Google
 

Trailing-Edge - PDP-10 Archives - BB-H580C-SB_1981 - xpand.mac
There are 14 other files named xpand.mac in the archive. Click here to see a list.
; UPD ID= 2915 on 6/4/80 at 2:33 PM by WRIGHT                           
TITLE	XPAND FOR COBOL V12B
SUBTTL	EXPAND THE SIZE OF ANY TABLE	AL BLACKINGTON/CAM



;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1974, 1981 BY DIGITAL EQUIPMENT CORPORATION

	SEARCH	P
	%%P==:%%P
	DEBUG==:DEBUG

;EDITS
;NAME	DATE		COMMENTS
;DAW	26-FEB-79	[640] FIX ILLEGAL MEMORY REFERENCE WHEN EXPANDING
;			TABLES IN PHASE O
;V12 RELEASED *****
;V10*****************
;
;DPL	18-AUG-76	[440] FIX XPANDING NAMTAB CAUSING SPURIOUS ERRS
;********************


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 RESTRT

XPAND:


	DEFINE TABSET (A,B,C,E,F,G,H),<
	IFN 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##
IFN XPNTST,<
	ENTRY XP1'A
XP1'A:	MOVEM	TA,SAVEAC+17
	SKIPN	TYPXPN##
	 JRST	.+3
	MOVE	TA,[POINT 7,[ASCIZ "E"]]
	PUSHJ	PP,TPMESS
	MOVE	TA,A'XP1
	JRST	XPAND0
A'XP1:	XWD	1,A'LOC##
>;END IFN XPNTST
	>>



	TABLES
XPAND0:	MOVEM	TA,SAVEAC	;SAVE AC'S TG THRU TB
	MOVE	TA,[XWD TG,SAVEAC+1]
	BLT	TA,SAVEAC+6

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

	PUSHJ	PP,ADDCOR	;NO--GET MORE CORE

	MOVE	TE,PHASEN	;IF WE ARE
	CAIE	TE,"E"		;[640] IN PHASE E, OR
	CAIN	TE,"O"		;[640] IN PHASE O, THEN
	JRST	XPND0B		;  DON'T MOVE NAME TABLE

	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
	ADDM	TE,NAMADR##	;[440]
	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)	;TG_XWD  -<SIZE TO MOVE>,<TOP LOCATION>
	HRRZ	TB,FREESP
	SUB	TA,TB
	MOVS	TG,TA
	HRRI	TG,-1(TB)

	MOVE TA,[XWD AOBUP,TF]	;SET UP AC'S
	BLT	TA,TB
	HLR	TE,SAVEAC
	JRST	TF
;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
	HRRZ	TF,(TE)		; [D] IF THIS TABLE IS EMPTY,
	JUMPE	TF,XPAND5	; [D] DON'T CHANGE ANYTHING.
	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)
XPAND5:	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 TG,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 TF THRU TB.
;IT MOVES CONTENTS OF LOCATIONS UP IN CORE BY AMOUNT EXPANDED.

AOBUP:	MOVE	TA,(TG)
	MOVEM	TA,(TG)		;THE ADDRESS OF THIS WILL BE AMOUNT TO EXPAND
	SUBI	TG,2
	AOBJN	TG,TF
	JRST	XPAND2
;PRINT OUT DEBUG MESSAGE

	IFN DEBUG,<EXTERNAL LSTMES,PUTLST,LCRLF

IFN XPNTST,<
;TYPE MESSAGE ON TTY
TPMESS:	PUSH	PP,CH
	PUSH	PP,TE
	MOVE	TE,[POINT 7,[ASCIZ "Expanding "]]
	PUSHJ	PP,TPMSST	;TYPE STRING
	MOVE	TE,TA		;GET TABLE B.P.
	PUSHJ	PP,TPMSST	;PRINT THAT STRING TOO
	MOVE	TE,[POINT 7,[ASCIZ " at "]]
	PUSHJ	PP,TPMSST
	MOVE	TE,[POINT 3,-2(PP),17]

TPMS1:	ILDB	CH,TE
	ADDI	CH,"0"
	OUTCHR	CH
	TLNE	TE,770000
	JRST	TPMS1
	MOVE	TE,[POINT 7,[ASCIZ/
/]]
	PUSHJ	PP,TPMSST
	POP	PP,TE		;RESTORE SAVED ACS
	POP	PP,CH
	POPJ	PP,

TPMSST:	ILDB	CH,TE		;GET CHAR OF STRING
	JUMPE	CH,[POPJ PP,]	;DONE, RETURN
	OUTCHR	CH		;TYPE IT
	JRST	TPMSST		;LOOP
>;END IFN XPNTST

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,-2(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
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

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

	JRST	ADCOR1

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

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

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

	POPJ	PP,
;CANNOT EXPAND CORE

NOADD:	TTCALL	3,[ASCIZ "?Not enough memory to continue compilation
"]
	JRST	RESTRT

;CANNOT SET CORE TO INITIAL SIZE

NOSET:	TTCALL	3,[ASCIZ "?Not enough memory to start compilation
"]
	CALLI	$EXIT


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


	END