;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ****** ARRAY PACKAGE ***************************
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************



	PGBOT ARA


SUBTTL	ARRAY PACKAGE

IFN SFA,	QSFA
IFN JOBQIO,	QJOB		;THESE ENTRIES USED ONLY
		QFILE		; BY ARRAYDIMS FUNCTION
ARYTP1:	AS.RDT+AS.FX,,QREADTABLE	;READTABLE
	AS.OBA+AS.SX+AS.GCP,,QOBARRAY	;OBARRAY
NPARTP==.-ARYTP1	;# OF PECULIAR ARRAY TYPES
DX$	AS.DX,,QDUPLEX			;DUPLEX
DX%	-1
CX$	AS.CX,,QCOMPLEX			;COMPLEX
CX%	-1
DB$	AS.DB,,QDOUBLE			;DOUBLE
DB%	-1
	AS.SX+AS.GCP,,TRUTH		;S-EXPRESSION
	AS.FX,,QFIXNUM			;FIXNUM
	AS.FL,,QFLONUM			;FLONUM
	AS.SX,,NIL			;NSTORE-TYPE
LARYTP==.-ARYTP1
ARYTYP==ARYTP1-.LZ (AS.RDT),	.SEE ADIMS	;FOR JFFO'S ON THE BITS

;;; TABLE OF EXTRA INSTRUCTIONS FOR ARRAY HEADER.
;;; ENTRIES ARE ZERO IF NO INSTRUCTION NEEDED.
;;; ENTRIES ARE NEGATIVE FOR AN ILLEGAL ARRAY TYPE.
;;; (NOTE THAT THE OPCODE  PUSH  IS POSITIVE.)

ARYIN1:	0			;READTABLE
	0			;OBARRAY
TBLCHK ARYIN1,NPARTP
DX$	PUSH P,CDUPL1		;DUPLEX
DX%	-1
CX$	PUSH P,CCMPL1		;COMPLEX
CX%	-1
DB$	PUSH P,CDBL1		;DOUBLE
DB%	-1
	0			;S-EXPRESSION
	PUSH P,CFIX1		;FIXNUM
	PUSH P,CFLOAT1		;FLONUM
	0			;NSTORE-TYPE
TBLCHK ARYIN1,LARYTP

;;; <ADDRESS OF SUBSCRIPT INSTRUCTION TABLE>,,<MULTIPLIER>
;;; THE MULTIPLIER IS USED TO ADJUST FOR THE NUMBER OF WORDS
;;; OCCUPIED BY EACH ELEMENT.

ARYIN2:	DIMFTB,,1		;READTABLE
	DIMSTB,,1		;OBARRAY
TBLCHK ARYIN2,NPARTP
DX$	DIMZTB,,4		;DUPLEX
DX%	0
CX$	DIMDTB,,2		;COMPLEX
CX%	0
DB$	DIMDTB,,2		;DOUBLE
DB%	0
	DIMSTB,,1		;S-EXPRESSION
	DIMFTB,,1		;FIXNUM
	DIMFTB,,1		;FLONUM
	DIMSTB,,1		;NSTORE-TYPE
TBLCHK ARYIN2,LARYTP

;;; TABLES OF INSTRUCTIONS FOR CALLING ARRAY SUBSCRIPT
;;; CALCULATION ROUTINES. DIMSTB IS FOR S-EXPRESSION
;;; ARRAYS, AND DIMFTB FOR FULL-WORD ARRAYS.

DIMSTB:	JSP TT,1DIMS	;TABLE OF <N>DIMS'S
	JSP TT,2DIMS
	JSP TT,3DIMS
	JSP TT,4DIMS
	JSP TT,5DIMS

DIMFTB:	JSP TT,1DIMF	;TABLE OF <N>DIMF'S
	JSP TT,2DIMF
	JSP TT,3DIMF
	JSP TT,4DIMF
	JSP TT,5DIMF

IFN DBFLAG+CXFLAG,[
DIMDTB:	JSP TT,1DIMD
	JSP TT,2DIMD
	JSP TT,3DIMD
	JSP TT,4DIMD
	JSP TT,5DIMD
]		;END OF IFN DBFLAG+CXFLAG

IFN DXFLAG,[
DIMZTB:	JSP TT,1DIMZ
	JSP TT,2DIMZ
	JSP TT,3DIMZ
	JSP TT,4DIMZ
	JSP TT,5DIMZ
]		;END OF IFN DXFLAG

SUBTTL	ARRAY AND *ARRAY FUNCTIONS

TTDEAD=BPURPG(TT)
TTDEDC=TTDEAD+<TTS<CN>,,>

ARRAY:	JSP TT,FWNACK		;FSUBR
	FA234567,,QARRAY
	JSP TT,KLIST		;LIKE *ARRAY, BUT FIRST TWO
	SUBI T,2		; ARGS NOT EVALUATED
	JRST ARRY0

%%ARRAY:
	JSP TT,LWNACK		;LSUBR (2 . 7)
	LA234567,,Q%%ARRAY
ARRY0:	MOVEI TT,(P)
	ADDI TT,(T)		;TT POINTS TO BELOW ARGS ON PDL
	HRRZ A,2(TT)
ARRY0B:	MOVSI F,-LARYTP		;CHECK OUT ARRAY TYPE
ARRY0C:	HRRZ B,ARYTP1(F)
	CAIN B,(A)
	 JRST ARRY0F
	AOBJN F,ARRY0C
	WTA [BAD ARRAY TYPE - *ARRAY!]
	MOVEM A,2(TT)
	JRST ARRY0B

ARRY0F:	TLZ F,-1		;F HAS ARRAY TYPE (INDEX INTO ARYTP1)
	CAIL F,NPARTP		;SKIP IF PECULIAR ARRAY TYPE
	 JRST ARRY2
	CAML T,XC-3
	 JRST ARRY1
ARRY0G:	MOVEI D,Q%%ARRAY		;WRONG NUMBER OF ARGS - LOSEY LOSEY
	JRST WNALOSE

ARRY1:	HRRZ AR2A,ARRYQ1(F)	;DEFAULT ARRAY TO COPY FROM
	CAML T,XC-2
	 SOJA T,ARRY1F		;T REFLECTS # OF DIMS
	POP P,A			;GET THIRD ARG
