/12 K OVERLAY FOR ROGALGOL, ARRAYS TO FIELD 2

SUDOMQ=33
SUBSA4=1652
IGET=1726
IPUT=1733
ARR=2221
ARNW=2324
NEXT=37
ABAS=24
T1=1
FLAC=44
FPUSH=4475
FPOP=4473

FIELD 1

*600;	EINT	/THE NEW ONE
*602;	0; JMP I .+1; ALEV0; JMP I 602	/NEW ARRAY LEVEL 0
*636;	JMP I .+1; AINIT

*SUBSA4+1
	TAD I 17; NOP	/ADD BASE FROM DOPE VECTOR
*IGET+3
	JMP I .+1; F2STAK
*IPUT+2
	JMP I IPUT1; JMP I .+1; IPUT2
IPUT1,	IPUT3

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

*2466
ALEV0,	TAD (2; TAD ABAS; DCA T1	/ADDRESS F2 FREE SPACE
	TAD 23; DCA ABAS	/ARRAY BASE NEXT FREE F1
	DCA I 23; ISZ 23; ISZ 23 /LEVEL NO. 0, NO LINK
	TAD I T1; DCA I 23; ISZ 23 /TRANSFER NEXT F2 TO NEW LEVEL
	JMP I .+1; 605

AINIT,	TAD 32; DCA 21	/BASE OF WORKING STACK
	CMA; TAD 23; DCA T1	/ADDRESS NEW F2 FREE SPACE POINTER
	DCA I T1; JMP I .+1; 640	/ZERO IT

F2STAK,	TAD XM1; DCA 11; CDF 20	/ADDRESS ARRAY ELEMENT
	TAD I 11; DCA FLAC
	TAD I 11; DCA FLAC+1
	TAD I 11; DCA FLAC+2
	CDF 10; FPUSH; JMP I NEXT
XM1,	-1

IPUT2,	CMA; TAD T1; DCA 11; CDF 20	/ADDRESS OF ELEMENT
	TAD FLAC; DCA I 11
	TAD FLAC+1; DCA I 11
	TAD FLAC+2; DCA I 11	/TRANSFER FLAC TO ARRAY
	CDF 10; JMP I NEXT
IPUT3,	CDF 20; TAD FLAC+2; DCA I T1	/TRANSFER INTEGER
	JMP .-5

ARR1,	ISZ 23
	TAD (2; TAD ABAS; DCA T1	/ADDRESS F2 POINTER
	TAD I T1; DCA I 23	/TRANSFER FREE SPACE POINTER TO NEW LEVEL
	CLA CLL CMA RAL; TAD 23	/NEW ABAS
	JMP I .+1; ARR+16

ARR2,	TAD (2; TAD ABAS; DCA T1
	TAD I T1; DCA I 23; ISZ 23	/NEXT FREE F2 SPACE TO DV.
	TAD I T1; TAD SUDOMQ; DCA I T1	/ADJUST F2 POINTER
	JMP I .+1; ARNW+4

EINT=2600
$