TITLE	XPAND FOR RPGII 1A(1)
SUBTTL	EXPAND THE SIZE OF ANY TABLE	AL BLACKINGTON/CAM/RBC
;
;COPYRIGHT 1974, DIGITAL EQUIPMENT CORP., MAYNARD, MA.
;
;MODIFIED TO RPGII VERSION JUNE 25, 1975	BOB CURRIER
;
;MODIFIED EXTENSIVLY DURING EDIT 41. CODE IS ADDED TO ZERO LOCATIONS
; AFTER DATA IS MOVED AS WELL AS CLEANING UP BUGS ASSOCIATED WITH
; CONVERSION FROM COBOL.

TWOSEG
RELOC	400000


	ENTRY	ADDCOR		;ADD 1K TO THE IMPURE AREA
	ENTRY	SETCOR		;SET WORK AREA TO IT'S INTIAL SIZE
	ENTRY	BLTUP		;MOVE UP SOME DATA
	INTERNAL XPAND
	EXTERNAL KILL, RESTRT

XPAND:


	DEFINE TABSET (A,B,C,E,F,G),<
	IFN ^D'C,<
	ENTRY XPN'A
XPN'A:	MOVEM	TA,SAVEAC+17
	IFN DEBUG,<
	MOVE	TA,[POINT 6,[SIXBIT "E"]]
	PUSHJ	PP,XPMESS
	>
	MOVE	TA,A'XPS
	JRST	XPAND0
A'XPS:	XWD	^D'C,A'LOC
	EXTERNAL A'LOC
	>>



	TABLES
XPAND0:	MOVEM	TA,SAVEAC	;SAVE AC'S TH THRU TB
	MOVE	TA,[XWD TH,SAVEAC+1]
	BLT	TA,SAVEAC+7	; [043] SAVE ALL THE AC'S


	HLRZ	TD,FREESP	;ENOUGH FREE CORE?
	HLRZ	TE,SAVEAC
	CAMG	TE,TD
	JRST	XPAND1		;YES

	PUSHJ	PP,ADDCOR	;NO--GET MORE CORE

	HRRZ	TE,NAMNXT	;MOVE UP NAMTAB
	ADDI	TE,2000
	HRRZ	TB,NM1LOC
	PUSHJ	PP,BLTUP
	MOVEI	TE,2000
	ADDM	TE,NAMLOC
	ADDM	TE,NM1LOC
	ADDM	TE,NM2LOC
	ADDM	TE,NAMNXT
	SKIPE	CURNAM
	ADDM	TE,CURNAM

XPND0B:	MOVSI	TE,2000		;INCREMENT AMOUNT OF FREE SPACE
	ADDM	TE,FREESP

XPAND1:	MOVE	TE,SAVEAC	;ANY TABLES ABOVE THIS ONE?
	SKIPN	3(TE)
	JRST	XPAND4		;NO


;MOVE HIGHER TABLES UP IN CORE
	HRRZ	TA,3(TE)	;TH_XWD  -<SIZE TO MOVE>,<TOP LOCATION>
	HRRZ	TB,FREESP
	SUB	TA,TB
	MOVS	TH,TA
	HRRI	TH,-1(TB)

	MOVE TA,[XWD AOBUP,TG]	;SET UP AC'S
	BLT	TA,TB
	HLR	TF,SAVEAC
	JRST	TG
;INCREMENT POINTERS TO ALL TABLES JUST MOVED
XPAND2:	MOVE	TE,SAVEAC	;TE_ADDRESS OF CURRENT POINTERS
	HLRZ	TD,SAVEAC	;TD_AMOUNT OF OFFSET

XPAND3:	ADDI	TE,3
	ADDM	TD,0(TE)	;INCREMENT X'LOC
	ADDM	TD,1(TE)	;INCREMENT X'NXT
	SKIPE	2(TE)		;INCREMENT CUR'X IF NON-ZERO
	ADDM	TD,2(TE)
	SKIPE	3(TE)
	JRST	XPAND3


;RESET LEFT HALF OF POINTERS FOR EXPANDED TABLE
XPAND4:	HRRZ	TA,SAVEAC
	HLLZ	TE,SAVEAC
	MOVNS	TE
	ADDM	TE,(TA)
	ADDM	TE,1(TA)

;RESET BOTH HALVES OF FREESP

	HLR	TE,SAVEAC
	ADDM	TE,FREESP


;RESTORE ALL AC'S
	MOVS	TA,[XWD TH,SAVEAC+1]
	BLT	TA,TB
	MOVE	TA,SAVEAC+17
	POPJ	PP,			;RETURN

