/ROGALGOL V4 ARRAY OVERLAY. PUTS ELEMENTS IN ANY FIELD
/WITH FIRST AND LAST ADDRESSES DEFINED
ARFLD=20

FIELD 1

SUBSA4=1652
IGET=1724
ARR=2220
ARNW=2322
PFORM=1731
SUBSA=1600
NEXT=37
ABAS=24
T1=1
FLAC=44
FPUSH=4475
FPOP=4473
FPUT=5663


/ THIS NEXT ASSUMES ARFLD=20; PREVENTS FIELD OPTIONS LOADING
/ INTO FIELD 2 OR BELOW. IF ARFLD CHANGED, THEN THIS SHOULD
/ BE DELETED. OR SET TO -6211
/ THEN BEWARE LOADING PROGRAM BY /0 - /7 OVER THIS OVERLAY.
/ IF SET TO -6231, THEN COULD NOT LOAD BY OPTION
/ INTO FIELDS 0 - 3 (FIELD 0 WOULD STILL BE THE DEFAULT).
*3602; -6221

*117;	IPUT

*600;	EINT
*602;	0; JMP I .+1; ALEV0; JMP I 602 /CREATE LEVEL 0
*636;	JMP I .+1; AINIT	/INITIALISE ARRAY STACK

*1240;	KCC; CDF CIF; JMP I 1220	/STRAIGHT TO MONITOR

*SUBSA4+1;	TAD I 17; NOP /ADD BASE ADDRESS FROM DV

*IGET+2
	JMP I .+1; FXSTAK
*PFORM+2
	JMS I XFPUT; NOP; JMP I NEXT
IPUT,	FPOP; JMS SUBSA; JMP I FXPUTI
	JMP I FXPUTR
FXPUTI,	FXPI
FXPUTR,	FXPR
XFPUT,	FPUT

*ARR+14;	JMP I .+1; ARR1
*ARNW+2;	JMP I .+1; ARR2

*2440
MAXAR,	7577	/MAXIMUM LOCATION FOR ARRAYS
ALEV0,	TAD (2; TAD ABAS; DCA T1	/ADDRESS FX FREE SPACE POINT
	TAD 23; DCA ABAS	/SET NEW ABAS
	DCA I 23; ISZ 23; ISZ 23 /LEVEL NO. 0
	TAD I T1; DCA I 23; ISZ 23	/FX POINTER TO NEW LEVEL
	JMP I .+1; 605

AINIT,	TAD 32; DCA 21	/OVERWRITTEN CODES
	CMA; TAD 23; DCA T1	/ADDRESS OF ARRAY SPACE POINTER
	TAD .+2; SKP; 0	/GET FIRST AVAILABLE ADDRESS
	DCA I T1; JMP I .+1; 640

FXSTAK,	JMS SETAD
	TAD I 11; DCA FLAC
	TAD I 11; DCA FLAC+1
	TAD I 11; DCA FLAC+2
	CDF 10; FPUSH; JMP I NEXT

FXPR,	JMS SETAD
	TAD FLAC; DCA I 11
	TAD FLAC+1; DCA I 11
	TAD FLAC+2; DCA I 11
	CDF 10; JMP I NEXT

FXPI,	CDF ARFLD; TAD FLAC+2; DCA I T1
	CDF 10; JMP I NEXT

ARR1,	ISZ 23	/3RD WORD IS FX POINTER
	TAD (2; TAD ABAS; DCA T1	/ADDRESS OF FX POINTER
	TAD I T1; DCA I 23	/TRANSFER POINTER TO NEW LEVEL
	CLA CLL CMA RAL; TAD 23	/NEW ABAS
	JMP I .+1; ARR+16 /GO STORE IT

ARR2,	DCA SETAD	/SAVE ARRAY SIZE
	TAD (2; TAD ABAS; DCA T1	/ADDRESS FX POINTER
	TAD I T1; DCA I 23; ISZ 23	/START OF ARRAY TO DV
	TAD I T1; TAD SETAD; DCA I T1	/BUMP FX POINT. BY ARRAY SIZE
	JMP I .+1; ARNW+4	/GO CHECK FREE SPACE (F1) POINTER

SETAD,	0; TAD T1; DCA T1	/ADDRESS OF ELEMENT
	TAD (2; TAD T1; CLL CIA
	TAD MAXAR; SNL CLA; JMS 1200
	CMA; TAD T1; DCA 11; CDF ARFLD; JMP I SETAD

EINT=2600
$
