Trailing-Edge
-
PDP-10 Archives
-
BB-H580E-SB_1985
-
xfrgen.mac
There are 7 other files named xfrgen.mac in the archive. Click here to see a list.
; UPD ID= 3346 on 1/16/81 at 2:29 PM by NIXON
TITLE XFRGEN FOR COBOL V12C
SUBTTL TRANSFER-OF-CONTROL GENERATORS SERG POLEVITSKY/ALB/CAM
SEARCH COPYRT
SALL
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
SEARCH P
%%P==:%%P
;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.
TWOSEG
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
RELOC 400000
SALL
ENTRY XFRGEN
XFRGEN:
INTERNAL PARGEN,GOGOGN,SECGEN,ALTGEN,PERFGN,STOPGN,GODPGN,PRFYGN
INTERNAL EWARN, RESOLV, SOLVER
INTERNAL TAGGEN, JUMPTO, SEGBRK, SEGCLN
INTERNAL DECLST,DECLEN ;[435]
EXTERNAL DCLTAG ;[435]
EXTERNAL INDCLR
EXTERNAL BADEOP,FATAL,WARN,LNKSET,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
;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
>
IFN ANS74,<
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
IFN ANS74,<
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
;SEE COBOL MEMO 100-350-011.1
;PAGES 15 - 16.
;UNDER PROTAB FLAGS.
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
IFN CSTATS,<
SKIPN METRSW## ;METER--ING?
JRST EGTNNN ;NO
MOVE CH,[MOVEI.+AC16,,^D1476] ;1476= PARAGRAPH TRACE CODE
PUSHJ PP,PUTASY##
MOVEI CH,METER.##
PUSHJ PP,PUT.PJ
EGTNNN: >;END IFN CSTATS
MOVEI CH,C.TRCE##
PUSHJ PP,PUT.PJ
MOVE CH,[XWD AS.XWD,1]
PUSHJ PP,PUTASN
IFN ANS74,<
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
>
IFN ANS68,<
HRRZI CH,1 ;ARG COUNT
>
PUSHJ PP,PUTASN
HRRZ CH,0(EACC)
IFN ANS68,<
TRZ CH,700000 ;GRNTEE ADRCON
JRST PUTASY ;PUT OUT CODE
>
IFN ANS74,<
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
IFN ANS74,<
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
IFN CSTATS,<
SKIPN METRSW## ;DOING METER--ING?
JRST EXITR1 ; NO
MOVE CH,[MOVEI.+AC16,,^D1475] ;1475= PERFORM EXIT (TIMED)
PUSHJ PP,PUTASY##
MOVEI CH,METER.##
PUSHJ PP,PUT.PJ
EXITR1: >;END IFN CSTATS
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
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
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)
HRRZ TA,(EACA) ;GET
PUSHJ PP,LNKSET ; FLAGS FOR
HRRZ EACB,PTFLAG(TA) ; "B"
MOVS TA,OPERND ;GET
MOVE TA,1(TA) ; FLAGS
PUSHJ PP,LNKSET ; FOR
IFN ANS74,<
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
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
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.
HRLI CH,EPJPP
JRST PUTASY ;GENERATE PUSHJ 17,<PERFORM-PARA>
;HERE FOR PERFORM OF EITHER NOT /Q OR NOT ALL RESIDENT (OR BOTH)
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
EXTERNAL PRODSW
EXTERNAL SETOPN, PUT.B, PUT.LA, GETTAG, PUTTAG, CONVNL
EXTERNAL MXAC., MACX., PUTAS1, PUTASY, PUTASN, OPNFAT
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 IA A COMP-1 ITEM
BADFP: MOVEI DW,E.321
JRST OPNFAT
SUBTTL THE STOP GENERATOR
;SEE COBOL MEMO 100-350-007
;"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 < LIEREAL>
;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.
TLNN EACB,1B19 ;IS THE LITERAL OR FIGURATIVE CONSTANT
;FLAG UP?
JRST EBLTFC ;NOPE! IT WASN'T, BAD SHOW, BAD OPERAND TYPE.
;EITHER (A): BIT UP SAYING "I AM A LITERAL"
;OR (B): BIT FROM (A) AND BIT SAYING "I AM
; I AM ALSO A FIGURATIVE CONSTANT"
;**THESE ARE THE ONLY TWO CONDITIONS!!**
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.
IFN ANS68,<
JRST PUTASY ;IF ALTER WORD WRITE IT OUT.
>
IFN ANS74,<
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.
IFN ANS68,<
JRST PUTASY ;FINISH UP THE INSTRUCTION WITH ITS ADDRESS
>
IFN ANS74,<
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
IFN ANS68,<
JRST PUTASY
>
IFN ANS74,<
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"
IFN ANS74,<
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,[XWD 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.
;CH 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,[XWD 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
IFN ANS74,<
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
IFN ANS68,<
TLNE TE,GNFIGC ;FIG. CONST.?
TLNN TE,GNTALY ;YES--TALLY?
>
JRST BADEP4 ;NO--ERROR
;VARIABLE FOUND
GODPG3: MOVEM EACA,EOPNXT
MOVEI TC,1(EACA)
MOVEM TC,CUREOP
MOVSM TC,OPERND
IFN ANS74,<
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
IFN ANS74,<
PUSH PP,EDEBDA ;DON'T WANT DEBUGGING CODE ON MOVE
SETZM EDEBDA
>
MOVEI TE,3
MOVEM TE,EAC
PUSHJ PP,MXAC.
IFN ANS74,<
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.
IFN ANS74,<
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
OUT LIT,TD ;WRITE OUT REST OF TABLE
JRST EBRPL1 ;OK
MOVEI CH,LITDEV ;ERROR--KILL
JRST DEVDED
EBRPL1: 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
SETZM EWORDB ;CLEAR COUNT OF WORDS IN TABLE
MOVE TE,LITLOC ;RESET LITNXT
MOVEM TE,LITNXT
PUSHJ PP,EBRPL2 ; GO GET LITERAL FROM LITFIL [167]
;WRITE LITAB ONTO ASYFIL (CONT'D)
EBRPL3: HRRZ EACC,LITLOC ;START AT TOP OF TABLE
JRST EBRPLA ; GO GET LITERALL [167]
EBRPL4: SOSG EWORDB ; SEE IF MORE LITERAL IN CORE [167].
PUSHJ PP,EBMOR ; NO READ IN MORE FROM LITFIL [167]
EBRPLA: ; NEED NEW LABEL [167]
HRRZ TE,1(EACC) ;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 ; NOT ALL OF LITERAL IN CORE. IS THERE A MINIMAL AMOUNT ? [167]
PUSHJ PP,EBMOR ; GET READ MORE [167]
EBRPL6: ; MOVE LABEL [167]
HLRZ TE,1(EACC) ;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 ; SEE IF MORE IN CORE [167]
PUSHJ PP,EBMORA ; NO READ IN MORE [210]
MOVE CH,2(EACC) ;WRITE OUT DATA WORD
PUSHJ PP,PUTASY
MOVEI EACC,1(EACC) ;BUMP LOCATION
SOJG EACB,EBRPL7 ;LOOP UNTIL DONE
AOJA EACC,EBRPL4 ;BUMP LOCATION AND LOOP
EBRPL9: POP PP,(PP) ; POP OFF CALL TO EBMOR [167]
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
;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
IN LIT,TE ;READ SOME WORDS
JRST EBRP1A ;OK
MOVEI CH,LITDEV ;ERROR--KILL
POP PP,(PP) ;[167] REMOVE CALL
JRST DEVDED
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 TE,EWORDB ; COUNT DOWN TWO WORDS [167]
SOSG TE,EWORDB ; AND SEE IF ANY LITERALS IN CORE [167]
PUSHJ PP,EBMORB ; TABLE EMPTY READ IN MORE [210]
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
MOVEI EACC,2(EACC) ;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 TE,EWORDB ; COUNT DOWN TWO WORDS [167]
SOSG TE,EWORDB ; AND SEE IF ANY LITERALS IN CORE [167]
PUSHJ PP,EBMORB ; TABLE EMPTY READ IN MORE [210]
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
MOVEI EACC,2(EACC) ;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?
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.
HRRZ TA,(TA) ;GET WHERE YOU ARE POINTED.
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 LITDEV,LITHDR,LITBLK
EXTERNAL AS.CNB,AS.GO,AS.MSC,AS.TAG,AS.LIT,AS.REL,AS.PRO
EXTERNAL TM.PRO
END