ARRY1A:	HLRZ AR2A,ARRYQ2(F)	;ARRAY TO COPY FROM IF NIL
	JUMPE A,ARRY1F
	HRRZ AR2A,ARRYQ2(F)	;ARRAY TO COPY FROM IF T
	CAIN A,TRUTH
	 JRST ARRY1F
	MOVEI C,(A)		;THIRD ARG BETTER BE AN ARRAY ITSELF
	MOVEI D,(T)
	PUSHJ P,AREGET		; TO COPY NEW ONE FROM
	MOVEI T,(D)
	HLLZ TT,ARRYQ1(F)	;SUPPLIED ARRAY BETTER BE
	TDNE TT,ASAR(A)		; OF CORRECT TYPE
	 JRST ARRY1D
	MOVEI A,(C)
	%WTA ARRYQ0(F)		;IF NOT, LOSEY LOSEY
	JRST ARRY1A

ARRYQ0:	SIXBIT \NOT READTABLE - *ARRAY!\
	SIXBIT \NOT OBARRAY - *ARRAY!\

ARRYQ1:	AS.RDT,,VREADTABLE	;REQUIRED BIT,,NO ARG DEFAULT
	AS.OBA,,VOBARRAY

ARRYQ2:	VREADTABLE,,[PRDTBL]
	VNIL,,VOBARRAY

ARRYQ3:	0,,2*LRCT			;MAX INDEX+1,,LENGTH OF DATA
	OBTSIZ+1+200,,OBTSIZ+1+200	;FOOEY - GLS

ARRYQ4:	-1,,3			;STANDARD GC AOBJN POINTER:
	-<OBTSIZ+1>/2,,3	; -<LENGTH IN WDS>,,<REL POS OF DATA>


ARRY1D:	SKIPA AR2A,A
ARRY1F:	 HRRZ AR2A,(AR2A)	;AR2A HAS SAR OF ARRAY TO COPY FROM
	MOVNI AR1,2(T)		;AR1 HAS NUMBER OF DIMENSIONS
	PUSH FXP,INHIBIT	;HALF A LOCKI
	HRRZ R,ARRYQ3(F)	;R HAS LENGTH OF ARRAY DATA
	HLRZ D,ARRYQ3(F)	;D HAS 1+LARGEST LEGAL INDEX
	PUSH FXP,D
	JRST ARRY2F

ARRY2:	CAML T,XC-2		;REGULAR ARRAY
	 JRST ARRY0G
	PUSH FXP,INHIBIT	;HALF A LOCKI
	MOVEI R,1		;R ACCUMULATES SIZE OF DATA
	HRREI D,2(T)		;-<# OF DIMENSIONS>
	MOVNI AR1,2(T)		;AR1 GETS NUMBER OF DIMENSIONS
ARRY2A:	POP P,A
ARRY2B:	JSP T,FXNV1
	TLNN TT,-1
	 JUMPG TT,ARRY2C
	WTA [ILLEGAL DIMENSION - *ARRAY!]
	JRST ARRY2B

ARRY2C:	PUSH FXP,TT
	IMULI R,(TT)		;PRODUCT OF ALL DIMENSIONS
	AOJL D,ARRY2A
	MOVEI D,(R)		;R HAS SIZE OF DATA, AR2A HAS NIL,
	SETZ AR2A,		; D HAS 1+LARGEST LEGAL INDEX
	HRRZ A,-1(P)		;PICK UP ARRAY NAME
ARRYAE:	JUMPE A,ARRY2F		;ALWAYS ALLOW NIL
	MOVEI TT,(A)		;GET POINTER TO ARRAY'S NAME ARG
	LSH TT,-SEGLOG		;MAKE POINTER TO ST TABLE
	MOVE TT,ST(TT)		;GET TABLE ENTRY
	TLNE TT,SA\SY		;OK IF SAR OR SYMBOL
	 JRST ARRY2F		;WIN IF IT IS
	%WTA NASER		;ELSE WRNG-TYPE-ARG ERROR
	HRRZM A,-1(P)		;REPLACE RETURNED ARG
	JRST ARRYAE		;AND TRY AGAIN WITH ATOM TEST
ARRY2F:	SETOM INHIBIT		;OTHER HALF OF LOCKI
	HRLM AR1,TOTSPC		;SAVE NUMBER OF DIMENSIONS
	MOVEI T,(AR1)		;T ACCUMULATES SIZE OF HEADER
	MOVEM D,LLIP1		;SAVE 1+LARGEST LEGAL INDEX
	MOVSI D,AS.SX
	TDNN D,ARYTP1(F)	;S-EXP OR FULLWORD ARRAY?
	AOJA T,ARRY2H		;FULLWORD NEEDS EXTRA WORD IN HEADER
	ADDI R,1		;S-EXP PACKS TWO ENTRIES PER WORD
	LSH R,-1
ARRY2H:	HRRZ TT,ARYIN2(F)	;ACCOUNT FOR LENGTHS OF ENTRIES
	IMULI R,(TT)
	MOVNM R,BPPNR		;-<SIZE OF ARRAY DATA IN WORDS>
	ADDI T,2		;TWO WDS IN HEADER FOR JSP AND SAR
	HRLM T,BPPNR		;SAVE SIZE OF HEADER
	ADDI R,1(T)		;ONE WORD FOR GC AOBJN POINTER
	HRRM R,TOTSPC		;SAVE TOTAL SIZE OF ARRAY IN WORDS
	MOVEM AR2A,(P)		;CLOBBER 2ND ARG WITH SAR OF ARRAY TO COPY
	PUSH FXP,F		;SAVE ARRAY TYPE

;FALLS THROUGH

;FALLS IN

	SKIPN A,-1(P)		;ARRAY OF NIL GIVES A SAR
	JRST ARRY3A		;DON'T DO SARGET FOR NIL
	PUSHJ P,SARGET
	JUMPN A,ARRY6		;ALREADY HAS A SAR
ARRY3A:	JSP T,SACONS
	MOVEI B,(A)
	MOVEI C,QARRAY
	SKIPE A,-1(P)
	PUSHJ P,PUTPROP		;AND PUTPROP IT UNLESS ATOM IS NIL
	JUMPN A,ARRY6
	MOVEM B,-1(P)		;WE WANT TO RETURN THE SAR, NOT NIL!
	MOVEI A,(B)
ARRY6:	MOVEM A,ADDSAR		;ADDRESS OF THE SAR
	MOVEI B,ADEAD
	MOVEM B,ASAR(A)		;THIS SAYS THE OLD ARRAY, IF ANY, IS DEAD
	MOVE B,GCMKL
	PUSHJ P,MEMQ1
	JUMPE A,ARRY6Q
	MOVEI B,DEDSAR
	HRLM B,(A)
