Trailing-Edge
-
PDP-10 Archives
-
CFS_TSU04_19910205_1of1
-
update/cblsrc/xfrgen.mac
There are 7 other files named xfrgen.mac in the archive. Click here to see a list.
; UPD ID= 1247 on 6/3/83 at 5:10 PM by HOFFMAN
TITLE XFRGEN FOR COBOL V13
SUBTTL TRANSFER-OF-CONTROL GENERATORS SERG POLEVITSKY/ALB/CAM
SEARCH COPYRT
SALL
;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, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
SEARCH P
%%P==:%%P
IFN TOPS20,<SEARCH MONSYM,MACSYM>
TWOSEG
.COPYRIGHT ;Put standard copyright statement in REL file
RELOC 400000
SALL
;EDITS
;NAME DATE COMMENTS
;V12A****************
;WTK 8-Jan-81 [1111] PERFORM LIMIT EXCEEDED when doing many executions of DECLARATIVES.
;DMN 1-FEB-80 [762] IMPLEMENT AND USE D. P. FLOATING POINT LITERALS
;V12*****************
;DAW 28-SEP-78 [561] FIX "GO DEPENDING" - /O PROBLEM
;V10*****************
; 10-AUG-76 [435] PUT IN CODE TO JUMP AROUND DECLARITIVES IN A DBMS PROG
; 14-APR-76 [425] FIX KPROG CALL IN NON-RESIDENT SECTION.
;DBT 1/20/75 SET AND CLEAR FLAG INDICATING INSTRUCTIONS
; NOT BEING PUT INTO ASY RATHER LITTAB
; SET AT SEGCLN AND CLEAR AT EBURPX
;DBT 1/18/75 IN GOENTR AND GOALTD THE REVERSED ORDER
; OF PUTASY AND PUTASN CALLS IS FOOLING THE
; UUO CONVERTER - REVERSE THEM
; ALSO EXITRP
; IT IS NOT CLEAR THATTHIS WILL WORK BUT IT'S
; WORTH A TRY
;ACK 22-APR-75 CONVERT LITAB EBCIDC CODE TO ASYFIL EBCDIC
; CODE WHEN TRANSFERING LITERALS TO THE ASY FILES.
;********************
; EDIT 271 FIX SO THAT GENERATED PARA NAME NEVER GETS TRACED
;**; EDIT 210 ADD TO FIX 167-LITTAB OVERFLOW
;*; EDIT 167 JEC 3/14/74 FIXES LITTAB OVERFLOW.
; IN THIS ROUTINE THE REQUIREMENT THAT THE ENTIRE
; LITERAL BE ALL IN CORE IS REMOVED.
ENTRY XFRGEN
XFRGEN:
INTERNAL PARGEN,GOGOGN,SECGEN,ALTGEN,PERFGN,STOPGN,GODPGN,PRFYGN
INTERN IPRFGN,EPRFGN
INTERNAL EWARN, RESOLV, SOLVER
INTERNAL TAGGEN, JUMPTO, SEGBRK, SEGCLN
INTERNAL DECLST,DECLEN ;[435]
EXTERNAL DCLTAG ;[435]
EXTERNAL INDCLR
EXTERNAL BADEOP,FATAL,WARN,LNKSET
IFE TOPS20,<
EXTERN DEVDED
>
EXTERNAL PUTAS1,PUTASY,PUTASN,DISPGN,PUTTAG,KILL,KILLF
EXTERNAL XPNALT,XPNLIT,XPNSEC,SETSEG,OPNFAT,PUT.EX,PUT.PJ,PUT.SX
EXTERNAL STASHP,STASHQ,POOLIT,PLITPC
EXTERNAL COMEBK
EXTERNAL TB.DAT,ESAVER,CUREOP,EOPLOC
EXTERNAL EBASEA,EMODEA,EDPLA,ESIZEA,EINCRA
EXTERNAL EBASEB,EMODEB,EDPLB,ESIZEB,EBASBX,EINCRB
EXTERNAL SOSLE.,SOSGE.,JRST.
EXTERNAL EAS1PC,AS.PAR,D1MODE,LTMODE,FCMODE,AS.OCT
EXTERNAL OPLINE
EXTERN PRODSW
EXTERN SETOPN, PUT.B, PUT.LA, GETTAG, PUTTAG, CONVNL
EXTERN MXAC., MACX., PUTAS1, PUTASY, PUTASN, OPNFAT
;CHECK PROTAB ENTRY FOR VALIDITY
DEFINE ISOPOK (ACSYM),<
TRNE ACSYM,PTDEF ;IS OPERAND DEFINED?
TRNE ACSYM,PTMULD ;BUT NOT MULTIPLY DEFINED?
POPJ PP, ;BAD OPERAND
>
SUBTTL MISCELLANEOUS GENERATORS
TAGGEN: HLRZ CH,W2 ;GET TAG NUMBER
PUSHJ PP,PUTTAG ;PUT TAG INTO TAG TABLE
JRST COMEBK ;RETURN WITHOUT DISTURBING EOPTAB
JUMPTO: HLRZ CH,W2 ;GET TAG FROM LEFT HALF OF W2.
ANDI CH,TM.TAG
IOR CH,[XWD JRST.,AS.TAG] ;CH _ JRST TAG [TAG CONVERTED TO F-G NOTATION].
HRRZ TA,CH ;GET TAG NUMBER
PUSHJ PP,REFTAG## ;REFERENCE IT
PUSHJ PP,PUTASY ;WRITE IT OUT
JRST COMEBK ;RETURN WITHOUT DISTURBING EOPTAB
SEGBRK: SKIPE TA,EPSECT ;CHECK TO SEE IF ANY SECTIONS PRIOR
;TO THIS ONE [IF NOT, HOW COME THERE IS
;A PRIORITY # FLOATING AROUND?]
JRST SETSEG ;PULL THE SCATTERED SEGMENT TOGETHER
OUTSTR [ASCIZ "Internal error: segment # found but no sections detected
"]
JRST KILL
;[435] FOR A DBMS PROG JUMP AROUND DECLARITIVES FROM DBMS SECTION
DECLST: SETOM INDCLR ;FLAG THAT WE ARE IN THE DECLARATIVES
IFN DBMS,<
SKIPN SCHSEC## ;IS THIS A DBMS PROGRAM?
>
POPJ PP, ;NO
IFN DBMS,<
PUSHJ PP,GETTAG ;[435] JUST BEFORE START OF DECLARITIVES GET A TAG TO JUMP TO
HRLI CH,JRST. ;[435] PUT IN JRST %TAG
HRRZM CH,DCLTAG ;[435] SAVE FOR LATER PUTTAG ADDR ASSIGNMENT
HRRZ TA,CH ;GET TAG NUMBER
PUSHJ PP,REFTAG## ;REFERENCE IT
PJRST PUTASY ;[435] PUT JRST %TAG INTO ASY FILE
>
DECLEN: SETZM INDCLR ;FLAG THAT WE ARE OUT OF THE DECLARATIVES
IFN DBMS,<
SKIPE SCHSEC ;IS THIS A DBMS PROGRAM?
HRROS DCLTAG ;[435] FLAG THAT WE ARE AT END OF DECLARITIVES
>
HRRZ CH,PROGLN## ;GET LINE NO. OF FIRST PROCEDURE
DPB CH,[POINT 13,PREVW1,28] ;SET IT INCASE FIRST PROCEDURE HAS NO VERB
POPJ PP, ;[435] RETURN
SUBTTL SECTION GENERATOR
SEENIT=1B35
SECGEN: HRRZ TA,EOPLOC ;IS THERE ONE AND ONLY ONE OPERAND?
HRRZ EACA,EOPNXT
CAIE TA,-2(EACA)
JRST BADEOP ;NO--TROUBLE
HRRZ TA,(EACA) ;GET PROTAB POINTER.
PUSHJ PP,LNKSET ;CONVERT LINK TO REAL ADDRESS
HRRZ EACD,2(TA) ;GET PRIORITY # FROM PROTAB
TROE EACD,SEENIT ;CHECK TO SEE IF
;YOU HAVE SEEN THIS SECTION BEFORE
;AND MARK IT AS "SEEN".
;IF YOU HAVE SEEN A SECTION BEFORE &
;BECAUSE OF SEGMENTATION
;YOU ARE DOING RANDOM READING, THE COMPILER
;COULD ENDLESSLY LOOP IF YOU DIDN'T DO THIS
;CHECK
JRST PREVLP ;PREVENT ENDLESS RE-READING OF THE SOURCE.
HRRM EACD,2(TA) ;UPDATE PROTAB ENTRY.
LDB EACC,FLAGPS ;GET PREVIOUSLY-SEEN SECTION'S FLAGS & PRIORITY #
ANDI EACC,ENREZE ;STRIP OFF ALL BUT PRIORITY BITS FOR LAST-SEEN OPERATOR
ANDI EACD,ENREZE ;STRIP OFF SECTION PRIORITY BITS FOR ITEM HELD IN HAND
CAIE EACC,(EACD) ;EQUAL ?
PUSHJ PP,SEGCLN ;NOPE! CHECK TO SEE IF CLEAN UP NECESSARY
;THEN PROCESS THE OPERATOR HELD IN HAND
SKIPGE W2,EPPARA ;IF 1ST PARAGRAPH NOT SEEN YET, OR LAST
;PARAGRAPH DOES NOT REQUIRE AN EXIT,
;DO NOT CHECK LAST
;PARAGRAPH'S STATUS.
;BIT 0 WILL BE UP IN EPPARA IF EXIT REQUIRED
PUSHJ PP,ESETUP ;SET POINTERS UP FOR CALL TO PARGEN
MOVEI EACC,EPSECT ;POINTER NOW REFLECTS FLAGS AND LINK
;FOR THE SECTION OPERATOR.
SKIPL W2,EPSECT ;IF PREVIOUS SECTION NEEDS EXIT, OR
TLNE W2,PTDECL*2 ; IT IS IN DECLARATIVES,
PUSHJ PP,EXITRP ; PUT OUT EXIT.
JRST EGETPR ;LEAVE FROM HERE FOR PARGEN.
ESETUP: MOVEI EACC,EPPARA ;TELL PARGEN THAT PREVIOUS
;PROCEDURE NAME WAS A PARAGRAPH
;NAME.
JRST EXITRP ;GO TO PARGEN
PREVLP: OUTSTR [ASCIZ "Internal error: incorrect source linkage
"]
JRST KILL
SUBTTL THE PARAGRAPH GENERATOR
EPAREX=1B18 ;THE ALERT FLAG TO SIGNAL THE
;GENERATING OF AN EXIT AT THE END OF
;THE LAST-SEEN PROCEDURE NAME OF TYPE
;SPECIFIED BY (EACC).
ECPFLG=6B20 ;CHANGE THE PROTAB FLAG FROM
;PHASE E NOMANCLATURE TO PHASE F-G
;NOMANCLATURE.
PARGEN: HRRZ TA,EOPLOC ;IS THERE ONE AND ONLY ONE OPERAND?
HRRZ EACA,EOPNXT
CAIE TA,-2(EACA)
JRST BADEOP ;NO--TROUBLE
MOVEI EACC,EPPARA ;ADDRESS FOR WHICH "PREVIOUS"
;PROCEDURE NAME WILL APPLY.
;
;
SKIPGE W2,EPPARA ;AS YOU COME TO THE PARAGRAPH
;GENERATOR, EPPARA CAN BE EITHER
;> 0 , OR = 0, THEN NO CHECKING NEEDED
;< 0 THEN CHECKS NEED TO BE MADE
PUSHJ PP,EXITRP ;AN EXIT IS REQUIRED!
;IF YOU COME FROM SCANNER ROUTINE,I.E., PARGEN CALLED DIRECTLY, YOU WILL
;BE INTERESTED IN THE PREVIOUS AND CURRENT PARAGRAPH OPERATORS.
;IF YOU COME FROM SECGEN, THEN YOU WILL BE INTERESTED IN THE PREVIOUS SECTION
;AND CURRENT SECTION OPERATORS
;IF YOU CAME TO THE PARAGRAPH GENERATOR AS PART OF THE CLEAN UP ACTIVITY AT
;A SEGMENT BREAK OR THE END OF PHASE E, THEN ALL THAT YOU
;ARE INTERESTED IN DOING IS GENERATING AN EXIT IF IT IS REQUIRED.
EGETPR: MOVE CH,EPGFIX ;"I AM A SECTION OR PARAGRAPH" TO CH.
;RIGHT HALF LOADED WITH MASK WHICH WILL
;CHANGE TABLE LINK TYPE FROM 4 TO 2.
HRRZ TA,(EACA) ;GET PROTAB LINK AS POINTED TO BY EACA.
XORI CH,(TA) ;CHANGE D-E NOTATION TO F-G NOTATION
;FOR PROTAB ENTRY.
HRRM TA,(EACC) ;UPDATE EPSECT OR EPPARA WITH CURRENT PROTAB ENTRY.
PUSHJ PP,LNKSET ;GET REAL ADDRESS
LDB EACD,PR.DEB ;DEBUGGING ON THIS PARA?
JUMPE EACD,EGTPR1 ;NO
PUSH PP,CH ;SAVE PARA NAME
MOVE CH,[SKIPA.##+AC16+ASINC,,AS.MSC]
PUSHJ PP,PUTASN
MOVEI CH,AS.DOT+1
PUSHJ PP,PUTASY ;SKIPA 16,.+1
MOVE CH,[AS.XWD,,1]
PUSHJ PP,PUTASN
MOVEI CH,DBP%FT ;FALL THROUGH CODE
PUSHJ PP,PUTASN ;IN LHS
LDB CH,[POINT 13,PREVW1##,28] ;GET LINE # OF PREVIOUS OPERATOR
PUSHJ PP,PUTASY
MOVE CH,[MOVEM.+AC16+ASINC,,AS.MSC]
PUSHJ PP,PUTASN
MOVE CH,DBPARM
IORI CH,AS.PAR
PUSHJ PP,PUTASY ;MOVEM 16,%PARAM+N
POP PP,CH
EGTPR1: HRLZ EACD,2(TA) ;EACD _ FLAG BITS FROM PROTAB
TLNN EACD,PTDEF ;IF ITEM IS NOT DEFINED,
TLNE EACD,PTMULD ; [271] ON MEANS GENERATED PARA NAME
SKIPA ; [271]
POPJ PP, ; FORGET IT
HRRZM TA,CURPRO ;SAVE ADDRESS OF THIS ENTRY
LSH EACD,-^D1 ; !.... SHIFT EACD RIGHT SO AS TO BE
;ABLE TO FIT IN A FLAG IN THE SIGN BIT DENOTING
;WHETHER OR NOT AN EXIT IS REQUIRED.
;IF EITHER EPPARA OR EPSECT NEEDS EXIT
;FOR CURRENT PROCEDURE NAME, CELL IS LESS THAN 0.
TLNE EACD,1B27 ;BIT 26 (BEFORE THE LSH EACD,-1), NOW BIT 27
;EQUIVALENT IN THE LEFT HALF OF EACD.
;SAYS WHETHER OR NOT ITEM REQUIRES EXIT GENERATED
;IF AN EXIT IS NEEDED, THEN
;BIT 27'S LEFT HALF EQUIVALENT IS ON. IF NO EXIT,
;THEN BIT 27'S EQUIVALENT IN LEFT HALF IS OFF.
;SKIP IF OFF.
TLO EACD,EPAREX ;EXIT REQUIRED FLAG GOES UP
;PROTAB FLAGS +
HLLM EACD,(EACC) ;FLAG FOR EXIT <IF NEEDED> IN LEFT HALF
;<LINK TO PROTAB IN RIGHT HALF>
;RESULT ALSO LEFT IN EACD.
TLNE EACD,ENREZF ;IF ITEM IS RESIDENT (PRIORITY # FROM PROTAB ENTRY
;IS ZERO IN BITS 19-25 (AFTER LSH -1))
;PUT CH OUT ONTO AS2.
;IF NON-RESIDENT, PUT ONTO AS3.
;SKIP IF RESIDENT.
SKIPA TC,EAS3PC ;PRIORITY NOT = 0--->GET NON-RES PPC\
MOVE TC,EAS2PC ;PRIORITY = 0 ---> GET RES-PPC.
MOVE TA,CURPRO
HRRM TC,1(TA) ;PROTAB ENTRY UPDATED!
PUSHJ PP,PUTASN ;SECTION OR PARAGRAPH OPERATOR GOES OUT
;AND PPC IS NOT! BUMPED.
IFN DBMS,<
SKIPL DCLTAG ;[435] ARE WE AT END OF DECLARITIVES?
JRST EGTPR3 ;[435] NO
HRRZ CH,DCLTAG ;[435] YES--GET JUMP TO TAG
PUSHJ PP,PUTTAG ;[435] AND ASSIGN IT HERE
SETZM DCLTAG ;ONLY DO IT ONCE
EGTPR3:> ;[435]
TLNE EACD,PTDEF/2 ; [271] IF GENERATED NAME NO TRACE
SKIPE PRODSW ;IF '/P' TYPED,
POPJ PP, ; NO TRACE CODE
MOVEI CH,C.TRCE##
PUSHJ PP,PUT.PJ
MOVE CH,[XWD AS.XWD,1]
PUSHJ PP,PUTASN
MOVE TA,CURPRO ;JUST INCASE
LDB CH,PR.DEB## ;DEBUGGING REQUIRED?
SKIPN CH
AOSA CH ;NO, SET CH TO 1 WORD
MOVEI CH,TC.DB+2 ;YES, NEED 2 WORDS
PUSHJ PP,PUTASN
HRRZ CH,0(EACC)
PUSHJ PP,GETPR% ;GET CORRECT %PR OFFSET
PUSHJ PP,PUTASY
LDB CH,PR.DEB ;DID WE WANT DEBUGGING USE
JUMPE CH,CPOPJ## ;NO
PUSH PP,CH ;YES
MOVE CH,[AS.XWD,,1]
PUSHJ PP,PUTASN
HRLZ CH,DBPARM## ;GET %PARAM TO USE
TLO CH,AS.PAR ;MAKE INTO %PARAM+N
HRRI CH,AS.MSC
PUSHJ PP,PUTASN
POP PP,TA ;DEBUG USE PROCEDURE
ADD TA,USELOC## ;POINT TO USE TABLE
LDB CH,US.PRO## ;GET TAG OF USE PROCEDURE
JRST PUTASY ;PUT OUT CODE
;THE RETURN IS EITHER TO ENTERS IN THE
;SCANNER ROUTINE
;TO A CLEAN UP ROUTINE ,
;OR TO THE SECTION GENERATOR
GETPR%: TRZ CH,700000 ;GRNTEE ADRCON
PUSH PP,CH+1 ;WE NEED TO CHANGE THE SIZE
IDIVI CH,SZ.PRO ; BECAUSE THE COMPILER USES SZ.PRO = 5
IMULI CH,SZ.PR6 ; WORDS, WHERE AS COBDDT ONLY SEES SZ.PR6 = 4
ADD CH,CH+1 ;WORDS. ADD IN THE EXTRA 1
POP PP,CH+1 ;THIS SAVES SPACE AND MAKES -68 AND -74 THE SAME
POPJ PP,
EPGFIX: XWD 740000,ECPFLG ; THE XOR OPERATION WITH THIS MASK
;WILL SET UP THE PARAGRAPH OPERATOR USED
;IN THIS PHASE (PHASE E) SO AS TO BE INTELLIGIBLE
;TO THE ASSEMBLY PHASE.
EXITRP: MOVSI CH,1B18 ;RESET EXIT REQ'D FLAG FOR THIS PROCEDURE NAME
ANDCAM CH,(EACC) ;STORE BACK INTO EITHER EPPARA OR EPSECT
SKIPE NRESSN## ;DID WE SEE ANY NON-RESIDENT SECTION?
JRST EXITNR ;YES, DO IT THE SLOW WAY
MOVE TA,(EACC) ;GET PROCEDURE NAME'S PROTAB LINK
;...LINK POINT BACK TO LAST-SEEN PROCEEDURE
PUSHJ PP,LNKSET ;CONVERT LINK TO REAL ADDRESS
HLRZ CH,3(TA) ;GET EXIT WORD <IF ONE IN PROTAB>
CAIN CH,0 ;NO LINK? THEN GO ALLOCATE ONE...
;TA IS EXPECTED TO HOLD POINTER TO
;PROPER PROTAB ENTRY, ABSOLUTE ADDRESS TYPE.
PUSHJ PP,EALLOC ;ALLOCATE AN EXIT WORD [0CT 0]
;EALLOC SUBROUTINE IS EXPECTED
;TO RETURN LINK IN CH, IF
;EXIT WORD NEEDS TO BE CREATED ON THE SPOT.
;PROTAB UP-DATED BY EALLOC SUBROUTINE.
PUSH PP,CH ;SAVE ADDRESS
SKIPE QUIKSW## ;/Q?
JRST EXITQ ;YES
;NO
;HERE FOR NORMAL EXIT IN RESIDENT SECTION
;GENERATES:
; SKIPN %PARAM+n
; JRST .+7
; SOS %PARAM+n
; HLRZ 10,0(17)
; CAME 10,LEVEL.##
; PUSHJ 17,EXIT.E##
; SOS LEVEL.##
; JRST @TRAC2.##
MOVE CH,[SKIPN.##+ASINC,,AS.MSC]
PUSHJ PP,PUTASN
MOVE CH,0(PP)
PUSHJ PP,PUTASY ;SKIPN %PARAM+N
MOVE CH,[JRST.+ASINC,,AS.MSC]
PUSHJ PP,PUTASN
MOVEI CH,AS.DOT+7
PUSHJ PP,PUTASY ;JRST .+7
MOVE CH,[SOS.##+ASINC,,AS.MSC]
PUSHJ PP,PUTASN
POP PP,CH
PUSHJ PP,PUTASY ;SOS %PARAM+N
PUSHJ PP,PUTASA
MOVSI CH,HLRZ.##+AC10+17
PUSHJ PP,PUTASY ;HLRZ 10,(17)
MOVE CH,[CAME.##+AC10,,LEVEL.]
PUSHJ PP,PUT.EX ;CAME 10,LEVEL.
MOVEI CH,EXIT.E##
PUSHJ PP,PUT.PJ ;PUSHJ P,EXIT.E
MOVE CH,[SOS.,,LEVEL.]
PUSHJ PP,PUT.EX ;SOS LEVEL.
SKIPN PRODSW
JRST EXITRN ;NON-PRODUCTION
MOVSI CH,POPJ.##+AC17
JRST PUTASY
EXITRN: PUSHJ PP,PUTASA##
MOVE CH,[XJRST.##+<(@)>,,TRAC2.##]
JRST PUT.EX ;NON-PRODUCTION
;HERE FOR QUICK EXIT IN RESIDENT SECTION
;GENERATES:
; SOSL %PARAM+n
; SOS LEVEL.## ;If in DECLARATIVES
; POPJ 17,
; AOS %PARAM+n
EXITQ: PUSHJ PP,PUTASA
MOVE CH,[SOSL.##+ASINC,,AS.MSC]
PUSHJ PP,PUTASN
MOVE CH,0(PP)
PUSHJ PP,PUTASY ;ASSUME WE PERFORMED THE EXIT
LDB CH,PR.DFD## ;[1111] FIND OUT IF THIS IS
JUMPE CH,EXITQA ;[1111] A DECLARATIVE EXIT
MOVE CH,[SOS.,,LEVEL.] ;[1111] SOS LEVEL. (DECREMENT TO
PUSHJ PP,PUT.EX ;[1111] COMPLEMENT THE AOS IN PERF.)
EXITQA: MOVSI CH,POPJ.##+AC17
PUSHJ PP,PUTASY ;OK, WE DID
MOVE CH,[AOS.##+ASINC,,AS.MSC]
PUSHJ PP,PUTASN
POP PP,CH
JRST PUTASY ;NO, WE DIDN'T
;HERE FOR EXIT WHEN NON-RESIDENT SECTION SEEN
EXITNR: MOVE CH,[ASINC+XIT##,,AS.MSC] ;EXIT UUO
PUSHJ PP,PUTASY
MOVE TA,(EACC) ;GET PROCEDURE NAME'S PROTAB LINK
;...LINK POINT BACK TO LAST-SEEN PROCEEDURE
PUSHJ PP,LNKSET ;CONVERT LINK TO REAL ADDRESS
HLRZ CH,3(TA) ;GET EXIT WORD <IF ONE IN PROTAB>
CAIN CH,0 ;NO LINK? THEN GO ALLOCATE ONE...
;TA IS EXPECTED TO HOLD POINTER TO
;PROPER PROTAB ENTRY, ABSOLUTE ADDRESS TYPE.
PUSHJ PP,EALLOC ;ALLOCATE AN EXIT WORD [0CT 0]
;EALLOC SUBROUTINE IS EXPECTED
;TO RETURN LINK IN CH, IF
;EXIT WORD NEEDS TO BE CREATED ON THE SPOT.
;PROTAB UP-DATED BY EALLOC SUBROUTINE.
JRST PUTASN
SUBTTL THE PERFORM GENERATOR
PERFGN: MOVEM W1,OPLINE ;SAVE LN&CP OF OPERATOR
MOVE EACA,EOPNXT
CAMN EACA,EOPLOC ;ANY OPERANDS?
JRST BADEOP ;NO--TROUBLE
HRRZ TC,EOPLOC ;GET ADDRESS OF FIRST OPERAND
ADDI TC,1
MOVSM TC,OPERND
MOVEI TE,-1(EACA) ;ALSO ADDRESS OF SECOND OPERAND
HRRM TE,OPERND
CAIN TC,0(TE) ;IS THERE ONLY ONE OPERAND?
JRST PERF1 ;YES
CAIE TC,-2(TE) ;NO--IS THERE ONLY TWO OPERANDS?
JRST BADEOP ;NO--ERROR
PUSHJ PP,SOLVER ;CONVERT FLOTAB TO PROTAB FOR "A"
MOVEM TA,-2(EACA)
PERF1: PUSHJ PP,RESOLV ;CONVERT FLOTAB TO PROTAB FOR "B" (OR ONLY)
MOVEM TA,0(EACA) ;LHS is guaranteed to be zero
CAIL TA,500000 ;Is it pointing to TAGTAB ?
CAIL TA,600000
TRNA ;No, its a normal PROTAB entry
JRST PERF3 ;Yes, get real address, and cont.
PUSHJ PP,LNKSET ;Get flags for
HRRZ EACB,PTFLAG(TA) ; "B"
MOVS TA,OPERND ;GET
MOVE TA,1(TA) ; FLAGS
PUSHJ PP,LNKSET ; FOR
LDB EACD,PR.DEB ;DEBUGGING ON THIS PARA?
JUMPE EACD,PERF2 ;NO
MOVE CH,[SKIPA.##+AC11+ASINC,,AS.MSC]
PUSHJ PP,PUTASN
MOVEI CH,AS.DOT+1
PUSHJ PP,PUTASY ;SKIPA 16,.+1
MOVE CH,[AS.XWD,,1]
PUSHJ PP,PUTASN
SKIPN CH,PERFCD## ;CODE ALREADY SET?
MOVEI CH,DBP%PL ;NO, USE PERFORM LOOP CODE
PUSHJ PP,PUTASN ;IN LHS
SETZM PERFCD
LDB CH,[POINT 13,PREVW1##,28] ;GET LINE # OF PREVIOUS OPERATOR
PUSHJ PP,PUTASY
MOVE CH,[MOVEM.+AC11+ASINC,,AS.MSC]
PUSHJ PP,PUTASN
MOVE CH,DBPARM
IORI CH,AS.PAR
PUSHJ PP,PUTASY ;MOVEM 16,%PARAM+N
PERF2: MOVE EACD,PTFLAG(TA) ; "A"
ISOPOK EACB; CHECK TO SEE THAT "B" LEGAL
ISOPOK EACD; ALSO "A"
TRNE EACB,PTXFER ;DOES "B" HAVE UNCONDITIONAL TRANSFER?
PUSHJ PP,NOEXIT ;YES, WARN USER
LDB EACC,FLAGPP ;GET FLAGS FOR CURRENT PARAGRAPH
;EVERYTHING OK--GENERATE THE PERFORM
;GENERATES
; AOS %PARAM+n
MOVE CH,[AOS.##+ASINC,,AS.MSC]
PUSHJ PP,PUTASN
MOVE TA,OPERND ;DO WE
MOVE TA,1(TA) ; HAVE AN
PUSHJ PP,LNKSET ; EXIT WORD
HLRZ CH,3(TA) ; FOR THIS
SKIPN CH ; PARAGRAPH OR SECTION?
PUSHJ PP,EALLOC ;NO--GET ONE
PUSHJ PP,PUTASY ;GENERATE AOS %PARAM+N
SKIPE QUIKSW ;/Q?
SKIPE NRESSN ;YES, ANY NON-RES SECTIONS?
JRST PERF6 ;NOT /Q ALL RESIDENT
;HERE FOR PERFORM OF ALL RESIDENT SECTIONS IN QUICK MODE
;GENERATES:
; PUSHJ 17,<paragraph-name>
MOVS TA,OPERND ;GET SET FOR THE "GO"
HRRZ CH,1(TA)
MOVEI CH,ECPFLG(CH)
SETZM GODPOV## ;[V10] MAKE SURE THAT THE SPECIAL
;[V10] GO DEPENDING FLAG IS OFF.
PERF2A: HRLI CH,EPJPP
JRST PUTASY ;GENERATE PUSHJ 17,<PERFORM-PARA>
;Here for in-line PERFORM
;If not in quick mode generates
; AOS 11,LEVEL.##
; MOVS 11,11
; HRRI 11,.+3
; PUSH 17,11
; JRST %TAG
;If in quick mode generates
; PUSHJ PP,%TAG
PERF3: MOVE CH,TA
SKIPE QUIKSW ;/Q?
JRST PERF2A ;YES, PERFORM-PARA = TAG
PUSH PP,CH ;SAVE TAG FOR JRST %TAG
MOVE CH,[AOS.+AC11,,LEVEL.##]
PUSHJ PP,PUT.EX ;GENERATE AOS 11,LEVEL.##
MOVE CH,[MOVS.##+AC11,,11]
PUSHJ PP,PUTASY ;GENERATE MOVS 11,11
MOVE CH,[HRRI.##+ASINC+AC11,,AS.MSC]
PUSHJ PP,PUTASN
MOVEI CH,AS.DOT+3
PUSHJ PP,PUTASY ;GENERATE HRRI 11,.+3
PUSHJ PP,PUTASA##
MOVE CH,[PUSH.##+AC17,,11]
PUSHJ PP,PUTASY ;GENERATE PUSH 17,11
PUSHJ PP,PUTASA##
POP PP,CH ;GET TAG
AOS CH
HRLI CH,XJRST.
JRST PUTASY ;GENERATE JRST %TAG
;HERE FOR PERFORM OF EITHER NOT /Q OR NOT ALL RESIDENT (OR BOTH)
;GENERATES
; AOS 11,LEVEL.##
; MOVS 11,11
; HRRI 11,.+4
; PUSH 17,11
; MOVEI 10,<paragraph-name>+1
; JRST @TRAC3.##
PERF6: MOVE CH,[AOS.+AC11,,LEVEL.##]
PUSHJ PP,PUT.EX ;GENERATE AOS 11,LEVEL.##
MOVE CH,[MOVS.##+AC11,,11]
PUSHJ PP,PUTASY ;GENERATE MOVS 11,11
CAIGE EACC,1B24 ;IN RESIDENT SECTION
JRST PERF7 ;YES
MOVE CH,[TLO.##+AC11+ASINC,,AS.CNB]
PUSHJ PP,PUTASY ;NO
LDB CH,[POINT 7,EACC,24] ;GET CURRENT LEVEL
LSH CH,^D10
PUSHJ PP,PUTASN ;GENERATE TLO 11,LEVEL_^D10
PERF7: XOR EACC,EACD ;SEE IF IN SAME SECTION
TRNE EACC,ENREZE
JRST PERF8 ;NOT
XOR EACC,EACD ;PUT SECTION NUMBER BACK
MOVE CH,[HRRI.##+ASINC+AC11,,AS.MSC]
PUSHJ PP,PUTASN
MOVEI CH,AS.DOT+4
SKIPE PRODSW ;IF /P SEEN
MOVEI CH,AS.DOT+3 ;ONE LESS WORD GENERATED
PUSHJ PP,PUTASY ;GENERATE HRRI 11,.+4
PUSHJ PP,PUTASA##
MOVE CH,[PUSH.##+AC17,,11]
PUSHJ PP,PUTASY ;GENERATE PUSH 17,11
MOVS TA,OPERND ;GET SET FOR THE "GO"
HRRZ CH,1(TA)
MOVEI CH,ECPFLG(CH)
SETZM GODPOV## ;[V10] MAKE SURE THAT THE SPECIAL
;[V10] GO DEPENDING FLAG IS OFF.
SKIPN PRODSW ;IF /P
JRST PERFDB ;PERFORM DEBUGGING
PUSH PP,CH ;SAVE CH FROM PUTASA
PUSHJ PP,PUTASA ;ALTERNATE SET
POP PP,CH ;RESTORE IT
HRLI CH,XJRST.
JRST PUTASY ;GENERATE JRST <PERFORM-PARA>
PERFDB: HRLI CH,MOVEI.+AC10+ASINC
PUSHJ PP,PUTASN
MOVEI CH,AS.ABS##+1
PUSHJ PP,PUTASY ;GENERATE MOVEI 10,<PERFORM-PARA>+1
PUSHJ PP,PUTASA##
MOVE CH,[XJRST.+<(@)>,,TRAC3.##]
JRST PUT.EX
;HERE WHEN DESTINATION AND SOURCE NOT SAME PRIORITY
PERF8: XOR EACC,EACD ;PUT SECTION PRIORITY BACK
MOVE CH,[HRRI.##+ASINC+AC11,,AS.MSC]
PUSHJ PP,PUTASN
MOVEI CH,AS.DOT+6
SKIPE PRODSW ;IF /P SEEN
MOVEI CH,AS.DOT+4 ;TWO LESS WORD GENERATED
PUSHJ PP,PUTASY ;GENERATE HRRI 11,.+6
PUSHJ PP,PUTASA##
MOVE CH,[PUSH.##+AC17,,11]
PUSHJ PP,PUTASY ;GENERATE PUSH 17,11
SKIPE PRODSW ;/P?
JRST PERF9 ;YES
MOVE CH,[MOVEI.+AC10+ASINC,,AS.MSC]
PUSHJ PP,PUTASN
MOVEI CH,AS.DOT+3
PUSHJ PP,PUTASY ;GENERATE MOVEI 10,.+3
PUSHJ PP,PUTASA##
MOVE CH,[XJRST.+<(@)>,,TRAC3.]
PUSHJ PP,PUT.EX ;GENERATE PUSHJ 17,@TRAC3.
PERF9: MOVE CH,[OVLAY.+ASINC,,AS.MSC]
PUSHJ PP,PUTASY
MOVS TA,OPERND ;GET SET FOR THE "GO"
HRRZ CH,1(TA)
MOVEI CH,ECPFLG(CH)
HRLM CH,CURPRO ;SAVE PROTAB TO BE RESOLVED LATER
SETZM GODPOV## ;[V10] MAKE SURE THAT THE SPECIAL
;[V10] GO DEPENDING FLAG IS OFF.
PUSHJ PP,OVLHDR ;OVERLAY HEADER MAKER ROUTINE
JRST PUTASN ;OUTPUT THE OVERLAY CALL
;EXIT PROCEDURE-NAME ENDS WITH AN UNCONDITIONAL "GO"
NOEXIT: MOVE TC,OPERND
HRRZM TC,CUREOP
MOVEI DW,E.232
JRST OPNWRN##
SUBTTL THE "PERFORM TIMES" GENERATOR
PRFYGN: SWOFF FEOFF1 ;TURN OFF MOST FLAGS
MOVEM W1,OPLINE ;SAVE LN&CP OF OPERATOR
MOVE EACC,[XWD 2,2] ;ASSUME ONLY ONE PROCEDURE NAME
HRRZ TC,EOPLOC ;SET "TC" TO SECOND OPERAND
ADDI TC,3
MOVE EACA,EOPNXT
CAIL TC,(EACA) ;IS THERE A SECOND ONE?
JRST BADEOP ;NO--TROUBLE
MOVE TE,0(TC) ;GET FIRST WORD OF SECOND OPERAND
TLNE TE,GNLIT ;IS IT A LITERAL OR FIG. CONST.?
JRST PRFYG1 ;YES
LDB TE,[POINT 3,1(TC),20] ;NO--DATA-NAME?
CAIN TE,TB.DAT
JRST PRFYG1 ;YES
ADD EACC,[XWD 2,2] ;NO--MUST HAVE TWO PROCEDURE-NAMES
ADDI TC,2 ;STEP UP TO NEXT OPERAND
CAIL TC,(EACA) ;IS THERE ANOTHER?
JRST BADEOP ;NO--TROUBLE
;"TC" POINTS TO "TIMES" COUNT
PRFYG1: ADD EACC,EOPLOC
MOVEM EACC,EOPNXT
MOVEM TC,CUREOP
MOVEI LN,EBASEA ;SET UP PARAMETERS
PUSHJ PP,SETOPN
HRRZ TE,EMODEA ;IS ITEM A LITERAL
CAIN TE,LTMODE
JRST PRFYG3 ;YES
CAIN TE,FCMODE ;NO--FIG. CONST.?
JRST BADINT ;YES--ERROR
;"TIMES" COUNT IS A DATA-NAME
CAIE TE,FPMODE ;IS IT COMP-1?
CAIN TE,F2MODE ;OR COMP-2?
JRST BADFP ;YES--ERROR
TSWF FANUM ;IS ITEM NUMERIC?
SKIPE EDPLA ;YES--ANY DECIMAL PLACES?
JRST BADDP ;NO--ERROR
HRRZ TE,ESIZEA ;IS IT ONE WORD?
CAILE TE,^D10
JRST BADSIZ ;NO--ERROR
JRST PRFYG6 ;YES
;"TIMES" COUNT IS A LITERAL
PRFYG3: PUSHJ PP,CONVNL ;GET VALUE OF LITERAL INTO TD & TC
SKIPN EDPLA ;ANY DECIMAL PLACES?
TSWF FLNEG ;NO--POSITIVE LITERAL?
JRST BADINT ;NO--ERROR
JUMPN TD,BADSIZ ;IS IT TWO WORDS?
JUMPE TC,BADINT ;NO--ZERO?
MOVSI CH,MOV## ;GET LITERAL INTO AC'S
PUSHJ PP,PUT.LA
MOVEI TE,D1MODE
MOVEM TE,EMODEA
JRST PRFYG7
PRFYG6: HRLZM TC,OPERND ;SAVE PTR TO OPERAND IN CASE SUBSCRIPTED
PUSHJ PP,MXAC. ;GET ITEM INTO AC'S
PRFYG7: MOVE CH,[XWD AS.OCT,1] ;ALLOCATE A %PARAM WORD
PUSHJ PP,PUTAS1
MOVEI CH,0
PUSHJ PP,PUTAS1
HRRZ EACC,EAS1PC
IORI EACC,AS.PAR
AOS EAS1PC
MOVE TE,[XWD EBASEA,EBASEB]
BLT TE,EBASBX
MOVEI TE,D1MODE
MOVEM TE,EMODEB
MOVE TE,[XWD ^D36,AS.MSC]
MOVEM TE,EBASEB
SWON FBSIGN;
HRRZM EACC,EINCRB
PUSHJ PP,MACX. ;STASH AC'S INTO %PARAM WORD
PUSHJ PP,GETTAG ;GET A TAG NUMBER
HRRZM CH,ESAVER+1 ;SAVE IT
PUSHJ PP,PUTTAG ;WRITE IT OUT
;ITEM HAS BEEN PUT INTO %PARAM
MOVE TE,@CUREOP ;WAS IT A LITERAL?
TLNN TE,GNLIT
JRST PRFY10 ;NO--MUST HAVE BEEN A DATA NAME
PUSHJ PP,PRFY20 ;YES--GENERATE THE PERFORM
MOVSI CH,SOSLE. ;YES--GENERATE <SOSLE B>
PUSHJ PP,PUT.B
MOVSI CH,JRST. ;GENERATE <JRST %TAG1>
HRR CH,ESAVER+1
HRRZ TA,CH ;TAG NUMBER
PUSHJ PP,REFTAG## ;REFERENCE IT
JRST PUTASY ; AND RETURN
;ITEM IS A DATA-NAME--TEST HAS TO BE BEFORE THE PERFORM
PRFY10: MOVSI CH,SOSGE. ;GENERATE <SOSGE>
PUSHJ PP,PUT.B
PUSHJ PP,GETTAG ;GENERATE <JRST %TAG2>
MOVEM CH,ESAVER+2
HRLI CH,JRST.
HRRZ TA,CH
PUSHJ PP,REFTAG##
PUSHJ PP,PUTASY
PUSHJ PP,PRFY20 ;GENERATE THE PERFORM
MOVSI CH,JRST. ;GENERATE <JRST %TAG1>
HRR CH,ESAVER+1
HRRZ TA,CH
PUSHJ PP,REFTAG##
PUSHJ PP,PUTASY
HRRZ CH,ESAVER+2 ;PUT OUT %TAG2
JRST PUTTAG ; AND RETURN
;SET UP EACA AS IF PERFORM WERE BEING CALLED, THEN CALL IT
PRFY20: MOVE EACA,EOPNXT
JRST PERFGN ;GO DO THE PERFORM
;ERROR ROUTINES
;LITERAL IS NEGATIVE OR HAS DECIMAL PLACES
BADINT: MOVEI DW,E.25
JRST OPNFAT
;IMPROPER SIZE OF DATA NAME
BADSIZ: MOVEI DW,E.278
JRST OPNFAT
;DATA-NAME HAS DECIMAL PLACES
BADDP: MOVEI DW,E.264
JRST OPNFAT
;DATA-NAME IS A COMP-1 ITEM
BADFP: MOVEI DW,E.321
JRST OPNFAT
;IN-LINE PERFORM GENERATOR
IPRFGN: SWOFF FEOFF1 ;TURN OFF MOST FLAGS
TLO W2,AS.TAG ;CONVERT TO TAG NUMBER
MOVEM W1,OPLINE ;SAVE LN&CP OF OPERATOR
MOVE EACA,EOPNXT
CAMN EACA,EOPLOC ;ANY OPERANDS?
JRST IPRF10 ;NO, SIMPLE CASE
HRRZ TC,EOPLOC ;GET ADDRESS OF FIRST OPERAND
ADDI TC,1
MOVEM TC,OPERND
MOVEI TE,-1(EACA) ;ALSO ADDRESS OF SECOND OPERAND
CAIE TC,0(TE) ;IS THERE ONLY ONE OPERAND?
JRST BADEOP ;NO--ERROR
MOVE TE,0(TC) ;GET FIRST WORD OF OPERAND
TLNE TE,GNLIT ;IS IT A LITERAL OR FIG. CONST.?
JRST IPRFG1 ;YES
LDB TE,[POINT 3,1(TC),20] ;NO--DATA-NAME?
CAIE TE,TB.DAT
JRST BADEOP ;NO--TROUBLE
;Similar code to PRFYG1
IPRFG1: MOVEM TC,CUREOP
MOVEI LN,EBASEA ;SET UP PARAMETERS
PUSHJ PP,SETOPN
HRRZ TE,EMODEA ;IS ITEM A LITERAL
CAIN TE,LTMODE
JRST IPRFG2 ;YES
CAIN TE,FCMODE ;NO--FIG. CONST.?
JRST BADINT ;YES--ERROR
;"TIMES" COUNT IS A DATA-NAME
CAIE TE,FPMODE ;IS IT COMP-1?
CAIN TE,F2MODE ;OR COMP-2?
JRST BADFP ;YES--ERROR
TSWF FANUM ;IS ITEM NUMERIC?
SKIPE EDPLA ;YES--ANY DECIMAL PLACES?
JRST BADDP ;NO--ERROR
HRRZ TE,ESIZEA ;IS IT ONE WORD?
CAILE TE,^D10
JRST BADSIZ ;NO--ERROR
JRST IPRFG3 ;YES
;"TIMES" COUNT IS A LITERAL
IPRFG2: PUSHJ PP,CONVNL ;GET VALUE OF LITERAL INTO TD & TC
SKIPN EDPLA ;ANY DECIMAL PLACES?
TSWF FLNEG ;NO--POSITIVE LITERAL?
JRST BADINT ;NO--ERROR
JUMPN TD,BADSIZ ;IS IT TWO WORDS?
JUMPE TC,BADINT ;NO--ZERO?
MOVSI CH,MOV## ;GET LITERAL INTO AC'S
PUSHJ PP,PUT.LA
MOVEI TE,D1MODE
MOVEM TE,EMODEA
JRST IPRFG4
IPRFG3: HRLZM TC,OPERND ;SAVE PTR TO OPERAND IN CASE SUBSCRIPTED
PUSHJ PP,MXAC. ;GET ITEM INTO AC'S
IPRFG4: MOVE CH,[XWD AS.OCT,1] ;ALLOCATE A %PARAM WORD
PUSHJ PP,PUTAS1
MOVEI CH,0
PUSHJ PP,PUTAS1
HRRZ EACC,EAS1PC
IORI EACC,AS.PAR
AOS EAS1PC
MOVE TE,[XWD EBASEA,EBASEB]
BLT TE,EBASBX
MOVEI TE,D1MODE
MOVEM TE,EMODEB
MOVE TE,[XWD ^D36,AS.MSC]
MOVEM TE,EBASEB
SWON FBSIGN;
HRRZM EACC,EINCRB
PUSHJ PP,MACX. ;STASH AC'S INTO %PARAM WORD
PUSHJ PP,GETTAG ;GET A TAG NUMBER
HRRZM CH,ESAVER+1 ;SAVE IT
PUSHJ PP,PUTTAG ;WRITE IT OUT
;ITEM HAS BEEN PUT INTO %PARAM
MOVE TE,@CUREOP ;WAS IT A LITERAL?
TLNN TE,GNLIT
JRST IPRFG5 ;NO--MUST HAVE BEEN A DATA NAME
PUSHJ PP,IPRF20 ;YES--GENERATE THE PERFORM
MOVSI CH,SOSLE. ;YES--GENERATE <SOSLE B>
PUSHJ PP,PUT.B
MOVSI CH,JRST. ;GENERATE <JRST %TAG1>
HRR CH,ESAVER+1
HRRZ TA,CH ;TAG NUMBER
PUSHJ PP,REFTAG## ;REFERENCE IT
PUSHJ PP,PUTASY
JRST IPRF30 ;Output jump over in-line PERFORM
;ITEM IS A DATA-NAME--TEST HAS TO BE BEFORE THE PERFORM
IPRFG5:: MOVSI CH,SOSGE. ;GENERATE <SOSGE>
PUSHJ PP,PUT.B
PUSHJ PP,GETTAG ;GENERATE <JRST %TAG2>
MOVEM CH,ESAVER+2
HRLI CH,JRST.
HRRZ TA,CH
PUSHJ PP,REFTAG##
PUSHJ PP,PUTASY
PUSHJ PP,IPRF20 ;GENERATE THE PERFORM
MOVSI CH,JRST. ;GENERATE <JRST %TAG1>
HRR CH,ESAVER+1
HRRZ TA,CH
PUSHJ PP,REFTAG##
PUSHJ PP,PUTASY
HRRZ CH,ESAVER+2 ;PUT OUT %TAG2
PUSHJ PP,PUTTAG
JRST IPRF30
IPRF10: PUSHJ PP,IPRF20 ;Generate PERFORM entry
JRST IPRF30 ;Generate jump over in-line PERFORM
;Generate code for entry to in-line PERFORM
;Similar code to PERF6 - generates code as if /P were on
IPRF20: SKIPN QUIKSW ;/Q?
JRST IPRF21 ;NO
HLRZ CH,W2
HRLI CH,EPJPP
JRST PUTASY ;GENERATE PUSHJ 17,<TAG%>
IPRF21: MOVE CH,[AOS.+AC11,,LEVEL.##]
PUSHJ PP,PUT.EX ;GENERATE AOS 11,LEVEL.##
MOVE CH,[MOVS.##+AC11,,11]
PUSHJ PP,PUTASY ;GENERATE MOVS 11,11
MOVE CH,[HRRI.##+ASINC+AC11,,AS.MSC]
PUSHJ PP,PUTASN
MOVEI CH,AS.DOT+3
PUSHJ PP,PUTASY ;GENERATE HRRI 11,.+3
PUSHJ PP,PUTASA##
MOVE CH,[PUSH.##+AC17,,11]
PUSHJ PP,PUTASY ;GENERATE PUSH 17,11
PUSHJ PP,PUTASA ;ALTERNATE SET
HLRZ CH,W2
HRLI CH,XJRST.
HRRZ TA,CH
PUSHJ PP,REFTAG##
JRST PUTASY ;GENERATE JRST <TAG%>
IPRF30: PUSHJ PP,PUTASA ;ALTERNATE SET
HLRZ CH,W2
AOS TA,CH
PUSHJ PP,REFTAG##
HRLI CH,XJRST.
PUSHJ PP,PUTASY ;GENERATE JRST <TAG+1%>
HLRZ CH,W2 ;Get tag number
JRST PUTTAG ;Put out tag to start of in-line PERFORM
;END OF IN-LINE PERFORM
;Same as EXITRP
EPRFGN: TLO W2,AS.TAG ;CONVERT TO TAG NUMBER
HRRZ TA,EOPLOC ;THERE SHOULD BE NO OPERANDS
HRRZ EACA,EOPNXT
CAIE TA,(EACA)
JRST BADEOP ;NO--TROUBLE
SKIPE QUIKSW ;/Q?
JRST EPRFGQ ;YES
;NO
;HERE FOR NORMAL EXIT
PUSHJ PP,PUTASA
MOVSI CH,HLRZ.##+AC10+17
PUSHJ PP,PUTASY ;HLRZ 10,(17)
MOVE CH,[CAME.##+AC10,,LEVEL.]
PUSHJ PP,PUT.EX ;CAME 10,LEVEL.
MOVEI CH,EXIT.E##
PUSHJ PP,PUT.PJ ;PUSHJ P,EXIT.E
MOVE CH,[SOS.,,LEVEL.]
PUSHJ PP,PUT.EX ;SOS LEVEL.
;HERE FOR QUICK EXIT
EPRFGQ: MOVSI CH,POPJ.##+AC17
PUSHJ PP,PUTASY
HLRZ CH,W2 ;Get tag number
AOJA CH,PUTTAG ;Put out tag after in-line PERFORM
SUBTTL THE STOP GENERATOR
;IF THERE ARE NO OPERANDS
;IN EOPTAB (EACC) = 0, THEN STOP RUN
;IF MORE THAN 1 OPERAND <A LITERAL>
;FOR THE STOP < LITERAL>
;CONDITION IS DISCOVERED, WE ARE IN TROUBLE.
STOPGN: MOVE EACA,EOPNXT
CAMN EACA,EOPLOC ;ANY OPERANDS?
JRST ESTRUN ;NO--BETTER BE "STOP RUN"
MOVE EACB,-1(EACA) ;NOW CHECK TO SEE IF THE OPERAND TYPE IS A.O.K.
TLNE EACB,1B19 ;IS THE LITERAL OR FIGURATIVE CONSTANT FLAG UP?
JRST STPGN1 ;YES
LDB EACB,[POINT 3,(EACA),20]
CAIE EACB,TB.MNE## ;IS IT A SYMBOLIC-CHARACTER?
JRST EBLTFC ;NOPE! IT WASN'T, BAD SHOW, BAD OPERAND TYPE.
STPGN1: PUSHJ PP,DISPGN ;GENERATE THE DISPLAY
MOVEI CH,C.STOP## ;GENERATE <PUSHJ PP,C.STOP>
JRST PUT.PJ
;OPERAND FOR "STOP" WASN'T A LITERAL
EBLTFC: OUTSTR [ASCIZ /"STOP" operand not literal
/]
JRST KILLF
;GENERATE "STOP RUN"
ESTRUN: MOVEI CH,STOPR.## ;GENERATE <PUSHJ PP,STOPR.>
JRST PUT.PJ
SUBTTL THE ALTER GENERATOR
;SOURCE EXAMPLE:
; C. ALTER A TO PROCEED TO B.
;NOMANCLATURE:
;C. SHALL BE THE POINT OF ORIGIN
;B. SHALL BE THE OBJECT OF THE ALTER
;A. SHALL BE THE SUBJECT OF THE ALTER.
;STRATEGY(?)
;
;(A) CHECK FOR TWO OPERANDS
;(B) CHECK TO SEE IF A IS ALTERABLE.
;(C) CHECK FOR A NOT BEING IN DECLARATIVES
;(D) CHECK FOR B NOT BEING IN DECLARATIVES.
; <A AND B AND C MUST BE TOTALLY WITHIN DECLARATIVES
; OR TOTALLY EXCLUDED FROM DECLARATIVES.>
;(E) SEE WHETHER OR NOT A'S PRIORITY # < 50.
;(F) IF A < 50, THEN A AND B CAN BE IN
;IN ANY SEGEMENTS <NO PRIORITY PROBLEMS>
;(G) GOT A LINK TO AN ALTER WORD IN LEFT HAND
;HALF OF
;THE 2ND WORD IN A'S PROTAB ENTRY ?. IF SO
;ALTER WORD HAS BEEN GENERATED & ALLOCATED.
;IF NOT, ALLOCATE ONE.
;(H) AS LONG AS TRANS-SEGEMENT GO DOES NOT
;CAUSE OVERLAY, GENERATE:
; MOVEI 0,<PHASE F-G TYPE CODE
; FOR B'S PROTAB LINK>
; MOVEM 0,<ALLOCATED ALTER WORD ADDRESS>
;(I) EXIT BACK TO SCANNER ROUTINE.
;(1) NOT TWO OPERANDS ? DIE...
;(2) B IN DECLARATIVES? THEN A HAD BETTER
;LIKEWISE BE WITHIN DECLARATIVES
;IF A AND B NOT COMPATIBLE, PUT
;OUT DIAGNOSTIC AND CONTINUE
;(3) SAME AS FOR (2); A AND B HAD BETTER MATCH.
;(4) IF A > 50, THEN THE GO TO
;< C.'S PRIORITY> HAS TO BE = A.'S.
;(5) OVERLAY CODING:
ALTGEN: HRRZ TA,EOPLOC ;IS THERE TWO AND ONLY TWO OPERANDS?
MOVE EACA,EOPNXT
CAIE TA,-4(EACA)
JRST BADEOP ;OOPS! BAD SHOW _
PUSHJ PP,RESOLV ;EACA IS LOOKING AT LAST OPERAND, B.
HRRM TA,(EACA) ;UPDATE EOPTAB.
PUSHJ PP,SOLVER ;RESOLV GETS B OPERNAD, SOLVER GETS
;A OPERAND.
HRRM TA,-2(EACA) ;UPDATE EOPTAB.
PUSHJ PP,LNKSET ;CONVERT TO REAL ADDRESS.
MOVEI EACB,(TA) ;SAVE POINTER TO 1ST WORD IN PROTAB FOR A.
;YOU MAY USE IT LATER
HRRZ W2,2(TA) ;GET A'S FLAGS & STUFF
TRNN W2,1B28 ;IS A ALTERABLE ?
POPJ PP, ;NO--FORGET IT (PHASE D PUT OUT DIAG)
ISOPOK W2;
HRRZ TA,(EACA) ;GET B OPERAND
MOVEI CH,ECPFLG(TA) ;& SAVE IT!
;CH _ PHASE F-G PROTAB CODE FOR B.
PUSHJ PP,LNKSET ;CONVERT LINK TO ENTRY ADDRESS
HRRZ EACD,2(TA) ;SAVE WORD 3 OF B'S PROTAB ENTRY IN EACD
ISOPOK EACD;
;BEGIN LADDER TEST:
;RUN DOWN NON-DECLARATIVE PATH/ IT WILL
;BE MOST FREQUENT BY FAR.
;THE OVERLAY GENERATOR EXPECTS TO FIND
;CH WITH THE PHASE F-G ADDRESS TO WHICH
;CONTROL IS TO BE TRANSFERRED
;EACC WITH THE CURRENT PRIORITY # OF CURRENT PARAGRAPH
;EACD WITH PRIORITY # OF (CH) ..OF WHERE YOU ARE GOING
;SEE GO GENERATOR ALSO...
LDB EACC,FLAGPP ;GET WHERE YOU ARE PRESENTLY....
TRNE EACC,1B32 ;IS C IN DECLARATIVES <SKIP IF NOT>?
JRST EBDECL ;C IS IN DECLARATIVES/ IF SO, A & B BOTH MUST
;BE IN DECLARATIVES.!.
;C WASN'T IN DECLARATIVES:
TRNN W2,1B32 ;OK, IS A IN DECLARATIVES [BETTER NOT BE]
TRNE EACD,1B32 ;IS B ?
JRST CWASNT ;BAD SHOW _ !! ALL NOT IN DECLARATIVES!
CAIL W2,^D50B24 ;CHECK TO SEE IF GO TO IS LESS THAN 50
JRST CKAEQB ;IF SEGMENT # > OR = 50, C AND A MUST BE =
EALTOK: TRNE W2,40 ;ARE ALL ALTERS WITHIN CURRENT SEGMENT
JRST ALTOLA ;OVERLAY REQUIRED? SURE IS!
ALLDEC: HRLI CH,MOVEI. ;CH NOW CONTAINS:
;MOVEI 0, B
QUICKY: PUSHJ PP,PUTASY ;PUT OUT & BUMP PPC.
;NOW PUT OUT
;MOVEM 0,<ALTER WORD>
ALTFIN: MOVE CH,[XWD ASINC+MOVEM.,AS.MSC] ;MOVEM 0,<IMPURE ADDRESS
;HOLDING ADDRESS OF DESTINATION>
PUSHJ PP,PUTASN ;1ST WORD DOESN'T BUMP PPC
;BECAUSE THIS IS A TWO-WORD ENTRY
HLRZ CH,2(EACB) ;GET A'S ALTER WORD [IF PRESENT]
JUMPE CH,ALTWDN ;IF NO ALTER WORD, GO GENERATE ONE.
ALTDEB: SKIPN DEBSW## ;DO WE NEED DEBUG CODE?
JRST PUTASY ;NO
PUSHJ PP,PUTASY ;YES
HLRZ CH,4(EACB) ;GET PR.DEB
JUMPE CH,CPOPJ ;NOT WANTED HERE
MOVEI CH,DBALT.##
PUSHJ PP,PUT.PJ ;PUSHJ 17,DBALT.
MOVE CH,[AS.XWD,,1]
PUSHJ PP,PUTASN
HRRZ CH,(EACA) ;GET "B" OPERAND
PUSHJ PP,GETPR% ;GET CORRECT %PR OFFSET
PUSHJ PP,PUTASN
HRRZ CH,-2(EACA) ;GET "A" OPERAND
PUSHJ PP,GETPR% ;GET CORRECT %PR OFFSET
PUSHJ PP,PUTASY
MOVE CH,[AS.XWD,,1]
PUSHJ PP,PUTASN
LDB CH,W1LN## ;GET LINE NUMBER
PUSHJ PP,PUTASN
HLRZ TA,4(EACB) ;DEBUG USE PROCEDURE
ADD TA,USELOC## ;POINT TO USE TABLE
LDB CH,US.PRO## ;GET TAG OF USE PROCEDURE
JRST PUTASY
ALTOLA: CAIGE W2,^D1B24 ;DO WE REALLY NEED A MOVE?
;IF BOTH SEG PRIORITY # ARE = 0,
;A MOVSI 0,<PROTAB LINK> WILL DO THE TRICK!
CAIL EACD,^D1B24 ;SEE IF BOTH ARE 0
JRST NEEDMV ; _ SHORT-CUT LOST, AT LEST 1
;PRIORITY # > RES => 0.
HRLI CH,MOVSI. ;SHORT-CUT PAYS OFF
JRST QUICKY
NEEDMV: HRLM CH,CURPRO ;SAVE PROTAB LINK
;FOR OVLHDR ROUTINE.
;START GENERATING: MOVE 0,LIT
MOVE CH,[XWD ASINC+MOV,AS.MSC]
PUSHJ PP,PUTASN ;1ST HALF OF INSTRUCTION OUT
PUSH PP,EACC ;SAVE ADDRESS OF CURRENT PARAGRAPH
MOVE EACC,W2 ;SET IT TO "A".
PUSHJ PP,OVLHDR ;NOW CREATE AN XWD WITH THE ADDRESS
;IN LEFT HALF, PRIORITY #'S IN RIGHT HALF
POP PP,EACC ;RESTORE ADDRESS OF CURRENT PARAGRAPH
PUSHJ PP,PUTASY ;FINISH UP SECOND HALF OF
;INSTRUCTION BEGUN ABOVE
;NOW YOU HAVE:
;MOVE 0,LIT
;LIT: XWD ADDRESS,PRI # PRI #
;NOW GO BACK AND GENERATE MOVEM 0,ALTER WORD
;MOVEM 0, PARAM
JRST ALTFIN
EBDECL: TRNE W2,1B32 ;C IN DECLARATIVES. A MUST BE TOO.
TRNN EACD,1B32 ;AS WELL AS "B".
;TEST WHERE YOU ARE FOR BEING IN DECLARATIVES.
JRST CWASIN ;ONE OF A OR C WAS NOT IN DECLARATIVES
JRST ALLDEC ;ALL IN DECLARATIVES, WHICH MUST BE IN SEGMENT 0
;NO NEED TO CHECK FOR OVERLAY REQUIRED
CWASNT: TRNE W2,1B32 ;C WASN'T IN DECLARATIVES, BUT
;EITHER A OR B OR BOTH WERE. FIND OUT WHICH ONES.
PUSHJ PP,AWASIT
TRNE EACD,1B32 ;OK, WAS "B" IN DECLARATIVES
JRST BWASIT
POPJ PP,
CWASIN: TRNN W2,1B32 ;C WAS IN DECLARATIVES, BUT EITHER A OR B OR BOTH
;WERE OUTSIDE.
PUSHJ PP,AWASIT ;A WAS OUTSIDE
TRNN EACD,1B32 ;TRY B
JRST BWASIT
POPJ PP,
AWASIT: MOVEI EACA,-2(EACA) ;POSITION POINTER TO LOOK AT A.
PUSHJ PP,BWASIT ;GIVE HIM THE DIAG.
MOVEI EACA,+2(EACA) ;REPOSITION POINTER TO LOOK AT B.
POPJ PP,
BWASIT: MOVEI DW,E.185 ;TRYING TO CROSS DECLARATIVES DIAGNOSTIC
JRST EFATAL
CKAEQB: MOVEI TB,(W2) ;SAVE THE ORIGINAL (W2).
ANDI TB,ENREZE ;STRIP ALL BUT PRIORITY BITS
MOVEI TC,(EACC) ;PRESERVE EACC
ANDI TC,ENREZE
CAIN TC,(TB) ;SEE STANDARDS, P-2-81, FOR RESTRICTIONS ON ALTER VERB.
JRST EALTOK ;GREAT! THEY ARE =
MOVEI DW,E.90 ;ALTERING A PROCEEDURE NAME OUTSIDE
JRST EFATAL ;YOUR OWN SEG WHEN YOU ARE IN A 50 OR GREATER SEGMENT.
;N*O*T*E ALTDWN REQUIRES
;THAT PROTAB BE UPDATED WITH THE ADDRESS LINK
;FOR THE ALTER WORD.
ALTWDN: CAIL EACC,^D50B24 ;ARE WE IN A 50 OR > SEG.
;IN OTHER WORDS, DO WE HAVE TO SAVE
;THE ALTERS?
JRST SAVALT ;YEP!!!
MOVE CH,[XWD AS.XWD,1] ;XWD HEADER
PUSHJ PP,PUTAS1 ;ONTO AS1 FILE
TRNE W2,40 ;OK, HEADER OUT, NOW WHAT'S IT GONNA BE,
;ADDRESS, PRIORITY BITS <FOR OVLAY>
;OR
;0,ADDRESS <FOR NON-OVERLAYED GOES.
JRST ADDPR1 ;OK, ADDRESS, PRIORITY BITS NEEDED
MOVEI CH,0 ;LEFT HALF OF XWD _ 0
PUSHJ PP,PUTAS1
PUSHJ PP,GETADR ;GET THE ADDRESS
FINXWD: PUSHJ PP,PUTAS1 ;WRITE THAT ADDRESS OUT
AOS CH,EAS1PC ;BUMP THE PPC
MOVEI CH,100000-1(CH) ;ADD IN TABLE TYPE AND READJUST PPC
;TO WHAT XWD IS.
HRLM CH,2(EACB) ;UPDATE PROTAB ENTRY.
JRST ALTDEB ;TEST FOR DEBUGGING CODE
GETADR: HRRZ TB,3(EACB) ;GET THE FLOTAB LINK FROM PROTAB ENTRY
ANDI TB,77777 ;STRIP OFF ALL BUT OFFSET
JUMPE TB,NOFLOK ;NO FLOTAB LINK?
;TSK! TSK?
ADD TB,FLOLOC ;ADD BASE ADDRESS
HRRZ TD,FLONXT ;TB NOW HOLDS POINTER TO FLOTAB
;CHECK POINTER AGAINST HIGHEST LEGAL
;FLOTAB ENTRY <(FLONXT)>
CAIGE TD,3(TB) ;MAKE SURE THAT THE NEXT ENTRY
;WHICH IS THE ONE YOU WANT, HAS BEEN
;COMPLETED, I.E., TWO WORDS ENTERED
JRST NOFLOK ;TSK, TSK NO CHAINING THRU FLOTAB.
MOVE TA,2(TB) ;GET NEXT ENTRY
LDB CH,LNKCOD## ;IS THE ITEM A PROTAB LINK?
CAIE CH,TB.PRO
JRST NOFLOK ;NO--ERROR
TLNN TA,1B23 ;IS THAT SOMETHING AN OBJECT OF
JRST NOFLOK ;
;GO OR GO DEPENDING?
MOVEI CH,ECPFLG(TA) ;LINK CONVERTED TO F-G NOTATION.
POPJ PP,
;GOTO. DEFAULT ADDRESS SINCE
;WE CANNOT CHAIN THRU FLOTAB.
NOFLOK: MOVE CH,EGOTO
POPJ PP,
ADDPR1: PUSHJ PP,GETADR ;XWD ADDRESS, PRIORITY BITS REQUIRED.
PUSHJ PP,PUTAS1 ;WRITE IT OUT
CAMN CH,EGOTO ;SEE IF GOTO. IS ADDRESS,
;THERE IS NO PROTAB ENTRY FOR HIM
PUSHJ PP,GOTOSG ;EVADE GOING TO LNKSET WITH
;GOTO. AS A LINK.
;LOAD UP WITH CURRENT PARA'S
;PRIORITY BITS IN CH.
;GOTO. IN TA.
;WITH GOTO. AS LINK.
PUSHJ PP,GETBIT ;SHIFT BITS INTO CORRECT POSITIONS.
JRST FINXWD
SAVALT: TRNE W2,40 ;ALL ALTERS WITHIN THE CURRENT SEG?
JRST ADDPR0 ;NOPE! _
MOVEI TB,0
PUSHJ PP,PUTALT ;XWD 0,ADDRESS
;ALL ENTRIES IN ALTAB ARE
;XWD'S, SO HEADER DOESN'T NEED TO BE
;SUPPLIED UNTIL YOU ARE BEGINNING
;TO DUMP THE TABLE.
PUSHJ PP,GETADR
;RESOLVE ADDRESS BY CHAINING THRU FLOTAB.
WRPALT: MOVE TB,CH
PUSHJ PP,INCALT ;INTO ALTAB + BUMP PPC.
MOVEI CH,700000-1(CH)
HRLM CH,2(EACB) ;UPDATE PROTAB
JRST ALTDEB ;TEST FOR DEBUGGING CODE
ADDPR0: PUSHJ PP,GETADR
MOVE TB,CH
PUSHJ PP,PUTALT ;GET ADDRESS AND PUT IT IN LEFT HALF OF XWD
CAMN CH,EGOTO ;AVOID GIVING GOTO. TO A SUBROUTINE AS A VIABLE LINK
PUSHJ PP,GOTOSG ;GOTO. IS IN THE RES SEG.
;EACD = DESTINATION PRIORITY BITS = RES
PUSHJ PP,GETBIT ;RIGHT HALF HAS PRI #S IN IT.
JRST WRPALT ;FINISH UP////
GOTOSG: MOVEI CH,AS.CNB
MOVEI TC,(W2) ;SAVE (W2) PLEASE!!
ANDI TC,ENREZE ;STRIP OFF ALL BUT PRIORITY BITS
LSH TC,-^D2 ;ALIGN POINT ORIGIN PRIORITY < BITS>
TLO CH,(TC)
POP PP,TE ;PREPARE TO TAKE THE SKIP EXIT BACK
JRST 1(TE) ;BACK + 1 WE GOT
SUBTTL THE GO GENERATOR
GOGOGN: MOVE EACA,EOPNXT
CAMN EACA,EOPLOC ;IF NO OPERANDS,
JRST EXTGO ; MUST BE 'GO TO.'
HRRZ TE,EOPLOC ;THERE ARE OPERANDS, THERE MUST
CAIE TE,-2(EACA) ; BE ONLY ONE
JRST BADEOP ;SOMETHING IS WRONG
SETZM GODPOV## ;[V10] MAKE SURE THE SPECIAL GO
;[V10] DEPENDING FLAG IS OFF.
SETZM USEXJR## ;DON'T USE "XJRST"
PUSHJ PP,GODBTS ;SEE IF DEBUGGING INFO NEEDED
;[V10] GO DEPENDING ENTERS HERE FOR EACH PROCEDURE-NAME.
GOGO1: PUSHJ PP,RESOLV ;RESOLVE (IF NECESSARY, PROTAB-FLOTAB ENTRY).
HRRM TA,(EACA) ;UPDATE EOPTAB
TLNE W1,1B27 ;IS THIS A SPECIAL GO; ONE CREATED BY
;THE SYNTAX SCANNER TO CONNECT THE
;SEGMENTS TOGETHER
JRST GOCKIT ;"SPECIAL" GO FOUND
RESUME: MOVEI CH,(TA) ;CHANGE
ANDI CH,TM.PRO ; ADDRESS CODE TO
IORI CH,AS.PRO ; ASSEMBLY NOTATION
PUSHJ PP,LNKSET ;CONVERT LINK TO REAL ADDRESS
MOVE EACD,2(TA) ;GET FLAGS FOR OBJECT OF GO
;CHECK FOR BONA FIDE OPERAND.
ISOPOK EACD;
LDB EACC,FLAGPP ;GET FLAGS FROM EPPARA
TRNE EACD,1B32 ;CHECK TO SEE IF DESTINATION IS IN DECLARATIVES.
JRST GODDEC ;GO HAS DESINATION IN DECLARATIVES, ALL
;IS NOT LOST YET FOR THE GUY. HE MAY BE
;O.K. IF SOURCE IS IN DECLARATIVES.
TRNE EACC,1B32 ;O.K., NOW CHECK FOR SOURCE IN DECLARATIVES
;COME HERE ONLY IF 1ST TEST SHOWS DESTINATION OUT OF
;DECLARATIVES.
JRST DECWRN ;YEP, SOURCE IN DECLARATIVES. THIS IS O.K.
;ONLY IF DESTINATION IN DECLARATIVES.
DECOK: TRNE EACC,140 ;CHECK FOR PRESENT PP'S BEING ALTERED:
;AN ALTERED GO.
JRST GOALTD
;GET EXPRESSION SET UP
GOENTR: HRLI CH,JRST. ;ADD IN A <JRST> TO CONVERTED LINK TO PROTAB
ANDI EACC,ENREZE ;STRIP OFF ALL BUT SOURCE'S PRIORITY BITS.
ANDI EACD,ENREZE ;STRIP OFF ALL BUT DESTINATION'S PRIORITY BITS
CAIN EACD,(EACC) ;DESTINATION & SOURCE OF = PRIORITY ?
;
JRST GOENT1 ;DESTINATION & SOURCE =, JRST IS OK.
HRLM CH,CURPRO ;SAVE CH, WHICH CONTAIN PROTAB
;POINTER, WHICH WILL BE RESOLVED TO ADDRESS
SKIPN GODPOV## ;[561] SKIP IF SPECIAL "GO DEPENDING"
JRST GOENT0 ;[561] NO
;[561] WRITE OUT THE "MOVEI" USING OPCODE "XMOVI." SO THE OPTIMIZER
;[561] DOESN'T THINK IT CAN TAMPER WITH IT.
PUSHJ PP,PUTASA ;[561] USE 2ND CODE SET FOR "XMOVI."
SKIPA CH,[XMOVI.##+AC16+ASINC,,AS.MSC] ;[561] SKIP WITH CH LOADED
GOENT0: MOVE CH,[OVLAY.+ASINC,,AS.MSC] ;[561] NEW LABEL
PUSHJ PP,PUTASY ;WRITE OUT THE CALL OR "MOVEI" TO BE XCT'D
PUSHJ PP,OVLHDR ;GO OFF TO OVERLAY HEADER MAKER ROUTINE.
;WILL RETURN WITH CH LOADED WITH
;ADDRESS REQUIRED TO FINISH OVLAY INSTRUCTION.
JRST PUTASN ;DBT
GOENT1: SKIPN USEXJR## ;SKIP IF XJRST
JRST PUTASY ;NO
HRLI CH,XJRST. ;[561] USE "XJRST"
PUSH PP,CH
PUSHJ PP,PUTASA##
POP PP,CH
JRST PUTASY
EXTGO: TLNE W1,1B28 ;IS HE GONNA FALL OF THE EDGE OF THE WORLD?
JRST EDGE ; _ YEP, SURE IS!
; _ GO TO. IN HAND
LDB EACC,FLAGPP ;GET CURRENT PARAGRAPH'S PROTAB LINK
TRNN EACC,140 ;LET'S SEE IF HE REALLY EVER DOES ALTER THIS GO.
JRST GOWRN ; _ HMMM! GO TO. THAT'S NEVER ALTERED!???
;<GOTO.. REQUIRED>
MOVEI EACD,0 ;_ SOME NON-RESIDENT
; MUST BE ASSUMED FOR A GOTO. THAT'S NOT
;RESOLVED. OTHERWISE, CHAINNING OF
;THE DAMN GLOBAL WILL KILL YOU
;SINCE THE ASSEMBLER WON'T BE ABLE TO
;TELL THE LOADER ABOUT THE CHAIN THAT
;VANISHES.
SKIPA EACB,EGOTO ;TO SEGMENT 0/
; ^ NOTE THAT SKIP WILL ALWAYS TAKE
;YOU OVER THE SAVING OF THE OPERAND
;IF THERE WAS NOT AN OPERAND
GOALTD: MOVEI EACB,(CH) ;IF YOU ARE COMING FROM THE OPERAND SIDE,
;SAVE THE OPERAND!!
TRNN EACC,40 ;OK, CHECK ALL PLACES THAT WE MIGHT BE GOING
;ALL PLACES IN THE SAME SEGMENT?
SKIPA CH,[XWD ASINC+JRST.+1B31,AS.MSC]
; ^ YEP. ALL OBJECTS IN SAME SEGMENT.
MOVE CH,[OVLAY.+ASINC,,AS.MSC] ;OVERLAY REQUIRED, MAKE ONE & UPDATE
;1ST PART OF JRST @ OR OVLAY. OUT
;ADDRESS PORTION COMING UP!!!
PUSHJ PP,PUTASY ;DBT
HRRZ TA,EPPARA ;GET PROTAB LINK FOR THIS PARAGRAPH
;<THE 1 THAT'S GOT THE GO WE'RE TALKING ABOUT>.
PUSHJ PP,LNKSET ;CONVERT TO REAL ADDRESS
HLRZ CH,2(TA) ;GET THE ALTER WORD <IF ONE IS THERE>
JUMPN CH,PUTASN ;DBT, IF NON-ZERO, WORD ALLOCATED, SO
;PUT IT ON ASSEMBLER INPUT FILE & BUMP PPC.
; _ NO WORD ALLOCATED
;ALLOCATE ONE, BUT MAKE ADDRESS
;GOTO. IN THE EVENT THAT HE DOES NOT
;FILL IN THE BLANK AT OBJECT TIME.
;FINISH UP JRST @ WITH ADDRESS
;OF XWD JUST PUT OUT.
;OR... PUT OUT LAST HALF OF OVLAY. UUO
;WITH ADDRESS OF XWD JUST PUT OUT.
CAIL EACC,^D50B24 ;ARE WE IN A 50 OR GREATER SEG?
;IF SO, WE HAVE TO SAVE THE ALTERS
;FOR THE BLT RESTORATION.
JRST SAVBLT ;YEP! IN 50 OR GT. SAVE ALTS/
PUSHJ PP,MAKXWD ;MAKE AN XWD
;EITHER A) XWD 0,ADDRESS FOR JRST @
;OR B) XWD ADDRESS, PRIORITY BITS
;FOR OVERLAY.
HRRZ TA,EPPARA ;GET ADDRESS OF
PUSHJ PP,LNKSET ; CURRENT PARAGRAPH
HRLM CH,2(TA) ;UPDATE PROTAB WITH ALTER-WORD ADDRESS.
JRST PUTASN ;DBT, FINISH UP INSTRUCTION WITH ADDRESS OF XWD
;SINCE WE ARE NOT IN A 50 OR GREATER SEG,
;ALL ALTER WORDS GO ON AS1.
EDGE: PUSHJ PP,CKEXIT ;CLEAN UP EXITS
SKIPN SLASHJ## ;/J ON (FORCE MAIN PROG)?
SKIPN SUBPRG## ;NO, /I ON (SUBPROG)?
SKIPE PROGST## ;MAIN PROG BUT DOES IT HAVE START
JRST EDGE1 ;YES, OR ITS A SUBPROG
SETZ CH, ;USE TAG 0
PUSHJ PP,PUTTAG ;DEFINE IT
MOVEI CH,AS.TAG ;AND TO START ADDRESS
MOVEM CH,PROGST
EDGE1: MOVE CH,[EPJPP,,KPROG.##] ;HE'S GONNA TRY TO FALL OFF
;THE EDGE OF THE WORLD
;INTO HIS LITERAL POOL.
HLLZ TA,EPPARA ;SEE IF YOU ARE IN RES/SEG
TLNE TA,ENREZF
PUSHJ PP,FXPROG ;SET FLAG IN EXTAB SHOWING REFERENCE
;TO EXTERNAL NAME MADE FROM NON-RES
JRST PUTASY ;WRITE IT ON APPROPRIATE FILE AND BUMP PPC.
GOCKIT: PUSHJ PP,CKEXIT ;IN ANY EVENT, GENERATE EXITS AS REQUIRED.
SKIPE TA,EPSECT ;IF NO LAST SECTION, THEN WE CANNOT
;BE IN THE DECLARATIVES
TLNN TA,1B33 ;THERE WAS A LAST SECTION, SKIP IF IT WAS IN THE DECLARATIVES
;REMEMBER, THAT EPSECT'S FLAGS SHIFTED RIGHT 1
JRST RESTOR ;PUSHJ TO OBJECT TIME ERROR ROUTINE NOT NEEDED.
;THERE MUST HAVE BEEN A LAST SECTION
;AND IT MUST HAVE BEEN IN THE DECLARATIVES, AND
;PLACE WHERE SYNTAX ROUTINE IS SENDING
;YOU MUST BE OUTSIDE THE DECLARATIVES.
HRRZ TA,(EACA) ;GET WHERE SYNTAX IS SENDING YOU
PUSHJ PP,LNKSET
MOVE TB,2(TA)
TRNE TB,1B32 ;ITEM OUTSIDE DECLARATIVES ?
JRST RESTOR ;NO, YOU CAN GO BACK
MOVE CH,[EPJPP,,KDECL.##] ;OOOPS, HE MIGHT FALL INTO LITERALS
HLLZ TA,EPPARA ;SEE WHETHER OR NOT WE IN RESIDENT SECTION.
TLNE TA,ENREZF
PUSHJ PP,FXDECL ;FIXUP OF USER TO DIE WHEN
;FALLING OUT OF DECLARATIVES
;REQUIRED, BUT PUSHJ 17
;MUST BE INDIRECT BECAUSE
;EXTERNALS CANNOT BE CHAINED
;INTO/OUT OF NON-RES SEGS.
JRST PUTASY
;THE CATCHER GENERATED <NO FALLING OUT OF
;THE DECLARATIVES>
;RETURN
FXDECL: SKIPA TA,[EXP STOPR.] ;PREPARE TO UPDATE EXTAB'S NON-RES REFERENCE FLAG
FXPROG: HRRZI TA,KPROG.
ANDI TA,77777
ADDI TA,<CD.EXT>B20
PUSHJ PP,LNKSET
MOVSI TB,NR.EXT
IORM TB,1(TA) ;[425] SET IN NON-RESIDENT SECTION.
POPJ PP,
RESTOR: HRRZ TA,(EACA) ;RESTORE TA FOR MAIN LINE PROGRAM
JRST RESUME
GODDEC: TRNE EACC,1B32 ;SEE IF SOURCE IS IN THE DECLARATIVES.
JRST DECOK ;EVERYTHING'S OK
GODBTS: SKIPN DBPARM## ;ANY CHANCE WE NEED TO OUTPUT DEBUG INFO?
POPJ PP, ;NO, NORMAL CODE
LDB CH,W1LN ;GET LINE#
HRLI CH,MOVEI.##+AC16
PUSHJ PP,PUTASY
MOVE CH,[MOVEM.+AC16+ASINC,,AS.MSC]
PUSHJ PP,PUTASN
MOVE CH,DBPARM
IORI CH,AS.PAR
JRST PUTASY ;MOVEM 16,%PARAM+N
DECWRN: MOVEI DW,E.185 ;VIOLATION OF DECLARATIVES BOUNDARY
JRST EFATAL
GOWRN: HRRZ TA,EPPARA ;GET THIS PP'S PROTAB LINK
PUSHJ PP,LNKSET ;GET REAL ADDRESS
HRRZ TB,3(TA) ;GET FLOTAB NTRY
ANDI TB,77777 ;STRIP OFF ALL BUT OFFSET
ADD TB,FLOLOC ;NOW YOU HAVE FLOTAB ENTRY.!
MOVEI EACA,2(TB) ;POINT EACA SO THAT -1(EACA)
;WILL LOOK AT LN & CP
MOVEI DW,E.94 ;GO TO. NOT ALTERED.
JRST EWARN
SAVBLT: MOVEI W2,(TA) ;COME HERE WHEN NO
;ALTER WORD HAS BEEN ALLOCATED FOR AN
;ALTERED GO.
;START BY SAVING THE ADDRESS
;OF THE PROTAB ENTRY THAT WILL BE
;UPDATED, SHOWING
;THAT AN ALTER WORD HAS BEEN ALLOCATED.
TRNE EACC,40 ;ALL ALTERS IN THIS SEG?
JRST ADDPR2 ;NOPE!
MOVEI TB,0
PUSHJ PP,PUTALT
MOVE TB,EACB ;GET SAVED ADDRESS.
FINBLT: PUSHJ PP,INCALT ;THE ADDRESS GOES IN RIGHT HAND
;HALF OF XWD. INCALT BUMPS ALTAB'S PPC
MOVEI CH,700000-1(CH) ;RESTORE ALTAB'S PPC TO
;WHAT IT SHOULD BE TO POINT TO
;XWD JUST CREATED, AND ADD IN TABLE TYPE CODE.
HRLM CH,2(W2) ;UPDATE THAT OLD PROTAB ENTRY
;THIS WILL ALLOW YOU TO GET
;A HANDLE ON ALTERED GOES
JRST PUTASN ;DBT
ADDPR2: MOVE TB,EACB ;RETRIEVE SAVED ADDRESS.
PUSHJ PP,PUTALT ;ADDRESS IN LEFT HALF OF XWD
HRRZ TA,EPPARA ;HAVE TO HAVE THE PROTAB ADDRESS
PUSHJ PP,GTBIT1
MOVE TB,CH ;GET PRI BITS INTO TB FROM CH &
JRST FINBLT
;FINISH UP
EGOTO: XWD AS.GO,AS.MSC ;POINTS TO JRST GOTO.
SUBTTL THE "GO DEPENDING" GENERATOR
EXTERNAL SETOPN,PUTASY,PUTASN,MXAC.
GODPGN: MOVE EACA,EOPNXT
CAMN EACA,EOPLOC ;ANY OPERANDS?
JRST BADEOP ;NO--TROUBLE
MOVEM W1,OPLINE ;SAVE OPERATOR'S LN&CP
;SCAN THRU EOPTAB FROM TOP, LOOKING FOR VARIABLE
MOVE EACA,EOPLOC
SETZM GODPOV## ;[V10] CLEAR THE CALL OVERLAY FLAG.
SETOM USEXJR## ;MAKE SURE WE GENERATE "XJRST'S" FOR
; GOTO'S
GODPG1: MOVE TE,1(EACA) ;GET FIRST WORD OF AN OPERAND
TLNE TE,GNLIT ;IS IT A LITERAL OR FIG. CONST.?
JRST GODPG2 ;YES
MOVE TA,2(EACA) ;NO--IS IT
LDB TE,LNKCOD ; A DATA-NAME?
CAIN TE,TB.DAT
JRST GODPG3 ;YES
ADD EACA,[XWD 2,2] ;[V10] MOVE UP TO THE SECOND
;[V10] WORD OF THE CURRENT OPERAND.
PUSHJ PP,RESOLV ;[V10] GO MAKE SURE WE HAVE A
;[V10] PROTAB LINK.
PUSHJ PP,LNKSET## ;[V10] MAKE IT INTO AN ADDRESS.
MOVE EACD,2(TA) ;[V10] GET THE DESTINATION'S FLAGS.
LDB EACC,FLAGPP ;[V10] GET THE CURRENT SEGMENT'S FLAGS.
XORI EACD,(EACC) ;[V10] IF THE DESTINATION ISN'T
TRNE EACD,ENREZE ;[V10] IN THE CURRENT SEGMENT,
SETOM GODPOV## ;[V10] NOTE THAT WE HAVE TO
;[V10] CALL THE OVERLAY HANDLER.
CAME EACA,EOPNXT ;KEEP LOOKING
JRST GODPG1
JRST BADEP6
;LITERAL OR FIG. CONST. FOUND
GODPG2: MOVEI TC,1(EACA) ;SETUP CUREOP
MOVEM TC,CUREOP ;INCASE OF ERROR
JRST BADEP4 ;NO--ERROR
;VARIABLE FOUND
GODPG3: MOVEM EACA,EOPNXT
MOVEI TC,1(EACA)
MOVEM TC,CUREOP
MOVSM TC,OPERND
SETOM EDEBDA## ;WE MIGHT NEED TO DEBUG ON DEPENDING VARIABLE
SOS EDEBDA ;BUT ONLY IF "ALL REFERENCE OFF"
MOVEI LN,EBASEA ;SET UP PARAMETERS FOR VARIABLE
PUSHJ PP,SETOPN
HRRZ TE,EMODEA
CAIE TE,FPMODE ;IS IT COMP-1?
CAIN TE,F2MODE ;OR COMP-2?
JRST BADEP7 ;YES--ERROR
TSWF FANUM ;IS IT NUMERIC?
SKIPE EDPLA ;YES--DECIMAL PLACES?
JRST BADEP1 ;BAD VARIABLE
MOVE TE,ESIZEA ;IS IT ONLY ONE WORD?
CAILE TE,^D10
JRST BADEP2 ;NO--BAD VARIABLE
;MOVE 'DEPENDING' ITEM INTO AC3
PUSH PP,EDEBDA ;DON'T WANT DEBUGGING CODE ON MOVE
SETZM EDEBDA
MOVEI TE,3
MOVEM TE,EAC
PUSHJ PP,MXAC.
POP PP,EDEBDA ;PUT BACK DEBUGGING INFO
;HOW MANY NAMES?
GODPG5: MOVE EACA,EOPNXT
CAMN EACA,EOPLOC ;ANY PROCEDURE NAMES?
JRST BADEOP ;NO--TROUBLE
HRRZ TC,EACA ;COMPUTE NUMBER OF NAMES
MOVE TD,EOPLOC
SUBI TC,0(TD)
LSH TC,-1
CAILE TC,77777 ;IN-BOUNDS?
JRST BADEOP ;NO--TROUBLE
SKIPE GODPOV## ;[V10] IF WE HAVE TO WORRY
JRST GODPD ;[V10] ABOUT SEGMENTS, GO ON.
PUSHJ PP,GODBTS ;SEE IF DEBUGGING ON PROCEDURES INFO NEEDED
SKIPE EDEBDA ;IF DEBUGGING ON "A"
JRST [PUSHJ PP,PUTASA ; WE NEED TO SAVE ACC 3
MOVE CH,[PUSH.+AC17,,3]
PUSHJ PP,PUTASY ;USE STACK
PUSHJ PP,GDEBA## ;GENERATE DEBUGGING INFO ON DEPENDING VARIABLE
PUSHJ PP,PUTASA ;NOW RESTORE ACC 3
MOVE CH,[POP.##+AC17,,3]
PUSHJ PP,PUTASY
JRST .+2]
PUSHJ PP,GDEBA## ;GENERATE DEBUGGING INFO ON DEPENDING VARIABLE
;GENERATE: CAIG 3,N
; JUMPG 3,.+1(3)
; JRST %TAG (.+N+1) ;[561]
;WHERE "N" IS THE NUMBER OF PROCEDURE NAMES
MOVSI CH,CAIG.+AC3
HRR CH,TC
PUSHJ PP,PUTASY
MOVE CH,[XWD JUMPG.+AC3+ASINC+3,AS.MSC]
PUSHJ PP,PUTASY
HRRZI CH,AS.DOT+1
PUSHJ PP,PUTASN
;[561] PUSHJ PP,PUTASA##
;[561] MOVE CH,[XWD XJRST.+ASINC,AS.MSC]
;[561] PUSHJ PP,PUTASY
;[561] MOVEI CH,AS.DOT+1(TC)
;[561] PUSHJ PP,PUTASN
;
PUSHJ PP,GETTAG ;[561] GET A TAG FOR TARGET OF JRST
PUSH PP,CH ;[561] SAVE ON PUSHDOWN STACK
HRLI CH,JRST. ;[561] FINISH INSTRUCTION -- "JRST %TAG"
PUSHJ PP,GOENT1 ;[561] PUT OUT JRST OR XJRST
HRRZ TA,CH ;[561] NOW REFERENCE THE TAG
PUSHJ PP,REFTAG ;[561] SO THE OPTIMIZER WILL WORK
;NOW PUT OUT ALL THE GO'S
GODPG6: ;[V10] COME BACK HERE AFTER WORRYING ABOUT SEGMENTS.
MOVE EACA,EOPLOC
GODPG7: ADD EACA,[XWD 2,2] ;BUMP TO NEXT ENTRY
PUSHJ PP,GOGO1
CAME EACA,EOPNXT ;DONE?
JRST GODPG7 ;NO--LOOP
SETZM GODPOV## ;[V10] MAKE SURE THE WORRY ABOUT
;[V10] SEGMENTS FLAG IS OFF.
POP PP,CH ;[561] GET TAG TO PUT OUT
PJRST PUTTAG ;[561] OUTPUT IT AND RETURN
;[V10] COME HERE ON A GO DEPENDING WHEN THE DESTINATION ISN'T IN THE
;[V10] CURRENT SEGMENT.
;[V10] (TC) = N, THE NUMBER OF DESTINATIONS
;[V10] GENERATE: JUMPLE 3, %TAG (.+5+N) ;[561]
;[V10] CAILE 3, N
;[V10] JRST %TAG (.+3+N)
;[V10] XCT .+1(3)
;[V10] PUSHJ 17, OVRLAY.
GODPD: PUSHJ PP, GETTAG ;[561] GET A TAG TO JUMP TO
PUSH PP, CH ;[561] SAVE IT ON STACK
;[V10] GENERATE THE "JUMPLE 3,%TAG"
HRLI CH, JMPLE.##+AC3 ;[561]
PUSHJ PP, PUTASY ;[V10]
;[V10] GENERATE THE "CAILE 3,N"
MOVSI CH, CAILE.##+AC3 ;[V10]
HRRI CH, (TC) ;[V10]
PUSHJ PP, PUTASY ;[V10]
;[V10] GENERATE THE "JRST %TAG"
HRRZ CH, (PP) ;[561] GET TAG (ON TOP OF STACK)
HRLI CH, JRST.## ;[561]
PUSHJ PP, PUTASY ;[V10]
;[561] REFERENCE THE TAG TWICE
HRRZ TA, (PP) ;[561]
PUSHJ PP, REFTAG ;[561]
HRRZ TA, (PP) ;[561]
PUSHJ PP, REFTAG ;[561]
;[V10] GENERATE THE "XCT .+1(3)"
MOVE CH, [XWD XCT.##+ASINC+3,AS.MSC] ;[V10]
PUSHJ PP, PUTASY ;[V10]
MOVEI CH, AS.DOT+1 ;[V10]
PUSHJ PP, PUTASN ;[V10]
;[V10] GENERATE THE "PUSHJ 17,OVLAY."
MOVEI CH, OVLAY%## ;[V10]
PUSHJ PP, GNPSX.## ;[V10]
;[V10] NOW WE HAVE TO PUT OUT EITHER "JRST <PROCEDURE-NAME>", IF
;[V10] THE DESTINATION IS IN THE SAME SECTION WE ARE CURRENTLY IN
;[V10] OR "MOVE 16,[XWD <PROCEDURE-NAME>,<PRIORITY>]", IF IT ISN'T,
;[V10] FOR ALL <PROCEDURE-NAMES> GIVEN.
JRST GODPG6 ;[V10] GO BACK TO THE OLD
;[V10] CODE. THE SUBROUTINE
;[V10] GOGO1 WAS HACKED SO
;[V10] THAT IT WOULD PRODUCE
;[V10] THE CORRECT CODE WHEN
;[V10] GODPOV WAS NON-ZERO.
;ERRORS
;VARIABLE ISN'T NUMERIC, OR HAS DECIMAL PLACES
BADEP1: PUSHJ PP,BADDP
JRST BADEP3
;VARIABLE IS TOO LARGE
BADEP2: PUSHJ PP,BADSIZ
BADEP3: MOVSI CH,MOVEI.+AC3 ;GENERATE <MOVEI 3,0> SO WE CAN GO ON
PUSHJ PP,PUTASY
JRST GODPG5
;A FIGURATIVE CONSTANT, BUT NOT TALLY.
BADEP4: MOVEI DW,E.184
PUSHJ PP,OPNFAT
BADEP5: MOVEM EACA,EOPNXT
JRST BADEP3
;COULDN'T FIND A LITERAL NOR A DATA NAME
BADEP6: OUTSTR [ASCIZ "No variable for GODEP
"]
JRST BADEP5
;COMP-1 WHEN IT SHOULDN'T BE
BADEP7: PUSHJ PP,BADFP
JRST BADEP3
AC3==3B30 ;AC USED BY GODEP
EXTERNAL ESIZEA,EBASEA,EDPLA
EXTERNAL EOPLOC,EOPNXT,CUREOP,OPERND,AS.DOT,EAC,TB.DAT
EXTERNAL CAIG.,MOVEI.,JUMPG.,JRST.
SUBTTL GENERATOR SERVICE ROUTINES
;THE VALTAB TO LITAB XFER SUBROUTINE:
;TRANSFERS ASCII FROM VALTAB TO LITAB
;AND SUPPLIES LITAB WITH A HEADER WORD
;ENTRY.
;ONLY GOOD FOR ASCII!
;EACA IS EXPECTED TO CONTAIN A POINTER
;TO A WORD WHICH, IN TURN, POINTS TO A
;RELATIVE ADDRESS IN VALTAB. THE ENTRY IN
;VALTAB CONTAINS IN BITS 0-5 [OF THE 1ST WORD]
;THE NUMBER OF CHARACTERS IN THE ASCII STRING.
;REFER TO COBOL MEMO 100-350-11.01, PAGE
;20 FOR FURTHER DESCRIPTION OF WORD LAYOUT
;IN VALTAB AND BIT ASSIGNMENTS.
;CALL:
;[PUSHJ PP,EVALIT]
;TA IS EXPECTED TO POINT TO THE ORIGIN'S
;[REAL ! ADDRESS!!] 1ST ENTRY.
;THIS ENTRY IS EXPECTED TO HAVE A CHARACTQR
;COUNT IN THE 1ST ASCII CHARACTER!
;
;
;THE SUBROUTINE CAN BE EXPECTED TO CLOBBER:
;EACA _ WHICH RETURNS WITH THE # OF WORDS PUT IN AS.LIT
;EACB
;EACC
;EACD
;
;TA - TE
;EACC AND EACD ARE EXPECTED TO BE CONTIGUOUS,
;I.E., EACC MUST BE 1 LESS THAN EACD,
;MODULO 20 OCTAL.
;PUT A WORD FROM TB
;INTO LITAB
;AND KEEP LITNXT & TA
;CORRECTLY POINTING TO
;WHERE THEY SHOULD
;
;TA WILL BE = LITNXT UPON EXITING.
;CALL IS [PUSHJ PP,PUTLIT]
;
INCALT: AOSA CH,EALTPC ;BUMP PPC
PUSHJ PP,XPNALT ;EXPAND THE ALTER TABLE
PUTALT: MOVE TA,ALTNXT
AOBJP TA,.-2
MOVEM TB,(TA)
MOVEM TA,ALTNXT
POPJ PP,
LINUM: POINT 13,-1(EACA),28 ;13 BITS LONG STOPPING AT BIT #28
;DW IS EXPECTED TO CONTAIN THE APPROPRIATE
;DECIMAL DIAGNOSTIC NUMBER UPON ARRIVING HERE.
EWARN: LDB LN,LINUM ;ALSO, W1 IS EXPECTED TO
;CONTAIN THE OPERAND'S LN & CP.
HRRZ CP,-1(EACA) ;GET CHARACTER POSITION
JRST WARN ;PUT OUT DIAG & RETURN
EFATAL: LDB LN,LINUM ;LIKEWISE FOR FATAL DIAGNOSTIC
HRRZ CP,-1(EACA)
JRST FATAL ;PUT OUT DIAG & RETURN
;ALLOCATE A WORD FOR EXIT ROUTINE.
;
;USES ACCUMULATORS
;TC
;TD
;TE
;TA IS EXPECTED TO POINT AT APPLICABLE PROTAB
;ENTRY UPON ENTERING SUBROUTINE
;CH IS EXPECTED TO RETURN WITH THE
;PHASE F EAS1PC + TYPE CODE LINK IN IT.
EOCT1: XWD 6B20!ASCOCT,000001
EALLOC: MOVE CH,EOCT1 ;ASSEMBLER OCTAL INFORMATION
PUSHJ PP,PUTAS1
MOVEI CH,0 ;THE 1 WORD OF OCTAL RADIX = 0.
PUSHJ PP,PUTAS1
AOS CH,EAS1PC ;BUMP PPC
MOVEI CH,100000-1(CH) ;LEAVE TYPE CODE + PPC BEFORE BUMPING
;IN CH
HRLM CH,3(TA) ;UP-DATE PROTAB.
POPJ PP, ;---------------> RETURN
;WRITE LITAB ONTO CURRENT ASYFIL
EBURPL: SKIPG LITBLK ;ANYTHING ON LITFIL?
JRST EBRP10 ;NO
HRRZ TE,LITNXT ;YES--COMPUTE HOW
HRRZ TD,LITLOC ; MANY WORDS
SUB TD,TE ; STILL IN LITAB
JUMPE TD,EBRPL1 ;IF NONE--NO NEED TO WRITE
MOVM TE,TD ;INCREMENT LITBLK
ADDM TE,LITBLK
MOVSS TD ;BUILD
HRR TD,LITLOC ; IOWD LIST FOR
SETZ TC, ; OUTPUT
IFE TOPS20,<
OUT LIT,TD ;WRITE OUT REST OF TABLE
JRST EBRPL1 ;OK
MOVEI CH,LITDEV ;ERROR--KILL
JRST DEVDED
>
IFN TOPS20,<
DMOVEM TD,IOWLIT## ;STORE IOWD
PUSHJ PP,RITLIT## ;OUTPUT IT
>
EBRPL1:
IFE TOPS20,<
CLOSE LIT,
MOVE TE,LITHDR ;CREATE
HLLZ TD,LITHDR+1 ; LOOKUP
SETZB TC,TB ; PARAMETERS
LOOKUP LIT,TE ;OPEN FOR INPUT
JRST EBRP11 ;CANNOT FIND IT--MONITOR TROUBLE
>
IFN TOPS20,<
PUSHJ PP,CLSLIT## ;CLOSE IT
PUSHJ PP,SETLIT## ;SET UP LITFIL TO READ BACK IN DUMP MODE
>
SETZM EWORDB ;CLEAR COUNT OF WORDS IN TABLE
MOVE TE,LITLOC ;RESET LITNXT
MOVEM TE,LITNXT
PUSHJ PP,EBRPL2 ;[167] GO GET LITERAL FROM LITFIL
;WRITE LITAB ONTO ASYFIL (CONT'D)
EBRPL3: HRRZ EACC,LITLOC ;START AT TOP OF TABLE
JRST EBRPLA ;[167] GO GET LITERALL
EBRPL4: SOSG EWORDB ;[167] SEE IF MORE LITERAL IN CORE.
PUSHJ PP,EBMOR ;[167] NO READ IN MORE FROM LITFIL
EBRPLA: HRRZ TE,1(EACC) ;[167] GET CODE AND SIZE
LSH TE,6 ;SEPARATE CODE
HLLM TE,1(EACC) ;STORE IN LHS WHERE EXPECTED
MOVEI TE,770000
ANDCAM TE,1(EACC) ;CLEAR CODE FROM COUNT SIDE
HLRZ TE,1(EACC) ;GET LITAB CODE
CAILE TE,MAXLIT## ;IF ILLEGAL,
JRST EBRPLX ; TROUBLE
HRRZ EACB,1(EACC) ;GET GROUP SIZE
MOVE TE,EWORDB ;IS ENTIRE GROUP IN CORE?
CAIL TE,1(EACB)
JRST EBRPL6 ;YES
CAIG TE,1000 ;[167] NOT ALL OF LITERAL IN CORE. IS THERE A MINIMAL AMOUNT?
PUSHJ PP,EBMOR ;[167] GET READ MORE
EBRPL6: HLRZ TE,1(EACC) ;[167] GET CODE BACK
XCT BRPTAB(TE) ;EXECUTE SOME ROUTINE
HRRI CH,(EACB) ;IT WASN'T BYTE OR XWD--GET SIZE
PUSHJ PP,PUTASN ;WRITE OUT HEADER WORD
EBRPL7: SOSG TE,EWORDB ;[167] SEE IF MORE IN CORE
PUSHJ PP,EBMORA ;[210] NO READ IN MORE
MOVE CH,2(EACC) ;WRITE OUT DATA WORD
PUSHJ PP,PUTASY
ADDI EACC,1 ;BUMP LOCATION
SOJG EACB,EBRPL7 ;LOOP UNTIL DONE
AOJA EACC,EBRPL4 ;BUMP LOCATION AND LOOP
EBRPL9: POP PP,(PP) ;[167] POP OFF CALL TO EBMOR
MOVE TE,LITLOC ;RESET LITNXT
MOVEM TE,LITNXT
EBRPLE: POPJ PP,
;WRITE LITAB ONTO ASYFIL (CONT'D)
EBRPLX: OUTSTR [ASCIZ "?Bad LITAB code--compiler error
"]
SKIPL LITBLK
SETZM LITBLK
JRST EBRPL9
;NOTHING WAS WRITTEN ON LITFIL
EBRP10: MOVE TE,LITNXT
SUB TE,LITLOC
JUMPE TE,EBRPLE
HRRZM TE,EWORDB
JRST EBRPL3
IFE TOPS20,<
;CANNOT FIND LITFIL
EBRP11: OUTSTR [ASCIZ "?Cannot find LITFIL--compiler error
"]
JRST KILL
>
;[167] READ MORE LITERALS FROM THE LITFIL
;[167] CODE EBRPL5 AND EBRPL2 MADE INTO A SUBROUTINE HERE
;[167] INSERTED AT EBRP11+2
EBMORA: SKIPG LITBLK ;[210] ANYMORE ON LITFIL
JRST EBRPL9 ;[210] NO QUIT
PUSHJ PP,EBMOR ;[210] READ IN MORE
JRST EBMORC ;[210] FINISH UP
EBMORB: SKIPG LITBLK ;[210] ANY MORE ON LITFIL?
JRST EBRPL9 ;[210] NO QUIT
AOS EWORDB ;[210] KEEP ANY WORDS NOT USED
PUSHJ PP,EBMOR ;[210] GET MORE
SOS EWORDB ;[210] FIX UP WORD COUNT
EBMORC: SOS EACC ;[210] FIX LITTAB POINTER
POPJ PP, ;[210] RETURN
EBMOR: SKIPG TE,EWORDB ;[167] MAKE SURE WE DONT GO NEGATIVE
SETZB TE,EWORDB ;[167] SET NEGATIVE TO ZERO
HLRE TD,LITLOC ;RESET THE NUMBER OF WORDS LEFT FOR
ADD TD,TE ; LITNXT.
HRLM TD,LITNXT
HRRZ TD,LITLOC ;[167] NO-- WAS BRPPL5
ADDI TD,1 ;MOVE UP
HRLI TD,1(EACC) ; UNUSED
ADD TE,LITLOC ; WORDS
CAME TE,LITLOC
BLT TD,0(TE) ;[210]
HRRM TE,LITNXT ;RESET LITNXT
SKIPG LITBLK ;ANYTHING LEFT IN FILE?
JRST EBRPL9 ;NO--QUIT
EBRPL2: MOVE TE,LITBLK ;GET NUMBER OF WORDS IN FILE
CAILE TE,1600 ;IF MORE THAN ^D768,
MOVEI TE,1600 ; USE ^D768
ADDM TE,EWORDB ;INCREMENT TABLE COUNT
EBRP12: HLRE TD,LITNXT ;WILL LITFIL READ IN OVER TAGTAB?
ADDI TD,(TE) ; (THE TABLE AFTER LITTAB)
JUMPLE TD,EBRP13 ;NO
PUSHJ PP,XPNLIT ;YES, EXPAND LITTAB
JRST EBRP12
EBRP13: MOVNS TE ;DECREMENT
ADDM TE,LITBLK ; FILE WORD COUNT
MOVSS TE ;CREATE
HRR TE,LITNXT ; IOWD LIST
SETZ TD, ; FOR INPUT
IFE TOPS20,<
IN LIT,TE ;READ SOME WORDS
JRST EBRP1A ;OK
MOVEI CH,LITDEV ;ERROR--KILL
POP PP,(PP) ;[167] REMOVE CALL
JRST DEVDED
>
IFN TOPS20,<
DMOVEM TE,IOWLIT ;STORE IOWD
PUSHJ PP,GETLIT## ;READ IT
>
EBRP1A: HRRZ EACC,LITLOC ;[167] GET LITTAB START
POPJ PP, ;[167] RETURN
;WRITE LITAB ONTO ASYFIL (CONT'D)
BRPTAB: JRST EBRPLX ;0 --ERROR
JRST BRPXWD ;1 --XWD
JRST BRPBYT ;2 --BYTE POINTER
MOVSI CH,6B20!ASCASC ;3 --ASCII
MOVSI CH,6B20!ASCSIX ;4 --SIXBIT
MOVSI CH,6B20!ASCD1 ;5 --ONE-WORD DECIMAL
MOVSI CH,6B20!ASCD2 ;6 --TWO-WORD DECIMAL
MOVSI CH,6B20!ASCFLT ;7 --FLOATING POINT
MOVSI CH,6B20!ASCOCT ;10--OCTAL
MOVSI CH,6B20!ASCEBC ;11--EBCDIC
AOJA EACC,BRPXTN ;12--EXTEND OPCODE
MOVSI CH,6B20!ASCF2 ;[762] 13--D. P. FLOATING POINT
;ITEM IS AN XWD
BRPXWD: LSH EACB,-1 ;HALVE THE COUNT
MOVEI CH,(EACB) ;BUILD A HEADER WORD
HRLI CH,5B20
PUSHJ PP,PUTASN ;WRITE IT OUT
BRPX1: SOS EWORDB ;[167] COUNT DOWN TWO WORDS
SOSG TE,EWORDB ;[167] AND SEE IF ANY LITERALS IN CORE
PUSHJ PP,EBMORB ;[210] TABLE EMPTY READ IN MORE
MOVE CH,2(EACC) ;GET LEFT-HALF INFO
PUSHJ PP,PUTASN ;WRITE IT OUT
MOVE CH,3(EACC) ;GET RIGHT-HALF INFO
PUSHJ PP,PUTASY ;WRITE IT OUT
ADDI EACC,2 ;BUMP TO NEXT DATUM
SOJG EACB,BRPX1 ;LOOP IF MORE DATA FOR THIS ITEM
AOJA EACC,EBRPL4 ;LOOP BACK TO GET NEXT ITEM
;ITEM IS A BYTE POINTER.
BRPBYT: LSH EACB,-1 ;HALVE THE COUNT
BRPB1: SOS EWORDB ;[167] COUNT DOWN TWO WORDS
SOSG TE,EWORDB ;[167] AND SEE IF ANY LITERALS IN CORE
PUSHJ PP,EBMORB ;[210] TABLE EMPTY READ IN MORE
MOVSI CH,4B20 ;BUILD HEADER WORD
HRR CH,2(EACC)
LDB TE,[POINT 3,CH,20] ;GET TYPE OF ADDRESS
CAIN TE,AC.EXT## ;EXTERNAL?
JRST [PUSHJ PP,PUT.EX ;YES, CHECK FOR NON-RES
JRST .+2]
PUSHJ PP,PUTASY ;NORMAL ADDRESS PART--WRITE THAT OUT
MOVE CH,3(EACC) ;GET INCREMENT WORD
PUSHJ PP,PUTASN ;WRITE THAT OUT
ADDI EACC,2 ;BUMP TO NEXT DATUM
SOJG EACB,BRPB1 ;LOOP IF MORE DATA FOR THIS ITEM
AOJA EACC,EBRPL4 ;LOOP TO GET NEXT ITEM
;ITEM IS AN EXTEND [OPCODE]
BRPXTN: PUSHJ PP,PUTASA ;THEY ARE IN OTHER OPCODE SET
SOSG EWORDB ;ONLY ONE WORD?
PUSHJ PP,EBMORB ;TABLE EMPTY READ IN MORE
MOVSI CH,ZOP.## ;GET BASE OPCODE
ADD CH,1(EACC) ;GET WHICH EXTEND
LDB TE,[POINT 3,CH,20] ;GET CODE
PUSHJ PP,[CAIE TE,AC.EXT## ;EXTERNAL
AOJA EACC,PUTASY ;NO
TLNN CH,(@) ;YES, INDIRECT SIGN ON?
AOJA EACC,PUT.EX ;NO
AOJA EACC,PUT.SX] ;YES
BRPXT1: SOJLE EACB,EBRPL4 ;ONLY ONE WORD
SOSG TE,EWORDB ;SEE IF TABLE EMPTY
PUSHJ PP,EBMORB ;YES, FILL IT
MOVE CH,1(EACC) ;GET NEXT
PUSHJ PP,PUTASN
AOJA EACC,BRPXT1 ;LOOP
;PUT AN ENTRY INTO SECTAB
PUSHJ PP,XPNSEC
PUTSEC: MOVE TA,SECNXT
AOBJP TA,.-2
MOVEM TB,(TA)
MOVEM TA,SECNXT
POPJ PP,
;UPDATE SECTAB, BURP OUT LITAB AND ALTAB
SEGCLN: PUSHJ PP,CKEXIT ;CHECK FOR EXITS REQUIRING GENERATION
TSWF FAS3 ;ARE WE IN A NON-RESIDENT SEGMENT?
SKIPA TB,EAS3PC ;YES--USE EAS3PC
MOVE TB,EAS2PC ;NO--USE EAS2PC
MOVSI TB,(TB) ;LH _ RH
PUSHJ PP,PUTSEC ;STASH THAT IN SECTAB
MOVEI TB,0
PUSHJ PP,PUTSEC ;MAKE ROOM FOR 2ND ENTRY
;IF REQUIRED. IF NOT NEEDED, 2ND
;ENTRY WILL BE 0'S.///
SETOM LITASY## ;FLAG FOR UUO CONVERSION - LITTAB TO ASY
;PUT OUT A RELOC OPERATOR & DUMP LITAB (IF NECESSARY)
SKIPN W2,ELITPC ;ANYTHING IN LITAB?
JRST ETSTAL ;NOTHING IN LITAB, CHECK ALTERS.
MOVE CH,[XWD AS.REL+1,AS.MSC] ;RELOC OPERATOR OUT
PUSHJ PP,PUTASN ;WRITE IT OUT
MOVEI CH,AS.LIT ;ADD TO BASE OF LITERALS FLAG + 0.
PUSHJ PP,PUTASN ;WRITE IT OUT
;SPILL CONTENTS OF LITAB TO ASYFIL
PUSHJ PP,EBURPL
ETSTAL: SKIPE W2,EALTPC ;IF PPC IS 0, NO DUMPING
PUSHJ PP,EBPALT ;BURP OUT ALTER FOR > 50.
TSWT FAS3 ;ARE WE IN A NON-RESIDENT SEGMENT?
JRST ETSTA1 ;NO
MOVE TA,EAS3PC ;YES--IF BIGGER
CAMLE TA,HILOC ; THAN LAST ONE,
MOVEM TA,HILOC ; RESET PROGRAM BREAK
ETSTA1: JUMPE EACA,EBURPX ;IF END OF PROG--NO CHECKS
HRRZ TA,(EACA) ;GET OPERAND'S FLAGS
;IN THE CASE OF THE CALL FROM ERAPUP,
;THIS MAY BE A DUMMY CREATED BY SELF.
PUSHJ PP,LNKSET
HRRZ TA,2(TA) ;THERE, GOT THE PRIORITY # FOR NEXT GUY <OR DUMMY>
CAIL TA,^D1B24 ;GOING TO RES ?
SWON FAS3 ; _ NOPE, SET "IN NON-RES FLAG.
; _ YEP, INITIAL CASE = SET TO
;RESIDENT, SO CONTINUE THINKING YOU ARE
;IN RESIDENT UNTIL YOU SEE NON-RES.
;FROM THE 1ST TIME YOU SEE NON-RES,
;ALL SUBSEQUENT SEGS WILL BE NON-RES.
TSWF FAS3 ;ANY NON-RESIDENTS SEEN?
IFN TOPS20,<
SKIPE SEGFLG ;YES, FIRST TIME?
JRST EBURPX ;NO
>
SETOM SEGFLG ;YES--SET INDICATOR FOR PHASE G
;CLEAR SOME WORK AREA
EBURPX: SETZB TB,EZEROL
SETZM ELITPC ;CLEAR LIT'S PPC.
SETZM EALTPC ;AND ALT'S PPC.
SETZM LITASY## ;CLEAR LITTAB TO ASY FLAG
MOVE TE,[XWD EZEROL,EZEROL+1]
BLT TE,EZEROH
JRST POOLINI## ;RESET LITERAL POOLER AND RETURN
EBPALT: HRRZ EACB,EAS3PC ;SAVE EAS3 PC
HRLI EACB,(W2) ;SAVE EALT PC TOO.
MOVSI CH,5B20 ;XWD HEADER
HRRI CH,(W2) ;WITH TYPE CODE AND # 2-WORD ENTRIES.
PUSHJ PP,PUTASN ;ONTO WRITE-LOCKED AS2 OR AS3.
SKIPA TA,ALTLOC ;ENTER DUMP
MORALT: MOVEI TA,2(TA) ;GET NEXT GUY & CONTINUE
MOVE CH,1(TA) ;1ST WORD
PUSHJ PP,PUTASN ;= LEFT HALF OF XWD
MOVE CH,2(TA) ;
PUSHJ PP,PUTASY ;2ND WORD = RIGHT HALF OF XWD
SOJG W2,MORALT ;MORE? YES ^; NO FALLS THRU
;NOPE _
;ALTAB HAS BEEN DUMPED, RESET IT TO ITS INITIAL VALUE SO THAT IF
; SUBSEQUENT SECTIONS CONTAIN ALTERS, THEY WILL BE DUMPED.
MOVE TA,ALTLOC##
MOVEM TA,ALTNXT##
;UPDATE 2ND WORD IN SECTAB NOW!
;SECNXT POINTS TO WORD YOU ARE GOING
;TO UPDATE:
HRRZ TA,SECNXT ;GET POINTER
MOVEM EACB,(TA) ;SECTAB ENTRY FOR THIS SEG COMPLETED!
;NOW SEE WHO IS LARGER,
HLRZ EACB,EACB ;EALTPC FOR THIS SEG?
CAMLE EACB,EALTMX ;OR BIGGEST SEEN TO DATE?
HRRZM EACB,EALTMX ;PRESENT ONE BECOMES CONTENDER.
POPJ PP, ;EVERTYTHING TAKEN CARE OF, RETURN.
;ALTERS WERE BURPED OUT
CKEXIT: SKIPGE W2,EPPARA ;CLEAN UP PRESENT PARAGRAPH
;FIRST: CHECK FOR PREVIOUS PARAGRAPH'S REQUIRING EXIT.
PUSHJ PP,SETUPP ;SET UP FOR GENERATING PARAGRAPH'S EXIT
SKIPGE W2,EPSECT ;SECOND: DO SAME FOR SECTION LAST SEEN
PUSHJ PP,SETUPS ;SET UP FOR GENERATING SECTION'S EXIT
POPJ PP, ;---------------> RETURN
SETUPP: MOVEI EACC,EPPARA ;SET POINTER TO INFORMATION ABOUT PREVIOUS PARAGRAPH
JRST EXITRP ;GO GENERATE THE EXIT
SETUPS: MOVEI EACC,EPSECT
JRST EXITRP
MAKXWD: MOVE CH,[XWD AS.XWD,1] ;BUILD UP 1ST 3 WORDS OF AN XWD
PUSHJ PP,PUTAS1
TRNE EACC,40 ;ARE ALL ALTERS IN THIS SEG?
JRST ADDBIT ;NOPE! <NOT ALL OF DESTINATIONS IN THIS SEG>.
MOVEI CH,0
PUSHJ PP,PUTAS1 ;AND WRITE OUT THE LEFT HALF
MOVE CH,EACB ;ADDRESS FOR JRST @ ALTERED GO
;GOES IN RIGHT HALF OF XWD
ENDXWD: PUSHJ PP,PUTAS1 ;XWD & THERE IS 1 OF ME
;LEFT HALD IS 0
AOS CH,EAS1PC
MOVEI CH,100000-1(CH) ;BUMP PPC FOR THE WHOLE WORD TO BE PUT OUT
;RESTORE PPC COUNT TO PRIOR SETTING & GET F-G
;TABLE INTO CH
POPJ PP, ;--------------- RETURN
ADDBIT: MOVE CH,EACB ;ADDRESS FOR THIS GUY GOES IN LEFT HALF
PUSHJ PP,PUTAS1
CAMN CH,EGOTO ;WHETHER IT'S EGOTO
PUSHJ PP,GOTOSG
PUSHJ PP,GETBIT ;PRIORITY BITS INTO RIGHT HALF
JRST ENDXWD ;FINISH UP THE OVLAY. XWD
SOLVER: SKIPA TA,-2(EACA) ;GET PROCEEDING LINK [NEXT EARLIER ONE ENTERED]
RESOLV: MOVE TA,(EACA) ;GET LINK AS POINTED TO BY EACA IN EOPTAB.
TLNN TA,EUNREZ ;IS THIS A FLOTAB ENTRY WHICH NEEDS TO BE RESOLVED
;INTO A PROTAB ENTRY ?
JRST ITISOK ;IT'S OK, THAT IS, IT'S ALREADY A PROTAB ENTRY.
ANDI TA,77777 ;GET JUST THE OFFSET BITS
ADD TA,FLOLOC ;ADD TO RELATIVE OFFSET, THE STARTING TABLE ADDRESS
;HELD IN FLOLOC.
LDB TE,FL.TAG##
HRRZ TA,(TA) ;GET WHERE YOU ARE POINTED.
JUMPN TE,CPOPJ ;If its a TAGTAB entry, exit
ITISOK: MOVEI TA,(TA) ;INSURE LEFT HALF OF TA CLEAR
CAIL TA,400001 ;NOW THAT YOU HAVE RESOLVED ENTRY, IS IT
;REALLY A PROTAB ENTRY /
;BETWEEN 400001 AND 500000 IS IT ?
CAIL TA,500000
POP PP,TE
POPJ PP, ;THE POP IS THE ERROR CONDITION, WHICH
;WILL THEN POPJ YOU TO CALLING ROUTINE.
OVLHDR: MOVE TA,[XWD XWDLIT,2];HEADER FOR XWD
PUSHJ PP,STASHP ;OUT ON FILE AS2, OR 3
HLRZ TA,CURPRO ;ADDRESS INTO LEFT HALF OF
;THE XWD YOU ARE BUILDING.
PUSHJ PP,STASHQ
;INTO THE RIGHT HALF OF XWD YOU ARE BUILDING:
MOVEI TA,ENREZE ;MASK FOR ALL BUT PRIORITY BITS
ANDI TA,(EACD) ;NOW THE PRIORITY BITS FOR THE DESTINATION.
; PRI BITS/ PRI BITS,AS.CNB
;= WORD OUT
LSH TA,^D7 ;MAKING ROOM FOR THE
MOVEI TC,(EACC) ;SAVE OLD EACC 1ST THOUGH!!!!
ANDI TC,ENREZE ;STRIP OFF ALL BUT PRITOITY BITS
LSH TC,-^D2 ;SHIFTED
TLO TA,(TC) ;SOURCE PRIORITY BITS INTO TB, RIGHT[TEST] HALF.
HRRI TA,AS.CNB ;CONSTANT INCREMENT TYPE CODE
PUSHJ PP,POOLIT ;PUT OUT LAST WORD
SKIPN CH,PLITPC
AOSA CH,ELITPC ;BUMP PC
TROA CH,AS.LIT
MOVEI CH,AS.LIT-1(CH) ;ADD IN TYPE CODE & READJUST PPC COUNT TO LOOK
;AT WORD JUST OUTPUT, NOT NEXT WORD.
POPJ PP,
GETBIT: MOVEI TA,-ECPFLG(CH) ;RESTORE LINK TO E NOTATION.
GTBIT1: PUSHJ PP,LNKSET
HRRZ CH,2(TA) ;GET PRIORITY BITS
ANDI CH,ENREZE
LSH CH,^D7 ;POSITION SEG # BITS.
MOVEI TC,(EACC) ;SAVE OLD EACC!!
ANDI TC,ENREZE ;INSURE THAT NO MORE BITS THAN
;THE PRIORITY BITS GET INTO XWD.
LSH TC,-^D2
TLO CH,(TC) ;SEG PRIORITY BITS IN LEFT
;HALF, AS.CNB INTO RIGHT HALF.
HRRI CH,AS.CNB
POPJ PP,
ENREZF=774B27 ;THE NON-RESIDENT MASK USED
;TO DISCERN A RESIDENT PROCEDURE NAME
;[ENREZF = ALL 0] FROM A NON-RESIDENT ONE.
;THE CODE KEY KEPT IN EPPARA AND EPSECT
;IS SLIGHTLY DIFFERENT FROM THE FORMAT
;AS IT IS STORED IN PROTAB...
;THE PRIORITY # IS SHIFTED RIGHT 1.
;... SEE PARGEN FOR FURTHER DESCRIPTION.
ENREZE=774B26 ;MASK FOR PRIORITY # [AS ABOVE] BUT SHIFTED 1
;TO THE LEFT. PRIORITY # & FLAGS
;LINE UP WITH PROTAB ENTRY..
EUNREZ=1B20 ;UNRESOLVED 1ST PASS OPERAND FLAG
FLAGPP: POINT 18,EPPARA,18 ;ALL OF EPPARA'S FLAGS SHIFTED LEFT 1 BIT
;SO THAT THEY ARE IN SYNC WITH FLAGS IN PROTAB.
FLAGPS: POINT 18,EPSECT,18 ;DITTO FOR SECTION FLAGS
EXTERNAL FPMODE,F2MODE,PTFLAG,CURPRO,EWORDB,LNKCOD,TM.TAG
EXTERNAL ALTLOC,ALTNXT,EALTMX,EALTPC
EXTERNAL EAS1PC,EAS2PC,EAS3PC,EZEROH,EZEROL
EXTERNAL LITLOC,LITNXT,SECNXT,FLOLOC,FLONXT
EXTERNAL OVLAY.
EXTERNAL MOVSI.,JRST.,MOVEI.,MOVEM.,EPJPP
EXTERNAL ELITPC,EPPARA,EPSECT,XWDLIT,AS.XWD,TB.PRO,HILOC,SEGFLG
EXTERNAL LITBLK
EXTERNAL AS.CNB,AS.GO,AS.MSC,AS.TAG,AS.LIT,AS.REL,AS.PRO
EXTERNAL TM.PRO
IFN TOPS20,<
EXTERNAL LITDEV,LITHDR
>
END