;BLT UP A BLOCK OF WORDS OF LENGTH >1K
;ENTER WITH:
;	TE SET TO LAST RECEIVING ADDRESS
;	TB SET TO FIRST SENDING ADDRESS

BLTUP:	MOVE	TD,TE
	ANDI	TE,776000		;TE_FIRST LOCATION IN THAT 1K BLOCK

BLTUP1:	MOVEI	TC,-2000(TE)		;TC_FIRST LOCATION IN LOWER 1K BLOCK
	CAMGE	TC,TB			;BELOW FIRST SENDING ADDRESS?
	MOVE	TC,TB			;YES--RESET TO FIRST SENDING ADDRESS

	MOVS	TA,TC			;CREATE XWD
	HRRI	TA,2000(TC)
	BLT	TA,(TD)			;MOVE DATA UP

	CAMN	TC,TB			;DONE?
	POPJ	PP,			;YES--RETURN
	MOVEI	TD,-1(TE)		;NO--DROP DOWN ONE 1K BLOCK
	SUBI	TE,2000
	JRST	BLTUP1			;LOOP



;THE FOLLOWING ROUTINE IS COPIED TO AC'S TG THRU TB.
;IT MOVES CONTENTS OF LOCATIONS UP IN CORE BY AMOUNT EXPANDED.

AOBUP:	MOVE	TA,(TH)
	MOVEM	TA,(TH)		;THE ADDRESS OF THIS WILL BE AMOUNT TO EXPAND
	SETZM	(TH)		; [041] ZERO LOCATION
	SUBI	TH,2
	AOBJN	TH,TG
	JRST	XPAND2
;PRINT OUT DEBUG MESSAGE

	IFN DEBUG,<EXTERNAL LSTMES,PUTLST,LCRLF

XPMESS:	PUSH	PP,CH
	PUSH	PP,TE
	MOVE	TE,[POINT 7,[ASCIZ "EXPANDING "]]
	PUSHJ	PP,LSTMES

XPM1:	ILDB	CH,TA
	JUMPE	CH,XPM2
	ADDI	CH,40
	PUSHJ	PP,PUTLST
	TLNE	TA,770000
	JRST	XPM1

XPM2:	MOVE	TE,[POINT 7,[ASCIZ " AT "]]
	PUSHJ	PP,LSTMES
	MOVE	TA,[POINT 3,-4(PP),17]

XPM3:	ILDB	CH,TA
	ADDI	CH,"0"
	PUSHJ	PP,PUTLST
	TLNE	TA,770000
	JRST	XPM3

	MOVE	TE,[POINT 7,[ASCIZ " IN PHASE "]]
	PUSHJ	PP,LSTMES
	MOVE	CH,PHASEN
	PUSHJ	PP,PUTLST
	PUSHJ	PP,LCRLF

	POP	PP,TE
	POP	PP,CH
	POPJ	PP,

	>


	TF==TE-1
	TG==TF-1
	TH==TG-1		;[041]
SUBTTL GET MORE CORE

;SETCOR IS ENTERED WITH DESIRED NEW JOBREL VALUE IN "TE"

SETCOR:	IORI	TE,1777

	CAMN	TE,.JBREL##	;AREA BEING CHANGED?
	POPJ	PP,		;NO--RETURN

	CORE	TE,		;TRY TO GET CORE
	JRST	NOSET		;CAN'T--NO COMPILATION POSSIBLE

	JRST	ADCOR1

ADDCOR:	HRRZ	TE,.JBREL	;FORM NEW JOBREL
	ADDI	TE,2000

	CORE	TE,		;TRY TO GRAB CORE
	JRST	NOADD		;CAN'T GET MORE--ABORT COMPILATION

ADCOR1:	HRRZ	TE,.JBREL
	ADDI	TE,1
	MOVEM	TE,TOPLOC

IFN DEBUG,<
	MOVE	TE,PHASEN
	CAIN	TE,"A"
	  POPJ	PP,
	MOVE	TE,[POINT 7,[ASCIZ "EXPANDING CORE"]]
	PUSHJ	PP,LSTMES
	PUSHJ	PP,LCRLF
	>

	POPJ	PP,
;CANNOT EXPAND CORE

NOADD:	OUTSTR	[ASCIZ "?Not enough core to continue compilation
"]
	JRST	RESTRT

;CANNOT SET CORE TO INITIAL SIZE

NOSET:	OUTSTR	[ASCIZ "?Not enough core to start compilation
"]
	EXIT


EXTERNAL TOPLOC,PHASEN
EXTERNAL NAMNXT,FREESP,SAVEAC,NAMLOC,NM1LOC,NM2LOC,CURNAM


	END