ARRY6Q:	HRRZ TT,TOTSPC
	MOVEM TT,GAMNT
	MOVEI AR2A,GCMKL	;RUNNING BACKUP POINTER FOR GCMKL
	MOVEI C,0		;TAIL OF GAMKL FOR WINNING DEAD BLOCK
	MOVEI F,-1		;SIZE OF SMLST DEAD BLOCK NOT SMLR THAN REQUESTED
	SKIPA D,BPSH		;RUNNING LOCATION OF BLOCK BEGINNINGS
ARRY6A:	MOVE AR2A,AR1
	HRRZ B,(AR2A)
	JUMPE B,ARRY7		;ALL DONE WITH GCMKL
	HRRZ AR1,(B)
	HLRZ A,(AR1)
	MOVE TT,(A)
	SUB D,TT
	HLRZ A,(B)
	HLRZ A,ASAR(A)		;ALIVEP
	JUMPN A,ARRY6A
	CAMGE TT,F
	CAMGE TT,GAMNT
	JRST ARRY6A
	MOVE F,TT
	MOVE C,AR2A
	MOVE R,D
	JRST ARRY6A

ARRY7:	JUMPN C,ARRY7A	;FOUND DEAD BLOCK BIG ENOUGH
	HRRZ TT,TOTSPC	;ELSE MUST GRAB NEW BLOCK OF REQUISITE SIZE
	PUSHJ P,AGTSPC
	JUMPE A,ARRY8
	SUB TT,TOTSPC
	HRRZM TT,INSP
	HRRZ TT,TOTSPC	;WILL MAKE AN ENTRY
	JSP T,FIX1A	;ON GCMKL.
	PUSHJ P,NCONS	
	MOVE B,ADDSAR
	PUSHJ P,XCONS
	MOVEI B,(A)
	MOVEI A,GCMKL
	PUSHJ P,.NCNC1
	MOVE TT,INSP
	JSP T,FIX1A
	MOVEM A,VBPEND 
	JRST ARRY5

ARRY7A:	HRRZ AR1,(C)	;C POINTS TO GCMKL TAIL WITH DEAD BLK TO BE USED
	SUB F,GAMNT	;F HAD SIZE OF USEABLE DEAD BLK
	JUMPN F,ARRY7B
	MOVE B,ADDSAR	;DEAD BLOCK IS EXACTLY SIZE NEEDED
	HRLM B,(AR1)	; SIMPLY SPLICE SAR INTO GCMKL AND XIT
	JRST ARRY4
ARRY7B:	ADD R,F		;SLICE UP DEAD BLOCK INTO ARRAY IN HIGHER
	MOVEI A,DBM	; PART AND NEW DEAD BLK IN LOWER
	HRLM A,(AR1)
	MOVE TT,F
	JSP T,FIX1A
	HRRZ AR1,(AR1)	;INSTALL NEW DEAD BLOCK MARKER,
	MOVEI AR2A,(A)	; AND NEW DEAD BLOCK SIZE
	HRRZ TT,TOTSPC
	JSP T,FIX1A
	HRRZ B,(C)
	PUSHJ P,CONS
	MOVE B,ADDSAR
	PUSHJ P,XCONS
	HRLM AR2A,(AR1)
   XCTPRO
	HRRM A,(C)	;PROTECTED, JUST TO BE SAFE
   NOPRO
ARRY4:	HRRZM R,INSP	;R NOW HOLDS BEGINNING OF BLOCK FOR NEW ARRAY
ARRY5:	POP FXP,F		;INDEX INTO ARYTP1
	HRRZ R,INSP		;R HELPS PUSH OUT ARRAY HEADER
	CAIGE F,NPARTP		;MAKE UP AOBJN POINTER FOR GC
	SKIPA C,ARRYQ4(F)
	MOVS C,BPPNR
	ADDI C,2(R)		;ALLOW FOR SIZE OF HEADER, ETC.
	PUSH R,C
	SKIPGE ARYIN1(F)	;MAKE DOUBLY SURE ARRAY TYPE EXISTS
	 .VALUE
	SKIPE TT,ARYIN1(F)	;OOPS! DO WE NEED EXTRA INSTRUCTION?
	 PUSH R,TT		;YES, PUSH IT OUT FIRST
	HLRZ T,ARYIN2(F)	;BASE ADDRESS OF TABLE OF SUBSCRIPT FUNCTION CALLS
	HLRZ D,TOTSPC		;NUMBER OF DIMENSIONS
	ADDI T,-1(D)
	PUSH R,(T)		;PUSH OUT JSP TO CORRECT PLACE
	PUSH R,ADDSAR		;PUSH OUT ADDRESS OF SAR
ARRY5D:	POP FXP,T		;PUSH OUT ARRAY DIMENSIONS, IN ORDER
	PUSH R,T
	SOJG D,ARRY5D
	SETZM 1(R)		;ZERO FIRST WORD OF DATA
	MOVSI A,1(R)		;MAKE UP BLT POINTER
	HRRI A,2(R)
	MOVN C,BPPNR
	ADDI C,(R)		;C HAS LIMIT FOR BLT
	POP P,AR1		;DO WE WANT TO COPY ANOTHER ARRAY?
	JUMPE AR1,ARRY5F	;NO - ZERO OUT ARRAY
	HRL A,TTSAR(AR1)	;YES - REARRANGE BLT POINTER
	SOJA A,ARRY5G
ARRY5F:	TLZ C,-1		;FOR ONE-WORD ARRAY, DON'T DO BLT!
	CAIE C,-1(A)
ARRY5G:	BLT A,(C)
	MOVE AR2A,ADDSAR	;PUT CORRECT STUFF INTO SAR ITSELF
	MOVE TT,INSP
	ADDI TT,2
	HLL TT,ARYTP1(F)
	MOVEM TT,ASAR(AR2A)
	ADDI R,1
	HRRM R,TTSAR(AR2A)
	HLRZ D,TOTSPC
	DPB D,[TTSDIM,,TTSAR(AR2A)]
	CAIGE F,NPARTP
	PUSHJ P,@ARRYQ5(F)	;PECULIAR ARRAYS NEED FIXING UP
	MOVE B,ADDSAR		;RETURN SAR IN B
	POP P,A			;RETURN ARG 1 IN A
	UNLKPOPJ

ARRY8:	SUB P,R70+1
	HLRZ TT,TOTSPC
	MOVNI TT,1(TT)
	HRLI TT,-1(TT)
	ADD FXP,TT
	HRRZ TT,TOTSPC
	JSP T,FXCONS
	pushj p,%%RLFE
	  ,,Q%%ARRAY
	UNLOCKI
	FAC [NO CORE - *ARRAY!]

