(FILECREATED "24-Feb-86 17:07:02" {ERIS}<FISCHER>ARRAYTEST.;27
 7864   

      changes to:  (RECORDS RANKVECTOR RANKTRIPLE NEWARRAY)
                   (FNS \RANKTRIPLEREF MAKE-RANKVECTOR DUMPWORDS \ARRAYINDEX.UFN PRINT-NEWARRAY 
                        MAKE-NEWARRAY NEWARRAY-DIMENSIONS PRINT-RANKVECTOR NEWARRAY-RANK)
                   (VARS ARRAYTESTCOMS)

      previous date: "20-Feb-86 16:00:15" {ERIS}<FISCHER>ARRAYTEST.;25)


(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT ARRAYTESTCOMS)

(RPAQQ ARRAYTESTCOMS
 [(RECORDS NEWARRAY RANKTRIPLE RANKVECTOR)
                          (FNS DUMPWORDS MAKE-NEWARRAY MAKE-RANKVECTOR NEWARRAY-DIMENSIONS 
                               NEWARRAY-RANK PRINT-RANKVECTOR PRINT-NEWARRAY \ARRAYINDEX.UFN 
                               \RANKTRIPLEREF)
                          (P (DEFPRINT (QUOTE NEWARRAY)
                                    (QUOTE PRINT-NEWARRAY))
                             (MOVD (QUOTE \ARRAYINDEX.UFN)
                                   (QUOTE \ARRAYINDEX1))
                             (MOVD (QUOTE \ARRAYINDEX.UFN)
                                   (QUOTE \ARRAYINDEX2)))
                          (PROP DOPVAL ARRAYINDEX1 ARRAYINDEX2)
                          (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
                                 (ADDVARS (NLAMA)
                                        (NLAML)
                                        (LAMA \ARRAYINDEX.UFN])
[DECLARE: EVAL@COMPILE 

(DATATYPE NEWARRAY
 ((RANKVECTOR POINTER)
                        (BASE POINTER)))

(BLOCKRECORD RANKTRIPLE
 ((OFFSET FIXP)
                             (FILL FIXP)
                             (LENGTH FIXP)))

(BLOCKRECORD RANKVECTOR
 ((ELEMENTTYPE WORD)
                             (RANK WORD)))
]
(/DECLAREDATATYPE (QUOTE NEWARRAY)
       (QUOTE (POINTER POINTER))
       (QUOTE ((NEWARRAY 0 POINTER)
               (NEWARRAY 2 POINTER)))
       (QUOTE 4))
(DEFINEQ

(DUMPWORDS

  [LAMBDA (H N)
                                                        (* raf 
                                                                           "24-Feb-86 15:32")

    (for
 I from
 0 to
 (SUB1 N) do
 (printout T " " (\GETBASE H I)))
    (TERPRI])

(MAKE-NEWARRAY

  [LAMBDA (DIMS)
                                                       (* raf 
                                                                           "18-Feb-86 17:37")

    (create
 NEWARRAY
           RANKVECTOR ←(MAKE-RANKVECTOR
 DIMS])

(MAKE-RANKVECTOR

  [LAMBDA (DIMS)
                                                       (* raf 
                                                                           "18-Feb-86 17:47")

    (COND
       ((NULL DIMS)
        (ERROR "No dimensions given")))
    (LET* ((RANK (LENGTH DIMS))
           (RV (\ALLOCBLOCK (IPLUS 2 (ITIMES RANK 6))
                      UNBOXEDBLOCK.GCT NIL 16)))
          (replace
 (RANKVECTOR RANK) of
 RV with
 RANK)
          (for
 DIMENSION in
 DIMS as
 I from
 0 to
 (SUB1 RANK)
             do
 (SETQ DIMENSION (FIXP DIMENSION))
                   (LET ((RT (\RANKTRIPLEREF
 RV I)))
                        (replace
 (RANKTRIPLE OFFSET) of
 RT with
 0)
                        (replace
 (RANKTRIPLE FILL) of
 RT with
 (if
 (EQ RANK 1)
                                                                              then
 DIMENSION
                                                                            else
 0))
                        (replace
 (RANKTRIPLE LENGTH) of
 RT with
 DIMENSION)))
      RV])

(NEWARRAY-DIMENSIONS

  [LAMBDA (ARRAY)
                                                      (* raf 
                                                                           "18-Feb-86 17:33")

    (LET ((RANKVECTOR (fetch
 (NEWARRAY RANKVECTOR) of
 ARRAY)))
         (for
 I from
 0 to
 (SUB1 (fetch
 (RANKVECTOR RANK) of
 RANKVECTOR))
            collect
 (fetch
 (RANKTRIPLE LENGTH) of
 (\RANKTRIPLEREF
 RANKVECTOR I])

(NEWARRAY-RANK

  [LAMBDA (A)
                                                          (* raf 
                                                                           "14-Feb-86 18:55")

    (fetch
 (RANKVECTOR RANK) of
 (fetch
 (NEWARRAY RANKVECTOR) of
 A])

(PRINT-RANKVECTOR

  [LAMBDA (RV)
                                                         (* raf 
                                                                           "18-Feb-86 17:20")

    (LET ((RANK (fetch
 (RANKVECTOR RANK) OF
 RV)))
         (printout T "#<RANKVECTOR: DIMS " RANK)
         (for
 I from
 2 to
 (ITIMES RANK 6) by
 2 do
 (printout T " "
                                                                             (\GETBASEFIXP RV I)))
         (printout T ">")
     RV])

(PRINT-NEWARRAY

  [LAMBDA (ARRAY)
                                                      (* raf 
                                                                           "18-Feb-86 18:04")

    (LET* ((RANK (NEWARRAY-RANK
 ARRAY)))
          (printout T \CML.READPREFIX "<NEWARRAY, DIMENSIONS: ")
          (for
 I in
 (NEWARRAY-DIMENSIONS
 ARRAY) do
 (printout T " " I))
          (printout T ">")
      ARRAY])

(\ARRAYINDEX.UFN

  [LAMBDA ARGS
                                                         (* raf 
                                                                           "18-Feb-86 20:38")

            
            (* * NEWARRAY followed by indices)


    (LET* ((FINALINDEX 0)
           (LASTWIDTH 1)
           (ARRAY (ARG ARGS 1))
           (RANKVECTOR (fetch
 (NEWARRAY RANKVECTOR) of
 ARRAY))
           (RANK (ffetch
 (RANKVECTOR RANK) of
 RANKVECTOR)))
          (if
 (NEQ RANK (SUB1 ARGS))
              then
 (ERROR "Dimensionality mismatch" ARRAY))
          [for
 I from
 (SUB1 RANK) to
 0 by
 -1
             do
 (LET ((RANKTRIPLE (\RANKTRIPLEREF
 RANKVECTOR I)))
                         (LET [(OFFSET (ffetch
 (RANKTRIPLE OFFSET) of
 RANKTRIPLE))
                               (FILL (ffetch
 (RANKTRIPLE FILL) of
 RANKTRIPLE))
                               (LENGTH (ffetch
 (RANKTRIPLE LENGTH) of
 RANKTRIPLE))
                               (INDEX (ARG ARGS (IPLUS I 2]
                              (if
 (ILESSP INDEX 0)
                                  then
 (ERROR "Index must be positive" INDEX))
                              (if
 (if
 (EQL RANK 1)
                                          then
 (ILESSP INDEX FILL)
                                        else
 (ILESSP INDEX LENGTH))
                                  then
 (add
 FINALINDEX (TIMES LASTWIDTH (PLUS OFFSET INDEX)))
                                        (change
 LASTWIDTH (TIMES DATUM LENGTH))
                                else
 (ERROR "Index out of bounds " INDEX]
      FINALINDEX])

(\RANKTRIPLEREF

  [LAMBDA (RANKVECTOR INDEX)
                                           (* raf 
                                                                           "24-Feb-86 15:29")

    (\ADDBASE RANKVECTOR (IPLUS 2 (ITIMES 6 INDEX])
)
(DEFPRINT (QUOTE NEWARRAY)
       (QUOTE PRINT-NEWARRAY))
(MOVD (QUOTE \ARRAYINDEX.UFN)
      (QUOTE \ARRAYINDEX1))
(MOVD (QUOTE \ARRAYINDEX.UFN)
      (QUOTE \ARRAYINDEX2))

(PUTPROPS ARRAYINDEX1 DOPVAL
 (2 ARRAYINDEX1))

(PUTPROPS ARRAYINDEX2 DOPVAL
 (3 ARRAYINDEX2))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 \ARRAYINDEX.UFN)
)
(PUTPROPS ARRAYTEST COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1996 7361 (DUMPWORDS 2006 . 2297) (MAKE-NEWARRAY 2299 . 2574) (MAKE-RANKVECTOR 2576 . 
3698) (NEWARRAY-DIMENSIONS 3700 . 4166) (NEWARRAY-RANK 4168 . 4451) (PRINT-RANKVECTOR 4453 . 4983) (
PRINT-NEWARRAY 4985 . 5423) (\ARRAYINDEX.UFN 5425 . 7105) (\RANKTRIPLEREF 7107 . 7359)))))
STOP