(FILECREATED " 4-Dec-83 19:07:32" {PHYLUM}<LISP>LIBRARY>CMLARRAY.;4 56766
changes to: (RECORDS CMLARRAY)
(FNS MAKEARRAY)
previous date: "22-OCT-83 04:11:35" {PHYLUM}<LISP>LIBRARY>CMLARRAY.;2)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT CMLARRAYCOMS)
(RPAQQ CMLARRAYCOMS ((* CommonLisp array facilities.)
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS \MACRO.MX \CHECKTYPE \INDEXABLE.FIXP))
(EXPORT (RECORDS CMLARRAY)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS * CMLARRAYTYPES)
(CONSTANTS \AT.MOD.BIT)))
(COMS (MACROS \0DIM.ASET)
(* Following macros likely differ in the various implementations but at least depend on
the \GETBASE... and \PUTBASE... series)
(MACROS DATATYPE.TEST \WORDREF.PTR \WORDSET.PTR \WORDSET.XPTR \WORDREF.FIXP
\WORDSET.FIXP \WORDREF.FLOATP \WORDSET.FLOATP \WORDREF.16 \WORDSET.16
\WORDREF.8 \WORDSET.8 \WORDREF.4 \WORDSET.4 \WORDREF.1 \WORDSET.1)
(FNS \BubbleWORDSET)
(DECLARE: EVAL@COMPILE DONTCOPY (FNS \BubbleWORDSET)))
(DECLARE: COPYWHEN (NEQ COMPILEMODE (QUOTE D))
(* Patch ups for non-D worlds)
(FILES MACROAUX)
(* Rather than forcibly load in NONDADDARITH we cause it to be loaded only when
compiling this file, or at "last moment" when absolutely needed.)
(FNS \NONDADDARITH.TRAMPOLINE)
(DECLARE: EVAL@LOADWHEN (NEQ (SYSTEMTYPE)
(QUOTE D))
(DECLARE: EVAL@COMPILEWHEN (NEQ COMPILEMODE (QUOTE D))
DONTCOPY
(P (OR (CONSTANTEXPRESSIONP (QUOTE PTRBLOCK.GCT))
(PROGN (SETQ PTRBLOCK.GCT 1)
(CONSTANTS PTRBLOCK.GCT))))
(FILES NONDADDARITH))
(P (MAPC (QUOTE (LOADBYTE DEPOSITEBYTE \GETBASEBIT \GETBASENIBBLE
\GETBASEBYTE \GETBASEDOUBLEBYTE \GETBASEFIXP
\GETBASEFLOATP \GETBASEPTR \PUTBASEBIT
\PUTBASENIBBLE \PUTBASEBYTE \PUTBASEDOUBLEBYTE
\PUTBASEFIXP \PUTBASEFLOATP \PUTBASEPTR))
(FUNCTION (LAMBDA (X)
(MOVD? (FUNCTION \NONDADDARITH.TRAMPOLINE)
X)))))))
(FNS MAKEARRAY \CML.ICP.CHECK \MARGINTO ADJUSTARRAY)
(FNS AREF ASET)
(MACROS AREF ASET)
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS \AREFSET.LINEARIZE \AREFSET.LINEARIZE1
\AREFSET.LINEARIZE2))
(FNS \AREF.1 \ASET.1 \AREF.2 \ASET.2 \AREFLINEAR \ASETLINEAR)
(MACROS ARRAYRANK ARRAYDIMENSIONS ARRAYDIMENSION)
(FNS ARRAYRANK ARRAYDIMENSIONS ARRAYDIMENSION ARRAYELEMENTTYPE ARRAYINBOUNDSP ARRAYTOTALSIZE
ARRAYROWMAJORINDEX)
(PROP ARGNAMES MAKEARRAY AREF ASET ARRAYINBOUNDSP ADJUSTARRAY)
(COMS (* The "fast" versions of AREF and ASET -- following P causes them all to be set up as
macros)
(DECLARE: EVAL@COMPILE
(P ((LAMBDA (C)
(MAPC (QUOTE (P X 1 4 8 16 N L))
(FUNCTION
(LAMBDA
(A)
(MAPC (QUOTE (AREF ASET))
(FUNCTION
(LAMBDA
(B)
(SETQ C (MKATOM (CONCAT "\" A B)))
(PUTPROP (MKATOM (CONCAT A B))
(QUOTE MACRO)
(LIST (QUOTE X)
(LIST (MKATOM (CONCAT "\Fast"
B
"expander"))
(QUOTE X)
(LIST (QUOTE QUOTE)
C))))
(PUTPROP C (QUOTE MACRO)
(LIST (QUOTE X)
(LIST (MKATOM (CONCAT
"\NoSissy"
B
"expander"))
(QUOTE X)
(LIST (QUOTE QUOTE)
C))))))))))))))
(FNS \FastAREFexpander \NoSissyAREFexpander \FastASETexpander \NoSissyASETexpander
\AREFSET.INDEXFORM \CMLARRAY.LOCFTRAN)
(INITVARS (AREFSissyFLG NIL))
(PROP GLOBALVAR AREFSissyFLG))
(FNS LISTARRAY FILLARRAY \PRINTCMLARRAY \READCMLARRAY)
(FILEPKGCOMS CMLARRAYS)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA ARRAYROWMAJORINDEX ARRAYINBOUNDSP ASET AREF ADJUSTARRAY MAKEARRAY
\NONDADDARITH.TRAMPOLINE)))))
(* CommonLisp array facilities.)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS \MACRO.MX MACRO (Z
(PROG ((X (EXPANDMACRO (CAR Z)
T)))
(COND
((EQ X (CAR Z))
(ERROR "No macro property -- \MACRO.MX" X))
(T (RETURN X))))))
(PUTPROPS \CHECKTYPE MACRO (X
(PROG ((VAR (CAR X))
(PRED (CADR X)))
(if (AND (LISTP PRED)
(MEMB (CAR PRED)
(QUOTE (QUOTE FUNCTION))))
then (SETQ PRED (LIST (CADR PRED)
VAR)))
(RETURN (SUBPAIR (QUOTE (MSG VAR PRED))
(LIST (CONCAT "
is not a suitable value for the variable: " VAR)
VAR PRED)
(QUOTE (until PRED do (SETQ VAR (ERROR VAR MSG)))))))))
(PUTPROPS \INDEXABLE.FIXP MACRO (OPENLAMBDA (X)
(AND (FIXP X)
(IGEQ X 0))))
(PUTPROPS \INDEXABLE.FIXP DMACRO (OPENLAMBDA (X)
(AND (SMALLP X)
(IGEQ X 0))))
)
)
(* FOLLOWING DEFINITIONS EXPORTED)
[DECLARE: EVAL@COMPILE
(DATATYPE CMLARRAY ((CMLANCHOR POINTER)
(CMLANCHOROFFSET POINTER)
(CMLAETYPE BITS 8)
(CMLMARGINS POINTER)
(CMLMOD#P2P FLAG)
(CMLRANK BITS 7)
(CMLDIML POINTER)
(CMLALIGNHI BITS 8)
(CMLIMAX POINTER)
(CMLALIGNLO BITS 8)
(CMLMOD# POINTER))
(ACCESSFNS (CMLALIGN (LOGOR (LLSH (fetch CMLALIGNHI of DATUM)
8)
(fetch CMLALIGNLO of DATUM))
(PROGN (replace CMLALIGNHI of DATUM
with (LOADBYTE NEWVALUE 8 8))
(replace CMLALIGNLO of DATUM
with (LOADBYTE NEWVALUE 0 8))
NEWVALUE)))
(SYSTEM))
]
(/DECLAREDATATYPE (QUOTE CMLARRAY)
(QUOTE (POINTER POINTER (BITS 8)
POINTER FLAG (BITS 7)
POINTER
(BITS 8)
POINTER
(BITS 8)
POINTER)))
(DECLARE: EVAL@COMPILE DONTCOPY
(RPAQQ CMLARRAYTYPES (\AT.POINTER \AT.FIXP \AT.WORD \AT.BYTE \AT.BIT \AT.FLOATP \AT.XPOINTER
\AT.NIBBLE \AT.DOUBLEBYTE))
(DECLARE: EVAL@COMPILE
(RPAQQ \AT.POINTER 2)
(RPAQQ \AT.FIXP 3)
(RPAQQ \AT.WORD 4)
(RPAQQ \AT.BYTE 5)
(RPAQQ \AT.BIT 6)
(RPAQQ \AT.FLOATP 7)
(RPAQQ \AT.XPOINTER 8)
(RPAQQ \AT.NIBBLE 9)
(RPAQQ \AT.DOUBLEBYTE 10)
(CONSTANTS \AT.POINTER \AT.FIXP \AT.WORD \AT.BYTE \AT.BIT \AT.FLOATP \AT.XPOINTER \AT.NIBBLE
\AT.DOUBLEBYTE)
)
(DECLARE: EVAL@COMPILE
(RPAQQ \AT.MOD.BIT 128)
(CONSTANTS \AT.MOD.BIT)
)
)
(* END EXPORTED DEFINITIONS)
(DECLARE: EVAL@COMPILE
(PUTPROPS \0DIM.ASET MACRO (OPENLAMBDA (FUNNAME \NewVal \Array)
(OR (ZEROP (ARRAYRANK \Array))
(ERROR \Array FUNNAME))
(freplace (CMLARRAY CMLANCHOR) of \Array with \NewVal)))
)
(* Following macros likely differ in the various implementations but at least depend on the
\GETBASE... and \PUTBASE... series)
(DECLARE: EVAL@COMPILE
(PUTPROPS DATATYPE.TEST MACRO (OPENLAMBDA (X TYPE)
(COND
((NOT (TYPENAMEP X TYPE))
(ERROR X (CONCAT (QUOTE Not% of% type% TYPE))))
(T X))))
(PUTPROPS DATATYPE.TEST DMACRO (= . \DTEST))
(PUTPROPS \WORDREF.PTR DMACRO ((ADDRESS I)
(\GETBASEPTR ADDRESS (PROG1 (LLSH I 1) (* (UNFOLD I WORDSPERCELL))
))))
(PUTPROPS \WORDREF.PTR MACRO (= . \GETBASEPTR))
(PUTPROPS \WORDSET.PTR DMACRO (X
(* (UNFOLD DATUM WORDSPERCELL))
(\BubbleWORDSET X (QUOTE \VectorSET))))
(PUTPROPS \WORDSET.PTR MACRO (X
(\BubbleWORDSET X (QUOTE \PUTBASEPTR))))
(PUTPROPS \WORDSET.XPTR DMACRO (X
(* (UNFOLD DATUM WORDSPERCELL))
(\BubbleWORDSET X (QUOTE \PUTBASEPTR)
(QUOTE (LLSH DATUM 1)))))
(PUTPROPS \WORDSET.XPTR MACRO (X
(\BubbleWORDSET X (QUOTE \PUTBASEPTR))))
(PUTPROPS \WORDREF.FIXP DMACRO ((ADDRESS I)
(\GETBASEFIXP ADDRESS (PROG1 (LLSH I 1) (* (UNFOLD I WORDSPERCELL))
))))
(PUTPROPS \WORDREF.FIXP MACRO (= . \GETBASEFIXP))
(PUTPROPS \WORDSET.FIXP DMACRO (X
(* (UNFOLD DATUM WORDSPERCELL))
(\BubbleWORDSET X (QUOTE \PUTBASEFIXP)
(QUOTE (LLSH DATUM 1)))))
(PUTPROPS \WORDSET.FIXP MACRO (X
(\BubbleWORDSET X (QUOTE \PUTBASEFIXP))))
(PUTPROPS \WORDREF.FLOATP DMACRO ((ADDRESS I)
(\GETBASEFLOATP ADDRESS (PROG1 (LLSH I 1) (* (UNFOLD I WORDSPERCELL))
))))
(PUTPROPS \WORDREF.FLOATP MACRO (= . \GETBASEFLOATP))
(PUTPROPS \WORDSET.FLOATP DMACRO (X
(* (UNFOLD DATUM WORDSPERCELL))
(\BubbleWORDSET X (QUOTE \PUTBASEFLOATP)
(QUOTE (LLSH DATUM 1)))))
(PUTPROPS \WORDSET.FLOATP MACRO (X
(\BubbleWORDSET X (QUOTE \PUTBASEFLOATP))))
(PUTPROPS \WORDREF.16 DMACRO (= . \GETBASE))
(PUTPROPS \WORDREF.16 MACRO (=
. \GETBASEDOUBLEBYTE))
(PUTPROPS \WORDSET.16 DMACRO (X
(\BubbleWORDSET X (QUOTE \PUTBASE))))
(PUTPROPS \WORDSET.16 MACRO (X
(\BubbleWORDSET X (QUOTE \PUTBASEDOUBLEBYTE))))
(PUTPROPS \WORDREF.8 DMACRO ((ADDRESS I)
(\GETBASEBYTE ADDRESS I)))
(PUTPROPS \WORDREF.8 MACRO (= . \GETBASEBYTE))
(PUTPROPS \WORDSET.8 DMACRO (X
(\BubbleWORDSET X (QUOTE \PUTBASEBYTE))))
(PUTPROPS \WORDSET.8 MACRO (X
(\BubbleWORDSET X (QUOTE \PUTBASEBYTE))))
(PUTPROPS \WORDREF.4 DMACRO ((BASE OFFST)
(\GETBASENIBBLE BASE OFFST)))
(PUTPROPS \WORDREF.4 MACRO (= . \GETBASENIBBLE))
(PUTPROPS \WORDSET.4 DMACRO (X
(\BubbleWORDSET X (QUOTE \PUTBASENIBBLE))))
(PUTPROPS \WORDSET.4 MACRO (X
(\BubbleWORDSET X (QUOTE \PUTBASENIBBLE))))
(PUTPROPS \WORDREF.1 DMACRO ((ADDRESS I)
(\GETBASEBIT ADDRESS I)))
(PUTPROPS \WORDREF.1 MACRO (= . \GETBASEBIT))
(PUTPROPS \WORDSET.1 DMACRO (X
(\BubbleWORDSET X (QUOTE \PUTBASEBIT))))
(PUTPROPS \WORDSET.1 MACRO (X
(\BubbleWORDSET X (QUOTE \PUTBASEBIT))))
)
(DEFINEQ
(\BubbleWORDSET
(LAMBDA (X FUNNAME SHIFTFORM) (* JonL " 1-JUL-83 19:45")
(PROG ((VAL (LISPFORM.SIMPLIFY (CAR X)
T))
(BASE (LISPFORM.SIMPLIFY (CADR X)
T))
(OFFST (LISPFORM.SIMPLIFY (CADDR X)
T)))
(AND SHIFTFORM (SETQ OFFST (SUBST OFFST (QUOTE DATUM)
SHIFTFORM)))
(RETURN (if (AND (ARGS.COMMUTABLEP VAL BASE)
(ARGS.COMMUTABLEP VAL OFFST))
then (LIST FUNNAME BASE OFFST VAL)
else (LIST (LIST (QUOTE LAMBDA)
(QUOTE (\Val))
(QUOTE (DECLARE (SPECVARS \Val)))
(LIST FUNNAME BASE OFFST (QUOTE \Val)))
VAL))))))
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DEFINEQ
(\BubbleWORDSET
(LAMBDA (X FUNNAME SHIFTFORM) (* JonL " 1-JUL-83 19:45")
(PROG ((VAL (LISPFORM.SIMPLIFY (CAR X)
T))
(BASE (LISPFORM.SIMPLIFY (CADR X)
T))
(OFFST (LISPFORM.SIMPLIFY (CADDR X)
T)))
(AND SHIFTFORM (SETQ OFFST (SUBST OFFST (QUOTE DATUM)
SHIFTFORM)))
(RETURN (if (AND (ARGS.COMMUTABLEP VAL BASE)
(ARGS.COMMUTABLEP VAL OFFST))
then (LIST FUNNAME BASE OFFST VAL)
else (LIST (LIST (QUOTE LAMBDA)
(QUOTE (\Val))
(QUOTE (DECLARE (SPECVARS \Val)))
(LIST FUNNAME BASE OFFST (QUOTE \Val)))
VAL))))))
)
)
(DECLARE: COPYWHEN (NEQ COMPILEMODE (QUOTE D))
(* Patch ups for non-D worlds)
(FILESLOAD MACROAUX)
(* Rather than forcibly load in NONDADDARITH we cause it to be loaded only when compiling this
file, or at "last moment" when absolutely needed.)
(DEFINEQ
(\NONDADDARITH.TRAMPOLINE
(LAMBDA NARGS (* JonL "11-SEP-83 15:09")
(PROG ((FNAME (STKNAME (STKNTH -1))))
(OR (FMEMB FNAME (QUOTE (LOADBYTE DEPOSITBYTE)))
(AND FNAME (LITATOM FNAME)
(ILESSP 8 (NCHARS FNAME))
(FMEMB (SUBATOM FNAME 2 4)
(QUOTE (GET PUT)))
(EQ (SUBATOM FNAME 5 8)
(QUOTE BASE)))
(SHOULDNT (QUOTE \NONDADDARITH.TRAMPOLINE)))
(PUTD FNAME NIL)
(FILESLOAD (SYSLOAD COMPILED FROM LISPUSERS)
NONDADDARITH)
(if (NOT (DEFINEDP FNAME))
then (MOVD (FUNCTION \NONDADDARITH.TRAMPOLINE)
FNAME)
(ERROR FNAME "Apparently not defined in NONDADDARITH file?")
else (APPLY FNAME (for I to NARGS collect (ARG NARGS I)))))))
)
(DECLARE: EVAL@LOADWHEN (NEQ (SYSTEMTYPE)
(QUOTE D))
(DECLARE: EVAL@COMPILEWHEN (NEQ COMPILEMODE (QUOTE D)) DONTCOPY
(OR (CONSTANTEXPRESSIONP (QUOTE PTRBLOCK.GCT))
(PROGN (SETQ PTRBLOCK.GCT 1)
(CONSTANTS PTRBLOCK.GCT)))
(FILESLOAD NONDADDARITH)
)
(MAPC (QUOTE (LOADBYTE DEPOSITEBYTE \GETBASEBIT \GETBASENIBBLE \GETBASEBYTE \GETBASEDOUBLEBYTE
\GETBASEFIXP \GETBASEFLOATP \GETBASEPTR \PUTBASEBIT \PUTBASENIBBLE
\PUTBASEBYTE \PUTBASEDOUBLEBYTE \PUTBASEFIXP \PUTBASEFLOATP \PUTBASEPTR))
(FUNCTION (LAMBDA (X)
(MOVD? (FUNCTION \NONDADDARITH.TRAMPOLINE)
X))))
)
)
(DEFINEQ
(MAKEARRAY
(LAMBDA NARGS (* JonL " 4-Dec-83 17:50")
(PROG ((A.E.TYPE T)
(DIML (if (ZEROP NARGS)
then NIL
elseif (EVENP NARGS)
then (ERROR "Odd # of keywords")
elseif (NULL (ARG NARGS 1))
then NIL
else (OR (LISTP (ARG NARGS 1))
(LIST (ARG NARGS 1)))))
(#ROWS 0)
(#ELTS/ROW 0)
(#ELTS 1)
(RANK 0)
(ANCHOROFFSET 0)
(DAROFFSET 0)
(THISROWBASE 0)
(ALIGNMENT 0)
MOD# DAR DARTYPE IV IEP ICP POINTERP BITSPERELEMENT ANCHOR TEM)
(DECLARE (SPECVARS A.E.TYPE #ELTS/ROW THISROWBASE))
(if DIML
then (for I in DIML
do (OR (AND (\INDEXABLE.FIXP I)
(IGEQ I 1))
(ERROR "Invalid dimension" I))
(SETQ #ELTS (ITIMES (SETQ #ROWS #ELTS)
(SETQ #ELTS/ROW I))))
(SETQ RANK (FLENGTH DIML))
else (RETURN ARRAY))
(for I VAL from 2 by 2 until (IGREATERP I NARGS)
do (SETQ VAL (ARG NARGS (ADD1 I)))
(SELECTQ (ARG NARGS I)
(ELEMENTTYPE (SETQ A.E.TYPE VAL))
(INITIALELEMENT (SETQ IEP T)
(SETQ IV VAL))
(INITIALCONTENTS (SETQ ICP T)
(SETQ IV VAL))
(DISPLACEDTO (SETQ DAR (DATATYPE.TEST VAL (QUOTE CMLARRAY)))
(SETQ DARTYPE (ffetch CMLAETYPE of DAR)))
(DISPLACEDTOBASE (SETQ DAR VAL)
(SETQ DARTYPE))
(DISPLACEDINDEXOFFSET (if (SETQ TEM (if (NOT (FIXP VAL))
then 10
elseif (ILESSP VAL 1)
then 27))
then (ERRORX (LIST TEM VAL)))
(SETQ DAROFFSET VAL))
(ALIGNMENT (if (SETQ TEM (if (NOT (FIXP VAL))
then 10
elseif (OR (NOT (SMALLP VAL))
(ILESSP VAL 1))
then 27))
then (ERRORX (LIST TEM VAL)))
(SETQ ALIGNMENT VAL))
(FILLPOINTER (ERROR (QUOTE NotYetImplemented)
"FILLPOINTER option"))
(ERROR "Bad keyword" (ARG NARGS I))))
(* Process keyword arguments)
FINDTYPE
(SETQ A.E.TYPE
(SELECTQ A.E.TYPE
((NIL T POINTER XPOINTER)
(SETQ POINTERP (AND (NEQ A.E.TYPE (QUOTE XPOINTER))
PTRBLOCK.GCT))
(SETQ BITSPERELEMENT BITSPERCELL)
\AT.POINTER)
((FIXP FIXNUM CELL)
(SETQ BITSPERELEMENT BITSPERCELL)
\AT.FIXP)
((FLOATP FLONUM)
(SETQ BITSPERELEMENT BITSPERCELL)
\AT.FLOATP)
((WORD SMALLPOSP)
(SELECTQ (SYSTEMTYPE)
(D (SETQ BITSPERELEMENT BITSPERWORD)
(SETQ MOD# (CONSTANT (LLSH 1 BITSPERWORD)))
\AT.WORD)
(ERROR A.E.TYPE "Only in Interlisp-D")))
((DOUBLEBYTE)
(SETQ BITSPERELEMENT (CONSTANT (TIMES 2 BITSPERBYTE)))
(SETQ MOD# (CONSTANT (LLSH 1 (TIMES 2 BITSPERBYTE))))
\AT.DOUBLEBYTE)
((BYTE CHARACTER)
(SETQ BITSPERELEMENT BITSPERBYTE)
(SETQ MOD# (CONSTANT (LLSH 1 BITSPERBYTE)))
\AT.BYTE)
((NIBBLE)
(SETQ BITSPERELEMENT BITSPERNIBBLE)
(SETQ MOD# (CONSTANT (LLSH 1 BITSPERNIBBLE)))
\AT.NIBBLE)
((BIT)
(SETQ BITSPERELEMENT 1)
(SETQ MOD# 2)
\AT.BIT)
(if (AND (EQ (CAR (LISTP A.E.TYPE))
(QUOTE MOD))
(NULL (CDDR A.E.TYPE))
(FIXP (SETQ MOD# (CADR A.E.TYPE)))
(ILESSP 1 MOD#))
then (if (SETQ TEM (SASSOC MOD#
(CONSTANT
(LIST (CONS (LLSH 1 1)
(QUOTE BIT))
(CONS (LLSH 1 BITSPERNIBBLE)
(QUOTE NIBBLE))
(CONS (LLSH 1 BITSPERBYTE)
(QUOTE BYTE))
(CONS (LLSH 1 (ITIMES 2 BITSPERBYTE))
(SELECTQ (SYSTEMTYPE)
(D (QUOTE WORD))
(QUOTE DOUBLEBYTE)))))))
then (SETQ A.E.TYPE (CDR TEM))
(GO FINDTYPE)
else (SETQ BITSPERELEMENT (INTEGERLENGTH (SUB1 MOD#)))
(OR (ILESSP BITSPERELEMENT \AT.MOD.BIT)
(SHOULDNT "\AT.MOD.BIT"))
(SETQ A.E.TYPE (LOGOR \AT.MOD.BIT BITSPERELEMENT)))
else (ERROR "Bad type specifier" A.E.TYPE))))
(* Standardize the type argument, and discern the number
of bits per element (and whether or not the elements are
pointers))
(if (NEQ ALIGNMENT 0)
then (SETQ #ELTS/ROW (ITIMES (IQUOTIENT (IPLUS #ELTS/ROW (SUB1 ALIGNMENT))
ALIGNMENT)
ALIGNMENT))
(SETQ #ELTS (ITIMES #ROWS #ELTS/ROW)))
(if ICP
then (AND IEP (ERROR (QUOTE Inconsistent% options)
(QUOTE (INITIALELEMENT INITIALCONTENTS))))
(AND DIML (\CML.ICP.CHECK DIML IV)))
(if DAR
then (* Some consistency checks)
(if (OR IEP ICP)
then (ERROR (QUOTE Inconsistent% options)
(if IEP
then (QUOTE (DISPLACEDTO INITIALELEMENT))
elseif ICP
then (QUOTE (DISPLACEDTO INITIALCONTENTS))
else (SHOULDNT)))
elseif (NULL DARTYPE)
then (* User just supplied a BASE address for the displacedto
array)
NIL
elseif (ILESSP (IDIFFERENCE (ADD1 (ffetch CMLIMAX of DAR))
DAROFFSET)
#ELTS)
then (ERROR "Attempt to displace to a cramped array" DAR)
elseif (NEQ (SETQ TEM (SELECTC A.E.TYPE
((LIST \AT.POINTER \AT.XPOINTER)
T)
NIL))
(SELECTC DARTYPE
((LIST \AT.POINTER \AT.XPOINTER)
T)
NIL))
then (ERROR (if TEM
then "Displaceing pointer array to non-pointer one."
else "Displaceing non-pointer array to pointer one.")
DAR)))
(if (ZEROP RANK)
then (AND IEP (ERROR (QUOTE Inconsistent% options)
(QUOTE INITIALELEMENT)))
(SETQ ANCHOR (if ICP
then (if (SELECTC A.E.TYPE
((LIST \AT.FIXP \AT.WORD \AT.BYTE \AT.NIBBLE
\AT.BIT)
(NOT (FIXP IV)))
(\AT.FLOATP (NOT (FLOATP IV)))
(if (ILEQ A.E.TYPE \AT.MOD.BIT)
then (NOT (FIXP IV))))
then (ERRORX (LIST 32 IV)))
IV
else (SELECTC A.E.TYPE
((LIST \AT.POINTER \AT.XPOINTER)
NIL)
(\AT.FLOATP 0.0)
0)))
else (SETQ ANCHOR (if DAR
then (* DAROFFSET is now to be converted to a bit offset.)
(* ANCHOROFFSET is in units of the new array's indices)
(SETQ ANCHOROFFSET
(if (NULL DARTYPE)
then DAROFFSET
else (IQUOTIENT (ITIMES (SELECTC
DARTYPE
((LIST \AT.POINTER \AT.FIXP
\AT.XPOINTER)
BITSPERCELL)
((LIST \AT.DOUBLEBYTE \AT.WORD)
(CONSTANT (TIMES 2 BITSPERBYTE)
))
(\AT.BYTE BITSPERBYTE)
(\AT.NIBBLE BITSPERNIBBLE)
(\AT.BIT 1)
(\AT.FLOATP (SHOULDNT
(QUOTE FLOATP)))
(if (IGEQ DARTYPE \AT.MOD.BIT)
then (BITCLEAR DARTYPE
\AT.MOD.BIT)
else (SHOULDNT)))
DAROFFSET)
BITSPERELEMENT)))
(if DARTYPE
then (ffetch CMLANCHOR of DAR)
else DAR)
else (SELECTQ (SYSTEMTYPE)
(D ((LAMBDA (BLOCK#WDS)
(\ALLOCBLOCK (FOLDHI BLOCK#WDS WORDSPERCELL)
POINTERP))
(FOLDHI (ADD1 (ITIMES #ELTS BITSPERELEMENT))
BITSPERWORD)))
((LAMBDA (#ELTS/WORD)
(ARRAY (IQUOTIENT (IPLUS #ELTS (SUB1 #ELTS/WORD))
#ELTS/WORD)))
(IQUOTIENT 36 BITSPERELEMENT))))))
(SETQ TEM
(create CMLARRAY
CMLRANK ← RANK
CMLANCHOR ← ANCHOR
CMLAETYPE ← A.E.TYPE
CMLANCHOROFFSET ← ANCHOROFFSET
CMLMARGINS ←(if (IGEQ RANK 2)
then (\MARGINTO DIML)
else 0)
CMLDIML ← DIML
CMLIMAX ←(SUB1 #ELTS)
CMLALIGN ← ALIGNMENT
CMLMOD# ← MOD#
CMLMOD#P2P ←(if (NOT MOD#)
then NIL
elseif (BITTEST A.E.TYPE \AT.MOD.BIT)
then (POWEROFTWOP (BITCLEAR A.E.TYPE \AT.MOD.BIT))
else (* This is the case of the "optimized" ones -- BIT BYTE
WORD etc)
T)))
(if (if IEP
then (SETQ IV (LIST IV))
T
elseif ICP
then (FRPTQ (SUB1 RANK)
(SETQ IV (APPLY (FUNCTION APPEND)
IV)))
T)
then (FILLARRAY TEM IV))
(RETURN TEM))))
(\CML.ICP.CHECK
(LAMBDA (DIML L) (* JonL " 8-FEB-83 18:54")
(if (NEQ (CAR DIML)
(LENGTH L))
then (ERROR (QUOTE INITIALCONTENTS))
else (pop DIML)
(OR (NULL DIML)
(for LL in L do (\CML.ICP.CHECK DIML LL))))))
(\MARGINTO
(LAMBDA (DIML) (* JonL "16-SEP-83 23:46")
(DECLARE (SPECVARS THISROWBASE #ELTS/ROW))
((LAMBDA (#HYPER.ROWS NEXTDIML LASTDIMENSIONP MARGINARRAY)
(SETQ MARGINARRAY (\MakeVector #HYPER.ROWS))
(if LASTDIMENSIONP
then (for I from 0 to (SUB1 #HYPER.ROWS)
do (* Except for the final margining over the real
baseblock, each margin array will be going into another
margin array for the next dimension.)
(\VectorSET MARGINARRAY I THISROWBASE)
(add THISROWBASE #ELTS/ROW))
else (for I from 0 to (SUB1 #HYPER.ROWS) do (\VectorSET MARGINARRAY I (\MARGINTO NEXTDIML)))
)
MARGINARRAY)
(CAR DIML)
(OR (CDR DIML)
(SHOULDNT))
(NULL (CDDR DIML)))))
(ADJUSTARRAY
(LAMBDA NARGS (* JonL "30-SEP-83 22:15")
(PROG ((ARRAY (DATATYPE.TEST (if (OR (ILESSP NARGS 1)
(IGREATERP NARGS 2))
then (if (ILESSP NARGS 2)
then (ERROR (QUOTE Too% few% args))
else (ERROR (QUOTE NotYetImplemented)
"Keywords for ADJUSTARRAY"))
else (ARG NARGS 1))
(QUOTE CMLARRAY)))
(DIML (if (ILEQ NARGS 1)
then NIL
elseif (NULL (ARG NARGS 2))
then NIL
else (OR (LISTP (ARG NARGS 2))
(LIST (ARG NARGS 2)))))
(#ROWS 0)
(#ELTS/ROW 0)
(#ELTS 1)
(THISROWBASE 0)
TEM)
(DECLARE (SPECVARS #ELTS/ROW THISROWBASE))
(if (NEQ (FLENGTH DIML)
(ffetch CMLRANK of ARRAY))
then (ERROR "Rank mismatch")
elseif (NOT (ZEROP (ffetch CMLALIGN of ARRAY)))
then (ERROR (QUOTE NotYetImplemented)
"Adjustment of ALIGN'd arrays"))
(if DIML
then (for I in DIML
do (OR (AND (\INDEXABLE.FIXP I)
(IGEQ I 1))
(ERROR "Invalid dimension" I))
(SETQ #ELTS (ITIMES (SETQ #ROWS #ELTS)
(SETQ #ELTS/ROW I))))
else (RETURN ARRAY))
(if (IGREATERP #ELTS (ADD1 (ffetch CMLIMAX of ARRAY)))
then (PROG ((HAUMANYBITS (ARRAYTOTALSIZE ARRAY T))
(A.E.TYPE (ffetch CMLAETYPE of ARRAY))
(ANCHOROFFSET (ffetch CMLANCHOROFFSET of ARRAY))
(NAOFFSET 0)
BITSPERELEMENT ANCHOR)
(SETQ BITSPERELEMENT (if (IGEQ A.E.TYPE \AT.MOD.BIT)
then (BITCLEAR A.E.TYPE \AT.MOD.BIT)
else (SELECTC A.E.TYPE
(\AT.POINTER BITSPERCELL)
(\AT.BYTE (SETQ NAOFFSET
(IMOD ANCHOROFFSET
BYTESPERCELL))
BITSPERBYTE)
((LIST \AT.DOUBLEBYTE \AT.WORD)
(SETQ NAOFFSET
(IMOD ANCHOROFFSET
(CONSTANT (IQUOTIENT
BYTESPERCELL 2)))
)
(CONSTANT (TIMES 2 BITSPERBYTE)))
(\AT.BIT (SETQ NAOFFSET
(IMOD ANCHOROFFSET
BITSPERCELL))
1)
(\AT.NIBBLE
(SETQ NAOFFSET
(IMOD ANCHOROFFSET
(CONSTANT (QUOTIENT
BITSPERCELL
BITSPERNIBBLE))))
BITSPERNIBBLE)
BITSPERCELL)))
(SELECTQ (SYSTEMTYPE)
(D (\BLT ANCHOR (ffetch CMLANCHOR of ARRAY)
(FOLDLO HAUMANYBITS BITSPERWORD)))
(ERROR (QUOTE NotYetImplemented)
"How to move a block of n bits starting at cell boundaries"))
(SETQ ANCHOR (SELECTQ (SYSTEMTYPE)
((TENEX TOPS20)
(SETQ TEM (IQUOTIENT 36 BITSPERELEMENT))
(* #ELTS/pdp10WORD)
(ARRAY (IQUOTIENT (IPLUS (IPLUS #ELTS NAOFFSET)
(SUB1 TEM))
TEM)))
(\ALLOCBLOCK (FOLDHI (ITIMES BITSPERELEMENT
(IPLUS #ELTS NAOFFSET))
BITSPERCELL))))
(freplace CMLANCHOR of ARRAY with ANCHOR)
(freplace CMLANCHOROFFSET of ARRAY with NAOFFSET)))
(* Process keyword arguments)
(freplace CMLDIML of ARRAY with DIML)
(freplace CMLMARGINS of ARRAY with (if (ILEQ 2 (ffetch CMLRANK of ARRAY))
then (\MARGINTO DIML)
else 0))
(freplace CMLIMAX of ARRAY with (SUB1 #ELTS))
(RETURN ARRAY))))
)
(DEFINEQ
(AREF
(LAMBDA NARGS (* JonL "30-SEP-83 21:45")
(OR (IGEQ NARGS 1)
(ERROR (QUOTE Too% few% args)))
(PROG ((ARRAY (DATATYPE.TEST (ARG NARGS 1)
(QUOTE CMLARRAY)))
RANK)
(RETURN (if (NEQ NARGS (ADD1 (SETQ RANK (ffetch CMLRANK of ARRAY))))
then (ERROR ARRAY (QUOTE Array% Rank% Mismatch))
elseif (ZEROP RANK)
then (ffetch CMLANCHOR of ARRAY)
else (\AREFLINEAR ARRAY (IPLUS (\AREFSET.LINEARIZE ARRAY 2 NARGS)
(ffetch CMLANCHOROFFSET of ARRAY))))))))
(ASET
(LAMBDA NARGS (* JonL "30-SEP-83 22:15")
(OR (IGEQ NARGS 2)
(ERROR (QUOTE Too% few% args)))
(PROG ((VAL (ARG NARGS 1))
(ARRAY (DATATYPE.TEST (ARG NARGS 2)
(QUOTE CMLARRAY)))
RANK)
(RETURN (if (NEQ NARGS (IPLUS 2 (SETQ RANK (ffetch CMLRANK of ARRAY))))
then (ERROR ARRAY (QUOTE Array% Rank% Mismatch))
elseif (SELECTC (ffetch CMLAETYPE of ARRAY)
(\AT.POINTER NIL)
((LIST \AT.BYTE \AT.DOUBLEBYTE \AT.WORD \AT.BIT \AT.FIXP)
(NOT (FIXP VAL)))
((LIST \AT.FLOATP)
(NOT (FLOATP VAL)))
NIL)
then (ERRORX (LIST 32 VAL))
elseif (ZEROP RANK)
then (replace CMLANCHOR of ARRAY with VAL)
VAL
else (\ASETLINEAR VAL ARRAY (IPLUS (\AREFSET.LINEARIZE ARRAY 3 NARGS)
(ffetch CMLANCHOROFFSET of ARRAY))))))))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS AREF MACRO (X
(SELECTC (LENGTH X)
(2 (CONS (QUOTE \AREF.1)
X))
(3 (CONS (QUOTE \AREF.2)
X))
(QUOTE IGNOREMACRO))))
(PUTPROPS ASET MACRO (X
(SELECTC (LENGTH X)
(3 (CONS (QUOTE \ASET.1)
X))
(4 (CONS (QUOTE \ASET.2)
X))
(QUOTE IGNOREMACRO))))
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS \AREFSET.LINEARIZE MACRO ((ARRAY STARTAGRI NARGS)
(bind (SETQ I 0)
(SETQ MARGINS (ffetch CMLMARGINS of ARRAY)) for L on (ffetch CMLDIML of ARRAY) as J
from STARTAGRI
do (SETQ I (ARG NARGS J))
(if (NOT (FIXP I))
then (ERROR I (QUOTE Array% index% not% FIXP))
elseif (OR (ILESSP I 0)
(IGEQ I (CAR L)))
then (ERROR I (QUOTE Array% index% out% of% bounds)))
(if (NULL (CDR L))
then (* Final index is modified by the result of marginings.)
(OR (ILEQ (add I MARGINS)
(ffetch CMLIMAX of ARRAY))
(SHOULDNT))
else (* Go thru one margin array)
(SETQ MARGINS (\VectorREF MARGINS I)))
finally (RETURN I))))
(PUTPROPS \AREFSET.LINEARIZE1 MACRO (OPENLAMBDA (ARRAY I)
(if (NEQ 1 (ffetch CMLRANK of ARRAY))
then (ERROR ARRAY (QUOTE Array% Rank% Mismatch))
elseif (NOT (FIXP I))
then (ERROR I (QUOTE Array% index% not% FIXP))
elseif (OR (ILESSP I 0)
(IGEQ I (CAR (ffetch CMLDIML of ARRAY))))
then (ERROR I (QUOTE Array% index% out% of% bounds)))
(if (IGREATERP I (ffetch CMLIMAX of ARRAY))
then (SHOULDNT))
(IPLUS I (ffetch CMLANCHOROFFSET of ARRAY))))
(PUTPROPS \AREFSET.LINEARIZE2 MACRO (OPENLAMBDA (ARRAY I J)
(* JonL " 7-FEB-83 18:55")
(if (NEQ 2 (ffetch CMLRANK of ARRAY))
then (ERROR ARRAY (QUOTE Array% Rank% Mismatch)))
((LAMBDA (\DimensionsList \LinearIndex)
(DECLARE (LOCALVARS \DimensionsList))
(if (NOT (FIXP I))
then (ERROR I (QUOTE Array% index% not% FIXP))
elseif (OR (ILESSP I 0)
(IGEQ I (pop \DimensionsList)))
then (ERROR I (QUOTE Array% index% out% of% bounds))
elseif (OR (ILESSP J 0)
(IGEQ J (CAR \DimensionsList)))
then (ERROR J (QUOTE Array% index% out% of% bounds)))
(SETQ \LinearIndex (IPLUS (\VectorREF \LinearIndex I)
J))
(if (IGREATERP \LinearIndex (ffetch CMLIMAX of ARRAY))
then (SHOULDNT))
(IPLUS \LinearIndex (ffetch CMLANCHOROFFSET of ARRAY)))
(ffetch CMLDIML of ARRAY)
(ffetch CMLMARGINS of ARRAY))))
)
)
(DEFINEQ
(\AREF.1
(LAMBDA (ARRAY I) (* JonL "30-SEP-83 21:51")
(SETQ ARRAY (DATATYPE.TEST ARRAY (QUOTE CMLARRAY)))
(\AREFLINEAR ARRAY (\AREFSET.LINEARIZE1 ARRAY I))))
(\ASET.1
(LAMBDA (VAL ARRAY I) (* JonL "30-SEP-83 21:52")
(SETQ ARRAY (DATATYPE.TEST ARRAY (QUOTE CMLARRAY)))
(\ASETLINEAR VAL ARRAY (\AREFSET.LINEARIZE1 ARRAY I))))
(\AREF.2
(LAMBDA (ARRAY I J) (* JonL "30-SEP-83 21:53")
(SETQ ARRAY (DATATYPE.TEST ARRAY (QUOTE CMLARRAY)))
(\AREFLINEAR ARRAY (\AREFSET.LINEARIZE2 ARRAY I J))))
(\ASET.2
(LAMBDA (VAL ARRAY I J) (* JonL "30-SEP-83 21:53")
(SETQ ARRAY (DATATYPE.TEST ARRAY (QUOTE CMLARRAY)))
(\ASETLINEAR VAL ARRAY (\AREFSET.LINEARIZE2 ARRAY I J))))
(\AREFLINEAR
(LAMBDA (ARRAY I) (* JonL "30-SEP-83 22:15")
(PROG ((ANCHOR (ffetch CMLANCHOR of ARRAY))
(A.E.TYPE (ffetch CMLAETYPE of ARRAY)))
(RETURN (if (IGEQ \AT.MOD.BIT A.E.TYPE)
then (SELECTC A.E.TYPE
(\AT.POINTER (\VectorREF ANCHOR I))
(\AT.BYTE (\WORDREF.8 ANCHOR I))
((LIST \AT.WORD \AT.DOUBLEBYTE)
(\WORDREF.16 ANCHOR I))
(\AT.BIT (\WORDREF.1 ANCHOR I))
(\AT.NIBBLE (\WORDREF.4 ANCHOR I))
(\AT.XPOINTER (\WORDREF.PTR ANCHOR I))
(\AT.FIXP (\WORDREF.FIXP ANCHOR I))
(\AT.FLOATP (\WORDREF.FLOATP ANCHOR I))
(SHOULDNT))
else (* A.E.TYPE will now have the number of bits per
element)
(SETQ I (\GETBASEBITS ANCHOR (ITIMES I (SETQ A.E.TYPE (BITCLEAR A.E.TYPE
\AT.MOD.BIT)))
A.E.TYPE))
(if (ffetch CMLMOD#P2P of ARRAY)
then I
else (IMOD I (ffetch CMLMOD# of ARRAY))))))))
(\ASETLINEAR
(LAMBDA (VAL ARRAY I) (* JonL "30-SEP-83 22:15")
(PROG ((ANCHOR (ffetch CMLANCHOR of ARRAY))
(A.E.TYPE (ffetch CMLAETYPE of ARRAY)))
(if (IGEQ \AT.MOD.BIT A.E.TYPE)
then (SELECTC A.E.TYPE
(\AT.POINTER (\WORDSET.PTR VAL ANCHOR I))
(\AT.BYTE (SETQ VAL (LOADBYTE VAL 0 BITSPERBYTE))
(\WORDSET.8 VAL ANCHOR I))
((LIST \AT.WORD \AT.DOUBLEBYTE)
(SETQ VAL (SELECTQ (SYSTEMTYPE)
(D (LOADBYTE VAL 0 BITSPERWORD))
(LOADBYTE VAL 0 (CONSTANT (TIMES 2 BITSPERBYTE)))))
(\WORDSET.16 VAL ANCHOR I))
(\AT.BIT (SETQ VAL (LOADBYTE VAL 0 1))
(\WORDSET.1 VAL ANCHOR I))
(\AT.NIBBLE (SETQ VAL (LOADBYTE VAL 0 BITSPERNIBBLE))
(\WORDSET.4 VAL ANCHOR I))
(\AT.XPOINTER (\WORDSET.XPTR VAL ANCHOR I))
(\AT.FIXP (SETQ VAL (IPLUS 0 VAL))
(\WORDSET.FIXP VAL ANCHOR I))
(\AT.FLOATP (SETQ VAL (IPLUS 0.0 VAL))
(\WORDSET.FLOATP VAL ANCHOR I))
(SHOULDNT))
else (* A.E.TYPE will now have the number of bits per
element)
(\PUTBASEBITS ANCHOR (ITIMES I (SETQ A.E.TYPE (BITCLEAR A.E.TYPE \AT.MOD.BIT)))
A.E.TYPE
(SETQ VAL (if (ffetch CMLMOD#P2P of ARRAY)
then (LOADBYTE VAL 0 A.E.TYPE)
else (IMOD VAL (ffetch CMLMOD# of ARRAY))))))
(RETURN VAL))))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS ARRAYRANK MACRO ((CMLARRAY)
(fetch CMLRANK of CMLARRAY)))
(PUTPROPS ARRAYDIMENSIONS MACRO (X
(if (AND X (NULL (CDR X)))
then (LIST (QUOTE fetch)
(QUOTE CMLDIML)
(CAR X))
else (QUOTE IGNOREMACRO))))
(PUTPROPS ARRAYDIMENSION MACRO ((CMLARRAY AXIS#)
(CAR (NTH (fetch CMLDIML of CMLARRAY)
(ADD1 AXIS#)))))
)
(DEFINEQ
(ARRAYRANK
(LAMBDA (CMLARRAY) (* JonL "25-SEP-83 22:36")
(\MACRO.MX (ARRAYRANK CMLARRAY))))
(ARRAYDIMENSIONS
(LAMBDA (CMLARRAY OPTIONS) (* JonL "30-SEP-83 21:56")
(SETQ CMLARRAY (DATATYPE.TEST CMLARRAY (QUOTE CMLARRAY)))
(OR (NULL OPTIONS)
(LISTP OPTIONS)
(SETQ OPTIONS (LIST OPTIONS)))
((LAMBDA (L)
(if (AND OPTIONS (MEMB (QUOTE NOCOPY)
OPTIONS))
then L
else (COPY L)))
(ffetch CMLDIML of CMLARRAY))))
(ARRAYDIMENSION
(LAMBDA (CMLARRAY AXIS#) (* JonL "23-SEP-83 21:14")
(\MACRO.MX (ARRAYDIMENSION CMLARRAY (COND
((AND (\INDEXABLE.FIXP AXIS#)
(ILESSP AXIS# (ARRAYRANK CMLARRAY)))
AXIS#)
((ERRORX (LIST 27 AXIS#))))))))
(ARRAYELEMENTTYPE
(LAMBDA (CMLARRAY) (* JonL "30-SEP-83 22:17")
(SETQ CMLARRAY (DATATYPE.TEST CMLARRAY (QUOTE CMLARRAY)))
((LAMBDA (J)
(if (IGEQ \AT.MOD.BIT J)
then (SELECTC J
(\AT.POINTER T)
(\AT.BYTE (QUOTE (MOD 256)))
((LIST \AT.WORD \AT.DOUBLEBYTE)
(QUOTE (MOD 65536)))
(\AT.BIT (QUOTE (MOD 2)))
(\AT.NIBBLE (QUOTE (MOD 16)))
(\AT.FIXP (QUOTE FIXNUM))
(\AT.FLOATP (QUOTE FLONUM))
(\AT.XPOINTER (QUOTE XPOINTER))
(SHOULDNT))
else (ffetch CMLMOD# of CMLARRAY)))
(ffetch CMLAETYPE of CMLARRAY))))
(ARRAYINBOUNDSP
(LAMBDA NARGS (* JonL "25-SEP-83 22:33")
(AND (ZEROP NARGS)
(HELP))
(PROG ((CMLARRAY (ARG NARGS 1)))
(OR (EQ NARGS (ADD1 (ARRAYRANK CMLARRAY)))
(ERROR "Rank Mismatch"))
(RETURN (NOT (find I in (ffetch CMLDIML of CMLARRAY) as K from 2
suchthat (OR (IGREATERP 0 (ARG NARGS K))
(ILEQ I (ARG NARGS K)))))))))
(ARRAYTOTALSIZE
(LAMBDA (CMLARRAY IN.BITS?) (* JonL "30-SEP-83 22:15")
(SETQ CMLARRAY (DATATYPE.TEST CMLARRAY (QUOTE CMLARRAY)))
((LAMBDA (N)
(if IN.BITS?
then (ITIMES ((LAMBDA (TYPE)
(if (IGEQ TYPE \AT.MOD.BIT)
then (BITCLEAR TYPE \AT.MOD.BIT)
else (SELECTC TYPE
(\AT.POINTER BITSPERCELL)
(\AT.BYTE BITSPERBYTE)
((LIST \AT.DOUBLEBYTE \AT.WORD)
(CONSTANT (TIMES 2 BITSPERBYTE)))
(\AT.BIT 1)
(\AT.NIBBLE BITSPERNIBBLE)
BITSPERCELL)))
(ffetch CMLAETYPE of CMLARRAY))
N)
else N))
(if (OR IN.BITS? (ZEROP (ffetch CMLALIGN of CMLARRAY)))
then (ADD1 (ffetch CMLIMAX of CMLARRAY))
else (APPLY (FUNCTION ITIMES)
(ffetch CMLDIML of CMLARRAY))))))
(ARRAYROWMAJORINDEX
(LAMBDA NARGS (* JonL "30-SEP-83 21:48")
(OR (IGEQ NARGS 1)
(ERROR (QUOTE Too% few% args)))
(PROG ((ARRAY (DATATYPE.TEST (ARG NARGS 1)
(QUOTE CMLARRAY))))
(if (NEQ NARGS (ADD1 (ffetch CMLRANK of ARRAY)))
then (ERROR ARRAY (QUOTE Array% Rank% Mismatch))
else (RETURN (\AREFSET.LINEARIZE ARRAY 2 NARGS))))))
)
(PUTPROPS MAKEARRAY ARGNAMES
(INDICESLST (KEYWORDNAMES: ELEMENTTYPE INITIALELEMENT INITIALCONTENTS DISPLACEDTO
DISPLACEDINDEXOFFSET)))
(PUTPROPS AREF ARGNAMES
(CMLARRY ...indices...))
(PUTPROPS ASET ARGNAMES
(NEWVALUE CMLARRY ...indices...))
(PUTPROPS ARRAYINBOUNDSP ARGNAMES
(CMLARRY ...indices...))
(PUTPROPS ADJUSTARRAY ARGNAMES
(CMLARRAY DIMENSIONSLST))
(* The "fast" versions of AREF and ASET -- following P causes them all to be set up as macros)
(DECLARE: EVAL@COMPILE
((LAMBDA (C)
(MAPC (QUOTE (P X 1 4 8 16 N L))
(FUNCTION (LAMBDA (A)
(MAPC (QUOTE (AREF ASET))
(FUNCTION (LAMBDA (B)
(SETQ C (MKATOM (CONCAT "\" A B)))
(PUTPROP (MKATOM (CONCAT A B))
(QUOTE MACRO)
(LIST (QUOTE X)
(LIST (MKATOM (CONCAT "\Fast"
B
"expander"))
(QUOTE X)
(LIST (QUOTE QUOTE)
C))))
(PUTPROP C (QUOTE MACRO)
(LIST (QUOTE X)
(LIST (MKATOM (CONCAT
"\NoSissy"
B
"expander"))
(QUOTE X)
(LIST (QUOTE QUOTE)
C))))))))))))
)
(DEFINEQ
(\FastAREFexpander
(LAMBDA (X FFUN) (* JonL " 1-JUL-83 19:49")
(LIST (QUOTE COND)
(LIST (QUOTE AREFSissyFLG)
(CONS (QUOTE AREF)
X))
(LIST (if (NLISTP X)
then (ERROR (QUOTE Too% few% args))
elseif (NLISTP (CDR X))
then (LIST (QUOTE fetch)
(QUOTE (CMLARRAY CMLANCHOR))
(QUOTE of)
(CAR X))
else (\NoSissyAREFexpander X FFUN T))))))
(\NoSissyAREFexpander
(LAMBDA (X FFUN CHECKFLG) (* JonL "20-SEP-83 21:46")
(PROG ((ACCESSOR (OR (CADR (ASSOC (SUBATOM FFUN 2)
(QUOTE ((PAREF \VectorREF)
(8AREF \WORDREF.8)
(16AREF \WORDREF.16)
(4AREF \WORDREF.4)
(1AREF \WORDREF.1)
(NAREF \WORDREF.FIXP)
(LAREF \WORDREF.FLOATP)
(XAREF \WORDREF.PTR)))))
(SHOULDNT)))
(ARRAYFORM (LISPFORM.SIMPLIFY (CAR X)
T))
(INDICES (for Y in (CDR X) collect (LISPFORM.SIMPLIFY Y T)))
ACCESSFORM)
(SETQ ACCESSFORM (LIST (PROG1 ACCESSOR (* Comment PPLossage))
(if CHECKFLG
then (QUOTE (ffetch (CMLARRAY CMLANCHOR)
of
(DATATYPE.TEST \Array (QUOTE CMLARRAY))))
else (QUOTE (fetch (CMLARRAY CMLANCHOR)
of \Array)))
(\AREFSET.INDEXFORM INDICES)))
(if (AND (NLISTP ARRAYFORM)
(ARGS.COMMUTABLEP.LIST INDICES ARRAYFORM))
then (SETQ ACCESSFORM (SUBST ARRAYFORM (QUOTE \Array)
ACCESSFORM))
else (SETQ ACCESSFORM (LIST (LIST (QUOTE LAMBDA)
(QUOTE (\Array))
(QUOTE (DECLARE (LOCALVARS \Array)))
ACCESSFORM)
ARRAYFORM)))
(RETURN ACCESSFORM))))
(\FastASETexpander
(LAMBDA (X FFUN) (* JonL " 2-JUL-83 00:46")
(if (OR (NLISTP X)
(NLISTP (CDR X)))
then (ERROR (QUOTE Too% few% args)))
(LIST (QUOTE COND)
(LIST (QUOTE AREFSissyFLG)
(CONS (QUOTE ASET)
X))
(LIST (if (NLISTP (CDDR X))
then (* Aha! 0-dimensional.)
(CONS (QUOTE \0DIM.ASET)
(CONS (KWOTE (SUBATOM FFUN 2))
X))
else (\NoSissyASETexpander X FFUN T))))))
(\NoSissyASETexpander
(LAMBDA (X FFUN CHECKFLG VAL.LAST.P) (* JonL "30-SEP-83 23:34")
(PROG ((FUN (SUBATOM FFUN 2))
(NEWVALFORM (LISPFORM.SIMPLIFY (CAR X)
T))
(ARRAYFORM (LISPFORM.SIMPLIFY (CADR X)
T))
(INDICES (for Y in (CDDR X) collect (LISPFORM.SIMPLIFY Y T)))
SETTORNAME SETTINGFORM SIMPLEINDEXP SIMPLEARRAYP TEM)
(SETQ SETTORNAME (OR (CADR (ASSOC FUN (if VAL.LAST.P
then (QUOTE ((PASET \VectorSet)
(8ASET \PUTBASEBYTE)
(16ASET \PUTBASE)
(1ASET \PUTBASEBIT)
(4ASET \PUTBASENIBBLE)
(NASET \PUTBASEFIXP)
(LASET \PUTBASEFLOATP)
(XASET \PUTBASEPTR)))
else (QUOTE ((PASET \WORDSET.PTR)
(8ASET \WORDSET.8)
(16ASET \WORDSET.16)
(1ASET \WORDSET.1)
(4ASET \WORDSET.4)
(NASET \WORDSET.FIXP)
(LASET \WORDSET.FLOATP)
(XASET \WORDSET.XPTR))))))
(SHOULDNT)))
(SETQ SETTINGFORM (CONS SETTORNAME (QUOTE (\NewVal (ffetch (CMLARRAY CMLANCHOR)
of \Array)
(IPLUS (ffetch (CMLARRAY CMLANCHOROFFSET)
of \Array)
\Index)))))
(if CHECKFLG
then (SETQ SETTINGFORM (LIST (QUOTE PROGN)
(LIST (QUOTE AND)
(QUOTE (OR (ILESSP \Index 0)
(IGREATERP \Index
(ffetch (CMLARRAY CMLIMAX)
of (DATATYPE.TEST
\Array
(QUOTE CMLARRAY))))))
(LIST (QUOTE ERROR)
(QUOTE \Array)
(KWOTE FFUN)))
SETTINGFORM)))
(SETQ TEM T)
(if (OR (NOT CHECKFLG)
(AND (NULL (CDR INDICES))
(OR (CONSTANTEXPRESSIONP (CAR INDICES))
(AND (NLISTP (CAR INDICES))
(SETQ TEM (ARGS.COMMUTABLEP ARRAYFORM (CAR INDICES)))))))
then (* 1-dim case, where index commutes with array)
(SETQ SIMPLEINDEXP T))
(if (if (NLISTP ARRAYFORM)
then (ARGS.COMMUTABLEP.LIST INDICES ARRAYFORM)
else (CONSTANTEXPRESSIONP ARRAYFORM))
then (SETQ SIMPLEARRAYP T)
elseif (NULL TEM)
then (* TEM will remain T unless the index for the 1-dim case
is a single variable which didn't quite commute with the
array)
(SETQ SIMPLEINDEXP T))
(SETQ SETTINGFORM (if SIMPLEINDEXP
then (SUBST (\AREFSET.INDEXFORM INDICES T)
(QUOTE \Index)
SETTINGFORM)
else (LIST (LIST (QUOTE LAMBDA)
(QUOTE (\Index))
(QUOTE (DECLARE (LOCALVARS \Index)))
SETTINGFORM)
(\AREFSET.INDEXFORM INDICES T))))
(if SIMPLEARRAYP
then (SETQ SETTINGFORM (SUBST ARRAYFORM (QUOTE \Array)
SETTINGFORM))
else (SETQ SETTINGFORM (LIST (LIST (QUOTE LAMBDA)
(QUOTE (\Array))
(QUOTE (DECLARE (LOCALVARS \Array)))
SETTINGFORM)
ARRAYFORM)))
(if (OR (CONSTANTEXPRESSIONP NEWVALFORM)
(AND (ARGS.COMMUTABLEP NEWVALFORM ARRAYFORM)
(ARGS.COMMUTABLEP.LIST INDICES NEWVALFORM)))
then (SETQ SETTINGFORM (SUBST NEWVALFORM (QUOTE \NewVal)
SETTINGFORM))
else (SETQ SETTINGFORM (LIST (LIST (QUOTE LAMBDA)
(QUOTE (\NewVal))
(QUOTE (DECLARE (LOCALVARS \NewVal)))
SETTINGFORM)
NEWVALFORM)))
(RETURN SETTINGFORM))))
(\AREFSET.INDEXFORM
(LAMBDA (INDICES NOANCHOROFFSETFLG) (* JonL " 1-JUL-83 22:23")
(* INDICES is a list whose elements should have already
been THROUGH LISPFORM.SIMPLIFY)
(if (NLISTP (CDR INDICES))
then (* Aha! 1-dimensional)
(SETQ INDICES (CAR INDICES))
else (bind (MARGINACCFORM ←(QUOTE (ffetch (CMLARRAY CMLMARGINS)
of \Array)))
for I in INDICES
do (* First, compose the chain of accesses through the
margin arrays, if any.)
(SETQ MARGINACCFORM (LIST (QUOTE \VectorREF)
MARGINACCFORM I))
finally (SETQ INDICES (CONS (QUOTE IPLUS)
(CDR MARGINACCFORM)))))
(if NOANCHOROFFSETFLG
then INDICES
else (LIST (QUOTE IPLUS)
(QUOTE (ffetch (CMLARRAY CMLANCHOROFFSET)
of \Array))
INDICES))))
(\CMLARRAY.LOCFTRAN
(LAMBDA (X) (* JonL " 1-JUL-83 20:07")
((LAMBDA (NAME MACP)
(if (AND (LISTP X)
(NNLITATOM (SETQ NAME (CAR X)))
(LISTP (SETQ MACP (GETP NAME (QUOTE MACRO))))
(EQ (CAR MACP)
(QUOTE X))
(NULL (CDDR MACP))
(LISTP (SETQ MACP (CADR MACP)))
(FMEMB (CAR MACP)
(QUOTE (\FastAREFexpander \FastASETexpander))))
then (PROG ((ARRAYFORM (LISPFORM.SIMPLIFY (CADR X)
T))
(INDICES (for Z in (CDDR X) collect (LISPFORM.SIMPLIFY Z T)))
(NBITS (SUBATOM (CADR (CADDR MACP))
2 -5))
(BASEFORM (QUOTE (fetch (\CMLARRAY CMLANCHOR)
of \Array)))
OFFSETFORM POINTERBYTEP LVARS LVALS)
(SETQ OFFSETFORM (\AREFSET.INDEXFORM INDICES))
(SELECTQ NBITS
(P (SETQ POINTERBYTEP T))
((X N L)
(SETQ NBITS BITSPERCELL)
(SETQ OFFSETFORM (LIST (QUOTE LLSH)
OFFSETFORM
(CONSTANT (SUB1 (INTEGERLENGTH BITSPERCELL)))
)))
(1 OFFSETFORM)
((16 4 8)
(SETQ OFFSETFORM (LIST (QUOTE LLSH)
OFFSETFORM
(SUB1 (INTEGERLENGTH NBITS)))))
(SHOULDNT))
(if (AND (NLISTP ARRAYFORM)
(ARGS.COMMUTABLEP.LIST INDICES ARRAYFORM))
then (SETQ BASEFORM (SUBST ARRAYFORM (QUOTE \Array)
BASEFORM))
(SETQ OFFSETFORM (SUBST ARRAYFORM (QUOTE \Array)
OFFSETFORM))
else (SETQ LVARS (LIST (QUOTE \Array)))
(SETQ LVALS (LIST ARRAYFORM)))
(RETURN (if POINTERBYTEP
then (LIST (QUOTE \POINTERBYTE)
LVARS LVALS BASEFORM OFFSETFORM)
else (LIST (QUOTE \BITSBYTE)
LVARS LVALS BASEFORM OFFSETFORM NBITS)))))))))
)
(RPAQ? AREFSissyFLG NIL)
(PUTPROPS AREFSissyFLG GLOBALVAR T)
(DEFINEQ
(LISTARRAY
(LAMBDA (CMLARRAY STARTI ENDI) (* JonL "30-SEP-83 22:15")
(SETQ CMLARRAY (DATATYPE.TEST CMLARRAY (QUOTE CMLARRAY)))
(PROG ((A.E.TYPE (ffetch CMLAETYPE of CMLARRAY))
(ANCHOR (ffetch CMLANCHOR of CMLARRAY))
(OFFST (ffetch CMLANCHOROFFSET of CMLARRAY))
(IMAX (ffetch CMLIMAX of CMLARRAY))
#ELTS CELLP MODP TEM)
(if (NULL STARTI)
then (SETQ STARTI 0)
else (\CHECKTYPE STARTI (FUNCTION \INDEXABLE.FIXP)))
(if (NULL ENDI)
then (SETQ ENDI IMAX)
else (\CHECKTYPE ENDI (FUNCTION \INDEXABLE.FIXP)))
(SETQ #ELTS (IDIFFERENCE IMAX (SUB1 STARTI)))
(if (IGEQ A.E.TYPE \AT.MOD.BIT)
then (SETQ MODP (BITCLEAR A.E.TYPE \AT.MOD.BIT))
else (SETQ CELLP (SELECTC A.E.TYPE
((LIST \AT.POINTER \AT.XPOINTER \AT.FIXP \AT.FLOATP)
T)
NIL)))
(if (OR (ILESSP #ELTS 0)
(IGREATERP #ELTS (ADD1 IMAX)))
then (ERROR "OUT OF RANGE"))
(add STARTI OFFST)
(add ENDI OFFST)
(RETURN (for I from STARTI to ENDI collect (if CELLP
then (SELECTC A.E.TYPE
(\AT.POINTER (\VectorREF
ANCHOR I))
(\AT.XPOINTER (\WORDREF.PTR
ANCHOR I))
(\AT.FIXP (\WORDREF.FIXP
ANCHOR I))
(\AT.FLOATP (\WORDREF.FLOATP
ANCHOR I))
(SHOULDNT))
elseif MODP
then (SETQ TEM (\GETBASEBITS ANCHOR
(ITIMES I MODP)
MODP))
(if (ffetch CMLMOD#P2P of CMLARRAY)
then TEM
else (IMOD TEM (ffetch CMLMOD#
of CMLARRAY)))
else (SELECTC A.E.TYPE
(\AT.BYTE (\WORDREF.8 ANCHOR I))
((LIST \AT.WORD \AT.DOUBLEBYTE)
(\WORDREF.16 ANCHOR I))
(\AT.NIBBLE (\WORDREF.4 ANCHOR I)
)
(\AT.BIT (\WORDREF.1 ANCHOR I))
(SHOULDNT))))))))
(FILLARRAY
(LAMBDA (CMLARRAY LIST STARTI ENDI) (* JonL "30-SEP-83 23:13")
(SETQ CMLARRAY (DATATYPE.TEST CMLARRAY (QUOTE CMLARRAY)))
(OR (LISTP LIST)
(SETQ LIST (LIST LIST)))
(PROG ((A.E.TYPE (ffetch CMLAETYPE of CMLARRAY))
(ANCHOR (ffetch CMLANCHOR of CMLARRAY))
(OFFST (ffetch CMLANCHOROFFSET of CMLARRAY))
(IMAX (ffetch CMLIMAX of CMLARRAY))
(ITEM (CAR LIST))
CELLP MODP #ELTS TEM)
(if (NULL STARTI)
then (SETQ STARTI 0)
else (\CHECKTYPE STARTI (FUNCTION \INDEXABLE.FIXP)))
(if (NULL ENDI)
then (SETQ ENDI IMAX)
else (\CHECKTYPE ENDI (FUNCTION \INDEXABLE.FIXP)))
(SETQ #ELTS (IDIFFERENCE IMAX (SUB1 STARTI)))
(if (IGEQ A.E.TYPE \AT.MOD.BIT)
then (SETQ MODP (BITCLEAR A.E.TYPE \AT.MOD.BIT))
else (SETQ CELLP (SELECTC (ffetch CMLAETYPE of CMLARRAY)
((LIST \AT.POINTER \AT.XPOINTER \AT.FIXP \AT.FLOATP)
T)
NIL)))
(if (OR (ILESSP #ELTS 0)
(IGREATERP #ELTS (ADD1 IMAX)))
then (ERROR "OUT OF RANGE"))
(add STARTI OFFST)
(add ENDI OFFST)
(for I from STARTI to ENDI
do
(if CELLP
then (SELECTC A.E.TYPE
(\AT.POINTER (\WORDSET.PTR ITEM ANCHOR I))
(\AT.XPOINTER (\WORDSET.XPTR ITEM ANCHOR I))
(\AT.FIXP (\WORDSET.FIXP ITEM ANCHOR I))
(\AT.FLOATP (\WORDSET.FLOATP ITEM ANCHOR I))
(SHOULDNT))
elseif MODP
then (\PUTBASEBITS ANCHOR (ITIMES I MODP)
MODP
(if (ffetch CMLMOD#P2P of CMLARRAY)
then (LOADBYTE ITEM 0 MODP)
else (IMOD ITEM (ffetch CMLMOD# of CMLARRAY))))
elseif (SELECTQ (SYSTEMTYPE)
(D (AND (NULL (CDR LIST))
(SELECTC A.E.TYPE
(\AT.BYTE (AND (EVENP I BYTESPERWORD)
(ILEQ BYTESPERWORD (IDIFFERENCE
ENDI I))))
((LIST \AT.WORD \AT.DOUBLEBYTE)
T)
(\AT.NIBBLE (AND (EVENP I BITSPERNIBBLE)
(ILEQ BITSPERNIBBLE
(IDIFFERENCE ENDI I))))
(\AT.BIT (AND (EVENP I BITSPERWORD)
(ILEQ BITSPERWORD (IDIFFERENCE ENDI I))
))
NIL)))
NIL)
then (* Do a word's worth at a time, but only on the D
machines.)
(SELECTQ
(SYSTEMTYPE)
(D (PROG (I'S WDOFFST WORD BLOCK#WDS)
(SETQ WORD
(SELECTC A.E.TYPE
(\AT.BYTE (SETQ WDOFFST (FOLDLO I BYTESPERWORD))
(SETQ BLOCK#WDS (IDIFFERENCE (ADD1 (FOLDLO ENDI
BYTESPERWORD))
WDOFFST))
(SETQ I'S (UNFOLD BLOCK#WDS BYTESPERWORD))
(ITIMES ITEM (CONSTANT (LOGOR 1 (LLSH 1
BITSPERBYTE)))))
((LIST \AT.WORD \AT.DOUBLEBYTE)
(SETQ WDOFFST I)
(SETQ BLOCK#WDS (IDIFFERENCE (ADD1 ENDI)
I))
(SETQ I'S BLOCK#WDS)
ITEM)
(\AT.NIBBLE (SETQ WDOFFST (FOLDLO I BITSPERNIBBLE))
(SETQ BLOCK#WDS (IDIFFERENCE
(ADD1 (FOLDLO ENDI BITSPERNIBBLE))
WDOFFST))
(SETQ I'S (UNFOLD BLOCK#WDS BITSPERNIBBLE))
(ITIMES
ITEM
(CONSTANT (for I to BITSPERNIBBLE
sum (LLSH 1 (TIMES BITSPERNIBBLE
(SUB1 I)))))))
(\AT.BIT (SETQ WDOFFST (FOLDLO I BITSPERWORD))
(SETQ BLOCK#WDS (IDIFFERENCE (ADD1 (FOLDLO ENDI
BITSPERWORD))
WDOFFST))
(SETQ I'S (UNFOLD BLOCK#WDS BITSPERWORD))
(if (ZEROP ITEM)
then 0
else (CONSTANT (MASK.1'S 0 BITSPERWORD))))
(SHOULDNT)))
(FRPTQ BLOCK#WDS (\PUTBASE ANCHOR WDOFFST WORD)
(add WDOFFST 1))
(add I (SUB1 I'S))))
NIL)
else (SELECTC A.E.TYPE
(\AT.BYTE (\WORDSET.8 ITEM ANCHOR I))
((LIST \AT.WORD \AT.DOUBLEBYTE)
(\WORDSET.16 ITEM ANCHOR I))
(\AT.NIBBLE (\WORDSET.4 ITEM ANCHOR I))
(\AT.BIT (\WORDSET.1 ITEM ANCHOR I))
(SHOULDNT)))
(pop LIST)
(if LIST
then (SETQ ITEM (CAR LIST))))
(RETURN CMLARRAY))))
(\PRINTCMLARRAY
(LAMBDA (VARORVAL FILE) (* JonL " 1-JUL-83 22:25")
(PROG ((A VARORVAL))
(AND A (LITATOM A)
(SETQ A (EVALV A)))
(OR (type? CMLARRAY A)
(ERRORX (LIST 27 VARORVAL)))
(PRIN1 "(" FILE)
(PRINT (LIST (ffetch CMLDIML of A)
(ARRAYELEMENTTYPE A)
(ffetch CMLALIGN of A))
FILE)
(PRINT (LISTARRAY A)
FILE)
(PRIN1 ")" FILE)
(TERPRI FILE))))
(\READCMLARRAY
(LAMBDA (FILE) (* JonL "27-APR-83 02:22")
(PROG ((L (READ FILE))
TEM)
(OR (AND (EQ 3 (LENGTH (SETQ TEM (CAR (LISTP L)))))
(OR (NULL (CAR TEM))
(LISTP (CAR TEM))))
(ERROR L "Wrong object read in"))
(SETQ TEM (MAKEARRAY (CAR TEM)
(QUOTE ELEMENTTYPE)
(CADR TEM)
(QUOTE ALIGNMENT)
(CADDR TEM)))
(FILLARRAY TEM (CADR L))
(RETURN TEM))))
)
(PUTDEF (QUOTE CMLARRAYS) (QUOTE FILEPKGCOMS) (QUOTE
((COM MACRO
(X (E (MAPC (QUOTE X)
(FUNCTION (LAMBDA (VAR)
(PRIN1 "(RPAQ ")
(PRIN2 VAR)
(PRIN1
"(\READCMLARRAY))")
(TERPRI)
(\PRINTCMLARRAY
VAR))))))))))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA ARRAYROWMAJORINDEX ARRAYINBOUNDSP ASET AREF ADJUSTARRAY MAKEARRAY
\NONDADDARITH.TRAMPOLINE)
)
(PUTPROPS CMLARRAY COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (9994 10681 (\BubbleWORDSET 10004 . 10679)) (10715 11402 (\BubbleWORDSET 10725 . 11400))
(11671 12493 (\NONDADDARITH.TRAMPOLINE 11681 . 12491)) (13112 26940 (MAKEARRAY 13122 . 22051) (
\CML.ICP.CHECK 22053 . 22372) (\MARGINTO 22374 . 23269) (ADJUSTARRAY 23271 . 26938)) (26941 28528 (
AREF 26951 . 27562) (ASET 27564 . 28526)) (31374 34894 (\AREF.1 31384 . 31604) (\ASET.1 31606 . 31830)
(\AREF.2 31832 . 32054) (\ASET.2 32056 . 32282) (\AREFLINEAR 32284 . 33384) (\ASETLINEAR 33386 .
34892)) (35309 38618 (ARRAYRANK 35319 . 35468) (ARRAYDIMENSIONS 35470 . 35881) (ARRAYDIMENSION 35883
. 36178) (ARRAYELEMENTTYPE 36180 . 36830) (ARRAYINBOUNDSP 36832 . 37292) (ARRAYTOTALSIZE 37294 .
38178) (ARRAYROWMAJORINDEX 38180 . 38616)) (39866 48575 (\FastAREFexpander 39876 . 40350) (
\NoSissyAREFexpander 40352 . 41681) (\FastASETexpander 41683 . 42226) (\NoSissyASETexpander 42228 .
45811) (\AREFSET.INDEXFORM 45813 . 46854) (\CMLARRAY.LOCFTRAN 46856 . 48573)) (48649 56116 (LISTARRAY
48659 . 50809) (FILLARRAY 50811 . 55065) (\PRINTCMLARRAY 55067 . 55595) (\READCMLARRAY 55597 . 56114))
)))
STOP