perm filename FAIL.FEB[X,AIL] blob
sn#094438 filedate 1974-03-30 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00161 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00013 00002 TITLE FAIL -- NEW STUFF
C00015 00003 AC'S, PDL'S, AND INITIAL CONSTANTS
C00022 00004 DEFINITION OF FLAGS FLAGS FLAGS
C00027 00005 BEGIN INIT ↔ SUBTTL OPCODE TABLE AND DEVICE INITIALIZATION
C00031 00006 ITS,<
C00035 00007 BEGIN INITIT
C00037 00008 ↑INITL: 0
C00041 00009 ERR3: MOVEI 6,[ASCIZ /INPUT SYNTAX ERROR/]
C00043 00010 ↑SWITCH:0
C00046 00011 ZER:
C00048 00012 JRST FAT
C00052 00013 BEGIN OPTBL
C00059 00014 ROUTINE TO GET SYSTEM CALL DEFS FROM SYSTEM
C00064 00015 BEGIN RPG ↔ SUBTTL INITIALIZATION OF PROGRAM
C00068 00016 STRT: TDZA T,T
C00075 00017 ITS,<
C00079 00018 OUT: 0
C00080 00019 NOFSL: JSR HERE WHEN OUT OF FREE STORAGE
C00086 00020 CHARACTER TABLE (FOR SCANNER)
C00090 00021 BEGIN SCAN ↔ SUBTTL SCANNER AND FRIENDS
C00092 00022 NUMS: MOVEI N,-20(B) PUT VALUE IN N
C00093 00023 ↑SPCSKP:0
C00095 00024 DEFINE EMPS (A)
C00096 00025 ↑RTBFND:HRRI B,TP2F!RBCF
C00098 00026 LNUM: JSR SLNUM
C00100 00027 DEFINE DHAN!(A)
C00101 00028 DEFINE QUOT 7 (M)
C00103 00029 EQLS: PUSH P,SRAD SAVE CURRENT RADIX
C00107 00030 DNOTB: JRST DNDH DELETE
C00109 00031 BSH: PUSHJ P,SCAN1 GET NUM
C00110 00032 LVMAC: POP M,C GET OLD MTBPNT
C00113 00033 NTST: CAMGE B,-3(M) DONE?
C00115 00034 ↑SCAN1: TLZE SFL AHEAD?
C00117 00035 ↑SCNTIL:TLZE SFL AHEAD?
C00119 00036 ↑SLURP: PUSH P,BROKCT ROUTINE TO EAT TEXT UP TO MATCHING BROKET
C00121 00037 JRST SLRPX
C00122 00038 SCANM GO HERE FOR SCAN IF MACROS ARE TO BE EXPANDED
C00125 00039 ↑Q%IF: DPB N,[POINT 3,Q%T,8]DEPOSIT TEST
C00127 00040 ↑QIF%D: HRREM N,Q%SV SAVE VALUE
C00129 00041 SUBTTL SCANS -- MAIN SCANNER IF SYMBOLS ARE TO BE LOOKED UP
C00132 00042 PT2: TLO SOPF OPCODE FOUND
C00134 00043 PT69: MOVEI PN,(TAC) OOPS - WRONG AC
C00136 00044 VRHN: TRNE B,UDARF
C00138 00045 SPCCHK: TLNN NFLG
C00140 00046 TCALL: ACALL CALL ASSEMBL
C00144 00047 IRBO: PUSH P,[0]
C00146 00048 BEGIN INP
C00150 00049 REVAL -- EVALUATES EXPRESION INTO LIST-POLISH
C00153 00050 SPC2: TLNE B,UNOF UNARY OPERATOR?
C00156 00051 SPC1: TLNE N,UNOF UNARY OPERATOR?
C00158 00052 REDUC -- REDUCES THE LIST STRUCTURE POLISH
C00161 00053 ADOP: AROP(ADD,,,ADD,12)
C00162 00054 MEVAL -- MAIN EVALUATER -------
C00166 00055 NONSIM: TLZ RELEF!REUNBF CLEAR FLAGS
C00169 00056 ↑DBLUP: 0
C00171 00057 PTQ1: MOVE N,LSTLAB+2SET UP...
C00173 00058 LADF: MOVEI O, INITIALIZE COUNT
C00175 00059 LNMM: PUSH P,O SAVE COUNT
C00177 00060 SAW ( CHECK FOR INDEX CONSTRUCT & GET OUT QUICKLY IF SO
C00179 00061 POLFIX: MOVE T,MTBPNT GET NEXT FREE AREA
C00181 00062 POLMOV: SKIPL N,(FS) OPERATOR OR OPERAND?
C00183 00063 BEGIN LABINS
C00186 00064 GFIX: CALL WITH POINTER TO DEFINED SYMBOL IN PN AND
C00188 00065 FINCFX: MOVE TAC,3(N) GET PLACE
C00190 00066 ↑SYMFXP: XWD 11,4
C00192 00067 PFIX: CALL WITH POINTER TO DEFINED SYMBOL IN PN AND POLISH
C00194 00068 PFULX: MOVE T,4(N) GET VALUE
C00196 00069 HALOUT: HRROM L,HALP1 DEPOSIT RIGHT HALF OF POINTER
C00197 00070 ↑POLOUT: HRRZ L,MTBPNT GET A FREE PLACE TO PUT FIXUP
C00199 00071 PPTT1: MOVS FS,-1(FS) GET ARG POINTER
C00202 00072 ASSMBL -- ASSEMBLES A LINE & RETURNS VALUE
C00204 00073 EMP: MOVEM N,WRD DEPOSIT VALUE
C00206 00074 IXFLD: TLNE UNDF DEFINED?
C00208 00075 CCOM: TLZ SFL SKIP THE ,
C00210 00076 SPCL: TLNE N,CRFG!LNFDCR?
C00211 00077 SUBTTL PSEUDO-OP ROUTINES
C00214 00078 ↑%ASCII: TLZ SFL CLEAR SCAN AHEAD
C00216 00079 ↑%XWD: TLO MLFT LEFT HALF
C00218 00080 ↑%LIT: MOVE N,OPCNT+1
C00219 00081 ↑%CON: MOVE TAC,SRAD SAVE CURRENT RADIX
C00221 00082 ↑DPHAZ: MOVE N,OPCNT+1
C00222 00083 ↑%BYTE: TRNN B,LFPF ( NEXT?
C00225 00084 ↑%POINT:PUSH P,SRAD SAVE CURRENT RADIX
C00227 00085 PAWT: MOVSS N SWAP HALVES
C00229 00086 ↑%SIX: TLZ SFL SKIP CHR.
C00231 00087 ↑%OPDEF:PUSHJ P,SCAN GET SIXBIT
C00234 00088 DEFINE TIT $(TITCNT,Q,EXTRA,X1)
C00236 00089 ↑%TITLE:MOVEI FS,
C00238 00090 ↑%EXT: PUSHJ P,SCANS GET IDENT
C00240 00091 ↑%NOSYM:SETZM SYMOUT
C00243 00092 ↑%ENTRY:SKIPE CODEM WAS CODE EMITTED?
C00246 00093 ↑%ENDL: PUSHJ P,BFRC FOURCE OUT BINARY
C00248 00094 ↑%RAD5: TRO NOFXF
C00250 00095 SUBTTL THIS HERE IS THE ASSEMBLER !!!!!!!!!
C00252 00096 SUBTTL UUO HANDLER AND OUTPUT ROUTINES
C00255 00097 BINARY I/O HANDLING ROUTINES
C00257 00098 ↑UBBOUT:MOVEM BC,UBBSV
C00259 00099 ↑UFOUT: MOVE TAC,@40 GET WORD
C00260 00100 ↑FFX: MOVEI TAC,(FC) ADDRESS GETS FIXED UP TO -(FBLK+2)
C00262 00101 ↑R5CON: MOVEM FS,R5C1
C00263 00102 LISTING I/O STUFF
C00265 00103 PUSHJ P, OCON CONVER
C00266 00104 ↑VBLOUT:TRNN LDEV LIST DEVICE?
C00268 00105 ↑LSTLF: SKIPGE AHED LINE FEED SEEN -- IF NOT FROM MACRO
C00271 00106 HERE SPEC CHRS & LINE OVERFLOW ARE HANDLED
C00273 00107 LOUTDL: SKIPLE LNCNT
C00276 00108 PTIM: PUSH P,N
C00279 00109 FLST: SKIPN ERCNT ANY ERRORS?
C00284 00110 YESL: SKIPN XPNDSW NOT EXPANDING NOW?
C00286 00111 OTAB: DPB TAC,NA
C00288 00112 ERSCN: SKIPN ERCNT NONE?
C00290 00113 RCQ: MOVEI N,LABPRT
C00294 00114 ↑CREFPT:0
C00298 00115 SUBTTL ..END, BEND, BEGIN..
C00300 00116 EINT: MOVE FS,(PN) GET SIXBIT
C00302 00117 LAST: MOVEI FS,5(N) SET UP POINTER
C00304 00118 EUND: MOVE FS,(PN) GET SIXBIT
C00307 00119 SPC: TLNN N,CRFG CR?
C00309 00120 BEGIN BEND
C00311 00121 LOOP1: MOVEM NA,NASAV SAVE
C00313 00122 DEL: MOVE T,FSTPNT GET FREE STRG PNTR.
C00316 00123 MERER: ASCII /MULTIPLY DEFINED BY ↑
C00318 00124 NFND: MOVE T,2(PN) GET FLAGS
C00320 00125 LITLAB: TLNE N,DAF!GLOBF BOY ARE THESE A PAIN
C00323 00126 MOVSI FS,20 RESTORE LOST FS
C00325 00127 PSYM: TRNN LDEV LIST DEV?
C00327 00128 SPT1: ADDI PN,3 GO TO NEXT
C00329 00129 %BEG: MOVE N,BLOCK GET BLOCK...
C00330 00130 %BPT: AOS %BCUR INCREMENT
C00332 00131 LITOUT -- TO OUTPUT LITTERALS
C00334 00132 LOP1: SKIPN 4(L) ANYTHING HERE?
C00336 00133 POLHAN: MOVE TAC,OPCNT GET PLACE WHERE THIS IS...
C00338 00134 LPQ3: SKIPN FS,1(L)
C00340 00135 ↑VAR: PUSHJ P,BFRC FORCE OUT BIN
C00341 00136 SUBTTL ..ORG.. INCLUDES ORG, LOC, RELOC, USE, AND SET
C00344 00137 BEGIN USE
C00346 00138 ↑NULN: BLOCK 5
C00347 00139 BEGIN SET
C00349 00140 SUBTTL MACROS, FOR, REPEAT, IF'S
C00351 00141 ALOP: PUSHJ P,SCAN GET ARG
C00354 00142 TXTIN: CALL, TO READ TEXT INTO CORE, WITH PLACE IT IS TO GO
C00357 00143 ARGIN: CALL TO READ IN ARGS. USES NEXT FREE SPACES
C00359 00144 BKR2: TRNN B,RTPF )?
C00361 00145 GALL1: PUSHJ P,SCAN1 GET CHR.
C00363 00146 SARGIN: CALL TO READ IN A SINGLE ARGUMENT. POINTER FOR
C00365 00147 ROUTINE TO RETURN MACRO TABLE SPACE
C00367 00148 MACRL: JUMPL N,[MOVEM B,LGARB↔JRST .+3] UPDATE LGARB, AVOID TEST IF AT END
C00369 00149 REPEAT CODE IS HERE ------------
C00372 00150 REP0: MOVE TAC,TLBLK
C00374 00151 ↑%FOR: MOVE O,MTBPNT
C00376 00152 CONE: TRNN N,ATF @?
C00378 00153 NOTHRD: MOVEI N,1
C00380 00154 HRRZI N,6(N) INCREMENT
C00382 00155 NOTIM: SUB P,[2(2)] CLEAR STACK
C00384 00156 IFLOP: MOVEI N,4(O) GET...
C00386 00157 ↑IFORSH:MOVE B,(M) GET ARG POINTER
C00388 00158 FINIT: POP P,N RESTORE
C00390 00159 EFLOP: PUSH P,FS PUSH CONCAT
C00392 00160 ↑EFORSH:MOVE B,(M) GET ARG POINTER
C00394 00161
C00395 ENDMK
C⊗;
TITLE FAIL -- NEW STUFF
SUBTTL CONDITIONAL ASSEMBLY
XALL
;ITS ASSEMBLY ADDED 6/18/73 --PJ
;CMU ASSEMBLY ADDED 10/6/73 -- MM/FW
DEFINE SETSW(SWIT,VAL)<IFNDEF SWIT,<↓SWIT←←VAL;>↓SWIT←←SWIT>
IFDEF .IOT,<ITSSW←←1> ;WE'RE AT MIT!
SETSW ITSSW,0
SETSW CMUSW,0
IFN CMUSW!ITSSW,<STANSW←←0>
SETSW STANSW,0 ;; **** turned this off -- rht ****
SETSW STNKSW,ITSSW
SETSW EDITSW,STANSW!CMUSW ;SWITCH TO ALLOW CALLING EDITOR
;(PROBABLY NOT VERY USEFUL WITH STD DEC RUN UUO WHICH CLOBBERS ACS)
SETSW STOPSW,CMUSW ;SWITCH TO MAKE /R DEFAULT MODE (ONLY CMU LIKES THIS CURRENTLY)
DEFINE ITS,<IFN ITSSW,>
DEFINE NOITS,<IFE ITSSW,>
DEFINE STINK,<IFN STNKSW,>
DEFINE NOSTINK,<IFE STNKSW,>
SUBTTL AC'S, PDL'S, AND INITIAL CONSTANTS
;AC'S
↓P←17
↓N←4
↓NA←N+1
↓PN←NA+1
↓B←10
↓C←B+1
↓L←12
↓T←1
↓FS←T+1
↓O←FS+1
↓CP←7
↓TAC←13
↓BC←14
↓FC←15
↓M←16
↓ERPLEN←←100 ;NO. OF ERROR MESSAGES
SETSW LINLEN,=120 ;CHARACTERS/LINE
SETSW LNPP,=60 ;LINES/PAGE FOR MOST PEOPLE
IFN STANSW,<LNPP←←=54>
chrpl: LINLEN ;CHaRacters Per Line - normally =120, but reduced
; by eight for CREFFing. - JHS
↓HASH←←=101;HASH SIZE
PLEN←←200
CPLEN←←200
RPGSW: 0
PDL: BLOCK PLEN ;PDLOV ERR PRINT WILL OVERFLOW INTO CPDL
CPDL: BLOCK CPLEN
LSTLAB: BLOCK 5
↓EFSLEN←←500;LENGTH OF AREA FOR POLISH
EFS: BLOCK EFSLEN
MACRT: BLOCK HASH
SYMTAB: BLOCK HASH
0
LITPNT: BLOCK HASH
-1
LOB: BLOCK 3
ODB: BLOCK 3
OPCDS: BLOCK HASH
NOITS,< 0
IBUF1: 201,,IBUF2
BLOCK 201+1
0
IBUF2: 201,,IBUF3
BLOCK 201+1
0
IBUF3: 201,,IBUF4
BLOCK 201+1
0
IBUF4: 201,,IBUF5
BLOCK 201+1
0
IBUF5: 201,,IBUF1
BLOCK 201+1
>;NOITS
ITS,<
SRCSTS: BLOCK 10 ;FOR CHANNEL STATUS
IBUF1: BLOCK 201
>;ITS
IDB: 0
INPNT: BLOCK 2
;MACRO TO MARK CURRENT PC AS LEGAL PLACE FOR MPV INTERRUPT
DEFINE LEG{FOR @! X←LEGNUM,LEGNUM{↑↑%$L!X::}↑↑LEGNUM←←LEGNUM+1 }
↓LEGNUM←←0
DEFINE DELHN
< DPB B,LSTPNT
ILDB C,INPNT
XCT DELTAB(C)
ILDB C,INPNT
DPB C,LSTPNT>
DEFINE GFST(A,B)
< SKIPN A,B
JSR NOFSL
>
DEFINE SRC1 (A,B,C,D)
< CAMN A,(B)
JRST C
SKIPN B,1(B)
D
CAMN A,(B)
JRST C
SKIPN B,1(B)
D
JRST .-10
>
DEFINE SRC2 (A,B,C,D)
< CAMN A,(B)
JRST C
HRRZ B,1(B)
JUMPN B,.-3
D
>
DEFINE ACALL ;TO CALL ASSMBL
< PUSHJ P,[POPJ CP,]>
DEFINE RETN ;TO RETURN FROM ASSMBL
< PUSHJ CP,[PUSH CP,[ASSMBL]
POP CP,-2(CP)
POPJ P,]>
DEFINE EDEPO (AC,PNT,NUM)
< MOVEI AC,177
LEG IDPB AC,PNT
MOVEI AC,NUM
LEG IDPB AC,PNT
>
DEFINE RVALUA ;TO CALL REVAL
< PUSH P,[16]
PUSHJ P,REVAL
MOVE FS,(P)
TRZE POLERF
SETZM (FS)
>
ITS,<
OPDEF RELEASE [1B8]
OPDEF CLOSE [2B8]
OPDEF TTYUUO [3B8]
OPDEF PTYUUO [4B8]
OPDEF CALLI [5B8]
OPDEF INIT [6B8]
OPDEF LOOKUP [7B8]
OPDEF ENTER [10B8]
>;ITS
OPDEF ERROR[11B8]
OPDEF FATAL[12B8]
OPDEF FOUT[13B8]
OPDEF OUTP[14B8]
OPDEF POUT[15B8]
OPDEF TRAN[16B8]
OPDEF BBOUT[17B8]
OPDEF CREF6 [20B8]
OPDEF CREF66 [21B8]
OPDEF CREF7 [22B8]
ITS,<
OPDEF IN [23B8]
OPDEF OUT [24B8]
OPDEF INPUT [25B8]
OPDEF OUTPUT [26B8]
OPDEF INBUF [27B8]
OPDEF OUTBUF [30B8]
OPDEF STATO [31B8]
OPDEF STATZ [32B8]
OPDEF GETSTS [33B8]
OPDEF MTAPE [34B8] ;ILLUUO
OPDEF TTCALL [TTYUUO]
OPDEF INCHRW [TTYUUO 0,]
OPDEF OUTCHR [TTYUUO 1,]
OPDEF INCHRS [TTYUUO 2,]
OPDEF OUTSTR [TTYUUO 3,]
OPDEF INCHWL [TTYUUO 4,]
OPDEF INCHSL [TTYUUO 5,]
OPDEF GETLIN [TTYUUO 6,]
OPDEF SETLIN [TTYUUO 7,]
OPDEF RESCAN [TTYUUO 10,]
OPDEF CLRBFI [TTYUUO 11,]
OPDEF CLRBFO [TTYUUO 12,]
OPDEF INSKIP [TTYUUO 13,]
OPDEF INWAIT [TTYUUO 14,]
OPDEF APRENB [CALLI 16]
OPDEF PTWR1S [PTYUUO 7,]
OPDEF PTWRS9 [PTYUUO 12,]
COMMENT ⊗
OPDEF .OPEN [41000,,0]
OPDEF .IOT [40000,,0]
OPDEF .CORE [43300,,0] ;43 6,0
OPDEF .RESET [42000,,37]
OPDEF .SUSET [43540,,0] ;43 13,0
OPDEF .DISMI [43040,,0] ;43 1,0
OPDEF .VALUE [43200,,0] ;43 4,0
OPDEF .CLOSE [42000,,7]
OPDEF .RDATE [42000,,46]
OPDEF .RTIME [42000,,45]
OPDEF .RCHST [42000,,103]
OPDEF .IOPUSH [42000,,13]
OPDEF .IOPOP [42000,,14]
OPDEF .GETSYS [42000,,23]
OPDEF .EVAL [42000,,73]
↓.SMASK←400006
↓.SSNAM←400016
↓.RMEMT←←12
⊗
INTERNAL USAVEA,USAVEB,USAVEC,USAVED,USAVEE,USAVEP
INTERNAL CTRL,META,CTLMTA,UUOCON,UUOXIT,ILLUUO,GBOUT1
EXTERNAL ITSGO,.TTYUUO,.PTYUUO,.INIT,.RELSE,.CLS,.LOOK,.ENTER,.CALLI
EXTERNAL .OUTBUF,.INBUF,.IN,.OUT,.INPUT,.OUTPUT,.STATO,.STATZ,.GETSTS
EXTERNAL STKTRN
CTRL←←0 ;CHARACTERS WHICH SET META BITS
META←←0
CTLMTA←←0
USAVEA: 0 ;UUO AC SAVE AREA
USAVEB: 0
USAVEC: 0
USAVED: 0
USAVEE: 0
USAVEP: 0
LSUUO: 0 ;UUO AND PC FOR REENTRANT UUO'S
LSUUPC: 0
UUORET: 0
>;ITS
IFE STANSW,<
OPDEF APRENB[CALLI 16]
OPDEF RUN[CALLI 35]
>
EXTERN JOBREL,JOBFF,JOBSA,JOBAPR,JOBTPC
↓SNB←←400000 ;VERY HANDY NUMBER WHICH ONE GETS TIRED OF TYPING
LABLTP: 0
LABLTC: 0
LSTPNT: 0
IBUFR1←IBUF1
BLOCK: 1
DBLCK: XWD DAF,-1
PCNT: BLOCK 2 ;LEAVE CONTIGUOUS & IN THIS ORDER
OPCNT: BLOCK 2
WRD: BLOCK 2
DPCNT: BLOCK 2
SUBTTL DEFINITION OF FLAGS FLAGS FLAGS
;AC 0 IS FLAG REGISTER
;AC 0 FLAGS (LEFT HALF):
↓SFL←←200000 ;SCANNER AHEAD ONE CHR.
↓IFLG←←100000 ;SCAN SAW IDENT
↓NFLG←←40000 ;SCAN SAW NUMBER
↓SCFL←←20000 ;SCAN SAW SPC.CHR.
↓FLTFL←←10000 ;SCAN -- FLOATING POINT NUMBER
↓ESNG←←4000 ;EVAL SAW ONLY SINGLE THING
↓ESPF←←2000 ;EVAL SAW ONLY SPC CHR
↓REUNBF ←←1000 ;REVAL TEMP BIT -- UNBAL PARENS
↓OPFLG←←400 ;AN OPCODE WAS SEEN
↓RELEF←←200 ;REDUC -- RELOC ERROR
↓SOPF←←100 ;SCANS -- OPCODE FOUND
↓PSOPF←←40 ;SCANS -- PSEUDO-OP FOUND
↓MLFT←←20 ;LEFT HALF FIXUPS SHOULD BE GENERATED
↓UNDF←←10 ;MEVAL -- UNDEF.
↓PAWF←←4 ;PARENS AROUND WHOLE -- MEVAL
↓AUNDF←←2 ;ASSMBL -- PART IS UNDEFINED
;RIGHT HALF BITS:
↓NOFXF←←200000 ;MEVAL -- DONT GENERATE FIXUPS
↓IOSW←←100000 ;ASSMBL -- IO OPCODE
↓BDEV←←40000 ;BIN DEVICE EXISTS
↓LDEV←←20000 ;LIST DEVICE EXISTS
↓BLOSW←←10000 ;TEMP BIT FOR LISTING SYNC
↓ADFL←←4000 ;TEMP BIT USED BY ASSMBLE TO KEEP TRACK OF # OF ADRSES
↓FLFXF←←2000 ;USED BY ASSMBL TO TELL MEVAL TO MAKE FULL WORD FIXUPS
↓TRBF←←1000 ;ASSMBL -- TERMINATED BY ]
↓POLERF←←400 ;POLISH ERROR
↓MACUNF←←200 ;A MACRO WAS ENTERED (FOR UNDERLINING)
↓IOFLGS←←BDEV!LDEV!BLOSW ;FLAGS PERTAINING TO I/O
;THE FOLLOWING ARE BITS USED TO IDENTIFY CHARACTERS IN THE TABLE
;LEFT HALF BITS:
;SNB OR 400000 (SIGN) ;NUMBER OR LETTER
↓NMFLG←←200000 ;NUMBER
↓SPFL←←100000 ;SPACE(TAB)
↓SPCLF←←40000 ;ANY SPC. CHR.
↓ARFL←←20000 ;ARITH OPERATOR
↓ARMD←←10000 ;ARITH OP MODIFIER (-,/,&,∧,UN -)
↓ARMD1←←4000 ;ADDITIONAL MODIFIER
↓UNOF←←2000 ;UNARY OP (- , ¬)
↓BFL←←1000 ;B
↓EFL←←400 ;E
↓DLETF←←200 ;DELETE
↓CRFG←←100 ;CR RET
↓LBRF←←40 ;< OR [
↓RBRF←←20 ;> OR ]
↓.FL←←10 ;.
↓LNFD←←4 ;LINE FEED
↓ENMF←←2 ;INDICATES THAT ANY STRING STARTING WITH
;THIS CHR. WILL BE SCANNED AS A NUMERICAL VALUE
↓SCRF←←1 ;SPC.CHR. REQUIRING HANDLING BY SCANNER
;THE FOLLOWING ARE RIGHT HALF BITS
↓SHRPF←←400000 ;#
↓BSLF←←200000 ;\ (BACKSLASH) (→)
↓UDARF←←100000 ;↑ OR ↓
↓LACF←←40000 ;← OR :
↓COMF←←20000 ;,
↓LFPF←←10000 ;(
↓RTPF←←4000 ;)
↓ATF←←2000 ;@
↓RBCF←←1000
↓LBCF←←400
↓INF←←200 ;⊂
↓EPSF←←100 ;ε
↓TP2F←←2 ;SUB-CLASS 2
↓TP1F←←1 ;SUB-CLASS 1
;THE FOLLOWING ARE NUMBER (FLAG PART) BITS USED TO TELL
; ABOUT NUMBERS AND SYMBOLS
;LEFT HALF:
↓DEFFL←←200000 ;UNDEFINED IF ON
↓VARF←←100000 ;"VAR"--(DEFINED WITH #)
↓INCF←←20000 ;"IN CORE" VALUE (IN ASSEMBLER CORE)
↓UPARF←←10000 ;UP ARROW (SYMBOL ONLY)
↓DAF←←4000 ;DOWN ARROW(SYMBOL ONLY)
↓DBLF←←2000 ;DOUBLE ← (←←) (SYMBOL ONLY)
↓GLOBF←←1000 ;GLOBAL
↓INTF←←400 ;INTERNAL
↓EXTF←←200 ;EXTERNAL
↓UDSF←←100 ;SYMBOL HAS BEEN DEFINED WITH AN UNDEFINED DEFINITION
↓SYMFIX←←40 ;WE NEED A SYMBOL TABLE FIXUP FOR THIS SYMBOL
↓DBLUPF←←20 ;THIS IS A DOUBLE UPARROWED SYMBOL (SYMBOL ONLY);;;;
↓COLONF←←10 ;SYM WAS DEFINED WITH :
↓REFBIT←←4 ;SYM HAS BEEN REFERENCED
ITS,<↓ANONF←←2> ;THIS SYMBOL ANONYMOUS TO LOADER
;RIGHT HALF HAS BITS FOR LEVELS AT WHICH DEFINED.
NOLIT
BEGIN INIT ↔ SUBTTL OPCODE TABLE AND DEVICE INITIALIZATION
NOITS,<
BEGIN NAME
↑NAME: 0
IFE STANSW,<SETZM 13>
NA1: JSR IN
CAIE 2,11
CAIN 2," "
JRST NA1
TDZA 6,6 ;HAVING IGNORED SPACES AND TABS-WE
LOOP1: JSR IN ;GET A CHR
CAIE 2,"."
SKIPL 7,CTAB(2) ;CHECK FOR NUMBER OR LETTER
JRST STOPN ;NO, ALL DONE
TLNE 6,770000 ;SEEN 6
JRST LOOP1 ;YES, IGNORE THIS
LSH 6,6 ;PUT IT IN
ANDI 7,77 ;SIXBIT FROM TABLE
IORI 6,(7)
MOVEI 2,40(7) ;MAKE SURE WE GET UPPER CASE VERSION OF CHAR
IDPB 2,10 ;SAVE CHR IN FILE NAME
IFE STANSW,<LSH 13,3
IORI 13,-'0' (7) ;MAKE OCTAL PPN>
JRST LOOP1
STOPN: JUMPE 6,@NAME ;IF 0 RETURN
SKIPA
STOPN2: JSR IN
CAIE 2," "
CAIN 2,11
JRST STOPN2
IFE STANSW,<MOVEM 13,SVNAM>
IFN STANSW,<MOVEM 6,SVNAM>;FOR PPNS
STOPN1: TLNE 6,770000 ;ELSE LEFT JUSTIFY
JRST @NAME
LSH 6,6
JRST STOPN1
IFN CMUSW,<
↑RDPPN: 0
FOR I←0,2<SETZM PPNBUF+I↔>
RDPPN1: JSR IN
CAIE 2," "
CAIN 2," "
JRST RDPPN1
MOVEI 7,=13
SKIPA 6,[440700,,PPNBUF]
RDPPN2: JSR IN
CAIN 2,","
JRST RDPPOK
SKIPL CTAB(2)
JRST RDPPX
RDPPOK: IDPB 2,6
SOJG 7,RDPPN2
RDPPX: MOVE 6,[4,,PPNBUF]
CALLI 6,-2 ;CMUDEC
JRST ERR3
JRST @RDPPN
PPNBUF: BLOCK 3>
BEND NAME
BEGIN GETFIL
↑SVNAM: 0
↑GETFIL:0
MOVE 10,[ASCII/ /]
MOVEM 10,FILNM ;INITIALIZE FILE NAME
SETZM FILNM+1
MOVE 10,[POINT 7,FILNM,6] ;AND POINTER
JSR NAME ;READ A NAME
JUMPE 6,@GETFIL ;RETURN IF NONE THERE
AOS GETFIL ;ELSE SET FOR SKIP RETURN
CAIE 2,":" ;DEVICE NAME?
JRST NODEV ;NO, TRY FILE NAME
MOVE 1,6 ;SET DEVICE
MOVE 10,[ASCII / /]
MOVEM 10,FILNM
SETZM FILNM+1
MOVE 10,[POINT 7,FILNM,6]
JSR NAME ;GET ANOTHER NAME
JUMPE 6,@GETFIL ;NONE, END
NODEV: MOVE 5,6 ;FILE NAME
MOVEI 10,0 ;NO MORE STUFF
CAIN 2,"[" ;POSSIBLE PPN
JRST INPPN
CAIE 2,"." ;ELSE MAYBE EXTENSION
JRST @GETFIL ;NEITHER, PASS IT ON
JSR NAME ;GET EXT
JUMPE 6,ERR3 ;LOSE IF NONE THERE
HLLZ 3,6 ;SET EXTENSION
CAIE 2,"[" ;CHECK FOR PPN ;2 CHANGED FROM C, REG 8-4-71
JRST @GETFIL ;NO, RETURN
INPPN: IFE CMUSW,<
JSR NAME ;GET LEFT HALF
JUMPE 6,ERR3 ;NOT THERE
HRLZ 4,SVNAM ;GET LEFT HALF
CAIE 2,"," ;SHOULD BE THERE
JRST ERR3
JSR NAME
HRR 4,SVNAM ;FOR RIGHT HALF
>IFN CMUSW,<
JSR RDPPN
> CAIN 2,"]"
JSR IN ;SKIP ] IF PRESENT
JRST @GETFIL
BEND GETFIL
>;NOITS
ITS,<
begin itsscn
;its style command line scanner
dev←1
fn1←5
fn2←3
sname←4
break←2
char←7
acptr←10
ac←6
getcc: 0 ;get character for command line scanner
skipe limbo
skipa break,limbo
jsr in
setzm limbo
jrst @getcc
name: 0 ;break off word from input stream
na1: jsr getcc
caie break," " ;ignore leading spaces
cain break,11 ;tabs too
jrst na1
move acptr,[440600,,ac]
tdza ac,ac
name1: jsr getcc
jsr brktst
jrst nambrk ;found a break character
name2: tlne acptr,770000 ;ignore everything after 6 characters
idpb char,acptr
jrst name1
nambrk: jumpn char,@name ;no trailing spaces
nambr1: jsr getcc
caie break," " ;ignore trailing spaces
cain break,11
jrst nambr1
jsr brktst
jrst @name ;a break character
movem break,limbo ;space broke us
movei break," "
jrst @name
;converts break to sixbit and puts result in char
;↑Q quotes next character
;fails to skip on break character <non-sixbit space , : ; @ ← ( ) >
brktst: 0
cain break,11
movei break," "
jsr sixtst
jumpl char,[ caie break,21 ;↑Q
jrst @brktst ;non-sixbit breaks us
jsr getcc
jsr sixtst
jumpl char,@brktst ;non-sixbit
jrst brkt1]
jumpe char,@brktst
caie char,','
cain char,'←'
jrst @brktst
caie char,':'
cain char,';'
jrst @brktst
caie char,'('
cain char,')'
jrst @brktst
caie char,'@'
cain char,'/'
jrst @brktst
brkt1: aos brktst ;whew!
jrst @brktst
;convert break to sixbit
sixtst: 0
movni char,1
cail break," "
caile break,"←"
jrst sixt1 ;might be lower case
movei char,-" "(break)
jrst @sixtst
sixt1: cail break,"a"
caile break,"z"
jrst @sixtst
movei char,<"A"-"a"-" ">(break)
jrst @sixtst
;this routine scans command line for file specification
↑getfil:0
jsr name
jumpe ac,@getfil
aosa getfil
getf1: jsr name ;break off first name
jumpe ac,@getfil ;let initl worry about it
cain break,":"
jrst [ move dev,ac
jrst getf1]
cain break,";"
jrst [ move sname,ac
jrst getf1]
;this must be fn1 or fn2
caie break," "
jrst [ jumpn fn1,[ move fn2,ac
jrst @getfil]
move fn1,ac
jrst @getfil]
jumpn fn1,[ move fn2,ac
jrst getf1]
move fn1,ac
jrst getf1
↑limbo: 0 ;scanner read ahead character
;scanner will not let us leave until non-zero
bend itsscn
>;ITS
BEGIN INITIT
↑INITIT:0
DPB 6,[POINT 4,INIT1,12]
SETZM FPPN ;IN CASE WE DO NOT STORE
MOVEM 1,NAM ;SET NAME
MOVEM 5,FNAM ;AND FILE NAME
MOVEM 3,FEXT
NOITS,<
CAIGE 6,5 ;PPNS FOR SPECIAL ONES
CAIN 6,2 ;NO PPN UNLESS INPUT
>;NOITS
MOVEM 4,FPPN
MOVEM 4,SAVPPN ;SAVE PPN SO WE CAN INVOKE AN EDITOR TVR - OCT '72
IFN STANSW,<
MOVSI 1,400000 ;REG. THESE 4 INSTRUCTIONS. 11-14-72
CAIE 6,4 ;SKIP IF IO CODE 4 - LIST FILE.
>
MOVEI 1,0 ;THIS IS NOT LST OR REL.
MOVEM 1,FEXT+1 ;AT STANFORD, LIST FILE PROT=400, DUMP NEVER.
MOVE 1,TBL1-2(6) ;GET BUFFER INFO
MOVEM 1,INIT2
INIT1: INIT @TBL3-2(6)
↑NAM: 0
INIT2: 0
JRST ERR1
INIT3: XCT TBL2-2(6) ;LOOKUP OR ENTER
JRST [ CAIN 6,2
SKIPE 3
JRST ERR2
ITS,<MOVSI 3,360000> ;GREATER THAN
NOITS,<MOVSI 3,'FAI'>
MOVEM 3,FEXT
JRST RENT1]
JRST @INITIT
TBL3: OCT 1,14,1,16,1
TBL1: IDB
XWD ODB,0
XWD LOB,0
0
CTLBUF
TBL2: LOOKUP 2,FNAM
ENTER 3,FNAM
ENTER 4,FNAM
LOOKUP 5,FNAM
LOOKUP 6,FNAM
↑↑FNAM: 0
FEXT: OCT 0,0
↑FPPN: 0
↑↑SAVPPN: 0
↑REENT: MOVEM 1,INITIT
RENT1: MOVEM 4,FPPN
JRST INIT3
BEND INITIT
↑RELFIL:BLOCK 5
↑INITL: 0
MOVEI 1,
NOITS,< HRLOI 3,'REL' >
ITS,<
SETZM LIMBO
HRLZI 3,'REL'
>;ITS
SETZB 5,4 ;NO FILE NAME, PPN
JSR GETFIL
JRST NOBIN ;NO FILE THERE
CAIN 2,"!" ;CHECK FOR LOAD COMMAND
JRST DOLOD
JUMPN 1,.+2
MOVSI 1,'DSK'
CAIN 2,"@"
JRST DOAT
MOVEM 5,RELFIL ;FILE NAME
NOITS,< HLLZM 3,RELFIL+1 >
ITS,< MOVEM 3,RELFIL+1 >
MOVEM 1,RELFIL+4
MOVEI 6,3 ;DEVICE 4
JSR INITIT
OUTBUF 3,2
TRO BDEV ;INDICATE WE HAVE ONE
CAIE 2,"/" ;CHECK FOR SWITCHES
CAIN 2,"("
JSR SWITCH
NOBIN: CAIN 2,"←" ;DOES HE WANT LISTING
JRST NOLST ;APPEARANTLY NNT
CAIE 2,","
JRST ERR3 ;HE IS A LOSER
MOVSI 1,'DSK'
MOVEI 5,0 ;NO FILE
IFN STANSW,<MOVSI 3,'LST'> ;ASSUME LST
IFE STANSW,<MOVSI 3,'CRF'> ;FOR CREF.
JSR GETFIL
JRST NOL1 ;MUST BE ,←
MOVEI 6,4
JSR INITIT
TRO LDEV
SETOM LISTSW
OUTBUF 4,5
CAIE 2,"/"
CAIN 2,"("
JSR SWITCH
NOL1: CAIE 2,"←"
JRST ERR3
NOLST: MOVSI 1,'DSK'
NOLS2: MOVEI 4,0 ;NO PPN FOR THIS ONE
SETZB 5,3 ;NO FILE OR EXT
JSR GETFIL
JFCL ;MUST BE OF FORM ,
ITS,<
JUMPE 5,[CAIE 2,12
JRST .+1
JRST NOLST] ;NULL FILE NAME, LF; MAYBE MORE ON NEXT LINE
>;ITS
MOVEM 1,SAVDEV# ;SAVE FOR NEXT TIME
MOVEI 6,2
JSR INITIT
ITS,<
MOVE 6,[2,,SRCSTS]
.RCHST 6,
MOVE 6,[440600,,SRCSTS+1] ;FILE NAME
MOVE 5,[440700,,FILNM]
MOVEI 3," "
IDPB 3,5
JSR NOLS3
MOVEI 3," "
IDPB 3,5 ;SPACE BETWEEN FILE NAMES
JSR NOLS3
MOVEI 3,0
IDPB 3,5 ;NULL MARKS END OF FILE NAME
OUTSTR FILNM
OUTSTR [ASCIZ /
/]
>;ITS
MOVEI 12,IBUFR1
TLO 12,400000
MOVEM 12,IDB ;SET UP BUFFER
SETZM MOINSW#
CAIE 2,"/"
CAIN 2,"("
JSR SWITCH
CAIN 2,","
SETOM MOINSW ;SAY HE HAS MORE TO COME
AOS INITL
MOVEM 17,INSV+17 ;SAVE ACS
MOVEI 17,INSV
BLT 17,INSV+16
MOVE 17,INSV+17
JRST @INITL
ITS,<
NOLS3: 0
MOVEI 4,6
ILDB 3,6
ADDI 3,40 ;CONVERT TO ASCII
IDPB 3,5
SOJG 4,.-3
JRST @NOLS3
>;ITS
ERR3: MOVEI 6,[ASCIZ /INPUT SYNTAX ERROR/]
ERR: JSR MESS
MOVEI 4,0
SKIPN RPGSW ;IF IN RPG MODE, SCAN TO END OF LINE
JRST @INITL
ERRL: CAIN 2,12
JRST @INITL
JSR IN
JRST ERRL
ERR1: MOVEI 6,[ASCIZ /DEVICE NOT AVAILABLE/]
JSR MESS
MOVE 6,NAM
ERRM: MOVEI 7,0
JSP 4,MS6
MOVEI 4,0
JRST @INITL
ERR2: MOVEI 6,[ASCIZ /FILE NOT FOUND/]
JSR MESS
MOVE 6,FNAM
JRST ERRM
BEGIN MS6
↑MS6: MOVEM 4,MESS
MOVE 1,[POINT 6,6]
MOVE 2,[POINT 7,MBUF]
LOOP: ILDB 7,1
JUMPE 7,[IDPB 7,2
MOVEI 6,MBUF
JRST ENDM]
ADDI 7,40
IDPB 7,2
JRST LOOP
BEND MS6
MESS: 0
ENDM: CALLI 6,3 ;DO A DDTOUT OF MESSAGE
MOVEI 6,[ASCIZ /
/]
CALLI 6,3
JRST @MESS
MBUF: BLOCK 2
BEGIN SWITCH
↑SWITCH:0
SETZM LPARF# ;NOT IN A ()
CAIN 2,"("
SETOM LPARF
MOVEI 10,0 ;NUMBER COUNT
SW1: JSR IN ;GET A SWITCH
CAIN 2,")" ;SEE IF END
JRST RPAR
CAIG 2,"9"
CAIGE 2,"0"
SKIPA
JRST [IMULI 10,=10 ;ACCUMULATE NUUMBERS
ADDI 10,-"0"(2)
JRST SW1]
CAIL 2,140
SUBI 2,40
MOVEI 7,0 ;SEARCH
LOOP1: SKIPN TBL1(7)
JRST ERR4
CAME 2,TBL1(7)
AOJA 7,LOOP1
SKIPG TBL2(7) ;PROHIBITED ON INPUT?
JRST OK ;NO
CAIN 6,2 ;INPUT?
JRST ERR5
OK: XCT TBL3(7)
SW4: MOVEI 10,0 ;RESET NUMBER
SKIPE LPARF ;IN ()
JRST SW1 ;YES
SW3: MOVNI 7,3 ;POINT BACK TO COMPARE
ADDM 7,SWITCH
JSR IN ;GET ANOTHER CHR
JRST @SWITCH
RPAR: SKIPE LPARF ;IN ()
JRST SW3 ;YES, EXIT
JRST ERR3 ;NO, LOSAGE
ERR4: MOVEI 6,[ASCIZ /UNREC SWITCH/]
ERRF: JSR MESS
ROT 2,-7
MOVEM 2,MBUF
MOVEI 6,MBUF
JRST ERR
ERR5: MOVEI 6,[ASCIZ /ILLEGAL SWITCH POSITION/]
JRST ERRF
DEFINE TABLE
<FOR B IN (<Z,1,ZER>,<W,-1,WND>,<A,-1,ADV>,<B,-1,BSP>
,<T,-1,LND>,<N,0,TTYERR>,<X,0,NOEXP>,<S,0,SYMOUT>
,<I,0,XL1IG>,<P,1,SLSHP>,<L,0,NOLTSW>,<C,1,CREFST>
,<Q,0,NOCNSW>,<U,0,UNDLNS>,<J,-1,ONCRF>,<K,-1,OFCRF>,<R,0,ERSTSW>
,<F,-1,NOSTOP>)
<TRBL (B)
>
>
DEFINE TRBL (A,B,C)
<"A"
>
TBL1: TABLE
0
DEFINE TRBL(A,B,C)
<B
>
TBL2: TABLE
0
DEFINE TRBL(A,B,C)
<IFE B,<SETOM C>
IFN B,<JRST C>
>
TBL3: TABLE
0
ZER:
DPB 6,[POINT 4,ZERA,12]
DPB 6,[POINT 4,ZERA+1,12]
ZERA: CALLI 13
CLOSE
JSP 1,REENT ;GO DO ENTER AGAIN
JRST SW4
DEFINE MAG (A,B)
<
DPB 6,[POINT 4,.+1,12]
MTAPE A
SOJG 10,.-1 ;DO IT A NUMBER OF TIMES
IFN B,<XCT .-2
DPB 6,[POINT 4,.+3,12]
DPB 6,[POINT 4,.+3,12]
DPB 6,[POINT 4,.+3,12]
MTAPE 0
STATO 1B24
MTAPE 16>
JRST SW4
>
WND: MAG 1,0
ADV: MAG 16,0
BSP: MAG 17,1
LND: MAG 10,0
CREFST: SETOM CREFSW
SETOM XCRFSW
MOVEI 10,LINLEN-8 ;CHOOSE ACC#10 BECAUSE SW4 CLOBBERS IT ANYWAY
MOVEM 10,CHRPL ;SET CHRPL SO CREF LISTINGS WON'T OVERFLOW - JHS
JRST SW4
ONCRF: SKIPE CREFSW
SETOM XCRFSW
JRST SW4
OFCRF: SETZM XCRFSW
JRST SW4
SLSHP: SKIPN 10
MOVEI 10,1
ADDM 10,PSWIT
JRST SW4
NOSTOP: SETZM ERSTSW
JRST SW4
BEND SWITCH
INSV: BLOCK 20
TSV: BLOCK 20
↑EOF: 0
SKIPN MOINSW ;MORE INPUT FIELDS?
JRST FAT
RELEAS 2,
MOVEM 17,TSV+17
MOVEI 17,TSV
BLT 17,TSV+16
MOVSI 17,INSV
BLT 17,17
MOVEI 17,EOFRT
MOVEM 17,INITL
ITS,< MOVE 17,TPDP > ;I WANT A PUSH DOWN POINTER!!!!!!!!!!!!!!
MOVE 1,SAVDEV
JRST NOLS2
EOFRT: JRST FAT
MOVSI 17,TSV
BLT 17,17
JRST @EOF
ITS,<
TPDP: -20,,TPDL-1
TPDL: BLOCK 20
>;ITS
DOLOD: JUMPN 1,.+2 ;CHANGE DEFAULT TO SYS
MOVSI 1,'SYS'
TRNE 3,-1
MOVSI 3,'DMP' ;AND DMP
MOVEM 1,SWPR
MOVEM 5,SWPR+1
MOVEM 3,SWPR+2
IFN STANSW,<
MOVEM 4,SWPR+4
SETZM SWPR+3
SKIPGE RPGSW
AOS SWPR+3 ;SET FOR RPG CALL
MOVEI 1,SWPR
CALL 1,[SIXBIT /SWAP/]
CALLI 12
>;IFN STANSW
IFE STANSW,<
MOVEI 1,SWPR
SKIPGE RPGSW
HRLI 1,1 ;START IN RPG MODE
CALLI 1,35
JRST 4,
>;IFE STANSW
SWPR: BLOCK 5 ;PUT PARAMS FOR SWAP HERE
IFE STANSW,<0>
↑ERRLK: MOVEI 6,[ASCIZ /NOT ENOUGH CORE FOR LINKAGE/]
CALLI 6,3
CALLI 12
DOAT: HLRZ 6,JOBSA
MOVEM 6,JOBFF ;RECLAIM BUFFER SPACE
NOITS,< TLZ 3,(3)> ;NULL EXTENSION IF NONE GIVEN
MOVEI 6,6 ;DEVICE 6
JSR INITIT ;GO GET IT SET UP
JRST RPGS1
FAT: SKIPN LITPG
JRST NOTLIT
MOVEI 3,LITMS
PUSHJ P,FMES
NOTLIT: MOVEI 3,0
SKIPE TXTPG
MOVEI 3,TXTMS
SKIPE SARGPG
MOVEI 3,SARMS
SKIPE REP0PG
MOVEI 3,REPMS
SKIPE TXTIPG
MOVEI 3,TXTIMS
JUMPE 3,FAT1
MOVE 1,SVLIN
MOVEM 1,@-1(3)
PUSHJ P,FMES
FAT1: FATAL [ASCIZ /END OF FILE & NO END STMT/]
FMES: MOVE 1,-2(3)
MOVE 2,[ASCII / /]
SKIPN @-1(3)
MOVEM 2,@-1(3)
MOVE 4,-1(3)
ADDI 4,2
HRLI 4,(<POINT 7,0,6>)
PUSHJ P,RNUM
MOVEI 1,0
IDPB 1,4
ERROR (3)
POPJ P,
RNUM: IDIVI 1,=10
HRLM 2,(P)
SKIPE 1
PUSHJ P,RNUM
HLRZ 1,(P)
ADDI 1,"0"
IDPB 1,4
POPJ P,
↑LITPG: 0
LITLIN
LITMS: ASCII / LITERAL LINE /
↑LITLIN:0
ASCII / PAGE /
BLOCK 3
↑TXTPG: 0
TXLIN
TXTMS: ASCII /TEXT STATEMENT LINE /
TXLIN: 0
ASCII / PAGE /
BLOCK 3
↑SARGPG: 0
SARLN
SARMS: ASCII /REPEAT OR MACRO ARGUMENT LINE /
SARLN: 0
ASCII / PAGE /
BLOCK 3
↑REP0PG:0
REPPG
REPMS: ASCII / REPEAT OR CONDITIONAL LINE /
REPPG: 0
ASCII / PAGE /
BLOCK 3
↑TXTIPG:0
TXTIL
TXTIMS: ASCII / FOR OR DEFINE LINE /
TXTIL: 0
ASCII / PAGE /
BLOCK 3
↑SVLIN: 0
BEND INIT
BEGIN OPTBL
GLOBAL HASH
XLIST
;XCREF
FOR @$ I←0,HASH-1
< IBQ$I←0
>
DEFINE ENT $(A,B,C)
< IBQ←'A'-'A'/HASH*HASH
IFL IBQ,<IBQ←-IBQ>
EN1(A,\IBQ,B,C)
>
DEFINE EN1 $(A,B,C,D)
< 'A'
IFIDN <>,<C>,<A IBQ$B>
IFDIF <>,<D>,<XWD -1,IBQ$B>
IFDIF <>,<C>,
<IFIDN <>,<D>,<C$IBQ$B>>
IBQ$B←.-2
IFDIF <>,<D>,<D
C>
>
DEFINE EMO(A)
< FOR @$ B IN(A)
< ENT(B)
ENT(B$I)
ENT(B$M)
ENT(B$S)
>
>
DEFINE ERG(A)
<FOR @$ Q IN (A)
<ENT(Q$B)
ENT(Q$I)
ENT(Q$M)
ENT(Q)
>
>
ERG(<SETM,SETA>)
ENT (PHASE,0,PHAZ)
ENT (DEPHAS,0,DPHAZ)
ENT(PZE, ,)
ENT(PAGE,0,%PAGE)
ENT(SUBTTL,0,%SUB)
ENT(RADIX,0,%RADIX)
ENT(TITLE,0,%TITLE)
ENT(END,9,%END)
ENT(PRGEND,0,%PRGEN)
DEFINE IO(A)
<FOR B IN(A)
<ENT (B,B,%IO)
>
>
IO(<CONSO,CONSZ,BLKI,BLKO,DATAI,DATAO,CONI,CONO>)
FOR @$ QRN IN (USE,SET,NOSYM,LIT,VAR,LIST,LALL)
<ENT(QRN,0,%$QRN)
>
ENT(XLIST,-1,%LIST)
ENT(XALL,-1,%LALL)
ENT(XLIST1,1,%LIST)
ENT(LOC,0,%ORG)
ENT(RELOC,-1,%ORG)
ENT(ORG,1,%ORG)
DEFINE ENQ(A)
< FOR B IN(A)
<ENT(B)
>
>
IFE STANSW<
ENQ(<CALL,INIT,ENTER,LOOKUP,USETO,USETI,UGETF,MTAPE,RELEAS>)
ENQ(<CLOSE,OUTBUF,INBUF,CALLI,STATO,STATZ,GETSTS,SETSTS>)
ENQ(<INPUT,OUTPUT>)
> ;IFE STANSW
ENT(INTERN,0,%INT)
ENT(OPDEF,0,%OPDEF)
ENT(ENTRY,0,%ENTRY)
ENT(LINK,0,%LINK)
ENT(LINKEN,0,%ENDL)
ENT(RADIX5,0,%RAD5)
ENT(CREF,0,%ONCRF)
ENT(XCREF,0,%OFCRF)
ENT(NOLIT,0,%NOLIT)
ENT(ARRAY,0,%ARAY)
ENT(INTEGE,0,%INTEG)
ENT(GLOBAL,0,%GLOB)
DEFINE MAT $(B)
<ENQ(<B$N,B$NE,B$NN,B$NA,B$O,B$ON,B$OE,B$OA>)
ENQ(<B$Z,B$ZE,B$ZN,B$ZA,B$C,B$CN,B$CE,B$CA>)
>
MAT(TS)
FOR @$ C IN(FAD,FSB,FMP,FDV)
<ENQ(<C,C$L,C$M,C$B,C$R,C$RL,C$RM,C$RB>)
>
ENQ(<AOBJN,AOBJP,FSC,IBP,BLT,JFCL,XCT>)
ENT(TTCALL,51B8+)
IFN STANSW,<
ENT(DPYOUT,703B8+)
>
IFE STANSW<
ENT(OPEN,50B8+)
ENT(RENAME,55B8+)
ENT(TTYUUO,51B8+)
ENT(INCHRW,<<TTCALL 0,>>)
ENT(OUTCHR,<<TTCALL 1,>>)
ENT(INCHRS,<<TTCALL 2,>>)
ENT(OUTSTR,<<TTCALL 3,>>)
ENT(INCHWL,<<TTCALL 4,>>)
ENT(INCHSL,<<TTCALL 5,>>)
ENT(GETLIN,<<TTCALL 6,>>)
ENT(SETLIN,<<TTCALL 7,>>)
ENT(RESCAN,<<TTCALL 10,>>)
ENT(CLRBFI,<<TTCALL 11,>>)
ENT(CLRBFO,<<TTCALL 12,>>)
ENT(INSKIP,<<TTCALL 13,>>)
ENT(IN,56B8+)
ENT(OUT,57B8+)
> ;IFE STANSW
ENT(CONS,257B8+)
ENT(JFFO,243B8+)
ENT(UFA,130B8+)
ENT(DFN,131B8+)
ENT(FADRI,145B8+)
ENT(FSBRI,155B8+)
ENT(FMPRI,165B8+)
ENT(FDVRI,175B8+)
ENT(FIX,247B8+)
ENT(JEN,<<JRST 12,>>)
ENT(HALT,<<JRST 4,>>)
ENT(JOV,<<JFCL 10,>>)
ENT(JCRY,<<JFCL 6,>>)
ENT(JCRY0,<<JFCL 4,>>)
ENT(JCRY1,<<JFCL 2,>>)
ENT(DEFINE,0,%DEF)
ENT(HISEG,0,%HISEG)
ENT(TWOSEG,0,%TWOSEG)
ENT(REPEAT,0,%REP)
ENT(FOR,0,%FOR)
ENT(POINT,0,%POINT)
ENT(BYTE,0,%BYTE)
ENT(OCT,10,%CON)
ENT(DEC,12,%CON)
ENQ(<JSP,JSA,JRA,ASH,ASHC,ROT,ROTC>)
ERG(<ANDCB,ORCM,ORCB,ORCA>)
MAT(TD)
DEFINE MAH $(A)
<EMO(<HRR$A,HRL$A,HLR$A,HLL$A>)
>
MAH(E)
MAH(O)
ERG(<AND,ANDCA,ANDCM,EQV,SETCA,SETCM,SETO,OR,IOR,XOR>)
ERG(<IMUL,MUL,DIV,IDIV>)
ENT(COMMEN,0,%COMM)
ENT(EXTERN,0,%EXT)
DEFINE JSK(A)
<FOR @$ Q IN(A)
<ENQ(<Q,Q$L,Q$LE,Q$G,Q$GE,Q$N,Q$E,Q$A>)
>
>
JSK(<AOJ,SOJ,AOS,SOS>)
ENT(JSR)
JSK(CAM)
MAH()
JSK(CAI)
ENQ(<LDB,DPB,ILDB,IDPB>)
EMO(<MOVS,MOVM,MOVN>)
ERG(SETZ)
ENT(BLOCK,0,%BLOCK)
ENT(EXCH)
MAH(Z)
ENT(BEGIN,0,%BEG)
ENT(BEND,0,%BEND)
JSK(SKIP)
ERG(SUB)
ENQ(<LSH,LSHC>)
ERG(ADD)
JSK(JUMP)
MAT(TR)
MAT(TL)
ENQ(<PUSH,POP,POPJ,PUSHJ>)
ENT(ASCII,0,%ASCII)
ENT(ASCIZ,1,%ASCII)
ENT(ASCID,-1,%ASCII)
ENT(SIXBIT,0,%SIX)
ENT(XWD,0,%XWD)
EMO(MOVE)
ENT(JRST)
↑OPCDS1:FOR @$ I←0,HASH-1
<IBQ$I
>
FOR @$I←0,HASH-1
<IBQ$I←0
>
DEFINE MENT (AR,BR,QR)
<'AR'
IBQ←'AR'-'AR'/HASH*HASH
IFL IBQ,<IBQ←-IBQ>
MENQ (\IBQ)
0
XWD -1,BR
QR
>
DEFINE MENQ $(A)
<IBQ$A
IBQ$A←.-2
>
FOR ROM IN (<IFE,2>,<IFG,7>,<IFN,6>,<IFL,1>,<IFGE,5>,<IFLE,3>)
<MENT (ROM,Q%IF)
>
FOR FOO IN (<IFIDN,-1,Q%IFD>,<IFDIF,0,Q%IFD>,<IFDEF,-1,QIF%D>,<IFNDEF,0,QIF%D>,<IFAVL,-1,QIF%A>,<IFNAVL,0,QIF%A>)
<MENT(FOO)
>
↑%IOWD: 'IOWD'
IBQ←'IOWD'-'IOWD'/HASH*HASH
MENQ (\IBQ)
0
2
.+1
%IOWD
ASCII/ XWD /
BYTE (7)"-","(",177,1,0,")",",",177,1,1,"-","1",40,177,3
FOR @! X IN(.,$.)
< 'X'
↑HASH!X←←'X'-'X'/HASH*HASH
MENQ \HASH!X
0
-2,,SCAN!X
SCNMPT
>
↑MACRT1: FOR @$ I←0,HASH-1
<IBQ$I
>
;CREF
LIST
BEND
;ROUTINE TO GET SYSTEM CALL DEFS FROM SYSTEM
IFN STANSW<
CALLPT←←272
SYS←←400000
OPSET: MOVEI T,37 ;GET SIZE OF MEMORY
PEEK T,
CAIL T,377777 ;NO MORE THAN 128K
MOVEI T,377777
ANDCMI T,1777
MOVSI T,1(T) ;MAKE PR WORD (WITH UWP BIT)
SETPR2 T,
JRST OPSLZ2
MOVE C,SYS+CALLPT
LDB NA,[221100,,C] ;# DEC CALLIS
MOVEM NA,UCLDLN#
SUBI NA,400000
MOVNM NA,SCLOFF#
LDB N,[331100,,C] ;TOTAL # CALLIS
CAIG N,300
CAIG N,400000(NA)
JRST OPSLUZ ;UNREASONABLE CRAP
MOVN NA,N
MOVSI T,(NA) ;MAKE AOBJN PNTR
MOVE L,SYS(C)
CAME L,['RESET ']
JRST OPSLUZ ;TABLE LOOKS WRONG
MOVE O,JOBFF
SETZM OPCDS ;INITIALIZE THIS
MOVE N,[OPCDS,,OPCDS+1] ;IT WILL KEEP TRACK OF THE ENDS OF THE HASH CHAINS
BLT N,OPCDS+HASH-1 ;AS THEY ARE NEEDED
MOVEI L,10 ;BIT FOR CALLI OPCODE ENTRIES
HRLI C,T
MOVEI B,40 ;INCREMENT
PUSHJ P,OPST1 ;DEFINE CALLIS
HRR C,@C ;GET MAJOR OPCODE TABLE ADR
MOVSI T,-40 ;# LOW UUOS
MOVEI L,40000 ;STARTING VAL
MOVEI B,1000 ;INC
PUSHJ P,OPST1 ;DEFINE LOW UUOS
HLL T,SYS-1(C) ;GET # HIGH UUOS IN LH
TLC T,-1
ADDI T,SYS ;CARRY WILL MAKE 2'S COMP
MOVEI L,700000 ;NEW INIT VAL (PNTR & INC SAME AS BEFORE)
PUSHJ P,OPST1 ;DEFINE HIGH UUOS
MOVEI B,40 ;NOW SET UP INC FOR SECONDARY OPCODES
OPSLP1: HRR C,SYS-1(C) ;GET NEXT TABLE LOC
TRNN C,-1
JRST OPSDON ;DONE IF ADR 0
HLRZ L,SYS-1(C) ;ELSE GET BASE VAL & CNT
LDB T,[50400,,L] ;GET CNT-1
MOVNI T,1(T)
MOVSI T,(T) ;MAKE AOBJN PNTR
ANDI L,777000 ;ISOLATE STARTING VAL
PUSHJ P,OPST1 ;DEFINE THIS SECONDARY SET
JRST OPSLP1 ;AND TRY FOR ANOTHER GRP
OPSDON: MOVEM O,JOBFF ;UPDATE BOTH
HRLM O,JOBSA ;COPIES OF JOBFF
OPSTX: SETOM OPSOK ;DON'T NEED TO DO THIS AGAIN
MOVEI T,
CORE2 T, ;FLUSH PR2
POPJ P,
POPJ P,
OPST1: TRNN C,600000
TRNN C,-200
JRST OPSLUZ ;BAD ADDRESS
IORI T,SYS ;PUT OFFSET IN PNTR
OPSTL: SKIPA N,@C
LSH N,-6
TRNN N,77 ;RIGHT-JUSTIFY IF NECESSARY (SIGH)
JUMPN N,.-2 ;BUT AVOID LOOP ON 0
JUMPE N,OPSNXT ;IGNORE 0'S
LEG MOVEM N,(O) ;STORE NAME
IDIVI N,HASH
MOVM NA,NA
SKIPE PN,OPCDS(NA) ;DO WE ALREADY KNOW THE END OF THIS CHAIN?
JRST OPSTL2 ;YES
TROA PN,OPCDS1-1(NA) ;NO - FIND IT SO THESE CAN GO AT END
MOVEI PN,(FS) ;WHERE THEY WON'T INTERFERE WITH
HRRZ FS,1(PN) ;NORMAL OPCODES
JUMPN FS,.-2
OPSTL2: HRRM O,1(PN) ;LINK IN
LEG MOVSM L,1(O) ;STORE VALUE
MOVEM O,OPCDS(NA) ;THIS IS NOW END OF LIST
ADDI O,2
OPSNXT: ADDI L,(B) ;COUNT VALUE FIELD
AOBJN T,OPSTL
POPJ P,
OPSLUZ: OUTSTR [ASCIZ /GARBAGEY DATA IN SYSTEM CALL TABLE/]
OPSLZ3: OUTSTR [ASCIZ /, YOU LOSE!
/]
EXIT
OPSLZ2: OUTSTR [ASCIZ /SETPR2 TO GET CALLI NAMES FAILED/]
JRST OPSLZ3
OPSEND←←. ;OPSOK THRU HERE THROWN AWAY AFTER FIRST TIME
OPSOK: 0
>
BEGIN RPG ↔ SUBTTL INITIALIZATION OF PROGRAM
↑SETRPG:
IFE STANSW,<
MOVSI 1,(<SIXBIT /FAI/>)
MOVEM 1,RPGNAM
HRLI 1,-170
HRR 1,JOBFF
MOVEM 1,RPGNAM+1
HRLI 1,700
MOVEM 1,CTLBUF+1 ;BYTE POINTER
HRLI 1,2 ;READ AND DELETE
HRRI 1,RPGNAM
CALLI 1,44 ;TEMPCORE
JRST DSKRPG ;NOT IN SERVICE
MOVEI 1,170*5
MOVEM 1,CTLBUF+2
SETOM TMPCOR#
MOVEI 1,200
ADDM 1,JOBFF ;BUMP TO PAST BUFFER
JRST RPGS5
DSKRPG:
>;IFE STANSW
MOVSI 1,'DSK'
MOVEM 1,RPGDV
IFE STANSW,<MOVSI 1,'FAI'
CALLI 2,30 ;JOB NUMBER
MOVEI 4,3
IDIVI 2,=10
IORI 1,20(3)
ROT 1,-6
SOJG 4,.-3 ;FAKE A JOB NUMBER.
>
IFN STANSW,<
MOVE 1,[SIXBIT /QQFAIL/]
>
MOVEM 1,RPGNAM
IFE STANSW,<MOVSI 1,'TMP'>
IFN STANSW,<MOVSI 1,'RPG'>
MOVEM 1,RPGNAM+1
SETZM RPGNAM+3
INIT 6,1
RPGDV: 0
CTLBUF
JRST STRT1 ;SEE US LOSE
LOOKUP 6,RPGNAM ;NOW SEE IF FILE IS THERE
JRST STRT
INIT 7,16 ;GET RID OF INPUT FILE
SIXBIT /DSK/
0
JRST STRT
SETZM RPGNAM+3 ;GET RID OF EXTRA JUNK
HLLZS RPGNAM+1
LOOKUP 7,RPGNAM
JRST STRT
RENAME 7,ZEROS
JFCL
↑RPGS1: INBUF 6,1
RPGS5:
ITS,< SETOM RPGSW >
NOITS,< HLLOS RPGSW>
MOVE 1,JOBFF
MOVEM 1,SVJFF ;SAVE FOR NEXT ASSEMBLY
JRST RPGGO
↑RPGRS: LDB 2,CTLBUF+1 ;SCAN TO END OF LINE
RPGRS2: CAIN 2,12
JRST RPGRS1
JSR IN
JRST RPGRS2
RPGRS1:
MOVE 1,SVJFF
MOVEM 1,JOBFF
JRST RPGGO ;AND AWAY WE GO
↑RPGIN: SOSG CTLBUF+2
JRST [ IFE STANSW,<SKIPE TMPCOR
JRST RPGXIT>
IN 6,0
JRST .+1
STATZ 6,20000 ;EOF?
JRST RPGXIT
OUTSTR [ASCIZ /ERROR READING COMMAND FILE/]
JRST RPGXIT]
IBP CTLBUF+1
MOVE 2,@CTLBUF+1
TRNE 2,1
JRST [AOS CTLBUF+1
MOVNI 2,5
ADDM 2,CTLBUF+2
JRST RPGIN]
LDB 2,CTLBUF+1
JUMPE 2,RPGIN
ITS,<
CAIN 2,3
JRST RPGXIT ;↑C IS EOF
CAIE 2,14 ;IGNORE FORM FEEDS
>;ITS
CAIN 2,15 ;IGNORE CR'S
JRST RPGIN
JRST @IN
RPGXIT: SKIPGE RPGSW
CALLI 12
SETZM RPGSW
JRST STRT1
↑CTLBUF:BLOCK 3
RPGNAM: BLOCK 4
SVJFF: 0
ZEROS: REPEAT 4,<0>
BEND
STRT: TDZA T,T
MOVNI T,1
MOVEM T,RPGSW
MOVE T,[JSR UUO]
MOVEM T,41
MOVE P,[-PLEN,,PDL-1]
ITS,< PUSHJ P,ITSGO>
PUSHJ P,CORINI ;SET UP MPV INTERRUPTS
IFN STANSW,<
SKIPN OPSOK
PUSHJ P,OPSET ;DEFINE SYSTEM OPCODES IF NOT DONE YET
>
SKIPGE RPGSW
JRST SETRPG
NOITS,< HLLZS 42> ;CLEAR OUT ERROR IF NOT IN RPG MODE
STRT1:
SKIPE RPGSW
JRST RPGRS
CALLI
PUSHJ P,CORINI ;NOW RE-ENABLE INTS AFTER RESET (SIGH)
RPGGO: MOVE P,[-PLEN,,PDL-1]
FOR A IN (NOEXP#,TTYERR#,SYMOUT#,XL1IG#,PSWIT#,<LISTSW#>
,NOLTSW#,CREFSW#,XCRFSW#,INLINE#,NOCNSW#,UNDLNS#
,PGNM,SPGNM,TTYPTR,INCLIN#)
< SETZM A
>
IFE STOPSW,<SETZM ERSTSW#;>SETOM ERSTSW#
MOVSI 1
MOVEM CHRCNT#
SETOM LNCNT ;SET THESE TWO CELLS TO FORCE HEADING
ITS,< SETZM NEWFIL>
AOS PGNM
MOVEI
SKIPN RPGSW
NOITS,< JSR SOUT >
ITS,<
JRST [ MOVEI 1,[.FNAM1]
PUSHJ P,FNMOUT
OUTCHR ["."]
MOVEI 1,[.FNAM2]
PUSHJ P,FNMOUT
JSR SOUT
JRST .+1]
>;ITS
JSR INITL ;DECODE COMMAND FILE, SET UP BUFFERS..
JRST FEND1 ;SOMETHING IS AMISS.
IFN STANSW,< PUSHJ P,TVSKIP ;MAYBE SKIP DIRECTORY AT STANFORD
;> PUSHJ P,INP ;READ INITIAL RECORD
STRT2: MOVE P,[-PLEN,,PDL-1]
SETZM SYMTAB
MOVE 1,[XWD SYMTAB,SYMTAB+1]
BLT 1,HASH-1+SYMTAB
MOVE 1,[XWD OPCDS1,OPCDS]
BLT 1,HASH-1+OPCDS
MOVE 1,[XWD MACRT1,MACRT]
BLT 1,HASH-1+MACRT
ITS,< PUSHJ P,GETSYS > ;GET SYSTEM SYMBOLS
ANDI IOFLGS ;CLEAR ALL BUT I/O FLAGS
FOR A IN (LOCNT#,%BCUR,POLPNT#,SEG#,<RTFLST#>
,SYMEM#,CODEM#,VARLST#,LGARB)
< SETZM A
>
SETOM XPNDSW
SETOM INMCSW#
SETOM TITLSW#
MOVE FS,['.MAIN']
MOVEM FS,BNAM ;SET INITIAL PROGRAM NAME
MOVEM FS,LSTLAB+3
NOITS,<
SKIPGE RPGSW
OUTSTR [ASCIZ /FAIL: /] ;PRINT OUT IF IN RPG MODE.
>;NOITS
MOVE 2,[XWD -ERPLEN,ERPD-1]
MOVEM 2,ERPNT
MOVE 1,PSWIT
ADDI 1,1
LSH 1,7 ;FORM MACRO PDL LENGTH
MOVE M,JOBFF
MOVEI 2,=1024*5(M) ;SEE IF AT LEAST 5K AVAILABLE.
CALLI 2,11 ;GET THE CORE. IF ANYONE NEEDS LESS THAN
PUSHJ P,COERR ;5 K, HE DESERVES OUR CONGRATULATIONS.
ADDM 1,JOBFF
SUBI M,1
MOVNS 1
HRL M,1
HRRZ 2,JOBREL ;GET END OF CORE
MOVEI 3,-1(2)
HRRZ 5,JOBFF ;GET END OF PROGRAM
SUB 3,5 ;FORM LENGTH OF FREE AREA
ASH 3,-1
MOVEM 2,MTBLST# ;SET END OF FREE AREA
MOVE 2,5
ADD 2,3
MOVEM 2,MTBPNT# ;FORM START OF FREE AREA
IDIVI 3,5 ;FORM COUNT
MOVEM 5,FSTPNT# ;START OF FREE STRG
ADDI 5,5 ;INCREMENT TO NEXT
MOVEM 5,-4(5) ;STORE LINK
SOJG 3,.-2 ;LOOP
SETZM -4(5) ;TERMINATE
SETZM LOCNT
SETZM ABSCNT#
MOVEI T,LOCNT
MOVEM T,CURBRK#
MOVEI CP,400000
MOVEM CP,HICNT#
HLLOS BRK#
MOVEI T,1
SETZM PCNT
MOVEM T,PCNT+1 ;INIT LOCATION COUNTERS
SETZM OPCNT
MOVEM T,OPCNT+1
SETZM DPCNT
MOVEM T,DPCNT+1
MOVEI CP,ASSMBL ;GET ADDRESS
MOVEM CP,CPDL ;INITIALIZE THE SPECIAL...
MOVE CP,[XWD CPDL,CPDL+1];USED FOR THE...
BLT CP,CPDL+CPLEN-1;CO-ROUTINE ASSMBL
MOVE CP,[XWD SNB+CPLEN-3,CPDL+CPLEN-2]
SETZB BC,FBLK+1
MOVE FC,[XWD -22,FBLK+2]
PUSHJ P,SBINI ;INITIALIZE SYMBOL OUTPUT.
MOVNI B,BBLK+2
HRRM B,BFX
MOVNI B,FBLK+2
HRRM B,FFX
MOVE B,[POINT 7,TLBLK+1,6]
MOVEM B,LSTPNT
MOVSI B,(<ASCII / />)
MOVEM B,TLBLK+1
MOVE B,[POINT 7,CREFTB,13]
MOVEM B,CREFPT
MOVE B,[LSH N,3]
MOVEM B,SRAD
MOVEI B,LINLEN ;120 CHARS/LINE NORMALLY - JHS
SKIPE CREFSW ;ARE WE CREFFING?
MOVEI B,LINLEN-8 ; YES
MOVEM B,CHRPL
MOVE B,[LITPNT-1,,LITPNT]
BLT B,LITPNT+HASH-1
MOVEI B,1
MOVEM B,BLOCK
MOVE B,[XWD DAF,-1]
MOVEM B,DBLCK
MOVE B,[XWD SNULN,NULN]
BLT B,NULN+5
MOVE B,[XWD -EFSLEN,EFS-1]
MOVEM B,EFSPNT#
SETZM TITCNT+1
MOVE B,[XWD -1,TITCNT+1]
MOVEM B,TITCNT
MOVE B,[XWD -1,SUBCNT+1]
MOVEM B,SUBCNT
MOVE B,[BYTE (7)15,12,15,12]
MOVEM B,SUBCNT+1
SETZM GARBAG
IFN STANSW,<
MOVEI C,OPSET
MOVEI B,OPSEND
PUSHJ P,MACRET ;GIVE OPCODE-GETTER TO FREE STORAGE
>
JRST MAIN
ITS,<
FNMOUT: HRLI 1,440600
MOVEI 2,6
ILDB 3,1
JUMPE 3,.+4
ADDI 3,40
OUTCHR 3
SOJG 2,.-4
POPJ P,
;CALLED AT INITIALIZATION TIME TO GOBBLE
;SYSTEM SYMBOLS INTO SYMBOL TABLE
BEGIN GETSYS
↑GETSYS:MOVE TAC,[RADIX50 0,SYSYMB]
.EVAL TAC,
JRST 4,.
MOVE T,[RADIX50 0,SYSYME]
.EVAL T,
JRST 4,.
ADDI T,1
SUBB T,TAC ;LENGTH OF GETSYS AREA
ASH TAC,-1 ;GUESS AT CORE NEEDED
IMULI TAC,5
ADD TAC,JOBFF ;END OF GETSYS AREA
CAMG TAC,JOBFF
JRST NONEED ;NO EXTRA CORE NEEDED
CALLI TAC,11
JRST 4,.
NONEED: MOVE B,TAC ;BEGINING OF GETSYS AREA
SUB B,T
MOVN C,T
HRL B,C ;AOBJN POINTER TO GETSYS AREA
PUSH P,B
MOVE C,[SIXBIT /CALLS/]
.GETSYS B,
JRST 4,.
POP P,B ;B/ AOBJN POINTER TO GETSYS AREA
MOVE C,JOBFF ;C/ POINTER TO ORIGIN OF FREE STORAGE
GETLOP: CAIL C,(B)
JRST 4,.
MOVE N,(B) ;SQUOZE
PUSHJ P,R50TOX ;CONVERT TO SIXBIT
MOVEM L,(C) ;SAVE SIXBIT
MOVE N,L
IDIVI N,HASH
MOVE N,1(B) ;VALUE
TDNN N,[777000,,0] ;OPCODE OR SYMBOL
JRST [ MOVEI PN,SYMTAB(NA) ;SYMBOL
SETZM 1(C)
HRLOI NA,ANONF!UPARF!DBLUPF
JRST LONG]
MOVEI PN,OPCDS(NA) ;OPCODE
TDNN N,[0,,-1] ;LONG OR SHORT ENTRY
JRST [ MOVEM N,1(C) ;SHORT
MOVEI NA,2 ;ENTRY LENGTH
JRST GETLP1]
MOVSI NA,20 ;MARK AS LONG ENTRY OPCODE
MOVEM NA,1(C)
MOVE NA,[ANONF,,1]
LONG: MOVEM NA,2(C)
MOVEM N,3(C) ;VALUE
SETZM 4(C) ;NO RELOCATION
MOVEI NA,5 ;ENTRY SIZE
GETLP1: MOVE N,(PN) ;POINTER TO CHAIN
HRRM N,1(C) ;NEW ENTRY POINTING TO CHAIN
MOVEM C,(PN) ;POINTER TO CHAIN
ADD C,NA ;UPDATE FREE STORAGE POINTER
ADD B,[1,,1]
AOBJN B,GETLOP ;MORE
MOVEM C,JOBFF
POPJ P,
;RADIX50 TO SIXBIT CONVERSION
; CALLED WITH SQUOZE IN N
; RETURNS SIXBIT IN L
; NA CLOBBERED
R50TOX: TLZ N,740000 ;CLEAR FLAGS FOR SPITE
MOVEI L,0
JUMPE N,CPOPJ ;AVOID INFINITE LOOP
R50TX1: IDIVI N,50
JUMPE NA,R50XF1 ;NULL
CAIG NA,12
JRST [ ADDI NA,'0'-1 ;ITS A DIGIT
JRST R50XF]
CAIG NA,44
JRST [ ADDI NA,'A'-13 ;ITS A LETTER
JRST R50XF]
MOVE NA,.$%-45(NA) ;SPECIAL CHARATCER
R50XF: OR L,NA
ROT L,-6
R50XF1: JUMPN N,R50TX1
TRNE L,77
POPJ P,
LSH L,-6
JRST .-3
.$%: '.'
'$'
'%'
BEND GETSYS
>;ITS
OUT: 0
OUTCHR T
JRST @OUT
SOUT: 0
OUTSTR [ASCIZ /
*/]
JRST @SOUT
IN: 0
SKIPE RPGSW
JRST RPGIN
IN1: ILDB 2,TTYPTR
JUMPN 2,@IN
MOVE 2,[440700,,TTYBUF]
MOVEM 2,TTYPTR
MOVEM 2,SOUT
IN2: INCHWL 2
ANDI 2,177
JUMPE 2,IN2
CAIN 2,15
JRST IN2
IDPB 2,SOUT
CAIE 2,12
JRST IN2
MOVEI 2,
IDPB 2,SOUT
JRST IN1
TTYPTR: 0
TTYBUF: BLOCK 40
;NOFSL: JSR HERE WHEN OUT OF FREE STORAGE
CELCNT: 0
NOFSL: 0
BEGIN NOFSL
PUSH P,O
PUSH P,T ;SAVE
PUSH P,FS ;...
PUSH P,N
PUSH P,NA
MOVEI NA,GARBAG-1
SKIPN T,GARBAG ;GET GARBAGE LIST
JRST NOGAR ;NONE
SETZB FS,CELCNT ;ZERO CELL COUNT
LOOP2: MOVE O,2(T) ;GET START ADDRESS
MOVE N,(T) ;GET COUNT
CAIGE N,5 ;BIG ENOUGH?
JRST NOMO ;NO
LOOP1: MOVEM FS,1(O) ;DEPOSIT POINTER
MOVE FS,O ;FORM NEW ONE
ADDI O,5
SUBI N,5 ;DECREASE COUNT
AOS CELCNT
CAIL N,5 ;ROOM FOR MORE?
JRST LOOP1 ;YES
NOMO: JUMPE N,USET ;USED IT ALL?
MOVEM N,(T) ;NO, DEPOSIT NEW COUNT
MOVEM O,2(T) ;DEPOSIT NEW START
MOVE NA,T
SKIPN T,1(T) ;GET NEXT
JRST NOMGAR ;NO MORE GARBAGE
JRST LOOP2
USET: MOVE O,1(T) ;GET POINTER
MOVEM O,1(NA) ;REMOVE THIS CELL...
MOVEM FS,1(T) ;& PUT IN...
MOVE FS,T ;FREE STRG
AOS CELCNT
SKIPE T,O
JRST LOOP2
NOMGAR: SKIPE T,GARBAG
MOVE T,3(T)
MOVEM T,LGARB
MOVE T,CELCNT
CAIGE T,20 ;WERE AT LEAST 20 CELLS CREATED?
JRST NOTNUF ;NO
LOOP4: MOVE T,NOFSL ;GET ADDRESS
LDB O,[POINT 4,-2(T),12];GET AC FLD
DPB O,[POINT 4,RSET,12];DEPOSIT
POP P,NA
POP P,N ;RESTORE
HRRM FS,RSET ;DEPOSIT FREE STORAGE POINTER
POP P,FS
POP P,T
POP P,O
RSET: MOVEI ;LOAD NEW POINTER
JRST @NOFSL ;RETURN
NOGAR: MOVEI FS,
NOTNUF: MOVE T,JOBREL ;GET END OF CORE
SUB T,MTBPNT ;SUB CURRENT START OF FREE AREA
CAIGE T,300 ;AT LEAST 300 WORDS LEFT?
PUSHJ P,COEXP ;NO, EXPAND CORE
MOVE T,JOBREL ;GET DIF
SUB T,MTBPNT ;...
LSH T,-1 ;DIV BY 2
ADD T,MTBPNT ;USE HALF FOR FREE STRG
MOVE O,MTBPNT ;GET START
LOOP3: MOVEM FS,1(O) ;DEPOSIT POINTER
MOVE FS,O ;GET NEW ONE
ADDI O,5 ;GO TO NEXT
CAMGE O,T ;FAR ENOUGH?
JRST LOOP3 ;NO
MOVEM O,MTBPNT ;YES, DEPOSIT NEW MTBPNT
JRST LOOP4
COEXP: MOVE T,JOBREL ;GET CURRENT END OF CORE
ADDI T,2000 ;EXPAND BY 1K
CALLI T,11 ;EXPAND
JRST COERR ;NO CORE
POPJ P,
↑COERR: OUTSTR [ASCIZ/
NO CORE AVAIL. STRIKE ANY KEY TO TRY AGAIN:/]
PUSHJ P,WAIT
JRST COEXP ;TRY AGAIN ON STRIKING ANY KEY
↑WAIT: CLRBFI
INCHRW T
CAIN T,15
INCHRW T
↑↑CPOPJ:POPJ P,
↑CORINI:MOVEI T,IFE STANSW,<620000;>220000
APRENB T,
MOVEI T,JOBAPR-1
PUSHJ T,CORI2
HRRZS O,T ;TRAP HERE TO SEE HOW MUCH PC CHANGED
SUBI O,@JOBTPC
JRST 2,1(T) ;SKIP TEST INSTR, CLEAR FLAGS (ESP. BIS)
CORI2: JSP T,.+1
SETZM -1 ;GET PC OFFSET FOR WRITE INSTRUCTIONS
MOVEM O,REGOFF#
JSP T,.+1
DPB [,-1] ;GET OFFSET FOR BYTE INSTRUCTIONS
MOVEM O,BYTOFF#
MOVEI T,JOBAPR-1
PUSHJ T,CPOPJ ;SET TO COME HERE ON MPV INTS
↑TSINT: MOVEM FS,SV ;SAVE
MOVEM T,SV+1
MOVE T,JOBCNI↑
TRNE T,200000
JRST PDLOVI
MOVE FS,JOBTPC ;GET PC WORD
TLNE FS,20000 ;TEST BIS FLAG TO SEE IF LOSING INST WAS BYTE INST
SKIPA FS,BYTOFF ;SELECT APPROPRIATE OFFSET
MOVE FS,REGOFF
ADDB FS,JOBTPC ;ADD OFFSET TO PC WORD
ANDI FS,-1 ;GET RID OF FLAGS
MOVSI T,-LEGCNT
LOP1: CAME FS,LEGTAB(T) ;SEE IF LEGAL PC
AOBJN T,LOP1
JUMPL T,MPVOK
OUTSTR [ASCIZ/
ASSEMBLER ERROR OR SYSTEM HACK./]
PUSHJ P,TTYERP
OUTSTR [ASCIZ /TYPE ANY KEY TO PROCEED ANYWAY:/]
PUSHJ P,WAIT
MPVOK: PUSHJ P,COEXP ;EXPAND CORE
MOVE FS,SV
MOVE T,SV+1 ;RESTORE
JRST 2,@JOBTPC ;& RETURN
PDLOVI: MOVEI T,[ASCIZ /UNRECOGNIZABLE/]
JUMPL CP,.+2
MOVEI T,[ASCIZ /COROUTINE/]
JUMPL M,.+2
MOVEI T,[ASCIZ /MACRO/]
JUMPL P,.+3
↑PDLOV: MOVEI T,[ASCIZ /MAIN/]
ANDI P,-1 ;AVOID RECURSIVE PDLOVS
OUTSTR (T)
OUTSTR [ASCIZ / PDL OVERFLOW, CAN'T CONTINUE.
/]
PUSHJ P,TTYERP
JRST 4,.
SV: BLOCK 2
BEND
SUBTTL CHARACTER TABLE (FOR SCANNER)
CTAB: 0
XWD SPCLF,UDARF!TP1F ;↓
(SPCLF)
(SPCLF)
XWD SPCLF!ARFL!ARMD,6 ;∧
XWD SPCLF!ARFL!UNOF,12 ;¬
XWD SPCLF,EPSF ;ε
FOR I←7,10
<(SPCLF)
>
XWD SCRF!SPFL!SPCLF,5 ;TAB
XWD SPCLF!LNFD!SCRF,1 ;LINE FEED
(SPCLF)
SPCLF!SCRF!LNFD,,7 ;FF LOOKS SORT OF LIKE LF
XWD SPCLF!CRFG,6 ;CR RET (6 IS FOR LOUT)
FOR I←16,17
<(SPCLF)
>
XWD SPCLF,INF ;⊂
FOR I←21,25
<(SPCLF)
>
XWD SPCLF!ARFL,4 ;⊗
XWD SPCLF!LNFD!CRFG,2 ;BOTH WAYS ARROW (↑W) LINE FEED AND CR RET
SNB!.FL!ENMF,,'.' ;_ (MAKE IT LOOK LIKE . IN SYMS)
XWD SPCLF,BSLF ;→(\)
XWD SPCLF,UDARF!TP2F ;↑
XWD SPCLF!ARFL!ARMD1,6 ;(NOT EQLS)(XOR)
(SPCLF)
XWD SPCLF!ARFL!ARMD1,6 ;CTRL ] TEMP USE AS XOR *** ≥≥≥
(SPCLF)
XWD SPCLF!ARFL,6 ;∨
XWD SCRF!SPCLF!SPFL,5 ;SPACE
XWD SPCLF!ARFL,6 ;!
XWD SPCLF!SCRF!ENMF,2 ;"
XWD SPCLF,SHRPF ;#
XWD SNB!ENMF,'$' ;$
XWD SNB!ENMF,'%' ;%
XWD SPCLF!ARFL!ARMD,6 ;&
XWD SPCLF!SCRF!ENMF,3 ;'
XWD SPCLF,LFPF ;(
XWD SPCLF,RTPF ;)
XWD SPCLF!ARFL,10 ;*
XWD SPCLF!ARFL,12 ;+
XWD SPCLF,COMF ;,
XWD SPCLF!ARFL!ARMD!UNOF,12 ;-
XWD SNB!.FL!ENMF,'.' ;.
XWD ARFL!SPCLF!ARMD,10 ;/
FOR I←20,31
<XWD SNB!NMFLG!ENMF,I
>
XWD SPCLF,LACF!TP2F ;:
XWD SPCLF!CRFG,2 ;;
XWD SPCLF!SCRF!ENMF!LBRF,10 ;WILL BE XWD SPCLF!ENMF!LBRF,LBCF!TP2F;<
XWD SPCLF!SCRF!ENMF,4 ;=
XWD SPCLF!SCRF!RBRF,11 ;WILL BE XWD SPCLF!RBRF,TP2F!RBCF;>
XWD SPCLF,UDARF!TP1F ;?
XWD SPCLF,ATF ;@
XWD SNB!ENMF,'A' ;A
XWD SNB!ENMF!BFL,'B' ;B
XWD SNB!ENMF,'C' ;C
XWD SNB!ENMF,'D' ;D
XWD SNB!ENMF!EFL,'E' ;E
FOR I←'F','Z'
<XWD SNB!ENMF,I
>
XWD SPCLF!ENMF!LBRF,TP1F;[
XWD SPCLF,BSLF ;\
XWD SPCLF!RBRF,TP1F ;]
XWD SPCLF,UDARF!TP2F ;↑
XWD SPCLF,LACF!TP1F ;←
XWD SPCLF,ATF ;@(140)
XWD SNB!ENMF,'A' ;A
XWD SNB!ENMF!BFL,'B' ;B
XWD SNB!ENMF,'C' ;C
XWD SNB!ENMF,'D' ;D
XWD SNB!ENMF!EFL,'E' ;E
FOR I←'F','Z'
<XWD SNB!ENMF,I
>
XWD SPCLF!SCRF,10 ;WILL BE XWD SPCLF,LBCF!TP2F;{
(SPCLF)
XWD SPCLF!SCRF,11 ;WILL BE XWD SPCLF,RBCF!TP2F;}
XWD SPCLF!SCRF,11 ;AS ABOVE
XWD SPCLF!SCRF!DLETF,0 ;DELETE
0
COMBTS←←SCRF!SPCLF!ENMF!LBRF!RBRF!DLETF!LNFD ;OR OF BITS FOR LF DEL <>{}
BEGIN SCAN ↔ SUBTTL SCANNER AND FRIENDS
;RETURNS WITH NEXT THING
;IF AN IDENTIFIER -- SIXBIT IN L
;IF A NUMBER -- VALUE IN N AND NA
;IF A SPC. CHR. -- BITS FOR CHR IN N
;IN ALL CASES, THE NEXT NON-BLANK CHR. AFTER THE
; THING RETURNED IS IN C AND ITS BITS ARE IN B.
↑SCAN: MOVEI L,1 ;PREPARE TO TEST FOR LINE NUM
TLZE SFL ;SHOULD WE RETURN CURRENT THING?
JRST AHEDW ;YES
LOOP3: ILDB C,INPNT ;GET CHR.
LOOP3A: IDPB C,LSTPNT ;DEPOSIT FOR LISTING
↑AHED: TDNE L,@INPNT ;LINE NUM?
JRST LNUM ;YES
SKIPL B,CTAB(C) ;GET BITS, IS IT NUM OR LET?
AHEDW: JUMPGE B,SPCRET ;NO
TLNE B,NMFLG ;NUM?
JRST NUMS ;YES
HRRZ L,B ;IT'S A LETTER, PUT IN L
REPEAT 5,< ILDB C,INPNT ;GET NEXT
IDPB C,LSTPNT ;DEPOSIT FOR LIST
SKIPL B,CTAB(C) ;GET BITS
JSR NOLT ;NOT LET OR NUM
LSH L,6
ORI L,(B) ;OR IN SIXBIT>
LOOP1: ILDB C,INPNT ;GET NEXT CHR.
IDPB C,LSTPNT ;DEPOSIT FOR LIST
SKIPL B,CTAB(C) ;GET BITS, LET OR NUM?
JSR NOLT ;NO
JRST LOOP1 ;YES,SKIP
NOLT: 0
JUMPE B,[JSP B,NULSKP
ILDB C,INPNT
IDPB C,LSTPNT
SKIPL B,CTAB(C)
JRST NOLT+1
JRST @NOLT]
TLNE B,SCRF ;SPC HANDLING?
XCT NOLB(B);YES
TLO SFL!IFLG ;SET 'SCAN AHEAD' AND 'IDENT'
TLZ NFLG!SCFL!FLTFL;CLEAR NUM & SPC.CHR.
POPJ P,
NUMS: MOVEI N,-20(B) ;PUT VALUE IN N
SKIPA NA,FLTB-20(B);FLOAT
LOOP2A: JSP B,NULSKP
LOOP2: ILDB C,INPNT ;GET NEXT CHR.
IDPB C,LSTPNT
SKIPL B,CTAB(C) ;GET BITS
JRST NONM ;NOT NUM
NLOP: TLNN B,NMFLG ;NUM?
JRST NLET ;NO, LET
↑SRAD: LSH N,3 ;MULT BY RADIX
ADDI N,-20(B) ;ADD IN THIS DIGIT
FMPR NA,[10.0] ;MULT FLOATING BY 10
FADR NA,FLTB-20(B);ADD IN THIS DIGIT
JRST LOOP2
FLTB: DEC 0,1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0
↑SPCSKP:0
PUSH P,L
MOVEI L,1
SPCCN1: ILDB C,INPNT ;GET NEXT
SPCCN2: IDPB C,LSTPNT ;DEPOSIT
XCT AHED
JRST [JSR SLNUM
JRST SPCCN1]
SKIPGE B,CTAB(C) ;GET BITS
JRST SPCKRT ;NNUM OR LET
SPCCON: JUMPE B,SPCNUL
TLNE B,SCRF ;SPC. HAND?
XCT SPKT(B) ;YES
SPCKRT: POP P,L
JRST @SPCSKP
NONM: JUMPE B,LOOP2A ;NULL TYPE CHR?
NONM1: TLNE B,SCRF ;SPC HAND?
XCT NOTB(B) ;YES
MOVEI NA,
TLO SFL!NFLG ;SET 'AHEAD' AND NUM
TLZ SCFL!IFLG!FLTFL;CLEAR SPC,CHR & IDENT
POPJ P,
SPCRET: JUMPE B,LOOP3Q ;IGNORE CHR?
TLNE B,SCRF ;DOES THIS CHR REQUIRE SPEC. ATT. BY SCAN?
XCT SPCTB(B) ;YES, HANDLE
SPCRT2: TLZ IFLG!NFLG!FLTFL;CLEAR IDENT ,NUM
TLO SCFL!SFL ;SET SPC CHR,AHEAD
MOVE N,B ;PUT BITS IN N
JSR SPCSKP ;SKIP TO NEXT NON-BLANK CHR.
POPJ P,
SPCNUL: JSP B,NULSKP
JRST SPCCN1
JRST SPCCN2
LOOP3Q: JSP B,NULSKP
JRST LOOP3
JRST LOOP3A
NULSKP: JUMPN C,(B) ;IF NOT A NULL
SKIPE @INPNT ;ZERO WORD?
JRST LOOP3Z ;NO
MOVSI TAC,700 ;SKIP REST OF WORD
HRR TAC,INPNT ;AND PREPARE TO SKIP MORE
SKIPN 1(TAC)
AOJA TAC,.-1
MOVEM TAC,INPNT
LOOP3Z: ILDB C,INPNT ;NO, A NULL, GET NEXT
JRST 2,@[20000,,1(B)] ;SET BIS & GO TO IDPB FOR LISTING
DEFINE EMPS (A)
< PUSHJ P,LBROK
JRST A>
BSPCTB: PUSHJ P,RTBFND
JRST SPCRET
JRST LOOP3
LBROK: HRRI B,LBCF!TP2F
TLZ B,SCRF
AOS BROKCT
POPJ P,
SPCTB: JRST DELT ;DELETE -- HANDLE
PUSHJ P,LSTLF ;HANDLE LINE FEED
JRST DQT ;HANDLE DOUBLE QUOTE
JRST SQT ;HANDLE SINGLE QUOTE
JRST EQLS ;HANDLE =
JRST LOOP3 ;SKIP SPACES
JFCL
PUSHJ P,NEWPAG
EMPS BSPCTB
↑BROKCT:0
↑RTBFND:HRRI B,TP2F!RBCF
TLZ B,SCRF
SKIPN RTFLST ;ANY TO CHECK?
POPJ P, ;NO
PUSH P,N ;SAVE
MOVE N,BROKCT ;GET CURRENT COUNT
CAMN N,@RTFLST ;SAME?
JRST RFNDQ ;YES
SOS BROKCT ;NO, DECREMENT COUNT AND RETURN
POP P,N
POPJ P,
RFNDQ: PUSH P,L
MOVE L,RTFLST ;GET POINTER
MOVE N,FSTPNT ;PUT THIS ONE...
EXCH N,1(L) ;BACK ON FREE STRG.
MOVEM L,FSTPNT ;...
MOVEM N,RTFLST ;...
SOS BROKCT ;DECREMENT COUNT
POP P,L
POP P,N
AOS (P) ;SET FOR SKIP REUTRN
POPJ P,
NLET: TLNE B,.FL ;.?
JRST DOT
TLNE B,BFL ;B?
JRST BSH
TLNE B,EFL ;E?
JRST EXP
ERROR [ASCIZ/LETTER FOLLOWS NUM -- SYNTAX/]
JRST NONM
LNUM: JSR SLNUM
JRST LOOP3
↑SLNUM: 0
CAIGE C,60
JRST POPMK ;YES
LNMC: MOVE C,@INPNT
MOVEM C,TLBLK
MOVEM C,SVLNUM
AOS INPNT ;SKIP LINE NUM WD
SKIPL @INPNT ;SEE IF WE RAN OFF BUFFER (RUBOUT WD WILL BE NEG)
JRST .+3
PUSHJ P,INP ;YES - READ ANOTHER
IBP INPNT ;AND SKIP TAB
MOVEI C,0
DPB C,LSTPNT
JRST @SLNUM
QURN: PUSH P,B
PUSHJ P,INP
POP P,B
ILDB C,INPNT
POPJ P,
POPMK: MOVE C,[ASCID/ /]
CAME C,@INPNT ;PAGE MARK?
JRST LNMC ;NO
AOS INPNT ;SKIP FIRST PAGE MARK WD
SKIPGE @INPNT
PUSHJ P,INP ;READ ANOTHER BUFFER IF NEEDED
AOS INPNT ;SKIP SECOND PAGE MARK WD
MOVSI C,440700
HLLM C,INPNT
TRNE LDEV ;MAKE SURE THERE IS A LIST DEV
SKIPN XPNDSW ;AND THE WE HAVE NOT SAID XLIST
TDZA C,C
MOVEI C,14 ;IN THAT CASE WE WILL MAKE A PAGE HEADING
DPB C,LSTPNT ;NULL OUT THAT SPACE
PUSH P,SLNUM ;PREPARE TO RETURN
↑NEWPAG:SKIPL AHED ;DON'T UPDATE THESE CELLS IF TEXT IS FROM MACRO
JRST LSTFRC
SETZM INLINE
AOS PGNM
SETZM SPGNM
JRST LSTFRC
DELT: DPB B,LSTPNT ;PUT ZERO(NULL)OVER DELETE IN LISTING
ILDB C,INPNT ;GET NEXT CHR.
XCT DELTAB(C) ;HANDLE
ILDB C,INPNT
DPB C,LSTPNT
JRST AHED
DEFINE DHAN!(A)
<DPB B,LSTPNT;PUT ZERO OVER DELETE
ILDB C,INPNT ;GET NEXT
XCT DELTAB(C);HANDLE
ILDB C,INPNT;GET NEXT
DPB C,LSTPNT;DEPOSIT FOR LIST
A!SKIPL B,CTAB(C)
>
NOLD: DHAN
JRST NOLT+1
JRST @NOLT
NOND: DHAN
JRST NONM
JRST NLOP
↑DELTAB:PUSHJ P,INP ;GET NEXT BUFFER
PUSHJ P,GETARG ;GO TO MACRO ARGUMENT
POP M,INPNT ;LEAVE ARGUMENT
PUSHJ P,LVMAC ;LEAVE MACRO
PUSHJ P,LVREP ;LEAVE REPEAT
PUSHJ P,LVFORL ;LEAVE NUMERIC FOR
PUSHJ P,LVFORI ;LEAVE "IN" FOR
PUSHJ P,EFORSH ;LEAVE "E" FOR
0
DEFINE QUOT 7 (M)
< MOVEI L,1
SETZB N,NA
QP7M: ILDB C,INPNT
QQ7M: IDPB C,LSTPNT
QT7M: XCT AHED
JRST [JSR SLNUM
JRST QP7M]
JUMPE C,QN7M
MOVE B,CTAB(C)
TLNE B,SCRF
XCT SCQT7M(B)
QU7M: IFE M,<TRZN C,100
TRZA C,40
TRO C,40>
LSH N,6+M
OR N,C
JRST QP7M
BSCQT7M:PUSHJ P,RTBFND
JRST QU7M
JRST QP7M
QN7M: JSP B,NULSKP
JRST QP7M
JRST QQ7M
>
SCQT1: JRST DH1
PUSHJ P,LSTLF
JRST SCR1
JFCL
JFCL
JFCL
JFCL
PUSHJ P,NEWPAG
EMPS BSCQT1
SCQT0: JRST DH0
PUSHJ P,LSTLF
JFCL
JRST SCR0
JFCL
JFCL
JFCL
PUSHJ P,NEWPAG
EMPS BSCQT0
DQT: QUOT(1)
DEFINE QUOTS = (A)
<SCR=A: JSR SPCSKP
TLO SFL!NFLG
TLZ SCFL!IFLG
POPJ P,
DH=A: DPB B,LSTPNT
ILDB C,INPNT
XCT DELTAB(C)
ILDB C,INPNT
DPB C,LSTPNT
JRST QT=A
>
QUOTS (1)
SQT: QUOT(0)
QUOTS(0)
EQLS: PUSH P,SRAD ;SAVE CURRENT RADIX
MOVE N,[IMULI N,12];SET TO 10...
MOVEM N,SRAD ;...
PUSHJ P,SCAN ;SCAN NUMBER
POP P,SRAD ;RESTORE RADIZ
POPJ P,
DOT: MOVE N,NA ;GET FLOATING NUM SO FAR
SKIPA NA,[10.0];GET 10
LOOP5A: JSP B,NULSKP
LOOP5: ILDB C,INPNT ;GET NEXT
IDPB C,LSTPNT ;DEPOSIT
SKIPL B,CTAB(C) ;GET BITS
JRST DNONM ;NOT NUM
DNLOP: TLNN B,NMFLG ;NUM?
JRST DNLET ;NO,LETTER
MOVE B,FLTB-20(B);FLOAT
FDVR B,NA ;SCALE
FADR N,B ;ADD IN
FMPR NA,[10.0] ;SCALE THE SCALE
JRST LOOP5
DNLET: TLNE B,EFL ;E?
JRST EXP1 ;YES
ERROR [ASCIZ/LETTER FOLLOWS NUM -- SYNTAX/]
JRST DNONM1
EXP: MOVE N,NA ;GET FLOATING VERSION
EXP1: PUSHJ P,SCAN1 ;GET NEXT CHR.
MOVEI NA,EXT1
HRRM NA,EXTP
TLNN B,UNOF ;- OR ¬(TREAT BOTH THE SAME)?
JRST PT5 ;NO
MOVEI NA,EXT2 ;YES, HANDLE...
HRRM NA,EXTP ;...
PUSHJ P,SCAN1 ;GET NEXT
PT5: TLNN B,NMFLG ;NUM?
ERROR[ASCIZ/NO NUM AFTER E/]
MOVEI NA,-20(B) ;GET VALUE
PUSHJ P,SCAN1 ;GET NEXT
TLNN B,NMFLG ;NUM?
JRST PT6 ;NO
ADDI NA,12 ;SECOND HALF OF TABLE
FMPR N,@EXTP ;SCALE
MOVEI NA,-20(B) ;GET VALUE
PUSHJ P,SCAN1 ;GET NEXT
PT6: FMPR N,@EXTP ;SCALE
TLNE B,NMFLG
ERROR[ASCIZ/TOO MANY NUMS AFTER E/]
JRST DNONM1
EXTP: XWD NA,EXT1
EXT1: 1.0
10.0
100.0
1000.0
10000.0
100000.0
1000000.0
10000000.0
100000000.0
1000000000.0
1.0
1.0E10
1.0E20
1.0E30
1.0E40
1.0E50
1.0E60
1.0E70
1.0E80
1.0E90
EXT2: 1.0
0.1
0.01
0.001
0.0001
0.00001
0.000001
0.0000001
0.00000001
0.000000001
1.0
1.0E-10
1.0E-20
1.0E-30
1.0E-40
1.0E-50
1.0E-60
1.0E-70
1.0E-80
1.0E-90
DNONM: JUMPE B,LOOP5A ;NULL TYPE?
DNONM1: TLNE B,SCRF ;SPECIAL AHNDLE?
XCT DNOTB(B) ;YES, HANDLE
MOVSI NA,FLTFL ;SET AS FLOATING
TLO SFL!NFLG!FLTFL;SET NUM&FLOATING & AHEAD
TLZ IFLG!SCFL ;CLEAR SPC CHR. & IDENT
POPJ P,
DNOTB: JRST DNDH ;DELETE
PUSHJ P,LSTLF ;LF
JFCL
JFCL
JFCL
JSR SPCSKP
JFCL
PUSHJ P,NEWPAG
EMPS BDNOTB
BDNOTB: PUSHJ P,RTBFND
JRST DNONM1
JRST LOOP5
DNDH: DHAN
JRST DNONM
JRST DNLOP
NOTB: JRST NOND
PUSHJ P,LSTLF
JFCL
JFCL
JFCL
JSR SPCSKP
JFCL
PUSHJ P,NEWPAG
EMPS BNOTB
BNOTB: PUSHJ P,RTBFND
JRST NONM
JRST LOOP2
NOLB: JRST NOLD
PUSHJ P,LSTLF
JFCL
JFCL
MOVE B,CTAB+"←" ;MAKE = LOOK LIKE ← AFTER SYMS
JSR SPCSKP
JFCL
PUSHJ P,NEWPAG
EMPS BNOLB
BNOLB: PUSHJ P,RTBFND
JRST NOLT+1
ILDB C,INPNT
IDPB C,LSTPNT
SKIPL B,CTAB(C)
JRST NOLT+1
JRST @NOLT
SPKT: JRST SPCDEL
JFCL
JFCL
JFCL
JFCL
JRST SPCCN1
JFCL
JFCL
EMPS BSPKT
BSPKT: PUSHJ P,RTBFND
JRST SPCKRT
JRST SPCCN1
SPCDEL: DHAN
JRST SPCCON
JRST SPCKRT
BSH: PUSHJ P,SCAN1 ;GET NUM
TLNN B,NMFLG ;NUM?
ERROR[ASCIZ/NO NUM AFTER B/]
MOVNI NA,-20(B) ;GET VALUE
PUSHJ P,SCAN1 ;GET NEXT
TLNN B,NMFLG ;NUM?
JRST BPT ;NO
IMULI NA,12 ;CONVERT TO ...
SUBI NA,-20(B) ;DECIMAL
PUSHJ P,SCAN1 ;GET NEXT
BPT: LSH N,=35(NA) ;DO SHIFT
JRST NONM1
LVMAC: POP M,C ;GET OLD MTBPNT
JUMPE C,LVNO ;NO ARGS?
POP M,B ;GET OLD NEW MTBPNT
PUSHJ P,MACRET
SKIPA
LVNO: SUB M,[1(1)]
POP M,INPNT ;SET SCAN POINTER BACK
POP M,C ;RESTORE CHR. SIZE FOR
DPB C,[POINT 6,LSTPNT,11];LISTING
HRRZM C,XPNDSW
HLRZM C,INMCSW
POP M,C
MOVEM C,AHED
MOVEM C,LOOP6
SKIPE UNDLNS ;UNDERLINING?
SKIPE NOEXP ;NO EXPAND?
JRST ARNMC ;NO
SKIPN INMCSW ;IN A MACRO?
JRST ARNMC ;YES
HRR C,LSTPNT
ADDI C,TLBLK-MBLK;GO BACK TO NORMAL POINTER
HRRM C,LSTPNT
ARNMC: POP M,C ;GET CHR.
AOS (P) ;SKIP NEXT ILDB
POPJ P,
GETARG: ILDB C,INPNT ;GET ARG #
ADD C,(M) ;GET POINTER
PUSH M,INPNT ;SAVE OLD PNTR.
MOVE C,(C)
MOVEM C,INPNT
POPJ P,
SUBTTL SCAN1,SCNTIL, SCANM
LVREP: SOSG -1(M) ;DECREMENT COUNT
JRST LRDON ;DONE
MOVE C,(M) ;GET...
HRLI C,440700 ;POINTER
MOVEM C,INPNT
POPJ P,
LRDON: POP M,C ;GET POINTER
SUB M,[1(1)]
POP M,B ;GET OLD NEW MTBPNT
PUSHJ P,MACRET
ALDON: PUSHJ P,LSTCHK ;A GOOD PLACE TO CATCH LOSSAGE FROM MOBY LINES
POP M,INPNT ;RESTORE SCAN POINTER
POP M,C ;RESTORE...
DPB C,[POINT 6,LSTPNT,11];LISTING
HRRZM C,XPNDSW
HLRZM C,INMCSW
POP M,C
MOVEM C,AHED ;RESTORE LINE NUM SKIPPING
MOVEM C,LOOP6
SKIPE UNDLNS ;UNDERLINING?
SKIPE NOEXP ;NO EXPAND?
POPJ P,
SKIPN INMCSW ;IN A MACRO?
POPJ P,
HRR C,LSTPNT
ADDI C,TLBLK-MBLK
HRRM C,LSTPNT
POPJ P,
NTST: CAMGE B,-3(M) ;DONE?
JRST LFDON ;YES
JRST NLFD ;NO
LVFORL: MOVE B,-4(M) ;GET INCREMENT
ADDB B,-2(M) ;ADD NUM
SKIPG -4(M) ;NEG INCREMENT?
JRST NTST ;YES
CAMLE B,-3(M) ;DONE?
JRST LFDON ;YES
NLFD: MOVE C,(M) ;GET ARG POINTER
ADD C,[XWD 440700,2]
PUSHJ P,BKSLSH ;CON TO ASCII
EDEPO (B,C,2) ;DEPOSIT END OF ARG
MOVE B,-1(M) ;GET START
ADD B,[XWD 440700,2]
MOVEM B,INPNT
JRST LSTCHK
LFDON: HRRZ C,-1(M) ;GET START OF THROW-AWAY
SUB M,[5(5)]
POP M,B ;GET OLD NEW MTBPNT
PUSHJ P,MACRET
JRST ALDON
LVFORI: MOVE B,(M) ;GET ARG POINTER
MOVE B,1(B) ;GET POINTER
ILDB C,B ;GET FIRST CHR. OF SECOND ARG
CAIE C,177 ;IS IT DELETE?
JRST IFORSH ;NO, GET NEXT ARG SETUP
SUB M,[2(2)] ;YES, NO MORE ITERATIONS
POP M,C ;GET START OF THROW-AWAY
POP M,B ;GET OLD NEW MTBPNT
PUSHJ P,MACRET
JRST ALDON
↑SCAN1: TLZE SFL ;AHEAD?
JRST S1PT ;YES
↑SCAN1A:MOVEI L,1 ;PREPARE TO TEST FOR LINE NUM
LOOP4: ILDB C,INPNT ;GET CHR.
LOOP4A: IDPB C,LSTPNT ;DEPOSIT FOR LISTING
↑LOOP6: TDNE L,@INPNT ;LINE NUM?
JRST [JSR SLNUM
JRST LOOP4]
SKIPN B,CTAB(C) ;GET BITS, NULL CHR?
JRST LOOP4Q ;YES, NULL CHR.
S1PT: TLNE B,SCRF ;SPECIAL HANDLING?
XCT SC1T(B) ;YES, AHNDLE
POPJ P,
LOOP4Q: JSP B,NULSKP
JRST LOOP4
JRST LOOP4A
SC1T: JRST SC1DH
PUSHJ P,LSTLF
JFCL
JFCL
JFCL
JFCL
JFCL
PUSHJ P,NEWPAG
EMPS BSC1T
BSC1T: PUSHJ P,RTBFND
POPJ P,
JRST LOOP4
SC1DH: DPB B,LSTPNT
ILDB C,INPNT
XCT DELTAB(C)
ILDB C,INPNT
DPB C,LSTPNT
JRST LOOP6
↑SCNTIL:TLZE SFL ;AHEAD?
JRST LOPP3 ;YES
LOPP1: ILDB C,INPNT ;GET CHR.
LOPP1A: IDPB C,LSTPNT ;DEPOSIT
LOPP2: SKIPN B,CTAB(C) ;GET BITS
JRST LOPP1Q ;NULL CHR
LOPP3: TLNE B,SCRF ;SPECIAL?
XCT STTB(B) ;YES
MOVSI B,¬COMBTS ;WATCH US SKIP COMMENTS FAST
MOVE TAC,INPNT
LOP69:REPEAT 5,<
ILDB C,TAC
IDPB C,LSTPNT
TDNN B,CTAB(C)
JRST LOP105 >
JRST LOP69
LOP105: MOVEM TAC,INPNT
JRST LOPP2
LOPP1Q: JSP B,NULSKP
JRST LOPP1
JRST LOPP1A
STTB: JRST STDH ;DELETE
JRST LSTLF ;LINE FEED, FORCE LISTING AND RETURN
JFCL
JFCL
JFCL
JFCL
JFCL
JRST NEWPAG ;FORM FEED, ADVANCE PAGE AND RETURN
EMPS BSTTB
BSTTB: PUSHJ P,RTBFND
JRST LOPP1
JRST LOPP1
STDH: DPB B,LSTPNT ;CLEAR THE DELETE
ILDB C,INPNT ;GET CHR.
XCT DELTAB(C) ;HANDLE
ILDB C,INPNT ;GET NEXT CHR.
DPB C,LSTPNT
JRST LOPP2
↑SLURP: PUSH P,BROKCT ;ROUTINE TO EAT TEXT UP TO MATCHING BROKET
SETZM BROKCT
JSP TAC,SLRP0
SOSL BROKCT
JRST SLRP1
POP P,TAC
ADDM TAC,BROKCT
POPJ P,
↑SLURPC:MOVE TAC,CTAB(C) ;EATS TEXT UP TO MATCHING CHAR
TLNN TAC,¬COMBTS
TLNN TAC,SCRF
JRST .+3
ERROR [ASCIZ /ILLEGAL DELIMETER/]
POPJ P,
PUSH P,TAC
HRLOI TAC,SCRF
MOVEM TAC,CTAB(C)
TLZ SFL
JSP TAC,SLRP0
PUSHJ P,RTBFND
JRST SLRP1
JRST SLRP1
SLRP0: HRRM TAC,SRBINS
TLZE SFL
JRST SLRP2
SLRP1: ILDB C,INPNT
SLRP1A: IDPB C,LSTPNT
SLRP2: SKIPN B,CTAB(C)
JRST SLRPN
SLRP3: TLNE B,SCRF
XCT SLTB(B)
MOVSI B,¬COMBTS ;PREPARE TO IGNORE ALMOST EVERYTHING
MOVE TAC,INPNT
SLRP4: REPEAT 5,<
ILDB C,TAC
IDPB C,LSTPNT
TDNN B,CTAB(C)
JRST SLRP5
>
JRST SLRP4
SLRP5: MOVEM TAC,INPNT
JRST SLRP2
JRST SLRPX
SLTB: JRST SLDH
PUSHJ P,LSTLF
REPEAT 7-2,<JFCL>
PUSHJ P,NEWPAG
AOS BROKCT
SRBINS: JRST
SLRPN: JSP B,NULSKP
JRST SLRP1
JRST SLRP1A
SLDH: DHAN <;>
JRST SLRP2
SLRPX: POP P,B
MOVEM B,CTAB(C)
POPJ P,
;SCANM GO HERE FOR SCAN IF MACROS ARE TO BE EXPANDED
↑SCANM: PUSHJ P,SCAN
TLNN IFLG ;IDENTIFIER?
POPJ P, ;NO
MOVE N,L ;GET SIXBIT
IDIVI N,HASH ;HASH
MOVMS NA
SKIPN TAC,MACRT(NA);GET START OF CHAIN
POPJ P,
SRC1(L,TAC,SCNMF,<POPJ P,>)
SCNMF: MOVEI NA,(TAC)
SKIPN N,3(NA) ;ANY ARGS?
JRST NOAG ;NO
JUMPL N,SCNMPO ;MACRO "PSEUDO OP"?('PSEUDO MACRO')
; PUSH P,B
PUSH P,NA ;SAVE POINTER
PUSH P,MTBPNT ;SAVE ARG POINTER
PUSHJ P,ARGIN ;GET ARGS
JUMPN C,.+2
IBP LSTPNT
POP P,N ;GET POINTER
HRRZM NA,MTBPNT ;DEPOSIT NEW ONE
POP P,NA ;GET POINTER
; POP P,B
NOAG: SKIPE XCRFSW
JRST [CAIN NA,%IOWD
CREF7 5,(NA)
CAIE NA,%IOWD
CREF6 5,(NA)
JRST .+1]
PUSH M,C ;SAVE CHR.
; TRNE B,LBCF!RBCF ;DID WE FUCK UP BROKCT?
; JRST [ TRNE B,LBCF
; SOSA BROKCT
; AOS BROKCT
; JRST .+1]
PUSH M,AHED ;SAVE STATE OF LINE NUMBER LOOKING FOR
LDB C,[POINT 6,LSTPNT,11];SAVE STATE...
HRL C,INMCSW ;IN MACRO &...
PUSH M,C ;OF LISTING
PUSH M,INPNT ;SAVE SCAN POINTER
PUSH M,MTBPNT
PUSH M,N ;DEPOSIT ARG POINTER
TLZ SFL ;CLEAR "SCAN AHEAD"
IFN STANSW,< MOVEI N,"⊃";>MOVEI N,"↑"
DPB N,LSTPNT ;ERASE LAST CHR IN LISTING
MOVEI N,
SKIPE NOEXP ;NO MACRO EXPAND?
DPB N,[POINT 6,LSTPNT,11];YES,DISCONTINUE LISTING
SKIPE NOEXP
SETZM XPNDSW
SETZM INMCSW
MOVE N,4(NA) ;GET TEXT POINTER
HRLI N,700 ;MAKE INTO BYTE POINTER
MOVEM N,INPNT ;DEPOSIT
MOVSI N,(<SKIPA>)
MOVEM N,AHED ;AVOID SKIPING...
MOVEM N,LOOP6 ;LINE NUMBERS
SKIPN NOEXP ;NO EXPAND?
SKIPN UNDLNS ;UNDERLINE?
JRST SCANM ;NO
HRRZ N,LSTPNT ;GET LIST. POINTER
CAIL N,TLBLK ;ALREADY CHANGED?
SUBI N,TLBLK-MBLK;NO,CHANGE IT
HRRM N,LSTPNT
TRO MACUNF ;SET BIT
JRST SCANM
SCNMPO: TLNE N,1
SKIPN XCRFSW
JRST @4(NA)
CREF7 5,(NA)
JRST @4(NA)
↑SCNMPT:TLZ IFLG
POPJ P,
↑Q%IF: DPB N,[POINT 3,Q%T,8];DEPOSIT TEST
MOVEI N,1(P)
BLT N,4(P) ;SAVE AC'S
ADD P,[4(4)]
TDO [XWD OPFLG,NOFXF]
PUSHJ P,MEVAL ;GET VALUE
TLNN UNDF!ESPF
TRNE NA,17 ;CHECK FOR DEFINED
PUSHJ P,IFER
MOVSI NA,-3(P)
BLT NA,3 ;RESTORE AC'S
SUB P,[4(4)]
Q%T: SKIP N
SKIPA N,[0]
MOVEI N,1
SETZM REPSW ;DO NOT INSERT CR LF AT END
PUSHJ P,REP ;DO THE REPEAT
JRST SCANM
IFER: ERROR [ASCIZ /UNDEFINED IF ARGUMENT-TAKEN AS 0/]
MOVEI N,0
POPJ P,
↑Q%IFD: HRREM N,Q%SV ;SAVE "VALUE"
JSR LGET ;GET THE {
MOVE NA,MTBPNT ;MAKE POINTER
HRLI NA,440700 ;...
PUSHJ P,SARGIN ;READ IN FIRST ARG.
MOVEI N,
REPEAT 5,<LEG IDPB N,NA>
HRRZ N,NA
HRLI NA,440700 ;MAKE POINTER
JSR LGET ;GET THE {
PUSHJ P,SARGIN ;READ IN SECOND ARG
MOVEI TAC,
REPEAT 5,<LEG IDPB TAC,NA>
HRRZS NA
SUB NA,N
ADD NA,MTBPNT
CAME NA,N ;SAME LENGTH?
JRST NOSAML ;NO
MOVE NA,MTBPNT ;GET POINTER
MOVE PN,N ;SAVE END
Q%LOP: MOVE TAC,(N) ;GET WORD
TRZ TAC,1
EXCH TAC,(NA) ;GET OTHER WORD
TRZ TAC,1
CAME TAC,(NA) ;SAME?
JRST NOSAML ;NO
ADDI N,1
ADDI NA,1
CAMGE NA,PN ;DONE?
JRST Q%LOP ;NO
SETCMM Q%SV ;SAME, COMPLEMENT
NOSAML: AOS N,Q%SV ;GET VALUE
SETZM REPSW ;NO CR LF AT END
PUSHJ P,REP ;DO IT
JRST SCANM
↑REPSW: 0
Q%SV: 0
↑QIF%D: HRREM N,Q%SV ;SAVE VALUE
PUSHJ P,SCAN ;GET SYMBOL
TLNN IFLG ;IDENT?
JRST QERR ;NO
MOVE NA,L ;GET SIXBIT
IDIVI NA,HASH ;HASH
MOVMS PN
SKIPN PN,SYMTAB(PN);GET START OF CHAIN
JRST QICOM ;NONE
SRC1(L,PN,DFND,JRST QICOM)
DFND: MOVE N,2(PN) ;GET FLAGS
TDNN N,BLOCK ;THHS BLOCK?
JRST QICOM ;NO
TLNE N,DEFFL ;DEFINED?
JRST QICOM ;NO
TR: SETCMM Q%SV ;YES
FLS: AOS N,Q%SV ;GET VALUE
SETZM REPSW ;NO CR LF AT END
PUSHJ P,REP ;DO IT
JRST SCANM
QERR: ERROR[ASCIZ/NOT IDENT AFTER IFDEF/]
JRST SCANM
↑QIF%A: HRREM N,Q%SV ;SAVE VALUE
PUSHJ P,SCAN ;GET SYMBOL
TLNN IFLG ;IDENT?
JRST QERR ;NO
MOVE NA,L ;GET SIXBIT
IDIVI NA,HASH ;HASH
MOVMS PN
SKIPN PN,SYMTAB(PN);GET START
JRST QICOM ;NONE
SRC1(L,PN,AFND,JRST QICOM)
AFND: MOVE N,2(PN) ;GET FLAGS
TLNN N,DEFFL ;DEFINED?
JRST TR ;YES
QICOM: MOVE NA,L ;GET SIXBIT
IDIVI NA,HASH ;HASH
MOVMS PN
SKIPN PN,MACRT(PN);GET START
JRST QIOP ;NONE
SRC1(L,PN,TR,JRST QIOP)
QIOP: MOVE NA,L ;GET SIXBIT
IDIVI NA,HASH ;HASH
MOVMS PN
SKIPN PN,OPCDS(PN);GET START
JRST FLS ;NONE
SRC2(L,PN,TR)
JRST FLS
SUBTTL SCANS -- MAIN SCANNER IF SYMBOLS ARE TO BE LOOKED UP
;SCANS GO HERE FOR SCAN IF MACROS ARE TO BE EXPANDED AND
; SYMBOLS ARE TO BE LOOKED UP
↑SCANS: PUSHJ P,SCANM
TLNN IFLG ;IDENT?
JRST SPCCHK ;NO, SPC CHR.
ITS,<
CAMN L,['.FNAM1']
JRST [ MOVE N,SRCSTS+1
MOVEI NA,0
POPJ P,]
CAMN L,['.FNAM2']
JRST [ MOVE N,SRCSTS+2
MOVEI NA,0
POPJ P,]
>;ITS
TLNN OPFLG ;HAS AN OPCODE BEEN SEEN?
SKIPN PN,OPCDS(NA);GET START OF CHAIN
JRST PT1 ;NONE
SRC2(L,PN,PT2)
PT1: SKIPN TAC,SYMTAB(NA)
JRST PT4 ;NONE THERE AT ALL
CAMN L,(TAC)
JRST PT69 ;IS FIRST, DON'T BOTHER TO MOVE
SR: SKIPN PN,1(TAC)
JRST PT4 ;END OF LIST
CAMN L,(PN) ;IF IT MATCHES
JRST PT3
SKIPN TAC,1(PN) ;ELSE TRY NEXT
JRST PT4 ;HERE IF SYM FOUND
CAME L,(TAC) ;SEE US PLAY LEAPFROG WITH AC'S
JRST SR ;KEEP LOOKING
EXCH TAC,PN ;STRAIGHTEN OUT AC'S
;HERE PN IS SYM FOUND, AND TAC IS PREVIOUS SYM IN LIST
;SYM IS MOVED TO FRONT OF LIST TO FIND "POPULAR" SYMS FAST
PT3: MOVE N,2(PN)
TDNN N,BLOCK ;RIGHT BLOCK?
JRST PT4 ;NO - MUST NOT BE THERE
EXCH N,1(PN) ;NEXT GUY
EXCH N,1(TAC) ;DELINK & GET CURRENT (SAME AS PN)
EXCH N,SYMTAB(NA) ;SWAP CURRENT WITH FIRST
EXCH N,1(PN) ;AND POINT CURRENT AT REST OF LIST (RESTORING N)
PT69R: SKIPE XCRFSW
CREF6 1,(PN)
PT3B: TRNE B,SHRPF!UDARF ;# OR ↑ NEXT?
JRST VRHN ;YES
PT3A: TLNE N,DEFFL ;DEFINED?
JRST NODF ;NO
TLON N,REFBIT
MOVEM N,2(PN) ;SYM HAS NOW BEEN REFERENCED
MOVE N,3(PN) ;YES,GET VALUE ...
MOVE NA,4(PN) ;....
POPJ P,
PT2: TLO SOPF ;OPCODE FOUND
↑OPVAL: MOVEI NA, ;ZERO NA
HLLZ N,1(PN) ;GET FLAGS (VALUE)
TLNN N,30 ;REGULAR OPCODE?
POPJ P, ;YES, RETURN
JUMPL N,PSOP ;PSEUDO-OP?
IFN STANSW<
TLZE N,10
JRST CALLOP>
MOVE N,3(PN) ;NO, GET VALUE
MOVE NA,4(PN) ;...
POPJ P, ;RETURN
PSOP: TLO PSOPF ;PSEUDO-OP SEEN
MOVE NA,2(PN) ;GET PSEUDO-OP ROUTINE ADDRESS
MOVE N,3(PN) ;GET VALUE
POPJ P,
IFN STANSW<
CALLOP: ROT N,15
CAML N,UCLDLN
ADD N,SCLOFF
HRLI N,(<CALLI>)
POPJ P,>
↑MKNEW: PUSH P,N ;SAVE
PUSH P,NA
PUSH P,L
MOVE L,(PN) ;GET SIXBIT
MOVE N,L
IDIVI N,HASH ;HASH
MOVMS NA
PUSHJ P,PT4 ;MAKE A PLACE
POP P,L ;RESTORE
POP P,NA
POP P,N
POPJ P,
PT69: MOVEI PN,(TAC) ;OOPS - WRONG AC
MOVE N,2(PN)
TDNE N,BLOCK
JRST PT69R ;OK FOR THIS BLOCK
PT4: GFST PN,FSTPNT ;GET SOME FREE STRG
SKIPE XCRFSW
CREF6 1,(PN)
MOVEM L,(PN) ;DEPOSIT SIXBIT
MOVE N,SYMTAB(NA);GET CURRENT POINTER
MOVEM PN,SYMTAB(NA);REPLACE WITH POINTER HERE
EXCH N,1(PN) ;POINT NEW TO OLD AND ...
MOVEM N,FSTPNT ;ADVANCE FREE STRG PNT.
SETZM 3(PN) ;NO FIXUPS YET
SETZM 4(PN) ;NO POLFIX'S YET
MOVSI N,DEFFL ;UNDEFINED
OR N,BLOCK ;GET BLOCK BIT
PT4A: TRNE B,SHRPF!UDARF ;# OR ↑ NEXT?
JRST VARH ;YES
MOVEM N,2(PN) ;SET FLAGS
HLLZ NA,N
MOVEI N,(PN) ;VALUE IS POINTER
POPJ P,
EXHN: PUSHJ P,MAKEXT
MOVEM N,2(PN)
JRST PT3B
EXTH: PUSHJ P,MAKEXT
JRST PT4A
MAKEXT: PUSHJ P,SCAN1A
MOVE L,(PN) ;RESTORE SIXBIT IN CASE LABEL
TLNN N,DEFFL
TLOA N,INTF
TLO N,EXTF
POPJ P,
NODF: MOVE N,PN ;VALUE IS POINTER
HLLZ NA,2(PN)
POPJ P,
VRHN: TRNE B,UDARF
JRST EXHN
SKIPE XCRFSW
PUSHJ P,[MOVEI NA,2
SKIPE LISTSW
IDPB NA,CREFPT
POPJ P,]
PUSHJ P,SCAN1A ;PASS THE #
TLNN N,DEFFL
JRST PT3A ;ALREADY DEFINED, JUST LEAVE IT
TLOE N,UDSF!VARF ;TURN ON AND CHECK
JRST PT3P
MOVEM N,2(PN) ;SAVE FLAGS
GFST NA,FSTPNT ;GET FREE STORAGE
MOVEM PN,(NA) ;SAVE PNTR TO SYMBOL
MOVE N,VARLST
MOVEM NA,VARLST ;PUT ON VARIABLE LIST
EXCH N,1(NA)
MOVEM N,FSTPNT
SETZM 2(NA) ;MARK AS ONE WORD VARIABLE
SKIPA N,2(PN)
PT3P: MOVEM N,2(PN) ;SAVE FLAGS
JRST PT3A
VARH: TRNE B,UDARF
JRST EXTH
TLO N,VARF!UDSF ;SET # BIT
MOVEM N,2(PN) ;& STORE
PUSHJ P,SCAN1A ;PASS THE #
SKIPE XCRFSW
PUSHJ P,[MOVEI NA,2 ;GIVE # TO CREF
SKIPE LISTSW
IDPB NA,CREFPT
POPJ P,]
GFST NA,FSTPNT
MOVEM PN,(NA)
MOVE N,VARLST
MOVEM NA,VARLST
EXCH N,1(NA)
MOVEM N,FSTPNT
SETZM 2(NA) ;ONE WORD
HLLZ NA,2(PN) ;GET FLAGS
MOVE N,PN ;VALUE IS POINTER
POPJ P, ;RETURN
SPCCHK: TLNN NFLG
TLNN N,LBRF ;[ OR < OR . KLUDGE?
POPJ P, ;NO
TLNN SCFL
JRST (N)
PUSH P,EFSPNT
MOVEM FS,EFSPNT
ADD P,[XWD 12,12]
JUMPGE P,PDLOV
MOVSI TAC,PCNT ;PUSH PCNT & +1...
HRRI TAC,-11(P) ; OPCNT & +1...
BLT TAC,-4(P) ;& WRD & +1
HRRZI TAC,-3(P)
BLT TAC,(P) ;SAVE AC'S
TLZ MLFT ;...0 TO 3
TRNN N,TP1F ;[ OR <?
JRST IRBO ;<?
GFST T,FSTPNT ;GET FREE STRG.
SETZM (T) ;ZERO COUNT
GFST(N,<1(T)>) ;GET NEXT
MOVEM N,2(T) ;DEPOSIT POINTER TO VALUE
MOVEM N,OPCNT ;SET CURRENT LOC. TO IN CORE &...
MOVEM N,PCNT ;HERE
MOVSI TAC,INCF ;AND TO "IN CORE"
MOVEM TAC,OPCNT+1;...
MOVEM TAC,PCNT+1;...
SETZM (N) ;ZERO REVERSE FIXUP POINTER FOR VALUE
SETZM 2(N) ;NO FLAGS
SETZM 3(N) ;NO BACK PNTR
MOVE TAC,1(N) ;GET POINTER TO REST OF FREE STRG
MOVEM TAC,FSTPNT ;& DEPOSIT
SETZM 3(T) ;NO FIXUPS YET
SETZM 4(T) ;...
FOR QRN IN(LITPG,LITLIN,LABLTP,LABLTC,N,T)
< PUSH P,QRN
>
SETZM LABLTP ;INIT FOR ANY LABELS...
SETZM LABLTC ;IN THIS LITTERAL
MOVE T,TLBLK
MOVEM T,LITLIN
MOVE T,PGNM
MOVEM T,LITPG
TCALL: ACALL ;CALL ASSEMBL
SKIPN WRD+1 ;EMPTY?
JRST LEMP ;YES
AOS @(P) ;COUNT # OF WORDS IN LIT.
AOS LABLTC
LEMCON: MOVE N,-1(P) ;GET POINTER TO VALUE
MOVE TAC,WRD
MOVEM TAC,3(N) ;SET VALUE...
MOVE TAC,WRD+1
MOVEM TAC,4(N) ;...
TRZE TRBF ;TERM BY ]?
JRST ANOBR ;YES
GFST T,FSTPNT ;GET FREE STRG.
MOVEM T,1(N) ;POINT TO HERE
MOVEM N,3(T) ;POINT BACK
MOVEM T,PCNT ;SET LOC...
MOVEM T,OPCNT ;COUNTERS
MOVE N,1(T) ;GET REST OF FREE STRG.
MOVEM N,FSTPNT ;SET FSTPNT
MOVEM T,-1(P) ;SET NEW POINTER
SETZM (T) ;ZERO REVERSE FIXUP POINTER
SETZM 2(T) ;NO FLAGS
JRST TCALL
ANOBR: SETZM 1(N) ;ZERO VALUE POINTER(NO MORE)
POP P,NA
MOVE T,LABLTP
HRLM T,2(NA) ;STORE PNTR TO LABELS
MOVE T,3(N)
IDIVI T,HASH
MOVMS FS
MOVE O,LITPNT(FS)
MOVEM NA,LITPNT(FS)
PUSHJ P,LITCOM
MOVEM O,1(NA)
MOVE PN,NA
LITNUL: MOVE T,-10(P) ;GET OLD FLAGS
TDZ REFLAG
AND T,REFLAG
OR T ;RESTORE CERTAIN FLAGS
TDZ [XWD NFLG!SCFL!PSOPF!SOPF,TRBF]
TLO IFLG
SUB P,[(1)1]
POP P,LABLTC ;RESTORE OLD COUNT
POP P,LABLTP ;RESTORE OLD
POP P,LITLIN
POP P,LITPG
HRLZI N,-2(P)
ADDI N,1
BLT N,3 ;RESTORE AC'S
MOVSI N,-11(P)
HRRI N,PCNT
BLT N,PCNT+5 ;RESTORE PCNT ETC.
SUB P,[XWD 12,12]
PUSHJ P,SCAN1 ;GET A PEEK AT NEXT (FOR CALLER)
TLO SFL ;BUT ONLY A PEEK
MOVSI NA,DEFFL
MOVE N,PN ;MARK AS UNDEFINED LABEL
POP P,EFSPNT
JUMPN N,.+3
MOVEI NA,
TLC IFLG!NFLG ;JUST GIVE 0 IF NULL
POPJ P,
LEMP: TRNN TRBF ;TERM BY > OR ]?
JRST TCALL ;NO
MOVE T,-1(P) ;PNTR TO VAL
MOVE N,FSTPNT
MOVEM N,1(T)
MOVEM T,FSTPNT ;RETURN UNUSED BLK
SKIPE N,3(T) ;GET LAST PNTR
JRST ANOBR ;FINISH IT OFF
ERROR[ASCIZ/NULL LITERAL/] ;OOPS
POP P,PN
MOVEM T,1(PN)
MOVEM PN,FSTPNT ;RETURN HEADER
MOVEI PN,
JRST LITNUL
↑SCAN.: MOVE N,DPCNT ;HERE FOR .
MOVE NA,DPCNT+1
TLO IFLG
POPJ P,
↑SCAN$.:TLO IFLG ;HERE FOR $.
MOVE N,OPCNT
MOVE NA,OPCNT+1
TLNN NA,INCF
POPJ P, ;NOT IN LIT - EASY
GFST PN,FSTPNT ;IN LIT - KLUDGE UP A PSEUDO LITLAB
MOVEI T,
EXCH T,1(PN)
MOVEM T,FSTPNT
SETZM (PN) ;THIS WILL DISTINGUISH IT
SETZM 3(PN)
SETZM 4(PN)
MOVSI T,DEFFL!UDSF
PUSHJ P,MAKLL
MOVEI N,(PN)
MOVSI NA,DEFFL!UDSF
POPJ P,
IRBO: PUSH P,[0]
PUSH P,[0]
DRIBL: TRO NOFXF ;NO FIXUPS
ACALL
TLNE AUNDF
ERROR [ASCIZ /UNDEFINED WORD IN <>/]
TRZN TRBF ;TERM BY ] OR >?
JRST NIRBO ;NO
NEMP: TLON SFL ;HAVE WE SCANNED AHEAD?
PUSHJ P,SCAN ;NO, DO IT
MOVE T,-5(P) ;GET OLD FLAGS
TDZ REFLAG
AND T,REFLAG ;RESTORE APPROPRIATE FLAGS
OR T
TDZ [XWD SOPF!SCFL!PSOPF!IFLG,TRBF]
TLO NFLG
MOVE N,WRD
MOVE NA,WRD+1 ;RETURN VALUE
HRLZI L,-4(P)
ADDI L,1
BLT L,3 ;RESTORE AC'S
MOVSI L,-13(P)
HRRI L,PCNT
BLT L,PCNT+5 ;RESTORE PCNT ETC.
SUB P,[XWD 14,14]
POP P,EFSPNT
POPJ P,
NIRBO: MOVEI N,-1(P) ;NO, SAVE VALUE
HRLI N,WRD ;...
BLT N,(P)
SLOP: TRO NOFXF ;NO FIXUPS
ACALL
TRZN TRBF ;TERM BY ] OR >?
JRST SLOP ;NO
MOVSI N,-1(P) ;PUT OLD VALUE...
HRRI N,WRD ;IN...
BLT N,WRD+1 ;WRD
JRST NEMP
↑REFLAG:XWD OPFLG!RELEF!MLFT!UNDF!ESPF!PAWF,NOFXF!IOSW!ADFL!FLFXF
BEGIN INP
;INP USED BY SCAN TO GET NEXT BUFFER
↑NXTFL: JSR EOF ;GET NEXT FILE IF ANY
SETZM PGNM
AOS PGNM
SETZM SPGNM
SETZM TLBLK ;FLUSH SOS LINE #
SETZM SVLNUM ;"
TRNN LDEV
JRST .+4
MOVEI TAC,14
SKIPE XPNDSW
IDPB TAC,LSTPNT
PUSHJ P,LSTFRC
IFN STANSW,<
↑↑TVSKIP: ;ROUTINE TO SKIP TVEDIT DIRECTORY COMPLETELY
SETZM TVFILE ;FIRST ASSUME NON-TV
IN 2, ;READ FIRST REC
JRST .+2
JRST INP0 ;LOSE
MOVSI B,-LTVTXT
MOVSI TAC,B
ADD TAC,INPNT
IBP TAC
TVSKP1: MOVE C,@TAC ;SEE IF THIS IS A DIRECTORY
XOR C,TVTXT(B)
TDNN C,TVMSK(B)
AOBJN B,TVSKP1
JUMPL B,INP0A
SETOM TVFILE ;REMEMBER THIS FOR EDITOR CALL
TVSKP2: IN 2, ;REALLY IS - SKIP TO NEXT RECORD BEGINNING WITH FF
JRST TVSKP3
STATO 2,20000
JRST INP0
OUTSTR [ASCIZ /INVALID DIRECTORY, NOT SKIPPING.
/]
USETI 2,1
JRST INP0A
TVSKP3: ILDB C,INPNT
CAIE C,14
JRST TVSKP2
AOS PGNM ;WE ARE NOW ON PAGE 2
SOS INPNT+1 ;1 CHAR IS GONE
JRST INP0A
TVTXT: ASCII /COMMENT ⊗ VALID 00000 PAGES/
LTVTXT←←.-TVTXT
TVMSK: ASCII /←←←←←←←←←←⊂⊂←←←←←←00000←←←←←←/
↑↑TVFILE:0
>;STANSW
↑↑INP: INPUT 2,
NOITS,<
INP0: STATZ 2,740000
FATAL [ASCIZ \I/O ERROR ON INPUT\]
STATZ 2,20000
JRST NXTFL
INP0A: MOVE B,INPNT
IBP B
HRRM B,INP1
MOVE B,IDB+2
MOVEM B+1,INTEM
ADDI B,4
IDIVI B,5
INP1: ADDI B,
MOVE B+1,[BYTE(7)177,0]
MOVEM B+1,(B)
MOVE B+1,INTEM
POPJ P,
>;NOITS
ITS,<
AOSN NEWFIL
JRST NXTFL
MOVE B,INPNT
MOVEM B,INTEM
INP1: SOSGE INPNT+1
JRST EOB ;NO END OF FILE SEEN
ILDB B,INTEM
CAIN B,3 ;↑C IS EOF CHARACTER
JRST EOF
CAIE B,177 ;LOOK FOR RUBOUT
JRST INP1
OUTSTR [ASCIZ/
THERE IS A RUBOUT IN YOUR SOURCE FILE. YOU SHOULD THINK
LONG AND HARD ABOUT WANTING IT THERE. IT'S BEING IGNORED.
/]
MOVEI B,0
DPB B,INTEM ;OVER WRITE WITH NULL
JRST INP1
EOB: MOVEI B,200*5 ;CHARACTER COUNT
MOVEM B,INPNT+1
MOVE B,[BYTE(7)177,0]
MOVEM B,IBUF1+200
POPJ P,
EOF: MOVEI B,177 ;MARK END OF BUFFER AS RUBOUT FOLLOWED BY NULL
DPB B,INTEM
MOVEI B,0
IDPB B,INTEM
MOVE B,INPNT+1
SUBI B,200*5-1 ;BL-(CC-1)-BL=BL-CC-(BL-1)
MOVNS B ;WHERE BL=BLOCK LENGTH AND CC=CHARACTER COUNT
MOVEM B,INPNT+1
SETOM NEWFIL
POPJ P,
↑↑NEWFIL: 0
>;ITS
INTEM:0
BEND INP
↑RESCN: MOVE N,L ;GET SIXBIT
IDIVI N,HASH ;HASH
MOVMS NA
JRST PT1
BEND SCAN
SUBTTL REVAL -- EVALUATES EXPRESION INTO LIST-POLISH
BEGIN REVAL
↑REVAL: MOVE O,FS ;INITIALIZE
TLNE SCFL ;SPC CHR?
JRST SPC1 ;YES
PUSH FS,N ;PUT NUM...
PUSH FS,NA ;INT STRG
TLNN B,ARFL ;ARITH OP COMING UP?
JRST NOA1 ;NO
TLZ B,UNOF
REVALU: MOVE T,B
TLO T,SNB ;MARK AS OPERATOR
PUSH FS,FS ;STORE POINTER TO NUM...
PUSH FS,T ;WITH OPERATOR
HRRZ O,FS ;SET "OLD OP" POINTER
LOOP2: PUSHJ P,SCANS ;GET A PREVIEW
LOOP4: TLNN B,ENMF ;NOT A NUM COMING?
JRST SPC2 ;NOT A NUM COMING
PUSHJ P,SCANS ;GET NEXT NUM
HRRZ T,B
TLNN B,ARFL ;ARITH OP COMING?
MOVEI T,16 ;NO,SET LEVEL=16
LOOP3: CAIGE T,@(O) ;COMPARE NEW OP LEVEL WITH OLD
JRST NLOW ;NEW ONE LOWER
PUSH FS,N ;PUT NUM...
PUSH FS,NA ;IN STRG
HRLM FS,-1(O) ;AND POINT OLD OP AT IT
LOOP1: CAML T,-1(P) ;COMPARE NEW OP WITH LIMIT
JRST NGL ;NEW GREATER OR EQUAL LIMIT
MOVE T,B ;MARK NEW OP ...
TLO T,SNB ;AS OPERATOR
TLZ T,UNOF
PUSH FS,O ;POINT TO OLD OP
PUSH FS,T ;WITH NEW
HRRZ O,FS ;SET "OLD OP"
JRST LOOP2
NGL: MOVEM O,-1(P) ;RETURN "OLD OP"
POPJ P,
NLOW: PUSH P,O ;SAVE "OLD OP"
MOVEI O,@(O) ;GET LEVEL OF OLD OP
PUSH P,O ;USE AS LIMIT
PUSHJ P,REVAL ;CALL REVAL
MOVE O,-1(P) ;GET OD OP POINTER
EXCH T,(P) ;GET RETURNED VALUE
HRLM T,-1(O) ;POINT OLD OP AT IT
POP P,T ;RESTORE T
SUB P,[XWD 1,1] ;POP
JRST LOOP1
SPC2: TLNE B,UNOF ;UNARY OPERATOR?
JRST UNAR ;YES
TRNE B,LFPF ;(?
JRST LFTP
TRO POLERF ;SET ERROR FLAG
ERROR [ASCIZ/ILLEGAL CHR AFTER OPERATOR/]
JRST NGL ;RETURN
UNAR: HRRI B,2 ;MARK AS UNARY
PUSH P,O ;SAVE OLD OP PNT
MOVEI O,@(O) ;GET LEVEL OF OLD OP
PUSH P,O ;USE AS LIMIT IN CALL
PUSHJ P,REVALU ;CALL REVAL(OTHER ENTRANCE)
OLF: MOVE O,-1(P) ;GET OLD OP
EXCH T,(P) ;GET RETURNED VALUE
HRLM T,-1(O) ;PNT OLD OP AT IT
POP P,T ;RESTORE T
SUB P,[XWD 1,1];POP
JRST LOOP1
LFTP: TLZ SFL ;IGNORE PAREN
PUSHJ P,SCANS ;GET NEXT
PUSH P,O ;SAVE O
PUSH P,[16] ;SET LIMIT =16
PUSHJ P,REVAL ;CALL REVAL
MOVE O,-1(P) ;GET OLD OP
EXCH T,(P) ;GET RETURNED VALUE
HRLM T,-1(O) ;PNT OLD OP AT IT
POP P,T ;RESTORE T
SUB P,[XWD 1,1]
TRNN B,RTPF ;RIGHT PAREN LAST THING?
JRST NRP ;NO
PUSHJ P,SCANS ;GET THE RIGHT PAREN FF.
TLNN B,ARFL ;ARITH OP NEXT?
JRST NGL ;NO
HRRZ T,B ;YES, SET T ...
CAIL T,@(O) ;COMPARE LEVEL
JRST LOOP1 ;AND PROCEED
MOVE T,B
TLO T,SNB
TLZ T,UNOF
PUSH P,O ;SAVE OLD OP
HLRZ O,-1(O) ;GET RETURNED VALUE BACK
PUSH FS,O ;POINT NEW OP AT IT
PUSH FS,T ;PUSH OP
HRRZ O,FS ;SET OLD OP
HRRZ T,@(P) ;GET LEVEL
PUSH P,T
PUSHJ P,LOOP2
JRST OLF
NRP: TLON REUNBF ;SET UNBAL FLAG
ERROR [ASCIZ/UNBAL PARENS/]
TRO POLERF ;SET ERROR FLAG
JRST NGL ;RETURN
SPC1: TLNE N,UNOF ;UNARY OPERATOR?
JRST UNAR1 ;YES
TRNE N,LFPF ;(?
JRST LFTP1 ;YES
ERROR[ASCIZ/ILLEGAL CHR STARTS EXPRESSION/]
TRO POLERF ;SET ERROR FLAG
MOVEI T,16
JRST NGL
UNAR1: PUSH FS,FS ;PUSH ANY OLD THING
HLLZ T,N
OR T,[XWD SNB,2];MARK AS UNARY OP
PUSH FS,T
HRRZ O,FS
JRST LOOP4
LFTP1: PUSHJ P,SCANS ;GET
↑LFTP2: PUSH P,[16] ;SET LIMIT=16
PUSHJ P,REVAL ;GET VALUE
POP P,O ;GET VALUE
TRNN B,RTPF ;)?
JRST NRP ;NO
PUSHJ P,SCANS ;GET PAST THE )
TLNE B,ARFL ;ARITH OP NEXT?
JRST PARAR ;YES
TLO O,SNB ;MARK VALUE AS "PARENS AROUND WHOLE"
MOVEM O,-1(P) ;RETURN
POPJ P,
↑PARAR: PUSH FS,O ;POINT TO VALUE...
MOVE T,B ;...
TLO T,SNB ;...
TLZ T,UNOF
PUSH FS,T ;FROM CURRENT OP
HRRZ O,FS ;SET OLD OP
JRST LOOP2
NOA1: HRRZM FS,-1(P) ;RETURN OPERAND
MOVEI T,16 ;SET LEVEL=16
POPJ P, ;RETURN
BEND
;REDUC -- REDUCES THE LIST STRUCTURE POLISH
; POINTED TO BY FS
BEGIN REDUC
↑REDUC: SKIPL (FS) ;SINGLE OPERAND?
POPJ P, ;YES
PUSH P,FS ;SAVE POINTER
MOVE O,(FS) ;GET BITS
TLNE O,UNOF ;UNARY OP?
JRST PT1 ;YES
MOVE FS,-1(FS) ;GET POINTER TO FIRST OPERAND
SKIPGE (FS) ;OPERATOR OR OPERAND?
PUSHJ P,REDUC ;OPERATOR, REDUCE
PT1: MOVE FS,(P) ;GET POINTER
MOVS FS,-1(FS) ;GET POINTER TO SECOND OPERAND
SKIPGE (FS) ;OPERATOR?
PUSHJ P,REDUC ;YES, REDUCE
MOVE FS,(P) ;GET POINTER
MOVE O,(FS) ;GET BITS
TLNE O,UNOF ;UNARY OP?
JRST PT2 ;YES
MOVE O,-1(FS) ;GET PNTR TO FIRST OP
SKIPGE FS,(O) ;OPERAND?
JRST CPOP ;NO, CAN'T REDUCE
TLNE FS,DEFFL ;DEFINED?
JRST CPOP ;NO, CAN'T REDUCE
PT2: MOVE FS,(P) ;GET PNTR.
MOVS FS,-1(FS) ;GET PNTR TO SECOND OP
SKIPGE T,(FS) ;OPERAND?
JRST CPOP ;NO, CAN'T REDUCE
TLNE T,DEFFL ;DEFINED?
JRST CPOP ;NO, CAN'T REDUCE
MOVE T,(P) ;GET POINTER
MOVE T,(T) ;GET OPERATION
DPB T,[POINT 5,T,4];TACK ARMD & ARMD1 ...
LDB T,[POINT 7,T,6];ONTO LEVEL
JRST @OPRT ;DO IT
RRETT: POP P,FS ;GET POINTER
MOVEM T,-1(FS) ;DEPOSIT VALUE
MOVEM O,(FS) ;DEPOSIT BITS
POPJ P, ;RETURN
CPOP: POP P,O
POPJ P,
OPRT: @OPTB1(T)
OPTB1: REPEAT 10,<0>
FOR QN IN (UNNOT,0,UNMIN,0,0,0,0,0,LSHF,0,0,0,0,0,0,0,<OROP>
,XROP,ANOP,0,0,0,0,0,MULOP,0,DIVOP,0,0,0,0,0,ADOP,O,SBOP)
<QN
>
DEFINE AROP(BOP,SPC1,SPC2,BTOP,MGNM,Q)
< MOVE T,-1(O) ;GET SECOND OP
SPC1
BOP T,-1(FS) ;BOP FIRST OP
SPC2
MOVE O,(O) ;GET BITS FOR SECOND OP
BTOP O,(FS) ;BTOP BITS FOR FIRST
TRNE O,MGNM ;LEGAL RELOC?
JRST CPOP ;NO
Q DPB O,[POINT 4,(FS),35]
Q MOVE O,(FS) ;GET NEW BITS
JRST RRETT
>
ADOP: AROP(ADD,,,ADD,12)
SBOP: AROP(SUB,,,SUB,12)
MULOP: AROP(IMUL,,,OR,17,<;>)
DIVOP: AROP(IDIV,<MOVEM FS,TM>,<MOVE FS,TM>,OR,17,<;>)
ANOP: AROP(AND,,,OR,17,<;>)
OROP: AROP(OR,,,OR,17,<;>)
LSHF: AROP(LSH @ ,<HRRZS -1(FS)>,,OR,17,<;>)
UNMIN: MOVN T,-1(FS) ;NEGATE NUM
MOVE O,(FS) ;GET BITS
TRNE O,17 ;RELOC LEGAL?
JRST CPOP ;NO
JRST RRETT
UNNOT: SETCM T,-1(FS) ;INVERT NUM
MOVE O,(FS) ;GET BITS
TRNE O,17 ;RELOC LEGAL?
JRST CPOP ;NO
JRST RRETT
XROP: AROP(XOR,,,OR,17,<;>)
TM: 0
BEND
SUBTTL MEVAL -- MAIN EVALUATER -------
;MEVAL -- EVALUATES AN ADDRESS FIELD EXPRESSION & GENERATES
;FIXUPS. RETURNS OPCODES UNTOUCHED.
;IF MLFT IS ON, GENERATES LEFT HALF FIXUPS INSTEAD OF RIGHT.
BEGIN MEVAL
↑MEVAL: TLZ SOPF!PSOPF!PAWF!ESPF!UNDF
MOVE FS,EFSPNT
PUSHJ P,SCANS ;GET THING
TLNE SCFL ;SPEC. CHR?
JRST MSPEC ;YES
TLNE NFLG ;NUM?
JRST MNUM ;YES
TRNE B,LACF ;TERM BY ← OR :?
JRST DEFN ;YES
TLNE SOPF ;OPCODE?
TLOA OPFLG
MNUM: TLOA OPFLG ;STOP OPCODE LOOKUP
POPJ P,
TLNE B,ARFL ;ARITH OP NEXT?
JRST NONSIM ;YES
TLNN NA,DEFFL ;DEFINED?
POPJ P, ;YES
TLO UNDF ;NO, SET BIT
TRNE NOFXF ;GENERATE FIXUPS?
POPJ P, ;NO
MOVE T,OPCNT+1 ;GET CURRENT OUTPUT LOC. COUNTER BITS
TLNE T,INCF ;IN CORE?
JRST NOTHER ;YES
SKIPN O,3(PN) ;GET FIXUP POINTER
JRST NOTHER ;NONE
LOOP1: SKIPN (O) ;ZERO DEVIATION?
JRST FND1 ;YES, FOUND
LOOP2: SKIPE O,1(O) ;END OF CHAIN?
JRST LOOP1 ;NO
NOTHER: GFST O,FSTPNT ;GET SOME FREE STRG
SETZM (O) ;ZERO DEVIATION
LOOP4: MOVEM T,4(O) ;DEPOSIT CURRENT LOCAT. CNT.FLAGS
MOVE TAC,OPCNT ;GET CURRENT LOC. CNT.
MOVEM TAC,3(O) ;DEPOSIT
SETZM 2(O) ;MAKE FLAGS
TLNE MLFT ;LEFT HALF?
JRST [AOS 2(O) ;YES SET BIT
TLNE T,INCF ;IN CORE?
MOVEM O,2(TAC) ;YES
JRST SARND]
TLNE T,INCF ;IN CORE?
MOVEM O,(TAC) ;YES, SET REVERSE FIXUP PNTR.
MOVEI T,2
TRNE FLFXF ;FULL WORD FIXUPS?
ORM T,2(O) ;YES, MARK
SARND: MOVE T,3(PN) ;FIXUP PNTR.
EXCH T,1(O) ;PUT NEW THINGS...
MOVEM O,3(PN) ;INTO CHAIN
MOVEM T,FSTPNT ;ADVANCE FREE STRG PNTR.
SETZB N,NA ;VALUE IS 0
HRRZS O
POPJ P,
FND1: MOVE TAC,4(O) ;GET NUM FLAGS
TLNE TAC,INCF ;IN CORE?
JRST LOOP2 ;YES
MOVE TAC,2(O) ;GET FLAGS
TLNN MLFT ;LEFT HALF NOW?
TRCN TAC,1 ;IS THIS LEFT HALF?
TRNN TAC,1 ;OR THIS?
JRST LOOP2 ;NO MATCH
TRNN FLFXF ;FULL WORD NOW?
TRCN TAC,2 ;IS THIS FULL WORD?
TRNN TAC,2 ;OR THIS?
JRST LOOP2 ;NO MATCH
FND1A: MOVE N,OPCNT ;GET NEW...
MOVE NA,OPCNT+1 ;VALUE...
EXCH N,3(O) ;AND SWITCH...
EXCH NA,4(O) ;WITH OLD
HRRZS O
POPJ P,
NONSIM: TLZ RELEF!REUNBF ;CLEAR FLAGS
TLO OPFLG ;INHIBIT OPCODE LOOKUP
MOVE FS,EFSPNT
NONSM2←.+2 ;RET FROM REVAL
RVALUA
PUSHJ P,REDUC ;REDUCE TO VALUE IF POS.
TLNE RELEF ;RELOC ERROR?
ERROR [ASCIZ/RELOCATION ERROR/]
POP P,FS ;GET POINTER TO POLISH
SKIPGE FS ;PARENS AROUND WHOLE?
TLO PAWF ;YES
SKIPGE O,(FS) ;DEFINED?
JRST NOTDF ;NO
MOVE N,-1(FS) ;GET VALUE...
MOVE NA,O ;AND VALUE FLAGS
TLNE NA,DEFFL ;MAKE SURE UNDEF HAS BEEN SET RIGHT
TLO UNDF
POPJ P,
NOTDF: TLO UNDF ;UNDEF.
TRNE NOFXF ;GENERATE NO FIXUPS?
POPJ P, ;NO
HRRZ T,O ;GET LEVEL
CAIE T,12 ;+ OR -?
JRST POLFIX ;NO
MOVE PN,-1(FS) ;GET POINTER TO RIGHT ARG.
MOVS T,PN ;GET POINTER TO LEFT ARG.
SKIPGE N,(PN) ;GET RIGHT ARG -- OPERAND?
JRST POLFIX ;NO
SKIPGE NA,(T) ;GET LEFT ARG. -- OPERAND?
JRST POLFIX ;NO
TLNN NA,DEFFL ;LEFT ARG DEFINED?
JRST OK1 ;YES
TLNE N,DEFFL ;RIGHT ARG DEFINED?
JRST POLFIX ;NO
TLNE O,ARMD ;+ OR -?
JRST POLFIX ;-
EXCH PN,T
EXCH NA,N ;SWITCH ARGS
OK1: TRNE NA,17 ;ANY RELOC ON LEFT ARG?
JRST POLFIX ;YES
TLNN O,ARMD ;-?
SKIPA NA,-1(T) ;NO, GET VALUE
MOVN NA,-1(T) ;YES, GET NEGATIVE VALUE
MOVE PN,-1(PN) ;GET SYMBOL TABLE POINTER
↑CCFIX: MOVE T,OPCNT+1 ;GET FLAGS
TLNE T,INCF ;IN CORE?
JRST NOF ;YES
SKIPN O,3(PN) ;GET FIXUP CHAIN
JRST NOF ;NONE
SRC: SRC1(NA,O,FND2,JRST NOF)
↑DBLUP: 0
FND2: MOVE TAC,4(O) ;GET NUM FLAGS
TLNE TAC,INCF ;IN CORE?
JRST SRC+2 ;YES
MOVE TAC,2(O) ;GET FLAGS
TLNN MLFT ;LEFT HALF NOW?
TRCN TAC,1 ;IS THIS LEFT HALF?
TRNN TAC,1 ;OR THIS?
JRST SRC+2 ;NO MATCH, CONTINUE SEARCH
TRNN FLFXF ;FULL WORD NOW?
TRCN TAC,2 ;IS THIS FULL WORD?
TRNN TAC,2 ;OR THIS?
JRST SRC+2 ;NO MATCH
JRST FND1A
NOF: GFST O,FSTPNT ;GET SOME FREE STRG.
MOVEM NA,(O) ;STORE DEVIATION
JRST LOOP4
MSPEC: TDNN N,[XWD UNOF,LFPF!UDARF];( OR ↑ OR ↓ OR UNARY OP?
JRST [TLO OPFLG!ESPF
POPJ P,]
TRNE N,LFPF
JRST IXTST ;( SEE IF INDEX
TLNE N,UNOF
JRST NONSIM ;UNARY OP
SETZM DBLUP ;NO DOUBLE UP ARROW YET.
PUSH P, ;SAVE FLAGS
PUSH P,N ;SAVE ↑ OR ↓
TLO OPFLG ;INHIBIT OPCODE SEZRCH
MSPE2: PUSHJ P,SCANS ;GET IDENT
TLNN IFLG ;IDENT?
JRST [TRNN N,TP2F ;ANOTHER ↑
JRST ERR1 ;NO -- LOSE
SETOM DBLUP
JRST MSPE2]
MOVEM L,LSTLAB+2;SAVE SIXBIT
POP P,L ;GET ↑ OR ↓
ANDI L,TP1F!TP2F;CLEAR REST
TRNN B,LACF ;: OR ← NEXT?
JRST ERR1 ;NO
TRNE B,TP1F ;← OR :?
JRST LADF ;←
PTQ1: MOVE N,LSTLAB+2;SET UP...
MOVEM N,LSTLAB ;LABEL NAME AND...
MOVE N,LSTLAB+3 ;BLOCK FOR...
MOVEM N,LSTLAB+1;ERROR MESSAGE PRINTER
EXCH L,(P) ;GET OLD FLAGS, SAVE LABINS FLAGS
ANDCA L,[XWD OPFLG,0];CLEAR ALL BUT OPFLG
ANDCM L ;TURN OFF OPFLG IF IT WAS OFF
MOVE N,PCNT ;GET CURRENT LOC...
MOVE NA,PCNT+1 ;...
MOVEM N,LSTLAB+4;DEPOSIT FOR ERROR PRINT
PUSHJ P,SCAN1A ;LOOK FOR ANOTHER :
POP P,L ;GET BACK FLAGS FOR LABINS
TLO L,COLONF ;MARK : TYPE
TRNN B,LACF ;ANOTHER :?
JRST .+3 ;NO
TLZ SFL ;SKIP SECOND :
TLO L,DBLF ;MARK ←← TYPE (::)
PUSHJ P,LABINS ;INSERT (DEFINE) LABEL
SKIPE XCRFSW ;CREF?
JRST [SKIPN LISTSW ;LISTING?
JRST .+1 ;NO
MOVEI N,2 ;YES
IDPB N,CREFPT
JRST .+1]
JRST MEVAL
ERR1: SUB P,[1,,1]
ERROR [ASCIZ/NO IDENT OR NO : OR ← AFTER ↑ OR ↓/]
POP P,N
ANDCA N,[XWD OPFLG,0];GETSTORE ...
ANDCM N ;OLD OPFLG
JRST MEVAL
DEFN: PUSH P, ;SAVE OLD FLAGS
TLO OPFLG ;INHIBIT OPCODE LOOKUP
TLNE SOPF ;FOUD AS OPCODE?
PUSHJ P,RESCN ;YES , FIND AS LABEL
MOVEM L,LSTLAB+2;SAVE SIXBIT
MOVEI L, ;NO FLAGS (NO ↑ OR ↓)
TRNN B,TP1F ;← OR :?
JRST PTQ1 ;:
LADF: MOVEI O, ;INITIALIZE COUNT
LLOP: SKIPE XCRFSW ;CREF?
JRST [SKIPN LISTSW ;LISTING?
JRST .+1 ;NO
MOVEI TAC,7 ;YES DELETE PRVIOUS SYMBOL OUTPUT
IDPB TAC,CREFPT
JRST .+1]
PUSH P,PN ;SAVE POINTER INTO SYMTAB
PUSH P,L ;SAVE FLAGS
ADDI O,1 ;COUNT
TLZ SFL ;SKIP THE ←
CAIN C,"=" ;IF CHAR WAS REALLY =
JRST EQLDEF
LLOP1: PUSHJ P,SCANS ;GET NEXT
TLNE SCFL ;SPC CHR?
JRST SCHAN ;YES
TLNN IFLG ;IDENT?
JRST LNMM ;NO, NUM
TRNN B,LACF ;← OR : NEXT?
JRST LNMM ;NO
MOVEI L, ;YES
JRST LLOP
SCHAN: TRNN N,LACF ;← OR : NEXT?
JRST SCNT ;NO
SCHLA: MOVSI N,DBLF ;SET ←←
ORM N,(P) ;...
JRST LLOP1
SCNT: TRNN N,UDARF ;↑ OR ↓?
JRST LNMM ;NO
PUSH P,N ;SAVE CHR.
PUSHJ P,SCANS ;GET IDENT
TLNN IFLG ;IDENT?
JRST ERR2 ;NO
TRNN B,LACF ;← OR :?
JRST ERR2 ;NO
POP P,L ;GET ↑ OR ↓
ANDI L,TP1F!TP2F ;CLEAR REST
JRST LLOP
ERR2: ERROR[ASCIZ/NO IDENT OR NO ← AFTER ↑ OR ↓/]
JRST LLOP1 ;TRY AGAIN
EQLDEF: PUSHJ P,SCAN1 ;KLUDGE TO MAKE == WORK
CAIN C,"="
JRST SCHLA ;IF VERY NEXT CHAR IS =, TREAT IT AS ←
TLO SFL ;OTHERWISE REPROCESS IT NORMALLY
JRST LLOP1
LNMM: PUSH P,O ;SAVE COUNT
MOVE FS,EFSPNT
TLZ RELEF!REUNBF ;CLEAR FLAGS
RVALUA
PUSHJ P,REDUC ;REDUCE TO VALUE
POP P,FS ;GET POINTER
TLNE RELEF ;RELOC ERROR?
ERROR[ASCIZ/RELOCATION ERROR/]
SKIPGE NA,(FS) ;DEFINED?
JRST [ ERROR[ASCIZ/UNDEFINED VALUE AFTER←/]
MOVEI NA,;THIS IS TO FIX MYSTERIOUS BUG
JRST .+1]
TLZE NA,DEFFL ;DEFINED?
JRST .-2 ;NO , ERROR
MOVE N,-1(FS) ;GET VALUE
POP P,O ;GET COUNT
LLOP2: POP P,L ;GET FLAGS
POP P,PN ;GET POINTER
SKIPE XCRFSW
CREF6 1,(PN)
PUSHJ P,LABINS ;INSERT DEFINITION
SKIPE XCRFSW
JRST [MOVEI L,2
SKIPE LISTSW
IDPB L,CREFPT
JRST .+1]
SOJG O,LLOP2 ;COUNT, DONE?
EXCH N,WRD
EXCH NA,WRD+1
PUSHJ P,LBLOUT ;LIST VALUE
MOVEM N,WRD
MOVEM NA,WRD+1
POP P,N ;YES, RESTORE OPFLG ...
ANDCA N,[XWD OPFLG,0] ;...
ANDCM N ;...
JRST MEVAL
;SAW ( CHECK FOR INDEX CONSTRUCT & GET OUT QUICKLY IF SO
IXTST: TLO OPFLG
PUSHJ P,SCANS ;SEE WHAT FOLLOWS
TRNE B,RTPF
TLNE SCFL
JRST IXTST2 ;SPEC CHR AFTER ( OR NOT ) AFTER THAT
PUSHJ P,SCAN1A
TLNE B,ARFL
JRST IXTST3 ;ARITH OP AFTER )
TLO PAWF ;HURRAY, IT'S AN INDEX
TLNE B,SPFL
JSR SPCSKP ;MAKE SURE WE'RE PAST BLANK
TLNE NA,DEFFL
TLO UNDF
POPJ P, ;SEE HOW EASY THAT WAS
;HERE WE SIMULATE HAVING GOTTEN THIS FAR INTO REVAL
IXTST2: TLZ RELEF!REUNBF
MOVE FS,EFSPNT
PUSH P,[16]
PUSHJ P,LFTP2
JRST NONSM2
;HERE WE SIMULATE HAVING GOTTEN EVEN FARTHER INTO REVAL
IXTST3: TLZ RELEF!REUNBF
MOVE FS,EFSPNT
PUSH FS,N
PUSH FS,NA
MOVEI O,(FS)
PUSH P,[16]
PUSHJ P,PARAR
JRST NONSM2
POLFIX: MOVE T,MTBPNT ;GET NEXT FREE AREA
MOVE N,OPCNT ;GET FIXUP LOCATION
LEG MOVEM N,2(T) ;DEPOSIT
MOVE O,OPCNT+1 ;GET FLAGS
LEG MOVEM O,3(T) ;DEPOSIT
TLNN O,INCF ;IN CORE?
JRST NOINCF ;NO
TLNE MLFT ;LEFT HALF?
JRST [HRROM T,2(N);YES -- SET REVERSE PNTR
JRST NOINCF]
HRROM T,(N) ;SET REVERSE POINTER
NOINCF: SETZM 1(T) ;CLEAR COUNT
HRRO O,T ;GET STRT POINTER
ADDI T,5 ;INCREMENT POINTER
PUSHJ P,POLMOV ;MOVE POLISH
SUBI T,1
MOVEM T,MTBPNT ;UPDATE FREE AREA POINTER
SUBI T,(O) ;FORM LENGTH
TLNE MLFT ;LEFT HALF?
TLO T,1 ;YES
TRNE FLFXF ;FULL WORD FIXUP?
TLO T,2 ;YES
MOVSM T,(O) ;DEPOSIT
SETZB N,NA ;"VALUE" IS 0
SKIPE 1(O) ;NO UNDEFS?
POPJ P,
MOVE T,3(O) ;GET FIXUP LOC FLAGS
TLNE T,INCF ;IN CORE?
POPJ P, ;YES
MOVE T,POLPNT ;GET CURRENT POINTER
MOVEM T,1(O) ;PUT IN...
HRRZM O,POLPNT ;CHAIN..
POPJ P,
POLMOV: SKIPL N,(FS) ;OPERATOR OR OPERAND?
JRST OPRD ;OPERAND
LEG MOVEM N,(T) ;DEPOSIT
TLNE N,UNOF ;UNARY OP?
JRST UNPT ;YES
MOVE N,-1(FS) ;GET POINTERS
ADDI T,2 ;INCREMENT POINTER
LEG MOVSM T,-3(T) ;DEPOSIT FIRST POINTER
PUSH P,T ;SAVE NEW POINTER
PUSH P,N ;SAVE OLD POINTER
HLRZ FS,N ;SET NEW OLD POINTER
PUSHJ P,POLMOV ;PUT IN FIRST OPERAND
POP P,FS ;GET LEFT OPERAND OLD POINTER
POP P,N ;GET OLD NEW POINTER
HRRM T,-3(N) ;DEPOSIT NEW LEFT POINTER
JRST POLMOV ;MOVE LEFT OPERAND
UNPT: MOVE N,-1(FS) ;GET OPERANDS
ADDI T,2
LEG MOVSM T,-3(T) ;DEPOSIT NEW POINTER
HLRZ FS,N ;SET UP POINTER
JRST POLMOV
OPRD: TLNN N,DEFFL ;DEFINED?
JRST DEFND ;YES
LEG MOVEM N,(T) ;DEPOSIT FLAGS
MOVE N,-1(FS) ;GET "VALUE"
LEG MOVEM N,-1(T) ;DEPOSIT
MOVE NA,O ;GET STRT OF POLFIX
HRLI NA,-1(T) ;GET POINTER
EXCH NA,4(N) ;INSERT POLFIX IN CHAIN
LEG MOVEM NA,1(T) ;...
ADDI T,3 ;INCREMENT
AOS 1(O) ;COUNT UNDEF SYMBOL
POPJ P,
DEFND: LEG MOVEM N,(T) ;DEPOSIT FLAGS
MOVE N,-1(FS) ;GET VALUE
LEG MOVEM N,-1(T) ;DEPOSIT
ADDI T,2 ;INCR. POINTER
POPJ P,
BEND
BEGIN LABINS
COMMENT +
LABINS -- CALL, TO DEFINE A LABEL, WITH THE VALUE
IN N & NA, THE POINTER TO THE TABLE ENTRY IN
PN AND FLAGS (AS FOLLOWS) IN L (LH SAME AS IN SYM)
RH: TP1F -- ↓
TP2F -- ↑
LH: DBLF -- ←← OR ::
COLONF -- : TYPE (ERR ON REDEF)
+
↑↑LVDEF:MOVEI L, ;HER TO DEFINE LITERALS & VARIABLES
MOVSI T,UDSF!VARF
ANDCAB T,2(PN)
↑↑LABINS:
HLLZ T,L
IOR T,2(PN) ;GET FLAGS
TLZE T,EXTF
TLO T,INTF ;TURN EXTERNAL → INTERNAL IF DEFINED
TLNE T,UDSF ;UNDEFINED - DEFINED
JRST ERR ;YES
TLZN T,DEFFL ;DEFINED?
JRST DEFD ;YES
TRNE L,TP1F ;↓?
OR T,DBLCK
TRNE L,TP2F ;↑?
TLO T,UPARF ;YES
SKIPE DBLUP
TLO T,DBLUPF ;DOUBLE UP ARROW FLAG.
TLNE NA,INCF ;IN CORE VALUE
JRST LILHN ;YES
MOVEM T,2(PN)
EXCH N,3(PN) ;SWITCH VALUE WITH FIXUP POINTER
EXCH NA,4(PN) ;SWITCH VALUE FLAGS WITH POLFIX PNTR.
JUMPE N,NOFX ;NO FIXUPS?
PUSHJ P,GFIX
JRST NOFX
LILHN: TLO T,DEFFL!UDSF;MARK AS UNDEFINED - DEFINED
↑MAKLL: MOVEM T,2(PN) ;DEPOSIT FLAGS
GFST T,FSTPNT
MOVE FS,LABLTP ;GET POINTER TO LIST OF LIT. LABS
EXCH FS,1(T) ;CONS ON
MOVEM FS,FSTPNT
MOVEM T,LABLTP
MOVE FS,(PN) ;GET SIXBIT
MOVEM FS,(T) ;DEPOSIT
MOVE FS,LABLTC ;GET COUNT
MOVEM FS,3(T) ;DEPOSIT
MOVEM PN,4(T) ;THE LOCATION OF THE SYMBOL BLOCK
POPJ P,
;GFIX: CALL WITH POINTER TO DEFINED SYMBOL IN PN AND
; FIRST FIXUP POINTER IN N. USES T,FS,L,TAC
↑GFIX: MOVSI T,REFBIT
IORM T,2(PN) ;MUST BE REFERENCED IF FIXUP NEEDED
MOVE FS,4(PN) ;GET FLAGS
LOOP1: MOVE TAC,2(N) ;GET FIXUP FLAGS
MOVE L,4(N) ;GET VALUE FLAGS
MOVE T,3(PN) ;GET VALUE
ADD T,(N) ;ADD DEVIATION
TRNE TAC,2 ;FULL WORD?
JRST FULFX ;YES
DPB L,[POINT 1,FS,34];SET LEFT HALF RELOC BIT
HRL T,3(N) ;PUT IN POINTER
TLNE L,INCF ;IN CORE?
JRST INCFX ;YES
TRNE TAC,1 ;LEFT HALF?
FOUT LFX ;YES
FOUT T ;OUTPUT FIXUP
LOOP2: MOVE L,FSTPNT ;PUT BACK ON ...
MOVE FS,4(PN) ;GET RELOC FLAGS BACK
EXCH L,1(N) ;FREE ...
MOVEM N,FSTPNT ;STRG
SKIPE N,L ;GET NEXT, DONE?
JRST LOOP1 ;NO
POPJ P,
FULFX: TLNE L,INCF ;IN CORE?
JRST FINCFX ;YES
HRLM T,FULF+3 ;DEPOSIT VALUE
HLRM T,FULF+2 ;...
DPB FS,[POINT 1,FULF+1,2];DEP. RELOC.
LSH FS,-2
DPB FS,[POINT 1,FULF+1,1];...
MOVE T,3(N) ;GET FIXUP PLACE
HRLM T,FULF+4 ;DEPOSIT
DPB L,[POINT 1,FULF+1,4];DEP. RELOC.
PUSHJ P,BFRC ;FORCE OUT BIN
POUT 5,FULF ;OUTPUT POLFIX
JRST LOOP2
FULF: XWD 11,3
0
XWD 1,0
XWD 0,-3
0
FINCFX: MOVE TAC,3(N) ;GET PLACE
MOVEM T,3(TAC) ;DEPOSIT VALUE...
ORM FS,4(TAC) ;& RELOC.
SETZM (TAC)
JRST LOOP2
INCFX: TRNE TAC,1 ;LEFT HALF?
JRST LINCFX ;YES
MOVS TAC,T
HRRM T,3(TAC) ;DEPOSIT VALUE
DPB FS,[POINT 1,4(TAC),35];DEPOSIT RELOC.
SETZM (TAC) ;ZERO REVERSE POINTER
JRST LOOP2
LINCFX: MOVS TAC,T
HRLM T,3(TAC) ;DEPOSIT VALUE
DPB FS,[POINT 1,4(TAC),33];DEPOSIT RELOC.
SETZM 2(TAC) ;ZERO REVERSE POINTER
JRST LOOP2
NOFX: JUMPE NA,NOPFX ;POLFIXES?
MOVE N,NA
PUSHJ P,PFIX
NOPFX: MOVE N,3(PN) ;RESTORE N ...
MOVE NA,4(PN) ;AND NA
MOVE T,2(PN) ;GET FLAGS
TLNN T,SYMFIX ;SEE IF SYMBOL TABLE FIXUP NEEDED
POPJ P, ;NO
MOVE FS,1(PN) ;BLOCK NAME
PUSHJ P,R5CON
MOVEM FS,SYMFXP+5
MOVE FS,(PN) ;SYMBOL NAME
PUSHJ P,R5CON
MOVEM FS,SYMFXP+4
MOVE N,3(PN)
HLRM N,SYMFXP+2 ;VALUE IN 2 HALVES
HRLM N,SYMFXP+3
DPB NA,[POINT 1,SYMFXP+1,2] ;RELOC
LSH NA,-2
DPB NA,[POINT 1,SYMFXP+1,1]
POUT 6,SYMFXP
MOVE NA,4(PN) ;GET RELOC BACK
POPJ P,
↑SYMFXP: XWD 11,4
0
XWD 1,0
XWD 0,-6
BLOCK 2
LFX: -1 ;WORDS FOR LEFT HALF FIXUP
0
DAREDF: MOVE FS,BLOCK ;GET BLOCK BIT
TRNE L,TP2F
LSH FS,-1
SKIPE DBLUP
MOVEI FS,1
SUBI FS,1 ;FORM ALL HIGHER BLOCK BITS
AND FS,T ;ANY HIGHER LEVEL BITS ON
JUMPE FS,DEFD1 ;NO
SKIPE XCRFSW
JRST [MOVEI FS,7
SKIPE LISTSW
IDPB FS,CREFPT
JRST .+1]
PUSHJ P,MKNEW ;CREATE A NEW ENTRY
ERROR [ASCIZ /WARNING - ↓ SYMBOL REDEFINED/]
JRST LABINS
DEFD: TLNE T,DAF ;DOWN ARROW
JRST DAREDF ;YES
DEFD1: TLZ T,UPARF ;CLEAR UPARROW BIT
TLNN T,COLONF
TLNE L,COLONF
JRST CHKDEF ;PROBABLY ERR IF EITHER NEW OR OLD IS : TYPE
DEFOK: TRNE L,TP1F ;↓?
OR T,DBLCK
TRNE L,TP2F ;↑?
TLO T,UPARF ;YES
SKIPE DBLUP
TLO T,DBLUPF
MOVEM T,2(PN) ;STORE FLAGS
MOVEM N,3(PN) ;DEPOSIT VALUE
MOVEM NA,4(PN) ;...
POPJ P,
CHKDEF: CAMN N,3(PN)
CAME NA,4(PN)
JRST ERR
JRST DEFOK ;NOT ERR IF REDEF WITH SAME VAL
ERR: ERROR[ASCIZ/MULTIPLE DEFINITION/]
POPJ P,
;PFIX: CALL WITH POINTER TO DEFINED SYMBOL IN PN AND POLISH
; FIXUP CHAIN POINTER IN N. USES T,FS,TAC,L
↑PFIX: MOVSI T,REFBIT
IORM T,2(PN) ;INDICATE REFERENCED
PFIX1: MOVS T,N ;GET OPERAND POINTER
MOVE FS,3(PN) ;GET VALUE
MOVEM FS,(T) ;DEPOSIT
MOVE FS,4(PN) ;GET FLAGS
MOVEM FS,1(T) ;DEPOSIT
MOVE FS,2(T) ;SAVE NEXT...
MOVEM FS,T2SAV ;POINTER
SOSLE 1(N) ;DECREMENT UNDEF SYM COUNT
JRST SUL ;Some Undefs. Left
MOVEI FS,5(N) ;GET START OF POLISH
PUSH P,O ;SAVE O
PUSHJ P,REDUC ;REDUCE
POP P,O ;RESTORE O
SKIPGE FS,5(N) ;VALUE OR OPERATOR?
JRST PLOUT ;OPERATOR
MOVE L,3(N) ;GET FIXUP FLAGS
TLNE L,INCF ;IN CORE FIXUP?
JRST PINC ;YES
MOVE TAC,(N) ;GET LEFT HALF FLAG
TRNE TAC,2 ;FULL WORD?
JRST PFULX ;YES
TRNE TAC,1 ;LEFT HALF FIXUP?
FOUT LFX ;YES
MOVE T,4(N) ;GET VALUE
HRL T,2(N) ;GET FIXUP
DPB L,[POINT 1,FS,34];DEPOSIT FIXUP RELOC
FOUT T ;PUT OUT FIXUP
PPT1: PUSH P,B ;SAVE
PUSH P,C
HRRZ C,N ;GET START ADDRESS
HLRZ B,(N) ;GET LENGTH
ADD B,C ;GET END
PUSHJ P,MACRET ;RETURN SPACE
POP P,C ;RESTORE
POP P,B
SUL: SKIPE N,T2SAV ;GET NEXT POLFIX
JRST PFIX1
POPJ P, ;NO MORE
PFULX: MOVE T,4(N) ;GET VALUE
HLRM T,FULF+2 ;DEPOSIT
HRLM T,FULF+3 ;...
DPB FS,[POINT 1,FULF+1,2];DEPOSIT RELOC
LSH FS,-2
DPB FS,[POINT 1,FULF+1,1]
MOVE T,2(N) ;GET FIXUP
HRLM T,FULF+4 ;DEPOSIT
DPB L,[POINT 1,FULF+1,4];DEPO. RELOC
PUSHJ P,BFRC ;FORCE OUT BIN
POUT 5,FULF ;PUT OUT FIXUP
JRST PPT1
PINF: MOVE T,4(N) ;GET VALUE
MOVE TAC,2(N) ;GET LIT LOC
MOVEM T,3(TAC) ;DEPOSIT VALUE
ORM FS,4(TAC) ;DEPOSIT RELOC
SETZM (TAC)
JRST PPT1
PINC: MOVE TAC,(N) ;GET FLAGS
TRNE TAC,2 ;FULL WORD?
JRST PINF ;YES
TRNE TAC,1 ;LEFT HALF?
JRST PINCL ;YES
MOVE TAC,2(N) ;GET LIT LOC.
MOVE T,4(N) ;GET VALUE
HRRM T,3(TAC) ;DEPOSIT
SETZM (TAC) ;CLEAR REVERSE POINTER
DPB FS,[POINT 2,4(TAC),35];DEP RELOC.
JRST PPT1
PINCL: MOVE TAC,2(N) ;GET LIT LOC.
MOVE T,4(N) ;GET VALUE
HRLM T,3(TAC) ;DEPOSIT
SETZM 2(TAC) ;CLEAR REV. PNTR.
DPB FS,[POINT 2,4(TAC),33];DEP RELOC.
JRST PPT1
HALOUT: HRROM L,HALP1 ;DEPOSIT RIGHT HALF OF POINTER
SETCMM HALP1 ;AND COMPLEMENT IT
IBP L ;INCREMENT RELOC POINTER
TDNE L,HALP1 ;DID IT GO TO NEXT WORD?
JRST HALP2 ;YES
HALRET: LEG IDPB TAC,HALP3 ;DEPOSIT HALFWORD
MOVSS TAC
LEG DPB TAC,L ;DEPOSIT RELOC
AOS HALP4 ;COUNT
POPJ P,
HALP2: ADDI L,=18 ;INCREMENT RELOC POINTER
AOS HALP3 ;INCREMENT HALFWORD POINTER
JRST HALRET
T2SAV: 0
HALP1: 0
HALP3: 0
HALP4: 0
PLOUT: MOVE L,3(N) ;GET FIXUP FLAGS
TLNE L,INCF ;IN CORE?
JRST SUL ;YES
MOVEI FS,5(N)
PUSHJ P,POLOUT
JRST PPT1
↑POLOUT: HRRZ L,MTBPNT ;GET A FREE PLACE TO PUT FIXUP
PUSH P,N ;SAVE N
ADD L,[XWD 442200,2];MAKE HALFWORD POINTER
SETZM HALP4 ;ZERO COUNT
MOVEM L,HALP3 ;DEPOSIT
ADD L,[440100000001-442200000002];MAKE RELOC POINTER
PUSHJ P,PPFFXX ;DO FIXUP
POP P,N ;GET N
HRRZ T,(N) ;GET FLAGS
MOVN TAC,T ;FORM...
ADDI TAC,-1 ;STORE OP
PUSHJ P,HALOUT ;OUTPUT IT
MOVE TAC,2(N) ;GET FIXUP
HRL TAC,3(N) ;& RELOC
PUSHJ P,HALOUT ;OUTPUT IT
MOVE T,MTBPNT ;GET START
MOVE FS,HALP4 ;GET COUNT
ADDI FS,1
LSH FS,-1 ;FORM REAL COUNT
HRLI FS,11 ;BLOCK TYPE
LEG MOVEM FS,(T) ;DEPOSIT
PUSHJ P,BFRC ;FORCE OUT BINARY
MOVN TAC,HALP3 ;FORM...
ADDI TAC,-1(T) ;LENGTH
HRL TAC,T ;GET START
MOVSM TAC,HALP3
BBOUT HALP3
POPJ P, ;RETURN
DEFINE TBB (A)
< IFL A-10,<FOR Q1←1,A
< 0
>
>
IFGE A-10,<A/10>
>
PPTAB: FOR Q IN (7,1,130,1,140,5,110,7,100,120,70,5,<50>
,1,60,5,30,1,40)
<TBB (Q)
>
PPTT1: MOVS FS,-1(FS) ;GET ARG POINTER
PPFFXX: SKIPL T,(FS) ;OPERAND OR OPERATOR?
JRST POPND ;OPERAND
DPB T,[POINT 5,T,4];FIND OUT WHAT...
LDB T,[POINT 7,T,6];OPERATOR IT...
MOVE TAC,PPTAB(T);IS
PUSHJ P,HALOUT ;OUT OUT OPERATOR
MOVE T,(FS)
TLNE T,UNOF ;UNARY OP?
JRST PPTT1 ;YES
MOVE FS,-1(FS) ;GET FIRST ARG POINTER
PUSH P,FS ;SAVE
PUSHJ P,PPFFXX ;PUT OUT
MOVS FS,(P) ;GET SECOND ARG POINTER
SUB P,[1(1)]
JRST PPFFXX ;PUT OUT & RETURN
POPND: TLNE T,DEFFL ;DEFINED?
JRST POPUN ;NO
MOVE TAC,-1(FS) ;GET VALUE
TLNN TAC,-1 ;SHORT OR LONG WORD?
TRNE T,14 ;LEFT RELOC?
JRST POPLNG ;LONG
MOVEI TAC, ;GET FLAGS
PUSHJ P,HALOUT ;PUT OUT
MOVE TAC,-1(FS) ;GET WORD
DPB T,[POINT 2,TAC,17];DEPOSIT RELOC
JRST HALOUT ;PUT OUT HALFWORD & RETURN
POPLNG: LDB N,[POINT 2,T,32];GET LEFT RELOC
MOVEI TAC,1
PUSHJ P,HALOUT
MOVS TAC,-1(FS)
HRL TAC,N
PUSHJ P,HALOUT ;PUT OUT LEFT HALF
HRRZ TAC,-1(FS) ;GET RIGHT HALF
DPB T,[POINT 2,TAC,17];DEPOSIT RELOC
JRST HALOUT ;PUT IT OUT & RETURN
POPUN: MOVEI TAC,2
PUSHJ P,HALOUT
MOVE N,-1(FS) ;GET POINTER
MOVE FS,(N) ;GET SIXBIT
PUSHJ P,R5CON ;CON TO RADIX50
TLO FS,40000 ;MARK AS EXTERNAL (POLISH TYPE)
HLRZ TAC,FS ;PUT OUT LEFT HALF
PUSHJ P,HALOUT
HRRZ TAC,FS ;PUT OUT RIGHT HALF...
JRST HALOUT ;AND RETURN
BEND
SUBTTL ASSMBL -- ASSEMBLES A LINE & RETURNS VALUE
; CALLED IN A STRANGE FASHION BECAUSE IT IS
; RECURSIVE AND A CO-ROUTINE
BEGIN ASSMBL
↑NONEM←←10 ;TEMP BIT USED TO MAKE NONZERO INDICATION
↑RBARET:TRO TRBF ;TERM BY ]
TRNE NOFXF ;NO FIXUPS?
JRST ARET ;YES, DONT LIST
SKIPE WRD+1
PUSHJ P,BLOUT
↑ARET: RETN
↑ASSMBL:TDZ[XWD OPFLG!AUNDF,ADFL!TRBF!IOSW]
SETZM WRD ;CLEAR WRD
SETZM WRD+1
LOOP1:
LOOP2: SKIPN WRD+1 ;EMPTY SO FAR?
TRO FLFXF ;YES, TELL MEVAL TO GENERATE FULL WORD FIXUPS
PUSHJ P,MEVAL ;GET NEXT THING
TRZ FLFXF
TLNE SOPF ;OPCODE?
JRST OPCD ;YES
TLNE ESPF ;SPC CHR?
JRST SPCL ;YES
TLNE PAWF ;()?
JRST IXFLD ;YES
TRNE B,COMF ;TERM BY ,?
JRST ACFLD ;YES
TROE ADFL ;ALREADY GOT AN ADDRESS?
JRST LERRA ;YES
TLNE UNDF ;DEFINED?
TLO AUNDF ;NO
SKIPN WRD+1 ;ANYTHING YET?
JRST EMP ;NO
HRRM N,WRD ;DEPOSIT AS ADDRESS
ANDI NA,1 ;GET RELOCATION
LOOP69: ORM NA,WRD+1 ;DEPOSIT
JRST LOOP2
EMP: MOVEM N,WRD ;DEPOSIT VALUE
HLL NA, ;GET AUNDF FLAG (MEANS FW FIXUP GENERATED)
AND NA,[AUNDF,,5] ;ISOLATE FLAG & RELOCATION
TLO NA,NONEM ;SET "NON EMPTY"
MOVEM NA,WRD+1 ;DEPOSIT
JRST LOOP2
LERRA: ERROR[ASCIZ/TWO ADDRESS FIELDS OR UNDEF OPCODE/]
JRST LOOP1 ;NO OR NO
OPCD: SKIPN XCRFSW ;CREF?
JRST OPCD2
MOVE FS,1(PN) ;PN STILL POINTS TO ENTRY, GET FLAGS
JUMPL FS,ORDOP
TLNN FS,20 ;IS IT REGULAR TYPE?
JRST ORDOP ;YES
HRRZ FS,2(PN) ;BLOCK BITS
JUMPE FS,ORDOP
CREF6 5,(PN) ;OPDEF, PUT OUT AS MACRO
SKIPA
ORDOP: CREF7 3,L ;YES
OPCD2: TLNE PSOPF ;PSEUDO OP?
JRST (NA) ;YES
↑OPCDR: MOVEM N,WRD ;DEPOSIT IN WRD
TLO NA,NONEM ;SET NON-EMPTY
MOVEM NA,WRD+1 ;DEPOSIT
JRST LOOP2
IXFLD: TLNE UNDF ;DEFINED?
ERROR[ASCIZ/UNDEFINED INDEX FIELD/]
MOVSS N
TRNE N,-1 ;RIGHT HALF ZERO?
TRON ADFL ;GOT AN ADDRESS?
SKIPA
TRZ N,-1 ;YES
ORM N,WRD ;OR INTO WRD
TRZE NA,17 ;RELOC?
ERROR [ASCIZ/RELOCATABLE INDEX FIELD/]
TLOA NA,NONEM ;SET "NON-EMPTY"
ACFL2: DPB N,[270400,,WRD] ;STORE AC FIELD
ACFL3: ORB NA,WRD+1 ;OR IN, GET OLD FLAGS
TLNE NA,AUNDF
ERROR [ASCIZ /AC OR INDEX FIELD CLOBBERED BY FIXUP/]
JRST LOOP1
ACFLD: PUSHJ P,SCAN1A ;GET NEXT
TRNE B,COMF ;ANOTHER ,?
JRST CCOM ;YES
TLNE UNDF ;DEFINED?
ERROR[ASCIZ/UNDEFINED AC FIELD/]
TRZE NA,17 ;RELOC?
ERROR[ASCIZ/RELOC AC FLD/]
TLO NA,NONEM ;SET "NON-EMPTY"
TRNN IOSW ;IO OP?
JRST ACFL2 ;NO
LSH N,-2
DPB N,[POINT 7,WRD,9]
JRST ACFL3
CCOM: TLZ SFL ;SKIP THE ,
SKIPE WRD+1 ;ANYTHING ASSEMBLED YET?
ERROR [ASCIZ /ILLEGAL ,,/] ;YES -- COMPLAIN
TLNN UNDF ;UNDEFINED?
JRST CCOM2 ;NO -- JUST STORE VALUE
TLO AUNDF ;YES -- TELL SOMEONE
JUMPL O,CCPOL ;HAVE WE SCREWED POLISH FIXUPS?
MOVE T,4(O) ;NO -- REGULAR
JUMPE NA,CCFOK ;OK IF NEW FIXUP CREATED
MOVEM N,3(O) ;RESTORE
MOVEM NA,4(O) ;OLD VALUE
MOVE NA,(O) ;LINKED TO WRONG THING -- GET OFFSET
TLO MLFT ;LET'S DO IT LEFT THIS TIME
PUSHJ P,CCFIX ;HAVE TO DO THIS OVER AGAIN
JRST CCOM2 ;NOW FINISH
CCFOK: MOVEI T,1 ;LH ONLY
DPB T,[(200)2(O)] ;FIX FLAGS
MOVE T,4(O) ;SEE IF
TLNN T,INCF ;IN CORE
JRST CCOM2 ;NO -- OK
MOVE T,3(O) ;YES -- WHERE?
CCRFX: SETZM (T) ;NO LONGER RH
MOVEM O,2(T) ;NOW LH REV PNTR
JRST CCOM2 ;NOW STORE
CCPOL: MOVEI T,1 ;LH ONLY
DPB T,[(200+O)] ;FIX FLAGS IN FIXUP
MOVE T,3(O) ;SEE WHAT IT'S FOR
TLNN T,INCF ;SOMETHING IN CORE?
JRST CCOM2 ;NO -- ALL DONE
MOVE T,2(O) ;YES -- FIND OUT WHERE
JRST CCRFX ;NOW FIX REV PNTRS
CCOM2: HRLM N,WRD ;STORE LH
DPB NA,[20200,,NA] ;MOVE RELOC BITS
TRZ NA,3 ;& FLUSH FROM RH
TLO NA,NONEM ;SOMETHING THERE
TLO OPFLG ;STOP OPCODE LOOKUP
JRST LOOP69 ;SET FLAGS & GO ON
SPCL: TLNE N,CRFG!LNFD;CR?
JRST SCR ;YES
TRNE N,ATF ;@?
JRST SAT
TLNE N,RBRF ;> OR ]?
JRST RBARET ;YES, RETURN
MOVSI NA,NONEM ;PREPARE TO MAKE NON-EMPTY
TRNE N,COMF ;IF COMMA
JRST LOOP69 ;CAUSE 18-BIT TRUNCATION
ERROR[ASCIZ/UNREC SPC CHR/]
JRST LOOP1
↑ASCR:
SCR: TRNE NOFXF ;NO FIXUPS TO BE GEN'D?
JRST .+3 ;YES, DON'T LIST BINARY
SKIPE WRD+1 ;ANYTHING?
PUSHJ P,BLOUT ;YES, DEPOSIT BINARY
TLNN N,LNFD ;LINE FEED?
PUSHJ P,SCNTIL ;NO, SKIP TO IT
JRST ARET
SAT: MOVSI N,20 ;GET @ BIT
MOVSI NA,NONEM ;GET NON-EMPTY BIT
ORM N,WRD ;DEPOSIT
ORM NA,WRD+1 ;...
JRST LOOP1
BEND
SUBTTL PSEUDO-OP ROUTINES
BEGIN POPS
↑%BLOCK:MOVE N,OPCNT+1 ;ILLEGAL IN LIT
TLNE N,INCF
JRST PSLIT
TRO NOFXF ;NO FIXUPS IF UNDEF
PUSHJ P,MEVAL ;GET VALUE
TRNN NA,17
TLNE ESPF!UNDF ;SPC. CHR?
JRST BERR ;YES
JUMPGE N,.+2
ERROR [ASCIZ/NEGATIVE ARGUMENT TO BLOCK/]
PUSHJ P,BFRC ;FORCE OUT BINARY
PUSHJ P,FXFRC ;FORCE OUT FIXUPS
ADDM N,PCNT ;ADD TO LOC CNTRS
ADDM N,OPCNT ;....
HRRZS PCNT
HRRZS OPCNT
SETZM WRD+1
SOS OPCNT
PUSHJ P,VBLOUT
AOS OPCNT
MOVE N,OPCNT
CAMGE N,BRK ;HIGH SEGMENT?
JRST .+5 ;NO,LOW SEG
CAMGE N,HICNT ;YES, IS OPCNT≥HICNT?
JRST .+5 ;NO
MOVEM N,HICNT ;YES,INCREMENT HIGH
JRST .+3
CAML N,@CURBRK ;IS OPCNT≥LOCNT?
MOVEM N,@CURBRK ;YES,INCREMENT LOW
JRST SPCFN
BERR: ERROR[ASCIZ/NOT EXPRESSION AFTER BLOCK/]
SETZM WRD+1
JRST SPCFN
↑%HISEG:SETZM WRD+1
SETOM SEG
MOVEI N,400000
MOVEM N,OPCNT
MOVEM N,PCNT
MOVEM N,DPCNT
HRRM N,HIBLK+2
MOVEI N,1
MOVEM N,OPCNT+1
MOVEM N,PCNT+1
MOVEM N,DPCNT+1
SETZM BRK
POUT 3,HIBLK
JRST SPCFN
HIBLK: XWD 3,1
XWD 200000,0
XWD 400000,400000
↑%TWOSEG:TRO NOFXF
SETOM SEG
PUSHJ P, MEVAL
MOVEM N,NA
SETZM WRD+1
TLNE ESPF ;ARGUMENT?
MOVEI N,400000 ;NO
TLNE UNDF ;YES. DEFINED?
JRST TWOERR ;NO. ERROR
HRRZM N,BRK
HRRM N,HIBLK+2
POUT 3,HIBLK ;YES
MOVE N,NA
TLNN ESPF
JRST SPCFN
JRST NSPCFN
TWOERR: ERROR[ASCIZ/TWOSEG ARGUMENT UNDEFINED./]
JRST SPCFN
↑%ASCII: TLZ SFL ;CLEAR SCAN AHEAD
MOVEM N,TM1 ;SAVE VALUE
HRRM C,TM2 ;SAVE TERM CHR.
MOVE C,TLBLK
MOVEM C,SVLIN
MOVE C,PGNM
MOVEM C,TXTPG
LOOP2: MOVEI N, ;CLEAR
MOVEI NA,5 ;COUNT
LOOP1: PUSHJ P,SCAN1 ;GET CHR.
TM2: CAIN C, ;TERM CHR?
JRST FND ;YES
LSH N,7 ;NO,SHIFT
OR N,C ;AND INSERT
SOJG NA,LOOP1 ;5 CHRS?
LSH N,1 ;YES
SKIPGE TM1 ;ASCID?
ORI N,1 ;YES
MOVEM N,WRD ;DEPOSIT VALUE
MOVSI N,NONEM ;PREPARE FLAGS
MOVEM N,WRD+1 ;DEPOSIT
PUSHJ P,BLOUT ;LIST BINARY
RETN ;RETURN
JRST LOOP2 ;CONTINUE
FND: SETZM TXTPG
CAIN NA,5 ;NONE IN THIS WORD?
JRST NONW ;YES, NONE
LSH N,7 ;ADJUST
SOJG NA,.-1 ;...
LSH N,1
SKIPGE TM1 ;ASCID?
ORI N,1 ;YES
MOVEM N,WRD ;DEPOSIT VALUE
LOP1: MOVSI N,NONEM
MOVEM N,WRD+1 ;SET FLAGS
↑SPCFN: TRZ NOFXF
PUSHJ P,SCAN1 ;GET CHR.
TLNN B,CRFG!RBRF; CR OR ] OR >?
JRST SPCFN ;NO
TLNE B,CRFG ;CR?
JRST SCR ;YES
TLNE B,RBRF ;> OR ]?
JRST RBARET ;YES
NONW: SETZM WRD ;ZERO WORD
SKIPLE TM1 ;ASCIZ?
JRST LOP1 ;YES, RETURN 0
SETZM WRD+1 ;"NOTHING ON LINE"
JRST SPCFN ;RETURN
↑SCR: SKIPE WRD+1
PUSHJ P,BLOUT
TLNN B,LNFD ;LF?
PUSHJ P,SCNTIL ;NO, GET TO IT
JRST ARET
TM1: 0
↑%XWD: TLO MLFT ;LEFT HALF
PUSHJ P,MEVAL
TLNE ESPF ;SPC CHR?
JRST XER ;YES
TRNN B,COMF ;TERM BY ,?
ERROR [ASCIZ/NO COMMA AFTER XWD OR BLANK FIELD/]
TRNE NA,14 ;LEFT HALF RELOC?
ERROR[ASCIZ/LEFT HALF OF EXPRESSION RELOCATABLE/]
PUSH P,N ;SAVE
PUSH P,NA ;SAVE
PUSHJ P,SCAN ;SKIP THE ,
TLNE B,CRFG!RBRF ;NOTHING MORE?
JRST [ SETZB N,NA ;INDEED -- THINK UP 0
JRST XWD3] ;FOR RIGHT HALF
TLZ MLFT ;NO LONGER LEFT HALF
PUSHJ P,MEVAL
TLNE ESPF ;SPC CHR?
JRST XERQ ;YES
TRNE NA,14 ;LEFT HALF RELOC?
ERROR[ASCIZ/LEFT HALF OF EXPRESSION RELOCATABLE/]
XWD3: TLO NA,NONEM
MOVEM N,WRD ;DEPOSIT VALUE
MOVEM NA,WRD+1
POP P,NA ;GET BITS
DPB NA,[POINT 2,WRD+1,33];DEPOSIT RELOC
POP P,NA ;GET VALUE
HRLM NA,WRD ;DEPOSIT
JRST SPCFN
XERQ: SUB P,[2(2)]
XER: ERROR[ASCIZ/NO EXPRESSION AFTER XWD/]
↑NSPCFN:TLNN N,CRFG!RBRF;CR RET?
JRST SPCFN ;NO
TRZ NOFXF
TLNE N,CRFG ;CR?
JRST ASCR
JRST RBARET
↑%LIT: MOVE N,OPCNT+1
TLNE N,INCF
JRST PSLIT ;NOT IN LIT
PUSHJ P,LITOUT
SETZM WRD+1
JRST SPCFN
↑%RADIX:TRO NOFXF
PUSHJ P,MEVAL ;GET VALUE
TRNN NA,17
TLNE ESPF!UNDF ;SPC. CHR?
BEGIN RAD
JRST RERR ;YES
PUSHJ P,RADX ;SET RADIX
SETZM WRD+1
JRST SPCFN
RERR: ERROR[ASCIZ/NOT EXPRESSION AFTER RADIX/]
TLNE ESPF
JRST NSPCFN
JRST SPCFN
BEND
↑RADX: MOVE NA,[IMULI N,];PREPARE INSTRUCTION
HRR NA,N
CAIN N,10 ;OCTAL?
MOVE NA,[LSH N,3];YES
MOVEM NA,SRAD ;SET RADIX
POPJ P,
↑%CON: MOVE TAC,SRAD ;SAVE CURRENT RADIX
BEGIN CON
MOVEM TAC,SVRAD
PUSHJ P,RADX ;SET RADIX
MOVSI N,NONEM
MOVEM N,WRD+1
LOP: PUSHJ P,SCANM ;GET NUM
TLNN NFLG ;NUM?
JRST CERR ;NO
MOVEM N,WRD ;DEPOSIT NUMBER
TRNN B,COMF ;TERM BY ,?
JRST LAST ;NO, LAST ONE
PUSHJ P,BLOUT ;PRINT BINARY
RETN ;RETURN THIS ONE
TLZ SFL ;SKIP THE ,
JRST LOP
CERR: ERROR[ASCIZ/NOT A NUMBER/]
LAST: MOVE TAC,SVRAD ;RESTORE RADIX
MOVEM TAC,SRAD
JRST SPCFN
SVRAD: 0
BEND
↑%IO: TRO IOSW ;TURN ON IO SWITCH
MOVEI NA, ;CLEAR OUT BITS
JRST OPCDR ;PROCEED
↑PHAZ: MOVE N,OPCNT+1
TLNE N,INCF
JRST PSLIT
TRO NOFXF
PUSHJ P,MEVAL ;GET VALUE
TLNE UNDF!ESPF ;DEFINED?
JRST PERR ;NO
MOVEM N,PCNT ;DEPOSIT VALUE...
MOVEM NA,PCNT+1 ;...
JRST SPCFN
PERR: ERROR[ASCIZ/UNDEFINED OR SPECIAL CHR -- PHASE/]
JRST SPCFN
↑PSLIT: ERROR [ASCIZ /ILLEGAL PSEUDOOP IN LITERAL/]
SETZM WRD+1
JRST SPCFN
↑DPHAZ: MOVE N,OPCNT+1
TLNE N,INCF
JRST PSLIT
MOVE N,[XWD OPCNT,PCNT]
BLT N,PCNT+1
JRST SPCFN
↑%LIST: JUMPE N,LST1 ;LIST?
JUMPG N,LST2 ;XLIST1?
TRZ LDEV ;TERMINATE LISTING
JRST SPCFN
LST2: SKIPN XL1IG ;/I SWITCH?(IGNORE XLIST1)
TRZ LDEV
JRST SPCFN
LST1: SKIPE LISTSW ;DEVICE EXIST?
TRO LDEV ;YES, START LISTING
JRST SPCFN
↑%COMM: PUSHJ P,SLURPC ;EAT EVERYTHING UP TO MATCHING CHAR
JRST SPCFN
↑%BYTE: TRNN B,LFPF ;( NEXT?
JRST BERR1 ;NO
SETZM WRD
TRO NOFXF ;NO FIXUPS
MOVE N,[POINT 3,WRD]
MOVEM N,PNTR
PARLOP: PUSH P,SRAD ;SAVE RADIX
MOVEI N,12
PUSHJ P,RADX ;CONVERT TO DEC.
PUSHJ P,MEVAL ;GET VALUE
TLNN PAWF ;()?
ERROR[ASCIZ/AMBIGUITY ERROR/]
TLNE UNDF!ESPF ;UNDEF OR SPC CHR?
ERROR[ASCIZ/UNREC OR UNDEF SIZE/]
TRNE NA,17 ;RELOC FIELD?
ERROR[ASCIZ/RELOC SIZE/]
POP P,SRAD ;RESTORE RADIX
DPB N,[POINT 6,PNTR,11];DEPOSIT SIZE
TRNE B,LFPF ;( NEXT?
JRST PARLOP ;YES
TRNE B,COMF ;, NEXT?
JRST NULF ;YES
BLOP: PUSHJ P,MEVAL ;GET NEXT BYTE
TLNE UNDF ;UNDEF?
ERROR[ASCIZ/UNDEF BYTE/]
TRNE NA,17 ;RELOC?
ERROR[ASCIZ/RELOC BYTE/]
TLNE ESPF ;SPC CHR?
ERROR[ASCIZ/SPC. CHR. IN BYTE FIELD/]
DBYT: IDPB N,PNTR ;DEPOSIT
HRRZ NA,PNTR ;DID WE ADVANCE...
CAIE NA,WRD ;TO NEXT WORD?
JSR GOTWRD ;YES
TRNN B,COMF ;, NEXT?
JRST NOCOM ;NO
PUSHJ P,SCAN ;GET THE ,
TRNE B,COMF ;, NEXT?
JRST NULF ;YES
TRNN B,LFPF ;( NEXT?
JRST BLOP ;NO
NULF: SETZB N,NA ;ZERO BYTE
JRST DBYT
NOCOM: TRNE B,LFPF ;(NEXT?
JRST PARLOP ;YES
MOVSI N,NONEM
MOVEM N,WRD+1
TRZ NOFXF ;RESTORE
JRST SPCFN ;LEAVE, THROUGH
GOTWRD: 0
MOVSI N,NONEM ;MARK WRD+1...
EXCH N,WRD+1 ;AND GET NEXT BYTE...
MOVEM N,NSAV ;& SAVE
PUSHJ P,BLOUT ;LIST BINARY
RETN ;RETURN THIS WORD
MOVE N,NSAV
MOVEM N,WRD ;GET SAVED BYTE
SOS PNTR ;ADJUST PNTR
JRST @GOTWRD
BERR1: ERROR[ASCIZ/NOT SIZE FIELD AFTER BYTE/]
JRST SPCFN
PNTR: 0
NSAV: 0
↑%POINT:PUSH P,SRAD ;SAVE CURRENT RADIX
MOVEI N,12
PUSHJ P,RADX ;SET RADIX TO DEC.
TRO NOFXF ;NO FIXUPS THIS FIELD
PUSHJ P,MEVAL
TRNN NA,17
TLNE UNDF!ESPF ;SPC CHR. OR UNDEF?
JRST PER1 ;YES
POP P,SRAD ;RESTORE RADIX
SETZM WRD
SETZM WRD+1
DPB N,[POINT 6,WRD,11];DEPOSIT SIZE
TRNN B,COMF ;, NEXT?
JRST PER2 ;NO
TLZ SFL ;SKIP THE ,
PPT3: TRZ ADFL!NOFXF ;FIXUPS OK NOW
PLOP: PUSHJ P,MEVAL ;GET NEXT EXPR.
TLNE ESPF ;SPC. CHR?
JRST PSPC ;YES
TLNE PAWF ;()?
JRST PAWT ;YES
TROE ADFL ;GOT AN ADDRESS ALREADY?
JRST LERR ;YES
HRRM N,WRD ;DEPOSIT ADDRS.
ORM NA,WRD+1 ;DEPOSIT RELOC
PPT: TLNE B,CRFG!RBRF ;CR OR ] OR >?
JRST PEND ;YES
TRNN B,COMF ;TERM BY ,?
JRST PLOP ;NO
TLZ SFL ;SKIP THE ,
PPT2: MOVSI NA,NONEM
ORM NA,WRD+1
TRO NOFXF
PUSH P,SRAD ;SAVE RADIX
MOVEI N,12
PUSHJ P,RADX ;SET TO DEC.
PUSHJ P,MEVAL ;GET VALUE
TRNN NA,17
TLNE ESPF!UNDF ;SPC CHR. OR UNDEF?
JRST PER3 ;YES
MOVNS N ;INVERT & ADD...
ADDI N,43 ;43
DPB N,[POINT 6,WRD,5] ;& DEPOSIT
PPT1: POP P,SRAD
TRZ NOFXF
JRST SPCFN
PAWT: MOVSS N ;SWAP HALVES
TRNE NA,17 ;RELOC?
ERROR[ASCIZ/RELOC INDEX FIELD/]
TLZ N,777760 ;CLEAR PART
ORM N,WRD ;OR IN
TLNE UNDF ;DEFINED?
ERROR[ASCIZ/UNDEF INDEX FIELD/]
JRST PPT
PSPC: TRNE N,COMF ;,?
JRST PPT2 ;YES
TRNE N,ATF ;@?
JRST PSAT ;YES
ERROR[ASCIZ/UNREC SPC CHR/]
JRST PPT
PSAT: MOVSI N,20 ;GET @ BIT
ORM N,WRD ;DEPOSIT
JRST PPT
PEND: MOVEI NA,44 ;GET 44
DPB NA,[POINT 6,WRD,5];DEPOSIT AS POSITION
MOVSI NA,NONEM ;MARK NONEMPTY
ORM NA,WRD+1
JRST SPCFN
PER1: ERROR[ASCIZ/UNREC, UNDEF, OR RELOC SIZE/]
JRST PPT1
PER2: ERROR[ASCIZ/NO COMMA AFTER SIZE/]
JRST PPT3
PER3: ERROR[ASCIZ/UNREC, UNDEF, OR RELOC POSITION/]
JRST PPT1
LERR: ERROR[ASCIZ/UNREC SYNTAX/]
JRST PPT
↑%SIX: TLZ SFL ;SKIP CHR.
MOVEM N,TM1 ;SAVE VALUE (OF OP)
HRRM C,TM3 ;SAVE TERM CHR.
MOVE C,TLBLK
MOVEM C,SVLIN
MOVE C,PGNM
MOVEM C,TXTPG
LOPS2: MOVEI N, ;CLEAR
MOVEI NA,6 ;COUNT
LOPS1: PUSHJ P,SCAN1 ;GET CHR.
TM3: CAIN C, ;TERM CHR?
JRST SFND ;YES
LSH N,6 ;NO, SHIFT
TRZN C,100 ;CONVERT...
TRZA C,40 ;TO...
TRO C,40 ;SIXBIT
OR N,C ;INSERT
SOJG NA,LOPS1 ;6 CHRS?
MOVEM N,WRD ;YES
MOVSI NA,NONEM ;PREPARE FLAGS
MOVEM NA,WRD+1 ;DEPOSIT
PUSHJ P,BLOUT ;LIST BINARY
RETN ;RETURN WRD
JRST LOPS2
SFND: SETZM TXTPG
CAIN NA,6 ;NONE IN THIS WORD?
JRST SNON ;NONE
LSH N,6 ;ADJUST
SOJG NA,.-1 ;...
MOVEM N,WRD ;DEPOSIT VALUE
MOVSI NA,NONEM ;AND...
MOVEM NA,WRD+1 ;FLAGS
JRST SPCFN ;RETURN
SNON: SETZM WRD+1
JRST SPCFN
↑%OPDEF:PUSHJ P,SCAN ;GET SIXBIT
TLNN IFLG ;IDENT?
JRST OPERR1 ;NO
PUSH P,L ;SAVE SIXBIT
PUSHJ P,SCAN ;GET NEXT
TLNN SCFL ;SPC. CHR?
JRST .-2 ;NO
TLNN N,LBRF ;[ OR <?
JRST .-4 ;NO
TRO NOFXF ;YES, NO FIXUPS
ACALL
TLNE AUNDF ;DEFINED?
JRST OPERR2 ;NO
TRZN TRBF ;TERM BY ] OR >?
ERROR[ASCIZ/UNREC TERMINATION CHR. -- OPDEF/]
POP P,L ;GET SIXBIT
MOVE N,L
IDIVI N,HASH ;HASH
MOVM NA,NA
SKIPN PN,OPCDS(NA)
JRST OPDF2
SRC2 L,PN,OPDFF ;CHECK FOR OLD DEF
OPDF2: GFST PN,FSTPNT
MOVEM L,(PN) ;DEPOSIT SIXBIT
MOVSI N,20
HRR N,OPCDS(NA);INSERT...
EXCH N,1(PN) ;IN LIST
MOVEM PN,OPCDS(NA)
MOVEM N,FSTPNT
MOVE N,BLOCK
MOVEM N,2(PN) ;SET BLOCK BIT
OPDF3: MOVSI N,WRD
HRRI N,3(PN)
BLT N,4(PN) ;DEPOSIT VALUE
OPDF4: SKIPE XCRFSW
CREF6 6,(PN)
PUSHJ P,LBLOUT
TRZ NOFXF
SETZM WRD+1
JRST SPCFN
OPERR1: ERROR[ASCIZ/NO IDENTIFIER AFTER OPDEF/]
JRST .+2
OPERR2: ERROR[ASCIZ/VALUE OF OPDEF MUST BE DEFINED -- USE A MACRO/]
SETZM WRD+1
JRST SPCFN
;HERE IF OLD DEF EXISTS
OPDFF: REPEAT 0,< ;LEAVE THIS HACK OUT UNTIL RAID IS FIXED
OPDFF: MOVEI O,(NA) ;SAVE HASH
PUSHJ P,OPVAL ;GET OLD VAL
TLO NA,NONEM
CAMN N,WRD
CAME NA,WRD+1
SKIPA NA,O
JRST OPDF4 ;OLD VAL SAME - DON'T DO MUCH
> SKIPL N,1(PN) ;CHECK TYPE OF OLD
TLNN N,20
JRST OPDF2 ;OLD IS PERMANENT - MUST INSERT NEW
HRRZ T,2(PN)
CAME T,BLOCK
JRST OPDF2 ;DIFFERENT BLOCK - INSERT NEW
JRST OPDF3 ;SAME BLOCK - JUST CLOBBER VAL
DEFINE TIT $(TITCNT,Q,EXTRA,X1)
< MOVE T,[POINT 7,TITCNT+1]
IFN X1,<TLOP: PUSHJ P,SCAN1 ;GET CHR.
JUMPGE B,TPOL ;NUM OR LET?
LSH FS,6 ;CON TO SIXBIT...
ORI FS,(B) ;...
TLNE FS,770000 ;6 CHRS?
JRST TPOL ;YES
IDPB C,T ;NO
JRST TLOP
TPOL: AOSE TITLSW
ERROR [ASCIZ /EXTRA TITLE STATEMENT/]
SKIPL RPGSW
JRST TPOL1
PUSH P,C
PUSH P,T
IDPB C,T
MOVEI C,15
IDPB C,T
MOVEI C,12
IDPB C,T
MOVEI C,0
IDPB C,T
ITS,< OUTSTR [ASCIZ /FAIL: /] >
OUTSTR TITCNT+1
POP P,T
POP P,C
TPOL1: MOVEM FS,BNAM ;DEPOSIT BLOCK NAME
MOVEM FS,LSTLAB+3
PUSHJ P,R5CON ;CON TO RAD 50
MOVEM FS,.+5
POUT 4,.+2
JRST TLOP$Q+1
XWD 6,2
0
0
0
>
TLOP$Q: PUSHJ P,SCAN1 ;GET CHR.
TLNE B,CRFG ;CR?
JRST .+3 ;YES
IDPB C,T ;DEPOSIT
JRST TLOP$Q
EXTRA
MOVEI N,
REPEAT 5,< IDPB N,T>
SUBI T,TITCNT+1 ;FORM COUNT
MOVNS T ;NEGATE
HRLM T,TITCNT ;DEPOSIT
JRST SCR
>
↑%TITLE:MOVEI FS,
TIT(TITCNT,1,,1)
↑%SUB: TIT(SUBCNT,A,<MOVEI N,15
IDPB N,T
MOVEI NA,12
IDPB NA,T
IDPB N,T
IDPB NA,T>,0)
↑%GLOB: PUSHJ P,SCANM ;GET IDENT
TLNN IFLG ;IDENT?
JRST NOIG ;NO
MOVE N,L ;GET SIXBIT
IDIVI N,HASH ;HASH
MOVMS NA
SKIPN PN,SYMTAB(NA);GET POINTER
JRST GER1 ;NONE
GSR: SRC1(L,PN,FNDG,JRST GER1)
GER1: ERROR[ASCIZ/GLOBAL -- NO PREVIOUS DEFINITION/]
JRST CONTG
FNDG: MOVE N,2(PN) ;GET FLAGS
TLNE N,UDSF ;UDEFINED-DEFINED IS GOOD ENOUGH
JRST GLDEF
TLNE N,DEFFL ;DEFINED?
JRST GSR+2 ;NO, TRY AGAIN
GLDEF: OR N,BLOCK ;TURN ON BLOCK BIT
TLNN N,DAF ;DOWN ARROW?
TLO N,GLOBF ;NO, SET GLOBAL
MOVEM N,2(PN) ;RESTORE FLAGS
CONTG: TRNN B,COMF ;, NEXT?
JRST SPCFN ;NO, DONE
TLZ SFL ;SKIP THE ,
JRST %GLOB ;CONTINUE
NOIG: ERROR[ASCIZ/NOT IDENT AFTER GLOBAL/]
JRST NSPCFN
↑%EXT: PUSHJ P,SCANS ;GET IDENT
TLNN IFLG ;IDENT?
JRST NOIE ;NO
MOVE T,2(PN) ;GET FLAGS
TLNN T,DEFFL ;DEFINED?
JRST EER1 ;YES
TLNE T,INTF
JRST EER2
TLO T,EXTF ;TURN ON EXT FLAG
MOVEM T,2(PN) ;DEPOSIT
CONTE: TRNN B,COMF ;, NEXT?
JRST SPCFN ;NO, DONE
TLZ SFL ;SKIP THE ,
JRST %EXT
EER1: ERROR[ASCIZ/EXTERNAL -- ALREADY DEFINED/]
JRST CONTE
EER2: ERROR [ASCIZ /EXTERNAL -- ALREADY INTERNAL/]
JRST CONTE
NOIE: ERROR[ASCIZ/NOT IDENT AFTER EXTERN/]
JRST NSPCFN
↑%INT: PUSHJ P,SCANS ;GET IDENT
TLNN IFLG ;IDENT?
JRST NOII ;NO
MOVE T,2(PN)
TLNE T,EXTF
JRST IER1
TLO T,INTF
MOVEM T,2(PN)
CONTI: TRNN B,COMF ;, NEXT?
JRST SPCFN ;NO
TLZ SFL ;YES, SKIP THE ,
JRST %INT
IER1: ERROR [ASCIZ /INTERNAL -- ALREADY EXTERNAL/]
JRST CONTI
NOII: ERROR[ASCIZ/NOT IDENT AFTER INTERN/]
JRST NSPCFN
↑%PAGE: MOVEI TAC,14
IDPB TAC,LSTPNT
JRST SPCFN
↑%LALL: JUMPL N,LAL
SETZM NOEXP
JRST SPCFN
LAL: SETOM NOEXP
JRST SPCFN
↑%NOSYM:SETZM SYMOUT
JRST SPCFN
↑%NOLIT:SETOM NOLTSW
JRST SPCFN
↑%INTEG:PUSHJ P,SCANS ;GET A SYMBOL
TLNN IFLG
JRST NOII2 ;NOT IDENT
MOVE T,2(PN)
TLON T,UDSF!VARF ;SET FLAGS
TLNN T,DEFFL
JRST NXT ;BUT IGNORE IF DEFINED
MOVEM T,2(PN)
GFST TAC,FSTPNT ;GET FREE BLOCK
MOVE T,VARLST
MOVEM TAC,VARLST
EXCH T,1(TAC)
MOVEM T,FSTPNT
MOVEM PN,(TAC)
SETZM 2(TAC) ;ONE WORD
NXT: TRNN B,COMF ;IS IT A COMMA NEXT
JRST SPCFN ;GO AWAY
TLZ SFL ;GET PAST IT
JRST %INTEG ;AND TRY FOR MORE
NOII2: ERROR [ASCIZ /NOT IDENT AFTER INTEGER/]
JRST NSPCFN
↑%ARAY: SETZM ARCNT# ;NUMBER OF THINGS PUSHED INTO STACK
%ARAY1: PUSHJ P,SCANS ;GET A SYMBOL
TLNN IFLG
JRST NOAR ;NOT IDENT SO LOSE
MOVE T,2(PN) ;CHECK FLAGS
TLON T,UDSF!VARF
TLNN T,DEFFL
ERROR [ASCIZ /ARRAY NAME ALREADY DEFINED/]
MOVEM T,2(PN) ;BUT THEM BACK
GFST TAC,FSTPNT
MOVE T,VARLST
MOVEM TAC,VARLST
EXCH T,1(TAC)
MOVEM T,FSTPNT
MOVEM PN,(TAC)
PUSH P,TAC
AOS ARCNT
TLNE B,LBRF ;CHECK FOR < OR [
TRNN B,TP1F ;AND THEN MAKE SURE OF [
JRST ARR3
TLZ SFL ;STOP SCANNING AHED
TRO NOFXF
PUSHJ P,MEVAL
TRNN NA,17
TLNE UNDF!ESPF ;CHECK SPECIAL OR UNDEF
JRST ARAYER
SUBI N,1 ;STORE ONE LESS
ARRY: POP P,TAC ;GET BACK A POINTER
MOVEM N,2(TAC)
SOSLE ARCNT
JRST ARRY ;GET MORE
TLNE B,RBRF
TRNN B,TP1F
JRST ARR2
PUSHJ P,SCAN
TRNN B,COMF
JRST SPCFN
TLZ SFL
JRST %ARAY
ARR3: TRNN B,COMF
JRST ARR1
TLZ SFL
JRST %ARAY1 ;GO GET ANOTHER NAME
ARR1: ERROR [ASCIZ /NO [ AFTER ARRAY/]
JRST COMAER ;GO GET STUFF OFF STACK
ARAYER: ERROR [ASCIZ /NO EXPRESSION AFTER [ - ARRAY/]
JRST COMAER
ARR2: ERROR [ASCIZ /NO ] AFTER ARRAY/]
JRST COMAER
NOAR: ERROR [ASCIZ /NOT IDENT AFTER ARRAY/]
JRST COMAER
POP P,TAC
COMAER: SOSL ARCNT
JRST .-2
JRST NSPCFN
↑%ENTRY:SKIPE CODEM ;WAS CODE EMITTED?
BEGIN ENTRY
ERROR [ASCIZ /ENTRY AFTER CODE EMITTED/]
PUSH P,BC ;USE THIS REGISTER AS AOBJN POINTER
MOVE BC,[XWD -=18,ENTBLK] ;FOR STORING ENTRIES
ENTR1: PUSHJ P,SCANS ;FIND A SYMBOL
TLNN IFLG ;WAS THERE A SYMBOL THERE?
JRST NOII ;NO, GIVE ERROR
MOVSI T,INTF ;SET AS INTERNAL
ORM T,2(PN) ;INTO FLAGS
MOVE FS,(PN) ;GET THE SIXBIT FOR THIS ONE
PUSHJ P,R5CON ;CONVERT TO RADIX50
MOVEM FS,(BC) ;PUT INTO ENTRY BLOCK
AOBJP BC,EMIT ;PUT OUT BLOCK IF OUT OF ROOM
GOENT: TRNN B,COMF ;COMMA FOLLOWING?
JRST ENDENT ;ALL DONE
TLZ SFL ;SET TO IGNORE COMMA
JRST ENTR1 ;AND GET MORE
ENDENT: HLRZ TAC,BC ;GET THE CURRENT COUNT
CAIN TAC,-=18 ;SEE IF ANY HAVE BEEN PUT IN
JRST FINENT ;NO, MUST HAVE BEEN A MULTIPLE OF 18
ADDI TAC,=18 ;GET COUNT (IF YOU IGNORE LEFT HALF
HRRM TAC,ENTWHO ;PUT IN BLOCK HEADER
ADDI TAC,2
MOVNS TAC
HRLM TAC,ENTHD ;AND -COUNT INTO OUTPUT POINTER
BBOUT ENTHD ;DO THE OUTPUT
FINENT: POP P,BC ;RESTORE THIS
SETZM WRD+1 ;TELL THEM NOTHING THERE
JRST SPCFN ;FINISH UP LINE
NOII: ERROR [ASCIZ /NOT IDENT AFTER ENTRY/]
JRST FINENT ;FINISH UP
EMIT: MOVE TAC,[XWD -=20,ENTWHO] ;AMOUTN TO DUMP
MOVEM TAC, ENTHD
MOVEI TAC,=18 ;NUMBER OF WORDS IN THE BLOCK
HRRM TAC,ENTWHO ;INTO BLOCK HEADER
BBOUT ENTHD ;OUTPUT IT
MOVE BC,[XWD -=18,ENTBLK]
JRST GOENT ;AND CONTINUE
ENTHD: ENTWHO
ENTWHO: XWD 4,0
0 ;RELOCATION BITS
ENTBLK: BLOCK =18
BEND ENTRY
↑%ENDL: PUSHJ P,BFRC ;FOURCE OUT BINARY
PUSHJ P,FXFRC ;AND FIXUPS
TRO NOFXF
PUSHJ P,MEVAL
MOVNS N ;USE NEGATIVE OF NUMBER
JRST LINK1 ;GO CHECK AND GET REST OF JUNK
↑%LINK: PUSHJ P,BFRC ;FORC OUT
PUSHJ P,FXFRC
TRO NOFXF
PUSHJ P,MEVAL
LINK1: TLNN ESPF!UNDF
TRNE NA,17 ;IF SPECIAL CHR OR UNDEF EXPR
JRST LNKERR ;GIVE ERROR MESSAGE
MOVEM N,LNKNUM ;STORE NUMBER FOR OUTPUT
TRNN B,COMF ;THERE SHOULD BE A COMMA THERE
ERROR [ASCIZ /NO COMMA AFTER LINK NUMBER/]
TLZ SFL ;SKIP THE COMMA
PUSHJ P,MEVAL ;GET THE ADDRESS
TLNE UNDF!ESPF
JRST LNKERR ;UNDEF OR SPECIAL NOT PERMITTED
DPB NA,[POINT 1,LKRLC,3] ;PUT IN RELOC BIT
HRRZM N,LNKADR ;AND ADDRESS
POUT 4,LNKBLK ;OUTPUT IT
SKIPA
LNKERR: ERROR [ASCIZ /NOT EXPRESSION AFTER LINK OR LINKEND/]
SETZM WRD+1 ;RETURN NOTHING
JRST SPCFN ;DONE
LNKBLK: XWD 12,2 ;HEADER
LKRLC: 0 ;RELOC BITS
LNKNUM: 0 ;NUMBER OR LINK
LNKADR: 0 ;ADDRESS OF LINK
↑%RAD5: TRO NOFXF
PUSHJ P,MEVAL ;GET NUMBER
TRNN NA,17
TLNE UNDF!ESPF ;IF UNDEF OR SPECIAL CHR
JRST RAD5ER
TRNN B,COMF
ERROR [ASCIZ /NO COMMA AFTER RADIX50/]
LSH N,-2 ;JUSTIFY
DPB N,[POINT 4,WRD,3] ;SAVE IN WORD
TLZ SFL ;IGNORE COMMA
PUSHJ P,SCAN ;GET IDENT
TLNN IFLG
ERROR [ASCIZ /NO IDENT AFTER RADIX50/]
MOVE FS,L ;GET SIXBIT
PUSHJ P,R5CON ;AND CONVERT
IORM FS,WRD ;PUT IN
MOVSI N,NONEM ;THERE IS SOMETHING THERE
MOVEM N,WRD+1 ;WITH NO RELOC
JRST SPCFN ;AND AWAY WE GO
RAD5ER: ERROR [ASCIZ /NOT EXPRESSION AFTER RADIX50/]
SETZM WRD+1
JRST SPCFN
↑%ONCRF:SKIPE CREFSW
SETOM XCRFSW
JRST SPCFN
↑%OFCRF:SETZM XCRFSW
JRST SPCFN
BEND
SUBTTL THIS HERE IS THE ASSEMBLER !!!!!!!!!
;MAIN: THIS HERE IS THE ASSEMBLER
MAINQ: MOVE N,PCNT+1 ;GET RELOC
MOVEM N,DPCNT+1 ;AND SET RELOC OF .
MOVE N,PCNT
MOVEM N,DPCNT
MAIN: TLZ OPFLG!MLFT
ACALL ;CALL ASSMBL
SKIPN WRD+1 ;ANYTHING ON LINE?
JRST MAINQ ;NO, NOTHING
OUTP WRD ;OUTPUT THE STUFF
AOS OPCNT ;INCREMENT
MOVE N,OPCNT
CAMGE N,BRK ;HIGH SEGMENT?
JRST .+5 ;NO,LOW SEGMENT
CAMGE N, HICNT ;YES. IS OPCNT≥HICNT?
JRST .+5 ;NO
MOVEM N,HICNT ;YES. INCREMENT HIGH
JRST .+3
CAML N,@CURBRK ;IS OPCNT≥LOCNT?
MOVEM N,@CURBRK ;YES, INCREMENT LOW
AOS N,PCNT ;INCREMENT
MOVEM N,DPCNT ;SET ADDRESS OF .
SKIPN N,POLPNT ;ANY POLFIXES FOR NOW?
JRST MAIN ;NO
SETZM POLPNT ;CLEAR POINTER
PUSHJ P,BFRC ;FORCE OUT BIN
MAINL: MOVEI FS,5(N) ;SET UP POINTER
MOVE NA,1(N) ;GET NEXT PNTR.
PUSHJ P,POLOUT ;PUT OUT POLFIX
SKIPN N,NA ;ANY MORE?
JRST MAIN ;NO
JRST MAINL ;YES
SUBTTL UUO HANDLER AND OUTPUT ROUTINES
;UUO HANDLER IS HERE
BEGIN UUO
↑UUO: 0
NOITS,<
LDB TAC,[POINT 5,40,8] ;GET UUO #
PUSHJ P,@UUOTB(TAC) ;CALL ROUTINE
JRST @UUO
>;NOITS
ITS,<
↑↑UUOCON←UUO
PUSH P,2
LDB 2,[POINT 5,40,8] ;GET UUO #
SKIPGE UUOTB(2)
JRST [ POP P,USAVEA
MOVEM P,USAVEP
JRST @UUOTB(2)] ;DIFFERENT CALL FOR SIMULATOR
MOVE TAC,2
POP P,2
PUSH P,40
PUSH P,UUO
POP P,LSUUPC
POP P,LSUUO
PUSHJ P,@UUOTB(TAC) ;CALL ROUTINE
JRST @UUO
↑↑UUOXIT:
MOVE 2,UUO
MOVEM 2,UUORET
MOVE 2,LSUUO ;RESTORE IN CASE USER UUO WAS IN PROGRESS
MOVEM 2,40
MOVE 2,LSUUPC
MOVEM 2,UUO
MOVE P,USAVEP ;RESTORE AC'S
MOVE 2,USAVEA
MOVE 3,USAVEB
MOVE 4,USAVEC
MOVE 5,USAVED
MOVE 6,USAVEE
JRST 2,@UUORET ;RETURN
>;ITS
UUOTB:
;UUO DISPATCH TABLE
NOITS,<
FOR I←0,10
<ILUUO
>
UERR
UFAT
UFOUT
UOUTP
UPOUT
UTRAN
UBBOUT
UCREF6
UCRF66
UCREF7
FOR I←23,37
<ILUUO
>
ILUUO: JRST 4,.
>;NOITS
ITS,<
SNB,,ILLUUO ;0
SNB,,.RELSE ;1
SNB,,.CLS ;2
SNB,,.TTYUUO ;3
SNB,,.PTYUUO ;4
SNB,,.CALLI ;5
SNB,,.INIT ;6
SNB,,.LOOK ;7
SNB,,.ENTER ;10
UERR ;11
UFAT ;12
UFOUT ;13
UOUTP ;14
UPOUT ;15
UTRAN ;16
UBBOUT ;17
UCREF6 ;20
UCRF66 ;21
UCREF7 ;22
SNB,,.IN ;23
SNB,,.OUT ;24
SNB,,.INPUT ;25
SNB,,.OUTPUT ;26
SNB,,.INBUF ;27
SNB,,.OUTBUF ;30
SNB,,.STATO ;31
SNB,,.STATZ ;32
SNB,,.GETSTS ;33
FOR I←34,37
<SNB,,ILLUUO
>
↑↑ILLUUO:
.VALUE [ASCIZ /:≠ ILLEGAL UUO ≠
/]
>;ITS
BEND UUO
; BINARY I/O HANDLING ROUTINES
BEGIN BIO
↑BBLK: XWD 1,0
BLOCK 23
↑FBLK: XWD 10,0
BLOCK 23
↑UOUTP: JUMPN BC,NOINI ;NOT FIRST WORD?
MOVE TAC,OPCNT ;GET OUTPUT ADDRESS
MOVEM TAC,BBLK+2 ;STORE
MOVE TAC,OPCNT+1 ;GET RELOCATION
LSH TAC,2 ;SHIFT
MOVEM TAC,BBLK+1 ;STORE
MOVE BC,[XWD -21,BBLK+3]
NOINI: MOVE TAC,@40 ;GET WORD
MOVEM TAC,(BC) ;STORE
AOS 40
MOVE TAC,@40 ;GET RELOC
DPB TAC,[POINT 1,TAC,34]
LDB TAC,[POINT 2,TAC,34]
OR TAC,BBLK+1 ;OR IN
AOBJP BC,FULL ;FULL?
LSH TAC,2 ;NO
MOVEM TAC,BBLK+1 ;STORE
POPJ P,
FULL: MOVEM TAC,BBLK+1;STORE RELOCATION
MOVEI TAC,22
HRRM TAC,BBLK ;SET COUNT
MOVE BC,[XWD -24,BBLK];OUTPUT COUNT
PUSHJ P,GBOUT ;OUTPUT THE BLOCK
PUSHJ P,FXFRC ;OUTPUT ANY FIXUPS
MOVEI BC,
POPJ P,
↑UBBOUT:MOVEM BC,UBBSV
MOVE BC,40
MOVE BC,(BC)
PUSHJ P,GBOUT
MOVE BC,UBBSV
POPJ P,
UBBSV: 0
↑GBOUT: HLRZ TAC,(BC) ;GET BLOCK TYPE
CAIE TAC,4 ;IGNORE IF ENTRY
SETOM CODEM ;FLAG THAT CODE WAS PUT OUT
CAIN TAC,2 ;ALSO CHECK SYMBOLS
SETOM SYMEM
TRNN BDEV ;BIN DEVICE?
POPJ P, ;NO
STINK,<
PUSHJ P,STKTRN ;TRANSLATE TO STINK FORMAT
PUSHJ P,GBOUT1
POPJ P, ;STKTRN SKIPS UPON OCCASION
↑↑GBOUT1:
>;STINK
GBOUT2: MOVE TAC,(BC)
SOSLE ODB+2
JRST GBPT
GBOUT3: OUT 3,
JRST GBPT
OUTSTR [ASCIZ /OUTPUT ERROR, TYPE ANY CHAR TO RETRY./]
PUSH P,T
PUSHJ P,WAIT
POP P,T
OUTSTR [ASCIZ /
/]
JRST GBOUT3
GBPT: IDPB TAC,ODB+1
AOBJN BC,GBOUT2
POPJ P,
↑BFRC: JUMPE BC,[POPJ P,]
↑BFX: MOVEI TAC,(BC);ADDRESS GETS FIXED UP TO -(BBLK+2)
HRRM TAC,BBLK ;COUNT
MOVE TAC,BBLK+1 ;GET RELOC BITS
LSH TAC,-2
LSH TAC,2
AOBJN BC,.-1 ;SHIFT RELOC BITS
MOVEM TAC,BBLK+1
MOVN BC,BBLK ;GET - COUNT
HRLI BC,-2(BC) ;SUBTRACT 2 & PUT IN LEFT HALF
HRRI BC,BBLK ;SET ADRESS
PUSHJ P,GBOUT
MOVEI BC,
POPJ P,
↑UFOUT: MOVE TAC,@40 ;GET WORD
MOVEM TAC,(FC) ;DEPOSIT
AOS 40
MOVE TAC,@40 ;GET RELOC
ANDI TAC,3
OR TAC,FBLK+1 ;OR IN
AOBJP FC,FFUL ;FULL?
LSH TAC,2 ;NO, SHIFT
MOVEM TAC,FBLK+1 ;STORE
POPJ P,
FFUL: MOVEM TAC,FBLK+1 ;STORE RELOC BITS
MOVEI TAC,22
HRRM TAC,FBLK ;SET COUNT
PUSHJ P,BFRC ;FORCE OUT BIN
MOVE BC,[XWD -24,FBLK]
PUSHJ P,GBOUT ;OUTPUT IT
MOVE FC,[XWD -22,FBLK+2];INIT
SETZB BC,FBLK+1
POPJ P,
↑FXFRC: CAMN FC,[XWD -22,FBLK+2];NONE?
POPJ P,
↑FFX: MOVEI TAC,(FC) ;ADDRESS GETS FIXED UP TO -(FBLK+2)
HRRM TAC,FBLK ;SET COUNT
MOVE TAC,FBLK+1 ;GET RELOC BITS
LSH TAC,-2
LSH TAC,2 ;SHIFT
AOBJN FC,.-1 ;LOOP
MOVEM TAC,FBLK+1
MOVN FC,FBLK ;GET -COUNT
HRLI FC,-2(FC) ;SUB 2 & PUT IN LEFT
HRRI FC,FBLK ;SET ADDRESS
EXCH FC,BC
PUSHJ P,GBOUT ;OUTPUT IT
MOVE BC,FC
MOVE FC,[XWD -22,FBLK+2];INIT
SETZM FBLK+1
POPJ P,
↑UPOUT: PUSH P,BC ;SAVE
MOVE BC,40 ;GET ADDRESS
LDB TAC,[POINT 4,BC,12];GET COUNT
MOVNS TAC ;NEGATE
HRL BC,TAC ;PUT IN LEFT
PUSHJ P,GBOUT ;OUTPUT IT
POP P,BC ;RESTORE
POPJ P,
↑BNAM: BLOCK =20 ;BLOCK NAMES
;R5CON: COMVERTS SIXBIT IN FS TO RADIX50 & PUTS RESULT
; IN FS, USES N
↑R5CON: MOVEM FS,R5C1
MOVE FS,[POINT 6,R5C1]
MOVEM FS,R5C1+1
ILDB FS,R5C1+1 ;GET FIRST CHR.
MOVE FS,R5TAB(FS);CON TO R5
REPEAT 5,< ILDB N,R5C1+1
IMULI FS,50
ADD FS,R5TAB(N)>
POPJ P,
R5C1: BLOCK 2
R5TAB: FOR I←0,'$'-1
<0
>
46
47
FOR I←'%'+1,'.'-1
<0
>
45
FOR I←'.'+1,'0'-1
<0
>
FOR I←1,12
<I
>
FOR I←'9'+1,'A'-1
<0
>
FOR I←13,44
<I
>
FOR I←'Z'+1,77
<0
>
BEND
;LISTING I/O STUFF
BEGIN LIO
↑UERR: LDB TAC,LSTPNT ;GET CURRENT CHR
PUSH P,TAC ;SAVE
MOVEI TAC,177 ;GET DELETE
DPB TAC,LSTPNT ;OUTPUT
MOVEI TAC,13 ;PRINT...
IDPB TAC,LSTPNT ;INTEGRAL SIGN
ARNT: POP P,TAC ;GET BACK THAT CHR
IDPB TAC,LSTPNT
MOVE TAC,ERPNT ;GET ERROR POINTER
PUSH TAC,40 ;SAVE ADDRESS
AOS ERCNT# ;COUNT
MOVEM TAC,ERPNT
POPJ P,
↑UFAT: PUSHJ P,UERR ;PUT OUT MESSAGE
MOVE TAC,ERPNT
PUSH TAC,FAT
AOS ERCNT
MOVEM TAC,ERPNT
PUSHJ P,LSTFRC
JRST FEND
FAT: [ASCIZ/FATAL/]
↑BLOUT: TRNN LDEV ;LIST DEVICE?
POPJ P, ;NO
MOVE TAC,PCNT+1
TLNE TAC,INCF ;IN CORE?
JRST LBLOUT ;YES
TROE BLOSW ;SET & TEST
JSR BLOT ;NO LSTFRC SINCE LAST BLOUT
BLRET: PUSH P,T ;SAVE T
PUSH P,FS ;SAVE FS
MOVS FS,OPCNT ;GET OUTPUT LOCATION
MOVE TAC,OPCNT+1;GET RELOC
PUSHJ P,OCON ;CONVERT TO ASCII OCTAL
MOVEM T,LBLK ;STORE IN BUFFER
MOVEM FS,LBLK+1 ;...
LBCON: MOVE FS,WRD ;GET LEFT HALF
MOVE TAC,WRD+1 ;GET RELOC...
LSH TAC,-2 ;...
PUSHJ P,OCON ;CONVERT
MOVEM T,LBLK+2
MOVEM FS,LBLK+3
MOVS FS,WRD ;GET RIGHT HALF
MOVE TAC,WRD+1 ;GET RELOC
PUSHJ P, OCON ;CONVER
MOVEM T,LBLK+4
MOVEM FS,LBLK+5
POP P,FS ;RESTORE...
POP P,T ;....
POPJ P,
BLOT: 0
PUSHJ P,LSTCHK ;MAKE SURE LOUT IS INTACT
MOVE TAC,[XWD -6,LBLK]
PUSHJ P,LOUT ;OUTPUT THE BINARY OCTAL...
MOVE TAC,[XWD -1,LCR]
PUSHJ P,LOUT ;AND A CR LF
JRST @BLOT
↑LBLOUT:TRNE LDEV ;LIST DEVICE?
SKIPE NOLTSW ;NO LITTERAL LIST?
POPJ P, ;NO
TROE BLOSW ;SET & TEST
JSR BLOT ;NO LSTFRC SINCE...
PUSH P,T ;SAVE
PUSH P,FS
MOVE T,[XWD BLNKS,LBLK]
BLT T,LBLK+1 ;BLANK LOCATION FIELD
JRST LBCON
BLNKS: ASCII / /
BYTE (7)40,40,11
ASCII / /
BYTE (7)40,40,11
↑VBLOUT:TRNN LDEV ;LIST DEVICE?
POPJ P, ;NO
TROE BLOSW ;ANY LSTFRC SINCE?
JSR BLOT ;NO
PUSH P,T ;SAVE
PUSH P,FS
MOVS FS,OPCNT ;GET LOCATION
MOVE TAC,OPCNT+1;&RELOC
PUSHJ P,OCON ;CONVERT TO ASCII
MOVEM T,LBLK
MOVEM FS,LBLK+1
MOVE T,[XWD BLNKS,LBLK+2]
BLT T,LBLK+5 ;BLANK VALUE
POP P,FS
POP P,T
POPJ P,
↑UTRAN: TRNN LDEV ;LIST DEV EXIST?
POPJ P, ;NO
TROE BLOSW ;SET & TEST
JSR BLOT ;EXTRA BINARY, DUMP IT
MOVS TAC,40 ;GET ADDRESS
HRRI TAC,LBLK ;SET UP BLT WRD
BLT TAC,LBLK+5 ;BLT
POPJ P,
LCR: BYTE(7)15,12
↑OCON: MOVEI T,6
HRRI FS,
REPEAT 4,< LSHC T,3
LSH T,4
ORI T,6>
LSHC T,3
LSH T,1
LSH FS,-4
OR FS,[BYTE(7)60,40,11,0,0]
TRNE TAC,1 ;RELOC?
ADD FS,[("'"-40)⊗26]
POPJ P,
↑LSTLF: SKIPGE AHED ;LINE FEED SEEN -- IF NOT FROM MACRO
SETOM INCLIN ;PREPARE TO UPDATE LINE NUM (FOR NON-SOS FILES)
↑LSTFRC:PUSHJ P,LSTCHK ;CHECK FOR CLOBBERAGE
JRST FLST
↑LSTCHK:MOVNI TAC,1
CAMN TAC,LTEST ;OVERRUN
POPJ P, ;NO
CAMN TAC,LTEST2
JRST LST2OK
MOVE TAC,SVLNUM
MOVEM TAC,TLBLK
MOVE TAC,[LBCLOB,,TLBLK+1]
BLT TAC,TLBLK+LBCLBL
MOVE TAC,[440700,,TLBLK+LBCLBL+1]
MOVEM TAC,LSTPNT
LST2OK: OUTSTR [ASCIZ /LINE BUFFER OVERFLOW -- ASSEMBLER CLOBBERED.
/]
PUSHJ P,TTYERP
MOVE TAC,[JRST LSTFRC]
MOVEM TAC,STRT+2
JRST 4,.
LBCLOB: ASCII / ****** LISTING LINE CLOBBERED ******/
LBCLBL←←.-LBCLOB
↑XPNDSW:0
↑SVLNUM:0
BYTE (7)11,11,11
LBFSZ←←200 ;SIZE OF LINE BUFFER - MUST BE POWER OF 2 (SEE TTYERP)
↑MBLK: BLOCK LBFSZ
LTEST2: -1
↑LBLK: BLOCK 6
↑TLBLK: BLOCK LBFSZ
LTEST: -1
;ROUTINE TO OUTPUT TO LISTING FILE - AOBJN PNTR IN TAC
↑LOUT: PUSH P,T ;SAVE
PUSH P,FS ;SAVE
LOUT0: PUSH P,TAC
MOVE FS,(TAC)
ANDCMI FS,1
LOUT1: MOVEI T,
LSHC T,7
LOUT1A: SKIPL TAC,CTAB(T)
JRST LOUTS ;MIGHT BE SPECIAL
LOUT2: AOS TAC,CHRCNT
CAML TAC,CHRPL
JRST LOUTOV ;OVERFLEW LINE
LOUT3: SOSG LOB+2
OUTPUT 4,
IDPB T,LOB+1
LOUT4: JUMPN FS,LOUT1
POP P,TAC
AOBJN TAC,LOUT0
POP P,FS
POP P,T
POPJ P,
LOUTS: TLNE TAC,SCRF!CRFG
XCT LOUTTB(TAC) ;THIS CHAR NEEDS WORRYING
JUMPN TAC,LOUT2 ;JUST ORDINARY SPEC CHR?
JRST LOUT4 ;FLUSH NULLS
;HERE SPEC CHRS & LINE OVERFLOW ARE HANDLED
JRST LOUT2 ;FOR SLURP HACK ETC.
LOUTTB: JRST LOUTDL ;RUBOUT
JRST LOUTLF ;LF
JRST LOUT2 ;"↔;
JRST LOUT2 ;'
JRST LOUT2 ;=
JRST LOUTSP ;SP & TAB
JRST LOUTCR ;CR
JRST LOUTFF ;FF
JRST LOUT2 ;<{
JRST LOUT2 ;>}
LOUTLF: SOSLE LNCNT
JRST LOUT3 ;JUST OUTPUT IF NO PAGE OFLO
SKIPL LNCNT ;DON'T CLOBBER CHAR IF ABOUT TO DO HEADING
MOVEI T,14 ;ELSE TURN INTO FF
LOUTFF: SKIPGE LNCNT ;IF ALREADY OFF PAGE
JRST LOUTH ;THEN DO HEADING
SKIPGE CHRCNT ;SEE IF DOING CREF STUFF
JRST LOUT3 ;AND AVOID SPECIAL TREATMENT FOR FF
MOVSI TAC,1 ;OTHERWISE USE A BIG NUMBER
MOVEM TAC,CHRCNT;TO GET US TO LOUTH ON THE NEXT CHAR
SETOM LNCNT ;MARK US OFF PAGE
JRST LOUT3 ;AND GO OUTPUT FF
LOUTCR: HLLZS CHRCNT ;CR RESETS POS EXCEPT HEADING FLAG
JRST LOUT3
LOUTSP: CAIE T,11 ;SEE IF THIS "SPACE" IS A TAB
JRST LOUT2 ;NO
MOVEI TAC,7 ;YES - UPDATE POS TO TAB STOP
IORM TAC,CHRCNT ;(ACTUALLY 1 SHORT)
JRST LOUT2 ;AOS AT LOUT2 WILL MAKE IT RIGHT
LOUTOV: TLNE TAC,-1 ;CHECK IF THIS IS REALLY HEADING FLAG
JRST LOUTH ;YES
HRROI TAC,[ASCIZ /
/]
PUSHJ P,LOUT ;JUST OFLO - STICK IN CRLF
JRST LOUT1A ;& REPROCESS CURRENT CHAR
LOUTDL: SKIPLE LNCNT
JRST LOUT3 ;PASS RUBOUT QUIETLY IF HEADING NOT NEEDED
LOUTH: PUSHJ P,LOUTH1 ;DO HEADING STUFF
JRST LOUT1A ;REPROCESS CURRENT CHAR
LOUTH1: HRROI TAC,[BYTE (7)15] ;HEADING TIME - FIRST OUTPUT CR
PUSHJ P,LOUT
SETZM CHRCNT ;& CLEAR FLAG
MOVEI TAC,LNPP
MOVEM TAC,LNCNT ;RESET LINE COUNTER
MOVE TAC,TITCNT
PUSHJ P,LOUT
PUSHJ P,PTIM
MOVE TAC,HEDCNT
PUSHJ P,LOUT
MOVE TAC,SUBCNT
JRST LOUT
DEFINE DEP
< ADDI N,60
ADDI NA,60
IDPB N,PTPNT
IDPB NA,PTPNT
>
↑TITCNT: XWD -1,.+1
0
BLOCK 40
HEDCNT: XWD -LHEAD,.+1
ASCII / FAIL /
HEAD: BLOCK 4
↑FILNM: BLOCK 3
ASCII / Page/
PG: ASCII / /
BLOCK 3 ;ALLOW ROOM FOR BLOCK NAME TOO
11*200*2 ;FINISH WITH A TAB
LHEAD←←.-HEDCNT-1
↑SUBCNT: XWD -1,.+1
BYTE (7)15,12,15,12
BLOCK 40
PTPNT: 0
PTIM: PUSH P,N
PUSH P,NA
CALLI N,14 ;GET DATE
MOVE NA,[POINT 7,HEAD]
MOVEM NA,PTPNT
IDIVI N,=31 ;GET DAY
MOVEM N,PG+1 ;SAVE
MOVEI N,(NA)1 ;GET DAY
IDIVI N,12 ;CON TO DEC
SKIPN N ;ZERO LEADING DIGIT?
MOVNI N,20 ;YES, CON TO BLANK
DEP
MOVEI N,"-"
IDPB N,PTPNT
MOVE N,PG+1
IDIVI N,=12 ;GET MONTH & YEAR
MOVE NA,MOTAB(NA);GET MONTH NAME
IDPB NA,PTPNT ;DEPOSIT
LSH NA,-7
IDPB NA,PTPNT
LSH NA,-7
IDPB NA,PTPNT
MOVEI NA,"-"
IDPB NA,PTPNT
ADDI N,=64
IDIVI N,12
DEP
MOVEI N,40
IDPB N,PTPNT
IDPB N,PTPNT
CALLI N,23 ;GET TIME
IDIVI N,=60000 ;THROW AWAY M.S & SEC
IDIVI N,=60 ;GET HRS & MINS
MOVEM NA,PG+1 ;SAVE MINS
IDIVI N,12 ;CON TO DEC
SKIPN N
MOVNI N,20
DEP
MOVE N,PG+1
MOVEI NA,":"
IDPB NA,PTPNT
IDIVI N,12
DEP
SETZM PG+1
SETZM PG+2
SETZM PG+3
HRRZS PG+4
MOVE N,[POINT 7,PG,13]
MOVEM N,PTPNT
MOVE N,PGNM ;GET PAGE NUM
PUSHJ P,PGCON
AOS N,SPGNM
CAIG N,1
JRST PTIM2
MOVEI NA,"-"
IDPB NA,PTPNT
PUSHJ P,PGCON
PTIM2: MOVEI N,15
IDPB N,PTPNT
MOVEI N,12
IDPB N,PTPNT
MOVE NA,[440600,,LSTLAB+3] ;TO GET BLOCK NAME
REPEAT 6,< ILDB N,NA
ADDI N,40
IDPB N,PTPNT>
POP P,NA
POP P,N
POPJ P,
PGCON: IDIVI N,12 ;CON TO DEC
JUMPE N,PGCOA ;0?
HRLM NA,(P) ;SAVE REMAINDER
PUSHJ P,PGCON
HLRZ NA,(P) ;GET REMAINDER
PGCOA: ORI NA,60
IDPB NA,PTPNT
POPJ P,
MOTAB: FOR AARDVARK IN (NAJ,BEF,RAM,RPA,YAM,NUJ,LUJ,<GUA>
,PES,TCO,VON,CED)
< "AARDVARKSESHOHOHO"
>
↑SPGNM: 0
↑PGNM: 0
↑LNCNT: 0
↑ERPD: BLOCK ERPLEN
↑ERPNT:0
↑PGBF: 0↔0 ;FOR TYPING PAGE NUMBERS IN ERROR MESSAGES--DCS 2/6/70
FLST: SKIPN ERCNT ;ANY ERRORS?
JRST QLST ; NO
SKIPN TTYERR ;IF ANYBODY WILL WANT MESSAGE,
JRST LSTAR ; THEN PRINT STARS
SKIPN LISTSW
JRST QLST ; DON'T EVEN CONSIDER IT
LSTAR: PUSH P,N
MOVEI N,[ASCIZ /#####/]
PUSHJ P,ERLST ;PRINT STARS
POP P,N
SKIPN TTYERR ;LIST ERRORS ON TTY?
PUSHJ P,TTYERP ;YES - DO IT
QLST: AOSN INCLIN ;IF NECESSARY,
AOS INLINE ;WE CAN UPDATE LINE NUM NOW (AFTER TTYERP)
TRNE LDEV ;LISTING?
JRST YESL ;YES
HRRZ TAC,LSTPNT
CAIGE TAC,TLBLK ;POINTER IN MACRO?
SKIPA TAC,[POINT 7,MBLK+1,6];YES
MOVE TAC,[POINT 7,TLBLK+1,6]
SKIPN XPNDSW
TLZ TAC,7700
MOVEM TAC,LSTPNT ;RESET LSTPNT
SKIPN UNDLNS ;UNDERLINING?
JRST ERSCN ;NO
SETZM MBLK
MOVE TAC,[XWD MBLK,MBLK+1]
BLT TAC,LTEST-1;CLEAR BUFFER
SETOM LTEST2
MOVE TAC,[BYTE (7) 11]
MOVEM TAC,TLBLK+1
JRST ERSCN ;PRINT ERRORS
↑TTYERP:PUSH P,TAC
MOVE TAC,LSTPNT
; TLO TAC,700 ;SIZE MIGHT BE 0 IN MACRO
; CAMN TAC,[350700,,TLBLK+1]
; JRST TTYERX
PUSH P,T
MOVEI T,15 ;MAKE SURE WE GET A CR-LF
IDPB T,TAC
MOVEI T,12
IDPB T,TAC
MOVE TAC,[POINT 7,FILNM]
JSR ASCFIL ; SEE BELOW
MOVE TAC,[POINT 7,[ASCIZ /, PAGE /]]
JSR ASCFIL ;PRINT THAT TOO
PUSH P,N
PUSH P,NA
MOVE N,PGNM
PUSHJ P,PGOUT
SKIPE TLBLK
JRST FLPG2 ;SOS LINE NUM EXISTS -- USE IT
MOVE TAC,[440700,,[ASCIZ /, LINE /]]
JSR ASCFIL
MOVE N,INLINE
ADDI N,1
PUSHJ P,PGOUT ;NO NUM -- USE OUR OWN
FLPG2: POP P,NA
MOVE TAC,[POINT 7,[BYTE (7) 15,12]]
JSR ASCFIL ;AND CRLF PRECEDING LINE PRINTOUT
MOVEI N,TLBLK
SKIPN TLBLK ;ANY SOS LINE NUM?
SKIPA TAC,[350700,,1(N)] ;NO, SKIP IT
MOVSI TAC,(<440700,,(N)>) ;YES, PRINT IT
CLOP3: ILDB T,TAC ;GET CHR OF LINE
JUMPE T,CLOP5
CLOP6: CAIN T,177 ;DELETE?
JRST CLOP2 ;YES
CLOP4: JSR OUT ;TYPE IT
CAIE T,12 ;DONE IF IT'S LF
JRST CLOP3
MOVE TAC,LSTPNT
MOVEI T,
IDPB T,TAC ;NULL OUT FORCED CR-LF (MAY SCREW UNDERLINE KLUDGE)
IDPB T,TAC
POP P,N
POP P,T
TTYERX: POP P,TAC
POPJ P,
CLOP2: ILDB T,TAC
CAIN T,13 ;INTEGAL SIGN?
HRROI T,12 ;YES, USE LINE-FEED (BUT AVOID COMPARE)
JRST CLOP4
CLOP5: TRNE TAC,-LBFSZ ;NULL - SEE IF REALLY UNDERLINE KLUDGE
JRST CLOP3 ;CAN'T BE IF OFF END
XORI N,MBLK≠TLBLK ;TRY OTHER BUFFER
LDB T,TAC
JUMPN T,CLOP6 ;YUP - TIME TO SWITCH BUFFERS
XORI N,MBLK≠TLBLK
JRST CLOP3
; TYPE ASCIZ STRING WHOSE BYTE POINTER IS IN TAC
ASCFIL: 0 ;JSR
ASCF1: ILDB T,TAC ;GET A CHR
JUMPE T,@ASCFIL ;RETURN WHEN DONE
JSR OUT ; TYPE IT
JRST ASCF1 ; RETURN FOR MORE
PGOUT: IDIVI N,12
JUMPE N,.+4
HRLM NA,(P)
PUSHJ P,PGOUT
HLRZ NA,(P)
MOVEI T,"0"(NA)
JSR OUT
POPJ P,
YESL: SKIPN XPNDSW ;NOT EXPANDING NOW?
POPJ P, ;YES
TRNN MACUNF ;WAS A MACRO SEEN?
JRST LARND ;NO
PUSH P,N
PUSH P,NA
MOVE N,[POINT 7,MBLK]
MOVE NA,[POINT 7,TLBLK]
LOOP1: ILDB TAC,NA ;GET CHR FROM PRIMARY BUFFER
JUMPE TAC,LNUL ;NULL?
CAIN TAC,177 ;DELETE?
JRST LDEL ;YES
CAIN TAC,11 ;TAB?
JRST LSPA ;YES
CAIN TAC,15 ;CR?
JRST LCRE ;YES
MOVEI TAC,40 ;NONE OF THE ABOVE (USE SPACE)
LSPA: IDPB TAC,N ;DEPOSIT IN SECONDARY BUFFER
JRST LOOP1
LDEL: IBP N
ILDB TAC,NA
JRST LSPA
LNUL: ILDB TAC,N ;GET OTHER CHR.
JUMPE TAC,LOOP1 ;BOTH NULL?
CAIN TAC,177 ;DELETE?
JRST LOOP1 ;YES
CAIN TAC,11 ;TAB?
JRST OTAB ;YES
CAIN TAC,15 ;CR?
JRST OCRE ;YES
CAIN TAC,40 ;SPACE?
JRST OTAB ;YES
MOVEI TAC,30 ;UNDERLINE
OTAB: DPB TAC,NA
JRST LOOP1
LCRE: IDPB TAC,N
OCRE: DPB TAC,NA
MOVEI TAC,
IDPB TAC,N
MOVEI TAC,12
IDPB TAC,NA
LARND: SKIPN CREFSW ;CREFING?
JRST NOCREF ;NO
MOVEI TAC,177 ;DEPOSIT...
IDPB TAC,CREFPT ;END...
MOVEI TAC,101 ;OF...
IDPB TAC,CREFPT ;CREF
PUSHJ P,CREFR ;DUMP THE INFO
NOCREF: TRNN MACUNF
JRST NOMAC
MOVN TAC,N
ADDI TAC,MBLK-2
HRLI TAC,MBLK-1
MOVSS TAC
PUSHJ P,LOUT
MOVN TAC,NA
SKIPA
NOMAC: MOVN TAC,LSTPNT ;FORM...
ADDI TAC,LBLK-1 ;COUNT
HRLI TAC,LBLK
TRZE BLOSW ;ANY BINARY
JRST BYES ;YES
ADDI TAC,5 ;REDUCE COUNT
PUSH P,[BYTE (7)11,11,11];TAB ACROSS
POP P,LBLK+5
HRLI TAC,LBLK+5 ;SET ADDRESS
BYES: MOVSS TAC ;SET UP CONTROL WORD FOR...
PUSHJ P,LOUT ;LOUT
SETZM MBLK
MOVE TAC,[XWD MBLK,MBLK+1]
BLT TAC,LTEST-1;CLEAR BUFFERS
SETOM LTEST2
MOVE TAC,[BYTE (7) 11]
MOVEM TAC,TLBLK+1
HRRZ TAC,LSTPNT
TRNN MACUNF
JRST .+3
POP P,NA
POP P,N
CAIL TAC,TLBLK
SKIPA TAC,[POINT 7,TLBLK+1,6]
SKIPA TAC,[POINT 7,MBLK+1,6]
TRZ MACUNF ;CLEAR FLAG
MOVEM TAC,LSTPNT;RESET LSTPNT
ERSCN: SKIPN ERCNT ;NONE?
POPJ P, ;NONE
SKIPN LISTSW ;LIST DEVICE?
SKIPN TTYERR ;ERRORS ON TTY?
JRST ERS1 ;SOMEONE WANTS ERROR MEXXAGES
NOITS,< HLLOS 42> ;MARK THAT ERRORS HAVE HAPPENED
MOVE TAC,[XWD -ERPLEN,ERPD-1]
MOVEM TAC,ERPNT ;NO ONE IS INTERESTED IN THESE LONELY...
SETZM ERCNT ;ERROR MESSAGES
POPJ P,
ERS1: PUSH P,N ;SAVE
PUSH P,NA ;SAVE NA
PUSH P,T
PUSH P,FS
MOVE FS,LSTLAB+1;GET BLOCK NAME
PUSHJ P,AFROM6 ;CON TO ASCII
MOVEM T,LABPRT ;SAVE
MOVE N,FS ;SAVE LAST CHR
MOVE FS,LSTLAB ;GET LABEL NAME
PUSHJ P,AFROM6 ;CON TO ASCII
OR N,[BYTE(7)0,40,"&",40]
ROT T,7
DPB T,[POINT 7,N,34]
MOVEM N,LABPRT+1;DEPOSIT SECOND WORD
ROT FS,7
DPB FS,[POINT 7,T,34]
MOVEM T,LABPRT+2;DEPOSIT THRID WORD
MOVE N,PCNT
SUB N,LSTLAB+4 ;GET DEVIATION
SETZM LABPRT+3
JUMPE N,RCQ
MOVE T,[POINT 7,LABPRT+3];SET UP POINTER
MOVEI NA,"+"
IDPB NA,T ;DEPOSIT +
PUSHJ P,RCR ;CONVERT
MOVEI NA,
IDPB NA,T
RCQ: MOVEI N,LABPRT
PUSHJ P,ERLST
POP P,FS
POP P,T
MOVE NA,ERPNT ;GET ERROR POINTER
ELOP: POP NA,N ;GET MESSAGE
PUSHJ P,ERLST ;LIST IT
SOSLE ERCNT ;ANY MORE?
JRST ELOP ;YES
MOVEM NA,ERPNT ;RESTORE
POP P,NA
POP P,N
SKIPN ERSTSW ;SHOULD WE STOP?
POPJ P, ; NO
IFE EDITSW,<;<
OUTSTR [ASCIZ /REPLY [CR] TO CONTINUE, [LF] TO CONTINUE AUTOMATICALLY
>/]
>
IFN EDITSW <;<
; BEGIN TVR PATCH OCT '72
OUTSTR [
ASCIZ /REPLY 'E' - EDIT, [CR] TO CONTINUE, [LF] TO CONTINUE AUTOMATICALLY
>/]
>
CLRBFI ;CLEAR TYPEAHEAD
INCHRW TAC ;WAIT FOR ACTIVATION
CLRBFI ;CLEAR TTY INPUT BUFFER
IFN EDITSW <
CAIE TAC,"e"
CAIN TAC,"E"
JRST EDGO
; END TVR PATCH
>
CAIN TAC,12 ;TURN OFF ERSTSW?
SETZM ERSTSW ; YES
POPJ P,
; END DCS PATCH
IFN EDITSW <
;INVOKE AN EDITOR TVR - OCT '72
EDGO: MOVE 14,FNAM ;GET FILENAME
HLLZ 13,FNAM+1 ;GET EXTENSION
MOVE 11,SAVPPN ;GET PPN
MOVE 16,PGNM ;GET PAGE NUMBER
SKIPN 15,TLBLK ;DOES IT HAVE LINE NUMBERS?
SKIPA 2,[SIXBIT /TECO/] ;NO, FIRST WE'LL ASSUME TECO
IFE CMUSW,< SKIPA 2,[SIXBIT /SOS/] ;YES, USE SOS>
IFN CMUSW,< SKIPA 2,[SIXBIT /LINED/]> ;CMU STILL CALLS IT LINED (SIGH)
MOVE 15,INLINE ;NO LINE NUMBERS, GET COUNT INSTEAD
IFN STANSW,<
SKIPE TVFILE
MOVSI 2,'E '
MOVEM 2,EDITOR
MOVEI RUNBLK
SWAP ;SWAP
>IFE STANSW,<
MOVEM 2,EDITOR
MOVE [1,,RUNBLK]
RUN
> HALT .-1 ;IN CASE IT LOSES
RUNBLK: SIXBIT /SYS/
EDITOR: 0
0
STANSW
0
IFN STANSW,<0>
>
LABPRT: BLOCK 6
RCR: IDIVI N,10
JUMPE N,.+4
HRLM NA,(P)
PUSHJ P,RCR
HLRZ NA,(P)
ORI NA,60
IDPB NA,T
POPJ P,
↑ERLST: SETZM SW1
NOITS,< HLLOS 42> ;MARK THAT ERRORS HAVE HAPPENED
PUSH P,T
PUSH P,FS
PUSH P,O
ELOP2: HRROI TAC,(N)
SKIPE LISTSW ;LIST DEVICE?
PUSHJ P,LOUT ;YES
MOVEI O,5
MOVE FS,(N) ;GET FIRST WORD
ELOP1: MOVEI T,
LSHC T,7 ;GET CHR.
JUMPE T,EDON ;DONE?
SKIPN TTYERR ;NO, TTY ERR LIST?
JSR OUT ;YES,LIST
SOJG O,ELOP1 ;MORE THIS WORD?
AOJA N,ELOP2 ;NO, GET NEXT WORD
SW1: 0
EDON: SKIPE SW1
JRST EDON1
SETOM SW1
MOVEI N,[BYTE(7)15,12]
JRST ELOP2
EDON1: POP P,O
POP P,FS
POP P,T
POPJ P,
↑CREFPT:0
↑CREFTB:BYTE (7)177,102
BLOCK 100
↑UCREF6:SKIPN LISTSW ;LISTING?
POPJ P, ;NO
LDB TAC,[POINT 4,40,12] ;NO SIZE CHECK IF 0
JUMPE TAC,OENT ;AND NO IDPB CREFPT EITHER
HRRZ TAC,CREFPT ;GET THE POINTER ADRESS
CAIGE TAC,CREFTB+70 ;SEE IF WE ARE ALMOST AT THE END
JRST NOCDM ;NO, GO ON
MOVEI TAC,177
IDPB TAC,CREFPT
MOVEI TAC,104
IDPB TAC,CREFPT ;GIVE IT A JUST EAT OP
PUSHJ P,CREFR ;AND DUMP
NOCDM: LDB TAC,[POINT 4,40,12];GET TYPE
IDPB TAC,CREFPT ;DEPOSIT
OENT: HRRZ TAC,40 ;GET SIXBIT
PUSH P,L ;SAVE L
MOVEI L,6 ;INIT SIZE
IDPB L,CREFPT ;DEPOSIT SIZE
PUSH P,T ;SAVE T
CLOOP1: LDB T,[POINT 3,TAC,20];GET CHR.
ADDI T,"0"
IDPB T,CREFPT ;DEPOSIT CHR.
LSH TAC,3 ;SHIFT
SOJG L,CLOOP1 ;DONE?
CRFRT: POP P,T ;YES, RESTORE
POP P,L
POPJ P,
↑UCREF7:SKIPN LISTSW
POPJ P,
HRRZ TAC,CREFPT ;GET THE POINTER ADRESS
CAIGE TAC,CREFTB+70 ;SEE IF WE ARE ALMOST AT THE END
JRST NOCDM7 ;NO, GO ON
MOVEI TAC,177
IDPB TAC,CREFPT
MOVEI TAC,104
IDPB TAC,CREFPT ;GIVE IT A JUST EAT OP
PUSHJ P,CREFR ;AND DUMP
NOCDM7: LDB TAC,[POINT 4,40,12]
IDPB TAC,CREFPT
JRST UCRF67
↑UCRF66:SKIPN LISTSW ;LISTING?
POPJ P, ;NO
PUSHJ P,UCREF6
UCRF67: MOVE TAC,@40 ;NOW GET THE SIXBIT
PUSH P,L
MOVEI L,5
TLNE TAC,770000 ;JUSTIFY
AOJA L,LADJ
LSH TAC,6
SOJG L,.-3
MOVEI L,1
LADJ: IDPB L,CREFPT
PUSH P,T
CLOOP2: LDB T,[POINT 6,TAC,5]
ADDI T,40
IDPB T,CREFPT
LSH TAC,6
SOJG L,CLOOP2
JRST CRFRT
CREFR: MOVEI TAC, ;PUT OUT THE CREF INFO
REPEAT 5,<IDPB TAC,CREFPT>
PUSHJ P,LSTCHK
SKIPG LNCNT
PUSHJ P,LOUTH1 ;OUTPUT HEADING IF NEEDED (BEFORE CREF JUNK)
MOVN TAC,CREFPT ;FORM...
ADDI TAC,CREFTB ;COUNT
HRLI TAC,CREFTB ;ADDRS
MOVSS TAC
PUSH P,CHRCNT
PUSH P,LNCNT
HLLZM TAC,CHRCNT ;SET COUNTS TO PREVENT
HRRZM TAC,LNCNT ;OVERFLOW DETECTION
PUSHJ P,LOUT ;PUT OUT CREF
POP P,LNCNT ;RESTORE COUNTS
POP P,CHRCNT
MOVE TAC,[POINT 7,CREFTB,13]
MOVEM TAC,CREFPT
POPJ P,
BEND
SUBTTL ..END, BEND, BEGIN..
BEGIN ENDS
;BEGIN AND END AND BEND ROUTINES
DOEND: MOVE N,OPCNT+1
TLNE N,INCF
JRST [SUB P,[1,,1]↔JRST PSLIT]
PUSHJ P,VAR
PUSHJ P,LITOUT ;PUT OUT LITTERALS
HRRZ N,BLOCK
CAIE N,1 ;AT OUTER LEVEL?
ERROR[ASCIZ/YOU ARE SUFFERING FROM THE UNFORTUNATE FACT THAT YOUR
INCOMPLETE PROGRAM HAS AN INSUFFICIENT
NUMBER OF STATEMENTS CONSISTING OF OR STARTING WITH
THE PSEUDO-OP BEND/]
TRO NOFXF
PUSHJ P,MEVAL ;GET ADDRESS
TLNE ESPF ;SPECIAL CHR?
JRST SPC ;YES
TLNE UNDF ;DEFINED?
ERROR[ASCIZ/UNDEFINED ADDRESS -- END/]
MOVEM N,EN1+2 ;DEPOSIT STARTING ADDRESS
ANDI NA,1 ;FORM...
ROT NA,-2 ;RELOCATION
MOVEM NA,EN1+1 ;AND DEPOSIT
POUT 3,EN1 ;PUT OUT THE STARTING ADDRESS NOW
EZERF: PUSHJ P,BEND ;DOO SYMBOL THINGS
PUSHJ P,BFRC ;FORCE OUT BINARY
PUSHJ P,FXFRC ;FORCE OUT FIXUPS
MOVEI O,HASH-1 ;INIT COUNT
ELOOP2: SKIPN PN,SYMTAB(O);GET START OF CHAIN
JRST NONTE ;NONE
ELOOP1: SKIPE CREFSW
CREF66 11,(PN)
MOVE N,2(PN) ;GET FLAGS
TLNE N,EXTF ;EXTERNAL?
JRST EEXT ;YES
TLNE N,DEFFL ;DEFINED?
JRST EUND ;NO
TLNE N,INTF ;INTERNAL?
JRST EINT ;YES
ECON: SKIPE PN,1(PN) ;GET NEXT
JRST ELOOP1
NONTE: SOJGE O,ELOOP2 ;NO MORE, GET NEXT CHAIN
JRST EPNT ;DONE
EINT: MOVE FS,(PN) ;GET SIXBIT
PUSHJ P,R5CON ;CON TO R5
TLO FS,40000 ;MARK AS INTERNAL
MOVE N,2(PN)
TLNE N,DBLF
TLO FS,SNB ;THESE CAN BE HALF-KILLED, TOO
MOVEM FS,IOU+2 ;DEPOSIT
MOVE L,3(PN) ;GET VALUE
MOVEM L,IOU+3 ;DEPOSIT
MOVE L,4(PN) ;GET RELOC
DPB L,[POINT 1,IOU+1,3];DEPOSIT
POUT 4,IOU ;OUTPUT IT
JRST ECON
IOU: XWD 2,2
BLOCK 3
EEXT: MOVE FS,(PN) ;GET SIXBIT
PUSHJ P,R5CON ;CON TO R5
TLO FS,600000 ;MARK AS EXT
MOVEM FS,IOU+2 ;DEPOSIT
SKIPN N,3(PN) ;GET FIXUP POINTER
JRST [SETZM IOU+1 ;ISSUE NULL REQUEST
SETZM IOU+3 ;TO ABS 0
POUT 4,IOU
JRST ECONN]
EXCON: SKIPE NA,(N) ;GET DEVIATION
JRST POLEX ;NOT 0
MOVE TAC,2(N) ;GET FLAGS
TRNE TAC,3 ;LEFT HALF OR FULL?
JRST POLEX ;YES
MOVE TAC,3(N) ;GET VALUE
MOVEM TAC,IOU+3 ;DEPOSIT
MOVE TAC,4(N) ;RELOC
DPB TAC,[POINT 1,IOU+1,3];DEPOSIT
POUT 4,IOU ;OUTPUT
SKIPE N,1(N) ;GET NEXT
JRST EXCON
ECONN: SKIPN N,4(PN) ;ANY POLFIXES?
JRST ECON ;NO
ECLOP: SOSG 1(N) ;LAST SYM?
JRST LAST ;YES
MOVSS N
SKIPN N,2(N) ;GET NEXT
JRST ECON
JRST ECLOP ;MORE
LAST: MOVEI FS,5(N) ;SET UP POINTER
PUSH P,O
PUSHJ P,REDUC ;REDUCE POLISH
POP P,O
PUSHJ P,BFRC ;FORCE OUT BIN
MOVEI FS,5(N) ;SET UP POINTER
MOVS NA,N ;GET NEXT
MOVE NA,2(NA) ;...
PUSHJ P,POLOUT ;PUT OUT POLISH
SKIPN N,NA ;ANY MORE?
JRST ECON ;NO
JRST ECLOP ;YES
EXPOL: (11)5
0
2(3)
0
(1)
0
0
POLEX: MOVE NA,N
MOVE FS,(PN) ;GET SIXBIT
PUSHJ P,R5CON ;CON TO RADIX50
TLO FS,40000
MOVEM FS,EXPOL+3;DEPOSIT
MOVE FS,(NA) ;GET DEVIATION
HRLM FS,EXPOL+5 ;DEPOSIT
HLRM FS,EXPOL+4 ;...
MOVE FS,2(NA) ;GET FLAGS
ANDI FS,3
SETCA FS, ;FORM STORE OP
HRRM FS,EXPOL+5 ;DEPOSIT
MOVE FS,3(NA) ;GET FIXUP LOC.
HRLM FS,EXPOL+6 ;DEPOSIT
MOVE FS,4(NA) ;GET RELOC
DPB FS,[POINT 1,EXPOL+1,8];DEP.
POUT 7,EXPOL ;OUTPUT IT
SKIPE N,1(NA) ;GET NEXT
JRST EXCON ;MORE
JRST ECONN ;NO MORE
EUND: MOVE FS,(PN) ;GET SIXBIT
PUSHJ P,AFROM6 ;CON TO ASCII
MOVEM T,EUOUT ;DEPOSIT
OR FS,[BYTE (7)0,11,"U","N","D"]
MOVEM FS,EUOUT+1;DEPOSIT
SKIPE FS,3(PN) ;GET FIXUP POINTER
SKIPA TAC,4(FS) ;GET RELOC
SKIPA TAC,[0] ;NO RELOC(NO FIXUP)
MOVE FS,3(FS) ;GET FIXUP VALUE
MOVSS FS
PUSHJ P,OCON ;CON TO OCTAL ASCII
MOVEM T,EUOUT+3 ;DEPOSIT
MOVEM FS,EUOUT+4;...
MOVEI N,EUOUT
PUSHJ P,ERLST ;LIST
JRST ECON
EPNT:
EN3: PUSHJ P,SBFRC ;FORCE OUT SYMBOLS
SKIPN SEG
JRST NBK
EN4: MOVE N,HICNT ;YES GET HIGH BREAK
MOVE NA,LOCNT ;GET LOW BREAK
MOVEM NA,WRD
MOVSI T,240000 ;BOTH RELOC
JRST ENDOUT
NBK: MOVE N,LOCNT ;GET PROGRAM BREAK
MOVEM N,WRD
MOVE NA,ABSCNT ;AND ABS PROG BREAK
CAIG NA,140
MOVEI NA, ;ONLY SET IF PAST 140
MOVSI T,200000 ;ONLY FIRST IS RELOC
ENDOUT: MOVEM T,EN2+1
MOVEM N,EN2+2 ;DEPOSIT
MOVEM NA,EN2+3
POUT 4,EN2 ;OUTPUT IT
PUSHJ P,BLOUT
PUSHJ P,SCNTIL ;GET TO LF AND FORCE LISTING
SETOM XPNDSW
JRST LSTFRC ;NOW REALLY FORCE LISTING
↑%END: PUSHJ P,DOEND
↑FEND: CLOSE 1,
↑FEND1: RELEAS 4,
RELEAS 2,
NOITS,<
MOVS N,RELFIL+4
TRNE BDEV
CAIE N,'DSK'
JRST FEND2
CLOSE 3, ;GODDAM DSKSER SCREWS FILE IF RENAME BEFORE CLOSE
IFE STANSW,<
CALLI N,22 ;GET TIME
IDIVI N,=60*=60 ;IN MINS
CALLI NA,14 ;& DATE
DPB N,[141300,,NA]
TLO NA,(<14,>) ;KEEP THE MODE HONEST
>
IFN STANSW,<
DSKTIM NA, ;GET DATE & TIME
TLO NA,(<SETZ 14,>) ;MODE 14, PROT 400 (DUMP NEVER)
>
MOVEM NA,RELFIL+2
SETZM RELFIL+3
RENAME 3,RELFIL ;ADJUST DATE & TIME TO END OF ASSEMBLY (LESS RPG LOSSAGE)
JFCL
>;NOITS
FEND2: RELEAS 3,
ITS,< CALLI 12 >
JRST STRT1
EUOUT: BLOCK 2
ASCII /EF /
BLOCK 2
EN1: XWD 7,1
0
0
EN2: 5,,2
200000,,
0
0
;PRGEND -- DOES END STUFF & RESTARTS PAST I/O INITIALIZATION
↑%PRGEN:PUSHJ P,DOEND
HRROI TAC,[BYTE (7)14]
TRNE LDEV
PUSHJ P,LOUT ;DO PAGE HEADING IF NECC
JRST STRT2
SPC: TLNN N,CRFG ;CR?
ERROR[ASCIZ/SPECIAL CHR IN ADDRESS FIELD -- END/]
JRST EZERF
BDOUT: XWD 2,22
0 ;RELOCATION INFORMATION
BLOCK 22 ;ROOM FOR MANY MANY SYMBOLS.....
BNPT: ASCII / /
BLOCK 3
ASCII / /
COMMENT ⊗
ROUTINE TO PUT OUT SYMBOLS IN REASONABLE FASHION.
CALL IS WITH:
FS RADIX 50 FOR SYMBOL.
NA VALUE
L IF NON-ZERO, RELOCATED.
⊗
↓SBOUT:
PUSH P,O ;NEED AN AC.
AOS BDOUT
AOS O,BDOUT
MOVEM FS,BDOUT(O) ;NAME.
MOVEM NA,BDOUT+1(O) ;VALUE
TRZ L,12
TRZE L,4 ;CHANGE RELOCATION BITS.
TRO L,2
IDPB L,BYTPT ;STORE SAME.
CAME O,[XWD 2,22] ;DONE?
JRST STSQM ;DONE THIS SOON.
PUSH P,SBRRT
SBFRC: PUSH P,TAC
PUSH P,BC
MOVEI BC,BDOUT
HRRZ TAC,BDOUT ;COUNT
TRNN TAC,-1
JRST SBDON
MOVNS TAC ;- COUNT.
HRLI BC,-2(TAC) ;NEW COUNT.
PUSHJ P,GBOUT ;WRITE IT OUT.
SBDON: POP P,BC
POP P,TAC
SBRRT: POPJ P,.+1
STSYM: HLLZS BDOUT ;RESTART COUNT.
MOVE O,[POINT 4,BDOUT+1]
MOVEM O,BYTPT ;RESTART BYTE POINTER.
STSQM: POP P,O
POPJ P,
↑SBINI: PUSH P,O
JRST STSYM
BYTPT: 0
BEGIN BEND
↑↑BEND: MOVE NA,BLOCK
SUBI NA,1 ;FORM WORD WITH ALL...
MOVEM NA,OBLK ;HIGHER LEVEL BITS ON
MOVE NA,BLOCK
LSH NA,-1 ;FORM WORD WITH NEXT...
MOVEM NA,BLOCKN ;BIT ON
MOVE NA,BLOCK ;GET BLOCK...
FAD NA,[0] ;NUMBER
LDB NA,[POINT 8,NA,8]
MOVE FS,BNAM-347(NA);GET NEXT BLOCK NAME UP
MOVEM FS,LSTLAB+3 ;DEP FOR ERROR PRINT
MOVE FS,BNAM-346(NA);GET BLOCK NAME
PUSHJ P,R5CON ;CON TO R5
TLO FS,140000
SUBI NA,345
PUSH P,L
SETZM L ;NO RELOCATION.
PUSHJ P,SBOUT ;OUTPUT SYMBOL.
POP P,L
MOVE FS,BNAM-1(NA) ;GET NAME
MOVEM FS,NMBLK ;SAVE THE NAME
SKIPE CREFSW ;CREF?
CREF7 16,FS ;YES
PUSHJ P,AFROM6 ;CON TO ASCII
MOVEM T,BNPT+2 ;DEPOSIT
ORI FS,20000+22
MOVEM FS,BNPT+3
IDIVI NA,12 ;CONVERT LEVEL TO...
ORI PN,60 ;DECIMAL...
SKIPN NA ;...
SUBI NA,20
ADDI NA,60 ;...
DPB PN,[POINT 7,BNPT+4,13];AND..
DPB NA,[POINT 7,BNPT+4,6];DEPOSIT
MOVE NA,MTBPNT ;SET UP...
MOVEM NA,SPNT ;FOR PSYM
MOVEM NA,SSPNT ;...
SETZM SCOUNT ;...
SETOM MERCNT ;INIT MULT...
MOVEI NA,MERSTR ;DEF. LAB...
MOVEM NA,MERPNT ;MESSAGE AREA
MOVEI NA,HASH ;INITIAL SYMTAB COUNTER
LOOP1: MOVEM NA,NASAV ;SAVE
MOVEI NA,SYMTAB-1(NA);GET FIRST OF CHAIN
SKIPN O,(NA)
JRST NONC ;NONE
LOOP2: MOVE N,2(O) ;GET FLAGS
TDNN N,BLOCK ;THIS BLOCK?
JRST NOTHS ;NO
TLNE N,UDSF ;IS THIS A DEFINED-UNDEFINED?
JRST LITLAB ;YES, SPECIAL CODE FOR ALL OF IT
TLNE N,DEFFL ;DEFINED?
JRST NODEF ;NO
TLNE N,DAF!GLOBF;IS IT GLOBAL OR DOWN ARROW?
JRST DGLOB ;YES
CONT: SKIPE SYMOUT ;SYMBOL TABLE LISTING?
PUSHJ P,PSYM ;YES
TLNE N,INTF ;INTERNAL?
JRST UPAR1 ;YES, DON'T PUT OUT DEFN.
TLNE N,UPARF ;UPAROW?
SKIPN BLOCKN ;AND NOT AT OUTER LEVEL
SKIPA
JRST UPAR1 ;THEN DO NOT PUT OUT DEF
MOVE FS,(O) ;GET SIXBIT
SKIPE CREFSW
CREF66 11,(O)
PUSHJ P,R5CON ;CON TO R5
TLO FS,100000 ;BITS
MOVE N,2(O) ;GET FLAGS
TLNE N,DBLF ;←←?
TLO FS,SNB ;YES
PUSH P,NA
MOVE NA,3(O) ;GET VALUE
MOVE L,4(O) ;GET RELOC
; DPB L,[POINT 1,BDOUT+1,3]
; LSH L,-2
; DPB L,[POINT 1,BDOUT+1,2]
ITS,< TLNN N,ANONF> ;DON'T PUT IT OUT IF ANONYMOUS
PUSHJ P,SBOUT
POP P,NA
TLNE N,UPARF!INTF
JRST UPAR1
DEL: MOVE T,FSTPNT ;GET FREE STRG PNTR.
EXCH T,1(O) ;PUT THIS BACK ON FREE STRG.
MOVEM O,FSTPNT ;...
DEL2: MOVEM T,(NA) ;& REMOVE FROM CHAIN
SKIPE O,T ;ANY MORE?
JRST LOOP2 ;YES
NONC: SOSLE NA,NASAV ;GET NEXT SYMTAB CHAIN
JRST LOOP1
JRST LDON
UPAR1: MOVE L,(O) ;GET SIXBIT
SKIPN PN,1(O) ;ANY MORE?
JRST UPAR ;NO
MOVE T,O
CAMN L,(PN)
JRST UNFD
MOVE T,PN
SKIPN PN,1(PN)
JRST UPAR
JRST .-5 ;PN WILL POINT TO SYMBOL AND T WILL BE THE TLINK TO IT
UNFD: MOVEM T,SVLNK ;SAVE LINK
MOVE T,2(PN) ;GET FLAGS
TDNN T,BLOCKN ;NEXT BLOCK?
JRST UPAR ;NO
TLNN T,UDSF ;OR IF DEFINED-UNDEFINE
TLZN T,DEFFL ;DEFINED?
JRST MERR ;YES
TLNE N,DBLUPF
TRZA N,-1 ;DON'T CLEAR ↑ FLAG IF ↑↑
TDZ N,[XWD UPARF,-1]
OR T,N ;TRANSFER BITS
TLNE T,UDSF
JRST [MOVEM T,2(O)
MOVE T,SVLNK ;ELIM UPPER BLOCK
MOVE N,FSTPNT ;GET SECOND BLOCK ONTO FREE STORAGE
EXCH N,1(PN)
MOVEM N,1(T)
MOVEM PN,FSTPNT
EXCH PN,O ;EXCHANGE SO FIXUP COMBINE DONE RIGHT
JRST UPNOD1] ;AND AWAY WE GO
MOVEM T,2(PN) ;DEPOSIT
EXCH PN,O
SKIPE N,3(O) ;FIXUPS?
PUSHJ P,GFIX ;YES
SKIPE N,4(O) ;POL-FIXES?
PUSHJ P,PFIX ;YES
EXCH PN,O
SKIPN CREFSW
JRST .+3
CREF6 10,(O) ;COMBINE TWO CHAINS
CREF6 0,(PN)
HRLI N,3(O) ;DEFINE..
HRRI N,3(PN) ;IT ...
BLT N,4(PN) ;ABOVE
JRST DEL ;AND DELETE IT BELOW
MERER: ASCII /MULTIPLY DEFINED BY ↑
/
MERSTR: BLOCK 57
MEREND: BLOCK 2
MERCNT: 0
MERPNT: 0
MERR: AOSN MERCNT ;ANY YET?
ERROR MERER ;NO, THIS IS FIRST
MOVEI FS,MEREND
CAMGE FS,MERPNT ;TOO MANY FOR TABLE?
JRST DEL ;YES, IGNORE
MOVE FS,(PN) ;NO, GET SIXBIT
PUSHJ P,AFROM6 ;CON TO ASCII
MOVEM T,@MERPNT ;DEPOSIT
AOS MERPNT ;INCREMENT
OR FS,[BYTE(7)0,40,40,15,12]
MOVEM FS,@MERPNT;DEPOSIT
AOS MERPNT ;INCREMENT
SETZM @MERPNT
JRST DEL
UPAR: HRRES N ;GET BLOCK BIT
LSH N,-1 ;SHIFT
HLL N,2(O) ;GET FLAGS
TLNN N,DBLUPF ;NOT IF DOUBLE UP ARROW.
TLZ N,UPARF ;CLEAR UPARROW BIT
MOVEM N,2(O) ;REDEPOSIT
NOTHS: MOVEI NA,1(O) ;PAS THIS ONE...
SKIPE O,1(O) ;AND LEAVE...
JRST LOOP2 ;ALONE
JRST NONC ;NO MORE THIS CHAIN
DGLOB: TDNN N,OBLK ;ANY OTHER BLOCK BITS ON?
JRST CONT ;NO
GLB1: TLNN N,DAF ;↓?
TDZ N,BLOCK ;NO, GLOBAL, TURN OFF THIS BIT
MOVEM N,2(O) ;DEPOSIT
JRST NOTHS
NODEF: MOVE L,(O) ;GET SIXBIT
SKIPN PN,1(O) ;ANY MORE?
JRST UPAR ;NO
SRC1(L,PN,NFND,JRST UPAR)
NFND: MOVE T,2(PN) ;GET FLAGS
TDNN T,BLOCKN ;NEXT BLOCK UP?
JRST UPAR ;NO
TLNE T,DEFFL ;DEFINED?
JRST UPNOD ;NO
TLNE T,UDSF ;UNDEFINE - DEFINED SYMBOL
JRST MERR ;YES
SKIPN CREFSW
JRST .+3
CREF6 10,(O)
CREF6 0,(PN)
SKIPE N,3(O) ;ANY FIXUPS?
PUSHJ P,GFIX ;YES, PUT OUT
SKIPE N,4(O) ;ANY POLFIXES?
PUSHJ P,PFIX ;YES, DO
JRST DEL
UPNOD: MOVE L,2(O) ;GET FLAGS
AND L,[XWD EXTF!INTF!VARF!UDSF,0]
ORM L,2(PN) ;DEPOSIT CERTAIN FLAGS
UPNOD1: SKIPN CREFSW
JRST .+3
CREF6 10,(O)
CREF6 0,(PN)
SKIPN L,3(O) ;APPEND...
JRST AHD
MOVE T,3(PN) ;FIXUPS...
MOVEM L,3(PN) ;FOR...
ALOP: SKIPN FS,1(L) ;ONE...
JRST EFND ;OCCURANCE...
MOVE L,FS ;ONTO THOSE...
JRST ALOP ;OF THE...
EFND: MOVEM T,1(L) ;OTHER
AHD: SKIPN L,4(O) ;APPEND...
JRST PFND1
MOVE T,4(PN) ;POLFIXES...
MOVEM L,4(PN) ;FOR...
MOVSS L
PLOP: MOVEM PN,(L) ;ONE...
SKIPN FS,2(L) ;OCCURANCE...
JRST PFND ;ONTO...
MOVS L,FS ;THOSE...
JRST PLOP ;OF THE...
PFND: MOVEM T,2(L) ;OTHER
PFND1: MOVE T,2(PN) ;MORE FLAGS
CAME O,FSTPNT ;THIS WILL BE TRUE ONLY IF WE CAME FROM ↑UDSF
JRST DEL
EXCH PN,O
JRST NOTHS ;SKIP DELETING THIS
OBLK: 0
NASAV: 0
BLOCKN: 0
NMBLK: 0
SVLNK: 0
LITLAB: TLNE N,DAF!GLOBF ;BOY ARE THESE A PAIN
JRST LITGLB
SKIPE SYMOUT
PUSHJ P,PSYM
TLNE N,INTF!UPARF ;BUT THESE ARE WORSE
JRST UPAR1 ;BEACUSE OF THE PAIN THEY CAUSE HERE
LITCNT: MOVE FS,(O) ;GET SIXBIT
SKIPE CREFSW
CREF66 11,(O)
PUSHJ P,R5CON
TLO FS,100000 ;SET TO LOCAL
MOVSI N,SYMFIX ;SAY WE NEED SYMBOL TABLE FIXUP
IORB N,2(O) ;GET FLAGS
TLNE N,DBLF
TLO FS,SNB ;SET DELETE FLAG
PUSH P,L
PUSH P,NA
SETZB L,NA
PUSHJ P,SBOUT
POP P,NA
POP P,L
MOVE T,NMBLK
EXCH T,1(O) ;PUT BLOCK NAME IN
JRST DEL2 ;GO FINISH THE DELETE
LITGLB: TDNN N,OBLK
JRST LITCNT
JRST GLB1
LDON: PUSH P,B
PUSH P,C
MOVEI NA,HASH ;PREPARE TO CUT BACK OPDEFS.
MOVE T,BLOCK ;TEST WORD
MOVSI FS,20 ;@ BIT
OLOP1: SKIPN N,OPCDS-1(NA);GET FIRST CHAIN
JRST NONT ;NONE
OLOP: TDNN FS,1(N) ;ORDINARY OP?
JRST ENDF ;YES, GO NO FURTHER
SKIPGE 1(N) ;PSEUDO-OP?
JRST ENDF ;YES
TDNN T,2(N) ;THIS BLOCK?
JRST ENDF ;NO, QUIT
PUSH P,N ;SAVE POINTER
MOVE FS,(N) ;GET OPDEF NAME
SKIPE CREFSW
CREF66 13,(N)
PUSHJ P,R5CON ;TO RADIX50 FOR DDT
POP P,N
TLO FS,100000 ;SET AS LOCAL
PUSH P,NA ;SAVE IT.....
PUSH P,L
MOVE NA,3(N) ;GET VALUE
MOVE L,4(N) ;AND FLAGS FOR RELOC
ITS,<
PUSH P,T
MOVE T,2(N)
TLNN T,ANONF ;DON'T HACK ANONYMOUS OPDEFS
PUSHJ P,SBOUT
POP P,T
>;ITS
NOITS,< PUSHJ P,SBOUT >
POP P,L
POP P,NA
MOVSI FS,20 ;RESTORE LOST FS
MOVE O,FSTPNT
EXCH O,1(N)
MOVEM N,FSTPNT ;PUT BACK IN FREE STRG
HRRZ N,O ;GET NEXT
JUMPN N,OLOP ;ANY MORE?
ENDF: MOVEM N,OPCDS-1(NA)
NONT: SOJG NA,OLOP1 ;CONTINUE WITH NEXT CHAIN
MOVEI NA,HASH ;PREPARE TO CUT BACK MACROS
MLOP1: SKIPN N,MACRT-1(NA);GET CHAIN
JRST MNON ;NONE
MLOP: TDNN T,2(N) ;THIS BLOCK?
JRST ENDM ;NO, QUIT
SKIPE CREFSW
CREF66 13,(N)
MOVE C,4(N) ;GET START
HLRZ B,(C) ;GET LENGTH
ADD B,C ;GET END
PUSHJ P,MACRET
MOVE O,FSTPNT ;PUT BACK ON FREE STRG.
EXCH O,1(N) ;...
MOVEM N,FSTPNT ;...
SKIPE N,O
JRST MLOP
ENDM: MOVEM N,MACRT-1(NA)
MNON: SOJG NA,MLOP1 ;GET NEXT CHAIN
MOVE N,BLOCK ;SHIFT...
LSH N,-1 ;BLOCK...
MOVEM N,BLOCK
SUBI N,1 ;AND...
SETCA N,
HRLI N,DAF
MOVEM N,DBLCK ;DBLCK
SKIPE SYMOUT ;SYMBOL LISTING?
PUSHJ P,PSYMGO ;YES
TRAN BNPT ;LIST BLOCK NAME
POP P,C
POP P,B
POPJ P,
PSYM: TRNN LDEV ;LIST DEV?
POPJ P, ;NO
SNBN←←377777
HRRZ T,SPNT ;SET UP...
HRLI T,2(O) ;BLT WRD
MOVEI L,3 ;INCREMENT...
ADDB L,SPNT ;POINTER
LEG SETZM -1(L) ;TO GET INTERRUPT IF CORE EXCEEDED
BLT T,-1(L) ;SAVE VALUE
MOVE T,(O) ;GET SIXBIT
TLNN T,770000 ;LEFT ADJUST
LSH T,6
TLNN T,770000
JRST .-2
TLC T,SNB ;INVERT SIGN FOR COMPARE
MOVEM T,-3(L) ;DEPOSIT
AOS SCOUNT ;...
POPJ P,
PSYMGO: SKIPN SCOUNT ;ANY?
POPJ P, ;NO
PUSHJ P,LSTCHK
MOVEI TAC,[BYTE (7)15,12]
PUSHJ P,LOUT
SLOOP2: HRLOI FS,SNBN ;INIT
MOVE NA,SCOUNT ;GET COUNT
MOVE PN,SSPNT ;GET START
SLOOP1: CAMG FS,(PN) ;COMPARE
JRST SPT1 ;NEW ONE LARGER
MOVE N,PN ;SAVE POINTER
MOVE FS,(PN) ;GET NEW SIXBIT
SPT1: ADDI PN,3 ;GO TO NEXT
SOJG NA,SLOOP1 ;LOOP
CAMN FS,[XWD SNBN,-1];DONE?
JRST [MOVEI TAC,[BYTE (7)15,12]
JRST LOUT]
HRLOI NA,SNBN ;REMOVE...
MOVEM NA,(N) ;THIS ONE
TLC FS,SNB ;REINVERT SIGN
PUSHJ P,AFROM6 ;CON TO ASCII
MOVEM T,SOUT ;DEPOSIT
TLO FS,220 ;PUT IN TAB
MOVEM FS,SOUT+1 ;DEPOSIT
MOVS FS,1(N) ;GET VALUE...
MOVE TAC,2(N) ;& RELOC
SETZM SOUT+2
MOVEI T,22
MOVEM T,SOUT+3
TRNN FS,-1 ;LEFT HALF =0?
JRST SPT2 ;YES
MOVSS FS ;GET LEFT HALF
LSH TAC,-2 ;& RELOC
PUSHJ P,OCON ;CON TO OCTAL ASCII
MOVEM T,SOUT+2 ;DEPOSIT
MOVEM FS,SOUT+3 ;...
MOVS FS,1(N) ;GET RIGHT HALF
MOVE TAC,2(N) ;& RELOC
SPT2: PUSHJ P,OCON ;CONVERT
MOVEM T,SOUT+4 ;DEPOSIT
MOVEM FS,SOUT+5 ;...
MOVE TAC,[XWD -7,SOUT]
PUSHJ P,LOUT ;OUTPUT IT
JRST SLOOP2
SOUT: BLOCK 6
BYTE (7)15,12
;AFROM6: CONVERTS 6-BIT TO ASCII. CALL WITH 6-BIT IN FS.
; RETURNS ASCII IN T & FS.
↑AFROM6:MOVEI T,
ALE1: LSHC T,6 ;GET CHR.
TRCE T,40 ;CON TO ASCII
TRO T,100 ;...
LSH T,1 ;LEAVE ROOM
TLNN T,700000 ;5 CHRS?
JRST ALE1 ;NO
LSH FS,-1 ;ADJUST FINAL CHR.
TLCE FS,200000 ;CON TO ...
TLO FS,SNB ;ASCII
POPJ P,
SCOUNT: 0
SPNT: 0
SSPNT: 0
BEND
↑AFROM6←AFROM6
BEND
%BEG: MOVE N,BLOCK ;GET BLOCK...
TRNE N,600000 ;LEGAL BEGIN?
ERROR[ASCIZ/BLOCKS NESTED TOO DEEP/]
LSH N,1 ;SHIFT
MOVEM N,BLOCK ;RESTORE
MOVNS N ;FORM DBLK...
HRLI N,DAF ;...
MOVEM N,DBLCK ;...
PUSHJ P,SCAN ;GET NAME, IF ANY
TLNE IFLG ;IDENT?
JRST %BPT ;YES
MOVE L,['A.000'];GET BASIC
MOVE FS,%BCUR ;GET CURRENT NUM
DPB FS,[POINT 3,L,35]
LSH FS,-3
DPB FS,[POINT 3,L,29]
LSH FS,-3
DPB FS,[POINT 3,L,23]
%BPT: AOS %BCUR ;INCREMENT
MOVEM L,LSTLAB+3;DEPOSIT FOR ERROR MESSAGE PRINTER
MOVE T,BLOCK
FAD T,[0]
LDB T,[POINT 8,T,8];GET NUM
MOVEM L,BNAM-346(T);DEPOSIT NAME
SKIPE CREFSW ;CREF?
CREF7 15,L ;YES
MOVE FS,L ;GET NAME
MOVE NA,T
PUSHJ P,AFROM6 ;CON TO ASCII
MOVEM T,%BQ+2 ;DEPOSIT
ORI FS,20022 ;...
MOVEM FS,%BQ+3 ;...
SUBI NA,345 ;GET LEVEL NUMBER
IDIVI NA,12 ;CON TO...
SKIPN NA ;DECIMAL...
SUBI NA,20 ;...
ADDI NA,60 ;...
ADDI PN,60 ;...
DPB NA,[POINT 7,%BQ+4,6]
DPB PN,[POINT 7,%BQ+4,13]
TRAN %BQ ;LIST BLOCK NAME & LEVEL
JRST NSPCFN
%BCUR: 0
%BQ: ASCII / /
BLOCK 3
ASCII / /
%BEND: MOVE T,BLOCK
SOJLE T,BERR ;BARF IF ALREADY OUTER BLOCK
PUSHJ P,SCAN ;GET OPTIONAL BLOCK NAME
TLNN IFLG
JRST BENDNA
MOVE T,BLOCK
FSC T,32
ROT T,9
CAME L,BNAM(T)
ERROR [ASCIZ /BLOCK NAME MISMATCH/]
BENDNA: PUSH P,N
PUSHJ P,BEND
POP P,N
JRST NSPCFN
BERR: ERROR [ASCIZ /TOO MANY BENDS/]
JRST NSPCFN
;LITOUT -- TO OUTPUT LITTERALS
BEGIN LITOUT
↑LITOUT:
MOVSI NA,-HASH ;HERE WE MAKE ALL THE BUCKETS INTO ONE BIG LIST
MOVEI O,LITPNT-1
SKIPN T,LITPNT(NA)
LITLP1: AOBJN NA,.-1
JUMPGE NA,LITGO
SETZM LITPNT(NA)
MOVEM T,1(O)
LITLP2: SKIPN T,1(O)
JRST LITLP1
SKIPE O,1(T)
JRST LITLP2
MOVE O,T
JRST LITLP1
LITGO: SKIPN NA,LITPNT ;GET LITERAL LIST
POPJ P, ;NONE
LOP2: MOVE O,1(NA) ;GET NEXT
PUSHJ P,LITCOM ;COMPARE WITH OTHER LITS & TACK TOGETHER
HLRZ L,2(NA) ;ANY LABELS
JUMPE L,NOLBS ;NO
PUSH P,O
PUSH P,NA
MOVE O,L
PT1: MOVE PN,4(O) ;GET POINTER TO SYMBOL TABLE ENTRY
MOVE N,PCNT ;GET VALUE
MOVE NA,PCNT+1
ADD N,3(O) ;ADD COUNT
PUSHJ P,LVDEF ;DEFINE IT
MOVE N,FSTPNT
SKIPE (O) ;CHECK FOR $. KLUDGE
JRST LLOK ;NOPE
MOVEM N,1(PN) ;RETURN "SYM" TO FS
MOVEI N,(PN)
LLOK: EXCH N,1(O) ;NOW RET LITLAB BLK
MOVEM O,FSTPNT
SKIPE O,N
JRST PT1
POP P,NA ;RESTORE
POP P,O
NOLBS: MOVEI PN,PCNT-3;SET UP "VALUE" POINTER FOR GFIX
SKIPE N,3(NA) ;GET FIXUP POINTER
PUSHJ P,GFIX ;PUT OUT FIXUPS
SKIPE N,4(NA)
PUSHJ P,PFIX
MOVE N,FSTPNT ;GET FREE STRG
MOVEM N,1(NA) ;PUT THIS BACK ON FREE STRG
MOVEM NA,FSTPNT ;...
HRRZ L,2(NA) ;GET VALUES
LOP1: SKIPN 4(L) ;ANYTHING HERE?
JRST LPT3 ;NO
HRLI PN,3(L) ;GET POINTER TO VALUE
HRRI PN,WRD
BLT PN,WRD+1 ;PUT IN WRD
PUSHJ P,BLOUT ;LIST VALUE
OUTP 3(L) ;OUTPUT VALUE
SKIPN N,(L) ;REVERSE FIXUP?
JRST LPT1 ;NO
JUMPGE N,.+3 ;POLISH FIXUP?
PUSHJ P,POLHAN ;YES, HANDLE
JRST LPT1
HRRI TAC,3(N)
HRLI TAC,OPCNT
BLT TAC,4(N) ;SET FIXUP WHICH POINTS HERE TO
;POINT TO CORE
LPT1: SKIPN N,2(L) ;REVERSE FIXUP, LEFT HALF?
JRST LPT2 ;NO
JUMPGE N,.+3
PUSHJ P,POLHAN
JRST LPT2
HRRI TAC,3(N)
HRLI TAC,OPCNT
BLT TAC,4(N) ;SET THIS ONE
LPT2: AOS OPCNT ;INCREMENT
MOVE N,OPCNT
CAMGE N,BRK
JRST .+5
CAMGE N,HICNT
JRST .+5
MOVEM N,HICNT
JRST .+3
CAML N,@CURBRK
MOVEM N,@CURBRK
AOS PCNT ;...
LPT3: MOVE N,FSTPNT
EXCH N,1(L) ;PUT THIS BACK...
MOVEM L,FSTPNT ;IN FREE STRG.
SKIPE L,N ;ANY MORE
JRST LOP1 ;YES
SKIPE NA,O ;GET NEXT LITTERAL, MORE?
JRST LOP2 ;THERE ARE MORE
SETZM LITPNT
POPJ P,
POLHAN: MOVE TAC,OPCNT ;GET PLACE WHERE THIS IS...
MOVEM TAC,2(N) ;GOING & MAKE POLFIX...
MOVE TAC,OPCNT+1;POINT THERE
MOVEM TAC,3(N)
SKIPLE 1(N) ;NO UNDEF SYMS LEFT?
POPJ P, ;SOME LEFT
MOVEI FS,5(N) ;SET UP POINTER
PUSH P,O ;SAVE
PUSH P,L
PUSHJ P,REDUC ;REDUCE THE POLISH
PUSHJ P,BFRC ;FORCE OUT BINARY
MOVEI FS,5(N) ;SET UP POINTER
PUSHJ P,POLOUT ;PUT OUT POLFIX
POP P,L
POP P,O
POPJ P,
↑LITCOM:SKIPN O ;ANY?
POPJ P,
MOVEI PN,O ;FIRST POINTER IS IN O
MOVE N,O ;GET FIRST POINTER
LOOP1: PUSHJ P,LCOM ;LITS AT N & NA SAME?
JRST SAM ;YES
MOVEI PN,1(N) ;NEXT POINTER IS HERE
LOOP3: SKIPE N,(PN) ;GET NEXT POINTER, MORE?
JRST LOOP1 ;YES
POPJ P, ;NO
SAM: SKIPN L,3(N) ;GET FIXUPS FOR ONE
JRST NOTN1
MOVE T,3(NA) ;GET FIXUPS FOR OTHER
MOVEM L,3(NA) ;DO AN APPEND
JUMPE T,NOTN1
LOOP2: SKIPN FS,1(L) ;...
JRST EFND
MOVE L,FS
JRST LOOP2
EFND: MOVEM T,1(L) ;...
NOTN1: SKIPN L,4(N) ;ALSO APPEND POLFIXES
JRST NOTN2
MOVE T,4(NA)
MOVEM L,4(NA)
JUMPE T,NOTN2
LPQ2: SKIPN FS,1(L)
JRST Q2FND
MOVE L,FS
JRST LPQ2
Q2FND: MOVEM T,1(L)
NOTN2: HLRZ L,2(N) ;ALSO APPEND LABELS
JUMPE L,NOTN3
HLRZ T,2(NA)
HRLM L,2(NA)
JUMPE T,NOTN3
LPQ3: SKIPN FS,1(L)
JRST Q3FND
MOVE L,FS
JRST LPQ3
Q3FND: MOVEM T,1(L)
NOTN3:
MOVE T,1(N) ;SKIP THIS ONE...
MOVEM T,(PN) ;IN CHAIN
MOVE FS,FSTPNT ;& PUT BACK ON FREE STRG. ...
MOVEM FS,1(N) ;...
HRRZ FS,2(N) ;GET VALUE CHAIN
MOVEM FS,FSTPNT ;POINT FREE STRG AT IT
LOOP4: SKIPN T,1(FS) ;SEARCH FOR END OF VALUE CHAIN
JRST VFND ;FOUND
MOVE FS,T
JRST LOOP4
VFND: MOVEM N,1(FS) ;POINT TI TO REST OF FREE STRG.
JRST LOOP3 ;PROCEED
LCOM: MOVE T,(N) ;GET COUNT
CAME T,(NA) ;SAME?
JRST NOSAM ;NO
MOVE FS,2(N) ;GET VALUE ...
MOVE L,2(NA) ;CHAINS
LOOP5: MOVE TAC,3(FS) ;COMPARE FIRST
CAME TAC,3(L) ;VALUE WORD
JRST NOSAM ;DIFFERENT
MOVE TAC,4(FS) ;ALSO COMP...
CAME TAC,4(L) ;FLAGS
JRST NOSAM ;DIFF
SKIPN (FS) ;DEFINED?
SKIPE 2(FS) ;...
JRST NOSAM ;NO
SKIPN (L) ;DEFF?...
SKIPE 2(L) ;...
JRST NOSAM ;NO
MOVE FS,1(FS) ;GET NEXT...
MOVE L,1(L) ;...
SOJG T,LOOP5 ;DONE
POPJ P, ;YES, SAME
NOSAM: AOS(P)
POPJ P,
VCNT: 0
↑VAR: PUSHJ P,BFRC ;FORCE OUT BIN
MOVE NA,PCNT+1 ;GET READY
SKIPN TAC,VARLST
POPJ P, ;NONE THERE
LOOP.1: MOVE PN,FSTPNT ;PUT BACK ON FREE STORAGE
EXCH PN,1(TAC)
MOVEM PN,VARLST ;KEEP VARLST UP TO DATE
MOVEM TAC,FSTPNT
MOVE PN,(TAC) ;POINTER TO SYMBOL
AOS N,2(TAC)
ADDM N,OPCNT
EXCH N,PCNT
ADDM N,PCNT
PUSHJ P,LVDEF
MOVE N,OPCNT
CAMGE N,BRK
JRST .+5
CAMGE N,HICNT
JRST .+5
MOVEM N,HICNT
JRST .+3
CAML N,@CURBRK
MOVEM N,@CURBRK
SKIPE TAC,VARLST
JRST LOOP.1
POPJ P,
↑%VAR: MOVE N,OPCNT+1
TLNE N,INCF
JRST PSLIT
PUSHJ P,VAR
JRST SPCFN
BEND
SUBTTL ..ORG.. INCLUDES ORG, LOC, RELOC, USE, AND SET
;ORG INCLUDES ORG, LOC, RELOC, PHASE, DEPHASE, USE, AND SET
BEGIN ORG
↑%ORG: MOVE NA,OPCNT+1
TLNE NA,INCF
JRST PSLIT
MOVEM N,SV ;SAVE VALUE
PUSHJ P,BFRC ;FORCE OUT BINARY
PUSHJ P,FXFRC ;FORCE OUT FIXUPS
TRO NOFXF
PUSHJ P,MEVAL ;GET VALUE
TLNE UNDF ;DEFINED?
JRST OERR ;NO
TLNE ESPF ;SPC. CHR?
JRST SCR ;YES
MOVE T,[XWD PCNT,PCSAV]
BLT T,PCSAV+3 ;SAVE OLD LOC.
SKIPN SV ;IS IT LOC?
MOVEI NA, ;YES
SKIPGE SV ;IS IT RELOC?
MOVEI NA,1 ;YES
ORG2: ANDI N,777777 ;LEAVE US NOT GET CONFUSED
XOR NA,PCNT+1 ;SET
TRNE NA,1 ;CHANGING RELOCATION?
JRST ORG4
ORG5: SUB N,PCNT
ADDM N,PCNT
ADDB N,OPCNT
ORG3: MOVEI T,(N)
ORG3A: MOVE NA,OPCNT+1
TRNN NA,1
SKIPA NA,[ABSCNT]
MOVEI NA,LOCNT
MOVEM NA,CURBRK
CAMGE T,BRK ;HIGH SEG?
JRST .+5 ;NO,LOW
CAMGE T,HICNT ;YES,IS OPCNT≥HICNT
JRST .+5 ;NO
MOVEM T,HICNT ;YES, INCREMENT HIGH
JRST .+3
CAML T,@CURBRK ;IS OPCNT≥LOCNT?
MOVEM T,@CURBRK ;YES, INCREMENT LOW
TLNE ESPF
JRST NSPCFN
JRST SPCFN
ORG4: XORB NA,PCNT+1 ;STORE RELOC, GET BACK ORIGINAL VALUE
MOVEM NA,DPCNT+1;AND STORE HERE ALSO
XOR NA,OPCNT+1 ;TEST THIS ONE
XORM NA,OPCNT+1 ;AND STORE IT
TRNE NA,1
JRST ORG5
;SORRY, PCNT AND OPCNT HAVE DIFFERENT RELOCATION
ERROR[ASCIZ/INDETERMINATE PHASE DUE TO RELOC, WILL DEPHASE/]
MOVE NA,PCNT+1
MOVEM NA,OPCNT+1
MOVEM N,PCNT
MOVEM N,OPCNT
JRST ORG3
SCR: MOVE T,[XWD PCNT,PCSAV+4]
MOVE O,[XWD PCSAV,PCNT]
MOVE NA,[XWD PCSAV+4,PCSAV]
BLT T,PCSAV+7
BLT O,PCNT+3 ;EXCHANGE OLD & REAL OLD
BLT NA,PCSAV+3
MOVE NA,PCNT+1
MOVEM NA,DPCNT+1
HRRZ T,OPCNT
JRST ORG3A
SV: 0
PCSAV: BLOCK 10
OERR: ERROR[ASCIZ/UNDEFINED FIELD -- ORG/]
JRST SPCFN
BEGIN USE
↑↑%USE: MOVE N,OPCNT+1
TLNE N,INCF
JRST PSLIT
PUSHJ P,BFRC ;FORCE OUT BIN
PUSHJ P,FXFRC ; " " FIXUPS
TLNE B,SPCLF ;SPCL CHR NEXT?
JRST SPCL ;YES
PUSHJ P,SCAN ;GET IDENT
TLNN IFLG ;IDENT?
JRST ERR ;NO
MOVE N,CURNT ;GET CURRENT POINTER
MOVSI O,PCNT
HRRI O,2(N) ;RESET...
BLT O,4(N) ;...
MOVE O,OPCNT+1 ;CURRENT...
HRLM O,3(N) ;ONE...
SKIPN N,NULN+1 ;GET CHAIN POINTER
JRST NON
LOOP1: CAMN L,(N) ;THIS ONE?
JRST FND ;YES
SKIPE N,1(N) ;NO, GET NEXT, ANY?
JRST LOOP1
NON: GFST NA,FSTPNT ;GET FREE STRG
MOVE N,NULN+1 ;GET POINTER
EXCH N,1(NA) ;INSERT NEW ONE
MOVEM N,FSTPNT
MOVEM NA,NULN+1
MOVEM L,(NA) ;DEPOSIT SIXBIT
MOVEM NA,CURNT ;THIS ONE NOW CURRENT
JRST SPCFN
SPCL: MOVE N,CURNT ;GET CURRENT
MOVSI O,PCNT ;AND RESET
HRRI O,2(N)
BLT O,4(N)
MOVE O,OPCNT+1
HRLM O,3(N)
MOVEI N,NULN
FND: MOVSI O,2(N) ;GET SOURCE
HRRI O,PCNT ;GET DEST.
MOVEM N,CURNT ;THIS ONE NOW CURRENT
BLT O,PCNT+2 ;BLT IN...
HLR O,PCNT+1 ;...
HRRZM O,OPCNT+1 ;;;
TRNN O,1
SKIPA O,[ABSCNT]
MOVEI O,LOCNT
MOVEM O,CURBRK
HRRZS PCNT+1 ;...
MOVE O,PCNT+1
MOVEM O,DPCNT+1
JRST SPCFN
↑NULN: BLOCK 5
↑CURNT: 0
↑SNULN: 0
0
0
1(1)
0
NULN
ERR: ERROR[ASCIZ/ILL. FORMAT -- USE/]
JRST SPCFN ;RETURN
BEND
↑NULN←NULN
↑SNULN←SNULN
BEGIN SET
↑↑%SET: MOVE N,OPCNT+1
TLNE N,INCF
JRST PSLIT
TLNE B,SPCLF ;SPC CHR NEXT
JRST SPCL ;YES ITS FOR NULL
PUSHJ P,SCAN ;GET IDENT
TLNN IFLG ;IDENT?
JRST ERR ;NO
SKIPN N,NULN+1 ;GET LIST, ANY?
JRST NON ;NO
LOOP1: CAMN L,(N) ;THIS ONE?
JRST FND ;YES
SKIPE N,1(N)
JRST LOOP1
NON: GFST N,FSTPNT ;GET FREE STRG
MOVE NA,NULN+1
EXCH NA,1(N) ;PUT ON LIST
MOVEM NA,FSTPNT
MOVEM N,NULN+1
MOVEM L,(N) ;DEPOSIT SIXBIT
FND: PUSH P,N
TRNE B,COMF ;,?
PUSHJ P,SCAN ;YES, SKIP
TDO [XWD OPFLG,NOFXF]
PUSHJ P,MEVAL ;EVALUATE EXPRESSION
POP P,T ;GET POINTER
TLNE UNDF!ESPF ;DEFINED?
JRST ERR ;NO
CAMN T,CURNT ;CURRENT ONE?
JRST ORG2 ;YES
HRRZM N,2(T) ;DEPOSIT VALUE...
HRRZM N,4(T) ;...
MOVEM NA,3(T) ;DEPOSIT RELOC
HRLM NA,3(T) ;...
JRST SPCFN
SPCL: MOVEI N,NULN
JRST FND
ERR: ERROR[ASCIZ/ILL. FORMAT -- SET/]
JRST SPCFN
BEND
BEND
SUBTTL MACROS, FOR, REPEAT, IF'S
BEGIN MAC
↑%DEF: PUSHJ P,SCAN ;GET NAME OF MACRO
TLNN IFLG ;IDENT?
JRST DERR1 ;NO
MOVE T,L ;GET SIXBIT
IDIVI T,HASH ;HASH
MOVMS FS
SKIPN O,MACRT(FS)
JRST DEF2
SRC2 L,O,REDEF
DEF2: GFST O,FSTPNT ;GET FREE STRG
MOVE T,MACRT(FS);PUT INTO CHAIN
EXCH T,1(O) ;...
MOVEM T,FSTPNT
MOVEM O,MACRT(FS)
MOVEM L,(O) ;DEPOSIT SIXBIT
MOVE N,BLOCK
MOVEM N,2(O) ;DEPOSIT BLOCK BIT
DEF3: SKIPE XCRFSW ;CREF?
CREF6 6,(O) ;YES
MOVE FS,MTBPNT ;GET POINTER TO FREE MACRO AREA
MOVEM FS,4(O) ;DEPOSIT POINTER
MOVEI T, ;ZERO ARG COUNT
TDNE B,[XWD CRFG,LBCF];CR OR { NEXT?
JRST NOCAT ;YES, NO CONCAT
TRNE B,LFPF ;(NEXT?
JRST NOCAT ;YES, NO CONCAT
TRNE B,RBCF ;} ?
JRST [ERROR[ASCIZ/ILLEGAL CONCATENATION CHR/]
JRST NOCAT]
PUSH P,C ;SAVE CONCAT CHR.
TLZ SFL ;SKIP CONCAT CHR.
SKIPA
NOCAT: PUSH P,[200] ;NO CONCAT CHR.
PUSHJ P,SCAN ;GET TO THE (
TLNN SCFL ;SPC. CHR?
JRST .-2 ;NO
TRNN N,LFPF!LBCF;( OR { ?
JRST .-4 ;NO
TRNE N,LBCF ;{ ?
JRST NOARG ;YES, NO ARGS
TRNE B,RTPF ;) NEXT?
JRST AEND ;YES
ALOP: PUSHJ P,SCAN ;GET ARG
TLNN IFLG ;IDENT?
ERROR[ASCIZ/ARGUMENT NOT IDENT/]
LEG MOVEM L,(FS) ;DEPOSIT ARG
ADDI FS,1 ;INCREMNT STRG PNTR.
CLOP: TRNN B,COMF ;, NEXT?
JRST .+3 ;NO
TLZ SFL ;YES, SKIP THE ,
AOJA T,ALOP
TRNE B,RTPF ;) NEXT?
AOJA T,AEND ;YES
PUSHJ P,SCAN ;GET NEXT
JRST CLOP
AEND: PUSHJ P,SCAN ;GET TO THE {
TLNN SCFL ;SPC CHR?
JRST .-2 ;NO
TRNN N,LBCF ;{ ?
JRST .-4 ;NO
NOARG: POP P,NA ;GET CONCAT CHR.
CAIN NA,200 ;ANY?
JRST NOCTA ;NO
PUSH P,CTAB(NA) ;SAVE OLD BITS
MOVSI N,SPCLF!SPFL;GET NEW BITS
MOVEM N,CTAB(NA);DEPOSIT
NOCTA: PUSH P,NA ;SAVE CHR
MOVE N,FS ;POINT TO PLACE TEXT...
HRLI N,700 ;SHOULD GO
MOVE NA,MTBPNT ;ARG POINTER
PUSHJ P,TXTIN ;GET TEXT IN
MOVEI L,177
LEG IDPB L,N ;DEPOSIT END...
MOVEI L,3 ;OF MACRO...
LEG IDPB L,N ;INDICATION
MOVEM T,3(O) ;DEPOSIT ARG COUNT
MOVEM O,(FS) ;DEPOSIT REVERSE POINTER
MOVEI L,1(N) ;GET END
SUB L,FS ;FORM LENGTH
HRLM L,(FS) ;DEPOSIT
JUMPE T,BNOA ;NO ARGS?
MOVS TAC,FS ;PREPARE TO MOVE UP
HRR TAC,MTBPNT ;...
SUBI N,(T)
BLT TAC,(N)
BNOA: ADDI N,1
HRRZM N,MTBPNT ;ADVANCE POINTER
POP P,N ;GET CONCAT CHR.
CAIE N,200 ;NO CONCAT?
POP P,CTAB(N) ;RESTORE BITS
JRST SPCFN
DERR1: ERROR[ASCIZ/NOT IDENT AFTER DEFINE/]
JRST SPCFN
;HERE IF REDEFINING MACRO
REDEF: HRRZ N,2(O)
CAME N,BLOCK
JRST DEF2 ;DIFFERENT BLOCK
PUSH P,B ;SAME BLOCK - FLUSH OLD TEXT & RE-USE SYM BLK
PUSH P,C
MOVE C,4(O)
HLRZ B,(C)
ADDI B,(C)
PUSHJ P,MACRET
POP P,C
POP P,B
JRST DEF3
;TXTIN: CALL, TO READ TEXT INTO CORE, WITH PLACE IT IS TO GO
;IN N, ARG POINTER IN NA, ARG COUNT IT T, CONCAT
;CHR. ON TOP OF STACK. USES PN,TAC,L
↑TXTIN: SETZM BCNT ;INIT { } COUNT
MOVE PN,PGNM
MOVEM PN,TXTIPG
MOVE PN,TLBLK
MOVEM PN,SVLIN
SKIPA
NLOOP1: LEG IDPB C,N
NLOOP: PUSHJ P,SCAN1 ;GET CHR.
JUMPGE B,SPCCHR ;SPC. CHR?
TLNE B,NMFLG ;NUM?
JRST SNUMS ;YES
MOVEM N,NSTO
LEG IDPB C,N
MOVEI PN,(B) ;GET SIXBIT
ILOOP: PUSHJ P,SCAN1 ;GET CHR.
JUMPGE B,ISPC ;SPC CHR?
LEG IDPB C,N ;NO, DEPOSIT
TLNE PN,770000 ;6 CHRS?
JRST ILOOP ;YES
LSH PN,6
ORI PN,(B) ;INSERT
JRST ILOOP
ISPC: JUMPE T,SPCCHR ;NO ARGS?
MOVE TAC,T ;GET COUNT
MOVE L,NA ;GET POINTER
ALOOP: CAMN PN,(L) ;ARG?
JRST YUP ;YUP
ADDI L,1
SOJG TAC,ALOOP ;LOOP
SPCCHR: CAMN C,-1(P) ;CONCAT CHR?
JRST NLOOP ;YES
TRNE B,LBCF ;{ ?
AOS BCNT ;YES, COUNT
TRNE B,RBCF ;} ?
SOSL BCNT ;YES,COUNT
JRST NLOOP1 ;RETURN
SETZM TXTIPG
POPJ P, ;RETURN
YUP: MOVEI PN,177 ;DEPOSIT ARG POINTER...
MOVE N,NSTO ;GET POINTER
LEG IDPB PN,N ;...
MOVEI PN,1 ;...
LEG IDPB PN,N ;...
MOVE L,T ;FORM ARG NUMBER...
SUB L,TAC ;...
LEG IDPB L,N ;AND DEPOSIT
JRST SPCCHR
SNUMS: LEG IDPB C,N ;DEPOSIT
PUSHJ P,SCAN1 ;GET CHR.
JUMPL B,SNUMS ;NOT SPC CHR?
JRST SPCCHR ;SPCCHR
NSTO: 0
BCNT: 0
;ARGIN: CALL TO READ IN ARGS. USES NEXT FREE SPACES
; IN CONTIGUAOUS AREA. USES N,PN,TAC,NA ;# OF ARGS
; SHOULD BE IN N
↑ARGIN: HRRZ NA,MTBPNT ;GET FREE AREA
BEGIN ARGIN
PUSH P,NA ;SAVE ON PDL (RECURSIVE)
ADD NA,N ;ADD # OF ARGS
HRLI NA,440700 ;MAKE INTO POINTER
PUSHJ P,SCAN1 ;GET NEXT CHR.
TRNN B,LFPF ;(?
JRST CRMOD ;NO
LOOP2: PUSHJ P,SCAN1 ;YES,PASS IT
LEG MOVEM NA,@(P) ;DEPOSIT POINTER TO FIRST ARG
TRNE B,BSLF ;\ (→)?
JRST BKS1 ;YES
PUSHJ P,SARGIN ;GET ARG
BKR1: TRNN B,RBCF ;}?
TLNN B,CRFG!RBRF ;DID IT STOP ON CR?
JRST .+3 ;NO
PUSHJ P,SARCON ;YES, CONTINUE
JRST .-3
MOVEI TAC,177 ;DEPOSIT...
LEG IDPB TAC,NA ;END...
MOVEI TAC,2 ;OF ARG...
LEG IDPB TAC,NA ;INDICATION
ADDI NA,1
HRLI NA,440700 ;NEXT AREA
LOOP1: TRNE B,COMF ;,?
JRST GNXT1 ;YES
TRNE B,RTPF ;)?
JRST GTERM1 ;YES
PUSHJ P,SCAN1 ;NO, IT MUST BE }
JRST LOOP1
GNXT1: SOJLE N,GALL1 ;NO MORE ALLOWED?
AOS (P) ;YES, MORE , ADVANCE POINTER
JRST LOOP2
CRMOD: LEG MOVEM NA,@(P) ;DEPOSIT POINTER
TRNE B,BSLF ;L (→)?
JRST BKS2 ;YES
PUSHJ P,SARGIN ;GET ARG
BKR2: TRNN B,RTPF ;)?
JRST .+3 ;NO
PUSHJ P,SARCON ;YES, CONTINUE
JRST .-3
MOVEI TAC,177 ;DEPOSIT...
LEG IDPB TAC,NA ;END...
MOVEI TAC,2 ;OF ARG...
LEG IDPB TAC,NA ;INDICATION
ADDI NA,1
HRLI NA,440700
LOOP3: TRNE B,COMF ;,?
JRST GNXT2 ;YES
TLNE B,CRFG!RBRF ;CR?
JRST GTERM2 ;YES
PUSHJ P,SCAN1 ;MUST BE }
JRST LOOP3
GNXT2: SOJLE N,GALL2 ;NO MORE ALLOWED?
AOS (P) ;YES, MORE
PUSHJ P,SCAN1
JRST CRMOD
GTERM1: SETZB B,C ;PASS THE ) (RETURNING NOTHING)
GTERM2: SOJLE N,GL ;GOTTEM ALL
MOVEI TAC,177 ;NO, DEPOSIT
LEG IDPB TAC,NA ;A NULL...
MOVEI TAC,2 ;ARG...
LEG IDPB TAC,NA ;...
HRLI NA,440700
LOOP4: AOS (P) ;INCREMNT POINTER
LEG MOVEM NA,@(P) ;DEPOSIT
SOJG N,LOOP4
ADDI NA,1
GL: SUB P,[1,,1] ;FLUSH PNTR FROM PDL
POPJ P,
GALL1: PUSHJ P,SCAN1 ;GET CHR.
TRNN B,RTPF ;)?
JRST GALL1 ;NO
GALL2: SUB P,[1,,1] ;FLUSH PNTR
JRST SCAN1 ;EAT THE ) OR , AND RETURN
BKHAN: HRRZM NA,MTBPNT ;UPDATE IN CASE MEVAL CAUSES MACRO HACKING
MOVEI TAC,1(P)
BLT TAC,7(P) ;SAVE AC'S
ADD P,[7(7)]
TRO NOFXF ;NO FIXUPS
PUSHJ P,MEVAL ;GET VALUE
TLNN UNDF!ESPF
TRNE NA,17
JRST [ERROR[ ASCIZ /UNDEFINED \ ARGUMENT/]
MOVEI N,0
JRST .+1]
EXCH N,B ;GET NUMBER
MOVEM C,NA-6(P) ;"EXCHANGE" CHAR WITH
HRRZ C,MTBPNT ;PNTR (CREATE AGAIN IN CASE
HRLI C,440700 ;CHANGED DURING MEVAL)
MOVEM C,@-7-1(P) ;MAKE SURE ARG PNTR IS UP TO DATE
PUSHJ P,BKSLSH ;CON TO aSCII
EXCH B,N
EXCH C,NA-6(P) ;RESTORE CHAR, PUT BACK NEW PNTR
SUB P,[7(7)]
MOVSI TAC,2(P)
HRRI TAC,1
BLT TAC,6 ;RESTORE AC'S
MOVE TAC,1(P)
TDZ REFLAG
AND TAC,REFLAG
OR TAC ;RESTORE FLAGS
TLZ SFL ;SKIP THE , OR ) OR WHATEVER
POPJ P,
BKS1: PUSHJ P,BKHAN
JRST BKR1
BKS2: PUSHJ P,BKHAN
JRST BKR2
BEND
;SARGIN: CALL TO READ IN A SINGLE ARGUMENT. POINTER FOR
;DEPOSIT SHOULD BE IN NA.
; STARTS WITH CURRENT CHR. & TERMINATES ON , OR CR OR ) OR > OR ].
; USES TAC . IF FIRST IS { , TERMS ON }
↑SARGIN:PUSH P,TAC
MOVE TAC,TLBLK
MOVEM TAC,SVLIN
MOVEM TAC,SARLIN
MOVE TAC,PGNM
MOVEM TAC,SARGPG
MOVEM TAC,SARPG
POP P,TAC
TRNE B,LBCF ;{ ?
JRST BROK ;YES
SLOOP: TRZ B,RBCF
TDNE B,[XWD RBRF!CRFG,RTPF!COMF];, OR CR OR ) OR > OR ]?
JRST BFND ;YES
SARCO: LEG IDPB C,NA ;NO, DEPOSIT
PUSHJ P,SCAN1 ;GET NEXT
JRST SLOOP
BROK: SETZM SARTAC
BLOOP: PUSHJ P,SCAN1 ;GET CHR.
TRNE B,LBCF ;{ ?
AOS SARTAC ;YES
TRNE B,RBCF ;} ?
JRST [SOSL SARTAC ;YES
JRST .+1
TLZ B,RBRF ;NOT END OF LINE
JRST BFND]
LEG IDPB C,NA ;DEPOSIT CHR.
JRST BLOOP
SARTAC: 0
SARLIN: 0
SARPG: 0
↑SARCON:PUSH P,SARLIN
POP P,SVLIN
PUSH P,SARPG
POP P,SARGPG
JRST SARCO
BFND: SETZM SARGPG
POPJ P,
;ROUTINE TO RETURN MACRO TABLE SPACE
↑MACRET:CAME B,MTBPNT
JRST MACR2
MOVEM C,MTBPNT ;AT END - JUST BACK UP MTBPNT
CAME C,LGARB
POPJ P,
MOVE B,GARBAG ;ADJOINS OLD FREE AREA - WE CAN BACK UP MTBPNT SOME MORE
MOVE C,2(B)
MOVEM C,MTBPNT
MOVE C,FSTPNT ;RETURN GARBAGE PNTR
EXCH C,1(B)
MOVEM C,GARBAG
MOVEM B,FSTPNT
JUMPE C,.+2
MOVE C,3(C)
MOVEM C,LGARB ;SET UP NEW "LAST GARBAGE" PNTR
POPJ P,
;NOT AT END - INSERT IN ORDERED LIST, COMBINING WITH OLD ENTRIES IF POSSIBLE
MACR2: PUSH M,T
PUSH M,N
MACR2A: SKIPA N,[-1,,GARBAG-1]
MACR3: MOVEI N,(T)
SKIPN T,1(N)
JRST MACRE ;RAN OFF END
CAMG B,3(T)
JRST MACR3
CAMN C,3(T) ;HERE WE HAVE PROPER POSITION
JRST MACRL ;LOW END MATCHES OLD
MACRE: JUMPL N,.+3
CAMN B,2(N)
JRST MACRH ;HIGH END MATCHES OLD
EXCH N,FSTPNT ;NEITHER MATCHES - CREATE NEW ENTRY
JUMPE N,MACRLZ ;TEST FOR NO FS
EXCH T,1(N)
EXCH T,FSTPNT
MOVEM N,1(T)
SETZM (N) ;ZERO SIZE FOR UPCOMING "COMBINE"
JUMPGE T,.+2
MOVEM B,LGARB ;UPDATE END ADR IF HIGHEST POS
MOVEM B,3(N)
MACRH: MOVEM C,2(N)
SUBI B,(C)
ADDM B,(N)
MACRX: POP M,N
POP M,T
POPJ P,
MACRL: JUMPL N,[MOVEM B,LGARB↔JRST .+3] ;UPDATE LGARB, AVOID TEST IF AT END
CAMN B,2(N)
JRST MACRB ;BOTH ENDS MATCH - WE HAVE CLOSED A HOLE!
MOVEM B,3(T)
MACRL2: SUBI B,(C)
ADDM B,(T)
JRST MACRX
MACRB: MOVE C,2(T) ;COMBINE ALL 3 PIECES INTO ONE, RETURN ONE OLD PNTR BLK
MOVEM C,2(N)
EXCH N,FSTPNT
EXCH N,1(T)
EXCH T,FSTPNT
MOVEM N,1(T)
JRST MACRL2
;HERE IF NO FS FOR PNTR
N, ;ARG FOR NOFSL
MACRLZ: JSR NOFSL ;THIS MAY CHANGE LIST, SO ...
MOVEM N,FSTPNT ;PUT BACK FS
JRST MACR2A ;AND START SCAN OVER
↑GARBAG:0
↑LGARB: 0
↑LGET: 0
PUSHJ P,SCAN1 ;GET CHR.
TRNN B,LBCF ;{ ?
JRST .-2 ;NO
JRST @LGET ;YES
;REPEAT CODE IS HERE ------------
DEFINE MACEX (AC)
< LDB AC,[POINT 6,LSTPNT,11]
HRL AC,INMCSW
PUSH M,AC
MOVEI AC,
SKIPN NOEXP
JRST .+3
DPB AC,[POINT 6,LSTPNT,11]
SETZM XPNDSW
SETZM INMCSW
>
↑%REP: TRO NOFXF ;GENERATE NO FIXUPS
PUSHJ P,MEVAL ;EVALUATE EXPR.
TRNN NA,17
TLNE UNDF!ESPF ;DEFINED & NOT SPC. CHR?
JRST REPER ;NO
JUMPL N,REPER ;NEG. COUNT?
SETOM REPSW ;SET REPEAT SWITCH (PUT CR LF AT END)
PUSHJ P,REP ;GO DO
TRZ NOFXF
JRST ASSMBL ;PROCEED
PUSHJ P,SCAN1 ;GET NEXT
↑REP: TRNN B,LBCF ;{ ?
JRST REP-1 ;NO
TLZ SFL
LBFN: JUMPE N,REP0 ;REPEAT 0?
CAIN N,1 ;REPEAT 1?
JRST REP1 ;YES
MOVE NA,MTBPNT ;MAKE READ-IN POINTER
HRLI NA,440700 ;...
PUSHJ P,SARGIN ;READ IN
SKIPN REPSW ;REPEAT?
JRST NOREP ;NO
MOVEI TAC,15 ;YES, INSERT CR LF
LEG IDPB TAC,NA
MOVEI TAC,12
LEG IDPB TAC,NA
NOREP: MOVEI TAC,177 ;DEPOSIT...
LEG IDPB TAC,NA ;END...
MOVEI TAC,4 ;OF REPEAT...
LEG IDPB TAC,NA ;...
PUSH M,AHED ;PUSH LINE NUMBET TEST
MOVSI TAC,(<SKIPA>)
MOVEM TAC,AHED ;INHIBIT...
MOVEM TAC,LOOP6 ;LINE NUMBER SKIPPING
MACEX (TAC)
PUSH M,INPNT ;SAVE OLD SCAN POINTER
HRRZI NA,1(NA) ;INCREMENT & ZERO LEFT
PUSH M,NA ;SAVE NEW MTBPNT
PUSH M,N ;SAVE COUNT
PUSH M,MTBPNT ;SAVE OLD MTBPNT (POINTS TO STRT)
MOVEM NA,MTBPNT ;RESET MTBPNT
MOVE NA,(M) ;GET POINTER
HRLI NA,440700
MOVEM NA,INPNT ;POINT TO STRT
DEFINE MACUND (ZORCHL)
< SKIPN NOEXP
SKIPN UNDLNS
ZORCHLYZNOTFORPRESIDENT
HRRZ TAC,LSTPNT
CAIL TAC,TLBLK
SUBI TAC,TLBLK-MBLK
HRRM TAC,LSTPNT
TRO MACUNF>
MACUND (<POPJ P,>)
POPJ P,
REP0: MOVE TAC,TLBLK
MOVEM TAC,SVLIN
MOVE TAC,PGNM
MOVEM TAC,REP0PG
PUSHJ P,SLURP ;EAT ALL THE TEXT
SETZM REP0PG
POPJ P,
REP1: SKIPN TAC,RTFLST ;GET POINTER
SETZM BROKCT ;ZERO COUNT IF AT OUTSIDE LEVEL
GFST NA,FSTPNT
HRRZM NA,RTFLST ;GET FREE STRG.
EXCH TAC,1(NA)
MOVEM TAC,FSTPNT
MOVE TAC,BROKCT ;GET COUNT
MOVEM TAC,@RTFLST ;DEPOSIT
POPJ P,
REPER: ERROR[ASCIZ/REPEAT -- ILLEGAL EXPRESSION FOR COUNT/]
JRST SPCFN
;BKSLSH: CALL, WITH BYTE POINTER IN C & NUM IN B.
; PUTS ASCII FOR NUM (IN CURRENT RADIX) AT PLACE POINTED TO BY C.
↑BKSLSH:JUMPE B,BKZER ;HANDLE ZERO SPECIALLY
MOVEM C,BKPNT ;DEPOSIT BYTE POINTER
PUSH P,N ;SAVE N
MOVEI N,1 ;
XCT SRAD ;GET RADIX
MOVEM N,BKRAD ;SAVE
POP P,N ;RESTORE N
JUMPL B,BKNEG ;NEG?
NLOPN: PUSHJ P,BKCON ;DO IT
MOVE C,BKPNT ;RESTORE POINTER
POPJ P, ;LEAVE
BKNEG: MOVEI C,"-" ;GET - SIGN
LEG IDPB C,BKPNT
MOVMS B
JRST NLOPN
BKRAD: 0
BKPNT: 0
BKCON: IDIV B,BKRAD ;DIVIDE BY RADIX
JUMPE B,BZER ;ZERO?
HRLM C,(P) ;NO, SAVE REMAINDER
PUSHJ P,BKCON ;CONVERT REST OF NUM
HLRZ C,(P) ;GET REMAINDER BACK
BZER: ORI C,60 ;CON TO ASCII
LEG IDPB C,BKPNT ;PUT OUT
POPJ P, ;LEAVE
BKZER: MOVEI B,"0" ;HANDLE ZERO...
LEG IDPB B,C ;AS A SPECIAL...
POPJ P, ;CASE
↑%FOR: MOVE O,MTBPNT
PUSHJ P,SCAN ;GET FIRST ARG
TLNN IFLG ;IDENT?
JRST FERR1 ;NO
MOVEI FS,200 ;NO CONCAT CHR.
F1RT: LEG MOVEM L,(O) ;SAVE
LEG SETZM 1(O) ;MAKE SURE THIS CELL EXISTS, THO WE MAY NOT USE IT
MOVEI T,1 ;ARG COUNT
TRNN B,COMF ;, NEXT?
JRST NOSEC
TLZ SFL ;SKIP THE ,
PUSHJ P,SCAN ;GET NEXT
TLNN IFLG ;IDENT?
JRST FERR2 ;NO
LEG MOVEM L,1(O) ;SAVE
MOVEI T,2 ;ARG COUNT
NOSEC: PUSHJ P,SCAN ;GET NEXT
TLNE IFLG ;IDENT?
JRST ICHK ;YES
TLNN SCFL ;SPC. CHR?
JRST FERR3 ;NO
TRNE N,LACF ;←?
JRST LFOR ;YES
TRNE N,EPSF ;?
JRST EFOR ;YES
TRNE N,INF ;⊂?
JRST INFOR ;YES
ERROR[ASCIZ/UNREC CHR. AFTER ARGS -- FOR/]
JRST SPCFN
ICHK: CAIN L,'IN' ;IN?
JRST INFOR ;YES
CAIN L,'E' ;E?
JRST EFOR ;YES
ERROR[ASCIZ/UNREC IDENT AFTER ARGS -- FOR/]
JRST SPCFN
FERR1: TLNE SCFL ;SPC CHR?
JRST CONE ;YES
FER1A: ERROR[ASCIZ/NO IDENT AFTER FOR/]
JRST SPCFN
FERR2: ERROR[ASCIZ/NO IDENT FOR SECOND ARG -- FOR/]
JRST SPCFN
FERR3: ERROR[ASCIZ/NUMBER AFTER ARGS -- FOR/]
JRST SPCFN
FERR5: ERROR [ASCIZ /ILLEGAL CONCATENATION CHR -- FOR/]
JRST SPCFN
CONE: TRNN N,ATF ;@?
JRST FER1A ;NO
MOVE FS,C ;YES, GET CONCAT CHR.
TRNE B,RBCF ;IS IT A > OR A ⎇
JRST FERR5
TLZ SFL ;SKIP CHR.
PUSHJ P,SCAN ;GET NEXT
TLNE IFLG ;IDENT?
JRST F1RT ;YES
JRST FER1A ;NO
OSAV: BLOCK 2
CONSAV: 0
FSVV: 0
TSVV: 0
LFOR: MOVEM FSVV ;SAVE FLAGS
TRO NOFXF ;NO FIXUPS
MOVEM T,TSVV ;SAVE ARG COUNT
MOVEM FS,CONSAV ;SAVE CONCAT CHR.
MOVE T,(O) ;SAVE...
MOVEM T,OSAV ;ARGS
MOVE T,1(O)
MOVEM T,OSAV+1
PUSHJ P,MEVAL ;GET VALUE
TRNN NA,17
TLNE UNDF!ESPF ;DEFINED?
JRST FERR4 ;NO
PUSH P,N ;SAVE
TLZ SFL
PUSHJ P,MEVAL ;GET VALUE
TRNN NA,17
TLNE UNDF!ESPF ;DEFINE?
JRST FERR4A ;NO
PUSH P,N ;SAVE
TRNN B,COMF ;, NEXT?
JRST NOTHRD ;NO
TLZ SFL
PUSHJ P,MEVAL ;GET VALUE
TRNN NA,17
TLNE UNDF!ESPF ;DEFINED?
JRST FERR4B ;NO
SKIPA
NOTHRD: MOVEI N,1
MOVE T,TSVV ;GET ARG COUNT
MOVE O,FSVV ;GET OLD FLAGS
TDZ REFLAG
AND O,REFLAG
OR T ;RESTORE FLAGS
MOVE O,MTBPNT ;GET POINTER
MOVE NA,OSAV ;REDEPOSIT ARGS
LEG MOVEM NA,(O) ;THIS IS DONE IN CASE...
MOVE NA,OSAV+1 ;MEVAL RAN OUT OF...
LEG MOVEM NA,1(O) ;FREE STRG & MTBPNT CHANGED
MOVE NA,(P) ;GET TERM #
JUMPL N,.+4
CAML NA,-1(P) ;ZERO TIMES?
JRST .+4 ;NO
JRST NOTIM ;YES
CAMLE NA,-1(P) ;ZERO TIMES?
JRST NOTIM ;YES
PUSH P,N ;SAVE N
MOVEI N,2(O) ;MAKE POINTER
HRLI N,440700 ;...
MOVE FS,CONSAV
CAIN FS,200 ;CONCAT CHR?
JRST FLOP1 ;NO
PUSH P,CTAB(FS) ;SAVE BITS
MOVSI NA,SPFL!SPCLF;GET NEW BITS
MOVEM NA,CTAB(FS)
FLOP1: PUSH P,FS ;SAVE CONCAT CHR.
MOVE NA,O ;ARG POINTER
JSR LGET ;GET TO THE {
PUSHJ P,TXTIN ;GET TEXT
PUSH M,AHED ;SAVE LINE NUM SKIP
MOVSI FS,(<SKIPA>)
MOVEM FS,AHED
MOVEM FS,LOOP6 ;INHIBIT LINE NUM SKIP
MACEX (FS)
PUSH M,INPNT ;SAVE OLD INPNT
EDEPO(L,N,5) ;DEPOSIT END OF FOR
HRRZI N,6(N) ;INCREMENT
PUSH M,N ;SAVE
POP P,FS ;GET CONCAT CHR
CAIE FS,200 ;ANY?
POP P,CTAB(FS) ;YES, RESTORE BITS
PUSH M,(P) ;SAVE INCREMENT
PUSH M,-1(P) ;SAVE TERM NUM
PUSH M,-2(P) ;SAVE STARTING #
PUSH M,O ;SAVE STARTING ADDRS -2
MOVEI FS,-5(N) ;GET ARG POINTER
PUSH M,FS ;SAVE
SUB P,[3(3)]
MOVEM N,MTBPNT ;RESET MTBPNT
MOVEI C,-3(N)
HRLI C,440700
LEG MOVEM C,-5(N) ;DEPOSIT ARG ...
LEG MOVEM C,-4(N) ;POINTERS
MOVE B,-2(M) ;GET NUMBER
PUSHJ P,BKSLSH ;CONVERT TO ASCII
EDEPO (TAC,C,2) ;DEPOSIT END OF ARG
ADD O,[XWD 440700,2]
MOVEM O,INPNT ;DEPOSIT
MACUND JRST ASSMBL
JRST ASSMBL ;GO, MAN
NOTIM: SUB P,[2(2)] ;CLEAR STACK
MOVEI N, ;REPEAT 0
PUSHJ P,REP
JRST ASSMBL
FERR4B: POP P,N
FERR4A: POP P,N
FERR4: ERROR[ASCIZ/UNDEFINED ARG -- FOR/]
JRST SPCFN
INFOR: PUSHJ P,SCAN ;GET TO THE (
TLNN SCFL ;SPCL CHR?
JRST .-2 ;NO
TRNN N,LFPF ;(?
JRST .-4 ;NO
PUSHJ P,SCAN1 ;GET NEXT CHR.
MOVEI NA,5(O) ;GET POINTER FOR ARGS
HRLI NA,440700 ;...
LEG MOVEM NA,3(O) ;DEPOSIT SECOND ARG POINTER
INLOP2: TRNE B,LBCF ;{?
LEG IDPB C,NA ;YES, DEPOSIT IT
PUSHJ P,SARGIN ;GET FIRST ARG.
INLOP1: TRNE B,RTPF ;TERM BY )?
JRST RTERM ;YES
TRNE B,COMF ;TERM BY COMMA?
JRST MYCON ;YES
PUSHJ P,SARCON ;NO, CONTINUE
JRST INLOP1
MYCON: LEG IDPB C,NA
PUSHJ P,SCAN1
TRNE B,LBCF ;{?
LEG IDPB C,NA ;YES, DEPOSIT
PUSHJ P,SARGIN
JRST INLOP1
RTERM: EDEPO (N,NA,2) ;DEPOSIT END OF ARG
CAIN FS,200 ;ANY CONCAT CHR?
JRST IFLOP ;NO
PUSH P,CTAB(FS) ;SAVE BITS
MOVSI N,SPFL!SPCLF;MAKE...
MOVEM N,CTAB(FS);NEW BITS
IFLOP: MOVEI N,4(O) ;GET...
HRLI N,440700 ;FIRST ARG...
MOVEM N,2(O) ;POINTER
MOVEI N,1(NA) ;MAKE TEXT...
HRLI N,440700 ;POINTER
PUSH P,FS ;SAVE CONCAT CHR.
MOVE FS,N ;& SAVE
JSR LGET ;GET TO THE {
MOVE NA,O ;SET ARG POINTER
PUSHJ P,TXTIN ;GET TEXT IN
PUSH M,AHED ;SAVE LINE NUM TEST
MACEX (L)
PUSH M,INPNT ;SAVE
MOVSI L,(<SKIPA>)
MOVEM L,AHED ;INIHIBIT LINE NUM...
MOVEM L,LOOP6 ;SKIPPING
EDEPO (L,N,6) ;DEPOSIT END OF FOR-IN
HRRZI N,1(N) ;FORM NEW MTBPNT
PUSH M,N ;SAVE
PUSH M,MTBPNT ;SAVE OLD
MOVEM N,MTBPNT
PUSH M,FS ;SAVE STRT OF TEXT
MOVEI N,2(O) ;GET ARG POINTER
PUSH M,N ;SAVE
POP P,FS ;GET CONCAT
CAIE FS,200 ;ANY?
POP P,CTAB(FS) ;YES, RESTORE
PUSHJ P,IFORSH ;SET UP ARGS
MACUND JRST ASSMBL
JRST ASSMBL
↑IFORSH:MOVE B,(M) ;GET ARG POINTER
MOVE C,1(B) ;GET SECOND ARG POINTER
PUSH P,N ;SAVE N
MOVE B,(B) ;GET FIRST ARG POINTER
ILDB TAC,C ;GET CHR.
SKIPGE N,CTAB(TAC) ;GET BITS
JRST ILOPI2
TLNE N,SCRF ;CHECK FOR SPECIAL ({ AND < AND > AND ⎇)
XCT IFORT(N)
TRNE N,LBCF ;{?
JRST LBRK ;YES
ILOPI1: TRNE N,COMF ;,?
JRST COMTOM ;YES
TLNE N,DLETF ;DELETE?
JRST DELTOM ;YES
ILOPI2: IDPB TAC,B ;DEPOSIT
ILDB TAC,C ;GET NEXT
SKIPL N,CTAB(TAC);GET BITS
JRST ILOPI1
JRST ILOPI2
IFORT: FOR I←0,7 <JFCL
>
HRRI N,LBCF!TP2F ;< OR {
HRRI N,RBCF!TP2F ;> OR ⎇
DELTOM: MOVE C,(M) ;GET ARG POINTER
MOVEM B,1(C) ;DEPOSIT SECOND ARG POINTER
EDEPO (TAC,B,2)
JRST FINIT
COMTOM: EDEPO (N,B,2)
MOVE N,(M) ;GET ARG POINTER
MOVEM C,1(N) ;DEPOSIT SECOND ARG POINTER
FINIT: POP P,N ;RESTORE
MOVE B,-1(M) ;GET START
MOVEM B,INPNT ;DEPOSIT
JRST LSTCHK
LBRK: SETZM IFOCNT ;ZERO {} COUNT
SKIPA
LILO1: IDPB TAC,B
ILDB TAC,C ;GET CHR.
SKIPGE N,CTAB(TAC);GET BITS
JRST LILO1 ;NOT SPC CHR.
TLNE N,SCRF
XCT IFORT(N)
TRNE N,LBCF ;{?
AOS IFOCNT ;YES
TRNE N,RBCF ;}?
SOSL IFOCNT ;YES, DONE?
JRST LILO1 ;NO
LILO2: ILDB TAC,C ;GET NEXT
SKIPGE N,CTAB(TAC);GET BITS
JRST LILO2
TRNE N,COMF ;,?
JRST COMTOM ;YES
TLNE N,DLETF ;DELETE?
JRST DELTOM ;YES
JRST LILO2 ;NO
IFOCNT: 0
EFOR: JSR LGET ;GET TO THE {
MOVEI NA,5(O) ;SET UP POINTER...
HRLI NA,440700 ;TO READ IN ARG...
LEG MOVEM NA,3(O) ;DEPOSIT
PUSHJ P,SARGIN ;GET ARG.
EDEPO (TAC,NA,2);DEPOSIT END OF ARG
MOVEI TAC,4(O) ;FORM FIRST ARG...
HRLI TAC,440700 ;POINTER
MOVEM TAC,2(O) ;DEPOSIT
JSR LGET ;GET TO THE {
MOVEI N,1(NA) ;FORM TEXT POINTER
HRLI N,440700 ;...
PUSH P,N ;SAVE
CAIN FS,200 ;ANY CONCAT CHR?
JRST EFLOP ;NO
PUSH P,CTAB(FS) ;SAVE BITS
MOVSI NA,SPFL!SPCLF;MAKE...
MOVEM NA,CTAB(FS);NEW BITS
EFLOP: PUSH P,FS ;PUSH CONCAT
MOVE NA,O ;ARG POINTER
PUSHJ P,TXTIN ;READ IN BODY OF TEXT
EDEPO (L,N,7);DEPOSIT END OF FOR
PUSH M,AHED ;SAVE LINE NUM SKIPPING
MACEX (L)
MOVSI L,(<SKIPA>)
MOVEM L,AHED
MOVEM L,LOOP6
PUSH M,INPNT ;SAVE SCAN POINTER
POP P,L ;GET CONCAT
CAIE L,200 ;ANY?
POP P,CTAB(L) ;YES, RESTORE BITS
ADDI N,1 ;FORM NEW...
HRRZS N ;MTBPNT
PUSH M,N ;SAVE
MOVEM N,MTBPNT ;DEPOSIT
MOVE N,2(O) ;GET FIRST ARG POINTER
IBP N
EDEPO (TAC,N,2);DEPOSIT END OF ARG
POP P,L ;GET START OF TEXT
PUSH M,L ;SAVE
MOVEI L,2(O) ;GET ARG POINTER
PUSH M,L ;SAVE
PUSHJ P,EFORSH ;SET UP FIRST
MACUND (JRST ASSMBL)
JRST ASSMBL
↑EFORSH:MOVE B,(M) ;GET ARG POINTER
ILDB C,1(B) ;GET NEXT CHR.
MOVE B,(B) ;GET FIRST ARG POINTER
IDPB C,B ;DEPOSIT CHR.
CAIN C,177 ;DONE?
JRST DYES ;YES
MOVE B,-1(M) ;GET TEXT POINTER
MOVEM B,INPNT ;DEPOSIT
JRST LSTCHK
DYES: POP M,C ;GET STRT OF REMOVABLE AREA
SUBI C,2 ;ADJUST
POP M,B ;GET END
POP M,B
PUSHJ P,MACRET
POP M,INPNT ;RESET INPNT
POP M,C ;GET LSTPNT
DPB C,[POINT 6,LSTPNT,11];RESTORE
HLRZM C,INMCSW ;RESTORE...
HRRZM C,XPNDSW ;SWITCHES
POP M,C
MOVEM C,AHED ;RESTORE...
MOVEM C,LOOP6
SKIPE UNDLNS ;UNDERLINING?
SKIPE NOEXP ;NO EXPAND?
POPJ P,
SKIPN INMCSW ;INA MACRO?
POPJ P,
HRR C,LSTPNT
ADDI C,TLBLK-MBLK
HRRM C,LSTPNT
POPJ P,
BEND MAC
LEGTAB: FOR @! X←0,LEGNUM-1{,%$L!X
}LEGCNT←←LEGNUM
XLIST
LIT
VAR
LIST
END STRT