2 .SYMTAB 4003.,2000. ;THIS MANY FOR DEC VERSION ON DEC SYSTEM.
3 IFN .OSMIDAS-SIXBIT/DEC/, .SYMTAB 5003. ;ON ITS ASSEMBLE FASTER.
6 .MLLIT==1 ;MULTI-LINE MODE.
12 I=2 ;INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF
18 T=10 ;NOT SO TEMP AS IN MOST PROGS W/ T
20 SYM=12 ;FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR
23 CH1=15 ;MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH
25 TM=17 ;SUPER TEMPORARY
27 IFDEF .XCREF, .XCREF FF,P,I,A,B,C,D,T
29 IF1,[ ;FOR PASS 1 TTY CONDITIONALS
30 IFDEF SAILSW,IFN SAILSW,DECSW==1
31 IFDEF CMUSW,IFN CMUSW,DECSW==1
32 IFDEF DECDBG,IFN DECDBG,DECSW==1
33 IFDEF DECSW,IFN DECSW,DECSW==1 ? ITSSW==0 ? TNXSW==0
34 IFDEF ITSSW,IFN ITSSW,ITSSW==1 ? DECSW==0 ? TNXSW==0
35 IFDEF TNXSW,IFN TNXSW,TNXSW==1 ? DECSW==0 ? ITSSW==0
37 IFNDEF ITSSW,ITSSW==IFDEF .IOT,[1] .ELSE 0 ;NONZERO FOR ITS VERSION
38 IFNDEF TNXSW,TNXSW==IFDEF JSYS,[1] .ELSE 0 ;NONZERO FOR TENEX VERSION
39 IFNDEF DECSW,DECSW==IFDEF LOOKUP,[1-TNXSW] .ELSE 0 ;NONZERO TO RUN ON DEC MONITOR.
40 ; TNXSW SINCE TENEX MIDAS HAS DEC UUO'S
42 IFNDEF DECDBG,DECDBG==0 ;NONZERO FOR DEC VERSION TO RUN WITH DEC DDT.
43 IFNDEF SAILSW,SAILSW==IFDEF SPCWAR,[1] .ELSE 0 ;NONZERO FOR SAIL VERSION.
44 IFNDEF CMUSW,CMUSW==IFDEF CMUDEC,[1] .ELSE 0 ;NONZERO FOR VERSION TO RUN AT CMU.
45 IFN TNXSW,DECSW==1 ;***TEMP*** USE PA1050 FOR NOW
46 IFN ITSSW\DECSW\TNXSW,TS==1
47 IFNDEF TS,TS==1 ;NON-ZERO FOR ASSEMBLED VERSION TO RUN IN TIME-SHARING
49 IFNDEF A1PSW, A1PSW==TS ;FOR 1PASS END-OF-PROGRAM AUTO-REASSEMBLY
50 IFNDEF TSSYMS, TSSYMS==ITSSW ;.UAI, ETC. (AND ..RJCL, ETC) - EVER USE THEM?
51 IFNDEF BRCFLG, BRCFLG==0 ;1 => BRACES { AND } ARE SPECIAL IN MACRO ARGS, ETC.
52 ;JUST LIKE BRACKETS. BRACES ARE SPECIAL IN CONDITIONALS
53 ;REGARDLESS OF BRCFLG.
54 IFNDEF CREFSW, CREFSW==ITSSW ;SET TO ALLOW C SWITCH TO CAUSE CREF OUTPUT.
55 IFNDEF LISTSW, LISTSW==1 ;SET TO ALLOW L SWITCH TO CAUSE A LISTING.
56 IFNDEF RCHASW, RCHASW==TS ;INCLUDE TTY AS POSSIBLE INPUT DEVICE
57 IFNDEF PURESW, PURESW==TS ;NON-ZERO TO SEPARATE PURE CODING FROM IMPURE AND DO PAGE SKIPS
58 IFNDEF FASLP, FASLP==ITSSW\TNXSW\CMUSW\SAILSW ;NON-ZERO => INCLUDE FASL OUTPUT CAPABILITY
59 ; NOTE!! IF RUNNING UNDER 10/50 THIS MAKES THINGS
60 ; SEVERAL K BIGGER THAN OTHERWISE
61 IFNDEF .I.FSW, .I.FSW==ITSSW\TNXSW\CMUSW\SAILSW ;NON-ZERO => INCLUDE .I, .F
62 IFNDEF MACSW, MACSW==1 ;NON-ZERO => INCLUDE MACRO PROCESSOR (!)
63 IFNDEF RUNTSW, RUNTSW==1 ;ASSEMBLE CODING TO TYPE OUT RUN TIME AT END OF ASSEMBLY
64 IFNDEF WRQTSW, WRQTSW==1 ;WRQOTE (MACRO DEFINITION READER) VERSION
65 ; ^ 0 => SLOW, 1 => FAST; MAYBE 2 WILL EVENTUALLY BE CREATED
66 IFE TS,IFNDEF MACL,MACL==6*2000 ;MACRO TABLE SIZE
68 IFE DECSW,IFNDEF MACL,MACL==6000 ;(MUST BE BIG ENOUGH TO COVER INIT CODE)
69 ;IN DEC VERSION, MACL IS DEFINED = SIZE OF INIT CODE.
70 IFNDEF MXMACL,MXMACL==32.*2000 ;MAXIMUM LENGTH MACTAB
72 IFNDEF MACRUM,MACRUM==4 ;# WORDS NOT USED AT END OF MACTAB
73 IFNDEF STRL,STRL==20 ;LENGTH OF STRING STORAGE (USED BY GSYL)
74 IFNDEF DMDEFL,DMDEFL==40 ;MAX NO OF DMY ARGS IN DEFINE
75 IFNDEF DMYAGL,DMYAGL==400 ;MAX NO COMBINED DMYARGS ALL MACROS CURRENTLY EXPANDING OR PUSHED
76 IFNDEF MPDLL,MPDLL==300 ;MACRO PDL LENGTH
77 IFNDEF DSSIZ,DSSIZ==40 ;MAX # ARGS MACRO WHOSE ARGS BEING SCANNED (SHOULD BE .GE. DMDEFL)
78 IFNDEF BKTABL,BKTABL==40 ;MAX NUM .BEGIN BLOCKS.
79 IFNDEF BKPDLS,BKPDLS==10 ;MAXIMUM .BEGIN BLOCK NESTING DEPTH.
80 IFNDEF BSIZE,BSIZE==37 ;PREFERRED SIZE BLOCK MAX SIZE-3
81 IFN DECSW,IFNDEF LPDL,LPDL==200.
82 IFNDEF LPDL,LPDL==500 ;LENGTH OF PDL
83 IFN DECSW,IFNDEF CONMIN,CONMIN==1000
84 IFNDEF CONMIN,CONMIN==3300 ;MINIMUM AMT OF SPACE FOR CONSTANTS TABLES.
85 IFNDEF CONMAX,CONMAX==10000 ;MAXIMUM SPACE USER CAN ASK FOR.
86 IFNDEF NCONS,NCONS==75. ;MAXIMUM NUMBER OF CONSTANTS AREAS
87 IFNDEF NVARS,NVARS==25. ;MAX. NUM. VARIABLES AREAS.
88 IFN DECSW,IFNDEF SYMDSZ,SYMDSZ==2003.
89 IFNDEF SYMDSZ,SYMDSZ==2707. ;DEFAULT # SYMS IN SYMTAB.
90 IFNDEF SYMMSZ,SYMMSZ==10177*2 ;# SYMS IF JNAME IS MMIDAS.
91 IFNDEF SYMMAX,SYMMAX==40000 ;MAX SYMTAB SIZE (# SYMS)
92 IFNDEF FASBL,FASBL==400 ;WORDS USED FOR FASL OUTPUT BUFFER
93 ; MUST HOLD STUFF ASSOC WITH ONE GROUP OF 9 CODE BYTES
94 IFNDEF FASATL,FASATL==2000 ;WORDS USED FOR FASL ATOM TABLE
95 ; HOLDS PNAMES ETC OF ALL ATOMS AS WILL BE IN FASLOAD'S
97 IFNDEF MINWPS,MINWPS==3 ;MIN # WORDS IN SYMTAB ENTRY
98 IFNDEF MAXWPS,MAXWPS==3 ;MAX # ALLOWED (WILL BE BIGGER SOME DAY)
99 IFNDEF NRMWPS,NRMWPS==3 ;DEFAULT #. 2 WDS FOR VALUE & FLAGS, 1 FOR NAME.
103 IFNDEF MIDVRS,MIDVRS=.FNAM2
104 IFE MIDVRS-SIXBIT/MID/,[
105 PRINTX /What is MIDAS version number? /
111 ;OSMIDAS GETS THE SIXBIT NAME OF THE TYPE OF OP. SYS. THE VERSION OF MIDAS
112 ;IS BEING ASSEMBLED TO RUN UNDER. IT WILL BE THE VALUE OF ".OSMIDAS" WHEN PROGRAMS
113 ;ARE ASSEMBLED WITH THIS MIDAS.
114 IFNDEF OSMIDAS,OSMIDAS==IFE TS,[SIXBIT/BARE/] .ELSE IFN ITSSW,[SIXBIT/ITS/] .ELSE IFN CMUSW,[SIXBIT/CMU/] .ELSE IFN SAILSW,[SIXBIT/SAIL/] .ELSE IFN TNXSW,[SIXBIT/TENEX/] .ELSE SIXBIT/DEC/
119 FLPPSS==400000 ;ONE IF PUNCHING PASS; MUST BE SIGN
120 FLHKIL==100000 ;ONE IF SYM TO BE SEMI KILLED IN DDT
122 FLVOT==40000 ;ALL RCH S MUST GO THRU RCH
123 ; IE TYPCTL .NE. POPJ P, (SET/CLEARED BY MDSSET, MDSCLR)
124 FLMAC==20000 ;ONE IF CHARS COMING FROM MACRO PROCESSOR, DON'T HACK CPGN/CLNN
125 FLTTY==10000 ;ONE IF CHARS FROM SOMEWHERE ELSE BUT NOT HACKING CPGN/CLNN
126 FLOUT==4000 ;ONE IF OUTPUT HAS OCCURED IN CURRENT MODE (USED BY TS NED LOGIC)
127 FLPTPF==2000 ;SET IF (TIME SHARING) OUTPUT DEVICE IS PTP
128 FLUNRD==1000 ;=> RE-INPUT LAST CHARACTER (SEE RCH)
134 FRFIRWD==400000 ;ONE FOR FIRST WORD OF BLOCK
135 FRSYMS==200000 ;ONE IF SYM PUNCH DESIRED
136 FRLOC==100000 ;ONE BETWEEN ABS LOC ASSIGN AND
137 ;FIRST BLOCK OUTPUT THEREAFTER (EBLK TO OUTPUT NULL BLOCK SO LINKING LOADER KNOWS $.)
139 FRNPSS==40000 ;ONE IF TWO PASS ASSEMBLY
140 FRPSS2==20000 ;ONE ON PASS 2
142 FRINVT==4000 ;USED BY PBITS AND OUTPUT TO OUTPUT WORDS OF CODE BITS IN CORRECT ORDER (STEAD LOGICAL)
143 FRNLIK==2000 ;TEMPORARILY SUPPRESS ADR LINKING
144 FRGLOL==1000 ;ONE IF LOCATION PLUS OFFSET IS GLOBAL
146 FRBIT7==400 ;SET IF LAST TIPLE OF CODEBITS WAS 7.
147 FRMRGO==200 ;MACRO PROC TO RETURN TO .GO HACKER W/O READING NEXT CHAR (SEE RCHSAV)
149 FRCMND==40 ;SET WHILE READING CMD, TELLS RFD TO NOTICE (, _, COMMA.
150 FRNNUL==20 ;SET ON RETURN FROM RFD IFF NONNULL SPEC.
151 FRARRO==10 ;TELLS RFD THAT 1ST NAME IS FN1, NOT FN2.
161 ILGLI==1 ;SET ON " CLEARED EACH SYL
162 ILVAR==2 ;SET ON ' " " "
163 ILFLO==4 ;FLOATING NUM, SET ON DIGIT AFTER .
164 ILDECP==10 ;DECIMAL PREFER, SET WHEN . SEEN.
165 ILUARI==20 ;1 => RIGHT OPERAND TO UPARROW BEING READ
166 ILLSRT==40 ;RETURN FROM <
167 ILWORD==400 ;SET IF CURRENT WORD IS NOT NULL RETURNED BY GETWORD
168 ILNPRC==1000 ;ONE IF NUMBER ALREADY PROCESSED BY UPARROW
169 ILMWRD==4000 ;SET ON MULTIPLE WORD
170 ILPRN==10000 ;SET DURING MACCL IF MACRO NAME WAS FOLLOWED BY (.
171 ILMWR1==20000 ;SET BY LBRAK AS SIGNAL TO ITSELF THAT THIS NOT FIRST
172 ;WORD OF MULTI-WORD CONSTANT
173 ILNOPT==40000 ;CONSTANTS OPTIMIZATION SUPPRESSION FLAG; SHOULD BE SET BY
174 ;VALUE-RETURNING PSEUDO DURING NOT PUNCHING PASS TO KEEP ITSELF OUT OF
175 ;CONSTANTS OPTIMIZATION
181 IRFLD==1 ;SET IF FLD NOT NULL
182 IRSYL==2 ;SET IF SYL NOT NULL
183 IRLET==4 ;SET IF SYL IS SYMBOL
184 IRDEF==10 ;SET IF CURRENT EXPR DEFINED
185 IRNOEQ==20 ;SET IF = ISN'T ALLOWED IN CURRENT CONTEXT.
186 IRCOM==40 ;SET IF CURRENT QUAN IS COMMON
187 IRPERI==100 ;SET IF PERIOD SEEN IN WHAT IS SO FAR (INCL .) A NUMBER
188 IREQL==200 ;ONE DURING READING WORD TO RIGHT OF =
189 IRIOINS==400 ;FIRST FIELD OF CURRENT WORD HAS IO INST
190 IRCONT==1000 ;SET IF NOT OK TO END BLOCK
191 IRPSUD==4000 ;SET IF ERROR COMMENTS WILL COME FROM PSEUDO
192 IRGMNS==20000 ;SET IF ILUARI OR BAKARI HAS GOBBLED MINUS
193 IROP==200000 ;SET IF OPERATOR SEEN IN CURRENT FIELD
201 ETSM=1000,, ;ERROR, TYPE SYM.
202 ETR=2000,, ;ERROR, ORDINARY MESSAGE.
203 ERJ=3000,, ;ERROR, NO MESSAGE, RETURN TO ADDR.
204 ETI=4000,, ;ERROR, IGNORE LINE, RET. TO ASSEM1.
205 ETA=5000,, ;ERROR, RET. TO ASSEM1.
206 ETASM=6000,, ;ERROR, TYPE SYM AND RETURN TO ASSEM1
207 ETF=7000,, ;FATAL ERROR.
208 TYPR=(37000) ;UUO, TYPE OUT ASCIZ STRING
212 ;LINK TABLE (GLOTB), ACCUMULATES GLOBAL REFERENCES FOR CURRENT FROB (USUALLY WORD) TO OUTPUT
213 ;GLSP2 POINTS TO (I.E. HAS ADR 1 LESS THAN) BOTTOM OF ACTIVE PART OF TABLE
214 ;GLSP1 POINTS TO TOP (HAS ADR OF LAST ENTRY ACTIVE)
216 ;ACTUAL ENTRIES IN GLOTB:
217 ;IF ENTIRE WORD ZERO, ENTRY IS NULL, WILL (OR SHOULD) BE IGNORED
218 ;RH ADR OF SQUOZE WITH INTERNAL MIDAS FLAGS (USUALLY IN SYMBOL TABLE, BUT MAY BE ANYWHERE IN CORE)
219 ;LH: RIGHT 10. BITS MULTIPLICATION FACTOR OR 0 => 1
220 ;GLOBAL SHOULD BE MULTIPLIED BY IT
223 ;SIGN BIT => THIS NOT PART OF FIELD, DON'T PLAY WITH FLAGS AT GETFLD, INTFD
224 ACF==40000 ;AC LOW OR HIGH (SWAPF => HIGH)
225 HFWDF==100000 ;MASK GLOBAL TO HALFWORD
227 MINF==20000 ;NEGATIVE OF GLOBAL
229 IFNDEF LBRKT,LBRKT=="[ ;LEFT DELIMITER FOR EXPLICITLY GROUPED CONDITIONALS, MACRO ARGS, REPEAT BODY, ETC.
230 IFNDEF RBRKT,RBRKT=="] ;RIGHT "
231 IFNDEF WPS, WPS==3 ;# CONTIG. WDS /STE. IFNDEF FOR DEBUGGING.
232 IFNDEF BKWPB,BKWPB==3 ;# WDS/BKTAB ENTRY.
233 IFNDEF EOFCH,EOFCH==3 ;EOF CHAR, BEWARE DISPATCH TABLE ENTRIES.
234 IFNDEF LBRACE,LBRACE=="{
235 IFNDEF RBRACE,RBRACE=="}
237 ;3RDWRD LH. SYM TAB BITS
239 3REL==600000 ;RELOC BITS, DO NOT CHANGE, SOMETIMES REFERENCED BY NUMERIC BYTE POINTERS
242 3RLNK==100000 ;R(LINK)
243 3KILL==40000 ;FULLY-KILLED SYM (DON'T GIVE TO DDT).
244 3VP==20000 ;VALUE PUNCHED
245 3SKILL==10000 ;SEMI KILL IN DDT
246 3LLV==4000 ;LINKING LOADER MUST INSERT VAL
247 3VAS2==2000 ;VAR SEEN ON PASS TWO WITH '
248 3VCNT==1000 ;USED IN CONSTANT
249 3MAS==400 ;THIS ISN'T THE LAST DEFINITION OF A SYM WITH THIS NAME
250 ;(SO ES MUST KEEP SEARCHING).
251 3NCRF==200 ;DON'T CREF THIS SYMBOL.
252 3MACOK==100 ;OK TO (RE)DEFINE THIS SYM AS MACRO.
253 ;(IE IS A MACRO OR SEEN ONLY IN .XCREF)
254 3LABEL==40 ;ILLEGAL TO REDEFINE THIS SYM TO DIFFERENT VALUE
255 3MULTI==20 ;THIS SYM IS MULTIPLY DEFINED, SO FLAG ALL DEFINITIONS.
256 3DOWN==10 ;THIS DEFINITION SHOULD BE SEEN BY SUBBLOCKS IN 1PASS MODE.
258 3DFCLR==737110 ;BITS IN LH TO CLEAR ON REDEFINITION.
262 TRIV==400000 ;1 IF OUT FORM IS FOR TRIVIAL LOADER (ABSOLUTE)
264 ARIM==2 ;IF ONE OUT FOR IS RIM
265 SBLKS==10 ;IF ONE OUT FORM IS SIMPLE BLOCKS
266 ARIM10==20 ;PDP-10 RIM
267 DECREL==40 ;DEC RELOCATABLE FORMAT (CONSIDERED "ABSOLUTE" INSIDE MIDAS)
268 FASL==100 ;LISP FASL COMPATIBLE RELOCATABLE FORMAT ( " " ")
274 ;SQUOZE FLAG DEFINITIONS IN MIDAS SYMBOL TABLE
276 CMMN==0 ;COMMON (NOT USED)
277 PSUDO==40000 ;PSEUDO OR MACRO, VALUE RH ADDR OF RTN (MACCL FOR MACRO),
278 ; LH WILL BE IN LH OF B WHEN RTN CALLED.
279 SYMC==100000 ;SYM, VALUE IS VALUE OF SYM.
280 LCUDF==140000 ;LOCAL UNDEF
281 DEFLVR==200000 ;DEF LOC VAR, VALUE IS VALUE.
282 UDEFLV==240000 ;UNDEF LOC VAR, VALUE IS 1+ IDX IN VARIAB. AREA, BUT IGNORD IF VAR AREA GLOB.
283 LGBLCB==300000 ;CODE BITS EQUAL TO THIS OR HIGHER REPRESENT GLOBAL QUANTITIES
284 DEFGVR==300000 ;DEF GLO VAR, VALUE IS VALUE
285 UDEFGV==340000 ;UNDEF GLO VAR, VALUE LIKE UNDEF LOCAL VAR.
286 GLOETY==400000 ;GLO ENTRY
287 GLOEXT==440000 ;GLO EXIT
288 NCDBTS==GLOEXT_<-18.+4>+1 ;# CODE BIT TYPES
291 IFN .-<TBLNAM>-NCDBTS,.ERR TBLNAM LOSES
294 ;LOADER BLOCK TYPES LINK
295 LLDCM==1 ;LOADER COMMAND BLOCK
299 LLIB==5 ;LIBRARY BLOCK
300 LCOMLOD==6 ;LOAD INTO COMMON
301 LGPA==7 ;GLOBAL PARAMETER ASSIGN
302 LDDSYM==10 ;LOCAL SYMS
303 LTCP==11 ;LOAD TIME COND ON PRESENCE
304 ELTCB==12 ;END LOAD TIME COND
305 LPLSH==22 ;POLISH FIXUP
310 LCGLO==2 ;GLOBAL LOC ASSIGN
311 LCCMST==3 ;SET COMMON BENCHMARK
312 LCEGLO==4 ;END OF GLOBAL BLOCK
313 LDCV==5 ;LOAD TIME COND ON VALUE
314 LDOFS==6 ;LOADER SET GLOBAL OFFSET
317 ;LOADER CODEBITS SECOND SPEC AFTER 7
320 CLGLO==2 ;LOC-GLO REC
323 CRPT==5 ;REPEAT GLOBAL VALUE
324 CDEFPT==6 ;DEFINE SYM AS $.
326 ;DEC RELOCATABLE BLOCK TYPES.
327 DECWDS==1 ;STORAGE WORDS.
328 DECSYM==2 ;SYMBOL DEFS OR GLOBAL ADDITIVE RQS.
329 DECHSG==3 ;LOAD INTO HIGH SEG (FOR .DECTWO)
330 DECENT==4 ;ENTRY NAMES
331 DECEND==5 ;END BLOCK, HAS PROGRAM BREAK.
332 DECNAM==6 ;PROGRAM NAME.
333 DECSTA==7 ;STARTING ADDRESS BLOCK.
334 DECINT==10 ;INTERNAL REQUEST
335 DECRQF==16 ;REQUEST LOADING A FILE
336 DECRQL==17 ;REQUEST LOADING A LIBRARY
341 DEFINE PRINTA A,B,C,D,E,F
342 IF1,[PRINTC
\7fA!B!C!D!E!F
346 IF1 [DEFINE BNKBLK OP
350 ;ADD A LINE TO BNKBLK, ACCUMULATED CONTENT OF
351 ;WHICH IS DUMPED OUT AT END OF ASSEMBLY
352 ;ARG TO BLCODE SHOULD BE FREE OF STORAGE WORDS
355 IF1 [BNKBLK [DEFINE BNKBLK OP
363 .ISTOP TERMIN TERMIN ] TERMIN
365 ;3RDWRD MANIPULATING MACROS
366 ;GET 3RDWRD INTO LH("A"), "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE
372 ;GET 3RDWRD INTO "A", "B" HAS ADR OF 1STWRD
378 ;PUT "A" INTO 3RDWRD, "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE
384 ;PUT "A" INTO 3RDWRD, "B" HAS ADR OF 1STWRD
394 ;RANDOM MACRO DEFINITIONS
396 ;A HAS ADR OF SYM SQUOZE, SKIP IF IT'S IN SYMBOL TABLE
403 ;EXECUTE AN INSTRUCTION WITH VARIOUS ADDRESSES (USUALLY PUSH OR POP)
412 TDNE I,[ILWORD,,IRNOEQ\IRFLD]
423 ERRNVL==[ASCIZ /Returns no value/]
424 ERRABS==[ASCIZ /Allowed only for STINK relocatable format/]
441 ;THESE ARE SOME MACRO DEFINITIONS FOR THE UNFINISHED MULTI-WORD
442 ;SYMBOL NAME FEATURE. FOR COMPATIBILITY, THEY ALL NOW HAVE DEFINITIONS
443 ;THAT ONLY HANDLE ONE WORD. THOSE OTHER DEFINITIONS COME AFTER THESE.
448 IFSN X,SYM,SKIPE A,X+1
453 DEFINE COPY2 X,Y,Z=USING A
460 DEFINE STORE2 AC,Y,Z=USING A
468 ;THESE ARE THE DEFINITIONS OF THE MACROS THAT DO NOT IMPLEMENT
469 ;MULTI-WORD SYMBOL NAMES.
476 DEFINE COPY2 X,Y,Z=USING A
481 DEFINE STORE2 AC,Y,Z=USING A
493 IFE .OSMIDAS-SIXBIT/ITS/,[
494 IFE CMUSW\SAILSW,.INSRT SYS:DECDFS
495 IFN SAILSW, .INSRT SYS:SAIDFS
496 IFN CMUSW, .INSRT SYS:CMUDFS
497 IFN TNXSW, .INSRT SYS:TNXDFS
498 ] ;IF ASSEMBLED ON ITS
499 IFN .OSMIDAS-SIXBIT/ITS/,[ ;OTHER PLACES DON'T KEEP THESE ON SYS:
500 IFE CMUSW\SAILSW,.INSRT DECDFS
501 IFN SAILSW, .INSRT SAIDFS
502 IFN CMUSW, .INSRT CMUDFS
503 IFN TNXSW, .INSRT TNXDFS
504 ] ;IF ASSEMBLED ON A NON-ITS PLACE
507 IFN TNXSW,[EXPUNGE RESET ; THE ONLY CONFLICTING JSYS/CALLI
530 IFN ITSSW,[IF1 [IFNDEF .IOT,[.INSRT SYS:ITSDFS
533 IFNDEF %PIPDL,.INSRT SYS:ITSBTS
538 .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
545 IFE PURESW,[ ;FOLLOWING IF NOT ASSEMBLING PURE CODING
554 IFN PURESW,[ ;FOLLOWING IF ASSEMBLING PURE CODING
556 ;MEMORY ORGANIZATION PURE CODING
558 ;MAXVAR BLOCKS OF IMPURE CODING, NO DYNAMIC ALLOCATION
559 ;BLCODE MACRO ACCUMULATES CODING TO BE PUT AT END OF
560 ;IMPURE CODING, NO STORAGE WORDS ALLOWED
561 ;THEN SYM TAB, STARTING AT ST.
562 ;THEN MACRO TABLE (WITH INIT. CODE IN IT)
563 ;STARTING INITIALLY AT MACTBA, ACTUAL ADDR IN MACTAD.
564 ;SYMTAB AND MACTAB DON'T NECESSARILY START ON PAGE BNDRYS.
565 ;THEN GAP TO MINPUR*2000 (HEREAFTER KNOWN AS "THE GAP")
566 IFN DECSW\TNXSW,MINPUR==200
567 IFN ITSSW,MINPUR==140 ;BLOCK NUMBER BEGINNING OF PURE CODING
568 ;PURE CODING UNTIL MAXPUR*2000-SOMETHING
569 ;THE FOLLOWING MACROS AND BLCODE MAKE IT NOT COMPLETELY NECESSARY
570 ;TO SEPARATE PURE CODING FROM IMPURE
572 CKPUR==0 ;0 => ASSEMBLING BELOW THE GAP, 1 ABOVE
574 ;SWITCH TO CODING ABOVE THE GAP
583 PUR.LC==MINPUR*2000+IFN DECSW,[RL0] ;SAVED LOCATION COUNTER ABOVE THE GAP WHEN ASSEMBLING BELOW
585 ;SWITCH TO CODING BELOW THE GAP
594 PBLK ;PBLK NORMAL MODE, VARIABLE AREAS BRACKETED WITH VBLK AND PBLK
596 ] ;END PURESW CONDITIONAL
598 .YSTGW ;SET UP NOW, STORAGE WORDS OK
604 IFN DECSW,[IFE SAILSW,LOC .JBAPR
609 ;DISPATCH TABLE FOR NON-SQUOZE CHARACTERS
610 ;REFERENCED AS DTB-40(RH OF POPJ IN GDTAB)
611 ;DTB ENTRY OF SYL TERMINATOR PUT IN CDISP BY GETSYL
613 DSYL==400000 ;SYL OPERATOR, DISPATCH INDEXED BY RH AT GETSYL (MUST BE SIGN)
614 DFLD==200000 ;FIELD OPERATOR, GETFD
615 DWRD==100000 ;WORD OP, GETWD
616 DSY1==1000 ;SET ONLY IF DSYL SET,
617 ;SET IF OP MIGHT BE 1ST CHAR OF NONNULL SYL.
619 DSY2==400 ;SET FOR _ ONLY.
621 ;ALL CLEAR => WORD TERMINATOR, NO DISPATCH
623 DTB: DWRD,,SPACE ;40 SP, TAB, RUBOUT
624 DSYL1,,RRL2 ;EXCLAIM AND OPEN-BRACE
627 DSYL,,RBRAK2 ;CLOSE-BRACE.
628 0 ;(USED TO BE PERCENT SIGN)
629 DFLD,,ANDF ;AMPERSAND
633 DFLD,,MULTP ; STAR TIMES
637 DSYL1,,CTLAT ;^@ (56)
639 DSYL1,,COLON ;COLON 60
645 DSYL1,,ATSGN ;AT SIGN
647 DFLD,,IORF ;BACKSLASH 70
650 DSYL+DSY2,,BAKAR ;BACKARR
654 DSYL,,LINEF ;LF (DSYL TO HACK CLNN)
655 DSYL,,FORMF ;FORM FEED (") 100
657 ;NOTE THAT POPJ P, IS VALID TEST FOR SQUOZENESS
660 GDTAB: POPJ P,56 ; ^@ GETS IGNORED.
661 REPEAT 2,POPJ P,76 ;(GDTAB GLOBAL SO OUT OF TS, AIO CAN CLOBBER GDTAB+141 WITH JRST RREOF
663 IFN .-GDTAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH GDTAB.
664 IFE TS,[POPJ P,76] IFN TS,[JRST RREOF]
669 POPJ P,100 ; FORM FEED
671 REPEAT "!-16-1,POPJ P,76
688 REPEAT 10.,JSP CH2,RR2 ; DIGITS
696 IFDEF .CRFOFF,.CRFOFF
697 IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ
705 POPJ P,76 ; NOW LOWER CASE GRAVE ACCENT
707 IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ
715 POPJ P,40 ; RUBOUT, LIKE SPACE
716 IFN .-GDTAB-200,.ERR GDTAB LOSES
718 NSQTB: IFDEF .CRFOFF,.CRFOFF
723 IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890$%.
725 SQUOZE 0,Q/50/50/50/50/50
726 SQUOZE 0,Q/50/50/50/50
735 ;4.9-4.4 ETC SPECIFY SHIFT
736 ;4.4-3.6 ETC SPECIFY NUMBER BITS
737 ;FIELD SPECS IN REVERSE ORDER
739 IFORTB: 0 ;NCNSN 10 ,
743 2200000000 ;NCFSN 14 ,B
747 4400000000 ;FSNSN 20 A
751 2200440000 ;FSFSN 24 A B
752 2200220044 ;FSFSF 25 A B C
753 270400440000 ;FSFCN 26 A B,
754 2227040044 ;FSFCF 27 A B,C
755 4400000000 ;FCNSN 30 A,
757 22220000 ;FCNCN 32 A,,
758 2200002222 ;FCNCF 33 A,,B
759 2200440000 ;FCFSN 34 A,B
763 FRTBL==.-IFORTB ;LENGTH OF FORMAT TABLE
765 FORTAB: BLOCK FRTBL ;ACTUAL FORMAT TABLE
773 RETURN: JRST . ;RH HAS RETURN ADR FOR END OF MAJOR ROUTINE (E.G PASS 2)
774 CDISP: 0 ;CURRENT DISPATCH CODE
775 PPRIME: 0 ;PUSH DOWN LIST MARKER (GETFLD)
776 SCNDEP: 0 ;DEPTH IN SUCCESSFUL BRACKET CONDITIONALS INSIDE INNERMOST LITERAL.
777 CONDLN: 0 ;LINE NUMBER AT WHICH LAST TOP LEVEL SUCCESSFUL CONDITIONAL ENCOUNTERED
778 CONDPN: 0 ;PAGE NUMBER-- PRINT THESE IF REACH END AND CONDITIONAL NOT TERMINATED
779 CONDFI: 0 ;SIXBIT FN1 OF FILE CONTAINING LAST TOP LEVEL SUCCESSFUL CONDITIONAL.
780 A.SUCC: 0 ;NONZERO IFF LAST CONDITIONAL SUCCEEDED.
781 ASMOUT: 0 ;0 NORMAL, 1 WITHIN <>, 2 IN (), 3 IN [].
782 ASMDSP: ASSEM3 ;PLACE TO JUMP TO FROM ASSEM1 LOOP.
783 ;ASSEM3 NORMAL. ASSEMC IF WITHIN <>, () OR []
784 ;AND .MLLIT ISN'T POS. LSSTHA AFTER > OR ) SEEN.
785 ;[ ;CONND AFTER ] SEEN.
786 ASMDS1: 0 ;ASMDSP SAVED HERE DURING ASCII, SIXBIT PSEUDOS.
787 ASSEMP: 0 ;RESTORE P FROM HERE AT ASSEM1. SAVED OVER LITERAL.
788 ASMI: 0 ;REINIT I AT ASSEM2 FROM ASMI.
789 GLSPAS: 0 ;RESTORE GLSP1 AT ASSEM1. SAVED OVER LITERAL.
790 GLSP1: 0 ;POINTER TO BOT OF LINKAGE TABLE IN USE HIGH ADR
791 GLSP2: 0 ;POINTER TO TOP OF LINKAGE TABLE IN USE LOW ADR
792 FORMAT: 0 ;ACCUMULATES FORMAT WORD
793 FORPNR: 0 ;POINTER INTO FORMAT WORD, SHOULD BE FORMAT+1 SO CLOBBERABLE BY LAST IDPB
794 FLDCNT: 0 ;NUMBER OF FIELDS PUSHED DOWN IN CURRENT WORD
795 WRD: 0 ;ACCUMULATES VALUE OF WORD
796 WRDRLC: 0 ;RELOC OF WRD, MUST COME RIGHT AFTER WRD.
799 PBITS1: 0 ;CURRENT CODE BITS
800 PBITS2: 0 ;NO OF SPECS LEFT IN CURRENT WORD
801 PBITS4: 0 ;POINTER TO WHERE CURRENT CODE BITS WILL GO
802 OPT1: 0 ;POINTER FOR STORING IN BKBUF (OUTPUT BUFFER)
803 CONTRL: 0 ;FLAG REG FOR IO CONTROL ETC, .GE. 0 => RELOCATABLE/1PASS
804 CDATBC: 0 ;CURRENT DATA BLOCK CODE TYPE
805 SCKSUM: 0 ;CKSUM FOR SIMPLE BLOCK FORMAT
807 PRGC: -1 ;ONE LESS THAN # TIMES END HAS BEEN ENCOUNTERED
808 OUTN1: -1 ;.GE. 0 => OUTPUT HAS OCCURED IN OTHER THAN 1PASS MODE (NOT INITIALIZED)
809 OUTC: -1 ;.GE. 0 => OUTPUT HAS OCCURED DURING CURRENT ASSEMBLY
811 LINKL: 0 ;SAVE LIMIT OF GLOTB GETWRD
812 STRCNT: 0 ;COUNT OF CHARS READ (INCL. DELIM) BY GSYL
813 STRPNT: 0 ;TEMP AT GSYL, BYTE POINTER TO STRING STORAGE
814 ISYMF: -1 ;-1 IF ISYMS HAVE NOT BEEN SPREAD
815 SMSRTF: -1 ;-1 IF SYMTAB HASN'T BEEN SORTED (PSEUDOS DELETED)
816 BITP: 0 ;BYTE PNTR TO CODE BITS IN CURRENT (RELOC) BLOCK
817 LDCCC: 0 ;DEPTH IN LOADTIME CONDS
818 PARBIT: 0 ;0 OR 4 FOR : OR = (IN GENERAL, TEMP AT P7X)
819 LABELF: 0 ;-1 IN COLON, SOMETIMES IN EQUAL. CAUSES 3LABEL TO BE SET.
820 STGSW: 0 ;NON ZERO GIVES ERROR PRINT ON STORAGE WORDS
821 HKALL: 0 ;NONZERO => HALF-KILL ALL LABELS (.HKALL'S VALUE)
822 LITSW: 0 ;-1 => USING A LITERAL GIVES AN ERROR
823 QMTCH: 0 ;-1 => ' AND " NEED MATCHING CLOSINGS (A LA FAIL, MACRO-10)
824 STARTA: 0 ;STARTING ADDRESS FOR SBLK, RIM
825 DECBRK: 0 ;LARGEST RELOC. ADDR. LOADED INTO. (USED FOR DEC FMT)
826 DECBRA: 0 ;LARGEST ABS. ADDR LOADED INTO.
827 DECBRH: 0 ;LIKE DECBRK BUT FOR ADDRS IN HI SEG.
828 DECTWO: MOVE ;NOT = MOVE => .DECTWO WAS DONE, AND THIS WD HAS
829 ;ADDR START OF HISEG.
830 ISAV: 0 ;I FROM FIELD AT AGETFLD
831 A.PASS: 0 ; .PASS INTSYM, # OF THIS PASS.
832 A.PPAS: 0 ;.PPASS INTSYM, # OF PASSES.
833 WPSTE: NRMWPS ;# WORDS PER SYMTAB ENTRY
834 WPSTE1: NRMWPS-1;ONE LESS THAN WPSTE - FOR SPEED.
835 WPSTEB: ,-NRMWPS(B) ;RH HAS - # WORDS PER SYMTAB ENTRY; LH HAS INDEX OF B.
836 SYMSIZ: 0 ;#WDS IN SYMTAB = WPS*<SYMLEN>
837 SYMLEN: SYMMSZ ;SYMTAB SIZE (# SYMS)
838 ;ASSEMBLED-IN VALUE USED AS DEFAULT, ONLY IF NON-TS.
839 SYMAOB: 0 ;-<# SYMS>,,0
840 INICLB: 0 ;-1 IF INITIALIZATION CODE CLOBBERED.
841 TTYINS: 0 ;AT START OF ASSEMBLY, -1 => .INSRT TTY PASS1, -2 => PASS2 ALSO.
843 FASBP: 0 ;PNTR TO FASL OUTPUT BUFFER
844 FASATP: 0 ;PNTR TO FASL ATOM TABLE
845 FASAT1: 0 ;PNTR TO FASL ATOM TABLE AFTER READING IN NEW ATOM
846 ; (MAYBE UPDATE FASATP TO THIS IF ATOM WAS UNIQUE9
847 FASAT2: 0 ;BYTE PNTR USED TO STORE ATOM IN
848 FASIDX: 0 ;INDEX NEXT ATOM LOADED INTO FASAT WILL BE
849 FASPCH: 0 ;AMOUNT OF FASAT "PUNCHED"
850 FASCBP: 440400,,FASB ;BYTE PNTR TO FASL CODE BIT WORD
851 FASPWB: 0 ;FASL CODE AT PWRD
852 FASBLC: 0 ;LOSING BLOCK "COUNT"
853 FASBLS: 0 ;LOSING BLOCK "SYMBOL"
854 AFRLD: 0 ;LIST READ CURRENT DEPTH
855 AFRLEN: 0 ;LIST READ CURRENT LENGTH
856 AFRDTF: 0 ;LIST READ DOT CONTEXT FLAG (0 NORMAL, 1 SAW DOT, 2 SAW "FROB AFTER DOT"
857 AFRFTP: 0 ;LIST READ SAVED STATE OF FASATP
858 AFLTYP: 0 ;TYPE LIST OP IN- 0 EVAL AND THROW AWAY VALUE
860 ;2 "RETURN" VALUE OF LIST
864 ;INFO CONVENIENT TO ANYONE GENERATING AN OUT OF TIME-SHARING MIDAS
866 ;MIDAS OUT OF TIME-SHARING ASSEMBLES INTO A COLLECTION OF SUBROUTINES
867 ;IO IS EXPECTED TO BE HANDLED BY OTHER PROGRAMS.
869 ;EXITS FROM THE ASSEMBLER:
870 ;TPPB OUTPUT BINARY WORD IN A
871 ;TFEED IF OUTPUT DEVICE IS PTP, PUNCH OUT # FRAMES OF BLANK TAPE
872 ;SPECIFIED BY B, MAY CLOBBER A AND B
873 ;GO2 RETURN POINT FROM FATAL ERRORS
874 ;TYO TYPE OUT CHARACTER IN A
875 ;TAB TYPE OUT A TAB (MAY CLOBBER A OF COURSE)
876 ;RCHTBL SEE THE RCH ROUTINES
880 ;PDL, LPDL MAY BE USED BY COMMAND PROCESSOR BUT WILL BE CLOBBERED BY MAIN ROUTINES
881 ;MAIN ROUTINES, CALLED WITH JSP A, , CLOBBER THE WHOLE WORLD (INCLUDING P)
884 ;PLOD IF APPROPRIATE, PUNCH OUT LOADER
885 ;PS2 PASS 2 (DOES ITS OWN PARTIAL INITIALIZATION)
886 ;PSYMS PUNCH OUT SYMBOL TABLE
890 ;CONTRL AFTER ASSEMBLY, .GE. 0 => RELOCATABLE, .LT. 0 => ABSOLUTE
891 ;ISYMF -1 IF SYMS HAVE NOT BEEN SPREAD, ELSE DON'T TRY TO ADD TO INITIAL SYMBOL TABLE
892 ;SMSRTF -1 IF SYMTAB HASN'T BEEN SORTED, ELSE SYMTAB CLOBBERED, DON'T RE-ASSEMBLE
893 ;MIDVRS .FNAM2 OF MIDAS ENGLISH
895 ;SOME FF FLAGS ARE GLOBAL SO COMMAND PROCESSOR CAN KNOW WHAT'S HAPPENED ON RETURN
897 ;COMMAND PROCESSOR MAY ADD TO INITIAL SYMBOL TABLE BEFORE CALLING INIT THE FIRST TIME
898 ;EISYMT IS THE FIRST LOCATION OK TO DUMP INTO
899 ;EISYMP RH SHOULD BE SET BY COMMAND PROCESSOR TO FIRST LOC NOT DUMPED INTO
900 ;INTSYM RH OF SYMTAB VALUE TO RETURN VALUE ADDRESSED BY LH(SYMTAB ENTRY)
902 ;RCH HAS AN ELABORATE SET OF GLOBALS, WHICH I DON'T FEEL LIKE PUTTING DOWN NOW, BUT THEY INCLUDE
903 ;RCH (GET CHAR) SEMIC, RRL1, RREOF, SEMICR, SEMIC, TYPCTL, GDTAB, CPGN, CLNN,
904 ;RCHMOD, MDSCLR, MDSSET, RCHSET, POPLMB, PSHLMB
905 ;ALSO RCHTBL ONLY EXIT
907 ;LISTING FEATURE GLOBALS:
908 ;PILPT PRINT CHAR IN A
909 ;LISTON LISTING ON/OFF FLAG, -1 => ON
910 ;LISTP SAME WORD AS LISTON.
911 ;LISTP1 POSITIVE => LIST EVEN ON NON-PUNCHING PASS.
912 ;LPTCLS END OF LISTING, PRINT FORM FEED, IF TS THEN CLOSE LPT
914 ;CREF FEATURE GLOBALS:
915 ;CRFOUT OUTPUT WORD IN A.
916 ;CREFP -1 => REQUEST GENERATION OF CREF OUTPUT.
917 ;THE RUBOUT-B-^W HEADER, THE SET-SOURCE-FILE BLOCK, AND THE EOF BLOCK
918 ;ARE THE RESPONSIBILITY OF THE COMMAND PROCESSOR.
920 ;;RCH ;CHARACTER INPUT ROUTINES
923 ;SAVE LIMBO1 STATUS AND RH(B)
924 ;THEN SET UP FOR NEW INPUT MODE (DESCRIPTOR IN A)
925 ;CALLED BY PUSHEM AND PUSHTT
927 PSHLMB: HRL B,LIMBO1 ;LAST CHARACTER INPUT
928 TLZE FF,FLUNRD ;RE-INPUT CHARACTER ON RETURN?
929 XCT LSTPLM ;SET B'S SIGN; IF LISTING, JRST PSHLML.
930 PSHLMN: EXCH A,RCHMOD ;GET OLD MODE IN A
931 DPB A,[360500,,B] ;STORE IN 5 OF HIGH 6 BITS IN B
932 PUSH F,B ;SAVE RESULTANT CRUD
933 CAMN A,RCHMOD ;COMPARE NEW WITH OLD
934 POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE
935 MOVE A,RCHMOD ;NOW GET NEW MODE
936 JRST PSHLM1 ;SET UP INSTRUCTIONS FOR NEW MODE
939 ;IF LISTING, LSTPLM HOLDS JRST PSHLML
941 JRST PSHLMM ;LAST WAS BREAK CHR
949 ;UNDO A PSHLMB (NOTE: IN COMMENTS BELOW, "NEW" MODE IS ON PDL, OLD IN RCHMOD)
951 POPLMB: POP F,A ;GET WORD THAT PSHLMB PUSHED
952 HLRZS A ;JUST INTERESTED IN LEFT HALF
953 TRZE A,400000 ;SIGN BIT SET?
954 TLOA FF,FLUNRD ;YES, SET FLAG TO RE-INPUT LAST CHAR
955 TLZA FF,FLUNRD ;NO, CLEAR FLAG.
956 XCT POPLML ;JFCL\IDPB A,PNTBP ;THE LATTER IFF LISTING.
957 SETZM LIMBO1 ;INITIALIZE FOR DPB
958 DPB A,[700,,LIMBO1] ;RESTORE LIMBO1
959 LSH A,-<18.-6> ;RIGHT JUSTIFY RCHMOD DESCRIPTOR
960 CAMN A,RCHMOD ;COMPARE NEW MODE WITH OLD
961 POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE
962 JRST RCHSET ;SET UP FOR NEW MODE AND RETURN
966 FOO==0 ;INITIALIZE COUNTER FOR FOLLOWING
968 DEFINE RCHBLT SIZE,ADR/
981 ;SET UP FOR INPUT OF MODE TYPE SPECIFIED IN A, CLOBBER A ONLY
983 RCHSET: MOVEM A,RCHMOD ;STORE NEW RCHMOD
984 PSHLM1: TLZ FF,FLMAC\FLTTY ;CLEAR FLAGS (MAYBE DEVICE ROUTINE SETS ONE)
985 XCT RCHTBL(A) ;GET IN A A POINTER TO A DESCRIPTOR TABLE (MAYBE ALSO SET FLAG)
986 PUSH P,T ;SAVE T, NEED IT FOR TEMP
987 RCHBLT 3,RCH2 ;FIRST 3 WORDS RCH2
989 JRST POPTJ ;ALL RCH'S TO GO THROUGH RCH, DON'T DO ANYTHING ELSE
990 MDSST1: RCHBLT 3,RR1 ;NEXT 3 RR1
991 RCHMOV RRL1 ;NEXT WORD RRL1
992 RCHPSN==FOO ;# WORDS IN ALL TABLES BUT LAST (NOT OF CONSTANT LENGTH)
993 RCHBLT 6,SEMIC ;LAST N SEMIC
998 ;SET UP TO "DISPLAY" (ALL RCH'S THROUGH RCH)
1000 MDSSET: TLO FF,FLVOT ;SET FLAG
1001 MOVEI A,MDSSTB-3 ;SET UP AC
1002 PUSH P,T ;SAVE T FOR RESTORATION
1003 JRST MDSST1 ;NOW SET UP
1005 MDSSTB: JRST RRL1 ;RR1
1010 IFN .-<MDSSTB-3>-RCHPSN,.ERR LOSSAGE AT MDSSTB.
1016 ;CLEAR OUT DISPLAY MODE
1018 MDSCLR: TLZ FF,FLVOT ;CLEAR FLAG
1020 JRST RCHSET ;NOW SET UP FOR REAL IN CURRENT MODE
1023 IFN TS,[ ;TABLE FOR RCHSET, INDEXED BY MODE
1024 ;MAYBE THIS CONDITIONAL WANTS TO BE CHANGED TO SOMETHING ELSE
1026 RCHTBL: MOVEI A,RCHFIL ;0 => INPUT FROM FILE
1027 IFN MACSW,PUSHJ P,RCHMAC ;1 => INPUT FROM MACRO (DO NOT CHANGE, USED BY MACRO PROCESSOR)
1028 IFN RCHASW,[IFE MACSW,HALT
1029 PUSHJ P,RCHTRC ;2 => TTY, QUIT ON CR
1030 PUSHJ P,RCHARC ;3 => TTY, DON'T QUIT ON CR
1032 ;TABLE FOR INPUTTING FROM FILE
1033 ;MAYBE THIS CONDITIONAL ALSO WANTS TO BE CHANGED
1035 RCHFIL: ILDB A,UREDP ;GETCHR, GET CHARACTER
1036 CAIG A,14 ;SKIP IF TOO BIG TO BE SPECIAL
1037 XCT RPATAB(A) ;SPECIAL, DO THE APPROPRIATE THING
1041 PUSHJ P,INCHR3 ;RREOF
1044 IFN .-RCHPSN-RCHFIL,.ERR RCHFIL LOSES.
1045 LDB CH1,[360600,,UREDP] ;SEMIC; FIND WHERE IN ITS WORD UREDP POINTS
1047 JRST @SEMIC3(CH1) ;AND ENTER THE CR-SCANNING LOOP AT THE APPROPRIATE
1048 JFCL ;PLACE (IT IS A WORD-BY-WORD LOOP).
1050 ;TABLE FOR ABOVE, EXECUTED INDEXED BY CHAR, 15 ONLY FROM SEMIC ELSE ANYTHING
1053 IFN ITSSW, JFCL ;0, ON I.T.S. IS NORMAL CHARACTER
1054 .ELSE CALL RPANUL ;0, ON DEC SYSTEM, IGNORE IT.
1057 IFN .-RPATAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH ENTRY IN RPATAB.
1058 PUSHJ P,INCHR3 ;3, EOFCH
1060 CALL RPALF ;LINE FEED
1062 PUSHJ P,RPAFF ;FORM FEED
1063 JRST SEMICR ;FROM SEMIC ONLY, EXIT FROM LOOP
1065 RPAFF: SKIPE ASMOUT ;FORM FEED
1066 ETR [ASCIZ/Formfeed within <>, () or []/]
1070 ADD CH1,[SIXBIT /P0/+1]
1072 DPB CH2,[300200,,CH1]
1073 .SUSET [.SWHO3,,CH1] ;PUT THE NEW PAGE # IN THE WHO-LINE.
1084 RPANUL: MOVE CH1,@UREDP ;SAW A NULL - IN A LINE NUMBER?
1086 JRST RCHTRA ;NO, JUST IGNORE IT.
1088 HRLM CH1,UREDP ;YES, SKIP THIS WHOLE WORD, THEN
1089 CALL RCH ;SKIP THE 1ST CHAR AFTER THE LINE NUMBER
1090 JRST RCHTRA ;RETURN THE NEXT CHAR FROM THIS CALL TO RCH.
1095 LIMBO1: 0 ;LAST CHARACTER READ BY RCH
1096 RCHMOD: 0 ;CURRENT INPUT MODE, 0 => INPUT FROM FILE, 1 => MACRO, ETC.
1097 CLNN: 0 ;1 LESS THAN LINE # IN CURRENT INPUT FILE.
1098 CPGN: 0 ;1 LESS THAN PAGE # IN CURRENT INPUT FILE
1099 A.STPL: 0 ;1 LESS THAN LINE # TO STOP AT.
1100 A.STPP: 0 ;1 LESS THAN PAGE # TO STOP AT.
1101 ;(STOPPING MEANS INSERTING THE TTY)
1103 ;READ CHARACTER INTO A FROM INPUT FILE, MACRO, OR WHATEVER (RCH)
1104 ;CLOBBERS A,CH1,CH2.
1107 JRST RCH1 ;RE-INPUT LAST ONE MAYBE GET HERE FROM RCH2+2
1108 RCH2: HALT ;ILDB A,UREDP ;ILDB A,CPTR ;GET CHAR
1109 0 ;CAIG A,14 ;TRZE A,200 ;CHECK FOR SPECIAL
1110 0 ;XCT RPATAB(A) ;PUSHJ P,MACTRM ;SPECIAL, PROCESS
1111 MOVEM A,LIMBO1 ;GOT CHAR, SAVE AS LAST CHAR GOTTEN
1112 IFE TS,RCHLS1==JRST TYPCTL
1113 IFN TS,RCHLS1==RET ;DEFAULT CONTENTS OF RCHLST (IF NOT LISTING)
1114 RCHLST: RCHLS1 ;AOSN PNTSW IF LISTING.
1120 TYPCTL: POPJ P, ;OR JRST SOMEWHERE
1128 RCHL2: MOVEM A,LISTBC
1134 RCH1LS: RET ;OR CAILE A,15 IF LISTING.
1135 RET ;NEEDED IN CASE LISTING.
1151 ;;GETSYL ;VARIOUS SYLLABLE READING ROUTINES (BUT NOT ALL OF THEM)
1153 GSYL: CLEARB SYM,STRCNT
1155 MOVE T,[440700,,STRSTO]
1157 GSYL3: AOSG A,STRCNT
1160 IDPB A,STRPNT ;STORE CHAR IN STRING EVEN IF DELIMITER (MINIMUM STRCNT = 1)
1166 PUSHJ P,GSYL1B ;RETURN ONLY ON SYL SEP
1171 GSYL1B: XCT GDTAB(A) ;POPJ FOR SYL SEPS
1173 GSYL1D: SOJGE D,GSYL3
1176 GSYL1C: ADD SYM,%.SQ(D)
1179 GSYL1A: XCT NSQTB-60(A)
1182 ;VERSION OF GETSYL TO TRY UNTIL SYL OR WORD TERMINATOR FOUND
1183 ;SKIPS IF NAME THERE (FOR .TYPE, SQUOZE)
1185 GTSLD2: TLNN C,DWRD\DFLD
1186 JRST GTSLD3 ;DELIMITER IS WORD TERMINATOR, TOLERATE THE NULL SYLLABLE
1187 GETSLD: PUSHJ P,GETSYL ;ENTRY, GET A SYL
1188 MOVE C,CDISP ;GET CDISP
1191 AOS (P) ;GOT SYL, CAUSE RETURN TO SKIP
1192 GTSLD3: TLNN C,DWRD\DFLD
1193 TLO FF,FLUNRD ;CAUSE DELIMITER TO BE RE-INPUT
1196 PASSPS: SKIPA A,LIMBO1
1203 GETSYL: TLZ I,ILUARI+ILNPRC+ILLSRT
1204 GTSL1: CLEARB SYM,NUMTAB ;RECUR HERE FOR RIGHT ARG TO ^ AND _.
1205 MOVE AA,[NUMTAB,,NUMTAB+1]
1207 BLT AA,NUMTAB+10 ;NUMTAB NOT CLEAR, HAVE TO CLEAR IT
1208 MOVEI D,6 ;CHARACTER COUNTER FOR BUILDING UP SYM
1209 SETOM ESBK ;NO SPECIFIC BLOCK DESIRED.
1210 TDZ I,[ILDECP+ILFLO+ILVAR+ILGLI,,IRPERI+IRLET+IRSYL]
1211 RRL2: PUSHJ P,RR ;CALL MAIN LOOP ROUTINE, READ UNTIL NON-SQUOZE CHAR
1212 SEMICR: ;RETURN HERE FROM SEMIC WITH CR IN A
1213 MOVEM A,LIMBO1 ;SYLLABLE OPERATOR OR TERMINATOR IN A, SAVE
1214 HRRZ A,GDTAB(A) ;NOW GET RIGHT HALF OF POPJ, INDEX INTO DTB
1215 MOVE C,DTB-40(A) ;GET DTB ENTRY (FLAGS,,JUMP ADR)
1216 MOVEM C,CDISP ;STORE AS DISPATCH CODE FOR LAST CHAR (SORT OF AN INTERPRETED LIMBO1)
1217 RR8: TLNE C,DSYL ;NOW SEE IF SYL OPERATOR FLAG SET
1218 JRST (C) ;SET => INTRA-SYLLABLE OPERATOR
1219 RR10: TRNE I,IRLET ;NOT SET => SYLLABLE TERMINATOR: SYL?
1220 POPJ P, ;SYL HAS LETTERS
1223 CAMN SYM,[SQUOZE 0,.]
1230 JRST RR9 ;NOT FLOATING POINT
1231 MOVE A,B ;FLOATING, HIGH IN AA,LOW IN A,EXP IN B
1232 ADDI A,306 ;201+105 TO ROUND
1233 ADDI AA,200 ;CAUSE EXPONENT TO BE ACCEPTABLE TO MACHINE
1234 JUMPGE AA,.+3 ;NOW CHECK FOR OVERFLOW ON ROUNDING
1235 LSH AA,-1 ;OVERFLOW, SHIFT BACK ONE
1236 AOS A ;INCREMENT EXPONENT TO COMPENSATE FOR SHIFT
1237 EXCH A,AA ;GET EXPONENT IN AA, REST IN A
1238 ASHC AA,-10 ;SHIFT TO MACHINE FLOATING POINT FORMAT
1239 SKIPE AA ;NOW CHECK HIGH ORDER BITS OF EXPONENT NOT SHIFTED INTO NUMBER
1240 ETR [ASCIZ /Exponent overflow/]
1241 RR9: TLZ I,ILGLI+ILVAR ;NOT TRYING TO DEFINE NUMBER AS VARIABLE OR GLOBAL
1242 CLBPOP: TDZA B,B ;CLEAR OUT B (RELOCATION BITS OF VALUE)
1243 CABPOP: SETZB A,B ;DO JRST CABPOP TO RETURN ZERO AS VALUE
1246 RRU: MOVE A,LIMBO1 ;GET HERE WHEN FLUNRD SET AT RR, RETRIEVE CHARACTER FROM LIMBO1
1247 CAIG A,14 ;IF TOO BIG,
1248 CAIGE A,12 ;OR IF TOO SMALL,
1249 JRST RR1B ;THEN JUST FALL BACK IN
1250 TLNN FF,FLVOT\FLMAC\FLTTY ;SKIP IF NOT HACKING CPGN/CLNN
1251 XCT RRUTAB-12(A) ;HACKING, UNHACK FOR HACK COMING UP
1252 JRST RR1B ;FALL BACK IN
1254 RRUTAB: SOS CLNN ;LINE FEED (TABLE FOR RRU)
1258 ;MAIN LOOP ROUTINE FOR GETSYL, READ SYM OR NUMBER
1260 RR: TLZE FF,FLUNRD ;RE-INPUT LAST CHARACTER?
1261 JRST RRU ;YES (SOMETIMES RETURN HERE FROM RREOF)
1262 RR1: JRST RRL1 ;ILDB A,CPTR ;GET CHAR (" " ")
1263 HALT ;TRZE A,200 ;CHECK FOR END OF STRING
1264 RREOF: PUSHJ P,RCH ;PUSHJ P,MACTRM ;PROCESS CONDITION, GET NEXT CHAR OR JRST RR1 OR RR1-1
1265 RR1B: XCT GDTAB(A) ;GOT CHAR, DO SOMETHING APPROPRIATE (POPJ ON NOT SQUOZE)
1266 TROA I,IRLET\IRSYL ;LETTERS RETURN, JUST UPDATED SYM, SET FLAGS
1267 TRO I,IRSYL ;NUMBERS RETURN, SET FEWER FLAGS
1268 SOJGE D,RR1 ;DECREMENT SYM COUNTER AND LOOP
1269 AOJA D,RR1 ;COUNTER EXHAUSTED, INCREMENT BACK TO 0 AND LOOP
1271 RRL1: PUSHJ P,RCH ;ILDB A,UREDP ;GET CHAR
1272 XCT GDTAB(A) ;NOW MAKE LIKE RR1B (EOFCH => JRST RREOF)
1278 ;SEMICOLON (GET HERE FROM RR8)
1280 JRST SEMICL ;RETURN HERE FROM SEMIC+2 WHEN FLUNRD SET
1281 ;NEXT 4 INSNS ALTERED IN DIFFERENT INPUT MODES. SEE RCHFIL, ETC.
1282 SEMIC: PUSHJ P,RCH ;GET CHAR
1283 CAIE A,15 ;SEE IF SPECIAL
1284 JRST SEMIC ;SPECIAL => DO SOMETHING (JRST SEMICR ON CR)
1285 JRST SEMICR ;IF NOT SPECIAL THEN GO BACK FOR NEXT CHAR
1287 LOC SEMIC+6 ;LEAVE A LITTLE EXTRA ROOM FOR BIG ROUTINES
1290 SEMICL: MOVE A,LIMBO1 ;HERE FROM SEMIC-1, RETRIEVE CHARACTER FROM LIMBO1
1291 CAIE A,15 ;SKIP IF SHOULD TERMINATE SCAN
1292 JRST SEMIC ;NOT CR, FALL BACK IN
1301 MOVE A,[ASCII /@@@@@/]
1302 SEMIC1: AOS CH1,UREDP
1303 MOVE CH1,(CH1) ;ANY CONTROL CHARS IN THE WORD UREDP POINTS AT?
1310 JRST SEMIC1 ;NO, ADVANCE TO NEXT WORD AND TEST IT.
1313 JRST SEMIC2 ;YES, LOOK AT EACH CHAR AND PROCESS IT.
1315 SEMIC3: REPEAT 6,JRST SEMIC2+3*<5-.RPCNT>
1319 ;JSP CH2,RR2 => DIGIT (FROM GDTAB)
1320 ;THIS ROUTINE IS GROSSLY SLOW, AND SHOULD BE SPEEDED UP SOMETIME
1322 RR2: XCT NSQTB-"0(A) ;UPDATE SQUOZE.
1324 JRST 1(CH2) ;SYL IS SYM, DON'T WASTE TIME.
1326 TLO I,ILFLO ;DIGIT AFTER . => FLOATING.
1327 MAKNUM: SETOM NTCLF ;NUMTAB ABOUT TO NOT BE CLEAR, SET FLAG FOR GETSYL TO CLEAR IT OUT NEXT TIME
1328 MOVEI AA,2 ;INDEX INTO NUMTAB ETC., SOJGE'D TO GET ALL RADICES
1329 MAKNM1: MOVE T,ARADIX(AA) ;GET THIS RADIX,
1330 CAMN T,ARADIX ;REDUNDANT => SKIP THIS PASS.
1332 SKIPGE CH1,HIGHPT(AA)
1334 MUL T,LOWPT(AA) ;TT HAS OLD LOW TIMES RADIX, T HAS OVFLO TO HIGH.
1335 ADDI TT,-"0(A) ;ADD DIGIT TO LOW PART
1337 AOJ T, ;OVERFLOW, INCREMENT SPILLOVER FROM MUL OF LOWPT
1338 JUMPE CH1,MAKNM5 ;OLG HIGHPT WAS 0 => SAVE TIME.
1339 JFCL 17,.+1 ;NOW CLEAR OV, ETC.
1340 IMUL CH1,ARADIX(AA) ;MULTIPLY HIGHPT BY RADIX
1341 ADD T,CH1 ;ADD HIGH PARTS
1342 JFCL 10,MAKNM2 ;JUMP ON OVERFLOW FROM IMUL OR ADD
1343 MAKNM5: TLNE I,ILFLO
1344 SOS NUMTAB(AA) ;FLOATING, DECREMENT EXP TO COMPENSATE FOR MULT OF HIGHPT/LOWPT
1345 MOVEM T,HIGHPT(AA) ;NOW STORE STUFF BACK
1347 MAKNM4: SOJGE AA,MAKNM1 ;NOW DO ALL THIS FOR NEXT RADIX
1350 MAKNM2: MOVSI B,400000 ;OVERFLOW FROM UPDATING HIGH PARTS
1351 IORM B,HIGHPT(AA) ;SET SIGN BIT
1352 MAKNM3: TLNN I,ILFLO
1353 AOS NUMTAB(AA) ;NOT FLOATING, INCREMENT EXP, MAY NOT WANT TRAILING BITS
1360 HIGHPT: 0 ;HIGH PART OF CURRENT NUMBER THIS RADIX
1361 0 ;4.9 => OVERFLOW, TRAILING DIGITS DROPPED
1363 LOWPT: 0 ;LOW PART OF CURRENT NUMBER THIS RADIX
1364 0 ;HIGHPT/LOWPT TAKEN AS 70. BIT POSITIVE INTEGER EXCEPT 4.9(HIGHPT) IS FLAG INSTEAD OF
1365 0 ;EXPONENTIATE 70. BIT INTEGER BY NUMTAB (WHICH MAY BE NEGATIVE) TO GET ACTUAL VALUE
1366 ARADIX: 10 ;CURRENT RADIX
1370 NTCLF: -1 ;-1 => NUMTAB NOT CLEAR (TO SAVE BLT AT GETSYL WHEN CLEAR)
1373 ;JRST POINT => . (FROM GDTAB)
1375 POINT: TLO I,ILDECP ;PREFER DECIMAL
1376 TROE I,IRPERI ;SET PERIOD FLAG
1377 TRO I,IRLET ;2 POINTS => NAME
1378 ADD SYM,%.SQ(D) ;UPDATE SYM
1381 RBRAK: SOSL SCNDEP ;IF A CONDITIONAL TO TERMINATE,
1382 JRST RBRAK2 ;HAVE DONE SO, IGNORE CHAR.
1384 ;CLOSES OF ALL KINDS COME HERE.
1386 GRTHN: MOVE A,LIMBO1
1387 SKIPE CH1,ASMOUT ;WHAT KIND OF OPEN ARE WE IN?
1388 CAIN CH1,4 ;WITHIN A .ASCII OR
1389 JRST RBRAK1 ;NOT WITHIN GROUPING => THIS CLOSE IS STRAY.
1390 CAME A,ASMOT1(CH1) ;RIGHT KIND OF CLOSE FOR THAT OPEN?
1392 RBRAK4: MOVE CH1,ASMOT2(CH1)
1393 MOVEM CH1,ASMDSP ;ARRANGE FOR THIS ASSEM1 LEVEL TO EXIT
1395 JRST RR10 ;AND GO TERMINATE WORD.
1397 RBRAK3: CALL TYOERR ;COME HERE ON CLOSE WRONG FOR OPEN.
1398 ;(EG, ")" MATCHING "<").
1399 TYPR [ASCIZ/ Seen when /]
1402 TYPR [ASCIZ/ expected
1406 RBRAK1: CAIN CH1,4 ;CLOSE INSIDE A .ASCII =>
1407 JRST RBRAK5 ;TERMINATE WORD BUT DON'T CLOSE ANYTHING.
1408 SKIPN CONSML ;COME HERE FOR STRAY CLOSE.
1411 TYPR [ASCIZ/Stray /]
1412 MOVE A,LIMBO1 ;GET THE CLOSE WE SAW.
1417 ;COME HERE FOR CLOSE-BRACE, AND CERTAIN CLOSE-BRACKETS.
1418 RBRAK2: SETOM A.SUCC ;HAVE JUST ENDED SUCCESSFUL BRACKETED CONDIT,
1419 JRST RRL2 ;REMEMBER THAT MOST RECENT CONDITIONAL WAS TRUE.
1421 FORMF: TLNN FF,FLVOT\FLMAC\FLTTY ;FORM FEED SYLLABLE OPERATOR ROUTINE
1422 PUSHJ P,RPAFF ;UNLESS ALREADY DONE, INCREMENT PAGE #.
1425 LINEF: TLNN FF,FLVOT\FLMAC\FLTTY ;LINE FEED SYLLABLE OPERATOR ROUTINE
1431 TLNN FF,FLVOT\FLMAC\FLTTY ;^@ SYLLABLE OPERATOR ROUTINE.
1436 ;DECIPHER A VALUE FROM NUMTABS
1437 ;LEAVES HIGH PART IN AA, LOW PART IN A, BINARY EXPONENT IN B
1438 ;AND RADIX USED IN D.
1440 NUMSL: TLNN I,ILVAR\ILDECP\ILFLO
1443 MOVE A,LOWPT ;BE VERY FAST IN CASE OF SMALL FIXNUM IN CURRENT RADIX.
1444 MOVE D,ARADIX ;SAVE RADIX AND HIGH PART FOR ^.
1448 NUMSLS: CLEARB TT,D ;TT BIT EXPONENT, D INDEX INTO NUMTAB, ETC.
1449 TLNE I,ILDECP+ILVAR ;NEITHER . NOR ', CURRENT RADIX.
1450 TLNE I,ILGLI ;" => CURRENT RADIX DESPITE . OR '.
1452 MOVEI D,1 ;DECIMAL UNLESS '
1453 TLNE I,ILVAR ;WHICH FORCES OCTAL.
1456 CAMN A,ARADIX ;IF REALLY SAME AS CURRENT RADIX,
1457 MOVEI D,0 ;COMPUTATION WASN'T DONE FOR THIS VALUE OF D,
1458 ;SO USE COMPUTATIONS DONE FOR CURRENT RADIX.
1459 NUMSL0: MOVE AA,HIGHPT(D) ;AA := HIGH PART
1460 MOVE B,LOWPT(D) ;B := LOW PART
1461 MOVE T,NUMTAB(D) ;T := EXPONENT
1462 MOVE D,ARADIX(D) ;NO LONGER NEED IDX, GET RADIX VALUE.
1464 JRST FIXNUM ;NOT FLOATING
1465 TLZ AA,400000 ;FLOATING, DON'T NEED DIGITS LOST ON OVERFLOW
1466 NUMC1: JUMPN AA,.+2 ;ENTRY FROM UPARR
1467 JUMPE B,FIX0 ;COMPLETELY ZERO => RETURN FIXED ZERO
1468 JUMPL T,NUMSL1 ;JUMP IF EXPONENT NEGATIVE
1469 JUMPE T,NUMSL2 ;JUMP (SKIP FOLLOWING) IF EXPONENT ZERO
1470 ;EXPONENT POSITIVE, DO THE APPROPRIATE THING
1471 NUMSL5: MULI B,(D) ;MULITIPLY LOW PART BY RADIX
1472 MULI AA,(D) ;MULTIPLY HIGH PART BY RADIX
1473 ADD A,B ;A := LOW PART OF HIGH + HIGH PART OF LOW
1475 ADDI AA,1 ;OVERFLOW ON ADDITION, INCREMENT HIGH PART OF HIGH
1476 MOVE B,C ;NO LONGER NEED HIGH OF LOW, GET LOW OF LOW IN B
1477 NUMSL3: JUMPE AA,NUMSL4 ;NOW CHECK FOR OVERFLOW INTO HIGH OF HIGH, JUMP ON NONE
1478 ASHC A,-1 ;NEXT THREE INSTRUCTIONS TO DO ASH3 AA,-1
1481 AOJA TT,NUMSL3 ;INCREMENT BIT EXPONENT AND TRY AGAIN
1483 NUMSL4: MOVE AA,A ;FLUSHED OVERFLOW, NOW GET (LOW PART OF) HIGH PART IN AA
1484 SOJG T,NUMSL5 ;COUNT DOWN
1486 NUMSL2: TLNN I,ILFLO
1487 JRST NUMSL9 ;NOT FLOATING, DON'T WASTE TIME NORMALIZING.
1488 SKIPA A,B ;EXPONENT NOW ZERO, GET LOW PART OF NUMBER IN A
1489 NUMSL7: ASHC AA,1 ;NOW NORMALIZE
1492 SKIPA B,TT ;DONE NORMALIZING, RETURN BINARY EXPONENT IN B
1498 ASHC AA,(TT) ;SHIFT 2-WD NUM. BY EXPONENT,
1499 LSH A,1 ;PUT HIGH BIT IN WITH REST.
1506 ETR [ASCIZ /FIXNUM too big for 36 bits/]
1509 NUMSL1: SKIPA A,B ;EXPONENT NEGATIVE: NORMALIZE NOW
1511 NUMSL6: TLNN AA,200000
1512 SOJA TT,NUMSL8 ;NOT NORMALIZED YET
1515 TLNN TM,-1 ;GET CONVIENT POWER OF RADIX
1516 JUMPL T,[ IMULI TM,(D)
1518 MOVE B,A ;GET NORMALIZED LOW PART IN B
1519 IDIV AA,TM ;DIVIDE HIGH PART BY APPROPRIATE RADIX
1526 JRST UPCTRC ;"UNARY UPARROW" => GOBBLE CHARS
1528 ETR [ASCIZ /Symbolic 1st arg to "^"/]
1529 PUSHJ P,NUMSL ;DECIPHER NUMTABS
1530 PUSHJ P,UA3 ;GET RIGHT OPERAND IN T
1533 PUSHJ P,NUMC1 ;T EXP HIGH IN AA LOW IN B TT BIN EXP
1534 MOVE C,CDISP ;IF A _ WAS DEFERRED WHILE ILUARI WAS SET,
1536 CAME C,[DSYL,,BAKAR] ;DO IT NOW.
1539 BAKAR: TLNE I,ILUARI
1540 JRST RR5 ;RETURN TO UPARROW (WILL COME BACK HERE LATER)
1543 JRST BAK1 ;NO SYL, OR SYL IS NAME
1544 CAMN SYM,[SQUOZE 0,.]
1545 JRST BAK1 ;. ALSO NAME
1555 MOVE C,[DFLD,,CBAKAR]
1556 EXCH C,CDISP ;IF 2ND ARG ENDED WITH A _, TURN INTO FIELD OP.
1557 CAME C,[DSYL,,BAKAR]
1562 UPCTR1: JSP F,QOTCOM ;UP ARROW TO GOBBLE SYL AND RETURN MASKED ASCII VALUE
1563 LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7
1564 ANDI A,77 ;NOW MASK CHARACTER IN TO TO BOTTOM 6 BITS
1565 ADD T,A ;ADD TO ACCUMULATED
1568 BAK1: MOVE TT,[DFLD,,CBAKAR]
1572 UA3: HRLM D,(P) ;SAVE RADIX (FOR UPARR)
1573 JSP LINK,SGTSY ;PUSH I,AA,A,B
1574 TLO I,ILUARI ;TELL _ TO WAIT TILL LATER (SEE UPARR, BAKARR)
1583 UA3L: PUSHJ P,GTSL1 ;GOBBLE SYL, LOOP POINT FOR PSEUDO OR MACRO RETURNED WITHOUT VALUE
1587 ETR [ASCIZ /Floating point 2nd arg to "_"/]
1591 JSP LINK,SGTSY1 ;RESTORE GETSYL TEMPS.
1595 UA3S: PUSHJ P,GETVAL ;MAKE NUMBER_NAME WORK
1596 JRST UA3SR ;GOT VALUE, PROCESS
1597 JRST UA3L ;NO VALUE, TRY AGAIN
1600 TRZ I,IRSYL ;(OR ELSE LSSTH GIVES NOS ERROR.)
1603 UA3SR: JUMPN B,RLCERR ;RELOC ERR
1606 ATSGN: MOVSI A,20 ;ATSIGN
1608 TRO I,IRFLD ;SET IRFLD FLAG EVEN THOUGH NOT DIRECTLY RETURNING VALUE
1609 ; ^ CHANGED FROM SYL TO FIELD 9/6/70
1610 JRST RRL2 ;FALL BACK IN
1612 DQUOTE: TRON I,IRSYL
1614 TRNN I,IRLET ;AFTER NUMBER => CURRENT RADIX.
1617 TLO FF,FLUNRD ;NEXT CHAR. SQUOZE?
1620 JRST DQUOT7 ;NO => MAKE PREV. SYM. GLOBAL.
1621 CAMN SYM,[SQUOZE 0,.M] ;SPECIAL BLOCK NAMES
1622 JRST DQUOTM ;.M MEANS MAIN BLOCK,
1623 CAMN SYM,[SQUOZE 0,.U]
1624 JRST DQUOTU ;.U MEANS SUPERIOR.
1625 CAMN SYM,[SQUOZE 0,.C]
1626 JRST DQUOTC ;.C MEANS CURRENT BLOCK.
1627 SKIPGE A,ESBK ;GET SPEC'D BLOCK OR CURRENT,
1628 HRR A,BKCUR ;LOOK FOR SUBBLOCK OF THAT BLOCK.
1630 ADD A,[1,,] ;LH HAS LEVEL SUBBLOCK OUGHT TO HAVE.
1632 SETO D, ;NO POSSIBLE ALTERNATE CHOICE YET.
1633 DQUOT0: CAME SYM,BKTAB(T) ;LOOK AT ALL BLOCKS SEEN.
1634 JRST DQUOT1 ;HAS THE NAME WE'RE LOOKING FOR?
1635 SKIPGE ESBK ;IF LOOKING FOR A SUBBLOCK OF A PARTICULAR BLOCK,
1638 JRST DQUOT2 ;SUCH A BLOCK WINS; ALL OTHERS LOSE.
1641 DQUOT4: SKIPN BKTAB+2(T) ;ELSE PREFER DEFINED BLOCKS TO UNDEFINED ONES.
1645 CAME D,[-1] ;THAT'S THE SAME EITHER WAY => PREFER AN INFERIOR
1646 CAMN A,BKTAB+1(T) ;OF THE CURRENT BLOCK TO ONE THAT'S NOT.
1650 DQUOT5: HRROI D,(T) ;FOUND A BLOCK WE LIKE BEST SO FAR.
1652 ANDI D,-1 ;LEAVE SIGN OF D SET UNLESS THE BLOCK IS DEFINED.
1653 DQUOT1: ADDI T,BKWPB
1656 HRRZI T,(D) ;NOW USE THE BEST BLOCK FOUND, IF THERE WAS ONE.
1659 MOVE T,BKTABP ;NOT FOUND, GET IDX OF 1ST UNUSED ENTRY.
1661 ETF ERRTMB ;NO ROOM FOR MORE BLOCKS.
1663 MOVEM A,BKTAB+1(T) ;ADD BLOCK AT END.
1665 MOVEM A,BKTABP ;POINTS AFTER LAST USED ENTRY.
1666 DQUOT2: MOVEM T,ESBK
1668 DQUOT3: MOVEI D,6 ;NEXT CHAR GOES IN 1ST SQUOZE POS.
1671 DQUOTM: MOVEI T,BKWPB ;.M - MAIN BLOCK FOLLOWS INITIAL SYMS BLOCK.
1674 DQUOTU: SKIPGE T,ESBK ;.U SPEC'D - GET SPEC'D OR CURRENT BLOCK,
1677 JRST DQUOT2 ;SPEC. ITS SUPERIOR.
1679 DQUOTC: SKIPGE T,ESBK ;.C => SPEC THE CURRENT BLOCK.
1683 SQUOT1: TLOA I,ILVAR
1685 MOVE A,BKCUR ;IF NO SPEC'D BLOCK,
1687 MOVEM A,ESBK ;SPEC. CURRENT BLOCK.
1691 DQUOT9: JSP F,QOTCON ;DOUBLE QUOTE TO GOBBLE SYL AND RETURN ASCII VALUE
1692 LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7
1693 ADD T,A ;ADD IN ASCII CHARACTER IN A
1694 POPJ P, ;RETURN TO SOMETHING
1696 SQUOTE: TROE I,IRSYL
1699 SQUOT9: JSP F,QOTCON ;SIXBIT SYL
1701 ETR ERRN6B ;NOT SIXBIT
1703 SUBI A,40 ;CONVERT TO UPPER CASE
1704 LSH T,6 ;SHIFT OVER ACCUMULATED VALUE
1705 ADDI T,-40(A) ;ADD IN SIXBIT FOR CHARACTER IN A
1708 ;COMMON ROUTINE FOR RIGHT JUSTIFIED TEXT SYLS
1709 ;CALLED WITH JSP F,; ROUTINE PUSHJ'S BACK W/ CHAR IN T, ACCUM VALUE IN A
1710 ;SYL FLAG EXPECTED TO BE ALREADY SET
1711 QOTCON: SKIPE QMTCH ;' AND " COME HERE, BUT NOT ^: IF IN QUOTES-MATCHING MODE, USE A
1712 JRST QOTCO4 ;FAIL-LIKE ALGORITHM. HERE FOLLOWS THE OLD MIDAS WAY OF DOING IT
1713 QOTCOM: CALL RCH ;USE AT LEAST 1 CHAR IN ANY CASE.
1716 QOTCO2: CALL RCH ;USE SUCCEEDING CHARS IF SQUOZE CHARS.
1723 QOTCO3: CAIN A,"" ;NONSQUOZE: IF IT IS A TEXT SYL INDICATOR,
1724 JRST DQUOT9 ;CONTINUE WITH WHATEVER TYPE OF TEXT
1726 JRST SQUOT9 ;IT INDICATES.
1729 QOTCO6: TLO FF,FLUNRD
1732 QOTCO4: MOVE B,LIMBO1 ;GET ' OR ", WHICHEVER STARTED THIS SYL, AS THE DELIMITER.
1733 MOVE SYM,[SQUOZE 0,TEXT]
1736 CAMN A,B ;FOUND ANOTHER EXAMPLE OF THE DELIMITER?
1737 JRST [ CALL RCH ;IF DUPLICATED, IT PUTS THE DELIMITER IN THE CONSTANT.
1740 JRST QOTCO6] ;OTHERWISE UNREAD THE CHAR AFTER THE DELIMITER AND EXIT.
1741 CALL (F) ;HAVE CHAR TO PUT IN STRING IN A; GO MERGE IT IN.
1744 ;RETURN A VALUE FROM A PSEUDO WHOSE ARGS CAN BE TERMINATED BY EITHER COMMA (GOBBLED)
1745 ;OR CR (NOT GOBBLED).
1746 VALRET: MOVE T,A ;ROUTINE TO RETURN VALUE IN A AFTER LAST CHAR GOBBLED BY GETSYL
1747 MOVE B,CDISP ;GET STORED DISPATCH CODE
1749 JRST VALR1 ;WORD TERMINATOR
1750 ;COME HERE TO RETURN A VALUE, AND ALSO
1751 ;BARF IF THE NEXT CHARACTER ISN'T A SYLLABLE SEPARATOR
1752 TEXT5: PUSH P,T ;ENTRY FROM TEXT ROUTINES (NLAST CHAR NOT GOBBLED BY GETSYL) TO RETURN VALUE IN T
1753 PUSHJ P,GETSYL ;SEE IF IMMEDIATELY FOLLOWED BY SYL
1755 ETR ERRNOS ;NO SEPARATOR BETWEEN TWO VALUES
1756 POP P,A ;RESTORE VALUE TO RETURN
1760 ;VARIOUS PUSH AND POP ROUTINES, ALL CALLED W/ JSP LINK,
1774 ;JSP LINK,SAVWD1 TO SAVE STUFF FOR < OR (, ETC.
1776 SAVWD1: PUSH P,A ;SYLL. BEFORE GROUPING NOW STARTING.
1777 PUSH P,B ;AND ITS RELOC.
1779 SAVWLD: PUSH P,FORMAT
1791 ;POP OFF WHAT PUSHED BY SAVWLD. CLEARS FLUNRD, IN CASE THE > OR ) WAS UN-READ.
1811 ;;GETFD ;GET FIELD (EXPRESSION); RETURN VALUE IN A, RELOC BITS IN B
1813 ;GET FIELD FOR PSEUDO
1814 ;SYM SHOULD CONTAIN THE SQUOZE NAME OF THE PSEUDO
1815 ;OR A POINTER TO AN INSN TO EXECUTE WHEN UNDEF
1816 ;SYMBOL SEEN. SYM IS NOT CLOBBERED.
1818 AGETFD: PUSH P,I ;SAVE I
1819 TRO I,IRPSUD+IRNOEQ ;SET FLAG TO GETVAL TO EXECUTE GTVER ON UNDEFINED SYM ON EITHER PASS
1820 SAVE GTVER ;OLD VALUE OF GTVER
1821 MOVEM SYM,GTVER ;ERROR MSG SHOULD GIVE NAME OF PSEUDO.
1825 MOVEM I,ISAV ;SAVE FLAGS FOR FIELD GOTTEN
1829 ;READ A FIELD, NOT PART OF THE CURRENT WORD.
1834 PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD
1835 ADD A,WRD ;ADD IN INDEX, INDIRECT FIELDS
1840 FAGTFD: PUSHJ P,AGETFD ;DO AGETFD, COMPLAIN IF RELOCATABLE OR GLOBAL
1844 ETSM [ASCIZ /relocatable or external argument/]
1847 ;READ A FIELD PART OF CURRENT WORD (FOR XWD, ETC).
1849 AGTFD3: PUSHJ P,GETFLD
1852 TLOA FF,FLUNRD ;DELIMITER IS WORD TERMINATOR => RE-READ IT.
1853 TRNE I,IRFLD ;NON-NULL FIELD SUPPLIED => RETURN IT.
1855 HRRZ C,CDISP ;ELSE COMMA => RETURN NULL VALUE (0)
1856 CAIN C,SPACE ;SPACE => TRY AGAIN TO READ A FIELD.
1857 JRST AGTFD3 ;NO FIELD, TRY AGAIN
1861 ;IN RELOCATABLE FORMAT
1862 ;READ FIELD AND COPY OUT AS WORD
1864 RGETFD: SETZM WRD ;FIRST INITIALIZE SOME STUFF AS THOUGH AT GETWD
1872 PUSHJ P,PWRDA ;OUTPUT WORD
1874 JRST IGTXT ;SOAK UP MULTI-WORD FIELD
1877 ;READ IN A FIELD, RETURN IN A,B SETTING IRFLD IF FIELD NOT NULL.
1878 GETFLD: SAVE GLSP1 ;REFERED TO AS GETFLB(P) WHEN ONLY 1 SYL PUSHED.
1881 GETFD1: TLNE I,ILMWRD
1882 JRST GETFD9 ;MULTIPLE WORD, RE-CALL PSEUDO
1885 GETFD9: PUSHJ P,GETVAL ;GET OPERAND (MAYBE SKIPS)
1886 GETFD6: SKIPA C,CDISP ;GET INFO ON SYLLABLE TERMINATOR
1887 JRST GETFD1 ;GETVAL SKIPPED => PSEUDO/MACRO WITH NO VALUE, TRY AGAIN
1889 JRST (C) ;FIELD OPERATOR, GO PROCESS
1890 TRNE I,IRSYL ;NO DISP MEANS FIELD TERMINATOR.
1892 CAME P,PPRIME ;IF ANY OPERATORS PUSHED,
1893 JSP LINK,GETFD8 ;EVAL THEM.
1894 SUB P,[1,,1] ;FLUSH GLSP1 SAVED AT GETFLD.
1897 GETFD8: MOVEI TT, ;END OF FIELD HAS VERY LOW PRIORITY.
1900 ;PUSH AN OPERATOR, MAYBE EVALLING STUFF TO LEFT.
1901 ;A HAS LEFT OPERAND (IF ANY), B RELOCATION BITS,
1902 ;C ADR OF ROUTINE TO PERFORM OPERATION, LH OF TT HAS PRECEDANCE OF OPERATOR
1904 GETFDL: MOVEI LINK,GETFD3 ;AFTER MAYBE EVALLING, GO PUSH OPERATOR.
1907 JRST GETFD5 ;UNARY, EVAL NOTHING, JUST PUSH WITH HIGH PRIO.
1908 GETFD2: CAME P,PPRIME ;NO OPS TO LEFT => NOTHING TO EVAL.
1909 CAMLE TT,GETFLP(P) ;COMPARE PRIO OF PREV. OP. AND CURRENT.
1910 JRST (LINK) ;WAIT UNTIL LATER
1911 GETFD7: HRRZ T,GETFLP(P) ;EVAL THE LAST OP ON STACK.
1912 JRST (T) ;GO DO IT NOW (ROUTINE RETURNS TO GETFD4)
1913 GETFD4: SUB P,[4,,4]
1916 GETFD5: MOVSI TT,200 ;GIVE UNARY OP HIGH PRIO. TO DO BEFORE NEXT BINARY.
1917 GETFD3: PUSH P,B ;GETFLR(P)
1921 PUSH P,GLSP1 ;GETFLG(P)
1924 GETFLB==,-4 ;PDL IDX OF GLSP1 BEFORE LEFT OPERAND.
1925 GETFLR==,-3 ;PDL IDX OF RELOC OF LEFT OPERAND.
1926 GETFLV==,-2 ;PDL IDX OF VALUE OF LEFT OPERAND.
1927 GETFLP==,-1 ;PDL IDX OF PRIO,,DISPATCH
1928 GETFLG==0 ;PDL IDX OF GLSP1 AFTER LEFT OPERAND (=BEFORE RIGHT)
1930 PLS: MOVEI C,PLS1 ;PLUS SIGN, PLS1 IS ROUTINE TO PERFORM OPERATION
1931 MINUS2: MOVSI TT,10 ;SET UP PRECEDENCE OF 10 FOR +, -
1934 MINUS: JSP C,MINUS2 ;MINUS SIGN
1935 MOVNS A ;NEGATE VALUE OF RIGHT OPERAND
1936 MOVNS B ;ALSO RELOCATION
1942 PUSHJ P,LNKTZ ;COMPLEMENT THE MINUS FLAG ON GLOBALS IN RIGHT OPERAND
1945 PLS1: ADD A,GETFLV(P) ;ADD VALUES
1946 ADD B,GETFLR(P) ;ADD RELOCATIONS
1950 LNKTC1: MOVE T,GLSP2
1951 LINKTC: CAML T,GLSP1
1959 MULTP: MOVEI C,MULTP1 ;ASTERISK, MULTP1 ROUTINE TO PERFORM MULTIPLICATION
1960 DIVID2: MOVSI TT,20 ;20 PRECEDENCE OF MULTIPLICATION, DIVISION
1963 MULTP1: JUMPGE FF,MULTR ;ON P1, DON'T CHECK THIS, SINCE UNDEF SYMS ARE EXTERNALS
1964 SKIPL CONTRL ;ELSE IN DECREL ASSEMBLY, TEST FOR EXTERNALS.
1966 MOVE D,GETFLB(P) ;ACTUALLY, GET HERE FOR ABS ASSEMBLIES TOO, BUT SO WHAT?
1968 ETR [ASCIZ /Externals multiplied/]
1969 MULTR: JUMPE B,MULTP3 ;JUMP ON RIGHT OPERAND NOT RELOCATED
1971 JRST MULTP4 ;BOTH OPERANDS RELOCATED
1972 MOVE T,GETFLV(P) ;GET VALUE OF LEFT OPERAND AND FALL IN
1975 MULTP3: MOVE T,A ;RIGHT OPERAND NOT RELOCATED, GET VALUE IN T
1976 MOVE B,GETFLR(P) ;RELOCATION BITS OF LEFT OPERAND
1977 MULTP5: MOVE D,GETFLG(P) ;GLOTB POINTER TO BETWEEN OPERANDS
1979 JRST GMUL1 ;LEFT OPERAND HAS GLOBALS
1981 JRST GMUL2 ;RIGHT OPERAND HAS GLOBALS
1982 ;AT THIS POINT, T HAS VALUE OF ABS OPERAND, B RELOC BITS OF OTHER
1983 GMUL4: IMUL A,GETFLV(P) ;MULTIPLY VALUES
1984 IMULB B,T ;MULTIPLY RELOCATION OF ONE BY VALUE OF OTHER
1986 SKIPL CONTRL ;EXCEPT IN STINK ASSEMBLY, OBJECT TO RELOCATION
1987 JRST GETFD4 ;OTHER THAN 0 OR 1 (ONLY AFFECTS DECREL, SINCE
1988 JUMPE T,GETFD4 ;RELOCATION CAN'T BE NONZERO IN ABS ASSEMBLY).
1989 MULTP4: ETR [ASCIZ+Relocatable arg to * or / or Boolean+]
1992 GMUL1: TLNE FF,FLPPSS ;LEFT OPERAND HAS GLOBALS, CHEK RIGHT OPERAND
1994 SKIPA CH1,A ;LOOKS OK, GET VALUE IN CH1
1995 ETR [ASCIZ /Multiplying two externals/]
1996 SKIPA D,GETFLB(P) ;GET GLOTB POINTER TO BOTTOM OF LEFT OPERAND
1997 GMUL2: MOVE CH1,GETFLV(P) ;GLOBALS IN RIGHT OPERAND ONLY, GET LEFT OPERAND
1999 JRST GMUL4 ;TABLE COUNTED OUT
2002 JUMPE CH1,GMUL5 ;MULTIPLYING BY ZERO, CLEAR OUT GLOTB ENTRY AND LOOP BACK
2003 LDB CH2,[221200,,1(D)] ;PICK UP MULTIPLICATION FIELD THIS GLOBAL
2008 MOVEI CH2,0 ;IF ONE THEN USE ZERO
2009 DPB CH2,[221200,,1(D)]
2016 DIVID: JSP C,DIVID2 ;SLASH, PRECEDENCE = 20
2017 DIVID1: JUMPN B,MULTP4 ;JUMP IF RIGHT OPERAND RELOCATED
2019 JRST MULTP4 ;LEFT OPERAND RELOCATED
2026 ETR [ASCIZ /Division involving externals/]
2029 ;LOGIC OPERATORS & (PREC = 40), # (PREC = 34), \ (PREC = 30)
2031 ANDF: MOVSI TT,40 ;&
2033 JSP D,LOGIC1 ;GO DO IT
2034 AND A,GETFLV(P) ;INSTRUCTION ARGUMENT TO LOGIC1
2036 XORF: MOVSI TT,34 ;#
2037 TRNN I,IRSYL ;IF ABOUT TO BE UNARY,
2038 MOVNI A,1 ;THEN TURN LEFT OPERAND INTO -1
2043 IORF: MOVSI TT,30 ;\
2048 ;COMMON EXECUTION ROUTINE FOR LOGICAL OPERATORS
2050 LOGIC1: JUMPN B,MULTP4 ;NO RELOCATION ALLOWED
2051 SKIPE GETFLR(P) ;NOW CHECK RELOCATION OF LEFT OPERAND
2053 XCT (D) ;ALL TESTS PASSED, DO IT
2054 JUMPGE FF,GETFD4 ;DON'T CHECK FOR GLOBALS EXCEPT DURING PUNCHING PASS
2055 MOVE D,GETFLB(P) ;PICK UP POINTER TO LEFT OPERAND GLOTB ENTRIES
2057 ETR [ASCIZ /External in arg to \, & or #/]
2060 CBAKAR: MOVSI TT,100 ;BACKARROW AS FIELD OPERATOR, PREC = 100
2061 JSP C,GETFDL ;RETURN TO GETFLD TO READ 2ND ARGUMENT.
2062 JSP D,LOGIC1 ;FOR EVALUATION, CALL LOGIC1
2063 JSP D,.+1 ;WHICH EXECUTES THIS INSTRUCTION,
2064 MOVE T,A ;TO CALL THIS SUBROUTINE.
2069 ;D SHOULD HAVE 1 FOR <, 2 FOR (, 3 FOR [ ;]
2070 LSSTH9: JSP LINK,SAVAS1 ;SAVE ASSEM1 PDL LEVELS, .BYTE MODE, ETC.
2071 MOVEM D,ASMOUT ;SAY WHAT KIND OF OPEN WE JUST DID
2072 JRST ASSEM3 ;REENTER ASSEM1 LOOP AT INNER LEVEL.
2074 ;COME HERE TO EXIT FROM AN ASSEM1 LEVEL THAT WAS ENTERED BY LSSTH9.
2075 LSSTHA: SKIPE BYTM ;IN BYTE MODE, DO .WALGN. SINCE ASMDSP
2076 JRST A.BY3 ;STILL POINTS HERE, WE'LL COME BACK.
2078 JSP T,CONNDP ;POP STUFF SAVED BY SAVAS1
2079 MOVE A,WRD ;RETURN THE WORD IN THE GROUPING
2080 MOVE B,WRDRLC ;(OUR CALLER WILL USVWLD, CLOBBERING WRD)
2083 LSSTH: MOVEI D,1 ;1 FOR <.
2086 LSSTH3: JSP LINK,USVWLD ;POP OFF ALL BUTPREVIOUS SYLL.
2088 ;GROUPINGS EXCEPT (PARENS THAT ADD TO WORD)
2089 ;SYLL IMMEDIATELY BEFORE OR AFTER IS ERROR.
2090 LSSTH2: ADDM A,-1(P) ;SYLL BEFORE GROUPING, PUSHED BY SAVWD1.
2092 TRNE I,IRSYL ;IF WAS SYLL BEFORE GROUPING, ERROR.
2094 LSSTH5: MOVE A,LIMBO1 ;CHECK FOR FOLLOWING SYLL.
2097 JRST LSSTH6 ;DELIMITER CR OR LF
2098 PUSHJ P,RCH ;NOT CR OR LF, GET NEXT CHAR
2099 CAIN A,"! ;IGNORE EXCLAMATION POINT
2101 TLO FF,FLUNRD ;CAUSE IT TO BE RE-INPUT
2104 JRST LSSTH4 ;SQUOZE CHAR. MEANS FOLLOWING SYLL.
2106 MOVE CH1,DTB-40(CH1) ;GET DISPATCH FOR CHAR.
2107 TLNE CH1,DSY1 ;MIGHT START SYL => NOS ERROR.
2109 LSSTH7: PUSHJ P,GTSL1
2112 POP P,A ;VALUE OF GROUPING WAS ADDM'ED INTO THESE.
2113 TLZE I,ILLSRT ?.SEE UA3
2114 RET ;IF CALLED BY ^ OR _ AS SYL OP, RETURN TO IT.
2117 LSSTH1: TLO I,ILWORD ;A NUMBER IN PARENS BY ITSELF IS A NONNULL WORD.
2120 TRNE I,IRSYL ;IF SYLL BEFORE,
2121 JRST LSSTH5 ;ERROR IF SYL AFTER.
2122 JRST LSSTH8 ;ELSE NO ERROR.
2124 LSSTH4: ETR ERRNOS ;FOLLOWING SYLL WHEN THAT IS ERROR.
2125 LSSTH8: TLNE I,ILLSRT ?.SEE UA3
2130 ERRNOS: ASCIZ /Syllables not separated/
2135 LEFTP: MOVEI D,2 ;2 FOR ).
2140 TLO C,400000 ;CAUSE IT TO GET ADDED INTO WORD STEAD HAVE VALUE AS SYL
2144 MOVSM A,T1 ;STORE SWAPPED VALUE
2145 ADDI B,400000 ;NOW WANT TO SWAP RELOCATION, MAKE LH CORRECT
2146 HLREM B,T2 ;STORE AS RH WITH SIGN EXTENDED
2147 MOVSI B,400000(B) ;GET RIGHT HALF IN LEFT
2148 ADDM B,T2 ;FINISH RELOCATION SWAP (THIS IS PAINLESS COMPARED TO THE HAIR EVERYWHERE
2149 ;ELSE WHEN KEEPING THE HALFWORDS SEPARATE)
2155 JUMPL C,LSSTH1 ;ADD TO WHOLE WORD
2158 ;VERSION OF GETWRD FOR PSEUDO,
2159 ;PSEUDO MUST EITHER SAVE I, PPRIME AND GTVER OR RETURN TO ASSEM1.
2160 ;SYM SHOULD HOLD NAME OF PSUEUDO.
2162 AGETWD: MOVEM SYM,GTVER ;STORE NAME OF PSEUDO FOR UNDEF SYM MSGS.
2163 TRO I,IRPSUD\IRDEF\IRNOEQ
2165 MOVE SYM,GTVER ;RESTORE SYM.
2167 PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD
2170 ;;GETWD ;READ A WORD, LEAVE VALUE IN A AND WRD, RELOC IN WRDRLC AND B
2172 GETWRD: MOVE T,GLSP1
2174 CLEARM FORMAT ;CLEAR FORMAT, WILL ACCUMULATE FORMAT NUMBER BY IDPB
2175 CLEARM WRD ;CLEAR WRD, WILL ACCUMULATE ABSOLUTE PART OF WORD
2176 CLEARM WRDRLC ; " RELOCATION BITS, "
2177 TDZ I,[ILWORD,,IRIOINS]
2178 CLEARM FLDCNT ;NO FIELDS YET
2179 MOVE T,[50100,,FORMAT] ;SET UP BIT POINTER TO FORMAT
2181 GTWD1: PUSHJ P,GETFLD ;READ NEXT FIELD
2182 SPACE6: MOVEI T,1 ;SET T TO 1, AC FOR IDPB ON ROUTINE DISPATCHED TO
2186 JRST (C) ;NO DISPATCH MEANS WD TERMINATOR
2188 MOVEM C,LINKL ;MARK END OF ACTIVE PART OF GLOTB
2190 JRST GETWD2 ;LAST FIELD NULL, MAYBE HAVE TO POP STUFF OFF
2191 IDPB T,FORPNR ;MARK NON-NULL FIELD IN FORMAT
2192 GTWD4A: TLO I,ILWORD ;NON-NULL WORD
2194 SKIPN TT,FORTAB-10(TT) ;PICK UP BYTE POINTER POSITION/SIZE FIELDS FOR FIELDS IN WORD
2195 ETR [ASCIZ /Undefined format/]
2196 MOVEM TT,FORMAT ;STORE IN FORMAT
2197 MOVE T,[301400,,FORMAT]
2199 ;AT THIS POINT, FLDCNT HAS 1 LESS THAN # FIELDS; PUT FIELDS TOGETHER TO FORM WORD
2203 IBP FORPNR ;HAVEN'T BACKED UP TO THIRD FIELD YET, INCREMENT TO DESC FOR PREV
2206 PUSHJ P,INTFLD ;PUT FIELD WHERE IT BELONGS
2208 JRST GTWD5 ;THIS WAS LAST (FIRST) FIELD
2209 POP P,GLSP2 ;NOT YET, POP OFF MORE
2222 COMMA: TRNN I,IRFLD ;FIELD DELIMITER WAS COMMA (T HAS 1)
2223 JRST COMMA1 ;NO FIELD
2224 IDPB T,FORPNR ;MARK NON-NULL FIELD
2225 COMMA4: IDPB T,FORPNR ;MARK FIELD TERMINATOR WAS COMMA
2228 ETR [ASCIZ /Comma past the 3rd field of a word/]
2229 PUSHFD: PUSH P,A ;DONE WITH THIS FIELD, NOW TO GET NEXT
2233 AOS FLDCNT ;ANOTHER FIELD
2238 HRRZS FORPNR ;STABILIZE FORPNR
2239 TLO I,ILWORD ;SAY WE HAVE A NON-NULL WORD IN PROGRESS (LOC, ETC. ILLEGAL).
2242 GETWD2: SKIPN FORMAT ;LAST FIELD OF WORD IS NULL
2243 JRST GTWD5 ;ENTIRE WORD NULL, MAYBE WERE PARENS.
2251 COMMA1: LDB TT,FORPNR ;COMMA TERMINATED NULL FOELD.
2253 JUMPE TT,COMMA2 ;NOT 1ST FIELD, JMP IF PREV WAS TERM BY SPACE.
2254 IBP FORPNR ;ELSE MARK NULL FIELD IN FORMAT.
2257 ;FIELD SPACE COMMA, PATHOLOGICAL CASE
2258 ;(EG MACRO STARTED WITH A COMMA)
2259 COMMA2: DPB T,FORPNR ;REPLACE SPACE WITH COMMA.
2262 ;FIELD TERMINATOR IS SPACE (T HAS 1)
2264 SPACE: MOVE TT,LIMBO1
2265 CAIE TT,^I ;HEURISTIC: REAL SPACES ARE LIKELY TO BE FOLLOWED BY SQUOZE,
2266 JRST SPACE4 ;WHILE TABS ARE LIKELY TO BE FOLLOWED BY COMMENTS.
2271 JRST .-2 ;FLUSH OTHER LOGICAL SPACES
2272 CAIN A,"; ;TAB WAS FOLLOWED BY SEMICOLON:
2275 CALL SEMIC ;FLUSH THE COMMENT
2278 JRST SPACE5] ;AND HANDLE THE C.R.
2280 TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-READ NEXT TIME
2281 SPACE4: TRNN I,IRFLD
2282 JRST GTWD1 ;NO FIELD
2283 IDPB T,FORPNR ;T HAS 1, MARK NON-NULL FIELD IN FORMAT
2284 IBP FORPNR ;MARK FIELD TERMINATOR WAS SPACE
2287 ;T HAS DESC BYTE, PUT FIELD IN ITS PLACE
2288 ;ALSO CALLED FROM PBYTE, MUSTN'T CLOBBER AA.
2290 INTFLD: MOVE TT,GLSP2
2292 JUMPE B,INTFD1 ;NO GLOBALS, JUMP IF NO RELOCATION
2297 CAIN T,44 ;WHOLE WORD
2300 ETR [ASCIZ/Relocation attempted in irrelocatable field/]
2301 ;(ASSUME) NO RELOCATION, CHECK FOR GLOBAL AC FIELDS
2302 CAIN T,2704 ;HIGH AC
2306 JUMPGE FF,INTFD1 ;JUMP ON NOT PUNCHING PASS
2308 ETR [ASCIZ/Global symbol in illegal field/]
2309 INTFD1: MOVEI TT,C_12.
2310 ROTC T,-12. ;SHIFT BYTE POINTER INTO TT
2311 MOVEI C,0 ;INITIALIZE C TO RECEIVE FIELD IN PROPER PLACE
2314 JRST INTFD2 ;RIGHT HALF, DON'T ALLOW CARRY INTO LH
2315 ADDM C,WRD ;ALLOW CARRY
2316 INTFD3: ADDM B,WRDRLC ;ADD RELOCATIONS, WILL BE BROKEN BACK INTO HALF-WORDS LATER
2319 INTFD2: ADD C,WRD ;ADD RIGHT HALVES
2325 TRZA A,3 ;IO DEVICE FIELD
2326 POPJ P, ;NOT "AC" FIELD
2334 PUSHJ P,LNKTC1 ;THIS IS A BUG WHICH SHOULD BE FIXED SOMETIME
2335 PRTCL: MOVE B,D ;GET BACK MAPPED RELOCATION BITS
2337 INTW: MOVE D,GLSP2 ;WHOLE WORD
2352 AOJA T,INTL2 ;INDEX FIELD, ETC => LEAVE ALONE
2353 IORM C,1(T) ;SET HFWDF
2354 XORM B,1(T) ;COMPLEMENT SWAP STATUS
2356 SETZM 1(T) ;SWAPPED TO RH, FLUSH IT
2359 INTACL: TDZA B,B ;AC LOW
2360 INTACH: HRLZI B,SWAPF ;AC HIGH
2367 IOINST: HLLZ A,B ;IO INSTRUCTION, GET WHICH ONE INTO A
2368 SKIPN FLDCNT ;THIS FIRST FIELD OF WORD?
2370 JRST CLBPOP ;RETURN VALUE
2372 ;TOP LEVEL LOOP, ASSEMBLE STORAGE WORDS
2373 ;LOTS OF PSEUDOS MEANINGLESS IN STORAGE WORDS
2374 ;(E.G. BLOCK, CONSTA) DO JRST ASSEM1 WHEN DONE
2375 ;THERE'S ALSO AN ERROR UUO WHICH RETURNS TO ASSEM1
2377 ASSEM1: MOVE P,ASSEMP
2380 ;COME HERE TO START THE NEXT EXPRESSION OR WHATEVER.
2383 JRST ASSEM2 ;PROBABLY NOT PROFITABLE TO SKIP AFTER SEE A TAB.
2385 JRST ASSEM3 ;FLUSH LEADING GARBAGE
2386 TLO FF,FLUNRD ;CAUSE NON-GARBAGE CHAR FOUND TO BE RE-INPUT
2387 ;ASMDSP POINTS HERE WITHIN ASCII, SIXBIT ETC.
2388 ASSEM2: TRZ I,IRFLD+IRSYL+IRLET+IRPSUD+IRCOM+IRCONT+IRGMNS+IROP+IRNOEQ+IREQL
2389 TLZ I,ILGLI+ILVAR+ILFLO+ILDECP+ILUARI+ILWORD+ILNPRC
2390 IOR I,ASMI ;SET DEF AND RESTORE PSEUDF.
2394 ;GETWRD WILL COPY GLSP1 INTO GLSP2
2395 IFN TS,[AOSN TTYBRF ;DO A ^H-BREAK IF REQUESTED.
2399 JRST @ASMDSP ;NO WORD ASSEMBLED,TRY AGAIN
2401 JRST PBYTE ;IN BYTE MODE, OUTPUT BYTE INSTEAD OF WORD, A,B MUST HAVE WRD,WRDRLC.
2402 MOVE AA,ASMOUT ;OUTPUT WD AS APPRO. FOR GROUPING, IF ANY.
2405 ASSEM6: SKIPE STGSW ;ASMOT0 POINS HERE. COME IF NOT IN GROUPING.
2406 ETR ERRSWD ;STORAGE WORD ASSEMBLED
2407 PUSHJ P,PWRD ;OUTPUT THE WORD.
2409 HRRZS CLOC ;INCREM. POINT .
2410 JRST @ASMDSP ;ASSEM3 OR ASSEM2
2412 ERRSWD: ASCIZ /Storage word assembled/
2414 ASSEM4: JSP T,PCONST ;ASMOT0+3 POINTS HERE. COME IF IN CONSTANT.
2417 ;ASMDSP POINTS HERE WITHIN GROUPING IF NOT IN MULTI-LINE MODE
2418 ;[ ;AND NO CLOSE (">)]") HAS BEEN SEEN.
2419 ASSEMC: MOVE AA,ASMOUT
2420 SKIPE CONSML ;IN ERROR MODE, GIVE APPROPRIATE ERROR MSG.
2422 JRST @ASMOT2(AA) ;CLOSE WHATEVER TYPE GRPING WE'RE IN.
2424 ;JUMP THRU THIS TABLE TO OUTPUT A WORD.
2425 ASMOT0: ASSEM6? ASSEM1? ASSEM1? ASSEM4? [HALT ]
2427 ;THIS TABLE GIVES APPRO. CLOSE FOR EACH TYPE OF GROUPING. ;[
2428 ASMOT1: "? ? "> ? ") ? "] ? "?
2430 ;THIS TABLE SAYS WHERE TO GO TO END THE GROUPING.
2431 ASMOT2: [HALT ]? LSSTHA? LSSTHA? CONND? [HALT ]
2433 ;APPROPRIATE ERROR MESSAGE FOR MISSING CLOSE OF GROUPING. [
2435 ETR [ASCIZ /Missing >/]
2436 ETR [ASCIZ /Missing )/]
2437 ETR [ASCIZ /Missing ]/]
2440 ;THIS TABLE TELLS PBYTE HOW TO HANDLE BYTE MODE.
2441 ASMOT4: PBY4 ? PBY5 ? PBY5 ? PBY3 ? [HALT ]
2443 ;TABLE SAYING WHAT CHAR MUST HAVE OPENED THE GROUPING.
2444 ASMOT5: "? ? "< ? "( ? "[ ? "? ;]
2446 ;;GETVAL ;GET VALUE OF SYM
2447 ;SKIPS ON PSEUDO NOT RETURNING VALUE (E.G. MACRO STARTING TO BE EXPANDED)
2448 ;ELSE RETURNS VALUE IN A, RELOCATION BITS IN B
2451 GTVER: 0 ;SQUOZE NAME OF CALLING PSEUDO, OR POINTER
2452 ;TO INSN TO EXECUTE WHEN IF SYM IS UNDEF.
2457 IFN CREFSW,XCT CRFINU ;JFCL OR CALL TO CREF RTN.
2458 JRST @.+1(A) ;FOUND, DISPATCH ON SQUOZE FLAGS
2460 GVTAB: GVCOM ;COMMON (UNUSED)
2461 GVPSEU ;PSEUDO OR MACRO.
2462 GVSYM ;LOCAL SYMBOL.
2463 GVUL ;LOCAL UNDEF (MAYBE STINK KNOWS VALUE)
2464 GVDLV ;DEFINED LOCAL VAR.
2465 GVULV ;UNDEF LOC VAR.
2467 GVUGV ;UNDEF GLO VAR
2472 GVDLV: PUSHJ P,GVDLGV ;IF PASS2 AND HAS ' THIS TIME, SET 3VAS2 FOR AVARIAB
2475 MOVSI T,DEFGVR ;NOW DEF GLO VAR.
2477 JRST GVDG1 ;MAYBE OUTPUT GLOBAL DEF. TO STINK.
2479 GVDGV: PUSHJ P,GVDLGV ;DEF GLO VAR; IF PASS 2 AND ' THIS TIME, SET 3VAS2
2480 JRST GVDG2 ;MUSN'T PUNCH VALUE, AVARIAB WILL.
2482 GVDLGV: TRNE FF,FRPSS2 ;IF PASS 2
2483 TLNN I,ILVAR ;AND THIS TIME HAVE SINGLEQUOTE
2485 TLO C,3VAS2 ;TELL AVARIAB SEEN IN PASS 2 WITH '.
2489 GVULV: TLZN I,ILGLI ;UNDEF LOCAL VAR, MAYBE MAKE GLOBAL.
2491 PUSHJ P,PLOGLO ;IF SO, TELL STINK SYM IS GLOBAL,
2492 MOVSI T,UDEFGV ;SYM NOW UNDEF GLO VAR
2494 JRST GVUNDF ;IN EITHER CASE, HANDLE UNDEF SYM.
2496 GVUL: TLZE C,3MACOK ;UNDEF LOCAL, PRESUMED NUMERIC
2497 3PUT C,D ;DON'T LET IT BECOME MACRO AND SCREW PASS2.
2499 JRST GVGLTB ;(REALLY DEFINED BUT ONLY STINK KNOWS HOW)
2500 TLNE I,ILGLI ;IF MAKING GLOBAL, TELL STINK.
2502 GVNF1: TLZE I,ILVAR ;IF ', MAKE VAR (WILL CHECK ILGLI)
2504 TLZN I,ILGLI ;NOT MAKING VAR, MAYBE GLOBAL?
2505 JRST GVUNDF ;NO, MAYBE ERROR, MAKE GLOTB ENTRY.
2507 PUSHJ P,VSM2 ;NOW GLOBAL UNDEF,
2508 JRST GVGLTB ;NO ERROR, JUST GLOTB ENTRY.
2510 GVUL1: TLZN I,ILGLI ;UNDEF LOCAL BECOMES
2511 SKIPA T,[UDEFLV,,] ;UNDEF LOC VAR OR
2512 GVGVAR: MOVSI T,UDEFGV ;UNDEF GLO VAR.
2515 PUSHJ P,VSM2 ;MAKE IT A VAR,
2516 JRST GVUNDF ;PRETEND HAD ALREADY BEEN A VAR.
2518 GVUG: TLZE I,ILVAR ;UNDEF GLOBAL: MAYBE MAKE UNDEF GLO VAR.
2520 GVGLTB: SKIPGE CONTRL ;UNDEF GLO IN ABS ASSEM =>
2521 JRST GVUND1 ;MAYBE TREAT AS UNDEF.
2522 GVGLT1: AOS GLSP1 ;DON'T KNOW SYM'S VALUE, MAKE GLOTB ENTRY.
2525 JRST CABPOP ;RETURN 0 AS VALUE.
2528 IFN CREFSW,XCT CRFINU ;ONLY IF NOT FOUND WOULD NOT CREF AFTER ES.
2529 TLNE I,ILVAR+ILGLI ;MAKING VAR OR GLOBAL FORCED CURRENTBLOCK ALREADY
2530 JRST GVNF1 ;AND WILL STORE NAME IN STE ANYWAY.
2531 SKIPGE ESBK ;ELSE IF NO SPEC'D BLOCK,
2532 TRNN FF,FRNPSS ;FORCE .MAIN BLOCK SO DON'T GET LOTS OF UNDEF ENTRIES.
2533 CAIA ;BUT CAN'T DO THAT FOR 1PASS OR WOULD MISS FWD REFS.
2537 JRST GVUNDF ;MAYBE ERROR, MAKE GLOTB ENTRY.
2539 GVCOM: TRO I,IRCOM ;COMMON: SAY THIS WAS ONE.
2540 HRRZ A,B ;RETURN RH OF VALUE, ABSOLUTE.
2543 GVPSEU: TLNN I,ILVAR+ILGLI ;CAN'T MAKE PSEUD OR MACRO GLOBAL OR VAR.
2544 JRST (B) ;OTHERWISE, DISPATCH TO IT.
2549 JRST (B) ;DISPATCH TO PSEUDO (OR MACCL IF MACRO)
2550 ;EXPECTS LH OF VALUE IN LH OF B.
2552 ERRCBV: ASCIZ /Can't be a variable/
2553 ERRCBG: ASCIZ /Can't be global/
2555 GTVL7B: TLNE C,3RLL ;R(LH)
2564 MOVE A,B ;THIS CODE DOES WHAT GVSYM2 WOULD DO, BUT FASTER.
2568 GVSYM2: TLZE I,ILVAR ;LOCAL SYM: CAN'T MAKE VARIABLE.
2571 JRST GVSYM0 ;NOT MAKING GLOBAL, GET VALUE & RETURN.
2572 GVSYM1: MOVSI T,GLOETY ;BECOMES DEF. GLOBAL.
2574 JRST GVDG1 ;HANDLE AS IF WAS DEF GLOBAL.
2576 ERRMDV: ASCIZ /Multiply-defined variable/
2578 GVDG: TLZE I,ILVAR ;GLOBAL ENTRY
2580 ;COME HERE FOR DEF GLOBAL
2581 GVDG1: SKIPGE CONTRL
2582 JRST GVDLV2 ;DON'T PUNCH VALUE IF ABSOLUTE.
2584 JRST GVDG2 ;VALUE PUNCHED ALREADY, NOT AGAIN.
2593 GVDG2: TRNN I,IRPSUD\IREQL ;IF INSIDE AN ORDINARY STORAGE WORD,
2594 TLNN C,3REL ;GENERATE A GLOBAL REF IF GLOBAL IS RELOCATABLE (HEURISTIC).
2595 GVDLV2: TLNE C,3LLV ;IF VAL KNOWN ONLY BY STINK, MUST MAKE A GLOBAL REF.
2597 GVSYM0: MOVE A,B ;USED IN LBRAK
2598 LDB B,[.BP (3RLR),C]
2603 GVUND1: MOVE A,CONTRL
2604 TRNE A,DECREL+FASL ;DEC FMT OR FASL => UNDEF GLOBALS OK.
2607 GVUNDF: TRZ I,IRDEF ;UNDEFINED, MAYBE ERROR, MAKE GLOTB ENTRY.
2613 ETSM [ASCIZ/Undefined/]
2615 ETSM [ASCIZ/Undefined in literal/]
2618 GVUND2: HLRZ A,GTVER ;DOES GTVER POINT TO AN INSN?
2619 JUMPE A,[XCT @GTVER ? JRST CABPOP]
2620 ERJ .+1 ;NO, IT IS NAME OF PSEUDO.
2622 CAIGE A,75. ;CR-LF-TAB NOW IF WHOLE MSG WON'T FIT ON A LINE.
2624 TYPE2 SYM ;TYPE NAME OF UNDEF SYM.
2625 TYPR [ASCIZ/ Undefined in /]
2630 ;EVALUATE SYMBOL, SQUOZE (FLAGS OFF) IN SYM
2631 ;IDX OF BLOCK TO DEFINE IN IN ESBK (OR -1 => ANY BLOCK NOW IN PROGRESS).
2632 ;DOESN'T CLOBBER F (FOR WRQOTE)
2633 ;RETURNS SKIPPING IF SYM FOUND, WITH SQUOZE FLAGS IN BOTTOM OF A,
2634 ;VALUE OF SYM IN B, STE IDX IN D, AND 3RDWD IN C.
2635 ;IF NOT FOUND, RETURNS IN D THE IDX OF A PLACE TO DEFINE SYM.
2636 ;CALL ESDCHK TO GET THE FOLLOWING EXTRA INFO (WHETHER SYM FOUND OR NOT):
2637 ;ESLAST -> LAST STE WITH DESIRED NAME SEEN, REGARDLESS OF WHAT BLOCK IT'S IN
2638 ;ESL1 HAS LEVEL OF BLOCK OF BEST STE SEEN, -1 IF NOT FOUND
2639 ;ESL2 HAS 3RDWRD OF BEST.
2640 ;ESXPUN HAS -1 OR IDX OF A STE WHICH MIGHT BE USED TO DEFINE THE SYM.
2641 ;RH(TM) GETS BLOCK IDX TO DEFINE IN IF DEFINE THE SYM.
2642 ;TT HAS -<# STE NOT LOOKED AT YET>
2643 ;THEN IF SYM IS FOUND IN A CONTAINING BLOCK AND YOU WANT TO DEFINE
2644 ;IT IN THE CURRENT BLOCK, YOU CAN CALL DEFCHK TO FIND AN STE TO DO IT IN.
2645 ;CALLING ESDEF IS AS GOOD AS CALLING ESDCHK AND DEFCHK, BUT DOESN'T
2646 ;LET YOU SEE WHAT YOU ARE GOING TO SHADOW.
2648 ESDEF: MOVE A,BKCUR ;EVAL SYM IN ORDER TO DEFINE IT:
2649 SKIPGE ESBK ;IF NO SPEC'D BLOCK, SPEC THE CURRENT BLOCK,
2650 MOVEM A,ESBK ;SO DEFS IN CONTAINING BLOCKS WON'T BE SEEN
2652 ESDCHK: SETOM ESLAST ;CALL HERE IF WE MIGHT END UP CALLING DEFCHK,
2653 SETOM ESL1 ;SINCE IN THAT CASE WE'LL NEED THESE VARS EVEN IF SYM IS FOUND
2654 SETOM ESXPUN ;RIGHT AWAY.
2656 ES: MOVE C,SYM ;HASH AWAY
2657 TSC C,SYM ;THIS MAKES SURE THAT THE FIRST FEW CHARS OF SYMBOL DON'T GIVE
2658 ;A ZERO REMAINDER, IF SYMLEN IS A ROUND NUMBER.
2659 MOVMS C ;THIS IS BECAUSE IDIV OF NEGATIVE NUMBER GIVES NEG. REMAINDER.
2662 SKIPGE TM,ESBK ;GET BKTAB IDX OF SPEC'D BLOCK
2663 HRR TM,BKCUR ;OR -1,,BKTAB IDX OF CURRENT BLOCK.
2664 ;NOW CHECK FAST FOR AN IMMEDIATE MATCH - AVOID SETTING UP FLAGS NEEDED ONLY WHEN
2665 ;SYM APPEARS IN MULTIPLE BLOCKS OR ISN'T DEFINED.
2667 JRST ESEND0 ;SYM IS KNOWN NOT TO BE DEFINED.
2670 JRST ESBAD0 ;NOT FOUND IN 1ST ENTRY - MUST SET UP INFO AND LOOP
2674 JRST ESGOOD ;IN THE DESIRED BLOCK => GOOD.
2675 TDNN C,[3MAS,,-1] ;IN THE INITIAL SYMS BLOCK, NOT PRESENT IN ANY OTHER,
2676 JUMPL TM,ESGOOD ;AND BLOCK WASN'T EXPLICITLY SPEC'D => GOOD.
2677 MOVN TT,SYMLEN ;ELSE MUST KEEP LOOKING TO SEE IF THIS DEF IS REALLY ONE WE WANT.
2684 ;LOOK AT THE NEXT STE, WHILE LOOPING.
2685 ESLP: SKIPN B,ST(D) ;GET SQUOZE IN THIS ST SLOT
2686 JRST ESEND ;NOTHING WHERE SYM BELONGS, END SEARCH
2687 TLZ B,740000 ;CLEAR OUT FLAGS
2688 CAME B,SYM ;COMPARE WITH WANTED
2689 JRST ESBAD ;NO MATCH BUT MAYBE KEEP GOING
2690 3GET C,D ;FOUND SYM, GET 3RDWRD
2692 CAIN A,(TM) ;DEFINED IN DESIRED BLOCK
2693 JRST ESGOOD ; => MUST BE GOOD.
2694 ESLP0: JUMPGE TM,ESIGN ;BLOCK SPEC'D => ALLOW NO OTHERS.
2695 TDNE C,[3MAS,,-1] ;IF IN INITIAL SYMS BLK, NO MORE DEFS,
2697 SKIPGE ESL1 ;AND NO PREVIOUS DEFS,
2698 JRST ESGOOD ;UNREDEFINED INITL SYM MUST BE GOOD.
2699 ESLP1: HLRZ B,BKTAB+1(C) ;GET LEVEL OF BLOCK DEF. IS IN.
2700 CAMN A,BKPDL(B) ;SAME AS BLOCK WE'RE IN AT THAT LEVEL?
2701 CAMLE B,BKLVL ;AND NOT A BLOCK WE'VE EXITED
2703 CAMG B,ESL1 ;OR HIGHER LEVEL THAN PREVIOUS BEST
2705 MOVEM C,ESL2 ;REPLACE BEST'S 3RDWRD, LEVEL, ADDR.
2708 ESIGN: HRRZM D,ESLAST ;THIS ENTRY LAST SEEN WITH THIS NAME.
2709 TLNN C,3MAS ;MORE STE'S FOR THIS SYM =>
2711 JRST ESNXT ;KEEP LOOKING.
2713 ;COME HERE IF 1ST SYM SEEN ISN'T THE SAME NAME. SET UP TO LOOP.
2714 ESBAD0: MOVN TT,SYMLEN
2718 ;HERE WHILE LOOPING WHEN SYM WITH WRONG NAME IS SEEN.
2719 ESBAD: JUMPN B,ESNXT
2720 SKIPGE A,ESXPUN ;IF THIS IS 1ST EXPUNGED ENTRY SEEN
2721 MOVEM D,ESXPUN ;REMEMBER IT FOR DEFINITION.
2723 HRROS ESLAST ;AND SET OLD ENTRY'S 3MAS.
2725 CAML D,SYMSIZ ;AT END => GO TO BEGINNING
2728 JRST ESEND1 ;NOT FOUND.
2730 ESEND0: MOVEI C,(TM) ;COME HERE IF 1ST PLACE LOOKED AT SHOWS THE SYM ISN'T DEFINED
2734 ESEND: SKIPGE A,ESXPUN ;FREE ENTRY CAN BE USED TO DEFINE.
2738 ESEND1: SKIPGE ESL1 ;NOT FOUND => FIND PLACE TO DEFINE IT.
2740 MOVE D,SADR ;IDX OF BEST FOUND.
2742 JRST ES1PS ;1-PASS, SPECIAL CHECK.
2743 MOVE C,ESL2 ;GET BEST'S 3RDWRD.
2744 ESGOOD: LDB A,[400400,,ST(D)] ;GET SQUOZE FLAGS IN A.
2745 ES1POK: MOVE B,ST+1(D) ;VALUE OF SYM. IN B.
2746 ;D HAS IDX OF 1STWRD IN SYM TAB.
2751 ;ESDCHK THEN DEFCHK IS SAME AS CALLING ESDEF.
2752 DEFCHK: SKIPGE ESL1 ;IF WE DIDN'T TAKE TIME TO SET ESLAST BEFORE,
2753 HRRZM D,ESLAST ;DO IT NOW. (SEE BEFORE ESLP1)
2756 ES1PS: LDB A,[400400,,ST(D)] ;1PASS & FOUND IN CONTAINING BLOCK:
2758 TRNN C,-1 ;INITIAL SYM, OK;
2760 CAIE A,1 ;PSEUDO OR MACRO
2761 TLNE C,3DOWN ;OR .DOWN'D SYMBOL OK;
2762 JRST ES1POK ;ELSE GET NEW STE TO DEF.
2763 DEFCH1: MOVEI C,(TM) ;INITIALIZE NEW 3RDWRD WITH BLOCK TO DEF IN.
2764 SKIPL D,ESXPUN ;IF FOUND EXPUNGED OR FREE ENTRY, USE IT.
2766 SKIPGE D,ESLAST ;ELSE LOOK FOR ONE.
2768 DEFCH4: MOVE B,ST(D)
2770 JUMPE B,DEFCH3 ;MUST RETURN 0 IN B IF DON'T SKIP.
2774 AOJL TT,DEFCH4 ;ASSUME TT LEFT AROUND FROM ES.
2776 ERRSCE: ASCIZ /Symbol table full/
2778 ;ESLAST HAS -1 IF NO ENTRY SEEN; ELSE
2779 ;RH HAS IDX OF LAST SEEN, SIGN SET IF SEEN BEFORE PLACE TO DEFINE.
2780 DEFCH3: MOVEM D,ESXPUN ;REMEMBER ADDR WHERE CAN DEFINE
2781 HRROS ESLAST ;LAST PLACE SEEN MUST BE EARLIER.
2782 DEFCH2: SKIPL A,ESLAST
2783 JRST DEFCH5 ;LAST PLACE SEEN WAS SEEN AFTER PLACE TO DEFINE.
2785 POPJ P, ;REALLY NEVER SEEN.
2787 IORM TM,ST+2(A) ;PLACE SEEN IS EARLIER, SET ITS 3MAS.
2790 DEFCH5: TLO C,3MAS ;PLACE TO DEF BEFORE EXISTING STES.
2793 ;ENTER A SYM IN SYMBOL TABLE
2796 ;D HAS INDEX INTO ST (PROBABLY SET UP BY ES)
2797 ;T HAS SQUOZE FLAGS (ONLY) IN PLACE FOR IOR OF SQUOZE
2798 ;SYM HAS SQUOZE, FLAGS OF WHICH ARE IGNORED
2800 VSM2LV: TLOA C,3LLV ;ENTRY FOR LINKING LOADER MUST SUPPLY VALUE
2801 VSM2W: MOVE B,WRD ;ENTRY TO ENTER VALUE OF WRD STEAD B
2804 IOR CH1,T ;CH1 := SQUOZE WITH FLAGS
2805 MOVEM CH1,ST(D) ;STORE SQUOZE
2806 MOVEM B,ST+1(D) ;STORE VALUE
2807 VSM3A: 3PUT C,D ;STORE 3RDWRD
2810 ;RETURN THE NUMBER OF SYMTAB SLOTS IN USE.
2811 A.SYMCN:MOVE D,SYMAOB
2813 A.SYC1: MOVE B,ST(D)
2821 ;;EQUAL ;EQUAL SIGN ENCOUNTERED, DO PARAMETER ASSIGNMENT
2823 EQUAL: TLZ FF,FLHKIL
2825 CAIE A,"= ;DECIDE WHETHER TO HALF-KILL THE SYM.
2830 CAIE A,": ;DECIDE WHETHER TO MARK SYM AS NOT REDEFINABLE.
2833 CAMN SYM,[SQUOZE 0,.] ;.=FOO, SAME AS LOC FOO
2835 TDNN I,[ILWORD,,IROP+IRNOEQ]
2837 ETR [ASCIZ/= With bad format or bad context/]
2841 MOVEI A,[ETSM [ASCIZ/Undefined in =/]]
2843 TRO I,IRNOEQ+IRDEF+IREQL
2846 MOVEM CH1,PARBIT ;SET FLAG TO TELL LOADER TO ALLOW REDEFINITION
2848 JRST ASEM1A ;UNDEFINED SYMS IN VALUE, IGNORE
2851 JRST EQUAL1 ;NOT LISTING.
2868 MOVE A,WRDRLC ;GET RELOCATION
2869 TDNN A,[-2,,-2] ;SKIP ON NON-STANDARD RELOCATION BITS
2871 JRST EQG1 ;STRANGE RELOCATION OR IN LOAD TIME CONDITIONALS => HAND PROBLEM TO LOADER
2874 JRST EQL1 ;NO GLOBALS IN DEFINITION
2878 ;GLOBALS TO RIGHT OF = OR WITHIN LOADER CONDIT.
2879 EQG1: IFN CREFSW, XCT CRFLBL ;CREF DEF. OF NORMAL SYM,
2881 JUMPL FF,[ETASM [ASCIZ /Externals in =/]]
2882 CALL ESDCHK ;SEARCH SYM TAB.
2883 JRST EQL2 ;NOT FOUND IN CURRENT OR CONTAINING BLKS.
2884 HRRZI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN.
2887 XCT EQG1TB(A) ;FOUND IN DESIRED BLOCK.
2891 CAIN A,PSUDO_-16 ;FOUND AS INITIAL PSEUDO => ERROR.
2893 EQG2: CALL DEFCHK ;FIND FREE STE TO DEFINE IN DESIRED BLOCK.
2894 JRST EQL2 ;PRETEND WASN'T FOUND.
2896 ERRQPA: ASCIZ /Shadowing a pseudo-op/
2897 ERRIPA: ASCIZ /Illegal =/
2899 EQG1TB: ETSM ERRIPA ;COMMON
2900 ETSM ERRIPA ;PSEUDO OR MACRO
2902 JRST EQGUL ;LOCAL UNDEF
2903 ETSM ERRIPA ;DEF LOC VAR
2904 ETSM ERRIPA ;UNDEF LOC VAR
2905 ETSM ERRIPA ;DEF GLO VAR
2906 ETSM ERRIPA ;UNDEF GLO VAR
2907 JRST EQL7 ;GLO ENTRY
2910 EQL8: PUSHJ P,GLKPNR
2912 EQL7: MOVSI T,GLOETY ;GLOBAL PARA ASSIGN
2915 LOPRA1: PUSH P,CASM1A ;RETURN TO ASSEM1A AFTER FOLLOWING.
2921 TLOA SYM,400000 ;SET FLAG TO HALF-KILL SYM
2923 TLO C,3SKILL ;SET CORRESPONDING FLAG IN 3RDWRD
2925 JUMPGE FF,CPOPJ ;JUMP ON NOT PUNCHING PASS
2926 SKIPN PARBIT ;IF CAME FROM COLON ROUTINE,
2927 JRST PDEFPT ;PUNCH "DEFINE SYM AS $.".
2928 TLO C,3VP ;VALUE PUNCHED
2929 3PUT C,D ;STORE UPDATED 3RDWRD
2932 DPB TT,[310700,,BKBUF]
2937 EQGUL: PUSHJ P,LKPNRO ;LOCAL UNDEF, OUTPUT LINK REQUEST.
2938 TLZ C,3LABEL\3MULTI ;CAN'T DETECT MDT'S WHEN ONLY STINK KNOWS FOR SURE.
2940 JRST EQL7 ;MAKE IT GLOBAL
2941 MOVSI T,LCUDF ;LOCAL UNDEFINED
2946 ;MAYBE PUNCH OUT LINK REQUEST
2947 ;SYM HAS NAME OF SYM TO REQUEST, D STE IDX OF SYM, C 3RDWRD, B ADR OF REQUEST
2948 ;REQUEST WILL BE PUNCHED IF 3RLNK SET IN C OR IF ANYTHING SET IN LH(B)
2950 GLKPNR: TLO SYM,40000 ;GLO BIT
2951 LKPNRO: TLNN C,3RLNK
2954 POPJ P, ;DON'T PUNCH REQUEST
2957 JRST LKPNDR ;DIFFERENT WAY TO OUTPUT THIS INFO IN DECREL FMT
2960 PUSHJ P,OUTSM0 ;PUNCH SYM
2962 TLZE C,3RLNK ;RELOC OF LINK PNR
2964 HRRZS B ;CLEAR OUT LH OF B
2965 TRZ I,IRCONT ;OK TO END BLOCK NOW
2966 JRST $OUTPT ;PUNCH OUT A AND RETURN
2968 LKPNDR: MOVSI A,DECINT ;WRITE AN "INTERNAL REQUEST" WITH ONE DATA WORD.
2970 SETZ TM, ;COMPUTE RELOC OF ADDRESS AND DATA IN TM.
2975 MOVE A,WRD ;ADDRESS TO LINK,,DATA
2980 ;THESE ASSUME STE IDX IN D, SQUOZE W/ FLAGS IN SYM.
2981 ;C HAS 3RDWRD, B OR WRD HAS VALUE TO DEF. WITH.
2982 ;CALL ONLY IN RELOCATABLE ASSEMBLY.
2984 OUTDE1: TLNE FF,FLPPSS
2985 TLO C,3VP ;VALUE PUNCHED
2990 PUSHJ P,P70 ;PUNCH OUT CODE BITS
2991 PUSHJ P,GTVL7B ;SET RELOCATION BITS IN SQUOZE
2994 JRST OUTWD ;OUTPUT VALUE
2996 ;PUNCH OUT LOCAL-GLOBAL RECOVERY BITS AND SYM
2997 ;I.E. TELL LOADER THAT SQUOZE IN SYM, FORMERLY CONSIDERED LOCAL, IS REALLY GLOBAL
2998 PLOGLO: SKIPGE CONTRL
3001 TRO I,IRCONT ;Don't end block between the two words
3005 TLO SYM,400000 ;SAY THIS IS NEW STYLE RQ,
3006 PUSHJ P,OUTSM0 ;PUNCH "OLD NAME" = SYMTAB IDX,
3007 TLC SYM,440000 ;SAY MAKE GLOBAL, OUTPUT ACTUAL NAME OF SYM.
3012 ;NO GLOBALS TO RIGHT OF EQUAL SIGN
3014 EQL1: PUSHJ P,ESDCHK
3015 JRST EQL1A ;NOT FOUND
3016 IFN CREFSW,XCT CRFEQL ;DEF. OCCUR. OF NORMAL SYM. OR INTSYM.
3017 MOVEI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN.
3020 SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED".
3022 XCT EQL1TB(A) ;FOUND IN DESIRED BLOCK => NOW REDEFINE.
3025 EQL1F: JUMPN T,EQL10
3028 MOVEI T,(B) ;FOUND AS PSEUDO IN INITIAL SYMS BLOCK,
3029 CAIN T,INTSYM ;SPECIAL WAY TO REDEFINE IF LIKE .MLLIT, ETC.
3031 ETSM ERRQPA ;SHADOWING AN INITIAL PSEUDO, TELL USER.
3032 EQL10: CALL DEFCHK ;FOUND IN OUTER BLOCK, GET NEW STE,
3033 JRST EQL1A ;DEFINE THERE AS IF NOT FOUND.
3035 EQL1TB: ETSM ERRIPA ;COMMON
3036 JRST EQL1B2 ;PSEUDO OR MACRO
3038 JRST EQL1C ;LOCAL UNDEF
3039 ETSM ERRIPA ;DEF LOC VAR
3040 ETSM ERRIPA ;UNDEF LOC VAR
3041 ETSM ERRIPA ;DEF GLO VAR
3042 ETSM ERRIPA ;UNDEF GLO VAR
3043 JRST EQL1D ;GLO ENTRY
3044 JRST EQL1E ;GLO EXIT
3046 EQL1E: PUSHJ P,GLKPNR ;DUMP LINKING POINTER
3049 PUSHJ P,RCHKT ;GLO ENTRY
3050 EQLB2: PUSHJ P,RMOVET
3056 SKIPE LDCCC ;IF IN LOADER CONDITIONAL,
3057 TLO C,3LLV ;THEN LOADER MUST SUPPLY VALUE
3058 PUSHJ P,VSM2W ;DEFINE SYM
3059 TLO SYM,40000 ;SET GLOBAL BIT IN SQUOZE
3060 EQL1CE: JUMPGE FF,ASEM1A
3062 ASEM1A: TLNE I,ILMWRD
3066 ;CHECK WHETHER DEFINING AN MDT, OR REDEFINING A LABEL (=> THIS IS AN MDT)
3067 MDTCHK: TLNN C,3LABEL
3069 CALL GVSYM0 ;MOVE VALUE OF SYM TO A, GET RELOC (WRDRLC STYLE) IN B
3071 CAME B,WRDRLC ;IF WE'RE CHANGING THE VALUE, MARK SYM AS MDT
3072 MDTCHL: TLO C,3MULTI
3073 MDTCH1: TLNE C,3MULTI ;EVER ASSIGNING TO MDT, EVEN SAME VALUE, GIVES ERR MSG
3078 JRST EQL1CA ;MAKE GLOBAL
3080 PUSHJ P,LKPNRO ;MAYBE OUTPUT LINK REQUEST
3082 PUSHJ P,RMOVET ;INITIALIZE 3RDWRD
3084 PUSHJ P,EQA2A ;ENTER DEF IN SYMTAB
3088 TLNE AA,3VCNT ;USED IN CONSTANT
3092 ;PUNCH OUT CODE BIT PAIR, FIRST OF WHICH IS 7
3094 P7X: MOVEM A,PARBIT ;ENTRY FOR SECOND BYTE IN A
3095 P70: PUSHJ P,PBITS7 ;ENTRY FOR SECOND BITE IN PARBIT, PUNCH OUT THE 7
3096 SKIPA A,PARBIT ;GET SECOND BYTE BACK
3097 PBITS7: MOVEI A,7 ;ENTRY TO JUST PUNCH OUT 7
3100 EQL1CA: PUSHJ P,PLOGLO
3103 EQA2A: TLNE FF,FLHKIL
3107 EQL1B2: HRRZ A,B ;ATTEMPT TO ASSIGN PSEUDO-OP, IS IT AN INTSYM?
3109 JRST EQLINT ;YES, GO SET WD IT POINTS TO.
3110 ETSM [ASCIZ /Pseudo or macro ='D/]
3114 JRST EQLB2 ;WAS LOCAL, MAKE IT GLOBAL
3115 ;WAS LOCAL, LEAVE IT LOCAL
3116 PUSHJ P,RMOVET ;PUT RELOCATION BITS IN BITS 0 AND 1 OF C (I.E. START SETTING UP 3RDWRD)
3120 EQL1A1: PUSHJ P,RCHKT
3125 EQL1A: SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED".
3127 IFN CREFSW,XCT CRFLBL ;DEF. OCCUR. OF NORMAL SYM.
3132 EQLINT: HLRZS B ;GET ADDR OF WD HOLDING VALUE.
3133 MOVEMM (B),WRD ;PUT NEW VALUE IN IT.
3136 ;;. ;ROUTINES DEALING WITH THE CURRENT LOCATION AND OFFSET
3139 CLOC: 0 ;PUNCHING LOC
3140 CRLOC: 0 ;PUNCHING RELOC
3142 OFRLOC: 0 ;OFSET RELOC
3143 ;VAL OF PT=CLOC+OFLOC,CRLOC+OFLOC
3144 SYLOC: 0 ;VAL OF LAST TAG
3146 SYLOC1: 0 ;VALUE OF NEXT TO LAST TAG
3147 SYSYM1: 0 ;NEXT TO LAST TAG
3148 GLOCTP: 0 ;4.9 => CURRENT LOCATION GLOBAL, 2.9 => OFFSET GLOBAL
3149 ;FRGLOL (FLAG IN FF) IS IOR OF BITS 4.9 AND 2.9 OF GLOCTP
3150 ;EXCEPT AFTER .=NON-GLOBAL WITH GLOBAL OFFSET
3151 ;OTHER BITS USED ONLY WHEN IN LINK (NEVER SET IN GLOCTP):
3156 ;POINT (.) AS PSEUDO-OP
3158 GTVLP: TRNE FF,FRGLOL
3159 JRST GTVLP2 ;LOCATION GLOBAL
3160 MOVE B,OFRLOC ;GET RELOCATION OF OFFSET
3161 ADD B,CRLOC ;ADD CURRENT RELOCATION
3162 MOVE A,CLOC ;GET CURRENT LOCATION
3163 SKIPGE BYTM1 ;IF IN BYTE MODE,
3164 HLL A,BYTWP ;SET LEFT HALF TO BYTE POINTER LEFT HALF FOR ILDB
3165 ADD A,OFLOC ;NOW ADD OFFSET
3166 TLZ I,ILFLO+ILDECP+IRPERI ;CLEAR OUT FLAGS SET WHEN LOOKED LIKE FLOATING POINT NUMBER
3170 GTVLP2: MOVEI T,$.H ;LOCATION GLOBAL
3172 HRRZM T,@GLSP1 ;PUT $. ON GLOBAL LIST (INCLUDES OFFSET, WHETHER GLOBAL OR NOT)
3173 SKIPL BYTM1 ;IN BYTE MODE?
3174 TDZA A,A ;NO, CLEAR ABS PART OF VALUE
3175 HLLZ A,BYTWP ;YES, USE LH(BP) AS ABS PART
3178 $.H: (GLOETY)+SQUOZE 0,$. ;CURRENT LOCATION + OFFSET IN LOADER
3179 $L.H: (GLOETY)+SQUOZE 0,$L. ;LOCATION BEING LOADED INTO BY LOADER, USED BY ABLOCK
3180 $O.H: (GLOETY)+SQUOZE 0,$O. ;LOADER OFFSET
3181 $R.H: (GLOEXT)+SQUOZE 0,$R. ;RELOCATION AS GLOBAL
3185 ETA [ASCIZ/Colon without preceding symbol/]
3187 TRNE I,IROP+IRPSUD+IREQL+IRNOEQ
3188 ETSM [ASCIZ/Label inside an expression/]
3190 ETSM [ASCIZ /Label inside <>, () or []/]
3192 PUSHJ P,RCH ;GET NEXT CHAR
3193 CAIN A,": ;IF NEXT CHAR ANOTHER COLON,
3194 TLOA FF,FLHKIL ;THEN SET FLAG TO HALF-KILL
3195 TLO FF,FLUNRD ;NOT COLON, CAUSE IT TO BE RE-INPUT
3196 SKIPE HKALL ;CHECK FOR HALF-KILL-ALL-LABELS MODE.
3198 MOVE T,CLOC ;GET CURRENT LOCATION
3200 HLL T,BYTWP ;BYTE MODE, SET LEFT HALF OF VALUE TO LEFT HALF OF BYTE POINTER
3201 ADD T,OFLOC ;ADD OFFSET
3202 MOVEM T,WRD ;STORE RESULT AWAY FOR POSSIBLE PUNCHOUT
3203 EXCH T,SYLOC ;NOW SET UP STUFF FOR ERROR PRINTOUT
3208 MOVE A,CRLOC ;SET UP RELOCATION
3211 CLEARM PARBIT ;SET FLAG SAYING COLON, FOR DEFINITION PUNCHING
3212 SETOM LABELF ;SET FLAG CAUSING 3LABEL (DON'T REDEFINE) TO BE SET.
3215 JRST GCOL1 ;LOCATION VIRTUAL OR IN LOAD TIME CONDITIONAL
3216 PUSHJ P,ESDCHK ;TRY FINDING CURRENT ENTRY IN ST
3217 JRST EQL1A ;NOT ALREADY DEFINED
3218 IFN CREFSW,XCT CRFLBL
3219 COLON1: MOVEI T,(C) ;BKTAB IDX OF BLOCK FOUND IN,
3220 CAIE T,(TM) ;FOUND IN DESIRED BLOCK => TRY REDEFINING.
3222 TLO C,3LABEL ;CAUSE REDEFINING SYMBOL TO BARF
3223 XCT COLON2(A) ;BUT MAYBE PRINT ERR MSG FIRST.
3228 COLON3: JUMPN T,EQL10 ;NOT INITIAL SYM => CAN SHADOW,
3229 CAIN A,SYMC_-14. ;INITIAL SYM => CAN SHADOW IF IT'S AN ORDINARY LOCAL SYM
3230 CAME B,WRD ;AND NEW VALUE SAME AS OLD VALUE.
3233 ETSM ERRRES ;ELSE GIVE ERROR MESSAGE BEFORE SHADOWING, TO WARN USER.
3236 ERRRES: ASCIZ /Pseudo, macro or initial sym as label/
3237 ERRMDT: ASCIZ /Multiply defined/
3239 COLON2: TLO C,3MULTI ;COMMON
3240 ETSM ERRRES ;MACRO OR PSEUDO
3242 JRST EQL1C ;LOCAL UNDEF
3246 TLO C,3MULTI ;SETTING 3MULTI CAUSES EQL1B TO PRINT AN MDT ERROR.
3247 JRST EQL1D ;GLOBAL ENTRY
3248 JRST EQL1E ;GLO EXIT
3250 ;COLON WHEN LOCATION VIRTUAL, OR IN LOAD TIME CONDITIONAL
3252 GCOL1: IFN CREFSW,XCT CRFLBL ;DEFINING ORDINARY SYM.
3254 ETASM [ASCIZ /Virtual label in abs assembly/]
3255 PUSHJ P,ESDCHK ;FIND ITS SLOT IN ST
3256 JRST EQL2 ;JUST LIKE EQG1 EXCEPT FOR ERROR MESSAGES.
3260 XCT GCOL1T(A) ;FOUND IN DESIRED BLOCK, REDEFINING.
3263 COLON5: JUMPN T,EQG2 ;SHADOWING, OK UNLESS INITIAL SYM.
3267 GCOL1T: TLO C,3MULTI ;COMMON
3268 ETSM ERRRES ;PSEUDO.
3270 JRST EQGUL ;LOCAL UNDEF.
3276 JRST EQL8 ;UNDEF GLO.
3279 ;PUNCH OUT "DEFINE SYM AS $."
3281 PDEFPT: MOVEI A,CDEFPT
3282 PUSHJ P,P7X ;OUTPUT 7 THEN PDEFPT
3283 JRST OUTSM0 ;OUTPUT SYM, WITHOUT BITS
3287 ALOC: PUSHJ P,ALOCRG ;LOC, GET ARG
3288 ALOC1: SETZM SYLOC ;CLEAR OUT LOC OF LAST TAG
3289 SETZM SYSYM ;CLEAR OUT LAST TAG SO ERROR MESSAGES DON'T PRINT OBSCENE INCREMENTS
3294 ETA [ASCIZ /LOC illegal in FASL assembly/]
3296 TRZE LINK,400 ;GLOBALS IN ARG?
3298 HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF CURRENT LOCATION
3299 CALL SLOCF ;RE-INIT NEXT OUTPUT BLOCK'S HEADER; SET LOCF.
3300 MOVEI A,LCEGLO ;=> RESET GLOBAL RELOCATION (BACK TO ORIGINAL NON-GLOBAL RELOCATION)
3301 TLZE LINK,400000 ;IS CURRENT LOCATION NOW GLOBAL?
3302 PUSHJ P,PLDCM ;YES, RESET IT
3303 MOVE B,WRDRLC ;GET BACK NEW RELOCATION
3304 ALOC2B: TRZE B,-2 ;NO BITS ALLOWED EXCEPT LOW ORDER
3305 ETR [ASCIZ *Illegal relocation in LOC/BLOCK/.=*]
3306 HRRZM B,CRLOC ;STORE NEW RELOCATION
3308 JRST ASSEM1 ;DON'T BOTHER WITH REST IF ABS.
3309 MOVEI B,2(B) ;LABS OR LREL
3310 DPB B,[310700,,BKBUF] ;STORE NEW BLOCK TYPE
3311 MOVEM B,CDATBC ;ALSO STORE AS NORMAL BLOCK TYPE
3312 AOFSTX: TDNN LINK,[SETZ(SETZ)] ;ENTRY FROM AOFFSET, SKIP IF FRGLOL SHOULD BE SET
3313 TRZA FF,FRGLOL ;CURRENT LOCATION PLUS OFFSET NOT GLOBAL, CLEAR FLAG
3314 TRO FF,FRGLOL ;GLOBAL, SET FLAG
3315 TRZ LINK,600 ;CLEAR OUT TEMPORARY FLAGS SO WON'T GET STORED IN GLOCTP
3316 MOVEM LINK,GLOCTP ;STORE BACK STATUS FLAGS
3319 PTEQ: MOVE SYM,[SQUOZE 0,LOC]
3320 PUSHJ P,ALOCRG ;.=, GET ARG
3321 MOVE T,[MINF+HFWDF,,$O.H] ;GLOTB ENTRY IF .+1 DOESN'T SKIP
3322 TRNE LINK,400000 ;OFFSET GLOBAL?
3323 JRST PTEQ2 ;YES, WANT TO DO LOC ARG-$O."
3324 PUSHJ P,SBWDOF ;OFFSET IS LOCAL, SUBTRACT FROM ARG
3327 ABLOCK: PUSHJ P,ABLKRG ;GET ARG TO "BLOCK" PSEUDOOP.
3328 TRNE LINK,400 ;GLOBALS IN ARG?
3329 JRST ABLKG ;GLOBALS IN ARG
3331 JRST ABLKG ;JUMP IF LOSER CHANGING RELOCATION WHILE CLOC GLOBAL
3334 TRNN D,FASL ;IN FASL FORMAT, CAN'T SET LOC. CTR.,
3337 ETA [ASCIZ /BLOCK size relocatable/]
3339 CALL ABLKF ;SO ON PASS 2 OUTPUT A BUNCH OF ZEROS.
3342 ;OUTPUT C(A) ZEROS, IN FASL FORMAT. NO-OP ON PASS 1. DOESN'T SET THE LOCATION COUNTER.
3343 ABLKF: JUMPE A,CPOPJ
3356 ABLKF1: ADD A,CLOC ;ARG TO BLOCK IS LOCAL, ADD DIRECTLY TO CLOC
3357 ADD B,CRLOC ;ALSO ADD RELOCATIONS
3358 HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF LOCATION
3359 CALL SLOCF ;FALL INTO ALOC ROUTINE, MAKING SURE FRLOC GETS SET
3363 SBWDOF: SUB A,OFLOC ;SUBTRACT OFFSET FROM WRD, ETC. IN A,B
3364 HRRZM A,WRD ;MAKE SURE RESULT GETS STORED IN WRD, AS WELL AS AC'S
3365 SUB B,OFRLOC ;NOW DO RELOCATIONS
3369 ABLKG: TRNE LINK,400000 ;GLOBAL BLOCK, IS OFFSET GLOBAL?
3370 JRST ABLKG2 ;YES, OK TO REFERENCE $L.
3371 PUSHJ P,SBWDOF ;NO, FOR COMPATIBILITY, DON'T REFERENCE $L.
3372 SKIPA T,[HFWDF,,$.H]
3373 ABLKG2: MOVE T,[HFWDF,,$L.H]
3374 PTEQ2: AOS GLSP1 ;STORE T IN GLOTB
3376 ALOC2: TLO LINK,400000 ;SET GLOBAL LOCATION FLAG
3377 MOVEI A,LCGLO ;=> GLOBAL LOCATION ASSIGNMENT
3378 PUSHJ P,PLDCM ;PUNCH OUT GLOBAL LOCATION ASSIGNMENT
3379 SETZM CLOC ;CLEAR OUT CLOC, NEW RELOCATION NOW
3380 SETZB B,BKBUF ;ALSO CLEAR OUT HEADER, JUST TO BE SURE
3381 AOJA B,ALOC2B ;SET RELOCATION TO 1 AND FALL IN
3383 AOFFSET: PUSHJ P,AOFFS2 ;OFFSET, GET ARG
3385 MOVEM A,WRD ;RESTORE UNTRUNCATED ARG.
3386 TRZE LINK,400 ;GLOBALS IN ARG?
3387 TROA LINK,400000 ;GLOBALS IN ARG, SET GLOBAL OFFSET FLAG
3388 TRZ LINK,400000 ;NO GLOBALS IN ARG
3389 MOVEM A,OFLOC ;STORE NEW OFFSET
3390 MOVEM B,OFRLOC ;ALSO STORE RELOCATION BITS
3391 SKIPGE CONTRL ;IN RELOCATABLE,
3393 MOVEI A,LDOFS ;LOADER OFFSET LOADER COMMAND TYPE
3394 PUSHJ P,PLDCM ;PUNCH OUT LOADER COMMAND
3397 ;GET ARG TO LOC, BLOCK, .=, OFFSET
3402 JRST [ CAML A,DECBRA ;IF ADDR BEFORE THE LOC WAS ABS,
3403 MOVEM A,DECBRA ;UPDATE HIGHEST ABS ADDR IF NEC.
3405 CAML A,DECTWO ;IT WAS RELOCA; UPDATE HIGHEST
3406 JRST [ CAML A,DECBRH ;ADDR OF APPROPRIATE SEG.
3413 PUSHJ P,CONBAD ;ERROR IF IN GROUPING
3415 TRNE I,IRNOEQ\IRPSUD\IREQL
3416 ETSM [ASCIZ /Inside pseudo or =/]
3417 TDNE I,[ILWORD,,IRFLD]
3419 PUSHJ P,EBLK ;MAYBE END CURRENT OUTPUT BLOCK
3420 PUSHJ P,AGETWD ;GET ARG
3421 MOVE LINK,GLOCTP ;GET GLOCTP FLAGS IN LINK, STAYS THERE UNTIL ALMOST DONE
3424 TROA LINK,400 ;SIGNAL GLOBAL ARG
3426 MOVE T,A ;SAVE UNTRUNCATED FOR AOFFSET,
3427 HRRZS A,WRD ;TRUNCATE FOR LOC, BLOCK, .=.
3428 TRNN I,IRDEF ;ALL DEFINED?
3430 SKIPGE CONTRL ;YES, RETURN SKIPPING OVER ARG
3434 ETASM [ASCIZ *Argument has externals*]
3436 ;;CONSTANTS AND VARIABLES
3444 PCNTB: BLOCK NCONS*3 ;CONSTANTS AREAS TABLE
3447 CONTBA: CONTAB ;ADDRESS OF BEGINNING OF CONSTANTS TABLE.
3448 CONTBE: CONTAB+LCONTB ;ADDRESS OF WORD AFTER END OF CONSTANTS TABLE.
3449 PLIM: 0 ;POINTER TO FIRST UNUSED WORD IN CONSTANTS TABLE.
3451 CONGLA: CONGLO ;ADDRESS OF BEGINNING OF CONSTANT-GLOBALS TABLE.
3452 CONGLE: CONGLO+LCNGLO ;ADDRESS OF WORD AFTER END OF CONSTANT GLOBALS TABLE.
3453 CONGOL: 0 ;HAS ADR OF FIRST WORD INACTIVE IN CONSTANT-GLOBALS TABLE.
3455 CONBIA: CONBIT ;ADDRESS OF BEGINNING OF CONSTANT-RELOCATION-BITS TABLE.
3457 CONLEN: CONMIN ;TOTAL SPACE ALLOCATED TO CONSTANTS TABLES.
3458 ;ALL THE HOOKS ARE IN FOR DYNAMIC ALLOCATION OF THESE TABLES
3459 ;(CONTAB, CONGLO, AND CONBIT). ALL THAT IS NEEDED IS TO GET
3460 ;THE SPACE AND INITIALIZE CONTBA, CONTBE, CONGLA, CONGLE, CONBIA.
3464 ;EACH ENTRY 3 WORDS; FIRST WORD SQUOZE, NAME OF AREA IF GLOBAL
3465 CSQZ: 0 ;SQUOZE COUNTER
3466 ;SECOND WORD RH LOC OF AREA (WITH OFFSET), LH LOC FIRST AFTER AREA (WITHOUT OFFSET)
3467 ;THIRD WORD LH FLAGS
3469 CGBAL==100000 ;GLOBAL (INCLUDING OFFSET)
3470 CTRL==200000 ;RELOCATED ( " )
3471 CTDEF==400000 ;DEFINED (MUST BE SIGN)
3473 PBCON: 0 ;POINTER INTO PCNTB, HAS ADR OF ENTRY FOR NEXT CONSTA
3474 PBCONL: 0 ;POINTER TO ABSOLUTE TOP OF PCNTB
3475 CONCNT: 0 ;NUMBER OF TIMES CONSTANTS CAN APPEAR (DECREMENTED BY CONSTA)
3476 CONDEP: 0 ;DEPTH IN CONSTANTS (0 TOP LEVEL)
3477 CONSAD: 0 ;ADDR IN CONSTANTS TABLE OF ENTRY FOR CURRENT CONST.
3478 CONSML: 0 ;VALUE OF .MLLIT INTSYM.
3479 ;NEGATIVE => ERROR MODE (DEFAULT)
3481 ;POSITIVE => NEW (MULTI-LINE) MODE.
3483 CONSTP: 0 ;PDL POINTER BELOW WDS FOR INNERMOST CONSTANT.
3486 ;VARIABLES FOR VARIABLES CODING
3488 VARCNT: 0 ;NO OF VAR IN CURRENT VAR AREA SO FAR
3489 VARPNT: 0 ;POINTER TO CURRENT PLACE IN VARTAB
3490 VARCNR: 0 ;NO OF TIMES VARIABLES MAY APPEAR
3491 VCLOC: 0 ;TEM FOR VARIAB
3492 VECSIZ: 0 ;DEFAULT SIZE FOR .VECTOR.
3496 ;LEFT-BRACKET ENCOUNTERED; HERE ON DISPATCH FROM GETFD
3497 ;SAVE WORLD, BYTE MODE, ASSEM1 PDL LEVELS.
3498 ;THEN SET ASSEM1 PDL LEVELS TO CURRENT LEVELS
3499 ;SO ASSEM1 WON'T FLUSH PAST LEVEL OF CONSTANT.
3500 ;SET CONSTP _ CURRENT PDL LEVEL. PCONS WILL PUT WORDS
3501 ;OF CONSTANT ABOVE CONSTP, AND SET ASSEMP ABOVE THEM.
3504 ETR [ASCIZ /Literal/]
3505 TRO I,IRFLD ;LEFT BRACKET
3506 JSP LINK,SAVWD1 ;SAVE CRUFT
3507 PUSH P,SCNDEP ;SO THE NEXT RBRKT WON'T TRY TO CLOSE CONDIT.
3510 SETZM SCNDEP ;NOT WITHIN CONDITIONALS IN THIS LITERAL.
3511 AOS CONDEP ;ONE DEEPER IN LITERALS.
3512 JRST ASSEM3 ;GO ASSEMBLE THE WORDS OF THE CONSTANT.
3514 ;OUTPUT WORD TO CONSTANT. P MUST EQUAL ASSEMP HERE.
3515 PCONS: SKIPL CONTRL ;IF RELOCATABLE,
3516 PUSHJ P,$RSET ;HANDLE STRANGE RELOCATIONS.
3518 SUB B,GLSP2 ;NUM. GLOBAL ENTRIES FOR THIS WD.
3519 HLRZ A,WRDRLC ;ONLY 1.1 AND 3.1 BITS MATTER.
3521 IOR A,WRDRLC ;GET THEM INTO 1.1, 1.2 BITS.
3522 TLNE I,ILNOPT ;REMEMBER ILNOPT ALSO.
3524 DPB B,[032200,,A] ;AND # GLBLS.
3525 PUSH P,A ;SAVE THEM ALL.
3526 HRLI B,(B) ;GET # GLBLS,,# GLBLS .
3530 HRRI A,1(P) ;SAVE THE GLBLS, IF ANY.
3535 MOVEM P,ASSEMP ;ASSEMP -> ABOVE WDS FOR LIT.; CONSTP, BELOW.
3538 ;JSP LINK,SAVAS1 TO PUSH DATA ON ASSEM1 LEVEL AND CALL ASSEM1
3540 .SEE CONNDP ;WHICH IS WHERE THESE THINGS ARE POPPED.
3541 SAVAS1: SKIPN BYTM ;IF IN BYTM NOW (WILL PUSH AND TURN OFF)
3543 MOVSI A,BYBYT ;SAVE ALL THE DETAILS.
3545 ADD P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL]
3546 JUMPGE P,CONFLP ;(SOFTWARE-DETECTED PDL-OV)
3556 PUSH P,GLSPAS ;SAVE ASSEM1 PDL LEVELS.
3562 MOVEM A,ASMI ;ASMI IOR'D INTO I AT ASSEM2 LOOP.
3564 HRL A,CLNN ;REMEMBER WHERE THIS LITERAL STARTS.
3565 INSIRP PUSH P,[A SYSYM SYLOC]
3566 MOVEM P,ASSEMP ;SO ASSEM1 WON'T FLUSH WHAT WE PUSHED.
3567 MOVEM P,CONSTP ;SO CONND CAN FIND 1ST WD OF CONSTANT.
3569 SAVAS2: MOVEI A,ASSEM3 ;IF NOT MULTI-LINE MODE, ARRANGE TO
3570 SKIPG CONSML ;END THE CONSTANT AFTER 1 WORD.
3575 PCONST: MOVE CH1,ASMDSP ;OUTPUT TO CONST. FROM ASSEM1
3576 CAIN CH1,CONND ;LAST WD OF CONST?
3577 CAME P,CONSTP ;1ST WD?
3578 JRST PCONS ;NO, DO THE GENERAL THING.
3579 SKIPL CONTRL ;THIS MUST BE ONLY WORD OF CONST,
3580 PUSHJ P,$RSET ;DON'T BOTHER PUSHING, END CONST. NOW.
3582 TLZ I,ILMWRD+ILMWR1 ;THIS IS 1ST WD, NO MORE WDS.
3583 JRST CONND3 ;PRETEND JUST POPPED IT.
3585 ;COME HERE FROM ASSEM1 TO END A CONSTANT.
3586 CONND: SKIPE BYTM ;IF IN BYTE MODE, LEAVE IT AND DO .WALGN
3587 JRST A.BY3 ;(WILL COME BACK SINCE ASMDSP STILL SET)
3588 CONNDW: MOVEMM CONSP1,CONSTP
3589 TLZ I,ILMWR1 ;THIS IS 1ST WORD COMING UP.
3590 CONND0: TLZ I,ILMWRD+ILNOPT
3592 MOVE F,CONSP1 ;ADDR IN IN PDL OF NEXT WD.
3594 JRST CONND2 ;J IF NO WORDS.
3595 MOVE A,1(F) ;GET SAVED NUM GLBLS,,NUM GLBLS
3597 LSH A,-1 ;RESTORE WRDRLC BITS 1.1, 3.1
3598 DPB A,[220100,,WRDRLC]
3600 TLO I,ILNOPT ;RESTORE NOOPTF.
3601 LSH A,-2 ;GET # GLBLS.
3602 HRLI A,(A) ;# GLBLS,,# GLBLS.
3604 HRRZM F,GLSP2 ;ADDR BEFORE 1ST GLOBAL ENTRY.
3606 HRRZM F,GLSP1 ;ADDR OF LAST GLOBAL ENTRY.
3609 AOBJN F,.+1 ;POINT TO NEXT CONST WD IF ANY,
3611 CAME F,ASSEMP ;IF MORE WORDS SET ILMWRD
3615 CONND2: INSIRP SETZM,[WRD,GLSP1,GLSP2]
3616 CONND3: MOVE F,GLSP1
3618 JUMPE F,SCON ;JUMP IF NOTHING VIRTUAL
3621 JUMPE B,SCON ;JUMP IF ONLY ONE GLOBAL
3622 ;SORT GLOTB ENTRIES THIS CONSTANT
3623 LSORT: HRL T,TT ;SET UP AOBJN POINTER TO GLOBALS REMAINING
3627 EXCH A,2(T) ;INTERCHANGE
3629 AOBJN T,LSORT2 ;INNER LOOP POINT
3630 SOJG B,LSORT ;OUTER LOOP
3635 PUSHJ P,RMOVET ;SET UP RELOACTION BITS.
3636 ROT T,2 ;ROTATE TO BOTTOM TWO BITS OF T
3637 TLNE I,ILMWRD+ILMWR1+ILNOPT
3638 JRST NOCON ;MULTIPLE WORD OR OPTIMIZATION SUPPRESSED, DON'T TRY TO FIND MATCH
3640 SCON1: CAML A,PLIM ;SEARCH CONSTANTS TABLE TO SEE IF ALREADY THERE
3641 JRST NOCON ;END OF TABLE, NO MATCH
3644 SCON2: AOJA A,SCON1 ;VAL DISAGREES
3645 PUSHJ P,CPTMK ;GET BP TO CONSTANTS-BIT TABLE IN C
3646 LDB F,C ;GET RELOCATION BITS THIS CONSTANT
3648 JRST SCON2 ;RLC DIFFRS
3649 MOVE B,CONGLA ;VALUE AND RELOCATION AGREE, NOW TO CHECK GLOBALS
3651 SCON2B: AOS B ;SEARCH FOR GLOBAL POINTING TO CONSTANT WHICH HAS MATCHED SO FAR
3653 JRST SCON3 ;GLOBALS MATCH SO FAR
3654 CAME A,1(B) ;SKIP IF ONE FOUND
3655 SCON7: AOJA B,SCON2B ;NOT YET
3656 MOVE D,(B) ;FOUND ONE, GET GLOTB ENTRY
3657 CAME D,1(C) ;COMPARE WITH THIS ENTRY IN GLOTB
3658 JRST SCON2 ;NO MATCH, FLUSH THIS CONSTANT
3659 AOJA C,SCON7 ;MATCH, TRY NEXT GLOBAL
3661 SCON3: CAME C,GLSP1 ;GLOBALS MATCH, BUT ARE WE EXACTLY AT END OF GLOTB?
3662 JRST SCON2 ;NO, BACK TO SEARCH
3665 NOCON: AOS A,PLIM ;CONSTANT NOT ALREADY IN TABLE
3667 ETF [ASCIZ/Literal table full/]
3673 TRO T,4 ;1.3 OF RELOCATION BITS => DON'T OPTIMIZE ON TOP OF ME
3676 NOCON3: CAML B,GLSP1
3679 AOJA B,NOCON3 ;THIS ENTRY NOT REALLY HERE
3685 SKPST C, ;SKIP IF IN SYMBOL TABLE
3687 3GET1 D,C ;IN SYMBOL TABLE
3688 TLO D,3VCNT ;THIS SYM USED IN CONSTANT
3689 3PUT1 D,C ;UPDATE 3RDWRD TABLE ENTRY
3692 NOCON5: AOS AA,CONGOL
3694 ETF [ASCIZ/Constants-global table full/]
3697 ;SET UP BYTE POINTER TO CONSTANTS-BIT TABLE
3698 ;A SHOULD HAVE ADR OF CONSTANTS TABLE ENTRY
3700 ;BITS IN CONSTANTS-BIT TABLE PER ENTRY:
3701 ;1.2, 1.1 RELOCATION BITS
3702 ;1.3 ILNOPT BIT => DON'T OPTIMIZE ON TOP OF ME
3709 ADD C,CONBIA ;SET UP ADDRESS PART
3711 DPB B,[360600,,C] ;STORE POSITION FIELD FROM REMAINDER
3712 TLO C,200 ;SET UP SIZE FIELD
3716 NOCON4: TLON I,ILMWR1
3717 MOVEM A,CONSAD ;IF 1ST WD SAVE ADDR.
3718 TLNE I,ILMWRD ;IF MORE WORDS, HANDLE NEXT.
3720 MOVE P,CONSTP ;VALUE OF CONSTP AT CONND.
3721 MOVE C,GLSPAS ;TO RESTORE GLSP1
3722 JSP T,CONNDP ;POP STUFF.
3723 HRRZ A,CONSAD ;ADDR OF CONSTANTS TABLE ENTRY OF 1ST WD.
3724 MOVE B,PBCON ;ADDR OF WDS DESCRIBING CONST. AREA.
3725 SKIPL 2(B) ;CONST. AREA LOCATION DEFINITE?
3726 AOJA C,CONND6 ;NO, USE GLOBAL.
3728 HRRZ C,1(B) ;ADD ACTUAL ADDR OF CONST. AREA.
3729 ADDI A,(C) ;GET C(CONTBA) + ADDR OF CONSTANT.
3730 LDB B,[420100,,2(B)]
3733 CONND6: MOVEM C,GLSP1
3736 CONND7: SUB A,CONTBA
3737 JRST LSSTH3 ;POP OUT INTO OUTER WORD.
3739 .SEE SAVAS1 ;WHICH IS WHAT PUSHES WHAT CONNDP POPS.
3740 CONNDP: SUB P,[3,,3] ;FLUSH SAVED SYLOC AND SYSYM AND CLNN,,CPGN.
3741 CONFL2: HRL T,ASMOUT ;REMEMBER IF POPPING A LITERAL OR NOT.
3742 INSIRP POP P,[CONSTP,ASSEMP,GLSPAS,ASMI,ASMDSP,ASMOUT,BYTM]
3743 SKIPN BYTM ;IF IN BYTE MODE, POP DETAILS.
3747 BLT A,BYTMC+BYTMCL-1
3748 MOVSI A,1-BYTMCL-LBYBYT(P)
3750 BLT A,BYBYT+LBYBYT-1
3751 SUB P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL]
3756 ADDM A,SCNDEP ;DON'T FORGET ABOUT ANY CONDITIONALS.
3757 SOS CONDEP ;HAVE POPPED ONE CONSTANT.
3760 CONFLS: MOVE P,ASSEMP ;FLUSH ALL CONSTANTS.
3761 CAMN P,[-LPDL,,PDL] ;IF IN ANY,
3763 MOVE P,CONSTP ;POINT AFTER ITS PDL ENTRY,
3764 JSP T,CONNDP ;POP IT,
3765 JRST CONFLS ;TRY AGAIN.
3767 CONBAD: SKIPN ASMOUT ;IF IN GROUPING, ERROR.
3769 ETSM [ASCIZ/Within <>, () or []/]
3772 ;COME HERE FOR PDL-OV ON P.
3773 ;IF IN A CONSTANT, FLUSH ALL OF THEM, SAYING WHERE EACH STARTED.
3774 ;THEN TYPE A PDL ERROR MSG AND RETURN TO ASSEM1.
3775 ;OTHERWISE FATAL ERROR.
3776 CONFLP: MOVEI LINK,ASSEM1
3779 JRST CONFL3 ;IN A CONSTANT.
3780 MOVEI P,PDL ;RE-INIT PDL SO NO MORE PDL-OV.
3782 ERRPDL: ASCIZ /PDL overflow/
3784 ;JSP LINK,CONFLM TO FLUSH CONSTANTS, SAYING WHERE THEYY STARTED,
3785 ;AND GIVE ERROR MSG.
3786 CONFLM: MOVE CH1,ASMOUT
3787 SKIPA CH1,ASMOT3(CH1)
3788 CONFLZ: SETZ CH1, ;LIKE CONFLM BUT NO ERR MSG AT END.
3790 CONFL1: MOVE P,CONSTP ;GET STACK ABOVE INNERMOST LITERAL.
3793 REST D ;GET INFO ON WHERE STARTED
3794 AOSN C ;THE 1ST TIME ONLY, SAY WHAT'S GOING ON.
3795 TYPR [ASCIZ/Within groupings: /]
3798 MOVE A,ASMOUT ;SAY WHAT KIND OF GROUPING IS BEING CLOSED
3800 CALL TYOERR ;BY SAYING WHAT CHAR OPENED IT.
3801 JSP T,CONFL2 ;POP REST OF WDS SAVED AT LBRAK.
3803 MOVEI A,1(D) ;PAGE # GROUPING STARTED ON.
3804 CALL DPNT ;PRINT IN DECIMAL.
3807 HLRZ A,D ;LINE NUMBER IT STARTED ON.
3809 CALL D3PNT2 ;PRINT W/ AT LEAST 3 CHARS, NO ZERO SUPPR.
3811 CAME A,[-LPDL,,PDL] ;MORE GROUPINGS TO POP => DO.
3815 JUMPE CH1,(LINK) ;IF CALLED CONFLZ, NO ERR MSG (CALLER WILL GIVE ONE)
3816 ETR (CH1) ;[ NO] OR PDL.
3823 SKIPE ASMOUT ;IF ANY GROUPNGS,
3824 JSP LINK,CONFLM ;FLUSH THEM, GIVE ERROR.
3828 CNSTN0: SOSGE CONCNT ;ENTRY FROM AEND
3829 ETF [ASCIZ /Too many constants areas/]
3841 ETR [ASCIZ /Constants globality phase error/]
3846 ETR [ASCIZ /Constants location phase error/]
3852 ETR [ASCIZ /Constants relocation phase error/]
3856 CNST2: MOVEI D,(T) ;STE IDX IN D FOR OUTSM0
3857 MOVE SYM,(T) ;GET NAME OF AREA
3858 TLC SYM,400000#LCUDF ;CLEAR LCUDF, SET HALF-KILL
3860 JRST [ MOVEI A,CDEFPT ;Define sym for beginning of constants area
3862 PUSHJ P,OUTSM ;As PDEFPT but punch squoze (see RPWRD1)
3870 LDB F,C ;GET THIS CONSTANT'S RELOCATION BITS
3872 TLO F,1 ;RELOCATE LEFT HALF
3873 MOVEM F,WRDRLC ;STORE RELOCATION
3874 MOVEI D,GLOTB ;AND NOW TO SET UP GLOTB!
3877 CNSTC: CAML C,CONGOL
3878 JRST CNSTB ;END OF CONSTANT-GLOBAL TABLE
3879 CAMN A,1(C) ;POINTS TO THIS CONSTANT?
3880 PUSH D,(C) ;YES, STORE ENTRY IN GLOTB
3884 CNSTB: HRRZM D,GLSP1 ;MARK END OF ACTIVE PART OF GLOTB
3886 PUSHJ P,PWRD ;OUTPUT THIS CONSTANT
3887 AOS CLOC ;INCREMENT CLOC TO NEXT
3888 HRRZS CLOC ;MAKE SURE IT STAYS IN A HALF-WORD (IMPORTANT SINCE MAY BE LESS THAN RELOCATION)
3889 POP P,A ;RESTORE POINTER INTO CONSTANTS TABLE
3892 CNST3: HLRZ A,1(T) ;GET POINTER TO TOP OF AREA STORED DURING PASS 1
3893 CAMN A,CLOC ;SAME AS CURRENT?
3894 JRST CNSTE ;YES, NO HAIR
3895 CAMGE A,CLOC ;DIFFERENT; LOWER?
3896 ETR [ASCIZ /More constants on pass 2 than 1/]
3897 ;INSUFFICIENT CONSTANT SPACE; CONSTANTS AREA TRYING TO BE BIGGER
3898 ;IN PASS 2 THAN PASS 1; THE EXTRA CONSTANTS WERE BACKED OVER
3899 MOVEM A,CLOC ;EITHER WAY, SET CLOC TO TOP OF AREA SO WON'T HAVE MDT TROUBLE
3900 PUSHJ P,EBLK ;END CURRENT BLOCK
3901 CALL SLOCF ;IF RELOCATABLE, MAKE SURE NEW VALUE OF $. GETS PUNCHED
3904 ;CALL SLOCF WHENEVER "." IS CHANGED WITHOUT THE OUTPUTTING OF A STORAGE WORD.
3905 SLOCF: MOVE A,CLOC ;STORE NEW "." IN HEADER FOR NEXT BLOCK OF OUTPUT.
3907 TRNN TM,DECREL+FASL ;BUT NOT IN DEC OR FASL OUTPUT FORMATS.
3909 IORI FF,FRLOC ;MAKE SURE NULL BLOCK IS OUTPUT IF NEC. TO TELL LOADER "." HAS CHANGED.
3912 ;CONSTA DURING PASS 1
3914 CNST1: HRRM B,1(T) ;STORE LOCATION OF AREA
3919 TLO D,CTRL ;RELOCATED
3922 IORM D,2(T) ;STORE FLAGS DESCRIBING AREA
3923 JUMPL FF,CNST2 ;JUMP ON PUNCHING PASS, PUNCH OUT AREA NOW
3926 ADDM T,CLOC ;PASS 1, JUST UPDATE CLOC
3931 JRST CNSTD ;LOCATION GLOBAL
3934 JRST CNSTDA ;2 PASS ASSEMBLY OR AREA DEFINED
3935 TRO I,IRCONT ;1PASS AND NOT DEFINED
3937 PUSHJ P,P70 ;DEFINE SYM
3941 TLO A,100000 ;RELOCATE
3945 PUSHJ P,$OUTPT ;OUTPUT VALUE, FIRST LOCATION IN AREA
3946 CNSTDA: MOVSI A,CTDEF
3947 IORM A,2(T) ;CALL IT DEFINED
3948 CNSTD: TRNE FF,FRPSS2
3951 HRLM A,1(T) ;MARK END OF AREA
3953 CNSTE: MOVE A,CONTBA
3965 ;DEFINING SYM USED IN CONSTANT, DELETE REFERENCES FROM CONSTANT-GLOBAL TABLE
3967 CONBUG: MOVE A,CONGLA ;B VAL C FLAGS ST(D) SADR
3969 PUSH P,C ;SAVE FLAGS
3970 CONBG2: MOVE C,(P) ;GET FLAGS
3971 CAML A,CONGOL ;DONE WITH SCAN?
3973 HRRZ F,(A) ;NO, GET CONSTANT-GLOBAL TABLE ENTRY
3974 CAIE F,ST(D) ;POINT TO THIS SYM?
3976 PUSH P,B ;YES, SAVE VALUE, ABOUT TO WORK WITH B
3977 MOVE T,(A) ;GET ENTIRE CONSTANT-GLOBAL TABLE ENTRY
3978 LDB CH2,[221200,,T] ;GET MULTIPLICATION FIELD
3980 IMUL B,CH2 ;NON-ZERO => MULTIPLY VALUE OF SYM
3982 MOVNS B ;NEGATE VALUE
3984 HRRZS B ;TRUNCATE TO HALFWORD
3986 ANDI B,17 ;AC, MASK TO FOUR BITS
3990 LSH B,5 ;AC, SHIFT FIVE
3991 ADD B,@1(A) ;ADD ABS PART OF VALUE
3993 HRRM B,@1(A) ;NOT SWAPPED, STORE LH
3995 HLLM B,@1(A) ;SWAPPED, STORE LH
3997 MOVEM B,@1(A) ;FULL WORD, STORE VALUE
3998 LDB CH1,[420200+P,,-1] ;GET HIGH BITS OF 3RDWRD, RELOCATION BITS
3999 TLNE T,HFWDF ;NOW TO MAP RELOCATION BITS
4006 HRRZ A,1(A) ;GET POINTER INTO CONSTANTS TABLE
4008 LDB B,C ;GET RELOCATION BITS
4013 ;ATTEMPTED MULTIPLE RELOCATION IN CONSTANT
4014 ; ^ ABOVE SHOULD BE REPLACED WITH A $RSET LIKE ROUTINE
4015 ;THAT ALSO SEARCHES CONSTANT-GLOBAL TABLE FOR $R. ALREADY THERE
4016 IOR B,CH1 ;LOOKS OK, IOR IN BITS FOR GLOBAL
4017 CONB8A: DPB B,C ;STORE BACK NEW RELOCATION BITS FOR CONSTANT
4019 CLEARM (A) ;CLEAR OUT CONSTANT-GLOBAL TABLE ENTRY
4023 CONBG6: AOJA A,CONBG2 ;BACK FOR NEXT CONSTANT, DON'T KNOW HOW MANY THIS SYM USED IN
4025 CONBG1: MOVE A,CONGLA
4028 CONBG7: CAML A,CONGOL
4031 CONBG5: AOJA A,CONBG4
4038 CONBG4: AOJA A,CONBG7
4039 CONBG3: MOVEM B,CONGOL
4050 ERRCRI: ASCIZ /Multiple relocation in constant/
4055 SKIPE ASMOUT ;FLUSH ANY GROUPINGS IN PROGRESS.
4060 AVARI0: SOSG VARCNR ;ENTRY FROM AEND
4061 ETF [ASCIZ /Too many variable areas/]
4062 MOVE D,SYMAOB ;SET UP AOBJN POINTER TO ST
4064 MOVEM T,VCLOC ;STORE AS LOCATION OF VARIABLE AREA
4070 HRL T,VARCNT ;SIZE OF AREA
4072 TLO T,400000 ;RELOCATED
4076 AVAR1: HRRZ A,@VARPNT ;VARIAB DURING PASS 2
4078 ETR [ASCIZ /Variables location phase error/]
4083 ETR [ASCIZ /Variables relocation phase error/]
4085 ETR [ASCIZ /Variables area size phase error/]
4087 AVAR2E: HLRZ T,@VARPNT
4089 JRST AVAR2C ;IF THIS VAR AREA IS EMPTY, DON'T SCAN SYMTAB.
4090 AVAR2: HLRZ LINK,ST(D) ;SCAN, CHECKING EACH SYM FOR WHETHER IT'S A VARIABLE
4095 JRST AVAR2C ;ALL SCANNED.
4097 AVAR2B: 3GET C,D ;FOUND A VARIABLE; DECIDE WHAT TO DO WITH IT.
4101 LDB LINK,[400400,,ST(D)]
4102 CAIE LINK,UDEFLV_-14.
4103 CAIN LINK,UDEFGV_-14.
4104 JRST AVAR3 ;UNDEFINED VARIABLE
4105 CAIE LINK,DEFGVR_-14.
4106 CAIN LINK,DEFLVR_-14.
4107 JRST AVAR4 ;DEFINED VARIABLE
4108 AVAR2A: ADD D,WPSTE1
4109 AOBJN D,AVAR2 ;CHECK ENTIRE SYMTAB
4110 AVAR2C: HLRZ A,@VARPNT ;NOW GET SIZE OF AREA
4111 TRZ A,400000 ;CLEAR OUT RELOCATION CHECK BIT
4114 TRNE D,FASL ;IN FASL ASSEMBLY, CAN'T JUST SET LOC CTR; MUST OUTPUT 0'S.
4117 ADD A,VCLOC ;ADD LOCATION OF BEGINNING OF VARIABLE AREA
4118 MOVEM A,CLOC ;STORE AS NEW CURRENT LOCATION
4121 CLEARM VARCNT ;INITIALIZE COUNT OF VARIABLES IN NEXT AREA
4122 AOS VARPNT ;INCREMENT POINTER TO POINT TO NEXT AREA
4125 ;UNDEFINED VARIABLE FOUND IN SYMTAB SCAN
4127 AVAR3: CAIN LINK,UDEFGV_-14. ;GLOBAL?
4128 TLO SYM,40000 ;GLOBAL
4131 CAIN LINK,UDEFGV_-14.
4134 JRST AVAR3A ;LOCATION GLOBAL
4142 CAIE LINK,UDEFGV_-14.
4146 AVAR4B: PUSHJ P,VSM2
4147 JUMPGE FF,AVAR2A ;IF PUNCHING PASS, OUTPUT DEFINITION.
4151 AVAR4: TLNE C,3VAS2 ;DEFINED VARIABLE FOUND DURING SYMTAB SCAN
4154 MOVSI T,(LINK) ;CAUSE AVAR4B TO REDEFINE AS SAME TYPE.
4158 AVAR3A: PUSHJ P,VSM2LV
4167 AVAR4A: CAIN LINK,DEFGVR_-14. ;DEF VAR, 3VAS2, POINT NOT GLOBAL.
4168 JRST AVAR4B ;VAR GLOBAL, MUST PUNCH DEF SINCE DIDN'T ON PASS1.
4169 3PUT C,D ;LOCAL, JUST SET 3VP SO DON'T SEE IT NEXT VARIAB.
4170 JRST AVAR2A ;NO NEED TO PUNCH DEF SINCE WAS DEF ON PASS1.
4172 ;;MAIN ;"MAIN" MIDAS ROUTINES: INIT, PS1, PLOD, PS2, PSYMS
4173 ;ALL CALLED WITH JSP A,; ALL GLOBAL
4174 ;RETURN INSTRUCTION FROM JSP IN LOCATION RETURN
4175 PS1: HRRM A,RETURN ;PASS 1, (PASS 1 INITIALIZATION ALREADY DONE), SAVE RETURN
4176 SAVE [ASSEM1-1] ;SIMBLK WILL POPJ1.
4177 IFN A1PSW,[SKIPL PRGC
4178 JRST A1PAS1 ;THIS NOT FIRST PROGRAM THIS ASSEMBLY, SET MODE TO 1PASS
4181 IFN ITSSW,JRST SIMBLK ;SELECT SBLK AND ASSEMBLE
4182 IFN DECSW\TNXSW,JRST A.DECRE ;SELECT .DECREL AND ASSEMBLE.
4184 PS2: HRRM A,RETURN ;PASS 2 (MAIN ROUTINE, PASS 2 INITIALIZATION NOT ALREADY DONE), SAVE RETURN
4185 JUMPL FF,PA2A ;JUMP IF PASS 1 ENDED IN 1PASS MODE
4186 TDO FF,[FLPPSS,,FRPSS2] ;SET PUNCHING PASS AND PASS 2 FLAGS
4187 PUSHJ P,P2INI ;INITIALIZE
4188 JRST ASSEM1 ;START ASSEMBLING
4190 PA2A: MOVE A,SYMAOB ;PASS 2 OF 1PASS ASSEMBLY, CHECK FOR UNDEFINED LOCALS
4191 PA2C: MOVE SYM,ST(A) ;GET SQUOZE THIS SYMTAB ENTRY
4192 LDB B,[400400,,SYM] ;GET FLAGS
4193 CAIE B,LCUDF_-14. ;LOCAL UNDEFINED?
4194 JRST PA2B ;NOT LOCAL UNDEFINED, DON'T COMPLAIN
4195 3GET C,A ;LOCAL UNDEFINED, GET 3RDWRD ST ENTRY
4196 TLZ SYM,740000 ;CLEAR OUT FLAGS IN SYM IN ANTICIPATION OF TYPING OUT COMPLAINT
4197 TLNN C,3LLV ;PROBLEM HANDED TO LINKING LOADER?
4198 ETSM [ASCIZ /Undefined/] ;NO
4199 PA2B: ADD A,WPSTE1 ;NOW GO FOR NEXT ST ENTRY
4203 $INIT: HRRM A,RETURN ;INITIALIZATION (BEFORE PASS 1 ONLY) ROUTINE, SAVE RETURN POINT
4204 IFN CREFSW,PUSHJ P,CRFOFF ;DON'T CREF ON 1ST PASS.
4205 IFN LISTSW,CALL LSTOFF ;DON'T LIST ON 1ST PASS.
4207 JRST INIT1 ;SPREAD SYMS (RETURNS TO SP4)
4208 MOVE A,SYMAOB ;ALREADY SPREAD, JUST FLUSH ALL BUT INITIAL SYMS
4209 INIT4: SKIPN B,ST(A)
4212 TRNE C,-1 ;INITIAL SYM?
4217 MOVE A,[BBKCOD,,BBKCOD+1]
4218 BLT A,EBKCOD ;CLEAR OUT BLANK CODE
4221 P1INI: CLEARB I, LDCCC
4222 INSIRP SETZM,BKBUF ISYMF A.PASS
4224 INSIRP SETZM,FASATP FASPCH
4227 MOVEMM DECTWO,[[MOVE]]
4228 TDZ FF,[-1-FLVOT-FLPTPF-FLTTY,,-1] ;INITIALIZE MOST FF FLAGS
4229 MOVEIM A.PPASS,2 ;DEFAULT IS 2-PASS.
4230 PUSHJ P,MACINI ;INITIALIZE MACRO STATUS
4233 MOVS A,[BKTAB,,P1INI1]
4235 MOVEIM BKTABP,BKWPB*2
4237 P2INI: INSIRP SETZM,[CPGN,CLNN,GENSM,OFLOC,OFRLOC,CRLOC,BKPDL
4238 SYLOC,SYSYM,BYTW,BYTRLC,STGSW,DECBRK,DEFNPS,BYTM,BYTM1,HKALL,QMTCH]
4241 CALL SETWH2 ;SET UP .WHO2, PREPARE .WHO3 IN A WITH PAGENUM=1.
4242 .SUSET [.SWHO3,,A] ;'P1 ',,PAGENUM OR 'P2 ',,PAGENUM
4243 .SUSET [.SWHO1,,[.BYTE 8 ? 166 ? 0 ? 165 ? 0]]
4245 TDZ FF,[FLUNRD,,FRGLOL]
4246 IRP X,,[BKWPB,BKCUR,,BKPDL+1,1,BKLVL,IRDEF,ASMI
4247 NCONS,CONCNT,VARTAB,VARPNT,NVARS,VARCNR,1,VECSIZ]
4248 IFE 1&.IRPCN,IFSN [X], MOVEI A,X
4249 IFN 1&.IRPCN, MOVEM A,X
4257 MOVE A,[440300,,PBITS1]
4264 MOVE A,[(LCUDF)+<SQUOZE 0,$ >+1] ;< AND > FOR COMPATIBILITY WITH OLD
4274 AOS CRLOC ;CRLOC GETS 1
4279 MOVE A,CONTRL ;IN DEC FORMAT, OUTPUT PROGRAM NAME.
4281 CALL DECPGN ;CLOBBERS A
4283 SETOM FASBLC ;LOSING BLOCK COUNT
4284 MOVE A,CONTRL ;IN FASL FORMAT, OUTPUT FASL HEADER
4286 CALL FASOIN ;INITIALIZE FASL OUTPUT
4289 TRO FF,FRSYMS+FRFIRWD
4290 MOVE A,[IFORTB,,FORTAB] ;INITIALIZE FORMAT TABLE ON EACH PASS
4292 MOVEIM GLSPAS,GLOTB ;INIT. ASSEM1 PDL LEVELS TO BOTTOM.
4293 MOVEMM ASSEMP,[[-LPDL,,PDL]]
4294 MOVEIM ASMDSP,ASSEM3
4297 SETZM SCNDEP ;NOT IN CONDIT. OR CONSTANT.
4299 HRRZM P,CONSML ;START OUT IN MULTI-LINE MODE.
4301 MOVE A,[440700,,LISTBF]
4305 SKIPG LISTP1 ;IF LIST ON PASS 1
4306 JUMPGE FF,CRETN ;OR PUNCHING PASS,
4307 SKIPE LISTP ;IF WANT LISTING,
4308 CALL LSTON ;TURN ON OUTPUT OF LISTING.
4312 SKIPE CREFP ;IF C SWITCH WAS SEEN,
4313 PUSHJ P,CRFON ;TURN ON CREFFING,
4315 CRETN: POPJ P,RETURN
4317 P1INI1: SQUOZE 0,.INIT ? 0 ? 3
4318 SQUOZE 0,.MAIN ? 1,,
4320 PLOD: HRRM A,RETURN ;MAIN ROUTINE TO PUNCH LOADER, CALLED BEFORE PASS 2 (PS2"), SAVE RETURN POINT
4321 PUSHJ P,PLOD1 ;PUNCH LOADER
4324 ;PUNCH OUT THE LOADER
4326 PLOD1: PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE
4329 JRST PLOD2 ;RIM10 => PUNCH OUT SBLK LOADER FOR PDP10 READIN-MODE READIN
4331 POPJ P, ;NOT SBLK => DON'T PUNCH LOADER
4332 PLOD1A: MOVSI B,SLOAD-SLOADP ;PUNCH SBLK LOADER IN RIM FORMAT
4333 MOVSI C,(DATAI PTR,)
4336 CAMN C,[DATAI PTR,13]
4346 PLOD2: MOVSI C,LDR10-ELDR10 ;PUNCH SBLK LOADER FOR PDP10 READIN
4347 PLOD3: MOVE A,LDR10(C)
4352 ;SBLK LOADER NORMALLY PUNCHED OUT IN RIM FORMAT
4354 SLOAD: CONO PTR,60 ;0 RESTART POINT (NEW BLOCK)
4355 JSP 14,30 ;1 START POINT, LOOP POINT FOR NEW BLOCK; WAIT FOR DATA WORD READY
4356 DATAI PTR,16 ;GET HEADER
4357 MOVE 15,16 ;INITIALIZE CHECKSUM
4358 JUMPGE 16,16 ;HEADER .GE. 0 => STARTING INSTRUCTION
4359 JSP 14,30 ;5 LOOP POINT FOR NEXT DATA WORD: WAIT FOR READY
4360 DATAI PTR,(16) ;READ IN DATA WORD
4361 ROT 15,1 ;NOW UPDATE CHECKSUM
4363 AOBJN 16,5 ;LOOP FOR ALL DATA WORDS THIS BLOCK
4364 MOVEI 14,33 ;30 TO RETURN TO 33
4365 JRST 30 ;WAIT FOR READY THEN GO TO 33
4366 ;14 JSP AC FOR ROUTINE AT 30
4368 ;16 AOBJN POINTER (UPDATED HEADER)
4369 CONSO PTR,10 ;30 ROUTINE TO WAIT FOR DATA WORD READY FOR DATAI
4372 DATAI PTR,16 ;33 GET CHECKSUM
4373 CAMN 15,16 ;COMPARE WITH CALCULATED
4374 JUMPA 1 ;OK, GO GET NEXT BLOCK (DON'T CHANGE TO JRST OR REAL LOADERS WILL GET CONFUSED)
4375 JRST 4, ;CHECKSUM ERROR
4379 ;FOLLOWING CODING ACTUAL WORDS TO BE OUTPUT
4380 ;BY ASSEMBLER, COMPILER, OR WHATEVER
4381 ;SHOULD BE EXECUTED BY PDP10 HARDWARE READIN FEATURE
4382 ;USES ONLY THE AC'S (BUT ALL OF THEM)
4385 -17,,0 ;BLKI POINTER FOR READ SWITCH
4387 LDRC=0 ;CHECKSUM (OK, SO YOU'RE NOT ALLOWED TO LOAD
4388 ;INTO IT DURING HARDWARE READIN, BUT WHO SAYS
4389 ;YOUR PROGRAM CAN'T USE IT?)
4390 OFFSET -.+1 ;BEGIN LOADING INTO 1 AS PER HEADER
4392 CONO PTR,60 ;START UP PTR (RESTART POINT)
4394 HRRI LDRB,.+2 ;INITIALIZE INDEX
4396 CONSO PTR,10 ;WAIT FOR WORD TO BE AVAILABLE
4398 ROT LDRC,-LDRRD(LDRB) ;BEFORE READING IN HEADER, ROTATE 2 BITS (THEN IGNORE)
4399 ;BEFORE READING IN EACH DATA WORD, ROTATE 1 BIT (FOR UPDATING CHECKSUM)
4400 ;BEFORE READING IN CHECKSUM, ROTATE NOT AT ALL (DON'T ROTATE CALCULATED CHECKSUM)
4401 DATAI PTR,@LDRT1-LDRRD(LDRB) ;READ WORD INTO RIGHT PLACE
4402 ;HEADER => READ INTO C
4403 ;STORAGE WORD => READ INDEXED BY AOBJN POINTER IN A
4404 ;CHECKSUM => READ INTO A FOR COMPARISON WITH C(C)
4405 XCT LDRT1-LDRRD(LDRB) ;EXECUTE RELEVANT T1 ENTRY (MAYBE SKIPS)
4406 XCT LDRT2-LDRRD(LDRB) ;EXECUTE RELEVANT T2 ENTRY (MAYBE JUMPS)
4408 SOJA ., ;-RD(B) IS 2, 1, AND 0 FOR SUCCESSIVE ENCOUNTERS OF THIS INSTRUCTION
4409 ;USED AS INDEX INTO TABLES, ETC.
4412 ;INDIRECTED THROUGH FOR DATAI
4413 ;THEN EXECUTED TO SEE WHAT TO DO WITH READ IN WORD
4414 ;ENTRIES EXECUTED IN REVERSE ORDER
4417 CAME LDRC,LDRA ;COMPARE CHECKSUM WITH CALCULATED, SKIP TO B IF THEY AGREE
4418 ADD LDRC,(LDRA) ;UPDATE CHECKSUM
4419 SKIPL LDRA,LDRC ;INITIALIZE HEADER AND SKIP UNLESS JUMP BLOCK
4422 ;EXECUTED IF CORRESPONDING ENTRY IN TABLE 1 DIDN'T SKIP WHEN EXECUTED
4425 JRST 4,LDRGO ;CHECKSUM ERROR
4426 AOBJN LDRA,LDRW ;UPDATE AOBJN POINTER AND GO BACK FOR NEXT STORAGE WORD IF NOT EXHAUSTED
4428 JRST LDRRD ;WHEN INITIALLY LOADED IS JUMP BLOCK TO THIS LOADER
4429 ;DURING LOADING USED TO HOLD HEADER (AOBJN POINTER), WHICH MAY BE LOADED JUMP BLOCK
4434 ;FLAGS IN SQUOZE OF SYMS TO OUTPUT
4436 ABSGLO==040000 ;SYM IS GLOBAL (IF RELOCA, SAYS THIS IS BLOCK NAME)
4437 ABSLCL==100000 ;LOCAL
4438 ABSDLI==200000 ;DELETE INPUT (DON'T RECOGNIZE IT IF TYPED IN)
4439 ABSDLO==400000 ;DELETE OUTPUT (DON'T TYPE IT OUT)
4441 PSYMS: HRRM A,RETURN ;PUNCH OUT SYMBOL TABLE, CALLED AFTER EVERYTHING ELSE, SAVE RETURN POINT
4442 PUSH P,PSYMS ;AT END, POPJ TO RETURN.
4444 JRST SYMDMP ;PUNCH SYMS IF NEC.
4446 JRST SYMDA ;IF RELOCA, PUNCH PROGRAM NAME.
4449 PSYMSD: MOVSI A,DECEND
4450 PUSHJ P,DECBLK ;START AN END-BLOCK.
4451 MOVE A,DECTWO ;IN 2-SEG PROGRAMS,
4453 JRST [ CAMG A,DECBRH ;OUTPUT HISEG BREAK
4459 CALL PWRD ;FOLLOWED BY LOSEG BREAK
4461 MOVEMM WRD,DECBRK ;OUTPUT THE PROGRAM BREAK.
4464 MOVE A,DECBRA ;OUTPUT HIGHEST ABS. ADDR
4466 SETZ A, ;IF IT'S ABOVE THE JOBDAT AREA.
4470 SYMDA: MOVEI A,LPRGN ;NOW PUNCH PROGRAM NAME
4471 DPB A,[310700,,BKBUF]
4479 ;DUMP OUT THE SYMBOL TABLE
4481 SYMDMP: TRZ I,IRCONT ;OK TO END BLOCK
4496 JUMPL T,SSYMD ;JUMP IF NOT RELOCATABLE
4497 MOVEI B,LDDSYM ;LOCAL SYMS BLOCK TYPE
4498 DPB B,[310700,,BKBUF] ;SET BLOCK TYPE
4500 MOVE B,SYMAOB ;CAUSE SSYMD3 TO LOOK AT ENTIRE SYM TAB.
4503 SYMDMD: MOVSI A,DECSYM ;IN DEC FMT, START SYMBOLS BLOCK.
4505 SYMDM1: MOVE B,SYMAOB
4508 ;AC ALLOCATIONS DURING PHASE 1 (COMPACTING THE SYMBOL TABLE):
4509 ;AA INITIALLY HAS -SMK,,; INPUT INDEX INTO ST
4512 ;D OUTPUT INDEX INTO SYMTAB
4516 SETZB C,SMSRTF ;SYMS SORTED => INITIAL SYMS CLOBBERED
4518 SSYMD1: SKIPE B,ST(AA) ;GET SYM NAME FROM TABLE
4519 TDNN B,[37777,,-1] ;MAKE SURE NOT EXPUNGED
4520 JRST SSYMDL ;NOT (REALLY) THERE, TRY NEXT
4521 MOVE CH1,ST+1(AA) ;GET VALUE OF SYM
4522 3GET CH2,AA ;GET 3RDWRD
4525 JRST SSYMDL ;DON'T PUNCH INITIAL OR KILLED SYMS.
4526 MOVEI A,0 ;INITIALIZE FOR SHIFTING IN FLAGS
4527 LSHC A,4 ;SHIFT FLAGS INTO A
4528 XCT SSYMDT(A) ;DO THE APPROPRIATE THING THIS KIND OF SYMTAB ENTRY
4530 SSYMD2: LSH B,-4 ;SHIFT SQUOZE BACK TO WHERE IT BELONGS
4531 TLO B,ABSLCL ;SET LOCAL BIT
4533 TLO B,ABSDLO ;HALF-KILL SYM
4534 PUSH D,B ;STORE NAME OF SYM IN OUTPUT SLOT
4535 PUSH D,CH1 ;STORE VALUE
4536 PUSH D,CH2 ;STORE 3RDWRD
4537 SSYMDL: ADD AA,WPSTE1
4538 AOBJN AA,SSYMD1 ;LOOP FOR ALL SYMS IN TABLE
4539 MOVSI CH2,4^5 ;1ST BIT TO SORT ON IS TOPO BIT,
4540 MOVEI A,ST ;SORT FROM BOTTOM OOF SYMTAB
4541 MOVEI B,1(D) ;TO WHERE WE FILLED UP TO.
4542 MOVE CH1,[TDNE CH2,1(A)] ;SORT ON 2ND WD, WDS WITH BIT ON COME FIRST.
4543 MOVE C,[TDNN CH2,1(B)]
4545 TLC C,(TDNE#TDNN) ;ON BITS AFTER 1ST, ENTRIES WITH BIT OFF COME FIRST.
4547 MOVEI AA,SSRTX ;NEED ONLY CHANGE C, CH1 THE FIRST TIME.
4550 SSYMD9: PUSHJ P,SSRTX ;SORT SYMS ARITHMETICALLY BY VALUE.
4552 ADDI B,ST ;SIZE OF AREA OF SYMTAB STILL IN USE.
4556 IDIVI C,BKWPB ;# BLOCKS (INCL. .INIT BLOCK).
4558 MOVEI C,1 ;IF ONLY .INIT AND .MAIN, FILE WILL HAVE ONLY GLOBAL.
4560 SUBM B,A ;-<# ENTRIES IN SYMTAB IN FILE>,,
4561 LSH A,1 ;-<# WDS IN SYMTAB IN FILE>,,
4562 MOVEM A,SCKSUM ;SAVE THIS.
4564 PUSHJ P,BKCNT ;PUT -<# SYMS IN BLOCK> IN 3RD WD OF EACH BKTAB ENTRY.
4568 ;DROPS IN IF ABS, JUMPS HERE IF RELOC.
4569 ;NOTE THAT IN ABS ASSEMBLY, B WILL CONTAIN THE CHECKSUM AND
4570 ;SHOULD NOT BE CLOBBERED.
4571 SSYMDR: PUSH P,B ;-<# SYMS>,,0 ;IT WILL BE -1(P)
4572 PUSHJ P,BKSRT ;SORT BLOCKS INTO BKTAB1
4573 MOVE B,SCKSUM ;GET CHKSUM AFTER 1SS WD. (PPBCK WILL UPDATE)
4574 SETOM 1(D) ;PUT A -1 AT END OF BKTAB1.
4575 PUSH P,[-1] ;(P) WILL BE BKTAB1 IDX OF NEXT BLOCK TO OUTPUT.
4576 SSYMD3: AOS F,(P) ;F HAS BKTAB1 IDX OF BLOCK.
4577 SKIPGE C,BKTAB1(F) ;BKTAB1 ELT HAS BKTAB IDX OR
4578 JRST SSYMDX ; -1 AFTER LAST BLOCK.
4580 JRST SSYMD7 ;DIFFERENT RTN TO OUTPUT BLOCK NAME IF RELOCA.
4581 TRNE LINK,DECREL+FASL
4582 JRST SSYMD6 ;NO BLOCKS IN DEC FMT. (OR FASL EITHER)
4584 JRST SSYMG1 ;ONLY 1 BLOCK, PUT ALL IN GLOBAL.
4588 HRL A,BKTAB+2(C) ;PUT IN -2*<NUM SYMS>
4590 SSYMG2: PUSHJ P,PPBCK ;FOLLOWED BY LEVEL.
4593 SSYMG1: MOVE A,[SQUOZE 0,GLOBAL]
4595 HRLZ A,BKTAB+BKWPB+2
4599 SSYMD7: MOVE A,BKTAB(C) ;OUTPUT BLOCK NAME IN RELOCATABLE.
4600 TLO A,ABSGLO ;TELL STINK IT'S BLOCK NAME.
4605 SSYMD6: SKIPL C,-1(P) ;AOBJN PTR TO SYMS.
4606 JRST SSYMD3 ;IN CASE NO SYMS.
4607 SSYMD4: HRRZ A,ST+2(C) ;OUPUT ONLY THE SYMS IN THE BLOCK
4608 CAME A,BKTAB1(F) ;NOW BEING HANDLED.
4611 TRNE LINK,DECREL+FASL
4612 JRST SYMD2 ;SPECIAL IF RELOCA.
4614 PUSHJ P,PPBCK ;1ST, SQUOZE WITH FLAGS.
4616 PUSHJ P,PPBCK ;2ND, VALUE.
4617 SSYMD5: ADD C,WPSTE1
4618 AOBJN C,SSYMD4 ;HANDLE NEXT SYM.
4619 JRST SSYMD3 ;ALL SYMS FORR THIS BLOCK DONE, DO NEXT BLOCK.
4621 ;PUNCH OUT LOCAL SYM (RELOCATABLE ASSEMBLY)
4622 ;NORMALLY OUTPUT SQUOZE W/ FLAGS ? VALUE,
4623 ;IF 3LLV SET OUTPUT PHONY NAME (= STE ADDR) ? SQUOZE W/ FLAGS, STINK FIXES IT UP.
4624 SYMD2: LDB A,[400400,,ST(C)]
4625 MOVE CH1,ST+1(C) ;SSYMDT MAY CHANGE CH1.
4627 XCT SSYMDT(A) ;SKIPS IF SHOULD OUTPUT SYM.
4633 JUMPE B,SSYMD5 ;UNUSED ENTRY.
4634 JUMPL LINK,SYMDEC ;J IF DEC OR FASL FMT
4636 TLO B,200000 ;RELOCATE LEFT HALF
4638 TLO B,100000 ;RELOCATE RIGHT HALF
4640 TLO B,400000 ;HALF-KILL
4642 TLNE CH2,3LLV ;IF STINK HAS VALUE,
4643 PUSHJ P,$OUTPT ;GIVE STINK NAME STINK KNOWS SYMBOL BY.
4644 TLNE CH2,3LLV ;IF GIVING PHONY NAME, INSURE LOCAL FLAG SET
4645 TLO B,ABSLCL ;(STINK WILL DO SO OTHERWISE)
4647 PUSHJ P,$OUTPT ;OUTPUT SYM
4649 TLNN CH2,3LLV ;DON'T OUTPUT VALUE IF DON'T KNOW IT.
4650 PUSHJ P,$OUTPT ;OUTPUT VALUE
4655 JRST SYMFSL ;FASL ASSMBLY
4657 PUSHJ P,ASQOZR ;RIGHT-JUSTIFY THE SQUOZE,
4659 TLO B,ABSDLO ;MAYBE HALFKILL,
4661 LDB A,[400400,,ST(C)]
4663 TLC B,ABSGLO+ABSLCL ;LOCAL SYM, CHANGE GLO TO LCL.
4666 PUSHJ P,DECPW ;FIRST, THE NAME,
4668 LDB TM,[420200,,ST+2(C)]
4669 MOVE A,ST+1(C) ;THEN THE VALUE AND RELOCATION BITS.
4674 SYMFSL: TLO B,400000 ;GET VALUE FROM SECOND WD
4676 TLO B,200000 ;RELOCATE LH
4679 CAIL A,LGBLCB_<-18.+4>
4680 TLO B,40000 ;GLOBAL FLAG
4682 MOVEI B,15 ;PUTDDTSYM
4689 ;XCT INDEXED ON SQUOZE FLAGS; SHOULDN'T PUNCH SYM IF DOESN'T SKIP.
4691 JFCL ;PSEUDO OR MACRO
4692 CAIA ;SYM, PUNCH OUT
4693 TLNN CH2,3LLV ;LOCAL UNDEFINED, OUTPUT IF STINK HAS VALUE TO TELL STINK WHERE TO PUT IT.
4694 TLZA CH1,-1 ;DEFINED LOCAL VARIABLE, CLEAR OUT LH(VALUE)
4695 JFCL ;UNDEFINED LOCAL VARIABLE
4696 SKIPL CONTRL ;DEFINED GLOBAL VARIABLE, PUNCH OUT IF ABS.
4697 JFCL ;UNDEFINED GLOBAL VARIABLE
4698 SKIPL CONTRL ;GLOBAL ENTRY, PUNCH OUT IF ABS ASSEM.
4699 JFCL ;GLOBAL EXIT, DON'T PUNCH OUT
4700 IFN .-SSYMDT-NCDBTS,.ERR SSYMDT LOSES.
4702 SSYMDX: SKIPGE LINK,CONTRL
4703 TRNE LINK,DECREL+FASL
4705 SKIPGE BKTAB1+1 ;IF ABS ANND BLOCK STR,
4707 MOVE A,[SQUOZE 0,GLOBAL]
4708 PUSHJ P,PPBCK ;PUT A GLOBAL BLOCK WITH NO SYMS AT END.
4711 SSYMG4: MOVE A,B ;ABS ASSEMBLY, OUTPUT CHKSUM.
4713 SSYMG3: SUB P,[2,,2]
4714 PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK
4715 SKIPL A,CONTRL ;RELOCATABLE => OUTPUT PROG NAME.
4721 TRNE A,DECREL ;DEC FMT => OUTPUT END BLOCK.
4723 MOVE A,STARTA ;NOW GET STARTING INSTRUCTION
4724 JRST PPB ;PUNCH IT OUT AND RETURN
4726 ;PUT INTO BKTAB1 THE BKTAB IDXS OF ALL THE BLOCKS IN THE ORDER THEIR
4727 ;SYMS SHOULD BE PUNCHED (A BLOCK'S SUBBLOCKS PRECEDE IT)
4728 BKSRT: MOVEI D,BKTAB1-1 ;D IS FOR PUSHING INTO BKTAB1.
4729 MOVSI A,1 ;START WITH BLOCK 0 (OUTERMOST, .INIT).
4730 BKSR1: SETZ C, ;HANDLE BLOCK IN A: LOOK FOR ITS SUBBLOCKS.
4731 BKSR2: CAME A,BKTAB+1(C)
4732 JRST BKSR3 ;THIS BLOCK ISN'T A SUBBLOCK.
4733 ADD A,[1,,] ;LH HAS SUBBLOCK'S LEVEL.
4734 HRRI A,(C) ;RH HAS SUBBLOCK.
4735 PUSHJ P,BKSR1 ;HANDLE THE SUBBLOCK
4741 JUMPE C,CPOPJ ;DON'T PUT .INIT BLOCK IN BKTAB1.
4742 PUSH D,C ;PUT THE BLOCK IN BKTAB1 (AFTER SUBBLOCKS)
4745 PPBCK: ROT B,1 ;OUTPUT WD IN A, UPDATING CKSUM IN B.
4751 BKCNT0: SETZM BKTAB+2(C) ;ZERO 3RD WD OF EACH BKTAB ENTRY.
4755 BKCNT1: MOVE C,ST+2(B)
4756 SOS BKTAB+2(C) ;ADD -2 FOR EACH SYM IN THE BLOCK.
4763 SSRTX: HRLM B,(P) ;DO ONE PASS OF RADIX-EXCHANGE. SAVE END.
4764 CAIL A,@WPSTEB ;ONLY 1 ENTRY, NOTHING TO DO.
4766 PUSH P,A ;SAVE START.
4768 JRST SSRTX4 ;MOVE UP TO 1ST WITH BIT ON.
4770 XCT C ;MOVE DOWN TO LAST WITH BIT OFF.
4776 MOVE D,.RPCNT(A) ;EXCHANGE THEM,
4780 SSRTX5: CAME A,B ;ALL DONE => DO NEXT BIT.
4781 JRST SSRTX3 ;MORE IN THIS PASS.
4782 ROT CH2,-1 ;NEXT BIT DOWN.
4783 POP P,A ;A -> START, B -> END OF 1ST HALF.
4784 JUMPL CH2,SSRTX6 ;ALL BITS IN WD DONE, STOP.
4785 PUSHJ P,(AA) ;DO NEXT BIT ON 1ST HALF.
4786 HLRZ B,(P) ;A -> END OF 1ST HALF, B -> END OF ALL.
4787 PUSHJ P,(AA) ;DO SECOND HALF.
4788 SSRTX6: ROT CH2,1 ;LEAVE CH2 AS FOUND IT.
4789 SSRTX7: HLRZ A,(P) ;LEAVE A -> END OF AREA SORTED.
4792 ;ARITHMETIC CONDITIONALS (B HAS JUMP<COND> A,)
4794 COND: PUSH P,B ;SAVE CONDITIONAL JUMP
4795 PUSHJ P,AGETFD ;GET FIELD TO TEST VALUE OF
4796 CONDPP: POP P,T ;RESTORE CONDITIONAL JUMP INSTRUCTION
4797 HRRI T,COND2 ;HRRI IN JUMP ADDRESS, GO TO COND2 IF CONDITIONAL TRUE
4798 XCT T ;JUMP IF COND T,ASSEMBLE STRING
4799 COND4: SETZM A.SUCC ;MOST RECENT CONDIT. FAILED.
4800 COND5: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WHAT PSEUDO WE'RE IN.
4802 JSP D,RARL4 ;INIT FOR THE CONDITIONALIZED STUFF.
4804 CALL RARFLS ;READ AND IGNORE THE ARG.
4807 ANULL: TLO FF,FLUNRD
4810 ;.ELSE, .ALSO - B'S LH WILL HAVE SKIPE OR SKIPN.
4811 A.ELSE: HRRI B,A.SUCC
4813 JRST COND4 ;CONDITION FALSE.
4816 ;IF1, IF2 - B'S LH WILL HAVE TRNE FF, OR TRNN FF,
4817 COND1: HRRI B,FRPSS2
4820 ;CONDITION TRUE, ASSEMBLE STRING
4821 COND2: SETOM A.SUCC ;LAST CONDITIONAL SUCCEEDED.
4822 COND6: PUSHJ P,RCH ;GET NEXT CHAR
4824 JRST [ CAIE A,LBRACE
4827 SKIPN SCNDEP ;BRACKET TYPE CONDITIONAL.
4830 MOVEMM CONDLN,CLNN ;AT TOP LEVEL, SAVE IN CASE THIS UNTERMINATED
4832 IFN TS, MOVEMM CONDFI,INFFN1
4833 COND7: AOS SCNDEP ;COUNT IT FOR RBRAK'S SAKE.
4838 SBCND: PUSH P,B ;SAVE TEST JUMP
4839 SETZB B,C ;C COUNTS SQUOZE CHARS FOR IFB/IFNB
4840 ;B COUNTS NONSQUOZE FOR IFSQ/IFNSQ
4841 JSP D,RARG ;INIT FOR READING OF ARG WHOSE BLANKNESS
4842 JRST CONDPP ;IS TO BE TESTED.
4843 JSP D,RARGCH(T) ;READ 1 CHAR,
4844 JRST CONDPP ;(NO MORE CHARS)
4845 HLRZ A,GDTAB(A) ;GET GDTAB ENTRY
4846 CAIE A,(POPJ P,) ;POPJ => NOT SQUOZE
4853 PUSH P,B ;SAVE CONDITIONAL JUMP
4854 PUSHJ P,GETSLD ;GET NAME
4857 MOVEI A,0 ;UNDEFINED
4858 IFN CREFSW,XCT CRFINU
4859 CAIN A,GLOEXT_-14. ;GLOBAL EXIT...
4860 SKIPL CONTRL ;DURING ABSOLUTE ASSEMBLY?
4861 CAIN A,3 ;NO, LOCAL UNDEF?
4862 MOVEI A,0 ;ONE OF THESE => UNDEF
4864 EXCH SYM,(P) ;POP SYM OUT FROM UNDER THE CONDITIONAL JUMP.
4867 ;;PWRD ;ROUTINES TO OUTPUT ASSEMBLES WORDS AND PORTIONS THEREOF
4869 ;HERE FROM PBITS TO OUTPUT WORD OF CODE BITS
4873 MOVEM A,PBITS2 ;INITIALIZE PBITS2 FOR COUNTING DOWN THROUGH NEXT SET OF CODE BITS
4874 MOVE A,[440300,,PBITS1]
4875 MOVEM A,BITP ;SET UP BITP FOR RELOADING PBITS1 WITH CODE BITS
4876 MOVE A,PBITS1 ;NOW GET ACCUMULATED WORD OF BITS
4877 MOVEM A,@PBITS4 ;STORE IN BKBUF
4878 AOS A,OPT1 ;RESERVE SPACE FOR NEW WORD
4879 ;IF FRBIT7 SET (LAST CALL TO PBITS HAD 7) THEN NEXT WORD OF CODE BITS GOES
4880 ;AFTER NEXT WORD OUTPUT (REALLY!), OTHERWISE BEFORE
4888 ;OUTPUT RELOCATION CODE BITS IN A
4890 PBITS: SKIPGE CONTRL
4891 POPJ P, ;NOT RELOCATABLE
4893 JRST PBITS3 ;NO MORE ROOM IN WORD, OUTPUT IT AND TRY AGAIN
4900 ;FOLLOWING ROUTINES SAVE AC'S EXCEPT FOR A
4902 OUTSM0: MOVE A,SYM ;OUTPUT NAME STINK KNOWS SYMBOL BY.
4903 TLZ A,37777 ;FOR LOCALS, THAT'S THE STE ADDR,
4905 TLNN SYM,40000 ;FOR GLOBALS, THAT'S THE SQUOZE.
4909 $OUTPT: SKIPGE CONTRL ;DIRECTLY PUNCH OUT WORD IN A IN RELOCATABLE ASSEMBLY ONLY
4910 POPJ P, ;DO NOTHING IF ABSOLUTE ASSEMBLY
4913 TRZN FF,FRINVT ;SKIP IF BEING HACKED FROM PBITS3, PUT WORD BEFORE WHERE IT NORMALLY BELONGS
4926 ;END CURRENT OUTPUT BLOCK
4933 JUMPGE T,EBLK3 ;JUMP IF RELOCATABLE ASSEMBLY
4938 JRST FASLE ;FASL HAS NO BLOCKS TO END - IGNORE
4944 EBLK3: MOVE T,PBITS1
4948 MOVE T,[440300,,PBITS1]
4953 MOVE B,OPT1 ;GET POINTER TO END OF BLOCK
4954 SUBI B,BKBUF+1 ;CONVERT TO # WORDS IN BLOCK (EXCLUDING HEADER)
4955 DPB B,[220700,,BKBUF] ;SET COUNT FIELD IN HEADER
4957 JUMPLE B,EBLK5 ;IGNORE NULL BLOCK UNLESS FRLOC SET
4958 TLO FF,FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING)
4960 EBK1: CAML T,OPT1 ;DONE WITH BLOCK?
4962 MOVE A,(T) ;NO, GET DATA WORD
4963 JFCL 4,.+1 ;UPDATE CHECKSUM
4965 JFCL 4,[AOJA TT,.+1]
4966 PUSHJ P,PPB ;OUTPUT WORD
4968 EBK2: SETCM A,TT ;DONE OUTPUTTING BLOCK, NOW GET CHECKSUM
4969 PUSHJ P,PPB ;OUTPUT CHECKSUM
4970 MOVE T,CDATBC ;GET BLOCK TYPE
4971 DPB T,[310700,,BKBUF] ;SET NE T BLOCK TYPE TO STORAGE WORDS BLOCK TYPE
4974 EBLK4: TLO FF,FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING)
4975 EBLK5: TRO FF,FRFIRWD
4982 ;PUNCH OUT WORD OF CODED DATA (E.G. STORAGE WORD); WRD, WRDRLC, GLOTB ENTRIES
4984 PWRDA: TROA FF,FRNLIK ;SUPPRESS ADR LINKING
4985 PWRD: TRZ FF,FRNLIK ;PERMIT ADR LINKING
4986 JUMPGE FF,CPOPJ ;IGNORE IF NOT PUNCHING PASS
4989 JRST PWRDL ;NOT MAKING LISTING NOW.
5000 DPB LINK,[220100,,LISTAD]
5004 JRST PWRD1 ;ABSOLUTE ASSEMBLY
5005 ;RELOCATABLE ASSEMBLY
5006 PUSHJ P,$RSET ;CHECK VALIDITY OF RELOCATION, STANDARDIZE IF NON-STANDARD
5009 JRST PWRD2 ;NO GLOBALS
5011 ;NOW TO SEE IF IT'S POSSIBLE OR DESIRABLE TO ADDRESS LINK
5015 JUMPN B,PWRD3 ;JUMP IF RH NON-ZERO
5018 JRST PWRD3 ;ADR LINKING SUPPRESSED OR CLOC GLOBAL
5020 JRST PWRD3 ;IN LOAD TIME CONDITIONALS
5021 MOVNI T,1 ;INITIALIZE T FOR COUNTING
5024 HRRZ TT,1(A) ;GET GLOTB ENTRY
5026 LDB TT,[400400,,(TT)] ;GET SQUOZE FLAGS FROM SYM
5029 JRST PWRD3 ;DEFINED, BUT MUST BE HERE FOR A REASON (SEE $.H)
5032 JRST PWRD3 ;NEGATED OR MULTIPLIED
5037 JRST PWRD3 ;NOT HIGH AC
5038 PWRD7A: AOJA A,PWRD4
5039 PWRD7: TRNE TT,SWAPF
5040 AOJA A,PWRD4 ;LEFT HALF
5041 AOJN T,PWRD3 ;JUMP IF THIS NOT FIRST GLOBAL IN RIGHT HALF
5042 MOVEI D,1(A) ;FIRST GLOBAL, SET UP POINTER TO GLOTB ENTRY
5045 PWRD5: AOJE T,PWRD3 ;NO GLOBALS LOOK BAD AND THERE AREN'T TOO MANY; JUMP IF NONE IN RH
5046 HRRZ T,(D) ;GET ADR OF SQUOZE
5047 SKPST T, ;SKIP IF IN SYMBOL TABLE
5048 JRST PWRD3 ;BELOW SYMBOL TABLE, DON'T ADDRESS LINK AFTER ALL
5049 PUSH P,T ;HOORAY, WE CAN ADDRESS LINK
5050 SETZM (D) ;CLEAR OUT GLOTB ENTRY, DON'T NEED IT ANY MORE
5051 PUSHJ P,PWRD31 ;DUMP OUT THE OTHER GLOBALS
5052 POP P,D ;GET ST ADR OF THIS AGAIN
5054 LDB A,[.BP (3RLNK),A]
5057 TRO A,2 ;RELOCATE LEFT HALF
5058 PUSHJ P,PBITS ;PUNCH OUT APPROPRIATE BITS FOR LINK LIST ENTRY
5059 HLR A,1(D) ;GET ADR OF LAST
5061 PUSHJ P,$OUTPT ;OUTPUT WORD WITH RH = ADR OF LAST RQ FOR SYM TO PUT IN RH'S
5062 MOVE A,CLOC ;NOW UPDATE ST ENTRY
5066 TLZA B,3RLNK ;CLOC NOT RELOCATED LAST TIME THIS SYM USED
5067 TLO B,3RLNK ;RELOCATED
5071 PWRD31: MOVE T,GLSP2 ;DUMP ALL GLO S IN GENERAL FORMAT
5072 PWRD3A: CAML T,GLSP1
5079 RPWRD1: LDB A,[.BP (MINF),B]
5082 MOVE A,(B) ;CODEBITS +SQUOZE FOR SYM
5086 TLOA A,40000 ;SYM IS GLO
5087 JRST [ MOVEI C,(B) ;IF WE ARE OUTPUTTING A REFERENCE TO THE
5088 CAIL C,PCNTB ;"LABEL" AT THE BEGINNING OF A CONSTANTS AREA
5089 CAIL C,PCNTB+NCONS*3 ;(BECAUSE THIS IS A 1PASS ASSEMBLY) USE THE
5090 MOVEI A,(B) ;NAME, SINCE THE SYMBOL ISN'T IN THE
5095 JRST PWRD3E ;AC HIGH OR LOW
5097 JRST PWRD3F ;ALL THROUGH
5101 PWRD3F: PUSHJ P,$OUTPT
5106 RPWRD: PUSHJ P,PBITS7
5113 PWRD3E: TLO A,300000
5116 PWRD3: PUSHJ P,PWRD31
5117 PWRD2: PUSHJ P,RCHKT
5123 ;CHECK FOR VALIDITY OF RELOCATION BITS OF CURRENT WORD
5124 ;LEAVE RELOC (RH) IN B, RELOC (LH) IN T
5126 RCHKT: HRRZ B,WRDRLC ;CHECK FOR RELOC. OTHER THAN 0 OR 1.
5130 RLCERR: ETSM [ASCIZ /Illegal relocation/]
5135 TLZ C,3DFCLR ;SET RELOC BITS IN C
5136 IOR C,T ;FROM B AND T.
5139 ;CHECK WRDRLC FOR VALIDITY (CAPABILITY OF BEING PUNCHED OUT)
5140 ;IF STANDARD THEN JUST RETURN
5141 ;IF NON-STANDARD BUT OTHERWISE OK, PUT $R. ON GLOBAL LIST, RESET WRDRLC, AND RETURN
5142 ;LEAVES B AND C SET UP WITH RH, LH OF WRDRLC.
5144 $RSET: MOVE C,WRDRLC ;GET RELOCATION
5145 ADDI C,400000 ;WANT TO SEPARATE HALFWORDS
5146 HLRE B,C ;GET LH IN B
5147 HRREI C,400000(C) ;GET RH IN C (WILL EXCHANGE LATER)
5148 MOVE A,[SWAPF+HFWDF,,$R.H] ;PUT THIS ON GLOBAL LIST IF LH NEEDS $R.
5150 PUSHJ P,$RSET1 ;LH NEEDS GLOBAL REFERENCE
5154 PUSHJ P,$RSET1 ;RH NEEDS GLOBAL REFERENCE
5155 HRLZM C,WRDRLC ;RELOC OF LH
5156 ADDM B,WRDRLC ;COMPLETE SETTING UP WRDRLC
5159 $RSET1: JUMPGE B,$RSET2 ;STRANGE RELOCATION IN B, JUMP IF NON-NEGATIVE
5160 MOVN T,B ;NEGATIVE, GET MAGNITUDE
5161 TLOA A,MINF ;SET FLAG TO NEGATE GLOBAL
5162 $RSET2: SOSA T,B ;POSITIVE, GET ONE LESS THAN IT IN T
5163 TDZA B,B ;NEGATIVE, CLEAR B, RELOCATION LEFT OVER
5164 MOVEI B,1 ;POSITIVE, SET RELOCATION LEFT OVER TO 1
5166 MOVEI T,0 ;MULTIPLYING BY TWO OR SUBTRACTING TIMES 1
5168 ETSM [ASCIZ /Relocation too large/] ;TOO BIG EVEN FOR $RSET
5169 DPB T,[221200,,A] ;LOOKS OK, STORE TIMES FIELD IN $R. REFERENCE
5170 AOS GLSP1 ;NOW PUT $R. ON GLOBAL LIST
5174 ;PWRD DURING ABSOLUTE ASSEMBLY
5176 PWRD1: TRNE LINK,DECREL ;DEC FMT IS CONSIDERED ABSOLUTE.
5180 JRST FASPW ;SO IS FASL
5184 ETR ERRILG ;GLOBALS APPEARING ILLEGALLY
5186 ETR ERRIRL ;RELOCATION APPEARING ILLEGALLY
5189 SBLKS1: MOVE A,WRD ;SBLK
5190 MOVEM A,@OPT1 ;STORE WRD IN BKBUF
5193 MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER
5196 POPJ P, ;BKBUF NOT FULL YET
5198 SBLKS2: SUBI A,BKBUF+1
5215 SBLK2: TRO FF,FRFIRWD
5223 JRST EBLK5 ;AVOID SETTING FLOUT IF NULL BLOCK.
5227 PRIM: MOVSI A,(DATAI PTR,)
5233 ;END A BLOCK IN DEC FMT. COME FROM EBLK.
5234 DECEBL: PUSH P,[EBLK5]
5235 DECEB1: MOVSI A,DECWDS ;JUST INIT. AN ORDINARY BLOCK,
5237 ;COME HERE TO OUTPUT PREVIOUS BLOCK AND START NEW BLOCK OF TYPE IN LH OF A.
5239 HRRZ A,BKBUF ;GET DATA-WORD COUNT OF CURRENT BLOCK.
5240 JUMPE A,DECB1 ;NO WORDS => CAN IGNORE.
5242 DECB0: MOVE A,-1(TT) ;GET AND PUNCH NEXT WD OF BLOCK.
5244 CAME TT,OPT1 ;STOP WHEN NEXT WD ISN'T IN BLOCK.
5247 HLLZM A,BKBUF ;PUT BLOCK TYPE IN LH OF HEADER, DATA WD COUNT IN RH IS 0.
5248 MOVEI TT,BKBUF+2 ;ADDR OF PLACE FOR 1ST DATA WD
5249 MOVEM TT,OPT1 ;(LEAVE SPACE FOR WD OF RELOC BITS)
5250 MOVE TT,[440200,,BKBUF+1]
5251 MOVEM TT,BITP ;BP FOR STORING PAIRS OF RELOC BITS.
5252 SETZM BKBUF+1 ;CLEAR THE WD OF RELOC BITS.
5256 ;COME HERE TO OUTPUT A WORD IN DEC FORMAT.
5258 CAIE A,DECWDS ;BEFORE THE 1ST STORAGE WD IN ORDINARY BLOCK,
5260 MOVE A,CRLOC ;MUST GO THE LOCATION CTR.
5265 AOS BKBUF ;IT COUNTS AS DATA WORD.
5267 TLNE A,77^4 ;IF NO ROOM FOR MORE RELOC BITS,
5269 HLLZ A,BKBUF ;START A NEW BLOCK.
5273 DECPW1: PUSHJ P,$RSET ;SET UP RELOC BITS OF HALVES IN B,C.
5275 IORI B,(C) ;COMBINE THEM.
5278 JRST DECPG ;GO HANDLE GLOBALS.
5279 DECPW3: IDPB B,BITP ;STORE THE RELOC BITS
5281 DECPW2: MOVEM A,@OPT1 ;AND THE VALUE.
5286 ;PUT A WORD DIRECTLY INTO DEC FMT BLOCK.
5288 DECWR1: IDPB TM,BITP ;SKIP A PAIR OF RELOC BITS,
5289 JRST DECPW2 ;STORE THE WORD.
5291 ;HANDLE GLOBAL REFS IN DEC FMT.
5292 DECPG: PUSHJ P,DECPW3 ;FIRST, OUTPUT THE WORD,
5293 DECPG0: MOVSI A,DECSYM
5294 PUSHJ P,DECBLK ;THEN STRT A SYMBOLS BLOCK.
5297 DECPG1: CAMN C,GLSP1 ;ALL DONE =>
5298 JRST DECPG2 ;GO START AN ORDINARY BLOCK FOR NEXT WD.
5300 TLNN A,77^4 ;BLOCK FULL => START ANOTHER.
5302 AOS C,GLSP2 ;GET ADDR OF NEXT GLOBAL REF.
5304 MOVE B,(B) ;GET NAME OF SYM.
5306 CAMN B,[SQUOZE 0,$R.]
5307 JRST DECPG3 ;(DEC'S LOADER HAS NO SUCH HACK.)
5308 CALL ASQOZR ;RIGHT-JUSTIFY THE SQUOZE FOR DEC SYSTEM.
5310 TLO A,600000 ;PUT IN FLAGS SAYING ADDITIVE GLOBAL RQ.
5311 PUSHJ P,DECWRD ;OUTPUT NAME.
5312 HRRZ A,CLOC ;GET ADDR OF RQ,
5313 TLO A,400000 ;MACRO-10 SETS THIS BIT SO I WILL.
5315 TLNE B,SWAPF ;SWAPPED => TELL LOADER..
5318 ETSM ERRILG ;CAN'T NEGATE GLOBAL OR PUT IN AC.
5320 PUSHJ P,DECWR1 ;OUTPUT 2ND WD,
5321 JRST DECPG1 ;GO BACK FOR MORE GLOBAL REFS.
5326 DECPG3: ETR ERRIRL ;WE NEEDED $R. BUT DIDN'T HAVE IT.
5329 ERRILG: ASCIZ /Illegal use of external/
5330 ERRIRL: ASCIZ /Illegal use of relocatables/
5333 ;OUTPUT PROGRAM NAME BLOCK (AT START OF PASS 2)
5334 ;IF 2-SEG PROGRAM, ALSO OUTPUT A TYPE-3 BLOCK (LOAD INTO HISEG)
5335 DECPGN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2.
5343 MOVSI A,14 ;IDENTIFY THIS REL FILE AS MADE BY MIDAS.
5347 RET ;NOT A 2-SEG PROGRAM.
5348 DECP2S: MOVSI A,DECHSG
5349 CALL DECBLK ;START A LOAD-INTO-HISEG BLOCK.
5351 HRL A,DECBRH ;HISEG BRK,,TWOSEG ORIGIN.
5354 MOVEI TM,1 ;RELOCATION IS 1.
5358 ;INITIALIZE OUTPUT FOR FASL ASSEMBLY
5359 FASOIN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2
5360 MOVE A,[SIXBIT /*FASL*/]
5365 PUSHJ P,PPB ;"LISP" VERSION NUMBER (USE M AND MIDAS NUMBER)
5366 MOVE A,[440400,,FASB] ;INITIALIZE FASL OUTPUT BUFFER
5373 ;COME HERE TO OUTPUT A WORD IN FASL FORMAT
5374 FASPW: MOVE C,FASPCH
5376 PUSHJ P,FPATB ;"PUNCH" OUT ATOM TBL (IF MORE HAS APPEARED)
5377 PUSHJ P,$RSET ;GET RELOC
5378 PUSH P,C ;SAVE LH RELOC
5379 MOVEM B,FASPWB ;B HAS RELOC, WHICH IS ALSO FASL CODE FOR RELOC =1
5381 FASPW3: CAME A,GLSP1
5382 JRST FASPW1 ;LOOK TO SEE ..
5383 FASPW2: MOVE A,WRD ;B HAS RELOC, WHICH ALSO HAPPENS TO BE FASL CODE TYPE
5385 PUSHJ P,FASO ;OUTPUT WORD IN A WITH FASL CODE IN B
5387 JUMPE TM,FASPW5 ;NO LEFT HALF RELOC, OK
5388 MOVNI A,1 ;ACTIVATE FASL HACK FOR LH RELOC
5389 MOVEI B,7 ;WOULD OTHERWISE BE GETDDTSYM
5391 FASPW5: MOVE C,GLSP2
5392 FASPW6: CAMN C,GLSP1
5395 JUMPE TM,[AOJA C,FASPW6]
5396 MOVE SYM,(TM) ;GET SQUOZE OF SYM
5397 TLZ SYM,740000 ;CLEAR CODE BITS
5399 TRZ D,400000 ;DONT WORRY ABOUT THAT BIT
5401 TLO SYM,400000 ;NEGATE
5409 ETSM [ASCIZ /Global in illegal FASL context/]
5411 FSPWWD: TLOA SYM,140000
5412 FSPWAC: TLOA SYM,100000
5413 FSPWRH: TLO SYM,40000
5419 FASPW1: HRRZ TM,1(A) ;GLOTB ENTRY
5423 FASPW4: AOJA A,FASPW3
5424 MOVE C,1(A) ;ITS A LIST STRUCTURE REF
5427 ETA [ASCIZ /Illegal LISP structure reference/]
5428 MOVE TM,AFDMY2-AFDMY1(TM) ;GET FASL BITS
5429 MOVEM TM,FASPWB ;FASL BITS
5430 CLEARM 1(A) ;FLUSH THAT GUY
5433 FPATB: CAMN C,FASATP ;PUNCH OUT ATOM TBL, AMT ALREADY PUNCHED IN C
5435 MOVEI B,12 ;ATOM TBL INFO
5438 AOJA C,FPATB3 ;LIST WORD .. SHOULD HAVE PUNCHED ITSELF
5440 HRRZ D,FASAT(C) ;ATOM "LENGTH"
5442 FPATB1: SOJL D,FPATB2
5447 FPATB3: ETR [ASCIZ /Internal loss at FPATB3/]
5448 FPATB2: MOVEM C,FASPCH ;RECORD AMOUNT PUNCHED
5449 JRST FPATB ;LOOP BACK IF MORE
5452 FASO: PUSHJ P,FASBO ;WRITE BITS
5453 FASO1: MOVEM A,@FASBP ;STORE A IN FASL OUTPUT BUFFER
5456 ETF [ASCIZ /.FASL output block too long/]
5459 FASBO: MOVE TM,FASCBP ;OUTPUT FASL CODEBITS IN B, WRITE PREV BLOCK IF NECC
5461 PUSHJ P,FASBE ;WRITE PREV FASL BLOCK
5468 FASBO2: CAML TT,FASBP
5476 CLEARM FASB ;NEW CODE WORD
5483 AFATOM: PUSH P,B ;SAVE CODEBITS
5486 ETI [ASCIZ /.ATOM illegal except in FASL assembly/]
5487 PUSHJ P,AFRATM ;READ "ATOM", RETURN INDEX IN A
5491 MOVEI T,AFDMY1(B) ;DUMMY (STORE THIS INFO IN SYM SO CONSTANTS WILL WIN
5493 MOVEI B,0 ;NO RELOCATION
5496 ;GLOBALS IN THIS TABLE KEEP TRACK OF LIST REFS
5497 ;UNDEF GLOBAL GODEBITS
5498 AFDMY1: SQUOZE 44,.%VCEL ;EVENTUALLY POINT TO VALUE CELL
5499 SQUOZE 44,.%SCAL ;EVENTUALLY BECOME "SMASHABLE CALL"
5500 SQUOZE 44,.%ATM ;EVENTUALLY POINT TO ATOM
5501 SQUOZE 44,.%ARY ;EVENTUALLY POINT TO ARRAY
5502 AFDMY2: 2 ;CODE BITS FOR VALUE CELL REF
5503 3 ;CODE BITS FOR SMASHABLE CALL
5504 4 ;CODE BITS FOR POINTER TO ATOM
5505 10 ;CODE BITS FOR POINTER TO ARRAY
5507 AFRATM: PUSHJ P,AFRTKN ;READ TOKEN, LEAVING IT AT END OF FASAT
5508 PUSHJ P,AFRITN ;"INTERN" IT, SKIP IF NOT FOUND
5509 POPJ P, ;IF FOUND, INDEX IN A
5510 PUSHJ P,AFRENT ;ENTER IN FASAT
5513 AFRENT: MOVE A,FASAT1 ;STORE FASAT1 IN FASATP
5515 AOS A,FASIDX ;RETURN LOAD TIME ATOM INDEX
5518 AFRTKN: MOVE A,FASATP
5520 MOVEM A,FASAT2 ;BYTE PNTR TO USE TO STORE ATOM
5522 CLEARM 1(A) ;MAKE SURE ALL LOW BITS CLEARED
5525 JRST AFRTK1 ;READ NUMBER INTO FIXNUM SPACE
5527 JRST AFRTK2 ;READ NUMBER INTO FLONUM SPACE
5528 AFRTKL: IDPB A,FASAT2 ;STORE CHAR
5530 CAIL A,FASAT+FASATL-1
5531 AFTERR: ETA [ASCIZ /LISP atom name table full/]
5535 JRST AFRTL2 ;IGNORE LF IN ATOM NAMES (PRIMARILY SO /CR WINS WITH ONE
5537 JRST AFRQT ;QUOTE CHAR
5547 JRST AFRTKL ;THAT CHAR WINS, SALT IT
5549 AFRQT: PUSHJ P,RCH ;TAKE NEXT CHR NO MATTER WHAT
5552 AFRTK1: SKIPA TM,[100000,,1] ;PUT VAL IN FIXNUM SPACE
5553 AFRTK2: MOVE TM,[200000,,1] ;PUT IT IN FLONUM SPACE
5555 MOVE SYM,[SQUOZE 0,ATOM]
5567 AFREN2: TLO FF,FLUNRD ;SAVE ( OR ) AS WELL AS FLUSHING
5568 AFREND: MOVEI B,5 ;PAD END OF P.N. WITH 0 S
5570 AFREN1: IDPB TM,FASAT2
5572 CAIL A,FASAT+FASATL-1
5577 MOVEM A,FASAT1 ;STORE PNTR TO WORD BEYOND ATOM
5578 ; MAYBE PUT THIS IN FASATP
5579 MOVE B,FASATP ;ADR OF START OF ATOM READ
5580 SUBI A,1(B) ;COMPUTE LENGTH OF FASAT
5581 HRRZM A,FASAT(B) ;PN ATOM 4.8-4.7 =0 STORE LENGTH IN HEADER WD
5585 AFRITN: MOVEI B,0 ;"INTERN" LAST ATOM READ IN
5586 MOVEI A,1 ;A CONTAINS RUNTIME ATOM TBL INDEX
5587 ;B INDEX WITHIN FASAT
5588 AFRIT1: CAML B,FASATP
5589 JRST POPJ1 ;NOT FOUND
5590 MOVE C,FASATP ;POINTS AT HEADER OF WORD OF NEW (?) ATOM
5591 HRRZ D,FASAT(B) ;HEADER WD OF GUY IN TBL(RIGHT HALF HAS LENGTH)
5592 JUMPE D,AFRIT4 ;JUMP ON RESERVED FOR LIST
5593 AFRIT2: MOVE TM,FASAT(C)
5595 AOJA B,AFRIT3 ;THIS ONE LOSES
5596 SOJL D,CPOPJ ;THIS ONE WINS!
5600 AFRIT3: SOJL D,[AOJA A,AFRIT1] ;FINISH SPACING OVER THIS GUY
5601 AFRIT4: AOJA B,AFRIT3
5603 AFENTY: SKIPGE B,CONTRL
5605 ETI [ASCIZ /.ENTRY in NON-FASL/]
5607 ETI [ASCIZ /.ENTRY when . is absolute/]
5608 PUSHJ P,AFRATM ;READ FUNCTION NAME
5611 PUSHJ P,AFRATM ;READ TYPE (SUBR, LSUBR, ETC)
5613 MOVE SYM,[SQUOZE 0,.ENTRY]
5614 PUSHJ P,FAGTFD ;READ ARGS PROP
5615 JUMPGE FF,ASSEM1 ;NOT PUNCHING PASS
5619 PUSHJ P,FPATB ;MAKE SURE ANY NEW ATOMS OUT
5629 AFLIST: HLRZM B,AFLTYP
5632 ETI [ASCIZ /.LIST illegal except in FASL assembly/]
5633 PUSHJ P,AFRLST ;READ LIST, RTN ATM TBL INDEX IN A
5635 JRST ASSEM1 ;JUST EVAL IN LISP AND THROW AWAY VALUE
5636 MOVEI B,AFDMAI ;"ATOM" INDEX IN AFDMY1 TBL
5637 JRST AFLST1 ;TREAT AS ATOM
5639 AFRLST: CLEARM AFRLD ;"DEPTH"
5640 CLEARM AFRLEN ;"LENGTH" OF LIST AT CURRENT LEVEL
5641 CLEARM AFRDTF ;DOT CONTEXT FLAG
5645 PUSHJ P,FPATB ;MAKE SURE ALL ATOMS "PUNCHED"
5647 MOVEM A,AFRFTP ;SAVED STATE OF FASAT POINTER
5649 MOVEI B,16 ;EVAL TYPE HACK
5651 MOVEI B,5 ;LIST TYPE HACK
5652 PUSHJ P,FASBO ;WRITE CODE BITS
5655 CAIE A,40 ;PREV ATOM (OR WHATEVER) "DELIMITED", SO THESE MEANINGLESS
5656 CAIN A,15 ;UNLESS AT TOP LEVEL AND HAVE READ SOMETHING
5669 JRST AFRNXT ;READ NEXT GUY THIS LVL
5671 AFRLO2: ETI [ASCIZ /LISP read context error/]
5672 AFRNXT: SKIPN TM,AFRDTF
5673 JRST AFRNX2 ;NOT HACKING DOTS, OK
5676 JRST AFRLO2 ;DIDNT JUST SEE THE DOT
5677 AFRNX2: PUSHJ P,AFRATM
5678 JUMPGE FF,AFRNX1 ;XFER ON NOT PUNCHING PASS
5679 PUSHJ P,FASO1 ;TELL LOADER TO PUSH THIS ON ITS STACK
5680 AFRNX1: AOS AFRLEN ;LIST NOW ONE LONGER THIS LVL
5683 AFRLO: SKIPN TM,AFRDTF
5684 JRST AFRLO3 ;NOT HACKING DOTS
5687 JRST AFRL1 ;IGNORE BOTH . AND (
5688 AFRLO3: SKIPE AFRLD ;(
5692 AFRLO1: PUSH P,AFRLEN
5693 CLEARM AFRLEN ;START NEW LVL
5694 AOS AFRLD ;DEPTH NOW ONE GREATER
5697 AFRLC: SOSGE AFRLD ;)
5698 JRST AFRLO2 ;AT TOP LEVEL, BARF
5701 JRST AFRLC2 ;NOT HACKING DOTS
5704 SOS A ;MAIN LIST NOW ONE SHORTER
5705 TLOA A,200000 ;DOT WITH LAST THING ON STACK
5706 AFRLC2: TLO A,100000 ;TELL LOADER TO MAKE LIST THIS LONG
5709 AFRLC5: POP P,AFRLEN ;LENGTH AT PREV LVL
5710 AOS AFRLEN ;NOW ONE MORE
5711 CLEARM AFRDTF ;NOT HACKING DOTS NOW
5712 SKIPE AFRLD ;RETURNING TO TOP LEVEL?
5714 JRST AFRX1 ;YES THRU
5718 JRST AFRLO2 ;DOT IN FIRST POSITION OF LIST
5719 AOS AFRDTF ;ENTER STATE 1 OF DOT HACKING
5722 AFRL1A: SKIPN AFRLD ;SPACER CHAR TERMINATES AT TOP LVL IF HAVE RD SOMETHING
5725 AFRX1: JUMPGE FF,AFRX2 ;NOT PUNCHING PASS
5728 ETR [ASCIZ /Saw atoms in list on pass 2 for first time/]
5729 SKIPN B,AFLTYP ;TYP LIST OP
5731 MOVSI A,-2 ;PUT LIST OR VALUE OF LIST IN ATOM TBL
5732 PUSHJ P,FASO1 ;TERM OP AND PUT IT IN ATOM TBL
5735 JUMPE B,CPOPJ ;JUST WANT VALUE OF LIST
5736 CAIN B,1 ;ONLY WANT THIS FOR STRAIGHT LIST
5737 PUSHJ P,FASO1 ;OUTPUT "SXHASH" WORD
5739 CLEARM FASAT-1(A) ;RESERVE SLOT IN FASAT TBL
5740 MOVEM A,FASPCH ;SAY ALREADY PUNCHED OUT
5744 AFRX2: TLO I,ILNOPT ;DONT TRY TO OPTIMIZE IF IN CONSTANT
5748 \f ;.LIBRA, .LIFS, ETC.
5750 A.LIB: NOVAL ? NOABS
5751 HLRZM B,LIBTYP' ;STORE BLOCK TYPE TO OUTPUT
5752 CLEARM LIBOP ;INITIALIZE SQUOZE FLAGS
5753 PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK, MAKING SURE LOADER KNOWS $.
5754 LIB1: PUSHJ P,GETSYL ;GET NAME
5756 JRST LIB2 ;NO SYL, DON'T OUTPUT
5762 LIB2: MOVE B,CDISP ;GET CDISP
5763 TLNN B,DWRD\DFLD ;CHECK FOR WORD TERMINATOR
5764 JRST LIB3 ;WORD TERMINATOR => DONE
5766 MOVE B,LIMBO1 ;RETRIEVE LAST CHAR READ
5773 MOVEM A,LIBOP' ;STORE SQUOZE FLAGS (LESS GLBL BIT) FOR NEXT SYM
5776 LIB3: MOVE A,LIBTYP ;GET BLOCK TYPE TO OUTPUT
5777 DPB A,[310700,,BKBUF]
5779 CAIN A,LLIB ;.LIBRA?
5780 JRST ARELC1 ;.LIBRA, NOW PLAY LIKE RELOCA PSEUDO
5781 JRST LIB5 ;SOMETHING ELSE (.LIFS), INCREMENT DEPTH IN LOAD TIME CONDITIONALS
5783 A.ELDC: NOVAL ? NOABS
5786 DPB A,[310700,,BKBUF]
5787 TRO FF,FRLOC ;MAKE EBLK OUTPUT NULL BLOCK
5790 CLEARM LDCCC ;LOADER CONDITIONAL UNDERFLOW
5793 ;LOADER CONDITIONAL ON VALUE
5795 A.LDCV: NOVAL ? NOABS
5800 DPB B,[400300,,BKBUF]
5804 DPB A,[400300,,BKBUF]
5808 ;.GLOBAL, .SCALAR, .VECTOR
5809 ;LH(B) HAS ILGLI, ILVAR, ILVAR+ILFLO RESPECTIVELY.
5812 HLLZ LINK,B ;REMEMBER WHICH OF THE THREE PSEUDO'S THIS IS.
5813 A.GLO2: MOVE A,GLSPAS
5816 PUSHJ P,GETSLD ;GET NAME
5817 JRST MACCR ;NO NAME => DONE
5822 JSP B,GVPSEU ;TRYING TO .GLOBAL A PSEUDO => TYPE APPRO. ERR MSG AND RETURN.
5823 JRST A.GLO2 ;DON'T DO ANYTHING TO IT; MOVE ON TO NEXT ARG.
5825 A.GLO1: IOR I,LINK ;SET THE GLOBAL FLAG OR THE VARIABLE FLAG.
5826 TLNE LINK,ILFLO ;FOR .VECTOR, SAVE # VARS CREATED BEFORE CREATING THIS ONE.
5827 SAVE VARCNT ;SO WE CAN TELL IF THIS CALL TO GETVAL ACTUALY CREATES IT.
5828 PUSHJ P,GETVAL ;NOW GET VALUE (CLOBBERS SQUOZE FLAGS)
5833 SAVE LINK ;.VECTOR - READ THE SIZE.
5834 TLO FF,FLUNRD ;RE-READ THE TERMINATOR AFTER THE SYM, SO "FOO(1)" AND "FOO," WIN
5835 MOVE SYM,[SQUOZE 0,.VECTOR]
5838 REST B ;GET PREV. VARCNT, SO WE CAN SEE IF IT WAS INCREMENTED.
5839 TRNN A,-1 ;MAKE (N) WORK AS SIZE BY USIN L.H. IF R.H. IS 0.
5842 MOVEM A,VECSIZ ;IF NONZERO SIZE SPEC'D, USE IT AND SET DEFAULT.
5843 MOVE A,VECSIZ ;ELSE USE THE DEFAULT.
5844 SUBI A,1 ;1 WORD WAS ALLOCATED BY GETVAL - HOW MANY MORE WANTED?
5845 CAME B,VARCNT ;(MAYBE SYM ALREADY DEFINED, MAYBE PASS2, ...)
5846 ADDM A,VARCNT ;IF GETVAL REALLY ALLOCATED THE SPACE THIS TIME, ALLOCATE THE
5847 JRST A.GLO2 ;RIGHT AMOUNT.
5851 A.LOP: NOVAL ? NOABS
5852 PUSHJ P,EBLK ;TERMINATE CURRENT BLOCK
5853 REPEAT 3,PUSHJ P,RGETFD ;GET THE FIELDS
5860 A.LIBRQ: NOVAL ? NOABS
5861 A.LBR1: PUSHJ P,GETSLD
5870 A.LNKOT: AOS (P) ;THIS PSEUDO RETURNS NO VALUE.
5873 AEND5: JUMPGE FF,CPOPJ ;IGNORE FOLLOWING ON NOT PUNCHING PASS
5875 AEND5A: MOVE SYM,ST(D)
5883 AEND5C: ADD D,WPSTE1
5890 AEND5B: HLLZ B,ST+1(D)
5900 HRRZS ST+1(D) ;CLEAR OUT LIST HEAD POINTER.
5901 TLZ C,3RLNK ;INDICATE NO LIST.
5905 ;PUNCH OUT COMPLETE LOADER COMMAND, PUNCHING OUT WRD AS ONLY CONTENTS
5907 PLDCM: PUSH P,LINK ;SAVE LINK FOR ALOC AND FRIENDS (CLOBBERS OTHER AC'S)
5908 PUSH P,A ;SAVE LOADER COMMAND TYPE
5909 PUSHJ P,EBLK ;TERMINATE PREV BLOCK, MAKING SURE LOADER KNOWS $.
5910 PUSHJ P,PWRDA ;PUNCH OUT THE WORD
5911 POP P,A ;GET BACK LOADER COMMAND TYPE FOR PLDCN
5912 PUSHJ P,PLDCN ;OUTPUT THE RESULTING BLOCK
5913 PLINKJ: POP P,LINK ;RESTORE LINK
5916 PLDCN: HRRM A,BKBUF ;STORE LOADER COMMAND TYPE IN BKBUF HEADER
5917 MOVEI A,LLDCM ;LOADER COMMAND BLOCK TYPE
5918 DPB A,[310700,,BKBUF] ;STORE BLOCK TYPE IN HEADER
5919 TRO FF,FRLOC ;MAKE EBLK OUTPUT BLOCK EVEN IF EMPTY
5922 ;.RELP <ARG> RETURNS RELOCATION OF ARG
5927 ;.ABSP <ARG> RETURNS ABSOLUTE PART OF ARG.
5931 ;.RL1 IN RELOCATABLE ASSEMBLY RETURNS ZERO WITH RELOCATION FACTOR ONE.
5932 ;IN ABSOLUTE ASSEMBLY, IT RETURNS JUST ZERO.
5933 ;IFN <.RELP .RL1>, IS A TEST FOR A RELOCATABLE ASSEMBLY.
5934 A.RL1: SKIPGE A,CONTRL
5942 SKIPE ASMOUT ; ERROR IF IN GROUPING.
5943 JSP LINK,CONFLM ;FLUSH CONSTANTS, GIVE ERROR MSG.
5944 SKIPE SCNDEP ;IF THERE ARE UNTERMINATED SUCCESSFUL
5945 CALL AENDM1 ;CONDITIONALS, MENTION THEM.
5947 CAIE A,BKWPB ;NOT IN .MAIN BLOCK => ERROR.
5951 TLO FF,FLUNRD ;IF LAST TERM. WAS WORD TERM., RE-READ.
5953 MOVE A,[440700,,LISTBF]
5960 PUSHJ P,AEND5 ;RELOCATABLE => .LNKOT
5964 MOVE A,CLOC ;IN DEC FMT, UPDATE HIGHEST ADDR SEEN,
5965 SKIPN CRLOC ;UPDATE EITHER THE HIGHEST ABS ADDR
5966 JRST [ CAML A,DECBRA
5969 CAML A,DECTWO ;OR THE HIGHEST REL ADDR IN THE
5970 JRST [ CAML A,DECBRH ;APPROPRIATE SEG.
5975 AEND6: JUMPL FF,AEND1 ;ON PUNCHING PASS, SPECIAL STUFF
5976 PUSHJ P,GETWRD ;OTHERWISE EAT UP WORD,
5977 JRST RETURN ;AND RETURN
5986 MOVE SYM,[SQUOZE 0,END]
5997 PUSHJ P,LPTCLS ;DONE LISTING
6001 JRST AEND3 ;RELOCATABLE
6004 JRST FASEN ;FASL FORM
6006 TRNN B,DECREL ;IF DEC FORMAT,
6008 TLNN I,ILWORD ;THEN IF THERE7S A STARTING ADDRESS,
6010 MOVSI A,DECSTA ;OUTPUT START-ADDRESS BLOCK.
6021 HRRM A,BKBUF ;SET UP PROGRAM BREAK JUST IN CASE OUTPUTTING MORE NULL DATA BLOCKS
6026 AEND1A: TLNN A,777000 ;CHECK INSTRUCTION PART
6027 TLO A,(JRST) ;INSTRUCTION PART 0; HE WANTS JRST
6030 ETR [ASCIZ /Start instruction negative/]
6031 HRLI A,(JRST) ;END SYMTAB WITH POSITIVE WORD
6032 MOVEM A,STARTA ;SAVE FOR PUNCHOUT AT END OF SYMTAB
6034 AEND2: PUSH P,[RETURN]
6038 SKIPE CCLFLG ;IN DEC VERSION, IF RUN BY CCL, DON'T PRINT
6039 AOS TTYFLG ;THIS STUFF ON THE TTY - ONLY IN ERROR FILE AND LISTING.
6048 CNTP1: CAML TT,PBCONL
6055 TYPR [ASCIZ /Constants area inclusive
6058 LDB B,[.BP (CGBAL),2(TT)]
6060 TYPR [ASCIZ /Global+/]
6071 AENDM1: TYPR [ASCIZ /Unterminated successful bracketed conditionals
6080 TYPR [ASCIZ/ of file /]
6087 AXWORD: CALL XGETFD ;READ 1ST FIELD,
6089 CALL IGTXT ;SOAK UP REST OF TEXT PSEUDO.
6096 CALL XGETFD ;NOW THE SECOND FIELD
6106 A.NTHWD: CALL AGETFD ;READ THE NUMBER OF THE WORD WE WANT.
6107 SOJL A,CABPOP ;NEGATIVE OR 0 => RETURN 0.
6108 SOJL A,A.1STWD ;1 => TURN INTO .1STWD.
6109 ;ELSE SKIP APPRO. # OF WORDS, THEN DO .1STWD.
6118 JRST CABPOP ;IF STRING ENDS BEFORE DESIRED WORD, RETURN 0.
6121 A.1STWD: CALL XGETFD ;GET THE 1ST WD OF FOLLOWING TEXT PSEUDO,
6122 CALL IGTXT ;THROW AWAY THE REST.
6123 MOVE T,A ;RETURN THE VALUE
6124 JRST TEXT5 ;COMPLAINING IF FOLLOWED IMMEDIATELY BY SYLLABLE.
6126 A.LENGTH: CALL PASSPS
6135 JRST VALRET ;RETURN VALUE IN T
6138 PUSHJ P,AGETFD ;GET FIELD ARG
6140 JRST MACCR ;RETURN WITHOUT CLOBBERING CURRENT VALUE
6142 A.RADIX: CALL AGETFD ;READ THE TEMP. RADIX.
6143 SAVE ARADIX ;LAMBDABIND RADIX TO THAT VALUE.
6145 CALL XGETFD ;READ IN THE NEXT FIELD USING THAT RADIX.
6149 ;READ A BIT-MASK AS ARG, RETURN THE LH OF BP. FOR THAT BYTE.
6152 SKIPE CDISP ;IF ARG WAS ENDED BY A COMMA, TURN IT INTO A SPACE
6153 HRRM C,CDISP ;SO THAT .BP FOO,BAR USES THE FLD SPACE FLD FORMAT.
6158 EXCH B,(P) ;(P) HAS # LEADING ZEROS.
6160 AND A,B ;A HAS ONLY THE LOW BIT OF THE BYTE.
6162 MOVNI B,1 ;B HAS 35.-<# TRAILING ZREROS.>
6164 SUB A,(P) ;A HAS SIZE OF BYTE
6165 LSH A,30 ;PUT IN S FIELD OF BP.
6168 ADDI B,35. ;B HAS # TRAILING ZEROS.
6169 DPB B,[360600,,A] ;PUT THAT IN P FIELD OF BP.
6172 ;READ IN BP, RETURN BIT MASK TO SPEC'D BYTE.
6173 ;THE ARG SHOULD BE JUST THE LH OF A BP, WHICH MAY BE IN EITHER HALF OF THE ARG.
6174 A.BM: CALL GETBPT ;READ IN A BYTE POINTER ARG, IN A, POINTING AT T.
6177 A.DPB1: DPB C,A ;PUT 1'S IN SPEC'D PART OF ACCUM T
6181 ;READ IN A BYTE POINTER (REALLY JUST S AND P FIELDS) AND MAKE POINT AT AC T.
6184 TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH.
6186 TLZ A,77 ;MAKE BP. -> AC T
6190 ;RETURN # TRAILING ZEROS IN ARGUMENT.
6193 AND A,B ;A HAS JUST LOW BIT OF ARG SET.
6195 MOVNI B,1 ;# OF ZEROS BEFORE LOW BIT =
6196 MOVN A,B ;35. - <# TRAILING ZEROS>
6200 ;RETURN # LEADING ZEROS IN ARG.
6207 ;.DPB STUFF,BP,WORD DOES A DPB OF STUFF INTO THE FIELD OF WORD SPEC'D BY BP,
6208 ;RETURNING THE RESULTING WORD.
6209 A.DPB: CALL YGETFD ;READ STUFF.
6211 CALL GETBPT ;READ BP AND TURN INTO ACTUAL BP POINTING AT T
6213 CALL YGETFD ;READ IN WORD AND PUT IN T.
6217 JRST A.DPB1 ;GO DO THE DEPOSIT AND RETURN THE ALTERED WORD.
6219 ;.LDB BP,WORD RETURNS THE CONTENTS OF THE BYTE IN WORD SELECTED BY BP
6230 PUSHJ P,GETWRD ;ON UNDEFINED SYM, WYB UNDEFINED SYM IN "WORD"?
6234 ;.BIND - MAKE SYMS BE DEFINED IN CURRENT (SPEC'D) BLOCK. LH(B) HAS 0.
6235 ;.KILL - FULLY KILL THE SYMS.LH(B) HAS 3KILL.
6236 ;.HKILL - HALFKILL THEM. LH(B) HAS 3SKILL.
6237 ;.XCREF - PREVENT CREFFING OF SYMS. LH(B) HAS 3NCRF.
6238 ;.DOWN - SET 3DOWN, MAKING SYM VISIBLE IN SUBBLOCKS IN 1 PASS ASSEMBLY.
6240 HLLZ LINK,B ;REMEMBER BIT TO SET.
6241 A.KIL1: CALL GETSLD ;READ NEXT SYMBOL NAME.
6242 JRST MACCR ;NO MORE, EXIT.
6243 SKIPE LINK ;EXCEPT FOR .BIND, DO NOTHING ON PASS 1.
6245 CALL ESDEF ;DEFINE THE SYMBOL, D HAS STE IDX.
6246 JRST A.KIL2 ;SYMBOL NEVER SEEN.
6247 IORM LINK,ST+2(D) ;SET THE BIT IN 3RDWRD..
6248 IOR C,LINK ;(IF .XCREF, PREVENT CREFFING THIS TIME)
6249 IFN CREFSW,XCT CRFINU ;CREF THE SYMBOL
6252 A.KIL2: MOVSI T,LCUDF ;SYMBOL UNDEFINED, MAKE UNDEF LOCAL.
6253 IOR C,LINK ;WITH THE DESIRED BIT SET.
6254 TLO C,3MACOK ;SHOULDN'T BE ERROR IF IT BECOMES MACRO.
6256 IFN CREFSW,XCT CRFINU
6259 ;EXPUNG SYM1,SYM2 ... ;UNDEFINE THOSE SYMS.
6261 AEXPU2: PUSHJ P,GETSLD ;GET NAME
6262 JRST MACCR ;NO MORE NAMES
6263 SAVE [AEXPU2] ;AFTER THIS SYM, POPJ TO READ ANOTHER.
6264 ;EXPUNGE 1 SYMBOL, SQUOZE IN SYM.
6266 JFCL ;NOT FOUND, DON'T COMPLAIN, JUST CREF.
6267 IFN CREFSW,XCT CRFDEF
6268 HRLZI T,400000 ;EXPUNGED ZERO SYM
6271 SKIPL CONTRL ;IF RELOCATABLE ANDLOCAL SYMBOL,
6274 TRO I,IRCONT ;Don't end block between the two words
6275 PUSHJ P,PBITS7 ;TELL STINK TO EXPUNGE SYM.
6278 TLO SYM,400000 ;SAY IS NEW TYPE RQ,
6280 MOVSI A,400000 ;NEW NAME NULL => DELETE.
6284 ;EQUAL SYM1,SYM2 ;DEFINE SYM1 SAME AS SYM2.
6288 SAVE SYM ;REMEMBER SYM NAME AND BLOCK TO DEF. IN.
6292 IFN CREFSW,XCT CRFINU ;CREF SYM DEFINED AS.
6293 CALL ES ;LOOK UP SYM TO EQUATE TO.
6294 JRST [ REST ESBK ;NOT FOUND => EXPUNGE THE 1ST SYM.
6299 IFN CREFSW,XCT CRFDEF
6301 SAVE B ;SAVE INFO ON VALUE OF SYM TO EQUATE TO.
6305 REST B ;3RDWRD OF 2ND SYMBOL.
6306 REST ST+1(D) ;(WHAT WAS PUSHED FROM B)
6308 DPB A,[400400,,ST(D)]
6309 TLZ C,3DFCLR ;SAVE OLD 3MAS, 3NCRF OF 1ST SYMBOL (AND ITS BLOCK #).
6310 AND B,[3DFCLR,,] ;SET REST OF 3RDWRD BITS FROM 2ND SYMBOL.
6315 ERRTFA: ASCIZ /Too few args - EQUAL/
6317 ;.SEE SYM1,SYM2,... ;CREF THOSE SYMS.
6318 A.SEE: CALL GETSLD ;READ 1 SYMBOL.
6319 JRST MACCR ;NONE TO BE READ.
6321 SKIPN CRFONP ;IF CREFFING,
6325 XCT CRFINU ;CREF THE SYMBOL.
6329 ;UUO HANDLING ROUTINE
6333 IFE ITSSW,ERRTTL: 0 ; NUMBER OF ERRORS HIT
6334 ERRCCT: 0 ;NUM CHARS OUTPUT ON LINE, FOR MAKING MSGS LINE UP.
6335 ERRJPC: 0 ;JPC READ WHEN UUO.
6337 IFN TS, .SUSET [.RJPC,,ERRJPC]
6338 JRST ERRH ;GO HANDLE IT
6341 PUSH P,B ;NOT TYPR => ERROR OF SOME KIND
6344 LDB T,[331100,,40] ;PICK UP OP CODE
6345 CAIN T,TYPR_-33 ;TYPR?
6348 CAIE T,ETASM_-33 ;CHECK FOR SPECIAL LOSSAGES AT COLON
6350 CAME SYM,SYSYM ;ARE WE ABOUT TO MENTIO THIS LOSING LABEL AS THE LAST ONE?
6354 MOVEM T,SYSYM ;COLON LOSSAGE, DE-MUNG TAG WORDS FOR PRINTOUT
6360 CALL PNTR ;FORCE OUT BUFFERED LISTING OUTPUT
6361 CALL PNTCRR ;AND CR, SO USER CAN SEE WHERE ERROR WAS.
6363 PUSHJ P,ERRTFL ;IF NOT SAME FILE AS LAST, PRINT FILE NAME.
6367 AOS ERRTTL ; BUMP ERROR TOTAL
6368 IFE SAILSW,AOS .JBERR ; BUMP ERROR MESSAGE COUNTER FOR LOADER TO ABORT
6371 MOVE A,SYSYM ;GET LAST TAG DEFINED
6372 JUMPE A,ERR1 ;SKIP PRINTOUT IF NONE THERE
6373 PUSHJ P,SYMTYP ;THERE, TYPE IT OUT
6374 MOVE B,CLOC ;NOW GET CURRENT LOCATION
6375 SUB B,SYLOC ;SUBTRACT VALUE OF LAST TAG
6376 JUMPE B,ERR1 ;SKIP NUMERIC PRINTOUT IF RIGHT AT TAG
6377 MOVEI A,"+ ;NOT AT TAG,
6378 PUSHJ P,TYOERR ;TYPE OUT PLUS SIGN,
6379 AOS ERRCCT ;(1 MORE CHAR TYPED)
6380 PUSHJ P,OCTPNT ;THEN TYPE OUT DIFFERENCE IN OCTAL
6381 ERR1: PUSHJ P,TABERR ;NOW SEPARATE WITH TAB
6383 CAIGE A,8 ;MAKE SURE MOVE TO COLUMN 16.
6385 MOVEI B,[ASCIZ/GL+/]
6386 SKIPGE GLOCTP ;LOCATION GLOBAL?
6387 PUSHJ P,TYPR3 ;YES, TYPE OUT THAT FACT.
6388 MOVE B,CLOC ;GET CURRENT LOCATION
6389 PUSHJ P,OCTPNT ;TYPE OUT IN OCTAL
6394 MOVE A,MDEPTH ;NOW DEPTH IN MACRO (NOT IRP, REPEAT, ETC.) EXPANSIONS
6396 CALL DPNT0 ;PRINT, IN 2-CHAR FIELD.
6398 CALL TYOERR ;(USED TO BE OCTAL)
6399 MOVE A,CPGN ;CURRENT PAGE NUMBER (FIRST PAGE OF FILE => 0)
6400 PUSHJ P,[AOJA A,D6PNT] ;TYPE IT OUT IN DECIMAL
6403 MOVE A,CLNN ;ALSO CURRENT LINE NUMBER
6404 PUSHJ P,[AOJA A,D3PNT2]
6406 MOVEI A,48. ;ASSUME ALL THE STUFF WE'VE PRINTED TAKES 48. CHARS
6407 MOVEM A,ERRCCT ;MAYBE SOMEDAY TABERR, ETC. WILL REALLY UPDATE ERRCCT PROPERLY.
6408 LDB A,[331100,,40] ;PICK UP OP CODE AGAIN
6409 CAIGE A,8 ;ERROR UUO MAX
6411 JRST [HALT ? JRST .-1] ;OPCODE 0, OR TOO BIG.
6412 JRST ERRSM ;ETSM => TYPE SYM AND MESSAGE.
6413 JRST ERRR ;ETR => JUST PRINT MESSAGE
6414 JRST ERRJ ;ERJ => RH(40) HAS JUMP ADR
6415 JRST ERRI ;ETI => IGNORE LINE RET TO ASSEM1
6416 JRST ERRA ;ETA => RET TO ASSEM1
6417 JRST ERRASM ;ETASM => TYPE SYM AND GO TO ASSEM1
6418 JRST IAE ;ERF => FATAL.
6420 ERRJ: MOVE A,40 ;ERJ => RH(40) HAS JUMP ADR
6424 ERRI: PUSHJ P,RCH ;ETI => IGNORE LINE, RETURN TO ASSEM1: EAT UP LINE
6427 ERRA: MOVEI A,ASSEM1 ;ETA => RETURN TO ASSEM1, DON'T TYPE SYM.
6431 ERRASM: MOVEI A,ASSEM1 ;ETASM => TYPE SYM AND RETURN TO ASSEM1
6433 ERRSM: MOVEI C,56. ;ETSM OR ETASM => TYPE OUT SYM THEN MESSAGE
6434 CALL TYPE37 ;CR NOW IF WHOLE MSG WON'T FIT ON ONE LINE.
6438 ERRR: CALL TYPE40 ;TYPE THE ERROR MESSAGE.
6440 POP P,A ;COMMON RETURN POINT FROM UUOS
6445 ;FINISH UP AN ERROR UUO'S ERROR MESSAGE. PRINT THE SPECIFIED STRING
6446 ;AND ALSO "IN DEFINE AT ..." IF NECESSARY, ALONG WITH APPROPRIATE CR'S.
6447 TYPE40: MOVE C,ERRCCT
6449 CALL TYPR4 ;PRINT THE ASCIZ STRING
6451 SKIPN A,DEFNPS ;IF INSIDE A LONG PSEUDO,
6455 CAMN A,CLNN ;WHICH DIDN'T START IN THIS VERY LINE,
6461 TYPE42: MOVEI B,[ASCIZ/ in /]
6464 CALL SYMTYP ;SAY WHAT PSEUDO, AND WHERE IT STARTED.
6465 MOVEI B,[ASCIZ/ Starting at /]
6467 MOVE A,DEFNPN ;PAGE # -1.
6468 CALL [AOJA A,DPNT] ;PRINT PAGE #.
6472 CALL D3PNT2 ;PRINT LINE #.
6474 MOVE B,DEFNFI ;PRINT FILE NAME IF IT ISN'T THE CURRENT FILE.
6477 MOVEI B,[ASCIZ/ of file /]
6482 TYPE41: CALL CRRERR ;AND CRLF.
6483 TYPE43: MOVE A,ERROR
6484 CAIN A,ASSEM1 ;IF THIS ERROR IS EXITING THE PSEUDO,
6485 SETZM DEFNPS ;SAY WE'RE NOT IN IT ANY MORE.
6488 ;JSP TM,ERMARK IN A PSEUDO, TO ARRANGE FOR ERROR MESSAGES TO MENTION
6489 ;THAT PSEUDO. SYM SHOULD CONTAIN THE NAME OF THE PSEUDO.
6490 ;PUSHES A WORD ON THE STACK SO THAT WHEN THE PSEUDO RETURNS DEFNPS WILL BE CLEARED.
6491 ;IF DEFNPS IS SET UP ALREADY, DOES NOTHING (DOESN'T SET DEFNPS; DOESN'T PUSH THE WORD)
6492 ERMARK: SKIPE DEFNPS
6508 ;C SHOULD HAVE CURRENT HORIZ POS. IF TYPING THE STRING 40 POINTS AT
6509 ;WOULD OVERFLOW THE LINE, TYPE A CRLF AND TAB NOW ON THE TTY ONLY.
6511 HRLI B,440700 ;FIRST, FIGURE OUT HOW FAR ON LINE WE'LL TYPE IF WE DON'T CR.
6513 CAIE A, ;AND COUNT CHARS IN THE ERR MSG.
6518 MOVEM A,ERRCCT ;PREVENT THIS FROM BEING DONE TWICE.
6521 MOVEI A,^M ;IF THERE'S NO ROOM, CRLF ON THE TTY ONLY (NOT THE ERR FILE).
6528 ;TYPE OUT SQUOZE (FLAGS OFF) IN A
6530 SYMTYP: PUSHJ P,SQCCV ;GET NEXT CHAR IN ASCII.
6532 PUSHJ P,TYOERR ;TYPE IT OUT.
6533 JUMPE B,CPOPJ ;RETURN IF NOTHING LEFT (TYPED OUT AT LEAST ONE CHAR THOUGH)
6534 IMULI B,50 ;LEFT-JUSTIFY REMAINDER
6535 MOVE A,B ;GET LEFT-JUSTIFIED REMAINDER IN A
6536 JRST SYMTYP ;TYPE OUT REMAINDER OF SYM
6538 ;TYPE OUT SQUOZE CHARACTER (IN A)
6540 SQCCV: IDIV A,[50*50*50*50*50]
6542 SOJA A,SQCDTO ;NUMBER (OR BLANK =>SLASH)
6544 SKIPA A,SYTB-45(A) ;SPECIAL
6545 ADDI A,"A-13 ;LETTER
6555 D3PNT2: MOVE T,[-3,,400000] ;3 CHAR FIELD, NO ZERO SUPPRESSION.
6558 DPNT: TDZA T,T ;ORDINARY DECIMAL PRINT.
6559 D6PNT: MOVSI T,-6 ;6 CHAR FIELD, ZERO SUPPRESSION.
6562 TRNE T,377777 ;IF NOT LAST DIGIT,
6563 TRNE T,400000 ;AND ZERO-SUPPR. WANTED,
6565 JUMPN A,DPNT2 ;IF THIS IS A LEADING 0,
6568 HRLM B,(P) ;REPLACE WITH A SPACE.
6569 DPNT2: AOBJN T,.+2 ;J IF NOT ENOUGH CHARS YET.
6570 JUMPE A,DPNT1 ;ENOUGH, DON'T MAKE MORE IF NOT NEEDED.
6574 ;TYPE HALFWORD IN B IN OCTAL.
6585 ;TYPE OUT THE SIXBIT WORD IN B
6587 SIXTYO: JUMPE B,CPOPJ
6601 ;OP CODE 0 => NO RECOVERY RETURN TO GO2
6602 IAE: CALL TYPE40 ;PRINT THE ERROR MESSAGE.
6604 JSP LINK,CONFLZ ;TELL USER ABOUT UNTERM. GROUPINGS.
6605 SKIPE SCNDEP ;MENTION ANY UNTERMINATED SUCCESSFUL
6606 CALL AENDM1 ;CONDITIONALS.
6607 IFN ITSSW,.RESET TYIC,
6610 ;TYPR [ASCIZ /STRING/] ;TYPE OUT STRING
6612 TYPR1: PUSH P,[ERRET1]
6613 TYPR4: HRRZ B,40 ;GET ADR OF BEGINNING OF STRING
6614 TYPR3: HRLI B,440700 ;CONVERT TO BYTE POINTER
6615 TYPR2: ILDB A,B ;GET NEXT CHAR
6616 JUMPE A,CPOPJ ;JUMP IF ZERO, END OF STRING
6617 PUSHJ P,TYOERR ;NON-ZERO, TYPE IT OUT
6620 CRRERR: MOVEI A,^M ;CRLF IN ERROR MESSAGE.
6623 TABERR: MOVEI A,^I ;TAB INN ERROR MESSAGE.
6626 SKIPE LSTTTY ;OUTPUT TO LISTING UNLESS LSTTTY ZERO.
6630 JRST TYO ;TO TTY UNLESS LSTTTY POSITIVE.
6632 \f;OUTPUT-FORMAT SELECTING PSEUDOS:
6634 ;.SLDR -- ON PASS 2, PUNCH OUT SBLK LOADER AND SELECT SBLK FORMAT
6636 JUMPGE FF,MACCR ;DO NOTHING ON PASS 1.
6637 PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE FIRST
6638 PUSHJ P,PLOD1A ;PUNCH OUT LOADER
6639 SIMBLK: MOVSI B,SBLKS ;ENTRY FROM PS1, A.SLDR SELECT SBLK
6642 SRIM: MOVE A,SYM ;ENTRY FROM GETVAL, LH(B) HAS RH(CONTRL)
6645 TYPR [ASCIZ/ Encountered
6648 SIMBL1: TRO FF,FRNPSS
6649 HRRI B,TRIV ;SET UP TRIV FLAG FOR LH(CONTRL)
6651 CAME B,CONTRL ;IF CHANGING MODES, END THE BLOCK IN THE OLD MODE
6653 MOVE A,CONTRL ;IF OLD MODE WAS RELOCATABLE OF SOME KIND,
6656 SETZM CRLOC ;INITIALIZE LOCATION COUNTER.
6659 SIMBL2: MOVEM B,CONTRL ;STORE NEW MODE.
6662 ;ROUTINE TO SET VARIABLES FOR BENEFIT OF NED LOGIC
6663 ;CALLED BY OUTPUT SELECTING PSEUDOS
6666 TRNE FF,FRNPSS ;IF PASS 1,
6669 AOS OUTN1 ;INDICATE "OUTPUT" HAS OCCURED OTHER THAN IN 1PASS MODE
6670 OUTCHK: TLZE FF,FLOUT
6671 AOS OUTC ;INDICATE "OUTPUT" HAS OCCURED DURING CURRENT ASSEMBLY
6679 A1PASS: PUSHJ P,OUTUPD
6680 A1PAS1: TLO FF,FLPPSS
6681 MOVEIM A.PPASS,1 ;SET .PPASS TO 1.
6682 IFN CREFSW,[ SKIPE CREFP ;THIS NOW PUNCHING PASS,
6683 PUSHJ P,CRFON ;MAYBE TURN ON CREFFING.
6687 CALL LSTON ;LIST NOW IF WANT LISTING AT ALL.
6693 ARELOC: PUSHJ P,OUTUPD
6694 ARELC1: PUSHJ P,EBLK ;FINISH CURRENT OUTPUT BLOCK
6695 TRO FF,FRLOC ;DOING LOCATION ASSIGNMENT, MAKE SURE NEXT GETS OUTPUT
6702 DPB A,[310700,,BKBUF]
6706 A.DECTWO: CALL AGETFD ;READ THE TWOSEG ORIGIN.
6708 ETF [ASCIZ /.DECTWO follows 1PASS/]
6710 TRNN C,IRFLD ;NO ARG => DEFAULT IT TO 400000
6714 A.DECREL: PUSHJ P,OUTUPD
6716 PUSHJ P,EBLK ;FORCE OUT BLOCK IN OTHER FMT.
6717 MOVE A,[SETZ DECREL]
6718 CAME A,CONTRL ;SWITCHING TO .DECREL MODE FOR 1ST TIME
6719 TRNE FF,FRNPSS ;IN A 1PASS ASSEMBLY
6721 CALL A.FAS1 ;DO THE SWITCH
6723 CALL DECPGN ;THEN WRITE THE PROGRAM NAME
6726 A.FAS1: MOVEM A,CONTRL ;DEC FMT COUNTS AS ABS ASSEMBLY.
6727 SETZM BKBUF ;(SO EBLK W0N'T OUTPUT ANYTHING)
6728 SETZM CLOC ;START ASSEMBLING FROM RELOCATABLE 0.
6731 PUSHJ P,EBLK ;INITIALIZE AN ORDINARY (DECWDS) BLOCK.
6735 A.FASL: PUSHJ P,OUTUPD
6737 MOVE A,[SETZ FASL] ;FASL ALSO COUNTS AS ABS
6742 SAVE CASSM1 ;RETURN TO ASSEM1.
6746 MOVE T,[440700,,STRSTO]
6747 ATIT2: ILDB A,T ;GET CHAR FROM TITLE STRING
6749 JRST ATIT3 ;CHAR IS SYLLABLE TERMINATOR
6750 IFE ITSSW,SKIPE CCLFLG ? TRNN FF,FRPSS2
6751 PUSHJ P,TYO ;NOT TERMINATOR, TYPE OUT AND LOOP BACK
6754 ATIT3: CALL ATIT1 ;PRINT THE REST OF THIS LINE.
6759 ETF [ASCIZ /TITLE follows 1PASS/]
6761 ADD A,A.PASS ;SHOULD WE .INSRT TTY: THIS PASS (T SWITCH)
6763 IFDEF GTYIPA,JRST GTYIPA ;GO PUSH TO TTY IF CAN,
6764 IFNDEF GTYIPA,HALT ;WHY DID YOU SET TTYINS IF CAN'T?
6766 ATIT1: CAIE A,15 ;CR?
6768 JRST [IFE ITSSW,SKIPE CCLFLG ? TRNN FF,FRPSS2
6769 JRST CRR ;ONE OF THESE, FINISH TYPEOUT WITH CR
6771 ] ; AND RETURN IF PASS2 DEC CCL
6772 IFE ITSSW,SKIPE CCLFLG ? TRNN FF,FRPSS2
6773 PUSHJ P,TYO ;NEITHER OF THESE, PRINT CHAR
6774 A.ERR1: PUSHJ P,RCH ;GET NEXT CHAR IN TITLE
6777 ;.ERR PSEUDO-OP -- FOLLOWED BY LINE WHICH IS ERROR MSG.
6778 A.ERR: SAVE CASSM1 ;RETURN TO ASSEM1,
6779 ERJ A.ERR1 ;AFTER NUMBERS AND USER'S STRING.
6781 A.FATAL: SAVE [GO2] ;.FATAL - CAUSE A FATAL ERROR.
6785 HLRZS B ;B SAYS WHETHER PRINTX, PRINTC OR COMMENT.
6791 JRST (B) ;GO TO APRIN1 FOR COMMENT,
6794 APRIN2: CAIE A,"! ;COME HERE FOR PRINTX
6795 APRIN3: PUSHJ P,TYO ;HERE FOR PRINTC
6799 CALL AGETFD ;PSEUDO TO TYPE A CHARACTER (AS NUMERIC ARG).
6804 CALL AGETFD ;PSEUDO TO TYPE A WORD OF SIXBIT.
6808 \f;.BEGIN - START NEW BLOCK WITH NAME = ARG, OR LAST LABEL DEFINED.
6810 SKIPE ASMOUT ;IF IN GROUPING, FLUSH IT & ERROR.
6812 PUSHJ P,GETSLD ;READ A NAME.
6813 MOVE SYM,SYSYM ;NO ARG, USE NAME OF LAST LABEL.
6814 MOVE A,SYM ;NAME TO USE FOR BLOCK.
6815 MOVE B,BKLVL ;CURRENT LEVEL + 1
6816 HRLZI B,1(B) ;IS LEVEL OF NEW BLOCK.
6817 HRR B,BKCUR ;ITS SUPERIOR IS CURRENT BLOCK.
6818 MOVEI C,0 ;SEE IF AN ENTRY EXISTS FOR THIS BLOCK.
6820 A.BEG0: CAMN A,BKTAB(C)
6822 JRST A.BEG1 ;THIS ENTRY ISN'T FOR BLOCK BEING ENTERED.
6823 TDNE AA,BKTAB+2(C) ;FOUND: DEFINED IN THIS PASS?
6824 ETSM [ASCIZ /Multiply defined BLOCK/]
6825 JRST A.BEG2 ;NO, SAY IT'S DEFINED.
6827 A.BEG1: ADDI C,BKWPB ;LOOK THRU ALL ENTRIES.
6830 CAIL C,BKTABS ;ALL ENTRIES USED => ERROR.
6832 MOVEM A,BKTAB(C) ;ALLOCATE NEW ENTRY
6833 MOVEM B,BKTAB+1(C) ;STORE NAME, LEVEL, SUPPRO.
6835 MOVEM A,BKTABP ;POINTS TO 1ST UNUSED ENTRY.
6836 A.BEG2: IORM AA,BKTAB+2(C) ;INDICATE BLOCK SEEN THIS PASS.
6837 MOVEM C,BKCUR ;NEW BLOCK NOW CURRENT BLOCK,
6838 AOS A,BKLVL ;ITS LEVEL NOW CURRENT LEVEL,
6839 CAIL A,BKPDLS ;PUSH IT ON BLOCK PDL
6840 ETF [ASCIZ /.BEGIN nesting too deep/]
6844 ERRTMB: ASCIZ /Too many symbol blocks/
6845 ERRUMB: ASCIZ /Unmatched .BEGIN - .END/
6847 ;.END - POP CURRENT BLOCK.
6849 SKIPE ASMOUT ;IN GROUPING => TERMINATE IT & ERROR.
6851 MOVE A,CDISP ;IF FOLLOWED BY WORD TERM,
6852 TLNN A,DWRD ;CAUSE IT TO BE RE-READ
6853 TLO FF,FLUNRD ;SO ARG WILL BE NULL.
6854 PUSHJ P,GETSLD ;READ ARG.
6855 JRST A.END0 ;NO ARG.
6856 MOVE C,BKCUR ;ERROR UNLESS BLOCK BEING TERMINATED
6857 MOVE A,BKTAB(C) ;HAS SAME NAME AS ARG.
6858 EXCH A,SYM ;(MAKE SURE SYM NAME TYPED IS BLOCK'S NAME)
6860 ETSM ERRUMB ;ERROR, PRINT SYM (BLOCK'S NAME)
6861 A.END0: MOVE C,BKCUR ;NOT OK TO END .MAIN BLOCK OR .INIT BLOCK.
6865 MOVEM C,BKCUR ;POP INTO FATHER OF PREV. CURRENT BLOCK.
6869 ;BKTAB: 3-WORD ENTRIES, 1 PER BLOCK, IN NO PARTICULAR ORDER.
6870 ;1ST WD HAS SQUOZE NAME OF BLOCK, FLAGS CLEAR.
6871 ;2ND WD HAS LEVEL,,BKTAB IDX OF CONTAINING BLOCK("FATHER", "SUPERIOR")
6872 ;3RD WD BIT 1.N ON => BLOCK ENTERED ON PASS N.
6873 ;SYMBOL TABLE OUTPUT RTN PUTS -2*<NUM SYMS IN BLOCK> IN 3RD WD.
6874 ;THE FIRST BKTAB ENTRY IS THAT OF THE OUTERMOST BLOCK (.INIT)
6875 ;IN WHICH INITIAL SYMS ARE DEFINED.
6876 ;THAT ENTRY'S 2ND AND 3RD WDS ARE 0.
6877 ;THE NEXT IS THAT OF THE MAIN BLOCK (.MAIN) IN WHICH
6878 ;ALL SYMBOLS ARE NORMALLY DEFINED (THAT IS, YOU ARE IN THAT BLOCK
6879 ;BEFORE YOU DO ANY .BEGIN'S).
6880 ;THAT ENTRY'S 2ND WD IS 1,, ; ITS 3RD, 0.
6882 ;THE BKPDL IS A TABLE OF BLOCKS CURRENTLY ENTERED & NOT ENDED.
6883 ;BKPDL'S 1ST ENTRY IS FOR OUTERMOST BLOCK.
6884 ;LAST ENTRY IS BKPDL+@BKLVL, FOR CURRENT BLOCK.
6886 BKTABS==BKTABL*BKWPB
6890 BKTAB: BLOCK 3 ;ENTRY FOR .INIT BLOCK.
6891 PRGNM: BLOCK BKTABS-BKWPB ;PROGRAM NAME IS NAME OF MAIN BLOCK.
6893 BKTABP: 0 ;IDX IN BKTAB OF 1ST UNUSED ENTRY.
6894 BKPDL: BLOCK BKPDLS ;TABLE OF BLOCKS STARTED, NOT FINISHED.
6895 BKLVL: 0 ;CURRENT BLOCK LEVEL, IDX OF LAST USED IN BKPDL.
6896 BKCUR: 0 ;BKTAB IDX OF CURRENT BLOCK.
6897 ESBK: 0 ;-1 OR BLOCK TO EVAL SYM. IN.
6898 ESL1: 0 ;IN ES, LEVEL OF BLOCK OF BEST SYM SO FAR.
6899 ESL2: 0 ;3RDWRD OF BEST SO FAR.
6900 SADR: 0 ;SYM TAB IDX OF BEST SO FAR.
6901 ESLAST: 0 ;RH IDX OF LAST DEF (EVEN IF NO GOOD) -1 IF NONE
6902 ;SIGN NEG. IF LAST DEF SEEN BEFORE @ESXPUN
6903 ESXPUN: -1 ;IF SEE EXPUNGED OR FREE ENTRY, PUT IDX HERE.
6904 BKTAB1: BLOCK BKTABL ;USED BY SSYMD.
6907 ;.SYMTAB ARG ;SAY WANT AT LEAST ARG STE'S IN SYMTAB.
6909 SAVE [0] ;THIS WORD WILL BE SETOM'ED IF THERE IS REALLY ANY WORK NEEDED.
6910 PUSHJ P,AGETFD ;GET DESIRED SYM TAB SIZE.
6911 CAMG A,SYMLEN ;IF HAVE ENOGH ROOM ALREADY,
6912 JRST A.SYM1 ;NO NEED TO RE-INIT.
6913 CAILE A,SYMMAX ;IF WANTS MORE THAN MAXIMUM, ERROR.
6914 ETF [ASCIZ/.SYMTAB 1st arg too big/]
6915 MOVEM A,SYMLEN ;TELL INITS ABOUT NEW SIZE.
6917 A.SYM1: CALL AGETFD ;READ DESIRED CONSTANTS TABLE SPACE ALLOCATION.
6918 CAMG A,CONLEN ;IF TABLE ALREADY BUG ENOUGH, NOTHING TO DO.
6921 ETF [ASCIZ/.SYMTAB 2nd arg too big/]
6922 MOVEM A,CONLEN ;ELSE REMEMBER IT AND SAY REALLOCATION NECESSARY.
6924 A.SYM2: CALL AGETFD ;3RD ARG IS # WORDS PER SYMBOL - BUT ONLY 3 IS ALLOWED NOW.
6925 JUMPE A,A.SYM3 ;EVENTUALLY 4 WILL GET 12-CHARACTER SYMBOLS.
6928 ETF [ASCIZ/.SYMTAB 3rd arg out of range/]
6932 A.SYM3: REST A ;IS THERE ANYTHING THAT ACTUALLY NEEDS TO BE CHANGED?
6933 JUMPE A,ASSEM1 ;IF NOT, NEVER GIVE ERROR - ELSE WOULD ALWAYS LOSE ON PASS 2.
6935 CAMN B,CONTBA ;IF THERE HAVE BEEN ANY LITERALS
6936 SKIPE INICLB ;OR ANY MACROS, IRPS, REPEATS, ETC., THEN ...
6937 ETF [ASCIZ/Too late to do .SYMTAB/]
6938 MOVE CH1,MACTAD ;SET UP AC -> START OF INIT CODE
6939 SUBI CH1,MACTBA ;SO IT CAN REFER TO ITSELF.
6940 PUSHJ P,INITS(CH1) ;RE-INIT, SET SYMSIZ, SYMAOB, ETC.
6941 PUSHJ P,MACINI ;INIT PTRS TO END OF MACTAB.
6944 A.OP: PUSHJ P,A.OP1 ;.OP,
6945 JRST VALRET ;RETURNS VALUE
6948 AOS (P) ;.AOP DOESN'T RETURN VALUE
6949 A.OP1: PUSHJ P,AGETFD
6952 PUSH P,A ;PDL NOW HAS FIELD 0 AND FIELD 1
6954 POP P,B ;B NOW HAS FIELD 1, A HAS FIELD 2, PDL HAS FIELD 0
6956 POP P,T ;T HAS FIELD 0, A HAS FIELD 1, B HAS FIELD 2
6957 TLNN T,(0 17,) ;IF AC FIELD NOT PRESENT IN INSN, SUPPLY ONE.
6959 TDNN T,[0 -1(17)] ;IF NO ADDR OR IDX FIELD IN INSTRUCTION,
6960 HRRI T,B ;SUPPLY ONE.
6961 SETOM A.ASKIP' ;.ASKIP WILL BE -1 IFF INSN SKIPPED, ELSE 0.
6962 TLNE T,74000 ;AVOID EXECUTING OPCODE ZERO.
6965 MOVEM A,AVAL1' ;STORE C(AC) AS .AVAL1
6966 MOVEM B,AVAL2' ;STORE C(E) FOR .AVAL2
6967 POPJ P, ;RETURN TO WHATEVER
6971 MOVEM T,AASCF1 ;STORE TYPE
6976 AASCII: SKIPA D,[440700,,T]
6977 ASIXBI: MOVE D,[440600,,T]
6978 SETZM AASCFT ;INDICATE NOT .DECTXT
6979 SETOM AASCF1 ;INDICATE REGULAR (NOT ASCIZ)
6985 ETA [ASCIZ /.DECTXT in non-DECREL assembly/]
6989 SETOM AASCF1 ;INDICATE ASCIZ-STYLE PADDING
6991 AASC1: TLZE I,ILMWRD
6992 JRST TEXT2 ;MULTIPLE WORD, FALL IN FOR NEXT SET OF CHARS
6993 MOVEMM ASMDS1,ASMDSP
6994 MOVEM SYM,DEFNPS ;REMEMBER LOCATION IN FILE OF PSEUDO
6995 MOVEMM DEFNLN,CLNN ;IN CASE THE DELIMITER IS MISSING.
6997 IFN TS, MOVEMM DEFNFI,INFFN1
6998 HLRZ T,B ;GET FILL CHARACTER
6999 IMUL T,[REPEAT 5,[1_<.RPCNT*7>+]0] ;CONVERT TO ASCII FILL WORD SHIFTED -1 (IMUL SCREW)
7000 LSH T,1 ;SHIFT TO PROPER POSITION (EXTRA IN CASE WANT TO FILL W/ HIGH BIT SET)
7001 MOVEM T,AASEFW ;STORE AS FILL WORD, T NOW SET UP TO ACCUMULATE VALUE
7003 MOVEM A,TEXT4 ;STORE TERMINATOR
7006 JRST AASC1A ;TERMINATOR
7008 JRST TEXT6 ;WORD FULL
7009 TEXT9: TLNE D,100 ;CHECK BOTTOM BIT OF SIZE FIELD OF BP
7010 JRST AASC2 ;SET => NOT SIXBIT
7013 SUBI A,40 ;CONVERT LOWER CASE ASCII TO UPPER CASE
7020 ERRN6B: ASCIZ /Character not SIXBIT/
7024 AASC1A: TLNN D,760000 ;SKIP UNLESS END OF WORD
7025 SKIPGE AASCF1 ;SKIP UNLESS REGULAR
7026 JRST [ MOVE CH1,ASMDS1 ;REGULAR OR NOT END OF WORD
7027 MOVEM CH1,ASMDSP ;RESTORE ASMDSP AS SAVED AT START OF PSEUDO.
7029 MOVEI CH1,1 ;END OF WORD AND NOT REGULAR
7030 JRST AASC1B ;EXTRA 0 NEED FOR Z FLAVOR
7034 JRST AASC3 ;NOT .ASCII OR NOT EXCL
7035 PUSH P,T ;READ FIELD
7038 SAVE ASMOUT ;PREVENT CLOSEBRACKETS FROM TRYING TO TAKE EFFECT.
7039 MOVEIM ASMOUT,4 ;NOTE THIS LOSES IF CALL PSEUDO THAT RETURNS TO ASSEM1.
7040 MOVEI SYM,[SETOM ASUDS1] ;NOW TO SET UP UNDEFINED SYM CONDITION
7042 MOVE SYM,[SQUOZE 0,.ASCII] ;PUNCHING PASS, UNDEFINED => REAL ERROR
7045 ;"UNDEFINED IN .ASCII" ERROR INSTR, ERROR MESSAGE BUT ONLY ON PASS 2
7046 ;BUT NOTE THAT ON PASS 2 IT MIGHT ASSEMBLE DIFFERENT NUMBER OF WORDS,
7047 ;CAUSING LOSSAGE IF NOT IN CONSTANT
7053 MOVNI A,1 ;HAD UNDEFINED SYMS SO ASSUME MAX
7055 TLO I,ILNOPT ;ALSO DON'T OPTIMIZE OVER IN CONSTANT
7056 MOVE CH1,[440700,,AASBF]
7061 AASC6: LSHC CH1,-35.
7073 IDPB A,ASBP1 ;END .ASCII NUMBER WITH ZERO
7074 AASC8A: TLNN D,760000
7075 JRST AASC7 ;END OF WORD
7081 AASC9: TLO FF,FLUNRD
7085 TEXT6: MOVNI CH1,1 ;WORD FULL
7086 AASC1B: MOVEM CH1,AASCF2
7090 SKIPE AASCFT ;FOR .DECTXT, OUTPUT WORD INSTEAD OF RETURNING IT.
7094 TLO I,ILMWRD ;ELSE ARRANGE TO BE CALLED BACK TO RETURN NEXT WORD.
7097 SKIPLE CONSML ;IF NOT MULTI-LINE MODE,
7099 MOVE T,ASMOUT ;IF THE TEXT IS IN <>'S OR ()'S,
7103 CALL IGTXT ;USE ONLY THE FIRST WORD.
7104 SKIPE CONSML ;AND ERROR IF IN ERROR MODE.
7105 ETR [ASCIZ/Multi-word text pseudo in brackets/]
7111 TEXT2A: MOVE T,AASEFW ;INITIALIZE T TO FILL WORD
7112 MOVE A,TEXT8 ;GET NEXT CHAR (ALREADY READ BY RCH)
7114 JRST TEXT9 ;REG OR HAVEN'T READ SECOND DELIMITER, FALL BACK IN
7118 JRST TEXT5 ;RETURNING FROM ASCIZ AFTER PUTTING THE TRAILING ZERO OUT.
7120 CALL PPB ;FOR .DECTXT, OUTPUT THE FILL WORD INSTEAD.
7125 AASCF1: 0 ;-1 REG OR SIXBIT, 1 .ASCI 0 ASCIZ
7126 AASCF2: 0 ;MULTIPLE WORD RETURN FLAG -1 REG 0 FINISH ! HACK 1 OUTPUT FILL WORD FOR Z
7127 AASCFT: 0 ;0 REGULAR, -1 => .DECTXT (OUTPUT WORDS TO FILE INSTEAD OF RETURNING THEM)
7129 TEXT8: 0 ;SAVED NEXT CHAR WHILE RETURNING BETWEEN WORDS
7130 ASBP1: 0 ;IDPB TO AASBF ON .ASCII FIELD
7131 ASBP2: 0 ;ILDB FROM AASBF "
7132 AASBF: BLOCK 8 ;ACCUMULATED TYPEOUT OF NUMBER FOR .ASCII, EXTRA LONG FOR HACKERS TYPING OUT BINARY
7133 ASUDS1: 0 ;UNDEFINED SYM FLAG FOR .ASCII DURING PASS 1
7134 AASEFW: 0 ;FILL WORD
7138 IGTXT: TLNN I,ILMWRD
7140 PUSH P,A ;ROUTINE TO EAT UP TEXT OF UNDESIRED MULTIPLE WORD
7141 SKIPLE AASCF2 ;DETECT SCREW CASE: AFTER ASCIZ OF 5 CHARS, DELIMITER IS
7142 JRST IGTXT1 ;ALREADY GOBBLED, BUT SOME OF THE ASCIZ REMAINS.
7146 IGTXT1: TLZ I,ILMWRD
7147 MOVEMM ASMDSP,ASMDS1
7151 ;".ASCVL /X" RETURNS THE ASCII VALUE OF "X". NOTE THE DELIMITER IS NOT REPEATED
7152 ;AND SERVES ONLY TO ALLOW SPACES TO BE IGNORED WHILE WINNING IF X IS A SPACE.
7153 A.ASCV: CALL PASSPS ;SKIP SPACES TO REACH THE DELIMITER.
7154 CALL RCH ;READ THE CHAR AFTER THE DELIMITER
7156 JRST TEXT5 ;AND RETURN ITS ASCII VALUE.
7158 ASQOZ: HLLM B,(P) ;SAVE FLAG THAT'S 0 FOR SQUOZE, -1 FOR .RSQZ .
7163 PUSHJ P,GETSLD ;GET SYM, SAVE DELIMITER FOR REINPUT
7166 LDB B,[4000,,SYM] ;GET JUST THE SQUOZE.
7168 PUSHJ P,ASQOZR ;FOR .RSQZ, RIGHT-JUSTIFY IT.
7173 ;RIGHT-JUSTIFY THE SQUOZE WORD IN B.
7176 JUMPN LINK,CPOPJ ;LAST ISN'T BLANK, DONE.
7177 MOVE B,SYM ;ELSE REPLACE BY WHAT'S SHIFTED RIGHT 1 CHAR.
7180 ;COMMON PSEUDO ROUTINE TO RETURN MIDAS INTERNAL QUANTITY
7181 ;ADR IN LH(B)) AS VALUE (EG. .RPCNT, .FNAM1, .AVAL2, ETC.
7182 ;INTSYMS MAY APPEAR TO LEFT OF =
7184 INTSYM: MOVE A,B ;GET ADR IN LH(A)
7185 JRA A,CLBPOP ;RETURN IT
7187 ;.YSTGW, .NSTGW ACCORDING TO WHAT'S IN LH(B)
7189 STGWS: HRLES B ;.NSTGW INCREMENTS STGSW, .YSTGW DECREMENTS.
7191 SKIPGE B ;BUT DON'T DECREMENT PAST 0.
7193 JRST MACCR ;STORAGE WORDS ARE ALLOWED IF STGSW IS ZERO.
7199 PUSHJ P,GETSLD ;GET NAME
7202 TRNN I,IRLET ;IF SYLLABLE IS A NUMBER,
7203 JRST [ SETO A, ;RETURN -1.
7205 PUSHJ P,ES ;EVALUATE SYM, INTERESTED IN SQUOZE FLAGS RETURNED IN A
7206 MOVEI A,17 ;DIDN'T SKIP, RETURN 17 => UNSEEN
7207 IFN CREFSW,XCT CRFINU
7210 NONAME: MOVE SYM,-2(P)
7211 ETSM [ASCIZ /No arg/]
7217 A.FORMAT: PUSHJ P,AGETFD ;GET FIRST FIELD (FORMAT #)
7218 MOVE B,CDISP ;WORD TERMINATOR ENDED 1ST ARG =>
7220 JRST A.FOR1 ;RETURN CURRENT SPEC FOR THAT FORMAT.
7222 PUSHJ P,AGETFD ;GET SECOND FIELD (TABLE ENTRY FOR FORMAT NUMBER)
7224 MOVEM A,FORTAB-10(B)
7227 A.FOR1: MOVE A,FORTAB-10(A)
7231 CLEARM NBYTS ;# BYTES ASSEMBLED
7232 CLEARM BYTMT ;TOTAL ACTIVE BYTES IN TABLE
7233 MOVE A,[440700,,BYBYT] ;POINTER TO NEW TABLE
7235 A.BY1: PUSHJ P,AGETFD ;GET FIELD, .GE. 0 => BYTE, .LT. 0 => HOLE
7238 JRST A.BY2 ;NO FIELD
7244 A.BY2: TLNE CH1,DWRD ;CDISP LEFT IN CH1 BY AGETFD
7245 JRST A.BY1 ;NOT WORD TERMINATOR
7246 SKIPN BYTMT ;WORD TERMINATOR, ANY FIELDS?
7247 JRST A.BY3 ;NO, DO .WALGN AND RESET TO WORD MODE
7248 SETOM BYTM ;ENTERING BYTE MODE
7257 ;RESET THE BYTE DESCRIPTOR TABLE POINTERS TO POINT TO NEW WORD
7259 BYSET: CLEARM BYTMC ;COUNT OF BYTES PROCESSED THIS TABLE SCAN
7260 MOVE A,[440700,,BYBYT] ;POINTER TO DESCRIPTOR TABLE
7262 ILDB A,BYTMP ;FIRST DESCRIPTOR BYTE
7264 DPB A,[300600,,BYTWP] ;DEPOSIT AS FIRST BYTE SIZE
7267 A.BY3: CLEARM BYTM ;NO LONGER IN BYTE MODE
7274 A.WAL1: LDB A,[360600,,BYTWP]
7276 JRST ASSEM1 ;ALREADY AT BEGINNING OF WORD
7278 DPB A,[360600,,BYTWP] ;MAKE IT POINT TO BEGINNING OF WORD
7283 BYTIN1: CLEARM BYTMC
7284 MOVE A,[440700,,BYBYT]
7290 DPB A,[300600,,BYTWP]
7296 ;NEXT BYTE GOES IN NEXT WORD
7297 PBY1: MOVE P,ASSEMP ;PCONS NEEDS THIS.
7299 PUSH A,BYTW ;INTO WRD,
7300 PUSH A,BYTRLC ;INTO WRDRLC
7304 DPB A,[360600,,BYTWP]
7306 JRST @ASMOT4(AA) ;TO PBY4 OR PBY5 OR PBY3
7310 PUSHJ P,PWRD ;NOT IN CONST., OUTPUT WORD.
7312 PBY3: JSP T,PCONS ;OUTPUT INTO CONST.
7315 BYTINR: MOVE A,T1 ;CURRENT BYTE SIZE
7318 SETZB A,B ;ASSEMBLE HOLE (BLANK BYTE) IMMEDIATELY AFTER PREVIOUS BYTE
7322 PBY2: MOVEI AA,WRD-1
7323 PUSH AA,BYTW ;INTO WRD
7324 PUSH AA,BYTRLC ;INTO WRDRLC
7326 LDB T,[301400,,BYTWP]
7328 POP AA,BYTRLC ;WRDRLC
7332 ;VARIABLES FOR .BYTE, .BYTC, .WALGN
7335 BYTM: 0 ;-1 FOR IN BYTE MODE, LAMBDA BOUND BY <'S, ('S, AND ['S ;]
7336 BYTMC: 0 ;COUNT CORRESP WITH BYTMP
7337 BYTMP: 0 ;POINTER TO BYTE DESC TABLE
7338 BYTMT: 0 ;TOTAL ACTIVE BYTES IN TABLE
7339 BYTM1: 0 ;GLOBAL VALUE OF BYTM - WHAT IT WAS OUTSIDE THE OUTERMOST BRACKET
7341 ;FORMAT OF BYTE DESC TABLE
7343 ;1.7=0 ASSEMBLE =1 BLANK
7344 ;1.1 - 1.6 NUMBER OF BITS
7346 IFNDEF LBYBYT,LBYBYT==5 ;LENGTH OF BYBYT
7347 BLCODE [BYBYT: BLOCK LBYBYT] ;BYTE DESC TABLE, 7 BITS PER DESC
7349 BYTWP: 440000,,BYTW ;POINTER TO BYTW IDPB TO DEPOSIT CURRENT BYTE
7350 BYTW: 0 ;WORD BEING ASSEMBLED IN BYTE MODE
7351 BYTRLC: 0 ;RELOC OF BYTW.
7352 NBYTS: 0 ;NUMBER BYTES ASSEMBLED (FOR .BYTC)
7357 ;GET IN B THE CHAR WHOSE ADR IS IN A, INCREMENT A
7364 VBLK ;THIS STUFF ALL RELOCATED WHEN MACTAB ADDR CHANGED.
7365 PTAB: (341000+CH1)MACTBA ;BYTE TABLE
7369 (341000+CH1)MACTBA+1
7371 ;IN FOLLOWING MACROS, B = -1, 0, OR +1 (+ SIGN MUST BE GIVEN)
7372 ;0 => BP SAME AS CHAR ADR, -1 => BP FOR ILDB, 1 => BP ONE AHEAD
7374 ;CHAR ADR IN A, RETURNS BP IN A, CLOBBERS A+1
7378 ADD <A>,(<A>+1)BCOMPT!B
7381 STOPPT: 041000,,MACTBA-1
7382 BCOMPT: 341000,,MACTBA
7384 BCOMPU: 141000,,MACTBA
7388 ;BP IN A RETURN CHAR ADR IN A, CLOBBERS A-1 (YES, A MINUS 1)
7389 ;2ND ARG IS SUBTRACTED - -1 GIVES ADDR OF THE NEXT CHAR.
7393 SUB <A>,(<A>-1)CCOMPT!B
7396 ;BP IN A RETURN CHAR ADR IN A+1, CLOBBERS A
7400 SUB <A>+1,(A)CCOMPT!B
7403 ;FROM HERE THRU CCOMPE SET BY MACINI.
7404 CCOMPB: 0 ;4*<41000,,MACTBA>-4
7405 CCOMPT: REPEAT 5,0 ;4*<41000,,MACTBA>+.RPCNT-3
7408 ;BP IN A, DECREMENT IT
7416 ;SET UP CPTR FROM CHAR ADR IN A
7418 ACPTRS: MOVEI CH1,(A) ;GET CHAR ADR IN CH1
7419 BCOMP CH1,-1 ;CONVERT TO BYTE POINTER
7420 MOVEM CH1,CPTR ;STORE COMPUTED CPTR
7423 AFCOMP: HRRZM A,FREEPT ;ENTRY TO STORE C(A) INTO FREEPT
7424 FCOMP: MOVE CH1,FREEPT ;COMPUTE FREPTB FROM FREEPT
7426 MOVEM CH1,FREPTB ;STORE CALCULATED BYTE POINTER
7434 PUTREL: JRST PUTRE1 ;IDPB A,FREPTB;STORE CHAR INTO FREE CHARACTER STORAGE
7435 AOS A,FREEPT ;CLOBBERS ONLY A.
7441 PUTRE1: PUSH P,[IDPB A,FREPTB]
7442 POP P,PUTREL ;COME HERE ONLY ON 1ST CALL TO PUTREL.
7443 SETOM INICLB ;HAVE WRITTEN IN MACRO TAB & CLOBBERED INIT.
7444 JRST PUTREL ;NOW GO BACK AND REALLY WRITE CHAR.
7446 ;200 BIT SET ON CHAR READ FROM MACTAB, PROCESS SPECIAL CONDITION
7447 ;CLOBBERS A,CH1,CH2.
7449 MACTRM: CAIN A,176 ;376?
7450 JRST RCHTRA ;376 => IGNORE, CHARACTER USED TO CLOBBER UNDESIRED CHARACTERS IN MACRO STORAGE
7454 JRST MRCH1 ;377, 375 => STOP
7455 ADD A,BBASE ;DUMMY, RELOCATE TO POINT TO DUMMY TABLE
7456 MOVEI B,RCHSAV ;RETURN TO RCHSAV ON END OF DUMMY
7457 PUSHJ P,PUSHEM ;SAVE CURRENT STATUS
7458 HRRZ A,(A) ;GET CHAR ADR OF DUMMY
7459 BCOMP A,-1 ;CONVERT TO BYTE POINTER
7460 MOVEM A,CPTR ;STORE AS NEW CPTR
7464 RCHTRA: POP P,A ;POP RETURN
7470 BPOPJ: POPJ B, ;RETURN AT END OF STRING EXPANSION
7472 ;RCHSET ROUTINE TO CAUSE INPUT FROM MACRO PROCESSOR
7474 RCHMAC: TLO FF,FLMAC ;SET FLAG
7476 RCHMC0: REPEAT 2,[ ;GETCHR, RR1
7477 ILDB A,CPTR ;GET CHAR
7478 TRZE A,200 ;200 BIT...
7479 PUSHJ P,MACTRM ;=> SPECIAL, PROCESS
7482 IFN .-RCHPSN-RCHMC0,.ERR RCHMC0 LOSES.
7490 ;PUSH INPUT STATUS IN FAVOR OF MACRO
7491 ;B HAS RETURN ADR FOR END OF MACRO (OR WHATEVER)
7496 MOVE F,MACP ;GET MACRO PDL POINTER
7498 CCOMP1 CH1,-1 ;CONVERT TO CHARACTER ADDRESS
7500 PUSH F,CH2 ;PUSH BBASE,,CPTR
7501 MOVEI A,1 ;=> EXPAND MACRO
7502 PUSHJ P,PSHLMB ;SAVE LIMBO1 STATUS AND RETURN
7506 ;RETURNS BBASE,,CPTR IN B (CPTR RE-INITIALIZED, BBASE NOT)
7511 PUSHJ P,POPLMB ;RESTORE LIMBO1 STATUS
7512 POP F,B ;BBASE,,CPTR
7513 MOVEI CH1,(B) ;GET CHAR ADR IN CH1
7514 BCOMP CH1,-1 ;CONVERT TO BYTE POINTER
7515 MOVEM CH1,CPTR ;STORE NEW CPTR
7516 PSHM1: MOVEM F,MACP ;STORE BACK MACRO PDL POINTER
7521 PMACP: MOVE B,MACP ;POP MACRO PDL
7524 IFN RCHASW,CAIE A,A.TYM8
7526 JRST A.GO6 ;IRP OR .TTYMAC
7529 CAIE A,RCHSV1 ;MACRO
7532 .VALUE ;DON'T HAVE RETURN,
7533 JRST A.GO6 ;BUT TRY A.GO6 LIKE EVERYTHING BUT REPEAT
7535 A.GO4: HLLZS -1(B) ;REPEAT, CLEAR OUT COUNT REMAINING
7536 A.GO6: TRO FF,FRMRGO ;EVERYTHING ELSE, SET FLAG TO QUIT
7539 ;4.9(B) => .STOP ELSE .ISTOP
7545 HLLZS -2(A) ;REPEAT, STOP ALL INTERATIONS
7547 HRRZS -1(A) ;IRP TYPE, CLEAR OUT # GROUPS, DON'T ALLOW RECYCLE
7548 A.STP1: MOVE A,STOPPT
7549 MOVEM A,CPTR ;CAUSE STOP
7553 ATERMI: ETSM [ASCIZ/Not in macro/]
7554 JRST MACCR ;MAYBE FLUSH MESSAGE IF PEOPLE HAVE PROBLEMS
7556 ;PDL STRUCTURE FOR REPEAT
7557 ;TWO TWO WORD ENTRIES
7559 ;LIMBO1 STATUS,,# TIMES LEFT
7560 ;OLD .RPCNT,,BEG OF BODY
7563 AREPEAT: PUSHJ P,AGETFD
7564 JUMPLE A,COND5 ;NO REPEAT PLAY LIKE STRING COND FALSE
7567 MOVEM A,PRREPT ;CHAR ADR BEGINNING OF REPEAT
7568 MOVEI A,373 ;CHECK CHAR FOR REPEAT
7569 PUSHJ P,PUTREL ;STORE AS FIRST CHR OF BODY
7572 CALL RARGCP ;READ THE ARG & COPY INTO MACRO STORAGE.
7573 MOVEI A,^M ;IF THE ARG WASN'T BRACKETED,
7575 CALL PUTREL ;INCLUDE THE TERMINATING CR.
7576 SWRET1: PUSHJ P,STPWR ;ALSO RETURN FROM STRING WRITE (.F .I)
7577 POP P,B ;# TIMES TO GO THROUGH
7579 MOVE B,MACP ;NOW GET MACRO PDL POINTER FOR PUSH OF SECOND ENTRY
7581 EXCH T,CRPTCT ;GET OLD .RPCNT, INITIALIZE NEW ONE TO -1
7582 CREPT1: SETZI TT,REPT1
7583 EXCH TT,PRREPT ;GET LOC BEGINNING OF BODY, CLEAR OUT PRREPT, DON'T NEED IT ANYMORE
7585 PUSH B,TT ;SAVE OLD .RPCNT,,ADDRESS OF BODY.
7586 PUSH B,CREPT1 ;PUSH CRUD,,REPT1 FOR RETURN
7587 MOVEM B,MACP ;STORE BACK UPDATED MACRO POINTER
7589 MOVEM A,CPTR ;CAUSE IMMEDIATE CYCLE
7592 IFN .I.FSW,[ ;CODING FOR .I, .F
7594 SWINI: MOVE A,FREEPT ;INITIALIZE, WILL EVENTUALLY PLAY LIKE REPEAT 1
7599 SWRET: PUSH P,[1] ;REPEAT COUNT
7602 SWFLS: MOVE A,PRREPT ;FLUSH RETURN
7607 ;RECYCLE AROUND REPEAT
7611 HRRZ A,(B) ;CHAR ADR BEG BODY
7614 HALT ;FIRST CHAR OF REPEAT BODY NOT 373
7616 HRRZ B,-2(C) ;# TIMES LEFT
7617 SOJL B,REPT2 ;JUMP IF LAST TIME THROUGH WAS LAST TIME TO GO THROUGH
7619 PUSHJ P,ACPTRS ;SET UP CPTR (CHAR ADR IN A)
7620 HRRM B,-2(C) ;STORE UPDATED COUNTDOWN
7625 REPT2: SOS A ;MOVE BACK TO BEG OF REPEAT
7626 ;(IN CASE GETS STORED INTO FREEPT)
7628 CCOMP CH2,-1 ;CONVERT TO CHARACTER ADDRESS
7638 ;STRING CONDITIONALS (IFSE, IFSN)
7640 SCOND: MOVE A,FREEPT
7645 SAVE B ;REMEMBER TEST INSTRUCTION.
7647 JSP D,RARG ;COPY THE 1ST OF THE 2 STRINGS
7649 CALL RARGCP ;INTO MACRO STORAGE, FOLLOWED BY 375.
7651 JSP D,RARG ;THEN START READING THE 2ND ARG,
7652 JRST SCOND3 ;GO TO SCOND3 WHEN REACH END OF 2ND ARG.
7653 JSP D,RARGCH(T) ;READ NEXT CHAR OF 2ND ARG,
7656 PUSHJ P,REDINC ;RE-FETCH NEXT CHAR OF 1ST ARG
7658 CAMN B,A ;COMPARE CHARACTERS
7659 JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING.
7661 CAILE A,"Z+40 ;NOT EQUAL => CONVERT BOTH TO UPPER CASE.
7668 CAMN B,A ;ARE THEY SAME EXCEPT FOR CASE?
7669 JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING.
7670 CLEARM SCONDF ;STRINGS DIFFER
7671 CALL RARFLS ;IGNORE REMAINDER OF 2ND ARG.
7672 SCOND3: CLEARB A,C ;END OF (SECOND) STRING ARG ENCOUNTERED
7687 BLCODE [DMYDEF: BLOCK DMDEFL] ;TABLE OF DUMMY NAMES FOR THING BEING DEFINED
7688 DMYTOP: DMYDEF ;POINTER INTO DMYDEF, POINTS TO AVAILABLE WORD
7689 ;SINCE ONLY ONE THING CAN BE DEFINED AT ONCE, IT IS NOT NECESSARY TO SAVE AND RESTORE DMYTOP
7690 DMYBOT: DMYDEF ;-> 1ST DMYDEF WD USED AT THIS LEVEL.
7691 ;RIGHT NOW, ALWAYS -> DMYDEF SINCE CAN'T HAVE DEFINITION
7692 ;WITHIN A DEFINITION YET.
7696 PDEF: PUSHJ P,GSYL ;READ IN SYL
7697 CAIE T,", ;IF DELIMITING CHR NOT ,
7698 JUMPE SYM,CPOPJ ;AND SYM NULL, RETURN
7699 PDEF1: MOVEM SYM,@DMYTOP ;STORE SYM
7700 AOS D,DMYTOP ;INCR PNTR
7701 CAIL D,DMYDEF+DMDEFL ;CHECK FOR TABLE SIZE EXCEEDED
7702 ETF [ASCIZ/Too many dummies in DEFINE or IRP/]
7706 BLCODE [DSTG: BLOCK DSSIZ] ;TABLE OF CHAR ADRS OF DUMMIES BEING DEFINED PRIOR TO MACRO EXPANSION
7707 RDWRDP: DSTG ;POINTER TO DSTG, POINTS TO FREE WORD
7708 ;NOTE THAT RDWRDP MUST BE SAVED AND RESTORED SINCE MORE MACROS CAN
7709 ;BE EXPANDED DURING FIELD READ FOR DUMMY
7712 ADDTR1: CLEARM PUTCNT
7713 ADDTRN: MOVE A,FREEPT
7714 ADDTR2: MOVEM A,@RDWRDP
7717 ETF [ASCIZ/Too many dummies in all macros & IRPs being expanded/]
7721 BLCODE [DMYAGT: BLOCK DMYAGL] ;TABLE OF CHAR ADRS OF DUMMYS OF MACROS BEING EXPANDED
7722 ;DMYAGT TRACKS WITH THE MACRO PDL;
7723 ;DMYAGT CAN'T BE COMBINED WITH DSTG SINCE DMYAGT CAN BE SHIFTING AROUND RANDOMLY DURING ARG SCAN
7724 BBASE: DMYAGT ;POINTER TO BEGINNING OF ACTIVE DUMMY LIST (FOR DEEPEST-NESTED MACRO BEING EXPANDED)
7725 ;ADD TO DUMMY # TO GET LOCATION CONTAINING CHAR ADR OF DUMMY
7726 TOPP: DMYAGT ;POINTER TO TOP OF DMYAGT ACTIVE, POINTS TO FREE REGISTER
7729 ;ACTIVATE DUMMYS ON TOP OF DSTG TABLE
7730 ;A -> FIRST (LOWEST) DUMMY IN DSTG TO ACTIVATE
7735 DMYTR2: CAML A,RDWRDP
7740 CAIL B,DMYAGT+DMYAGL
7741 ETF [ASCIZ /Too many dummy args active/]
7743 DMYTR1: POP P,RDWRDP
7746 ;THE MACRO TABLE IS FILLED MAINLY WITH 8-BIT BYTES.
7747 ;THE FIRST WORD'S ADDR IS IN MACTAD; THE LAST+1'S IN MACTND.
7748 ;THE CHARACTER NUMBER OF THE LAST+1ST CHAR IS IN MACHI.
7749 ;MACHIB IS BP. TO HIGHEST BYTE OK TO FILL (LAST IN C(MACTND)-1)
7751 ;IF A BYTE IN THE TABLE HAS ITS HIGH BIT OFF, IT IS AN ASCII CHARACTER.
7752 ;OTHERWISE, IT IS SPECIAL. IF THE 100 BIT IS OFF IT MEANS
7753 ;SUBSTITUTE A MACRO DUMMY ARG WHEN READ; THE CHAR IS THE NUMBER OF THE ARG+200 .
7755 ;377 AND 375 ARE STOP CODES, CAUSING A POP OUT OF THE CURRENT STRING.
7756 ;GC CONSIDERS THE CHAR. AFTER A 375 TO START A NEW STRING.
7758 ;376 IS IGNORED WHEN READ; USED TO CLOBBER UNWANTED CHARACTERS IN STRINHGS.
7760 ;374 STARTS EVERY MACRO-DEFINITION.
7761 ;373 STARTS THE BODY OF A REPEAT.
7763 ;370 STARTS A WORD STRING:
7764 ;THE WORD AFTER THAT WHICH CONTAINS THE 370
7765 ; HAS THE LENGTH IN WORDS OF THE STRING IN ITS LH,
7766 ; IN ITS RH, THE ADDRESS OF WD WHICH POINTS BACK TO THIS ONE.
7767 ; THEN FOLLOW RANDOM WDS HOLDING ANYTHING AT ALL.
7768 ; GC WILL MAKE SURE IT STAYS ON WD BOUNDARY.
7769 ; THE LENGTH INCLUDES THE WD HOLDING THE LENGTH.
7770 ; IF THE RH OF 1ST WD HAS 0, GC WILL FLUSH THE STRING
7772 STRTYP: PUSHJ P,REDINC ;DEBUGGING AID ONLY
7776 STRTP2: PUSHJ P,TYO ;NORMAL CHAR, JUST TYPE OUT
7781 MOVEI A,"* ;SPECIAL CHAR, TYPE *
7785 JRST STRTP3 ;CONTROL CHAR
7786 ADDI A,260 ;DUMMY, CONVERT TO #
7787 JRST STRTP2 ;TYPE OUT (SINGLE DIGIT) NUMBER
7790 SKIPA A,C% ;STOP, TYPE %
7791 MOVEI A,"/ ;SOMETHING ELSE, TYPE /
7795 ;.GSSET, SET GENERATED SYM COUNTER
7797 A.GSSET: CALL AGETFD
7801 ;GSYL-LIKE ROUTINE, READ A SYL FOR WRQOTE
7803 WRQRR: PUSHJ P,RCH ;GET CHAR (MAYBE WANT THIS TO BE FASTER YET)
7804 IDPB A,FREPTB ;DEPOSIT IN MACRO TABLE
7805 CAMN F,FREPTB ;WAS THIS LAST CHAR IN TABLE?
7806 JRST WRQRGC ;YES, NEED GARBAGE COLLECTION
7807 WRQRR2: XCT GDTAB(A) ;DISPATCH ON CHAR
7809 SOJGE D,WRQRR ;LOOP FOR FIRST SEVEN CHARS
7813 ;HERE FROM WRQRR WHEN NEED GARBAGE COLLECTION OF MACRO TABLE
7815 WRQRGC: MOVEM C,WRQTBP ;PUT POINTER TO BEGINNING OF SYL WHERE IT WILL BE GC'D
7817 PUSHJ P,GCA ;GARBAGE COLLECT
7818 MOVE F,MACHIB ;RESET F TO POINT TO NEW LAST CHAR IN MACTAB
7820 EXCH C,WRQTBP ;GET BACK POINTER TO CHAR BEFORE SYL
7821 MOVE A,LIMBO1 ;RETRIEVE LAST CHAR READ
7822 JRST WRQRR2 ;LOOP BACK, PROCESS CHAR
7824 ;HERE FROM WRQOTE IF .QUOTE SEEN
7825 ;.QUOTE TAKES ARG LIKE ASCII, PRINTC, ETC.
7827 A.QOT1: MOVE A,WRQBEG(P) ;GET BACK BP TO CHAR BEFORE .QUOTE
7828 PUSHJ P,A.QOTS ;SET UP FREEPT AND FREPTB PROPERLY
7829 MOVE A,LIMBO1 ;NOW GET CHAR AFTER .QUOTE
7831 CAIN A,40 ;COMPARE WITH SPACE
7832 PUSHJ P,RCH ;SPACE, GOBBLE NEXT CHAR FOR DELIMITER, ELSE THIS ONE
7833 MOVEM A,A.QOT2 ;STORE AS TERMINATOR OF STRING
7834 A.QOT3: PUSHJ P,RCH ;GET CHAR TO QUOTE
7835 CAMN A,A.QOT2 ;TERMINATOR?
7836 JRST WRQOT1 ;TERMINATOR, BACK FOR MORE DEFINITION
7837 PUSHJ P,PUTREL ;DEPOSIT CHAR
7840 ;READ IN BODY OF MACRO, IRP, OR WHATEVER
7842 WRQOTE: SAVE [0] ;USED FOR LENGTH OF SYMBOL (REALLY 6 MINUS IT).
7844 SAVE [0] ;THIS WD USED FOR DEFINE/TERMIN COUNT.
7846 SAVE [0] ;USED TO REMEMBER BEGINNING OF SYMBOL.
7848 SETOM INICLB ;CLOBBERED INITS, .SYMTAB NOW ILLEGAL.
7849 PUSHJ P,RCH ;MAYBE POP UP A LEVEL IN EXPANSIONS, SAVE MACTAB SPACE
7850 TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-INPUT
7851 MOVE F,MACHIB ;POINTER TO LAST CHAR OK TO PUT IN MACTAB, STAYS IN F
7852 TRO I,IRSYL\IRLET ;MAKE SURE FLAGS SET SO WON'T WASTE TIME AT MAKNUM, POINT
7854 WRQOT1: MOVEI D,6 ;SQUOZE COUNTER
7855 MOVEI SYM,0 ;INITIALIZE SYM
7856 MOVE C,FREPTB ;GET POINTER TO CHAR BEFORE SYL ABOUT TO READ
7857 PUSHJ P,WRQRR ;READ SYL
7858 JUMPE SYM,.-2 ;LOOP UNTIL NON-NULL
7859 ;NOW SEE IF DUMMY; **NOTE**: C STILL HAS BYTE POINTER, A SYL TERMINATOR
7862 JRST WRQOT2 ;NOT DUMMY
7863 CAME SYM,(B) ;COMPARE WITH DUMMY NAME
7864 AOJA B,.-3 ;LOOP ON NO MATCH
7865 SUB B,DMYBOT ;DUMMY, CONVERT TO NUMBER + 200
7867 LDB T,C ;GET LAST CHAR BEFORE SYL
7868 CAIE T,"! ; ^ NOTE THAT THIS CAN LOSE IF MACRO HAS 33. ARGS
7869 IDPB B,C ;NOT EXCLAMATION POINT, LEAVE THERE, DEPOSITING DUMMY CHAR
7871 DPB B,C ;EXCL, WIPE IT OUT
7872 MOVEM C,FREPTB ;RESET FREPTB
7873 CAIE A,"! ;A HAS DUMMY TERMINATOR, COMPARE WITH EXCL
7874 TLO FF,FLUNRD ;NOT EXCLAMATION POINT, CAUSE IT TO BE RE-INPUT
7875 JRST WRQOT1 ;LOOP BACK FOR NEXT SYL
7877 ;SYL ISN'T DUMMY, CHECK FOR PSEUDO
7878 WRQOT2: MOVEM D,WRQLEN(P) ;REMEMBER START OF AND LENGHTH OF THE SYMBOL.
7880 SETOM ESBK ;EVAL IN CURRENT BLOCK.
7881 PUSHJ P,ES ;EVALUATE SYM (DOESN'T CLOBBER F)
7882 JRST WRQOT0 ;NOT SEEN
7884 JRST WRQOT0 ;NOT PSEUDO
7885 TLZ B,-1 ;CLEAR OUT LH OF VALUE, ONLY INTERESTED IN RH
7890 AOS WRQLVL(P) ;DEFINE OR IRP
7891 IFN RCHASW,[CAIN B,A.TTYM
7892 AOS WRQLVL(P) ;.TTYMAC
7897 ETR [ASCIZ /TERMIN longer than 6 chars/]
7898 SOSL WRQLVL(P) ;TERMIN, SKIP IF THE TERMINATING ONE
7899 JRST WRQOT0 ;NOT MATCHING TERMIN, BACK FOR NEXT SYL
7900 POP P,A ;GET BACK BP TO LAST CHAR BEFORE TERMIN
7901 SUB P,[2,,2] .SEE WRQLVL,WRQBEG
7902 MOVE T,DMYBOT ;WE'RE NO LONGER USING SPACE IN DMYDEF.
7904 A.QOTS: LDB T,A ;HERE ALSO FROM A.QOT1, GET CHAR BEFORE .QUOTE OR TERMIN
7906 JRST A.QTS2 ;NOT EXCLAMATION POINT => OK
7907 DBPM A, ;EXCLAMATION POINT, DECREMENT POINTER
7908 A.QTS2: MOVEM A,FREPTB ;STORE AS NEW FREPTB
7909 CCOMP1 A,-1 ;CONVERT TO CHAR ADR
7910 MOVEM B,FREEPT ;STORE CHAR ADR AS NEW FREEPT
7914 ;IT STARTS WITH A 374.
7915 ;THEN COME ARGUMENT DESCRIPTORS, ONE PER ARGUMENT.
7916 MCF==777650 ;BITS AND FIELDS ARE:
7917 MCFDEF==200 ;ARG IS DEFAULTED. MCFDEF AND MCFGEN NEVER BOTH SET.
7918 MCFGEN==100 ;ARG SHOULD BE GENSYMMED IF NOT GIVEN IN CALL.
7919 MCFKWD==40 ;ARG IS A KEYWORD ARG, SELECTED BY <ARGNAME>= RATHER THAN POSITION.
7920 MCFSYN==7 ;FIELD THAT SPECIFIES THE ARGUMENT'S SYNTAX.
7921 MCFNRM==1 ;MCFSYN CONTAINS MCFNRM => NORMAL-SYNTAX ARG
7922 MCFLIN==2 ;MCFSYN CONTAINS MCFLIN => WHOLE LINE ARG
7923 MCFBAL==3 ;MCFSYN CONTAINS MCFBAL => BALANCED ARG
7924 MCFSTR==4 ;MCFSYN CONTAINS MCFSTR => ARG IS A DELIMITED STRING, AS IN "ASCIZ".
7925 MCFEVL==5 ;MCFSYN CONTAINS MCFEVL => ARG IS BY VALUE (PREEVALUATED).
7926 ;IF MCFKWD IS SET, THE DESCRIPTOR IS FOLLOWED BY THE NAME OF THE ARGUMENT,
7927 ;TERMINATED BY A 377.
7928 ;IF MCFDEF IS SET, THE DESCRIPTOR IS FOLLOWED BY THE DEFAULT VALUE OF THE ARG,
7929 ;TERMINATED BY A 377.
7930 ;IF MCFKWD AND MCFDEF ARE BOTH SET, THE ARG NAME COMES FIRST.
7931 ;A ZERO BYTE ENDS THE DESCRIPTOR LIST.
7932 ;THEN COMES THE BODY OF THE MACRO, FOLLOWED BY A 375.
7934 ADEFINE: NOVAL ;ERROR IF CONTEXT WANTS A VALUE.
7935 SAVE CASSM1 ;RETURN TO ASSEM1 EVENTUALLY
7936 JSP TM,ERMARK ;ERR MSGS SHOULD SAY WE'RE INSIDE A DEFINE.
7937 SAVE SYM ;THESE 2 PUSHES ARE FOR NONAME'S SAKE.
7944 SAVE ESBK ;SAVE BLOCK TO DEFINE IN FOR ES'S SAKE.
7945 IFN CREFSW,XCT CRFMCD
7949 PUSHJ P,ESDEF ;FIND SLOT IN SYMBOL TABLE FOR IT
7950 TLO C,3MACOK ;NEVER SEEN, OK TO MAKE MACRO.
7951 TLON C,3MACOK ;ELSE ERROR IF NUMERIC OR ALREADY USED.
7952 ETSM [ASCIZ/Non-macro made macro/]
7953 MOVEI B,MACCL ;RH(VALUE) = MACCL
7954 HRL B,PRDEF ;LH(VALUE) = CHAR ADR OF MACRO
7955 CLEARM PRDEF ;NO LONGER NEED PRDEF
7956 MOVSI T,PSUDO ;SYMBOL TABLE ENTRY LOOKS LIKE PSEUDO
7964 ;NAME DUMMY, CAUSES READIN OF CRUD FROM TTY -> CR (NOT INCLUSIVE)
7966 A.TTYM: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WE'RE INSIDE A .TTYMAC
7967 CALL A.TYM1 ;READ IN A MACRO-DEFINITION.
7968 MOVEI A,40 ;DON'T LET THE CHAR ENDING THE TERMIN
7969 MOVEM A,LIMBO1 ;MAKE MACCL THINK THERE ARE NO ARGS.
7970 CALL GTYIP1 ;PUSH INTO TTY FOR INPUT
7971 HRLZ B,PRDEF ;PHONY UP A MACRO WHOSE DEFN IS WHAT WE READ.
7974 JRST A.TYM2 ;CALL THE MACRO:
7975 ;READ THE ARGS, POP OUT OF TTY, EXPAND THE MACRO
7976 ;AND THEN EXIT TO A.TYM8
7979 A.TYM1: MOVE A,FREEPT
7981 MOVEI LINK,MCFNRM ;INITIALLY, DUMMIES ARE NORMAL.
7983 PUSHJ P,PUTREL ;MARK BEGINNING OF MACRO
7984 DEFNI: MOVE T,LIMBO1
7988 JRST DEFNA ;NO MORE ARGS (DONE WITH LINE)
7995 CAIE T,"< ;OPENS TURN ON BALANCEDNESS.
7998 CAIE T,"> ;CLOSES TURN OFF BALANCEDNESS.
8001 CAIN T,"? ;? TURNS BALANCEDNESS ON OR OFF.
8003 CAIN T,"+ ;+ COMPLEMENTS KEYWORDNESS
8005 CAIN T,"\ ;\ COMPLEMENTS GENSYMMEDNESS
8007 CAIN T,"- ;- TURNS WHOLELINENESS ON OR OFF.
8009 CAIN T,"* ;* TURNS ASCIZ-STYLE-NESS ON OR OFF.
8011 CAIN T,"# ;# TURNS EVALUATEDNESS ON OR OFF.
8013 CAIN T,": ;: MAKES FOLLOWING ARGS NORMAL
8014 MOVEI LINK,MCFNRM ;IN ALL RESPECTS
8016 JRST DEFNSM ;ALLOW DEFINE LINE TO BE COMMENTED
8018 CALL GSYL ;READ IN SYMBOL AS SQUOZE IN SYM.
8020 CAIN T,"/ ;/ MEANS PREVIOUS ARG IS WHOLE-LINE.
8021 XORI LINK,MCFLIN#MCFNRM
8022 JUMPE SYM,DEFNC ;JUMP IF SYMBOL NAME WAS NULL.
8023 CALL PDEF1 ;ELSE PUSH IT ON LIST OF DUMMIES.
8027 IORI A,MCFDEF ;ONE ARG, WITH DEFAULT VALUE.
8028 ANDCMI A,MCFGEN ;NOT TO BE GENSYMMED.
8029 DEFNL: CALL PUTREL ;OUTPUT A DESCRIPTOR FOR THIS ARG
8031 CALL DEFNM ;PUT OUT ARG NAME IF KWD ARG
8032 CAIE T,"= ;THEN DEFAULT VALUE IF DEFAULTED.
8034 JSP D,RARG ;INIT. FOR READING THE DEFAULT VALUE.
8036 CALL RARGCP ;COPY THE ARG INTO MACRO SPACE,
8037 CALL PUT377 ;TERMINATED BY A 377.
8038 JRST DEFNI ;NOW FOR THE NEXT ARG.
8040 DEFNM: MOVE D,[440700,,STRSTO]
8047 DEFEVL: SKIPA A,[MCFEVL] ;TURN EVALUATEDNESS ON OR OFF.
8048 DEFASC: MOVEI A,MCFSTR ;TURN ASCIINESS ON OR OFF.
8051 DEFBAL: SKIPA A,[MCFBAL] ;TURN ON BALANCEDNESS, BUT IF ALREADY ON TURN OFF.
8052 DEFWHL: MOVEI A,MCFLIN ;SIMILAR FOR WHOLELINENESS.
8053 DEFN9: LDB B,[.BP MCFSYN,LINK]
8054 CAMN A,B ;IF CURRENT STATE IS SAME AS IN A,
8055 MOVEI A,MCFNRM ;SWITCH TO NORMAL MODE INSTEAD.
8056 DPB A,[.BP MCFSYN,LINK]
8059 DEFNB2: SKIPA A,[MCFNRM] ;TURN OFF BALANCEDNESS
8060 DEFNB1: MOVEI A,MCFBAL ;TURN ON BALANCEDNESS
8061 DPB A,[.BP MCFSYN,LINK]
8064 DEFNSM: PUSHJ P,RCH ;SEMICOLON IN DEFINE LINE
8067 DEFNA: SKIPA A,LINK ;END OF DEFINE LINE, GET COUNT
8070 PUSHJ P,PUTREL ;DEPOSIT END-OF-DESCRIPTORS MARK
8073 TLO FF,FLUNRD ;CHAR AFTER CR NOT LF
8074 PUSHJ P,WRQOTE ;READ IN BODY
8077 ;COME HERE TO EXPAND MACRO; LH OF B POINTS TO STRING.
8078 ;SYM HOLDS NAME OF MACRO (USED BY CALL TO AGETFD IN MACEVL).
8079 MACCL: JSP TM,ERMARK ;ERROR MESSAGE DURING ARG SCAN SHOULD SAY WE'RE IN IT.
8085 SAVE A ;RCHSV1 FOR MACRO, A.TYM8 FOR .TTYMA
8093 JUMPE B,[TLO FF,FLUNRD ;SAVE CHR FOLLOWING MACRO W/NO ARGUEMENTS
8094 TLZ I,ILPRN ;SUCH MACROS
8095 SKIPE B,ASMOUT ;IF WITHIN A GROUPING,
8098 JSP LINK,SAVAS2 ;RESTORE ASMDSP TO NORMAL IN CASE
8099 JRST MACNX0] ;THE CHAR BEING REREAD IS A CLOSE.
8104 JRST MACCLD ;NO ARGS IN THIS CALL; NULLIFY ALL ARGS.
8107 TLO I,ILPRN ;BUT MAYBE THERE IS A (. IF SO, IT'S A PAREN'D CALL,
8108 CAIN A,LBRKT ;AND WON'T END TILL THE MATCHING CLOSE.
8110 CAIE A,40 ;IF THE CHAR ENDING THE MACRO NAME ISN'T AN OPENPAREN,
8111 CAIN A,^I ;EOL, OR SPACE, RE-READ IT AS PART OF 1ST MACRO ARG.
8115 MACNX0: TDZ LINK,LINK
8116 MACNXD: CALL MACDES ;FETCH NEXT DESCRIPTOR
8117 JRST MACPUS ;NO MORE => THIS IS END OF THE CALL
8119 JRST MACK ;KEYWORD PARAM => SPECIAL SCANNER
8120 ;READ IN THE VALUE OF THE NEXT ARG, WHICH IS NORMAL (NOT KEYWORD)
8121 MACNRM: CALL ADDTRN ;PUSH WORD TO HOLD VALUE OF ARG ONTO DSTG,
8122 ;INITIALIZED -> FREEPT, WHERE WE WILL NOW WRITE THE ARG.
8123 SOS C,A ;TELL MACRED WHERE THAT WORD IS.
8124 CALL MACRED ;READ IN THE ARGUMENT VALUE.
8125 JRST MACNXD ;THEN HANDLE ANOTHER ARG
8127 JRST MACCLD ;END OF ARG LIST => NULLIFY REMAINING ARGS.
8129 ;READ IN THE NEXT MACRO ARGUMENT ACC TO SYNTAX FLAGS IN LINK.
8130 ;C HAS ADDRESS OF WORD ON THE RDWRDP STACK WHICH HOLDS THE POINTER TO THIS ARG
8131 ;IN CASE WE WISH TO SET THE ARG TO THE NULL STRING. B AND LINK NOT CLOBBERED.
8132 ;RETURNS SKIPPING TWICE IF NO ARG BECAUSE END OF MACRO CALL SEEN.
8133 MACRED: MOVEI D,MACNXR ;RARL3, RARB, RARGBR RETURN TO MACNXR
8137 JRST MACEND ;MAYBE WE HAVE REACHED THE END OF THE MACRO CALL.
8138 LDB B,[.BP MCFSYN,LINK]
8140 JRST RARL3 ;ELSE, IF WHOLELINE ARG, NOTHING ELSE TO CHECK,
8141 ;SO INIT FOR READING IT IN.
8143 JRST MACNUL ;NON-WHOLELINE ARG IS NULL IF NEXT CHAR IS COMMA
8144 CAIN A,"; ;SEMICOLON ENDS ARG LIST UNLESS INSIDE WHOLELINE ARG
8147 JRST RARB ;FOR BALANCED ARG, NOTHING ELSE SPECIAL, SO INIT.
8150 CAIN B,MCFEVL ;FOR EVALUATED ARG, READ FIELD AND EXPRESS AS NUMERAL.
8151 TLOA FF,FLUNRD ;AND THE CHAR WE JUST READ WAS THE 1ST CHAR OF THE FIELD.
8152 CAIN A,"\ ;NORMAL ARG STARTING WITH "\" TREATED THE SAME WAY, BUT FIELD
8153 JRST MACEVL ;STARTS WITH NEXT CHAR.
8155 JRST RARGBR ;FOR ORDINARY ARG, OPEN-BRACKET MAKES IT SPECIAL
8160 MOVEI T,RARGN ;OTHERWISE IT'S A NORMAL ARG
8161 TLOA FF,FLUNRD ;AND THE CHAR WE RCH'ED IS THE 1ST CHAR OF IT
8162 MACNXR: JRST MACEN1 ;NON-SKIP RETURN FROM RARB, RARL3 OR RARGBR => ARG NULL
8163 CALL RARGCP ;ARG NON-NULL => COPY IT INTO STRING SPACE
8165 CSTPWR: JRST STPWR ;AND TERMINATE IT
8166 MACSC: MOVE A,(C) ;EXCEPT THAT SEMICOLONS INVALIDATE ALL THE SPACES
8167 CAME A,FREEPT ;AND TABS THAT PRECEDE THEM.
8168 JRST STPWR ;IF, AS A RESULT OF THAT, THE ARG IS NULL, END THE ARGLIST.
8169 ;COME HERE WHEN THE END OF THE MACRO'S WHOLE ARGLIST IS SEEN.
8170 MACEND: TLO FF,FLUNRD
8171 MACEN1: AOS (P) ;2-SKIP RETURN FROM MACRED INDICATES END OF ARGLIST
8172 AOS (P) ;END OF ARGLIST => THIS ARG IS NULL.
8173 ;COME HERE TO NULLIFY CURRENT ARG (WHERE C POINTS)
8174 MACNUL: TRZE LINK,MCFDEF
8175 JRST MACDEF ;MAYBE DEFAULT IT
8177 JRST MACGEN ;MAYBE GENSYM IT
8178 SETZM (C) ;ELSE SET TO NULL STRING.
8184 MACSTR: CAIE A,40 ;HERE FOR ARG DELIMITED LIKE TEXT STRINGS: /TEXT/.
8185 CAIN A,^I ;SKIP ALL SPACES AND TABS BEFORE THE ARG.
8187 JSP D,RARB ;FIND END OF LINE, COMMENT, OR CLOSEBRACKET =>
8188 JRST MACEND ;NULLIFY ARG AND END MACRO CALL.
8189 MOVE T,A ;ELSE SAVE THIS CHAR; IT'S THE DELIMITER.
8192 CALL RCH ;READ ANOTHER CHARACTER. IF IT ISN'T THE DELIMITER,
8194 JRST MACST2 ;STORE IT AND READ ANOTHER.
8196 MACST3: CALL RCH ;PASS BY SPACES AFTER THE CLOSING DELIMITER
8200 CAIE A,", ;COMMA HERE ENDS THE ARG BUT NOT THE MACRO CALL.
8201 JSP D,RARB ;ELSE CHECK FOR OTHER TERMINATORS.
8202 RET ;WE FOUND AN ACCEPTABLE ARG TERMINATOR.
8203 ETR [ASCIZ /Garbage in ASCIZ-style macro arg/]
8204 JRST RARFLS ;IF THERE'S ANYTHING ELSE, COMPLAIN AND SKIP IT.
8206 ;COME HERE TO GIVE AN ARG ITS DEFAULT VALUE.
8207 ;MCFDEF WAS CLEARED SO MACDES WILL KNOW THE DEFAULT VALUE HAS
8208 ;ALREADY BEEN PASSED OVER AND WON'T TRY TO SKIP OVER IT.
8209 ;IF MCFKWD IS SET, WE MUST SKIP OVER THE KWD ARG'S NAME FIRST.
8210 MACDEF: MOVE A,@PRCALP ;COPY THE DEFAULT VALUE FROM THE MACRO BODY
8216 MACDF1: CALL REDINC ;AS THE ARGUMENT STRING.
8218 JRST MACDF2 ;END OF THE DEFAULT VALUE.
8224 MACDF2: MOVEM A,@PRCALP
8227 ;COME HERE IF GENSYMMABLE ARG IS SPEC'D AS NULL.
8240 ;PROCESS ARG THAT STARTS WITH \, OR #-TYPE ARG.
8241 MACEVL: CALL RCH ;FIRST, CHECK FOR IMMEDIATE END OF MACRO CALL.
8245 PUSH P,LINK ;SAVE LINK, NEED FLAGS
8246 PUSHJ P,AGETFD ;GET THE FIELD
8248 ETR [ASCIZ /Relocatable \'d macro arg/]
8250 REST C ;IF AGETFD EXPANDED A MACRO, FREEPT HAS CHANGED, SO
8251 MOVE CH1,FREEPT ;PUT NEW VALUE INTO THE POINTER TO THIS DUMMY.
8253 MOVE CH1,A ;SAVE VALUE OF FIELD FROM CLOBBERAGE
8255 MACEV1: LSHC CH1,-35. ;NOW "TYPE OUT" VALUE OF FIELD IN CURRENT RADIX
8263 JRST PUTREL ;OUTPUT TO MACTAB STRING BEING DEFINED
8265 ;HANDLE KEYWORD PARAMETERS. COME HERE WHEN A DESCRIPTOR IS SEEN
8266 ;THAT SPECIFIES A KEYWORD PARAMETER.
8270 ;FIRST, PUSH A "NOT SET" MARKER FOR EACH OF THE KEYWORD PARAMS IN THIS RUN OF SUCH.
8273 CALL MACDES ;NOTE THAT THERE IS ONLY ONE PARAM PER DESCRIPTOR
8274 JRST MACK1 ;FOR KEYWORD PARAMS, SO NO NEED TO COUNT DOWN.
8278 REST @PRCALP ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM.
8279 MACKLP: CALL GPASST ;NOW SEE IF THERE'S AN ARGUMENT TO BE FOUND
8280 CAIE A,^M ;IF SO, IT SHOUDL START WITH A KEYWORD.
8282 JRST MACKND ;CR OR LF => NO KEYWORD, AND END SCAN.
8286 JRST MACKN1 ;NULL ARG => NO KEYWORD, BUT DON'T END SCAN.
8289 JRST MACKND ;DETECT END OF PARENTHESIZED CALLS, ETC.
8294 CALL GSYL ;THERE SHOULD BE ANOTHER ARG, SO TRY READING KEYWORD NAME
8296 MOVE C,(P) ;NOW SCAN THROUGH THIS RUN OF KEYWORD PARAMS FOR THE
8297 SAVE @PRCALP ;ONE WHOSE NAME MATCHES WHAT GSYL READ.
8300 JRST MACKL5 ;NOT FOLLOWED BY "="??
8302 MACKL4: MOVE D,[440700,,STRSTO]
8306 CAIN B,377 ;IF REACHED END OF KEYWORD'S NAME, AND EQUAL SO FAR
8307 JRST MACKL2 ;SEE IF ARG'S NAME ALSO OVER.
8309 JRST MACKL1 ;ELSE KEEP COMPARING IF NAMES STILL SAME SO FAR.
8310 MACKL6: MOVEM A,@PRCALP
8311 CALL MACDES ;THIS KEYWORD DOESN'T MATCH SO FIND THE NEXT
8312 JRST MACKL3 ;THERE ARE NO MORE; LOSE - ARG WITH BAD KEYWORD.
8317 MACKL5: ETR [ASCIZ /Bad format keyword argument/]
8318 TLOA FF,FLUNRD ;INCLUDE THE BAD NON-"=" AS PART OF WHAT WE DISCARD
8319 MACKL3: ETR [ASCIZ /Arg with undefined keyword/]
8321 CALL RARFLS ;SKIP AN ORDINARY-SYNTAX MACRO ARG TO TRY TO RECOVER.
8324 ;COME HERE AFTER FINDING THE PARAM THAT MATCHES THIS ARG.
8325 ;C POINTS TO THE WORD IN DSTG FOR THAT ARG (DSTG IS WHAT ADDTRN PUSHES IN)
8326 MACKL2: TRZ LINK,MCFKWD ;(IN CASE WE GO TO MACKL6, SINCE KWD NAME SKIPPED ALREADY)
8328 JRST MACKL6 ;KWD NAME OVER BUT SPEC'D NAME NOT => MISMATCH
8330 CALL MACRED ;READ IN THE VALUE OF THE ARG, THUS SETTING THIS PARAM.
8331 JRST MACK1 ;THERE ARE MORE ARGS => HANDLE THEM
8335 MACKND: TLO FF,FLUNRD ;MACRO CALL TERMINATOR SEEN.
8336 ;NULL ARG SEEN; ENDS THIS RUN OF KEYWORD ARGS BUT NOT THE CALL.
8337 MACKN1: REST C ;GET PTR TO 1ST KWD ARG'S VALUE-WORD
8339 AOJN A,MACKN4 ;IF THIS ARG WASN'T SPECIFIED,
8341 CALL MACNUL ;NULLIFY IT (MAYBE DEFAULT OR GENSYM)
8342 MACKN4: CALL MACDES ;NOW SKIP OVER THE DESCRIPTORS OF THIS RUN OF KEYWORD PARAMS
8343 JRST MACPUS ;EXHAUSTED ALL THE DESCR'S => END OF MACRO CALL.
8344 TRNE LINK,MCFKWD ;SAME IF REACH A NON-KWD ARG.
8346 TLNN FF,FLUNRD ;REACHED A NON-KEYWORD PARAM: IF TERMINATOR WAS A NULL ARG,
8347 JRST MACNRM ;GO ON TO READ THE VALUE OF THE NON-KEYWORD PARAM.
8348 JRST MACCLS ;ELSE CALL WAS REALLY ENDED, SO NULLIFY REMAINING ARGS.
8350 ;COME HERE TO FIND THE NEXT DESCRIPTOR.
8351 ;SKIPS OVER THE NAME AND DEFAULT VALUE OF THE PREVIOUS DESCRIPTOR, IF ANY.
8352 ;THE CONTENTS OF LINKK SAY WHETHER THEY EXIST TO BE SKIPPED OVER.
8353 MACDES: MOVE A,@PRCALP
8354 CALL REDINC ;READ NEXT CHAR OF MACRO
8356 TRNE LINK,MCFKWD\MCFDEF
8357 JRST [ CAIE B,377 ;IF THERE'S NAME OR DEFAULT TO SKIP, GO PAST TERMINATOR
8359 TRZN LINK,MCFKWD ;AND SAY WE FOUND ONE
8360 TRZ LINK,MCFDEF ;NOTE THERE MAY BE ANOTHER, IN WHICH CASE WE WILL
8361 JRST MACDES] ;SKIP TILL ANOTHER 377
8362 JUMPE B,CPOPJ ;THIS DESC IS TERMINATOR => RETURN NO SKIP.
8363 MOVEI LINK,(B) ;ELSE PUT FLAGS IN LINK.
8366 ;COME HERE WHEN A MACRO CALL TERMINATOR IS ENCOUNTERED, TO NULLIFY ALL
8367 ;THE REMAINING PARAMS THAT THE MACRO WANTS, THEN ENTER THE MACRO.
8368 ;ENTER AT MACCLS IF HAVE JUST READ A DESCRIPTOR AND NOT NULLIFIED THE ARG,
8369 ;OR AT MACCLD IF HAVE JUST PROCESSED AN ARG, TO READ THE NEXT DESCRIPTOR.
8370 MACCLS: TRNE LINK,MCFDEF\MCFGEN
8372 SETZ A, ;NULLIFY NON-GENSYMMED, NON-DEFAULTED ARGS QUICKLY
8374 MACCLD: CALL MACDES ;THEN READ THE NEXT DESCRIPTOR.
8375 JRST MACPUS ;IF NO MORE ARGS, ENTER THE MACRO.
8378 MACCL2: CALL ADDTRN ;FOR GENSYMMED OR DEFAULTED ARG, PUSH PTR TO FREE STG
8380 CALL MACNUL ;THEN WRITE THE DESIRED VALUE THERE
8381 JRST MACCLD ;THEN HANDLE NEXT DESCRIPTOR.
8383 ;COME TO MACPUS WHEN ALL THE PARAMS HAVE HAD VALUES PUT IN DSTG (USING ADDTRN)
8384 ;TO ENTER THE MACRO.
8385 MACPUS: TLZE I,ILPRN ;SPECIAL PARENTHESIZED CALL?
8386 CALL MACPRN ;YES, SKIP PAST THE CLOSING PAREN.
8387 MOVE B,(P) ;IS THIS A .TTYMAC?
8389 CALL A.INEO ;YES, POP OUT OF TTY AFTER READING ARGS.
8391 REST B ;RCHSV1 OR A.TYM8
8394 PUSHJ P,ACPTRS ;SET UP CPTR
8399 MACCR: AOS (P) ;COMMON RETURN FROM PSEUDOS TO RETURN FROM GETVAL WITHOUT VALUE
8400 CMACCR: POPJ P,MACCR
8402 MACPRN: MOVEI TT,1 ;START PAREN-DEPTH AT 1
8403 JSP D,RARBC ;AND READ CHARS, UPDATING THE DEPTH, UNTIL
8405 JUMPN TT,.-2 ;THE DEPTH GETS TO BE 0.
8408 A.GOMC: ILDB B,A ;.GO ROUTINE TO SKIP PAST DESCRIPTORS
8409 JUMPN B,A.GOMC ;IN HEADER OF MACRO DEFINITION.
8412 RCHSV1: SOS MDEPTH ;END OF MACRO EXPANSION, DECREMENT DEPTH IN MACRO EXPANSIONS
8413 A.TYM8: PUSH P,A ;ENTRY FROM .TTYMAC END OF EXPANSION
8415 RCHSV3: CAMG B,BBASE
8422 HRRZ A,-1(B) ;GET NEW FREEPT
8426 ;RETURN ROUTINE FOR END OF DUMMY
8427 RCHSAV: MOVE B,BBASE
8431 REPT6: TRZE FF,FRMRGO
8432 POPJ P, ;RETURN TO .GO
8435 ;IRP, IRPS, IRPC, IRPW, IRPNC ALL CALL HERE.
8436 ;ALL USE 2 FRAMES ON THE MACRO PDL:
8437 ; <OLD BBASE>,,<OLD CPTR>
8438 ; <SAVED LIMBO1 STATUS>,,<OUTER .IRPCNT>
8439 ; <IRP TYPE>\<# GROUPS>,,<CHAR ADDR START OF IRP BODY>
8440 ; <SAVED TOPP>,,AIRR
8441 ;THE 3RD WORD HAS IN BITS 4.1-4.3 THE IRP TYPE CODE
8442 ; (NIRPO, NIRPC, ETC)
8443 ;AND IN THE REST OF THE LH, THE NUMBER OF GROUPS
8444 ; (TRIPLES OF TWO DUMMIES AND A LIST)
8446 .SEE NIRPO ;FOR DEFINITIONS OF IRP TYPE CODES.
8448 AIRP: JSP TM,ERMARK ;ERROR MESSAGES SHOULD SAY WE'RE INSIDE IT.
8451 HLRZ LINK,B ;GET IRP TYPE CODE TO INDEX BY.
8454 CALL AGETFD ;IRPNC, READ THE 3 NUMERIC ARGS.
8459 MOVEM A,AIRPN2 ;THE LAST ARG,
8460 REST AIRPN1 ;THE MIDDLE,
8461 REST AIRPN0 ;THE FIRST.
8463 AIRP0: SETZM IRPCR ;NO GROUPS SEEN YET.
8469 ;TRY TO READ IN ANOTHER GROUP.
8470 AIRP1: CALL PDEF ;READ IN DUMMY NAME, PUSH ON DMYTOP.
8471 CAIE T,", ;TERMINATOR WASN'T COMMA AND NAME WAS NULL
8472 JUMPE SYM,AIRP2 ;=> NO MORE GROUPS.
8473 CALL PDEF ;NONNULL GROUP, READ & PUSH 2ND NAME.
8474 CAIN T,"[ ;] TRY TO DETECT "IRP X,[", ETC. ]
8475 CALL [ETR [ASCIZ/Comma missing in IRP/]
8476 TLO FF,FLUNRD ;GENERATE A COMMA.
8478 CALL ADDTRN ;PUSH CHAR ADDR OF 1ST DUMMY,
8480 CAIN LINK,NIRPC ;LEAVE SPACE FOR IRPC'S 1ST ARG, IRPS'S 2ND.
8484 AOS -1(A) ;IRPS - 1ST ARG GOES AFTER NEXT 377.
8485 CALL ADDTRN ;PUSH CHAR ADDR OF 2ND DUMMY.
8488 XCT AIRP1T-1(LINK) ;MAYBE INCREMENT THAT ADDR.
8489 AOS IRPCR ;ONE MORE GROUP SEEN.
8490 JSP D,RARG ;INITIALIZE READING LIST.
8491 JRST AIRP3 ;NO LIST.
8498 NIRPN:: AIRPN ;IRPNC
8502 AOS -1(A) ;INCR. THE 2ND DUMMY ADDR FOR IRP, IRPC.
8504 JFCL ;DECR. FOR IRPS, NOTHING FOR IRPW.
8505 AOS -1(A) ;INCR. FOR IRPNC.
8507 ;READ LIST FOR IRPC OR IRP AND STUFF INTO STRING.
8509 AIRPO: CALL RARGCP ;COPY UP TO END OF ARG INTO MACRO SPACE.
8512 AIRPW3: CALL PUT377 ;END A LINE,
8514 CALL PUT377 ;IF NO ; YET, MAKE NULL 2ND ARG.
8515 ;COME HERE FOR IRPW, LOOP BACK FOR NEXT LINE.
8516 AIRPW: SETO C, ;NO ; SEEN YET IN LINE.
8517 AIRPW1: JSP D,RARGCH(T)
8518 JRST AIRP3 ;END OF LIST, GO WRITE 375.
8521 JRST AIRPW1 ;IGNORE NULL LINES.
8523 AOJE C,AIRPW2 ;ON 1ST SEMI, SWITCH TO 2ND ARG.
8526 JRST AIRPW3 ;END OF LINE => END BOTH ARGS, START OVER.
8529 JRST AIRP3 ;END OF LIST.
8535 AIRPS: SETO C, ;NO SQUOZE CHAR SEEN YET.
8536 AIRPS2: JSP D,RARGCH(T)
8541 AOJA C,AIRPS0 ;A SQUOZE CHAR OR !.
8542 JUMPL C,AIRPS2 ;NON SQUOZE FOLLOWING ANOTHER, FLUSH.
8543 DPB A,AIRPSP ;NONSQUOZE ENDING NONNULL SYL, PUT BEFORE SYL.
8545 CALL PUT377 ;FOLLOW SYL WITH 377.
8548 AIRPS0: JUMPN C,AIRPS3 ;NOT 1ST CHAR IN SYL?
8550 CALL PUT377 ;1ST, LEAVE A SPACE FOR THE SYL'S TERMINATOR.
8552 MOVEM A,AIRPSP ;REMEMBER WHERE THE SPACE IS.
8557 AIRPN: SKIPG C,AIRPN0 ;ANY CHARS TO IGNORE?
8562 AIRPN4: SKIPN C,AIRPN2 ;GET MAX # GRPS OF CHARS.
8563 JRST AIRPN7 ;0 => IGNORE THE REST.
8564 AIRPN5: MOVE B,AIRPN1 ;DO NEXT GRP, GET # CHARS/GRP.
8565 AIRPN6: JSP D,RARGCH(T)
8567 CALL PUTREL ;STORE THE NEXT CHAR.
8568 SOJG B,RARGCH(T) ;COUNT CHARS IN GRP.
8570 CALL PUTREL ;FOLLOW GRP BY 376.
8571 SOJN C,AIRPN5 ;MAYBE CAN DO MORE GRPS.
8572 AIRPN7: CALL RARFLS ;DID AS MANY GRPS AS CAN DO,
8573 ;IGNORE REMAINDER OF LIST.
8575 ;COME HERE WHEN EXHAUST THE LIST.
8577 JRST AIRP1 ;READ ANOTHER GROUP.
8579 ;ALL GROUPS READ IN; NOW READ IN BODY.
8580 AIRP2: CAIE T,"; ;IF A SEMICOLON ENDED THE ARGS, SKIP THE COMMENT.
8586 MOVE A,FREEPT ;SAVE CHAR ADDR START OF BODY
8587 MOVEM A,PRIRP ;WHERE GC WILL RELOCATE IT.
8588 PUSHJ P,RCH ;IF NEXT CHAR LF, THEN FLUSH IT
8591 PUSHJ P,WRQOTE ;READ BODY OF IRP
8592 PUSHJ P,STPWR ;WRITE STOP
8593 PUSHJ P,PUSHEM ;SAVE WORLD
8595 POP P,A ;RESTORE RDWRDP FROM LONG AGO
8596 PUSH P,TOPP ;NOW SAVE TOPP
8597 PUSHJ P,DMYTRN ;ACTIVATE DUMMYS
8598 MOVE B,MACP ;NOW GET MACRO PDL POINTER
8599 MOVE A,CIRPCT ;GET .IRPCNT
8600 HRRM A,(B) ;CLOBBER "RETURN" ON PDL TO OLD IRPCNT
8601 SETOM CIRPCT ;INITIALIZE IRPCNT
8602 MOVS A,IRPCR ;GET # GROUPS
8603 HRR A,PRIRP ;CHAR ADR OF BEGINNING OF BODY
8605 DPB LINK,[410300,,A] ;PUT IN TYPE OF IRP.
8606 PUSH B,A ;PUSH <SPECIFICATION BITS\# GROUPS>,,CHAR ADR BEGINNING
8607 POP P,A ;NOW GET OLD TOPP
8608 HRLS A ;MOVE TO LEFT HALF
8609 HRRI A,AIRR ;RETURN TO AIRR ON END OF BODY
8610 PUSH B,A ;PUSH OLD TOPP,,AIRP4
8611 MOVEM B,MACP ;STORE BACK UPDATED MACRO PDL POINTER
8613 MOVEM A,CPTR ;CAUSE STOP RIGHT AWAY TO CAUSE CYCLING
8617 ;RECYCLE THROUGH IRP
8620 AIRR: PUSH P,A ;A GETS BP ILDBING THRU ARG LIST.
8621 PUSH P,C ;C # GROUPS LEFT
8622 PUSH P,T ;T ADR OF PAIR OF CHAR ADR'S OF DUMMYS
8623 PUSH P,TT ;TT TYPE OF IRP (NIRPO, NIRPC, ETC)
8624 AOS CIRPCT ;INCREMENT .IRPCNT
8625 HRRZ A,(B) ;GET CHARACTER ADR BEG BODY FROM PDL
8626 PUSHJ P,ACPTRS ;SET UP CPTR
8629 JRST AIRR9 ;RETURN TO .GO
8630 HLRZ T,1(B) ;DUMMY TAB ADR
8631 LDB C,[220600,,(B)] ;# GROUPS
8632 JUMPE C,AIRR9 ;JUMP IF NO GROUPS
8633 LDB TT,[410300,,(B)] ;GET TYPE OF IRP (NIRPO, ETC)
8634 AIRR6: JRST @.+1(TT)
8635 AIRRER ? AIRRO ? AIRRC ? AIRRS ? AIRRW ? AIRRN ? AIRRER ? AIRRER
8638 ;MOVE 1 ARG THRU 1 GROUP OF IRP.
8639 AIRRO: HRRZ A,1(T) ;THE 1ST ARG WILL START THIS TIME
8640 HRRZM A,(T) ;WHERE THE "REST OF STRING" STARTED LAST TIME.
8641 BCOMP A,-1 ;GET BP THAT'LL ILDB THAT CHAR.
8642 SETO CH1, ;COUNT [-] DEPTH.
8645 JRST AIRRO4 ;END OF STRING IS END OF ARG.
8646 SETZM AIRPT ;THIS GROUP NOT NULL.
8648 AOJE CH1,AIRRO3 ;FLUSH OUTERMOST [-] PAIRS.
8651 JUMPGE CH1,AIRRO1 ;DON'T LOOK FOR , WITHIN [-].
8654 JRST AIRRO2 ;END OF ARG.
8655 CAIE B,^M ;^M IS IGNORED (FLUSHED.)
8657 AIRRO3: MOVEI B,376 ;FLUSH A CHAR BY REPLACING WITH 376
8661 AIRRC4: SUB P,[1,,1]
8662 AIRRC3: SETZM (T) ;NULLIFY BOTH ARGS PERMANENTLY.
8663 AIRRO4: SETZM 1(T) ;NULLIFY 2ND ARG PERMANENTLY
8664 JRST AIRR8 ;DONE WITH THIS GROUP.
8666 AIRRO2: MOVEI B,377 ;REPLACE CHAR THAT ENDED ARG WITH TERMINATOR.
8668 AIRRW3: CCOMP1 A,-1 ;GET ADDR OF CHAR AFTER.
8669 HRRZM B,1(T) ;"REST OF STRING" STARTS THERE.
8672 AIRRN: MOVE A,1(T) ;NEW 1ST DUMMY STARTS AT OLD "REST OF STRING".
8674 BCOMP A,-1 ;NEW "REST OF STRING" STARTS AFTER 376,
8675 JRST AIRRW2 ;WHICH WILL BECOME A 377.
8677 AIRRW: MOVE A,1(T) ;GET CHAR ADDR START OF 2ND HALF OF PREV LINE.
8678 CALL AIRRM ;SET 1ST DUMMY -> AFTER NEXT 376 OR 377 .
8679 AIRRW2: ILDB B,A ;MOVE UP TO NEXT 377 OR END OF STRING.
8680 CAIN B,375 ;END OF STRING ENDS 1ST DUMMY'S ARG =>
8681 JRST AIRRO4 ;NULLIFY THE 2ND DUMMY.
8682 SETZM AIRPT ;THIS GROUP NOT NULL.
8685 JRST AIRRO2 ;SET UP 2ND DUMMY -> NEXT CHAR.
8688 ;MOVE UP IN 1 GROUP OF IRPS.
8689 AIRRS: MOVE A,(T) ;MOVE FROM 1ST DUMMY,
8690 CALL AIRRM ;PUT 1ST DUMMY AFTER NEXT 377,
8691 AOS (T) ;MOVE IT PAST THE SYL'S TERMINATING CHAR,
8692 ILDB CH1,A ;GET THAT CHAR,
8694 JRST AIRRS2 ;STORE AS 2ND DUMMY.
8696 AIRRM: BCOMP A,-1 ;A HAS CHAR ADDR; WILL ILDB THAT CHAR.
8698 CAIN B,375 ;END OF STRING => NULLIFY BOTH ARGS
8699 JRST AIRRC4 ;AND FINISHED WITH GROUP.
8703 CCOMP1 CH1,-1 ;GET CHAR ADDR OF CHAR AFTER 377
8704 MOVEM CH2,(T) ;PUT 1ST DUMMY THERE.
8705 RET ;NOTE A NOT CLOBBERED, CAN GO ON ILDB'ING.
8707 ;MOVE UP IN ONE GROUP OF IRPC.
8708 AIRRC: AOS A,1(T) ;DELETE 1ST CHAR FROM "REST OF STRING".
8709 BCOMP A,-1 ;GET BP -> THAT CHAR.
8710 LDB CH1,A ;GET THE CHAR.
8711 MOVE A,(T) ;GET CHAR ADDR OF PLACE TO PUT IT.
8712 AIRRS2: CAIN CH1,375 ;REACHED END OF STRING =>
8713 JRST AIRRC3 ;NULLIFY BOTH ARGS.
8715 DPB CH1,A ;STORE IT IN THE 1-CHAR ARG.
8716 AIRR7: SETZM AIRPT ;THIS GROUP NOT EXHAUSTED YET.
8718 SOJG C,AIRR6 ;MORE GROUPS => DO THE NEXT.
8719 AIRR9: POP P,TT ;RETURN FROM AAIRPC
8723 MOVN A,[2,,2] ;ARGS EXHAUSTED, RETURN
8731 ;IRP ARG-STRING READING COROUTINES: CALL WITH JSP D,
8732 ;INITIALIZE FOR READIN OF ARG BUT DON'T GET A CHAR.
8733 ;SKIPS IF NONNULL ARG AVAILABLE.
8734 ;COROUTINES REMEMBER INFO IN T AND TT BETWEEN CALLS.
8735 ;THE CALLER SHOULDN'T CLOBBER THEM.
8736 RARG: CALL RCH ;DECIDE WHAT TYPE OF ARG FOLLOWS, IF ANY.
8737 CAIN A,LBRKT ;RARG ALLOWS [-] AND MAYBE {-} ARGS AS WELL AS SIMPLE ONES.
8744 JSP T,RARGXT ;CAUSE FAILURE RETURN ON SEMI, CR, LF.
8745 RARGN: CALL RCH ;RARGCH RTN FOR NORMAL ARG.
8747 JRST (D) ;COMMA ENDS ARG.
8749 JRST RARGSM ;SEMI ENDS SCAN.
8751 CAIN A,^J ;CR, LF END SCAN.
8752 RARGSM: TLOA FF,FLUNRD
8756 RARGBR: SETZ TT, ;TT USED AS BRACKET COUNTER.
8757 JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T.
8758 ;READ-CHAR RTN FOR [-] TYPE ARGS.
8759 RARGBC: CALL RCH ;READ NEXT CHAR OF ARG.
8764 JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACKET.
8766 RARGRR: SETZ TT, ;TT USED AS BRACE COUNTER.
8767 JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T.
8768 ;READ-CHAR RTN FOR {-} TYPE ARGS.
8769 RARGRC: CALL RCH ;READ NEXT CHAR OF ARG.
8774 JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACE.
8776 ;TO GET THE NEXT CHAR OF THE ARG IN A, DO JSP D,RARGCH(T).
8777 ;SKIPS UNLESS NO MORE CHARS TO GET.
8778 ;NO SKIP AND SET => SCAN SHOULD BE TERMINATED.
8779 ;RARG SHOULD NOT BE CALLED AGAIN IN THAT CASE.
8780 RARGCH==0 ;THIS SYMBOL IS FOR CREF'S SAKE.
8782 ;COPY THE ARG BEING READ INTO MACRO SPACE.
8783 ;ON RETURN, A WILL HOLD "; IF ARGUMENT WAS ENDED BY ";".
8784 RARGCP: JSP D,RARGCH(T)
8789 RARGC1: CAIE A,"; ;IF SEMI ENDED THE ARG, FLUSH THE
8790 RET ;SPACES AND TABS BEFORE IT.
8791 RARGC2: LDB A,FREPTB
8795 JRST [ MOVEI A,"; ;LAST CHAR OF ARG ISN'T SP OR TAB.
8796 RET] ;MAKE SURE A HAS ";" IF ARG WAS ENDED BY ";".
8797 RARGC3: SOS FREEPT ;IT IS ONE; BACK OVER IT.
8803 ;IGNORE THE REST OF THE ARG NOW BEING READ.
8804 RARFLS: JSP D,RARGCH(T)
8808 ;COME HERE TO SET UP TO READ A BALANCED ARG.
8809 ;IF THERE'S NO ARG, RETURNS WOTH JRST (D).
8810 ;ELSE RETURNS WITH JRST 1(D) SETTING UNRCHF.
8812 SETZ TT, ;TT USED AS BRACKET COUNTER.
8814 CAIN A,") ;IF 1ST CHAR IS A CLOSE,
8815 JRST RARB4 ;THERE'S NO ARG.
8819 JSP T,RARGXT ;CHECK FOR CR, LF, SEMI, AND RETURN.
8820 ;1-CHAR RTN FOR READING BALANCED ARG.
8823 CAIN A,"> ;FOR CLOSES, MAYBE END ARG.
8829 CAIN A,"< ;FOR OPEN BRACKETS, INCR. THE COUNT.
8830 AOJA TT,1(D) ;OPENS CAN'T END THE ARG.
8835 JRST RARGX1 ;NOT WITHIN BRACKETS, TEST FOR COMMA, ETC.
8837 RARB2: SOJGE TT,1(D) ;COME HERE FOR CLOSEBRKTS.
8838 RARB4: TLO FF,FLUNRD
8841 ;COME HERE TO INIT FOR AN ARG FOR REPEAT, ETC.
8842 ;THAT IS, EITHER A BRACKETED ARG OR A 1-LINE ARG.
8846 RARL4: CAIN A,LBRACE
8847 JRST RARGRR ;1ST CHAR A BRACE => BRACED ARG.
8849 CAIN A,LBRKT ;1ST CHAR A BRKT => BRKT ARG.
8853 ;INIT FOR A 1-LINE ARG.
8855 ;1-CHAR RTN FOR 1-LINE ARGS.
8860 ;IF BRACES AREN'T USED BY MOST THINGS, THE NORMAL ROUTINE RARL1 DOESN'T
8861 ;CHECK FOR THEM, BUT RALR4 (CALLED BY CONDITIONALS) STILL MUST.
8862 RARL4: CAIN A,LBRACE
8867 ;1-LINE ARGS TO MACROS: DON'T TERMINATE THE SPEC,
8868 ;AND SKIP OVER THE CR AND LF.
8869 RARL3: TLO FF,FLUNRD
8873 JRST (D) ;LF IS THE END - SKIP IT.
8876 CALL RCH ;CR => SKIP FOLLOWING LF, END ARG.
8881 ;PUSHJ P,A.GST SEARCH CURRENT MACRO STRING FOR TAG (IN A.GST4)
8882 ;SKIP IF FOUND, RETURN ON END OF STRING ANYWAY
8883 ;BYTE POINTER (ILDB TO GET FIRST CHARACTER) IN A
8885 A.GST: MOVEM A,A.GST3 ;SAVE BYTE POINTER
8886 A.GST1: ILDB B,A.GST3 ;GET CHAR
8888 POPJ P, ;END OF STRING => STOP
8890 JRST A.GST1 ;WAIT FOR POINT
8891 PUSHJ P,A.GSYL ;FOUND POINT, GET REST OF NAME
8892 JUMPL T,CPOPJ ;RETURN ON END OF STRING
8893 CAME SYM,[SQUOZE 0,TAG] ;TAG?
8894 JRST A.GST1 ;NO, KEEP GOING
8895 PUSHJ P,A.GSYL ;GET THE TAG
8896 JUMPL T,CPOPJ ;RETURN ON END OF STRING (THERE MUST BE BREAK CHAR AFTER TAG BEFORE STOP)
8898 JRST A.GST1 ;NOT THE ONE BEING LOOKED FOR
8900 LDB B,A ;GET DELIMITER
8903 ILDB B,A ;CR, GET NEXT CHAR
8904 CAIE B,12 ;LINE FEED?
8905 MOVE A,A.GST3 ;NO, DON'T FLUSH
8908 ;LOOK BACKWARD FOR BEGINNING OF STRING, BYTE POINTER AN A
8909 ;LEAVES POINTER POINTING AT STOP CHAR (NOT BEFORE); ALSO LEAVES STOP CHAR IN B
8911 AG.SP: MOVE B,(A) ;GET WORD FROM MACTAB
8912 XOR B,[300_28.+300_20.+300_12.+300_4] ;DO XOR TO ANITIALLY SET UP
8913 LDB CH1,[400400,,A] ;PICK UP 4 HIGH ORDER BITS OF POSITION FIELD
8914 JRST A.GSP2-1(CH1) ;DISPATCH ON POSITION FIELD (-1 SINCE BIT SET IN POSITION FIELD)
8917 XOR B,[300_28.+300_20.+300_12.+300_4]
8919 A.GSP2: TRNN B,300_4
8929 AG.SF: SUBI CH1,A.GSP2-1 ;GET HERE WHEN STOP CHAR FOUND
8930 DPB CH1,[400400,,A] ;CLOBBER POSITION FIELD OF BYTE POINTER AGAIN
8931 ILDB B,A ;INCREMENT TO UNIVERSALLY ACCEPTABLE POINTER, GETTING STOP CHAR IN B AT SAME TIME
8942 A.GO: PUSHJ P,GSYL ;DOESN'T WORK RELIABLY FROM DUMMY
8945 A.GO1: TLNN FF,FLMAC
8946 JRST MACCR ;NOT GETTING CHARS FROM MACRO => STOP
8948 PUSHJ P,AG.SP ;BACK TO BEGINNING
8950 JRST A.GOMC ;MACRO, SKIP PAST HEADER
8951 A.GORT: PUSHJ P,A.GST
8952 JRST A.GO2 ;END OF STRING, TRY POPPING UP ONE
8956 A.GO2: PUSHJ P,PMACP
8959 A.GSYL: MOVNI D,100000 ;GET SYL FOR .GO WHILE LOOKING FOR TAG
8960 MOVEM D,STRCNT ;STRCNT .LT. 0 SIGNAL FOR GSYL TO JRST (F)
8963 A.GSY3: ILDB A,A.GST3 ;GET CHAR
8964 TRZN A,200 ;CHECK FOR SPECIAL
8965 JRST A.GSY2 ;NO, FALL BACK IN
8966 CAIG A,100 ;BIG ENOUGH TO BE SPECIAL?
8967 JRST A.GSY3 ;NO, MUST BE DUMMY, IGNORE
8968 HRROI T,(A) ;SPECIAL => ASSUME STOP: T .LT. 0 SIGNAL TO CALLING ROUTINE
8969 POPJ P, ;RETURN TO CALLING ROUTINE
8971 ;INITIALIZE MACRO STATUS
8974 MOVEM A,FREEPT ;FORGET ALL STRINGS IN MACTAB
8977 HRLI A,41000 ;SET UP CCOMPB THRU CCOMPE
8978 LSH A,2 ;(THEIR VALUES CAN'T BE ASSEMBLED IN BECAUSE
8979 SUBI A,4 ;THEY ARE MUTLTIPLY RELOCATABLE, AND IN DEC
8980 MOVSI AA,CCOMPB-CCOMPE ;VERSION THAT CAN'T BE DONE)
8981 MACIN0: MOVEM A,CCOMPB(AA)
8986 ANDI A,-2000 ;ADDR OF 1ST WD AFTER MACTAB.
8987 CALL MACIN2 ;SET UP PTRS TO END OF MACTAB.
8988 SETZM GCCNT ;CLEAR OUT GC COUNT SO WILL GET MORE CORE FIRST THREE
8989 MACIN1: SETZM MDEPTH ;NOW INITIALIZE MACRO EXPANSION STATUS
8990 SETZM PRSTG ;NOW TO CLEAR OUT BYTE POINTERS
8991 MOVE A,[PRSTG,,PRSTG+1]
8998 MOVE A,[-MPDLL,,MACPDL]
9002 ;A -> 1ST WD AFTER MACTAB, SET UP ALL POINTERS TO END OF MACTAB.
9003 MACIN2: MOVEM A,MACTND
9005 LSH A,2 ;1ST BYTE MACTAB DOESN'T HAVE.
9011 SOS A ;LAST WD IN MACTAB.
9012 MOVEM A,MACHIB ;INITIALIZE BYTE POINTER TO HIGHEST BYTE OK TO FILL
9015 ;MACRO VARIABLE AREA (MOST THEREOF)
9018 MACP: 0 ;MAC PDL POINTER
9019 BLCODE [MACPDL: BLOCK MPDLL+1] ;MACRO PDL
9020 FREEPT: 0 ;MACRO STG PNTR POINTS TO FREE CHAR
9021 FREPTB: 0 ;FREEPT IN BYTE POINTER FORM
9022 MACTAD: MACTBA ;ADDR OF START OF MACRO TABLE.
9023 MACTND: 0 ;ADDR OF 1ST WD AFTER MACTAB.
9024 MACHI: 0 ;CHAR ADR ONE ABOVE ACTIVE MACTAB
9025 MACHIB: 0 ;POINTS TO LAST BYTE IN MACTAB
9027 SCONDF: 0 ;STRING CONDITIONAL FLAG, -1 => IDENTICAL, 0 DIFFERENT
9028 GENSM: 0 ;GENERATED SYM COUNT
9029 DEFNPS: 0 ;NONZERO => NAME OF PSEUDO NOW READING ITS ARG.
9030 ;A FATAL ERROR WILL TYPE THE PSEUDO'S NAME.
9031 DEFNPN: 0 ;PAGE # -1 OF THAT PSEUDO. ALSO TYPED BY FATAL ERRORS.
9032 DEFNLN: 0 ;LINE # -1.
9033 DEFNFI: 0 ;SIXBIT FN1 OF FILE CONTAINING PSEUDO THAT DEFNPS REFERS TO.
9034 MDEPTH: 0 ;DEPTH IN MACRO (NOT IRP OR REPEAT) EXPANSIONS
9035 PUTCNT: 0 ;AOS'D BY PUTREL, USED BY CALLING ROUTINE, USUALLY TO COUNT ACTIVE CHARS (DURING DEFINITION)
9036 IRPCR: 0 ;COUNT OF A,B,[LIST] GROUPS IN IRP IRPC IRPS, " " "
9037 AIRPT: 0 ;IRP EXPANSION TEMP, -1 => NO NON-NULL DUMMYS YET, ELSE 0
9038 AIRPN0: 0 ;1ST NUMERIC ARG TO IRPNC
9041 A.QOT2: 0 ;DELIMITER FOR .QUOTE
9042 CRPTCT: -1 ;COUNT THROUGH CURRENT REPEAT (FOR .RPCNT)
9043 CIRPCT: -1 ;COUNT THOUGH CURRENT IRP (FOR .IRPCNT)
9044 A.GST3: 0 ;ON .GO, NAME (IN SQUOZE) OF TAG BEING SEARCHED FOR
9045 A.GST4: 0 ;BYTE POINTER FOR ILDB WHILE SEARCHING FOR TAG
9046 PRCALP: PRCAL-1 ;POINTER INTO PRCALP, POINTS TO LAST ACTIVE ENTRY
9048 PRSTG: ;BEGIN WORDS GARBAGE COLLECTED: FIRST BYTE POINTERS ILDB'D
9050 CPTR: 0 ;ILDB TO GET NEXT CHAR FROM MACRO OR WHATEVER
9051 IFE WRQTSW-1,WRQTBP: 0 ;POINTS TO LAST CHAR BEFORE CURRENT SYL AT WRQOTE
9052 AIRPSP: 0 ;-> PLACE TO STORE SYL-TERMINATOR, IN IRPS READIN.
9053 GCBPL==.-PRSTG ;END BYTE POINTERS, BEGIN CHARACTER ADDRESSES
9054 PRSCND: 0 ;CHARACTER ADDRESS OF CURRENT LOCATION IN FIRST STRING OF IFSE,IFSN WHILE COMPARING WITH SECOND
9055 PRSCN1: 0 ;CHAR ADR BEG OF FIRST STRING IFSE, IFSN
9056 PRREPT: 0 ;CHAR ADR BEG OF BODY OF REPT
9057 PRIRP: 0 ;CHAR ADR BEG OF IRP BODY
9058 PRDEF: 0 ;CHAR ADR BEG OF MACRO BEING DEFINED
9059 PRCAL: REPEAT 10,0 ;TEMP STORAGE FOR CHAR ADR BEG MACRO BODY, USED TO READ DUMMY SPECS
9060 EPRSTT: ;END CHAR ADR WORDS GARBAGE COLLECTED
9062 ;BEGIN GARBAGE COLLECTOR VARIABLES
9064 GCCNT: 0 ;CNT OF GC'S
9065 SYMSTR: 0 ;PNTR TO CHAIN OF MACRO PNTRS IN SYM TABLE (DURING GC), LINKED THROUGH RH'S OF "VALUE"
9066 REDPT: 0 ;CHAR ADR READING FROM WHEN MOVING STRING DOWN
9067 REDPTB: 0 ;REDPT IN BYTE POINTER FORM
9068 ;GC WRITES WITH FREEPT/FREPTB
9069 COFST: 0 ;AMOUNT CHARS MOVED DOWN BY, SUBTRACTED FROM CHAR ADR TO RELOCATE
9070 SVF: 0 ;FLAG, .GE. 0 => NO POINTERS FOUND POINTING TO CURRENT STRING
9071 FREPTS: 0 ;-> BEGINNING OF CURRENT STRING BEING COPIED DOWN
9072 FRPTBS: 0 ;FREPTS IN BYTE POINTER FORM
9073 GCENDF: 0 ;-1 => END OF LAST STRING FOUND, AFTER RELOCATING POINTERS, MSTG2 SHOULD EXIT
9074 GCHI: 0 ;GC HIGH POINTER, CHAR ADR FIRST NOT TO GARBAGE COLLECT
9075 GCRDHI: <MACL-MACRUM>*4 ;GC DROPS DEAD (MACTAB FULL) IFWRITING INTO THIS CHAR ADR
9076 BLCODE [GCSV: BLOCK 16] ;AC SAVE AREA FOR GC
9079 ;GARBAGE COLLECT THE MACRO TABLE
9081 GCA1: MOVE A,FREEPT ;GC ALL IN MACTAB.
9082 GCA: MOVEM A,GCHI ;ENTRY TO STORE A IN GCHI -> FIRST CHAR NOT TO GARBAGE COLLECT
9083 GC: MOVEM 17,GCSV+15
9088 PUSHJ P,GCCORQ ;EXPAND CORE ON FIRST THREE GC'S
9091 MOVEM A,REDPT ;SET UP FOR READING
9092 MOVEM A,FREEPT ;ALSO FOR WRITING
9093 MOVE A,BCOMPU ;ALSO SET UP CORRESPINDING BYTE POINTERS
9096 MOVE C,[-GCBPL,,PRSTG]
9097 GCLP1: SKIPN B,(C) ;NOW CONVERT BYTE POINTERS...
9098 JRST GCLP1B ;(INACTIVE)
9099 CCOMP B,-1 ;TO CHARACTER ADDRESSES
9100 MOVEM B,(C) ;STORE BACK CHARACTER ADDRESS
9101 GCLP1B: AOBJN C,GCLP1 ;LOOP FOR ALL SUCH BYTE POINTERS
9102 MOVE A,SYMAOB ;NOW SET UP MACRO LIST; T INITIALLY HAS 0 => END OF LIST DURING COMPUTATION
9103 SYMMG: ;POINTS TO FIRST MACRO SYMTAB ENTRY ON LIST
9104 LDB B,[400400,,ST(A)] ;GET SQUOZE FLAGS THIS SYM
9105 CAIN B,PSUDO_-14. ;PSEUDO? (=> MAYBE MACRO)
9106 JRST SYMMG1 ;YES, MAYBE PUT ON LIST (RETURNS TO SYMMG2)
9107 SYMMG2: ADD A,WPSTE1
9108 AOBJN A,SYMMG ;LOOP FOR ENTIRE SYMTAB
9109 MOVEM T,SYMSTR ;STORE INITIAL LIST ENTRY FOR MACROS
9111 ;GC DEALS WITH "UNIT STRINGS", EACH STRING ENDS WITH 375
9112 ;GENERAL PROCEDURE IS TO COPY A STRING DOWN THEN SEARCH FOR POINTERS TO WHERE STRING USED TO BE
9113 ;IF POINTERS FOUND THEY ARE RELOCATED TO POINT TO COPIED DOWN STRING
9114 ;IF POINTERS ARE NOT FOUND THE STRING IS WIPED OUT
9117 MSTG: MOVE C,REDPT ;SET UP C TO POINT TO BEG OF STRING BEING READ
9118 ;(FOR EVENTUALLY SEARCHING FOR POINTERS TO STRING, NOTE C STAYS AROUND FOR AWHILE)
9120 MOVEM TT,FREPTS ;-> BEGINNING OF WRITTEN STRING
9122 MOVEM TT,FRPTBS ;BYTE POINTER -> BEGINNING OF WRITTEN STRING
9123 PUSHJ P,RDTRNS ;COPY CHARACTER
9125 JRST MSTGB ;THAT WAS NO STRING, THAT WAS MY IO-BUFFER!
9126 MOVE TT,B ;SAVE CHARACTER JUST COPIED
9127 MSTG1: CAML LINK,GCHI
9128 JRST GCEND ;JUST READ LAST CHAR IN PART OF MACTAB TO GARBAGE COLLECT => DONE
9130 JRST MSTG2 ;END THIS STRING, NOW SEARCH FOR POINTERS, RETURNS TO MSTG
9131 PUSHJ P,RDTRNS ;STRING NOT EXHAUSTED, COPY NEXT CHAR
9134 SYMMG1: HRRZ B,ST+1(A) ;PSEUDO FOUND IN SYMTAB, GET "VALUE"
9135 CAIE B,MACCL ;MACCL? (=> MACRO, CHAR ADR OF BODY IN LH)
9136 JRST SYMMG2 ;NO, JUST FALL BACK INTO LOOP
9137 HRRM T,ST+1(A) ;MACRO, REPLACE MACCL PART OF VALUE WITH POINTER TO NEXT
9138 MOVEI T,ST+1(A) ;UPDATE T (INITIAL LIST ENTRY) TO POINT TO WORD JUST CLOBBERED
9147 ;COPY CHARACTER DOWN (REDPTB -> FREPTB)
9148 ;LEAVE INCREMENTED REDPT IN LINK, FREEPT IN A, CHAR IN B
9150 RDTRNS: ILDB B,REDPTB
9156 MSTGB: ADDI A,3 ;COPY AN IO-BUFFER:
9158 MOVEM A,FREEPT ;WRITE INTO WORD BOUNDARY.
9161 MOVEM LINK,REDPT ;READ FROM WORD BOUNDARY.
9167 ADDI B,1 ;NEW ADDR OF 1ST WD.
9168 HRRZ LINK,1(A) ;GET ADDR OF POINTER TO STRING.
9169 MOVEM LINK,SVF ;REMEMBER WHETHER TO FLUSH STRING.
9171 HRRM B,(LINK) ;RELOCATE THAT POINTER (IF ANY)
9172 HRLI B,1(A) ;SET UP AC FOR BLT.
9173 HLRZ LINK,1(A) ;GET LENGTH OF STRING.
9182 CAML LINK,GCHI ;IF THIS IO-BUFFER IS LAST THING IN MACRO SPACE,
9183 SETOM GCENDF ;DON'T LOOK FOR ANYTHING FOLLOWING IT.
9184 JRST MSTGB1 ;NOW MAYBE FLUSH THIS STRING, COPY NEXT.
9186 ;GET HERE WHEN MSTG2 FINISHES WITH FLAG SET TO EXIT: UNDO INITIALIZATION AND RETURN
9195 ETF [ASCIZ /Macro space full/]
9197 JRST USYMG1 ;EMPTY LIST
9198 MOVEI C,MACCL ;SET UP C FOR HRRM'ING
9199 USYMG: HRRZ TT,(T) ;GET ADR ON LIST
9200 HRRM C,(T) ;CLOBBER RH JUST GOT NEXT POINTER FROM TO MACCL
9205 SKIPE T,TT ;MAKE NEXT POINTER CURRENT, SKIP IF END OF LIST
9208 USYMG1: MOVE C,[-GCBPL,,PRSTG]
9209 GCLP2: MOVE A,(C) ;NOW CONVERT CHARACTER ADDRESSES...
9210 BCOMP A,-1 ;BACK TO BYTE POINTERS
9215 POPJ P, ;EXIT FROM GARBAGE COLLECTOR
9217 ;GC ROUTINE TO SCAN TABLE AREA FOR POINTERS TO CURRENT STRING
9218 ;CH1 -> BEGINNING OF TABLE, 4.9 => LOOK AT PAIRS SKIPPING SECOND OF EACH PAIR
9219 ;T POINTS TO LAST WORD IN TABLE + 1
9220 ;RELOCATE POINTERS IN TABLE POINTED TO
9221 ;C POINTS TO BEGINNING OF STRING, B -> END + 1
9224 POPJ P, ;TABLE EXHAUSTED
9225 HRRZ TT,-1(T) ;GET LAST ENTRY IN TABLE (UPPER POINTER UPDATED TO COUNT DOWN)
9228 JRST MSCN1 ;DOESN'T POINT TO CURRENT STRING
9229 SUB TT,COFST ;POINTS TO STRING, RELOCATE
9230 HRRM TT,-1(T) ;STORE BACK RELOCATED POINTER
9231 SETOM SVF ;SET FLAG TO SAVE STRING
9233 SOS T ;CH1 NEGATIVE => SKIP A WORD
9236 GCEND: SETOM GCENDF ;DONE READING FROM MACTAB, BUT FIRST HAVE TO RELOCATE POINTERS TO LAST STRING
9237 MSTG2: CLEARM SVF ;NO POINTERS FOUND TO STRING YET
9240 MOVEM D,COFST ;STORE AMOUNT CHARS COPIED DOWN BY FOR CHAR ADR RELOCATION
9243 JRST MSTG3 ;NOT A MACRO
9245 JUMPE T,MSTG3 ;JUMP IF NO MACROS ON LIST
9246 MSTG5: HLRZ TT,(T) ;GET CHAR ADR THIS MACRO
9247 CAML TT,C ;SKIP IF POINTS BELOW BEGINNING THIS STRING
9248 CAML TT,B ;SKIP UNLESS POINTS TO OR ABOVE FIRST CHAR NOT YET READ
9249 JRST MSTG4 ;DOESN'T POINT TO THIS STRING
9250 SETOM SVF ;POINTS TO THIS STRING, SET FLAG TO SAVE STRING
9251 SUB TT,COFST ;RELOCATE
9252 HRLM TT,(T) ;STORE BACK UPDATED CHAR ADR THIS MACRO
9253 MSTG4: HRRZ T,(T) ;NOW GET POINTER TO NEXT MACRO
9254 JUMPN T,MSTG5 ;LOOP FOR ALL MACROS ON LIST
9258 PUSHJ P,MSCN ;RELOCATE POINTERS IN DUMMY ARG TABLE
9261 PUSHJ P,MSCN ;RELOCATE POINTERS IN MACRO PDL
9265 PUSHJ P,MSCN ;RELOCATE POINTERS IN PRSTG
9268 PUSHJ P,MSCN ;RELOCATE DUMMY ARGS READ (OR BEING READ) IN BUT NOT YET ACTIVATED
9272 JRST MSTGB2 ;FOUND POINTERS TO THIS STRING, DON'T FLUSH
9273 MOVE TT,FREPTS ;NO POINTERS FOUND, FLUSH STRING
9277 MSTGB2: SKIPGE GCENDF ;IF WE JUST HACKED AN I-O BUFFER, MAYBE IT'S THE LAST
9278 JRST GCEND1 ;THING IN MACRO SPACE.
9281 ] ;END MACSW CONDITIONAL (AND MACRO PROCESSOR ROUTINES)
9283 IFN .I.FSW,[ ;;.I.F ;ALGEBRAIC COMPILER ROUTINE
9284 ; 'ALGEBRAIC' CRUFT MARO DEFINITIONS
9287 MOVEI D,[SIXBIT /ARG!!/]
9292 MOVEI A,15 ;CARRIAGE RETURN
9294 MOVEI A,12 ;LINE FEED
9333 ; START OF COMPILER PROPER
9335 OPDL: CH?CH?CH?CH?CH?CH?CH?CH ;COMMUTATOR
9336 CH?SP?CH?CH?CH?CR?CH?CH
9337 CH?CH?CH?CH?CH?CH?CH?CH
9338 CH?CH?CH?CH?CH?CH?CH?CH
9339 SP?CH?CH?CH?DL?CH?CH?CH
9340 LP?RP?TX?PL?CM?MN?CH?DV
9341 CH?CH?CH?CH?CH?CH?CH?CH
9342 CH?CH?CH?KL?LB?EQ?RB?CH
9344 ; CH?CH?CH?CH?CH?CH?CH?CH
9345 ; CH?CH?CH?CH?CH?CH?CH?CH
9346 ; CH?CH?CH?CH?CH?CH?CH?CH
9347 ; CH?CH?CH?CH?CH?CH?UP?CH
9348 ; CH?CH?CH?CH?CH?CH?CH?CH
9349 ; CH?CH?CH?CH?CH?CH?CH?CH
9350 ; CH?CH?CH?CH?CH?CH?CH?CH
9351 ; CH?CH?CH?CH?CH?CH?CH?CH
9355 ENN: 60 ;ACCUMULATOR NUMBER - TROUBLE IF GOES PAST 9
9357 BTPNT: 440700,,STRING ;D
9358 STRING: BLOCK 10 ;CHARACTER ASSEMBLY (D) - TROUBLE IF OVERFLOWS
9361 DIRPNT: 440700,,DIROUT ;TPN
9362 DIROUT: BLOCK 40 ;COPY OF LINE IN PROGRESS (TPN) - TROUBLE IF OVERFLOWS
9366 OPSTK: BLOCK OPSTKL ;OPERATOR STACK (R) - TROUBLE IF OVERFLOWS
9371 ENDSTT: 0 ;ON IF END OF STATEMENT ENCOUNTERED
9372 CHARF: 0 ;LAST WAS NOT OPERATOR
9373 NUMFL: 0 ;STRING IS NUMERIC CONSTANT (NEEDS [ AND ])
9375 R2SV: 0 ;SAVED I, CALLED V EARLIER ON
9377 INTEGR: 0 ;INTEGER ARITHMETIC
9378 WARN: 0 ;ON AFTER ) TO STOP NON-OPERATOR
9379 RANDM: 0 ;DUMP COMMA COUNT HERE
9381 TEMP: 440600,,(D) ;INDIRECT VIA D
9385 ; ENTRANCE TO 'ALGEBRAIC' TRANSLATOR
9390 PUSHJ P,SWINI ;INITIALISE PASSAGE TO MIDAS ASSEMBLER
9393 SETZM ENDSTT ;RESET END OF STMNT FLAG
9394 SETZM EQHIT' ;RESET LAST CHAR WAS= FLAG
9395 SETZM WARN ;SET OFF ERROR DETECTOR
9396 MOVEI A,"0 ;INITIALISE POINTERS
9399 MOVEM A,TPN ;POINTER TO SAVED INPUT
9400 MOVE SYM,[-OPSTKL,,OPSTK]
9401 PUSH SYM,[0,,ENDSAT]
9402 PUSH P,[0] ;INITIALISE COMMA-COUNTER
9405 RDITTS: SKIPE ENDSTT
9408 CAIGE A,100 ;FOR ABBREVIATED DISPATCH TABLE
9419 SETOM CHARF ;NON UNARY FLAG
9426 SHORT: ;DECIDES IF STRING CAN BE USED IN IMMEDIATE TYPE OPS
9433 JRST APUPJ ;YEPE HE ASKED FOR IT
9435 POPJ P, ;STRING IS LONG
9439 JUMPE I,APUPJ ;ITS OK FOUND ONLY NUMBERS
9441 POPJ P, ;NON-NUMBER IN STRING
9445 SKIPN I ;ANYTHING FOLLOW '.' QST
9446 APUPJ: SETOM IMMED' ;INDICATE IMMEDIATE USAGE IS POSSIBLE
9451 GOPART: MOVEM I,R2SV
9455 JRST PSOPR ;GO PUSH OPERATOR
9457 SETOM IMMED ;FOR ARITH OPS ONLY FIXED WILL DO IMMEDIATE
9458 PUSHJ P,SHORT ;ESTABLISH IF STRING CAN BE IMMEDIFIED
9459 POP SYM,A ;POP AN OPERATOR
9462 MOAN OVERPOPPED OPERATOR STACK
9468 AOS ENN ;TAKE CARE OF UNSATISFIED = AT END
9476 RTONOP: MOVE I,(SYM)
9478 JRST BUDDY ;NO ARGUMENT FUNCTION
9480 MOAN ) FOLLOWS OPERATOR
9482 BDEND: MOAN TOO MANY ('S
9484 CHBRT: MOAN NON-OPERATOR FOLLOWS )
9488 AOS ENN ;HANDLES UNSATISFIED = AT END
9499 PUSH P,[0] ;INITIALISE COMMA-COUNTER
9512 CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT
9516 CAIE A,") ;SEARCH FOR NEXT RP
9519 CMBAN: SETOM CHARF ;MAKE BELIEVE CHARATER LAST
9520 SETOM WARN ;YET SET ) TRAP
9523 NMRINX: CAIN A,"- ;IS IT A MINUS
9527 MOVEI I,"+ ;NUMERICAL SUBSCRIPT
9531 CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT
9545 LFRHT: MOAN ( FOLLOWS DIRECTLY ON )
9547 SP=RDITA ;USE FOR NON ARITH STATS
9549 CM: MOVE I,[1,,COMMX]
9556 SKIPN CHARF ;TEST FOR EXISTANCE OF L H S
9558 NUMBER ;IS L H S A NUMBER
9569 PL: MOVE I,[2,,PLUS]
9571 JRST RDITA ;UNARY PLUS
9574 MN: MOVE I,[2,,MINUX]
9579 AB: SKIPE CHARF ;ABSOLUTE VALUE
9580 JRST ABERR ;NOT UNARY
9585 JRST LP ;TREAT LIKE (
9593 NUBRST: MOAN '<' FOLLOWS NUMBER
9595 NUSTRB: MOAN '(' FOLLOWS NUMBER
9597 EQFLOP: MOAN '=' FOLLOWS OPERATOR
9599 EQNUMB: MOAN '=' FOLLOWS NUMBER
9601 ABERR: MOAN NON-UNARY ABS
9603 TX: MOVE I,[4,,TIMES]
9605 JRST RDITA ;UNARY TIMES
9608 DL: GET ;CONTINUE STATEMENT RC
9614 GET ;CONTROL I OR SPACE
9616 MOVEM A,TPN ;RESET SAVED INPUT POINTER TO AVOID FILLING ITS BUFFER
9623 ERRCON: TRNE FF,FRPSS2 ;NO OUTPUT ON SECOND PASS
9625 ;MAY ALSO WANT TO USE STATEMENT PLUS LINE NUMBER TYPE TACTIC
9635 MOVEI A,"? ;POINT AT ERROR
9639 DORSAL: GET ;COPY UP TO LINE FEED
9643 CONERT: PUSHJ P,TIPIS
9645 CONRAT: MOVE TM,[ACSAV,,P]
9647 JRST SWFLS ;GO BACK AND FLUSH
9656 UP: SKIPN WARN ;FOR (NUMBER)^N
9659 MOVEM A,R1SV ;SAVE THE ARROW
9661 JRST CHEX ;ITS PART OF A NUMBER
9662 ITSEX: MOVE I,[6,,STRSTR]
9669 BDCONT: MOAN BAD CONTINUATION
9671 KL=CR ;SEMICOLON ACTS LIKE CR IN TERMINATING
9673 STRSTR: SKIPN STRING
9687 EXLS: PUSH P,[ASCII !EXPLO!]
9694 DV: MOVE I,[4,,DIVIX]
9699 PSOPR: PUSH SYM,I ;PUSH OPERATOR FOR LATER EXCECUTION
9702 PUSHJ P,SHORT ;CAN WE IMMEDIFY
9703 PUSHJ P,MVOI ;AND MOVE OPERAND INTO STACK
9707 PRODB: NUMBER ;OUTPUT WHAT IS IN STRING
9708 SKIPE IMMED ;NO [ & ] IF IMMEDIATE USE
9711 MOVEI A,"[ ;[ FOR CONSTANT
9725 MOVEI A,"] ;] FOR CONSTANT
9730 PRODC: HRLI A,440700 ;MAKE BYTE POINTER
9734 JRST RDITTS ;IGNORE LP ON STACK
9736 RCAR: HALT ;IMPOSSIBLE FOR THESE TO BE ON STACK
9742 MOVEI A,[ASCIZ ! MOVEM A!]
9767 JRST MVOALR ;OPERAND ALREADY THERE
9768 MOVEI A,[ASCIZ ! MOVE A!]
9770 MOVEI A,[ASCIZ ! MOVEI A!]
9771 MVOIK: PUSHJ P,PRODC
9774 FINOF: PUSHJ P,PUTREL
9784 TOEARL: MOAN TOO MANY )'S
9786 PLUS: MOVEI A,[ASCIZ ! FADR A!]
9788 MOVEI A,[ASCIZ ! ADD A!]
9790 MOVEI A,[ASCIZ ! ADDI A!]
9791 OPERT: PUSHJ P,PRODC
9814 MINUX: MOVEI A,[ASCIZ ! FSBR A!]
9816 MOVEI A,[ASCIZ ! SUB A!]
9818 MOVEI A,[ASCIZ ! SUBI A!]
9821 TIMES: PUSHJ P,TMSTR
9823 MOVEI A,[ASCIZ ! IMULI A!]
9826 DIVIX: MOVEI A,[ASCIZ ! FDVR A!]
9828 MOVEI A,[ASCIZ ! IDIV A!]
9830 MOVEI A,[ASCIZ ! IDIVI A!]
9835 JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE
9838 MOVEI A,[ASCIZ ! MOVNS A!]
9839 UMINUC: PUSHJ P,PRODC
9846 MOABC: MOVEI A,[ASCIZ ! MOVN A!]
9848 MOVEI A,[ASCIZ ! MOVNI A!]
9856 MOVEI A,[ASCIZ ! MOVMS A!]
9859 MOABS: MOVEI A,[ASCIZ ! MOVM A!]
9861 MOVEI A,[ASCIZ ! MOVMI A!]
9865 MVONT: MOVEI A,[ASCIZ ! MOVE A!]
9870 TMSTR: MOVEI A,[ASCIZ ! FMPR A!]
9872 MOVEI A,[ASCIZ ! IMUL A!]
9879 JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE
9884 MOVEI A,[ASCIZ ! HRLZI A!]
9890 MOVEI A,[ASCIZ !,201400!]
9896 ONTMS: PUSHJ P,TMSTR
9900 ONMVS: PUSHJ P,PUTREL
9904 LSTCHX: PUSHJ P,PUTREL
9908 POWR: GAMB?POWR2?POWAA?POWR4
9910 POWR4: PUSHJ P,ONTMS
9911 POWR2: PUSHJ P,ONTMS
9914 POWAA: PUSHJ P,MVONT
9928 UINDV: MOAN INTEGER UNARY DIVIDE
9935 MOVEI A,[ASCIZ ! PUSHJ P,!]
9945 JRST RDITTS ;AS USED FROM FUNCT
9946 JRST COMMT ;AS USED FROM STRSTR
9948 MORFMC: MOVE A,RANDM
9950 SKIPN CHARF ;NO ARGUMENTS
9954 CAMN A,ENN ;ARE ARGUMENT ALREADY IN A0 AND UP
9957 MORYLP: PUSHJ P,ZENBD
9968 MORXLP: PUSHJ P,ZENBD
9973 ZENBD: MOVEI A,[ASCIZ ! EXCH A!]
9986 MORTP: ILDB A,BYTPNT
9987 CAIN A,1 ;EXCLAMATION
9993 ] ;END .I.FSW CONDITIONAL
9999 PNTR: MOVEM 17,PNTSA+17
10010 PUSHJ P,PSOS ;PRINT SPACE OR '
10012 PNTR3: HLRZ T,LISTWD
10024 PNTR4: MOVE TT,[440700,,LISTBF]
10025 PNTR6: CAMN TT,PNTBP
10035 PNTR5C: CALL PILPT ;OUTPUT THE ^L,
10036 CALL PNTHDR ;AND THE PAGE NUMBER.
10041 PNTR5D: SETOM LISTBC
10042 PNTR5: MOVNI A,LISTBS*5-1
10043 MOVEM A,PNTSW ;DETECT OVERFLOW OF LISTBF
10044 MOVE TT,[440700,,LISTBF]
10050 PNTR5B: MOVE A,LISTBC
10061 PNTR1: MOVE TT,[440700,,LISTBF]
10075 P6OD: MOVE TT,[220300,,T]
10083 PNTCR: MOVEI A,^M ;OUTPUT ^M TO LST IF OPEN.
10084 PILPTX: SKIPE LSTONP;OUTPUT CHAR TO LST IF LSTING.
10089 MOVEI B,10. ;MOVE TO COLUMN 80.,
10093 HLLOM B,LSTTTY ;POSITIVE SO TYOERR GOES ONLY TO LST.
10094 TYPR [ASCIZ/Page /]
10098 PNTCRR: CALL PNTCR ;OUTPUT CRLF TO LST IF OPEN.
10113 A.LSTFF: AOS (P) ;RETURN NO VALUE.
10114 ; ADDR, CONTENTS IF NOT LISTING, CONTENTS IF LISTING.
10115 LSTOFF: LSTM LSTONP,0,-1
10116 LSTM LSTPLM,[TLO B,4^5][JRST PSHLML]
10117 LSTM RCHLST,RCHLS1,AOSN PNTSW
10118 LSTM RCH1LS,RET,[CAILE A,^M]
10119 LSTM POPLML,JFCL,[IDPB A,PNTBP]
10123 LSTON: BLOCK LSTM0-1
10126 A.LSTN: SKIPN LISTP1 ;IF SHOULD LIST THIS PASS
10128 SKIPE LISTP ;AND WANT LISTING,
10129 CALL LSTON ;TURN ON LISTING OUTPUT.
10132 IFNDEF LISTBS,LISTBS==50. ;LISTBF SIZE IN WORDS.
10134 VBLK ;LISTING FEATURE VARIABLES
10136 PNTBP: 0 ;POINTER TO LISTING LINE BUFFER
10137 LSTONP: 0 ;NONZERO WHEN OUTPUTTING TO LISTING FILE.
10139 LISTON: 0 ;-1 IF LISTING ON
10140 PNTSW: 0 ;-1 IF LAST CHR CR OR LF, OR -<# CHARS SPACE LEFT IN LISTBF>
10141 LISTBF: BLOCK LISTBS
10142 LISTAD: 0 ;ADDRESS OR -1 NONE 3.1 RELOC
10144 LSTRLC: 0 ;RELOCATION
10145 LISTPF: 0 ;-1 OTHERS CONTAIN SOMETHING
10146 LISTBC: 0 ;BREAK CHR CR LF OR FF OR -1 IF NONE SINCE LAST PNTR
10147 LISTTM: 0 ;TEMP AT AEND
10148 PNTSA: BLOCK 20 ;AC SAVE AREA FOR LISTING FEATURE
10149 LISTP1: 0 ;POSITIVE => WANT TO LIST EVEN ON PASS 1.
10154 ;THESE VARIABLES ARE REFERENCED EVEN IF LISTSW IS 0.
10155 LSTTTY: 0 ;TYOERR TYPES ON TTY IFF LE 0, ON LST IF NOT 0.
10156 LSTPLM: TLO B,4^5 ;OR JRST PSHLML ;XCT'D BY PSHLMB.
10157 POPLML: JFCL ;OR IDPB A,PNTSW ;XCT'D IN POPLMB.
10160 IFE LISTSW, A.LSTN: A.LSTF: RET
10164 CREFP: 0 ;SET BY C SWITCH TO REQUEST CREFFING.
10165 CRFONP: 0 ;SET WHILE CREFFING.
10166 CRFLFL: 0 ;LAST PAGNUM,,LINENUM OUTPUT.
10167 CRFINU: JFCL\PUSHJ P,CRFUSE ;XCT THIS TO CREF NON-DEF OCCUR.
10168 CRFLBL: JFCL\PUSHJ P,CRFLB1 ;XCT FOR DEF. OF NORMAL SYM.
10169 CRFEQL: JFCL\PUSHJ P,CRFEQ1 ; FOR DEF. OF NORMAL SYM. OR INTSYM.
10170 CRFMCD: JFCL\PUSHJ P,CRFMC1 ; FOR DEF. OF MACRO.
10171 CRFDEF: JFCL\PUSHJ P,CRFDF1 ; FOR RANDOM DEF, CHECK FLAGS.
10173 CRFILE: 0 ;SET => SHOULDN'T OUTPUT PAGNUM,,LINENUM'S
10174 ;USED BY .CRFILE INTSYM SO CAN'T BE IN CONDIT.
10177 CRFEQ1: MOVEI T,(B)
10178 CAIN A,1 ;IF NOT PSEUDO OR NOT INTSYM,
10180 JRST CRFLB1 ;IS NORMAL SYM.
10181 CRFOD1: MOVSI T,600000 ;ELSE DEFINING INSN.
10184 CRFDF2: MOVEI T,(B) ;DECIDE WHETHER DEFINING MACRO OR PSEUDO.
10187 CRFMC1: SKIPA T,[500000,,] ;DEFINING MACRO.
10188 CRFLB1: MOVSI T,440000 ;DEFINING NORMAL SYM.
10193 ;COME HERE FOR NON-DEF; MUST DECIDE WHAT TYPE SYM.
10194 CRFUSE: TLNE C,3NCRF ;SYM MAY HAVE CREFFING SUPPRESSED.
10198 JRST CRFMAC ;PSEUDOS, MACROS.
10199 MOVSI A,40000 ;FLAG FOR NORMAL SYM.
10201 MOVSI A,200000 ;FLAG FOR INSNS.
10205 AOBJN A,.+1 ;A HAS PAGNUM,,LINENUM .
10206 SKIPGE CRFILE ;IF SHOULD OUTPUT IT,
10208 CAME A,CRFLFL ;AND HAS CHANGED, DO SO.
10212 IOR A,SYM ;COMBINE SYM AND CREF FLAG.
10216 CRFMAC: MOVEI A,(B)
10218 SKIPA A,[100000,,] ;MACRO
10219 MOVSI A,200000 ;PSEUDO-OP.
10222 ;DEFINING OCCURRENCE, MIGHT BE ANY TYPE SYM.
10223 CRFDF1: CAIN A,1 ;TYPE 1 => MACRO OR PSEUDO.
10225 TRNE C,-1 ;ELSE INSN OR NORMAL SYM.
10241 A.CRFFF: AOS (P) ;.CRFOFF - STOP CREFFING. NO VAUE.
10242 ; LOCATION, NORMAL VALUE, VALUE WHILE CREFFING
10243 CRFOFF: CRFM CRFONP,0,-1
10244 CRFM CRFLBL,JFCL,[PUSHJ P,CRFLB1]
10245 CRFM CRFEQL,JFCL,[PUSHJ P,CRFEQ1]
10246 CRFM CRFMCD,JFCL,[PUSHJ P,CRFMC1]
10247 CRFM CRFINU,JFCL,[PUSHJ P,CRFUSE]
10248 CRFM CRFDEF,JFCL,[PUSHJ P,CRFDF1]
10252 CRFON: BLOCK CRFM0-1
10255 A.CRFN: JUMPGE FF,MACCR
10256 SKIPE CREFP ;.CRFON, IF HAVE CREF FILE, START CREFFING.
10261 IFN TS,[ ;;TS ;TIME-SHARING ROUTINES
10263 IFNDEF TYPDLC,TYPDLC==7 ;MAXIMUM TOTAL DEPTH OF .INSRT (INCLUDING TTY)
10264 IFNDEF MX.INS,MX.INS==5 ;MAXIMUM DEPTH .INSRT FILES ONLY
10265 IFNDEF MAXIND,MAXIND==6 ;MAXIMUM # @: TABLE ENTRIES FOR .INSRT
10273 IFNDEF UTIBFL,UTIBFL==400 ;INPUT BUFFER SPACE.
10274 IFNDEF UTOBFL,UTOBFL==200
10275 IFNDEF CMBFL,CMBFL==50 ;COMMAND BUFFER LENGTH.
10276 IFNDEF CRFBSZ,CRFBSZ==200 ;# WDS CREF OUTPUT BUFFER.
10277 IFNDEF LSTBSZ,LSTBSZ==200
10278 IFNDEF ERRSW,ERRSW==1 ;1 FOR ERROR FILE OUTPUT CAPABILITY.
10279 IFNDEF ERRBSZ,ERRBSZ==1 ;ERROR FILE BUFFER SIZE.
10281 ERRC==0 ;ERR DEVICE CHANNEL.
10282 TYIC==1 ;TTY INPUT CHANNEL
10283 TYOC==2 ;TTY OUTPUT CHANNEL
10284 CREFC==3 ;CREF OUTPUT.
10285 UTYOC==4 ;OUTPUT FILE
10286 LPTC==5 ;LISTING (LPT)
10287 ERRFC==6 ;ASSEMBLY ERROR OUTPUT FILE.
10288 UTYIC==7 ;1ST INPUT CHANNEL, UTYIC+N USED FOR NTH .INSRT LEVEL IN DEC VERSION.
10291 INTJPC: 0 ;SAVES .JPC AT INTERRUPT.
10292 INTSVP: 0 ;SAVES P ON INTERRUPT FOR DEBUGGING
10294 ;NOTE THAT ONLY PDL OV IS NOW ENABLED.
10298 TSINT: 0 ;1ST WD INTERRUPTS (AT PRESENT) ARE CONSIDERED FATAL ERRORS
10299 .JBTPC: 0 ;ERROR PROCESSOR RE-ENABLES INTERRUPTS
10300 .SUSET [.RJPC,,INTJPC]
10302 JRST TTYINT ;SECOND-WORD INTS.
10303 JRST TSINT1 ;JUMP INTO PURE CODING AND PROCESS INTERRUPT
10305 .ELSE CCLFLG:0 ; FLAG TO INDICATE CCL ENTRY FROM COMPIL
10308 TSINT1: MOVEM P,INTSVP ;SAVE P FOR POSSIBLE DEBUGGING
10309 .SUSET [.SPICL,,[-1]]
10310 IFE SAILSW,MOVE A,.JBCNI ;GET INTERRUPT REQUEST WORD
10311 .ELSE MOVE A,JOBCNI
10312 TRNE A,200000 ;PDL OVERFLOW?
10314 MOVE B,[TYPR [ASCIZ/Unknown interrupt - Fatal/]]
10316 IFE SAILSW,MOVE A,.JBTPC ;SO ERROR ROUTINE WILL PRINT OUT PROPERLY
10317 .ELSE MOVE A,JOBTPC
10320 ;MIDAS STARTS HERE.
10325 MOVEM A,CCLFLG ; REMEMBER TYPE OF START-UP
10331 .SUSET [.RSNAM,,RSYSNM] ;GET SYSTEM NAME
10332 .SUSET [.SMASK,,[%PIPDL]] ;PDL OVERFLOW ONLY.
10333 .SUSET [.SMSK2,,[1_TYIC]]
10334 SYSCAL TTYSET,[1000,,TYIC
10337 .SUSET [.SPICL,,[-1]] ;PERMIT INTERRUPTS (IN CASE RESTARTED DURING INTERRUPT)
10339 MOVEI FF,0 ;INITIALIZE FLAGS
10340 MOVE P,[-LPDL,,PDL] ;INITIALIZE P
10343 TYPR [ASCIZ /Can't restart MIDAS/]
10346 BEG9: MOVEI D,SYMDSZ ;GET DEFAULT SYMTAB SIZE
10348 .SUSET [.RXJNAM,,A]
10349 CAME A,['MMIDAS] ;OR LARGER FOR MMIDAS
10350 CAMN A,[SIXBIT/MM/]
10353 SKIPGE ISYMF ;THE FIRST TIME THROUGH,
10354 MOVEM D,SYMLEN ;MAKE THAT THE SIZE TO USE.
10355 CALL JCLINI ;NOW TRY TO FETCH JCL.
10356 IFN ITSSW,[SKIPGE ISYMF ;SKIP IF SYMS SPREAD
10357 CALL TSYMGT ;GET TS SYMS FROM SYSTEM
10359 SKIPGE CMPTR ;IF NO CMD FROM DDT,
10360 JRST GO2A ;ANNOUNCE MIDAS'S NAME AND VERSION.
10363 TYPR [ASCIZ /NOTPUR /]
10365 MOVE B,[SIXBIT /MIDAS./]
10373 IFE ITSSW,SETZM ERRTTL ; INITIALIZE ERROR COUNTER
10374 MOVEI FF,0 ;INITIALIZE FLAGS
10377 IFN RUNTSW,[ PUSHJ P,RNTTMA ;GET INITIAL RUN TIME.
10380 PUSHJ P,CMD ;GET TYPED IN COMMAND
10383 TYPR [ASCIZ/SYMTAB clobbered
10387 GO21: PUSHJ P,GINIT ;INITIALIZE STUFF
10388 PUSHJ P,OPNRD ;OPEN INPUT FILE
10389 PUSHJ P,WINIT ;OPEN OUTPUT FILE, CREF FILE.
10392 OUTSTR [ASCIZ /MIDAS: /]
10394 GO3: MOVEMM TTYFLG,WSWCNT ;TURN OFF TYPEOUT IF THERE WERE (W) SWITCHS.
10396 JSP A,$INIT ;INITIALIZE FOR ASSEMBLY
10397 JSP A,PS1 ;DO PASS 1
10398 TRNE FF,FRNPSS ;IF 2 PASS ASSEMBLY,
10399 PUSHJ P,OPNRD ;THEN RE-OPEN INPUT FILE
10400 JSP A,PLOD ;MAYBE PUNCH OUT SBLK LOADER IN SOME FORMAT
10401 JSP A,PS2 ;DO PASS 2
10402 JSP A,PSYMS ;MAYBE PUNCH OUT SYMBOL TABLE
10405 AOS PRGC ;INDICATE END STATEMENT ENCOUNTERED
10407 TRNN FF,FRNPSS ;IF 1 PASS ASSEMBLY,
10410 JRST GO3 ;THEN TRY TO ASSEMBLE ANOTHER PROGRAM
10416 MOVE A,[SIXBIT /*FASL*/] ;"FINISH" FASL FILE
10418 PUSHJ P,FASO ;IGNORE END FROB, BUT OUTPUT FASL END CODE
10419 MOVE A,[.BYTE 7 ?3 ? 3 ? 3? 3? 3]
10420 PUSHJ P,FASO1 ;RANDOMNESS
10421 PUSHJ P,FASBE ;WRITE OUT LAST BLOCK
10423 GO4: SETZM FATAL ;THERE WAS NO FATAL ERROR: OUTPUT FILES GET RENAMED.
10425 RETN2: PUSHJ P,.FILE
10428 PUSHJ P,RNTTYO ;TYPE OUT RUN TIME USED SINCE GO2A
10430 CALL ERRCLS ;FILE AWAY ERROR FILE.
10433 ;INITIALIZATION ROUTINE CALLED ONCE PER (COMMANDED) ASSEMBLY
10439 IFN DECSW,[ IFE SAILSW,[
10440 SETZM V.SITE ;; CODE TO SET UP .SITE'S VALUE, ON DEC SYSTEM.
10441 MOVE A,[V.SITE,,V.SITE+1]
10443 MOVE B,[440600,,V.SITE]
10444 MOVSI C,-5 ;PROCESS 5 WORDS F .GTCNF
10446 HRRI A,11 ;11 = .GTCNF
10447 GETTAB A, ;GET 1 WORD
10449 GINIT2: SETZ AA, ;EXTRACT THE ASCII CHARS AND STORE THEM.
10451 TRCE AA,140 ;SWAP BIT 40 WITH BIT 100, THUS TURNING
10452 TRCE AA,140 ;"A TO 'A, "a TO 'A, "1 TO '1, ETC, AND ^@ TO ' .
10454 IDPB AA,B ;STORE THE SIXBIT INTO .SITE'S VALUE STRING.
10455 JUMPN A,GINIT2 ;WHEN NOTHING LEFT OF THIS WORD OF .GTCNF, GET THE NEXT.
10458 MOVE A,[MAXIND,,FDSOFS]
10459 MOVEM A,INDDP ;INITIALIZE POINTER INTO INDIRECT FILE TABLE
10460 IFDINI: MOVE A,[DNAM,,IFDS]
10461 BLT A,IFDS+LFDSE-1 ;SET UP INPUT FILE NAMES FROM DNAM ETC.
10464 IFN RUNTSW,[ ;TYPE OUT RUN TIME USED
10467 IFE ITSSW,[ ; NOBODY WANTS THIS ON ITS, BUT OTHER PEOPLE DO...SIGH...
10468 SKIPE A,ERRTTL ; ANY ASSEMBLY ERRORS?
10469 JRST [ TYPR [ASCIZ/? /] ; YES, ERROR MESSAGE FOR BATCH CONTROLLERS
10471 TYPR [ASCIZ/ error(s) detected
10475 SKIPE CCLFLG ; CALLED VIA CCL?
10479 TYPR [ASCIZ /Run time = /]
10480 CALL A.MRUNT ;GET RUNTIME IN MILLISEC. IN A.
10482 IDIVI A,100. ;GET SECS AND HUNDREDTHS.
10483 HRLM B,(P) ;SAVE REMAINDER
10484 PUSHJ P,HMSTYO ;TYPE OUT SECS
10488 CALL RNTYO3 ;TYPE OUT HUNDREDTHS
10492 TYPR [ASCIZ/ Symbols including initial ones
10496 ;TYPE OUT H:MM:SS TIME IN A
10497 ;DOESN'T WORK FOR TIMES .GE. 60. HOURS
10499 HMSTYO: IDIVI A,60.
10504 RNTYO2: PUSHJ P,TYO ;TYPE DELIMITING CHAR
10506 RNTYO3: IDIVI A,10.
10507 PUSHJ P,ADGTYO ;TYPE OUT DIGIT IN A
10514 RNTTMA: .SUSET [.RRUNT,,A]
10519 A.MRUNT: PUSHJ P,RNTTMA ;GET CURRENT RUN TIME
10520 SUB A,IRUNTM' ;SUBTRACT RUN TIME AS OF GO2
10521 IFN ITSSW,[MULI A,4069. ;CONVERT TO NANOSECONDS
10522 DIV A,[1.^6] ;THEN TO MILLISECONDS.
10527 ;TS OUTPUT ROUTINES
10529 PPB: JUMPGE FF,CPOPJ
10536 TPPB1: CALL TPPBF ;OUTPUT THE BUFFER,
10540 MOVE C,[0 UTYOC,UTOHDR]
10541 CALL OBUFO ;OUTPUT & RE-INIT BUFFER.
10547 SKIPN ERRFP ;IF WANT ERROR OUTPUT FILE,
10549 CALL OINIT ;OPEN IT.
10553 SETOM ERRFOP ;ERROR FILE NOW OPEN.
10555 PUSHJ P,OINIT ;OPEN OUTPUT FILE, FN2=OUTPUT.
10556 13^9 UTYOC,ONAM ;<DEC-MODE> CHNL,NAME-BLOCK.
10560 TLZ FF,FLPTPF ;INITIALLY ASSUME DEVICE NOT PAPER TAPE PUNCH
10561 .STATUS UTYOC,A ;GET STATUS OF OUTPUT CHANNEL
10562 ANDI A,77 ;MASK TO DEVICE CODE
10563 CAIN A,7 ;IF PAPER TAPE PUNCH,
10564 TLO FF,FLPTPF ;THEN SET FLPTPF
10570 0 LPTC,LSTDEV ;OPEN LISTING FILE IF DESIRED.
10576 SKIPN CREFP ;IF CREF REQUESTED,
10578 PUSHJ P,OINIT ;OPEN CREF FILE, FN2=CRFOUT
10582 MOVE A,[.BYTE 7 ? 177 ? "B ? ^W]
10583 PUSHJ P,CRFOUT ;OUTPUT HEADER TO INDICATE IMAGE INPUT.
10584 PUSHJ P,CRFSSF ;OUTPUT SET-SOURCE-FILE BLOCK.
10588 IFN ITSSW,RELEAS==.CLOSE
10590 ;CLOSE INPUT, BIN, CREF AND LIST FILES.
10591 .FILE: RELEAS UTYIC,
10593 SKIPL B,CONTRL ;IF RELOCATABLE,
10594 PUSHJ P,TPPB ;OUTPUT A -1 SO STINK WILL SEE EOF
10595 SETZ A, ;IN DEC FMT, OUTPUT A 0 AT END.
10599 JRST .FILE2 ;OUTPUT FNAM2 WAS EXPLICITLY SPECIFIED
10601 SKIPA A,[IFN DECSW,['STK,,] .ELSE ['REL,,]]
10602 MOVSI A,(SIXBIT /BIN/)
10603 TRNE B,DECREL ;THE DEFAULT DEPENDS ON OUTPUT TYPE.
10607 MOVE A,[IFN ITSSW,[SIXBIT /FASL/] .ELSE ['FAS,,]]
10610 .FILE2: JSP A,OCLOSE
10611 0 UTYOC,UTOHDR ;WRITE OUT BUFFER, RENAME AND CLOSE OUTPUT FILE.
10614 SKIPN LISTP ;LISTING FILE OPEN =>
10616 CALL PNTCR ;END WITH CR AND FF.
10620 0 LPTC,LSTHDR ;OUTPUT BUFFER, RENAME & CLOSE IT.
10625 SKIPN CREFP ;IF CREF FILE OPEN,
10628 PUSHJ P,CRFOUT ;OUTPUT EOF BLOCK,
10629 JSP A,OCLOSE ;WRITE BUFFER, CLOSE.
10630 0 CREFC,CRFHDR ; 0 CHNL,HEADER
10635 ;FILE OUT ERROR OUTPUT FILE.
10636 ERRCLS: SETZM FATAL ;ERR FILE RENAMED EVEN AFTER FATAL ERROR.
10639 RET ;THERE IS NONE.
10641 CALL ERRCHR ;PUT CRLF AT ENND.
10644 JSP A,OCLOSE ;RENAME AND CLOSE.
10650 \f; PUSHJ P,OINIT ;OPEN OUTPUT FILE
10651 ; MODE CHNL,NAME-BLOCK-ADDR
10652 ; SIXBIT/DESIRED-TEMPORARY-FN2/
10653 ; HEADER,,BUFFER SPACE ;USED ONLY IN DEC VERSION.
10654 ;THE MODE SHOULD BE 13^9 FOR BINARY, 0 FOR ASCII.
10657 HLRZ B,2(A) ;GET ADDR OF HEADER,
10658 SETOM 2(B) ;SET BUFFER BYTE COUNT TO -1 => NOT INITTED.
10659 MOVE AA,1(A) ;GET 2ND ARG,
10660 MOVS A,@(P) ;COPY OUTPUT FILE'S EVENTUAL NAMES INTO DNAM, ETC.
10662 .CALL OINITR ;TRANSLATE THEM AS IF OPENING THAT FILE,
10663 JRST OINITL ;(TOO MANY TRANSLATIONS)
10664 .CALL OINITB ;DELETE OLD TEMP NAME FILE.
10665 JFCL ;THERE WAS NONE.
10666 LDB A,[270400,,@(P)] ;GET CHANNEL NUM.
10667 HRLI A,7 ;OPEN MODE.
10668 LDB B,[331100,,@(P)]
10669 CAIN B,0 ;BUT MAYBE WANT ASCII MODE.
10674 MOVEI B,3(A) ;SUCCESSFUL OPEN, COPY TRANSLATED NAMES INTO NAME-BLOCK FOR FILE
10676 BLT A,(B) ;FOR EVENTUAL RENAME.
10677 POPJ3: AOS (P) ;SKIP OVER 3 ARGS.
10684 ;WRITE OUT LAST BUFFER, RENAME TO NAMES IN NAMEBLOCK AND CLOSE.
10685 OCLOSE: MOVE C,(A) ;1ST WD OF ARGS IS WHAT OBUFO WANTS.
10686 LDB B,[360600,,1(C)] ;JUST IN CASE THIS IS ASCII FILE,
10687 DPB B,[300600,,OCLOSP] ;GET BP TO UNUSED PART OF LAST WD OF BUFFER,
10689 DPB B,OCLOSP ;AND PAD WITH ^C'S.
10690 SOS 2(C) ;OBUFO ASSUMES BYTE COUNT WAS SOS'D.
10691 CALL OBUFO ;WRITE OUT LAST PARTIAL BUFFER
10693 LDB C,[270400,,(A)] ;GET CHNL NUM.
10695 JRST OCLOS1 ;AFTER FATAL ERROR, DON'T RENAME OUTPUTFILES.
10696 .CALL ORENMB ;RENAME (B HAS NAMEBLOCK ADDR)
10698 OCLOS1: .CALL OCLOSB ;CLOSE
10702 ORENMB: SETZ ? SIXBIT/RENMWO/
10703 C ? 1(B) ? SETZ 2(B) ;[CHNL] ? [FN1] ? [FN2] ((SETZ))
10705 OCLOSB: SETZ ? SIXBIT/CLOSE/
10708 OINITB: SETZ ? SIXBIT/DELETE/
10709 DNAM ? ['_MIDAS] ? AA ? SETZ SNAM
10711 OINITR: SETZ ? SIXBIT/TRANS/
10712 REPEAT 4,DNAM+.RPCNT
10713 REPEAT 4,[? 2000,,DNAM+.RPCNT ] ((SETZ))
10715 OINITO: SETZ ? SIXBIT/OPEN/ ? A
10716 DNAM ? ['_MIDAS] ? AA ? SETZ SNAM
10718 ;WRITE OUT AND REINITIALIZE BUFFER FOR FILE.
10719 ;ASSUMES BYTE COUNT (HEADER 3RD WD) WAS SOS'D.
10720 ;C HAS <0 CHNL,HEADER>
10721 ;IN ITS VERSION, HEADER 1ST WD HAS <SIZE IN BYTES>,,<BUFFER ADDR>-1
10724 AOSGE 2(C) ;WAS COUNT SOS'D FROM -1?
10725 JRST OBUFO1 ;YES, BUFFER HADN'T BEEN INITTED, DON'T WRITE IT.
10727 ADD A,(C) ;RH(A) HAS -<# WDS USED IN BUFFER>.
10730 AOS A ;A HAS AOBJN -> USED PART OF BUFFER.
10734 XCT AA ;WRITE IT IN FILE.
10735 OBUFO1: MOVE A,1(C)
10736 HRR A,(C) ;POSITION THE B.P. BEFORE START OF BUFFER,
10737 TLZ A,770000 ;AFTER LAST BYTE IN WD (IDPB WILL USE 1ST BUFFER WD)
10740 MOVEM A,2(C) ;SET UP BYTE COUNT.
10744 TFEED: TLNN FF,FLPTPF ;IF OUTPUT DEVICE NOT PTP,
10745 POPJ P, ;THEN DO NOTHING
10746 PUSHJ P,TPPBF ;OTHERWISE OUTPUT THE BUFFER,
10747 TFEED1: .FEED UTYOC, ;FEED A LINE,
10748 TLZA FF,FLPTPF ;IF THIS IS EXECUTED, UTYOC DOESN'T HAVE PTP AFTER ALL
10749 SOJG B,TFEED1 ;FEED THE SPECIFIED NUMBER OF LINES,
10750 POPJ P, ;AND RETURN
10754 SKIPGE PURIFG ;IF NOT YET PURIFIED, ASSUME BEING DEBUGGED.
10757 .LOGOUT ;COME HERE TO COMMIT SUICIDE.
10760 A.SITE: CALL AGETFD ;.SITE N, RETURNS NTH WORD OF SIXBIT MACHINE NAME.
10761 CAIE A,0 ;ON ITS, ONLY WORD 0 IS NONZERO. IT'S THE "MACHINE NAME".
10763 SYSCAL SSTATU,[MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A]
10768 OINITL: IFN ITSSW,[
10769 HLLZ A,@(P) ;GET CHNL NUM,
10770 TLZ A,777037 ;MASK TO JUST AC FIELD (CHNL NUM)
10772 XCT A ;READ ITS STATUS,
10774 PUSHJ P,OPNER ;TYPE OUT REASON FOR OPEN FAILURE,
10776 PUSHJ P,GTYIP ;GET TYPEIN
10777 HRLZ A,@(P) ;REPLACE '_MIDAS' WHATEVER BY ACTUAL NAMES.
10779 PUSHJ P,RFD ;GET NEW FILE DESCRIPTION
10780 HRRZ A,@(P) ;GET NAME BLOCK ADDR,
10782 HRLI A,DNAM ;COPY NAMES JUST READ INTO IT.
10786 OINITS: ASCIZ/Use what filename instead? /
10790 MOVS A,(AA) ;GET NAME-BLOCK ADDR IN LH,
10791 HRLZ TT,A ;GET CHNL NUM IN LH.
10792 TLZ TT,#(0 17,) ;MASK TO AC FIELD (CHANNEL NUM)
10794 BLT A,SNAM ;COPY NAMES INTO DNAM THRU SNAM.
10795 HRRZ D,2(AA) ;GET BUFFER SPACE ADDR.
10796 HLLZ C,2(AA) ;GET HEADER ADDR.
10798 SETZM (A) ;CLEAR OUT ITS-VERSION CONTENTS OF 1ST HEADER WD.
10799 LDB A,[331100,,(AA)] ;GET MODE TO OPEN IN (WILL BE ASCII OR IMAGE BINARY)
10800 CALL OPNRD2 ;DO OPEN.
10802 IFE SAILSW,[SAVE .JBFF
10806 XOR TT,[<OPEN A>#<OUTBUF 1>]
10808 IFE SAILSW,REST .JBFF
10810 MOVE A,[SIXBIT /000MD /]
10811 PJOB B, ;GET JOB NUMBER, TO MAKE SIXBIT /<NNN>MD<E, O, OR L>/
10816 DPB C,[300400,,A] ;PUT THE DIGITS OF THE JOB NUMBER INTO THE SIXBIT WORD.
10819 LDB B,[360600,,1(AA)] ;GET 1ST CHAR OF 'OUTPUT, 'LSTOUT, 'CRFOUT, 'ERROUT.
10820 IOR A,B ;USE IT AS LAST CHAR OF TEMP FILE NAME.
10824 XOR TT,[<OUTBUF 1>#<ENTER A>]
10825 XCT TT ;DO ENTER UTYOC,A
10831 ;CLOSE AN OUTPUT FILE, SEE NON-DEC VERSION FOR ARGS.
10832 OCLOSE: MOVE AA,1(A) ;NAME BLOCK ADDR.
10835 MOVE C,(AA) ;DELETE ANY FILE WITH NAMES
10836 SETZB B,D ;WE WANT TO RENAME TO.
10844 JRST OCLOS1 ;THERE IS NONE, JUST RENAME.
10850 OCLOS1: MOVE B,1(AA) ;DESIRED FN1.
10851 HLLZ C,2(AA) ;DESIRED FN2.
10853 MOVE T,3(AA) ;SNAME (THAT IS, PPN)
10854 HLLZ AA,(A) ;GET JUST CHNL NUM.
10857 XOR AA,[CLOSE#<RENAME B>]
10860 OCLOS2: HLLZ B,(A) ;GET CHNL IN AC FIELD.
10865 ;WRITE OUT BUFFER OF OUTPUT FILE, C HAS <0 CHNL,HEADER>
10866 OBUFO: AND C,[0 17,] ;GET JUST CHNL NUM.
10870 SAVE A ;ERROR RETURN FROM OUT UUO.
10871 XOR C,[OUT#<GETSTS A>]
10872 XCT C ;READ FILE STATUS.
10873 TRZ A,74^4 ;CLEAR ERROR BITS.
10874 ETR [ASCIZ /Output data error/]
10875 XOR C,[<GETSTS A>#<SETSTS (A)>]
10881 TSRETN: MOVE C,[SIXBIT /MIDAS/]
10888 CALL AGETFD ;.SITE ON DEC SYSTEM; VALUE HAS BEEN PRECOMPUTED NTO V.SITE.
10895 .ELSE JRST CABPOP ;SAIL DOESN'T HAVE GETTAB USED IN SETTING UP V.SITE.
10897 ;DEVICE NAME IN B, MODE IN A,
10898 ;HEADER ADDR IN C, BUFFER SPACE ADDR IN D,
10899 ;CREAT DEC-STYLE BUFFER RING LEAVING 1 WD BETWEEN BUFFERS.
10901 IFE SAILSW,DEVSIZ AA,
10902 SKIPA AA,[204] ;DEFAULT BUFFER SIZE IS THAT FOR DSK.
10903 AOJLE AA,.-1 ;GET SIZE INCLUDING EXTRA WD.
10904 MOVEI T,1(D) ;ADDR OF WD 2 OF 1ST BUFFER.
10905 HRLI AA,T ;@AA IS ADDR OF 2ND WD OF NEXT BUFFER.
10906 SUBI D,(AA) ;FACILITATE TEST FOR END OF BUFFER SPACE.
10908 MOVEM T,(C) ;HEADER -> A BUFFER, SIGN SET.
10909 HRRM T,1(C) ;MAKE RH OF BP -> BUFFER 1ST WD.
10910 MOVSI T,440000 ;SET UP P-FIELD OF B.P.
10914 HRLI T,-3(AA) ;DATA-AREA-SIZE +1,,ADDR-OF-2ND-WD
10915 BUFIN1: CAIGE D,-410(T) ;ROOM FOR ANOTHER AFTER THIS BUFFER?
10916 JRST BUFIN2 ;NO, ASSUMING 410 WDS BUFFERRrSPACE.
10917 MOVEM T,@AA ;YES, MAKE NEXT BUFFER -> THIS ONE,
10918 HRRI T,@AA ;POINT TO NEXT ONE.
10921 BUFIN2: ADDI D,1(AA) ;-> 2ND WD OF 1ST BUFFER.
10922 MOVEM T,(D) ;1ST BUFFER -> LAST, MAKING RING.
10925 ;CLOSE ALL INPUT CHANNELS - EQUIVALENT TO ITS .IOPDL.
10926 $IOPDL: MOVEI A,UTYIC
10927 EXCH A,UTICHN ;SET INPUT CHNL NUM. TO LOWEST.
10929 IOR A,[RELEAS] ;SET UP TO RELEAS THE HIGHEST IN USE FIRST.
10930 IOPDL1: XCT A ;RELEAS ONE INPUT CHANNEL,
10931 CAMN A,[RELEAS UTYIC,]
10934 JRST IOPDL1 ;RELEAS THE NEXT ONE DOWN.
10936 .IOPDL==CALL $IOPDL
10941 ;OPEN MAIN INPUT FILE FOR READING
10943 OPNRD: .IOPDL ;RE-INITIALIZE IO PDL
10944 INSIRP SETZM,INFCNT INFCUR INFERR
10945 MOVE A,[-TYPDLS-1,,TTYPDL]
10946 MOVEM A,ITTYP ;INITIALIZE "TTY PDL"
10947 PUSHJ P,MACIN1 ;CLOBBER MACRO EXPANSION STATUS
10948 MOVS A,IFDS ;GET DEVICE NAME
10949 CAIN A,(SIXBIT /TTY/) ;TTY?
10950 JRST OPNRDT ;YES, TREAT SPECIAL
10951 MOVSI A,IFDS ;NOT TTY, TRY OPENING FILE
10952 PUSHJ P,A.IMP1 ;SET UP DNAM, ETC.
10953 PUSHJ P,OPNRD1 ;TRY OPENING FILE
10955 MOVEM A,INFERR ;ERR MSG IN MAIN FILE SHOULDN'T TYPE NAMES.
10956 MOVEI A,0 ;=> INPUT FROM FILE
10957 OPNRT2: MOVE T,[IFNM1,,RFNAM1]
10958 BLT T,RFNAM2 ;SET UP .FNAM1, .FNAM2
10960 JRST RCHSET ;SET UP TO READ FROM FILE OR TTY. (ARG IN A)
10962 OPNRDT: MOVE A,[IFDS+1,,IFNM1] ;TTY SPECIFIED, TREAT SPECIAL
10963 BLT A,IFNM2 ;CLOBBER .IFNM1, .IFNM2 TO SPECIFIED
10964 TYPR [ASCIZ /Reading from TTY:
10966 MOVEI A,3 ;=> INPUT FROM TTY, DON'T QUIT ON CR
10969 OPNRDL: PUSHJ P,IOPNER ;.OPEN LOST, TYPE OUT MESSAGE
10970 JRST GO2A ;READ NEW COMMAND
10973 ;COMMON STUFF FOR OPNRD1 IN DEC AND ITS VERSIONS.
10974 OPNRD3: HRRZM A,UTIBED ;SAY BUFFER EMPTY,
10976 MOVEM A,@UTIBED ;CAUSE IMMEDIATE RELOAD.
10977 MOVE A,[INFDEV+1,,IFNM1]
10978 BLT A,IFNM2 ;SET UP .IFNM1, .IFNM2.
10979 AOS A,INFCNT ;ASSIGN THIS FILE A NUMBER.
10980 MOVEM A,INFCUR ;OPNRD EXPECTS THIS LEFT IN A.
10983 ;EOF WHILE TRYING TO READ CHARACTER
10985 RPAEOF: PUSH P,B ;SAVE B
10986 RPAEO1: MOVE B,ITTYP ;GET PDL POINTER
10987 PUSHJ P,BPOPJ ;CALL POP ROUTINE (MAYBE NED'S OUT)
10988 JRST RCHTRB ;RETURN TO GET CHARACTER
10990 ;EOF FROM MAIN FILE
10992 NEDCHK: TRNE FF,FRCMND ;^C READ IN COMMANND, :KILL SELF.
10996 AOSN NEDCRL ;INVENT ONE CRLF AFTER END OF MAIN FILE.
10997 JRST [ MOVE B,[440700,,[.BYTE 7 ? ^M ? ^J ? ^C]]
11001 IFN A1PSW,[ PUSHJ P,OUTCHK
11003 XCT NEDT(A) ;SKIPS IF NED CONDITION TO BE COMPLAINED ABOUT
11007 ETF [ASCIZ /No END statement/]
11009 IFN A1PSW,[ ;HOLLER "NED" IF ANY OF THE FOLLOWING:
11010 NEDT: SKIPL PRGC ;NO END STATEMENTS HAVE BEEN ENCOUNTERED
11011 SKIPGE OUTC ;OUTPUT HAS OCCURED NOT MATCHED BY AN END STATEMENT
11012 SKIPGE OUTN1 ;OUTPUT HAS OCCURED OTHER THAN IN 1PASS MODE
11013 TRNN FF,FRPSS2 ;CURRENTLY IN PASS 2
11014 LNEDT==.-NEDT ;LENGTH OF TABLE
11018 ;TRY .OPENING INPUT FILE (DESCRIPTION IN DNAM, ETC.) SKIPS IF SUCCESSFUL
11020 OPNRD1: MOVE A,[2,,UTYIC] ;MODE,,CHANNEL.
11022 JRST OPNRD2 ;CAN'T OPEN INPUT FILE.
11025 SKIPN B ;GET SYSTEM FILE NAME 1
11026 MOVE B,FNAM1 ;SYSTEM DOESN'T KNOW, USE SPEC'D.
11027 SKIPN C ;NOW SAME FOR FN2.
11029 MOVE AA,[A,,INFDEV]
11030 BLT AA,INFDEV+3 ;REMEMBER NAMES OF CURRENT INPUT FILE.
11031 HRLZS INFDEV ;MAKE THE DEV NAME BE LEFT-JUST.
11032 MOVE A,IUREDP ;SET UP READING PTR,
11034 JRST OPNRD3 ;SET UP ^C AFTER BUFFER, INFCUR, ETC.
11036 OPNRD2: .STATUS UTYIC,IFSTS ;.OPEN LOST, GET CHANNEL STATUS NOW BEFORE POSSIBLE .IOPOP
11039 OPENB: SETZ ? SIXBIT/OPEN/
11040 A ;SHOULD HOLD MODE,,CHANNEL.
11041 DNAM ? DNAM+1 ? DNAM+2 ? SETZ SNAM
11043 IUREDP: 440700,,UTIBUF
11045 ;EOFCH ENCOUNTERED ON READ, RELOAD AND JUMP BACK FOR NEXT CHAR
11047 INCHR3: HRRZ A,UREDP ;GET BYTE POINTER
11048 CAME A,UTIBED ;END OF COMPLETELY READ BLOCK?
11049 JRST RPAEOF ;NO => REALLY EOF
11052 MOVE A,[-UTIBFL,,UTIBUF]
11053 .IOT UTYIC,A ;READ IN BLOCK
11054 TLZ A,377777 ;CLEAR OUT @, INDEX FIELDS, ALSO ALL BUT SIGN JUST FOR LAUGHS
11055 MOVEM A,UTIBED ;STORE RH (UPDATED POINTER) FOR EOF CHECK AT INCHR3
11056 MOVSI A,EOFCH_<18.-7>
11057 MOVEM A,@UTIBED ;STORE EOF WORD
11058 JRST RCHTRA ;NOW TRY NEXT CHAR
11062 OPNRD1: MOVEI C,UTIHDR ;OPEN THE INPUT FILE W/ NAMES IN DNAM ... SNAM.
11063 SETZ A, ;MODE ASCII.
11065 MOVE TT,UTICHN ;GET CHANNEL NUM. TO USE.
11066 LSH TT,27 ;PUT IN AC FIELD.
11067 CALL OPNRD2 ;DO OPEN.
11069 CALL BUFINI ;INITIALIZE THE INPUT BUFFERS AND HEADER.
11073 TLC TT,(OPEN#LOOKUP)
11074 XCT TT ;LOOKUP CHANNEL,A
11078 DEVNAM A, ;GET REAL NAME OF DEVICE.
11082 MOVE A,[DNAM,,INFDEV]
11087 ;TAKE C -> HEADER, D -> BUFFER SPACE, A HAS MODE, TT HAS CHNL IN AC FLD.
11088 ;OPEN FILE IN DNAM ... SNAM, INIT BUFFERS,
11089 ;THEN SET UP FOR LOOKUP OR ENTER.
11091 OPNRD2: IOR TT,[OPEN A]
11093 XCT TT ;OPEN CHANNEL,A
11097 ;RELOAD BUFFER, DEC STYLE.
11098 INCHR3: HRRZ A,UREDP ;EOF AT END OF BUFFER?
11100 JRST RPAEOF ;NO, EOF, ^C IN FILE.
11103 LSH A,27 ;CHANNEL NUM. N AC FLD.
11105 XCT A ;GET NEXT BUFFERFULL.
11107 JRST INCHR4 ;ERROR.
11108 INCHR5: MOVE A,UTICNT
11111 ADD A,UREDP ;-> 1ST WD NOT READ INTO.
11115 MOVEI B,1 ;SCAN THE FILE AND REPLACE ALL LINE NUMBERS WITH NULLS.
11116 INCHR6: CAMN A,UTIBED
11122 INCHR7: MOVSI B,^C_13
11123 MOVEM B,(A) ;PUT EOF CHAR AFTER BUFFER.
11124 JRST RCHTRB ;RETRY RCH.
11126 INCHR4: XOR A,[<GETSTS B>#IN]
11129 ETR [ASCIZ /Input data error/]
11130 XOR A,[<GETSTS B>#<SETSTS (B)>]
11131 XCT A ;CLEAR ERROR BITS IN STATUS.
11137 ;IO PDL ROUTINES FOR INPUT FILE
11138 ;PUSH THE INPUT FILE
11140 IPUSH: AOSN CMEOF ;WANT TO POP OUT OF TTY? (^C TYPED IN)
11141 CALL POPTT ;YES, DO NOW BEFORE FORGET.
11142 MOVE D,UREDP ;GET INPUT BYTE POINTER
11145 TLNN D,760000 ;AT END OF WORD?
11146 ADD D,[430000,,1] ;YES, MAKE IT POINT TO BEGINNING OF NEXT WORD
11149 ADD A,UTIBED ;GET # WDS WE'LL NEED IN MACTAB.
11150 HLR D,UTIBED ;REMEMBER WHETHER EOF ON LAST .IOT.
11151 HRRZS UTIBED ;NOW CLEAR OUT LEFT HALF FOR FOLLOWING
11154 AOS A,UTICHN ;DO ".IOPUSH" - USE NEXT CHANNEL.
11156 ADD A,[WAIT-<0 1,>]
11157 XCT A ;DON'T MOVE BUFFERS WHILE IO GOING ON!
11158 MOVEI A,UTIBFL+2 ;ASSUME MUST SAVE ALL BUFFER SPACE.
11163 CAML A,MACTND ;NO ROOM IN MACTAB => GC IT.
11166 CALL PUTREL ;INDICATE START OF SAVED BUFFER.
11170 MOVE C,ITTYP ;GET ADDR OF TTY PDL WD THAT'LL POINT TO SAVED BUFFER.
11172 HRRZM C,(B) ;STORE IN RH OF 1ST WD,
11173 MOVEI C,(B) ;REMEMBER ADDR OF SAVED BUFFER TO PUSH ON TTYPDL.
11174 HRLM A,(B) ;PUT LENGTH IN LH.
11176 IFN ITSSW,HRL B,UREDP ;ILH _ ADDR OF 1ST WD TO SAVE.
11177 IFN DECSW,HRLI B,UTIBUF
11178 ADDI A,-2(B) ;ADDR OF LAST WD TO BLT INTO.
11181 MOVEM A,FREPTB ;MAKE FREE BP -> LAST BYTE JUST USED.
11185 ADDI A,4 ;GET CHAR ADDR OF NEXT FREE BYTE.
11187 MOVE B,ITTYP ;GET LOCAL VERSION OF IOPDL
11188 IPSHP: PUSH B,C ;PUSH -> SAVED BUFFER (GC WILL RELOCATE)
11189 IFN DECSW,PUSH B,UTIBED
11190 IFN DECSW,PUSH B,UTIHDR
11191 REPEAT 4,PUSH B,INFDEV+.RPCNT ;SAVE NAMES OF INPUT FILE.
11192 PUSH B,INFCUR ;SAVE NUMBER OF INPUT FILE.
11193 PUSH B,D ;LH=LH(OLD UREDP), RH=LH(OLD UTIBED)
11194 ;FOLLOWING TWO MUST BE LAST PUSHED
11195 INSIRP PUSH B,[IFNM1 IFNM2] ;CLOBBERED ON PDL IF .OPEN SUCCESSFUL
11196 INPDEL==.-IPSHP ;LENGTH OF EACH ENTRY ON PDL
11197 MOVE A,FREEPT ;W MUST USE SAME GC CONVENTION AS PUTREL;
11198 CAML A,MACHI ;NAMELY, GC AFTER USING UP THE LAST BYTE.
11200 MOVEI A,0 ;=> INPUT FROM FILE
11201 MOVEM B,ITTYP ;STORE BACK UPDATED POINTER
11202 JSP B,PUSHTT ;SAVE STUFF, ADDRESS MODIFY AND RETURN
11203 ;POP INTO THE INPUT FILE
11205 IFN CREFSW,[ MOVEI A,2 ;IF CREFFING, OUTPUT POP-FILE BLOCK.
11208 IPOPL: PUSHJ P,POPTT ;COME HERE IF .INSRT'S OPEN FAILED.
11210 MOVE B,ITTYP ;GET POINTER
11211 INSIRP POP B,[IFNM2 IFNM1 A] ;POP STUFF
11213 REPEAT 4,POP B,INFDEV+3-.RPCNT
11220 MOVEM B,ITTYP ;SAVED UPDATED PDL POINTERR.
11221 HLRZ B,(C) ;GET LENGTH OF SAVED BUFFER,
11227 MOVEI AA,UTIBUF-1(B) ;GET ADDR OF 1ST WD WON'T BLT INTO IN UTIBUF,
11228 HRLI AA,(A) ;GET SAVED LH OF UTIBED,
11230 HRRI A,UTIBUF ;MAKE A -> 1ST WD IN BUFFER,
11236 XCT AA ;THIS CODE EQUIVALENT TO .IOPOP.
11242 MOVEM A,@UTIBED ;PUT EOF CHAR AFTER BUFFER.
11243 MOVSI A,1(C) ;GET ADDR OF 1ST DATA WD OF SAVED BUFFER,
11247 HLLZS (C) ;TELL GC TO RECLAIM SAVED BUFFER.
11251 ;SAVE INTERNAL POINTERS CONCERNING INPUT MODE
11253 TYPDEL==2 ;NUMBER OF WORDS IN RELEVANT PDL ENTRY
11257 AOSN CMEOF ;IF SUPPOSED TO POP OUT OF TTY SOON,
11258 CALL POPTT ;DO IT NOW BEFORE CMEOF CLOBBERED.
11259 MOVE F,ITTYP ;GET RELEVANT PDL POINTER
11261 EXCH A,CLNN ;SET UP NEW LINE NUMBER
11262 HRL A,CPGN ;SAVE CURRENT PAGE NUMBER
11263 SETZM CPGN ;NOW RE-INITIALIZE
11264 SKIPGE CRFILE ;SAVE CREF-ALL-ON-ONE-LINE FLAG.
11266 PUSH F,A ;SAVE CPGN,,CLNN
11267 MOVE A,-1(P) ;RETRIEVE NEW MODE
11268 PUSHJ P,PSHLMB ;SAVE LIMBO1 AND SET UP INSTRUCTIONS FOR NEW MODE
11273 MOVEM F,ITTYP ;STORE BACK UPDATED POINTER
11276 ;RESTORE INTERNAL POINTERS CONCERNING INPUT MODE
11280 MOVE F,ITTYP ;GET PDL POINTER
11281 PUSHJ P,POPLMB ;POP INTO LIMBO1, SET UP NEW MODE
11282 POP F,A ;GET CPGN,,CLNN
11283 SETZM CRFILE ;RESTORE ALL-ON-ONE-LINE FLAG.
11293 MOVEM F,ITTYP ;STORE BACK UPDATED POINTER
11297 SETWH2: MOVE A,RCHMOD
11299 SKIPA A,[SIXBIT /TTY:/]
11304 ADD A,[SIXBIT /P0/+1]
11310 ;CAUSE INPUT FROM TTY (MAIN ROUTINES)
11312 GTYIPA: ;PUSH TO TTY, DON'T STO@ AT CR.
11314 IFN ITSSW,[ TYPR [ASCIZ/TTY: .INSRTed, end input with ^C
11316 .ELSE [ IFE SAILSW,[ TYPR [ASCIZ/TTY: .INSRTed, end input with ^Z
11318 .ELSE [ TYPR [ASCIZ /TTY: .INSRTed, end input with CTL-META-LF
11320 GTYIP1: SKIPA A,[3]
11321 GTYIP: MOVEI A,2 ;INPUT FROM TTY, STOP AFTER 1 LINE.
11322 SETZM CMPTR ;FORCE RELOAD ON 1ST READ.
11323 JSP B,PUSHTT ;SET UP VARIABLES AND RETURN
11324 GTYIPR: SETZM CMPTR ;RETURN ON .INEOF OR CR
11327 ;CALL HERE FROM ASSEM1 LOOP WHEN A ^H INTERRUPT IS DETECTED.
11328 TTYBRK: SETZM A.TTYF
11329 ETR [ASCIZ/^H - break /] ;TYPE FILENAME, PAGE AND LINE #.
11331 TYPR [ASCIZ/within a <>, () or []
11335 ;RCHSET ROUTINES FOR READING FROM TTY
11336 ;RCHMOD=3 => DON'T QUIT ON CR
11340 RCHARC: TLO FF,FLTTY ;SET FLAG
11342 RCHAC1: REPEAT 2,[ ;RCH2, RR1
11343 ILDB A,CMPTR ;GET CHAR
11344 CAIN A,0 ;END OF STRING MARKED WITH 0
11345 PUSHJ P,TYRLDR ;RELOAD, JUMP BACK FOR NEXT CHAR
11348 IFN .-RCHAC1-RCHPSN,.ERR RCHAC1 LOSES.
11349 ILDB A,CMPTR ;SEMIC
11356 TYRLD: MOVEI A,3 ;RETURN AFTER THE CALL, NOT BEFORE.
11361 ;RELOAD BUFFER IF RAN OUT IN CALL TO RCH.
11362 TYRLDR: AOSN CMEOF ;EOF DETECTED AFTER LAST RELOAD =>
11363 JRST RPAEOF ;POP OUT OF TTY.
11368 SAVE A.TTYF ;IF CHARS RUBBED OUT THEY SHOULD BE PRINTED.
11370 MOVE F,[10700,,CMBUF-1] ;INITIAL BYTE POINTER TO BUFFER
11371 MOVEM F,CMPTR ;STORE AS BYTE POINTER FOR READ
11372 TYRLD2: PUSHJ P,TYI ;GET CHARACTER
11373 CAIN A,177 ;RUBOUT?
11377 JRST TYRLD7 ;^C, ^Z => EOF.
11379 JRST TYRLD5 ;RUB OUT ALL
11380 CAIE B,2 ;FOR .TTYMAC HANDLING, CONVERT LOWER CASE TO UPPER.
11386 TYRLD6: IDPB A,F ;STORE CHARACTER IN BUFFER
11388 JRST TYRLD2 ;NO, GO BACK FOR NEXT
11389 CAIN B,2 ;.TTYMAC (MODE 2) => CR ENDS INPUT, SO FAKE EOF.
11391 MOVEI A,^J ;FOLLOW THE CR WITH A LF.
11393 SAVE F ;OUTPUT THE ENTIRE LINE TO THE ERROR FILE
11394 MOVE F,[10700,,CMBUF-1]
11398 CAIN A,^M ;IF LINE WAS ENDED BY A ^C OR ^Z, PUT THAT IN ERROR
11399 SKIPL CMEOF ;FILE, WHICH NEEDS HAIR SINCE THAT CHAR IS NOT
11400 JRST TYRLD0 ;IN THE STRING WE STORED.
11403 MOVEI A,IFN DECSW,["Z] .ELSE "C
11406 TYRLD0: CALL ERRCHR
11411 IDPB A,F ;MARK END OF STRING
11419 TYRLD7: SETOM CMEOF ;^C, ^Z FORCE EOF,
11420 CALL TYRLCR ;AFTER TURNING INTO ^M.
11429 TYRLD3: CAMN F,[10700,,CMBUF-1] ;RUBOUT, BEGINNING OF BUFFER?
11431 LDB A,F ;GET LAST CHARACTER IN BUFFER
11432 CALL TYOX ;TYPE IT OUT, DON'T WRITE IN ERROR FILE.
11433 ADD F,[70000,,] ;DECREMENT POINTER
11434 JUMPGE F,TYRLD2 ;JUMP IF VALID
11435 SUB F,[430000,,1] ;WAS 440700,,SOMETHING, BACK IT UP
11438 TYRLD5: MOVE F,[10700,,CMBUF-1] ;^U, BACK TO BEGINNING OF LINE
11439 TYRLD4: PUSHJ P,TYRLCR ;RUBOUT WHEN AT BEGINNING OF BUFFER, TYPE CR
11442 IFN ITSSW,[ ;GET (JUST TYPED IN) CHAR IN A
11446 CALL TTYINI ;OPEN THE TTY IF NOT ALREADY DONE.
11456 .OPEN TYIC,[SIXBIT / TTYMIDAS TYI/] ;INPUT, CONVERT LOWER CASE TO UPPER
11458 .OPEN TYOC,[21,,SIXBIT / TTYMIDAS TYO/] ;DISPLAY MODE OUTPUT
11460 SYSCAL CNSGET,[1000,,TYOC ? 2000,,A ? 2000,,A]
11461 MOVSI A,1 ;TTY: IS TRANSLATED TO SOMETHING ELSE => ASSUME INFINITE LINEL
11462 MOVEM A,LINEL ;ELSE LINEL GETS WIDTH OF TTY.
11463 SETOM TTYOP ;SAY THE TTY IS NOW OPEN.
11466 JCLINI: .SUSET [.ROPTIO,,A]
11467 TLNN A,40000 ;HAS OUR SUPERIUOR SAID IT HAS A CMD?
11469 MOVE A,[CMBUF,,CMBUF+1]
11470 BLT A,CMBUF+CMBFL-2 ;ZERO ALL BUT LAST WD,
11471 MOVEM A,CMBUF+CMBFL-1 ;NONZERO LAST WD.
11472 .BREAK 12,[5,,CMBUF] ;TRY TO READ COMMAND STRING.
11473 MOVE A,[440700,,CMBUF]
11474 SKIPE CMBUF ;IF READ A CMD-STRING,
11475 MOVEM A,CMPTR ;TELL TYRLD, GO2 IT'S THERE.
11478 ;JRST HERE FROM TSINT FOR 2ND WD INTERRUPTS.
11480 MOVEI A,TYIC ;THE TTY CHNL IS THE ONLY ONE ENABLED.
11482 JRST TTYINX ;NO INT. CHAR.
11484 AOS A,TTYFLG ;^W SILENCES,
11486 SOS A,TTYFLG ;^V UNSILENCES,
11488 SETOM TTYBRF ;^H SAYS BREAK NEXT TIME THRU ASSEM1 LOOP.
11494 TYI: SKIPN TTYOP ;OPEN THE TTY, IF NOT ALREADY DONE.
11498 CAIN A,612 ;SAIL => EOF IS 612. SO TURN INTO NORMAL EOF.
11501 CAIE A,^M ;THROW AWAY THE LF AFTER A CR
11504 MOVEI A,^M ;NOTE THAT TYRLDR WILL PUT IT BACK IN.
11507 TTYINI: OPEN TTYINB
11509 INSIRP PUSH P,AA A B
11514 MOVEI AA,1012 ;.TOWID
11516 TRMOP. B, ;READ WIDTH OF TTY LINE INTO B.
11518 TTYIN1: MOVEI B,80. ;TRMOP. FAILED OR NOT TRIED => ASSUME WIDTH IS 80.
11520 INSIRP POP P,B A AA
11528 TTYREN: IFE SAILSW,LOC .JBREN
11532 SETOM TTYBRF ;"REENTER" COMMAND COMES HERE
11533 R: G: IFE SAILSW,JRST @.JBOPC ;TO REQUEST A ^H-BREAK.
11540 ERRCHR: IFN ERRSW,[
11541 SKIPN ERRFOP ;OUTPUT CHAR IN A TO ERROR FILE IF ONE IS OPEN.
11544 JRST ERRCH1 ;OUTPUT BUFFER.
11549 MOVE C,[0 ERRFC,ERRHDR]
11562 JCLINI: SKIPN CCLFLG ; WAS MIDAS CALLED FROM CCL LEVEL?
11563 RET ; NO, DO NOT SNARF TEMPCORE
11564 SETZM CCLFLG ; IF TMPCOR LOSES WANT THIS 0 (WILL RE-SETOM BELOW)
11565 SETZM CMBUF ; ZERO FIRST COMMAND WORD
11566 MOVE A,[CMBUF,,CMBUF+1] ; LOAD BLT POINTER
11567 BLT A,CMBUF+CMBFL-2 ; ZERO ALL BUT LAST WORD
11568 MOVEM A,CMBUF+CMBFL-1 ; NON-ZERO LAST WORD
11569 MOVE A,[2,,['MID,, ? -CMBFL,,CMBUF-1]]
11570 TMPCOR A, ; READ COMPIL-GENERATED COMMAND
11571 RET ; NO COMMAND, PUNT
11572 MOVE A,[440700,,CMBUF] ; LOAD A BYTE POINTER TO THE COMMAND
11573 SKIPN CMBUF ; ONE LAST CHECK FOR IT TO BE THERE
11574 RET ; ALAS, THERE IS NONE
11576 MOVEM A,CMPTR ; THERE IS, SET COMMAND POINTER
11579 CAIE B,^J ;SEE IF OUR COMMAND FILE HAS ANYTHING AFTER 1ST LINE.
11583 SETOM MORJCL ;IT DOES; SET FLAG SO AFTER HANDLING 1ST LINE WE'LL
11585 MOVE C,[440700,,UTIBUF+2]
11589 SUBI C,UTIBUF+1 ;GET # WORDS WRITTEN IN UTIBUF. OPERAND IS RELOCATABLE!
11590 HRLOI C,-1(C) ;THESE 2 INSNS TURN SIZE INTO -SIZE,,UTIBUF+1
11607 TYPDLS==TYPDLC*TYPDEL+INPDEL*MX.INS
11608 ;"TTY PDL", STORES INFORMATION ABOUT CURRENT INPUT MODE
11609 ;(SIMILAR TO MACRO PDL BUT NOT GARBAGE COLLECTED)
11611 ITTYP: -TYPDLS-1,,TTYPDL ;PDL POINTER (TYPDEL=LENGTH OF EACH ENTRY)
11612 TTYPDL: NEDCHK ;ACTUAL PDL: INITIAL ENTRY TO OVERPOP ROUTINE
11613 BLOCK TYPDLS ;PDL PROPER
11615 ;INPUT BUFFER AND VARIABLES
11617 UTIBUF: BLOCK UTIBFL
11618 UTIHDR: 0 ;INPUT BUFFER HEADER (DEC VERSION)
11619 UREDP: 440700,,UTIBUF ;INPUT BYTE POINTER
11620 UTICNT: 0 ;INPUT BYTE COUNT (DEC VERSION)
11621 UTIBED: UTIBUF ;EOF COMPARISON WITH RH(UREDP), 4.9 => EOF ON .IOT
11622 IFSTS: 0 ;.STATUS WORD STORED BY OPNRD1 WHEN .OPEN LOSES
11623 IFN DECSW,UTICHN: UTYIC
11625 ;FILE DESCRIPTION STORAGE
11627 INDDP: MAXIND,,FDSOFS ;POINTER INTO TABLE
11628 FDSBEG==. ;BEGINNING OF TABLE AREA
11629 DNAM: 0 ;DEVICE NAME
11630 FNAM1: 0 ;FILE NAME 1
11632 SNAM: 0 ;SYSTEM NAME
11633 LFDSE==.-FDSBEG ;LENGTH OF TABLE ENTRY
11634 IFDS: BLOCK LFDSE ;SPECIFIED INPUT FILE
11635 0 ;FOR .FDELE AT .FILE TIME
11636 ONAM: BLOCK 3 ;OUTPUT DEVICE/FILENAMES SPECIFIED
11639 OSYSNM: -1 ;SPECIFIED OUTPUT SYSTEM NAME
11641 CRFDEV: BLOCK 3 ;CREF DEV, FN1, FN2.
11642 CRFSNM: 0 ;CREF SNAME.
11644 IFN ERRSW,ERRDEV: BLOCK 4 ;ERROR OUTPUT FILE NAMES.
11646 LSTDEV: BLOCK 3 ;LISTING FILE NAMES.
11651 INFFN1: BLOCK 3 ;FILENAMES OF INPUT FILE BEING READ NOW.
11652 INFCNT: 0 ;# INPUT FILE OPENED.
11653 INFCUR: 0 ;WHAT INFCNT WAS WHEN CURRENT FILE OPENED.
11654 INFERR: 0 ;WHAT INFCUR HELD AT LAST ERROR MSG.
11655 FDSOFS==.-FDSBEG ;OFFSET TO BEGINNING OF NON-DEDICATED AREA
11656 BLOCK LFDSE*MAXIND ;OPEN NAMES @: FILES (AND FNF'S)
11657 SFSFDS=.-FDSOFS ;SOURCE SPECIFIED NAMES @: FILES
11658 BLOCK LFDSE*MAXIND ;STORAGE FOR "
11664 RSYSNM: 0 ;INITIAL SYSTEM NAME
11666 IFN CMUSW, PPNBUF: BLOCK 4 ;FOR CONVERTING CMU PPNs
11668 IFN DECSW,IFE SAILSW, V.SITE: BLOCK 5 ;SYSTEM NAME IN SIXBIT, FOR .SITE.
11672 CMBUF: BLOCK CMBFL ;TYPEIN BUFFER
11673 CMPTR: 0 ;BYTE POINTER TO CMBUF, CLEARED AT GO2 IF >0.
11674 CMEOF: 0 ;-1 => POPTT INSTEAD RELOAD AFTER THIS BUFFERFULL.
11675 IFN DECSW,MORJCL: 0 ;-1 => THERE ARE MORE LINES OF CCL COMMANDS
11676 ;SO DO A RUN SYS:MIDAS WHEN FINISHED.
11677 TTYOP: 0 ;-1 => THE TTY IS ALREADY OPEN.
11678 LINEL: 0 ;WIDTH OF TTY (MAY BE 1,, MEANING ASSUME INFINITE).
11679 A.TTYFLG: ;VALUE OF .TTYFLG:
11680 TTYFLG: 0 ;TTY TYPEOUT PERMITTED IFF >= 0.
11681 WSWCNT: 0 ;THE NUMBER OF W-SWITCHES IN THE LAST CMD STRING.
11682 TTYBRF: 0 ;-1 => ^H BREAK HAS BEEN REQUESTED BUT NOT DONE.
11683 FATAL: 0 ;AT END OF ASSEMBLY, NOT 0 IFF FATAL ERROR OCCURRED.
11684 NEDCRL: 0 ;-1 => HAVEN'T YET SUPPLIED A CRLF AT EOF OF MAIN FILE.
11685 NVRRUN: -1 ;0 => MIDAS WAS RUN; ERROR TO START OR PURIFY.
11689 ERRDNM: (SIXBIT /ERR/)
11691 ERRNM2: 0 ;.STATUS WORD
11693 IFN ITSSW,OCLOSP: @1(C) ;TURNED INTO BP TO UNUSED PART OF LAST BFFER WD USED.
11697 UTOBUF: BLOCK UTOBFL ;OUTPUT BUFFER
11698 UTOHDR: UTOBFL,,UTOBUF-1
11699 UTYOP: 444400,, ;OUTPUT (36. BIT) BYTE POINTER
11700 UTYOCT: 0 ;# WORDS LEFT IN UTOBUF
11702 IFN CREFSW,[ ;CREF OUTPUT VARS.
11703 CRFBUF: BLOCK CRFBSZ
11704 CRFHDR: CRFBSZ,,CRFBUF-1 ;HEADER, ASSEMBLED VALUE USED ONLY IFN ITSSW
11705 CRFPTR: 444400,, ;BP FOR FILLING BUFFER
11706 CRFCNT: 0 ;NUM. CHARS. EMPTY IN BUFFER
11710 LSTBUF: BLOCK LSTBSZ
11711 LSTHDR: 5*LSTBSZ,,LSTBUF-1
11717 ERRBUF: BLOCK ERRBSZ
11718 ERRHDR: 5*ERRBSZ,,ERRBUF-1
11721 ERRFP: 0 ;NON-0 IF WANT ERROR OUTPUT FILE.
11722 ERRFOP: 0 ;NON-0 IF ERROR FILE OPEN (IE TRY OUTPUTTING TO IT)
11726 ;.INSRT FILEDESCRIPTION<CR>
11728 ;TTY: => OK, READS LINE AT A TIME, RUBOUT ALLOWED WITHIN LINE
11729 ;PUSHES MACRO EXPANSION, OTHER .INSRT'S
11730 ;IN FILEDESCRIPTION, ^R => RESET FILE NAME COUNTER
11733 MOVEI F,IFDS-DNAM ;SET UP POINTER TO INPUT FILE NAMES
11734 PUSHJ P,A.IMAP ;DEFAULT NAMES = INPUT NAMES
11735 MOVSI A,(SIXBIT /DSK/)
11737 CAIN B,(SIXBIT /TTY/) ;IF INPUTTING FROM TTY,
11738 MOVEM A,DNAM ;THEN SET DEFAULT DEVICE TO DSK INSTEAD
11739 IFN ITSSW,MOVSI A,(SIXBIT/>/)
11740 IFN DECSW,MOVSI A,'MID
11741 MOVEM A,FNAM2 ;USE > AS THE DEFAULT FN2.
11743 A.IN1: PUSHJ P,RFD ;READ FILE DESCRIPTION
11744 MOVS A,DNAM ;GET SPECIFIED DEVICE NAME
11745 CAIE A,(SIXBIT /@/) ;ATSIGN?
11746 PUSHJ P,A.ITRY ;NO, TRY OPENING FILE
11748 AOJE A,A.INT1 ;ALREADY TRYING TO SET UP TABLE ENTRY
11749 SKIPA F,[MAXIND,,FDSOFS] ;ATSIGN, OR FNF, SEARCH TABLE
11750 A.IN2: SUBI F,-LFDSE ;LOOP POINT SEARCHING TABLE, INCREMENT TO NEXT ENTRY, COUNT DOWN LH
11751 CAMN F,INDDP ;COMPARE WITH POINTER TO TOP OF TABLE
11752 JRST A.IN3 ;AGREE => THIS FILE NOT IN TABLE
11753 MOVE A,F ;-> SFSFDS
11754 MOVSI B,-LFDSE ;-> DNAM, LH FOR COUNT
11755 MOVE T,SFSFDS(A) ;GET SPECIFICATION NAME THIS ENTRY
11756 CAMN T,DNAM(B) ;COMPARE WITH THAT JUST SPECIFIED
11757 AOBJN B,[AOJA A,.-2] ;CHECK ALL NAMES THIS ENTRY
11758 JUMPL B,A.IN2 ;LOOP IF NAMES DON'T ALL AGREE
11760 PUSHJ P,A.IMAP ;SET NEW FILE DESCRIPTION FROM THAT IN TABLE ENTRY
11761 PUSHJ P,A.ITRY ;TRY OPENING FILE
11762 MOVSI A,SFSFDS(F) ;SET UP LH(BLT POINTER),
11763 PUSHJ P,A.IMP1 ;UNMAP TO ORIGINAL NAMES
11764 PUSHJ P,TYPFIL ;TYPE OUT SPECIFIED NAMES
11765 TYPR [ASCIZ / -> /] ;TYPE OUT POINTER
11766 PUSHJ P,A.IMAP ;RE-MAP INTO TRANSLATION ENTRY IN TABLE
11767 SETOM DNAM(F) ;"HALF-KILL" ENTRY
11768 A.INT1: PUSHJ P,IOPNR1 ;TYPE OUT ALL KINDS OF STUFF
11769 A.INT2: PUSHJ P,GTYIP ;PREPARE TO READ ONE LINE FROM TTY
11770 JRST A.IN1 ;TRY AGAIN WITH WHAT HE TYPES IN
11774 A.IN3: TLNN F,-1 ;MORE ROOM FOR ANOTHER ENTRY IN TABLE?
11775 ETF [ASCIZ /Too many @: files/]
11778 BLT A,SFSFDS+LFDSE-1(F) ;SET UP KEY OF NEW ENTRY
11779 SETOM DNAM(F) ;DOCUMENT FACT THAT ENTRY HAS ONLY KEY, NOT TRANSLATION
11781 ADDM A,INDDP ;UPDATE POINTER INTO TABLE
11782 MOVS A,DNAM ;GET SPECIFIED DEVICE NAME
11783 CAIE A,(SIXBIT /@/) ;ATSIGN?
11784 JRST A.INT1 ;NO, TYPE OUT GARBAGE AND TRY AGAIN, READING FROM TTY
11785 MOVE A,IFDS ;YES, CLOBBER FROM INPUT DEVICE NAME
11789 ;TRY OPENING INPUT FILE FOR .INSRT, RETURN IF UNSUCCESSFUL
11791 A.ITRY: MOVS A,DNAM ;GET SPECIFIED DEVICE NAME
11792 CAIN A,(SIXBIT /TTY/) ;TTY?
11793 JRST A.ITRT ;YES, TREAT SPECIAL
11795 PUSHJ P,IPUSH ;SAVE CURRENT STATUS
11796 PUSHJ P,OPNRD1 ;TRY OPENING FILE
11797 JRST IPOPL ;LOSE, POP AND RETURN
11798 IFN ITSSW,CALL SETWH2
11800 MOVEI A,-1-TYPDEL(B)
11802 BLT A,-TYPDEL(B) ;INTRODUCE HYSTERESIS SO .INSRT'ING FILE CAN REFERENCE .IFNM1, .IFNM2
11804 SKIPE CRFONP ;IF CREFFING, OUTPUT PUSH-FILE BLOCK.
11805 PUSHJ P,CRFPSH ;(POP-FILE BLOCK OUTPUT AT IPOP)
11808 MOVE A,DNAM(F) ;PUSH SUCCESSFUL, NOW CHECK TO SEE IF TABLE ENTRY SHOULD BE FINISHED
11810 PUSHJ P,A.OMAP ;YES, DO IT
11811 JRST ASSEM1 ;NOW ASSEMBLE FROM FILE (ASSEM1 CLOBBERS PDL)
11815 A.ITRT: PUSHJ P,GTYIPA ;READ FROM TTY, DON'T QUIT UNTIL .INEOF
11816 JRST A.ITR2 ;FALL BACK IN (DOESN'T TOUCH .IFNM1, .IFNM2)
11818 ;.INEOF ;EOF PSEUDO (MAINLY USEFUL FROM TTY)
11820 A.IEF2: PUSHJ P,PMACP ;LOOP POINT, POP ENTRY OFF MACRO PDL
11821 A.INEO: TLNE FF,FLMAC ;INPUTTING FROM MACRO?
11822 JRST A.IEF2 ;YES, POP IT OFF
11823 PUSH P,CMACCR ;BACK TO INPUTTING FROM FILE OR TTY, CAUSE RETURN TO MACCR
11824 MOVE B,ITTYP ;GET PDL POINTER
11825 POPJ B, ;RETURN TO POP ROUTINE
11829 A.IMAP: MOVSI A,DNAM(F) ;CLOBBER DNAM ETC. FROM TABLE TRANSLATION ENTRY POINTED TO BY F
11830 A.IMP1: HRRI A,DNAM ;ENTRY FOR LH(BLT POINTER) ALREADY SET UP
11831 BLT A,DNAM+LFDSE-1 ;DO IT
11834 A.OMAP: MOVEI A,DNAM(F) ;CLOBBER TRANSLATION OF TABLE ENTRY POINTED TO BY F FROM DNAM ETC.
11836 BLT A,DNAM+LFDSE-1(F)
11839 ;CALL FROM ERRH; TYPE INPUT FILE'S NAMES IF CHANGED SINCE LAST ERR MSG.
11840 ERRTFL: MOVE C,INFCUR
11841 EXCH C,INFERR ;SAY LAST ERROR MSG IN THIS FILE.
11842 CAMN C,INFERR ;IF PREV. MSG WAS IN OTHER FILE,
11844 MOVE C,[-4+DECSW,,INFDEV-DNAM]
11845 PUSHJ P,TYPF1 ;TYPE THIS FILE'S NAMES.
11850 IOPNR1: PUSHJ P,IOPNER ;TYPE OUT CRUFT
11854 ;TYPE OUT DNAM ETC. AS FILE SPECIFICATION
11856 TYPFIL: MOVSI C,-4+DECSW
11857 TYPF1: MOVE B,DNAM(C) ;GET NEXT NAME
11858 PUSHJ P,SIXTYO ;TYPE OUT NAME
11860 MOVE A,FILSPC+4-DECSW(A) ;NOW GET DELIMITING CHARACTER
11861 PUSHJ P,TYOERR ;TYPE OUT
11862 AOBJN C,TYPF1 ;LOOP FOR ALL NAMES
11864 .ELSE,[ SKIPN B,DNAM(C) ;ON DEC SYSTEM PPN IS A SPECIAL CASE
11877 OCTPPN: HLRZ B,DNAM(C) ;LH IS PROJ,
11880 .ELSE [ HLLZ B,DNAM(C)
11887 CALL OCTPNT ;RH IS PROG.
11889 .ELSE [ HRLZ B,DNAM(C)
11898 IFN ITSSW, 40 ? 40 ? ";
11901 ;OPENLOSS DOCUMENTATION ROUTINE
11902 IOPNER: MOVE A,IFSTS ;INPUT
11903 OPNER: MOVEM A,ERRNM2 ;SAVE .STATUS WORD
11904 PUSHJ P,TYPFIL ;TYPE OUT FILE DESCRIPTION
11905 PUSHJ P,CRRERR ;NOW CRLF TO ENSURE ROOM FOR FOLLOWING
11907 TYPR [ASCIZ/OPEN failed/]
11911 .OPEN ERRC,ERRDNM ;NOW GET THE SYSTEM TO SAY WHAT'S WRONG
11912 .VALUE ;CAN'T OPEN ERR DEVICE?
11913 IOPNR2: .IOT ERRC,A ;GET CHARACTER FROM SYSTEM
11914 CAIN A,14 ;ENDS WITH FORM FEED
11916 PUSHJ P,TYOERR ;TYPE OUT CHARACTER
11917 JRST IOPNR2 ;LOOP BACK FOR NEXT
11920 ;READ SINGLE FILE DESCRIPTION INTO DNAM ... SNAM .
11921 ;FRNNUL 1 IFF SPEC WAS NONNULL.
11922 ;FRMRGO 1 IFF "." WAS SEEN IN DEC VERSION - FORCE NULL FN2.
11923 ;FRCMND 1 IFF SHOULD RECOGNIZE -, COMMA, / AND ( AS SPECIAL CHARACTERS.
11924 RFD: TRZ FF,FRNNUL+FRMRGO
11925 RFD8: SETZ D, ;D COUNTS FILENAMES. 0 BEFORE 1ST.
11926 RFD1: MOVEI C,0 ;INITIALIZE SIXBIT NAME.
11927 MOVE B,[440600,,C] ;SET UP BP FOR INPUT
11928 RFD2: PUSHJ P,RCH ;GET CHARACTER IN A
11929 CAIN A,": ;IF COLON...
11930 JRST RFDCOL ;THEN PROCESS AS SUCH
11931 CAIN A,"; ;SIMILARLY FOR SEMICOLON
11934 CAIN A,"! ; FOO! MEANS RUN SYS:FOO WITH OFFSET 1
11937 CAIN A,^Q ;IF CONTROL Q...
11938 JRST RFDCQ ;THEN GET NEXT CHARACTER AND TREAT AS NON-SYNTACTICAL
11939 TRNN FF,FRCMND ;IF READING COMMAND, _, COMMA, / AND ( ARE SPECIAL.
11942 JRST CMDSW ;READ SWITCHES.
11944 JRST CMDSL ;READ 1 SWITCH
11945 IFN DECSW,CAIN A,"=
11946 .ALSO JRST RFD6 ;ON DEC SYS, "=" = "_"
11949 JRST RFD6 ;COMMA AND _ END SPEC.
11953 CAIN A,". ;. LIK SPACE ON DEC SYS.
11955 CAILE A,40 ;LOGICAL SPACE? (INCLUDING CR)
11957 RFD6: TRZN FF,FRMRGO ;EXCEPT AFTER ".",
11958 JUMPE C,RFD5 ;IGNORE NULL FILENAMES
11959 XCT RFDTAB(D) ;STORE THE NAME (MAY SKIP)
11960 ADDI D,1 ;NEXT NAME PUT ELSEWHERE
11965 TRO FF,FRNNUL ;SPEC NOT NULL.
11966 RFD5: IFN DECSW,[CAIN A,"[ ;] READ PPN FOR DEC SYS.
11968 CAIN A,^R ;CONTROL R,
11969 JRST RFD8 ;RESETS FILENAME COUNT
11971 CAIN A,"= ;ON DEC SYS, "=" = "_".
11976 CAIE A,"_ ;RETURN IF SPEC TERMINATOR,
11979 JRST RFD1 ;ELSE NEXT NAME.
11981 RFDCQ: PUSHJ P,RCH ;CONTROL Q EATS UP THE NEXT CHARACTER
11983 JRST RFD6 ;BUT NOT IF CR
11984 RFDC: CAIL A,140 ;CONVERT LOWER CASE TO UPPER.
11986 SUBI A,40 ;CONVERT CHARACTER TO SIXBIT
11987 TLNE B,770000 ;TOO MANY CHARACTERS?
11991 RFDTAB: MOVEM C,FNAM1 ;1ST NAME.
11992 MOVEM C,FNAM2 ;2ND NAME.
11993 MOVEM C,DNAM ;3RD NAME IS DEV.
11994 MOVEM C,SNAM ;4TH IS SNAME.
11995 CAIA ;5TH AND ON IGNORED, DON'T INCR. D.
11997 RFDCOL: TRO FF,FRNNUL
11998 JUMPE C,RFD1 ;IF HE WANTS THE NULL DEVICE HE GETS TO TYPE IT IN
11999 MOVEM C,DNAM ;MOVE TO RH OF DEVICE LOCATION
12003 RFD7: PUSHJ P,RFDPPN ;READ PPN, USE AS "SNAME".
12005 RFDSEM: TRO FF,FRNNUL
12006 JUMPE C,RFD1 ;NO NULL SYSTEM NAMES PLEASE
12007 MOVEM C,SNAM ;MOVE TO SYSTEM NAME LOCATION
12011 RFDPPN: PUSHJ P,RFDOCT ;READ PROJECT NUM,
12012 IFN CMUSW, JUMPE C,RCMUPP ;AT CMU WATCH FOR OUR FUNNY PPNs
12014 PUSHJ P,RFDOCT ;READ PROGRAMMER NUM.
12018 IFE SAILSW,RFDOCL=="0 ? RFDOCH=="8 ;READ OCTAL NUMBERS.
12019 .ELSE RFDOCL==40 ? RFDOCH==140 ;READ SIXBIT (RIGHT-JUSTIFIED).
12021 RFDOCT: SETZ C, ;READ OCTAL NUM, RETURN IN C.
12022 RFDOC1: PUSHJ P,RCH
12025 IFN SAILSW,[ ;[ ;EVEN IF READING SIXBIT NAMES (FOR SAIL),
12026 CAIE A,", ;COMMA AND CLOSEBRACKET ARE STILL SPECIAL.
12032 POPJ P, ;NOT OCTAL OR NOT 6BIT, RETURN.
12033 IMULI C,RFDOCH-RFDOCL
12038 RCMUPP: CAIN A,"] ;WATCH OUT FOR []
12040 REPEAT 4, SETZM PPNBUF+.RPCNT
12041 MOVE C,[440700,,PPNBUF]
12042 RCMUPL: CAIE A,^M ;Don't look too far
12049 RCMUPD: MOVE A,[C,,PPNBUF]
12058 ;PROCESS "FOO!", WHICH MEANS "RUN SYS:FOO WITH AN OFFSET OF 1".
12060 RFDRUN: MOVSI A,'SYS ;DEV NAME
12062 SETZB C,D ;DEFAULT THE FN2. 4TH WORD NOT USED.
12063 SETZB T,TT ;DEFAULT THE PPN (UNUSED ANYWAY). DON'T SPECIFY CORE SIZE.
12064 MOVE AA,[1,,A] ;<START OFFSET>,,<ADDRESS OF ARG BLOCK>
12067 RFDRU1: MOVE F,[1,,RFDRUE]
12068 CORE F, ;FLUSH AS MUCH CORE AS POSSIBLE, SINCE RUN UUO CAN LOSE
12069 HALT ;BECAUSE OF HOW MUCH WE HAVE.
12077 ;COMMAND SWITCH PROCESSING.
12079 CMDSL: CALL RCH ;COME HERE AFTER A SLASH. READ ONE SWITCH.
12089 JRST RFD6 ;DON'T CRASH IF USER PUTS CR IN SWITCH LIST.
12093 CMDSW1: CAIL A,140 ;LOWER CASE TO UPPER.
12096 SOS TTYINS ;COUNT # T-SWITCHES.
12101 CAIN A,"W ;W - PREVENT TTY MESSAGES, AND RQ ERROR OUTPUT FILE IF POSSIBLE.
12102 IFE ERRSW,AOS WSWCNT
12105 CAIN A,"E ;E - RQ ERROR LOG FILE.
12109 CAIN A,"C ;C - RQ CREF OUTPUT.
12114 ;READ COMMAND, DEFAULT FILENAMES.
12117 SKIPN CMPTR ;UNLESS HAVE DDT COMMAND STRING, PROMPT.
12118 CMDB: TYPR [ASCIZ/*/]
12119 MOVEI A,3 ;READ FROM TTY (OR STRING <- CMPTR)
12121 TRO FF,FRCMND+FRARRO ;TELL RFD ABOUT COMMA, _ AND (.
12122 CALL RFD ;NOW SEE IF COMMAND NULL, AND WHETHER HAS _.
12126 JRST CMDB ;JUST A CR WITH NOTHING SIGNIFICANT BEFORE IT.
12128 TRZ FF,FRARRO ;FRARRO WILL BE ON IFF NO _ IN STRING.
12130 JRST CMD1 ;READ THRU THE WHOLE COMMAND.
12134 ;NOW RE-READ THE STRING, FOR REAL THIS TIME.
12135 CMD1: MOVE F,[440700,,CMBUF]
12136 MOVEM F,CMPTR ;START FROM BEGINNING OF STRING.
12137 IFN CREFSW,SETZM CREFP ;CLEAR ALL SWITCHES BEFORE DECODING THEM.
12138 INSIRP SETZM 0,ERRFP TTYINS WSWCNT
12141 SETOM LISTP1 ;WILL BE AOSED BY EACH (L) SWITCH.
12143 SETZM DNAM ;CLEAR OUT ALL FILENAMES.
12144 MOVE T,[DNAM,,DNAM+1]
12146 MOVSI T,'DSK ;DEFAULT DEV IS DSK
12147 MOVEM T,DNAM ;EXCEPT PERHAPS IF OUTPUT SPEC NULL.
12149 MOVEM T,SNAM ;DEFAULT SNAME IS INITIAL SNAME.
12151 TRNN FF,FRARRO ;DON'T GOBBLE INPUT SPEC AS OUTPUT!
12152 CALL RFD ;READ BIN FILE SPEC.
12153 MOVE F,FF ;REMEMBER WHETHER NULL
12154 MOVE T,[DNAM,,ONAM]
12157 CAIN T,'NUL ;IF BIN WENT TO NUL:,
12158 MOVEI T,'DSK ;CREF GOES TO DSK.
12159 MOVSM T,DNAM ;ELSE DEFAULT DEV FOR CREF IS BIN'S DEV.
12160 IFN DECSW,MOVSI T,'CRF
12161 IFN ITSSW,MOVE T,[SIXBIT/CREF/]
12162 MOVEM T,FNAM2 ;DEFAULT THE CREF FILE'S NAMES.
12166 JRST CMD2 ;RAN OUT OF OUTPUT SPECS => JUST USE DEFAULTS.
12167 CALL RFD ;READ CREF FILE SPEC.
12169 TRNN FF,FRNNUL ;IF SPEC NOT NULL OR ENDED BY _,
12171 SETOM CREFP ;WE MUST WANT TO CREF.
12172 CMD2: MOVE T,[DNAM,,CRFDEV]
12175 MOVSI T,'ERR ;DEFAULT THE ERROR OUTPUT FILE'S NNAMES.
12178 JRST CMD6 ;NO MORE OUTPUT SPECS.
12179 CALL RFD ;READ ERROR FILE SPPEC.
12181 TRNN FF,FRNNUL ;NONNULL SPEC OR LAST SPEC =>
12183 SETOM ERRFP ;MUST WAANT ANN ERROR FILE.
12184 CMD6: MOVE T,[DNAM,,ERRDEV]
12189 IFN DECSW,MOVSI T,'LST
12190 IFN ITSSW,MOVE T,[SIXBIT/LIST/]
12191 MOVEM T,FNAM2 ;DEFAULT LST FILE FN2.
12192 CAIN A,"_ ;ANY OUTPUT SPEC REMAINING?
12194 CALL RFD ;YES, READ ONE.
12195 SETOM LISTP ;LIST SPEC GIVEN IMPLIES WANT LISTING.
12196 CMD3: MOVE T,[DNAM,,LSTDEV]
12201 CALL RFD ;IGNORE ANY OUTPUT SPECS NOT NEEDED.
12204 CMD4: MOVSI T,'DSK ;DEFAULT THE INPUT NAMES.
12206 CAIE A,'PTP ;DON'T LEAVE DEV NAME SET TO COMMON OUTPUT-ONLY DEVS.
12209 IFN DECSW,MOVSI T,'MID
12210 IFN ITSSW,MOVSI T,'>_14
12212 MOVE T,[SIXBIT/PROG/]
12213 SKIPN FNAM1 ;THE FN1 ALONE IS STICKY ACROSS THE _.
12215 TRO FF,FRARRO ;IF ONLY 1 NAME IT SHOULD BE FNAM1.
12216 CALL RFD ;READ INPUT SPEC.
12217 MOVE T,[DNAM,,IFDS]
12219 MOVE T,FNAM1 ;DEFAULT OUTPUT FN1'S TO INPUT.
12230 IFN ERRSW,[SKIPN ERRDEV+1
12233 MOVSI A,'NUL ;THE OUTPUT DEV DEFAULTS TO NUL:
12234 MOVS T,DNAM ;IF THE INPUT IS FROM TTY:
12236 TRNE F,FRNNUL ;AND THE BIN SPEC WAS NULL.
12239 TRZ FF,FRARRO ;DON'T LOUSE UP .INSRT'S READING.
12244 CRFOUT: SOSGE CRFCNT
12245 JRST CRFOU1 ;NO ROOM, OUTPUT AND INIT BUFFER.
12250 MOVE C,[0 CREFC,CRFHDR]
12255 CRFSSF: SKIPA A,[1] ;OUTPUT SET-SOURCE-FILE BLOCK.
12256 CRFPSH: MOVEI A,3 ;OUTPUT PUSH-SOURCE-FILE BLOCK.
12257 REPEAT 4,[ CALL CRFOUT
12258 MOVE A,INFDEV+.RPCNT
12266 ;L SWITCH TYPED IN DURING COMMAND, SET UP FOR LISTING
12267 CMDLST: SETOM LISTP ;SAY WANT LISTING.
12268 AOS LISTP1 ;(STARTS AS -1, WILL BE POS. AFTER 2ND (L))
12271 ;PRINT CHARACTER IN A
12272 PILPT: SOSGE LSTCNT
12278 MOVE C,[0 LPTC,LSTHDR]
12285 \f;GET ANOTHER K OF MACTAB SPACE.
12287 CORRQB: IFN ITSSW,.VALUE ;LOOP POINT FOR DON'T PROCEED
12292 MOVE A,(P) ;RESTORE A FROM PDL
12295 GCCORQ: MOVE A,MACHI
12296 LSH A,-2 ;CONVERT TO WORD #
12297 CAIL A,MXMACL ;WANT MORE THAN ALLOWED?
12299 MOVE A,MACTND ;NO, GET ADDR OF BLOCK WE WANT TO GET.
12300 PUSH P,A ;ENTRY, SAVE A IN CASE HAVE TO TRY AGAIN
12302 HRLI A,10001 ;(CODE FOR FRESH PAGE, _1)
12304 .CBLK A, ;TRY GETTING BLOCK
12313 JRST MACIN2 ;UPDATE POINTERS TO END OF MACTAB.
12320 No core for macro table./]
12321 CORQL1: TYPR [ASCIZ /
12323 CORQL2: PUSHJ P,TYI ;GET CHAR
12326 JRST CORRQA ;=> TRY AGAIN
12328 JRST CORRQB ;=> BACK TO DDT THEN TRY AGAIN
12330 ERJ CORQL1 ;=> TYPE OUT ERROR-TYPE BLURB
12331 TYPR [ASCIZ /? /] ;SOMETHING ELSE
12334 ] ;END TS CONDITIONAL
12336 FEED1: SKIPA B,[40]
12342 IFG PURESW-DECSW,[ ;PURIFICATION ROUTINE
12344 PURIFG: -1 ;-1 IF NOT (YET) PURIFIED
12359 IFG PURESW-DECSW,[LOC <.+1777>&-2000 ;SKIP TO NEXT PAGE
12360 MAXPUR==./2000 ;FIRST PAGE ABOVE PURE PAGES
12361 PRINTA Pure pages = ,\MAXPUR-MINPUR
12367 IFN DECDBG, DECDBB: BLOCK 8000. ;SPACE FOR DEC DDT'S SYMS.
12370 BBKCOD==. ;BEGIN BLANK CODING, CLEARED OUT DURING INITIALIZATION
12371 IFG PURESW-DECSW,MINBNK==<.+1777>/2000 ;FIRST PAGE OF BLANK CODE
12372 BNKBLK ;DUMP OUT ACCUMULATED BLANK CODING
12374 ;NOW MORE BLANK CODING
12376 BKBUF: BLOCK BSIZE+5 ;CURRENT BLOCK TO OUTPUT
12377 GLOTB: BLOCK 20 ;GLOBAL TABLE, EACH ENTRY FLAGS,,ADR OF SQUOZE (SEE COMMENTS NEAR BEGINNING)
12378 STRSTO: BLOCK STRL ;STRING STORAGE FOR GSYL AND FRIENDS
12380 FASB: BLOCK FASBL ;OUTPUT BUFFER FOR FASL MODE
12381 ;FIRST WD 9 FOUR BIT CODE GROUPS, REST ASSOC STUFF
12382 FASAT: BLOCK FASATL ;ATOM TABLE FOR FASL MODE
12383 ;EACH ENTRY CONSISTS OF ATOM IN FORMAT DESIRED BY FASLOAD,
12385 ; HEADER WD. RH LENGTH IN WDS
12386 ; 4.8-4.7 TYPE 0-PN 1 FIX 2 FLO 3 BIG (NOT IMPLEMENTED)
12387 ; FOLLOWED BY PN OR VALUE
12388 ;-EXCEPT- IF RH OF HEADER =0, THIS SLOT RESERVED FOR LIST
12392 EBKCOD==. ;END BLANK CODING
12395 PRINTA ST = ,\.-RL0
12397 ST: ;SYMBOL TABLE 3 WORDS/SYM FIRST SQUOZE, SECOND "VALUE", 3RD FLAGS,,BLOCK.
12398 BLOCK NRMWPS*SYMDSZ
12400 ;LITERALS TABLES - CAN MOVE AND GROW. THESE TAGS & LENGTHS ARE JUST THE DEFAULTS
12401 .SEE CONTBA ;ETC, WHICH CONTAIN THE ACTUAL ADDRESSES. SO DON'T USE THEM!
12402 CONTAB: BLOCK LCONTB ;CONSTANTS TABLE, VALUES OF CONSTANTS THIS CONSTANTS AREA
12403 CONGLO: BLOCK LCNGLO ;CONSTANTS GLOBAL TABLE, EACH ENTRY TWO WORDS
12404 ;FIRST WD GLOTB ENTRY. SECOND WD ADR IN CONTAB OF CONSTANT TO WHICH IT REFERS
12405 CONBIT: BLOCK LCONTB/12.+1 ;RELOCATION BITS AND ILNOPT BIT(SEE CPTMK)
12406 ;3 BITS FOR EACH WORD OF CONTAB.
12408 ;;INIT ;INITIALIZATION ROUTINES (IN MACRO TABLE, GET WIPED OUT)
12409 IFN ITSSW,MINMAC==./2000 ;# OF 1ST PAGE HOLDING PART OF MACTAB.
12410 ;NOTE THAT THIS CODE IS COPIED UPWARD WHEN MACTAB IS MOVED
12411 ;DUE TO SYMTAB EXPANSION. THEREFOR IT MUST REFER TO ITSELF
12412 ;INDEXED BY THE OFFSET OF WHERE IT IS FROM WHERE IT WAS ASSEMBLED.
12413 ;THAT IS KEPT IN CH1. ALL LITERALS MUST BE USED INDEX OF CH1, TOO.
12416 MACTBA: 773767750000 ;MACRO CHARACTER STORAGE (FIRST WORD 3 375'S)
12417 INIT1: MOVE CH1,MACTAD ;GET ADDR THIS COODE REALLY STARTS AT.
12418 SUBI CH1,MACTBA ;GET OFFSET FROM WHERE ASSEMBLED.
12420 MOVE A,[BBKCOD,,BBKCOD+1](CH1)
12421 BLT A,EBKCOD-1 ;CLEAR OUT BLANK CODING
12422 PUSH P,[SP4](CH1) ;NOW INIT THE SYMTAB & FINISHED.
12424 ;INITIALIZE THE SYMTAB, EXPECT SIZE IN SYMLEN.
12425 INITS: MOVE AA,SYMLEN ;SET UP THE OTHER VARS
12426 IMUL AA,WPSTE ;DEALING WITH SYMTAB SIZE.
12428 ADDI AA,ST ;ADDR OF START OF CONTAB.
12431 ADD AA,CONLEN ;ADD LENGTH OF CONTAB TO GET ADDR OF CONGLO TAB.
12432 MOVEM AA,CONTBE ;WHICH IS ALSO THE END OF CONTAB.
12435 MOVE A,CONLEN ;ADD IN LENGTH OF CONGLO (1/4 OF CONLEN)
12438 MOVEM AA,CONGLE ;TO GET END OF CONGLO, AND START OF CONBIT TABLE.
12443 ADD AA,A ;ADD LENGTH OF CONBIT (1/12 OF CONLEN) GETTING ADDR OF MACTAB.
12447 IORI AA,1777 ;FIX ALLOCATION PROBLEMS ON KI-10
12449 ETF [ASCIZ /No core for symbols/](CH1)
12453 HRLZM A,SYMAOB ;AOBJN -> SYMTAB.
12459 CAMG AA,MACTAD ;MOVED MACTAB UP?
12461 IFN ITSSW,[ ;YES, GET CORE FOR INCREASE.
12463 MOVEI AA,MACL+1777(AA)
12464 LSH AA,-10. ;1ST PAGE NOT NEEDED BY MACTAB.
12465 MOVEI A,MACL+1777+MACTBA(CH1)
12466 LSH A,-10. ;1ST PAGE MACTAB DOESN'T YET HAVE.
12467 SUBM A,AA ;# PAGES NEEDED.
12469 HRRI AA,(A) ;-<# PAGES>,,<1ST NEEDED>
12470 JUMPGE AA,.+3(CH1) ;DON'T CALL IF NEED 0 PAGES, WOULD GET ONE.
12475 SUBM AA,MACTAD ;MACTAD _ SHIFT IN START OF MACTAB.
12476 EXCH AA,MACTAD ;MACTAD GETS NEW START, AA HAS SHIFT.
12477 MOVSI A,PTAB-CCOMPB
12478 ADDM AA,PTAB(A) ;RELOCATE BYTE-PTRS INTO MACTAB.
12480 MOVNI B,INITS2(CH1)
12481 HRROI A,@EISYMP(CH1)
12482 ADDI B,1(A) ;GET # WDS IN SECOND HALF OF INIT CODE.
12483 HRRM AA,.+1(CH1) ;COPY 2ND HALF UPWARD WITH POP-LOOP.
12484 POP A,(A) ;THIS INSN IMPURE.
12486 ADDI CH1,(AA) ;CHANGE OFFSET TO PT. TO NEW LOCATIONN OF INIT CODE.
12487 JRST INITS2(CH1) ;JUMP INTO 2ND HALF, WHERE IT'S BEEN COPIED TO.
12488 INITS2: HRROI A,INITS2-1(CH1) ;THEN COPY 1ST HALF (WHICH ENNDS BEFORE INITS2)
12489 SUBI A,(AA) ;GET WHERE NOW ENDS, NOT WHERE WILL END.
12490 MOVEI B,INITS2-MACTBA ;UP UNDERNEATH THE 2ND HALF.
12491 HRRM AA,.+1(CH1) ;(THIS TWO-STEP COPYING HANDLES ALL OVERLAPS)
12494 INITS1: MOVE AA,SYMSIZ
12496 MOVE A,[ST,,ST+1](CH1)
12497 BLT A,ST-1(AA) ;CLEAR OUT SYMBOL TABLE
12498 SETZM ESBK ;DEFINE THEM IN OUTER BLOCK.
12499 MOVEI AA,ISYMTB(CH1)
12500 MOVS F,ISMTBB(CH1) ;GET SWAPPED VALUE OF FIRST INSTRUCTION
12501 SP3: CAIL AA,EISYM1(CH1)
12502 JRST SP1(CH1) ;DONE WITH INSTRUCTIONS
12506 PUSHJ P,ES ;WON'T SKIP
12515 EISYMP: ;MAY BE MUNGED
12516 SP1: CAIL AA,EISYMT(CH1)
12519 LDB T,[400400,,SYM](CH1)
12525 CAME T,[GLOETY,,](CH1) ;GLOBAL ENTRIES REALLY EXITS, HACKED TO DEFEAT ADDRESS LINKING
12526 CAMN T,[GLOEXT,,](CH1)
12535 INITSB: SETZ ? 'CORBLK
12536 1000,,600000 ;BOTH READ AND WRITE.
12537 1000,,-1 ? AA ;INTO SELF, AA IS AOBJN -> PAGES.
12538 SETZI 400001 ;FRESH PAGES.
12540 ;GOBBLE SYMS FROM SYSTEM
12541 ;TABLE AREA IN SYSTEM:
12543 ;LAST (AS OPPOSED TO LAST + 1) SYSYME
12545 TSYMGT: MOVE AA,[MXICLR-MXIMAC,,MXICLR]
12546 .CALL INITSB ;GET MACTAB PAGES NNOT LOADED INTO.
12549 MOVE AA,[MINBNK-MINMAC,,MINBNK]
12550 .CALL INITSB ;GET PAGES FOR BLANK CODE & SYMTAB.
12554 JSP F,PURIFD ;NOT PURIFIED => FLUSH PAGES
12555 MINPUR-MXIMAC ;OF MACTAB CREATED BY LOADING BUT NOT NEEDED.
12559 MOVEI A,EISYMT ;EISYMT FIRST LOC FOR ITS SYMS
12560 MOVE B,[SIXBIT /CALLS/] ;SYSTEM CALLS
12561 .GETSYS A, ;READ IN SYSTEM CALLS (SHOULD SKIP)
12564 .VALUE ;.GETSYS DIDN'T UPDATE AOBJN POINTER
12565 HRRM A,SP1 ;MARK END OF SYMS
12568 .VALUE ;MACL TOO SMALL! INITS MIGHT LOSE.
12570 MOVEI AA,SYMC_<-18.+4> ;SQUOZE FLAG FOR SYM
12571 TSYMG2: DPB AA,[400400,,(B)]
12577 IFN PURESW,[ ;HERE ARE THE GUTS OF THE PURIFY ROUTINE
12579 PURIFY: SKIPL NVRRUN
12580 .VALUE [ASCIZ /:
\eAlready run
\e
12582 PURIF1: MOVEI P,17 ;START PDL AT 20
12583 JSP F,PURIFD ;CALL .CBLK ROUTINE
12584 MINMAC-MINBNK ;FLUSH BLANK CODE PAGES (INCL. SYM TAB)
12586 MINPUR-MXICLR ;FLUSH MACTAB PAGES CREATED BY LOAD BUT NOT NNEEDED.
12588 MAXPUR-MINPUR ;PURIFY PURE PAGES.
12590 SETZM PURIFG ;SET "PURIFIED" FLAG
12591 MOVE [1,,2] ;NOW CLEAR OUT REMAINS OF DATA OF SELF
12594 .VALUE [ASCIZ /:
\ePurified
\epdump
\17 SYS;TS MIDAS
\16\e/]
12596 GAPFLS: JSP F,PURIFD ;FLUSH GAP PAGES CREATED ON INITIAL LOAD.
12601 ;JSP F,PURIFD ;DO A SEQUENCE OF .CBLKS
12602 ;FOLLOW WITH AN ARBITRARY NUMBER OF PAIRS OF ARGUMENTS
12603 ;FIRST ARG OF PAIR # PAGES TO PROCESS, MAY BE ZERO
12604 ;SECOND INITIAL .CBLK AC CONTENTS
12606 PURIFD: MOVE C,(F) ;GET COUNT
12607 TLNE C,777000 ;CHECK INSTRUCTION PART
12608 JRST (F) ;INSTRUCTION => RETURN TO IT
12609 JUMPE C,PURID2 ;JUMP IF NO PAGES IN COUNT
12610 MOVE A,1(F) ;GET INITIAL .CBLK ARG
12613 ADDI A,1001 ;INCREMENT .CBLK ARG TO NEXT PAGE
12614 SOJG C,PURID1 ;DO IT THE APPROPRIATE NUMBER OF TIMES
12618 ] ;END PURESW CONDITIONAL
12619 ] ;END ITSSW, CONDITIONAL
12623 IFE SAILSW,HRLZ A,.JBSYM ;GET ADDR OF START OF DDT SYMS,
12624 .ELSE HRLZ A,JOBSYM
12625 HRRI A,DECDBB+200 ;LEAVE 200 WD SPACE BEFORE THEM.
12626 IFE SAILSW,[HRRM A,.JBSYM ;MOVE THEM INTO SPACE PROVIDED
12628 .ELSE [HRRM A,JOBSYM
12631 BLT A,DECDBB+177(B) ;SO THEY WON'T GET IN MACTAB'S WAY.
12637 ;;ISYMS ;INITIAL SYMBOL TABLE
12639 ADJSP=105_33 ;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE
12641 ISMTBB: ADJSP ;FIRST OP. CODE IN ISYMTB
12740 SQUOZE 10,JFFO ;PDP10 INSTRUCTION
12744 SQUOZE 10,CIRC ;CIRCULATE: ROTC WITH AC+1 GOING THE WRONG WAY
13072 SQUOZE 10,LDBI ;REALLY ILDB,
13074 SQUOZE 10,DPBI ;AND IDPB
13086 IRPS INST,,FAD FSB FMP FDV
13097 .ISTOP TERMIN TERMIN
13099 IFN TNXSW,[;; RESET IS BOTH A JSYS AND A CALLI!!
13102 IFSN X,RESET,[SQUOZE 10,X
13104 .ISTOP TERMIN TERMIN
13108 IFE SAILSW,.DECMT DECDF1
13110 IFN SAILSW,.DECMS DECDF1
13111 IFE SAILSW,.DEC.J DECDF1
13112 IFN SAILSW,.DECJB DECDF1
13115 IFN TNXSW,[;; DEFINE JSYS'S ON TENEX VERSION
13120 .ISTOP TERMIN TERMIN
13236 IRPS X,,[.BIND=0,.KILL=3KILL,.HKILL=3SKILL,.XCREF=3NCRF,.DOWN=3DOWN]
13237 IFE 1&.IRPCN, SQUOZE 4,X
13238 IFN 1&.IRPCN, X,,A.KILL
13246 IRPS X,,[.MLLIT=CONSML,.PASS=A.PASS,.PPASS=A.PPASS,.SUCCESS=A.SUCCESS
13247 .HKALL=HKALL,.STGSW=STGSW,.LITSW=LITSW,.AVAL1=AVAL1,.AVAL2=AVAL2
13248 .ASKIP=A.ASKIP,.CURLN=CLNN,.CURPG=CPGN,.QMTCH=QMTCH,.STPLN=A.STPLN,.STPPG=A.STPPG]
13249 IFE 1&.IRPCN, SQUOZE 4,X
13250 IFN 1&.IRPCN, X,,INTSYM
13253 ;CONDITIONALS (SEE ALSO IFSE, IFSN)
13275 SQUOZE 4,IFDEF ;ASSEMBLE IF SYM DEFINED
13277 SQUOZE 4,IFNDEF ;ASSEMBLE IF SYM NOT DEFINED
13279 SQUOZE 4,IFB ;ASSEMBLE IF STRING BLANK (HAS NO SQUOZE CHARS)
13281 SQUOZE 4,IFNB ;ASSEMBLE IF STRING NOT BLANK
13283 SQUOZE 4,IFSQ ;ASSEMBLE IF STRING ARG IS ALL SQUOZE
13285 SQUOZE 4,IFNSQ ;ASSEMBLE IF STRING ARG IS NOT ALL SQUOZE.
13315 IRPS A,,E N G LE GE L
13330 SQUOZE 40,$O. ;(OH) GLOBAL OFFSET
13332 SQUOZE 40,$L. ;REAL LOCATION (WITHOUT OFFSET)
13351 ILVAR\ILFLO,,A.GLOB
13362 A.CRFN ;START CREFFING.
13364 A.CRFFF ;STOP CREFFING.
13369 A.CRFN==ASSEM1 ;THESE DO NOTHING IF CAN'T CREF.
13373 IFN MACSW,[ ;MACRO PROCESSOR PSEUDOS
13374 ;MACROS GET DEFINED AS
13375 ;SQUOZE 4, <MACRO NAME>
13376 ;<CHAR ADR>,, MACCL
13412 IFN RCHASW,[SQUOZE 4,.TTYMAC
13424 SQUOZE 4,.ARRAY ;3 INDEX TO AFDMY1 TBL
13427 AFATOM(AFDMAI) ;2 INDEX TO AFDMY1 TBL
13428 AFDMAI==2 ;INDEX OF ATOM IN AFDMY1 TBL
13430 AFATOM(1) ;1 " " " "
13432 AFATOM(0) ;0 " " " "
13434 AFLIST(1) ;NORMAL LIST
13436 AFLIST ;EVAL LIST AND THROW VALUE AWAY
13438 AFLIST(2) ;EVAL LIST AND "RETURN" VALUE
13440 AFENTY ;DECLARE LISP ENTRY POINT (SUBR ETC)
13467 IRPS X,,UAI UAO BAI BAO UII UIO BII BIO
13472 IRPS X,Y,START LFILE STP+SYM JCL PFILE STB CONV+XUNAME
13481 EISYMT: PRINTA \.-MACTBA-1, words initialization coding.
13483 IFNDEF MACL,MACL=.+5-MACTBA
13484 IFGE .-MACTBA-MACL,.ERR MACL TOO SMALL
13488 IFGE .+2400-MACTBA-MACL,.ERR MACL TOO SMALL
13490 MXICLR==./2000 ;FIRST PAGE ABOVE INITIALIZING CODING
13491 LOC <MACTBA+MACL+1777>&-2000
13492 MXIMAC==./2000 ;FIRST PAGE ABOVE INITIAL MACTBA
13493 MAXMAC==<CONMAX+CONMAX/4+CONMAX/12+1+MXMACL+SYMMAX*MAXWPS+ST+1777>/2000
13494 ;1ST PAGE MACRO TABLE CAN'T POSSIBLY USE.
13495 IFLE MINPUR-MAXMAC,.ERR PURE TOO LOW.
13496 PRINTA MINPUR-MAXMAC = ,\MINPUR-MAXMAC
13499 IFN TS,END BEG ;MUST BE BEFORE RELOCATABLE END STATEMENT,
13500 ;SINCE TS MIDAS NOW TRIES TO DO MULTIPLE 1PASS ASSEMBLIES FROM SAME FILE.
13501 ;PUTTING RELOCABLE END STATEMENT FIRST CAUSES IT TO ENCOUNTER OTHER
13502 ;END STATEMENT IN NEW ASSEMBLY CAUSING CONFUSION