Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0130/macro.mac
There are 45 other files named macro.mac in the archive. Click here to see a list.
TITLE MACRO %50A(441)
SUBTTL RPG/CMF/JF/PMH/DMN/JNT/RKH/JBC/ILG 1-Jul-76
;COPYRIGHT 1968,1969,1970,1971,1972,1973,1974,1975,1976 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
VMACRO==50 ;VERSION NUMBER
VUPDATE==1 ;DEC UPDATE LEVEL
VEDIT==441 ;EDIT NUMBER
VCUSTOM==2 ;NON-DEC UPDATE LEVEL
LOC <.JBVER==137>
<VCUSTOM>B2+<VMACRO>B11+<VUPDATE>B17+VEDIT
RELOC
COMMENT * ASSEMBLY FEATURE SWITCHES (ACTION WHEN NON-ZERO)
SWITCHES ON (NON-ZERO) IN DEC VERSION
PURESW GIVES TWO SEGMENT MACRO
CCLSW GIVES RAPID PROGRAM GENERATION FEATURE
TEMP TMPCOR UUO IS TO BE USED
FORMSW USE MORE READABLE FORMATS FOR LISTING (ICCSW)
DFRMSW DEFAULT CONDITION OF FORMAT PRINTING (MULTI-FORM IF ON)
KI10 GIVES KI10 OP-CODES
KL10 GIVES KL10 OP-CODES
SWITCHES OFF (ZERO) IN DEC VERSION
STANSW GIVES STANFORD FEATURES
LNSSW GIVES LNS VERSION
IIISW GIVES III FEATURES
OPHSH GIVES HASH SEARCH OF OPCODES
TENEX GIVES BBN TENEX FEATURES
POLISH GIVES EXTERNAL ARITHMETIC EXPRESSIONS
AND PSECT MULTIPLE RELOCATION COUNTERS
TSTCD GIVES LINK DEBUGGING AND DEVELOPMENT DIRECTIVES
*
SUBTTL DEFAULT ASSEMBLY SWITCH SETTINGS
IFNDEF FT.U01,<FT.U01==1>
IFNDEF PURESW,<PURESW==1>
IFNDEF STANSW,<STANSW==0>
IFN STANSW,<CCLSW==1>
IFNDEF LNSSW,<LNSSW==0>
IFNDEF CCLSW,<CCLSW==1>
IFNDEF TEMP,<TEMP==1>
IFNDEF IIISW,<IIISW==0>
IFN IIISW,<
IFNDEF DFRMSW,<DFRMSW==0>>
IFNDEF DFRMSW,<DFRMSW==1>
IFN DFRMSW,<FORMSW==1>
IFNDEF FORMSW,<FORMSW==1>
IFNDEF OPHSH,<OPHSH==0>
IFNDEF KI10,<KI10==1>
IFNDEF KL10,<KL10==1>
IFN KL10,<KI10==1>
IFNDEF TENEX,<TENEX==0>
IFNDEF POLISH,<POLISH==0>
IFNDEF TSTCD,<TSTCD==0>
SUBTTL REVISION HISTORY
;START OF 50
;114 (6113) TIDY UP SYMBOL TABLE LISTING
;115 IMPLEMENT BINARY UNIVERSAL FILES
;116 (6272) CORRECT LISTING OF CERTAIN BYTE FIELDS
;117 (6321) MINOR FIX FOR I.S.C.
;120 (6245) LABEL IN LITERAL
;121 ADD PSEUDO-OP .COMMON
;122 ADD PSEUDO-OPS .REQUIRE AND .REQUEST
;123 ADD ^! (XOR) AND ^- (NOT) OPERATORS
;124 (6350) V ERRORS ON PASS 1
;125 (6483) X ERRORS ON PASS 1
;126 SOME SLIGHT SPEEDUPS IN BYPASS ROUTINE (NOW A MACRO)
;127 FREE A FLAG BIT FOR POLISH FIXUPS (FUTURE)
;130 (6482) GENERATE MULTIPLE CREF NO. FOR EXP 1,2,3,,ETC.
;131 (6476) REMOVE BLANKS AT END OF COMMAND STRING
;132 (6477) INCORRECT DEFAULT EXT FOR @ FILES
;133 (6475) MISSING MACRO LISTING WITH SALL
;134 (6506) FIX BUG IN HASHED OPCODES
;135 (6764) MAKE OPDEF PRINT VALUE LIKE =
;136 (6803) ADD SYMBOL .CPU. FOR HOST CPU TYPE
;137 (6765) BETTER HANDLING OF () IN MACRO CALLS
;140 (6708) DON'T NEED <> FOR SINGLE LINE CONDITIONALS
;141 (6629) DON'T CREF .XCREF
;142 (6509) COUNT PAGES CORRECTLY ON PRGEND
;143 (6698) GIVE "Q" ERROR IF MORE THAN 18 BIT VALUES IN XWD
;144 CHANGE EOL CHAR TO LF, QIVE "Q" ERROR ON FREE CR
;145 MAKE "Q" ERRORS PRINT AS WARNINGS INSTEAD OF ERRORS
;146 CALL HELPER TO PRINT HELP TEXT
;147 ADD NEW I/O DEVICE CODES AND NEW UUOS
;150 (6894) FIX LOCATION COUNTER IN PHASE CODE
;151 ADD FAIL COMPATIBLE PSEUDO-OP .LINK (LINK), .LNKEND (LNKEND), .ORG (ORG)
;152 (7063) COUNT <> IN CHARACTER LOOKAHEAD
;153 (6981) VERY LONG SEQUENCED LINES DON'T PRINT CORRECTLY
;154 (7018) 87 CHAR LONG LINE GET EXTRA CR-LF IN LISTING
;155 (7005) LABEL IN LITERALS AGAIN
;156 (7116) SUPERSEDED BY 225
;157 (7027) PRINT SEQUENCED BLANK LINE
;160 (7078) GARBAGE IN BITS 0-3 OF RADIX-50 IN SOME MACROS
;161 (7373) MAKE PAGE PSEUDO-OP INCREASE PAGE INCREMENT NO. ONLY
;162 ADD SFD LOGIC
;163 (7435) SUPERSEDED BY 204
;164 ADD POLISH EXPRESSIONS (NOT SUPPORTED)
;165 REMOVE 0 LISTED ON FIRST LINE AFTER PRGEND
;167 (7462) ADD ! TO SUPPRESS SYMBOLS
;170 (7638) FIX ILL MEM REFS ON PRGEND
;171 (8374) TEST AND GIVE ERROR IF EXP AFTER \ IN MACRO CALL IS A MACRO
;173 (8264) SAVE AND RESTORE ACCS IN SYN ROUTINE IF CORE EXPANSION IS REQUIRED
;175 (8606) ONLY USE ASCII 37 AS CONTINUATION CHARACTER IF AT END OF LINE
;176 (8633) CORRECTLY HANDLE <> IN COMMENTS IN MACROS AFTER ;;
;200 MAKE DEFAULT NUMBER OF BUFFERS BE 5
;201 ADD DATE75 HACK
;202 ADD PSEUDO-OP .DIRECTIVE
;203 (10071) FIX TWOSEG & PRGEND INTERACTION SO LOAD FORLIB IN LOW SEG
;204 (11044) CLEAR PNTF IF 18 BIT VALUE (UNLESS EXTERN) AT INSRT4
;205 (10820) FIX #154 INCASE IN MACROS
;206 ADD TENEX FEATURES
;207 FORCE END STATEMENT IF END NOT SEEN
;210 ADD EXTERNAL START ADDRESS ON END STATEMENT
;211 ALLOW <> IN COMMAND TO BE SAME AS []
;212 PUT ERROR MESSAGES IN STANDARD FORM
;213 PUT ASSEMBLY ERRORS IN CREF TABLE
;214 OUTPUT COMPILER TYPE IN HEADER BLOCK (TYPE 6)
;215 (9810) DON'T LIST COMMENT BEFORE MACRO EXPANSION IF IN REPEAT
;216 MAKE DEFAULT [DIRECTORY] WORK
;217 (9996) TURN ON SALL IN LITERALS SO MACRO CALLS DON'T EXPAND
;220 (9633) MAKE .XCREF APPLY TO SPECIFIC SYMBOLS
;221 (9508) IF NEXT LINE AFTER TAPE PSEUDO-OP IS FF OR VT LIST IT
;222 (9499) MORE OF #124
;223 (10393) FIX ILL MEM REF ON END MACRO
;224 (S-033) MINOR VERSION NUMBER DECODE LOGIC WRONG
;225 (11907) REDEFINING MACROS IN PRGENDS
;226 (11929) MORE OF ABOVE, WHEN A UNIVERSAL FILE HAS BEEN READ
;227 (S-034) ADD SWITCH /nnL TO GIVE LINES/PAGE, ALSO MAKE 2 LARGER
;230 DON'T SEARCH UNIVERSAL FILE ON LABEL & ASSIGNMENT DEFINITIONS
;231 EXPAND CORE TO HOLD BOTH COPIES IN UNIVERSAL AND PRGEND
;232 ADD .TEXT PSEUDO-OP TO GENERATE ASCIZ BLOCK TYPE FOR LINK-10
;233 CHECK FOR INVALID ARG TO BLOCK PSEUDO-OP
;234 OUTPUT CPU TIME TAKEN FOR ASSEMBLY
;235 ADD .DIRECTIVE KA10,KI10 TO SET BIT IN BLOCK TYPE 6
;236 FIX SALL/XLIST BUG, MAKE XALL ONLY TURN OFF SALL
;237 (12493) GIVE U ERROR ON LABEL DEFINED AND USED IN SAME LITERAL
;240 (12631) ENHANCEMENTS TO BINARY UNIVERSALS
;241 (13033) INCORRECT CHECKING OF ACC "C" AGAINST ASCII AT STMNT2+13
;242 (13034) SAVE AC0 (AND SOME OTHERS) AT OUTPL1
;243 (13402) MAKE LOWER CASE WORK WITH SINGLE QUOTES
;244 EXTEND EDIT #210 TO ALLOW EXTERNAL + CONSTANT
;245 (13047) FLAG QUESTIONABLE USE OF SINGLE QUOTE WITH "Q" ERROR
;246 (13119) WRITE CREF FILE IN DEFAULT PATH
;247 (12803) FLAG QUESTIONABLE USE OF # AND ## ON SAME SYMBOL
;250 (13032) CLEAR MORE ERROR BITS ON PASS1 IN MULTI-LINE LITERAL
;251 FIX PROGRAM BREAK IF LIT STATEMENT IN PRGEND
;252 DON'T GIVE "Q" ERROR ON EXTRA "CR" (SEE EDIT #144)
;253 DON'T PRINT GARBAGE ON PASS1 ERROR IN MULTI-LINE LIT
;254 USE ALL AVAILABLE PRINTING SPACES FOR LONG LINES
;255 FIX UNARY MINUS BUG IN EDIT #164
;256 (13664) HANDLE SPECIAL EXTERN IN UNIVERSAL CORRECTLY
;257 HANDLE VERTICAL TABS CORRECTLY
;260 FIX BUG IN #140, THROW AWAY JUNK BEFORE COMMA
;261 HANDLE SOS PAGE MARK CORRECTLY
;262 TRAP ILL MEM REF CAUSED BY MISSING CLOSE PAREN IN MACRO ARG LIST (#137)
;263 DON'T DESTROY ACC RC IN LONG LINE OF ASCIZ TEXT
;264 FIX BUG IN #175 CAUSING EXTRA CR-LF
;265 ADD PSECT CODE UNDER POLISH SWITCH, THIS IS VERSION 51 ONLY
;266 FIX LOOP CAUSED BY MISSING ")" IN SEARCH MODS (#240)
;267 DON'T PASS DEFINITION FLAG TO CREF ON ##
;270 DOUBLE SIZE OF BASIC PUSHDOWN STACK
;271 ADD .IF PSEUDO-OP
;272 FIX LOOP CAUSED BY #260 IF EOL ENCOUNTERED
;VERSION 50 (272) RELEASED NOV-74
;273 ADD BYPASS TO FIX ERROR WITH PPN SPEC FOR .REQUIRE & .REQUEST
;274 (14734) FIX PROBLEM WITH .IF CONDITIONALS
;275 (14723) FIX SPURIOUS MONRET WITH STICKY PPNS
;276 (14811) CAUSE * AND / TO GIVE N ERRORS WHEN THEY OVERFLOW
;277 ALLOW ALTMODES TO TERMINATE COMMAND STRINGS AGAIN
;EDITS 300 THROUGH 317 WERE USED FOR MACRO 51
;320 (Q3086) FIX MCRNES MESSAGE IN DEFINE AFTER SIXBIT//
;321 (Q3085) FIX LITERALS NOT LISTING IN MACROS AND SOME BOGUS V ERRORS WHEN NOT LALL
;322 CHANGE RADIX50 TO GIVE Q ERROR ON CODE NOT 74 BITS
;323 (14943) FIX TO MAKE EXTERNALS REFERENCED IN UNIVERSALS WORK
;324 (14957) FIX FOR E ERRORS WHEN OPDEF REFERENCES EXTERNAL OF SAME NAME
;325 (15043) CHANGE 152 & 176 TO NOT PRINT ANGLE BRACKETS OR 1 ; AFTER ;;
;326 (15218) CHANGE MCRNEC MESSAGE TO GIVE UP ASSEMBLY
;327 FIX THE CRLF'S WHEN LALL IS USED IN A MACRO UNDER SALL
;330 (15277) CORRECT VALUE OF SYMBOL .CPU. FOR KA-10
;331 (15279) CORRECT OUTPUT OF .TEXT BLOCKS GENERATING MORE THAN 18 WORDS
;332 CORRECTION TO 325 WHEN ;;> IS END OF MACRO
;333 (15280) ^ IS SOMETIMES SWALLOWED WHEN NOT FOLLOWED BY ! OR -
;334 (15293) DEFAULT MACRO ARGUMENTS ARE NOT SAVED IN BINARY UNIVERSALS
;335 (15406) SCAN .REQUIRE,.REQUEST WITH FILE SPEC SCANNER, NOT GETSYM
;336 (15485) CLEAN UP 323 TO MAKE IT THE SAME AS PUBLISHED 256
;337 FIX EDIT 333 TO MAKE ^! ^- WORK AGAIN
;340 (15682) CHECK FOR FORWARD DEFINED ENTRIES BEFORE MAKING UNDEFINES EXTERNAL
;341 FIX ERRORS WITH DEFAULT ARGUMENTS
;342 (15680) ADD PORTAL OPCODE
;343 (15683) DON'T SEARCH UNIVERSALS WHEN DEFINING INTERN,EXTERN,ETC
;344 LIST MOVE [CONO] CORRECTLY
;345 (16130) CORRECT EDIT 335 TO BYPASS EXTRA TABS AND SPACES
;346 (16130) PREVENT RELOC FROM OPERATING ACROSS PRGEND'S
;347 (16250) FIX EDITS 325 AND 332 TO HANDLE MACROS TERMINATING
; ON THE SAME LINE
;350 (16471) EDIT 345 BREAKS SCANNING OF .REQU??? TYPE ITEM BECAUSE
; BYPASS MACRO EATS FIRST CHARACTER OF SPEC.
;351 (16335) WHEN AN OPEN ANGLE BRACKET IS MISSING AFTER IRPC,
; DON'T CRASH WHILE SEARCHING FOR IT.
;352 (16589) FIX '[DEVICE] NOT AVAILABLE' ERROR MESSAGE TYPEOUT
;353 REMOVE EDIT 343
;354 (16804) FIX EDIT 351 TO ALLOW COMMA BEFORE OPEN BRACKET IN IRP,IRPC
; ADD 'MISSING OPEN BRACKET' ERROR MESSAGE FOR IRP
;355 (16878) CHECK ENOUGH CORE ALLOTTED FOR UNIVERSAL FILES WITH PRGEND
;356 (16883) GIVE ERROR MESSAGE IF UNABLE TO WRITE UNIVERSAL FILE
;357 (17041) FIX EDITS 333,337 TO MAKE ^!,^- WORK IN A MACRO
;360 (16690) FIX '[SYMBOL] UNASSIGNED, DEFINED AS IF EXTERNAL' ERROR
; MESSAGE TYPEOUT
;361 (17046) FIX EDITS 351,354 TO ALLOW ) BEFORE OPEN ANGLE BRACKET
;362 ADD .DIRECTIVES .OKOVL,.EROVL TO ALLOW * OR / OVERFLOW
;363 (16988) INSERT UNDEFINED SYMBOL PRECEDED BY UNARY MINUS IN UNDEFINED SYMBOL TABLE
;364 (17147) ADD SEPARATE 'UNIVERSAL VERSION SKEW' ERROR MESSAGE
;365 (17143) FIX .CREF,.XCREF FOR MULTIPLY-ENTERED SYMBOLS
;366 (17256) FIX HANDLING OF FIRST LEVEL ANGLE BRACKETS INSIDE MACROS
;367 (16559) FIX ERROR HANDLING IN LITERALS
;370 (17387) FIX .TEXT FLAG HANDLING
;371 (16710) CORRECT DECREMENTING OF MACROS DEFINED IN UNIVERSALS BELOW 1
;372 (17912) FIX .XTABM FOR SPECIAL CASES
;373 (17913) ADD ERROR MESSAGE FOR MISSING < IN REPEAT
;374 (17993) FIX HANDLING OF RELOCATABLE ARGUMENTS WITH ^L
;375 (17994) FIX PREVIOUS EDITS TO ^- AND ^! OPERATORS
;376 (18280) CORRECT EDIT 367, IT BROKE ERRORS IN SINGLE LINE LITERALS
;377 ADD MCRPGE (PRGEND ERROR) MNEMONIC
;400 PRESERVE OLD .REL FILE AND PRODUCE PARTIAL LISTING AFTER
; MRCNEC OR MRCPDL ERROR
;401 DON'T ALLOW SHIFT TO DELETE RELOCATION FACTOR
;402 (17904) FIX "LABEL + OFFSET" FOR LABELS IN LITERALS
;403 REPLACE MCREWU,MCRERU ERROR MESSAGES WITH EXISTING I/O MESSAGES
;404 (18768) FIX CHECK FOR ! AFTER SYMBOL IN INTERN,EXTERN,SUPRESS,ETC.
;405 (18282) CHECK FOR DEFAULT PPN SUCH AS [,NNNN] OR [NNNN,]
;406 (18894) DON'T ALLOW SEMI-INFINITE LOOP IN ASSIGNMENT STATEMENT
;407 EDIT 401 IS A GOOD IDEA,BUT IT BROKE OLD PROGRAMS
;410 GENERAL CLEANUP IN PREPARATION FOR RELEASE.
;411 (18828) /N SHOULDN'T SUPRESS %....X SYMBOLS IN CREF
;412 CLEAR HISNSW AT PRGEND FOR NEXT PROGRAM
;413 ADD .DIRECTIVE KL10, MAKE IT OK TO HAVE MULTIPLE CPUS
;414 ADD .DIRECTIVES .TCDON/.TCDOFF FOR TESTING NEW LINK CODES
;415 SUPERSEDE EDITS 367,376 FOR CLARITY
;416 (Q0320) FIX ^- AGAIN. EDITS 375,333 SUPERSEDED.
;417 (Q0316) EDIT 221 BROKE TAPE PSEUDO-OP WHEN EOF FOLLOWS
;420 (Q0322) RESET TITLE TO ".MAIN" AT PRGEND
;421 (Q0328) CLEAN UP THE .DIRECTIVE CODE, ADD .DIRECTIVE NO
;422 (Q0363) FIX DEFAULT ARG READ-IN FOR DEFINES IN MACROS
;423 MAKE .LINK PSEUDO-OP READ 3RD ARGUMENT CORRECTLY.
;424 (18893) CHECK FOR ILLEGAL CHARACTERS AT ASTERISK LEVEL.
;425 (19585) REWORK EDIT 373
;426 CLEAN UP EDITS 351,354,361
;427 (Q0390) ALLOW NULL EXTENSIONS IN SOURCE SPECIFICATIONS
;430 (20036) IMPLEMENT "%MCRSOC STATEMENT OUT OF ORDER .COMMON [SYMBOL]" MESSAGE
;431 CLEAN UP UNIVERSAL I/O ERROR MESSAGES
;432 FURTHER CLEANUP FOR RELEASE
;; MACRO 50A RELEASE IN FALL, 1976
;440 FIX "R" ERRORS (WITH EXTERNAL SYMBOLS) CAUSED BY EDIT 324
;441 FIX "P" ERRORS WHEN SYMBOL FORWARD-REFERENCED ACROSS LITERAL
;
;*****CUSTOMER REVISION HISTORY*****
;1 IMPLEMENT USER PUSHDOWN LIST--FEATURE TEST FT.U01
;2 CLEAR USER PDP ON PRGEND AND END, CHECK FOR STACK UNDERFLOW
;******************* END OF REVISION HISTORY *******************
SUBTTL OTHER PARAMETERS
IFN FT.U01,<$USRLN==^D50> ;LENGTH OF USER PUSH DOWN LIST
.PDP== ^D100 ;[270] BASIC PUSH-DOWN POINTER
IFNDEF LPTWID,<LPTWID==^D132> ;DEFAULT WIDTH OF PRINTER
.LPTWD==8*<LPTWID/8> ;USEFUL WIDTH IN MAIN LISTING
.CPL== .LPTWD-^D32 ;WIDTH AVAILABLE FOR TEXT WHEN
;BINARY IS IN HALFWORD FORMAT
.CPLX==LPTWID-.LPTWD ;[254] EXCESS SPACE IN LAST TAB STOP
IFNDEF .LPP,< ;[227]
IFE STANSW,<.LPP==^D57 ;LINES/PAGE>
IFN STANSW,<.LPP==^D52 ;LINES/PAGE>
>
.STP== ^D40 ;STOW SIZE
.TBUF== ^D80 ;TITLE BUFFER
.SBUF== ^D80 ;SUB-TITLE BUFFER
.IFBLK==^D20 ;IFIDN COMPARISON BLOCK SIZE
.R1B==^D18
.UNIV==^D10 ;NUMBER OF UNIVERSAL SYMBOL TABLES ALLOWED
.LEAF==4 ;SIZE OF BLOCKS IN MACRO TREE
.UVER==5 ;[334] VERSION # OF UNV FILE
.SFDLN==5 ;[162] NUMBER OF SFD'S ALLOWED
NCOLS==LPTWID/^D32 ;NUMBER OF COLUMNS IN SYMBOL TABLE
SGNSGS==^D64 ;MAX # OF DISTINCT PSECTS ALLOWED
;IN ONE ASSEMBLY
SGNDEP==^D16 ;MAX PSECT DEPTH ALLOWED
IFN CCLSW,<IFNDEF CTLSIZ,<CTLSIZ==^D200>>
IFN OPHSH,<IFNDEF PRIME,<PRIME==^D701>>
IFNDEF NUMBUF,<NUMBUF==5> ;[200] NUMBER OF INPUT BUFFERS
EXTERN .JBREL,.JBFF,.JBAPR,.JBSA,.JBERR
EXTERN .HELPR
IFDEF .REQUEST,<.REQUEST REL:HELPER > ;[122]
LOWL:! ;START OF LOW SEGMENT
IFN PURESW,<TWOSEGMENTS
RELOC 400000>
SALL ;SUPPRESS ALL MACROS
;SOME ASCII CHARACTERS
HT==11
LF==12
VT==13
FF==14
CR==15
CZ==32
EOL==33
CLA==37
;ACCUMULATORS
AC0== 0
AC1= AC0+1
AC2= AC1+1
SDEL= 3 ;SEARCH INCREMENT
SX= SDEL+1 ;SEARCH INDEX
ARG= 5 ;ARGUMENT
V= 6 ;VALUE
C= 7 ;CURRENT CHARACTER
CS= C+1 ;CHARACTER STATUS BITS
RC= 11 ;RELOCATION BITS
MWP= 12 ;MACRO WRITE POINTER
MRP= 13 ;MACRO READ POINTER
IO= 14 ;IO REGISTER (LEFT)
ER== IO ;ERROR REGISTER (RIGHT)
FR= 15 ;FLAG REGISTER (LEFT)
RX== FR ;CURRENT RADIX (RIGHT)
MP= 16 ;MACRO PUSHDOWN POINTER
PP= 17 ;BASIC PUSHDOWN POINTER
%OP== 3
%MAC== 5
%DSYM== 2
%SYM== 1
%DMAC== %MAC+1
%ERR==%MAC
OPDEF RESET [CALLI 0]
OPDEF SETDDT [CALLI 2]
OPDEF DDTOUT [CALLI 3]
OPDEF DEVCHR [CALLI 4]
OPDEF CORE [CALLI 11]
OPDEF EXIT [CALLI 12]
OPDEF UTPCLR [CALLI 13]
OPDEF DATE [CALLI 14]
OPDEF APRENB [CALLI 16]
OPDEF MSTIME [CALLI 23]
OPDEF PJOB [CALLI 30]
OPDEF RUN [CALLI 35]
OPDEF TMPCOR [CALLI 44]
OPDEF MTWAT. [MTAPE 0]
OPDEF MTREW. [MTAPE 1]
OPDEF MTEOT. [MTAPE 10]
OPDEF MTSKF. [MTAPE 16]
OPDEF MTBSF. [MTAPE 17]
;FR FLAG REGISTER (FR/RX)
IOSCR== 000001 ;NO CR AFTER LINE
POLSW== 000002 ;[164] DOING POLISH ON GLOBALS
MTAPSW==000004 ;MAG TAPE
ERRQSW==000010 ;IGNORE Q ERRORS
LOADSW==000020 ;END OF PASS1 & NO EOF YET
DCFSW== 000040 ;DECIMAL FRACTION
RIM1SW==000100 ;RIM10 MODE
NEGSW== 000200 ;NEGATIVE ATOM
RIMSW== 000400 ;RIM OUTPUT
PNCHSW==001000 ;RIM/BIN OUTPUT WANTED
CREFSW==002000
R1BSW== 004000 ;RIM10 BINARY OUTPUT
TMPSW== 010000 ;EVALUATE CURRENT ATOM
INDSW== 020000 ;INDIRECT ADDRESSING WANTED
RADXSW==040000 ;RADIX ERROR SWITCH
FSNSW== 100000 ;NON BLANK FIELD SEEN
MWLFLG==200000 ;ON FOR DON'T ALLOW MULTI-WORD LITERALS
P1== 400000 ;PASS1
;IO FLAG REGISTER (IO/ER)
FLDSW== 400000 ;ADDRESS FIELD
IOMSTR==200000
ARPGSW==100000 ;ALLOW RAPID PROGRAM GENERATION
IOPROG==040000 ;SUPRESS LISTING (LIST/XLIST PSEUDO OP)
NUMSW== 020000
IOMAC== 010000 ;MACRO EXPANSION IN PROGRESS
IOPALL==004000 ;SUPRESS LISTING OF MACRO EXPANSIONS
IONCRF==002000 ;SUPRESS OUTPUT OF CREF INFORMATION
CRPGSW==001000 ;CURRENTLY IN PROGRESS ON RPG
IOCREF==000400 ;WE ARE NOW OUTPUTTING CREF INFO
IOENDL==000200 ;BEEN TO STOUT
IOPAGE==000100
DEFCRS==000040 ;THIS IS A DEFINING OCCURANCE (MACROS)
IOIOPF==000020 ;IOP INSTRUCTION SEEN
MFLSW== 000010 ;MULTI-FILE MODE,PRGEND SEEN
IORPTC==000004 ;REPEAT CURRENT CHARACTER
RSASSW==000002 ;[265] REFERENCE IS TO A SYMBOL IN ANOTHER PSECT
IOSALL==000001 ;SUPPRESS MACRO LISTING EVEN IF BINARY IS GENERATED
OPDEF JUMP1 [JUMPL FR, ] ;JUMP IF PASS 1
OPDEF JUMP2 [JUMPGE FR, ] ;JUMP IF PASS 2
OPDEF JUMPOC [JUMPGE IO, ] ;JUMP IF IN OP-CODE FIELD
OPDEF JUMPAD [JUMPL IO, ] ;JUMP IF IN ADDRESS FIELD
OPDEF JUMPCM [JUMPL CS, ] ;JUMP IF CURRENT CHAR IS COMMA
OPDEF JUMPNC [JUMPGE CS, ] ;JUMP IF CURRENT CHAR IS NON-COMMA
OPDEF PJRST [JRST] ;JUMP TO POPJ PP, ;RETURN
OPDEF HALT [HALT] ;TO PUT IN CREF TABLE
;ER ERROR REGISTERS (IO/ER)
ERRS== 000010 ;[265] ILLEGAL PSECT USAGE
ERRM== 000020 ;MULTIPLY DEFINED SYMBOL
ERRE== 000040 ;ILLEGAL USE OF EXTERNAL
ERRP== 000100 ;PHASE DISCREPANCY
ERRO== 000200 ;UNDEFINED OP CODE
ERRN== 000400 ;NUMBER ERROR
ERRV== 001000 ;VALUE PREVIOUSLY UNDEFINED
ERRU== 002000 ;UNDEFINED SYMBOL
ERRR== 004000 ;RELOCATION ERROR
ERRL== 010000 ;LITERAL ERROR
ERRD== 020000 ;REFERENCE TO MULTIPLY DEFINED SYMBOL
ERRA== 040000 ;PECULIAR ARGUMENT
ERRX== 100000 ;MACRO DEFINITION ERROR
ERRQ== 200000 ;QUESTIONABLE, NON-FATAL ERROR
ERROR1==ERRP!ERRM!ERRV!ERRX ;[125] ERRORS THAT PRINT ON PASS 1
ERRORS==777760
LPTSW== 000002
TTYSW== 000001
;SYMBOL TABLE FLAGS
SYMF== 400000 ;SYMBOL
TAGF== 200000 ;TAG
NOOUTF==100000 ;NO DDT OUTPUT WFW
SYNF== 040000 ;SYNONYM
MACF== SYNF_-1 ;MACRO
OPDF== SYNF_-2 ;OPDEF
PNTF== 004000 ;"VALUE" IN SYMBOL TBL IS PNTR TO 36BIT VALUE
UNDF== 002000 ;UNDEFINED
EXTF== 001000 ;EXTERNAL
INTF== 000400 ;INTERNAL
ENTF== 000200 ;ENTRY
VARF== 000100 ;VARIABLE
NCRF== 000040 ;[220] DO NOT CREF THIS SYMBOL
MDFF== 000020 ;MULTIPLY DEFINED
SPTR== 000010 ;SPECIAL EXTERNAL POINTER
SUPRBT==000004 ;SUPRESS OUTPUT TO REL AND LISTING
LELF== 000002 ;LEFT HAND RELOCATABLE
RELF== 000001 ;RIGHT HAND RELOCATABLE
LITF== 200000 ;FLAG FOR PSEUDO-OPS INVALID IN LIT'S
ADDF== 100000 ;FLAG FOR PSEUDO-OPS INVALID IN ADDRESSES
TNODE== 200000 ;TERMINAL NODE FOR EVALEX
;USEFUL MACROS
DEFINE FORERR(AC,ABC)<
MOVE AC,[PAGENO,,ABC'PG]
BLT AC,ABC'PG+3
>
;MACRO TO BYPASS LEADING TABS AND SPACES
DEFINE BYPASS <
PUSHJ PP,GETCHR
JUMPE C,.-1
>
SUBTTL START ASSEMBLING
ASSEMB: PUSHJ PP,INZ ;INITIALIZE FOR PASS
SKIPA AC1,.+1 ;LOCALIZED CODE
ASCII /.MAIN/
MOVEM AC1,TBUF
SETZM TBUF+1 ;SIGNAL NOT YET SEEN A TITLE
MOVEI SBUF
HRRM SUBTTX
ASSEM1: PUSHJ PP,CHARAC ;TEST FOR FORM FEED
SKIPGE LIMBO ;CRLF FLAG?
JRST ASSEM1 ;YES ,IGNORE LF
CAIN C,14
SKIPE SEQNO
JRST ASSEM2
PUSHJ PP,OUTFF1
PUSHJ PP,OUTLI
JRST ASSEM1
ASSEM2: AOS TAGINC
CAIN C,"\" ;BACK-SLASH?
TLZA IO,IOMAC ;YES, LIST IF IN MACRO
TLO IO,IORPTC
PUSHJ PP,STMNT ;OFF WE GO
TLZN IO,IOENDL ;WAS STOUT PRE-EMPTED?
PUSHJ PP,STOUT ;NO, POLISH OFF LINE
JRST ASSEM1
SUBTTL STATEMENT PROCESSOR
STMNT: TLZ FR,INDSW!FSNSW
SETZM UPARROW ;[375]CLEAR SPECIAL REPEAT CHARACTER
TLZA IO,FLDSW
STMNT1: PUSHJ PP,LABEL
STMNT2: PUSHJ PP,ATOM ;GET THE FIRST ATOM
CAIN C,'=' ;"="?
JRST ASSIGN ;YES
CAIN C,':' ;":"?
JRST STMNT1 ;YES
JUMPAD STMNT7 ;NUMERIC EXPRESSION
JUMPN AC0,STMN2A ;JUMP IF NON NULL FIELD
SKIPN LITLVL ;ALLOW COMMA IN LITERALS
CAIE C,',' ;NULL, COMMA?
CAIN C,EOL ;OR END OF LINE?
POPJ PP, ;YES,EXIT
CAIN C,']' ;[241] CLOSING LITERAL?
POPJ PP, ;YES
JRST STMNT9 ;NO,AT LEAST SKIP ALL THIS NONSENSE
STMN2A: JUMPE C,.+2
TLO IO,IORPTC
PUSHJ PP,MSRCH ;SEARCH FOR MACRO/OPDEF/SYN
JRST STMNT3 ;NOT FOUND, TRY OP CODE
LDB SDEL,[POINT 3,ARG,5]
JUMPE SDEL,ERRAX ;ERROR IF NO FLAGS
SOJE SDEL,OPD1 ;OPDEF IF 1
SOJE SDEL,CALLM ;MACRO IF 2
JRST STMNT4 ;SYNONYM, PROCESS WITH OP-CODES
STMNT3: PUSHJ PP,OPTSCH ;SEARCH OP CODE TABLE
JRST STMNT5 ;NOT FOUND
STMNT4: HLLZ AC0,V ;PUT CODE IN AC0
TRZ V,ADDF ;CLEAR ADDRESS NON-VALID FLAG
TRZE V,LITF ;VALID IN LITERAL?
SKIPN LITLVL ;NO, ARE WE IN A LITERAL?
JRST 0(V) ;NO, GO TO APPROPRIATE PROCESSOR
POPJ PP, ;YES,EXIT
STMNT5: PUSHJ PP,SSRCH ;TRY SYMBOLS
JRST STMNT8 ;NOT FOUND
TLNN ARG,EXTF!UNDF ;EXTERNAL OR UNDEFINED?
TDNE RC,[-2,,-2] ;CHECK FOR EXTERNAL
JRST STMNT7 ;YES, PROCESS IN EVALEX
MOVE AC0,V ;FOUND, PUT VALUE IN AC0
TLO IO,NUMSW ;FLAG AS NUMERIC
STMNT7: TLZ IO,IORPTC
STMNT9: PUSHJ PP,EVALHA ;EVALUATE EXPRESSION
IFN FORMSW,< MOVE AC1,HWFORM ;USE STANDARD FORM>
TLNE FR,FSNSW ;FIELD SEEN?
JRST STOW ;YES,STOW THE CODE AND EXIT
CAIE C,']' ;CLOSING LITERAL?
TRO ER,ERRQ ;NO, GIVE "Q" ERROR
POPJ PP, ;EXIT
STMNT8: MOVEI V,0 ;ALWAYS START SCAN WITH 0
CAIL V,CALNTH ;END OF TABLE?
JRST STMN8C ;YES, TRY TTCALLS
CAME AC0,CALTBL(V) ;FOUND IT?
AOJA V,.-3 ;NO,TRY AGAIN
SUBI V,NEGCAL ;CALLI'S START AT -1
HRLI V,(CALLI) ;PUT IN UUO
STMN8D: MOVSI ARG,OPDF ;SET FLAG FOR OPDEF
STMN8B: PUSHJ PP,INSERT ;PUT OPDEF IN TABLE
JRST OPD ;AND TREAT AS OPDEF
STMN8C: SETZ V, ;START WITH ZERO
CAIL V,TTCLTH ;END OF TABLE?
JRST STMN8E ;TRY MTAPES
CAME AC0,TTCTBL(V) ;MATCH?
AOJA V,.-3 ;NO, KEEP TRYING
LSH V,5 ;PUT IN AC FIELD (RIGHT HALF)
HRLZI V,<(TTCALL)>(V) ;PUT UUO IN LEFT HALF
JRST STMN8D ;SET OPDEF FLAG
STMN8E: SETZ V, ;START AT ZERO
CAIL V,MTALTH ;END OF TABLE?
JRST STMN8A ;YES, ERROR
CAME AC0,MTATBL(V) ;MATCH
AOJA V,.-3 ;NOT YET
PUSH PP,AC0 ;SAVE IT
MOVE AC0,[POINT 9,MTACOD]
IBP AC0 ;GET TO RIGHT ONE
SOJGE V,.-1 ;EVENTUALLY
LDB V,AC0 ;GET FUNCTION
HRLI V,(MTAPE) ;FILL IN OPCODE
POP PP,AC0
JRST STMN8D
STMN8A: SETZB V,RC ;CLEAR VALUE AND RELOCATION
TRO ER,ERRO ;FLAG AS UNDEFINED OP-CODE
JUMP1 OPD ;TREAT AS STANDARD OP ON PASS1
MOVSI ARG,OPDF!UNDF!EXTF ;SET A FEW FLAGS
JRST STMN8B ;TO FORCE OUT A MESSAGE
SUBTTL LABEL PROCESSOR
LABEL: JUMPAD LABEL4 ;COMPARE IF NON-SYMBOLIC
JUMPE AC0,LABEL5 ;ERROR IF BLANK
TLO IO,DEFCRS ;THIS IS A DEFINITION
SKIPN LITLVL ;[402] LABEL IN LITERAL?
JRST LABL10 ;[402] NO
SETOM LBLFLG ;[402] SET FLAG
EXCH AC0,STPX ;[402]
MOVEM AC0,LTGINC ;[402] SET MARKER
EXCH AC0,STPX ;[402]
LABL10: PUSH PP,UNISCH+1 ;[402] SAVE SEARCH LIST
SETZM UNISCH+1 ;BUT DISALLOW
PUSHJ PP,SSRCH ;SEARCH FOR OPERAND
MOVSI ARG,SYMF!UNDF!TAGF ;NOT FOUND
POP PP,UNISCH+1 ;RESTORE STATUS
TLNN ARG,EXTF ;OPERAND FOUND (SKIP EXIT)
JRST LABEL0
JUMP1 LABEL3 ;ERROR ON PASS1
TLNN ARG,UNDF ;UNDEFINED ON PASS1
JRST LABEL3 ;NO, FLAG ERROR
TLZ ARG,EXTF!PNTF ;TURN OFF EXT FLAG NOW
JUMPE V,LABEL0 ;NOTHING TO CHAIN IF 0
MOVE RC,LOCAL ;GET CURENT POINTER
MOVEM RC,1(ARG) ;STORE OVER NAME
HRRM ARG,LOCAL ;LINK INTO CHAIN
MOVE RC,LOCA ;GET CURRENT LOCATION
HRLM RC,(ARG) ;STORE BUT SWAPPED
LSH V,-^D17 ;SHIFT RELOCATION TO BIT 34
IOR V,MODA ;CURRENT RELOCATION
HRLM V,1(ARG) ;STORE IT
LABEL0: TLZN ARG,UNDF!VARF ;WAS IT PREVIOUSLY DEFINED?
JRST LABEL2 ;YES, CHECK EQUALITY
MOVE V,LOCA ;WFW
MOVE RC,MODA
TLO ARG,TAGF
PUSHJ PP,PEEK ;GET NEXT CHAR.
CAIE C,":" ;SPECIAL CHECK FOR ::
JRST LABEL1 ;NO MATCH
TLO ARG,INTF ;MAKE IT INTERNAL
PUSHJ PP,GETCHR ;PROCESS NEXT CHAR.
PUSHJ PP,PEEK ;PREVIEW NEXT CHAR.
LABEL1: CAIE C,"!" ;HALF-KILL SIGN
JRST LABEL6 ;NO
TLO ARG,NOOUTF ;YES, SUPPRESS IT
PUSHJ PP,GETCHR ;AND GET RID OF IT
LABEL6: MOVEM AC0,TAG ;SAVE FOR PASS 1 ERRORS
HLLZS TAGINC ;ZERO INCREMENT
JRST INSERT ;INSERT/UPDATE AND EXIT
LABEL2: HRLOM V,LOCBLK ;SAVE LIST LOCATION
IFN POLISH,<
CAMLE SX,SGSBOT ;IS IT IN THE
CAMLE SX,SGSTOP ; CURRENT PSECT
JRST LABEL3> ;NO, FLAG ERROR
CAMN V,LOCA ;DOES IT COMPARE WITH PREVIOUS? WFW
CAME RC,MODA
LABEL3: TLOA ARG,MDFF ;NO, FLAG MULTIPLY DEFINED AND SKIP
JRST LABEL7 ;YES, GET RID OF EXTRA CHARS.
TRO ER,ERRM ;FLAG MULTIPLY DEFINED ERROR
JRST UPDATE ;UPDATE AND EXIT
LABEL4: CAMN AC0,LOCA ;DO THEY COMPARE?
CAME RC,MODA
LABEL5: TRO ER,ERRP ;NO, FLAG PHASE ERROR
POPJ PP,
LABEL7: SKIPN LITLVL ;[155] LABEL IN A LITERAL?
JRST LABEL8 ;[155] NO
MOVEM AC0,LITLBL ;[155] YES, SAVE LABEL NAME FOR LATER
MOVE AC0,STPX ;[155] CURRENT DEPTH
SUB AC0,STPY ;[155] MINUS START
MOVEM AC0,LITLBL+1 ;[155] STORE DEPTH IN LIT
MOVE AC0,LITLBL ;[155] RESTORE 0
TLO ARG,UNDF ;[237] PUT BACK U FLAG
IORM ARG,0(SX) ;[237] INCASE REFERENCED IN SAME LITERAL
JRST LABEL9 ;DON'T STORE LABEL IN LIT
LABEL8: MOVEM AC0,TAG ;SAVE FOR ERRORS
HLLZS TAGINC
LABEL9: PUSHJ PP,PEEK ;INSPECT A CHAR.
CAIN C,":" ;COLON?
PUSHJ PP,GETCHR ;YES, DISPOSE OF IT
PUSHJ PP,PEEK ;EXAMINE ONE MORE CHAR.
CAIN C,"!" ;EXCLAMATION?
JRST GETCHR ;YES, INDEED
POPJ PP,
SUBTTL ATOM PROCESSOR
ATOM: PUSHJ PP,CELL ;GET FIRST CELL
TLNE IO,NUMSW ;IF NON-NUMERIC
ATOM1: CAIE C,42 ;OR NOT A BINARY SHIFT,
POPJ PP, ;EXIT
PUSH PP,AC0 ;STACK REGISTERS, ITS A BINARY SHIFT
PUSH PP,AC1
PUSH PP,RC
PUSH PP,RX
HRRI RX,^D10 ;COMPUTE SHIFT RADIX 10
PUSHJ PP,CELLSF ;GET SHIFT
MOVE ARG,RC ;SAVE RELOCATION
POP PP,RX ;RESTORE REGISTERS
POP PP,RC
POP PP,AC1
MOVN SX,AC0 ;USE NEGATIVE OF SHIFT
POP PP,AC0
JUMPN ARG,NUMER2 ;IF NOT ABSOLUTE
TLNN IO,NUMSW ;AND NUMERIC,
JRST NUMER2 ;FLAG ERROR
LSHC AC0,^D35(SX)
LSH RC,^D35(SX)
JRST ATOM1 ;TEST FOR ANOTHER
CELLSF: TLO IO,FLDSW
CELL: SETZB AC0,RC ;CLEAR RESULT AND RELOCATION
SETZB AC1,AC2 ;CLEAR WORK REGISTERS
MOVEM PP,PPTEMP ;SAVE PUSHDOWN POINTER
TLZ IO,NUMSW
TLZA FR,NEGSW!DCFSW!RADXSW
CELL1: TLO IO,FLDSW
AOSLE UPARRO ;[333] SKIP GETCHR IF RE-EATING ^
BYPASS
LDB V,[POINT 4,CSTAT(C),14] ;GET CODE
XCT .+1(V) ;EXECUTE, INDEX VIA BITS 11,12,13,14 OF CSTAT TABLE
JRST CELL1 ;0; BLANK, (TAB OR "+")
JRST LETTER ;1; LETTER ] $ % ( ) , ; >
TLC FR,NEGSW ;2; "-"
TLO FR,INDSW ;3; "@"
JRST NUM1 ;4; NUMERIC 0 - 9
JRST ANGLB ;5; "<"
JRST SQBRK ;6; "["
JRST QUOTES ;7; ""","'"
JRST QUAL ;10; "^"
JRST PERIOD ;11; "."
TROA ER,ERRQ ;12; ERROR, FLAG AND TREAT AS DELIMITER
;12; ! # & * / : = ? \ _
LETTER: TLOA AC2,(POINT 6,AC0,) ;SET BYTE POINTER
LETTE1: PUSHJ PP,GETCHR ;GET CHARACTER
TLNN CS,6 ;ALPHA-NUMERIC?
JRST LETTE3 ;NO,TEST FOR VARIABLE
TLNE AC2,770000 ;STORE ONLY SIX BYTES
LETTE2: IDPB C,AC2 ;RETURN FROM PERIOD
JRST LETTE1
LETTE3: CAIE C,03 ;"#"?
POPJ PP,
JUMPE AC0,POPOUT ;TEST FOR NULL
PUSHJ PP,PEEK ;PEEK AT NEXT CHAR.
CAIN C,"#" ;IS IT 2ND #?
JRST LETTE4 ;YES, THEN IT'S AN EXTERN
TLO IO,DEFCRS
PUSHJ PP,SSRCH ;YES, SEARCH FOR SYMBOL (OPERAND)
MOVSI ARG,SYMF!UNDF ;NOT FOUND, FLAG AS UNDEFINED SYM.
TLNN ARG,UNDF ;UNDEFINED?
JRST LETTE5 ;[247] NO, BUT SEE IF ALREADY DEFINED AS EXTERNAL
TLO ARG,VARF ;YES, FLAG AS A VARIABLE
TRO ER,ERRU ;SET UNDEFINED ERROR FLAG
PUSHJ PP,INSERZ ;INSERT IT WITH A ZERO VALUE
JRST GETDEL
LETTE4: PUSHJ PP,GETCHR ;AND SCAN PAST IT
TLZ IO,DEFCRS ;[267] MAKE SURE NOT A DEFINITION
PUSHJ PP,EXTER5 ;[267] PUT IN SYMBOL TABLE
JRST GETCHR ;GET RID OF #
LETTE5: TLNE ARG,EXTF ;[247] EXTERNAL
TRO ER,ERRQ ;[247] YES, FLAG WITH "Q" ERROR
JRST GETCHR ;[247] GET NEXT CHAR AND RETURN
NUMER1: SETZB AC0,RC ;RETURN ZERO
NUMER2: TRO ER,ERRN ;FLAG ERROR
GETDEL: PUSHJ PP,GETCHR
GETDE1: JUMPE C,.-1
MOVEI AC1,0
GETDE3: TLO IO,NUMSW!FLDSW ;FLAG NUMERIC
TLNN FR,NEGSW ;IS ATOM NEGATIVE?
POPJ PP, ;NO, EXIT
JUMPE AC1,GETDE2
MOVNS AC1
TDCA AC0,[-1]
GETDE2: MOVNS AC0 ;YES, NEGATE VALUE
MOVNS RC ;AND RELOCATION
POPOUT: POPJ PP, ;EXIT
QUOTES: CAIE C,"'"-40 ;IS IT "'"
JRST QUOTE ;NO MUST BE """
JRST SQUOTE ;YES
QUOTE0: TLNE AC0,376000 ;5 CHARACTERS STORED ALREADY?
TRO ER,ERRQ ;YES, GIVE WARNING
ASH AC0,7
IOR AC0,C
QUOTE: PUSHJ PP,CHARAC ;GET 7-BIT ASCII
CAIG C,15 ;TEST FOR LF, VT, FF OR CR
CAIGE C,12
JRST .+2 ;NO, SO ALL IS WELL
JRST QUOTE2 ;ESCAPE WITH Q ERROR
CAIE C,42
JRST QUOTE0
PUSHJ PP,PEEK ;LOOK AT NEXT CHAR.
CAIE C,42
JRST QUOTE1 ;RESTORE REPEAT LEVEL AND QUIT
PUSHJ PP,CHARAC ;GET NEXT CHAR.
JRST QUOTE0 ;USE IT
QUOTE2: TRO ER,ERRQ ;SET Q ERROR
QUOTE1: JRST GETDEL
SQUOT0: CAIL C,"a" ;[243] TEST FOR LOWER CASE
CAILE C,"z" ;[243] ...
JRST .+2 ;[243] NO
SUBI C," " ;[243]
TLNE AC0,770000 ;SIX CHARS. STORED ALREADY ?
TRO ER,ERRQ ;YES
LSH AC0,6
IORI AC0,-40(C) ;OR IN SIXBIT CHAR.
SQUOTE: PUSHJ PP,CHARAC
CAIG C,CR
CAIGE C,LF
JRST .+2
JRST QUOTE2 ;[245] FLAG WITH "Q" ERROR
CAIE C,"'"
JRST SQUOT0
PUSHJ PP,PEEK
CAIE C,"'"
JRST QUOTE1
PUSHJ PP,CHARAC
JRST SQUOT0
QUAL: BYPASS ;SKIP BLANKS, GET NEXT CHARACTER
CAIN C,'B' ;"B"?
JRST QUAL2 ;YES, RADIX=D2
CAIN C,'O' ;"O"?
JRST QUAL8 ;YES, RADIX=D8
CAIN C,'F' ;"F"?
JRST NUMDF ;YES, PROCESS DECIMAL FRACTION
CAIN C,'L' ;"L"?
JRST QUALL ;YES
CAIN C,'-' ;[123] "^-" IS NOT
JRST QUALN ;[123]
CAIE C,'D' ;"D"?
JRST NUMER1 ;NO, FLAG NUMERIC ERROR
ADDI AC2,2
QUAL8: ADDI AC2,6
QUAL2: ADDI AC2,2
PUSH PP,RX
HRR RX,AC2
PUSHJ PP,CELLSF
QUAL2A: POP PP,RX
TLNN IO,NUMSW
JRST NUMER1
JRST GETDE1
QUALL: PUSH PP,FR
PUSHJ PP,CELLSF
MOVE AC2,AC0
MOVEI AC0,^D36
SETZ RC, ;[374] IN CASE ARG IS RELOCATABLE
JUMPE AC2,QUAL2A
LSH AC2,-1
SOJA AC0,.-2
QUALN: MOVE CS,CSTATN ;[416]GET CHARACTERISTICS FOR "^-"
JRST GETDE1 ;[416]THEN GET DELIMITER
SUBTTL LITERAL PROCESSOR
SQBRK: PUSH PP,TAG ;[402] SAVE CURRENT TAG
PUSH PP,TAGINC ;[402] AND OFFSET
PUSH PP,FR
PUSH PP,EXTPNT ;ALLOW EXTERN TO PRECEDE LIT IN XWD
IFN FORMSW,< PUSH PP,IOSEEN ;[344] SAVE I/O INSTRUCTION SEEN VALUE>
SETZM EXTPNT
SKIPE LITLVL ;SAVE SEQNO AND PAGE IF NOT IN LIT ALREADY
JRST SQB5
FORERR (C,LIT)
SQB5: JSP AC2,SVSTOW
PUSH PP,[0] ;[217] STACK A ZERO
TLNE IO,IOPALL ;[217] LEAVE ALONE IF LALL ON
TLNN IO,IOSALL ;[321] TEST IF SALL ALREADY ON
SETOM (PP) ;[217] SIGNAL NOT BY -1
PUSH PP,LITERR ;[415]SAVE LITERR FROM PREVIOUS LEVEL
SETZM LITERR ;[415]CLEAR IT FOR THIS LEVEL
SQB3: PUSHJ PP,STMNT
IORM ER,LITERR ;[415]GET CUMMULATIVE ERRORS FOR LEVEL
CAIN C,75 ;CHECK FOR ]
JRST SQB1
TLO IO,IORPTC
TLNE FR,MWLFLG ;CALL IT ] IF NOT MULTI-WORD FLAG
JRST SQB2 ;BUT REPEAT LAST CHARACTER
BYPASS
CAIN C,EOL
TLOA IO,IORPTC
TRO ER,ERRQ
SQB4: PUSHJ PP,CHARAC
CAIN C,";" ;COMMENT?
JRST SQB6 ;YES, IGNORE SQUARE BRACKETS
CAIN C,"]" ;LOOK FOR TERMINAL SQB
TRNN ER,ERRORS ;IN CASE OF ERROR IN LITERAL
JRST .+2 ;NO ALL IS WELL
JRST SQB1 ;FINISH THE LITERAL NOW!!
CAIG C,FF ;LOOK FOR END OF LINE
CAIN C,HT
JRST SQB4
SQB4A: PUSHJ PP,OUTIML ;DUMP
PUSHJ PP,CHARAC ;GET ANOTHER CHAR.
SKIPL LIMBO ;CRLF FLAG
TLO IO,IORPTC ;NO REPEAT
JRST SQB3
SQB6: PUSHJ PP,CHARAC ;GET A CHARACTER
CAIG C,CR
CAIN C,HT ;LOOK FOR END OF LINE CHAR.
JRST SQB6 ;NOT YET
JRST SQB4A ;GOT IT
SQB1: TLZ IO,IORPTC
SQB2: PUSHJ PP,STOLIT
POP PP,LITERR ;[415]RESTORE LITERR FOR NEXT LEVEL
SKIPE (PP) ;[217] WAS SALL ORIGINALLY ON?
TLZ IO,IOSALL ;[217] NO, SO TURN IT OFF
POP PP,(PP) ;[217] GET STACK RIGHT
JSP AC2,GTSTOW
SKIPE LITLBL ;NEED TO FIXUP A LABEL?
PUSHJ PP,RELBLE ;YES, USE LOC OF LITERAL
IFN POLISH,<
SKIPE POLITS ;[265] NEED TO FIXUP ANY POLISH?
PUSHJ PP,SQBPOL ;[265] YES
>
IFN FORMSW,< POP PP,IOSEEN ;[344] RESTORE IOSEEN FOR LISTING>
POP PP,EXTPNT
POP PP,FR
POP PP,TAGINC ;[402] RESTORE PREVIOUS OFFSET
POP PP,TAG ;[402] AND LABEL
SETZM LBLFLG ;[402] ZERO 'LABEL-IN-LITERAL' FLAG
SETZM LTGINC ;[402] AND MARKER
SKIPE LITLVL ;WERE WE NESTED?
JUMP1 NUMER2 ;YES, FORCE ERROR IF PASS 1
JUMP2 GETDEL ;[120] USE VALUE GIVEN IF PASS 2
TRO ER,ERRU ;[120] VALUE IS UNDEFINED ON PASS 1
SETZ AC0, ;[120] SO SET IT TO 0
JRST GETDEL ;[120]
RELBLE: PUSH PP,AC0 ;SAVE LOCATION COUNTER
PUSH PP,RC ;AND RELOCATION
MOVE AC0,LITLBL ;SYMBOL WE NEED
SETZM LITLBL ;ZERO INDICATOR
PUSHJ PP,SSRCH ;SEARCH FOR OPERAND
JRST RELBL1 ;SHOULD NEVER HAPPEN
TLNN ARG,TAGF ;IT BETTER BE A LABEL
JRST RELBL1 ;IT WASN'T , GIVE UP BEFORE SOME HARM IS DONE
TLZ ARG,UNDF!EXTF!PNTF ;CLEAR FLAGS NOW
POP PP,RC ;GET LITERAL RELOCATION
MOVE V,(PP) ;GET VALUE (LOC COUNTER)
ADD V,LITLBL+1 ;[155] PLUS DEPTH IN LITERAL
PUSHJ PP,UPDATE ;UPDATE VALUE
POP PP,AC0 ;RESTORE LITERAL COUNT
POPJ PP, ;RETURN
RELBL1: POP PP,RC ;RESTORE RC
POP PP,AC0 ;AND AC0
POPJ PP, ;JUST RETURN
IFN POLISH,< ;[265]
;HERE TO FIXUP POLISH EXPRESSIONS INSIDE CURRENT LIT
;AS EACH ONE IS FIXED MOVE IT TO POLIST
SQBPOL: PUSH PP,CS ;GET SOME FREE ACCS
PUSH PP,AC0 ;SAVE LOC
SQBPL1: MOVE CS,@POLITS ;GET A BLOCK POINTER
EXCH CS,POLITS ;SET FOR NEXT TIME
MOVE AC0,CS ;GET A COPY
EXCH AC0,POLIST ;STORE IN LIST OF "GOOD" POLISH
MOVEM AC0,(CS) ;LINK IN
SQBPL2: ADDI CS,1 ;FIRST WORD
MOVE AC0,(CS) ;GET SOMETHING
JUMPL AC0,SQBPL5 ;THIS IS AN OPERATOR
JUMPE AC0,SQBPL4 ;18 BIT VALUE
SOJE AC0,SQBPL3 ;36 BIT VALUE
AOJA CS,SQBPL2 ;SYMBOL
SQBPL3: ADDI CS,1 ;SKIP OVER 2 WORDS
SQBPL4: AOJA CS,SQBPL2 ;GET NEXT
SQBPL5: HRRZ AC0,AC0 ;GET OPERATOR ONLY
CAIGE AC0,-6 ;[265] CHECK FOR STORE OP
JRST SQBPL2 ;ITS NOT
MOVE AC0,0(PP) ;GET ADDRESS
ADDM AC0,1(CS) ;ADD TO OFFSET
HRLM RC,1(CS) ;SET RELOCATION
SKIPE POLITS ;MORE TO DO?
JRST SQBPL1 ;YES
POP PP,AC0 ;RESTORE LOC
POP PP,CS ;AND SAVED AC
POPJ PP,
>
SUBTTL NUMBER PROCESSOR
ANGLB: PUSH PP,FR
TLZ FR,INDSW
PUSHJ PP,ATOM
TLNN IO,NUMSW
CAIE C,35
JRST ANGLB1
PUSHJ PP,ASSIG1
MOVE AC0,V
JRST ANGLB2
ANGLB1: PUSHJ PP,EVALHA
ANGLB2: POP PP,FR
CAIE C,36
TRO ER,ERRN
JRST GETDEL
PERIOD: PUSHJ PP,GETCHR ;LOOK AT NEXT CHARACTER
TLNN CS,2 ;ALPHABETIC?
JRST PERNUM ;NO, TEST NUMERIC
MOVSI AC0,'. ' ;YES, PUT PERIOD IN AC0
MOVSI AC2,(POINT 6,AC0,5) ;SET BYTE POINTER
JRST LETTE2 ;AND TREAT AS SYMBOL
PERNUM: TLNE CS,4 ;IS IT A NUMBER
JRST NUM32 ;YES
MOVE AC0,LOCA ;NO. CURRENT LOC SYMBOL (.)
MOVE RC,MODA ;SET TO CURRENT ASSEMBLY MODE
JRST GETDE1 ;GET DELIMITER
NUMDF: TLO FR,DCFSW ;SET DECIMAL FRACTION FLAG
NUM: PUSHJ PP,GETCHR ;GET A CHARACTER
TLNN CS,4 ;NUMERIC?
JRST NUM10 ;NO
NUM1: SUBI C,20 ;CONVERT TO OCTAL
PUSH PP,C ;STACK FOR FLOATING POINT
SKIPE AC0 ;ARE WE ABOUT TO LOSE SOME DATA?
TRO ER,ERRQ ;YES, AT LEAST WARN USER
MOVE AC0,AC1
MULI AC0,0(RX)
ADD AC1,C ;ADD IN LAST VALUE
CAIL C,0(RX) ;IS NUMBER LESS THAN CURRENT RADIX?
TLO FR,RADXSW ;NO, SET FLAG
AOJA AC2,NUM ;YES, AC2=NO. OF DECIMAL PLACES
NUM10: CAIE C,'.' ;PERIOD?
TLNE FR,DCFSW ;OR DECIMAL FRACTION?
JRST NUM30 ;YES, PROCESS FLOATING POINT
SETZ CS, ;AND CLEAR IT
CAIN C,'K' ;SEE IF SUFFIX THERE
MOVEI CS,3
CAIN C,'M'
MOVEI CS,6
CAIN C,'G'
MOVEI CS,9
JUMPE CS,NUM12 ;NO SUFFIX?
MOVE AC0,AC1 ;SCALE THE NUMBER
MULI AC0,(RX)
SOJG CS,.-2
PUSHJ PP,GETCHR ;SKIP THE SUFFIX
NUM12: MOVE CS,CSTAT(C) ;RESTORE STATUS
LSH AC1,1 ;NO, CLEAR THE SIGN BIT
LSHC AC0,^D35 ;AND SHIFT INTO AC0
MOVE PP,PPTEMP ;RESTORE PP
SOJE AC2,GETDE1 ;NO RADIX ERROR TEST IF ONE DIGIT
TLNE FR,RADXSW ;WAS ILLEGAL NUMBER ENCOUNTERED?
TRO ER,ERRN ;YES, FLAG N ERROR
JRST GETDE1
NUM30: CAIE C,'B' ;IF "B" THEN MISSING "."
NUM31: PUSHJ PP,GETCHR
TLNN CS,4 ;NUMERIC?
JRST NUM40 ;NO
NUM32: SUBI C,20
PUSH PP,C
JRST NUM31
NUM40: PUSH PP,FR ;STACK VALUES
HRRI RX,^D10
PUSH PP,AC2
PUSH PP,PPTEMP
CAIN C,45 ;"E"?
JRST [PUSHJ PP,PEEK ;GET NEXT CHAR
PUSH PP,C ;SAVE NEXT CHAR
PUSHJ PP,CELL ;YES, GET EXPONENT
POP PP,C ;GET FIRST CHAR. AFTER E
CAIN V,4 ;MUST HAVE NUMERICAL STATUS
JRST .+2 ;SKIP RETURN
CAIN C,"<" ;ALLOW <EXP>
JRST .+2 ;SKIP RETURN
SKIPN AC0 ;ERROR IF NON-ZERO EXPRESSION
TROA ER,ERRQ ;ALLOW E+,E-
SETOM RC ;FORCE NUMERICAL ERROR
JRST .+2] ;SKIP RETURN
MOVEI AC0,0 ;NO, ZERO EXPONENT
POP PP,PPTEMP
POP PP,SX
POP PP,FR
HRRZ V,PP
MOVE PP,PPTEMP
JUMPN RC,NUMER1 ;EXPONENT MUST BE ABSOLUTE
ADD SX,AC0
HRRZ ARG,PP
ADD SX,ARG
SETZB AC0,AC2
TLNE FR,DCFSW
JRST NUM60
JOV NUM50 ;CLEAR OVERFLOW FLAG
NUM50: JSP SDEL,NUMUP ;FLOATING POINT
JRST NUM52 ;END OF WHOLE NUMBERS
FMPR AC0,[10.0] ;MULTIPLY BY 10
TLO AC1,233000 ;CONVERT TO FLOATING POINT
FADR AC0,AC1 ;ADD IT IN
JRST NUM50
NUM52: JSP SDEL,NUMDN ;PROCESS FRACTION
FADR AC0,AC2
JOV NUMER1 ;TEST FOR OVERFLOW
JRST GETDE1
TLO AC1,233000
TRNE AC1,-1
FADR AC2,AC1 ;ACCUMULATE FRACTION
FDVR AC2,[10.0]
JRST NUM52
NUM60: JSP SDEL,NUMUP
JRST NUM62
IMULI AC0,^D10
ADD AC0,AC1
JRST NUM60
NUM62: LSHC AC1,-^D36
JSP SDEL,NUMDN
LSHC AC1,^D37
PUSHJ PP,BYPAS2
JRST GETDE3
DIVI AC1,^D10
JRST NUM62
NUMUP: MOVEI AC1,0
CAML ARG,SX
JRST 0(SDEL)
CAMGE ARG,V
MOVE AC1,1(ARG)
AOJA ARG,1(SDEL)
NUMDN: MOVEI AC1,0
CAMG V,SX
JRST 0(SDEL)
CAMLE V,ARG
MOVE AC1,0(V)
SOJA V,3(SDEL)
SUBTTL GETSYM
GETSYM: MOVEI AC0,0 ;CLEAR AC0
MOVSI AC1,(POINT 6,AC0) ;PUT POINTER IN AC1
BYPASS ;SKIP LEADING BLANKS
TLNN CS,2 ;ALPHABETIC?
JRST GETSY1 ;NO, ERROR
CAIE C,16 ;PERIOD?
JRST GETSY2 ;NO, A VALID SYMBOL
IDPB C,AC1 ;STORE THE CHARACTER
PUSHJ PP,GETCHR ;YES, TEST NEXT CHARACTER
TLNN CS,2 ;ALPHABETIC?
GETSY1: TROA ER,ERRA
GETSY2: AOS 0(PP) ;YES, SET SKIP EXIT
GETSY3: TLNN CS,6 ;ALPHA-NUMERIC?
JRST BYPAS2 ;NO, GET DELIMITER
TLNE AC1,770000 ;YES, HAVE WE STORED SIX?
IDPB C,AC1 ;NO, STORE IT
PUSHJ PP,GETCHR
JRST GETSY3
SUBTTL EXPRESSION EVALUATOR
CV== AC0 ;CURRENT VALUE
PV== AC1 ;PREVIOUS VALUE
RC== RC ;CURRENT RELOCATABILITY
PR== AC2 ;PREVIOUS RELOCATABILITY
CS= CS ;CURRENT STATUS
PS== SDEL ;PREVIOUS STATUS
EVALHA: TLO FR,TMPSW
EVALCM: PUSHJ PP,EVALEX ;EVALUATE FIRST EXPRESSION
PUSH PP,[0] ;MARK PDL
JUMPCM EVALC3 ;JUMP IF COMMA
TLO IO,IORPTC ;IT'S NOT,SO REPEAT
JRST OP ;PROCESS IN OP
EVALC3:
IFN FORMSW,<PUSH PP,INFORM ;PUT FORM WORD ON STACK>
PUSH PP,[0] ;STORE ZERO'S ON PDL
PUSH PP,[0] ;.......
MOVSI AC2,(POINT 4,(PP),12)
JRST OP1B ;PROCESS IN OP
EVALEX: TLO IO,FLDSW
IFN POLISH,<
TLZ FR,POLSW ;[164] CLEAR EVALUATING POLISH FLAG
>
PUSH PP,[TNODE,,0] ;MARK THE LIST 200000,,0
TLZN FR,TMPSW
EVATOM: PUSHJ PP,ATOM ;GET THE NEXT ATOM
JUMPE AC0,EVGETD ;TEST FOR NULL/ZERO
TLOE IO,NUMSW ;SET NUMERIC, WAS IT PREVIOUSLY?
JRST EVGETD+1 ;YES, TREAT ACCORDINGLY
PUSHJ PP,SEARCH ;SEARCH FOR MACRO OR SYMBOL
JRST EVOP ;NOT FOUND, TRY FOR OP-CODE
JUMPL ARG,.+2 ;SKIP IF OPERAND
PUSHJ PP,SSRCH1 ;OPERATOR, TRY FOR SYMBOL (OPERAND)
PUSHJ PP,QSRCH ;PERFORM CROSS-REFERENCE
JUMPG ARG,EVMAC ;BRANCH IF OPERATOR
MOVE AC0,V ;SYMBOL, SET VALUE
JRST EVTSTS ;TEST STATUS
EVMAC: TLNE FR,NEGSW ;UNARY MINUS?
JRST EVERRZ ;YES, INVALID BEFORE OPERATOR
LDB SDEL,[POINT 3,ARG,5] ;GET MACF/OPDF/SYNF
SOJL SDEL,EVERRZ ;ERROR IF NO FLAGS
JUMPE C,.+2 ;NON-BLANK?
TLO IO,IORPTC ;YES, REPEAT CHARACTER
SOJE SDEL,EVMAC1 ;MACRO IF 2
JUMPG SDEL,EVOPS ;SYNONYM IF 4
MOVE AC0,V ;OPDEF
MOVEI V,OP ;SET TRANSFER VECTOR
JRST EVOPD
EVMAC1: SKIPL MACENL ;ALREADY IN CALLM?
JRST CALLM ;NO, EVALUATE MACRO
SETZB RC,AC0 ;ZERO VALUE
TRO ER,ERRA ;SET "A" ERROR
JRST EVGETD ;CONTINUE EVALUATION
EVOP: PUSHJ PP,OPTSCH ;[363] SEARCH OP TABLE
JRST EVOPX ;[363] NOT FOUND
TLNE FR,NEGSW ;[363] OPCODE, UNARY MINUS?
JRST EVERRZ ;[363] YES, ERROR
EVOPS: TRZ V,LITF ;CLEAR LIT INVALID FLAG
TRZE V,ADDF ;SYNONYM
JRST EVOPX ;PSEUDO-OP THAT GENERATES NO DATA JUMPS
HLLZ AC0,V
EVOPD: JUMPE C,.+2 ;OPDEF, NON-BLANK DELIMITER?
TLO IO,IORPTC ;YES, REPEAT CHARACTER
JSP AC2,SVSTOW
PUSHJ PP,0(V)
PUSHJ PP,DSTOW
JSP AC2,GTSTOW
TRNE RC,-2
HRRM RC,EXTPNT
TLNE RC,-2
HLLM RC,EXTPNT
JRST EVNUM
EVOPX: MOVSI ARG,SYMF!UNDF
PUSHJ PP,INSERZ
EVERRZ: SETZB AC0,RC ;CLEAR CODE AND RELOCATION
EVERRU: TRO ER,ERRU
JRST EVGETD
EVTSTS: TLNE ARG,UNDF
JRST [TRO ER,ERRU ;SET UNDEF ERROR
JUMP1 EVGETD ;TREAT AS UNDF ON PASS1
JRST .+1] ;TREAT AS EXTERNAL ON PASS2
TLNN ARG,EXTF
JRST EVTSTR
HRRZ RC,ARG ;GET ADRES WFW
HRRZ ARG,EXTPNT ;SAVE IT WFW
HRRM RC,EXTPNT ;WFW
IFE POLISH,< ;[164] NOT NEEDED SINCE POLISH WILL TAKE CARE OF EXTERNS
TRNE ARG,-1 ;WFW
TRO ER,ERRE
>
SETZB AC0,ARG
EVTSTR: TLNE ARG,MDFF ;MULTIPLY DEFINED?
TRO ER,ERRD ;YES, FLAG IT
TLNN FR,NEGSW ;[255] NEGATIVE ATOM?
JRST EVGETD ;[255] NO
IFN POLISH,<
TDNE RC,[-2,,-2] ;[255] EXTERNALS?
JRST NEGEXT ;[255] YES, MUST BE UNARY MINUS
>
PUSHJ PP,GETDE2 ;[255] NO, JUST NEGATE
EVGETD: TLNE IO,NUMSW ;NON BLANK FIELD
TLO FR,FSNSW ;YES,SET FLAG
PUSHJ PP,BYPAS2
TLNE CS,6 ;ALPHA-NUMERIC?
TLO IO,IORPTC ;YES, REPEAT IT
CAIN C,'^' ;[123] IS THIS THE SPECIAL ESCAPE CHAR?
JRST EVUPAR ;[123] YES, SEE WHAT FOLLOWS
EVUPAT: ;[333] LABEL FOR RETURN FROM ^
IFN POLISH,<
TLZN IO,RSASSW ;INTER-PSECT REFERENCE?
JRST EVNUM ;NO
PUSH PP,SGWFND ;INX OF PSECT REFERRED TO
PUSH PP,[-1] ;DUMMY RELOCATION
PUSH PP,CSTATP> ;ADDITIVE PSECT OPERATION
EVNUM: POP PP,PS ;POP THE PREVIOUS DELIMITER/TNODE
TLO PS,4000
IFN POLISH,<
TLC PS,110000 ;TEST FOR BITS 2 AND 5
TLCN PS,110000 ; BOTH ON - MEANS ADDITIVE
JRST EVXCT> ; PSECT OPERATION
CAMGE PS,CS ;OPERATION REQUIRED?
JRST EVPUSH ;NO, PUT VALUES BACK ON STACK
TLNN PS,TNODE ;YES, HAVE WE REACHED TERMINAL NODE?
JRST EVXCT ;NO, EXECUTION REQUIRED
TLNE CS,170000 ;[123] YES, ARE WE POINTING AT DEL? (& ! * / + - _)
JRST EVPUSH ;[123] NO,FALL INTO EVPUSH
IFN POLISH,<
TLNE FR,POLSW ;[164] BEEN RESOLVING POLISH?
JRST POLPOP ;[164] YES, OUTPUT IT
>
POPJ PP, ;NO, EXIT
;HERE TO HANDLE "^!"
EVUPAR: SETZM UPARRO ;[333] CLEAR ^ COUNTER ONCE IN A WHILE
PUSHJ PP,PEEK ;[333] SEE WHAT CHARACTER AFTER ^ IS
SETZ CS, ;[333] AND CHECK FOR ! AFTER IT
CAIN C,"!" ;[333] IS IT ! FOR ^!
SKIPA CS,CSTATX ;[333] YES, GET SPECIAL POINTER
JRST EVUPAN ;[416]NOT ^!
TLZ IO,IORPTC ;[337] CLEAR REREAD
SKIPE MRP ;[357] IF IN A MACRO
PUSHJ PP,MREAD ;[357] BETTER DO THIS
SUBI C,40 ;[333] YES, CHANGE TO SIXBIT
JRST EVNUM ;[333] AND EVALUATE
EVUPAN: MOVEI C,'^' ;[333] RESTORE C
MOVE CS,CSTAT(C) ;[333] AND CS
SETOM UPARRO ;[333] SET FLAG FOR CELL1 TO RE-EAT ^
JRST EVUPAT ;[333] AND CONTINUE FROM ^
EVPUSH: PUSH PP,PS ;STACK VALUES
PUSH PP,CV
PUSH PP,RC
PUSH PP,CS
JRST EVATOM ;GET NEXT ATOM
EVXCT: POP PP,PR ;POP PREVIOUS RELOCATABILITY
POP PP,PV ;AND PREVIOUS VALUE
LDB PS,[POINT 4,PS,29] ;[123] TYPE OF OPERATION TO PS
IFE POLISH,<
XCT EVTAB(PS) ;[123] PERFORM PROPER OPERATION
JUMPN RC,.+2 ;COMMON RELOCATION TEST
EVXCT1: JUMPE PR,EVNUM
TRO ER,ERRR ;BOTH MUST BE FIXED
JRST EVNUM ;GO TRY AGAIN
EVTAB: JRST ASSEM1 ;0; SHOULD NEVER GET HERE ;DMN
JRST XMUL ;1;
JRST XDIV ;2;
JRST XADD ;3;
JRST XSUB ;4;
JRST XLRW ;5; "_"
IOR CV,PV ;6; MERGE PV INTO CV
AND CV,PV ;7; AND PV INTO CV
XOR CV,PV ;10; XOR PV INTO CV
SETCM CV,CV ;11;[416] NOT (ONE'S COMPLIMENT)
REPEAT 6,<HALT> ;12-17;[416] JUST INCASE
>
IFN POLISH,<
CAILE PS,11 ;[265] OPS 12 AND 13
JRST POLPSH ;[265] REQUIRE POLISH FIXUPS
TDNN RC,[-2,,-2] ;CHECK FOR EXTERNALS
TDNE PR,[-2,,-2] ;IN EITHER OPERAND
JUMP2 POLPSH ;CAN NOT DO IT HERE
XCT PRTAB(PS) ;TEST PREVIOUS RELOCATION
XCT RCTAB(PS) ;AND THIS RELOCATION
EVXCT1: JFCL 17,.+1 ;[276] CLEAR OVERFLOW FOR * AND /
XCT EVTAB(PS) ;[276] PERFORM PROPER OPERATION
SKIPL OKOVFL ;[362] OVERFLOW OK?
JOV .+2 ;[276] SKIP IF * OR / OVERFLOWED
SKIPA ;[276] IT'S OK
TRO ER,ERRN ;[276] SET N ERROR FOR OVERFLOW
JRST EVNUM ;GO TRY AGAIN
EVTAB: JRST ASSEM1 ;0; SHOULD NEVER GET HERE ;DMN
IMULM PV,CV ;1;
IDIVM PV,CV ;2;
JRST XADD ;3;
JRST XSUB ;4;
JRST XLRW ;5; "_"
IOR CV,PV ;6; MERGE PV INTO CV
AND CV,PV ;7; AND PV INTO CV
XOR CV,PV ;10; XOR PV INTO CV
SETCM CV,CV ;11; NOT (ONE'S COMPLIMENT)
MOVN CV,CV ;12; NEGATE (TWO'S COMPLEMENT)
JFCL ;13;[265] ADDITIVE PSECT OPERATION
REPEAT 4,<HALT> ;14-17; JUST INCASE
NEGEXT: MOVE PS,(PP) ;[255] GET DELIMITER OFF STACK
CAME PS,[TNODE,,0] ;[255] NOTHING ON YET?
JRST EVGETD ;[255] NO?
MOVSI PS,4000 ;[255] FAKE UP EVPUSH OF
ADDM PS,(PP) ;[255] PS
PUSH PP,[0] ;[255] CV
PUSH PP,[0] ;[255] RC
PUSH PP,CSTAT+'-' ;[255] CS
TLZ FR,NEGSW ;[255] CLEAR FLAG
JRST EVGETD ;[255] NOW EVALUATE
PRTAB: JFCL ;0
JUMPN PR,POLPSH ;1
JUMPN PR,POLPSH ;2
SKIPE PR ;3
SKIPE PR ;4
REPEAT 4,<JUMPN PR,POLPSH> ;5, 6, 7, 10
JFCL ;11
RCTAB: JFCL ;0
JUMPN RC,POLPSH ;1
JUMPN RC,POLPSH ;2
JUMPN RC,POLPSH ;3
JUMPE RC,POLPSH ;4
REPEAT 4,<JUMPN RC,POLPSH> ;5, 6, 7, 10
JFCL ;11
>
XSUB: SUBM PV,CV
SUBM PR,RC
JRST EVNUM
XADD: ADDM PV,CV
ADDM PR,RC
JRST EVNUM
IFE POLISH,<
XDIV: IDIV PR,CV ;CORRECT RELOCATABILITY
JFCL 17,.+1 ;[276] CLEAR OVERFLOW
IDIVM PV,CV
SKIPL OKOVFL ;[362] SKIP IF OVERFLOW OK
JOV .+2 ;[276] SEE IF OVERFLOWED
SKIPA ;[276] NO
TRO ER,ERRN ;[276] YES, SET N ERROR
XDIV1: EXCH PR,RC ;TAKE RELOCATION OF NUMERATOR
JRST EVXCT1
XMUL: JUMPE PR,XMUL1 ;AT LEAST ONE OPERAND
JUMPE RC,XMUL1 ;MUST BE FIXED
TRO ER,ERRR
XMUL1: IORM PR,RC ;GET RELOCATION TO RC
CAMGE PV,CV ;FIND THE GREATER
EXCH PV,CV ;FIX IN CASE CV=0,OR 1
IMULM PV,RC
JFCL 17,.+1 ;[276] CLEAR OVERFLOW
IMULM PV,CV
SKIPL OKOVFL ;[362] SKIP IF OVERFLOW OK
JOV .+2 ;[276] SEE IF OVERFLOW
SKIPA ;[276] NO
TRO ER,ERRN ;[276] YES, SET N ERROR
JRST EVNUM
XLRW: EXCH PV,CV ;[401][407]
LSH CV,0(PV)
LSH PR,0(PV)
JRST XDIV1
>
IFN POLISH,<
XLRW: EXCH PV,CV
LSH CV,0(PV)
JRST EVNUM
>
IFN POLISH,< ;[164]
;HERE FOR EXTERNAL ARITHMETIC
;CONVERS TO POLISH BLOCK TYPE 11
POLPSH: JUMP1 EVXCT1 ;ONLY SAVE POLISH ON PASS2
PUSH PP,POLSTK ;SAVE STACK POINTER
EXCH PP,POLSTK ;SAVE PP AND SET UP POLISH STACK
TLO FR,POLSW ;SIGNAL STORING POLISH
PUSH PP,POLTBL-1(PS) ;STACK OPERATOR
PUSH PP,PR ;STACK PREVIOUS RELOCATION
PUSH PP,PV ;AND VALUE
PUSH PP,RC ;STACK CURRENT
PUSH PP,CV
EXCH PP,POLSTK ;GET PP BACK
POP PP,CV ;USE STACK POINTER FOR VALUE
MOVE RC,CV ;AND RELOCATION (ENSURES EXTERNAL)
JRST EVNUM ;TRY NEXT ITEM
;HERE TO STORE THE POLISH LIST
;RC (AND CV) HAVE POINTER TO TOP ITEM IN PUSHDOWN STACK
POLPOP: MOVE PV,FREE ;GET NEXT FREE LOCATION
EXCH PV,POLIST ;SWAP STACK POINTER
PUSHJ PP,POLSTR ;STORE POINTER TO NEXT POLISH BLOCK
PUSHJ PP,POLOPF ;STORE FIRST OPERATOR
PUSHJ PP,POLFST ;STORE FIRST PART
PUSHJ PP,POLSND ;STORE SECOND PART
SKIPE PV,POLTYP ;USE PRESET TYPE
JRST POLOCT ;IF SET
SETO PV, ;STORE OPERATOR OF -1
JUMPNC POLOCT ;FOR RIGHT HALF FIXUP
SUBI PV,1 ;-2 FOR LEFT HALF
POLOCT: XCT 3+[SETZM EXTPNT ;FULL WORD
HRRZS EXTPNT ;LEFT HALF
HLLZS EXTPNT](PV) ;RIGHT HALF
SKIPE INASGN ;DEFINING A SYMBOL?
JRST [SUBI PV,3 ;DIFFERENT STORE OPERATOR
PUSHJ PP,POLSTR ;STORE IT
MOVE CV,HDAS ;GET FLAGS
MOVEI ARG,10 ;ASSUME LOCAL
TLNE CV,INTF ;IS IT GLOBAL?
MOVEI ARG,4 ;YES, MAKE GLOBAL
MOVE CV,INASGN ;GET SIXBIT SYMBOL
PUSHJ PP,SQOZE ;RADIX50
MOVE PV,AC0 ;CORRECT ACC
JRST POLPOR] ;STORE IT
PUSHJ PP,POLSTR ;[265] STORE IT
MOVE PV,LOCA ;LOCATION
HRL PV,MODA ;AND MODE
SKIPN LITLVL ;[265] HOWEVER IF IN A LITERAL?
JRST POLPOR ;[265] NOT
MOVE PV,POLIST ;[265] WE CAN NOT SUPPLY THE STORE ADDRESS YET
MOVE CV,(PV) ;[265] SO PUT IN A SPECIAL LIST
MOVEM CV,POLIST ;[265] REMOVE FROM REGULAR LIST
EXCH PV,POLITS ;[265] STORE IN POLIST LIT LIST
MOVEM PV,@POLITS ;[265] LINK TOGETHER
MOVE PV,STPX ;[265] STORE DEPTH IN THIS LIT
SUB PV,STPY ;[265] WITH NO RELOCATION YET
POLPOR: PUSHJ PP,POLSTR
SETZB RC,CV ;USE ZERO VALUE AND RELOCATION
POLRET: MOVE PV,POLPTR ;RESET INITIAL POLISH POINTER
MOVEM PV,POLSTK
POPJ PP, ;RETURN
;THIS IS A KLUDGE TO PRODUCE ADDITIVE GLOBALS FOR THE FEW CASES THAT THEY
;CAN HANDLE. I.E. K+GLOBAL, GLOBAL+K, GLOBAL-K
;SO THAT OLD PROGRAMS WILL COMPIL THE SAME WAY AND LOAD WITH THE
;OLD LOADER WITHOUT THE FAILSW CODE
;APART FROM ADDITIVE SYMBOL FIXUPS POLISH BLOCKS ARE MORE POWERFULL
;***** REMOVE SOMEDAY
POLOPF: HRRZ PS,1(RC) ;GET FIRST OPERATOR
CAIE PS,3 ;CAN ONLY HANDLE ADD
CAIN PS,4 ;AND SUBTRACT
JRST POLOP2 ;ITS ONE OF THOSE GIVE IT A TRY
;*****
POLOPX: SKIPN SGNMAX ;[265] PSECTS USED?
JRST POLOPR ;[265] NO
PUSH PP,PV ;[265] SAVE FIRST OP
HRRO PV,SGNCUR ;[265] GET CUR PSECT INX
TRO PV,400000 ;[265] MAKE POLISH OP
PUSHJ PP,POLSTR ;[265] STORE IT
POP PP,PV ;[265] GET FIRST OP
POLOPR: HRRZ PV,1(RC) ;[265] GET OPERATOR
CAIE PV,15 ;[265] ADDITIVE PSECT OPERATION?
JRST POLOPS ;[265] NO
AOS 0(PP) ;[265] SKIP FIRST OPERAND
HRRO PV,3(RC) ;[265] GET PSECT INX
TROA PV,400000 ;[265] MAKE POLISH OP
POLOPS: HRRO PV,1(RC) ;[265] GET OPERATOR AND FLAG IT
JRST POLSTR ;STORE IT AND EXIT
;***** MORE OF THIS KLUDGE
POLOP2: SUBI PS,3 ;MAKES LIFE EASIER
MOVE CV,4(RC) ;GET 2ND OPERAND
JUMPL CV,POLOPX ;ITS A POINTER, THEREFORE TOO COMPLEX
MOVE PV,2(RC) ;AND 1ST OPERAND
JUMPL PV,POLOPX ;THIS IS A POINTER
TDNN CV,[-2,,-2] ;TEST FOR EXTERN
JRST [TRNE CV,1 ;TEST FOR BOTH RELOCATABLE
TRNN PV,1
JRST POLOP3 ;THIS IS NOT EXTERN SO OTHER CAN BE
JRST POLOPX] ;CANNOT HANDLE HERE, USE POLISH
JUMPN PS,POLOPX ;CAN NOT HANDLE -GLOBAL
TDNE PV,[-2,,-2] ;TEST FOR EXTERN HERE
JRST POLOPX ;GLOBAL+GLOBAL TOO COMPLEX
POLOP3: SOS FREE ;BACKUP FREE COUNTER
MOVE PV,@FREE ;GET LAST POINTER
MOVEM PV,POLIST ;SET POINTER BACK
POP PP,PV ;POP RETURN OFF STACK
TLZ FR,POLSW ;CLEAR FLAG JUST IN CASE
;RELOAD RC, CV, PV, AND PR FROM STACK
;AND EXECUTE OPERATOR
MOVE PR,2(RC) ;
MOVE PV,3(RC)
MOVE CV,5(RC)
MOVE RC,4(RC) ;THIS ONE LAST OF COURSE
JUMPN PS,POLOP5 ;DO MINUS
ADDM PV,CV
ADDM PR,RC
JRST POLRET ;RESTORE STACK AND RETURN
POLOP5: SUBM PV,CV
SUBM PR,RC
JRST POLRET
;***** END OF THIS KLUDGE
;HERE TO HANDLE FIRST OPERAND
;HIGHLY RECURSIVE
POLFST: MOVE PV,2(RC) ;GET RELOCATION
JUMPL PV,POLFSR ;THIS IS ANOTHER POINTER
TDNE PV,[-2,,-2] ;IS IT EXTERNAL?
JRST POLFS2 ;YES
MOVE CV,3(RC) ;GET VALUE
POLFS4: TLNN PV,-1 ;CHECK FOR LEFT HALF VALUE
TLNE CV,-1
JRST POLFS1 ;YES, NEED FULL WORD
HRL CV,PV ;XWD RELOC ,, VALUE
SETZ PV, ;OPERAND IS 0 FOR 18 BIT VALUE
PUSHJ PP,POLSTR
MOVE PV,CV
JRST POLSTR ;STORE AND EXIT
POLFS1: MOVEI PV,1 ;OPERAND IS 1 FOR 36 BIT VALUE
PUSHJ PP,POLSTR
MOVE PV,2(RC) ;RELOCATION
PUSHJ PP,POLSTR
MOVE PV,CV ;VALUE
JRST POLSTR
POLSN2:
POLFS2: MOVE CV,1(PV) ;GET SIXBIT SYMBOL INTO AC0
MOVEI PV,2 ;OPERAND IN 2 FOR SYMBOL
PUSHJ PP,POLSTR
MOVEI ARG,4 ;MAKE GLOBAL REQUEST
PUSHJ PP,SQOZE ;TO RADIX-50
MOVE PV,CV ;PUT IN RIGHT ACC
JRST POLSTR ;STORE IT
POLFSR: CAME PV,3(RC) ;CHECK TO MAKE SURE IT REALLY IS A POINTER
JRST POLFSN ;NO, ITS A NEGATIVE GLOBAL
PUSH PP,RC ;SAVE THIS POINTER
MOVE RC,PV ;GET NEXT POINTER
PUSHJ PP,POLOPR ;GET OPERATOR
PUSHJ PP,POLFST ;GET FIRST OPERAND
PUSHJ PP,POLSND ;GET SECOND OPERAND
POP PP,RC ;GET BACK PREVIOUS POINTER
POPJ PP, ;RETURN TO PREVIOUS LEVEL
POLFSN: HRROI PV,14 ;TWO'S COMPLIMENT NEGATIVE
PUSHJ PP,POLSTR ;STORE OPERATOR
MOVN PV,2(RC) ;GET RELOCATION
TDNE PV,[-2,,-2] ;CHECK FOR EXTERN
JRST POLFS2 ;IT IS, CONVERT TO RADIX-50
MOVN CV,3(RC) ;GET VALUE
JRST POLFS4 ;AND STORE IT
;HERE TO HANDLE 2ND OPERAND, ALSO RECURSIVE
POLSNR: CAME PV,5(RC) ;MAKE SURE IT REALLY IS
JRST POLSNN ;ITS A NEGATIVE GLOBAL
MOVE RC,PV ;GET NEXT POINTER
PUSHJ PP,POLOPR ;STORE OPERATOR
PUSHJ PP,POLFST ;GET 1ST OPERAND
;AND GET SECOND OPERAND
POLSND: MOVE PV,4(RC) ;GET RELOCATION
JUMPL PV,POLSNR ;THIS IS A POINTER
TDNE PV,[-2,,-2] ;IS IT EXTERNAL?
JRST POLSN2 ;YES
MOVE CV,5(RC) ;GET VALUE
POLSN4: TLNN PV,-1 ;CHECK FOR LEFT HALF VALUE
TLNE CV,-1
JRST POLSN1 ;YES, NEED FULL WORD
HRL CV,PV ;XWD RELOC ,, VALUE
SETZ PV, ;OPERAND IS 0 FOR 18 BIT VALUE
PUSHJ PP,POLSTR
MOVE PV,CV
JRST POLSTR ;STORE AND EXIT
POLSNN: HRROI PV,14 ;TWO'S COMPLIMENT NEGATIVE
PUSHJ PP,POLSTR ;STORE OPERATOR
MOVN PV,4(RC) ;GET RELOCATION
TDNE PV,[-2,,-2] ;CHECK FOR EXTERN
JRST POLSN2 ;IT IS, CONVERT TO RADIX-50
MOVN CV,5(RC) ;GET VALUE
JRST POLSN4 ;AND STORE IT
POLSN1: MOVEI PV,1 ;OPERAND IS 1 FOR 36 BIT VALUE
PUSHJ PP,POLSTR
MOVE PV,4(RC) ;RELOCATION
PUSHJ PP,POLSTR
MOVE PV,CV ;VALUE
; JRST POLSTR
POLSTR: AOS SDEL,FREE ;GET A FREE WORD
CAML SDEL,SYMBOL ;ENOUGH?
PUSHJ PP,XCEED ;NO
MOVEM PV,-1(SDEL) ;STORE ONE WORD
POPJ PP,
;TABLE OF CORRESPONDENCE BETWEEN MACRO-10 OPERATORS AND BLOCK 11 OPERATORS
POLTBL: ;POLISH VALUE MACRO-10 OPERATOR
5 ;1 MULTIPLY
6 ;2 DIVIDE
3 ;3 ADD
4 ;4 SUBTRACT
11 ;5 LEFT SHIFT
10 ;6 LOGICAL IOR
7 ;7 LOGICAL AND
12 ;10 LOGICAL XOR
13 ;11 NOT
14 ;12 NEGATE
15 ;13 ADDITIVE PSECT OPERATION
>;END OF IFN POLISH
SUBTTL LITERAL STORAGE HANDLER
STOLER:
IFE FORMSW,< SETZB AC0,RC ;ERROR, NO CODE STORED
PUSHJ PP,STOW ;STOW ZERO>
IFN FORMSW,< MOVEI AC0,0
PUSHJ PP,STOWZ1>
TRO ER,ERRL ;AND FLAG THE ERROR
STOLIT: MOVE SDEL,STPX
SUB SDEL,STPY ;COMPUTE NUMBER OF WORDS
JUMPE SDEL,STOLER ;ERROR IF NONE STORED
MOVE SX,LITERR ;[415]GET TOTAL ERRORS FOR LEVEL
TRNN FR,ERRQSW ;[415]IGNORING Q ERRORS?
TRZ SX,ERRQ ;[415]YES,SO TURN IT OFF
TRNN SX,ERRORS ;[415]DOES LITERAL HAVE ERROR?
JRST STOL06 ;NO
;**;[441] INSERT 2L,CHANGE COMMENT @STOLIT+8 JBC 21-SEP-76
TRNE SX,ERRU ;[441] YES,NO SEARCH IF UNDF SYMBOL ON
JRST STOL22 ;[441] PASS1, BRANCH
JUMP2 STOL22 ;[441] BRANCH IF PASS2
ADDM SDEL,LITCNT ;PASS ONE, UPDATE COUNT
JRST STOWI ;INITIALIZE STOW
STOL06: MOVEI SX,LITAB ;PREPARE FOR SEARCH
MOVE ARG,STPX ;SAVE IN THE EVENT OF MULTIPLE-WORD
HRL ARG,STPY
MOVE AC2,LITNUM
MOVEI SDEL,0
STOL08: PUSHJ PP,DSTOW ;GET VALUE WFW
STOL10: SOJL AC2,STOL24 ;TEST FOR END
MOVE SX,0(SX) ;NO, GET NEXT STORAGE CELL
MOVE V,-1(SX) ;GET RELOCATION BITS WFW
CAMN AC0,-2(SX) ;DO CODES COMPARE? WFW
CAME RC,V ;YES, HOW ABOUT RELOCATION?
AOJA SDEL,STOL10 ;NO, TRY AGAIN
SKIPGE STPX ;YES, MULTI-WORD?
JRST STOL13 ;NO, JUST RETURN LOCATION
MOVEM AC2,SAVBLK+AC2 ;YES, SAVE STARTING INFO
MOVEM SX,SAVBLK+SX
STOL12: SOJL AC2,STOL23 ;TEST FOR END
PUSHJ PP,DSTOW ;GET NEXT WORD WFW
MOVE SX,0(SX) ;UPDATE POINTER
MOVE V,-1(SX) ;GET RELOCATION WFW
CAMN AC0,-2(SX) ;COMPARE VALUE WFW
CAME RC,V ;AND RELOCATION
JRST STOL14 ;NO MATCH, TRY AGAIN
SKIPL STPX ;MATCH, HAVE WE FINISHED SEARCH?
JRST STOL12 ;NO, TRY NEXT WORD
STOL13: ;YES, RETURN LOCATION
IFN POLISH,<
SETZM POLITS ;CLEAR ANY POLISH PENDING
>
JRST STOL26
STOL14: MOVE AC2,SAVBLK+AC2 ;RESTORE STOW POINTERS
MOVE SX,SAVBLK+SX
HRREM ARG,STPX
HLREM ARG,STPY
AOJA SDEL,STOL08 ;BETTER LUCK NEXT TIME
STOL22: MOVE SDEL,LITNUM
STOL23: PUSHJ PP,DSTOW ;DSTOW AND CONVERT
STOL24: MOVE SX,LITABX ;GET CURRENT STORAGE
PUSHJ PP,GETTOP ;GET NEXT CELL
MOVEM AC0,-2(SX) ;STORE CODE WFW
MOVEM RC,-1(SX) ;WFW
IFN FORMSW,<
MOVE AC0,FORM
MOVEM AC0,-3(SX)>
MOVEM SX,LITABX ;SET POINTER TO CURRENT CELL
AOS LITNUM ;INCREMENT NUMBER STORED
AOS LITCNT ;INCREMENT NUMBER RESERVED
SKIPL STPX ;ANY MORE CODE?
JRST STOL23 ;YES
STOL26: JUMP1 POPOUT ;EXIT IF PASS ONE
MOVE SX,LITHDX ;GET HEADER BLOCK
HLRZ RC,-1(SX) ;GET BLOCK RELOCATION
HRRZ AC0,-1(SX)
ADDI AC0,0(SDEL) ;COMPUTE ACTUAL LOCATION
POPJ PP, ;EXIT
SUBTTL INPUT ROUTINES
GETCHR: PUSHJ PP,CHARAC ;GET ASCII CHARACTER
CAIL C,"A"+40 ;CHECK FOR LOWER CASE
CAILE C,"Z"+40
JRST .+2 ;NOT LOWER CASE
IFN STANSW,<
SUBI C,40
CAIN C,32
MOVEI C,136 ;^
CAIN C,30
MOVEI C,137 ;_
CAIN C,176
MOVEI C,134 ;~
CAIN C,140
MOVEI C,100 ;@>
IFE STANSW,<
TRZA C,100 ;CONVERT LOWER CASE TO SIXBIT>
SUBI C,40 ;CONVERT TO SIXBIT
CAIG C,77 ;CHAR GREATER THAN SIXBIT?
JUMPGE C,GETCS ;TEST FOR VALID SIXBIT
ADDI C,40 ;BACK TO ASCII
CAIN C,HT ;CHECK FOR TAB
JRST GETCS2 ;MAKE IT LOOK LIKE SPACE
CAIG C,CR ;GREATER THAN CR
CAIG C,HT ;GREATER THAN TAB
JRST GETCS1 ;IS NOT FF,VT,LF OR CR
MOVEI C,EOL ;LINE OR FORM FEED OR V TAB
TLOA IO,IORPTC ;REPEAT CHARACTER
GETCS2: MOVEI C,0 ;BUT TREAT AS BLANK
GETCS: MOVE CS,CSTAT(C) ;GET STATUS BITS
POPJ PP, ;EXIT
GETCS1: JUMPE C,GETCS ;IGNORE NULS
TRC C,100 ;MAKE CHAR. VISIBLE
MOVEI CS,"^"
DPB CS,LBUFP ;PUT ^ IN OUTPUT
PUSHJ PP,RSW2 ;ALSO MODIFIED CHAR.
TRO ER,ERRQ ;FLAG Q ERROR
JRST GETCHR ;BUT IGNORE CHAR.
CHARAC: TLZE IO,IORPTC ;REPEAT REQUESTED?
JRST CHARAX ;YES
RSW0: JUMPN MRP,MREAD ;BRANCH IF TREE POINTER SET
PUSHJ PP,READ
RSW1: SKIPE RPOLVL ;ARE WE IN "REPEAT ONCE"?
JRST REPO1 ;YES
RSW2: CAIN C,LF ;LF?
JRST RSW4 ;YES, SEE IF LAST CHAR WAS A CR
MOVEM C,LIMBO ;STORE THIS CHAR. FOR RPTC
RSW3: TLNE IO,IOSALL ;MACRO SUPPRESS ALL?
JUMPN MRP,CPOPJ ;YES,DON'T LIST IN MACRO
SOSG CPL ;ANY ROOM IN THE IMAGE BUFFER?
PUSHJ PP,RSW5 ;[254] NO, BUT SEE IF ANY EXCESS WE CAN USE
IDPB C,LBUFP ;YES, STORE IN PRINT AREA
CAIE C,HT ;TAB?
POPJ PP, ;NO, EXIT
MOVEI CS,7 ;TAB COUNT MASK
ANDCAM CS,CPL ;MASK TO TAB STOP
POPJ PP,
RSW4: MOVE CS,LIMBO ;GET LAST CHAR.
MOVEM C,LIMBO ;STORE THIS CHAR. FOR RPTC
CAIE CS,CR ;LAST CHAR. A CR?
JRST RSW3 ;NO
HRROS LIMBO ;YES,FLAG
POPJ PP, ;AND EXIT
RSW5: PUSH PP,C ;[254] NEED AN ACC
MOVNI C,.CPLX ;[254] GET EXCESS SPACE
CAMGE C,CPL ;[254] ANY ROOM?
JRST [POP PP,C ;[254] YES
POPJ PP,] ;[254] JUST RETURN
POP PP,C ;[254] NO
JRST OUTPL ;[254] OUTPUT THE PARTIAL LINE
CHARAX: HRRZ C,LIMBO ;GET LAST CHARACTER
POPJ PP, ;EXIT
CHARL: PUSHJ PP,CHARAC ;GET AND TEST 7-BIT ASCII
CAIG C,FF ;LINE OR FORM FEED OR VT?
CAIGE C,LF
POPJ PP, ;NO,EXIT
SKIPE LITLVL ;IN LITERAL?
JRST OUTIML ;YES
CHARL1: PUSHJ PP,SAVEXS ;SAVE REGISTERS
PUSHJ PP,OUTLIN ;DUMP THE LINE
JRST RSTRXS ;RESTORE REGISTERS AND EXIT
;STATEMENT OUT PASSES REMAINDER OF LINE (CMNT)
;UNTIL A LINE TERMINATOR IS SEEN.
STOUTS: TLOA IO,IOENDL!IORPTC
STOUT: TLO IO,IORPTC
BYPASS
CAIE C,EOL ;MOST LIKELY A ; OR EOL CH
JRST STOUT2 ;IT WASN'T, SEE WHY!
HRRZ C,LIMBO ;GET CHARACTER INCASE EOL
TLZN IO,IORPTC ;IT WAS , SKIP NEXT GET
STOUT1: PUSHJ PP,RSW0
CAIN C,CR ;NEED SPECIAL TEST FOR CR
JRST STOUT3 ;INCASE NOT FOLLOWED BY LF
CAIG C,FF
CAIGE C,LF
JRST STOUT1
JRST OUTLIN ;OUTPUT THE LINE (BIN AND LST)
STOUT2: CAIN C,14 ;COMMA?
SKIPL STPX ;YES, ERROR IF CODE STORED
TRO ER,ERRQ
JRST STOUT1 ;PASS OUT TIL END OF LINE
STOUT3: PUSHJ PP,RSW0 ;GET NEXT CHAR.
CAIG C,FF ;GENUINE EOL CHARACTER?
CAIGE C,LF
TLOA IO,IORPTC ;NO, SO REPEAT IT
JRST OUTLIN ;AND DUMP LINE IN ANY CASE
REPEAT 0,< ;[252] DON'T FLAG IT
TRO ER,ERRQ ;[144] FLAG EXTRA <CR> WITH "Q" ERROR
>
SETZ C,
DPB C,LBUFP ;CLEAR LOOK-AHEAD CHAR OUT OF BUFFER
PUSHJ PP,OUTLIN ;DUMP UPTO CR AS LINE
HRRZ C,LIMBO ;GET C BACK
JRST RSW3 ;AND PUT CHAR IN NEW BUFFER
SUBTTL CHARACTER STATUS TABLE
DEFINE GENCS (OPLVL,ATOM,AN,SQUOZ,OPTYPE,SEQNO)
<BYTE (6)OPLVL (9)ATOM (3)AN (6)SQUOZ,OPTYPE,SEQNO>
;OPLVL PRIORITY OF BINARY OPERATORS
;ATOM INDEX TO JUMP TABLE AT CELL1
;AN TYPE OF CHARACTER
; 1=OTHER, 2=ALPHA, 4=NUMERIC
;SQUOZ VALUE IN RADIX 50
;OPTYPE INDEX TO JUMP TABLE AT EVXCT
;SEQNO VALUE IN SIXBIT
CSTAT:
GENCS 00,00,1,00,00,00 ; ' '
GENCS 04,12,1,00,06,01 ; '!'
GENCS 00,07,1,00,00,02 ; '"'
GENCS 00,12,1,00,00,03 ; '#'
GENCS 00,01,2,46,00,04 ; '$'
GENCS 00,01,2,47,00,05 ; '%'
GENCS 04,12,1,00,07,06 ; '&'
GENCS 00,07,1,00,00,07 ; '''
GENCS 00,01,1,00,00,10 ; '('
GENCS 00,01,1,00,00,11 ; ')'
GENCS 02,12,1,00,01,12 ; '*'
GENCS 01,00,1,00,03,13 ; '+'
GENCS 40,01,1,00,00,14 ; ','
GENCS 01,02,1,00,04,15 ; '-'
GENCS 00,11,2,45,00,16 ; '.'
GENCS 02,12,1,00,02,17 ; '/'
GENCS 00,04,4,01,00,20 ; '0'
GENCS 00,04,4,02,00,21 ; '1'
GENCS 00,04,4,03,00,22 ; '2'
GENCS 00,04,4,04,00,23 ; '3'
GENCS 00,04,4,05,00,24 ; '4'
GENCS 00,04,4,06,00,25 ; '5'
GENCS 00,04,4,07,00,26 ; '6'
GENCS 00,04,4,10,00,27 ; '7'
GENCS 00,04,4,11,00,30 ; '8'
GENCS 00,04,4,12,00,31 ; '9'
GENCS 00,12,1,00,00,32 ; ':'
GENCS 00,01,1,00,00,33 ; ';'
GENCS 00,05,1,00,00,34 ; '<'
GENCS 00,12,1,00,00,35 ; '='
GENCS 00,01,1,00,00,36 ; '>'
GENCS 00,12,1,00,00,37 ; '?'
GENCS 00,03,1,00,00,40 ; '@'
GENCS 00,01,2,13,00,41 ; 'A'
GENCS 00,01,2,14,00,42 ; 'B'
GENCS 00,01,2,15,00,43 ; 'C'
GENCS 00,01,2,16,00,44 ; 'D'
GENCS 00,01,2,17,00,45 ; 'E'
GENCS 00,01,2,20,00,46 ; 'F'
GENCS 00,01,2,21,00,47 ; 'G'
GENCS 00,01,2,22,00,50 ; 'H'
GENCS 00,01,2,23,00,51 ; 'I'
GENCS 00,01,2,24,00,52 ; 'J'
GENCS 00,01,2,25,00,53 ; 'K'
GENCS 00,01,2,26,00,54 ; 'L'
GENCS 00,01,2,27,00,55 ; 'M'
GENCS 00,01,2,30,00,56 ; 'N'
GENCS 00,01,2,31,00,57 ; 'O'
GENCS 00,01,2,32,00,60 ; 'P'
GENCS 00,01,2,33,00,61 ; 'Q'
GENCS 00,01,2,34,00,62 ; 'R'
GENCS 00,01,2,35,00,63 ; 'S'
GENCS 00,01,2,36,00,64 ; 'T'
GENCS 00,01,2,37,00,65 ; 'U'
GENCS 00,01,2,40,00,66 ; 'V'
GENCS 00,01,2,41,00,67 ; 'W'
GENCS 00,01,2,42,00,70 ; 'X'
GENCS 00,01,2,43,00,71 ; 'Y'
GENCS 00,01,2,44,00,72 ; 'Z'
GENCS 00,06,1,00,00,73 ; '['
GENCS 00,12,1,00,00,74 ; '\'
GENCS 00,01,1,00,00,75 ; ']'
GENCS 00,10,1,00,00,76 ; '^'
GENCS 10,12,1,00,05,77 ; '_'
CSTATX: GENCS 04,12,1,00,10,01 ;[123] '^!'
CSTATN: GENCS 04,12,1,00,11,15 ;[123][416] '^-'
IFN POLISH,<
CSTATP: GENCS 11,12,1,00,13,13 ;ADDITIVE PSECT OPERATION
>
SUBTTL LISTING ROUTINES
OUTLIN: TRNN ER,ERRORS-ERRQ ;ANY ERRORS?
TLNE FR,ERRQSW ;NO, IGNORE Q ERRORS?
TRZ ER,ERRQ ;YES, YES, ZERO THE Q ERROR
HRLZ AC0,ER ;PUT ERROR FLAGS IN AC0 LEFT
TDZ ER,TYPERR
JUMP1 OUTL30 ;BRANCH IF PASS ONE
JUMPN AC0,OUTL02 ;JUMP IF ANY ERRORS TO FORCE PRINTING
SKIPL STPX ;SKIP IF NO CODE, OTHERWISE
JRST OUTL01 ;NO
TLNN IO,IOSALL ;YES,SUPPRESS ALL?
JRST OUTL03 ;NO
JUMPN MRP,CPOPJ ;YES,EXIT IF IN MACRO
LDB C,[XWD 350700,LBUF]
CAIE C,15 ;FIRST CHAR CR?
OUTL01: TLZ IO,IOMAC ;FORCE MACRO PRINTING
OUTL03: TLNN IO,IOMSTR!IOPROG!IOMAC
OUTL02: IOR ER,OUTSW ;FORCE IT.
IDPB AC0,LBUFP ;STORE ZERO TERMINATOR AFTER ASCII SRC LINE
TSO ER,AC0 ;[411]RE-FLAG THE ERRORS FOR %....X
TLNN FR,CREFSW ;CREF?
PUSHJ PP,CLSCRF ;YES, WRITE END OF CREF DATA (177,003)
MOVE C,TYPERR ;[411]NOW RESTORE FLAGS AS
ANDI C,ERRORS ;[411]THEY WERE SO TTY LISTING IS
TDZ ER,C ;[411]WHAT THEY ASKED FOR
JUMPE AC0,OUTL20 ;BRANCH IF NO ERRORS
TLZE AC0,ERRM ;M ERROR?
TLO AC0,ERRP ;M ERROR SET - SET P ERROR.
PUSHJ PP,OUTLER ;PROCESS ERRORS
OUTL20: SKIPN C,ASGBLK ;[263]
SKIPE CS,LOCBLK ;
SKIPL STPX ;ANY BINARY?
JRST OUTL23 ;YES, JUMP
JUMPE C,OUTL22 ;[263] SEQUENCE BREAK AND NO BINARY JUMPS
ILDB C,TABP ;ASSIGNMENT FALLS THROUGH
PUSHJ PP,OUTL ;OUTPUT A TAB.
ILDB C,TABP ;OUTPUT 2ND TAB, LOCATION FIELD
PUSHJ PP,OUTC ;NEXT IS BINARY LISTING FIELD
HLLO CS,LOCBLK ;LEFT HALF OF A 36BIT VALUE
SKIPL ASGBLK ;[263] SKIP IF LEFT HALF IS NOT RELOC
TRZA CS,1 ;IT IS, SET THE FLAG
TLNE CS,-1 ;SKIP IF ITS A 18BIT VALUE, OTHERWISE
PUSHJ PP,ONC1 ;PRINT LH OF A 36 BIT VALUE IN CS
HRLO CS,LOCBLK ;PICK UP THE RIGHT HALF (18BIT VALUE)
MOVE C,ASGBLK ;[263] GET RIGHT HALF RELOCATION
TRZ CS,0(C) ;[263]
PUSHJ PP,ONC ;PRINT IT
JRST OUTL23 ;SKIP SINGLE QUOTE TEST
OUTL22: PUSHJ PP,ONC ;TAB TO RH AND PRINT IT
MOVEI C,"'"
SKIPE MODA
PUSHJ PP,OUTC
OUTL23: SKIPL STPX ;ANY BINARY?
PUSHJ PP,BOUT ;YES, DUMP IT
MOVE CS,@OUTLI2 ;[POINT 7,LBUF]
OUTL24: ILDB C,CS
CAILE C," " ;[157]
JRST OUTL28 ;[157] FOUND A PRINTING CHARACTER
JUMPN C,OUTL24 ;[157] TRY AGAIN UNLESS TERMINAL 0
SKIPN SEQNO ;[157] SEQUENCE NO. ARE WORTH PRINTING
JRST OUTL25 ;[157] BUT JUST TABS AREN'T
OUTL28: MOVE CS,TABP
PUSHJ PP,OUTASC ;OUTPUT TABS & SEQ. NO.
OUTL25: MOVEI CS,LBUF
PUSHJ PP,OUTAS0 ;DUMP THE LINE
TLNE IO,IOSALL ;SUPPRESSING ALL
JUMPN MRP,OUTL27 ;YES,EXTRA CR IF IN MACRO
OUTL26: SKIPGE STPX ;ANY BINARY?
JRST OUTLI ;NO, CLEAN UP AND EXIT
PUSHJ PP,OUTLI2 ;YES, INITIALIZE FOR NEXT LINE
TLNN FR,CREFSW ;[130] CREF REQUESTED?
TLNE IO,IOPROG ;[130] YES, THEN IS XLIST ON?
JRST .+2 ;[130] CREF NOT BEING PRINTED
PUSHJ PP,CLSCRF ;[130] CLOSE OUT THIS CREF LINE
PUSHJ PP,BOUT ;YES, DUMP IT
OUTL27: PUSHJ PP,OUTCR ;OUTPUT CARRIAGE RETURN
JRST OUTL26 ;TEST FOR MORE BINARY
OUTPL: SKIPN LITLVL ;IF IN LITERAL
SKIPL STPX ;OR CODE GENERATED
JRST OUTIM ;JUST OUTPUT THE IMAGE
SKIPE ASGBLK ;[205]
JRST OUTPL1 ;[205] JUMP IF AN ASSIGNMENT
SKIPE LOCBLK ;[205] OR A BLOCK RESERVATION
SKIPE MACENL ;[205] STILL IN "CALLM"?
JRST OUTIM ;[205] OTHERWISE OUTPUT IMAGE
JUMPN MRP,OUTIM ;[205] ALSO IF IN A MACRO
OUTPL1: PUSHJ PP,SAVEXS ;[242] SAVE AC0 AND C
MOVEI C,CR
IDPB C,LBUFP
MOVEI C,LF
IDPB C,LBUFP ;FINISH WITH CRLF
PUSHJ PP,OUTLIN ;OUTPUT PARTIAL LINE
PUSHJ PP,RSTRXS ;[242] RESTORE ACS
JRST OUTLI2 ;INITIALISE REST OF LINE
OUTL30: AOS CS,STPX ;PASS ONE
CAIN C,FF ;FORM FEED?
PUSHJ PP,OUTFF2 ;YES, COUNT PAGES FOR PASS1 ERROR
ADDM CS,LOCO ;INCREMENT OUTPUT LOCATION
PUSHJ PP,STOWI ;INITIALIZE STOW
TLZ AC0,ERRORS-ERROR1 ;[125]
JUMPN AC0,OUTL32 ;JUMP IF ERRORS
TLNE IO,IOSALL ;SUPPRESSING ALL
JUMPN MRP,CPOPJ ;YES,EXIT
JRST OUTLI1 ;NO,INIT LINE
OUTL32: IDPB AC0,LBUFP ;ZERO TERNIMATOR
IOR ER,OUTSW ;LIST ERRORS
MOVE CS,TAG
PUSHJ PP,OUTSY1
MOVEI CS,[SIXBIT / +@/]
PUSHJ PP,OUTSIX ;OUTPUT TAG
HRRZ C,TAGINC
PUSHJ PP,DNC ;CONVERT INCREMENT TO DECIMAL
PUSHJ PP,OUTTAB ;OUTPUT TAB
PUSHJ PP,OUTLER ;OUTPUT ERROR FLAGS
PUSHJ PP,OUTTAB
MOVEI CS,SEQNO ;ADDRESS OF SEQUENCE NO.
SKIPE SEQNO ;FILE NOT SEQUENCED
PUSHJ PP,OUTAS0 ;OUTPUT IT
JRST OUTL25 ;OUTPUT BASIC LINE
OUTLER:
SETZM LITERR ;[415]CLEAR ACCUMULATED LITERAL ERRORS
PUSH PP,ER ;SAVE LISTING SWITCHES FOR LATER
TRNE ER,TTYSW ;IF THIS IS ON, LISTING IS ON TTY
TRZ ER,ERRORS ;SO SUPPRESS ON TTY
TDZ ER,OUTSW ;BUT THIS SHOULD ONLY GO TO THE TTY
MOVE CS,INDIR ;GET FILE NAME
CAME CS,LSTFIL ;AND SEE IF SAME
JRST [MOVEM CS,LSTFIL ;SAVE AS LAST ONE
MOVEI CS,LSTFIL
PUSHJ PP,OUTSIX ;LIST NAME
MOVEI C," "
PUSHJ PP,OUTL
MOVE CS,PAGENO ;PRINT PAGE NUMBER TOO
JRST OUTLE8]
MOVE CS,PAGENO ;NOW CHECK PAGE NUMBER
CAME CS,LSTPGN
OUTLE8: JRST [MOVEM CS,LSTPGN
MOVEI CS,[ASCIZ /PAGE /]
PUSHJ PP,OUTAS0
MOVE C,PAGENO
PUSHJ PP,DNC
PUSHJ PP,OUTCR ;AND NOW FOR THE ERROR LINE
JRST .+1]
HLLM ER,(PP) ;RESTORE ER BUT NOT IO (LEFT HALF OF AC)
POP PP,ER
MOVE CS,[POINT 7,[ASCII / QXADLRUVNOPEMS/]]
OUTLE2: ILDB C,CS ;GET ERROR MNEMONIC
JUMPGE AC0,OUTLE4 ;BRANCH IF NOT FLAGGED
CAIN C,"Q" ;"Q" ERROR?
AOSA QERRS ;YES, JUST COUNT AS WARNING
AOS ERRCNT ;INCREMENT ERROR COUNT
PUSHJ PP,OUTL ;OUTPUT THE CHARACTER
OUTLE4: LSH AC0,1 ;SHIFT NEXT FLAG INTO SIGN BIT
JUMPN AC0,OUTLE2 ;TEST FOR END
POPJ PP, ;EXIT
OUTIM1: TLOA FR,IOSCR ;SUPPRESS CRLF AFTER LINE
OUTIM: TLZ FR,IOSCR ;DON'T FOR PARTIAL LINE
TLNE IO,IOSALL ;SUPPRESSING ALL?
JUMPN MRP,CPOPJ ;YES ,EXIT IF IN MACRO
JUMP1 OUTLI1 ;BYPASS IF PASS ONE
PUSH PP,ER
TDZ ER,TYPERR
TLNN IO,IOMSTR!IOPROG!IOMAC
IOR ER,OUTSW
PUSH PP,C ;OUTPUT IMAGE
TLNN FR,CREFSW
PUSHJ PP,CLSCRF
OUTIM2: MOVE CS,TABP
PUSHJ PP,OUTASC ;OUTPUT TABS
IDPB C,LBUFP ;STORE ZERO TERMINATOR
MOVEI CS,LBUF
PUSHJ PP,OUTAS0 ;OUTPUT THE IMAGE
TLZN FR,IOSCR ;CRLF SUPPRESS?
PUSHJ PP,OUTCR ;NO,OUTPUT
POP PP,C
HLLM ER,0(PP)
POP PP,ER
JRST OUTLI2
OUTLI: TLNE IO,IOSALL ;SUPPRESSING ALL
JUMPN MRP,OUTLI3 ;YES,SET FLAG IN REPEATS ALSO
TLNE IO,IOPALL ;MACRO EXPANSION SUPRESS REQUESTED?
SKIPN MACLVL ;YES, ARE WE IN MACRO?
TLZA IO,IOMAC ;NO, CLEAR MAC FLAG
OUTLI3: TLO IO,IOMAC ;YES, SET FLAG
OUTLI1: TRZ ER,ERRORS!LPTSW!TTYSW
OUTLI2: MOVE CS,[POINT 7,LBUF] ;INITIALIZE BUFFERS
MOVEM CS,LBUFP
IFN FORMSW,<MOVE CS,[POINT 7,TABI]
MOVSS HWFMT ;PUT FLAG IN LEFT HALF
SKIPGE HWFMT ;BUT IF ONLY HALF-WORD FORMAT>
MOVE CS,[POINT 7,TABI,6]
MOVEM CS,TABP
MOVEI CS,.CPL
IFN FORMSW,<SKIPL HWFMT ;IF MULTI-FORMAT
SUBI CS,8 ;LINE IS ONE TAB SHORTER
MOVSS HWFMT ;BACK AS IT WAS>
SKIPE SEQNO ;[153] A SEQUENCED FILE?
SUBI CS,8 ;[153] YES, SEQ NO TAKES UP SPACE
MOVEM CS,CPL
MOVSI CS,(ASCII / /)
SKIPE SEQNO ;HAVE WE SEQUENCE NUMBERS?
MOVEM CS,SEQNO ;YES, STORE TAB IN CASE OF MACRO
MOVEM CS,SEQNO+1 ;STORE TAB AND TERMINATOR
SETZM ASGBLK
SETZM LOCBLK
POPJ PP,
OUTIML: TLNE IO,IOSALL ;SUPPRESSING ALL?
JUMPN MRP,CPOPJ ;YES,EXIT IF IN MACRO
TRNN ER,ERRORS-ERRQ ;FOR LITERALS (MULIT-LINE) OUTPUT ERRORS
TLNE FR,ERRQSW
TRZ ER,ERRQ
HRLZ CS,ER
JUMP1 OUTML1 ;CHECK PASS1 ERRORS
TDZ ER,TYPERR
JUMPE CS,OUTIM1
PUSH PP,[0] ;ERRORS SHOULD BE ZEROED
PUSH PP,C
PUSH PP,AC0 ;SAVE AC0 IN CASE CALLED FROM ASCII
MOVE AC0,CS ;ERROR ROUTINE WANTS FLAGS IN AC0
IOR ER,OUTSW
TLNN FR,CREFSW
PUSHJ PP,CLSCRF ;FIX CREF
TLZE AC0,ERRM
TLO AC0,ERRP
PUSHJ PP,OUTLER ;OUTPUT THEM
POP PP,AC0
JRST OUTIM2 ;AND LINE
OUTML1: TLZ CS,ERRORS-ERROR1-ERRL ;[250] ANY ERRORS TO PRINT ON PASS1?
JUMPE CS,[TRZ ER,ERRORS!LPTSW!TTYSW-ERRN ;[250] NONE
JRST OUTLI2] ;[250] BUT "N" IS FOR MULTI-LINE LITS
TRZ ER,ERRORS!LPTSW!TTYSW ;[250]
TRO ER,ERRL
PUSH PP,ER ;SAVE
PUSH PP,C ;SAVE THIS
PUSH PP,AC0 ;AS ABOVE
MOVE AC0,CS ;...
TDZ ER,TYPERR
IOR ER,OUTSW
MOVE CS,TAG
PUSHJ PP,OUTSY1
MOVEI CS,[SIXBIT / +@/]
PUSHJ PP,OUTSIX
SKIPN LBLFLG ;[402] HAS A LABEL OCCURRED IN THIS LITERAL?
JRST [HRRZ C,TAGINC ;[402] NO, GET NORMAL INC
JRST OUTML2] ;[402]
MOVE C,STPX ;[402] GET CURRENT DEPTH
SUB C,LTGINC ;[402] SUBTRACT DEPTH OF LABEL
OUTML2: PUSHJ PP,DNC ;[402]
PUSHJ PP,OUTTAB
PUSHJ PP,OUTLER ;DO NOT FORGET ERRORS
PUSHJ PP,OUTTAB
SETZ AC0, ;[253] SET A ZERO TERMINATOR
IDPB AC0,LBUFP ;[253] IN THE OUTPUT BUFFER
MOVEI CS,LBUF ;PRINT REST OF LINE
PUSHJ PP,SOUT20
POP PP,AC0
POP PP,C
POP PP,ER
JRST OUTLI2
SUBTTL OUTPUT ROUTINES
UOUT: PUSHJ PP,LOOKUP ;SET FOR TABLE SCAN
TRNN ARG,PNTF ;WFW
TRNN ARG,UNDF
JRST UOUT13 ;TEST FOR UNDF!EXTF!PNTF ON PASS2
JUMP2 UOUT10
TLNN IO,IOIOPF ;ANY IOP'S SEEN
JRST UOUT12 ;NO,MAKE EXTERNAL
MOVSI CS,PRMTBL-PRMEND;YES LOOKUP IN TABLE
UOUT1: CAME AC0,PRMTBL(CS) ;HAVE WE A MATCH?
AOBJN CS,UOUT2 ;NO,INCREMENT AND JUMP
MOVE ARG,PRMTBL+1(CS);YES,GET VALUE
MOVEM ARG,(SX) ;UPDATE SYMBOL TABLE
POPJ PP, ;EXIT
UOUT2: AOBJN CS,UOUT1 ;TEST FOR END
UOUT12: TRNE ARG,ENTF ;[340] SEE IF FORWARD DEFINED
POPJ PP, ;[340] YES, THEN DON'T EXTERNAL IT
PUSHJ PP,EXTER2 ;MAKE IT EXTERNAL
MOVSI ARG,UNDF ;BUT PUT UNDF BACK ON
IORM ARG,(SX) ;SO MESSAGE WILL COME OUT
POPJ PP, ;GET NEXT SYMBOL
UOUT13: JUMP1 CPOPJ ;RECYCLE ON PASS1
TRC ARG,UNDF!EXTF!PNTF ;CHECK FOR ALL THREE ON
TRCE ARG,UNDF!EXTF!PNTF ;ARE THEY?
POPJ PP, ;NO, RECYCLE
UOUT10: PUSHJ PP,OUTSYM ;OUTPUT THE SYMBOL
MOVEI CS,[SIXBIT /UNASSIGNED, DEFINED AS IF EXTERNAL @/]
PUSHJ PP,OUTSIX ;[360]
JRST OUTCR ;[360] POPJ FOR NEXT SYMBOL
;OUTPUT THE ENTRIES
EOUT: MOVEI C,0 ;INITIALIZE THE COUNT
MOVE SX,SYMBOL
MOVE SDEL,0(SX)
EOUT1: SOJL SDEL,EOUT2 ;TEST FOR END
ADDI SX,2
HLRZ ARG,0(SX)
ANDCAI ARG,SYMF!INTF!ENTF
JUMPN ARG,EOUT1 ;IF INVALID, DON'T COUNT
AOJA C,EOUT1 ;BUMP COUNT
EOUT2: HRLI C,4 ;BLOCK TYPE 4
PUSHJ PP,OUTBIN
SETZB C,ARG
PUSHJ PP,OUTBIN
MOVE SX,SYMBOL
MOVE SDEL,0(SX)
MOVEI V,^D18
EOUT3: SOJL SDEL,POPOUT
ADDI SX,2
HLRZ C,0(SX)
ANDCAI C,SYMF!INTF!ENTF
JUMPN C,EOUT3
SOJGE V,EOUT4 ;TEST END OF BLOCK
PUSHJ PP,OUTBIN
MOVEI V,^D17 ;WFW
EOUT4: MOVE AC0,-1(SX)
PUSHJ PP,SQOZE
MOVE C,AC0
PUSHJ PP,OUTBIN
JRST EOUT3
LSOUT: SKIPN C,LOCAL ;ANY LOCAL FIXUPS REQUIRED?
POPJ PP, ;NO
MOVS AC0,(C) ;GET VALUE RIGHT WAY ROUND
MOVS RC,1(C) ;AND RELOCATION
HLRZM RC,LOCAL ;STORE NEXT POINTER
PUSHJ PP,COUT ;OUTPUT THIS WORD
JRST LSOUT ;LOOK FOR MORE
;OUTPUT THE SYMBOLS
SOUT: SKIPN IONSYM ;SKIP IF NOSYM SEEN
TRNN ER,LPTSW!TTYSW ;A LISTING REQUIRED?
JRST SOUT2 ;NO
MOVEI [ASCIZ /SYMBOL TABLE/]
HRRM SUBTTX ;SET NEW SUB-TITLE
MOVEI ARG,NCOLS ;SET UP FOR NCOLS ACROSS SYMBOL TABLE
TRNE ER,TTYSW ;IS TTY LISTING DEVICE?
MOVEI ARG,2 ;YES,ONLY 2 COLLUMNS
MOVEM ARG,NCOLLS ;STORE ANSWER
IFE POLISH,<
MOVE SX,SYMBOL ;START OF TABLE
MOVE SDEL,(SX) ;COUNT OF SYMBOLS
>
IFN POLISH,<
MOVE SX,SGSBOT ;START OF TABLE
MOVE SDEL,SGNCUR ;CUR PSECT INX
JUMPE SDEL,SOUTBS ;IS THIS THE BLANK PSECT?
MOVE ARG,[XWD SGTTLB,SGLIST]
BLT ARG,SGTTLE-SGTTLB+SGLIST-1 ;MOVE SUBTTL
MOVE AC1,SGTTLE ;'TO' POINTER
MOVE AC2,SGTTLF ;'FROM' POINTER
SGTTLL: ILDB AC0,AC2 ;GET A SIXBIT CHAR
ADDI AC0,40 ;FORM ASCII
IDPB AC0,AC1 ;PUT IN SUBTTL
TLNE AC2,770000 ;DONE SIX CHARS?
JRST SGTTLL ;NOT DONE YET
SETZ AC0, ;TERMINATE SUBTTL
IDPB AC0,AC1 ; WITH NULL BYTE
MOVEI AC0,SGLIST ;POINTER TO
HRRM AC0,SUBTTX ; NEW SUBTTL
SOUTBS: HRRZ SDEL,SGSCNT(SDEL) ;COUNT OF SYMBOLS
>
ADDI SX,2 ;SKIP COUNT
MOVEM SX,SXSV ;SAVE PLACE
MOVEM SDEL,SDELSV
MOVE SX,SPAGNO ;GET LAST SYMBOL PAGE NUMBER
EXCH SX,PAGENO ;SWAP WITH OUTPUT PAGE NUMBER
MOVEM SX,SPAGNO ;AND STORE IT
MOVE SX,[BYTE (7) 0,0,<"S">,<"-">,0]
IORM SX,DBUF+4 ;FIXUP TITLE
SOUT0: PUSHJ PP,SOUTP ;GET PAGE SET UP
JRST SOUT1 ;NOTHING TO OUTPUT
PUSHJ PP,SOUTF ;DUMP ONE PAGE
JRST SOUT1 ;DIDN'T FILL PAGE-DONE
JRST SOUT0
IFN POLISH,<
SGTTLB: ASCII /SYMBOL TABLE FOR PSECT /
SGTTLE: POINT 7,SGTTLE-SGTTLB+SGLIST
SGTTLF: POINT 6,SGNAME(SDEL)
>
SOUTT: MOVE ARG,(SX) ;GET FLAGS
TLNE ARG,SUPRBT ;SURPRESSED?
POPJ PP, ;YES
TLNN ARG,SYMF ;SYMBOL IS OK
TLNN ARG,SYNF!MACF ;BUT MACRO OR SYNONYM AREN'T
AOS (PP)
POPJ PP,
SOUTP: MOVE AC1,NCOLLS ;GET COLUMN COUNT
MOVE SX,SXSV ;GET POSITION
MOVE SDEL,SDELSV ;AND COUNT
SOUTP0: MOVEM SX,SYMBLK(AC1)
HRLM SDEL,SYMBLK(AC1) ;SAVE IN TABLE
MOVE AC0,..LPP ;[227] LINE COUNT
SOUTP1: JUMPE SDEL,SOUTP2 ;IF NONE LEFT, GO ELSEWHERE
PUSHJ PP,SOUTT ;SYMBOL OK?
TDZA RC,RC ;NO
SETO RC, ;YES
ADDI SX,2 ;SET UP FOR NEXT NOW
SUBI SDEL,1
JUMPGE RC,SOUTP1 ;SKIP SYMBOL
SOJG AC0,SOUTP1 ;COUNT IN SYMBOL
SOJG AC1,SOUTP0 ;START NEXT COLUMN
MOVEM SX,SXSV ;SAVE POSITION
MOVEM SDEL,SDELSV
AOS (PP)
POPJ PP,
SOUTP2: CLEARM SDELSV ;FLAG DONE
CAME AC1,NCOLLS ;IF ON 1ST COLUMN
JRST .+3
CAMN AC0,..LPP ;[227] AND FIRST LINE
POPJ PP, ;THEN SKIP PRINTING
SOJLE AC1,CPOPJ1 ;ALREADY GOT THIS LINE
CLEARM SYMBLK(AC1)
SOJG AC1,.-1 ;ZERO ALL OTHERS
JRST CPOPJ1
SOUTF: PUSHJ PP,OUTFF ;GET TO TOP OF PAGE
MOVE AC1,..LPP ;[227]
MOVEM AC1,COLSIZ
SOUTF1: PUSHJ PP,SOUTL ;DUMP ONE LINE
JRST CPOPJ ;WAS BLANK
SOSLE COLSIZ ;ONE MORE DONE
JRST SOUTF1 ;MORE TO GO
SOUTF2: JRST CPOPJ1
SOUTL: MOVE AC1,NCOLLS ;SET COLUME COUNT
SOUTL0: HRRZ SX,SYMBLK(AC1)
HLRZ SDEL,SYMBLK(AC1);GET POSITION IN TABLE
JUMPE SDEL,SOUTL3 ;NOTHING THERE
SOUTL1: PUSHJ PP,SOUTT ;SYMBLE PRINTABLE?
JRST SOUTL2 ;CENCOR!!
PUSHJ PP,SOUTE ;DUMP OUT ENTRY
ADDI SX,2
SUBI SDEL,1 ;UP TP NEXT ONE
HRL SX,SDEL ;SAVE OUR PLACE
MOVEM SX,SYMBLK(AC1)
SOJG AC1,SOUTL0 ;NEXT!
AOS (PP)
JRST OUTCR ;POLISH OFF LINE
SOUTL2: ADDI SX,2
SOJG SDEL,SOUTL1 ;KEEP SEARCHING
SOUTL3: CAME AC1,NCOLLS ;BLANK LINE?
AOS (PP) ;NO
JRST OUTCR
SOUTE: MOVE AC0,-1(SX)
PUSHJ PP,OUTSYM ;DUMP SYMBOL OUT
PUSHJ PP,SRCH7 ;GET VALUE
TLNN ARG,EXTF ;EXTERNAL?
JRST .+5
HLRZ RC,V ;YES, NEED FIXUP
TRNE RC,-2
MOVS RC,(RC)
HLL V,RC
HLLO CS,V
TLNE RC,-1
TRZ CS,1
TLNE RC,-2
TRZ CS,EXTF
TLNN V,-1
TLNE RC,-1
PUSHJ PP,ONC1
PUSHJ PP,OUTTAB
HRLO CS,V
TRNE RC,-1
TRZ CS,1
TRNE RC,-2
TRZ CS,EXTF
PUSHJ PP,ONC1
PUSHJ PP,OUTTAB ;AND TAB, OF COURSE
PUSHJ PP,SOUTE8 ;ABBREVIATION FOR TYPE
JRST OUTTAB ;FINAL TAB
SOUTE8: TLNN ARG,INTF!EXTF!ENTF!UNDF!NOOUTF
POPJ PP, ;SKIP JUNK FOR SIMPLE STUFF
SETZ CS,
TLNE ARG,INTF ;INTERNAL
MOVEI CS,1
TLNE ARG,EXTF ;EXTERNAL
MOVEI CS,-1
TLNE ARG,ENTF ;ENTRY
MOVEI CS,-5
TLNE ARG,NOOUTF ;DDT SURPRESSED
ADDI CS,3
TLNE ARG,UNDF ;UNDEFINED
MOVEI CS,-3 ;SET FOR UDF
MOVEI CS,SOUTC(CS) ;GET ABREVIATION
JRST OUTAS0
SOUT1: MOVE SX,PAGENO ;GET LAST SYMBOL PAGE NUMBER
EXCH SX,SPAGNO ;SWAP WITH OUTPUT PAGE NUMBER
MOVEM SX,PAGENO ;AND STORE IT
MOVE SX,[BYTE (7) 0,0,<"S">,<"-">,0]
ANDCAM SX,DBUF+4 ;FIXUP TITLE
SOUT2: PUSHJ PP,SGLKUP ;[265] SET FOR TABLE SCAN
TRNN ARG,SYMF
TRNN ARG,MACF!SYNF
TDZA MRP,MRP ;SKIP AND CLEAR MRP
POPJ PP, ;NO, TRY AGAIN
TRNE ARG,INTF
MOVEI MRP,1
TRNE ARG,EXTF
MOVNI MRP,1 ;MRP=-1 FOR EXTERNAL
TRNE ARG,SYNF ;SYNONYM?
JUMPL MRP,POPOUT ;YES, DON'T OUTPUT IF EXTERNAL
TRNE ARG,SUPRBT ;IF SUPRESSED
POPJ PP, ;DO NOT OUTPUT
JUMPGE MRP,SOUT10 ;BRANCH IF NOT EXTERNAL
HLRZ RC,V ;PUT POINTER/FLAGS IN RC
TRNE RC,-2 ;POINTER?
MOVS RC,0(RC) ;YES
HLL V,RC ;STORE LEFT VALUE
SOUT10: PUSH PP,RC ;SAVE FOR LATER
MOVEI AC1,0
JUMPLE MRP,SOUT15 ;SET DEFFERRED BITS IF INTERN=EXTERN
TDNE RC,[-2,,-2] ;CHECK FOR INTERN=EXTERN
TRZ ARG,NOOUTF ;YES, SO CLEAR SUPPRESS FLAG
TLNE RC,-2 ;CHECK FOR LEFT FIXUP
IORI AC1,40 ;AND SET BITS
TRNE RC,-2 ;CHECK FOR RIGHT FIXUP
IORI AC1,20 ;AND SET BITS
SOUT15: TLNE RC,-2 ;FIX RELOC AS 0 IF EXTERNAL
HRRZS RC
TRNE RC,-2
HLLZS RC
TLZE RC,-1
TRO RC,2
HRL MRP,RC
MOVEI RC,0
TRNE ARG,ENTF ;ENTRY DMN
HRRI MRP,-5
TRNE ARG,NOOUTF ;SUPRESS OUTPUT? WFW
ADDI MRP,3 ;YES WFW
TRNE ARG,UNDF ;UNDEFINED IS EXTERNAL
HRRI MRP,2 ;SO FLAG AS UDF
IOR AC1,SOUTC(MRP)
MOVE ARG,AC1
PUSHJ PP,NOUT2 ;SQUOZE AND DUMP THE SYMBOL
MOVEM AC0,SVSYM ;SAVE IT
MOVE AC0,V ;GET THE VALUE
HLRZ RC,MRP ;AND THE RELOCATION
PUSHJ PP,COUT
POP PP,RC ;GET BACK RELOC AND CHECK EXTERNAL
TRNN RC,-2 ;IS IT?
JRST SOUT50 ;NO
MOVE AC0,1(RC) ;GET NAME
MOVEI ARG,60 ;EXTERNAL REQ
PUSHJ PP,SQOZE
HLLZS RC ;NO RELOC
PUSHJ PP,COUT ;OUTPUT IT
MOVE AC0,SVSYM ;GET SYMBOL NAME
TLO AC0,500000 ;SET AS ADDITIVE SYMBOL
TLZ AC0,200000 ;BUT NOT LEFT HALF ETC
PUSHJ PP,COUT
SOUT50: MOVSS RC ;CHECK LEFT HALF
TRNN RC,-2
POPJ PP,
MOVE AC0,1(RC)
MOVEI ARG,60
PUSHJ PP,SQOZE
MOVEI RC,0
PUSHJ PP,COUT
MOVE AC0,SVSYM
TLO AC0,700000
JRST COUT
SOUT20: PUSHJ PP,OUTAS0
JRST OUTCR
<ASCII /ENT/>!04 ;DMN
0
<ASCII /UDF/>!60 ;UNDEFINED EXTERNAL
<ASCII /SEN/>!44 ;SUPRESSED ENTRY
<ASCII /EXT/>!60
SOUTC: EXP 10
<ASCII /INT/>!04
<ASCII /SEX/>!60 ;SUPPRESSED EXTERNAL (NOT USED YET)
<ASCII /SPD/>!50
<ASCII /SIN/>!44 ;DMN
;OUTPUT THE BINARY
BOUT: HRRZ CS,LOCA ;[150] PICKUP THE LOCATION
SUB CS,STPX ;[150] MINUS START
ADD CS,STPY ;[150] PLUS END
HRLO CS,CS ;[150] TO GET ASSEMBLY LOCATION
PUSHJ PP,ONC ;OUTPUT IT TO THE LISTING FILE
MOVEI C,"'"
SKIPE MODA ;[150] IF MODE IS NOT ABSOLUTE
PUSHJ PP,OUTC ;PRINT A SINGLE QUOTE
PUSHJ PP,DSTOW ;GET THE CODE
PUSH PP,RC ;SAVE RELOC
PUSH PP,RC ;AND AGAIN
TLNE RC,-2 ;CHECK LEFT EXTERNAL
HRRZS RC ;MAKE LEFT NON-RELOC
TRNN RC,-2 ;RIGHT EXT?
JRST BOUT30 ;NO
HRRZ AC1,AC0 ;YES
JUMPE AC1,BOUT20 ;PROCESS IF ZERO CODE THERE
HLLZS RC ;MAKE NON-RELOC
JRST BOUT30 ;PROCESS
BOUT20: HRRM AC1,-1(PP) ;FIX RC IN STACK SO NO CONFUSION WFW (AC1 HAS 0)
HRR AC0,0(RC) ;NO, SET ADDRESS LINK
MOVE AC1,LOCO ;GET CURRENT LOCATION
HRRM AC1,0(RC) ;SET NEW LINK
HLRZ AC1,0(RC) ;GET FLAGS/POINTER
TRNN AC1,-2 ;POINTER?
HRR AC1,RC ;NO, SET TO FLAGS
HLR RC,0(AC1) ;PUT FLAGS IN RC
HRL AC1,MODO ;GET CURRENT MODE
TRZE RC,-2 ;LEFT HALF RELOCATABLE+
TLO AC1,2 ;YES, SET FLAG
HLLM AC1,0(AC1) ;STORE NEW FLAGS
BOUT30: HLLO CS,AC0
TLZE RC,1 ;PACK RELOCATION BITS
TRO RC,2
TRNE RC,2 ;LEFT HALF RELOCATABLE?
TRZ CS,1 ;YES, RESET BIT
PUSH PP,AC0 ;NEED AN AC
HLRZ AC0,-1(PP) ;AC0 = LEFT RELOCATION
CAILE AC0,1 ;EXTERNAL?
XORI CS,EXTF!1 ;YES, SET SWITCH
IFN FORMSW,<
OR AC0,HWFMT
JUMPN AC0,BOUT3H ;EDIT IN HALF WORD FORMAT IF NOT 0
MOVE AC0,FORM ;GET FORM WORD
MOVEI C,0 ;ZERO FIELD SIZE
BOUT3A: JFFO AC0,BOUT3B ;AC1 = FIELD SIZE -1
JRST BOUT3C ;NO FIELDS LEFT, JUMP
BOUT3B: LSH AC0,1(AC1) ;SHIFT OFF FORM FIELD
MOVEI AC1,6(AC1)
IDIVI AC1,3 ;AC1 = COLUMNS USED + 1
ADDI C,(AC1) ;INCREMENT FIELD SIZE
CAIG C,^D23 ;IS FIELD SIZE GTR 23?
JRST BOUT3A ;NO. CONTINUE
MOVE AC1,HWFORM ;USE STANDARD FORM
MOVEM AC1,FORM
MOVEI C,^D13 ;SET FIELD SIZE TO 13
BOUT3C: MOVEM C,FLDSIZ ;STORE FIELD SIZE
MOVE AC0,FORM ;AC0 = FORM WORD
TRNN RC,2 ;IS LEFT HALF RELOCATED?
CAMN AC0,HWFORM ;NO. IS FORM HALF WORD?
JRST BOUT3H ;YES. EDIT IN OLD WAY
IBP TABP
CAIL C,^D16
IBP TABP
ILDB C,TABP ;GET A TAB
PUSHJ PP,OUTL ;OUTPUT IT
MOVE AC2,(PP) ;AC2 = INFO TO BE EDITED
PUSH PP,CS ;SAVE CS = C+1
BOUT3D: JFFO AC0,BOUT3E ;AC1 = FIELD LENGTH - 1
BOUT3E: LSH AC0,1(AC1) ;SHIFT OFF FORM FIELD
MOVEI C,3(AC1)
MOVEI AC1,0
LSHC AC1,-2(C) ;AC1 = FIELD INFO
IDIVI C,3 ;C = # OF OCTAL DIGITS
MOVE C+1,AC0 ;SAVE AC0
SKIPE IOSEEN ;IS THIS A I/O INST.
PUSHJ PP,BOUT3J ;YES,SET FIELDS CORRECTLY
MOVNS C
ROT AC1,(C)
ROT AC1,(C)
ROT AC1,(C)
MOVNS C
BOUT3F: MOVEI AC0,6 ;EDIT A DIGIT
LSHC AC0,3
EXCH AC0,C
PUSHJ PP,OUTC ;OUTPUT IT
MOVE C,AC0
SOJG C,BOUT3F ;IF MORE DIGITS, GO BACK
JUMPE C+1,BOUT3G ;JUMP IF END OF WORD
MOVE AC0,C+1 ;RESTORE AC0
MOVEI C," "
PUSHJ PP,OUTC ;OUTPUT A SPACE
JRST BOUT3D ;PROCESS NEXT FIELD
BOUT3G: POP PP,CS ;RESTORE CS = C+1
MOVEI C," "
TRNE RC,1 ;RELOCATABLE?
MOVEI C,"'" ;YES
HRRZ AC0,-1(PP) ;AC0 = RIGHT RELOCATION
CAILE AC0,1 ;EXTERNAL?
MOVEI C,"*" ;YES
PUSHJ PP,ONC2 ;STORE POSSIBLE INDICATOR
POP PP,AC0
JRST BOUT3I ;CONTINUE
BOUT3H: MOVEI C,^D15 ;SET SIZE TO 15
MOVEM C,FLDSIZ ;[116]
SETZM IOSEEN ;CLEAR INCASE HWFMT WAS SET
>
POP PP,AC0 ;RESTORE
PUSHJ PP,ONC
HRLO CS,AC0
TDZ CS,RC ;SET RELOCATION
HRRZ C,(PP) ;C = RIGHT RELOCATION
CAILE C,1 ;EXTERNAL
XORI CS,EXTF!1 ;YES, SET SWITCH
PUSHJ PP,ONC
BOUT3I: POP PP,CS ;GET RID OF ENTRY ON STACK
HRRZ CS,LOCO
TLNE FR,RIMSW!RIM1SW!R1BSW ;RIM OUTPUT?
JRST ROUT ;YES, GO PROCESS
HRL CS,MODO
CAME CS,MODLOC ;SEQUENCE OR RELOCATION BREAK?
PUSHJ PP,COUTD ;YES, DUMP THE BUFFER
SKIPL COUTX ;NEW BUFFER?
JRST BOUT40 ;NO, STORE CODE AND EXIT
MOVEM CS,MODLOC ;YES, STORE NEW VALUES
EXCH AC0,LOCO
EXCH RC,MODO
PUSHJ PP,COUT ;STORE BLOCK LOCATION AND MODE
EXCH RC,MODO ;RESTORE CURRENT VALUES
EXCH AC0,LOCO
BOUT40: PUSHJ PP,COUT ;EMIT CODE
POP PP,RC ;RETRIEVE EXTERNAL BITS
TRNN RC,-2 ;RIGHT EXTERNAL?
JRST BOUT50 ;TRY FOR LEFT
PUSHJ PP,COUTD
PUSH PP,BLKTYP ;TERMINATE TYPE AND SAVE
MOVEI AC0,2 ;BLOCK TYPE 2
MOVEM AC0,BLKTYP
MOVE AC0,1(RC) ;GET SYMBOL
MOVEI ARG,60 ;CODE BITS
PUSHJ PP,SQOZE ;CONVERT TO RADIX 50
HLLZS RC ;SYMBOL HAS NO RELOCATION
PUSHJ PP,COUT ;EMIT
MOVE AC0,LOCO ;GET CURRENT LOC
HRLI AC0,400000 ;ADDITIVE REQ
HRR RC,MODO ;CURRENT MODE
PUSHJ PP,COUT ;EMIT
MOVSS RC ;NOW FOR LEFT
TRNN RC,-2
JRST BOUT60
JRST BOUT70
BOUT50: MOVSS RC ;CHECK OTHER HALF
TRNN RC,-2 ;LEFT HALF EXTERNAL?
JRST BOUT80 ;NO, FALSE ALARM
PUSHJ PP,COUTD ;CHANGE MODE
PUSH PP,BLKTYP
MOVEI AC0,2
MOVEM AC0,BLKTYP
BOUT70: MOVE AC0,1(RC)
MOVEI ARG,60
PUSHJ PP,SQOZE
HLLZS RC
PUSHJ PP,COUT
MOVE AC0,LOCO
HRLI AC0,600000 ;LEFT HALF ADD
HRR RC,MODO
PUSHJ PP,COUT ;EMIT
BOUT60: PUSHJ PP,COUTD ;CHANGE MODE
POP PP,BLKTYP ;TO OLD ONE
BOUT80: AOS LOCO
AOS MODLOC
POPJ PP,
IFN FORMSW,<
BOUT3J: MOVSS IOSEEN ;SWAP
SKIPGE IOSEEN ;SKIP IF NOT FIRST FIELD
JRST [HLLZS IOSEEN ;CLEAR RIGHT HALF
POPJ PP,] ;AND RETURN
MOVSS IOSEEN ;SWAP BACK
LSH AC1,2 ;CORRECT MNEMONIC AND OP CODE
CAIE C,1 ;IS IT OP CODE?
POPJ PP, ;NO,JUST RETURN
MOVEI C,2 ;TWO CHAR. WIDE NOW
SETZM IOSEEN ;DON'T COME AGAIN
POPJ PP, ;RETURN
>
NOUT: MOVE V,[POINT 7,TBUF] ;POINTER TO ASCII LINE
MOVSI CS,(POINT 6,AC0) ;POINTER TO SIXBIT AC0
SETZB ARG,AC0
NOUT1: ILDB C,V ;GET ASCII
CAIL C,"A"+40
CAILE C,"Z"+40
JRST .+2
TRZA C,100 ;LOWER CASE TO SIXBIT
SUBI C,40 ;CONVERT TO SIXBIT
JUMPLE C,NOUT3 ;TEST FORM NON-SIXBIT
CAILE C,77 ;AND NOT GREATER THAN SIXBIT
JRST NOUT3 ;...
IDPB C,CS ;DEPOSIT IN AC0
TLNE CS,770000 ;TEST FOR SIX CHARACTERS
JRST NOUT1 ;NO, GET ANOTHER
NOUT3: SKIPGE UNIVSN ;IF A UNIVERSAL PROG
POPJ PP, ;RETURN TO PUT IT IN THE TABLE
IFN CCLSW,<SKIPN TBUF+1 ;AND IF WE HAVE NOT SEEN A TITLE
PUSHJ PP,PRNAM ;THEN PRINT THE NAME>
PUSHJ PP,NOUT2 ;[214] DUMP NAME
MOVSI AC0,11 ;[214] TYPE MARKER
IOR AC0,CPUTYP ;[235] CPU TYPE
PJRST COUT ;[214] DUMP AND EXIT
NOUT2: PUSHJ PP,SQOZE ;CONVERT TO SIXBIT
JRST COUT ;DUMP AND EXIT
HOUT:
IFN POLISH,<
SETZ AC0, ;[265] FORCE TO PSECT 0
SKIPE SGNMAX ;[265] NO PSECTS
PUSHJ PP,SGOUTN ;[265] PUT IT OUT
>
MOVEI RC,1 ;RELOCATABLE
MOVE AC0,HHIGH ;GET HIGH SEG IF TWO SEGMENTS
JUMPE AC0,.+2 ;NOT TWO SEGMENTS
PUSHJ PP,COUT ;OUTPUT IT
MOVE AC0,SGATTR ;[265]
SKIPE HHIGH ;ANY TWOSEG HIGH STUFF
JRST COUT ;YES,SO NO ABS.
PUSHJ PP,COUT ;OUTPUT THE HIGHEST LOCATION
MOVE AC0,ABSHI
;PUT OUT ABS PORTION OF PROGRAM BREAK
SOJA RC,COUT ;OUTPUT A WORD OF ZERO AND EXIT
IFN POLISH,< ;[164]
;HERE TO OUTPUT BLOCK TYPE 11
POUT: SKIPN POLIST ;ANY POLISH TO OUTPUT?
POPJ PP, ;NO
TLO FR,POLSW ;SET FLAG
PUSHJ PP,COUTD ;DUMP BUFFER UNLESS EMPTY
MOVE CS,@POLIST ;GET A BLOCK POINTER
EXCH CS,POLIST ;SET FOR NEXT TIME
POUTA: ADDI CS,1 ;FIRST WORD
MOVE AC0,(CS) ;GET SOMETHING
SETZ RC, ;CLEAR RELOCATION
JUMPL AC0,POUTOP ;THIS IS AN OPERATOR
PUSHJ PP,PCOUT ;STORE THIS HALF WORD
JUMPE AC0,POUT0 ;18 BIT VALUE
SOJE AC0,POUT1 ;36 BIT VALUE
HLRZ AC0,1(CS) ;GET HALF OF SYMBOL
PUSHJ PP,PCOUT
HRRZ AC0,1(CS) ;GET OTHER HALF
PUSHJ PP,PCOUT
AOJA CS,POUTA
POUT0: HLRZ RC,1(CS) ;GET RELOCATION
HRRZ AC0,1(CS) ;AND VALUE
PUSHJ PP,PCOUT
AOJA CS,POUTA ;GET NEXT
POUT1: HLRZ RC,1(CS) ;GET LEFT HALF
HLRZ AC0,2(CS)
PUSHJ PP,PCOUT
HRRZ RC,1(CS) ;RIGHT HALF
HRRZ AC0,2(CS)
PUSHJ PP,PCOUT
ADDI CS,2 ;SKIP OVER 2 WORDS
JRST POUTA
POUTOP: HRRZ AC0,AC0 ;GET OPERATOR ONLY
PUSHJ PP,PCOUT ;OUTPUT
CAIGE AC0,-6 ;[265] CHECK FOR STORE OP
JRST POUTA ;ITS NOT
CAIGE AC0,-3 ;CHECK FOR SYMBOL FIXUP
JRST POUTSY ;IT IS
HLRZ RC,1(CS) ;GET RELOCATION
HRRZ AC0,1(CS) ;AND STORE ADDRESS
POUTOQ: PUSHJ PP,PCOUT
TLZ FR,POLSW ;CLEAR FLAG INCASE END
JRST POUT ;SEE IF MORE TO GO
POUTSY: HLRZ AC0,1(CS) ;GET LHS SYMBOL
SETZ RC, ;NO RELOCATION
PUSHJ PP,PCOUT ;OUTPUT IT
HRRZ AC0,1(CS) ;GET RHS
PUSHJ PP,COUT
JFFO PP,POUTOQ ;FOLLOW WITH 0 FOR BLOCK LEVEL (FAIL COMPATIBLE)
PCOUT: MOVE C,COUTP ;GET POINTER
TLNE C,010000 ;LEFT OR RIGHT HALF?
JRST PCOUTR ;JUST THE RIGHT HALF
AOS C,COUTX ;INCREMENT INDEX
HRLZM AC0,COUTDB(C) ;STORE LEFT HALF
IDPB RC,COUTP ;AND RELOCATION
POPJ PP,
PCOUTR: MOVE C,COUTX ;GET CURRENT INDEX
HRRM AC0,COUTDB(C) ;STORE RIGHT HALF
IDPB RC,COUTP ;AND RELOCATION
CAIE C,^D17 ;IS THE BUFFER FULL
POPJ PP, ;NO
JRST COUTD ;YES, DUMP IT
;HERE TO OUTPUT BLOCK TYPE 22 - PSECT NAME
SGOUTN: PUSHJ PP,COUTD ;FINISH OFF CURRENT BLOCK
PUSH PP,BLKTYP ;SAVE CURRENT BLOCK TYPE
MOVEI AC0,22 ;BLOCK TYPE 22 IS A
MOVEM AC0,BLKTYP ; PSECT NAME
MOVE C,SGNCUR ;GET CUR PSECT INX
MOVE AC0,SGNAME(C) ;GET PSECT NAME
SETZ RC, ;CLEAR RELOCATION
PUSHJ PP,COUT ;OUTPUT THE BLOCK
MOVE C,SGNCUR ;INDEX AGAIN
HRRZ AC0,SGORIG(C) ;GET ORIGIN IF SPECIFIED
SKIPE AC0 ;NOT
PUSHJ PP,COUT
PUSHJ PP,COUTD ;FINISH IT OFF
POP PP,BLKTYP ;RESTORE CURRENT BLOCK TYPE
POPJ PP, ;RETURN
;HERE TO OUTPUT BLOCK TYPE 23 - PSECT LENGTH AND ATTRIBUTES
SGOUTL: PUSHJ PP,COUTD ;FINISH OFF CURRENT BLOCK
PUSH PP,BLKTYP ;SAVE CURRENT BLOCK TYPE
MOVEI AC0,23 ;BLOCK TYPE 23 IS A
MOVEM AC0,BLKTYP ; PSECT LENGTH
MOVE RC,SGNCUR ;GET CUR PSECT INX
MOVE AC0,SGNAME(RC) ;GET PSECT NAME
SETZ RC, ;CLEAR RELOCATION
PUSHJ PP,COUT ;OUTPUT THE NAME
MOVE RC,SGNCUR ;GET CUR PSECT INX
MOVE AC0,SGATTR(RC) ;GET PSECT LENGTH AND ATTRS
MOVEI RC,1 ;BREAK IS RELOCATED
PUSHJ PP,COUT ;OUTPUT THE LENGTH AND ATTRS
PUSHJ PP,COUTD ;FINISH IT OFF
POP PP,BLKTYP ;RESTORE CURRENT BLOCK TYPE
POPJ PP, ;RETURN
>
HSOUT: SETZM HISNSW ;CLEAR FOR PASS2
MOVE AC0,SVTYP3 ;GET HISEG ARG
JUMPGE AC0,.+4 ;JUMP IF ONLY HISEG
HRL AC0,HIGH1 ;GET BREAK FROM PASS 1
JUMPL AC0,.+2 ;OK IF GREATER THAN 400000
HRLS AC0 ;SIGNAL TWO SEGMENT TO LOADER
MOVEI RC,1 ;ASSUME RELOCATABLE
JRST COUT ;OUTPUT THE WORD
VOUT: SKIPN RC,VECREL ;IS VECTOR ABSOLUTE ZERO?
SKIPE VECTOR ;ALSO CHECK RELOCATION
JRST .+3 ;[244]
SKIPN VECSYM ;[244] SEE IF SYMBOLIC
POPJ PP, ;YES, EXIT
IFN POLISH,<
MOVE AC0,VECFND ;GET START ADR PSECT INX
MOVEM AC0,SGNCUR ;POINT CUR PSECT THERE
SKIPE SGNMAX ;IF PSECTS WERE USED
PUSHJ PP,SGOUTN ; THEN PUT OUT PSECT BLOCK
MOVE RC,VECREL> ;GET RELOCATION
MOVE AC0,VECTOR ;AC0 SHOULD BE FLAGS
SKIPN VECSYM ;[244] 2 WORDS IF SYMBOLIC
JRST COUT
PUSHJ PP,COUT ;OUTPUT CONSTANT
MOVE AC0,VECSYM ;[244] GET SYMBOL
MOVEI ARG,60 ;[210] MAKE REQUEST
PUSHJ PP,SQOZE ;[210] IN RADIX-50
SETZ RC, ;[240]
COUT: AOS C,COUTX ;INCREMENT INDEX
MOVEM AC0,COUTDB(C) ;STORE CODE
IDPB RC,COUTP ;STORE RELOCATION BITS
CAIE C,^D17 ;IS THE BUFFER FULL?
POPJ PP, ;NO, EXIT
COUTD: AOSG C,COUTX ;DUMP THE BUFFER
JRST COUTI ;BUFFER WAS EMPTY
HRL C,BLKTYP ;SET BLOCK TYPE
COUTT: ;[232] ENTER FROM .TEXT PSEUDO-OP
PUSHJ PP,OUTBIN ;OUTPUT COUNT AND TYPE
SETOB C,COUTY ;INITIALIZE INDEX
COUTD2: MOVE C,COUTDB(C) ;GET RELOCATION BITS/CODE
CAMN SDEL,[XWD 440000,0] ;[331] IF .TEXT, ONLY OUTPUT THE RELOCATION
TRZN C,1 ;[331] WORD IF IT HAS DATA OR IS NEEDED
;[331] FOR A NULL STRING TERMINATOR
PUSHJ PP,OUTBIN ;DUMP IT
AOS C,COUTY ;INCREMENT INDEX
CAMGE C,COUTX ;TEST FOR END
JRST COUTD2 ;NO, GET NEXT WORD
COUTI: SETOM COUTX ;INITIALIZE BUFFER INDEX
SETZM COUTRB ;ZERO RELOCATION BITS
IFN POLISH,<
HRRZ C,BLKTYP ;[164] IF WE ARE OUTPUTING
CAIN C,11 ;[164] POLISH BLOCK TYPE 11
SKIPA C,[POINT 1,COUTRB] ;[164] USE HALF WORDS
>
MOVE C,[POINT 2,COUTRB]
MOVEM C,COUTP ;INITIALIZE BIT POINTER
POPJ PP, ;EXIT
STOWZ1:
IFN FORMSW,< MOVE AC1,HWFORM ;USE STANDARD FORM>
STOWZ: MOVEI RC,0
STOW:
IFN FORMSW,< MOVEM AC1,FORM ;STORE FORM WORD>
IFN TSTCD,<
SKIPE TCDFLG ;[414]TESTING NEW LINK CODES?
JRST STOWTC ;[414]YES.
> ; NFI TSTCD ;[414]
JUMP1 STOW20 ;SKIP TEST IF PASS ONE
TRNE RC,-2 ;RIGHT HALF ZERO OR 1?
PUSHJ PP,STOWT ;NO, HANDLE EXTERNAL
TLNN RC,-2 ;LEFT HALF ZERO OR 1? WFW
JRST STOW10 ;YES, SKIP TEST
MOVSS RC ;SWAP HALVES
PUSHJ PP,STOWT1 ;HANDLE EXTERNAL WFW
MOVSS RC ;RESTORE VALUES
STOW10: SKIPE EXTPNT ;ANY EXTERNALS REMAINING?
TRO ER,ERRE ;YES, SET EXTERNAL ERROR FLAG
STOW20: AOS AC1,STPX ;INCREMENT POINTER
MOVEM AC0,STCODE(AC1) ;STOW CODE
MOVEM RC,STOWRC(AC1) ;STOW RELOCATION BITS
IFN FORMSW,<
PUSH PP,FORM
POP PP,STFORM(AC1) ;STORE FORM WORD
>
SKIPN LITLVL ;ARE WE IN LITERAL?
AOS LOCA ;NO, INCREMENT ASSEMBLY LOCATION
CAIGE AC1,.STP-1 ;OVERFLOW?
POPJ PP, ;NO, EXIT
SKIPE LITLVL ;ARE WE IN A LITERAL?
TROA ER,ERRL ;YES, FLAG ERROR BUT DON'T DUMP
JRST CHARL1 ;NO, SAVE REGISTERS AND DUMP THE BUFFER
JRST STOWI ;INITIALIZE BUFFER
DSTOW: AOS AC1,STPY ;INCREMENT POINTER
MOVE AC0,STCODE(AC1) ;FETCH CODE
MOVE RC,STOWRC(AC1) ;FETCH RELOCATION BITS
IFN FORMSW,<
PUSH PP,STFORM(AC1)
POP PP,FORM ;GET FORM WORD
>
CAMGE AC1,STPX ;IS THIS THE END?
POPJ PP, ;NO, EXIT
STOWI: SETOM STPX ;INITIALIZE FOR INPUT
SETOM STPY ;INITIALIZE FOR OUTPUT
SETZM EXTPNT
POPJ PP, ;EXIT
SVSTOW: AOS LITLVL ;NESTED LITERALS
PUSH PP,STPX ;MAKE ROOM FOR ANOTHER
PUSH PP,STPY
MOVE AC1,STPX
MOVEM AC1,STPY
JRST 0(AC2)
GTSTOW: POP PP,STPY ;BACK UP A LEVEL
POP PP,STPX
SOS LITLVL
JRST 0(AC2)
;EXTERNAL RIGHT
STOWT: HRRZ AC1,EXTPNT ;GET RIGHT POINTER
CAIE AC1,(RC) ;DOES IT MATCH
PUSHJ PP,QEXT ;EXTERNAL OR RELOCATION ERROR
HLLZS EXTPNT
POPJ PP, ;EXIT
;EXTERNAL LEFT
STOWT1: HLRZ AC1,EXTPNT ;GET LEFT HALF
CAIE AC1,(RC) ;SEE ABOVE
PUSHJ PP,QEXT
HRRZS EXTPNT
POPJ PP, ;EXIT
IFN TSTCD,<
STOWTC: SKIPE RC ;[414]RELOCATABLE OR EXTERNAL?
PUSHJ PP,QEXT ;[414]YES,FLAG ERROR
JUMP1 CPOPJ ;[414]IF PASS 1, RETURN
MOVE C,AC0 ;[414]GET VALUE
JRST OUTBIN ;[414]DEPOSIT INTO REL FILE AND RETURN
> ; NFI TSTCD
ONC: ILDB C,TABP ;ENTRY TO ADVANCE TAB POINTER
PUSHJ PP,OUTL ;OUTPUT A TAB
;OUTPUT 6 OCT NUMBERS FROM CS LEFT
ONC1: MOVEI C,6 ;CONVERT TO ASCII
LSHC C,3 ;SHIFT IN OCTAL
PUSHJ PP,OUTL ;OUTPUT ASCII FROM C
TRNE CS,-1 ;ARE WE THROUGH?
JRST ONC1 ;NO, GET ANOTHER
MOVEI C,0 ;CLEAR C
TLNN CS,1 ;RELOCATABLE?
MOVEI C,"'" ;YES
TLNN CS,EXTF ;OR EXTERNAL
MOVEI C,"*" ;YES
ONC2: JUMPN C,OUTC ;OUTPUT IF EXTERN OR RELOCATABLE
IFN FORMSW,< SOS FLDSIZ ;DECREMENT FIELD SIZE>
POPJ PP, ;EXIT
DNC: IDIVI C,^D10
HRLM CS,0(PP)
JUMPE C,.+2
PUSHJ PP,DNC ;RECURSE IF NON-ZERO
HLRZ C,0(PP)
ADDI C,"0" ;FORM ASCII
JRST PRINT ;DUMP AND TEST FOR END
OUTAS0: HRLI CS,(POINT 7,,) ;ENTRY TO SET POINTER
OUTASC: ILDB C,CS ;GET NEXT BYTE
JUMPE C,POPOUT ;EXIT ON ZERO DELIMITER
PUSHJ PP,PRINT
JRST OUTASC
OUTSIX: HRLI CS,(POINT 6,,) ;OUTPUT SIXBIT
ILDB C,CS ;GET SIXBIT
CAIN C,40 ;"@" DELIMITER?
POPJ PP, ;YES, EXIT
ADDI C,40 ;NO, FORM ASCII
PUSHJ PP,OUTL ;OUTPUT ASCII CHAR FROM C
JRST OUTSIX+1
OUTSYM: MOVE CS,AC0 ;PLACE NAME IN CS
OUTSY1: MOVEI C,0 ;CLEAR C
LSHC C,6 ;MOVE NEXT SIXBIT CHARACTER IN
JUMPE C,OUTTAB ;TEST FOR END
ADDI C,40 ;CONVERT TO ASCII
PUSHJ PP,OUTL ;OUTPUT
JRST OUTSY1 ;LOOP
OUTSET: AOS SX,0(PP) ;GET RETURN LOCATION
MOVE SX,-1(SX) ;GET XWD CODE
HLRM SX,BLKTYP ;SET BLOCK TYPE
SETZB ARG,RC
PUSHJ PP,0(SX) ;GO TO PRESCRIBED ROUTINE
JRST COUTD ;TERMINATE BLOCK AND EXIT
;LOOKUP SCANS ALL THE SYMBOLS IN THE SYMBOL TABLE
LOOKUP: POP PP,LOOKX ;INTERCEPT RETURN POP
MOVE SX,SYMBOL
IFE POLISH,<
MOVE SDEL,0(SX) ;SET FOR TABLE SCAN
LOOKL: SOJL SDEL,POPOUT ;TEST FOR END
>
IFN POLISH,<
PUSH PP,0(SX) ;SET FOR TABLE SCAN
LOOKL: SOSGE 0(PP) ;TEST FOR END
JRST LOOKXT ;DONE, EXIT
>
ADDI SX,2
MOVE AC0,-1(SX)
PUSHJ PP,SRCH7 ;LOAD REGISTERS
HLRZS ARG
PUSHJ PP,@LOOKX ;RETURN TO CALLING ROUTINE
JRST LOOKL ;TRY AGAIN
IFE POLISH,<SYN LOOKUP,SGLKUP>
IFN POLISH,<
LOOKXT: POP PP,AC0 ;THROW AWAY COUNTER
POPJ PP,
SGLKUP: POP PP,LOOKX ;INTERCEPT RETURN POP
MOVE SX,SGNCUR ;GET CUR PSECT INX
PUSH PP,SGSCNT(SX) ;SAVE SYM CNT
HRRZS 0(PP) ;DON'T WANT LEFT HALF
MOVE SX,SGSBOT ;GET INIT SYM TAB PTR
JRST LOOKL ;REST IS SAME AS FOR FULL CASE
>
END0:
IFN FT.U01,<
MOVE V,[IOWD $USRLN,$USSTK] ; RESET USER STACK
MOVEM V,$USRPD ; SO DO IT
>; END OF FT.U01
IFN POLISH,<
HRROS SGNCUR ;[265] FORCE EVALUATION IN ITS OWN PSECT
>
PUSHJ PP,EVALCM ;GET A WORD
IFN POLISH,<
HRRZS SGNCUR ;[265] BACK TO NORMAL
>
SKIPN V,AC0 ;NON-ZERO?
JUMPE RC,.+2 ;OR RELOC?
PUSHJ PP,ASSIG7 ;YES, LIST THE VALUE
SETZM VECSYM ;[240] INCASE NOT SYMBOLIC
SKIPN EXTPNT ;[210] EXTERNAL?
JRST END00 ;[210] NO
CAME RC,EXTPNT ;[210] MAKE SURE SAME
JRST [SETZB AC0,VECSYM ;[244] NO, CLEAR
TRO ER,ERRE ;[210] FLAG ERROR
JRST .+3] ;[244]
MOVE RC,1(RC) ;[244] GET SIXBIT NAME
MOVEM RC,VECSYM ;[244] STORE SYMBOL NAME
SETZB RC,EXTPNT ;[210] AND CLEAR RELOC
END00: MOVEM AC0,VECTOR
MOVEM RC,VECREL
IFN POLISH,<
MOVE AC1,SGWFND ;[265] GET START ADR PSECT INX
MOVEM AC1,VECFND ;[265] SAVE IT
>
PUSHJ PP,STOUTS ;DUMP THE LINE
END01: SETZ MRP, ;[223] SHOULDN'T BE IN A MACRO BY NOW
IFN POLISH,<
MOVE AC1,SGNMAX ;[265] GET HIGHEST PSECT USED
PUSH PP,AC1 ;[265] SAVE IT
END02: CAME AC1,SGNCUR ;[265] IF NOT CURRENT
PUSHJ PP,%SWSEG ;[265] SWAP IT
>
PUSHJ PP,VARA ;FILL OUT SELF-DEFINED VARIABLES
IFE IIISW,<PUSH PP,IO ;SAVE FLAGS
TLO IO,IOPROG ;XLIST LITS>
PUSHJ PP,LIT1
IFE IIISW,<POP PP,IO ;GET FLAG BACK>
IFN POLISH,<
SOSL AC1,0(PP) ;[265] DONE YET?
JRST END02 ;[265] NO
POP PP,AC1 ;[265] GET JUNK OFF STACK
>
JUMP2 ENDP2
MOVE HHIGH ;GET HIGH SEG BREAK
MOVEM HIGH1 ;SAVE FOR TWOSEG/HISEG BLOCK TYPE 3
PUSHJ PP,UOUT
TLNN IO,MFLSW ;SKIP IF ONLY PSEND
PUSHJ PP,REC2
MOVE INDIR ;SET UP FIRST AS LAST
MOVEM LSTFIL ;PRINTED
SETZM LSTPGN
PUSHJ PP,INZ1 ;[234]
TLNE IO,MFLSW ;IF PSEND
POPJ PP, ;BACK TO PSEND0
SKIPE PRGPTR ;HAVE ANY PRGEND'S BEEN SEEN
PUSHJ PP,PSEND3 ;YES,GO SET UP AGAIN
PASS20: SETZM CTLSAV
PUSHJ PP,COUTI
PUSHJ PP,EOUT ;OUTPUT THE ENTRIES
PUSHJ PP,OUTSET
XWD 6,NOUT ;OUTPUT THE NAME (BLKTYP-6)
SKIPN HISNSW ;PUT OUT BLOCK TYPE 3?
JRST PASS21 ;NO
PUSHJ PP,OUTSET
XWD 3,HSOUT ;OUTPUT THE HISEG BLOCK
PASS21: MOVEI 1
HRRM BLKTYP ;SET FOR TYPE 1 BLOCK
TLZ FR,P1 ;SET FOR PASS 2 AND TURN OFF FLAG
TLO IO,IOPALL ;PUT THESE BACK
TLZ IO,IOPROG!IOCREF!DEFCRS!IONCRF ;[141] SO LISTINGS WILL BE THE WAY THEY SHOULD
TLNN FR,R1BSW
JRST STOWI
MOVE CS,[XWD $ST-1-$CKSM,R1BLDR]
MOVE C,0(CS)
PUSHJ PP,PTPBIN
AOBJN CS,.-2
PUSHJ PP,R1BI
JRST STOWI
R1BLDR:
PHASE 0
IOWD $ADR,$ST
$ST: CONO PTR,60
HRRI $A,$RD+1
$RD: CONSO PTR,10
JRST .-1
DATAI PTR,@$TBL1-$RD+1($A)
XCT $TBL1-$RD+1($A)
XCT $TBL2-$RD+1($A)
$A: SOJA $A,
$TBL1: CAME $CKSM,$ADR
ADD $CKSM,1($ADR)
SKIPL $CKSM,$ADR
$TBL2: JRST 4,$ST
AOBJN $ADR,$RD
$ADR: JRST $ST+1
$CKSM:
DEPHASE
IF2,< PURGE $ST,$RD,$A,$TBL1,$TBL2,$ADR,$CKSM>
ENDP2: PUSHJ PP,COUTD ;DUMP THE BUFFER
MOVE AC0,LOCO ;CHECK TO SEE IF LIT DIFFERED
SKIPN MODO ;AND USE SMALLER SINCE AT END
JRST [CAMN AC0,ABSHI
HRRZM AC2,ABSHI
JRST ENDP2W]
SKIPE HHIGH ;SKIP IF NOT TWO SEGMENTS
JRST [CAMN AC0,HHIGH
HRRZM AC2,HHIGH
JRST ENDP2W]
CAMN AC0,HIGH
HRRZM AC2,HIGH
ENDP2W:
IFN POLISH,<
MOVE AC1,SGNCUR
CAMN AC0,HIGH
HRRM AC2,SGATTR(AC1)
>
REPEAT 1,<TLNE IO,IOCREF ;CLOSE CREF IF NECESSARY>
REPEAT 0,<TLNE FR,CREFSW ;IF CREFFING
JRST ENDP2Q
MOVEI SDEL,0
PUSH PP,DBUF+3 ;SO NO PAGE INFO
DPB SDEL,[POINT 7,DBUF+3,13]
IOR ER,OUTSW ;MAKE SURE OF OUTPUT
PUSHJ PP,CREF
MOVEI C,20 ;CODE FOR TITLE
PUSHJ PP,OUTLST
PUSH PP,IO ;SAVE THIS
TLZ IO,IOPAGE ;AND PREVENT PAGE DURING TITLE
MOVEI CS,TBUF
PUSHJ PP,OUTAS0
MOVEI CS,VBUF
PUSHJ PP,OUTAS0
POP PP,IO ;RESTORE THE IO WORD
POP PP,DBUF+3> ;NEEDS FIX TO CREF
PUSHJ PP,CLSCR2 ;CLOSE IT UP
ENDP2Q: HRR ER,OUTSW ;SET OUTPUT SWITCH
SKIPN TYPERR
TRO ER,TTYSW
PUSHJ PP,UOUT ;OUTPUT UNDEFINEDS
TRO ER,TTYSW
OUTPUT CTL, ;CLEAR JUNK OUT OF BUFFER
SKPINC C ;SEE IF WE CAN INPUT A CHAR.
JFCL ;BUT ONLY TO DEFEAT ^O
SKIPG C,QERRS ;ANY Q ERRORS SEEN?
JRST ENDPER ;NO, TRY REAL ERRORS
PUSHJ PP,OUTCR ;NEW LINE
MOVEI C,"%" ;WARNING CHARACTER
PUSHJ PP,OUTL
MOVE C,QERRS ;GET COUNT
CAIN C,1 ;1 IS SPECIAL
JRST ONERQ
PUSHJ PP,DNC ;OUTPUT IT
SKIPA CS,[EXP ERRMQ2]
ONERQ: MOVEI CS,ERRMQ1
PUSHJ PP,OUTSIX
ENDPER: SKIPG C,ERRCNT ;GET ERROR COUNT AND CHECK FOR POSITIVE
JRST NOERW ;PRINT NO ERROR MESSAGE
IFN CCLSW,<ADDM C,.JBERR ;REMEMBER ERROR COUNT FOR EXECUTION DELETION>
PUSHJ PP,OUTCR
MOVEI C,"?" ;? FOR BATCH
PUSHJ PP,OUTL ;...
MOVE C,ERRCNT ;PRINT NUMBER OF ERRORS
CAIN C,1 ;1 IS A SPECIAL CASE
JRST ONERW ;PRINT MESSAGE
PUSHJ PP,DNC
SKIPA CS,[EXP ERRMS1] ;LOAD TO PRINT
ONERW: MOVEI CS,ERRMS2 ;ONE ERROR DETECTED
ONERW1: PUSHJ PP,OUTSIX ;PRINT
JRST ENDP2A
NOERW: SKIPE QERRS ;IF "Q" ERRORS
PUSHJ PP,OUTCR ;CLOSE LINE NOW
MOVEI CS,ERRMS3
IFN CCLSW,<TLNE IO,CRPGSW!MFLSW ;IF RPG, DON'T PRINT MESSAGE>
IFE CCLSW,<TLNE IO,MFLSW ;NOR IF MULTI-FILE MODE>
TRZ ER,TTYSW ;NO TTY OUTPUT
IOR ER,OUTSW ;UNLESS NEEDED FOR LISTING
SKIPN QERRS ;ALREADY DONE
PUSHJ PP,OUTCR
JRST ONERW1
ENDP2A: PUSHJ PP,OUTCR
TLNN IO,MFLSW ;IN A MULTI-PROG FILE?
JRST ENDP2D ;NO
SKIPN QERRS ;ANY WARNINGS?
SKIPE ERRCNT ;ANY ERROR?
PUSHJ PP,[MOVEI CS,[ASCIZ /PROGRAM /]
PUSHJ PP,OUTAS0 ;YES,SO PRINT MESSAGE
MOVEI CS,TBUF ;AND TITLE
PUSHJ PP,OUTAS0 ;FOR IDENTIFICATION
JRST OUTCR] ;AND A CR-LF
TRZA ER,TTYSW ;NO MORE OUTPUT NOW
ENDP2D:
IFN CCLSW,<TLNE IO,CRPGSW ;IF RPG, DON'T PRINT PGM BREAK
TRZ ER,TTYSW ;...>
IFE CCLSW,< SKIPA ;SO PRGEND CODE CAN WORK>
IOR ER,OUTSW ;...
PUSHJ PP,OUTCR
MOVEI CS,[SIXBIT /HI-SEG. BREAK IS @/]
SKIPN HHIGH ;DON'T PRINT IF ZERO
JRST ENDP2C ;IT WAS
PUSHJ PP,OUTSIX
HRLO CS,HHIGH ;GET THE BREAK
PUSHJ PP,ONC1
PUSHJ PP,OUTCR
ENDP2C: MOVEI CS,[SIXBIT /PROGRAM BREAK IS @/]
PUSHJ PP,OUTSIX ;OUTPUT PROGRAM BREAK
HRLO CS,SGATTR ;GET PROGRAM BREAK
PUSHJ PP,ONC1
PUSHJ PP,OUTCR
IFN POLISH,<
SKIPN AC1,SGNMAX ;GET PSECT CNT
JRST ENDP2E ;PSECTS NOT USED?
MOVEI AC2,1
ENDP2F: MOVEI CS,[SIXBIT /PSECT BREAK IS @/]
PUSHJ PP,OUTSIX ;OUTPUT PSECT BREAK
HRLO CS,SGATTR(AC2) ;GET PSECT BRK
PUSHJ PP,ONC1
MOVE CS,[SIXBIT / FOR /]
MOVEM CS,SGLIST
MOVE CS,SGNAME(AC2) ;GET PSECT NAME
MOVEM CS,SGLIST+1
MOVSI CS,SIXBIT/ @ /
MOVEM CS,SGLIST+2
MOVEI CS,SGLIST
PUSHJ PP,OUTSIX
PUSHJ PP,OUTCR
AOS AC2
SOJG AC1,ENDP2F ;LOOP THRU PSECT.S
ENDP2E:>
HRRZ CS,ABSHI ;GET ABS. BREAK
CAIG CS,140 ;ANY ABS. CODE
JRST ENDP2B ;NO, SO DON'T PRINT
MOVEI CS,[SIXBIT /ABSLUTE BREAK IS @/]
PUSHJ PP,OUTSIX
HRLO CS,ABSHI
PUSHJ PP,ONC1
PUSHJ PP,OUTCR
ENDP2B: MOVEI CS,[SIXBIT /CPU TIME USED @/]
PUSHJ PP,OUTSIX ;[234] PRINT THE TIME IT TOOK TO ASSEMBLE
SETZ C, ;[234] SO AS TO GET THE RIGHT TIME
RUNTIM C, ;[234] GET THE TIME NOW
SUB C,RTIME ;[234] MINUS TIME WHEN STARTED
IDIVI C,^D1000 ;[234] GET MS.
PUSH PP,C+1 ;[234] SAVE
IDIVI C,^D60 ;[234] GET SEC. IN C+1, MIN. IN C
PUSH PP,C+1 ;[234] SAVE SECONDS
IDIVI C,^D60 ;[234] GET HOURS IN C, MINS. IN C+1
PUSH PP,C+1 ;[234] SAVE MINS
JUMPE C,NOHOUR ;[234] SKIP IF LESS THAN 1 HOUR
PUSHJ PP,DNC ;[234] PRINT HOURS
MOVEI C,":" ;[234] SEPARATOR
PUSHJ PP,OUTC ;[234]
NOHOUR: POP PP,CS ;[234] GET MINS
PUSHJ PP,DECPT2 ;[234] PRINT THEM
MOVEI C,":" ;[234]
PUSHJ PP,OUTC ;[234]
POP PP,CS ;[234] A LITTLE DIFFERENT FOR MS
PUSHJ PP,DECPT2 ;[234] PRINT SECONDS
MOVEI C,"." ;[234] A POINT FOR MS.
PUSHJ PP,OUTC ;[234]
POP PP,CS ;[234] GET MS.
PUSHJ PP,DECPT3 ;[234] PRINT MS.
PUSHJ PP,OUTCR ;[234] AND A CRLF
TLNE FR,RIMSW!R1BSW ;RIM MODE?
PUSHJ PP,RIMFIN ;YES, FINISH IT
IFN CCLSW,<TLNN IO,CRPGSW!MFLSW ;IF NOT IN CCL MODE>
IFE CCLSW,<TLNN IO,MFLSW ;NOR IF IN MULTI-FILE MODE>
TRO ER,TTYSW ;PRINT SIZE
PUSHJ PP,OUTCR
MOVE C,.JBREL
IFN TENEX,<
SUB C,SYMBOL ;[206] ONLY COUNT WHATS REALLY IN USE
ADD C,FREE ;[206] EITHER SYMBOLS OR STORAGE
LSH C,-9 ;[206] IN PAGES
>
IFE TENEX,<
LSH C,-^D10
>
ADDI C,1
PUSHJ PP,DNC
IFE TENEX,<
MOVEI CS,[SIXBIT /K CORE USED@/]
>
IFN TENEX,<
MOVEI CS,[SIXBIT / PAGES USED@/]
>
PUSHJ PP,OUTSIX
PUSHJ PP,OUTCR
HRR ER,OUTSW
PUSHJ PP,OUTSET
XWD 10,LSOUT ;OUTPUT THE LOCALS (..-10)
IFN POLISH,<
SETZM SGNCUR ;SET TO BLANK PSECT
SKIPN SGNMAX ;WERE PSECTS USED?
JRST ENDP2H ;NO
ENDP2G: PUSHJ PP,SRCHI ;SET UP SRCHX,SGSBOT,SGSTOP
PUSHJ PP,SGOUTL ;OUTPUT PSECT LENGTH BLOCK
ENDP2H:
>
PUSHJ PP,OUTSET
XWD 2,SOUT ;OUTPUT THE SYMBOLS (BLKTYP-2)
IFN POLISH,<
AOS SX,SGNCUR ;INCR PSECT INX
CAMG SX,SGNMAX ;LAST PSECT DONE?
JRST ENDP2G ;NO, DO NEXT PSECT
SETZM SGNCUR ;SET TO BLANK PSECT
PUSHJ PP,OUTSET ;[164]
XWD 11,POUT ;[164] OUTPUT THE POLISH (..-11)
MOVSI SX,(POINT 2) ;[164] RESET BYTE COUNT
HLLM SX,COUTP ;[164] AFTER END OF POLISH
>
PUSHJ PP,OUTSET
XWD 7,VOUT ;OUTPUT TRANSFER VECTOR (..-7)
PUSHJ PP,OUTSET
XWD 5,HOUT ;OUTPUT HIGHEST RELOCATABLE (..-5)
PUSHJ PP,COUTD
TLNN IO,MFLSW ;IS IT PRGEND?
JRST FINIS ;ALAS, FINISHED
MOVEI CS,SBUF ;RESET SBUF POINTER
HRRM CS,SUBTTX ;TO SUBTTL
SETZM PASS2I ;CLEAR PASS2 VARIABLES
MOVE [XWD PASS2I,PASS2I+1]
PUSH PP,PAGENO ;SAVE PAGE NUMBER IN CASE PRGEND
BLT PASS2Z-1 ;BUT NOT ALL OF VARIABLES
POP PP,PAGENO ;RESTORE IT
; JRST INZ ;RE-INITIALIZE FOR NEXT PROG
; FALL THROUGH
SUBTTL PASS INITIALIZE
INZ: SETZ C, ;[234] GET CURRENT JOB NUMBER
RUNTIM C, ;[234] GET RUNTIME FOR LATER
MOVEM C,RTIME ;[234] SAVE
INZ1: AOS MODA
AOS MODO
IFN POLISH,<
MOVE AC1,SGNMAX
MOVSI AC0,1
MOVEM AC0,SGRELC(AC1)
SOJGE AC1,.-1
MOVE AC1,SGNMAX ;[265] GET HIGHEST PSECT USED
PUSH PP,AC1 ;[265] SAVE IT
INZ2: CAME AC1,SGNCUR ;[265] IF NOT CURRENT
PUSHJ PP,%SWSEG ;[265] SWAP IT
>
MOVEI VARHD
MOVEM VARHDX
MOVEI LITHD
MOVEM LITHDX
PUSHJ PP,LITI
IFN POLISH,<
SOSL AC1,0(PP) ;[265] DONE YET?
JRST INZ2 ;[265] NO
POP PP,AC1 ;[265] GET JUNK OFF STACK
>
SETZM SEQNO
HRRI RX,^D8
PUSHJ PP,STOWI
IFN FORMSW,<
HRRES HWFMT ;SET DEFAULT VALUE BACK>
JRST OUTLI
RCPNTR: POINT 1,ARG,^L<RELF>-18 ;POINT 1,ARG,22
;[234] ROUTINE TO PRINT CPU TIME USED
DECPT3: MOVEI C,"0" ;[234] FILL WITH ZERO
CAIG CS,^D99 ;[234] 3 DIGITS?
PUSHJ PP,OUTC ;[234] NO
DECPT2: MOVEI C,"0" ;[234] FILL WITH ZERO
CAIG CS,^D9 ;[234] 2 DIGITS?
PUSHJ PP,OUTC ;[234] NO
MOVE C,CS ;[234] GET VALUE
PJRST DNC ;[234] OUTPUT IN DECIMAL AND RETURN
RIMFIN: TLNE FR,R1BSW
PUSHJ PP,R1BDMP
SKIPN C,VECTOR
MOVSI C,(JRST 4,)
TLNN C,777000
TLO C,(JRST)
PUSHJ PP,PTPBIN
MOVEI C,0
JRST PTPBIN
SUBTTL PSEUDO-OP HANDLERS
IFN FT.U01,< ;USER PUSH-DOWN LIST
$PDUSR: PUSH PP,AC0 ;SAVE INSTR FOR LATER
PUSHJ PP,GETSYM ;GET SIXBIT SYMBOL TO PUSH/POP
JRST [TRO ER,ERRA ;NO SYMBOL--FLAKY STATEMENT
POP PP,AC0 ;KEEP THE STACK HONEST
POPJ PP,] ;GIVE UP WITH ERROR FLAG SET
PUSHJ PP,SSRCH ;LOOKUP THE SYMBOL
JRST [TRO ER,ERRU ;SYMBOL MUST BE DEFINED TO PUSH IT
POP PP,AC0 ;CLEAR PDL
POPJ PP,] ;GIVE UP
POP PP,AC0 ;RESTORE INSTR
TLNN AC0,(1B7) ; POP?
JRST $PDUS1 ; NOPE, DON'T CHECK FOR UNDERFLOW
HRRZ AC1,$USRPD ; GET CURRENT STACK POINTER
CAIGE AC1,$USSTK ; IS THE STACK EMPTY?
JRST [TRO ER,ERRA ;YES GIVE AN ERROR
POPJ PP,] ; GIVE UP WITH AN ERROR
$PDUS1: MOVE AC1,$USRPD ;PICK UP USER PDP
TLO AC0,(<AC1>B12) ;PUT LOCATION OF PDP IN INSTR
HRRI AC0,V ;SET LOCATION OF DATA
XCT AC0 ;PUSH/POP THE SYMBOL
MOVEM AC1,$USRPD ;SAVE PDP FOR LATER
TLNE AC0,(1B7) ;WAS THIS A PUSH?
PUSHJ PP,UPDATE ;NO--RESET VALUE OF SYMBOL
CAIN C,',' ;ANOTHER SYMBOL COMING?
JRST $PDUSR ;YES--GO HANDLE IT
POPJ PP, ;NO--GET NEXT STATEMENT
>;END IFN FT.U01
TAPE0: PUSHJ PP,STOUTS ;FINISH THIS LINE
SETZM EOFFLG ;[417]CLEAR END OF FILE FLAG
PUSHJ PP,PEEK ;[221] LOOK AT NEXT CHARACTER
CAIE C,VT ;[221] PRINT IF V TAB
CAIN C,FF ;[221] OR FORM FEED
PUSHJ PP,STOUTS ;[221]
TLZ IO,IORPTC ;[221] CLEAR CHARACTER FROM LOOK-AHEAD
PUSHJ PP,OUTLI2 ;[221] AND FROM LINE BUFFER
SKIPE EOFFLG ;[417]IF EOF SEEN DURING PEEKING
POPJ PP, ;[417]DON'T SKIP ANOTHER FILE, ELSE
JRST GOTEND ;IGNORE THE REST OF THIS FILE
%NOBIN: TLZE FR,PNCHSW ;IS REL FILE OPEN?
CLOSE BIN,40 ;YES, GET RID OF IT
POPJ PP,
RADIX0: PUSHJ PP,EVAL10 ;EVALUATE RADIX D10
CAIG AC0,^D10 ;IF GREATER THAN 10
CAIG AC0,1 ;OR LESS THAN 2,
ERRAX: TROA ER,ERRA ;FLAG ERROR AND SKIP
HRR RX,AC0 ;SET NEW RADIX
POPJ PP,
XALL0: JUMP1 POPOUT ;IGNORE ON PASS 1
TLZN IO,IOSALL ;TURN OFF MACRO SUPPRESS ALL
JRST IOSET ;NOT SALL ON SO NOTHING TO WORRY ABOUT
CAIE C,EOL ;END OF LINE SEEN?
JRST XALL1 ;NO
LDB C,LBUFP ;GET LAST CHARACTER
CAIN C,CR ;UNDER SPECIAL CIRCUMSTANCES IT GETS REMOVED
JRST XALL1 ;[236] NO, ALL IS WELL
SOSG CPL ;ANY ROOM?
PUSHJ PP,RSW5 ;[254] NO, SEE IF ANY EXCESS IN IT
MOVEI C,CR ;NOW FOR TERMINAYOR
IDPB C,LBUFP ;WILL GET REMOVED LATER
XALL1: PUSHJ PP,IOSET ;[236] FINISH OFF LINE
TRNN SX,IOPALL ;[236] WAS IT XALL OR XLIST?
TLO IO,IOSALL ;[236] IT WAS XLIST
POPJ PP, ;[236]
IOSET: JUMP1 POPOUT ;NOSYM (IONSYM), XALL (IOPALL), XLIST (IOPROG)
HLRZ SX,AC0 ;STORE FLAGS
PUSHJ PP,STOUTS ;POLISH OFF LINE
TLO IO,0(SX) ;NOW SUPRESS PRINTING
POPJ PP,
IORSET: TDZ IO,AC0 ;RESET FLAG IOPALL/IOPROG
POPJ PP,
IOLSET: JUMP1 POPOUT ;[327] SPECIAL FOR LALL, TO SEE IF IN MACRO UNDER SALL
TLNE IO,IOSALL ;[327] SEE IF SALL
JUMPN MRP,IOLSE1 ;[327] AND IN MACRO
TDZ IO,AC0 ;[327] NO, CHANGE TO LALL
POPJ PP, ;[327] AND RETURN
IOLSE1: PUSHJ PP,STOUTS ;[327] LALL UNDER MACRO, CLEAR REST OF LINE
TLZ IO,IOSALL!IOPALL ;[327] ****** SET TO LALL
PUSHJ PP,OUTIM ;[327] FORCE A CRLF
POPJ PP, ;[327] AND RETURN
BLOCK0: PUSHJ PP,HIGHQ
PUSHJ PP,EVALEX ;EVALUATE
TLNE AC0,-1 ;[233] SEE IF VALID ARG TYPE
JRST ERRAX ;[233] NO, GIVE ERROR
TRZE RC,-1 ;EXTERNAL OR RELOCATABLE?
PUSHJ PP,QEXT ;YES, DETERMINE TYPE
ADDM AC0,LOCO ;UPDATE ASSEMBLY LOCATION
BLOCK1: EXCH AC0,LOCA ;SAVE START OF BLOCK
ADDM AC0,LOCA ;UPDATE OUTPUT LOCATION
BLOCK2: HRLOM AC0,LOCBLK
JUMP2 POPOUT
TRNE ER,ERRU
TRO ER,ERRV
POPJ PP,
PRNTX0: TRO ER,TTYSW ;SET OUTPUT TO TTY
JUMP2 PRNTX2 ;PASS1?
TDOA ER,OUTSW ;YES,OUTPUT TO LSTDEV ALSO
PRNTX2: ANDCM ER,OUTSW ;NO,DON'T OUTPUT TO TTY IF IT IS LSTDEV
BYPASS ;GET FIRST CHAR.
TLOA IO,IORPTC ;REPEAT IT AND SKIP
PRNTX4: PUSHJ PP,PRINT ;PRINT THE CHAR.
PUSHJ PP,CHARAC ;GET ASCII CHAR.
CAIG C,CR ;IF GREATER THAN CR
CAIG C,HT ;OR LESS THAN LF
JRST PRNTX4 ;THEN CONTINUE
PUSHJ PP,OUTCR ;OUTPUT A CRLF
TRZA ER,TTYSW!LPTSW ;TURN OF OUTPUT
CPOPJ1: AOS (PP) ;USEFUL TAG HAS TO GO SOMEWHERE
CPOPJ: POPJ PP, ;EXIT
REMAR0: PUSHJ PP,GETCHR ;GET A CHARACTER
REMAR1: CAIE C,EOL
JRST REMAR0
POPJ PP, ;EXIT
PAGE0: PUSHJ PP,STOUTS ;[161] PAGE PSEUDO-OP
PAGE1: TLNE IO,IOCREF ;[161] CURRENTLY DOING CREF?
TLNE IO,IOPROG ;[161] AND NOT XLISTED?
JRST PAGE2 ;[161] NO
HRR ER,OUTSW ;[161]
PUSHJ PP,CLSCRF ;[161]
PUSHJ PP,OUTCR
HRRI ER,0 ;[161]
PAGE2: TLO IO,IOPAGE ;[161]
POPJ PP, ;[161]
LIT0: PUSHJ PP,BLOCK1
PUSHJ PP,STOUTS
LIT1: JUMP2 LIT20
;ON PASS ONE, WE JUST STEP THE LOCATION COUNTER AND CLEAR
MOVE AC0,LITCNT
MOVE SX,LITHDX
HRLM AC0,0(SX)
MOVE V,LOCA
HRL V,MODA
MOVEM V,-1(SX)
JRST LIT24
LIT20: PUSH PP,LOCA
PUSH PP,LOCO
SKIPN LITNUM
JRST LIT20A
MOVE SX,LITHDX
HRRZ AC0,-1(SX)
CAME AC0,LOCA
TRO ER,ERRP
LIT20A: MOVE SX,LITAB
LIT21: SOSGE LITNUM
JRST LIT22
IFN FORMSW,<
MOVE AC0,-3(SX)
MOVEM AC0,FORM
>
MOVE AC0,-2(SX) ;WFW
MOVE RC,-1(SX) ;WFW
MOVE SX,(SX) ;WFW POINTER TO THE NEXT LIT
PUSHJ PP,STOW20 ;STOW CODE
MOVEI C,12 ;SET LINE FEED
IDPB C,LBUFP
PUSHJ PP,OUTLIN ;OUTPUT THE LINE
JRST LIT21
LIT22: HRRZ AC2,LOCO
POP PP,LOCO
POP PP,LOCA
MOVE SX,LITHDX
HLRZ AC0,0(SX)
SUB AC2,LOCO ;COMPUTE LENGTH USED
CAMGE AC0,AC2 ;USE LARGER
MOVE AC0,AC2
ADD AC2,LOCO
LIT24: ADDM AC0,LOCA
ADDM AC0,LOCO
PUSHJ PP,GETTOP
HRRM SX,LITHDX
LITI: SETZM LITCNT
SETZM LITNUM
MOVEI LITAB
MOVEM LITABX
JRST HIGHQ
GETTOP: HRRZ AC1,SX ;VARHD
HRRZ SX,0(SX)
JUMPN SX,POPOUT
IFE FORMSW,< MOVEI SX,3 ;WFW>
IFN FORMSW,< MOVEI SX,4 ;ICC>
ADDB SX,FREE
CAML SX,SYMBOL
PUSHJ PP,XCEED
SUBI SX,1 ;MAKE SX POINT TO LINK
SETZM 0(SX) ;CLEAR FORWARD LINK
HRRM SX,0(AC1) ;STORE ADDRESS IN LAST LINK
POPJ PP,
VAR0: PUSHJ PP,BLOCK1 ;PRINT LOCATION
PUSHJ PP,VARA
JRST STOUTS
VARA: MOVE SX,VARHDX
MOVE AC0,LOCA ;GET LOCATION FOR CHECK
JUMP1 VARB ;DO NOT CHECK START ON PASS 1
CAME AC0,-1(SX) ;CHECK START OF VAR AREA
TRO ER,ERRP ;AND GIVE ERROR
VARB: MOVEM AC0,-1(SX) ;SAVE START FOR PASS 2
HLRZ AC0,0(SX)
ADDM AC0,LOCA
ADDM AC0,LOCO
PUSHJ PP,GETTOP
HRRM SX,VARHDX
JUMP2 POPOUT
PUSHJ PP,LOOKUP ;SET FOR TABLE SCAN
TRZN ARG,VARF
POPJ PP, ;NO, EXIT
TRZ ARG,UNDF ;TURN OFF FLAG NOW
MOVSI AC0,1(V) ;NUMBER TO ADD TO
ADDM AC0,0(AC1) ;UPDATE COUNT
VARA1: ADDI V,1 ;GET LENGTH OF DESIRED BLOCK
ADDM V,LOCO
EXCH V,LOCA
ADDM V,LOCA
HRL ARG,V ;GET STARTING LOCATION AND UPDAT PCS
IOR ARG,MODA ;SET TO ASSEMBLY MODE
MOVSM ARG,0(SX) ;UPDATE 2ND WRD OF SYM TAB ENTRY
JRST HIGHQ1
IF: PUSH PP,AC0 ;SAVE AC0
PUSH PP,IO
PUSHJ PP,EVALXQ ;EVALUATE AND TEST EXTERNAL
POP PP,AC1
IORI ER,(AC1) ;[124] RESTORE PREVIOUS ERROR FLAGS
JUMPL AC1,IFPOP
TLZ IO,FLDSW
IFPOP: POP PP,AC1 ;RETRIEVE SKIP INSTRUCTION
IFSET: TLO IO,IORPTC ;REPEAT CHARACTER
IFXCT: XCT AC1 ;EXECUTE INSTRUCTION
IFXF: TDZA AC0,AC0 ;FALSE
IFXT: MOVEI AC0,1 ;TRUE
IFEXIT: SETZM EXTPNT ;JUST IN CASE
IFN POLISH,<
TLZ IO,RSASSW ;[265] ...
>
JUMPOC IFDO ;[140] BRANCH IF IN OP-CODE FIELD
IFEX1: PUSHJ PP,GETCHR ;SEARCH FOR "<"
CAIN C,EOL ;ERROR IF END OF LINE
JRST ERRAX
CAIE C,'<'
JRST IFEX1
JUMPE AC0,IFEX2 ;TEST FOR 0
TLO IO,IORPTC ;NO, PROCESS AS CELL
PUSHJ PP,CELL
IFN FORMSW,<MOVE AC1,HWFORM ;USE STANDARD FORM>
SETZM INCND ;NOT ANY MORE
JRST STOW ;STOW CODE AND EXIT
IFDO: BYPASS ;[140] GET NEXT NON-3LANK
CAIN C,EOL ;[272] AT EOL?
JRST REPEA1 ;[272] YES, USE OLD METHOD
CAIE C,',' ;[260] ARE WE AT THE COMMA?
CAIN C,'<' ;[260] OR START OF CONDITIONAL?
CAIA ;[260] YES
JRST IFDO ;[260] NOT YET AT COMMA OR ANGLE BRKT
CAIN C,',' ;[260] IGNORE THE COMMA
PUSHJ PP,BYPAS1 ;[140] AND GET SOMETHING ELSE
TLO IO,IORPTC ;[140] REPEAT LAST CHAR.
CAIE C,'<' ;[140] OLD METHOD USED ANGLES
CAIN C,EOL ;[140] ALSO OLD IF NEW LINE SEEN
JRST REPEA1 ;[140] ASSEMBLE CODE BETWEEN ANGLES
JUMPLE AC0,REMAR0 ;[140] FALSE, TREAT AS COMMENT
JRST STMNT ;[140] TRUE, ASSEMBLE IT
IFPASS: HRRI AC0,P1 ;MAKE IT TLNX IO,P1
MOVE AC1,AC0 ;PLACE IT IN AC1
JRST IFSET ;EXECUTE INSTRUCTION
IFB0: HLLO AC1,AC0 ;FORM AND STORE TEST INSTRUCTION
IFB1: PUSHJ PP,CHARL ;GET FIRST NON-BLANK
CAIE C," "
CAIN C," "
JRST IFB1 ;SKIP BLANKS AND TABS
CAIG C,CR ;CHECK FOR CARRET AS DELIM.
CAIGE C,LF
CAIA
JRST ERRAX
FORERR (SX,CND)
SETOM INCND ;SAVE INFO. FOR PASS 1 ERRORS
CAIN C,"<" ;LEFT BRACKET?
SETZB C,RC ;YES, PREPARE FOR OLD FORMAT
SKIPA SX,C ;SAVE FOR COMPARISON
IFB3: TRO AC0,1 ;SET FLAG
IFB2: PUSHJ PP,CHARL ;GET ASCII CHARACTER AND LIST
CAMN C,SX ;TEST FOR DELIMITER
JRST IFXCT ;FOUND
CAIE C," " ;BLANK?
CAIN C," " ;OR TAB?
JRST IFB2 ;YES
JUMPN SX,IFB3 ;JUMP IF NEW FORMAT
CAIN C,"<" ;<?
AOJA RC,IFB2 ;YES, INCREMENT COUNT
CAIN C,">" ;>?
SOJL RC,IFXCT ;YES, DECREMENT AND EXIT IF DONE
JRST IFB3 ;GET NEXT CHARACTER
IFDEF0: HRRI AC0,UNDF ;MAKE IT TLNX ARG,UNDF
PUSH PP,AC0 ;STACK IT
PUSHJ PP,GETSYM ;TAKES SKIP RETURN IF SYM NAME IS LEGAL
TROA ER,ERRA ;ILLEGAL!
PUSHJ PP,SEARCH
JRST [PUSHJ PP,OPTSCH
TLO ARG,UNDF
JRST .+1]
PUSHJ PP,SSRCH3 ;EMIT TO CREF ANYWAY
JRST IFPOP ;POP AND EXECUTE INSTRUCTION
IFIDN0: HLRZS AC0
MOVEI V,2*.IFBLK-1
SETZM IFBLK(V) ;CLEAR COMPARISON BLOCK
SOJGE V,.-1
SETZM .TEMP ;CLEAR STORED DELIMETER
MOVEI RC,IFBLK ;SET FOR FIRST BLOCK
PUSHJ PP,IFCL ;GET FIRST STRING
MOVEI RC,IFBLKA
PUSHJ PP,IFCL ;GET SECOND STRING
MOVEI V,.IFBLK-1
MOVE SX,IFBLK(V) ;GET WORD FROM FIRST STRING
CAMN SX,IFBLKA(V) ;COMPARE WITH SECOND STRING
SOJGE V,.-2 ;EQUAL, TRY NEXT WORD
JUMPL V,IFEXIT ;DID WE FINISH STRING
XORI AC0,1 ;NO, TOGGLE REQUEST
JRST IFEXIT ;DO NOT TURN ON IORPTC WFW
IFCL: PUSHJ PP,CHARAC ;GET AND LIST CHARACTER
CAIE C," " ;SKIP SPACES
CAIG C,CR ;ALSO SKIP CR-LF
CAIGE C,HT ;AND TAB
JRST .+2 ;NOT ONE OF THEM
JRST IFCL ;SO LONG COMPARISONS WILL WORK
;*** A CROCK SO THAT IFIDN <X>,<X>,<INST.> WILL WORK ***
CAIE C,"," ;IS IT A COMMA?
JRST .+3 ;NO
SKIPN .TEMP ;YES, WAS PREVIOUS FIELD OLD METHOD?
JRST IFCL ;YES, IGNORE COMMA AND SPACES
; ***
CAIN C,"<" ;WAS IT LEFT BRACKET?
SETO C, ;SIGNAL OLD METHOD, LOOK FOR RIGHT BRACKET
MOVEM C,.TEMP ;STORE TERMINATOR FOR COMPARISON
MOVEI SX,5*.IFBLK-1 ;LIMIT SEARCH
HRLI RC,(POINT 7,,) ;SET UP BYTE IN RC
IFCLR: PUSHJ PP,CHARAC
SKIPLE .TEMP ;NEW METHOD?
JRST IFCLR1 ;YES, IGNORE ANGLE BRACKET COUNTING
CAIN C,"<" ;ANOTHER LEFT ANGLE?
SOS .TEMP ;YES, KEEP COUNT
CAIN C,">" ;CLOSING ANGLE
AOSGE .TEMP ;MATCHING COUNT?
IFCLR1: CAMN C,.TEMP ;TEST FOR DELIMITER
POPJ PP, ;EXIT ON RIGHT DELIMITER
SOJG SX,.+2 ;ANY ROOM IN COMPARISON BLOCK?
TROA ER,ERRA ;NO, FLAG ERROR BUT KEEP ON GOING
IDPB C,RC ;DEPOSIT BYTE
JRST IFCLR
IFEX2: PUSHJ PP,GETCHR
CAIN C,EOL ;EXIT WITH ERROR IF END OF LINE
JRST ERRAX
CAIN C,34 ;"<"?
AOJA AC0,IFEX2 ;YES, INCREMENT COUNT
CAIE C,36 ;">"?
JRST IFEX2 ;NO, TRY AGAIN
SOJGE AC0,IFEX2 ;YES, TEST FOR MATCH
BYPASS ;YES, MOVE TO NEXT DELIMITER
SETZM INCND ;OUT OF CONDITIONAL NOW
AOJA AC0,STOWZ1 ;STOW ZERO
INTER0: HLLZM AC0,INTENT ;AC0 CONTAINS INTF/ENTF FLAGS
INTER1: PUSHJ PP,GETSYM ;GET A SYMBOL
JRST INTER3 ;INVALID, SKIP
PUSHJ PP,SSRCH ;SEARCH THE TABLE
MOVSI ARG,SYMF!INTF!UNDF
PUSHJ PP,SUPSYM ;[167] SEE IF "!" SEEN
TLNN ARG,UNDF ;ALLOW FORWARD REFERENCE
TLNN ARG,SYNF!EXTF
TDOA ARG,INTENT ;SET APPROPRIATE FLAGS
INTER3: TROA ER,ERRA ;FLAG ARG EROR AND SKIP
PUSHJ PP,INSERQ ;INSERT/UPDATE
JUMPCM INTER1
SETZM EXTPNT ;JUST IN CASE, SO AS NOT TO CONFUSE WORLD
IFN POLISH,<
TLZ IO,RSASSW ;[265] ...
>
POPJ PP, ;NO, EXIT
;.IF SYMBOL ATTRIBUTE
%IF: PUSHJ PP,GETSYM ;[271] GET THE SYMBOL
JRST %IFNUMERIC ;[271] MIGHT WANT THIS ATTRIBUTE
PUSHJ PP,SEARCH ;[271] GENERAL SEARCH
JRST IFXF ;[271] FAILED IF NOT IN TABLE
TLO IO,IORPTC ;[271] GET FIRST CHAR
PUSHJ PP,GETSYM ;[271] GET ATTRIBUTE
JRST ERRAX ;[271] MUST BE A SYMBOL
SETO AC1, ;[271] MASK
IFLOOP: MOVSI AC2,-IFLEN ;[271] AOBJN PTR
MOVE SDEL,IFATAB(AC2);[271] GET NAME
AND SDEL,AC1 ;[271] MASK
CAMN AC0,SDEL ;[271] MATCH
JRST IFOUND ;[271] GOT IT
AOBJN AC2,IFLOOP+1 ;[271] LOOP
JUMPGE AC1,ERRAX ;[271] NOT IN TABLE
TDNN AC0,AC1 ;[271] SET MASK
JRST IFLOOP ;[271] SET
LSH AC1,-6 ;[271] TRY NEXT CHAR
JUMPN AC1,.-3 ;[271] TRY AGAIN
HALT ;[271] ?
IFOUND: XCT IFJTAB(AC2) ;[274]
JRST IFXF ;[271] FALSE
JRST IFXT ;[271] TRUE
DEFINE IFATRIB <
XX SYMBOL,<TLNN ARG,SYMF>
XX SYNONYM,<TLNN ARG,SYNF>
XX MACRO,<TLNN ARG,MACF>
XX OPDEF,<TLNN ARG,OPDF>
XX EXTERNAL
XX ENTRY,<TLNN ARG,ENTF>
XX INTERNAL
XX GLOBAL
XX LOCAL
XX LABEL,<TLNN ARG,TAGF>
XX ASSIGNMENT
XX ABSOLUTE,<TLNE ARG,LELF!RELF>
XX RELOCATABLE,<TLNN ARG,LELF!RELF>
XX LRELOCATABLE,<TLNN ARG,LELF>
XX RRELOCATABLE,<TLNN ARG,RELF>
XX NUMERIC,JFCL
>
DEFINE XX (A,B)<
<SIXBIT /A/>
>
IFATAB: IFATRIB
IFLEN==.-IFATAB
DEFINE XX (A,B)<
IFB <B>,<
PUSHJ PP,%IF'A
>
IFNB <B>,<
B
>>
IFJTAB: IFATRIB
%IFEXTERNAL:
TLNE ARG,EXTF ;[271] ENTERNAL?
AOS (PP) ;[271] YES
POPJ PP,
%IFINTERNAL:
TLNN ARG,EXTF!SPTR ;[271] EXTERN?
AOS (PP)
POPJ PP,
%IFGLOBAL:
TLNE ARG,EXTF!INTF!ENTF
AOS (PP)
POPJ PP,
%IFLOCAL:
TLNN ARG,EXTF!SPTR
AOS (PP)
POPJ PP,
%IFASSIGNMENT:
TLNE ARG,SYMF
TLNE ARG,TAGF
POPJ PP,
JRST CPOPJ1
%IFNUMERIC:
TLNE IO,NUMSW ;[271] MUST BE NUMERIC
PUSHJ PP,GETSYM ;[271] GET ATTRIBUTE
JRST ERRAX ;[271] ERROR
SETO AC1, ;[271] MASK
TDNN AC0,AC1 ;[271] SET IT UP
JRST .+3 ;[271] DONE
LSH AC1,-6
JRST .-3 ;[271] TRY AGAIN
MOVE SDEL,['NUMERI'] ;[271] ONLY VALID ONE
AND SDEL,AC1 ;[271] MASK OUT ONES WE DON'T CARE ABOUT
CAMN AC0,SDEL ;[271] MATCH?
AOS (PP) ;[271] TRUE
POPJ PP,
;ASSIGN PSEUDO-OP FOR TENEX
;ASSIGN SYM1,SYM2,INCR
ASGN: PUSHJ PP,COUTD ;DUMP BUFFER
PUSH PP,BLKTYP ;SAVE BLOCK TYPE
MOVEI AC0,100 ;ASSIGN BLOCK TYPE
MOVEM AC0,BLKTYP
PUSHJ PP,GETSYM ;HERE TO ASGN6 COPIED FROM EXTERN
JRST ASGN2
TLO IO,DEFCRS ;FLAG AS DEFINITION
PUSHJ PP,SSRCH
JRST ASGN1
TLNN ARG,EXTF!VARF!UNDF
JRST ASGN2
TLNE ARG,EXTF
JRST [JUMP1 ASGN6
TLZN ARG,UNDF
JRST ASGN6
ANDM ARG,(SX)
JRST ASGN1]
ASGN1: MOVEI V,2
ADDB V,FREE
CAML V,SYMBOL
PUSHJ PP,XCEEDS
SUBI V,2
SETZB RC,0(V)
MOVSI ARG,SYMF!EXTF
PUSHJ PP,INSERT
MOVSI ARG,PNTF
IORM ARG,0(SX)
MOVE AC0,-1(SX)
MOVEM AC0,1(V)
ASGN6: MOVE AC0,-1(SX)
SETZ ARG,
PUSHJ PP,SQOZE ;CONVERT TO SQUOZE
PUSHJ PP,COUT ;OUTPUT FIRST SYMBOL
JUMPNC ASGN2 ;MUST BE COMMA HERE
PUSHJ PP,GETSYM ;SECOND SYMBOL
JRST ASGN2
MOVEI SDEL,%SYM ;OUTPUT TO CREF
PUSHJ PP,CREF
SETZ ARG,
PUSHJ PP,SQOZE ;CONVERT TO SQUOZE
PUSHJ PP,COUT
JUMPNC ASGN3 ;COMMA?
PUSHJ PP,EVALXQ ;YES, EVALUATE INCREMENT
ASGN4: PUSHJ PP,COUT
JUMP1 ASGN7 ;DON'T OUTPUT IF PASS1
PUSHJ PP,COUTD ;OUTPUT 3 WORDS
ASGN5: POP PP,BLKTYP ;RESTORE BLOCK TYPE
POPJ PP,
ASGN3: MOVEI AC0,1 ;INCREMENT IS 1 IF NOT SPECIFIED
JRST ASGN4
ASGN2: TRO ER,ERRE ;INDICATE
ASGN7: PUSHJ PP,COUTI ;CLEAR OUTPUT BUFFER
JRST ASGN5
EXTER0: PUSHJ PP,GETSYM ;GET A SYMBOL
JRST EXTER4 ;INVALID, ERROR
EXTER1: TLO IO,DEFCRS ;FLAG THIS AS A DEFINITION
EXTER5: PUSHJ PP,SSRCH ;[267] OK, SEARCH SYMBOL TABLE
JRST EXTER2 ;NOT THERE, INSERT IT
TLNN ARG,EXTF!VARF!UNDF
TROA ER,ERRE ;FLAG ERROR AND BYPASS
TLNE ARG,EXTF ;VALID, ALREADY DEFINED?
JRST [JUMP1 EXTER3 ;YES, BYPASS
TLZN ARG,UNDF ;SKIP IF UNDEFINED ALSO
JRST EXTER3 ;CONTINUE
ANDM ARG,(SX) ;CLEAR UNDF ON PASS 2
JRST EXTER2] ;SET UP EXTERNAL NOW
EXTER2: MOVEI V,2 ;NO, GET 2 CELLS FROM THE TREE
ADDB V,FREE
CAML V,SYMBOL ;HAVE WE RUN OUT OF CORE?
PUSHJ PP,XCEEDS ;YES, TRY TO BORROW SOME MORE
SUBI V,2 ;GET RIGHT CELL FOR POINTER
SETZB RC,0(V) ;ALL SET, ZERO VALUES
MOVSI ARG,SYMF!EXTF
PUSHJ PP,SUPSYM ;[167] SEE IF "!" SEEN
PUSHJ PP,INSERT ;INSERT/UPDATE IT
MOVSI ARG,PNTF
IORM ARG,0(SX)
SKIPA ARG,-1(SX) ;GET THE SIXBIT FOR THE NAME
EXTER4: TROA ER,ERRA ;FLAG AS ERROR
MOVEM ARG,1(V) ;AND STORE IT FOR ADDITIVE GLOBAL FIXUPS
EXTER3: PUSHJ PP,SUPSYM ;[167] SEE IF "!" SEEN
JUMPCM EXTER0
POPJ PP, ;NO, EXIT
EVAL10: PUSH PP,RX
HRRI RX,^D10
PUSHJ PP,EVALEX ;EVALUATE
POP PP,RX ;RESET RADIX
JUMPE RC,POPOUT ;EXIT IF ABSOLUTE
QEXT:
IFN POLISH,<
TLNE FR,POLSW ;[164] ANY POLISH EXTERNAL EXPRESSIONS
JRST QPOL ;[164] YES, REMOVE AND FLAG ERROR
>
SKIPE EXTPNT ;ANY POSSIBILITIES?
TROA ER,ERRE ;YES, FLAG EXTERNAL ERROR
TRO ER,ERRR ;NO, FLAG RELOCATION ERROR
HLLZS RC ;CLEAR RELOCATION/EXTERNAL
POPJ PP,
IFN POLISH,<
QPOL: TRO ER,ERRE ;[164] FLAG EXTERNAL ERROR
PUSH PP,AC1 ;[164] GET AN AC
MOVE AC1,POLIST ;[164] GET LAST ITEM IN LIST
MOVEM AC1,FREE ;[164] RESET FREE CORE POINTER
MOVE AC1,(AC1) ;[164] GET PREVIOUS ITEM
MOVEM AC1,POLIST ;[164] MAKE IT TOP OF LIST
POP PP,AC1 ;[164]
POPJ PP, ;[164]
>
EVALXQ: PUSH PP,IO ;[222] SAVE ERROR STATUS
TRZ ER,-1 ;[222] START AFRESH
PUSHJ PP,EVALQ ;[222] EVALUATE EXPRESSION
TRNE ER,ERRU ;[222] TEST FOR UNDEF
TRO ER,ERRV ;[222] FLAG "V" ERROR
HLLM IO,(PP) ;[222] STORE STATUS FLAGS
IORM ER,(PP) ;[222] COMPOUND ERRORS
POP PP,IO ;[222] RESTORE THEM
POPJ PP, ;[222]
EVALQ: PUSHJ PP,EVALEX ;EVALUATE EXPRESSION
TDZE RC,[-2,,-2] ;WAS AN EXTERNAL FOUND?
TRO ER,ERRE ;YES, FLAG ERROR
POPJ PP, ;RETURN
OPDEF0: PUSHJ PP,GETSYM ;GET THE FIRST SYMBOL
POPJ PP, ;ERROR IF INVALID SYMBOL
CAIE C,73 ;"["?
JRST ERRAX ;NO, ERROR
PUSH PP,AC0 ;STACK MNEMONIC
AOS LITLVL ;SHORT OUT LOCATION INCREMENT
PUSHJ PP,STMNT ;EVALUATE STATEMENT
SKIPGE STPX ;CODE STORED?
TROA ER,ERRA ;NO,"A" ERROR
PUSHJ PP,DSTOW ;GET AND DECODE VALUE
SOS LITLVL
EXCH AC0,0(PP) ;EXCHANGE VALUE FOR MNEMONIC
PUSH PP,RC ;STACK RELOCATION
TLO IO,DEFCRS ;SAY WE ARE DEFINING IT
PUSHJ PP,MSRCH ;SEARCH SYMBOL TABLE
MOVSI ARG,OPDF ;NOT FOUND
POP PP,RC ;RESTORE VALUES
POP PP,V
TLNE ARG,SYNF!MACF
TRO ER,ERRA ;YES "A" ERROR
TRNN ER,ERRA ;ERROR?
PUSHJ PP,INSERT ;NO, INSERT/UPDATE
PUSHJ PP,ASSIG7 ;[135] LIST VALUE LIKE =
TLZ IO,DEFCRS ;JUST IN CASE
BYPASS
JRST STOWI ;BE SURE STOW IS RESET
DEPHA0: MOVE AC0,LOCO
SKIPA RC,MODO ;SET TO OUTPUT VALUES AND SKIP
PHASE0: PUSHJ PP,EVALXQ ;EVALUATE AND CHECK FOR EXTERNAL
MOVEM AC0,LOCA ;SET ASSEMBLY LOCATION COUNTER
MOVEM RC,MODA
JRST BLOCK2
ASSIGN: JUMPAD ERRAX ;NO, ERROR
PUSHJ PP,ASSIG1
TLNE IO,IOSALL ;SUPPRESS ALL?
JUMPN MRP,CPOPJ ;IF IN MACRO
ASSIG7: MOVEM RC,ASGBLK
TRNE RC,-2 ;EXTERNAL
HLLZS ASGBLK ;YES,CLEAR RELOCATION
TLNE RC,1 ;LEFT HALF NOT RELOC?
TLNE RC,-2 ;...
HRROS ASGBLK ;YES, SET FLAG
MOVEM V,LOCBLK
POPJ PP,
ASSIG1: PUSH PP,AC0 ;SAVE SYMBOL
MOVEM AC0,INASGN ;[164] INCASE POLISH FIXUP REQUIRED
SETZB AC0,EXTPNT ;SPECIAL CHECK FOR == WFW
ASSIG4: PUSHJ PP,PEEK ;IS THE NEXT ON =
CAIE C,"="
CAIN C,"!"
CAIA ;[406]WANT TO SUPRESS SYMBOL
JRST ASSIG5 ;[406]NOT "=" OR "!",SO SEE IF COLON
TLOE AC0,NOOUTF ;[406]TURN ON "NO-OUTPUT" FLAG
TRO ER,ERRQ ;[406]IF ALREADY ON, GIVE ERROR
PUSHJ PP,GETCHR ;PROCESS THE CHAR.
PUSHJ PP,PEEK ;CHECK FOR ==: DMN
ASSIG5: CAIE C,":" ;IS IT
JRST ASSIG6 ;NO
TLOE AC0,INTF ;[406]FLAG AS INTERNAL
TRO ER,ERRQ ;[406]IF ALREADY ON, ITS AN ERROR
PUSHJ PP,GETCHR ;REPEAT IT
JRST ASSIG4 ;TRY AGAIN (MIGHT BE =:!)
ASSIG6: MOVEM AC0,HDAS ;STORE THESE BITS WFW
PUSHJ PP,EVALCM ;EVALUATE EXPRESSION
SETZM INASGN ;[164] FINISHED WITH POLISH BY NOW
EXCH AC0,0(PP) ;SWAP VALUE FOR SYMBOL
PUSH PP,RC
TRNN RC,-2 ;CHECK EXTERNAL AGREEMENT
JRST ASSIG2
HRRZS RC
HRRZ ARG,EXTPNT
CAME RC,ARG
PUSHJ PP,QEXT ;EXTERNAL OR RELOCATION ERROR
ASSIG2: HLRZ RC,(PP)
TRNN RC,-2
JRST ASSIG3
HLRZ ARG,EXTPNT
CAME RC,ARG
PUSHJ PP,QEXT
ASSIG3: TLO IO,DEFCRS
PUSH PP,UNISCH+1 ;SAVE SEARCH LIST
SETZM UNISCH+1 ;BUT DISALLOW
PUSHJ PP,SSRCH
MOVSI ARG,SYMF
POP PP,UNISCH+1 ;RESTORE STATUS
IOR ARG,HDAS ;WFW
TLNE ARG,UNDF ;WAS IT UNDEFINED
TLZ ARG,EXTF!PNTF ;YES,CLEAR EXTF NOW
TLZ ARG,UNDF!VARF ;CANCEL UNDEFINED AND VARIABLE FLAGS
SETZM EXTPNT ;FOR REST OF WORLD
IFN POLISH,<
TLZ IO,RSASSW ;[265] ...
>
POP PP,RC
TRNE ER,ERRORS-ERRQ
SETZ RC, ;CLEAR RELOCATION
POP PP,V
TRNE ER,ERRU ;WAS VALUE UNDEFINED?
TLO ARG,UNDF ;YES,SO TURN UNDF ON
TLNE ARG,TAGF!EXTF
JRST ERRAX
JRST INSERT
;LOC, RELOC, AND ORG COME HERE
%ORG: PUSH PP,AC0 ;SAVE TYPE
PUSHJ PP,HIGHQ ;GET LATEST PC
BYPASS ;SKIP BLANKS
TLO IO,IORPTC ;REPEAT LAST
CAIN C,EOL ;USE PREVIOUS VALUE IF NULL ARGUMENT
JRST ORG03
PUSHJ PP,EVALXQ ;GET EXPRESSION AND TEST EXTERNAL
SKIPGE (PP) ;ORG?
HRLM RC,(PP) ;YES, SAVE RELOC OF ARG
ORG01: HRRM AC0,(PP) ;STORE NEW VALUE
IFE POLISH,<
HLRZ AC1,(PP) ;GET MODE
HRRZ AC0,LOCO ;PC OF OUTPUT
CAMN AC1,MODO ;MODE SAME?
JRST [MOVEM AC0,@REL1P(AC1) ;SAVE NEW VALUE
JRST ORG02]
MOVEM AC0,@ABS1P(AC1) ;SAVE NEW VALUE
ORG02: MOVE AC0,MODO ;SAVE OLD MODE
MOVEM AC0,ORGMOD
>
IFN POLISH,<
HRRZ AC0,LOCO ;PC OF OUTPUT
MOVE AC1,MODO ;OLD MODE
MOVEM AC0,@REL1P(AC1) ;SAVE OLD VALUE
MOVE AC0,MODO ;SAVE OLD MODE
MOVEM AC0,ORGMOD
MOVE AC1,SGNCUR ;CURRENT PSECT INDEX
MOVE AC0,HIGH ;SAVE PSECT BREAK
HRRM AC0,SGATTR(AC1)
HRR AC0,RELLOC ;SAVE PSECT REL PC
HRL AC0,ORGMOD ;SAVE PSECT MODE
MOVEM AC0,SGRELC(AC1)
>
POP PP,AC0 ;GET RESULT
ORG2A: HLRZM AC0,MODA ;SET MODES
HLRZM AC0,MODO
HRRZM AC0,LOCA ;AND LOCATIONS
HRRZM AC0,LOCO
JRST BLOCK2
ORG03: HRRZ AC0,ORGMOD ;GET PREV MODE
SKIPGE (PP) ;ORG?
HRLM AC0,(PP) ;YES, SAVE IT
HLRZ AC1,(PP) ;NEW MODE
MOVE AC0,@REL1P(AC1) ;GET PREV VALUE
JRST ORG01
REL1P: EXP ABSLOC
ABS1P: EXP RELLOC
EXP ABSLOC
; .PSECT NAME /ATTRIB,ORIGIN
IFN POLISH,<
%SEGME: SKIPN HISNSW ;CAN'T HAVE PSECTS WITH
SKIPE UNIVSN ; HISEG, TWOSEG OR
JRST ERRSX ; UNIVERSAL
MOVE AC2,SGDMAX ;CHECK IF MAX PSECT
CAILE AC2,SGNDEP-1 ; NESTING DEPTH EXCEEDED
JRST ERRSX ;YES
PUSHJ PP,GETSYM ;GET PSECT NAME
PUSHJ PP,[SETZ AC0, ;NONE SPECIFIED, BLANK NAME
TRZ ER,ERRA ;UNDO GETSYM'S ERR FLAG
POPJ PP,]
MOVE AC1,SGNMAX ;GET PSECT COUNT
%SEGM1: CAMN AC0,SGNAME(AC1) ;SEEN THIS NAME BEFORE?
JRST %SEGM2 ;YES
SOJGE AC1,%SEGM1 ;LOOP THRU KNOWN NAMES
MOVE AC1,SGNMAX ;CHECK IF MAX DISTINCT PSECT
CAILE AC1,SGNSGS-1 ; LIMIT EXCEEDED
JRST ERRSX ;YES
AOS AC1,SGNMAX ;INCR PSECT COUNT
MOVEM AC0,SGNAME(AC1) ;STORE PSECT NAME
MOVSI AC2,1 ;SET MODE TO RELOC
MOVEM AC2,SGRELC(AC1) ; AND PC TO ZERO
HRRZS SGORIG ;INCASE NOT GIVEN
%SEGM4: MOVE SDEL,SYMBOL ;ROOM TO INIT
SUBI SDEL,LENGTH ; SYM TAB
CAMLE SDEL,FREE ; FOR NEW PSECT?
JRST %SEGM3 ;YES
PUSHJ PP,XCEEDS ;TRY FOR MORE CORE
JRST %SEGM4 ;START OVER
%SEGM3: MOVEM SDEL,SYMBOL ;NEW SYM TAB BOT
HRLI SDEL,LENGTH(SDEL) ;OLD SYM TAB BOT
MOVE SX,SYMTOP ;SYM TAB TOP
BLT SDEL,-LENGTH(SX) ;MOVE SYM TAB DOWN
HRLI SDEL,SYMNUM+1 ;PTR TO PERM SYM TAB
HRRI SDEL,1-LENGTH(SX) ;PERM SYMS GO HERE
BLT SDEL,0(SX) ;MOVE PERM SYMS TO NEW PSECT
MOVE AC2,SYMNUM ;PERM SYM CNT
MOVEM AC2,SGSCNT(AC1) ;SET SYM CNT
SETZM SGATTR(AC1) ;ZERO PSECT BRK AND ATTRS
ADDM AC2,@SYMBOL ;ADJUST TOTAL SYM CNT
%SEGM2: AOS AC2,SGDMAX ;INCR PSECT DEPTH
MOVEM AC0,SGLIST(AC2) ;STORE PSECT NAME
%SEGM5: CAIE C,'/' ;ATTRIBUTES SPECIFIED?
JRST %SEGM9 ;NO, TRY VALUE
PUSH PP,AC1 ;SAVE PSECT INX
PUSHJ PP,GETSYM ;GET ATTRIBUTE
JRST %SEGM8 ;TOO BAD
; THE BELOW ATTRIBUTES ARE PAIRED; A CONFLICT IS
; FLAGGED IF BOTH OF ANY PAIR ARE SEEN (CUMMULATIVELY)
MOVE AC1,AC0 ;ATRIB NAME
SETO AC2, ;MASK
LSH AC1,6 ;SHIFT UP 1 CHAR AT A TIME
LSH AC2,6 ;SAME FOR MASK
JUMPN AC1,.-2 ;UNTIL CHAR ALL GONE, MASK LEFT
MOVSI AC1,-%SGTLN ;AOBJN WORD
%SEGM6: CAMN AC0,%SGTBL(AC1) ;ATTRIBUTE FOUND?
JRST %SEGM7 ;YES, PROCESS IT
XOR AC0,%SGTBL(AC1) ;BUT SEE IF WHAT WE HAVE MATCHES
TDNN AC0,AC2 ;TRUE IF MASKED BITS ARE 0
JRST %SEGM7 ;YES, IT MATCHES
XOR AC0,%SGTBL(AC1) ;PUT NAME BACK
AOBJN AC1,%SEGM6 ;NO, CHECK NEXT
SETZ AC2, ;CLEAR ATTR FLAG
TRO ER,ERRQ ;FLAG WARNING
%SEGM7: MOVEI AC2,1 ;SET ATRIB BIT
LSH AC2,-1(AC1) ; IN AC2
MOVE AC1,0(PP) ;GET PSECT INX
HLRZ AC0,SGATTR(AC1) ;GET PREV ATTRS
ANDI AC0,525252 ;SELECT LEFT OPTIONS
LSH AC0,-1 ;SHIFT THEM RIGHT
AND AC0,AC2 ;COMPARE NEW AND PREVIOUS
JUMPE AC0,.+3 ;CONFLICTING ATTRIBUTE?
TRO ER,ERRQ ;YES, FLAG WARNING
SETZ AC2, ; AND IGNORE IT
HLRZ AC0,SGATTR(AC1) ;GET PREV ATTRS
ANDI AC0,252525 ;SELECT RIGHT OPTIONS
LSH AC0,1 ;SHIFT THEM LEFT
AND AC0,AC2 ;COMPARE NEW AND PREVIOUS
JUMPE AC0,.+3 ;CONFLICTING ATTRIBUTE?
TRO ER,ERRQ ;YES, FLAG WARNING
SETZ AC2, ; AND IGNORE IT
HRLZS AC2 ;MOVE TO LEFT HALF
IORM AC2,SGATTR(AC1) ;MERGE ATTRIBUTES
%SEGM8: POP PP,AC1 ;RESTORE PSECT INX
JUMPCM %SEGM5 ;LOOP IF MORE ATTRS
JRST %SWSEG ;SWAP PC AND MODE
%SEGM9: JUMPNC %SWSEG ;NO VALUE
PUSH PP,AC1 ;SAVE INDEX
PUSHJ PP,EVALCM ;GET IT
POP PP,AC1 ;RESTORE INDEX
HRRM AC0,SGORIG(AC1) ;STORE IT
JRST %SWSEG ;SWAP PC AND MODE
%SGTBL: <SIXBIT /CONCATENATED/>
<SIXBIT /OVERLAID/>
<SIXBIT /RWRITE/>
<SIXBIT /RONLY/>
%SGTLN==.-%SGTBL
%ENDSE: SKIPN HISNSW ;CAN'T HAVE PSECTS WITH
SKIPE UNIVSN ; HISEG, TWOSEG OR
JRST ERRSX ; UNIVERSAL
MOVE AC2,SGDMAX ;IF DEPTH IS ALREADY ZERO
JUMPE AC2,ERRSX ; THEN .ENDPS IS ILLEGAL
PUSHJ PP,GETSYM ;GET PSECT NAME
JRST %ENDS1 ;NONE SPECIFIED, IGNORE CHECK
CAME AC0,SGLIST(AC2) ;DOES IT MATCH CORRES .PSECT NAME
TRO ER,ERRQ ;NO, FLAG WARN AND DO IT ANYWAY
%ENDS1: TRZ ER,ERRA ;UNDO GETSYM'S ERR FLAG
SOS AC2,SGDMAX ;DECR PSECT DEPTH
MOVE AC0,SGLIST(AC2) ;NAME OF PSECT TO RESUME
MOVE AC1,SGNMAX ;GET PSECT COUNT
CAME AC0,SGNAME(AC1) ;NAME MATCH?
SOJGE AC1,.-1 ;NO, TRY NEXT
;HERE TO SWAP TO NEW PSECT
;ENTER WITH OLD PSECR IN SGNCUR
;NEW PSECT IN AC1
%SWSEG: PUSH PP,AC1 ;SAVE NEW PSECT INX
MOVE AC2,SGNCUR ;GET OLD PSECT INX
HLRZ SDEL,SGORIG(AC2) ;ALREADY SETUP LIT/VAR BLOCK
JUMPN SDEL,%SWSG1 ;YES
MOVEI SDEL,.SGLVL+1 ;NO
ADDB SDEL,FREE ;TRY TO GET IT
CAML SDEL,SYMBOL ;WILL IT FIT?
PUSHJ PP,XCEED ;NO, XPAND
SUBI SDEL,.SGLVL+1 ;GET ORIGIN
HRLM SDEL,SGORIG(AC2) ;NOW STORE IT
%SWSG1: MOVSI AC0,.SGLVZ ;START OF LIT/VAR AREA
HRRI AC0,1(SDEL) ;SAVE AREA
BLT AC0,.SGLVL(SDEL);STORE IT
MOVE AC0,LITLVL ;GET LITLVL
MOVEM AC0,(SDEL) ;STORE IT
HLLZ AC0,SGORIG(AC1) ;RESTORE NEW LIT/VAR
JUMPE AC0,[MOVE AC0,[.SGLVZ,,.SGLVZ+1] ;NOT YET SETUP
SETZM .SGLVZ ;CLEAR FIRST WORD
BLT AC0,.SGLVZ+.SGLVL ;PLUS REST
MOVEI AC0,VARHD ;SET UP AREA
MOVEM AC0,VARHDX
MOVEI AC0,LITHD
MOVEM AC0,LITHDX
SETZM LITLVL
PUSHJ PP,LITI
JRST %SWSG2] ;JOIN COMMON CODE
AOBJP AC0,.+1 ;BYPASS FIRST WORD
HRRI AC0,.SGLVZ ;TO LIT/VAR AREA
BLT AC0,.SGLVZ+.SGLVL-1
HLRZ SDEL,SGORIG(AC1) ;POINTER TO LIT INFO
MOVE AC0,(SDEL) ;GET LITLVL
MOVEM AC0,LITLVL ;WE ARE NOW IN
PUSHJ PP,HIGHQ ;SET CURRENT PROG BRK
%SWSG2: MOVE AC0,SGRELC(AC1) ;GET OLD MODE AND PC
PUSH PP,AC0 ;SAVE SAME
HLRZ RC,AC0 ;GET OLD MODE
SKIPN RC ;IF ABS MODE
MOVE AC0,ABSLOC ; THEN GET ABS PC
HRRM AC0,(PP) ;STORE NEW VALUE
HRRZ AC0,LOCO ;PC OF OUTPUT
MOVE AC1,MODO ;OLD MODE
MOVEM AC0,@REL1P(AC1) ;SAVE OLD VALUE
MOVE AC0,MODO ;SAVE OLD MODE
MOVEM AC0,ORGMOD
MOVE AC1,SGNCUR ;CURRENT PSECT INDEX
MOVE AC0,HIGH ;SAVE PSECT BREAK
HRRM AC0,SGATTR(AC1)
HRR AC0,RELLOC ;SAVE PSECT REL PC
HRL AC0,ORGMOD ;SAVE PSECT MODE
MOVEM AC0,SGRELC(AC1)
MOVE AC0,-1(PP) ;GET NEW PSECT INX
MOVEM AC0,SGNCUR ;SET SGNCUR TO IT
JUMP1 .+2 ;IF PASS 2 THEN
PUSHJ PP,SGOUTN ; OUTPUT PSECT NAME BLOCK
POP PP,AC0 ;GET RESULT
HLRZM AC0,MODA ;SET MODES
HLRZM AC0,MODO
HRRZM AC0,LOCA ;AND LOCATIONS
HRRZM AC0,LOCO
POP PP,SGNCUR ;STORE NEW PSECT INX
MOVE AC1,SGNCUR ;NEW PSECT INX
HRRZ AC0,SGATTR(AC1) ;GET PSECT BRK
MOVEM AC0,HIGH ;RESTORE IT
PUSHJ PP,SRCHI ;SET UP SRCHX
POPJ PP, ;DONE
ERRSX: TRO ER,ERRS ;FLAG PSECT USAGE ERROR
POPJ PP, ;DONE
>
HISEG1:
IFN POLISH,<
SKIPE SGNMAX ;IF PSECTS USED THEN CAN'T USE
JRST ERRSX ; HISEG OR TWOSEG
>
PUSHJ PP,HIGHQ ;SET CURRENT PROGRAM BREAK
PUSHJ PP,COUTD ;DUMP CURRENT TYPE OF BLOCK
SKIPN HISNSW ;IF WE HAVE SEEN IT BEFORE
SKIPE HIGH ;OR ANY RELOC CODE PUT OUT
TRO ER,ERRQ ;FLAG AS AN ERROR
BYPASS ;GO GET EXPRESSION
TLO IO,IORPTC
PUSHJ PP,EVALXQ ;CHECK FOR EXTERNAL
ANDCMI AC0,1777 ;ONLY ALLOWED TO START ON NEW K BOUND
HRRZM AC0,LOCA ;SET LOC COUNTERS
HRRZM AC0,LOCO
MOVEI RC,1 ;ASSUME RELOCATABLE
POPJ PP,
TWSEG0: PUSHJ PP,HISEG1 ;COMMON CODE
JUMPN AC0,.+2 ;ARGUMENT SEEN
MOVEI AC0,400000 ;ASSUME 400000
HRRZM AC0,HMIN ;SET OFSET OF HIGH SEG.
HRRZM AC0,HHIGH ;INCASE NO HISEG CODE
TLOA AC0,(1B0) ;SIGNAL TWO SEGMENTS AND SKIP
HISEG0: PUSHJ PP,HISEG1 ;COMMON CODE
HISEG2: MOVEM AC0,SVTYP3 ;SAVE THE HISEG ARG
MOVEM RC,MODA ;SET MODES
MOVEM RC,MODO
SETOM HISNSW ;WE HAVE ALREADY PUT ONE OUT
JRST BLOCK2 ;MAKE LISTING HAPPEN RIGHT
IFN FORMSW,<
ONFORM: HRRES HWFMT ;ALLOW MULTI-FORMAT LISTING
POPJ PP,
OFFORM: HRROS HWFMT ;HALF-WORD FORMAT ONLY
POPJ PP, >
IFE FORMSW,<
SYN CPOPJ,ONFORM
SYN CPOPJ,OFFORM>
HIGHQ:
HIGHQ1: MOVE V,LOCO ;GET ASSEMBLY LOCATION
SKIPN MODO ;IF ASSEMBLY MODE IS ABSOLUTE
JRST [CAMLE V,ABSHI ;RECORED ABS HIGHEST ALSO
MOVEM V,ABSHI
POPJ PP,]
SKIPE HMIN ;IS IT A TWO SEGMENT PROGRAM?
JRST [CAMGE V,HMIN ;YES,IS THIS HIGH SEG.?
JRST .+1 ;NO,STORE LOW SEGMENT
CAMLE V,HHIGH ;YES,IS IT GREATER THAN "HHIGH"?
MOVEM V,HHIGH ;YES,REPLACE WITH LARGER VALUE
POPJ PP,]
CAMLE V,HIGH ;IS IT GREATER THAN "HIGH"?
MOVEM V,HIGH ;YES, REPLACE WITH LARGER VALUE
POPJ PP,
ONML: TLZA FR,MWLFLG ;MULTI-WORD LITERALS OK
OFFML: TLO FR,MWLFLG ;NO
POPJ PP,
OFFSYM: SETOM IONSYM ;SUPRESS SYMBOL TABLE LISTING
POPJ PP,
SUPRE0: PUSHJ PP,GETSYM ;GET A SYMBOL TO SUPRES
JRST SUPRE1 ;ERROR
PUSHJ PP,SSRCH ;SYMBOL ONLY
JRST SUPRE1 ;GIVE ERROR MESSAGE
PUSHJ PP,SUPSYM ;[167] SEE IF "!" SEEN
TLOA ARG,SUPRBT ;SET THE SUPRESS BIT
SUPRE1: TROA ER,ERRA
IORM ARG,(SX) ;PUT BACK
JUMPCM SUPRE0 ;ANY MORE?
JRST SUPRS1
SUPRSA: PUSHJ PP,LOOKUP ;SUPRESS ALL
MOVSI ARG,SUPRBT
IORM ARG,(SX)
SUPRS1: SETZM EXTPNT ;JUST IN CASE WE LOOKED ONE UP
IFN POLISH,<
TLZ IO,RSASSW ;[265] ...
>
POPJ PP,
XPUNG0: JUMP1 POPOUT
PUSHJ PP,LOOKUP
MOVE ARG,(SX) ;GET SYMBOL FLAGS
TLNN ARG,INTF!ENTF!EXTF!SPTR
TLOA ARG,SUPRBT ;LOCAL SYMBOL,SO SUPPRESS IT
SETZM EXTPNT
IFN POLISH,<
TLZ IO,RSASSW ;[265] ...
>
MOVEM ARG,(SX) ;RESTORE FLAGS
POPJ PP,
NODDT0: PUSHJ PP,GETSYM ;GET A SYMBOL TO SUPRES
JRST NODDT1 ;ERROR
PUSHJ PP,SSRCH ;SYMBOL ONLY
JRST NODDT1 ;GIVE ERROR MESSAGE
PUSHJ PP,SUPSYM ;SEE IF "!" SEEN
TLOA ARG,NOOUTF ;SET THE NO-DDT BIT
NODDT1: TROA ER,ERRA
IORM ARG,(SX) ;PUT BACK
JUMPCM NODDT0 ;ANY MORE?
JRST SUPRS1
SUPSYM: CAIE C,'!' ;[404][167] WANT NO DDT OUTPUT FOR THIS SYMBOL?
POPJ PP, ;[167] NO
TLO ARG,NOOUTF ;[167] YES, SET FLAG
PJRST BYPAS1 ;[167] SKIP "!" AND RETURN
;[220] .CREF SYMBOL,SYMBOL,ETC
ONCRF: PUSHJ PP,GETSYM ;SEE IF A SYMBOL SPECIFIED
JRST [MOVSI AC0,IONCRF ;NO, PUT FLAG BACK
TRZ ER,ERRA ;CLEAR "A" ERROR
TLZ IO,DEFCRS ;CLEAR ANY WAITING DEFINING OCCURENCES
JRST IORSET]
ONCRF0: PUSHJ PP,SEARCH ;[365] GENERAL SEARCH
JRST ONCRFE ;[365] ERROR
MOVSI ARG,NCRF ;[365] NO CREF FLAG IN ARG
ANDCAM ARG,(SX) ;[365] TURN OFF NO CREF BIT
CAMN AC0,1(SX) ;[365] OTHER ENTRY IN SYMBOL TABLE?
ANDCAM ARG,2(SX) ;[365] TURN OFF NCRF
CAMN AC0,-3(SX) ;[365] OTHER ENTRY IN SYMBOL TABLE?
ANDCAM ARG,-2(SX) ;[365] TURN OFF NCRF
CAIA ;[365]
ONCRFE: TRO ER,ERRA ;[365] SET ERROR CONDITION
JUMPNC SUPRS1 ;GIVE UP IF NO MORE
PUSHJ PP,GETSYM ;GET NEXT SYMBOL
JRST ONCRFE ;ERROR
JRST ONCRF0
;[220] .XCREF SYMBOL,SYMBOL,ETC
OFFCRF: PUSHJ PP,GETSYM ;SEE IF A SYMBOL SPECIFIED
JRST [MOVSI AC0,IONCRF ;PUT FLAG BACK
TRZ ER,ERRA ;CLEAR "A" ERROR
JRST IOSET]
OFCRF0: PUSHJ PP,SEARCH ;[365] GENERAL SEARCH
JRST OFCRFE ;[365] ERROR
MOVSI ARG,NCRF ;[365] NO CREF FLAG IN ARG
IORM ARG,(SX) ;[365] SET NO CREF BIT
CAMN AC0,1(SX) ;[365] OTHER ENTRY IN SYMBOL TABLE?
IORM ARG,2(SX) ;[365] SET BIT
CAMN AC0,-3(SX) ;[365] OTHER ENTRY IN SYMBOL TABLE?
IORM ARG,-2(SX) ;[365] SET BIT
CAIA ;[365]
OFCRFE: TRO ER,ERRA ;[365] FLAG ERROR
JUMPNC SUPRS1 ;GIVE UP IF NO MORE SYMBOLS
PUSHJ PP,GETSYM ;GET NEXT SYMBOL
JRST OFCRFE ;ERROR
JRST OFCRF0
TITLE0: JUMP2 REMAR0
SKIPE TBUF+1 ;IS THIS THE FIRST TITLE?
JRST [TRO ER,ERRM ;NO, FLAG AS ERROR
JRST REMAR0] ;AND IGNORE
MOVEI SX,.TBUF
HRRI AC0,TBUF
PUSHJ PP,SUBTT1 ;GO READ IT
MOVEM SX,TCNT ;SAVE COUNT OF CHARS. WRITTEN
SKIPE UNIVSN ;WAS IT A UNIVERSAL?
PUSHJ PP,ADDUNV ;YES ADD TO TABLE
SKIPN TBUF+1 ;2ND WORD NON-ZERO SIGNALS TITLE SEEN
AOS TBUF+1 ;MAKE IT SO
IFN CCLSW,<JRST PRNAM ;PRINT NAME IF FIRST ONE>
IFE CCLSW,<POPJ PP, ;EXIT OTHERWISE>
SUBTT0: SKIPE SBUF ;STORE FIRST SUBTTL ON PASS1
JUMP1 REMAR0 ;OTHERWISE EXIT IF PASS ONE
MOVEI SX,.SBUF
HRRI AC0,SBUF
SUBTT1: BYPASS ;BYPASS LEADING BLANKS
TLO IO,IORPTC
SUBTT3: PUSHJ PP,CHARAC ;GET ASCII CHARACTER
IDPB C,AC0 ;STORE IN BLOCK
CAIGE C,40 ;TEST FOR TERMINATOR
CAIN C,HT
SOJG SX,SUBTT3 ;TEST FOR BUFFER FULL
DPB RC,AC0 ;END, STORE TERMINATOR
SOJA SX,REMAR1 ;COUNT NULL AND EAT UP ANY REMAINING CHARS.
IFN CCLSW,<
PRNAM: TLNN IO,CRPGSW ;NOT IF NOT RPG
POPJ PP,
PUSH PP,AC0 ;SAVE AC0 DMN
PUSH PP,RC ;AND RC
MOVE AC0,[POINT 7,TBUF]
MOVE SX,[POINT 7,OTBUF]
MOVEI RC,6 ;MAX OF SIX CHRS
MOVEI C,HT ;START WITH A TAB
IDPB C,SX
PN1: ILDB C,AC0
CAILE C," " ;CHECK FOR LEGAL
CAILE C,"Z"+40 ;CHECK AGAINST LOWER CASE Z
JRST PN2
IDPB C,SX ;PUT IN OUTPUT BUFFER
SOJG RC,PN1 ;GET MORE
PN2: MOVEI C,CR ;END WITH CR-LF
IDPB C,SX
MOVEI C,LF
IDPB C,SX
SETZ C, ;TERMINATOR
IDPB C,SX
TTCALL 3,OTBUF
POP PP,RC
POP PP,AC0 ;RESTORE AC0 DMN
POPJ PP,
>
SYN0: PUSHJ PP,GETSYM ;GET THE FIRST SYMBOL
JRST ERRAX ;ERROR, EXIT
PUSHJ PP,MSRCH ;TRY FOR MACRO/OPDEF
JRST SYN3 ;NO, TRY FOR OPERAND
SYN1: MOVEI SX,MSRCH ;YES, SET FLAG
SYN2: JUMPNC ERRAX ;[173] ERROR IF NO COMMA
PUSH PP,ARG ;[173] SAVE SOME REGISTERS
PUSH PP,RC ;[173]
PUSH PP,V ;[173]
PUSH PP,SX ;[173] SAVE SEARCH ROUTINE
PUSHJ PP,GETSYM ;[173] GET THE SECOND SYMBOL
JRST [SUB PP,[4,,4] ;[173] PUT STACK BACK
POPJ PP,] ;[173] AND GIVE UP
POP PP,SX ;[173] RESTORE SEARCH ROUTINE
PUSHJ PP,@SX ;[173] SEARCH FOR SECOND SYMBOL
JFCL ;[173]
POP PP,V ;[173] RESTORE VALUES
POP PP,RC ;[173]
POP PP,ARG ;[173]
TLNE ARG,MACF ;MACRO?
PUSHJ PP,REFINC ;YES, INCREMENT REFERENCE
JRST INSERT ;INSERT AND EXIT
SYN3: PUSHJ PP,SSRCH ;SEARCH FOR OPERAND
JRST SYN4 ;NOT FOUND, TRY OP CODE
TLO ARG,SYNF ;FLAG AS SYNONYM
TLNE ARG,EXTF ;EXTERNAL?
HRRZ V,ARG ;YES, RELPACE WITH POINTER
MOVEI SX,SSRCH ;SET FLAG
TLNN ARG,VARF ;DO NOT LET HIM SYN A VARIABLE
JRST SYN2
JRST ERRAX
SYN4: PUSHJ PP,OPTSCH ;SEARCH FOR OP-CODE
JRST ERRAX ;NOT FOUND, EXIT WITH ERROR
MOVSI ARG,SYNF ;FLAG AS SYNONYM
JRST SYN1
PURGE0: PUSHJ PP,GETSYM ;GET A MNEMONIC
JRST [TRZ ER,ERRA ;CLEAR ERROR
POPJ PP,] ;AND RETURN
PUSHJ PP,MSRCH ;SEARCH MACRO SYMBOL TABLE
JRST PURGE2 ;NOT FOUND, TRY SYMBOLS
PUSH PP,CS ;SAVE CS AS IT MAY GET GARBAGED
TLNE ARG,MACF ;MACRO?
PUSHJ PP,REFDEC ;YES, DECREMENT THE REFERENCE
POP PP,CS
JRST PURGE4 ;REMOVE SYMBOL FROM TABLE
PURGE2: PUSHJ PP,SSRCH ;TRY OPERAND SYMBOL TABLE
JRST PURGE5 ;NOT FOUND GET NEXT SYMBOL
TDNE RC,[-2,,-2] ;CHECK COMPLEX EXTERNAL
TLNE ARG,SYNF
JRST .+2
JRST PURGE3
TLNE ARG,EXTF!UNDF ;ERROR IF EXTERNAL OR UNDEFINED
TLNE ARG,SYNF ;BUT NOT A SYNONYM
JRST PURGE4
PURGE3: TROA ER,ERRA ;NOT FOUND, ERROR
PURGE4: PUSHJ PP,REMOVE ;REMOVE FROM THE SYMBOL TABLE
PURGE5: JUMPCM PURGE0
POPJ PP, ;EXIT
OPD1: TLNE ARG,UNDF ;IF OPDEF IS UNDEFINED
TRO ER,ERRO ;GIVE "O" ERROR
OPD: MOVE AC0,V ;PUT VALUE IN AC0
JRST OP
IOP: MOVSI AC2,(POINT 9,0(PP),11)
IFE FORMSW,< TLOA IO,IOIOPF ;SET "IOP SEEN" AND SKIP>
IFN FORMSW,< PUSH PP,IOFORM ;USE I/O FORM
JUMPAD .+2 ;[344] IF IN ADDRESS FIELD, DON'T CHANGE IOSEEN
SETOM IOSEEN ;[116] SIGNAL FOR BOUT TO ADJUST FIELDS
TLO IO,IOIOPF ;SET "IOP" SEEN
JRST OP+2>
OP: MOVSI AC2,(POINT 4,0(PP),12)
IFN FORMSW,< PUSH PP,INFORM ;USE INST. FORM>
PUSH PP,RC
PUSH PP,AC0 ;STACK CODE
PUSH PP,AC2
PUSHJ PP,EVALEX ;EVALUATE FIRST EXPRESSION
POP PP,AC2
JUMPNC OP2
OP1B: PUSHJ PP,GETCHR ;GET A CHARACTER
IFE FORMSW,<JUMPCM XWD5 ;PROCESS COMMA COMMA IN XWD>
IFN FORMSW,<JUMPNC .+4 ;JUMP IF NO COMMA
MOVE AC2,HWFORM ;GET FORM WORD FOR XWD
MOVEM AC2,-2(PP) ;REPLACE INSTRUCTION FORM
JRST XWD5 ;PROCESS COMMA COMMA IN XWD>
TLO IO,IORPTC ;NOT A COMMA,REPEAT IT
LDB AC1,AC2
ADD AC1,AC0
DPB AC1,AC2
IFN POLISH,<
TLNN FR,POLSW ;[164] DON'T ALLOW EXTERNAL ACS
>
JUMPE RC,OP1A ;EXTERNAL OR RELOCATABLE?
PUSHJ PP,QEXT ;YES, DETERMINE WHICH AND FLAG AN ERROR
OP1A: PUSHJ PP,EVALEX ;GET ADDRESS PART
OP2: PUSHJ PP,EVADR ;EVALUATE STANDARD ADDRESS
OP3: POP PP,AC0 ;PUT IN AC0
POP PP,RC
IFN FORMSW,< POP PP,AC1 ;GET FORM WORD>
SKIPE (PP) ;CAME FROM EVALCM?
JRST STOW ;NO,STOW CODE AND EXIT
POP PP,AC1 ;YES,EXIT IMMEDIATELY
POPJ PP,
EVADR: ;EVALUATE STANDARD ADDRESS
IFE IIISW,<TLNN AC0,-1 ;OK IF ALL 0'S
JRST .+4 ;IT WAS
TLC AC0,-1 ;CHANGE ALL ONES TO ZEROS
TLCE AC0,-1 ;OK IF ALL 1'S
TRO ER,ERRQ ;NO,FLAG Q ERROR>
ADD AC0,-1(PP) ;ADD ADDRESS PORTIONS
HLL AC0,-1(PP) ;GET LEFT HALF
TLZE FR,INDSW ;INDIRECT BIT?
TLO AC0,(Z @) ;YES, PUT IT IN
MOVEM AC0,-1(PP) ;RE-STACK CODE
ADD RC,-2(PP) ;UPDATE RELOCATION
HRRM RC,-2(PP) ;USE HALF WORD ADD
CAIE C,10 ;"("?
POPJ PP, ;NO, EXIT
MOVSS EXTPNT ;WFW
PUSHJ PP,EVALCM ;EVALUATE
MOVSS EXTPNT ;WFW
MOVSS V,AC0 ;SWAP HALVES
IFE IIISW,<MOVSS SX,RC
IOR SX,V ;MERGE RELOCATION
TRNN SX,-1 ;RIGHT HALF ZERO?
JRST OP2A ;YES, DO SIMPLE ADD
MOVE ARG,RC ;NO, SWAP RC INTO ARG>
IFN IIISW,<MOVSS ARG,RC>
ADD V,-1(PP) ;ADD RIGHT HALVES
ADD ARG,-2(PP)
HRRM V,-1(PP) ;UPDATE WITHOUT CARRY
HRRM ARG,-2(PP)
HLLZS AC0 ;PREPARE LEFT HALVES
HLLZS RC
IFE IIISW,<TLNE SX,-1 ;IS LEFT HALF ZERO?
TRO ER,ERRQ ;NO FLAG FORMAT ERROR
OP2A: TLNE RC,-1 ;RELOCATION FOR LEFT HALF?
PUSHJ PP,OP2A1 ;YES,IS IT LEGAL?
TLNE AC0,777000 ;OP CODE FIELD USED?
JRST [EXCH AC0,-1(PP) ;YES, GET STORED CODE
TLNE AC0,777000 ;OP CODE FIELD BEEN SET?
TRO ER,ERRQ ;YES, MOST LIKELY AN ERROR
EXCH AC0,-1(PP)
JRST .+1] ;RETURN TO ADD >
ADDM AC0,-1(PP) ;MERGE WITH PREVIOUS VALUE
ADDM RC,-2(PP)
CAIE C,11 ;")"?
JRST ERRAX ;NO, FLAG ERROR
;YES, BYPASS PARENTHESIS
BYPAS1: PUSHJ PP,GETCHR
BYPAS2: JUMPE C,.-1 ;SKIP TRAILING BLANKS
POPJ PP, ;EXIT
IFE IIISW,<
OP2A1: EXCH RC,-2(PP) ;GET STORED CODE
TLNN RC,-1 ;OK IF ALL ZERO
JRST OP2A2 ;OK SO RETURN
TLC RC,-1 ;CHANGE ALL ONES TO ZEROS
TLCE RC,-1 ;OK IF ALL ONES
TRO ER,ERRQ ;OTHERWISE A "Q" ERROR
OP2A2: EXCH RC,-2(PP) ;GET RC,BACK
POPJ PP, ;AND RETURN>
EXPRES: HRLZ AC0,RX ;FUDGE FOR OCT0
OCT0: PUSH PP,RX
HLR RX,AC0
IFN POLISH,<
MOVNI AC0,3 ;[164] PRESET POLISH TYPE SINCE WE
MOVEM AC0,POLTYP ;[164] NEED FULL WORD FIXUPS IF POLISH
>
OCT1: PUSHJ PP,EVALEX ;EVALUATE
IFN POLISH,<
TDNE RC,[-2,,-2] ;[164] TEST FOR EXTERNAL
PUSHJ PP,OCTFW ;[164] YES, NEEDS FULL WORD FIXUP
>
IFN FORMSW,< MOVE AC1,HWFORM>
PUSHJ PP,STOW ;STOW CODE
JUMPCM OCT1
POP PP,RX ;YES, RESTORE RADIX
IFN POLISH,<
SETZM POLTYP ;[164] CLEAR FLAG
>
POPJ PP, ;EXIT
IFN POLISH,<
;HERE TO GENERATE FULL WORD FIXUPS FOR EXP EXTERN
;NOTE THIS GENERATES BLOCK TYPE 11 POLISH FIXUPS
;THESE CANNOT BE LOADER BY LOADER UNLESS FAILSW IS ON
OCTFW: MOVE PV,FREE ;[164] COPY CODE FROM POLPOP
EXCH PV,POLIST ;[164] TO SET UP A NEW BLOCK
PUSHJ PP,POLSTR ;[164] STORE POINTER TO LAST
MOVE PV,EXTPNT ;[164] GET POINTER TO EXTERNAL SYMBOL
PUSHJ PP,POLFS2 ;[164] STORE EXTERNAL
JRST POLOCT ;[164] AND FIXUP ADDRESS, AND RETURN
>
SIXB10: MOVSI RC,(POINT 6,AC0) ;SET UP POINTER
MOVEI AC0,0 ;CLEAR WORD
SIXB20: PUSHJ PP,CHARL ;GET NEXT CHARACTER
CAMN C,SX ;IS THIS PRESET DELIMITER?
IFE FORMSW,< JRST ASC60 ;YES>
IFN FORMSW,<
JRST [PUSHJ PP,BYPAS1
ANDCM RC,STPX
MOVE AC1,SXFORM
SETZM INTXT ;[320] NO LONGER IN TEXT
JUMPGE RC,STOWZ
POPJ PP,]>
CAIL C,"A"+40
CAILE C,"Z"+40
JRST .+2
TRZA C,100 ;CONVERT LOWER CASE TO SIXBIT
SUBI C,40 ;CONVERT TO SIXBIT
JUMPL C,ASC55 ;TEST FOR INVALID CHARACTER
IDPB C,RC ;NO, DEPOSIT THE BYTE
TLNE RC,770000 ;IS THE WORD FULL?
JRST SIXB20 ;NO, GET NEXT CHARACTER
IFN FORMSW,< MOVE AC1,SXFORM ;SIXBIT FORM>
PUSHJ PP,STOWZ ;YES, STORE
JRST SIXB10 ;GET NEXT WORD
%TEXT1: TLC AC0,240000 ;[232] CONVERT .TEXT TO COMMENT ON PASS1
ASCII0: HLLZ SDEL,AC0 ;STORE ASCII/ASCIZ FLAG
ASC10: PUSHJ PP,CHARL ;GET FIRST NON-BLANK
CAIE C," "
CAIN C,HT
JRST ASC10
CAIG C,CR ;CHECK FOR CRRET AS DELIM
CAIGE C,LF
CAIA
JRST ERRAX
FORERR (SX,TXT)
SETOM INTXT
MOVE SX,C ;SAVE FOR COMPARISON
JUMPG SDEL,SIXB10 ;BRANCH IF SIXBIT
ASC20: MOVSI RC,(POINT 7,AC0) ;SET UP POINTER
TLNE SDEL,200000 ;THIS BIT (AND BIT0) IN FOR COMMENT
MOVSI RC,440000 ;SO NOTHING WILL BE DEPOSITED
IFE IIISW,<MOVEI AC0,0 ;CLEAR WORD>
IFN IIISW,<TLNE SDEL,100000 ;ASCID?
TLZA SDEL,400000 ;YES, ZERO ASCIZ BIT
TDZA AC0,AC0 ;NO, ZERO WORD
MOVE AC0,[BYTE (7) 10,10,10,10,10 (1) 1] ;YES, A WORD FULL OF BACKSPACES>
ASC30: PUSHJ PP,CHARL ;GET ASCII CHARACTER AND LIST
CAMN C,SX ;TEST FOR DELIMITER
JRST ASC50 ;FOUND
IDPB C,RC ;DEPOSIT BYTE
TLNE RC,760000 ;HAVE WE FINISHED WORD?
JRST ASC30 ;NO,GET NEXT CHARACTER
IFN FORMSW,< MOVE AC1,ASCIIF ;USE ASCII FORM WORD>
TLNE SDEL,040000 ;.TEXT ?
JRST [PUSHJ PP,STOTXT ;YES, STORE IN REL FILE
JRST ASC20] ;CONTINUE
PUSHJ PP,STOWZ ;YES, STOW IT
JRST ASC20 ;GET NEXT WORD
ASC55: TDZA CS,CS ;ZERO CS IN CASE NESTED
ASC50: TDZA RC,SDEL ;TEST FOR ASCIIZ
TROA ER,ERRA ;SIXBIT ERROR EXIT
ASC60: PUSHJ PP,BYPAS1 ;POLISH OFF TERMINATOR
SETZM INTXT ;WE ARE OUT OF IT
IFN FORMSW,< MOVE AC1,ASCIIF ;USE ASCII FORM WORD>
IFN IIISW,<TLNN SDEL,100000 ;NO EXTRA WORDS FOR ASCID>
ANDCM RC,STPX ;STORE AT LEAST ONE WORD
TLNN SDEL,200000 ;GET OUT WITHOUT STORING
JUMPGE RC,[TLNN SDEL,040000 ;.TEXT?
JRST STOWZ ;NO, STOW
JRST STOTXT] ;YES, STORE IN REL FILE
POPJ PP, ;ASCII, NO BYTES STORED, SO EXIT
;[232] .TEXT PSEUDO-OP
%TEXT0: JUMP1 %TEXT1 ;IGNORE ON PASS1
PUSH PP,BLKTYP ;SAVE CURRENT TYPE
PUSHJ PP,COUTD ;[370] DUMP CURRENT BLOCK
HLLZ SDEL,AC0 ;[370] FLAG BITS FOR ASCII
SETZM BLKTYP ;DON'T KNOW IT YET
PUSHJ PP,ASC10 ;START PROCESSING
PUSHJ PP,STOTXD ;FINISH BLOCK
POP PP,BLKTYP ;RESTORE PREVIOUS
POPJ PP,
STOTXT: SKIPN BLKTYP ;FIRST WORD?
JRST [MOVEM AC0,BLKTYP
POPJ PP,] ;SAVE AS BLOCK TYPE
SKIPN COUTRB ;2ND WORD
JRST [MOVEM AC0,COUTRB
POPJ PP,]
AOS C,COUTX ;NO, JUST STORE AS NORMAL
MOVEM AC0,COUTDB(C)
CAIE C,^D17 ;BUFFER FULL?
POPJ PP, ;NO
STOTXD: SKIPN C,BLKTYP ;[331] SEE IF ANY TEXT TO OUTPUT
JRST COUTI ;[331] NO JUST CLEAR COUNTS
AOS COUTX ;[331] ACCOUNT FOR STARTING FROM -1
SETZM BLKTYP ;[331] CLEAR BLOCKTYPE WORD FOR NEXT BLOCK
TRNN C,177_1 ;[331] SEE IF RELOCATION WORD IS NEEDED
AOS COUTRB ;[331] FIRST WORD OF BLOCK WAS NOT FULL,
;[331] 2ND WAS 0, PUT THE LSN BIT ON FOR
;[331] COUTD2 TO CHECK SO THERE WON'T BE
;[331] AN EXTRA 0 WORD IN THE FILE
JRST COUTT ;DUMP BLOCK
POINT0:
IFN FORMSW,< PUSH PP,BPFORM ;USE BYTE POINTER FORM WORD>
PUSH PP,RC ;STACK REGISTERS
PUSH PP,AC0
PUSHJ PP,EVAL10 ;EVALUATE RADIX 10
DPB AC0,[POINT 6,0(PP),11] ;STORE BYTE SIZE
JUMPNC POINT2
IFN POLISH,<
SETOM POLTYP ;[164] FORCE RIGHT-HALF FIXUP IF POLISH
>
PUSHJ PP,EVALEX ;NO, GET ADDRESS
PUSHJ PP,EVADR ;EVALUATE STANDARD ADDRESS
IFN POLISH,<
SETZM POLTYP ;[164] BACK TO NORMAL
>
JUMPNC POINT2
PUSHJ PP,EVAL10 ;EVALUATE RADIX 10
TLNE IO,NUMSW ;IF NUMERIC
TDCA AC0,[-1] ;POSITION=D35-RHB
POINT2: MOVEI AC0,0 ;OTHERWISE SET TO D36
ADDI AC0,^D36
LSH AC0,^D30
ADDM AC0,0(PP) ;UPDATE VALUE
JRST OP3
XWD0:
IFN FORMSW,< PUSH PP,HWFORM ;USE HALF WORD FORM>
PUSH PP,RC
PUSH PP,AC0 ;STORE ZERO ON STACK
PUSHJ PP,EVALEX ;EVALUATE EXPRESSION
JUMPNC OP2
XWD5: SKIPN (PP) ;ANY CODE YET?
JRST XWD10 ;NO,USE VALUE IN AC0
JUMPE AC0,.+2 ;ANYTHING IN AC0?
TRO ER,ERRQ ;YES,FLAG "Q"ERROR
MOVE AC0,(PP) ;USE PREVIOUS VALUE
MOVE RC,-1(PP) ;AND RELOCATION
XWD10: TLNN AC0,-1 ;[143] LEFT HALF SHOULD BE ZERO
JRST XWD11 ;[143] IT IS
TLC AC0,-1 ;[143] OR AT LEST ALL ONES
TLCE AC0,-1 ;[143] FOR XWD -1,-2 ETC
TRO ER,ERRQ ;[143] NO, WARN USER
XWD11: HRLZM AC0,0(PP) ;SET LEFT HALF
HRLZM RC,-1(PP)
MOVSS EXTPNT ;WFW
JRST OP1A ;EXIT THROUGH OP
IOWD0: PUSHJ PP,EVALQ ;[222] EVALUATE AND TEST FOR EXTERNAL
CAIE C,14 ;","?
JRST [SKIPN AC0 ;IF NZERO AND NO "," SEEN
TRO ER,ERRQ ;TREAT AS Q ERROR
IFN FORMSW,< MOVE AC1,HWFORM ;USE HALF WORD FORM>
SOJA AC0,STOW] ;NO, TREAT AS RIGHT HALF
PUSH PP,AC0 ;YES, STACK LEFT HALF
PUSHJ PP,EVALEX ;WFW
SUBI AC0,1
POP PP,AC1 ;RETRIEVE LEFT HALF
MOVNS AC1
HRL AC0,AC1
IFN FORMSW,< MOVE AC1,HWFORM ;USE HALF WORD FORM>
JRST STOW ;STOW CODE AND EXIT
BYTE0: PUSHJ PP,BYPAS1 ;GET FIRST NON-BLANK
CAIE C,10 ;"("?
JRST ERRAX ;NO, FLAG ERROR AND EXIT
IFN FORMSW,<
PUSH PP,[1]
MOVEI AC0,0
>
PUSH PP,RC
PUSH PP,AC0 ;INITIALIZE STACK TO ZERO
MOVSI ARG,(POINT -1,(PP))
BYTE1: PUSH PP,ARG
PUSHJ PP,EVAL10 ;EVALUATE RADIX 10
POP PP,ARG
CAIG AC0,^D36 ;TEST SIZE
JUMPGE AC0,.+2
TRO ER,ERRA
DPB AC0,[POINT 6,ARG,11] ;STORE BYTE SIZE
BYTE2: IBP ARG ;INCREMENT BYTE
TRZN ARG,-1 ;OVERFLOW?
JRST BYTE3 ;NO
SETZB AC0,RC ;YES
EXCH AC0,0(PP) ;GET CURRENT VALUES
EXCH RC,-1(PP) ;AND STACK ZEROS
IFN FORMSW,<
MOVE AC1,HWFORM ;USE STANDARD FORM
EXCH AC1,-2(PP) ;GET FORM WORD
>
PUSHJ PP,STOW ;STOW FULL WORD
BYTE3: PUSH PP,ARG
PUSHJ PP,EVALEX ;COMPUTE NEXT BYTE
POP PP,ARG
DPB AC0,ARG ;STORE BYTE
HLLO AC0,ARG
DPB RC,AC0 ;STORE RELOCATION
IFN FORMSW,<
MOVEI AC0,1
HRRI ARG,-2
DPB AC0,ARG ;STORE FORM BYTE
HRRI ARG,0
>
JUMPCM BYTE2
CAIN C,10 ;"("?
JRST BYTE1 ;YES, GET NEW BYTE SIZE
JRST OP3 ;NO, EXIT
RADX50: PUSHJ PP,EVALEX ;EVALUATE CODE
JUMPN RC,ERRAX ;ERROR IF NOT ABSOLUTE
JUMPNC ERRAX
TDZE AC0,[EXP ^-74] ;[322] MAKE SURE ONLY 74 BITS ON
TRO ER,ERRQ ;[322] NOPE, LIGHT Q ERROR
PUSH PP,AC0 ;[160] SAVE CODE BITS
PUSHJ PP,GETSYM ;YES, GET SYMBOL
TRZ ER,ERRA ;CLEAR ERROR
POP PP,ARG ;[160] PUT CODE INTO ARG
PUSHJ PP,SQOZE ;SQUOZE SIXBIT AND ADD CODE
IFN FORMSW,< MOVE AC1,HWFORM ;USE STANDARD FORM>
JRST STOW ;STOW CODE AND EXIT
SQOZE: MOVE AC1+1,AC0 ;PUT SIXBIT IN AC1+1
MOVEI AC0,0 ;CLEAR RESULT
SQOZ1: MOVEI AC1,0
LSHC AC1,6 ;PUT 6-BIT CHARACTER IN AC1
LDB AC1,[POINT 6,CSTAT(AC1),23] ;CONVERT TO RADIX50
IMULI AC0,50 ;MULTIPLY PREVIOUS RESULT
ADD AC0,AC1 ;ADD NEW CHARACTER
JUMPN AC1+1,SQOZ1 ;TEST FOR END
LSH ARG,^D30 ;LEFT-JUSTIFY CODE
IOR AC0,ARG ;MERGE WITH RESULT
POPJ PP,
; .LINK PSEUDO OP. FORM IS
;
; .LINK LNKNO, LNKLOC, LNKNXT
;
;WHERE LNKNO IS THE LINK NUMBER, LNKLOC IS THE LOCATION INTO WHICH
;LINK SHOULD STORE THE CURRENT VALUE OF THE LINK POINTER, AND
;LNKNXT IS AN OPTIONAL ARGUMENT WHICH LINK WILL ACCEPT AS THE
;NEW VALUE OF THE LINK POINTER (IF LNKNXT ABSENT THEN LNKLOC IS
;THE NEW POINTER VALUE).
%LINK: PUSH PP,BLKTYP ;SAVE BLOCK TYPE
PUSH PP,AC0
JUMP1 LINK1 ;SKIP CODE GEN IF P1
PUSHJ PP,COUTD
MOVEI AC0,12 ;LINK TYPE
MOVEM AC0,BLKTYP
LINK1: PUSHJ PP,EVALEX ;EVAL CHECK EXT
POP PP,AC1 ;GET BITS BACK
JUMPN RC,LNKERR ;MUST BE ABS
JUMPNC LNKERR ;GRNTEE COMMA
TLNE AC1,400000 ;LNKEND?
MOVN AC0,AC0 ;YES, NEGATE RESULT
JUMP1 LINK2 ;SKIP IF P1
PUSHJ PP,COUT
LINK2: PUSHJ PP,EVALXQ ;NO EXTERNALS
JUMPNC LINK2A ;[423] THIRD ARGUMENT SPECIFIED?
HRL AC0,RC ;[423] YES - MUST FIRST SAVE THE
PUSH PP,AC0 ;[423] OLD VALUES OF RC, AC0
PUSHJ PP,EVALXQ ;[423] READ IN THIRD ARGUMENT
MOVS AC0,AC0 ;[423] LINK EXPECTS LNKNXT IN THE
MOVS RC,RC ;[423] LEFT HALF OF SECOND WORD
HRR AC0,(PP) ;[423] RESTORE LNKLOC VALUE
HLR RC,(PP) ;[423] AND ITS RELOCATION BIT
TLNE RC,1 ;[423] LNKNXT RELOCATABLE???
TRO RC,2 ;[423] YES - SET FOR COUT TO DEPOSIT
SUB PP,[1,,1] ;[423] "POP" BOGUS WORD OFF STACK
LINK2A: JUMP1 LINK3
PUSHJ PP,COUT ;DUMP LOC
PUSHJ PP,COUTD ;FINISH BLOCK
LINK3: POP PP,BLKTYP ;RESTORE BLKTYP
POPJ PP,
LNKERR: POP PP,BLKTYP ;RESTORE BLOCK TYPE
PJRST ERRAX ;GIVE ERROR RETURN
%INTEG: PUSHJ PP,GETSYM ;GET A SYMBOL
JRST INTG2 ;BAD SYMBOL ERROR
TLO IO,DEFCRS ;THIS IS A DEFINTION
PUSHJ PP,SSRCH ;SEE IF THERE
MOVSI ARG,SYMF!UNDF ;SET SYMBOL AND UNDEFINED IF NOT
TLNN ARG,UNDF ;IF ALREADY DEFINED
JRST INTG1 ;JUST IGNORE
TLOA ARG,VARF ;SET VARIABLE FLAG
INTG2: TROA ER,ERRA ;SYMBOL ERROR
PUSHJ PP,INSERZ ;PUT IN WITH ZERO VALUE (LENGTH OF 1)
INTG1: JUMPCM %INTEG
POPJ PP,
%ARAY: MOVEM PP,ARAYP ;SAVE PUSHDOW POINTER
ARAY2: PUSHJ PP,GETSYM
JRST ARAY1 ;BAD SYMBOL GIVE ERROR AND ABORT
PUSH PP,AC0 ;SAVE NAME
JUMPCM ARAY2 ;AND GO ON IF A COMMA
CAIE C,"["-40 ;MUST BE A [
JRST ARAY1
BYPASS ;OH, WELL
TLO IO,IORPTC
PUSHJ PP,EVALXQ ;GET A SIZE
CAIE C,"]"-40 ;MUST END RIGHT
JRST ARAY1
BYPASS ;??
HRRZ V,AC0 ;GET VALUE
SUBI V,1
NXTVAL: POP PP,AC0
PUSH PP,V ;SAVE OVER SEARCH
TLO IO,DEFCRS
PUSHJ PP,SSRCH ;FIND IT
MOVSI ARG,SYMF!UNDF
POP PP,V ;GET VALUE BACK
TLNN ARG,UNDF
JRST ARAY3
TLO ARG,VARF
MOVEI RC,0 ;NO RELOC
PUSHJ PP,INSERT
ARAY3: CAME PP,ARAYP
JRST NXTVAL ;STILL NAMES STACKED
JUMPCM ARAY2
POPJ PP,
ARAY1: TRO ER,ERRA ;ERROR EXIT
MOVE PP,ARAYP
POPJ PP, ;RESET PDL AND GO
;[121] .COMMON SYMBOL [SIZE]
SYN ARAYP,COMMP ;SAVE SPACE
COMM0: JUMP1 COMM1 ;WASTE OF TIME ON PASS1
PUSHJ PP,COUTD ;DUMP CURRENT BLOCK
PUSH PP,BLKTYP ;SAVE TYPE
MOVEI AC0,20 ;COMMON BLOCK TYPE
MOVEM AC0,BLKTYP ;SET NEW
COMM1: MOVEM PP,COMMP ;SAVE PUSHDOWN POINTER
COMM2: PUSHJ PP,GETSYM ;GET A 6-BIT SYMBOL NAME
JRST COMM7 ;BAD SYMBOL, GIVE UP
PUSH PP,AC0 ;SAVE SYMBOL NAME
JUMPCM COMM2 ;AND GET ANOTHER IF COMMA
CAIE C,'[' ;MUST BE A [
JRST COMM7 ;YOU LOSE
BYPASS ;SKIP ANY LEADING SPACES
TLO IO,IORPTC ;BUT NOT LAST CHAR
PUSHJ PP,EVALXQ ;GET SIZE OF COMMON
CAIE C,']' ;MUST END RIGHT
JRST COMM7
HRRZ V,AC0 ;GET VALUE
;PUSHDOWN STACK IS IN WRONG ORDER, REVERSE IT
HRRZ RC,PP ;TOP ITEM
HRRZ ARG,COMMP ;BOTTOM ITEM
ADDI ARG,1 ;WELL ALMOST
COMM6: CAIG RC,(ARG) ;ANYTHING TO MOVE?
JRST COMM3 ;NO
MOVE 0,(RC) ;MOVE TOP
EXCH 0,(ARG) ;TO BOTTOM
MOVEM 0,(RC)
SUBI RC,1 ;DECREMENT
AOJA ARG,COMM6 ;AND TRY AGAIN
COMM3: JUMP1 [MOVE AC0,0(PP) ;[430] GET SYMBOL
PUSHJ PP,SEARCH ;[430] PERFORM GENERAL SEARCH
JRST COMM3A ;[430] NOT FOUND, GOOD
JUMPL ARG,CMNERR ;[430] FOUND, OPERAND, WARN
CAME AC0,-3(SX) ;[430] MACRO, LOOK ONE SLOT BELOW
JRST COMM3A ;[430] NOT FOUND, CONTINUE
JRST CMNERR ;[430] WARNING
]
COMM3A: POP PP,AC0 ;GET SYMBOL OFF STACK
JUMP1 .+2 ;IGNORE V ON PASS 1
PUSH PP,V ;SAVE VALUE
PUSHJ PP,EXTER1 ;DEFINE AS EXTERNAL
;NOTE, CS IS NOT ON A COMMA, SO WILL RETURN
JUMP1 COMM4 ;ALL DONE IF PASS1
SETZ RC, ;NO RELOCATION
MOVEI ARG,4 ;FORM RADIX50 04,SYMBOL
PUSHJ PP,SQOZE ;IN AC0
PUSHJ PP,COUT ;OUTPUT SYMBOL
POP PP,V ;GET VALUE BACK
MOVE AC0,V ;AND INTO AC0
PUSHJ PP,COUT ;SECOND PART OF PAIR
COMM4: CAME PP,COMMP ;FINISHED WITH STACKED SYMBOLS
JRST COMM3 ;NO MORE TO GO
BYPASS ;GET NEXT DELIMITER
JUMPCM COMM2 ;MORE TO GO IF COMMA NEXT
COMM5: JUMP1 CPOPJ
PUSHJ PP,COUTD ;DUMP THIS BLOCK
POP PP,BLKTYP ;RESTORE LAST
POPJ PP,
COMM7: TRO ER,ERRA ;FLAG ERROR
MOVE PP,COMMP ;RESET PUSHDOWN POINTER
JRST COMM5 ;RESTORE BLKTYP AND EXIT
CMNERR: PUSHJ PP,EWARN ;[430] WARNING
MOVSI RC,[SIXBIT /SOC STATEMENT OUT OF ORDER .COMMON@/] ;[430] SYMBOL IN AC0
PUSHJ PP,TYPMSG ;[430]
AOS QERRS ;[430] COUNT AS WARNING
JRST COMM3A ;[430] CONTINUE
;[122] .REQUEST DEV:FILENAME[PPN]
REQUIR: SKIPA CS,[16] ;BLOCK TYPE 16
REQUES: MOVEI CS,17 ;BLOCK TYPE 17
JUMP1 REMAR0 ;IGNORE ON PASS 1
PUSHJ PP,COUTD ;DUMP CURRENT
PUSH PP,BLKTYP ;SAVE LAST BLOCK TYPE
MOVEM CS,BLKTYP ;SET NEW
REQU0:
REPEAT 3,<PUSH PP,[0]> ;STACK A NULL SPEC INCASE OF ERROR
BYPASS ;[345] FLUSH EXTRA TABS AND SPACES
TLO IO,IORPTC ;[350]BACK OFF BECAUSE SCHGET
;[350]WILL TRY TO GET THIS CHARACTER
PUSHJ PP,SCHGET ;[335] GET PART OF A FILE SPEC
JUMPE AC0,REQUER ;[335] ERROR IF NOTHING
CAIE C,':' ;WAS THERE A DEVICE
JRST REQU1 ;NO, GOOD GUESS
MOVEM AC0,-2(PP) ;SAVE DEVICE
PUSHJ PP,SCHGET ;[335] GET THE FILE NAME
JUMPE AC0,REQUER ;[335] ERROR IF NOTHING
REQU1: MOVEM AC0,(PP) ;STORE FILE NAME
CAIN C,'.' ;[335] SEE IF AN EXTENSION GIVEN
JRST REQU4 ;[335] YES, GO SKIP IT AND MAKE SURE IT'S
REQU3: ;[335] A .REL FILE, CAUSE THAT'S ALL IT CAN BE
CAIE C,'[' ;WAS THERE A PPN
JRST REQU2 ;NO, AS EXPECTED
BYPASS ;SKIP ANY BLANKS
TLO IO,IORPTC
PUSHJ PP,EVALXQ ;GET HALF A PPN
HRLM AC0,-1(PP) ;STORE IT
PUSHJ PP,EVALXQ ;GET OTHER HALF
HRRM AC0,-1(PP) ;STORE IT
CAIE C,']' ;MUST END ON ]
JRST REQUER ;IT DIDN'T
BYPASS ;[273]HANDLE PPN CORRECTLY
REQU2: SETZ RC, ;NO RELOCATION
POP PP,AC0 ;GET FILE NAME
PUSHJ PP,COUT
POP PP,AC0 ;AND PPN
PUSHJ PP,COUT
POP PP,AC0 ;FINALLY DEVICE
PUSHJ PP,COUT
JUMPCM REQU0 ;MORE TO COME
PUSHJ PP,COUTD ;DUMP BLOCK
POP PP,BLKTYP ;RESTORE BLOCK TYPE
POPJ PP, ;NO
REQU4: PUSHJ PP,SCHGET ;[335] GO SCAN OUT EXTENSION
HLRZ AC0,AC0 ;[335] SWAP FOR CAIE
CAIE AC0,'REL' ;[335] SEE IF IT'S FOR .REL
TRO ER,ERRQ ;[335] NOPE, TELL HIM ABOUT IT
JRST REQU3 ;[335] BACK TO LOOK FOR PPN
REQUER: SUB PP,[3,,3] ;REMOVE THE THREE ITEMS
POP PP,BLKTYP ;RESTORE BLOCK TYPE
JRST ERRAX ;AND GIVE UP
;[202] NEW .DIRECTIVE PSEUDO-OP
;[202] ARGS ARE FUNCTIONS TO BE DONE
;[421] CLEAN UP DIRECTIVE CODE
;[421] ADD .DIRECTIVE NO XXXX WHICH NEGATES EFFECT
%DIREC:
SETZM NOFLG ;START W/POSITIVE DIRECTIVE
DIREC1: PUSHJ PP,GETSYM ;GET SYMBOL
JRST ERRAX ;MISSING, GIVE ERROR
CAMN AC0,[SIXBIT /NO/];IS IT "NO"
JRST [ SKIPE NOFLG ;IS NEGATIVE FLAG OFF?
TROA ER,ERRQ;NO. DONT ALLOW .DIRECT NO NO XXXX
SETOM NOFLG ;SET AS NEGATIVE DIRECTIVE
TLO IO,IORPTC ;REGET THE DELIMITER
JRST DIREC1] ;AND GET NEXT SYMBOL
MOVSI ARG,-DIRLEN ;AOBJN WORD
CAMN AC0,DIRARG(ARG) ;LOOK FOR MATCH
JRST DIRFND ;GOT IT
AOBJN ARG,.-2 ;LOOP FOR ALL OF TABLE
JRST ERRAX ;NOT FOUND, GIVE ERROR
DIRFND:
SKIPE NOFLG ;IS THIS A NEGATIVE DIRECTIVE?
JRST DIRNDO ;YES,GO PROCESS IT
XCT DIPXCT(ARG) ;EXECUTE THE INSTRUCTION
JRST DIREND ;SEE IF MORE TO DO
DIRNDO: ;HERE FOR NEGATIVE DIRECTIVE
SKIPN DINXCT(ARG) ;ANYTHING THERE TO DO?
TROA ER,ERRA ;NO, NOTHING TO DO
XCT DINXCT(ARG) ;ELSE DO IT
DIREND:
JUMPCM %DIREC ;GET NEXT SYMBOL IF COMMA FOLLOWS
POPJ PP, ;ELSE RETURN
; TABLES FOR DIRECTIVE PROCESSOR
;[421]
; THE DIRMAK MACRO DEFINES THE ARGUMENTS FOR THE .DIRECTIVE PSEUDO-OP
; THE FIRST ENTRY IS THE NAME OF THE PARTICULAR DIRECTIVE
; THE SECOND ENTRY IS THE INSTRUCTION TO EXECUTE IF THE CASE IS
; .DIRECTIVE XXXXXX
; THE THIRD ARGUMENT IS THE INSTRUCTION TO EXECUTE IF THE CASE IS
; .DIRECTIVE NO XXXXXX
; IF THERE IS NO LOGICAL NEGATIVE FOR THIS DIRECTIVE, IT SHOULD
; BE LEFT BLANK.
; THE THREE TABLES CREATED ARE DIRARG, DIPXCT, DINXCT
DEFINE DIRMAK, <
XLIST
X (.NOBIN,<PUSHJ PP,%NOBIN>) ;;DONT GENERATE REL FILE
X (.ITABM,<SETZM DECTAB>,<SETOM DECTAB>);;INCLUDE TABS IN MACRO ARGS
X (.XTABM,<SETOM DECTAB>,<SETZM DECTAB>);;EXCLUDE "" " ""
X (KA10,<PUSHJ PP,SETKA>) ;;SET PROCESSOR TYPE KA
X (KI10,<PUSHJ PP,SETKI>) ;;SET PROCESSOR TYPE KI
X (KL10,<PUSHJ PP,SETKL>) ;;SET PROCESSOR TYPE KL
X (.OKOVL,<SETOM OKOVFL>,<SETZM OKOVFL>);;ALLOW /,* OVERFLOW
X (.EROVL,<SETZM OKOVFL>,<SETOM OKOVFL>);;DONT ALLOW /,* OVERFLOW
IFN TSTCD,<
X (.TCDON,<PUSHJ PP,TCDSET>) ;;DEBUG NEW CODE TYPES
X (.TCDOF,<SETZM TCDFLG>) ;; "" "" "" ""
> ; END OF IFN TSTCD CONDITIONAL
LIST
> ; END OF DIRMAK DEFINITION
; DEFINE TABLE OF DIRECTIVE ARGUMENTS
DEFINE X($A,$B,$C)< SIXBIT \$A\>
DIRARG: DIRMAK
DIRLEN==.-DIRARG
; DEFINE TABLE OF POSITIVE DIRECTIVE ACTIONS
DEFINE X($A,$B,$C)< $B>
DIPXCT: DIRMAK
; DEFINE TABLE OF NEGATIVE DIRECTIVE ACTIONS
DEFINE X($A,$B,$C)<
IFB <$C>,<EXP 0>
IFNB <$C>, <$C> >
DINXCT: DIRMAK
; [421] SET THE VARIOUS FLAVORS OF CPU FOR LINK TO CHECK
SETKA: SKIPA ARG,[1B5] ;[235]
SETKI: MOVSI ARG,(2B5) ;[235]
SKIPA ;[413]SET FOR KI OR KA
SETKL: MOVSI ARG,(4B5) ;[413] KA=1 KI=2 KL=4
IORM ARG,CPUTYP ;[413]MAKE INCLUSIVE WITH WHAT IS THERE
POPJ PP, ;[413]THEN RETURN
; [421] SET TEST CODE UP FOR DEBUGGING NEW LINK TYPES
IFN TSTCD,<
TCDSET: SETOM TCDFLG ;[414]SET FLAG ON
PUSHJ PP,COUTD ;[414]BIND OFF LAST BLOCK
POPJ PP, ;[414]
> ; NFI TSTCD [414]
; PSEUDO-END STATEMENT FOR MULTI-FILE CAPABILITY
; HERE IF PRGEND (PASS 1)
PSEND0: TLO IO,MFLSW ;PSEND SEEN
PUSHJ PP,END0 ;AS IF END STATEMENT
HLLZS IO ;CLEAR ER(RH)
SETZM ERRCNT ;CLEAR ERROR COUNT FOR EACH PROG.
SETZM QERRS ;[145] ...
JUMP2 PSEND2 ;DIFFERENT ON PASS2
SKIPE UNIVSN ;SEEN A UNIVERSAL
PUSHJ PP,UNISYM ;YES, STORE SYMBOLS
PUSHJ PP,PSEND4 ;SAVE SYMBOLS, POINTERS AND TITLE
MOVE AC0,[ASCII /.MAIN/] ;[420] GET DEFAULT TITLE
MOVEM AC0,TBUF ;[420]AND MAKE IT CURRENT TITLE
SETZM TBUF+1 ;CLEAR TITLE SEEN FLAG
SETZM RELLOC ;[346] CLEAR TO PREVENT EFFECTS ACROSS PRGEND
PSEND1: TLZ IO,MFLSW ;FOR NEXT FILE
SETZM UNISCH ;CLEAR UNIVERSAL SEARCH TABLE
MOVE AC0,[UNISCH,,UNISCH+1]
BLT AC0,UNISCH+.UNIV-1
TLO IO,IOPAGE ;[142] SIGNAL NEW PAGE BUT DON'T CHANGE NUMBER
MOVSI AC0,1 ;SET SO RELOC 0 WORKS
HRRZM AC0,LOCA ;[165] SET ASSEMBLY LOCATION
HRRZM AC0,LOCO ;[165] AND OUTPUT LOCATION
HLRZM AC0,MODA ;[165] SET MODE
HLRZM AC0,MODO ;[165]
POPJ PP, ;[165]
; HERE IF PRGEND (PASS 2)
PSEND2: SETZM SBUF ;SO SUBTTL IS NOT WRONG
SETZM UNIVSN ;[226] IN CASE IN UNIVERSAL
PUSHJ PP,PSEND5 ;PUT TITLE BACK
PUSHJ PP,PSEND1 ;COMMON CODE
JRST PASS20 ;OUTPUT THE ENTRIES
; HERE IF END (PASS 1)
PSEND3: PUSHJ PP,PSEND4 ;SAVE LAST PROGRAM
HLRS PRGPTR ;REINITIALIZE POINTER
PJRST PSEND5 ;READ BACK FIRST PROGRAM
;HERE TO SAVE AND RESTORE SYMBOL TABLE, TITLE AND OTHER USEFUL LOCATIONS
XTRA==7 ;NUMBER OF OTHER LOCATIONS TO SAVE
PSEND4: MOVE V,FREE ;GET NEXT FREE LOCATION
ADDI V,LENGTH+.TBUF/5+XTRA
IFN POLISH,<
ADD V,SGNMAX
ADD V,SGNMAX
ADD V,SGNMAX
ADD V,SGNMAX
>
CAML V,SYMBOL ;WILL WORST CASE FIT?
PUSHJ PP,XCEED ;NO, EXPAND
MOVS V,FREE
HRR V,PRGPTR ;LAST PRGEND BLOCK
HLRM V,(V) ;LINK THIS BLOCK
SKIPN PRGPTR ;IF FIRST TIME
HLLZM V,PRGPTR ;SET LINK TO START OF CHAIN
HLRM V,PRGPTR ;POINTER TO IT
SETZM @FREE ;CLEAR LINK WORD
AOS FREE ;THIS LOCATION USED NOW
MOVS AC0,SYMBOL ;BOTTOM OF SYMBOL TABLE
HRR AC0,FREE ;FREE SPACE
MOVE V,@SYMBOL ;GET NUMBER OF SYMBOLS
ASH V,1 ;TWO WORDS PER SYMBOL
ADDI V,1 ;ONE MORE FOR COUNT
ADDB V,FREE ;END OF TABLE WHEN MOVED
BLT AC0,(V) ;MOVE TABLE
HRRZ AC0,.JBREL ;TOP OF CORE
SUBI AC0,1
MOVEM AC0,SYMTOP ;FOR NEXT SYMBOL TABLE
SUBI AC0,LENGTH ;LENGTH OF INITIAL SYMBOLS
MOVEM AC0,SYMBOL ;SET POINTER TO COUNT OF SYMBOLS
HRLI AC0,SYMNUM ;BLT POINTER
BLT AC0,@SYMTOP ;SET UP INITIAL SYMBOL TABLE
PUSHJ PP,SRCHI ;SET UP SEARCH POINTER
MOVEI AC0,.TBUF ;MAX NUMBER OF CHARS. IN TITLE
SUB AC0,TCNT ;ACTUAL NUMBER
IDIVI AC0,5 ;NUMBER OF WORDS
SKIPE AC1 ;REMAINDER?
ADDI AC0,1 ;YES
MOVEM AC0,@FREE ;STORE COUNT
AOS FREE ;THIS LOCATION USED NOW
EXCH AC0,FREE ;SET UP AC0 FOR BLT
ADDM AC0,FREE ;WILL BE AFTER TITLE MOVES
HRLI AC0,TBUF ;BLT POINTER
BLT AC0,@FREE ;MOVE TITLE
IFN POLISH,<
MOVE AC2,SGNMAX ;PSECT COUNT
MOVE AC0,AC2
PUSHJ PP,STORIT ;SAVE PSECT COUNT
MOVE AC0,SGNAME(AC2)
PUSHJ PP,STORIT ;SAVE PSECT NAME
MOVE AC0,SGRELC(AC2)
PUSHJ PP,STORIT ;SAVE MODE AND PC
MOVE AC0,SGSCNT(AC2)
PUSHJ PP,STORIT ;SAVE SYM CNT
MOVE AC0,SGATTR(AC2)
PUSHJ PP,STORIT ;SAVE BREAK AND ATTRS
SOJGE AC2,.-10
SETZM SGNMAX ;ZERO PSECT CNT
SETZM SGNAME ;BLANK PSECT NAME
MOVSI AC0,1 ;SET RELOCATION
MOVEM AC0,SGRELC ; TO RELATIVE ZERO
MOVE AC0,@SYMBOL ;GET SYM CNT
MOVEM AC0,SGSCNT ;SAVE PSECT SYM CNT
PUSHJ PP,SRCHI ;SET UP SEARCH POINTER
>
MOVE AC0,LITHD ;[251] LENGTH ,, START
PUSHJ PP,STORIT ;[251]
MOVE AC2,LITHDX ;POINTER TO LIT INFO.
MOVE AC0,-1(AC2) ;SIZE OF PASS1 LOCO
PUSHJ PP,STORIT ;SAVE IT IN SYMBOL TABLE
MOVE AC2,VARHDX ;SAME FOR VARS
MOVE AC0,-1(AC2)
PUSHJ PP,STORIT
MOVE AC0,(AC2)
PUSHJ PP,STORIT
SETZM (AC2) ;CLEAR NUMBER OF VARIABLES SEEN
MOVE AC0,HISNSW ;GET TWOSEG/HISEG FLAG
HRR AC0,HIGH1 ;AND PASS1 BREAK
PUSHJ PP,STORIT
SETZM HISNSW ;[412] CLEAR HISEG FLAG FOR NEXT PROGRAM
JUMPGE AC0,PSEND6 ;NOT TWOSEG
MOVE AC0,SVTYP3 ;HIGH SEGMENT OFFSET
PUSHJ PP,STORIT ;SAVE IT ALSO
PSEND6: MOVE AC0,FREE ;GET NEXT FREE LOCATION
SUBI AC0,1 ;LAST ONE USED
HRRZ V,PRGPTR ;POINTER TO START OF DATA BLOCK
HRLM AC0,(V) ;LINK TO END OF BLOCK
POPJ PP, ;RETURN
PSENDX: PUSHJ PP,XCEED ;NEED TO EXPAND CORE FIRST
PSEND5: HRRZ V,.JBREL ;[170] GET TOP OF CORE
SETZM (V) ;[170] CLEAR OR GET ILL MEM REF
MOVEI AC0,-1(V) ;[170]
MOVEM AC0,SYMTOP ;TOP OF NEW SYMBOL TABLE
HRRZ V,PRGPTR ;ADDRESS OF THIS BLOCK
JUMPE V,PSNDER ;ERROR LINK NOT SET UP
MOVE AC1,(V) ;NEXT LINK
MOVE V,1(V) ;GET ITS SYMBOL COUNT
ASH V,1 ;NUMBER OF WORDS
ADDI V,1 ;PLUS ONE FOR COUNT
SUBI AC0,(V) ;START OF NEW SYMBOL TABLE
CAMG AC0,FREE ;WILL IT FIT
JRST PSENDX ;NO, NEED TO EXPAND AND RESET AC0
ADD V,PRGPTR ;POINT TO END OF SYMBOL TABLE
MOVEI V,1(V) ;THEN TO BEG OF TITLE
MOVEM AC0,SYMBOL ;BOTTOM OF NEW TABLE
HRL AC0,PRGPTR ;ADDRESS OF FIRST WORD OF BLOCK
ADD AC0,[1,,0] ;MAKE BLT POINTER
HRRM AC1,PRGPTR ;POINT TO NEXT BLOCK
BLT AC0,@SYMTOP ;MOVE TABLE
PUSHJ PP,SRCHI ;SET UP POINTER
MOVE AC1,(V) ;NUMBER OF WORDS OF TITLE
MOVEI AC0,1(V) ;START OF STORED TITLE
ADD V,AC1 ;INCREMENT PAST TITLE
ADDI AC1,TBUF-1 ;END OF TITLE
HRLI AC0,TBUF ;WHERE TO PUT IT
MOVSS AC0 ;BLT POINTER
BLT AC0,(AC1) ;MOVE TITLE
IFN POLISH,<
PUSHJ PP,GETIT ;GET PSECT COUNT
MOVE AC2,AC0
MOVEM AC2,SGNMAX
PUSHJ PP,GETIT ;GET PSECT NAME
MOVEM AC0,SGNAME(AC2)
PUSHJ PP,GETIT ;GET MODE AND PC
MOVEM AC0,SGRELC(AC2)
PUSHJ PP,GETIT ;GET SYM CNT
MOVEM AC0,SGSCNT(AC2)
PUSHJ PP,GETIT ;GET BREAK AND ATTRS
MOVEM AC0,SGATTR(AC2)
SOJGE AC2,.-10
SETZM SGNCUR ;SET TO BLANK PSECT
PUSHJ PP,SRCHI ;SET UP POINTER
>
SKIPN TBUF+1 ;CHECK TITLE SEEN FLAG
AOS TBUF+1 ;AND SET IT NON-ZERO
PUSHJ PP,GETIT ;[251]
MOVEM AC0,LITHD ;[251]
MOVE AC2,LITHDX ;INVERSE OF ABOVE
PUSHJ PP,GETIT
MOVEM AC0,-1(AC2)
MOVE AC2,VARHDX ;SAME FOR VARS
PUSHJ PP,GETIT
MOVEM AC0,-1(AC2)
PUSHJ PP,GETIT
MOVEM AC0,(AC2) ;RESTORE COUNT OF VARS
PUSHJ PP,GETIT ;GET TWO HALF WORDS
HRRZM AC0,HIGH1 ;PASS1 BREAK
HLLEM AC0,HISNSW ;TWOSEG/HISEG FLAG
JUMPGE AC0,CPOPJ ;NOT TWOSEG
PUSHJ PP,GETIT
MOVEM AC0,SVTYP3 ;BLOCK 3 WORD
POPJ PP,
STORIT: MOVEM AC0,@FREE ;STORE IT IN DATA BLOCK
AOS FREE ;ADVANCE POINTER
POPJ PP,
GETIT: MOVE AC0,1(V) ;FILL AC0 OUT OF PRGEND BLOCK
AOJA V,CPOPJ ;INCREMENT AND RETURN
PSNDER: HRROI RC,[SIXBIT /PGE PRGEND ERROR @/] ;[377]
JRST ERRFIN
;MULTIPLE SYMBOL TABLE FEATURE PSEUDO-OPS
UNIV0: JUMP2 UNIV2 ;[226] DO PROPER PASS2 STUFF
HRRZ SX,UNIVNO ;GET NUMBER OF UNIVERSALS SEEN
CAIL SX,.UNIV ;ALLOW ONE MORE?
JRST UNVERR ;NO, GIVE FATAL ERROR
SETOM UNIVSN ;AND SET SEEN A UNIVERSAL
JRST TITLE0 ;CONTINUE AS IF TITLE
UNIV2: HLLOS UNIVSN ;[226] ENSURE SET UP FOR UNIVERSAL
JRST REMAR0 ;[226] AND IGNORE LINE
ADDUNV: PUSH PP,RC ;AN AC TO USE
PUSHJ PP,NOUT ;CONVERT TO SIXBIT
HRRZ RC,UNIVNO ;GET ENTRY INDEX
MOVEM AC0,UNITBL+1(RC) ;STORE SIXBIT NAME IN TABLE
MOVEM AC0,UNVDIR ;AND FOR ENTER LATER
HRRZS UNIVSN ;ONLY DO IT ONCE
POP PP,RC ;RESTORE RC
POPJ PP, ;AND RETURN
UNVERR: HRROI RC,[SIXBIT /TMU TOO MANY UNIVERSALS@/]
JRST ERRFIN
UNISYM: PUSHJ PP,SUPRSA ;TURN ON SUPPRESS BIT
SKIPN UNVSKP ;SKIP IF /U SEEN
PUSHJ PP,UNVOUT ;OUTPUT SYMBOL TABLE
TLNN IO,MFLSW ;[231] ALSO IN PRGEND?
JRST UNISYN ;[231] NO
MOVE AC0,@SYMBOL ;[231] GET NO. OF SYMBOLS
LSH AC0,1 ;[231] 2 WORDS EACH
ADDI AC0,1 ;[231] PLUS COUNT
ADD AC0,FREE ;[231] HOW MUCH WE WILL NEED
CAML AC0,SYMBOL ;[231] WILL IT FIT IN WHAT WE HAVE
UNISYK: PUSHJ PP,XCEED ;[355] [231] NO, EXPAND
CAML AC0,SYMBOL ;[355] ENOUGH?
JRST UNISYK ;[355] NO,EXPAND
UNISYN: PUSH PP,SYMBOL ;NEED TO SAVE INCASE PRGEND
MOVE AC0,SYMTOP ;TOP OF TABLE
SUB AC0,SYMBOL ;GET LENGTH OF TABLE
HRL ARG,SYMBOL ;BOTTOM OF TABLE
HRR ARG,FREE ;WHERE TO GO
HRRZ RC,UNIVNO ;GET TABLE INDEX
HRRM ARG,SYMBOL ;WILL BE THERE SOON
HRRZM ARG,UNIPTR+1(RC) ;STORE IN CORRESPONDING PLACE
ADDB AC0,FREE ;WHERE TO END
HRLM AC0,UNIPTR+1(RC) ;SAVE NEW SYMTOP
BLT ARG,@FREE ;MOVE TABLE
HRRZM AC0,UNITOP ;SAVE TOP OF TABLES+1
CAMLE AC0,MACSIZ ;IN CASE OVER A K BOUND
MOVEM AC0,MACSIZ ;DON'T REDUCE SO FAR NOW
MOVE AC0,SRCHX ;SAVE OLD SEARCH POINTER
PUSHJ PP,SRCHI ;GET SEARCH POINTER
EXCH AC0,SRCHX
MOVEM AC0,UNISHX+1(RC) ;SAVE IT
POP PP,SYMBOL ;RESTORE OLD VALUE
SETZM UNIVSN ;CLEAR FLAG INCASE PRGEND
AOS UNIVNO ;SIGNAL ANOTHER UNIVERSAL SAVED
POPJ PP, ;RETURN
SERCH0: PUSHJ PP,GETSYM ;GET A SYMBOL
JRST ERRAX ;ERROR IF NOT VALID
MOVE RC,UNIVNO ;NUMBER OF UNIVERSALS AVAILABLE
JUMPE RC,UNVINP ;TRY TO READ SYMBOLS FROM DSK
CAME AC0,UNITBL(RC) ;LOOK FOR MATCH
SOJA RC,.-2 ;NOT FOUND YET
SERCH1: MOVE AC0,RC ;STORE TABLE ENTRY NUMBER
MOVEI RC,1 ;START AT ENTRY ONE
CAIL RC,.UNIV ;CHECK FOR CONSISTENCY ERROR
JRST SCHERR ;SHOULD NEVER HAPPEN!!
SKIPE UNISCH(RC) ;LOOK FOR AN EMPTY SLOT
AOJA RC,.-3 ;NOT FOUND YET
MOVEM AC0,UNISCH(RC) ;STORE INDEX IN TABLE
CAIE C,'(' ;[240] GIVING FILE SPEC?
JRST SERCH4 ;[240] NO
SERCH2: PUSHJ PP,GETCHR ;[240] YES, GET RID OF IT
CAIN C,')' ;[266] LOOK FOR END
JRST SERCH3 ;[266] FOUND IT
CAIE C,EOL ;[266] REACHED END OF LINE?
JRST SERCH2 ;[266] NO, KEEP LOOKING
TROA ER,ERRQ ;[266] GIVE UP AND FLAG ERROR
SERCH3: PUSHJ PP,GETCHR ;[240] GET NEXT CHAR
SERCH4: JUMPCM SERCH0 ;[240] LOOK FOR MORE NAMES
POPJ PP, ;FINISHED
VERSKW: MOVSI RC,[SIXBIT /UVS UNIVERSAL VERSION SKEW, REASSEMBLE UNIVERSAL@/] ;[364]
JRST ERRFIN ;[364] NAME IN AC0
SCHERR: MOVSI RC,[SIXBIT /CFU CANNOT FIND UNIVERSAL@/]
JRST ERRFIN ;NAME IN AC0
;MESSAGE FOR CASE WHERE FILES AFTER UNIVERSAL USED MORE BUFFER SPACE THAN FIRST UNIVERSAL
UNIERR: HRROI RC,[SIXBIT /USS UNIVERSAL PROGRAM(S) MUST HAVE SAME OUTPUT SPECIFICATION AS OTHER FILES@/]
JRST ERRFIN
SCHGET: SETZ AC0, ;[240] INITIALIZE
MOVSI AC1,(POINT 6,AC0) ;[240]
SCHGNX: PUSHJ PP,GETCHR ;[240] GET NEXT CHARACTER
CAIE C,'.' ;[240] SPECIAL TEST FOR END OF NAME
TLNN CS,6 ;[240] OR ANY NON-ALPHANUMERIC
PJRST BYPAS2 ;[240] SKIP ALL SPACES AND QUIT
TLNE AC1,770000 ;[240] ALL SIX IN YET?
IDPB C,AC1 ;[240] NO, STORE THIS ONE
JRST SCHGNX ;[240] GET NEXT
SCHOCT: SETZ AC0, ;[240] INITIALIZE
SCHONX: PUSHJ PP,GETCHR ;[240] GET NEXT CHAR
TLNN CS,4 ;[240] NUMBER
PJRST BYPAS2 ;[240] NO, SKIP TRAILING SPACES
LSH AC0,3 ;[240] MAKE SPACE
ADDI AC0,-'0'(C) ;[240] AND STOW DIGIT
JRST SCHONX ;[240] GET NEXT
SUBTTL MACRO/REPEAT HANDLERS
REPEA0: PUSHJ PP,EVALXQ ;EVALUATE REPEAT EXP, EXTERNS ARE ILL.
JUMPNC ERRAX
REPEA1: SETZM COMSW ;[425] SET COMMENT SWITCH
JUMPLE AC0,REPZ ;PASS THE EXP., DONT PROCESS
SOJE AC0,REPO ;REPEAT ONCE
REPEA2: PUSHJ PP,GCHARQ ;GET STARTING "<"
PUSHJ PP,COMTST ;[425] IGNORE COMMENTS
SKIPN COMSW ;[425] INSIDE A COMMENT?
CAIG C," " ;[373] TEXT FORMATTING CHARACTER?
JRST REPEA2 ;[373] YES, GET NEXT
CAIE C,"<" ;[373] "<"?
JRST REPMAB ;[373] NO, ERROR
PUSHJ PP,SKELI1 ;INITIALIZE SKELETON
PUSH MP,REPEXP
MOVEM AC0,REPEXP
PUSH MP,REPPNT ;STACK PREVIOUS REPEAT POINTER
MOVEM ARG,REPPNT ;STORE NEW POINTER
TDZA SDEL,SDEL ;YES, INITIALIZE BRACKET COUNT AND SKIP
REPEA4: PUSHJ PP,WCHARQ ;WRITE A CHARACTER
PUSHJ PP,GCHARQ ;GET A CHARACTER
CAIN C,"<" ;"<"?
AOJA SDEL,REPEA4 ;YES, INCREMENT AND WRITE
CAIE C,">" ;">"?
JRST REPEA4 ;NO, WRITE THE CHARACTER
SOJGE SDEL,REPEA4 ;YES, WRITE IF NON-NEGATIVE COUNT
MOVSI CS,(BYTE (7) 177,3) ;SET "REPEAT" END
PUSHJ PP,WWRXE ;WRITE END
SKIPN LITLVL ;LITERAL MIGHT END ON LINE
SKIPE MACLVL ;IF IN MACRO DARE NOT PROCESS
JRST REPEA5 ;REST OF LINE SINCE MACRO MIGHT END ON IT
BYPASS
PUSHJ PP,STOUTS ;POLISH OF LINE BEFORE PROCESSING REPEAT
REPEA5: PUSH MP,MRP ;STACK PREVIOUS READ POINTER
PUSH MP,RCOUNT ;SAVE WORD COUNT
HRRZ MRP,REPPNT ;SET UP READ POINTER
SKIPN MACLVL ;IF IN MACRO GIVE CR-LF FIRST
SKIPE LITLVL ;SAME FOR LITERAL
JRST REPEA7
AOJA MRP,POPOUT ;BYPASS ARG COUNT
REPEA7: HRRZ MRP,REPPNT ;SET UP READ POINTER
ADDI MRP,1 ;BYPASS ARG COUNT
REPEA8: MOVEI C,LF
JRST RSW2
REPEND: SOSL REPEXP
JRST REPEA7
HRRZ V,REPPNT ;GET START OF TREE
PUSHJ PP,REFDEC ;DECREMENT REFERENCE
POP MP,RCOUNT
POP MP,MRP
POP MP,REPPNT
POP MP,REPEXP
SKIPN LITLVL ;IF IN LITERAL OR
SKIPE MACLVL ;IF IN MACRO
JRST RSW0 ;FINISH OF LINE NOW
JRST REPEA8
REPMAB: HRROI RC,[SIXBIT /MBR MISSING OPEN ANGLE BRACKET FOR REPEAT@/] ;[373]
JUMP1 .+2 ;[373] ONLY COUNT ERROR ON PASS 2
AOS ERRCNT ;[373] INCREMENT ERROR COUNT
JRST ERRNE0 ;[373] COMMON MESSAGE
REPZ: FORERR (SDEL,REP)
SETOM INREP
REPZ0: PUSHJ PP,GCHAR ;[425] GET STARTING <
PUSHJ PP,COMTST ;[425] IGNORE COMMENTS
SKIPN COMSW ;[425] INSIDE A COMMENT?
CAIG C," " ;[425] TEXT-FORMATTING CHARACTER?
JRST REPZ0 ;[425] YES, GET NEXT
CAIE C,"<" ;[425] < ?
JRST CORMAB ;[425] NO, ERROR
MOVEI SDEL,1 ;[425] SET COUNT
REPZ1: PUSHJ PP,GCHAR ;GET NEXT CHARACTER
CAIN C,"<" ;"<"?
AOJA SDEL,REPZ1 ;YES, INCREMENT COUNT
CAIN C,">" ;">"?
SOJLE SDEL,REPZ2 ;YES, EXIT IF MATCHING
JRST REPZ1 ;NO, RECYCLE
REPZ2: SETZM INREP ;FLAG OUT OF IT
SETZM INCND ;AND CONDITIONAL ALSO
JRST STMNT ;AND EXIT
REPO: PUSHJ PP,GCHAR ;GET "<"
PUSHJ PP,COMTST ;[425] IGNORE COMMENTS
SKIPN COMSW ;[425] INSIDE A COMMENT?
CAIG C," " ;[425] TEXT-FORMATTING CHARACTER?
JRST REPO ;[425] YES, GET NEXT
CAIE C,"<" ;[425] < ?
JRST CORMAB ;[425] NO, ERROR
SKIPE RPOLVL ;ARE WE NESTED?
AOS RPOLVL ;YES, DECREMENT CURRENT
PUSH MP,RPOLVL
SETOM RPOLVL
JRST STMNT
REPO1: CAIN C,"<"
SOS RPOLVL
CAIN C,">"
AOSE RPOLVL
JRST RSW2
POP MP,RPOLVL
PUSHJ PP,RSW2
JRST RSW0
CORMAB: HRROI RC,[SIXBIT /MBC MISSING OPEN ANGLE BRACKET FOR CONDITIONAL OR REPEAT@/] ;[425]
JUMP1 .+2 ;[425] ONLY COUNT ERROR ON PASS 2
AOS ERRCNT ;[425] INCREMENT ERROR COUNT
JRST ERRNE0 ;[425] COMMON MESSAGE
COMTST: CAIG C,FF ;[425] SEARCH FOR END OF LINE
CAIGE C,LF ;[425] LF, VT OR FF?
JRST .+2 ;[425] WASN'T ANY OF THEM
SETZM COMSW ;[425] RESET COMMENT SWITCH
CAIN C,";" ;[425] COMMENT?
SETOM COMSW ;[425] YES, SET COMMENT SWITCH
POPJ PP, ;[425] CONTINUE
DEFIN0: PUSHJ PP,GETSYM ;GET MACRO NAME
JRST ERRAX ;EXIT ON ERROR
MOVEM PP,PPTMP1 ;SAVE POINTER
MOVEM AC0,PPTMP2 ;SAVE NAME
TLO IO,IORPTC
FORERR (SX,DEF)
SETOM INDEF ;AND FLAG IN DEFINE
SETZB SX,.TEMP ;[425] SET ARGUMENT AND REFERENCE COUNT
SETZM COMSW ;[425] AND COMMENT SWITCH
DEF02: PUSHJ PP,GCHAR ;SEARCH FOR "(" OR "<"
PUSHJ PP,COMTST ;[425] IGNORE COMMENTS
SKIPE COMSW ;INSIDE A COMMENT?
JRST DEF02 ;YES, IGNORE CHARACTER
CAIN C,"<" ;"<"?
JRST DEF20 ;YES
CAIE C,"(" ;"("?
JRST DEF02 ;NO
DEF10: PUSHJ PP,GETSYM ;YES, GET DUMMY SYMBOL
TRO ER,ERRA ;FLAG ERROR
ADDI SX,1 ;INCREMENT ARG COUNT
PUSH PP,AC0 ;STACK IT
CAIN C,'<' ;A DEFAULT ARGUMENT COMING UP?
JRST DEF80 ;YES, STORE IT AWAY
CAIE C,11 ;")"?
JRST DEF10 ;NO, GET NEXT DUMMY SYMBOL
DEF12: PUSHJ PP,GCHAR
PUSHJ PP,COMTST ;[425] IGNORE COMMENTS
SKIPN COMSW ;[425] SKIP IF INSIDE COMMENT
CAIE C,"<" ;"<"?
JRST DEF12 ;NO
DEF20: PUSH PP,[0] ;YES, MARK THE LIST
LSH SX,9 ;SHIFT ARG COUNT
AOS ARG,SX
PUSHJ PP,SKELI ;INITIALIZE MACRO SKELETON
MOVE AC0,PPTMP2 ;GET NAME
TLO IO,DEFCRS
PUSH PP,UNISCH+1 ;MUST NOT SEARCH UNIVERSALS AT THIS POINT
SETZM UNISCH+1 ;OTHERWISE ORIGINAL DEFINITION WILL BE LOST
PUSHJ PP,MSRCH ;SEARCH THE TABLE
JRST DEF24 ;NOT FOUND
TLNN ARG,MACF ;FOUND, IS IT A MACRO?
TROA ER,ERRX ;NO, FLAG ERROR AND SKIP
PUSHJ PP,REFDEC ;YES, DECREMENT THE REFERENCE
DEF24: POP PP,UNISCH+1 ;BACK AS IT WAS
HRRZ V,WWRXX ;GET START OF TREE
SKIPN .TEMP ;ANY DEFAULT ARGUMENTS TO TAKE CARE OF?
JRST DEF25 ;NO
HRRZ C,1(V) ;GET SHIFTED ARG COUNT
LSH C,-9 ;GET ARG COUNT BACK
ADDI C,1 ;ONE MORE FOR TERMINAL ZERO
ADD C,.TEMP ;NUMBER OF ITEMS IN STACK
HRLS C ;MAKE XWD
MOVE SDEL,.TEMP ;NUMBER OF WORDS NEEDED
ADDI SDEL,1 ;[341] PLUS THE 0 AT THE END
ADDB SDEL,FREE ;FROM FREE CORE
CAML SDEL,SYMBOL ;MORE CORE NEEDED
PUSHJ PP,XCEEDS ;YES, TRY TO GET IT
SUB SDEL,.TEMP ;FORM POINTER
SUBI SDEL,1 ;[341] MINUS THE 0
SUB PP,C ;[341] BACK UP STACK TO START OF ARGS
HRLM SDEL,1(V) ;STORE IT WITH ARG COUNT IN MACRO
SUBI SDEL,1 ;TO USE FOR PUSHING POINTER INTO STORAGE
MOVEI C,1(PP) ;POINT TO START OF STACK
DEF26: MOVE ARG,(C) ;GET AN ITEM OFF STACK
TLNN ARG,-40 ;A POINTER?
JUMPN ARG,[PUSH SDEL,ARG ;YES, STORE IT
AOJA C,DEF26] ;GET NEXT
PUSH PP,ARG ;RESTACK ARGUMENT
SKIPE ARG ;FINISHED IF ZERO
AOJA C,DEF26 ;GET NEXT
PUSH SDEL,ARG ;STORE ZERO IN DEFAULT LIST ALSO
DEF25: MOVSI ARG,MACF
MOVEM PP,PPTMP2 ;STORE TEMP STORAGE POINTER
PUSHJ PP,INSERT ;INSERT/UPDATE
TLZ IO,DEFCRS ;JUST IN CASE
SETZM ARGF ;NO ARGUMENT SEEN
SETZM SQFLG ;AND NO ' SEEN
TDZA SDEL,SDEL ;CLEAR BRACKET COUNT
DEF30: PUSHJ PP,WCHAR ;WRITE CHARACTER
DEF31: PUSHJ PP,GCHAR ;GET A CHARACTER
DEF32: MOVE CS,C ;GET A COPY
CAIN C,";" ;IS IT A COMMENT
JRST CPEEK ;YES CHECK FOR ;;
DEF33: CAIG CS,"Z"+40 ;CONVERT LOWER CASE
CAIGE CS,"A"+40
JRST .+2
SUBI CS,40
CAIGE CS,40 ;TEST FOR CONTROL CHAR.
JRST [SKIPN SQFLG ;HAS SINGLE QUOTE BEEN SEEN?
JRST DEF30 ;NO, OUTPUT THIS CHAR.
PUSH PP,C ;YES, SAVE CURRENT CHAR
MOVEI C,47 ;SET UP QUOTE
PUSHJ PP,WCHAR ;WRITE IT
POP PP,C ;GET BACK CURRENT CHAR.
SETZM SQFLG ;RESET FLAG
JRST DEF30] ;AND CONTINUE
CAILE CS,77+40
JRST DEF30 ;TEST FOR SPECIAL
MOVE CS,CSTAT-40(CS) ;GET STATUS BITS
TLNE CS,6 ;ALPHA-NUMERIC?
JRST DEF40 ;YES
SKIPN SQFLG ;WAS A ' SEEN?
JRST DEF36 ;NO, PROCESH
PUSH PP,C ;YES, SAVE CURRENT CHARACTER
MOVEI C,47 ;AND PUT IN A '
PUSHJ PP,WCHAR ;...
POP PP,C ;RESTORE CURRENT CHARACTER
SETZM SQFLG ;AND RESET FLAG
DEF36: CAIE C,47 ;IS THIS A '?
JRST DEF35 ;NOPE
SKIPN ARGF ;YES, WAS LAST THING SEEN AN ARG?
SETOM SQFLG ;IF NOT, SET SNGL QUOT FLAG
SETZM ARGF ;BUT NOT ARGUMENT IN ANY CASE
JRST DEF31 ;GO GET NEXT CHARACTER
DEF35: SETZM ARGF ;THIS IS NOT AN ARGUMENT
CAIN C,"<" ;"<"?
AOJA SDEL,DEF30 ;YES, INCREMENT COUNT AND WRITE
CAIN C,">" ;">"?
SOJL SDEL,DEF70 ;YES, TEST FOR END
JRST DEF30 ;NO, WRITE IT
CPEEK: TLNN IO,IOPALL ;IF LALL IS ON
JRST DEF33 ;JUST RETURN
PUSH PP,CS ;NEED TO SAVE CS, SINCE CHARAC MAY DESTROY IT
PUSHJ PP,PEEK ;LOOK AT NEXT CHAR.
POP PP,CS ;RESTORE CS
CAIN C,";" ;IS IT ;;?
JRST CPEEK0 ;[325] YES, GO SCAN LINE MATCHING ANGLE BRAKETS
MOVE C,CS ;RESTORE C
JRST DEF33 ;AND RETURN
CPEEK0: SETZM CPEEKC ;[325] CLEAR MATCHING ANGLE COUNTER
CPEEK1: PUSHJ PP,GCHAR ;[325] GET A CHARACTER
CAIN C,"<" ;[325] SEE IF LEFT ANGLE
AOJA SDEL,CPEEKL ;[325] YES, GO ADD TO COUNT
CAIN C,">" ;[325] SEE IF RIGHT ANGLE
SOJA SDEL,CPEEKR ;[325] YES, GO SUBTRACT FROM COUNT
CAIG C,CR ;[325] SEE IF AN
CAIGE C,LF ;[325] END OF LINE CHARACTER
JRST CPEEK1 ;[325] NO, CONTINUE
CPEK1A: SKIPL CPEEKC ;[347] YES, SEE IF UNMATCHED ANGLES
JRST CPEEK3 ;[332] NO, GO SEE IF END OF MACRO
PUSH PP,C ;[325] SAVE EOL CHARACTER
CPEEK2: MOVEI C,">" ;[325] SET TO PUT IN SOME RIGHTS
PUSHJ PP,WCHAR ;[325] GO DO ONE
AOSGE CPEEKC ;[325] SEE IF ENOUGH
JRST CPEEK2 ;[325] NO, LOOP
POP PP,C ;[325] RECOVER EOL CHARACTER
CPEEK3: JUMPL SDEL,DEF70 ;[332] IF END OF MACRO, LEAVE COMPLETELY
JRST DEF32 ;[325] AND GET OUT OF LINE
CPEEKL: AOS CPEEKC ;[325] ADD IN LEFT ANGLE BRACKET
JRST CPEEK1 ;[325] TO NEXT CHARACTER
CPEEKR:
JUMPL SDEL,CPEK1A ;[366] JUMP IF END OF MACRO
SOS CPEEKC ;[325],[347]SUBTRACT OUT RIGHT BRACKET
JRST CPEEK1 ;[347]CONTINUE
DEF40: MOVEI AC0,0 ;CLEAR ATOM
MOVSI AC1,(POINT 6,AC0) ;SET POINTER
DEF42: PUSH PP,C ;STACK CHARACTER
TLNE AC1,770000 ;HAVE WE STORED 6?
IDPB CS,AC1 ;NO, STORE IN ATOM
PUSHJ PP,GCHAR ;GET NEXT CHARACTER
MOVE CS,C
CAIG CS,"Z"+40
CAIGE CS,"A"+40
JRST .+2
SUBI CS,40 ;CONVERT LOWER TO UPPER
CAIL CS,40
CAILE CS,77+40
JRST DEF44 ;TEST SPECIAL
MOVE CS,CSTAT-40(CS) ;GET STATUS
TLNE CS,6 ;ALPHA-NUMERIC?
JRST DEF42 ;YES, GET ANOTHER
DEF44: PUSH PP,[0] ;NO, MARK THE LIST
MOVE SX,PPTMP1 ;GET POINTER TO TOP
DEF46: SKIPN 1(SX) ;END OF LIST?
JRST DEF50 ;YES
CAME AC0,1(SX) ;NO, DO THEY COMPARE?
AOJA SX,DEF46 ;NO, TRY AGAIN
SUB SX,PPTMP1 ;YES, GET DUMMY SYMBOL NUMBER
LSH SX,4
MOVSI CS,<(BYTE (7) 177,101)>(SX) ;SET ESCAPE CODE MACEND
LSH AC0,-^D30
CAIN AC0,5 ;"%"?
TLO CS,1000 ;YES, SET CRESYM FLAG
PUSHJ PP,WWORD ;WRITE THE WORD
SETOM ARGF ;SET ARGUMENT SEEN FLAG
SETZM SQFLG ;AND IGNORE ANY ' WAITING TO GET INTO STRING
DEF48: MOVE PP,PPTMP2 ;RESET PUSHDOWN POINTER
TLO IO,IORPTC ;ECHO LAST CHARACTER
JRST DEF31 ;RECYCLE
DEF50:
SKIPN SQFLG ;HAVE WE SEEN A '?
JRST DEF51 ;NOPE
MOVEI C,47 ;YES, PUT IT IN
PUSHJ PP,WCHAR ;...
SETZM SQFLG ;AND CLEAR FLAG
DEF51: MOVE C,2(SX) ;GET CHARACTER
JUMPE C,DEF48 ;CLEAN UP IF END
PUSHJ PP,WCHAR ;WRITE THE CHARACTER
AOJA SX,DEF51 ;GET NEXT
DEF70: MOVE PP,PPTMP1 ;RESTORE PUSHDOWN POINTER
MOVSI CS,(BYTE (7) 177,1)
PUSHJ PP,WWRXE ;WRITE END
SETZM INDEF ;OUT OF IT
JRST BYPAS1
; HERE TO STORE DEFAULT ARGUMENTS
DEF80: AOS .TEMP ;COUNT ONE MORE
PUSHJ PP,SKELI1 ;INITIALIZE SKELETON
HRL V,SX ;SYMBOL NUMBER
PUSH PP,V ;STORE POINTER
TDZA SDEL,SDEL ;ZERO BRACKET COUNT
DEF81: PUSHJ PP,WCHARQ ;WRITE A CHARACTER
PUSHJ PP,GCHAR ;[422] GET A CHARACTER
CAIN C,"<" ;ANOTHER "<"?
AOJA SDEL,DEF81 ;YES, INCREMENT AND WRITE
CAIE C,">" ;CLOSING ANGLE?
JRST DEF81 ;NO, JUST WRITE THE CHAR.
SOJGE SDEL,DEF81 ;YES, WRITE IF NOT END
MOVSI CS,(BYTE (7) 177,2)
PUSHJ PP,WWRXE ;WRITE END OF DUMMY ARGUMENT
PUSHJ PP,GCHAR ;READ AT NEXT CHAR.
CAIE C,")" ;END OF ARGUMENT LIST?
JRST DEF10 ;NO, GET NEXT SYMBOL
JRST DEF12 ;YES, LOOK FOR "<"
SUBTTL MACRO CALL PROCESSOR
CALLM: SKIPGE MACENL ;ARE WE TRYING TO RE-ENTER?
JRST ERRAX ;YES, BOMB OUT WITH ERROR
HRROS MACENL ;FLAG "CALLM IN PROGRESS"
EXCH MP,RP
PUSH MP,V ;STACK FOR REFDEC
EXCH MP,RP
MOVEM AC0,CALNAM ;SAVE MACRO NAME INCASE OF ERROR
FORERR (SDEL,CAL)
ADDI V,1 ;POINT TO DUMMY SYMBOL COUNT
AOS SDEL,0(V) ;INCREMENT ARG COUNT
HLLZM SDEL,.TEMP ;DEFAULT ARG POINTER IF NON-ZERO
LSHC SDEL,-^D<9+36> ;ZERO SDEL, GET ARG COUNT IN SX
ANDI SX,777 ;MASK OUT ANYTHING ELSE
SKIPE .TEMP ;IF AT LEAST ONE DEFAULT ARG
HRRM SX,.TEMP ;STORE COUNT OF ARGS
PUSH PP,V ;STACK FOR MRP
PUSH PP,RP ;STACK FOR MACPNT
JUMPE SX,MAC20 ;TEST FOR NO ARGS
PUSHJ PP,CHARAC
CAIE C,"(" ;"("
TLOA SDEL,-1 ;[137] NO, FUDGE PAREN COUNT AND SKIP
MAC10: PUSHJ PP,GCHAR ;GET A CHARACTER, LOOK FOR AN ARG
JUMPE SDEL,MAC11 ;[137] SKIP TEST IF IN ()
CAIG C,CR
CAIGE C,LF
CAIN C,";" ;";"?
JRST MAC21 ;YES, END OF ARGUMENT STRING
MAC11: IFE TENEX,<
SKIPN DECTAB ;[372] TREAT LEADING TAB UNDER .XTABM AS SPECIAL CASE
JRST MAC11A ;[372]
>
CAIN C,11 ;[372] FLUSH TABS
JRST MAC10 ;[372]
MAC11A: SKIPLE SX ;[372] [137] SKIP IF NO ARGS LEFT
PUSHJ PP,SKELI1 ;NO, INITIALIZE SKELETON
CAIN C,"<" ;"<"?
JRST MAC30 ;YES, PROCESS AS SPECIAL
CAIE C,176
CAIN C,134 ;"\"
JRST MAC40 ;YES, PROCESS SYMBOL
MAC14: CAIN C,"," ;","?
JRST MAC16 ;YES; NULL SYMBOL
IFE TENEX,<
SKIPN DECTAB ;DO TABS DEC'S WAY?
JRST .+3 ;YES
>
CAIN C,11 ;FLUSH TABS
JRST MAC14A
JUMPL SDEL,MAC14B ;[137] IGNORE TEST FOR () IF NOT INSIDE ()
CAIN C,"(" ;"("?
ADDI SDEL,1 ;YES, INCREMENT COUNT
CAIN C,")" ;")"?
SOJL SDEL,MAC16 ;YES, TEST FOR END
MAC14B: SKIPLE SX ;[137] IGNORE IF NO ARGS LEFT
PUSHJ PP,WCHAR ;WRITE INTO SKELETON
MAC14A: PUSHJ PP,CHARAC ;GET NEXT CHARACTER
MAC14E: ;[262] INCASE WE REACHED MACEND
JUMPG SDEL,MAC14 ;[137] IGNORE TEST IF IN ()
CAIG C,CR
CAIGE C,LF
JRST .+2
JRST MAC15 ;TEST FOR END OF LINE
CAIE C,";" ;";"?
JRST MAC14 ;NO
;YES, END OF LINE
MAC15: TLO IO,IORPTC
MAC16: JUMPLE SX,MAC17 ;[137] SKIP IF NO ARGS LEFT
MOVSI CS,(BYTE (7) 177,2)
PUSHJ PP,WWRXE ;WRITE END
EXCH MP,RP
PUSH MP,WWRXX
EXCH MP,RP
MAC17: SUBI SX,1 ;[137] DECREMENT ARG COUNT
JUMPGE SDEL,MAC10 ;[137] IF IN () KEEP LOOKING
TRNN SDEL,(1B0) ;[205] SKIP LOOKING IF SEEN ")"
JUMPG SX,MAC10 ;[137] NO, BUT MORE ARGS TO COME
MAC20: TLZN IO,IORPTC
PUSHJ PP,CHARAC
MAC21: EXCH MP,RP
JUMPE SX,MAC21B ;NO MISSING ARGS
MAC21A: PUSH MP,[-1] ;FILL IN MISSING ARGS
SKIPN .TEMP ;ANY DEFAULT ARGS?
JRST MAC21C ;NO
HRRZ C,.TEMP ;GET ARG COUNT
SUBI C,-1(SX) ;ACCOUNT FOR THOSE GIVEN
HRLZS C ;PUT IN LEFT HALF
HLRZ SDEL,.TEMP ;ADDRESS OF TABLE
MAC21D: SKIPN (SDEL) ;END OF LIST
JRST MAC21C ;YES
XOR C,(SDEL) ;TEST FOR CORRECT ARG
TLNN C,-1 ;WAS IT?
JRST MAC21E ;YES
XOR C,(SDEL) ;BACK THE WAY IT WAS
AOJA SDEL,MAC21D ;AND TRY AGAIN
MAC21E: MOVEM C,(MP) ;REPLACE -1 WITH TREE POINTER
AOS 1(C) ;INCREMENT REFERENCE
MAC21C: SOJG SX,MAC21A
MAC21B: PUSH MP,[0] ;SET TERMINAL
HRRZ C,LIMBO
TLNN IO,IOSALL ;SUPPRESSING ALL?
JRST MAC23 ;NO
JUMPN MRP,MAC27 ;IN MACRO?
PUSHJ PP,SEMSRC ;CHECK FOR IMMEDIATE COMMENT
JRST MAC26 ;NOT FOUND, CONTINUE
MAC22: PUSHJ PP,CHARAC ;YES,GET IT INTO THE LBUF
CAIG C,CR ;LESS THAN CR?
CAIGE C,LF ;AND GREATER THAN LF?
JRST MAC22 ;NO GET ANOTHER
MAC26: PUSHJ PP,DECLBP ;DECREMENT LINE BUFFER POINTER
MAC27: HRLI C,-1 ;SET FLAG
JRST MAC25
MAC23: MOVEI SX,"^"
DPB SX,LBUFP ;SET ^ INTO LINE BUFFER
JUMPAD MAC25 ;BRANCH IF ADDRESS FIELD
JUMPN MRP,MAC25 ;BRANCH IF ALREADY IN A MACRO
SKIPN LITLVL ;[215] BRANCH IF WITHIN A LITERAL
SKIPE RPOLVL ;[215] OR IN A REPEAT
JRST MAC25
PUSHJ PP,RSW3 ;OUTPUT C AGAIN (OVERWRITTEN BY "^")
PUSHJ PP,SEMSRC ;LOOK FOR A COMMENT
JRST MAC24 ;NO COMMENT CONTINUE
PUSHJ PP,STOUT ;LIST COMMENT OR CR-LF
TLNE IO,IOPALL ;MACRO EXPANSION SUPPRESSION?
TLO IO,IOMAC ; NO, SET TEMP BIT
TDOA C,[-1] ;FLAG LAST CHARACTER
MAC24: PUSHJ PP,DECLBP ;DECREMENT BYTE POINTER
MAC25: PUSH MP,MACPNT
POP PP,MACPNT
PUSH MP,C
PUSH MP,RCOUNT ;STACK WORD COUNT
PUSH MP,MRP ;STACK MACRO POINTER
POP PP,MRP ;SET NEW READ POINTER
EXCH MP,RP
AOS MACLVL
HRRZS MACENL ;RESET "CALLM IN PROGRESS"
JUMPOC STMNT2 ;OP-CODE FIELD
JRST EVATOM ;ADDRESS FIELD
;ROUTINE TO LOOK FOR A SEMICOLON, IGNORING SPACES AND TABS
; SKIP IF FOUND
PUSHJ PP,CHARAC ;FETCH ANOTHER CHARACTER
SEMSRC: CAIE C," " ;SPACE?
CAIN C," " ;OR TAB?
JRST .-3 ;YES, GET ANOTHER CHARACTER
CAIN C,";" ;NO, SEMICOLON?
AOS (PP) ;YES, SKIP RETURN
POPJ PP,
;ROUTINE TO DEVREMENT BYTE POINTER LBUFP
DECLBP: HRLZI SX,70000 ;INCREASE P FIELD BY 1 BYTE
ADDB SX,LBUFP
JUMPGE SX,CPOPJ ;RETURN IF NO OVERFLOW
HRLOI SX,347777 ;OVERFLOW, BACKUP ONE WORD
ADDM SX,LBUFP
POPJ PP,
MAC30: MOVEI AC0,0 ;INITIALIZE BRACKET COUNTER
MAC31: PUSHJ PP,GCHAR ;GET A CHARACTER
CAIN C,"<" ;"<"?
ADDI AC0,1 ;YES, INCREMENT COUNT
CAIN C,">" ;">"?
SOJL AC0,MAC14A ;YES, EXIT IF MATCHING
SKIPLE SX ;[137] IGNORE IF NO ARGS LEFT
PUSHJ PP,WCHAR ;WRITE INTO SKELETON
JRST MAC31 ;GO BACK FOR ANOTHER
MAC40: PUSH PP,SX ;STACK REGISTERS
PUSH PP,SDEL
HLLM IO,TAGINC ;SAVE IO FLAGS
PUSHJ PP,CELL ;GET AN ATOM
MOVE V,AC0 ;ASSUME NUMERIC
TLNE IO,NUMSW ;GOOD GUESS?
JRST MAC41 ;YES
PUSHJ PP,SSRCH ;SEARCH THE SYMBOL TABLE
TROA ER,ERRX ;NOT FOUND, ERROR
MAC41: PUSHJ PP,MAC42 ;FORM ASCII STRING
HLL IO,TAGINC ;RESTORE IO FLAGS
POP PP,SDEL
POP PP,SX
TLO IO,IORPTC ;REPEAT LAST CHARACTER
JRST MAC14A ;RETURN TO MAIN SCAN
MAC42: JUMPLE SX,CPOPJ ;[137] NO ARGS LEFT
MOVE C,V
MAC44: LSHC C,-^D35
LSH CS,-1
DIVI C,0(RX) ;DIVIDE BY CURRENT RADIX
HRLM CS,0(PP)
JUMPE C,.+2 ;TEST FOR END
PUSHJ PP,MAC44
HLRZ C,0(PP)
ADDI C,"0" ;FORM TEXT
JRST WCHAR ;WRITE INTO SKELETON
MACEN0: SOS MACENL
MACEND: HRRZ C,0(PP) ;[262] GET TOP ADDRESS
CAIN C,MAC14E ;[262] WERE WE LOOKING FOR CLOSE PAREN?
JUMPGE SDEL,MPAERR ;[262] YES, GIVE USEFUL ERROR MESSAGE
SKIPGE C,MACENL ;TEST "CALLM IN PROGRESS"
AOS MACENL ;INCREMENT END LEVEL AND EXIT
JUMPL C,REPEA8
EXCH MP,RP
POP MP,MRP ;RETRIEVE READ POINTER
POP MP,RCOUNT ;AND WORD COUNT
MOVEI C,"^"
SKIPL 0(MP) ;TEST FLAG
PUSHJ PP,RSW2 ;MARK END OF SUBSTITUTION
POP MP,C
POP MP,ARG
SKIPA MP,MACPNT ;RESET MP AND SKIP
MACEN1: PUSHJ PP,REFDEC ;DECREMENT REFERENCE
MACEN2: AOS V,MACPNT ;GET POINTER
MOVE V,0(V)
JUMPG V,MACEN1 ;IF >0, DECREMENT REFERENCE
JUMPL V,MACEN2 ;IF <0, BYPASS
POP MP,V ;IF=0, RETRIEVE POINTER
PUSHJ PP,REFDEC ;DECREMENT REFERENCE
MOVEM ARG,MACPNT
EXCH MP,RP
SOS MACLVL
SKIPN MACENL ;CHECK UNPROCESSED END LEVEL
JRST MACEN3 ;NONE TO PROCESS
TRNN MRP,-1 ;MRP AT END OF TEXT
JRST MACEN0 ;THEN POP THE MACRO STACK NOW
MACEN3: TRNN C,77400 ;SALL FLAG?
HRLI C,0 ;YES,TURN IT OFF
JUMPL C,REPEA8 ;IF FLAG SET SUBSTITUTE
JRST RSW2
IRP0: SKIPN MACLVL ;ARE WE IN A MACRO?
JRST ERRAX ;NO, BOMB OUT
IRP10: PUSHJ PP,MREADS ;YES, GET DATA SPEC
CAIE C,40 ;SKIP LEADING BLANKS
CAIN C,"(" ;"("?
JRST IRP10 ;YES, BYPASS
CAIN C,11
JRST IRP10
CAIE C,177 ;NO, IS IT SPECIAL?
JRST ERRAX ;NO, ERROR
PUSHJ PP,MREADS ;YES
TRZN C,100 ;CREATED?
JRST ERRAX
CAIL C,40 ;TOO BIG?
JRST ERRAX
ADD C,MACPNT ;NO, FORM POINTER TO STACK
PUSH MP,IRPCF ;STACK PREVIOUS POINTERS
PUSH MP,IRPSW
PUSH MP,IRPARP
PUSH MP,IRPARG
PUSH MP,IRPCNT
PUSH MP,0(C)
PUSH MP,IRPPOI
HRRZM C,IRPARP
MOVEM AC0,IRPCF ;IRPC FLAG FOUND IN AC0
SETOM IRPSW ;RESET IRP SWITCH
MOVE CS,0(C)
MOVEM CS,IRPARG
IRP15: PUSHJ PP,MREADS ;[351] GET A CHARACTER LOOKING FOR "<"
CAIE C,"<" ;"<"?
JRST [CAIE C,"," ;[426] IGNORE COMMA
CAIG C," " ;[351] IGNORE TEXT-FORMATTING CHARACTERS
JRST IRP15 ;[351]
CAIE C,")" ;[361] IGNORE CLOSE PARENTHESIS
CAIN C,">" ;[426] IGNORE RIGHT ANGLE BRACKET
JRST IRP15 ;[354] GO BACK FOR ANOTHER
JRST IRPMBI] ;[351] CAN'T FIND BRACKET (OR ILL CHAR)
PUSHJ PP,SKELI1 ;INITIALIZE NEW STRING
MOVEM ARG,IRPPOI ;SET NEW POINTER
TDZA SDEL,SDEL ;ZERO BRACKET COUNT AND SKIP
IRP20: PUSHJ PP,WCHAR1
PUSHJ PP,MREADS
CAIN C,"<" ;"<"?
AOJA SDEL,IRP20 ;YES, INCREMENT COUNT AND WRITE
CAIE C,">" ;">"?
JRST IRP20 ;NO, JUST WRITE IT
SOJGE SDEL,IRP20 ;YES, WRITE IF NOT MATCHING
MOVE CS,[BYTE (7) 15,177,4]
PUSHJ PP,WWRXE ;WRITE END
PUSH MP,MRP ;STACK PREVIOUS READ POINTER
PUSH MP,RCOUNT ;AND WORD COUNT
SKIPG CS,IRPARG
JRST IRPPOP ;EXIT IF NOT VALID ARGUMENT
MOVEI C,1(CS) ;INITIALIZE POINTER
MOVEM C,IRPARG
IRPSET: EXCH MRP,IRPARG ;SWAP READ POINTERS
MOVE SX,RCOUNT ;SWAP COUNT OF WORDS TO READ
EXCH SX,IRPCNT
MOVEM SX,RCOUNT
PUSHJ PP,SKELI1 ;INITIALIZE SKELETON FOR DATA
HRRZM ARG,@IRPARP ;STORE NEW DS POINTER
SETZB SX,SDEL ;ZERO FOUND FLAG AND BRACKET COUNT
LDB C,MRP ;GET LAST CHAR
CAIN C,","
SKIPE IRPCF ;IN IRPC
JRST IRPSE1 ;NO
MOVEI SX,1 ;FORCE ARGUMENT
IRPSE1: PUSHJ PP,MREADS
CAIE C,177 ;SPECIAL?
AOJA SX,IRPSE2 ;NO, FLAG AS FOUND
PUSHJ PP,PEEKM ;LOOK AT NEXT CHARACTER
SETZM IRPSW ;SET IRP SWITCH
JUMPG SX,IRPSE4 ;IF ARG FOUND, PROCESS IT
JRST IRPPOP ;NO, CLEAN UP AND EXIT
IRPSE2: SKIPE IRPCF ;IRPC?
JRST IRPSE3 ;YES, WRITE IT
CAIN C,"," ;NO, IS IT A COMMA?
JUMPE SDEL,IRPSE4 ;YES, EXIT IF NOT NESTED
CAIN C,"<" ;"<"?
ADDI SDEL,1 ;YES, INCREMENT COUNT
CAIN C,">" ;">"?
SUBI SDEL,1 ;YES, DECREMENT COUNT
IRPSE3: PUSHJ PP,WCHAR
SKIPN IRPCF ;IRPC?
JRST IRPSE1 ;NO, GET NEXT CHARACTER
IRPSE4: MOVSI CS,(BYTE (7) 177,2)
PUSHJ PP,WWRXE ;WRITE END
MOVEM MRP,IRPARG ;SAVE POINTER
MOVE MRP,RCOUNT ;SAVE COUNT
MOVEM MRP,IRPCNT
HRRZ MRP,IRPPOI ;SET FOR NEW SCAN
AOJA MRP,REPEA8 ;ON ARG COUNT
IRPMBI: PUSHJ PP,EFATAL ;[351]FATAL ERROR,TYPE ?MCR
MOVE AC0,CALNAM ;[351]FETCH MACRO NAME
SKIPN IRPCF ;[354] IRPC?
JRST [MOVSI RC,[SIXBIT/MBI MISSING OPEN BRACKET FOR IRP INSIDE MACRO@/] ;[354] NO
JRST IRPERR] ;[354]
MOVSI RC,[SIXBIT/MBI MISSING OPEN BRACKET FOR IRPC INSIDE MACRO@/] ;[351]
IRPERR: PUSHJ PP,TYPMSG ;[354] [351]OUTPUT MESSAGE
JUMP1 .+2 ;[351]ONLY COUNT ERROR ONCE
AOS ERRCNT ;[351]DO DURING PASS2
JRST ERRNE2 ;[351]COMMON MESSAGE
STOPI0: SKIPN IRPARP ;IRP IN PROGRESS?
JRST ERRAX ;NO, ERROR
SETZM IRPSW ;YES, SET SWITCH
POPJ PP,
IRPEND: MOVE V,@IRPARP
PUSHJ PP,REFDEC
SKIPE IRPSW ;MORE TO COME?
JRST IRPSET ;YES
IRPPOP: MOVE V,IRPPOI
PUSHJ PP,REFDEC ;DECREMENT REFERENCE
POP MP,RCOUNT
POP MP,MRP ;RESTORE CELLS
POP MP,IRPPOI
POP MP,@IRPARP
POP MP,IRPCNT
POP MP,IRPARG
POP MP,IRPARP
POP MP,IRPSW
POP MP,IRPCF
JRST REPEA8
GETDS: ;GET DUMMY SYMBOL NUMBER
MOVE CS,C ;USE CS FOR WORK REGISTER
ANDI CS,37 ;MASK
ADD CS,MACPNT ;ADD BASE ADDRESS
MOVE V,0(CS) ;GET POINTER FLAG
JUMPG V,GETDS1 ;BRANCH IF POINTER
TRNN C,40 ;NOT POINTER, SHOULD WE CREATE?
JRST RSW0 ;NO, FORGET THIS ARG
PUSH PP,WWRXX
PUSH PP,MWP ;STACK MACRO WRITE POINTER
PUSH PP,WCOUNT ;SAVE WORD COUNT
PUSHJ PP,SKELI1 ;INITIALIZE SKELETON
MOVEM ARG,0(CS) ;STORE POINTER
MOVE CS,[BYTE (7) 0,170,170,170,171] ;CREATE A SYMBOL
ADD CS,LSTSYM ;LSTSYM= # OF LAST CREATED
TDZ CS,[BYTE (7) 0,170,170,170,170]
MOVEM CS,LSTSYM
IOR CS,[ASCII /.0000/]
MOVEI C,"."
PUSHJ PP,WCHAR
PUSHJ PP,WWORD ;WRITE INTO SKELETON
MOVSI CS,(BYTE (7) 177,2)
PUSHJ PP,WWRXE ;WRITE END CODE
POP PP,WCOUNT ;RESTORE WORD COUNT
POP PP,MWP ;RESTORE MACRO WRITE POINTER
POP PP,WWRXX
MOVE V,ARG ;SET UP FOR REFINC
GETDS1: PUSHJ PP,REFINC ;INCREMENT REFERENCE
HRL V,RCOUNT ;SAVE WORD COUNT
PUSH MP,V ;STACK V FOR DECREMENT
PUSH MP,MRP ;STACK READ POINTER
MOVEI MRP,1(V) ;FORM READ POINTER
JRST RSW0 ;EXIT
DSEND: POP MP,MRP
POP MP,V
HLREM V,RCOUNT ;RESTORE WORD COUNT
HRRZS V ;CLEAR COUNT
PUSHJ PP,REFDEC ;DECREMENT REFERENCE
JRST RSW0 ;EXIT
SKELI1: MOVEI ARG,1 ;ENTRY FOR SINGLE ARG
SKELI: SETZ MWP, ;SIGNAL FIRST TIME THROUGH
PUSHJ PP,SKELWL ;GET POINTER WORD
HRRZM MWP,WWRXX ;SAVE FIRST ADDRESS
HRRZM MWP,LADR ;SAVE START OF LINKED LIST
HRRZM ARG,1(MWP) ;STORE COUNT
SOS WCOUNT ;ACCOUNT FOR WORD
HRRZ ARG,WWRXX ;SET FIRST ADDRESS
ADDI MWP,2 ;BUMP POINTER
HRLI MWP,(POINT 7) ;SET FOR 5 ASCII BYTES
;SKELW RETURNS WITH ADR OF NEXT FREE LOC IN V (RIGHT)
SKELW: SOSLE WCOUNT ;STILL SOME SPACE IN LEAF?
POPJ PP, ;YES, RETURN
SKELWL: SKIPE V,NEXT ;GET FIRST FREE ADDRESS
JRST SKELW1 ;IF NON-ZERO, UPDATE FREE
MOVE V,FREE ;GET FREE
ADDI V,.LEAF ;INCREMENT BY LEAF SIZE
CAML V,SYMBOL ;OVERFLOW?
PUSHJ PP,XCEED ;YES, BOMB OUT
EXCH V,FREE ;UPDATE FREE
SETZM (V) ;CLEAR LINK
SKELW1: HLL V,0(V) ;GET ADDRESS
HLRM V,NEXT ;UPDATE NEXT
SKIPE MWP ;IF FIRST TIME
HRLM V,1-.LEAF(MWP) ;STORE LINK IN FIRST WORD OF LEAF
MOVEI MWP,.LEAF ;SIZE OF LEAF
MOVEM MWP,WCOUNT ;STORE FOR COUNT DOWN
MOVEI MWP,(V) ;SET UP WRITE POINTER
TLO MWP,(POINT 7,,20) ;2 ASCII CHARS
POPJ PP,
;WWRXX POINTS TO END OF TREE
;MWP IDPB POINTER TO NEXT HOLE
;NEXT FIRST OF A LINKED PORTION THAT IS NOT BEING USED (LEAVES)
;FREE POINTS TO FREE CORE BETWEEN TREE AND SYM-TABLE
;LADR POINTS TO BEG OF LINKED PORTION.
GCHARQ: JUMPN MRP,MREADS ;IF GETTING CHAR. FROM TREE
GCHAR: PUSHJ PP,CHARAC ;GET ASCII CHARACTER
CAIG C,FF ;TEST FOR LF, VT OR FF
CAIGE C,LF
POPJ PP, ;NO
JRST OUTIM1 ;YES, LIST IT
WCHARQ:
WCHAR:
WCHAR1: TLNN MWP,760000 ;END OF WORD?
PUSHJ PP,SKELW ;YES, GET ANOTHER
IDPB C,MWP ;STORE CHARACTER
POPJ PP,
WWORD: LSHC C,7 ;MOVE ASCII INTO C
PUSHJ PP,WCHAR1 ;STORE IT
JUMPN CS,WWORD ;TEST FOR END
POPJ PP, ;YES, EXIT
WWRXE: PUSHJ PP,WWORD ;WRITE LAST WORD
ADD MWP,WCOUNT ;GET TO END OF LEAF
SUBI MWP,.LEAF ;NOW POINT TO START OF IT
HRRZS (MWP) ;ZERO LEFT HALF OF LAST LEAF
HRRM MWP,@WWRXX ;SET POINTER TO END
POPJ PP,
MREAD: PUSHJ PP,MREADS ;READ ONE CHARACTER
CAIE C,177 ;SPECIAL?
JRST RSW1 ;NO, EXIT
PUSHJ PP,MREADS ;YES, GET CODE WORD
TRZE C,100 ;SYMBOL?
JRST GETDS ;YES
CAILE C,4 ;POSSIBLY ILLEGAL
JRST ERRAX ;YUP
HRRI MRP,0 ;NO, SIGNAL END OF TEXT
JRST .+1(C)
PUSHJ PP,XCEED
JRST MACEND ;1; END OF MACRO
JRST DSEND ;2; END OF DUMMY SYMBOL
JRST REPEND ;3; END OF REPEAT
JRST IRPEND ;4; END OF IRP
MREADI: HRLI MRP,700 ;SET UP BYTE POINTER
MOVEI C,.LEAF-1 ;NUMBER OF WORDS
MOVEM C,RCOUNT
MREADS: TLNN MRP,-1 ;FIRST TIME HERE?
JRST MREADI ;YES, SET UP MRP AND RCOUNT
TLNN MRP,760000 ;HAVE WE FINISHED WORD?
SOSLE RCOUNT ;YES, STILL ROOM IN LEAF?
JRST MREADC ;STILL CHAR. IN LEAF
HLRZ MRP,1-.LEAF(MRP);YES, GET LINK
HRLI MRP,(POINT 7,,20) ;SET POINTER
MOVEI C,.LEAF ;RESET COUNT
MOVEM C,RCOUNT
MREADC: ILDB C,MRP ;GET CHARACTER
POPJ PP,
PEEK: JUMPN MRP,PEEKM ;THIS IS A MACRO READ
PUSHJ PP,CHARAC ;READ AN ASCII CHAR.
TLO IO,IORPTC ;REPEAT FOR NEXT
POPJ PP, ;AND RETURN
PEEKM: PUSH PP,MRP ;SAVE MACRO READ POINTER
PUSH PP,RCOUNT ;SAVE WORD COUNT
PUSHJ PP,MREADS ;READ IN A CHAR.
POP PP,RCOUNT ;RESTORE WORD COUNT
POP PP,MRP ;RESET READ POINTER
POPJ PP, ;IORPTC IS NOT SET
REFINC: AOS 1(V) ;INCREMENT REFERENCE
POPJ PP,
REFDEC: JUMPLE V,DECERR ;CATASTROPHIC ERROR SOMEWHERE
SOS CS,1(V) ;DECREMENT REFERENCE
TRNE CS,000777 ;IS IT ZERO?
POPJ PP, ;NO, EXIT
CAMGE V,UNITOP ;[225] IS THIS IN UNIV AREA?
JRST [AOS 1(V) ;[371][225] YES, PUT IT BACK TO DEFINING REFERENCE COUNT
POPJ PP,] ;[371] AND DO NOT DELETE IT
HRRZ CS,0(V) ;YES, GET POINTER TO END
HRL CS,NEXT ;GET POINTER TO NEXT RE-USABLE
HLLM CS,0(CS) ;SET LINK
HRRM V,NEXT ;RESET NEXT
POPJ PP,
DECERR: PUSHJ PP,EFATAL ;OUTPUT CR-LF ? MCR
MOVE AC0,CALNAM ;GET MACRO NAME
MOVSI RC,[SIXBIT /EWE ERROR WHILE EXPANDING@/]
PUSHJ PP,TYPMSG
JRST ERRNE2 ;COMMON MESSAGE
MPAERR: PUSHJ PP,EFATAL ;OUTPUT CR-LF ? MCR
MOVE AC0,CALNAM ;GET MACRO NAME
MOVSI RC,[SIXBIT /MPA MISSING CLOSE PAREN AROUND ARG LIST OF@/]
PUSHJ PP,TYPMSG
JRST ERRNE2 ;COMMON MESSAGE
A== 0 ;ASCII MODE
AL== 1 ;ASCII LINE MODE
IB== 13 ;IMAGE BINARY MODE
B== 14 ;BINARY MODE
; == 0 ;USED BY HELPER AND GETSEGS
CTL== 1 ;CONTROL DEVICE NUMBER
IFN CCLSW,<CTL2==5 ;INPUT DEV FOR CCL FILE>
BIN== 2 ;BINARY DEVICE NUMBER
CHAR== 3 ;INPUT DEVICE NUMBER
LST== 4 ;LISTING DEVICE NUMBER
UNV== 6 ;SYMBOL TABLE FILE (UNIVERSAL)
; COMMAND STRING ACCUMULATORS
ACDEV== 1 ;DEVICE
ACFILE==2 ;FILE
ACEXT== 3 ;EXTENSION
ACPPN== 4 ;PPN
ACDEL== 4 ;DELIMITER
ACPNTR==5 ;BYTE POINTER
TIO== 6
TIORW== 1000
TIOLE== 2000
TIOCLD==20000
DIRBIT==4 ;DIRECTORY DEVICE
TTYBIT==10 ;TTY
MTABIT==20 ;MTA
DTABIT==100 ;DTA
DISBIT==2000 ;DISPLAY
CONBIT==20000 ;CONTROLING TTY
LPTBIT==40000 ;LPT
DSKBIT==200000 ;DSK
;GETSTS ERROR BITS
IOIMPM==400000 ;IMPROPER MODE (WRITE LOCK)
IODERR==200000 ;DEVICE DATA ERROR
IODTER==100000 ;CHECKSUM OR PARITY ERROR
IOBKTL== 40000 ;BLOCK TOO LARGE
ERRBIT==IOIMPM!IODERR!IODTER!IOBKTL
SYN .TEMP,PPN
SUBTTL I/O ROUTINES
BEG:
IFN CCLSW,<TLZA IO,ARPGSW ;DON'T ALLOW RAPID PROGRAM GENERATION
TLO IO,ARPGSW ;ALLOW RAPID PROGRAM GENERATION>
IFN PURESW,<
MOVE MRP,[XWD LOWL,LOWL+1] ;START OF DATA
SETZM LOWL ;ZERO FIRST WORD
BLT MRP,LOWEND ;AND THE REST
MOVE MRP,[XWD LOWH,LOWL] ;PHASED CODE
BLT MRP,LOWL+LENLOW ;MOVE IT IN>
HRRZ MRP,.JBREL ;GET LOWSEG SIZE
IFN TENEX,<
CAIL MRP,377777 ;[206] DO WE HAVE ALL OF CORE?
JRST .+4 ;[206] YES
MOVEI MRP,377777 ;[206] NO, MAY AS WELL GET IT
CORE MRP, ;[206] IT WILL SAVE EXPANSION LATER
JFCL ;[206] TOO BAD
HRRZ MRP,.JBREL ;[206] GET HIGHEST LOC
>
MOVEM MRP,MACSIZ ;SAVE CORE SIZE
;DECODE VERSION NUMBER
MOVEI PP,JOBFFI ;TEMP PUSH DOWN STACK
PUSH PP,[0] ;MARK BOTTOM OF STACK
LDB 0,[POINT 3,.JBVER,2] ;GET USER BITS
JUMPE 0,GETE ;NOT SET IF ZERO
ADDI 0,"0" ;FORM NUMBER
PUSH PP,0 ;STACK IT
MOVEI 0,"-" ;SEPARATE BY HYPHEN
PUSH PP,0 ;STACK IT ALSO
GETE: HRRZ 0,.JBVER ;GET EDIT NUMBER
JUMPE 0,GETU ;SKIP ALL THIS IF ZERO
MOVEI 1,")" ;ENCLOSE IN PARENS.
PUSH PP,1
GETED: IDIVI 0,8 ;GET OCTAL DIGITS
ADDI 1,"0" ;MAKE ASCII
PUSH PP,1 ;STACK IT
JUMPN 0,GETED ;LOOP TIL DONE
MOVEI 0,"(" ;OTHER PAREN.
PUSH PP,0
GETU: LDB 0,[POINT 6,.JBVER,17] ;UPDATE NUMBER
JUMPE 0,GETV ;SKIP IF ZERO
IDIVI 0,^D26 ;[224] MIGHT BE TWO DIGITS
ADDI 1,"@" ;FORM ALPHA
PUSH PP,1
JUMPN 0,GETU+1 ;LOOP IF NOT DONE
GETV: LDB 0,[POINT 9,.JBVER,11] ;GET VERSION NUMBER
IDIVI 0,8 ;GET DIGIT
ADDI 1,"0" ;TO ASCII
PUSH PP,1 ;STACK
JUMPN 0,GETV+1 ;LOOP
MOVE 1,[POINT 7,VBUF+1,20] ;POINTER TO DEPOSIT IN VBUF
POP PP,0 ;GET CHARACTER
IDPB 0,1 ;DEPOSIT IT
JUMPN 0,.-2 ;KEEP GOING IF NOT ZERO
IFN FORMSW,<IFE DFRMSW,<
SETOM PHWFMT ;HALF WORD UNLESS CHANGED BY SWITCH>>
IFN CCLSW,<
TLZA IO,CRPGSW ;SET TO INIT NEW COMMAND FILE
M: TLNN IO,CRPGSW ;CURRENTLY DOING RPG?>
IFE CCLSW,<M:>
RESET ;INITIALIZE PROGRAM
SETZM BINDEV ;CLEAR INCASE NOT USED NEXT TIME
SETZM LSTDEV ;SAME REASON
SETZM INDEV ;INCASE OF ERROR
HRRZ MRP,MACSIZ ;GET INITIAL SIZE
CORE MRP, ;BACK TO ORIGINAL SIZE
JFCL ;SHOULD NEVER FAIL
SETZB MRP,PASS1I
MOVE [XWD PASS1I,PASS1I+1]
BLT PASS2X-1 ;ZERO THE PASS1 AND PASS2 VARIABLES
MOVEI PP,JOBFFI ;SET TEMP PUSH-DOWN POINTER
IFN FORMSW,<
MOVE CS,PHWFMT ;GET DEFAULT VALUE (PERMANENT)
MOVEM CS,HWFMT ;SET IT (TEMP) >
MOVE CS,[POINT 7,DBUF,6] ;INITIALIZE FOR DATE
MSTIME 2, ;GET TIME FROM MONITOR
PUSHJ PP,TIMOUT ;TIME FORMAT OUTPUT
DATE 1, ;GET DATE
IBP CS ;PASS OVER PRESET SPACE
PUSHJ PP,DATOUT ;DATE FORMAT OUTPUT
MOVSI FR,P1!CREFSW
IFN CCLSW,<TLNE IO,CRPGSW ;RPG IN PROGRESS?
JRST GOSET ;YES, GO READ NEXT COMMAND
TLNE IO,ARPGSW ;NO, RPG ALLOWED?
JRST RPGSET ;YES, GO TRY
CTLSET: RELEASE CTL2, ;IN CASE OF LOOKUP FAILURE>
IFE CCLSW,<CTLSET:>
MOVSI IO,IOPALL ;ZERO FLAGS
INIT CTL,AL ;INITIALIZE USER CONSOLE
SIXBIT /TTY/
XWD CTOBUF,CTIBUF
EXIT ;NO TTY, NO ASSEMBLY
MOVSI C,'TTY'
DEVCHR C, ;GET CHARACTERISTICS
TLNN C,10 ;IS IT REALLY A TTY
EXIT ;NO
INBUF CTL,1 ;INITIALIZE SINGLE CONTROL
OUTBUF CTL,1 ;BUFFERS
PUSHJ PP,CRLF ;OUTPUT CARRIAGE RETURN - LINE FEED
MOVEI C,"*"
IDPB C,CTOBUF+1
OUTPUT CTL,
MOVE AC1,[POINT 7,CTLBUF] ;BYTE POINTER TO STORE COMMAND
MOVEI AC2,1 ;[277] INITIALIZE CHARACTER COUNT
CTLS2: SOSGE CTIBUF+2 ;USUAL SOSG LOOP ON TTY INPUT
INPUT CTL, ;GET NEXT BUFFER
ILDB 0,CTIBUF+1 ;GET CHARACTER
CAIL AC2,CTLSIZ ;NUMBER OF CHARS. ALLOWED
JRST COMERR ;COMMAND LINE TOO LONG
CAIN 0,CZ ;TEST FOR ^Z
JRST CZSTOP ;MONRET TYPE EXIT
IDPB 0,AC1 ;STORE CHAR.
CAIE 0,33 ;TEST FOR ALTMODE
CAIG 0,FF ;TEST FOR EOL CHAR
CAIGE 0,LF ;ONE OF FF, VT, OR LF
AOJA AC2,CTLS2 ;NOT END OF LINE YET
MOVEM AC2,CTIBUF+2 ;RESET CHAR. COUNT
MOVE AC1,[POINT 7,CTLBUF] ;BYTE POINTER TO STORE COMMAND
MOVEM AC1,CTIBUF+1 ;RESET BYTE POINTER
IFN CCLSW,<JRST BINSET ;BEGIN WITH BINARY FILE
RPGSET:
IFN TEMP,<HRRZ 3,.JBFF ;GET START OF BUFFER AREA
HRRZ 0,.JBREL ;GET TOP OF CORE
CAIGE 0,200(3) ;WILL BUFFER FIT?
JRST [ADDI 0,200 ;NO, GET ENUF CORE
CORE 0, ;CORE UUO
JRST XCEED2 ;FAILED, SO GIVE UP
JRST .+1] ;CONTINUE
HRRM 3,TMPFIL+1 ;STORE IN TMPCOR UUO IOWD
SOS TMPFIL+1 ;MAKE IT THE PROPER IOWD FORMAT
HRRM 3,CTLBLK+1 ;DUMMY UP BUFFER HEADER
MOVE 0,[2,,TMPFIL] ;SET UP FOR TEMP CORE READ
TMPCOR ;READ AND DELETE FILE "MAC"
JRST RPGTMP ;NO SUCH FILE IN CORE TRY DISK
ADD 3,0 ;CALCULATE END OF BUFFER
MOVEM 3,.JBFF ;FIX JOBFF SO FILE WONT BE KILLED
IMULI 0,5 ;CALCULATE CHARACTER COUNT
ADDI 0,1 ;SINCE SOSG HAPPENS AFTER NOT BEFORE
MOVEM 0,CTLBLK+2 ;SET UP CHAR CNT IN BUFFER HEADER
MOVEI 0,440700 ;SET UP BYTE POINTER IN HEADER
HRLM 0,CTLBLK+1 ;BUFFER HEADER NOW SET UP
SETOM TMPFLG ;MARK THAT A TMPCOR UUO WAS DONE
JRST RPGS2A ;CONTINUE IN MAIN STREAM
RPGTMP: SETZM TMPFLG ;JUST IN CASE>
INIT CTL2,AL ;LOOK FOR DISK
SIXBIT /DSK/ ;...
XWD 0,CTLBLK ;...
JRST CTLSET ;DSK NOT THERE
HRLZI 3,'MAC' ;###MAC
MOVEI 3 ;COUNT
PJOB AC1, ;RETURNS JOB NO. TO AC1
RPGLUP: IDIVI AC1,12 ;CONVERT
ADDI AC2,"0"-40 ;SIXBITIZE IT
LSHC AC2,-6 ;
SOJG 0,RPGLUP ;3 TIMES
MOVEM 3,CTLBUF ;###MAC
HRLZI 'TMP' ;
MOVEM CTLBUF+1 ;TMP
SETZM CTLBUF+3 ;PROG-PRO
LOOKUP CTL2,CTLBUF ;COMMAND FILE
JRST CTLSET ;NOT THERE
HLRM EXTMP ;SAVE THE EXTENSION
RPGS2: INBUF CTL2,1 ;SINGLE BUFFERED
RPGS2A: INIT CTL,AL ;TTY FOR CONSOLE MESSAGES
SIXBIT /TTY/ ;...
XWD CTOBUF,0 ;...
EXIT ;NO TTY, NO ASSEMBLY
OUTBUF CTL,1 ;SINGLE BUFFERED
MOVE .JBFF ;REMEMBER WHERE BINARY BUFFERS BEGIN
MOVEM SAVFF ;...
HRRZ .JBREL ;TOP OF CORE
CAMLE MACSIZ ;SEE IF IT HAS GROWN
MOVEM MACSIZ ;PREVENTS ADDRESS CHECK ON EXIT
TLNE IO,CRPGSW ;ARE WE ALREADY IN RPG MODE?
JRST M ;MUST HAVE COME FROM @ COMMAND, RESET
GOSET: MOVSI IO,IOPALL!CRPGSW ;SET INITIAL FLAGS
MOVEI CS,CTLSIZ ;MAXIMUM CHARS IN A LINE
MOVE AC1,CTLBLK+2 ;NUMBER OF CHARACTERS
MOVEM AC1,CTIBUF+2 ;SAVE FOR PASS 2
MOVE AC1,[POINT 7,CTLBUF] ;WHERE TO STASH CHARS
MOVEM AC1,CTIBUF+1 ;...
GOSET1: SOSG CTLBLK+2 ;ANY MORE CHARS?
PUSHJ PP,[IFN TEMP,<SKIPE TMPFLG ;TMPCOR UUO IN PROGRESS?
EXIT ;YES EXIT>
IN CTL2, ;READ ANOTHER BUFFERFUL
POPJ PP, ;EVERYTHING OK, RETURN
STATO CTL2,20000 ;EOF?
JRST [HRROI RC,[SIXBIT /ECF ERROR READING COMMAND FILE@/]
JRST ERRFIN] ;GO COMPLAIN
PUSHJ PP,DELETE ;CMD FILE
EXIT] ;EOF AND FINISHED
ILDB C,CTLBLK+1 ;GET NEXT CHAR
MOVE RC,@CTLBLK+1 ;CHECK FOR SEQUENCE NUMBERS
TRNE RC,1 ;...
JRST [AOS CTLBLK+1 ;SKIP OVER ANOTHER 5 CHARS
MOVNI RC,5 ;...
ADDM RC,CTLBLK+2 ;...
JRST GOSET1 ] ;GO READ ANOTHER CHAR
JUMPE C,GOSET1 ;IGNORE NULLS
CAIE C," " ;[131] IGNORE SPACES
CAIN C," " ;[131] AND TABS
JRST GOSET1 ;[131] ALSO, SAVES SPACE AND COMMAND ERROR
IDPB C,CTIBUF+1 ;STASH AWAY
AOS CTIBUF+2 ;INCREMENT CHAR. COUNT
CAIE C,12 ;LINE FEED OR
CAIN C,175 ;ALTMODE?
JRST GOSET2 ;YES, FINISHED WITH COMMAND
CAIE C,176
CAIN C,33
JRST GOSET2 ;ALTMODE.
SOJG CS,GOSET1 ;GO READ ANOTHER
JRST COMERR ;GO COMPLAIN
GOSET2: MOVEI C,12 ;MAKE SURE THERE'S A LF
IDPB C,CTIBUF+1 ;...
MOVEM AC1,CTIBUF+1 ;SET POINTER TO BEGINNING
AOS CTIBUF+2 ;ADD I TO COUNT
MOVE SAVFF ;RESET JOBFF FOR NEW BINARY
MOVEM .JBFF ;...
JRST BINSET
RPGS1: PUSHJ PP,DELETE ;DELETE COMMAND FILE
MOVEM ACDEV,RPGDEV ;GET SET TO INIT
OPEN CTL2,RPGINI ;DO IT
JRST EINIT ;ERROR
MOVEM ACFILE,INDIR ;USE INPUT BLOCK
MOVEM ACPPN,INDIR+3 ;SET PPN
HLLZM ACEXT,INDIR+1 ;SET FILE EXTENSION
JUMPN ACEXT,RPGS1A ;[132] EXPLICIT EXTENSION GIVEN, USE IT
IFE STANSW,<MOVSI ACEXT,'CCL' ;IF BLANK TRY CCL>
IFN STANSW,<MOVSI ACEXT,'RPG' ;IF BLANK TRY RPG>
HLLZM ACEXT,INDIR+1 ;[132] STORE DEFAULT EXT
LOOKUP CTL2,INDIR ;[132]
SKIPA ACEXT,INDIR+1 ;[132] FAILED, PICKUP EXT AND ERROR CODE
JRST RPGS1B ;[132] SUCCESS
TRNE ACEXT,-1 ;[132] CHECK FOR ERROR CODE OTHER THAN 0
JRST RPGLOS ;[132] YES, YOU LOSE
SETZB ACEXT,INDIR+1 ;[132] TRY NULL EXT
RPGS1A: LOOKUP CTL2,INDIR ;[132]
JRST RPGLOS ;[132] TOTAL FAILURE
RPGS1B: HLRM ACEXT,EXTMP ;[132] SAVE THE EXTENSION
HLRZ .JBSA ;RESET JOBFF TO ORIGINAL
MOVEM .JBFF
TLO IO,CRPGSW ;TURN ON SWITCH SO WE RESET WORLD
JRST RPGS2 ;AND GO
RPGLOS: RELEAS CTL2,0
TLZ IO,CRPGSW ;STOPS IO TO UNASGD CHAN
JRST ERRCF ;NO FILE FOUND
>
BINSET: PUSHJ PP,NAME1 ;GET FIRST NAME
JRST BINSE3 ;NO FILE HERE
HLLZ ACEXT,ACEXT ;[427] DISALLOW NULL EXTENSIONS
IFN CCLSW,<CAIN C,"!" ;WAS THIS AN IMPERATIVE?
JRST NUNSET ;GET THEE TO A NUNNERY
CAIN C,"@" ;CHECK FOR A NEW RPG FILE
JRST RPGS1>
TLNN FR,CREFSW ;CROSS REF REQUESTED?
JRST LSTSE1 ;YES, SKIP BINARY
CAIN C,"," ;COMMA?
JUMPE ACDEV,LSTSET ;YES, SKIP BINARY IF NO DEVICE SPECIFIED
CAIN C,"_" ;LEFT ARROW?
JUMPE ACDEV,LSTSE1 ;YES, SKIP BINARY IF NO DEVICE SPECIFIED
JUMPE ACDEV,M ;IGNORE IF JUST <CR-LF>
TLO FR,PNCHSW ;OK, SET SWITCH
MOVEM ACDEV,BINDEV ;STORE DEVICE NAME
MOVEM ACFILE,BINDIR ;STORE FILE NAME IN DIRECTORY
JUMPN ACEXT,.+2 ;EXTENSION SPECIFIED?
MOVSI ACEXT,'REL' ;NO, ASSUME RELOCATABLE BINARY
MOVEM ACEXT,BINDIR+1 ;STORE IN DIRECTORY
MOVEM ACPPN,BINDIR+3 ;SET PPN
OPEN BIN,BININI ;INITIALIZE BINARY
JRST EINIT ;ERROR
TLZE TIO,TIOLE ;SKIP TO EOT
MTEOT. BIN,
TLZE TIO,TIORW ;REWIND REQUESTED?
MTREW. BIN, ;YES
JUMPGE CS,BINSE2 ;BRANCH IF NO BACK-SPACE
MTBSF. BIN, ;BACK-SPACE A FILE
AOJL CS,.-1 ;TEST FOR END
MTWAT. BIN,
STATO BIN,1B24 ;LOAD POINT?
MTSKF. BIN, ;NO, GO FORWARD ONE
BINSE2: SOJG CS,.-1 ;TEST FORWARD SPACING
TLNE TIO,TIOCLD ;DIRECTORY CLEAR REQUESTED?
UTPCLR BIN, ;YES, CLEAR IT
OUTBUF BIN,2 ;SET UP TWO RING BUFFER
BINSE3: CAIN C,"_"
JRST GETSET ;NO LISTING
LSTSET: PUSHJ PP,NAME1 ;GET NEXT DEVICE
JRST GETSET ;NO FILE HERE
HLLZ ACEXT,ACEXT
HLLZ ACEXT,ACEXT ;[427] DISALLOW NULL EXTENSIONS
LSTSE1: CAIE C,"_"
JRST ERRCM
TLNE FR,CREFSW ;CROSS-REF REQUESTED?
JRST LSTSE2 ;NO, BRANCH
JUMPN ACDEV,.+2 ;YES, WAS DEVICE SPECIFIED?
MOVSI ACDEV,'DSK' ;NO, ASSUME DSK
JUMPN ACFILE,.+2
MOVE ACFILE,[SIXBIT /CREF/]
JUMPN ACEXT,.+2
MOVSI ACEXT,'CRF'
LSTSE2: JUMPE ACDEV,GETSET ;FORGET LISTING IF NO DEVICE SPECIFIED
MOVE AC0,ACDEV
DEVCHR AC0, ;GET CHARACTERISTICS
TLNE AC0,LPTBIT!DISBIT!TTYBIT
TLNE FR,CREFSW ; WAS CROSS-REF REQUESTED?
AOSA OUTSW+0*TTYSW ;NO, ASSUME TTY
JRST ERRCM ;YES, ERROR - CREF DEV MUST NOT BE LPT, DIS, OR TTY
TLNE AC0,CONBIT ;CONTROLING TELETYPE LISTING?
JRST GETSET ;YES, BUFFER ALREADY SET
MOVEM ACDEV,LSTDEV ;STORE DEVICE NAME
AOS OUTSW+0*LPTSW ;SET FOR LPT
MOVEM ACFILE,LSTDIR ;STORE FILE NAME
JUMPN ACEXT,.+2
MOVSI ACEXT,'LST'
MOVEM ACEXT,LSTDIR+1
MOVEM ACPPN,LSTDIR+3 ;SET PPN
OPEN LST,LSTINI ;INITIALIZE LISTING OUTPUT
JRST EINIT ;ERROR
TLZE TIO,TIOLE
MTEOT. LST,
TLZE TIO,TIORW ;REWIND REQUESTED?
MTREW. LST, ;YES
JUMPGE CS,LSTSE3
MTBSF. LST,
AOJL CS,.-1
MTWAT. LST,
STATO LST,1B24
MTSKF. LST,
LSTSE3: SOJG CS,.-1
TLNE TIO,TIOCLD ;DIRECTORY CLEAR REQUESTED?
UTPCLR LST, ;YES, CLEAR IT
OUTBUF LST,2 ;SET UP A TWO RING BUFFER
GETSET:
IFN FT.U01,<
MOVE 3,[IOWD $USRLN,$USSTK] ; RESET THE USER PUSH DOWN STACK
MOVEM 3,$USRPD ; SO DO IT
>;END OF FT.U01
MOVEI 3,PDPERR
HRRM 3,.JBAPR ;SET TRAP LOCATION
MOVEI 3,1B19 ;SET FOR PUSH-DOWN OVERFLOW
APRENB 3,
SOS 3,PDP ;GET PDP REQUEST MINUS 1
IMULI 3,.PDP ;COMPUTE SIZE (50*<NUMBER OF /P'S +1>)
HRLZ MP,3
HRR MP,.JBFF ;SET BASIC POINTER
MOVE PP,MP
SUB PP,3
MOVEM PP,RP ;SET RP
MOVEM PP,SAVERP
SUB PP,3
IFN POLISH,<
MOVEM PP,POLSTK ;[164] SAVE INITIAL POLISH FIXUP STACK
MOVEM PP,POLPTR ;[164] ONLY CHANGE IF STACK MOVES
SUB PP,3 ;[164]
>
ASH 3,1 ;DOUBLE SIZE OF BASIC POINTER
HRL PP,3
MOVEM PP,SAVEPP
MOVEM MP,SAVEMP
SUBM PP,3 ;COMPUTE TOP LOCATION
SKIPN UNITOP ;IF ANY UNIVERSALS HAVE BEEN SEEN
JRST GETSE0 ;NO
HRRZS 3 ;GET TOP OF BUFFERS AND STACKS
CAMLE 3,UNISIZ ;HOPE ITS NOT BIGGER THAN UNIVERSAL ONE
JRST UNIERR ;IT WAS, YOU LOSE
SKIPA 3,UNITOP ;DON'T LOSE THEM
GETSE0: HRRZM 3,UNISIZ ;STORE UNTIL A UNIVERSAL IS SEEN
HRRZM 3,LADR ;SET START OF MACRO TREE
HRRZM 3,FREE
GETSE1: HRRZ .JBREL
SUBI 1
MOVEM SYMTOP ;SET TOP OF SYMBOL TABLE
SUBI LENGTH ;SET POINTER FOR INITIAL SYMBOLS
CAMLE LADR ;HAVE WE ROOM?
JRST GETSE2 ;YES
HRRZ 2,.JBREL ;NO, TRY FOR MORE CORE
ADDI 2,2000
CORE 2,
JRST XCEED2 ;NO MORE, INFORM USER
JRST GETSE1 ;TRY AGAIN
GETSE2: MOVEM SYMBOL ;SET START OF SYMBOL TABLE
HRLI SYMNUM
BLT @SYMTOP ;STORE SYMBOLS
IFN POLISH,<
MOVE @SYMBOL ;SYMBOL COUNT
MOVEM SGSCNT ; FOR THIS PSECT
>
PUSHJ PP,SRCHI ;INITIALIZE TABLE
;HERE TO TEST FOR CPU AND SET VALUE IN .CPU.
;PDP-6 = 1
;KA-10 = 2
;KI-10 = 3
;KL-10 = 4
MOVEI V,1 ;SET VALUE TO .PDP6. FOR STARTERS
JFCL 1,.+1 ;CLEAR PC CHANGE FLAG
JRST .+1 ;THEN CHANGE PC
JFCL 1,.PDP6. ;IF FLAG ON, ITS A PDP6
HRLOI 1,-2 ;CHECK FOR KA-10
AOBJP 1,.KA10. ;CHECK CARRY BETWEEN HALVES
SETZ 1, ;CLEAR AC
BLT 1,0 ;AND TRY BLT, KI WILL BE 0 AND
JUMPE 1,.KI10. ;KL WILL HAVE 1,,1
; JRST .KL10.
.KL10.: AOS V
.KI10.: AOS V
.KA10.: AOS V
.PDP6.: MOVE AC0,['.CPU. ']
PUSHJ PP,SSRCH ;SEE IF THERE ALREADY AND IF NOT
PUSHJ PP,[MOVSI ARG,SYMF!NOOUTF!SUPRBT
SETZ RC,
JRST INSERT] ;PUT IT IN TABLE
GETPPN V, ;[405]GET LOGGED IN PPN
JFCL ;[405]ALT. RETURN
MOVEM V,MYPPN ;[405]AND REMEMBER IT
IFN POLISH,<
SETZM SGNMAX ;INIT TO ONE .PSECT
SETZM SGNCUR ;IT IS THE CURRENT .PSECT
SETZM SGNAME ;IT IS THE BLANK .PSECT
MOVSI 1
MOVEM SGRELC ;SET THE RELOCATION COUNTER
SETZM SGATTR ;ZERO PSECT BRK AND ATTRS
SETZM SGDMAX ;ONE .PSECT DEEP
SETZM SGLIST ;IT IS THE BLANK .PSECT
>
MOVE [XWD CTIBUF+1,CTLSAV] ;SAVE CONTROL INPUT BUFFER
BLT CTLS1 ;FOR RESCAN ON PASS 2
MOVSI 'DSK' ;SET INPUT TO TAKE DSK AS DEV
MOVEM ACDEVX
PUSHJ PP,COUTI ;INIT OUTPUT JUST IN CASE
PUSHJ PP,INSET ;GET FIRST INPUT FILE
JRST GETSE3 ;ERROR
IFN CCLSW,<TLNE IO,CRPGSW ;BUT ONLY IF DOING RPG
TTCALL 3,[ASCIZ /MACRO:/] ;PUBLISH COMPILER NAME>
MOVE CS,INDIR ;SET UP NAME OF FIRST FILE
MOVEM CS,LSTFIL ;AS LAST PRINTED
SETZM LSTPGN
JRST ASSEMB ;START ASSEMBLY
GETSE3: PUSHJ PP,ERRNE
JRST ERRFIN
FINIS: CLOSE BIN, ;DUMP BUFFER
TLNE FR,PNCHSW ;PUNCH REQUESTED?
PUSHJ PP,TSTBIN ;YES, TEST FOR ERRORS
RELEAS BIN,
CLOSE LST,
SOSLE OUTSW+0*LPTSW ;LPT TYPE OUTPUT?
PUSHJ PP,TSTLST ;YES, TEST FOR ERRORS
RELEAS LST,
RELEAS CHAR,
OUTPUT CTL,0 ;FLUSH TTY OUTPUT
SKIPE UNIVSN ;SKIP IF NOT ASSEMBLING UNIVERSAL
PUSHJ PP,UNISYM ;STORE SYMBOLS ETC. FIRST
JRST M ;RETURN FOR NEXT ASSEMBLY
IFN CCLSW,<
NUNSET: JUMPN ACDEV,.+2
MOVSI ACDEV,'SYS' ;USE SYS IF NONE SPECIFIED
MOVEM ACDEV,RUNDEV
MOVEM ACFILE,RUNFIL ;STORE FILE NAME
SKIPN SFDADD ;ANY SFD'S?
JRST NUNPP ;NO
HRLI ACPPN,RUNSFD ;FORM BLT WORD
MOVSS ACPPN ;BUT WRONG WAY ROUND
BLT ACPPN,RUNSFD+2+.SFDLN
MOVEI ACPPN,RUNSFD ;SET UP ADDRESS AGAIN
NUNPP: MOVEM ACPPN,RUNPP ;IN PPN
PUSHJ PP,DELETE ;COMMAND FILE
SETZM RUNFIL+1 ;LET MONITOR CHOOSE EXT
SETZM RUNFIL+2 ;CLEAR ALSO
SETZM RUNPP+1 ;ZERO CORE ARG
MOVEI 16,RUNDEV ;XWD 0,RUNDEV
TLNE IO,CRPGSW ;WAS RPG IN PROGRESS?
HRLI 16,1 ;YES. START NEXT AT C(.JBSA)+1
;REDUCE THE LOW SEGMENT TO 1K AND DELETE THE HIGH
;BEFORE THE RUN UUO, SAVES CORE AND TIME
MOVE 1,[1,,RUNEND-1] ;DELETE HIGH & LOW
MOVE 2,[RUNHI,,RUNLO]
BLT 2,RUNDEV-1 ;BLT CODE DOWN
JRST RUNLO ;GO TO IT
RUNHI: PHASE LOWL
RUNLO:! CORE 1, ;CUT DOWN TO 1K
JFCL ;TOO BAD
RUN 16, ;DO "RUN DEV:NAME"
HALT ;SHOULDN'T RETURN. HALT IF IT DOES
RUNDEV:! BLOCK 1
RUNFIL:! BLOCK 3
RUNPP:! BLOCK 2
RUNSFD:! BLOCK 3+.SFDLN
RUNEND:!
DEPHASE
DELETE: HRRZ EXTMP ;IF THE EXTENSION
CAIE 'TMP' ;IS .TMP
POPJ PP, ;RETURN.
CLOSE CTL2, ;DELETE
SETZB 4,5 ;THE COMMAND FILE.
SETZB 6,7
RENAME CTL2,4 ;
JFCL
POPJ PP,
>
INSET: MOVEI JOBFFI ;POINTER TO INPUT BUFFER
HRRM .JBFF ;INFORM SYSTEM OF BUFFER AREA
PUSHJ PP,NAME2 ;GET NEXT COMMAND NAME
POPJ PP, ;ERROR RETURN IF NONE LEFT
AOS (PP) ;SUCCESS
MOVEM ACDEV,INDEV ;STORE DEVICE
MOVEM ACFILE,INDIR ;STORE FILE IN DIRECTORY
MOVEM ACPPN,INDIR+3 ;STORE PPN BEFORE WE LOSE IT
OPEN CHAR,INDEVI
JRST EINIT ;ERROR
DEVCHR ACDEV, ;TEST CHARACTERISTICS
TLNN ACDEV,MTABIT ;MAG TAPE?
JRST INSET3 ;NO
TLZN FR,MTAPSW ;FIRST MAG TAPE IN PASS 2?
JRST INSET1 ;NO
TLNN TIO,TIORW ;YES, REWIND REQUESTED?
SUB CS,RECCNT ;NO, PREPARE TO BACK-SPACE TAPE
INSET1: AOS RECCNT ;INCREMENT FILE COUNTER
ADDM CS,RECCNT ;UPDATE COUNT
TLZE TIO,TIOLE
MTEOT. CHAR,
TLZE TIO,TIORW ;REWIND?
MTREW. CHAR, ;YES
JUMPGE CS,INSET2
MTBSF. CHAR,
MTBSF. CHAR,
AOJL CS,.-1
MTWAT. CHAR,
STATO CHAR,1B24
MTSKF. CHAR,
INSET2: SOJGE CS,.-1
INSET3: INBUF CHAR,1
MOVEI ACPNTR,JOBFFI
EXCH ACPNTR,.JBFF
SUBI ACPNTR,JOBFFI
MOVEI ACDEL,NUMBUF*203+1
IDIV ACDEL,ACPNTR
INBUF CHAR,(ACDEL)
JUMPN ACEXT,INSET4 ;TAKE USER'S EXTENSION IF NON-BLANK
MOVSI ACEXT,'MAC' ;BLANK, TRY .MAC FIRST
PUSHJ PP,INSETI
INSET4: PUSHJ PP,INSETI
JUMPE ACEXT,ERRCF ;ERROR IF ZERO
TLNE ACDEV,TTYBIT ;TELETYPE?
SETSTS CHAR,AL ;YES, CHANGE TO ASCII LINE
;DO ALL ENTERS HERE FOR LEVEL D
SKIPE ENTERS ;HAVE ENTERS BEEN DONE ALREADY?
JRST ENTRDN ;YES, DON'T DO TWICE
SKIPN ACEXT,LSTDEV ;IS THERE A LIST DEVICE?
JRST LSTSE6 ;NO SO DON'T DO ENTER
SKIPN ACFILE,LSTDIR ;GET FILE NAME INCASE OF ERROR
JRST [DEVCHR ACEXT,
TLNE ACEXT,DIRBIT ;DOES IT HAVE A DIRECTORY?
JRST LSTSE4 ;YES, GIVE UP BEFORE HARM IS DONE
SKIPE ACFILE,INDIR ;USE INPUT FILE NAME
MOVEM ACFILE,LSTDIR ;TOO BAD IF ZERO ALSO
JRST LSTSE4]
HLLZS ACEXT,LSTDIR+1 ;EXT ALSO
MOVE ACPPN,LSTDIR+3 ;SAVE PPN
LOOKUP LST,LSTDIR ;PREVIOUS ONE STILL THERE
JRST LSTSE4 ;NO
SETZM LSTDIR ;YES,CLEAR NAME
HLLZS LSTDIR+1
MOVEM ACPPN,LSTDIR+3 ;RESET PPN
RENAME LST,LSTDIR
CLOSE LST, ;IGNORE FAILURE
MOVEM ACFILE,LSTDIR ;RESTORE NAME
SETZM LSTDIR+2 ;CLEAR PROTECTION AND DATE
LSTSE4: MOVEM ACPPN,LSTDIR+3 ;[246] SET PPN AGAIN
HLLZS LSTDIR+1 ;ZERO RIGHT HALF OF EXTENSION WORD
ENTER LST,LSTDIR ;SET UP DIRECTORY
JRST ERRCL ;ERROR
LSTSE6: SKIPN ACEXT,BINDEV ;A BINARY DEVICE THEN ?
JRST ENTRDN ;NO
SKIPN ACFILE,BINDIR ;INCASE OF ERROR
JRST [DEVCHR ACEXT,
TLNE ACEXT,DIRBIT ;DOES IT HAVE A DIRECTORY?
JRST .+1 ;YES, GIVE UP BEFORE HARM IS DONE
SKIPE ACFILE,INDIR ;USE INPUT FILE NAME
MOVEM ACFILE,BINDIR ;TOO BAD IF ZERO ALSO
JRST .+1]
HLLZS ACEXT,BINDIR+1
ENTER BIN,BINDIR ;ENTER FILE NAME
JRST ERRCB ;ERROR
ENTRDN: SETOM ENTERS ;MAKE SURE ONLY DONE ONCE
MOVE CS,[POINT 7,DEVBUF]
PUSH PP,1 ;SAVE THE ACCS
PUSH PP,2
PUSH PP,3
SKIPN 2,INDIR ;GET INPUT NAME
JRST FINDEV ;FINISHED WITH DEVICE
SETZ 1, ;CLEAR FOR RECEIVING
LSHC 1,6 ;SHIFT ONE CHAR. IN
ADDI 1,40 ;FORM ASCII
IDPB 1,CS ;STORE CHAR.
JUMPN 2,.-4 ;MORE TO DO?
MOVEI 1," " ;SEPARATE BY TAB
IDPB 1,CS
HLLZ 2,INDIR+1 ;GET EXT
JUMPE 2,FINEXT ;NO EXT
SETZ 1,
LSHC 1,6 ;SAME LOOP AS ABOVE
ADDI 1,40
IDPB 1,CS
JUMPN 2,.-4
MOVEI 1," "
IDPB 1,CS ;SEPARATE BY TAB
FINEXT: LDB 1,[POINT 12,INDIR+2,35] ;GET LOW 12 BITS OF DATE
LDB 2,[POINT 3,INDIR+1,20] ;GET HIGH 3 BITS OF DATE
DPB 2,[POINT 3,1,23] ;MERGE TO BITS
JUMPE 1,FINDEV ;NO DATE?
PUSHJ PP,DATOUT ;STORE IT
LDB 2,[POINT 11,INDIR+2,23] ;GET CREATION TIME
JUMPE 2,FINDEV ;NO TIME (DECTAPE)
MOVEI 1," " ;SEPARATE BY SPACE
IDPB 1,CS
PUSHJ PP,TIMOU1 ;STORE TIME
FINDEV: SETZ 1,
MOVEI 2," " ;FINAL TAB
IDPB 2,CS
IDPB 1,CS ;TERMINATE FOR NOW
POP PP,3 ;RESTORE ACCS
POP PP,2
POP PP,1
SKIPN PAGENO ;IF FIRST TIME THRU
JRST OUTFF ;START NEW PAGE
SETZM PAGENO ;ON NEW FILE, RESET PAGES
JRST OUTFF2 ;DON'T START NEW PAGE UNLESS FF
INSETI: HLLZM ACEXT,INDIR+1 ;STORE EXTENSION
MOVE ACPPN,INDIR+3 ;SAVE PPN
LOOKUP CHAR,INDIR
SKIPA ACEXT,INDIR+1 ;GET ERROR CODE
JRST CPOPJ1 ;SKIP-RETURN IF FOUND
TRNE ACEXT,-1 ;ERROR CODE OF 0 IS FILE NOT FOUND
JRST ERRCF ;FILE THERE BUT NOT READABLE
SETZ ACEXT, ;CLEAR EXT AND TRY AGAIN
MOVEM ACPPN,INDIR+3 ;RESTORE PPN
POPJ PP,
REC2: MOVS [CTIBUF+1,,CTLSAV] ;RESCAN CONTROL (FROM PASS1 END STMNT)
BLT CTIBUF+2 ;INPUT BUFFER
MOVEI "_"
HRLM ACDELX ;FUDGE PREVIOUS DELIMITER
SETZM PASS2I
MOVE [XWD PASS2I,PASS2I+1]
BLT PASS2X-1 ;ZERO PASS2 VARIABLES
TLO FR,MTAPSW!LOADSW ;SET FLAGS
GOTEND: MOVE INDEV ;GET LAST DEVICE
DEVCHR ;GET ITS CHARACTERISTICS
TLNE 4 ;TEST FOR DIRECTORY (DSK OR DTA)
JRST EOT ;YES, SO DON'T WASTE TIME
JRST .+3 ;NO, INPUT BUFFER BY BUFFER
IN CHAR,
JRST .-1 ;NO ERRORS
STATO CHAR,1B22 ;TEST FOR EOF
JRST .-3 ;IGNORE ERRORS
EOT: PUSHJ PP,SAVEXS ;SAVE REGISTERS
SETOM EOFFLG ;[417]GOING THRU EOF PROCEDURE
PUSHJ PP,INSET ;GET THE NEXT INPUT DEVICE
JRST EOT0 ;ERROR
HRROI RC,[SIXBIT /EP1 END OF PASS 1]@/] ;ASSUME END OF PASS
TLZN FR,LOADSW ;ZERO ONLY ON END OF PASS 1
HRROI RC,[SIXBIT /LNF LOAD THE NEXT FILE]@/] ;NOT END OF PASS
TLNE ACDEV,(1B13!1B15) ;WAS ALL THAT WORK NECESSARY?
JRST RSTRXS ;NO
PUSHJ PP,EINFO ;CR-LF [
PUSHJ PP,TYPMSG ;YES
RSTRXS: MOVSI RC,SAVBLK ;SET POINTER
BLT RC,RC-1 ;RESTORE REGISTERS
MOVE RC,SAVERC ;RESTORE RC
POPJ PP, ;EXIT
SAVEXS: MOVEM RC,SAVERC ;SAVE RC
MOVEI RC,SAVBLK ;SET POINTER
BLT RC,SAVBLK+RC-1 ;BLT ALL REGISTERS BELOW RC
POPJ PP, ;EXIT
EOT0: JUMP1 [TLON FR,LOADSW ;PRINT MESSAGE ONCE
PUSHJ PP,ERRNE ;ON PASS1
JRST EOT1]
AOS ERRCNT ;COUNT AS ERROR
TLO FR,LOADSW ;USED TO SIGNAL POPJ RET FROM ERRNE
PUSHJ PP,ERRNE ;PRINT ERROR MESSAGE
EOT1: TLZ IO,IORPTC
MOVE PP,SAVEPP ;RESTORE STACKS
MOVE MP,SAVERP
MOVEM MP,SAVERP
MOVE MP,SAVEMP
AOBJN PP,END01 ;FAKE END SEEN
NAME1: SETZM ACDEVX ;ENTRY FOR DESTINATION
NAME2: SETZB ACDEV,INDIR+2 ;ENTRY FOR SOURCE
SETZB ACFILE,PPN ;CLEAR FILE AND PPN
HLRZ ACDEL,ACDELX ;GET PREVIOUS DELIMITER
SETZB TIO,CS
SETZB ACEXT,INDIR+3 ;RESET EXTENSION AND PROGRAM-NUMBER PAIR
SETZM SFDADD ;CLEAR FIRST WORD OF SFD BLOCK
MOVE AC0,[SFDADD,,SFDADD+1]
BLT AC0,SFDADD+2+.SFDLN ;AND REST OF IT
NAME3: MOVSI ACPNTR,(POINT 6,AC0) ;SET POINTER
TDZA AC0,AC0 ;CLEAR SYMBOL
SLASH: PUSHJ PP,SW0
GETIOC: PUSHJ PP,TTYIN ;GET INPUT CHARACTER
CAIN C,"/"
JRST SLASH
CAIN C,"("
JRST SWITCH
CAIN C,":"
JRST DEVICE
CAIN C,"."
JRST NAME
IFN CCLSW,<CAIE C,"!" ;IS CHAR AN IMPERATIVE?
CAIN C,"@"
JRST TERM ;YES, GO DO IT>
CAIE C,33 ;CHECK FOR THREE FLAVORS OF ALT-MODE
CAIN C,176 ;...
JRST TERM ;...
CAIG C,CR ;LESS THAN CR?
CAIGE C,LF ;AND GREATER THAN LF?
CAIN C,175 ;OR 3RD ALTMOD
JRST TERM ;YES
CAIE C,"<" ;NEW ALT FORM OF DIRECTORY
CAIN C,"["
JRST PROGNP ;GET PROGRAMER NUMBER PAIR
CAIN C,"=" ;EQUALS IS SAME AS LEFT ARROW
TRCA C,142 ;SO MAKE IT A "_" AND SKIP
CAIE C,","
CAIN C,"_"
JRST TERM
JUMPL C,TERME ;ERROR RETURN FROM TTYIN?
CAIGE C,40 ;VALID AS SIXBIT?
JRST [CAIN C,CZ ;NO,IS IT ^Z
JRST CZSTOP ;YES,EXIT FOR BATCH
JRST GETIOC] ;JUST IGNORE
CAIL C,"0" ;[424] ERROR IF NOT ALPHANUMERIC
CAILE C,"Z" ;[424]
JRST ERRCM ;[424]
CAILE C,"9" ;[424]
CAIL C,"A" ;[424]
CAIA ;[424]
JRST ERRCM ;[424]
SUBI C,40 ;CONVERT TO 6-BIT
TLNE ACPNTR,770000 ;HAVE WE STORED SIX BYTES?
IDPB C,ACPNTR ;NO, STORE IT
JRST GETIOC ;GET NEXT CHARACTER
DEVICE: JUMPN ACDEV,ERRCM ;ERROR IF ALREADY SET
MOVE ACDEV,AC0 ;DEVICE NAME
JRST DEVNAM ;COMMON CODE
NAME: JUMPN ACFILE,ERRCM ;ERROR IF ALREADY SET
MOVE ACFILE,AC0 ;FILE NAME
DEVNAM: MOVE ACDEL,C ;SET DELIMITER
JRST NAME3 ;GET NEXT SYMBOL
TERME: TLZA C,-1 ;MAKE INTO 33 BUT GIVE ERROR RET
TERM: AOS (PP) ;GIVE SKIP RETURN ON VALID TERMINATOR
JUMPE ACDEL,TERM1 ;IF NO PREVIOUS TERMINATOR, THEN FILENAME
CAIN ACDEL,"_" ;...
JRST TERM1 ;...
CAIE ACDEL,":" ;IF PREVIOUS DELIMITER
CAIN ACDEL,"," ;WAS COLON OR COMMA
TERM1: MOVE ACFILE,AC0 ;SET FILE
CAIN ACDEL,"." ;IF PERIOD,
HLLO ACEXT,AC0 ;[427] SET EXTENSION
HRLM C,ACDELX ;SAVE PREVIOUS DELIMITER
JUMPN ACDEV,.+2 ;IF DEVICE SET USE IT
SKIPA ACDEV,ACDEVX ;OTHERWISE USE LAST DEVICE
MOVEM ACDEV,ACDEVX ;AND DEVICE
SKIPN ACPPN,PPN ;[216] PUT PPN IN RIGHT PLACE
SKIPN PPPN ;[216] DO WE HAVE A DEFAULT?
JRST TERM2 ;[216] PPN IS SETUP
MOVE ACPPN,[PSFD,,SFDADD] ;[216] MOVE DEFAULT SFD
BLT ACPPN,SFDE ;[216]
MOVE ACPPN,PPPN ;[216] AND PPN
TERM2: CAIN C,"!" ;IMPERATIVE?
POPJ PP, ;YES, DON'T ASSUME DEV
JUMPE ACFILE,CPOPJ ;IF THERE IS A FILE,
JUMPN ACDEV,.+2 ;BUT NO DEVICE
MOVSI ACDEV,'DSK' ;THEN ASSUME DISK
POPJ PP, ;EXIT
CZSTOP: EXIT 1, ;[275]MONRET
JRST M ;[275]CONTINUE
ERRCM: HRROI RC,[SIXBIT /CME COMMAND ERROR@/]
JRST ERRFIN
PROGNP: PUSHJ PP,GETOCT ;GET AN OCTAL NUMBER IN RC
SKIPN RC ;[405] IF ITS 0, USE
HLRZ RC,MYPPN ;[405]USE LOGGED IN PROJECT NUMBER
HRLZM RC,PPN ;STORE IT
CAIE C,"," ;MORE?
JRST PPNTST ;[216] NO, GIVE UP
PUSHJ PP,GETOCT ;GET AN OCTAL NUMBER
SKIPN RC ;[405] IF ITS 0, USE
HRRZ RC,MYPPN ;[405]MY PROGRAMMER NUMBER
HRRM RC,PPN ;STORE IT
CAIE C,"," ;SFD'S?
JRST PPNTST ;[216] NO
MOVEI C,SFDADD ;POINT TO DDDSFD BLOCK
EXCH C,PPN ;SWAP WITH PPN
MOVEM C,SFDADD+2 ;STORE IT
MOVEI RC,SFDADD+3 ;START OF SFD AREA
SFD1: HRRZS RC ;CLEAR BYTE POINTER
CAILE RC,SFDADD+2+.SFDLN
JRST ERRCM ;PATH TOO LONG
HRLI RC,(POINT 6) ;BYTE POINTER SETUP
SFD2: PUSHJ PP,TTYIN ;GET CHAR
CAIE C,">" ;ALT FORM
CAIN C,"]" ;END?
JRST PPNTST ;[216] YES
CAIN C,"," ;NEXT SFD
AOJA RC,SFD1 ;YES, INCREMENT STORE ADDRESS
SUBI C,40 ;CONVERT TO SIXBIT
JUMPL C,ERRCM ;ERROR
TLNE RC,770000 ;SPACE IN WORD
IDPB C,RC ;YES, STORE CHAR.
JRST SFD2 ;GET NEXT CHAR
GETOCT: SETZ RC, ;START WITH ZERO
GETOC1: PUSHJ PP,TTYIN
CAIE C,"," ;TEST FOR COMMA
CAIN C,"]" ;AND CLOSE SQB
POPJ PP, ;YES, WEVE GOT SOMETHING
CAIN C,">" ;ALSO ALT FORM
POPJ PP,
IFE STANSW,<
CAIL C,"0" ;CHECK FOR VALID NUMBERS
CAILE C,"7"
JRST ERRCM ;NOT VALID
LSH RC,3 ;SHIFT PREVIOUS RESULT
ADDI RC,-"0"(C) ;ADD IN NEW NUMBER>
IFN STANSW,<LSH RC,6 ;SHIFT PREVIOUS RESULT
ADDI RC,-40(C) ;PUT IN NEW CHARACTER>
JRST GETOC1 ;GET NEXT CHARACTER
;[216] HERE TO TEST FOR DEFAULT PPN
PPNTST: SKIPN ACFILE ;SEEN FILE NAME YET?
SKIPE AC0 ;OR PENDING
JRST GETIOC ;NO
PUSH PP,AC0 ;GET AN AC
MOVE AC0,PPN ;GET PPN
MOVEM AC0,PPPN ;MAKE IT PERMANENT
MOVE AC0,[SFDADD,,PSFD]
BLT AC0,PSFDE ;SAME FOR SFDS
POP PP,AC0
JRST GETIOC
;[216] END OF EDIT
SWITC0: PUSHJ PP,SW1 ;PROCESS CHARACTER
SWITCH: PUSHJ PP,TTYIN ;GET NEXT CHARACTER
CAIE C,")" ;END OF STRING?
JRST SWITC0 ;NO
JRST GETIOC ;YES
SW0: PUSHJ PP,TTYIN
SW1: HRREI C,-"A"(C) ;[227] CONVERT FROM ASCII TO NUMERIC
JUMPL C,SEELPP ;[227] NUMERIC VALUE MAYBE?
CAILE C,"Z"-"A" ;WITHIN BOUNDS? (IS IT ALPHA?)
JRST ERRCM ;[227] NO, LT. Z, ERROR
MOVE RC,[POINT 5,BYTAB]
IBP RC
SOJGE C,.-1 ;MOVE TO PROPER BYTE
LDB C,RC ;PICK UP BYTE
JUMPE C,ERRCM ;TEST FOR VALID SWITCH
CAIG C,SWTABT-SWTAB ;LEGAL ON SOURCE?
JUMPL PP,ERRCM ;NO, TEST FOR SOURCE
LDB RC,[POINT 4,SWTAB-1(C),12]
CAIN RC,IO
SKIPN CTLSAV ;IF PASS2 OR IO SWITCH,
XCT SWTAB-1(C) ;EXECUTE INSTRUCTION
POPJ PP, ;EXIT
TLZ IO,IOSALL ;TAKE CARE OF /X
POPJ PP,
HELP: PUSH PP,.JBFF ;SAVE REAL .JBFF
MOVE 1,.JBREL ;USE JOBREL
MOVEM 1,.JBFF ;SO HELPER DOESN'T DESTROY SYMBOL TABLE
MOVE 1,['MACRO '] ;GET MACRO.HLP
PUSHJ PP,.HELPR ;CALL HELPER
POP PP,.JBFF ;RESTORE JOBFF INCASE CCL MODE
JRST M ;RESTART
;[227] HERE FOR /nnL SWITCH TO SET LINES/PAGE
SEELPP: ADDI C,"A"-"0" ;TO NUMERIC RANGE
CAIG C,9 ;IS IT
JUMPGE C,.+2
JRST ERRCM ;NO, BARF
MOVE RC,C ;MOVE VALUE
SEELP1: PUSHJ PP,TTYIN ;GET NEXT
CAIG C,"9" ;IS IT NUMERIC
CAIGE C,"0" ;...
JRST SEELP2 ;NO, CHECK END
IMULI RC,^D10 ;MAKE SPACE
ADDI RC,-"0"(C) ;AND PUT DIGIT
JRST SEELP1 ;AND CONTINUE
SEELP2: CAIE C,"L" ;END PROPERLY?
JRST ERRCM ;NO, BARF
SUBI RC,4 ;EASIER FOR SYMBOL OUTPUT ROUTINES
MOVEM RC,..LPP ;SAVE IN "READ-ONLY"
POPJ PP, ;ALL DONE
DEFINE SETSW (LETTER,INSTRUCTION) < INSTRUCTION
J= <"LETTER"-"A">-7*<I=<"LETTER"-"A">/7>
SETCOD \I,J>
DEFINE SETCOD (I,J)
<BYTAB'I=BYTAB'I!<.-SWTAB>B<5*J+4>>
BYTAB0= 0 ;INITIALIZE TABLE
BYTAB1= 0
BYTAB2= 0
BYTAB3= 0
SWTAB:
SETSW Z,<TLO TIO,TIOCLD >
SETSW C,<TLZ FR,CREFSW >
SETSW P,<SOS PDP >
SWTABT: ;THE ABOVE SW'S ARE LEGAL ON OUTPUT ONLY
SETSW A,<ADDI CS,1 >
SETSW B,<SUBI CS,1 >
SETSW E,<TLZ IO,IOPALL!IOSALL >
IFN FORMSW,< SETSW F,<SETZM HWFMT>
SETSW G,<SETOM HWFMT>>
SETSW H,<JRST HELP>
SETSW L,<TLZ IO,IOMSTR >
SETSW M,<TLO IO,IOPALL!IOSALL >
SETSW N,<HLLOS TYPERR >
SETSW O,<XCT OFFML >
SETSW Q,<TLO FR,ERRQSW >
SETSW S,<TLO IO,IOMSTR >
SETSW T,<TLO TIO,TIOLE >
SETSW U,<SETOM UNVSKP >
SETSW W,<TLO TIO,TIORW >
SETSW X,<TLOA IO,IOPALL >
IFG .-SWTAB-37,<PRINTX SWITCH TABLE TOO LONG, CHANGE BYTE SIZE>
BYTAB: ;BYTAB CONTAINS AN INDEX TO SWTAB
;IT CONSIST OF 7 5BIT BYTES/WORD
;OR ONE BYTE FOR EACH LETTER
+BYTAB0 ;A-G BYTE = 1 THROUGH 17 = INDEX
+BYTAB1 ;H-N BYTE = 0 = COMMAND ERROR
+BYTAB2 ;O-U
+BYTAB3 ;V-Z
IF2,<PURGE I,J,BYTAB0,BYTAB1,BYTAB2,BYTAB3>
TTYIN: SOSGE CTIBUF+2 ;ENUF CHAR.?
JRST TTYERR ;NO
ILDB C,CTIBUF+1 ;GET CHARACTER
CAIE C," " ;SKIP BLANKS
CAIN C,HT ;AND TABS
JRST TTYIN
CAIN C,15 ;CR?
SETZM CTIBUF+2 ;YES,IGNORE REST OF LINE
CAIG C,"Z"+40 ;CHECK FOR LOWER CASE
CAIGE C,"A"+40
POPJ PP, ;NO,EXIT
SUBI C,40
POPJ PP, ;YES, EXIT
COMERR: HRROI RC,[SIXBIT /CTL COMMAND LINE TOO LONG@/]
JRST ERRFIN
TTYERR: SKIPN INDEV ;INPUT DEVICE SEEN?
JRST ERRCM ;NO, SO MISSING "_"
HRROI C,EOL ;SIGNAL ERROR
POPJ PP, ;AND RETURN
ERRNE: HRROI RC,[SIXBIT /NES NO END STATEMENT ENCOUNTERED ON INPUT FILE@/]
ERRNE0: PUSHJ PP,EFATAL ;OUTPUT CR-LF ?MCR
PUSHJ PP,TYPMSG ;OUTPUT IT
SKIPE LITLVL ;SEE IF IN LITERAL
SKIPN LITPG ;PAGE 0 MEANS NOT IN A LITERAL REALLY
JRST ERRNE1 ;NO, TRY OTHERS
MOVE V,[XWD [SIXBIT /IN LITERAL@/],LITPG]
PUSHJ PP,PRNUM ;GO PRINT INFORMATION
ERRNE1: MOVEI V,0 ;CHECK FOR OTHER PLACES
SKIPE INDEF
MOVE V,[XWD [SIXBIT /IN DEFINE@/],DEFPG]
SKIPE INTXT
MOVE V,[XWD [SIXBIT /IN TEXT@/],TXTPG]
SKIPE INREP
MOVE V,[XWD [SIXBIT /IN CONDITIONAL OR REPEAT@/],REPPG]
SKIPE INCND
MOVE V,[XWD [SIXBIT /IN CONDITIONAL@/],CNDPG]
SKIPGE MACENL
ERRNE2: MOVE V,[XWD [SIXBIT /IN MACRO CALL@/],CALPG]
JUMPN V,ERRNE3
MOVE V,[XWD [SIXBIT /@/],PAGENO] ;BETTER THAN NOTHING
SKIPE LITLVL ;HAD ONE PAGE NUMBER ALREADY
POPJ PP,
ERRNE3: PUSHJ PP,PRNUM
TLNE FR,LOADSW ;SEEN END OF FILE YET?
POPJ PP, ;YES
MOVE PP,SAVEPP ;NO RESET STACK
MOVE MP,SAVERP
MOVEM MP,RP
MOVE MP,SAVEMP
SETZ MRP,
JRST ASSEM2 ;AND CONTINUE
ERRMS1: SIXBIT / ERRORS DETECTED@/
ERRMS2: SIXBIT /1 ERROR DETECTED@/
ERRMS3: SIXBIT /NO ERRORS DETECTED@/
ERRMQ1: SIXBIT /1 WARNING GIVEN@/
ERRMQ2: SIXBIT / WARNINGS GIVEN@/
EINIT: PUSHJ PP,EFATAL ;[352] ?MCR
MOVSI CS,'DNA' ;[352]
PUSHJ PP,TYPSYM ;[352] DNA
MOVEI C," " ;[352]
PUSHJ PP,TYO ;[352] SPACE
MOVE RC,[XWD ACDEV,[SIXBIT /NOT AVAILABLE@/]] ;[352]
JRST ERRFN1 ;[352] REST OF MESSAGE
ERRCL: HRRZ RC,LSTDIR+1 ;GET LST DEV ERROR CODE
JRST .+2 ;GET ERROR MESSAGE
ERRCB: HRRZ RC,BINDIR+1 ;GET BIN DEV ERROR CODE
JUMPN RC,ERRTYP
SOJA RC,ERRTYP ;SPECIAL CASE IF ERROR CODE 0
ERRCF: HRRZ RC,INDIR+1 ;GET INPUT DEV ERROR CODE
HLLZ ACEXT,INDIR+1 ;SET UP EXT
ERRTYP: CAIL RC,TABLND-TABLE ;IS ERROR CODE LEGAL?
SKIPA RC,TABLND ;NO, GIVE CATCH ALL MESSAGE
MOVE RC,TABLE(RC) ;YES, PICK UP MESSAGE
PUSHJ PP,EFATAL ;PUT OUT CR-LF ?MCR
MOVSI CS,'LRE' ;LOOKUP-RENAME-ENTER TYPE
PUSHJ PP,TYPSYM
CAIA ;SKIP CALL TO EFATAL NOW
ERRFIN: PUSHJ PP,EFATAL
ERRFN1: PUSHJ PP,TYPMSG ;[352]
CLOSE LST, ;GIVE USER A PARTIAL LISTING
CLOSE BIN,40 ;BUT NEVER A BUM REL FILE
JRST M
EFATAL: PUSHJ PP,OCRLF
MOVEI C,"?"
PUSHJ PP,TYO
MOVSI CS,'MCR' ;IDENTIFY CUSP
IFN CCLSW,<AOS .JBERR ;RECORD ERROR SO EXECUTION DELETED>
PJRST TYPSYM ;AND RETURN
EWARN: PUSHJ PP,OCRLF
MOVEI C,"%"
PUSHJ PP,TYO
MOVSI CS,'MCR' ;IDENTIFY CUSP
PJRST TYPSYM ;AND RETURN
EINFO: PUSHJ PP,OCRLF
MOVEI C,"["
PUSHJ PP,TYO
MOVSI CS,'MCR' ;IDENTIFY CUSP
PJRST TYPSYM ;AND RETURN
OCRLF: SKPINC C ;SEE IN WE CAN INPUT A CHAR.
JFCL ;BUT ONLY TO DEFEAT ^O
PJRST CRLF
[SIXBIT /(0) ILLEGAL FILE NAME@/],,ACFILE
TABLE: [SIXBIT /(0) FILE WAS NOT FOUND@/],,ACFILE
[SIXBIT /(1) NO DIRECTORY FOR PROJECT-PROGRAMMER NUMBER@/],,ACFILE
[SIXBIT /(2) PROTECTION FAILURE@/],,ACFILE
[SIXBIT /(3) FILE WAS BEING MODIFIED@/],,ACFILE
[SIXBIT /(4) RENAME FILE NAME ALREADY EXISTS@/],,ACFILE
[SIXBIT /(5) ILLEGAL SEQUENCE OF UUOS@/],,ACFILE
[SIXBIT /(6) BAD UFD OR BAD RIB@/],,ACFILE
[SIXBIT /(7) NOT A SAV FILE@/],,ACFILE
[SIXBIT /(10) NOT ENOUGH CORE@/],,ACFILE
[SIXBIT /(11) DEVICE NOT AVAILABLE@/],,ACFILE
[SIXBIT /(12) NO SUCH DEVICE@/],,ACFILE
[SIXBIT /(13) NOT TWO RELOC REG. CAPABILITY@/],,ACFILE
[SIXBIT /(14) NO ROOM OR QUOTA EXCEEDED@/],,ACFILE
[SIXBIT /(15) WRITE LOCK ERROR@/],,ACFILE
[SIXBIT /(16) NOT ENOUGH MONITOR TABLE SPACE@/],,ACFILE
[SIXBIT /(17) PARTIAL ALLOCATION ONLY@/],,ACFILE
[SIXBIT /(20) BLOCK NOT FREE ON ALLOCATION@/],,ACFILE
[SIXBIT /(21) CAN'T SUPERSEDE (ENTER) AN EXISTING DIRECTORY@/],,ACFILE
[SIXBIT /(22) CAN'T DELETE (RENAME) A NON-EMPTY DIRECTORY@/],,ACFILE
[SIXBIT /(23) SFD NOT FOUND@/],,ACFILE
[SIXBIT /(24) SEARCH LIST EMPTY@/],,ACFILE
[SIXBIT /(25) SFD NESTED TOO DEEPLY@/],,ACFILE
[SIXBIT /(26) NO-CREATE ON FOR SPECIFIED PATH@/],,ACFILE
TABLND: [SIXBIT /(?) LOOKUP, ENTER, OR RENAME ERROR@/],,ACFILE
TYPMSG: HLRZ CS,RC ;GET FIRST MESSAGE
CAIE CS,-1 ;SKIP IF MINUS ONE
PUSHJ PP,TYPM2 ;TYPE MESSAGE
HRRZ CS,RC ;GET SECOND HALF
PUSHJ PP,TYPM2
CRLF: MOVEI C,CR ;OUTPUT CARRIAGE RETURN
PUSHJ PP,TYO
MOVEI C,LF ;AND LINE FEED
TYO: SOSG CTOBUF+2 ;BUFFER FULL?
OUTPUT CTL,0 ;YES, DUMP IT
IDPB C,CTOBUF+1 ;STORE BYTE
CAIG C,FF ;FORM FEED?
CAIGE C,LF ;V TAB OR LINE FEED?
POPJ PP, ;NO
OUTPUT CTL,0 ;YES
POPJ PP, ;AND EXIT
TYPM2: MOVSI C,(1B0) ;ANTICIPATE REGISTER WORD
CAIN CS,ACFILE ;FILE NAME ?
JRST [JUMPE ACEXT,.+1 ;YES, TEST FOR EXT
LSH ACEXT,-6 ;MAKE SPACE FOR "."
IOR ACEXT,[SIXBIT /. @/]
JRST TYPM2A]
CAIG CS,17 ;IS IT?
MOVEM C,1(CS)
TYPM2A: HRLI CS,(POINT 6,,) ;FORM BYTE POINTER
TYPM3: ILDB C,CS ;GET A SIXBIT BYTE
CAIN C,40 ;"@"?
JRST TYO ;YES, TYPE SPACE AND EXIT
ADDI C,40 ;NO, FORM 7-BIT ASCII
PUSHJ PP,TYO ;OUTPUT CHARACTER
JRST TYPM3
TYPSYM: MOVEI C,0 ;CLEAR C
LSHC C,6 ;MOVE NEXT SIXBIT CHARACTER IN
JUMPE C,CPOPJ ;TEST FOR END
ADDI C,40 ;CONVERT TO ASCII
PUSHJ PP,TYO ;OUTPUT
JRST TYPSYM ;LOOP
XCEEDS: ADDI SX,2000 ;ADJUST SYMBOL POINTER
XCEED: PUSHJ PP,SAVEXS ;SAVE THE REGISTERS
HRRZ 1,.JBREL ;GET CURRENT TOP
MOVEI 0,2000(1)
CORE 0, ;REQUEST MORE CORE
JRST XCEED2 ;ERROR, BOMB OUT
HRRZ 2,.JBREL ;GET NEW TOP
XCEED1: MOVE 0,0(1) ;GET ORIGIONAL
MOVEM 0,0(2) ;STORE IN NEW LOCATION
SUBI 2,1 ;DECREMENT UPPER
CAMLE 1,SYMBOL ;HAVE WE ARRIVED?
SOJA 1,XCEED1 ;NO, GET ANOTHER
MOVEI 1,2000
ADDM 1,SYMBOL
ADDM 1,SYMTOP
PUSHJ PP,SRCHI ;RE-INITIALIZE SYMBOL TABLE
JRST RSTRXS ;RESTORE REGISTERS AND EXIT
XCEED2: HRROI RC,[SIXBIT /NEC INSUFFICIENT CORE@/]
XCEED3: TLO FR,LOADSW ;[326] MAKE SURE IT COMES BACK
PUSHJ PP,ERRNE0 ;[326] GO PRINT WHERE
CLOSE LST, ;[400] GIVE USER A PARTIAL LISTING
CLOSE BIN,40 ;[400] BUT NEVER A BUM REL FILE
JRST M ;[326] START ANOTHER ASSEMBLY
PDPERR: HRROI RC,[SIXBIT .PDL PDP OVERFLOW, TRY /P@.]
MOVE PP,[IOWD $USRLN,$USSTK] ; RESET BOTH TYPES OF STACKS
MOVEM PP,$USRPD ; INCLUDING USER TYPE
MOVE PP,SAVEPP ;GET A VALID STACK POINTER
JRST XCEED3 ;[326] DON'T CONTINUE ASSEMBLY
PRNUM: HLRZ CS,V ;GET MESSAGE
PUSHJ PP,TYPM2
MOVEI CS,[SIXBIT /ON PAGE@/]
PUSHJ PP,TYPM2
MOVE AC0,(V) ;GET PAGE
PUSHJ PP,DP1 ;PRINT NUMBER
MOVEI C,40
PUSHJ PP,TYO
SKIPN AC1,1(V) ;GET SEQ NUM IF THERE
JRST PRNUM1 ;NO, TRY FOR TAG
MOVEM AC1,OUTSQ
MOVEI CS,[SIXBIT /LINE@/]
PUSHJ PP,TYPM2
OUTPUT CTL,0 ;TO MAKE THINGS PRINT IN RIGHT ORDER
OUTSTR OUTSQ ;PRINT SEQUENCE NUMBER
MOVEI C," " ;ADD SPACE
PUSHJ PP,TYO
PRNUM1: MOVEI CS,[SIXBIT /AT@/]
PUSHJ PP,TYPM2
MOVE CS,2(V)
PUSHJ PP,TYPSYM ;PRINT TAG
MOVEI CS,[SIXBIT / +@/]
PUSHJ PP,TYPM2
HRRZ AC0,3(V)
PUSHJ PP,DP1 ;PRINT DECIMAL INCREMENT
PJRST CRLF ;END LINE
DP1: IDIVI AC0,^D10
HRLM AC1,(PP)
JUMPE AC0,.+2
PUSHJ PP,DP1
HLRZ C,(PP)
ADDI C,"0"
JRST TYO
RIM0: TDO FR,AC0 ;SET RIM/RIM10 FLAG
TLNE FR,PNCHSW ;FORGET IT IF PUNCH RESET
SETSTS BIN,IB ;SET TO IMAGE BINARY MODE
POPJ PP,
ROUT: EXCH CS,RIMLOC
SUB PP,[XWD 1,1] ;CLEAR OUT STACK WFW
TLNE FR,R1BSW
JRST ROUT6
TLNN FR,RIM1SW
JRST ROUT1
JUMPE CS,ROUT1 ;RIM10 OUTPUT
SUB CS,RIMLOC
JUMPE CS,ROUT1
JUMPG CS,ERRAX
MOVEI C,0
PUSHJ PP,PTPBIN
AOJL CS,.-1
ROUT1: MOVSI C,(DATAI PTR,) ;RIM OUTPUT
HRR C,LOCO ;GET ADDRESS
TLNE FR,RIM1SW ;NO DATAI IF RIM10
AOSA RIMLOC
PUSHJ PP,PTPBIN ;OUTPUT
MOVE C,AC0 ;CODE
AOSA LOCO ;INCREMENT CURRENT LOCATION
OUTBIN: TLNN FR,RIMSW!RIM1SW!R1BSW ;EXIT IF RIM MODE
PTPBIN: TLNN FR,PNCHSW ;EXIT IF PUNCH NOT REQUESTED
POPJ PP,
SOSG BINBUF+2 ;TEST FOR BUFFER FULL
PUSHJ PP,DMPBIN ;YES, DUMP IT
IDPB C,BINBUF+1 ;DEPOSIT BYTE
POPJ PP, ;EXIT
DMPBIN: OUT BIN,0 ;DUMP THE BUFFER
POPJ PP, ;NO ERRORS
TSTBIN: GETSTS BIN,C ;GET STSTUS BITS
TRNN C,ERRBIT ;ERROR?
POPJ PP, ;NO, EXIT
MOVE AC0,BINDEV ;YES, GET TAG
JRST ERRLST ;TYPE MESSAGE AND ABORT
DMPLST: OUT LST,0 ;OUTPUT BUFFER
POPJ PP, ;NO ERRORS
TSTLST: GETSTS LST,C ;ANY ERRORS?
TRNN C,ERRBIT
POPJ PP, ;NO, EXIT
MOVE AC0,LSTDEV
ERRLST: MOVSI RC,[SIXBIT /WLE OUTPUT WRITE-LOCK ERROR DEVICE@/]
TRNE C,IOIMPM ;IMPROPER MODE?
JRST ERRFIN ;YES
MOVSI RC,[SIXBIT /ODE OUTPUT DATA ERROR DEVICE@/]
TRNE C,IODERR ;DEVICE DATA ERROR?
JRST ERRFIN ;YES
MOVSI RC,[SIXBIT /OCP OUTPUT CHECKSUM OR PARITY ERROR DEVICE@/]
TRNE C,IODTER ;IS IT
JRST ERRFIN ;YES
MOVE CS,AC0 ;GET DEVICE
DEVCHR CS, ;FIND OUT WHAT IT IS
MOVSI RC,[SIXBIT /OQE OUTPUT QUOTA EXCEEDED ON DEVICE@/]
TLNN CS,DSKBIT ;SKIP IF DSK OUTPUT
MOVSI RC,[SIXBIT /OBL OUTPUT BLOCK TOO LARGE DEVICE@/]
JRST ERRFIN
R1BDMP: SETCM CS,R1BCNT
JUMPE CS,R1BI
HRLZS C,CS
HRR C,R1BLOC
HRRI C,-1(C)
MOVEM C,R1BCHK
PUSHJ PP,PTPBIN
HRRI CS,R1BBLK
R1BDM1: MOVE C,0(CS)
ADDM C,R1BCHK
PUSHJ PP,PTPBIN
AOBJN CS,R1BDM1
MOVE C,R1BCHK
PUSHJ PP,PTPBIN
R1BI: SETOM R1BCNT
PUSH PP,LOCO
POP PP,R1BLOC
POPJ PP,
ROUT6: CAME CS,RIMLOC
PUSHJ PP,R1BDMP
AOS C,R1BCNT
MOVEM AC0,R1BBLK(C)
AOS LOCO
CAIN C,.R1B-1
PUSHJ PP,R1BDMP
AOS RIMLOC
POPJ PP,
READ0: PUSHJ PP,EOT ;END OF TAPE
READ: SOSGE IBUF+2 ;BUFFER EMPTY?
JRST READ3 ;YES
READ1: ILDB C,IBUF+1 ;PLACE CHARACTER IN C
MOVE CS,@IBUF+1 ;CHECK FOR SEQUENCE NUMBER
TRNN CS,1
JRST READ1A
CAMN CS,[<ASCII / />+1] ;[261] HOWEVER IF AN SOS PAGE MARK
SETZ CS, ;[261] CLEAR SEQ NO. SO LINE NOT COUNTED
MOVEM CS,SEQNO
MOVEM CS,SEQNO2
MOVNI CS,4
ADDM CS,IBUF+2 ;ADJUST WORD COUNT
REPEAT 4,< IBP IBUF+1> ;SKIP SEQ NO
PUSHJ PP,READ ;AND THE TAB
JRST READ ;GET NEXT CHARACTER
READ1A: JUMPE C,READ ;IGNORE NULL
CAIN C,CZ ;IF IT'S A "^Z"
MOVEI C,LF ;TREAT IT AS A "LF"
CAIE C,CLA ;CONTROL _
POPJ PP,
MOVEI C,"^" ;MAKE CONTROL _ VISIBLE
PUSHJ PP,RSW2
MOVEI C,"_"
PUSHJ PP,RSW2
PUSHJ PP,PEEK ;[175] LOOK AT NEXT CHAR
CAIG C,CR ;[175] IF IT IS END OF LINE
CAIGE C,LF ;[175]
JRST [POP PP,CS ;[175] GET RETURN ADDRESS
PUSH PP,LIMBO ;[175] SAVE NEXT CHAR,RSW1 DESTROYS IT
MOVEI C,CLA ;[175] RETORE ^_
PUSHJ PP,(CS) ;[175] RETURN TO LIST CHAR ETC
POP PP,LIMBO ;[175] SAFE TO STORE NOW
POPJ PP,] ;[175] RETURN TO PROGRAM
TLZ IO,IORPTC ;[264] USE THE CHAR IN C NOW
JRST READ2A ;[264] BUT DON'T LIST TWICE
READ2: PUSHJ PP,READ ;YES, TEST FOR LINE FEED
PUSHJ PP,RSW2 ;LIST IN ANY EVENT
READ2A: CAIG C,FF ;[264] IS IT ONE OF
CAIGE C,LF ;LF, VT, OR FF?
JRST READ2 ;NO
PUSHJ PP,OUTIM1 ;YES, DUMP THE LINE
JRST READ ;RETURN NEXT CHARACTER
READ3: IN CHAR,0 ;GET NEXT BUFFER
JRST READ ;NO ERRORS
GETSTS CHAR,C
TRNN C,ERRBIT!2000 ;ERRORS?
JRST READ0 ;EOF
MOVE AC0,INDEV
READ4: MOVSI RC,[SIXBIT/PET INPUT PHYSICAL END OF TAPE DEVICE@/] ;[403]
TRNE C,2000
JRST ERRFIN ;E-O-T
MOVSI RC,[SIXBIT /MDE MONITOR DETECTED SOFTWARE INPUT ERROR DEVICE@/]
TRNE C,IOIMPM ;IMPROPER MODE?
JRST ERRFIN ;YES
MOVSI RC,[SIXBIT /IDE INPUT DATA ERROR DEVICE@/]
TRNE C,IODERR ;DEVICE DATA ERROR?
JRST ERRFIN ;YES
MOVSI RC,[SIXBIT /ICP INPUT CHECKSUM OR PARITY ERROR DEVICE@/]
TRNN C,IODTER
MOVSI RC,[SIXBIT /IBL INPUT BLOCK TOO LARGE DEVICE@/]
JRST ERRFIN
OUTAB2: PUSHJ PP,OUTTAB ;PRINT TWO TABS
OUTTAB: MOVEI C,HT
PRINT: CAIE C,CR ;IS THIS A CR?
CAIN C,LF ;OR LF?
JRST OUTCR ;YES, GO PROCESS
CAIN C,VT ;[257] VERT TAB?
JRST OUTVT ;[257] YES
CAIN C,FF ;FORM FEED?
JRST OUTFF ;YES, FORCE NEW PAGE
JRST OUTL
OUTVT: PUSH PP,C+1 ;[257] NEED ADJACENT ACC
MOVEI C,.LPP ;[257] NO. OF LINES WE STARTED WITH
SUB C,LPP ;[257] MINUS NO. OF LINES LEFT
IDIVI C,^D20 ;[257] HOW MANY WILL VT TAKE
SUBI C+1,^D20 ;[257] TO GET TO NEXT TAB STOP
ADDM C+1,LPP ;[257] ACCOUNT FOR THEM
POP PP,C+1 ;[257]
MOVEI C,VT ;[257] PUT CHAR BACK
SKIPLE LPP ;[257] DID WE END PAGE?
JRST OUTL ;[257] NO, OUTPUT IT
TLO IO,IOPAGE ;[257] YES, NEXT TIME
JRST OUTC ;[257] OUTPUT IT
OUTCR: TRNN ER,ERRORS!LPTSW!TTYSW
POPJ PP,
MOVEI C,CR ;CARRIAGE RETURN, LINE FEED
PUSHJ PP,OUTL
SOSGE LPP ;END OF PAGE?
TLO IO,IOPAGE ;YES, SET FLAG
TRCA C,7 ;FORM LINE FEED AND SKIP
OUTL: TLZN IO,IOPAGE ;NEW PAGE REQUESTED?
JRST OUTC ;NO
JUMP1 OUTC ;YES, BYPASS IF PASS ONE
PUSH PP,C ;SAVE C AND CS
PUSH PP,CS
PUSH PP,ER
TLNN IO,IOMSTR!IOPROG
HRR ER,OUTSW
TLNE IO,IOCREF ;IF DOING CREF OUTPUT NOW
TLNE FR,CREFSW ;AND CREFFING (JUST IN CASE)
JRST .+2
PUSHJ PP,CLSC3 ;CLOSE IT OUT
HLLM IO,(PP) ;SAVE THIS NEW STATE OF IO
MOVE C,..LPP ;[227]
ADDI C,2 ;[227] PUT BACK THE 2 LINES
MOVEM C,LPP ;SET NEW COUNTER
MOVEI C,CR
PUSHJ PP,OUTC
MOVEI C,FF
PUSHJ PP,OUTC ;OUTPUT FORM FEED
MOVEI CS,TBUF
PUSHJ PP,OUTAS0 ;OUTPUT TITLE
MOVEI CS,VBUF
PUSHJ PP,OUTAS0 ;OUTPUT VERSION
MOVEI CS,DBUF
PUSHJ PP,OUTAS0 ; AND DATE
MOVE C,PAGENO
PUSHJ PP,DNC ;OUTPUT PAGE NUMBER
AOSG PAGEN. ;FIRST PAGE OF THIS NUMBER?
JRST OUTL1 ;YES
MOVEI C,"-" ;NO, PUT OUT MODIFIER
PUSHJ PP,OUTC
MOVE C,PAGEN.
PUSHJ PP,DNC
OUTL1: PUSHJ PP,OUTCR
MOVEI CS,DEVBUF
PUSHJ PP,OUTAS0
HRRZ CS,SUBTTX ;SWITCH FOR SUB-TITLE
SKIPE 0(CS) ;IS THERE A SUB-TITLE?
PUSHJ PP,OUTTAB ;YES, OUTPUT A TAB
PUSHJ PP,SOUT20 ;OUTPUT ASCII WITH CARRIAGE RETURN
PUSHJ PP,OUTCR
POP PP,ER
POP PP,CS ;RESTORE REGISTERS
POP PP,C
OUTC: TRNE ER,ERRORS!TTYSW
PUSHJ PP,TYO
TRNN ER,LPTSW
POPJ PP,
OUTLST: SOSG LSTBUF+2 ;BUFFER FULL?
PUSHJ PP,DMPLST ;YES, DUMP IT
IFN STANSW,< CAIN C,"@"
MOVEI C,140
CAIN C,"_"
MOVEI C,30
CAIN C,"^"
MOVEI C,32
CAIE C,"\"
JRST OUTLSS
MOVEI C,177
IDPB C,LSTBUF+1
JRST OUTLST
OUTLSS: >
IDPB C,LSTBUF+1 ;STORE BYTE
POPJ PP, ;EXIT
OUTFF: TLOA IO,IOPAGE ;[161]
OUTFF1: PUSHJ PP,PAGE1 ;[161] CLOSE CREF
OUTFF2: SETOM PAGEN. ;[161]
AOS PAGENO ;[161]
POPJ PP, ;[161]
TIMOUT: IDIVI 2,^D60*^D1000
TIMOU1: IDIVI 2,^D60
PUSH PP,3 ;SAVE MINUTES
PUSHJ PP,OTOD ;STORE HOURS
MOVEI 3,":" ;SEPARATE BY COLON
IDPB 3,CS
POP PP,2 ;STORE MINUTES
OTOD: IDIVI 2,^D10
ADDI 2,60 ;FORM ASCII
IDPB 2,CS
ADDI 3,60
IDPB 3,CS
POPJ PP,
DATOUT: IDIVI 1,^D31 ;GET DAY
ADDI 2,1
CAIG 2,^D9 ;TWO DIGITS?
ADDI 2,7760*^D10 ;NO, PUT IN SPACE
PUSHJ PP,OTOD ;STORE DAY
IDIVI 1,^D12 ;GET MONTH
MOVE 2,DTAB(2) ;GET MNEMONIC
IDPB 2,CS ;DEPOSIT RIGHT MOST 7 BITS
LSH 2,-7 ;SHIFT NEXT IN
JUMPN 2,.-2 ;DEPOSIT IFIT EXISTS
MOVEI 2,^D64(1) ;GET YEAR
JRST OTOD ;STORE IT
DTAB: "-NAJ-"
"-BEF-"
"-RAM-"
"-RPA-"
"-YAM-"
"-NUJ-"
"-LUJ-"
"-GUA-"
"-PES-"
"-TCO-"
"-VON-"
"-CED-"
;[115] BINARY UNIVERSALS
;HERE TO WRITE OUT UNIVERSAL SYMBOL FILE
;SYMBOL TABLE PLUS MACROS
UNVOUT: HRRZ AC0,FREE ;GET HIGHEST FREE LOCATION
MOVEM AC0,.JBFF ;INTO JOBFF
INIT UNV,B ;INIT DSK FOR OUTPUT
SIXBIT /DSK/
XWD UNVBUF,0 ;OUTPUT ONLY
JRST UNVINT ;[431] ERROR
MOVSI AC0,'UNV' ;STANDARD EXT
MOVEM AC0,UNVDIR+1
SETZM UNVDIR+2
SETZM UNVDIR+3 ;CLEAR PPN
ENTER UNV,UNVDIR ;ENTER FILE
JRST UNVENT ;[431] ERROR
MOVEI SDEL,2*203 ;STANDARD DOUBLE BUFFERING
ADD SDEL,FREE ;FROM FREE CORE
CAML SDEL,SYMBOL ;MORE CORE NEEDED?
PUSHJ PP,XCEED ;YES
SUBI SDEL,2*203 ;BACK TO START OF BUFFER
MOVEM SDEL,.JBFF ;SETUP FOR BUFFERS
OUTBUF UNV,2 ;SET THEM UP
MOVSI AC1,777 ;SPECIAL MARKER FIRST WORD
HRRI AC1,.UVER ;STORE VERSION NUMBER
PUSHJ PP,UNVBIN ;LOADER BLOCK 777?
MOVE AC1,@SYMBOL ;GET NUMBER OF SYMBOLS
MOVN SDEL,AC1
HRLZS SDEL
HRR SDEL,SYMBOL ;FORM AOBJN POINTER
PUSHJ PP,UNVBIN ;OUTPUT NUMBER OF SYMBOLS
ADDI SDEL,1 ;BYPASS COUNT
UNVLUP: MOVE AC1,(SDEL) ;GET SYMBOL
PUSHJ PP,UNVBIN
ADDI SDEL,1
MOVE AC1,(SDEL) ;GET VALUE
TLNE AC1,SPTR ;SPECIAL EXTERNAL POINTER?
JRST UNVSPT ;YES
TLNE AC1,EXTF ;EXTERNAL (BUT NOT SPTR)?
JRST UNVEXT ;YES, OUTPUT 2 WORDS
TLNE AC1,MACF ;MACRO
JRST UNVMAC ;YES, SAVE MACRO TEXT ALSO
TLNE AC1,PNTF ;ONLY A POINTER TO VALUE?
JRST UNVPTF ;YES
PUSHJ PP,UNVBIN ;OUTPUT VALUE
UNVNXT: AOBJN SDEL,UNVLUP ;FOR ALL SYMBOLS
RELEASE UNV,
POPJ PP,
UNVINT: PUSHJ PP,EWARN ;[431] NOT FATAL
AOS QERRS ;[431] INCREMENT WARNING COUNT
MOVE AC0,UNVDIR ;[431] FILENAME IN AC0
MOVSI RC,[SIXBIT /UWU UNABLE TO WRITE UNIVERSAL FILE@/] ;[431]
PJRST TYPMSG ;[431] TYPE MESSAGE AND EXIT
UNVENT: PUSHJ PP,EWARN ;[431] NOT FATAL
AOS QERRS ;[431] INCREMENT WARNING COUNT
MOVSI CS,'EFU' ;[431] ENTER FAILED UNIVERSAL MNEMONIC
PUSHJ PP,TYPSYM ;[431]
MOVEI C," " ;[431] THROW IN A SPACE
PUSHJ PP,TYO ;[431]
HRRZ RC,UNVDIR+1 ;[431] GET ERROR BITS
SKIPN RC ;[431]
SOS RC ;[431] =0 SPECIAL CASE
CAIL RC,TABLND-TABLE ;[431] WITHIN BOUNDS?
JRST [HLRZ CS,TABLND ;[431] CATCH-ALL ERR MESS
JRST .+2] ;[431]
HLRZ CS,TABLE(RC) ;[431] REFERENCE TABLE
PUSHJ PP,TYPM2 ;[431] GIVE APPROPRIATE MESSAGE
MOVE AC0,UNVDIR ;[431] FILE NAME
MOVSI RC,[SIXBIT /UNIVERSAL FILE@/] ;[431]
PJRST TYPMSG ;[431] FINISH OFF AND EXIT
;HERE FOR EXTERNAL (NOT SPTR)
UNVEXT: MOVE AC2,AC1 ;GET POINTER
HLLZ AC1,AC1 ;CLEAR POINTER
PUSHJ PP,UNVBIN ;OUTPUT FLAGS
MOVE AC1,0(AC2) ;GET FIRST WORD (VALUE)
PUSHJ PP,UNVBIN
MOVE AC1,1(AC2) ;GET SECOND WORD (SYMBOL)
PUSHJ PP,UNVBIN
JRST UNVNXT
;HERE FOR 36 BIT VALUE
UNVPTF: MOVE AC2,AC1 ;GET COPY
HLLZ AC1,AC1 ;CLEAR POINTER
PUSHJ PP,UNVBIN ;OUTPUT FLAGS
MOVE AC1,(AC2) ;GET VALUE
PUSHJ PP,UNVBIN ;OUTPUT IT
JRST UNVNXT
;HERE FOR SPECIAL EXTERNAL SYMBOL
UNVSPT: MOVE AC2,AC1 ;COPY POINTER
HLLZ AC1,AC1 ;CLEAR POINTER
PUSHJ PP,UNVBIN ;OUTPUT FLAGS
MOVE AC1,(AC2) ;GET FIRST WORD
PUSHJ PP,UNVBIN ;STORE VALUE
MOVE AC1,1(AC2) ;GET RELOCATION WORD
MOVE AC2,AC1 ;COPY IT
PUSHJ PP,UNVBIN
TRNN AC2,-1 ;RIGHT HALF RELOCATION?
JRST .+5 ;NO
MOVE AC1,(AC2) ;GET VALUE
PUSHJ PP,UNVBIN
MOVE AC1,1(AC2) ;EXTERNAL SYMBOL
PUSHJ PP,UNVBIN
TLNN AC2,-1 ;LEFT HALF RELOCATION?
JRST UNVNXT ;NO
HLRZS AC2 ;YES, SWAP
JRST .-7 ;AND OUTPUT
;HERE FOR MACRO
UNVMAC: MOVE AC2,AC1 ;GET POINTER TO TEXT
HLLZ AC1,AC1 ;CLEAR POINTER
PUSHJ PP,UNVBIN ;OUTPUT FLAGS
HLRZ AC1,1(AC2) ;[334] GET DEFAULT VALUES, IF ANY
MOVEM AC1,UNVDFA ;[334] SAVE STARTING ADDRESS
PUSHJ PP,UNVMCP ;[334] GO DUMP MACRO ITSELF
SKIPN AC2,UNVDFA ;[334] SEE IF ANY DEFAULT VALUES (LEFT)
JRST UNVNXT ;[334] NO, CONTINUE WITH NEXT SYMBOL
HRROI AC1,(AC2) ;[334] SET UP AOBJP POINTER FOR # OF DEFAULTS
SKIPE (AC1) ;[334] ARE THERE ANY MORE?
AOBJP AC1,.-1 ;[334] YES, COUNT AND TRY NEXT
PUSHJ PP,UNVBIN ;[334] OUTPUT COUNT WORD
UNVMC1: HLRZ AC1,(AC2) ;[334] GET THE AGUMENT # OF THIS DEFAULT
PUSHJ PP,UNVBIN ;[334] OUTPUT THE ARGUMENT NUMBER
MOVE AC2,(AC2) ;[334] GET ADDRESS OF DEFAULT
PUSHJ PP,UNVMCP ;[334] GO OUTPUT, IT LOOKS LIKE MACRO
AOS AC2,UNVDFA ;[334] UP POINTER TO DEFAULT BLOCK
SKIPE (AC2) ;[334] SEE IF ANY MORE
JRST UNVMC1 ;[334] YES, GO WRITE THEM OUT
JRST UNVNXT ;[334] NO, GO DO NEXT SYMBOL
UNVMCP: HLL AC2,(AC2) ;[334] PUT ADDRESS OF NEXT BLOCK IN LEFT
QQ==0
REPEAT .LEAF,<
MOVE AC1,QQ(AC2)
PUSHJ PP,UNVBIN
QQ==QQ+1>
HLRZS AC2
JUMPN AC2,UNVMCP ;[334] MORE LEAFS TO PROCESS
POPJ PP, ;[334] RETURN
UNVBIN: SOSG UNVBUF+2
PUSHJ PP,DMPUNV
IDPB AC1,UNVBUF+1
POPJ PP,
DMPUNV: OUT UNV,0
POPJ PP,
GETSTS UNV,C ;[403] GET STATUS BITS
TRNN C,ERRBIT ;[403] ERRORS?
POPJ PP, ;[403] NO, EXIT
MOVSI AC0,'DSK' ;[431] DEVICE ALWAYS DSK
JRST ERRLST ;[403] GIVE ERROR MESSAGE
;HERE TO READ IN UNIVERSAL SYMBOL TABLE
UNVINP: MOVEM AC0,UNVDIR ;FILE WE NEED
PUSH PP,AC0 ;[240] SAVE REAL NAME OF UNV
MOVSI AC1,'DSK' ;[240] DEFAULT DEVICE
MOVEM AC1,UNVDEV ;[240]
MOVSI AC1,'UNV' ;REQUIRED EXT
MOVEM AC1,UNVDIR+1
SETZM UNVDIR+2
SETZM UNVDIR+3
CAIE C,'(' ;[240] SEE IF USER SUPPLIED FILE SPEC
JRST UNVOPN ;[240] NO, USE DEFAULT
PUSHJ PP,SCHGET ;[240] GET A NAME
CAIE C,':' ;[240] IS IT A DEVICE?
JRST UNVCKN ;[240] NO TRY NAME
MOVEM AC0,UNVDEV ;[240] YES, SAVE DEVICE
PUSHJ PP,SCHGET ;[240] TRY NEXT NAME
UNVCKN: MOVEM AC0,UNVDIR ;[240] SAVE NAME
CAIE C,'.' ;[240] DOES EXT FOLLOW?
JRST .+3 ;[240] NO
PUSHJ PP,SCHGET ;[240] YES, GET IT
MOVEM AC0,UNVDIR+1 ;[240] AND STORE IT
CAIE C,'[' ;[240] A DIRECTORY SPECIFIED?
JRST SCHCLP ;[240] NO
PUSHJ PP,SCHOCT ;[240] GET PPN
HRLZM AC0,UNVDIR+3 ;[240] AND SAVE IT
CAIE C,',' ;[240] CHECK PROG NO.
TROA ER,ERRQ ;[240] WARN USER
PUSHJ PP,SCHOCT ;[240] GRT IT
HRRM AC0,UNVDIR+3 ;[240]
CAIE C,',' ;[240] AN SFD GIVEN?
JRST SCHCLB ;[240] NO
MOVEI AC0,UNVPTH ;GET PATH PTR
EXCH AC0,UNVDIR+3 ;[240] SWAP WITH PPN
MOVEM AC0,UNVPTH+2 ;[240] AND PUT IN PATH
MOVSI RC,-.SFDLN ;[240] AOBJN PTR FOR SFDS
SCHSFD: PUSHJ PP,SCHGET ;[240] GET SFD NAME
AOBJP RC,SCHCLB+1 ;[240] SEE IF ENOUGH ROOM
MOVEM AC0,UNVPTH+2(RC) ;[240] YES, STORE
CAIN C,',' ;[240] DOES PATH CONTINUE ON?
JRST SCHSFD ;[240] YES
SCHCLB: CAIE C,']' ;[240] DOES PATH FINISH PROPERLY?
TROA ER,ERRQ ;[240] NO
PUSHJ PP,BYPAS1 ;[240] EAT UP THE "]"
SCHCLP: CAIE C,')' ;[240] FILE SPEC END PROPERLY?
TROA ER,ERRQ ;[240] NO
PUSHJ PP,BYPAS1 ;[240] EAT IT
UNVOPN: POP PP,AC0 ;[240] UNV NAME BACK IN 0
OPEN UNV,UNVINI ;[240] TRY USER SPECIFICATION
JRST UNVUNV ;FAILED
LOOKUP UNV,UNVDIR ;SEE IF THERE
JRST UNVUNV ;TRY UNV:
MOVEM AC0,UNVDIR ;[240] RESTORE NAME OF UNV
UNVFND: AOS RC,UNIVNO ;BUMP COUNT OF UNIVERSALS
CAILE RC,.UNIV ;SEE IF ROOM IN TABLES
JRST UNVERR ;NO, GIVE ERROR
SKIPN UNIVSN ;IS CURRENT PROG A UNIVERSAL
JRST UNVNOT ;NO
CAIL RC,.UNIV ;YES, ROOM FOR IT AS WELL?
JRST UNVERR ;NO
MOVE AC1,UNITBL(RC) ;GET CURRENT NAME
MOVEM AC1,UNITBL+1(RC) ;STORE IT IN NEXT SLOT
UNVNOT: MOVEM AC0,UNITBL(RC) ;STORE NAME
HLRE SDEL,UNVDIR+3 ;GET SIZE OF FILE
MOVMS SDEL ;IN WORDS
ADD SDEL,FREE ;AT TOP OF FREE CORE
HRRZM SDEL,UNIPTR(RC) ;SAVE NEW SYMTOP (IN WRONG HALF)
ADDI SDEL,2*203 ;PLUS 2 BUFFERS
CAML SDEL,SYMBOL ;WILL IT FIT?
PUSHJ PP,XCEED ;NO, TRY FOR MORE
CAML SDEL,SYMBOL ;DID WE GET ENOUGH?
JRST .-2 ;NO TRY AGAIN
SUBI SDEL,2*203 ;START OF BUFFERS
MOVEM SDEL,.JBFF
INBUF UNV,2 ;STANDARD DOUBLE BUFFERING
PUSHJ PP,UNVREAD ;READ AND IGNORE FIRST WORD (777 MARKER)
HRRZS AC1 ;GET UNV VERSION #
SETOM UNVER% ;[334] KLUDGE SWITCH TO ALLOW VERSION 4
CAIE AC1,4 ;[334] SEE IF 4 (MIGHT BOMB DEFAULT ARGUMENTS)
AOSA UNVER% ;[334] NO, UNVER% IS 0 FOR GOOD FILES
AOS AC1 ;[334] VERSION 4 NEEDS FUDGING
CAIE AC1,.UVER ;BETTER MATCH
JRST VERSKW ;[364] YOU LOSE
PUSHJ PP,UNVREAD ;READ SYMBOL COUNT (SECOND WORD)
MOVE SDEL,AC1 ;GET COPY
LSH SDEL,1 ;TWO WORDS PER SYMBOL
ADDI SDEL,1 ;PLUS ONE FOR COUNT
MOVNS SDEL ;NEGATE
MOVE AC2,SDEL ;STORE IT
ADD AC2,UNIPTR(RC) ;ADD SYMTOP
HRLM AC2,UNIPTR(RC) ;TO FORM SYMBOL
MOVSS UNIPTR(RC) ;NOW PUT IN CORRECT HALVES
MOVN SDEL,AC1 ;GET NO. OF SYMBOLS
HRLZ SDEL,SDEL ;TO FORM AOBJN POINTER
HRR SDEL,AC2 ;POINT TO WHERE TO STORE THEM
MOVEM AC1,(SDEL) ;STORE COUNT
ADDI SDEL,1 ;AND GET PAST IT
UNVRLO: PUSHJ PP,UNVREAD ;GET A SYMBOL
MOVEM AC1,(SDEL) ;STORE IT
ADDI SDEL,1 ;INCREMENT PAST IT
PUSHJ PP,UNVREAD ;GET VALUE
MOVEM AC1,(SDEL) ;STORE IT
TLNE AC1,SPTR ;SPECIAL EXTERNAL POINTER?
JRST UNVRSP ;YES
TLNE AC1,EXTF ;EXTERNAL (NOT SPTR)?
JRST UNVREX ;YES
TLNE AC1,MACF ;MACRO?
JRST UNVRMC ;YES
TLNE AC1,PNTF ;36 BIT VALUE
JRST UNVRPT ;YES
UNVRNX: AOBJN SDEL,UNVRLO ;GET NEXT
RELEASE UNV,
MOVE RC,UNIVNO ;POINT TO LAST ENTRY
MOVE AC1,UNITBL+1(RC) ;GET NAME INCASE IN UNIV NOW
SKIPE UNIVSN ;ARE WE?
MOVEM AC1,UNVDIR ;YES, RESET NAME OF OUTPUT FILE
IFN POLISH,<
PUSH PP,SGSBOT
PUSH PP,SGSTOP
PUSH PP,SGSCNT
PUSH PP,SGNCUR
>
PUSH PP,SYMBOL
PUSH PP,SYMTOP ;SAVE EXISTING VALUES
PUSH PP,SRCHX
MOVE AC1,UNIPTR(RC) ;GET SYMTOP,,SYMBOL
HLRZM AC1,SYMTOP
HLRZM AC1,FREE ;DON'T FORGET TO SET FREE BEYOND SYMTOP
HRRZM AC1,SYMBOL
HLRZ AC1,AC1 ;TOP LOCATION
MOVEM AC1,UNITOP ;SAVE NEW TOP FOR UNIVERSALS
CAMLE AC1,MACSIZ ;HAVE WE INCREASED?
MOVEM AC1,MACSIZ ;YES, STOP ILL MEM REFS
IFN POLISH,<
SETZM SGNCUR
MOVE AC0,@SYMBOL
MOVEM AC0,SGSCNT
>
PUSHJ PP,SRCHI ;SETUP SEARCH POINTER
MOVE AC1,SRCHX ;LOAD IT
MOVEM AC1,UNISHX(RC) ;SAVE IT
POP PP,SRCHX ;RESTORE
POP PP,SYMTOP
POP PP,SYMBOL
IFN POLISH,<
POP PP,SGNCUR
POP PP,SGSCNT
POP PP,SGSTOP
POP PP,SGSBOT
>
JRST SERCH1 ;AND RETURN
;HERE FOR 36 BIT VALUE
UNVRPT: PUSHJ PP,UNVREAD
AOS AC2,FREE ;GET A FREE LOC
SUBI AC2,1
MOVEM AC1,(AC2) ;STORE IT
HRRM AC2,(SDEL) ;FIXUP SYMBOL POINTER
JRST UNVRNX ;GET NEXT
;HERE FOR EXTERNAL (NOT SPTR)
UNVREX: MOVEI AC2,2 ;NEED 2 LOCS
ADDB AC2,FREE
SUBI AC2,2 ;POINT TO START OF 2 WORDS
PUSHJ PP,UNVREAD ;GET VALUE
MOVEM AC1,0(AC2) ;MOST LIKELY 0
PUSHJ PP,UNVREAD ;GET NAME
MOVEM AC1,1(AC2)
HRRM AC2,(SDEL) ;POINT TO VALUE
JRST UNVRNX ;GET NEXT
;HERE FOR SPECIAL EXTERNAL SYMBOL
UNVRSP: MOVEI AC2,2 ;GET 2 LOCATIONS
ADDB AC2,FREE ;FROM FREE CORE
SUBI AC2,2 ;POINT TO START OF 2 WORDS
PUSHJ PP,UNVREAD ;GET VALUE
MOVEM AC1,(AC2)
PUSHJ PP,UNVREAD ;GET RELOCATION
HRRM AC2,(SDEL) ;STORE POINTER
MOVEI RC,1(AC2) ;POINT TO RELOCATION WORD
SETZM (RC) ;CLEAR RELOCATION
MOVE AC2,AC1 ;STORE PREVIOUS RELOCATION
TRNN AC2,-1 ;RIGHT HALF RELOCATION?
JRST UNVRS2 ;NO
HRR AC2,FREE ;POINT TO NEXT 2 WORD BLOCK
HRRM AC2,(RC) ;POINT TO BLOCK (RELOCATION)
UNVRS1: PUSHJ PP,UNVREAD ;GET VALUE
MOVEM AC1,(AC2)
PUSHJ PP,UNVREAD ;GET EXTERNAL SYMBOL
MOVEM AC1,1(AC2)
HRRI AC2,2(AC2) ;INCREMENT RIGHT HALF BY 2 WORDS USED
HRRZM AC2,FREE ;INCREMENT FREE
UNVRS2: TLZN AC2,-1 ;LEFT HALF RELOCATION?
JRST UNVRNX ;NO, GET NEXT SYMBOL
HRLM AC2,(RC) ;FIX LEFT RELOCATION
JRST UNVRS1 ;AND FILL IN VALUE
;HERE FOR MACRO
UNVRMC: MOVE AC2,FREE ;FREE LOC COUNTER
HRRM AC2,(SDEL) ;IS WHERE MACRO STARTS
MOVEM AC2,UNVDFA ;[334] SAVE STARTING ADDRESS OF MACRO
PUSHJ PP,UNVRML ;[334] GO READ IN MACRO DEFINITION
MOVE AC1,UNVDFA ;[334] GET STARTING ADDRESS BACK
HLRZ AC2,1(AC1) ;[334] GET POINTER FOR ANY DEFAULTS
JUMPE AC2,UNVRNX ;[334] NONE, GO DO NEXT SYMBOL
SKIPE UNVER% ;[334] MAKE SURE WE WROTE THEM ON DISK
JRST UNVRER ;[334] NO, TELL USER
PUSH PP,SDEL ;[334] SAVE AOBJN POINTER
MOVE AC2,FREE ;[334] GET NEXT FREE ADDRESS
HRLM AC2,1(AC1) ;[334] POINT TO IT IN MACRO BODY
PUSHJ PP,UNVREAD ;[334] GO READ COUNT OF DEFAULTS
MOVN SDEL,AC1 ;[334] COPY COUNT TO AOBJN POINTER
HRRI SDEL,(AC2) ;[334] SET AOBJN ADDRESS INTO SDEL
HLRZ AC2,AC1 ;[334] GET COUNT-1 OF DEFAULTS
ADDI AC2,2 ;[334] CHANGE TO COUNT+1 (+0 WORD)
ADDB AC2,FREE ;[334] BUMP FREE BY DEFAULT POINTER BLOCK LENGTH
UNVRM1: PUSHJ PP,UNVREAD ;[334] GO READ ARGUMENT NUMBER
HRLM AC1,(SDEL) ;[334] SAVE IN POINTER BLOCK
HRRM AC2,(SDEL) ;[334] SAVE START OF VALUE (MAY BE SET UP BY UNVRML)
PUSHJ PP,UNVRML ;[334] GO COPY DEFAULT VALUE
AOBJN SDEL,UNVRM1 ;[334] DO ALL DEFAULTS
SETZM (SDEL) ;[334] CLEAR END OF BLOCK WORD
POP PP,SDEL ;[334] RESTORE BIG AOBJN WORD
JRST UNVRNX ;[334] GO DO NEXT SYMBOL
UNVRML: QQ==0
REPEAT .LEAF,<
PUSHJ PP,UNVREAD
MOVEM AC1,QQ(AC2) ;STORE
QQ==QQ+1>
MOVE AC1,(AC2) ;SEE WHAT FIRST WORD WAS
TLNN AC1,-1 ;IF ZERO THEN FINISHED
JRST UNVRMF ;SET LAST BLOCK POINTER
MOVEI AC1,.LEAF(AC2) ;POINT TO NEXT BLOCK
HRLM AC1,(AC2) ;FILL IT IN
ADDI AC2,.LEAF ;POINT TO IT
JRST UNVRML ;AND LOOP
UNVRMF: MOVE AC1,(SDEL) ;GET FIRST BLOCK
HRRM AC2,(AC1) ;POINT TO LAST
ADDI AC2,.LEAF ;POINT TO NEXT FREE
MOVEM AC2,FREE
POPJ PP, ;[334] RETURN
UNVRER: MOVSI RC,[SIXBIT /OUF UNIVERSAL FILE DEFAULT ARGUMENTS LOST, REASSEMBLE@/];[334]
JRST ERRFIN ;[334] PRINT THAT HAD DEFAULTS WHICH WERE LOST
UNVREA: SOSG UNVBUF+2
PUSHJ PP,UNVRIN
ILDB AC1,UNVBUF+1
POPJ PP,
UNVRIN: IN UNV,
POPJ PP,
GETSTS UNV,C ;[403] GET STATUS BITS
TRNN C,ERRBIT!2000 ;[403] ERRORS?
JRST UNVRN1 ;[431] E-O-F
MOVE AC0,UNVDEV ;[403] GET DEVICE
JRST READ4 ;[403] GIVE I/O ERROR MESSAGE
UNVRN1: MOVSI RC,[SIXBIT /ERU UNEXPECTED END-OF-FILE READING UNIVERSAL FILE@/] ;[431] NAME IN AC0
JRST ERRFIN ;[431] GIVE ERROR MESSAGE
UNVUNV: MOVEM AC0,UNVDIR ;[240] RESTORE REAL NAME
MOVSI AC1,'UNV' ;[240] AND DEFAULT EXT
MOVEM AC1,UNVDIR+1 ;[240]
SETZM UNVDIR+2 ;[240]
SETZM UNVDIR+3 ;[240] DEFAULT PATH
INIT UNV,B
SIXBIT /UNV/
UNVBUF
JRST UNVSYS
LOOKUP UNV,UNVDIR
JRST UNVSYS
JRST UNVFND
UNVSYS: INIT UNV,B
SIXBIT /SYS/
UNVBUF
JRST SCHERR
LOOKUP UNV,UNVDIR ;SEE IF THERE
JRST SCHERR ;NO
JRST UNVFND ;GOT IT
SUBTTL MACHINE INSTRUCTION SEARCH ROUTINES
IFE OPHSH,<
OPTSCH: MOVEI RC,0
MOVEI ARG,1B^L<OP1END-OP1TOP> ;SET UP INDEX
MOVEI V,1B^L<OP1END-OP1TOP>/2 ;SET UP INCREMENT
OPT1A: CAMN AC0,OP1TOP(ARG) ;ARE WE POINTING AT SYMBOL?
JRST OPT1D ;YES, GET THE CODE
JUMPE V,POPOUT ;TEST FOR END
CAML AC0,OP1TOP(ARG) ;NO, SHOULD WE MOVE DOWN?
TDOA ARG,V ;NO, INCREMENT
OPT1B: SUB ARG,V ;YES, DECREMENT
ASH V,-1 ;HALVE INCREMENT
CAIG ARG,OP1END-OP1TOP ;ARE WE OUT OF BOUNDS?
JRST OPT1A ;NO, TRY AGAIN
JRST OPT1B ;YES, BRING IT DOWN A PEG
>
IFN OPHSH,<
OPTSCH: MOVE ARG,AC0 ;GET SIXBIT NAME
TLZ ARG,400000 ;CLEAR SIGN BIT
IDIVI ARG,PRIME ;REM. GOES IN V
CAMN AC0,OP1TOP(V) ;ARE WE POINTING AT SYMBOL?
JRST OPT1D ;YES
SKIPN OP1TOP(V) ;TEST FOR END
JRST OPT1B ;SYMBOL NOT FOUND
HLRZ RC,ARG ;SAVE LHS OF QUOTIENT
SKIPA ARG,RC ;GET IT BACK
OPT1A: ADDI ARG,(RC) ;INCREMENT ARG
ADDI V,(ARG) ;QUADRATIC INCREASE TO V
CAIL V,PRIME ;V IS MODULO PRIME
JRST [SUBI V,PRIME
JRST .-1]
CAMN AC0,OP1TOP(V) ;IS THIS IT?
JRST OPT1D ;YES
SKIPE OP1TOP(V) ;END?
JRST OPT1A ;TRY AGAIN
OPT1B: SETZ RC, ;[134] CLEAR RELOCATION INCASE IMPLICIT OPDEF
POPJ PP, ;FAILED
>
OPT1D:
IFN OPHSH,< SETZ RC, ;CLEAR RELOCATION
MOVE ARG,V ;GET INDEX IN RIGHT ACC.>
IDIVI ARG,4 ;ARG HAS INDEX USED IN OPTTAB
LDB V,OPTTAB(V) ;V HAS INDEX TO OPTTAB
CAIL V,700 ;PSEUDO-OP OR IO INSTRUCTION?
JRST OPT1G ;YES
ROT V,-^D9 ;LEFT JUSTIFY
HRRI V,OP ;POINT TO BASIC FORMAT
OPT1F: AOS 0(PP) ;SET FOR SKIP EXIT
MOVEI SDEL,%OP ;SET OP-CODE CROSS-REF FLAG
JRST CREF ;TEST AND OUTPUT, AC0=SYMBOL, V=VALUE
OPT1G: JUMPG AC0,[CAME AC0,['.XCREF'] ;[141] DON'T CREF .XCREF
JRST .+3 ;IF ".","$",OR "%" USE TABLE 1
MOVE V,OP1TAB-700(V) ;[217] USE TABLE 1
JRST CPOPJ1] ;[217] AND BYPASS CREF
TLNN AC0,200000 ;PSEUDO-OP OR IO INST., TEST FOR PROPER TABLE
SKIPA V,OP2TAB-700(V) ;2ND TABLE, FIRST LETTER IS "A" TO "O"
MOVE V,OP1TAB-700(V) ;1ST TABLE, ..."P" TO "Z"
JRST OPT1F ;EXIT
OPTTAB:
IFE OPHSH,< POINT 9,OP1COD-1(ARG),35>
POINT 9,OP1COD (ARG), 8
POINT 9,OP1COD (ARG),17
POINT 9,OP1COD (ARG),26
IFN OPHSH,< POINT 9,OP1COD (ARG),35>
.XCREF ;DON'T CREF THIS MESS
IFE OPHSH,<
RELOC .-1
OP1TOP:
RELOC
IF1, < N1=0
LSYM== SIXBIT /ADD/
DEFINE $FAIL(SYMBOL)< PRINTX ? SYMBOL -BAD OPCODE ORDER>
DEFINE X (SYMBOL,CODE)<
IFL <SIXBIT /SYMBOL/-LSYM>,< $FAIL(SYMBOL)>
LSYM== <SIXBIT /SYMBOL/>
N1=N1+1>>
IF2, <
N2=^D36
CC=0
RELOC OP1COD
RELOC
DEFINE X (SYMBOL,CODE)
<SIXBIT /SYMBOL/
CC=CC+CODE_<N2=N2-9>
IFE N2, <OUTLIT>>
DEFINE OUTLIT <
RELOC
+CC
RELOC
N2=^D36+<CC=0>>>
SYN X,XX ;JUST THE SAME MACRO>
IFN OPHSH,<
DEFINE XX (SB,CD)<> ;A NUL MACRO
OP1TOP: IF1,< BLOCK PRIME>
IF1,<DEFINE X (SB,CD)<>>
IF2,<
DEFINE OPSTOR (RM)<.$'RM=.$'RM+<OPCODE_<9*<3-R&3>>>>
DEFINE X (SB,CD)<
SXB=<SIXBIT /SB/>
Q=SXB&-1_-1/PRIME
R=SXB&-1_-1-Q*PRIME
H=Q_-22&777
TRY=1
OPCODE=CD
ITEM Q,\R
IFL PRIME-TRY,<PRINTX HASH FAILURE>>
DEFINE ITEM (QT,RM)<
IFN .%'RM,<R=R+H
IFL PRIME-R,<R=R-R/PRIME*PRIME>
H=H+Q_-22&777
IFGE PRIME-<TRY=TRY+1>,<ITEM Q,\R>>
IFE .%'RM,<.%'RM=SXB
OPSTOR \<R/4>>>>
IF1,<
DEFINE GETSYM (N)<.%'N=0>
N=0
XLIST
REPEAT PRIME,<GETSYM \N
N=N+1>
DEFINE GETSYM (N)<.$'N=0>
N=0
REPEAT <PRIME/4+1>,<GETSYM \N
N=N+1>
>
LIST>
;MACRO TO HANDLE KI10 OP-CODES
IFE KI10,<
DEFINE XK (SB,CD) <> ;NUL MACRO>
IFN KI10,<SYN X,XK ;USUAL X MACRO>
; MACRO TO HANDLE KL10 OP-CODES
IFE KL10,<
DEFINE XKK (SB,CD) <> >
IFN KL10, <SYN X,XKK>
IFN OPHSH,< ;PUT THE MOST USED OP CODES FIRST
X JRST , 254
X PUSHJ , 260
X POPJ , 263
X PUSH , 261
X POP , 262
X AOS , 350
X ASCIZ , 701
X CALLI , 047
X EXTERN, 724
X INTERN, 744
X JFCL , 255
X JSP , 265
X MOVE , 200
X MOVEI , 201
X MOVEM , 202
X SETZM , 402
X SIXBIT, 717
X SOS , 370
X TLNE , 603
X TLNN , 607
X TLO , 661
X TLZ , 621
X TLZA , 625
X TLZE , 623
X TLZN , 627
X TRNE , 602
X TRNN , 606
X TRZ , 620
>
X ADD , 270
X ADDB , 273
X ADDI , 271
X ADDM , 272
XKK ADJBP , 133
XKK ADJSP , 105
X AND , 404
X ANDB , 407
X ANDCA , 410
X ANDCAB, 413
X ANDCAI, 411
X ANDCAM, 412
X ANDCB , 440
X ANDCBB, 443
X ANDCBI, 441
X ANDCBM, 442
X ANDCM , 420
X ANDCMB, 423
X ANDCMI, 421
X ANDCMM, 422
X ANDI , 405
X ANDM , 406
X AOBJN , 253
X AOBJP , 252
X AOJ , 340
X AOJA , 344
X AOJE , 342
X AOJG , 347
X AOJGE , 345
X AOJL , 341
X AOJLE , 343
X AOJN , 346
XX AOS , 350
X AOSA , 354
X AOSE , 352
X AOSG , 357
X AOSGE , 355
X AOSL , 351
X AOSLE , 353
X AOSN , 356
X ARG , 320
X ARRAY , 771
IFN IIISW,<X ASCID , 773>
X ASCII , 700
XX ASCIZ , 701
X ASH , 240
X ASHC , 244
X ASUPPR, 705
X BLKI , 702
X BLKO , 703
X BLOCK , 704
X BLT , 251
X BYTE , 707
XX CAI , 300
X CAIA , 304
X CAIE , 302
X CAIG , 307
X CAIGE , 305
X CAIL , 301
X CAILE , 303
X CAIN , 306
X CALL , 040
XX CALLI , 047
XX CAM , 310
X CAMA , 314
X CAME , 312
X CAMG , 317
X CAMGE , 315
X CAML , 311
X CAMLE , 313
X CAMN , 316
XX CLEAR , 400
XX CLEARB, 403
XX CLEARI, 401
XX CLEARM, 402
X CLOSE , 070
XKK CMPSE , 002
XKK CMPSG , 007
XKK CMPSGE, 005
XKK CMPSL , 001
XKK CMPSLE, 003
XKK CMPSN , 006
X COMMEN, 770
X CONI , 710
X CONO , 711
IFN STANSW,<X CONS,257>
X CONSO , 712
X CONSZ , 713
XKK CVTBDO, 012
XKK CVTBDT, 013
XKK CVTDBO, 010
XKK CVTDBT, 011
XKK DADD , 114
XX DATA. , 020
X DATAI , 714
X DATAO , 715
XKK DDIV , 117
X DEC , 716
X DEFINE, 717
X DEPHAS, 720
XK DFAD , 110
XK DFDV , 113
XK DFMP , 112
X DFN , 131
XK DFSB , 111
X DIV , 234
X DIVB , 237
X DIVI , 235
X DIVM , 236
XK DMOVE , 120
XK DMOVEM, 124
XK DMOVN , 121
XK DMOVNM, 125
XKK DMUL , 116
X DPB , 137
XKK DSUB , 115
XKK EBLT , 020
XKK EDIT , 004
X END , 721
X ENTER , 077
X ENTRY , 722
X EQV , 444
X EQVB , 447
X EQVI , 445
X EQVM , 446
X EXCH , 250
X EXP , 723
XKK EXTEND, 123
XX EXTERN, 724
X FAD , 140
X FADB , 143
X FADL , 141
X FADM , 142
X FADR , 144
X FADRB , 147
X FADRI , 145
X FADRM , 146
X FDV , 170
X FDVB , 173
X FDVL , 171
X FDVM , 172
X FDVR , 174
X FDVRB , 177
X FDVRI , 175
X FDVRM , 176
XX FIN. , 021
IFN STANSW,<X FIX , 130>
IFE STANSW,<XK FIX , 122>
XK FIXR , 126
XK FLTR , 127
X FMP , 160
X FMPB , 163
X FMPL , 161
X FMPM , 162
X FMPR , 164
X FMPRB , 167
X FMPRI , 165
X FMPRM , 166
X FSB , 150
X FSBB , 153
X FSBL , 151
X FSBM , 152
X FSBR , 154
X FSBRB , 157
X FSBRI , 155
X FSBRM , 156
X FSC , 132
X GETSTS, 062
X HALT , 725
X HISEG , 706
X HLL , 500
X HLLE , 530
X HLLEI , 531
X HLLEM , 532
X HLLES , 533
X HLLI , 501
X HLLM , 502
X HLLO , 520
X HLLOI , 521
X HLLOM , 522
X HLLOS , 523
X HLLS , 503
X HLLZ , 510
X HLLZI , 511
X HLLZM , 512
X HLLZS , 513
X HLR , 544
X HLRE , 574
X HLREI , 575
X HLREM , 576
X HLRES , 577
X HLRI , 545
X HLRM , 546
X HLRO , 564
X HLROI , 565
X HLROM , 566
X HLROS , 567
X HLRS , 547
X HLRZ , 554
X HLRZI , 555
X HLRZM , 556
X HLRZS , 557
X HRL , 504
X HRLE , 534
X HRLEI , 535
X HRLEM , 536
X HRLES , 537
X HRLI , 505
X HRLM , 506
X HRLO , 524
X HRLOI , 525
X HRLOM , 526
X HRLOS , 527
X HRLS , 507
X HRLZ , 514
X HRLZI , 515
X HRLZM , 516
X HRLZS , 517
X HRR , 540
X HRRE , 570
X HRREI , 571
X HRREM , 572
X HRRES , 573
X HRRI , 541
X HRRM , 542
X HRRO , 560
X HRROI , 561
X HRROM , 562
X HRROS , 563
X HRRS , 543
X HRRZ , 550
X HRRZI , 551
X HRRZM , 552
X HRRZS , 553
X IBP , 133
X IDIV , 230
X IDIVB , 233
X IDIVI , 231
X IDIVM , 232
X IDPB , 136
X IF1 , 726
X IF2 , 727
X IFB , 730
X IFDEF , 731
X IFDIF , 732
X IFE , 733
X IFG , 734
X IFGE , 735
X IFIDN , 736
X IFL , 737
X IFLE , 740
X IFN , 741
X IFNB , 742
X IFNDEF, 743
X ILDB , 134
X IMUL , 220
X IMULB , 223
X IMULI , 221
X IMULM , 222
X IN , 056
XX IN. , 016
X INBUF , 064
XX INF. , 026
X INIT , 041
X INPUT , 066
X INTEGE, 772
XX INTERN, 744
X IOR , 434
X IORB , 437
X IORI , 435
X IORM , 436
X IOWD , 745
X IRP , 746
X IRPC , 747
X JCRY , 750
X JCRY0 , 751
X JCRY1 , 752
X JEN , 753
XX JFCL , 255
X JFFO , 243
X JFOV , 765
X JOV , 754
X JRA , 267
XX JRST , 254
X JRSTF , 755
X JSA , 266
XX JSP , 265
X JSR , 264
X JSYS , 104
XX JUMP , 320
XX JUMPA , 324
X JUMPE , 322
X JUMPG , 327
X JUMPGE, 325
X JUMPL , 321
X JUMPLE, 323
X JUMPN , 326
X LALL , 756
X LDB , 135
X LIST , 757
X LIT , 760
X LOC , 761
X LOOKUP, 076
X LSH , 242
X LSHC , 246
XK MAP , 257
X MLOFF , 767
X MLON , 766
XX MOVE , 200
XX MOVEI , 201
XX MOVEM , 202
X MOVES , 203
X MOVM , 214
X MOVMI , 215
X MOVMM , 216
X MOVMS , 217
X MOVN , 210
X MOVNI , 211
X MOVNM , 212
X MOVNS , 213
X MOVS , 204
X MOVSI , 205
XKK MOVSLJ, 016
X MOVSM , 206
XKK MOVSO , 014
XKK MOVSRJ, 017
X MOVSS , 207
XKK MOVST , 015
X MTAPE , 072
XX MTOP. , 024
X MUL , 224
X MULB , 227
X MULI , 225
X MULM , 226
XX NLI. , 031
XX NLO. , 032
X NOSYM , 762
X OCT , 763
X OPDEF , 764
X OPEN , 050
X OR , 434
X ORB , 437
X ORCA , 454
X ORCAB , 457
X ORCAI , 455
X ORCAM , 456
X ORCB , 470
X ORCBB , 473
X ORCBI , 471
X ORCBM , 472
X ORCM , 464
X ORCMB , 467
X ORCMI , 465
X ORCMM , 466
X ORI , 435
X ORM , 436
X OUT , 057
XX OUT. , 017
X OUTBUF, 065
XX OUTF. , 027
X OUTPUT, 067
X PAGE , 700
X PASS2 , 701
X PHASE , 702
X POINT , 703
XX POP , 262
XX POPJ , 263
X PORTAL, 757
X PRGEND, 714
X PRINTX, 704
X PURGE , 705
XX PUSH , 261
XX PUSHJ , 260
X RADIX , 706
X RADIX5, 707
X RELEAS, 071
X RELOC , 710
X REMARK, 711
X RENAME, 055
X REPEAT, 712
XX RESET., 015
X RIM , 715
X RIM10 , 735
X RIM10B, 736
X ROT , 241
X ROTC , 245
X RSW , 716
XX RTB. , 022
X SALL , 720
X SEARCH, 721
X SETA , 424
X SETAB , 427
X SETAI , 425
X SETAM , 426
X SETCA , 450
X SETCAB, 453
X SETCAI, 451
X SETCAM, 452
X SETCM , 460
X SETCMB, 463
X SETCMI, 461
X SETCMM, 462
X SETM , 414
X SETMB , 417
X SETMI , 415
X SETMM , 416
X SETO , 474
X SETOB , 477
X SETOI , 475
X SETOM , 476
X SETSTS, 060
X SETZ , 400
X SETZB , 403
X SETZI , 401
XX SETZM , 402
XX SIXBIT, 717
XX SKIP , 330
X SKIPA , 334
X SKIPE , 332
X SKIPG , 337
X SKIPGE, 335
X SKIPL , 331
X SKIPLE, 333
X SKIPN , 336
XX SLIST., 025
X SOJ , 360
X SOJA , 364
X SOJE , 362
X SOJG , 367
X SOJGE , 365
X SOJL , 361
X SOJLE , 363
X SOJN , 366
XX SOS , 370
X SOSA , 374
X SOSE , 372
X SOSG , 377
X SOSGE , 375
X SOSL , 371
X SOSLE , 373
X SOSN , 376
IFN STANSW,<X SPCWAR,43>
X SQUOZE, 707
X STATO , 061
X STATUS, 062
X STATZ , 063
X STOPI , 722
X SUB , 274
X SUBB , 277
X SUBI , 275
X SUBM , 276
IF2,<IFE OPHSH,<SUBTL:>>
X SUBTTL, 723
X SUPPRE, 713
X SYN , 724
X TAPE , 725
X TDC , 650
X TDCA , 654
X TDCE , 652
X TDCN , 656
X TDN , 610
X TDNA , 614
X TDNE , 612
X TDNN , 616
X TDO , 670
X TDOA , 674
X TDOE , 672
X TDON , 676
X TDZ , 630
X TDZA , 634
X TDZE , 632
X TDZN , 636
X TITLE , 726
X TLC , 641
X TLCA , 645
X TLCE , 643
X TLCN , 647
X TLN , 601
X TLNA , 605
XX TLNE , 603
XX TLNN , 607
XX TLO , 661
X TLOA , 665
X TLOE , 663
X TLON , 667
XX TLZ , 621
XX TLZA , 625
XX TLZE , 623
XX TLZN , 627
X TRC , 640
X TRCA , 644
X TRCE , 642
X TRCN , 646
X TRN , 600
X TRNA , 604
XX TRNE , 602
XX TRNN , 606
X TRO , 660
X TROA , 664
X TROE , 662
X TRON , 666
XX TRZ , 620
X TRZA , 624
X TRZE , 622
X TRZN , 626
X TSC , 651
X TSCA , 655
X TSCE , 653
X TSCN , 657
X TSN , 611
X TSNA , 615
X TSNE , 613
X TSNN , 617
X TSO , 671
X TSOA , 675
X TSOE , 673
X TSON , 677
X TSZ , 631
X TSZA , 635
X TSZE , 633
X TSZN , 637
X TTCALL, 051
X TWOSEG, 731
X UFA , 130
X UGETF , 073
X UJEN , 100
IFN TENEX,<
X UMOVE , 100
X UMOVEI, 101
X UMOVEM, 102
X UMOVES, 103
>
X UNIVER, 737
X USETI , 074
X USETO , 075
X VAR , 727
XX WTB. , 023
X XALL , 732
X XCT , 256
X XLIST , 733
X XOR , 430
X XORB , 433
X XORI , 431
X XORM , 432
X XPUNGE, 730
X XWD , 734
X Z , 000
IFN FT.U01,<
IFN POLISH,<$BEG==762>
IFE POLISH,<$BEG==760>
X $POP , $BEG
X $PUSH , <$BEG+1>
>;END IFN FT.U01
X .ASSIG, 751
X .COMMO, 747
X .CREF , 740
X .DIREC, 750
IFN POLISH,<
X .ENDPS, 761
>
X .HWFRM, 742
X .IF , 756
X .LINK , 753
X .LNKEN, 754
X .MFRMT, 743
X .NODDT, 746
X .ORG , 752
IFN POLISH,<
X .PSECT, 760
>
X .REQUE, 744
X .REQUI, 745
X .TEXT , 755
X .XCREF, 741
IFN OPHSH,< ;NO-OPS, OLD MNEMONICS,F4 UUOS
X CAI , 300
X CAM , 310
X CLEAR , 400
X CLEARB, 403
X CLEARI, 401
X CLEARM, 402
X JUMP , 320
X JUMPA , 324
X SKIP , 330
X RESET., 015
X IN. , 016
X OUT. , 017
X DATA. , 020
X FIN. , 021
X RTB. , 022
X WTB. , 023
X MTOP. , 024
X SLIST., 025
X INF. , 026
X OUTF. , 027
X NLI. , 031
X NLO. , 032
>
IFE OPHSH,<
IF1, < BLOCK N1>
OP1END: -1B36
OP1COD: BLOCK N1/4
CC
IF2,< PURGE N1,N2>
>
IFN OPHSH,<
IF2,<
DEFINE SETVAL (N)<EXP .%'N
PURGE .%'N>
N=0
XLIST
REPEAT PRIME,<SETVAL \N
N=N+1>
LIST
>
OP1COD: IF1,< BLOCK <PRIME/4+1>>
IF2,<
DEFINE SETVAL (N)<EXP .$'N
PURGE .$'N>
N=0
XLIST
REPEAT <PRIME/4+1>,<SETVAL \N
N=N+1>
>
LIST>
.CREF ;START CREFFING AGAIN
SUBTTL PERMANENT SYMBOLS
SYMNUM: EXP LENGTH/2 ;NUMBER OF PERMANENT SYMBOLS
DEFINE P (A,B)<
XLIST
SIXBIT /A/
XWD SYMF!NOOUTF,B
LIST>
P @, 0(SUPRBT)
P ??????, 0(SUPRBT)
LENGTH= .-SYMNUM-1 ;LENGTH OF INITIAL SYMBOLS
PRMTBL: ;PERMANENT SYMBOLS
P ADC, 24
P ADC2, 30
P APR, 0
P CCI, 14
P CDP, 110
P CDR, 114
P CLK, 70
P CLK2, 74
P CPA, 0
P CR, 150
P CR2, 154
P DC, 200
P DC2, 204
P DCSA, 300
P DCSB, 304
P DDC, 270
P DDC2, 274
P DF, 270
P DIS, 130
P DIS2, 134
P DLB, 60
P DLB2, 160
P DLC, 64
P DLC2, 164
P DLS, 240
P DLS2, 244
P DPC, 250
P DPC2, 254
P DPC3, 260
P DPC4, 264
P DSI, 464
P DSI2, 474
P DSK, 170
P DSK2, 174
P DSS, 460
P DSS2, 470
P DTC, 320
P DTC2, 330
P DTS, 324
P DTS2, 334
P LPT, 124
P LPT2, 234
P MDF, 260
P MDF2, 264
P MTC, 220
P MTM, 230
P MTS, 224
P PAG, 10
P PI, 4
P PLT, 140
P PLT2, 144
P PTP, 100
P PTR, 104
P TMC, 340
P TMC2, 350
P TMS, 344
P TMS2, 354
P TTY, 120
P UTC, 210
P UTS, 214
IFE LNSSW,< XLIST >
IFN LNSSW,< ;SPECIAL DEVICES FOR PEPR
P .A,550
P .AB,434
P .ANG,440
P .B,554
P .BITE,470
P .FA,564
P .GAIN,520
P .GATE,444
P .IA,560
P .INC,514
P .LC,474
P .LG,570
P .PEPR,400
P .RG,574
P .SCON,430
P .STAT,410
P .TC,500
P .TED,540
P .THR,544
P .TRK,404
P .VIEW,524>
LIST
PRMEND: ;END OF PERMANENT SYMBOLS
OPDEF ZL [Z LITF] ;INVALID IN LITERALS
OPDEF ZA [Z ADDF] ;INVALID IN ADDRESSES
OPDEF ZAL [Z ADDF!LITF]
OP1TAB:
ZA PAGE0 ;PAGE
ZAL PASS20 ;PASS2
ZAL PHASE0 ;PHASE
Z POINT0 ;POINT
ZA PRNTX0 ;PRINTX
ZA PURGE0 ;PURGE
ZA RADIX0 ;RADIX
Z RADX50 ;RADIX50,SQUOZE
ZAL %ORG (1) ;RELOC
ZAL REMAR0 ;REMARK
ZA REPEA0 ;REPEAT
ZA SUPRE0 ;SUPRESS
ZAL PSEND0 ;PRGEND
ZAL RIM0 (RIMSW) ;RIM
DATAI 0,IOP ;RSW
Z ASCII0 (1) ;SIXBIT
ZAL IOSET (IOPALL!IOSALL) ;SALL
ZAL SERCH0 ;SEARCH
ZA STOPI0 ;STOPI
ZA SUBTT0 (Z (POINT 7,,)) ;SUBTTL
ZA SYN0 ;SYN
ZAL TAPE0 ;TAPE
ZA TITLE0 (Z (POINT 7,,)) ;TITLE
ZAL VAR0 ;VAR
Z XPUNG0 ;XPUNGE
ZAL TWSEG0 ;TWOSEGMENTS
ZAL XALL0 (IOPALL) ;XALL
ZAL XALL0 (IOPROG) ;XLIST
Z XWD0 ;XWD
ZAL RIM0 (RIM1SW) ;RIM10
ZAL RIM0 (R1BSW) ;RIM10B
ZA UNIV0 (Z (POINT 7,,)) ;UNIVERSAL
ZAL ONCRF (IONCRF) ;.CREF
ZAL OFFCRF (IONCRF) ;.XCREF
ZA OFFORM ;.HWFRMT
ZA ONFORM ;.MFRMT
ZAL REQUEST ;.REQUEST
ZAL REQUIRE ;.REQUIRE
ZA NODDT0 ;.NODDT
ZAL COMM0 ;.COMMON
ZAL %DIREC ;.DIRECTIVE
ZA ASGN ;.ASSIGN
ZAL %ORG (1B18) ;.ORG
ZAL %LINK (0) ;.LINK
ZAL %LINK (1B18) ;.LNKEND
Z %TEXT0 (1B18+1B21) ;.TEXT
Z %IF ;.IF
JRST 1,OP ;[342] PORTAL
IFN POLISH,<
ZA %SEGME ;.PSECT
ZA %ENDSE ;.ENDPS
>
IFN FT.U01,<
POP $PDUSR ;$POP
PUSH $PDUSR ;$PUSH
>;END IFN FT.U01
OP2TAB:
Z ASCII0 (0) ;ASCII
Z ASCII0 (1B18) ;ASCIZ
BLKI IOP ;BLKI
BLKO IOP ;BLKO
ZAL BLOCK0 ;BLOCK
ZA SUPRSA ;ASUPPRESS
ZAL HISEG0 ;HISEG
Z BYTE0 ;BYTE
CONI IOP ;CONI
CONO IOP ;CONO
CONSO IOP ;CONSO
CONSZ IOP ;CONSZ
DATAI IOP ;DATAI
DATAO IOP ;DATAO
Z OCT0 (^D10) ;DEC
ZA DEFIN0 ;DEFINE
ZAL DEPHA0 ;DEPHASE
ZAL END0 ;END
ZA INTER0 (INTF!ENTF) ;ENTRY
Z EXPRES ;EXP
ZA EXTER0 ;EXTERN
JRST 4,OP ;HALT
TLNN FR,IFPASS ;IF1
TLNE FR,IFPASS ;IF2
TRNE AC0,IFB0 ;IFB
TLNE ARG,IFDEF0 ;IFDEF
Z IFIDN0 (0) ;IFDIF
SKIPE IF ;IFE
SKIPG IF ;IFG
SKIPGE IF ;IFGE
Z IFIDN0 (1) ;IFIDN
SKIPL IF ;IFL
SKIPLE IF ;IFLE
SKIPN IF ;IFN
TRNN AC0,IFB0 ;IFNB
TLNN ARG,IFDEF0 ;IFNDEF
ZA INTER0 (INTF) ;INTERN
Z IOWD0 ;IOWD
Z IRP0 (0) ;IRP
Z IRP0 (400000) ;IRPC
JFCL 6,OP ;JCRY
JFCL 4,OP ;JCRY0
JFCL 2,OP ;JCRY1
JRST 12,OP ;JEN
JFCL 10,OP ;JOV
JRST 2,OP ;JRSTF
ZAL IOLSET (IOPALL!IOSALL) ;[327] LALL, SEE ***** AT IOLSE1+1 IF CHANGED
ZAL IORSET (IOPROG) ;LIST
ZAL LIT0 ;LIT
ZAL %ORG (0) ;LOC
ZA OFFSYM ;NOSYM
Z OCT0 (^D8) ;OCT
ZA OPDEF0 ;OPDEF
JFCL 1,OP ;JFOV
ZA ONML ;MLON
ZA OFFML ;MLOFF
Z ASCII0 (3B19) ;COMMENT
ZAL %ARAY ;ARRAY
ZAL %INTEG ;INTEGER
ZAL %LINK (0) ;LINK
ZAL %LINK (1B18) ;LNKEND
ZAL %ORG (1B18) ;ORG
ZA ASGN ;ASSIGN
IFN IIISW,<
Z ASCII0 (5B20) ;ASCID>
CALTBL:
;USER DEFINED CALLI'S GO HERE
SIXBIT /LIGHTS/ ;-1
CALLI0: SIXBIT /RESET/ ; 0
SIXBIT /DDTIN/ ; 1
SIXBIT /SETDDT/ ; 2
SIXBIT /DDTOUT/ ; 3
SIXBIT /DEVCHR/ ; 4
SIXBIT /DDTGT/ ; 5
SIXBIT /GETCHR/ ; 6
SIXBIT /DDTRL/ ; 7
SIXBIT /WAIT/ ;10
SIXBIT /CORE/ ;11
SIXBIT /EXIT/ ;12
SIXBIT /UTPCLR/ ;13
SIXBIT /DATE/ ;14
SIXBIT /LOGIN/ ;15
SIXBIT /APRENB/ ;16
SIXBIT /LOGOUT/ ;17
SIXBIT /SWITCH/ ;20
SIXBIT /REASSI/ ;21
SIXBIT /TIMER/ ;22
SIXBIT /MSTIME/ ;23
SIXBIT /GETPPN/ ;24
SIXBIT /TRPSET/ ;25
SIXBIT /TRPJEN/ ;26
SIXBIT /RUNTIM/ ;27
SIXBIT /PJOB/ ;30
SIXBIT /SLEEP/ ;31
SIXBIT /SETPOV/ ;32
SIXBIT /PEEK/ ;33
SIXBIT /GETLIN/ ;34
SIXBIT /RUN/ ;35
SIXBIT /SETUWP/ ;36
SIXBIT /REMAP/ ;37
SIXBIT /GETSEG/ ;40
SIXBIT /GETTAB/ ;41
SIXBIT /SPY/ ;42
SIXBIT /SETNAM/ ;43
SIXBIT /TMPCOR/ ;44
SIXBIT /DSKCHR/ ;45
SIXBIT /SYSSTR/ ;46
SIXBIT /JOBSTR/ ;47
SIXBIT /STRUUO/ ;50
SIXBIT /SYSPHY/ ;51
SIXBIT /FRECHN/ ;52
SIXBIT /DEVTYP/ ;53
SIXBIT /DEVSTS/ ;54
SIXBIT /DEVPPN/ ;55
SIXBIT /SEEK/ ;56
SIXBIT /RTTRP/ ;57
SIXBIT /LOCK/ ;60
SIXBIT /JOBSTS/ ;61
SIXBIT /LOCATE/ ;62
SIXBIT /WHERE/ ;63
SIXBIT /DEVNAM/ ;64
SIXBIT /CTLJOB/ ;65
SIXBIT /GOBSTR/ ;66
0 ;67
0 ;70
SIXBIT /HPQ/ ;71
SIXBIT /HIBER/ ;72
SIXBIT /WAKE/ ;73
SIXBIT /CHGPPN/ ;74
SIXBIT /SETUUO/ ;75
SIXBIT /DEVGEN/ ;76
SIXBIT /OTHUSR/ ;77
SIXBIT /CHKACC/ ;100
SIXBIT /DEVSIZ/ ;101
SIXBIT /DAEMON/ ;102
SIXBIT /JOBPEK/ ;103
SIXBIT /ATTACH/ ;104
SIXBIT /DAEFIN/ ;105
SIXBIT /FRCUUO/ ;106
SIXBIT /DEVLNM/ ;107
SIXBIT /PATH./ ;110
SIXBIT /METER./ ;111
SIXBIT /MTCHR./ ;112
SIXBIT /JBSET./ ;113
SIXBIT /POKE./ ;114
SIXBIT /TRMNO./ ;115
SIXBIT /TRMOP./ ;116
SIXBIT /RESDV./ ;117
SIXBIT /UNLOK./ ;120
SIXBIT /DISK./ ;121
SIXBIT /DVRST./ ;122
SIXBIT /DVURS./ ;123
SIXBIT /XTTSK./ ;124
SIXBIT /CAL11./ ;125
SIXBIT /MTAID./ ;126
SIXBIT /IONDX./ ;127
SIXBIT /CNECT./ ;130
SIXBIT /MVHDR./ ;131
SIXBIT /ERLST./ ;132
SIXBIT /SENSE./ ;133
SIXBIT /CLRST./ ;134
SIXBIT /PIINI./ ;135
SIXBIT /PISYS./ ;136
SIXBIT /DEBRK./ ;137
SIXBIT /PISAV./ ;140
SIXBIT /PIRST./ ;141
SIXBIT /IPCFR./ ;142
SIXBIT /IPCFS./ ;143
SIXBIT /IPCFQ./ ;144
SIXBIT /PAGE./ ;145
SIXBIT /SUSET./ ;146
SIXBIT /COMPT./ ;147
SIXBIT /SCHED./ ;150
SIXBIT /ENQ./ ;151
SIXBIT /DEQ./ ;152
SIXBIT /ENQC./ ;153
SIXBIT /TAPOP./ ;154
SIXBIT /FILOP./ ;155
SIXBIT /CAL78./ ;156
SIXBIT /NODE./ ;157
SIXBIT /ERRPT./ ;160
SIXBIT /ALLOC./ ;161
SIXBIT /PERF./ ;162
CALNTH==.-CALTBL
NEGCAL==CALLI0-CALTBL ;NUMBER OF NEGATIVE CALLI'S
TTCTBL: SIXBIT /INCHRW/ ; 0 INPUT A CHAR. AND WAIT
SIXBIT /OUTCHR/ ; 1 OUTPUT A CHAR.
SIXBIT /INCHRS/ ; 2 INPUT A CHAR. AND SKIP
SIXBIT /OUTSTR/ ; 3 OUTPUT A STRING
SIXBIT /INCHWL/ ; 4 INPUT CHAR., WAIT, LINE MODE
SIXBIT /INCHSL/ ; 5 INPUT CHAR., SKIP, LINE MODE
SIXBIT /GETLCH/ ; 6 GET LINE CHARACTERISTICS
SIXBIT /SETLCH/ ; 7 SET LINE CHARACTERISTICS
SIXBIT /RESCAN/ ;10 RESET INPUT STREAM TO COMMAND
SIXBIT /CLRBFI/ ;11 CLEAR TYPEIN BUFFER
SIXBIT /CLRBFO/ ;12 CLEAR TYPEOUT BUFFER
SIXBIT /SKPINC/ ;13 SKIPS IF A CHAR. CAN BE INPUT
SIXBIT /SKPINL/ ;14 SKIPS IF A LINE CAN BE INPUT
SIXBIT /IONEOU/ ;15 OUTPUT AS AN IMAGE CHAR.
TTCLTH==.-TTCTBL
MTATBL: SIXBIT /MTWAT./ ; 0
SIXBIT /MTREW./ ; 1
SIXBIT /MTEOF./ ; 3
SIXBIT /MTSKR./ ; 6
SIXBIT /MTBSR./ ; 7
SIXBIT /MTEOT./ ; 10
SIXBIT /MTUNL./ ; 11
SIXBIT /MTBLK./ ; 13
SIXBIT /MTSKF./ ; 16
SIXBIT /MTBSF./ ; 17
SIXBIT /MTDEC./ ;100
SIXBIT /MTIND./ ;101
MTALTH==.-MTATBL
MTACOD: BYTE (9) 0,1,3,6
BYTE (9) 7,10,11,13
BYTE (9) 16,17,100,101
SUBTTL USER-DEFINED SYMBOL SEARCH ROUTINES
MSRCH: PUSHJ PP,SEARCH ;PERFORM GENERAL SEARCH
POPJ PP, ;NOT FOUND, EXIT
JUMPG ARG,MSRCH2 ;SKIP-EXIT AND CROSS-REF IF FOUND
CAME AC0,1(SX) ;WE ARE LOOKING AT SYMBOL, TRY ONE ABOVE
POPJ PP, ;NO, EXIT
ADDI SX,2 ;YES, POINT TO IT
;**;[440] DELETE 1 INSTR @MSRCH+6 JBC 3-SEP-76
;** SETZM EXTPNT ;[324] RESET EXTERNAL POINTERS WORD
PUSHJ PP,SRCH5 ;LOAD REGISTERS
MSRCH2: AOSA 0(PP) ;SET SKIP-EXIT
QSRCH: JUMPL ARG,SSRCH3 ;BRANCH IF OPERAND
MOVEI SDEL,%MAC ;SET OPERATOR FLAG
TLZE IO,DEFCRS ;IS IT A DEFINITION?
MOVEI SDEL,%DMAC ;YES
JRST CREF ;CROSS-REF AND EXIT
SSRCH: PUSHJ PP,SEARCH ;PERFORM GENERAL SEARCH
POPJ PP, ;NOT FOUND, EXIT
JUMPL ARG,SSRCH2 ;SKIP-EXIT AND CROSS-REF IF FOUND
SSRCH1: CAME AC0,-3(SX) ;WE ARE LOOKING AT MACRO, LOOK ONE SLOT BELOW
POPJ PP, ;NO DICE, EXIT
SUBI SX,2 ;YES, POINT TO IT
;**;[440] INSERT 1 INSTR @SSRCH1+3 JBC 3-SEP-76
TLNE ARG,OPDF ;[440] IF IN OPDEF
SETZM EXTPNT ;[324] RESET EXTERNAL POINTERS WORD
PUSHJ PP,SRCH5 ;LOAD REGISTERS
SSRCH2: AOS 0(PP) ;SET FOR SKIP-EXIT
SSRCH3: MOVEI SDEL,%SYM ;SET OPERAND FLAG
CREF: TLNE ARG,NCRF ;[220] .XCREF SEEN?
JRST [TLZ IO,DEFCRS ;[220] CLEAR DEFINITION FLAG
POPJ PP,] ;[220] AND DON'T CREF
TLNN IO,IONCRF ;NO CREFFING FOR THIS SYMBOL?
TLNE FR,P1!CREFSW ;PASS ONE OR CROSS-REF SUPPRESSION?
POPJ PP, ;YES, EXIT
EXCH SDEL,C ;PUT FLAG IN C, SACE C
PUSH PP,CS
TLNE IO,IOCREF ;HAVE WE PUT OUT THE 177,102
JRST CREF3 ;YES
PUSH PP,C ;START OF CREF DATA
REPEAT 0,< ;NEEDS CHANGE TO CREF
MOVEI C,177
PUSHJ PP,OUTLST
MOVEI C,102
PUSHJ PP,OUTLST
TLO IO,IOCREF ;WE NOW ARE IN THAT STATE
POP PP,C ;WE HAVE NOW
CREF3: JUMPE C,NOFLG ;JUST CLOSE IT
PUSHJ PP,OUTLST ;TYPE OF SYMBOL (%MAC,%DMAC,%SYM)
MOVSI CS,770000 ;COUNT CHRS
TDZA C,C ;STARTING AT 0
LSH CS,-6 ;TRY NEXT
TDNE AC0,CS ;IS THAT ONE THERE?
AOJA C,.-2 ;YES
PUSHJ PP,OUTLST ;PRINT NUMBER OF SYMBOL CONSTITUENTS
MOVE CS,AC0
CREF2: MOVEI C,0
LSHC C,6
ADDI C,40
PUSHJ PP,OUTLST ;THE ASCII SYMBOL
JUMPN CS,CREF2
MOVEI C,%DSYM
TLZE IO,DEFCRS
PUSHJ PP,OUTLST ;MARK IT AS A DEFINING OCCURENCE
NOFLG: MOVE C,SDEL
POP PP,CS
POPJ PP,
CLSCRF: TRNN ER,LPTSW
POPJ PP, ;LEAVE IF WE SHOULD NOT BE PRINTING
CLSCR2: MOVEI C,177
PUSHJ PP,PRINT
TLZE IO,IOCREF ;WAS IT OPEN?
JRST CLSCR1 ;YES, JUST CLOSE IT
MOVEI C,102 ;NO, OPEN IT FIRST
PUSHJ PP,OUTLST ;MARK BEGINNING OF CREF DATA
MOVEI C,177
PUSHJ PP,OUTLST
CLSCR1: MOVEI C,103
JRST OUTLST ;MARK END OF CREF DATA
CLSC3: TLZ IO,IOCREF
MOVEI C,177
PUSHJ PP,OUTLST
MOVEI C,104
JRST OUTLST ;177,104 CLOSES IT FOR NOW
> ;END OF REPEAT 0
REPEAT 1,< ;WORKS WITH EXISTING CREF
TLNE IO,IOPAGE
PUSHJ PP,CRFHDR ;GET CORRECT SUBTTL
MOVEI C,177
PUSHJ PP,OUTLST
MOVEI C,102
PUSHJ PP,OUTLST
TLO IO,IOCREF ;WE NOW ARE IN THAT STATE
POP PP,C ;WE HAVE NOW
CREF3: PUSHJ PP,OUTLST ;TYPE OF SYMBOL (%MAC,%DMAC,%SYM)
MOVSI CS,770000 ;COUNT CHRS
TDZA C,C ;STARTING AT 0
LSH CS,-6 ;TRY NEXT
TDNE AC0,CS ;IS THAT ONE THERE?
AOJA C,.-2 ;YES
PUSHJ PP,OUTLST ;PRINT NUMBER OF SYMBOL CONSTITUENTS
MOVE CS,AC0
CREF2: MOVEI C,0
LSHC C,6
ADDI C,40
PUSHJ PP,OUTLST ;THE ASCII SYMBOL
JUMPN CS,CREF2
MOVEI C,%DSYM
TLZE IO,DEFCRS
PUSHJ PP,OUTLST ;MARK IT AS A DEFINING OCCURENCE
MOVE C,SDEL
POP PP,CS
POPJ PP,
IFN OPHSH,<
SUBTL: SIXBIT /SUBTTL/>
CRFHDR: CAME AC0,SUBTL ;IS FIRST SYMBOL "SUBTTL"
JRST CRFHD1 ;NO
HLLZ AC0,V
PUSHJ PP,SUBTT0 ;UPDATE SUBTTL
MOVE AC0,SUBTL ;RESTORE ARG.
MOVEI V,CPOPJ
CRFHD1: MOVEI C,0
JRST OUTL
CLSC3:
CLSCRF: TRNN ER,LPTSW
POPJ PP, ;LEAVE IF WE SHOULD NOT BE PRINTING
CLSCR2: TLZE IO,IOCREF ;FINISH UP LINE
JRST CLSCR1
MOVEI C,0
TLNE IO,IOPAGE ;NEW PAGE?
PUSHJ PP,OUTL ;YES,GIVE IT A ROUSING SENDOFF!
MOVEI C,177
PUSHJ PP,OUTLST
MOVEI C,102
PUSHJ PP,OUTLST ;MARK BEGINNING OF CREF DATA
CLSCR1: TRNN ER,ERRORS ;ANY ERRORS TO CREF
JRST CLSCR6 ;NO, JUST CLOSE OUT
MOVE C,[POINT 6,[SIXBIT /QXADLRUVNOPEMS/]]
PUSH PP,ER ;SAVE
ANDI ER,ERRORS ;ONLY LOOK AT THESE
HRLZ ER,ER ;PUT FLAGS IN LEFT HALF
CLSCR4: ILDB CS,C ;GET NEXT ERROR CODE
LSH ER,1 ;SHIFT FLAG IN
JUMPE ER,CLSCR5 ;FINISHED
JUMPG ER,CLSCR4 ;NOT YET
PUSH PP,C ;SAVE BYTE POINTER
TDO CS,['%.... '] ;MAGIC SYMBOL
MOVEI C,%ERR ;TYPE
PUSHJ PP,OUTLST
MOVEI C,6 ;NO OF CHARS.
PUSHJ PP,OUTLST
SETZ C, ;CLEAR RECEIVING ACC
LSHC C,6 ;SHIFT IN CHAR
ADDI C,40 ;TO ASCII
PUSHJ PP,OUTLST
JUMPN CS,.-4 ;MORE TO DO
POP PP,C ;BYTE POINTER BACK
JUMPN ER,CLSCR4 ;GET NEXT
CLSCR5: POP PP,ER ;RESTORE ER
CLSCR6: MOVEI C,177
PUSHJ PP,OUTLST
MOVEI C,103
JRST OUTLST ;MARK END OF CREF DATA
> ;END OF REPEAT 1
IFE POLISH,<
SEARCH: HLRZ SX,SRCHX
HRRZ SDEL,SRCHX
SRCH1: CAML AC0,-1(SX)
JRST SRCH3
SRCH2: SUB SX,SDEL
LSH SDEL,-1
CAMG SX,SYMTOP
JUMPN SDEL,SRCH1
JUMPN SDEL,SRCH2
SOJA SX,SRCHNO ;NOT FOUND
SRCH3: CAMN AC0,-1(SX)
JRST SRCH4 ;NORMAL / FOUND EXIT
ADD SX,SDEL
LSH SDEL,-1
CAMG SX,SYMTOP
JUMPN SDEL,SRCH1
JUMPN SDEL,SRCH2
SOJA SX,SRCHNO ;NOT FOUND
SRCH4: AOS 0(PP) ;SET FOR SKIP EXIT
SRCH5: MOVSI ARG,SUPRBT ;HE IS USING IT, TURN OFF BIT
ANDCAM ARG,(SX) ; IN THE TABLE
SRCH7: MOVE ARG,0(SX) ;FLAG AND VALUE TO ARG
LDB RC,RCPNTR ;POINT 1,ARG,17
TLNE ARG,LELF ;CHECK LEFT RELOCATE
TLO RC,1
HRRZ V,ARG
TLNE ARG,SPTR ;CHECK SPECIAL EXTESN POINTER
JRST SRCH6
TLNE ARG,PNTF
MOVE V,0(ARG) ;36BIT VALUE TO V
JRST SRCHOK
SRCH6: MOVE V,0(ARG) ;VALUE
MOVE RC,1(ARG) ;AND RELOC
TLNE RC,-2 ;CHECK AND SET EXTPNT
HLLM RC,EXTPNT
TRNE RC,-2
HRRM RC,EXTPNT
JRST SRCHOK
SRCHNO: SKIPN UNISCH+1 ;ALLOWED TO SEARCH OTHER TABLES
POPJ PP, ;NO, JUST RETURN
AOS V,UNISCH ;GET NEXT INDEX TO TABLE
CAIE V,1 ;FIRST TIME IN
JRST SRCHN1 ;YES, SAVE SYMBOL INFO
HRLM SX,UNISCH ;SAVE SX AND SET FLAG
MOVE ARG,SRCHX ;SEARCH POINTER
MOVEM ARG,UNISHX ;TO A SAFE PLACE
HRR ARG,SYMBOL
HRL ARG,SYMTOP
MOVEM ARG,UNIPTR ;STORE ALSO
SRCHN1: MOVE V,UNISCH(V) ;GET TRUE INDEX
JUMPE V,SRCHKO ;IF ZERO ALL TABLE SCANNED
MOVE ARG,UNISHX(V) ;NEW SRCHX
MOVEM ARG,SRCHX ;SET IT UP
MOVE ARG,UNIPTR(V) ;SYMTOP,,SYMBOL
HRRZM ARG,SYMBOL
HLRZM ARG,SYMTOP
JRST SEARCH ;TRY AGAIN
>
IFN POLISH,<
SEARCH: PUSHJ PP,SRCHI ;SET UP SRCHX
TLZ IO,RSASSW ;CLR INTER-PSECT REF SWITCH
HRRZ AC1,SGNCUR ;GET CUR PSECT INX
MOVEM AC1,SGWFND ;SET PSECT WHERE FOUND
PUSHJ PP,SRCH ;SEARCH CURRENT PSECT
JRST SRCHSG ;NOPE, TRY OTHER PSECT.S
JRST SRCH4S ;COMMON SUCCESSFUL EXIT
SRCHSG: PUSH PP,SX ;SAVE SX VALUE
PUSH PP,SGNCUR ;SAVE SGNCUR
PUSH PP,SGNMAX ;INIT PSECT INX
SRCHSL: MOVE V,0(PP) ;GET PSECT INX
CAMN V,-1(PP) ;DON'T SEARCH CURRENT
JRST SRCHSC ; PSECT AGAIN
MOVEM V,SGNCUR ;FUDGE CUR PSECT
PUSHJ PP,SRCHI ;SET UP SRCHX
PUSHJ PP,SRCH ;SEARCH THIS PSECT
JRST SRCHSC ;NOT HERE EITHER
MOVE AC1,SGNCUR ;GET RELEVANT PSECT INX
MOVEM AC1,SGWFND ;SET PSECT WHERE FOUND
SKIPGE -1(PP) ;WANT TO EVALUATE IN THIS PSECT?
JRST SRCH4 ;YES, JUST EXIT
MOVE ARG,0(SX) ;GET FLAGS
TLNN ARG,EXTF ;EXTERNAL?
JRST .+3 ;NO
TLNN ARG,SPTR ;BUT NOT SPECIAL
JRST SRCHEX ;YES, MUST STOR IN REQUESTING PSECT
TLNE ARG,LELF!RELF ;IF RELOCATABLE THEN
TLO IO,RSASSW ; SET INTER-PSECT REF SWITCH
JRST SRCH4 ;COMMON SUCCESSFUL EXIT
SRCHEX: POP PP,AC1 ;INDEX
POP PP,SGNCUR ;RESTORE
POP PP,SX ;WHERE IT SHOULD BE
MOVEI SDEL,2 ;NEEDS 2 WORDS
ADDB SDEL,FREE
CAML SDEL,SYMBOL ;WILL IT FIT?
PUSHJ PP,XCEEDS ;NO
SETZM -2(SDEL) ;VALUE
MOVEM AC0,-1(SDEL) ;NAME
MOVEI V,-2(SDEL) ;POINTER
MOVSI ARG,SYMF!EXTF!PNTF ;FLAGS WE NEED
PUSHJ PP,INSERT ;PUT IT IN
JRST SEARCH ;TRY AGAIN
SRCHSC: SOS V,0(PP) ;BUMP PSECT INX
JUMPGE V,SRCHSL ;LOOP IF MORE PSECTS
POP PP,AC1 ;THROW AWAY PSECT INX
POP PP,SGNCUR ;RESTORE SGNCUR
PUSHJ PP,SRCHI ;RESET SRCHX
POP PP,SX ;RESTORE SX VALUE
SKIPN UNISCH+1 ;ALLOWED TO SEARCH OTHER TABLES
POPJ PP, ;NO, JUST RETURN
HRLM SX,UNISCH ;SAVE SX AND SET FLAG
MOVE ARG,SRCHX ;SEARCH POINTER
MOVEM ARG,UNISHX ;TO A SAFE PLACE
HRR ARG,SGSBOT
HRL ARG,SGSTOP
MOVEM ARG,UNIPTR ;STORE ALSO
SRCHUL: AOS V,UNISCH ;GET NEXT INDEX TO TABLE
MOVE V,UNISCH(V) ;GET TRUE INDEX
JUMPE V,SRCHKO ;IF ZERO ALL TABLE SCANNED
MOVE ARG,UNISHX(V) ;NEW SRCHX
MOVEM ARG,SRCHX ;SET IT UP
MOVE ARG,UNIPTR(V) ;SGSTOP,,SGSBOT
HRRZM ARG,SGSBOT
HLRZM ARG,SGSTOP
PUSHJ PP,SRCH ;SEARCH UNIV SYM TAB
JRST SRCHUL ;NOPE, TRY NEXT ONE
JRST SRCH4S ;COMMON SUCCESSFUL EXIT
SRCH4: POP PP,AC1 ;THROW AWAY PSECT INX
POP PP,SGNCUR ;RESTORE SGNCUR
POP PP,AC1 ;THROW AWAY SX VALUE
SRCH4S: AOS 0(PP) ;SET FOR SKIP EXIT
SRCH5: MOVSI ARG,SUPRBT ;HE IS USING IT, TURN OFF BIT
ANDCAM ARG,(SX) ; IN THE TABLE
SRCH7: MOVE ARG,0(SX) ;FLAG AND VALUE TO ARG
LDB RC,RCPNTR ;POINT 1,ARG,17
TLNE ARG,LELF ;CHECK LEFT RELOCATE
TLO RC,1
HRRZ V,ARG
TLNE ARG,SPTR ;CHECK SPECIAL EXTESN POINTER
JRST SRCH6
TLNE ARG,PNTF
MOVE V,0(ARG) ;36BIT VALUE TO V
JRST SRCHOK
SRCH6: MOVE V,0(ARG) ;VALUE
MOVE RC,1(ARG) ;AND RELOC
TLNE RC,-2 ;CHECK AND SET EXTPNT
HLLM RC,EXTPNT
TRNE RC,-2
HRRM RC,EXTPNT
JRST SRCHOK
>
SRCHKO: SETZ ARG, ;CLEAR ARG SO ZERO STORED
SRCHOK: SKIPN UNISCH ;HAVE WE SEARCH OTHER TABLES
POPJ PP, ;NO, JUST RETURN
SYMBCK: HLRZ SX,UNISCH ;RESTORE SX
SETZM UNISCH ;CLEAR SYMBCK FLAG
MOVE SDEL,UNISHX ;SRCHX
MOVEM SDEL,SRCHX ;RESTORE ORIGINAL
IFE POLISH,<
MOVE SDEL,UNIPTR ;SYMTOP,,SYMBOL
HRRZM SDEL,SYMBOL
HLRZM SDEL,SYMTOP
JUMPE ARG,CPOPJ ;TOTALLY UNDEFINED
>
IFN POLISH,<
MOVE SDEL,UNIPTR ;SGSTOP,,SGSBOT
HRRZM SDEL,SGSBOT
HLRZM SDEL,SGSTOP
JUMPE ARG,CPOPJ ;TOTALLY UNDEFINED
PUSH PP,SGNCUR ;SAVE CUR PSECT
SETZM SGNCUR ;SET TO BLANK PSECT
SETZM SGWFND ;SET PSECT WHERE FOUND
PUSHJ PP,SRCHI ;SET UP SRCHX
PUSHJ PP,SRCH ;SET UP SX
JFCL
>
TLNE ARG,SPTR ;[256] SPECIAL EXTERNAL?
JRST SYMBKS ;[256] YES
TLNE ARG,EXTF ;EXTERNAL?
JRST SYMBKX ;YES, NEED 2 MORE CELLS
TLNN ARG,PNTF ;36 BIT VALUE FLAG SET?
JRST .+3 ;[265] NO, PUT IN TABLE AND RETURN
TLNN V,-1 ;BUT IS IT ONLY 18 BIT VALUE?
TLZ ARG,PNTF ;YES, SO ONLY USE 18 BITS
IFE POLISH,<
JRST INSERT
SYN CPOPJ,SYMBKR
>
IFN POLISH,<
PUSHJ PP,INSERT ;[265] STILL HAVE 0 PSECT
SYMBKR: POP PP,SGNCUR ;[265] RESTORE CUR PSECT
POPJ PP, ;[265]
>
SYMBKX: PUSH PP,[EXP SYMBKR] ;[265] RETURN ADDRESS
PUSH PP,1(ARG) ;SAVE SIXBIT NAME
MOVSI ARG,SYMF!EXTF!PNTF ;SET ONLY THE REQUIRED FLAGS
;[265] PUT 2 WORDS IN CORE
SYMBKY: PUSHJ PP,INSERZ ;[256] INSERT SYMBOL IN TABLE
MOVEI SDEL,2 ;GET 2 CELLS FROM FREE CORE
ADDB SDEL,FREE
CAML SDEL,SYMBOL ;MORE CORE NEEDED?
PUSHJ PP,XCEEDS ;YES
HRRI ARG,-2(SDEL) ;POINTER TO VALUE
SETZM (ARG) ;AND CLEAR IT
POP PP,1(ARG) ;STORE SIXBIT VALUE
MOVEM ARG,(SX) ;SET FLAGS AND VALUE AS IT SHOULD BE
POPJ PP, ;RETURN
SYMBKS: PUSH PP,V ;[256] SAVE ADDITIVE VALUE
PUSH PP,[Z SYMBKZ] ;[336] SET UP RETURN ADDRESS FOR PJRST
PUSH PP,ARG ;[323] SAVE SYMBOL'S FLAGS
PUSH PP,UNISCH+1 ;[256] ONLY SEARCH MAIN TABLE
SETZM UNISCH+1 ;[256] ...
PUSH PP,AC0 ;[256] SAVE SYMBOL WE REALLY WANT
MOVE ARG,1(ARG) ;[256] GET POINTER TO DEFINING SYMBOL
MOVE AC0,1(ARG) ;[256] AND FINALLY SYMBOL
PUSHJ PP,SEARCH ;[256] SEE IF DEFINING GLOBAL IS IN TABLE
PUSHJ PP,[PUSH PP,1(ARG) ;SAVE SIXBIT NAME
MOVSI ARG,SYMF!EXTF!PNTF ;SET ONLY THE REQUIRED FLAGS
JRST SYMBKY] ;[256] NO, PUT IN SYMBOL TABLE
POP PP,AC0 ;[256] GET SYMBOL BACK
PUSHJ PP,SEARCH ;[256] SETUP SX AGAIN
JFCL ;[256] WILL ALWAYS FAIL
POP PP,UNISCH+1 ;[256] BACK TO MULTIPLE SEARCHES
HLL ARG,0(PP) ;[256] RECOVER FLAGS
HRRZM ARG,0(PP) ;[256] STACK POINTER TO GLOBAL
JRST SYMBKY ;[323] AND DO DUMMY PUSHJ
SYMBKZ: ;[323] FAKE RETURN ADDRESS
POP PP,V ;[256] GET OFFSET
MOVEM V,0(ARG) ;[256] STORE OFFSET
JRST SYMBKR ;[265] RETURN
IFN POLISH,<
SRCH: HLRZ SX,SRCHX
HRRZ SDEL,SRCHX
SRCH1: CAML AC0,-1(SX)
JRST SRCH3
SRCH2: SUB SX,SDEL
LSH SDEL,-1
CAMG SX,SGSTOP
JUMPN SDEL,SRCH1
JUMPN SDEL,SRCH2
SOJA SX,SRCHNO ;NOT FOUND
SRCH3: CAMN AC0,-1(SX)
JRST SRCHYE ;NORMAL / FOUND EXIT
ADD SX,SDEL
LSH SDEL,-1
CAMG SX,SGSTOP
JUMPN SDEL,SRCH1
JUMPN SDEL,SRCH2
SOJA SX,SRCHNO ;NOT FOUND
SYN CPOPJ1,SRCHYE ;SKIP RETURN
SYN CPOPJ,SRCHNO ;NON-SKIP RETURN
>
INSERQ: TLNE ARG,UNDF!VARF
INSERZ: SETZB RC,V
INSERT: CAME AC0,-1(SX) ;ARE WE LOOKING AT MATCHING MNEMONIC?
JRST INSRT2 ;NO, JUST INSERT
JUMPL ARG,INSRT1 ;YES, BRANCH IF OPERAND
SKIPL 0(SX) ;OPERATOR, ARE WE LOOKING AT ONE?
JRST UPDATE ;YES, UPDATE
JRST INSRT2 ;NO, INSERT
INSRT1: SKIPG 0(SX) ;OPERAND, ARE WE LOOKING AT ONE?
JRST UPDATE ;YES, UPDATE
SUBI SX,2 ;NO, MOVE UNDER OPERATOR AND INSERT
INSRT2: MOVE SDEL,SYMBOL
SUBI SDEL,2
CAMLE SDEL,FREE
JRST INSRT3
PUSHJ PP,XCEEDS
ADDI SDEL,2000
INSRT3: MOVEM SDEL,SYMBOL ;MAKE ROOM FOR A TWO WORD ENTRY
HRLI SDEL,2(SDEL)
BLT SDEL,-2(SX) ;PUSH EVERYONE DOWN TWO LOACTIONS
IFN POLISH,<
MOVE AC1,SGNCUR ;CURRENT PSECT INDEX
AOS SGSCNT(AC1) ;INCREMENT PSECT SYM COUNT
>
AOS @SYMBOL ;INCREMENT THE SYMBOL COUNT
TDNE RC,[-2,,-2] ;SPECIAL LEFT OR RIGHT EXTERNAL?
JRST INSRT5 ;YES, JUMP
TLNN V,-1 ;SKIP IF V IS A 36BIT VALUE
JRST INSRT4 ;JUMP, ITS A 18BIT VALUE
AOS SDEL,FREE ;36BIT, SO GET A CELL FROM FREE CORE
CAML SDEL,SYMBOL ;MORE CORE NEEDED?
PUSHJ PP,XCEEDS ;YES
HRRI ARG,-1(SDEL) ;POINTER TO ARG
MOVEM V,0(ARG) ;36BIT VALUE TO FREE CORE
TLO ARG,PNTF ;[204] NOTE THAT ARG IS APOINTER, NOT A 18BIT VALUE
JRST INSRT7 ;[204] STORE SYMBOL
INSRT4: HRR ARG,V ;18 BIT VALUE ARG
TLNN ARG,EXTF ;[204] POSSIBLE TO BE EXT WITH 0 RELOC SO DON'T
TLZ ARG,PNTF ;[204] CLEAR POINTER FLAG INCASE SET
INSRT7: DPB RC,RCPNTR ;FIX RIGHT RELOCATION
TLNE RC,1
TLO ARG,LELF ;FIX LEFT RELOCATION
INSRT6: MOVEM ARG,0(SX) ;INSERT FLAGS AND VALUE.
MOVEM AC0,-1(SX) ;INSERT SYMBOL NAME.
PUSHJ PP,SRCHI ;INITILIAZE SRCHX
JRST QSRCH ;EXIT THROUGH CREF
INSRT5: MOVEI SDEL,2 ;GET TWO CELLS FROM FREE CORE
ADDB SDEL,FREE
CAML SDEL,SYMBOL ;MORE CORE NEEDED?
PUSHJ PP,XCEEDS ;YES
MOVEM RC,-1(SDEL)
HRRI ARG,-2(SDEL) ;POINTER TO ARG
MOVEM V,0(ARG)
TLO ARG,SPTR ;SET SPECIAL POINTER, POINTS TO TWO CELLS
JRST INSRT6
REMOVE:
IFN POLISH,<
MOVEI AC2,0(SX) ;ADDRESS OF THE SYMBOL
SUB AC2,SYMBOL ; - BASE OF SYMBOL TABLE
LSH AC2,-1 ; / 2 = SYMBOL ORDINAL
TDZA AC1,AC1 ;INIT PSECT INDEX
ADDI AC1,1 ;INCREMENT PSECT INDEX
HRRZ AC0,SGSCNT(AC1) ;WITHIN THIS PSECT?
SUB AC2,AC0
JUMPG AC2,.-3 ;TRY NEXT PSECT IF NOT
SOS SGSCNT(AC1) ;DECREMENT PSECT SYM COUNT
>
SUBI SX,2 ;MOVE EVERYONE UP TWO LOCATIONS
REMOV1: MOVE 0(SX)
MOVEM 2(SX) ;OVERWRITE THE DELETED SYMBOL
CAME SX,SYMBOL ;SKIP WHEN DONE
SOJA SX,REMOV1
ADDI SX,2
MOVEM SX,SYMBOL
SOS 0(SX) ;DECREMENT THE SYMBOL COUNT
SRCHI: MOVEI AC2,0 ;THIS CODE SETS UP SRCHX
IFE POLISH,<
FAD AC2,@SYMBOL
>
IFN POLISH,<
HRRZ AC1,SGNCUR
HRRZ AC1,SGSCNT(AC1)
FAD AC2,AC1
>
LSH AC2,-^D27
MOVEI AC1,1000
LSH AC1,-357(AC2)
HRRM AC1,SRCHX
LSH AC1,1
IFE POLISH,<
ADD AC1,SYMBOL
HRLM AC1,SRCHX
>
IFN POLISH,<
HRLM AC1,SRCHX
MOVE AC1,SYMBOL
MOVEM AC1,SGSBOT
HRRZ AC2,SGNCUR
JUMPE AC2,SRCHI2
SRCHI1: HRRZ AC1,SGSCNT-1(AC2)
LSH AC1,1
ADDB AC1,SGSBOT
SOJG AC2,SRCHI1
SRCHI2: MOVS AC2,AC1
ADDM AC2,SRCHX
MOVE AC2,SGNCUR
SRCHI3: HRRZ AC1,SGSCNT(AC2)
LSH AC1,1
ADD AC1,SGSBOT
MOVEM AC1,SGSTOP
>
POPJ PP, ;SRCHX=XWD <SYMTBL+LENGTH/2>,LENGTH/4
UPDATE: DPB RC,RCPNTR ;FIX RIGHT RELOCATION
TLNE ARG,SPTR ;SKIP IF THERE IS NO SPECIAL POINTER
JRST UPDAT4 ;YES, USE THE TWO CELLS
TDNE RC,[-2,,-2] ;NEED TO CHANGE ANY CURRENT EXTERNS
JRST UPDAT5 ;YES ,JUMP
TLZ ARG,LELF ;CLEAR LELF
TLNE RC,1 ;LEFT RELOCATABLE?
TLO ARG,LELF ;YES, SET THE FLAG
TLNE ARG,PNTF ;WAS THERE A 36BIT VALUE?
JRST UPDAT2 ;YES, USE IT.
TLNE V,-1 ;NO,IS THERE A 36BIT VALUE?
JRST UPDAT1 ;YES, GET A CELL
HRR ARG,V ;NO, USE RH OF ARG
UPDAT3: MOVEM ARG,0(SX) ;OVERWRITE THE ONE IN THE TABLE
IFE POLISH,<
POPJ PP, ;AND EXIT
>
IFN POLISH,<
JRST UPDAT6 ;AND EXIT
>
UPDAT1: AOS SDEL,FREE ;GET ONE CELL
CAML SDEL,SYMBOL ;NEED MORE CORE?
PUSHJ PP,XCEEDS ;YES
HRRI ARG,-1(SDEL) ;POINTER TO ARG
TLO ARG,PNTF ;AND NOTE IT.
UPDAT2: TLNE ARG,EXTF ;IS THERE A EXTERNAL?
JRST UPDAT3 ;YES, - JUST SAVE A LOCATION
MOVEM ARG,0(SX) ;NO, OVERWRITE THE POINTER IN THE TABLE
MOVEM V,0(ARG) ;STORE VALUE AS A 36BIT VALUE
IFE POLISH,<
POPJ PP, ;AND EXIT
>
IFN POLISH,<
JRST UPDAT6 ;AND EXIT
>
UPDAT4: MOVEM ARG,0(SX) ;WE HAVE TWO CELLS, WE USE THEM
MOVEM V,0(ARG) ;SAVE AS 36BIT VALUE
MOVEM RC,1(ARG) ;SAVE RELOCATION BITS
POPJ PP, ;AND EXIT
UPDAT5: MOVEI SDEL,2 ;THERE IS A EXTERNAL
ADDB SDEL,FREE ;SO WE NEED TWO LOACTIONS
CAML SDEL,SYMBOL ;NEED MORE CORE?
PUSHJ PP,XCEEDS ;YES
MOVEM RC,-1(SDEL) ;SAVE RELOCATION BITS
HRRI ARG,-2(SDEL) ;SAVE THE POINTER IN ARG
MOVEM V,0(ARG) ;SAVE A 36BIT VALUE
TLO ARG,SPTR ;SET SPECIAL PNTR FLAG
TLZ ARG,PNTF ;CLEAR POINTER FLAG
JRST UPDAT3 ;SAVE THE POINTER AND EXIT
IFN POLISH,<
UPDAT6: TLNN IO,DEFCRS ;DEFINING OCCURANCE?
POPJ PP, ;NO, RETURN
TLNE ARG,EXTF ;EXTERNAL?
POPJ PP, ;YES, RETURN
MOVE SDEL,SYMBOL ;GET START OF SYM TAB
SETZ AC1, ;ZERO PSECT INX
UPDAT7: HRRZ AC2,SGSCNT(AC1) ;PSECT SYM CNT
LSH AC2,1 ;DOUBLE IT
ADD SDEL,AC2 ;END OF PSECT
CAMGE SDEL,SX ;SYM IN THIS PSECT?
AOJA AC1,UPDAT7 ;NO, TRY NEXT PSECT
CAMN AC1,SGNCUR ;IF IT'S IN THE CUR PSECT
POPJ PP, ; THEN RETURN
PUSH PP,AC1 ;SAVE PRESENT PSECT INX
PUSH PP,0(SX) ;SAVE SYMBOL STUFF
PUSH PP,-1(SX) ; AND NAME
PUSH PP,SX ;SAVE PRESENT SYM INX
PUSHJ PP,SRCHI ;SET UP SRCHX
PUSHJ PP,SRCH ;SET UP NEW SX
JFCL
POP PP,SDEL ;RESTORE PRESENT SYM INX
MOVE AC1,-2(PP) ;GET PRESENT PSECT INX
CAMG AC1,SGNCUR ;WHICH WAY TO MOVE?
JRST UPDAT9 ;DOWN
ADDI SX,2 ;MUST MOVE THIS ONE ALSO
UPDAT8: MOVE AC2,-2(SDEL) ;MOVE PART OF
MOVEM AC2,0(SDEL) ; SYMBOL TABLE
CAILE SDEL,0(SX) ;ENOUGH MOVED?
SOJA SDEL,UPDAT8 ;NO
JRST UPDT10 ;COMMON EXIT
UPDAT9: HRLI AC2,1(SDEL) ;FROM HERE
HRRI AC2,-1(SDEL) ; TO HERE
BLT AC2,-2(SX) ; UNTIL HERE, MOVE!
UPDT10: POP PP,-1(SX) ;RESTORE SYMBOL NAME
POP PP,0(SX) ; AND STUFF
POP PP,AC1 ;OLD PSECT INX
SOS SGSCNT(AC1) ;DECR ITS SYM CNT
MOVE AC1,SGNCUR ;CUR PSECT INX
AOS SGSCNT(AC1) ;INCR ITS SYM CNT
PUSHJ PP,SRCHI ;SET UP SRCHX
POPJ PP, ;RETURN
>
SUBTTL CONSTANTS
IFN FORMSW,<
HWFORM: BYTE (18) 1,1
INFORM: BYTE (9) 1 (4) 1 (1) 1 (4) 1 (18) 1
IOFORM: BYTE (3) 1 (7) 1 (3) 1 (1) 1 (4) 1 (18) 1
BPFORM: BYTE (6) 1,1 (2) 1 (4) 1 (18) 1
ASCIIF: BYTE (7) 1,1,1,1,1
SXFORM: BYTE (6) 1,1,1,1,1,1
>
SUBTTL PHASED CODE
IFN PURESW,<LOWH:
PHASE LOWL>
IFN FT.U01,<
$USRPD: IOWD $USRLN,$USSTK
>;END IFN FT.U01
IFN TEMP,<TMPFIL: SIXBIT /MAC/
XWD -200,0>
LSTFIL: BLOCK 1
SIXBIT /@/ ;SYMBOL TO STOP PRINTING
TABI:
IFE FORMSW,< BYTE (7) 0, 11, 11, 11, 11>
IFN FORMSW,< BYTE (7) 11,11, 11, 11, 11>
SEQNO: BLOCK 1
ASCIZ / /
BININI: EXP B
BINDEV: BLOCK 1
XWD BINBUF,0
LSTINI: EXP AL
LSTDEV: BLOCK 1
XWD LSTBUF,0
IFN CCLSW,<
RPGINI: EXP AL
RPGDEV: BLOCK 1
XWD 0,CTLBLK
>
INDEVI: EXP A
INDEV: BLOCK 1
XWD 0,IBUF
UNVINI: EXP B ;[240] OPEN BLOCK FOR BINARY UNV
UNVDEV: BLOCK 1 ;[240] SO USER CAN SPECIFY
EXP UNVBUF ;[240]
..LPP: EXP .LPP-2 ;[227] "READ-ONLY" LINES/PAGE
DBUF: ASCIZ / TI:ME DY-MON-YR PAGE /
VBUF: ASCIZ / MACRO %/ ;MUST BE LAST LOCATIONS IN BLOCK
IFE PURESW,< BLOCK 3 ;ALLOW FOR LONG TITLE>
IFN PURESW,< DEPHASE
LENLOW==.-LOWH>
SUBTTL STORAGE CELLS
IFN PURESW,< RELOC LOWL
LOWL: BLOCK LENLOW+3 >
PASS1I:
RP: BLOCK 1
IFN POLISH,<
POLSTK: BLOCK 1 ;[164]
POLPTR: BLOCK 1 ;[164]
>
CTLBUF: BLOCK <CTLSIZ+5>/5
LSTBUF: BLOCK 3
BINBUF: BLOCK 3
IBUF: BLOCK 3
UNVBUF: BLOCK 3
LSTDIR: BLOCK 4
BINDIR: BLOCK 4
INDIR: BLOCK 4
UNVDIR: BLOCK 4
UNVPTH: BLOCK 2+.SFDLN ;[240] PATH FOR UNV LOOKUP
MYPPN: BLOCK 1 ;[405]LOGGED IN PPN
ACDELX: ;LEFT HALF
BLKTYP: BLOCK 1 ;RIGHT HALF
COUTX: BLOCK 1
COUTY: BLOCK 1
COUTP: BLOCK 1
COUTRB: BLOCK 1
COUTDB: BLOCK ^D18
UPARRO: BLOCK 1 ;[333] SWITCH WORD FOR RE-EATING ^ IF NOT FOLLOWED BY - OR !
OKOVFL: BLOCK 1 ;[362] -1 == * OR / OVERFLOW OK
DECTAB: BLOCK 1 ;[206] -1 == TABS NOT INCLUDED IN MACRO ARGS
IFN TSTCD,<
TCDFLG: BLOCK 1 ;[414]-1 MEANS TEST MODE, 0 REGULAR MODE
> ; NFI TSTCD
ERRCNT: BLOCK 1
EOFFLG: BLOCK 1 ;[417]END OF FILE SEEN,NEXT FILE OPENED
NOFLG: BLOCK 1 ;0=DIRECTIVE XXX -1=DIRECT NO XXXX
QERRS: BLOCK 1 ;COUNT OF "Q" ERRORS
FREE: BLOCK 1
HIGH1: BLOCK 1
HISNSW: BLOCK 1
SVTYP3: BLOCK 1
HMIN: BLOCK 1 ;START OF HIGH SEG. IN TWO SEG. PROG.
SXSV: BLOCK 1
SDELSV: BLOCK 1
COLSIZ: BLOCK 1
SYMBLK: BLOCK 1
IFBLK: BLOCK .IFBLK
IFBLKA: BLOCK .IFBLK
LADR: BLOCK 1
NCOLLS: BLOCK 1
LIMBO: BLOCK 1
LBUFP: BLOCK 1
LBUF: BLOCK <.CPL+5>/5
.SGLVZ==. ;[264] START OF LIT /VAR AREA
BLOCK 1
VARHD: BLOCK 1
VARHDX: BLOCK 1
LITAB: BLOCK 1
LITABX: BLOCK 1
BLOCK 1
LITHD: BLOCK 1
LITHDX: BLOCK 1
LITCNT: BLOCK 1
LITNUM: BLOCK 1
.SGLVL==.-.SGLVZ ;[264] LENGTH OF LIT/VAR AREA
LITERR: BLOCK 1 ;[415]
LOOKX: BLOCK 1
NEXT: BLOCK 1
OUTSW: BLOCK 1
PDP: BLOCK 1
RECCNT: BLOCK 1
SAVBLK: BLOCK RC
SAVERC: BLOCK 1
SBUF: BLOCK .SBUF/5
SRCHX: BLOCK 1
SUBTTX: BLOCK 1
SVSYM: BLOCK 1
SYMBOL: BLOCK 1
SYMTOP: BLOCK 1
SYMCNT: BLOCK 1
IFN POLISH,<
SGNMAX: BLOCK 1
SGNAME: BLOCK SGNSGS+1
SGRELC: BLOCK SGNSGS+1
SGSCNT: BLOCK SGNSGS+1
SGATTR: BLOCK SGNSGS+1
SGORIG: BLOCK SGNSGS+1 ;[264] LIT/VAR AREA ,, ORIGIN OF PSECT
SGSBOT: BLOCK 1
SGSTOP: BLOCK 1
SGWFND: BLOCK 1
>
STPX: BLOCK 1
STPY: BLOCK 1
STCODE: BLOCK .STP
STOWRC: BLOCK .STP
IFN FORMSW,<
STFORM: BLOCK .STP
FORM: BLOCK 1
HWFMT: BLOCK 1
FLDSIZ: BLOCK 1
IOSEEN: BLOCK 1
>
TABP: BLOCK 1
TCNT: BLOCK 1 ;COUNT OF CHARS. LEFT IN TBUF
TBUF: BLOCK .TBUF/5
DEVBUF: BLOCK 6 ;STORE NAME.EXT CREATION DATE AND TIME
TYPERR: BLOCK 1
PRGPTR: BLOCK 1 ;POINTER TO CHAIN OF PRGEND BLOCKS
ENTERS: BLOCK 1 ;-1 WHEN ENTERS HAVE BEEN DONE
UNIVSN: BLOCK 1 ;-1 WHEN A UNIVERSAL SEEN
UNVSKP: BLOCK 1 ;-1 IF /U SEEN (DON'T SAVE UNIV)
CPUTYP: BLOCK 1 ;[235] CPU TYPE FOR HEADER BLOCK
IFN FT.U01,<
$USSTK: BLOCK $USRLN ;USER PUSH-DOWN STACK
>;END IFN FT.U01
PASS2I:
ABSHI: BLOCK 1
HIGH: BLOCK 1
HHIGH: BLOCK 1 ;SAVE BREAK OF HIGH SEG. IN TWO SEG PROG.
IFN POLISH,<
SGNCUR: BLOCK 1
SGDMAX: BLOCK 1
SGLIST: BLOCK SGNDEP+1
>
ACDEVX: BLOCK 1
CPL: BLOCK 1
CTLSAV: BLOCK 1
CTLS1: BLOCK 1
EXTPNT: BLOCK 1
INTENT: BLOCK 1
INREP: BLOCK 1
INDEF: BLOCK 1
INTXT: BLOCK 1
INCND: BLOCK 1
CALNAM: BLOCK 1
COMSW: BLOCK 1 ;[425] -1 IF IN COMMENT WHILE LOOKING FOR ANG.BRKT.
;DO NOT SPLIT THIS BLOCK OF 4 WORDS
PAGENO: BLOCK 1
SEQNO2: BLOCK 1
TAG: BLOCK 1
TAGINC: BLOCK 1
CALPG: BLOCK 4
DEFPG: BLOCK 4
LITPG: BLOCK 4
REPPG: BLOCK 4
TXTPG: BLOCK 4
CNDPG: BLOCK 4
IRPCNT: BLOCK 1
IRPARG: BLOCK 1
IRPARP: BLOCK 1
IRPCF: BLOCK 1
IRPPOI: BLOCK 1
IRPSW: BLOCK 1
LITLVL: BLOCK 1
LBLFLG: BLOCK 1 ;[402] -1 IF LABEL HAS OCCURRED INSIDE CURRENT LITERAL
LTGINC: BLOCK 1 ;[402] DEPTH OF LABEL IN LITERAL
LITLBL: BLOCK 2 ;[155] NAME OF LABEL DEFINED INSIDE A LITERAL + VALUE
ASGBLK: BLOCK 1
LOCBLK: BLOCK 1
LOCA: BLOCK 1
LOCO: BLOCK 1
RELLOC: BLOCK 1
ABSLOC: BLOCK 1
LPP: BLOCK 1
ORGMOD: BLOCK 1
MODA: BLOCK 1
MODLOC: BLOCK 1
MODO: BLOCK 1
IFN CCLSW,<OTBUF: BLOCK 2>
OUTSQ: BLOCK 2
PAGEN.: BLOCK 1
PPTEMP: BLOCK 1
PPTMP1: BLOCK 1
PPTMP2: BLOCK 1
REPCNT: BLOCK 1
REPEXP: BLOCK 1
REPPNT: BLOCK 1
RPOLVL: BLOCK 1
R1BCNT: BLOCK 1
R1BCHK: BLOCK 1
R1BBLK: BLOCK .R1B
R1BLOC: BLOCK 1
RIMLOC: BLOCK 1
VECREL: BLOCK 1
VECTOR: BLOCK 1
VECSYM: BLOCK 1 ;[244] GLOBAL SYMBOLIC START ADDRESS
IFN POLISH,<
VECFND: BLOCK 1
>
.TEMP: BLOCK 1 ;TEMPORARY STORAGE
UNISCH: BLOCK .UNIV+1 ;SEARCH TABLE FOR UNIVERSALS
SQFLG: BLOCK 1
ARGF: BLOCK 1
CPEEKC: BLOCK 1 ;[325] ANGLE COUNT AFTER ;; IN MACRO
MACENL: BLOCK 1
MACLVL: BLOCK 1
MACPNT: BLOCK 1
WWRXX: BLOCK 1
RCOUNT: BLOCK 1 ;COUNT OF WORDS STILL TO READ IN LEAF
WCOUNT: BLOCK 1 ;COUNT OF WORDS STILL FREE IN LEAF
IONSYM: BLOCK 1 ;-1 SUPRESS LISTING OF SYMBOLS
LOCAL: BLOCK 1 ;LINKED LIST OF LOCAL FIXUPS
IFN POLISH,<
POLTYP: BLOCK 1 ;[164] PRESET IF POLISH FIXUP TYPE KNOWN
POLIST: BLOCK 1 ;[164] LINKED LIST OF POLISH FIXUP BLOCKS
POLITS: BLOCK 1 ;[265] LINKED LIST OF POLISH FIXUPS TO LITS (TEMP)
>
INASGN: BLOCK 1 ;[267] HOLDS SYMBOL NAME DURING ASSIGN INCASE NEEDS POLISH
SFDADD: BLOCK 3+.SFDLN ;FOR LOOKUP/ENTER OF SFD PATH
SFDE==.-1 ;[216] END OF SFD
PPPN: BLOCK 1 ;[216] DEFAULT PPN
PSFD: BLOCK 3*.SFDLN ;[216] DEFAULT SFD
PSFDE==.-1 ;[216] LAST ADDRESS IN SFD
PASS2Z: ;ONLY CLEAR TO HERE ON PRGEND
LSTSYM: BLOCK 1
SPAGNO: BLOCK 1 ;PAGE NUMBER FOR SYMBOL TABLES
PASS2X:
SUBTTL MULTI-ASSEMBLY STORAGE CELLS
SAVEPP: BLOCK 1 ;SAVE PP INCASE NO END STATEMENT
SAVEMP: BLOCK 1 ;MACRO PNTR FOR SAME REASOM
SAVERP: BLOCK 1 ;MACRO READ POINTER
LSTPGN: BLOCK 1
ARAYP: BLOCK 1
HDAS: BLOCK 1
IFN CCLSW,<EXTMP: BLOCK 1 ;HOLDS EXT OF COMMAND FILE (RH)
SAVFF: BLOCK 1>
CTLBLK: BLOCK 3
CTIBUF: BLOCK 3
CTOBUF: BLOCK 3
IFN TEMP,<TMPFLG: BLOCK 1>
IFN FORMSW,<PHWFMT: BLOCK 1>
MACSIZ: BLOCK 1 ;INITIAL SIZE OF LOW SEG
UNISIZ: BLOCK 1 ;TOP OF BUFFERS AND STACKS
UNITOP: BLOCK 1 ;TOP OF UNIVERSAL SYMBOL TABLE
UNIVNO: BLOCK 1 ;NUMBER OF UNIVERSALS SEEN
UNITBL: BLOCK .UNIV+1 ;TABLE OF UNIVERSAL NAMES
UNIPTR: BLOCK .UNIV+1 ;TABLE OF SYMBOL POINTERS
UNISHX: BLOCK .UNIV+1 ;TABLE OF SRCHX POINTERS
UNVDFA: BLOCK 1 ;[334] DEFAULT ARGUMENT POINTER FOR UNIVERSAL I/O
UNVER%: BLOCK 1 ;[334] OLD UNIVERSAL FILE IF -1, MAY HAVE LOST DEFAULT ARGS
RTIME: BLOCK 1 ;[234] CPU TIME AT START OF PASS1
VAR ;CLEAR VARIABLES
IFE POLISH,<SYN HIGH,SGATTR>
JOBFFI: BLOCK 203*NUMBUF+1 ;INPUT BUFFER PLUS ONE
IFN PURESW,<LOWEND==.-1
RELOC >
END BEG