Trailing-Edge
-
PDP-10 Archives
-
BB-H506D-SM_1983
-
cobol/source/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