SUBTTL	AREGET ROUTINE

AREGET:	PUSH P,A	;GET AN ARRAY SAR (AND INSIST ON ONE!)
	MOVEI TT,(A)
	LSH TT,-SEGLOG
	MOVE TT,ST(TT)
	TLNE TT,SA
	 JRST AREGT0	;A SAR ITSELF IS ACCEPTABLE
AREGT2:	PUSHJ P,ARGET	;SO IS A SYMBOL WITH AN ARRAY PROPERTY
	JUMPE A,AREGT1
AREGT0:	MOVE TT,ASAR(A)	;A KILLED ARRAY IS AS BAD AS NO ARRAY
	CAIE TT,ADEAD
	 JRST POP1J	;SUCCESS! RETURN THE SAR IN A
AREGT1:	POP P,A		;FAILURE! CRAP OUT
	%WTA ARGT3
	JRST AREGET

ARGT3:	SIXBIT \NOT AN ARRAY!\


SUBTTL	MKDTAR/MKLSAR ROUTINE, AND ARRAYDIMS FUNCTION

MKFLAR:	SKIPA T,[QFLONUM]
MKFXAR:	MOVEI T,QFIXNUM
	JRST MKAR1

MKDTAR:	TDZA T,T	;MAKE UP A DATA ARRAY [NO GC PROTECTION FOR ELTS]
MKLSAR:	MOVEI T,TRUTH	;MAKE UP A LIST ARRAY [GC PROTECTION]
	LSH TT,1	;FINDS NUMBER OF DATA WORDS DESIRED IN TT
MKAR1:	PUSH P,[PX1J]	;A CONTAINS NAME FOR ARRAY
	PUSH P,A	;A=NIL => GENSYM A NAME
	PUSH P,T	;A=<-1,,> => JUST RETURN THE SAR
	PUSH FXP,TT	;LEAVES GENSYMMED NAME OF ARRAY IN A
	MOVEI A,(FXP)
	PUSH P,A	;LEAVES ADDRESS OF SAR IN B
	MOVEI T,0
	SKIPN A,-2(P)
	 PUSHJ P,GENSYM
	HRRZM A,-2(P)
	MOVNI T,3
	JRST %%ARRAY


   SPECPRO INTZAX
SACONS:	SKIPN FFA		;SAR CONSER
	PUSHJ P,AGC
	MOVE A,@FFA
   XCTPRO
	EXCH A,FFA
   NOPRO
	HRLI T,((TT))
	HLLM T,TTSAR(A)
	JRST (T)

;ARRAY-DIMENSION-N
ADIMN:	JSP T,FXNV1		;just checks for fixnumness
	MOVE AR1,A
	MOVE A,B
	JSP R,ADIMC		;SUBR 1 - ARG MUST BE ARRAY
	MOVE F,(AR1)
	JUMPLE F,FALSE
	CAMLE F,TT		;TT HAS # OF DIMS
	 JRST FALSE
	SUBM F,TT
	SOS TT
	MOVE TT,@TTSAR(C)
	JRST FIX1

;ARRAY-#-DIMS
ANDIM:	JSP R,ADIMC	;SUBR 1 - ARG MUST BE ARRAY
	JRST FIX1

ARRTYP:	JSP R,ADIMC
	MOVE A,F
	POPJ P,

ADIMS0:	MOVEI A,(C)
	%WTA ARGT3
ADIMC:	MOVEI C,(A)		;COMMON ROUTINE FOR ARRAYDIMS/ARRAY-DIMENSION-N
	PUSHJ P,SARGET	
	JUMPE A,ADIMS0	
	HRRZ T,ASAR(A)
	CAIN T,ADEAD
	 JRST FALSE
	LOCKTOPOPJ
	MOVEI C,(A)
	MOVE T,ASAR(C)
	JFFO T,.+1
	HRRZ F,ARYTYP(TT)		;F HAS SYMBOL FOR ARRAY TYPE
	CAIE F,TRUTH
	 JRST .+3
	  TLNN T,AS.GCP
	   MOVEI F,NIL
	LDB TT,[TTSDIM,,TTSAR(C)]	;# OF DIMENSIONS
	JRST (R)

;ARRAYDIMS
ADIMS:	JSP R,ADIMC		;SUBR 1 - ARG MUST BE ARRAY
	MOVNI D,(TT)		;D HAS -<# OF DIMS>
	MOVNI R,1
	TDZA B,B
ADIMS1:	MOVEI B,(A)		;CONS UP LIST OF DIMENSIONS
	MOVEI TT,(R)
	MOVE TT,@TTSAR(C)
	JSP T,FXCONS
	PUSHJ P,CONS
	CAME R,D
	 SOJA R,ADIMS1
	MOVEI B,(F)		;CONS TYPE ON FRONT OF LIST
	JRST XCONS


;;;	JSP T,ARYSIZ
;;; ACCEPTS A SAR IN A; RETURNS THE PRODUCT OF THE DIMENSIONS
;;; IN F, AND THE SIZE OF THE DATA IN WORDS IN TT.
;;; SAVES D AND R.


ARYSIZ:	HLL T,ASAR(A)		;RETURN ADDRESS IN IN RH OF T
	TLNE T,AS.RDT+AS.OBA
	 JRST ARYSZ5		;SPECIAL HANDLING FOR READTABLES AND OBARRAY
	LDB TT,[TTSDIM,,TTSAR(A)]
	MOVNS TT
	MOVE F,@TTSAR(A)
ARYSZ3:	AOJE TT,ARYSZ4		;ON EXIT, F HAS PRODUCT OF ALL DIMENSIONS
	IMUL F,@TTSAR(A)
	JRST ARYSZ3

ARYSZ4:	TLNE T,AS.SX
	 JRST ARYSZ7
ARYSZ6:	MOVE TT,F		;NUMERIC ARRAY - SIZES MAY BE 1, 2, 4
IFN DBFLAG+CXFLAG,[
	TLNE T,AS.DB+AS.CX
	 LSH TT,1
]		;END OF IFN DBFLAG+CXFLAG
DX$	TLNE T,AS.DX
DX$	 LSH TT,1
	JRST (T)

ARYSZ5:	MOVEI F,LRCT		;ASSUME A READTABLE
	TLNE T,AS.RDT
	 JRST ARYSZ6
	MOVEI F,OBTSIZ+1+200	;IF NOT, AN OBARRAY
