Trailing-Edge
-
PDP-10 Archives
-
BB-H506E-SM
-
cobol/source/cobolg.mac
There are 14 other files named cobolg.mac in the archive. Click here to see a list.
; UPD ID= 3556 on 5/15/81 at 11:04 PM by NIXON
TITLE COBOLG FOR COBOL V12C
SUBTTL PHASE G - ASSEMBLY AL BLACKINGTON/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,COMUNI,TABLES
SEARCH OPCTAB
%%P==:%%P
%%COMU==:%%COMU
DBMS==:DBMS
DEBUG==:DEBUG
MCS==:MCS
TCS==:TCS
;EDITS
;NAME DATE COMMENTS
;WTK 23-SEP-80 [1055] FIX EDIT 762 TO USE CORRECT ERROR MESSAGE.
;DMN 30-MAY-80 [1024] FIX BUG IN EDIT 762 IF D. P. MANTISSA IS EXACTLY 18 DIGITS.
;LEM 9-APR-80 [1010] FINISH EDIT 774
;DAW 10-MAR-80 [774] DELETE AS1.TMP IF USING -,-=FOO/O
;DMN 1-FEB-80 [762] IMPLEMENT AND USE D. P. FLOATING POINT LITERALS
;DMN 12/28/79 [756] GENERATE REQUEST FOR C.RSET IN COBOL SUBPROGRAMS
;DMN 3/6/79 [653] TURN ON FFATAL ON ASSEMBLY ERRORS
;V10*****************
;JEC 01/29/76 [402] ADD INSTRUCTION HRRI
;DPL 01/29/76 [401] DON'T OUTPUT USES ADDR IF ONLY DBMS USE PROC
;GPS 3/12/75 ADD CODE FOR SIMULTANEOUS UPDATE
;DBT 1/17/75 ;SEARCH COMUNI.UNV FOR DEFINITION OF FIXNUM
; GET COMSIZ (LIBOL LOW SEG ALLOC) FROM COMUNI ALSO
; EXPAND THE INFIX% MACRO TO GET INDICES OF
; THE HEADER BLOCK AND CHECK THAT THEY ARE
; GENERATED AT THE APPROPRIATE SPOTS
;
; GENERATE THE NEW HEADER ELEMENTS
; COBVR. COMPILER VERSION
; COBSW. ASSEMBLY SWITCHES
; PUSHL. PUSH DOWN LIST SIZE
;
;DBT 1/17/75 ;PUT IN ERROR CHECK RATHER THAN GENERATING
; UUO' ANY MORE. COBOLE SHOULD NOT LET ANY THROUGH
; IF IT DOES IT MEANS THAT THE UUO WAS ENTERED
; INTO THE ASY FILES BY OTHER THAN A PUTASY CALL
; THE UUO GENERATOR MUST BE CHANGED
;ACK 22-APR-75 ALLOW EBCDIC LITERALS IN THE ASY FILES.
;********************
; EDIT 266 CALL TO TTYON TO TURN ON TTY
; [EDIT 201] GENERATE CODE FOR COBOL START UP START.: JSP 16,COBST.
;EDIT 110 FIX COMPILE WITH /A WITH AN ALTER TO A PROCEED TO
; A NON-RESIDENT SEGEMENT
TWOSEG
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
RELOC 400000
SALL
INTERNAL CLRDAT,PUTDAT,PDATI,COMSIZ
EXTERN SURRT.,SUEQT.,SUFBT.
EXTERNAL SETASY,GETASY,PUTBIN,KILL
EXTERNAL PUTLST,LCRLF,HDROUT,LSTMES,KILLF,LNKSET
EXTERNAL RESTRT,DEVDED
EXTERNAL PSORT,RELES,RETRN,MERGE,BLKTYP
DEFBYT XXFIL,3,1 ;FILLER IN WORD 1
DEFBYT EXENT,1,1 ;1 BIT, WORD 1
COBOLG: SETFAZ G;
SKIPN NAMNXT ;IF NO NAMTAB,
SETOM PRODSW ; PRETEND '/P' TYPED
SETZM GAERAS ;CLEAR ERROR COUNTER
SETZM ACSFLG## ;CLEAR ALTERNATE CODE SET FLAG
SETZM INDFLG## ;CLEAR INDENT FLAG
SETZM OVRWRD ;SO WE OUTPUT SYMBOLS TO NON-OVERLAY PART
IFN FT68274,<
JRST NDASY0 ;NEVER ASSEMBLE, CVT FILE IS ON BIN CHAN
>
IFE DEBUG,<
TSWF FFATAL;
JRST NDASY0
>
SKIPN BINDEV ;DO WE HAVE TO ASSEMBLE?
TSWF FOBJEC;
JRST COBLGA ;YES
SKIPN OPTSW ;[774] CHECK FOR /O TURNED ON
JRST NDASY0 ;NO--QUIT
MOVEI TA,'AS1' ;[774] SPECIFY AS1 BACK TO CHANNEL 12
HRRM TA,ASYFIL ;[774] SO WE CAN DELETE AS1.TMP LATER.
PUSHJ PP,SETASY ;[774] DO A LOOKUP
JRST NDASY0 ;[1010] NO--QUIT
COBLGA: MOVSI TE,(ASCIZ "A")
MOVEM TE,HDRPAG
SETZM SUBPAG
SETZM PAGCNT
TSWT FOBJEC ;ANY OBJECT LISTING?
SWON FNOLST ;NO--TURN ON "NO LISTING AT ALL"
HRRZS OBJSIZ
MOVE TA,NONRES ;SET HILOC
ADDB TA,HILOC ; (HIGHEST LOC IN LOW SEGMENT)
;11-MAY-79 /DAW CHECK FOR LOW SEG BEING TOO BIG
ADDI TA,COMSIZ+LO.PUR ;GET ABSOLUTE VALUE OF HIGHEST LOC.
CAIL TA,MLOWSZ ;MAX EXCEEDED?
SETOM FTOOBG## ;YES, MAKE SURE FLAG IS SET
;NOW GO AHEAD AND TRY TO ASSEMBLE ANYWAY
COBLGC: PUSHJ PP,INITAL ;INITIALIZE THE PHASE
JRST NXTAS2 ;START UP
;PICK UP NEXT ASYFIL
NXTASY: CLOSE ASY, ;CLOSE THAT ASYFIL
IFN DEBUG,<
MOVE TE,CORESW
TLNN TE,%KILLG
TLNE TE,%KILFG
JRST NXTAS0
>
MOVEI TE,0 ;DELETE
RENAME ASY,TE ; THE ASYFIL,
JFCL ; IGNORING ANY TROUBLE
NXTAS0: PUSHJ PP,CLRDAT ;CLEAN OUT GRPDAT
HRRZ TA,ASYFIL ;WAS THAT AS3FIL?
CAIN TA,(SIXBIT "AS3")
JRST ENDASY ;YES--ALL DONE
AOS ASYFIL ;NO--SET UP NEXT
CAIE TA,(SIXBIT "AS1") ;WAS THAT THE DATA SEGMENT?
JRST NXTAS1 ;NO
;NEXT INPUT FILE IS FOR THE RESIDENT SECTIONS
PUSHJ PP,STARTI
MOVE PC,RESDNT ;RESET CURRENT LOCATION COUNTER
MOVEM PC,DATGRP+2
JRST NXTAS3
;NEXT INPUT FILE IS FOR THE NON-RESIDENT SECTIONS
NXTAS1: PUSHJ PP,EXTOUT ;WRITE OUT ANY DUMMIES FOR EXTERNAL REFERENCES
PUSHJ PP,SETOVR ;SET UP OVERLAY TABLE
MOVE PC,NONRES
SWON FASSEG ;SET "THIS IS NON-RESIDENT"
NXTAS3: MOVEM PC,CURREL
NXTAS2: PUSHJ PP,SETASY
;PICK UP NEXT ITEM IN ASYFIL
GET: PUSHJ PP,GETASY ;GET NEXT DATUM
JUMPE CH,NXTASY ;JUMP IF FILE FINISHED
MOVE W1,CH
JUMPL CH,NOTOPR ;IS IT AN INSTRUCTION?
MOVE TB,W1 ;SET UP LH OF "TB"
LDB TE,[POINT 3,W1,20];PICK UP ADDRESS TYPE
CAIE TE,6 ;CONSTANT OR
CAIN TE,7 ; MISCELLANEOUS?
TLO W1,ASINC ;YES--SET "INCREMENT FOLLOWS"
TLNN W1,ASINC ;ANY INCREMENT?
TDCA CH,CH ;NO--USE ZERO
PUSHJ PP,GETASY ;YES--GET IT
MOVE W2,CH ;IF RH=0, LH=INCREMENT (NEG OR POS)
PUSHJ PP,GETOPR
TSWT FNOLST ;ANY LISTING?
PUSHJ PP,LSTOPR ;YES--LIST IT
SETZM ACSFLG ;CLEAR ALTERNATE CODE SET FLAG
HRLZS INDFLG ;HALF-CLEAR FLAG SO IT WORKS FOR NEXT DATUM, BUT NOT ONE AFTER
AOJA PC,GET ;LOOP
;ITEM WAS NOT AN INSTRUCTION
NOTOPR: SWOFF FGDEC;
LDB TA,[POINT 3,W1,2];GET CODE
JRST @.+1-4(TA)
EXP BYTER
EXP XWDER
EXP CONST
EXP MISC
;ITEM IS A BYTE POINTER
BYTER: PUSHJ PP,GETASY
HRRZ W2,CH
MOVE TB,CH
PUSHJ PP,GETADR
PUSHJ PP,PUTDAT
TSWT FNOLST ;ANY LISTING?
PUSHJ PP,LSTBYT ;YES--LIST THE BYTE POINTER
AOJA PC,GET ;BACK FOR NEXT
;ITEM IS AN XWD
XWDER: HRRZ CT,W1 ;GRAB ITEM COUNT
XWDER1: PUSHJ PP,GETASY ;GRAB LH WORD FROM ASYFIL
MOVE W1,CH
HLRZ W2,CH
PUSHJ PP,GETADR ;RESOLVE ADDRESS
MOVSS TB ;PUT IT IN LEFT HALF
LSH TA,1 ;SHIFT RELOCATION
PUSH PP,W1 ;SAVE THE WORD
PUSH PP,TA ;SAVE RELOCATION
PUSHJ PP,GETASY ;GRAB RH WORD FROM ASYFIL
MOVE W1,CH
HLRZ W2,CH
PUSHJ PP,GETADR ;RESOLVE ADDRESS
POP PP,TC ;GET LH RELOCATION
OR TA,TC ;COMBINE WITH RH
PUSHJ PP,PUTDAT ;WRITE OUT WORD
EXCH W1,(PP)
POP PP,TC
TSWT FNOLST ;ANY LISTING?
PUSHJ PP,LSTXWD ;YES--LIST IT
ADDI PC,1 ;KICK UP LOCATION COUNTER
SOJG CT,XWDER1 ;LOOP IF MORE XWD'S
JRST GET ;NO--GO AFTER NEXT ITEM
;ITEM IS A CONSTANT
CONST: HRRZ CT,W1
TLNN W1,ASCON
JRST BADCON
TLNE W1,ASCSIX
JRST CONSIX
TLNE W1,ASCASC
JRST CONASC
TLNE W1,ASCEBC
JRST CONEBC
TLNE W1,ASCD1
MOVEI OP,0
TLNE W1,ASCD2
MOVEI OP,1
TLNE W1,ASCFLT
MOVEI OP,2
TLNE W1,ASCOCT
MOVEI OP,3
TLNE W1,ASCF2 ;[762] COMP-2?
JRST CONSF2 ;[762] YES
CONST1: PUSHJ PP,GETASY
TLNN W1,ASCFLT ;FLOATING POINT?
SKIPA TB,CH ;NO--TAKE IT AS IS
PUSHJ PP,FLTCON ;YES--CONSTRUCT CONSTANT
MOVEI TA,0
PUSHJ PP,PUTDAT
TSWF FNOLST;
JRST CONST2
PUSHJ PP,LSTCOD
PUSHJ PP,@CONTAB(OP)
PUSHJ PP,LCRLF
CONST2: ADDI PC,1
SOJG CT,CONST1
JRST GET
;TABLE OF ROUTINES WHICH LIST CONSTANTS
CONTAB: EXP LSTD1
EXP LSTD2
EXP LSTFLT
EXP LSTOCT
;ITEM IS A CONSTANT (CONT'D).
;IT IS SIXBIT
CONSIX: MOVE TC,CT
CONSX1: CAIG TC,^D12
JRST CONSX2
MOVEI TC,^D12
PUSHJ PP,LSTSIX
MOVNI TC,^D12
ADDB TC,CT
JRST CONSX1
CONSX2: PUSHJ PP,LSTSIX
JRST GET
;IT IS ASCII
CONASC: MOVE TC,CT
CONAS1: CAIG TC,^D14
JRST CONAS2
MOVEI TC,^D14
PUSHJ PP,LSTASC
MOVNI TC,^D14
ADDB TC,CT
JRST CONAS1
CONAS2: PUSHJ PP,LSTASC
JRST GET
;IT IS EBCDIC
CONEBC: MOVE TC,CT ;NUMBER OF WORDS.
CONEB1: CAIG TC,^D18 ;MORE THAN 72 CHARS?
JRST CONEB2 ;NO, GO FINISH UP.
MOVEI TC,^D18 ;SET THE LIMIT AT 18 WORDS.
PUSHJ PP,LSTEBC ;GO PUT THEM OUT.
MOVNI TC,^D18
ADDB TC,CT ;ADJUST THE COUNTS.
JRST CONEB1 ;GO WRITE THE REST OUT.
CONEB2: PUSHJ PP,LSTEBC ;PUT OUT WHATEVER IS LEFT.
JRST GET ;GO GET MORE ASY STUFF.
;[762] IT IS D. P. FLOATING POINT
CONSF2: PUSHJ PP,F2CON ;[762] CONSTRUCT 2 WORD CONSTANT IN TB AND TA
MOVE TC,TA ;[762] PUT SECOND WORD IN SAFE PLACE
MOVEI TA,0 ;[762]
PUSHJ PP,PUTDAT ;[762]
MOVEI TA,0 ;[762]
EXCH TB,TC ;[762] SECOND WORD
PUSHJ PP,PUTDAT ;[762]
EXCH TB,TC ;[762]
TSWF FNOLST ;[762]
AOJA PC,CONST2 ;[762] COUNT TWO WORDS
PUSHJ PP,LSTCOD ;[762]
PUSHJ PP,LSTF2 ;[762] LIST IT
PUSHJ PP,STRTI9 ;[762] LIST <CR-LF> AND BUMP PC
MOVE TB,TC ;[762]
PUSHJ PP,LSTCOD ;[762] LIST SECOND WORD
PUSHJ PP,LCRLF ;[762]
JRST CONST2 ;[762]
;ITEM IS MISCELLANEOUS
MISC: TLNE W1,ASPARN ;PARAGRAPH OR SECTION NAME?
JRST MISPRO ;YES
TLNE W1,ASTAGN ;NO--SPECIAL TAG?
JRST MISTAG ;YES
TLNE W1,ASREL ;NO--RELOC?
JRST MISREL ;YES
TLNE W1,ASENTN ;NO, ENTRY?
JRST MISPRO ;YES
TLNE W1,ASSMSC ;SPECIAL MISCELLANEOUS?
JRST MISSMC ;YES
TLNE W1,ASACS ;ALTERNATE CODE SET?
JRST MISACS ;YES
OUTSTR [ASCIZ "Bad MISC. operator
"]
JRST KILL
MISACS: SETOM ACSFLG ;SET FLAG
JRST GET ;GET INST
;SPECIAL MISCELLANEIOUS ITEMS - ASSUME THEY ARE ADDRESSES.
MISSMC: HRRZI CT,(W1) ;SEE HOW MANY THERE ARE.
MISSMH: PUSHJ PP,GETASY ;GO GET ONE.
MOVE W1,CH ;SET IT UP.
HLRZ W2,CH
PUSHJ PP,GETADR ;GO SEE WHAT TO DO WITH IT.
TSWT FNOLST ;LISTING?
PUSHJ PP,LSTADR ;YES, GO DO IT TO IT.
SOJG CT,MISSMH ;ANY MORE?
JRST GET ;NO GO GET THE NEXT ITEM.
;ITEM IS A PROCEDURE NAME
MISPRO: TSWF FNOLST; ;ANY LISTING?
JRST MISP1 ;NO
MOVE TA,TAGOUT ;ANY TAGS BEING PRINTED?
JUMPLE TA,MISP1
PUSHJ PP,LCRLF ;YES--PUT OUT <C.R.>,<L.F.>
SWON FASPAR;
SETOM TAGOUT
MISP1: MOVE DT,W1 ;GET PRODAT ENTRY
ANDI DT,77777
TLNE W1,ASENTN ;ENTRY?
JRST MISENT ;YES
ADD DT,PROLOC
MOVE CH,2(DT) ;IS THIS A SECTION?
TRNE CH,PTSECT
JRST MISP5 ;NO
;ITEM IS A PROCEDURE NAME (CONT'D)
;SECTION
TSWF FNOLST ;ANY LISTING?
JRST MISP4B ;NO
PUSHJ PP,HDROUT
PUSHJ PP,TABS3
PUSHJ PP,LSTNAM
MOVE TE,[POINT 7,[ASCIZ " SECTION"]]
PUSHJ PP,LSTMES
MOVE DT,W1 ;GET ADDRESS OF PROTAB ENTRY
ANDI DT,77777
ADD DT,PROLOC
LDB TE,PTSEGN ;GET SEGMENT NUMBER
JUMPE TE,MISP4 ;IF 0, DON'T PRINT IT
MOVEI CH," "
PUSHJ PP,PUTLST
IDIVI TE,^D10
MOVEI CH,"0"(TE)
PUSHJ PP,PUTLST
MOVEI CH,"0"(TD)
PUSHJ PP,PUTLST
MISP4: PUSHJ PP,LCRLF ;PUT OUT <C.R.>,<L.F.>
PUSHJ PP,LCRLF
SWOFF FASPAR;
MISP4B: MOVE DT,W1 ;CONVERT PRIORITY NUMBER TO DECIMAL
ANDI DT,77777
ADD DT,PROLOC
LDB TE,PTSEGN
IDIVI TE,12
LSH TE,6
ADDI TE,2020(TD)
CAMN TE,DECSEG ;SAME PRIORITY AS PREVIOUS SECTION?
JRST MISP6 ;YES
MOVEM TE,DECSEG ;NO--SAVE THIS ONE
PUSHJ PP,MISP4A ;UPDATE SECTAB POINTER
PUSHJ PP,CLRDAT ;CLEAR OUT DATGRP
PUSHJ PP,RESOVR ;PUT ENTRY IN OVERLAY TABLE
HRRZ PC,NONRES ;RESET PC
JRST MISP6
MISP4A: MOVEI TA,2
ADDB TA,CURSEC
HLRZ TB,0(TA) ;UPDATE LITBAS
ADD TB,CURREL
LDB TE,PTSEGN ;GET SEGMENT NUMBER
SKIPN TE ;SKIP IF NON-ZERO
SUB TB,INDELC ;SUBTRACT # OF INSTRUCTIONS DELETED
MOVEM TB,LITBAS
POPJ PP,
;ITEM IS AN ENTRY POINT
MISENT: ADD DT,EXTLOC ;GET ABS EXTAB ADDR
MOVE TD,PC ;PUT PC VALUE IN EXTAB ENTRY
HRRM TD,1(DT)
TSWF FNOLST ;LISTING?
JRST GET ;NO
PUSHJ PP,LCRLF
PUSHJ PP,TABS3 ;3 TABS
MOVE TE,[POINT 7,[ASCIZ "ENTRY "]]
PUSHJ PP,LSTMES
PUSHJ PP,LSTNAM
PUSHJ PP,LCRLF
PUSHJ PP,TABS3
PUSHJ PP,LSTNAM ;"ENTRY-NAME:"
MOVEI CH,":"
PUSHJ PP,PUTLST
PUSHJ PP,LCRLF
JRST GET
TABS3: MOVEI CH,11 ;PUT OUT 3 TABS
PUSHJ PP,PUTLST
PUSHJ PP,PUTLST
PJRST PUTLST
;ITEM IS A PROCEDURE NAME (CONT'D).
;ITEM IS A PARAGRAPH NAME
MISP5: TSWF FNOLST ;ANY LISTING?
JRST MISP6 ;NO
TSWTS FASPAR; ;ANY NAME OUT FOR THIS LINE?
PUSHJ PP,LCRLF ;NO--PUT OUT <C.R.>,<L.F.>
PUSHJ PP,TABS3
PUSHJ PP,LSTNAM ;PUT OUT A PARAGRAPH-NAME
MOVEI CH,":"
PUSHJ PP,PUTLST
PUSHJ PP,LCRLF
;INSURE THAT THE PROCEDURE-NAME JUST SEEN BELONGS AT THIS ADDRESS
MISP6: LDB TE,PTSEGN
SKIPN TE ;RESIDENT SEGMENT?
SKIPA TD,RESDNT ;YES
MOVE TD,NONRES ;NO
ADD TD,1(DT) ;RELOCATE THE ADDRESS
CAIN PC,(TD) ;OK?
JRST GET ;YES--RETURN
MOVE TE,[POINT 7,[ASCIZ "
******** PHASE ERROR ********
"]]
PUSHJ PP,LSTMES
MOVNI TE,4
ADDB TE,PAGCNT
SKIPG TE
PUSHJ PP,HDROUT
AOS GAERAS
JRST GET
;ITEM IS MISCELLANEOUS (CONT'D)
;SPECIAL TAG
MISTAG: TSWF FNOLST; ;YES--ANY LISTING?
JRST GET ;NO--FORGET IT
SKIPN OPTSW## ;/OPTIMIZE?
JRST MSTAG1 ;NO-- ALL TAGS ARE OK
SKIPN TAGOUT ;SKIP IF NO TAG FOR THIS LINE YET
JRST TAGDEL ; WE WON'T EVER PRINT MORE THAN 1 NOW
HRRZ TC,W1
ANDI TC,77777 ;GET TAG NUMBER
ADD TC,TAGLOC##
LDB TB,[POINT 15,(TC),17] ;GET REF COUNT
JUMPN TB,OKTAG ;DON'T PRINT TAGS THAT AREN'T REFERENCED
TAGDEL: AOS TAGDLC## ;REMEMBER WE "DELETED" A TAG
JRST GET
OKTAG: MOVE TB,(TC) ;GET ENTRY
TLNE TB,(1B0) ;SAME AS %TAG OR PARAGRAPH?
JRST GET ;YES- DON'T WORRY ABOUT IT
MSTAG1: AOSE TA,TAGOUT ;ALREADY ONE FOR THIS LINE?
JRST MSTAG2 ;YES
MOVEM W1,SAVTAG ;NO--SAVE THIS ONE
JRST GET
MSTAG2: CAIE TA,1 ;ANY TAG BEING SAVED?
JRST MSTAG3 ;NO
TSWT FASPAR; ;ANY PARAGRAPH-NAME FOR THIS LINE?
PUSHJ PP,LCRLF ;NO--PUT OUT <C.R.>
PUSHJ PP,TABS3
MOVE TC,SAVTAG ;PRINT THE TAG
PUSHJ PP,MSTAG4
MSTAG3: MOVEI CH," " ;PRINT A SPACE
PUSHJ PP,PUTLST
MOVE TC,W1 ;PRINT THIS TAG
PUSHJ PP,MSTAG4
JRST GET
MSTAG4: MOVEI CH,"%"
PUSHJ PP,PUTLST
ANDI TC,77777
PUSHJ PP,LSINC5
MOVEI CH,":"
PUSHJ PP,PUTLST
MOVE TE,TAGOUT ;IS PRINT-LINE FULL OF TAGS?
CAIE TE,^D11
CPOPJ: POPJ PP,
SWON FASPAR; ;YES--SET "PARAGRAPH NAME PRINTED"
SETOM TAGOUT ;SET "NO TAGS"
JRST LCRLF
;ITEM IS MISCELLANEOUS (CONT'D)
;RELOC
MISREL: TLNN W1,1 ;ANY INCREMENT?
TDCA CH,CH ;NO--USE ZERO
PUSHJ PP,GETASY ;YES--GET IT
HRRZ W2,CH
PUSHJ PP,GETADR ;ASSEMBLE ADDRESS INTO RH OF TB
ANDI W1,7B20 ;WAS THAT A FILE TABLE?
CAIN W1,4B20
SUBI TB,SZ.DEV ;YES--DEDUCT SIZE OF DEVICE TABLE
TSWF FASSEG ;OVERLAY SEGMENT?
CAIN PC,(TB) ;YES--IS PC ACTUALLY BEING CHANGED?
JRST MISRL5 ;YES--TROUBLE
MOVEI TE,[POINT 7,[ASCIZ "
****** IMPROPER RELOC ******
"]]
PUSHJ PP,LSTMES
MOVNI TE,3
ADDM TE,PAGCNT
AOS GAERAS
JRST GET
MISRL5: TSWF FASSEG ;IS THIS AN OVERLAY SEGMENT?
JRST MISRL6 ;YES
PUSHJ PP,CLRDAT ;NO--CLEAR DATGRP
HRRZ PC,TB
MOVEM PC,DATGRP+2
MISRL6: TSWF FNOLST ;ANY LISTING?
JRST GET
PUSHJ PP,LCRLF
CAIE W1,7B20 ;WAS THAT A MISCELLANEOUS REFERENCE?
JRST GET ;NO--RETURN
CAIN W2,3B20 ;YES--LITERAL BASE?
JRST MISRL8 ;YES
CAIE W2,1B20 ;NO--IMPURE BASE?
JRST GET ;NO--RETURN
;ITEM IS MISCELLANEOUS (CONT'D)
;RELOC (CONT'D)
;SPECIAL RELOC--PRINT OUT A TAG
MOVE CH,[RADIX50 10,%TEMP]
MOVEI TA,2*FIXNUM
PUSHJ PP,PUTSYM ;PUT OUT LOCAL SYMBOL
MOVE TA,[SIXBIT "%PARAM"] ;PRINT OUT "%PARAM" AS A TAG
JRST MISRL9
MISRL8: MOVEI CH,HDROUT
MOVE TA,PAGCNT
CAIL TA,^D30
MOVEI CH,LCRLF
PUSHJ PP,(CH)
MOVE TA,[SIXBIT "%LIT"] ;PRINT OUT "%LITNN" AS A TAG
IOR TA,DECSEG
MISRL9: PUSH PP,TA ;SAVE SYMBOL
PUSHJ PP,TABS3
PUSHJ PP,SIXOUT
MOVEI CH,":"
PUSHJ PP,PUTLST
SWON FASPAR!FRELOC
PUSHJ PP,LCRLF
POP PP,TC ;GET SYMBOL BACK
PUSHJ PP,RADX50
ADD CH,[<RADIX50 10,>+<1*50*50*50*50*50>]
MOVE TA,PC
PUSHJ PP,PUTSYM ;OUTPUT AS LOCAL SYMBOL
JRST GET
;END OF ASSEMBLY
ENDASY: PUSHJ PP,CLRDAT ;CLEAR OUT DATGRP
TSWT FASSEG ;HAVE WE DONE ANY NON-RESIDENT SEGMENTS?
JRST NDASY2 ;NO
PUSHJ PP,CLROVR ;YES--CLEAR OUT OVERLAY TABLE
JRST NDASY3
NDASY2: PUSHJ PP,EXTOUT ;WRITE OUT EXTERNAL REQUESTS
PUSHJ PP,ENDBLK ;PUT OUT END BLOCK
NDASY3: MOVE OP,HILOC
TSWF FREENT ;RE-ENTRANT PROGRAM?
JRST [ADD OP,HPLOC ;YES, ADD HIGH SEG SIZE
SUBI OP,400000 ; (JUST GET TOTAL SIZE)
JRST .+1]
SUB OP,OBJSIZ ;MAX MEMORY WE CAN USE
JUMPLE OP,NDASY4 ;JUMP IF OK
OUTSTR [ASCIZ/%MEMORY SIZE exceeded in object program
/] ;PRINT WARNING TO USER
NDASY4: TSWF FNOLST ;ANY LISTING?
JRST NDASY0 ;NO
MOVE TE,[POINT 7,[ASCIZ "
END"]]
PUSHJ PP,LSTMES
MOVE TE,[POINT 7,[ASCIZ " START."]]
SKIPN SLASHJ ;FORCE START ADDR?
SKIPN SUBPRG ;NO, MAIN PROGRAM?
PUSHJ PP,LSTMES ;YES, LIST "END START."
PUSHJ PP,LCRLF
PUSHJ PP,PBREAK ;PRINT OUT PROGRAM BREAK
SKIPE OPTSW## ;SKIP IF OPTIMIZER NOT CALLED
PUSHJ PP,OPTSUM ; IT WAS-- GO PRINT SUMMARY
NDASY0: SKIPE LSTDEV
SWOFF FNOLST;
PUSHJ PP,CNTOUT
SKIPLE GAERAS ;ANY ASSEMBLY ERRORS?
PUSHJ PP,NDASY5
IFE DEBUG!FT68274,<
TSWF FFATAL ;IN STANDARD VERSION, IF FATAL
CLOSE BIN,$CLS40 ; ERROR, DISCARD NEW REL, KEEP OLD
>
RELEASE BIN, ;THROW AWAY BIN DEVICE
SKIPE CREFSW ;IF '/C',
PUSHJ PP,CREF ; PUT OUT CREF LISTING
IFN DEBUG,<
IFE FT68274,<
PUSHJ PP,SUMARY
>>
MOVEI CH,14
PUSHJ PP,PUTLST
RELEASE LST,
IFN DEBUG,< EXTERNAL KILL,KILLF,%KILLG,%KILFG,CORESW
MOVE TA,CORESW
TLNE TA,%KILLG
JRST KILL
TLNE TA,%KILFG
JRST KILLF
>
;DELETE ALL SCRATCH FILES AND RELEASE I/O CHANNELS, THEN RESTART COMPILATION
MOVE I0,[RENAME FSC,I1]
MOVSI TA,(CLOSE FSC,)
MOVSI TB,(RELEASE FSC,)
NDASY1: CAME I0,[RENAME LIT,I1]
JRST NDAS1A
SKIPGE LITBLK
JRST NDAS1B
NDAS1A: CAME I0,[RENAME CRF,I1]
JRST NDAS1C
SKIPN CREFSW
JRST NDAS1B
NDAS1C: SETZB I1,I2
SETZB I3,I4
XCT TA
XCT I0
JFCL ;IGNORE ERRORS
XCT TB
NDAS1B: CAMN I0,[RENAME LSC,I1]
JRST RESTRT
ADD I0,[1B12]
ADD TA,[1B12]
ADD TB,[1B12]
JRST NDASY1
NDASY5: SWON FFATAL ;[653] TURN ON FATAL ERRORS SEEN
PUSHJ PP,PUTQRY
MOVE TE,GAERAS
MOVE TA,[POINT 7,[ASCIZ " ASSEMBLY ERROR"]]
PUSHJ PP,CNTO4 ;PUT OUT "N ASSEMBLY ERROR(S)"
MOVE TA,[POINT 7,[ASCIZ ": *** COMPILER BUG! ***"]]
PUSHJ PP,CNTO6 ;PRINT TEXT TO LET USER KNOW IT'S A
; REAL COMPILER BUG
TSWT FLTTY;
OUTSTR [ASCIZ "
"]
JRST LCRLF ;CRLF TO LISTING
;TYPE OUT "?" AND BUMP JOBERR
PUTQRY: MOVE TE,[POINT 7,[ASCIZ "
?"]]
TSWF FLTTY ;LISTING ON TTY?
JRST PUTQR2 ;YES
OUTSTR (TE) ;NO
PUTQR1: AOS TD,.JBERR##
TRNN TD,-1
SOS .JBERR
POPJ PP,
PUTQR2: PUSHJ PP,LSTMES
SOS PAGCNT
JRST PUTQR1
;PUT OUT MESSAGE FOR NUMBER OF ERRORS
CNTOUT: PUSHJ PP,TTYON## ; TURN ON TTY TO GET SUMMARY LINE [266]
PUSHJ PP,LCRLF
PUSHJ PP,LCRLF
SKIPE FTOOBG## ;LOW SEG SIZE TOO BIG?
PUSHJ PP,CNTOU1 ;YES, COMPLAIN ABOUT IT
SKIPE COUNTF ;ANY FATAL ERRORS?
PUSHJ PP,PUTQRY ;YES--TYPE "?"
MOVE TD,COUNTW ;ANY ERRORS
ADD TD,COUNTF ; AT ALL?
JUMPE TD,CNTO2
MOVE TE,COUNTF
MOVE TA,[POINT 7,[ASCIZ " Fatal Error"]]
PUSHJ PP,CNTO3
MOVE TA,[POINT 7,[ASCIZ ", "]]
PUSHJ PP,CNTO6
MOVE TE,COUNTW
MOVE TA,[POINT 7,[ASCIZ " Warning"]]
CNTO1: PUSHJ PP,CNTO3
IFN ANS74,<
SKIPE FLGSW## ;DID USER ASK FOR FLAGGER?
PUSHJ PP,CNTFV ;YES, RECORD VIOLATIONS
>
TSWT FLTTY;
OUTSTR [ASCIZ "
"]
IFN ANS74,<
SKIPE FLGSW## ;DID USER ASK FOR FLAGGER?
JRST FLCRLF ;YES
>
JRST LCRLF ;NO
CNTO2: MOVE TE,[POINT 7,[ASCIZ "No Errors Detected"]]
PUSHJ PP,LSTMES
IFN ANS74,<
SKIPN FLGSW## ;DID USER ASK FOR FLAGGER?
JRST LCRLF ;NO
MOVE TE,[POINT 7,[ASCIZ ", "]]
PUSHJ PP,LSTMES ;ON LISTING ONLY
PUSHJ PP,CNTFV1 ;RECORD VIOLATIONS
INTERN FLCRLF
FLCRLF: PUSHJ PP,LCRLF
MOVE TE,[POINT 7,[ASCIZ /Flagging requested /]]
PUSHJ PP,LSTMES
SKIPL TA,FLGSW ;GET FLAGGING REQUESTED
JRST FLG1 ;NORMAL CASE
SETCM TA,FLGSW ;FLAG EXCEPTIONS TO
MOVE TE,[POINT 7,[ASCIZ /for /]]
PUSHJ PP,LSTMES
SETO TE, ;FIPS LEVELS ARE SPECIAL
TRZE TA,%LV.H ; AS WE ONLY PRINT THE LOWEST
MOVEI TE,^D35-^L<%LV.H>
TRZE TA,%LV.HI
MOVEI TE,^D35-^L<%LV.HI>
TRZE TA,%LV.LI
MOVEI TE,^D35-^L<%LV.LI>
TRZE TA,%LV.L
MOVEI TE,^D35-^L<%LV.L>
JRST FLG7 ;COMMON CODE
FLG1: MOVE TE,[POINT 7,[ASCIZ /at /]]
PUSHJ PP,LSTMES
SETO TE, ;FIPS LEVELS ARE SPECIAL
TRZE TA,%LV.L ; AS WE ONLY PRINT THE HIGHEST
MOVEI TE,^D35-^L<%LV.L>
TRZE TA,%LV.LI
MOVEI TE,^D35-^L<%LV.LI>
TRZE TA,%LV.HI
MOVEI TE,^D35-^L<%LV.HI>
TRZE TA,%LV.H
MOVEI TE,^D35-^L<%LV.H>
FLG7: JUMPL TE,FLG3 ;NO FIPS LEVELS
MOVE TE,FIPTBL##(TE) ;GET BYTE POINTER
PUSHJ PP,LSTMES
JUMPE TA,LCRLF ;NOTHING LEFT TO DO?
FLG2: SKIPL FLGSW ;SEE WHICH SEPATATOR TO USE
SKIPA TE,[POINT 7,[ASCIZ / + /]]
MOVE TE,[POINT 7,[ASCIZ /, /]]
PUSHJ PP,LSTMES
FLG3: SETZ TE,0
MOVEI TD,1 ;INITIALIZE LOOP
FLG4: TDZE TA,TD ;SEE IF WE HAVE FOUND THE BIT
JRST FLG5 ;YES
LSH TD,1 ;NO
AOJA TE,FLG4 ;TRY NEXT BIT
FLG5: MOVE TE,FIPTBL(TE) ;GET MESSAGE
PUSHJ PP,LSTMES
JUMPN TA,FLG2 ;LOOP IF STILL MORE
>
JRST LCRLF
;NUMBER OF ERRORS IS IN TE, TA HAS BYTE-POINTER TO TEXT
CNTO3: JUMPN TE,CNTO4 ;IS NUMBER ZERO?
MOVEI CH,"N" ;YES--
PUSHJ PP,CNTO10 ; TYPE
MOVEI CH,"o" ; AND PRINT
PUSHJ PP,CNTO10 ; 'NO'
SKIPA
CNTO4: PUSHJ PP,CNTO9
PUSHJ PP,CNTO6
CAIN TE,1
POPJ PP,
MOVEI CH,"s"
JRST CNTO10
;PUT OUT ERROR MESSAGE (CONT'D)
;PUT OUT TEXT
CNTO6: TSWT FLTTY;
OUTSTR (TA)
CNTO7: ILDB CH,TA
JUMPE CH,CPOPJ
PUSHJ PP,PUTLST
JRST CNTO7
;PUT OUT NUMBER
CNTO9: MOVE TD,TE
CNTO9A: IDIVI TD,^D10
HRLM TC,(PP)
SKIPE TD
PUSHJ PP,CNTO9A
HLRZ CH,(PP)
ADDI CH,"0"
CNTO10: TSWT FLTTY;
OUTCHR CH
JRST PUTLST
IFN ANS74,<
CNTFV: MOVE TA,[POINT 7,[ASCIZ ", "]]
PUSHJ PP,CNTO6
CNTFV1: SKIPN TE,COUNTV## ;ANY VIOLATIONS?
JRST CNTFV2 ;NO
MOVE TA,[POINT 7,[ASCIZ " Flagger Violation"]]
JRST CNTO3 ;PRINT MESSAGE AND RETURN
CNTFV2: MOVE TE,[POINT 7,[ASCIZ "No Flagger Violations Detected"]]
JRST LSTMES ;GIVE MESSAGE AND RETURN
>
;PRINT OUT ERROR MESSAGE FOR LOW SEG SIZE EXCEEDED
CNTOU1: PUSHJ PP,PUTQRY ;PRINT "?"
SWON FFATAL; ; SO .REL FILE GETS DISCARDED
MOVE TE,[POINT 7,[ASCIZ/Maximum low segment size exceeded in object program
/]]
TSWT FLTTY ;UNLESS LISTING GOING THERE,
OUTSTR (TE) ; TYPE ON TTY
PJRST LSTMES ;PRINT MESSAGE AND RETURN
;PRINT OUT THE PROGRAM BREAK
PBREAK: MOVE OP,HILOC
TSWF FREENT ;RE-ENTRANT PROGRAM?
JRST PBRAK1 ;YES
MOVE TE,[POINT 7,[ASCIZ "
Program break is "]]
JRST PBRAK2
PBRAK1: MOVE TE,[POINT 7,[ASCIZ "
High segment break is "]]
PUSHJ PP,LSTMES
HRRZ TA,HPLOC
ADD OP,HPLOC
SUBI OP,400000
PUSHJ PP,LSCOD4
MOVE TE,[POINT 7,[ASCIZ "
Low segment break is "]]
PBRAK2: PUSHJ PP,LSTMES
HRRZ TA,HILOC
PUSHJ PP,LSCOD4
SUB OP,OBJSIZ
JUMPLE OP,LCRLF
MOVE TE,[POINT 7,[ASCIZ "
'MEMORY SIZE' EXCEEDED BY "]]
PUSHJ PP,LSTMES
MOVE TA,OP
PUSHJ PP,LSINC2
JRST LCRLF
;PRINT OPTIMIZER RESULTS
OPTSUM: MOVE TE,[POINT 7,[ASCIZ "
Optimizer summery:
Number of instructions deleted: "]]
PUSHJ PP,LSTMES
MOVE TE,INDELC##
PUSHJ PP,PRTDEC ;PRINT # INSTRUCTIONS DELETED
MOVE TE,[POINT 7,[ASCIZ "
Number of tags deleted: "]]
PUSHJ PP,LSTMES
MOVE TE,TAGDLC##
PUSHJ PP,PRTDEC ;PRINT # TAGS DELETED
PJRST LCRLF ;PRINT CRLF, THEN RETURN
;PRINT A NUMBER
PRTDEC: SKIPA TC,[^D10] ;BASE 10
PRTOCT: MOVEI TC,8 ;BASE 8
PRTBAS: IDIV TE,TC
PUSH PP,TD
SKIPE TE
PUSHJ PP,PRTBAS
POP PP,CH
ADDI CH,"0"
PJRST PUTLST ;PRINT DIGIT, RECURSE
;PUT OUT A DATA WORD ONTO BINFIL
;ENTER WITH DATA WORD IN TB, RELOCATION BITS IN TA
PUTDAT: SKIPN BINDEV ;ANY BINARY FILE?
POPJ PP, ;NO--RETURN
IDPB TA,RB ;PUT AWAY RELOCATION
MOVEM TB,(GP) ;PUT WORD IN NEXT SLOT
AOS DATGRP ;KICK UP ITEM COUNT
CAIN TA,1B33 ;EXTERNAL?
TRNN W2,-1 ;AND OFFSET
JRST PDAT0 ;NO
HRRZ CH,W1
IFN BIS,<
CAIN CH,E0.6## ;E0.6
MOVE CH,[RADIX50 60,E0.6]
CAIN CH,E0.7## ;E0.7
MOVE CH,[RADIX50 60,E0.7]
CAIN CH,E0.9## ;E0.9
MOVE CH,[RADIX50 60,E0.9]
>
TLNN CH,-1 ;DID WE GET A VALID EXTERNAL?
JRST PDAT0 ;NO
PUSH PP,CH ;YES
PUSHJ PP,CLRDAT ;YES, DUMP BLOCK
MOVE CH,[2,,2] ;NEED SYMBOL FIXUP
PUSHJ PP,PUTBIN
MOVSI CH,(1B3) ;RHS RELOC
PUSHJ PP,PUTBIN
POP PP,CH
PUSHJ PP,PUTBIN
MOVSI CH,400000 ;RHS FIXUP
HRR CH,PC
JRST PUTBIN
PDAT0: AOBJN GP,PDAT3 ;BLOCK FULL YET?
TSWF FASSEG ;ARE WE IN OVERLAY SEGMENT?
JRST PDAT5 ;YES
MOVEI TD,^D17 ;NO
MOVE TE,[XWD -^D20,DATGRP] ;WRITE IT OUT
PDAT1: AOS DATGRP
PDAT2: MOVE CH,(TE)
PUSHJ PP,PUTBIN
AOBJN TE,PDAT2
ADDM TD,DATGRP+2
PDATI: TSWF FASSEG ;OVERLAY SEGMENT?
JRST PDAT7 ;YES--USE OTHER ROUTINE
MOVSI TE,1B19 ;RELOCATION FOR PC
MOVEM TE,DATGRP+1
HRLZ TE,BLKTYP
MOVEM TE,DATGRP
MOVE GP,[XWD -^D17,DATGRP+3] ;RESET POINTER
MOVE RB,[POINT 2,DATGRP+1,1] ;RESET RELOCATION BYTE POINTER
PDAT3: POPJ PP, ;RETURN
;WRITE OUT ANY ENTRIES IN GRPDAT
CLRDAT: SKIPN BINDEV ;FORGET THE WHOLE THING IF
POPJ PP, ; NO BINARY BEING WRITTEN
HRRZ TE,DATGRP
SKIPN TE ;ANYTHING IN GRPDAT?
JRST PDATI
MOVEI TD,(TE)
MOVNI TE,3(TE)
MOVSS TE
HRRI TE,DATGRP
TSWT FASSEG;
JRST PDAT1
ADD TE,[XWD 2,1]
JRST PDAT6
;WRITE OUT 18 WORDS OF OVERLAY BINARY
PDAT5: MOVE TE,[XWD -^D19,DATGRP+1]
PDAT6: MOVE CH,(TE)
PUSHJ PP,PUTBIN
AOS OVRWRD
AOBJN TE,PDAT6
PDAT7: SETZM DATGRP+1
SETZM DATGRP
MOVE GP,[XWD -^D18,DATGRP+2]
MOVE RB,[POINT 2,DATGRP+1]
POPJ PP,
;WRITE OUT A SYMBOL DEFINITION
;ENTER WITH SYMBOL (IN RADIX 50) IN CH; VALUE IN TA
PUTSYM: SKIPN OVRWRD ;DON'T PUT SYMBOLS IN OVERLAY FILE
SKIPN BINDEV
POPJ PP,
MOVE TE,SYMLC1
MOVEM CH,0(TE)
MOVEM TA,1(TE)
TSWT FRELOC ;IF NOT RELOCATABLE,
TDCA TE,TE ; USE 0,
MOVEI TE,1 ; ELSE USE 1
IDPB TE,SYMREL
MOVEI TE,2
ADDM TE,SYMLC1
ADDM TE,SYMGRP
MOVE TE,SYMREL
TLNE TE,770000
POPJ PP,
MOVE TE,[XWD -^D20,SYMGRP]
PSYM1: MOVE CH,0(TE)
PUSHJ PP,PUTBIN
AOBJN TE,PSYM1
PSYMI: MOVSI TE,2
MOVEM TE,SYMGRP
SETZM SYMGRP+1
MOVEI TE,SYMGRP+2
MOVEM TE,SYMLC1
MOVE TE,[POINT 4,SYMGRP+1]
MOVEM TE,SYMREL
POPJ PP,
;CLEAR OUT SYMGRP
CLRSYM: HRRZ TE,SYMGRP
SKIPE BINDEV
SKIPN TE
POPJ PP,
ADDI TE,2
MOVNS TE
MOVSS TE
HRRI TE,SYMGRP
JRST PSYM1
;ITEM IS INSTRUCTION
GETOPR: LDB OP,ASOP ;PICK UP OPERATOR
CAIE OP,ENDIT ;END OF INPUT?
JRST GETOP1
LDB TE,ASAC ;MAYBE--IS AC=17?
CAIN TE,17
JRST ENDASY ;YES
GETOP1:
CAIL OP,FSTUUO ;IS THIS A UUO??
JRST [OUTSTR [ASCIZ '?Phase G UUO conversion error
']
SWON FFATAL ;FATAL ERROR SWITCH
SETZI OP, ;ZERO OP
JRST .+1 ]
LSH OP,1
ADDI OP,OPTABL
SKIPE ACSFLG## ;ALTERNATE CODE SET?
ADDI OP,OP2TAB-OPTABL ;YES
MOVE TD,(OP) ;PICK UP PDP-10 OP-CODE
DPB TD,[POINT 9,TB,8] ;PUT IT INTO TB
SWOFF FGDEC!FGNEG ;TURN OFF FLAGS
TLNE TD,1 ;ARE DECIMAL ADDRESSES ALLOWED?
SWON FGDEC ;YES
TLNE TD,2 ;ALLOWED TO PRINT AS NEGATIVE IF LARGE?
SWON FGNEG ;YES
PUSHJ PP,GETADR ;GET ADDRESS IN RH OF TB
JRST PUTDAT ;PUT OUT ASSEMBLED WORD AND RETURN
;LIST A PDP-10 INSTRUCTION
LSTOPR: PUSHJ PP,LSTCOD ;LIST CONTENTS OF TB & ANY TAG
MOVE TA,(OP) ;GET FLAGS
TLNE TA,(1B2) ;NEED TO INDENT?
PUSHJ PP,LST2SP ;YES, LIST 2 SPACES
MOVE TA,1(OP) ;GET MNEMONICS FOR OPERATOR
CAMN TA,[SIXBIT /PUSHJ/] ;PUSHJ CAN BE SPECIAL
PUSHJ PP,INDCHK ;CHECK FOR INDENTING
PUSHJ PP,SIXOUT ;PRINT IT OUT
MOVEI CH,11
PUSHJ PP,PUTLST
SKIPL 0(OP) ;SHOULD WE PRINT AC?
TLNE W1,(17B12) ;ONLY IF NOT ZERO
TRNA ;YES
JRST LOPR1
MOVEI CH,"1" ;YES
TLNE W1,400 ;IS IT > 7?
PUSHJ PP,PUTLST ;YES--PRINT A 1
LDB CH,[POINT 3,W1,12] ;PRINT LOW-ORDER DIGIT
ADDI CH,"0"
PUSHJ PP,PUTLST
MOVEI CH,","
PUSHJ PP,PUTLST
LOPR1: MOVEI CH,"@"
TLNE W1,20 ;IS INDIRECT BIT ON?
PUSHJ PP,PUTLST ;YES--PUT OUT "@"
TDNE W1,[17,,-1] ;ADDRESS AND (XR) BOTH 0?
JRST LOPR2 ;YES
JUMPN W2,LOPR2 ;INCREMENT NON-ZERO
MOVE DT,(OP) ;GET FLAGS
TLNE DT,(1B1) ;DO WE PRINT ZERO ADDRESSES
LOPR2: PUSHJ PP,LSTADR ;LIST ADDRESS
TLNE W1,17 ;ANY INDEX?
PUSHJ PP,PUTXR
JRST LCRLF ;NO--END OF LINE
INDCHK: HRRZ CH,W1 ;GET ADDRESS
CAIE CH,C.TRCE##
CAIN CH,WRITE%##
SETOM INDFLG ;FOLLOWED BY INDENTED XWD
POPJ PP,
;LIST A BYTE POINTER
LSTBYT: PUSHJ PP,LSTCOD ;LIST CONTENTS OF TB & ANY TAG
MOVE TA,[SIXBIT "POINT"]
PUSHJ PP,SIXOUT
MOVEI CH,11
PUSHJ PP,PUTLST
LDB TE,[POINT 6,TB,11] ;PUT OUT BYTE SIZE
PUSHJ PP,DECIT
MOVEI CH,","
PUSHJ PP,PUTLST
MOVEI CH,"@" ;PUT OUT ANY INDIRECT
TLNE TB,20
PUSHJ PP,PUTLST
PUSHJ PP,LSTADR ;LIST ADDRESS
HLL W1,TB ;INCASE INDEX
TLNE TB,17 ;ANY INDEX?
PUSHJ PP,PUTXR ;YES--LIST IT
LDB TD,[POINT 6,TB,5] ;GET RESIDUE
CAIN TD,^D36 ;IS IT 36?
JRST LCRLF ;YES--DONE
MOVEI CH,"," ;NO--LIST IT
PUSHJ PP,PUTLST
MOVEI TE,^D35
SUB TE,TD
PUSHJ PP,DECIT
JRST LCRLF
;LIST AN XWD
LSTXWD: PUSH PP,TC ;SAVE SECOND WORD
PUSHJ PP,LSTCOD ;LIST ASSEMBLED WORD AND ANY TAG
SKIPE INDFLG ;NEED TO INDENT?
PUSHJ PP,LST2SP ;YES
MOVSI TA,'XWD'
PUSHJ PP,SIXOUT
MOVEI CH,11
PUSHJ PP,PUTLST
HLRZ W2,W1 ;LIST LEFT-HALF
PUSHJ PP,LSTADR
MOVEI CH,"," ;PUT OUT COMMA
PUSHJ PP,PUTLST
POP PP,W1 ;GET BACK SECOND WORD
HLRZ W2,W1 ;LIST RIGHT-HALF
PUSHJ PP,LSTADR
JRST LCRLF ;PUT OUT <C.R.>,<L.F.> AND RETURN
;LIST 2 SPACES
LST2SP: MOVEI CH," "
PUSHJ PP,PUTLST
MOVEI CH," "
PJRST PUTLST
;LIST ADDRESS
;LIST THE OPERAND IN THE ADDRESS
LSTADR: MOVE DT,W1
ANDI DT,77777
LDB TD,ADRTYP
XCT ADRTB2(TD)
PUSHJ PP,LSTNAM
SWOFF FASEXT;
TRNE W2,700000
POPJ PP,
JRST LSTINC
;LIST ADDRESSES (CONT'D)
;EXTERNAL NAME
LSTEXT: ADD DT,EXTLOC
TSWF FASSEG ;ARE WE IN OVERLAY SEG?
JRST LSTEX1 ;YES
TLNE TB,(Z @0) ;IF INDIRECT BIT IS OFF,
TSWF FREENT ; OR PROGRAM IS RE-ENTRANT,
JRST LSTEX2 ; PRINT IN A NORMAL WAY
LSTEX1: HRRZ TA,TB
PUSHJ PP,LSINC2
MOVE TE,[POINT 7,[ASCIZ " ;"]]
PUSHJ PP,LSTMES
PUSHJ PP,LSTNAM
TSWF FREENT ;[151-SB]DON'T DO THIS IF REENT
POPJ PP,
TSWF FASSEG;
SKIPGE TE,1(DT) ;TABLE ENTRY = FULL-WORD -1?
;(NOT SURE THIS EVER HAPPENS)
POPJ PP,
CAIN TE,-1 ;RH ENTRY = -1?
POPJ PP,
AOS GAERAS
MOVE TE,[POINT 7,[ASCIZ " ******NO FLAG IN EXTAB******"]]
JRST LSTMES
LSTEX2: SWON FASEXT ;NO
PUSHJ PP,LSTNAM
SWOFF FASEXT;
MOVE TE,W1
ANDI TE,77777
ADD TE,EXTLOC
LOAD TE,EXENT,(TE)
JUMPN TE,LSTEX3 ;DON'T ADD ## IF ENTRY POINT
MOVEI CH,"#"
PUSHJ PP,PUTLST
MOVEI CH,"#"
PUSHJ PP,PUTLST
LSTEX3: TRNN W2,700000
JRST LSTINC
POPJ PP,
;LIST ADDRESSES (CONT'D).
;CONSTANT > 77777
LSTCON: HRRZ TA,W2
TSWT FGNEG ;COULD IT BE NEGATIVE?
JRST LSCONX ;NO
HRRES TA ;EXTEND SIGN
JUMPGE TA,LSCONX ;ITS NOT
MOVMS TA ;GET MAGNITUDE
MOVEI CH,"-"
PUSHJ PP,PUTLST
JRST LSCONX
;CONSTANT < 100000
LSCON1: HRRZ TA,W1
ANDI TE,77777
LSCONX: TSWT FGDEC; ;ARE WE ALLOWED TO PRINT IN DECIMAL?
JRST LSINC2 ;NO
JRST LSINC4 ;YES--USE DECIMAL
;SPECIAL TAG
LSTTAG: MOVE TC,W1
LSTTG1: ANDI TC,77777
HRRZ TE,TC
ADD TE,TAGLOC##
MOVE TE,(TE)
TRC TE,AS.PRO ;IF SAME AS A PARAGRAPH NAME,
TRNN TE,700000
JRST LSTPNM ;LIST IT INSTEAD
TLNN TE,(1B0) ;INDIRECTING?
JRST LSTTG2 ;NO
HRRZ TC,TE ;YES-GET NEW TAG #
JRST LSTTG1 ;HANDLE MORE LEVELS OF INDIRECTING
LSTTG2: MOVEI CH,"%"
PUSHJ PP,PUTLST
PUSHJ PP,LSINC5 ;LIST CONTENTS OF TC = TAG #
JRST LSTINC ;AND CONTENTS OF W2 = INCREMENT (IF NOT ZERO)
LSTPNM: HRRZ DT,TE
ADD DT,PROLOC
PUSHJ PP,LSTNAM ;LIST THE NAME
JRST LSTINC ;LIST INCREMENT IF ANY, RETURN
;MISCELLANEOUS
LSTMIS: LDB TD, MSC.CL## ;SEE WHICH CLASS IT IS.
JRST @LMSTBL(TD) ;DISPATCH TO THE APPROPRIATE ROUTINE.
LMSTBL: EXP LODMSC
EXP LMSCL1
EXP LMSCL2 ;NEG. INCREMENT
LODMSC: LDB TD,INCTYP
ANDI W2,77777
XCT INCTB2(TD)
LODMS5: PUSHJ PP,SIXOUT
JRST LSTINC
;NEGATIVE INCREMENT
LMSCL2: LDB TD,INCTYP
XCT INCTB2(TD)
PUSHJ PP,SIXOUT
MOVEI CH,"-"
PUSHJ PP,PUTLST
MOVE TA,W2
JRST LSINC1
LMSCL1: HLR TE, MSCTB1(W2) ;SELECT A ROUTINE.
JRST (TE) ;DISPATCH.
LBASAD: TSWT FREENT; ;REENTRANT?
SKIPA TA, [SIXBIT "%FILES"] ;NO.
MOVE TA, [SIXBIT "START."] ;YES.
PJRST SIXOUT
;INCREMENT TO LITERAL POOL
INCLIT: MOVE TA,[SIXBIT "%LIT"]
IOR TA,DECSEG
POPJ PP,
;INCREMENT TO DATA DIVISION
INCDAT: HRRZ TA,W2
JRST LSINC1
;LIST ANY INCREMENT (IN W2) IN OCTAL
LSTINC: TLNE W2,-1 ;ANYTHING IN LH?
JRST LSTINA ;YES--COULD BE INCREMENT OR JUNK
MOVE TA,W2
TRNN TA,77777
POPJ PP,
MOVEI CH,"+"
PUSHJ PP,PUTLST
LSINC1: ANDI TA,77777
LSINC2: MOVE TD,[POINT 3,TA,17] ;NO
ILDB CH,TD
TLNE TD,770000
JUMPE CH,.-2
LSINC3: ADDI CH,"0"
PUSHJ PP,PUTLST
TLNN TD,770000
POPJ PP,
ILDB CH,TD
JRST LSINC3
;LH(W2) WAS NON-ZERO
LSTINA: TRNE W2,-1 ;RH BETTER BE 0 THEN
JRST BADINC ;NOPE--BAD INCREMENT
HLRE TA,W2
SKIPGE TA ;SKIP IF POSITIVE
JRST LSTINB ;NO
MOVEI CH,"+"
PUSHJ PP,PUTLST
JRST LSINC1
LSTINB: MOVE TE,[POINT 7,[ASCIZ/ - /]]
PUSHJ PP,LSTMES ;SPACES AROUND MINUS SIGN
; TO DISTIGUISH INCREMENT FROM DATANAME
MOVM TA,TA ;GET NUMBER TO PRINT
JRST LSINC1
;LIST ANY INCREMENT IN DECIMAL
LSINC4: HRRZ TC,TA
CAIG TC,7
JRST LSINC5
MOVEI CH,"^"
PUSHJ PP,PUTLST
MOVEI CH,"D"
PUSHJ PP,PUTLST
;ENTER HERE FROM LSTTAG
LSINC5: PUSH PP,TB ;SAVE ANY ASSEMBLED WORD
HRRZI TA,0
LSINC6: IDIVI TC,^D10
ADDI TB,20
LSHC TB,-6
JUMPN TC,LSINC6
PUSHJ PP,SIXOUT ;PRINT THE NUMBER
POP PP,TB ;RESTORE THE ASSEMBLED WORD
POPJ PP,
;LIST INDEX
PUTXR: MOVEI CH,"("
PUSHJ PP,PUTLST
MOVEI CH,"1"
TLNE W1,10 ;IS INDEX > 7?
PUSHJ PP,PUTLST ;YES--PUT OUT THE "1"
LDB CH,[POINT 3,W1,17]
ADDI CH,"0"
PUSHJ PP,PUTLST
MOVEI CH,")"
JRST PUTLST ;PUT OUT PAREN AND RETURN
;LIST A NAMTAB ENTRY
;ENTER WITH RH OF DT CONTAINING THE ADDRESS OF A TABLE ENTRY.
LSTNAM: HLRZ TA,0(DT)
ANDI TA,LMASKB
MOVEI TE,0
JUMPE TA,LSNAM1 ;ZERO ENTRY?
ADD TA,NAMLOC ;NO--GET NAMTAB ADDRESS
HRRZ TD,NAMNXT ;IS IT OUT OF NAMTAB?
CAIGE TD,(TA)
LSNAM1: SKIPA TD,[POINT 6,[SIXBIT "??UNKNOWN??"]]
MOVE TD,[POINT 6,1(TA)] ;NO
JRST LSNAM3
LSNAM2: ADDI TE,1
PUSHJ PP,PUTLST
LSNAM3: ILDB CH,TD
TRNN CH,60 ;DONE?
JRST [CAIE CH,'%' ;YES, UNLESS IT'S A %
POPJ PP, ;NO--EXIT
JRST .+1]
ADDI CH,40
CAIN CH,";" ;IS IT A SEMI-COLON?
MOVEI CH,"." ;YES--USE PERIOD
CAIE CH,":" ;IS IT A COLON?
JRST LSNAM2 ;NO
TSWT FASEXT; ;YES--PRINTING AN EXTERNAL-NAME?
TRCA CH,27 ;NO--USE "-"
MOVEI CH,"$" ;YES--USE "$"
JRST LSNAM2
;LIST AN EBCDIC CONSTANT.
LSTEBC: MOVE DT, [POINT 9, TB]
JRST LSTASE
;LIST A SIXBIT CONSTANT
LSTSIX: SKIPA DT,[POINT 6,TB]
;LIST AN ASCII CONSTANT
LSTASC: MOVE DT,[POINT 7,TB]
LSTASE: MOVE OP,[POINT 7,GHOLD]
MOVEI W2,42
PUSHJ PP,GETASY ;GET FIRST WORD
MOVE TB,CH
SETZ TA,
TSWF FNOLST ;ANY LISTING?
JRST ASCSX0 ;NO
PUSH PP,CH ;YES, SAVE WORD
PUSH PP,TC ;AND WORD COUNT
PUSHJ PP,LSTCOD ;LIST PC AND FIRST WORD
POP PP,TC
POP PP,CH ;RESTORE FIRST WORD
TDZA TA,TA ;PUT OUT TO BINFIL
ASCSX1: PUSHJ PP,GETASY
MOVE TB,CH
ASCSX0: PUSHJ PP,PUTDAT
ADDI PC,1
TSWT FNOLST ;ANY LISTING?
JRST ASCSX2
SOJG TC,ASCSX1
POPJ PP,
ASCSX2: ILDB CH,DT
TLNE DT,1000 ;IS IT EBCDIC?
JRST ASCSX4 ;YES, GO CONVERT IT.
TLNE DT,100 ;SIXBIT?
JRST ASCS2I ;NO
JUMPE CH,[ADD TA,[1,,0] ;JUST COUNT SPACES
JRST ASCS2J] ;IN CASE TRAILING NULLS
ADDI CH,40 ;YES, CONVERT TO ASCII
JUMPE TA,ASCS2I ;ANY SPACES TO PUT OUT?
PUSH PP,CH ;YES
MOVEI CH," "
IDPB CH,OP
SUB TA,[1,,0]
JUMPN TA,.-3 ;LOOP
POP PP,CH
ASCS2I: CAIN CH,42 ;COME BACK HERE WITH AN ASCII
;CHAR FROM THE EBCDIC CONVERSION
;ROUTINE.
MOVEI W2,"/"
JUMPE CH,.+3 ;IGNORE NULL
CAIGE CH, 40 ;WILL IT PRINT?
MOVEI CH, "\" ;NO, REPLACE IT.
IDPB CH,OP
ASCS2J: TLNE DT,760000
JRST ASCSX2
HRRI DT,TB-1
SOJG TC,ASCSX1
MOVEI CH,0 ;SET "END OF CONSTANT"
IDPB CH,OP
;LIST A SIXBIT OR ASCII CONSTANT (CONT'D)
ASCSX3: SETOM TAGOUT
MOVE TE,[POINT 7,[ASCIZ "SIXBIT "]];ASSUME SIXBIT.
TLNN DT, 100 ;IS IT?
JRST ASCS3Q ;YES, GO ON.
TLNE DT, 1000 ;IS IT ASCII OR EBCDIC?
SKIPA TE,[POINT 7,[ASCIZ "EBCDIC "]];MUST BE EBCDIC.
MOVE TE,[POINT 7,[ASCIZ "ASCII "]];MUST BE ASCII.
ASCS3Q: PUSHJ PP,LSTMES
MOVE CH,W2
PUSHJ PP,PUTLST
MOVE TE,[POINT 7,GHOLD]
PUSHJ PP,LSTMES
MOVE CH,W2
PUSHJ PP,PUTLST
JRST LCRLF
ASCSX4: ROT CH, -2 ;FORM THE TABLE INDEX.
JUMPL CH, ASCS4I ;LEFT OR RIGHT HALF.
HLR CH, EBASC.##(CH) ;LEFT.
CAIA
ASCS4I: HRR CH, EBASC.##(CH) ;RIGHT.
TLNN CH, (1B1) ;IS THE CHAR RIGHT JUSTIFIED?
LSH CH, -^D9 ;IT IS NOW.
ANDI CH, 177 ;GET RID OF ANY JUNK.
JRST ASCS2I ;RETURN.
;LIST A ONE-WORD DECIMAL CONSTANT
LSTD1: MOVSI TA,'DEC'
PUSHJ PP,SIXOUT
MOVEI CH,11
PUSHJ PP,PUTLST
MOVE TE,TB
JRST DECIT
;LIST A TWO-WORD DECIMAL CONSTANT
LSTD2: MOVSI TA,'DEC'
PUSHJ PP,SIXOUT
MOVEI CH,11
PUSHJ PP,PUTLST
PUSHJ PP,GETASY
PUSH PP,CH
PUSH PP,TB
MOVE TB,CH
MOVEI TA,0
PUSHJ PP,PUTDAT
SUBI CT,1
POP PP,TD ;TD_LEFT HALF
MOVE TC,(PP) ;TC_RIGHT HALF
JUMPGE TD,LSTD2A ;IS IT NEGATIVE?
MOVEI CH,"-" ;YES -- PUT OUT MINUS SIGN
PUSHJ PP,PUTLST
SETCA TD, ;MAKE THE VALUE POSITIVE
MOVNS TC
TLZ TC,1B18
SKIPN TC
AOJL TD,[MOVE TE,[POINT 7,[ASCIZ /-1*2**70/]]
PUSHJ PP,LSTMES
JRST LSTD2C] ;LOW-VALUES
LSTD2A: JUMPE TD,LSTD2D
DIV TD,[DEC 10000000000]
PUSH PP,TC
MOVE TE,TD
PUSHJ PP,DECIT
POP PP,TD
SKIPA TB,[XWD -^D9,DECTAB]
LSTD2B: MOVE TD,TC
IDIV TD,(TB)
MOVEI CH,"0"(TD)
PUSHJ PP,PUTLST
AOBJN TB,LSTD2B
MOVEI CH,"0"(TC)
PUSHJ PP,PUTLST
LSTD2C: PUSHJ PP,STRTI9
POP PP,TB
JRST LSTCOD
LSTD2D: MOVE TE,TC
PUSHJ PP,DECIT
JRST LSTD2C
;ASSEMBLE A FLOATING POINT CONSTANT
FLTCON: PUSH PP,LN ;SAVE LN
SUBI CH,^D8 ;REDUCE EXPONENT BY 8
MOVEM CH,FLTC1 ;SAVE EXPONENT
PUSHJ PP,GETASY ;GET AND SAVE MANTISSA
MOVEM CH,FLTC2
SUBI CT,1 ;DECREMENT WORD COUNT
MOVEI TB,0 ;CLEAR TB
SKIPA TD,[POINT 4,FLTC2,3]
FLTCN1: IMULI TB,^D10 ;CREATE MANTISSA
ILDB TC,TD
ADD TB,TC
TLNE TD,770000
JRST FLTCN1
JUMPE TB,FLTC12 ;ZERO?
MOVEI LN,243 ;MAXIMUM BINARY EXPONENT
TLNE TB,777777 ;IF MANTISSA
JRST FLTCN3 ; IS ZERO IN LEFT-HALF,
SUBI LN,^D17 ; DECREMENT EXPONENT AND
LSH TB,^D17 ; SHIFT MANTISSA
FLTCN3: TLNE TB,777000 ;IF MANTISSA
JRST FLTCN4 ; IS ZERO IN FIRST 8 BITS,
LSH TB,^D8 ; SHIFT LEFT
SUBI LN,^D8 ; AND DECREMENT EXPONENT
FLTCN4: TLNE TB,(1B1) ;SHIFT MANTISSA
JRST FLTCN5 ; UNTIL BIT 1
LSH TB,1 ; IS NON-ZERO
SOJA LN,FLTCN4
FLTCN5: MOVM TE,FLTC1 ;GET TENS EXPONENT
CAILE TE,^D100 ;IF TOO BIG,
JRST FLTBIG ; FORGET IT
JUMPE TE,FLTCN9 ;IF ZERO, WE'RE DONE
FLTCN6: MOVEI TC,0 ;SET 'LEFT OVER' TO ZERO
CAIG TE,^D38 ;IF EXPONENT
JRST FLTCN7 ; IS GREATER THAN 38
MOVEI TC,-^D38(TE) ; SAVE 'LEFT OVER'
MOVEI TE,^D38 ; AND RESET EXPONENT TO 38
FLTCN7: LSH TE,1 ;[762] TWO WORDS PER ENTRY
SKIPGE FLTC1 ;POSITIVE EXPONENT?
MOVNS TE ;NO--GET NEGATIVE
MUL TB,FLTAB1(TE) ;MULTIPLY BY TABLE VALUE
TLNE TB,(1B1) ;IF NOT
JRST FLTCN8 ; NORMALIZED,
LSH TB,1 ; THEN NORMALIZE IT
SUBI LN,1
FLTCN8: LSH TE,-1 ;[762] TWO WORDS PER ENTRY
IDIVI TE,4 ;GET EXPONENT FROM
LDB TE,FLTAB2(TD) ; TABLE
ADDI LN,-200(TE) ;ADD TO THE ONE WE'VE BEEN CARRYING
SKIPE TE,TC ;IF ANY EXPONENT WAS LEFT OVER,
JRST FLTCN6 ; MAKE ANOTHER ITERATION
FLTCN9: ADDI TB,200 ;ROUND THE MANTISSA
JUMPGE TB,FLTC10 ;IF NECESSARY,
LSH TB,-1 ; ADJUST MANTISSA
ADDI LN,1 ; AND EXPONENT
FLTC10: TRNE LN,777400 ;IF EXPONENT IS TOO BIG,
JRST FLTBIG ; WE LOSE
LSH TB,-^D8 ;MAKE ROOM FOR EXPONENT
DPB LN,[POINT 9,TB,8];STASH EXPONENT
LDB TA,[POINT 4,FLTC2,3];GET SIGN OF ITEM
SKIPE TA ;IF NOT POSITIVE,
MOVNS TB ; NEGATE THE RESULT
FLTC12: MOVEI TE,^D8 ;BUMP EXPONENT
ADDM TE,FLTC1 ; TO ORIGINAL VALUE
FLTC13: POP PP,LN ;[762] RESTORE LN
POPJ PP,
F2BIG: SKIPA TE,[POINT 7,[ASCIZ "
****** BAD COMP-2 CONSTANT ******
"]] ;[762]
FLTBIG: MOVE TE,[POINT 7,[ASCIZ "
****** BAD COMP-1 CONSTANT ******
"]]
PUSHJ PP,LSTMES
AOS GAERAS
MOVNI TB,3
ADDM TB,PAGCNT
MOVEI TB,0
JRST FLTC12
;LIST A FLOATING POINT CONSTANT
LSTFLT: MOVE TA,[SIXBIT "FLOAT"]
PUSHJ PP,SIXOUT
MOVEI CH,11
PUSHJ PP,PUTLST
LDB CH,[POINT 4,FLTC2,3] ;IS THE VALUE POSITIVE?
JUMPE CH,LSFLT1
MOVEI CH,"-"
PUSHJ PP,PUTLST
LSFLT1: MOVSI TA,'0. '
PUSHJ PP,SIXOUT
MOVE TA,FLTC2 ;[762] GET MANTISSA
MOVEI TB,10
LSFLT2: LSH TA,4 ;[762] GET NEXT DIGIT LINED UP
JUMPE TA,LSFLT3 ;[762] ALL DONE WITH MANTISSA
LDB CH,[POINT 4,TA,3] ;[762] GET DIGIT
ADDI CH,"0"
PUSHJ PP,PUTLST
SOJG TB,LSFLT2
LSFLT3: SKIPN TE,FLTC1 ;[762]
POPJ PP,
MOVEI CH,"E"
PUSHJ PP,PUTLST
JRST DECIT
;[762] ASSEMBLE A D. P. FLOATING POINT CONSTANT
F2CON: PUSH PP,LN ;[762] SAVE LN
PUSHJ PP,GETASY ;[762] GET AND SAVE
MOVEM CH,FLTC1 ;[762] EXPONENT
PUSHJ PP,GETASY ;[762] GET AND SAVE
MOVEM CH,FLTC2 ;[762] FIRST 8 DIGITS OF MANTISSA
SUBI CT,1 ;[762] DECREMENT WORD COUNT
CAIG CT,1 ;[762] ONLY 2 WORDS SUPLIED?
JRST F2CNZ1 ;[762] YES, ZERO THE SECOND AND THIRD WORDS
PUSHJ PP,GETASY ;[762] SAME FOR SECOND WORD
MOVEM CH,FLTC2+1 ;[762]
SUBI CT,1 ;[762] DECREMENT WORD COUNT
CAIG CT,1 ;[762] ONLY 3 WORDS SUPLIED?
JRST F2CNZ2 ;[762] YES, ZERO THE THIRD WORD
PUSHJ PP,GETASY ;[762] SAME FOR SECOND WORD
MOVEM CH,FLTC2+2 ;[1024] [762]
SOJA CT,F2CON0 ;[762] DECREMENT THE COUNT
F2CNZ1: SETZM FLTC2+1 ;[762] ZERO THE SECOND WORD
F2CNZ2: SETZM FLTC2+2 ;[762] ZERO THE THIRD WORD
F2CON0: MOVE CH,FLTC1 ;[762] GET EXPONENT INTO SAFE PLACE
SUBI CH,^D8 ;[762] REDUCE IT BY 8 DIGITS INITIALLY
SETZB TB,TA ;[762] CLEAR FRACTION
SKIPA TD,[POINT 4,FLTC2,3] ;[762]
F2CN1: IMULI TA,^D10 ;[762] CREATE MANTISSA
ILDB TE,TD ;[762]
ADD TA,TE ;[762]
TLNE TD,770000 ;[762]
JRST F2CN1 ;[762]
SKIPN FLTC2+1 ;[762] ARE REMAINING WORDS ZERO?
SKIPE FLTC2+2 ;[762]
JRST F3CON ;[762] NO, NEED DOUBLE PRECISION
F2CN2: MOVEI LN,306 ;[762] INITIALIZE D. P. BINARY EXPONENT
JUMPN TB,F2CN3 ;[762] JUMP IF HIGH ORDER WORD NON-ZERO
EXCH TB,TA ;[762] NO, MOVE LOW HALF TO HIGH, CLEAR LOW HALF
SUBI LN,^D35 ;[762] AND ADJUST EXPONENT
F2CN3: MOVE TC,TB ;[762] GET HIGH HALF INTO TC
JFFO TC,F2CN4 ;[762] ANY ONES NOW?
JRST F2C12 ;[762] NO, RESULT IS ZERO
F2CN4: EXCH TB,TC ;[762] PUT SHIFT COUNTER IN TC
ASHC TB,-1(TC) ;[762] NORMALIZE D.P. INTEGER TO PUT BIN POINT BETWEEN BITS 0 AND 1
SUBI LN,-1(TC) ;[762] ADJUST EXPONENT TO COMPENSATE FOR SHIFT
F2CN5: JUMPE CH,F2CN9 ;[762] DECIMAL EXPONENT = 0, NO MUL BY 10 NEEDED
F2CN6: MOVM TE,CH ;[762] GET MAGNITUDE OF DECIMAL EXPONENT
CAILE TE,PTLEN. ;[762] BETWEEN 0 AND MAX. TABLE SIZE?
MOVEI TE,PTLEN. ;[762] NO, SO MAKE IT SO
SKIPGE CH ;[762] RESTORE CORRECT SIGN
MOVNS TE ;[762]
SUB CH,TE ;[762] GET EXCESS EXPONENT
LSH TE,1 ;[762] TABLE IS 2 WORDS PER ITEM
DMOVE TD,TB ;[762] MOVE TO FIRST PAIR OF 4 ACCS
DMUL TD,FLTAB1(TE) ;[762] RESULT IN TB & TA
DMOVE TB,TD ;[762] GET HIGH PAIR
TLNE TB,(1B1) ;[762] NORMALIZED?
JRST F2CN7 ;[762] YES
ASHC TB,1 ;[762] NO, SHIFT LEFT ONE PLACE
SUBI LN,1 ;[762] AND ADJUST EXPONENT
F2CN7: LSH TE,-1 ;[762] TWO WORDS PER ENTRY
IDIVI TE,4 ;[762] GET EXPONENT FROM
LDB TE,FLTAB2(TD) ;[762] TABLE
ADDI LN,-200(TE) ;[762] ADD TO THE ONE WE'VE BEEN CARRYING
JUMPN CH,F2CN6 ;[762] IF ANY EXPONENT WAS LEFT OVER, MAKE ANOTHER ITERATION
F2CN9: TLO TB,(1B0) ;[762] START ROUNDING (ALLOW FOR OVERFLOW)
TLO TA,(1B0) ;[762] ALLOW FOR CARRY'S
ADDI TA,200 ;[762] LOW WORD ROUNDING
TLZN TA,(1B0) ;[762] DID CARRY PROPAGATE INTO HIGH WORD?
ADDI TB,1 ;[762] YES
TLZE TB,(1B0) ;[762] DID CARRY PROPAGATE TO BIT 0?
JRST F2CN10 ;[762] NO
ASHC TB,-1 ;[762] YES, RENORMALIZE TO RIGHT
ADDI LN,1 ;[762] ADJUST BINARY EXPONENT
TLO TB,(1B1) ;[762] AND TURN ON HIGH FRACTION BIT
F2CN10: TRNE LN,777400 ;[762] IF EXPONENT IS TOO BIG,
JRST F2BIG ;[1055] [762] WE LOSE
ASHC TB,-^D8 ;[762] MAKE ROOM FOR EXPONENT
DPB LN,[POINT 9,TB,8] ;[762] STASH EXPONENT
LDB TE,[POINT 4,FLTC2,3] ;[762] GET SIGN OF ITEM
SKIPE TE ;[762] IF NOT POSITIVE,
DMOVN TB,TB ;[762] NEGATE THE RESULT
JRST FLTC13 ;[762] RETURN
F2C12: SETZB TB,TA ;[762] RESULT IS ZERO
JRST FLTC13 ;[762] RETURN
;HERE WHEN MORE THAN 8 DIGITS IN NUMBER
F3CON: SUBI CH,^D10 ;[762] REDUCE EXPONENT BY 10 MORE DIGITS
IMULI TB,^D10 ;[762] MAKE ROOM FOR NINTH DIGIT
ILDB TE,TD ;[762] GET IT
ADD TB,TE ;[762]
F3CN1: ILDB TE,TD ;[762] GET NEXT DIGIT
F3CN2: IMULI TC,^D10 ;[762] MULTIPLY HIGH D. P. FRACTIONBY 10
MULI TB,^D10 ;[762] MULTIPLY LOW D. P. FRACTION BY 10
ADD TC,TB ;[762] ADD HIGH PART OF LOW PRODUCT INTO RESULT
MOVE TB,TA ;[762] GET LOW PART OR LOW PRODUCT
TLO TB,(1B0) ;[762] STOP OVERFLOW IF CARRY INTO HIGH WORD
ADD TB,TE ;[762] ADD IN NEXT DIGIT
TLZN TB,(1B0) ;[762] SKIP IF NO CARRY
ADDI TC,1 ;[762] PROPAGATE CARRY INTO HIGH WORD
TLNE TD,770000 ;[762] ANY MORE DIGITS IN THIS WORD?
JRST F3CN1 ;[762] YES, GET NEXT DIGIT
JUMPE TD,F2CN2 ;[762] JOINT MAIN LINE
ILDB TE,TD ;[762] GET 18 TH DIGIT
SETZ TD, ;[762] SIGNAL END
JRST F3CN2 ;[762] STORE IT
;[762] LIST A D. P. FLOATING POINT CONSTANT
LSTF2: SKIPN FLTC2+1 ;[762] SECOND WORD ZERO?
SKIPE FLTC2+2 ;[762] AND THIRD WORD ZERO?
SKIPA TA,[SIXBIT "FLOAT"] ;[762] NO, DO IT THE HARD WAY
JRST LSTFLT ;[762] YES, TREAT AS IF COMP-1
PUSHJ PP,SIXOUT ;[762]
MOVEI CH,11 ;[762]
PUSHJ PP,PUTLST ;[762]
LDB CH,[POINT 4,FLTC2,3] ;[762] IS THE VALUE POSITIVE?
JUMPE CH,LSTF2A ;[762]
MOVEI CH,"-" ;[762]
PUSHJ PP,PUTLST ;[762]
LSTF2A: MOVSI TA,'0. ' ;[762]
PUSHJ PP,SIXOUT ;[762]
MOVE TA,[POINT 4,FLTC2,3] ;[762]
MOVEI TB,^D8 ;[762] PRINT ALL OF FIRST WORD
SKIPE FLTC2+2 ;[762] AND IF THIRD WORD IS NON-ZERO
MOVEI TB,^D18 ;[762] ALL 18 DIGITS
LSTF2B: ILDB CH,TA ;[762]
ADDI CH,"0" ;[762]
PUSHJ PP,PUTLST ;[762]
SOJG TB,LSTF2B ;[762]
SKIPE FLTC2+2 ;[762] IF THIRD WORD WAS NON-ZERO
JRST LSFLT3 ;[762] WE'RE DONE, OTHERWISE
MOVE TA,FLTC2+1 ;[762] GET SECOND WORD
MOVEI TB,10 ;[762]
JRST LSFLT2 ;[762] PRINT SECOND WORD
;PUT LOCATION, ASSEMBLED WORD, AND ANY TAG ONTO LSTFIL
LSTCOD: PUSHJ PP,LISTPC
HLRZ TD,TB ;PRINT LH OF ASSEMBLED WORD
MOVE TE,[POINT 3,TD,17]
PUSHJ PP,LSCOD3
MOVEI CH," "
TRNE TA,1B34
MOVEI CH,"'"
TRNE TA,1B32
MOVEI CH,"*"
PUSHJ PP,PUTLST
MOVEI CH," "
PUSHJ PP,PUTLST
MOVE TE,[POINT 3,TB,17] ;PRINT RH OF ASSEMBLED WORD
PUSHJ PP,LSCOD3
MOVEI CH," "
TRNE TA,1B35
MOVEI CH,"'"
TRNE TA,1B33
MOVEI CH,"*"
PUSHJ PP,PUTLST
MOVEI CH,11
PUSHJ PP,PUTLST
SKIPE TAGOUT ;A SINGLE TAG TO BE LISTED?
JRST LSCOD2 ;NO
MOVE TC,SAVTAG
PUSHJ PP,MSTAG4
LSCOD2: SETOM TAGOUT
MOVEI CH,11
JRST PUTLST ;PUT OUT TAB AND RETURN
LSCOD4: MOVE TE,[POINT 3,TA,17]
LSCOD3: ILDB CH,TE ;PRINT A HALF-WORD
ADDI CH,"0"
PUSHJ PP,PUTLST
TLNE TE,770000
JRST LSCOD3
POPJ PP,
;PRINT OUT CURRENT PC
LISTPC: SKIPLE TAGOUT ;ANY TAGS OUT?
PUSHJ PP,LCRLF ;YES -- FINISH THE LINE
TSWTZ FASPAR; ;ANY PARAGRAPH NAME OUT?
SKIPL TAGOUT ;NO -- ANY TAG LINE?
PUSHJ PP,LCRLF ;YES -- PUT OUT ANOTHER <C.R.>
MOVE TE,[POINT 3,PC,17] ;PRINT LOCATION COUNTER
PUSHJ PP,LSCOD3
MOVEI CH,"'"
TSWF FRELOC;
PUSHJ PP,PUTLST
MOVEI CH,11
JRST PUTLST
;PUT LOCATION IN RH OF "TB", SET RELOCATION IN TA.
;OPERAND IS IN RH OF "W1".
GETADR: LDB TD,ADRTYP
MOVE TE,W1
ANDI TE,77777
XCT ADRTB1(TD)
MOVEI TA,1
TLNE W2,-1 ;ANYTHING IN LH?
JRST GETAD1 ;YES, INCR. IS IN LH
ADD TB,W2
POPJ PP,
GETAD1: HLRE TE,W2 ;GET POS. OR NEG. INCREMENT FROM LH(W2)
ADD TB,TE
POPJ PP,
;ADDRESS IS A CONSTANT
ADRCON: MOVEI TA,0
HRR TB,TE
POPJ PP,
;ADDRESS IS IN EXTAB
ADREXT: ADD TE,EXTLOC ;GET EXTTAB LOCATION
HRRZ TD,1(TE) ;PICK UP ADDRESS
LOAD TA,EXENT,(TE) ;IS IT AN ENTRY POINT?
JUMPN TA,ADEXT2 ;YES - JUST USE ADDRESS
TSWT FASSEG ;ARE WE IN NON-RESIDENT SEGMENT?
JRST ADEXT0 ;NO
SKIPL 1(TE) ;YES--IS FLAG IN EXTAB ON?
JRST ADEXT3 ;NO--IT SHOULD BE
TLO W1,1B31 ;YES--SET INDIRECT FLAGS
TLO TB,1B31
JRST ADEXT1
ADEXT0: JUMPN W2,ADEXT4 ;ADDITIVE GLOBAL?
HRRM PC,1(TE) ;SET LINK TO CURRENT LOCATION
CAIN TD,-1 ;IS THIS FIRST REFERENCE?
JRST ADEXT3 ;YES
ADEXT1: HRR TB,TD ;GET LINK ADDRESS
MOVEI TA,1B33+1B35 ;SET RELOCATION TO EXTERNAL AND RELOCATABLE
POPJ PP, ;RETURN
ADEXT2: HRR TB,TD ;GET LINK ADDRESS
MOVEI TA,1B35 ;SET RELOCATION ON
POPJ PP, ;RETURN
ADEXT3: HLLZS TB ;SET ADDRESS TO ZERO
MOVEI TA,1B33 ;SET RELOCATION TO EXTERNAL
POPJ PP, ;RETURN
ADEXT4: HRR TB,W2 ;SET ADDRESS TO BE ADDITIVE CONSTANT
MOVEI TA,1B33 ;SET RELOCATION TO EXTERNAL
POPJ PP, ;RETURN
;ADDRESS IS IN PROTAB
ADRPRO: HRRZ DT,PROLOC ;GET ADDRESS OF PROTAB ENTRY
ADD DT,TE
HRR TB,1(DT) ;PICK UP THAT LOCATION
LDB TE,PTSEGN ;IS IT IN THE RESIDENT SEGMENT?
JUMPN TE,ADPRO2
ADD TB,RESDNT ;YES--RELOCATE
POPJ PP,
ADPRO2: ADD TB,NONRES ;RELOCATE TO NON-RESIDENT SEGMENT
POPJ PP,
;ADDRESS IS A GENERATED TAG
ADRTAG: ADD TE,TAGLOC ;GET ABSOLUTE ADDRESS
MOVE TE,(TE) ;GET ENTRY
TLNN TE,(1B0) ; USE ANOTHER TAG OR PARA?
JRST ADRTG1 ;NO
TRC TE,AS.PRO ;IS THIS A PROCEDURE NAME?
TRNE TE,700000
JRST ADRTG2 ;NO-- A TAG THEN
;ENTRY POINTS TO A PARAGRAPH. GET PC FROM PROTAB
HRRZ DT,PROLOC
HRRZ TE,TE
ADD DT,TE ;GET ADDRESS OF PROTAB ENTRY
HRR TE,1(DT) ;GET PC
LDB TD,PTSEGN
JUMPN TD,ADPRG4 ;NON-RES SEC
ADD TE,RESDNT ;RESIDENT SECTION
JRST ADRTG3
ADPRG4: ADD TE,NONRES
JRST ADRTG3
ADRTG2: ANDI TE,77777 ;GET TAG #
JRST ADRTAG ;MAYBE MORE LEVELS OF INDIRECTING
ADRTG1: HRRZ TE,TE ;GET PC
TRZE TE,400000 ;IS IT IN RESIDENT AREA?
JRST .+3
ADD TE,RESDNT ;YES--RELOCATE BY RESIDENT BASE
SKIPA
ADD TE,NONRES ;NO--RELOCATE BY NON-RESIDENT BASE
ADRTG3: HRR TB,TE ;PUT ADDRESS IN TB
POPJ PP, ;RETURN
;ADDRESS IS FILE-TABLE
ADRFIL: HRRZ DT,FILLOC
ADD DT,TE
HRR TB,1(DT)
ADD TB,FILTBL
POPJ PP,
;ADDRESS IS IN DATAB
ADRDAT: HRRZ TA,DATLOC
ADD TA,TE
LDB TE,DA.DFS
JUMPE TE,ADRD3
LDB TE,DA.DEF
JUMPE TE,ADRD3
MOVEI TE,0
DPB TE,DA.DFS
PUSH PP,TA ;SAVE IT'S ADDRESS
ADRD1: LDB TA,DA.BRO ;GET BROTHER OR FATHER LINK
LDB TE,LNKCOD
CAIN TE,TB.FIL ;IS IT A FILTAB ENTRY?
JRST ADRD2 ;YES
PUSHJ PP,LNKSET ;NO--GET ADDRESS
JRST ADRD1
ADRD2: SKIPE TA ;ERROR, JUST GIVE UP
PUSHJ PP,LNKSET
MOVE DT,TA
LDB TC,FTDBAS
POP PP,TA
ADDM TC,1(TA)
ADRD3: HRR TB,1(TA)
LDB TE,DA.LKS## ;ITEM IN LINKAGE SECTION?
MOVEI TA,0 ;IN CASE SO, SET FOR ABSOLUTE ADDR
SKIPE TE
AOSA (PP) ;IF SO, SKIP RETURN OVER THE MOVEI TA,1
ADD TB,DATBAS ;IF NOT ADD IN BASE OF DATA AREA
POPJ PP,
;THE INCREMENT IS A CONSTANT
INCCON: HRR TB,W2 ;SET VALUE
MOVEI TA,0 ;NO RELOCATION
POPJ PP,
;THE INCREMENT IS MISCELLANEOUS
INCMIS: LDB TE, MSC.CL## ;SEE WHICH CLASS IT IS.
JRST @MSCTBL(TE) ;DISPATCH TO APPROPRIATE ROUTINE.
MSCTBL: EXP OLDMSC ;CLASS 0 OLD TYPE MISCELLANEOUS.
EXP MSCCL1 ;CLASS 1 SPECIAL VALUES.
EXP MSCCL2 ;CLASS 2 (NEGATIVE INCREMENT)
EXP BADINC
EXP BADINC
EXP BADINC
EXP BADINC
EXP BADINC
;CLASS 0 OLD TYPE MISCELLANEOUS:
OLDMSC: LDB TE,INCTYP
XCT INCTB1(TE)
MOVE TD,W2
ANDI TD,77777
ADD TB,TD
MOVEI TA,1 ;RELOCATED
POPJ PP,
;SAME AS OLDMSC, BUT INCREMENT IS TO BE SUBTRACTED
;FROM BASE ADDRESS.
MSCCL2: LDB TE,INCTYP
XCT INCTB1(TE) ;SET TB = BASE ADDRESS
MOVE TD,W2
ANDI TD,77777
SUB TB,TD
MOVEI TA,1 ;RELOCATED
POPJ PP,
;IMPROPER INCREMENT
BADINC: MOVE TE,[POINT 7,[ASCIZ "
******** BAD INCREMENT *********
"]]
PUSHJ PP,LSTMES
AOS GAERAS
MOVNI TE,3
ADDM TE,PAGCNT
HRRI TB,0
POPJ PP,
;%TEMP INCREMENTS
TMPINC: HRR TB,TEMBAS
SUBI TB,2*FIXNUM
POPJ PP,
TMPLST: SUBI W2,2*FIXNUM
MOVE TA,[SIXBIT '%TEMP']
POPJ PP,
;INCREMENT IS 'GOTO..'
INCGO:
MOVEI TE,GOTO.##
ANDI TE,77777
JRST ADREXT
;INCREMENT IS '%FILES'
INCFLS: MOVEI TA,1 ;RELOCATABLE
HRRI TB,FILO ;ADDR OF %FILES
POPJ PP,
;CLASS 1 INCREMENT IS A SPECIAL VALUE.
MSCCL1: HRRZI TE, (W2) ;SEE WHAT IT IS.
CAILE TE, LAS.M1## ;IF IT'S NOT VALID
JRST BADINC ; COMPLAIN.
HRR TE, MSCTB1(TE) ;SELECT A ROUTINE'S ADDR.
JRST (TE) ;DISPATCH.
MSCTB1: XWD LBASAD,BASADR
XWD HDROUT,CPOPJ
;IT'S THE PROGRAM'S BASE ADDRESS.
BASADR: TSWT FREENT; ;REENTRENT CODE?
JRST INCFLS ;NO, PUT OUT ADDR OF %FILES.
MOVEI TB, 400000 ;PUT OUT ADDR OF START.
MOVEI TA, 1 ;RELOCATE IT.
POPJ PP, ;RETURN.
;CONVERT A SIXBIT WORD TO RADIX 50.
;ENTER WITH THE WORD IN TC; EXIT WITH VALUE IN CH.
RADX50: MOVEI CH,0
MOVE TE,[POINT 6,TC]
RDX50A: ILDB TD,TE
JUMPE TD,RDX50C
IMULI CH,50
CAIN TD,';' ;IS IT A SEMI-COLON?
JRST RDX50D ;YES
CAIN TD,'%' ;PERCENT SIGN
JRST [MOVEI TD,47 ;YES, ITS SPECIAL
JRST RDX50E]
CAIGE TD,'A'
CAIG TD,'9'
SKIPA
JRST RDX50B
CAIN TD,"."-40
MOVEI TD,45+17+7
SUBI TD,17
CAILE TD,12
SUBI TD,7
CAIG TD,46
SKIPGE TD
RDX50B: MOVEI TD,46
RDX50E: ADD CH,TD
TLNE TE,770000
JRST RDX50A
RDX50C: POPJ PP,
RDX50D: MOVEI TD,45 ;CHANGE ";" TO "."
JRST RDX50E
;LIST AN OCTAL CONSTANT
LSTOCT: MOVSI TA,'OCT'
PUSHJ PP,SIXOUT
MOVEI CH,11
PUSHJ PP,PUTLST
MOVE TA,[POINT 3,TB]
LSOCT1: ILDB CH,TA
TLNE TA,770000
JUMPE CH,LSOCT1
LSOCT2: ADDI CH,"0"
PUSHJ PP,PUTLST
TLNN TA,770000
POPJ PP,
ILDB CH,TA
JRST LSOCT2
;PRINT OUT THE DECIMAL VALUE IN TE
DECIT: JUMPGE TE,DECIT1
MOVEI CH,"-"
PUSHJ PP,PUTLST
MOVMS TE
DECIT1: IDIVI TE,^D10
HRLM TD,(PP)
SKIPE TE
PUSHJ PP,DECIT1
HLRZ CH,(PP)
ADDI CH,"0"
JRST PUTLST
;PRINT OUT A SIXBIT WORD
SIXOUT: MOVE TE,[POINT 6,TA]
SIXOT1: ILDB CH,TE
JUMPE CH,SIXOT2
ADDI CH,40
PUSHJ PP,PUTLST
TLNE TE,770000
JRST SIXOT1
SIXOT2: POPJ PP,
;LIST AN XWD:
LSAXWD: TRNN TA, 1B34
TLNE TB, -1
SKIPA TA, [SIXBIT "XWD"]
HRLI TA, 'EXP'
PUSHJ PP, SIXOUT
MOVEI CH, 11
PUSHJ PP, PUTLST
TLNN TB, -1
JRST LSAXWH
MOVSS TB
MOVE TA, [POINT 3,TB,17]
PUSHJ PP, LSOCT1
MOVEI CH, ","
PUSHJ PP, PUTLST
MOVSS TB
LSAXWH: MOVE TA, [POINT 3,TB,17]
PJRST LSOCT1
;PUT OUT THE FIRST LINES OF CODE:
; JSP 14,RESET. ;[201]
; JRST <PROCEDURE-NAME>
STARTI: PUSHJ PP,CLRDAT ;CLEAR DATGRP
MOVE PC,RESDNT
SUB PC,FIXEDS
HRRZM PC,DATGRP+2
;IF ITS /R AND ANY RMS I/O HAS BEEN REQUESTED PUT OUT A GLOBAL REQUEST
; TELLING LINK TO LOAD THE RMS INITIALIZATION ROUTINE.
IFE TOPS20,<
TSWT FREENT; ;EXPLICIT /R
>
IFN TOPS20,<
SKIPN RENSW## ;EXPLICIT /R
>
JRST STRTI1 ;NON-REENTRANT
MOVE CH,[2,,2]
PUSHJ PP,PUTBIN ;PUT OUT GLOBAL REQUEST BLOCK
SETZ CH,
PUSHJ PP,PUTBIN ;NO RELOCATION INFO
MOVE CH,[RADIX50 60,RMS.EV] ;REENTRANT VERSION
PUSHJ PP,PUTBIN ;GO PUT IT INTO THE REL FILE.
SETZ CH,
PUSHJ PP,PUTBIN
;PUT OUT A START BLOCK
STRTI1: SKIPN SLASHJ## ;FORCE START ADDR?
SKIPN SUBPRG## ;NO, THIS A SUBPROGRAM?
SKIPA CH,[7,,1] ;NO, PUT OUT A START ADDR
JRST [MOVE CH,[2,,2] ;[756] YES, OMIT THE MAIN PROGRAM INFO
PUSHJ PP,PUTBIN ;[756] BUT PUT OUT GLOBAL REQUEST
SETZ CH, ;[756]
PUSHJ PP,PUTBIN ;[756] FOR CBLIO
MOVE CH,[RADIX50 60,C.RSET] ;[756]
PUSHJ PP,PUTBIN ;[756] INCASE CALLED BY NON-COBOL SUBROUTINE
SETZ CH, ;[756]
JRST PUTBIN] ;[756]
PUSHJ PP,PUTBIN
MOVSI CH,200000
PUSHJ PP,PUTBIN
HRRZ CH,PC
PUSHJ PP,PUTBIN
;PUT OUT A GLOBAL REQUEST TELLING LINK TO LOAD THE APPROPRIATE
; STARTUP ROUTINE.
MOVE CH,[2,,2]
PUSHJ PP,PUTBIN ;PUT OUT GLOBAL REQUEST BLOCK
SETZ CH,
PUSHJ PP,PUTBIN ;NO RELOCATION INFO
IFE TOPS20,<
TSWT FREENT; ;IF IT'S NOT REENTRANT, USE
; CON012 INSTEAD OF COR012.
>
IFN TOPS20,<
SKIPN RENSW## ;EXPLICIT /R
>
SKIPA CH,[RADIX50 60,CN.12] ;NON-REENTRANT
MOVE CH,[RADIX50 60,CR.12] ;REENTRANT VERSION
PUSHJ PP,PUTBIN ;GO PUT IT INTO THE REL FILE.
SETZ CH,
PUSHJ PP,PUTBIN
PUSHJ PP,HDROUT
PUSHJ PP,LCRLF
MOVE CH,[RADIX50 10,START.]
MOVE TA,PC
PUSHJ PP,PUTSYM ;OUTPUT AS LOCAL SYMBOL
SC==0 ;[201] INITIAL COUNT OF START INSTRUCTIONS.
; PUT OUT THE JFCL
MOVSI TB,(JFCL)
SETZ TA, ;NO RELOCATION.
PUSHJ PP,PUTDAT ;ASSEMBLE IT.
MOVE TE,[POINT 7, [ASCIZ "START.: JFCL"]]
PUSHJ PP,STRTI8 ;PUT INTO LISTING
SC==SC+1
; PUT OUT JSP 16,COBST. ;[201]
MOVSI TB,(JSP 16,) ;[201]
MOVEI W2,0 ;[201] NO RELOCATION.
MOVEI W1,COBST.## ;[201] EXTAB ADR OF START UP
PUSHJ PP,GETADR ;[201] GET ADDRESS
PUSHJ PP,PUTDAT ;[201] ASSEMBLE IT.
MOVE TE,[POINT 7, [ASCIZ " JSP 16,COBST.##"]] ; [201]
PUSHJ PP,STRTI8 ;[201] PUT INTO LISTING
SC==SC+1 ;[201]
;PUT OUT THE "JSP"
IFN CSTATS,<
SKIPN METRSW## ;WITH METER--ING?
JRST STRTII ;NO, DON'T SET THE FLAG
MOVSI TB,(SETOM)
MOVEI W2,0
MOVEI W1,METR.## ;METR.
PUSHJ PP,GETADR
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ " SETOM METR. ;Do METER--ING"]]
PUSHJ PP,STRTI8
STRTII: >
MOVSI TB,(JSP 14,)
MOVEI W2,0
MOVEI W1,C.RSET## ;EXTAB ADDR OF RESET.
PUSHJ PP,GETADR
PUSHJ PP,PUTDAT
SETOM TAGOUT
MOVE TE,[POINT 7,[ASCIZ " JSP 14,C.RSET##"]] ; [201]
PUSHJ PP,STRTI8
SC==SC+1
;PUT OUT "XWD 0,PROGRAM-ENTRY+1"
HRRZ TB,RESDNT ;GET CODE BASE
HRRZ TC,PRGENT## ;ADD ON ENTRY POINT
ANDI TC,77777
ADDI TB,(TC)
MOVEI TA,1 ;RELATIVE
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ " XWD 0,"]]
PUSHJ PP,LISTIT
MOVE TA,PROGID
PUSHJ PP,SIXOUT
PUSHJ PP,STRTI9
SC==SC+1
;PUT OUT "AOS %CALLFLAG"
HRRZ TB,IMPPAR ;GET BASE OF %PARAM
HRRZ TC,RETPTR##
ANDI TC,77777
ADDI TB,(TC)
HRLI TB,(AOS)
MOVEI TA,1 ;RELATIVE
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ " AOS %PARAM"]]
PUSHJ PP,LISTIT
SKIPE W2,TC
PUSHJ PP,LSTINC ;LIST OFFSET
PUSHJ PP,STRTI9
SC==SC+1
IFN ANS74,<
;PUT OUT "JSP 16,DEBST.##"
;OR "SETZM DEBUG.##"
SKIPN DEBSW ;IF NO DEBUGGING
JRST [MOVSI TB,(SETZM) ;MAKE SURE DEBUG-SWITCH IS OFF
SETZ W2,
MOVEI W1,DEBUG.##
PUSHJ PP,GETADR
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ " SETZM DEBUG.##"]]
JRST STRTI7]
MOVSI TB,(JSP 16,)
MOVEI W2,0
MOVEI W1,DEBST.## ;EXTAB ADDR OF DEBST.
PUSHJ PP,GETADR
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ " JSP 16,DEBST.##"]]
STRTI7: PUSHJ PP,STRTI8
SC==SC+1
>
;PUT OUT "JSP 16,CBDDT."
MOVSI TB,(JSP 16,)
MOVEI W2,0
MOVEI W1,CBDDT.## ;EXTAB ADDR OF CBDDT.
PUSHJ PP,GETADR
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ " JSP 16,CBDDT.##"]]
PUSHJ PP,STRTI8
SC==SC+1
;PUT OUT "XWD 0,PROGRAM-ENTRY+1"
HRRZ TB,RESDNT ;GET CODE BASE
HRRZ TC,PRGENT## ;ADD ON ENTRY POINT
ANDI TC,77777
ADDI TB,(TC)
MOVEI TA,1 ;RELATIVE
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ " XWD 0,"]]
PUSHJ PP,LISTIT
MOVE TA,PROGID
PUSHJ PP,SIXOUT
PUSHJ PP,STRTI9
SC==SC+1
IFN DBMS,<
;PUT OUT "MOVEI 16,INITDB-ARG-LIST-ADDR"
SKIPN SCHSEC## ;[206] WAS THERE A DBMS CALL?
JRST NODBMS ;NO
MOVSI TB,(MOVEI 16,)
HRR TB,LITBAS
ADD TB,DBUSES##
MOVEI TA,1
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ " MOVEI 16,%LIT00"]]
PUSHJ PP,LISTIT
HRRZ W2,DBUSES ;"+.."
PUSHJ PP,LSTINC
PUSHJ PP,STRTI9
;PUT OUT "PUSHJ 17,INITDB"
MOVSI TB,(PUSHJ 17,)
MOVEI W2,0
MOVEI W1,INITDB##
PUSHJ PP,GETADR
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ " PUSHJ 17,INITDB##"]]
PUSHJ PP,STRTI8
NODBMS:>
IFN MCS!TCS,<
IFE TOPS20,<
SKIPN FINITL## ;IS THERE AN "INITIAL" CD-ENTRY?
>
IFN TOPS20,<
SKIPN CSSEEN## ;IS THERE A COMUNICATIONS SECTION?
>
JRST MCSEND ;NO
MOVSI TB,(MOVEI 16,)
MOVEI TA,1
IFN TOPS20,<
SKIPN FINITL## ;WAS THERE?
SOJA TA,.+3 ;NO
>
HRR TB,LITBAS
ADD TB,M.IARG## ;GET INIT ARG ADDR
PUSHJ PP,PUTDAT
IFN TOPS20,<
SKIPN FINITL
SKIPA TE,[POINT 7,[ASCIZ / MOVEI 16,0/]]
>
MOVE TE,[POINT 7,[ASCIZ / MOVEI 16,%LIT00/]]
PUSHJ PP,LISTIT
HRRZ W2,M.IARG
PUSHJ PP,LSTINC ;LIST INCREMENT
PUSHJ PP,STRTI9
;PUT OUT "PUSHJ 17,M.INIT"
MOVSI TB,(PUSHJ 17,)
MOVEI W2,0
MOVEI W1,M.INIT## ;GET M.INIT ADDRESS
PUSHJ PP,GETADR
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ / PUSHJ 17,M.INIT##/]]
PUSHJ PP,STRTI8
MCSEND:>
IFN ANS74,<
;IF DEBUG MODULE INVOKED FOR PROCEDURE-NAMES
;PUT OUT CODE TO STORE INITIAL LINE NUMBER AND TEXT TYPE
SKIPE DEBSW## ;DEBUG MODULE?
SKIPN DBPARM## ;AND PROCEDURE-NAME %PARAM GIVEN?
JRST DBPEND ;NO
MOVSI TB,(SKIPA 16,)
HRRI TB,1(PC)
MOVEI TA,1 ;RELOCATE RHS
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ / SKIPA 16,.+1/]]
PUSHJ PP,STRTI8
MOVSI TB,DBP%SP ;START PROGRAM CODE
HRR TB,PROGLN## ;LINE NUMBER
SETZ TA,
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ / XWD 1,/]]
PUSHJ PP,LISTIT
HRRZ TA,PROGLN
PUSHJ PP,LSINC4
PUSHJ PP,STRTI9
MOVSI TB,(MOVEM 16,)
MOVEI W1,AS.MSC##
HRRZ W2,DBPARM
IORI W2,AS.PAR##
PUSHJ PP,GETADR
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ / MOVEM 16,%PARAM/]]
PUSHJ PP,LISTIT
MOVE W2,DBPARM
PUSHJ PP,LSTINC
PUSHJ PP,STRTI9
DBPEND:>
;PUT OUT "JRST" TO BEGINNING OF CODE
MOVSI W1,076000
HRR W1,PROGST
MOVEI W2,0
MOVE TB,W1
PUSHJ PP,GETOPR
PUSHJ PP,LSTOPR
ADDI PC,1
SC==SC+1
JRST CLRDAT
STRTS==:SC ;NUMBER OF WORDS OF START CODE
;PUT OUT MESSAGE, FOLLOWED BY <C.R.>,<L.F.>, AND BUMP PC
STRTI8: PUSHJ PP,LISTIT
STRTI9: AOJA PC,LCRLF
;PUT OUT THE FIXED PORTION OF CODE:
; FILES.: XWD 0,FILTBL
; USES.: XWD 0,USEBAS
; SEGWD.: XWD RESDNT,NONRES
; ALTER.: XWD <IMPURE BASE>,A50BAS
; OVRFN.: SIXBIT "<BINARY FILE NAME>"
; POINT.: '.'
; COMMA.: ','
; MONEY.: '$'
INFIX% ;GET EXPECTED INDICES OF HEADER ELEMENTS
;INDEX IS SAME AS NAME WITH % PRECEEDING
FXNM==0 ;USED TO CHECK INDICES FOR CORRECTNESS
;PUT OUT "XWD 0,FILTBL"
FIXED: PUSHJ PP,CLRDAT ;CLEAR OUT DATGRP
HRRZM PC,DATGRP+2
PUSHJ PP,LCRLF
HRRZ TB,FILTBL ;ASSUME THERE ARE FILES
MOVEI TA,1
MOVE TE,FILLOC ;ARE THERE ANY FILES?
CAMN TE,FILNXT
SETZB TA,TB ;NO--PUT OUT UNRELOCATED ZERO
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ "%FILES: XWD 0,"]]
PUSHJ PP,LISTIT
MOVE TA,TB
PUSHJ PP,LSINC2
PUSHJ PP,LCRLF
MOVE CH,[RADIX50 10,%FILES]
MOVE TA,PC
PUSHJ PP,PUTSYM
ADDI PC,1
IFN FXNM-%FILES,<PRINTX FILES. ERROR>
FXNM==FXNM+1
;PUT OUT "XWD 0,USEBAS"
HRRZ TB,USEBAS
MOVEI TA,1
IFN DBMS,<SKIPE DBONLY##> ;[401] IF ONLY DBMS USE, DON'T PUT OUT ANYTHING
CAMN TB,IMPPAR ;IF NO 'USE' TABLE,
SETZB TA,TB ; PUT OUT ZERO
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ "%USES: XWD 0,"]]
PUSHJ PP,LISTIT
MOVE TA,TB
PUSHJ PP,LSINC2
PUSHJ PP,STRTI9
IFN FXNM-%USES.,<PRINTX USES. ERROR>
FXNM==FXNM+1
;PUT OUT "SEGWD.: XWD PURE,IMPURE"
MOVEI TA,3
TSWT FREENT ;RE-ENTRANT PROGRAM?
TDCA TB,TB ;NO
MOVSI TB,1B18 ;YES
HRR TB,NONRES
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ "%SEGWD: XWD "]]
PUSHJ PP,LISTIT
TSWT FREENT;
SKIPA TE,[POINT 7,[ASCIZ "0,"]]
MOVE TE,[POINT 7,[ASCIZ "400000,"]]
PUSHJ PP,LSTMES
HRRZ TA,TB
PUSHJ PP,LSINC2
PUSHJ PP,STRTI9
IFN FXNM-%SEGWD,<PRINTX SEGWD. ERROR>
FXNM==FXNM+1
;PUT OUT "ALTER.: XWD 0,A50BAS"
HRRZ TB,A50BAS
MOVEI TA,3
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ "%ALTER: XWD 0,"]]
PUSHJ PP,LISTIT
HRRZ TA,TB
PUSHJ PP,LSINC2
PUSHJ PP,STRTI9
IFN FXNM-%ALTER,<PRINTX ALTER. ERROR>
FXNM==FXNM+1
;PUT OUT "OVRFN.: SIXBIT "FILE-NAME"
SKIPE TB,SEGFLG ;ANY NON-RESIDENT CODING?
MOVE TB,BINHDR ;YES--USE REL FILE'S NAME
MOVEI TA,0
PUSHJ PP,PUTDAT
JUMPE TB,FIXD4C ;ANY "OVR" FILE?
MOVE TE,[POINT 7,[ASCIZ /%OVRFN: SIXBIT "/]]
PUSHJ PP,LISTIT
MOVE TA,TB
PUSHJ PP,SIXOUT
MOVEI CH,42
PUSHJ PP,PUTLST
JRST FIXD4D
FIXD4C: MOVE TE,[POINT 7,[ASCIZ "%OVRFN: OCT 0"]]
PUSHJ PP,LISTIT
FIXD4D: PUSHJ PP,STRTI9
IFN FXNM-%OVRFN,<PRINTX OVRFN. ERROR>
FXNM==FXNM+1
;PUT OUT CONSTANTS (E.G. "POINT.")
MOVE TC,DCP.
FIXED5: HRRZ TB,@(TC)
SUBI TB,40 ;CONVERT TO SIXBIT
MOVEI TA,0
PUSHJ PP,PUTDAT
TSWF FNOLST ;ANY LISTING?
AOJA PC,FIXED6 ;NO
MOVE TE,[POINT 7,1(TC)] ;YES
PUSHJ PP,LISTIT
MOVEI CH,40(TB)
PUSHJ PP,PUTLST
MOVEI CH,"'"
PUSHJ PP,PUTLST
PUSHJ PP,STRTI9
FIXED6: ADDI TC,2
AOBJN TC,FIXED5
IFN FXNM-%POINT,<PRINTX POINT. ERROR>
FXNM==FXNM+1
IFN FXNM-%COMMA,<PRINTX COMMA. ERROR>
FXNM==FXNM+1
IFN FXNM-%MONEY,<PRINTX MONEY. ERROR>
FXNM==FXNM+1
;PUT OUT "MEMRY.: OCT <MEMORY-SIZE>"
HRRZ TB,OBJSIZ
SUBI TB,1
IORI TB,1777
MOVEI TA,0
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ "%MEMRY: OCT "]]
PUSHJ PP,LISTIT
HRRZ TA,TB
PUSHJ PP,LSINC2
PUSHJ PP,STRTI9
IFN FXNM-%MEMRY,<PRINTX MEMRY. ERROR>
FXNM==FXNM+1
;PUT OUT SYMBOL TABLE POINTERS AS ZERO WORDS
MOVE TC,SYM.P
FIXED8: SETZB TA,TB
PUSHJ PP,PUTDAT ;OUTPUT A ZERO
SKIPE PRODSW ;IF SYMBOLS
JRST FIXD8A ; ARE BEING GENERATED,
MOVEI TA,1 ; PRINT THE APPROPRIATE VALUES
TLNN TC, 1 ;DO WE WANT TO RELOCATE THE LEFT HALF TOO?
MOVEI TA, 3 ;YES.
MOVE TB,@0(TC)
FIXD8A: MOVE TE,[POINT 7,1(TC)]
PUSHJ PP,LISTIT ;LIST SOMETHING
PUSHJ PP,LSAXWD
PUSHJ PP,STRTI9 ;UPDATE PC
ADDI TC,2 ;LOOP
AOBJN TC,FIXED8 ;...
IFN FXNM-%%NM.,<PRINTX %NM. ERROR>
FXNM==FXNM+1
IFN FXNM-%%DT.,<PRINTX %DT. ERROR>
FXNM==FXNM+1
IFN FXNM-%%PR.,<PRINTX %PR. ERROR>
FXNM==FXNM+1
; PUT OUT %COBVR - COMPILER VERSION
SETZ TA, ;NO RELOCATION
MOVE TB,.JBVER## ;COMPILER VERION
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ "%COBVR: "]]
PUSHJ PP,LISTIT
MOVE TB,.JBVER
PUSHJ PP,LSAXWD
MOVE TE,[POINT 7,[ASCIZ " ;COBOL version number"]]
PUSHJ PP,LSTMES ;LIST SECOND PART OF MESSAGE
PUSHJ PP,STRTI9 ;INCREMENT PC
IFN FXNM-%COBVR,<PRINTX COBVR. ERROR>
FXNM==FXNM+1
;PUT OUT %COBSW - COMPILER ASSEMBLY SWITCHES
SETZ TA, ;NO RELOCATION
MOVE TB,COBSW%## ;ASSEMBLY SWITCH WORD
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ "%COBSW: "]]
PUSHJ PP,LISTIT
MOVE TB,COBSW%
PUSHJ PP,LSAXWD
MOVE TE,[POINT 7,[ASCIZ " ;Compiler assembly switches"]]
PUSHJ PP,LSTMES ;LIST SECOND PART OF MESSAGE
PUSHJ PP,STRTI9
IFN FXNM-%COBSW,<PRINTX COBSW. ERROR>
FXNM==FXNM+1
;PUT OUT PUSHL.: OCT <PUSHDOWN LIST SIZE>
SETZI TA, ;NO RELOCATION
HRRZ TB,OJPPSZ## ;STACK SIZE
ADDI TB,200
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ "%PUSHL: OCT "]]
PUSHJ PP,LISTIT
HRRZ TA,TB
PUSHJ PP,LSINC2
PUSHJ PP,STRTI9
IFN FXNM-%PUSHL,<PRINTX PUSHL. ERROR>
FXNM==FXNM+1
SETZ TA, ;GENERATE LENGTH OF RETAINED RECORDS TABLE
MOVE TB,SURRT.
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ"%SURRT: XWD 0,"]]
PUSHJ PP,LISTIT
MOVE TA,SURRT.
PUSHJ PP,LSINC2
PUSHJ PP,STRTI9
IFN FXNM-%SURRT,<PRINTX SURRT ERROR>
FXNM==FXNM+1
SETZ TA, ;GENERATE LENGTH OF ENQ/DEQ TABLES
MOVE TB,SUEQT.
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ"%SUEQT: XWD 0,"]]
PUSHJ PP,LISTIT
MOVE TA,SUEQT.
PUSHJ PP,LSINC2
PUSHJ PP,STRTI9
IFN FXNM-%SUEQT,<PRINTX SUEQT ERROR>
FXNM==FXNM+1
SETZ TA, ;GENERATE LENGTH OF FILL/FLUSH BUFFER TABLE
MOVE TB,SUFBT.
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ"%SUFBT: XWD 0,"]]
PUSHJ PP,LISTIT
MOVE TA,SUFBT.
PUSHJ PP,LSINC2
PUSHJ PP,STRTI9
IFN FXNM-%SUFBT,<PRINTX SUFBT ERROR>
FXNM==FXNM+1
IFN ANS74,<
;PUT OUT %DB: XWD 0,<DEBUG-ITEM>
MOVE TB,DEBSW## ;GET ADDRESS OF DEBUG-ITEM
SETZ TA, ;NO RELOCATION
ANDI TB,077777 ;TABLE ADDRESS ONLY
MOVEM TB,DEBSW
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ "%DB: XWD 0,"]]
PUSHJ PP,LISTIT
MOVE TA,DEBSW
PUSHJ PP,LSINC2
PUSHJ PP,STRTI9
IFN FXNM-%%DB.,<PRINTX %DB. ERROR>
FXNM==FXNM+1
>
IFN FXNM-FIXNUM,<PRINTX FIXNUM ERROR>
;PUT OUT STORAGE SPACE FOR CALLER'S FILES., ETC.
MOVEI TC,FIXNUM
FIX11: SETZB TA,TB
PUSHJ PP,PUTDAT
ADDI PC,1
SOJG TC,FIX11
PUSHJ PP,CLRDAT
PUSHJ PP,LCRLF
;NOW PUT OUT CORRECT VALUES AS TYPE 37 BLOCKS
SKIPE PRODSW ;IF NO SYMBOLS,
POPJ PP, ; FORGET IT
PUSHJ PP,CLRDAT
MOVE CH,[XWD 37,4]
PUSHJ PP,PUTBIN
MOVSI CH,(<BYTE (2)1,1,3,1>)
PUSHJ PP,PUTBIN
MOVEI CH,-2*FIXNUM+%%NM.(PC)
PUSHJ PP,PUTBIN
HRRZ CH,NM.PC
PUSHJ PP,PUTBIN
MOVE CH,DT.PC
PUSHJ PP,PUTBIN
MOVE CH,PR.PC
JRST PUTBIN
;INITIALIZE THE PHASE
INITAL: MOVE TA,BINBUF ;SET UP BINARY OUTPUT BUFFERS
MOVEM TA,.JBFF
SKIPE BINDEV
OUTBUF BIN,2
PUSHJ PP,HDROUT
PUSHJ PP,ENTBLK ;PUT OUT ENTRY BLOCK AT START OF REL FILE
MOVEI TA,1 ;INIT BLKTYP
MOVEM TA,BLKTYP
PUSHJ PP,PDATI ;SET UP DATGRP
PUSHJ PP,PSYMI ;SET UP SYMGRP
MOVE CH,[XWD 6,2] ;PUT OUT NAME BLOCK
PUSHJ PP,PUTBIN
MOVEI CH,0 ;ZERO
PUSHJ PP,PUTBIN ; RELOCATION WORD
MOVE TC,PROGID ;PROGRAM-ID
PUSHJ PP,RADX50 ; IN
PUSHJ PP,PUTBIN ; RADIX 50
IFN ANS68,<
MOVSI CH,2 ;"I AM COBOL-68" CODE
>
IFN ANS74,<
MOVSI CH,16 ; COBOL-74
>
IFN BIS,<
;DELETE THIS UNTIL FIELD-IMAGE LINK IS FIXED
; TLO CH,(4B5) ;KL-BIS, LET LINK KNOW
>
IFE TOPS20,<
TSWT FREENT;
>
HRRI CH,COMSIZ ;RESERVE SPACE FOR LIBOL DATA
PUSHJ PP,PUTBIN
TSWT FREENT ;RE-ENTRANT CODE?
JRST INITL2
MOVE CH,[XWD 3,1] ;YES--
PUSHJ PP,PUTBIN ; PUT
MOVSI CH,3B19 ; OUT
PUSHJ PP,PUTBIN ; 'HISEG'
MOVE CH,EAS2PC ; BLOCK
ADD CH,RESDNT
ADD CH,EXTCNT
MOVSS CH
HRR CH,RESDNT ;GET START OF HIGH-SEG
TRZ CH,777 ;PUT ON PAGE BOUNDARY
PUSHJ PP,PUTBIN
;PUT OUT .JBOPS WORD IF THIS IS A MAIN PROGRAM.
INITL2: SKIPN SLASHJ## ;/J ON? (FORCE START ADR)
SKIPN SUBPRG## ;NO, /I ON? (OMIT START ADR) OR IS IT
; A SUBPROGRAM IN ITS OWN RIGHT?
JRST .+2 ;NO, MUST BE A MAIN PROG.
JRST INITL3 ;IT IS A SUBPROG. DON'T PUT OUT EITHER
; THE .JBOPS WORD OR THE DEFINITION OF
; LILOW.
MOVE CH,[XWD 1,2]
PUSHJ PP,PUTBIN
IFN TOPS20,<
TSWT FREENT
>
TDCA CH,CH
MOVSI CH,(1B2)
PUSHJ PP,PUTBIN
MOVEI CH,.JBOPS
PUSHJ PP,PUTBIN
TSWT FREENT
SKIPA CH,[XWD 140,FIXNUM+140]
MOVEI CH,0
PUSHJ PP,PUTBIN
;OUTPUT COMPILER VERSION NUMBER
MOVE CH,[1,,2] ;2 WORD DATA BLOCK
PUSHJ PP,PUTBIN
SETZ CH, ;NO RELOCATION
PUSHJ PP,PUTBIN
MOVEI CH,.JBVER ;LOCATION
PUSHJ PP,PUTBIN
MOVE CH,.JBVER ;VALUE
PUSHJ PP,PUTBIN
;PUT OUT A REFERENCE TO "LILOW."
;THIS WILL ONLY BE DONE FOR NON-REENTRANT MAIN PROGRAMS.
;CODE TO BE GENERATED IS:
; XWD 2,2
; EXP 0
; RADIX50 60,LILOW.
; EXP 0
;
; THIS WILL CAUSE ROUTINE LILOWS.MAC TO BE LOADED FROM LIBOL.REL
; THIS MODULE WILL DEFINE SYMBOLS FOR THE LIBOL DISPATCH TABLE
; IN ORDER TO RESOLVE EXTERNAL REFERENCES IN THE COBOL PROGRAM
IFE TOPS20,<
TSWF FREENT ;ARE WE GENERATING REENTRANT CODE?
>
IFN TOPS20,<
SKIPE RENSW ;EXPLICIT /R FOR TOPS-20
>
JRST INITL3 ;YES, DO NOTHING.
;GET HERE IF WE ARE GENERATING A ONE SEGMENT MAIN PROGRAM.
MOVE CH,[XWD 2,2] ;BLOCK TYPE 2(SYMBOLS),,TWO DATA WORDS.
PUSHJ PP,PUTBIN ;PUT IT IN THE REL FILE.
SETZI CH, ;NO RELOCATION.
PUSHJ PP,PUTBIN ;PUT IT IN THE REL FILE.
MOVE CH,[RADIX50 60,LILOW.] ;GLOBAL DEFINITION.
PUSHJ PP,PUTBIN ;PUT IT IN THE REL FILE.
SETZI CH,
PUSHJ PP,PUTBIN ;PUT IT IN THE REL FILE.
;FINISH UP INITIALIZATION
INITL3: MOVEI TA,(SIXBIT "AS1") ;SET UP FOR AS1FIL
HRRM TA,ASYFIL
HLLZS SW ;CLEAR SWITCHES
PUSHJ PP,HDROUT ;PUT OUT HEADING LINE
MOVE TA,RESDNT ;RESET CURRENT RELOCATION
MOVEM TA,CURREL
HRRZ TA,EXTLOC ;SET EXTERNAL LOCATIONS TO -1
ADDI TA,1
MOVE TB,EXTNXT
INITL4: HLLOS 1(TA)
ADDI TA,2
HLRZ TC,-1(TA) ;GET COUNT OF EXTRA WORDS
ANDI TC,7
HRLI TC,(TC)
ADD TA,TC ;ADD TO CTR-PTR
CAIG TA,(TB)
JRST INITL4
HRRZ TA,SECLOC ;SET SECTAB POINTER TO FIRST ENTRY LESS 1
ADDI TA,1
MOVEM TA,CURSEC
HLRZ TB,0(TA)
ADD TB,CURREL
SUB TB,INDELC## ;SECTAB ENTRIES ARE NOT UPDATED, SO FAKE IT
MOVEM TB,LITBAS
MOVEI TA,' 00'
MOVEM TA,DECSEG
SETOM TAGOUT ;SET TAGOUT TO -1
PUSHJ PP,DOSYM ;PUT OUT SYMBOLS
SWON FRELOC;
SETZB PC,DATGRP+2
PUSHJ PP,FIXED
JRST CLRDAT
;PUT OUT EXTERNAL REQUESTS TO ALL ITEMS IN EXTAB WHICH HAVE BEEN USED.
;SET UP XWD'S FOR THOSE ITEMS USED BY NON-RESIDENT SEGMENTS.
EXTOUT: MOVE OP,EXTLOC ;START AT TOP OF TABLE
TSWT FREENT;
ADD OP,[XWD NUMEXT,NUMEXT]
PUSHJ PP,CLRDAT ;INSURE DATGRP IS CLEAN
HRRZM PC,DATGRP+2 ;SET LOCATION IN DATGRP
EXTO1: CAMN OP,EXTNXT ;DONE?
JRST EXTO9 ;YES--EMPTY SYMGRP AND RETURN
AOBJP OP,EXTBAD ;NO--STEP UP TO NEXT ENTRY
SKIPL TB,1(OP) ;IS IT REFERENCED IN NON-RESIDENT SEGMENT?
JRST EXTO7 ;NO
;AN XWD IS REQUIRED
TLNN TB,NR.IND ;YES, BUT IS IT SPECIAL
TLZA TB,-1 ;NO--CLEAR LEFT HALF
HRLI TB,(@) ;YES, TURN ON INDIRECT BIT
TRC TB,-1 ;HAS IT BEEN REFERENCED YET?
TRCE TB,-1
JRST EXTO2 ;YES
MOVEI TA,1B33 ;MAKE EXTERNAL
TRZA TB,-1 ;NO--USE UNRELOCATED ZERO
EXTO2: MOVEI TA,1 ;YES--RELOCATE
HRRM PC,1(OP) ;RESET EXTAB
PUSHJ PP,PUTDAT
PUSHJ PP,CLRDAT ;INSURE THAT IT'S OUT BEFORE EXTERNAL REQUEST
TSWF FNOLST ;ANY OBJECT LISTING?
AOJA PC,EXTO7 ;NO, BUMP PROGRAM COUNTER
PUSHJ PP,LSTCOD ;YES--LIST PC AND ASSEMBLED CODE
;PUT OUT EXTERNAL REQUESTS (CONT'D).
MOVE TE,1(OP)
TLNE TE,NR.IND ;SPECIAL
SKIPA TE,[POINT 7,[ASCIZ "Z @"]]
MOVE TE,[POINT 7,[ASCIZ "XWD 0,"]]
PUSHJ PP,LSTMES
MOVE DT,OP
PUSHJ PP,LSTNAM ;PRINT EXTERNAL NAME
MOVEI CH,"#"
PUSHJ PP,PUTLST
MOVEI CH,"#"
PUSHJ PP,PUTLST
PUSHJ PP,STRTI9 ;BUMP PROGRAM COUNTER
EXTO7: AOBJP OP,EXTBAD ;STEP UP TO SECOND WORD
HRRZ TA,0(OP) ;ANY REFERENCE TO IT?
CAIN TA,-1
JRST EXTO8 ;NO
HLRZ TC,-1(OP)
ANDI TC,77777
ADD TC,NAMLOC
MOVE TC,1(TC)
PUSHJ PP,RADX50
LDB TB,[POINT 2,(OP),3] ;ENTRY POINT?
SKIPE TB
TLOA CH,040000 ;YES, GLOBAL DEFINITION
TLO CH,600000 ;NO, GLOBAL REQUEST
PUSHJ PP,PUTSYM
EXTO8: HLRZ TC,(OP) ;GET # OF EXTRA WORDS
ANDI TC,7
HRLI TC,(TC)
ADD OP,TC ;ADD TO CTR-PTR
JRST EXTO1
EXTO9: MOVEM PC,HPLOC
JRST CLRSYM
;EXTAB IS IMPROPERLY SET UP
EXTBAD: OUTSTR [ASCIZ "EXTNXT improperly set up
"]
JRST KILL
;PUT OUT ENTRY BLOCK AT START OF REL FILE
ENTBLK: SKIPN BINDEV ;ANY REL OUTPUT?
POPJ PP, ;NO
HRRZ OP,EXTLOC ;SET UP EXTAB PTR
ADDI OP,3
PUSHJ PP,CLREN2 ;SET UP DATGRP
ENTBL1: LDB TA,[POINT 2,1(OP),3] ;ENTRY POINT?
JUMPE TA,ENTBL2 ;NO
HLRZ TC,(OP) ;GET NAMTAB LINK
ANDI TC,77777
ADD TC,NAMLOC
MOVE TC,1(TC) ;GET SYMBOL
PUSHJ PP,RADX50 ;CONVERT TO RADIX50
MOVEM CH,(GP) ;STASH SYMBOL IN DATGRP
AOS DATGRP
AOBJN GP,ENTBL2 ;FILLED DATGRP?
PUSHJ PP,CLRENT ;YES, OUTPUT BLOCK
HRLZI TE,4 ;SET UP ENTRY BLOCK TYPE CODE
MOVEM TE,DATGRP
SETZM TE,DATGRP+1 ;CLR RELOCATION WORD
MOVE GP,[-^D18,,DATGRP+2] ;SET UP DATGRP PTR
ENTBL2: HLRZ TC,1(OP) ;GET COUNT OF EXTRA WORDS
ANDI TC,7
ADDI OP,2(TC) ;BUMP EXTAB PTR
MOVE TC,EXTNXT## ;AT END OF TABLE?
CAIG OP,(TC)
JRST ENTBL1 ;NO
CLRENT: HRRZ TE,DATGRP ;GET BLOCK COUNT
JUMPE TE,CPOPJ ;EXIT IF NONE THERE
MOVNI TE,2(TE)
HRLI TE,(TE)
HRRI TE,DATGRP
CLREN1: MOVE CH,(TE)
PUSHJ PP,PUTBIN
AOBJN TE,CLREN1
CLREN2: HRLZI TE,4 ;SET UP ENTRY BLOCK TYPE CODE
MOVEM TE,DATGRP
SETZM TE,DATGRP+1 ;CLR RELOCATION WORD
MOVE GP,[-^D18,,DATGRP+2] ;SET UP DATGRP PTR
POPJ PP,
;PUT OUT END BLOCK.
;REENTRANT PROGRAMS HAVE HIGH-BREAK FOLLOWED BY LOW-BREAK.
;NON-REENTRANT PROGRAMS HAVE LOW-BREAK FOLLOWED BY ABSOLUTE BREAK.
;[74] ALSO PUT OUT BLOCK TYPE 12 ITEM 1 TO LINK ALL ENTRY POINTS
ENDBLK:
IFN ANS74,<
MOVE CH,[12,,2]
PUSHJ PP,PUTBIN
MOVSI CH,(1B3)
PUSHJ PP,PUTBIN
MOVEI CH,1 ;ASSUME SUBPROGRAM
SKIPN SLASHJ ;FORCED START ADDRESS
SKIPN SUBPRG ;NO, THIS A SUBPROGRAM?
MOVN CH,CH ;NO, MAIN PROGRAM, SO MAKE HEAD
PUSHJ PP,PUTBIN
MOVE CH,PRGENT ;GET MAIN ENTRY POINT
SUBI CH,3 ;BACKUP TO LINK WORD
ADD CH,RESDNT ;ADD IN BASE
PUSHJ PP,PUTBIN ;OUTPUT LINK ADDRESS
>
MOVE CH,[XWD 5,2] ;BLOCK TYPE AND COUNT
PUSHJ PP,PUTBIN
MOVSI CH,(4B3) ;RELOCATION IF NON-REENTRANT
TSWF FREENT
TLO CH,(1B3) ;RELOCATION FOR LOW-BREAK
PUSHJ PP,PUTBIN
TSWF FREENT ;IF RE-ENTRANT,
SKIPA CH,HPLOC ; USE HIGH-BREAK,
MOVE CH,END.PC ; ELSE USE LOW-BREAK
PUSHJ PP,PUTBIN
TSWF FREENT ;IF RE-ENTRANT
SKIPA CH,END.PC ; USE LOW-BREAK,
MOVEI CH,COMSIZ+140 ; ELSE USE COMMON BREAK
JRST PUTBIN
;LIST AN INSTRUCTION SET UP BY INITIALIZER
LISTIT: TSWF FNOLST;
POPJ PP,
PUSH PP,TE
PUSHJ PP,LSTCOD
POP PP,TE
ILDB CH,TE ;REPLACE TAB IN LINE WITH
DPB CH,LSTBH+1 ; FIRST CHARACTER OF TEXT
JRST LSTMES
;SET UP FOR OVERLAY OUTPUT FILE
SETOVR: SKIPN BINDEV ;ANY BINARY?
POPJ PP, ;NO--FORGET IT
PUSHJ PP,CLRDAT ;YES--CLEAR OUT DATA
PUSHJ PP,ENDBLK ;PUT OUT END BLOCK
RELEASE BIN, ;CLOSE OUT OLD FILE
MOVE TE,BINDEV ;IS BINARY GOING TO DISK?
CALLI TE,$DEVCH
MOVSI TD,(SIXBIT "DSK")
TLNN TE,$DSK
MOVEM TD,BINDEV ;NO--JAM "DSK" AS OUTPUT DEVICE
MOVEI TE,14
MOVE TD,BINDEV
MOVSI TC,BINBH
OPEN BIN,TE
JRST SETOV8
MOVE TE,BINHDR
MOVSI TD,(SIXBIT "OVR")
SETZM TC
MOVE TB,BINPP
ENTER BIN,TE
JRST SETOV8
MOVE TE,BINBUF
MOVEM TE,.JBFF
OUTBUF BIN,2
MOVEI TE,^D256
MOVEI CH,0
PUSHJ PP,PUTBIN
SOJG TE,.-2
MOVEI TE,600
MOVEM TE,OVRWRD
MOVE TA,LITLOC
HRRZM TA,CURLIT
MOVS TE,TA
HRRI TE,1(TA)
SETZM (TA)
BLT TE,^D255(TA)
JRST PDAT7
;TROUBLE INTIALIZING DEVICE
SETOV8: OUTSTR [ASCIZ "?Cannot initialize overlay file
"]
SETZM BINDEV
POPJ PP,
;PUT ENTRY INTO OVERLAY DIRECTORY (RESIDING IN LITAB).
;ENTER WITH DT POINTING TO NEXT SECTION ENTRY IN PROTAB.
RESOVR: HRRZ TE,LITLOC
CAMN TE,CURLIT
JRST RESOV1
SUB PC,NONRES
MOVE TE,CURLIT
MOVNM PC,1(TE)
RESOV1: LDB TE,PTSEGN
MOVE TC,TE
LSH TE,1
ADD TE,LITLOC
HRRZM TE,CURLIT
MOVE TD,OVRWRD
MOVEM TD,0(TE)
CAIGE TC,^D50
POPJ PP,
HRRZ TE,LITLOC
ADDI TE,^D200-^D50(TC)
MOVE TD,CURSEC
MOVE TC,1(TD)
ADD TC,NONRES
MOVSM TC,0(TE)
POPJ PP,
;COPY LITAB TO OVERLAY FILE DIRECTORY
CLROVR: SKIPN BINDEV
POPJ PP,
SUB PC,NONRES
MOVE TE,CURLIT
MOVNM PC,1(TE)
CLOSE BIN,
MOVE TD,BINHDR
MOVSI TC,(SIXBIT "OVR")
MOVEI TB,0
MOVE TA,BINPP
LOOKUP BIN,TD
JRST CLROV5
MOVE TA,BINPP
ENTER BIN,TD
JRST CLROV6
MOVSI TD,-^D256
HRR TD,LITLOC
CLROV4: MOVE CH,(TD)
PUSHJ PP,PUTBIN
AOBJN TD,CLROV4
POPJ PP,
CLROV5: outstr [ASCIZ "?Monitor error--could't find OVR file after closing
"]
POPJ PP,
CLROV6: OUTSTR [ASCIZ "?Monitor error--couldn't update OVR file
"]
POPJ PP,
SUBTTL FINAL SUMMARY FOR COMPILATION
;PRINT OUT TIMES FOR PHASES
IFN DEBUG,<EXTERN %ATIME,%GTIME,TOPLOC,IMPURE,FREESP
EXTERN NAMCT1,NAMCT2,NAMCT3,NAMDIS,DISTSZ,%RTIME,%RGTIM
IFE ONESEG,<EXTERN %TTIME>
SUMARY: TSWF FNOLST ;ANY LISTING?
POPJ PP, ;NO--QUIT
MOVEI TA,0
CALLI TA,$RTIME
MOVEM TA,%RGTIM+1
CALLI CP,$TIME
MOVEM CP,%GTIME+1
MOVSI TE,(ASCIZ "S")
MOVEM TE,HDRPAG
SETZM SUBPAG
SETZM PAGCNT
PUSHJ PP,HDROUT
MOVE TE,[POINT 7,[ASCIZ "Checkout summary
Elapsed CP
"]]
PUSHJ PP,LSTMES
MOVEI TA,%ATIME
MOVEI TB,"A"
IFE ONESEG,<
SETZM %TTIME
>
SETZM %RTIME
TIMLUP: SKIPN OPTSW## ;DID WE CALL OPTIMIZER?
JRST TIMLP1 ;NO, SKIP CHECKING CODE
CAIN TB,"P" ;DID WE DO "O" LAST?
JRST [MOVEI TB,"F" ;YES- DO "F" NOW
JRST TIMLP2]
CAIN TB,"F" ;DID WE DO "E" LAST?
MOVEI TB,"O" ;YES--DO "O" NOW
JRST TIMLP2
TIMLP1: CAIN TB,"F" ;AT "F"?
ADDI TA,4 ;YES--SKIP PHASE O TIMES
TIMLP2: MOVE CH,TB ;PUT OUT PHASE IDENTIFICATION
PUSHJ PP,PUTLST
ADDI TB,1
MOVEI CH," "
PUSHJ PP,PUTLST
PUSHJ PP,PUTLST
MOVE TE,1(TA) ;COMPUTE RUN TIME
SUB TE,0(TA)
IFE ONESEG,<
ADDM TE,%TTIME ;KEEP A RUNNING TOTAL
>
PUSHJ PP,TIMOUT ;PRINT IT
MOVEI CH,11
PUSHJ PP,PUTLST
MOVE TE,3(TA) ;COMPUTE CP TIME
SUB TE,2(TA)
ADDM TE,%RTIME ;ACCUMULATE IT
PUSHJ PP,TIMOUT
PUSHJ PP,LCRLF
ADDI TA,4
CAIG TA,%GTIME ;DONE?
JRST TIMLUP ;NO--LOOP
;FINAL SUMMARY FOR COMPILATION (CONT'D)
;PRINT OUT TIMES FOR PHASES (CONT'D)
MOVE TE,[POINT 7,[ASCIZ "
Total elapsed"]]
PUSHJ PP,LSTMES
MOVE TE,CP
SUB TE,%ATIME
PUSHJ PP,TIMOUT
IFE ONESEG,<
MOVE TE,[POINT 7,[ASCIZ ", not including GETSEG"]]
PUSHJ PP,LSTMES
MOVE TE,%TTIME
PUSHJ PP,TIMOUT
>
MOVE TE,[POINT 7,[ASCIZ ", CP time"]]
PUSHJ PP,LSTMES
MOVE TE,%RTIME
PUSHJ PP,TIMOUT
PUSHJ PP,LCRLF
;FINAL SUMMARY FOR COMPILATION (CONT'D)
;PRINT OUT SIZE OF IMPURE AREA
MOVE TE,[POINT 7,[ASCIZ "
Impure size: "]]
PUSHJ PP,LSTMES
HRRZ TE,TOPLOC
SUBI TE,IMPURE-140
PUSHJ PP,TABD2
MOVE TE,[POINT 7,[ASCIZ "
Free storage:"]]
PUSHJ PP,LSTMES
HLRZ TE,FREESP
PUSHJ PP,TABD2
;FINAL SUMMARY FOR COMPILATION (CONT'D)
;PRINT OUT TABLE USAGE.
MOVE TE,[POINT 7,[ASCIZ "
Orig Final Used
"]]
PUSHJ PP,LSTMES
MOVE TB,TABDX
TABD1: MOVE TA,(TB) ;PICK UP TABLE NAME
PUSHJ PP,SIXOUT ;PRINT IT
MOVEI CH,11
PUSHJ PP,PUTLST
HLRZ TE,1(TB) ;PRINT ORIGINAL SIZE
CAIN TE,1 ;IF 1, REALLY ZERO
MOVEI TE,0
PUSH PP,TE ;SAVE IT
PUSHJ PP,TABD2
MOVE TC,1(TB) ;PRINT FINAL SIZE
HLRE TE,(TC)
MOVMS TE
MOVEI CH," "
PUSHJ PP,PUTLST
POP PP,TD ;SAME SIZE AS ORIGINAL?
CAMN TE,TD
PUSHJ PP,TABD6 ;YES--PRINT SPACES AND SKIP
PUSHJ PP,TABD2
HRRZ TE,1(TC) ;PRINT SIZE USED (MNE'NXT - MNE'LOC)
HRRZ TD,0(TC)
SUB TE,TD
MOVEI CH," "
PUSHJ PP,PUTLST
PUSHJ PP,TABD2
PUSHJ PP,LCRLF
ADDI TB,1
AOBJN TB,TABD1 ;LOOP UNTIL DONE
;FINAL SUMMARY FOR COMPILATION (CONT'D)
;PRINT OUT NAMTAB PARAMETERS AND BASE LOCATIONS
PUSHJ PP,LCRLF
PUSHJ PP,LCRLF
REPEAT 0,<
MOVE TE,[POINT 7,[ASCIZ "
SEARCH DISTRIBUTION
"]]
PUSHJ PP,LSTMES
MOVEI TA,1
NAMCTB: MOVEI CH," "
CAIN TA,DISTSZ
MOVEI CH,76 ;"GREATER THAN"
PUSHJ PP,PUTLST
MOVEI TE,(TA)
CAIN TE,DISTSZ
SUBI TE,1
PUSHJ PP,DECIT
MOVEI CH,"-"
PUSHJ PP,PUTLST
MOVE TE,NAMDIS-1(TA)
PUSHJ PP,DECIT
PUSHJ PP,LCRLF
CAIE TA,DISTSZ
AOJA TA,NAMCTB
>
JRST BASLS0
;FINAL SUMMARY FOR COMPILATION (CONT'D).
DEFINE BASES,<
XLIST
BASLOC NAMCT1,1
BASLOC NAMCT2,1
BASLOC NAMCT3,1
BASLOC TEMBAS,0
BASLOC DATBAS,0
BASLOC FILTBL,0
BASLOC USEBAS,0
BASLOC IMPPAR,0
BASLOC A50BAS,0
BASLOC RESDNT,0
BASLOC NONRES,0
LIST>
DEFINE BASLOC (X,Y),<
XWD Y*40,X
SIXBIT "X"
>
BASLST: BASES;
BASXWD: XWD <BASLST-.>/2,BASLST
BASLS0: PUSHJ PP,LCRLF
MOVE TB,BASXWD
BASLS1: MOVE TA,1(TB)
PUSHJ PP,SIXOUT
MOVEI CH,11
PUSHJ PP,PUTLST
MOVE TE,@0(TB)
MOVE TA,0(TB)
TLNE TA,-40
JRST BASLS4
MOVE TA,[POINT 3,TE,17]
BASLS2: ILDB CH,TA
ADDI CH,"0"
PUSHJ PP,PUTLST
TLNE TA,770000
JRST BASLS2
BASLS3: PUSHJ PP,LCRLF
ADDI TB,1
AOBJN TB,BASLS1
PJRST PRNTAG ;GO PRINT OUT TAG TABLE
BASLS4: PUSHJ PP,DECIT
JRST BASLS3
;FINAL SUMMARY FOR COMPILATION (CONT'D)
;PRINT OUT TABLE USAGE (CONT'D)
TABD2: MOVEI CT,SIZED
IDIVI TE,12 ;CONVERT TO 5 DECIMAL DIGITS
PUSH PP,TD
SOJG CT,.-2
MOVEI CT,SIZED-1
JUMPE TE,.+4 ;MORE THAN 5 DIGITS?
IDIVI TE,12 ;YES--KEEP CONVERTING
PUSH PP,TD
AOJA CT,.-3
MOVEI CH," "
PUSHJ PP,PUTLST
TABD3: POP PP,TE ;SUPPRESS LEADING ZEROES
JUMPN TE,TABD5
PUSHJ PP,PUTLST
SOJG CT,TABD3
TABD4: POP PP,TE ;PRINT OUT SIGNIFICANT DIGITS
TABD5: MOVEI CH,"0"(TE)
PUSHJ PP,PUTLST
SOJGE CT,TABD4
POPJ PP,
;PRINT OUT SIX SPACES AND SKIP UPON EXITING
TABD6: AOS (PP)
MOVEI CT,SIZED+1
MOVEI CH," "
PUSHJ PP,PUTLST
SOJG CT,.-1
POPJ PP,
;FINAL SUMMARY FOR COMPILATION (CONT'D)
;PRINT TAGTAB STATISTICS
PRNTAG: TSWT FOBJEC ;ANY OBJECT LISTING?
POPJ PP, ;NO, NO TAG TABLE EITHER
SKIPN TAGCNT## ;ANY TAGS USED
JRST NOTAGS ;NONE???
PUSHJ PP,HDROUT ;START NEW PAGE
MOVEI TB,LINPAG##-3 ;NO. OF LINES LEFT ON FIRST PAGE
SETZM TAGOFF## ;OFFSET FOR FIRST COLUMN
MOVEM TB,TAGOFF+1 ;OFFSET FOR SECOND COLUMN
ADD TB,TB
MOVEM TB,TAGOFF+2 ;OFFSET FOR THIRD COLUMN
MOVE TA,TAGCNT ;GET NUMBER OF TAGS
HRRZ CH,TAGLOC## ;GET BASE OF TAG TABLE
CAILE TA,LINPAG-3 ;FIT IN ONE COLUMN?
SKIPA TB,[EXP 3-LINPAG] ;NO
MOVN TB,TA ;YES
ADD TA,TB ;WHATS LEFT
HRL TB,CH ;START AT FRONT
MOVSM TB,TAGCOL## ;FIRST AOBJN WORD
CAILE TA,LINPAG-3
SKIPA TB,[EXP 3-LINPAG]
MOVN TB,TA
ADD TA,TB
HRLI TB,LINPAG-3 ;OFFSET
MOVSM TB,TAGCOL+1 ;SECOND AOBJN WORD
ADDM CH,TAGCOL+1 ;ADD IN BASE
CAILE TA,LINPAG-3
SKIPA TB,[EXP 3-LINPAG]
MOVN TB,TA
ADD TA,TB
HRLI TB,<LINPAG-3>*2
MOVSM TB,TAGCOL+2 ;THIRD AOBJN WORD
ADDM CH,TAGCOL+2 ;ADD IN BASE
MOVEM TA,TAGLFT## ;STORE # OF TAGS LEFT AFTER THIS PAGE DONE
MOVE TE,[POINT 7,[ASCIZ "TAG table:
(TAG) (Ref. count) (PC) (TAG) (Ref. count) (PC) (TAG) (Ref. count) (PC)
"]]
PUSHJ PP,LSTMES
MOVNI TA,2
ADDM TA,PAGCNT## ;GET COUNT RIGHT
SETZ TB, ;TB= TAG NUMBER
PRNTG0: MOVSI TA,-3 ;AOBJN POINTER TO THE AOBJN POINTERS
PRNTG1: MOVEI CH,"%"
PUSHJ PP,PUTLST
MOVEI TE,0(TB) ;PRINT TAG #
ADD TE,TAGOFF##(TA) ;ADD IN OFFSET
PUSHJ PP,PRTDEC
MOVEI CH,11 ;TAB
PUSHJ PP,PUTLST
HRRZ TE,TAGCOL(TA) ;GET RIGHT PART OF TABLE
LDB TE,[POINT 15,(TE),17] ;PRINT REF. COUNT
PUSHJ PP,PRTDEC
MOVEI CH,11
PUSHJ PP,PUTLST
HRRZ TD,TAGCOL(TA)
MOVE TD,(TD)
TLNE TD,(1B0) ;
JRST PRINDT ;"INDIRECT REFERENCE"
HRRZ TE,TD ;PRINT PC
ADD TE,RESDNT ;ADD IN BASE OF RESIDENT SECTION
PUSHJ PP,PRTOCT
PRNTG2: HLRE TE,TA ;PRINT SEPARATOR
AOJE TE,PRNTG3 ;UNLESS LAST COLUMN
MOVE TE,[POINT 7,[ASCIZ / /]] ;4 TABS
PUSHJ PP,LSTMES
PRNTG3: AOBJP TA,PRNTG4 ;DONE WITH THIS ROW?
SKIPGE TAGCOL(TA) ;NO, IS NEXT COLUMN STILL VALID
JRST PRNTG1 ;YES, DO IT
PRNTG4: PUSHJ PP,LCRLF ;<CRLF>
ADDI TB,1 ;NEXT TAG
MOVE CH,[1,,1]
ADDM CH,TAGCOL+1 ;ADVANCE THE POINTERS
ADDM CH,TAGCOL+2
ADDB CH,TAGCOL
JUMPL CH,PRNTG0 ;STILL MORE TO DO ON THIS PAGE
SKIPG TAGLFT ;MORE TO DO?
POPJ PP, ;NO, DONE
ADD TB,TAGOFF+2 ;ADVANCE TAG # BY THREE AREAS
MOVEI TE,LINPAG
MOVEM TE,TAGOFF+1 ;REST OF PAGES ARE LARGER
ADD TE,TE
MOVEM TE,TAGOFF+2
MOVE TE,TAGCOL+2 ;THIS IS NEW BASE
HRRM TE,TAGCOL
ADDI TE,LINPAG
HRRM TE,TAGCOL+1
ADDI TE,LINPAG
HRRM TE,TAGCOL+2
MOVE TA,TAGLFT ;GET WHATS LEFT
CAILE TA,LINPAG ;FIT ON ONE PAGE?
SKIPA TE,[EXP -LINPAG]
MOVN TE,TA ;YES
ADD TA,TE
HRLM TE,TAGCOL ;NEW FIRST AOBJN POINTER
CAILE TA,LINPAG
SKIPA TE,[EXP -LINPAG]
MOVN TE,TA
ADD TA,TE
HRLM TE,TAGCOL+1 ;SECOND WORD
CAILE TA,LINPAG
SKIPA TE,[EXP -LINPAG]
MOVN TE,TA
ADD TA,TE
HRLM TE,TAGCOL+2
MOVEM TA,TAGLFT ;IN CASE NO DONE
JRST PRNTG0 ;START AGAIN
PRINDT: TRC TD,AS.PRO
TRZE TD,700000 ;SKIP IF A PARAGRAPH REF
JRST PRNTG5
HRRZ DT,PROLOC
ADDI DT,(TD)
PUSH PP,TA
PUSH PP,TB
PUSHJ PP,LSTNAM ;LIST PARAGRAPH NAME
POP PP,TB
POP PP,TA
HLRE CH,TA ;PRINT SEPARATOR
AOJE CH,PRNTG3 ;UNLESS LAST COLUMN
IDIVI TE,7 ;GET NO. OF TAB STOPS ALREADY PASSED
SUBI TE,5 ;NO. WE NEED
JUMPN TE+1,.+3 ;ONE TIME LESS IF NOT EXACT NUMBER
MOVEI CH,11
PUSHJ PP,PUTLST
AOJL TE,.-2 ;LOOP UNTIL ENOUGH
JRST PRNTG3
PRNTG5: MOVEI CH,"%"
PUSHJ PP,PUTLST
HRRZ TE,TD ;GET TAG NUMBER
PUSHJ PP,PRTDEC
JRST PRNTG2
NOTAGS: MOVE TE,[POINT 7,[ASCIZ "
[TAGTAB found empty]
"]]
PJRST LSTMES
;FINAL SUMMARY FOR COMPILATION (CONT'D)
;PRINT ELAPSED TIME
;ENTER WITH TIME IN "TE".
TIMOUT: ADDI TE,5 ;ROUND UP 5 MILS
IDIVI TE,^D1000 ;CONVERT TO SECONDS
MOVEI TC,(TD) ;SAVE REMAINDER ROUNDED
PUSHJ PP,TABD2 ;PRINT SECONDS
MOVEI CH,"." ;PRINT FRACTIONS OF A SECOND
PUSHJ PP,PUTLST
MOVE TE,TC
IDIVI TE,^D100
MOVEI CH,"0"(TE)
PUSHJ PP,PUTLST
MOVE TE,TD
IDIVI TE,^D10
MOVEI CH,"0"(TE)
JRST PUTLST
;TABLE OF TABLES
DEFINE TABSET (A,B,C,E,F,G,H),<
EXTERNAL A'LOC
SIXBIT "E"
XWD ^D'B+1,A'LOC>
TABDT: TABLES
TABDX: XWD <TABDT-.>/2,TABDT
> ;END OF "IFN DEBUG" FOR SUMMARY
SUBTTL SYMBOL TABLE DUMPER
;SET TO APPEND TO REL FILE IF AN OVERLAY FILE WAS WRITTEN, ELSE
;JUST CONTINUE WRITING ON CURRENT BIN DEVICE.
DOSYM: MOVE PC,HILOC
MOVEM PC,END.PC
SKIPE BINDEV
SKIPE PRODSW ;IF THIS IS FOR PRODUCTION,
JRST DOSYM9 ; WE DON'T NEED TABLES
;IF DEBUG MODE IS WANTED CHECK TO SEE IF WE HAVE ANY FAKE CD DATABS TO FIXUP
IFN ANS74,<
IFN MCS!TCS,<
SKIPN DEBSW## ;NEED DEBUG CODE?
JRST NODEB ;NO
MOVEI TA,1
MOVEM TA,CURCD## ;INITIALIZE LOOP
JRST DBLOOP
DBTST: MOVEI TA,SZ.CD ;GET SIZE OF TABLE
ADDB TA,CURCD ;INCREMENT SAFE COUNTER
DBLOOP: ADD TA,CDLOC##
HRRZ TA,TA
HRRZ TB,CDNXT##
CAIL TA,(TB) ;STILL IN TABLE?
JRST NODEB ;NO, ALL DONE
LDB TA,CD.FDL## ;DEBUGGING ON THIS CD-NAME
JUMPE TA,DBTST ;NO
PUSH PP,TA ;SAVE LINK
PUSHJ PP,LNKSET ;GET FAKE DATAB ADDRESS
LDB TA,DA.NAM## ;GET NAMTAB LINK
ADD TA,NAMLOC
POP PP,(TA) ;STORE LINK TO DATAB
JRST DBTST ;LOOP FOR ALL CDTAB
NODEB:>>
;INITIALIZE DATGRP AND GET SYMBOL PC
MOVEI TE,37
MOVEM TE,BLKTYP
PUSHJ PP,PDATI
MOVE PC,END.PC
MOVEM PC,DATGRP+2
MOVEM PC,NM.PC ;SAVE NAMTAB VALUE
PUSHJ PP,PUTZER ;WRITE ZERO IN FILE
PUSHJ PP,TABFIX ;FIX UP TABLES AND PUT OUT NAMTAB
MOVEM PC,DT.PC ;SAVE PNTR TO DATAB
PUSHJ PP,PUTZER ;ZEROTH WORD OF TABLE
PUSHJ PP,DODAT ;PUT OUT DATAB
MOVEM PC,PR.PC ;SAVE PNTR TO PROTAB
PUSHJ PP,PUTZER ;...
PUSHJ PP,DOPRO ;PUT OUT PROTAB
HRRI TA,-1(PC) ;SAVE ADDRESS OF THE LAST
HRLM TA,DT.PC ; ADDRESS IN THE USER'S PROGRAM.
MOVEM PC,%ES.PC
PUSHJ PP,CLRDAT
MOVEI TE,1
MOVEM TE,BLKTYP
JRST PDATI
DOSYM9: SETZM NM.PC##
SETZM DT.PC##
SETZM PR.PC##
POPJ PP,
;HERE TO PUT OUT DATAB
DODAT: MOVE DT,DATLOC
DODAT1: CAML DT,DATNXT
POPJ PP, ;NO MORE - RETURN
MOVEI TA,0
MOVE TB,1(DT) ;DUMP FIRST WORD
HRL TB,4(DT) ;PICK UP ADJUSTED NAMTAB LINK
HLLZS 4(DT) ;CLEAR RPWTAB LINK
PUSHJ PP,PUTDAT
HRRZI TA,1(DT) ;ITEM IN LINKAGE SECTION?
LDB TB,DA.LKS##
JUMPE TB,DODAT0 ;NO
LDB TC,DA.LVL## ;GET LEVEL #
MOVEI TA,2 ;YES, RELOCATE LEFT HALF (LINK PTR)
HLRZ TB,2(DT)
ADD TB,IMPPAR## ;BASE OF %PARAM
HRLZI TB,(TB)
CAIE TC,01 ;LEVEL 01 OR 77?
CAIN TC,77
MOVEM TB,CURHLD## ;YES, SAVE PTR
MOVE TB,CURHLD ;NO, GET PTR TO 01 LEVEL
HRR TB,2(DT) ;KEEP RH ABSOLUTE OFFSET
JRST DODAT5
DODAT0: MOVEI TA,1 ;RELOCATE 2ND WORD
MOVE TB,2(DT)
ADD TB,DATBAS
DODAT5: PUSHJ PP,PUTDAT
ADDI PC,2 ;ACCOUNT FOR THEM
MOVEI W1,5 ;ASSUME 5 WORDS ADDITIONAL
MOVEI TA,1(DT)
;IF THE FATHER IS A FILENAME, CHANGE THE FILTAB POINTER TO THE FILE NUMBER,
; SO COBDDT CAN DO JUSTIFICATION.
LDB TA,DA.POP ;GET FATHER
JUMPE TA,DODT5A ; NO FATHER, JUMP
LDB TC,LNKCOD ;IS IT A FILENAME?
CAIE TC,CD.FIL
JRST DODT5A ;NO, LEAVE AS IS
ADD TA,FILLOC## ;LOOK AT FILTAB ENTRY
LDB TD,FI.NUM## ;GET NUMBER OF THE FILE
MOVEI TA,1(DT) ;STORE IN DATAB ENTRY
DPB TD,DA.POP ; IN PLACE OF THE FILTAB ADDRESS
;SEE IF ITEM HAS PICTURE WORDS
DODT5A: MOVEI TA,1(DT)
LDB TD,DA.PWA
JUMPE TD,DODAT2
MOVEI W1,DA.EDW+4-2
LDB TE,DA.KEY ;ACCOUNT FOR ANY
ADD W1,TE ; KEYS
JRST DODAT3
;SEE IF ITEM IS SUBSCRIPTED
DODAT2: LDB TD,DA.SUB ;IS FIELD SUBSCRIPTED?
JUMPE TD,DODAT4 ;NO
ADDI W1,2 ;YES--ACCOUNT FOR 2 MORE WORDS
DODAT3: MOVEI TE,0
DPB TE,DA.DEP
DODAT4: ADD PC,W1 ;ACCOUNT FOR REST OF ENTRY
HRRZI TC,3(DT)
ADDI W1,1
HRLS W1
ADD DT,W1
MOVNI W1,-1(W1)
HRL TC,W1
MOVEI TA,0
MOVE TB,(TC)
PUSHJ PP,PUTDAT
AOBJN TC,.-2
AOBJN DT,DODAT1
;HERE TO PUT OUT PROTAB
DOPRO: MOVE DT,PROLOC
DOPRO1: CAML DT,PRONXT
POPJ PP, ;EXIT WHEN DONE
MOVEI TA,0 ;PUT OUT FIRST WORD
MOVE TB,1(DT)
HRL TB,4(DT)
IFN ANS74,<
;FIX LINK TO PROTAB FOR SAME NAME POINTER
HRRZ TE,TB ;GET LINK TO SAME NAME
TRZ TE,700000 ;GET RID OF BITS
IDIVI TE,SZ.PRO
IMULI TE,SZ.PR6
ADD TE,TD ;ADD BACK IN THE REMAINDER
DPB TE,[POINT 15,TB,35]
>;END IFN ANS74
PUSHJ PP,PUTDAT
MOVEI TA,1 ;PUT OUT SECOND WORD
MOVE TB,2(DT)
IFN ANS74,< ;FIX POINTER TO SECTION
HLRZ TE,TB ;GET COMPILER'S PROTAB POINTER
TRZ TE,700000 ;GET PROTAB OFFSET
IDIVI TE,SZ.PRO ; FIND COMPILER ENTRY NUMBER
IMULI TE,SZ.PR6 ; FIND LIBOL ENTRY OFFSET
ADD TE,TD ;ADD INCREMENT (SHOULD BE 1)
DPB TE,[POINT 15,TB,17] ;PUT BACK IN TB
>;END IFN ANS74
LDB TE,[POINT 7,3(DT),24]
JUMPN TE,DOPRO2
ADD TB,RESDNT
JRST DOPRO3
DOPRO2: ADD TB,NONRES
DOPRO3: PUSHJ PP,PUTDAT
MOVEI TA,0 ;PUT OUT THIRD WORD
MOVE TB,3(DT)
PUSHJ PP,PUTDAT
IFN ANS68,<
SETZB TA,TB ;PUT OUT ZERO FOR FOURTH WORD
PUSHJ PP,PUTDAT
>
IFN ANS74,<
HRRZ TA,4(DT) ;GET FLOTAB LINK
ADD TA,FLOLOC##
LDB TB,FL.LN## ;GET LINE#
SETZ TA,
PUSHJ PP,PUTDAT ;PUT OUT LINE# AS FOURTH WORD
>
ADDI PC,SZ.PR6 ;INCREMENT BY SIZE OF ENTRY
ADD DT,[SZ.PRO,,SZ.PRO]
JRST DOPRO1 ;LOOP
;HERE TO FIX UP NAMTAB PNTRS AND DUMP CONDENSED NAMTAB
TABFIX: MOVE OP,NM2LOC
MOVEI CT,1 ;INIT OFFSET IN NAMTAB
TABFX1: SKIPN TB,0(OP)
JRST TABFX7
ADD TB,NAMLOC
HRRZ TA,0(TB)
JUMPE TA,TABFX6 ;SKIP ENTRY IF NO POINTER
MOVE W1,TB ;SAVE PNTR TO ENTRY
PUSHJ PP,TABFX9 ;GET FIRST DATAB OR PROTAB LINK
JUMPE TA,TABFX6 ;IF NONE, FORGET IT
HRRM W2,0(W1) ;RESET LINK IN NAMTAB
TABFX2: HRRM CT,3(TA) ;SAVE NAMTAB LINK IN ITEM
HRRZ TA,0(TA) ;GET 'SAME NAME' LINK
JUMPE TA,TABFX5 ;IF NONE, WE ARE DONE WITH THIS NAME
PUSHJ PP,TABFX9 ;GO TO NEXT DATAB OR PROTAB ENTRY
JUMPN TA,TABFX2 ;LOOP IF ONE FOUND
TABFX5: HRRZ DT,NAMLOC
ADD DT,0(OP)
HRRZ TA,0(DT)
JUMPE TA,TABFX6 ;JUST SKIP IF NOTHING LEFT
HLLM DT,0(DT) ;STORE SIZE
HLRZ TA,DT
ADDI CT,1(TA) ;UPDATE NAMTAB OFFSET
MOVNI TA,1(TA)
HRL DT,TA ;FORM AOBJN WORD
MOVEI TA,0
MOVE TB,0(DT)
PUSHJ PP,PUTDAT
AOBJN DT,.-2
TABFX6: AOJA OP,TABFX1
HRL DT,TA ;FORM AOBJN WORD TO DATA ITEM
TABFX7: ADDI PC,-1(CT) ;UPDATE PC
PUTZER: SETZB TA,TB
PUSHJ PP,PUTDAT ;WRITE 0 IN FILE
AOJA PC,CPOPJ ;RETURN
;FIND NEXT DATAB OR PROTAB ENTRY
TABFX9: MOVE W2,TA ;SAVE THE LINK
LDB TC,LNKCOD ;GET TABLE TYPE
JUMPE TC,TBFX9A ;IF ZERO, FORGET IT
PUSHJ PP,LNKSET ;CONVERT LINK TO ADDRESS
IFN ANS68,<
CAIE TC,TB.DAT ;IF DATAB
CAIN TC,TB.PRO ; OR PROTAB
POPJ PP, ; WE WIN
>
IFN ANS74,<
CAIN TC,TB.DAT ;IF DATAB
POPJ PP, ; WE WIN
CAIE TC,TB.PRO ; OR PROTAB
JRST TBFX9B ; NO, WE LOSE
PUSH PP,W2+1 ;WE NEED NEXT ACC TO HOLD REMAINDER (OF 1)
ANDI W2,077777 ;ONLY THE TABLE OFFSET
IDIVI W2,SZ.PRO ;CONVERT FROM 5 WORDS
IMULI W2,SZ.PR6 ;TO 4 WORDS
ADD W2,W2+1 ;PLUS 1
POP PP,W2+1
TRO W2,TB.PRO*100000
POPJ PP, ; WE WIN
TBFX9B:>
HRRZ TA,0(TA) ;IF 'SAME NAME' LINK IS NON-ZERO,
JUMPN TA,TABFX9 ; TRY THAT ONE,
POPJ PP, ; ELSE QUIT
TBFX9A: MOVEI TA,0
POPJ PP,
SUBTTL PRODUCE CREF LISTING
CREF: MOVSI TE,(ASCIZ "C")
MOVEM TE,HDRPAG
SETZM SUBPAG
SETZM PAGCNT
MOVEM PP,CRFERA
MOVE TA,CRFBUF
MOVEM TA,.JBFF##
INBUF CRF,2
MOVE TD,CRFHDR
MOVE TC,CRFHDR+1
SETZB TB,TA
LOOKUP CRF,TD
JRST KNOCRF
MOVE TE,CRFLOC## ;SET JOBFF TO BE AT
HRRM TE,.JBFF ; CRFTAB
PUSHJ PP,PSORT ;SET UP SORT
CREF04: MOVE TE,[XWD -6,GCREFN-1]
CREF4A: PUSHJ PP,GETCRF ;GET CREF WORD
JRST CREF10 ;NO MORE, GO DO MERGE
AOBJP TE,CREF05
TLC CH,1B18
MOVEM CH,(TE)
JRST CREF4A
CREF05: TLZ CH,377774 ;GET RID OF SOME CRUD
TLC CH,1B18 ;REVERSE 'DEFINITION' FLAG SO THAT DEFINITION
; OF ITEM SORTS BEFORE NON-DEFINITION
ROT CH,^D11 ;GET LINE NUMBER INTO LEFT HALF
MOVEM CH,(TE)
LDB TE,[POINT 6,GCREFN,5];IF IT DOESN'T START WITH "-"
CAIE TE,"M"-40 ; (SIXBIT "-" WITH HI-BIT COMPLEMENTED)
PUSHJ PP,RELES ; GIVE ITEM TO SORT
JRST CREF04 ;GO AFTER ANOTHER
;PRODUCE CREF LISTING (CONT'D)
;END OF INPUT
CREF10: PUSHJ PP,MERGE ;MERGE THE SCRATCH FILES
SETZM OLDCNM ;CLEAR 'MOST RECENT NAME'
MOVE TE,[XWD OLDCNM,OLDCNM+1]
BLT TE,OLDCNM+4
PUSHJ PP,HDROUT ;PUT OUT HEADING
CREF30: PUSHJ PP,RETRN ;GET AN ITEM FROM SORT
JRST LCRLF ;AT END--PUT OUT <C.R.>,<L.F.> AND RETURN
CRF30A: MOVE TE,[XWD -5,GCREFN];TURN
MOVSI TD,1B18 ; OFF
CREF31: XORM TD,(TE) ; SIGN
AOBJN TE,CREF31 ; BIT
MOVE TE,[XWD -5,GCREFN]; COMPARE
MOVEI TD,OLDCNM ; THIS
CRF31A: MOVE TC,(TE) ; ONE
CAME TC,(TD) ; WITH
JRST CRF31B ; LAST
AOBJP TE,CREF34 ; 0NE
AOJA TD,CRF31A ; *
;NEW ONE IS NOT SAME AS OLD ONE
CRF31B: PUSHJ PP,LCRLF ;PUT OUT <C.R.>,<L.F.>
MOVE TE,[XWD GCREFN,OLDCNM];COPY NEW ONE TO
BLT TE,OLDCNM+4 ; OLD ONE
MOVEI TE,0 ;PUT
MOVE TA,[POINT 6,GCREFN]; NEW
CRF31C: ILDB CH,TA ; ONE
JUMPE CH,CRF31D ; ONTO
ADDI CH,40 ; LISTING
PUSHJ PP,PUTLST ; FILE
AOJA TE,CRF31C ; *
CRF31D: TRZ TE,7 ;TAB
CRF31E: MOVEI CH,11 ; TO
PUSHJ PP,PUTLST ; COLUMN
ADDI TE,10 ; 32
CAIGE TE,40 ; *
JRST CRF31E ; *
;PRODUCE CREF LISTING (CONT'D)
MOVEI TE,^D11 ;SET UP
TSWF FLTTY ; COUNT OF
MOVEI TE,^D5 ; NUMBERS PER
MOVEM TE,GCREFC ; LINE
JRST CREF36
CREF34: SOSLE GCREFC ;IS LINE FULL?
JRST CREF35 ;NO
PUSHJ PP,LCRLF ;YES--PUT OUT <C.R.>,<L.F.>
MOVEI CH,11 ;PUT OUT
PUSHJ PP,PUTLST ; TABS
PUSHJ PP,PUTLST ; TO
PUSHJ PP,PUTLST ; COLUMN 24
MOVEI TE,^D11 ;SET UP
TSWF FLTTY ; COUNT OF
MOVEI TE,^D5 ; NUMBERS PER
MOVEM TE,GCREFC ; LINE
;PRODUCE CREF LISTING (CONT'D)
;PUT OUT LINE NUMBER
CREF35: MOVEI CH,11 ;PRECEDE IT
PUSHJ PP,PUTLST ; BY TAB
CREF36: HLRZ TC,GCREFN+5 ;GET LINE NUMBER
MOVEI TD,4 ;PUT OUT 4 DIGITS
PUSHJ PP,CREF38
MOVE TA,GCREFN+5 ;IS IT A
TROE TA,1B25 ; DEFINITION?
JRST CREF30 ;NO
PUSH PP,TA ;YES--SAVE TA
MOVEI CH,"#" ;PRINT A
PUSHJ PP,PUTLST ; POUND SIGN
PUSHJ PP,RETRN ;GET NEXT ITEM
JRST CREF37 ;NO MORE--WE ARE DONE
POP PP,TA ;GET PREVIOUS LN,CP
CAMN TA,GCREFN+5 ;IF SAME AS THIS ONE,
JRST CREF30 ; IGNORE THIS ONE,
JRST CRF30A ; ELSE USE THIS ONE
CREF37: POP PP,TA ;RESTORE PUSH-DOWN LIST
JRST LCRLF ;PUT OUT <C.R.>,<L.F.> AND LEAVE
;PUT OUT 4-DIGIT DECIMAL NUMBER
CREF38: IDIVI TC,^D10
HRLM TB,(PP)
SOJLE TD,.+2
PUSHJ PP,CREF38
HLRZ CH,(PP)
ADDI CH,"0"
JRST PUTLST
;GET WORD FROM CREF FILE
GETCRF: SOSG CRFBHI+2
JRST GTCRF2
GTCRF1: ILDB CH,CRFBHI+1
AOS (PP)
POPJ PP,
GTCRF2: IN CRF,
JRST GTCRF1
STATO CRF,740000 ;IF NO ERROR BITS,
POPJ PP, ; IT MUST BE END OF FILE
MOVEI CH,CRFDEV
JRST DEVDED
;NO CREF FILE
KNOCRF: OUTSTR [ASCIZ "?Couldn't find cref file"]
CALLI 12
;TABLE OF ROUTINES TO CREATE ADDRESS, BY ADDRESS TYPE
ADRTB1: JRST ADRCON ;CONSTANT
PUSHJ PP,ADRDAT ;DATAB
PUSHJ PP,ADRPRO ;PROTAB
JRST ADREXT ;EXTAB
PUSHJ PP,ADRFIL ;FILTAB
PUSHJ PP,ADRTAG ;TAGTAB
JRST INCCON ;INCREMENT IS A CONSTANT
JRST INCMIS ;INCREMENT IS MISCELLANEOUS
;TABLE OF ROUTINES TO HANDLE INCREMENT,BY INCREMENT TYPE
INCTB1: PUSHJ PP,BADINC ;ADD INCREMENT TO ADDRESS
HRR TB,IMPPAR ;ADD TO PARAMETERS IN IMPURE AREA
JRST INCFLS ;REFERENCE TO FILES.
HRR TB,LITBAS ;ADD TO LITERAL POOL BASE
JRST INCGO ;REFERENCE TO "GOTO.."
HRR TB,PC ;ADD TO CURRENT LOCATION
PUSHJ PP,TMPINC ;ADD TO TEMPORARY BASE
HRR TB,A50BAS ;ADD TO ALTER TABLE FOR SEGS > 49
;TABLE OF ROUTINES USED TO LIST THE ADDRESS
ADRTB2: JRST LSCON1 ;ADDRESS IS CONSTANT <100000
ADD DT,DATLOC ;DATAB
ADD DT,PROLOC ;PROTAB
JRST LSTEXT ;EXTAB
ADD DT,FILLOC ;FILTAB
JRST LSTTAG ;TAGTAB
JRST LSTCON ;INCREMENT IS CONSTANT >77777
JRST LSTMIS ;MISCELLANEOUS
;TABLE OF ROUTINES FOR LISTING MISCELLANEOUS ADDRESSES
INCTB2: MOVSI TA," "-40 ;NOT USED
MOVE TA,[SIXBIT "%PARAM"]
MOVE TA,[SIXBIT "%FILES"]
PUSHJ PP,INCLIT
MOVE TA,[SIXBIT "GOTO.."]
MOVSI TA,(SIXBIT /./)
PUSHJ PP,TMPLST
MOVE TA,[SIXBIT "%ALT50"]
SUBTTL CONSTANTS
;TABLE OF POWERS OF TEN FOR FLOATING-POINT CONVERSION.
;THE FIRST PARAMETER IS THE EXPONENT, THE SECOND IS THE HI-ORDER 35 BITS
;OF THE MANTISSA, AND THE THIRD IS THE LOW-ORDER 35 BITS OF THE MANTISSA.
;ONLY THE HI-ORDER 35 BITS ARE USED IN THE CONVERSION.
DEFINE .TAB. (A)<
REPEAT 0,<
NUMBER 732,357347511265,056017357445 ;D-50
NUMBER 736,225520615661,074611525567
NUMBER 741,273044761235,213754053125
NUMBER 744,351656155504,356747065752
NUMBER 750,222114704413,025260341562
NUMBER 753,266540065515,332534432117
NUMBER 756,344270103041,121263540543
NUMBER 762,216563051724,322660234335
NUMBER 765,262317664312,007434303425
NUMBER 770,337003641374,211343364332
NUMBER 774,213302304735,325716130610 ;D-40
NUMBER 777,256162766125,113301556752
>
NUMBER 002,331617563552,236162112545 ;D-38
NUMBER 006,210071650242,242707256537
NUMBER 011,252110222313,113471132267
NUMBER 014,324532266776,036407360745
NUMBER 020,204730362276,323044526457
NUMBER 023,246116456756,207655654173
NUMBER 026,317542172552,051631227231
NUMBER 032,201635314542,132077636440
NUMBER 035,242204577672,360517606150 ;D-30
NUMBER 040,312645737651,254643547602
NUMBER 043,375417327624,030014501542
NUMBER 047,236351506674,217007711035
NUMBER 052,306044030453,262611673245
NUMBER 055,367455036566,237354252116
NUMBER 061,232574123152,043523552261
NUMBER 064,301333150004,254450504735
NUMBER 067,361622002005,327562626124
NUMBER 073,227073201203,246647575664
NUMBER 076,274712041444,220421535242 ;D-20
NUMBER 101,354074451755,264526064512
NUMBER 105,223445672164,220725640716
NUMBER 110,270357250621,265113211102
NUMBER 113,346453122766,042336053323
NUMBER 117,220072763671,325412633103
NUMBER 122,264111560650,112715401724
NUMBER 125,341134115022,135500702312
NUMBER 131,214571460113,172410431376
NUMBER 134,257727774136,131112537675
NUMBER 137,333715773165,357335267655 ;D-10
NUMBER 143,211340575011,265512262714
NUMBER 146,253630734214,043034737477
NUMBER 151,326577123257,053644127417
NUMBER 155,206157364055,173306466551
NUMBER 160,247613261070,332170204303
NUMBER 163,321556135307,020626245364
NUMBER 167,203044672274,152375747331
NUMBER 172,243656050753,205075341217
NUMBER 175,314631463146,146314631463 ;D-01
A: NUMBER 201,200000000000,0 ;D00
NUMBER 204,240000000000,0
NUMBER 207,310000000000,0
NUMBER 212,372000000000,0
NUMBER 216,234200000000,0
NUMBER 221,303240000000,0
NUMBER 224,364110000000,0
NUMBER 230,230455000000,0
NUMBER 233,276570200000,0
NUMBER 236,356326240000,0
NUMBER 242,225005744000,0 ;D+10
NUMBER 245,272207335000,0
NUMBER 250,350651224200,0
NUMBER 254,221411634520,0
NUMBER 257,265714203644,0
NUMBER 262,343277244615,0
NUMBER 266,216067446770,040000000000
NUMBER 271,261505360566,050000000000
NUMBER 274,336026654723,262000000000
NUMBER 300,212616214044,117200000000
NUMBER 303,255361657055,143040000000 ;D+20
NUMBER 306,330656232670,273650000000
NUMBER 312,207414740623,165311000000
NUMBER 315,251320130770,122573200000
NUMBER 320,323604157166,147332040000
NUMBER 324,204262505412,000510224000
NUMBER 327,245337226714,200632271000
NUMBER 332,316627074477,241000747200
NUMBER 336,201176345707,304500460420
NUMBER 341,241436037271,265620574524
NUMBER 344,311745447150,043164733651 ;D+30
NUMBER 347,374336761002,054022122623
NUMBER 353,235613266501,133413263573
NUMBER 356,305156144221,262316140531
NUMBER 361,366411575266,037001570657
NUMBER 365,232046056261,323301053415
NUMBER 370,300457471736,110161266320
NUMBER 373,360573410325,332215544004
NUMBER 377,226355145205,250330436402 ;D+38
REPEAT 0,<
NUMBER 402,274050376447,022416546102
NUMBER 405,353062476160,327122277522 ;D+40
NUMBER 411,222737506706,206363367623
NUMBER 414,267527430470,050060265567
NUMBER 417,345455336606,062074343124
NUMBER 423,217374313163,337245615764
NUMBER 426,263273376020,327117161361
NUMBER 431,340152275425,014743015655
NUMBER 435,214102366355,050055710514
NUMBER 440,257123064050,162071272637
NUMBER 443,332747701062,216507551406
NUMBER 447,210660730537,231114641743 ;D+50
NUMBER 452,253035116667,177340012333
>
>
DEFINE NUMBER (A,B,C)
< EXP B,C> ;[762] GENERATE BOTH WORDS
FLTAB0: .TAB. FLTAB1
XX==<FLTAB1-FLTAB0>/2 ;[762] CALCULATE NUMBER OF TABLE ENTRIES BEFORE "FLTAB1"
PTLEN.==XX ;[762] MAX. SIZE OF TABLE
XX==XX-XX/4*4 ;CALC XX==XX MOD 4
BINR1==<BINR2==<BINR3==0>> ;INIT THE BINARY
DEFINE NUMBER (A,B,C)<
IFE XX-1,< BYTE (9) BINR1,BINR2,BINR3,<A>
BINR1==<BINR2==<BINR3==0>> >
IFE XX-2,<BINR3==A>
IFE XX-3,<BINR2==A>
IFE XX,<BINR1==A
XX==4>
XX==XX-1>
POINT 9,FLTAB3-1(TE),17
POINT 9,FLTAB3-1(TE),26
POINT 9,FLTAB3-1(TE),35
FLTAB2: POINT 9,FLTAB3(TE),8
POINT 9,FLTAB3(TE),17
POINT 9,FLTAB3(TE),26
POINT 9,FLTAB3(TE),35
.TAB. FLTAB3
IFN BINR1!BINR2!BINR3,< BYTE (9) BINR1,BINR2,BINR3,0>
;TABLE OF DECIMAL POWERS OF TEN
DECTAB: DEC 1000000000
DEC 100000000
DEC 10000000
DEC 1000000
DEC 100000
DEC 10000
DEC 1000
DEC 100
DEC 10
;THE CONSTANTS WHICH GO AT TOP OF PROGRAM
DEFINE CONST (X,Y),<
EXTERNAL X'PC
EXP X'PC
ASCIZ /Y: /
>
SYM.S: CONST NM.,%NM
CONST DT.,%DT
CONST PR.,%PR
SYM.P: XWD -3,SYM.S
DEFINE CONST (X,Y),<
EXTERNAL Y
EXP Y
ASCIZ /X: '/
>
DCP.S: CONST %POINT,DCPNT.;
CONST %COMMA,COMA.;
CONST %MONEY,DOLLR.;
DCP.: XWD -3,DCP.S
FILO==0 ;RELATIVE POSITION OF 'FILES.'
;TABLE OF PDP-10 OP-CODES
SALL
DEFINE %OPCT% (MNEM,B,C,OP10,LISTAC,LISTAD,LIST10,LSTNEG,INDENT,J,K,L,M,N),<
XWD LISTAC*1B18+LISTAD*1B19+INDENT*1B20+LIST10+LSTNEG*2,OP10
SIXBIT "MNEM">
DEFINE %OPCU%(A,B,C,D,E,F,G,H,I,J,K,L,M,N),<>
;NOW THAT MACROS ARE DEFINED, BUILD THE TABLE
OPCTAB OPTABL ;THE FIRST SET OF OP CODES WITH LABEL FOR TABLE
OPCTB2 OP2TAB ;THE SECOND SET OF OP CODES WITH LABEL FOR TABLE
XOPTAB ;GET EXTRA OP CODES ALSO
ASAC: POINT 4,W1,12 ;AC-FIELD OF OPERATOR
FSTUUO==142
ENDIT==177
SIZED==5 ;SIZE OF LARGEST NUMBER PRINTED AT TABD2
BADCON: OUTSTR [ASCIZ "Bad constant type in ASYFIL
"]
JRST KILLF
EXTERNAL LNKCOD,TB.FIL
EXTERNAL .JBOPS,COUNTF,COUNTW
EXTERNAL END.PC
EXTERNAL NAMLOC,DATLOC,FILLOC,FILNXT,PROLOC,EXTLOC,EXTNXT,TAGLOC,SECLOC,CURSEC
EXTERNAL LITLOC,TAGOUT,SAVTAG,DATGRP,DECSEG,ASYFIL,NAMNXT,LITBLK
EXTERNAL PRONXT,DATNXT,NM2LOC,%ES.PC
EXTERNAL ASOP,INCTYP,ADRTYP,PTSEGN,RESDNT,NONRES,DATBAS,TEMBAS,USEBAS
EXTERNAL EAS2PC,IMPPAR,LITBAS,ALTBAS,A50BAS,FLTC1,FLTC2,FILTBL
EXTERNAL SYMLC1,SYMREL,CURREL,SYMGRP,LSTBH
EXTERNAL PROGID,PROGST,GHOLD,PAGCNT,GAERAS,NUMEXT,EXTCNT
EXTERNAL BINHDR,BINDEV,BINBUF,BINPP,BINBH,OVRWRD,CURLIT,HILOC,HPLOC,SEGFLG
EXTERNAL LSTDEV,CRFDEV,CRFBHI,CRFBUF,CRFHDR
EXTERNAL FTDBAS,FIXEDS,OBJSIZ,HDRPAG,SUBPAG
EXTERNAL GCREFC,GCREFN,OLDCNM,CREFSW,PRODSW,CRFERA
EXTERNAL LMASKB
EXTERNAL DA.DFS,DA.DEF,DA.BRO,DA.POP
EXTERNAL DA.PWA,DA.EDW,DA.SUB,DA.DEP,DA.KEY
EXTERNAL TB.DAT,TB.PRO
EXTERNAL AS.TAG,AS.PRO
END COBOLG