Trailing-Edge
-
PDP-10 Archives
-
decuslib20-06
-
decus/20-153/rpgiig.mac
There is 1 other file named rpgiig.mac in the archive. Click here to see a list.
TITLE RPGIIG FOR RPGII 1
SUBTTL PHASE G - ASSEMBLY AL BLACKINGTON/CAM/SEB/BOB CURRIER
;CONVERTED TO RPGII VERSION, AUGUST 11, 1975 02:48:35
;SOME OF THIS IS STILL
;COPYRIGHT 1974, DIGITAL EQUIPMENT CORP., MAYNARD, MA.
;BUT A LOT HAS BEEN MODIFIED BY BOB CURRIER
TWOSEG
RELOC 400000
INTERNAL CLRDAT,PUTDAT,PDATI
EXTERNAL SETASY,GETASY,PUTBIN,KILL
EXTERNAL PUTLST,LCRLF,HDROUT,LSTMES,KILLF,LNKSET
EXTERNAL RESTRT,DEVDED
EXTERNAL BLKTYP
IFN CREF,<
EXTERNAL PSORT,RELES,RETRN,MERGE >
RPGIIG: SETFAZ G;
SKIPN NAMNXT ;IF NO NAMTAB,
SETOM PRODSW ; PRETEND '/P' TYPED
SETZM GAERAS ;CLEAR ERROR COUNTER
IFE DEBUG, <TSWF FFATAL;
JRST NDASY0>
SKIPN BINDEV ;DO WE HAVE TO ASSEMBLE?
TSWF FOBJEC;
JRST RPGIGA ;YES
JRST NDASY0 ;NO--QUIT
RPGIGA: 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"
PUSHJ PP,INITAL ;INITIALIZE THE PHASE
PUSHJ PP,SETASY ;INITIALIZE THE FILE
JRST GET
;PICK UP NEXT ASYFIL
NXTASY: CLOSE ASY, ;CLOSE THAT ASYFIL
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 CONTROL LEVEL CALC SECTIONS
SWOFF FASDAT; ;TURN OFF "THIS IS DATA DIVISION"
PUSHJ PP,STARTI
MOVE PC,RESDNT ;RESET CURRENT LOCATION COUNTER
MOVEM PC,DATGRP+2
JRST NXTAS3
;NEXT INPUT FILE IS FOR THE DETAIL CALC SECTIONS
NXTAS1: PUSHJ PP,EXTOUT ;WRITE OUT ANY DUMMIES FOR EXTERNAL REFERENCES
MOVE PC,NONRES
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
GET0: 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
HRRZ W2,CH
GET1: PUSHJ PP,GETOPR
TSWT FNOLST ;ANY LISTING?
PUSHJ PP,LSTOPR ;YES--LIST IT
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!FASDAT ;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!FASDAT ;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,ASCD1
MOVEI OP,0
TLNE W1,ASCD2
MOVEI OP,1
TLNE W1,ASCFLT
MOVEI OP,2
TLNE W1,ASCOCT
MOVEI OP,3
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
IFE DEBUG,<
TSWT FASDAT; > ;DON'T LIST IF DATA DIVISION
TSWF FNOLST;
JRST CONST2
PUSHJ PP,LSTCOD
PUSHJ PP,@CONTAB(OP)
PUSHJ PP,LCRLF
CONST2: ADDI PC,1
SOJG CT,CONST1
JRST GET
BADCON: TTCALL 3,[ASCIZ "BAD CONSTANT TYPE IN ASYFIL
"]
JRST KILLF
;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
;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
TTCALL 3,[ASCIZ "BAD MISC. OPERATOR
"]
JRST KILL
;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
JRST MISP5 ;NO
;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 MISEN1 ;NO
PUSHJ PP,HDROUT ;NEW PAGE
PUSHJ PP,TABS3 ;3 TABS
MOVE TE,[POINT 7,[ASCIZ "ENTRY "]]
PUSHJ PP,LSTMES
PUSHJ PP,LSTNAM
PUSHJ PP,LCRLF ;2 CRLF
PUSHJ PP,LCRLF
PUSHJ PP,TABS3
PUSHJ PP,LSTNAM ;"ENTRY-NAME:"
MOVEI CH,":"
PUSHJ PP,PUTLST
PUSHJ PP,LCRLF
PUSHJ PP,LCRLF
MISEN1: JRST GET
TABS3: MOVEI CH,11 ;PUT OUT 3 TABS
PUSHJ PP,PUTLST
PUSHJ PP,PUTLST
PUSHJ PP,PUTLST
POPJ PP,
;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: HLRZ TA,0(DT) ; [261] get NAMTAB offset
ANDI TA,LMASKB ; [261] get the naughty bits
JUMPE TA,MISP6A ; [261] ignore if zero entry
ADD TA,NAMLOC ; [261] offset it
MOVE TC,1(TA) ; [261] get the sixbit name
PUSHJ PP,RADX50 ; [261] convert to RAD50
TLO CH,040000 ; [261] mark as relocatable
MOVE TA,PC ; [261] value = .
PUSHJ PP,PUTSYM ; [261] output the symbol and value
MISP6A: LDB TE,PTSEGN
SKIPN TE ;RESIDENT SEGMENT?
SKIPA TD,RESDNT ;YES
MOVE TD,NONRES ;NO
ADD TD,(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: MOVE TC,W1 ; [261] get value of tag
SETZ TA, ; [261] start fresh
MTAG0: IDIVI TC,^D10 ; [261] shift
ADDI TB,20 ; [261] convert to sixbit character
LSHC TB,-6 ; [261] make room for next one
JUMPN TC,MTAG0 ; [261] loop until done
LSH TA,-6 ; [261] shift one more time to make room for
TLO TA,(<'%'>B5) ; [261] the percent sign
MOVE TC,TA ; [261] get into proper AC
PUSHJ PP,RADX50 ; [261] convert to RAD50
TLO CH,040000 ; [261] is relocatable
MOVE TA,PC ; [261] get the symbol value
PUSHJ PP,PUTSYM ; [261] output the symbol
TSWF FNOLST; ;ANY LISTING?
JRST GET ;NO--FORGET IT
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
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
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: TSWT FNOLST; ; [261] any listing?
PUSHJ PP,LCRLF ; [261] yes -
HRRZS W1 ; GET USEFUL BITS
CAIE W1,7B20 ;WAS THAT A MISCELLANEOUS REFERENCE?
JRST GET ;NO--RETURN
CAIN W2,1B20 ;OTF BASE?
JRST MISR10 ; YES
CAIN W2,2B20 ; NO - OCHBAS?
JRST MISR11 ; YES -
CAIN W2,4B20 ; NO - ICHBAS?
JRST MISR12 ; YES -
CAIN W2,7B20 ; [356] no - DATBAS?
JRST MISR14 ; YES -
CAIN W2,3B20 ;NO--LITERAL BASE?
JRST MISRL8 ;YES
JRST GET ;NO--RETURN
;RELOC (CONT'D)
;SPECIAL RELOC--PRINT OUT A TAG
MISRL8: TSWF FNOLST; ; [261] any listing?
JRST MSRL8A ; [261] no -
MOVEI CH,HDROUT
MOVE TA,PAGCNT
CAIL TA,^D30
MOVEI CH,LCRLF
PUSHJ PP,(CH)
MSRL8A: MOVE TA,[SIXBIT "%LIT"] ;PRINT OUT "%LIT:" AS A TAG
MISRL9: TSWF FNOLST; ; [261] any listing?
JRST MSRL9A ; [261] no -
PUSHJ PP,TABS3
PUSHJ PP,SIXOUT
MSRL9A: MOVE TC,TA ; [261] get symbol into proper AC
PUSHJ PP,RADX50 ; [261] convert to RAD50
TLO CH,040000 ; [261] is relocatable
MOVE TA,PC ; [261] get value
PUSHJ PP,PUTSYM ; [261] output the symbol
TSWF FNOLST; ; [261] any listing?
JRST GET ; [261] no - exit
MOVEI CH,":"
PUSHJ PP,PUTLST
SWON FASPAR;
PUSHJ PP,LCRLF
JRST GET
MISR10: SKIPA TA,[SIXBIT "%OTF"]
MISR11: MOVE TA,[SIXBIT "%OCH"]
SWOFF FASDAT;
JRST MISRL9
MISR12: SKIPA TA,[SIXBIT "%ICH"]
MISR14: MOVE TA,[SIXBIT "%DAT"]
SWOFF FASDAT;
JRST MISRL9
;END OF ASSEMBLY
ENDASY: MOVE CH,[RADIX50 04,%TEMP] ; [261] get symbol name
MOVE TA,TEMBAS ; [261] get value
PUSHJ PP,PUTSYM ; [261] output it
MOVE CH,[RADIX50 04,%ARR] ; [261] get another symbol
MOVE TA,ARRBAS ; [261] get another value
MOVE TB,ARRLOC ; [261] get start of ARRTAB
CAME TB,ARRNXT ; [261] same as the end?
PUSHJ PP,PUTSYM ; [261] no - output symbol
PUSHJ PP,CLRDAT ;CLEAR OUT DATGRP
NDASY2: PUSHJ PP,EXTOUT ;WRITE OUT EXTERNAL REQUESTS
PUSHJ PP,ENDBLK ;PUT OUT END BLOCK
NDASY3: TSWF FNOLST ;ANY LISTING?
JRST NDASY0 ;NO
MOVE TE,[POINT 7,[ASCIZ "
END"]]
PUSHJ PP,LSTMES
MOVE TE,[POINT 7,[ASCIZ " START."]]
PUSHJ PP,LSTMES ;YES, LIST "END START."
PUSHJ PP,LCRLF
PUSHJ PP,PBREAK ;PRINT OUT PROGRAM BREAK
NDASY0: SKIPE LSTDEV
SWOFF FNOLST;
PUSHJ PP,CNTOUT
SKIPLE GAERAS ;ANY ASSEMBLY ERRORS?
PUSHJ PP,NDASY5
NDASY4:
IFE DEBUG,<
TSWF FFATAL ;IN STANDARD VERSION, IF FATAL
CLOSE BIN,$CLS40 ; ERROR, DISCARD NEW REL, KEEP OLD
>
RELEASE BIN, ;THROW AWAY BIN DEVICE
IFN CREF,<
SKIPE CREFSW ;IF '/C',
PUSHJ PP,CREFL > ; PUT OUT CREF LISTING
IFN DEBUG,<
PUSHJ PP,SUMARY>
MOVEI CH,14
PUSHJ PP,PUTLST
RELEASE LST,
;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: PUSHJ PP,PUTQRY
MOVE TE,GAERAS
MOVE TA,[POINT 7,[ASCIZ " Assembly Error"]]
JRST CNTO1
;TYPE OUT "?" AND BUMP JOBERR
PUTQRY: MOVE TE,[POINT 7,[ASCIZ "
?"]]
TSWF FLTTY ;LISTING ON TTY?
JRST PUTQR2 ;YES
TTCALL 3,(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,LCRLF
PUSHJ PP,LCRLF
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
TSWT FLTTY;
TTCALL 3,[ASCIZ "
"]
JRST LCRLF
CNTO2: MOVE TE,[POINT 7,[ASCIZ "No Errors Detected"]]
PUSHJ PP,LSTMES
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
CNTO5: POPJ PP,
MOVEI CH,"s"
JRST CNTO10
;PUT OUT ERROR MESSAGE (CONT'D)
;PUT OUT TEXT
CNTO6: TSWT FLTTY;
TTCALL 3,(TA)
CNTO7: ILDB CH,TA
JUMPE CH,CNTO5
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;
TTCALL 1,CH
JRST PUTLST
;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
TTCALL 3,[ASCIZ "
%RPGCSE 'CORE SIZE TO EXECUTE' exceeded in object program
"]
MOVE TE,[POINT 7,[ASCIZ "
'CORE SIZE TO EXECUTE' exceeded by "]]
PUSHJ PP,LSTMES
MOVE TA,OP
PUSHJ PP,LSINC2
JRST LCRLF
;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
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 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: CAIGE OP,FSTUUO ;IS IT A UUO WHICH USES AC-FIELD TO DEFINE OP-CODE?
JRST GET2 ;NO
LDB TE,ASAC ;YES--PICK UP AC-FIELD
CAIG OP,FSTUUO ;IS IT OPEN OR CLOSE?
ANDI TE,1 ;YES--GET RID OF ALL BUT LOW-ORDER BIT
LSH TE,1 ;DOUBLE IT
MOVS OP,UUOTBL-FSTUUO(OP) ;SET OP TO TABLE2
ADD OP,TE
JRST GET3
GET2: LSH OP,1
ADDI OP,OPTABL
GET3: MOVE TD,(OP) ;PICK UP PDP-10 OP-CODE
DPB TD,[POINT 9,TB,8] ;PUT IT INTO TB
TLNN TD,1 ;ARE DECIMAL ADDRESSES ALLOWED?
SWOFFS FGDEC ;NO
SWON FGDEC ;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
LOPR0: MOVE TA,1(OP) ;GET MNEMONICS FOR OPERATOR
PUSHJ PP,SIXOUT ;PRINT IT OUT
MOVEI CH,11
PUSHJ PP,PUTLST
SKIPL 0(OP) ;SHOULD WE PRINT AC?
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 "@"
PUSHJ PP,LSTADR ;LIST ADDRESS
TLNE W1,17 ;ANY INDEX?
PUSHJ PP,PUTXR
JRST LCRLF ;NO--END OF LINE
;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
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
MOVE TA,[SIXBIT "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 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
LSTFTB: MOVE TA,[SIXBIT "%FTB"]
PUSHJ PP,SIXOUT
MOVE W2,W1
ANDI W2,77777
PJRST 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 ;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;
TRNN W2,700000
JRST LSTINC
POPJ PP,
;LIST ADDRESSES (CONT'D).
;CONSTANT > 77777
LSTCON: HRRZ TA,W2
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: MOVEI CH,"%"
PUSHJ PP,PUTLST
MOVE TC,W1
ANDI TC,77777
PUSHJ PP,LSINC5
JRST LSTINC
;MISCELLANEOUS
LSTMIS: LDB TD,INCTYP
ANDI W2,77777
XCT INCTB2(TD)
PUSHJ PP,SIXOUT
JRST LSTINC
;INCREMENT TO DATA DIVISION
INCDAT: HRRZ TA,W2
JRST LSINC1
;LIST ANY INCREMENT (IN W2) IN OCTAL
LSTINC: MOVE TA,W2
TRNN TA,77777
POPJ PP,
MOVEI CH,"+"
CAILE TA,70000 ; IS IT .- ?
JRST LSINC7 ; YES -
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
;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,
LSINC7: MOVEI CH,"-" ; GET A MINUS
PUSHJ PP,PUTLST ; STASH ONTO LISTING
MOVNS TA ; GET POSITIVE NUMBER
JRST LSINC1 ; AND CONTINUE
;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
LSNAM0: MOVEI TE,0
JUMPE TA,LSNAM1 ;ZERO ENTRY?
ADD TA,NAMLOC ; ADD IN BASE OF NAMTAB
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
JUMPN CH,.+2 ; DONE?
POPJ PP, ;YES--EXIT
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 A SIXBIT CONSTANT
LSTSIX: SKIPA DT,[POINT 6,TB]
;LIST AN ASCII CONSTANT
LSTASC: MOVE DT,[POINT 7,TB]
TSWT FNOLST ;ANY LISTING?
PUSHJ PP,LISTPC ;YES--LIST PC
MOVE OP,[POINT 7,GHOLD]
MOVEI W2,42
ASCSX1: PUSHJ PP,GETASY
MOVE TB,CH
MOVEI TA,0
PUSHJ PP,PUTDAT
ADDI PC,1
TSWT FNOLST ;ANY LISTING?
JRST ASCSX2
SOJG TC,ASCSX1
POPJ PP,
ASCSX2: ILDB CH,DT
TLNN DT,100
ADDI CH,40
CAIN CH,42
MOVEI W2,"/"
SKIPE CH
IDPB CH,OP
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)
MOVEI CH,11 ;PUT OUT TWO TABS
PUSHJ PP,PUTLST
PUSHJ PP,PUTLST
SKIPE TAGOUT ;ANY TAGS?
JRST ASCSX3 ;NO
MOVE TC,SAVTAG
PUSHJ PP,MSTAG4
ASCSX3: SETOM TAGOUT
TLNN DT,100 ;ASCII?
SKIPA TE,[POINT 7,[ASCIZ " SIXBIT "]];NO
MOVE TE,[POINT 7,[ASCIZ " ASCII "]];YES
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
;LIST A ONE-WORD DECIMAL CONSTANT
LSTD1: MOVE TA,[SIXBIT "DEC"]
PUSHJ PP,SIXOUT
MOVEI CH,11
PUSHJ PP,PUTLST
MOVE TE,TB
JRST DECIT
;LIST A TWO-WORD DECIMAL CONSTANT
LSTD2: MOVE TA,[SIXBIT "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
ADDI TD,1
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,LCRLF
ADDI PC,1
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
FLTCN2: 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: SKIPGE FLTC1 ;POSITIVE EXPONENT?
MOVNS TE ;NO--GET NEGATIVE
MUL TB,FLTAB1(TE) ;MULTIPLY BY TABLE VALUE
TLNE TB,(1B1) ;IF NO
JRST FLTCN8 ; NORMALIZED,
LSH TB,1 ; THEN NORMALIZE IT
SUBI LN,1
FLTCN8: 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
POP PP,LN ;RESTORE LN
POPJ PP,
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: MOVE TA,[SIXBIT "0."]
PUSHJ PP,SIXOUT
MOVE TA,[POINT 4,FLTC2,3]
MOVEI TB,10
LSFLT2: ILDB CH,TA
ADDI CH,"0"
PUSHJ PP,PUTLST
SOJG TB,LSFLT2
SKIPN TE,FLTC1
POPJ PP,
MOVEI CH,"E"
PUSHJ PP,PUTLST
JRST DECIT
;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,"'"
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,"'"
PUSHJ PP,PUTLST
MOVEI CH,11
PUSHJ PP,PUTLST
SKIPE TAGOUT ;A SINGLE TAG TO BE LISTED?
JRST LSCOD2 ;NO
LSCOD1: 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
ADD TB,W2
POPJ PP,
;ADDRESS IS A CONSTANT
ADRCON: MOVEI TA,0
HRR TB,TE
POPJ PP,
;ADDRESS IS IN EXTAB
ADREXT: CAIGE TE,NUMEXT ;IS IT A RPGLIB ROUTINE?
TSWF FREENT ;YES--IS THIS A RE-ENTRANT PROGRAM?
JRST ADEXT4 ;RE-ENTRANT, OR NOT LIBOL ROUTINE
LSH TE,-1
TLO W1,1B31
MOVEI TA,0
HRRI TB,140+FIXNUM(TE)
TLO TB,1B31
POPJ PP,
ADEXT4: ADD TE,EXTLOC ;GET EXTTAB LOCATION
HRRZ TD,1(TE) ;PICK UP ADDRESS
ADEXT0: 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,1 ;SET RELOCATION ON
POPJ PP, ;RETURN
ADEXT3: HLLZS TB ;SET ADDRESS TO ZERO
MOVEI TA,0 ;TURN RELOCATION OFF
POPJ PP, ;RETURN
;ADDRESS IS IN PROTAB
ADRPRO: HRRZ DT,PROLOC ;GET ADDRESS OF PROTAB ENTRY
ADD DT,TE
HRR TB,(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 AN OCHTAB ENTRY
ADRTAG: HRRZ DT,OCHLOC ; GET BOTTOM OF OCHTAB
ADD DT,TE ; ADD OUT INCREMENT
HRR TB,1(DT) ; GET THE WORD
ADD TB,OCHBAS ; ADD IT TO OCHBAS
POPJ PP, ; EXIT
;ADDRESS IS OBJECT TIME FILE TABLE
ADRFIL: HRR TB,TE
MOVE W2,FTBBAS##
POPJ PP,
;ADDRESS IS IN ICHTAB
ADRDAT: HRRZ TA,ICHLOC##
ADD TA,TE
ADRD3: HRR TB,1(TA)
ADD TB,ICHBAS ;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,INCTYP
XCT INCTB1(TE)
MOVE TD,W2
ANDI TD,77777
CAILE TD,70000 ; NEGATIVE INCREMENT?
ADD TD,[XWD 777777,700000] ; YES - CONVERT TO FULL WORD
ADD 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
POPJ PP,
TMPLST: MOVE TA,[SIXBIT '%TEMP']
POPJ PP,
;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,";"-40 ;IS IT A SEMI-COLON?
JRST RDX50D ;YES
CAIN TD,"%"-40
JRST RDX50F
CAIGE TD,"A"-40
CAIG TD,"9"-40
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,
RDX50F: TROA TD,47 ; use RAD50 "%"
RDX50D: MOVEI TD,45 ;CHANGE ";" TO "."
JRST RDX50E
;LIST AN OCTAL CONSTANT
LSTOCT: MOVE TA,[SIXBIT "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,
;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
;PUT OUT A START BLOCK
MOVE CH,[XWD 7,1]
PUSHJ PP,PUTBIN
MOVSI CH,200000
PUSHJ PP,PUTBIN
HRRZ CH,PC
PUSHJ PP,PUTBIN
STRT2: PUSHJ PP,HDROUT
PUSHJ PP,LCRLF
SC==0 ;INITIAL COUNT OF START INSTRUCTIONS [201].
SRT==SC
;
TSWT FREENT ;RE-ENTRANT CODE?
JRST STRT10 ;NO -- GETSEG NEEDED
MOVE TE,[POINT 7, [ASCIZ "START.:"]]
PUSHJ PP,STRTI8
;PUT OUT THE "JSP"
STRTI9: MOVSI TB,(JSP 14,)
TSWF FREENT;
JRST STRT9C
HRRI TB,400010
MOVEI TA,0
JRST STRT9D
STRT9C: MOVEI W2,0
MOVEI W1,RESET## ;EXTAB ADDR OF RESET.
PUSHJ PP,GETADR
STRT9D: PUSHJ PP,PUTDAT
SETOM TAGOUT
TSWT FREENT;
SKIPA TE,[POINT 7,[ASCIZ " JSP 14,400010 ;RESET."]]
MOVE TE,[POINT 7,[ASCIZ " JSP 14,RESET."]] ; [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,PRGID
PUSHJ PP,SIXOUT
PUSHJ PP,LCRLF
AOJ PC,
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,STRTI8
SC==SC+1
MCSEND:
;PUT OUT "JRST" TO BEGINNING OF CODE
HRRZ TB,PROGST ; GET START OF CODE
HRLI TB,(JRST) ; GET THE INSTRUCTION
MOVEI TA,1 ; RELOCATE
PUSHJ PP,PUTDAT ; OUTPUT
MOVE TE,[POINT 7, [ASCIZ " JRST "]]
PUSHJ PP,LISTIT
MOVE TA,PRGID ; GET PROGRAM NAME
PUSHJ PP,SIXOUT ; OUTPUT IT
PUSHJ PP,LCRLF ; DO A RTNL
AOJ PC,
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
AOJA PC,LCRLF
;PUT OUT 'GETSEG' CODE
GC==0 ;INIT COUNT OF GETSEG + START INSTRUCTIONS
STRT10: MOVSI TB,(MOVEI 1,) ;PUT OUT "MOVEI 1,%RPGLB"
HRR TB,RESDNT
ADDI TB,GETSGC-6
SUB TB,FIXEDS
MOVEI TA,1
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ "START.: MOVEI 1,%RPGLB"]] ; [201]
PUSHJ PP,STRTI8
GC==GC+1
MOVE W1,[EXP 132B8+1B12+40B35] ;PUT OUT "CALLI 1,40"
MOVEI W2,0
MOVE TB,W1
PUSHJ PP,GETOPR
PUSHJ PP,LSTOPR
ADDI PC,1
GC==GC+1
MOVSI TB,(JRST 4,) ;PUT OUT "JRST 4,."
HRR TB,RESDNT
SUB TB,FIXEDS
ADDI TB,2
MOVEI TA,1
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ " JRST 4,."]]
PUSHJ PP,STRTI8
GC==GC+1
MOVSI TB,(MOVEI 16,) ;PUT OUT "MOVEI 16,ADDR OF RPGLIB ARGS"
HRR TB,RPGVER##
ADD TB,LITBAS
MOVEI TA,1
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ " MOVEI 16,%LIT ;RPGLIB arguments"]]
PUSHJ PP,STRTI8
GC==GC+1
PUSHJ PP,STRTI9
GC==GC+SC
PUSHJ PP,LCRLF
MOVE TC,[IOWD 6,GETTAB]
STRTI4: ADDI TC,1 ;PUT OUT
MOVE TB,(TC) ; SIXBIT "SYS"
MOVEI TA,0 ; SIXBIT "RPGLIB"
PUSHJ PP,PUTDAT ; SIXBIT "SHR"
MOVE TE,1(TC) ; Z
PUSHJ PP,STRTI8 ; Z
AOBJN TC,STRTI4 ; Z
GC==GC+6
JRST CLRDAT
GETSGC==:GC ;NUMBER OF WORDS OF GETSEG CODE + START CODE
PRINTC==GETSGC-6-12
;PUT OUT THE FIXED PORTION OF CODE:
; OTFBAS: XWD 0,OTFBAS
; MEMRY.: OCT OBJSIZ
; TOTBAS: XWD 0,%TOT
; TABDEX: OCT 0
; FTBBAS: XWD 0,FTBBAS
; PUSHL.: OCT 200
; FRCFIL: OCT 0
; ARRBAS: XWD 0,ARRBAS
; STKLST: XWD 0,.STLST
FIXNUM==^D9 ;NUMBER OF FIXED ITEMS
;(MUST AGREE WITH FIXNUM IN RPGIIE)
;PUT OUT "XWD 0,OTFBAS"
FIXED: PUSHJ PP,CLRDAT ;CLEAR OUT DATGRP
HRRZM PC,DATGRP+2
PUSHJ PP,LCRLF
HRRZ TB,OTFBAS ;ASSUME THERE ARE FILES
MOVEI TA,1
MOVE TE,OTFLOC## ;ARE THERE ANY FILES?
CAMN TE,OTFNXT##
SETZB TA,TB ;NO--PUT OUT UNRELOCATED ZERO
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ "%OTFBS: XWD 0,"]]
PUSHJ PP,LISTIT
MOVE TA,TB
PUSHJ PP,LSINC2
PUSHJ PP,LCRLF
ADDI PC,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,LCRLF
ADDI PC,1
;Put out "TOTBAS: XWD 0,%TOT"
HRRZ TB,NONRES##
MOVEI TA,1
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7, [ASCIZ "%TOTBS: XWD 0,"]]
PUSHJ PP,LISTIT
HRRZ TA,TB
PUSHJ PP,LSINC2
PUSHJ PP,LCRLF
ADDI PC,1
;PUT OUT "TABDEX: OCT 0"
SETZB TA,TB
TSWF F1P; ; 1P REPEAT ON?
MOVEI TB,1 ; YES - FLAG IT
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7, [ASCIZ "%TBDEX: OCT "]]
PUSHJ PP,LISTIT
HRRZ TA,TB ; GET DATA INTO PROPER AC
PUSHJ PP,LSINC2
PUSHJ PP,LCRLF
ADDI PC,1
;PUT OUT "FTBBAS: XWD 0,FTBBAS"
HRRZ TB,FTBBAS
ADDI TB,32 ; [153] Add in device table offset
MOVEI TA,1
MOVE TE,FTBLOC## ; ARE THERE ANY FILES?
CAMN TE,FTBNXT##
SETZB TA,TB ; NO - OUTPUT NON-RELOCATED ZERO
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7, [ASCIZ "%FTBAS: XWD 0,"]]
PUSHJ PP,LISTIT
HRRZ TA,TB
PUSHJ PP,LSINC2
PUSHJ PP,LCRLF
ADDI PC,1
;PUT OUT "PUSHL.: OCT 200"
MOVEI TB,200 ; GET THAT CONSTANT
MOVE TA,0 ; NON-RELOCATABLE
PUSHJ PP,PUTDAT ; OUTPUT
MOVE TE,[POINT 7,[ASCIZ "%PUSHL: OCT "]]
PUSHJ PP,LISTIT ; OUTPUT TO LISTING
HRRZ TA,TB ; GET THAT DATA
PUSHJ PP,LSINC2 ; OUTPUT DATA
PUSHJ PP,LCRLF ; DO A CRLF
ADDI PC,1 ; AND BUMP THAT PC
;Put out "FRCFIL: OCT 0"
SETZB TA,TB
PUSHJ PP,PUTDAT
MOVE TE,[POINT 7,[ASCIZ "%FRCFL: OCT "]]
PUSHJ PP,LISTIT
HRRZ TA,TB
PUSHJ PP,LSINC2
PUSHJ PP,LCRLF
ADDI PC,1
;Put out "ARRBAS: XWD 0,ARRBAS"
HRRZ TB,ARRBAS## ; get start of ARRTAB
MOVEI TA,1 ; relocated
MOVE TE,ARRLOC## ; get in core start of ARRTAB
CAMN TE,ARRNXT## ; is there any?
SETZB TA,TB ; no - output non-relocated zero
PUSHJ PP,PUTDAT ; output
MOVE TE,[POINT 7, [ASCIZ "%ARBAS: XWD 0,"]]
PUSHJ PP,LISTIT ; output junk to listing
HRRZ TA,TB ; get into proper AC
PUSHJ PP,LSINC2 ; output RH
PUSHJ PP,LCRLF ; and a <CR>
ADDI PC,1 ; bump the PC
;Put out "STKLST: XWD 0,.STLST"
SETZB TA,TB ; start with zero
SKIPN TB,.STLST## ; do we have a list?
JRST .+3 ; no - output non-reloacted zero
ADD TB,OTFBAS ; yes - relocate by OTFBAS
MOVEI TA,1 ; relocate thusly too
PUSHJ PP,PUTDAT ; output
MOVE TE,[POINT 7, [ASCIZ "%STLST: XWD 0,"]]
PUSHJ PP,LISTIT ; output to listing
HRRZ TA,TB ; get into proper AC
PUSHJ PP,LSINC2 ; output data to listing
PUSHJ PP,LCRLF ; formatting touches
ADDI PC,1 ; bump the PC
POPJ PP,
;INITIALIZE THE PHASE
INITAL: MOVE TA,NONRES ;SET HILOC
ADD TA,EAS3PC## ; [261] adjust HILOC to be correct
ADDM TA,HILOC
HRRZS OBJSIZ
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,PRGID ;PROGRAM-ID
PUSHJ PP,RADX50 ; IN
PUSHJ PP,PUTBIN ; RADIX 50
MOVSI CH,0 ;"I AM UNKNOWN" CODE
TSWT FREENT;
HRRI CH,COMSIZ
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
HRRI CH,1B18
PUSHJ PP,PUTBIN
;PUT OUT .JBOPS WORD IF THIS IS A MAIN PROGRAM.
INITL2: MOVE CH,[XWD 1,2]
PUSHJ PP,PUTBIN
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
;PUT OUT A REFERENCE TO "FUNCT." IN CASE LINK-10 OVERLAYS ARE GOING
; TO BE USED.
;THIS WILL ONLY BE DONE FOR NON-REENTRANT MAIN PROGRAMS.
;CODE TO BE GENERATED IS:
; XWD 2,2
; EXP 0
; RADIX50 04,FUNCT.
; EXP %FUNCT+FIXNUM+140
;AT RESET TIME LIBOL WILL PLACE "JRST FUNCT." IN SOME ABSOLUTE LOCATION
; WHICH IS IN LIBOL'S DISPATCH TABLE. THUS, WHEN THE OVERLAY ROUTINES
; DO PUSHJ'S TO FUNCT. THEY WILL GO THROUGH THE FUNCT. DEFINED IN THE
; COBOL PROGRAM TO THE FUNCT. DEFINED IN LIBOL.
TSWF FREENT ;ARE WE GENERATING REENTRANT CODE?
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 04,FUNCT.] ;GLOBAL DEFINITION.
PUSHJ PP,PUTBIN ;PUT IT IN THE REL FILE.
HRRZI CH,%FUNCT##+FIXNUM+140 ;ABSOLUTE LOCATION AT RUNTIME.
PUSHJ PP,PUTBIN ;PUT IT IN THE REL FILE.
INITL3: BLOCK 0
;FINISH UP INITIALIZATION
MOVEI TA,(SIXBIT "AS1") ;SET UP FOR AS1FIL
HRRM TA,ASYFIL
HLLZS SW ;CLEAR SWITCHES
IFE DEBUG,<SWON FASDAT; ;TURN ON "DATA AREA">
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
SETOM TAGOUT ;SET TAGOUT TO -1
INITL9: 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
HRRZS TB ;YES--CLEAR LEFT HALF
CAIE TB,-1 ;HAS IT BEEN REFERENCED YET?
JRST EXTO2
SETZB TB,TA ;NO--USE UNRELOCATED ZERO
JRST EXTO3
EXTO2: MOVEI TA,1 ;YES--RELOCATE
EXTO3: 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?
JRST EXTO6 ;NO
PUSHJ PP,LSTCOD ;YES--LIST PC AND ASSEMBLED CODE
;PUT OUT EXTERNAL REQUESTS (CONT'D).
MOVE TE,[POINT 7,[ASCIZ "XWD 0,"]]
PUSHJ PP,LSTMES
MOVE DT,OP
PUSHJ PP,LSTNAM ;PRINT EXTERNAL NAME
PUSHJ PP,LCRLF
EXTO6: ADDI PC,1 ;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: TTCALL 3,[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
ENTBL0: 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
SKIPN TE ;EXIT IF NONE THERE
POPJ PP,
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.
ENDBLK: 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: POPJ PP, ;NO--FORGET IT
;FINAL SUMMARY FOR COMPILATION
;PRINT OUT TIMES FOR PHASES
IFN DEBUG, <EXTERNAL %ATIME,%GTIME,TOPLOC,IMPURE,FREESP
EXTERNAL NAMCT1,NAMCT2,NAMCT3,NAMDIS,DISTSZ,%TTIME,%RTIME,%RGTIM,%RATIM
SUMARY: TSWF FNOLST ;ANY LISTING?
POPJ PP, ;NO--QUIT
MOVEI TA,0
RUNTIM TA,
MOVEM TA,%RGTIM+1
MSTIME CP,
MOVEM CP,%GTIME+1
SETZM PAGCNT
PUSHJ PP,HDROUT
MOVE TE,[POINT 7,[ASCIZ "Checkout Summary
Elapsed CPU
"]]
PUSHJ PP,LSTMES
MOVEI TA,%ATIME
MOVEI TB,"A"
SETZM %TTIME
SETZM %RTIME
TIMLUP: 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)
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
TIML2: PUSHJ PP,LCRLF
TIML3: 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
MOVE TE,[POINT 7,[ASCIZ ", not including GETSEG"]]
PUSHJ PP,LSTMES
MOVE TE,%TTIME
PUSHJ PP,TIMOUT
MOVE TE,[POINT 7,[ASCIZ ", CPU 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
TABDEB: 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 DATBAS,0
BASLOC ARRBAS,0
BASLOC OTFBAS,0
BASLOC ICHBAS,0
BASLOC OCHBAS,0
BASLOC FTBBAS,0
BASLOC RESDNT,0
BASLOC NONRES,0
BASLOC LITBAS,0
BASLOC TEMBAS,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
POPJ PP,
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 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
TIMO2: 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
;FINAL SUMMARY FOR COMPILATION (CONT'D)
;TABLE OF TABLES
DEFINE TABSET (A,B,C,E,F,G),<
EXTERNAL A'LOC
SIXBIT "E"
XWD ^D'B+1,A'LOC>
TABDT: TABLES
TABDX: XWD <TABDT-.>/2,TABDT
> ;END OF "IFN DEBUG" FOR SUMMARY
;PRODUCE CREF LISTING
IFE CREF,<XLIST>
IFN CREF,<
CREFL: 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
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 LUMBER 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: TTCALL 3,[ASCIZ "?COULDN'T FIND CREF FILE"]
EXIT
> ; IFN CREF
LIST
;TABLE OF ROUTINES TO CREATE ADDRESS, BY ADDRESS TYPE
ADRTB1: JRST ADRCON ;CONSTANT
PUSHJ PP,ADRDAT ;ICHTAB
PUSHJ PP,ADRPRO ;PROTAB
JRST ADREXT ;EXTAB
PUSHJ PP,ADRFIL ;FTBTAB
PUSHJ PP,ADRTAG ;OCHTAB
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,OTFBAS ;ADD TO OTFBAS
HRR TB,OCHBAS ;ADD TO BAS OF OCHTAB
HRR TB,LITBAS ;ADD TO LITERAL POOL BASE
HRR TB,ICHBAS ;ADD TO BASE OF ICHTAB
HRR TB,PC ;ADD TO CURRENT LOCATION
PUSHJ PP,TMPINC ;ADD TO TEMPORARY BASE
HRR TB,DATBAS ;ADD TO BASE OF DATA
;TABLE OF ROUTINES USED TO LIST THE ADDRESS
ADRTB2: JRST LSCON1 ;ADDRESS IS CONSTANT <100000
ADD DT,ICHLOC ;ICHTAB
ADD DT,PROLOC ;PROTAB
JRST LSTEXT ;EXTAB
JRST LSTFTB ;FTBTAB
ADD DT,OCHLOC## ;OCHTAB
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 "%OTF"]
MOVE TA,[SIXBIT "%OCH"]
MOVE TA,[SIXBIT "%LIT"]
MOVE TA,[SIXBIT "%ICH"]
MOVSI TA,160000
PUSHJ PP,TMPLST
MOVE TA,[SIXBIT "%DAT"]
;TABLE OF ROUTINES WHICH LIST CONSTANTS
CONTAB: EXP LSTD1
EXP LSTD2
EXP LSTFLT
EXP LSTOCT
;TABLE TO AID IN PUTTING OUT 'GETSEG' ROUTINE
GETTAB: SIXBIT "SYS"
POINT 7,[ASCIZ /%RPGLB: SIXBIT "SYS"/]
%LB6
%LB7
IFN %CPU-%20,<
SIXBIT "SHR"
POINT 7,[ASCIZ / SIXBIT "SHR"/]
>
IFE %CPU-%20,<
SIXBIT "EXE"
POINT 7,[ASCIZ / SIXBIT "EXE"/]
>
Z
POINT 7,[ASCIZ / Z/]
Z
POINT 7,[ASCIZ / Z/]
Z
POINT 7,[ASCIZ / Z/]
;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>
FLTAB0: .TAB. FLTAB1
XX==<FLTAB1-FLTAB0> ;CALCULATE NUMBER OF TABLE ENTRIES BEFORE "FLTAB1"
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
;TABLE OF PDP-10 OP-CODES
DEFINE OPCODE (MNEM,OP10,LISTAC,LIST10),<
XWD LISTAC*1B18+LIST10,OP10
SIXBIT "MNEM">
DEFINE UUOTPX (UUOTYP,UUOSIZ),<
XWD UUOTYP,UUOSIZ>
DEFINE TABLE1,<
XLIST
OPTABL: OPCODE MOVE,200,1,0 ;000
OPCODE MOVEI,201,1,1 ;001
OPCODE MOVEM,202,1,0 ;002
OPCODE MOVM,214,1,0 ;003
OPCODE MOVMM,216,1,0 ;004
OPCODE MOVN,210,1,0 ;005
OPCODE MOVNI,211,1,1 ;006
OPCODE MOVNM,212,1,0 ;007
OPCODE MOVS,204,1,0 ;010
OPCODE MOVSI,205,1,1 ;011
OPCODE ADD,270,1,0 ;012
OPCODE ADDI,271,1,1 ;013
OPCODE ADDM,272,1,0 ;014
OPCODE ADDB,273,1,0 ;015
OPCODE SUB,274,1,0 ;016
OPCODE SUBI,275,1,1 ;017
OPCODE SUBM,276,1,0 ;020
OPCODE MUL,224,1,0 ;021
OPCODE MULI,225,1,1 ;022
OPCODE IMUL,220,1,0 ;023
OPCODE IMULI,221,1,1 ;024
OPCODE ASH,240,1,1 ;025
OPCODE DIV,234,1,0 ;026
OPCODE TDO,670,1,0 ;027
OPCODE TDZ,630,1,0 ;030
OPCODE IDIV,230,1,0 ;031
OPCODE IDIVI,231,1,1 ;032
OPCODE IDIVM,232,1,0 ;033
OPCODE FADR,144,1,0 ;034
OPCODE FADRM,146,1,0 ;035
OPCODE FSBR,154,1,0 ;036
OPCODE FSBRM,156,1,0 ;037
OPCODE FMPR,164,1,0 ;040
OPCODE FMPRM,166,1,0 ;041
OPCODE FDVR,174,1,0 ;042
OPCODE FDVRM,176,1,0 ;043
OPCODE DPB,137,1,0 ;044
OPCODE LDB,135,1,0 ;045
OPCODE IDPB,136,1,0 ;046
OPCODE ILDB,134,1 ;047
OPCODE AOS,350,1,0 ;050
OPCODE SOS,370,0,0 ;051
OPCODE SOSGE,375,0,0 ;052
OPCODE SOSLE,373,0,0 ;053
OPCODE CAME,312,1,0 ;054
OPCODE CAIE,302,1,1 ;055
OPCODE CAMG,317,1,0 ;056
OPCODE CAIG,307,1,1 ;057
OPCODE CAMGE,315,1,0 ;060
OPCODE CAIGE,305,1,1 ;061
OPCODE CAML,311,1,0 ;062
OPCODE CAIL,301,1,1 ;063
OPCODE CAMLE,313,1,0 ;064
OPCODE CAILE,303,1,1 ;065
OPCODE CAMN,316,1,0 ;066
OPCODE CAIN,306,1,1 ;067
OPCODE JUMPE,322,1,0 ;070
OPCODE JUMPG,327,1,0 ;071
OPCODE JUMPGE,325,1,0 ;072
OPCODE JUMPL,321,1,0 ;073
OPCODE JUMPLE,323,1,0 ;074
OPCODE JUMPN,326,1,0 ;075
OPCODE JRST,254,0,0 ;076
OPCODE SKIPE,332,0,0 ;077
OPCODE SKIPG,337,0,0 ;100
OPCODE SKIPGE,335,0,0 ;101
OPCODE SKIPL,331,0,0 ;102
OPCODE SKIPLE,333,0,0 ;103
OPCODE SKIPN,336,0,0 ;104
OPCODE SKIPA,334,1,0 ;105
OPCODE TRNE,602,1,0 ;106
OPCODE TRNN,606,1,0 ;107
OPCODE TLNE,603,1,0 ;110
OPCODE TLNN,607,1,0 ;111
OPCODE IBP,133,0,0 ;112
OPCODE PUSHJ,260,1,0 ;113
OPCODE BLT,251,1,0 ;114
OPCODE SETZM,402,0,0 ;115
OPCODE SETOM,476,0,0 ;116
OPCODE TDCA,654,1,0 ;117
OPCODE ANDM,406,1,0 ;120
OPCODE TDNN,616,1,0 ;121
OPCODE HRLOI,525,1,0 ;122
OPCODE HRROI,561,1,0 ;123
OPCODE HRLZI,515,1,0 ;124
OPCODE HRRZI,551,1,0 ;125
OPCODE SETZB,403,1,0 ;126
OPCODE ARG,320,1,0 ;127
OPCODE SOJG,367,1,0 ;130
OPCODE EXCH,250,1,0 ;131
OPCODE CALLI,047,1,0 ;132
OPCODE TLZ,621,1,0 ;133
OPCODE TLO,661,1,0 ;134
OPCODE SETCA,450,1,0 ;135
OPCODE SETCMM,462,1,0 ;136
OPCODE POPJ,263,1,0 ;137
OPCODE SUBSCR,1,1,0 ;140
OPCODE UUO7,7,1,0 ;141
OPCODE FIX.,10,1,0 ;142
OPCODE UUO11,11,1,0 ;143
OPCODE PERF.,12,1,0 ;144
OPCODE FLOT.1,13,1,0 ;145
OPCODE FLOT.2,14,1,0 ;146
OPCODE PD6.,15,1,0 ;147
OPCODE PD7.,16,1,0 ;150
OPCODE GD6.,17,1,0 ;151
OPCODE GD7.,20,1,0 ;152
OPCODE NEG.,21,1,0 ;153
OPCODE MAG.,22,1,0 ;154
OPCODE ADD.12,23,1,0 ;155
OPCODE ADD.21,24,1,0 ;156
OPCODE ADD.22,25,1,0 ;157
OPCODE SUB.12,26,1,0 ;160
OPCODE SUB.21,27,1,0 ;161
OPCODE SUB.22,30,1,0 ;162
OPCODE MUL.12,31,1,0 ;163
OPCODE MUL.21,32,1,0 ;164
OPCODE MUL.22,33,1,0 ;165
OPCODE DIV.11,34,1,0 ;166
OPCODE DIV.12,35,1,0 ;167
OPCODE DIV.21,36,1,0 ;170
OPCODE DIV.22,37,1,0 ;171
UUOTBL: UUOTPX UOTP1,UOSZ1 ;OPEN,CLOSE
UUOTPX UOTP2,UOSZ2 ;I/O
UUOTPX UOTP3,UOSZ3 ;COMPARISON
UUOTPX UOTP4,UOSZ4 ;CONVERSION
UUOTPX UOTP5,UOSZ5 ;MISCELLANEOUS
LIST>
DEFINE UUOCOD (MNEM,OP10),<
IFIDN <MNEM>,<PERF.>,<EXP 1B0+OP10>
IFDIF <MNEM>,<PERF.>,<XWD 0,OP10>
SIXBIT "MNEM">
DEFINE UUOIRP(A,B),<
IRP A,<
UUOCOD A,B>>
DEFINE UUOTSZ (A),<
XXX==<.-UOTP'A>/2
IFE XXX&1,<UOSZ'A==XXX/2>
IFN XXX&1,<UOSZ'A==XXX/2+1>
UUONUM==UUONUM+UOSZ'A
UUOTNM==UUOTNM+1
>
FSTSPC==140 ;ASYFIL CODE FOR FIRST UUO
NUMSPC==32 ;NUMBER OF UUO'S WHICH ACCEPT ANY AC-FIELD
FSTUUO==172 ;FIRST UUO WHICH USES AC-FILED TO FURTHER DEFINE OP-CODE
UUOTNM==0
UUONUM==NUMSPC
DEFINE TABLE2,<
XLIST
UOTP1: UUOIRP <ULOSE.,ULOSE.>,1
UUOTSZ 1
UOTP2: UUOIRP <ULOSE.,ULOSE.,ULOSE.,ULOSE.,ULOSE.,ULOSE.>,2
UUOIRP <ULOSE.,ULOSE.,ULOSE.>,2
UUOIRP <ULOSE.,ULOSE.>,2
UUOTSZ 2
UOTP3: UUOIRP <COMP.,CMP.11>,3
UUOIRP <CMP.12,CMP.21,CMP.22,CMP.76,CMP.96,CMP.97>,3
UUOIRP <SPAC.6,SPAC.7,SPAC.9,COMP%,CMP%11,CMP%12>,3
UUOIRP <CMP%21,CMP%22>,3
UUOTSZ 3
UOTP4: UUOIRP <MOVE.,C.D6D7,C.D6D9>,4
UUOIRP <C.D7D6,C.D7D9,C.D9D6,C.D9D7>,4
UUOIRP <MVSGNR,MVSGN>,4
UUOIRP <TESTZ,TIME.,TIMED.,RSVWD.,TESTB.,SQRT.,DEBUG.>,4
UUOTSZ 4
UOTP5: UUOIRP <SETOF.,SETON.,INDC.>,5
UUOIRP <FORCE.,EXCPT.,.READ.,CHAIN.>,5
UUOIRP <DSPLY.,ULOSE.,ULOSE.,ULOSE.>,5
UUOIRP <ULOSE.,ULOSE.,ULOSE.,ULOSE.,ULOSE.>,5
UUOTSZ 5
LIST>
TABLE1
TABLE2
ASAC: POINT 4,W1,12 ;AC-FIELD OF OPERATOR
COMSIZ==1600 ;SIZE OF COMMON IN OBJECT PROGRAM
ENDIT==177
SIZED==5 ;SIZE OF LARGEST NUMBER PRINTED AT TABD2
EXTERNAL LNKCOD,TB.FIL
EXTERNAL .JBOPS,COUNTF,COUNTW
EXTERNAL %ES.PC,END.PC
EXTERNAL NAMLOC,DATLOC,FILLOC,FILNXT,PROLOC,EXTLOC,EXTNXT
EXTERNAL LITLOC,TAGOUT,SAVTAG,DATGRP,DECSEG,ASYFIL,NAMNXT,LITBLK
EXTERNAL ASOP,INCTYP,ADRTYP,PTSEGN,RESDNT,NONRES,DATBAS,TEMBAS,USEBAS
EXTERNAL EAS2PC,IMPPAR,LITBAS,OTFBAS,ICHBAS,OCHBAS,INDBAS,FLTC1,FLTC2
EXTERNAL SYMLC1,SYMREL,UUOBIT,CURREL,SYMGRP,LSTBH
EXTERNAL PRGID,PROGST,GHOLD,PAGCNT,GAERAS,NUMEXT,EXTCNT
EXTERNAL BINHDR,BINDEV,BINBUF,BINPP,BINBH,OVRWRD,CURLIT,HILOC,HPLOC
EXTERNAL LSTDEV,CRFDEV,CRFBHI,CRFBUF,CRFHDR
EXTERNAL FTDBAS,FIXEDS,OBJSIZ,HDRPAG,SUBPAG
EXTERNAL GCREFC,GCREFN,OLDCNM,CREFSW,PRODSW
EXTERNAL LMASKB
END