ARYSZ7:	move tt,f		;ALLOW FOR S-EXPRESSION ARRAYS
	addi tt,1		; HAVING TWO ELEMENTS/WORD
	LSH TT,-1		;(Don't use MOVEI TT,1(F) in case array is
	JRST (T)		; just slightly bigger than 2^18.)

OBAFIX:	JUMPE AR1,CPOPJ		;FIX UP OBARRAY AFTER A BLTARRAY, ETC.
	MOVE T,TTSAR(AR2A)	; BY COPYING ALL THE BUCKETS
	HRLI T,442200		;USER INTERRUPTS SHOULD BE SHUT OFF
	MOVEI D,OBTSIZ
OBAFX3:	ILDB A,T
	SETZ B,
	PUSHJ P,.APPEND		;USE *APPEND TO COPY LISTS
	DPB A,T
	SOJG D,OBAFX3
	POPJ P,

RDTFIX:	SKIPA R,PROLIS	;FIX UP A READTABLE AFTER A BLTARRAY, ETC.
RDTFX2:	HRRZ R,(R)	; BY DUPLICATING ALL PROLIS ENTRIES
	JUMPE R,CPOPJ	; FOR MACRO CHAR FUNCTIONS
	HLRZ D,(R)
	HRRZ TT,(D)
	HLRZ T,(TT)
	CAIE T,(AR1)
	 JRST RDTFX2
	HRRZ B,(TT)
	MOVEI A,(AR2A)
	PUSHJ P,CONS
	HLRZ B,(D)
	PUSHJ P,XCONS
	MOVE B,PROLIS
	PUSHJ P,CONS
	MOVEM A,PROLIS
	JRST RDTFX2



SUBTTL	*REARRAY FUNCTION

.REARRAY:		;THIS CODE COULD STAND MUCH IMPROVEMENT
	JSP TT,LWNACK
	LA1234567,,Q.REARRAY
	AOJE T,.REA1		;ONE ARG, DELETE THE ARRAY
	MOVEI D,(P)
	ADDI D,(T)
	HRLI D,(T)
	HRRZ A,(D)
	SUBI T,1
	PUSH FXP,T
.REA4B:	PUSHJ P,AREGET
	MOVE T,ASAR(A)		;GET SAR
	TLNN T,AS.FIL\AS.JOB	;DON'T ALLOW JOB OR FILE ARRAY
	 JRST .REA4A
	XCT .REA6A		;ISSUE WTA ERROR
	JRST .REA4B
.REA4A:	LOCKI
	PUSH P,A
	HLRZ T,ASAR(A)
	HRRZ A,1(D)
.REA4:	MOVSI F,-LARYTP
.REA5:	HRRZ B,ARYTP1(F)
	CAIN B,(A)
	 JRST .REA7
	AOBJN F,.REA5
.REA6:	UNLOCKI
	POP FXP,T
.REA6A:	WTA [BAD ARRAY TYPE - *REARRAY!]
	MOVEM A,1(D)
	PUSH FXP,T
	LOCKI
	JRST .REA4

.REA7:	HLRZ TT,ARYTP1(F)
	XORI TT,(T)
	ANDCMI TT,AS<GCP>
	JUMPN TT,.REA6
.REA7A:	PUSHJ P,.REA8
.REA2:	LOCKI
	HRRZ AR1,(P)		;AR1 HAS THE OLD ARRAY SAR
	MOVEI AR2A,(A)		;AR2A HAS THE NEW ARRAY SAR
	PUSHJ P,.REA3		;COPY OLD ARRAY DATA INTO NEW ARRAY
	 JRST .REALOSE
	MOVEI B,ADEAD		;NOW INTER-CLOBBER THE TWO SARS
	EXCH B,ASAR(AR2A)
	MOVEM B,ASAR(AR1)	;STORE NEW CONTENTS OF ASAR
	TLNE B,AS<FX+FL>
	 ADDI B,1
	MOVEM AR1,1(B)		;INSTALL CORRECT SAR IN ARRAY
	MOVE B,TTSAR(AR2A)
	HLLOS TTSAR(AR2A)
	MOVEM B,TTSAR(AR1)	;STORE NEW CONTENTS OF TTSAR
	MOVEI A,(AR1)
	MOVE B,GCMKL
	PUSHJ P,MEMQ1
	JUMPE A,.REALOSE
	MOVEI B,DEDSAR
	HRLM B,(A)
	MOVE B,GCMKL
	MOVEI A,(AR2A)
	PUSHJ P,MEMQ1
	JUMPE A,.REALOSE
	HRLM AR1,(A)
	UNLOCKI
	POP FXP,T
	HRLI T,-1(T)
	ADD P,T
	JRST POPAJ

.REA8:	PUSH P,R70		;*ARRAY WILL CREATE A FRESH SAR
	PUSH P,1(D)
	AOBJN D,.-1
	UNLOCKI
	MOVE T,(FXP)
	JRST %%ARRAY


.REALOSE:	SUB P,R70+1
	UNLOCKI
	POP FXP,T
	PUSHJ FXP,LISTX
	PUSHJ P,NCONS
	MOVEI B,Q.REARRAY
	PUSHJ P,XCONS
	FAC [*REARRAY LOST!]


;;; SMASH ARRAY WHOSE SAR IS IN AR1 INTO ARRAY WHOSE SAR IS IN AR2A
;;; SKIPS ON SUCCESS - FAILS WHEN ARRAY TYPES DON'T MATCH

.REA3:	HLLZ TT,ASAR(AR1)
	HLLZ D,ASAR(AR2A)
	XOR TT,D
	TLZ TT,AS.GCP
	JUMPE TT,.REA3C		;WIN IF ARRAY TYPES MATCH
	TLNE TT,#<AS.DB+AS.CX+AS.DX+AS.FX+AS.FL>	;ASSUME WIN IF BOTH NUMERIC
	 POPJ P,
.REA3C:	AOS (P)
	MOVEI A,(AR1)
	JSP T,ARYSIZ		;RETURNS SIZE IN WORDS IN TT
	MOVE R,TT
	MOVEI A,(AR2A)
	JSP T,ARYSIZ
	HRRZS (P)
	CAMG TT,R		;MOVE NUMBER OF WORDS DICTATED
	 JRST .REA3D		; BY THE SMALLER OF THE ARRAYS
	MOVE TT,R
	HRROS (P)		;REMEMBER WHETHER ARRAY GETS BIGGER OR SMALLER
.REA3D:	ADD TT,TTSAR(AR2A)
	HRRZ R,TTSAR(AR2A)
	HRL R,TTSAR(AR1)
	BLT R,-1(TT)		;TRANSFER THE DATA
	SKIPGE (P)		;IF DIDN'T SWITCH ARRAY SIZES THEN DO CHECK
	 JRST .REA3E
	TLNE T,AS.SX		;IF S-EXP ARRAY
	 TRNN F,1		;AND AN ODD NUMBER OF ENTRIES
	  SKIPA
	   HLLZS -1(TT)		;MAKE SURE LAST HALFWORD IS ZERO
.REA3E:	TRNN D,AS.RDT+AS.OBA
	 POPJ P,
	TRNE D,AS.RDT		;MUST PERFORM A SPECIAL FIXUPS"
ARRYQ5:	 JRST RDTFIX		;;  OBAFIX FOR OBARRAYS (AFTER BLT'TING)
	JRST OBAFIX		;;  RDTFIX FOR READTABLES



GETSP:	JSP TT,LWNACK
	LA12,,QGETSP
	POP P,A
	MOVEI D,GETSP1
	HRL D,VPURE
	AOJE T,GETSP0
	HRLI D,(A)
	POP P,A
GETSP0:	JSP T,FXNV1	;RETURNS BPEND-BPORG IF SPACE IS AVAILABLE
	TLCE D,-1
	 TLZ D,-1
	LOCKTOPOPJ
	PUSH P,D
AGTSPC:	MOVEM TT,GAMNT
	ADD TT,@VBPORG		;INSURE THAT BPEND-BPORG > (TT)
	SUB TT,@VBPEND
	JUMPGE TT,GTSPC1	;MUST RELOCATE, OR GET MORE CORE.
	MOVE A,VBPEND		;ALREADY OK
	MOVE TT,(A)
	POPJ P,

GETSP1:	JUMPE TT,FALSE
	SUB TT,@VBPORG
	JRST FIX1

.REA1:	MOVE A,(P)		;REMOVES ARRAY BY PUTTING ADDRESS OF
	PUSHJ P,SARGET		; ERROR ROUTINE IN SAR, ETC.
	JUMPE A,POP1J
	MOVE T,ASAR(A)		;GET SAR
	TLNE T,AS.JOB\AS.FIL	;MUST NOT BE FILE OR JOB ARRAY
	 JRST .REA1A
	MOVEI B,ADEAD
   XCTPRO
	MOVEM B,ASAR(A)
	MOVE B,[TTDEAD]
	MOVSI T,TTS<CN>
	TDNE T,TTSAR(A)
	 IOR B,T
	MOVEM B,TTSAR(A)
   NOPRO
	JRST POPAJ
.REA1A:	POP P,A			;ARRAY IS FILE OR JOB OBJECT
	XCT .REA6A		;ISSUE WTA ERROR
	PUSH P,A
	JRST .REA1

SUBTTL	MULTI-DIMENSIONAL ARRAY ACCESS ROUTINES

;;; THESE ARE LIKE THE FXNV ROUTINES; THEY TAKE A FIXNUM
;;; FROM AN ARGUMENT AC, CHECK ITS TYPE, AND PUT ITS VALUE
;;; IN R.  THIS VALUE IS CHECKED TO ENSURE IT IS WITHIN THE
;;; NEXT DIMENSION VALUE.  TT IS STEPPED ALONG THE VECTOR
;;; OF DIMENSIONS IN THE ARRAY HEADER.  AYNV1 ADDITIONALLY
;;; PUTS THE ADDRESS OF THE SAR IN LISAR.

   SFXPRO
AYNV1:	HRRZ R,(TT)
	MOVEM R,LISAR
	AOJA TT,AYNV0

AYNV5:	SKIPA A,AR2A
AYNV4:	 MOVEI A,(AR1)
	JRST AYNV0

AYNV3:	SKIPA A,C
AYNV2:	 MOVEI A,(B)	;LEFT HALF OF B MAY BE NON-ZERO
AYNV0:	MOVEI R,(A)
	LSH R,-SEGLOG
	MOVE R,ST(R)
	TLNN R,FX
	 JRST AYNVER		;LOSE IF NOT A FIXNUM
	SKIPL R,(A)		;MUST NOT BE NEGATIVE,
	 CAML R,(TT)		; AND MUST BE BELOW NEXT DIMENSION
	  CAIA
	   AOJA TT,(T)		;RETURN TO CALLER, BUMPING POINTER IN TT
	SKIPA D,[IXEXBD]
AYNVER:	 MOVEI D,NFXIX
	PUSH P,D
	MOVEI R,(TT)
AYNVE1:	HLRZ D,-1(R)		;WE MUST BACK UP THE POINTER TO THE JSP TT,
	CAIE D,(JSP TT,)	; WHICH IS WHERE THE ASAR POINTS
	 SOJA R,AYNVE1
	HRRZ D,(R)
	SUB TT,ASAR(D)		;SAVE TT AS AN ABSOLUTE OFFSET FROM THE ASAR
	EXCH D,(P)		; (SINCE DURING THE ERROR THE ARRAY MAY MOVE)
	XCT AYNVSFX		;SYNCHRONIZE WITH THE INTERRUPT LOCKOUT MECHANISM
	POP P,D
	ADD TT,ASAR(D)		;RESTORE THE TT POINTER USING THE
	JRST AYNV0		; (POSSIBLY NEW) ASAR, AND TRY AGAIN

.SEE 1DIMS			;THE 1-DIMENSIONAL ACCESS ROUTINES ARE IN LOW CORE

2DIMS:	JSP T,AYNV1
	MUL R,(TT)
	JSP T,AYNV2
2DIMS1:	ADDI R,(F)
	JRST ARYGET

2DIMF:	JSP T,AYNV1
	MUL R,(TT)
	JSP T,AYNV2
2DIMF1:	ADDI R,(F)
	JRST ANYGET

IFN DBFLAG+CXFLAG,[
2DIMD:	JSP T,AYNV1
	MUL R,(TT)
	JSP T,AYNV2
2DIMD1:	ADDI R,(F)
	JRST ADYGET
]		;END OF IFN DBFLAG+CXFLAG

IFN DXFLAG,[
2DIMZ:	JSP T,AYNV1
	MUL R,(TT)
	JSP T,AYNV2
2DIMZ1:	ADDI R,(F)
	JRST AZYGET
]		;END OF IFN DXFLAG

;;; THERE ARE FOUR SEPARATE 1DIM- AND 2DIM- ROUTINES FOR SPEED.
;;; FOR THE OTHERS, WHICH ARE LESS COMMON, WE PREFER TO SAVE
;;; SPACE.  WE ENCODE THE ARRAY TYPE IN THE LEFT HALF OF B:
;;;	0	S-EXPRESSION
;;;	1	FIXNUM, FLONUM
;;;	2	DOUBLE, COMPLEX
;;;	3	DUPLEX
;;; PLEASANTLY, IF THIS NUMBER IS N, AN ARRAY ELEMENT IS OF SIZE
;;; 2^N HALFWORDS, BUT WE DO NOT USE THIS FACT.

IFN DXFLAG,		3DIMZ:	TLOA B,2
IFN DBFLAG+CXFLAG,	3DIMD:	 TLOA B,2
3DIMF:				  TLO B,1
3DIMS:	JSP T,AYNV1
	MUL R,(TT)
	JSP T,AYNV2
	ADDI F,(R)
	IMUL F,(TT)
	JSP T,AYNV3
3DIMX:	HLRZ T,B
	TLZ B,-1
	JRST .+1(T)
			JRST 2DIMS1	;S-EXPRESSION
			JRST 2DIMF1	;FIXNUM, FLONUM
IFN DBFLAG+CXFLAG,	JRST 2DIMD1	;DOUBLE, COMPLEX
.ELSE	.VALUE
IFN DXFLAG,		JRST 2DIMZ1	;DUPLEX
.ELSE	.VALUE


IFN DXFLAG,		4DIMZ:	TLOA B,2
IFN DBFLAG+CXFLAG,	4DIMD:	 TLOA B,2
4DIMF:				  TLO B,1
4DIMS:	JSP T,AYNV1
	MUL R,(TT)
	JSP T,AYNV2
	ADDI F,(R)
	IMUL F,(TT)
	JSP T,AYNV3
	ADDI F,(R)
	IMUL F,(TT)
	JSP T,AYNV4
	JRST 3DIMX


IFN DXFLAG,		5DIMZ:	TLOA B,2
IFN DBFLAG+CXFLAG,	5DIMD:	 TLOA B,2
5DIMF:				  TLO B,1
5DIMS:	JSP T,AYNV1
	MUL R,(TT)
	JSP T,AYNV2
	ADDI F,(R)
	IMUL F,(TT)
	JSP T,AYNV3
	ADDI F,(R)
	IMUL F,(TT)
	JSP T,AYNV4
	ADDI F,(R)
	IMUL F,(TT)
	JSP T,AYNV5
	JRST 3DIMX
   NOPRO

SUBTTL	FILLARRAY AND LISTARRAY

FILLARRAY:			;SUBR 2
	SKOTT B,LS
	 JRST FILLAA
	MOVEI C,(B)
FILLA0:	PUSH P,A
	PUSHJ P,AREGET		;GET SAR OF ARRAY
	HLLZ D,ASAR(A)
	TLNE D,AS.JOB+AS.FIL+AS.RDT+AS.OBA
	 JRST FILLUZ		;CAN'T FILL JOB OR FILE OR READTABLE OR OBARRAY
	JSP T,ARYSIZ		;GET SIZE OF ARRAY IN F
	SETZ TT,		;TT WILL BE USED FOR INCREMENTAL INDEX
	TLNN D,AS.SX
	 JRST FILLA2
FILLA1:	JUMPE C,FILLA4		;FILL LOOP FOR S-EXP ARRAYS
	HLRZ B,(C)
	HRLM B,@TTSAR(A)
	HRRZ C,(C)
	SOJE F,POPAJ
	JUMPE C,FILLA5
	HLRZ B,(C)
	HRRM B,@TTSAR(A)
	HRRZ C,(C)
	SOJE F,POPAJ
	AOJA TT,FILLA1

FILLA4:	HRLM B,@TTSAR(A)
	SOJE F,POPAJ
FILLA5:	HRRM B,@TTSAR(A)
	SOJE F,POPAJ
	ADDI F,1
	ROT F,-1		;ROT, NOT LSH; SEE BELOW
	MOVEI D,1		;MULTIPLIER FOR ELEMENT SIZE
	JRST FILLA7

FILLA2:	TLNN D,AS.FX+AS.FL
IFN DBFLAG+CXFLAG,	JRST FILLD1
.ELSE	 .VALUE
	MOVEI B,(A)		;FILL LOOP FOR FULLWORD ARRAYS
FILLA3:	JUMPE C,FILLA6
	HLRZ A,(C)
	HRRZ C,(C)
	MOVEI R,(TT)
	TLNN D,AS<FX>
	JSP T,FLNV1X
	JSP T,FXNV1
	EXCH TT,R
	MOVEM R,@TTSAR(B)
	SOJE F,POPAJ
	AOJA TT,FILLA3

IFN DBFLAG+CXFLAG,[
FILLD1:	TLNN D,AS.DB+AS.CX
DX$	 JRST FILLZ1
DX%	 .VALUE
	MOVE F,D
FILLD3:	JUMPE C,FILLD6		;FILL LOOP FOR DOUBLE AND COMPLEX ARRAYS
	HLRZ A,(C)
	HRRZ C,(C)
	MOVEI R,(TT)
DB$ CX$	TLNN F,AS.DB
DB$ CX$	 JSP T,CXNV1X
DB$	  JSP T,DBNV1
DB%	JSP T,CXNV1
	EXCH TT,R
	MOVEM R,@TTSAR(B)
	ADDI TT,1
	MOVEM D,@TTSAR(B)
	SOJE F,POPAJ
	AOJA TT,FILLD3

FILLD6:	ADDI TT,1
	MOVEM D,@TTSAR(B)
	MOVEI D,2
	SOJA TT,FILLA9
]		;END OF IFN DBFLAG+CXFLAG

IFN DXFLAG,[
FILLZ1:	TLNN D,AS.DX
	 .VALUE
	PUSH FXP,TT
	PUSH FXP,F
FILLZ3:	JUMPE C,FILLZ6		;FILL LOOP FOR DUPLEX ARRAYS
	HLRZ A,(C)
	HRRZ C,(C)
	JSP T,DXNV1
	MOVE T,TT
	MOVE TT,-1(FXP)
KA	MOVEM R,@TTSAR(B)
KA	ADDI TT,1
KA	MOVEM F,@TTSAR(B)
KA	ADDI TT,1
KIKL	DMOVEM R,@TTSAR(B)
KIKL	ADDI TT,2
	MOVEM T,@TTSAR(B)
	ADDI TT,1
	MOVEM D,@TTSAR(B)
	ADDI TT,1
	MOVEM TT,-1(FXP)
	SOSE (FXP)
	 JRST FILLZ3
	POPI FXP,2
	JRST POPAJ

FILLZ6:
KA	MOVEM R,@TTSAR(B)
KA	ADDI TT,1
KA	MOVEM F,@TTSAR(B)
KA	ADDI TT,1
KIKL	DMOVEM R,@TTSAR(B)
KIKL	ADDI TT,2
	MOVEM T,@TTSAR(B)
	ADDI TT,1
	MOVEM D,@TTSAR(B)
	SUBI TT,3
	MOVEI D,4
	JRST FILLA8
]		;END OF IFN DXFLAG

OPNCLR:	MOVEI F,LONBFA		;USED BY $OPEN TO CLEAR ARRAY
	SETZB TT,R		;SAR OF FILE ARRAY IS IN A
	MOVEI B,(A)
	PUSH P,A
FILLA6:	MOVEI D,1
FILLA9:	MOVEM R,@TTSAR(B)
FILLA8:	SOJE F,POPAJ
	TLO F,400000		;AVOID HLLZS BELOW
	MOVEI A,(B)
FILLA7:	LOCKI			;IF LIST RUNS OUT, DUPLICATE INTO
	ADD TT,TTSAR(A)		; REMAINING ELEMENTS WITH A BLT
	IMULI F,(D)		;ACCOUNT FOR SIZE OF ELEMENTS
	ADDI F,(TT)
	ADDI F,-1(D)
	HRLI TT,(TT)
	ADDI TT,(D)
	BLT TT,(F)
	SKIPL F		;FOR AN ODD LENGTH S-EXP ARRAY, ZERO RH OF
	 HLLZS (F)	; LAST WORD SO GC WON'T MARK IT SPURIOUSLY
	POP P,A
	UNLKPOPJ

FILLAA: TLNE TT,SA	;A SAR?
	 JRST FILLAB
	TLNE TT,SY	;A NON-NULL SYMBOL?
	 JUMPN B,FILLAB
	EXCH A,B
	WTA [CANT FILLARRAY WITH THIS!]
	EXCH A,B
	JRST FILLARRAY

FILLAB:	JCALLF 2,QBLTARRAY


FILLUZ:	POP P,A
	WTA [WRONG TYPE ARRAY!]
	JRST FILLA0



LISTARRAY:
	JSP TT,LWNACK
	   LA12,,QLISTARRAY
	HRLZI D,377777		;INITIAL SETTING FOR COUNT
	AOJE T,LISTA3
	POP P,B			;COUNT INITIALIZED TO 2ND ARG IF PRESENT
	JSP T,FXNV2
LISTA3:	POP P,A
LISTAZ:	PUSHJ P,AREGET
	MOVE T,(A)		;GET SAR BITS
	TLNN T,AS.JOB		;CAN'T BE JOB ARRAY
	 TLNE T,AS.FIL		; OR FILE ARRAY
	  JRST LISFIL
	JSP T,ARYSIZ		;GET SIZE OF ARRAY
	JUMPL D,LISTA7		;SET COUNT TO SIZE IF 2ND ARG NEGATIVE
	CAMGE D,F		;OR IF 2ND ARG BIGGER THAN SIZE
	 MOVE F,D
LISTA7:	MOVEI C,(A)
	SETZB A,B
	JUMPE F,CPOPJ
	TLNN T,AS.SX
	 JRST LISTA5
	MOVEI TT,-1(F)
	LSHC TT,-1		;FIGURE OUT IF ODD OR EVEN
	JUMPGE D,LISTA2		; NUMBER OF ITEMS TO LIST
LISTA1:	HRRZ B,@TTSAR(C)	;S-EXP ARRAY LISTING LOOP
	PUSHJ P,XCONS
LISTA2:	HLRZ B,@TTSAR(C)
	PUSHJ P,XCONS
	SOJGE TT,LISTA1
	POPJ P,

LISTA5:	TLNN T,AS.FX+AS.FL
IFN DBFLAG+CXFLAG, JRST LISTD5
.ELSE	.VALUE
	SKIPA D,T		;FULLWORD ARRAY LISTING LOOP
LISTA6:	 MOVEI B,(A)
	MOVEI TT,-1(F)
	MOVE TT,@TTSAR(C)
	TLNN D,AS<FX>		;CONS UP FLONUM OR FIXNUM?
	 JSP T,FLCONX		;FLONUM CONS WITH SKIP RETURN
	  JSP T,FXCONS		;FIXNUM CONS
	PUSHJ P,CONS
	SOJG F,LISTA6
	POPJ P,

LISFIL:	WTA [CANT LIST JOB- OR FILE- ARRAY!]
	JRST LISTAZ

IFN DBFLAG+CXFLAG,[
LISTD5:	TLNN T,AS.DB+AS.CX
DX$	 JRST LISTZ5
DX%	 .VALUE
	SKIPA R,T
LISTD6:	 MOVEI B,(A)		;DOUBLE/COMPLEX ARRAY LISTING LOOP
KA	HRROI TT,-1(F)
KA	ROT TT,1		;SNEAKY, HUH?
KA	MOVE D,@TTSAR(C)
KA	SUBI TT,1
KA	MOVE TT,@TTSAR(C)
KIKL	MOVEI TT,-1(F)
KIKL	LSH TT,1
KIKL	DMOVE TT,@TTSAR(C)
DB$ CX$	TLNN R,AS.DB
DB$ CX$	 JSP T,CXCONX		;COMPLEX CONS WITH SKIP RETURN
DB$	  JSP T,DBCONS
DB%	JSP T,CXCONS
	PUSHJ P,CONS
	SOJG F,LISTD5
	POPJ P,
]		;END OF IFN DBFLAG+CXFLAG

IFN DXFLAG,[
LISTZ5:	TLNN T,AS.DX
	 .VALUE
	PUSH FXP,F
	SKIPA TT,F
LISTZ6:	 MOVEI B,(A)
	LSH TT,2
KA	MOVE R,@TTSAR(C)
KA	ADDI TT,1
KA	MOVE F,@TTSAR(C)
KA	ADDI TT,2
KA	MOVE D,@TTSAR(C)
KA	SUBI TT,1
KA	MOVE TT,@TTSAR(C)
KIKL	DMOVE R,@TTSAR(C)
KIKL	ADDI TT,2
KIKL	DMOVE TT,@TTSAR(C)
	JSP T,DXCONS
	PUSHJ P,CONS
	SOSE TT,(FXP)
	 JRST LISTZ6
	POPI FXP,1
	POPJ P,
]		;END OF IFN DXFLAG

	PGTOP ARA,[ARRAY STUFF]
