From 9af82f432322b4c0dad566d7f4ba1691db0fe9a4 Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Fri, 23 Feb 2018 10:01:56 +0100 Subject: [PATCH] Old MIDAS versions. MIDAS 108 < 1973-03-09 MIDAS 323 1977-05-10 MIDAS 352 1977-10-16 MIDAS 400 1978-07-22 MIDAS 412 1978-12-16 MIDAS 421 1980-03-09 MIDAS 433 1983-04-05 MIDAS 455 1984-01-31 TSRTNS 171 1978-07-22 TSRTNS 181 1978-10-03 TSRTNS 188 1978-12-16 TSRTNS 194 1980-11-17 TSRTNS 229 1984-10-03 TSRTNS 231 1985-06-18 --- src/midas/midas.108 | 10031 ++++++++++++++++++++++++++++++ src/midas/midas.323 | 13496 ++++++++++++++++++++++++++++++++++++++++ src/midas/midas.352 | 13549 +++++++++++++++++++++++++++++++++++++++++ src/midas/midas.400 | 11849 +++++++++++++++++++++++++++++++++++ src/midas/midas.412 | 11917 ++++++++++++++++++++++++++++++++++++ src/midas/midas.421 | 11960 ++++++++++++++++++++++++++++++++++++ src/midas/midas.433 | 11985 ++++++++++++++++++++++++++++++++++++ src/midas/midas.455 | 11953 ++++++++++++++++++++++++++++++++++++ src/midas/tsrtns.171 | 4149 +++++++++++++ src/midas/tsrtns.181 | 4189 +++++++++++++ src/midas/tsrtns.188 | 4231 +++++++++++++ src/midas/tsrtns.194 | 4252 +++++++++++++ src/midas/tsrtns.229 | 4587 ++++++++++++++ src/midas/tsrtns.231 | 4586 ++++++++++++++ 14 files changed, 122734 insertions(+) create mode 100644 src/midas/midas.108 create mode 100644 src/midas/midas.323 create mode 100644 src/midas/midas.352 create mode 100644 src/midas/midas.400 create mode 100644 src/midas/midas.412 create mode 100644 src/midas/midas.421 create mode 100755 src/midas/midas.433 create mode 100755 src/midas/midas.455 create mode 100644 src/midas/tsrtns.171 create mode 100644 src/midas/tsrtns.181 create mode 100644 src/midas/tsrtns.188 create mode 100755 src/midas/tsrtns.194 create mode 100755 src/midas/tsrtns.229 create mode 100755 src/midas/tsrtns.231 diff --git a/src/midas/midas.108 b/src/midas/midas.108 new file mode 100644 index 00000000..fddd009c --- /dev/null +++ b/src/midas/midas.108 @@ -0,0 +1,10031 @@ + +TITLE MIDAS 6 + +IFN <17-.TYPE .SYMTAB >, .SYMTAB 4000. ;APPROX TWICE # SYMS. +;CONDITIONALS IN FOLLOWING FOR COMPATIBILITY WITH OLD AND NTS VERSIONS OF MIDAS +IFE <17-.TYPE IFNDEF >,[DEFINE IFNDEF NAME +IFE <17-.TYPE NAME >*<3-.TYPE NAME >,TERMIN ;ASSEMBLE IF NAME NOT DEFINED +] +IFNDEF IFDEF,[DEFINE IFDEF NAME +IFN <17-.TYPE NAME >*<3*.TYPE NAME >,TERMIN ;ASSEMBLE IF NAME DEFINED +] +IF1,[IFN <17-.TYPE .INSRT >,[ +EQUALS NO,.INEOF ;LET "NO" BE VALID ANSWER TO TYPED OUT QUESTION +PRINTC /SWITCHES? +/ + ;NOW GET ANSWER, USER CAN TYPE IN STUFF IF HE WANTS TO, DEFINING SWITCHES, ETC. +.INSRT TTY: +EXPUNGE NO +PRINTC /OK. +/ ;A SIGN OF LIFE IS OFTEN WELCOMED IF TYPEIN HAS BEEN HAIRY +]] + +IFNDEF TS,TS==1 ;NON-ZERO FOR ASSEMBLED VERSION TO RUN IN TIME-SHARING +IFNDEF MOBY,MOBY==1 ;NON-ZERO TO ASSEMBLE MOBY SYMBOL TABLE, ETC. +IFE TS,1PASS +IFNDEF A1PSW, A1PSW==TS ;FOR 1PASS END-OF-PROGRAM AUTO-REASSEMBLY +IFNDEF TSSYMS, TSSYMS==1 ;.UAI, .UAO, .BAI, .BAO, .UII, .UIO, .BII, .BIO - EVER USE THEM? +IFNDEF LISTSW, LISTSW==0 ;LISTING FEATURE FOR MAINT PROGS +IFNDEF CREFSW, CREFSW==TS ;SET TO ALLOW C SWITCH TO CAUSE CREF OUTPUT. +IFNDEF RCHASW, RCHASW==TS ;INCLUDE TTY AS POSSIBLE INPUT DEVICE +IFNDEF PURESW, PURESW==TS ;NON-ZERO TO SEPARATE PURE CODING FROM IMPURE AND DO PAGE SKIPS +IFNDEF .I.FSW, .I.FSW==1 ;NON-ZERO => INCLUDE .I, .F +IFNDEF MACSW, MACSW==1 ;NON-ZERO => INCLUDE MACRO PROCESSOR (!) +IFN TS,IFNDEF RUNTSW, RUNTSW==1 ;ASSEMBLE CODING TO TYPE OUT RUN TIME AT END OF ASSEMBLY +IFNDEF WRQTSW, WRQTSW==1 ;WRQOTE (MACRO DEFINITION READER) VERSION + ; ^ 0 => SLOW, 1 => FAST; MAYBE 2 WILL EVENTUALLY BE CREATED +IFE TS,[IFNDEF MACL,[ +IFE MOBY,MACL==2*2000 ;LENGTH OF MACTAB (MACRO DEFINITION TABLE) +IFN MOBY,MACL==6*2000 +]]IFN TS,[IFNDEF MACL,MACL==4000 +IFNDEF MXMACL,MXMACL==16.*2000 ;MAXIMUM LENGTH MACTAB (USED ONLY IF PURESW .NE. 0) +]IFNDEF MACRUM,MACRUM==4 ;# WORDS NOT USED AT END OF MACTAB +IFNDEF STRL,STRL==20 ;LENGTH OF STRING STORAGE (USED BY GSYL) +IFNDEF DMDEFL,DMDEFL==20 ;MAX NO OF DMY ARGS IN DEFINE +IFNDEF DMYAGL,DMYAGL==400 ;MAX NO COMBINED DMYARGS ALL MACROS CURRENTLY EXPANDING OR PUSHED +IFNDEF MPDLL,MPDLL==300 ;MACRO PDL LENGTH +IFNDEF DSSIZ,DSSIZ==40 ;MAX # ARGS MACRO WHOSE ARGS BEING SCANNED (SHOULD BE .GE. DMDEFL) +IFNDEF BKTABL,BKTABL==40 ;MAX NUM BLOCKS. +IFNDEF BKPDLS,BKPDLS==10 ;MAXIMUM BLOCK NESTING DEPTH. +IFNDEF BSIZE,BSIZE==37 ;PREFERRED SIZE BLOCK MAX SIZE-3 +IFNDEF LPDL,LPDL"==500 ;LENGTH OF PDL +IFNDEF LCONTB,IFN MOBY,LCONTB==500*5 ;LENGTH OF CONSTANTS TABLE +IFNDEF LCONTB,IFE MOBY,LCONTB==500 +IFNDEF LCNGLO,LCNGLO==200*3 ;LENGTH OF CONST GLO TAB +IFNDEF NCONS,NCONS==25. ;MAXIMUM NUMBER OF CONSTANTS AREAS +IFNDEF NVARS,NVARS==25. ;MAX. NUM. VARIABLES AREAS. +IFNDEF SYMDSZ,SYMDSZ==2177*2 ;DEFAULT # SYMS IN SYMTAB. +IFNDEF SYMMSZ,SYMMSZ==10177*2 ;# SYMS IF JNAME IS MMIDAS. +IFNDEF DECSW,DECSW==0 ;NOT TEN50 VERSION. + +IFNDEF MIDVRS,MIDVRS"=.FNAM2 +.GLOBAL MIDVRS ;IN CASE USER HAS TYPED IT IN + +;AC DEFS + +FF"=0 ;FLAGS +P=1 +I=2 ;INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF +AA=3 +A=4 +B=5 +C=6 +D=7 +T=10 ;NOT SO TEMP AS IN MOST PROGS W/ T +TT=11 +SYM=12 ;FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR +LINK=13 +F=14 +CH1=15 ;MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH +CH2=16 ;" " " +TM=17 ;SUPER TEMPORARY + +IFDEF .XCREF, .XCREF FF,P,I,A,B,C,D,T + +;FF FLAGS NOT PUSHED +;LEFT HALF +PPSS"==400000 ;ONE IF PUNCHING PASS; MUST BE SIGN +INDEFF==200000 ;SET IF LOC OR OFFSET IS INDEF +SKILF==100000 ;ONE IF SYM TO BE SEMI KILLED IN DDT + +VOT"==40000 ;ALL RCH S MUST GO THRU RCH + ; IE TYPCTL .NE. POPJ P, (SET/CLEARED BY MDSSET, MDSCLR) +MACRCH"==20000 ;ONE IF CHARS COMING FROM MACRO PROCESSOR, DON'T HACK CPGN/CLNN +TTYRCH"==10000 ;ONE IF CHARS FROM SOMEWHERE ELSE BUT NOT HACKING CPGN/CLNN +PTPF==2000 ;SET IF (TIME SHARING) OUTPUT DEVICE IS PTP + +OUTF==4000 ;ONE IF OUTPUT HAS OCCURED IN CURRENT MODE (USED BY TS NED LOGIC) + +;FF RIGHT HALF FLAGS + +FIRWD==400000 ;ONE FOR FIRST WORD OF BLOCK +IPSYMS==200000 ;ONE IF SYM PUNCH DESIRED +LOCF==100000 ;ONE BETWEEN ABS LOC ASSIGN AND + ;FIRST BLOCK OUTPUT THEREAFTER (EBLK TO OUTPUT NULL BLOCK SO LINKING LOADER KNOWS $.) + +NPSS"==40000 ;ONE IF TWO PASS ASSEMBLY +PSS"==20000 ;ONE ON PASS 2 + +INVTF==4000 ;USED BY PBITS AND OUTPUT TO OUTPUT WORDS OF CODE BITS IN CORRECT ORDER (STEAD LOGICAL) +NLIKF==2000 ;TEMPORARILY SUPPRESS ADR LINKING +GLOLOC==1000 ;ONE IF LOCATION PLUS OFFSET IS GLOBAL + +BITF==400 ;SET IF LAST TIPLE OF CODEBITS WAS 7. +MRSW==200 ;MACRO PROC TO RETURN TO .GO HACKER W/O READING NEXT CHAR (SEE RCHSAV) + + ;INDICATOR REGISTER + +;LEFT HALF +GLI==1 ;SET ON " CLEARED EACH SYL +VAR==2 ;SET ON ' " " " +FLO==4 ;SET ON . " " " +DECP==10 ;DECIMAL PREFER +UARI==20 ;1 => RIGHT OPERAND TO UPARROW BEING READ +LSRET==40 ;RETURN FROM < +MNSFLG==100 ;SET IF LAST OP WAS MINUS +WRDF==400 ;SET IF CURRENT WORD IS NOT NULL RETURNED BY GETWORD +NPRC==1000 ;ONE IF NUMBER ALREADY PROCESSED BY UPARROW +UNRCHF==2000 ;=> RE-INPUT LAST CHARACTER (SEE RCH) +MWRD==4000 ;SET ON MULTIPLE WORD +MWRD1==20000 ;SET BY LBRAK AS SIGNAL TO ITSELF THAT THIS NOT FIRST + ;WORD OF MULTI-WORD CONSTANT +NOOPTF==40000 ;CONSTANTS OPTIMIZATION SUPPRESSION FLAG; SHOULD BE SET BY + ;VALUE-RETURNING PSEUDO DURING NOT PUNCHING PASS TO KEEP ITSELF OUT OF + ;CONSTANTS OPTIMIZATION + + +;RIGHT HALF + +FLD==1 ;SET IF FLD NOT NULL +SYL==2 ;SET IF L-N SEEN IN CURRENT SYL +LET==4 ;SET IF LET SEEN IN CURRENT SYL +DEF==10 ;SET IF CURRENT EXPR DEFINED + +COM==40 ;SET IF CURRENT QUAN IS COMMON +PERI==100 ;SET IF PERIOD SEEN IN WHAT IS SO FAR (INCL .) A NUMBER +EQLF==200 ;ONE DURING READING WORD TO RIGHT OF = +AIOWD==400 ;FIRST FIELD OF CURRENT WORD HAS IO INST +CONT==1000 ;SET IF NOT OK TO END BLOCK +IFN TS,FFFLG==2000 ;USED BY RFD TO COUNT FILE NAMES +PSEUDF==4000 ;SET IF ERROR COMMENTS WILL COME FROM PSEUDO +GMINF==20000 ;SET IF UARI OR BAKARI HAS GOBBLED MINUS +OPFLD==200000 ;SET IF OPERATOR SEEN IN CURRENT FIELD + ;LINK TABLE (GLOTB), ACCUMULATES GLOBAL REFERENCES FOR CURRENT FROB (USUALLY WORD) TO OUTPUT +;GLSP2 POINTS TO (I.E. HAS ADR 1 LESS THAN) BOTTOM OF ACTIVE PART OF TABLE +;GLSP1 POINTS TO TOP (HAS ADR OF LAST ENTRY ACTIVE) + +;ACTUAL ENTRIES IN GLOTB: +;IF ENTIRE WORD ZERO, ENTRY IS NULL, WILL (OR SHOULD) BE IGNORED +;RH ADR OF SQUOZE WITH INTERNAL MIDAS FLAGS (USUALLY IN SYMBOL TABLE, BUT MAY BE ANYWHERE IN CORE) +;LH: RIGHT 10. BITS MULTIPLICATION FACTOR OR 0 => 1 + ;GLOBAL SHOULD BE MULTIPLIED BY IT +;REST OF LH FLAGS: + +;SIGN BIT => THIS NOT PART OF FIELD, DON'T PLAY WITH FLAGS AT GETFLD, INTFD +ACF==40000 ;AC LOW OR HIGH (SWAPF => HIGH) +HFWDF==100000 ;MASK GLOBAL TO HALFWORD +SWAPF==200000 ;SWAP +MINF==20000 ;NEGATIVE OF GLOBAL + +IFNDEF LBRKT,LBRKT=="[ ;LEFT DELIMITER FOR EXPLICITLY GROUPED CONDITIONALS, MACRO ARGS, REPEAT BODY, ETC. +IFNDEF RBRKT,RBRKT=="] ;RIGHT " +IFNDEF WPS, WPS==3 ;# CONTIG. WDS /STE. IFNDEF FOR DEBUGGING. +IFNDEF BKWPB,BKWPB==3 ;# WDS/BKTAB ENTRY. +IFNDEF EOFCH,EOFCH==3 ;EOF CHAR, BEWARE DISPATCH TABLE ENTRIES. + +ERSM=1000,, ;ERROR, TYPE SYM. +ERR=2000,, ;ERROR, ORDINARY MESSAGE. +ERJ=3000,, ;ERROR, NO MESSAGE, RETURN TO ADDR. +ERI=4000,, ;ERROR, IGNORE LINE, RET. TO ASSEM1. +ERA=5000,, ;ERROR, RET. TO ASSEM1. +ER1=6000,, ;ERROR ON PASS 1 ONLY, TYPE SYM. +ERF=7000,, ;FATAL ERROR. +TYPR=(37000) ;UUO, TYPE OUT ASCIZ STRING + +;3RDWRD LH. SYM TAB BITS + +3REL==600000 ;RELOC BITS, DO NOT CHANGE, SOMETIMES REFERENCED BY NUMERIC BYTE POINTERS +3RLR==200000 ;R(RH) +3RLL==400000 ;R(LH) +3RLNK==100000 ;R(LINK) +3INI==40000 ;INITIAL SYM +3LLV==4000 ;LINKING LOADER MUST INSERT VAL +3VP==20000 ;VALUE PUNCHED +3VCNT==1000 ;USED IN CONSTANT +3SKILL==10000 ;SEMI KILL IN DDT +3VAS2==2000 ;VAR SEEN ON PASS TWO WITH ' +3MAS==400 ;MULTIPLE SYMS SAME NAME AT DIFFERENT LEVELS (I.E. KEEP LOOKING + ;AT SYMBOL LOOKUP) +3NCRF==200 ;DON'T CREF THIS SYMBOL. + +3DFCLR==777000 ;BITS IN LH TO CLEAR ON REDEFINITION. + +;CONTROL FLAGS +;LEFT HALF +TRIV==400000 ;1 IF OUT FORM IS FOR TRIVIAL LOADER (ABSOLUTE) +;RIGHT HALF +ARIM==2 ;IF ONE OUT FOR IS RIM +SBLKS==10 ;IF ONE OUT FORM IS SIMPLE BLOCKS +ARIM10==20 ;PDP-10 RIM +DECREL==40 ;DEC RELOCATABLE FORMAT. + +;SQUOZE FLAG DEFINITIONS IN MIDAS SYMBOL TABLE + +CMMN==0 ;COMMON (NOT USED) +PSUDO==40000 ;PSEUDO OR MACRO, VALUE RH ADDR OF RTN (MACCL FOR MACRO), + ; LH WILL BE IN LH OF B WHEN RTN CALLED. +SYMC==100000 ;SYM, VALUE IS VALUE OF SYM. +LCUDF==140000 ;LOCAL UNDEF +DEFLVR==200000 ;DEF LOC VAR, VALUE IS VALUE. +UDEFLV==240000 ;UNDEF LOC VAR, VALUE IS 1+ IDX IN VARIAB. AREA, BUT IGNORD IF VAR AREA GLOB. +DEFGVR==300000 ;DEF GLO VAR, VALUE IS VALUE +UDEFGV==340000 ;UNDEF GLO VAR, VALUE LIKE UNDEF LOCAL VAR. +GLOETY==400000 ;GLO ENTRY +GLOEXT==440000 ;GLO EXIT +NCDBTS==GLOEXT_<-18.+4>+1 ;# CODE BIT TYPES + +DEFINE CDBCHK TBLNAM +IFN .--NCDBTS,.ERR TBLNAM LOSES +TERMIN + +;LOADER BLOCK TYPES LINK +LLDCM==1 ;LOADER COMMAND BLOCK +LABS==2 ;ABSOLUTE +LREL==3 ;RELOCATABLE +LPRGN==4 ;PROG NAME +LLIB==5 ;LIBRARY BLOCK +LCOMLOD==6 ;LOAD INTO COMMON +LGPA==7 ;GLOBAL PARAMETER ASSIGN +LDDSYM==10 ;LOCAL SYMS +LTCP==11 ;LOAD TIME COND ON PRESENCE +ELTCB==12 ;END LOAD TIME COND +LPLSH==22 ;POLISH FIXUP + +;LOADER COMMANDS +;IN ADR OF LDCMD BLK +LCJMP==1 ;JUMP +LCGLO==2 ;GLOBAL LOC ASSIGN +LCCMST==3 ;SET COMMON BENCHMARK +LCEGLO==4 ;END OF GLOBAL BLOCK +LDCV==5 ;LOAD TIME COND ON VALUE +LDOFS==6 ;LOADER SET GLOBAL OFFSET +LD.OP==7 ;LOADER .OP + +;LOADER CODEBITS SECOND SPEC AFTER 7 +CDEF==0 ;DEF +CCOMN==1 ;COMMON REL +CLGLO==2 ;LOC-GLO REC +CLIBQ==3 ;LIBREQ +CRDF==4 ;GLO REDEF +CRPT==5 ;REPEAT GLOBAL VALUE +CDEFPT==6 ;DEFINE SYM AS $. + +;DEC RELOCATABLE BLOCK TYPES. +DECWDS==1 ;STORAGE WORDS. +DECSYM==2 ;SYMBOL DEFS OR GLOBAL ADDITIVE RQS. +DECEND==5 ;END BLOCK, HAS PROGRAM BREAK. +DECNAM==6 ;PROGRAM NAME. +DECSTA==7 ;STARTING ADDRESS BLOCK. + +DEFINE PRINTA A,B,C,D,E,F +IF1,[PRINTC Á!B!C!D!E!F +Ý +TERMIN + +IFE PURESW,[ ;FOLLOWING IF NOT ASSEMBLING PURE CODING + +DEFINE PBLK +TERMIN + +DEFINE VBLK +TERMIN +] + +IF1 [DEFINE BNKBLK OP +OP +TERMIN ] + + ;ADD A LINE TO BNKBLK, ACCUMULATED CONTENT OF + ;WHICH IS DUMPED OUT AT END OF ASSEMBLY + ;ARG TO BLCODE SHOULD BE FREE OF STORAGE WORDS + +DEFINE BLCODE NEWCFT +IF1 [BNKBLK [DEFINE BNKBLK OP +OP]NEWCFT +TERMIN ] +IF2 [IRPW X,,[ +NEWCFT +] +IRPS Y,,X +Y=Y +.ISTOP TERMIN TERMIN ] TERMIN + + ;3RDWRD MANIPULATING MACROS + ;GET 3RDWRD INTO LH("A"), "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3GET A,B + MOVE A,ST+2(B) + TERMIN + + ;GET 3RDWRD INTO "A", "B" HAS ADR OF 1STWRD + +DEFINE 3GET1 A,B + MOVE A,2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3PUT A,B + MOVEM A,ST+2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS ADR OF 1STWRD + +DEFINE 3PUT1 A,B + MOVEM A,2(B) + TERMIN + +IFN PURESW,[ ;FOLLOWING IF ASSEMBLING PURE CODING + +;MEMORY ORGANIZATION PURE CODING + +;MAXVAR BLOCKS OF IMPURE CODING, NO DYNAMIC ALLOCATION + ;BLCODE MACRO ACCUMULATES CODING TO BE PUT AT END OF + ;IMPURE CODING, NO STORAGE WORDS ALLOWED +;THEN SYM TAB, STARTING AT ST. +;THEN MACRO TABLE (WITH INIT. CODE IN IT) +;STARTING INITIALLY AT MACTBA, ACTUAL ADDR IN MACTAD. +;SYMTAB AND MACTAB DON'T NECESSARILY START ON PAGE BNDRYS. +;THEN GAP TO MINPUR*2000 (HEREAFTER KNOWN AS "THE GAP") +IFN DECSW,MINPUR==200 +IFE DECSW,MINPUR==120 ;BLOCK NUMBER BEGINNING OF PURE CODING +;PURE CODING UNTIL MAXPUR*2000-SOMETHING +;THE FOLLOWING MACROS AND BLCODE MAKE IT NOT COMPLETELY NECESSARY +;TO SEPARATE PURE CODING FROM IMPURE + +CKPUR==0 ;0 => ASSEMBLING BELOW THE GAP, 1 ABOVE + + ;SWITCH TO CODING ABOVE THE GAP + +DEFINE PBLK +IFN CKPUR,.ERR PBLK +IFE CKPUR,[VAR.LC==. +LOC PUR.LC +]CKPUR==1 +TERMIN + +PUR.LC==MINPUR*2000 ;SAVED LOCATION COUNTER ABOVE THE GAP WHEN ASSEMBLING BELOW + + ;SWITCH TO CODING BELOW THE GAP + +DEFINE VBLK +IFE CKPUR,.ERR VBLK +IFN CKPUR,[PUR.LC==. +LOC VAR.LC +]CKPUR==0 +TERMIN + +PBLK ;PBLK NORMAL MODE, VARIABLE AREAS BRACKETED WITH VBLK AND PBLK + +] ;END PURESW CONDITIONAL + +.YSTGW ;SET UP NOW, STORAGE WORDS OK + + ;RANDOM MACRO DEFINITIONS + + ;ASSEMBLE BYTE INSTRUCTION POINTING TO CERTAIN BIT + +DEFINE BYB A,B,C +ZZZ=C +ZZ=43 +REPEAT 35.,[IFGE ZZZ,[ ZZZ=ZZZ_1 + ZZ=ZZ-1 +]] +A,[ZZ*10000+100,,B] +TERMIN + + ;A HAS ADR OF SYM SQUOZE, SKIP IF IT'S IN SYMBOL TABLE + +DEFINE SKPST A + CAIL A,ST + CAML A,MACTAD +TERMIN + + ;EXECUTE AN INSTRUCTION WITH VARIOUS ADDRESSES (USUALLY PUSH OR POP) + +DEFINE INSIRP A,B +IRPS %ADR,,[B] +A,%ADR +TERMIN +TERMIN + +DEFINE MOVEIM B,C + MOVEI A,C + MOVEM A,B +TERMIN + +DEFINE MOVEMM B,C + MOVE A,C + MOVEM A,B +TERMIN + +IFNDEF HALT,[ +IFN TS-DECSW, HALT==.VALUE +IFE TS-DECSW,[DEFINE HALT + JRST 4,. + TERMIN +]] + +IF1 [IFN DECSW,[.INSRT COM:DEC DEFS + .DECDF +IFN PURESW,.DECTWO +IFE PURESW,.DECREL +]] + +FOO==. +LOC 41 + JSR ERROR +IFN TS-DECSW,JSR TSINT +IFN DECSW,[LOC JOBAPR + TSINT1] +LOC FOO + + ;DISPATCH TABLE FOR NON-SQUOZE CHARACTERS + ;REFERENCED AS DTB-40(RH OF POPJ IN GDTAB) + ;DTB ENTRY OF SYL TERMINATOR PUT IN CDISP BY GETSYL + +DSYL==400000 ;SYL OPERATOR, DISPATCH INDEXED BY RH AT GETSYL (MUST BE SIGN) +DFLD==200000 ;FIELD OPERATOR, GETFD +DWRD==100000 ;WORD OP, GETWD +;ALL CLEAR => WORD TERMINATOR, NO DISPATCH + +DTB: DWRD,,SPACE ;40 SP, TAB, RUBOUT + DSYL,,RRL2 ;EXCLAIM + DSYL,,DQUOTE ;" + DFLD,,XORF ;NUM SIGN + 0 ;(USED TO BE DOLLAR SIGN) + 0 ;(USED TO BE PERCENT SIGN) + DFLD,,ANDF ;AMPERSAND + DSYL,,SQUOTE ;' + DFLD,,LEFTP ;( 50 + 0 ;) + DFLD,,MULTP ; STAR TIMES + DFLD,,PLS ;+ PLUS + DWRD,,COMMA ; , + DFLD,,MINUS ;- + 0 ;UNUSED (FORMERLY PERIOD) + DFLD,,DIVID ;/ + DSYL,,COLON ;COLON 60 + DSYL,,SEMIC ;SEMI + DFLD,,LSSTH ;< + DSYL,,EQUAL ;= + 0 ;> + 0 ;? + DSYL,,ATSGN ;AT SIGN + DFLD,,LBRAK ;[ + DFLD,,IORF ;BACKSLASH 70 + DSYL,,RBRAK ;] + DSYL,,UPARR ;^ + DSYL,,BAKAR ;BACKARR + 0 ;CR + 0 ;(USED TO BE TAB) + 0 ;ALL OTHER + DSYL,,LINEF ;LF (DSYL TO HACK CLNN) + DSYL,,FORMF ;FORM FEED (") 100 + + ;NOTE THAT POPJ P, IS VALID TEST FOR SQUOZENESS + ;EXCEPT FOR EOFCH + +GDTAB": REPEAT 3,POPJ P,76 ;(GDTAB GLOBAL SO OUT OF TS, AIO CAN CLOBBER GDTAB+141 WITH JRST RREOF + ;ON OLD FILES) +IFN .-GDTAB-EOFCH,[PRINTC /EOFCH DOESN'T AGREE WITH GDTAB. +/] +IFE TS,[POPJ P,76] IFN TS,[JRST RREOF] + REPEAT 5,POPJ P,76 + POPJ P,40 ; TAB + POPJ P,77 ; LF + POPJ P,76 ; VERT TAB + POPJ P,100 ; FORM FEED + POPJ P,74 ; CR + REPEAT "!-16-1,POPJ P,76 + POPJ P,40 ; SPACE + POPJ P,41 ; ! + POPJ P,42 ; " + POPJ P,43 ; # + ADD SYM,%$SQ(D) ; $ + ADD SYM,%%SQ(D) ; % + POPJ P,46 ; & + POPJ P,47 ; ' + POPJ P,50 ; ( + POPJ P,51 ; ) + POPJ P,52 ; * + POPJ P,53 ; + + POPJ P,54 ; , + POPJ P,55 ; - + JSP CH1,POINT ; . + POPJ P,57 ; / + REPEAT 10.,JSP CH2,RR2 ; DIGITS + POPJ P,60 ; : + POPJ P,61 ; ; + POPJ P,62 ; < + POPJ P,63 ; = + POPJ P,64 ; > + POPJ P,65 ; ? + POPJ P,66 ; @ +IFDEF .CRFOFF,.CRFOFF +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN + POPJ P,67 ; [ + POPJ P,70 ; \ + POPJ P,71 ; ] + POPJ P,72 ; ^ + POPJ P,73 ; _ + POPJ P,76 ; NOW LOWER CASE GRAVE ACCENT + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN +IFDEF .CRFON,.CRFON + REPEAT 4,POPJ P,76 ; BRACES, VERT BAR, TILDE + POPJ P,40 ; RUBOUT, LIKE SPACE + IFN .-GDTAB-200,[PRINTX /GDTAB LOSES +/] + +NSQTB: IFDEF .CRFOFF,.CRFOFF +IRPC Q,,0123456789 + ADD SYM,%!Q!SQ(D) +TERMIN + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890$%. +%!Q!SQ: 0 + SQUOZE 0,Q/50/50/50/50/50 + SQUOZE 0,Q/50/50/50/50 + SQUOZE 0,Q/50/50/50 + SQUOZE 0,Q/50/50 + SQUOZE 0,Q/50 + SQUOZE 0,Q +TERMIN +IFDEF .CRFON,.CRFON + +;FORMAT TABLE(S) +;4.9-4.4 ETC SPECIFY SHIFT +;4.4-3.6 ETC SPECIFY NUMBER BITS +;FIELD SPECS IN REVERSE ORDER + +IFORTB: 0 ;NCNSN 10 , + 0 ;NCNSF 11 IMPOS + 0 ;NCNCN 12 ,, + 2200,, ;NCNCF 13 ,,C + 2200000000 ;NCFSN 14 ,B + 0 ;NCFSF 15 ,B C + 0 ;NCFCN 16 ,B, + 0 ;NCFCF 17 ,B,C + 4400000000 ;FSNSN 20 A + 0 ;FSNSF 21 IMPOS + 0 ;FSNCN 22 IMPOS + 0 ;FSNCF 23 IMPOS + 2200440000 ;FSFSN 24 A B + 2200220044 ;FSFSF 25 A B C + 270400440000 ;FSFCN 26 A B, + 2227040044 ;FSFCF 27 A B,C + 4400000000 ;FCNSN 30 A, + 0 ;FCNSF 31 IMPOS + 22220000 ;FCNCN 32 A,, + 2200002222 ;FCNCF 33 A,,B + 2200440000 ;FCFSN 34 A,B + 0 ;FCFSF 35 A,B C + 0 ;FCFCN 36 A,B, + 0 ;FCFCF 37 A,B,C +FRTBL==.-IFORTB ;LENGTH OF FORMAT TABLE +VBLK +FORTAB: BLOCK FRTBL ;ACTUAL FORMAT TABLE +FRTBE=.-1 +PBLK + +;VARIABLE STORAGE + +VBLK + +RETURN: JRST . ;RH HAS RETURN ADR FOR END OF MAJOR ROUTINE (E.G PASS 2) +CDISP: 0 ;CURRENT DISPATCH CODE +PPRIME: 0 ;PUSH DOWN LIST MARKER (GETFLD) +SCNDEP: 0 ;DEPTH IN SUCCESSFUL BRACKET CONDITIONALS INSIDE INNERMOST LITERAL. +ASSEMP: 0 ;RESTORE P FROM HERE AT ASSEM1. SAVED OVER LITERAL. +GLSPAS: 0 ;RESTORE GLSP1 AT ASSEM1. SAVED OVER LITERAL. +GLSP1: 0 ;POINTER TO BOT OF LINKAGE TABLE IN USE HIGH ADR +GLSP2: 0 ;POINTER TO TOP OF LINKAGE TABLE IN USE LOW ADR +FORMAT: 0 ;ACCUMULATES FORMAT WORD +FORPNR: 0 ;POINTER INTO FORMAT WORD, SHOULD BE FORMAT+1 SO CLOBBERABLE BY LAST IDPB +FLDCNT: 0 ;NUMBER OF FIELDS PUSHED DOWN IN CURRENT WORD +WRD: 0 ;ACCUMULATES VALUE OF WORD +WRDRLC: 0 ;RELOC OF WRD, MUST COME RIGHT AFTER WRD. +T1: 0 ;TEMP +T2: 0 ;TEMP +PBITS1: 0 ;CURRENT CODE BITS +PBITS2: 0 ;NO OF SPECS LEFT IN CURRENT WORD +PBITS4: 0 ;POINTER TO WHERE CURRENT CODE BITS WILL GO +OPT1: 0 ;POINTER FOR STORING IN BKBUF (OUTPUT BUFFER) +CONTRL": 0 ;FLAG REG FOR IO CONTROL ETC, .GE. 0 => RELOCATABLE/1PASS +CDATBC: 0 ;CURRENT DATA BLOCK CODE TYPE +SCKSUM: 0 ;CKSUM FOR SIMPLE BLOCK FORMAT +IFN A1PSW,[ +PRGC": -1 ;ONE LESS THAN # TIMES END HAS BEEN ENCOUNTERED +OUTN1": -1 ;.GE. 0 => OUTPUT HAS OCCURED IN OTHER THAN 1PASS MODE (NOT INITIALIZED) +OUTC": -1 ;.GE. 0 => OUTPUT HAS OCCURED DURING CURRENT ASSEMBLY +] +LINKL: 0 ;SAVE LIMIT OF GLOTB GETWRD +STRCNT: 0 ;COUNT OF CHARS READ (INCL. DELIM) BY GSYL +STRPNT: 0 ;TEMP AT GSYL, BYTE POINTER TO STRING STORAGE +GETCNR: 105 ;PRIORITY OF UNARY OPS (AOS'D TO CAUSE RIGHT TO LEFT EVALUATION) +ISYMF": -1 ;-1 IF ISYMS HAVE NOT BEEN SPREAD +SMSRTF": -1 ;-1 IF SYMTAB HASN'T BEEN SORTED (PSEUDOS DELETED) +GLOBT: 0 ;GLSP1 PUSHED DOWN ONE LEVEL AT GETFLD +BITP: 0 ;BYTE PNTR TO CODE BITS IN CURRENT (RELOC) BLOCK +LDCCC: 0 ;DEPTH IN LOADTIME CONDS +PARBIT: 0 ;0 OR 4 FOR : OR = (IN GENERAL, TEMP AT P7X) +STGSW: 0 ;NON ZERO GIVES ERROR PRINT ON STORAGE WORDS +STARTA: 0 ;STARTING ADDRESS FOR SBLK, RIM +DECBRK: 0 ;LARGEST RELOC. ADDR. LOADED INTO. (USED FOR DEC FMT) +ISAV: 0 ;I FROM FLD AT AGETFLD +CPGN": 0 ; 1 LESS THAN CURRENT PAGE # IN INPUT FILE +CLNN": 0 ; 1 LESS THAN CURRENT LINE # IN INPUT FILE +A.PASS: 0 ; .PASS INTSYM, # OF THIS PASS. +A.PPAS: 0 ;.PPASS INTSYM, # OF PASSES. +SYMSIZ: 0 ;#WDS IN SYMTAB = WPS* +SYMLEN: IFN MOBY,SYMMSZ ;# SYMS FIT IN SYM TAB + IFE MOBY,SYMDSZ ;(ASSEMBLED IN VALUE USED ONLY IF NON-TS) +SYMAOB: 0 ;-<# SYMS>,,0 +INICLB: 0 ;-1 IF INITIALIZATION CODE CLOBBERED. +TTYINS: 0 ;AT START OF ASSEMBLY, -1 => .INSRT TTY PASS1, -2 => PASS2 ALSO. + +PBLK + + ;INFO CONVENIENT TO ANYONE GENERATING AN OUT OF TIME-SHARING MIDAS + +;MIDAS OUT OF TIME-SHARING ASSEMBLES INTO A COLLECTION OF SUBROUTINES +;IO IS EXPECTED TO BE HANDLED BY OTHER PROGRAMS. + +;EXITS FROM THE ASSEMBLER: +;TPPB OUTPUT BINARY WORD IN A +;TFEED IF OUTPUT DEVICE IS PTP, PUNCH OUT # FRAMES OF BLANK TAPE + ;SPECIFIED BY B, MAY CLOBBER A AND B +;GO2 RETURN POINT FROM FATAL ERRORS +;TYO TYPE OUT CHARACTER IN A +;TAB TYPE OUT A TAB (MAY CLOBBER A OF COURSE) +;RCHTBL SEE THE RCH ROUTINES + +;ENTRIES + +;PDL, LPDL MAY BE USED BY COMMAND PROCESSOR BUT WILL BE CLOBBERED BY MAIN ROUTINES +;MAIN ROUTINES, CALLED WITH JSP A, , CLOBBER THE WHOLE WORLD (INCLUDING P) +;INIT INITIALIZE +;PS1 PASS 1 +;PLOD IF APPROPRIATE, PUNCH OUT LOADER +;PS2 PASS 2 (DOES ITS OWN PARTIAL INITIALIZATION) +;PSYMS PUNCH OUT SYMBOL TABLE + +;OTHER ENTRIES + +;CONTRL AFTER ASSEMBLY, .GE. 0 => RELOCATABLE, .LT. 0 => ABSOLUTE +;ISYMF -1 IF SYMS HAVE NOT BEEN SPREAD, ELSE DON'T TRY TO ADD TO INITIAL SYMBOL TABLE +;SMSRTF -1 IF SYMTAB HASN'T BEEN SORTED, ELSE SYMTAB CLOBBERED, DON'T RE-ASSEMBLE +;MIDVRS .FNAM2 OF MIDAS ENGLISH + +;SOME FF FLAGS ARE GLOBAL SO COMMAND PROCESSOR CAN KNOW WHAT'S HAPPENED ON RETURN + +;COMMAND PROCESSOR MAY ADD TO INITIAL SYMBOL TABLE BEFORE CALLING INIT THE FIRST TIME +;EISYMT IS THE FIRST LOCATION OK TO DUMP INTO +;EISYMP RH SHOULD BE SET BY COMMAND PROCESSOR TO FIRST LOC NOT DUMPED INTO +;INTSYM RH OF SYMTAB VALUE TO RETURN VALUE ADDRESSED BY LH(SYMTAB ENTRY) + +;RCH HAS AN ELABORATE SET OF GLOBALS, WHICH I DON'T FEEL LIKE PUTTING DOWN NOW, BUT THEY INCLUDE +;RCH (GET CHAR) SEMIC, RRL1, RREOF, SEMICR, SEMIC, TYPCTL, GDTAB, CPGN, CLNN, +;RCHMOD, MDSCLR, MDSSET, RCHSET, POPLMB, PSHLMB +;ALSO RCHTBL ONLY EXIT + +;LISTING FEATURE GLOBALS: +;PILPT PRINT CHAR IN A +;LISTON LISTING ON/OFF FLAG, -1 => ON +;LPTCLS END OF LISTING, PRINT FORM FEED, IF TS THEN CLOSE LPT + +;CREF FEATURE GLOBALS: +;CRFOUT OUTPUT WORD IN A. +;CREFP -1 => REQUEST GENERATION OF CREF OUTPUT. +;THE RUBOUT-B-^W HEADER, THE SET-SOURCE-FILE BLOCK, AND THE EOF BLOCK +;ARE THE RESPONSIBILITY OF THE COMMAND PROCESSOR. + +;;RCH ;CHARACTER INPUT ROUTINES + +IFN RCHASW\MACSW,[ + ;SAVE LIMBO1 STATUS AND RH(B) + ;THEN SET UP FOR NEW INPUT MODE (DESCRIPTOR IN A) + ;CALLED BY PUSHEM AND PUSHTT + +PSHLMB": HRL B,LIMBO1 ;LAST CHARACTER INPUT + TLZE I,UNRCHF ;RE-INPUT CHARACTER ON RETURN? +IFE LISTSW,TLO B,400000 ;YES +IFN LISTSW,[JRST LSTUN1 ;YES, LISTING STYLE +LSTUN2:] + EXCH A,RCHMOD ;GET OLD MODE IN A + DPB A,[360500,,B] ;STORE IN 5 OF HIGH 6 BITS IN B + PUSH F,B ;SAVE RESULTANT CRUD + CAMN A,RCHMOD ;COMPARE NEW WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + MOVE A,RCHMOD ;NOW GET NEW MODE + JRST PSHLM1 ;SET UP INSTRUCTIONS FOR NEW MODE + +IFN LISTSW,[ +LSTUN1: AOSN PNTSW + JRST LSTUN5 ;LAST WAS BREAK CHR + REPEAT 4,IBP PNTBP + SOSA PNTBP +LSTUN5: SETOM LISTBC + TLO B,400000 + JRST LSTUN2 +] + + ;UNDO A PSHLMB (NOTE: IN COMMENTS BELOW, "NEW" MODE IS ON PDL, OLD IN RCHMOD) + +POPLMB": POP F,A ;GET WORD THAT PSHLMB PUSHED + HLRZS A ;JUST INTERESTED IN LEFT HALF + TRZE A,400000 ;SIGN BIT SET? + TLOA I,UNRCHF ;YES, SET FLAG TO RE-INPUT LAST CHAR +IFE LISTSW,TLZ I,UNRCHF ;NO, CLEAR FLAG +IFN LISTSW,[TLZA I,UNRCHF ;SAME, LISTING STYLE... + IDPB A,PNTBP ;SET SWITCH, DEPOSIT CHAR INTO LISTING BUFFER +] + SETZM LIMBO1 ;INITIALIZE FOR DPB + DPB A,[700,,LIMBO1] ;RESTORE LIMBO1 + LSH A,-<18.-6> ;RIGHT JUSTIFY RCHMOD DESCRIPTOR + CAMN A,RCHMOD ;COMPARE NEW MODE WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + JRST RCHSET ;SET UP FOR NEW MODE AND RETURN +] + + +FOO==0 ;INITIALIZE COUNTER FOR FOLLOWING + +DEFINE RCHBLT SIZE,ADR/ + MOVSI T,FOO(A) + HRRI T,ADR + BLT T,-1+ADR +FOO==FOO+ +TERMIN + +DEFINE RCHMOV ADR/ + MOVE T,FOO(A) + MOVEM T,ADR +FOO==FOO+1 +TERMIN + + ;SET UP FOR INPUT OF MODE TYPE SPECIFIED IN A, CLOBBER A ONLY + +RCHSET": MOVEM A,RCHMOD ;STORE NEW RCHMOD +PSHLM1: TLZ FF,MACRCH\TTYRCH ;CLEAR FLAGS (MAYBE DEVICE ROUTINE SETS ONE) + XCT RCHTBL"(A) ;GET IN A A POINTER TO A DESCRIPTOR TABLE (MAYBE ALSO SET FLAG) + PUSH P,T ;SAVE T, NEED IT FOR TEMP + RCHBLT 3,GETCHR ;FIRST 3 WORDS GETCHR + TLNE FF,VOT + JRST POPTJ ;ALL RCH'S TO GO THROUGH RCH, DON'T DO ANYTHING ELSE +MDSST1: RCHBLT 3,RR1 ;NEXT 3 RR1 + RCHMOV RRL1 ;NEXT WORD RRL1 +RCHPSN==FOO ;# WORDS IN ALL TABLES BUT LAST (NOT OF CONSTANT LENGTH) + RCHBLT 6,SEMIC ;LAST N SEMIC +POPTJ: POP P,T + POPJ P, + + ;SET UP TO "DISPLAY" (ALL RCH'S THROUGH RCH) + +MDSSET": TLO FF,VOT ;SET FLAG + MOVEI A,MDSSTB-3 ;SET UP AC + PUSH P,T ;SAVE T FOR RESTORATION + JRST MDSST1 ;NOW SET UP + +MDSSTB: JRST RRL1 ;RR1 + HALT + PUSHJ P,RCH ;RREOF + + PUSHJ P,RCH ;RRL1 +IFN .--RCHPSN,[PRINTC /LOSSAGE AT MDSSTB. +/] + PUSHJ P,RCH ;SEMIC + CAIE A,15 + JRST SEMIC + JRST SEMICR + + ;CLEAR OUT DISPLAY MODE + +MDSCLR": TLZ FF,VOT ;CLEAR FLAG + MOVE A,RCHMOD + JRST RCHSET ;NOW SET UP FOR REAL IN CURRENT MODE + +IFN TS,[ ;TABLE FOR RCHSET, INDEXED BY MODE + ;MAYBE THIS CONDITIONAL WANTS TO BE CHANGED TO SOMETHING ELSE + +RCHTBL: MOVEI A,RCHFIL ;0 => INPUT FROM FILE +IFN MACSW,PUSHJ P,RCHMAC ;1 => INPUT FROM MACRO (DO NOT CHANGE, USED BY MACRO PROCESSOR) +IFN RCHASW,[IFE MACSW,HALT + PUSHJ P,RCHTRC ;2 => TTY, QUIT ON CR + PUSHJ P,RCHARC ;3 => TTY, DON'T QUIT ON CR +] + ;TABLE FOR INPUTTING FROM FILE + ;MAYBE THIS CONDITIONAL ALSO WANTS TO BE CHANGED + +RCHFIL: ILDB A,UREDP" ;GETCHR, GET CHARACTER + CAIG A,14 ;SKIP IF TOO BIG TO BE SPECIAL + XCT RPATAB(A) ;SPECIAL, DO THE APPROPRIATE THING + + JRST RRL1 ;RR1 + HALT + PUSHJ P,INCHR3" ;RREOF + + ILDB A,UREDP ;RRL1 +IFN .-RCHPSN-RCHFIL,[PRINTC /RCHFIL LOSES. +/] + ILDB A,UREDP ;SEMIC, GET CHARACTER + CAIG A,15 ;SKIP IF TOO BIG TO BE SPECIAL (CR ALSO SPECIAL HERE) + XCT RPATAB(A) ;MAYBE SPECIAL, DO THE APPROPRIATE THING + JRST SEMIC ;NOT CR, LOOP BACK FOR NEXT CHAR + + ;TABLE FOR ABOVE, EXECUTED INDEXED BY CHAR, 15 ONLY FROM SEMIC ELSE ANYTHING + +RPATAB": JFCL ;0 + JFCL + JFCL +IFN .-RPATAB-EOFCH,[PRINTC /EOFCH DOESN'T AGREE WITH ENTRY IN RPATAB. +/] + PUSHJ P,INCHR3" ;3, EOFCH + REPEAT 6,JFCL + AOS CLNN ;LINE FEED + JFCL ;13 + PUSHJ P,RPAFF ;FORM FEED + JRST SEMICR ;FROM SEMIC ONLY, EXIT FROM LOOP + +RPAFF: AOS CPGN ;FORM FEED + SETZM CLNN + POPJ P, +] + +VBLK +LIMBO1: 0 ;LAST CHARACTER READ BY RCH +RCHMOD": 0 ;CURRENT INPUT MODE, 0 => INPUT FROM FILE, 1 => MACRO, ETC. + + ;READ CHARACTER INTO A FROM INPUT FILE, MACRO, OR WHATEVER (RCH) + +RCH": TLZE I,UNRCHF + JRST RCH1 ;RE-INPUT LAST ONE MAYBE GET HERE FROM GETCHR+2 +GETCHR: HALT ;ILDB A,UREDP" ;ILDB A,CPTR ;GET CHAR + 0 ;CAIG A,14 ;TRZE A,200 ;CHECK FOR SPECIAL + 0 ;XCT RPATAB(A) ;PUSHJ P,MACTRM ;SPECIAL, PROCESS + MOVEM A,LIMBO1 ;GOT CHAR, SAVE AS LAST CHAR GOTTEN +IFN LISTSW,[ + AOSN PNTSW + PUSHJ P,PNTR + CAIG A,15 + JRST RCHL1 +RCHL3: IDPB A,PNTBP +] +TYPCTL": POPJ P, ;OR JRST SOMEWHERE +PBLK + +IFN LISTSW,[ +RCHL1: CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + JRST RCHL3 +RCHL2: MOVEM A,LISTBC + SETOM PNTSW + JRST TYPCTL +] + +RCH1: MOVE A,LIMBO1 +IFN LISTSW,CAILE A,15 + POPJ P, +IFN LISTSW,[CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + POPJ P, + JRST RCHL2 +] + +;;GETSYL ;VARIOUS SYLLABLE READING ROUTINES (BUT NOT ALL OF THEM) + +GSYL: CLEARB SYM,STRCNT +GSYL1: MOVEI D,6 + MOVE T,[440700,,STRSTO] + MOVEM T,STRPNT +GSYL3: AOSG A,STRCNT + JRST (F) + PUSHJ P,RCH + IDPB A,STRPNT ;STORE CHAR IN STRING EVEN IF DELIMITER (MINIMUM STRCNT = 1) +A.GSY2: CAIN A,". + JRST GSYL1C + HLRZ CH1,GDTAB(A) + CAIN CH1,(JSP CH2,) + JRST GSYL1A ;NUMBER + PUSHJ P,GSYL1B ;RETURN ONLY ON SYL SEP + HRRZ A,GDTAB(A) + MOVE T,LIMBO1 +C%: POPJ P,"% + +GSYL1B: XCT GDTAB(A) ;POPJ FOR SYL SEPS + SUB P,[1,,1] +GSYL1D: SOJGE D,GSYL3 + AOJA D,GSYL3 + +GSYL1C: ADD SYM,%.SQ(D) + JRST GSYL1D + +GSYL1A: XCT NSQTB-60(A) + JRST GSYL1D + + ;VERSION OF GETSYL TO TRY UNTIL SYL OR WORD TERMINATOR FOUND + ;SKIPS IF NAME THERE (FOR .TYPE, SQUOZE) + +GTSLD2: TLNN C,DWRD\DFLD + JRST GTSLD3 ;DELIMITER IS WORD TERMINATOR, TOLERATE THE NULL SYLLABLE +GETSLD: PUSHJ P,GETSYL ;ENTRY, GET A SYL + MOVE C,CDISP ;GET CDISP + TRNN I,SYL + JRST GTSLD2 ;NO SYL + AOS (P) ;GOT SYL, CAUSE RETURN TO SKIP +GTSLD3: TLNN C,DWRD\DFLD + TLO I,UNRCHF ;CAUSE DELIMITER TO BE RE-INPUT + POPJ P, + +GETSYL: TLZ I,UARI+NPRC +GTSL1: CLEARB SYM,NUMTAB ;RECUR HERE FOR RIGHT ARG TO ^ AND _. + MOVE AA,[NUMTAB,,NUMTAB+1] + AOSN NTCLF + BLT AA,NUMTAB+10 ;NUMTAB NOT CLEAR, HAVE TO CLEAR IT + MOVEI D,6 ;CHARACTER COUNTER FOR BUILDING UP SYM + SETOM ESBK ;NO SPECIFIC BLOCK DESIRED. + TDZ I,[DECP+FLO+VAR+GLI+LSRET,,PERI+LET+SYL] +RRL2: PUSHJ P,RR ;CALL MAIN LOOP ROUTINE, READ UNTIL NON-SQUOZE CHAR +SEMICR": ;RETURN HERE FROM SEMIC WITH CR IN A + MOVEM A,LIMBO1 ;SYLLABLE OPERATOR OR TERMINATOR IN A, SAVE + HRRZ A,GDTAB(A) ;NOW GET RIGHT HALF OF POPJ, INDEX INTO DTB + MOVE C,DTB-40(A) ;GET DTB ENTRY (FLAGS,,JUMP ADR) + MOVEM C,CDISP ;STORE AS DISPATCH CODE FOR LAST CHAR (SORT OF AN INTERPRETED LIMBO1) +RR8: TLNE C,DSYL ;NOW SEE IF SYL OPERATOR FLAG SET + JRST (C) ;SET => INTRA-SYLLABLE OPERATOR +RR10: TRNN I,SYL ;NOT SET => SYLLABLE TERMINATOR: SYL? + JRST CABPOP ;NO SYL + TRNE I,LET + POPJ P, ;SYL HAS LETTERS + CAMN SYM,[SQUOZE 0,.] + JRST PT1 ;SYM IS . + ;NUMBER + +RR5: TLNN I,NPRC + PUSHJ P,NUMSL + TLNN I,FLO + JRST RR9 ;NOT FLOATING POINT + MOVE A,B ;FLOATING, HIGH IN AA,LOW IN A,EXP IN B + ADDI A,306 ;201+105 TO ROUND + ADDI AA,200 ;CAUSE EXPONENT TO BE ACCEPTABLE TO MACHINE + JUMPGE AA,.+3 ;NOW CHECK FOR OVERFLOW ON ROUNDING + LSH AA,-1 ;OVERFLOW, SHIFT BACK ONE + AOS A ;INCREMENT EXPONENT TO COMPENSATE FOR SHIFT + EXCH A,AA ;GET EXPONENT IN AA, REST IN A + ASHC AA,-10 ;SHIFT TO MACHINE FLOATING POINT FORMAT + SKIPE AA ;NOW CHECK HIGH ORDER BITS OF EXPONENT NOT SHIFTED INTO NUMBER + ERR 'EPO ;EXPONENT OVERFLOW +RR9: TLZ I,GLI+VAR ;NOT TRYING TO DEFINE NUMBER AS VARIABLE OR GLOBAL +CLBPOP: TDZA B,B ;CLEAR OUT B (RELOCATION BITS OF VALUE) +CABPOP: SETZB A,B ;DO JRST CABPOP TO RETURN ZERO AS VALUE + POPJ P, + +RRU: MOVE A,LIMBO1 ;GET HERE WHEN UNRCHF SET AT RR, RETRIEVE CHARACTER FROM LIMBO1 + CAIG A,14 ;IF TOO BIG, + CAIGE A,12 ;OR IF TOO SMALL, + JRST RR1B ;THEN JUST FALL BACK IN + TLNN FF,VOT\MACRCH\TTYRCH ;SKIP IF NOT HACKING CPGN/CLNN + XCT RRUTAB-12(A) ;HACKING, UNHACK FOR HACK COMING UP + JRST RR1B ;FALL BACK IN + +RRUTAB: SOS CLNN ;LINE FEED (TABLE FOR RRU) + JRST RR1B ;13 + SOS CPGN ;FORM FEED + + ;MAIN LOOP ROUTINE FOR GETSYL, READ SYM OR NUMBER +VBLK +RR: TLZE I,UNRCHF ;RE-INPUT LAST CHARACTER? + JRST RRU ;YES (SOMETIMES RETURN HERE FROM RREOF) +RR1: JRST RRL1 ;ILDB A,CPTR ;GET CHAR (" " ") + HALT ;TRZE A,200 ;CHECK FOR END OF STRING +RREOF": PUSHJ P,RCH ;PUSHJ P,MACTRM ;PROCESS CONDITION, GET NEXT CHAR OR JRST RR1 OR RR1-1 +RR1B: XCT GDTAB(A) ;GOT CHAR, DO SOMETHING APPROPRIATE (POPJ ON NOT SQUOZE) + TROA I,LET\SYL ;LETTERS RETURN, JUST UPDATED SYM, SET FLAGS + TRO I,SYL ;NUMBERS RETURN, SET FEWER FLAGS + SOJGE D,RR1 ;DECREMENT SYM COUNTER AND LOOP + AOJA D,RR1 ;COUNTER EXHAUSTED, INCREMENT BACK TO 0 AND LOOP + +RRL1": PUSHJ P,RCH ;ILDB A,UREDP" ;GET CHAR + XCT GDTAB(A) ;NOW MAKE LIKE RR1B (EOFCH => JRST RREOF) + TROA I,LET\SYL + TRO I,SYL + SOJGE D,RRL1 + AOJA D,RRL1 + + ;SEMICOLON (GET HERE FROM RR8) + + JRST SEMICL ;RETURN HERE FROM SEMIC+2 WHEN UNRCHF SET +SEMIC": PUSHJ P,RCH ;ILDB A,UREDP ;GET CHAR + CAIE A,15 ;CAIG A,15 ;SEE IF SPECIAL + JRST SEMIC ;XCT RPATAB(A) ;SPECIAL => DO SOMETHING (JRST SEMICR ON CR) + JRST SEMICR ;JRST SEMIC ;IF NOT SPECIAL THEN GO BACK FOR NEXT CHAR + +LOC SEMIC+6 ;LEAVE A LITTLE EXTRA ROOM FOR BIG ROUTINES +PBLK + +SEMICL: MOVE A,LIMBO1 ;HERE FROM SEMIC-1, RETRIEVE CHARACTER FROM LIMBO1 + CAIE A,15 ;SKIP IF SHOULD TERMINATE SCAN + JRST SEMIC ;NOT CR, FALL BACK IN + JRST SEMICR ;DONE + + ;JSP CH2,RR2 => DIGIT (FROM GDTAB) + ;THIS ROUTINE IS GROSSLY SLOW, AND SHOULD BE SPEEDED UP SOMETIME + +RR2: TRNE I,LET + JRST RR2A ;NAME + TRZE I,PERI + TLO I,FLO ;FLOATING POINT + PUSHJ P,MAKNUM ;UPDATE NUMTABS +RR2A: XCT NSQTB-"0(A) ;UPDATE SYM + JRST 1(CH2) ;SKIP-RETURN + +MAKNUM: SETOM NTCLF ;NUMTAB ABOUT TO NOT BE CLEAR, SET FLAG FOR GETSYL TO CLEAR IT OUT NEXT TIME + MOVEI AA,2 ;INDEX INTO NUMTAB ETC., SOJGE'D TO GET ALL RADICES +MAKNM1: MOVE T,ARADIX(AA) ;GET THIS RADIX, + CAMN T,ARADIX ;REDUNDANT => SKIP THIS PASS. + JUMPN AA,MAKNM4 + SKIPGE CH1,HIGHPT(AA) + JRST MAKNM3 + MUL T,LOWPT(AA) ;TT HAS OLD LOW TIMES RADIX, T HAS OVFLO TO HIGH. + ADDI TT,-"0(A) ;ADD DIGIT TO LOW PART + TLZE TT,400000 + AOJ T, ;OVERFLOW, INCREMENT SPILLOVER FROM MUL OF LOWPT + JUMPE CH1,MAKNM5 ;OLG HIGHPT WAS 0 => SAVE TIME. + JFCL 17,.+1 ;NOW CLEAR OV, ETC. + IMUL CH1,ARADIX(AA) ;MULTIPLY HIGHPT BY RADIX + ADD T,CH1 ;ADD HIGH PARTS + JFCL 10,MAKNM2 ;JUMP ON OVERFLOW FROM IMUL OR ADD +MAKNM5: TLNE I,FLO + SOS NUMTAB(AA) ;FLOATING, DECREMENT EXP TO COMPENSATE FOR MULT OF HIGHPT/LOWPT + MOVEM T,HIGHPT(AA) ;NOW STORE STUFF BACK + MOVEM TT,LOWPT(AA) +MAKNM4: SOJGE AA,MAKNM1 ;NOW DO ALL THIS FOR NEXT RADIX + POPJ P, + +MAKNM2: MOVSI B,400000 ;OVERFLOW FROM UPDATING HIGH PARTS + IORM B,HIGHPT(AA) ;SET SIGN BIT +MAKNM3: TLNN I,FLO + AOS NUMTAB(AA) ;NOT FLOATING, INCREMENT EXP, MAY NOT WANT TRAILING BITS + JRST MAKNM4 + +VBLK +NUMTAB: 0 ;EXPONENT + 0 + 0 +HIGHPT: 0 ;HIGH PART OF CURRENT NUMBER THIS RADIX + 0 ;4.9 => OVERFLOW, TRAILING DIGITS DROPPED + 0 +LOWPT: 0 ;LOW PART OF CURRENT NUMBER THIS RADIX + 0 ;HIGHPT/LOWPT TAKEN AS 70. BIT POSITIVE INTEGER EXCEPT 4.9(HIGHPT) IS FLAG INSTEAD OF + 0 ;EXPONENTIATE 70. BIT INTEGER BY NUMTAB (WHICH MAY BE NEGATIVE) TO GET ACTUAL VALUE +ARADIX: 10 ;CURRENT RADIX + 12 + 10 + +NTCLF: -1 ;-1 => NUMTAB NOT CLEAR (TO SAVE BLT AT GETSYL WHEN CLEAR) +PBLK + + ;JRST POINT => . (FROM GDTAB) + +POINT: TLO I,DECP ;PREFER DECIMAL + TROE I,PERI ;SET PERIOD FLAG + TRO I,LET ;2 POINTS => NAME + ADD SYM,%.SQ(D) ;UPDATE SYM + JRST 1(CH1) ;RETURN + +RBRAK: SOSL SCNDEP ;IF A CONDITIONAL TO TERMINATE, + JRST RRL2 ;HAVE DONE SO, IGNORE CHAR. + SETZM SCNDEP + SKIPN CONDEP ;IF A CONSTANT TO TERMINATE, + JRST RBRAK1 + AOS CONEND ;SET FLAG TO END CONSTANT AT ASSEM1, + SETZM CDISP + JRST RR10 ;AND GO TERMINATE WORD. + +RBRAK1: SKIPE CONSML ;STRAY BRACKET ERROR UNLESS OLD MODE. + ERR (SIXBIT/NO[/) ;] + JRST RRL2 + +FORMF: TLNE FF,VOT\MACRCH\TTYRCH ;FORM FEED SYLLABLE OPERATOR ROUTINE + JRST RR10 ;CHARACTER CAME FROM RCH, THIS PROBLEM ALREADY TAKEN CARE OF + SETZM CLNN ;CLEAR OUT LINE NUMBER + AOS CPGN ;INCREMENT CURRENT PAGE NUMBER + JRST RR10 + +LINEF: TLNE FF,VOT\MACRCH\TTYRCH ;LINE FEED SYLLABLE OPERATOR ROUTINE + JRST RR10 + AOS CLNN ;INCREMENT CURRENT LINE NUMBER + JRST RR10 + +ATSGN: MOVSI A,20 ;ATSIGN + IORM A,WRD + TRO I,FLD ;SET FLD FLAG EVEN THOUGH NOT DIRECTLY RETURNING VALUE + ; ^ CHANGED FROM SYL TO FLD 9/6/70 + JRST RRL2 ;FALL BACK IN + + ;DECIPHER A VALUE FROM NUMTABS + ;LEAVES HIGH PART IN AA, LOW PART IN A, BINARY EXPONENT IN B + +NUMSL: CLEARB TT,D ;TT BIT EXPONENT, D INDEX INTO NUMTAB, ETC. + TLNE I,DECP+VAR ;NEITHER . NOR ', CURRENT RADIX. + TLNE I,GLI ;" => CURRENT RADIX DESPITE . OR '. + JRST NUMSL0 + MOVEI D,1 ;DECIMAL UNLESS ' + TLNE I,VAR ;WHICH FORCES OCTAL. + MOVEI D,2 + MOVE A,ARADIX(D) + CAMN A,ARADIX ;IF REALLY SAME AS CURRENT RADIX, + MOVEI D,0 ;COMPUTATION WASN'T DONE FOR THIS VALUE OF D, + ;SO USE COMPUTATIONS DONE FOR CURRENT RADIX. +NUMSL0: MOVE AA,HIGHPT(D) ;AA := HIGH PART + MOVE B,LOWPT(D) ;B := LOW PART + MOVE T,NUMTAB(D) ;T := EXPONENT + MOVE D,ARADIX(D) ;NO LONGER NEED IDX, GET RADIX VALUE. + TLNN I,FLO + JRST FIX ;NOT FLOATING + TLZ AA,400000 ;FLOATING, DON'T NEED DIGITS LOST ON OVERFLOW +NUMC1: JUMPN AA,.+2 ;ENTRY FROM UPARR + JUMPE B,FIX0 ;COMPLETELY ZERO => RETURN FIXED ZERO + JUMPL T,NUMSL1 ;JUMP IF EXPONENT NEGATIVE + JUMPE T,NUMSL2 ;JUMP (SKIP FOLLOWING) IF EXPONENT ZERO + ;EXPONENT POSITIVE, DO THE APPROPRIATE THING +NUMSL5: MULI B,(D) ;MULITIPLY LOW PART BY RADIX + MUL AA,(D) ;MULTIPLY HIGH PART BY RADIX + ADD A,B ;A := LOW PART OF HIGH + HIGH PART OF LOW + TLZE A,400000 + ADDI AA,1 ;OVERFLOW ON ADDITION, INCREMENT HIGH PART OF HIGH + MOVE B,C ;NO LONGER NEED HIGH OF LOW, GET LOW OF LOW IN B +NUMSL3: JUMPE AA,NUMSL4 ;NOW CHECK FOR OVERFLOW INTO HIGH OF HIGH, JUMP ON NONE + ASHC A,-1 ;NEXT THREE INSTRUCTIONS TO DO ASH3 AA,-1 + ASH A,1 + ASHC AA,-1 + AOJA TT,NUMSL3 ;INCREMENT BIT EXPONENT AND TRY AGAIN + +NUMSL4: MOVE AA,A ;FLUSHED OVERFLOW, NOW GET (LOW PART OF) HIGH PART IN AA + SOJG T,NUMSL5 ;COUNT DOWN + +NUMSL2: TLNN I,FLO + JRST NUMSL9 ;NOT FLOATING, DON'T WASTE TIME NORMALIZING. + SKIPA A,B ;EXPONENT NOW ZERO, GET LOW PART OF NUMBER IN A +NUMSL7: ASHC AA,1 ;NOW NORMALIZE + TLNN AA,200000 + SOJA TT,NUMSL7 + SKIPA B,TT ;DONE NORMALIZING, RETURN BINARY EXPONENT IN B +PT1: TRO I,LET + POPJ P, + +NUMSL9: MOVE A,B + MOVEI B,0 + ASHC AA,(TT) ;SHIFT 2-WD NUM. BY EXPONENT, + LSH A,1 ;PUT HIGH BIT IN WITH REST. + JRST FIX1 + +FIX0: TLZ I,FLO +FIX: LSHC A,45 +FIX1: LSHC AA,-1 + JUMPE AA,.+2 + ERR 'XSG ;SIG CHECK + POPJ P, + +NUMSL1: SKIPA A,B ;EXPONENT NEGATIVE: NORMALIZE NOW +NUMSL8: ASHC AA,1 +NUMSL6: TLNN AA,200000 + SOJA TT,NUMSL8 ;NOT NORMALIZED YET + MOVE B,A ;GET NORMALIZED LOW PART IN B + IDIVI AA,(D) ;DIVIDE HIGH PART BY APPROPRIATE RADIX + ADD B,A + MOVEI A,0 ;NOW TURN A/B INTO DOUBLE PRECISION POSITIVE VERSION OF C(B) + TLZE B,400000 + MOVEI A,1 + DIVI A,(D) + AOJL T,NUMSL6 + JRST NUMSL2 + +UPARR: TRON I,SYL + JRST UPCTRC ;"UNARY UPARROW" => GOBBLE CHARS + TRNE I,LET + ERR 'ILF ;LETTERS IN LEFT OPERAND TO UPARROW + PUSHJ P,NUMSL ;DECIPHER NUMTABS + TLO I,UARI ;SET INDICATOR (USED BY BACKARROW) + PUSHJ P,UA3 ;GET RIGHT OPERAND IN T + TLZ I,UARI + MOVE TT,B ;EXPONENT + MOVE B,A ;LOW PART + PUSHJ P,NUMC1 ;T EXP HIGH IN AA LOW IN B TT BIN EXP + MOVE C,CDISP + TLO I,NPRC + JRST RR8 + +UPCTRC: JSP F,QOTCOM ;UP ARROW TO GOBBLE SYL AND RETURN MASKED ASCII VALUE + LSH A,6 ;SHIFT ACCUMULATED VALUE OVER 6 (NOT ENTIRELY CLEAR IT SHOULD BE 6, BUT...) + ANDI T,77 ;NOW MASK CHARACTER IN TO TO BOTTOM 6 BITS + ADD A,T ;ADD TO ACCUMULATED + POPJ P, + +BAK1: MOVE TT,[DFLD,,CBAKAR] + MOVEM TT,CDISP + JRST RR10 + +BAKAR: TLNE I,UARI + JRST RR5 ;RETURN TO UPARROW (WILL COME BACK HERE LATER) + TRNE I,SYL + TRNE I,LET + JRST BAK1 ;NO SYL, OR SYL IS NAME + CAMN SYM,[SQUOZE 0,.] + JRST BAK1 ;. ALSO NAME + TLZN I,NPRC + PUSHJ P,NUMSL + PUSHJ P,UA3 + ADD B,T + ASHC AA,(B) + LSH A,1 + LSHC AA,-1 + CLEARB B,AA + TLZ I,FLO + POPJ P, + +UA3: HRLM D,(P) ;SAVE RADIX (FOR UPARR) + JSP LINK,SGTSY ;PUSH I,AA,A,B + PUSHJ P,RCH + CAIN A,"- + TROA I,GMINF + TLO I,UNRCHF + PUSHJ P,RCH + CAIN A,"< + JRST UAR1 + TLO I,UNRCHF +UA3L: PUSHJ P,GTSL1 ;GOBBLE SYL, LOOP POINT FOR PSEUDO OR MACRO RETURNED WITHOUT VALUE + TRNE I,LET + JRST UA3S ;NAME + TLNE I,FLO + ERR 'ILF ;RIGHT OPERAND IS FLOATING POINT +UAR2: TRZN I,GMINF + SKIPA T,A + MOVN T,A + MOVEI TT,SGTSY1 + JSP LINK,POPLIS + HLRZ D,(P) + POPJ P, + +UA3S: PUSHJ P,GETVAL ;MAKE NUMBER_NAME WORK + JRST UA3SR ;GOT VALUE, PROCESS + JRST UA3L ;NO VALUE, TRY AGAIN + +UAR1: TLO I,LSRET + PUSHJ P,LSSTH + PUSH P,A + PUSHJ P,RCH + CAIN A,"! + JRST .-2 + HLRZ T,GDTAB(A) + CAIE T,(POPJ P,) + ERR 'NOS ;> NOT FOLLOWED BY BREAK CHAR + HRRZ A,GDTAB(A) + MOVE A,DTB-40(A) + MOVEM A,CDISP + POP P,A +UA3SR: JUMPN B,RLCERR ;RELOC ERR + JRST UAR2 + +DQUOTE: TRON I,SYL + JRST DQUOT8 + TRNN I,LET ;AFTER NUMBER => CURRENT RADIX. + JRST DQUOT7 + PUSHJ P,RCH + TLO I,UNRCHF ;NEXT CHAR. SQUOZE? + HLRZ A,GDTAB(A) + CAIN A,(POPJ P,) + JRST DQUOT7 ;NO => MAKE PREV. SYM. GLOBAL. + CAMN SYM,[SQUOZE 0,.M] ;SPECIAL BLOCK NAMES + JRST DQUOTM ;.M MEANS MAIN BLOCK, + CAMN SYM,[SQUOZE 0,.U] + JRST DQUOTU ;.U MEANS SUPERIOR. + SKIPGE A,ESBK ;GET SPEC'D BLOCK OR CURRENT, + HRR A,BKCUR ;LOOK FOR SUBBLOCK OF THAT BLOCK. + HLL A,BKTAB+1(A) + ADD A,[1,,] ;LH HAS LEVEL SUBBLOCK OUGHT TO HAVE. + MOVEI T,0 + SETO D, ;NO POSSIBLE ALTERNATE CHOICE YET. +DQUOT0: CAME SYM,BKTAB(T) ;LOOK AT ALL BLOCKS SEEN. + JRST DQUOT1 ;HAS THE NAME WE'RE LOOKING FOR? + CAMN A,BKTAB+1(T) + JRST DQUOT2 ;HAS THE RIGHT SUPPRO, TOO, MUST BE THE ONE. + SKIPN BKTAB+2(T) ;ELSE THIS IS ALTERNATE CHOICE + JUMPGE D,DQUOT1 ;(BUT PREFER DEFINED TO UNDEF) + HRROI D,(T) ;LEAVE SIGN OF D SET + SKIPE BKTAB+2(T) + ANDI D,-1 ;UNLESS THE ALTERNATE IS DEFINED. +DQUOT1: ADDI T,BKWPB + CAMGE T,BKTABP + JRST DQUOT0 + HRRZI T,(D) ;HAVEN'T FOUND BEST POSSIBLE BLOCK. + SKIPGE ESBK ;IF SUPPRO WASN'T SPEC'D + CAIN T,-1 ;USE THE ALTERNATE CHOICE IF ANY. + CAIA + JRST DQUOT2 + MOVE T,BKTABP ;NOT FOUND, GET IDX OF 1ST UNUSED ENTRY. + CAIL T,BKTABS + ERF 'TMB ;NO ROOM FOR MORE BLOCKS. + MOVEM SYM,BKTAB(T) + MOVEM A,BKTAB+1(T) ;ADD BLOCK AT END. + MOVEI A,BKWPB(T) + MOVEM A,BKTABP ;POINTS AFTER LAST USED ENTRY. +DQUOT2: MOVEM T,ESBK + SETZ SYM, +DQUOT3: MOVEI D,6 ;NEXT CHAR GOES IN 1ST SQUOZE POS. + JRST RRL2 + +DQUOTM: SETZB SYM,ESBK ;BLOCK .M SPEC'D - SET TO OUTERMOST BLOCK. + JRST DQUOT3 + +DQUOTU: SKIPGE T,ESBK ;.U SPEC'D - GET SPEC'D OR CURRENT BLOCK, + MOVE T,BKCUR + HRRZ T,BKTAB+1(T) + JRST DQUOT2 ;SPEC. ITS SUPERIOR. + +SQUOT1: TLOA I,VAR +DQUOT7: TLO I,GLI + MOVE A,BKCUR ;IF NO SPEC'D BLOCK, + SKIPGE ESBK + MOVEM A,ESBK ;SPEC. CURRENT BLOCK. + JRST RRL2 + +DQUOT8: JSP F,QOTCOM ;DOUBLE QUOTE TO GOBBLE SYL AND RETURN ASCII VALUE + LSH A,7 ;SHIFT ACCUMULATED VALUE OVER 7 + ADD A,T ;ADD IN ASCII CHARACTER IN T + POPJ P, ;RETURN TO SOMETHING + +SQUOTE: TROE I,SYL + JRST SQUOT1 + JSP F,QOTCOM ;SIXBIT SYL + CAIGE T,40 + ERR 'N6B ;NOT SIXBIT + CAIL T,140 + SUBI T,40 ;CONVERT TO UPPER CASE + LSH A,6 ;SHIFT OVER ACCUMULATED VALUE + ADDI A,-40(T) ;ADD IN SIXBIT FOR CHARACTER IN T + POPJ P, + + ;COMMON ROUTINE FOR RIGHT JUSTIFIED TEXT SYLS + ;CALLED WITH JSP F,; ROUTINE PUSHJ'S BACK W/ CHAR IN T, ACCUM VALUE IN A + ;SYL FLAG EXPECTED TO BE ALREADY SET + +QOTCOM: PUSHJ P,RCH ;GET FIRST CHARACTER + PUSH P,A ;SAVE IT, WILL USE IT NO MATTER WHAT IT IS + PUSHJ P,GSYL ;NOW GET NAME + MOVE B,STRCNT ;GET STRING COUNT, ONE MORE THAN # NON-BREAK CHARS READ BY GSYL + TLO I,UNRCHF ;SET FLAG TO RE-INPUT DELIMITING CHARACTER + POP P,T ;NOW GET BACK THAT FIRST CHARACTER + MOVE D,[440700,,STRSTO] ;SET UP BYTE POINTER TO STRING STORAGE + TDZA A,A ;CLEAR OUT ACCUMULATED VALUE AND FALL IN +QOTCM2: ILDB T,D ;GET CHAR FROM STRING + PUSHJ P,(F) ;PROCESS CHAR + SOJG B,QOTCM2 ;DO IT THE APPROPRIATE NUMBER OF TIMES + MOVE T,A + JRST TEXT5 + +VALRET: MOVE T,A ;ROUTINE TO RETURN VALUE IN A AFTER LAST CHAR GOBBLED BY GETSYL + MOVE B,CDISP ;GET STORED DISPATCH CODE + TLNN B,DWRD\DFLD + JRST VALR1 ;WORD TERMINATOR +TEXT5: PUSH P,T ;ENTRY FROM TEXT ROUTINES (NLAST CHAR NOT GOBBLED BY GETSYL) TO RETURN VALUE IN T + PUSHJ P,GETSYL ;SEE IF IMMEDIATELY FOLLOWED BY SYL + TRNE I,SYL + ERR 'NOS ;NO SEPARATOR BETWEEN TWO VALUES + POP P,A ;RESTORE VALUE TO RETURN +VALR1: TRO I,SYL + JRST CLBPOP + + ;VARIOUS PUSH AND POP ROUTINES, ALL CALLED W/ JSP LINK, + +SGTSY: PUSH P,I + PUSH P,AA + PUSH P,A + PUSH P,B + PUSHJ P,(LINK) +SGTSY1==. + +SAVWD1: PUSH P,A ;SYLL. BEFORE GROUPING NOW STARTING. + PUSH P,B ;AND ITS RELOC. + +SAVWLD: PUSH P,FORMAT + PUSH P,FORPNR + PUSH P,FLDCNT + PUSH P,GLSP2 + PUSH P,I + PUSH P,WRD + PUSH P,WRDRLC + PUSH P,SYM + PUSHJ P,(LINK) +SAVL1==. + + ;(ALMOST) GENERALIZED POP ROUTINE + +POPLIS: POP P,F ;FIRST ENTRY ON PDL PC STORED BY PUSHJ AT END OF PUSH ROUTINE + CAIE TT,(F) ;TT SHOULD BE INDEPENDENTLY SET UP BY CALLING ROUTINE W/ SAME VALUE + HALT ;ROUTINE VERIFIES THIS AND KILLS ASSEMBLY IF DISAGREE + +POPLS1: HLRZ F,-2(TT) ;NOW FOR THE ACTUAL POPPING: GET NEXT PREV. INSTRUCTION IN PUSH ROUTINE + CAIE F,(PUSH P,) ;IF NOT PUSH + JRST (LINK) ;THEN DONE, RETURN + POP P,@-2(TT) ;PUSH, POP OFF WORD PUSHED + SOJA TT,POPLS1 + + ;POP OFF WHAT PUSHED BY SAVWLD (FOR WHICH POPLIS DOESN'T WORK) + +USVWLD: POP P,SYM + HRRZS SYM + CAIE SYM,SAVL1 + HALT + POP P,SYM + POP P,WRDRLC + POP P,WRD + TDZ I,[-1-(WRDF)] + IOR I,(P) + POP P,1(P) + POP P,GLSP2 + POP P,FLDCNT + POP P,FORPNR + POP P,FORMAT + JRST (LINK) + +;;GETFD ;GET FIELD (EXPRESSION); RETURN VALUE IN A, RELOC BITS IN B + + ;GET FIELD FOR PSEUDO + ;FOLLOW PUSHJ WITH INSTR EXECUTED IF SYM NOT FOUND + +AGETFD: MOVE CH1,@(P) ;GET ERROR INSTRUCTION + MOVEM CH1,GTVER ;STORE APPROPRIATELY + PUSH P,I ;SAVE I + TRO I,PSEUDF ;SET FLAG TO GETVAL TO EXTCUTE GTVER ON UNDEFINED SYM ON EITHER PASS + PUSH P,WRD + SETZM WRD +AGTFD3: PUSHJ P,GETFLD + MOVE CH1,CDISP + TLNN CH1,DWRD + TLOA I,UNRCHF ;DELIMITER IS WORD TERMINATOR + TRNE I,FLD + AOSA -2(P) ;CAUSE RETURN TO SKIP OVER ERROR UUO + JRST AGTFD3 ;NO FIELD, TRY AGAIN + TLNE I,MWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + ADD A,WRD ;ADD IN INDEX, INDIRECT FIELDS + POP P,WRD + MOVEM I,ISAV ;SAVE FLAGS FOR FLD GOTTEN + POP P,I + POPJ P, + + ;IN RELOCATABLE FORMAT + ;READ FIELD AND COPY OUT AS WORD + +RGETFD: SETZM WRD ;FIRST INITIALIZE SOME STUFF AS THOUGH AT GETWD + SETZM WRDRLC + MOVE A,GLSPAS + MOVEM A,GLSP1 + MOVEM A,GLSP2 +RGTFD3: PUSHJ P,GETFLD ;READ UNTIL FIELD TERMINATOR + MOVE CH1,CDISP + TLNN CH1,DWRD ;WAS FIELD TERMINATOR WORD TERMINATOR? + TLOA I,UNRCHF ;YES + TRNE I,FLD ;NO, SKIP IF NO FIELD, GO BACK AND TRY AGAIN + JRST .+2 + JRST RGTFD3 + ADDM A,WRD + ADDM B,WRDRLC + PUSHJ P,PWRDA ;OUTPUT WORD + TLNE I,MWRD + JRST IGTXT ;SOAK UP MULTI-WORD FIELD + POPJ P, + +GETFLD: PUSH P,GLSP2 + PUSH P,GLSP2 + PUSH P,PPRIME + PUSH P,GLOBT + MOVE A,GLSP1 + MOVEM A,GLOBT + MOVEM P,PPRIME + TRZ I,FLD+OPFLD +GETFD1: TLNE I,MWRD + JRST .+3 ;MULTIPLE WORD, RE-CALL PSEUDO + PUSHJ P,GETSYL + TRNE I,LET + PUSHJ P,GETVAL ;GET OPERAND (MAYBE SKIPS) +GETFD6: SKIPA C,CDISP ;GET INFO ON SYLLABLE TERMINATOR + JRST GETFD1 ;GETVAL SKIPPED => PSEUDO/MACRO WITH NO VALUE, TRY AGAIN + TLNE C,DFLD + JRST (C) ;FIELD OPERATOR, GO PROCESS + MOVEI TT,0 ;NO DISP MEANS FD TERMINATOR + TRNE I,SYL + TRO I,FLD + JSP LINK,GETFD2 ;EVALUATE WHATEVER HASN'T BEEN + SUB P,[4,,4] ;NOW POP OFF CRUFT FROM PDL + POP P,GLOBT + POP P,PPRIME + SUB P,[2,,2] + POPJ P, + + ;JSP LINK,GETFDA ;STORE SPECIFICATIONS OF OPERATOR, OPERAND; + ;MAYBE EVALUATE CRUFT ON LEFT + ;A HAS LEFT OPERAND (IF ANY), B RELOCATION BITS, + ;C ADR OF ROUTINE TO PERFORM OPERATION, TT HAS PRECEDANCE OF OPERATOR + +GETFDL: MOVEI LINK,GETFD1 ;ENTRY FOR NORMAL ROUTINE (RETURNS TO GETFD1) SO CAN DO JSP C,GETFDL +GETFDA: TRO I,FLD+OPFLD + TRNN I,SYL + AOS TT,GETCNR ;UNARY +GETFD2: CAMN P,PPRIME + JRST GETFD3 ;TOP OF LIST + HLRZ T,(P) ;GET PREC + CAMLE TT,T ;COMPARE TO CURRENT + JRST GETFD3 ;WAIT UNTIL LATER + HRRZ T,(P) + JRST (T) ;GO DO IT NOW (ROUTINE RETURNS TO GETFD4) +GETFD4: SUB P,[4,,4] + JRST GETFD2 + ;PDL AS SEEN BY OPERATOR ROUTINES: +GETFD3: PUSH P,GLSP1 ;-3(P) POINTS TO HIGHEST GLOTB ENTRY OF LEFT OPERAND (ALSO JUST BEFORE RIGHT) + PUSH P,B ;-2(P) HAS RELOCATION BITS OF LEFT OPERAND + PUSH P,A ;-1(P) HAS VALUE OF LEFT OPERAND + HRL C,TT + PUSH P,C ;(P) HAS OF OPERATOR + JRST (LINK) + +PLS: MOVEI C,PLS1 ;PLUS SIGN, PLS1 IS ROUTINE TO PERFORM OPERATION +MINUS2: MOVEI TT,10 ;SET UP PRECEDENCE OF 10 FOR +, - + JRST GETFDL + +MINUS: JSP C,MINUS2 ;MINUS SIGN + MOVNS A ;NEGATE VALUE OF RIGHT OPERAND + MOVNS B ;ALSO RELOCATION + MOVE T,-3(P) + PUSH P,B + HRLZI B,MINF + PUSH P,C + PUSHJ P,LNKTZ ;COMPLEMENT THE MINUS FLAG ON GLOBALS IN RIGHT OPERAND + POP P,C + POP P,B +PLS1: ADD A,-1(P) ;ADD VALUES + ADD B,-2(P) ;ADD RELOCATIONS + JRST GETFD4 + +LNKTZ: TDZA C,C +LNKTC1: MOVE T,GLSP2 +LINKTC: CAML T,GLSP1 + POPJ P, + SKIPL 1(T) + XORM B,1(T) + SKIPL 1(T) + IORM C,1(T) + AOJA T,LINKTC + +MULTP: MOVEI C,MULTP1 ;ASTERISK, MULTP1 ROUTINE TO PERFORM MULTIPLICATION +DIVID2: MOVEI TT,20 ;20 PRECEDENCE OF MULTIPLICATION, DIVISION + JRST GETFDL + +MULTP1: JUMPE B,MULTP3 ;JUMP ON RIGHT OPERAND NOT RELOCATED + SKIPE -2(P) + JRST MULTP4 ;BOTH OPERANDS RELOCATED + MOVE T,-1(P) ;GET VALUE OF LEFT OPERAND AND FALL IN + JRST .+3 +MULTP3: MOVE T,A ;RIGHT OPERAND NOT RELOCATED, GET VALUE IN T + MOVE B,-2(P) ;RELOCATION BITS OF LEFT OPERAND + MOVE D,-3(P) ;GLOTB POINTER TO BETWEEN OPERANDS + CAME D,-7(P) + JRST GMUL1 ;LEFT OPERAND HAS GLOBALS + CAME D,GLSP1 + JRST GMUL2 ;RIGHT OPERAND HAS GLOBALS + ;AT THIS POINT, T HAS VALUE OF ABS OPERAND, B RELOC BITS OF OTHER +GMUL4: IMUL A,-1(P) ;MULTIPLY VALUES + IMUL D,T ;MULTIPLY RELOCATION OF ONE BY VALUE OF OTHER + JRST GETFD4 +MULTP4: ERSM 'IRL ;ILLEGAL RELOCATION * / + JRST GETFD4 + +GMUL1: TLNE FF,PPSS ;LEFT OPERAND HAS GLOBALS, CHEK RIGHT OPERAND + CAMN D,GLSP1 + SKIPA CH1,A ;LOOKS OK, GET VALUE IN CH1 + ERSM 'IMY ;ILLEGAL MPY (BOTH OPERANDS GLOBAL DURING PUNCHING PASS) + SKIPA D,-7(P) ;GET GLOTB POINTER TO BOTTOM OF LEFT OPERAND +GMUL2: MOVE CH1,-1(P) ;GLOBALS IN RIGHT OPERAND ONLY, GET LEFT OPERAND +GMUL3: CAML D,GLSP1 + JRST GMUL4 ;TABLE COUNTED OUT + SKIPGE 1(D) + AOJA D,GMUL3 + JUMPE CH1,GMUL5 ;MULTIPLYING BY ZERO, CLEAR OUT GLOTB ENTRY AND LOOP BACK + LDB CH2,[221200,,1(D)] ;PICK UP MULTIPLICATION FIELD THIS GLOBAL + SKIPN CH2 + MOVEI CH2,1 ;0 => 1 + IMUL CH2,CH1 + CAIN CH2,1 + MOVEI CH2,0 ;IF ONE THEN USE ZERO + DPB CH2,[221200,,1(D)] + AOJA D,GMUL3 + + +GMUL5: CLEARM 1(D) + AOJA D,GMUL3 + +DIVID: JSP C,DIVID2 ;SLASH, PRECEDENCE = 20 +DIVID1: JUMPN B,MULTP4 ;JUMP IF RIGHT OPERAND RELOCATED + SKIPE -2(P) + JRST MULTP4 ;LEFT OPERAND RELOCATED + EXCH A,-1(P) + IDIV A,-1(P) + MOVEI B,0 + JUMPGE FF,GETFD4 + MOVE D,-7(P) + CAME D,GLSP1 + ERSM 'IDV ;AT LEAST ONE OF DIVISION OPERANDS GLOBAL DURING PUNCHING PASS + JRST GETFD4 + + ;LOGIC OPERATORS & (PREC = 40), # (PREC = 34), \ (PREC = 30) + +ANDF: MOVEI TT,40 ;& + JSP C,GETFDL + JSP D,LOGIC1 ;GO DO IT + AND A,-1(P) ;INSTRUCTION ARGUMENT TO LOGIC1 + +XORF: MOVEI TT,34 ;# + TRNN I,SYL ;IF ABOUT TO BE UNARY, + MOVNI A,1 ;THEN TURN LEFT OPERAND INTO -1 + JSP C,GETFDL + JSP D,LOGIC1 + XOR A,-1(P) + +IORF: MOVEI TT,30 ;\ + JSP C,GETFDL + JSP D,LOGIC1 + IOR A,-1(P) + + ;COMMON EXECUTION ROUTINE FOR LOGICAL OPERATORS + +LOGIC1: JUMPN B,MULTP4 ;NO RELOCATION ALLOWED + SKIPE -2(P) ;NOW CHECK RELOCATION OF LEFT OPERAND + JRST MULTP4 + XCT (D) ;ALL TESTS PASSED, DO IT + JUMPGE FF,GETFD4 ;DON'T CHECK FOR GLOBALS EXCEPT DURING PUNCHING PASS + MOVE D,-7(P) ;PICK UP POINTER TO LEFT OPERAND GLOTB ENTRIES + CAME D,GLSP1 + ERSM 'IBL ;GLOBALS IN BOOLEAN + JRST GETFD4 + +CBAKAR: MOVEI TT,100 ;BACKARROW AS FIELD OPERATOR, PREC = 100 + JSP C,GETFDL + JUMPN B,MULTP4 ;NO RELOCATION ALLOWED + MOVE T,A + MOVE A,-1(P) + LSH A,(T) + JRST GETFD4 + +OPEN: PUSH P,D ;CLOSE DELIMITER, SET UP BY CALLING ROUTINE + PUSHJ P,GETWRD ;GET WORD + POP P,D ;RESTORE DELIMITER + CAME D,LIMBO1 ;IF AGREES WITH LAST CHAR READ, + TLNE I,MWRD ;OR IF READING MULTIPLE WORD + POPJ P, ;THEN OK + MOVE D,LIMBO1 ;NEITHER, GET LAST CHAR + CAIE D,15 + CAIN D,12 + SKIPE CONSML ;CR OR LF => OK IN OLD MODE. + ERR 'ILC ;ILLEGAL CLOSE + POPJ P, + +LSSTH: MOVEI D,"> + JSP LINK,SAVWD1 + PUSHJ P,OPEN + TLNE I,MWRD + PUSHJ P,IGTXT ;NOT INTERESTED IN MULTI-WORD CRUD +LSSTH3: JSP LINK,USVWLD ;POP OFF ALL BUTPREVIOUS SYLL. + TLZE I,LSRET + JRST LSSTHR ;RETURN TO ^ OR _ + +;GROUPINGS EXCEPT (PARENS THAT ADD TO WORD) +;SYLL IMMEDIATELY BEFORE OR AFTER IS ERROR. +LSSTH2: ADDM A,-1(P) ;SYLL BEFORE GROUPING, PUSHED BY SAVWD1. + ADDM B,(P) + TRNE I,SYL ;IF WAS SYLL BEFORE GROUPING, ERROR. + ERR 'NOS +LSSTH5: MOVE A,LIMBO1 ;CHECK FOR FOLLOWING SYLL. + CAIE A,15 + CAIN A,12 + JRST LSSTH6 ;DELIMITER CR OR LF + PUSHJ P,RCH ;NOT CR OR LF, GET NEXT CHAR + CAIN A,"! ;IGNORE EXCLAMATION POINT + JRST .-2 + TLO I,UNRCHF ;CAUSE IT TO BE RE-INPUT + HLRZ CH1,GDTAB(A) + CAIE CH1,(POPJ P,) + JRST LSSTH4 ;SQUOZE CHAR. MEANS FOLLOWING SYLL. + HRRZ CH1,GDTAB(A) + MOVE CH1,DTB-40(CH1) ;GET DISPATCH FOR CHAR. + CAIE A,12 + CAIN A,14 + JRST LSSTH7 ;THESE CHARS ARE SYLL. OPS. + CAIE A,"_ ;BUT DON'T CONSTITUTE A FOLLOWING SYLL, SO OK. + CAIN A,"] + JRST LSSTH7 + CAIN A,"; + JRST LSSTH7 + TLNE CH1,DSYL + JRST LSSTH4 ;SYLLABLE OPERATOR +LSSTH7: PUSHJ P,GETSYL +LSSTH6: TRO I,SYL + POP P,B + POP P,A ;VALUE OF GROUPING WAS ADDM'ED INTO THESE. + JRST GETFD6 + +LSSTH1: ADDM A,WRD + ADDM B,WRDRLC + TRNE I,SYL ;IF SYLL BEFORE, + JRST LSSTH5 ;ERROR IF SYL AFTER. + JRST LSSTH8 ;ELSE NO ERROR. + +LSSTH4: ERR 'NOS ;FOLLOWING SYLL WHEN THAT IS ERROR. +LSSTH8: SUB P,[2,,2] + JRST GETFD1 + +LSSTHR: +POP2J: SUB P,[2,,2] + POPJ P, + +LEFTP: MOVEI D,") + JSP LINK,SAVWD1 + MOVEI C,0 + TRNE I,OPFLD + TRNE I,SYL + TLO C,400000 ;CAUSE IT TO GET ADDED INTO WORD STEAD HAVE VALUE AS SYL + PUSH P,C + PUSHJ P,OPEN + POP P,C + MOVSM A,T1 ;STORE SWAPPED VALUE + ADDI B,400000 ;NOW WANT TO SWAP RELOCATION, MAKE LH CORRECT + HLREM B,T2 ;STORE AS RH WITH SIGN EXTENDED + MOVSI B,400000(B) ;GET RIGHT HALF IN LEFT + ADDM B,T2 ;FINISH RELOCATION SWAP (THIS IS PAINLESS COMPARED TO THE HAIR EVERYWHERE + ;ELSE WHEN KEEPING THE HALFWORDS SEPARATE) + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + TLNE I,MWRD + PUSHJ P,IGTXT + JSP LINK,USVWLD + MOVE A,T1 + MOVE B,T2 + JUMPL C,LSSTH1 ;ADD TO WHOLE WORD + JRST LSSTH2 + + ;VERSION OF GETWRD FOR PSEUDO + ;FOLLOW WITH UNDEFINED SYM ERROR MESSAGE + +AGETWD: MOVE CH1,@(P) ;GET ERROR UUO + MOVEM CH1,GTVER ;STORE APPROPRIATELY + TRO I,PSEUDF\DEF + PUSHJ P,GETWRD + TLNE I,MWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + JRST POPJ1 + +;;GETWD ;READ A WORD, LEAVE VALUE IN A AND WRD, RELOC IN WRDRLC AND B + +GETWRD: MOVE T,GLSP1 + MOVEM T,GLSP2 + CLEARM FORMAT ;CLEAR FORMAT, WILL ACCUMULATE FORMAT NUMBER BY IDPB + CLEARM WRD ;CLEAR WRD, WILL ACCUMULATE ABSOLUTE PART OF WORD + CLEARM WRDRLC ; " RELOCATION BITS, " + TDZ I,[WRDF,,AIOWD] + CLEARM FLDCNT ;NO FIELDS YET + MOVE T,[50100,,FORMAT] ;SET UP BIT POINTER TO FORMAT + MOVEM T,FORPNR +GTWD1: PUSHJ P,GETFLD ;READ NEXT FIELD + MOVEI T,1 ;SET T TO 1, AC FOR IDPB ON ROUTINE DISPATCHED TO + MOVE C,CDISP + TLNE C,DWRD + JRST (C) ;NO DISPATCH MEANS WD TERMINATOR + MOVE C,GLSP1 + MOVEM C,LINKL ;MARK END OF ACTIVE PART OF GLOTB + TRNN I,FLD + JRST GETWD2 ;LAST FIELD NULL, MAYBE HAVE TO POP STUFF OFF + IDPB T,FORPNR ;MARK NON-NULL FIELD IN FORMAT +GTWD4A: TLO I,WRDF ;NON-NULL WORD + MOVE TT,FORMAT + SKIPN TT,FORTAB-10(TT) ;PICK UP BYTE POINTER POSITION/SIZE FIELDS FOR FIELDS IN WORD + ERR 'UFM ;UNDEFINED FORMAT + MOVEM TT,FORMAT ;STORE IN FORMAT + MOVE T,[301400,,FORMAT] + MOVEM T,FORPNR + ;AT THIS POINT, FLDCNT HAS 1 LESS THAN # FIELDS; PUT FIELDS TOGETHER TO FORM WORD +GTWD3: LDB T,FORPNR + MOVE D,FLDCNT + CAIG D,2 + IBP FORPNR ;HAVEN'T BACKED UP TO THIRD FIELD YET, INCREMENT TO DESC FOR PREV + TRNE I,AIOWD + PUSHJ P,INTIOW + PUSHJ P,INTFLD ;PUT FIELD WHERE IT BELONGS + SOSGE FLDCNT + JRST GTWD5 ;THIS WAS LAST (FIRST) FIELD + POP P,GLSP2 ;NOT YET, POP OFF MORE + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD3 + +GTWD5: MOVE A,WRD + MOVE B,WRDRLC + MOVE C,LINKL + MOVEM C,GLSP1 + TRZ I,AIOWD + POPJ P, + +SPACE2: POP P,A +COMMA: TRNN I,FLD ;FIELD DELIMITER WAS COMMA (T HAS 1) + JRST COMMA1 ;NO FIELD + IDPB T,FORPNR ;MARK NON-NULL FIELD +COMMA4: IDPB T,FORPNR ;MARK FIELD TERMINATOR WAS COMMA +PUSHFD: PUSH P,A ;DONE WITH THIS FIELD, NOW TO GET NEXT + PUSH P,B + PUSH P,GLSP1 + PUSH P,GLSP2 + AOS FLDCNT ;ANOTHER FIELD + MOVE TT,GLSP1 + MOVEM TT,GLSP2 + HRRZ T,FORPNR + CAIE T,FORMAT + HRRZS FORPNR ;STABILIZE FORPNR + JRST GTWD1 + +GETWD2: SKIPN FORMAT ;LAST FIELD OF WORD IS NULL + JRST GTWD5 ;ENTIRE WORD NULL, MAYBE WERE PARENS. + SOS FLDCNT + POP P,GLSP2 + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD4A + +COMMA1: LDB TT,FORPNR ;COMMA TERMINATED NULL FOELD. + SKIPE FORMAT + JUMPE TT,COMMA2 ;NOT 1ST FLD, JMP IF PREV WAS TERM BY SPACE. + IBP FORPNR ;ELSE MARK NULL FIELD IN FORMAT. + JRST COMMA4 + +;FIELD SPACE COMMA, PATHOLOGICAL CASE +;(EG MACRO STARTED WITH A COMMA) +COMMA2: DPB T,FORPNR ;REPLACE SPACE WITH COMMA. + JRST GTWD1 + + ;FIELD TERMINATOR IS SPACE (T HAS 1) + +SPACE: PUSH P,A + MOVE TT,GDTAB+40 + PUSHJ P,RCH + CAMN TT,GDTAB(A) + JRST .-2 ;FLUSH OTHER LOGICAL SPACES + CAIN A,", ;FIRST NON-SPACE CHAR COMMA? + JRST SPACE2 ;YES + POP P,A ;NO, RESTORE A + TLO I,UNRCHF ;CAUSE CHAR TO BE RE-READ NEXT TIME + TRNN I,FLD + JRST GTWD1 ;NO FIELD + IDPB T,FORPNR ;T HAS 1, MARK NON-NULL FIELD IN FORMAT + IBP FORPNR ;MARK FIELD TERMINATOR WAS SPACE + JRST PUSHFD + +;T HAS DESC BYTE, PUT FIELD IN ITS PLACE +;ALSO CALLED FROM PBYTE, MUSTN'T CLOBBER AA. + +INTFLD: MOVE TT,GLSP2 + CAMN TT,GLSP1 + JUMPE B,INTFD1 ;NO GLOBALS, JUMP IF NO RELOCATION + CAIN T,2222 ;LH + JRST INTL + CAIN T,22 ;RH + JRST INTR + CAIN T,44 ;WHOLE WORD + JRST INTW + SKIPE B + ERR 'IRL ;RELOCATION ATTEMPTED IN IRRELOCATABLE FIELD + ;(ASSUME) NO RELOCATION, CHECK FOR GLOBAL AC FIELDS + CAIN T,2704 ;HIGH AC + JRST INTACH + CAIN T,504 ;AC LOW + JRST INTACL + JUMPGE FF,INTFD1 ;JUMP ON NOT PUNCHING PASS + CAME TT,GLSP1 + ERR 'IGS ;GLOB SYM APPEARS IN ILLEGAL FIELD +INTFD1: MOVEI TT,C_12. + ROTC T,-12. ;SHIFT BYTE POINTER INTO TT + MOVEI C,0 ;INITIALIZE C TO RECEIVE FIELD IN PROPER PLACE + DPB A,TT + CAMN TT,[2200,,C] + JRST INTFD2 ;RIGHT HALF, DON'T ALLOW CARRY INTO LH + ADDM C,WRD ;ALLOW CARRY +INTFD3: ADDM B,WRDRLC ;ADD RELOCATIONS, WILL BE BROKEN BACK INTO HALF-WORDS LATER + POPJ P, + +INTFD2: ADD C,WRD ;ADD RIGHT HALVES + HRRM C,WRD + JRST INTFD3 + +INTIOW: CAIE T,2704 + CAIN T,504 + TRZA A,3 ;IO DEVICE FIELD + POPJ P, ;NOT "AC" FIELD + ADDI T,611-504 + POPJ P, + +INTR: HRRE D,B ;RH + MOVEI B,0 + PUSH P,T + HRLZI C,HFWDF + PUSHJ P,LNKTC1 ;THIS IS A BUG WHICH SHOULD BE FIXED SOMETIME +PRTCL: MOVE B,D ;GET BACK MAPPED RELOCATION BITS +PRTCL2: POP P,T +INTW: MOVE D,GLSP2 ;WHOLE WORD + HRLOI LINK,377777 + CAML D,GLSP1 + JRST INTFD1 + ANDM LINK,1(D) + AOJA D,.-3 + +INTL: HRLZ D,B ;LH + MOVSI B,SWAPF + MOVSI C,HFWDF + PUSH P,T + MOVE T,GLSP2 +INTL2: CAML T,GLSP1 + JRST PRTCL + SKIPGE 1(T) + AOJA T,INTL2 ;INDEX FIELD, ETC => LEAVE ALONE + IORM C,1(T) ;SET HFWDF + XORM B,1(T) ;COMPLEMENT SWAP STATUS + TDNN B,1(T) + SETZM 1(T) ;SWAPPED TO RH, FLUSH IT + AOJA T,INTL2 + +INTACL: TDZA B,B ;AC LOW +INTACH: HRLZI B,SWAPF ;AC HIGH + HRLZI C,ACF + PUSH P,T + PUSHJ P,LNKTC1 + MOVEI B,0 + JRST PRTCL2 + +IOINST: HLLZ A,B ;IO INSTRUCTION, GET WHICH ONE INTO A + SKIPN FLDCNT ;THIS FIRST FIELD OF WORD? + TRO I,AIOWD ;YES + JRST CLBPOP ;RETURN VALUE + + ;TOP LEVEL LOOP, ASSEMBLE STORAGE WORDS + ;LOTS OF PSEUDOS MEANINGLESS IN STORAGE WORDS + ;(E.G. BLOCK, CONSTA) DO JRST ASSEM1 WHEN DONE + ;THERE'S ALSO AN ERROR UUO WHICH RETURNS TO ASSEM1 + +ASSEM1: TLNE I,MWRD + JRST ASSEM2 ;ASSEMBLING MULTIPLE WORD + SKIPG CONSML ;UNLESS IN MULTI-LINE MODE, + JSP LINK,CONFLA ;FLUSH CONSTANTS, ERROR IF ANY AND CONSML < 0. + SKIPE CONEND ;IF DIDN'T FLUSH AND SAW RBRKT, END CONST. + JRST CONND +ASSEM3: PUSHJ P,RCH + CAIG A,40 + JRST .-2 ;FLUSH LEADING GARBAGE + TLO I,UNRCHF ;CAUSE NON-GARBAGE CHAR FOUND TO BE RE-INPUT +ASSEM2: TRZ I,FLD+SYL+LET+PSEUDF+COM+CONT+GMINF+OPFLD + TLZ I,GLI+VAR+FLO+DECP+UARI+MNSFLG+WRDF+NPRC + TRO I,DEF + TLZ FF,SKILF + MOVE P,ASSEMP + HRRZM P,GETCNR ;MAKE SURE PREC OF UNARY OPS FITS IN A HALFWORD DURING LONG ASSEMBLIES + MOVE A,GLSPAS + SKIPL BYTM + MOVEM A,GLSP1 + ;GETWRD WILL COPY GLSP1 INTO GLSP2 + PUSHJ P,GETWRD + TLZN I,WRDF + JRST ASSEM0 ;NO WORD ASSEMBLED,TRY AGAIN + SKIPGE BYTM + JRST PBYTE ;IN BYTE MODE, OUTPUT BYTE INSTEAD OF WORD, A,B MUST HAVE WRD,WRDRLC. + SKIPE CONDEP + JRST ASSEM4 + SKIPE STGSW ;NOT INSIDE CONSTANT + ERR 'SWD ;STORAGE WORD ASSEMBLED + PUSHJ P,PWRD ;OUTPUT THE WORD. + AOS CLOC + HRRZS CLOC ;INCREM. POINT . + JRST ASSEM1 + +ASSEM0: SKIPN CONDEP ;IF IN CONSTANT, MAYBE SHOULD END IT. + JRST ASSEM1 + CAIA +ASSEM4: JSP T,PCONST ;OUTPUT WORD TO CONSTANT. + SKIPE CONEND ;SAW BRACKET => END IT. + JRST CONND + SKIPG CONSML ;NEW MODE => OTHERWISE DON'T END. + TLNE I,MWRD ;SAME IF INSIDE MULTIPLE WORD PSEUDO. + JRST ASSEM1 + SKIPE CONSML ;CLOSING CONST. WITH CR OR LF, [ + ERR (SIXBIT/NO]/) + JRST CONND + +;;GETVAL ;GET VALUE OF SYM + ;SKIPS ON PSEUDO NOT RETURNING VALUE (E.G. MACRO STARTING TO BE EXPANDED) + ;ELSE RETURNS VALUE IN A, RELOCATION BITS IN B + +VBLK +GTVER: 0 ;ERROR UUO (OR WHATEVER) TO EXECUTE ON UNDEFINED SYMBOL IN PSEUDO + JRST CABPOP +PBLK + +GETVAL: PUSHJ P,ES + JRST GVNF ;NO STE. +IFN CREFSW,XCT CRFINU ;JFCL OR CALL TO CREF RTN. + JRST @.+1(A) ;FOUND, DISPATCH ON SQUOZE FLAGS + +GVTAB: GVCOM ;COMMON (UNUSED) + GVPSEU ;PSEUDO OR MACRO. + GVSYM ;LOCAL SYMBOL. + GVUL ;LOCAL UNDEF (MAYBE STINK KNOWS VALUE) + GVDLV ;DEFINED LOCAL VAR. + GVULV ;UNDEF LOC VAR. + GVDGV ;DEF GLO VAR + GVUGV ;UNDEF GLO VAR + GVDG ;DEF GLOBAL + GVUG ;UNDEF GLOBAL + +;DEF LOCAL VAR. +GVDLV: PUSHJ P,GVDLGV ;IF PASS2 AND HAS ' THIS TIME, SET 3VAS2 FOR AVARIAB + TLZN I,GLI + JRST GVDLV2 + MOVSI T,DEFGVR ;NOW DEF GLO VAR. + PUSHJ P,VSM2 + JRST GVDG1 ;MAYBE OUTPUT GLOBAL DEF. TO STINK. + +GVDGV: PUSHJ P,GVDLGV ;DEF GLO VAR; IF PASS 2 AND ' THIS TIME, SET 3VAS2 + JRST GVDG2 ;MUSN'T PUNCH VALUE, AVARIAB WILL. + +GVDLGV: TRNE FF,PSS ;IF PASS 2 + TLNN I,VAR ;AND THIS TIME HAVE SINGLEQUOTE + POPJ P, + TLO C,3VAS2 ;TELL AVARIAB SEEN IN PASS 2 WITH '. + 3PUT C,D + POPJ P, + +GVULV: TLZN I,GLI ;UNDEF LOC VAR, MAYBE MAKE GLOBAL. + JRST GVUNDF + PUSHJ P,PLOGLO ;IF SO, TELL STINK SYM IS GLOBAL, + MOVSI T,UDEFGV ;SYM NOW UNDEF GLO VAR + PUSHJ P,VSM2 + JRST GVUNDF ;IN EITHER CASE, HANDLE UNDEF SYM. + +GVUL: TLNE C,3LLV ;UNDEF LOCAL + JRST GVGLTB ;(REALLY DEFINED BUT ONLY STINK KNOWS HOW) + TLNE I,GLI ;IF MAKING GLOBAL, TELL STINK. + PUSHJ P,PLOGLO +GVNF1: TLZE I,VAR ;IF ', MAKE VAR (WILL CHECK GLI) + JRST GVUL1 + TLZN I,GLI ;NOT MAKING VAR, MAYBE GLOBAL? + JRST GVUNDF ;NO, MAYBE ERROR, MAKE GLOTB ENTRY. + MOVSI T,GLOEXT + PUSHJ P,VSM2 ;NOW GLOBAL UNDEF, + JRST GVGLTB ;NO ERROR, JUST GLOTB ENTRY. + +GVUL1: TLZN I,GLI ;UNDEF LOCAL BECOMES + SKIPA T,[UDEFLV,,] ;UNDEF LOC VAR OR +GVGVAR: MOVSI T,UDEFGV ;UNDEF GLO VAR. +GVVAR: AOS VARCNT + HRR B,VARCNT + PUSHJ P,VSM2 ;MAKE IT A VAR, + JRST GVUNDF ;PRETEND HAD ALREADY BEEN A VAR. + +GVUG: TLZE I,VAR ;UNDEF GLOBAL: MAYBE MAKE UNDEF GLO VAR. + JRST GVGVAR +GVGLTB: AOS GLSP1 ;DON'T KNOW SYM'S VALUE, MAKE GLOTB ENTRY. + MOVEI T,ST(D) + HRRZM T,@GLSP1 + JRST CABPOP ;RETURN 0 AS VALUE. + +GVNF: +IFN CREFSW,XCT CRFINU ;ONLY IF NOT FOUND WOULD NOT CREF AFTER ES. + TLNE I,VAR+GLI ;MAKING VAR OR GLOBAL FORCED CURRENTBLOCK ALREADY + JRST GVNF1 ;AND WILL STORE NAME IN STE ANYWAY. + SKIPGE ESBK ;ELSE IF NO SPEC'D BLOCK, + HRRI C,0 ;FORCE OUTERMOST BLOCK SO DON'T GET LOTS OF UNDEF ENTRIES. + MOVSI T,LCUDF + PUSHJ P,VSM2 + JRST GVUNDF ;MAYBE ERROR, MAKE GLOTB ENTRY. + +GVCOM: TRO I,COM ;COMMON: SAY THIS WAS ONE. + HRRZ A,B ;RETURN RH OF VALUE, ABSOLUTE. + JRST CLBPOP + +GVPSEU: TLZE I,VAR+GLI ;CAN'T MAKE PSEUD OR MACRO GLOBAL OR VAR. + ERSM 'ILV + JRST (B) ;DISPATCH TO PSEUDO (OR MACCL IF MACRO) + ;EXPECTS LH OF VALUE IN LH OF B. + +GTVL7B: TLNE C,3RLL ;R(LH) + TLO SYM,200000 + TLNE C,3RLR ;R(RH) + TLO SYM,100000 + POPJ P, + +GVSYM: TLZE I,VAR ;LOCAL SYM: CAN'T MAKE VARIABLE. + ERSM 'MDV + TLZN I,GLI + JRST GVSYM0 ;NOT MAKING GLOBAL, GET VALUE & RETURN. +GVSYM1: MOVSI T,GLOETY ;BECOMES DEF. GLOBAL. + PUSHJ P,VSM2 + JRST GVDG1 ;HANDLE AS IF WAS DEF GLOBAL. + + GVDG: TLZE I,VAR ;GLOBAL ENTRY + ERSM 'MDV ;MDGV + TLNE C,3VP + JRST GVDG2 ;VALUE PUNCHED ALREADY, NOT AGAIN. + +;COME HERE FOR DEF GLOBAL THAT HASN'T HAD VALUE PUNCHED. +GVDG1: SKIPGE CONTRL + JRST GVDG2 ;DON'T PUNCH VALUE IF ABSOLUTE. + JUMPGE FF,GVDG2 + TLNN C,3LLV + TRNE I,PSEUDF+EQLF + JRST GVDG2 + TLO SYM,40000 + PUSH P,WRD + PUSHJ P,OUTDE2 + POP P,WRD +GVDG2: TRNN I,EQLF + TRNN I,PSEUDF + TLNN C,3REL +GVDLV2: TLNE C,3LLV + JRST GVGLTB +GVSYM0: MOVE A,B ;USED IN LBRAK + BYB LDB B,C,\3RLR_18. + TLNE C,3RLL + TLO B,1 + POPJ P, + +GVUGV: +GVUNDF: TRZ I,DEF ;UNDEFINED, MAYBE ERROR, MAKE GLOTB ENTRY. + TRNE I,PSEUDF + JRST GTVER ;PSEUDO + TRNN FF,PSS + JRST GVGLTB ;PASS 1 + SKIPN CONDEP + ERSM 'USW + SKIPE CONDEP + ERSM 'USC + JRST CABPOP + +;PUNCH OUT LOCAL-GLOBAL RECOVERY BITS AND SYM +;I.E. TELL LOADER THAT SQUOZE IN SYM, FORMERLY CONSIDERED LOCAL, IS REALLY GLOBAL +;SHOULD BE CALLED ONLY IN RELOCATABLE ASSEMBLY. +PLOGLO: PUSH P,A + PUSHJ P,PBITS7 + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY THIS IS NEW STYLE RQ, + PUSHJ P,OUTSM0 ;PUNCH "OLD NAME" = SYMTAB IDX, + TLC SYM,440000 ;SAY MAKE GLOBAL, OUTPUT ACTUAL NAME OF SYM. + PUSHJ P,OUTSM + JRST POPAJ + +;EVALUATE SYMBOL, SQUOZE (FLAGS OFF) IN SYM +;RETURNS CRUD AS DOCUMENTED IN COMMENTS, SKIPS IF FOUND +;DOESN'T CLOBBER F (FOR WRQOTE) +;ESBK SHOULD HAVE -1 OR SPEC'D BLOCK (AS SET BY GETSYL FOR INSTANCE) +;ESLAST -> LAST STE WITH DESIRED NAME SEEN, EVEN IF NOT BEST. +;ESL1 HAS LEVEL OF BEST, -1 IF NONE. +;ESL2 HAS 3RDWRD OF BEST. +;ESXPUN HAS -1 OR IDX OF PLACE TO DEFINE SYM. + +ESDEF: MOVE A,BKCUR ;EVAL SYM IN ORDER TO DEFINE IT: + SKIPGE ESBK ;IF NO SPEC'D BLOCK, SPEC CURRENT BLOCK, + MOVEM A,ESBK ;SO DEFS IN CONTAINING BLOCKS WON'T BE SEEN + +ES: MOVN TT,SYMLEN ;-<# STE'S IN SYMTAB> + SETOM ESLAST + SETOM ESL1 + MOVE C,SYM ;HASH AWAY + TSC C,C + MOVMS C + IDIV C,SYMLEN + IMULI D,WPS + SKIPGE TM,ESBK ;GET BKTAB IDX OF SPEC'D BLOCK + HRR TM,BKCUR ;OR -1,,BKTAB IDX OF CURRENT BLOCK. + SETOB C,ESXPUN ;NO EXPUNGED OR FREE ENTRY FOUND. +ESLP: SKIPN B,ST(D) ;GET SQUOZE IN THIS ST SLOT + JRST ESEND ;NOTHING WHERE SYM BELONGS, END SEARCH + TLZ B,740000 ;CLEAR OUT FLAGS + CAME B,SYM ;COMPARE WITH WANTED + JRST ESBAD ;NO MATCH BUT MAYBE KEEP GOING + 3GET C,D ;FOUND SYM, GET 3RDWRD + MOVEI A,(C) + CAIN A,(TM) ;DEFINED IN DESIRED BLOCK + JRST ESGOOD ; => MUST BE GOOD. + JUMPGE TM,ESIGN ;BLOCK SPEC'D => ALLOW NO OTHERS. + HLRZ B,BKTAB+1(C) ;GET LEVEL OF BLOCK DEF. IS IN. + CAMN A,BKPDL(B) ;SAME AS BLOCK WE'RE IN AT THAT LEVEL? + CAMLE B,BKLVL ;AND NOT A BLOCK WE'VE EXITED + JRST ESIGN + CAMG B,ESL1 ;OR HIGHER LEVEL THAN PREVIOUS BEST + JRST ESIGN + MOVEM C,ESL2 ;REPLACE BEST'S 3RDWRD, LEVEL, ADDR. + MOVEM B,ESL1 + MOVEM D,SADR +ESIGN: HRRZM D,ESLAST ;THIS ENTRY LAST SEEN WITH THIS NAME. + TLNN C,3MAS ;MORE STE'S FOR THIS SYM => + JRST ESEND1 + JRST ESNXT ;KEEP LOOKING. +ESBAD: JUMPN B,ESNXT + SKIPGE A,ESXPUN ;IF THIS IS 1ST EXPUNGED ENTRY SEEN + MOVEM D,ESXPUN ;REMEMBER IT FOR DEFINITION. + SKIPGE A + HRROS ESLAST ;AND SET OLD ENTRY'S 3MAS. +ESNXT: ADDI D,WPS + CAML D,SYMSIZ ;AT END => GO TO BEGINNING + MOVEI D,0 + AOJN TT,ESLP + JRST ESEND1 ;NOT FOUND. + +ESEND: SKIPGE A,ESXPUN ;FREE ENTRY CAN BE USED TO DEFINE. + MOVEM D,ESXPUN + SKIPGE A + HRROS ESLAST +ESEND1: SKIPGE ESL1 ;NOT FOUND => FIND PLACE TO DEFINE IT. + JRST DEFCH1 + MOVE D,SADR ;IDX OF BEST FOUND. + TRNE FF,NPSS + JRST ES1PS ;1-PASS, SPECIAL CHECK. + SKIPA C,ESL2 ;GET BEST'S 3RDWRD. +ESGOOD: MOVEM D,SADR ;FOUND IN CURRENT BLOCK. + LDB A,[400400,,ST(D)] ;GET SQUOZE FLAGS IN A. +ES1POK: MOVE B,ST+1(D) ;VALUE OF SYM. IN B. + ;D HAS IDX OF 1STWRD IN SYM TAB. + ;C HAS 3RDWRD +POPJ1: AOS (P) +CPOPJ: POPJ P, + +ES1PS: LDB A,[400400,,ST(D)] ;1PASS & FOUND IN CONTAINING BLOCK: + MOVE C,ESL2 + CAIE A,1 ;PSEUDO OR MACRO + TLNE C,3INI ; OR INSN, OK; ELSE GET NEW STE TO DEF. + JRST ES1POK +DEFCH1: MOVEI C,(TM) ;INITIALIZE NEW 3RDWRD WITH BLOCK TO DEF IN. + SKIPL D,ESXPUN ;IF FOUND EXPUNGED OR FREE ENTRY, USE IT. + JRST DEFCH2 + SKIPGE D,ESLAST ;ELSE LOOK FOR ONE. + ERF 'SCE +DEFCH4: MOVE B,ST(D) + TLZ B,740000 + JUMPE B,DEFCH3 ;MUST RETURN 0 IN B IF DON'T SKIP. + ADDI D,WPS + CAML D,SYMSIZ + MOVEI D,0 + AOJL TT,DEFCH4 ;ASSUME TT LEFT AROUND FROM ES. + ERF 'SCE + +;ESLAST HAS -1 IF NO ENTRY SEEN; ELSE +;RH HAS IDX OF LAST SEEN, SIGN SET IF SEEN BEFORE PLACE TO DEFINE. +DEFCH3: MOVEM D,ESXPUN ;REMEMBER ADDR WHERE CAN DEFINE + HRROS ESLAST ;LAST PLACE SEEN MUST BE EARLIER. +DEFCH2: SKIPL A,ESLAST + JRST DEFCH5 ;LAST PLACE SEEN WAS SEEN AFTER PLACE TO DEFINE. + CAMN A,[-1] + POPJ P, ;REALLY NEVER SEEN. + MOVSI TM,3MAS + IORM TM,ST+2(A) ;PLACE SEEN IS EARLIER, SET ITS 3MAS. + POPJ P, + +DEFCH5: TLO C,3MAS ;PLACE TO DEF BEFORE EXISTING STES. + POPJ P, + +;ENTER A SYM IN SYMBOL TABLE + ;B HAS VALUE + ;C HAS 3RDWRD + ;D HAS INDEX INTO ST (PROBABLY SET UP BY ES) + ;T HAS SQUOZE FLAGS (ONLY) IN PLACE FOR IOR OF SQUOZE + ;SYM HAS SQUOZE, FLAGS OF WHICH ARE IGNORED + +VSM2LV: TLOA C,3LLV ;ENTRY FOR LINKING LOADER MUST SUPPLY VALUE +VSM2W: MOVE B,WRD ;ENTRY TO ENTER VALUE OF WRD STEAD B +VSM2: MOVE CH1,SYM + TLZ CH1,740000 + IOR CH1,T ;CH1 := SQUOZE WITH FLAGS + MOVEM CH1,ST(D) ;STORE SQUOZE + MOVEM B,ST+1(D) ;STORE VALUE +VSM3A: 3PUT C,D ;STORE 3RDWRD + POPJ P, + + +;;EQUAL ;EQUAL SIGN ENCOUNTERED, DO PARAMETER ASSIGNMENT + +EQUAL: CAMN SYM,[SQUOZE 0,.] ;.=FOO, SAME AS LOC FOO + JRST PTEQ + TRNN I,OPFLD+PSEUDF + TRNN I,LET + ERA 'IPA ;ILLEG ARG EQ + PUSH P,SYM + PUSH P,ESBK + PUSH P,I + MOVE A,[ERSM 'USP] + MOVEM A,GTVER + TRO I,PSEUDF+DEF+EQLF + PUSHJ P,RCH + CAIE A,"= + TLOA I,UNRCHF + TLO FF,SKILF + PUSHJ P,GETWRD + MOVEI CH1,CRDF + MOVEM CH1,PARBIT ;SET FLAG TO TELL LOADER TO ALLOW REDEFINITION + TRNN I,DEF + JRST ASEM1A ;UNDEFINED SYMS IN VALUE, IGNORE +IFN LISTSW,[ + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE SYM,WRD + MOVEM SYM,LISTWD + MOVE SYM,WRDRLC + MOVEM SYM,LSTRLC + SETOM LISTAD + SETOM LISTPF +] + TDZ I,[-1-(MWRD)] + IOR I,(P) + POP P,(P) + POP P,ESBK + POP P,SYM + MOVE A,WRDRLC ;GET RELOCATION + TDNN A,[-2,,-2] ;SKIP ON NON-STANDARD RELOCATION BITS + SKIPE LDCCC + JRST EQG1 ;STRANGE RELOCATION OR IN LOAD TIME CONDITIONALS => HAND PROBLEM TO LOADER + MOVE A,GLSP1 + CAMN A,GLSP2 + JRST EQL1 ;NO GLOBALS IN DEFINITION +;FALLS THROUGH. + +;FALLS THROUGH. +;GLOBALS TO RIGHT OF = OR WITHIN LOADER CONDIT OR GLOBAL LOC CTR. +EQG1: IFN CREFSW, XCT CRFLBL ;CREF DEF. OF NORMAL SYM, + JUMPGE FF,EQG2 ;(UNDEF SYMS GIVE GLOBAL REFS, 1ST PASS) + SKIPGE CONTRL + ERA 'IPA ;UNDEF GLOBALS & NOT RELOCATABLE? +EQG2: PUSHJ P,ESDEF ;GLOBALS TO RIGHT + JRST EQL2 ;NOT FOUND + JRST .+1(A) + ERA 'IPA ;COMMON + ERA 'IPA ;PSEUDO OR MACRO + JRST EQL2 ;SYM + JRST EQGUL ;LOCAL UNDEF + ERA 'IPA ;DEF LOC VAR + ERA 'IPA ;UNDEF LOC VAR + ERA 'IPA ;DEF GLO VAR + ERA 'IPA ;UNDEF GLO VAR + JRST EQL7 ;GLO ENTRY +EQL8: JUMPE B,EQL7 ;GLO EXIT REACHED BY DISP + PUSHJ P,GLKPNR +EQL7: MOVSI T,GLOETY ;GLOBAL PARA ASSIGN + MOVEI B,0 + TLO SYM,40000 +LOPRA1: PUSH P,CASM1A ;RETURN TO ASSEM1A AFTER FOLLOWING. + TLNE FF,SKILF + TLOA SYM,400000 ;SET FLAG TO HALF-KILL SYM + TLZA C,3SKILL + TLO C,3SKILL ;SET CORRESPONDING FLAG IN 3RDWRD + PUSHJ P,VSM2LV + JUMPGE FF,CPOPJ ;JUMP ON NOT PUNCHING PASS + SKIPN PARBIT ;IF CAME FROM COLON ROUTINE, + JRST PDEFPT ;PUNCH "DEFINE SYM AS $.". + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D ;STORE UPDATED 3RDWRD + PUSHJ P,EBLK + MOVEI TT,LGPA + DPB TT,[310700,,BKBUF] + PUSHJ P,OUTSM0 + PUSHJ P,PWRDA + JRST EBLK + +EQGUL: PUSHJ P,LKPNRO ;LOCAL UNDEF, OUTPUT LINK REQUEST. +EQL2: TLNE I,GLI + JRST EQL7 ;MAKE IT GLOBAL + MOVSI T,LCUDF ;LOCAL UNDEFINED + JRST LOPRA1 + +CASM1A: JRST ASEM1A + +;MAYBE PUNCH OUT LINK REQUEST +;SYM HAS NAME OF SYM TO REQUEST, D STE IDX OF SYM, C 3RDWRD, B ADR OF REQUEST +;REQUEST WILL BE PUNCHED IF 3RLNK SET IN C OR IF ANYTHING SET IN LH(B) + +GLKPNR: TLO SYM,40000 ;GLO BIT +LKPNRO: TLNN C,3RLNK + TLNE B,-1 + TROA I,CONT + POPJ P, ;DON'T PUNCH REQUEST + MOVEI A,6 + PUSHJ P,PBITS + PUSHJ P,OUTSM ;PUNCH SYM + HLRZ A,B + TLZE C,3RLNK ;RELOC OF LINK PNR + TLO A,100000 + HRRZS B ;CLEAR OUT LH OF B + TRZ I,CONT ;OK TO END BLOCK NOW + JRST OUTPUT ;PUNCH OUT A AND RETURN + +;THESE ASSUME STE IDX IN D, SQUOZE W/ FLAGS IN SYM. +;C HAS 3RDWRD, B OR WRD HAS VALUE TO DEF. WITH. +;CALL ONLY IN RELOCATABLE ASSEMBLY. +OUTDE2: MOVEM B,WRD +OUTDE1: TLNE FF,PPSS + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D + TRO I,CONT + PUSHJ P,P70 ;PUNCH OUT CODE BITS + PUSHJ P,GTVL7B ;SET RELOCATION BITS IN SQUOZE + PUSHJ P,OUTSM0 + TRZ I,CONT + JRST OUTWD ;OUTPUT VALUE + + ;NO GLOBALS TO RIGHT OF EQUAL SIGN + +EQL1: PUSHJ P,ESDEF + JRST EQL1A ;NOT FOUND +IFN CREFSW,XCT CRFEQL ;DEF. OCCUR. OF NORMAL SYM. OR INTSYM. + JRST .+1(A) + ERA 'IPA ;COMMON + JRST EQL1B2 ;PSEUDO OR MACRO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + ERA 'IPA ;DEF LOC VAR + ERA 'IPA ;UNDEF LOC VAR + ERA 'IPA ;DEF GLO VAR + ERA 'IPA ;UNDEF GLO VAR + JRST EQL1D ;GLO ENTRY +EQL1E: PUSHJ P,GLKPNR ;GLO EXIT REACHED BY DISP DUMP LINKING POINTER +EQL1D: PUSHJ P,RCHKT ;GLO ENTRY +EQLB2: PUSHJ P,RMOVET + TLNE FF,SKILF + TLOA SYM,400000 + TLZA C,3SKILL + TLO C,3SKILL + HRLZI T,GLOETY + SKIPE LDCCC ;IF IN LOADER CONDITIONAL, + TLO C,3LLV ;THEN LOADER MUST SUPPLY VALUE + PUSHJ P,VSM2W ;DEFINE SYM + TLO SYM,40000 ;SET GLOBAL BIT IN SQUOZE +EQL1CE: JUMPGE FF,ASEM1A + PUSHJ P,OUTDE1 +ASEM1A: TLNE I,MWRD + PUSHJ P,IGTXT + JRST ASSEM1 + +EQL1C: TLNE I,GLI + JRST EQL1CA ;MAKE GLOBAL + PUSH P,C + PUSHJ P,LKPNRO ;MAYBE OUTPUT LINK REQUEST + PUSHJ P,RCHKT + PUSHJ P,RMOVET ;INITIALIZE 3RDWRD + MOVSI T,SYMC ;SYM + PUSHJ P,EQA2A ;ENTER DEF IN SYMTAB + TLNE C,3SKILL + TLO SYM,400000 + POP P,AA + TLNE AA,3VCNT ;USED IN CONSTANT + PUSHJ P,CONBUG + JRST EQL1CE + + ;PUNCH OUT CODE BIT PAIR, FIRST OF WHICH IS 7 + +P7X: MOVEM A,PARBIT ;ENTRY FOR SECOND BYTE IN A +P70: PUSHJ P,PBITS7 ;ENTRY FOR SECOND BITE IN PARBIT, PUNCH OUT THE 7 + SKIPA A,PARBIT ;GET SECOND BYTE BACK +PBITS7: MOVEI A,7 ;ENTRY TO JUST PUNCH OUT 7 + JRST PBITS + +EQL1CA: PUSHJ P,PLOGLO + JRST EQL1E +EQA2: PUSH P,CASM1A +EQA2A: TLNE FF,SKILF + TLO C,3SKILL + JRST VSM2W + +EQL1B2: HRRZ A,B ;ATTEMPT TO ASSIGN PSEUDO-OP, IS IT AN INTSYM? + CAIN A,INTSYM + JRST EQLINT ;YES, GO SET WD IT POINTS TO. + ERSM 'QPA ;ELSE TURN INTO NORMAL SYM. +EQL1B: PUSHJ P,RCHKT + TLNE I,GLI + JRST EQLB2 ;WAS LOCAL, MAKE IT GLOBAL + ;WAS LOCAL, LEAVE IT LOCAL + PUSHJ P,RMOVET ;PUT RELOCATION BITS IN BITS 0 AND 1 OF C (I.E. START SETTING UP 3RDWRD) + MOVSI T,SYMC ;SYM + JRST EQA2 + +EQL1A1: PUSHJ P,RCHKT + PUSHJ P,RMOVET + HRLZI T,SYMC + JRST EQA2 + +EQL1A: +IFN CREFSW,XCT CRFLBL ;DEF. OCCUR. OF NORMAL SYM. + TLNN I,GLI + JRST EQL1A1 + JRST EQL1D + +EQLINT: HLRZS B ;GET ADDR OF WD HOLDING VALUE. + MOVEMM (B),WRD ;PUT NEW VALUE IN IT. + JRST ASEM1A + +;;. ;ROUTINES DEALING WITH THE CURRENT LOCATION AND OFFSET + +VBLK +CLOC: 0 ;PUNCHING LOC +CRLOC: 0 ;PUNCHING RELOC +OFLOC: 0 ;OFSET VAL +OFRLOC: 0 ;OFSET RELOC +;VAL OF PT=CLOC+OFLOC,CRLOC+OFLOC +SYLOC: 0 ;VAL OF LAST TAG +SYSYM: 0 ;LAST TAG +SYLOC1: 0 ;VALUE OF NEXT TO LAST TAG +SYSYM1: 0 ;NEXT TO LAST TAG +GLOCTP: 0 ;4.9 => CURRENT LOCATION GLOBAL, 2.9 => OFFSET GLOBAL + ;GLOLOC (FLAG IN FF) IS IOR OF BITS 4.9 AND 2.9 OF GLOCTP + ;EXCEPT AFTER .=NON-GLOBAL WITH GLOBAL OFFSET + ;OTHER BITS USED ONLY WHEN IN LINK (NEVER SET IN GLOCTP): + ;400 => ARG GLOBAL +PBLK + + + ;POINT (.) AS PSEUDO-OP + +GTVLP: TLNE FF,INDEFF + JRST GTVLP1 ;LOCATION INDEFINITE + TRNE FF,GLOLOC + JRST GTVLP2 ;LOCATION GLOBAL + MOVE B,OFRLOC ;GET RELOCATION OF OFFSET + ADD B,CRLOC ;ADD CURRENT RELOCATION + MOVE A,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM ;IF IN BYTE MODE, + HLL A,BYTWP ;SET LEFT HALF TO BYTE POINTER LEFT HALF FOR ILDB + ADD A,OFLOC ;NOW ADD OFFSET + TLZ I,FLO+DECP+PERI ;CLEAR OUT FLAGS SET WHEN LOOKED LIKE FLOATING POINT NUMBER + POPJ P, + +GTVLP1: TLNE FF,PPSS ;LOCATION INDEFINITE + ERSM 'PNI + JRST CABPOP + +GTVLP2: MOVEI T,$.H ;LOCATION GLOBAL + AOS GLSP1 + HRRZM T,@GLSP1 ;PUT $. ON GLOBAL LIST (INCLUDES OFFSET, WHETHER GLOBAL OR NOT) + SKIPL BYTM ;IN BYTE MODE? + TDZA A,A ;NO, CLEAR ABS PART OF VALUE + HLLZ A,BYTWP ;YES, USE LH(BP) AS ABS PART + JRST CLBPOP + +$.H: (GLOETY)+SQUOZE 0,$. ;CURRENT LOCATION + OFFSET IN LOADER +$L.H: (GLOETY)+SQUOZE 0,$L. ;LOCATION BEING LOADED INTO BY LOADER, USED BY ABLOCK +$O.H: (GLOETY)+SQUOZE 0,$O. ;LOADER OFFSET +$R.H: (GLOEXT)+SQUOZE 0,$R. ;RELOCATION AS GLOBAL + +COLON: TLNN I,WRDF + TRNN I,SYL + ERA 'ILF ;COLON WITHIN STORAGE WORD OR NOT PRECEDED BY SYL + TRNN I,OPFLD+PSEUDF + TRNN I,LET + ERA 'ILT ;COLON WITHIN FIELD OR PSEUDO, OR SYL NOT NAME + TLNE FF,INDEFF + ERA 'CLI ;COLON WHEN LOCATION INDEFINITE + PUSHJ P,RCH ;GET NEXT CHAR + CAIN A,": ;IF NEXT CHAR ANOTHER COLON, + TLOA FF,SKILF ;THEN SET FLAG TO HALF-KILL + TLO I,UNRCHF ;NOT COLON, CAUSE IT TO BE RE-INPUT + MOVE T,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM + HLL T,BYTWP ;BYTE MODE, SET LEFT HALF OF VALUE TO LEFT HALF OF BYTE POINTER + ADD T,OFLOC ;ADD OFFSET + MOVEM T,WRD ;STORE RESULT AWAY FOR POSSIBLE PUNCHOUT + EXCH T,SYLOC ;NOW SET UP STUFF FOR ERROR PRINTOUT + MOVEM T,SYLOC1 + EXCH SYM,SYSYM + MOVEM SYM,SYSYM1 + MOVE SYM,SYSYM + MOVE A,CRLOC ;SET UP RELOCATION + ADD A,OFRLOC + MOVEM A,WRDRLC + CLEARM PARBIT ;SET FLAG SAYING COLON + SKIPN LDCCC + TRNE FF,GLOLOC + JRST GCOL1 ;LOCATION VIRTUAL OR IN LOAD TIME CONDITIONAL + PUSHJ P,ESDEF ;TRY FINDING CURRENT ENTRY IN ST + JRST EQL1A ;NOT ALREADY DEFINED +IFN CREFSW,XCT CRFLBL +COLON1: JRST .+1(A) + ERA 'MDT ;COMMON + ERA 'RES ;MACRO OR PSEUDO + JRST COLON4 ;SYM + JRST EQL1C ;LOCAL UNDEF + ERA 'MDT + ERA 'MDT + ERA 'MDT + ERA 'MDT + JRST EQL1D ;GLOBAL ENTRY + JRST EQL1E ;GLO EXIT + +COLON4: CAME B,WRD + JRST COL4E + PUSHJ P,GVSYM0 ;GET PREV. RELOC IN B. + CAME B,WRDRLC +COL4E: ERA 'MDT ;MDGS +CASSM1: JRST ASSEM1 + + ;COLON WHEN LOCATION VIRTUAL, OR IN LOAD TIME CONDITIONAL + +GCOL1: IFN CREFSW,XCT CRFLBL ;DEFINING ORDINARY SYM. + PUSHJ P,ESDEF ;FIND ITS SLOT IN ST + JRST EQL2 ;JUST LIKE EQG1 EXCEPT FOR ERROR MESSAGES. + JRST .+1(A) + + ERA 'MDT ;COMMON + ERA 'RES ;PSEUDO. + JRST EQL2 ;SYM. + JRST EQGUL ;LOCAL UNDEF. + ERA 'MDT ;VAR + ERA 'MDT + ERA 'MDT + ERA 'MDT + JRST EQL7 ;DEF GLO + JRST EQL8 ;UNDEF GLO. + + + ;PUNCH OUT "DEFINE SYM AS $." + +PDEFPT: MOVEI A,CDEFPT + PUSHJ P,P7X ;OUTPUT 7 THEN PDEFPT + JRST OUTSM0 ;OUTPUT SYM, WITHOUT BITS + + ;LOC, BLOCK, .= + +ALOC: PUSHJ P,ALOCRG ;LOC, GET ARG + ERSM 'USL ;IF UNDEFINED SYM IN LOC +ALOC1: SETZM SYLOC ;CLEAR OUT LOC OF LAST TAG + SETZM SYSYM ;CLEAR OUT LAST TAG SO ERROR MESSAGES DON'T PRINT OBSCENE INCREMENTS + TRZE LINK,400 ;GLOBALS IN ARG? + JRST ALOC2 ;YES + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF CURRENT LOCATION + SKIPGE B,CONTRL + TRNN B,DECREL ;(IN DEC FMT DON'T CLOBBER BKBUF) + HRRZM A,BKBUF ;ALSO STORE IN BKBUF IN CASE WANT TO OUTPUT NULL BLOCK + MOVEI A,LCEGLO ;=> RESET GLOBAL RELOCATION (BACK TO ORIGINAL NON-GLOBAL RELOCATION) + TLZE LINK,400000 ;IS CURRENT LOCATION NOW GLOBAL? + PUSHJ P,PLDCM ;YES, RESET IT + MOVE B,WRDRLC ;GET BACK NEW RELOCATION +ABLK2: TRO FF,LOCF ;INDICATE ABS LOC ASSGT, FORCE EBLK TO OUTPUT LOCATION TO STINK +ALOC2B: TRZE B,-2 ;NO BITS ALLOWED EXCEPT LOW ORDER + ERR 'LAI ;ILLEGAL RELOCATION ATTEMPTED IN LOCATION ASSIGNMENT + HRRZM B,CRLOC ;STORE NEW RELOCATION + SKIPGE CONTRL + JRST ASSEM1 ;DON'T BOTHER WITH REST IF ABS. + MOVEI B,2(B) ;LABS OR LREL + DPB B,[310700,,BKBUF] ;STORE NEW BLOCK TYPE + MOVEM B,CDATBC ;ALSO STORE AS NORMAL BLOCK TYPE +AOFSTX: TDNN LINK,[SETZ(SETZ)] ;ENTRY FROM AOFFSET, SKIP IF GLOLOC SHOULD BE SET + TRZA FF,GLOLOC ;CURRENT LOCATION PLUS OFFSET NOT GLOBAL, CLEAR FLAG + TRO FF,GLOLOC ;GLOBAL, SET FLAG + TRZ LINK,600 ;CLEAR OUT TEMPORARY FLAGS SO WON'T GET STORED IN GLOCTP + MOVEM LINK,GLOCTP ;STORE BACK STATUS FLAGS + JRST ASSEM1 + +PTEQ: PUSHJ P,ALOCRG ;.=, GET ARG + ERSM 'USP ;HE'LL FIGURE IT OUT + MOVE T,[MINF+HFWDF,,$O.H] ;GLOTB ENTRY IF .+1 DOESN'T SKIP + TRNE LINK,400000 ;OFFSET GLOBAL? + JRST PTEQ2 ;YES, WANT TO DO LOC ARG-$O." + PUSHJ P,SBWDOF ;OFFSET IS LOCAL, SUBTRACT FROM ARG + JRST ALOC1 + +ABLOCK: PUSHJ P,ABLKRG ;BLOCK, GET ARG + ERSM 'USB ;UNDEFINED SYM IN BLOCK + TRNE LINK,400 ;GLOBALS IN ARG? + JRST ABLKG ;GLOBALS IN ARG + TLNE LINK,400000 + JUMPN B,ABLKG ;JUMP IF LOSER CHANGING RELOCATION WHILE CLOC GLOBAL + ADD A,CLOC ;ARG TO BLOCK IS LOCAL, ADD DIRECTLY TO CLOC + ADD B,CRLOC ;ALSO ADD RELOCATIONS + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF LOCATION + JRST ABLK2 ;FALL INTO ALOC ROUTINE, MAKING SURE LOCF GETS SET + +SBWDOF: SUB A,OFLOC ;SUBTRACT OFFSET FROM WRD, ETC. IN A,B + HRRZM A,WRD ;MAKE SURE RESULT GETS STORED IN WRD, AS WELL AS AC'S + SUB B,OFRLOC ;NOW DO RELOCATIONS + HRRZM B,WRDRLC + POPJ P, + +ABLKG: TRNE LINK,400000 ;GLOBAL BLOCK, IS OFFSET GLOBAL? + JRST ABLKG2 ;YES, OK TO REFERENCE $L. + PUSHJ P,SBWDOF ;NO, FOR COMPATIBILITY, DON'T REFERENCE $L. + SKIPA T,[HFWDF,,$.H] +ABLKG2: MOVE T,[HFWDF,,$L.H] +PTEQ2: AOS GLSP1 ;STORE T IN GLOTB + MOVEM T,@GLSP1 +ALOC2: TLO LINK,400000 ;SET GLOBAL LOCATION FLAG + MOVEI A,LCGLO ;=> GLOBAL LOCATION ASSIGNMENT + PUSHJ P,PLDCM ;PUNCH OUT GLOBAL LOCATION ASSIGNMENT + SETZM CLOC ;CLEAR OUT CLOC, NEW RELOCATION NOW + SETZB B,BKBUF ;ALSO CLEAR OUT HEADER, JUST TO BE SURE + AOJA B,ALOC2B ;SET RELOCATION TO 1 AND FALL IN + + ;GET ARG TO LOC, BLOCK, .=, OFFSET + +ALOCRG: TLZ FF,INDEFF ;THIS SHOULD BE IMPROVED SOMETIME +ABLKRG: SKIPN CRLOC ;IF ADDR. BEFORE LOC WAS RELOC, + JRST ABLKR1 + MOVE A,CLOC + CAML A,DECBRK ;USE IT TO UPDATE THE MAX. RELOC. ADDR. SEEN. + MOVEM A,DECBRK +ABLKR1: PUSHJ P,CONBAD ;ERROR IF IN LITERAL. + MOVEI A,", ;CALLED WITH PUSHJ, FOLLOWED BY INSTR EXECUTED IF UNDEFINED + MOVEM A,LIMBO1 ;START OFF WITH COMMA TO TRUNCATE TO HALFWORD (BLETCH!) + TLO I,UNRCHF ;CAUSE IT TO BE (RE)INPUT +AOFFS2: MOVE A,@(P) ;ENTRY FROM AOFFSET, GET ERROR ARG + MOVEM A,GTVER + TRO I,PSEUDF\DEF + PUSHJ P,EBLK ;MAYBE END CURRENT OUTPUT BLOCK + PUSHJ P,GETWRD ;GET ARG + MOVE LINK,GLOCTP ;GET GLOCTP FLAGS IN LINK, STAYS THERE UNTIL ALMOST DONE + MOVE T,GLSP2 + CAME T,GLSP1 + TROA LINK,400 ;SIGNAL GLOBAL ARG + TRZ LINK,400 ;LOCAL + TRNE I,DEF ;ALL DEFINED? + JRST POPJ1 ;YES, RETURN SKIPPING OVER ARG + TLO FF,INDEFF ;LOCATION := INDEFINITE + MOVE A,[SQUOZE 0,INDEFF] + MOVEM A,SYSYM + MOVE A,CLOC + MOVEM A,SYLOC + JRST ASSEM1 + +AOFFSET: PUSHJ P,AOFFS2 ;OFFSET, GET ARG + ERSM 'USO ;UNDEFINED SYMBOL IN OFFSET + TRZE LINK,400 ;GLOBALS IN ARG? + TROA LINK,400000 ;GLOBALS IN ARG, SET GLOBAL OFFSET FLAG + TRZ LINK,400000 ;NO GLOBALS IN ARG + MOVEM A,OFLOC ;STORE NEW OFFSET + MOVEM B,OFRLOC ;ALSO STORE RELOCATION BITS + SKIPGE CONTRL ;IN RELOCATABLE, + JRST AOFSTX + MOVEI A,LDOFS ;LOADER OFFSET LOADER COMMAND TYPE + PUSHJ P,PLDCM ;PUNCH OUT LOADER COMMAND + JRST AOFSTX + +;;CONSTANTS AND VARIABLES + ;VARIABLES AREA +VBLK +BLCODE [CONBIT: BLOCK LCONTB/12.+1 ;RELOCATION BITS AND NOOPTF BIT(SEE CPTMK) +CONTAB: BLOCK LCONTB ;CONSTANTS TABLE, VALUES OF CONSTANTS THIS CONSTANTS AREA +CONGLO: BLOCK LCNGLO ;CONSTANTS GLOBAL TABLE + ;EACH ENTRY TWO WORDS + ;FIRST WORD GLOTB ENTRY + ;SECOND ADR IN CONTAB OF CONSTANT TO WHICH IT REFERS +PCNTB: BLOCK NCONS*3 ;CONSTANTS AREAS TABLE +VARTAB: BLOCK NVARS +] +PLIM: 0 ;POINTER TO TOP OF CONTAB, HAS ADR OF FIRST UNUSED WORD +CONGOL: 0 ;HAS ADR OF FIRST WORD INACTIVE IN CONGLO + + ;PCNTB STUFF + + ;EACH ENTRY 3 WORDS; FIRST WORD SQUOZE, NAME OF AREA IF GLOBAL +CSQZ: 0 ;SQUOZE COUNTER + ;SECOND WORD RH LOC OF AREA (WITH OFFSET), LH LOC FIRST AFTER AREA (WITHOUT OFFSET) + ;THIRD WORD LH FLAGS + +CGBAL==100000 ;GLOBAL (INCLUDING OFFSET) +CTRL==200000 ;RELOCATED ( " ) +CTDEF==400000 ;DEFINED (MUST BE SIGN) + +PBCON: 0 ;POINTER INTO PCNTB, HAS ADR OF ENTRY FOR NEXT CONSTA +PBCONL: 0 ;POINTER TO ABSOLUTE TOP OF PCNTB +CONCNT: 0 ;NUMBER OF TIMES CONSTANTS CAN APPEAR (DECREMENTED BY CONSTA) +CONDEP: 0 ;DEPTH IN CONSTANTS (0 TOP LEVEL) +CONSAD: 0 ;ADDR IN CONTAB OF ENTRY FOR CURRENT CONST. +CONSML: 0 ;VALUE OF .MLLIT INTSYM. + ;NEGATIVE => ERROR MODE (DEFAULT) + ;ZERO => OLD MODE. + ;POSITIVE => NEW (MULTI-LINE) MODE. + +CONSTP: 0 ;PDL POINTER BELOW WDS FOR INNERMOST CONSTANT. +CONEND: 0 ;SET BY RBRAK TO FORCE END OF CONSTANT. + + ;VARIABLES FOR VARIABLES CODING + +VARCNT: 0 ;NO OF VAR IN CURRENT VAR AREA SO FAR +VARPNT: 0 ;POINTER TO CURRENT PLACE IN VARTAB +VARCNR: 0 ;NO OF TIMES VARIABLES MAY APPEAR +VCLOC: 0 ;TEM FOR VARIAB + +PBLK + +;LEFT-BRACKET ENCOUNTERED; HERE ON DISPATCH FROM GETFD +;SAVE WORLD, BYTE MODE, ASSEM1 PDL LEVELS. +;THEN SET ASSEM1 PDL LEVELS TO CURRENT LEVELS +;SO ASSEM1 WON'T FLUSH PAST LEVEL OF CONSTANT. +;SET CONSTP _ CURRENT PDL LEVEL. PCONS WILL PUT WORDS +;OF CONSTANT ABOVE CONSTP, AND SET ASSEMP ABOVE THEM. + +LBRAK: TRO I,FLD ;LEFT BRACKET + JSP LINK,SAVWD1 ;SAVE CRUFT + AOS CONDEP ;ONE DEEPER IN CONSTANTS + PUSH P,SCNDEP ;SO THE NEXT RBRKT WON'T TRY TO CLOSE CONDIT. + SETZM SCNDEP + SKIPN BYTM ;IF IN BYTM NOW (WILL PUSH AND TURN OFF) + JRST LBRAK1 + MOVSI A,BYBYT ;SAVE ALL THE DETAILS. + HRRI A,1(P) + ADD P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] + JUMPGE P,[ERF 'PDL] + BLT A,-BYTMCL(P) + MOVSI A,BYTMC + HRRI A,1-BYTMCL(P) + BLT A,(P) +LBRAK1: PUSH P,BYTM + SETZM BYTM + PUSH P,PPRIME + PUSH P,GLSPAS ;SAVE ASSEM1 PDL LEVELS. + PUSH P,ASSEMP + PUSH P,CONSTP + MOVEM P,ASSEMP ;SO ASSEM1 WON'T FLUSH WHAT WE PUSHED. + MOVEM P,CONSTP ;SO CONND CAN FIND 1ST WD OF CONSTANT. + MOVEMM GLSPAS,GLSP1 + JRST ASSEM3 ;GO ASSEMBLE THE WORDS OF THE CONSTANT. + +;OUTPUT WORD TO CONSTANT. P MUST EQUAL ASSEMP HERE. +PCONS: SKIPL CONTRL ;IF RELOCATABLE, + PUSHJ P,$RSET ;HANDLE STRANGE RELOCATIONS. + MOVE B,GLSP1 + SUB B,GLSP2 ;NUM. GLOBAL ENTRIES FOR THIS WD. + HLRZ A,WRDRLC ;ONLY 1.1 AND 3.1 BITS MATTER. + LSH A,1 + IOR A,WRDRLC ;GET THEM INTO 1.1, 1.2 BITS. + TLNE I,NOOPTF ;REMEMBER NOOPTF ALSO. + IORI A,4 + DPB B,[032200,,A] ;AND # GLBLS. + PUSH P,A ;SAVE THEM ALL. + HRLI B,(B) ;GET # GLBLS,,# GLBLS . + JUMPE B,PCONS1 + MOVE A,GLSP2 + MOVSI A,1(A) + HRRI A,1(P) ;SAVE THE GLBLS, IF ANY. + ADD P,B + JUMPGE P,[ERF 'PDL] + BLT A,(P) +PCONS1: PUSH P,WRD + MOVEM P,ASSEMP ;ASSEMP -> ABOVE WDS FOR LIT.; CONSTP, BELOW. + JRST (T) + +PCONST: SKIPE CONEND ;OUTPUT TO CONST. FROM ASSEM1; LAST WD OF CONST? + CAME P,CONSTP ;1ST WD? + JRST PCONS ;NO, DO THE GENERAL THING. + SKIPL CONTRL ;THIS MUST BE ONLY WORD OF CONST, + PUSHJ P,$RSET ;DON'T BOTHER PUSHING, END CONST. NOW. + PUSH P,CONSTP + TLZ I,MWRD+MWRD1 ;THIS IS 1ST WD, NO MORE WDS. + JRST CONND3 ;PRETEND JUST POPPED IT. + +;COME HERE FROM ASSEM1 TO END A CONSTANT. +CONND: SKIPE BYTM ;IF IN BYTE MODE, LEAVE IT AND DO .WALGN + JRST A.BY3 ;(WILL COME BACK SINCE RBRKTF STILL SET) +CONNDW: PUSH P,CONSTP ;CONSTP WILL POINT TO NEXT WD OF CONST. + TLZ I,MWRD1 ;THIS IS 1ST WORD COMING UP. +CONND0: TLZ I,MWRD+NOOPTF + SETZM WRDRLC + MOVE F,CONSTP ;ADDR IN IN PDL OF NEXT WD. + CAMN F,ASSEMP + JRST CONND2 ;J IF NO WORDS. + MOVE A,1(F) ;GET SAVED NUM GLBLS,,NUM GLBLS + DPB A,[100,,WRDRLC] + LSH A,-1 ;RESTORE WRDRLC BITS 1.1, 3.1 + DPB A,[220100,,WRDRLC] + TRNE A,2 + TLO I,NOOPTF ;RESTORE NOOPTF. + LSH A,-2 ;GET # GLBLS. + HRLI A,(A) ;# GLBLS,,# GLBLS. + AOBJN F,.+1 + HRRZM F,GLSP2 ;ADDR BEFORE 1ST GLOBAL ENTRY. + ADD F,A + HRRZM F,GLSP1 ;ADDR OF LAST GLOBAL ENTRY. + MOVE A,1(F) + MOVEM A,WRD + AOBJN F,.+1 ;POINT TO NEXT CONST WD IF ANY, + MOVEM F,CONSTP + CAME F,ASSEMP ;IF MORE WORDS SET MWRD + TLO I,MWRD + JRST CONND3 + +CONND2: INSIRP SETZM,[WRD,GLSP1,GLSP2] +CONND3: MOVE F,GLSP1 + SUB F,GLSP2 + JUMPE F,SCON ;JUMP IF NOTHING VIRTUAL + MOVEI B,-1(F) + MOVN TT,B + JUMPE B,SCON ;JUMP IF ONLY ONE GLOBAL + ;SORT GLOTB ENTRIES THIS CONSTANT +LSORT: HRL T,TT ;SET UP AOBJN POINTER TO GLOBALS REMAINING + HRR T,GLSP2 +LSORT2: MOVE A,1(T) + CAMLE A,2(T) + EXCH A,2(T) ;INTERCHANGE + MOVEM A,1(T) + AOBJN T,LSORT2 ;INNER LOOP POINT + SOJG B,LSORT ;OUTER LOOP + ;DROPS THROUGH + + ;DROPS THROUGH +SCON: PUSHJ P,RCHKT + PUSHJ P,RMOVET ;SET UP RELOACTION BITS. + ROT T,2 ;ROTATE TO BOTTOM TWO BITS OF T + TLNE I,MWRD+MWRD1+NOOPTF + JRST NOCON ;MULTIPLE WORD OR OPTIMIZATION SUPPRESSED, DON'T TRY TO FIND MATCH + MOVEI A,CONTAB +SCON1: CAML A,PLIM ;SEARCH CONTAB TO SEE IF ALREADY THERE + JRST NOCON ;END OF TABLE, NO MATCH + MOVE B,WRD + CAME B,(A) +SCON2: AOJA A,SCON1 ;VAL DISAGREES + PUSHJ P,CPTMK ;GET BP TO CONBIT TABLE IN C + LDB F,C ;GET RELOCATION BITS THIS CONSTANT + CAME F,T + JRST SCON2 ;RLC DIFFRS + MOVEI B,CONGLO ;VALUE AND RELOCATION AGREE, NOW TO CHECK GLOBALS + SKIPA C,GLSP2 +SCON2B: AOS B ;SEARCH FOR GLOBAL POINTING TO CONSTANT WHICH HAS MATCHED SO FAR + CAML B,CONGOL + JRST SCON3 ;GLOBALS MATCH SO FAR + CAME A,1(B) ;SKIP IF ONE FOUND +SCON7: AOJA B,SCON2B ;NOT YET + MOVE D,(B) ;FOUND ONE, GET GLOTB ENTRY + CAME D,1(C) ;COMPARE WITH THIS ENTRY IN GLOTB + JRST SCON2 ;NO MATCH, FLUSH THIS CONSTANT + AOJA C,SCON7 ;MATCH, TRY NEXT GLOBAL + +SCON3: CAME C,GLSP1 ;GLOBALS MATCH, BUT ARE WE EXACTLY AT END OF GLOTB? + JRST SCON2 ;NO, BACK TO SEARCH + JRST NOCON4 + NOCON: AOS A,PLIM ;CONSTANT NOT ALREADY IN TABLE + CAILE A,CONTAB+LCONTB + ERF 'TMC + MOVE AA,WRD + MOVEM AA,-1(A) + SOS A + PUSHJ P,CPTMK + TLNE I,NOOPTF + TRO T,4 ;1.3 OF RELOCATION BITS => DON'T OPTIMIZE ON TOP OF ME + DPB T,C + MOVE B,GLSP2 +NOCON3: CAML B,GLSP1 + JRST NOCON4 + SKIPN C,1(B) + AOJA B,NOCON3 ;THIS ENTRY NOT REALLY HERE + MOVEM C,@CONGOL + HRRZS C + PUSHJ P,NOCON5 + MOVEM A,@CONGOL + PUSHJ P,NOCON5 + SKPST C, ;SKIP IF IN SYMBOL TABLE + AOJA B,NOCON3 + 3GET1 D,C ;IN SYMBOL TABLE + TLO D,3VCNT ;THIS SYM USED IN CONSTANT + 3PUT1 D,C ;UPDATE 3RDWRD TABLE ENTRY + AOJA B,NOCON3 + +NOCON5: AOS AA,CONGOL + CAIL AA,CONGLO+LCNGLO + ERF 'TMC ;TOO MANY CONSTANT GLOBAL REFERENCES + POPJ P, + + ;SET UP BYTE POINTER TO CONBIT TABLE + ;A SHOULD HAVE ADR OF CONTAB ENTRY + ;LEAVES ANSWER IN C + ;BITS IN CONBIT TABLE PER ENTRY: + ;1.2, 1.1 RELOCATION BITS + ;1.3 NOOPTF BIT => DON'T OPTIMIZE ON TOP OF ME + +CPTMK: PUSH P,A + SUBI A,CONTAB + PUSH P,B + IDIVI A,12. + MOVEI C,CONBIT(A) ;SET UP ADDRESS PART + IMULI B,3 + DPB B,[360600,,C] ;STORE POSITION FIELD FROM REMAINDER + TLO C,200 ;SET UP SIZE FIELD + POP P,B + JRST POPAJ + NOCON4: TLON I,MWRD1 + MOVEM A,CONSAD ;IF 1ST WD SAVE ADDR. + TLNE I,MWRD ;IF MORE WORDS, HANDLE NEXT. + JRST CONND0 + MOVE P,(P) ;VALUE OF CONSTP AT CONND. + MOVE C,GLSPAS ;TO RESTORE GLSP1 + JSP T,CONNDP ;POP STUFF. + HRRZ A,CONSAD ;ADDR OF CONTAB ENTRY OF 1ST WD. + MOVE B,PBCON ;ADDR OF WDS DESCRIBING CONST. AREA. + SKIPL 2(B) ;CONST. AREA LOCATION DEFINITE? + AOJA C,CONND6 ;NO, USE GLOBAL. + MOVEM C,GLSP1 + HRRZ C,1(B) ;ADD ACTUAL ADDR OF CONST. AREA. + ADDI A,(C) ;GET CONTAB + ADDR OF CONSTANT. + LDB B,[420100,,2(B)] + JRST CONND7 + +CONND6: MOVEM C,GLSP1 + MOVEM B,(C) + MOVEI B,0 +CONND7: SUBI A,CONTAB + JRST LSSTH3 ;POP OUT INTO OUTER WORD. + +CONNDP: INSIRP POP P,[CONSTP,ASSEMP,GLSPAS,PPRIME,BYTM] + SKIPN BYTM ;IF IN BYTE MODE, POP DETAILS. + JRST CONND5 + MOVSI A,1-BYTMCL(P) + HRRI A,BYTMC + BLT A,BYTMC+BYTMCL-1 + MOVSI A,1-BYTMCL-LBYBYT(P) + HRRI A,BYBYT + BLT A,BYBYT+LBYBYT-1 + SUB P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] +CONND5: POP P,A + ADDM A,SCNDEP ;DON'T FORGET ABOUT ANY CONDITIONALS. + SOS CONDEP ;HAVE POPPED ONE CONSTANT. + SETZM CONEND + JRST (T) + +CONFLA: SKIPGE CONSML ;FLUSH CONSTANTS, IN ERROR MODE ERROR IF ANY. + SKIPN CONDEP + CAIA ;[ +CONFLM: ERR (SIXBIT/NO]/) +CONFLS: MOVE P,ASSEMP ;FLUSH ALL CONSTANTS. + SKIPN CONDEP ;IF IN ANY, + JRST (LINK) + MOVE P,CONSTP ;POINT AFTER ITS PDL ENTRY, + JSP T,CONNDP ;POP IT, + JRST CONFLS ;TRY AGAIN. + +CONBAD: SKIPN CONDEP ;IF IN CONSTANT, ERROR. + POPJ P, + ERSM 'IPC + JRST ASSEM1 + + ;CONSTA + +CNSTNT: SKIPE CONDEP ;IF ANY CONSTANTS, + JSP LINK,CONFLM ;FLUSH THEM, GIVE ERROR. + PUSH P,CASSM1 ;CAUSE RETURN TO ASSEM1 +CNSTN0: SOSGE CONCNT ;ENTRY FROM AEND + ERF 'TCA ;TOO MANY CONSTANTS AREAS + MOVE B,CLOC + ADD B,OFLOC + HRRZ T,PBCON + TRNN FF,PSS + JRST CNST1 ;PASS 1 + + MOVSI A,CGBAL + TDZ A,2(T) + TRNE FF,GLOLOC + TLC A,CGBAL + SKIPN A + ERR 'CVD + HRRZ B,1(T) + SUB B,OFLOC + HRRZS B + CAME B,CLOC + ERR 'CLD + MOVE B,2(T) + ROT B,2 + XOR B,CRLOC + XOR B,OFRLOC + TRNE B,1 + ERR 'CRD + ;DROPS THROUGH + + ;DROPS THROUGH +CNST2: MOVEI D,(T) ;STE IDX IN D FOR OUTSM0 + MOVE SYM,(T) ;GET NAME OF AREA + TLC SYM,400000#LCUDF ;CLEAR LCUDF, SET HALF-KILL + TRNE FF,GLOLOC + PUSHJ P,PDEFPT ;DEFINE SYM FOR BEGINNING OF CONSTANTS AREA + MOVEI A,CONTAB +CNSTH: CAML A,PLIM + JRST CNSTA ;THRU + MOVE TT,(A) + MOVEM TT,WRD + PUSHJ P,CPTMK + LDB F,C ;GET THIS CONSTANT'S RELOCATION BITS + TRZE F,2 + TLO F,1 ;RELOCATE LEFT HALF + MOVEM F,WRDRLC ;STORE RELOCATION + MOVEI D,GLOTB ;AND NOW TO SET UP GLOTB! + MOVEM D,GLSP2 + MOVEI C,CONGLO +CNSTC: CAML C,CONGOL + JRST CNSTB ;END OF CONGLO + CAMN A,1(C) ;POINTS TO THIS CONSTANT? + PUSH D,(C) ;YES, STORE ENTRY IN GLOTB + AOS C + AOJA C,CNSTC + +CNSTB: HRRZM D,GLSP1 ;MARK END OF ACTIVE PART OF GLOTB + PUSH P,A + PUSHJ P,PWRD ;OUTPUT THIS CONSTANT + AOS CLOC ;INCREMENT CLOC TO NEXT + HRRZS CLOC ;MAKE SURE IT STAYS IN A HALF-WORD (IMPORTANT SINCE MAY BE LESS THAN RELOCATION) + POP P,A ;RESTORE POINTER INTO CONTAB + AOJA A,CNSTH + +CNST3: HLRZ A,1(T) ;GET POINTER TO TOP OF AREA STORED DURING PASS 1 + CAMN A,CLOC ;SAME AS CURRENT? + JRST CNSTE ;YES, NO HAIR + CAMGE A,CLOC ;DIFFERENT; LOWER? + ERR 'ICS ;INSUFFICIENT CONSTANT SPACE; CONSTANTS AREA TRYING TO BE BIGGER + ;IN PASS 2 THAN PASS 1; THE EXTRA CONSTANTS WERE BACKED OVER + MOVEM A,CLOC ;EITHER WAY, SET CLOC TO TOP OF AREA SO WON'T HAVE MDT TROUBLE + PUSHJ P,EBLK ;END CURRENT BLOCK + TRO FF,LOCF ;IF RELOCATABLE, MAKE SURE NEW VALUE OF $. GETS PUNCHED + JRST CNSTE + + ;CONSTA DURING PASS 1 + +CNST1: HRRM B,1(T) ;STORE LOCATION OF AREA + MOVEI D,0 + MOVE A,CRLOC + ADD A,OFRLOC + TRNE A,1 + TLO D,CTRL ;RELOCATED + TRNE FF,GLOLOC + TLO D,CGBAL ;GLOBAL + IORM D,2(T) ;STORE FLAGS DESCRIBING AREA + JUMPL FF,CNST2 ;JUMP ON PUNCHING PASS, PUNCH OUT AREA NOW + MOVE T,PLIM + SUBI T,CONTAB + ADDM T,CLOC ;PASS 1, JUST UPDATE CLOC + HRRZS CLOC + +CNSTA: HRRZ T,PBCON + TRNE FF,GLOLOC + JRST CNSTD ;LOCATION GLOBAL + TRNN FF,NPSS + SKIPGE 2(T) + JRST CNSTDA ;2 PASS ASSEMBLY OR AREA DEFINED + TRO I,CONT ;1PASS AND NOT DEFINED + SETZM PARBIT + PUSHJ P,P70 ;DEFINE SYM + MOVE A,(T) + TLC A,400000#LCUDF + SKIPE CRLOC + TLO A,100000 ;RELOCATE + PUSHJ P,OUTPUT + HRRZ A,1(T) + PUSHJ P,OUTPUT ;OUTPUT VALUE, FIRST LOCATION IN AREA + TRZ I,CONT +CNSTDA: MOVSI A,CTDEF + IORM A,2(T) ;CALL IT DEFINED +CNSTD: TRNE FF,PSS + JRST CNST3 ;PASS 2 + MOVE A,CLOC + HRLM A,1(T) ;MARK END OF AREA + +CNSTE: MOVEI A,CONTAB + MOVEM A,PLIM + MOVEI A,CONGLO + MOVEM A,CONGOL + MOVEI T,3 + ADDB T,PBCON + CAML T,PBCONL + MOVEM T,PBCONL + AOS A,CSQZ + MOVEM A,(T) + POPJ P, + + ;DEFINING SYM USED IN CONSTANT, DELETE REFERENCES FROM CONGLO TABLE + +CONBUG: MOVEI A,CONGLO ;B VAL C FLAGS ST(D) SADR + PUSH P,T + PUSH P,C ;SAVE FLAGS +CONBG2: MOVE C,(P) ;GET FLAGS + CAML A,CONGOL ;DONE WITH SCAN? + JRST CONBG1 ;YES + HRRZ F,(A) ;NO, GET CONGLO ENTRY + CAIE F,ST(D) ;POINT TO THIS SYM? + AOJA A,CONBG6 + PUSH P,B ;YES, SAVE VALUE, ABOUT TO WORK WITH B + MOVE T,(A) ;GET ENTIRE CONGLO ENTRY + LDB CH2,[221200,,T] ;GET MULTIPLICATION FIELD + SKIPE CH2 + IMUL B,CH2 ;NON-ZERO => MULTIPLY VALUE OF SYM + TLNE T,MINF + MOVNS B ;NEGATE VALUE + TLNE T,HFWDF + HRRZS B ;TRUNCATE TO HALFWORD + TLNE T,ACF + ANDI B,17 ;AC, MASK TO FOUR BITS + TLNE T,SWAPF + MOVSS B ;SWAP VALUE + TLNE T,ACF + LSH B,5 ;AC, SHIFT FIVE + ADD B,@1(A) ;ADD ABS PART OF VALUE + TLNN T,SWAPF + HRRM B,@1(A) ;NOT SWAPPED, STORE LH + TLNE T,SWAPF + HLLM B,@1(A) ;SWAPPED, STORE LH + TLNN T,HFWDF + MOVEM B,@1(A) ;FULL WORD, STORE VALUE + LDB CH1,[420200+P,,-1] ;GET HIGH BITS OF 3RDWRD, RELOCATION BITS + TLNE T,HFWDF ;NOW TO MAP RELOCATION BITS + TRZ CH1,2 + TLNE T,SWAPF + LSH CH1,1 + TRZE CH1,4 + TRO CH1,1 + PUSH P,A + HRRZ A,1(A) ;GET POINTER INTO CONTAB + PUSHJ P,CPTMK + LDB B,C ;GET RELOCATION BITS + TLNE T,MINF + JRST CONBG8 ;NEGATE + TRNE B,(CH1) + ERA 'CRI ;ATTEMPTED MULTIPLE RELOCATION IN CONSTANT + ; ^ ABOVE SHOULD BE REPLACED WITH A $RSET LIKE ROUTINE + ;THAT ALSO SEARCHES CONGLO FOR $R. ALREADY THERE + IOR B,CH1 ;LOOKS OK, IOR IN BITS FOR GLOBAL +CONB8A: DPB B,C ;STORE BACK NEW RELOCATION BITS FOR CONSTANT + POP P,A + CLEARM (A) ;CLEAR OUT CONGLO ENTRY + CLEARM 1(A) + POP P,B + AOS A +CONBG6: AOJA A,CONBG2 ;BACK FOR NEXT CONSTANT, DON'T KNOW HOW MANY THIS SYM USED IN + +CONBG1: MOVEI A,CONGLO + PUSH P,B + MOVEI B,CONGLO +CONBG7: CAML A,CONGOL + JRST CONBG3 + SKIPN C,(A) +CONBG5: AOJA A,CONBG4 + MOVEM C,(B) + MOVE C,1(A) + MOVEM C,1(B) + AOS B + AOJA B,CONBG5 + +CONBG4: AOJA A,CONBG7 +CONBG3: MOVEM B,CONGOL + POP P,B + POP P,C + POP P,T + POPJ P, +CONBG8: XORI B,3 + TRNE B,(CH1) + ERA 'CRI + ANDCB B,CH1 + JRST CONB8A + + ;VARIAB + +AVARIAB: PUSH P,CASSM1 ;RETURN TO ASSEM1 +AVARI0: SOSG VARCNR ;ENTRY FROM AEND + ERF 'TVA ;TOO MANY VARIABLE AREAS + MOVE D,SYMAOB ;SET UP AOBJN POINTER TO ST + MOVE T,CLOC + MOVEM T,VCLOC ;STORE AS LOCATION OF VARIABLE AREA + ADD T,OFLOC + MOVE C,CRLOC + ADD C,OFRLOC + TRNE FF,PSS + JRST AVAR1 ;PASS 2 + HRL T,VARCNT ;SIZE OF AREA + TRNE C,1 + TLO T,400000 ;RELOCATED + MOVEM T,@VARPNT + JRST AVAR2 + +AVAR1: HRRZ A,@VARPNT ;VARIAB DURING PASS 2 + CAIE A,(T) + ERR 'VLD + HLRZ A,@VARPNT + TRZE A,400000 + XORI C,1 + TRNE C,1 + ERR 'VRD + SKIPE VARCNT + ERR 'VND + +AVAR2: 3GET C,D + MOVE B,ST+1(D) + MOVE SYM,ST(D) + TLZ SYM,740000 + LDB LINK,[400400,,ST(D)] + CAIE LINK,UDEFLV_-14. + CAIN LINK,UDEFGV_-14. + JRST AVAR3 ;UNDEFINED VARIABLE + CAIE LINK,DEFGVR_-14. + CAIN LINK,DEFLVR_-14. + JRST AVAR4 ;DEFINED VARIABLE +AVAR2A: ADDI D,WPS-1 + AOBJN D,AVAR2 ;CHECK ENTIRE SYMTAB + HLRZ A,@VARPNT ;NOW GET SIZE OF AREA + TRZ A,400000 ;CLEAR OUT RELOCATION CHECK BIT + ADD A,VCLOC ;ADD LOCATION OF BEGINNING OF VARIABLE AREA + MOVEM A,CLOC ;STORE AS NEW CURRENT LOCATION + PUSHJ P,EBLK + TRO FF,LOCF + CLEARM VARCNT ;INITIALIZE COUNT OF VARIABLES IN NEXT AREA + AOS VARPNT ;INCREMENT POINTER TO POINT TO NEXT AREA + POPJ P, + + ;UNDEFINED VARIABLE FOUND IN SYMTAB SCAN + +AVAR3: CAIN LINK,UDEFGV_-14. ;GLOBAL? + TLO SYM,40000 ;GLOBAL + PUSHJ P,LKPNRO + MOVSI T,DEFLVR + CAIN LINK,UDEFGV_-14. + MOVSI T,DEFGVR + TRNE FF,GLOLOC + JRST AVAR3A ;LOCATION GLOBAL + MOVEI B,-1(B) + ADD B,VCLOC + ADD B,OFLOC + MOVE TT,CRLOC + ADD TT,OFRLOC + SKIPE TT + TLO C,3RLR + CAIE LINK,UDEFGV_-14. + TLZN C,3VCNT + SKIPA + PUSHJ P,CONBUG +AVAR4B: PUSHJ P,VSM2 + JUMPGE FF,AVAR2A ;IF PUNCHING PASS, OUTPUT DEFINITION. + PUSHJ P,OUTDE2 + JRST AVAR2A + +AVAR4: TLNE C,3VAS2 ;DEFINED VARIABLE FOUND DURING SYMTAB SCAN + TLOE C,3VP + JRST AVAR2A + MOVSI T,(LINK) ;CAUSE AVAR4B TO REDEFINE AS SAME TYPE. + LSH T,14. + TRNN FF,GLOLOC + JRST AVAR4A +AVAR3A: PUSHJ P,VSM2LV + JUMPGE FF,AVAR2A + PUSHJ P,PDEFPT + MOVEI A,0 + PUSHJ P,PBITS + PUSHJ P,OUTPUT + AOS CLOC + JRST AVAR2A + +AVAR4A: CAIN LINK,DEFGVR_-14. ;DEF VAR, 3VAS2, POINT NOT GLOBAL. + JRST AVAR4B ;VAR GLOBAL, MUST PUNCH DEF SINCE DIDN'T ON PASS1. + 3PUT C,D ;LOCAL, JUST SET 3VP SO DON'T SEE IT NEXT VARIAB. + JRST AVAR2A ;NO NEED TO PUNCH DEF SINCE WAS DEF ON PASS1. + +;;MAIN ;"MAIN" MIDAS ROUTINES: INIT, PS1, PLOD, PS2, PSYMS + ;ALL CALLED WITH JSP A,; ALL GLOBAL + ;RETURN INSTRUCTION FROM JSP IN LOCATION RETURN + +PS1": HRRM A,RETURN ;PASS 1, (PASS 1 INITIALIZATION ALREADY DONE), SAVE RETURN +IFN A1PSW,[SKIPL PRGC + JRST A1PAS1 ;THIS NOT FIRST PROGRAM THIS ASSEMBLY, SET MODE TO 1PASS +] JRST SIMBLK ;SELECT SBLK AND ASSEMBLE + +PS2": HRRM A,RETURN ;PASS 2 (MAIN ROUTINE, PASS 2 INITIALIZATION NOT ALREADY DONE), SAVE RETURN + JUMPL FF,PA2A ;JUMP IF PASS 1 ENDED IN 1PASS MODE + TDO FF,[PPSS,,PSS] ;SET PUNCHING PASS AND PASS 2 FLAGS + TRZ FF,GLOLOC ;RE-INITIALIZINT CURRENT LOCATION, CLEAR GLOBAL LOCATION FLAG + PUSHJ P,P2INI ;INITIALIZE + JRST ASSEM1 ;START ASSEMBLING + +PA2A: MOVE A,SYMAOB ;PASS 2 OF 1PASS ASSEMBLY, CHECK FOR UNDEFINED LOCALS +PA2C: MOVE SYM,ST(A) ;GET SQUOZE THIS SYMTAB ENTRY + LDB B,[400400,,SYM] ;GET FLAGS + CAIE B,LCUDF_-14. ;LOCAL UNDEFINED? + JRST PA2B ;NOT LOCAL UNDEFINED, DON'T COMPLAIN + 3GET C,A ;LOCAL UNDEFINED, GET 3RDWRD ST ENTRY + TLZ SYM,740000 ;CLEAR OUT FLAGS IN SYM IN ANTICIPATION OF TYPING OUT COMPLAINT + TLNN C,3LLV ;PROBLEM HANDED TO LINKING LOADER? + ERSM 'USW ;NO, JUST PLAIN UNDEFINED +PA2B: ADDI A,WPS-1 ;NOW GO FOR NEXT ST ENTRY + AOBJN A,PA2C + JRST RETURN + +INIT": HRRM A,RETURN ;INITIALIZATION (BEFORE PASS 1 ONLY) ROUTINE, SAVE RETURN POINT +IFN CREFSW,PUSHJ P,CRFOFF ;DON'T CREF ON 1ST PASS. + SKIPGE ISYMF + JRST INIT1 ;SPREAD SYMS (RETURNS TO SP4) + MOVE A,SYMAOB ;ALREADY SPREAD, JUST FLUSH ALL BUT INITIAL SYMS +INIT4: SKIPN B,ST(A) + JRST INIT2 + 3GET C,A + TLNN C,3INI ;INITIAL SYM? + CLEARM ST(A) ;NO +INIT2: AOS A + AOBJN A,INIT4 + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1] + BLT A,EBKCOD ;CLEAR OUT BLANK CODE + +SP4: PUSH P,CRETN +P1INI: CLEARB I, LDCCC + INSIRP SETZM,BKBUF ISYMF A.PASS + TDZ FF,[-1-VOT-PTPF-TTYRCH,,-1] ;INITIALIZE MOST FF FLAGS + MOVEIM A.PPASS,2 ;DEFAULT IS 2-PASS. + PUSHJ P,MACINI ;INITIALIZE MACRO STATUS + MOVEI A,CONGLO + MOVEM A,CONGOL + MOVEI A,PCNTB + MOVEM A,PBCONL + MOVE A,[SQUOZE 0,.MAIN] + MOVEM A,PRGNM + MOVEIM BKTABP,BKWPB + ;DROPS IN. +P2INI: INSIRP SETZM,[CPGN,CLNN,GENSM,OFLOC,OFRLOC,CRLOC,BKLVL,BKPDL,BKCUR +SYLOC,SYSYM,BYTW,BYTRLC,STGSW,DECBRK] + AOS A.PASS + TLZ FF,INDEFF + MOVEI A,NCONS + MOVEM A,CONCNT + MOVEI A,VARTAB + MOVEM A,VARPNT + MOVEI A,NVARS + MOVEM A,VARCNR + CLEARM VARCNT + CLEARM PBITS2 + MOVE A,[440300,,PBITS1] + MOVEM A,BITP + MOVEI A,PBITS4 + HRRZM A,PBITS4 + CLEARB I,PBITS1 + MOVEI A,CONTAB + MOVEM A,PLIM + MOVEI A,PCNTB + MOVEM A,PBCON + MOVE A,[(LCUDF)++1] ;< AND > FOR COMPATIBILITY WITH OLD + MOVEM A,PCNTB + MOVEM A,CSQZ + MOVEI A,8 + MOVEM A,ARADIX + MOVEI A,100 + MOVEM A,CLOC + SETZM GLOCTP + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + TRO FF,IPSYMS+FIRWD + MOVE A,[IFORTB,,FORTAB] ;INITIALIZE FORMAT TABLE ON EACH PASS + BLT A,FRTBE + MOVEIM GLSPAS,GLOTB ;INIT. ASSEM1 PDL LEVELS TO BOTTOM. + MOVEMM ASSEMP,[[-LPDL,,PDL]] + SETZM SCNDEP ;NOT IN CONDIT. OR CONSTANT. + SETZM CONDEP + SETOM CONSML ;START OUT IN ERROR MODE. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + MOVEM A,PNTBP + CLEARM LISTPF + SETOM LISTBC +] +IFN CREFSW,[ + JUMPGE FF,P2INI1 + SKIPE CREFP ;IF C SWITCH WAS SEEN, + PUSHJ P,CRFON ;TURN ON CREFFING, +P2INI1:] + AOSLE TTYINS ;MAYBE WE SHOULD .INSRT TTY:. +CRETN: POPJ P,RETURN + TYPR [ASCIZ/TTY INPUT, END WITH .INEOF +/] +IFNDEF GTYIPA,HALT ;SHOULDN'T SET TTYINS IF CAN'T INSRT TTY. +IFDEF GTYIPA,JRST GTYIPA ;ACTUALLY PUSH TO TTY. + +PLOD": HRRM A,RETURN ;MAIN ROUTINE TO PUNCH LOADER, CALLED BEFORE PASS 2 (PS2"), SAVE RETURN POINT + PUSHJ P,PLOD1 ;PUNCH LOADER + JRST RETURN ;RETURN + + ;PUNCH OUT THE LOADER + +PLOD1: PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE + MOVE B,CONTRL + TRNE B,ARIM10 + JRST PLOD2 ;RIM10 => PUNCH OUT SBLK LOADER FOR PDP10 READIN-MODE READIN + TRNN B,SBLKS + POPJ P, ;NOT SBLK => DON'T PUNCH LOADER +PLOD1A: MOVSI B,SLOAD-SLOADP ;PUNCH SBLK LOADER IN RIM FORMAT + MOVSI C,(DATAI PTR,) +PLOAD1: MOVE A,C + PUSHJ P,PPBA + CAMN C,[DATAI PTR,13] + HRRI C,27 + MOVE A,SLOAD(B) + PUSHJ P,PPBA + AOS C + AOBJN B,PLOAD1 + MOVE A,[JRST 1] + PUSHJ P, PPBA + JRST FEED1 + +PLOD2: MOVSI C,LDR10-ELDR10 ;PUNCH SBLK LOADER FOR PDP10 READIN +PLOD3: MOVE A,LDR10(C) + PUSHJ P,PPBA + AOBJN C,PLOD3 + JRST FEED1 + + ;SBLK LOADER NORMALLY PUNCHED OUT IN RIM FORMAT + +SLOAD: CONO PTR,60 ;0 RESTART POINT (NEW BLOCK) + JSP 14,30 ;1 START POINT, LOOP POINT FOR NEW BLOCK; WAIT FOR DATA WORD READY + DATAI PTR,16 ;GET HEADER + MOVE 15,16 ;INITIALIZE CHECKSUM + JUMPGE 16,16 ;HEADER .GE. 0 => STARTING INSTRUCTION + JSP 14,30 ;5 LOOP POINT FOR NEXT DATA WORD: WAIT FOR READY + DATAI PTR,(16) ;READ IN DATA WORD + ROT 15,1 ;NOW UPDATE CHECKSUM + ADD 15,(16) + AOBJN 16,5 ;LOOP FOR ALL DATA WORDS THIS BLOCK + MOVEI 14,33 ;30 TO RETURN TO 33 + JRST 30 ;WAIT FOR READY THEN GO TO 33 + ;14 JSP AC FOR ROUTINE AT 30 + ;15 CHECKSUM + ;16 AOBJN POINTER (UPDATED HEADER) + CONSO PTR,10 ;30 ROUTINE TO WAIT FOR DATA WORD READY FOR DATAI + JRST 30 + JRST (14) + DATAI PTR,16 ;33 GET CHECKSUM + CAMN 15,16 ;COMPARE WITH CALCULATED + JUMPA 1 ;OK, GO GET NEXT BLOCK (DON'T CHANGE TO JRST OR REAL LOADERS WILL GET CONFUSED) + JRST 4, ;CHECKSUM ERROR +SLOADP==. + +;PDP10 SBLK LOADER +;FOLLOWING CODING ACTUAL WORDS TO BE OUTPUT + ;BY ASSEMBLER, COMPILER, OR WHATEVER +;SHOULD BE EXECUTED BY PDP10 HARDWARE READIN FEATURE +;USES ONLY THE AC'S (BUT ALL OF THEM) + +LDR10: + -17,,0 ;BLKI POINTER FOR READ SWITCH + +LDRC=0 ;CHECKSUM (OK, SO YOU'RE NOT ALLOWED TO LOAD + ;INTO IT DURING HARDWARE READIN, BUT WHO SAYS + ;YOUR PROGRAM CAN'T USE IT?) +OFFSET -.+1 ;BEGIN LOADING INTO 1 AS PER HEADER +LDRGO==. + CONO PTR,60 ;START UP PTR (RESTART POINT) +LDRRD==. + HRRI LDRB,.+2 ;INITIALIZE INDEX +LDRW==. + CONSO PTR,10 ;WAIT FOR WORD TO BE AVAILABLE + JRST .-1 + ROT LDRC,-LDRRD(LDRB) ;BEFORE READING IN HEADER, ROTATE 2 BITS (THEN IGNORE) + ;BEFORE READING IN EACH DATA WORD, ROTATE 1 BIT (FOR UPDATING CHECKSUM) + ;BEFORE READING IN CHECKSUM, ROTATE NOT AT ALL (DON'T ROTATE CALCULATED CHECKSUM) + DATAI PTR,@LDRT1-LDRRD(LDRB) ;READ WORD INTO RIGHT PLACE + ;HEADER => READ INTO C + ;STORAGE WORD => READ INDEXED BY AOBJN POINTER IN A + ;CHECKSUM => READ INTO A FOR COMPARISON WITH C(C) + XCT LDRT1-LDRRD(LDRB) ;EXECUTE RELEVANT T1 ENTRY (MAYBE SKIPS) + XCT LDRT2-LDRRD(LDRB) ;EXECUTE RELEVANT T2 ENTRY (MAYBE JUMPS) +LDRB==. + SOJA ., ;-RD(B) IS 2, 1, AND 0 FOR SUCCESSIVE ENCOUNTERS OF THIS INSTRUCTION + ;USED AS INDEX INTO TABLES, ETC. + + ;TABLE 1 + ;INDIRECTED THROUGH FOR DATAI + ;THEN EXECUTED TO SEE WHAT TO DO WITH READ IN WORD + ;ENTRIES EXECUTED IN REVERSE ORDER + +LDRT1==. + CAME LDRC,LDRA ;COMPARE CHECKSUM WITH CALCULATED, SKIP TO B IF THEY AGREE + ADD LDRC,(LDRA) ;UPDATE CHECKSUM + SKIPL LDRA,LDRC ;INITIALIZE HEADER AND SKIP UNLESS JUMP BLOCK + + ;TABLE 2 + ;EXECUTED IF CORRESPONDING ENTRY IN TABLE 1 DIDN'T SKIP WHEN EXECUTED + +LDRT2==. + JRST 4,LDRGO ;CHECKSUM ERROR + AOBJN LDRA,LDRW ;UPDATE AOBJN POINTER AND GO BACK FOR NEXT STORAGE WORD IF NOT EXHAUSTED +LDRA==. + JRST LDRRD ;WHEN INITIALLY LOADED IS JUMP BLOCK TO THIS LOADER + ;DURING LOADING USED TO HOLD HEADER (AOBJN POINTER), WHICH MAY BE LOADED JUMP BLOCK + +OFFSET 0 +ELDR10==. + +;FLAGS IN SQUOZE OF SYMS TO OUTPUT + +ABSGLO==040000 ;SYM IS GLOBAL (IF RELOCA, SAYS THIS IS BLOCK NAME) +ABSLCL==100000 ;LOCAL +ABSDLI==200000 ;DELETE INPUT (DON'T RECOGNIZE IT IF TYPED IN) +ABSDLO==400000 ;DELETE OUTPUT (DON'T TYPE IT OUT) + +PSYMS": HRRM A,RETURN ;PUNCH OUT SYMBOL TABLE, CALLED AFTER EVERYTHING ELSE, SAVE RETURN POINT + PUSH P,PSYMS ;AT END, POPJ TO RETURN. + TRNE FF,IPSYMS + JRST SYMDMP ;PUNCH SYMS IF NEC. + SKIPL A,CONTRL + JRST SYMDA ;IF RELOCA, PUNCH PROGRAM NAME. + TRNN A,DECREL + POPJ P, +PSYMSD: MOVSI A,DECEND + PUSHJ P,DECBLK ;START AN END-BLOCK. + MOVEMM WRD,DECBRK ;OUTPUT THE PROGRAM BREAK. + SETZM WRDRLC + PUSHJ P,PWRD + SETZ A, ;OUTPUT A ZERO WORD. + PUSHJ P,DECWRD + JRST EBLK + +SYMDA: MOVEI A,LPRGN ;NOW PUNCH PROGRAM NAME + DPB A,[310700,,BKBUF] + MOVE A,PRGNM + TLO A,40000 + PUSHJ P,OUTPUT + PUSHJ P,EBLK + TLZ FF,OUTF + POPJ P, + + ;DUMP OUT THE SYMBOL TABLE + +SYMDMP: TRZ I,CONT ;OK TO END BLOCK + CLEARM GLSP1 + CLEARM GLSP2 + CLEARM WRDRLC + MOVE T,CONTRL + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + CLEARM CLOC + CLEARM BKBUF + TRNE T,DECREL + JRST SYMDMD + JUMPL T,SSYMD ;JUMP IF NOT RELOCATABLE + MOVEI B,LDDSYM ;LOCAL SYMS BLOCK TYPE + DPB B,[310700,,BKBUF] ;SET BLOCK TYPE + MOVEM B,CDATBC + MOVE B,SYMAOB ;CAUSE SSYMD3 TO LOOK AT ENTIRE SYM TAB. + JRST SSYMDR + +SYMDMD: MOVSI A,DECSYM ;IN DEC FMT, START SYMBOLS BLOCK. + PUSHJ P,DECBLK + MOVE B,SYMAOB + JRST SSYMDR + +;AC ALLOCATIONS DURING PHASE 1 (COMPACTING THE SYMBOL TABLE): + ;AA INITIALLY HAS -SMK,,; INPUT INDEX INTO ST + ;A TEMP + ;B SQUOZE + ;D OUTPUT INDEX INTO SYMTAB + ;CH1 VALUE OF SYM + ;CH2 3RDWRD + +SSYMD: MOVEI D,ST-1 + SETZB C,SMSRTF ;SYMS SORTED => INITIAL SYMS CLOBBERED + MOVE AA,SYMAOB +SSYMD1: SKIPE B,ST(AA) ;GET SYM NAME FROM TABLE + TDNN B,[37777,,-1] ;MAKE SURE NOT EXPUNGED + JRST SSYMDL ;NOT (REALLY) THERE, TRY NEXT + MOVE CH1,ST+1(AA) ;GET VALUE OF SYM + 3GET CH2,AA ;GET 3RDWRD + TLNE CH2,3INI+3LLV + JRST SSYMDL ;DON'T PUNCH INITIAL SYMS. + MOVEI A,0 ;INITIALIZE FOR SHIFTING IN FLAGS + LSHC A,4 ;SHIFT FLAGS INTO A + XCT SSYMDT(A) ;DO THE APPROPRIATE THING THIS KIND OF SYMTAB ENTRY + JRST SSYMDL +SSYMD2: LSH B,-4 ;SHIFT SQUOZE BACK TO WHERE IT BELONGS + TLO B,ABSLCL ;SET GLOBAL BIT + TLNE CH2,3SKILL + TLO B,ABSDLO ;HALF-KILL SYM + PUSH D,B ;STORE NAME OF SYM IN OUTPUT SLOT + PUSH D,CH1 ;STORE VALUE + PUSH D,CH2 ;STORE 3RDWRD +SSYMDL: ADDI AA,WPS-1 + AOBJN AA,SSYMD1 ;LOOP FOR ALL SYMS IN TABLE + MOVSI CH2,4^5 ;1ST BIT TO SORT ON IS TOPO BIT, + MOVEI A,ST ;SORT FROM BOTTOM OOF SYMTAB + MOVEI B,1(D) ;TO WHERE WE FILLED UP TO. + MOVE CH1,[TDNE CH2,1(A)] ;SORT ON 2ND WD, WDS WITH BIT ON COME FIRST. + MOVE C,[TDNN CH2,1(B)] + JSP AA,SSYMD9 + TLC C,(TDNE#TDNN) ;ON BITS AFTER 1ST, ENTRIES WITH BIT OFF COME FIRST. + TLC CH1,(TDNE#TDNN) + MOVEI AA,SSRTX ;NEED ONLY CHANGE C, CH1 THE FIRST TIME. + JRST SSRTX + +SSYMD9: PUSHJ P,SSRTX ;SORT SYMS ARITHMETICALLY BY VALUE. + MOVNI B,-ST(B) ;AOBJN -> AREA OF SYMTAB IN USE. + IDIVI B,WPS + HRLZI B,(B) + MOVE C,BKTABP + IDIVI C,BKWPB ;# BLOCKS. + CAIE C,1 + ADDI C,1 ;BLOCK STRUCTURE => COUNT GLOBAL HEADER. + MOVSI A,(C) + SUBM B,A ;-<# ENTRIES IN SYMTAB IN FILE>,, + LSH A,1 ;-<# WDS IN SYMTAB IN FILE>,, + MOVEM A,SCKSUM ;SAVE THIS. + PUSHJ P,PPB + PUSHJ P,BKCNT ;PUT -<# SYMS IN BLOCK> IN 3RD WD OF EACH BKTAB ENTRY. + +;DROPS THROUGH. + +;DROPS IN IF ABS, JUMPS HERE IF RELOC. +;NOTE THAT IN ABS ASSEMBLY, B WILL CONTAIN THE CHECKSUM AND +;SHOULD NOT BE CLOBBERED. +SSYMDR: PUSH P,B ;-<# SYMS>,,0 ;IT WILL BE -1(P) + PUSHJ P,BKSRT ;SORT BLOCKS INTO BKTAB1 + MOVE B,SCKSUM ;GET CHKSUM AFTER 1SS WD. (PPBCK WILL UPDATE) + SETOM 1(D) ;PUT A -1 AT END OF BKTAB1. + PUSH P,[-1] ;(P) WILL BE BKTAB1 IDX OF NEXT BLOCK TO OUTPUT. +SSYMD3: AOS F,(P) ;F HAS BKTAB1 IDX OF BLOCK. + SKIPGE C,BKTAB1(F) ;BKTAB1 ELT HAS BKTAB IDX OR + JRST SSYMDX ; -1 AFTER LAST BLOCK. + SKIPL LINK,CONTRL + JRST SSYMD7 ;DIFFERENT RTN TO OUTPUT BLOCK NAME IF RELOCA. + TRNE LINK,DECREL + JRST SSYMD6 ;NO BLOCKS IN DEC FMT. + SKIPGE BKTAB1+1 + JRST SSYMG1 ;ONLY 1 BLOCK, PUT ALL IN GLOBAL. + MOVE A,BKTAB(C) + PUSHJ P,PPBCK + HLRZ A,BKTAB+1(C) + HRL A,BKTAB+2(C) ;PUT IN -2* + ADD A,[-2,,2] + PUSHJ P,PPBCK ;FOLLOWED BY LEVEL. + JRST SSYMD6 + +SSYMG1: MOVE A,[SQUOZE 0,GLOBAL] + PUSHJ P,PPBCK + HRLZ A,BKTAB+2 + ADD A,[-2,,] + JRST SSYMD6 + +SSYMD7: MOVE A,BKTAB(C) ;OUTPUT BLOCK NAME IN RELOCATABLE. + TLO A,ABSGLO ;TELL STINK IT'S BLOCK NAME. + PUSHJ P,OUTPUT + HLRZ A,BKTAB+1(C) + PUSHJ P,OUTPUT +SSYMD6: MOVE C,-1(P) ;AOBJN PTR TO SYMS. +SSYMD4: HRRZ A,ST+2(C) ;OUPUT ONLY THE SYMS IN THE BLOCK + CAME A,BKTAB1(F) ;NOW BEING HANDLED. + JRST SSYMD5 + SKIPGE LINK,CONTRL + TRNE LINK,DECREL + JRST SYMD2 ;SPECIAL IF RELOCA. + MOVE A,ST(C) + PUSHJ P,PPBCK ;1ST, SQUOZE WITH FLAGS. + MOVE A,ST+1(C) + PUSHJ P,PPBCK ;2ND, VALUE. +SSYMD5: ADDI C,WPS-1 + AOBJN C,SSYMD4 ;HANDLE NEXT SYM. + JRST SSYMD3 ;ALL SYMS FORR THIS BLOCK DONE, DO NEXT BLOCK. + +;PUNCH OUT LOCAL SYM (RELOCATABLE ASSEMBLY) +;NORMALLY OUTPUT SQUOZE W/ FLAGS ? VALUE, +;IF 3LLV SET OUTPUT PHONY NAME (= STE ADDR) ? SQUOZE W/ FLAGS, STINK FIXES IT UP. +SYMD2: LDB A,[400400,,ST(C)] + MOVE CH1,ST+1(C) ;SSYMDT MAY CHANGE CH1. + MOVE CH2,ST+2(C) + XCT SSYMDT(A) ;SKIPS IF SHOULD OUTPUT SYM. + JRST SSYMD5 + TLNE CH2,3INI + JRST SSYMD5 + MOVE B,ST(C) + TLZ B,740000 + JUMPE B,SSYMD5 ;UNUSED ENTRY. + JUMPL LINK,SYMDEC ;J IF DEC FMT + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LEFT HALF + TLNE CH2,3RLR + TLO B,100000 ;RELOCATE RIGHT HALF + TLNE CH2,3SKILL + TLO B,400000 ;HALF-KILL + MOVEI A,ST(C) + TLNE CH2,3LLV ;IF STINK HAS VALUE, + PUSHJ P,OUTPUT ;GIVE STINK NAME STINK KNOWS SYMBOL BY. + TLNE CH2,3LLV ;IF GIVING PHONY NAME, INSURE LOCAL FLAG SET + TLO A,ABSLCL ;(STINK WILL DO SO OTHERWISE) + MOVE A,B + PUSHJ P,OUTPUT ;OUTPUT SYM + MOVE A,CH1 + TLNN CH2,3LLV ;DON'T OUTPUT VALUE IF DON'T KNOW IT. + PUSHJ P,OUTPUT ;OUTPUT VALUE + JRST SSYMD5 + +SYMDEC: PUSHJ P,ASQOZR ;RIGHT-JUSTIFY THE SQUOZE, + TLNE CH2,3SKILL + TLO B,ABSDLO ;MAYBE HALFKILL, + TLO B,ABSGLO + MOVEM B,WRD + PUSH P,C + PUSHJ P,DECPW ;FIRST, THE NAME, + POP P,C + LDB TM,[420200,,ST+2(C)] + MOVE A,ST+1(C) ;THEN THE VALUE AND RELOCATION BITS. + PUSHJ P,DECWR1 + JRST SSYMD5 + +;XCT INDEXED ON SQUOZE FLAGS; SHOULDN'T PUNCH SYM IF DOESN'T SKIP. +SSYMDT: JFCL ;COM + JFCL ;PSEUDO OR MACRO + CAIA ;SYM, PUNCH OUT + TLNN CH2,3LLV ;LOCAL UNDEFINED, OUTPUT IF STINK HAS VALUE TO TELL STINK WHERE TO PUT IT. + TLZA CH1,-1 ;DEFINED LOCAL VARIABLE, CLEAR OUT LH(VALUE) + JFCL ;UNDEFINED LOCAL VARIABLE + SKIPL CONTRL ;DEFINED GLOBAL VARIABLE, PUNCH OUT IF ABS. + JFCL ;UNDEFINED GLOBAL VARIABLE + SKIPL CONTRL ;GLOBAL ENTRY, PUNCH OUT IF ABS ASSEM. + JFCL ;GLOBAL EXIT, DON'T PUNCH OUT +IFN .-SSYMDT-NCDBTS,[PRINTC /SSYMDT LOSES. +/] + +SSYMDX: SKIPGE LINK,CONTRL + TRNE LINK,DECREL + JRST SSYMG3 + SKIPGE BKTAB1+1 ;IF ABS ANND BLOCK STR, + JRST SSYMG4 + MOVE A,[SQUOZE 0,GLOBAL] + PUSHJ P,PPBCK ;PUT A GLOBAL BLOCK WITH NO SYMS AT END. + MOVSI A,-2 + PUSHJ P,PPBCK +SSYMG4: MOVE A,B ;ABS ASSEMBLY, OUTPUT CHKSUM. + PUSHJ P,PPB +SSYMG3: SUB P,[2,,2] + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK + SKIPL A,CONTRL ;RELOCATABLE => OUTPUT PROG NAME. + JRST SYMDA + TRNE A,DECREL ;DEC FMT => OUTPUT END BLOCK. + JRST PSYMSD + MOVE A,STARTA ;NOW GET STARTING INSTRUCTION + JRST PPB ;PUNCH IT OUT AND RETURN + +;PUT INTO BKTAB1 THE BKTAB IDXS OF ALL THE BLOCKS IN THE ORDER THEIR +;SYMS SHOULD BE PUNCHED (A BLOCK'S SUBBLOCKS PRECEDE IT) +BKSRT: MOVEI D,BKTAB1-1 ;D IS FOR PUSHING INTO BKTAB1. + MOVSI A,1 ;START WITH BLOCK 0. +BKSR1: SETZ C, ;HANDLE BLOCK IN A: LOOK FOR ITS SUBBLOCKS. +BKSR2: CAME A,BKTAB+1(C) + JRST BKSR3 ;THIS BLOCK ISN'T A SUBBLOCK. + ADD A,[1,,] ;LH HAS SUBBLOCK'S LEVEL. + HRRI A,(C) ;RH HAS SUBBLOCK. + PUSHJ P,BKSR1 ;HANDLE THE SUBBLOCK + MOVE A,BKTAB+1(C) +BKSR3: ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKSR2 + MOVEI C,(A) + PUSH D,C ;PUT THE BLOCK IN BKTAB1 (AFTER SUBBLOCKS) + POPJ P, + +PPBCK: ROT B,1 ;OUTPUT WD IN A, UPDATING CKSUM IN B. + ADD B,A + JRST PPB + +BKCNT: PUSH P,B + MOVEI C,0 +BKCNT0: SETZM BKTAB+2(C) ;ZERO 3RD WD OF EACH BKTAB ENTRY. + ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKCNT0 +BKCNT1: MOVE C,ST+2(B) + SOS BKTAB+2(C) ;ADD -2 FOR EACH SYM IN THE BLOCK. + SOS BKTAB+2(C) + ADDI B,WPS-1 + AOBJN B,BKCNT1 +POPBJ: POP P,B + POPJ P, + +SSRTX: HRLM B,(P) ;DO ONE PASS OF RADIX-EXCHANGE. SAVE END. + CAIL A,-WPS(B) ;ONLY 1 ENTRY, NOTHING TO DO. + JRST SSRTX7 + PUSH P,A ;SAVE START. +SSRTX3: XCT CH1 + JRST SSRTX4 ;MOVE UP TO 1ST WITH BIT ON. + SUBI B,WPS + XCT C ;MOVE DOWN TO LAST WITH BIT OFF. + JRST SSRTX5 +REPEAT WPS,[ + MOVE D,.RPCNT(A) ;EXCHANGE THEM, + EXCH D,.RPCNT(B) + MOVEM D,.RPCNT(A)] +SSRTX4: ADDI A,WPS +SSRTX5: CAME A,B ;ALL DONE => DO NEXT BIT. + JRST SSRTX3 ;MORE IN THIS PASS. + ROT CH2,-1 ;NEXT BIT DOWN. + POP P,A ;A -> START, B -> END OF 1ST HALF. + JUMPL CH2,SSRTX6 ;ALL BITS IN WD DONE, STOP. + PUSHJ P,(AA) ;DO NEXT BIT ON 1ST HALF. + HLRZ B,(P) ;A -> END OF 1ST HALF, B -> END OF ALL. + PUSHJ P,(AA) ;DO SECOND HALF. +SSRTX6: ROT CH2,1 ;LEAVE CH2 AS FOUND IT. +SSRTX7: HLRZ A,(P) ;LEAVE A -> END OF AREA SORTED. + POPJ P, + + ;ARITHMETIC CONDITIONALS (B HAS JUMP A,) + +COND: PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,AGETFD ;GET FIELD TO TEST VALUE OF + ERSM 'UCD ;UNDEFINED SYMBOL IN CONDITIONAL +CONDPP: POP P,T ;RESTORE CONDITIONAL JUMP INSTRUCTION + HRRI T,COND2 ;HRRI IN JUMP ADDRESS, GO TO COND2 IF CONDITIONAL TRUE + XCT T ;JUMP IF COND T,ASSEMBLE STRING +COND4: PUSHJ P,RCH ;CONDITION FALSE, EAT UP STRING + CAIN A,LBRKT + JRST COND3 +ANULL: TLO I,UNRCHF +ANULL2: PUSHJ P,RCH + CAIE A,15 + CAIN A,12 + JRST ANULL1 + JRST ANULL2 + +COND3: MOVEI C,0 ;LEFT BRACKET ENCOUNTERED + PUSHJ P,RCHCNT ;READ UNTIL MATCHING RIGHT BRACKET + JRST .-1 + JRST MACCR + + ;IF1, IF2 + +COND1: HRRI B,PSS + XCT B + JRST COND4 ;NO + ;CONDITION TRUE, ASSEMBLE STRING +COND2: PUSHJ P,RCH ;GET NEXT CHAR + CAIN A,LBRKT ;IF BRACKET-TYPE, + AOS SCNDEP ;COUNT IT FOR RBRAK'S SAKE. + CAIE A,LBRKT ;FLUSH ONLY IF LEFT BRACKET +ANULL1: TLO I,UNRCHF + JRST MACCR + + ;IFB, IFNB + +SBCND: PUSH P,B ;SAVE TEST JUMP + SETZB C,D ;C HAS BRACKET COUNT, D SQUOZE CHAR COUNT + PUSHJ P,RCH ;GET FIRST CHARACTER + CAIN A,LBRKT + JRST SBCND4 ;ARGUMENT BRACKETED +SBCND2: CAIN A,", ;NOT BRACKETED, CHECK FOR COMMA => END + JRST CONDPP ;END, GO TRY IT + PUSHJ P,SQCKD ;IF CHAR IN A IS SQUOZE, INCREMENT D + PUSHJ P,RCH ;GET NEXT CHARACTER + JRST SBCND2 ;GO PROCESS + +SBCND3: PUSHJ P,SQCKD ;IF CHAR IN A IS SQUOZE, INCREMENT D +SBCND4: PUSHJ P,RCHCNT ;GET NEXT CHAR + JRST SBCND3 ;NOT MATCHING RIGHT BRACKET + JRST CONDPP ;DONE, NOW SEE IF SHOULD ASSEMBLE + + ;IF CHAR IN A IS SQUOZE, INCREMENT D + ;USES GDTAB + +SQCKD: HLRZ B,GDTAB(A) ;GET GDTAB ENTRY + CAIE B,(POPJ P,) ;POPJ => NOT SQUOZE + AOJ D, ;SQUOZE + POPJ P, + + ;IFDEF, IFNDEF + +DEFCND: PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,GETSLD ;GET NAME + ERR 'NAM ;NO NAME + PUSHJ P,ES + MOVEI A,0 ;UNDEFINED +IFN CREFSW,XCT CRFINU + CAIN A,GLOEXT_-14. ;GLOBAL EXIT... + SKIPL CONTRL ;DURING ABSOLUTE ASSEMBLY? + CAIN A,3 ;NO, LOCAL UNDEF? + MOVEI A,0 ;ONE OF THESE => UNDEF + JRST CONDPP + +;;PWRD ;ROUTINES TO OUTPUT ASSEMBLES WORDS AND PORTIONS THEREOF + + ;HERE FROM PBITS TO OUTPUT WORD OF CODE BITS + +PBITS3: PUSH P,A + MOVEI A,14 + MOVEM A,PBITS2 ;INITIALIZE PBITS2 FOR COUNTING DOWN THROUGH NEXT SET OF CODE BITS + MOVE A,[440300,,PBITS1] + MOVEM A,BITP ;SET UP BITP FOR RELOADING PBITS1 WITH CODE BITS + MOVE A,PBITS1 ;NOW GET ACCUMULATED WORD OF BITS + MOVEM A,@PBITS4 ;STORE IN BKBUF + AOS A,OPT1 ;RESERVE SPACE FOR NEW WORD + ;IF BITF SET (LAST CALL TO PBITS HAD 7) THEN NEXT WORD OF CODE BITS GOES + ;AFTER NEXT WORD OUTPUT (REALLY!), OTHERWISE BEFORE + TRNN FF,BITF + SOSA A + TRO FF,INVTF + HRRZM A,PBITS4 + POP P,A + CLEARM PBITS1 + ;DROPS THROUGH + ;OUTPUT RELOCATION CODE BITS IN A + +PBITS: SKIPGE CONTRL + POPJ P, ;NOT RELOCATABLE + SOSGE PBITS2 + JRST PBITS3 ;NO MORE ROOM IN WORD, OUTPUT IT AND TRY AGAIN + CAIN A,7 + TROA FF,BITF + TRZ FF,BITF + IDPB A,BITP + POPJ P, + + ;FOLLOWING ROUTINES SAVE AC'S EXCEPT FOR A + +OUTSM0: MOVE A,SYM ;OUTPUT NAME STINK KNOWS SYMBOL BY. + TLZ A,37777 ;FOR LOCALS, THAT'S THE STE ADDR, + HRRI A,ST(D) + TLNN SYM,40000 ;FOR GLOBALS, THAT'S THE SQUOZE. + JRST OUTPUT +OUTSM: SKIPA A,SYM +OUTWD: MOVE A,WRD +OUTPUT: SKIPGE CONTRL ;DIRECTLY PUNCH OUT WORD IN A IN RELOCATABLE ASSEMBLY ONLY + POPJ P, ;DO NOTHING IF ABSOLUTE ASSEMBLY + PUSH P,AA + MOVE AA,OPT1 + TRZN FF,INVTF ;SKIP IF BEING HACKED FROM PBITS3, PUT WORD BEFORE WHERE IT NORMALLY BELONGS + AOS AA + MOVEM A,-1(AA) + MOVE A,CLOC + TRZE FF,FIRWD + HRRM A,BKBUF + POP P,AA + AOS A,OPT1 + CAIL A,BSIZE+BKBUF + TRNE I,CONT + POPJ P, + ;MAY DROP THROUGH + + ;END CURRENT OUTPUT BLOCK + +EBLK: PUSH P,T + PUSH P,TT + PUSH P,A + PUSH P,B + MOVE T,CONTRL + JUMPGE T,EBLK3 ;JUMP IF RELOCATABLE ASSEMBLY + TRNE T,ARIM10\SBLKS + JRST ESBLK + TRNE T,DECREL + JRST DECEBL + JRST EBLK5 + +EBLK3: MOVE T,PBITS1 + MOVEM T,@PBITS4 + MOVEI T,PBITS4 + MOVEM T,PBITS4 + MOVE T,[440300,,PBITS1] + MOVEM T,BITP + CLEARB TT,PBITS2 + CLEARM PBITS1 + MOVEI T,BKBUF + MOVE B,OPT1 ;GET POINTER TO END OF BLOCK + SUBI B,BKBUF+1 ;CONVERT TO # WORDS IN BLOCK (EXCLUDING HEADER) + DPB B,[220700,,BKBUF] ;SET COUNT FIELD IN HEADER + TRZN FF,LOCF + JUMPLE B,EBLK4 ;IGNORE NULL BLOCK UNLESS LOCF SET + TLO FF,OUTF ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) + PUSHJ P,FEED +EBK1: CAML T,OPT1 ;DONE WITH BLOCK? + JRST EBK2 ;YES + MOVE A,(T) ;NO, GET DATA WORD + JFCL 4,.+1 ;UPDATE CHECKSUM + ADD TT,A + JFCL 4,[AOJA TT,.+1] + PUSHJ P,PPB ;OUTPUT WORD + AOJA T,EBK1 +EBK2: SETCM A,TT ;DONE OUTPUTTING BLOCK, NOW GET CHECKSUM + PUSHJ P,PPB ;OUTPUT CHECKSUM + MOVE T,CDATBC ;GET BLOCK TYPE + DPB T,[310700,,BKBUF] ;SET NE T BLOCK TYPE TO STORAGE WORDS BLOCK TYPE + MOVEI T,BKBUF+1 + MOVEM T,OPT1 +EBLK4: TLO FF,OUTF ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) +EBLK5: TRO FF,FIRWD + POP P,B + POP P,A + POP P,TT + POP P,T + POPJ P, + + ;PUNCH OUT WORD OF CODED DATA (E.G. STORAGE WORD); WRD, WRDRLC, GLOTB ENTRIES + +PWRDA: TROA FF,NLIKF ;SUPPRESS ADR LINKING +PWRD: TRZ FF,NLIKF ;PERMIT ADR LINKING + JUMPGE FF,CPOPJ ;IGNORE IF NOT PUNCHING PASS +IFN LISTSW,[ + SKIPGE LISTPF + PUSHJ P,PNTR + SETOM LISTPF + MOVE LINK,WRD + MOVEM LINK,LISTWD + MOVE LINK,WRDRLC + MOVEM LINK,LSTRLC + MOVE LINK,CLOC + MOVEM LINK,LISTAD + MOVE LINK,CRLOC + DPB LINK,[220100,,LISTAD] +] + SKIPGE LINK,CONTRL + JRST PWRD1 ;ABSOLUTE ASSEMBLY + ;RELOCATABLE ASSEMBLY + PUSHJ P,$RSET ;CHECK VALIDITY OF RELOCATION, STANDARDIZE IF NON-STANDARD + MOVE A,GLSP2 + CAMN A,GLSP1 + JRST PWRD2 ;NO GLOBALS + + ;NOW TO SEE IF IT'S POSSIBLE OR DESIRABLE TO ADDRESS LINK + + HRLZ B,WRD + HRR B,WRDRLC + JUMPN B,PWRD3 ;JUMP IF RH NON-ZERO + TRNN FF,NLIKF + SKIPGE GLOCTP + JRST PWRD3 ;ADR LINKING SUPPRESSED OR CLOC GLOBAL + SKIPE LDCCC + JRST PWRD3 ;IN LOAD TIME CONDITIONALS + MOVNI T,1 ;INITIALIZE T FOR COUNTING +PWRD4: CAML A,GLSP1 + JRST PWRD5 ;DONE + HRRZ TT,1(A) ;GET GLOTB ENTRY + JUMPE TT,PWRD7A + LDB TT,[400400,,(TT)] ;GET SQUOZE FLAGS FROM SYM + CAIE TT,DEFGVR_-14. + CAIN TT,GLOETY_-14. + JRST PWRD3 ;DEFINED, BUT MUST BE HERE FOR A REASON (SEE $.H) + HLRZ TT,1(A) + TRNE TT,1777+MINF + JRST PWRD3 ;NEGATED OR MULTIPLIED + TRNE TT,HFWDF + JRST PWRD7 + TRNE TT,ACF + TRNN TT,SWAPF + JRST PWRD3 ;NOT HIGH AC +PWRD7A: AOJA A,PWRD4 +PWRD7: TRNE TT,SWAPF + AOJA A,PWRD4 ;LEFT HALF + AOJN T,PWRD3 ;JUMP IF THIS NOT FIRST GLOBAL IN RIGHT HALF + MOVEI D,1(A) ;FIRST GLOBAL, SET UP POINTER TO GLOTB ENTRY + AOJA A,PWRD4 + +PWRD5: AOJE T,PWRD3 ;NO GLOBALS LOOK BAD AND THERE AREN'T TOO MANY; JUMP IF NONE IN RH + HRRZ T,(D) ;GET ADR OF SQUOZE + SKPST T, ;SKIP IF IN SYMBOL TABLE + JRST PWRD3 ;BELOW SYMBOL TABLE, DON'T ADDRESS LINK AFTER ALL + PUSH P,T ;HOORAY, WE CAN ADDRESS LINK + SETZM (D) ;CLEAR OUT GLOTB ENTRY, DON'T NEED IT ANY MORE + PUSHJ P,PWRD31 ;DUMP OUT THE OTHER GLOBALS + POP P,D ;GET ST ADR OF THIS AGAIN + 3GET1 A,D + BYB LDB A,A,\3RLNK_18. + MOVE B,WRDRLC + TLNE B,1 + TRO A,2 ;RELOCATE LEFT HALF + PUSHJ P,PBITS ;PUNCH OUT APPROPRIATE BITS FOR LINK LIST ENTRY + HLR A,1(D) ;GET ADR OF LAST + HLL A,WRD + PUSHJ P,OUTPUT ;OUTPUT WORD WITH RH = ADR OF LAST RQ FOR SYM TO PUT IN RH'S + MOVE A,CLOC ;NOW UPDATE ST ENTRY + HRLM A,1(D) + 3GET1 B,D + SKIPN CRLOC + TLZA B,3RLNK ;CLOC NOT RELOCATED LAST TIME THIS SYM USED + TLO B,3RLNK ;RELOCATED + 3PUT1 B,D + POPJ P, + +PWRD31: MOVE T,GLSP2 ;DUMP ALL GLO S IN GENERAL FORMAT +PWRD3A: CAML T,GLSP1 + POPJ P, + MOVE B,1(T) + TRNN B,-1 + AOJA T,PWRD3A + TLNE B,1777 + JRST RPWRD ;REPEAT +RPWRD1: BYB LDB A,B,\MINF_18. + TRO A,4 + PUSHJ P,PBITS + MOVE A,(B) ;CODEBITS +SQUOZE FOR SYM + HLRZ C,A + TLZ A,740000 + CAIL C,DEFGVR + TLOA A,40000 ;SYM IS GLO + MOVEI A,(B) ;LOCAL, OUTPUT STE ADDR ("PHONY NAME") INSTEAD NAME + TLNE B,SWAPF + TLO A,400000 + TLNE B,ACF + JRST PWRD3E ;AC HIGH OR LOW + TLNN B,HFWDF + JRST PWRD3F ;ALL THROUGH + TLO A,100000 + TLNE B,SWAPF + TLC A,300000 +PWRD3F: PUSHJ P,OUTPUT + AOJA T,PWRD3A + + + +RPWRD: PUSHJ P,PBITS7 + MOVEI A,CRPT + PUSHJ P,PBITS + LDB A,[221200,,B] + PUSHJ P,OUTPUT + JRST RPWRD1 + +PWRD3E: TLO A,300000 + JRST PWRD3F + +PWRD3: PUSHJ P,PWRD31 +PWRD2: PUSHJ P,RCHKT + HRRZ A,B + DPB T,[10100,,A] + PUSHJ P,PBITS + JRST OUTWD + + ;CHECK FOR VALIDITY OF RELOCATION BITS OF CURRENT WORD + ;LEAVE RELOC (RH) IN B, RELOC (LH) IN T + +RCHKT: HRRZ B,WRDRLC ;CHECK FOR RELOC. OTHER THAN 0 OR 1. + HLRZ T,WRDRLC + TRZN B,-2 + TRZE T,-2 +RLCERR: 1000,,'IRC + POPJ P, + +RMOVET: ROT T,-1 + DPB B,[420100,,T] + TLZ C,3DFCLR ;SET RELOC BITS IN C + IOR C,T ;FROM B AND T. + POPJ P, + + ;CHECK WRDRLC FOR VALIDITY (CAPABILITY OF BEING PUNCHED OUT) + ;IF STANDARD THEN JUST RETURN + ;IF NON-STANDARD BUT OTHERWISE OK, PUT $R. ON GLOBAL LIST, RESET WRDRLC, AND RETURN + ;LEAVES B AND C SET UP WITH RH, LH OF WRDRLC. + +$RSET: MOVE C,WRDRLC ;GET RELOCATION + ADDI C,400000 ;WANT TO SEPARATE HALFWORDS + HLRE B,C ;GET LH IN B + HRREI C,400000(C) ;GET RH IN C (WILL EXCHANGE LATER) + MOVE A,[SWAPF+HFWDF,,$R.H] ;PUT THIS ON GLOBAL LIST IF LH NEEDS $R. + TRNE B,-2 ;CHECK LH + PUSHJ P,$RSET1 ;LH NEEDS GLOBAL REFERENCE + EXCH B,C + HRLI A,HFWDF + TRNE B,-2 ;CHECK RH + PUSHJ P,$RSET1 ;RH NEEDS GLOBAL REFERENCE + HRLZM C,WRDRLC ;RELOC OF LH + ADDM B,WRDRLC ;COMPLETE SETTING UP WRDRLC + POPJ P, + +$RSET1: JUMPGE B,$RSET2 ;STRANGE RELOCATION IN B, JUMP IF NON-NEGATIVE + MOVN T,B ;NEGATIVE, GET MAGNITUDE + TLOA A,MINF ;SET FLAG TO NEGATE GLOBAL +$RSET2: SOSA T,B ;POSITIVE, GET ONE LESS THAN IT IN T + TDZA B,B ;NEGATIVE, CLEAR B, RELOCATION LEFT OVER + MOVEI B,1 ;POSITIVE, SET RELOCATION LEFT OVER TO 1 + CAIN T,1 + MOVEI T,0 ;MULTIPLYING BY TWO OR SUBTRACTING TIMES 1 + TRNE T,-2000 + ERSM 'ROV ;RELOCATION OVERFLOW; TOO BIG EVEN FOR $RSET + DPB T,[221200,,A] ;LOOKS OK, STORE TIMES FIELD IN $R. REFERENCE + AOS GLSP1 ;NOW PUT $R. ON GLOBAL LIST + MOVEM A,@GLSP1 + POPJ P, + + ;PWRD DURING ABSOLUTE ASSEMBLY + +PWRD1: TRNE LINK,DECREL ;DEC FMT IS CONSIDERED ABSOLUTE. + JRST DECPW + MOVE A,GLSP1 + CAME A,GLSP2 + ERR 'ILA ;GLOBALS APPEARING ILLEGALLY + SKIPE WRDRLC + ERR 'IRA ;RELOCATION APPEARING ILLEGALLY + TRNE LINK,ARIM + JRST PRIM ;RIM +SBLKS1: MOVE A,WRD ;SBLK + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FIRWD + MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER + AOS A,OPT1 + CAIGE A,BKBUF+BSIZE + POPJ P, ;BKBUF NOT FULL YET + +SBLKS2: SUBI A,BKBUF+1 + JUMPE A,CPOPJ + MOVNS A + HRLM A,BKBUF + PUSHJ P,FEED + MOVEI T,BKBUF + CLEARM SCKSUM +SBLK1: CAML T,OPT1 + JRST SBLK2 + MOVE A,SCKSUM + ROT A,1 + ADD A,(T) + MOVEM A,SCKSUM + MOVE A,(T) + PUSHJ P,PPB + AOJA T,SBLK1 + +SBLK2: TRO FF,FIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,SCKSUM + JRST PPB + +ESBLK: MOVE A,OPT1 + PUSHJ P,SBLKS2 + JRST EBLK4 + +PRIM: MOVSI A,(DATAI PTR,) + HRR A,CLOC + PUSHJ P,PPB + MOVE A,WRD + JRST PPB + +;END A BLOCK IN DEC FMT. COME FROM EBLK. +DECEBL: PUSH P,[EBLK5] +DECEB1: MOVSI A,DECWDS ;JUST INIT. AN ORDINARY BLOCK, + +;COME HERE TO OUTPUT PREVIOUS BLOCK AND START NEW BLOCK OF TYPE IN LH OF A. +DECBLK: PUSH P,A + HRRZ A,BKBUF ;GET DATA-WORD COUNT OF CURRENT BLOCK. + JUMPE A,DECB1 ;NO WORDS => CAN IGNORE. + MOVEI TT,BKBUF+1 +DECB0: MOVE A,-1(TT) ;GET AND PUNCH NEXT WD OF BLOCK. + PUSHJ P,PPB + CAME TT,OPT1 ;STOP WHEN NEXT WD ISN'T IN BLOCK. + AOJA TT,DECB0 +DECB1: POP P,A + HLLZM A,BKBUF ;PUT BLOCK TYPE IN LH OF HEADER, DATA WD COUNT IN RH IS 0. + MOVEI TT,BKBUF+2 ;ADDR OF PLACE FOR 1ST DATA WD + MOVEM TT,OPT1 ;(LEAVE SPACE FOR WD OF RELOC BITS) + MOVE TT,[440200,,BKBUF+1] + MOVEM TT,BITP ;BP FOR STORING PAIRS OF RELOC BITS. + TLO FF,OUTF + POPJ P, + +;COME HERE TO OUTPUT A WORD IN DEC FORMAT. +DECPW: MOVS A,BKBUF + CAIE A,DECWDS ;BEFORE THE 1ST STORAGE WD IN ORDINARY BLOCK, + JRST DECPW0 + MOVE A,CRLOC ;MUST GO THE LOCATION CTR. + IDPB A,BITP + MOVE A,CLOC + MOVEM A,@OPT1 + AOS OPT1 + AOS BKBUF ;IT COUNTS AS DATA WORD. +DECPW0: MOVE A,BITP + TLNE A,77^4 ;IF NO ROOM FOR MORE RELOC BITS, + JRST DECPW1 + HLLZ A,BKBUF ;START A NEW BLOCK. + PUSHJ P,DECBLK + JRST DECPW + +DECPW1: PUSHJ P,$RSET ;SET UP RELOC BITS OF HALVES IN B,C. + LSH C,1 + IORI B,(C) ;COMBINE THEM. + MOVE A,GLSP1 + CAME A,GLSP2 + JRST DECPG ;GO HANDLE GLOBALS. +DECPW3: IDPB B,BITP ;STORE THE RELOC BITS + MOVE A,WRD +DECPW2: MOVEM A,@OPT1 ;AND THE VALUE. + AOS OPT1 + AOS BKBUF + POPJ P, + +;PUT A WORD DIRECTLY INTO DEC FMT BLOCK. +DECWRD: SETZ TM, +DECWR1: IDPB TM,BITP ;SKIP A PAIR OF RELOC BITS, + JRST DECPW2 ;STORE THE WORD. + +;HANDLE GLOBAL REFS IN DEC FMT. +DECPG: PUSHJ P,DECPW3 ;FIRST, OUTPUT THE WORD, +DECPG0: MOVSI A,DECSYM + PUSHJ P,DECBLK ;THEN STRT A SYMBOLS BLOCK. + MOVE C,GLSP1 +DECPG1: CAMN C,GLSP2 ;ALL DONE => + JRST DECEB1 ;GO START AN ORDINARY BLOCK FOR NEXT WD. + MOVE A,BITP + TLNN A,77^4 ;BLOCK FULL => START ANOTHER. + JRST DECPG0 + AOS C,GLSP1 ;GET ADDR OF NEXT GLOBAL REF. + MOVE B,(C) + MOVE A,(B) ;GET NAME OF SYM. + TLZ A,740000 + TLO A,600000 ;PUT IN FLAGS SAYING ADDITIVE GLOBAL RQ. + PUSHJ P,DECWRD ;OUTPUT NAME. + HRRZ A,CLOC ;GET ADDR OF RQ, + TLO A,400000 ;MACRO SETS THIS BIT SO I WILL. + TLNE B,SWAPF ;SWAPPED => TELL LOADER.. + TLO A,200000 + MOVE TM,CRLOC + PUSHJ P,DECWR1 ;OUTPUT 2ND WD, + JRST DECPG1 ;GO BACK FOR MORE GLOBAL REFS. + + ;.LIBRA, .LIFS, ETC. + +A.LIB: HLRZM B,LIBTYP' ;STORE BLOCK TYPE TO OUTPUT + CLEARM LIBOP ;INITIALIZE SQUOZE FLAGS + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK, MAKING SURE LOADER KNOWS $. +LIB1: PUSHJ P,GETSYL ;GET NAME + TRNN I,SYL + JRST LIB2 ;NO SYL, DON'T OUTPUT + IOR SYM,LIBOP + TLO SYM,40000 + PUSHJ P,OUTSM + MOVSI A,400000 + ANDCAM A,LIBOP +LIB2: MOVE B,CDISP ;GET CDISP + TLNN B,DWRD\DFLD ;CHECK FOR WORD TERMINATOR + JRST LIB3 ;WORD TERMINATOR => DONE + MOVE A,LIBOP + MOVE B,LIMBO1 ;RETRIEVE LAST CHAR READ + CAIN B,", + MOVSI A,400000 + CAIN B,"+ + TLZ A,200000 + CAIN B,"- + TLO A,200000 + MOVEM A,LIBOP' ;STORE SQUOZE FLAGS (LESS GLBL BIT) FOR NEXT SYM + JRST LIB1 + +LIB3: MOVE A,LIBTYP ;GET BLOCK TYPE TO OUTPUT + DPB A,[310700,,BKBUF] + PUSHJ P,EBLK + CAIN A,LLIB ;.LIBRA? + JRST ARELC1 ;.LIBRA, NOW PLAY LIKE RELOCA PSEUDO + JRST LIB5 ;SOMETHING ELSE (.LIFS), INCREMENT DEPTH IN LOAD TIME CONDITIONALS +A.ELDC: PUSHJ P,EBLK + MOVEI A,ELTCB + DPB A,[310700,,BKBUF] + TRO FF,LOCF ;MAKE EBLK OUTPUT NULL BLOCK + PUSHJ P,EBLK + SOSGE LDCCC + CLEARM LDCCC ;LOADER CONDITIONAL UNDERFLOW + JRST ASSEM1 + + ;LOADER CONDITIONAL ON VALUE + +A.LDCV: LSH B,-27. + PUSH P,B + PUSHJ P,AGETWD + ERSM 'ULC ;UNDEFINED IN LOADER CONDITIONAL + POP P,B + DPB B,[400300,,BKBUF] + MOVEI A,LDCV + PUSHJ P,PLDCM + MOVEI A,0 + DPB A,[400300,,BKBUF] +LIB5: AOS LDCCC +CCASM1: JRST ASSEM1 + + ;.GLOBAL + +A.GLOB: MOVE A,GLSPAS + MOVEM A,GLSP1 + SETOM FLDCNT + PUSHJ P,GETSLD ;GET NAME + JRST ASSEM1 ;NO NAME => DONE + TLO I,GLI ;SET DOUBLEQUOTE FLAG + PUSHJ P,GETVAL ;NOW GET VALUE (CLOBBERS SQUOZE FLAGS) + JRST A.GLOB ;LOOP FOR NEXT SYM + ERSM 'ILG ;ILLEGAL NAME FOR .GLOBAL + JRST A.GLOB ;GET NEXT ANYWAY + + ;.LOP + +A.LOP: SKIPGE CONTRL + ERA 'ILO ;.LOP WHEN NOT IN RELOCATABLE OUTPUT FORMAT + PUSHJ P,EBLK ;TERMINATE CURRENT BLOCK + REPEAT 3,PUSHJ P,RGETFD ;GET THE FIELDS + MOVEI A,LD.OP + PUSHJ P,PLDCN + JRST ASSEM1 + + ;.LIBRQ + +A.LIBRQ: PUSHJ P,GETSLD + JRST ASSEM1 + PUSHJ P,PBITS7 + MOVEI A,3 + PUSHJ P,PBITS + TLO SYM,40000 + PUSHJ P,OUTSM + JRST A.LIBRQ + +A.LNKOT: AOS (P) ;THIS PSEUDO RETURNS NO VALUE. + +AEND5: JUMPGE FF,CPOPJ ;IGNORE FOLLOWING ON NOT PUNCHING PASS + MOVE D,SYMAOB +AEND5A: MOVE SYM,ST(D) + LDB T,[400400,,SYM] + CAIE T,DEFLVR_-14. + CAIN T,DEFGVR_-14. + JRST AEND5E + CAIE T,LCUDF_-14. + CAIN T,GLOEXT_-14. + JRST AEND5B +AEND5C: ADDI D,WPS-1 + AOBJN D,AEND5A + POPJ P, + +AEND5E: 3GET C,D + TLNN C,3LLV + JRST AEND5C +AEND5B: HLLZ B,ST+1(D) + 3GET C,D + TLNN C,3RLNK + JUMPE B,AEND5C + TLZ SYM,740000 + CAIE T,LCUDF_-14. + CAIN T,DEFLVR_-14. + SKIPA + TLO SYM,40000 + PUSHJ P,LKPNRO + HRRZS ST+1(D) ;CLEAR OUT LIST HEAD POINTER. + TLZ C,3RLNK ;INDICATE NO LIST. + 3PUT C,D + JRST AEND5C + + ;PUNCH OUT COMPLETE LOADER COMMAND, PUNCHING OUT WRD AS ONLY CONTENTS + +PLDCM: PUSH P,LINK ;SAVE LINK FOR ALOC AND FRIENDS (CLOBBERS OTHER AC'S) + PUSH P,A ;SAVE LOADER COMMAND TYPE + PUSHJ P,EBLK ;TERMINATE PREV BLOCK, MAKING SURE LOADER KNOWS $. + PUSHJ P,PWRDA ;PUNCH OUT THE WORD + POP P,A ;GET BACK LOADER COMMAND TYPE FOR PLDCN + PUSHJ P,PLDCN ;OUTPUT THE RESULTING BLOCK + POP P,LINK ;RESTORE LINK + POPJ P, + +PLDCN: HRRM A,BKBUF ;STORE LOADER COMMAND TYPE IN BKBUF HEADER + MOVEI A,LLDCM ;LOADER COMMAND BLOCK TYPE + DPB A,[310700,,BKBUF] ;STORE BLOCK TYPE IN HEADER + TRO FF,LOCF ;MAKE EBLK OUTPUT BLOCK EVEN IF EMPTY + JRST EBLK + +AEND: SKIPE CONDEP ; ERROR IF IN CONSTANT. + JSP LINK,CONFLM ;FLUSH CONSTANTS, GIVE ERROR MSG. + SKIPE BKCUR ;IF NOT IN OUTER BLOCK, ERROR. + ERR 'UMB + MOVE A,CDISP + TLNN A,DWRD + TLO I,UNRCHF ;IF LAST TERM. WAS WORD TERM., RE-READ. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + EXCH A,PNTBP + MOVEM A,LISTTM +] + PUSHJ P,AVARI0 + PUSHJ P,CNSTN0 + SKIPL A,CONTRL + PUSHJ P,AEND5 ;RELOCATABLE => .LNKOT + JUMPL FF,AEND1 ;ON PUNCHING PASS, SPECIAL STUFF + PUSHJ P,GETWRD ;OTHERWISE EAT UP WORD, + JRST RETURN ;AND RETURN + +AEND1: PUSHJ P,EBLK +IFN LISTSW,[ + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE A,LISTTM + MOVEM A,PNTBP +] + PUSHJ P,AGETWD + ERSM 'USE ;UNDEFINED SYM IN END +IFN LISTSW,[ + MOVEM A,LISTWD + MOVEM B,LSTRLC + SETOM LISTAD + SETOM LISTPF + PUSHJ P,PNTR + PUSHJ P,LPTCLS" ;DONE LISTING + MOVE A,LISTWD +] + SKIPL B,CONTRL + JRST AEND3 ;RELOCATABLE + TRNN B,DECREL + JRST AEND1A + MOVE A,CLOC ;IN DEC FMT, UPDATE HIGHEST RELOC ADDR SEEN, + SKIPE CRLOC + CAMG A,DECBRK + CAIA + MOVEM A,DECBRK + MOVSI A,DECSTA ;THEN OUTPUT START-ADDRESS BLOCK. + PUSHJ P,DECBLK + PUSHJ P,PWRD ;WITH THE START-ADDRESS. + PUSHJ P,EBLK + JRST AEND2 + +AEND3: HRRZ A,CLOC + HRRM A,BKBUF ;SET UP PROGRAM BREAK JUST IN CASE OUTPUTTING MORE NULL DATA BLOCKS + MOVEI A,LCJMP + PUSHJ P,PLDCM + JRST AEND2 + +AEND1A: TLNN A,777000 ;CHECK INSTRUCTION PART + TLO A,(JRST) ;INSTRUCTION PART 0; HE WANTS JRST + PUSHJ P,PPB + JUMPG A,.+3 + ERR 'EWN ;END WORD NEGATIVE + HRLI A,(JRST) ;END SYMTAB WITH POSITIVE WORD + MOVEM A,STARTA ;SAVE FOR PUNCHOUT AT END OF SYMTAB + PUSHJ P,FEED1 +AEND2: PUSH P,[RETURN] +CNARTP: MOVNI D,1 + MOVEI TT,PCNTB +CNTP1: CAML TT,PBCONL + POPJ P, + HRRZ B,1(TT) + HLRZ A,1(TT) + CAMN A,B + JRST CNTP2 + AOSN D + TYPR [ASCIZ /CONSTANTS AREA INCLUSIVE +FROM TO +/] + BYB LDB B,2(TT),\CGBAL_18. + SKIPE B + TYPR [ASCIZ /GLOBAL+/] + HRRZ B,1(TT) + PUSHJ P,OCTPNT + PUSHJ P,TAB + HLRZ B,1(TT) + SOS B + PUSHJ P,OCTPNT + PUSHJ P,CRR +CNTP2: ADDI TT,3 + JRST CNTP1 + +AXWORD: PUSHJ P,GETFLD ;XWD + HRRZ C,CDISP + CAIN C,COMMA + JRST .+3 ;FIELD TERMINATOR WAS COMMA + TRNN I,FLD + JRST AXWORD ;NOT COMMA AND NO FIELD, TRY AGAIN + HRLM A,WRD + HRLM B,WRDRLC + MOVSI C,HFWDF + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + PUSH P,GLSP1 + PUSHJ P,GETFLD ;NOW THE SECOND FIELD + TRNN I,FLD ;KEEP TRYING UNTIL A FIELD THERE + JRST .-2 + HRRM A,WRD + HRRES B + ADDM B,WRDRLC + MOVSI C,HFWDF + MOVEI B,0 + POP P,T + PUSHJ P,LINKTC + JRST CABPOP + +A.LENGTH: MOVE A,LIMBO1 + CAIN A,40 + PUSHJ P,RCH + PUSH P,[0] + PUSH P,A +A.LN1: PUSHJ P,RCH + AOS -1(P) + CAME A,(P) + JRST A.LN1 + SOS T,-1(P) + SUB P,[2,,2] + JRST TEXT5 ;RETURN VALUE IN T + +ARDIX: PUSHJ P,AGETFD ;GET FIELD ARG + ERSM 'USX ;WHAT ELSE TO SAY? + MOVEM A,ARADIX + JRST MACCR ;RETURN WITHOUT CLOBBERING CURRENT VALUE + +AWORD: PUSHJ P,EBLK + PUSHJ P,GETWRD ;ON UNDEFINED SYM, WYB UNDEFINED SYM IN "WORD"? + PUSHJ P,PPB + JRST ASSEM1 + +AEXPUNG: PUSHJ P,GETSLD ;GET NAME + JRST ASSEM1 ;NO MORE NAMES + PUSHJ P,ES + JFCL ;NOT FOUND, DON'T COMPLAIN, JUST CREF. +IFN CREFSW,XCT CRFDEF + HRLZI T,400000 ;EXPUNGED ZERO SYM + SKIPE ST(D) + MOVEM T,ST(D) + SKIPL CONTRL ;IF RELOCATABLE ANDLOCAL SYMBOL, + CAIL A,DEFGVR_-33. + JRST AEXPUNG + PUSHJ P,PBITS7 ;TELL STINK TO EXPUNGE SYM. + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY IS NEW TYPE RQ, + PUSHJ P,OUTSM0 + MOVSI A,400000 ;NEW NAME NULL => DELETE. + PUSHJ P,OUTPUT + JRST AEXPUNG ;LOOP BACK FOR NEXT SYM NAME + +AEQUAL: PUSHJ P,GETSYL + PUSHJ P,ESDEF + MOVEM SYM,ST(D) + PUSH P,D + PUSHJ P,GETSYL + PUSHJ P,ES + ERA 'IEQ +IFN CREFSW,XCT CRFINU ;CREF SYM DEFINED AS. + POP P,D +IFN CREFSW,[ + LDB SYM,[4000,,ST(D)] + XCT CRFDEF ;CREF THE SYM BEING DEFINED. +] + DPB A,[(400400) ST(D)] + MOVEM B,ST+1(D) + 3GET B,D + TLZ B,3DFCLR ;SAVE OLD 3MAS, 3NCRF + ANDCM C,[3DFCLR,,] + IOR C,B + 3PUT C,D + JRST ASSEM1 + + ;UUO HANDLING ROUTINE + ;41 HAS JSR ERROR + +VBLK +ERRCCT: 0 ;NUM CHARS OUTPUT ON LINE, FOR MAKING MSGS LINE UP. +ERRJPC: 0 ;JPC READ WHEN UUO. +ERROR: 0 +IFN TS, .SUSET [.RJPC,,ERRJPC] + JRST ERRH ;GO HANDLE IT +PBLK +ERRH: PUSH P,T + PUSH P,B ;NOT TYPR => ERROR OF SOME KIND + PUSH P,A + LDB T,[331100,,40] ;PICK UP OP CODE + CAIN T,TYPR_-33 ;TYPR? + JRST TYPR1 ;YES + ;ERROR OF SOME KIND + CAIN T,6 ;6000,,? + JUMPGE FF,ERRET1 ;YES, IF PUNCHING PASS THEN IGNORE + HRRZ T,40 + CAIE T,(SIXBIT /MDT/) ;CHECK FOR SPECIAL LOSSAGES AT COLON + CAIN T,(SIXBIT /RES/) + SKIPA T,SYSYM1 + JRST .+4 ;NOT COLON LOSSAGE, SKIP UN-MUNGATUDE + MOVEM T,SYSYM ;COLON LOSSAGE, DE-MUNG TAG WORDS FOR PRINTOUT + MOVE T,SYLOC1 + MOVEM T,SYLOC +IFN TS, PUSHJ P,ERRTFL ;IF NOT SAME FILE AS LAST, PRINT FILE NAME. + SETZM ERRCCT + MOVE A,SYSYM ;GET LAST TAG DEFINED + JUMPE A,ERR1 ;SKIP PRINTOUT IF NONE THERE + PUSHJ P,SYMTYP ;THERE, TYPE IT OUT + MOVE B,CLOC ;NOW GET CURRENT LOCATION + SUB B,SYLOC ;SUBTRACT VALUE OF LAST TAG + JUMPE B,ERR1 ;SKIP NUMERIC PRINTOUT IF RIGHT AT TAG + MOVEI A,"+ ;NOT AT TAG, + PUSHJ P,TYO ;TYPE OUT PLUS SIGN, + AOS ERRCCT ;(1 MORE CHAR TYPED) + PUSHJ P,OCTPNT ;THEN TYPE OUT DIFFERENCE IN OCTAL +ERR1: PUSHJ P,TAB" ;NOW SEPARATE WITH TAB + MOVE A,ERRCCT + CAIGE A,8 ;MAKE SURE MOVE TO COLUMN 16. + PUSHJ P,TAB + MOVEI B,[ASCIZ/GL+/] + SKIPGE GLOCTP ;LOCATION GLOBAL? + PUSHJ P,TYPR3 ;YES, TYPE OUT THAT FACT. + MOVE B,CLOC ;GET CURRENT LOCATION + PUSHJ P,OCTPNT ;TYPE OUT IN OCTAL + PUSHJ P,TAB ;SEPARATE FROM FOLLOWING WITH TAB + MOVE B,MDEPTH ;NOW DEPTH IN MACRO (NOT IRP, REPEAT, ETC.) EXPANSIONS + PUSHJ P,OCTPNT + PUSHJ P,TAB + MOVE A,CPGN ;CURRENT PAGE NUMBER (FIRST PAGE OF FILE => 0) + PUSHJ P,[AOJA A,DPNT] ;TYPE IT OUT IN DECIMAL + PUSHJ P,TAB + MOVE A,CLNN ;ALSO CURRENT LINE NUMBER + PUSHJ P,[AOJA A,DPNT] + PUSHJ P,TAB + ;DROPS THROUGH + + ;DROPS THROUGH + LDB A,[331100,,40] ;PICK UP OP CODE AGAIN + CAIGE A,8 ;ERROR UUO MAX + JRST .+1(A) + JRST IAE ;0 => NO RECV + JRST ERR2 ;1000 SYM+MESS + JRST ERR3 ;2000 MESS + JRST ERR6 ;3000 RH(40) HAS JUMP ADR + JRST ERR4 ;4000 IGNORE LINE RET TO ASSEM1 + JRST ERR5 ;5000 RET TO ASSEM1 + JRST ERR2 ;6000 SYM ON PPSS + JRST IAE ;ERF => FATAL. + + ;TYPE OUT SQUOZE (FLAGS OFF) IN A + +SYMTYP: PUSHJ P,SQCCV ;GET NEXT CHAR IN ASCII. + AOS ERRCCT + PUSHJ P,TYO ;TYPE IT OUT. + JUMPE B,CPOPJ ;RETURN IF NOTHING LEFT (TYPED OUT AT LEAST ONE CHAR THOUGH) + IMULI B,50 ;LEFT-JUSTIFY REMAINDER + MOVE A,B ;GET LEFT-JUSTIFIED REMAINDER IN A + JRST SYMTYP ;TYPE OUT REMAINDER OF SYM + + ;TYPE OUT SQUOZE CHARACTER (IN A) + +SQCCV: IDIV A,[50*50*50*50*50] + CAIG A,10. + SOJA A,SQCDTO ;NUMBER (OR BLANK =>SLASH) + CAIL A,45 + SKIPA A,SYTB-45(A) ;SPECIAL + ADDI A,"A-13 ;LETTER + POPJ P, + +SQCDTO: ADDI A,"0 + POPJ P, + +SYTB: ". + "$ + "% + +DPNT: IDIVI A,10. + HRLM B,(P) + SKIPE A + PUSHJ P,DPNT + JRST DPNT1 + +OCTPNT: HRRZ A,B + IDIVI A,10 + HRLM B,(P) + JUMPE A,.+2 + PUSHJ P,.-3 + AOS ERRCCT +DPNT1: HLRZ A,(P) +ADGTYO: ADDI A,"0 + JRST TYO + +ERR6: MOVE A,40 ;3000,, => RH(40) HAS JUMP ADR + HRRM A,ERROR + JRST ERRET1 + +ERR4: PUSHJ P,RCH ;4000,, => IGNORE LINE, RETURN TO ASSEM1: EAT UP LINE + CAIE A,12 + JRST .-2 + +ERR5: MOVEI A,ASSEM1 ;5000,, => RETURN TO ASSEM1 + MOVEM A,ERROR +ERR2: MOVE A,SYM ;1000,, OR 6000,, ON PPSS; TYPE OUT SYM THEN MESSAGE + PUSHJ P,SYMTYP + PUSHJ P,TAB +ERR3: HRLZ B,40 ;2000,, JUST TYPE OUT MESSAGE + PUSHJ P,SIXTYO + PUSHJ P,CRR +ERRET1: POP P,A ;COMMON RETURN POINT FROM UUOS + POP P,B + POP P,T + JRST 2,@ERROR + + ;TYPE OUT THE SIXBIT WORD IN B + +SIXTYO: JUMPE B,CPOPJ + MOVEI A,0 + ROTC A,6 + ADDI A,40 + PUSHJ P,TYO + JRST SIXTYO + + ;TYPE CRLF + +CRR: MOVEI A,15 + PUSHJ P,TYO + MOVEI A,12 + JRST TYO + +IAE: HRLZ B,40 ;OP CODE 0 => NO RECOVERY RETURN TO GO2 + PUSHJ P,SIXTYO + PUSHJ P,TAB + SOS B,ERROR ;MAKE OUTPUT POINT TO ERROR INSTRUCTION + PUSHJ P,OCTPNT +IFN TS-DECSW,.RESET TYIC, + JRST GO2" + + ;TYPR [ASCIZ /STRING/] ;TYPE OUT STRING + +TYPR1: PUSH P,[ERRET1] + HRRZ B,40 ;GET ADR OF BEGINNING OF STRING +TYPR3: HRLI B,440700 ;CONVERT TO BYTE POINTER +TYPR2: ILDB A,B ;GET NEXT CHAR + JUMPE A,CPOPJ ;JUMP IF ZERO, END OF STRING + PUSHJ P,TYO ;NON-ZERO, TYPE IT OUT + JRST TYPR2 + ;OUTPUT-FORMAA SELECTING PSEUDOS: + +;.SLDR -- PUNCH OUT SBLK LOADER NOW AND SELECT SBLK FORMAT +A.SLDR: PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE FIRST + PUSHJ P,PLOD1A ;PUNCH OUT LOADER +SIMBLK: MOVSI B,SBLKS ;ENTRY FROM PS1, A.SLDR SELECT SBLK +SRIM: TRO FF,NPSS ;ENTRY FROM GETVAL, LH(B) HAS RH(CONTRL) + HRRI B,TRIV ;SET UP TRIV FLAG FOR LH(CONTRL) + MOVSM B,CONTRL ;STORE NEW CONTRL + PUSHJ P,OUTUPD + JRST ASSEM1 + + ;ROUTINE TO SET VARIABLES FOR BENEFIT OF NED LOGIC + ;CALLED BY OUTPUT SELECTING PSEUDOS OTHER THAN 1PASS AND .LIBRA +OUTUPD: IFN A1PSW,[ + TRNN FF,PSS ;IF PASS 1, + TLZ FF,PPSS ;THEN INDICATE NOT PUNCHING PASS + TROE FF,NPSS + TLNN FF,OUTF + JRST OUTCHK + AOS OUTN1 ;INDICATE "OUTPUT" HAS OCCURED OTHER THAN IN 1PASS MODE +OUTCHK: TLZE FF,OUTF + AOS OUTC ;INDICATE "OUTPUT" HAS OCCURED DURING CURRENT ASSEMBLY +] POPJ P, + +ANOSYMS: TRZ FF,IPSYMS + JRST ASSEM1 + +A1PASS: PUSHJ P,OUTUPD +A1PAS1: TLO FF,PPSS + MOVEIM A.PPASS,1 ;SET .PPASS TO 1. +IFN CREFSW,[ SKIPE CREFP ;THIS NOW PUNCHING PASS, + PUSHJ P,CRFON ;MAYBE TURN ON CREFFING. +] + TRZA FF,NPSS +ARELOC: PUSHJ P,OUTUPD +ARELC1: PUSHJ P,EBLK ;FINISH CURRENT OUTPUT BLOCK + TRO FF,LOCF ;DOING LOCATION ASSIGNMENT, MAKE SURE NEXT GETS OUTPUT + CLEARM CLOC + MOVEI A,1 + MOVEM A,CRLOC + CLEARM CONTRL + SETZM BKBUF + MOVEI A,LREL + DPB A,[310700,,BKBUF] + MOVEM A,CDATBC + JRST POPJ1 + +A.DECREL: PUSHJ P,OUTUPD + PUSHJ P,EBLK ;FORCE OUT BLOCK IN OTHER FMT. + MOVE A,[SETZ DECREL] + MOVEM A,CONTRL ;DEC FMT COUNTS AS ABS ASSEMBLY. + SETZM BKBUF ;(SO EBLK W0N'T OUTPUT ANYTHING) + SETZM CLOC ;START ASSEMBLING FROM RELOCATABLE 0. + MOVEI A,1 + MOVEM A,CRLOC + PUSHJ P,EBLK ;INITIALIZE AN ORDINARY (DECWDS) BLOCK. + JRST POPJ1 + +ATITLE: PUSH P,CASSM1 ;RETURN TO ASSEM1 + TRNN FF,PSS ;PRECEDE W/ CR ON PASS 1 + PUSHJ P,CRR + PUSHJ P,GSYL + SKIPE SYM + MOVEM SYM,PRGNM + MOVE T,[440700,,STRSTO] +ATIT2: ILDB A,T ;GET CHAR FROM TITLE STRING + SOSG STRCNT + JRST ATIT1 ;CHAR IS SYLLABLE TERMINATOR + PUSHJ P,TYO ;NOT TERMINATOR, TYPE OUT AND LOOP BACK + JRST ATIT2 + +ATIT1: CAIE A,15 ;CR? + CAIN A,12 ;LF? + JRST CRR ;ONE OF THESE, FINISH TYPEOUT WITH CR + PUSHJ P,TYO ;NEITHER OF THESE, PRINT CHAR +A.ERR1: PUSHJ P,RCH ;GET NEXT CHAR IN TITLE + JRST ATIT1 + +;.ERR PSEUDO-OP -- FOLLOWED BY LINE WHICH IS ERROR MSG. +A.ERR: PUSH P,CASSM1 ;ATIT1 POPJ'S. + ERJ A.ERR1 ;PRINT RANDOM INFO, EXIT TO A.ERR1 . + +APRNTC: +APRNTX: MOVE A,LIMBO1 + CAIN A,40 + PUSHJ P,RCH + MOVE T,A +APRTX1: PUSHJ P,RCH + CAIN A,"! + JUMPGE B,.-2 + CAMN A,T + JRST ASSEM1 + PUSHJ P,TYO + JRST APRTX1 + ;.BEGIN - START NEW BLOCK WITH NAME = LAST LABEL DEFINED. +A.BEGIN: SKIPE CONDEP ;IF IN LITERAL, FLUSH IT & ERROR. + JSP LINK,CONFLM + PUSHJ P,GETSLD ;READ A NAME. + MOVE SYM,SYSYM ;NO ARG, USE NAME OF LAST LABEL. + MOVE A,SYM ;NAME TO USE FOR BLOCK. + MOVE B,BKLVL ;CURRENT LEVEL + 1 + HRLZI B,1(B) ;IS LEVEL OF NEW BLOCK. + HRR B,BKCUR ;ITS SUPERIOR IS CURRENT BLOCK. + MOVEI C,0 ;SEE IF AN ENTRY EXISTS FOR THIS BLOCK. + MOVE AA,A.PASS +A.BEG0: CAMN A,BKTAB(C) + CAME B,BKTAB+1(C) + JRST A.BEG1 ;THIS ENTRY ISN'T FOR BLOCK BEING ENTERED. + TDNE AA,BKTAB+2(C) ;FOUND: DEFINED IN THIS PASS? + ERSM 'MDB + JRST A.BEG2 ;NO, SAY IT'S DEFINED. + +A.BEG1: ADDI C,BKWPB ;LOOK THRU ALL ENTRIES. + CAMGE C,BKTABP + JRST A.BEG0 + CAIL C,BKTABS ;ALL ENTRIES USED => ERROR. + ERF 'TMB + MOVEM A,BKTAB(C) ;ALLOCATE NEW ENTRY + MOVEM B,BKTAB+1(C) ;STORE NAME, LEVEL, SUPPRO. + MOVEI A,BKWPB(C) + MOVEM A,BKTABP ;POINTS TO 1ST UNUSED ENTRY. +A.BEG2: IORM AA,BKTAB+2(C) ;INDICATE BLOCK SEEN THIS PASS. + MOVEM C,BKCUR ;NEW BLOCK NOW CURRENT BLOCK, + AOS A,BKLVL ;ITS LEVEL NOW CURRENT LEVEL, + CAIL A,BKPDLS ;PUSH IT ON BLOCK PDL + ERF 'BTD ;(BLOCK PDL OV) + MOVEM C,BKPDL(A) + JRST ASSEM1 + +;.END - POP CURRENT BLOCK. +A.END: SKIPE CONDEP ;IN CONSTANT => TERMINATE IT & ERROR. + JSP LINK,CONFLM + MOVE A,CDISP ;IF FOLLOWED BY WORD TERM, + TLNN A,DWRD ;CAUSE IT TO BE RE-READ + TLO I,UNRCHF ;SO ARG WILL BE NULL. + PUSHJ P,GETSLD ;READ ARG. + JRST A.END0 ;NO ARG. + MOVE C,BKCUR ;ERROR UNLESS BLOCK BEING TERMINATED + MOVE A,BKTAB(C) ;HAS SAME NAME AS ARG. + EXCH A,SYM ;(MAKE SURE SYM NAME TYPED IS BLOCK'S NAME) + CAME A,SYM + 1000,,'UMB ;ERROR, PRINT SYM (BLOCK'S NAME) + JRST A.END1 + +A.END0: SKIPN BKCUR ;NO ARG, OK TO END ANY BLOCK + 5000,,'UMB ;EXCEPT OUTERMOST. +A.END1: MOVE C,BKCUR + HRRZ C,BKTAB+1(C) + MOVEM C,BKCUR ;POP INTO FATHER OF PREV. CURRENT BLOCK. + SOS BKLVL + JRST ASSEM1 + +;BKTAB: 3-WORD ENTRIES, 1 PER BLOCK, IN NO PARTICULAR ORDER. +;1ST WD HAS SQUOZE NAME OF BLOCK, FLAGS CLEAR. +;2ND WD HAS LEVEL,,BKTAB IDX OF CONTAINING BLOCK("FATHER", "SUPERIOR") +;3RD WD BIT 1.N ON => BLOCK ENTERED ON PASS N. +;SYMBOL TABLE OUTPUT RTN PUTS -2* IN 3RD WD. +;THE FIRST BKTAB ENTRY IS THAT OF THE OUTERMOST BLOCK +;IN WHICH INITIAL SYMS ARE DEFINED, AS WELL AS ALL SYMS IN +;PROGRAMS NOT USING BLOCK STRUCTURE. +;ITS 2ND AND 3RD WDS ARE 0. + +;THE BKPDL IS A TABLE OF BLOCKS CURRENTLY ENTERED & NOT ENDED. +;BKPDL'S 1ST ENTRY IS FOR OUTERMOST BLOCK. +;LAST ENTRY IS BKPDL+@BKLVL, FOR CURRENT BLOCK. + +BKTABS==BKTABL*BKWPB + +VBLK +BLCODE [ +PRGNM: ;PROGRAM NAME IS NAME OF OUTERMOST BLOCK. +BKTAB: BLOCK BKTABS +] +BKTABP: 0 ;IDX IN BKTAB OF 1ST UNUSED ENTRY. +BKPDL: BLOCK BKPDLS ;TABLE OF BLOCKS STARTED, NOT FINISHED. +BKLVL: 0 ;CURRENT BLOCK LEVEL, IDX OF LAST USED IN BKPDL. +BKCUR: 0 ;BKTAB IDX OF CURRENT BLOCK. +ESBK: 0 ;-1 OR BLOCK TO EVAL SYM. IN. +ESL1: 0 ;IN ES, LEVEL OF BLOCK OF BEST SYM SO FAR. +ESL2: 0 ;3RDWRD OF BEST SO FAR. +SADR: 0 ;SYM TAB IDX OF BEST SO FAR. +ESLAST: 0 ;RH IDX OF LAST DEF (EVEN IF NO GOOD) -1 IF NONE + ;SIGN NEG. IF LAST DEF SEEN BEFORE @ESXPUN +ESXPUN: -1 ;IF SEE EXPUNGED OR FREE ENTRY, PUT IDX HERE. +BKTAB1: BLOCK BKTABL ;USED BY SSYMD. +PBLK + +;.SYMTAB ARG ;SAY WANT AT LEAST ARG STE'S IN SYMTAB. +A.SYMTAB: PUSHJ P,AGETFD ;GET DESIRED SYM TAB SIZE. + ERF 'USS ;NO HOPE OF SUCCESS., SYMTAB TOO SMALL. + CAMG A,SYMLEN ;IF HAVE ENOGH ROOM ALREADY, + JRST ASSEM1 ;NO NEED TO RE-INIT. + CAILE A,SYMMAX ;IF WANTS MORE THAN MAXIMUM, ERROR. + ERF 'SCE + SKIPE INICLB ;IF DEFINED ANY MACROS, ETC, + ERF 'INI ;CAN'T RE-INIT SINCE INIT CODE CLOBBERED. + MOVEM A,SYMLEN ;TELL INITS( ABOUT NEW SIZE. + MOVE CH1,MACTAD ;SET UP AC -> START OF INIT CODE + SUBI CH1,MACTBA ;SO IT CAN REFER TO ITSELF. + PUSHJ P,INITS(CH1) ;RE-INIT, SET SYMSIZ, SYMAOB, ETC. + PUSHJ P,MACINI ;INIT PTRS TO END OF MACTAB. + JRST ASSEM1 + +A.OP: PUSHJ P,A.OP1 ;.OP, + JRST VALRET ;RETURNS VALUE + +A.AOP: PUSH P,CMACCR ;.AOP DOESN'T RETURN VALUE +A.OP1: PUSHJ P,AGETFD + ERSM 'U.0 ;UNDEFINED SYMBOL IN FIELD 0 + PUSH P,A + PUSHJ P,AGETFD + ERSM 'U.1 ;UNDEFINED SYMBOL IN FIELD 1 + PUSH P,A ;PDL NOW HAS FIELD 0 AND FIELD 1 + PUSHJ P,AGETFD + ERSM 'U.2 ;UNDEFINED SYMBOL IN FIELD 2 + POP P,B ;B NOW HAS FIELD 1, A HAS FIELD 2, PDL HAS FIELD 0 + EXCH A,B + POP P,T ;T HAS FIELD 0, A HAS FIELD 1, B HAS FIELD 2 + TDNN T,[757,,-1] ;DO NOT SUPPLY AC AND ADR FIELDS IF ANY BITS ON + ;IN INTRUCTION'S AC,X,OR ADR FIELDS + IOR T,[0 A,B] + XCT T + JFCL ;DON'T CARE IF IT SKIPS + MOVEM A,AVAL1' ;STORE C(AC) AS .AVAL1 + MOVEM B,AVAL2' ;STORE C(E) FOR .AVAL2 + POPJ P, ;RETURN TO WHATEVER + +AASCIZ: TDZA T,T +A.ASCII: MOVEI T,1 + MOVEM T,AASCF1 ;STORE TYPE + MOVE D,[440700,,T] + JRST AASC1 + +ASIXBIT: SKIPA D,[440600,,T] +AASCII: MOVE D,[440700,,T] + SETOM AASCF1 ;INDICATE REGULAR +AASC1: TLZE I,MWRD + JRST TEXT2 ;MULTIPLE WORD, FALL IN FOR NEXT SET OF CHARS + HLRZ T,B ;GET FILL CHARACTER + IMUL T,[REPEAT 5,[1_<.RPCNT*7>+]0] ;CONVERT TO ASCII FILL WORD SHIFTED -1 (IMUL SCREW) + LSH T,1 ;SHIFT TO PROPER POSITION (EXTRA IN CASE WANT TO FILL W/ HIGH BIT SET) + MOVEM T,AASEFW ;STORE AS FILL WORD, T NOW SET UP TO ACCUMULATE VALUE + MOVE A,LIMBO1 + CAIN A,40 + PUSHJ P,RCH ;SPACE, GET NEXT CHAR FOR USE AS DELIMITER + MOVEM A,TEXT4 ;STORE TERMINATOR +TEXT7: PUSHJ P,RCH +AASC8: CAMN A,TEXT4 + JRST AASC1A ;TERMINATOR + TLNN D,760000 + JRST TEXT6 ;WORD FULL +TEXT9: TLNE D,100 ;CHECK BOTTOM BIT OF SIZE FIELD OF BP + JRST AASC2 ;SET => NOT SIXBIT + SUBI A,40 + CAILE A,77 + SUBI A,40 ;CONVERT LOWER CASE ASCII TO UPPER CASE + JUMPGE A,.+2 + ERR 'N6B +AASC3: IDPB A,D + TRO I,SYL + JRST TEXT7 + +;TERMINATOR + +AASC1A: TLNN D,760000 ;SKIP UNLESS END OF WORD + SKIPGE AASCF1 ;SKIP UNLESS REGULAR + JRST TEXT5 ;REGULAR OR NOT END OF WORD + MOVEI CH1,1 ;END OF WORD AND NOT REGULAR + JRST AASC1B ;EXTRA 0 NEED FOR Z FLAVOR + +AASC2: CAIN A,"! + SKIPG AASCF1 + JRST AASC3 ;NOT .ASCII OR NOT EXCL + PUSH P,T ;READ FIELD + PUSH P,D + PUSH P,SYM + MOVE D,[SETOM ASUDS1] ;NOW TO SET UP UNDEFINED SYM CONDITION + TLNE FF,PPSS + MOVE D,[ERSM 'USA] ;PUNCHING PASS, UNDEFINED => REAL ERROR + MOVEM D,AASM1 + CLEARM ASUDS1 + PUSHJ P,AGETFD + XCT AASM1 ;"UNDEFINED IN .ASCII" ERROR INSTR, ERROR MESSAGE BUT ONLY ON PASS 2 + ;BUT NOTE THAT ON PASS 2 IT MIGHT ASSEMBLE DIFFERENT NUMBER OF WORDS, + ;CAUSING LOSSAGE IF NOT IN CONSTANT + POP P,SYM + POP P,D + POP P,T + SKIPGE ASUDS1 + MOVNI A,1 ;HAD UNDEFINED SYMS SO ASSUME MAX + SKIPGE ASUDS1 + TLO I,NOOPTF ;ALSO DON'T OPTIMIZE OVER IN CONSTANT + MOVE CH1,[440700,,AASBF] + MOVEM CH1,ASBP1 + MOVEM CH1,ASBP2 + PUSH P,[AASC5] + MOVE CH1,A +AASC6: LSHC CH1,-35. + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,AASC6 + HLRZ A,(P) + ADDI A,"0 + IDPB A,ASBP1 + POPJ P, + +AASC5: MOVEI A,0 + IDPB A,ASBP1 ;END .ASCII NUMBER WITH ZERO +AASC8A: TLNN D,760000 + JRST AASC7 ;END OF WORD + ILDB A,ASBP2 + JUMPE A,AASC9 + IDPB A,D + JRST AASC8A + +AASC9: MOVE A,LIMBO1 + JRST AASC8 + +AASC7: TDZA CH1,CH1 +TEXT6: MOVNI CH1,1 ;WORD FULL +AASC1B: MOVEM CH1,AASCF2 + CLEARM CDISP + MOVEM A,TEXT8 + TLO I,MWRD + MOVE A,T + JRST CLBPOP + + ;GET NEXT WORD + +TEXT2: MOVE T,AASEFW ;INITIALIZE T TO FILL WORD + MOVE A,TEXT8 ;GET NEXT CHAR (ALREADY READ BY RCH) + TRO I,FLD + SKIPGE B,AASCF2 + JRST TEXT9 ;REG OR HAVEN'T READ SECOND DELIMITER, FALL BACK IN + JUMPE B,AASC8A + JRST TEXT5 ;ASCIZ + +VBLK + +AASCF1: 0 ;-1 REG OR SIXBIT, 1 .ASCI 0 ASCIZ +AASCF2: 0 ;MULTIPLE WORD RETURN FLAG -1 REG 0 FINISH ! HACK 1 OUTPUT FILL WORD FOR Z +TEXT4: 0 ;DELIMITER +TEXT8: 0 ;SAVED NEXT CHAR WHILE RETURNING BETWEEN WORDS +ASBP1: 0 ;IDPB TO AASBF ON .ASCII FIELD +ASBP2: 0 ;ILDB FROM AASBF " +AASBF: BLOCK 8 ;ACCUMULATED TYPEOUT OF NUMBER FOR .ASCII, EXTRA LONG FOR HACKERS TYPING OUT BINARY +ASUDS1: 0 ;UNDEFINED SYM FLAG FOR .ASCII DURING PASS 1 +AASM1: 0 ;EXECUTED IF FIELD FOR .ASCII NOT DEFINED +AASEFW: 0 ;FILL WORD + +PBLK + +IGTXT: PUSH P,A ;ROUTINE TO EAT UP TEXT OF UNDESIRED MULTIPLE WORD + PUSHJ P,RCH + CAME A,TEXT4 + JRST .-2 + TLZ I,MWRD + JRST POPAJ + +ASQOZ: HLLM B,(P) ;SAVE FLAG THAT'S 0 FOR SQUOZE, -1 FOR .RSQZ . + PUSHJ P,AGETFD + ERR 'USS + LSH A,36 + PUSH P,A + PUSHJ P,GETSLD ;GET SYM, SAVE DELIMITER FOR REINPUT + ERR 'NAM ;NO NAME? + LDB B,[4000,,SYM] ;GET JUST THE SQUOZE. + SKIPGE -1(P) + PUSHJ P,ASQOZR ;FOR .RSQZ, RIGHT-JUSTIFY IT. + POP P,A + ADD A,B + JRST CLBPOP + +;RIGHT-JUSTIFY THE SQUOZE WORD IN B. +ASQOZR: MOVE SYM,B + IDIVI SYM,50 + JUMPN LINK,CPOPJ ;LAST ISN'T BLANK, DONE. + MOVE B,SYM ;ELSE REPLACE BY WHAT'S SHIFTED RIGHT 1 CHAR. + JRST ASQOZR + + ;COMMON PSEUDO ROUTINE TO RETURN MIDAS INTERNAL QUANTITY + ;ADR IN LH(B)) AS VALUE (EG. .RPCNT, .FNAM1, .AVAL2, ETC. + ;INTSYMS MAY APPEAR TO LEFT OF = + +INTSYM": MOVE A,B ;GET ADR IN LH(A) + JRA A,CLBPOP ;RETURN IT + + ;.YSTGW, .NSTGW ACCORDING TO WHAT'S IN LH(B) + +STGWS: HLLZM B,STGSW + JRST POPJ1 + + ;.TYPE + +A.TYPE: PUSHJ P,GETSLD ;GET NAME + ERR 'NAM ;NO NAME FOR .TYPE TO RETURN TYPE OF + PUSHJ P,ES ;EVALUATE SYM, INTERESTED IN SQUOZE FLAGS RETURNED IN A + MOVEI A,17 ;DIDN'T SKIP, RETURN 17 => UNSEEN +IFN CREFSW,XCT CRFINU + JRST CLBPOP + + ;.FORMAT + +A.FORMAT: PUSHJ P,AGETFD ;GET FIRST FIELD (FORMAT #) + ERSM 'UF1 + PUSH P,A + PUSHJ P,AGETFD ;GET SECOND FIELD (TABLE ENTRY FOR FORMAT NUMBER) + ERSM 'UF2 + POP P,B + MOVEM A,FORTAB-10(B) + JRST ASSEM1 + +A.BYTE: CLEARM NBYTS ;# BYTES ASSEMBLED + CLEARM BYTMT ;TOTAL ACTIVE BYTES IN TABLE + MOVE A,[440700,,BYBYT] ;POINTER TO NEW TABLE + MOVEM A,BYTMP +A.BY1: PUSHJ P,AGETFD ;GET FIELD, .GE. 0 => BYTE, .LT. 0 => HOLE + ERSM 'UBS + MOVE C,ISAV + TRNN C,FLD + JRST A.BY2 ;NO FIELD + MOVM B,A + SKIPGE A + TRO B,100 + IDPB B,BYTMP + AOS BYTMT +A.BY2: TLNE CH1,DWRD ;CDISP LEFT IN CH1 BY AGETFD + JRST A.BY1 ;NOT WORD TERMINATOR + SKIPN BYTMT ;WORD TERMINATOR, ANY FIELDS? + JRST A.BY3 ;NO, DO .WALGN AND RESET TO WORD MODE + SETOM BYTM ;ENTERING BYTE MODE + PUSHJ P,BYSET + MOVE A,GLSPAS + MOVEM A,GLSP1 + JRST ASSEM1 + + ;RESET THE BYTE DESCRIPTOR TABLE POINTERS TO POINT TO NEW WORD + +BYSET: CLEARM BYTMC ;COUNT OF BYTES PROCESSED THIS TABLE SCAN + MOVE A,[440700,,BYBYT] ;POINTER TO DESCRIPTOR TABLE + MOVEM A,BYTMP + ILDB A,BYTMP ;FIRST DESCRIPTOR BYTE + AOS BYTMC + DPB A,[300600,,BYTWP] ;DEPOSIT AS FIRST BYTE SIZE + POPJ P, + +A.BY3: CLEARM BYTM ;NO LONGER IN BYTE MODE + +A.WALGN: LDB A,[360600,,BYTWP] + CAIN A,44 + JRST ASSEM1 ;ALREADY AT BEGINNING OF WORD + MOVEI A,44 + DPB A,[360600,,BYTWP] ;MAKE IT POINT TO BEGINNING OF WORD + PUSHJ P,BYSET + CLEARM T1 + JRST PBY1 + +BYTIN1: CLEARM BYTMC + MOVE A,[440700,,BYBYT] + MOVEM A,BYTMP +BYTINC: AOS A,BYTMC + CAMLE A,BYTMT + JRST BYTIN1 + ILDB A,BYTMP + DPB A,[300600,,BYTWP] + MOVEM A,T1 + HLLZ A,BYTWP + IBP A + TRNN A,-1 + JRST BYTINR + ;NEXT BYTE GOES IN NEXT WORD +PBY1: MOVE P,ASSEMP ;PCONS NEEDS THIS. + MOVEI A,WRD-1 + PUSH A,BYTW ;INTO WRD, + PUSH A,BYTRLC ;INTO WRDRLC + CLEARM BYTW + SETZM BYTRLC + MOVEI A,44 + DPB A,[360600,,BYTWP] + SKIPE CONDEP + JRST PBY3 + SKIPE STGSW + ERR 'SWD + PUSHJ P,PWRD ;NOT IN CONST., OUTPUT WORD. + AOSA CLOC +PBY3: JSP T,PCONS ;OUTPUT INTO CONST. + MOVE A,GLSPAS + MOVEM A,GLSP1 +BYTINR: MOVE A,T1 ;CURRENT BYTE SIZE + TRNN A,100 + JRST ASSEM0 + SETZB A,B ;ASSEMBLE HOLE (BLANK BYTE) IMMEDIATELY AFTER PREVIOUS BYTE + JRST PBY2 + +PBYTE: AOS NBYTS +PBY2: MOVEI AA,WRD-1 + PUSH AA,BYTW ;INTO WRD + PUSH AA,BYTRLC ;INTO WRDRLC + IBP BYTWP + LDB T,[301400,,BYTWP] + PUSHJ P,INTFLD + POP AA,BYTRLC ;WRDRLC + POP AA,BYTW ;WRD + JRST BYTINC + + ;VARIABLES FOR .BYTE, .BYTC, .WALGN + +VBLK +BYTM: 0 ;-1 FOR IN BYTE MODE +BYTMC: 0 ;COUNT CORRESP WITH BYTMP +BYTMP: 0 ;POINTER TO BYTE DESC TABLE +BYTMT: 0 ;TOTAL ACTIVE BYTES IN TABLE + +;FORMAT OF BYTE DESC TABLE +;SEVEN BIT BYTES +;1.7=0 ASSEMBLE =1 BLANK +;1.1 - 1.6 NUMBER OF BITS + +IFNDEF LBYBYT,LBYBYT==5 ;LENGTH OF BYBYT +BLCODE [BYBYT: BLOCK LBYBYT] ;BYTE DESC TABLE, 7 BITS PER DESC + +BYTWP: 440000,,BYTW ;POINTER TO BYTW IDPB TO DEPOSIT CURRENT BYTE +BYTW: 0 ;WORD BEING ASSEMBLED IN BYTE MODE +BYTRLC: 0 ;RELOC OF BYTW. +NBYTS: 0 ;NUMBER BYTES ASSEMBLED (FOR .BYTC) +BYTMCL==.-BYTMC +PBLK + ;;MACRO PROCESSOR +IFN MACSW,[ + ;GET IN B THE CHAR WHOSE ADR IS IN A, INCREMENT A + +REDINC: MOVE CH1,A + IDIVI CH1,4 + LDB B,PTAB(CH2) + AOJA A,CPOPJ + +VBLK ;THIS STUFF ALL RELOCATED WHEN MACTAB ADDR CHANGED. +PTAB: (341000+CH1)MACTBA ;BYTE TABLE + (241000+CH1)MACTBA + (141000+CH1)MACTBA + (41000+CH1)MACTBA + (341000+CH1)MACTBA+1 + + ;IN FOLLOWING MACROS, B = -1, 0, OR +1 (+ SIGN MUST BE GIVEN) + ;0 => BP SAME AS CHAR ADR, -1 => BP FOR ILDB, 1 => BP ONE AHEAD + + ;CHAR ADR IN A, RETURNS BP IN A, CLOBBERS A+1 + +DEFINE BCOMP A,B/ + IDIVI ,4 + ADD ,(+1)BCOMPT!B +TERMIN + +STOPPT: 041000,,MACTBA-1 +BCOMPT: 341000,,MACTBA + 241000,,MACTBA +BCOMPU: 141000,,MACTBA + 041000,,MACTBA + 341000,,MACTBA+1 + + ;BP IN A RETURN CHAR ADR IN A, CLOBBERS A-1 (YES, A MINUS 1) + +DEFINE CCOMP A,B/ + MOVEI -1,0 + ASHC -1,2 + SUB ,(-1)CCOMPT!B +TERMIN + + ;BP IN A RETURN CHAR ADR IN A+1, CLOBBERS A + +DEFINE CCOMP1 A,B/ + MULI ,4 + SUB +1,(A)CCOMPT!B +TERMIN + +;FROM HERE THRU CCOMPE RELOCATED BY 4*SHIFT IN MACTAB +CCOMPB: <41000,,MACTBA>*4-4 +CCOMPT: REPEAT 5,<41000,,MACTBA>*4-3+.RPCNT +CCOMPE: PBLK + + ;BP IN A, DECREMENT IT + +DEFINE DBPM A + ADD A,[100000,,] + SKIPGE A + SUB A,[400000,,1] +TERMIN + + ;SET UP CPTR FROM CHAR ADR IN A + +ACPTRS: MOVEI CH1,(A) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE COMPUTED CPTR + POPJ P, + +AFCOMP: HRRZM A,FREEPT ;ENTRY TO STORE C(A) INTO FREEPT +FCOMP: MOVE CH1,FREEPT ;COMPUTE FREPTB FROM FREEPT + BCOMP CH1,-1 + MOVEM CH1,FREPTB ;STORE CALCULATED BYTE POINTER + POPJ P, + +VBLK +PUTREL: JRST PUTRE1 ;IDPB A,FREPTB;STORE CHAR INTO FREE CHARACTER STORAGE + AOS A,FREEPT + AOS PUTCNT + CAMGE A,MACHI + POPJ P, + JRST GCA +PBLK +PUTRE1: PUSH P,[IDPB A,FREPTB] + POP P,PUTREL ;COME HERE ONLY ON 1ST CALL TO PUTREL. + SETOM INICLB ;HAVE WRITTEN IN MACRO TAB & CLOBBERED INIT. + JRST PUTREL ;NOW GO BACK AND REALLY WRITE CHAR. + + ;200 BIT SET ON CHAR READ FROM MACTAB, PROCESS SPECIAL CONDITION + +MACTRM: CAIN A,176 ;376? + JRST RCHTRA ;376 => IGNORE, CHARACTER USED TO CLOBBER UNDESIRED CHARACTERS IN MACRO STORAGE + PUSH P,B ;SAVE B + CAIE A,177 + CAIN A,175 + JRST MRCH1 ;367, 375 => STOP + ADD A,BBASE ;DUMMY, RELOCATE TO POINT TO DUMMY TABLE + MOVEI B,RCHSAV ;RETURN TO RCHSAV ON END OF DUMMY + PUSHJ P,PUSHEM ;SAVE CURRENT STATUS + HRRZ A,(A) ;GET CHAR ADR OF DUMMY + BCOMP A,-1 ;CONVERT TO BYTE POINTER + MOVEM A,CPTR ;STORE AS NEW CPTR + MOVE A,TOPP + MOVEM A,BBASE +RCHTRB": POP P,B +RCHTRA": POP P,A ;POP RETURN + TLZN I,UNRCHF + JRST -3(A) + JRST -4(A) + +MRCH1: MOVE B,MACP +BPOPJ: POPJ B, ;RETURN AT END OF STRING EXPANSION + + ;RCHSET ROUTINE TO CAUSE INPUT FROM MACRO PROCESSOR + +RCHMAC": TLO FF,MACRCH ;SET FLAG + JSP A,CPOPJ +RCHMC0: REPEAT 2,[ ;GETCHR, RR1 + ILDB A,CPTR ;GET CHAR + TRZE A,200 ;200 BIT... + PUSHJ P,MACTRM ;=> SPECIAL, PROCESS +] + ERF 'IAE ;RRL1 +IFN .-RCHPSN-RCHMC0,[PRINTC /RCHMC0 LOSES. +/] + ILDB A,CPTR ;SEMIC + TRZE A,200 + PUSHJ P,MACTRM + CAIE A,15 + JRST SEMIC ;NOT YET + JRST SEMICR ;YET + + ;PUSH INPUT STATUS IN FAVOR OF MACRO + ;B HAS RETURN ADR FOR END OF MACRO (OR WHATEVER) + ;SEE ALSO PMACP + +PUSHEM: PUSH P,A + PUSH P,F + MOVE F,MACP ;GET MACRO PDL POINTER + MOVE CH1,CPTR + CCOMP1 CH1,-1 ;CONVERT TO CHARACTER ADDRESS + HRL CH2,BBASE + PUSH F,CH2 ;PUSH BBASE,,CPTR + MOVEI A,1 ;=> EXPAND MACRO + PUSHJ P,PSHLMB ;SAVE LIMBO1 STATUS AND RETURN + JRST PSHM1 + + ;UNDO A PUSHEM + ;RETURNS BBASE,,CPTR IN B (CPTR RE-INITIALIZED, BBASE NOT) + +POPEM: PUSH P,A + PUSH P,F + MOVE F,MACP + PUSHJ P,POPLMB ;RESTORE LIMBO1 STATUS + POP F,B ;BBASE,,CPTR + MOVEI CH1,(B) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE NEW CPTR +PSHM1: MOVEM F,MACP ;STORE BACK MACRO PDL POINTER +POPFAJ: POP P,F +POPAJ: POP P,A + POPJ P, + +PMACP: MOVE B,MACP ;POP MACRO PDL + HRRZ A,(B) + SUB B,[1,,1] +IFN RCHASW,CAIE A,A.TYM8 + CAIN A,AIRP4 + JRST A.GO6 ;IRP OR .TTYMAC + CAIN A,REPT1 + JRST A.GO4 ;REPEAT + CAIE A,RCHSV1 ;MACRO + CAIN A,RCHSAV ;ARG + JRST A.GO6 + ERR 'UCP ;DON'T HAVE RETURN, + JRST A.GO6 ;BUT TRY A.GO6 LIKE EVERYTHING BUT REPEAT + +A.GO4: HLLZS -1(B) ;REPEAT, CLEAR OUT COUNT REMAINING +A.GO6: TRO FF,MRSW ;EVERYTHING ELSE, SET FLAG TO QUIT + JRST (A) + + ;4.9(B) => .STOP ELSE .ISTOP + +A.STOP: HRRZ A,MACP + JUMPL B,A.STP1 + HRRZ B,(A) ;.ISTOP + CAIN B,AIRP4 + HRRZS -1(A) ;IRP TYPE, CLEAR OUT # GROUPS, DON'T ALLOW RECYCLE +A.STP1: MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP + JRST POPJ1 + +A.QOTE: ERA 'QTL ;.QUOTE ON TOP LEVEL + +ATERMI: ERSM 'TTL ;TERMIN ON TOP LEVEL + JRST MACCR ;MAYBE FLUSH MESSAGE IF PEOPLE HAVE PROBLEMS + + ;PDL STRUCTURE FOR REPEAT + ;TWO TWO WORD ENTRIES + ;BBASE,,CPTR + ;LIMBO1 STATUS,,# TIMES LEFT + ;OLD .RPCNT,,BEG OF BODY + ;GARBAGE,,REPT1 + +AREPEAT: PUSHJ P,AGETFD + ERSM 'USR + JUMPLE A,COND4 ;NO REPEAT PLAY LIKE STRING COND FALSE + PUSH P,A + MOVE A,FREEPT + MOVEM A,PRREPT ;CHAR ADR BEGINNING OF REPEAT + MOVEI A,373 ;CHECK CHAR FOR REPEAT + PUSHJ P,PUTREL ;STORE AS FIRST CHR OF BODY + MOVSI LINK,400000+RDRPTF + PUSHJ P,RDWRDN + MOVEI A,15 + CAIE T,RBRKT + PUSHJ P,PUTREL +SWRET1: PUSHJ P,STPWR ;ALSO RETURN FROM STRING WRITE (.F .I) + POP P,B ;# TIMES TO GO THROUGH + PUSHJ P,PUSHEM + MOVE B,MACP ;NOW GET MACRO PDL POINTER FOR PUSH OF SECOND ENTRY + MOVNI T,1 + EXCH T,CRPTCT ;GET OLD .RPCNT, INITIALIZE NEW ONE TO -1 +CREPT1: SETZI TT,REPT1 + EXCH TT,PRREPT ;GET LOC BEGINNING OF BODY, CLEAR OUT PRREPT, DON'T NEED IT ANYMORE + HRL TT,T + PUSH B,TT ;SAVE OLD .RPCNT,,# TIMES TO GO THROUGH + PUSH B,CREPT1 ;PUSH CRUD,,REPT1 FOR RETURN + MOVEM B,MACP ;STORE BACK UPDATED MACRO POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE IMMEDIATE CYCLE + JRST MACCR + +IFN .I.FSW,[ ;CODING FOR .I, .F + +SWINI: MOVE A,FREEPT ;INITIALIZE, WILL EVENTUALLY PLAY LIKE REPEAT 1 + MOVEM A,PRREPT + MOVEI A,373 + JRST PUTREL + +SWRET: PUSH P,[1] ;REPEAT COUNT + JRST SWRET1 + +SWFLS: MOVE A,PRREPT ;FLUSH RETURN + PUSHJ P,AFCOMP + JRST MACCR +] + + ;RECYCLE AROUND REPEAT + +REPT1: PUSH P,A + PUSH P,C + HRRZ A,(B) ;CHAR ADR BEG BODY + PUSHJ P,REDINC + CAIE B,373 + ERF 'IAE ;FIRST CHAR OF REPEAT BODY NOT 373 + HRRZ C,MACP + HRRZ B,-2(C) ;# TIMES LEFT + SOJL B,REPT2 ;JUMP IF LAST TIME THROUGH WAS LAST TIME TO GO THROUGH + AOS CRPTCT + PUSHJ P,ACPTRS ;SET UP CPTR (CHAR ADR IN A) + HRRM B,-2(C) ;STORE UPDATED COUNTDOWN +REPT3: POP P,C + POP P,A + JRST REPT6 + +REPT2: SOS A ;MOVE BACK TO BEG OF REPEAT + ;(IN CASE GETS STORED INTO FREEPT) + MOVE CH2,CPTR + CCOMP CH2,-1 ;CONVERT TO CHARACTER ADDRESS + CAMN CH2,FREEPT + PUSHJ P,AFCOMP + MOVE A,[-3,,-2] + ADDB A,MACP + HLRZ A,1(A) + MOVEM A,CRPTCT + PUSHJ P,POPEM + JRST REPT3 + + ;STRING CONDITIONALS (IFSE, IFSN) + +SCOND: MOVE A,FREEPT + MOVEM A,PRSCND + MOVEM A,PRSCN1 + HRRI B,SCONDF + MOVEM B,SCINST ;STORE TEST INSTRUCTION + MOVEI LINK,0 + PUSHJ P,RDWRDN ;READ IN FIRST STRING + SETOB C,SCONDF + PUSHJ P,RCH ;GET FIRST CHARACTER OF SECOND STRING + CAIN A,LBRKT + MOVEI C,0 ;BRACKETED STRING + SKIPN C +SCND2A: PUSHJ P,RCH + JUMPGE C,SCOND1 ;JUMP IF PROCESSING BRACKETED STRING + CAIN A,", ;NOT BRACKETED, CHECK FOR COMMA + JRST SCOND3 ;END OF SECOND STRING +SCOND6: EXCH A,PRSCND + PUSHJ P,REDINC ;GET COMPARISON CHARACTER + EXCH A,PRSCND + CAMN B,A ;COMPARE CHARACTERS + JRST SCND2A + CLEARM SCONDF ;STRINGS DIFFER +SCOND5: PUSHJ P,RCH + JUMPGE C,SCOND7 + CAIE A,", + JRST SCOND5 +SCOND3: CLEARB A,C ;END OF (SECOND) STRING ARG ENCOUNTERED + EXCH C,PRSCN1 + MOVEM C,FREEPT + PUSHJ P,FCOMP + EXCH A,PRSCND + PUSHJ P,REDINC + CAIE B,375 + CLEARM SCONDF + XCT SCINST + JRST COND4 + JRST COND2 + +SCOND1: PUSHJ P,QSCNT ;SECOND STRING ARG BRACKETED, CHECK CHAR + JRST SCOND6 ;NOT END + JRST SCOND3 ;RIGHT BRACKET + +SCOND7: PUSHJ P,QSCNT + JRST SCOND5 + JRST SCOND3 + +VBLK +BLCODE [DMYDEF: BLOCK DMDEFL] ;TABLE OF DUMMY NAMES FOR THING BEING DEFINED +DMYTOP: DMYDEF ;POINTER INTO DMYDEF, POINTS TO AVAILABLE WORD + ;SINCE ONLY ONE THING CAN BE DEFINED AT ONCE, IT IS NOT NECESSARY TO SAVE AND RESTORE DMYTOP +PBLK + +PDEF: PUSHJ P,GSYL ;READ IN SYL + CAIE T,", ;IF DELIMITING CHR NOT , + JUMPE SYM,CPOPJ ;AND SYM NULL, RETURN +PDEF1: MOVEM SYM,@DMYTOP ;STORE SYM + AOS A,DMYTOP ;INCR PNTR + CAIL A,DMYDEF+DMDEFL ;CHECK FOR TABLE SIZE EXCEEDED + ERF 'TMD ;YES + POPJ P, + +VBLK +BLCODE [DSTG: BLOCK DSSIZ] ;TABLE OF CHAR ADRS OF DUMMIES BEING DEFINED PRIOR TO MACRO EXPANSION +RDWRDP: DSTG ;POINTER TO DSTG, POINTS TO FREE WORD + ;NOTE THAT RDWRDP MUST BE SAVED AND RESTORED SINCE MORE MACROS CAN + ;BE EXPANDED DURING FIELD READ FOR DUMMY +PBLK + +ADDTR1: CLEARM PUTCNT +ADDTRN: MOVE A,FREEPT +ADDTR2: MOVEM A,@RDWRDP + AOS A,RDWRDP + CAIL A,DSTG+DSSIZ + ERF 'TMA +CRDWR7: POPJ P,RDWR7 + +VBLK +BLCODE [DMYAGT: BLOCK DMYAGL] ;TABLE OF CHAR ADRS OF DUMMYS OF MACROS BEING EXPANDED + ;DMYAGT TRACKS WITH THE MACRO PDL; + ;DMYAGT CAN'T BE COMBINED WITH DSTG SINCE DMYAGT CAN BE SHIFTING AROUND RANDOMLY DURING ARG SCAN +BBASE: DMYAGT ;POINTER TO BEGINNING OF ACTIVE DUMMY LIST (FOR DEEPEST-NESTED MACRO BEING EXPANDED) + ;ADD TO DUMMY # TO GET LOCATION CONTAINING CHAR ADR OF DUMMY +TOPP: DMYAGT ;POINTER TO TOP OF DMYAGT ACTIVE, POINTS TO FREE REGISTER +PBLK + + ;ACTIVATE DUMMYS ON TOP OF DSTG TABLE + ;A -> FIRST (LOWEST) DUMMY IN DSTG TO ACTIVATE + +DMYTRN: MOVE B,TOPP + MOVEM B,BBASE + PUSH P,A +DMYTR2: CAML A,RDWRDP + JRST DMYTR1 + MOVE B,(A) + MOVEM B,@TOPP + AOS B,TOPP + CAIL B,DMYAGT+DMYAGL + ERF 'TMD + AOJA A,DMYTR2 +DMYTR1: POP P,RDWRDP + POPJ P, + +STRTYP: PUSHJ P,REDINC ;DEBUGGING AID ONLY + EXCH A,B + TRZE A,200 + JRST STRTP1 +STRTP2: PUSHJ P,TYO" ;NORMAL CHAR, JUST TYPE OUT + MOVE A,B + JRST STRTYP + +STRTP1: PUSH P,A + MOVEI A,"* ;SPECIAL CHAR, TYPE * + PUSHJ P,TYO + POP P,A + TRNE A,100 + JRST STRTP3 ;CONTROL CHAR + ADDI A,260 ;DUMMY, CONVERT TO # + JRST STRTP2 ;TYPE OUT (SINGLE DIGIT) NUMBER + +STRTP3: CAIN A,175 + SKIPA A,C% ;STOP, TYPE % + MOVEI A,"/ ;SOMETHING ELSE, TYPE / + JRST STRTP2 + + + ;.GSSET, SET GENERATED SYM COUNTER + +A.GSSET: PUSHJ P,AGETWD + ERSM 'USG + MOVEM A,GENSM + JRST ASSEM1 + +;MACRO PROC FLAGS (IN LH(LINK)) + +SCEND==200 ;SCAN END +GENF==400 ;GENERATED ARGS +LNSCN==1000 ;ACTIVATE LINE SCAN ON LAST LINE +ALNSCN==2000 ;LINE SCAN ACTIVE +;400000 SAYS COMMAS DO NOT BREAK ARG +RDRPTF==4000 ;REPEAT +LCRIND=10000 ;CR SEEN AFTER RIGHT BRACKET + +RDWRDA: PUSHJ P,ADDTR1 +RDWRDN: PUSHJ P,RCH ;ENTRY FROM STRING COND, AREPEAT ETC + TLNE LINK,ALNSCN + JRST RDWR3 ;DONT QUIT UNTIL CR OR LF + CAIN A,LBRKT + JRST RDWR1 ;IF FIRST CHAR LBRACK, READ UNTIL MATCHING RBRACK + CAIN A,"\ ;IF FIRST CHAR \ + JUMPGE LINK,RDWR6 ;AND NORM ARG READ, THEN PROCESS FIELD +RDWR3: CAIE A,15 ;ON CR + CAIN A,12 ;OR LF + JRST RDWR2C ;EXIT + CAIN A,"; ;ON SEMI + JUMPGE LINK,RDWR2D ;ON NORMAL SCAN CAUSE SEMI TO BE REINPUT AND RET + CAIN A,", ;IF COMMA + JUMPGE LINK,RDWR2 ;END THIS ARG + PUSHJ P,PUTREL ;NOTA, DEPOSIT THIS CHR + PUSHJ P,RCH ;GET NEXT CHR + JRST RDWR3 ;AND LOOP BACK,NOT CHECKING FOR LBRKT OR \ + +RDWR2D: TLO I,UNRCHF + JRST RDWR2C + +RDWR7: MOVE A,LIMBO1 + CAIE A,15 + CAIN A,12 +RDWR2C: TLO LINK,SCEND ;SCAN ENDED +RDWR2: MOVE T,A ;RET LAST CHR IN T + TLNE LINK,RDRPTF ;ON REPEAT, + POPJ P, ;THATS ALL RETURN +RDWR2A: HRL A,PUTCNT ;SAVE COUNT OF LENGTH THIS ARG IN CHRS + HRR A,RDWRDP + HLLM A,-1(A) +STPWR: MOVEI A,375 ;WRITE STOP CODE + JRST PUTREL + + ;PROCESS FIELD + +RDWR6: SOS RDWRDP ;BACK UP RDWRDP, MAY BE USED BY MACRO IN FIELD + PUSH P,LINK ;SAVE LINK, NEED FLAGS + PUSHJ P,AGETFD ;GET THE FIELD + ERSM 'USM + POP P,LINK + MOVE CH1,A ;SAVE VALUE OF FIELD FROM CLOBBERAGE + PUSHJ P,ADDTR1 ;RE-GENERATE DUMMY + PUSH P,CRDWR7 ;RETURN TO RDWR7 +RDWR6A: LSHC CH1,-35. ;NOW "TYPE OUT" VALUE OF FIELD IN CURRENT RADIX + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,RDWR6A + HLRZ A,(P) + ADDI A,60 + JRST PUTREL ;OUTPUT TO MACTAB STRING BEING DEFINED + +RDWR1: TDZA C,C ;READ UNTIL RIGHT BRACKET +RDWR1A: PUSHJ P,PUTREL + PUSHJ P,RCHCNT + JRST RDWR1A + + TLNE LINK,RDRPTF + JRST RDWR2 ;REPEAT, SKIP FOLLOWING + +RDWR2B: PUSHJ P,RCH + TLO I,UNRCHF + CAIE A,15 + CAIN A,12 + TLO LINK,SCEND+LCRIND ;CR OR LF + JRST RDWR2 + +RCHCNT: PUSHJ P,RCH ;GET CHARACTER +QSCNT: CAIN A,LBRKT ;SKIP IF CHAR IS MATCHING RBRAK + AOJA C,CPOPJ + CAIN A,RBRKT + SOJL C,POPJ1 + POPJ P, + +IFE WRQTSW,[ +WRTSS: MOVE T,[440700,,STRSTO] ;COPY STRING STORAGE (INCL DELIMITER) INTO MACTAB: GET INPUT POINTER + MOVE B,STRCNT ;GET COUNT + SOJL B,CPOPJ ;DECREMENT COUNT, RETURN IF DONE + ILDB A,T ;GET CHAR FROM STRING + PUSHJ P,PUTREL ;COPY OUT + JRST .-3 +] + +IFE WRQTSW,[ ;SLOW WRQOTE + + ;READ IN BODY OF MACRO OR WHATEVER + +WRQOTE: CLEARM DCNT ;CLEAR DEFINE/TERMIN LEVEL COUNT + SETOM INICLB ;WROTE IN MACTAB, CLOBBERED INITS. +WRQOT0: PUSHJ P,GSYL + JUMPE SYM,WRQOT1 ;JUMP ON NO SYM + PUSHJ P,ES + MOVEI A,0 ;NOT SEEN + MOVE TT,A + CAIE A,PSUDO/40000 + JRST WRQOT4 ;NOT PSEUDO + HRRZS B + CAIN B,A.QOTE + JRST A.QOT1 ;.QUOTE +WRQOT4: MOVEI A,DMYDEF ;NOW CHECK FOR DUMMYS + CAML A,DMYTOP + JRST WRQOT2 ;NO MORE DUMMY NAMES TO COMPARE WITH + CAME SYM,(A) + AOJA A,.-3 + SUBI A,DMYDEF-200 ;DUMMY, CONVERT TO # + 200 + LDB B,FREPTB ;GET LAST CHAR ALREADY THERE + CAIE B,"! ;IF CHAR JUST BEFORE DUMMY NOT EXCLAMATION POINT, + PUSHJ P,PUTREL ;THEN DEPOSIT DUMMY+200 AS NEXT CHAR + CAIN B,"! ;IF LAST CHAR BEFORE DUMMY IS EXCL, + DPB A,FREPTB ;THEN FLUSH IT, CLOBBERING IT WITH DUMMY # + 200 + MOVE A,T + CAIE A,"! + PUSHJ P,PUTREL ;STORE SYL TERMINATOR + JRST WRQOT0 + +WRQOT2: CAIE TT,PSUDO/40000 ;NOT DUMMY, PSEUDO? + JRST WRQOT1 ;NO, COPY INTO MACRO BODY AND LOOP + CAIE B,ADEFINE ;YES, DEFINE? + CAIN B,AIRP ;IRP? + AOS DCNT ;DEFINE OR IRP, MATCHED BY TERMIN +IFN RCHASW,[CAIN B,A.TTYM ;.TTYMAC? + AOS DCNT ;YES +] CAIN B,ATERMIN ;TERMIN? + SOSL DCNT ;TERMIN, SKIP IF MATCHING ONE + JRST WRQOT1 ;NOT MATCHING TERMIN, LOOP + POPJ P, + +WRQOT1: PUSHJ P,WRTSS ;COPY STRING + JRST WRQOT0 + +A.QOT1: MOVE A,LIMBO1 ;.QUOTE DURING READIN, TAKES ARG LIKE ASCII + CAIN A,40 + PUSHJ P,RCH + MOVEM A,A.QOT2 +A.QOT3: PUSHJ P,RCH + CAMN A,A.QOT2 + JRST WRQOT0 + PUSHJ P,PUTREL + JRST A.QOT3 +] + +IFE WRQTSW-1,[ ;FAST WRQOTE + + ;GSYL-LIKE ROUTINE, READ A SYL FOR WRQOTE + +WRQRR: PUSHJ P,RCH ;GET CHAR (MAYBE WANT THIS TO BE FASTER YET) + IDPB A,FREPTB ;DEPOSIT IN MACRO TABLE + CAMN F,FREPTB ;WAS THIS LAST CHAR IN TABLE? + JRST WRQRGC ;YES, NEED GARBAGE COLLECTION +WRQRR2: XCT GDTAB(A) ;DISPATCH ON CHAR + JFCL ;(MAYBE SKIPS) + SOJGE D,WRQRR ;LOOP FOR FIRST SEVEN CHARS + AOJA D,WRQRR ;EIGHTH CHAR OR AFTER + + ;HERE FROM WRQRR WHEN NEED GARBAGE COLLECTION OF MACRO TABLE + +WRQRGC: MOVEM C,WRQTBP ;PUT POINTER TO BEGINNING OF SYL WHERE IT WILL BE GC'D + MOVE A,MACHI + PUSHJ P,GCA ;GARBAGE COLLECT + MOVE F,MACHIB ;RESET F TO POINT TO NEW LAST CHAR IN MACTAB + MOVEI C,0 + EXCH C,WRQTBP ;GET BACK POINTER TO CHAR BEFORE SYL + MOVE A,LIMBO1 ;RETRIEVE LAST CHAR READ + JRST WRQRR2 ;LOOP BACK, PROCESS CHAR + + ;HERE FROM WRQOTE IF .QUOTE SEEN + ;.QUOTE TAKES ARG LIKE ASCII, PRINTC, ETC. + +A.QOT1: POP P,A ;GET BACK BP TO CHAR BEFORE .QUOTE + PUSHJ P,A.QOTS ;SET UP FREEPT AND FREPTB PROPERLY + MOVE A,LIMBO1 ;NOW GET CHAR AFTER .QUOTE + CAIN A,40 ;COMPARE WITH SPACE + PUSHJ P,RCH ;SPACE, GOBBLE NEXT CHAR FOR DELIMITER, ELSE THIS ONE + MOVEM A,A.QOT2 ;STORE AS TERMINATOR OF STRING +A.QOT3: PUSHJ P,RCH ;GET CHAR TO QUOTE + CAMN A,A.QOT2 ;TERMINATOR? + JRST WRQOT1 ;TERMINATOR, BACK FOR MORE DEFINITION + PUSHJ P,PUTREL ;DEPOSIT CHAR + JRST A.QOT3 + + ;READ IN BODY OF MACRO, IRP, OR WHATEVER + +WRQOTE: SETZM DCNT ;CLEAR DEFINE/TERMIN LEVEL COUNT + SETOM INICLB ;CLOBBERED INITS. + PUSHJ P,RCH ;MAYBE POP UP A LEVEL IN EXPANSIONS, SAVE MACTAB SPACE + TLO I,UNRCHF ;CAUSE CHAR TO BE RE-INPUT + MOVE F,MACHIB ;POINTER TO LAST CHAR OK TO PUT IN MACTAB, STAYS IN F + TROA I,SYL\LET ;MAKE SURE FLAGS SET SO WON'T WASTE TIME AT MAKNUM, POINT +WRQOT0: POP P,C ;LOOP POINT, THROW AWAY POINTER TO LAST SYL +WRQOT1: MOVEI D,6 ;SQUOZE COUNTER + MOVEI SYM,0 ;INITIALIZE SYM + MOVE C,FREPTB ;GET POINTER TO CHAR BEFORE SYL ABOUT TO READ + PUSHJ P,WRQRR ;READ SYL + JUMPE SYM,.-2 ;LOOP UNTIL NON-NULL + ;NOW SEE IF DUMMY; **NOTE**: C STILL HAS BYTE POINTER, A SYL TERMINATOR + MOVEI B,DMYDEF + CAML B,DMYTOP + JRST WRQOT2 ;NOT DUMMY + CAME SYM,(B) ;COMPARE WITH DUMMY NAME + AOJA B,.-3 ;LOOP ON NO MATCH + SUBI B,DMYDEF-200 ;DUMMY, CONVERT TO NUMBER + 200 + LDB T,C ;GET LAST CHAR BEFORE SYL + CAIE T,"! ; ^ NOTE THAT THIS CAN LOSE IF MACRO HAS 33. ARGS + IDPB B,C ;NOT EXCLAMATION POINT, LEAVE THERE, DEPOSITING DUMMY CHAR + CAIN T,"! + DPB B,C ;EXCL, WIPE IT OUT + MOVEM C,FREPTB ;RESET FREPTB + CAIE A,"! ;A HAS DUMMY TERMINATOR, COMPARE WITH EXCL + TLO I,UNRCHF ;NOT EXCLAMATION POINT, CAUSE IT TO BE RE-INPUT + JRST WRQOT1 ;LOOP BACK FOR NEXT SYL + +WRQOT2: PUSH P,C ;SYL ISN'T DUMMY, CHECK FOR PSEUDO + SETOM ESBK ;EVAL IN CURRENT BLOCK. + PUSHJ P,ES ;EVALUATE SYM (DOESN'T CLOBBER F) + JRST WRQOT0 ;NOT SEEN + CAIE A,PSUDO/40000 + JRST WRQOT0 ;NOT PSEUDO + TLZ B,-1 ;CLEAR OUT LH OF VALUE, ONLY INTERESTED IN RH + CAIN B,A.QOTE + JRST A.QOT1 ;.QUOTE + CAIE B,ADEFINE + CAIN B,AIRP + AOS DCNT ;DEFINE OR IRP +IFN RCHASW,[CAIN B,A.TTYM + AOS DCNT ;.TTYMAC +] CAIN B,ATERMIN + SOSL DCNT ;TERMIN, SKIP IF THE TERMINATING ONE + JRST WRQOT0 ;NOT MATCHING TERMIN, BACK FOR NEXT SYL + POP P,A ;GET BACK BP TO LAST CHAR BEFORE TERMIN +A.QOTS: LDB T,A ;HERE ALSO FROM A.QOT1, GET CHAR BEFORE .QUOTE OR TERMIN + CAIE B,"! + JRST A.QTS2 ;NOT EXCLAMATION POINT => OK + DBPM A, ;EXCLAMATION POINT, DECREMENT POINTER +A.QTS2: MOVEM A,FREPTB ;STORE AS NEW FREPTB + CCOMP1 A,-1 ;CONVERT TO CHAR ADR + MOVEM B,FREEPT ;STORE CHAR ADR AS NEW FREEPT + POPJ P, +] + +ADEFINE: MOVEI A,DMYDEF + MOVEM A,DMYTOP + PUSHJ P,GETSYL + JUMPE SYM,.-1 ;KEEP TRYING UNTIL MACRO NAME THERE + MOVEM SYM,MACNM + PUSH P,ESBK ;SAVE BLOCK TO DEFINE IN FOR ES'S SAKE. +IFN CREFSW,XCT CRFMCD + MOVE A,FREEPT + MOVEM A,PRDEF + CLEARB LINK,B ;B COUNT + MOVEI A,374 + PUSHJ P,PUTREL ;MARK BEGINNING OF MACRO + MOVE T,LIMBO1 +DEFNC: CAIE T,12 + CAIN T,15 + JRST DEFNA ;NO MORE ARGS (DONE WITH LINE) + CAIN T,"\ + JRST DEFNB + CAIN T,"/ + JRST DEFNE + CAIN T,"; + JRST DEFNSM ;ALLOW DEFINE LINE TO BE COMMENTED +DEFND: PUSHJ P,PDEF + JUMPE SYM,DEFNC ;JUMP IF NO DUMMY DEFINED + AOJA B,DEFNC ;DUMMY NAME THERE, INCREMENT COUNT + +DEFNE: TRO B,200 ;LAST DELIMITER WAS SLASH, SET FLAG +DEFNB: MOVE A,B ;ENTRY FOR LAST DELIM WAS BACKSLASH + PUSHJ P,PUTREL + MOVEI B,0 + TRO LINK,GENF + JRST DEFND + +DEFNSM: PUSHJ P,RCH ;SEMICOLON IN DEFINE LINE + CAIE A,15 + CAIN A,12 +DEFNA: SKIPA A,B ;END OF DEFINE LINE, GET COUNT + JRST DEFNSM + PUSHJ P,PUTREL ;DEPOSIT REMAINING COUNT + MOVEI A,0 + TRNN LINK,GENF + PUSHJ P,PUTREL ;DEPOSIT + PUSHJ P,RCH + CAIE A,12 + TLO I,UNRCHF ;CHAR AFTER CR NOT LF + PUSHJ P,WRQOTE ;READ IN BODY + PUSHJ P,STPWR ;WRITE STOP + MOVE SYM,MACNM ;GET MACRO NAME + POP P,ESBK + PUSHJ P,ESDEF ;FIND SLOT IN SYMBOL TABLE FOR IT + JFCL + MOVEI B,MACCL ;RH(VALUE) = MACCL + HRL B,PRDEF ;LH(VALUE) = CHAR ADR OF MACRO + CLEARM PRDEF ;NO LONGER NEED PRDEF + MOVSI T,PSUDO ;SYMBOL TABLE ENTRY LOOKS LIKE PSEUDO + PUSHJ P,VSM2 + JRST ASSEM1 + +MACCL: MOVSI 17,-14 ;MACRO EXPANSION TIME + PUSH P,2(17) + AOBJN 17,.-1 + AOS PRCALP + AOS MDEPTH + PUSH P,RDWRDP + MOVEI LINK,0 + HLRZ A,B + PUSHJ P,REDINC + CAIE B,374 + HALT + PUSHJ P,REDINC + SKIPN B + TLO I,UNRCHF ;SAVE CHR FOLLOWING MACRO W/NO ARGUEMENTS + MOVEM A,@PRCALP + MOVE A,LIMBO1 + CAIE A,15 + CAIN A,12 + JRST MAC2A ;NO ARGS SUPPLIED + JUMPE B,MAC4 ;JUMP IF NO DUMMIES IN DEF + TRZE B,200 + TLO LINK,LNSCN +MAC3: PUSH P,B + TLNE LINK,LNSCN + SOJE B,MAC3A +MAC3B: PUSHJ P,RDWRDA + POP P,B + TLNE LINK,SCEND + SOJA B,MAC2 + SOJG B,MAC3 +MAC4: MOVE A,@PRCALP + PUSHJ P,REDINC + MOVEM A,@PRCALP + JUMPE B,MAC1A +MAC5: PUSH P,B + TLNE LINK,SCEND + PUSHJ P,GENSYM + TLNN LINK,SCEND + PUSHJ P,RDWRDA î POP P,B + SOJG B,MAC5 +MAC1A: MOVEI B,RCHSV1 ;RETURN TO RCHSV1 ON END OF MACRO +A.TYM9: PUSHJ P,PUSHEM ;ENTRY FROM .TTYMAC + MOVE A,@PRCALP + PUSHJ P,ACPTRS ;SET UP CPTR + POP P,A + PUSHJ P,DMYTRN + SOS PRCALP +MACC2: MOVSI 17,-13(P) + HRRI 17,2 + BLT 17,15 +MACC1: SUB P,[14,,14] +MACCR: AOS (P) ;COMMON RETURN FROM PSEUDOS TO RETURN FROM GETVAL WITHOUT VALUE +CMACCR: POPJ P,MACCR + +MAC2A: TLO LINK,SCEND ;NO ARGS SUPPLIED TO MACRO + TRZ B,200 +MAC2: SOJL B,MAC4 ;DONE SCANNING ARGS + MOVEI A,0 ;MORE DUMMIES IN DEF, + PUSHJ P,ADDTR2 ;GENERATE NULL DUMMY + JRST MAC2 + +MAC3A: TLO LINK,ALNSCN+400000 + JRST MAC3B + +GENSYM: PUSHJ P,ADDTR1 + MOVEI A,5 + MOVEM A,SCKSUM + MOVEI A,"G + PUSHJ P,PUTREL + PUSH P,[RDWR2A] + AOS A,GENSM + IDIVI A,10 + HRLM B,(P) + SOSLE SCKSUM + PUSHJ P,.-3 + HLRZ A,(P) + ADDI A,60 + JRST PUTREL + +A.GOMC: IBP A ;.GO ROUTINE TO SKIP PAST MACRO HEADER FLUSH # ARGS + IBP A ;FLUSH # DMY ARGS + JRST A.GORT + +RCHSV1: SOS MDEPTH ;END OF MACRO EXPANSION, DECREMENT DEPTH IN MACRO EXPANSIONS +A.TYM8: PUSH P,A ;ENTRY FROM .TTYMAC END OF EXPANSION + MOVE B,TOPP +RCHSV3: CAMG B,BBASE + JRST RCHSV2 + HLRZ A,-1(B) + ADD A,-1(B) + MOVEI A,1(A) + CAME A,FREEPT + JRST RCHSV2 + HRRZ A,-1(B) ;GET NEW FREEPT + SOJA B,RCHSV3 + +RCHSV2: POP P,A + ;RETURN ROUTINE FOR END OF DUMMY +RCHSAV: MOVE B,BBASE + MOVEM B,TOPP + PUSHJ P,POPEM + HLRM B,BBASE +REPT6: TRZE FF,MRSW + POPJ P, ;RETURN TO .GO + JRST RCHTRB + +IFN RCHASW,[ + ;.TTYMAC NAME + ;BODY + ;TERMIN + + ;NAME DUMMY, CAUSES READIN OF CRUD FROM TTY -> CR (NOT INCLUSIVE) + +A.TTYM: MOVSI 17,-14 + PUSH P,2(17) ;SAVE AC'S IN STANDARD MANNER + AOBJN 17,.-1 + MOVEI A,DMYDEF + MOVEM A,DMYTOP + AOS PRCALP + MOVE A,FREEPT + MOVEM A,@PRCALP + PUSH P,RDWRDP + MOVSI LINK,ALNSCN\400000 + PUSHJ P,GSYL ;READ DUMMY'S NAME + JUMPE SYM,.-1 ;KEEP TRYING UNTIL THERE'S SOMETHING THERE + PUSHJ P,RCH ;NOW GET CHARACTER AFTER DELIMITER + CAIE A,12 ;IF NOT LINE FEED, + TLO I,UNRCHF ;THEN DON'T FLUSH + PUSHJ P,PDEF1 ;ENTER DUMMY NAME IN TABLE + PUSHJ P,WRQOTE ;READ IN BODY + PUSHJ P,STPWR ;WRITE TERMIN + PUSHJ P,GTYIP ;INPUT FROM TTY + PUSHJ P,RDWRDA ;READ IN FROM TTY UNTIL CR, FLUSH CR + MOVEI B,A.TYM8 ;WHEN DONE, RETURN TO A.TYM8 + JRST A.TYM9 +] + + ;NOW IRP + ;IRP PDL STRUCTURE: + ;TWO TWO WORD ENTRIES + + ;BBASE,,CPTR + ;LIMBO1 STATUS,,OLD .IRPCNT + ;SPEC BITS\# A,B,[LIST] GROUPS,,CHAR ADR BEGINNING OF BODY + ;OLD TOPP,,AIRP4 + +AIRP: MOVSI 17,-14 + PUSH P,2(17) + AOBJN 17,.-1 + PUSH P,RDWRDP + HLLZM B,AIRPTT ;SAVE TYPE OF IRP + CLEARB LINK,IRPCR + MOVEI A,DMYDEF + MOVEM A,DMYTOP + ;DROPS THROUGH + + ;DROPS THROUGH + +AIRP1: PUSHJ P,PDEF + CAIE T,", + JUMPE SYM,AIRP2 ;NO DUMMY SPECIFIED (EXIT FROM LOOP) + PUSHJ P,PDEF ;READ OTHER NAME OF PAIR + MOVE TT,AIRPTT + TLNE TT,200000 + PUSHJ P,PUT377 ;OCCUPY THE CHARACTER OF WHAT WILL BE THE SECOND DUMMY + PUSHJ P,ADDTRN ;GENERATE NULL DUMMY (FIRST DUMMY), POINTS TO NEXT CHAR + PUSHJ P,PUT377 ;MARK BEGINNING OF DUMMYS + PUSHJ P,RDWRDA ;READ LIST + MOVE A,RDWRDP ;NOW GET DUMMY POINTER, POINTS TO ONE HIGHER THAN LAST ACTIVE + SOS -1(A) ;BACK UP SECOND ARG'S CHARACTER ADDRESS TO POINT TO STOP WRITTEN + MOVSI TT,200000 + TDNE TT,AIRPTT + SOS -1(A) ;IRPS, BACK UP CHAR ADR TO POINT TO CHAR FOR SECOND DUMMY'S EXCLUSIVE USE + AOS IRPCR ;ANOTHER GROUP + TLNN LINK,SCEND + JRST AIRP1 + TLNE LINK,LCRIND + TLZ I,UNRCHF ;FLUSH CR +AIRP2: MOVE A,FREEPT + MOVEM A,PRIRP + PUSHJ P,RCH ;IF NEXT CHAR LF, THEN FLUSH IT + CAIE A,12 + TLO I,UNRCHF + PUSHJ P,WRQOTE ;READ BODY OF IRP + PUSHJ P,STPWR ;WRITE STOP + PUSHJ P,PUSHEM ;SAVE WORLD + POP P,A ;RESTORE RDWRDP FROM LONG AGO + PUSH P,TOPP ;NOW SAVE TOPP + PUSHJ P,DMYTRN ;ACTIVATE DUMMYS + MOVE B,MACP ;NOW GET MACRO PDL POINTER + MOVE A,CIRPCT ;GET .IRPCNT + HRRM A,(B) ;CLOBBER "RETURN" ON PDL TO OLD IRPCNT + SETOM CIRPCT ;INITIALIZE IRPCNT + MOVS A,IRPCR ;GET # GROUPS + HRR A,PRIRP ;CHAR ADR OF BEGINNING OF BODY + IOR A,AIRPTT ;IOR IN SPECIFICATION BITS + PUSH B,A ;PUSH ,,CHAR ADR BEGINNING + POP P,A ;NOW GET OLD TOPP + HRLS A ;MOVE TO LEFT HALF + HRRI A,AIRP4 ;RETURN TO AIRP4 ON END OF BODY + PUSH B,A ;PUSH OLD TOPP,,AIRP4 + MOVEM B,MACP ;STORE BACK UPDATED MACRO PDL POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP RIGHT AWAY TO CAUSE CYCLING + JRST MACC2 + +PUT377: MOVEI A,377 ;WRITE 377 + JRST PUTREL + + ;RECYCLE THROUGH IRP + + ;AC ALLOCATIONS: +AIRP4: PUSH P,A ;A GETS CHAR ADR LOOKING AT DUMMY + PUSH P,C ;C # GROUPS LEFT + PUSH P,T ;T ADR OF PAIR OF CHAR ADR'S OF DUMMYS + PUSH P,TT ;TT TYPE OF IRP 4.9 => IRPC, 4.8 IRPS, 4.7 IRPW, NONE IRP + AOS CIRPCT ;INCREMENT .IRPCNT + HRRZ A,(B) ;GET CHARACTER ADR BEG BODY FROM PDL + PUSHJ P,ACPTRS ;SET UP CPTR + SETOM AIRPT + TRNE FF,MRSW + JRST AIRP9 ;RETURN TO .GO + HLRZ T,1(B) ;DUMMY TAB ADR + LDB C,[220600,,(B)] ;# GROUPS + JUMPE C,AIRP9 ;JUMP IF NO GROUPS + SKIPGE TT,(B) + JRST AAIRPC ;4.9 => IRPC +AIRP6: SETOM AIRPT1 + HRRZ A,(T) ;GET ADR OF FIRST ARG + TLNE TT,100000 + HRRZ A,1(T) ;IRPW => START FROM SECOND ARG +AIRP6A: PUSHJ P,REDINC ;GET CHARACTER FROM ARG + CAIN B,375 + JRST AIRP10 ;END OF STRING + CAIE B,377 + JRST AIRP6A ;WAIT FOR 377 (=> END OF PREV) + TLNE TT,100000 + JRST AIRPW1 ;IRPW + SETOM AIRPT2 +AIRP7E: MOVEM A,(T) ;STORE NEW CHAR ADR +AIRP7: PUSHJ P,REDINC + CAIN B,375 + JRST AIRP5 + TLNE TT,200000 + JRST AIRPS2 ;IRPS + CLEARM AIRPT + CAIN B,LBRKT + AOSE AIRPT2 + JRST AIRP7A ;NOT NEW LIST +AIRP7C: MOVEI B,376 ;CLOBBER BRACKET IN STRING STORAGE + DPB B,PTAB(CH2) + JRST AIRP7 + +AIRP7A: SKIPL AIRPT2 ;RIGHT BRACKET IN LIST + CAIE B,RBRKT + JRST AIRP7B + SOSGE AIRPT2 ;RIGHT BRACKET IN LIST + JRST AIRP7C ;END OF LIST +AIRP7B: CAIN B,15 + JRST AIRP7D + CAIE B,12 + CAIN B,", + SKIPL AIRPT2 + JRST AIRP7 ;NOT END OF ENTRY + ;DROPS THROUGH + + ;DROPS THROUGH +AIRPS1: MOVEI CH1,-1(A) ;END OF GROUP (ENTRY FROM IRPS, IRPW) + IDIVI CH1,4 + MOVEI B,377 + DPB B,PTAB(CH2) + TLNN TT,300000 + MOVEM A,1(T) ;IRP, STORE CHAR ADR OF REST OF STRING +AIRP8: ADDI T,2 + SOJG C,AIRP6 +AIRP9: POP P,TT ;RETURN FROM AAIRPC + POP P,T + SKIPL AIRPT + JRST REPT3 + MOVN A,[2,,2] ;ARGS EXHAUSTED, RETURN + ADDB A,MACP + HRRZ A,(A) + MOVEM A,CIRPCT + POP P,C + POP P,A + JRST RCHSAV + + ;IRPW + ;AIRPT1 -1 => SEMICOLON NOT YET ENCOUNTERED + ;AIRPT -1 => ALL GROUPS NULL SO FAR + +AIRPW1: PUSHJ P,REDINC ;GET CHARACTER (377 ALREADY FOUND) + CAIE B,15 + CAIN B,12 + JRST AIRPW1 ;CR OR LF, IGNORE LEADING BREAK CHAR + CAIN B,375 + JRST AIRP10 ;STOP (ARG EXHAUSTED) + MOVEM A,(T) ;STORE CHARACTER ADR ONE PAST BEGINNING OF FIRST DUMMY + SOS (T) ;MAKE IT POINT TO FIRST ARG + SETZM AIRPT ;SOMETHING THERE, CALL IT NON-NULL GROUP EVEN IF DUMMYS BOTH NULL + JRST AIRPW4 + +AIRPW3: PUSHJ P,REDINC ;GET NEXT CHAR + CAIN B,375 + SOJA A,AIRPWX ;STOP, END OF ARG STRING THIS GROUP + CAIE B,15 + CAIN B,12 + SOJA A,AIRPWD ;DELIMITER => END OF SECOND ARG, MAYBE ALSO END OF FIRST +AIRPW4: CAIN B,"; + AOSE AIRPT1 ;SKIP IF SEMICOLON HASN'T BEEN ENCOUNTERED YET + JRST AIRPW3 ;NOT DELIMITER, TRY NEXT + MOVEI B,377 ;SEMICOLON, CLOBBER WITH STOP MARKING END OF FIRST ARG + DPB B,PTAB(CH2) + MOVEM A,1(T) ;STORE CHAR ADR BEG SECOND ARG + JRST AIRPW3 ;FALL BACK IN + +AIRPWD: SKIPGE AIRPT1 ;DELIMITER (CR OR LF) ENCOUNTERED, SEMI FOUND? + MOVEM A,1(T) ;NO, CLOBBER SECOND DUMMY TO NULL STRING + AOJA A,AIRPS1 ;FALL BACK IN + +AIRPWX: SKIPGE AIRPT1 ;STOP CHAR ENCOUNTERED, SEMI FOUND? + MOVEM A,1(T) ;NO, CLOBBER SECOND ARG TO NULL STRING + AOJA A,AIRP8 ;FALL BACK IN + +AIRPS4: CLEARM AIRPT ;SQUOZE + CLEARM AIRPT1 + JRST AIRP7 + +AIRPS2: HLRZ CH1,GDTAB(B) ;GET GDTAB ENTRY THIS CHAR + CAIN CH1,(POPJ P,) ;POPJ => NOT SQUOZE, + CAIN B,"! ;BUT ALLOW EXCLAMATION POINT + JRST AIRPS4 ;SQUOZE OR ! + SKIPGE AIRPT1 + JRST AIRP7E ;IGNORE NULL SYLLABLES + HRRZ CH1,1(T) + IDIVI CH1,4 + DPB B,PTAB(CH2) ;DEPOSIT DELIMITER AS SECOND ARG + JRST AIRPS1 + +AIRP7D: SKIPL AIRPT2 + JRST AIRP7 + JRST AIRP7C + +AIRP10: CLEARM (T) ;END OF STRING +AIRP5: CLEARM 1(T) + JRST AIRP8 + +AAIRPC: MOVE A,(T) +AIRPC1: PUSHJ P,REDINC + CAIN B,375 + JRST AIRPC3 + CAIE B,377 + JRST AIRPC1 ;WAIT FOR 377 (END OF PREV) + MOVEM A,1(T) ;CHAR ADR OF STRING VALUE OF DUMMY + PUSHJ P,REDINC + CAIN B,375 + JRST AIRPC3 + CLEARM AIRPT + MOVEI CH1,-2(A) + MOVEM CH1,(T) + IDIVI CH1,4 + DPB B,PTAB(CH2) + MOVEI B,377 + DPB B,PTAB+1(CH2) + AOS 1(T) +AIRPC2: ADDI T,2 + SOJG C,AAIRPC + JRST AIRP9 + +AIRPC3: CLEARM (T) + CLEARM 1(T) + JRST AIRPC2 + + ;PUSHJ P,A.GST SEARCH CURRENT MACRO STRING FOR TAG (IN A.GST4) + ;SKIP IF FOUND, RETURN ON END OF STRING ANYWAY + ;BYTE POINTER (ILDB TO GET FIRST CHARACTER) IN A + +A.GST: MOVEM A,A.GST3 ;SAVE BYTE POINTER +A.GST1: ILDB B,A.GST3 ;GET CHAR + CAIL B,300 + POPJ P, ;END OF STRING => STOP + CAIE B,". + JRST A.GST1 ;WAIT FOR POINT + PUSHJ P,A.GSYL ;FOUND POINT, GET REST OF NAME + JUMPL T,CPOPJ ;RETURN ON END OF STRING + CAME SYM,[SQUOZE 0,TAG] ;TAG? + JRST A.GST1 ;NO, KEEP GOING + PUSHJ P,A.GSYL ;GET THE TAG + JUMPL T,CPOPJ ;RETURN ON END OF STRING (THERE MUST BE BREAK CHAR AFTER TAG BEFORE STOP) + CAME SYM,A.GST4 + JRST A.GST1 ;NOT THE ONE BEING LOOKED FOR + MOVE A,A.GST3 + LDB B,A ;GET DELIMITER + CAIE B,15 ;CR? + JRST POPJ1 + ILDB B,A ;CR, GET NEXT CHAR + CAIE B,12 ;LINE FEED? + MOVE A,A.GST3 ;NO, DON'T FLUSH + JRST POPJ1 + + ;LOOK BACKWARD FOR BEGINNING OF STRING, BYTE POINTER AN A + ;LEAVES POINTER POINTING AT STOP CHAR (NOT BEFORE); ALSO LEAVES STOP CHAR IN B + +AG.SP: MOVE B,(A) ;GET WORD FROM MACTAB + XOR B,[300_28.+300_20.+300_12.+300_4] ;DO XOR TO ANITIALLY SET UP + LDB CH1,[400400,,A] ;PICK UP 4 HIGH ORDER BITS OF POSITION FIELD + JRST A.GSP2-1(CH1) ;DISPATCH ON POSITION FIELD (-1 SINCE BIT SET IN POSITION FIELD) + +AG.SP3: MOVE B,(A) + XOR B,[300_28.+300_20.+300_12.+300_4] + +A.GSP2: TRNN B,300_4 + JSP CH1,AG.SF + TLNN B,3 + JSP CH1,AG.SF + TLNN B,300_2 + JSP CH1,AG.SF + TLNN B,300_10. + JSP CH1,AG.SF + SOJA A,AG.SP3 + +AG.SF: SUBI CH1,A.GSP2-1 ;GET HERE WHEN STOP CHAR FOUND + DPB CH1,[400400,,A] ;CLOBBER POSITION FIELD OF BYTE POINTER AGAIN + ILDB B,A ;INCREMENT TO UNIVERSALLY ACCEPTABLE POINTER, GETTING STOP CHAR IN B AT SAME TIME + POPJ P, ;THAT'S ALL + +A.TAG: PUSHJ P,GSYL + CAIE T,15 + JRST MACCR + PUSHJ P,RCH + CAIE A,12 + TLO I,UNRCHF + JRST MACCR + +A.GO: PUSHJ P,GSYL ;DOESN'T WORK RELIABLY FROM DUMMY + MOVEM SYM,A.GST4 + +A.GO1: TLNN FF,MACRCH + JRST MACCR ;NOT GETTING CHARS FROM MACRO => STOP + MOVE A,CPTR + PUSHJ P,AG.SP ;BACK TO BEGINNING + CAIN B,374 + JRST A.GOMC ;MACRO, SKIP PAST HEADER +A.GORT: PUSHJ P,A.GST + JRST A.GO2 ;END OF STRING, TRY POPPING UP ONE + MOVEM A,CPTR + JRST MACCR + +A.GO2: PUSHJ P,PMACP + JRST A.GO1 + +A.GSYL: MOVNI D,100000 ;GET SYL FOR .GO WHILE LOOKING FOR TAG + MOVEM D,STRCNT ;STRCNT .LT. 0 SIGNAL FOR GSYL TO JRST (F) + MOVEI SYM,0 + JSP F,GSYL1 +A.GSY3: ILDB A,A.GST3 ;GET CHAR + TRZN A,200 ;CHECK FOR SPECIAL + JRST A.GSY2 ;NO, FALL BACK IN + CAIG A,100 ;BIG ENOUGH TO BE SPECIAL? + JRST A.GSY3 ;NO, MUST BE DUMMY, IGNORE + HRROI T,(A) ;SPECIAL => ASSUME STOP: T .LT. 0 SIGNAL TO CALLING ROUTINE + POPJ P, ;RETURN TO CALLING ROUTINE + + ;INITIALIZE MACRO STATUS + +MACINI": MOVEI A,3 + MOVEM A,FREEPT ;FORGET ALL STRINGS IN MACTAB + PUSHJ P,FCOMP + MOVE A,MACTAD + ADDI A,MACL+1777 + ANDI A,-2000 ;ADDR OF 1ST WD AFTER MACTAB. + MOVEM A,MACTND + SUB A,MACTAD + LSH A,2 ;1ST BYTE MACTAB DOESN'T HAVE. + MOVEM A,MACHI + SUBI A,MACRUM*4 + MOVEM A,GCRDHI + MOVE A,STOPPT + HRR A,MACTND + SOS A ;LAST WD IN MACTAB. + MOVEM A,MACHIB ;INITIALIZE BYTE POINTER TO HIGHEST BYTE OK TO FILL +IFN TS, SETZM GCCNT ;CLEAR OUT GC COUNT SO WILL GET MORE CORE FIRST THREE +MACIN1": SETZM MDEPTH ;NOW INITIALIZE MACRO EXPANSION STATUS + SETZM PRSTG ;NOW TO CLEAR OUT BYTE POINTERS + MOVE A,[PRSTG,,PRSTG+1] + BLT A,EPRSTT-1 + MOVEI A,DSTG + MOVEM A,RDWRDP + MOVEI A,DMYAGT + MOVEM A,TOPP + MOVEM A,BBASE + MOVE A,[-MPDLL,,MACPDL] + MOVEM A,MACP + POPJ P, + + ;MACRO VARIABLE AREA (MOST THEREOF) + +VBLK +MACP: 0 ;MAC PDL POINTER +BLCODE [MACPDL: BLOCK MPDLL+1] ;MACRO PDL +FREEPT: 0 ;MACRO STG PNTR POINTS TO FREE CHAR +FREPTB: 0 ;FREEPT IN BYTE POINTER FORM +MACTAD: MACTBA ;ADDR OF START OF MACRO TABLE. +MACTND: 0 ;ADDR OF 1ST WD AFTER MACTAB. +MACHI: MACL*4 ;CHAR ADR ONE ABOVE ACTIVE MACTAB +MACHIB: 0 ;POINTS TO LAST BYTE IN MACTAB + +SCINST: 0 ;STRING CONDITIONAL INSTRUCTION +SCONDF: 0 ;STRING CONDITIONAL FLAG, -1 => IDENTICAL, 0 DIFFERENT +GENSM: 0 ;GENERATED SYM COUNT +MACNM: 0 ;NAME OF MACRO BEING DEFINED +DCNT: 0 ;USED BY WRQOTE CURRENT DEPTH IN DEFINE-IRP-TERMIN LEVEL +MDEPTH: 0 ;DEPTH IN MACRO (NOT IRP OR REPEAT) EXPANSIONS +PUTCNT: 0 ;AOS'D BY PUTREL, USED BY CALLING ROUTINE, USUALLY TO COUNT ACTIVE CHARS (DURING DEFINITION) +AIRPTT: 0 ;TYPE OF IRP (400000) IRPC (200000) IRPS (100000) IRPW 0 IRP, USED DURING READIN +IRPCR: 0 ;COUNT OF A,B,[LIST] GROUPS IN IRP IRPC IRPS, " " " +AIRPT: 0 ;IRP EXPANSION TEMP, -1 => NO NON-NULL DUMMYS YET, ELSE 0 +AIRPT1: 0 ; " ,IRPS OR IRPW => (0 => CURRENT DUMMY NOT NULL, -1 => NULL) +AIRPT2: 0 ; " , IRP ONLY, BRACKET COUNT (FOR FLUSHING LIST BRACKETS) +A.QOT2: 0 ;DELIMITER FOR .QUOTE +CRPTCT: -1 ;COUNT THROUGH CURRENT REPEAT (FOR .RPCNT) +CIRPCT: -1 ;COUNT THOUGH CURRENT IRP (FOR .IRPCNT) +A.GST3: 0 ;ON .GO, NAME (IN SQUOZE) OF TAG BEING SEARCHED FOR +A.GST4: 0 ;BYTE POINTER FOR ILDB WHILE SEARCHING FOR TAG +PRCALP: PRCAL-1 ;POINTER INTO PRCALP, POINTS TO LAST ACTIVE ENTRY + +PRSTG: ;BEGIN WORDS GARBAGE COLLECTED: FIRST BYTE POINTERS ILDB'D + +CPTR: 0 ;ILDB TO GET NEXT CHAR FROM MACRO OR WHATEVER +IFE WRQTSW-1,WRQTBP: 0 ;POINTS TO LAST CHAR BEFORE CURRENT SYL AT WRQOTE +GCBPL==.-PRSTG ;END BYTE POINTERS, BEGIN CHARACTER ADDRESSES +PRSCND: 0 ;CHARACTER ADDRESS OF CURRENT LOCATION IN FIRST STRING OF IFSE,IFSN WHILE COMPARING WITH SECOND +PRSCN1: 0 ;CHAR ADR BEG OF FIRST STRING IFSE, IFSN +PRREPT: 0 ;CHAR ADR BEG OF BODY OF REPT +PRIRP: 0 ;CHAR ADR BEG OF IRP BODY +PRDEF: 0 ;CHAR ADR BEG OF MACRO BEING DEFINED +PRCAL: REPEAT 10,0 ;TEMP STORAGE FOR CHAR ADR BEG MACRO BODY, USED TO READ DUMMY SPECS +EPRSTT: ;END CHAR ADR WORDS GARBAGE COLLECTED + + ;BEGIN GARBAGE COLLECTOR VARIABLES + +IFN TS,GCCNT: 0 ;CNT OF GC'S +SYMSTR: 0 ;PNTR TO CHAIN OF MACRO PNTRS IN SYM TABLE (DURING GC), LINKED THROUGH RH'S OF "VALUE" +REDPT: 0 ;CHAR ADR READING FROM WHEN MOVING STRING DOWN +REDPTB: 0 ;REDPT IN BYTE POINTER FORM + ;GC WRITES WITH FREEPT/FREPTB +COFST: 0 ;AMOUNT CHARS MOVED DOWN BY, SUBTRACTED FROM CHAR ADR TO RELOCATE +SVF: 0 ;FLAG, .GE. 0 => NO POINTERS FOUND POINTING TO CURRENT STRING +FREPTS: 0 ;-> BEGINNING OF CURRENT STRING BEING COPIED DOWN +FRPTBS: 0 ;FREPTS IN BYTE POINTER FORM +GCENDF: 0 ;-1 => END OF LAST STRING FOUND, AFTER RELOCATING POINTERS, MSTG2 SHOULD EXIT +GCHI: 0 ;GC HIGH POINTER, CHAR ADR FIRST NOT TO GARBAGE COLLECT +GCRDHI: *4 ;GC DROPS DEAD (MACTAB FULL) IFWRITING INTO THIS CHAR ADR +BLCODE [GCSV: BLOCK 16] ;AC SAVE AREA FOR GC +PBLK + + ;GARBAGE COLLECT THE MACRO TABLE + +GCA: MOVEM A,GCHI ;ENTRY TO STORE A IN GCHI -> FIRST CHAR NOT TO GARBAGE COLLECT +GC: MOVEM 17,GCSV+15 + MOVE 17,[2,,GCSV] + BLT 17,GCSV+14 +IFN TS,[AOS A,GCCNT + CAIGE A,4 + PUSHJ P,GCCORQ ;EXPAND CORE ON FIRST THREE GC'S +] CLEARB T,GCENDF + MOVEI A,3 + MOVEM A,REDPT ;SET UP FOR READING + MOVEM A,FREEPT ;ALSO FOR WRITING + MOVE A,BCOMPU ;ALSO SET UP CORRESPINDING BYTE POINTERS + MOVEM A,FREPTB + MOVEM A,REDPTB + MOVE C,[-GCBPL,,PRSTG] +GCLP1: SKIPN B,(C) ;NOW CONVERT BYTE POINTERS... + JRST GCLP1B ;(INACTIVE) + CCOMP B,-1 ;TO CHARACTER ADDRESSES + MOVEM B,(C) ;STORE BACK CHARACTER ADDRESS +GCLP1B: AOBJN C,GCLP1 ;LOOP FOR ALL SUCH BYTE POINTERS + MOVE A,SYMAOB ;NOW SET UP MACRO LIST; T INITIALLY HAS 0 => END OF LIST DURING COMPUTATION +SYMMG: ;POINTS TO FIRST MACRO SYMTAB ENTRY ON LIST + LDB B,[400400,,ST(A)] ;GET SQUOZE FLAGS THIS SYM + CAIN B,PSUDO_-14. ;PSEUDO? (=> MAYBE MACRO) + JRST SYMMG1 ;YES, MAYBE PUT ON LIST (RETURNS TO SYMMG2) +SYMMG2: ADDI A,WPS-1 + AOBJN A,SYMMG ;LOOP FOR ENTIRE SYMTAB + MOVEM T,SYMSTR ;STORE INITIAL LIST ENTRY FOR MACROS + ;DROPS THROUGH + ;GC DEALS WITH "UNIT STRINGS", EACH STRING ENDS WITH 375 + ;GENERAL PROCEDURE IS TO COPY A STRING DOWN THEN SEARCH FOR POINTERS TO WHERE STRING USED TO BE + ;IF POINTERS FOUND THEY ARE RELOCATED TO POINT TO COPIED DOWN STRING + ;IF POINTERS ARE NOT FOUND THE STRING IS WIPED OUT + ;DROPS THROUGH + +MSTG: MOVE C,REDPT ;SET UP C TO POINT TO BEG OF STRING BEING READ + ;(FOR EVENTUALLY SEARCHING FOR POINTERS TO STRING, NOTE C STAYS AROUND FOR AWHILE) + MOVE TT,FREEPT + MOVEM TT,FREPTS ;-> BEGINNING OF WRITTEN STRING + MOVE TT,FREPTB + MOVEM TT,FRPTBS ;BYTE POINTER -> BEGINNING OF WRITTEN STRING + PUSHJ P,RDTRNS ;COPY CHARACTER + MOVE TT,B ;SAVE CHARACTER JUST COPIED +MSTG1: CAML LINK,GCHI + JRST GCEND ;JUST READ LAST CHAR IN PART OF MACTAB TO GARBAGE COLLECT => DONE + CAIN B,375 + JRST MSTG2 ;END THIS STRING, NOW SEARCH FOR POINTERS, RETURNS TO MSTG + PUSHJ P,RDTRNS ;STRING NOT EXHAUSTED, COPY NEXT CHAR + JRST MSTG1 + +SYMMG1: HRRZ B,ST+1(A) ;PSEUDO FOUND IN SYMTAB, GET "VALUE" + CAIE B,MACCL ;MACCL? (=> MACRO, CHAR ADR OF BODY IN LH) + JRST SYMMG2 ;NO, JUST FALL BACK INTO LOOP + HRRM T,ST+1(A) ;MACRO, REPLACE MACCL PART OF VALUE WITH POINTER TO NEXT + MOVEI T,ST+1(A) ;UPDATE T (INITIAL LIST ENTRY) TO POINT TO WORD JUST CLOBBERED + PUSH P,A + HLRZ A,ST+1(A) + PUSHJ P,REDINC + CAIE B,374 + HALT + POP P,A + JRST SYMMG2 + + ;COPY CHARACTER DOWN (REDPTB -> FREPTB) + ;LEAVE INCREMENTED REDPT IN LINK, FREEPT IN A, CHAR IN B + +RDTRNS: ILDB B,REDPTB + IDPB B,FREPTB + AOS LINK,REDPT + AOS A,FREEPT + POPJ P, + +IFN TS,[ ;NEED MORE CORE FOR MACTAB + +GCCORQ: MOVE A,MACHI + LSH A,-2 ;CONVERT TO WORD # + CAIL A,MXMACL ;WANT MORE THAN ALLOWED? + POPJ P, + MOVE A,MACTND ;NO, GET ADDR OF BLOCK WE WANT TO GET. + MOVEI AA,[ASCIZ /MACRO TABLE./] ;TEXT ARG TO CORRQ + PUSHJ P,CORRQ ;GET BLOCK + ADDI A,2000 + MOVEM A,MACTND ;INCREMENT ADDR AFTER END OF MACTAB. + SUB A,MACTAD ;GET # WDS NOW HAVE. + LSH A,2 ;CONVERT TO CHAR ADR + MOVEM A,MACHI ;STORE BACK NEW HIGH PUT ADR + SUBI A,MACRUM*4 + MOVEM A,GCRDHI ;STORE NEW MACTAB HIGH POINTER + ADDI A,MACRUM*4 ;CONVERT BACK TO END POINTER + BCOMP A,-1 ;CONVERT TO BP TO LAST BYTE IN TABLE + MOVEM A,MACHIB ;STORE AS SUCH + POPJ P, +] + + ;GET HERE WHEN MSTG2 FINISHES WITH FLAG SET TO EXIT: UNDO INITIALIZATION AND RETURN + +GCEND1: IFN TS,[ + MOVE A,FREEPT + ADDI A,2000*4 + CAML A,MACHI + PUSHJ P,GCCORQ +] MOVE A,FREEPT + CAML A,GCRDHI + ERF 'MCE + SKIPN T,SYMSTR + JRST USYMG1 ;EMPTY LIST + MOVEI C,MACCL ;SET UP C FOR HRRM'ING +USYMG: HRRZ TT,(T) ;GET ADR ON LIST + HRRM C,(T) ;CLOBBER RH JUST GOT NEXT POINTER FROM TO MACCL + HLRZ A,(T) + PUSHJ P,REDINC + CAIE B,374 + HALT + SKIPE T,TT ;MAKE NEXT POINTER CURRENT, SKIP IF END OF LIST + JRST USYMG + +USYMG1: MOVE C,[-GCBPL,,PRSTG] +GCLP2: MOVE A,(C) ;NOW CONVERT CHARACTER ADDRESSES... + BCOMP A,-1 ;BACK TO BYTE POINTERS + MOVEM A,(C) + AOBJN C,GCLP2 + MOVS 17,[2,,GCSV] + BLT 17,17 + POPJ P, ;EXIT FROM GARBAGE COLLECTOR + + ;GC ROUTINE TO SCAN TABLE AREA FOR POINTERS TO CURRENT STRING + ;CH1 -> BEGINNING OF TABLE, 4.9 => LOOK AT PAIRS SKIPPING SECOND OF EACH PAIR + ;T POINTS TO LAST WORD IN TABLE + 1 + ;RELOCATE POINTERS IN TABLE POINTED TO + ;C POINTS TO BEGINNING OF STRING, B -> END + 1 + +MSCN: CAIG T,(CH1) + POPJ P, ;TABLE EXHAUSTED + HRRZ TT,-1(T) ;GET LAST ENTRY IN TABLE (UPPER POINTER UPDATED TO COUNT DOWN) + CAML TT,C + CAML TT,B + JRST MSCN1 ;DOESN'T POINT TO CURRENT STRING + SUB TT,COFST ;POINTS TO STRING, RELOCATE + HRRM TT,-1(T) ;STORE BACK RELOCATED POINTER + SETOM SVF ;SET FLAG TO SAVE STRING +MSCN1: SKIPGE CH1 + SOS T ;CH1 NEGATIVE => SKIP A WORD + SOJA T,MSCN + +GCEND: SETOM GCENDF ;DONE READING FROM MACTAB, BUT FIRST HAVE TO RELOCATE POINTERS TO LAST STRING +MSTG2: CLEARM SVF ;NO POINTERS FOUND TO STRING YET + MOVE D,REDPT + SUB D,FREEPT + MOVEM D,COFST ;STORE AMOUNT CHARS COPIED DOWN BY FOR CHAR ADR RELOCATION + MOVE B,REDPT + CAIE TT,374 + JRST MSTG3 ;NOT A MACRO + MOVE T,SYMSTR + JUMPE T,MSTG3 ;JUMP IF NO MACROS ON LIST +MSTG5: HLRZ TT,(T) ;GET CHAR ADR THIS MACRO + CAML TT,C ;SKIP IF POINTS BELOW BEGINNING THIS STRING + CAML TT,B ;SKIP UNLESS POINTS TO OR ABOVE FIRST CHAR NOT YET READ + JRST MSTG4 ;DOESN'T POINT TO THIS STRING + SETOM SVF ;POINTS TO THIS STRING, SET FLAG TO SAVE STRING + SUB TT,COFST ;RELOCATE + HRLM TT,(T) ;STORE BACK UPDATED CHAR ADR THIS MACRO +MSTG4: HRRZ T,(T) ;NOW GET POINTER TO NEXT MACRO + JUMPN T,MSTG5 ;LOOP FOR ALL MACROS ON LIST + +MSTG3: MOVE T,TOPP + MOVEI CH1,DMYAGT + PUSHJ P,MSCN ;RELOCATE POINTERS IN DUMMY ARG TABLE + HRRZ T,MACP + HRROI CH1,MACPDL + PUSHJ P,MSCN ;RELOCATE POINTERS IN MACRO PDL + HRRZ T,PRCALP + AOS T + MOVEI CH1,PRSTG + PUSHJ P,MSCN ;RELOCATE POINTERS IN PRSTG + HRRZ T,RDWRDP + MOVEI CH1,DSTG + PUSHJ P,MSCN ;RELOCATE DUMMY ARGS READ (OR BEING READ) IN BUT NOT YET ACTIVATED + SKIPGE GCENDF + JRST GCEND1 ;EXIT + SKIPGE SVF + JRST MSTG ;FOUND POINTERS TO THIS STRING, DON'T FLUSH + MOVE TT,FREPTS ;NO POINTERS FOUND, FLUSH STRING + MOVEM TT,FREEPT + MOVE TT,FRPTBS + MOVEM TT,FREPTB + JRST MSTG + +] ;END MACSW CONDITIONAL (AND MACRO PROCESSOR ROUTINES) + +IFN .I.FSW,[ ;;.I.F ;ALGEBRAIC COMPILER ROUTINE +; 'ALGEBRAIC' CRUFT MARO DEFINITIONS + +DEFINE MOAN ARG/ + MOVEI D,[SIXBIT /ARG!!/] + JRST ERRCON +TERMIN + +DEFINE RETLIN + MOVEI A,15 ;CARRIAGE RETURN + PUSHJ P,PUTREL + MOVEI A,12 ;LINE FEED + PUSHJ P,PUTREL +TERMIN + +DEFINE NUMBER + MOVE A,BTPNT + ILDB I,A + CAIE I,"# + CAIGE I,"@ +TERMIN + +DEFINE RESTOR + MOVE D,BTPNT + SETZM STRING + SETZM STRING+1 + SETZM STRING+2 +TERMIN + + +DEFINE SPECN + POP P,RANDM + MOVE A,ENN + SUB A,RANDM + MOVEM A,ENN +TERMIN + +DEFINE GET + EXCH I,ACSAV+1 + PUSHJ P,RCH + EXCH I,ACSAV+1 +TERMIN + +DEFINE GETT + EXCH I,ACSAV+1 + PUSHJ P,RCH + EXCH I,ACSAV+1 + IDPB A,TPN +TERMIN + +; START OF COMPILER PROPER + +OPDL: CH?CH?CH?CH?CH?CH?CH?CH ;COMMUTATOR + CH?SP?CH?CH?CH?CR?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + SP?CH?CH?CH?DL?CH?CH?CH + LP?RP?TX?PL?CM?MN?CH?DV + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?KL?LB?EQ?RB?CH + +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?UP?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH + +VBLK + +ENN: 60 ;ACCUMULATOR NUMBER - TROUBLE IF GOES PAST 9 + +BTPNT: 440700,,STRING ;D +STRING: BLOCK 10 ;CHARACTER ASSEMBLY (D) - TROUBLE IF OVERFLOWS + +TPN: 0 +DIRPNT: 440700,,DIROUT ;TPN +DIROUT: BLOCK 40 ;COPY OF LINE IN PROGRESS (TPN) - TROUBLE IF OVERFLOWS + +OPSTKL==40 + 0 +OPSTK: BLOCK OPSTKL ;OPERATOR STACK (R) - TROUBLE IF OVERFLOWS + 0 + + + +ENDSTT: 0 ;ON IF END OF STATEMENT ENCOUNTERED +CHARF: 0 ;LAST WAS NOT OPERATOR +NUMFL: 0 ;STRING IS NUMERIC CONSTANT (NEEDS [ AND ]) +R1SV: 0 ;SAVED A +R2SV: 0 ;SAVED I, CALLED V EARLIER ON + +INTEGR: 0 ;INTEGER ARITHMETIC +WARN: 0 ;ON AFTER ) TO STOP NON-OPERATOR +RANDM: 0 ;DUMP COMMA COUNT HERE +ACSAV: BLOCK 7 +TEMP: 440600,,(D) ;INDIRECT VIA D +BYTPNT: 0 +PBLK + +; ENTRANCE TO 'ALGEBRAIC' TRANSLATOR + +A.I: SETOM INTEGR + SKIPA +A.F: SETZM INTEGR + PUSHJ P,SWINI ;INITIALISE PASSAGE TO MIDAS ASSEMBLER + MOVE TM,[P,,ACSAV] + BLT TM,ACSAV+6 + SETZM ENDSTT ;RESET END OF STMNT FLAG + SETZM EQHIT' ;RESET LAST CHAR WAS= FLAG + SETZM WARN ;SET OFF ERROR DETECTOR + MOVEI A,"0 ;INITIALISE POINTERS + MOVEM A,ENN + MOVE A,DIRPNT + MOVEM A,TPN ;POINTER TO SAVED INPUT + MOVE SYM,[-OPSTKL,,OPSTK] + PUSH SYM,[0,,ENDSAT] + PUSH P,[0] ;INITIALISE COMMA-COUNTER + SETZM CHARF +CLSTR: RESTOR +RDITTS: SKIPE ENDSTT + JRST BDEND +RDITA: GETT + CAIGE A,100 ;FOR ABBREVIATED DISPATCH TABLE + JRST @OPDL(A) + CAIN A,"\ + JRST AB + CAIN A,"^ + JRST UP + +CH: SETZM EQHIT + SKIPE WARN + JRST CHBRT +CHEY: IDPB A,D + SETOM CHARF ;NON UNARY FLAG + JRST RDITA + +GAMB: RESTOR +COMMT: MOVE I,R2SV + JRST GOPURT + +SHORT: ;DECIDES IF STRING CAN BE USED IN IMMEDIATE TYPE OPS + SETZM IMMED' + SKIPN STRING + POPJ P, ;NO STRING + MOVE A,BTPNT + ILDB I,A + CAIN I,"# + JRST APUPJ ;YEPE HE ASKED FOR IT + SKIPE STRING+1 + POPJ P, ;STRING IS LONG + SKIPA + +TSTSHL: ILDB I,A + JUMPE I,APUPJ ;ITS OK FOUND ONLY NUMBERS + CAILE I,"@ + POPJ P, ;NON-NUMBER IN STRING + CAIE I,". + JRST TSTSHL + ILDB I,A + SKIPN I ;ANYTHING FOLLOW '.' QST +APUPJ: SETOM IMMED' ;INDICATE IMMEDIATE USAGE IS POSSIBLE + POPJ P, + +SZPRT: SETZM CHARF +GOPRT: SETZM WARN +GOPART: MOVEM I,R2SV +GOPURT: HLRZ B,I + HLRZ C,(SYM) + CAMLE B,C + JRST PSOPR ;GO PUSH OPERATOR + SKIPN INTEGR + SETOM IMMED ;FOR ARITH OPS ONLY FIXED WILL DO IMMEDIATE + PUSHJ P,SHORT ;ESTABLISH IF STRING CAN BE IMMEDIFIED + POP SYM,A ;POP AN OPERATOR + JUMPN A,(A) + + MOAN OVERPOPPED OPERATOR STACK + +CHEX: MOVE A,R1SV + JRST CHEY + +RP: SKIPE EQHIT + AOS ENN ;TAKE CARE OF UNSATISFIED = AT END + SKIPN CHARF + JRST RTONOP + SETOM CHARF +BUDDY: SETOM WARN + MOVEI I,RPAR + JRST GOPART + +RTONOP: MOVE I,(SYM) + CAIN I,FUNCT + JRST BUDDY ;NO ARGUMENT FUNCTION + + MOAN ) FOLLOWS OPERATOR + +BDEND: MOAN TOO MANY ('S + +CHBRT: MOAN NON-OPERATOR FOLLOWS ) + + +CR: SKIPE EQHIT + AOS ENN ;HANDLES UNSATISFIED = AT END + SETOM ENDSTT + MOVEI I,RCAR + JRST GOPRT + +LP: SETZM EQHIT + SKIPE WARN + JRST LFRHT + SETZM CHARF + SKIPE STRING + JRST INDX + PUSH P,[0] ;INITIALISE COMMA-COUNTER + PUSH SYM,[0,,LFTPR] + JRST RDITA + +INDX: NUMBER + JRST NUSTRB + GETT + CAIG A,"9 + JRST NMRINX + MOVEI I,"( + IDPB I,D +INDY: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDN + CAIN A,"- + JRST CMPNDN + CAIE A,") ;SEARCH FOR NEXT RP + JRST INDY + IDPB A,D +CMBAN: SETOM CHARF ;MAKE BELIEVE CHARATER LAST + SETOM WARN ;YET SET ) TRAP + JRST RDITA + +NMRINX: CAIN A,"- ;IS IT A MINUS + JRST INDZ + CAIN A,"+ + JRST INDZ + MOVEI I,"+ ;NUMERICAL SUBSCRIPT + IDPB I,D +INDZ: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDC + CAIE A,") + JRST INDZ + JRST CMBAN + +CMPNDN: MOVEI I,") + IDPB I,D + JRST INDZ + +CMPNDC: MOVEI I,"( + IDPB I,D + JRST INDY + +LFRHT: MOAN ( FOLLOWS DIRECTLY ON ) + +SP=RDITA ;USE FOR NON ARITH STATS + +CM: MOVE I,[1,,COMMX] + SKIPN CHARF + AOS ENN + JRST SZPRT + +EQ: SETOM EQHIT + SETZM WARN + SKIPN CHARF ;TEST FOR EXISTANCE OF L H S + JRST EQFLOP + NUMBER ;IS L H S A NUMBER + JRST EQNUMB + MOVEI I,EQAAL +EQVAL: SETZM CHARF + PUSH SYM,I + PUSH P,STRING + PUSH P,STRING+1 + PUSH P,STRING+2 + PUSH P,[0] + JRST CLSTR + +PL: MOVE I,[2,,PLUS] + SKIPN CHARF + JRST RDITA ;UNARY PLUS + JRST SZPRT + +MN: MOVE I,[2,,MINUX] + SKIPN CHARF + MOVE I,[5,,UMINU] + JRST SZPRT + +AB: SKIPE CHARF ;ABSOLUTE VALUE + JRST ABERR ;NOT UNARY + MOVE I,[5,,UABS] + JRST SZPRT + +LB: SKIPN CHARF + JRST LP ;TREAT LIKE ( + NUMBER + JRST NUBRST + MOVEI I,FUNCT + JRST EQVAL + +RB=RP + +NUBRST: MOAN '<' FOLLOWS NUMBER + +NUSTRB: MOAN '(' FOLLOWS NUMBER + +EQFLOP: MOAN '=' FOLLOWS OPERATOR + +EQNUMB: MOAN '=' FOLLOWS NUMBER + +ABERR: MOAN NON-UNARY ABS + +TX: MOVE I,[4,,TIMES] + SKIPN CHARF + JRST RDITA ;UNARY TIMES + JRST SZPRT + +DL: GET ;CONTINUE STATEMENT RC + GET ;LF + GET ;. + CAIE A,". ;DOT + JRST BDCONT + GET ;F OR I + GET ;CONTROL I OR SPACE + MOVE A,DIRPNT + MOVEM A,TPN ;RESET SAVED INPUT POINTER TO AVOID FILLING ITS BUFFER + MOVEI A,"$ + IDPB A,TPN + MOVEI A,40 + IDPB A,TPN + JRST RDITA + +ERRCON: TRNE FF,PSS ;NO OUTPUT ON SECOND PASS + JRST CONRBT +;MAY ALSO WANT TO USE STATEMENT PLUS LINE NUMBER TYPE TACTIC + MOVE B,DIRPNT +OUTRR: ILDB A,B + PUSHJ P,TYO + CAME B,TPN + JRST OUTRR + SKIPE ENDSTT + JRST CONERT +DORSTL: MOVEI A,40 + PUSHJ P,TYO + MOVEI A,"? ;POINT AT ERROR + PUSHJ P,TYO + MOVEI A,40 + PUSHJ P,TYO +DORSAL: GET ;COPY UP TO LINE FEED + PUSHJ P,TYO + CAIE A,12 ;LF + JRST DORSAL +CONERT: PUSHJ P,TIPIS + PUSHJ P,CRR +CONRAT: MOVE TM,[ACSAV,,P] + BLT TM,P+6 + JRST SWFLS ;GO BACK AND FLUSH + + +CONRBT: GET + CAIE A,12 ;LF + JRST CONRBT + JRST CONRAT + + +UP: SKIPN WARN ;FOR (NUMBER)^N + SKIPN STRING + JRST ITSEX + MOVEM A,R1SV ;SAVE THE ARROW + NUMBER + JRST CHEX ;ITS PART OF A NUMBER +ITSEX: MOVE I,[6,,STRSTR] + SKIPN CHARF + JRST EXMB + JRST SZPRT + +EXMB: MOAN UNARY ^ + +BDCONT: MOAN BAD CONTINUATION + +KL=CR ;SEMICOLON ACTS LIKE CR IN TERMINATING + +STRSTR: SKIPN STRING + JRST EXLS + NUMBER + SKIPA + JRST EXLS + SUBI I,61 + TDNE I,[-1,,777774] + JRST EXLS + MOVE A,STRING + TDNE A,[3777,,-1] + JRST EXLS + ADDI I,POWR + JRST @(I) + +EXLS: PUSH P,[ASCII !EXPLO!] + PUSH P,[ASCII !G !] + PUSH P,[0] + PUSH P,[1] + SETOM EXRET' + JRST FUNET + +DV: MOVE I,[4,,DIVIX] + SKIPN CHARF + MOVE I,[5,,UDIVI] + JRST SZPRT + +PSOPR: PUSH SYM,I ;PUSH OPERATOR FOR LATER EXCECUTION + SKIPN STRING + JRST RDITTS + PUSHJ P,SHORT ;CAN WE IMMEDIFY + PUSHJ P,MVOI ;AND MOVE OPERAND INTO STACK + JRST CLSTR + + +PRODB: NUMBER ;OUTPUT WHAT IS IN STRING + SKIPE IMMED ;NO [ & ] IF IMMEDIATE USE + JRST OVNM + PUSH P,A + MOVEI A,"[ ;[ FOR CONSTANT + PUSHJ P,PUTREL + POP P,A + SETOM NUMFL +OVNM: CAIN I,"# + JRST PRDOC + + EXCH A,I + PUSHJ P,PUTREL + MOVE A,I +PRDOC: ILDB I,A + JUMPN I,OVNM + SKIPN NUMFL + POPJ P, + MOVEI A,"] ;] FOR CONSTANT + PUSHJ P,PUTREL + SETZM NUMFL + POPJ P, + +PRODC: HRLI A,440700 ;MAKE BYTE POINTER + JRST PRDOC + +LFTPR: SPECN + JRST RDITTS ;IGNORE LP ON STACK + +RCAR: HALT ;IMPOSSIBLE FOR THESE TO BE ON STACK +RPAR: HALT + +EQAAL: SPECN + SKIPE STRING + PUSHJ P,MVOI + MOVEI A,[ASCIZ ! MOVEM A!] + PUSHJ P,PRODC + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +ENDSAT: SPECN + SKIPN ENDSTT + JRST TOEARL + SKIPE STRING + PUSHJ P,MVOI +GETLF: GET + CAIE A,12 ;LF + JRST GETLF + MOVE TM,[ACSAV,,P] + BLT TM,P+6 + JRST SWRET ;GO BACK + +MVOI: MOVE A,BTPNT + ILDB I,A + CAIN I,"& + JRST MVOALR ;OPERAND ALREADY THERE + MOVEI A,[ASCIZ ! MOVE A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVEI A!] +MVOIK: PUSHJ P,PRODC + MOVE A,ENN + AOS ENN +FINOF: PUSHJ P,PUTREL + MOVEI A,", + PUSHJ P,PUTREL + PUSHJ P,PRODB + RETLIN + POPJ P, + +MVOALR: AOS ENN + POPJ P, + +TOEARL: MOAN TOO MANY )'S + +PLUS: MOVEI A,[ASCIZ ! FADR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! ADD A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! ADDI A!] +OPERT: PUSHJ P,PRODC + SKIPE STRING + JRST GAINS + SOS ENN +OPRTE: MOVE A,ENN + SOS A + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +COMMAA: MOVEI A,", + PUSHJ P,PUTREL + MOVEI A,"A + JRST PUTREL + +GAINS: MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +MINUX: MOVEI A,[ASCIZ ! FSBR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! SUB A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! SUBI A!] + JRST OPERT + +TIMES: PUSHJ P,TMSTR + SKIPE IMMED + MOVEI A,[ASCIZ ! IMULI A!] + JRST OPERT + +DIVIX: MOVEI A,[ASCIZ ! FDVR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IDIV A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! IDIVI A!] + JRST OPERT + + +UMINU: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE STRING + JRST MOABC + MOVEI A,[ASCIZ ! MOVNS A!] +UMINUC: PUSHJ P,PRODC + MOVE A,ENN + SOS A + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +MOABC: MOVEI A,[ASCIZ ! MOVN A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVNI A!] + PUSHJ P,MVOIK + JRST GAMB + +UABS: CAMN B,C + JRST BAKWD + SKIPE STRING + JRST MOABS + MOVEI A,[ASCIZ ! MOVMS A!] + JRST UMINUC + +MOABS: MOVEI A,[ASCIZ ! MOVM A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVMI A!] + PUSHJ P,MVOIK + JRST GAMB + +MVONT: MOVEI A,[ASCIZ ! MOVE A!] + PUSHJ P,PRODC + MOVE A,ENN + JRST ONMVS + +TMSTR: MOVEI A,[ASCIZ ! FMPR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IMUL A!] + POPJ P, + +BAKWD: PUSH SYM,A + JRST PSOPR + +UDIVI: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE INTEGR + JRST UINDV + SKIPN STRING + PUSHJ P,MVONT + MOVEI A,[ASCIZ ! HRLZI A!] + PUSHJ P,PRODC + MOVE A,ENN + SKIPN STRING + SOS A + PUSHJ P,PUTREL + MOVEI A,[ASCIZ !,201400!] + PUSHJ P,PRODC + RETLIN + AOS ENN + JRST DIVIX + +ONTMS: PUSHJ P,TMSTR + PUSHJ P,PRODC + MOVE A,ENN + SOS A +ONMVS: PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A +LSTCHX: PUSHJ P,PUTREL + RETLIN + POPJ P, + +POWR: GAMB?POWR2?POWAA?POWR4 + +POWR4: PUSHJ P,ONTMS +POWR2: PUSHJ P,ONTMS + JRST GAMB + +POWAA: PUSHJ P,MVONT + AOS ENN + PUSHJ P,ONTMS + SOS ENN + PUSHJ P,TMSTR + PUSHJ P,PRODC + RESTOR + JRST OPRTE + +COMMX: AOS (P) + SKIPE STRING + PUSHJ P,MVOI + JRST GAMB + +UINDV: MOAN INTEGER UNARY DIVIDE + +FUNCT: SETZM EXRET +FUNET: SKIPE STRING + PUSHJ P,MVOI + SPECN + PUSHJ P,MORFMC + MOVEI A,[ASCIZ ! PUSHJ P,!] + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + PUSHJ P,PRODC + PUSHJ P,PRODB + RESTOR + RETLIN + PUSHJ P,MORFNC + SKIPN EXRET + JRST RDITTS ;AS USED FROM FUNCT + JRST COMMT ;AS USED FROM STRSTR + +MORFMC: MOVE A,RANDM + MOVEM A,RANSV' + SKIPN CHARF ;NO ARGUMENTS + AOS ENN + SETOM CHARF + MOVEI A,"1 + CAMN A,ENN ;ARE ARGUMENT ALREADY IN A0 AND UP + POPJ P, + SETZM CORDM +MORYLP: PUSHJ P,ZENBD + AOS CORDM + SOSL RANSV + JRST MORYLP + POPJ P, + +MORFNC: MOVEI A,"1 + CAMN A,ENN + POPJ P, + MOVE A,RANDM + MOVEM A,CORDM' +MORXLP: PUSHJ P,ZENBD + SOSL CORDM + JRST MORXLP + POPJ P, + +ZENBD: MOVEI A,[ASCIZ ! EXCH A!] + PUSHJ P,PRODC + MOVE A,CORDM + ADDI A,"0 + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A + ADD A,CORDM + JRST LSTCHX + +TIPIS: MOVE A,TEMP + MOVEM A,BYTPNT +MORTP: ILDB A,BYTPNT + CAIN A,1 ;EXCLAMATION + POPJ P, + ADDI A," ;SPACE + PUSHJ P,TYO + JRST MORTP + +] ;END .I.FSW CONDITIONAL + +IFN LISTSW,[ +PNTR: MOVEM 17,PNTSA+17 + MOVEI 17,PNTSA + BLT 17,PNTSA+16 + JUMPGE FF,PNTR5 + SKIPL LISTON + JRST PNTR5 + AOSE LISTPF + JRST PNTR1 + SKIPGE T,LISTAD + JRST PNTR2 + PUSHJ P,P6OD + HLRZS T + PUSHJ P,PSOS ;PRINT SPACE OR ' + PUSHJ P,PILPTS +PNTR3: HLRZ T,LISTWD + PUSHJ P,P6OD + MOVS T,LSTRLC + TLNE T,400000 + AOJ T, + PUSHJ P,PSOS + HRRZ T,LISTWD + PUSHJ P,P6OD + HRRZ T,LSTRLC + PUSHJ P,PSOS + PUSHJ P,PILPTS + PUSHJ P,PILPTS +PNTR4: MOVE TT,[440700,,LISTBF] +PNTR6: CAMN TT,PNTBP + JRST PNTR5A + ILDB A,TT + PUSHJ P,PILPT + JRST PNTR6 + +PNTR5A: MOVEI A,15 + PUSHJ P,PILPT + MOVE A,LISTBC + CAIE A,14 + MOVEI A,12 +PNTR5C: PUSHJ P,PILPT +PNTR5D: SETOM LISTBC + +PNTR5: MOVE TT,[440700,,LISTBF] + MOVEM TT,PNTBP + MOVSI 17,PNTSA + BLT 17,17 + POPJ P, + +PNTR5B: MOVE A,LISTBC + CAIN A,14 + JRST PNTR5C + JRST PNTR5D + +PNTR2: MOVEI T,8 + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR3 + +PNTR1: MOVE TT,[440700,,LISTBF] + CAMN TT,PNTBP + JRST PNTR5B + MOVEI T,25. + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR4 + +PSOS: MOVEI A,"' + TRNN T,-1 +PILPTS: MOVEI A,40 + JRST PILPT" + +P6OD: MOVE TT,[220300,,T] +P6OD1: ILDB A,TT + ADDI A,"0 + PUSHJ P,PILPT + TLNE TT,770000 + JRST P6OD1 + POPJ P, + +VBLK ;LISTING FEATURE VARIABLES + +PNTBP: 0 ;POINTER TO LISTING LINE BUFFER +LISTON": 0 ;-1 IF LISTING ON +PNTSW: 0 ;-1 IF LAST CHR CR OR LF +LISTBF: BLOCK 50. +LISTAD: 0 ;ADDRESS OR -1 NONE 3.1 RELOC +LISTWD: 0 ;WORD +LSTRLC: 0 ;RELOCATION +LISTPF: 0 ;-1 OTHERS CONTAIN SOMETHING +LISTBC: 0 ;BREAK CHR CR LF OR FF OR -1 IF NONE SINCE LAST PNTR +LISTTM: 0 ;TEMP AT AEND +PNTSA: BLOCK 20 ;AC SAVE AREA FOR LISTING FEATURE +] ;END LISTSW CONDITIONAL +IFE LISTSW,VBLK + IFN CREFSW,[ +CREFP": 0 ;SET BY C SWITCH TO REQUEST CREFFING. +CRFONP: 0 ;SET WHILE CREFFING. +CRFLFL: 0 ;LAST PAGNUM,,LINENUM OUTPUT. +CRFINU: JFCL\PUSHJ P,CRFUSE ;XCT THIS TO CREF NON-DEF OCCUR. +CRFLBL: JFCL\PUSHJ P,CRFLB1 ;XCT FOR DEF. OF NORMAL SYM. +CRFEQL: JFCL\PUSHJ P,CRFEQ1 ; FOR DEF. OF NORMAL SYM. OR INTSYM. +CRFMCD: JFCL\PUSHJ P,CRFMC1 ; FOR DEF. OF MACRO. +CRFDEF: JFCL\PUSHJ P,CRFDF1 ; FOR RANDOM DEF, CHECK FLAGS. +] +CRFILE: 0 ;SET => SHOULDN'T OUTPUT PAGNUM,,LINENUM'S +;USED BY .CRFILE INTSYM SO CAN'T BE IN CONDIT. +PBLK +IFN CREFSW,[ +CRFEQ1: MOVEI T,(B) + CAIN A,1 ;IF NOT PSEUDO OR NOT INTSYM, + CAIE T,INTSYM + JRST CRFLB1 ;IS NORMAL SYM. +CRFOD1: MOVSI T,600000 ;ELSE DEFINING INSN. + JRST CRFEQ2 + +CRFDF2: MOVEI T,(B) ;DECIDE WHETHER DEFINING MACRO OR PSEUDO. + CAIE T,MACCL + JRST CRFOD1 +CRFMC1: SKIPA T,[500000,,] ;DEFINING MACRO. +CRFLB1: MOVSI T,440000 ;DEFINING NORMAL SYM. +CRFEQ2: PUSH P,A + MOVE A,T + JRST CRFMA1 + +;COME HERE FOR NON-DEF; MUST DECIDE WHAT TYPE SYM. +CRFUSE: TLNE C,3NCRF ;SYM MAY HAVE CREFFING SUPPRESSED. + POPJ P, + PUSH P,A + CAIN A,1 + JRST CRFMAC ;PSEUDOS, MACROS. + MOVSI A,40000 ;FLAG FOR NORMAL SYM. + TLNE C,3INI + MOVSI A,200000 ;FLAG FOR INSNS. +CRFMA1: PUSH P,A + MOVE A,CLNN + HRL A,CPGN + AOBJN A,.+1 ;A HAS PAGNUM,,LINENUM . + SKIPGE CRFILE ;IF SHOULD OUTPUT IT, + JRST CRFUS1 + CAME A,CRFLFL ;AND HAS CHANGED, DO SO. + PUSHJ P,CRFOUT + MOVEM A,CRFLFL +CRFUS1: POP P,A + IOR A,SYM ;COMBINE SYM AND CREF FLAG. + PUSHJ P,CRFOUT + JRST POPAJ + +CRFMAC: MOVEI A,(B) + CAIN A,MACCL + SKIPA A,[100000,,] ;MACRO + MOVSI A,200000 ;PSEUDO-OP. + JRST CRFMA1 + +;DEFINING OCCURRENCE, MIGHT BE ANY TYPE SYM. +CRFDF1: CAIN A,1 ;TYPE 1 => MACRO OR PSEUDO. + JRST CRFDF2 + TLNN C,3INI ;ELSE INSN OR NORMAL SYM. + JRST CRFLB1 + JRST CRFOD1 + +DEFINE CRFM %A,B,C +IF1 [ [B] + [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+CRFM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-CRFM0] +TERMIN + + +; LOCATION, NORMAL VALUE, VALUE WHILE CREFFING +CRFOFF: CRFM CRFONP,0,-1 + CRFM CRFLBL,JFCL,[PUSHJ P,CRFLB1] + CRFM CRFEQL,JFCL,[PUSHJ P,CRFEQ1] + CRFM CRFMCD,JFCL,[PUSHJ P,CRFMC1] + CRFM CRFINU,JFCL,[PUSHJ P,CRFUSE] + CRFM CRFDEF,JFCL,[PUSHJ P,CRFDF1] + POPJ P, +CRFM0==.-CRFOFF + +CRFON: BLOCK CRFM0-1 + POPJ P, + +;.XCREF , DON'T CREF THOSE SYMS. +A.XCREF: PUSHJ P,GETSLD ;READ SYM. + JRST ASSEM1 + JUMPGE FF,A.XCREF + PUSHJ P,ESDEF + JRST A.XCR1 + TLO C,3NCRF ;TURN ON CREF SUPPRESS BIT. + 3PUT C,D + JRST A.XCREF + +A.XCR1: MOVSI T,LCUDF ;CREATE UNDEF ENTRY + TLO C,3NCRF ;WITH CREFFING SUPPRESSED. + PUSHJ P,VSM2 + JRST A.XCREF ;NEXT SYM. + +A.CRFN: JUMPGE FF,ASSEM1 + SKIPE CREFP ;.CRFON, IF HAVE CREF FILE, START CREFFING. + PUSHJ P,CRFON + JRST ASSEM1 + +A.CRFFF: PUSHJ P,CRFOFF ;.CRFOFF, STOP CREFFING. + JRST ASSEM1 +] + +IFN TS,[ ;;TS ;TIME-SHARING ROUTINES + +IFNDEF TYPDLC,TYPDLC==14 ;MAXIMUM TOTAL DEPTH OF .INSRT (INCLUDING TTY) +IFNDEF MX.INS,MX.INS==8 ;MAXIMUM DEPTH .INSRT FILES ONLY +IFNDEF MAXIND,MAXIND==20 ;MAXIMUM # @: TABLE ENTRIES FOR .INSRT +IFNDEF UTIBFL,UTIBFL==100 ;# WORDS EACH .IOT UTYIC, +IFNDEF TUTIBL,TUTIBL==3*UTIBFL ;TOTAL # WORDS INPUT BUFFER +IFNDEF CMBFL,CMBFL==50 ;COMMAND BUFFER LENGTH. +IFNDEF CRFBSZ,CRFBSZ==200 ;# WDS CREF OUTPUT BUFFER. + +IFN DECSW,[DEFINE .SUSET A + TERMIN ] + +TYIC==1 ;TTY INPUT CHANNEL +TYOC==2 ;TTY OUTPUT CHANNEL +CREFC==3 ;CREF OUTPUT. +UTYOC==4 ;OUTPUT FILE +LPTC==5 ;LISTING (LPT) +ERRC==6 ;ERR DEVICE INPUT +UTYIC==7 ;1ST INPUT CHANNEL, UTYIC+1 USED FOR 1ST .INSRT LEVEL IN DEC VERSION. + +VBLK +INTJPC: 0 ;SAVES .JPC AT INTERRUPT. +INTSVP: 0 ;SAVES P ON INTERRUPT FOR DEBUGGING + +;NOTE THAT ONLY PDL OV IS NOW ENABLED. + +IFE DECSW,[ +JOBCNI: +TSINT: 0 ;ALL INTERRUPTS (AT PRESENT) ARE CONSIDERED FATAL ERRORS +JOBTPC: 0 ;ERROR PROCESSOR RE-ENABLES INTERRUPTS + .SUSET [.RJPC,,INTJPC] + JRST TSINT1 ;JUMP INTO PURE CODING AND PROCESS INTERRUPT +] PBLK +TSINT1: MOVEM P,INTSVP ;SAVE P FOR POSSIBLE DEBUGGING + MOVE A,JOBCNI ;GET INTERRUPT REQUEST WORD + MOVEI B,'INT ;DEFAULT + SOS JOBTPC ;MAKE IT POINT TO PLACE INTERRUPT CAME FROM + TRNN A,200000 ;PDL OVERFLOW? + JRST TSINT7 ;NO + LDB A,[270400,,@JOBTPC] ;GET AC FIELD OF GUILTY INSTRUCTION + CAIN A,P ;IF P, + MOVE P,[-LPDL,,PDL] ;RESET PDL POINTER + MOVEI B,'PDL +TSINT7: TRNE A,20000 ;MEMORY PROTECTION VIOLATION? + MOVEI B,'ILM ;YES + MOVEM B,40 + AOS A,JOBTPC ;SO ERROR ROUTINE WILL PRINT OUT PROPERLY + .SUSET [.SPICL,,[-1]] + JSA A,ERROR + +IFNDEF .IOT,[ ;DON'T DEFINE SYSTEM CALLS IF DEFINED.. + + ;ITS SYSTEM CALLS AS OF ITS 703, 8:56:44 PM, WEDNESDAY, NOV 17,1971 --SSYML.14 + +.RUPC==0? .STTY==400002? .SETM2=42000,,5? .IOPDL=42000,,57 +.RVAL==1? .SFLS==400003? .LOGIN=42000,,6? .ITYIC=42000,,60 +.RTTY==2? .SUNAM==400004? .CLOSE=42000,,7? .MASTE=42000,,61 +.RFLS==3? .SJNAM==400005? .UCLOS=42000,,10? .VSTST=42000,,62 +.RUNAM==4? .SMASK==400006? .ATTY=42000,,11? .DIETI=42000,,66 +.RJNAM==5? .SUSTP==400007? .DTTY=42000,,12? .SHUTD=42000,,67 +.RMASK==6? .SPIRQ==400010? .IOPUS=42000,,13? .ARMOF=42000,,70 +.RUSTP==7? .SINTB==400011? .IOPOP=42000,,14? .NDIS=42000,,71 +.RPIRQ==10? .SMEMT==400012? .DCLOS=42000,,15? .FEED=42000,,72 +.RINTB==11? .SSV40==400013? .DSTOP=42000,,16? .EVAL=42000,,73 +.RMEMT==12? .SIPIR==400014? .RDTIM=42000,,17? .REDEF=42000,,74 +.RSV40==13? .SAPIR==400015? .RDSW=42000,,20? .IFSET=42000,,75 +.RIPIR==14? .SSNAM==400016? .GUN=42000,,21? .UTNAM=42000,,76 +.RAPIR==15? .SPICL==400017? .UDISM=42000,,22? .UINIT=42000,,77 +.RSNAM==16? .SMARA==400020? .GETSY=42000,,23? .RYEAR=42000,,100 +.RPICL==17? .SMARP==400021? .IPDP=42000,,24? .RLPDT=42000,,101 +.RMARA==20? .SUUOH==400022? .GETLO=42000,,25? .RDATI=42000,,102 +.RMARP==21? .SUIND==400023? .SETLO=42000,,26? .RCHST=42000,,103 +.RUUOH==22? .SRUNT==400024? .DISOW=42000,,27? .RBTC=42000,,104 +.RUIND==23? .SMSK2==400025? .MSPAC=42000,,30? .DMPCH=42000,,105 +.RRUNT==24? .SIFPI==400026? .GENSY=42000,,32? .SWAP=42000,,106 +.RMSK2==25? .SAPRC==400027? .LOGOU=42000,,33? .CALL=43000,, +.RIFPI==26? .SSV60==400030? .REALT=42000,,34? .DISMI=43040,, +.RAPRC==27? .SUTRP==400031? .WSNAM=42000,,35? .TRANS=43100,, +.RSV60==30? .SIIFP==400032? .UPISE=42000,,36? .TRANA=43140,, +.RUTRP==31? .SAIFP==400033? .RESET=42000,,37? .VALUE=43200,, +.RIIFP==32? .SIMAS==400034? .ARMOV=42000,,40? .UTRAN=43240,, +.RAIFP==33? .SAMAS==400035? .CBLK=42000,,42? .CORE=43300,, +.RIMAS==34? .SIMSK==400036? .ASSIG=42000,,43? .TRAND=43340,, +.RAMAS==35? .SAMSK==400037? .DESIG=42000,,44? .DSTAR=43400,, +.RIMSK==36? .SJPC==400040? .RTIME=42000,,45? .FDELE=43440,, +.RAMSK==37? .SOPC==400041? .RDATE=42000,,46? .DSTRT=43500,, +.RJPC==40? .SRTMR==400042? .HANG=42000,,47? .SUSET=43540,, +.ROPC==41? .S60H==400043? .EOFC=42000,,50? .LTPEN=43600,, +.RRTMR==42? .IOT=40000,,? .IOTLS=42000,,51? .VSCAN=43640,, +.R60H==43? .OPEN=41000,,? .RSYSI=42000,,52? .POTSE=43700,, +.RIOC==100? .OPER=42000,,? .SUPSE=42000,,53? .USET=44000,, +.RIOS==120? .ITYI=42000,,1? .PDTIM=42000,,54? .BREAK=45000,, +.RIOP==140? .LISTE=42000,,2? .ARMRS=42000,,55? .STATU=46000,, +.SUPC==400000? .SLEEP=42000,,3? .UBLAT=42000,,56? .ACCES=47000,, +.SVAL==400001? .SETMS=42000,,4 + ] ;END IFNDEF .IOT, CONDITIONAL. + +BEG: .SUSET [.RSNAM,,RSYSNM] ;GET SYSTEM NAME + .SUSET [.SMASK,,[200000]] ;PDL OVERFLOW ONLY. + .SUSET [.SPICL,,[-1]] ;PERMIT INTERRUPTS (IN CASE RESTARTED DURING INTERRUPT) + MOVEI FF,0 ;INITIALIZE FLAGS + MOVE P,[-LPDL,,PDL] ;INITIALIZE P +IFN PURESW,[MOVE A,[HALT] + MOVEM A,PURIFY +] MOVEI D,SYMDSZ ;GET DEFAULT SYMTAB SIZE + .SUSET [.RJNAM,,A] + CAME A,['MMIDAS] ;OR LARGER FOR MMIDAS + CAMN A,[SIXBIT/MM/] + MOVEI D,SYMMSZ + SKIPGE ISYMF ;THE FIRST TIME THROUGH, + MOVEM D,SYMLEN ;MAKE THAT THE SIZE TO USE. + PUSHJ P,TTYINI ;NOW OPEN TTY +IFN PURESW,[ + SKIPGE PURIFG + TYPR [ASCIZ /NOTPUR /] +] + MOVE B,[SIXBIT /MIDAS./] + PUSHJ P,SIXTYO + MOVE B,[.FNAM2] + PUSHJ P,SIXTYO +IFE DECSW,[SKIPGE ISYMF ;SKIP IF SYMS SPREAD + PUSHJ P,TSYMGT ;GET TS SYMS FROM SYSTEM +] ;DROPS THROUGH + + ;RETURN POINT FROM FATAL ERRORS (DROPS THROUGH) + +GO2: MOVEI FF,0 ;INITIALIZE FLAGS + SKIPLE CMPTR + SETZM CMPTR + SETZM TTYINS ;NO T-SWITCHES SEEN YET. +IFN RUNTSW,[ PUSHJ P,RNTTMA ;GET INITIAL RUN TIME. + MOVEM A,IRUNTM] + PUSHJ P,CMD ;GET TYPED IN COMMAND + SKIPGE SMSRTF + JRST GO21 + TYPR [ASCIZ/SYMTAB CLOBBERED +/] + JRST GO2 + +GO21: PUSHJ P,GINIT ;INITIALIZE STUFF + PUSHJ P,OPNRD ;OPEN INPUT FILE + PUSHJ P,WINIT ;OPEN OUTPUT FILE, CREF FILE. +GO3: JSP A,INIT ;INITIALIZE FOR ASSEMBLY + JSP A,PS1 ;DO PASS 1 +IFN A1PSW,[ + TLZ FF,OUTF + AOS PRGC ;INDICATE END STATEMENT ENCOUNTERED + SETOM OUTC ;" " " +] + TRNE FF,NPSS ;IF 2 PASS ASSEMBLY, + PUSHJ P,OPNRD ;THEN RE-OPEN INPUT FILE + JSP A,PLOD ;MAYBE PUNCH OUT SBLK LOADER IN SOME FORMAT + JSP A,PS2 ;DO PASS 2 + JSP A,PSYMS ;MAYBE PUNCH OUT SYMBOL TABLE +IFN A1PSW,[ + TRNN FF,NPSS ;IF 1 PASS ASSEMBLY, + JRST GO3 ;THEN TRY TO ASSEMBLE ANOTHER PROGRAM +] +RETN2: PUSHJ P,.FILE +IFN RUNTSW,[SKIPE RUNTSX + PUSHJ P,RNTTYO ;TYPE OUT RUN TIME USED SINCE GO2 +] JRST TSRETN + + ;INITIALIZATION ROUTINE CALLED ONCE PER (COMMANDED) ASSEMBLY + +GINIT: IFN A1PSW,[ + SETOM PRGC + SETOM OUTC +] + MOVE A,[MAXIND,,FDSOFS] + MOVEM A,INDDP ;INITIALIZE POINTER INTO INDIRECT FILE TABLE +IFDINI: MOVE A,[DNAM,,IFDS] + BLT A,IFDS+LFDSE-1 ;SET UP INPUT FILE NAMES FROM DNAM ETC. + POPJ P, + +IFN RUNTSW,[ ;TYPE OUT RUN TIME USED + +RNTTYO: TYPR [ASCIZ /RUN TIME = /] + PUSH P,[CRR] ;END WITH CRLF + PUSHJ P,RNTTMA ;GET CURRENT RUN TIME + SUB A,IRUNTM' ;SUBTRACT RUN TIME AS OF GO2 + MULI A,4069. ;CONVERT TO NANOSECONDS + DIV A,[10000000.] ;10.**7, CONVERT TO HUNDREDTHS + IDIVI A,100. ;GET SECS AND REMAINDER + HRLM B,(P) ;SAVE REMAINDER + PUSHJ P,HMSTYO ;TYPE OUT SECS + MOVEI A,". + JRST RNTYO2 ;TYPE OUT HUNDREDTHS + + ;TYPE OUT H:MM:SS TIME IN A + ;DOESN'T WORK FOR TIMES .GE. 60. HOURS + +HMSTYO: IDIVI A,60. + JUMPE A,HMSTY2 + HRLM B,(P) + PUSHJ P,HMSTYO + MOVEI A,": +RNTYO2: PUSHJ P,TYO ;TYPE DELIMITING CHAR + HLRZ A,(P) + IDIVI A,10. + PUSHJ P,ADGTYO ;TYPE OUT DIGIT IN A + MOVEI A,"0(B) + JRST TYO + +HMSTY2: MOVE A,B + JRST DPNT + +RNTTMA: .SUSET [.RRUNT,,A] + POPJ P, +] + + ;TS OUTPUT ROUTINES + +TPPB: IDPB A,UTYOP ;OUTPUT WORD + AOSGE UTYOCT ;SKIP IF BUFFER FULL + POPJ P, +TPPBF: EXCH A,UTYOP ;BUFFER FULL OR TPPBF CALLED TO DUMP BUFFER + HRLOI A,-UTOBUF(A) + EQVI A,UTOBUF + TLNE A,-1 ;IGNORE ZERO + .IOT UTYOC,A +WINIT2: MOVNI A,UTOBE-UTOBUF ;(RE)INITIALIZE OUTPUT BUFFER VARIABLES + MOVEM A,UTYOCT + MOVE A,[4400,,UTOBUF-1] + EXCH A,UTYOP + POPJ P, + +.FILE: MOVNI A,1 + MOVE B,CONTRL + TRNN B,DECREL ;UNLESS IN DEC FMT, + PUSHJ P,TPPB ;OUTPUT A -1 SO STINK WILL SEE EOF + PUSHJ P,TPPBF ;OUTPUT THE BUFFER + .CLOSE UTYIC, + MOVEI A,UTYOC + MOVEM A,ONAM + SETZM ONAM-1 + SKIPE ONAM+2 + JRST .FILE2 ;OUTPUT FNAM2 WAS EXPLICITLY SPECIFIED + SKIPL B,CONTRL + SKIPA A,[SIXBIT /REL/] + MOVSI A,(SIXBIT /BIN/) + TRNE B,DECREL ;THE DEFAULT DEPENDS ON OUTPUT TYPE. + MOVE A,['DECREL] + MOVEM A,ONAM+2 +.FILE2: .FDELE ONAM-2 + JFCL + .CLOSE UTYOC, +IFN CREFSW,[ + SKIPN CREFP ;IF CREF FILE OPEN, + POPJ P, + MOVEI A,0 + PUSHJ P,CRFOUT ;OUTPUT EOF BLOCK, + PUSHJ P,CRFEND ;EMPTY BUFFER, + MOVEI A,CREFC + MOVEM A,CRFDEV + SETZM CRFDEV-1 + MOVE A,[SIXBIT/CREF/] + SKIPN CRFDEV+2 ;DEFAULT FN2 TO CREF, + MOVEM A,CRFDEV+2 + .FDELE CRFDEV-2 ;RENAME (WAS _MIDAS CRFOUT) + JFCL + .CLOSE CREFC, +] POPJ P, + +WINIT: PUSHJ P,OINIT ;OPEN OUTPUT FILE, FN2=OUTPUT. + 0 UTYOC,ONAM ;CHNL,NAME-BLOCK. + SIXBIT/OUTPUT/ + TLZ FF,PTPF ;INITIALLY ASSUME DEVICE NOT PAPER TAPE PUNCH + .STATUS UTYOC,A ;GET STATUS OF OUTPUT CHANNEL + ANDI A,77 ;MASK TO DEVICE CODE + CAIN A,7 ;IF PAPER TAPE PUNCH, + TLO FF,PTPF ;THEN SET PTPF +IFN CREFSW,[ + SKIPN CREFP ;IF CREF REQUESTED, + JRST WINIT2 + PUSHJ P,OINIT ;OPEN CREF FILE, FN2=CRFOUT + 0 CREFC,CRFDEV + SIXBIT/CRFOUT/ + SETOM CRFCNT ;SAY BUFFER NOT INITTED. + MOVE A,[<177_35>+ASCII/B/] + PUSHJ P,CRFOUT ;OUTPUT HEADER TO INDICATE IMAGE INPUT. + PUSHJ P,CRFSSF ;OUTPUT SET-SOURCE-FILE BLOCK. +] JRST WINIT2 + ; PUSHJ P,OINIT ;OPEN OUTPUT FILE +; 0 CHNL,NAME-BLOCK-ADDR +; SIXBIT/DESIRED-TEMPORARY-FN2/ +OINIT: MOVE A,[SIXBIT/_MIDAS/] + MOVEM A,DNAM+1 ;OPEN AS _MIDAS WHATEVER. + MOVE A,(P) + MOVE A,1(A) ;GET 2ND ARG, + MOVEM A,DNAM+2 ;USE AS FN2. + MOVE A,@(P) ;1ST ARG. + MOVE B,3(A) ;GET SNAME SPECIFIED, + MOVEM B,SNAM + MOVE A,(A) ;DEVICE NAME, + MOVEM A,DNAM + .CALL OINITB ;DELETE OLD TEMP NAME FILE. + JFCL ;THERE WAS NONE. + LDB A,[270400,,@(P)] ;GET CHANNEL NUM. + HRLI A,7 ;OPEN MODE. + .CALL OPENB + JRST OINITL +POPJ2: AOS (P) ;SKIP OVER 2 ARGS. + JRST POPJ1 + +OINITB: SETZ ? SIXBIT/DELETE/ + DNAM ? DNAM+1 ? DNAM+2 ? SETZ SNAM + +OINITL: HLLZ A,@(P) ;GET CHNL NUM, + IOR A,[.STATUS A] + XCT A ;READ ITS STATUS, + PUSHJ P,OPNER ;TYPE OUT REASON FOR OPEN FAILURE, + MOVEI A,": ;AND EXPECTATION CHARACTER. + PUSHJ P,TYO + PUSHJ P,GTYIP ;GET TYPEIN + HRLZ A,@(P) ;REPLACE '_MIDAS' WHATEVER BY ACTUAL NAMES. + PUSHJ P,A.IMP1 + PUSHJ P,RFD ;GET NEW FILE DESCRIPTION + HRRZ A,@(P) ;GET NAME BLOCK ADDR, + MOVEI B,3(A) + HRLI A,DNAM ;COPY NAMES JUST READ INTO IT. + BLT A,(B) + JRST OINIT + +TFEED: TLNN FF,PTPF ;IF OUTPUT DEVICE NOT PTP, + POPJ P, ;THEN DO NOTHING + PUSHJ P,TPPBF ;OTHERWISE OUTPUT THE BUFFER, +TFEED1: .FEED UTYOC, ;FEED A LINE, + TLZA FF,PTPF ;IF THIS IS EXECUTED, UTYOC DOESN'T HAVE PTP AFTER ALL + SOJG B,TFEED1 ;FEED THE SPECIFIED NUMBER OF LINES, + POPJ P, ;AND RETURN + +TSRETN: .LOGOUT ;COME HERE TO COMMIT SUICIDE. + .BREAK 16,160000 + + ;TS INPUT ROUTINES + + ;OPEN MAIN INPUT FILE FOR READING + +OPNRD: .IOPDL ;RE-INITIALIZE IO PDL + MOVE A,[-TYPDLS-1,,TTYPDL] + EXCH A,ITTYP ;INITIALIZE "TTY PDL" + CAME A,ITTYP ;ANYTHING PUSHED? + PUSHJ P,MACIN1 ;YES, CLOBBER MACRO EXPANSION STATUS + MOVE A,[440700,,UTIBUF] ;NOW CLOBBER INPUT BUFFER VARIABLES + INSIRP MOVEM A,[IUREDP UREDP UTIBED] ;INITIALIZE EVERYTHING + MOVSI A,EOFCH_<18.-7> + MOVEM A,UTIBUF ;CAUSE EOFCH TO BE FIRST CHARACTER READ + MOVS A,IFDS ;GET DEVICE NAME + CAIN A,(SIXBIT /TTY/) ;TTY? + JRST OPNRDT ;YES, TREAT SPECIAL + MOVSI A,IFDS ;NOT TTY, TRY OPENING FILE + PUSHJ P,A.IMP1 ;SET UP DNAM, ETC. + PUSHJ P,OPNRD1 ;TRY OPENING FILE + JRST OPNRDL ;LOSE + HRRZS UTIBED ;WIN, CAUSE RELOADING ON FIRST CALL TO RPA + MOVEI A,0 ;=> INPUT FROM FILE +OPNRT2: MOVE T,[IFNM1,,RFNAM1] + BLT T,RFNAM2 ;SET UP .FNAM1, .FNAM2 + SETZM ERRTPF ;NO NEED TO TYPE MAIN FILE'S NAME. + JRST RCHSET ;ADDRESS MODIFY AND RETURN + +OPNRDT: MOVE A,[IFDS+1,,IFNM1] ;TTY SPECIFIED, TREAT SPECIAL + BLT A,IFNM2 ;CLOBBER .IFNM1, .IFNM2 TO SPECIFIED + MOVEI A,3 ;=> INPUT FROM TTY, DON'T QUIT ON CR + JRST OPNRT2 + +OPNRDL: PUSHJ P,IOPNER ;.OPEN LOST, TYPE OUT MESSAGE + JRST GO2 ;READ NEW COMMAND + + ;TRY .OPENING INPUT FILE (DESCRIPTION IN DNAM, ETC.) SKIPS IF SUCCESSFUL + +OPNRD1: MOVE A,[2,,UTYIC] ;MODE,,CHANNEL. + .CALL OPENB + JRST OPNRD2 ;CAN'T OPEN INPUT FILE. + MOVE A,[UTYIC,,RCHSTB] + .RCHST A, ;RESULTS NEEDED BY WINIT, A.ITR2. + SKIPN A,RCHSTB+1 ;GET SYSTEM FILE NAME 1 + MOVE A,FNAM1 ;SYSTEM DOESN'T KNOW, GET SPECIFIED + MOVEM A,IFNM1 ;SET UP FOR .IFNM1 + MOVEM A,RCHSTB+1 + SKIPN A,RCHSTB+2 ;NOW SAME FOR .IFNM2 + MOVE A,FNAM2 + MOVEM A,IFNM2 + MOVEM A,RCHSTB+2 + MOVE A,[RCHSTB,,ERRDEV] + BLT A,ERRDEV+3 ;REMEMBER NAMES OF CURRENT INPUT FILE. + HRLZS ERRDEV ;MAKE THE DEV NAME BE LEFT-JUST. + SETOM ERRTPF ;INPUT FILE NAMES HAVE CHANGED, TYPE THEM NEXT ERROR MSG. + AOSA (P) ;CAUSE RETURN TO SKIP +OPNRD2: .STATUS UTYIC,IFSTS ;.OPEN LOST, GET CHANNEL STATUS NOW BEFORE POSSIBLE .IOPOP + POPJ P, + +OPENB: SETZ ? SIXBIT/OPEN/ + A ;SHOULD HOLD MODE,,CHANNEL. + DNAM ? DNAM+1 ? DNAM+2 ? SETZ SNAM + + ;EOFCH ENCOUNTERED ON READ, RELOAD AND JUMP BACK FOR NEXT CHAR + +INCHR3: HRRZ A,UREDP ;GET BYTE POINTER + CAME A,UTIBED ;END OF COMPLETELY READ BLOCK? + JRST RPAEOF ;NO => REALLY EOF + MOVE A,IUREDP ;GET INITIAL UREDP + HLL A,UREDP + ADD A,[70000,,] ;BACK UP OVER EOF CHAR ILDB'D, MAY BE RETURNING FROM .INSRT + MOVEM A,UREDP ;STORE INITIAL UREDP FOR NEXT TIME AROUND + HRLI A,-UTIBFL ;CONVERT TO BLOCK .IOT POINTER + .IOT UTYIC,A ;READ IN BLOCK + TLZ A,377777 ;CLEAR OUT @, INDEX FIELDS, ALSO ALL BUT SIGN JUST FOR LAUGHS + MOVEM A,UTIBED ;STORE RH (UPDATED POINTER) FOR EOF CHECK AT INCHR3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ;STORE EOF WORD + JRST RCHTRA ;NOW TRY NEXT CHAR + + ;EOF WHILE TRYING TO READ CHARACTER + +RPAEOF: PUSH P,B ;SAVE B + MOVE B,ITTYP ;GET PDL POINTER + PUSHJ P,BPOPJ ;CALL POP ROUTINE (MAYBE NED'S OUT) + JRST RCHTRB ;RETURN TO GET CHARACTER + + ;EOF FROM MAIN FILE + +NEDCHK: IFN A1PSW,[ PUSHJ P,OUTCHK + MOVSI A,-LNEDT + XCT NEDT(A) ;SKIPS IF NED CONDITION TO BE COMPLAINED ABOUT + AOBJN A,.-1 + JUMPGE A,RETN2 +] + MOVE A,[70700,,[EOFCH]] + MOVEM A,UREDP + ERF 'NED + +IFN A1PSW,[ ;HOLLAR "NED" IF ANY OF THE FOLLOWING: +NEDT: SKIPL PRGC ;NO END STATEMENTS HAVE BEEN ENCOUNTERED + SKIPGE OUTC ;OUTPUT HAS OCCURED NOT MATCHED BY AN END STATEMENT + SKIPGE OUTN1 ;OUTPUT HAS OCCURED OTHER THAN IN 1PASS MODE + TRNN FF,PSS ;CURRENTLY IN PASS 2 +LNEDT==.-NEDT ;LENGTH OF TABLE +] + + ;IO PDL ROUTINES FOR INPUT FILE + ;PUSH THE INPUT FILE + +IPUSH: MOVE A,[UTYIC,,RCHSTB] + .RCHST A, + MOVE A,UREDP ;GET INPUT BYTE POINTER + TLNN A,760000 ;AT END OF WORD? + ADD A,[430000,,1] ;YES, MAKE IT POINT TO BEGINNING OF NEXT WORD + SKIPGE UTIBED ;EOF ON LAST .IOT? + TLO A,40 ;YES + HRRZS UTIBED ;NOW CLEAR OUT LEFT HALF FOR FOLLOWING + SKIPGE B,ACCP ;GET .ACCESS POINTER + JRST IPSH2 ;INPUT DEVICE NOT RANDOMLY ACCESSIBLE + ADDI B,(A) + SUB B,UTIBED ;CONVERT TO DESIRED + HRR A,IUREDP ;CLOBBER RH(UREDP TO SAVE) + CAME B,ACCP ;NEW POINTER SAME AS OLD? + .ACCESS UTYIC,B ;NO, HAVE SYSTEM CAUSE RE-INPUT FROM DESIRED WORD + TLZ A,40 ;RANDOM ACCES DEVICE- SILL READ STUFF AGAIN + ;DISREGARD PREV EOF + SKIPA B,IUREDP ;IUREDP TO POINT TO FIRST AVAILABLE WORD +IPSH3: MOVE B,UTIBED +IPSH4: HRLI B,440700 + MOVEM B,IUREDP ;LINK FORWARD + MOVEM B,UREDP ;STORE NEW POINTER + HRRZM B,UTIBED ;STORE EOF CHECK + MOVSI T,EOFCH_<18.-7> + MOVEM T,(B) ;STORE EOF WORD TO CAUSE RELOAD + .IOPUSH UTYIC, ;NOW DO THE .IOPUSH + MOVE B,ITTYP ;GET LOCAL VERSION OF IOPDL +IPSHP: +REPEAT 4,PUSH B,ERRDEV+.RPCNT ;SAVE NAMES OF INPUT FILE. + PUSH B,A ;NEW UREDP, RH ALSO RH(IUREDP), <40,,> => SET SIGN OF UTIBED + ;FOLLOWING TWO MUST BE LAST PUSHED + INSIRP PUSH B,[IFNM1 IFNM2] ;CLOBBERED ON PDL IF .OPEN SUCCESSFUL +INPDEL==.-IPSHP ;LENGTH OF EACH ENTRY ON PDL + MOVEI A,0 ;=> INPUT FROM FILE + MOVEM B,ITTYP ;STORE BACK UPDATED POINTER + JSP B,PUSHTT ;SAVE STUFF, ADDRESS MODIFY AND RETURN + ;POP INTO THE INPUT FILE +IPOP: +IFN CREFSW,[ MOVEI A,2 ;IF CREFFING, OUTPUT POP-FILE BLOCK. + SKIPE CRFONP + PUSHJ P,CRFOUT] +IPOPL: PUSHJ P,POPTT ;COME HERE IF .INSRT'S OPEN FAILED. + MOVE B,ITTYP ;GET POINTER + INSIRP POP B,[IFNM2 IFNM1 A] ;POP STUFF +REPEAT 4,POP B,ERRDEV+3-.RPCNT + MOVEM B,ITTYP ;STORE BACK UPDATED POINTER + .IOPOP UTYIC, ;POP INTO CHANNEL + HRRZ B,IUREDP ;NOW GET POINTER TO LAST WORD IN BUFFER + TLZE A,40 ;BIT 12. SET? + TLO B,400000 ;YES, SET SIGN BIT IN WHAT WILL BECOME EOF CHECK + MOVEM B,UTIBED + MOVEM A,UREDP ;STORE NEW POINTER + HRRM A,IUREDP ;ALSO POINTER TO BEGINNING OF ACTIVE PART OF BUFFER + MOVE A,[<<<<_7+EOFCH>_7+EOFCH>_7+EOFCH>_7+EOFCH>_1] + MOVEM A,(B) ;STORE EOF CHARACTERS AT END OF BUFFER + SETOM ERRTPF ;CHANGED FILES, NEXT ERROR MUST TYPE NAME. + POPJ P, + + ;IPUSH WHEN DEVICE NOT RANDOMLY ACCESSIBLE + +IPSH2: HRRZ B,IUREDP ;GET POINTER TO BEGINNING OF ACTIVE PART OF BUFFER + CAIN B,(A) ;THAT WHERE UREDP IS? + JRST IPSH3 ;YES, NO BLT NECESSARY + MOVS T,A + HRR T,B ;SET UP BLT POINTER + SUBI B,(A) + HRR A,T + ADDB B,UTIBED + BLT T,(B) ;BLT DOWN STUFF (INCL EOF WRD) TO BOTTOM OF ACTIVE PART OF BUFFER + CAIL B,UTIBE-UTIBFL ;ROOM? + ERF 'IOV ;NO ROOM IN BUFFER FOR ANOTHER INPUT FILE + JRST IPSH4 + + ;SAVE INTERNAL POINTERS CONCERNING INPUT MODE + +TYPDEL==2 ;NUMBER OF WORDS IN RELEVANT PDL ENTRY + +PUSHTT: PUSH P,A + PUSH P,F + MOVE F,ITTYP ;GET RELEVANT PDL POINTER + MOVEI A,0 + EXCH A,CLNN ;SET UP NEW LINE NUMBER + HRL A,CPGN ;SAVE CURRENT PAGE NUMBER + SETZM CPGN ;NOW RE-INITIALIZE +IFN CREFSW,[ + SKIPGE CRFILE ;SAVE CREF-ALL-ON-ONE-LINE FLAG. + TLO A,400000 +] + PUSH F,A ;SAVE CPGN,,CLNN + MOVE A,-1(P) ;RETRIEVE NEW MODE + PUSHJ P,PSHLMB ;SAVE LIMBO1 AND SET UP INSTRUCTIONS FOR NEW MODE + MOVEM F,ITTYP ;STORE BACK UPDATED POINTER + JRST POPFAJ + + ;RESTORE INTERNAL POINTERS CONCERNING INPUT MODE + +POPTT: PUSH P,A + PUSH P,F + MOVE F,ITTYP ;GET PDL POINTER + PUSHJ P,POPLMB ;POP INTO LIMBO1, SET UP NEW MODE + POP F,A ;GET CPGN,,CLNN +IFN CREFSW,[ + SETZM CRFILE ;RESTORE ALL-ON-ONE-LINE FLAG. + TLZE A,400000 + SETOM CRFILE +] + HLRZM A,CPGN + HRRZM A,CLNN + MOVEM F,ITTYP ;STORE BACK UPDATED POINTER + JRST POPFAJ + + ;TTY ROUTINES + + ;GET CHARACTER IN A, READ NEW STRING IF OLD EXHAUSTED (USED BY CMD) + +RCHA: ILDB A,CMPTR ;GET CHARACTER + JUMPN A,CPOPJ ;RETURN IF VALID + PUSHJ P,TYRLD ;END OF STRING, RELOAD + JRST RCHA ;TRY AGAIN + + ;CAUSE INPUT FROM TTY (MAIN ROUTINES) + +GTYIP: SKIPA A,[2] ;VERSION TO QUIT ON CR +GTYIPA: MOVEI A,3 ;VERSION TO NOT QUIT ON CR + PUSHJ P,TYRLD ;GET TYPED IN STRING + JSP B,PUSHTT ;SET UP VARIABLES AND RETURN +GTYIPR: SETZM CMPTR ;RETURN ON .INEOF OR CR + JRST POPTT + + ;RCHSET ROUTINES FOR READING FROM TTY + ;3 => DON'T QUIT ON CR + +RCHARC: TLO FF,TTYRCH ;SET FLAG + JSP A,CPOPJ +RCHAC1: REPEAT 2,[ ;GETCHR, RR1 + ILDB A,CMPTR ;GET CHAR + CAIN A,0 ;END OF STRING MARKED WITH 0 + PUSHJ P,RTYRLD ;RELOAD, JUMP BACK FOR NEXT CHAR +] + HALT ;RRL1 +IFN .-RCHAC1-RCHPSN,[PRINTC /RCHAC1 LOSES. +/] + ILDB A,CMPTR ;SEMIC + CAIN A,15 + JRST SEMICR + JUMPN A,SEMIC + PUSHJ P,TYRLD + JRST SEMIC + + ;2 => QUIT ON CR + +RCHTRC: TLO FF,TTYRCH ;SET FLAG + JSP A,CPOPJ +RCHTC1: REPEAT 2,[ ;GETCHR, RR1 + ILDB A,CMPTR + CAIN A,0 + PUSHJ P,RPAEOF +] + HALT ;RRL1 +IFN .-RCHTC1-RCHPSN,[PRINTC /RCHTC1 LOSES. +/] + ILDB A,CMPTR ;SEMIC + CAIN A,0 + PUSHJ P,RPAEOF ;END OF STRING + JRST SEMIC + + ;READ IN STRING + +TYRLD: PUSH P,A + PUSH P,F + MOVE F,[10700,,CMBUF-1] ;INITIAL BYTE POINTER TO BUFFER + MOVEM F,CMPTR ;STORE AS BYTE POINTER FOR READ +TYRLD2: PUSHJ P,TYI ;GET CHARACTER + CAIN A,177 ;RUBOUT? + JRST TYRLD3 ;YES + CAIE A,^C + CAIN A,^U + JRST TYRLD5 ;RUB OUT ALL + IDPB A,F ;STORE CHARACTER IN BUFFER + CAIE A,15 ;CR? + JRST TYRLD2 ;NO, GO BACK FOR NEXT + MOVEI A,0 ;YES, + IDPB A,F ;MARK END OF STRING + JRST POPFAJ + +TYRLD3: CAMN F,[10700,,CMBUF-1] ;RUBOUT, BEGINNING OF BUFFER? + JRST TYRLD4 ;YES + LDB A,F ;GET LAST CHARACTER IN BUFFER + PUSHJ P,TYO ;TYPE IT OUT + ADD F,[70000,,] ;DECREMENT POINTER + JUMPGE F,TYRLD2 ;JUMP IF VALID + SUB F,[430000,,1] ;WAS 440700,,SOMETHING, BACK IT UP + JRST TYRLD2 + +TYRLD5: MOVE F,[10700,,CMBUF-1] ;CONTROL C, BACK TO BEGINNING OF LINE +TYRLD4: PUSHJ P,CRR ;RUBOUT WHEN AT BEGINNING OF BUFFER, TYPE CR + JRST TYRLD2 + +RTYRLD: PUSHJ P,TYRLD + JRST RCHTRA + +IFE DECSW,[ ;GET (JUST TYPED IN) CHAR IN A + +TYI: .IOT TYIC,A + JUMPE A,TYI + CAIE A,^L ;SKIP IF FORM-FEED, CLEAR SCREEN ON DISPLAY CONSOLE + POPJ P, + MOVEI A,^P + PUSHJ P,TYO + MOVEI A,"C + PUSHJ P,TYO + MOVEI A,^L + POPJ P, + +TAB: MOVEI A,11 +TYO: .IOT TYOC,A ;TYPE OUT CHAR IN A + POPJ P, + + ;INITIALIZE TTY + +TTYINI: .OPEN TYIC,[20,,SIXBIT / TTYMIDAS TYI/] ;INPUT, CONVERT LOWER CASE TO UPPER + .VALUE + .OPEN TYOC,[21,,SIXBIT / TTYMIDAS TYO/] ;DISPLAY MODE OUTPUT + .VALUE + MOVE A,[CMBUF,,CMBUF+1] + BLT A,CMBUF+CMBFL-2 ;ZERO ALL BUT LAST WD, + MOVEM A,CMBUF+CMBFL-1 ;NONZERO LAST WD. + .BREAK 12,[5,,CMBUF] ;TRY TO READ COMMAND STRING. + POPJ P, +] ;END IFE DECSW, + +IFN DECSW,[ +TYI: INCHWL A + POPJ P, + +TAB: MOVEI A,^I +TYO: OUTCHR A + POPOPJ P, + +TTYINI: INIT TYIC,100 + 'TTY,, + 0 + JRST TTYINI + SETZM CMBUF + POPJ P, +] + + ;TS DATA STORAGE + +VBLK + +TYPDLS=TYPDLC*TYPDEL+INPDEL*MX.INS + ;"TTY PDL", STORES INFORMATION ABOUT CURRENT INPUT MODE + ;(SIMILAR TO MACRO PDL BUT NOT GARBAGE COLLECTED) + +ITTYP: -TYPDLS-1,,TTYPDL ;PDL POINTER (TYPDEL=LENGTH OF EACH ENTRY) +TTYPDL: NEDCHK ;ACTUAL PDL: INITIAL ENTRY TO OVERPOP ROUTINE + BLOCK TYPDLC*TYPDEL ;PDL PROPER + + ;INPUT BUFFER AND VARIABLES + +UTIBUF: EOFCH_<36.-7> + BLOCK TUTIBL-1 ;INPUT BUFFER +UTIBE: 0 ;END OF " +IUREDP: 440700,,UTIBUF ;INITIAL UREDP, POINTS TO BEGINNING OF ACTIVE PART OF BUFFER +UREDP: 440700,,UTIBUF ;INPUT BYTE POINTER +UTIBED: 440700,,UTIBUF ;EOF COMPARISON WITH RH(UREDP), 4.9 => EOF ON .IOT +IFSTS: 0 ;.STATUS WORD STORED BY OPNRD1 WHEN .OPEN LOSES + + ;FILE DESCRIPTION STORAGE + +INDDP: MAXIND,,FDSOFS ;POINTER INTO TABLE +FDSBEG==. ;BEGINNING OF TABLE AREA +DNAM: 0 ;DEVICE NAME +FNAM1: 0 ;FILE NAME 1 +FNAM2: 0 ;" " 2 +SNAM: 0 ;SYSTEM NAME +LFDSE==.-FDSBEG ;LENGTH OF TABLE ENTRY +IFDS: BLOCK LFDSE ;SPECIFIED INPUT FILE + 0 ;FOR .FDELE AT .FILE TIME +ONAM: BLOCK 3 ;OUTPUT DEVICE/FILENAMES SPECIFIED +OSYSNM: -1 ;SPECIFIED OUTPUT SYSTEM NAME +IFN CREFSW,[ 0 +CRFDEV: BLOCK 3 ;CREF DEV, FN1, FN2. +CRFSNM: 0 ;CREF SNAME. +] +ERRDEV: BLOCK 4 ;FILENAMES OF FILE BEING READ NOW. +ERRTPF: 0 ;SET => NEXT ERROR MESSAGE SHOULD TYPE THEM. +FDSOFS==.-FDSBEG ;OFFSET TO BEGINNING OF NON-DEDICATED AREA + BLOCK LFDSE*MAXIND ;OPEN NAMES @: FILES (AND FNF'S) +SFSFDS=.-FDSOFS ;SOURCE SPECIFIED NAMES @: FILES + BLOCK LFDSE*MAXIND ;STORAGE FOR " + +RFNAM1: 0 ;.FNAM1 +RFNAM2: 0 +IFNM1: 0 ;.IFNM1 +IFNM2: 0 +RSYSNM: -1 ;INITIAL SYSTEM NAME + + ;.RCHST BLOCK + +RCHSTB: BLOCK 4 ;DNAM, FN1, FN2, SNAM +ACCP: 0 ;.ACCESS POINTER + BLOCK 4 ;ROOM FOR FURTHER EXPANSION OF .RCHST + + ;TTY VARIABLES + +CMBUF: BLOCK CMBFL ;TYPEIN BUFFER +CMPTR: 440700,,CMBUF ;BYTE POINTER TO CMBUF, CLEARED AT GO2 IF >0. + + ;OPNER VARIABLES + +ERRDNM: (SIXBIT /ERR/) + 3 +ERRNM2: 0 ;.STATUS WORD + + ;OUTPUT VARIABLES + +UTOBUF: BLOCK 200 ;OUTPUT BUFFER +UTOBE: +UTYOP: 0 ;OUTPUT (36. BIT) BYTE POINTER +UTYOCT: 0 ; - # WORDS LEFT IN UTOBUF + +IFN RUNTSW,RUNTSX: 0 ;NON-ZERO TO TYPE OUT RUN TIME AT END OF ASSEMBLY + +IFN CREFSW,[ ;CREF OUTPUT VARS. +CRFBUF: BLOCK CRFBSZ +CRFCNT: 0 ;NUM. CHARS. EMPTY IN BUFFER +CRFPTR: 0 ;BP IN BUFFER +] +PBLK + + ;.INSRT FILEDESCRIPTION + ;INSERT FILE HERE + ;TTY: => OK, READS LINE AT A TIME, RUBOUT ALLOWED WITHIN LINE + ;PUSHES MACRO EXPANSION, OTHER .INSRT'S + ;IN FILEDESCRIPTION, ^R => RESET FILE NAME COUNTER + +A.INSR: MOVEI F,IFDS-DNAM ;SET UP POINTER TO INPUT FILE NAMES + PUSHJ P,A.IMAP ;DEFAULT NAMES = INPUT NAMES + MOVSI A,(SIXBIT /DSK/) + MOVS B,DNAM + CAIN B,(SIXBIT /TTY/) ;IF INPUTTING FROM TTY, + MOVEM A,DNAM ;THEN SET DEFAULT DEVICE TO DSK INSTEAD +A.IN1: PUSHJ P,RFD ;READ FILE DESCRIPTION + MOVS A,DNAM ;GET SPECIFIED DEVICE NAME + CAIE A,(SIXBIT /@/) ;ATSIGN? + PUSHJ P,A.ITRY ;NO, TRY OPENING FILE + MOVE A,DNAM(F) + AOJE A,A.INT1 ;ALREADY TRYING TO SET UP TABLE ENTRY + SKIPA F,[MAXIND,,FDSOFS] ;ATSIGN, OR FNF, SEARCH TABLE +A.IN2: SUBI F,-LFDSE ;LOOP POINT SEARCHING TABLE, INCREMENT TO NEXT ENTRY, COUNT DOWN LH + CAMN F,INDDP ;COMPARE WITH POINTER TO TOP OF TABLE + JRST A.IN3 ;AGREE => THIS FILE NOT IN TABLE + MOVE A,F ;-> SFSFDS + MOVSI B,-LFDSE ;-> DNAM, LH FOR COUNT + MOVE T,SFSFDS(A) ;GET SPECIFICATION NAME THIS ENTRY + CAMN T,DNAM(B) ;COMPARE WITH THAT JUST SPECIFIED + AOBJN B,[AOJA A,.-2] ;CHECK ALL NAMES THIS ENTRY + JUMPL B,A.IN2 ;LOOP IF NAMES DON'T ALL AGREE + ;FILE IS IN TABLE + PUSHJ P,A.IMAP ;SET NEW FILE DESCRIPTION FROM THAT IN TABLE ENTRY + PUSHJ P,A.ITRY ;TRY OPENING FILE + MOVSI A,SFSFDS(F) ;SET UP LH(BLT POINTER), + PUSHJ P,A.IMP1 ;UNMAP TO ORIGINAL NAMES + PUSHJ P,TYPFIL ;TYPE OUT SPECIFIED NAMES + TYPR [ASCIZ / -> /] ;TYPE OUT POINTER + PUSHJ P,A.IMAP ;RE-MAP INTO TRANSLATION ENTRY IN TABLE + SETOM DNAM(F) ;"HALF-KILL" ENTRY +A.INT1: PUSHJ P,IOPNR1 ;TYPE OUT ALL KINDS OF STUFF +A.INT2: PUSHJ P,GTYIP ;PREPARE TO READ ONE LINE FROM TTY + JRST A.IN1 ;TRY AGAIN WITH WHAT HE TYPES IN + + ;FILE NOT IN TABLE + +A.IN3: TLNN F,-1 ;MORE ROOM FOR ANOTHER ENTRY IN TABLE? + ERF (SIXBIT/TM@/) ;NO + MOVEI A,SFSFDS(F) + HRLI A,DNAM + BLT A,SFSFDS+LFDSE-1(F) ;SET UP KEY OF NEW ENTRY + SETOM DNAM(F) ;DOCUMENT FACT THAT ENTRY HAS ONLY KEY, NOT TRANSLATION + MOVNI A,-LFDSE + ADDM A,INDDP ;UPDATE POINTER INTO TABLE + MOVS A,DNAM ;GET SPECIFIED DEVICE NAME + CAIE A,(SIXBIT /@/) ;ATSIGN? + JRST A.INT1 ;NO, TYPE OUT GARBAGE AND TRY AGAIN, READING FROM TTY + MOVE A,IFDS ;YES, CLOBBER FROM INPUT DEVICE NAME + MOVEM A,DNAM + JRST A.INT2 + + ;TRY OPENING INPUT FILE FOR .INSRT, RETURN IF UNSUCCESSFUL + +A.ITRY: MOVS A,DNAM ;GET SPECIFIED DEVICE NAME + CAIN A,(SIXBIT /TTY/) ;TTY? + JRST A.ITRT ;YES, TREAT SPECIAL + PUSHJ P,IPUSH ;SAVE CURRENT STATUS + PUSHJ P,OPNRD1 ;TRY OPENING FILE + JRST IPOPL ;LOSE, POP AND RETURN + MOVE B,ITTYP + MOVEI A,-1-TYPDEL(B) + HRLI A,IFNM1 + BLT A,(B) ;INTRODUCE HYSTERESIS SO .INSRT'ING FILE CAN REFERENCE .IFNM1, .IFNM2 +IFN CREFSW,[ + SKIPE CRFONP ;IF CREFFING, OUTPUT PUSH-FILE BLOCK. + PUSHJ P,CRFPSH ;(POP-FILE BLOCK OUTPUT AT POPTT) +] +A.ITR2: + MOVE A,DNAM(F) ;PUSH SUCCESSFUL, NOW CHECK TO SEE IF TABLE ENTRY SHOULD BE FINISHED + AOJN A,ASSEM1 + PUSHJ P,A.OMAP ;YES, DO IT + JRST ASSEM1 ;NOW ASSEMBLE FROM FILE (ASSEM1 CLOBBERS PDL) + + ;.INSRT TTY: + +A.ITRT: PUSHJ P,GTYIPA ;READ FROM TTY, DON'T QUIT UNTIL .INEOF + JRST A.ITR2 ;FALL BACK IN (DOESN'T TOUCH .IFNM1, .IFNM2) + + ;.INEOF ;EOF PSEUDO (MAINLY USEFUL FROM TTY) + +A.IEF2: PUSHJ P,PMACP ;LOOP POINT, POP ENTRY OFF MACRO PDL +A.INEO: TLNE FF,MACRCH ;INPUTTING FROM MACRO? + JRST A.IEF2 ;YES, POP IT OFF + PUSH P,CMACCR ;BACK TO INPUTTING FROM FILE OR TTY, CAUSE RETURN TO MACCR + MOVE B,ITTYP ;GET PDL POINTER + POPJ B, ;RETURN TO POP ROUTINE + +ERRTFL: AOSE ERRTPF ;TYPE FILNAMES IF CHANGED SINCE LAST CALLED HERE. + POPJ P, + MOVE C,[-4,,ERRDEV-DNAM] + PUSHJ P,TYPF1 + JRST CRR + + ;MISC .INSRT + +A.IMAP: MOVSI A,DNAM(F) ;CLOBBER DNAM ETC. FROM TABLE TRANSLATION ENTRY POINTED TO BY F +A.IMP1: HRRI A,DNAM ;ENTRY FOR LH(BLT POINTER) ALREADY SET UP + BLT A,DNAM+LFDSE-1 ;DO IT + POPJ P, + +A.OMAP: MOVEI A,DNAM(F) ;CLOBBER TRANSLATION OF TABLE ENTRY POINTED TO BY F FROM DNAM ETC. + HRLI A,DNAM + BLT A,DNAM+LFDSE-1(F) + POPJ P, + + ;MISC TS + +IOPNR1: PUSHJ P,IOPNER ;TYPE OUT CRUFT + MOVEI A,"_ ;EXPECTATION CHARACTER + JRST TYO ;TYPE OUT _ TO TELL USER MIDAS WANTS TYPEIN + + ;TYPE OUT DNAM ETC. AS FILE SPECIFICATION + +TYPFIL: MOVSI C,-4 +TYPF1: MOVE B,DNAM(C) ;GET NEXT NAME + PUSHJ P,SIXTYO ;TYPE OUT NAME + HLRZ A,C + MOVE A,FILSPC+4(A) ;NOW GET DELIMITING CHARACTER + PUSHJ P,TYO ;TYPE OUT + AOBJN C,TYPF1 ;LOOP FOR ALL NAMES + POPJ P, + +FILSPC: ": + 40 ;SPACE + 40 + "; + + ;OPENLOSS DOCUMENTATION ROUTINE + +IOPNER: MOVE A,IFSTS ;INPUT +OPNER: MOVEM A,ERRNM2 ;SAVE .STATUS WORD + PUSHJ P,TYPFIL ;TYPE OUT FILE DESCRIPTION + PUSHJ P,CRR ;NOW CRLF TO ENSURE ROOM FOR FOLLOWING +IFN DECSW,[ + TYPR [ASCIZ/OPEN FAILED/] + JRST CRR +] +IFE DECSW,[ + .OPEN ERRC,ERRDNM ;NOW GET THE SYSTEM TO SAY WHAT'S WRONG + .VALUE ;CAN'T OPEN ERR DEVICE? +IOPNR2: .IOT ERRC,A ;GET CHARACTER FROM SYSTEM + CAIN A,14 ;ENDS WITH FORM FEED + POPJ P, + PUSHJ P,TYO ;TYPE OUT CHARACTER + JRST IOPNR2 ;LOOP BACK FOR NEXT +] ;END IFE DECSW, + + ;READ SINGLE FILE DESCRIPTION + +RFD: TRO I,FFFLG ;SET FLAG KEEPING TRACK OF FILENAME COUNT +RFD1: MOVEI C,0 ;INITIALIZE WORD + MOVE B,[440600,,C] ;SET UP BP FOR INPUT +RFD2: PUSHJ P,RCH ;GET CHARACTER IN A + CAIN A,": ;IF COLON... + JRST RFDCOL ;THEN PROCESS AS SUCH + CAIN A,"; ;SIMILARLY FOR SEMICOLON + JRST RFDSEM + CAIN A,^Q ;IF CONTROL Q... + JRST RFDCQ ;THEN GET NEXT CHARACTER AND TREAT AS NON-SYNTACTICAL + CAILE A,40 ;LOGICAL SPACE? (INCLUDING CR) + JRST RFDC ;NO +RFD6: JUMPE C,RFD5 ;IGNORE NULL FILENAMES + EXCH C,FNAM2 + TRZN I,FFFLG + MOVEM C,FNAM1 ;MOVE SECOND TO FIRST +RFD5: IFN DECSW,[CAIN A,"[ ;] READ PPN FOR DEC SYS. + JRST RFD7] + CAIN A,^R ;CONTROL R, + JRST RFD ;RESETS FILENAME COUNT + CAIE A,15 ;WAS LAST CHAR CR? + JRST RFD1 ;NO, GO BACK FOR NEXT NAME + POPJ P, ;DONE + +RFDCOL: JUMPE C,RFD1 ;IF HE WANTS THE NULL DEVICE HE GETS TO TYPE IT IN + MOVEM C,DNAM ;MOVE TO RH OF DEVICE LOCATION + JRST RFD1 ;LOOP + +IFN DECSW,RFD7: PUSHJ P,RFDPPN ;READ PPN, USE AS "SNAME". +RFDSEM: JUMPE C,RFD1 ;NO NULL SYSTEM NAMES PLEASE + MOVEM C,SNAM ;MOVE TO SYSTEM NAME LOCATION + JRST RFD1 ;LOOP + +RFDCQ: PUSHJ P,RCH ;CONTROL Q EATS UP THE NEXT CHARACTER + CAIN A,15 + JRST RFD6 ;BUT NOT IF CR +RFDC: CAIL A,140 ;CONVERT LOWER CASE TO UPPER. + SUBI A,40 + SUBI A,40 ;CONVERT CHARACTER TO SIXBIT + TLNE B,770000 ;TOO MANY CHARACTERS? + IDPB A,B ;NO + JRST RFD2 ;LOOP + +IFN DECSW,[ +RFDPPN: PUSHJ P,RFDOCT ;READ PROJECT NUM, + HRLM C,(P) + PUSHJ P,RFDOCT ;READ PROGRAMMER NUM. + HLL C,(P) + POPJ P, + +RFDOCT: SETZ C, ;READ OCTAL NUM, RETURN IN C. +RFDOC1: PUSHJ P,RCH + CAIL A,"0 + CAIL A,"8 + POPJ P, ;NOT OCTAL, RETURN. + IMULI C,10 + ADDI C,-"0(A) + JRST RFDOC1 +] + + ;GET COMMAND + +;FLAGS (IN F) (LH => INPUT, RH => OUTPUT) +;OTHER AC'S: C HAS COMPLETE NAME, D NAME BEING BUILT UP, TT BYTE POINTER TO C + +SIF==400000 +COLF==200000 +NAMF==100000 +NAM2F==40000 +DEVF==20000 +SCOLF==10000 +SYSNF==4000 + +CMD: PUSHJ P,CRR + MOVEI F,0 +CMDB: MOVEI D,0 ;CLEAR OUT NAME + MOVE TT,[10600,,D-1] +CMDL: PUSHJ P,RCHA ;READ CHARACTER FROM TTY + CAIN A,": + JRST CMDCOL + CAIN A,"; + JRST CMDSC + CAIN A,"_ + JRST CMDLA +IFN DECSW,[CAIN A,"[ ;] FOR DEC SYS, CAN SPEC PPN. + JRST CMDPPN + CAIE A,".] ;PERIOD SAME AS SPACE FOR DEC SYS. + CAIG A,40 + JRST CMDS + CAIN A,"( + JRST CMDSW + CAIN A,^Q ;^Q => READ ANOTHER CHAR, USE IT INSTEAD. + PUSHJ P,RCHA + CAIN A,^M ;CR ENDS COMMAND. + JRST CMDE +CMDL1: CAIL A,140 ;HANDLE LOWER CASE. + SUBI A,40 + SUBI A,40 + PUSHJ P,SYLEND + TLNE TT,770000 + IDPB A,TT + JRST CMDL + +IFN DECSW,[ +CMDPPN: PUSHJ P,SYLE1 ;END PREVIOUS NAME. + PUSHJ P,RFDPPN ;READ THE PPN. + TLO F,SCOLF+SIF + JRST CMDB ;USE AS SNAME. +] +CMDSC: TLOA F,SCOLF +CMDCOL: TLO F,COLF +CMDS: CAMN TT,[10600,,D-1] + JRST CMDL + TLO F,SIF + MOVE C,D + JRST CMDB + +SYLEND: TLZN F,SIF + POPJ P, +SYLE2: TLZE F,COLF + JRST SYLDV + TLZE F,SCOLF + JRST SYLSN + TLOE F,NAMF + JRST NAM2 + MOVEM C,FNAM1 + POPJ P, +NAM2: TLON F,NAM2F ;NAMES AFTER SECOND GET IGNORED + MOVEM C,FNAM2 + POPJ P, + +SYLSN: TLO F,SYSNF + MOVEM C,SNAM + POPJ P, +SYLDV: TLO F,DEVF + LDB T,[360600,,C] + CAIG T,'9 + CAIGE T,'0 + JRST SYLDV1 + TLNN C,7777 + MOVSI C,(SIXBIT /UT/+T) +SYLDV1: MOVEM C,DNAM + POPJ P, + +CMDLA: PUSHJ P,SYLE1 + HLRZS F + MOVE T,[DNAM,,ONAM] + BLT T,ONAM+3 + JRST CMDB + +SYLE1: CAMN TT,[10600,,D-1] + JRST SYLEND + MOVE C,D + JRST SYLE2 + +CMDSW: PUSHJ P,RCHA + CAIL A,140 ;LOWER CASE TO UPPER. + SUBI A,40 + CAIN A,") + JRST CMDL + CAIN A,"T + SOS TTYINS ;COUNT # T-SWITCHES. +IFN LISTSW,[CAIN A,"L + JRST CMDLST +] +IFN RUNTSW,[CAIN A,"R + SETOM RUNTSX +] +IFN CREFSW,[CAIN A,"C + SETOM CREFP +] JRST CMDSW + IFN CREFSW,[ +;OUTPUT WHATEVER IS IN CREF BUFFER. +CRFEND: SKIPGE CRFCNT + JRST CRFEN3 ;NOT INITTED, DON'T WRITE IT. + MOVE A,CRFPTR + HRLZI A,1-CRFBUF(A) + EQVI A,-1-CRFBUF ;AOBJN -> FILLED PART OF BUFFER. + .IOT CREFC,A +CRFEN3: SETOM CRFCNT ;SAY BUFFER NOT INITTED (WILL INIT ON OUTPUT) + POPJ P, + +CRFOUT: SOSGE CRFCNT + JRST CRFOU1 ;NO ROOM, OUTPUT AND INIT BUFFER. + IDPB A,CRFPTR + POPJ P, + +CRFOU1: PUSH P,A + AOSGE CRFCNT ;IF HAD BEEN -1, WASN'T INITTED, + JRST CRFOU2 ;DON'T EMPTY, JUST INIT. + MOVE A,[-CRFBSZ,,CRFBUF] + .IOT CREFC,A +CRFOU2: MOVE A,[444400,,CRFBUF] + MOVEM A,CRFPTR + MOVEI A,CRFBSZ + MOVEM A,CRFCNT ;SET UP PTR, CNT SAYING BUFFER EMPTY. + POP P,A + JRST CRFOUT + +CRFSSF: SKIPA A,[1] ;OUTPUT SET-SOURCE-FILE BLOCK. +CRFPSH: MOVEI A,3 ;OUTPUT PUSH-SOURCE-FILE BLOCK. + PUSHJ P,CRFOUT + HRLZ A,RCHSTB ;AFTER HEADER COME DEV, FN1, FN2, SNAM + PUSHJ P,CRFOUT + MOVE A,IFNM1 ;ALL LEFT-JUSTIFIED SIXBIT WDS. + PUSHJ P,CRFOUT + MOVE A,IFNM2 + PUSHJ P,CRFOUT + MOVE A,RCHSTB+3 + JRST CRFOUT +] + +IFN LISTSW,[ + + ;PRINTING ROUTINES + + ;L SWITCH TYPED IN DURING COMMAND, SET UP FOR LISTING + +CMDLST: SETOM LISTON + PUSHJ P,MDSSET ;SET UP INSTRUCTIONS TO GO TO RCH +CMDSW1: .OPEN LPTC,[SIXBIT / !LPTWALL PAPER /] + SKIPA A,[30.] + JRST CMDSW + .SLEEP A, + JRST CMDSW1 + + ;PRINT CHARACTER IN A + +PILPT: .IOT LPTC,A + POPJ P, + + ;DONE PRINTING + +LPTCLS: SKIPL LISTON + POPJ P, ;WASN'T PRINTING TO BEGIN WITH + SETZM LISTON ;CLEAR OUT FLAG + MOVEI A,15 ;NOW TO END WITH FOR FEED + PUSHJ P,PILPT + MOVEI A,14 + PUSHJ P,PILPT + .CLOSE LPTC, ;RELEASE PRINTER + POPJ P, +] + + ;CARRIAGE RETURN TYPED + +CMDE: PUSHJ P,SYLE1 + TLNN F,NAMF\DEVF + JRST CMDB ;JUST RANDOM CR, TRY AGAIN + ;NOW FILL IN MISSING NAMES + ;DEVICE + MOVSI T,(SIXBIT /DSK/) + TLNE F,DEVF + SKIPA T,DNAM + MOVEM T,DNAM ;DEFAULT INPUT DEVICE IS DSK + CAMN T,[SIXBIT /TTY/] ;DEFAULT OUTPUT DEVICE IS INPUT DEVICE UNLESS INPUT DEVICE IS TTY, + MOVSI T,(SIXBIT /NUL/) ;IN WHICH CASE DEFAULT OUTPUT DEVICE IS NUL + TRNE F,NAMF\NAM2F\SYSNF ;UNLESS SOME OUTPUT NAME WAS GIVEN. + MOVSI T,'DSK + TRNN F,DEVF ;OUTPUT DEVICE SPECIFIED? + MOVEM T,ONAM ;NO, STORE DEFAULT OUTPUT DEVICE + ;SYSTEM NAME + MOVE T,RSYSNM + TLNN F,SYSNF + MOVEM T,SNAM ;DEFAULT INPUT SYSTEM NAME IS INITIAL SYSTEM NAME + TRNN F,SYSNF + MOVEM T,OSYSNM ;DEFAULT OUTPUT SYSTEM NAME IS ALSO INITIAL SYSTEM NAME + ;INPUT FILE NAMES + MOVE T,[SIXBIT /PROG/] + TLNN F,NAMF ;IF NO INPUT FILE NAMES TYPED, + MOVEM T,FNAM1 ;THEN FIRST INPUT FILE NAME IS "PROG" + MOVSI T,(SIXBIT />/) + TLNN F,NAM2F ;IF FEWER THAN TWO INPUT NAMES TYPED, + MOVEM T,FNAM2 ;THEN INPUT SECOND FILE NAME IS ">" + ;OUTPUT FILE NAMES + TRNE F,NAM2F + JRST CMDE1 ;BOTH OUTPUT FILE NAMES TYPED, RETURN + MOVE T,FNAM1 ;NOT BOTH, + EXCH T,ONAM+1 ;SET FIRST OUTPUT NAME FROM FIRST INPUT NAME + TRNN F,NAMF ;IF ONE OUTPUT NAME TYPED THEN IT IS THE SECOND + MOVEI T,0 ;AT FILE TIME TO BE CHANGED EITHER TO "BIN" OR "REL" + MOVEM T,ONAM+2 +CMDE1: +IFN CREFSW,[ ;SET CREF FILE NAMES. + MOVE T,[ONAM,,CRFDEV] + BLT T,CRFSNM ;FN1, SNAME SAME AS OUTPUT FILE'S, + SETZM CRFDEV+2 ;FN2 WILL DEFAULT TO CREF. + MOVSI T,(SIXBIT/DSK/) + MOVEM T,CRFDEV +] POPJ P, + + ;ALLOCATE FRESH BLOCK OF CORE CONTAINING ADR IN A + ;AA SHOULD HAVE POINTER TO ASCII STRING W/ NAME OF TABLE + ;BEING ALLOCATED FOR + ;CLOBBERS B, + +CORRQB: .VALUE ;LOOP POINT FOR DON'T PROCEED + TLZ AA,400000 +CORRQA: POP P,D + POP P,C + SKIPA A,(P) ;RESTORE A FROM PDL +CORRQ: PUSH P,A ;ENTRY, SAVE A IN CASE HAVE TO TRY AGAIN +IFE DECSW,[ + HRLI A,10001 ;(CODE FOR FRESH PAGE, _1) + LSH A,-1 + .CBLK A, ;TRY GETTING BLOCK +] +IFN DECSW,[ + ADDI A,2000 + CORE A, +] + JRST CORRQL ;LOSE + JRST POPAJ ;WIN + +CORRQL: PUSH P,C + PUSH P,D + TLOE AA,400000 + JRST CORQL1 + TYPR [ASCIZ / +NO CORE FOR /] + TYPR (AA) ;TYPE TABLE NAME +CORQL1: TYPR [ASCIZ / +TRY AGAIN? /] +CORQL2: PUSHJ P,TYI ;GET CHAR + CAIN A,"Y ;Y, + JRST CORRQA ;=> TRY AGAIN + CAIN A,"N ;N, + JRST CORRQB ;=> BACK TO DDT THEN TRY AGAIN + CAIN A,"? ;?, + 3000,,CORQL1 ;=> TYPE OUT ERROR-TYPE BLURB + TYPR [ASCIZ /? /] ;SOMETHING ELSE + JRST CORQL2 + +] ;END TS CONDITIONAL + +FEED1: SKIPA B,[40] +FEED: MOVEI B,5 + JRST TFEED" +PPB: JUMPGE FF,CPOPJ +PPBA: JRST TPPB" + +VBLK + +IFN PURESW&TS,[ ;PURIFICATION ROUTINE + +PURIFY: JRST PURIF1 ;OR .VALUE MESSAGE + +PURIFG: -1 ;-1 IF NOT (YET) PURIFIED +] + VARIAB +VPAT": +VPATCH": BLOCK 20 +VPATCE"=.-1 + +PBLK + +CONSTANTS + +PAT": +PATCH": BLOCK 100 +IFE PURESW,PATCHE"=.-1 + +IFN PURESW,[LOC <.+1777>&-2000 ;SKIP TO NEXT PAGE + MAXPUR==./2000 ;FIRST PAGE ABOVE PURE PAGES +PRINTA PURE PAGES = ,\MAXPUR-MINPUR +] + +VBLK +PDL": BLOCK LPDL+1 +.NSTGW +BBKCOD==. ;BEGIN BLANK CODING, CLEARED OUT DURING INITIALIZATION +IFN PURESW,MINBNK==<.+1777>/2000 ;FIRST PAGE OF BLANK CODE +BNKBLK ;DUMP OUT ACCUMULATED BLANK CODING + + ;NOW MORE BLANK CODING + +BKBUF: BLOCK BSIZE+5 ;CURRENT BLOCK TO OUTPUT +GLOTB: BLOCK 20 ;GLOBAL TABLE, EACH ENTRY FLAGS,,ADR OF SQUOZE (SEE COMMENTS NEAR BEGINNING) +STRSTO: BLOCK STRL ;STRING STORAGE FOR GSYL AND FRIENDS + +EBKCOD==. ;END BLANK CODING +.YSTGW + +PRINTA ST = ,\. + +ST: ;SYMBOL TABLE 3 WORDS/SYM FIRST SQUOZE, SECOND "VALUE", 3RD FLAGS,,BLOCK. +IFN TS,IFNDEF SYMMAX,SYMMAX==40000 ;MAX. # SYMS IN SYMTAB. +IFG MOBY-TS, IFNDEF SYMMAX, SYMMAX==40000 +IFE MOBY&TS,IFNDEF SYMMAX,SYMMAX==<<16.*2000>-ST-1-MACL>/WPS +IFE TS,SYMDSZ==SYMMAX ;WHY TRY TO SAVE CORE IF NOT TS? + + BLOCK WPS*SYMDSZ + +;;INIT ;INITIALIZATION ROUTINES (IN MACRO TABLE, GET WIPED OUT) +MINMAC==./2000 ;# OF 1ST PAGE HOLDING PART OF MACTAB. +;NOTE THAT THIS CODE IS COPIED UPWARD WHEN MACTAB IS MOVED +;DUE TO SYMTAB EXPANSION. THEREFOR IT MUST REFER TO ITSELF +;INDEXED BY THE OFFSET OF WHERE IT IS FROM WHERE IT WAS ASSEMBLED. +;THAT IS KEPT IN CH1. ALL LITERALS MUST BE USED INDEX OF CH1, TOO. + +;MAC PROC TABLES +MACTBA: 773767750000 ;MACRO CHARACTER STORAGE (FIRST WORD 3 375'S) +INIT1: MOVE CH1,MACTAD ;GET ADDR THIS COODE REALLY STARTS AT. + SUBI CH1,MACTBA ;GET OFFSET FROM WHERE ASSEMBLED. + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1](CH1) + BLT A,EBKCOD-1 ;CLEAR OUT BLANK CODING + PUSH P,[SP4](CH1) ;NOW INIT THE SYMTAB & FINISHED. + +;INITIALIZE THE SYMTAB, EXPECT SIZE IN SYMLEN. +INITS: MOVE AA,SYMLEN ;SET UP THE OTHER VARS + IMULI AA,WPS ;DEALING WITH SYMTAB SIZE. + MOVEM AA,SYMSIZ + ADDI AA,ST ;ADDR OF START OF MACTAB. + CAMG AA,MACTAD ;MOVED MACTAB UP? + JRST INITS1(CH1) +IFN TS-DECSW,[ ;YES, GET CORE FOR INCREASE. + MOVEI AA,MACL+1777(AA) + LSH AA,-10. ;1ST PAGE NOT NEEDED BY MACTAB. + MOVEI A,MACL+1777+MACTBA(CH1) + LSH A,-10. ;1ST PAGE MACTAB DOESN'T YET HAVE. + SUBM A,AA ;# PAGES NEEDED. + HRLZI AA,(AA) + HRRI AA,(A) ;-<# PAGES>,,<1ST NEEDED> + JUMPGE AA,.+3(CH1) ;DON'T CALL IF NEED 0 PAGES, WOULD GET ONE. + .CALL INITSB(CH1) + .VALUE + MOVE AA,SYMSIZ ;LEAVE IN AA WHAT WE FOUND. + ADDI AA,ST +] +IFN DECSW,[ + MOVEI AA,MACL+1777(AA) + ANDI AA,-2000 + CORE AA, + HALT + MOVE AA,SYMSIZ + ADDI AA,ST +] + SUBM AA,MACTAD ;MACTAD _ SHIFT IN START OF MACTAB. + EXCH AA,MACTAD ;MACTAD GETS NEW START, AA HAS SHIFT. + MOVSI A,PTAB-CCOMPB + ADDM AA,PTAB(A) ;RELOCATE BYTE-PTRS INTO MACTAB. + AOBJN A,.-1(CH1) + LSH AA,2 ;RELOCATE PTRS TO 4*MACTBA. + MOVSI A,CCOMPB-CCOMPE + ADDM AA,CCOMPB(A) + AOBJN A,.-1(CH1) + LSH AA,-2 ;AA AGAIN HAS SHIFT IN MACTAB. + MOVNI B,INITS2(CH1) + HRROI A,@EISYMP(CH1) + ADDI B,1(A) ;GET # WDS IN SECOND HALF OF INIT CODE. + HRRM AA,.+1(CH1) ;COPY 2ND HALF UPWARD WITH POP-LOOP. + POP A,(A) ;THIS INSN IMPURE. + SOJG B,.-1(CH1) + ADDI CH1,(AA) ;CHANGE OFFSET TO PT. TO NEW LOCATIONN OF INIT CODE. + JRST INITS2(CH1) ;JUMP INTO 2ND HALF, WHERE IT'S BEEN COPIED TO. +INITS2: HRROI A,INITS2-1(CH1) ;THEN COPY 1ST HALF (WHICH ENNDS BEFORE INITS2) + SUBI A,(AA) ;GET WHERE NOW ENDS, NOT WHERE WILL END. + MOVEI B,INITS2-MACTBA ;UP UNDERNEATH THE 2ND HALF. + HRRM AA,.+1(CH1) ;(THIS TWO-STEP COPYING HANDLES ALL OVERLAPS) + POP A,(A) + SOJG B,.-1(CH1) +INITS1: MOVE AA,SYMSIZ + MOVN A,SYMLEN + HRLZM A,SYMAOB ;AOBJN -> SYMTAB. + SETZM ST + MOVE A,[ST,,ST+1](CH1) + BLT A,ST-1(AA) ;CLEAR OUT SYMBOL TABLE + SETZM BKCUR ;DEFINE THEM IN OUTER BLOCK. + MOVEI AA,ISYMTB(CH1) + MOVS F,ISMTBB(CH1) ;GET SWAPPED VALUE OF FIRST INSTRUCTION +SP3: CAIL AA,EISYM1(CH1) + JRST SP1(CH1) ;DONE WITH INSTRUCTIONS + MOVE SYM,(AA) + JUMPE SYM,SP2(CH1) + TLZ SYM,740000 + PUSHJ P,ES ;WON'T SKIP + HRLZI T,SYMC + HRLZ B,F + MOVSI C,3INI + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP2: ADDI F,1000 + AOJA AA,SP3(CH1) +EISYMP": ;MAY BE MUNGED +SP1: CAIL AA,EISYMT(CH1) + POPJ P, + MOVE SYM,(AA) + LDB T,[400400,,SYM](CH1) + ROT T,-4 + TLZ SYM,740000 + PUSHJ P,ES + MOVE B,1(AA) + MOVSI C,3INI + CAME T,[GLOETY,,](CH1) ;GLOBAL ENTRIES REALLY EXITS, HACKED TO DEFEAT ADDRESS LINKING + CAMN T,[GLOEXT,,](CH1) + TLO C,3LLV + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 + AOS AA + AOJA AA,SP1(CH1) + +IFN TS-DECSW,[ +INITSB: SETZ ? 'CORBLK + 1000,,600000 ;BOTH READ AND WRITE. + 1000,,-1 ? AA ;INTO SELF, AA IS AOBJN -> PAGES. + SETZI 400001 ;FRESH PAGES. + + ;GOBBLE SYMS FROM SYSTEM + ;TABLE AREA IN SYSTEM: + ;FIRST LOC SYSYMB + ;LAST (AS OPPOSED TO LAST + 1) SYSYME + +TSYMGT: MOVE AA,[MXICLR-MXIMAC,,MXICLR] + .CALL INITSB ;GET MACTAB PAGES NNOT LOADED INTO. + .VALUE +IFN PURESW,[ + MOVE AA,[MINBNK-MINMAC,,MINBNK] + .CALL INITSB ;GET PAGES FOR BLANK CODE & SYMTAB. + .VALUE + SKIPN PURIFG + JRST TSYMG3 + JSP F,PURIFD ;NOT PURIFIED => FLUSH PAGES + MINPUR-MXIMAC ;OF MACTAB CREATED BY LOADING BUT NOT NEEDED. + MXIMAC*1001 +TSYMG3: +] + MOVEI A,EISYMT ;EISYMT FIRST LOC FOR ITS SYMS + MOVE B,[SIXBIT /CALLS/] ;SYSTEM CALLS + .GETSYS A, ;READ IN SYSTEM CALLS (SHOULD SKIP) + .VALUE + SKIPGE A + .VALUE ;.GETSYS DIDN'T UPDATE AOBJN POINTER + HRRM A,SP1 ;MARK END OF SYMS + MOVEI B,EISYMT + MOVEI AA,SYMC_<-18.+4> ;SQUOZE FLAG FOR SYM +TSYMG2: DPB AA,[400400,,(B)] + ADDI B,2 + CAIE B,(A) + JRST TSYMG2 + POPJ P, + +IFN PURESW,[ ;HERE ARE THE GUTS OF THE PURIFY ROUTINE + +PURIF1: MOVEI P,17 ;START PDL AT 20 + JSP F,PURIFD ;CALL .CBLK ROUTINE + MINMAC-MINBNK ;FLUSH BLANK CODE PAGES (INCL. SYM TAB) + MINBNK*1001 + MINPUR-MXICLR ;FLUSH MACTAB PAGES CREATED BY LOAD BUT NOT NNEEDED. + MXICLR*1001 + MAXPUR-MINPUR ;PURIFY PURE PAGES. + 400000+MINPUR*1001 + SETZM PURIFG ;SET "PURIFIED" FLAG + MOVE [1,,2] ;NOW CLEAR OUT REMAINS OF DATA OF SELF + MOVEI 1,0 + BLT 40 + .VALUE [ASCIZ /:PURIFIEDî/] + + ;JSP F,PURIFD ;DO A SEQUENCE OF .CBLKS + ;FOLLOW WITH AN ARBITRARY NUMBER OF PAIRS OF ARGUMENTS + ;FIRST ARG OF PAIR # PAGES TO PROCESS, MAY BE ZERO + ;SECOND INITIAL .CBLK AC CONTENTS + +PURIFD: MOVE C,(F) ;GET COUNT + TLNE C,777000 ;CHECK INSTRUCTION PART + JRST (F) ;INSTRUCTION => RETURN TO IT + JUMPE C,PURID2 ;JUMP IF NO PAGES IN COUNT + MOVE A,1(F) ;GET INITIAL .CBLK ARG +PURID1: .CBLK A, + .VALUE + ADDI A,1001 ;INCREMENT .CBLK ARG TO NEXT PAGE + SOJG C,PURID1 ;DO IT THE APPROPRIATE NUMBER OF TIMES +PURID2: ADDI F,2 + JRST PURIFD + +] ;END PURESW CONDITIONAL +] ;END TS CONDITIONAL + +CONSTANTS + +;;ISYMS ;INITIAL SYMBOL TABLE + +UFA=FSC-(2000) ;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE + +ISMTBB: UFA ;FIRST OP. CODE IN ISYMTB + +ISYMTB: + +SQUOZE 10,UFA ;PDP10 INSTRUCTION +SQUOZE 10,DFN ;PDP10 INSTRUCTION +SQUOZE 10,FSC +SQUOZE 10,IBP +SQUOZE 10,ILDB +SQUOZE 10,LDB +SQUOZE 10,IDPB +SQUOZE 10,DPB +SQUOZE 10,FAD +SQUOZE 10,FADL +SQUOZE 10,FADM +SQUOZE 10,FADB +SQUOZE 10,FADR +SQUOZE 10,FADRL +SQUOZE 10,FADRM +SQUOZE 10,FADRB +SQUOZE 10,FSB +SQUOZE 10,FSBL +SQUOZE 10,FSBM +SQUOZE 10,FSBB +SQUOZE 10,FSBR +SQUOZE 10,FSBRL +SQUOZE 10,FSBRM +SQUOZE 10,FSBRB +SQUOZE 10,FMP +SQUOZE 10,FMPL +SQUOZE 10,FMPM +SQUOZE 10,FMPB +SQUOZE 10,FMPR + SQUOZE 10,FMPRL +SQUOZE 10,FMPRM +SQUOZE 10,FMPRB +SQUOZE 10,FDV +SQUOZE 10,FDVL +SQUOZE 10,FDVM +SQUOZE 10,FDVB +SQUOZE 10,FDVR +SQUOZE 10,FDVRL +SQUOZE 10,FDVRM +SQUOZE 10,FDVRB +SQUOZE 10,MOVE +SQUOZE 10,MOVEI +SQUOZE 10,MOVEM +SQUOZE 10,MOVES +SQUOZE 10,MOVS +SQUOZE 10,MOVSI +SQUOZE 10,MOVSM +SQUOZE 10,MOVSS +SQUOZE 10,MOVN +SQUOZE 10,MOVNI +SQUOZE 10,MOVNM +SQUOZE 10,MOVNS +SQUOZE 10,MOVM +SQUOZE 10,MOVMI +SQUOZE 10,MOVMM +SQUOZE 10,MOVMS + +SQUOZE 10,IMUL +SQUOZE 10,IMULI +SQUOZE 10,IMULM +SQUOZE 10,IMULB +SQUOZE 10,MUL +SQUOZE 10,MULI +SQUOZE 10,MULM +SQUOZE 10,MULB +SQUOZE 10,IDIV +SQUOZE 10,IDIVI +SQUOZE 10,IDIVM +SQUOZE 10,IDIVB +SQUOZE 10,DIV +SQUOZE 10,DIVI +SQUOZE 10,DIVM +SQUOZE 10,DIVB +SQUOZE 10,ASH +SQUOZE 10,ROT +SQUOZE 10,LSH +SQUOZE 10,JFFO ;PDP10 INSTRUCTION +SQUOZE 10,ASHC +SQUOZE 10,ROTC +SQUOZE 10,LSHC +SQUOZE 10,CIRC ;CIRCULATE: ROTC WITH AC+1 GOING THE WRONG WAY +SQUOZE 10,EXCH +SQUOZE 10,BLT +SQUOZE 10,AOBJP +SQUOZE 10,AOBJN +SQUOZE 10,JRST +SQUOZE 10,JFCL +SQUOZE 10,XCT +0 + SQUOZE 10,PUSHJ +SQUOZE 10,PUSH +SQUOZE 10,POP +SQUOZE 10,POPJ +SQUOZE 10,JSR +SQUOZE 10,JSP +SQUOZE 10,JSA +SQUOZE 10,JRA +SQUOZE 10,ADD +SQUOZE 10,ADDI +SQUOZE 10,ADDM +SQUOZE 10,ADDB +SQUOZE 10,SUB +SQUOZE 10,SUBI +SQUOZE 10,SUBM +SQUOZE 10,SUBB +SQUOZE 10,CAI +SQUOZE 10,CAIL +SQUOZE 10,CAIE +SQUOZE 10,CAILE +SQUOZE 10,CAIA +SQUOZE 10,CAIGE +SQUOZE 10,CAIN +SQUOZE 10,CAIG + +SQUOZE 10,CAM +SQUOZE 10,CAML +SQUOZE 10,CAME +SQUOZE 10,CAMLE +SQUOZE 10,CAMA +SQUOZE 10,CAMGE +SQUOZE 10,CAMN +SQUOZE 10,CAMG +SQUOZE 10,JUMP +SQUOZE 10,JUMPL +SQUOZE 10,JUMPE +SQUOZE 10,JUMPLE +SQUOZE 10,JUMPA +SQUOZE 10,JUMPGE +SQUOZE 10,JUMPN +SQUOZE 10,JUMPG +SQUOZE 10,SKIP +SQUOZE 10,SKIPL +SQUOZE 10,SKIPE +SQUOZE 10,SKIPLE +SQUOZE 10,SKIPA +SQUOZE 10,SKIPGE +SQUOZE 10,SKIPN +SQUOZE 10,SKIPG +SQUOZE 10,AOJ +SQUOZE 10,AOJL +SQUOZE 10,AOJE +SQUOZE 10,AOJLE +SQUOZE 10,AOJA +SQUOZE 10,AOJGE +SQUOZE 10,AOJN +SQUOZE 10,AOJG +SQUOZE 10,AOS +SQUOZE 10,AOSL +SQUOZE 10,AOSE + SQUOZE 10,AOSLE +SQUOZE 10,AOSA +SQUOZE 10,AOSGE +SQUOZE 10,AOSN +SQUOZE 10,AOSG +SQUOZE 10,SOJ +SQUOZE 10,SOJL +SQUOZE 10,SOJE +SQUOZE 10,SOJLE +SQUOZE 10,SOJA +SQUOZE 10,SOJGE +SQUOZE 10,SOJN +SQUOZE 10,SOJG +SQUOZE 10,SOS +SQUOZE 10,SOSL +SQUOZE 10,SOSE +SQUOZE 10,SOSLE +SQUOZE 10,SOSA +SQUOZE 10,SOSGE +SQUOZE 10,SOSN +SQUOZE 10,SOSG + +SQUOZE 10,SETZ +SQUOZE 10,SETZI +SQUOZE 10,SETZM +SQUOZE 10,SETZB +SQUOZE 10,AND +SQUOZE 10,ANDI +SQUOZE 10,ANDM +SQUOZE 10,ANDB +SQUOZE 10,ANDCA +SQUOZE 10,ANDCAI +SQUOZE 10,ANDCAM +SQUOZE 10,ANDCAB +SQUOZE 10,SETM +SQUOZE 10,SETMI +SQUOZE 10,SETMM +SQUOZE 10,SETMB +SQUOZE 10,ANDCM +SQUOZE 10,ANDCMI +SQUOZE 10,ANDCMM +SQUOZE 10,ANDCMB +SQUOZE 10,SETA +SQUOZE 10,SETAI +SQUOZE 10,SETAM +SQUOZE 10,SETAB +SQUOZE 10,XOR +SQUOZE 10,XORI +SQUOZE 10,XORM +SQUOZE 10,XORB +SQUOZE 10,IOR +SQUOZE 10,IORI +SQUOZE 10,IORM +SQUOZE 10,IORB +SQUOZE 10,ANDCB +SQUOZE 10,ANDCBI +SQUOZE 10,ANDCBM +SQUOZE 10,ANDCBB +SQUOZE 10,EQV +SQUOZE 10,EQVI + SQUOZE 10,EQVM +SQUOZE 10,EQVB +SQUOZE 10,SETCA +SQUOZE 10,SETCAI +SQUOZE 10,SETCAM +SQUOZE 10,SETCAB +SQUOZE 10,ORCA +SQUOZE 10,ORCAI +SQUOZE 10,ORCAM +SQUOZE 10,ORCAB +SQUOZE 10,SETCM +SQUOZE 10,SETCMI +SQUOZE 10,SETCMM +SQUOZE 10,SETCMB + +SQUOZE 10,ORCM +SQUOZE 10,ORCMI +SQUOZE 10,ORCMM +SQUOZE 10,ORCMB +SQUOZE 10,ORCB +SQUOZE 10,ORCBI +SQUOZE 10,ORCBM +SQUOZE 10,ORCBB +SQUOZE 10,SETO +SQUOZE 10,SETOI +SQUOZE 10,SETOM +SQUOZE 10,SETOB +SQUOZE 10,HLL +SQUOZE 10,HLLI +SQUOZE 10,HLLM +SQUOZE 10,HLLS +SQUOZE 10,HRL +SQUOZE 10,HRLI +SQUOZE 10,HRLM +SQUOZE 10,HRLS +SQUOZE 10,HLLZ +SQUOZE 10,HLLZI +SQUOZE 10,HLLZM +SQUOZE 10,HLLZS +SQUOZE 10,HRLZ +SQUOZE 10,HRLZI +SQUOZE 10,HRLZM +SQUOZE 10,HRLZS +SQUOZE 10,HLLO +SQUOZE 10,HLLOI +SQUOZE 10,HLLOM +SQUOZE 10,HLLOS +SQUOZE 10,HRLO +SQUOZE 10,HRLOI +SQUOZE 10,HRLOM +SQUOZE 10,HRLOS +SQUOZE 10,HLLE +SQUOZE 10,HLLEI +SQUOZE 10,HLLEM +SQUOZE 10,HLLES +SQUOZE 10,HRLE +SQUOZE 10,HRLEI +SQUOZE 10,HRLEM +SQUOZE 10,HRLES +SQUOZE 10,HRR + SQUOZE 10,HRRI +SQUOZE 10,HRRM +SQUOZE 10,HRRS +SQUOZE 10,HLR +SQUOZE 10,HLRI +SQUOZE 10,HLRM +SQUOZE 10,HLRS + +SQUOZE 10,HRRZ +SQUOZE 10,HRRZI +SQUOZE 10,HRRZM +SQUOZE 10,HRRZS +SQUOZE 10,HLRZ +SQUOZE 10,HLRZI +SQUOZE 10,HLRZM +SQUOZE 10,HLRZS +SQUOZE 10,HRRO +SQUOZE 10,HRROI +SQUOZE 10,HRROM +SQUOZE 10,HRROS +SQUOZE 10,HLRO +SQUOZE 10,HLROI +SQUOZE 10,HLROM +SQUOZE 10,HLROS +SQUOZE 10,HRRE +SQUOZE 10,HRREI +SQUOZE 10,HRREM +SQUOZE 10,HRRES +SQUOZE 10,HLRE +SQUOZE 10,HLREI +SQUOZE 10,HLREM +SQUOZE 10,HLRES +SQUOZE 10,TRN +SQUOZE 10,TLN +SQUOZE 10,TRNE +SQUOZE 10,TLNE +SQUOZE 10,TRNA +SQUOZE 10,TLNA +SQUOZE 10,TRNN +SQUOZE 10,TLNN +SQUOZE 10,TDN +SQUOZE 10,TSN +SQUOZE 10,TDNE +SQUOZE 10,TSNE +SQUOZE 10,TDNA +SQUOZE 10,TSNA +SQUOZE 10,TDNN +SQUOZE 10,TSNN +SQUOZE 10,TRZ +SQUOZE 10,TLZ +SQUOZE 10,TRZE +SQUOZE 10,TLZE +SQUOZE 10,TRZA +SQUOZE 10,TLZA +SQUOZE 10,TRZN +SQUOZE 10,TLZN +SQUOZE 10,TDZ +SQUOZE 10,TSZ +SQUOZE 10,TDZE +SQUOZE 10,TSZE + +SQUOZE 10,TDZA +SQUOZE 10,TSZA +SQUOZE 10,TDZN +SQUOZE 10,TSZN + +SQUOZE 10,TRC +SQUOZE 10,TLC +SQUOZE 10,TRCE +SQUOZE 10,TLCE +SQUOZE 10,TRCA +SQUOZE 10,TLCA +SQUOZE 10,TRCN +SQUOZE 10,TLCN +SQUOZE 10,TDC +SQUOZE 10,TSC +SQUOZE 10,TDCE +SQUOZE 10,TSCE +SQUOZE 10,TDCA +SQUOZE 10,TSCA +SQUOZE 10,TDCN +SQUOZE 10,TSCN +SQUOZE 10,TRO +SQUOZE 10,TLO +SQUOZE 10,TROE +SQUOZE 10,TLOE +SQUOZE 10,TROA +SQUOZE 10,TLOA +SQUOZE 10,TRON +SQUOZE 10,TLON +SQUOZE 10,TDO +SQUOZE 10,TSO +SQUOZE 10,TDOE +SQUOZE 10,TSOE +SQUOZE 10,TDOA +SQUOZE 10,TSOA +SQUOZE 10,TDON +SQUOZE 10,TSON + +EISYM1: +SQUOZE 4,BLKI +BLKI IOINST +SQUOZE 4,DATAI +DATAI IOINST +SQUOZE 4,BLKO +BLKO IOINST +SQUOZE 4,DATAO +DATAO IOINST +SQUOZE 4,CONO +CONO IOINST +SQUOZE 4,CONI +CONI IOINST +SQUOZE 4,CONSZ +CONSZ IOINST +SQUOZE 4,CONSO +CONSO IOINST + +SQUOZE 10,APR +0 +SQUOZE 10,PI +4 +SQUOZE 10,PTP +100 +SQUOZE 10,PTR +104 +SQUOZE 10,TTY +120 +SQUOZE 10,LPT +124 +SQUOZE 10,DIS +130 +SQUOZE 10,DC +200 +SQUOZE 10,UTC +210 +SQUOZE 10,UTS +214 + + +SQUOZE 10,LDBI ;REALLY ILDB, +LDBI +SQUOZE 10,DPBI ;AND IDPB +DPBI +SQUOZE 10,CLEAR +CLEAR +SQUOZE 10,CLEARI +CLEARI +SQUOZE 10,CLEARM +CLEARM +SQUOZE 10,CLEARB +CLEARB +IRPS INST,,FAD FSB FMP FDV +SQUOZE 10,INST!RI +INST!RL +TERMIN + +SQUOZE 4,RIM10 +ARIM10,,SRIM +SQUOZE 4,SBLK +SBLKS,,SRIM +SQUOZE 4,RIM +ARIM,,SRIM +SQUOZE 4,SQUOZE +ASQOZ +SQUOZE 4,.RSQZ +-1,,ASQOZ +SQUOZE 4,XWD +AXWORD +SQUOZE 4,CONSTA +CNSTNT +SQUOZE 4,.MLLIT +CONSML,,INTSYM +SQUOZE 4,ASCIC +EOFCH,,AASCIZ +SQUOZE 4,RADIX +ARDIX + +IRPS X,,[END TITLE .BEGIN .END VARIAB SIXBIT ASCII ASCIZ .ASCII +BLOCK LOC OFFSET RELOCA 1PASS .DECRE NOSYMS EXPUNGE EQUALS NULL +WORD .SYMTAB] +SQUOZE 4,X +A!X +TERMIN + SQUOZE 4,.PASS +A.PASS,,INTSYM +SQUOZE 4,.PPASS +A.PPASS,,INTSYM + + ;CONDITIONALS (SEE ALSO IFSE, IFSN) +SQUOZE 4,IFG +JUMPG A,COND +SQUOZE 4,IFGE +JUMPGE A,COND +SQUOZE 4,IFE +JUMPE A,COND +SQUOZE 4,IFLE +JUMPLE A,COND +SQUOZE 4,IFL +JUMPL A,COND +SQUOZE 4,IFN +JUMPN A,COND + +SQUOZE 4,IF1 +TRNE FF,COND1 +SQUOZE 4,IF2 +TRNN FF,COND1 +SQUOZE 4,IFDEF ;ASSEMBLE IF SYM DEFINED +JUMPG A,DEFCND +SQUOZE 4,IFNDEF ;ASSEMBLE IF SYM NOT DEFINED +JUMPE A,DEFCND +SQUOZE 4,IFB ;ASSEMBLE IF STRING BLANK (HAS NO SQUOZE CHARS) +JUMPLE D,SBCND +SQUOZE 4,IFNB ;ASSEMBLE IF STRING NOT BLANK +JUMPG D,SBCND + +SQUOZE 4,PRINTX +APRNTX +SQUOZE 4,PRINTC +(400000)APRNTC +SQUOZE 4,.ERR +A.ERR + +SQUOZE 4,.LIBRA +LLIB,,A.LIB +SQUOZE 4,.LENGTH +A.LENGTH +SQUOZE 4,.LIFS +LTCP,,A.LIB +SQUOZE 4,.ELDC +A.ELDC +IRPS A,,E N G LE GE L +SQUOZE 4,.LIF!A +JUMP!A A.LDCV +TERMIN +SQUOZE 4,.SLDR +A.SLDR + +SQUOZE 4,.AOP ;DOESN'T HAVE VALUE +A.AOP +SQUOZE 4,.OP +A.OP +SQUOZE 4,.FORMAT +A.FORMAT +SQUOZE 4,. +GTVLP +SQUOZE 4,.LOP +A.LOP +SQUOZE 40,$. +0 +SQUOZE 44,$R. +0 +SQUOZE 40,$O. ;(OH) GLOBAL OFFSET +0 +SQUOZE 40,$L. ;REAL LOCATION (WITHOUT OFFSET) +0 +SQUOZE 40,.LVAL1 +0 +SQUOZE 40,.LVAL2 +0 +SQUOZE 4,.LNKOT +A.LNKOT +SQUOZE 4,.NSTGW +(1)STGWS +SQUOZE 4,.YSTGW +STGWS +SQUOZE 4,.TYPE +A.TYPE +SQUOZE 4,.LIBRQ +A.LIBRQ +SQUOZE 4,.GLOBAL +A.GLOB + +SQUOZE 4,.BYTC +NBYTS,,INTSYM +SQUOZE 4,.BYTE +A.BYTE +SQUOZE 4,.WALGN +A.WALGN + +;CREF PSEUDO-OPS. +SQUOZE 4,.CRFON +A.CRFN ;START CREFFING. +SQUOZE 4,.CRFOFF +A.CRFFF ;STOP CREFFING. +SQUOZE 4,.XCREF +A.XCREF +SQUOZE 4,.CRFIL +CRFILE,,INTSYM + +IFE CREFSW,[ + A.CRFN==ASSEM1 ;THESE DO NOTHING IF CAN'T CREF. + A.CRFFF==ASSEM1 + A.XCREF==ASSEM1 +] + +IFN MACSW,[ ;MACRO PROCESSOR PSEUDOS +;MACROS GET DEFINED AS +;SQUOZE 4, +;,, MACCL + +SQUOZE 4,REPEAT +AREPEAT +SQUOZE 4,DEFINE +ADEFINE +SQUOZE 4,IRP +AIRP +SQUOZE 4,IRPC +AIRP(400000) +SQUOZE 4,IRPS +(200000)AIRP +SQUOZE 4,IRPW +100000,,AIRP +SQUOZE 4,TERMIN +ATERMIN +SQUOZE 4,.QUOTE +A.QOTE +SQUOZE 4,.STOP +(400000)A.STOP +SQUOZE 4,.ISTOP +A.STOP +SQUOZE 4,.RPCNT +CRPTCT,,INTSYM +SQUOZE 4,.GSSET +A.GSSET +SQUOZE 4,.GSCNT +GENSM,,INTSYM +SQUOZE 4,.GO +A.GO +SQUOZE 4,.TAG +A.TAG +SQUOZE 4,.IRPCNT +CIRPCT,,INTSYM +IFN RCHASW,[SQUOZE 4,.TTYMAC +A.TTYM +] +SQUOZE 4,IFSE +SKIPN SCOND +SQUOZE 4,IFSN +SKIPE SCOND +] + +SQUOZE 4,.STGSW +STGSW,,INTSYM +SQUOZE 4,.AVAL1 +AVAL1,,INTSYM ;C(AC) AFTER .AOP, .OP +SQUOZE 4,.AVAL2 +AVAL2,,INTSYM ;C(E) AFTER " +IFN TS,[ +SQUOZE 4,.FNAM1 +RFNAM1,,INTSYM +SQUOZE 4,.FNAM2 +RFNAM2,,INTSYM +SQUOZE 4,.INSRT +A.INSRT +SQUOZE 4,.INEOF +A.INEO +SQUOZE 4,.IFNM1 +IFNM1,,INTSYM +SQUOZE 4,.IFNM2 +IFNM2,,INTSYM +] +IFN .I.FSW,[ +SQUOZE 4,.F +A.F +SQUOZE 4,.I +A.I +] +IFN TSSYMS,[ +IRPS X,,UAI UAO BAI BAO UII UIO BII BIO +SQUOZE 10,.!X +.IRPCN +TERMIN +] +EISYMT": PRINTA \.-MACTBA-1, WORDS INITIALIZATION CODING. + +IFN TS,[ + LOC <.+1777>&-2000 +MXICLR==./2000 ;FIRST PAGE ABOVE INITIALIZING CODING + LOC &-2000 +MXIMAC==./2000 ;FIRST PAGE ABOVE INITIAL MACTBA +] + +IFN TS\DECSW,END BEG ;MUST BE BEFORE RELOCATABLE END STATEMENT, + ;SINCE TS MIDAS NOW TRIES TO DO MULTIPLE 1PASS ASSEMBLIES FROM SAME FILE. + ;PUTTING RELOCABLE END STATEMENT FIRST CAUSES IT TO ENCOUNTER OTHER + ;END STATEMENT IN NEW ASSEMBLY CAUSING CONFUSION + +END 100 +  \ No newline at end of file diff --git a/src/midas/midas.323 b/src/midas/midas.323 new file mode 100644 index 00000000..cb0f4cfc --- /dev/null +++ b/src/midas/midas.323 @@ -0,0 +1,13496 @@ + +.SYMTAB 4003.,2000. ;THIS MANY FOR DEC VERSION ON DEC SYSTEM. +IFN .OSMIDAS-SIXBIT/DEC/, .SYMTAB 5003. ;ON ITS ASSEMBLE FASTER. + +TITLE MIDAS +.MLLIT==1 ;MULTI-LINE MODE. + +;AC DEFS + +FF=0 ;FLAGS +P=1 +I=2 ;INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF +AA=3 +A=4 +B=5 +C=6 +D=7 +T=10 ;NOT SO TEMP AS IN MOST PROGS W/ T +TT=11 +SYM=12 ;FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR +LINK=13 +F=14 +CH1=15 ;MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH +CH2=16 ;" " " +TM=17 ;SUPER TEMPORARY + +IFDEF .XCREF, .XCREF FF,P,I,A,B,C,D,T + +IF1,[ ;FOR PASS 1 TTY CONDITIONALS +IFDEF SAILSW,IFN SAILSW,DECSW==1 +IFDEF CMUSW,IFN CMUSW,DECSW==1 +IFDEF DECDBG,IFN DECDBG,DECSW==1 +IFDEF DECSW,IFN DECSW,DECSW==1 ? ITSSW==0 ? TNXSW==0 +IFDEF ITSSW,IFN ITSSW,ITSSW==1 ? DECSW==0 ? TNXSW==0 +IFDEF TNXSW,IFN TNXSW,TNXSW==1 ? DECSW==0 ? ITSSW==0 +] ; IF1 +IFNDEF ITSSW,ITSSW==IFDEF .IOT,[1] .ELSE 0 ;NONZERO FOR ITS VERSION +IFNDEF TNXSW,TNXSW==IFDEF JSYS,[1] .ELSE 0 ;NONZERO FOR TENEX VERSION +IFNDEF DECSW,DECSW==IFDEF LOOKUP,[1-TNXSW] .ELSE 0 ;NONZERO TO RUN ON DEC MONITOR. + ; TNXSW SINCE TENEX MIDAS HAS DEC UUO'S + ; DEFINED TOO +IFNDEF DECDBG,DECDBG==0 ;NONZERO FOR DEC VERSION TO RUN WITH DEC DDT. +IFNDEF SAILSW,SAILSW==IFDEF SPCWAR,[1] .ELSE 0 ;NONZERO FOR SAIL VERSION. +IFNDEF CMUSW,CMUSW==IFDEF CMUDEC,[1] .ELSE 0 ;NONZERO FOR VERSION TO RUN AT CMU. +IFN TNXSW,DECSW==1 ;***TEMP*** USE PA1050 FOR NOW +IFN ITSSW\DECSW\TNXSW,TS==1 +IFNDEF TS,TS==1 ;NON-ZERO FOR ASSEMBLED VERSION TO RUN IN TIME-SHARING +IFE TS,1PASS +IFNDEF A1PSW, A1PSW==TS ;FOR 1PASS END-OF-PROGRAM AUTO-REASSEMBLY +IFNDEF TSSYMS, TSSYMS==ITSSW ;.UAI, ETC. (AND ..RJCL, ETC) - EVER USE THEM? +IFNDEF BRCFLG, BRCFLG==0 ;1 => BRACES { AND } ARE SPECIAL IN MACRO ARGS, ETC. + ;JUST LIKE BRACKETS. BRACES ARE SPECIAL IN CONDITIONALS + ;REGARDLESS OF BRCFLG. +IFNDEF CREFSW, CREFSW==ITSSW ;SET TO ALLOW C SWITCH TO CAUSE CREF OUTPUT. +IFNDEF LISTSW, LISTSW==1 ;SET TO ALLOW L SWITCH TO CAUSE A LISTING. +IFNDEF RCHASW, RCHASW==TS ;INCLUDE TTY AS POSSIBLE INPUT DEVICE +IFNDEF PURESW, PURESW==TS ;NON-ZERO TO SEPARATE PURE CODING FROM IMPURE AND DO PAGE SKIPS +IFNDEF FASLP, FASLP==ITSSW\TNXSW\CMUSW\SAILSW ;NON-ZERO => INCLUDE FASL OUTPUT CAPABILITY + ; NOTE!! IF RUNNING UNDER 10/50 THIS MAKES THINGS + ; SEVERAL K BIGGER THAN OTHERWISE +IFNDEF .I.FSW, .I.FSW==ITSSW\TNXSW\CMUSW\SAILSW ;NON-ZERO => INCLUDE .I, .F +IFNDEF MACSW, MACSW==1 ;NON-ZERO => INCLUDE MACRO PROCESSOR (!) +IFNDEF RUNTSW, RUNTSW==1 ;ASSEMBLE CODING TO TYPE OUT RUN TIME AT END OF ASSEMBLY +IFNDEF WRQTSW, WRQTSW==1 ;WRQOTE (MACRO DEFINITION READER) VERSION + ; ^ 0 => SLOW, 1 => FAST; MAYBE 2 WILL EVENTUALLY BE CREATED +IFE TS,IFNDEF MACL,MACL==6*2000 ;MACRO TABLE SIZE +IFN TS,[ +IFE DECSW,IFNDEF MACL,MACL==6000 ;(MUST BE BIG ENOUGH TO COVER INIT CODE) + ;IN DEC VERSION, MACL IS DEFINED = SIZE OF INIT CODE. +IFNDEF MXMACL,MXMACL==32.*2000 ;MAXIMUM LENGTH MACTAB +] +IFNDEF MACRUM,MACRUM==4 ;# WORDS NOT USED AT END OF MACTAB +IFNDEF STRL,STRL==20 ;LENGTH OF STRING STORAGE (USED BY GSYL) +IFNDEF DMDEFL,DMDEFL==40 ;MAX NO OF DMY ARGS IN DEFINE +IFNDEF DMYAGL,DMYAGL==400 ;MAX NO COMBINED DMYARGS ALL MACROS CURRENTLY EXPANDING OR PUSHED +IFNDEF MPDLL,MPDLL==300 ;MACRO PDL LENGTH +IFNDEF DSSIZ,DSSIZ==40 ;MAX # ARGS MACRO WHOSE ARGS BEING SCANNED (SHOULD BE .GE. DMDEFL) +IFNDEF BKTABL,BKTABL==40 ;MAX NUM .BEGIN BLOCKS. +IFNDEF BKPDLS,BKPDLS==10 ;MAXIMUM .BEGIN BLOCK NESTING DEPTH. +IFNDEF BSIZE,BSIZE==37 ;PREFERRED SIZE BLOCK MAX SIZE-3 +IFN DECSW,IFNDEF LPDL,LPDL==200. +IFNDEF LPDL,LPDL==500 ;LENGTH OF PDL +IFN DECSW,IFNDEF CONMIN,CONMIN==1000 +IFNDEF CONMIN,CONMIN==3300 ;MINIMUM AMT OF SPACE FOR CONSTANTS TABLES. +IFNDEF CONMAX,CONMAX==10000 ;MAXIMUM SPACE USER CAN ASK FOR. +IFNDEF NCONS,NCONS==75. ;MAXIMUM NUMBER OF CONSTANTS AREAS +IFNDEF NVARS,NVARS==25. ;MAX. NUM. VARIABLES AREAS. +IFN DECSW,IFNDEF SYMDSZ,SYMDSZ==2003. +IFNDEF SYMDSZ,SYMDSZ==2707. ;DEFAULT # SYMS IN SYMTAB. +IFNDEF SYMMSZ,SYMMSZ==10177*2 ;# SYMS IF JNAME IS MMIDAS. +IFNDEF SYMMAX,SYMMAX==40000 ;MAX SYMTAB SIZE (# SYMS) +IFNDEF FASBL,FASBL==400 ;WORDS USED FOR FASL OUTPUT BUFFER + ; MUST HOLD STUFF ASSOC WITH ONE GROUP OF 9 CODE BYTES +IFNDEF FASATL,FASATL==2000 ;WORDS USED FOR FASL ATOM TABLE + ; HOLDS PNAMES ETC OF ALL ATOMS AS WILL BE IN FASLOAD'S + ; SYMTAB AT LOAD TIME +IFNDEF MINWPS,MINWPS==3 ;MIN # WORDS IN SYMTAB ENTRY +IFNDEF MAXWPS,MAXWPS==3 ;MAX # ALLOWED (WILL BE BIGGER SOME DAY) +IFNDEF NRMWPS,NRMWPS==3 ;DEFAULT #. 2 WDS FOR VALUE & FLAGS, 1 FOR NAME. + +IF1 [ + +IFNDEF MIDVRS,MIDVRS=.FNAM2 +IFE MIDVRS-SIXBIT/MID/,[ +PRINTX /What is MIDAS version number? / +.TTYMAC VRS +MIDVRS=SIXBIT/VRS/ +TERMIN +] + +;OSMIDAS GETS THE SIXBIT NAME OF THE TYPE OF OP. SYS. THE VERSION OF MIDAS +;IS BEING ASSEMBLED TO RUN UNDER. IT WILL BE THE VALUE OF ".OSMIDAS" WHEN PROGRAMS +;ARE ASSEMBLED WITH THIS MIDAS. +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/ + +;FF FLAGS NOT PUSHED +;LEFT HALF +FL==1,,525252 +FLPPSS==400000 ;ONE IF PUNCHING PASS; MUST BE SIGN +FLHKIL==100000 ;ONE IF SYM TO BE SEMI KILLED IN DDT + +FLVOT==40000 ;ALL RCH S MUST GO THRU RCH + ; IE TYPCTL .NE. POPJ P, (SET/CLEARED BY MDSSET, MDSCLR) +FLMAC==20000 ;ONE IF CHARS COMING FROM MACRO PROCESSOR, DON'T HACK CPGN/CLNN +FLTTY==10000 ;ONE IF CHARS FROM SOMEWHERE ELSE BUT NOT HACKING CPGN/CLNN +FLOUT==4000 ;ONE IF OUTPUT HAS OCCURED IN CURRENT MODE (USED BY TS NED LOGIC) +FLPTPF==2000 ;SET IF (TIME SHARING) OUTPUT DEVICE IS PTP +FLUNRD==1000 ;=> RE-INPUT LAST CHARACTER (SEE RCH) + + +;FF RIGHT HALF FLAGS + +FR==525252 +FRFIRWD==400000 ;ONE FOR FIRST WORD OF BLOCK +FRSYMS==200000 ;ONE IF SYM PUNCH DESIRED +FRLOC==100000 ;ONE BETWEEN ABS LOC ASSIGN AND + ;FIRST BLOCK OUTPUT THEREAFTER (EBLK TO OUTPUT NULL BLOCK SO LINKING LOADER KNOWS $.) + +FRNPSS==40000 ;ONE IF TWO PASS ASSEMBLY +FRPSS2==20000 ;ONE ON PASS 2 + +FRINVT==4000 ;USED BY PBITS AND OUTPUT TO OUTPUT WORDS OF CODE BITS IN CORRECT ORDER (STEAD LOGICAL) +FRNLIK==2000 ;TEMPORARILY SUPPRESS ADR LINKING +FRGLOL==1000 ;ONE IF LOCATION PLUS OFFSET IS GLOBAL + +FRBIT7==400 ;SET IF LAST TIPLE OF CODEBITS WAS 7. +FRMRGO==200 ;MACRO PROC TO RETURN TO .GO HACKER W/O READING NEXT CHAR (SEE RCHSAV) + +FRCMND==40 ;SET WHILE READING CMD, TELLS RFD TO NOTICE (, _, COMMA. +FRNNUL==20 ;SET ON RETURN FROM RFD IFF NONNULL SPEC. +FRARRO==10 ;TELLS RFD THAT 1ST NAME IS FN1, NOT FN2. + +] ;END IF1 + +IF1 [ + + ;INDICATOR REGISTER + +;LEFT HALF +IL==1,,525252 +ILGLI==1 ;SET ON " CLEARED EACH SYL +ILVAR==2 ;SET ON ' " " " +ILFLO==4 ;FLOATING NUM, SET ON DIGIT AFTER . +ILDECP==10 ;DECIMAL PREFER, SET WHEN . SEEN. +ILUARI==20 ;1 => RIGHT OPERAND TO UPARROW BEING READ +ILLSRT==40 ;RETURN FROM < +ILWORD==400 ;SET IF CURRENT WORD IS NOT NULL RETURNED BY GETWORD +ILNPRC==1000 ;ONE IF NUMBER ALREADY PROCESSED BY UPARROW +ILMWRD==4000 ;SET ON MULTIPLE WORD +ILPRN==10000 ;SET DURING MACCL IF MACRO NAME WAS FOLLOWED BY (. +ILMWR1==20000 ;SET BY LBRAK AS SIGNAL TO ITSELF THAT THIS NOT FIRST + ;WORD OF MULTI-WORD CONSTANT +ILNOPT==40000 ;CONSTANTS OPTIMIZATION SUPPRESSION FLAG; SHOULD BE SET BY + ;VALUE-RETURNING PSEUDO DURING NOT PUNCHING PASS TO KEEP ITSELF OUT OF + ;CONSTANTS OPTIMIZATION + + +;RIGHT HALF + +IR==525252 +IRFLD==1 ;SET IF FLD NOT NULL +IRSYL==2 ;SET IF SYL NOT NULL +IRLET==4 ;SET IF SYL IS SYMBOL +IRDEF==10 ;SET IF CURRENT EXPR DEFINED +IRNOEQ==20 ;SET IF = ISN'T ALLOWED IN CURRENT CONTEXT. +IRCOM==40 ;SET IF CURRENT QUAN IS COMMON +IRPERI==100 ;SET IF PERIOD SEEN IN WHAT IS SO FAR (INCL .) A NUMBER +IREQL==200 ;ONE DURING READING WORD TO RIGHT OF = +IRIOINS==400 ;FIRST FIELD OF CURRENT WORD HAS IO INST +IRCONT==1000 ;SET IF NOT OK TO END BLOCK +IRPSUD==4000 ;SET IF ERROR COMMENTS WILL COME FROM PSEUDO +IRGMNS==20000 ;SET IF ILUARI OR BAKARI HAS GOBBLED MINUS +IROP==200000 ;SET IF OPERATOR SEEN IN CURRENT FIELD + + +CALL=PUSHJ P, +RET=POPJ P, +SAVE=PUSH P, +REST=POP P, + +ETSM=1000,, ;ERROR, TYPE SYM. +ETR=2000,, ;ERROR, ORDINARY MESSAGE. +ERJ=3000,, ;ERROR, NO MESSAGE, RETURN TO ADDR. +ETI=4000,, ;ERROR, IGNORE LINE, RET. TO ASSEM1. +ETA=5000,, ;ERROR, RET. TO ASSEM1. +ETASM=6000,, ;ERROR, TYPE SYM AND RETURN TO ASSEM1 +ETF=7000,, ;FATAL ERROR. +TYPR=(37000) ;UUO, TYPE OUT ASCIZ STRING +] ;END IF1 + +IF1 [ +;LINK TABLE (GLOTB), ACCUMULATES GLOBAL REFERENCES FOR CURRENT FROB (USUALLY WORD) TO OUTPUT +;GLSP2 POINTS TO (I.E. HAS ADR 1 LESS THAN) BOTTOM OF ACTIVE PART OF TABLE +;GLSP1 POINTS TO TOP (HAS ADR OF LAST ENTRY ACTIVE) + +;ACTUAL ENTRIES IN GLOTB: +;IF ENTIRE WORD ZERO, ENTRY IS NULL, WILL (OR SHOULD) BE IGNORED +;RH ADR OF SQUOZE WITH INTERNAL MIDAS FLAGS (USUALLY IN SYMBOL TABLE, BUT MAY BE ANYWHERE IN CORE) +;LH: RIGHT 10. BITS MULTIPLICATION FACTOR OR 0 => 1 + ;GLOBAL SHOULD BE MULTIPLIED BY IT +;REST OF LH FLAGS: + +;SIGN BIT => THIS NOT PART OF FIELD, DON'T PLAY WITH FLAGS AT GETFLD, INTFD +ACF==40000 ;AC LOW OR HIGH (SWAPF => HIGH) +HFWDF==100000 ;MASK GLOBAL TO HALFWORD +SWAPF==200000 ;SWAP +MINF==20000 ;NEGATIVE OF GLOBAL + +IFNDEF LBRKT,LBRKT=="[ ;LEFT DELIMITER FOR EXPLICITLY GROUPED CONDITIONALS, MACRO ARGS, REPEAT BODY, ETC. +IFNDEF RBRKT,RBRKT=="] ;RIGHT " +IFNDEF WPS, WPS==3 ;# CONTIG. WDS /STE. IFNDEF FOR DEBUGGING. +IFNDEF BKWPB,BKWPB==3 ;# WDS/BKTAB ENTRY. +IFNDEF EOFCH,EOFCH==3 ;EOF CHAR, BEWARE DISPATCH TABLE ENTRIES. +IFNDEF LBRACE,LBRACE=="{ +IFNDEF RBRACE,RBRACE=="} + +;3RDWRD LH. SYM TAB BITS + +3REL==600000 ;RELOC BITS, DO NOT CHANGE, SOMETIMES REFERENCED BY NUMERIC BYTE POINTERS +3RLL==400000 ;R(LH) +3RLR==200000 ;R(RH) +3RLNK==100000 ;R(LINK) +3KILL==40000 ;FULLY-KILLED SYM (DON'T GIVE TO DDT). +3VP==20000 ;VALUE PUNCHED +3SKILL==10000 ;SEMI KILL IN DDT +3LLV==4000 ;LINKING LOADER MUST INSERT VAL +3VAS2==2000 ;VAR SEEN ON PASS TWO WITH ' +3VCNT==1000 ;USED IN CONSTANT +3MAS==400 ;THIS ISN'T THE LAST DEFINITION OF A SYM WITH THIS NAME + ;(SO ES MUST KEEP SEARCHING). +3NCRF==200 ;DON'T CREF THIS SYMBOL. +3MACOK==100 ;OK TO (RE)DEFINE THIS SYM AS MACRO. + ;(IE IS A MACRO OR SEEN ONLY IN .XCREF) +3LABEL==40 ;ILLEGAL TO REDEFINE THIS SYM TO DIFFERENT VALUE +3MULTI==20 ;THIS SYM IS MULTIPLY DEFINED, SO FLAG ALL DEFINITIONS. +3DOWN==10 ;THIS DEFINITION SHOULD BE SEEN BY SUBBLOCKS IN 1PASS MODE. + +3DFCLR==737110 ;BITS IN LH TO CLEAR ON REDEFINITION. + +;CONTROL FLAGS +;LEFT HALF +TRIV==400000 ;1 IF OUT FORM IS FOR TRIVIAL LOADER (ABSOLUTE) +;RIGHT HALF +ARIM==2 ;IF ONE OUT FOR IS RIM +SBLKS==10 ;IF ONE OUT FORM IS SIMPLE BLOCKS +ARIM10==20 ;PDP-10 RIM +DECREL==40 ;DEC RELOCATABLE FORMAT (CONSIDERED "ABSOLUTE" INSIDE MIDAS) +FASL==100 ;LISP FASL COMPATIBLE RELOCATABLE FORMAT ( " " ") + +] ;END IF1 + +IF1 [ + +;SQUOZE FLAG DEFINITIONS IN MIDAS SYMBOL TABLE + +CMMN==0 ;COMMON (NOT USED) +PSUDO==40000 ;PSEUDO OR MACRO, VALUE RH ADDR OF RTN (MACCL FOR MACRO), + ; LH WILL BE IN LH OF B WHEN RTN CALLED. +SYMC==100000 ;SYM, VALUE IS VALUE OF SYM. +LCUDF==140000 ;LOCAL UNDEF +DEFLVR==200000 ;DEF LOC VAR, VALUE IS VALUE. +UDEFLV==240000 ;UNDEF LOC VAR, VALUE IS 1+ IDX IN VARIAB. AREA, BUT IGNORD IF VAR AREA GLOB. +LGBLCB==300000 ;CODE BITS EQUAL TO THIS OR HIGHER REPRESENT GLOBAL QUANTITIES +DEFGVR==300000 ;DEF GLO VAR, VALUE IS VALUE +UDEFGV==340000 ;UNDEF GLO VAR, VALUE LIKE UNDEF LOCAL VAR. +GLOETY==400000 ;GLO ENTRY +GLOEXT==440000 ;GLO EXIT +NCDBTS==GLOEXT_<-18.+4>+1 ;# CODE BIT TYPES + +DEFINE CDBCHK TBLNAM +IFN .--NCDBTS,.ERR TBLNAM LOSES +TERMIN + +;LOADER BLOCK TYPES LINK +LLDCM==1 ;LOADER COMMAND BLOCK +LABS==2 ;ABSOLUTE +LREL==3 ;RELOCATABLE +LPRGN==4 ;PROG NAME +LLIB==5 ;LIBRARY BLOCK +LCOMLOD==6 ;LOAD INTO COMMON +LGPA==7 ;GLOBAL PARAMETER ASSIGN +LDDSYM==10 ;LOCAL SYMS +LTCP==11 ;LOAD TIME COND ON PRESENCE +ELTCB==12 ;END LOAD TIME COND +LPLSH==22 ;POLISH FIXUP + +;LOADER COMMANDS +;IN ADR OF LDCMD BLK +LCJMP==1 ;JUMP +LCGLO==2 ;GLOBAL LOC ASSIGN +LCCMST==3 ;SET COMMON BENCHMARK +LCEGLO==4 ;END OF GLOBAL BLOCK +LDCV==5 ;LOAD TIME COND ON VALUE +LDOFS==6 ;LOADER SET GLOBAL OFFSET +LD.OP==7 ;LOADER .OP + +;LOADER CODEBITS SECOND SPEC AFTER 7 +CDEF==0 ;DEF +CCOMN==1 ;COMMON REL +CLGLO==2 ;LOC-GLO REC +CLIBQ==3 ;LIBREQ +CRDF==4 ;GLO REDEF +CRPT==5 ;REPEAT GLOBAL VALUE +CDEFPT==6 ;DEFINE SYM AS $. + +;DEC RELOCATABLE BLOCK TYPES. +DECWDS==1 ;STORAGE WORDS. +DECSYM==2 ;SYMBOL DEFS OR GLOBAL ADDITIVE RQS. +DECHSG==3 ;LOAD INTO HIGH SEG (FOR .DECTWO) +DECENT==4 ;ENTRY NAMES +DECEND==5 ;END BLOCK, HAS PROGRAM BREAK. +DECNAM==6 ;PROGRAM NAME. +DECSTA==7 ;STARTING ADDRESS BLOCK. +DECINT==10 ;INTERNAL REQUEST +DECRQF==16 ;REQUEST LOADING A FILE +DECRQL==17 ;REQUEST LOADING A LIBRARY +] ;END IF1 + +IF1 [ + +DEFINE PRINTA A,B,C,D,E,F +IF1,[PRINTC A!B!C!D!E!F +] +TERMIN + +IF1 [DEFINE BNKBLK OP +OP +TERMIN ] + + ;ADD A LINE TO BNKBLK, ACCUMULATED CONTENT OF + ;WHICH IS DUMPED OUT AT END OF ASSEMBLY + ;ARG TO BLCODE SHOULD BE FREE OF STORAGE WORDS + +DEFINE BLCODE NEWCFT +IF1 [BNKBLK [DEFINE BNKBLK OP +OP]NEWCFT +TERMIN ] +IF2 [IRPW X,,[ +NEWCFT +] +IRPS Y,,X +Y=Y +.ISTOP TERMIN TERMIN ] TERMIN + + ;3RDWRD MANIPULATING MACROS + ;GET 3RDWRD INTO LH("A"), "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3GET A,B + MOVE A,ST+2(B) + TERMIN + + ;GET 3RDWRD INTO "A", "B" HAS ADR OF 1STWRD + +DEFINE 3GET1 A,B + MOVE A,2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3PUT A,B + MOVEM A,ST+2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS ADR OF 1STWRD + +DEFINE 3PUT1 A,B + MOVEM A,2(B) + TERMIN + +] ;END IF1 + +IF1 [ + + ;RANDOM MACRO DEFINITIONS + + ;A HAS ADR OF SYM SQUOZE, SKIP IF IT'S IN SYMBOL TABLE + +DEFINE SKPST A + CAIL A,ST + CAML A,MACTAD +TERMIN + + ;EXECUTE AN INSTRUCTION WITH VARIOUS ADDRESSES (USUALLY PUSH OR POP) + +DEFINE INSIRP A,B + IRPS %ADR,,[B] + A,%ADR + TERMIN +TERMIN + +DEFINE NOVAL + TDNE I,[ILWORD,,IRNOEQ\IRFLD] + ETSM ERRNVL +TERMIN + +DEFINE NOABS + SKIPGE CONTRL + ETASM ERRABS +TERMIN + +] ;END IF1 + +ERRNVL==[ASCIZ /Returns no value/] +ERRABS==[ASCIZ /Allowed only for STINK relocatable format/] + +IF1 [ + +DEFINE MOVEIM B,C + MOVEI A,C + MOVEM A,B +TERMIN + +DEFINE MOVEMM B,C + MOVE A,C + MOVEM A,B +TERMIN +] ;END IF1 + +IF1 [ +IFN 0,[ +;THESE ARE SOME MACRO DEFINITIONS FOR THE UNFINISHED MULTI-WORD +;SYMBOL NAME FEATURE. FOR COMPATIBILITY, THEY ALL NOW HAVE DEFINITIONS +;THAT ONLY HANDLE ONE WORD. THOSE OTHER DEFINITIONS COME AFTER THESE. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +IFSN X,SYM,SKIPE A,X+1 +.ELSE SKIPE A,SYMX + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y + MOVE Z,X+1 + MOVEM Z,Y+1 +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y + MOVE Z,AC!X + MOVEM Z,Y+1 +TERMIN +] + +.ELSE [ +;THESE ARE THE DEFINITIONS OF THE MACROS THAT DO NOT IMPLEMENT +;MULTI-WORD SYMBOL NAMES. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y +TERMIN +] + +DEFINE USING X +X,TERMIN + +] ;END IF1 + +IFN DECSW\TNXSW,[ +IF1 [ +IFE .OSMIDAS-SIXBIT/ITS/,[ + IFE CMUSW\SAILSW,.INSRT SYS:DECDFS + IFN SAILSW, .INSRT SYS:SAIDFS + IFN CMUSW, .INSRT SYS:CMUDFS + IFN TNXSW, .INSRT SYS:TNXDFS +] ;IF ASSEMBLED ON ITS +IFN .OSMIDAS-SIXBIT/ITS/,[ ;OTHER PLACES DON'T KEEP THESE ON SYS: + IFE CMUSW\SAILSW,.INSRT DECDFS + IFN SAILSW, .INSRT SAIDFS + IFN CMUSW, .INSRT CMUDFS + IFN TNXSW, .INSRT TNXDFS +] ;IF ASSEMBLED ON A NON-ITS PLACE +.DECDF + +IFN TNXSW,[EXPUNGE RESET ; THE ONLY CONFLICTING JSYS/CALLI +.TNXDF +] ;IFN TNXSW + +EXPUNGE .SUSET +DEFINE .SUSET A +TERMIN + +DEFINE HALT + JRST 4,. +TERMIN + +EXPUNGE .VALUE +EQUALS .VALUE HALT +DEFINE .LOSE A + JRST 4,.-1 +TERMIN +] ;IF1 +IFN PURESW,.DECTWO +IFE PURESW,.DECREL +RL0==. +] ;IFN DECSW\TNXSW + +IFN ITSSW,[IF1 [IFNDEF .IOT,[.INSRT SYS:ITSDFS + .ITSDF +] ;IFNDEF .IOT +IFNDEF %PIPDL,.INSRT SYS:ITSBTS + HALT==.VALUE + EXPUNG .JBTPC,.JBCNI + +DEFINE SYSCAL A,B + .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] +TERMIN +] ;IF1 +RL0==0 +IFDEF .SBLK,.SBLK +] ;IFN ITSSW + +IFE PURESW,[ ;FOLLOWING IF NOT ASSEMBLING PURE CODING + +DEFINE PBLK +TERMIN + +DEFINE VBLK +TERMIN +] + +IFN PURESW,[ ;FOLLOWING IF ASSEMBLING PURE CODING + +;MEMORY ORGANIZATION PURE CODING + +;MAXVAR BLOCKS OF IMPURE CODING, NO DYNAMIC ALLOCATION + ;BLCODE MACRO ACCUMULATES CODING TO BE PUT AT END OF + ;IMPURE CODING, NO STORAGE WORDS ALLOWED +;THEN SYM TAB, STARTING AT ST. +;THEN MACRO TABLE (WITH INIT. CODE IN IT) +;STARTING INITIALLY AT MACTBA, ACTUAL ADDR IN MACTAD. +;SYMTAB AND MACTAB DON'T NECESSARILY START ON PAGE BNDRYS. +;THEN GAP TO MINPUR*2000 (HEREAFTER KNOWN AS "THE GAP") +IFN DECSW\TNXSW,MINPUR==200 +IFN ITSSW,MINPUR==140 ;BLOCK NUMBER BEGINNING OF PURE CODING +;PURE CODING UNTIL MAXPUR*2000-SOMETHING +;THE FOLLOWING MACROS AND BLCODE MAKE IT NOT COMPLETELY NECESSARY +;TO SEPARATE PURE CODING FROM IMPURE + +CKPUR==0 ;0 => ASSEMBLING BELOW THE GAP, 1 ABOVE + + ;SWITCH TO CODING ABOVE THE GAP + +DEFINE PBLK +IFN CKPUR,.ERR PBLK +IFE CKPUR,[VAR.LC==. +LOC PUR.LC +]CKPUR==1 +TERMIN + +PUR.LC==MINPUR*2000+IFN DECSW,[RL0] ;SAVED LOCATION COUNTER ABOVE THE GAP WHEN ASSEMBLING BELOW + + ;SWITCH TO CODING BELOW THE GAP + +DEFINE VBLK +IFE CKPUR,.ERR VBLK +IFN CKPUR,[PUR.LC==. +LOC VAR.LC +]CKPUR==0 +TERMIN + +PBLK ;PBLK NORMAL MODE, VARIABLE AREAS BRACKETED WITH VBLK AND PBLK + +] ;END PURESW CONDITIONAL + +.YSTGW ;SET UP NOW, STORAGE WORDS OK + +FOO==. +LOC 41 + JSR ERROR +IFN ITSSW,JSR TSINT +IFN DECSW,[IFE SAILSW,LOC .JBAPR +.ELSE LOC JOBAPR + TSINT1] +LOC FOO + + ;DISPATCH TABLE FOR NON-SQUOZE CHARACTERS + ;REFERENCED AS DTB-40(RH OF POPJ IN GDTAB) + ;DTB ENTRY OF SYL TERMINATOR PUT IN CDISP BY GETSYL + +DSYL==400000 ;SYL OPERATOR, DISPATCH INDEXED BY RH AT GETSYL (MUST BE SIGN) +DFLD==200000 ;FIELD OPERATOR, GETFD +DWRD==100000 ;WORD OP, GETWD +DSY1==1000 ;SET ONLY IF DSYL SET, + ;SET IF OP MIGHT BE 1ST CHAR OF NONNULL SYL. +DSYL1==DSYL+DSY1 +DSY2==400 ;SET FOR _ ONLY. + +;ALL CLEAR => WORD TERMINATOR, NO DISPATCH + +DTB: DWRD,,SPACE ;40 SP, TAB, RUBOUT + DSYL1,,RRL2 ;EXCLAIM AND OPEN-BRACE + DSYL1,,DQUOTE ;" + DFLD,,XORF ;NUM SIGN + DSYL,,RBRAK2 ;CLOSE-BRACE. + 0 ;(USED TO BE PERCENT SIGN) + DFLD,,ANDF ;AMPERSAND + DSYL1,,SQUOTE ;' + DFLD,,LEFTP ;( 50 + DSYL,,RPARN ;) + DFLD,,MULTP ; STAR TIMES + DFLD,,PLS ;+ PLUS + DWRD,,COMMA ; , + DFLD,,MINUS ;- + DSYL1,,CTLAT ;^@ (56) + DFLD,,DIVID ;/ + DSYL1,,COLON ;COLON 60 + DSYL,,SEMIC ;SEMI + DFLD,,LSSTH ;< + DSYL1,,EQUAL ;= + DSYL,,GRTHN ;> + 0 ;? + DSYL1,,ATSGN ;AT SIGN + DFLD,,LBRAK ;[ + DFLD,,IORF ;BACKSLASH 70 + DSYL,,RBRAK ;] + DSYL1,,UPARR ;^ + DSYL+DSY2,,BAKAR ;BACKARR + 0 ;CR + 0 ;(USED TO BE TAB) + 0 ;ALL OTHER + DSYL,,LINEF ;LF (DSYL TO HACK CLNN) + DSYL,,FORMF ;FORM FEED (") 100 + + ;NOTE THAT POPJ P, IS VALID TEST FOR SQUOZENESS + ;EXCEPT FOR EOFCH + +GDTAB: POPJ P,56 ; ^@ GETS IGNORED. + REPEAT 2,POPJ P,76 ;(GDTAB GLOBAL SO OUT OF TS, AIO CAN CLOBBER GDTAB+141 WITH JRST RREOF + ;ON OLD FILES) +IFN .-GDTAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH GDTAB. +IFE TS,[POPJ P,76] IFN TS,[JRST RREOF] + REPEAT 5,POPJ P,76 + POPJ P,40 ; TAB + POPJ P,77 ; LF + POPJ P,76 ; VERT TAB + POPJ P,100 ; FORM FEED + POPJ P,74 ; CR + REPEAT "!-16-1,POPJ P,76 + POPJ P,40 ; SPACE + POPJ P,41 ; ! + POPJ P,42 ; " + POPJ P,43 ; # + ADD SYM,%$SQ(D) ; $ + ADD SYM,%%SQ(D) ; % + POPJ P,46 ; & + POPJ P,47 ; ' + POPJ P,50 ; ( + POPJ P,51 ; ) + POPJ P,52 ; * + POPJ P,53 ; + + POPJ P,54 ; , + POPJ P,55 ; - + JSP CH1,POINT ; . + POPJ P,57 ; / + REPEAT 10.,JSP CH2,RR2 ; DIGITS + POPJ P,60 ; : + POPJ P,61 ; ; + POPJ P,62 ; < + POPJ P,63 ; = + POPJ P,64 ; > + POPJ P,65 ; ? + POPJ P,66 ; @ +IFDEF .CRFOFF,.CRFOFF +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN + POPJ P,67 ; [ + POPJ P,70 ; \ + POPJ P,71 ; ] + POPJ P,72 ; ^ + POPJ P,73 ; _ + POPJ P,76 ; NOW LOWER CASE GRAVE ACCENT + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN +IFDEF .CRFON,.CRFON + POPJ P,41 ;{ + POPJ P,76 ;| + POPJ P,44 ;} + POPJ P,76 ;~ + POPJ P,40 ; RUBOUT, LIKE SPACE + IFN .-GDTAB-200,.ERR GDTAB LOSES + +NSQTB: IFDEF .CRFOFF,.CRFOFF +IRPC Q,,0123456789 + ADD SYM,%!Q!SQ(D) +TERMIN + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890$%. +%!Q!SQ: 0 + SQUOZE 0,Q/50/50/50/50/50 + SQUOZE 0,Q/50/50/50/50 + SQUOZE 0,Q/50/50/50 + SQUOZE 0,Q/50/50 + SQUOZE 0,Q/50 + SQUOZE 0,Q +TERMIN +IFDEF .CRFON,.CRFON + +;FORMAT TABLE(S) +;4.9-4.4 ETC SPECIFY SHIFT +;4.4-3.6 ETC SPECIFY NUMBER BITS +;FIELD SPECS IN REVERSE ORDER + +IFORTB: 0 ;NCNSN 10 , + 0 ;NCNSF 11 IMPOS + 0 ;NCNCN 12 ,, + 2200,, ;NCNCF 13 ,,C + 2200000000 ;NCFSN 14 ,B + 0 ;NCFSF 15 ,B C + 0 ;NCFCN 16 ,B, + 0 ;NCFCF 17 ,B,C + 4400000000 ;FSNSN 20 A + 0 ;FSNSF 21 IMPOS + 0 ;FSNCN 22 IMPOS + 0 ;FSNCF 23 IMPOS + 2200440000 ;FSFSN 24 A B + 2200220044 ;FSFSF 25 A B C + 270400440000 ;FSFCN 26 A B, + 2227040044 ;FSFCF 27 A B,C + 4400000000 ;FCNSN 30 A, + 0 ;FCNSF 31 IMPOS + 22220000 ;FCNCN 32 A,, + 2200002222 ;FCNCF 33 A,,B + 2200440000 ;FCFSN 34 A,B + 0 ;FCFSF 35 A,B C + 0 ;FCFCN 36 A,B, + 0 ;FCFCF 37 A,B,C +FRTBL==.-IFORTB ;LENGTH OF FORMAT TABLE +VBLK +FORTAB: BLOCK FRTBL ;ACTUAL FORMAT TABLE +FRTBE=.-1 +PBLK + +;VARIABLE STORAGE + +VBLK + +RETURN: JRST . ;RH HAS RETURN ADR FOR END OF MAJOR ROUTINE (E.G PASS 2) +CDISP: 0 ;CURRENT DISPATCH CODE +PPRIME: 0 ;PUSH DOWN LIST MARKER (GETFLD) +SCNDEP: 0 ;DEPTH IN SUCCESSFUL BRACKET CONDITIONALS INSIDE INNERMOST LITERAL. +CONDLN: 0 ;LINE NUMBER AT WHICH LAST TOP LEVEL SUCCESSFUL CONDITIONAL ENCOUNTERED +CONDPN: 0 ;PAGE NUMBER-- PRINT THESE IF REACH END AND CONDITIONAL NOT TERMINATED +CONDFI: 0 ;SIXBIT FN1 OF FILE CONTAINING LAST TOP LEVEL SUCCESSFUL CONDITIONAL. +A.SUCC: 0 ;NONZERO IFF LAST CONDITIONAL SUCCEEDED. +ASMOUT: 0 ;0 NORMAL, 1 WITHIN <>, 2 IN (), 3 IN []. +ASMDSP: ASSEM3 ;PLACE TO JUMP TO FROM ASSEM1 LOOP. + ;ASSEM3 NORMAL. ASSEMC IF WITHIN <>, () OR [] + ;AND .MLLIT ISN'T POS. LSSTHA AFTER > OR ) SEEN. + ;[ ;CONND AFTER ] SEEN. +ASMDS1: 0 ;ASMDSP SAVED HERE DURING ASCII, SIXBIT PSEUDOS. +ASSEMP: 0 ;RESTORE P FROM HERE AT ASSEM1. SAVED OVER LITERAL. +ASMI: 0 ;REINIT I AT ASSEM2 FROM ASMI. +GLSPAS: 0 ;RESTORE GLSP1 AT ASSEM1. SAVED OVER LITERAL. +GLSP1: 0 ;POINTER TO BOT OF LINKAGE TABLE IN USE HIGH ADR +GLSP2: 0 ;POINTER TO TOP OF LINKAGE TABLE IN USE LOW ADR +FORMAT: 0 ;ACCUMULATES FORMAT WORD +FORPNR: 0 ;POINTER INTO FORMAT WORD, SHOULD BE FORMAT+1 SO CLOBBERABLE BY LAST IDPB +FLDCNT: 0 ;NUMBER OF FIELDS PUSHED DOWN IN CURRENT WORD +WRD: 0 ;ACCUMULATES VALUE OF WORD +WRDRLC: 0 ;RELOC OF WRD, MUST COME RIGHT AFTER WRD. +T1: 0 ;TEMP +T2: 0 ;TEMP +PBITS1: 0 ;CURRENT CODE BITS +PBITS2: 0 ;NO OF SPECS LEFT IN CURRENT WORD +PBITS4: 0 ;POINTER TO WHERE CURRENT CODE BITS WILL GO +OPT1: 0 ;POINTER FOR STORING IN BKBUF (OUTPUT BUFFER) +CONTRL: 0 ;FLAG REG FOR IO CONTROL ETC, .GE. 0 => RELOCATABLE/1PASS +CDATBC: 0 ;CURRENT DATA BLOCK CODE TYPE +SCKSUM: 0 ;CKSUM FOR SIMPLE BLOCK FORMAT +IFN A1PSW,[ +PRGC: -1 ;ONE LESS THAN # TIMES END HAS BEEN ENCOUNTERED +OUTN1: -1 ;.GE. 0 => OUTPUT HAS OCCURED IN OTHER THAN 1PASS MODE (NOT INITIALIZED) +OUTC: -1 ;.GE. 0 => OUTPUT HAS OCCURED DURING CURRENT ASSEMBLY +] +LINKL: 0 ;SAVE LIMIT OF GLOTB GETWRD +STRCNT: 0 ;COUNT OF CHARS READ (INCL. DELIM) BY GSYL +STRPNT: 0 ;TEMP AT GSYL, BYTE POINTER TO STRING STORAGE +ISYMF: -1 ;-1 IF ISYMS HAVE NOT BEEN SPREAD +SMSRTF: -1 ;-1 IF SYMTAB HASN'T BEEN SORTED (PSEUDOS DELETED) +BITP: 0 ;BYTE PNTR TO CODE BITS IN CURRENT (RELOC) BLOCK +LDCCC: 0 ;DEPTH IN LOADTIME CONDS +PARBIT: 0 ;0 OR 4 FOR : OR = (IN GENERAL, TEMP AT P7X) +LABELF: 0 ;-1 IN COLON, SOMETIMES IN EQUAL. CAUSES 3LABEL TO BE SET. +STGSW: 0 ;NON ZERO GIVES ERROR PRINT ON STORAGE WORDS +HKALL: 0 ;NONZERO => HALF-KILL ALL LABELS (.HKALL'S VALUE) +LITSW: 0 ;-1 => USING A LITERAL GIVES AN ERROR +QMTCH: 0 ;-1 => ' AND " NEED MATCHING CLOSINGS (A LA FAIL, MACRO-10) +STARTA: 0 ;STARTING ADDRESS FOR SBLK, RIM +DECBRK: 0 ;LARGEST RELOC. ADDR. LOADED INTO. (USED FOR DEC FMT) +DECBRA: 0 ;LARGEST ABS. ADDR LOADED INTO. +DECBRH: 0 ;LIKE DECBRK BUT FOR ADDRS IN HI SEG. +DECTWO: MOVE ;NOT = MOVE => .DECTWO WAS DONE, AND THIS WD HAS + ;ADDR START OF HISEG. +ISAV: 0 ;I FROM FIELD AT AGETFLD +A.PASS: 0 ; .PASS INTSYM, # OF THIS PASS. +A.PPAS: 0 ;.PPASS INTSYM, # OF PASSES. +WPSTE: NRMWPS ;# WORDS PER SYMTAB ENTRY +WPSTE1: NRMWPS-1;ONE LESS THAN WPSTE - FOR SPEED. +WPSTEB: ,-NRMWPS(B) ;RH HAS - # WORDS PER SYMTAB ENTRY; LH HAS INDEX OF B. +SYMSIZ: 0 ;#WDS IN SYMTAB = WPS* +SYMLEN: SYMMSZ ;SYMTAB SIZE (# SYMS) + ;ASSEMBLED-IN VALUE USED AS DEFAULT, ONLY IF NON-TS. +SYMAOB: 0 ;-<# SYMS>,,0 +INICLB: 0 ;-1 IF INITIALIZATION CODE CLOBBERED. +TTYINS: 0 ;AT START OF ASSEMBLY, -1 => .INSRT TTY PASS1, -2 => PASS2 ALSO. +IFN FASLP,[ +FASBP: 0 ;PNTR TO FASL OUTPUT BUFFER +FASATP: 0 ;PNTR TO FASL ATOM TABLE +FASAT1: 0 ;PNTR TO FASL ATOM TABLE AFTER READING IN NEW ATOM + ; (MAYBE UPDATE FASATP TO THIS IF ATOM WAS UNIQUE9 +FASAT2: 0 ;BYTE PNTR USED TO STORE ATOM IN +FASIDX: 0 ;INDEX NEXT ATOM LOADED INTO FASAT WILL BE +FASPCH: 0 ;AMOUNT OF FASAT "PUNCHED" +FASCBP: 440400,,FASB ;BYTE PNTR TO FASL CODE BIT WORD +FASPWB: 0 ;FASL CODE AT PWRD +FASBLC: 0 ;LOSING BLOCK "COUNT" +FASBLS: 0 ;LOSING BLOCK "SYMBOL" +AFRLD: 0 ;LIST READ CURRENT DEPTH +AFRLEN: 0 ;LIST READ CURRENT LENGTH +AFRDTF: 0 ;LIST READ DOT CONTEXT FLAG (0 NORMAL, 1 SAW DOT, 2 SAW "FROB AFTER DOT" +AFRFTP: 0 ;LIST READ SAVED STATE OF FASATP +AFLTYP: 0 ;TYPE LIST OP IN- 0 EVAL AND THROW AWAY VALUE + ;1 "RETURN" LIST + ;2 "RETURN" VALUE OF LIST +] +PBLK + + ;INFO CONVENIENT TO ANYONE GENERATING AN OUT OF TIME-SHARING MIDAS + +;MIDAS OUT OF TIME-SHARING ASSEMBLES INTO A COLLECTION OF SUBROUTINES +;IO IS EXPECTED TO BE HANDLED BY OTHER PROGRAMS. + +;EXITS FROM THE ASSEMBLER: +;TPPB OUTPUT BINARY WORD IN A +;TFEED IF OUTPUT DEVICE IS PTP, PUNCH OUT # FRAMES OF BLANK TAPE + ;SPECIFIED BY B, MAY CLOBBER A AND B +;GO2 RETURN POINT FROM FATAL ERRORS +;TYO TYPE OUT CHARACTER IN A +;TAB TYPE OUT A TAB (MAY CLOBBER A OF COURSE) +;RCHTBL SEE THE RCH ROUTINES + +;ENTRIES + +;PDL, LPDL MAY BE USED BY COMMAND PROCESSOR BUT WILL BE CLOBBERED BY MAIN ROUTINES +;MAIN ROUTINES, CALLED WITH JSP A, , CLOBBER THE WHOLE WORLD (INCLUDING P) +;INIT INITIALIZE +;PS1 PASS 1 +;PLOD IF APPROPRIATE, PUNCH OUT LOADER +;PS2 PASS 2 (DOES ITS OWN PARTIAL INITIALIZATION) +;PSYMS PUNCH OUT SYMBOL TABLE + +;OTHER ENTRIES + +;CONTRL AFTER ASSEMBLY, .GE. 0 => RELOCATABLE, .LT. 0 => ABSOLUTE +;ISYMF -1 IF SYMS HAVE NOT BEEN SPREAD, ELSE DON'T TRY TO ADD TO INITIAL SYMBOL TABLE +;SMSRTF -1 IF SYMTAB HASN'T BEEN SORTED, ELSE SYMTAB CLOBBERED, DON'T RE-ASSEMBLE +;MIDVRS .FNAM2 OF MIDAS ENGLISH + +;SOME FF FLAGS ARE GLOBAL SO COMMAND PROCESSOR CAN KNOW WHAT'S HAPPENED ON RETURN + +;COMMAND PROCESSOR MAY ADD TO INITIAL SYMBOL TABLE BEFORE CALLING INIT THE FIRST TIME +;EISYMT IS THE FIRST LOCATION OK TO DUMP INTO +;EISYMP RH SHOULD BE SET BY COMMAND PROCESSOR TO FIRST LOC NOT DUMPED INTO +;INTSYM RH OF SYMTAB VALUE TO RETURN VALUE ADDRESSED BY LH(SYMTAB ENTRY) + +;RCH HAS AN ELABORATE SET OF GLOBALS, WHICH I DON'T FEEL LIKE PUTTING DOWN NOW, BUT THEY INCLUDE +;RCH (GET CHAR) SEMIC, RRL1, RREOF, SEMICR, SEMIC, TYPCTL, GDTAB, CPGN, CLNN, +;RCHMOD, MDSCLR, MDSSET, RCHSET, POPLMB, PSHLMB +;ALSO RCHTBL ONLY EXIT + +;LISTING FEATURE GLOBALS: +;PILPT PRINT CHAR IN A +;LISTON LISTING ON/OFF FLAG, -1 => ON +;LISTP SAME WORD AS LISTON. +;LISTP1 POSITIVE => LIST EVEN ON NON-PUNCHING PASS. +;LPTCLS END OF LISTING, PRINT FORM FEED, IF TS THEN CLOSE LPT + +;CREF FEATURE GLOBALS: +;CRFOUT OUTPUT WORD IN A. +;CREFP -1 => REQUEST GENERATION OF CREF OUTPUT. +;THE RUBOUT-B-^W HEADER, THE SET-SOURCE-FILE BLOCK, AND THE EOF BLOCK +;ARE THE RESPONSIBILITY OF THE COMMAND PROCESSOR. + +;;RCH ;CHARACTER INPUT ROUTINES + +IFN RCHASW\MACSW,[ + ;SAVE LIMBO1 STATUS AND RH(B) + ;THEN SET UP FOR NEW INPUT MODE (DESCRIPTOR IN A) + ;CALLED BY PUSHEM AND PUSHTT + +PSHLMB: HRL B,LIMBO1 ;LAST CHARACTER INPUT + TLZE FF,FLUNRD ;RE-INPUT CHARACTER ON RETURN? + XCT LSTPLM ;SET B'S SIGN; IF LISTING, JRST PSHLML. +PSHLMN: EXCH A,RCHMOD ;GET OLD MODE IN A + DPB A,[360500,,B] ;STORE IN 5 OF HIGH 6 BITS IN B + PUSH F,B ;SAVE RESULTANT CRUD + CAMN A,RCHMOD ;COMPARE NEW WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + MOVE A,RCHMOD ;NOW GET NEW MODE + JRST PSHLM1 ;SET UP INSTRUCTIONS FOR NEW MODE + +IFN LISTSW,[ +;IF LISTING, LSTPLM HOLDS JRST PSHLML +PSHLML: AOSN PNTSW + JRST PSHLMM ;LAST WAS BREAK CHR + REPEAT 4,IBP PNTBP + SOSA PNTBP +PSHLMM: SETOM LISTBC + TLO B,400000 + JRST PSHLMN +] + + ;UNDO A PSHLMB (NOTE: IN COMMENTS BELOW, "NEW" MODE IS ON PDL, OLD IN RCHMOD) + +POPLMB: POP F,A ;GET WORD THAT PSHLMB PUSHED + HLRZS A ;JUST INTERESTED IN LEFT HALF + TRZE A,400000 ;SIGN BIT SET? + TLOA FF,FLUNRD ;YES, SET FLAG TO RE-INPUT LAST CHAR + TLZA FF,FLUNRD ;NO, CLEAR FLAG. + XCT POPLML ;JFCL\IDPB A,PNTBP ;THE LATTER IFF LISTING. + SETZM LIMBO1 ;INITIALIZE FOR DPB + DPB A,[700,,LIMBO1] ;RESTORE LIMBO1 + LSH A,-<18.-6> ;RIGHT JUSTIFY RCHMOD DESCRIPTOR + CAMN A,RCHMOD ;COMPARE NEW MODE WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + JRST RCHSET ;SET UP FOR NEW MODE AND RETURN +] + + +FOO==0 ;INITIALIZE COUNTER FOR FOLLOWING + +DEFINE RCHBLT SIZE,ADR/ + MOVSI T,FOO(A) + HRRI T,ADR + BLT T,-1+ADR +FOO==FOO+ +TERMIN + +DEFINE RCHMOV ADR/ + MOVE T,FOO(A) + MOVEM T,ADR +FOO==FOO+1 +TERMIN + + ;SET UP FOR INPUT OF MODE TYPE SPECIFIED IN A, CLOBBER A ONLY + +RCHSET: MOVEM A,RCHMOD ;STORE NEW RCHMOD +PSHLM1: TLZ FF,FLMAC\FLTTY ;CLEAR FLAGS (MAYBE DEVICE ROUTINE SETS ONE) + XCT RCHTBL(A) ;GET IN A A POINTER TO A DESCRIPTOR TABLE (MAYBE ALSO SET FLAG) + PUSH P,T ;SAVE T, NEED IT FOR TEMP + RCHBLT 3,RCH2 ;FIRST 3 WORDS RCH2 + TLNE FF,FLVOT + JRST POPTJ ;ALL RCH'S TO GO THROUGH RCH, DON'T DO ANYTHING ELSE +MDSST1: RCHBLT 3,RR1 ;NEXT 3 RR1 + RCHMOV RRL1 ;NEXT WORD RRL1 +RCHPSN==FOO ;# WORDS IN ALL TABLES BUT LAST (NOT OF CONSTANT LENGTH) + RCHBLT 6,SEMIC ;LAST N SEMIC +POPTJ: POP P,T + POPJ P, + +IFN LISTSW,[ + ;SET UP TO "DISPLAY" (ALL RCH'S THROUGH RCH) + +MDSSET: TLO FF,FLVOT ;SET FLAG + MOVEI A,MDSSTB-3 ;SET UP AC + PUSH P,T ;SAVE T FOR RESTORATION + JRST MDSST1 ;NOW SET UP + +MDSSTB: JRST RRL1 ;RR1 + HALT + PUSHJ P,RCH ;RREOF + + PUSHJ P,RCH ;RRL1 +IFN .--RCHPSN,.ERR LOSSAGE AT MDSSTB. + PUSHJ P,RCH ;SEMIC + CAIE A,15 + JRST SEMIC + JRST SEMICR + + ;CLEAR OUT DISPLAY MODE + +MDSCLR: TLZ FF,FLVOT ;CLEAR FLAG + MOVE A,RCHMOD + JRST RCHSET ;NOW SET UP FOR REAL IN CURRENT MODE +] ;END IFN LISTSW, + +IFN TS,[ ;TABLE FOR RCHSET, INDEXED BY MODE + ;MAYBE THIS CONDITIONAL WANTS TO BE CHANGED TO SOMETHING ELSE + +RCHTBL: MOVEI A,RCHFIL ;0 => INPUT FROM FILE +IFN MACSW,PUSHJ P,RCHMAC ;1 => INPUT FROM MACRO (DO NOT CHANGE, USED BY MACRO PROCESSOR) +IFN RCHASW,[IFE MACSW,HALT + PUSHJ P,RCHTRC ;2 => TTY, QUIT ON CR + PUSHJ P,RCHARC ;3 => TTY, DON'T QUIT ON CR +] + ;TABLE FOR INPUTTING FROM FILE + ;MAYBE THIS CONDITIONAL ALSO WANTS TO BE CHANGED + +RCHFIL: ILDB A,UREDP ;GETCHR, GET CHARACTER + CAIG A,14 ;SKIP IF TOO BIG TO BE SPECIAL + XCT RPATAB(A) ;SPECIAL, DO THE APPROPRIATE THING + + JRST RRL1 ;RR1 + HALT + PUSHJ P,INCHR3 ;RREOF + + ILDB A,UREDP ;RRL1 +IFN .-RCHPSN-RCHFIL,.ERR RCHFIL LOSES. + LDB CH1,[360600,,UREDP] ;SEMIC; FIND WHERE IN ITS WORD UREDP POINTS + IDIVI CH1,7 + JRST @SEMIC3(CH1) ;AND ENTER THE CR-SCANNING LOOP AT THE APPROPRIATE + JFCL ;PLACE (IT IS A WORD-BY-WORD LOOP). + + ;TABLE FOR ABOVE, EXECUTED INDEXED BY CHAR, 15 ONLY FROM SEMIC ELSE ANYTHING + +RPATAB: +IFN ITSSW, JFCL ;0, ON I.T.S. IS NORMAL CHARACTER +.ELSE CALL RPANUL ;0, ON DEC SYSTEM, IGNORE IT. + JFCL + JFCL +IFN .-RPATAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH ENTRY IN RPATAB. + PUSHJ P,INCHR3 ;3, EOFCH + REPEAT 6,JFCL + CALL RPALF ;LINE FEED + JFCL ;13 + PUSHJ P,RPAFF ;FORM FEED + JRST SEMICR ;FROM SEMIC ONLY, EXIT FROM LOOP + +RPAFF: SKIPE ASMOUT ;FORM FEED + ETR [ASCIZ/Formfeed within <>, () or []/] + AOS CH1,CPGN + SETOM CLNN +IFN ITSSW,[ + ADD CH1,[SIXBIT /P0/+1] + MOVE CH2,A.PASS + DPB CH2,[300200,,CH1] + .SUSET [.SWHO3,,CH1] ;PUT THE NEW PAGE # IN THE WHO-LINE. +] +RPALF: AOS CH2,CLNN + CAME CH2,A.STPLN + RET + MOVE CH1,CPGN + CAMN CH1,A.STPPG + SETOM TTYBRF + RET + +IFN DECSW,[ +RPANUL: MOVE CH1,@UREDP ;SAW A NULL - IN A LINE NUMBER? + TRNN CH1,1 + JRST RCHTRA ;NO, JUST IGNORE IT. + MOVEI CH1,010700 + HRLM CH1,UREDP ;YES, SKIP THIS WHOLE WORD, THEN + CALL RCH ;SKIP THE 1ST CHAR AFTER THE LINE NUMBER + JRST RCHTRA ;RETURN THE NEXT CHAR FROM THIS CALL TO RCH. +] +] ;END IFN TS, + +VBLK +LIMBO1: 0 ;LAST CHARACTER READ BY RCH +RCHMOD: 0 ;CURRENT INPUT MODE, 0 => INPUT FROM FILE, 1 => MACRO, ETC. +CLNN: 0 ;1 LESS THAN LINE # IN CURRENT INPUT FILE. +CPGN: 0 ;1 LESS THAN PAGE # IN CURRENT INPUT FILE +A.STPL: 0 ;1 LESS THAN LINE # TO STOP AT. +A.STPP: 0 ;1 LESS THAN PAGE # TO STOP AT. + ;(STOPPING MEANS INSERTING THE TTY) + +;READ CHARACTER INTO A FROM INPUT FILE, MACRO, OR WHATEVER (RCH) +;CLOBBERS A,CH1,CH2. + +RCH: TLZE FF,FLUNRD + JRST RCH1 ;RE-INPUT LAST ONE MAYBE GET HERE FROM RCH2+2 +RCH2: HALT ;ILDB A,UREDP ;ILDB A,CPTR ;GET CHAR + 0 ;CAIG A,14 ;TRZE A,200 ;CHECK FOR SPECIAL + 0 ;XCT RPATAB(A) ;PUSHJ P,MACTRM ;SPECIAL, PROCESS + MOVEM A,LIMBO1 ;GOT CHAR, SAVE AS LAST CHAR GOTTEN +IFE TS,RCHLS1==JRST TYPCTL +IFN TS,RCHLS1==RET ;DEFAULT CONTENTS OF RCHLST (IF NOT LISTING) +RCHLST: RCHLS1 ;AOSN PNTSW IF LISTING. +IFN LISTSW,[ + PUSHJ P,PNTR + CAIG A,15 + JRST RCHL1 +RCHL3: IDPB A,PNTBP +TYPCTL: POPJ P, ;OR JRST SOMEWHERE +PBLK + +RCHL1: CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + JRST RCHL3 +RCHL2: MOVEM A,LISTBC + SETOM PNTSW + JRST TYPCTL + +VBLK +RCH1: MOVE A,LIMBO1 +RCH1LS: RET ;OR CAILE A,15 IF LISTING. + RET ;NEEDED IN CASE LISTING. + CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + POPJ P, + JRST RCHL2 +PBLK +] ;END IFN LISTSW, + +IFE LISTSW,[ +PBLK +RCH1: MOVE A,LIMBO1 + RET +] ;END IFE LISTSW, + +;;GETSYL ;VARIOUS SYLLABLE READING ROUTINES (BUT NOT ALL OF THEM) + +GSYL: CLEARB SYM,STRCNT +GSYL1: MOVEI D,6 + MOVE T,[440700,,STRSTO] + MOVEM T,STRPNT +GSYL3: AOSG A,STRCNT + JRST (F) + PUSHJ P,RCH + IDPB A,STRPNT ;STORE CHAR IN STRING EVEN IF DELIMITER (MINIMUM STRCNT = 1) +A.GSY2: CAIN A,". + JRST GSYL1C + HLRZ CH1,GDTAB(A) + CAIN CH1,(JSP CH2,) + JRST GSYL1A ;NUMBER + PUSHJ P,GSYL1B ;RETURN ONLY ON SYL SEP + HRRZ A,GDTAB(A) + MOVE T,LIMBO1 +C%: POPJ P,"% + +GSYL1B: XCT GDTAB(A) ;POPJ FOR SYL SEPS + SUB P,[1,,1] +GSYL1D: SOJGE D,GSYL3 + AOJA D,GSYL3 + +GSYL1C: ADD SYM,%.SQ(D) + JRST GSYL1D + +GSYL1A: XCT NSQTB-60(A) + JRST GSYL1D + + ;VERSION OF GETSYL TO TRY UNTIL SYL OR WORD TERMINATOR FOUND + ;SKIPS IF NAME THERE (FOR .TYPE, SQUOZE) + +GTSLD2: TLNN C,DWRD\DFLD + JRST GTSLD3 ;DELIMITER IS WORD TERMINATOR, TOLERATE THE NULL SYLLABLE +GETSLD: PUSHJ P,GETSYL ;ENTRY, GET A SYL + MOVE C,CDISP ;GET CDISP + TRNN I,IRSYL + JRST GTSLD2 ;NO SYL + AOS (P) ;GOT SYL, CAUSE RETURN TO SKIP +GTSLD3: TLNN C,DWRD\DFLD + TLO FF,FLUNRD ;CAUSE DELIMITER TO BE RE-INPUT + POPJ P, + +PASSPS: SKIPA A,LIMBO1 +GPASST: CALL RCH + CAIE A,40 + CAIN A,^I + JRST GPASST + RET + +GETSYL: TLZ I,ILUARI+ILNPRC+ILLSRT +GTSL1: CLEARB SYM,NUMTAB ;RECUR HERE FOR RIGHT ARG TO ^ AND _. + MOVE AA,[NUMTAB,,NUMTAB+1] + AOSN NTCLF + BLT AA,NUMTAB+10 ;NUMTAB NOT CLEAR, HAVE TO CLEAR IT + MOVEI D,6 ;CHARACTER COUNTER FOR BUILDING UP SYM + SETOM ESBK ;NO SPECIFIC BLOCK DESIRED. + TDZ I,[ILDECP+ILFLO+ILVAR+ILGLI,,IRPERI+IRLET+IRSYL] +RRL2: PUSHJ P,RR ;CALL MAIN LOOP ROUTINE, READ UNTIL NON-SQUOZE CHAR +SEMICR: ;RETURN HERE FROM SEMIC WITH CR IN A + MOVEM A,LIMBO1 ;SYLLABLE OPERATOR OR TERMINATOR IN A, SAVE + HRRZ A,GDTAB(A) ;NOW GET RIGHT HALF OF POPJ, INDEX INTO DTB + MOVE C,DTB-40(A) ;GET DTB ENTRY (FLAGS,,JUMP ADR) + MOVEM C,CDISP ;STORE AS DISPATCH CODE FOR LAST CHAR (SORT OF AN INTERPRETED LIMBO1) +RR8: TLNE C,DSYL ;NOW SEE IF SYL OPERATOR FLAG SET + JRST (C) ;SET => INTRA-SYLLABLE OPERATOR +RR10: TRNE I,IRLET ;NOT SET => SYLLABLE TERMINATOR: SYL? + POPJ P, ;SYL HAS LETTERS + TRNN I,IRSYL + JRST CABPOP ;NO SYL + CAMN SYM,[SQUOZE 0,.] + JRST PT1 ;SYM IS . + ;NUMBER + +RR5: TLNN I,ILNPRC + PUSHJ P,NUMSL + TLNN I,ILFLO + JRST RR9 ;NOT FLOATING POINT + MOVE A,B ;FLOATING, HIGH IN AA,LOW IN A,EXP IN B + ADDI A,306 ;201+105 TO ROUND + ADDI AA,200 ;CAUSE EXPONENT TO BE ACCEPTABLE TO MACHINE + JUMPGE AA,.+3 ;NOW CHECK FOR OVERFLOW ON ROUNDING + LSH AA,-1 ;OVERFLOW, SHIFT BACK ONE + AOS A ;INCREMENT EXPONENT TO COMPENSATE FOR SHIFT + EXCH A,AA ;GET EXPONENT IN AA, REST IN A + ASHC AA,-10 ;SHIFT TO MACHINE FLOATING POINT FORMAT + SKIPE AA ;NOW CHECK HIGH ORDER BITS OF EXPONENT NOT SHIFTED INTO NUMBER + ETR [ASCIZ /Exponent overflow/] +RR9: TLZ I,ILGLI+ILVAR ;NOT TRYING TO DEFINE NUMBER AS VARIABLE OR GLOBAL +CLBPOP: TDZA B,B ;CLEAR OUT B (RELOCATION BITS OF VALUE) +CABPOP: SETZB A,B ;DO JRST CABPOP TO RETURN ZERO AS VALUE + POPJ P, + +RRU: MOVE A,LIMBO1 ;GET HERE WHEN FLUNRD SET AT RR, RETRIEVE CHARACTER FROM LIMBO1 + CAIG A,14 ;IF TOO BIG, + CAIGE A,12 ;OR IF TOO SMALL, + JRST RR1B ;THEN JUST FALL BACK IN + TLNN FF,FLVOT\FLMAC\FLTTY ;SKIP IF NOT HACKING CPGN/CLNN + XCT RRUTAB-12(A) ;HACKING, UNHACK FOR HACK COMING UP + JRST RR1B ;FALL BACK IN + +RRUTAB: SOS CLNN ;LINE FEED (TABLE FOR RRU) + JRST RR1B ;13 + SOS CPGN ;FORM FEED + + ;MAIN LOOP ROUTINE FOR GETSYL, READ SYM OR NUMBER +VBLK +RR: TLZE FF,FLUNRD ;RE-INPUT LAST CHARACTER? + JRST RRU ;YES (SOMETIMES RETURN HERE FROM RREOF) +RR1: JRST RRL1 ;ILDB A,CPTR ;GET CHAR (" " ") + HALT ;TRZE A,200 ;CHECK FOR END OF STRING +RREOF: PUSHJ P,RCH ;PUSHJ P,MACTRM ;PROCESS CONDITION, GET NEXT CHAR OR JRST RR1 OR RR1-1 +RR1B: XCT GDTAB(A) ;GOT CHAR, DO SOMETHING APPROPRIATE (POPJ ON NOT SQUOZE) + TROA I,IRLET\IRSYL ;LETTERS RETURN, JUST UPDATED SYM, SET FLAGS + TRO I,IRSYL ;NUMBERS RETURN, SET FEWER FLAGS + SOJGE D,RR1 ;DECREMENT SYM COUNTER AND LOOP + AOJA D,RR1 ;COUNTER EXHAUSTED, INCREMENT BACK TO 0 AND LOOP + +RRL1: PUSHJ P,RCH ;ILDB A,UREDP ;GET CHAR + XCT GDTAB(A) ;NOW MAKE LIKE RR1B (EOFCH => JRST RREOF) + TROA I,IRLET\IRSYL + TRO I,IRSYL + SOJGE D,RRL1 + AOJA D,RRL1 + + ;SEMICOLON (GET HERE FROM RR8) + + JRST SEMICL ;RETURN HERE FROM SEMIC+2 WHEN FLUNRD SET +;NEXT 4 INSNS ALTERED IN DIFFERENT INPUT MODES. SEE RCHFIL, ETC. +SEMIC: PUSHJ P,RCH ;GET CHAR + CAIE A,15 ;SEE IF SPECIAL + JRST SEMIC ;SPECIAL => DO SOMETHING (JRST SEMICR ON CR) + JRST SEMICR ;IF NOT SPECIAL THEN GO BACK FOR NEXT CHAR + +LOC SEMIC+6 ;LEAVE A LITTLE EXTRA ROOM FOR BIG ROUTINES +PBLK + +SEMICL: MOVE A,LIMBO1 ;HERE FROM SEMIC-1, RETRIEVE CHARACTER FROM LIMBO1 + CAIE A,15 ;SKIP IF SHOULD TERMINATE SCAN + JRST SEMIC ;NOT CR, FALL BACK IN + JRST SEMICR ;DONE + +SEMIC2: +REPEAT 5,[ + ILDB A,UREDP + CAIG A,15 + XCT RPATAB(A) +] + MOVE A,[ASCII /@@@@@/] +SEMIC1: AOS CH1,UREDP + MOVE CH1,(CH1) ;ANY CONTROL CHARS IN THE WORD UREDP POINTS AT? + MOVE CH2,CH1 + AND CH1,A + AND CH2,[ASCII/ /] + LSH CH2,1 + IOR CH1,CH2 + CAMN CH1,A + JRST SEMIC1 ;NO, ADVANCE TO NEXT WORD AND TEST IT. + MOVEI A,440700 + HRLM A,UREDP + JRST SEMIC2 ;YES, LOOK AT EACH CHAR AND PROCESS IT. + +SEMIC3: REPEAT 6,JRST SEMIC2+3*<5-.RPCNT> + + + + ;JSP CH2,RR2 => DIGIT (FROM GDTAB) + ;THIS ROUTINE IS GROSSLY SLOW, AND SHOULD BE SPEEDED UP SOMETIME + +RR2: XCT NSQTB-"0(A) ;UPDATE SQUOZE. + TRNE I,IRLET + JRST 1(CH2) ;SYL IS SYM, DON'T WASTE TIME. + TRNE I,IRPERI + TLO I,ILFLO ;DIGIT AFTER . => FLOATING. +MAKNUM: SETOM NTCLF ;NUMTAB ABOUT TO NOT BE CLEAR, SET FLAG FOR GETSYL TO CLEAR IT OUT NEXT TIME + MOVEI AA,2 ;INDEX INTO NUMTAB ETC., SOJGE'D TO GET ALL RADICES +MAKNM1: MOVE T,ARADIX(AA) ;GET THIS RADIX, + CAMN T,ARADIX ;REDUNDANT => SKIP THIS PASS. + JUMPN AA,MAKNM4 + SKIPGE CH1,HIGHPT(AA) + JRST MAKNM3 + MUL T,LOWPT(AA) ;TT HAS OLD LOW TIMES RADIX, T HAS OVFLO TO HIGH. + ADDI TT,-"0(A) ;ADD DIGIT TO LOW PART + TLZE TT,400000 + AOJ T, ;OVERFLOW, INCREMENT SPILLOVER FROM MUL OF LOWPT + JUMPE CH1,MAKNM5 ;OLG HIGHPT WAS 0 => SAVE TIME. + JFCL 17,.+1 ;NOW CLEAR OV, ETC. + IMUL CH1,ARADIX(AA) ;MULTIPLY HIGHPT BY RADIX + ADD T,CH1 ;ADD HIGH PARTS + JFCL 10,MAKNM2 ;JUMP ON OVERFLOW FROM IMUL OR ADD +MAKNM5: TLNE I,ILFLO + SOS NUMTAB(AA) ;FLOATING, DECREMENT EXP TO COMPENSATE FOR MULT OF HIGHPT/LOWPT + MOVEM T,HIGHPT(AA) ;NOW STORE STUFF BACK + MOVEM TT,LOWPT(AA) +MAKNM4: SOJGE AA,MAKNM1 ;NOW DO ALL THIS FOR NEXT RADIX + JRST 1(CH2) + +MAKNM2: MOVSI B,400000 ;OVERFLOW FROM UPDATING HIGH PARTS + IORM B,HIGHPT(AA) ;SET SIGN BIT +MAKNM3: TLNN I,ILFLO + AOS NUMTAB(AA) ;NOT FLOATING, INCREMENT EXP, MAY NOT WANT TRAILING BITS + JRST MAKNM4 + +VBLK +NUMTAB: 0 ;EXPONENT + 0 + 0 +HIGHPT: 0 ;HIGH PART OF CURRENT NUMBER THIS RADIX + 0 ;4.9 => OVERFLOW, TRAILING DIGITS DROPPED + 0 +LOWPT: 0 ;LOW PART OF CURRENT NUMBER THIS RADIX + 0 ;HIGHPT/LOWPT TAKEN AS 70. BIT POSITIVE INTEGER EXCEPT 4.9(HIGHPT) IS FLAG INSTEAD OF + 0 ;EXPONENTIATE 70. BIT INTEGER BY NUMTAB (WHICH MAY BE NEGATIVE) TO GET ACTUAL VALUE +ARADIX: 10 ;CURRENT RADIX + 12 + 10 + +NTCLF: -1 ;-1 => NUMTAB NOT CLEAR (TO SAVE BLT AT GETSYL WHEN CLEAR) +PBLK + + ;JRST POINT => . (FROM GDTAB) + +POINT: TLO I,ILDECP ;PREFER DECIMAL + TROE I,IRPERI ;SET PERIOD FLAG + TRO I,IRLET ;2 POINTS => NAME + ADD SYM,%.SQ(D) ;UPDATE SYM + JRST 1(CH1) ;RETURN + +RBRAK: SOSL SCNDEP ;IF A CONDITIONAL TO TERMINATE, + JRST RBRAK2 ;HAVE DONE SO, IGNORE CHAR. + SETZM SCNDEP +;CLOSES OF ALL KINDS COME HERE. +RPARN: +GRTHN: MOVE A,LIMBO1 + SKIPE CH1,ASMOUT ;WHAT KIND OF OPEN ARE WE IN? + CAIN CH1,4 ;WITHIN A .ASCII OR + JRST RBRAK1 ;NOT WITHIN GROUPING => THIS CLOSE IS STRAY. + CAME A,ASMOT1(CH1) ;RIGHT KIND OF CLOSE FOR THAT OPEN? + ERJ RBRAK3 +RBRAK4: MOVE CH1,ASMOT2(CH1) + MOVEM CH1,ASMDSP ;ARRANGE FOR THIS ASSEM1 LEVEL TO EXIT +RBRAK5: SETZM CDISP + JRST RR10 ;AND GO TERMINATE WORD. + +RBRAK3: CALL TYOERR ;COME HERE ON CLOSE WRONG FOR OPEN. + ;(EG, ")" MATCHING "<"). + TYPR [ASCIZ/ Seen when /] + MOVE A,ASMOT1(CH1) + CALL TYOERR + TYPR [ASCIZ/ expected +/] + JRST RBRAK4 + +RBRAK1: CAIN CH1,4 ;CLOSE INSIDE A .ASCII => + JRST RBRAK5 ;TERMINATE WORD BUT DON'T CLOSE ANYTHING. + SKIPN CONSML ;COME HERE FOR STRAY CLOSE. + JRST RRL2 + ERJ .+1 + TYPR [ASCIZ/Stray /] + MOVE A,LIMBO1 ;GET THE CLOSE WE SAW. + CALL TYOERR + CALL CRRERR + JRST RRL2 + +;COME HERE FOR CLOSE-BRACE, AND CERTAIN CLOSE-BRACKETS. +RBRAK2: SETOM A.SUCC ;HAVE JUST ENDED SUCCESSFUL BRACKETED CONDIT, + JRST RRL2 ;REMEMBER THAT MOST RECENT CONDITIONAL WAS TRUE. + +FORMF: TLNN FF,FLVOT\FLMAC\FLTTY ;FORM FEED SYLLABLE OPERATOR ROUTINE + PUSHJ P,RPAFF ;UNLESS ALREADY DONE, INCREMENT PAGE #. + JRST RR10 + +LINEF: TLNN FF,FLVOT\FLMAC\FLTTY ;LINE FEED SYLLABLE OPERATOR ROUTINE + CALL RPALF + JRST RR10 + +CTLAT: +IFN DECSW,[ + TLNN FF,FLVOT\FLMAC\FLTTY ;^@ SYLLABLE OPERATOR ROUTINE. + CALL RPANUL +] + JRST RRL2 + + ;DECIPHER A VALUE FROM NUMTABS + ;LEAVES HIGH PART IN AA, LOW PART IN A, BINARY EXPONENT IN B + ;AND RADIX USED IN D. + +NUMSL: TLNN I,ILVAR\ILDECP\ILFLO + SKIPE B,HIGHPT + JRST NUMSLS + MOVE A,LOWPT ;BE VERY FAST IN CASE OF SMALL FIXNUM IN CURRENT RADIX. + MOVE D,ARADIX ;SAVE RADIX AND HIGH PART FOR ^. + SETZ AA, + RET + +NUMSLS: CLEARB TT,D ;TT BIT EXPONENT, D INDEX INTO NUMTAB, ETC. + TLNE I,ILDECP+ILVAR ;NEITHER . NOR ', CURRENT RADIX. + TLNE I,ILGLI ;" => CURRENT RADIX DESPITE . OR '. + JRST NUMSL0 + MOVEI D,1 ;DECIMAL UNLESS ' + TLNE I,ILVAR ;WHICH FORCES OCTAL. + MOVEI D,2 + MOVE A,ARADIX(D) + CAMN A,ARADIX ;IF REALLY SAME AS CURRENT RADIX, + MOVEI D,0 ;COMPUTATION WASN'T DONE FOR THIS VALUE OF D, + ;SO USE COMPUTATIONS DONE FOR CURRENT RADIX. +NUMSL0: MOVE AA,HIGHPT(D) ;AA := HIGH PART + MOVE B,LOWPT(D) ;B := LOW PART + MOVE T,NUMTAB(D) ;T := EXPONENT + MOVE D,ARADIX(D) ;NO LONGER NEED IDX, GET RADIX VALUE. + TLNN I,ILFLO + JRST FIXNUM ;NOT FLOATING + TLZ AA,400000 ;FLOATING, DON'T NEED DIGITS LOST ON OVERFLOW +NUMC1: JUMPN AA,.+2 ;ENTRY FROM UPARR + JUMPE B,FIX0 ;COMPLETELY ZERO => RETURN FIXED ZERO + JUMPL T,NUMSL1 ;JUMP IF EXPONENT NEGATIVE + JUMPE T,NUMSL2 ;JUMP (SKIP FOLLOWING) IF EXPONENT ZERO + ;EXPONENT POSITIVE, DO THE APPROPRIATE THING +NUMSL5: MULI B,(D) ;MULITIPLY LOW PART BY RADIX + MULI AA,(D) ;MULTIPLY HIGH PART BY RADIX + ADD A,B ;A := LOW PART OF HIGH + HIGH PART OF LOW + TLZE A,400000 + ADDI AA,1 ;OVERFLOW ON ADDITION, INCREMENT HIGH PART OF HIGH + MOVE B,C ;NO LONGER NEED HIGH OF LOW, GET LOW OF LOW IN B +NUMSL3: JUMPE AA,NUMSL4 ;NOW CHECK FOR OVERFLOW INTO HIGH OF HIGH, JUMP ON NONE + ASHC A,-1 ;NEXT THREE INSTRUCTIONS TO DO ASH3 AA,-1 + ASH A,1 + ASHC AA,-1 + AOJA TT,NUMSL3 ;INCREMENT BIT EXPONENT AND TRY AGAIN + +NUMSL4: MOVE AA,A ;FLUSHED OVERFLOW, NOW GET (LOW PART OF) HIGH PART IN AA + SOJG T,NUMSL5 ;COUNT DOWN + +NUMSL2: TLNN I,ILFLO + JRST NUMSL9 ;NOT FLOATING, DON'T WASTE TIME NORMALIZING. + SKIPA A,B ;EXPONENT NOW ZERO, GET LOW PART OF NUMBER IN A +NUMSL7: ASHC AA,1 ;NOW NORMALIZE + TLNN AA,200000 + SOJA TT,NUMSL7 + SKIPA B,TT ;DONE NORMALIZING, RETURN BINARY EXPONENT IN B +PT1: TRO I,IRLET + POPJ P, + +NUMSL9: MOVE A,B + MOVEI B,0 + ASHC AA,(TT) ;SHIFT 2-WD NUM. BY EXPONENT, + LSH A,1 ;PUT HIGH BIT IN WITH REST. + JRST FIX1 + +FIX0: TLZ I,ILFLO +FIXNUM: LSHC A,45 +FIX1: LSHC AA,-1 + JUMPE AA,.+2 + ETR [ASCIZ /FIXNUM too big for 36 bits/] + POPJ P, + +NUMSL1: SKIPA A,B ;EXPONENT NEGATIVE: NORMALIZE NOW +NUMSL8: ASHC AA,1 +NUMSL6: TLNN AA,200000 + SOJA TT,NUMSL8 ;NOT NORMALIZED YET + AOS T + MOVEI TM,(D) + TLNN TM,-1 ;GET CONVIENT POWER OF RADIX + JUMPL T,[ IMULI TM,(D) + AOJA T,.-1] + MOVE B,A ;GET NORMALIZED LOW PART IN B + IDIV AA,TM ;DIVIDE HIGH PART BY APPROPRIATE RADIX + DIV A,TM + JUMPL T,NUMSL6 + MOVE B,A + JRST NUMSL2 + +UPARR: TRON I,IRSYL + JRST UPCTRC ;"UNARY UPARROW" => GOBBLE CHARS + TRNE I,IRLET + ETR [ASCIZ /Symbolic 1st arg to "^"/] + PUSHJ P,NUMSL ;DECIPHER NUMTABS + PUSHJ P,UA3 ;GET RIGHT OPERAND IN T + MOVE TT,B ;EXPONENT + MOVE B,A ;LOW PART + PUSHJ P,NUMC1 ;T EXP HIGH IN AA LOW IN B TT BIN EXP + MOVE C,CDISP ;IF A _ WAS DEFERRED WHILE ILUARI WAS SET, + TLO I,ILNPRC + CAME C,[DSYL,,BAKAR] ;DO IT NOW. + JRST RR10 + +BAKAR: TLNE I,ILUARI + JRST RR5 ;RETURN TO UPARROW (WILL COME BACK HERE LATER) + TRNE I,IRSYL + TRNE I,IRLET + JRST BAK1 ;NO SYL, OR SYL IS NAME + CAMN SYM,[SQUOZE 0,.] + JRST BAK1 ;. ALSO NAME + TLZN I,ILNPRC + PUSHJ P,NUMSL + PUSHJ P,UA3 + ADD B,T + ASHC AA,(B) + LSH A,1 + LSHC AA,-1 + CLEARB B,AA + TLZ I,ILFLO + MOVE C,[DFLD,,CBAKAR] + EXCH C,CDISP ;IF 2ND ARG ENDED WITH A _, TURN INTO FIELD OP. + CAME C,[DSYL,,BAKAR] + EXCH C,CDISP + POPJ P, + +UPCTRC: SETZ T, +UPCTR1: JSP F,QOTCOM ;UP ARROW TO GOBBLE SYL AND RETURN MASKED ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + ANDI A,77 ;NOW MASK CHARACTER IN TO TO BOTTOM 6 BITS + ADD T,A ;ADD TO ACCUMULATED + POPJ P, + +BAK1: MOVE TT,[DFLD,,CBAKAR] + MOVEM TT,CDISP + JRST RR10 + +UA3: HRLM D,(P) ;SAVE RADIX (FOR UPARR) + JSP LINK,SGTSY ;PUSH I,AA,A,B + TLO I,ILUARI ;TELL _ TO WAIT TILL LATER (SEE UPARR, BAKARR) + PUSHJ P,RCH + CAIN A,"- + TROA I,IRGMNS + TLO FF,FLUNRD + PUSHJ P,RCH + CAIN A,"< + JRST UAR1 + TLO FF,FLUNRD +UA3L: PUSHJ P,GTSL1 ;GOBBLE SYL, LOOP POINT FOR PSEUDO OR MACRO RETURNED WITHOUT VALUE + TRNE I,IRLET + JRST UA3S ;NAME + TLNE I,ILFLO + ETR [ASCIZ /Floating point 2nd arg to "_"/] +UAR2: TRZN I,IRGMNS + SKIPA T,A + MOVN T,A + JSP LINK,SGTSY1 ;RESTORE GETSYL TEMPS. + HLRZ D,(P) + POPJ P, + +UA3S: PUSHJ P,GETVAL ;MAKE NUMBER_NAME WORK + JRST UA3SR ;GOT VALUE, PROCESS + JRST UA3L ;NO VALUE, TRY AGAIN + +UAR1: TLO I,ILLSRT + TRZ I,IRSYL ;(OR ELSE LSSTH GIVES NOS ERROR.) + SETZB A,B + PUSHJ P,LSSTH +UA3SR: JUMPN B,RLCERR ;RELOC ERR + JRST UAR2 + +ATSGN: MOVSI A,20 ;ATSIGN + IORM A,WRD + TRO I,IRFLD ;SET IRFLD FLAG EVEN THOUGH NOT DIRECTLY RETURNING VALUE + ; ^ CHANGED FROM SYL TO FIELD 9/6/70 + JRST RRL2 ;FALL BACK IN + +DQUOTE: TRON I,IRSYL + JRST DQUOT8 + TRNN I,IRLET ;AFTER NUMBER => CURRENT RADIX. + JRST DQUOT7 + PUSHJ P,RCH + TLO FF,FLUNRD ;NEXT CHAR. SQUOZE? + HLRZ A,GDTAB(A) + CAIN A,(POPJ P,) + JRST DQUOT7 ;NO => MAKE PREV. SYM. GLOBAL. + CAMN SYM,[SQUOZE 0,.M] ;SPECIAL BLOCK NAMES + JRST DQUOTM ;.M MEANS MAIN BLOCK, + CAMN SYM,[SQUOZE 0,.U] + JRST DQUOTU ;.U MEANS SUPERIOR. + CAMN SYM,[SQUOZE 0,.C] + JRST DQUOTC ;.C MEANS CURRENT BLOCK. + SKIPGE A,ESBK ;GET SPEC'D BLOCK OR CURRENT, + HRR A,BKCUR ;LOOK FOR SUBBLOCK OF THAT BLOCK. + HLL A,BKTAB+1(A) + ADD A,[1,,] ;LH HAS LEVEL SUBBLOCK OUGHT TO HAVE. + MOVEI T,0 + SETO D, ;NO POSSIBLE ALTERNATE CHOICE YET. +DQUOT0: CAME SYM,BKTAB(T) ;LOOK AT ALL BLOCKS SEEN. + JRST DQUOT1 ;HAS THE NAME WE'RE LOOKING FOR? + SKIPGE ESBK ;IF LOOKING FOR A SUBBLOCK OF A PARTICULAR BLOCK, + JRST DQUOT4 + CAMN A,BKTAB+1(T) + JRST DQUOT2 ;SUCH A BLOCK WINS; ALL OTHERS LOSE. + JRST DQUOT1 + +DQUOT4: SKIPN BKTAB+2(T) ;ELSE PREFER DEFINED BLOCKS TO UNDEFINED ONES. + JUMPGE D,DQUOT1 + SKIPE BKTAB+2(T) + JUMPL D,DQUOT5 + CAME D,[-1] ;THAT'S THE SAME EITHER WAY => PREFER AN INFERIOR + CAMN A,BKTAB+1(T) ;OF THE CURRENT BLOCK TO ONE THAT'S NOT. + JRST DQUOT5 + JRST DQUOT1 + +DQUOT5: HRROI D,(T) ;FOUND A BLOCK WE LIKE BEST SO FAR. + SKIPE BKTAB+2(T) + ANDI D,-1 ;LEAVE SIGN OF D SET UNLESS THE BLOCK IS DEFINED. +DQUOT1: ADDI T,BKWPB + CAMGE T,BKTABP + JRST DQUOT0 + HRRZI T,(D) ;NOW USE THE BEST BLOCK FOUND, IF THERE WAS ONE. + CAIE T,-1 + JRST DQUOT2 + MOVE T,BKTABP ;NOT FOUND, GET IDX OF 1ST UNUSED ENTRY. + CAIL T,BKTABS + ETF ERRTMB ;NO ROOM FOR MORE BLOCKS. + MOVEM SYM,BKTAB(T) + MOVEM A,BKTAB+1(T) ;ADD BLOCK AT END. + MOVEI A,BKWPB(T) + MOVEM A,BKTABP ;POINTS AFTER LAST USED ENTRY. +DQUOT2: MOVEM T,ESBK + SETZ SYM, +DQUOT3: MOVEI D,6 ;NEXT CHAR GOES IN 1ST SQUOZE POS. + JRST RRL2 + +DQUOTM: MOVEI T,BKWPB ;.M - MAIN BLOCK FOLLOWS INITIAL SYMS BLOCK. + JRST DQUOT2 + +DQUOTU: SKIPGE T,ESBK ;.U SPEC'D - GET SPEC'D OR CURRENT BLOCK, + MOVE T,BKCUR + HRRZ T,BKTAB+1(T) + JRST DQUOT2 ;SPEC. ITS SUPERIOR. + +DQUOTC: SKIPGE T,ESBK ;.C => SPEC THE CURRENT BLOCK. + MOVE T,BKCUR + JRST DQUOT2 + +SQUOT1: TLOA I,ILVAR +DQUOT7: TLO I,ILGLI + MOVE A,BKCUR ;IF NO SPEC'D BLOCK, + SKIPGE ESBK + MOVEM A,ESBK ;SPEC. CURRENT BLOCK. + JRST RRL2 + +DQUOT8: SETZ T, +DQUOT9: JSP F,QOTCON ;DOUBLE QUOTE TO GOBBLE SYL AND RETURN ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + ADD T,A ;ADD IN ASCII CHARACTER IN A + POPJ P, ;RETURN TO SOMETHING + +SQUOTE: TROE I,IRSYL + JRST SQUOT1 + SETZ T, +SQUOT9: JSP F,QOTCON ;SIXBIT SYL + CAIGE A,40 + ETR ERRN6B ;NOT SIXBIT + CAIL A,140 + SUBI A,40 ;CONVERT TO UPPER CASE + LSH T,6 ;SHIFT OVER ACCUMULATED VALUE + ADDI T,-40(A) ;ADD IN SIXBIT FOR CHARACTER IN A + POPJ P, + +;COMMON ROUTINE FOR RIGHT JUSTIFIED TEXT SYLS +;CALLED WITH JSP F,; ROUTINE PUSHJ'S BACK W/ CHAR IN T, ACCUM VALUE IN A +;SYL FLAG EXPECTED TO BE ALREADY SET +QOTCON: SKIPE QMTCH ;' AND " COME HERE, BUT NOT ^: IF IN QUOTES-MATCHING MODE, USE A + JRST QOTCO4 ;FAIL-LIKE ALGORITHM. HERE FOLLOWS THE OLD MIDAS WAY OF DOING IT +QOTCOM: CALL RCH ;USE AT LEAST 1 CHAR IN ANY CASE. + JRST QOTCO1 + +QOTCO2: CALL RCH ;USE SUCCEEDING CHARS IF SQUOZE CHARS. + HLRZ CH1,GDTAB(A) + CAIN CH1,(POPJ P,) + JRST QOTCO3 +QOTCO1: CALL (F) + JRST QOTCO2 + +QOTCO3: CAIN A,"" ;NONSQUOZE: IF IT IS A TEXT SYL INDICATOR, + JRST DQUOT9 ;CONTINUE WITH WHATEVER TYPE OF TEXT + CAIN A,"' + JRST SQUOT9 ;IT INDICATES. + CAIN A,"^ + JRST UPCTR1 +QOTCO6: TLO FF,FLUNRD + JRST TEXT5 + +QOTCO4: MOVE B,LIMBO1 ;GET ' OR ", WHICHEVER STARTED THIS SYL, AS THE DELIMITER. + MOVE SYM,[SQUOZE 0,TEXT] + JSP TM,ERMARK +QOTCO5: CALL RCH + CAMN A,B ;FOUND ANOTHER EXAMPLE OF THE DELIMITER? + JRST [ CALL RCH ;IF DUPLICATED, IT PUTS THE DELIMITER IN THE CONSTANT. + CAMN A,B + JRST .+1 + JRST QOTCO6] ;OTHERWISE UNREAD THE CHAR AFTER THE DELIMITER AND EXIT. + CALL (F) ;HAVE CHAR TO PUT IN STRING IN A; GO MERGE IT IN. + JRST QOTCO5 + +;RETURN A VALUE FROM A PSEUDO WHOSE ARGS CAN BE TERMINATED BY EITHER COMMA (GOBBLED) +;OR CR (NOT GOBBLED). +VALRET: MOVE T,A ;ROUTINE TO RETURN VALUE IN A AFTER LAST CHAR GOBBLED BY GETSYL + MOVE B,CDISP ;GET STORED DISPATCH CODE + TLNN B,DWRD\DFLD + JRST VALR1 ;WORD TERMINATOR +;COME HERE TO RETURN A VALUE, AND ALSO +;BARF IF THE NEXT CHARACTER ISN'T A SYLLABLE SEPARATOR +TEXT5: PUSH P,T ;ENTRY FROM TEXT ROUTINES (NLAST CHAR NOT GOBBLED BY GETSYL) TO RETURN VALUE IN T + PUSHJ P,GETSYL ;SEE IF IMMEDIATELY FOLLOWED BY SYL + TRNE I,IRSYL + ETR ERRNOS ;NO SEPARATOR BETWEEN TWO VALUES + POP P,A ;RESTORE VALUE TO RETURN +VALR1: TRO I,IRSYL + JRST CLBPOP + + ;VARIOUS PUSH AND POP ROUTINES, ALL CALLED W/ JSP LINK, + +SGTSY: PUSH P,I + PUSH P,AA + PUSH P,A + PUSH P,B + JRST (LINK) + +SGTSY1: POP P,B + POP P,A + POP P,AA + POP P,I + JRST (LINK) + +;JSP LINK,SAVWD1 TO SAVE STUFF FOR < OR (, ETC. + +SAVWD1: PUSH P,A ;SYLL. BEFORE GROUPING NOW STARTING. + PUSH P,B ;AND ITS RELOC. + +SAVWLD: PUSH P,FORMAT + PUSH P,FORPNR + PUSH P,FLDCNT + PUSH P,GLSP2 + PUSH P,I + PUSH P,WRD + PUSH P,WRDRLC + PUSH P,SYM + PUSH P,PPRIME + PUSHJ P,(LINK) +SAVL1==. + +;POP OFF WHAT PUSHED BY SAVWLD. CLEARS FLUNRD, IN CASE THE > OR ) WAS UN-READ. + +USVWLD: POP P,SYM + HRRZS SYM + CAIE SYM,SAVL1 + HALT + TLZ FF,FLUNRD + POP P,PPRIME + POP P,SYM + POP P,WRDRLC + POP P,WRD + TDZ I,[-1-(ILWORD)] + IOR I,(P) + POP P,1(P) + POP P,GLSP2 + POP P,FLDCNT + POP P,FORPNR + POP P,FORMAT + JRST (LINK) + +;;GETFD ;GET FIELD (EXPRESSION); RETURN VALUE IN A, RELOC BITS IN B + + ;GET FIELD FOR PSEUDO + ;SYM SHOULD CONTAIN THE SQUOZE NAME OF THE PSEUDO + ;OR A POINTER TO AN INSN TO EXECUTE WHEN UNDEF + ;SYMBOL SEEN. SYM IS NOT CLOBBERED. + +AGETFD: PUSH P,I ;SAVE I + TRO I,IRPSUD+IRNOEQ ;SET FLAG TO GETVAL TO EXECUTE GTVER ON UNDEFINED SYM ON EITHER PASS + SAVE GTVER ;OLD VALUE OF GTVER + MOVEM SYM,GTVER ;ERROR MSG SHOULD GIVE NAME OF PSEUDO. + CALL YGETFD + MOVE SYM,GTVER + REST GTVER + MOVEM I,ISAV ;SAVE FLAGS FOR FIELD GOTTEN +POPIJ: POP P,I + POPJ P, + +;READ A FIELD, NOT PART OF THE CURRENT WORD. +YGETFD: PUSH P,WRD + SETZM WRD + CALL XGETFD + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + ADD A,WRD ;ADD IN INDEX, INDIRECT FIELDS + POP P,WRD + POPJ P, + +IFN FASLP,[ +FAGTFD: PUSHJ P,AGETFD ;DO AGETFD, COMPLAIN IF RELOCATABLE OR GLOBAL + MOVE TM,GLSP1 + CAMN TM,GLSP2 + SKIPE B + ETSM [ASCIZ /relocatable or external argument/] + POPJ P, +] +;READ A FIELD PART OF CURRENT WORD (FOR XWD, ETC). +XGETFD: SAVE PPRIME +AGTFD3: PUSHJ P,GETFLD + MOVE CH1,CDISP + TLNN CH1,DWRD + TLOA FF,FLUNRD ;DELIMITER IS WORD TERMINATOR => RE-READ IT. + TRNE I,IRFLD ;NON-NULL FIELD SUPPLIED => RETURN IT. + JRST AGTFD4 + HRRZ C,CDISP ;ELSE COMMA => RETURN NULL VALUE (0) + CAIN C,SPACE ;SPACE => TRY AGAIN TO READ A FIELD. + JRST AGTFD3 ;NO FIELD, TRY AGAIN +AGTFD4: REST PPRIME + POPJ P, + + ;IN RELOCATABLE FORMAT + ;READ FIELD AND COPY OUT AS WORD + +RGETFD: SETZM WRD ;FIRST INITIALIZE SOME STUFF AS THOUGH AT GETWD + SETZM WRDRLC + MOVE A,GLSPAS + MOVEM A,GLSP1 + MOVEM A,GLSP2 + CALL XGETFD + ADDM A,WRD + ADDM B,WRDRLC + PUSHJ P,PWRDA ;OUTPUT WORD + TLNE I,ILMWRD + JRST IGTXT ;SOAK UP MULTI-WORD FIELD + POPJ P, + +;READ IN A FIELD, RETURN IN A,B SETTING IRFLD IF FIELD NOT NULL. +GETFLD: SAVE GLSP1 ;REFERED TO AS GETFLB(P) WHEN ONLY 1 SYL PUSHED. + MOVEM P,PPRIME + TRZ I,IRFLD+IROP +GETFD1: TLNE I,ILMWRD + JRST GETFD9 ;MULTIPLE WORD, RE-CALL PSEUDO + PUSHJ P,GETSYL + TRNE I,IRLET +GETFD9: PUSHJ P,GETVAL ;GET OPERAND (MAYBE SKIPS) +GETFD6: SKIPA C,CDISP ;GET INFO ON SYLLABLE TERMINATOR + JRST GETFD1 ;GETVAL SKIPPED => PSEUDO/MACRO WITH NO VALUE, TRY AGAIN + TLNE C,DFLD + JRST (C) ;FIELD OPERATOR, GO PROCESS + TRNE I,IRSYL ;NO DISP MEANS FIELD TERMINATOR. + TRO I,IRFLD + CAME P,PPRIME ;IF ANY OPERATORS PUSHED, + JSP LINK,GETFD8 ;EVAL THEM. + SUB P,[1,,1] ;FLUSH GLSP1 SAVED AT GETFLD. + RET + +GETFD8: MOVEI TT, ;END OF FIELD HAS VERY LOW PRIORITY. + JRST GETFD7 + +;PUSH AN OPERATOR, MAYBE EVALLING STUFF TO LEFT. +;A HAS LEFT OPERAND (IF ANY), B RELOCATION BITS, +;C ADR OF ROUTINE TO PERFORM OPERATION, LH OF TT HAS PRECEDANCE OF OPERATOR + +GETFDL: MOVEI LINK,GETFD3 ;AFTER MAYBE EVALLING, GO PUSH OPERATOR. + TRO I,IRFLD+IROP + TRNN I,IRSYL + JRST GETFD5 ;UNARY, EVAL NOTHING, JUST PUSH WITH HIGH PRIO. +GETFD2: CAME P,PPRIME ;NO OPS TO LEFT => NOTHING TO EVAL. + CAMLE TT,GETFLP(P) ;COMPARE PRIO OF PREV. OP. AND CURRENT. + JRST (LINK) ;WAIT UNTIL LATER +GETFD7: HRRZ T,GETFLP(P) ;EVAL THE LAST OP ON STACK. + JRST (T) ;GO DO IT NOW (ROUTINE RETURNS TO GETFD4) +GETFD4: SUB P,[4,,4] + JRST GETFD2 + +GETFD5: MOVSI TT,200 ;GIVE UNARY OP HIGH PRIO. TO DO BEFORE NEXT BINARY. +GETFD3: PUSH P,B ;GETFLR(P) + PUSH P,A ;GETFLV(P) + HLL C,TT + PUSH P,C ;GETFLP(P) + PUSH P,GLSP1 ;GETFLG(P) + JRST GETFD1 + +GETFLB==,-4 ;PDL IDX OF GLSP1 BEFORE LEFT OPERAND. +GETFLR==,-3 ;PDL IDX OF RELOC OF LEFT OPERAND. +GETFLV==,-2 ;PDL IDX OF VALUE OF LEFT OPERAND. +GETFLP==,-1 ;PDL IDX OF PRIO,,DISPATCH +GETFLG==0 ;PDL IDX OF GLSP1 AFTER LEFT OPERAND (=BEFORE RIGHT) + +PLS: MOVEI C,PLS1 ;PLUS SIGN, PLS1 IS ROUTINE TO PERFORM OPERATION +MINUS2: MOVSI TT,10 ;SET UP PRECEDENCE OF 10 FOR +, - + JRST GETFDL + +MINUS: JSP C,MINUS2 ;MINUS SIGN + MOVNS A ;NEGATE VALUE OF RIGHT OPERAND + MOVNS B ;ALSO RELOCATION + JUMPGE FF,PLS1 + MOVE T,GETFLG(P) + PUSH P,B + HRLZI B,MINF + PUSH P,C + PUSHJ P,LNKTZ ;COMPLEMENT THE MINUS FLAG ON GLOBALS IN RIGHT OPERAND + POP P,C + POP P,B +PLS1: ADD A,GETFLV(P) ;ADD VALUES + ADD B,GETFLR(P) ;ADD RELOCATIONS + JRST GETFD4 + +LNKTZ: TDZA C,C +LNKTC1: MOVE T,GLSP2 +LINKTC: CAML T,GLSP1 + POPJ P, + SKIPL 1(T) + XORM B,1(T) + SKIPL 1(T) + IORM C,1(T) + AOJA T,LINKTC + +MULTP: MOVEI C,MULTP1 ;ASTERISK, MULTP1 ROUTINE TO PERFORM MULTIPLICATION +DIVID2: MOVSI TT,20 ;20 PRECEDENCE OF MULTIPLICATION, DIVISION + JRST GETFDL + +MULTP1: JUMPGE FF,MULTR ;ON P1, DON'T CHECK THIS, SINCE UNDEF SYMS ARE EXTERNALS + SKIPL CONTRL ;ELSE IN DECREL ASSEMBLY, TEST FOR EXTERNALS. + JRST MULTR + MOVE D,GETFLB(P) ;ACTUALLY, GET HERE FOR ABS ASSEMBLIES TOO, BUT SO WHAT? + CAME D,GLSP1 + ETR [ASCIZ /Externals multiplied/] +MULTR: JUMPE B,MULTP3 ;JUMP ON RIGHT OPERAND NOT RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;BOTH OPERANDS RELOCATED + MOVE T,GETFLV(P) ;GET VALUE OF LEFT OPERAND AND FALL IN + JRST MULTP5 + +MULTP3: MOVE T,A ;RIGHT OPERAND NOT RELOCATED, GET VALUE IN T + MOVE B,GETFLR(P) ;RELOCATION BITS OF LEFT OPERAND +MULTP5: MOVE D,GETFLG(P) ;GLOTB POINTER TO BETWEEN OPERANDS + CAME D,GETFLB(P) + JRST GMUL1 ;LEFT OPERAND HAS GLOBALS + CAME D,GLSP1 + JRST GMUL2 ;RIGHT OPERAND HAS GLOBALS + ;AT THIS POINT, T HAS VALUE OF ABS OPERAND, B RELOC BITS OF OTHER +GMUL4: IMUL A,GETFLV(P) ;MULTIPLY VALUES + IMULB B,T ;MULTIPLY RELOCATION OF ONE BY VALUE OF OTHER + TRZ T,1 + SKIPL CONTRL ;EXCEPT IN STINK ASSEMBLY, OBJECT TO RELOCATION + JRST GETFD4 ;OTHER THAN 0 OR 1 (ONLY AFFECTS DECREL, SINCE + JUMPE T,GETFD4 ;RELOCATION CAN'T BE NONZERO IN ABS ASSEMBLY). +MULTP4: ETR [ASCIZ+Relocatable arg to * or / or Boolean+] + JRST GETFD4 + +GMUL1: TLNE FF,FLPPSS ;LEFT OPERAND HAS GLOBALS, CHEK RIGHT OPERAND + CAMN D,GLSP1 + SKIPA CH1,A ;LOOKS OK, GET VALUE IN CH1 + ETR [ASCIZ /Multiplying two externals/] + SKIPA D,GETFLB(P) ;GET GLOTB POINTER TO BOTTOM OF LEFT OPERAND +GMUL2: MOVE CH1,GETFLV(P) ;GLOBALS IN RIGHT OPERAND ONLY, GET LEFT OPERAND +GMUL3: CAML D,GLSP1 + JRST GMUL4 ;TABLE COUNTED OUT + SKIPGE 1(D) + AOJA D,GMUL3 + JUMPE CH1,GMUL5 ;MULTIPLYING BY ZERO, CLEAR OUT GLOTB ENTRY AND LOOP BACK + LDB CH2,[221200,,1(D)] ;PICK UP MULTIPLICATION FIELD THIS GLOBAL + SKIPN CH2 + MOVEI CH2,1 ;0 => 1 + IMUL CH2,CH1 + CAIN CH2,1 + MOVEI CH2,0 ;IF ONE THEN USE ZERO + DPB CH2,[221200,,1(D)] + AOJA D,GMUL3 + + +GMUL5: CLEARM 1(D) + AOJA D,GMUL3 + +DIVID: JSP C,DIVID2 ;SLASH, PRECEDENCE = 20 +DIVID1: JUMPN B,MULTP4 ;JUMP IF RIGHT OPERAND RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;LEFT OPERAND RELOCATED + EXCH A,GETFLV(P) + IDIV A,GETFLV(P) + MOVEI B,0 + JUMPGE FF,GETFD4 + MOVE D,GETFLB(P) + CAME D,GLSP1 + ETR [ASCIZ /Division involving externals/] + JRST GETFD4 + + ;LOGIC OPERATORS & (PREC = 40), # (PREC = 34), \ (PREC = 30) + +ANDF: MOVSI TT,40 ;& + JSP C,GETFDL + JSP D,LOGIC1 ;GO DO IT + AND A,GETFLV(P) ;INSTRUCTION ARGUMENT TO LOGIC1 + +XORF: MOVSI TT,34 ;# + TRNN I,IRSYL ;IF ABOUT TO BE UNARY, + MOVNI A,1 ;THEN TURN LEFT OPERAND INTO -1 + JSP C,GETFDL + JSP D,LOGIC1 + XOR A,GETFLV(P) + +IORF: MOVSI TT,30 ;\ + JSP C,GETFDL + JSP D,LOGIC1 + IOR A,GETFLV(P) + + ;COMMON EXECUTION ROUTINE FOR LOGICAL OPERATORS + +LOGIC1: JUMPN B,MULTP4 ;NO RELOCATION ALLOWED + SKIPE GETFLR(P) ;NOW CHECK RELOCATION OF LEFT OPERAND + JRST MULTP4 + XCT (D) ;ALL TESTS PASSED, DO IT + JUMPGE FF,GETFD4 ;DON'T CHECK FOR GLOBALS EXCEPT DURING PUNCHING PASS + MOVE D,GETFLB(P) ;PICK UP POINTER TO LEFT OPERAND GLOTB ENTRIES + CAME D,GLSP1 + ETR [ASCIZ /External in arg to \, & or #/] + JRST GETFD4 + +CBAKAR: MOVSI TT,100 ;BACKARROW AS FIELD OPERATOR, PREC = 100 + JSP C,GETFDL ;RETURN TO GETFLD TO READ 2ND ARGUMENT. + JSP D,LOGIC1 ;FOR EVALUATION, CALL LOGIC1 + JSP D,.+1 ;WHICH EXECUTES THIS INSTRUCTION, + MOVE T,A ;TO CALL THIS SUBROUTINE. + MOVE A,GETFLV(P) + LSH A,(T) + JRST (D) + +;D SHOULD HAVE 1 FOR <, 2 FOR (, 3 FOR [ ;] +LSSTH9: JSP LINK,SAVAS1 ;SAVE ASSEM1 PDL LEVELS, .BYTE MODE, ETC. + MOVEM D,ASMOUT ;SAY WHAT KIND OF OPEN WE JUST DID + JRST ASSEM3 ;REENTER ASSEM1 LOOP AT INNER LEVEL. + +;COME HERE TO EXIT FROM AN ASSEM1 LEVEL THAT WAS ENTERED BY LSSTH9. +LSSTHA: SKIPE BYTM ;IN BYTE MODE, DO .WALGN. SINCE ASMDSP + JRST A.BY3 ;STILL POINTS HERE, WE'LL COME BACK. + MOVE P,CONSTP + JSP T,CONNDP ;POP STUFF SAVED BY SAVAS1 + MOVE A,WRD ;RETURN THE WORD IN THE GROUPING + MOVE B,WRDRLC ;(OUR CALLER WILL USVWLD, CLOBBERING WRD) + POPJ P, + +LSSTH: MOVEI D,1 ;1 FOR <. + JSP LINK,SAVWD1 + PUSHJ P,LSSTH9 +LSSTH3: JSP LINK,USVWLD ;POP OFF ALL BUTPREVIOUS SYLL. + +;GROUPINGS EXCEPT (PARENS THAT ADD TO WORD) +;SYLL IMMEDIATELY BEFORE OR AFTER IS ERROR. +LSSTH2: ADDM A,-1(P) ;SYLL BEFORE GROUPING, PUSHED BY SAVWD1. + ADDM B,(P) + TRNE I,IRSYL ;IF WAS SYLL BEFORE GROUPING, ERROR. + ETR ERRNOS +LSSTH5: MOVE A,LIMBO1 ;CHECK FOR FOLLOWING SYLL. + CAIE A,15 + CAIN A,12 + JRST LSSTH6 ;DELIMITER CR OR LF + PUSHJ P,RCH ;NOT CR OR LF, GET NEXT CHAR + CAIN A,"! ;IGNORE EXCLAMATION POINT + JRST .-2 + TLO FF,FLUNRD ;CAUSE IT TO BE RE-INPUT + HLRZ CH1,GDTAB(A) + CAIE CH1,(POPJ P,) + JRST LSSTH4 ;SQUOZE CHAR. MEANS FOLLOWING SYLL. + HRRZ CH1,GDTAB(A) + MOVE CH1,DTB-40(CH1) ;GET DISPATCH FOR CHAR. + TLNE CH1,DSY1 ;MIGHT START SYL => NOS ERROR. + JRST LSSTH4 +LSSTH7: PUSHJ P,GTSL1 +LSSTH6: TRO I,IRSYL + POP P,B + POP P,A ;VALUE OF GROUPING WAS ADDM'ED INTO THESE. + TLZE I,ILLSRT ?.SEE UA3 + RET ;IF CALLED BY ^ OR _ AS SYL OP, RETURN TO IT. + JRST GETFD6 + +LSSTH1: TLO I,ILWORD ;A NUMBER IN PARENS BY ITSELF IS A NONNULL WORD. + ADDM A,WRD + ADDM B,WRDRLC + TRNE I,IRSYL ;IF SYLL BEFORE, + JRST LSSTH5 ;ERROR IF SYL AFTER. + JRST LSSTH8 ;ELSE NO ERROR. + +LSSTH4: ETR ERRNOS ;FOLLOWING SYLL WHEN THAT IS ERROR. +LSSTH8: TLNE I,ILLSRT ?.SEE UA3 + JRST LSSTH6 + SUB P,[2,,2] + JRST GETFD1 + +ERRNOS: ASCIZ /Syllables not separated/ + +POP2J: SUB P,[2,,2] + POPJ P, + +LEFTP: MOVEI D,2 ;2 FOR ). + JSP LINK,SAVWD1 + MOVEI C,0 + TRNE I,IROP + TRNE I,IRSYL + TLO C,400000 ;CAUSE IT TO GET ADDED INTO WORD STEAD HAVE VALUE AS SYL + PUSH P,C + PUSHJ P,LSSTH9 + POP P,C + MOVSM A,T1 ;STORE SWAPPED VALUE + ADDI B,400000 ;NOW WANT TO SWAP RELOCATION, MAKE LH CORRECT + HLREM B,T2 ;STORE AS RH WITH SIGN EXTENDED + MOVSI B,400000(B) ;GET RIGHT HALF IN LEFT + ADDM B,T2 ;FINISH RELOCATION SWAP (THIS IS PAINLESS COMPARED TO THE HAIR EVERYWHERE + ;ELSE WHEN KEEPING THE HALFWORDS SEPARATE) + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + JSP LINK,USVWLD + MOVE A,T1 + MOVE B,T2 + JUMPL C,LSSTH1 ;ADD TO WHOLE WORD + JRST LSSTH2 + +;VERSION OF GETWRD FOR PSEUDO, +;PSEUDO MUST EITHER SAVE I, PPRIME AND GTVER OR RETURN TO ASSEM1. +;SYM SHOULD HOLD NAME OF PSUEUDO. + +AGETWD: MOVEM SYM,GTVER ;STORE NAME OF PSEUDO FOR UNDEF SYM MSGS. + TRO I,IRPSUD\IRDEF\IRNOEQ + PUSHJ P,GETWRD + MOVE SYM,GTVER ;RESTORE SYM. + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + RET + +;;GETWD ;READ A WORD, LEAVE VALUE IN A AND WRD, RELOC IN WRDRLC AND B + +GETWRD: MOVE T,GLSP1 + MOVEM T,GLSP2 + CLEARM FORMAT ;CLEAR FORMAT, WILL ACCUMULATE FORMAT NUMBER BY IDPB + CLEARM WRD ;CLEAR WRD, WILL ACCUMULATE ABSOLUTE PART OF WORD + CLEARM WRDRLC ; " RELOCATION BITS, " + TDZ I,[ILWORD,,IRIOINS] + CLEARM FLDCNT ;NO FIELDS YET + MOVE T,[50100,,FORMAT] ;SET UP BIT POINTER TO FORMAT + MOVEM T,FORPNR +GTWD1: PUSHJ P,GETFLD ;READ NEXT FIELD +SPACE6: MOVEI T,1 ;SET T TO 1, AC FOR IDPB ON ROUTINE DISPATCHED TO + SKIPA C,CDISP +SPACE5: REST A + TLNE C,DWRD + JRST (C) ;NO DISPATCH MEANS WD TERMINATOR + MOVE C,GLSP1 + MOVEM C,LINKL ;MARK END OF ACTIVE PART OF GLOTB + TRNN I,IRFLD + JRST GETWD2 ;LAST FIELD NULL, MAYBE HAVE TO POP STUFF OFF + IDPB T,FORPNR ;MARK NON-NULL FIELD IN FORMAT +GTWD4A: TLO I,ILWORD ;NON-NULL WORD + MOVE TT,FORMAT + SKIPN TT,FORTAB-10(TT) ;PICK UP BYTE POINTER POSITION/SIZE FIELDS FOR FIELDS IN WORD + ETR [ASCIZ /Undefined format/] + MOVEM TT,FORMAT ;STORE IN FORMAT + MOVE T,[301400,,FORMAT] + MOVEM T,FORPNR + ;AT THIS POINT, FLDCNT HAS 1 LESS THAN # FIELDS; PUT FIELDS TOGETHER TO FORM WORD +GTWD3: LDB T,FORPNR + MOVE D,FLDCNT + CAIG D,2 + IBP FORPNR ;HAVEN'T BACKED UP TO THIRD FIELD YET, INCREMENT TO DESC FOR PREV + TRNE I,IRIOINS + PUSHJ P,INTIOW + PUSHJ P,INTFLD ;PUT FIELD WHERE IT BELONGS + SOSGE FLDCNT + JRST GTWD5 ;THIS WAS LAST (FIRST) FIELD + POP P,GLSP2 ;NOT YET, POP OFF MORE + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD3 + +GTWD5: MOVE A,WRD + MOVE B,WRDRLC + MOVE C,LINKL + MOVEM C,GLSP1 + TRZ I,IRIOINS + POPJ P, + +COMMA: TRNN I,IRFLD ;FIELD DELIMITER WAS COMMA (T HAS 1) + JRST COMMA1 ;NO FIELD + IDPB T,FORPNR ;MARK NON-NULL FIELD +COMMA4: IDPB T,FORPNR ;MARK FIELD TERMINATOR WAS COMMA + MOVE TT,FLDCNT + CAIL TT,2 + ETR [ASCIZ /Comma past the 3rd field of a word/] +PUSHFD: PUSH P,A ;DONE WITH THIS FIELD, NOW TO GET NEXT + PUSH P,B + PUSH P,GLSP1 + PUSH P,GLSP2 + AOS FLDCNT ;ANOTHER FIELD + MOVE TT,GLSP1 + MOVEM TT,GLSP2 + HRRZ T,FORPNR + CAIE T,FORMAT + HRRZS FORPNR ;STABILIZE FORPNR + TLO I,ILWORD ;SAY WE HAVE A NON-NULL WORD IN PROGRESS (LOC, ETC. ILLEGAL). + JRST GTWD1 + +GETWD2: SKIPN FORMAT ;LAST FIELD OF WORD IS NULL + JRST GTWD5 ;ENTIRE WORD NULL, MAYBE WERE PARENS. + SOS FLDCNT + POP P,GLSP2 + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD4A + +COMMA1: LDB TT,FORPNR ;COMMA TERMINATED NULL FOELD. + SKIPE FORMAT + JUMPE TT,COMMA2 ;NOT 1ST FIELD, JMP IF PREV WAS TERM BY SPACE. + IBP FORPNR ;ELSE MARK NULL FIELD IN FORMAT. + JRST COMMA4 + +;FIELD SPACE COMMA, PATHOLOGICAL CASE +;(EG MACRO STARTED WITH A COMMA) +COMMA2: DPB T,FORPNR ;REPLACE SPACE WITH COMMA. + JRST GTWD1 + + ;FIELD TERMINATOR IS SPACE (T HAS 1) + +SPACE: MOVE TT,LIMBO1 + CAIE TT,^I ;HEURISTIC: REAL SPACES ARE LIKELY TO BE FOLLOWED BY SQUOZE, + JRST SPACE4 ;WHILE TABS ARE LIKELY TO BE FOLLOWED BY COMMENTS. + PUSH P,A + MOVE TT,GDTAB+40 + PUSHJ P,RCH + CAMN TT,GDTAB(A) + JRST .-2 ;FLUSH OTHER LOGICAL SPACES + CAIN A,"; ;TAB WAS FOLLOWED BY SEMICOLON: + JRST [ SAVE B + TRZ I,IRSYL + CALL SEMIC ;FLUSH THE COMMENT + MOVEI T,1 + REST B + JRST SPACE5] ;AND HANDLE THE C.R. +SPACE3: POP P,A + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-READ NEXT TIME +SPACE4: TRNN I,IRFLD + JRST GTWD1 ;NO FIELD + IDPB T,FORPNR ;T HAS 1, MARK NON-NULL FIELD IN FORMAT + IBP FORPNR ;MARK FIELD TERMINATOR WAS SPACE + JRST PUSHFD + +;T HAS DESC BYTE, PUT FIELD IN ITS PLACE +;ALSO CALLED FROM PBYTE, MUSTN'T CLOBBER AA. + +INTFLD: MOVE TT,GLSP2 + CAMN TT,GLSP1 + JUMPE B,INTFD1 ;NO GLOBALS, JUMP IF NO RELOCATION + CAIN T,2222 ;LH + JRST INTL + CAIN T,22 ;RH + JRST INTR + CAIN T,44 ;WHOLE WORD + JRST INTW + SKIPE B + ETR [ASCIZ/Relocation attempted in irrelocatable field/] + ;(ASSUME) NO RELOCATION, CHECK FOR GLOBAL AC FIELDS + CAIN T,2704 ;HIGH AC + JRST INTACH + CAIN T,504 ;AC LOW + JRST INTACL + JUMPGE FF,INTFD1 ;JUMP ON NOT PUNCHING PASS + CAME TT,GLSP1 + ETR [ASCIZ/Global symbol in illegal field/] +INTFD1: MOVEI TT,C_12. + ROTC T,-12. ;SHIFT BYTE POINTER INTO TT + MOVEI C,0 ;INITIALIZE C TO RECEIVE FIELD IN PROPER PLACE + DPB A,TT + CAMN TT,[2200,,C] + JRST INTFD2 ;RIGHT HALF, DON'T ALLOW CARRY INTO LH + ADDM C,WRD ;ALLOW CARRY +INTFD3: ADDM B,WRDRLC ;ADD RELOCATIONS, WILL BE BROKEN BACK INTO HALF-WORDS LATER + POPJ P, + +INTFD2: ADD C,WRD ;ADD RIGHT HALVES + HRRM C,WRD + JRST INTFD3 + +INTIOW: CAIE T,2704 + CAIN T,504 + TRZA A,3 ;IO DEVICE FIELD + POPJ P, ;NOT "AC" FIELD + ADDI T,611-504 + POPJ P, + +INTR: HRRE D,B ;RH + MOVEI B,0 + PUSH P,T + HRLZI C,HFWDF + PUSHJ P,LNKTC1 ;THIS IS A BUG WHICH SHOULD BE FIXED SOMETIME +PRTCL: MOVE B,D ;GET BACK MAPPED RELOCATION BITS +PRTCL2: POP P,T +INTW: MOVE D,GLSP2 ;WHOLE WORD + HRLOI LINK,377777 + CAML D,GLSP1 + JRST INTFD1 + ANDM LINK,1(D) + AOJA D,.-3 + +INTL: HRLZ D,B ;LH + MOVSI B,SWAPF + MOVSI C,HFWDF + PUSH P,T + MOVE T,GLSP2 +INTL2: CAML T,GLSP1 + JRST PRTCL + SKIPGE 1(T) + AOJA T,INTL2 ;INDEX FIELD, ETC => LEAVE ALONE + IORM C,1(T) ;SET HFWDF + XORM B,1(T) ;COMPLEMENT SWAP STATUS + TDNN B,1(T) + SETZM 1(T) ;SWAPPED TO RH, FLUSH IT + AOJA T,INTL2 + +INTACL: TDZA B,B ;AC LOW +INTACH: HRLZI B,SWAPF ;AC HIGH + HRLZI C,ACF + PUSH P,T + PUSHJ P,LNKTC1 + MOVEI B,0 + JRST PRTCL2 + +IOINST: HLLZ A,B ;IO INSTRUCTION, GET WHICH ONE INTO A + SKIPN FLDCNT ;THIS FIRST FIELD OF WORD? + TRO I,IRIOINS ;YES + JRST CLBPOP ;RETURN VALUE + + ;TOP LEVEL LOOP, ASSEMBLE STORAGE WORDS + ;LOTS OF PSEUDOS MEANINGLESS IN STORAGE WORDS + ;(E.G. BLOCK, CONSTA) DO JRST ASSEM1 WHEN DONE + ;THERE'S ALSO AN ERROR UUO WHICH RETURNS TO ASSEM1 + +ASSEM1: MOVE P,ASSEMP + JRST @ASMDSP + +;COME HERE TO START THE NEXT EXPRESSION OR WHATEVER. +ASSEM3: PUSHJ P,RCH + CAIN A,^I + JRST ASSEM2 ;PROBABLY NOT PROFITABLE TO SKIP AFTER SEE A TAB. + CAIG A,40 + JRST ASSEM3 ;FLUSH LEADING GARBAGE + TLO FF,FLUNRD ;CAUSE NON-GARBAGE CHAR FOUND TO BE RE-INPUT +;ASMDSP POINTS HERE WITHIN ASCII, SIXBIT ETC. +ASSEM2: TRZ I,IRFLD+IRSYL+IRLET+IRPSUD+IRCOM+IRCONT+IRGMNS+IROP+IRNOEQ+IREQL + TLZ I,ILGLI+ILVAR+ILFLO+ILDECP+ILUARI+ILWORD+ILNPRC + IOR I,ASMI ;SET DEF AND RESTORE PSEUDF. + MOVE A,GLSPAS + SKIPL BYTM + MOVEM A,GLSP1 + ;GETWRD WILL COPY GLSP1 INTO GLSP2 +IFN TS,[AOSN TTYBRF ;DO A ^H-BREAK IF REQUESTED. + CALL TTYBRK] + PUSHJ P,GETWRD + TLZN I,ILWORD + JRST @ASMDSP ;NO WORD ASSEMBLED,TRY AGAIN + SKIPGE BYTM + JRST PBYTE ;IN BYTE MODE, OUTPUT BYTE INSTEAD OF WORD, A,B MUST HAVE WRD,WRDRLC. + MOVE AA,ASMOUT ;OUTPUT WD AS APPRO. FOR GROUPING, IF ANY. + JRST @ASMOT0(AA) + +ASSEM6: SKIPE STGSW ;ASMOT0 POINS HERE. COME IF NOT IN GROUPING. + ETR ERRSWD ;STORAGE WORD ASSEMBLED + PUSHJ P,PWRD ;OUTPUT THE WORD. + AOS CLOC + HRRZS CLOC ;INCREM. POINT . + JRST @ASMDSP ;ASSEM3 OR ASSEM2 + +ERRSWD: ASCIZ /Storage word assembled/ + +ASSEM4: JSP T,PCONST ;ASMOT0+3 POINTS HERE. COME IF IN CONSTANT. + JRST @ASMDSP + +;ASMDSP POINTS HERE WITHIN GROUPING IF NOT IN MULTI-LINE MODE +;[ ;AND NO CLOSE (">)]") HAS BEEN SEEN. +ASSEMC: MOVE AA,ASMOUT + SKIPE CONSML ;IN ERROR MODE, GIVE APPROPRIATE ERROR MSG. + XCT ASMOT3(AA) + JRST @ASMOT2(AA) ;CLOSE WHATEVER TYPE GRPING WE'RE IN. + +;JUMP THRU THIS TABLE TO OUTPUT A WORD. +ASMOT0: ASSEM6? ASSEM1? ASSEM1? ASSEM4? [HALT ] + +;THIS TABLE GIVES APPRO. CLOSE FOR EACH TYPE OF GROUPING. ;[ +ASMOT1: "? ? "> ? ") ? "] ? "? + +;THIS TABLE SAYS WHERE TO GO TO END THE GROUPING. +ASMOT2: [HALT ]? LSSTHA? LSSTHA? CONND? [HALT ] + +;APPROPRIATE ERROR MESSAGE FOR MISSING CLOSE OF GROUPING. [ +ASMOT3: HALT + ETR [ASCIZ /Missing >/] + ETR [ASCIZ /Missing )/] + ETR [ASCIZ /Missing ]/] + HALT + +;THIS TABLE TELLS PBYTE HOW TO HANDLE BYTE MODE. +ASMOT4: PBY4 ? PBY5 ? PBY5 ? PBY3 ? [HALT ] + +;TABLE SAYING WHAT CHAR MUST HAVE OPENED THE GROUPING. +ASMOT5: "? ? "< ? "( ? "[ ? "? ;] + +;;GETVAL ;GET VALUE OF SYM + ;SKIPS ON PSEUDO NOT RETURNING VALUE (E.G. MACRO STARTING TO BE EXPANDED) + ;ELSE RETURNS VALUE IN A, RELOCATION BITS IN B + +VBLK +GTVER: 0 ;SQUOZE NAME OF CALLING PSEUDO, OR POINTER + ;TO INSN TO EXECUTE WHEN IF SYM IS UNDEF. +PBLK + +GETVAL: PUSHJ P,ES + JRST GVNF ;NO STE. +IFN CREFSW,XCT CRFINU ;JFCL OR CALL TO CREF RTN. + JRST @.+1(A) ;FOUND, DISPATCH ON SQUOZE FLAGS + +GVTAB: GVCOM ;COMMON (UNUSED) + GVPSEU ;PSEUDO OR MACRO. + GVSYM ;LOCAL SYMBOL. + GVUL ;LOCAL UNDEF (MAYBE STINK KNOWS VALUE) + GVDLV ;DEFINED LOCAL VAR. + GVULV ;UNDEF LOC VAR. + GVDGV ;DEF GLO VAR + GVUGV ;UNDEF GLO VAR + GVDG ;DEF GLOBAL + GVUG ;UNDEF GLOBAL + +;DEF LOCAL VAR. +GVDLV: PUSHJ P,GVDLGV ;IF PASS2 AND HAS ' THIS TIME, SET 3VAS2 FOR AVARIAB + TLZN I,ILGLI + JRST GVDLV2 + MOVSI T,DEFGVR ;NOW DEF GLO VAR. + PUSHJ P,VSM2 + JRST GVDG1 ;MAYBE OUTPUT GLOBAL DEF. TO STINK. + +GVDGV: PUSHJ P,GVDLGV ;DEF GLO VAR; IF PASS 2 AND ' THIS TIME, SET 3VAS2 + JRST GVDG2 ;MUSN'T PUNCH VALUE, AVARIAB WILL. + +GVDLGV: TRNE FF,FRPSS2 ;IF PASS 2 + TLNN I,ILVAR ;AND THIS TIME HAVE SINGLEQUOTE + POPJ P, + TLO C,3VAS2 ;TELL AVARIAB SEEN IN PASS 2 WITH '. + 3PUT C,D + POPJ P, + +GVULV: TLZN I,ILGLI ;UNDEF LOCAL VAR, MAYBE MAKE GLOBAL. + JRST GVUNDF + PUSHJ P,PLOGLO ;IF SO, TELL STINK SYM IS GLOBAL, + MOVSI T,UDEFGV ;SYM NOW UNDEF GLO VAR + PUSHJ P,VSM2 + JRST GVUNDF ;IN EITHER CASE, HANDLE UNDEF SYM. + +GVUL: TLZE C,3MACOK ;UNDEF LOCAL, PRESUMED NUMERIC + 3PUT C,D ;DON'T LET IT BECOME MACRO AND SCREW PASS2. + TLNE C,3LLV + JRST GVGLTB ;(REALLY DEFINED BUT ONLY STINK KNOWS HOW) + TLNE I,ILGLI ;IF MAKING GLOBAL, TELL STINK. + PUSHJ P,PLOGLO +GVNF1: TLZE I,ILVAR ;IF ', MAKE VAR (WILL CHECK ILGLI) + JRST GVUL1 + TLZN I,ILGLI ;NOT MAKING VAR, MAYBE GLOBAL? + JRST GVUNDF ;NO, MAYBE ERROR, MAKE GLOTB ENTRY. + MOVSI T,GLOEXT + PUSHJ P,VSM2 ;NOW GLOBAL UNDEF, + JRST GVGLTB ;NO ERROR, JUST GLOTB ENTRY. + +GVUL1: TLZN I,ILGLI ;UNDEF LOCAL BECOMES + SKIPA T,[UDEFLV,,] ;UNDEF LOC VAR OR +GVGVAR: MOVSI T,UDEFGV ;UNDEF GLO VAR. +GVVAR: AOS VARCNT + HRR B,VARCNT + PUSHJ P,VSM2 ;MAKE IT A VAR, + JRST GVUNDF ;PRETEND HAD ALREADY BEEN A VAR. + +GVUG: TLZE I,ILVAR ;UNDEF GLOBAL: MAYBE MAKE UNDEF GLO VAR. + JRST GVGVAR +GVGLTB: SKIPGE CONTRL ;UNDEF GLO IN ABS ASSEM => + JRST GVUND1 ;MAYBE TREAT AS UNDEF. +GVGLT1: AOS GLSP1 ;DON'T KNOW SYM'S VALUE, MAKE GLOTB ENTRY. + MOVEI T,ST(D) + HRRZM T,@GLSP1 + JRST CABPOP ;RETURN 0 AS VALUE. + +GVNF: +IFN CREFSW,XCT CRFINU ;ONLY IF NOT FOUND WOULD NOT CREF AFTER ES. + TLNE I,ILVAR+ILGLI ;MAKING VAR OR GLOBAL FORCED CURRENTBLOCK ALREADY + JRST GVNF1 ;AND WILL STORE NAME IN STE ANYWAY. + SKIPGE ESBK ;ELSE IF NO SPEC'D BLOCK, + TRNN FF,FRNPSS ;FORCE .MAIN BLOCK SO DON'T GET LOTS OF UNDEF ENTRIES. + CAIA ;BUT CAN'T DO THAT FOR 1PASS OR WOULD MISS FWD REFS. + HRRI C,BKWPB + MOVSI T,LCUDF + PUSHJ P,VSM2 + JRST GVUNDF ;MAYBE ERROR, MAKE GLOTB ENTRY. + +GVCOM: TRO I,IRCOM ;COMMON: SAY THIS WAS ONE. + HRRZ A,B ;RETURN RH OF VALUE, ABSOLUTE. + JRST CLBPOP + +GVPSEU: TLNN I,ILVAR+ILGLI ;CAN'T MAKE PSEUD OR MACRO GLOBAL OR VAR. + JRST (B) ;OTHERWISE, DISPATCH TO IT. + TLZE I,ILVAR + ETSM ERRCBV + TLZE I,ILGLI + ETSM ERRCBG + JRST (B) ;DISPATCH TO PSEUDO (OR MACCL IF MACRO) + ;EXPECTS LH OF VALUE IN LH OF B. + +ERRCBV: ASCIZ /Can't be a variable/ +ERRCBG: ASCIZ /Can't be global/ + +GTVL7B: TLNE C,3RLL ;R(LH) + TLO SYM,200000 + TLNE C,3RLR ;R(RH) + TLO SYM,100000 + POPJ P, + +GVSYM: TLNN C,3REL + TLNE I,ILVAR\ILGLI + JRST GVSYM2 + MOVE A,B ;THIS CODE DOES WHAT GVSYM2 WOULD DO, BUT FASTER. + SETZ B, + RET + +GVSYM2: TLZE I,ILVAR ;LOCAL SYM: CAN'T MAKE VARIABLE. + ETSM ERRMDV + TLZN I,ILGLI + JRST GVSYM0 ;NOT MAKING GLOBAL, GET VALUE & RETURN. +GVSYM1: MOVSI T,GLOETY ;BECOMES DEF. GLOBAL. + PUSHJ P,VSM2 + JRST GVDG1 ;HANDLE AS IF WAS DEF GLOBAL. + +ERRMDV: ASCIZ /Multiply-defined variable/ + +GVDG: TLZE I,ILVAR ;GLOBAL ENTRY + ETSM ERRMDV +;COME HERE FOR DEF GLOBAL +GVDG1: SKIPGE CONTRL + JRST GVDLV2 ;DON'T PUNCH VALUE IF ABSOLUTE. + TLNE C,3VP + JRST GVDG2 ;VALUE PUNCHED ALREADY, NOT AGAIN. + JUMPGE FF,GVDG2 + TLNN C,3LLV + TRNE I,IRPSUD+IREQL + JRST GVDG2 + TLO SYM,40000 + PUSH P,WRD + PUSHJ P,OUTDE2 + POP P,WRD +GVDG2: TRNN I,IRPSUD\IREQL ;IF INSIDE AN ORDINARY STORAGE WORD, + TLNN C,3REL ;GENERATE A GLOBAL REF IF GLOBAL IS RELOCATABLE (HEURISTIC). +GVDLV2: TLNE C,3LLV ;IF VAL KNOWN ONLY BY STINK, MUST MAKE A GLOBAL REF. + JRST GVGLTB +GVSYM0: MOVE A,B ;USED IN LBRAK + LDB B,[.BP (3RLR),C] + TLNE C,3RLL + TLO B,1 + POPJ P, + +GVUND1: MOVE A,CONTRL + TRNE A,DECREL+FASL ;DEC FMT OR FASL => UNDEF GLOBALS OK. + JRST GVGLT1 +GVUGV: +GVUNDF: TRZ I,IRDEF ;UNDEFINED, MAYBE ERROR, MAKE GLOTB ENTRY. + TRNE I,IRPSUD\IREQL + JRST GVUND2 ;PSEUDO + TRNN FF,FRPSS2 + JRST GVGLT1 ;PASS 1 + SKIPN CONDEP + ETSM [ASCIZ/Undefined/] + SKIPE CONDEP + ETSM [ASCIZ/Undefined in literal/] + JRST CABPOP + +GVUND2: HLRZ A,GTVER ;DOES GTVER POINT TO AN INSN? + JUMPE A,[XCT @GTVER ? JRST CABPOP] + ERJ .+1 ;NO, IT IS NAME OF PSEUDO. + MOVE A,LINEL + CAIGE A,75. ;CR-LF-TAB NOW IF WHOLE MSG WON'T FIT ON A LINE. + CALL CRRTBX + TYPE2 SYM ;TYPE NAME OF UNDEF SYM. + TYPR [ASCIZ/ Undefined in /] + TYPE2 GTVER + CALL CRRERR + JRST CABPOP + +;EVALUATE SYMBOL, SQUOZE (FLAGS OFF) IN SYM +;IDX OF BLOCK TO DEFINE IN IN ESBK (OR -1 => ANY BLOCK NOW IN PROGRESS). +;DOESN'T CLOBBER F (FOR WRQOTE) +;RETURNS SKIPPING IF SYM FOUND, WITH SQUOZE FLAGS IN BOTTOM OF A, +;VALUE OF SYM IN B, STE IDX IN D, AND 3RDWD IN C. +;IF NOT FOUND, RETURNS IN D THE IDX OF A PLACE TO DEFINE SYM. +;CALL ESDCHK TO GET THE FOLLOWING EXTRA INFO (WHETHER SYM FOUND OR NOT): +;ESLAST -> LAST STE WITH DESIRED NAME SEEN, REGARDLESS OF WHAT BLOCK IT'S IN +;ESL1 HAS LEVEL OF BLOCK OF BEST STE SEEN, -1 IF NOT FOUND +;ESL2 HAS 3RDWRD OF BEST. +;ESXPUN HAS -1 OR IDX OF A STE WHICH MIGHT BE USED TO DEFINE THE SYM. +;RH(TM) GETS BLOCK IDX TO DEFINE IN IF DEFINE THE SYM. +;TT HAS -<# STE NOT LOOKED AT YET> +;THEN IF SYM IS FOUND IN A CONTAINING BLOCK AND YOU WANT TO DEFINE +;IT IN THE CURRENT BLOCK, YOU CAN CALL DEFCHK TO FIND AN STE TO DO IT IN. +;CALLING ESDEF IS AS GOOD AS CALLING ESDCHK AND DEFCHK, BUT DOESN'T +;LET YOU SEE WHAT YOU ARE GOING TO SHADOW. + +ESDEF: MOVE A,BKCUR ;EVAL SYM IN ORDER TO DEFINE IT: + SKIPGE ESBK ;IF NO SPEC'D BLOCK, SPEC THE CURRENT BLOCK, + MOVEM A,ESBK ;SO DEFS IN CONTAINING BLOCKS WON'T BE SEEN + +ESDCHK: SETOM ESLAST ;CALL HERE IF WE MIGHT END UP CALLING DEFCHK, + SETOM ESL1 ;SINCE IN THAT CASE WE'LL NEED THESE VARS EVEN IF SYM IS FOUND + SETOM ESXPUN ;RIGHT AWAY. + MOVN TT,SYMLEN +ES: MOVE C,SYM ;HASH AWAY + TSC C,SYM ;THIS MAKES SURE THAT THE FIRST FEW CHARS OF SYMBOL DON'T GIVE + ;A ZERO REMAINDER, IF SYMLEN IS A ROUND NUMBER. + MOVMS C ;THIS IS BECAUSE IDIV OF NEGATIVE NUMBER GIVES NEG. REMAINDER. + IDIV C,SYMLEN + IMUL D,WPSTE + SKIPGE TM,ESBK ;GET BKTAB IDX OF SPEC'D BLOCK + HRR TM,BKCUR ;OR -1,,BKTAB IDX OF CURRENT BLOCK. +;NOW CHECK FAST FOR AN IMMEDIATE MATCH - AVOID SETTING UP FLAGS NEEDED ONLY WHEN +;SYM APPEARS IN MULTIPLE BLOCKS OR ISN'T DEFINED. + SKIPN B,ST(D) + JRST ESEND0 ;SYM IS KNOWN NOT TO BE DEFINED. + TLZ B,740000 + CAME B,SYM + JRST ESBAD0 ;NOT FOUND IN 1ST ENTRY - MUST SET UP INFO AND LOOP + 3GET C,D + MOVEI A,(C) + CAIN A,(TM) + JRST ESGOOD ;IN THE DESIRED BLOCK => GOOD. + TDNN C,[3MAS,,-1] ;IN THE INITIAL SYMS BLOCK, NOT PRESENT IN ANY OTHER, + JUMPL TM,ESGOOD ;AND BLOCK WASN'T EXPLICITLY SPEC'D => GOOD. + MOVN TT,SYMLEN ;ELSE MUST KEEP LOOKING TO SEE IF THIS DEF IS REALLY ONE WE WANT. + SETOM ESLAST + SETOM ESL1 + SETOM ESXPUN + JUMPGE TM,ESIGN + JRST ESLP1 + +;LOOK AT THE NEXT STE, WHILE LOOPING. +ESLP: SKIPN B,ST(D) ;GET SQUOZE IN THIS ST SLOT + JRST ESEND ;NOTHING WHERE SYM BELONGS, END SEARCH + TLZ B,740000 ;CLEAR OUT FLAGS + CAME B,SYM ;COMPARE WITH WANTED + JRST ESBAD ;NO MATCH BUT MAYBE KEEP GOING + 3GET C,D ;FOUND SYM, GET 3RDWRD + MOVEI A,(C) + CAIN A,(TM) ;DEFINED IN DESIRED BLOCK + JRST ESGOOD ; => MUST BE GOOD. +ESLP0: JUMPGE TM,ESIGN ;BLOCK SPEC'D => ALLOW NO OTHERS. + TDNE C,[3MAS,,-1] ;IF IN INITIAL SYMS BLK, NO MORE DEFS, + JRST ESLP1 + SKIPGE ESL1 ;AND NO PREVIOUS DEFS, + JRST ESGOOD ;UNREDEFINED INITL SYM MUST BE GOOD. +ESLP1: HLRZ B,BKTAB+1(C) ;GET LEVEL OF BLOCK DEF. IS IN. + CAMN A,BKPDL(B) ;SAME AS BLOCK WE'RE IN AT THAT LEVEL? + CAMLE B,BKLVL ;AND NOT A BLOCK WE'VE EXITED + JRST ESIGN + CAMG B,ESL1 ;OR HIGHER LEVEL THAN PREVIOUS BEST + JRST ESIGN + MOVEM C,ESL2 ;REPLACE BEST'S 3RDWRD, LEVEL, ADDR. + MOVEM B,ESL1 + MOVEM D,SADR +ESIGN: HRRZM D,ESLAST ;THIS ENTRY LAST SEEN WITH THIS NAME. + TLNN C,3MAS ;MORE STE'S FOR THIS SYM => + JRST ESEND1 + JRST ESNXT ;KEEP LOOKING. + +;COME HERE IF 1ST SYM SEEN ISN'T THE SAME NAME. SET UP TO LOOP. +ESBAD0: MOVN TT,SYMLEN + SETOM ESLAST + SETOM ESL1 + SETOB C,ESXPUN +;HERE WHILE LOOPING WHEN SYM WITH WRONG NAME IS SEEN. +ESBAD: JUMPN B,ESNXT + SKIPGE A,ESXPUN ;IF THIS IS 1ST EXPUNGED ENTRY SEEN + MOVEM D,ESXPUN ;REMEMBER IT FOR DEFINITION. + SKIPGE A + HRROS ESLAST ;AND SET OLD ENTRY'S 3MAS. +ESNXT: ADD D,WPSTE + CAML D,SYMSIZ ;AT END => GO TO BEGINNING + MOVEI D,0 + AOJN TT,ESLP + JRST ESEND1 ;NOT FOUND. + +ESEND0: MOVEI C,(TM) ;COME HERE IF 1ST PLACE LOOKED AT SHOWS THE SYM ISN'T DEFINED + MOVEM D,ESXPUN + POPJ P, + +ESEND: SKIPGE A,ESXPUN ;FREE ENTRY CAN BE USED TO DEFINE. + MOVEM D,ESXPUN + SKIPGE A + HRROS ESLAST +ESEND1: SKIPGE ESL1 ;NOT FOUND => FIND PLACE TO DEFINE IT. + JRST DEFCH1 + MOVE D,SADR ;IDX OF BEST FOUND. + TRNN FF,FRNPSS + JRST ES1PS ;1-PASS, SPECIAL CHECK. + MOVE C,ESL2 ;GET BEST'S 3RDWRD. +ESGOOD: LDB A,[400400,,ST(D)] ;GET SQUOZE FLAGS IN A. +ES1POK: MOVE B,ST+1(D) ;VALUE OF SYM. IN B. + ;D HAS IDX OF 1STWRD IN SYM TAB. + ;C HAS 3RDWRD +POPJ1: AOS (P) +CPOPJ: POPJ P, + +;ESDCHK THEN DEFCHK IS SAME AS CALLING ESDEF. +DEFCHK: SKIPGE ESL1 ;IF WE DIDN'T TAKE TIME TO SET ESLAST BEFORE, + HRRZM D,ESLAST ;DO IT NOW. (SEE BEFORE ESLP1) + JRST DEFCH1 + +ES1PS: LDB A,[400400,,ST(D)] ;1PASS & FOUND IN CONTAINING BLOCK: + MOVE C,ESL2 + TRNN C,-1 ;INITIAL SYM, OK; + JRST ES1POK + CAIE A,1 ;PSEUDO OR MACRO + TLNE C,3DOWN ;OR .DOWN'D SYMBOL OK; + JRST ES1POK ;ELSE GET NEW STE TO DEF. +DEFCH1: MOVEI C,(TM) ;INITIALIZE NEW 3RDWRD WITH BLOCK TO DEF IN. + SKIPL D,ESXPUN ;IF FOUND EXPUNGED OR FREE ENTRY, USE IT. + JRST DEFCH2 + SKIPGE D,ESLAST ;ELSE LOOK FOR ONE. + ETF ERRSCE +DEFCH4: MOVE B,ST(D) + TLZ B,740000 + JUMPE B,DEFCH3 ;MUST RETURN 0 IN B IF DON'T SKIP. + ADD D,WPSTE + CAML D,SYMSIZ + MOVEI D,0 + AOJL TT,DEFCH4 ;ASSUME TT LEFT AROUND FROM ES. + ETF ERRSCE +ERRSCE: ASCIZ /Symbol table full/ + +;ESLAST HAS -1 IF NO ENTRY SEEN; ELSE +;RH HAS IDX OF LAST SEEN, SIGN SET IF SEEN BEFORE PLACE TO DEFINE. +DEFCH3: MOVEM D,ESXPUN ;REMEMBER ADDR WHERE CAN DEFINE + HRROS ESLAST ;LAST PLACE SEEN MUST BE EARLIER. +DEFCH2: SKIPL A,ESLAST + JRST DEFCH5 ;LAST PLACE SEEN WAS SEEN AFTER PLACE TO DEFINE. + CAMN A,[-1] + POPJ P, ;REALLY NEVER SEEN. + MOVSI TM,3MAS + IORM TM,ST+2(A) ;PLACE SEEN IS EARLIER, SET ITS 3MAS. + POPJ P, + +DEFCH5: TLO C,3MAS ;PLACE TO DEF BEFORE EXISTING STES. + POPJ P, + +;ENTER A SYM IN SYMBOL TABLE + ;B HAS VALUE + ;C HAS 3RDWRD + ;D HAS INDEX INTO ST (PROBABLY SET UP BY ES) + ;T HAS SQUOZE FLAGS (ONLY) IN PLACE FOR IOR OF SQUOZE + ;SYM HAS SQUOZE, FLAGS OF WHICH ARE IGNORED + +VSM2LV: TLOA C,3LLV ;ENTRY FOR LINKING LOADER MUST SUPPLY VALUE +VSM2W: MOVE B,WRD ;ENTRY TO ENTER VALUE OF WRD STEAD B +VSM2: MOVE CH1,SYM + TLZ CH1,740000 + IOR CH1,T ;CH1 := SQUOZE WITH FLAGS + MOVEM CH1,ST(D) ;STORE SQUOZE + MOVEM B,ST+1(D) ;STORE VALUE +VSM3A: 3PUT C,D ;STORE 3RDWRD + POPJ P, + +;RETURN THE NUMBER OF SYMTAB SLOTS IN USE. +A.SYMCN:MOVE D,SYMAOB + SETZ A, +A.SYC1: MOVE B,ST(D) + TLZ B,740000 + SKIPE B + AOS A + ADD D,WPSTE1 + AOBJN D,A.SYC1 + JRST CLBPOP + +;;EQUAL ;EQUAL SIGN ENCOUNTERED, DO PARAMETER ASSIGNMENT + +EQUAL: TLZ FF,FLHKIL + PUSHJ P,RCH + CAIE A,"= ;DECIDE WHETHER TO HALF-KILL THE SYM. + TLOA FF,FLUNRD + TLO FF,FLHKIL + SETZM LABELF + CALL RCH + CAIE A,": ;DECIDE WHETHER TO MARK SYM AS NOT REDEFINABLE. + TLOA FF,FLUNRD + SETOM LABELF + CAMN SYM,[SQUOZE 0,.] ;.=FOO, SAME AS LOC FOO + JRST PTEQ + TDNN I,[ILWORD,,IROP+IRNOEQ] + TRNN I,IRLET + ETR [ASCIZ/= With bad format or bad context/] + PUSH P,SYM + PUSH P,ESBK + PUSH P,I + MOVEI A,[ETSM [ASCIZ/Undefined in =/]] + MOVEM A,GTVER + TRO I,IRNOEQ+IRDEF+IREQL + PUSHJ P,GETWRD + MOVEI CH1,CRDF + MOVEM CH1,PARBIT ;SET FLAG TO TELL LOADER TO ALLOW REDEFINITION + TRNN I,IRDEF + JRST ASEM1A ;UNDEFINED SYMS IN VALUE, IGNORE +IFN LISTSW,[ + SKIPN LSTONP + JRST EQUAL1 ;NOT LISTING. + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE SYM,WRD + MOVEM SYM,LISTWD + MOVE SYM,WRDRLC + MOVEM SYM,LSTRLC + SETOM LISTAD + SETOM LISTPF +EQUAL1: +] ;END IFN LISTSW, + TDZ I,[-1-(ILMWRD)] + IOR I,(P) + TLZ FF,FLUNRD + POP P,(P) + POP P,ESBK + POP P,SYM + MOVE A,WRDRLC ;GET RELOCATION + TDNN A,[-2,,-2] ;SKIP ON NON-STANDARD RELOCATION BITS + SKIPE LDCCC + JRST EQG1 ;STRANGE RELOCATION OR IN LOAD TIME CONDITIONALS => HAND PROBLEM TO LOADER + MOVE A,GLSP1 + CAMN A,GLSP2 + JRST EQL1 ;NO GLOBALS IN DEFINITION +;FALLS THROUGH. + +;FALLS THROUGH. +;GLOBALS TO RIGHT OF = OR WITHIN LOADER CONDIT. +EQG1: IFN CREFSW, XCT CRFLBL ;CREF DEF. OF NORMAL SYM, + SKIPGE CONTRL + JUMPL FF,[ETASM [ASCIZ /Externals in =/]] + CALL ESDCHK ;SEARCH SYM TAB. + JRST EQL2 ;NOT FOUND IN CURRENT OR CONTAINING BLKS. + HRRZI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQG1A + XCT EQG1TB(A) ;FOUND IN DESIRED BLOCK. + JRST ASSEM1 + +EQG1A: JUMPN T,EQG2 + CAIN A,PSUDO_-16 ;FOUND AS INITIAL PSEUDO => ERROR. + ETSM ERRQPA +EQG2: CALL DEFCHK ;FIND FREE STE TO DEFINE IN DESIRED BLOCK. + JRST EQL2 ;PRETEND WASN'T FOUND. + +ERRQPA: ASCIZ /Shadowing a pseudo-op/ +ERRIPA: ASCIZ /Illegal =/ + +EQG1TB: ETSM ERRIPA ;COMMON + ETSM ERRIPA ;PSEUDO OR MACRO + JRST EQL2 ;SYM + JRST EQGUL ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL7 ;GLO ENTRY + JRST EQL8 ;GLO EXIT + +EQL8: PUSHJ P,GLKPNR + TLZ C,3LABEL\3MULTI +EQL7: MOVSI T,GLOETY ;GLOBAL PARA ASSIGN + MOVEI B,0 + TLO SYM,40000 +LOPRA1: PUSH P,CASM1A ;RETURN TO ASSEM1A AFTER FOLLOWING. + TLNE C,3MULTI + ETSM ERRMDT + SKIPE LABELF + TLO C,3LABEL + TLNE FF,FLHKIL + TLOA SYM,400000 ;SET FLAG TO HALF-KILL SYM + TLZA C,3SKILL + TLO C,3SKILL ;SET CORRESPONDING FLAG IN 3RDWRD + PUSHJ P,VSM2LV + JUMPGE FF,CPOPJ ;JUMP ON NOT PUNCHING PASS + SKIPN PARBIT ;IF CAME FROM COLON ROUTINE, + JRST PDEFPT ;PUNCH "DEFINE SYM AS $.". + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D ;STORE UPDATED 3RDWRD + PUSHJ P,EBLK + MOVEI TT,LGPA + DPB TT,[310700,,BKBUF] + PUSHJ P,OUTSM0 + PUSHJ P,PWRDA + JRST EBLK + +EQGUL: PUSHJ P,LKPNRO ;LOCAL UNDEF, OUTPUT LINK REQUEST. + TLZ C,3LABEL\3MULTI ;CAN'T DETECT MDT'S WHEN ONLY STINK KNOWS FOR SURE. +EQL2: TLNE I,ILGLI + JRST EQL7 ;MAKE IT GLOBAL + MOVSI T,LCUDF ;LOCAL UNDEFINED + JRST LOPRA1 + +CASM1A: JRST ASEM1A + +;MAYBE PUNCH OUT LINK REQUEST +;SYM HAS NAME OF SYM TO REQUEST, D STE IDX OF SYM, C 3RDWRD, B ADR OF REQUEST +;REQUEST WILL BE PUNCHED IF 3RLNK SET IN C OR IF ANYTHING SET IN LH(B) + +GLKPNR: TLO SYM,40000 ;GLO BIT +LKPNRO: TLNN C,3RLNK + TLNE B,-1 + TROA I,IRCONT + POPJ P, ;DON'T PUNCH REQUEST + MOVE A,CONTRL + TRNE A,DECREL + JRST LKPNDR ;DIFFERENT WAY TO OUTPUT THIS INFO IN DECREL FMT + MOVEI A,6 + PUSHJ P,PBITS + PUSHJ P,OUTSM0 ;PUNCH SYM + HLRZ A,B + TLZE C,3RLNK ;RELOC OF LINK PNR + TLO A,100000 + HRRZS B ;CLEAR OUT LH OF B + TRZ I,IRCONT ;OK TO END BLOCK NOW + JRST $OUTPT ;PUNCH OUT A AND RETURN + +LKPNDR: MOVSI A,DECINT ;WRITE AN "INTERNAL REQUEST" WITH ONE DATA WORD. + CALL DECBLK + SETZ TM, ;COMPUTE RELOC OF ADDRESS AND DATA IN TM. + TLNE C,3RLNK + TRO TM,2 + SKIPE WRDRLC + TRO TM,1 + MOVE A,WRD ;ADDRESS TO LINK,,DATA + HRL A,B + CALL DECWR1 + JRST EBLK + +;THESE ASSUME STE IDX IN D, SQUOZE W/ FLAGS IN SYM. +;C HAS 3RDWRD, B OR WRD HAS VALUE TO DEF. WITH. +;CALL ONLY IN RELOCATABLE ASSEMBLY. +OUTDE2: MOVEM B,WRD +OUTDE1: TLNE FF,FLPPSS + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D + SKIPGE CONTRL + RET + TRO I,IRCONT + PUSHJ P,P70 ;PUNCH OUT CODE BITS + PUSHJ P,GTVL7B ;SET RELOCATION BITS IN SQUOZE + PUSHJ P,OUTSM0 + TRZ I,IRCONT + JRST OUTWD ;OUTPUT VALUE + +;PUNCH OUT LOCAL-GLOBAL RECOVERY BITS AND SYM +;I.E. TELL LOADER THAT SQUOZE IN SYM, FORMERLY CONSIDERED LOCAL, IS REALLY GLOBAL +PLOGLO: SKIPGE CONTRL + RET + PUSH P,A + PUSHJ P,PBITS7 + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY THIS IS NEW STYLE RQ, + PUSHJ P,OUTSM0 ;PUNCH "OLD NAME" = SYMTAB IDX, + TLC SYM,440000 ;SAY MAKE GLOBAL, OUTPUT ACTUAL NAME OF SYM. + PUSHJ P,OUTSM + JRST POPAJ + + ;NO GLOBALS TO RIGHT OF EQUAL SIGN + +EQL1: PUSHJ P,ESDCHK + JRST EQL1A ;NOT FOUND +IFN CREFSW,XCT CRFEQL ;DEF. OCCUR. OF NORMAL SYM. OR INTSYM. + MOVEI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQL1F + SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL + XCT EQL1TB(A) ;FOUND IN DESIRED BLOCK => NOW REDEFINE. + JRST ASSEM1 + +EQL1F: JUMPN T,EQL10 + CAIE A,PSUDO_-16 + JRST EQL10 + MOVEI T,(B) ;FOUND AS PSEUDO IN INITIAL SYMS BLOCK, + CAIN T,INTSYM ;SPECIAL WAY TO REDEFINE IF LIKE .MLLIT, ETC. + JRST EQLINT + ETSM ERRQPA ;SHADOWING AN INITIAL PSEUDO, TELL USER. +EQL10: CALL DEFCHK ;FOUND IN OUTER BLOCK, GET NEW STE, + JRST EQL1A ;DEFINE THERE AS IF NOT FOUND. + +EQL1TB: ETSM ERRIPA ;COMMON + JRST EQL1B2 ;PSEUDO OR MACRO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL1D ;GLO ENTRY + JRST EQL1E ;GLO EXIT + +EQL1E: PUSHJ P,GLKPNR ;DUMP LINKING POINTER + CAIA +EQL1D: CALL MDTCHK + PUSHJ P,RCHKT ;GLO ENTRY +EQLB2: PUSHJ P,RMOVET + TLNE FF,FLHKIL + TLOA SYM,400000 + TLZA C,3SKILL + TLO C,3SKILL + HRLZI T,GLOETY + SKIPE LDCCC ;IF IN LOADER CONDITIONAL, + TLO C,3LLV ;THEN LOADER MUST SUPPLY VALUE + PUSHJ P,VSM2W ;DEFINE SYM + TLO SYM,40000 ;SET GLOBAL BIT IN SQUOZE +EQL1CE: JUMPGE FF,ASEM1A + PUSHJ P,OUTDE1 +ASEM1A: TLNE I,ILMWRD + PUSHJ P,IGTXT + JRST ASSEM1 + +;CHECK WHETHER DEFINING AN MDT, OR REDEFINING A LABEL (=> THIS IS AN MDT) +MDTCHK: TLNN C,3LABEL + JRST MDTCH1 + CALL GVSYM0 ;MOVE VALUE OF SYM TO A, GET RELOC (WRDRLC STYLE) IN B + CAMN A,WRD + CAME B,WRDRLC ;IF WE'RE CHANGING THE VALUE, MARK SYM AS MDT +MDTCHL: TLO C,3MULTI +MDTCH1: TLNE C,3MULTI ;EVER ASSIGNING TO MDT, EVEN SAME VALUE, GIVES ERR MSG + ETSM ERRMDT + RET + +EQL1C: TLNE I,ILGLI + JRST EQL1CA ;MAKE GLOBAL + PUSH P,C + PUSHJ P,LKPNRO ;MAYBE OUTPUT LINK REQUEST + PUSHJ P,RCHKT + PUSHJ P,RMOVET ;INITIALIZE 3RDWRD + MOVSI T,SYMC ;SYM + PUSHJ P,EQA2A ;ENTER DEF IN SYMTAB + TLNE C,3SKILL + TLO SYM,400000 + POP P,AA + TLNE AA,3VCNT ;USED IN CONSTANT + PUSHJ P,CONBUG + JRST EQL1CE + + ;PUNCH OUT CODE BIT PAIR, FIRST OF WHICH IS 7 + +P7X: MOVEM A,PARBIT ;ENTRY FOR SECOND BYTE IN A +P70: PUSHJ P,PBITS7 ;ENTRY FOR SECOND BITE IN PARBIT, PUNCH OUT THE 7 + SKIPA A,PARBIT ;GET SECOND BYTE BACK +PBITS7: MOVEI A,7 ;ENTRY TO JUST PUNCH OUT 7 + JRST PBITS + +EQL1CA: PUSHJ P,PLOGLO + JRST EQL1E +EQA2: PUSH P,CASM1A +EQA2A: TLNE FF,FLHKIL + TLO C,3SKILL + JRST VSM2W + +EQL1B2: HRRZ A,B ;ATTEMPT TO ASSIGN PSEUDO-OP, IS IT AN INTSYM? + CAIN A,INTSYM + JRST EQLINT ;YES, GO SET WD IT POINTS TO. + ETSM [ASCIZ /Pseudo or macro ='D/] +EQL1B: CALL MDTCHK + PUSHJ P,RCHKT + TLNE I,ILGLI + JRST EQLB2 ;WAS LOCAL, MAKE IT GLOBAL + ;WAS LOCAL, LEAVE IT LOCAL + PUSHJ P,RMOVET ;PUT RELOCATION BITS IN BITS 0 AND 1 OF C (I.E. START SETTING UP 3RDWRD) + MOVSI T,SYMC ;SYM + JRST EQA2 + +EQL1A1: PUSHJ P,RCHKT + PUSHJ P,RMOVET + HRLZI T,SYMC + JRST EQA2 + +EQL1A: SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL +IFN CREFSW,XCT CRFLBL ;DEF. OCCUR. OF NORMAL SYM. + TLNN I,ILGLI + JRST EQL1A1 + JRST EQL1E + +EQLINT: HLRZS B ;GET ADDR OF WD HOLDING VALUE. + MOVEMM (B),WRD ;PUT NEW VALUE IN IT. + JRST ASEM1A + +;;. ;ROUTINES DEALING WITH THE CURRENT LOCATION AND OFFSET + +VBLK +CLOC: 0 ;PUNCHING LOC +CRLOC: 0 ;PUNCHING RELOC +OFLOC: 0 ;OFSET VAL +OFRLOC: 0 ;OFSET RELOC +;VAL OF PT=CLOC+OFLOC,CRLOC+OFLOC +SYLOC: 0 ;VAL OF LAST TAG +SYSYM: 0 ;LAST TAG +SYLOC1: 0 ;VALUE OF NEXT TO LAST TAG +SYSYM1: 0 ;NEXT TO LAST TAG +GLOCTP: 0 ;4.9 => CURRENT LOCATION GLOBAL, 2.9 => OFFSET GLOBAL + ;FRGLOL (FLAG IN FF) IS IOR OF BITS 4.9 AND 2.9 OF GLOCTP + ;EXCEPT AFTER .=NON-GLOBAL WITH GLOBAL OFFSET + ;OTHER BITS USED ONLY WHEN IN LINK (NEVER SET IN GLOCTP): + ;400 => ARG GLOBAL +PBLK + + + ;POINT (.) AS PSEUDO-OP + +GTVLP: TRNE FF,FRGLOL + JRST GTVLP2 ;LOCATION GLOBAL + MOVE B,OFRLOC ;GET RELOCATION OF OFFSET + ADD B,CRLOC ;ADD CURRENT RELOCATION + MOVE A,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 ;IF IN BYTE MODE, + HLL A,BYTWP ;SET LEFT HALF TO BYTE POINTER LEFT HALF FOR ILDB + ADD A,OFLOC ;NOW ADD OFFSET + TLZ I,ILFLO+ILDECP+IRPERI ;CLEAR OUT FLAGS SET WHEN LOOKED LIKE FLOATING POINT NUMBER + POPJ P, + + +GTVLP2: MOVEI T,$.H ;LOCATION GLOBAL + AOS GLSP1 + HRRZM T,@GLSP1 ;PUT $. ON GLOBAL LIST (INCLUDES OFFSET, WHETHER GLOBAL OR NOT) + SKIPL BYTM1 ;IN BYTE MODE? + TDZA A,A ;NO, CLEAR ABS PART OF VALUE + HLLZ A,BYTWP ;YES, USE LH(BP) AS ABS PART + JRST CLBPOP + +$.H: (GLOETY)+SQUOZE 0,$. ;CURRENT LOCATION + OFFSET IN LOADER +$L.H: (GLOETY)+SQUOZE 0,$L. ;LOCATION BEING LOADED INTO BY LOADER, USED BY ABLOCK +$O.H: (GLOETY)+SQUOZE 0,$O. ;LOADER OFFSET +$R.H: (GLOEXT)+SQUOZE 0,$R. ;RELOCATION AS GLOBAL + +COLON: TRNE I,IRLET + TRNN I,IRSYL + ETA [ASCIZ/Colon without preceding symbol/] + TLNN I,ILWORD + TRNE I,IROP+IRPSUD+IREQL+IRNOEQ + ETSM [ASCIZ/Label inside an expression/] + SKIPE ASMOUT + ETSM [ASCIZ /Label inside <>, () or []/] + TLZ FF,FLHKIL + PUSHJ P,RCH ;GET NEXT CHAR + CAIN A,": ;IF NEXT CHAR ANOTHER COLON, + TLOA FF,FLHKIL ;THEN SET FLAG TO HALF-KILL + TLO FF,FLUNRD ;NOT COLON, CAUSE IT TO BE RE-INPUT + SKIPE HKALL ;CHECK FOR HALF-KILL-ALL-LABELS MODE. + TLO FF,FLHKIL + MOVE T,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 + HLL T,BYTWP ;BYTE MODE, SET LEFT HALF OF VALUE TO LEFT HALF OF BYTE POINTER + ADD T,OFLOC ;ADD OFFSET + MOVEM T,WRD ;STORE RESULT AWAY FOR POSSIBLE PUNCHOUT + EXCH T,SYLOC ;NOW SET UP STUFF FOR ERROR PRINTOUT + MOVEM T,SYLOC1 + EXCH SYM,SYSYM + MOVEM SYM,SYSYM1 + MOVE SYM,SYSYM + MOVE A,CRLOC ;SET UP RELOCATION + ADD A,OFRLOC + MOVEM A,WRDRLC + CLEARM PARBIT ;SET FLAG SAYING COLON, FOR DEFINITION PUNCHING + SETOM LABELF ;SET FLAG CAUSING 3LABEL (DON'T REDEFINE) TO BE SET. + SKIPN LDCCC + TRNE FF,FRGLOL + JRST GCOL1 ;LOCATION VIRTUAL OR IN LOAD TIME CONDITIONAL + PUSHJ P,ESDCHK ;TRY FINDING CURRENT ENTRY IN ST + JRST EQL1A ;NOT ALREADY DEFINED +IFN CREFSW,XCT CRFLBL +COLON1: MOVEI T,(C) ;BKTAB IDX OF BLOCK FOUND IN, + CAIE T,(TM) ;FOUND IN DESIRED BLOCK => TRY REDEFINING. + JRST COLON3 + TLO C,3LABEL ;CAUSE REDEFINING SYMBOL TO BARF + XCT COLON2(A) ;BUT MAYBE PRINT ERR MSG FIRST. + JRST EQL1B + +CASSM1: JRST ASSEM1 + +COLON3: JUMPN T,EQL10 ;NOT INITIAL SYM => CAN SHADOW, + CAIN A,SYMC_-14. ;INITIAL SYM => CAN SHADOW IF IT'S AN ORDINARY LOCAL SYM + CAME B,WRD ;AND NEW VALUE SAME AS OLD VALUE. + CAIA + SKIPE WRDRLC + ETSM ERRRES ;ELSE GIVE ERROR MESSAGE BEFORE SHADOWING, TO WARN USER. + JRST EQL10 + +ERRRES: ASCIZ /Pseudo, macro or initial sym as label/ +ERRMDT: ASCIZ /Multiply defined/ + +COLON2: TLO C,3MULTI ;COMMON + ETSM ERRRES ;MACRO OR PSEUDO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI ;SETTING 3MULTI CAUSES EQL1B TO PRINT AN MDT ERROR. + JRST EQL1D ;GLOBAL ENTRY + JRST EQL1E ;GLO EXIT + +;COLON WHEN LOCATION VIRTUAL, OR IN LOAD TIME CONDITIONAL + +GCOL1: IFN CREFSW,XCT CRFLBL ;DEFINING ORDINARY SYM. + SKIPGE CONTRL + ETASM [ASCIZ /Virtual label in abs assembly/] + PUSHJ P,ESDCHK ;FIND ITS SLOT IN ST + JRST EQL2 ;JUST LIKE EQG1 EXCEPT FOR ERROR MESSAGES. + MOVEI T,(C) + CAIE T,(TM) + JRST COLON5 + XCT GCOL1T(A) ;FOUND IN DESIRED BLOCK, REDEFINING. + JRST EQL2 + +COLON5: JUMPN T,EQG2 ;SHADOWING, OK UNLESS INITIAL SYM. + ETSM ERRRES + JRST EQG2 + +GCOL1T: TLO C,3MULTI ;COMMON + ETSM ERRRES ;PSEUDO. + JRST EQL2 ;SYM. + JRST EQGUL ;LOCAL UNDEF. + TLO C,3MULTI ;VAR + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + JRST EQL7 ;DEF GLO + JRST EQL8 ;UNDEF GLO. + + + ;PUNCH OUT "DEFINE SYM AS $." + +PDEFPT: MOVEI A,CDEFPT + PUSHJ P,P7X ;OUTPUT 7 THEN PDEFPT + JRST OUTSM0 ;OUTPUT SYM, WITHOUT BITS + +;LOC, BLOCK, .= + +ALOC: PUSHJ P,ALOCRG ;LOC, GET ARG +ALOC1: SETZM SYLOC ;CLEAR OUT LOC OF LAST TAG + SETZM SYSYM ;CLEAR OUT LAST TAG SO ERROR MESSAGES DON'T PRINT OBSCENE INCREMENTS +IFN FASLP,[ + SKIPGE TM,CONTRL + TRNN TM,FASL + JRST .+2 + ETA [ASCIZ /LOC illegal in FASL assembly/] +] + TRZE LINK,400 ;GLOBALS IN ARG? + JRST ALOC2 ;YES + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF CURRENT LOCATION + CALL SLOCF ;RE-INIT NEXT OUTPUT BLOCK'S HEADER; SET LOCF. + MOVEI A,LCEGLO ;=> RESET GLOBAL RELOCATION (BACK TO ORIGINAL NON-GLOBAL RELOCATION) + TLZE LINK,400000 ;IS CURRENT LOCATION NOW GLOBAL? + PUSHJ P,PLDCM ;YES, RESET IT + MOVE B,WRDRLC ;GET BACK NEW RELOCATION +ALOC2B: TRZE B,-2 ;NO BITS ALLOWED EXCEPT LOW ORDER + ETR [ASCIZ *Illegal relocation in LOC/BLOCK/.=*] + HRRZM B,CRLOC ;STORE NEW RELOCATION + SKIPGE CONTRL + JRST ASSEM1 ;DON'T BOTHER WITH REST IF ABS. + MOVEI B,2(B) ;LABS OR LREL + DPB B,[310700,,BKBUF] ;STORE NEW BLOCK TYPE + MOVEM B,CDATBC ;ALSO STORE AS NORMAL BLOCK TYPE +AOFSTX: TDNN LINK,[SETZ(SETZ)] ;ENTRY FROM AOFFSET, SKIP IF FRGLOL SHOULD BE SET + TRZA FF,FRGLOL ;CURRENT LOCATION PLUS OFFSET NOT GLOBAL, CLEAR FLAG + TRO FF,FRGLOL ;GLOBAL, SET FLAG + TRZ LINK,600 ;CLEAR OUT TEMPORARY FLAGS SO WON'T GET STORED IN GLOCTP + MOVEM LINK,GLOCTP ;STORE BACK STATUS FLAGS + JRST ASSEM1 + +PTEQ: MOVE SYM,[SQUOZE 0,LOC] + PUSHJ P,ALOCRG ;.=, GET ARG + MOVE T,[MINF+HFWDF,,$O.H] ;GLOTB ENTRY IF .+1 DOESN'T SKIP + TRNE LINK,400000 ;OFFSET GLOBAL? + JRST PTEQ2 ;YES, WANT TO DO LOC ARG-$O." + PUSHJ P,SBWDOF ;OFFSET IS LOCAL, SUBTRACT FROM ARG + JRST ALOC1 + +ABLOCK: PUSHJ P,ABLKRG ;GET ARG TO "BLOCK" PSEUDOOP. + TRNE LINK,400 ;GLOBALS IN ARG? + JRST ABLKG ;GLOBALS IN ARG + TLNE LINK,400000 + JRST ABLKG ;JUMP IF LOSER CHANGING RELOCATION WHILE CLOC GLOBAL +IFN FASLP,[ + MOVE D,CONTRL + TRNN D,FASL ;IN FASL FORMAT, CAN'T SET LOC. CTR., + JRST ABLKF1 + SKIPE B + ETA [ASCIZ /BLOCK size relocatable/] + JUMPGE FF,ABLKF1 + CALL ABLKF ;SO ON PASS 2 OUTPUT A BUNCH OF ZEROS. + JRST ABLKF1 + +;OUTPUT C(A) ZEROS, IN FASL FORMAT. NO-OP ON PASS 1. DOESN'T SET THE LOCATION COUNTER. +ABLKF: JUMPE A,CPOPJ + JUMPGE FF,CPOPJ + SETZM WRD + SETZM WRDRLC + SAVE A + SAVE A +ABLKF2: CALL FASPW + MOVEMM GLSP2,GLSP1 + SOSE (P) + JRST ABLKF2 + JRST POPBAJ +] + +ABLKF1: ADD A,CLOC ;ARG TO BLOCK IS LOCAL, ADD DIRECTLY TO CLOC + ADD B,CRLOC ;ALSO ADD RELOCATIONS + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF LOCATION + CALL SLOCF ;FALL INTO ALOC ROUTINE, MAKING SURE FRLOC GETS SET + JRST ALOC2B + + +SBWDOF: SUB A,OFLOC ;SUBTRACT OFFSET FROM WRD, ETC. IN A,B + HRRZM A,WRD ;MAKE SURE RESULT GETS STORED IN WRD, AS WELL AS AC'S + SUB B,OFRLOC ;NOW DO RELOCATIONS + HRRZM B,WRDRLC + POPJ P, + +ABLKG: TRNE LINK,400000 ;GLOBAL BLOCK, IS OFFSET GLOBAL? + JRST ABLKG2 ;YES, OK TO REFERENCE $L. + PUSHJ P,SBWDOF ;NO, FOR COMPATIBILITY, DON'T REFERENCE $L. + SKIPA T,[HFWDF,,$.H] +ABLKG2: MOVE T,[HFWDF,,$L.H] +PTEQ2: AOS GLSP1 ;STORE T IN GLOTB + MOVEM T,@GLSP1 +ALOC2: TLO LINK,400000 ;SET GLOBAL LOCATION FLAG + MOVEI A,LCGLO ;=> GLOBAL LOCATION ASSIGNMENT + PUSHJ P,PLDCM ;PUNCH OUT GLOBAL LOCATION ASSIGNMENT + SETZM CLOC ;CLEAR OUT CLOC, NEW RELOCATION NOW + SETZB B,BKBUF ;ALSO CLEAR OUT HEADER, JUST TO BE SURE + AOJA B,ALOC2B ;SET RELOCATION TO 1 AND FALL IN + +AOFFSET: PUSHJ P,AOFFS2 ;OFFSET, GET ARG + MOVE A,T + MOVEM A,WRD ;RESTORE UNTRUNCATED ARG. + TRZE LINK,400 ;GLOBALS IN ARG? + TROA LINK,400000 ;GLOBALS IN ARG, SET GLOBAL OFFSET FLAG + TRZ LINK,400000 ;NO GLOBALS IN ARG + MOVEM A,OFLOC ;STORE NEW OFFSET + MOVEM B,OFRLOC ;ALSO STORE RELOCATION BITS + SKIPGE CONTRL ;IN RELOCATABLE, + JRST AOFSTX + MOVEI A,LDOFS ;LOADER OFFSET LOADER COMMAND TYPE + PUSHJ P,PLDCM ;PUNCH OUT LOADER COMMAND + JRST AOFSTX + +;GET ARG TO LOC, BLOCK, .=, OFFSET + +ALOCRG: +ABLKRG: MOVE A,CLOC + SKIPN CRLOC + JRST [ CAML A,DECBRA ;IF ADDR BEFORE THE LOC WAS ABS, + MOVEM A,DECBRA ;UPDATE HIGHEST ABS ADDR IF NEC. + JRST ABLKR1] + CAML A,DECTWO ;IT WAS RELOCA; UPDATE HIGHEST + JRST [ CAML A,DECBRH ;ADDR OF APPROPRIATE SEG. + MOVEM A,DECBRH + JRST ABLKR1] + CAML A,DECBRK + MOVEM A,DECBRK +AOFFS2: +ABLKR1: SAVE SYM + PUSHJ P,CONBAD ;ERROR IF IN GROUPING + REST SYM + TRNE I,IRNOEQ\IRPSUD\IREQL + ETSM [ASCIZ /Inside pseudo or =/] + TDNE I,[ILWORD,,IRFLD] + ETSM ERRNVL + PUSHJ P,EBLK ;MAYBE END CURRENT OUTPUT BLOCK + PUSHJ P,AGETWD ;GET ARG + MOVE LINK,GLOCTP ;GET GLOCTP FLAGS IN LINK, STAYS THERE UNTIL ALMOST DONE + MOVE T,GLSP2 + CAME T,GLSP1 + TROA LINK,400 ;SIGNAL GLOBAL ARG + TRZ LINK,400 ;LOCAL + MOVE T,A ;SAVE UNTRUNCATED FOR AOFFSET, + HRRZS A,WRD ;TRUNCATE FOR LOC, BLOCK, .=. + TRNN I,IRDEF ;ALL DEFINED? + JRST ASSEM1 + SKIPGE CONTRL ;YES, RETURN SKIPPING OVER ARG + TRNN LINK,400 + RET + MOVE SYM,GTVER + ETASM [ASCIZ *Argument has externals*] + +;;CONSTANTS AND VARIABLES + ;VARIABLES AREA +VBLK + +LCNGLO==CONMIN/4 +LCONTB==CONMIN + +BLCODE [ +PCNTB: BLOCK NCONS*3 ;CONSTANTS AREAS TABLE +VARTAB: BLOCK NVARS +] +CONTBA: CONTAB ;ADDRESS OF BEGINNING OF CONSTANTS TABLE. +CONTBE: CONTAB+LCONTB ;ADDRESS OF WORD AFTER END OF CONSTANTS TABLE. +PLIM: 0 ;POINTER TO FIRST UNUSED WORD IN CONSTANTS TABLE. + +CONGLA: CONGLO ;ADDRESS OF BEGINNING OF CONSTANT-GLOBALS TABLE. +CONGLE: CONGLO+LCNGLO ;ADDRESS OF WORD AFTER END OF CONSTANT GLOBALS TABLE. +CONGOL: 0 ;HAS ADR OF FIRST WORD INACTIVE IN CONSTANT-GLOBALS TABLE. + +CONBIA: CONBIT ;ADDRESS OF BEGINNING OF CONSTANT-RELOCATION-BITS TABLE. + +CONLEN: CONMIN ;TOTAL SPACE ALLOCATED TO CONSTANTS TABLES. + ;ALL THE HOOKS ARE IN FOR DYNAMIC ALLOCATION OF THESE TABLES + ;(CONTAB, CONGLO, AND CONBIT). ALL THAT IS NEEDED IS TO GET + ;THE SPACE AND INITIALIZE CONTBA, CONTBE, CONGLA, CONGLE, CONBIA. + + ;PCNTB STUFF + + ;EACH ENTRY 3 WORDS; FIRST WORD SQUOZE, NAME OF AREA IF GLOBAL +CSQZ: 0 ;SQUOZE COUNTER + ;SECOND WORD RH LOC OF AREA (WITH OFFSET), LH LOC FIRST AFTER AREA (WITHOUT OFFSET) + ;THIRD WORD LH FLAGS + +CGBAL==100000 ;GLOBAL (INCLUDING OFFSET) +CTRL==200000 ;RELOCATED ( " ) +CTDEF==400000 ;DEFINED (MUST BE SIGN) + +PBCON: 0 ;POINTER INTO PCNTB, HAS ADR OF ENTRY FOR NEXT CONSTA +PBCONL: 0 ;POINTER TO ABSOLUTE TOP OF PCNTB +CONCNT: 0 ;NUMBER OF TIMES CONSTANTS CAN APPEAR (DECREMENTED BY CONSTA) +CONDEP: 0 ;DEPTH IN CONSTANTS (0 TOP LEVEL) +CONSAD: 0 ;ADDR IN CONSTANTS TABLE OF ENTRY FOR CURRENT CONST. +CONSML: 0 ;VALUE OF .MLLIT INTSYM. + ;NEGATIVE => ERROR MODE (DEFAULT) + ;ZERO => OLD MODE. + ;POSITIVE => NEW (MULTI-LINE) MODE. + +CONSTP: 0 ;PDL POINTER BELOW WDS FOR INNERMOST CONSTANT. +CONSP1: 0 + + ;VARIABLES FOR VARIABLES CODING + +VARCNT: 0 ;NO OF VAR IN CURRENT VAR AREA SO FAR +VARPNT: 0 ;POINTER TO CURRENT PLACE IN VARTAB +VARCNR: 0 ;NO OF TIMES VARIABLES MAY APPEAR +VCLOC: 0 ;TEM FOR VARIAB +VECSIZ: 0 ;DEFAULT SIZE FOR .VECTOR. + +PBLK + +;LEFT-BRACKET ENCOUNTERED; HERE ON DISPATCH FROM GETFD +;SAVE WORLD, BYTE MODE, ASSEM1 PDL LEVELS. +;THEN SET ASSEM1 PDL LEVELS TO CURRENT LEVELS +;SO ASSEM1 WON'T FLUSH PAST LEVEL OF CONSTANT. +;SET CONSTP _ CURRENT PDL LEVEL. PCONS WILL PUT WORDS +;OF CONSTANT ABOVE CONSTP, AND SET ASSEMP ABOVE THEM. + +LBRAK: SKIPE LITSW + ETR [ASCIZ /Literal/] + TRO I,IRFLD ;LEFT BRACKET + JSP LINK,SAVWD1 ;SAVE CRUFT + PUSH P,SCNDEP ;SO THE NEXT RBRKT WON'T TRY TO CLOSE CONDIT. + JSP LINK,SAVAS1 + MOVEIM ASMOUT,3 + SETZM SCNDEP ;NOT WITHIN CONDITIONALS IN THIS LITERAL. + AOS CONDEP ;ONE DEEPER IN LITERALS. + JRST ASSEM3 ;GO ASSEMBLE THE WORDS OF THE CONSTANT. + +;OUTPUT WORD TO CONSTANT. P MUST EQUAL ASSEMP HERE. +PCONS: SKIPL CONTRL ;IF RELOCATABLE, + PUSHJ P,$RSET ;HANDLE STRANGE RELOCATIONS. + MOVE B,GLSP1 + SUB B,GLSP2 ;NUM. GLOBAL ENTRIES FOR THIS WD. + HLRZ A,WRDRLC ;ONLY 1.1 AND 3.1 BITS MATTER. + LSH A,1 + IOR A,WRDRLC ;GET THEM INTO 1.1, 1.2 BITS. + TLNE I,ILNOPT ;REMEMBER ILNOPT ALSO. + IORI A,4 + DPB B,[032200,,A] ;AND # GLBLS. + PUSH P,A ;SAVE THEM ALL. + HRLI B,(B) ;GET # GLBLS,,# GLBLS . + JUMPE B,PCONS1 + MOVE A,GLSP2 + MOVSI A,1(A) + HRRI A,1(P) ;SAVE THE GLBLS, IF ANY. + ADD P,B + JUMPGE P,CONFLP + BLT A,(P) +PCONS1: PUSH P,WRD + MOVEM P,ASSEMP ;ASSEMP -> ABOVE WDS FOR LIT.; CONSTP, BELOW. + JRST (T) + +;JSP LINK,SAVAS1 TO PUSH DATA ON ASSEM1 LEVEL AND CALL ASSEM1 +;LOOP RECURSIVELY. +.SEE CONNDP ;WHICH IS WHERE THESE THINGS ARE POPPED. +SAVAS1: SKIPN BYTM ;IF IN BYTM NOW (WILL PUSH AND TURN OFF) + JRST LBRAK1 + MOVSI A,BYBYT ;SAVE ALL THE DETAILS. + HRRI A,1(P) + ADD P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] + JUMPGE P,CONFLP ;(SOFTWARE-DETECTED PDL-OV) + BLT A,-BYTMCL(P) + MOVSI A,BYTMC + HRRI A,1-BYTMCL(P) + BLT A,(P) +LBRAK1: PUSH P,BYTM + SETZM BYTM + SAVE ASMOUT + SAVE ASMDSP + SAVE ASMI + PUSH P,GLSPAS ;SAVE ASSEM1 PDL LEVELS. + PUSH P,ASSEMP + PUSH P,CONSTP + MOVE A,I + ANDI A,IRPSUD+IREQL + IORI A,IRDEF + MOVEM A,ASMI ;ASMI IOR'D INTO I AT ASSEM2 LOOP. + HRRZ A,CPGN + HRL A,CLNN ;REMEMBER WHERE THIS LITERAL STARTS. + INSIRP PUSH P,[A SYSYM SYLOC] + MOVEM P,ASSEMP ;SO ASSEM1 WON'T FLUSH WHAT WE PUSHED. + MOVEM P,CONSTP ;SO CONND CAN FIND 1ST WD OF CONSTANT. + MOVEMM GLSPAS,GLSP1 +SAVAS2: MOVEI A,ASSEM3 ;IF NOT MULTI-LINE MODE, ARRANGE TO + SKIPG CONSML ;END THE CONSTANT AFTER 1 WORD. + MOVEI A,ASSEMC + MOVEM A,ASMDSP + JRST (LINK) + +PCONST: MOVE CH1,ASMDSP ;OUTPUT TO CONST. FROM ASSEM1 + CAIN CH1,CONND ;LAST WD OF CONST? + CAME P,CONSTP ;1ST WD? + JRST PCONS ;NO, DO THE GENERAL THING. + SKIPL CONTRL ;THIS MUST BE ONLY WORD OF CONST, + PUSHJ P,$RSET ;DON'T BOTHER PUSHING, END CONST. NOW. + PUSH P,CONSTP + TLZ I,ILMWRD+ILMWR1 ;THIS IS 1ST WD, NO MORE WDS. + JRST CONND3 ;PRETEND JUST POPPED IT. + +;COME HERE FROM ASSEM1 TO END A CONSTANT. +CONND: SKIPE BYTM ;IF IN BYTE MODE, LEAVE IT AND DO .WALGN + JRST A.BY3 ;(WILL COME BACK SINCE ASMDSP STILL SET) +CONNDW: MOVEMM CONSP1,CONSTP + TLZ I,ILMWR1 ;THIS IS 1ST WORD COMING UP. +CONND0: TLZ I,ILMWRD+ILNOPT + SETZM WRDRLC + MOVE F,CONSP1 ;ADDR IN IN PDL OF NEXT WD. + CAMN F,ASSEMP + JRST CONND2 ;J IF NO WORDS. + MOVE A,1(F) ;GET SAVED NUM GLBLS,,NUM GLBLS + DPB A,[100,,WRDRLC] + LSH A,-1 ;RESTORE WRDRLC BITS 1.1, 3.1 + DPB A,[220100,,WRDRLC] + TRNE A,2 + TLO I,ILNOPT ;RESTORE NOOPTF. + LSH A,-2 ;GET # GLBLS. + HRLI A,(A) ;# GLBLS,,# GLBLS. + AOBJN F,.+1 + HRRZM F,GLSP2 ;ADDR BEFORE 1ST GLOBAL ENTRY. + ADD F,A + HRRZM F,GLSP1 ;ADDR OF LAST GLOBAL ENTRY. + MOVE A,1(F) + MOVEM A,WRD + AOBJN F,.+1 ;POINT TO NEXT CONST WD IF ANY, + MOVEM F,CONSP1 + CAME F,ASSEMP ;IF MORE WORDS SET ILMWRD + TLO I,ILMWRD + JRST CONND3 + +CONND2: INSIRP SETZM,[WRD,GLSP1,GLSP2] +CONND3: MOVE F,GLSP1 + SUB F,GLSP2 + JUMPE F,SCON ;JUMP IF NOTHING VIRTUAL + MOVEI B,-1(F) + MOVN TT,B + JUMPE B,SCON ;JUMP IF ONLY ONE GLOBAL + ;SORT GLOTB ENTRIES THIS CONSTANT +LSORT: HRL T,TT ;SET UP AOBJN POINTER TO GLOBALS REMAINING + HRR T,GLSP2 +LSORT2: MOVE A,1(T) + CAMLE A,2(T) + EXCH A,2(T) ;INTERCHANGE + MOVEM A,1(T) + AOBJN T,LSORT2 ;INNER LOOP POINT + SOJG B,LSORT ;OUTER LOOP + ;DROPS THROUGH + + ;DROPS THROUGH +SCON: PUSHJ P,RCHKT + PUSHJ P,RMOVET ;SET UP RELOACTION BITS. + ROT T,2 ;ROTATE TO BOTTOM TWO BITS OF T + TLNE I,ILMWRD+ILMWR1+ILNOPT + JRST NOCON ;MULTIPLE WORD OR OPTIMIZATION SUPPRESSED, DON'T TRY TO FIND MATCH + MOVE A,CONTBA +SCON1: CAML A,PLIM ;SEARCH CONSTANTS TABLE TO SEE IF ALREADY THERE + JRST NOCON ;END OF TABLE, NO MATCH + MOVE B,WRD + CAME B,(A) +SCON2: AOJA A,SCON1 ;VAL DISAGREES + PUSHJ P,CPTMK ;GET BP TO CONSTANTS-BIT TABLE IN C + LDB F,C ;GET RELOCATION BITS THIS CONSTANT + CAME F,T + JRST SCON2 ;RLC DIFFRS + MOVE B,CONGLA ;VALUE AND RELOCATION AGREE, NOW TO CHECK GLOBALS + SKIPA C,GLSP2 +SCON2B: AOS B ;SEARCH FOR GLOBAL POINTING TO CONSTANT WHICH HAS MATCHED SO FAR + CAML B,CONGOL + JRST SCON3 ;GLOBALS MATCH SO FAR + CAME A,1(B) ;SKIP IF ONE FOUND +SCON7: AOJA B,SCON2B ;NOT YET + MOVE D,(B) ;FOUND ONE, GET GLOTB ENTRY + CAME D,1(C) ;COMPARE WITH THIS ENTRY IN GLOTB + JRST SCON2 ;NO MATCH, FLUSH THIS CONSTANT + AOJA C,SCON7 ;MATCH, TRY NEXT GLOBAL + +SCON3: CAME C,GLSP1 ;GLOBALS MATCH, BUT ARE WE EXACTLY AT END OF GLOTB? + JRST SCON2 ;NO, BACK TO SEARCH + JRST NOCON4 + +NOCON: AOS A,PLIM ;CONSTANT NOT ALREADY IN TABLE + CAMLE A,CONTBE + ETF [ASCIZ/Literal table full/] + MOVE AA,WRD + MOVEM AA,-1(A) + SOS A + PUSHJ P,CPTMK + TLNE I,ILNOPT + TRO T,4 ;1.3 OF RELOCATION BITS => DON'T OPTIMIZE ON TOP OF ME + DPB T,C + MOVE B,GLSP2 +NOCON3: CAML B,GLSP1 + JRST NOCON4 + SKIPN C,1(B) + AOJA B,NOCON3 ;THIS ENTRY NOT REALLY HERE + MOVEM C,@CONGOL + HRRZS C + PUSHJ P,NOCON5 + MOVEM A,@CONGOL + PUSHJ P,NOCON5 + SKPST C, ;SKIP IF IN SYMBOL TABLE + AOJA B,NOCON3 + 3GET1 D,C ;IN SYMBOL TABLE + TLO D,3VCNT ;THIS SYM USED IN CONSTANT + 3PUT1 D,C ;UPDATE 3RDWRD TABLE ENTRY + AOJA B,NOCON3 + +NOCON5: AOS AA,CONGOL + CAML AA,CONGLE + ETF [ASCIZ/Constants-global table full/] + POPJ P, + + ;SET UP BYTE POINTER TO CONSTANTS-BIT TABLE + ;A SHOULD HAVE ADR OF CONSTANTS TABLE ENTRY + ;LEAVES ANSWER IN C + ;BITS IN CONSTANTS-BIT TABLE PER ENTRY: + ;1.2, 1.1 RELOCATION BITS + ;1.3 ILNOPT BIT => DON'T OPTIMIZE ON TOP OF ME + +CPTMK: PUSH P,A + SUB A,CONTBA + PUSH P,B + IDIVI A,12. + MOVEI C,(A) + ADD C,CONBIA ;SET UP ADDRESS PART + IMULI B,3 + DPB B,[360600,,C] ;STORE POSITION FIELD FROM REMAINDER + TLO C,200 ;SET UP SIZE FIELD +POPBAJ: POP P,B + JRST POPAJ + +NOCON4: TLON I,ILMWR1 + MOVEM A,CONSAD ;IF 1ST WD SAVE ADDR. + TLNE I,ILMWRD ;IF MORE WORDS, HANDLE NEXT. + JRST CONND0 + MOVE P,CONSTP ;VALUE OF CONSTP AT CONND. + MOVE C,GLSPAS ;TO RESTORE GLSP1 + JSP T,CONNDP ;POP STUFF. + HRRZ A,CONSAD ;ADDR OF CONSTANTS TABLE ENTRY OF 1ST WD. + MOVE B,PBCON ;ADDR OF WDS DESCRIBING CONST. AREA. + SKIPL 2(B) ;CONST. AREA LOCATION DEFINITE? + AOJA C,CONND6 ;NO, USE GLOBAL. + MOVEM C,GLSP1 + HRRZ C,1(B) ;ADD ACTUAL ADDR OF CONST. AREA. + ADDI A,(C) ;GET C(CONTBA) + ADDR OF CONSTANT. + LDB B,[420100,,2(B)] + JRST CONND7 + +CONND6: MOVEM C,GLSP1 + MOVEM B,(C) + MOVEI B,0 +CONND7: SUB A,CONTBA + JRST LSSTH3 ;POP OUT INTO OUTER WORD. + +.SEE SAVAS1 ;WHICH IS WHAT PUSHES WHAT CONNDP POPS. +CONNDP: SUB P,[3,,3] ;FLUSH SAVED SYLOC AND SYSYM AND CLNN,,CPGN. +CONFL2: HRL T,ASMOUT ;REMEMBER IF POPPING A LITERAL OR NOT. + INSIRP POP P,[CONSTP,ASSEMP,GLSPAS,ASMI,ASMDSP,ASMOUT,BYTM] + SKIPN BYTM ;IF IN BYTE MODE, POP DETAILS. + JRST CONND5 + MOVSI A,1-BYTMCL(P) + HRRI A,BYTMC + BLT A,BYTMC+BYTMCL-1 + MOVSI A,1-BYTMCL-LBYBYT(P) + HRRI A,BYBYT + BLT A,BYBYT+LBYBYT-1 + SUB P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] +CONND5: HLRZ A,T + CAIE A,3 + JRST (T) + POP P,A + ADDM A,SCNDEP ;DON'T FORGET ABOUT ANY CONDITIONALS. + SOS CONDEP ;HAVE POPPED ONE CONSTANT. + JRST (T) + +CONFLS: MOVE P,ASSEMP ;FLUSH ALL CONSTANTS. + CAMN P,[-LPDL,,PDL] ;IF IN ANY, + JRST (LINK) + MOVE P,CONSTP ;POINT AFTER ITS PDL ENTRY, + JSP T,CONNDP ;POP IT, + JRST CONFLS ;TRY AGAIN. + +CONBAD: SKIPN ASMOUT ;IF IN GROUPING, ERROR. + POPJ P, + ETSM [ASCIZ/Within <>, () or []/] + JRST ASSEM1 + +;COME HERE FOR PDL-OV ON P. +;IF IN A CONSTANT, FLUSH ALL OF THEM, SAYING WHERE EACH STARTED. +;THEN TYPE A PDL ERROR MSG AND RETURN TO ASSEM1. +;OTHERWISE FATAL ERROR. +CONFLP: MOVEI LINK,ASSEM1 + MOVEI CH1,ERRPDL + SKIPE CONDEP + JRST CONFL3 ;IN A CONSTANT. + MOVEI P,PDL ;RE-INIT PDL SO NO MORE PDL-OV. + ETF ERRPDL +ERRPDL: ASCIZ /PDL overflow/ + +;JSP LINK,CONFLM TO FLUSH CONSTANTS, SAYING WHERE THEYY STARTED, +;AND GIVE ERROR MSG. +CONFLM: MOVE CH1,ASMOUT + SKIPA CH1,ASMOT3(CH1) +CONFLZ: SETZ CH1, ;LIKE CONFLM BUT NO ERR MSG AT END. +CONFL3: SETO C, +CONFL1: MOVE P,CONSTP ;GET STACK ABOVE INNERMOST LITERAL. + REST SYLOC + REST SYSYM + REST D ;GET INFO ON WHERE STARTED + AOSN C ;THE 1ST TIME ONLY, SAY WHAT'S GOING ON. + TYPR [ASCIZ/Within groupings: /] + SKIPE C + TYPR [ASCIZ/, /] + MOVE A,ASMOUT ;SAY WHAT KIND OF GROUPING IS BEING CLOSED + MOVE A,ASMOT5(A) + CALL TYOERR ;BY SAYING WHAT CHAR OPENED IT. + JSP T,CONFL2 ;POP REST OF WDS SAVED AT LBRAK. + TYPR [ASCIZ/ at /] + MOVEI A,1(D) ;PAGE # GROUPING STARTED ON. + CALL DPNT ;PRINT IN DECIMAL. + MOVEI A,"- + CALL TYOERR + HLRZ A,D ;LINE NUMBER IT STARTED ON. + ADDI A,1 + CALL D3PNT2 ;PRINT W/ AT LEAST 3 CHARS, NO ZERO SUPPR. + MOVE A,ASSEMP + CAME A,[-LPDL,,PDL] ;MORE GROUPINGS TO POP => DO. + JRST CONFL1 + CALL CRRERR + MOVE P,ASSEMP + JUMPE CH1,(LINK) ;IF CALLED CONFLZ, NO ERR MSG (CALLER WILL GIVE ONE) + ETR (CH1) ;[ NO] OR PDL. + CALL CRRERR + JRST (LINK) + + ;CONSTA + +CNSTNT: NOVAL + SKIPE ASMOUT ;IF ANY GROUPNGS, + JSP LINK,CONFLM ;FLUSH THEM, GIVE ERROR. + PUSHJ P,CNSTN0 + JRST ASSEM1 + +CNSTN0: SOSGE CONCNT ;ENTRY FROM AEND + ETF [ASCIZ /Too many constants areas/] + MOVE B,CLOC + ADD B,OFLOC + HRRZ T,PBCON + TRNN FF,FRPSS2 + JRST CNST1 ;PASS 1 + + MOVSI A,CGBAL + TDZ A,2(T) + TRNE FF,FRGLOL + TLC A,CGBAL + SKIPN A + ETR [ASCIZ /Constants globality phase error/] + HRRZ B,1(T) + SUB B,OFLOC + HRRZS B + CAME B,CLOC + ETR [ASCIZ /Constants location phase error/] + MOVE B,2(T) + ROT B,2 + XOR B,CRLOC + XOR B,OFRLOC + TRNE B,1 + ETR [ASCIZ /Constants relocation phase error/] + ;DROPS THROUGH + + ;DROPS THROUGH +CNST2: MOVEI D,(T) ;STE IDX IN D FOR OUTSM0 + MOVE SYM,(T) ;GET NAME OF AREA + TLC SYM,400000#LCUDF ;CLEAR LCUDF, SET HALF-KILL + TRNE FF,FRGLOL + PUSHJ P,PDEFPT ;DEFINE SYM FOR BEGINNING OF CONSTANTS AREA + MOVE A,CONTBA +CNSTH: CAML A,PLIM + JRST CNSTA ;THRU + MOVE TT,(A) + MOVEM TT,WRD + PUSHJ P,CPTMK + LDB F,C ;GET THIS CONSTANT'S RELOCATION BITS + TRZE F,2 + TLO F,1 ;RELOCATE LEFT HALF + MOVEM F,WRDRLC ;STORE RELOCATION + MOVEI D,GLOTB ;AND NOW TO SET UP GLOTB! + MOVEM D,GLSP2 + MOVE C,CONGLA +CNSTC: CAML C,CONGOL + JRST CNSTB ;END OF CONSTANT-GLOBAL TABLE + CAMN A,1(C) ;POINTS TO THIS CONSTANT? + PUSH D,(C) ;YES, STORE ENTRY IN GLOTB + AOS C + AOJA C,CNSTC + +CNSTB: HRRZM D,GLSP1 ;MARK END OF ACTIVE PART OF GLOTB + PUSH P,A + PUSHJ P,PWRD ;OUTPUT THIS CONSTANT + AOS CLOC ;INCREMENT CLOC TO NEXT + HRRZS CLOC ;MAKE SURE IT STAYS IN A HALF-WORD (IMPORTANT SINCE MAY BE LESS THAN RELOCATION) + POP P,A ;RESTORE POINTER INTO CONSTANTS TABLE + AOJA A,CNSTH + +CNST3: HLRZ A,1(T) ;GET POINTER TO TOP OF AREA STORED DURING PASS 1 + CAMN A,CLOC ;SAME AS CURRENT? + JRST CNSTE ;YES, NO HAIR + CAMGE A,CLOC ;DIFFERENT; LOWER? + ETR [ASCIZ /More constants on pass 2 than 1/] + ;INSUFFICIENT CONSTANT SPACE; CONSTANTS AREA TRYING TO BE BIGGER + ;IN PASS 2 THAN PASS 1; THE EXTRA CONSTANTS WERE BACKED OVER + MOVEM A,CLOC ;EITHER WAY, SET CLOC TO TOP OF AREA SO WON'T HAVE MDT TROUBLE + PUSHJ P,EBLK ;END CURRENT BLOCK + CALL SLOCF ;IF RELOCATABLE, MAKE SURE NEW VALUE OF $. GETS PUNCHED + JRST CNSTE + +;CALL SLOCF WHENEVER "." IS CHANGED WITHOUT THE OUTPUTTING OF A STORAGE WORD. +SLOCF: MOVE A,CLOC ;STORE NEW "." IN HEADER FOR NEXT BLOCK OF OUTPUT. + SKIPGE TM,CONTRL + TRNN TM,DECREL+FASL ;BUT NOT IN DEC OR FASL OUTPUT FORMATS. + HRRM A,BKBUF + IORI FF,FRLOC ;MAKE SURE NULL BLOCK IS OUTPUT IF NEC. TO TELL LOADER "." HAS CHANGED. + RET + + ;CONSTA DURING PASS 1 + +CNST1: HRRM B,1(T) ;STORE LOCATION OF AREA + MOVEI D,0 + MOVE A,CRLOC + ADD A,OFRLOC + TRNE A,1 + TLO D,CTRL ;RELOCATED + TRNE FF,FRGLOL + TLO D,CGBAL ;GLOBAL + IORM D,2(T) ;STORE FLAGS DESCRIBING AREA + JUMPL FF,CNST2 ;JUMP ON PUNCHING PASS, PUNCH OUT AREA NOW + MOVE T,PLIM + SUB T,CONTBA + ADDM T,CLOC ;PASS 1, JUST UPDATE CLOC + HRRZS CLOC + +CNSTA: HRRZ T,PBCON + TRNE FF,FRGLOL + JRST CNSTD ;LOCATION GLOBAL + TRNN FF,FRNPSS + SKIPGE 2(T) + JRST CNSTDA ;2 PASS ASSEMBLY OR AREA DEFINED + TRO I,IRCONT ;1PASS AND NOT DEFINED + SETZM PARBIT + PUSHJ P,P70 ;DEFINE SYM + MOVE A,(T) + TLC A,400000#LCUDF + SKIPE CRLOC + TLO A,100000 ;RELOCATE + PUSHJ P,$OUTPT + HRRZ A,1(T) + PUSHJ P,$OUTPT ;OUTPUT VALUE, FIRST LOCATION IN AREA + TRZ I,IRCONT +CNSTDA: MOVSI A,CTDEF + IORM A,2(T) ;CALL IT DEFINED +CNSTD: TRNE FF,FRPSS2 + JRST CNST3 ;PASS 2 + MOVE A,CLOC + HRLM A,1(T) ;MARK END OF AREA + +CNSTE: MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + MOVEI T,3 + ADDB T,PBCON + CAML T,PBCONL + MOVEM T,PBCONL + AOS A,CSQZ + MOVEM A,(T) + POPJ P, + + ;DEFINING SYM USED IN CONSTANT, DELETE REFERENCES FROM CONSTANT-GLOBAL TABLE + +CONBUG: MOVE A,CONGLA ;B VAL C FLAGS ST(D) SADR + PUSH P,T + PUSH P,C ;SAVE FLAGS +CONBG2: MOVE C,(P) ;GET FLAGS + CAML A,CONGOL ;DONE WITH SCAN? + JRST CONBG1 ;YES + HRRZ F,(A) ;NO, GET CONSTANT-GLOBAL TABLE ENTRY + CAIE F,ST(D) ;POINT TO THIS SYM? + AOJA A,CONBG6 + PUSH P,B ;YES, SAVE VALUE, ABOUT TO WORK WITH B + MOVE T,(A) ;GET ENTIRE CONSTANT-GLOBAL TABLE ENTRY + LDB CH2,[221200,,T] ;GET MULTIPLICATION FIELD + SKIPE CH2 + IMUL B,CH2 ;NON-ZERO => MULTIPLY VALUE OF SYM + TLNE T,MINF + MOVNS B ;NEGATE VALUE + TLNE T,HFWDF + HRRZS B ;TRUNCATE TO HALFWORD + TLNE T,ACF + ANDI B,17 ;AC, MASK TO FOUR BITS + TLNE T,SWAPF + MOVSS B ;SWAP VALUE + TLNE T,ACF + LSH B,5 ;AC, SHIFT FIVE + ADD B,@1(A) ;ADD ABS PART OF VALUE + TLNN T,SWAPF + HRRM B,@1(A) ;NOT SWAPPED, STORE LH + TLNE T,SWAPF + HLLM B,@1(A) ;SWAPPED, STORE LH + TLNN T,HFWDF + MOVEM B,@1(A) ;FULL WORD, STORE VALUE + LDB CH1,[420200+P,,-1] ;GET HIGH BITS OF 3RDWRD, RELOCATION BITS + TLNE T,HFWDF ;NOW TO MAP RELOCATION BITS + TRZ CH1,2 + TLNE T,SWAPF + LSH CH1,1 + TRZE CH1,4 + TRO CH1,1 + PUSH P,A + HRRZ A,1(A) ;GET POINTER INTO CONSTANTS TABLE + PUSHJ P,CPTMK + LDB B,C ;GET RELOCATION BITS + TLNE T,MINF + JRST CONBG8 ;NEGATE + TRNE B,(CH1) + ETA ERRCRI + ;ATTEMPTED MULTIPLE RELOCATION IN CONSTANT + ; ^ ABOVE SHOULD BE REPLACED WITH A $RSET LIKE ROUTINE + ;THAT ALSO SEARCHES CONSTANT-GLOBAL TABLE FOR $R. ALREADY THERE + IOR B,CH1 ;LOOKS OK, IOR IN BITS FOR GLOBAL +CONB8A: DPB B,C ;STORE BACK NEW RELOCATION BITS FOR CONSTANT + POP P,A + CLEARM (A) ;CLEAR OUT CONSTANT-GLOBAL TABLE ENTRY + CLEARM 1(A) + POP P,B + AOS A +CONBG6: AOJA A,CONBG2 ;BACK FOR NEXT CONSTANT, DON'T KNOW HOW MANY THIS SYM USED IN + +CONBG1: MOVE A,CONGLA + PUSH P,B + MOVE B,CONGLA +CONBG7: CAML A,CONGOL + JRST CONBG3 + SKIPN C,(A) +CONBG5: AOJA A,CONBG4 + MOVEM C,(B) + MOVE C,1(A) + MOVEM C,1(B) + AOS B + AOJA B,CONBG5 + +CONBG4: AOJA A,CONBG7 +CONBG3: MOVEM B,CONGOL + POP P,B + POP P,C + POP P,T + POPJ P, +CONBG8: XORI B,3 + TRNE B,(CH1) + ETA ERRCRI + ANDCB B,CH1 + JRST CONB8A + +ERRCRI: ASCIZ /Multiple relocation in constant/ + + ;VARIAB + +AVARIAB: NOVAL + SKIPE ASMOUT ;FLUSH ANY GROUPINGS IN PROGRESS. + JSP LINK,CONFLM + PUSHJ P,AVARI0 + JRST ASSEM1 + +AVARI0: SOSG VARCNR ;ENTRY FROM AEND + ETF [ASCIZ /Too many variable areas/] + MOVE D,SYMAOB ;SET UP AOBJN POINTER TO ST + MOVE T,CLOC + MOVEM T,VCLOC ;STORE AS LOCATION OF VARIABLE AREA + ADD T,OFLOC + MOVE C,CRLOC + ADD C,OFRLOC + TRNE FF,FRPSS2 + JRST AVAR1 ;PASS 2 + HRL T,VARCNT ;SIZE OF AREA + TRNE C,1 + TLO T,400000 ;RELOCATED + MOVEM T,@VARPNT + JRST AVAR2E + +AVAR1: HRRZ A,@VARPNT ;VARIAB DURING PASS 2 + CAIE A,(T) + ETR [ASCIZ /Variables location phase error/] + HLRZ A,@VARPNT + TRZE A,400000 + XORI C,1 + TRNE C,1 + ETR [ASCIZ /Variables relocation phase error/] + SKIPE VARCNT + ETR [ASCIZ /Variables area size phase error/] + +AVAR2E: HLRZ T,@VARPNT + TRNN T,377777 + JRST AVAR2C ;IF THIS VAR AREA IS EMPTY, DON'T SCAN SYMTAB. +AVAR2: HLRZ LINK,ST(D) ;SCAN, CHECKING EACH SYM FOR WHETHER IT'S A VARIABLE + CAIL LINK,DEFLVR + JRST AVAR2B + ADD D,WPSTE1 + AOBJN D,AVAR2 + JRST AVAR2C ;ALL SCANNED. + +AVAR2B: 3GET C,D ;FOUND A VARIABLE; DECIDE WHAT TO DO WITH IT. + MOVE B,ST+1(D) + MOVE SYM,ST(D) + TLZ SYM,740000 + LDB LINK,[400400,,ST(D)] + CAIE LINK,UDEFLV_-14. + CAIN LINK,UDEFGV_-14. + JRST AVAR3 ;UNDEFINED VARIABLE + CAIE LINK,DEFGVR_-14. + CAIN LINK,DEFLVR_-14. + JRST AVAR4 ;DEFINED VARIABLE +AVAR2A: ADD D,WPSTE1 + AOBJN D,AVAR2 ;CHECK ENTIRE SYMTAB +AVAR2C: HLRZ A,@VARPNT ;NOW GET SIZE OF AREA + TRZ A,400000 ;CLEAR OUT RELOCATION CHECK BIT +IFN FASLP,[ + MOVE D,CONTRL + TRNE D,FASL ;IN FASL ASSEMBLY, CAN'T JUST SET LOC CTR; MUST OUTPUT 0'S. + CALL ABLKF +] + ADD A,VCLOC ;ADD LOCATION OF BEGINNING OF VARIABLE AREA + MOVEM A,CLOC ;STORE AS NEW CURRENT LOCATION + PUSHJ P,EBLK + CALL SLOCF + CLEARM VARCNT ;INITIALIZE COUNT OF VARIABLES IN NEXT AREA + AOS VARPNT ;INCREMENT POINTER TO POINT TO NEXT AREA + POPJ P, + + ;UNDEFINED VARIABLE FOUND IN SYMTAB SCAN + +AVAR3: CAIN LINK,UDEFGV_-14. ;GLOBAL? + TLO SYM,40000 ;GLOBAL + PUSHJ P,LKPNRO + MOVSI T,DEFLVR + CAIN LINK,UDEFGV_-14. + MOVSI T,DEFGVR + TRNE FF,FRGLOL + JRST AVAR3A ;LOCATION GLOBAL + MOVEI B,-1(B) + ADD B,VCLOC + ADD B,OFLOC + MOVE TT,CRLOC + ADD TT,OFRLOC + SKIPE TT + TLO C,3RLR + CAIE LINK,UDEFGV_-14. + TLZN C,3VCNT + SKIPA + PUSHJ P,CONBUG +AVAR4B: PUSHJ P,VSM2 + JUMPGE FF,AVAR2A ;IF PUNCHING PASS, OUTPUT DEFINITION. + PUSHJ P,OUTDE2 + JRST AVAR2A + +AVAR4: TLNE C,3VAS2 ;DEFINED VARIABLE FOUND DURING SYMTAB SCAN + TLOE C,3VP + JRST AVAR2A + MOVSI T,(LINK) ;CAUSE AVAR4B TO REDEFINE AS SAME TYPE. + LSH T,14. + TRNN FF,FRGLOL + JRST AVAR4A +AVAR3A: PUSHJ P,VSM2LV + JUMPGE FF,AVAR2A + PUSHJ P,PDEFPT + MOVEI A,0 + PUSHJ P,PBITS + PUSHJ P,$OUTPT + AOS CLOC + JRST AVAR2A + +AVAR4A: CAIN LINK,DEFGVR_-14. ;DEF VAR, 3VAS2, POINT NOT GLOBAL. + JRST AVAR4B ;VAR GLOBAL, MUST PUNCH DEF SINCE DIDN'T ON PASS1. + 3PUT C,D ;LOCAL, JUST SET 3VP SO DON'T SEE IT NEXT VARIAB. + JRST AVAR2A ;NO NEED TO PUNCH DEF SINCE WAS DEF ON PASS1. + +;;MAIN ;"MAIN" MIDAS ROUTINES: INIT, PS1, PLOD, PS2, PSYMS + ;ALL CALLED WITH JSP A,; ALL GLOBAL + ;RETURN INSTRUCTION FROM JSP IN LOCATION RETURN +PS1: HRRM A,RETURN ;PASS 1, (PASS 1 INITIALIZATION ALREADY DONE), SAVE RETURN + SAVE [ASSEM1-1] ;SIMBLK WILL POPJ1. +IFN A1PSW,[SKIPL PRGC + JRST A1PAS1 ;THIS NOT FIRST PROGRAM THIS ASSEMBLY, SET MODE TO 1PASS +] + TRO FF,FRNPSS +IFN ITSSW,JRST SIMBLK ;SELECT SBLK AND ASSEMBLE +IFN DECSW\TNXSW,JRST A.DECRE ;SELECT .DECREL AND ASSEMBLE. + +PS2: HRRM A,RETURN ;PASS 2 (MAIN ROUTINE, PASS 2 INITIALIZATION NOT ALREADY DONE), SAVE RETURN + JUMPL FF,PA2A ;JUMP IF PASS 1 ENDED IN 1PASS MODE + TDO FF,[FLPPSS,,FRPSS2] ;SET PUNCHING PASS AND PASS 2 FLAGS + PUSHJ P,P2INI ;INITIALIZE + JRST ASSEM1 ;START ASSEMBLING + +PA2A: MOVE A,SYMAOB ;PASS 2 OF 1PASS ASSEMBLY, CHECK FOR UNDEFINED LOCALS +PA2C: MOVE SYM,ST(A) ;GET SQUOZE THIS SYMTAB ENTRY + LDB B,[400400,,SYM] ;GET FLAGS + CAIE B,LCUDF_-14. ;LOCAL UNDEFINED? + JRST PA2B ;NOT LOCAL UNDEFINED, DON'T COMPLAIN + 3GET C,A ;LOCAL UNDEFINED, GET 3RDWRD ST ENTRY + TLZ SYM,740000 ;CLEAR OUT FLAGS IN SYM IN ANTICIPATION OF TYPING OUT COMPLAINT + TLNN C,3LLV ;PROBLEM HANDED TO LINKING LOADER? + ETSM [ASCIZ /Undefined/] ;NO +PA2B: ADD A,WPSTE1 ;NOW GO FOR NEXT ST ENTRY + AOBJN A,PA2C + JRST RETURN + +$INIT: HRRM A,RETURN ;INITIALIZATION (BEFORE PASS 1 ONLY) ROUTINE, SAVE RETURN POINT +IFN CREFSW,PUSHJ P,CRFOFF ;DON'T CREF ON 1ST PASS. +IFN LISTSW,CALL LSTOFF ;DON'T LIST ON 1ST PASS. + SKIPGE ISYMF + JRST INIT1 ;SPREAD SYMS (RETURNS TO SP4) + MOVE A,SYMAOB ;ALREADY SPREAD, JUST FLUSH ALL BUT INITIAL SYMS +INIT4: SKIPN B,ST(A) + JRST INIT2 + 3GET C,A + TRNE C,-1 ;INITIAL SYM? + CLEARM ST(A) ;NO +INIT2: ADD A,WPSTE1 + AOBJN A,INIT4 + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1] + BLT A,EBKCOD ;CLEAR OUT BLANK CODE + +SP4: PUSH P,CRETN +P1INI: CLEARB I, LDCCC + INSIRP SETZM,BKBUF ISYMF A.PASS +IFN FASLP,[ + INSIRP SETZM,FASATP FASPCH + CLEARM FASIDX +] + MOVEMM DECTWO,[[MOVE]] + TDZ FF,[-1-FLVOT-FLPTPF-FLTTY,,-1] ;INITIALIZE MOST FF FLAGS + MOVEIM A.PPASS,2 ;DEFAULT IS 2-PASS. + PUSHJ P,MACINI ;INITIALIZE MACRO STATUS + MOVEI A,PCNTB + MOVEM A,PBCONL + MOVS A,[BKTAB,,P1INI1] + BLT A,BKTAB+4 + MOVEIM BKTABP,BKWPB*2 + ;DROPS IN. +P2INI: INSIRP SETZM,[CPGN,CLNN,GENSM,OFLOC,OFRLOC,CRLOC,BKPDL +SYLOC,SYSYM,BYTW,BYTRLC,STGSW,DECBRK,DEFNPS,BYTM,BYTM1,HKALL,QMTCH] + AOS B,A.PASS +IFN ITSSW,[ + CALL SETWH2 ;SET UP .WHO2, PREPARE .WHO3 IN A WITH PAGENUM=1. + .SUSET [.SWHO3,,A] ;'P1 ',,PAGENUM OR 'P2 ',,PAGENUM + .SUSET [.SWHO1,,[.BYTE 8 ? 166 ? 0 ? 165 ? 0]] +] + TDZ FF,[FLUNRD,,FRGLOL] +IRP X,,[BKWPB,BKCUR,,BKPDL+1,1,BKLVL,IRDEF,ASMI +NCONS,CONCNT,VARTAB,VARPNT,NVARS,VARCNR,1,VECSIZ] +IFE 1&.IRPCN,IFSN [X], MOVEI A,X +IFN 1&.IRPCN, MOVEM A,X +TERMIN + MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + CLEARM VARCNT + CLEARM PBITS2 + MOVE A,[440300,,PBITS1] + MOVEM A,BITP + MOVEI A,PBITS4 + HRRZM A,PBITS4 + CLEARB I,PBITS1 + MOVEI A,PCNTB + MOVEM A,PBCON + MOVE A,[(LCUDF)++1] ;< AND > FOR COMPATIBILITY WITH OLD + MOVEM A,PCNTB + MOVEM A,CSQZ + MOVEI A,8 + MOVEM A,ARADIX +IFN ITSSW,[ + MOVEI A,100 + MOVEM A,CLOC +] +.ELSE [ SETZM CLOC + AOS CRLOC ;CRLOC GETS 1 +] + SETZM GLOCTP + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,CONTRL ;IN DEC FORMAT, OUTPUT PROGRAM NAME. + TRNE A,DECREL + CALL DECPGN ;CLOBBERS A +IFN FASLP,[ + SETOM FASBLC ;LOSING BLOCK COUNT + MOVE A,CONTRL ;IN FASL FORMAT, OUTPUT FASL HEADER + TRNE A,FASL + CALL FASOIN ;INITIALIZE FASL OUTPUT +] + SETZM DECBRH + TRO FF,FRSYMS+FRFIRWD + MOVE A,[IFORTB,,FORTAB] ;INITIALIZE FORMAT TABLE ON EACH PASS + BLT A,FRTBE + MOVEIM GLSPAS,GLOTB ;INIT. ASSEM1 PDL LEVELS TO BOTTOM. + MOVEMM ASSEMP,[[-LPDL,,PDL]] + MOVEIM ASMDSP,ASSEM3 + SETZM ASMOUT + SETZM CONSTP + SETZM SCNDEP ;NOT IN CONDIT. OR CONSTANT. + SETZM CONDEP + HRRZM P,CONSML ;START OUT IN MULTI-LINE MODE. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + MOVEM A,PNTBP + CLEARM LISTPF + SETOM LISTBC + SKIPG LISTP1 ;IF LIST ON PASS 1 + JUMPGE FF,CRETN ;OR PUNCHING PASS, + SKIPE LISTP ;IF WANT LISTING, + CALL LSTON ;TURN ON OUTPUT OF LISTING. +] +IFN CREFSW,[ + JUMPGE FF,CRETN + SKIPE CREFP ;IF C SWITCH WAS SEEN, + PUSHJ P,CRFON ;TURN ON CREFFING, +] +CRETN: POPJ P,RETURN + +P1INI1: SQUOZE 0,.INIT ? 0 ? 3 + SQUOZE 0,.MAIN ? 1,, + +PLOD: HRRM A,RETURN ;MAIN ROUTINE TO PUNCH LOADER, CALLED BEFORE PASS 2 (PS2"), SAVE RETURN POINT + PUSHJ P,PLOD1 ;PUNCH LOADER + JRST RETURN ;RETURN + + ;PUNCH OUT THE LOADER + +PLOD1: PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE + MOVE B,CONTRL + TRNE B,ARIM10 + JRST PLOD2 ;RIM10 => PUNCH OUT SBLK LOADER FOR PDP10 READIN-MODE READIN + TRNN B,SBLKS + POPJ P, ;NOT SBLK => DON'T PUNCH LOADER +PLOD1A: MOVSI B,SLOAD-SLOADP ;PUNCH SBLK LOADER IN RIM FORMAT + MOVSI C,(DATAI PTR,) +PLOAD1: MOVE A,C + PUSHJ P,PPBA + CAMN C,[DATAI PTR,13] + HRRI C,27 + MOVE A,SLOAD(B) + PUSHJ P,PPBA + AOS C + AOBJN B,PLOAD1 + MOVE A,[JRST 1] + PUSHJ P, PPBA + JRST FEED1 + +PLOD2: MOVSI C,LDR10-ELDR10 ;PUNCH SBLK LOADER FOR PDP10 READIN +PLOD3: MOVE A,LDR10(C) + PUSHJ P,PPBA + AOBJN C,PLOD3 + JRST FEED1 + + ;SBLK LOADER NORMALLY PUNCHED OUT IN RIM FORMAT + +SLOAD: CONO PTR,60 ;0 RESTART POINT (NEW BLOCK) + JSP 14,30 ;1 START POINT, LOOP POINT FOR NEW BLOCK; WAIT FOR DATA WORD READY + DATAI PTR,16 ;GET HEADER + MOVE 15,16 ;INITIALIZE CHECKSUM + JUMPGE 16,16 ;HEADER .GE. 0 => STARTING INSTRUCTION + JSP 14,30 ;5 LOOP POINT FOR NEXT DATA WORD: WAIT FOR READY + DATAI PTR,(16) ;READ IN DATA WORD + ROT 15,1 ;NOW UPDATE CHECKSUM + ADD 15,(16) + AOBJN 16,5 ;LOOP FOR ALL DATA WORDS THIS BLOCK + MOVEI 14,33 ;30 TO RETURN TO 33 + JRST 30 ;WAIT FOR READY THEN GO TO 33 + ;14 JSP AC FOR ROUTINE AT 30 + ;15 CHECKSUM + ;16 AOBJN POINTER (UPDATED HEADER) + CONSO PTR,10 ;30 ROUTINE TO WAIT FOR DATA WORD READY FOR DATAI + JRST 30 + JRST (14) + DATAI PTR,16 ;33 GET CHECKSUM + CAMN 15,16 ;COMPARE WITH CALCULATED + JUMPA 1 ;OK, GO GET NEXT BLOCK (DON'T CHANGE TO JRST OR REAL LOADERS WILL GET CONFUSED) + JRST 4, ;CHECKSUM ERROR +SLOADP==. + +;PDP10 SBLK LOADER +;FOLLOWING CODING ACTUAL WORDS TO BE OUTPUT + ;BY ASSEMBLER, COMPILER, OR WHATEVER +;SHOULD BE EXECUTED BY PDP10 HARDWARE READIN FEATURE +;USES ONLY THE AC'S (BUT ALL OF THEM) + +LDR10: + -17,,0 ;BLKI POINTER FOR READ SWITCH + +LDRC=0 ;CHECKSUM (OK, SO YOU'RE NOT ALLOWED TO LOAD + ;INTO IT DURING HARDWARE READIN, BUT WHO SAYS + ;YOUR PROGRAM CAN'T USE IT?) +OFFSET -.+1 ;BEGIN LOADING INTO 1 AS PER HEADER +LDRGO==. + CONO PTR,60 ;START UP PTR (RESTART POINT) +LDRRD==. + HRRI LDRB,.+2 ;INITIALIZE INDEX +LDRW==. + CONSO PTR,10 ;WAIT FOR WORD TO BE AVAILABLE + JRST .-1 + ROT LDRC,-LDRRD(LDRB) ;BEFORE READING IN HEADER, ROTATE 2 BITS (THEN IGNORE) + ;BEFORE READING IN EACH DATA WORD, ROTATE 1 BIT (FOR UPDATING CHECKSUM) + ;BEFORE READING IN CHECKSUM, ROTATE NOT AT ALL (DON'T ROTATE CALCULATED CHECKSUM) + DATAI PTR,@LDRT1-LDRRD(LDRB) ;READ WORD INTO RIGHT PLACE + ;HEADER => READ INTO C + ;STORAGE WORD => READ INDEXED BY AOBJN POINTER IN A + ;CHECKSUM => READ INTO A FOR COMPARISON WITH C(C) + XCT LDRT1-LDRRD(LDRB) ;EXECUTE RELEVANT T1 ENTRY (MAYBE SKIPS) + XCT LDRT2-LDRRD(LDRB) ;EXECUTE RELEVANT T2 ENTRY (MAYBE JUMPS) +LDRB==. + SOJA ., ;-RD(B) IS 2, 1, AND 0 FOR SUCCESSIVE ENCOUNTERS OF THIS INSTRUCTION + ;USED AS INDEX INTO TABLES, ETC. + + ;TABLE 1 + ;INDIRECTED THROUGH FOR DATAI + ;THEN EXECUTED TO SEE WHAT TO DO WITH READ IN WORD + ;ENTRIES EXECUTED IN REVERSE ORDER + +LDRT1==. + CAME LDRC,LDRA ;COMPARE CHECKSUM WITH CALCULATED, SKIP TO B IF THEY AGREE + ADD LDRC,(LDRA) ;UPDATE CHECKSUM + SKIPL LDRA,LDRC ;INITIALIZE HEADER AND SKIP UNLESS JUMP BLOCK + + ;TABLE 2 + ;EXECUTED IF CORRESPONDING ENTRY IN TABLE 1 DIDN'T SKIP WHEN EXECUTED + +LDRT2==. + JRST 4,LDRGO ;CHECKSUM ERROR + AOBJN LDRA,LDRW ;UPDATE AOBJN POINTER AND GO BACK FOR NEXT STORAGE WORD IF NOT EXHAUSTED +LDRA==. + JRST LDRRD ;WHEN INITIALLY LOADED IS JUMP BLOCK TO THIS LOADER + ;DURING LOADING USED TO HOLD HEADER (AOBJN POINTER), WHICH MAY BE LOADED JUMP BLOCK + +OFFSET 0 +ELDR10==. + +;FLAGS IN SQUOZE OF SYMS TO OUTPUT + +ABSGLO==040000 ;SYM IS GLOBAL (IF RELOCA, SAYS THIS IS BLOCK NAME) +ABSLCL==100000 ;LOCAL +ABSDLI==200000 ;DELETE INPUT (DON'T RECOGNIZE IT IF TYPED IN) +ABSDLO==400000 ;DELETE OUTPUT (DON'T TYPE IT OUT) + +PSYMS: HRRM A,RETURN ;PUNCH OUT SYMBOL TABLE, CALLED AFTER EVERYTHING ELSE, SAVE RETURN POINT + PUSH P,PSYMS ;AT END, POPJ TO RETURN. + TRNE FF,FRSYMS + JRST SYMDMP ;PUNCH SYMS IF NEC. + SKIPL A,CONTRL + JRST SYMDA ;IF RELOCA, PUNCH PROGRAM NAME. + TRNN A,DECREL + POPJ P, +PSYMSD: MOVSI A,DECEND + PUSHJ P,DECBLK ;START AN END-BLOCK. + MOVE A,DECTWO ;IN 2-SEG PROGRAMS, + CAME A,[MOVE] + JRST [ CAMG A,DECBRH ;OUTPUT HISEG BREAK + MOVE A,DECBRH + MOVEM A,WRD + MOVEIM WRDRLC,1 + CALL PWRD + MOVEMM WRD,DECBRK + CALL PWRD ;FOLLOWED BY LOSEG BREAK + JRST EBLK] + MOVEMM WRD,DECBRK ;OUTPUT THE PROGRAM BREAK. + MOVEIM WRDRLC,1 + PUSHJ P,PWRD + MOVE A,DECBRA ;OUTPUT HIGHEST ABS. ADDR + CAIG A,140 + SETZ A, ;IF IT'S ABOVE THE JOBDAT AREA. + PUSHJ P,DECWRD + JRST EBLK + +SYMDA: MOVEI A,LPRGN ;NOW PUNCH PROGRAM NAME + DPB A,[310700,,BKBUF] + MOVE A,PRGNM + TLO A,40000 + PUSHJ P,$OUTPT + PUSHJ P,EBLK + TLZ FF,FLOUT + POPJ P, + + ;DUMP OUT THE SYMBOL TABLE + +SYMDMP: TRZ I,IRCONT ;OK TO END BLOCK + CLEARM GLSP1 + CLEARM GLSP2 + CLEARM WRDRLC + MOVE T,CONTRL + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + CLEARM CLOC + CLEARM BKBUF +IFN FASLP,[ + TRNE T,FASL + JRST SYMDM1 +] + TRNE T,DECREL + JRST SYMDMD + JUMPL T,SSYMD ;JUMP IF NOT RELOCATABLE + MOVEI B,LDDSYM ;LOCAL SYMS BLOCK TYPE + DPB B,[310700,,BKBUF] ;SET BLOCK TYPE + MOVEM B,CDATBC + MOVE B,SYMAOB ;CAUSE SSYMD3 TO LOOK AT ENTIRE SYM TAB. + JRST SSYMDR + +SYMDMD: MOVSI A,DECSYM ;IN DEC FMT, START SYMBOLS BLOCK. + PUSHJ P,DECBLK +SYMDM1: MOVE B,SYMAOB + JRST SSYMDR + +;AC ALLOCATIONS DURING PHASE 1 (COMPACTING THE SYMBOL TABLE): + ;AA INITIALLY HAS -SMK,,; INPUT INDEX INTO ST + ;A TEMP + ;B SQUOZE + ;D OUTPUT INDEX INTO SYMTAB + ;CH1 VALUE OF SYM + ;CH2 3RDWRD +SSYMD: MOVEI D,ST-1 + SETZB C,SMSRTF ;SYMS SORTED => INITIAL SYMS CLOBBERED + MOVE AA,SYMAOB +SSYMD1: SKIPE B,ST(AA) ;GET SYM NAME FROM TABLE + TDNN B,[37777,,-1] ;MAKE SURE NOT EXPUNGED + JRST SSYMDL ;NOT (REALLY) THERE, TRY NEXT + MOVE CH1,ST+1(AA) ;GET VALUE OF SYM + 3GET CH2,AA ;GET 3RDWRD + TRNE CH2,-1 + TLNE CH2,3KILL+3LLV + JRST SSYMDL ;DON'T PUNCH INITIAL OR KILLED SYMS. + MOVEI A,0 ;INITIALIZE FOR SHIFTING IN FLAGS + LSHC A,4 ;SHIFT FLAGS INTO A + XCT SSYMDT(A) ;DO THE APPROPRIATE THING THIS KIND OF SYMTAB ENTRY + JRST SSYMDL +SSYMD2: LSH B,-4 ;SHIFT SQUOZE BACK TO WHERE IT BELONGS + TLO B,ABSLCL ;SET LOCAL BIT + TLNE CH2,3SKILL + TLO B,ABSDLO ;HALF-KILL SYM + PUSH D,B ;STORE NAME OF SYM IN OUTPUT SLOT + PUSH D,CH1 ;STORE VALUE + PUSH D,CH2 ;STORE 3RDWRD +SSYMDL: ADD AA,WPSTE1 + AOBJN AA,SSYMD1 ;LOOP FOR ALL SYMS IN TABLE + MOVSI CH2,4^5 ;1ST BIT TO SORT ON IS TOPO BIT, + MOVEI A,ST ;SORT FROM BOTTOM OOF SYMTAB + MOVEI B,1(D) ;TO WHERE WE FILLED UP TO. + MOVE CH1,[TDNE CH2,1(A)] ;SORT ON 2ND WD, WDS WITH BIT ON COME FIRST. + MOVE C,[TDNN CH2,1(B)] + JSP AA,SSYMD9 + TLC C,(TDNE#TDNN) ;ON BITS AFTER 1ST, ENTRIES WITH BIT OFF COME FIRST. + TLC CH1,(TDNE#TDNN) + MOVEI AA,SSRTX ;NEED ONLY CHANGE C, CH1 THE FIRST TIME. + JRST SSRTX + +SSYMD9: PUSHJ P,SSRTX ;SORT SYMS ARITHMETICALLY BY VALUE. + MOVNI B,(B) + ADDI B,ST ;SIZE OF AREA OF SYMTAB STILL IN USE. + IDIV B,WPSTE + HRLZI B,(B) + MOVE C,BKTABP + IDIVI C,BKWPB ;# BLOCKS (INCL. .INIT BLOCK). + CAIN C,2 + MOVEI C,1 ;IF ONLY .INIT AND .MAIN, FILE WILL HAVE ONLY GLOBAL. + MOVSI A,(C) + SUBM B,A ;-<# ENTRIES IN SYMTAB IN FILE>,, + LSH A,1 ;-<# WDS IN SYMTAB IN FILE>,, + MOVEM A,SCKSUM ;SAVE THIS. + PUSHJ P,PPB + PUSHJ P,BKCNT ;PUT -<# SYMS IN BLOCK> IN 3RD WD OF EACH BKTAB ENTRY. + +;DROPS THROUGH. + +;DROPS IN IF ABS, JUMPS HERE IF RELOC. +;NOTE THAT IN ABS ASSEMBLY, B WILL CONTAIN THE CHECKSUM AND +;SHOULD NOT BE CLOBBERED. +SSYMDR: PUSH P,B ;-<# SYMS>,,0 ;IT WILL BE -1(P) + PUSHJ P,BKSRT ;SORT BLOCKS INTO BKTAB1 + MOVE B,SCKSUM ;GET CHKSUM AFTER 1SS WD. (PPBCK WILL UPDATE) + SETOM 1(D) ;PUT A -1 AT END OF BKTAB1. + PUSH P,[-1] ;(P) WILL BE BKTAB1 IDX OF NEXT BLOCK TO OUTPUT. +SSYMD3: AOS F,(P) ;F HAS BKTAB1 IDX OF BLOCK. + SKIPGE C,BKTAB1(F) ;BKTAB1 ELT HAS BKTAB IDX OR + JRST SSYMDX ; -1 AFTER LAST BLOCK. + SKIPL LINK,CONTRL + JRST SSYMD7 ;DIFFERENT RTN TO OUTPUT BLOCK NAME IF RELOCA. + TRNE LINK,DECREL+FASL + JRST SSYMD6 ;NO BLOCKS IN DEC FMT. (OR FASL EITHER) + SKIPGE BKTAB1+1 + JRST SSYMG1 ;ONLY 1 BLOCK, PUT ALL IN GLOBAL. + MOVE A,BKTAB(C) + PUSHJ P,PPBCK + HLRZ A,BKTAB+1(C) + HRL A,BKTAB+2(C) ;PUT IN -2* + ADD A,[-2,,1] +SSYMG2: PUSHJ P,PPBCK ;FOLLOWED BY LEVEL. + JRST SSYMD6 + +SSYMG1: MOVE A,[SQUOZE 0,GLOBAL] + PUSHJ P,PPBCK + HRLZ A,BKTAB+BKWPB+2 + ADD A,[-2,,] + JRST SSYMG2 + +SSYMD7: MOVE A,BKTAB(C) ;OUTPUT BLOCK NAME IN RELOCATABLE. + TLO A,ABSGLO ;TELL STINK IT'S BLOCK NAME. + PUSHJ P,$OUTPT + HLRZ A,BKTAB+1(C) + SUBI A,1 + PUSHJ P,$OUTPT +SSYMD6: SKIPL C,-1(P) ;AOBJN PTR TO SYMS. + JRST SSYMD3 ;IN CASE NO SYMS. +SSYMD4: HRRZ A,ST+2(C) ;OUPUT ONLY THE SYMS IN THE BLOCK + CAME A,BKTAB1(F) ;NOW BEING HANDLED. + JRST SSYMD5 + SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL + JRST SYMD2 ;SPECIAL IF RELOCA. + MOVE A,ST(C) + PUSHJ P,PPBCK ;1ST, SQUOZE WITH FLAGS. + MOVE A,ST+1(C) + PUSHJ P,PPBCK ;2ND, VALUE. +SSYMD5: ADD C,WPSTE1 + AOBJN C,SSYMD4 ;HANDLE NEXT SYM. + JRST SSYMD3 ;ALL SYMS FORR THIS BLOCK DONE, DO NEXT BLOCK. + +;PUNCH OUT LOCAL SYM (RELOCATABLE ASSEMBLY) +;NORMALLY OUTPUT SQUOZE W/ FLAGS ? VALUE, +;IF 3LLV SET OUTPUT PHONY NAME (= STE ADDR) ? SQUOZE W/ FLAGS, STINK FIXES IT UP. +SYMD2: LDB A,[400400,,ST(C)] + MOVE CH1,ST+1(C) ;SSYMDT MAY CHANGE CH1. + MOVE CH2,ST+2(C) + XCT SSYMDT(A) ;SKIPS IF SHOULD OUTPUT SYM. + JRST SSYMD5 + TLNE CH2,3KILL + JRST SSYMD5 + MOVE B,ST(C) + TLZ B,740000 + JUMPE B,SSYMD5 ;UNUSED ENTRY. + JUMPL LINK,SYMDEC ;J IF DEC OR FASL FMT + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LEFT HALF + TLNE CH2,3RLR + TLO B,100000 ;RELOCATE RIGHT HALF + TLNE CH2,3SKILL + TLO B,400000 ;HALF-KILL + MOVEI A,ST(C) + TLNE CH2,3LLV ;IF STINK HAS VALUE, + PUSHJ P,$OUTPT ;GIVE STINK NAME STINK KNOWS SYMBOL BY. + TLNE CH2,3LLV ;IF GIVING PHONY NAME, INSURE LOCAL FLAG SET + TLO B,ABSLCL ;(STINK WILL DO SO OTHERWISE) + MOVE A,B + PUSHJ P,$OUTPT ;OUTPUT SYM + MOVE A,CH1 + TLNN CH2,3LLV ;DON'T OUTPUT VALUE IF DON'T KNOW IT. + PUSHJ P,$OUTPT ;OUTPUT VALUE + JRST SSYMD5 + +SYMDEC: IFN FASLP,[ + TRNE LINK,FASL + JRST SYMFSL ;FASL ASSMBLY +] + PUSHJ P,ASQOZR ;RIGHT-JUSTIFY THE SQUOZE, + TLNE CH2,3SKILL + TLO B,ABSDLO ;MAYBE HALFKILL, + TLO B,ABSGLO + LDB A,[400400,,ST(C)] + CAIGE A,DEFGVR_-14. + TLC B,ABSGLO+ABSLCL ;LOCAL SYM, CHANGE GLO TO LCL. + MOVEM B,WRD + PUSH P,C + PUSHJ P,DECPW ;FIRST, THE NAME, + POP P,C + LDB TM,[420200,,ST+2(C)] + MOVE A,ST+1(C) ;THEN THE VALUE AND RELOCATION BITS. + PUSHJ P,DECWR1 + JRST SSYMD5 + +IFN FASLP,[ +SYMFSL: TLO B,400000 ;GET VALUE FROM SECOND WD + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LH + TLNE CH2,3RLR + TLO B,100000 + CAIL A,LGBLCB_<-18.+4> + TLO B,40000 ;GLOBAL FLAG + MOVE A,B + MOVEI B,15 ;PUTDDTSYM + PUSHJ P,FASO + MOVE A,CH1 + PUSHJ P,FASO1 + JRST SSYMD5 +] + +;XCT INDEXED ON SQUOZE FLAGS; SHOULDN'T PUNCH SYM IF DOESN'T SKIP. +SSYMDT: JFCL ;COM + JFCL ;PSEUDO OR MACRO + CAIA ;SYM, PUNCH OUT + TLNN CH2,3LLV ;LOCAL UNDEFINED, OUTPUT IF STINK HAS VALUE TO TELL STINK WHERE TO PUT IT. + TLZA CH1,-1 ;DEFINED LOCAL VARIABLE, CLEAR OUT LH(VALUE) + JFCL ;UNDEFINED LOCAL VARIABLE + SKIPL CONTRL ;DEFINED GLOBAL VARIABLE, PUNCH OUT IF ABS. + JFCL ;UNDEFINED GLOBAL VARIABLE + SKIPL CONTRL ;GLOBAL ENTRY, PUNCH OUT IF ABS ASSEM. + JFCL ;GLOBAL EXIT, DON'T PUNCH OUT +IFN .-SSYMDT-NCDBTS,.ERR SSYMDT LOSES. + +SSYMDX: SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL + JRST SSYMG3 + SKIPGE BKTAB1+1 ;IF ABS ANND BLOCK STR, + JRST SSYMG4 + MOVE A,[SQUOZE 0,GLOBAL] + PUSHJ P,PPBCK ;PUT A GLOBAL BLOCK WITH NO SYMS AT END. + MOVSI A,-2 + PUSHJ P,PPBCK +SSYMG4: MOVE A,B ;ABS ASSEMBLY, OUTPUT CHKSUM. + PUSHJ P,PPB +SSYMG3: SUB P,[2,,2] + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK + SKIPL A,CONTRL ;RELOCATABLE => OUTPUT PROG NAME. + JRST SYMDA +IFN FASLP,[ + TRNE A,FASL + POPJ P, +] + TRNE A,DECREL ;DEC FMT => OUTPUT END BLOCK. + JRST PSYMSD + MOVE A,STARTA ;NOW GET STARTING INSTRUCTION + JRST PPB ;PUNCH IT OUT AND RETURN + +;PUT INTO BKTAB1 THE BKTAB IDXS OF ALL THE BLOCKS IN THE ORDER THEIR +;SYMS SHOULD BE PUNCHED (A BLOCK'S SUBBLOCKS PRECEDE IT) +BKSRT: MOVEI D,BKTAB1-1 ;D IS FOR PUSHING INTO BKTAB1. + MOVSI A,1 ;START WITH BLOCK 0 (OUTERMOST, .INIT). +BKSR1: SETZ C, ;HANDLE BLOCK IN A: LOOK FOR ITS SUBBLOCKS. +BKSR2: CAME A,BKTAB+1(C) + JRST BKSR3 ;THIS BLOCK ISN'T A SUBBLOCK. + ADD A,[1,,] ;LH HAS SUBBLOCK'S LEVEL. + HRRI A,(C) ;RH HAS SUBBLOCK. + PUSHJ P,BKSR1 ;HANDLE THE SUBBLOCK + MOVE A,BKTAB+1(C) +BKSR3: ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKSR2 + MOVEI C,(A) + JUMPE C,CPOPJ ;DON'T PUT .INIT BLOCK IN BKTAB1. + PUSH D,C ;PUT THE BLOCK IN BKTAB1 (AFTER SUBBLOCKS) + POPJ P, + +PPBCK: ROT B,1 ;OUTPUT WD IN A, UPDATING CKSUM IN B. + ADD B,A + JRST PPB + +BKCNT: PUSH P,B + MOVEI C,0 +BKCNT0: SETZM BKTAB+2(C) ;ZERO 3RD WD OF EACH BKTAB ENTRY. + ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKCNT0 +BKCNT1: MOVE C,ST+2(B) + SOS BKTAB+2(C) ;ADD -2 FOR EACH SYM IN THE BLOCK. + SOS BKTAB+2(C) + ADD B,WPSTE1 + AOBJN B,BKCNT1 +POPBJ: POP P,B + POPJ P, + +SSRTX: HRLM B,(P) ;DO ONE PASS OF RADIX-EXCHANGE. SAVE END. + CAIL A,@WPSTEB ;ONLY 1 ENTRY, NOTHING TO DO. + JRST SSRTX7 + PUSH P,A ;SAVE START. +SSRTX3: XCT CH1 + JRST SSRTX4 ;MOVE UP TO 1ST WITH BIT ON. + SUB B,WPSTE + XCT C ;MOVE DOWN TO LAST WITH BIT OFF. + JRST SSRTX5 + MOVE D,WPSTE + CAIE D,MAXWPS + JRST .+4 +REPEAT MAXWPS,[ + MOVE D,.RPCNT(A) ;EXCHANGE THEM, + EXCH D,.RPCNT(B) + MOVEM D,.RPCNT(A)] +SSRTX4: ADD A,WPSTE +SSRTX5: CAME A,B ;ALL DONE => DO NEXT BIT. + JRST SSRTX3 ;MORE IN THIS PASS. + ROT CH2,-1 ;NEXT BIT DOWN. + POP P,A ;A -> START, B -> END OF 1ST HALF. + JUMPL CH2,SSRTX6 ;ALL BITS IN WD DONE, STOP. + PUSHJ P,(AA) ;DO NEXT BIT ON 1ST HALF. + HLRZ B,(P) ;A -> END OF 1ST HALF, B -> END OF ALL. + PUSHJ P,(AA) ;DO SECOND HALF. +SSRTX6: ROT CH2,1 ;LEAVE CH2 AS FOUND IT. +SSRTX7: HLRZ A,(P) ;LEAVE A -> END OF AREA SORTED. + POPJ P, + + ;ARITHMETIC CONDITIONALS (B HAS JUMP A,) + +COND: PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,AGETFD ;GET FIELD TO TEST VALUE OF +CONDPP: POP P,T ;RESTORE CONDITIONAL JUMP INSTRUCTION + HRRI T,COND2 ;HRRI IN JUMP ADDRESS, GO TO COND2 IF CONDITIONAL TRUE + XCT T ;JUMP IF COND T,ASSEMBLE STRING +COND4: SETZM A.SUCC ;MOST RECENT CONDIT. FAILED. +COND5: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WHAT PSEUDO WE'RE IN. + CALL RCH + JSP D,RARL4 ;INIT FOR THE CONDITIONALIZED STUFF. + CAIA + CALL RARFLS ;READ AND IGNORE THE ARG. + JRST MACCR + +ANULL: TLO FF,FLUNRD + JRST COND5 + +;.ELSE, .ALSO - B'S LH WILL HAVE SKIPE OR SKIPN. +A.ELSE: HRRI B,A.SUCC + XCT B + JRST COND4 ;CONDITION FALSE. + JRST COND2 ;TRUE. + +;IF1, IF2 - B'S LH WILL HAVE TRNE FF, OR TRNN FF, +COND1: HRRI B,FRPSS2 + XCT B + JRST COND4 ;NO + ;CONDITION TRUE, ASSEMBLE STRING +COND2: SETOM A.SUCC ;LAST CONDITIONAL SUCCEEDED. +COND6: PUSHJ P,RCH ;GET NEXT CHAR + CAIE A,LBRKT + JRST [ CAIE A,LBRACE + TLO FF,FLUNRD + JRST MACCR] + SKIPN SCNDEP ;BRACKET TYPE CONDITIONAL. + SKIPE CONDEP + JRST COND7 + MOVEMM CONDLN,CLNN ;AT TOP LEVEL, SAVE IN CASE THIS UNTERMINATED + MOVEMM CONDPN,CPGN +IFN TS, MOVEMM CONDFI,INFFN1 +COND7: AOS SCNDEP ;COUNT IT FOR RBRAK'S SAKE. + JRST MACCR + + ;IFB, IFNB + +SBCND: PUSH P,B ;SAVE TEST JUMP + SETZB B,C ;C COUNTS SQUOZE CHARS FOR IFB/IFNB + ;B COUNTS NONSQUOZE FOR IFSQ/IFNSQ + JSP D,RARG ;INIT FOR READING OF ARG WHOSE BLANKNESS + JRST CONDPP ;IS TO BE TESTED. + JSP D,RARGCH(T) ;READ 1 CHAR, + JRST CONDPP ;(NO MORE CHARS) + HLRZ A,GDTAB(A) ;GET GDTAB ENTRY + CAIE A,(POPJ P,) ;POPJ => NOT SQUOZE + AOJA C,RARGCH(T) + AOJA B,RARGCH(T) + + ;IFDEF, IFNDEF + +DEFCND: SAVE SYM + PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + PUSHJ P,ES + MOVEI A,0 ;UNDEFINED +IFN CREFSW,XCT CRFINU + CAIN A,GLOEXT_-14. ;GLOBAL EXIT... + SKIPL CONTRL ;DURING ABSOLUTE ASSEMBLY? + CAIN A,3 ;NO, LOCAL UNDEF? + MOVEI A,0 ;ONE OF THESE => UNDEF + REST SYM + EXCH SYM,(P) ;POP SYM OUT FROM UNDER THE CONDITIONAL JUMP. + JRST CONDPP + +;;PWRD ;ROUTINES TO OUTPUT ASSEMBLES WORDS AND PORTIONS THEREOF + + ;HERE FROM PBITS TO OUTPUT WORD OF CODE BITS + +PBITS3: PUSH P,A + MOVEI A,14 + MOVEM A,PBITS2 ;INITIALIZE PBITS2 FOR COUNTING DOWN THROUGH NEXT SET OF CODE BITS + MOVE A,[440300,,PBITS1] + MOVEM A,BITP ;SET UP BITP FOR RELOADING PBITS1 WITH CODE BITS + MOVE A,PBITS1 ;NOW GET ACCUMULATED WORD OF BITS + MOVEM A,@PBITS4 ;STORE IN BKBUF + AOS A,OPT1 ;RESERVE SPACE FOR NEW WORD + ;IF FRBIT7 SET (LAST CALL TO PBITS HAD 7) THEN NEXT WORD OF CODE BITS GOES + ;AFTER NEXT WORD OUTPUT (REALLY!), OTHERWISE BEFORE + TRNN FF,FRBIT7 + SOSA A + TRO FF,FRINVT + HRRZM A,PBITS4 + POP P,A + CLEARM PBITS1 + ;DROPS THROUGH + ;OUTPUT RELOCATION CODE BITS IN A + +PBITS: SKIPGE CONTRL + POPJ P, ;NOT RELOCATABLE + SOSGE PBITS2 + JRST PBITS3 ;NO MORE ROOM IN WORD, OUTPUT IT AND TRY AGAIN + CAIN A,7 + TROA FF,FRBIT7 + TRZ FF,FRBIT7 + IDPB A,BITP + POPJ P, + + ;FOLLOWING ROUTINES SAVE AC'S EXCEPT FOR A + +OUTSM0: MOVE A,SYM ;OUTPUT NAME STINK KNOWS SYMBOL BY. + TLZ A,37777 ;FOR LOCALS, THAT'S THE STE ADDR, + HRRI A,ST(D) + TLNN SYM,40000 ;FOR GLOBALS, THAT'S THE SQUOZE. + JRST $OUTPT +OUTSM: SKIPA A,SYM +OUTWD: MOVE A,WRD +$OUTPT: SKIPGE CONTRL ;DIRECTLY PUNCH OUT WORD IN A IN RELOCATABLE ASSEMBLY ONLY + POPJ P, ;DO NOTHING IF ABSOLUTE ASSEMBLY + PUSH P,AA + MOVE AA,OPT1 + TRZN FF,FRINVT ;SKIP IF BEING HACKED FROM PBITS3, PUT WORD BEFORE WHERE IT NORMALLY BELONGS + AOS AA + MOVEM A,-1(AA) + MOVE A,CLOC + TRZE FF,FRFIRWD + HRRM A,BKBUF + POP P,AA + AOS A,OPT1 + CAIL A,BSIZE+BKBUF + TRNE I,IRCONT + POPJ P, + ;MAY DROP THROUGH + + ;END CURRENT OUTPUT BLOCK + +EBLK: PUSH P,T + PUSH P,TT + PUSH P,A + PUSH P,B + MOVE T,CONTRL + JUMPGE T,EBLK3 ;JUMP IF RELOCATABLE ASSEMBLY + TRNE T,ARIM10\SBLKS + JRST ESBLK +IFN FASLP,[ + TRNE T,FASL + JRST FASLE ;FASL HAS NO BLOCKS TO END - IGNORE +] + TRNE T,DECREL + JRST DECEBL + JRST EBLK5 + +EBLK3: MOVE T,PBITS1 + MOVEM T,@PBITS4 + MOVEI T,PBITS4 + MOVEM T,PBITS4 + MOVE T,[440300,,PBITS1] + MOVEM T,BITP + CLEARB TT,PBITS2 + CLEARM PBITS1 + MOVEI T,BKBUF + MOVE B,OPT1 ;GET POINTER TO END OF BLOCK + SUBI B,BKBUF+1 ;CONVERT TO # WORDS IN BLOCK (EXCLUDING HEADER) + DPB B,[220700,,BKBUF] ;SET COUNT FIELD IN HEADER + TRZN FF,FRLOC + JUMPLE B,EBLK5 ;IGNORE NULL BLOCK UNLESS FRLOC SET + TLO FF,FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) + PUSHJ P,FEED +EBK1: CAML T,OPT1 ;DONE WITH BLOCK? + JRST EBK2 ;YES + MOVE A,(T) ;NO, GET DATA WORD + JFCL 4,.+1 ;UPDATE CHECKSUM + ADD TT,A + JFCL 4,[AOJA TT,.+1] + PUSHJ P,PPB ;OUTPUT WORD + AOJA T,EBK1 +EBK2: SETCM A,TT ;DONE OUTPUTTING BLOCK, NOW GET CHECKSUM + PUSHJ P,PPB ;OUTPUT CHECKSUM + MOVE T,CDATBC ;GET BLOCK TYPE + DPB T,[310700,,BKBUF] ;SET NE T BLOCK TYPE TO STORAGE WORDS BLOCK TYPE + MOVEI T,BKBUF+1 + MOVEM T,OPT1 +EBLK4: TLO FF,FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) +EBLK5: TRO FF,FRFIRWD +FASLE: POP P,B + POP P,A +PTT.TJ: POP P,TT + POP P,T + POPJ P, + + ;PUNCH OUT WORD OF CODED DATA (E.G. STORAGE WORD); WRD, WRDRLC, GLOTB ENTRIES + +PWRDA: TROA FF,FRNLIK ;SUPPRESS ADR LINKING +PWRD: TRZ FF,FRNLIK ;PERMIT ADR LINKING + JUMPGE FF,CPOPJ ;IGNORE IF NOT PUNCHING PASS +IFN LISTSW,[ + SKIPN LSTONP + JRST PWRDL ;NOT MAKING LISTING NOW. + SKIPGE LISTPF + PUSHJ P,PNTR + SETOM LISTPF + MOVE LINK,WRD + MOVEM LINK,LISTWD + MOVE LINK,WRDRLC + MOVEM LINK,LSTRLC + MOVE LINK,CLOC + MOVEM LINK,LISTAD + MOVE LINK,CRLOC + DPB LINK,[220100,,LISTAD] +PWRDL: +] ;END IFN LISTSW, + SKIPGE LINK,CONTRL + JRST PWRD1 ;ABSOLUTE ASSEMBLY + ;RELOCATABLE ASSEMBLY + PUSHJ P,$RSET ;CHECK VALIDITY OF RELOCATION, STANDARDIZE IF NON-STANDARD + MOVE A,GLSP2 + CAMN A,GLSP1 + JRST PWRD2 ;NO GLOBALS + + ;NOW TO SEE IF IT'S POSSIBLE OR DESIRABLE TO ADDRESS LINK + + HRLZ B,WRD + HRR B,WRDRLC + JUMPN B,PWRD3 ;JUMP IF RH NON-ZERO + TRNN FF,FRNLIK + SKIPGE GLOCTP + JRST PWRD3 ;ADR LINKING SUPPRESSED OR CLOC GLOBAL + SKIPE LDCCC + JRST PWRD3 ;IN LOAD TIME CONDITIONALS + MOVNI T,1 ;INITIALIZE T FOR COUNTING +PWRD4: CAML A,GLSP1 + JRST PWRD5 ;DONE + HRRZ TT,1(A) ;GET GLOTB ENTRY + JUMPE TT,PWRD7A + LDB TT,[400400,,(TT)] ;GET SQUOZE FLAGS FROM SYM + CAIE TT,DEFGVR_-14. + CAIN TT,GLOETY_-14. + JRST PWRD3 ;DEFINED, BUT MUST BE HERE FOR A REASON (SEE $.H) + HLRZ TT,1(A) + TRNE TT,1777+MINF + JRST PWRD3 ;NEGATED OR MULTIPLIED + TRNE TT,HFWDF + JRST PWRD7 + TRNE TT,ACF + TRNN TT,SWAPF + JRST PWRD3 ;NOT HIGH AC +PWRD7A: AOJA A,PWRD4 +PWRD7: TRNE TT,SWAPF + AOJA A,PWRD4 ;LEFT HALF + AOJN T,PWRD3 ;JUMP IF THIS NOT FIRST GLOBAL IN RIGHT HALF + MOVEI D,1(A) ;FIRST GLOBAL, SET UP POINTER TO GLOTB ENTRY + AOJA A,PWRD4 + +PWRD5: AOJE T,PWRD3 ;NO GLOBALS LOOK BAD AND THERE AREN'T TOO MANY; JUMP IF NONE IN RH + HRRZ T,(D) ;GET ADR OF SQUOZE + SKPST T, ;SKIP IF IN SYMBOL TABLE + JRST PWRD3 ;BELOW SYMBOL TABLE, DON'T ADDRESS LINK AFTER ALL + PUSH P,T ;HOORAY, WE CAN ADDRESS LINK + SETZM (D) ;CLEAR OUT GLOTB ENTRY, DON'T NEED IT ANY MORE + PUSHJ P,PWRD31 ;DUMP OUT THE OTHER GLOBALS + POP P,D ;GET ST ADR OF THIS AGAIN + 3GET1 A,D + LDB A,[.BP (3RLNK),A] + MOVE B,WRDRLC + TLNE B,1 + TRO A,2 ;RELOCATE LEFT HALF + PUSHJ P,PBITS ;PUNCH OUT APPROPRIATE BITS FOR LINK LIST ENTRY + HLR A,1(D) ;GET ADR OF LAST + HLL A,WRD + PUSHJ P,$OUTPT ;OUTPUT WORD WITH RH = ADR OF LAST RQ FOR SYM TO PUT IN RH'S + MOVE A,CLOC ;NOW UPDATE ST ENTRY + HRLM A,1(D) + 3GET1 B,D + SKIPN CRLOC + TLZA B,3RLNK ;CLOC NOT RELOCATED LAST TIME THIS SYM USED + TLO B,3RLNK ;RELOCATED + 3PUT1 B,D + POPJ P, + +PWRD31: MOVE T,GLSP2 ;DUMP ALL GLO S IN GENERAL FORMAT +PWRD3A: CAML T,GLSP1 + POPJ P, + MOVE B,1(T) + TRNN B,-1 + AOJA T,PWRD3A + TLNE B,1777 + JRST RPWRD ;REPEAT +RPWRD1: LDB A,[.BP (MINF),B] + TRO A,4 + PUSHJ P,PBITS + MOVE A,(B) ;CODEBITS +SQUOZE FOR SYM + HLRZ C,A + TLZ A,740000 + CAIL C,DEFGVR + TLOA A,40000 ;SYM IS GLO + JRST [ MOVEI C,(B) ;IF WE ARE OUTPUTTING A REFERENCE TO THE + CAIL C,PCNTB ;"LABEL" AT THE BEGINNING OF A CONSTANTS AREA + CAIL C,PCNTB+NCONS*3 ;(BECAUSE THIS IS A 1PASS ASSEMBLY) USE THE + MOVEI A,(B) ;NAME, SINCE THE SYMBOL ISN'T IN THE + JRST .+1] ;SYMTAB + TLNE B,SWAPF + TLO A,400000 + TLNE B,ACF + JRST PWRD3E ;AC HIGH OR LOW + TLNN B,HFWDF + JRST PWRD3F ;ALL THROUGH + TLO A,100000 + TLNE B,SWAPF + TLC A,300000 +PWRD3F: PUSHJ P,$OUTPT + AOJA T,PWRD3A + + + +RPWRD: PUSHJ P,PBITS7 + MOVEI A,CRPT + PUSHJ P,PBITS + LDB A,[221200,,B] + PUSHJ P,$OUTPT + JRST RPWRD1 + +PWRD3E: TLO A,300000 + JRST PWRD3F + +PWRD3: PUSHJ P,PWRD31 +PWRD2: PUSHJ P,RCHKT + HRRZ A,B + DPB T,[10100,,A] + PUSHJ P,PBITS + JRST OUTWD + + ;CHECK FOR VALIDITY OF RELOCATION BITS OF CURRENT WORD + ;LEAVE RELOC (RH) IN B, RELOC (LH) IN T + +RCHKT: HRRZ B,WRDRLC ;CHECK FOR RELOC. OTHER THAN 0 OR 1. + HLRZ T,WRDRLC + TRZN B,-2 + TRZE T,-2 +RLCERR: ETSM [ASCIZ /Illegal relocation/] + POPJ P, + +RMOVET: ROT T,-1 + DPB B,[420100,,T] + TLZ C,3DFCLR ;SET RELOC BITS IN C + IOR C,T ;FROM B AND T. + POPJ P, + + ;CHECK WRDRLC FOR VALIDITY (CAPABILITY OF BEING PUNCHED OUT) + ;IF STANDARD THEN JUST RETURN + ;IF NON-STANDARD BUT OTHERWISE OK, PUT $R. ON GLOBAL LIST, RESET WRDRLC, AND RETURN + ;LEAVES B AND C SET UP WITH RH, LH OF WRDRLC. + +$RSET: MOVE C,WRDRLC ;GET RELOCATION + ADDI C,400000 ;WANT TO SEPARATE HALFWORDS + HLRE B,C ;GET LH IN B + HRREI C,400000(C) ;GET RH IN C (WILL EXCHANGE LATER) + MOVE A,[SWAPF+HFWDF,,$R.H] ;PUT THIS ON GLOBAL LIST IF LH NEEDS $R. + TRNE B,-2 ;CHECK LH + PUSHJ P,$RSET1 ;LH NEEDS GLOBAL REFERENCE + EXCH B,C + HRLI A,HFWDF + TRNE B,-2 ;CHECK RH + PUSHJ P,$RSET1 ;RH NEEDS GLOBAL REFERENCE + HRLZM C,WRDRLC ;RELOC OF LH + ADDM B,WRDRLC ;COMPLETE SETTING UP WRDRLC + POPJ P, + +$RSET1: JUMPGE B,$RSET2 ;STRANGE RELOCATION IN B, JUMP IF NON-NEGATIVE + MOVN T,B ;NEGATIVE, GET MAGNITUDE + TLOA A,MINF ;SET FLAG TO NEGATE GLOBAL +$RSET2: SOSA T,B ;POSITIVE, GET ONE LESS THAN IT IN T + TDZA B,B ;NEGATIVE, CLEAR B, RELOCATION LEFT OVER + MOVEI B,1 ;POSITIVE, SET RELOCATION LEFT OVER TO 1 + CAIN T,1 + MOVEI T,0 ;MULTIPLYING BY TWO OR SUBTRACTING TIMES 1 + TRNE T,-2000 + ETSM [ASCIZ /Relocation too large/] ;TOO BIG EVEN FOR $RSET + DPB T,[221200,,A] ;LOOKS OK, STORE TIMES FIELD IN $R. REFERENCE + AOS GLSP1 ;NOW PUT $R. ON GLOBAL LIST + MOVEM A,@GLSP1 + POPJ P, + + ;PWRD DURING ABSOLUTE ASSEMBLY + +PWRD1: TRNE LINK,DECREL ;DEC FMT IS CONSIDERED ABSOLUTE. + JRST DECPW +IFN FASLP,[ + TRNE LINK,FASL + JRST FASPW ;SO IS FASL +] + MOVE A,GLSP1 + CAME A,GLSP2 + ETR ERRILG ;GLOBALS APPEARING ILLEGALLY + SKIPE WRDRLC + ETR ERRIRL ;RELOCATION APPEARING ILLEGALLY + TRNE LINK,ARIM + JRST PRIM ;RIM +SBLKS1: MOVE A,WRD ;SBLK + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FRFIRWD + MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER + AOS A,OPT1 + CAIGE A,BKBUF+BSIZE + POPJ P, ;BKBUF NOT FULL YET + +SBLKS2: SUBI A,BKBUF+1 + JUMPE A,CPOPJ + MOVNS A + HRLM A,BKBUF + PUSHJ P,FEED + MOVEI T,BKBUF + CLEARM SCKSUM +SBLK1: CAML T,OPT1 + JRST SBLK2 + MOVE A,SCKSUM + ROT A,1 + ADD A,(T) + MOVEM A,SCKSUM + MOVE A,(T) + PUSHJ P,PPB + AOJA T,SBLK1 + +SBLK2: TRO FF,FRFIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,SCKSUM + JRST PPB + +ESBLK: MOVE A,OPT1 + CAIN A,BKBUF+1 + JRST EBLK5 ;AVOID SETTING FLOUT IF NULL BLOCK. + PUSHJ P,SBLKS2 + JRST EBLK4 + +PRIM: MOVSI A,(DATAI PTR,) + HRR A,CLOC + PUSHJ P,PPB + MOVE A,WRD + JRST PPB + +;END A BLOCK IN DEC FMT. COME FROM EBLK. +DECEBL: PUSH P,[EBLK5] +DECEB1: MOVSI A,DECWDS ;JUST INIT. AN ORDINARY BLOCK, + +;COME HERE TO OUTPUT PREVIOUS BLOCK AND START NEW BLOCK OF TYPE IN LH OF A. +DECBLK: PUSH P,A + HRRZ A,BKBUF ;GET DATA-WORD COUNT OF CURRENT BLOCK. + JUMPE A,DECB1 ;NO WORDS => CAN IGNORE. + MOVEI TT,BKBUF+1 +DECB0: MOVE A,-1(TT) ;GET AND PUNCH NEXT WD OF BLOCK. + PUSHJ P,PPB + CAME TT,OPT1 ;STOP WHEN NEXT WD ISN'T IN BLOCK. + AOJA TT,DECB0 +DECB1: POP P,A + HLLZM A,BKBUF ;PUT BLOCK TYPE IN LH OF HEADER, DATA WD COUNT IN RH IS 0. + MOVEI TT,BKBUF+2 ;ADDR OF PLACE FOR 1ST DATA WD + MOVEM TT,OPT1 ;(LEAVE SPACE FOR WD OF RELOC BITS) + MOVE TT,[440200,,BKBUF+1] + MOVEM TT,BITP ;BP FOR STORING PAIRS OF RELOC BITS. + SETZM BKBUF+1 ;CLEAR THE WD OF RELOC BITS. + TLO FF,FLOUT + POPJ P, + +;COME HERE TO OUTPUT A WORD IN DEC FORMAT. +DECPW: MOVS A,BKBUF + CAIE A,DECWDS ;BEFORE THE 1ST STORAGE WD IN ORDINARY BLOCK, + JRST DECPW0 + MOVE A,CRLOC ;MUST GO THE LOCATION CTR. + IDPB A,BITP + MOVE A,CLOC + MOVEM A,@OPT1 + AOS OPT1 + AOS BKBUF ;IT COUNTS AS DATA WORD. +DECPW0: MOVE A,BITP + TLNE A,77^4 ;IF NO ROOM FOR MORE RELOC BITS, + JRST DECPW1 + HLLZ A,BKBUF ;START A NEW BLOCK. + PUSHJ P,DECBLK + JRST DECPW + +DECPW1: PUSHJ P,$RSET ;SET UP RELOC BITS OF HALVES IN B,C. + LSH C,1 + IORI B,(C) ;COMBINE THEM. + MOVE A,GLSP1 + CAME A,GLSP2 + JRST DECPG ;GO HANDLE GLOBALS. +DECPW3: IDPB B,BITP ;STORE THE RELOC BITS + MOVE A,WRD +DECPW2: MOVEM A,@OPT1 ;AND THE VALUE. + AOS OPT1 + AOS BKBUF + POPJ P, + +;PUT A WORD DIRECTLY INTO DEC FMT BLOCK. +DECWRD: SETZ TM, +DECWR1: IDPB TM,BITP ;SKIP A PAIR OF RELOC BITS, + JRST DECPW2 ;STORE THE WORD. + +;HANDLE GLOBAL REFS IN DEC FMT. +DECPG: PUSHJ P,DECPW3 ;FIRST, OUTPUT THE WORD, +DECPG0: MOVSI A,DECSYM + PUSHJ P,DECBLK ;THEN STRT A SYMBOLS BLOCK. + MOVE C,GLSP2 + SAVE SYM +DECPG1: CAMN C,GLSP1 ;ALL DONE => + JRST DECPG2 ;GO START AN ORDINARY BLOCK FOR NEXT WD. + MOVE A,BITP + TLNN A,77^4 ;BLOCK FULL => START ANOTHER. + JRST DECPG0 + AOS C,GLSP2 ;GET ADDR OF NEXT GLOBAL REF. + MOVE B,(C) + MOVE B,(B) ;GET NAME OF SYM. + TLZ B,740000 + CAMN B,[SQUOZE 0,$R.] + JRST DECPG3 ;(DEC'S LOADER HAS NO SUCH HACK.) + CALL ASQOZR ;RIGHT-JUSTIFY THE SQUOZE FOR DEC SYSTEM. + MOVE A,B + TLO A,600000 ;PUT IN FLAGS SAYING ADDITIVE GLOBAL RQ. + PUSHJ P,DECWRD ;OUTPUT NAME. + HRRZ A,CLOC ;GET ADDR OF RQ, + TLO A,400000 ;MACRO-10 SETS THIS BIT SO I WILL. + MOVE B,(C) + TLNE B,SWAPF ;SWAPPED => TELL LOADER.. + TLO A,200000 + TLNE B,ACF+MINF + ETSM ERRILG ;CAN'T NEGATE GLOBAL OR PUT IN AC. + MOVE TM,CRLOC + PUSHJ P,DECWR1 ;OUTPUT 2ND WD, + JRST DECPG1 ;GO BACK FOR MORE GLOBAL REFS. + +DECPG2: REST SYM + JRST DECEB1 + +DECPG3: ETR ERRIRL ;WE NEEDED $R. BUT DIDN'T HAVE IT. + JRST DECPG1 + +ERRILG: ASCIZ /Illegal use of external/ +ERRIRL: ASCIZ /Illegal use of relocatables/ + + +;OUTPUT PROGRAM NAME BLOCK (AT START OF PASS 2) +;IF 2-SEG PROGRAM, ALSO OUTPUT A TYPE-3 BLOCK (LOAD INTO HISEG) +DECPGN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2. + SAVE [EBLK] + MOVSI A,DECNAM + CALL DECBLK + MOVE B,PRGNM + CALL ASQOZR + MOVE A,B + CALL DECWRD + MOVSI A,14 ;IDENTIFY THIS REL FILE AS MADE BY MIDAS. + CALL DECWRD + MOVE A,DECTWO + CAMN A,[MOVE] + RET ;NOT A 2-SEG PROGRAM. +DECP2S: MOVSI A,DECHSG + CALL DECBLK ;START A LOAD-INTO-HISEG BLOCK. + MOVE A,DECTWO + HRL A,DECBRH ;HISEG BRK,,TWOSEG ORIGIN. + SKIPL A + HRLI A,(A) + MOVEI TM,1 ;RELOCATION IS 1. + JRST DECWR1 + +IFN FASLP,[ +;INITIALIZE OUTPUT FOR FASL ASSEMBLY +FASOIN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2 + MOVE A,[SIXBIT /*FASL*/] + PUSHJ P,PPB + MOVE A,[MIDVRS] + LSH A,-6 + TLO A,(SIXBIT /M/) + PUSHJ P,PPB ;"LISP" VERSION NUMBER (USE M AND MIDAS NUMBER) + MOVE A,[440400,,FASB] ;INITIALIZE FASL OUTPUT BUFFER + MOVEM A,FASCBP + MOVEI A,FASB+1 + MOVEM A,FASBP + POPJ P, + + +;COME HERE TO OUTPUT A WORD IN FASL FORMAT +FASPW: MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;"PUNCH" OUT ATOM TBL (IF MORE HAS APPEARED) + PUSHJ P,$RSET ;GET RELOC + PUSH P,C ;SAVE LH RELOC + MOVEM B,FASPWB ;B HAS RELOC, WHICH IS ALSO FASL CODE FOR RELOC =1 + MOVE A,GLSP2 +FASPW3: CAME A,GLSP1 + JRST FASPW1 ;LOOK TO SEE .. +FASPW2: MOVE A,WRD ;B HAS RELOC, WHICH ALSO HAPPENS TO BE FASL CODE TYPE + MOVE B,FASPWB + PUSHJ P,FASO ;OUTPUT WORD IN A WITH FASL CODE IN B + POP P,TM + JUMPE TM,FASPW5 ;NO LEFT HALF RELOC, OK + MOVNI A,1 ;ACTIVATE FASL HACK FOR LH RELOC + MOVEI B,7 ;WOULD OTHERWISE BE GETDDTSYM + PUSHJ P,FASO +FASPW5: MOVE C,GLSP2 +FASPW6: CAMN C,GLSP1 + POPJ P, + HRRZ TM,1(C) + JUMPE TM,[AOJA C,FASPW6] + MOVE SYM,(TM) ;GET SQUOZE OF SYM + TLZ SYM,740000 ;CLEAR CODE BITS + HLRZ D,1(C) + TRZ D,400000 ;DONT WORRY ABOUT THAT BIT + TRZE D,MINF + TLO SYM,400000 ;NEGATE + CAIN D,SWAPF + JRST FSPWSW + CAIN D,HFWDF + JRST FSPWRH + CAIN D,ACF+SWAPF + JRST FSPWAC + JUMPE D,FSPWWD + ETSM [ASCIZ /Global in illegal FASL context/] + +FSPWWD: TLOA SYM,140000 +FSPWAC: TLOA SYM,100000 +FSPWRH: TLO SYM,40000 +FSPWSW: MOVE A,SYM + MOVEI B,7 ;DDT SYM + PUSHJ P,FASO + AOJA C,FASPW6 + +FASPW1: HRRZ TM,1(A) ;GLOTB ENTRY + JUMPE TM,FASPW4 + CAIL TM,AFDMY1 + CAIL TM,AFDMY2 +FASPW4: AOJA A,FASPW3 + MOVE C,1(A) ;ITS A LIST STRUCTURE REF + TLNN C,-1-HFWDF + SKIPE FASPWB + ETA [ASCIZ /Illegal LISP structure reference/] + MOVE TM,AFDMY2-AFDMY1(TM) ;GET FASL BITS + MOVEM TM,FASPWB ;FASL BITS + CLEARM 1(A) ;FLUSH THAT GUY + AOJA A,FASPW3 + +FPATB: CAMN C,FASATP ;PUNCH OUT ATOM TBL, AMT ALREADY PUNCHED IN C + POPJ P, ;THRU + MOVEI B,12 ;ATOM TBL INFO + MOVE A,FASAT(C) + TRNN A,-1 + AOJA C,FPATB3 ;LIST WORD .. SHOULD HAVE PUNCHED ITSELF + PUSHJ P,FASO + HRRZ D,FASAT(C) ;ATOM "LENGTH" + AOS C +FPATB1: SOJL D,FPATB2 + MOVE A,FASAT(C) + PUSHJ P,FASO1 + AOJA C,FPATB1 + +FPATB3: ETR [ASCIZ /Internal loss at FPATB3/] +FPATB2: MOVEM C,FASPCH ;RECORD AMOUNT PUNCHED + JRST FPATB ;LOOP BACK IF MORE + + +FASO: PUSHJ P,FASBO ;WRITE BITS +FASO1: MOVEM A,@FASBP ;STORE A IN FASL OUTPUT BUFFER + AOS TM,FASBP + CAIL TM,FASB+FASBL + ETF [ASCIZ /.FASL output block too long/] + POPJ P, + +FASBO: MOVE TM,FASCBP ;OUTPUT FASL CODEBITS IN B, WRITE PREV BLOCK IF NECC + TLNN TM,770000 + PUSHJ P,FASBE ;WRITE PREV FASL BLOCK + IDPB B,FASCBP + POPJ P, + +FASBE: PUSH P,A + PUSH P,B + MOVEI TT,FASB +FASBO2: CAML TT,FASBP + JRST FASBO3 + MOVE A,(TT) + PUSHJ P,PPB + AOJA TT,FASBO2 + +FASBO3: POP P,B + POP P,A + CLEARM FASB ;NEW CODE WORD + MOVEI TM,FASB+1 + MOVEM TM,FASBP + SOS FASCBP + POPJ P, + + +AFATOM: PUSH P,B ;SAVE CODEBITS + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ATOM illegal except in FASL assembly/] + PUSHJ P,AFRATM ;READ "ATOM", RETURN INDEX IN A + POP P,B + HLRZS B +AFLST1: AOS GLSP1 + MOVEI T,AFDMY1(B) ;DUMMY (STORE THIS INFO IN SYM SO CONSTANTS WILL WIN + HRRZM T,@GLSP1 + MOVEI B,0 ;NO RELOCATION + POPJ P, + +;GLOBALS IN THIS TABLE KEEP TRACK OF LIST REFS +;UNDEF GLOBAL GODEBITS +AFDMY1: SQUOZE 44,.%VCEL ;EVENTUALLY POINT TO VALUE CELL + SQUOZE 44,.%SCAL ;EVENTUALLY BECOME "SMASHABLE CALL" + SQUOZE 44,.%ATM ;EVENTUALLY POINT TO ATOM + SQUOZE 44,.%ARY ;EVENTUALLY POINT TO ARRAY +AFDMY2: 2 ;CODE BITS FOR VALUE CELL REF + 3 ;CODE BITS FOR SMASHABLE CALL + 4 ;CODE BITS FOR POINTER TO ATOM + 10 ;CODE BITS FOR POINTER TO ARRAY + +AFRATM: PUSHJ P,AFRTKN ;READ TOKEN, LEAVING IT AT END OF FASAT + PUSHJ P,AFRITN ;"INTERN" IT, SKIP IF NOT FOUND + POPJ P, ;IF FOUND, INDEX IN A + PUSHJ P,AFRENT ;ENTER IN FASAT + POPJ P, + +AFRENT: MOVE A,FASAT1 ;STORE FASAT1 IN FASATP + MOVEM A,FASATP + AOS A,FASIDX ;RETURN LOAD TIME ATOM INDEX + POPJ P, + +AFRTKN: MOVE A,FASATP + ADD A,[700,,FASAT] + MOVEM A,FASAT2 ;BYTE PNTR TO USE TO STORE ATOM + CLEARM (A) + CLEARM 1(A) ;MAKE SURE ALL LOW BITS CLEARED + PUSHJ P,RCH + CAIN A,"# + JRST AFRTK1 ;READ NUMBER INTO FIXNUM SPACE + CAIN A,"& + JRST AFRTK2 ;READ NUMBER INTO FLONUM SPACE +AFRTKL: IDPB A,FASAT2 ;STORE CHAR + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 +AFTERR: ETA [ASCIZ /LISP atom name table full/] + CLEARM 1(A) +AFRTL2: PUSHJ P,RCH + CAIN A,12 + JRST AFRTL2 ;IGNORE LF IN ATOM NAMES (PRIMARILY SO /CR WINS WITH ONE + CAIN A,"/ ;SLASH + JRST AFRQT ;QUOTE CHAR + CAIE A,40 + CAIN A,15 + JRST AFREND + CAIE A,"; + CAIN A,11 + JRST AFREND + CAIE A,"( + CAIN A,") + JRST AFREN2 + JRST AFRTKL ;THAT CHAR WINS, SALT IT + +AFRQT: PUSHJ P,RCH ;TAKE NEXT CHR NO MATTER WHAT + JRST AFRTKL + +AFRTK1: SKIPA TM,[100000,,1] ;PUT VAL IN FIXNUM SPACE +AFRTK2: MOVE TM,[200000,,1] ;PUT IT IN FLONUM SPACE + PUSH P,TM + MOVE SYM,[SQUOZE 0,ATOM] + PUSHJ P,FAGTFD + POP P,TM + MOVE B,FASATP + ADDI B,2 + CAIL B,FASAT+FASATL + XCT AFTERR + MOVEM TM,FASAT-2(B) + MOVEM A,FASAT-1(B) + MOVEM B,FASAT1 + POPJ P, + +AFREN2: TLO FF,FLUNRD ;SAVE ( OR ) AS WELL AS FLUSHING +AFREND: MOVEI B,5 ;PAD END OF P.N. WITH 0 S + MOVEI TM,0 +AFREN1: IDPB TM,FASAT2 + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 + XCT AFTERR + CLEARM 1(A) + SOJG B,AFREN1 + SUBI A,FASAT + MOVEM A,FASAT1 ;STORE PNTR TO WORD BEYOND ATOM + ; MAYBE PUT THIS IN FASATP + MOVE B,FASATP ;ADR OF START OF ATOM READ + SUBI A,1(B) ;COMPUTE LENGTH OF FASAT + HRRZM A,FASAT(B) ;PN ATOM 4.8-4.7 =0 STORE LENGTH IN HEADER WD + + POPJ P, + +AFRITN: MOVEI B,0 ;"INTERN" LAST ATOM READ IN + MOVEI A,1 ;A CONTAINS RUNTIME ATOM TBL INDEX + ;B INDEX WITHIN FASAT +AFRIT1: CAML B,FASATP + JRST POPJ1 ;NOT FOUND + MOVE C,FASATP ;POINTS AT HEADER OF WORD OF NEW (?) ATOM + HRRZ D,FASAT(B) ;HEADER WD OF GUY IN TBL(RIGHT HALF HAS LENGTH) + JUMPE D,AFRIT4 ;JUMP ON RESERVED FOR LIST +AFRIT2: MOVE TM,FASAT(C) + CAME TM,FASAT(B) + AOJA B,AFRIT3 ;THIS ONE LOSES + SOJL D,CPOPJ ;THIS ONE WINS! + AOS B + AOJA C,AFRIT2 + +AFRIT3: SOJL D,[AOJA A,AFRIT1] ;FINISH SPACING OVER THIS GUY +AFRIT4: AOJA B,AFRIT3 + +AFENTY: SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ENTRY in NON-FASL/] + SKIPN CRLOC + ETI [ASCIZ /.ENTRY when . is absolute/] + PUSHJ P,AFRATM ;READ FUNCTION NAME + HRLZS A + PUSH P,A + PUSHJ P,AFRATM ;READ TYPE (SUBR, LSUBR, ETC) + HRRM A,(P) + MOVE SYM,[SQUOZE 0,.ENTRY] + PUSHJ P,FAGTFD ;READ ARGS PROP + JUMPGE FF,ASSEM1 ;NOT PUNCHING PASS + PUSH P,A + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ANY NEW ATOMS OUT + POP P,C + POP P,A + MOVEI B,13 + PUSHJ P,FASO + HRL A,C + HRR A,CLOC + PUSHJ P,FASO1 + JRST ASSEM1 + +AFLIST: HLRZM B,AFLTYP + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.LIST illegal except in FASL assembly/] + PUSHJ P,AFRLST ;READ LIST, RTN ATM TBL INDEX IN A + SKIPN AFLTYP + JRST ASSEM1 ;JUST EVAL IN LISP AND THROW AWAY VALUE + MOVEI B,AFDMAI ;"ATOM" INDEX IN AFDMY1 TBL + JRST AFLST1 ;TREAT AS ATOM + +AFRLST: CLEARM AFRLD ;"DEPTH" + CLEARM AFRLEN ;"LENGTH" OF LIST AT CURRENT LEVEL + CLEARM AFRDTF ;DOT CONTEXT FLAG + JUMPGE FF,AFRLI1 + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ALL ATOMS "PUNCHED" + MOVE A,FASATP + MOVEM A,AFRFTP ;SAVED STATE OF FASAT POINTER + MOVE C,AFLTYP + MOVEI B,16 ;EVAL TYPE HACK + CAIN C,1 + MOVEI B,5 ;LIST TYPE HACK + PUSHJ P,FASBO ;WRITE CODE BITS +AFRLI1: +AFRL1: PUSHJ P,RCH + CAIE A,40 ;PREV ATOM (OR WHATEVER) "DELIMITED", SO THESE MEANINGLESS + CAIN A,15 ;UNLESS AT TOP LEVEL AND HAVE READ SOMETHING + JRST AFRL1A + CAIE A,11 + CAIN A,12 + JRST AFRL1A + CAIN A,"( + JRST AFRLO + CAIN A,") + JRST AFRLC + CAIN A,". + JRST AFRDT ;DOT.. + TLO FF,FLUNRD + SKIPE AFRLD + JRST AFRNXT ;READ NEXT GUY THIS LVL + SKIPE AFRLEN +AFRLO2: ETI [ASCIZ /LISP read context error/] +AFRNXT: SKIPN TM,AFRDTF + JRST AFRNX2 ;NOT HACKING DOTS, OK + AOS TM,AFRDTF + CAIE TM,2 + JRST AFRLO2 ;DIDNT JUST SEE THE DOT +AFRNX2: PUSHJ P,AFRATM + JUMPGE FF,AFRNX1 ;XFER ON NOT PUNCHING PASS + PUSHJ P,FASO1 ;TELL LOADER TO PUSH THIS ON ITS STACK +AFRNX1: AOS AFRLEN ;LIST NOW ONE LONGER THIS LVL + JRST AFRL1 + +AFRLO: SKIPN TM,AFRDTF + JRST AFRLO3 ;NOT HACKING DOTS + SOJN TM,AFRLO2 + CLEARM AFRDTF + JRST AFRL1 ;IGNORE BOTH . AND ( +AFRLO3: SKIPE AFRLD ;( + JRST AFRLO1 + SKIPE AFRLEN + JRST AFRLO2 +AFRLO1: PUSH P,AFRLEN + CLEARM AFRLEN ;START NEW LVL + AOS AFRLD ;DEPTH NOW ONE GREATER + JRST AFRL1 + +AFRLC: SOSGE AFRLD ;) + JRST AFRLO2 ;AT TOP LEVEL, BARF + MOVE A,AFRLEN + SKIPN TM,AFRDTF + JRST AFRLC2 ;NOT HACKING DOTS + CAIE TM,2 + JRST AFRLO2 + SOS A ;MAIN LIST NOW ONE SHORTER + TLOA A,200000 ;DOT WITH LAST THING ON STACK +AFRLC2: TLO A,100000 ;TELL LOADER TO MAKE LIST THIS LONG + JUMPGE FF,AFRLC5 + PUSHJ P,FASO1 +AFRLC5: POP P,AFRLEN ;LENGTH AT PREV LVL + AOS AFRLEN ;NOW ONE MORE + CLEARM AFRDTF ;NOT HACKING DOTS NOW + SKIPE AFRLD ;RETURNING TO TOP LEVEL? + JRST AFRL1 + JRST AFRX1 ;YES THRU + +AFRDT: SKIPN AFRDTF + SKIPN AFRLEN + JRST AFRLO2 ;DOT IN FIRST POSITION OF LIST + AOS AFRDTF ;ENTER STATE 1 OF DOT HACKING + JRST AFRL1 + +AFRL1A: SKIPN AFRLD ;SPACER CHAR TERMINATES AT TOP LVL IF HAVE RD SOMETHING + SKIPN AFRLEN + JRST AFRL1 +AFRX1: JUMPGE FF,AFRX2 ;NOT PUNCHING PASS + MOVE A,AFRFTP + CAME A,FASATP + ETR [ASCIZ /Saw atoms in list on pass 2 for first time/] + SKIPN B,AFLTYP ;TYP LIST OP + SKIPA A,[-1,,] + MOVSI A,-2 ;PUT LIST OR VALUE OF LIST IN ATOM TBL + PUSHJ P,FASO1 ;TERM OP AND PUT IT IN ATOM TBL + MOVEI A,0 + MOVE B,AFLTYP + JUMPE B,CPOPJ ;JUST WANT VALUE OF LIST + CAIN B,1 ;ONLY WANT THIS FOR STRAIGHT LIST + PUSHJ P,FASO1 ;OUTPUT "SXHASH" WORD + AOS A,FASATP + CLEARM FASAT-1(A) ;RESERVE SLOT IN FASAT TBL + MOVEM A,FASPCH ;SAY ALREADY PUNCHED OUT + AOS A,FASIDX + POPJ P, + +AFRX2: TLO I,ILNOPT ;DONT TRY TO OPTIMIZE IF IN CONSTANT + CLEARB A,B + POPJ P, +] + ;.LIBRA, .LIFS, ETC. + +A.LIB: NOVAL ? NOABS + HLRZM B,LIBTYP' ;STORE BLOCK TYPE TO OUTPUT + CLEARM LIBOP ;INITIALIZE SQUOZE FLAGS + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK, MAKING SURE LOADER KNOWS $. +LIB1: PUSHJ P,GETSYL ;GET NAME + TRNN I,IRSYL + JRST LIB2 ;NO SYL, DON'T OUTPUT + IOR SYM,LIBOP + TLO SYM,40000 + PUSHJ P,OUTSM + MOVSI A,400000 + ANDCAM A,LIBOP +LIB2: MOVE B,CDISP ;GET CDISP + TLNN B,DWRD\DFLD ;CHECK FOR WORD TERMINATOR + JRST LIB3 ;WORD TERMINATOR => DONE + MOVE A,LIBOP + MOVE B,LIMBO1 ;RETRIEVE LAST CHAR READ + CAIN B,", + MOVSI A,400000 + CAIN B,"+ + TLZ A,200000 + CAIN B,"- + TLO A,200000 + MOVEM A,LIBOP' ;STORE SQUOZE FLAGS (LESS GLBL BIT) FOR NEXT SYM + JRST LIB1 + +LIB3: MOVE A,LIBTYP ;GET BLOCK TYPE TO OUTPUT + DPB A,[310700,,BKBUF] + PUSHJ P,EBLK + CAIN A,LLIB ;.LIBRA? + JRST ARELC1 ;.LIBRA, NOW PLAY LIKE RELOCA PSEUDO + JRST LIB5 ;SOMETHING ELSE (.LIFS), INCREMENT DEPTH IN LOAD TIME CONDITIONALS + +A.ELDC: NOVAL ? NOABS + PUSHJ P,EBLK + MOVEI A,ELTCB + DPB A,[310700,,BKBUF] + TRO FF,FRLOC ;MAKE EBLK OUTPUT NULL BLOCK + PUSHJ P,EBLK + SOSGE LDCCC + CLEARM LDCCC ;LOADER CONDITIONAL UNDERFLOW + JRST ASSEM1 + + ;LOADER CONDITIONAL ON VALUE + +A.LDCV: NOVAL ? NOABS + LSH B,-27. + PUSH P,B + PUSHJ P,AGETWD + POP P,B + DPB B,[400300,,BKBUF] + MOVEI A,LDCV + PUSHJ P,PLDCM + MOVEI A,0 + DPB A,[400300,,BKBUF] +LIB5: AOS LDCCC +CCASM1: JRST ASSEM1 + +;.GLOBAL, .SCALAR, .VECTOR +;LH(B) HAS ILGLI, ILVAR, ILVAR+ILFLO RESPECTIVELY. + +A.GLOB: NOVAL + HLLZ LINK,B ;REMEMBER WHICH OF THE THREE PSEUDO'S THIS IS. +A.GLO2: MOVE A,GLSPAS + MOVEM A,GLSP1 + SETOM FLDCNT + PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO NAME => DONE + CALL ES + JRST A.GLO1 + CAIE A,PSUDO_-14. + JRST A.GLO1 + JSP B,GVPSEU ;TRYING TO .GLOBAL A PSEUDO => TYPE APPRO. ERR MSG AND RETURN. + JRST A.GLO2 ;DON'T DO ANYTHING TO IT; MOVE ON TO NEXT ARG. + +A.GLO1: IOR I,LINK ;SET THE GLOBAL FLAG OR THE VARIABLE FLAG. + TLNE LINK,ILFLO ;FOR .VECTOR, SAVE # VARS CREATED BEFORE CREATING THIS ONE. + SAVE VARCNT ;SO WE CAN TELL IF THIS CALL TO GETVAL ACTUALY CREATES IT. + PUSHJ P,GETVAL ;NOW GET VALUE (CLOBBERS SQUOZE FLAGS) + CAIA + HALT + TLNN LINK,ILFLO + JRST A.GLO2 + SAVE LINK ;.VECTOR - READ THE SIZE. + TLO FF,FLUNRD ;RE-READ THE TERMINATOR AFTER THE SYM, SO "FOO(1)" AND "FOO," WIN + MOVE SYM,[SQUOZE 0,.VECTOR] + CALL AGETFD + REST LINK + REST B ;GET PREV. VARCNT, SO WE CAN SEE IF IT WAS INCREMENTED. + TRNN A,-1 ;MAKE (N) WORK AS SIZE BY USIN L.H. IF R.H. IS 0. + HLRZS A + SKIPE A + MOVEM A,VECSIZ ;IF NONZERO SIZE SPEC'D, USE IT AND SET DEFAULT. + MOVE A,VECSIZ ;ELSE USE THE DEFAULT. + SUBI A,1 ;1 WORD WAS ALLOCATED BY GETVAL - HOW MANY MORE WANTED? + CAME B,VARCNT ;(MAYBE SYM ALREADY DEFINED, MAYBE PASS2, ...) + ADDM A,VARCNT ;IF GETVAL REALLY ALLOCATED THE SPACE THIS TIME, ALLOCATE THE + JRST A.GLO2 ;RIGHT AMOUNT. + + ;.LOP + +A.LOP: NOVAL ? NOABS + PUSHJ P,EBLK ;TERMINATE CURRENT BLOCK + REPEAT 3,PUSHJ P,RGETFD ;GET THE FIELDS + MOVEI A,LD.OP + PUSHJ P,PLDCN + JRST ASSEM1 + + ;.LIBRQ + +A.LIBRQ: NOVAL ? NOABS +A.LBR1: PUSHJ P,GETSLD + JRST MACCR + PUSHJ P,PBITS7 + MOVEI A,3 + PUSHJ P,PBITS + TLO SYM,40000 + PUSHJ P,OUTSM + JRST A.LBR1 + +A.LNKOT: AOS (P) ;THIS PSEUDO RETURNS NO VALUE. + NOVAL + +AEND5: JUMPGE FF,CPOPJ ;IGNORE FOLLOWING ON NOT PUNCHING PASS + MOVE D,SYMAOB +AEND5A: MOVE SYM,ST(D) + LDB T,[400400,,SYM] + CAIE T,DEFLVR_-14. + CAIN T,DEFGVR_-14. + JRST AEND5E + CAIE T,LCUDF_-14. + CAIN T,GLOEXT_-14. + JRST AEND5B +AEND5C: ADD D,WPSTE1 + AOBJN D,AEND5A + POPJ P, + +AEND5E: 3GET C,D + TLNN C,3LLV + JRST AEND5C +AEND5B: HLLZ B,ST+1(D) + 3GET C,D + TLNN C,3RLNK + JUMPE B,AEND5C + TLZ SYM,740000 + CAIE T,LCUDF_-14. + CAIN T,DEFLVR_-14. + SKIPA + TLO SYM,40000 + PUSHJ P,LKPNRO + HRRZS ST+1(D) ;CLEAR OUT LIST HEAD POINTER. + TLZ C,3RLNK ;INDICATE NO LIST. + 3PUT C,D + JRST AEND5C + + ;PUNCH OUT COMPLETE LOADER COMMAND, PUNCHING OUT WRD AS ONLY CONTENTS + +PLDCM: PUSH P,LINK ;SAVE LINK FOR ALOC AND FRIENDS (CLOBBERS OTHER AC'S) + PUSH P,A ;SAVE LOADER COMMAND TYPE + PUSHJ P,EBLK ;TERMINATE PREV BLOCK, MAKING SURE LOADER KNOWS $. + PUSHJ P,PWRDA ;PUNCH OUT THE WORD + POP P,A ;GET BACK LOADER COMMAND TYPE FOR PLDCN + PUSHJ P,PLDCN ;OUTPUT THE RESULTING BLOCK +PLINKJ: POP P,LINK ;RESTORE LINK + POPJ P, + +PLDCN: HRRM A,BKBUF ;STORE LOADER COMMAND TYPE IN BKBUF HEADER + MOVEI A,LLDCM ;LOADER COMMAND BLOCK TYPE + DPB A,[310700,,BKBUF] ;STORE BLOCK TYPE IN HEADER + TRO FF,FRLOC ;MAKE EBLK OUTPUT BLOCK EVEN IF EMPTY + JRST EBLK + +;.RELP RETURNS RELOCATION OF ARG +A.RELP: CALL AGETFD + MOVE A,B + JRST VALRET + +;.ABSP RETURNS ABSOLUTE PART OF ARG. +A.ABSP: CALL AGETFD + JRST VALRET + +;.RL1 IN RELOCATABLE ASSEMBLY RETURNS ZERO WITH RELOCATION FACTOR ONE. +;IN ABSOLUTE ASSEMBLY, IT RETURNS JUST ZERO. +;IFN <.RELP .RL1>, IS A TEST FOR A RELOCATABLE ASSEMBLY. +A.RL1: SKIPGE A,CONTRL + TRNE A,DECREL\FASL + SKIPA B,[1] + SETZ B, + SETZ A, + RET + +AEND: NOVAL + SKIPE ASMOUT ; ERROR IF IN GROUPING. + JSP LINK,CONFLM ;FLUSH CONSTANTS, GIVE ERROR MSG. + SKIPE SCNDEP ;IF THERE ARE UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS, MENTION THEM. + MOVE A,BKCUR + CAIE A,BKWPB ;NOT IN .MAIN BLOCK => ERROR. + ETR ERRUMB + MOVE A,CDISP + TLNN A,DWRD + TLO FF,FLUNRD ;IF LAST TERM. WAS WORD TERM., RE-READ. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + EXCH A,PNTBP + MOVEM A,LISTTM +] + PUSHJ P,AVARI0 + PUSHJ P,CNSTN0 + SKIPL A,CONTRL + PUSHJ P,AEND5 ;RELOCATABLE => .LNKOT + SKIPGE A,CONTRL + TRNN A,DECREL + JRST AEND6 + MOVE A,CLOC ;IN DEC FMT, UPDATE HIGHEST ADDR SEEN, + SKIPN CRLOC ;UPDATE EITHER THE HIGHEST ABS ADDR + JRST [ CAML A,DECBRA + MOVEM A,DECBRA + JRST AEND6] + CAML A,DECTWO ;OR THE HIGHEST REL ADDR IN THE + JRST [ CAML A,DECBRH ;APPROPRIATE SEG. + MOVEM A,DECBRH + JRST AEND6] + CAML A,DECBRK + MOVEM A,DECBRK +AEND6: JUMPL FF,AEND1 ;ON PUNCHING PASS, SPECIAL STUFF + PUSHJ P,GETWRD ;OTHERWISE EAT UP WORD, + JRST RETURN ;AND RETURN + +AEND1: PUSHJ P,EBLK +IFN LISTSW,[ + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE A,LISTTM + MOVEM A,PNTBP +] + MOVE SYM,[SQUOZE 0,END] + TLZ I,ILWORD + PUSHJ P,AGETWD +IFN LISTSW,[ + MOVEM A,LISTWD + MOVEM B,LSTRLC + SETOM LISTAD + SETOM LISTPF + SKIPE LSTONP + PUSHJ P,PNTR + SKIPE LISTP + PUSHJ P,LPTCLS ;DONE LISTING + MOVE A,LISTWD +] ;END IFN LISTSW, + SKIPL B,CONTRL + JRST AEND3 ;RELOCATABLE +IFN FASLP,[ + TRNE B,FASL + JRST FASEN ;FASL FORM +] + TRNN B,DECREL ;IF DEC FORMAT, + JRST AEND1A + TLNN I,ILWORD ;THEN IF THERE7S A STARTING ADDRESS, + JRST AEND2 + MOVSI A,DECSTA ;OUTPUT START-ADDRESS BLOCK. + PUSHJ P,DECBLK + PUSHJ P,PWRD + PUSHJ P,EBLK + JRST AEND2 + +IFN FASLP,[ +FASEN: JRST AEND2 +] + +AEND3: HRRZ A,CLOC + HRRM A,BKBUF ;SET UP PROGRAM BREAK JUST IN CASE OUTPUTTING MORE NULL DATA BLOCKS + MOVEI A,LCJMP + PUSHJ P,PLDCM + JRST AEND2 + +AEND1A: TLNN A,777000 ;CHECK INSTRUCTION PART + TLO A,(JRST) ;INSTRUCTION PART 0; HE WANTS JRST + PUSHJ P,PPB + JUMPG A,.+3 + ETR [ASCIZ /Start instruction negative/] + HRLI A,(JRST) ;END SYMTAB WITH POSITIVE WORD + MOVEM A,STARTA ;SAVE FOR PUNCHOUT AT END OF SYMTAB + PUSHJ P,FEED1 +AEND2: PUSH P,[RETURN] +CNARTP: +IFN DECSW,[ + SAVE TTYFLG + SKIPE CCLFLG ;IN DEC VERSION, IF RUN BY CCL, DON'T PRINT + AOS TTYFLG ;THIS STUFF ON THE TTY - ONLY IN ERROR FILE AND LISTING. + CALL CNTPD + REST TTYFLG + RET + +CNTPD: +] + MOVNI D,1 + MOVEI TT,PCNTB +CNTP1: CAML TT,PBCONL + RET + HRRZ B,1(TT) + HLRZ A,1(TT) + CAMN A,B + JRST CNTP2 + AOSN D + TYPR [ASCIZ /Constants area inclusive +From To +/] + LDB B,[.BP (CGBAL),2(TT)] + SKIPE B + TYPR [ASCIZ /Global+/] + HRRZ B,1(TT) + PUSHJ P,OCTPNT + PUSHJ P,TABERR + HLRZ B,1(TT) + SOS B + PUSHJ P,OCTPNT + PUSHJ P,CRRERR +CNTP2: ADDI TT,3 + JRST CNTP1 + +AENDM1: TYPR [ASCIZ /Unterminated successful bracketed conditionals +The first was at /] + AOS A,CONDPN + CALL DPNT + MOVEI A,"- + CALL TYOERR + AOS A,CONDLN + CALL D3PNT2 +IFN TS,[ + TYPR [ASCIZ/ of file /] + MOVE B,CONDFI + CALL SIXTYO +] + JRST CRRERR + + +AXWORD: CALL XGETFD ;READ 1ST FIELD, + TLNE I,ILMWRD + CALL IGTXT ;SOAK UP REST OF TEXT PSEUDO. + HRLM A,WRD + HRLM B,WRDRLC + MOVSI C,HFWDF + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + PUSH P,GLSP1 + CALL XGETFD ;NOW THE SECOND FIELD + HRRM A,WRD + HRRES B + ADDM B,WRDRLC + MOVSI C,HFWDF + MOVEI B,0 + POP P,T + PUSHJ P,LINKTC + JRST CABPOP + +A.NTHWD: CALL AGETFD ;READ THE NUMBER OF THE WORD WE WANT. + SOJL A,CABPOP ;NEGATIVE OR 0 => RETURN 0. + SOJL A,A.1STWD ;1 => TURN INTO .1STWD. + ;ELSE SKIP APPRO. # OF WORDS, THEN DO .1STWD. + +A.NTH1: SAVE A + SAVE WRD + CALL XGETFD + TLZ FF,FLUNRD + REST WRD + REST A + TLNN I,ILMWRD + JRST CABPOP ;IF STRING ENDS BEFORE DESIRED WORD, RETURN 0. + SOJGE A,A.NTH1 + +A.1STWD: CALL XGETFD ;GET THE 1ST WD OF FOLLOWING TEXT PSEUDO, + CALL IGTXT ;THROW AWAY THE REST. + MOVE T,A ;RETURN THE VALUE + JRST TEXT5 ;COMPLAINING IF FOLLOWED IMMEDIATELY BY SYLLABLE. + +A.LENGTH: CALL PASSPS + PUSH P,[0] + PUSH P,A +A.LN1: PUSHJ P,RCH + AOS -1(P) + CAME A,(P) + JRST A.LN1 + SOS A,-1(P) + SUB P,[2,,2] + JRST VALRET ;RETURN VALUE IN T + +ARDIX: NOVAL + PUSHJ P,AGETFD ;GET FIELD ARG + MOVEM A,ARADIX + JRST MACCR ;RETURN WITHOUT CLOBBERING CURRENT VALUE + +A.RADIX: CALL AGETFD ;READ THE TEMP. RADIX. + SAVE ARADIX ;LAMBDABIND RADIX TO THAT VALUE. + MOVEM A,ARADIX + CALL XGETFD ;READ IN THE NEXT FIELD USING THAT RADIX. + REST ARADIX + JRST VALRET + +;READ A BIT-MASK AS ARG, RETURN THE LH OF BP. FOR THAT BYTE. +A.BP: CALL YGETFD + MOVEI C,SPACE + SKIPE CDISP ;IF ARG WAS ENDED BY A COMMA, TURN IT INTO A SPACE + HRRM C,CDISP ;SO THAT .BP FOO,BAR USES THE FLD SPACE FLD FORMAT. + JUMPE A,VALR1 + SAVE A + JFFO A,.+2 + MOVEI B,36. + EXCH B,(P) ;(P) HAS # LEADING ZEROS. + MOVN A,B + AND A,B ;A HAS ONLY THE LOW BIT OF THE BYTE. + JFFO A,.+2 + MOVNI B,1 ;B HAS 35.-<# TRAILING ZREROS.> + MOVEI A,1(B) + SUB A,(P) ;A HAS SIZE OF BYTE + LSH A,30 ;PUT IN S FIELD OF BP. + SUB P,[1,,1] + MOVNS B + ADDI B,35. ;B HAS # TRAILING ZEROS. + DPB B,[360600,,A] ;PUT THAT IN P FIELD OF BP. + JRST VALR1 + +;READ IN BP, RETURN BIT MASK TO SPEC'D BYTE. +;THE ARG SHOULD BE JUST THE LH OF A BP, WHICH MAY BE IN EITHER HALF OF THE ARG. +A.BM: CALL GETBPT ;READ IN A BYTE POINTER ARG, IN A, POINTING AT T. + SETZ T, + SETO C, +A.DPB1: DPB C,A ;PUT 1'S IN SPEC'D PART OF ACCUM T + MOVE A,T + JRST VALRET + +;READ IN A BYTE POINTER (REALLY JUST S AND P FIELDS) AND MAKE POINT AT AC T. +;RETURN IT IN AC A. +GETBPT: CALL YGETFD + TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH. + HRLI A,(A) + TLZ A,77 ;MAKE BP. -> AC T + HRRI A,T + RET + +;RETURN # TRAILING ZEROS IN ARGUMENT. +A.TZ: CALL YGETFD + MOVN B,A + AND A,B ;A HAS JUST LOW BIT OF ARG SET. + JFFO A,.+2 + MOVNI B,1 ;# OF ZEROS BEFORE LOW BIT = + MOVN A,B ;35. - <# TRAILING ZEROS> + ADDI A,35. + JRST VALRET + +;RETURN # LEADING ZEROS IN ARG. +A.LZ: CALL YGETFD + JFFO A,.+2 + MOVEI B,36. + MOVE A,B + JRST VALRET + +;.DPB STUFF,BP,WORD DOES A DPB OF STUFF INTO THE FIELD OF WORD SPEC'D BY BP, +;RETURNING THE RESULTING WORD. +A.DPB: CALL YGETFD ;READ STUFF. + SAVE A + CALL GETBPT ;READ BP AND TURN INTO ACTUAL BP POINTING AT T + SAVE A + CALL YGETFD ;READ IN WORD AND PUT IN T. + MOVE T,A + REST A ;A HAS BP + REST C ;C HAS STUFF + JRST A.DPB1 ;GO DO THE DEPOSIT AND RETURN THE ALTERED WORD. + +;.LDB BP,WORD RETURNS THE CONTENTS OF THE BYTE IN WORD SELECTED BY BP +A.LDB: CALL GETBPT + SAVE A + CALL YGETFD + MOVE T,A + REST A + LDB A,A + JRST VALRET + +AWORD: NOVAL + PUSHJ P,EBLK + PUSHJ P,GETWRD ;ON UNDEFINED SYM, WYB UNDEFINED SYM IN "WORD"? + PUSHJ P,PPB + JRST ASSEM1 + +;.BIND - MAKE SYMS BE DEFINED IN CURRENT (SPEC'D) BLOCK. LH(B) HAS 0. +;.KILL - FULLY KILL THE SYMS.LH(B) HAS 3KILL. +;.HKILL - HALFKILL THEM. LH(B) HAS 3SKILL. +;.XCREF - PREVENT CREFFING OF SYMS. LH(B) HAS 3NCRF. +;.DOWN - SET 3DOWN, MAKING SYM VISIBLE IN SUBBLOCKS IN 1 PASS ASSEMBLY. +A.KILL: NOVAL + HLLZ LINK,B ;REMEMBER BIT TO SET. +A.KIL1: CALL GETSLD ;READ NEXT SYMBOL NAME. + JRST MACCR ;NO MORE, EXIT. + SKIPE LINK ;EXCEPT FOR .BIND, DO NOTHING ON PASS 1. + JUMPGE FF,A.KIL1 + CALL ESDEF ;DEFINE THE SYMBOL, D HAS STE IDX. + JRST A.KIL2 ;SYMBOL NEVER SEEN. + IORM LINK,ST+2(D) ;SET THE BIT IN 3RDWRD.. + IOR C,LINK ;(IF .XCREF, PREVENT CREFFING THIS TIME) +IFN CREFSW,XCT CRFINU ;CREF THE SYMBOL + JRST A.KIL1 + +A.KIL2: MOVSI T,LCUDF ;SYMBOL UNDEFINED, MAKE UNDEF LOCAL. + IOR C,LINK ;WITH THE DESIRED BIT SET. + TLO C,3MACOK ;SHOULDN'T BE ERROR IF IT BECOMES MACRO. + CALL VSM2 +IFN CREFSW,XCT CRFINU + JRST A.KIL1 + +;EXPUNG SYM1,SYM2 ... ;UNDEFINE THOSE SYMS. +AEXPUNG: NOVAL +AEXPU2: PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO MORE NAMES + SAVE [AEXPU2] ;AFTER THIS SYM, POPJ TO READ ANOTHER. +;EXPUNGE 1 SYMBOL, SQUOZE IN SYM. +AEXPU1: PUSHJ P,ES + JFCL ;NOT FOUND, DON'T COMPLAIN, JUST CREF. +IFN CREFSW,XCT CRFDEF + HRLZI T,400000 ;EXPUNGED ZERO SYM + SKIPE ST(D) + MOVEM T,ST(D) + SKIPL CONTRL ;IF RELOCATABLE ANDLOCAL SYMBOL, + CAIL A,DEFGVR_-33. + RET + PUSHJ P,PBITS7 ;TELL STINK TO EXPUNGE SYM. + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY IS NEW TYPE RQ, + PUSHJ P,OUTSM0 + MOVSI A,400000 ;NEW NAME NULL => DELETE. + JRST $OUTPT + +;EQUAL SYM1,SYM2 ;DEFINE SYM1 SAME AS SYM2. +AEQUAL: NOVAL + PUSHJ P,GETSLD + ETR ERRTFA + SAVE SYM ;REMEMBER SYM NAME AND BLOCK TO DEF. IN. + SAVE ESBK + PUSHJ P,GETSLD + ETR ERRTFA +IFN CREFSW,XCT CRFINU ;CREF SYM DEFINED AS. + CALL ES ;LOOK UP SYM TO EQUATE TO. + JRST [ REST ESBK ;NOT FOUND => EXPUNGE THE 1ST SYM. + REST SYM + JRST AEXPU1] + REST ESBK + REST SYM +IFN CREFSW,XCT CRFDEF + SAVE A + SAVE B ;SAVE INFO ON VALUE OF SYM TO EQUATE TO. + SAVE C + CALL ESDEF + MOVEM SYM,ST(D) + REST B ;3RDWRD OF 2ND SYMBOL. + REST ST+1(D) ;(WHAT WAS PUSHED FROM B) + REST A + DPB A,[400400,,ST(D)] + TLZ C,3DFCLR ;SAVE OLD 3MAS, 3NCRF OF 1ST SYMBOL (AND ITS BLOCK #). + AND B,[3DFCLR,,] ;SET REST OF 3RDWRD BITS FROM 2ND SYMBOL. + IOR B,C + 3PUT B,D + JRST MACCR + +ERRTFA: ASCIZ /Too few args - EQUAL/ + +;.SEE SYM1,SYM2,... ;CREF THOSE SYMS. +A.SEE: CALL GETSLD ;READ 1 SYMBOL. + JRST MACCR ;NONE TO BE READ. +IFN CREFSW,[ + SKIPN CRFONP ;IF CREFFING, + JRST A.SEE + CALL ES + MOVEI A,SYMC_-33. + XCT CRFINU ;CREF THE SYMBOL. +] + JRST A.SEE + + ;UUO HANDLING ROUTINE + ;41 HAS JSR ERROR + +VBLK +IFE ITSSW,ERRTTL: 0 ; NUMBER OF ERRORS HIT +ERRCCT: 0 ;NUM CHARS OUTPUT ON LINE, FOR MAKING MSGS LINE UP. +ERRJPC: 0 ;JPC READ WHEN UUO. +ERROR: 0 +IFN TS, .SUSET [.RJPC,,ERRJPC] + JRST ERRH ;GO HANDLE IT +PBLK +ERRH: PUSH P,T + PUSH P,B ;NOT TYPR => ERROR OF SOME KIND + PUSH P,A + SAVE C + LDB T,[331100,,40] ;PICK UP OP CODE + CAIN T,TYPR_-33 ;TYPR? + JRST TYPR1 ;YES + ;ERROR OF SOME KIND + CAIE T,ETASM_-33 ;CHECK FOR SPECIAL LOSSAGES AT COLON + CAIN T,ETSM_-33 + CAME SYM,SYSYM ;ARE WE ABOUT TO MENTIO THIS LOSING LABEL AS THE LAST ONE? + JRST ERRH1 + MOVE T,SYSYM1 + + MOVEM T,SYSYM ;COLON LOSSAGE, DE-MUNG TAG WORDS FOR PRINTOUT + MOVE T,SYLOC1 + MOVEM T,SYLOC +ERRH1: +IFN TS,[ +IFN LISTSW,[ + CALL PNTR ;FORCE OUT BUFFERED LISTING OUTPUT + CALL PNTCRR ;AND CR, SO USER CAN SEE WHERE ERROR WAS. +] + PUSHJ P,ERRTFL ;IF NOT SAME FILE AS LAST, PRINT FILE NAME. +] + SETZM ERRCCT +IFE ITSSW,[ + AOS ERRTTL ; BUMP ERROR TOTAL +IFE SAILSW,AOS .JBERR ; BUMP ERROR MESSAGE COUNTER FOR LOADER TO ABORT +.ELSE AOS JOBERR +] ; IFE ITSSW + MOVE A,SYSYM ;GET LAST TAG DEFINED + JUMPE A,ERR1 ;SKIP PRINTOUT IF NONE THERE + PUSHJ P,SYMTYP ;THERE, TYPE IT OUT + MOVE B,CLOC ;NOW GET CURRENT LOCATION + SUB B,SYLOC ;SUBTRACT VALUE OF LAST TAG + JUMPE B,ERR1 ;SKIP NUMERIC PRINTOUT IF RIGHT AT TAG + MOVEI A,"+ ;NOT AT TAG, + PUSHJ P,TYOERR ;TYPE OUT PLUS SIGN, + AOS ERRCCT ;(1 MORE CHAR TYPED) + PUSHJ P,OCTPNT ;THEN TYPE OUT DIFFERENCE IN OCTAL +ERR1: PUSHJ P,TABERR ;NOW SEPARATE WITH TAB + MOVE A,ERRCCT + CAIGE A,8 ;MAKE SURE MOVE TO COLUMN 16. + PUSHJ P,TABERR + MOVEI B,[ASCIZ/GL+/] + SKIPGE GLOCTP ;LOCATION GLOBAL? + PUSHJ P,TYPR3 ;YES, TYPE OUT THAT FACT. + MOVE B,CLOC ;GET CURRENT LOCATION + PUSHJ P,OCTPNT ;TYPE OUT IN OCTAL +;DROPS THROUGH + +;DROPS THROUGH. + PUSHJ P,TABERR + MOVE A,MDEPTH ;NOW DEPTH IN MACRO (NOT IRP, REPEAT, ETC.) EXPANSIONS + MOVSI T,-2 + CALL DPNT0 ;PRINT, IN 2-CHAR FIELD. + MOVEI A,". + CALL TYOERR ;(USED TO BE OCTAL) + MOVE A,CPGN ;CURRENT PAGE NUMBER (FIRST PAGE OF FILE => 0) + PUSHJ P,[AOJA A,D6PNT] ;TYPE IT OUT IN DECIMAL + MOVEI A,"- + CALL TYOERR + MOVE A,CLNN ;ALSO CURRENT LINE NUMBER + PUSHJ P,[AOJA A,D3PNT2] + PUSHJ P,TABERR + MOVEI A,48. ;ASSUME ALL THE STUFF WE'VE PRINTED TAKES 48. CHARS + MOVEM A,ERRCCT ;MAYBE SOMEDAY TABERR, ETC. WILL REALLY UPDATE ERRCCT PROPERLY. + LDB A,[331100,,40] ;PICK UP OP CODE AGAIN + CAIGE A,8 ;ERROR UUO MAX + JRST .+1(A) + JRST [HALT ? JRST .-1] ;OPCODE 0, OR TOO BIG. + JRST ERRSM ;ETSM => TYPE SYM AND MESSAGE. + JRST ERRR ;ETR => JUST PRINT MESSAGE + JRST ERRJ ;ERJ => RH(40) HAS JUMP ADR + JRST ERRI ;ETI => IGNORE LINE RET TO ASSEM1 + JRST ERRA ;ETA => RET TO ASSEM1 + JRST ERRASM ;ETASM => TYPE SYM AND GO TO ASSEM1 + JRST IAE ;ERF => FATAL. + +ERRJ: MOVE A,40 ;ERJ => RH(40) HAS JUMP ADR + HRRM A,ERROR + JRST ERRET1 + +ERRI: PUSHJ P,RCH ;ETI => IGNORE LINE, RETURN TO ASSEM1: EAT UP LINE + CAIE A,12 + JRST .-2 +ERRA: MOVEI A,ASSEM1 ;ETA => RETURN TO ASSEM1, DON'T TYPE SYM. + MOVEM A,ERROR + JRST ERRR + +ERRASM: MOVEI A,ASSEM1 ;ETASM => TYPE SYM AND RETURN TO ASSEM1 + MOVEM A,ERROR +ERRSM: MOVEI C,56. ;ETSM OR ETASM => TYPE OUT SYM THEN MESSAGE + CALL TYPE37 ;CR NOW IF WHOLE MSG WON'T FIT ON ONE LINE. + MOVE A,SYM + PUSHJ P,SYMTYP + PUSHJ P,TABERR +ERRR: CALL TYPE40 ;TYPE THE ERROR MESSAGE. +ERRET1: REST C + POP P,A ;COMMON RETURN POINT FROM UUOS + POP P,B + POP P,T + JRST 2,@ERROR + +;FINISH UP AN ERROR UUO'S ERROR MESSAGE. PRINT THE SPECIFIED STRING +;AND ALSO "IN DEFINE AT ..." IF NECESSARY, ALONG WITH APPROPRIATE CR'S. +TYPE40: MOVE C,ERRCCT + CALL TYPE37 + CALL TYPR4 ;PRINT THE ASCIZ STRING + CALL CRRERR + SKIPN A,DEFNPS ;IF INSIDE A LONG PSEUDO, + RET + MOVE A,DEFNLN + MOVE B,DEFNPN + CAMN A,CLNN ;WHICH DIDN'T START IN THIS VERY LINE, + CAME B,CPGN + JRST TYPE42 + MOVE A,DEFNFI + CAMN A,INFFN1 + JRST TYPE43 +TYPE42: MOVEI B,[ASCIZ/ in /] + CALL TYPR3 + MOVE A,DEFNPS + CALL SYMTYP ;SAY WHAT PSEUDO, AND WHERE IT STARTED. + MOVEI B,[ASCIZ/ Starting at /] + CALL TYPR3 + MOVE A,DEFNPN ;PAGE # -1. + CALL [AOJA A,DPNT] ;PRINT PAGE #. + MOVEI A,"- + CALL TYOERR + AOS A,DEFNLN + CALL D3PNT2 ;PRINT LINE #. +IFN TS,[ + MOVE B,DEFNFI ;PRINT FILE NAME IF IT ISN'T THE CURRENT FILE. + CAMN B,INFFN1 + JRST TYPE41 + MOVEI B,[ASCIZ/ of file /] + CALL TYPR3 + MOVE B,DEFNFI + CALL SIXTYO +] +TYPE41: CALL CRRERR ;AND CRLF. +TYPE43: MOVE A,ERROR + CAIN A,ASSEM1 ;IF THIS ERROR IS EXITING THE PSEUDO, + SETZM DEFNPS ;SAY WE'RE NOT IN IT ANY MORE. + RET + +;JSP TM,ERMARK IN A PSEUDO, TO ARRANGE FOR ERROR MESSAGES TO MENTION +;THAT PSEUDO. SYM SHOULD CONTAIN THE NAME OF THE PSEUDO. +;PUSHES A WORD ON THE STACK SO THAT WHEN THE PSEUDO RETURNS DEFNPS WILL BE CLEARED. +;IF DEFNPS IS SET UP ALREADY, DOES NOTHING (DOESN'T SET DEFNPS; DOESN'T PUSH THE WORD) +ERMARK: SKIPE DEFNPS + JRST (TM) + MOVEM SYM,DEFNPS + MOVE SYM,CLNN + MOVEM SYM,DEFNLN + MOVE SYM,CPGN + MOVEM SYM,DEFNPN + MOVE SYM,INFFN1 + MOVEM SYM,DEFNFI + MOVE SYM,DEFNPS + CALL (TM) + CAIA + AOS (P) + SETZM DEFNPS + RET + +;C SHOULD HAVE CURRENT HORIZ POS. IF TYPING THE STRING 40 POINTS AT +;WOULD OVERFLOW THE LINE, TYPE A CRLF AND TAB NOW ON THE TTY ONLY. +TYPE37: HRRZ B,40 + HRLI B,440700 ;FIRST, FIGURE OUT HOW FAR ON LINE WE'LL TYPE IF WE DON'T CR. + ILDB A,B + CAIE A, ;AND COUNT CHARS IN THE ERR MSG. + AOJA C,.-2 + CAMGE C,LINEL + RET +CRRTBX: MOVEI A,10 + MOVEM A,ERRCCT ;PREVENT THIS FROM BEING DONE TWICE. + SKIPE TTYFLG + RET + MOVEI A,^M ;IF THERE'S NO ROOM, CRLF ON THE TTY ONLY (NOT THE ERR FILE). + PUSHJ P,TYOX + MOVEI A,^J + PUSHJ P,TYOX + MOVEI A,^I + JRST TYOX + + ;TYPE OUT SQUOZE (FLAGS OFF) IN A + +SYMTYP: PUSHJ P,SQCCV ;GET NEXT CHAR IN ASCII. + AOS ERRCCT + PUSHJ P,TYOERR ;TYPE IT OUT. + JUMPE B,CPOPJ ;RETURN IF NOTHING LEFT (TYPED OUT AT LEAST ONE CHAR THOUGH) + IMULI B,50 ;LEFT-JUSTIFY REMAINDER + MOVE A,B ;GET LEFT-JUSTIFIED REMAINDER IN A + JRST SYMTYP ;TYPE OUT REMAINDER OF SYM + + ;TYPE OUT SQUOZE CHARACTER (IN A) + +SQCCV: IDIV A,[50*50*50*50*50] + CAIG A,10. + SOJA A,SQCDTO ;NUMBER (OR BLANK =>SLASH) + CAIL A,45 + SKIPA A,SYTB-45(A) ;SPECIAL + ADDI A,"A-13 ;LETTER + POPJ P, + +SQCDTO: ADDI A,"0 + POPJ P, + +SYTB: ". + "$ + "% + +D3PNT2: MOVE T,[-3,,400000] ;3 CHAR FIELD, NO ZERO SUPPRESSION. + JRST DPNT0 + +DPNT: TDZA T,T ;ORDINARY DECIMAL PRINT. +D6PNT: MOVSI T,-6 ;6 CHAR FIELD, ZERO SUPPRESSION. +DPNT0: IDIVI A,10. + HRLM B,(P) + TRNE T,377777 ;IF NOT LAST DIGIT, + TRNE T,400000 ;AND ZERO-SUPPR. WANTED, + JRST DPNT2 + JUMPN A,DPNT2 ;IF THIS IS A LEADING 0, + JUMPN B,DPNT2 + MOVEI B," -"0 + HRLM B,(P) ;REPLACE WITH A SPACE. +DPNT2: AOBJN T,.+2 ;J IF NOT ENOUGH CHARS YET. + JUMPE A,DPNT1 ;ENOUGH, DON'T MAKE MORE IF NOT NEEDED. + CALL DPNT0 + JRST DPNT1 + +;TYPE HALFWORD IN B IN OCTAL. +OCTPNT: HRRZ A,B + IDIVI A,10 + HRLM B,(P) + JUMPE A,.+2 + PUSHJ P,.-3 + AOS ERRCCT +DPNT1: HLRZ A,(P) +ADGTYO: ADDI A,"0 + JRST TYOERR + +;TYPE OUT THE SIXBIT WORD IN B + +SIXTYO: JUMPE B,CPOPJ + MOVEI A,0 + ROTC A,6 + ADDI A,40 + PUSHJ P,TYOERR + JRST SIXTYO + + ;TYPE CRLF + +CRR: MOVEI A,15 + PUSHJ P,TYO + MOVEI A,12 + JRST TYO + +;OP CODE 0 => NO RECOVERY RETURN TO GO2 +IAE: CALL TYPE40 ;PRINT THE ERROR MESSAGE. + SKIPE ASMOUT + JSP LINK,CONFLZ ;TELL USER ABOUT UNTERM. GROUPINGS. + SKIPE SCNDEP ;MENTION ANY UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS. +IFN ITSSW,.RESET TYIC, + JRST GO2 + + ;TYPR [ASCIZ /STRING/] ;TYPE OUT STRING + +TYPR1: PUSH P,[ERRET1] +TYPR4: HRRZ B,40 ;GET ADR OF BEGINNING OF STRING +TYPR3: HRLI B,440700 ;CONVERT TO BYTE POINTER +TYPR2: ILDB A,B ;GET NEXT CHAR + JUMPE A,CPOPJ ;JUMP IF ZERO, END OF STRING + PUSHJ P,TYOERR ;NON-ZERO, TYPE IT OUT + JRST TYPR2 + +CRRERR: MOVEI A,^M ;CRLF IN ERROR MESSAGE. + CALL TYOERR + SKIPA A,[^J] +TABERR: MOVEI A,^I ;TAB INN ERROR MESSAGE. +TYOERR: +IFN LISTSW,[ + SKIPE LSTTTY ;OUTPUT TO LISTING UNLESS LSTTTY ZERO. + CALL PILPTX +] + SKIPG LSTTTY + JRST TYO ;TO TTY UNLESS LSTTTY POSITIVE. + RET + ;OUTPUT-FORMAT SELECTING PSEUDOS: + +;.SLDR -- ON PASS 2, PUNCH OUT SBLK LOADER AND SELECT SBLK FORMAT +A.SLDR: NOVAL + JUMPGE FF,MACCR ;DO NOTHING ON PASS 1. + PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE FIRST + PUSHJ P,PLOD1A ;PUNCH OUT LOADER +SIMBLK: MOVSI B,SBLKS ;ENTRY FROM PS1, A.SLDR SELECT SBLK + JRST SIMBL1 + +SRIM: MOVE A,SYM ;ENTRY FROM GETVAL, LH(B) HAS RH(CONTRL) + SAVE B + CALL SYMTYP + TYPR [ASCIZ/ Encountered +/] + REST B +SIMBL1: TRO FF,FRNPSS + HRRI B,TRIV ;SET UP TRIV FLAG FOR LH(CONTRL) + MOVSS B + CAME B,CONTRL ;IF CHANGING MODES, END THE BLOCK IN THE OLD MODE + CALL EBLK + MOVE A,CONTRL ;IF OLD MODE WAS RELOCATABLE OF SOME KIND, + TRNN A,DECREL\FASL + JUMPL A,SIMBL2 + SETZM CRLOC ;INITIALIZE LOCATION COUNTER. + MOVEI A,100 + MOVEM A,CLOC +SIMBL2: MOVEM B,CONTRL ;STORE NEW MODE. + AOS (P) + + ;ROUTINE TO SET VARIABLES FOR BENEFIT OF NED LOGIC + ;CALLED BY OUTPUT SELECTING PSEUDOS +OUTUPD: NOVAL +IFN A1PSW,[ + TRNE FF,FRNPSS ;IF PASS 1, + TLNN FF,FLOUT + JRST OUTCHK + AOS OUTN1 ;INDICATE "OUTPUT" HAS OCCURED OTHER THAN IN 1PASS MODE +OUTCHK: TLZE FF,FLOUT + AOS OUTC ;INDICATE "OUTPUT" HAS OCCURED DURING CURRENT ASSEMBLY +] + RET + +ANOSYMS: NOVAL + TRZ FF,FRSYMS + JRST MACCR + +A1PASS: PUSHJ P,OUTUPD +A1PAS1: TLO FF,FLPPSS + MOVEIM A.PPASS,1 ;SET .PPASS TO 1. +IFN CREFSW,[ SKIPE CREFP ;THIS NOW PUNCHING PASS, + PUSHJ P,CRFON ;MAYBE TURN ON CREFFING. +] +IFN LISTSW,[ + SKIPE LISTP + CALL LSTON ;LIST NOW IF WANT LISTING AT ALL. +] + MOVE A,CONTRL + TRNE A,DECREL + CALL DECPGN + TRZA FF,FRNPSS +ARELOC: PUSHJ P,OUTUPD +ARELC1: PUSHJ P,EBLK ;FINISH CURRENT OUTPUT BLOCK + TRO FF,FRLOC ;DOING LOCATION ASSIGNMENT, MAKE SURE NEXT GETS OUTPUT + CLEARM CLOC + MOVEI A,1 + MOVEM A,CRLOC + CLEARM CONTRL + SETZM BKBUF + MOVEI A,LREL + DPB A,[310700,,BKBUF] + MOVEM A,CDATBC + JRST MACCR + +A.DECTWO: CALL AGETFD ;READ THE TWOSEG ORIGIN. + TRNN FF,FRNPSS + ETF [ASCIZ /.DECTWO follows 1PASS/] + MOVE C,ISAV + TRNN C,IRFLD ;NO ARG => DEFAULT IT TO 400000 + MOVEI A,400000 + MOVEM A,DECTWO + +A.DECREL: PUSHJ P,OUTUPD + TRZ FF,FRLOC + PUSHJ P,EBLK ;FORCE OUT BLOCK IN OTHER FMT. + MOVE A,[SETZ DECREL] + CAME A,CONTRL ;SWITCHING TO .DECREL MODE FOR 1ST TIME + TRNE FF,FRNPSS ;IN A 1PASS ASSEMBLY + JRST A.FAS1 + CALL A.FAS1 ;DO THE SWITCH + JFCL + CALL DECPGN ;THEN WRITE THE PROGRAM NAME + JRST MACCR + +A.FAS1: MOVEM A,CONTRL ;DEC FMT COUNTS AS ABS ASSEMBLY. + SETZM BKBUF ;(SO EBLK W0N'T OUTPUT ANYTHING) + SETZM CLOC ;START ASSEMBLING FROM RELOCATABLE 0. + MOVEI A,1 + MOVEM A,CRLOC + PUSHJ P,EBLK ;INITIALIZE AN ORDINARY (DECWDS) BLOCK. + JRST MACCR + +IFN FASLP,[ +A.FASL: PUSHJ P,OUTUPD + PUSHJ P,EBLK + MOVE A,[SETZ FASL] ;FASL ALSO COUNTS AS ABS + JRST A.FAS1 +] + +ATITLE: NOVAL + SAVE CASSM1 ;RETURN TO ASSEM1. + PUSHJ P,GSYL + SKIPE SYM + MOVEM SYM,PRGNM + MOVE T,[440700,,STRSTO] +ATIT2: ILDB A,T ;GET CHAR FROM TITLE STRING + SOSG STRCNT + JRST ATIT3 ;CHAR IS SYLLABLE TERMINATOR +IFE ITSSW,SKIPE CCLFLG ? TRNN FF,FRPSS2 + PUSHJ P,TYO ;NOT TERMINATOR, TYPE OUT AND LOOP BACK + JRST ATIT2 + +ATIT3: CALL ATIT1 ;PRINT THE REST OF THIS LINE. + MOVE A,CONTRL + TRNE A,DECREL + TRNE FF,FRNPSS + CAIA + ETF [ASCIZ /TITLE follows 1PASS/] + MOVE A,TTYINS + ADD A,A.PASS ;SHOULD WE .INSRT TTY: THIS PASS (T SWITCH) + JUMPG A,CPOPJ +IFDEF GTYIPA,JRST GTYIPA ;GO PUSH TO TTY IF CAN, +IFNDEF GTYIPA,HALT ;WHY DID YOU SET TTYINS IF CAN'T? + +ATIT1: CAIE A,15 ;CR? + CAIN A,12 ;LF? + JRST [IFE ITSSW,SKIPE CCLFLG ? TRNN FF,FRPSS2 + JRST CRR ;ONE OF THESE, FINISH TYPEOUT WITH CR + .ALSO RET] ; AND RETURN IF PASS2 DEC CCL +IFE ITSSW,SKIPE CCLFLG ? TRNN FF,FRPSS2 + PUSHJ P,TYO ;NEITHER OF THESE, PRINT CHAR +A.ERR1: PUSHJ P,RCH ;GET NEXT CHAR IN TITLE + JRST ATIT1 + +;.ERR PSEUDO-OP -- FOLLOWED BY LINE WHICH IS ERROR MSG. +A.ERR: SAVE CASSM1 ;RETURN TO ASSEM1, + ERJ A.ERR1 ;AFTER NUMBERS AND USER'S STRING. + +A.FATAL: SAVE [GO2] ;.FATAL - CAUSE A FATAL ERROR. + ERJ A.ERR1 + +APRINT: NOVAL + HLRZS B ;B SAYS WHETHER PRINTX, PRINTC OR COMMENT. + JSP TM,ERMARK + CALL PASSPS + MOVE T,A +APRIN1: PUSHJ P,RCH + CAME A,T + JRST (B) ;GO TO APRIN1 FOR COMMENT, + JRST MACCR + +APRIN2: CAIE A,"! ;COME HERE FOR PRINTX +APRIN3: PUSHJ P,TYO ;HERE FOR PRINTC + JRST APRIN1 + +A.TYO: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A CHARACTER (AS NUMERIC ARG). + CALL TYOERR + JRST MACCR + +A.TYO6: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A WORD OF SIXBIT. + MOVE B,A + CALL SIXTYO + JRST MACCR + ;.BEGIN - START NEW BLOCK WITH NAME = ARG, OR LAST LABEL DEFINED. +A.BEGIN: NOVAL + SKIPE ASMOUT ;IF IN GROUPING, FLUSH IT & ERROR. + JSP LINK,CONFLM + PUSHJ P,GETSLD ;READ A NAME. + MOVE SYM,SYSYM ;NO ARG, USE NAME OF LAST LABEL. + MOVE A,SYM ;NAME TO USE FOR BLOCK. + MOVE B,BKLVL ;CURRENT LEVEL + 1 + HRLZI B,1(B) ;IS LEVEL OF NEW BLOCK. + HRR B,BKCUR ;ITS SUPERIOR IS CURRENT BLOCK. + MOVEI C,0 ;SEE IF AN ENTRY EXISTS FOR THIS BLOCK. + MOVE AA,A.PASS +A.BEG0: CAMN A,BKTAB(C) + CAME B,BKTAB+1(C) + JRST A.BEG1 ;THIS ENTRY ISN'T FOR BLOCK BEING ENTERED. + TDNE AA,BKTAB+2(C) ;FOUND: DEFINED IN THIS PASS? + ETSM [ASCIZ /Multiply defined BLOCK/] + JRST A.BEG2 ;NO, SAY IT'S DEFINED. + +A.BEG1: ADDI C,BKWPB ;LOOK THRU ALL ENTRIES. + CAMGE C,BKTABP + JRST A.BEG0 + CAIL C,BKTABS ;ALL ENTRIES USED => ERROR. + ETF ERRTMB + MOVEM A,BKTAB(C) ;ALLOCATE NEW ENTRY + MOVEM B,BKTAB+1(C) ;STORE NAME, LEVEL, SUPPRO. + MOVEI A,BKWPB(C) + MOVEM A,BKTABP ;POINTS TO 1ST UNUSED ENTRY. +A.BEG2: IORM AA,BKTAB+2(C) ;INDICATE BLOCK SEEN THIS PASS. + MOVEM C,BKCUR ;NEW BLOCK NOW CURRENT BLOCK, + AOS A,BKLVL ;ITS LEVEL NOW CURRENT LEVEL, + CAIL A,BKPDLS ;PUSH IT ON BLOCK PDL + ETF [ASCIZ /.BEGIN nesting too deep/] + MOVEM C,BKPDL(A) + JRST ASSEM1 + +ERRTMB: ASCIZ /Too many symbol blocks/ +ERRUMB: ASCIZ /Unmatched .BEGIN - .END/ + +;.END - POP CURRENT BLOCK. +A.END: NOVAL + SKIPE ASMOUT ;IN GROUPING => TERMINATE IT & ERROR. + JSP LINK,CONFLM + MOVE A,CDISP ;IF FOLLOWED BY WORD TERM, + TLNN A,DWRD ;CAUSE IT TO BE RE-READ + TLO FF,FLUNRD ;SO ARG WILL BE NULL. + PUSHJ P,GETSLD ;READ ARG. + JRST A.END0 ;NO ARG. + MOVE C,BKCUR ;ERROR UNLESS BLOCK BEING TERMINATED + MOVE A,BKTAB(C) ;HAS SAME NAME AS ARG. + EXCH A,SYM ;(MAKE SURE SYM NAME TYPED IS BLOCK'S NAME) + CAME A,SYM + ETSM ERRUMB ;ERROR, PRINT SYM (BLOCK'S NAME) +A.END0: MOVE C,BKCUR ;NOT OK TO END .MAIN BLOCK OR .INIT BLOCK. + CAIG C,BKWPB + ETA ERRUMB + HRRZ C,BKTAB+1(C) + MOVEM C,BKCUR ;POP INTO FATHER OF PREV. CURRENT BLOCK. + SOS BKLVL + JRST ASSEM1 + +;BKTAB: 3-WORD ENTRIES, 1 PER BLOCK, IN NO PARTICULAR ORDER. +;1ST WD HAS SQUOZE NAME OF BLOCK, FLAGS CLEAR. +;2ND WD HAS LEVEL,,BKTAB IDX OF CONTAINING BLOCK("FATHER", "SUPERIOR") +;3RD WD BIT 1.N ON => BLOCK ENTERED ON PASS N. +;SYMBOL TABLE OUTPUT RTN PUTS -2* IN 3RD WD. +;THE FIRST BKTAB ENTRY IS THAT OF THE OUTERMOST BLOCK (.INIT) +;IN WHICH INITIAL SYMS ARE DEFINED. +;THAT ENTRY'S 2ND AND 3RD WDS ARE 0. +;THE NEXT IS THAT OF THE MAIN BLOCK (.MAIN) IN WHICH +;ALL SYMBOLS ARE NORMALLY DEFINED (THAT IS, YOU ARE IN THAT BLOCK +;BEFORE YOU DO ANY .BEGIN'S). +;THAT ENTRY'S 2ND WD IS 1,, ; ITS 3RD, 0. + +;THE BKPDL IS A TABLE OF BLOCKS CURRENTLY ENTERED & NOT ENDED. +;BKPDL'S 1ST ENTRY IS FOR OUTERMOST BLOCK. +;LAST ENTRY IS BKPDL+@BKLVL, FOR CURRENT BLOCK. + +BKTABS==BKTABL*BKWPB + +VBLK +BLCODE [ +BKTAB: BLOCK 3 ;ENTRY FOR .INIT BLOCK. +PRGNM: BLOCK BKTABS-BKWPB ;PROGRAM NAME IS NAME OF MAIN BLOCK. +] +BKTABP: 0 ;IDX IN BKTAB OF 1ST UNUSED ENTRY. +BKPDL: BLOCK BKPDLS ;TABLE OF BLOCKS STARTED, NOT FINISHED. +BKLVL: 0 ;CURRENT BLOCK LEVEL, IDX OF LAST USED IN BKPDL. +BKCUR: 0 ;BKTAB IDX OF CURRENT BLOCK. +ESBK: 0 ;-1 OR BLOCK TO EVAL SYM. IN. +ESL1: 0 ;IN ES, LEVEL OF BLOCK OF BEST SYM SO FAR. +ESL2: 0 ;3RDWRD OF BEST SO FAR. +SADR: 0 ;SYM TAB IDX OF BEST SO FAR. +ESLAST: 0 ;RH IDX OF LAST DEF (EVEN IF NO GOOD) -1 IF NONE + ;SIGN NEG. IF LAST DEF SEEN BEFORE @ESXPUN +ESXPUN: -1 ;IF SEE EXPUNGED OR FREE ENTRY, PUT IDX HERE. +BKTAB1: BLOCK BKTABL ;USED BY SSYMD. +PBLK + +;.SYMTAB ARG ;SAY WANT AT LEAST ARG STE'S IN SYMTAB. +A.SYMTAB: NOVAL + SAVE [0] ;THIS WORD WILL BE SETOM'ED IF THERE IS REALLY ANY WORK NEEDED. + PUSHJ P,AGETFD ;GET DESIRED SYM TAB SIZE. + CAMG A,SYMLEN ;IF HAVE ENOGH ROOM ALREADY, + JRST A.SYM1 ;NO NEED TO RE-INIT. + CAILE A,SYMMAX ;IF WANTS MORE THAN MAXIMUM, ERROR. + ETF [ASCIZ/.SYMTAB 1st arg too big/] + MOVEM A,SYMLEN ;TELL INITS ABOUT NEW SIZE. + SETOM (P) +A.SYM1: CALL AGETFD ;READ DESIRED CONSTANTS TABLE SPACE ALLOCATION. + CAMG A,CONLEN ;IF TABLE ALREADY BUG ENOUGH, NOTHING TO DO. + JRST A.SYM2 + CAILE A,CONMAX + ETF [ASCIZ/.SYMTAB 2nd arg too big/] + MOVEM A,CONLEN ;ELSE REMEMBER IT AND SAY REALLOCATION NECESSARY. + SETOM (P) +A.SYM2: CALL AGETFD ;3RD ARG IS # WORDS PER SYMBOL - BUT ONLY 3 IS ALLOWED NOW. + JUMPE A,A.SYM3 ;EVENTUALLY 4 WILL GET 12-CHARACTER SYMBOLS. + CAIL A,MINWPS + CAILE A,MAXWPS + ETF [ASCIZ/.SYMTAB 3rd arg out of range/] + CAME A,WPSTE + SETOM (P) + MOVEM A,WPSTE +A.SYM3: REST A ;IS THERE ANYTHING THAT ACTUALLY NEEDS TO BE CHANGED? + JUMPE A,ASSEM1 ;IF NOT, NEVER GIVE ERROR - ELSE WOULD ALWAYS LOSE ON PASS 2. + MOVE B,PLIM + CAMN B,CONTBA ;IF THERE HAVE BEEN ANY LITERALS + SKIPE INICLB ;OR ANY MACROS, IRPS, REPEATS, ETC., THEN ... + ETF [ASCIZ/Too late to do .SYMTAB/] + MOVE CH1,MACTAD ;SET UP AC -> START OF INIT CODE + SUBI CH1,MACTBA ;SO IT CAN REFER TO ITSELF. + PUSHJ P,INITS(CH1) ;RE-INIT, SET SYMSIZ, SYMAOB, ETC. + PUSHJ P,MACINI ;INIT PTRS TO END OF MACTAB. + JRST ASSEM1 + +A.OP: PUSHJ P,A.OP1 ;.OP, + JRST VALRET ;RETURNS VALUE + +A.AOP: NOVAL + AOS (P) ;.AOP DOESN'T RETURN VALUE +A.OP1: PUSHJ P,AGETFD + PUSH P,A + PUSHJ P,AGETFD + PUSH P,A ;PDL NOW HAS FIELD 0 AND FIELD 1 + PUSHJ P,AGETFD + POP P,B ;B NOW HAS FIELD 1, A HAS FIELD 2, PDL HAS FIELD 0 + EXCH A,B + POP P,T ;T HAS FIELD 0, A HAS FIELD 1, B HAS FIELD 2 + TLNN T,(0 17,) ;IF AC FIELD NOT PRESENT IN INSN, SUPPLY ONE. + TLO T,(0 A,) + TDNN T,[0 -1(17)] ;IF NO ADDR OR IDX FIELD IN INSTRUCTION, + HRRI T,B ;SUPPLY ONE. + SETOM A.ASKIP' ;.ASKIP WILL BE -1 IFF INSN SKIPPED, ELSE 0. + TLNE T,74000 ;AVOID EXECUTING OPCODE ZERO. + XCT T + SETZM A.ASKIP + MOVEM A,AVAL1' ;STORE C(AC) AS .AVAL1 + MOVEM B,AVAL2' ;STORE C(E) FOR .AVAL2 + POPJ P, ;RETURN TO WHATEVER + +AASCIZ: TDZA T,T +A.ASCII: MOVEI T,1 + MOVEM T,AASCF1 ;STORE TYPE + MOVE D,[440700,,T] + SETZM AASCFT + JRST AASC1 + +AASCII: SKIPA D,[440700,,T] +ASIXBI: MOVE D,[440600,,T] + SETZM AASCFT ;INDICATE NOT .DECTXT + SETOM AASCF1 ;INDICATE REGULAR (NOT ASCIZ) + JRST AASC1 + +A.DCTX: NOVAL + MOVE A,CONTRL + TRNN A,DECREL + ETA [ASCIZ /.DECTXT in non-DECREL assembly/] + CALL EBLK + SETZ B, + SETOM AASCFT + SETOM AASCF1 ;INDICATE ASCIZ-STYLE PADDING + MOVE D,[440700,,T] +AASC1: TLZE I,ILMWRD + JRST TEXT2 ;MULTIPLE WORD, FALL IN FOR NEXT SET OF CHARS + MOVEMM ASMDS1,ASMDSP + MOVEM SYM,DEFNPS ;REMEMBER LOCATION IN FILE OF PSEUDO + MOVEMM DEFNLN,CLNN ;IN CASE THE DELIMITER IS MISSING. + MOVEMM DEFNPN,CPGN +IFN TS, MOVEMM DEFNFI,INFFN1 + HLRZ T,B ;GET FILL CHARACTER + IMUL T,[REPEAT 5,[1_<.RPCNT*7>+]0] ;CONVERT TO ASCII FILL WORD SHIFTED -1 (IMUL SCREW) + LSH T,1 ;SHIFT TO PROPER POSITION (EXTRA IN CASE WANT TO FILL W/ HIGH BIT SET) + MOVEM T,AASEFW ;STORE AS FILL WORD, T NOW SET UP TO ACCUMULATE VALUE + CALL PASSPS + MOVEM A,TEXT4 ;STORE TERMINATOR +TEXT7: PUSHJ P,RCH +AASC8: CAMN A,TEXT4 + JRST AASC1A ;TERMINATOR + TLNN D,760000 + JRST TEXT6 ;WORD FULL +TEXT9: TLNE D,100 ;CHECK BOTTOM BIT OF SIZE FIELD OF BP + JRST AASC2 ;SET => NOT SIXBIT + SUBI A,40 + CAILE A,77 + SUBI A,40 ;CONVERT LOWER CASE ASCII TO UPPER CASE + JUMPGE A,.+2 + ETR ERRN6B +AASC3: IDPB A,D + TRO I,IRSYL + JRST TEXT7 + +ERRN6B: ASCIZ /Character not SIXBIT/ + +;TERMINATOR + +AASC1A: TLNN D,760000 ;SKIP UNLESS END OF WORD + SKIPGE AASCF1 ;SKIP UNLESS REGULAR + JRST [ MOVE CH1,ASMDS1 ;REGULAR OR NOT END OF WORD + MOVEM CH1,ASMDSP ;RESTORE ASMDSP AS SAVED AT START OF PSEUDO. + JRST TEXTX] + MOVEI CH1,1 ;END OF WORD AND NOT REGULAR + JRST AASC1B ;EXTRA 0 NEED FOR Z FLAVOR + +AASC2: CAIN A,"! + SKIPG AASCF1 + JRST AASC3 ;NOT .ASCII OR NOT EXCL + PUSH P,T ;READ FIELD + PUSH P,D + PUSH P,SYM + SAVE ASMOUT ;PREVENT CLOSEBRACKETS FROM TRYING TO TAKE EFFECT. + MOVEIM ASMOUT,4 ;NOTE THIS LOSES IF CALL PSEUDO THAT RETURNS TO ASSEM1. + MOVEI SYM,[SETOM ASUDS1] ;NOW TO SET UP UNDEFINED SYM CONDITION + TLNE FF,FLPPSS + MOVE SYM,[SQUOZE 0,.ASCII] ;PUNCHING PASS, UNDEFINED => REAL ERROR + CLEARM ASUDS1 + PUSHJ P,AGETFD + ;"UNDEFINED IN .ASCII" ERROR INSTR, ERROR MESSAGE BUT ONLY ON PASS 2 + ;BUT NOTE THAT ON PASS 2 IT MIGHT ASSEMBLE DIFFERENT NUMBER OF WORDS, + ;CAUSING LOSSAGE IF NOT IN CONSTANT + REST ASMOUT + POP P,SYM + POP P,D + POP P,T + SKIPGE ASUDS1 + MOVNI A,1 ;HAD UNDEFINED SYMS SO ASSUME MAX + SKIPGE ASUDS1 + TLO I,ILNOPT ;ALSO DON'T OPTIMIZE OVER IN CONSTANT + MOVE CH1,[440700,,AASBF] + MOVEM CH1,ASBP1 + MOVEM CH1,ASBP2 + PUSH P,[AASC5] + MOVE CH1,A +AASC6: LSHC CH1,-35. + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,AASC6 + HLRZ A,(P) + ADDI A,"0 + IDPB A,ASBP1 + POPJ P, + +AASC5: MOVEI A,0 + IDPB A,ASBP1 ;END .ASCII NUMBER WITH ZERO +AASC8A: TLNN D,760000 + JRST AASC7 ;END OF WORD + ILDB A,ASBP2 + JUMPE A,AASC9 + IDPB A,D + JRST AASC8A + +AASC9: TLO FF,FLUNRD + JRST TEXT7 + +AASC7: TDZA CH1,CH1 +TEXT6: MOVNI CH1,1 ;WORD FULL +AASC1B: MOVEM CH1,AASCF2 + CLEARM CDISP + MOVEM A,TEXT8 + MOVE A,T + SKIPE AASCFT ;FOR .DECTXT, OUTPUT WORD INSTEAD OF RETURNING IT. + JRST [ CALL PPB + MOVE D,[440700,,T] + JRST TEXT2A] + TLO I,ILMWRD ;ELSE ARRANGE TO BE CALLED BACK TO RETURN NEXT WORD. + MOVEI T,ASSEM2 + MOVEM T,ASMDSP + SKIPLE CONSML ;IF NOT MULTI-LINE MODE, + JRST CLBPOP + MOVE T,ASMOUT ;IF THE TEXT IS IN <>'S OR ()'S, + HRRZ T,ASMOT2(T) + CAIE T,LSSTHA + JRST CLBPOP + CALL IGTXT ;USE ONLY THE FIRST WORD. + SKIPE CONSML ;AND ERROR IF IN ERROR MODE. + ETR [ASCIZ/Multi-word text pseudo in brackets/] + JRST CLBPOP + + ;GET NEXT WORD + +TEXT2: TRO I,IRFLD +TEXT2A: MOVE T,AASEFW ;INITIALIZE T TO FILL WORD + MOVE A,TEXT8 ;GET NEXT CHAR (ALREADY READ BY RCH) + SKIPGE B,AASCF2 + JRST TEXT9 ;REG OR HAVEN'T READ SECOND DELIMITER, FALL BACK IN + JUMPE B,AASC8A +TEXTX: SETZM DEFNPS + SKIPN AASCFT + JRST TEXT5 ;RETURNING FROM ASCIZ AFTER PUTTING THE TRAILING ZERO OUT. + MOVE A,T + CALL PPB ;FOR .DECTXT, OUTPUT THE FILL WORD INSTEAD. + JRST MACCR + +VBLK + +AASCF1: 0 ;-1 REG OR SIXBIT, 1 .ASCI 0 ASCIZ +AASCF2: 0 ;MULTIPLE WORD RETURN FLAG -1 REG 0 FINISH ! HACK 1 OUTPUT FILL WORD FOR Z +AASCFT: 0 ;0 REGULAR, -1 => .DECTXT (OUTPUT WORDS TO FILE INSTEAD OF RETURNING THEM) +TEXT4: 0 ;DELIMITER +TEXT8: 0 ;SAVED NEXT CHAR WHILE RETURNING BETWEEN WORDS +ASBP1: 0 ;IDPB TO AASBF ON .ASCII FIELD +ASBP2: 0 ;ILDB FROM AASBF " +AASBF: BLOCK 8 ;ACCUMULATED TYPEOUT OF NUMBER FOR .ASCII, EXTRA LONG FOR HACKERS TYPING OUT BINARY +ASUDS1: 0 ;UNDEFINED SYM FLAG FOR .ASCII DURING PASS 1 +AASEFW: 0 ;FILL WORD + +PBLK + +IGTXT: TLNN I,ILMWRD + RET + PUSH P,A ;ROUTINE TO EAT UP TEXT OF UNDESIRED MULTIPLE WORD + SKIPLE AASCF2 ;DETECT SCREW CASE: AFTER ASCIZ OF 5 CHARS, DELIMITER IS + JRST IGTXT1 ;ALREADY GOBBLED, BUT SOME OF THE ASCIZ REMAINS. + PUSHJ P,RCH + CAME A,TEXT4 + JRST .-2 +IGTXT1: TLZ I,ILMWRD + MOVEMM ASMDSP,ASMDS1 + SETZM DEFNPS + JRST POPAJ + +;".ASCVL /X" RETURNS THE ASCII VALUE OF "X". NOTE THE DELIMITER IS NOT REPEATED +;AND SERVES ONLY TO ALLOW SPACES TO BE IGNORED WHILE WINNING IF X IS A SPACE. +A.ASCV: CALL PASSPS ;SKIP SPACES TO REACH THE DELIMITER. + CALL RCH ;READ THE CHAR AFTER THE DELIMITER + MOVE T,A + JRST TEXT5 ;AND RETURN ITS ASCII VALUE. + +ASQOZ: HLLM B,(P) ;SAVE FLAG THAT'S 0 FOR SQUOZE, -1 FOR .RSQZ . + SAVE SYM + PUSHJ P,AGETFD + LSH A,36 + PUSH P,A + PUSHJ P,GETSLD ;GET SYM, SAVE DELIMITER FOR REINPUT + CALL NONAME + REST A + LDB B,[4000,,SYM] ;GET JUST THE SQUOZE. + SKIPGE -1(P) + PUSHJ P,ASQOZR ;FOR .RSQZ, RIGHT-JUSTIFY IT. + SUB P,[1,,1] + ADD A,B + JRST CLBPOP + +;RIGHT-JUSTIFY THE SQUOZE WORD IN B. +ASQOZR: MOVE SYM,B + IDIVI SYM,50 + JUMPN LINK,CPOPJ ;LAST ISN'T BLANK, DONE. + MOVE B,SYM ;ELSE REPLACE BY WHAT'S SHIFTED RIGHT 1 CHAR. + JRST ASQOZR + + ;COMMON PSEUDO ROUTINE TO RETURN MIDAS INTERNAL QUANTITY + ;ADR IN LH(B)) AS VALUE (EG. .RPCNT, .FNAM1, .AVAL2, ETC. + ;INTSYMS MAY APPEAR TO LEFT OF = + +INTSYM: MOVE A,B ;GET ADR IN LH(A) + JRA A,CLBPOP ;RETURN IT + + ;.YSTGW, .NSTGW ACCORDING TO WHAT'S IN LH(B) + +STGWS: HRLES B ;.NSTGW INCREMENTS STGSW, .YSTGW DECREMENTS. + ADDB B,STGSW + SKIPGE B ;BUT DON'T DECREMENT PAST 0. + SETZM STGSW + JRST MACCR ;STORAGE WORDS ARE ALLOWED IF STGSW IS ZERO. + + ;.TYPE + +A.TYPE: SAVE SYM + SAVE SYM + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + SUB P,[2,,2] + TRNN I,IRLET ;IF SYLLABLE IS A NUMBER, + JRST [ SETO A, ;RETURN -1. + JRST CLBPOP] + PUSHJ P,ES ;EVALUATE SYM, INTERESTED IN SQUOZE FLAGS RETURNED IN A + MOVEI A,17 ;DIDN'T SKIP, RETURN 17 => UNSEEN +IFN CREFSW,XCT CRFINU + JRST CLBPOP + +NONAME: MOVE SYM,-2(P) + ETSM [ASCIZ /No arg/] + SETZ SYM, + POPJ P, + + ;.FORMAT + +A.FORMAT: PUSHJ P,AGETFD ;GET FIRST FIELD (FORMAT #) + MOVE B,CDISP ;WORD TERMINATOR ENDED 1ST ARG => + TLNN B,DWRD + JRST A.FOR1 ;RETURN CURRENT SPEC FOR THAT FORMAT. + PUSH P,A + PUSHJ P,AGETFD ;GET SECOND FIELD (TABLE ENTRY FOR FORMAT NUMBER) + POP P,B + MOVEM A,FORTAB-10(B) + JRST ASSEM1 + +A.FOR1: MOVE A,FORTAB-10(A) + JRST CLBPOP + +A.BYTE: NOVAL + CLEARM NBYTS ;# BYTES ASSEMBLED + CLEARM BYTMT ;TOTAL ACTIVE BYTES IN TABLE + MOVE A,[440700,,BYBYT] ;POINTER TO NEW TABLE + MOVEM A,BYTMP +A.BY1: PUSHJ P,AGETFD ;GET FIELD, .GE. 0 => BYTE, .LT. 0 => HOLE + MOVE C,ISAV + TRNN C,IRFLD + JRST A.BY2 ;NO FIELD + MOVM B,A + SKIPGE A + TRO B,100 + IDPB B,BYTMP + AOS BYTMT +A.BY2: TLNE CH1,DWRD ;CDISP LEFT IN CH1 BY AGETFD + JRST A.BY1 ;NOT WORD TERMINATOR + SKIPN BYTMT ;WORD TERMINATOR, ANY FIELDS? + JRST A.BY3 ;NO, DO .WALGN AND RESET TO WORD MODE + SETOM BYTM ;ENTERING BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETOM BYTM1 + PUSHJ P,BYSET + MOVE A,GLSPAS + MOVEM A,GLSP1 + JRST ASSEM1 + + ;RESET THE BYTE DESCRIPTOR TABLE POINTERS TO POINT TO NEW WORD + +BYSET: CLEARM BYTMC ;COUNT OF BYTES PROCESSED THIS TABLE SCAN + MOVE A,[440700,,BYBYT] ;POINTER TO DESCRIPTOR TABLE + MOVEM A,BYTMP + ILDB A,BYTMP ;FIRST DESCRIPTOR BYTE + AOS BYTMC + DPB A,[300600,,BYTWP] ;DEPOSIT AS FIRST BYTE SIZE + POPJ P, + +A.BY3: CLEARM BYTM ;NO LONGER IN BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETZM BYTM1 + JRST A.WAL1 + +A.WALGN: NOVAL +A.WAL1: LDB A,[360600,,BYTWP] + CAIN A,44 + JRST ASSEM1 ;ALREADY AT BEGINNING OF WORD + MOVEI A,44 + DPB A,[360600,,BYTWP] ;MAKE IT POINT TO BEGINNING OF WORD + PUSHJ P,BYSET + CLEARM T1 + JRST PBY1 + +BYTIN1: CLEARM BYTMC + MOVE A,[440700,,BYBYT] + MOVEM A,BYTMP +BYTINC: AOS A,BYTMC + CAMLE A,BYTMT + JRST BYTIN1 + ILDB A,BYTMP + DPB A,[300600,,BYTWP] + MOVEM A,T1 + HLLZ A,BYTWP + IBP A + TRNN A,-1 + JRST BYTINR + ;NEXT BYTE GOES IN NEXT WORD +PBY1: MOVE P,ASSEMP ;PCONS NEEDS THIS. + MOVEI A,WRD-1 + PUSH A,BYTW ;INTO WRD, + PUSH A,BYTRLC ;INTO WRDRLC + CLEARM BYTW + SETZM BYTRLC + MOVEI A,44 + DPB A,[360600,,BYTWP] + MOVE AA,ASMOUT + JRST @ASMOT4(AA) ;TO PBY4 OR PBY5 OR PBY3 + +PBY4: SKIPE STGSW + ETR ERRSWD + PUSHJ P,PWRD ;NOT IN CONST., OUTPUT WORD. + AOSA CLOC +PBY3: JSP T,PCONS ;OUTPUT INTO CONST. +PBY5: MOVE A,GLSPAS + MOVEM A,GLSP1 +BYTINR: MOVE A,T1 ;CURRENT BYTE SIZE + TRNN A,100 + JRST @ASMDSP + SETZB A,B ;ASSEMBLE HOLE (BLANK BYTE) IMMEDIATELY AFTER PREVIOUS BYTE + JRST PBY2 + +PBYTE: AOS NBYTS +PBY2: MOVEI AA,WRD-1 + PUSH AA,BYTW ;INTO WRD + PUSH AA,BYTRLC ;INTO WRDRLC + IBP BYTWP + LDB T,[301400,,BYTWP] + PUSHJ P,INTFLD + POP AA,BYTRLC ;WRDRLC + POP AA,BYTW ;WRD + JRST BYTINC + + ;VARIABLES FOR .BYTE, .BYTC, .WALGN + +VBLK +BYTM: 0 ;-1 FOR IN BYTE MODE, LAMBDA BOUND BY <'S, ('S, AND ['S ;] +BYTMC: 0 ;COUNT CORRESP WITH BYTMP +BYTMP: 0 ;POINTER TO BYTE DESC TABLE +BYTMT: 0 ;TOTAL ACTIVE BYTES IN TABLE +BYTM1: 0 ;GLOBAL VALUE OF BYTM - WHAT IT WAS OUTSIDE THE OUTERMOST BRACKET + +;FORMAT OF BYTE DESC TABLE +;SEVEN BIT BYTES +;1.7=0 ASSEMBLE =1 BLANK +;1.1 - 1.6 NUMBER OF BITS + +IFNDEF LBYBYT,LBYBYT==5 ;LENGTH OF BYBYT +BLCODE [BYBYT: BLOCK LBYBYT] ;BYTE DESC TABLE, 7 BITS PER DESC + +BYTWP: 440000,,BYTW ;POINTER TO BYTW IDPB TO DEPOSIT CURRENT BYTE +BYTW: 0 ;WORD BEING ASSEMBLED IN BYTE MODE +BYTRLC: 0 ;RELOC OF BYTW. +NBYTS: 0 ;NUMBER BYTES ASSEMBLED (FOR .BYTC) +BYTMCL==.-BYTMC +PBLK + ;;MACRO PROCESSOR +IFN MACSW,[ + ;GET IN B THE CHAR WHOSE ADR IS IN A, INCREMENT A + +REDINC: MOVE CH1,A + IDIVI CH1,4 + LDB B,PTAB(CH2) + AOJA A,CPOPJ + +VBLK ;THIS STUFF ALL RELOCATED WHEN MACTAB ADDR CHANGED. +PTAB: (341000+CH1)MACTBA ;BYTE TABLE + (241000+CH1)MACTBA + (141000+CH1)MACTBA + (41000+CH1)MACTBA + (341000+CH1)MACTBA+1 + + ;IN FOLLOWING MACROS, B = -1, 0, OR +1 (+ SIGN MUST BE GIVEN) + ;0 => BP SAME AS CHAR ADR, -1 => BP FOR ILDB, 1 => BP ONE AHEAD + + ;CHAR ADR IN A, RETURNS BP IN A, CLOBBERS A+1 + +DEFINE BCOMP A,B/ + IDIVI ,4 + ADD ,(+1)BCOMPT!B +TERMIN + +STOPPT: 041000,,MACTBA-1 +BCOMPT: 341000,,MACTBA + 241000,,MACTBA +BCOMPU: 141000,,MACTBA + 041000,,MACTBA + 341000,,MACTBA+1 + +;BP IN A RETURN CHAR ADR IN A, CLOBBERS A-1 (YES, A MINUS 1) +;2ND ARG IS SUBTRACTED - -1 GIVES ADDR OF THE NEXT CHAR. +DEFINE CCOMP A,B/ + MOVEI -1,0 + ASHC -1,2 + SUB ,(-1)CCOMPT!B +TERMIN + + ;BP IN A RETURN CHAR ADR IN A+1, CLOBBERS A + +DEFINE CCOMP1 A,B/ + MULI ,4 + SUB +1,(A)CCOMPT!B +TERMIN + +;FROM HERE THRU CCOMPE SET BY MACINI. +CCOMPB: 0 ;4*<41000,,MACTBA>-4 +CCOMPT: REPEAT 5,0 ;4*<41000,,MACTBA>+.RPCNT-3 +CCOMPE::PBLK + + ;BP IN A, DECREMENT IT + +DEFINE DBPM A + ADD A,[100000,,] + SKIPGE A + SUB A,[400000,,1] +TERMIN + + ;SET UP CPTR FROM CHAR ADR IN A + +ACPTRS: MOVEI CH1,(A) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE COMPUTED CPTR + POPJ P, + +AFCOMP: HRRZM A,FREEPT ;ENTRY TO STORE C(A) INTO FREEPT +FCOMP: MOVE CH1,FREEPT ;COMPUTE FREPTB FROM FREEPT + BCOMP CH1,-1 + MOVEM CH1,FREPTB ;STORE CALCULATED BYTE POINTER + POPJ P, + +STPWR: MOVEI A,375 + JRST PUTREL + +VBLK +PUT377: MOVEI A,377 +PUTREL: JRST PUTRE1 ;IDPB A,FREPTB;STORE CHAR INTO FREE CHARACTER STORAGE + AOS A,FREEPT ;CLOBBERS ONLY A. + AOS PUTCNT + CAMGE A,MACHI + POPJ P, + JRST GCA +PBLK +PUTRE1: PUSH P,[IDPB A,FREPTB] + POP P,PUTREL ;COME HERE ONLY ON 1ST CALL TO PUTREL. + SETOM INICLB ;HAVE WRITTEN IN MACRO TAB & CLOBBERED INIT. + JRST PUTREL ;NOW GO BACK AND REALLY WRITE CHAR. + +;200 BIT SET ON CHAR READ FROM MACTAB, PROCESS SPECIAL CONDITION +;CLOBBERS A,CH1,CH2. + +MACTRM: CAIN A,176 ;376? + JRST RCHTRA ;376 => IGNORE, CHARACTER USED TO CLOBBER UNDESIRED CHARACTERS IN MACRO STORAGE + PUSH P,B ;SAVE B + CAIE A,177 + CAIN A,175 + JRST MRCH1 ;377, 375 => STOP + ADD A,BBASE ;DUMMY, RELOCATE TO POINT TO DUMMY TABLE + MOVEI B,RCHSAV ;RETURN TO RCHSAV ON END OF DUMMY + PUSHJ P,PUSHEM ;SAVE CURRENT STATUS + HRRZ A,(A) ;GET CHAR ADR OF DUMMY + BCOMP A,-1 ;CONVERT TO BYTE POINTER + MOVEM A,CPTR ;STORE AS NEW CPTR + MOVE A,TOPP + MOVEM A,BBASE +RCHTRB: POP P,B +RCHTRA: POP P,A ;POP RETURN + TLZN FF,FLUNRD + JRST -3(A) + JRST -4(A) + +MRCH1: MOVE B,MACP +BPOPJ: POPJ B, ;RETURN AT END OF STRING EXPANSION + + ;RCHSET ROUTINE TO CAUSE INPUT FROM MACRO PROCESSOR + +RCHMAC: TLO FF,FLMAC ;SET FLAG + JSP A,CPOPJ +RCHMC0: REPEAT 2,[ ;GETCHR, RR1 + ILDB A,CPTR ;GET CHAR + TRZE A,200 ;200 BIT... + PUSHJ P,MACTRM ;=> SPECIAL, PROCESS +] + .VALUE +IFN .-RCHPSN-RCHMC0,.ERR RCHMC0 LOSES. + ILDB A,CPTR ;SEMIC + TRZE A,200 + PUSHJ P,MACTRM + CAIE A,15 + JRST SEMIC ;NOT YET + JRST SEMICR ;YET + + ;PUSH INPUT STATUS IN FAVOR OF MACRO + ;B HAS RETURN ADR FOR END OF MACRO (OR WHATEVER) + ;SEE ALSO PMACP + +PUSHEM: PUSH P,A + PUSH P,F + MOVE F,MACP ;GET MACRO PDL POINTER + MOVE CH1,CPTR + CCOMP1 CH1,-1 ;CONVERT TO CHARACTER ADDRESS + HRL CH2,BBASE + PUSH F,CH2 ;PUSH BBASE,,CPTR + MOVEI A,1 ;=> EXPAND MACRO + PUSHJ P,PSHLMB ;SAVE LIMBO1 STATUS AND RETURN + JRST PSHM1 + + ;UNDO A PUSHEM + ;RETURNS BBASE,,CPTR IN B (CPTR RE-INITIALIZED, BBASE NOT) + +POPEM: PUSH P,A + PUSH P,F + MOVE F,MACP + PUSHJ P,POPLMB ;RESTORE LIMBO1 STATUS + POP F,B ;BBASE,,CPTR + MOVEI CH1,(B) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE NEW CPTR +PSHM1: MOVEM F,MACP ;STORE BACK MACRO PDL POINTER +POPFAJ: POP P,F +POPAJ: POP P,A + POPJ P, + +PMACP: MOVE B,MACP ;POP MACRO PDL + HRRZ A,(B) + SUB B,[1,,1] +IFN RCHASW,CAIE A,A.TYM8 + CAIN A,AIRR + JRST A.GO6 ;IRP OR .TTYMAC + CAIN A,REPT1 + JRST A.GO4 ;REPEAT + CAIE A,RCHSV1 ;MACRO + CAIN A,RCHSAV ;ARG + JRST A.GO6 + .VALUE ;DON'T HAVE RETURN, + JRST A.GO6 ;BUT TRY A.GO6 LIKE EVERYTHING BUT REPEAT + +A.GO4: HLLZS -1(B) ;REPEAT, CLEAR OUT COUNT REMAINING +A.GO6: TRO FF,FRMRGO ;EVERYTHING ELSE, SET FLAG TO QUIT + JRST (A) + + ;4.9(B) => .STOP ELSE .ISTOP + +A.STOP: HRRZ A,MACP + JUMPL B,A.STP1 + HRRZ B,(A) ;.ISTOP + CAIN B,REPT1 + HLLZS -2(A) ;REPEAT, STOP ALL INTERATIONS + CAIN B,AIRR + HRRZS -1(A) ;IRP TYPE, CLEAR OUT # GROUPS, DON'T ALLOW RECYCLE +A.STP1: MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP + JRST POPJ1 + +A.QOTE: JFCL +ATERMI: ETSM [ASCIZ/Not in macro/] + JRST MACCR ;MAYBE FLUSH MESSAGE IF PEOPLE HAVE PROBLEMS + + ;PDL STRUCTURE FOR REPEAT + ;TWO TWO WORD ENTRIES + ;BBASE,,CPTR + ;LIMBO1 STATUS,,# TIMES LEFT + ;OLD .RPCNT,,BEG OF BODY + ;GARBAGE,,REPT1 + +AREPEAT: PUSHJ P,AGETFD + JUMPLE A,COND5 ;NO REPEAT PLAY LIKE STRING COND FALSE + PUSH P,A + MOVE A,FREEPT + MOVEM A,PRREPT ;CHAR ADR BEGINNING OF REPEAT + MOVEI A,373 ;CHECK CHAR FOR REPEAT + PUSHJ P,PUTREL ;STORE AS FIRST CHR OF BODY + JSP D,RARL1 + CAIA + CALL RARGCP ;READ THE ARG & COPY INTO MACRO STORAGE. + MOVEI A,^M ;IF THE ARG WASN'T BRACKETED, + TLNE FF,FLUNRD + CALL PUTREL ;INCLUDE THE TERMINATING CR. +SWRET1: PUSHJ P,STPWR ;ALSO RETURN FROM STRING WRITE (.F .I) + POP P,B ;# TIMES TO GO THROUGH + PUSHJ P,PUSHEM + MOVE B,MACP ;NOW GET MACRO PDL POINTER FOR PUSH OF SECOND ENTRY + MOVNI T,1 + EXCH T,CRPTCT ;GET OLD .RPCNT, INITIALIZE NEW ONE TO -1 +CREPT1: SETZI TT,REPT1 + EXCH TT,PRREPT ;GET LOC BEGINNING OF BODY, CLEAR OUT PRREPT, DON'T NEED IT ANYMORE + HRL TT,T + PUSH B,TT ;SAVE OLD .RPCNT,,ADDRESS OF BODY. + PUSH B,CREPT1 ;PUSH CRUD,,REPT1 FOR RETURN + MOVEM B,MACP ;STORE BACK UPDATED MACRO POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE IMMEDIATE CYCLE + JRST MACCR + +IFN .I.FSW,[ ;CODING FOR .I, .F + +SWINI: MOVE A,FREEPT ;INITIALIZE, WILL EVENTUALLY PLAY LIKE REPEAT 1 + MOVEM A,PRREPT + MOVEI A,373 + JRST PUTREL + +SWRET: PUSH P,[1] ;REPEAT COUNT + JRST SWRET1 + +SWFLS: MOVE A,PRREPT ;FLUSH RETURN + PUSHJ P,AFCOMP + JRST MACCR +] + + ;RECYCLE AROUND REPEAT + +REPT1: PUSH P,A + PUSH P,C + HRRZ A,(B) ;CHAR ADR BEG BODY + PUSHJ P,REDINC + CAIE B,373 + HALT ;FIRST CHAR OF REPEAT BODY NOT 373 + HRRZ C,MACP + HRRZ B,-2(C) ;# TIMES LEFT + SOJL B,REPT2 ;JUMP IF LAST TIME THROUGH WAS LAST TIME TO GO THROUGH + AOS CRPTCT + PUSHJ P,ACPTRS ;SET UP CPTR (CHAR ADR IN A) + HRRM B,-2(C) ;STORE UPDATED COUNTDOWN +REPT3: POP P,C + POP P,A + JRST REPT6 + +REPT2: SOS A ;MOVE BACK TO BEG OF REPEAT + ;(IN CASE GETS STORED INTO FREEPT) + MOVE CH2,CPTR + CCOMP CH2,-1 ;CONVERT TO CHARACTER ADDRESS + CAMN CH2,FREEPT + PUSHJ P,AFCOMP + MOVE A,[-3,,-2] + ADDB A,MACP + HLRZ A,1(A) + MOVEM A,CRPTCT + PUSHJ P,POPEM + JRST REPT3 + + ;STRING CONDITIONALS (IFSE, IFSN) + +SCOND: MOVE A,FREEPT + MOVEM A,PRSCND + MOVEM A,PRSCN1 + SAVE SYM + HRRI B,SCONDF + SAVE B ;REMEMBER TEST INSTRUCTION. + SETOB C,SCONDF + JSP D,RARG ;COPY THE 1ST OF THE 2 STRINGS + CAIA + CALL RARGCP ;INTO MACRO STORAGE, FOLLOWED BY 375. + CALL STPWR + JSP D,RARG ;THEN START READING THE 2ND ARG, + JRST SCOND3 ;GO TO SCOND3 WHEN REACH END OF 2ND ARG. + JSP D,RARGCH(T) ;READ NEXT CHAR OF 2ND ARG, + JRST SCOND3 + EXCH A,PRSCND + PUSHJ P,REDINC ;RE-FETCH NEXT CHAR OF 1ST ARG + EXCH A,PRSCND + CAMN B,A ;COMPARE CHARACTERS + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CAIL A,"A+40 + CAILE A,"Z+40 ;NOT EQUAL => CONVERT BOTH TO UPPER CASE. + CAIA + SUBI A,40 + CAIL B,"A+40 + CAILE B,"Z+40 + CAIA + SUBI B,40 + CAMN B,A ;ARE THEY SAME EXCEPT FOR CASE? + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CLEARM SCONDF ;STRINGS DIFFER + CALL RARFLS ;IGNORE REMAINDER OF 2ND ARG. +SCOND3: CLEARB A,C ;END OF (SECOND) STRING ARG ENCOUNTERED + EXCH C,PRSCN1 + MOVEM C,FREEPT + PUSHJ P,FCOMP + EXCH A,PRSCND + PUSHJ P,REDINC + CAIE B,375 + CLEARM SCONDF + REST B + REST SYM + XCT B ;DO THE TEST. + JRST COND4 + JRST COND2 + +VBLK +BLCODE [DMYDEF: BLOCK DMDEFL] ;TABLE OF DUMMY NAMES FOR THING BEING DEFINED +DMYTOP: DMYDEF ;POINTER INTO DMYDEF, POINTS TO AVAILABLE WORD + ;SINCE ONLY ONE THING CAN BE DEFINED AT ONCE, IT IS NOT NECESSARY TO SAVE AND RESTORE DMYTOP +DMYBOT: DMYDEF ;-> 1ST DMYDEF WD USED AT THIS LEVEL. + ;RIGHT NOW, ALWAYS -> DMYDEF SINCE CAN'T HAVE DEFINITION + ;WITHIN A DEFINITION YET. + +PBLK + +PDEF: PUSHJ P,GSYL ;READ IN SYL + CAIE T,", ;IF DELIMITING CHR NOT , + JUMPE SYM,CPOPJ ;AND SYM NULL, RETURN +PDEF1: MOVEM SYM,@DMYTOP ;STORE SYM + AOS D,DMYTOP ;INCR PNTR + CAIL D,DMYDEF+DMDEFL ;CHECK FOR TABLE SIZE EXCEEDED + ETF [ASCIZ/Too many dummies in DEFINE or IRP/] + POPJ P, + +VBLK +BLCODE [DSTG: BLOCK DSSIZ] ;TABLE OF CHAR ADRS OF DUMMIES BEING DEFINED PRIOR TO MACRO EXPANSION +RDWRDP: DSTG ;POINTER TO DSTG, POINTS TO FREE WORD + ;NOTE THAT RDWRDP MUST BE SAVED AND RESTORED SINCE MORE MACROS CAN + ;BE EXPANDED DURING FIELD READ FOR DUMMY +PBLK + +ADDTR1: CLEARM PUTCNT +ADDTRN: MOVE A,FREEPT +ADDTR2: MOVEM A,@RDWRDP + AOS A,RDWRDP + CAIL A,DSTG+DSSIZ + ETF [ASCIZ/Too many dummies in all macros & IRPs being expanded/] + RET + +VBLK +BLCODE [DMYAGT: BLOCK DMYAGL] ;TABLE OF CHAR ADRS OF DUMMYS OF MACROS BEING EXPANDED + ;DMYAGT TRACKS WITH THE MACRO PDL; + ;DMYAGT CAN'T BE COMBINED WITH DSTG SINCE DMYAGT CAN BE SHIFTING AROUND RANDOMLY DURING ARG SCAN +BBASE: DMYAGT ;POINTER TO BEGINNING OF ACTIVE DUMMY LIST (FOR DEEPEST-NESTED MACRO BEING EXPANDED) + ;ADD TO DUMMY # TO GET LOCATION CONTAINING CHAR ADR OF DUMMY +TOPP: DMYAGT ;POINTER TO TOP OF DMYAGT ACTIVE, POINTS TO FREE REGISTER +PBLK + + ;ACTIVATE DUMMYS ON TOP OF DSTG TABLE + ;A -> FIRST (LOWEST) DUMMY IN DSTG TO ACTIVATE + +DMYTRN: MOVE B,TOPP + MOVEM B,BBASE + PUSH P,A +DMYTR2: CAML A,RDWRDP + JRST DMYTR1 + MOVE B,(A) + MOVEM B,@TOPP + AOS B,TOPP + CAIL B,DMYAGT+DMYAGL + ETF [ASCIZ /Too many dummy args active/] + AOJA A,DMYTR2 +DMYTR1: POP P,RDWRDP + POPJ P, + +;THE MACRO TABLE IS FILLED MAINLY WITH 8-BIT BYTES. +;THE FIRST WORD'S ADDR IS IN MACTAD; THE LAST+1'S IN MACTND. +;THE CHARACTER NUMBER OF THE LAST+1ST CHAR IS IN MACHI. +;MACHIB IS BP. TO HIGHEST BYTE OK TO FILL (LAST IN C(MACTND)-1) + +;IF A BYTE IN THE TABLE HAS ITS HIGH BIT OFF, IT IS AN ASCII CHARACTER. +;OTHERWISE, IT IS SPECIAL. IF THE 100 BIT IS OFF IT MEANS +;SUBSTITUTE A MACRO DUMMY ARG WHEN READ; THE CHAR IS THE NUMBER OF THE ARG+200 . + +;377 AND 375 ARE STOP CODES, CAUSING A POP OUT OF THE CURRENT STRING. +;GC CONSIDERS THE CHAR. AFTER A 375 TO START A NEW STRING. + +;376 IS IGNORED WHEN READ; USED TO CLOBBER UNWANTED CHARACTERS IN STRINHGS. + +;374 STARTS EVERY MACRO-DEFINITION. +;373 STARTS THE BODY OF A REPEAT. + +;370 STARTS A WORD STRING: +;THE WORD AFTER THAT WHICH CONTAINS THE 370 +; HAS THE LENGTH IN WORDS OF THE STRING IN ITS LH, +; IN ITS RH, THE ADDRESS OF WD WHICH POINTS BACK TO THIS ONE. +; THEN FOLLOW RANDOM WDS HOLDING ANYTHING AT ALL. +; GC WILL MAKE SURE IT STAYS ON WD BOUNDARY. +; THE LENGTH INCLUDES THE WD HOLDING THE LENGTH. +; IF THE RH OF 1ST WD HAS 0, GC WILL FLUSH THE STRING + +STRTYP: PUSHJ P,REDINC ;DEBUGGING AID ONLY + EXCH A,B + TRZE A,200 + JRST STRTP1 +STRTP2: PUSHJ P,TYO ;NORMAL CHAR, JUST TYPE OUT + MOVE A,B + JRST STRTYP + +STRTP1: PUSH P,A + MOVEI A,"* ;SPECIAL CHAR, TYPE * + PUSHJ P,TYO + POP P,A + TRNE A,100 + JRST STRTP3 ;CONTROL CHAR + ADDI A,260 ;DUMMY, CONVERT TO # + JRST STRTP2 ;TYPE OUT (SINGLE DIGIT) NUMBER + +STRTP3: CAIN A,175 + SKIPA A,C% ;STOP, TYPE % + MOVEI A,"/ ;SOMETHING ELSE, TYPE / + JRST STRTP2 + + + ;.GSSET, SET GENERATED SYM COUNTER + +A.GSSET: CALL AGETFD + MOVEM A,GENSM + JRST ASSEM1 + + ;GSYL-LIKE ROUTINE, READ A SYL FOR WRQOTE + +WRQRR: PUSHJ P,RCH ;GET CHAR (MAYBE WANT THIS TO BE FASTER YET) + IDPB A,FREPTB ;DEPOSIT IN MACRO TABLE + CAMN F,FREPTB ;WAS THIS LAST CHAR IN TABLE? + JRST WRQRGC ;YES, NEED GARBAGE COLLECTION +WRQRR2: XCT GDTAB(A) ;DISPATCH ON CHAR + JFCL ;(MAYBE SKIPS) + SOJGE D,WRQRR ;LOOP FOR FIRST SEVEN CHARS + HRRI D,0 + JRST WRQRR + + ;HERE FROM WRQRR WHEN NEED GARBAGE COLLECTION OF MACRO TABLE + +WRQRGC: MOVEM C,WRQTBP ;PUT POINTER TO BEGINNING OF SYL WHERE IT WILL BE GC'D + MOVE A,MACHI + PUSHJ P,GCA ;GARBAGE COLLECT + MOVE F,MACHIB ;RESET F TO POINT TO NEW LAST CHAR IN MACTAB + MOVEI C,0 + EXCH C,WRQTBP ;GET BACK POINTER TO CHAR BEFORE SYL + MOVE A,LIMBO1 ;RETRIEVE LAST CHAR READ + JRST WRQRR2 ;LOOP BACK, PROCESS CHAR + + ;HERE FROM WRQOTE IF .QUOTE SEEN + ;.QUOTE TAKES ARG LIKE ASCII, PRINTC, ETC. + +A.QOT1: MOVE A,WRQBEG(P) ;GET BACK BP TO CHAR BEFORE .QUOTE + PUSHJ P,A.QOTS ;SET UP FREEPT AND FREPTB PROPERLY + MOVE A,LIMBO1 ;NOW GET CHAR AFTER .QUOTE + CAIE A,^I + CAIN A,40 ;COMPARE WITH SPACE + PUSHJ P,RCH ;SPACE, GOBBLE NEXT CHAR FOR DELIMITER, ELSE THIS ONE + MOVEM A,A.QOT2 ;STORE AS TERMINATOR OF STRING +A.QOT3: PUSHJ P,RCH ;GET CHAR TO QUOTE + CAMN A,A.QOT2 ;TERMINATOR? + JRST WRQOT1 ;TERMINATOR, BACK FOR MORE DEFINITION + PUSHJ P,PUTREL ;DEPOSIT CHAR + JRST A.QOT3 + + ;READ IN BODY OF MACRO, IRP, OR WHATEVER + +WRQOTE: SAVE [0] ;USED FOR LENGTH OF SYMBOL (REALLY 6 MINUS IT). +WRQLEN==,-2 + SAVE [0] ;THIS WD USED FOR DEFINE/TERMIN COUNT. +WRQLVL==,-1 + SAVE [0] ;USED TO REMEMBER BEGINNING OF SYMBOL. +WRQBEG==0 + SETOM INICLB ;CLOBBERED INITS, .SYMTAB NOW ILLEGAL. + PUSHJ P,RCH ;MAYBE POP UP A LEVEL IN EXPANSIONS, SAVE MACTAB SPACE + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-INPUT + MOVE F,MACHIB ;POINTER TO LAST CHAR OK TO PUT IN MACTAB, STAYS IN F + TRO I,IRSYL\IRLET ;MAKE SURE FLAGS SET SO WON'T WASTE TIME AT MAKNUM, POINT +WRQOT0: +WRQOT1: MOVEI D,6 ;SQUOZE COUNTER + MOVEI SYM,0 ;INITIALIZE SYM + MOVE C,FREPTB ;GET POINTER TO CHAR BEFORE SYL ABOUT TO READ + PUSHJ P,WRQRR ;READ SYL + JUMPE SYM,.-2 ;LOOP UNTIL NON-NULL + ;NOW SEE IF DUMMY; **NOTE**: C STILL HAS BYTE POINTER, A SYL TERMINATOR + MOVE B,DMYBOT + CAML B,DMYTOP + JRST WRQOT2 ;NOT DUMMY + CAME SYM,(B) ;COMPARE WITH DUMMY NAME + AOJA B,.-3 ;LOOP ON NO MATCH + SUB B,DMYBOT ;DUMMY, CONVERT TO NUMBER + 200 + SUBI B,200 + LDB T,C ;GET LAST CHAR BEFORE SYL + CAIE T,"! ; ^ NOTE THAT THIS CAN LOSE IF MACRO HAS 33. ARGS + IDPB B,C ;NOT EXCLAMATION POINT, LEAVE THERE, DEPOSITING DUMMY CHAR + CAIN T,"! + DPB B,C ;EXCL, WIPE IT OUT + MOVEM C,FREPTB ;RESET FREPTB + CAIE A,"! ;A HAS DUMMY TERMINATOR, COMPARE WITH EXCL + TLO FF,FLUNRD ;NOT EXCLAMATION POINT, CAUSE IT TO BE RE-INPUT + JRST WRQOT1 ;LOOP BACK FOR NEXT SYL + +;SYL ISN'T DUMMY, CHECK FOR PSEUDO +WRQOT2: MOVEM D,WRQLEN(P) ;REMEMBER START OF AND LENGHTH OF THE SYMBOL. + MOVEM C,WRQBEG(P) + SETOM ESBK ;EVAL IN CURRENT BLOCK. + PUSHJ P,ES ;EVALUATE SYM (DOESN'T CLOBBER F) + JRST WRQOT0 ;NOT SEEN + CAIE A,PSUDO/40000 + JRST WRQOT0 ;NOT PSEUDO + TLZ B,-1 ;CLEAR OUT LH OF VALUE, ONLY INTERESTED IN RH + CAIN B,A.QOTE + JRST A.QOT1 ;.QUOTE + CAIE B,ADEFINE + CAIN B,AIRP + AOS WRQLVL(P) ;DEFINE OR IRP +IFN RCHASW,[CAIN B,A.TTYM + AOS WRQLVL(P) ;.TTYMAC +] + CAIE B,ATERMIN + JRST WRQOT0 + SKIPGE WRQLEN(P) + ETR [ASCIZ /TERMIN longer than 6 chars/] + SOSL WRQLVL(P) ;TERMIN, SKIP IF THE TERMINATING ONE + JRST WRQOT0 ;NOT MATCHING TERMIN, BACK FOR NEXT SYL + POP P,A ;GET BACK BP TO LAST CHAR BEFORE TERMIN + SUB P,[2,,2] .SEE WRQLVL,WRQBEG + MOVE T,DMYBOT ;WE'RE NO LONGER USING SPACE IN DMYDEF. + MOVEM T,DMYTOP +A.QOTS: LDB T,A ;HERE ALSO FROM A.QOT1, GET CHAR BEFORE .QUOTE OR TERMIN + CAIE T,"! + JRST A.QTS2 ;NOT EXCLAMATION POINT => OK + DBPM A, ;EXCLAMATION POINT, DECREMENT POINTER +A.QTS2: MOVEM A,FREPTB ;STORE AS NEW FREPTB + CCOMP1 A,-1 ;CONVERT TO CHAR ADR + MOVEM B,FREEPT ;STORE CHAR ADR AS NEW FREEPT + POPJ P, + +;FORMAT OF A MACRO: +;IT STARTS WITH A 374. +;THEN COME ARGUMENT DESCRIPTORS, ONE PER ARGUMENT. +MCF==777650 ;BITS AND FIELDS ARE: +MCFDEF==200 ;ARG IS DEFAULTED. MCFDEF AND MCFGEN NEVER BOTH SET. +MCFGEN==100 ;ARG SHOULD BE GENSYMMED IF NOT GIVEN IN CALL. +MCFKWD==40 ;ARG IS A KEYWORD ARG, SELECTED BY = RATHER THAN POSITION. +MCFSYN==7 ;FIELD THAT SPECIFIES THE ARGUMENT'S SYNTAX. + MCFNRM==1 ;MCFSYN CONTAINS MCFNRM => NORMAL-SYNTAX ARG + MCFLIN==2 ;MCFSYN CONTAINS MCFLIN => WHOLE LINE ARG + MCFBAL==3 ;MCFSYN CONTAINS MCFBAL => BALANCED ARG + MCFSTR==4 ;MCFSYN CONTAINS MCFSTR => ARG IS A DELIMITED STRING, AS IN "ASCIZ". + MCFEVL==5 ;MCFSYN CONTAINS MCFEVL => ARG IS BY VALUE (PREEVALUATED). +;IF MCFKWD IS SET, THE DESCRIPTOR IS FOLLOWED BY THE NAME OF THE ARGUMENT, +;TERMINATED BY A 377. +;IF MCFDEF IS SET, THE DESCRIPTOR IS FOLLOWED BY THE DEFAULT VALUE OF THE ARG, +;TERMINATED BY A 377. +;IF MCFKWD AND MCFDEF ARE BOTH SET, THE ARG NAME COMES FIRST. +;A ZERO BYTE ENDS THE DESCRIPTOR LIST. +;THEN COMES THE BODY OF THE MACRO, FOLLOWED BY A 375. + +ADEFINE: NOVAL ;ERROR IF CONTEXT WANTS A VALUE. + SAVE CASSM1 ;RETURN TO ASSEM1 EVENTUALLY + JSP TM,ERMARK ;ERR MSGS SHOULD SAY WE'RE INSIDE A DEFINE. + SAVE SYM ;THESE 2 PUSHES ARE FOR NONAME'S SAKE. + SAVE SYM + CALL GETSLD + CALL NONAME + TLZ FF,FLUNRD + SUB P,[2,,2] + SAVE SYM + SAVE ESBK ;SAVE BLOCK TO DEFINE IN FOR ES'S SAKE. +IFN CREFSW,XCT CRFMCD + CALL A.TYM1 + POP P,ESBK + REST SYM + PUSHJ P,ESDEF ;FIND SLOT IN SYMBOL TABLE FOR IT + TLO C,3MACOK ;NEVER SEEN, OK TO MAKE MACRO. + TLON C,3MACOK ;ELSE ERROR IF NUMERIC OR ALREADY USED. + ETSM [ASCIZ/Non-macro made macro/] + MOVEI B,MACCL ;RH(VALUE) = MACCL + HRL B,PRDEF ;LH(VALUE) = CHAR ADR OF MACRO + CLEARM PRDEF ;NO LONGER NEED PRDEF + MOVSI T,PSUDO ;SYMBOL TABLE ENTRY LOOKS LIKE PSEUDO + JRST VSM2 + +IFN RCHASW,[ + ;.TTYMAC NAME + ;BODY + ;TERMIN + + ;NAME DUMMY, CAUSES READIN OF CRUD FROM TTY -> CR (NOT INCLUSIVE) + +A.TTYM: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WE'RE INSIDE A .TTYMAC + CALL A.TYM1 ;READ IN A MACRO-DEFINITION. + MOVEI A,40 ;DON'T LET THE CHAR ENDING THE TERMIN + MOVEM A,LIMBO1 ;MAKE MACCL THINK THERE ARE NO ARGS. + CALL GTYIP1 ;PUSH INTO TTY FOR INPUT + HRLZ B,PRDEF ;PHONY UP A MACRO WHOSE DEFN IS WHAT WE READ. + SETZM PRDEF + MOVEI A,A.TYM8 + JRST A.TYM2 ;CALL THE MACRO: + ;READ THE ARGS, POP OUT OF TTY, EXPAND THE MACRO + ;AND THEN EXIT TO A.TYM8 +] + +A.TYM1: MOVE A,FREEPT + MOVEM A,PRDEF + MOVEI LINK,MCFNRM ;INITIALLY, DUMMIES ARE NORMAL. + MOVEI A,374 + PUSHJ P,PUTREL ;MARK BEGINNING OF MACRO +DEFNI: MOVE T,LIMBO1 + MOVE A,LINK +DEFNC: CAIE T,12 + CAIN T,15 + JRST DEFNA ;NO MORE ARGS (DONE WITH LINE) + CAIE T,LBRACE + CAIN T,LBRKT + JRST DEFNB1 + CAIE T,RBRACE + CAIN T,RBRKT + JRST DEFNB2 + CAIE T,"< ;OPENS TURN ON BALANCEDNESS. + CAIN T,"( + JRST DEFNB1 + CAIE T,"> ;CLOSES TURN OFF BALANCEDNESS. + CAIN T,") + JRST DEFNB2 + CAIN T,"? ;? TURNS BALANCEDNESS ON OR OFF. + JRST DEFBAL + CAIN T,"+ ;+ COMPLEMENTS KEYWORDNESS + XORI LINK,MCFKWD + CAIN T,"\ ;\ COMPLEMENTS GENSYMMEDNESS + XORI LINK,MCFGEN + CAIN T,"- ;- TURNS WHOLELINENESS ON OR OFF. + JRST DEFWHL + CAIN T,"* ;* TURNS ASCIZ-STYLE-NESS ON OR OFF. + JRST DEFASC + CAIN T,"# ;# TURNS EVALUATEDNESS ON OR OFF. + JRST DEFEVL + CAIN T,": ;: MAKES FOLLOWING ARGS NORMAL + MOVEI LINK,MCFNRM ;IN ALL RESPECTS + CAIN T,"; + JRST DEFNSM ;ALLOW DEFINE LINE TO BE COMMENTED +DEFND: SAVE A + CALL GSYL ;READ IN SYMBOL AS SQUOZE IN SYM. + REST A + CAIN T,"/ ;/ MEANS PREVIOUS ARG IS WHOLE-LINE. + XORI LINK,MCFLIN#MCFNRM + JUMPE SYM,DEFNC ;JUMP IF SYMBOL NAME WAS NULL. + CALL PDEF1 ;ELSE PUSH IT ON LIST OF DUMMIES. + MOVE A,LINK + CAIE T,"= + JRST DEFNL + IORI A,MCFDEF ;ONE ARG, WITH DEFAULT VALUE. + ANDCMI A,MCFGEN ;NOT TO BE GENSYMMED. +DEFNL: CALL PUTREL ;OUTPUT A DESCRIPTOR FOR THIS ARG + TRNE LINK,MCFKWD + CALL DEFNM ;PUT OUT ARG NAME IF KWD ARG + CAIE T,"= ;THEN DEFAULT VALUE IF DEFAULTED. + JRST DEFNI + JSP D,RARG ;INIT. FOR READING THE DEFAULT VALUE. + CAIA + CALL RARGCP ;COPY THE ARG INTO MACRO SPACE, + CALL PUT377 ;TERMINATED BY A 377. + JRST DEFNI ;NOW FOR THE NEXT ARG. + +DEFNM: MOVE D,[440700,,STRSTO] +DEFNM1: ILDB A,D + CAMN D,STRPNT + JRST PUT377 + CALL PUTREL + JRST DEFNM1 + +DEFEVL: SKIPA A,[MCFEVL] ;TURN EVALUATEDNESS ON OR OFF. +DEFASC: MOVEI A,MCFSTR ;TURN ASCIINESS ON OR OFF. + JRST DEFN9 + +DEFBAL: SKIPA A,[MCFBAL] ;TURN ON BALANCEDNESS, BUT IF ALREADY ON TURN OFF. +DEFWHL: MOVEI A,MCFLIN ;SIMILAR FOR WHOLELINENESS. +DEFN9: LDB B,[.BP MCFSYN,LINK] + CAMN A,B ;IF CURRENT STATE IS SAME AS IN A, + MOVEI A,MCFNRM ;SWITCH TO NORMAL MODE INSTEAD. + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNB2: SKIPA A,[MCFNRM] ;TURN OFF BALANCEDNESS +DEFNB1: MOVEI A,MCFBAL ;TURN ON BALANCEDNESS + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNSM: PUSHJ P,RCH ;SEMICOLON IN DEFINE LINE + CAIE A,15 + CAIN A,12 +DEFNA: SKIPA A,LINK ;END OF DEFINE LINE, GET COUNT + JRST DEFNSM + MOVEI A,0 + PUSHJ P,PUTREL ;DEPOSIT END-OF-DESCRIPTORS MARK + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD ;CHAR AFTER CR NOT LF + PUSHJ P,WRQOTE ;READ IN BODY + JRST STPWR + +;COME HERE TO EXPAND MACRO; LH OF B POINTS TO STRING. +;SYM HOLDS NAME OF MACRO (USED BY CALL TO AGETFD IN MACEVL). +MACCL: JSP TM,ERMARK ;ERROR MESSAGE DURING ARG SCAN SHOULD SAY WE'RE IN IT. + MOVEI A,RCHSV1 +A.TYM2: SAVE I + AOS PRCALP + AOS MDEPTH + SAVE RDWRDP + SAVE A ;RCHSV1 FOR MACRO, A.TYM8 FOR .TTYMA + MOVEI LINK,0 + HLRZ A,B + PUSHJ P,REDINC + CAIE B,374 + HALT + MOVEM A,@PRCALP + PUSHJ P,REDINC + JUMPE B,[TLO FF,FLUNRD ;SAVE CHR FOLLOWING MACRO W/NO ARGUEMENTS + TLZ I,ILPRN ;SUCH MACROS + SKIPE B,ASMOUT ;IF WITHIN A GROUPING, + CAIN B,4 + JRST MACNX0 + JSP LINK,SAVAS2 ;RESTORE ASMDSP TO NORMAL IN CASE + JRST MACNX0] ;THE CHAR BEING REREAD IS A CLOSE. + TLZ I,ILPRN + MOVE A,LIMBO1 + CAIE A,15 + CAIN A,12 + JRST MACCLD ;NO ARGS IN THIS CALL; NULLIFY ALL ARGS. + CAIE A,"< + CAIN A,"( + TLO I,ILPRN ;BUT MAYBE THERE IS A (. IF SO, IT'S A PAREN'D CALL, + CAIN A,LBRKT ;AND WON'T END TILL THE MATCHING CLOSE. + TLO I,ILPRN + CAIE A,40 ;IF THE CHAR ENDING THE MACRO NAME ISN'T AN OPENPAREN, + CAIN A,^I ;EOL, OR SPACE, RE-READ IT AS PART OF 1ST MACRO ARG. + JRST MACNX0 + TLNN I,ILPRN + TLO FF,FLUNRD +MACNX0: TDZ LINK,LINK +MACNXD: CALL MACDES ;FETCH NEXT DESCRIPTOR + JRST MACPUS ;NO MORE => THIS IS END OF THE CALL + TRNE LINK,MCFKWD + JRST MACK ;KEYWORD PARAM => SPECIAL SCANNER +;READ IN THE VALUE OF THE NEXT ARG, WHICH IS NORMAL (NOT KEYWORD) +MACNRM: CALL ADDTRN ;PUSH WORD TO HOLD VALUE OF ARG ONTO DSTG, + ;INITIALIZED -> FREEPT, WHERE WE WILL NOW WRITE THE ARG. + SOS C,A ;TELL MACRED WHERE THAT WORD IS. + CALL MACRED ;READ IN THE ARGUMENT VALUE. + JRST MACNXD ;THEN HANDLE ANOTHER ARG + .VALUE + JRST MACCLD ;END OF ARG LIST => NULLIFY REMAINING ARGS. + +;READ IN THE NEXT MACRO ARGUMENT ACC TO SYNTAX FLAGS IN LINK. +;C HAS ADDRESS OF WORD ON THE RDWRDP STACK WHICH HOLDS THE POINTER TO THIS ARG +;IN CASE WE WISH TO SET THE ARG TO THE NULL STRING. B AND LINK NOT CLOBBERED. +;RETURNS SKIPPING TWICE IF NO ARG BECAUSE END OF MACRO CALL SEEN. +MACRED: MOVEI D,MACNXR ;RARL3, RARB, RARGBR RETURN TO MACNXR + CALL RCH + CAIE A,^M + CAIN A,^J + JRST MACEND ;MAYBE WE HAVE REACHED THE END OF THE MACRO CALL. + LDB B,[.BP MCFSYN,LINK] + CAIN B,MCFLIN + JRST RARL3 ;ELSE, IF WHOLELINE ARG, NOTHING ELSE TO CHECK, + ;SO INIT FOR READING IT IN. + CAIN A,", + JRST MACNUL ;NON-WHOLELINE ARG IS NULL IF NEXT CHAR IS COMMA + CAIN A,"; ;SEMICOLON ENDS ARG LIST UNLESS INSIDE WHOLELINE ARG + JRST MACEND + CAIN B,MCFBAL + JRST RARB ;FOR BALANCED ARG, NOTHING ELSE SPECIAL, SO INIT. + CAIN B,MCFSTR + JRST MACSTR + CAIN B,MCFEVL ;FOR EVALUATED ARG, READ FIELD AND EXPRESS AS NUMERAL. + TLOA FF,FLUNRD ;AND THE CHAR WE JUST READ WAS THE 1ST CHAR OF THE FIELD. + CAIN A,"\ ;NORMAL ARG STARTING WITH "\" TREATED THE SAME WAY, BUT FIELD + JRST MACEVL ;STARTS WITH NEXT CHAR. + CAIN A,LBRKT + JRST RARGBR ;FOR ORDINARY ARG, OPEN-BRACKET MAKES IT SPECIAL +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + MOVEI T,RARGN ;OTHERWISE IT'S A NORMAL ARG + TLOA FF,FLUNRD ;AND THE CHAR WE RCH'ED IS THE 1ST CHAR OF IT +MACNXR: JRST MACEN1 ;NON-SKIP RETURN FROM RARB, RARL3 OR RARGBR => ARG NULL + CALL RARGCP ;ARG NON-NULL => COPY IT INTO STRING SPACE + CAIE A,"; +CSTPWR: JRST STPWR ;AND TERMINATE IT +MACSC: MOVE A,(C) ;EXCEPT THAT SEMICOLONS INVALIDATE ALL THE SPACES + CAME A,FREEPT ;AND TABS THAT PRECEDE THEM. + JRST STPWR ;IF, AS A RESULT OF THAT, THE ARG IS NULL, END THE ARGLIST. +;COME HERE WHEN THE END OF THE MACRO'S WHOLE ARGLIST IS SEEN. +MACEND: TLO FF,FLUNRD +MACEN1: AOS (P) ;2-SKIP RETURN FROM MACRED INDICATES END OF ARGLIST + AOS (P) ;END OF ARGLIST => THIS ARG IS NULL. +;COME HERE TO NULLIFY CURRENT ARG (WHERE C POINTS) +MACNUL: TRZE LINK,MCFDEF + JRST MACDEF ;MAYBE DEFAULT IT + TRNE LINK,MCFGEN + JRST MACGEN ;MAYBE GENSYM IT + SETZM (C) ;ELSE SET TO NULL STRING. + RET + +MACST1: CALL RCH + CAIN A,", + JRST MACNUL +MACSTR: CAIE A,40 ;HERE FOR ARG DELIMITED LIKE TEXT STRINGS: /TEXT/. + CAIN A,^I ;SKIP ALL SPACES AND TABS BEFORE THE ARG. + JRST MACST1 + JSP D,RARB ;FIND END OF LINE, COMMENT, OR CLOSEBRACKET => + JRST MACEND ;NULLIFY ARG AND END MACRO CALL. + MOVE T,A ;ELSE SAVE THIS CHAR; IT'S THE DELIMITER. + TLZA FF,FLUNRD +MACST2: CALL PUTREL + CALL RCH ;READ ANOTHER CHARACTER. IF IT ISN'T THE DELIMITER, + CAME A,T + JRST MACST2 ;STORE IT AND READ ANOTHER. + CALL STPWR +MACST3: CALL RCH ;PASS BY SPACES AFTER THE CLOSING DELIMITER + CAIE A,40 + CAIN A,^I + JRST MACST3 + CAIE A,", ;COMMA HERE ENDS THE ARG BUT NOT THE MACRO CALL. + JSP D,RARB ;ELSE CHECK FOR OTHER TERMINATORS. + RET ;WE FOUND AN ACCEPTABLE ARG TERMINATOR. + ETR [ASCIZ /Garbage in ASCIZ-style macro arg/] + JRST RARFLS ;IF THERE'S ANYTHING ELSE, COMPLAIN AND SKIP IT. + +;COME HERE TO GIVE AN ARG ITS DEFAULT VALUE. +;MCFDEF WAS CLEARED SO MACDES WILL KNOW THE DEFAULT VALUE HAS +;ALREADY BEEN PASSED OVER AND WON'T TRY TO SKIP OVER IT. +;IF MCFKWD IS SET, WE MUST SKIP OVER THE KWD ARG'S NAME FIRST. +MACDEF: MOVE A,@PRCALP ;COPY THE DEFAULT VALUE FROM THE MACRO BODY + TRZN LINK,MCFKWD + JRST MACDF1 +MACDF0: CALL REDINC + CAIE B,377 + JRST MACDF0 +MACDF1: CALL REDINC ;AS THE ARGUMENT STRING. + CAIN B,377 + JRST MACDF2 ;END OF THE DEFAULT VALUE. + EXCH A,B + CALL PUTREL + EXCH A,B + JRST MACDF1 + +MACDF2: MOVEM A,@PRCALP + JRST STPWR + +;COME HERE IF GENSYMMABLE ARG IS SPEC'D AS NULL. +MACGEN: MOVEI A,5 + MOVEM A,SCKSUM + MOVEI A,"G + PUSHJ P,PUTREL + SAVE CSTPWR + AOS A,GENSM + IDIVI A,10 + HRLM B,(P) + SOSLE SCKSUM + PUSHJ P,.-3 + JRST MACEV2 + +;PROCESS ARG THAT STARTS WITH \, OR #-TYPE ARG. +MACEVL: CALL RCH ;FIRST, CHECK FOR IMMEDIATE END OF MACRO CALL. + JSP D,RARB + JRST MACEN1 + SAVE C + PUSH P,LINK ;SAVE LINK, NEED FLAGS + PUSHJ P,AGETFD ;GET THE FIELD + SKIPE B + ETR [ASCIZ /Relocatable \'d macro arg/] + POP P,LINK + REST C ;IF AGETFD EXPANDED A MACRO, FREEPT HAS CHANGED, SO + MOVE CH1,FREEPT ;PUT NEW VALUE INTO THE POINTER TO THIS DUMMY. + MOVEM CH1,(C) + MOVE CH1,A ;SAVE VALUE OF FIELD FROM CLOBBERAGE + SAVE CSTPWR +MACEV1: LSHC CH1,-35. ;NOW "TYPE OUT" VALUE OF FIELD IN CURRENT RADIX + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,MACEV1 +MACEV2: HLRZ A,(P) + ADDI A,60 + JRST PUTREL ;OUTPUT TO MACTAB STRING BEING DEFINED + +;HANDLE KEYWORD PARAMETERS. COME HERE WHEN A DESCRIPTOR IS SEEN +;THAT SPECIFIES A KEYWORD PARAMETER. +MACK: SAVE RDWRDP + SAVE @PRCALP + SAVE LINK +;FIRST, PUSH A "NOT SET" MARKER FOR EACH OF THE KEYWORD PARAMS IN THIS RUN OF SUCH. +MACK2: SETO A, + CALL ADDTR2 + CALL MACDES ;NOTE THAT THERE IS ONLY ONE PARAM PER DESCRIPTOR + JRST MACK1 ;FOR KEYWORD PARAMS, SO NO NEED TO COUNT DOWN. + TRNE LINK,MCFKWD + JRST MACK2 +MACK1: REST LINK + REST @PRCALP ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM. +MACKLP: CALL GPASST ;NOW SEE IF THERE'S AN ARGUMENT TO BE FOUND + CAIE A,^M ;IF SO, IT SHOUDL START WITH A KEYWORD. + CAIN A,^J + JRST MACKND ;CR OR LF => NO KEYWORD, AND END SCAN. + CAIN A,"; + JRST MACKND + CAIN A,", + JRST MACKN1 ;NULL ARG => NO KEYWORD, BUT DON'T END SCAN. + CAIE A,") + CAIN A,"> + JRST MACKND ;DETECT END OF PARENTHESIZED CALLS, ETC. + CAIE A,RBRKT + CAIN A,RBRACE + JRST MACKND + TLO FF,FLUNRD + CALL GSYL ;THERE SHOULD BE ANOTHER ARG, SO TRY READING KEYWORD NAME + CALL PASSPS + MOVE C,(P) ;NOW SCAN THROUGH THIS RUN OF KEYWORD PARAMS FOR THE + SAVE @PRCALP ;ONE WHOSE NAME MATCHES WHAT GSYL READ. + SAVE LINK + CAIE A,"= + JRST MACKL5 ;NOT FOLLOWED BY "="?? + DPB A,STRPNT +MACKL4: MOVE D,[440700,,STRSTO] + MOVE A,@PRCALP +MACKL1: CALL REDINC + ILDB AA,D + CAIN B,377 ;IF REACHED END OF KEYWORD'S NAME, AND EQUAL SO FAR + JRST MACKL2 ;SEE IF ARG'S NAME ALSO OVER. + CAMN B,AA + JRST MACKL1 ;ELSE KEEP COMPARING IF NAMES STILL SAME SO FAR. +MACKL6: MOVEM A,@PRCALP + CALL MACDES ;THIS KEYWORD DOESN'T MATCH SO FIND THE NEXT + JRST MACKL3 ;THERE ARE NO MORE; LOSE - ARG WITH BAD KEYWORD. + TRNN LINK,MCFKWD + JRST MACKL3 + AOJA C,MACKL4 + +MACKL5: ETR [ASCIZ /Bad format keyword argument/] + TLOA FF,FLUNRD ;INCLUDE THE BAD NON-"=" AS PART OF WHAT WE DISCARD +MACKL3: ETR [ASCIZ /Arg with undefined keyword/] + MOVEI T,RARGN + CALL RARFLS ;SKIP AN ORDINARY-SYNTAX MACRO ARG TO TRY TO RECOVER. + JRST MACK1 + +;COME HERE AFTER FINDING THE PARAM THAT MATCHES THIS ARG. +;C POINTS TO THE WORD IN DSTG FOR THAT ARG (DSTG IS WHAT ADDTRN PUSHES IN) +MACKL2: TRZ LINK,MCFKWD ;(IN CASE WE GO TO MACKL6, SINCE KWD NAME SKIPPED ALREADY) + CAIE AA,"= + JRST MACKL6 ;KWD NAME OVER BUT SPEC'D NAME NOT => MISMATCH + MOVEMM (C),FREEPT + CALL MACRED ;READ IN THE VALUE OF THE ARG, THUS SETTING THIS PARAM. + JRST MACK1 ;THERE ARE MORE ARGS => HANDLE THEM + .VALUE + REST LINK + REST @PRCALP +MACKND: TLO FF,FLUNRD ;MACRO CALL TERMINATOR SEEN. +;NULL ARG SEEN; ENDS THIS RUN OF KEYWORD ARGS BUT NOT THE CALL. +MACKN1: REST C ;GET PTR TO 1ST KWD ARG'S VALUE-WORD +MACKN2: MOVE A,(C) + AOJN A,MACKN4 ;IF THIS ARG WASN'T SPECIFIED, + MOVEMM (C),FREEPT + CALL MACNUL ;NULLIFY IT (MAYBE DEFAULT OR GENSYM) +MACKN4: CALL MACDES ;NOW SKIP OVER THE DESCRIPTORS OF THIS RUN OF KEYWORD PARAMS + JRST MACPUS ;EXHAUSTED ALL THE DESCR'S => END OF MACRO CALL. + TRNE LINK,MCFKWD ;SAME IF REACH A NON-KWD ARG. + AOJA C,MACKN2 + TLNN FF,FLUNRD ;REACHED A NON-KEYWORD PARAM: IF TERMINATOR WAS A NULL ARG, + JRST MACNRM ;GO ON TO READ THE VALUE OF THE NON-KEYWORD PARAM. + JRST MACCLS ;ELSE CALL WAS REALLY ENDED, SO NULLIFY REMAINING ARGS. + +;COME HERE TO FIND THE NEXT DESCRIPTOR. +;SKIPS OVER THE NAME AND DEFAULT VALUE OF THE PREVIOUS DESCRIPTOR, IF ANY. +;THE CONTENTS OF LINKK SAY WHETHER THEY EXIST TO BE SKIPPED OVER. +MACDES: MOVE A,@PRCALP + CALL REDINC ;READ NEXT CHAR OF MACRO + MOVEM A,@PRCALP + TRNE LINK,MCFKWD\MCFDEF + JRST [ CAIE B,377 ;IF THERE'S NAME OR DEFAULT TO SKIP, GO PAST TERMINATOR + JRST MACDES + TRZN LINK,MCFKWD ;AND SAY WE FOUND ONE + TRZ LINK,MCFDEF ;NOTE THERE MAY BE ANOTHER, IN WHICH CASE WE WILL + JRST MACDES] ;SKIP TILL ANOTHER 377 + JUMPE B,CPOPJ ;THIS DESC IS TERMINATOR => RETURN NO SKIP. + MOVEI LINK,(B) ;ELSE PUT FLAGS IN LINK. + JRST POPJ1 + +;COME HERE WHEN A MACRO CALL TERMINATOR IS ENCOUNTERED, TO NULLIFY ALL +;THE REMAINING PARAMS THAT THE MACRO WANTS, THEN ENTER THE MACRO. +;ENTER AT MACCLS IF HAVE JUST READ A DESCRIPTOR AND NOT NULLIFIED THE ARG, +;OR AT MACCLD IF HAVE JUST PROCESSED AN ARG, TO READ THE NEXT DESCRIPTOR. +MACCLS: TRNE LINK,MCFDEF\MCFGEN + JRST MACCL2 + SETZ A, ;NULLIFY NON-GENSYMMED, NON-DEFAULTED ARGS QUICKLY + CALL ADDTR2 +MACCLD: CALL MACDES ;THEN READ THE NEXT DESCRIPTOR. + JRST MACPUS ;IF NO MORE ARGS, ENTER THE MACRO. + JRST MACCLS + +MACCL2: CALL ADDTRN ;FOR GENSYMMED OR DEFAULTED ARG, PUSH PTR TO FREE STG + SOS C,A + CALL MACNUL ;THEN WRITE THE DESIRED VALUE THERE + JRST MACCLD ;THEN HANDLE NEXT DESCRIPTOR. + +;COME TO MACPUS WHEN ALL THE PARAMS HAVE HAD VALUES PUT IN DSTG (USING ADDTRN) +;TO ENTER THE MACRO. +MACPUS: TLZE I,ILPRN ;SPECIAL PARENTHESIZED CALL? + CALL MACPRN ;YES, SKIP PAST THE CLOSING PAREN. + MOVE B,(P) ;IS THIS A .TTYMAC? + CAIN B,A.TYM8 + CALL A.INEO ;YES, POP OUT OF TTY AFTER READING ARGS. + JFCL + REST B ;RCHSV1 OR A.TYM8 + PUSHJ P,PUSHEM + MOVE A,@PRCALP + PUSHJ P,ACPTRS ;SET UP CPTR + POP P,A + PUSHJ P,DMYTRN + SOS PRCALP + REST I +MACCR: AOS (P) ;COMMON RETURN FROM PSEUDOS TO RETURN FROM GETVAL WITHOUT VALUE +CMACCR: POPJ P,MACCR + +MACPRN: MOVEI TT,1 ;START PAREN-DEPTH AT 1 + JSP D,RARBC ;AND READ CHARS, UPDATING THE DEPTH, UNTIL + HALT + JUMPN TT,.-2 ;THE DEPTH GETS TO BE 0. + RET + +A.GOMC: ILDB B,A ;.GO ROUTINE TO SKIP PAST DESCRIPTORS + JUMPN B,A.GOMC ;IN HEADER OF MACRO DEFINITION. + JRST A.GORT + +RCHSV1: SOS MDEPTH ;END OF MACRO EXPANSION, DECREMENT DEPTH IN MACRO EXPANSIONS +A.TYM8: PUSH P,A ;ENTRY FROM .TTYMAC END OF EXPANSION + MOVE B,TOPP +RCHSV3: CAMG B,BBASE + JRST RCHSV2 + HLRZ A,-1(B) + ADD A,-1(B) + MOVEI A,1(A) + CAME A,FREEPT + JRST RCHSV2 + HRRZ A,-1(B) ;GET NEW FREEPT + SOJA B,RCHSV3 + +RCHSV2: POP P,A + ;RETURN ROUTINE FOR END OF DUMMY +RCHSAV: MOVE B,BBASE + MOVEM B,TOPP + PUSHJ P,POPEM + HLRM B,BBASE +REPT6: TRZE FF,FRMRGO + POPJ P, ;RETURN TO .GO + JRST RCHTRB + +;IRP, IRPS, IRPC, IRPW, IRPNC ALL CALL HERE. +;ALL USE 2 FRAMES ON THE MACRO PDL: +; ,, +; ,, +; \<# GROUPS>,, +; ,,AIRR +;THE 3RD WORD HAS IN BITS 4.1-4.3 THE IRP TYPE CODE +; (NIRPO, NIRPC, ETC) +;AND IN THE REST OF THE LH, THE NUMBER OF GROUPS +; (TRIPLES OF TWO DUMMIES AND A LIST) + +.SEE NIRPO ;FOR DEFINITIONS OF IRP TYPE CODES. + +AIRP: JSP TM,ERMARK ;ERROR MESSAGES SHOULD SAY WE'RE INSIDE IT. + SAVE I + SAVE RDWRDP + HLRZ LINK,B ;GET IRP TYPE CODE TO INDEX BY. + CAIE LINK,NIRPN + JRST AIRP0 + CALL AGETFD ;IRPNC, READ THE 3 NUMERIC ARGS. + SAVE A + CALL AGETFD + SAVE A + CALL AGETFD + MOVEM A,AIRPN2 ;THE LAST ARG, + REST AIRPN1 ;THE MIDDLE, + REST AIRPN0 ;THE FIRST. + MOVEI LINK,NIRPN +AIRP0: SETZM IRPCR ;NO GROUPS SEEN YET. + +;FALLS THROUGH. + +;FALLS THROUGH. + +;TRY TO READ IN ANOTHER GROUP. +AIRP1: CALL PDEF ;READ IN DUMMY NAME, PUSH ON DMYTOP. + CAIE T,", ;TERMINATOR WASN'T COMMA AND NAME WAS NULL + JUMPE SYM,AIRP2 ;=> NO MORE GROUPS. + CALL PDEF ;NONNULL GROUP, READ & PUSH 2ND NAME. + CAIN T,"[ ;] TRY TO DETECT "IRP X,[", ETC. ] + CALL [ETR [ASCIZ/Comma missing in IRP/] + TLO FF,FLUNRD ;GENERATE A COMMA. + RET] + CALL ADDTRN ;PUSH CHAR ADDR OF 1ST DUMMY, + CAIE LINK,NIRPS + CAIN LINK,NIRPC ;LEAVE SPACE FOR IRPC'S 1ST ARG, IRPS'S 2ND. + CALL PUT377 + MOVE A,RDWRDP + CAIN LINK,NIRPS + AOS -1(A) ;IRPS - 1ST ARG GOES AFTER NEXT 377. + CALL ADDTRN ;PUSH CHAR ADDR OF 2ND DUMMY. + CALL PUT377 + MOVE A,RDWRDP + XCT AIRP1T-1(LINK) ;MAYBE INCREMENT THAT ADDR. + AOS IRPCR ;ONE MORE GROUP SEEN. + JSP D,RARG ;INITIALIZE READING LIST. + JRST AIRP3 ;NO LIST. + JRST @.(LINK) + OFFSET 1-. +NIRPO:: AIRPO ;IRP +NIRPC:: AIRPC ;IRPC +NIRPS:: AIRPS ;IRPS +NIRPW:: AIRPW ;IRPW +NIRPN:: AIRPN ;IRPNC + OFFSET 0 + +AIRP1T: AOS -1(A) + AOS -1(A) ;INCR. THE 2ND DUMMY ADDR FOR IRP, IRPC. + SOS -1(A) + JFCL ;DECR. FOR IRPS, NOTHING FOR IRPW. + AOS -1(A) ;INCR. FOR IRPNC. + +;READ LIST FOR IRPC OR IRP AND STUFF INTO STRING. +AIRPC: +AIRPO: CALL RARGCP ;COPY UP TO END OF ARG INTO MACRO SPACE. + JRST AIRP3 + +AIRPW3: CALL PUT377 ;END A LINE, + CAIGE C, + CALL PUT377 ;IF NO ; YET, MAKE NULL 2ND ARG. +;COME HERE FOR IRPW, LOOP BACK FOR NEXT LINE. +AIRPW: SETO C, ;NO ; SEEN YET IN LINE. +AIRPW1: JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST, GO WRITE 375. + CAIE A,^M + CAIN A,^J + JRST AIRPW1 ;IGNORE NULL LINES. +AIRPW4: CAIN A,"; + AOJE C,AIRPW2 ;ON 1ST SEMI, SWITCH TO 2ND ARG. + CAIE A,^J + CAIN A,^M + JRST AIRPW3 ;END OF LINE => END BOTH ARGS, START OVER. +AIRPW5: CALL PUTREL + JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST. + JRST AIRPW4 + +AIRPW2: MOVEI A,377 + JRST AIRPW5 + +AIRPS: SETO C, ;NO SQUOZE CHAR SEEN YET. +AIRPS2: JSP D,RARGCH(T) + JRST AIRP3 + HLRZ CH1,GDTAB(A) + CAIN CH1,(RET) + CAIN A,"! + AOJA C,AIRPS0 ;A SQUOZE CHAR OR !. + JUMPL C,AIRPS2 ;NON SQUOZE FOLLOWING ANOTHER, FLUSH. + DPB A,AIRPSP ;NONSQUOZE ENDING NONNULL SYL, PUT BEFORE SYL. + SETZM AIRPSP + CALL PUT377 ;FOLLOW SYL WITH 377. + JRST AIRPS + +AIRPS0: JUMPN C,AIRPS3 ;NOT 1ST CHAR IN SYL? + SAVE A + CALL PUT377 ;1ST, LEAVE A SPACE FOR THE SYL'S TERMINATOR. + MOVE A,FREPTB + MOVEM A,AIRPSP ;REMEMBER WHERE THE SPACE IS. + REST A +AIRPS3: CALL PUTREL + JRST AIRPS2 + +AIRPN: SKIPG C,AIRPN0 ;ANY CHARS TO IGNORE? + JRST AIRPN4 + JSP D,RARGCH(T) + JRST AIRP3 + SOJG C,.-2 +AIRPN4: SKIPN C,AIRPN2 ;GET MAX # GRPS OF CHARS. + JRST AIRPN7 ;0 => IGNORE THE REST. +AIRPN5: MOVE B,AIRPN1 ;DO NEXT GRP, GET # CHARS/GRP. +AIRPN6: JSP D,RARGCH(T) + JRST AIRP3 + CALL PUTREL ;STORE THE NEXT CHAR. + SOJG B,RARGCH(T) ;COUNT CHARS IN GRP. + MOVEI A,376 + CALL PUTREL ;FOLLOW GRP BY 376. + SOJN C,AIRPN5 ;MAYBE CAN DO MORE GRPS. +AIRPN7: CALL RARFLS ;DID AS MANY GRPS AS CAN DO, + ;IGNORE REMAINDER OF LIST. + +;COME HERE WHEN EXHAUST THE LIST. +AIRP3: CALL STPWR + JRST AIRP1 ;READ ANOTHER GROUP. + +;ALL GROUPS READ IN; NOW READ IN BODY. +AIRP2: CAIE T,"; ;IF A SEMICOLON ENDED THE ARGS, SKIP THE COMMENT. + JRST AIRP4 +AIRP5: CALL RCH + CAIE A,^M + JRST AIRP5 +AIRP4: SAVE LINK + MOVE A,FREEPT ;SAVE CHAR ADDR START OF BODY + MOVEM A,PRIRP ;WHERE GC WILL RELOCATE IT. + PUSHJ P,RCH ;IF NEXT CHAR LF, THEN FLUSH IT + CAIE A,12 + TLO FF,FLUNRD + PUSHJ P,WRQOTE ;READ BODY OF IRP + PUSHJ P,STPWR ;WRITE STOP + PUSHJ P,PUSHEM ;SAVE WORLD + REST LINK + POP P,A ;RESTORE RDWRDP FROM LONG AGO + PUSH P,TOPP ;NOW SAVE TOPP + PUSHJ P,DMYTRN ;ACTIVATE DUMMYS + MOVE B,MACP ;NOW GET MACRO PDL POINTER + MOVE A,CIRPCT ;GET .IRPCNT + HRRM A,(B) ;CLOBBER "RETURN" ON PDL TO OLD IRPCNT + SETOM CIRPCT ;INITIALIZE IRPCNT + MOVS A,IRPCR ;GET # GROUPS + HRR A,PRIRP ;CHAR ADR OF BEGINNING OF BODY + SETZM PRIRP + DPB LINK,[410300,,A] ;PUT IN TYPE OF IRP. + PUSH B,A ;PUSH ,,CHAR ADR BEGINNING + POP P,A ;NOW GET OLD TOPP + HRLS A ;MOVE TO LEFT HALF + HRRI A,AIRR ;RETURN TO AIRR ON END OF BODY + PUSH B,A ;PUSH OLD TOPP,,AIRP4 + MOVEM B,MACP ;STORE BACK UPDATED MACRO PDL POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP RIGHT AWAY TO CAUSE CYCLING + REST I + JRST MACCR + + ;RECYCLE THROUGH IRP + + ;AC ALLOCATIONS: +AIRR: PUSH P,A ;A GETS BP ILDBING THRU ARG LIST. + PUSH P,C ;C # GROUPS LEFT + PUSH P,T ;T ADR OF PAIR OF CHAR ADR'S OF DUMMYS + PUSH P,TT ;TT TYPE OF IRP (NIRPO, NIRPC, ETC) + AOS CIRPCT ;INCREMENT .IRPCNT + HRRZ A,(B) ;GET CHARACTER ADR BEG BODY FROM PDL + PUSHJ P,ACPTRS ;SET UP CPTR + SETOM AIRPT + TRNE FF,FRMRGO + JRST AIRR9 ;RETURN TO .GO + HLRZ T,1(B) ;DUMMY TAB ADR + LDB C,[220600,,(B)] ;# GROUPS + JUMPE C,AIRR9 ;JUMP IF NO GROUPS + LDB TT,[410300,,(B)] ;GET TYPE OF IRP (NIRPO, ETC) +AIRR6: JRST @.+1(TT) +AIRRER ? AIRRO ? AIRRC ? AIRRS ? AIRRW ? AIRRN ? AIRRER ? AIRRER +AIRRER: .VALUE + +;MOVE 1 ARG THRU 1 GROUP OF IRP. +AIRRO: HRRZ A,1(T) ;THE 1ST ARG WILL START THIS TIME + HRRZM A,(T) ;WHERE THE "REST OF STRING" STARTED LAST TIME. + BCOMP A,-1 ;GET BP THAT'LL ILDB THAT CHAR. + SETO CH1, ;COUNT [-] DEPTH. +AIRRO1: ILDB B,A + CAIN B,375 + JRST AIRRO4 ;END OF STRING IS END OF ARG. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIN B,"[ + AOJE CH1,AIRRO3 ;FLUSH OUTERMOST [-] PAIRS. + CAIN B,"] + SOJL CH1,AIRRO3 + JUMPGE CH1,AIRRO1 ;DON'T LOOK FOR , WITHIN [-]. + CAIE B,^J + CAIN B,", + JRST AIRRO2 ;END OF ARG. + CAIE B,^M ;^M IS IGNORED (FLUSHED.) + JRST AIRRO1 +AIRRO3: MOVEI B,376 ;FLUSH A CHAR BY REPLACING WITH 376 + DPB B,A + JRST AIRRO1 + +AIRRC4: SUB P,[1,,1] +AIRRC3: SETZM (T) ;NULLIFY BOTH ARGS PERMANENTLY. +AIRRO4: SETZM 1(T) ;NULLIFY 2ND ARG PERMANENTLY + JRST AIRR8 ;DONE WITH THIS GROUP. + +AIRRO2: MOVEI B,377 ;REPLACE CHAR THAT ENDED ARG WITH TERMINATOR. + DPB B,A +AIRRW3: CCOMP1 A,-1 ;GET ADDR OF CHAR AFTER. + HRRZM B,1(T) ;"REST OF STRING" STARTS THERE. + JRST AIRR8 + +AIRRN: MOVE A,1(T) ;NEW 1ST DUMMY STARTS AT OLD "REST OF STRING". + MOVEM A,(T) + BCOMP A,-1 ;NEW "REST OF STRING" STARTS AFTER 376, + JRST AIRRW2 ;WHICH WILL BECOME A 377. + +AIRRW: MOVE A,1(T) ;GET CHAR ADDR START OF 2ND HALF OF PREV LINE. + CALL AIRRM ;SET 1ST DUMMY -> AFTER NEXT 376 OR 377 . +AIRRW2: ILDB B,A ;MOVE UP TO NEXT 377 OR END OF STRING. + CAIN B,375 ;END OF STRING ENDS 1ST DUMMY'S ARG => + JRST AIRRO4 ;NULLIFY THE 2ND DUMMY. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIGE B,376 + JRST AIRRW2 + JRST AIRRO2 ;SET UP 2ND DUMMY -> NEXT CHAR. + + +;MOVE UP IN 1 GROUP OF IRPS. +AIRRS: MOVE A,(T) ;MOVE FROM 1ST DUMMY, + CALL AIRRM ;PUT 1ST DUMMY AFTER NEXT 377, + AOS (T) ;MOVE IT PAST THE SYL'S TERMINATING CHAR, + ILDB CH1,A ;GET THAT CHAR, + MOVE A,1(T) + JRST AIRRS2 ;STORE AS 2ND DUMMY. + +AIRRM: BCOMP A,-1 ;A HAS CHAR ADDR; WILL ILDB THAT CHAR. +AIRRM1: ILDB B,A + CAIN B,375 ;END OF STRING => NULLIFY BOTH ARGS + JRST AIRRC4 ;AND FINISHED WITH GROUP. + CAIE B,377 + JRST AIRRM1 + MOVE CH1,A + CCOMP1 CH1,-1 ;GET CHAR ADDR OF CHAR AFTER 377 + MOVEM CH2,(T) ;PUT 1ST DUMMY THERE. + RET ;NOTE A NOT CLOBBERED, CAN GO ON ILDB'ING. + +;MOVE UP IN ONE GROUP OF IRPC. +AIRRC: AOS A,1(T) ;DELETE 1ST CHAR FROM "REST OF STRING". + BCOMP A,-1 ;GET BP -> THAT CHAR. + LDB CH1,A ;GET THE CHAR. + MOVE A,(T) ;GET CHAR ADDR OF PLACE TO PUT IT. +AIRRS2: CAIN CH1,375 ;REACHED END OF STRING => + JRST AIRRC3 ;NULLIFY BOTH ARGS. + BCOMP A,0 + DPB CH1,A ;STORE IT IN THE 1-CHAR ARG. +AIRR7: SETZM AIRPT ;THIS GROUP NOT EXHAUSTED YET. +AIRR8: ADDI T,2 + SOJG C,AIRR6 ;MORE GROUPS => DO THE NEXT. +AIRR9: POP P,TT ;RETURN FROM AAIRPC + POP P,T + SKIPL AIRPT + JRST REPT3 + MOVN A,[2,,2] ;ARGS EXHAUSTED, RETURN + ADDB A,MACP + HRRZ A,(A) + MOVEM A,CIRPCT + POP P,C + POP P,A + JRST RCHSAV + +;IRP ARG-STRING READING COROUTINES: CALL WITH JSP D, +;INITIALIZE FOR READIN OF ARG BUT DON'T GET A CHAR. +;SKIPS IF NONNULL ARG AVAILABLE. +;COROUTINES REMEMBER INFO IN T AND TT BETWEEN CALLS. +;THE CALLER SHOULDN'T CLOBBER THEM. +RARG: CALL RCH ;DECIDE WHAT TYPE OF ARG FOLLOWS, IF ANY. + CAIN A,LBRKT ;RARG ALLOWS [-] AND MAYBE {-} ARGS AS WELL AS SIMPLE ONES. + JRST RARGBR +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + TLO FF,FLUNRD + JSP T,RARGXT ;CAUSE FAILURE RETURN ON SEMI, CR, LF. +RARGN: CALL RCH ;RARGCH RTN FOR NORMAL ARG. +RARGX1: CAIN A,", + JRST (D) ;COMMA ENDS ARG. +RARGXT: CAIN A,"; + JRST RARGSM ;SEMI ENDS SCAN. +RARGX2: CAIE A,^M + CAIN A,^J ;CR, LF END SCAN. +RARGSM: TLOA FF,FLUNRD + JRST 1(D) + JRST (D) + +RARGBR: SETZ TT, ;TT USED AS BRACKET COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR [-] TYPE ARGS. +RARGBC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRKT + AOJA TT,1(D) + CAIN A,RBRKT + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACKET. + +RARGRR: SETZ TT, ;TT USED AS BRACE COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR {-} TYPE ARGS. +RARGRC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRACE + AOJA TT,1(D) + CAIN A,RBRACE + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACE. + +;TO GET THE NEXT CHAR OF THE ARG IN A, DO JSP D,RARGCH(T). +;SKIPS UNLESS NO MORE CHARS TO GET. +;NO SKIP AND SET => SCAN SHOULD BE TERMINATED. +;RARG SHOULD NOT BE CALLED AGAIN IN THAT CASE. +RARGCH==0 ;THIS SYMBOL IS FOR CREF'S SAKE. + +;COPY THE ARG BEING READ INTO MACRO SPACE. +;ON RETURN, A WILL HOLD "; IF ARGUMENT WAS ENDED BY ";". +RARGCP: JSP D,RARGCH(T) + JRST RARGC1 + CALL PUTREL + JRST RARGCH(T) + +RARGC1: CAIE A,"; ;IF SEMI ENDED THE ARG, FLUSH THE + RET ;SPACES AND TABS BEFORE IT. +RARGC2: LDB A,FREPTB + CAIN A,^I + JRST RARGC3 + CAIE A,40 + JRST [ MOVEI A,"; ;LAST CHAR OF ARG ISN'T SP OR TAB. + RET] ;MAKE SURE A HAS ";" IF ARG WAS ENDED BY ";". +RARGC3: SOS FREEPT ;IT IS ONE; BACK OVER IT. + MOVE A,FREPTB + DBPM A + MOVEM A,FREPTB + JRST RARGC2 + +;IGNORE THE REST OF THE ARG NOW BEING READ. +RARFLS: JSP D,RARGCH(T) + RET + JRST RARGCH(T) + +;COME HERE TO SET UP TO READ A BALANCED ARG. +;IF THERE'S NO ARG, RETURNS WOTH JRST (D). +;ELSE RETURNS WITH JRST 1(D) SETTING UNRCHF. +RARB: TLO FF,FLUNRD + SETZ TT, ;TT USED AS BRACKET COUNTER. + CAIE A,RBRACE + CAIN A,") ;IF 1ST CHAR IS A CLOSE, + JRST RARB4 ;THERE'S NO ARG. + CAIE A,"> + CAIN A,RBRKT + JRST RARB4 + JSP T,RARGXT ;CHECK FOR CR, LF, SEMI, AND RETURN. +;1-CHAR RTN FOR READING BALANCED ARG. +RARBC: CALL RCH + CAIE A,RBRACE + CAIN A,"> ;FOR CLOSES, MAYBE END ARG. + JRST RARB2 + CAIE A,") + CAIN A,RBRKT + JRST RARB2 + CAIE A,LBRACE + CAIN A,"< ;FOR OPEN BRACKETS, INCR. THE COUNT. + AOJA TT,1(D) ;OPENS CAN'T END THE ARG. + CAIE A,"( + CAIN A,LBRKT + AOJA TT,1(D) + JUMPN TT,1(D) + JRST RARGX1 ;NOT WITHIN BRACKETS, TEST FOR COMMA, ETC. + +RARB2: SOJGE TT,1(D) ;COME HERE FOR CLOSEBRKTS. +RARB4: TLO FF,FLUNRD + JRST (D) + +;COME HERE TO INIT FOR AN ARG FOR REPEAT, ETC. +;THAT IS, EITHER A BRACKETED ARG OR A 1-LINE ARG. +RARL1: CALL RCH +RARL2: +IFN BRCFLG,[ +RARL4: CAIN A,LBRACE + JRST RARGRR ;1ST CHAR A BRACE => BRACED ARG. +] + CAIN A,LBRKT ;1ST CHAR A BRKT => BRKT ARG. + JRST RARGBR + TLO FF,FLUNRD + +;INIT FOR A 1-LINE ARG. +RARL: JSP T,1(D) +;1-CHAR RTN FOR 1-LINE ARGS. +RARLC: CALL RCH + JRST RARGX2 + +IFE BRCFLG,[ +;IF BRACES AREN'T USED BY MOST THINGS, THE NORMAL ROUTINE RARL1 DOESN'T +;CHECK FOR THEM, BUT RALR4 (CALLED BY CONDITIONALS) STILL MUST. +RARL4: CAIN A,LBRACE + JRST RARGRR + JRST RARL2 +] + +;1-LINE ARGS TO MACROS: DON'T TERMINATE THE SPEC, +;AND SKIP OVER THE CR AND LF. +RARL3: TLO FF,FLUNRD + JSP T,1(D) + CALL RCH + CAIN A,^J + JRST (D) ;LF IS THE END - SKIP IT. + CAIE A,^M + JRST 1(D) + CALL RCH ;CR => SKIP FOLLOWING LF, END ARG. + CAIE A,^J + TLO FF,FLUNRD + JRST (D) + + ;PUSHJ P,A.GST SEARCH CURRENT MACRO STRING FOR TAG (IN A.GST4) + ;SKIP IF FOUND, RETURN ON END OF STRING ANYWAY + ;BYTE POINTER (ILDB TO GET FIRST CHARACTER) IN A + +A.GST: MOVEM A,A.GST3 ;SAVE BYTE POINTER +A.GST1: ILDB B,A.GST3 ;GET CHAR + CAIL B,300 + POPJ P, ;END OF STRING => STOP + CAIE B,". + JRST A.GST1 ;WAIT FOR POINT + PUSHJ P,A.GSYL ;FOUND POINT, GET REST OF NAME + JUMPL T,CPOPJ ;RETURN ON END OF STRING + CAME SYM,[SQUOZE 0,TAG] ;TAG? + JRST A.GST1 ;NO, KEEP GOING + PUSHJ P,A.GSYL ;GET THE TAG + JUMPL T,CPOPJ ;RETURN ON END OF STRING (THERE MUST BE BREAK CHAR AFTER TAG BEFORE STOP) + CAME SYM,A.GST4 + JRST A.GST1 ;NOT THE ONE BEING LOOKED FOR + MOVE A,A.GST3 + LDB B,A ;GET DELIMITER + CAIE B,15 ;CR? + JRST POPJ1 + ILDB B,A ;CR, GET NEXT CHAR + CAIE B,12 ;LINE FEED? + MOVE A,A.GST3 ;NO, DON'T FLUSH + JRST POPJ1 + + ;LOOK BACKWARD FOR BEGINNING OF STRING, BYTE POINTER AN A + ;LEAVES POINTER POINTING AT STOP CHAR (NOT BEFORE); ALSO LEAVES STOP CHAR IN B + +AG.SP: MOVE B,(A) ;GET WORD FROM MACTAB + XOR B,[300_28.+300_20.+300_12.+300_4] ;DO XOR TO ANITIALLY SET UP + LDB CH1,[400400,,A] ;PICK UP 4 HIGH ORDER BITS OF POSITION FIELD + JRST A.GSP2-1(CH1) ;DISPATCH ON POSITION FIELD (-1 SINCE BIT SET IN POSITION FIELD) + +AG.SP3: MOVE B,(A) + XOR B,[300_28.+300_20.+300_12.+300_4] + +A.GSP2: TRNN B,300_4 + JSP CH1,AG.SF + TLNN B,3 + JSP CH1,AG.SF + TLNN B,300_2 + JSP CH1,AG.SF + TLNN B,300_10. + JSP CH1,AG.SF + SOJA A,AG.SP3 + +AG.SF: SUBI CH1,A.GSP2-1 ;GET HERE WHEN STOP CHAR FOUND + DPB CH1,[400400,,A] ;CLOBBER POSITION FIELD OF BYTE POINTER AGAIN + ILDB B,A ;INCREMENT TO UNIVERSALLY ACCEPTABLE POINTER, GETTING STOP CHAR IN B AT SAME TIME + POPJ P, ;THAT'S ALL + +A.TAG: PUSHJ P,GSYL + CAIE T,15 + JRST MACCR + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD + JRST MACCR + +A.GO: PUSHJ P,GSYL ;DOESN'T WORK RELIABLY FROM DUMMY + MOVEM SYM,A.GST4 + +A.GO1: TLNN FF,FLMAC + JRST MACCR ;NOT GETTING CHARS FROM MACRO => STOP + MOVE A,CPTR + PUSHJ P,AG.SP ;BACK TO BEGINNING + CAIN B,374 + JRST A.GOMC ;MACRO, SKIP PAST HEADER +A.GORT: PUSHJ P,A.GST + JRST A.GO2 ;END OF STRING, TRY POPPING UP ONE + MOVEM A,CPTR + JRST MACCR + +A.GO2: PUSHJ P,PMACP + JRST A.GO1 + +A.GSYL: MOVNI D,100000 ;GET SYL FOR .GO WHILE LOOKING FOR TAG + MOVEM D,STRCNT ;STRCNT .LT. 0 SIGNAL FOR GSYL TO JRST (F) + MOVEI SYM,0 + JSP F,GSYL1 +A.GSY3: ILDB A,A.GST3 ;GET CHAR + TRZN A,200 ;CHECK FOR SPECIAL + JRST A.GSY2 ;NO, FALL BACK IN + CAIG A,100 ;BIG ENOUGH TO BE SPECIAL? + JRST A.GSY3 ;NO, MUST BE DUMMY, IGNORE + HRROI T,(A) ;SPECIAL => ASSUME STOP: T .LT. 0 SIGNAL TO CALLING ROUTINE + POPJ P, ;RETURN TO CALLING ROUTINE + + ;INITIALIZE MACRO STATUS + +MACINI: MOVEI A,3 + MOVEM A,FREEPT ;FORGET ALL STRINGS IN MACTAB + PUSHJ P,FCOMP + MOVE A,MACTAD + HRLI A,41000 ;SET UP CCOMPB THRU CCOMPE + LSH A,2 ;(THEIR VALUES CAN'T BE ASSEMBLED IN BECAUSE + SUBI A,4 ;THEY ARE MUTLTIPLY RELOCATABLE, AND IN DEC + MOVSI AA,CCOMPB-CCOMPE ;VERSION THAT CAN'T BE DONE) +MACIN0: MOVEM A,CCOMPB(AA) + AOJ A, + AOBJN AA,MACIN0 + MOVE A,MACTAD + ADDI A,MACL+1777 + ANDI A,-2000 ;ADDR OF 1ST WD AFTER MACTAB. + CALL MACIN2 ;SET UP PTRS TO END OF MACTAB. + SETZM GCCNT ;CLEAR OUT GC COUNT SO WILL GET MORE CORE FIRST THREE +MACIN1: SETZM MDEPTH ;NOW INITIALIZE MACRO EXPANSION STATUS + SETZM PRSTG ;NOW TO CLEAR OUT BYTE POINTERS + MOVE A,[PRSTG,,PRSTG+1] + BLT A,EPRSTT-1 + MOVEI A,DSTG + MOVEM A,RDWRDP + MOVEI A,DMYAGT + MOVEM A,TOPP + MOVEM A,BBASE + MOVE A,[-MPDLL,,MACPDL] + MOVEM A,MACP + POPJ P, + +;A -> 1ST WD AFTER MACTAB, SET UP ALL POINTERS TO END OF MACTAB. +MACIN2: MOVEM A,MACTND + SUB A,MACTAD + LSH A,2 ;1ST BYTE MACTAB DOESN'T HAVE. + MOVEM A,MACHI + SUBI A,MACRUM*4 + MOVEM A,GCRDHI + MOVE A,STOPPT + HRR A,MACTND + SOS A ;LAST WD IN MACTAB. + MOVEM A,MACHIB ;INITIALIZE BYTE POINTER TO HIGHEST BYTE OK TO FILL + RET + + ;MACRO VARIABLE AREA (MOST THEREOF) + +VBLK +MACP: 0 ;MAC PDL POINTER +BLCODE [MACPDL: BLOCK MPDLL+1] ;MACRO PDL +FREEPT: 0 ;MACRO STG PNTR POINTS TO FREE CHAR +FREPTB: 0 ;FREEPT IN BYTE POINTER FORM +MACTAD: MACTBA ;ADDR OF START OF MACRO TABLE. +MACTND: 0 ;ADDR OF 1ST WD AFTER MACTAB. +MACHI: 0 ;CHAR ADR ONE ABOVE ACTIVE MACTAB +MACHIB: 0 ;POINTS TO LAST BYTE IN MACTAB + +SCONDF: 0 ;STRING CONDITIONAL FLAG, -1 => IDENTICAL, 0 DIFFERENT +GENSM: 0 ;GENERATED SYM COUNT +DEFNPS: 0 ;NONZERO => NAME OF PSEUDO NOW READING ITS ARG. + ;A FATAL ERROR WILL TYPE THE PSEUDO'S NAME. +DEFNPN: 0 ;PAGE # -1 OF THAT PSEUDO. ALSO TYPED BY FATAL ERRORS. +DEFNLN: 0 ;LINE # -1. +DEFNFI: 0 ;SIXBIT FN1 OF FILE CONTAINING PSEUDO THAT DEFNPS REFERS TO. +MDEPTH: 0 ;DEPTH IN MACRO (NOT IRP OR REPEAT) EXPANSIONS +PUTCNT: 0 ;AOS'D BY PUTREL, USED BY CALLING ROUTINE, USUALLY TO COUNT ACTIVE CHARS (DURING DEFINITION) +IRPCR: 0 ;COUNT OF A,B,[LIST] GROUPS IN IRP IRPC IRPS, " " " +AIRPT: 0 ;IRP EXPANSION TEMP, -1 => NO NON-NULL DUMMYS YET, ELSE 0 +AIRPN0: 0 ;1ST NUMERIC ARG TO IRPNC +AIRPN1: 0 ;2ND, +AIRPN2: 0 ;3RD. +A.QOT2: 0 ;DELIMITER FOR .QUOTE +CRPTCT: -1 ;COUNT THROUGH CURRENT REPEAT (FOR .RPCNT) +CIRPCT: -1 ;COUNT THOUGH CURRENT IRP (FOR .IRPCNT) +A.GST3: 0 ;ON .GO, NAME (IN SQUOZE) OF TAG BEING SEARCHED FOR +A.GST4: 0 ;BYTE POINTER FOR ILDB WHILE SEARCHING FOR TAG +PRCALP: PRCAL-1 ;POINTER INTO PRCALP, POINTS TO LAST ACTIVE ENTRY + +PRSTG: ;BEGIN WORDS GARBAGE COLLECTED: FIRST BYTE POINTERS ILDB'D + +CPTR: 0 ;ILDB TO GET NEXT CHAR FROM MACRO OR WHATEVER +IFE WRQTSW-1,WRQTBP: 0 ;POINTS TO LAST CHAR BEFORE CURRENT SYL AT WRQOTE +AIRPSP: 0 ;-> PLACE TO STORE SYL-TERMINATOR, IN IRPS READIN. +GCBPL==.-PRSTG ;END BYTE POINTERS, BEGIN CHARACTER ADDRESSES +PRSCND: 0 ;CHARACTER ADDRESS OF CURRENT LOCATION IN FIRST STRING OF IFSE,IFSN WHILE COMPARING WITH SECOND +PRSCN1: 0 ;CHAR ADR BEG OF FIRST STRING IFSE, IFSN +PRREPT: 0 ;CHAR ADR BEG OF BODY OF REPT +PRIRP: 0 ;CHAR ADR BEG OF IRP BODY +PRDEF: 0 ;CHAR ADR BEG OF MACRO BEING DEFINED +PRCAL: REPEAT 10,0 ;TEMP STORAGE FOR CHAR ADR BEG MACRO BODY, USED TO READ DUMMY SPECS +EPRSTT: ;END CHAR ADR WORDS GARBAGE COLLECTED + + ;BEGIN GARBAGE COLLECTOR VARIABLES + +GCCNT: 0 ;CNT OF GC'S +SYMSTR: 0 ;PNTR TO CHAIN OF MACRO PNTRS IN SYM TABLE (DURING GC), LINKED THROUGH RH'S OF "VALUE" +REDPT: 0 ;CHAR ADR READING FROM WHEN MOVING STRING DOWN +REDPTB: 0 ;REDPT IN BYTE POINTER FORM + ;GC WRITES WITH FREEPT/FREPTB +COFST: 0 ;AMOUNT CHARS MOVED DOWN BY, SUBTRACTED FROM CHAR ADR TO RELOCATE +SVF: 0 ;FLAG, .GE. 0 => NO POINTERS FOUND POINTING TO CURRENT STRING +FREPTS: 0 ;-> BEGINNING OF CURRENT STRING BEING COPIED DOWN +FRPTBS: 0 ;FREPTS IN BYTE POINTER FORM +GCENDF: 0 ;-1 => END OF LAST STRING FOUND, AFTER RELOCATING POINTERS, MSTG2 SHOULD EXIT +GCHI: 0 ;GC HIGH POINTER, CHAR ADR FIRST NOT TO GARBAGE COLLECT +GCRDHI: *4 ;GC DROPS DEAD (MACTAB FULL) IFWRITING INTO THIS CHAR ADR +BLCODE [GCSV: BLOCK 16] ;AC SAVE AREA FOR GC +PBLK + + ;GARBAGE COLLECT THE MACRO TABLE + +GCA1: MOVE A,FREEPT ;GC ALL IN MACTAB. +GCA: MOVEM A,GCHI ;ENTRY TO STORE A IN GCHI -> FIRST CHAR NOT TO GARBAGE COLLECT +GC: MOVEM 17,GCSV+15 + MOVE 17,[2,,GCSV] + BLT 17,GCSV+14 +IFN TS,[AOS A,GCCNT + CAIGE A,4 + PUSHJ P,GCCORQ ;EXPAND CORE ON FIRST THREE GC'S +] CLEARB T,GCENDF + MOVEI A,3 + MOVEM A,REDPT ;SET UP FOR READING + MOVEM A,FREEPT ;ALSO FOR WRITING + MOVE A,BCOMPU ;ALSO SET UP CORRESPINDING BYTE POINTERS + MOVEM A,FREPTB + MOVEM A,REDPTB + MOVE C,[-GCBPL,,PRSTG] +GCLP1: SKIPN B,(C) ;NOW CONVERT BYTE POINTERS... + JRST GCLP1B ;(INACTIVE) + CCOMP B,-1 ;TO CHARACTER ADDRESSES + MOVEM B,(C) ;STORE BACK CHARACTER ADDRESS +GCLP1B: AOBJN C,GCLP1 ;LOOP FOR ALL SUCH BYTE POINTERS + MOVE A,SYMAOB ;NOW SET UP MACRO LIST; T INITIALLY HAS 0 => END OF LIST DURING COMPUTATION +SYMMG: ;POINTS TO FIRST MACRO SYMTAB ENTRY ON LIST + LDB B,[400400,,ST(A)] ;GET SQUOZE FLAGS THIS SYM + CAIN B,PSUDO_-14. ;PSEUDO? (=> MAYBE MACRO) + JRST SYMMG1 ;YES, MAYBE PUT ON LIST (RETURNS TO SYMMG2) +SYMMG2: ADD A,WPSTE1 + AOBJN A,SYMMG ;LOOP FOR ENTIRE SYMTAB + MOVEM T,SYMSTR ;STORE INITIAL LIST ENTRY FOR MACROS + ;DROPS THROUGH + ;GC DEALS WITH "UNIT STRINGS", EACH STRING ENDS WITH 375 + ;GENERAL PROCEDURE IS TO COPY A STRING DOWN THEN SEARCH FOR POINTERS TO WHERE STRING USED TO BE + ;IF POINTERS FOUND THEY ARE RELOCATED TO POINT TO COPIED DOWN STRING + ;IF POINTERS ARE NOT FOUND THE STRING IS WIPED OUT + ;DROPS THROUGH + +MSTG: MOVE C,REDPT ;SET UP C TO POINT TO BEG OF STRING BEING READ + ;(FOR EVENTUALLY SEARCHING FOR POINTERS TO STRING, NOTE C STAYS AROUND FOR AWHILE) + MOVE TT,FREEPT + MOVEM TT,FREPTS ;-> BEGINNING OF WRITTEN STRING + MOVE TT,FREPTB + MOVEM TT,FRPTBS ;BYTE POINTER -> BEGINNING OF WRITTEN STRING + PUSHJ P,RDTRNS ;COPY CHARACTER + CAIN B,370 + JRST MSTGB ;THAT WAS NO STRING, THAT WAS MY IO-BUFFER! + MOVE TT,B ;SAVE CHARACTER JUST COPIED +MSTG1: CAML LINK,GCHI + JRST GCEND ;JUST READ LAST CHAR IN PART OF MACTAB TO GARBAGE COLLECT => DONE + CAIN B,375 + JRST MSTG2 ;END THIS STRING, NOW SEARCH FOR POINTERS, RETURNS TO MSTG + PUSHJ P,RDTRNS ;STRING NOT EXHAUSTED, COPY NEXT CHAR + JRST MSTG1 + +SYMMG1: HRRZ B,ST+1(A) ;PSEUDO FOUND IN SYMTAB, GET "VALUE" + CAIE B,MACCL ;MACCL? (=> MACRO, CHAR ADR OF BODY IN LH) + JRST SYMMG2 ;NO, JUST FALL BACK INTO LOOP + HRRM T,ST+1(A) ;MACRO, REPLACE MACCL PART OF VALUE WITH POINTER TO NEXT + MOVEI T,ST+1(A) ;UPDATE T (INITIAL LIST ENTRY) TO POINT TO WORD JUST CLOBBERED + PUSH P,A + HLRZ A,ST+1(A) + PUSHJ P,REDINC + CAIE B,374 + HALT + POP P,A + JRST SYMMG2 + + ;COPY CHARACTER DOWN (REDPTB -> FREPTB) + ;LEAVE INCREMENTED REDPT IN LINK, FREEPT IN A, CHAR IN B + +RDTRNS: ILDB B,REDPTB + IDPB B,FREPTB + AOS LINK,REDPT + AOS A,FREEPT + POPJ P, + +MSTGB: ADDI A,3 ;COPY AN IO-BUFFER: + TRZ A,3 + MOVEM A,FREEPT ;WRITE INTO WORD BOUNDARY. + ADDI LINK,3 + TRZ LINK,3 + MOVEM LINK,REDPT ;READ FROM WORD BOUNDARY. + MOVEI B,041000 + HRLM B,REDPTB + HRLM B,FREPTB + MOVE B,FREPTB + MOVE A,REDPTB + ADDI B,1 ;NEW ADDR OF 1ST WD. + HRRZ LINK,1(A) ;GET ADDR OF POINTER TO STRING. + MOVEM LINK,SVF ;REMEMBER WHETHER TO FLUSH STRING. + SKIPE LINK + HRRM B,(LINK) ;RELOCATE THAT POINTER (IF ANY) + HRLI B,1(A) ;SET UP AC FOR BLT. + HLRZ LINK,1(A) ;GET LENGTH OF STRING. + ADDM LINK,REDPTB + LSH LINK,2 + ADDM LINK,FREEPT + ADDM LINK,REDPT + LSH LINK,-2 + ADDB LINK,FREPTB + BLT B,(LINK) + MOVE LINK,REDPT + CAML LINK,GCHI ;IF THIS IO-BUFFER IS LAST THING IN MACRO SPACE, + SETOM GCENDF ;DON'T LOOK FOR ANYTHING FOLLOWING IT. + JRST MSTGB1 ;NOW MAYBE FLUSH THIS STRING, COPY NEXT. + + ;GET HERE WHEN MSTG2 FINISHES WITH FLAG SET TO EXIT: UNDO INITIALIZATION AND RETURN + +GCEND1: IFN TS,[ + MOVE A,FREEPT + ADDI A,2000*4 + CAML A,MACHI + PUSHJ P,GCCORQ +] MOVE A,FREEPT + CAML A,GCRDHI + ETF [ASCIZ /Macro space full/] + SKIPN T,SYMSTR + JRST USYMG1 ;EMPTY LIST + MOVEI C,MACCL ;SET UP C FOR HRRM'ING +USYMG: HRRZ TT,(T) ;GET ADR ON LIST + HRRM C,(T) ;CLOBBER RH JUST GOT NEXT POINTER FROM TO MACCL + HLRZ A,(T) + PUSHJ P,REDINC + CAIE B,374 + HALT + SKIPE T,TT ;MAKE NEXT POINTER CURRENT, SKIP IF END OF LIST + JRST USYMG + +USYMG1: MOVE C,[-GCBPL,,PRSTG] +GCLP2: MOVE A,(C) ;NOW CONVERT CHARACTER ADDRESSES... + BCOMP A,-1 ;BACK TO BYTE POINTERS + MOVEM A,(C) + AOBJN C,GCLP2 + MOVS 17,[2,,GCSV] + BLT 17,17 + POPJ P, ;EXIT FROM GARBAGE COLLECTOR + + ;GC ROUTINE TO SCAN TABLE AREA FOR POINTERS TO CURRENT STRING + ;CH1 -> BEGINNING OF TABLE, 4.9 => LOOK AT PAIRS SKIPPING SECOND OF EACH PAIR + ;T POINTS TO LAST WORD IN TABLE + 1 + ;RELOCATE POINTERS IN TABLE POINTED TO + ;C POINTS TO BEGINNING OF STRING, B -> END + 1 + +MSCN: CAIG T,(CH1) + POPJ P, ;TABLE EXHAUSTED + HRRZ TT,-1(T) ;GET LAST ENTRY IN TABLE (UPPER POINTER UPDATED TO COUNT DOWN) + CAML TT,C + CAML TT,B + JRST MSCN1 ;DOESN'T POINT TO CURRENT STRING + SUB TT,COFST ;POINTS TO STRING, RELOCATE + HRRM TT,-1(T) ;STORE BACK RELOCATED POINTER + SETOM SVF ;SET FLAG TO SAVE STRING +MSCN1: SKIPGE CH1 + SOS T ;CH1 NEGATIVE => SKIP A WORD + SOJA T,MSCN + +GCEND: SETOM GCENDF ;DONE READING FROM MACTAB, BUT FIRST HAVE TO RELOCATE POINTERS TO LAST STRING +MSTG2: CLEARM SVF ;NO POINTERS FOUND TO STRING YET + MOVE D,REDPT + SUB D,FREEPT + MOVEM D,COFST ;STORE AMOUNT CHARS COPIED DOWN BY FOR CHAR ADR RELOCATION + MOVE B,REDPT + CAIE TT,374 + JRST MSTG3 ;NOT A MACRO + MOVE T,SYMSTR + JUMPE T,MSTG3 ;JUMP IF NO MACROS ON LIST +MSTG5: HLRZ TT,(T) ;GET CHAR ADR THIS MACRO + CAML TT,C ;SKIP IF POINTS BELOW BEGINNING THIS STRING + CAML TT,B ;SKIP UNLESS POINTS TO OR ABOVE FIRST CHAR NOT YET READ + JRST MSTG4 ;DOESN'T POINT TO THIS STRING + SETOM SVF ;POINTS TO THIS STRING, SET FLAG TO SAVE STRING + SUB TT,COFST ;RELOCATE + HRLM TT,(T) ;STORE BACK UPDATED CHAR ADR THIS MACRO +MSTG4: HRRZ T,(T) ;NOW GET POINTER TO NEXT MACRO + JUMPN T,MSTG5 ;LOOP FOR ALL MACROS ON LIST + +MSTG3: MOVE T,TOPP + MOVEI CH1,DMYAGT + PUSHJ P,MSCN ;RELOCATE POINTERS IN DUMMY ARG TABLE + HRRZ T,MACP + HRROI CH1,MACPDL + PUSHJ P,MSCN ;RELOCATE POINTERS IN MACRO PDL + HRRZ T,PRCALP + AOS T + MOVEI CH1,PRSTG + PUSHJ P,MSCN ;RELOCATE POINTERS IN PRSTG + HRRZ T,RDWRDP + MOVEI CH1,DSTG + PUSHJ P,MSCN ;RELOCATE DUMMY ARGS READ (OR BEING READ) IN BUT NOT YET ACTIVATED + SKIPGE GCENDF + JRST GCEND1 ;EXIT +MSTGB1: SKIPE SVF + JRST MSTGB2 ;FOUND POINTERS TO THIS STRING, DON'T FLUSH + MOVE TT,FREPTS ;NO POINTERS FOUND, FLUSH STRING + MOVEM TT,FREEPT + MOVE TT,FRPTBS + MOVEM TT,FREPTB +MSTGB2: SKIPGE GCENDF ;IF WE JUST HACKED AN I-O BUFFER, MAYBE IT'S THE LAST + JRST GCEND1 ;THING IN MACRO SPACE. + JRST MSTG + +] ;END MACSW CONDITIONAL (AND MACRO PROCESSOR ROUTINES) + +IFN .I.FSW,[ ;;.I.F ;ALGEBRAIC COMPILER ROUTINE +; 'ALGEBRAIC' CRUFT MARO DEFINITIONS + +DEFINE MOAN ARG/ + MOVEI D,[SIXBIT /ARG!!/] + JRST ERRCON +TERMIN + +DEFINE RETLIN + MOVEI A,15 ;CARRIAGE RETURN + PUSHJ P,PUTREL + MOVEI A,12 ;LINE FEED + PUSHJ P,PUTREL +TERMIN + +DEFINE NUMBER + MOVE A,BTPNT + ILDB I,A + CAIE I,"# + CAIGE I,"@ +TERMIN + +DEFINE RESTOR + MOVE D,BTPNT + SETZM STRING + SETZM STRING+1 + SETZM STRING+2 +TERMIN + + +DEFINE SPECN + POP P,RANDM + MOVE A,ENN + SUB A,RANDM + MOVEM A,ENN +TERMIN + +DEFINE GET + EXCH I,ACSAV+1 + PUSHJ P,RCH + EXCH I,ACSAV+1 +TERMIN + +DEFINE GETT + EXCH I,ACSAV+1 + PUSHJ P,RCH + EXCH I,ACSAV+1 + IDPB A,TPN +TERMIN + +; START OF COMPILER PROPER + +OPDL: CH?CH?CH?CH?CH?CH?CH?CH ;COMMUTATOR + CH?SP?CH?CH?CH?CR?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + SP?CH?CH?CH?DL?CH?CH?CH + LP?RP?TX?PL?CM?MN?CH?DV + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?KL?LB?EQ?RB?CH + +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?UP?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH + +VBLK + +ENN: 60 ;ACCUMULATOR NUMBER - TROUBLE IF GOES PAST 9 + +BTPNT: 440700,,STRING ;D +STRING: BLOCK 10 ;CHARACTER ASSEMBLY (D) - TROUBLE IF OVERFLOWS + +TPN: 0 +DIRPNT: 440700,,DIROUT ;TPN +DIROUT: BLOCK 40 ;COPY OF LINE IN PROGRESS (TPN) - TROUBLE IF OVERFLOWS + +OPSTKL==40 + 0 +OPSTK: BLOCK OPSTKL ;OPERATOR STACK (R) - TROUBLE IF OVERFLOWS + 0 + + + +ENDSTT: 0 ;ON IF END OF STATEMENT ENCOUNTERED +CHARF: 0 ;LAST WAS NOT OPERATOR +NUMFL: 0 ;STRING IS NUMERIC CONSTANT (NEEDS [ AND ]) +R1SV: 0 ;SAVED A +R2SV: 0 ;SAVED I, CALLED V EARLIER ON + +INTEGR: 0 ;INTEGER ARITHMETIC +WARN: 0 ;ON AFTER ) TO STOP NON-OPERATOR +RANDM: 0 ;DUMP COMMA COUNT HERE +ACSAV: BLOCK 7 +TEMP: 440600,,(D) ;INDIRECT VIA D +BYTPNT: 0 +PBLK + +; ENTRANCE TO 'ALGEBRAIC' TRANSLATOR + +A.I: SETOM INTEGR + SKIPA +A.F: SETZM INTEGR + PUSHJ P,SWINI ;INITIALISE PASSAGE TO MIDAS ASSEMBLER + MOVE TM,[P,,ACSAV] + BLT TM,ACSAV+6 + SETZM ENDSTT ;RESET END OF STMNT FLAG + SETZM EQHIT' ;RESET LAST CHAR WAS= FLAG + SETZM WARN ;SET OFF ERROR DETECTOR + MOVEI A,"0 ;INITIALISE POINTERS + MOVEM A,ENN + MOVE A,DIRPNT + MOVEM A,TPN ;POINTER TO SAVED INPUT + MOVE SYM,[-OPSTKL,,OPSTK] + PUSH SYM,[0,,ENDSAT] + PUSH P,[0] ;INITIALISE COMMA-COUNTER + SETZM CHARF +CLSTR: RESTOR +RDITTS: SKIPE ENDSTT + JRST BDEND +RDITA: GETT + CAIGE A,100 ;FOR ABBREVIATED DISPATCH TABLE + JRST @OPDL(A) + CAIN A,"\ + JRST AB + CAIN A,"^ + JRST UP + +CH: SETZM EQHIT + SKIPE WARN + JRST CHBRT +CHEY: IDPB A,D + SETOM CHARF ;NON UNARY FLAG + JRST RDITA + +GAMB: RESTOR +COMMT: MOVE I,R2SV + JRST GOPURT + +SHORT: ;DECIDES IF STRING CAN BE USED IN IMMEDIATE TYPE OPS + SETZM IMMED' + SKIPN STRING + POPJ P, ;NO STRING + MOVE A,BTPNT + ILDB I,A + CAIN I,"# + JRST APUPJ ;YEPE HE ASKED FOR IT + SKIPE STRING+1 + POPJ P, ;STRING IS LONG + SKIPA + +TSTSHL: ILDB I,A + JUMPE I,APUPJ ;ITS OK FOUND ONLY NUMBERS + CAILE I,"@ + POPJ P, ;NON-NUMBER IN STRING + CAIE I,". + JRST TSTSHL + ILDB I,A + SKIPN I ;ANYTHING FOLLOW '.' QST +APUPJ: SETOM IMMED' ;INDICATE IMMEDIATE USAGE IS POSSIBLE + POPJ P, + +SZPRT: SETZM CHARF +GOPRT: SETZM WARN +GOPART: MOVEM I,R2SV +GOPURT: HLRZ B,I + HLRZ C,(SYM) + CAMLE B,C + JRST PSOPR ;GO PUSH OPERATOR + SKIPN INTEGR + SETOM IMMED ;FOR ARITH OPS ONLY FIXED WILL DO IMMEDIATE + PUSHJ P,SHORT ;ESTABLISH IF STRING CAN BE IMMEDIFIED + POP SYM,A ;POP AN OPERATOR + JUMPN A,(A) + + MOAN OVERPOPPED OPERATOR STACK + +CHEX: MOVE A,R1SV + JRST CHEY + +RP: SKIPE EQHIT + AOS ENN ;TAKE CARE OF UNSATISFIED = AT END + SKIPN CHARF + JRST RTONOP + SETOM CHARF +BUDDY: SETOM WARN + MOVEI I,RPAR + JRST GOPART + +RTONOP: MOVE I,(SYM) + CAIN I,FUNCT + JRST BUDDY ;NO ARGUMENT FUNCTION + + MOAN ) FOLLOWS OPERATOR + +BDEND: MOAN TOO MANY ('S + +CHBRT: MOAN NON-OPERATOR FOLLOWS ) + + +CR: SKIPE EQHIT + AOS ENN ;HANDLES UNSATISFIED = AT END + SETOM ENDSTT + MOVEI I,RCAR + JRST GOPRT + +LP: SETZM EQHIT + SKIPE WARN + JRST LFRHT + SETZM CHARF + SKIPE STRING + JRST INDX + PUSH P,[0] ;INITIALISE COMMA-COUNTER + PUSH SYM,[0,,LFTPR] + JRST RDITA + +INDX: NUMBER + JRST NUSTRB + GETT + CAIG A,"9 + JRST NMRINX + MOVEI I,"( + IDPB I,D +INDY: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDN + CAIN A,"- + JRST CMPNDN + CAIE A,") ;SEARCH FOR NEXT RP + JRST INDY + IDPB A,D +CMBAN: SETOM CHARF ;MAKE BELIEVE CHARATER LAST + SETOM WARN ;YET SET ) TRAP + JRST RDITA + +NMRINX: CAIN A,"- ;IS IT A MINUS + JRST INDZ + CAIN A,"+ + JRST INDZ + MOVEI I,"+ ;NUMERICAL SUBSCRIPT + IDPB I,D +INDZ: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDC + CAIE A,") + JRST INDZ + JRST CMBAN + +CMPNDN: MOVEI I,") + IDPB I,D + JRST INDZ + +CMPNDC: MOVEI I,"( + IDPB I,D + JRST INDY + +LFRHT: MOAN ( FOLLOWS DIRECTLY ON ) + +SP=RDITA ;USE FOR NON ARITH STATS + +CM: MOVE I,[1,,COMMX] + SKIPN CHARF + AOS ENN + JRST SZPRT + +EQ: SETOM EQHIT + SETZM WARN + SKIPN CHARF ;TEST FOR EXISTANCE OF L H S + JRST EQFLOP + NUMBER ;IS L H S A NUMBER + JRST EQNUMB + MOVEI I,EQAAL +EQVAL: SETZM CHARF + PUSH SYM,I + PUSH P,STRING + PUSH P,STRING+1 + PUSH P,STRING+2 + PUSH P,[0] + JRST CLSTR + +PL: MOVE I,[2,,PLUS] + SKIPN CHARF + JRST RDITA ;UNARY PLUS + JRST SZPRT + +MN: MOVE I,[2,,MINUX] + SKIPN CHARF + MOVE I,[5,,UMINU] + JRST SZPRT + +AB: SKIPE CHARF ;ABSOLUTE VALUE + JRST ABERR ;NOT UNARY + MOVE I,[5,,UABS] + JRST SZPRT + +LB: SKIPN CHARF + JRST LP ;TREAT LIKE ( + NUMBER + JRST NUBRST + MOVEI I,FUNCT + JRST EQVAL + +RB=RP + +NUBRST: MOAN '<' FOLLOWS NUMBER + +NUSTRB: MOAN '(' FOLLOWS NUMBER + +EQFLOP: MOAN '=' FOLLOWS OPERATOR + +EQNUMB: MOAN '=' FOLLOWS NUMBER + +ABERR: MOAN NON-UNARY ABS + +TX: MOVE I,[4,,TIMES] + SKIPN CHARF + JRST RDITA ;UNARY TIMES + JRST SZPRT + +DL: GET ;CONTINUE STATEMENT RC + GET ;LF + GET ;. + CAIE A,". ;DOT + JRST BDCONT + GET ;F OR I + GET ;CONTROL I OR SPACE + MOVE A,DIRPNT + MOVEM A,TPN ;RESET SAVED INPUT POINTER TO AVOID FILLING ITS BUFFER + MOVEI A,"$ + IDPB A,TPN + MOVEI A,40 + IDPB A,TPN + JRST RDITA + +ERRCON: TRNE FF,FRPSS2 ;NO OUTPUT ON SECOND PASS + JRST CONRBT +;MAY ALSO WANT TO USE STATEMENT PLUS LINE NUMBER TYPE TACTIC + MOVE B,DIRPNT +OUTRR: ILDB A,B + PUSHJ P,TYO + CAME B,TPN + JRST OUTRR + SKIPE ENDSTT + JRST CONERT +DORSTL: MOVEI A,40 + PUSHJ P,TYO + MOVEI A,"? ;POINT AT ERROR + PUSHJ P,TYO + MOVEI A,40 + PUSHJ P,TYO +DORSAL: GET ;COPY UP TO LINE FEED + PUSHJ P,TYO + CAIE A,12 ;LF + JRST DORSAL +CONERT: PUSHJ P,TIPIS + PUSHJ P,CRR +CONRAT: MOVE TM,[ACSAV,,P] + BLT TM,P+6 + JRST SWFLS ;GO BACK AND FLUSH + + +CONRBT: GET + CAIE A,12 ;LF + JRST CONRBT + JRST CONRAT + + +UP: SKIPN WARN ;FOR (NUMBER)^N + SKIPN STRING + JRST ITSEX + MOVEM A,R1SV ;SAVE THE ARROW + NUMBER + JRST CHEX ;ITS PART OF A NUMBER +ITSEX: MOVE I,[6,,STRSTR] + SKIPN CHARF + JRST EXMB + JRST SZPRT + +EXMB: MOAN UNARY ^ + +BDCONT: MOAN BAD CONTINUATION + +KL=CR ;SEMICOLON ACTS LIKE CR IN TERMINATING + +STRSTR: SKIPN STRING + JRST EXLS + NUMBER + SKIPA + JRST EXLS + SUBI I,61 + TDNE I,[-1,,777774] + JRST EXLS + MOVE A,STRING + TDNE A,[3777,,-1] + JRST EXLS + ADDI I,POWR + JRST @(I) + +EXLS: PUSH P,[ASCII !EXPLO!] + PUSH P,[ASCII !G !] + PUSH P,[0] + PUSH P,[1] + SETOM EXRET' + JRST FUNET + +DV: MOVE I,[4,,DIVIX] + SKIPN CHARF + MOVE I,[5,,UDIVI] + JRST SZPRT + +PSOPR: PUSH SYM,I ;PUSH OPERATOR FOR LATER EXCECUTION + SKIPN STRING + JRST RDITTS + PUSHJ P,SHORT ;CAN WE IMMEDIFY + PUSHJ P,MVOI ;AND MOVE OPERAND INTO STACK + JRST CLSTR + + +PRODB: NUMBER ;OUTPUT WHAT IS IN STRING + SKIPE IMMED ;NO [ & ] IF IMMEDIATE USE + JRST OVNM + PUSH P,A + MOVEI A,"[ ;[ FOR CONSTANT + PUSHJ P,PUTREL + POP P,A + SETOM NUMFL +OVNM: CAIN I,"# + JRST PRDOC + + EXCH A,I + PUSHJ P,PUTREL + MOVE A,I +PRDOC: ILDB I,A + JUMPN I,OVNM + SKIPN NUMFL + POPJ P, + MOVEI A,"] ;] FOR CONSTANT + PUSHJ P,PUTREL + SETZM NUMFL + POPJ P, + +PRODC: HRLI A,440700 ;MAKE BYTE POINTER + JRST PRDOC + +LFTPR: SPECN + JRST RDITTS ;IGNORE LP ON STACK + +RCAR: HALT ;IMPOSSIBLE FOR THESE TO BE ON STACK +RPAR: HALT + +EQAAL: SPECN + SKIPE STRING + PUSHJ P,MVOI + MOVEI A,[ASCIZ ! MOVEM A!] + PUSHJ P,PRODC + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +ENDSAT: SPECN + SKIPN ENDSTT + JRST TOEARL + SKIPE STRING + PUSHJ P,MVOI +GETLF: GET + CAIE A,12 ;LF + JRST GETLF + MOVE TM,[ACSAV,,P] + BLT TM,P+6 + JRST SWRET ;GO BACK + +MVOI: MOVE A,BTPNT + ILDB I,A + CAIN I,"& + JRST MVOALR ;OPERAND ALREADY THERE + MOVEI A,[ASCIZ ! MOVE A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVEI A!] +MVOIK: PUSHJ P,PRODC + MOVE A,ENN + AOS ENN +FINOF: PUSHJ P,PUTREL + MOVEI A,", + PUSHJ P,PUTREL + PUSHJ P,PRODB + RETLIN + POPJ P, + +MVOALR: AOS ENN + POPJ P, + +TOEARL: MOAN TOO MANY )'S + +PLUS: MOVEI A,[ASCIZ ! FADR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! ADD A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! ADDI A!] +OPERT: PUSHJ P,PRODC + SKIPE STRING + JRST GAINS + SOS ENN +OPRTE: MOVE A,ENN + SOS A + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +COMMAA: MOVEI A,", + PUSHJ P,PUTREL + MOVEI A,"A + JRST PUTREL + +GAINS: MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +MINUX: MOVEI A,[ASCIZ ! FSBR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! SUB A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! SUBI A!] + JRST OPERT + +TIMES: PUSHJ P,TMSTR + SKIPE IMMED + MOVEI A,[ASCIZ ! IMULI A!] + JRST OPERT + +DIVIX: MOVEI A,[ASCIZ ! FDVR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IDIV A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! IDIVI A!] + JRST OPERT + + +UMINU: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE STRING + JRST MOABC + MOVEI A,[ASCIZ ! MOVNS A!] +UMINUC: PUSHJ P,PRODC + MOVE A,ENN + SOS A + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +MOABC: MOVEI A,[ASCIZ ! MOVN A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVNI A!] + PUSHJ P,MVOIK + JRST GAMB + +UABS: CAMN B,C + JRST BAKWD + SKIPE STRING + JRST MOABS + MOVEI A,[ASCIZ ! MOVMS A!] + JRST UMINUC + +MOABS: MOVEI A,[ASCIZ ! MOVM A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVMI A!] + PUSHJ P,MVOIK + JRST GAMB + +MVONT: MOVEI A,[ASCIZ ! MOVE A!] + PUSHJ P,PRODC + MOVE A,ENN + JRST ONMVS + +TMSTR: MOVEI A,[ASCIZ ! FMPR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IMUL A!] + POPJ P, + +BAKWD: PUSH SYM,A + JRST PSOPR + +UDIVI: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE INTEGR + JRST UINDV + SKIPN STRING + PUSHJ P,MVONT + MOVEI A,[ASCIZ ! HRLZI A!] + PUSHJ P,PRODC + MOVE A,ENN + SKIPN STRING + SOS A + PUSHJ P,PUTREL + MOVEI A,[ASCIZ !,201400!] + PUSHJ P,PRODC + RETLIN + AOS ENN + JRST DIVIX + +ONTMS: PUSHJ P,TMSTR + PUSHJ P,PRODC + MOVE A,ENN + SOS A +ONMVS: PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A +LSTCHX: PUSHJ P,PUTREL + RETLIN + POPJ P, + +POWR: GAMB?POWR2?POWAA?POWR4 + +POWR4: PUSHJ P,ONTMS +POWR2: PUSHJ P,ONTMS + JRST GAMB + +POWAA: PUSHJ P,MVONT + AOS ENN + PUSHJ P,ONTMS + SOS ENN + PUSHJ P,TMSTR + PUSHJ P,PRODC + RESTOR + JRST OPRTE + +COMMX: AOS (P) + SKIPE STRING + PUSHJ P,MVOI + JRST GAMB + +UINDV: MOAN INTEGER UNARY DIVIDE + +FUNCT: SETZM EXRET +FUNET: SKIPE STRING + PUSHJ P,MVOI + SPECN + PUSHJ P,MORFMC + MOVEI A,[ASCIZ ! PUSHJ P,!] + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + PUSHJ P,PRODC + PUSHJ P,PRODB + RESTOR + RETLIN + PUSHJ P,MORFNC + SKIPN EXRET + JRST RDITTS ;AS USED FROM FUNCT + JRST COMMT ;AS USED FROM STRSTR + +MORFMC: MOVE A,RANDM + MOVEM A,RANSV' + SKIPN CHARF ;NO ARGUMENTS + AOS ENN + SETOM CHARF + MOVEI A,"1 + CAMN A,ENN ;ARE ARGUMENT ALREADY IN A0 AND UP + POPJ P, + SETZM CORDM +MORYLP: PUSHJ P,ZENBD + AOS CORDM + SOSL RANSV + JRST MORYLP + POPJ P, + +MORFNC: MOVEI A,"1 + CAMN A,ENN + POPJ P, + MOVE A,RANDM + MOVEM A,CORDM' +MORXLP: PUSHJ P,ZENBD + SOSL CORDM + JRST MORXLP + POPJ P, + +ZENBD: MOVEI A,[ASCIZ ! EXCH A!] + PUSHJ P,PRODC + MOVE A,CORDM + ADDI A,"0 + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A + ADD A,CORDM + JRST LSTCHX + +TIPIS: MOVE A,TEMP + MOVEM A,BYTPNT +MORTP: ILDB A,BYTPNT + CAIN A,1 ;EXCLAMATION + POPJ P, + ADDI A," ;SPACE + PUSHJ P,TYO + JRST MORTP + +] ;END .I.FSW CONDITIONAL + +IFN LISTSW,[ + +;LISTING ROUTINES. + +PNTR: MOVEM 17,PNTSA+17 + MOVEI 17,PNTSA + BLT 17,PNTSA+16 + SKIPL LSTONP + JRST PNTR5 + AOSE LISTPF + JRST PNTR1 + SKIPGE T,LISTAD + JRST PNTR2 + PUSHJ P,P6OD + HLRZS T + PUSHJ P,PSOS ;PRINT SPACE OR ' + PUSHJ P,PILPTS +PNTR3: HLRZ T,LISTWD + PUSHJ P,P6OD + MOVS T,LSTRLC + TLNE T,400000 + AOJ T, + PUSHJ P,PSOS + HRRZ T,LISTWD + PUSHJ P,P6OD + HRRZ T,LSTRLC + PUSHJ P,PSOS + PUSHJ P,PILPTS + PUSHJ P,PILPTS +PNTR4: MOVE TT,[440700,,LISTBF] +PNTR6: CAMN TT,PNTBP + JRST PNTR5A + ILDB A,TT + PUSHJ P,PILPT + JRST PNTR6 + +PNTR5A: CALL PNTCR + MOVE A,LISTBC + CAIE A,14 + JRST PNTR7 +PNTR5C: CALL PILPT ;OUTPUT THE ^L, + CALL PNTHDR ;AND THE PAGE NUMBER. + JRST PNTR5D + +PNTR7: MOVEI A,12 + PUSHJ P,PILPT +PNTR5D: SETOM LISTBC +PNTR5: MOVNI A,LISTBS*5-1 + MOVEM A,PNTSW ;DETECT OVERFLOW OF LISTBF + MOVE TT,[440700,,LISTBF] + MOVEM TT,PNTBP + MOVSI 17,PNTSA + BLT 17,17 + POPJ P, + +PNTR5B: MOVE A,LISTBC + CAIN A,14 + JRST PNTR5C + JRST PNTR5D + +PNTR2: MOVEI T,8 + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR3 + +PNTR1: MOVE TT,[440700,,LISTBF] + CAMN TT,PNTBP + JRST PNTR5B + MOVEI T,25. + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR4 + +PSOS: MOVEI A,"' + TRNN T,-1 +PILPTS: MOVEI A,40 + JRST PILPT + +P6OD: MOVE TT,[220300,,T] +P6OD1: ILDB A,TT + ADDI A,"0 + PUSHJ P,PILPT + TLNE TT,770000 + JRST P6OD1 + POPJ P, + +PNTCR: MOVEI A,^M ;OUTPUT ^M TO LST IF OPEN. +PILPTX: SKIPE LSTONP;OUTPUT CHAR TO LST IF LSTING. + JRST PILPT + RET + +PNTHDR: MOVEI A,^I + MOVEI B,10. ;MOVE TO COLUMN 80., + CALL PILPT + SOJG B,.-1 + SAVE LSTTTY + HLLOM B,LSTTTY ;POSITIVE SO TYOERR GOES ONLY TO LST. + TYPR [ASCIZ/Page /] + MOVE A,CPGN + CALL [AOJA A,DPNT] + REST LSTTTY +PNTCRR: CALL PNTCR ;OUTPUT CRLF TO LST IF OPEN. +PNTLF: MOVEI A,^J + JRST PILPTX + +DEFINE LSTM %A,B,C +IF1 [ [B] ? [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+LSTM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-LSTM0 +] +TERMIN + +A.LSTFF: AOS (P) ;RETURN NO VALUE. +; ADDR, CONTENTS IF NOT LISTING, CONTENTS IF LISTING. +LSTOFF: LSTM LSTONP,0,-1 + LSTM LSTPLM,[TLO B,4^5][JRST PSHLML] + LSTM RCHLST,RCHLS1,AOSN PNTSW + LSTM RCH1LS,RET,[CAILE A,^M] + LSTM POPLML,JFCL,[IDPB A,PNTBP] + JRST MDSCLR +LSTM0==.-LSTOFF + +LSTON: BLOCK LSTM0-1 + JRST MDSSET + +A.LSTN: SKIPN LISTP1 ;IF SHOULD LIST THIS PASS + JUMPGE FF,MACCR + SKIPE LISTP ;AND WANT LISTING, + CALL LSTON ;TURN ON LISTING OUTPUT. + JRST MACCR + +IFNDEF LISTBS,LISTBS==50. ;LISTBF SIZE IN WORDS. + +VBLK ;LISTING FEATURE VARIABLES + +PNTBP: 0 ;POINTER TO LISTING LINE BUFFER +LSTONP: 0 ;NONZERO WHEN OUTPUTTING TO LISTING FILE. +LISTP: +LISTON: 0 ;-1 IF LISTING ON +PNTSW: 0 ;-1 IF LAST CHR CR OR LF, OR -<# CHARS SPACE LEFT IN LISTBF> +LISTBF: BLOCK LISTBS +LISTAD: 0 ;ADDRESS OR -1 NONE 3.1 RELOC +LISTWD: 0 ;WORD +LSTRLC: 0 ;RELOCATION +LISTPF: 0 ;-1 OTHERS CONTAIN SOMETHING +LISTBC: 0 ;BREAK CHR CR LF OR FF OR -1 IF NONE SINCE LAST PNTR +LISTTM: 0 ;TEMP AT AEND +PNTSA: BLOCK 20 ;AC SAVE AREA FOR LISTING FEATURE +LISTP1: 0 ;POSITIVE => WANT TO LIST EVEN ON PASS 1. +] ;END IFN LISTSW, + +IFE LISTSW,VBLK + +;THESE VARIABLES ARE REFERENCED EVEN IF LISTSW IS 0. +LSTTTY: 0 ;TYOERR TYPES ON TTY IFF LE 0, ON LST IF NOT 0. +LSTPLM: TLO B,4^5 ;OR JRST PSHLML ;XCT'D BY PSHLMB. +POPLML: JFCL ;OR IDPB A,PNTSW ;XCT'D IN POPLMB. + +PBLK +IFE LISTSW, A.LSTN: A.LSTF: RET + +VBLK +IFN CREFSW,[ +CREFP: 0 ;SET BY C SWITCH TO REQUEST CREFFING. +CRFONP: 0 ;SET WHILE CREFFING. +CRFLFL: 0 ;LAST PAGNUM,,LINENUM OUTPUT. +CRFINU: JFCL\PUSHJ P,CRFUSE ;XCT THIS TO CREF NON-DEF OCCUR. +CRFLBL: JFCL\PUSHJ P,CRFLB1 ;XCT FOR DEF. OF NORMAL SYM. +CRFEQL: JFCL\PUSHJ P,CRFEQ1 ; FOR DEF. OF NORMAL SYM. OR INTSYM. +CRFMCD: JFCL\PUSHJ P,CRFMC1 ; FOR DEF. OF MACRO. +CRFDEF: JFCL\PUSHJ P,CRFDF1 ; FOR RANDOM DEF, CHECK FLAGS. +] +CRFILE: 0 ;SET => SHOULDN'T OUTPUT PAGNUM,,LINENUM'S +;USED BY .CRFILE INTSYM SO CAN'T BE IN CONDIT. +PBLK +IFN CREFSW,[ +CRFEQ1: MOVEI T,(B) + CAIN A,1 ;IF NOT PSEUDO OR NOT INTSYM, + CAIE T,INTSYM + JRST CRFLB1 ;IS NORMAL SYM. +CRFOD1: MOVSI T,600000 ;ELSE DEFINING INSN. + JRST CRFEQ2 + +CRFDF2: MOVEI T,(B) ;DECIDE WHETHER DEFINING MACRO OR PSEUDO. + CAIE T,MACCL + JRST CRFOD1 +CRFMC1: SKIPA T,[500000,,] ;DEFINING MACRO. +CRFLB1: MOVSI T,440000 ;DEFINING NORMAL SYM. +CRFEQ2: PUSH P,A + MOVE A,T + JRST CRFMA1 + +;COME HERE FOR NON-DEF; MUST DECIDE WHAT TYPE SYM. +CRFUSE: TLNE C,3NCRF ;SYM MAY HAVE CREFFING SUPPRESSED. + POPJ P, + PUSH P,A + CAIN A,1 + JRST CRFMAC ;PSEUDOS, MACROS. + MOVSI A,40000 ;FLAG FOR NORMAL SYM. + TRNN C,-1 + MOVSI A,200000 ;FLAG FOR INSNS. +CRFMA1: PUSH P,A + MOVE A,CLNN + HRL A,CPGN + AOBJN A,.+1 ;A HAS PAGNUM,,LINENUM . + SKIPGE CRFILE ;IF SHOULD OUTPUT IT, + JRST CRFUS1 + CAME A,CRFLFL ;AND HAS CHANGED, DO SO. + PUSHJ P,CRFOUT + MOVEM A,CRFLFL +CRFUS1: POP P,A + IOR A,SYM ;COMBINE SYM AND CREF FLAG. + PUSHJ P,CRFOUT + JRST POPAJ + +CRFMAC: MOVEI A,(B) + CAIN A,MACCL + SKIPA A,[100000,,] ;MACRO + MOVSI A,200000 ;PSEUDO-OP. + JRST CRFMA1 + +;DEFINING OCCURRENCE, MIGHT BE ANY TYPE SYM. +CRFDF1: CAIN A,1 ;TYPE 1 => MACRO OR PSEUDO. + JRST CRFDF2 + TRNE C,-1 ;ELSE INSN OR NORMAL SYM. + JRST CRFLB1 + JRST CRFOD1 + +DEFINE CRFM %A,B,C +IF1 [ [B] + [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+CRFM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-CRFM0] +TERMIN + + +A.CRFFF: AOS (P) ;.CRFOFF - STOP CREFFING. NO VAUE. +; LOCATION, NORMAL VALUE, VALUE WHILE CREFFING +CRFOFF: CRFM CRFONP,0,-1 + CRFM CRFLBL,JFCL,[PUSHJ P,CRFLB1] + CRFM CRFEQL,JFCL,[PUSHJ P,CRFEQ1] + CRFM CRFMCD,JFCL,[PUSHJ P,CRFMC1] + CRFM CRFINU,JFCL,[PUSHJ P,CRFUSE] + CRFM CRFDEF,JFCL,[PUSHJ P,CRFDF1] + POPJ P, +CRFM0==.-CRFOFF + +CRFON: BLOCK CRFM0-1 + POPJ P, + +A.CRFN: JUMPGE FF,MACCR + SKIPE CREFP ;.CRFON, IF HAVE CREF FILE, START CREFFING. + PUSHJ P,CRFON + JRST MACCR +] ;END IFN CREFSW, + +IFN TS,[ ;;TS ;TIME-SHARING ROUTINES + +IFNDEF TYPDLC,TYPDLC==7 ;MAXIMUM TOTAL DEPTH OF .INSRT (INCLUDING TTY) +IFNDEF MX.INS,MX.INS==5 ;MAXIMUM DEPTH .INSRT FILES ONLY +IFNDEF MAXIND,MAXIND==6 ;MAXIMUM # @: TABLE ENTRIES FOR .INSRT +IFN DECSW,[ + UTOBFL==203 + CRFBSZ==203 + UTIBFL==410 + LSTBSZ==203 + ERRBSZ==203 +] +IFNDEF UTIBFL,UTIBFL==400 ;INPUT BUFFER SPACE. +IFNDEF UTOBFL,UTOBFL==200 +IFNDEF CMBFL,CMBFL==50 ;COMMAND BUFFER LENGTH. +IFNDEF CRFBSZ,CRFBSZ==200 ;# WDS CREF OUTPUT BUFFER. +IFNDEF LSTBSZ,LSTBSZ==200 +IFNDEF ERRSW,ERRSW==1 ;1 FOR ERROR FILE OUTPUT CAPABILITY. +IFNDEF ERRBSZ,ERRBSZ==1 ;ERROR FILE BUFFER SIZE. + +ERRC==0 ;ERR DEVICE CHANNEL. +TYIC==1 ;TTY INPUT CHANNEL +TYOC==2 ;TTY OUTPUT CHANNEL +CREFC==3 ;CREF OUTPUT. +UTYOC==4 ;OUTPUT FILE +LPTC==5 ;LISTING (LPT) +ERRFC==6 ;ASSEMBLY ERROR OUTPUT FILE. +UTYIC==7 ;1ST INPUT CHANNEL, UTYIC+N USED FOR NTH .INSRT LEVEL IN DEC VERSION. + +VBLK +INTJPC: 0 ;SAVES .JPC AT INTERRUPT. +INTSVP: 0 ;SAVES P ON INTERRUPT FOR DEBUGGING + +;NOTE THAT ONLY PDL OV IS NOW ENABLED. + +IFN ITSSW,[ +.JBCNI: +TSINT: 0 ;1ST WD INTERRUPTS (AT PRESENT) ARE CONSIDERED FATAL ERRORS +.JBTPC: 0 ;ERROR PROCESSOR RE-ENABLES INTERRUPTS + .SUSET [.RJPC,,INTJPC] + SKIPGE TSINT + JRST TTYINT ;SECOND-WORD INTS. + JRST TSINT1 ;JUMP INTO PURE CODING AND PROCESS INTERRUPT +] +.ELSE CCLFLG:0 ; FLAG TO INDICATE CCL ENTRY FROM COMPIL + +PBLK +TSINT1: MOVEM P,INTSVP ;SAVE P FOR POSSIBLE DEBUGGING + .SUSET [.SPICL,,[-1]] +IFE SAILSW,MOVE A,.JBCNI ;GET INTERRUPT REQUEST WORD +.ELSE MOVE A,JOBCNI + TRNE A,200000 ;PDL OVERFLOW? + JRST CONFLP + MOVE B,[TYPR [ASCIZ/Unknown interrupt - Fatal/]] + MOVEM B,40 +IFE SAILSW,MOVE A,.JBTPC ;SO ERROR ROUTINE WILL PRINT OUT PROPERLY +.ELSE MOVE A,JOBTPC + JSA A,ERROR + +;MIDAS STARTS HERE. +BEG: +IFN DECSW,[ + TDZA A,A + SETO A, + MOVEM A,CCLFLG ; REMEMBER TYPE OF START-UP + RESET + MOVEI A,600000 + APRENB A, +] +IFN ITSSW,[ + .SUSET [.RSNAM,,RSYSNM] ;GET SYSTEM NAME + .SUSET [.SMASK,,[%PIPDL]] ;PDL OVERFLOW ONLY. + .SUSET [.SMSK2,,[1_TYIC]] + SYSCAL TTYSET,[1000,,TYIC + [232020,,202020] + [232020,,220220]] + .SUSET [.SPICL,,[-1]] ;PERMIT INTERRUPTS (IN CASE RESTARTED DURING INTERRUPT) +] + MOVEI FF,0 ;INITIALIZE FLAGS + MOVE P,[-LPDL,,PDL] ;INITIALIZE P + AOSN NVRRUN + JRST BEG9 + TYPR [ASCIZ /Can't restart MIDAS/] + JRST TSRETN + +BEG9: MOVEI D,SYMDSZ ;GET DEFAULT SYMTAB SIZE +IFN ITSSW,[ + .SUSET [.RXJNAM,,A] + CAME A,['MMIDAS] ;OR LARGER FOR MMIDAS + CAMN A,[SIXBIT/MM/] + MOVEI D,SYMMSZ +] + SKIPGE ISYMF ;THE FIRST TIME THROUGH, + MOVEM D,SYMLEN ;MAKE THAT THE SIZE TO USE. + CALL JCLINI ;NOW TRY TO FETCH JCL. +IFN ITSSW,[SKIPGE ISYMF ;SKIP IF SYMS SPREAD + CALL TSYMGT ;GET TS SYMS FROM SYSTEM +] + SKIPGE CMPTR ;IF NO CMD FROM DDT, + JRST GO2A ;ANNOUNCE MIDAS'S NAME AND VERSION. +IFG PURESW-DECSW,[ + SKIPGE PURIFG + TYPR [ASCIZ /NOTPUR /] +] + MOVE B,[SIXBIT /MIDAS./] + PUSHJ P,SIXTYO + MOVE B,[MIDVRS] + PUSHJ P,SIXTYO +; JRST GO2A + +GO2A: SETOM FATAL + SETZM TTYFLG +IFE ITSSW,SETZM ERRTTL ; INITIALIZE ERROR COUNTER + MOVEI FF,0 ;INITIALIZE FLAGS + SKIPLE CMPTR + SETZM CMPTR +IFN RUNTSW,[ PUSHJ P,RNTTMA ;GET INITIAL RUN TIME. + MOVEM A,IRUNTM'] + SETZM LSTTTY + PUSHJ P,CMD ;GET TYPED IN COMMAND + SKIPGE SMSRTF + JRST GO21 + TYPR [ASCIZ/SYMTAB clobbered +/] + JRST GO2A + +GO21: PUSHJ P,GINIT ;INITIALIZE STUFF + PUSHJ P,OPNRD ;OPEN INPUT FILE + PUSHJ P,WINIT ;OPEN OUTPUT FILE, CREF FILE. +IFN DECSW,[ + SKIPGE CCLFLG + OUTSTR [ASCIZ /MIDAS: /] +] +GO3: MOVEMM TTYFLG,WSWCNT ;TURN OFF TYPEOUT IF THERE WERE (W) SWITCHS. + SETOM LSTTTY + JSP A,$INIT ;INITIALIZE FOR ASSEMBLY + JSP A,PS1 ;DO PASS 1 + TRNE FF,FRNPSS ;IF 2 PASS ASSEMBLY, + PUSHJ P,OPNRD ;THEN RE-OPEN INPUT FILE + JSP A,PLOD ;MAYBE PUNCH OUT SBLK LOADER IN SOME FORMAT + JSP A,PS2 ;DO PASS 2 + JSP A,PSYMS ;MAYBE PUNCH OUT SYMBOL TABLE +IFN A1PSW,[ + TLZ FF,FLOUT + AOS PRGC ;INDICATE END STATEMENT ENCOUNTERED + SETOM OUTC ;" " " + TRNN FF,FRNPSS ;IF 1 PASS ASSEMBLY, + SKIPGE CONTRL + CAIA + JRST GO3 ;THEN TRY TO ASSEMBLE ANOTHER PROGRAM +] +IFN FASLP,[ + SKIPGE A,CONTRL + TRNN A,FASL + JRST GO4 + MOVE A,[SIXBIT /*FASL*/] ;"FINISH" FASL FILE + MOVEI B,17 + PUSHJ P,FASO ;IGNORE END FROB, BUT OUTPUT FASL END CODE + MOVE A,[.BYTE 7 ?3 ? 3 ? 3? 3? 3] + PUSHJ P,FASO1 ;RANDOMNESS + PUSHJ P,FASBE ;WRITE OUT LAST BLOCK +] +GO4: SETZM FATAL ;THERE WAS NO FATAL ERROR: OUTPUT FILES GET RENAMED. +GO2: +RETN2: PUSHJ P,.FILE + SETZM LSTTTY +IFN RUNTSW,[ + PUSHJ P,RNTTYO ;TYPE OUT RUN TIME USED SINCE GO2A +];IFN RUNTSW + CALL ERRCLS ;FILE AWAY ERROR FILE. + JRST TSRETN + + ;INITIALIZATION ROUTINE CALLED ONCE PER (COMMANDED) ASSEMBLY + +GINIT: IFN A1PSW,[ + SETOM PRGC + SETOM OUTC +] +IFN DECSW,[ IFE SAILSW,[ + SETZM V.SITE ;; CODE TO SET UP .SITE'S VALUE, ON DEC SYSTEM. + MOVE A,[V.SITE,,V.SITE+1] + BLT A,V.SITE+4 + MOVE B,[440600,,V.SITE] + MOVSI C,-5 ;PROCESS 5 WORDS F .GTCNF +GINIT1: HRLZ A,C + HRRI A,11 ;11 = .GTCNF + GETTAB A, ;GET 1 WORD + SETZ A, +GINIT2: SETZ AA, ;EXTRACT THE ASCII CHARS AND STORE THEM. + ROTC AA,7 + TRCE AA,140 ;SWAP BIT 40 WITH BIT 100, THUS TURNING + TRCE AA,140 ;"A TO 'A, "a TO 'A, "1 TO '1, ETC, AND ^@ TO ' . + TRCE AA,140 + IDPB AA,B ;STORE THE SIXBIT INTO .SITE'S VALUE STRING. + JUMPN A,GINIT2 ;WHEN NOTHING LEFT OF THIS WORD OF .GTCNF, GET THE NEXT. + AOBJN C,GINIT1 +]];END DECSW + MOVE A,[MAXIND,,FDSOFS] + MOVEM A,INDDP ;INITIALIZE POINTER INTO INDIRECT FILE TABLE +IFDINI: MOVE A,[DNAM,,IFDS] + BLT A,IFDS+LFDSE-1 ;SET UP INPUT FILE NAMES FROM DNAM ETC. + POPJ P, + +IFN RUNTSW,[ ;TYPE OUT RUN TIME USED + +RNTTYO: +IFE ITSSW,[ ; NOBODY WANTS THIS ON ITS, BUT OTHER PEOPLE DO...SIGH... + SKIPE A,ERRTTL ; ANY ASSEMBLY ERRORS? + JRST [ TYPR [ASCIZ/? /] ; YES, ERROR MESSAGE FOR BATCH CONTROLLERS + CALL DPNT + TYPR [ASCIZ/ error(s) detected +/] + JRST .+1] +IFN DECSW,[ + SKIPE CCLFLG ; CALLED VIA CCL? + RET +] ; IFN DECSW +] ; IFE ITSSW + TYPR [ASCIZ /Run time = /] + CALL A.MRUNT ;GET RUNTIME IN MILLISEC. IN A. + IDIVI A,10. + IDIVI A,100. ;GET SECS AND HUNDREDTHS. + HRLM B,(P) ;SAVE REMAINDER + PUSHJ P,HMSTYO ;TYPE OUT SECS + MOVEI A,". + CALL TYO + HLRZ A,(P) + CALL RNTYO3 ;TYPE OUT HUNDREDTHS + CALL CRR + CALL A.SYMC + CALL DPNT + TYPR [ASCIZ/ Symbols including initial ones +/] + RET + + ;TYPE OUT H:MM:SS TIME IN A + ;DOESN'T WORK FOR TIMES .GE. 60. HOURS + +HMSTYO: IDIVI A,60. + JUMPE A,HMSTY2 + HRLM B,(P) + PUSHJ P,HMSTYO + MOVEI A,": +RNTYO2: PUSHJ P,TYO ;TYPE DELIMITING CHAR + HLRZ A,(P) +RNTYO3: IDIVI A,10. + PUSHJ P,ADGTYO ;TYPE OUT DIGIT IN A + MOVEI A,"0(B) + JRST TYO + +HMSTY2: MOVE A,B + JRST DPNT + +RNTTMA: .SUSET [.RRUNT,,A] +IFN DECSW,[SETZ A, + RUNTIM A,] + POPJ P, + +A.MRUNT: PUSHJ P,RNTTMA ;GET CURRENT RUN TIME + SUB A,IRUNTM' ;SUBTRACT RUN TIME AS OF GO2 +IFN ITSSW,[MULI A,4069. ;CONVERT TO NANOSECONDS + DIV A,[1.^6] ;THEN TO MILLISECONDS. +] + JRST CLBPOP +] + + ;TS OUTPUT ROUTINES + +PPB: JUMPGE FF,CPOPJ +PPBA: +TPPB: SOSGE UTYOCT + JRST TPPB1 + IDPB A,UTYOP + RET + +TPPB1: CALL TPPBF ;OUTPUT THE BUFFER, + JRST TPPB + +TPPBF: SAVE C + MOVE C,[0 UTYOC,UTOHDR] + CALL OBUFO ;OUTPUT & RE-INIT BUFFER. + REST C + RET + +WINIT: +IFN ERRSW,[ + SKIPN ERRFP ;IF WANT ERROR OUTPUT FILE, + JRST WINIT2 + CALL OINIT ;OPEN IT. + 0 ERRFC,ERRDEV + SIXBIT/ERROUT/ + ERRHDR,,ERRBUF + SETOM ERRFOP ;ERROR FILE NOW OPEN. +WINIT2: ] + PUSHJ P,OINIT ;OPEN OUTPUT FILE, FN2=OUTPUT. + 13^9 UTYOC,ONAM ; CHNL,NAME-BLOCK. + SIXBIT/OUTPUT/ + UTOHDR,,UTOBUF +IFN ITSSW,[ + TLZ FF,FLPTPF ;INITIALLY ASSUME DEVICE NOT PAPER TAPE PUNCH + .STATUS UTYOC,A ;GET STATUS OF OUTPUT CHANNEL + ANDI A,77 ;MASK TO DEVICE CODE + CAIN A,7 ;IF PAPER TAPE PUNCH, + TLO FF,FLPTPF ;THEN SET FLPTPF +] +IFN LISTSW,[ + SKIPN LISTP + JRST WINIT1 + CALL OINIT + 0 LPTC,LSTDEV ;OPEN LISTING FILE IF DESIRED. + SIXBIT/LSTOUT/ + LSTHDR,,LSTBUF +WINIT1: +] +IFN CREFSW,[ + SKIPN CREFP ;IF CREF REQUESTED, + RET + PUSHJ P,OINIT ;OPEN CREF FILE, FN2=CRFOUT + 13^9 CREFC,CRFDEV + SIXBIT/CRFOUT/ + CRFHDR,,CRFBUF + MOVE A,[.BYTE 7 ? 177 ? "B ? ^W] + PUSHJ P,CRFOUT ;OUTPUT HEADER TO INDICATE IMAGE INPUT. + PUSHJ P,CRFSSF ;OUTPUT SET-SOURCE-FILE BLOCK. +] + RET + +IFN ITSSW,RELEAS==.CLOSE + +;CLOSE INPUT, BIN, CREF AND LIST FILES. +.FILE: RELEAS UTYIC, + MOVNI A,1 + SKIPL B,CONTRL ;IF RELOCATABLE, + PUSHJ P,TPPB ;OUTPUT A -1 SO STINK WILL SEE EOF + SETZ A, ;IN DEC FMT, OUTPUT A 0 AT END. + TRNE B,DECREL + CALL TPPB + SKIPE ONAM+2 + JRST .FILE2 ;OUTPUT FNAM2 WAS EXPLICITLY SPECIFIED + SKIPL B,CONTRL + SKIPA A,[IFN DECSW,['STK,,] .ELSE ['REL,,]] + MOVSI A,(SIXBIT /BIN/) + TRNE B,DECREL ;THE DEFAULT DEPENDS ON OUTPUT TYPE. + MOVSI A,'REL +IFN FASLP,[ + TRNE B,FASL + MOVE A,[IFN ITSSW,[SIXBIT /FASL/] .ELSE ['FAS,,]] +] + MOVEM A,ONAM+2 +.FILE2: JSP A,OCLOSE + 0 UTYOC,UTOHDR ;WRITE OUT BUFFER, RENAME AND CLOSE OUTPUT FILE. + ONAM +IFN LISTSW,[ + SKIPN LISTP ;LISTING FILE OPEN => + JRST .FILE3 + CALL PNTCR ;END WITH CR AND FF. + MOVEI A,^L + CALL PILPT + JSP A,OCLOSE + 0 LPTC,LSTHDR ;OUTPUT BUFFER, RENAME & CLOSE IT. + LSTDEV +.FILE3: +] ;END IFN LISTSW +IFN CREFSW,[ + SKIPN CREFP ;IF CREF FILE OPEN, + POPJ P, + MOVEI A,0 + PUSHJ P,CRFOUT ;OUTPUT EOF BLOCK, + JSP A,OCLOSE ;WRITE BUFFER, CLOSE. + 0 CREFC,CRFHDR ; 0 CHNL,HEADER + CRFDEV +] + RET + +;FILE OUT ERROR OUTPUT FILE. +ERRCLS: SETZM FATAL ;ERR FILE RENAMED EVEN AFTER FATAL ERROR. +IFN ERRSW,[ + SKIPN ERRFOP + RET ;THERE IS NONE. + MOVEI A,^M + CALL ERRCHR ;PUT CRLF AT ENND. + MOVEI A,^J + CALL ERRCHR + JSP A,OCLOSE ;RENAME AND CLOSE. + 0 ERRFC,ERRHDR + ERRDEV + SETZM ERRFOP +] + RET + ; PUSHJ P,OINIT ;OPEN OUTPUT FILE +; MODE CHNL,NAME-BLOCK-ADDR +; SIXBIT/DESIRED-TEMPORARY-FN2/ +; HEADER,,BUFFER SPACE ;USED ONLY IN DEC VERSION. +;THE MODE SHOULD BE 13^9 FOR BINARY, 0 FOR ASCII. +IFN ITSSW,[ +OINIT: MOVE A,(P) + HLRZ B,2(A) ;GET ADDR OF HEADER, + SETOM 2(B) ;SET BUFFER BYTE COUNT TO -1 => NOT INITTED. + MOVE AA,1(A) ;GET 2ND ARG, + MOVS A,@(P) ;COPY OUTPUT FILE'S EVENTUAL NAMES INTO DNAM, ETC. + CALL A.IMP1 + .CALL OINITR ;TRANSLATE THEM AS IF OPENING THAT FILE, + JRST OINITL ;(TOO MANY TRANSLATIONS) + .CALL OINITB ;DELETE OLD TEMP NAME FILE. + JFCL ;THERE WAS NONE. + LDB A,[270400,,@(P)] ;GET CHANNEL NUM. + HRLI A,7 ;OPEN MODE. + LDB B,[331100,,@(P)] + CAIN B,0 ;BUT MAYBE WANT ASCII MODE. + HRLI A,3 + .CALL OINITO + JRST OINITL + HRRZ A,@(P) + MOVEI B,3(A) ;SUCCESSFUL OPEN, COPY TRANSLATED NAMES INTO NAME-BLOCK FOR FILE + HRLI A,DNAM + BLT A,(B) ;FOR EVENTUAL RENAME. +POPJ3: AOS (P) ;SKIP OVER 3 ARGS. +POPJ2: AOS (P) + JRST POPJ1 + +; JSP A,OCLOSE +; 0 CHNL,HEADER +; NAMEBLOCKADDR +;WRITE OUT LAST BUFFER, RENAME TO NAMES IN NAMEBLOCK AND CLOSE. +OCLOSE: MOVE C,(A) ;1ST WD OF ARGS IS WHAT OBUFO WANTS. + LDB B,[360600,,1(C)] ;JUST IN CASE THIS IS ASCII FILE, + DPB B,[300600,,OCLOSP] ;GET BP TO UNUSED PART OF LAST WD OF BUFFER, + MOVE B,[ASCIC//] + DPB B,OCLOSP ;AND PAD WITH ^C'S. + SOS 2(C) ;OBUFO ASSUMES BYTE COUNT WAS SOS'D. + CALL OBUFO ;WRITE OUT LAST PARTIAL BUFFER + MOVE B,1(A) + LDB C,[270400,,(A)] ;GET CHNL NUM. + SKIPE FATAL + JRST OCLOS1 ;AFTER FATAL ERROR, DON'T RENAME OUTPUTFILES. + .CALL ORENMB ;RENAME (B HAS NAMEBLOCK ADDR) + HALT +OCLOS1: .CALL OCLOSB ;CLOSE + HALT + JRST 2(A) + +ORENMB: SETZ ? SIXBIT/RENMWO/ + C ? 1(B) ? SETZ 2(B) ;[CHNL] ? [FN1] ? [FN2] ((SETZ)) + +OCLOSB: SETZ ? SIXBIT/CLOSE/ + SETZ C + +OINITB: SETZ ? SIXBIT/DELETE/ + DNAM ? ['_MIDAS] ? AA ? SETZ SNAM + +OINITR: SETZ ? SIXBIT/TRANS/ + REPEAT 4,DNAM+.RPCNT + REPEAT 4,[? 2000,,DNAM+.RPCNT ] ((SETZ)) + +OINITO: SETZ ? SIXBIT/OPEN/ ? A + DNAM ? ['_MIDAS] ? AA ? SETZ SNAM + +;WRITE OUT AND REINITIALIZE BUFFER FOR FILE. +;ASSUMES BYTE COUNT (HEADER 3RD WD) WAS SOS'D. +;C HAS <0 CHNL,HEADER> +;IN ITS VERSION, HEADER 1ST WD HAS ,,-1 +OBUFO: SAVE A + SAVE AA + AOSGE 2(C) ;WAS COUNT SOS'D FROM -1? + JRST OBUFO1 ;YES, BUFFER HADN'T BEEN INITTED, DON'T WRITE IT. + MOVN A,1(C) + ADD A,(C) ;RH(A) HAS -<# WDS USED IN BUFFER>. + MOVSI A,(A) + HRR A,(C) + AOS A ;A HAS AOBJN -> USED PART OF BUFFER. + HLLZ AA,C + IOR AA,[.IOT A] + SKIPGE A + XCT AA ;WRITE IT IN FILE. +OBUFO1: MOVE A,1(C) + HRR A,(C) ;POSITION THE B.P. BEFORE START OF BUFFER, + TLZ A,770000 ;AFTER LAST BYTE IN WD (IDPB WILL USE 1ST BUFFER WD) + MOVEM A,1(C) + HLRE A,(C) + MOVEM A,2(C) ;SET UP BYTE COUNT. + REST AA + JRST POPAJ + +TFEED: TLNN FF,FLPTPF ;IF OUTPUT DEVICE NOT PTP, + POPJ P, ;THEN DO NOTHING + PUSHJ P,TPPBF ;OTHERWISE OUTPUT THE BUFFER, +TFEED1: .FEED UTYOC, ;FEED A LINE, + TLZA FF,FLPTPF ;IF THIS IS EXECUTED, UTYOC DOESN'T HAVE PTP AFTER ALL + SOJG B,TFEED1 ;FEED THE SPECIFIED NUMBER OF LINES, + POPJ P, ;AND RETURN + +TSRETN: +IFN PURESW,[ + SKIPGE PURIFG ;IF NOT YET PURIFIED, ASSUME BEING DEBUGGED. + .VALUE +] + .LOGOUT ;COME HERE TO COMMIT SUICIDE. + .BREAK 16,160000 + +A.SITE: CALL AGETFD ;.SITE N, RETURNS NTH WORD OF SIXBIT MACHINE NAME. + CAIE A,0 ;ON ITS, ONLY WORD 0 IS NONZERO. IT'S THE "MACHINE NAME". + JRST CABPOP + SYSCAL SSTATU,[MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A] + .LOSE 1000 + JRST CLBPOP +] ;END IFN ITSSW + +OINITL: IFN ITSSW,[ + HLLZ A,@(P) ;GET CHNL NUM, + TLZ A,777037 ;MASK TO JUST AC FIELD (CHNL NUM) + IOR A,[.STATUS A] + XCT A ;READ ITS STATUS, +] + PUSHJ P,OPNER ;TYPE OUT REASON FOR OPEN FAILURE, + TYPR OINITS + PUSHJ P,GTYIP ;GET TYPEIN + HRLZ A,@(P) ;REPLACE '_MIDAS' WHATEVER BY ACTUAL NAMES. + PUSHJ P,A.IMP1 + PUSHJ P,RFD ;GET NEW FILE DESCRIPTION + HRRZ A,@(P) ;GET NAME BLOCK ADDR, + MOVEI B,3(A) + HRLI A,DNAM ;COPY NAMES JUST READ INTO IT. + BLT A,(B) + JRST OINIT + +OINITS: ASCIZ/Use what filename instead? / + +IFN DECSW,[ +OINIT: MOVE AA,(P) + MOVS A,(AA) ;GET NAME-BLOCK ADDR IN LH, + HRLZ TT,A ;GET CHNL NUM IN LH. + TLZ TT,#(0 17,) ;MASK TO AC FIELD (CHANNEL NUM) + HRRI A,DNAM + BLT A,SNAM ;COPY NAMES INTO DNAM THRU SNAM. + HRRZ D,2(AA) ;GET BUFFER SPACE ADDR. + HLLZ C,2(AA) ;GET HEADER ADDR. + HLRZ A,C + SETZM (A) ;CLEAR OUT ITS-VERSION CONTENTS OF 1ST HEADER WD. + LDB A,[331100,,(AA)] ;GET MODE TO OPEN IN (WILL BE ASCII OR IMAGE BINARY) + CALL OPNRD2 ;DO OPEN. + JRST OINITL +IFE SAILSW,[SAVE .JBFF + MOVEM D,.JBFF] +.ELSE [SAVE JOBFF + MOVEM D,JOBFF] + XOR TT,[#] + XCT TT +IFE SAILSW,REST .JBFF +.ELSE REST JOBFF + MOVE A,[SIXBIT /000MD /] + PJOB B, ;GET JOB NUMBER, TO MAKE SIXBIT /MD/ + JFCL ;CAN IT SKIP? + IDIVI B,10. + DPB C,[220400,,A] + IDIVI B,10. + DPB C,[300400,,A] ;PUT THE DIGITS OF THE JOB NUMBER INTO THE SIXBIT WORD. + DPB B,[360400,,A] + MOVE AA,(P) + LDB B,[360600,,1(AA)] ;GET 1ST CHAR OF 'OUTPUT, 'LSTOUT, 'CRFOUT, 'ERROUT. + IOR A,B ;USE IT AS LAST CHAR OF TEMP FILE NAME. + MOVSI B,'TMP + SETZ C, + MOVE D,SNAM + XOR TT,[#] + XCT TT ;DO ENTER UTYOC,A + JRST OINITL +POPJ3: AOS (P) +POPJ2: AOS (P) + JRST POPJ1 + +;CLOSE AN OUTPUT FILE, SEE NON-DEC VERSION FOR ARGS. +OCLOSE: MOVE AA,1(A) ;NAME BLOCK ADDR. + SKIPGE FATAL + JRST OCLOS2 + MOVE C,(AA) ;DELETE ANY FILE WITH NAMES + SETZB B,D ;WE WANT TO RENAME TO. + OPEN ERRC,B + JRST OCLOS1 + MOVE B,1(AA) + HLLZ C,2(AA) + SETZ D, + MOVE T,3(AA) + LOOKUP ERRC,B + JRST OCLOS1 ;THERE IS NONE, JUST RENAME. + SETZ B, + MOVE T,3(AA) + RENAME ERRC,B + JFCL + RELEAS ERRC, +OCLOS1: MOVE B,1(AA) ;DESIRED FN1. + HLLZ C,2(AA) ;DESIRED FN2. + SETZ D, + MOVE T,3(AA) ;SNAME (THAT IS, PPN) + HLLZ AA,(A) ;GET JUST CHNL NUM. + IOR AA,[CLOSE] + XCT AA + XOR AA,[CLOSE#] + XCT AA + JFCL +OCLOS2: HLLZ B,(A) ;GET CHNL IN AC FIELD. + IOR B,[RELEAS] + XCT B + JRST 2(A) + +;WRITE OUT BUFFER OF OUTPUT FILE, C HAS <0 CHNL,HEADER> +OBUFO: AND C,[0 17,] ;GET JUST CHNL NUM. + TLO C,(OUT) + XCT C + RET + SAVE A ;ERROR RETURN FROM OUT UUO. + XOR C,[OUT#] + XCT C ;READ FILE STATUS. + TRZ A,74^4 ;CLEAR ERROR BITS. + ETR [ASCIZ /Output data error/] + XOR C,[#] + XCT C + JRST POPAJ + +TFEED: RET + +TSRETN: MOVE C,[SIXBIT /MIDAS/] + SKIPE MORJCL + JRST RFDRUN + EXIT + +A.SITE: +IFE SAILSW,[ + CALL AGETFD ;.SITE ON DEC SYSTEM; VALUE HAS BEEN PRECOMPUTED NTO V.SITE. + CAIL A, + CAIL A,5 + JRST CABPOP + MOVE A,V.SITE(A) + JRST CLBPOP +];END IFE SAILSW +.ELSE JRST CABPOP ;SAIL DOESN'T HAVE GETTAB USED IN SETTING UP V.SITE. + +;DEVICE NAME IN B, MODE IN A, +;HEADER ADDR IN C, BUFFER SPACE ADDR IN D, +;CREAT DEC-STYLE BUFFER RING LEAVING 1 WD BETWEEN BUFFERS. +BUFINI: MOVEI AA,A +IFE SAILSW,DEVSIZ AA, + SKIPA AA,[204] ;DEFAULT BUFFER SIZE IS THAT FOR DSK. + AOJLE AA,.-1 ;GET SIZE INCLUDING EXTRA WD. + MOVEI T,1(D) ;ADDR OF WD 2 OF 1ST BUFFER. + HRLI AA,T ;@AA IS ADDR OF 2ND WD OF NEXT BUFFER. + SUBI D,(AA) ;FACILITATE TEST FOR END OF BUFFER SPACE. + HRLI T,400000 + MOVEM T,(C) ;HEADER -> A BUFFER, SIGN SET. + HRRM T,1(C) ;MAKE RH OF BP -> BUFFER 1ST WD. + MOVSI T,440000 ;SET UP P-FIELD OF B.P. + IORM T,1(C) + HRRZ T,1(C) + AOS 1(C) + HRLI T,-3(AA) ;DATA-AREA-SIZE +1,,ADDR-OF-2ND-WD +BUFIN1: CAIGE D,-410(T) ;ROOM FOR ANOTHER AFTER THIS BUFFER? + JRST BUFIN2 ;NO, ASSUMING 410 WDS BUFFERRrSPACE. + MOVEM T,@AA ;YES, MAKE NEXT BUFFER -> THIS ONE, + HRRI T,@AA ;POINT TO NEXT ONE. + JRST BUFIN1 + +BUFIN2: ADDI D,1(AA) ;-> 2ND WD OF 1ST BUFFER. + MOVEM T,(D) ;1ST BUFFER -> LAST, MAKING RING. + RET + +;CLOSE ALL INPUT CHANNELS - EQUIVALENT TO ITS .IOPDL. +$IOPDL: MOVEI A,UTYIC + EXCH A,UTICHN ;SET INPUT CHNL NUM. TO LOWEST. + LSH A,27 + IOR A,[RELEAS] ;SET UP TO RELEAS THE HIGHEST IN USE FIRST. +IOPDL1: XCT A ;RELEAS ONE INPUT CHANNEL, + CAMN A,[RELEAS UTYIC,] + RET ;ALL DONE. + SUB A,[0 1,] + JRST IOPDL1 ;RELEAS THE NEXT ONE DOWN. + +.IOPDL==CALL $IOPDL +] ;END IFNN DECSW, + + ;TS INPUT ROUTINES + + ;OPEN MAIN INPUT FILE FOR READING + +OPNRD: .IOPDL ;RE-INITIALIZE IO PDL + INSIRP SETZM,INFCNT INFCUR INFERR + MOVE A,[-TYPDLS-1,,TTYPDL] + MOVEM A,ITTYP ;INITIALIZE "TTY PDL" + PUSHJ P,MACIN1 ;CLOBBER MACRO EXPANSION STATUS + MOVS A,IFDS ;GET DEVICE NAME + CAIN A,(SIXBIT /TTY/) ;TTY? + JRST OPNRDT ;YES, TREAT SPECIAL + MOVSI A,IFDS ;NOT TTY, TRY OPENING FILE + PUSHJ P,A.IMP1 ;SET UP DNAM, ETC. + PUSHJ P,OPNRD1 ;TRY OPENING FILE + JRST OPNRDL ;LOSE + MOVEM A,INFERR ;ERR MSG IN MAIN FILE SHOULDN'T TYPE NAMES. + MOVEI A,0 ;=> INPUT FROM FILE +OPNRT2: MOVE T,[IFNM1,,RFNAM1] + BLT T,RFNAM2 ;SET UP .FNAM1, .FNAM2 + SETOM NEDCRL + JRST RCHSET ;SET UP TO READ FROM FILE OR TTY. (ARG IN A) + +OPNRDT: MOVE A,[IFDS+1,,IFNM1] ;TTY SPECIFIED, TREAT SPECIAL + BLT A,IFNM2 ;CLOBBER .IFNM1, .IFNM2 TO SPECIFIED + TYPR [ASCIZ /Reading from TTY: +/] + MOVEI A,3 ;=> INPUT FROM TTY, DON'T QUIT ON CR + JRST OPNRT2 + +OPNRDL: PUSHJ P,IOPNER ;.OPEN LOST, TYPE OUT MESSAGE + JRST GO2A ;READ NEW COMMAND + + +;COMMON STUFF FOR OPNRD1 IN DEC AND ITS VERSIONS. +OPNRD3: HRRZM A,UTIBED ;SAY BUFFER EMPTY, + MOVSI A,^C_13 + MOVEM A,@UTIBED ;CAUSE IMMEDIATE RELOAD. + MOVE A,[INFDEV+1,,IFNM1] + BLT A,IFNM2 ;SET UP .IFNM1, .IFNM2. + AOS A,INFCNT ;ASSIGN THIS FILE A NUMBER. + MOVEM A,INFCUR ;OPNRD EXPECTS THIS LEFT IN A. + JRST POPJ1 + + ;EOF WHILE TRYING TO READ CHARACTER + +RPAEOF: PUSH P,B ;SAVE B +RPAEO1: MOVE B,ITTYP ;GET PDL POINTER + PUSHJ P,BPOPJ ;CALL POP ROUTINE (MAYBE NED'S OUT) + JRST RCHTRB ;RETURN TO GET CHARACTER + + ;EOF FROM MAIN FILE + +NEDCHK: TRNE FF,FRCMND ;^C READ IN COMMANND, :KILL SELF. + JRST TSRETN + SKIPE RCHMOD + JRST NEDCH1 + AOSN NEDCRL ;INVENT ONE CRLF AFTER END OF MAIN FILE. + JRST [ MOVE B,[440700,,[.BYTE 7 ? ^M ? ^J ? ^C]] + MOVEM B,UREDP + RET] +NEDCH1: +IFN A1PSW,[ PUSHJ P,OUTCHK + MOVSI A,-LNEDT + XCT NEDT(A) ;SKIPS IF NED CONDITION TO BE COMPLAINED ABOUT + AOBJN A,.-1 + JUMPGE A,GO4 +] + ETF [ASCIZ /No END statement/] + +IFN A1PSW,[ ;HOLLER "NED" IF ANY OF THE FOLLOWING: +NEDT: SKIPL PRGC ;NO END STATEMENTS HAVE BEEN ENCOUNTERED + SKIPGE OUTC ;OUTPUT HAS OCCURED NOT MATCHED BY AN END STATEMENT + SKIPGE OUTN1 ;OUTPUT HAS OCCURED OTHER THAN IN 1PASS MODE + TRNN FF,FRPSS2 ;CURRENTLY IN PASS 2 +LNEDT==.-NEDT ;LENGTH OF TABLE +] + +IFN ITSSW,[ + ;TRY .OPENING INPUT FILE (DESCRIPTION IN DNAM, ETC.) SKIPS IF SUCCESSFUL + +OPNRD1: MOVE A,[2,,UTYIC] ;MODE,,CHANNEL. + .CALL OPENB + JRST OPNRD2 ;CAN'T OPEN INPUT FILE. + MOVE AA,[UTYIC,,A] + .RCHST AA, + SKIPN B ;GET SYSTEM FILE NAME 1 + MOVE B,FNAM1 ;SYSTEM DOESN'T KNOW, USE SPEC'D. + SKIPN C ;NOW SAME FOR FN2. + MOVE C,FNAM2 + MOVE AA,[A,,INFDEV] + BLT AA,INFDEV+3 ;REMEMBER NAMES OF CURRENT INPUT FILE. + HRLZS INFDEV ;MAKE THE DEV NAME BE LEFT-JUST. + MOVE A,IUREDP ;SET UP READING PTR, + MOVEM A,UREDP + JRST OPNRD3 ;SET UP ^C AFTER BUFFER, INFCUR, ETC. + +OPNRD2: .STATUS UTYIC,IFSTS ;.OPEN LOST, GET CHANNEL STATUS NOW BEFORE POSSIBLE .IOPOP + POPJ P, + +OPENB: SETZ ? SIXBIT/OPEN/ + A ;SHOULD HOLD MODE,,CHANNEL. + DNAM ? DNAM+1 ? DNAM+2 ? SETZ SNAM + +IUREDP: 440700,,UTIBUF + + ;EOFCH ENCOUNTERED ON READ, RELOAD AND JUMP BACK FOR NEXT CHAR + +INCHR3: HRRZ A,UREDP ;GET BYTE POINTER + CAME A,UTIBED ;END OF COMPLETELY READ BLOCK? + JRST RPAEOF ;NO => REALLY EOF + MOVE A,IUREDP + MOVEM A,UREDP + MOVE A,[-UTIBFL,,UTIBUF] + .IOT UTYIC,A ;READ IN BLOCK + TLZ A,377777 ;CLEAR OUT @, INDEX FIELDS, ALSO ALL BUT SIGN JUST FOR LAUGHS + MOVEM A,UTIBED ;STORE RH (UPDATED POINTER) FOR EOF CHECK AT INCHR3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ;STORE EOF WORD + JRST RCHTRA ;NOW TRY NEXT CHAR +] ;END IFN ITSSW + +IFN DECSW,[ +OPNRD1: MOVEI C,UTIHDR ;OPEN THE INPUT FILE W/ NAMES IN DNAM ... SNAM. + SETZ A, ;MODE ASCII. + MOVEI D,UTIBUF + MOVE TT,UTICHN ;GET CHANNEL NUM. TO USE. + LSH TT,27 ;PUT IN AC FIELD. + CALL OPNRD2 ;DO OPEN. + RET ;FAILED. + CALL BUFINI ;INITIALIZE THE INPUT BUFFERS AND HEADER. + MOVE D,SNAM + MOVE A,FNAM1 + HLLZ B,FNAM2 + TLC TT,(OPEN#LOOKUP) + XCT TT ;LOOKUP CHANNEL,A + RET ;FAILED. +IFE SAILSW,[ + MOVE A,DNAM + DEVNAM A, ;GET REAL NAME OF DEVICE. + CAIA + MOVEM A,DNAM +] + MOVE A,[DNAM,,INFDEV] + BLT A,INFDEV+3 + MOVE A,UREDP + JRST OPNRD3 + +;TAKE C -> HEADER, D -> BUFFER SPACE, A HAS MODE, TT HAS CHNL IN AC FLD. +;OPEN FILE IN DNAM ... SNAM, INIT BUFFERS, +;THEN SET UP FOR LOOKUP OR ENTER. +;SKIP IF SUCCEED. +OPNRD2: IOR TT,[OPEN A] + MOVE B,DNAM + XCT TT ;OPEN CHANNEL,A + RET + JRST POPJ1 + +;RELOAD BUFFER, DEC STYLE. +INCHR3: HRRZ A,UREDP ;EOF AT END OF BUFFER? + CAME A,UTIBED + JRST RPAEOF ;NO, EOF, ^C IN FILE. + SAVE B + MOVE A,UTICHN + LSH A,27 ;CHANNEL NUM. N AC FLD. + TLO A,(IN) + XCT A ;GET NEXT BUFFERFULL. + CAIA ;SUCCEED. + JRST INCHR4 ;ERROR. +INCHR5: MOVE A,UTICNT + ADDI A,9 + IDIVI A,5 + ADD A,UREDP ;-> 1ST WD NOT READ INTO. + HRRZM A,UTIBED + HRRZ A,UREDP + AOS A + MOVEI B,1 ;SCAN THE FILE AND REPLACE ALL LINE NUMBERS WITH NULLS. +INCHR6: CAMN A,UTIBED + JRST INCHR7 + TDNE B,(A) + MOVEM B,(A) + AOJA A,INCHR6 + +INCHR7: MOVSI B,^C_13 + MOVEM B,(A) ;PUT EOF CHAR AFTER BUFFER. + JRST RCHTRB ;RETRY RCH. + +INCHR4: XOR A,[#IN] + XCT A + TRZE B,74^4 + ETR [ASCIZ /Input data error/] + XOR A,[#] + XCT A ;CLEAR ERROR BITS IN STATUS. + TRNN B,2^4 + JRST INCHR5 + JRST RPAEO1 ;EOF. +] ;END IFN DECSW, + + ;IO PDL ROUTINES FOR INPUT FILE + ;PUSH THE INPUT FILE + +IPUSH: AOSN CMEOF ;WANT TO POP OUT OF TTY? (^C TYPED IN) + CALL POPTT ;YES, DO NOW BEFORE FORGET. + MOVE D,UREDP ;GET INPUT BYTE POINTER +IFN ITSSW,[ + .IOPUS UTYIC, + TLNN D,760000 ;AT END OF WORD? + ADD D,[430000,,1] ;YES, MAKE IT POINT TO BEGINNING OF NEXT WORD + MOVEM D,UREDP + MOVNI A,-2(D) + ADD A,UTIBED ;GET # WDS WE'LL NEED IN MACTAB. + HLR D,UTIBED ;REMEMBER WHETHER EOF ON LAST .IOT. + HRRZS UTIBED ;NOW CLEAR OUT LEFT HALF FOR FOLLOWING +] +IFN DECSW,[ + AOS A,UTICHN ;DO ".IOPUSH" - USE NEXT CHANNEL. + LSH A,27 + ADD A,[WAIT-<0 1,>] + XCT A ;DON'T MOVE BUFFERS WHILE IO GOING ON! + MOVEI A,UTIBFL+2 ;ASSUME MUST SAVE ALL BUFFER SPACE. +] + SAVE A + ADD A,FREPTB + ANDI A,-1 + CAML A,MACTND ;NO ROOM IN MACTAB => GC IT. + CALL GCA1 + MOVEI A,370 + CALL PUTREL ;INDICATE START OF SAVED BUFFER. + REST A + AOS B,FREPTB + SUBI A,1 + MOVE C,ITTYP ;GET ADDR OF TTY PDL WD THAT'LL POINT TO SAVED BUFFER. + ADDI C,1 + HRRZM C,(B) ;STORE IN RH OF 1ST WD, + MOVEI C,(B) ;REMEMBER ADDR OF SAVED BUFFER TO PUSH ON TTYPDL. + HRLM A,(B) ;PUT LENGTH IN LH. + AOS B +IFN ITSSW,HRL B,UREDP ;ILH _ ADDR OF 1ST WD TO SAVE. +IFN DECSW,HRLI B,UTIBUF + ADDI A,-2(B) ;ADDR OF LAST WD TO BLT INTO. + BLT B,(A) + HRLI A,041000 + MOVEM A,FREPTB ;MAKE FREE BP -> LAST BYTE JUST USED. + SUB A,MACTAD + ANDI A,-1 + LSH A,2 + ADDI A,4 ;GET CHAR ADDR OF NEXT FREE BYTE. + MOVEM A,FREEPT + MOVE B,ITTYP ;GET LOCAL VERSION OF IOPDL +IPSHP: PUSH B,C ;PUSH -> SAVED BUFFER (GC WILL RELOCATE) +IFN DECSW,PUSH B,UTIBED +IFN DECSW,PUSH B,UTIHDR +REPEAT 4,PUSH B,INFDEV+.RPCNT ;SAVE NAMES OF INPUT FILE. + PUSH B,INFCUR ;SAVE NUMBER OF INPUT FILE. + PUSH B,D ;LH=LH(OLD UREDP), RH=LH(OLD UTIBED) + ;FOLLOWING TWO MUST BE LAST PUSHED + INSIRP PUSH B,[IFNM1 IFNM2] ;CLOBBERED ON PDL IF .OPEN SUCCESSFUL +INPDEL==.-IPSHP ;LENGTH OF EACH ENTRY ON PDL + MOVE A,FREEPT ;W MUST USE SAME GC CONVENTION AS PUTREL; + CAML A,MACHI ;NAMELY, GC AFTER USING UP THE LAST BYTE. + CALL GCA1 + MOVEI A,0 ;=> INPUT FROM FILE + MOVEM B,ITTYP ;STORE BACK UPDATED POINTER + JSP B,PUSHTT ;SAVE STUFF, ADDRESS MODIFY AND RETURN + ;POP INTO THE INPUT FILE +IPOP: +IFN CREFSW,[ MOVEI A,2 ;IF CREFFING, OUTPUT POP-FILE BLOCK. + SKIPE CRFONP + PUSHJ P,CRFOUT] +IPOPL: PUSHJ P,POPTT ;COME HERE IF .INSRT'S OPEN FAILED. + SAVE C + MOVE B,ITTYP ;GET POINTER + INSIRP POP B,[IFNM2 IFNM1 A] ;POP STUFF + POP B,INFCUR +REPEAT 4,POP B,INFDEV+3-.RPCNT +IFN DECSW,[ + POP B,C + SAVE C ;OLD UTIHDR + POP B,UTIBED +] + POP B,C + MOVEM B,ITTYP ;SAVED UPDATED PDL POINTERR. + HLRZ B,(C) ;GET LENGTH OF SAVED BUFFER, +IFN ITSSW,[ + SAVE A + CALL SETWH2 + REST A + .IOPOP UTYIC, + MOVEI AA,UTIBUF-1(B) ;GET ADDR OF 1ST WD WON'T BLT INTO IN UTIBUF, + HRLI AA,(A) ;GET SAVED LH OF UTIBED, + MOVEM AA,UTIBED + HRRI A,UTIBUF ;MAKE A -> 1ST WD IN BUFFER, +] +IFN DECSW,[ + MOVE AA,UTICHN + LSH AA,27 + IOR AA,[RELEAS] + XCT AA ;THIS CODE EQUIVALENT TO .IOPOP. + SOS UTICHN + REST UTIHDR +] + MOVEM A,UREDP + MOVSI A,^C_13 + MOVEM A,@UTIBED ;PUT EOF CHAR AFTER BUFFER. + MOVSI A,1(C) ;GET ADDR OF 1ST DATA WD OF SAVED BUFFER, + HRRI A,UTIBUF + CAIE B,1 + BLT A,UTIBUF-2(B) + HLLZS (C) ;TELL GC TO RECLAIM SAVED BUFFER. +POPCJ: REST C + RET + + ;SAVE INTERNAL POINTERS CONCERNING INPUT MODE + +TYPDEL==2 ;NUMBER OF WORDS IN RELEVANT PDL ENTRY + +PUSHTT: PUSH P,A + PUSH P,F + AOSN CMEOF ;IF SUPPOSED TO POP OUT OF TTY SOON, + CALL POPTT ;DO IT NOW BEFORE CMEOF CLOBBERED. + MOVE F,ITTYP ;GET RELEVANT PDL POINTER + MOVEI A,0 + EXCH A,CLNN ;SET UP NEW LINE NUMBER + HRL A,CPGN ;SAVE CURRENT PAGE NUMBER + SETZM CPGN ;NOW RE-INITIALIZE + SKIPGE CRFILE ;SAVE CREF-ALL-ON-ONE-LINE FLAG. + TLO A,400000 + PUSH F,A ;SAVE CPGN,,CLNN + MOVE A,-1(P) ;RETRIEVE NEW MODE + PUSHJ P,PSHLMB ;SAVE LIMBO1 AND SET UP INSTRUCTIONS FOR NEW MODE +IFN ITSSW,[ + CALL SETWH2 + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ;STORE BACK UPDATED POINTER + JRST POPFAJ + + ;RESTORE INTERNAL POINTERS CONCERNING INPUT MODE + +POPTT: PUSH P,A + PUSH P,F + MOVE F,ITTYP ;GET PDL POINTER + PUSHJ P,POPLMB ;POP INTO LIMBO1, SET UP NEW MODE + POP F,A ;GET CPGN,,CLNN + SETZM CRFILE ;RESTORE ALL-ON-ONE-LINE FLAG. + TLZE A,400000 + SETOM CRFILE + HLRZM A,CPGN + HRRZM A,CLNN +IFN ITSSW,[ + CALL SETWH2 + ADD A,CPGN + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ;STORE BACK UPDATED POINTER + JRST POPFAJ + +IFN ITSSW,[ +SETWH2: MOVE A,RCHMOD + CAIL A,2 + SKIPA A,[SIXBIT /TTY:/] + MOVE A,INFFN1 + .SUSET [.SWHO2,,A] + MOVE A,A.PASS + LSH A,30 + ADD A,[SIXBIT /P0/+1] + RET +] + + ;TTY ROUTINES + + ;CAUSE INPUT FROM TTY (MAIN ROUTINES) + +GTYIPA: ;PUSH TO TTY, DON'T STO@ AT CR. + SETZM A.TTYF +IFN ITSSW,[ TYPR [ASCIZ/TTY: .INSRTed, end input with ^C +/] ] +.ELSE [ IFE SAILSW,[ TYPR [ASCIZ/TTY: .INSRTed, end input with ^Z +/] ] + .ELSE [ TYPR [ASCIZ /TTY: .INSRTed, end input with CTL-META-LF +/] ]] +GTYIP1: SKIPA A,[3] +GTYIP: MOVEI A,2 ;INPUT FROM TTY, STOP AFTER 1 LINE. + SETZM CMPTR ;FORCE RELOAD ON 1ST READ. + JSP B,PUSHTT ;SET UP VARIABLES AND RETURN +GTYIPR: SETZM CMPTR ;RETURN ON .INEOF OR CR + JRST POPTT + +;CALL HERE FROM ASSEM1 LOOP WHEN A ^H INTERRUPT IS DETECTED. +TTYBRK: SETZM A.TTYF + ETR [ASCIZ/^H - break /] ;TYPE FILENAME, PAGE AND LINE #. + SKIPE ASMOUT + TYPR [ASCIZ/within a <>, () or [] +/] + JRST GTYIPA + + ;RCHSET ROUTINES FOR READING FROM TTY + ;RCHMOD=3 => DON'T QUIT ON CR + ;2 => QUIT ON CR. + +RCHTRC: +RCHARC: TLO FF,FLTTY ;SET FLAG + JSP A,CPOPJ +RCHAC1: REPEAT 2,[ ;RCH2, RR1 + ILDB A,CMPTR ;GET CHAR + CAIN A,0 ;END OF STRING MARKED WITH 0 + PUSHJ P,TYRLDR ;RELOAD, JUMP BACK FOR NEXT CHAR +] + HALT ;RRL1 +IFN .-RCHAC1-RCHPSN,.ERR RCHAC1 LOSES. + ILDB A,CMPTR ;SEMIC + CAIN A,15 + JRST SEMICR + JUMPN A,SEMIC + PUSHJ P,TYRLD + JRST SEMIC + +TYRLD: MOVEI A,3 ;RETURN AFTER THE CALL, NOT BEFORE. + ADDM A,(P) + + ;READ IN STRING + +;RELOAD BUFFER IF RAN OUT IN CALL TO RCH. +TYRLDR: AOSN CMEOF ;EOF DETECTED AFTER LAST RELOAD => + JRST RPAEOF ;POP OUT OF TTY. + SAVE A + SAVE B + MOVE B,RCHMOD + PUSH P,F + SAVE A.TTYF ;IF CHARS RUBBED OUT THEY SHOULD BE PRINTED. + SETZM A.TTYF + MOVE F,[10700,,CMBUF-1] ;INITIAL BYTE POINTER TO BUFFER + MOVEM F,CMPTR ;STORE AS BYTE POINTER FOR READ +TYRLD2: PUSHJ P,TYI ;GET CHARACTER + CAIN A,177 ;RUBOUT? + JRST TYRLD3 ;YES + CAIE A,^C + CAIN A,^Z + JRST TYRLD7 ;^C, ^Z => EOF. + CAIN A,^U + JRST TYRLD5 ;RUB OUT ALL + CAIE B,2 ;FOR .TTYMAC HANDLING, CONVERT LOWER CASE TO UPPER. + JRST TYRLD6 + CAIL A,"A+40 + CAILE A,"Z+40 + CAIA + SUBI A,40 +TYRLD6: IDPB A,F ;STORE CHARACTER IN BUFFER + CAIE A,^M ;CR? + JRST TYRLD2 ;NO, GO BACK FOR NEXT + CAIN B,2 ;.TTYMAC (MODE 2) => CR ENDS INPUT, SO FAKE EOF. + SETOM CMEOF + MOVEI A,^J ;FOLLOW THE CR WITH A LF. + IDPB A,F + SAVE F ;OUTPUT THE ENTIRE LINE TO THE ERROR FILE + MOVE F,[10700,,CMBUF-1] +TYRLD8: CAMN F,(P) + JRST TYRLD9 + ILDB A,F + CAIN A,^M ;IF LINE WAS ENDED BY A ^C OR ^Z, PUT THAT IN ERROR + SKIPL CMEOF ;FILE, WHICH NEEDS HAIR SINCE THAT CHAR IS NOT + JRST TYRLD0 ;IN THE STRING WE STORED. + MOVEI A,"^ + CALL ERRCHR + MOVEI A,IFN DECSW,["Z] .ELSE "C + CALL ERRCHR + LDB A,F +TYRLD0: CALL ERRCHR + JRST TYRLD8 + +TYRLD9: REST F + MOVEI A,0 + IDPB A,F ;MARK END OF STRING + IDPB A,F + REST A.TTYF + REST F + REST B + REST A + JRST RCHTRA + +TYRLD7: SETOM CMEOF ;^C, ^Z FORCE EOF, + CALL TYRLCR ;AFTER TURNING INTO ^M. + MOVEI A,^M + JRST TYRLD6 + +TYRLCR: MOVEI A,^M + CALL TYOX + MOVEI A,^J + JRST TYOX + +TYRLD3: CAMN F,[10700,,CMBUF-1] ;RUBOUT, BEGINNING OF BUFFER? + JRST TYRLD4 ;YES + LDB A,F ;GET LAST CHARACTER IN BUFFER + CALL TYOX ;TYPE IT OUT, DON'T WRITE IN ERROR FILE. + ADD F,[70000,,] ;DECREMENT POINTER + JUMPGE F,TYRLD2 ;JUMP IF VALID + SUB F,[430000,,1] ;WAS 440700,,SOMETHING, BACK IT UP + JRST TYRLD2 + +TYRLD5: MOVE F,[10700,,CMBUF-1] ;^U, BACK TO BEGINNING OF LINE +TYRLD4: PUSHJ P,TYRLCR ;RUBOUT WHEN AT BEGINNING OF BUFFER, TYPE CR + JRST TYRLD2 + +IFN ITSSW,[ ;GET (JUST TYPED IN) CHAR IN A +OUTCHR==.IOT TYOC, + +TYI: SKIPN TTYOP + CALL TTYINI ;OPEN THE TTY IF NOT ALREADY DONE. + .IOT TYIC,A + JUMPE A,TYI + CAIN A,^L + JRST TYI + POPJ P, + + ;INITIALIZE TTY + +TTYINI: SAVE A + .OPEN TYIC,[SIXBIT / TTYMIDAS TYI/] ;INPUT, CONVERT LOWER CASE TO UPPER + .LOSE + .OPEN TYOC,[21,,SIXBIT / TTYMIDAS TYO/] ;DISPLAY MODE OUTPUT + .LOSE + SYSCAL CNSGET,[1000,,TYOC ? 2000,,A ? 2000,,A] + MOVSI A,1 ;TTY: IS TRANSLATED TO SOMETHING ELSE => ASSUME INFINITE LINEL + MOVEM A,LINEL ;ELSE LINEL GETS WIDTH OF TTY. + SETOM TTYOP ;SAY THE TTY IS NOW OPEN. + JRST POPAJ + +JCLINI: .SUSET [.ROPTIO,,A] + TLNN A,40000 ;HAS OUR SUPERIUOR SAID IT HAS A CMD? + RET ;NO. + MOVE A,[CMBUF,,CMBUF+1] + BLT A,CMBUF+CMBFL-2 ;ZERO ALL BUT LAST WD, + MOVEM A,CMBUF+CMBFL-1 ;NONZERO LAST WD. + .BREAK 12,[5,,CMBUF] ;TRY TO READ COMMAND STRING. + MOVE A,[440700,,CMBUF] + SKIPE CMBUF ;IF READ A CMD-STRING, + MOVEM A,CMPTR ;TELL TYRLD, GO2 IT'S THERE. + POPJ P, + +;JRST HERE FROM TSINT FOR 2ND WD INTERRUPTS. +TTYINT: SAVE A + MOVEI A,TYIC ;THE TTY CHNL IS THE ONLY ONE ENABLED. + .ITYIC A, + JRST TTYINX ;NO INT. CHAR. + CAIN A,^W + AOS A,TTYFLG ;^W SILENCES, + CAIN A,^V + SOS A,TTYFLG ;^V UNSILENCES, + CAIN A,^H + SETOM TTYBRF ;^H SAYS BREAK NEXT TIME THRU ASSEM1 LOOP. +TTYINX: REST A + .DISMIS .JBTPC +] ;END IFN ITSSW + +IFN DECSW,[ +TYI: SKIPN TTYOP ;OPEN THE TTY, IF NOT ALREADY DONE. + CALL TTYINI + INCHWL A +IFN SAILSW,[ + CAIN A,612 ;SAIL => EOF IS 612. SO TURN INTO NORMAL EOF. + MOVEI A,^Z +] + CAIE A,^M ;THROW AWAY THE LF AFTER A CR + RET + INCHWL A + MOVEI A,^M ;NOTE THAT TYRLDR WILL PUT IT BACK IN. + RET + +TTYINI: OPEN TTYINB + JRST TTYINI + INSIRP PUSH P,AA A B +IFE SAILSW,[ + PJOB A, + TRMNO. A, + JRST TTYIN1 + MOVEI AA,1012 ;.TOWID + MOVE B,[2,,AA] + TRMOP. B, ;READ WIDTH OF TTY LINE INTO B. +] +TTYIN1: MOVEI B,80. ;TRMOP. FAILED OR NOT TRIED => ASSUME WIDTH IS 80. + MOVEM B,LINEL + INSIRP POP P,B A AA + SETOM TTYOP + RET + +TTYINB: 1 + 'TTY,, + 0 + +TTYREN: IFE SAILSW,LOC .JBREN +.ELSE LOC JOBREN +TTYREN +LOC TTYREN + SETOM TTYBRF ;"REENTER" COMMAND COMES HERE +R: G: IFE SAILSW,JRST @.JBOPC ;TO REQUEST A ^H-BREAK. +.ELSE JRST @JOBOPC +] + +TAB: MOVEI A,^I +TYO: SKIPG A.TTYF + CALL TYOX +ERRCHR: IFN ERRSW,[ + SKIPN ERRFOP ;OUTPUT CHAR IN A TO ERROR FILE IF ONE IS OPEN. + RET + SOSGE ERRCNT + JRST ERRCH1 ;OUTPUT BUFFER. + IDPB A,ERRPNT + RET + +ERRCH1: SAVE C + MOVE C,[0 ERRFC,ERRHDR] + CALL OBUFO + REST C + JRST ERRCHR +]IFE ERRSW,RET + +TYOX: SKIPN TTYOP + CALL TTYINI + OUTCHR A + RET + +IFN DECSW,[ + +JCLINI: SKIPN CCLFLG ; WAS MIDAS CALLED FROM CCL LEVEL? + RET ; NO, DO NOT SNARF TEMPCORE + SETZM CCLFLG ; IF TMPCOR LOSES WANT THIS 0 (WILL RE-SETOM BELOW) + SETZM CMBUF ; ZERO FIRST COMMAND WORD + MOVE A,[CMBUF,,CMBUF+1] ; LOAD BLT POINTER + BLT A,CMBUF+CMBFL-2 ; ZERO ALL BUT LAST WORD + MOVEM A,CMBUF+CMBFL-1 ; NON-ZERO LAST WORD + MOVE A,[2,,['MID,, ? -CMBFL,,CMBUF-1]] + TMPCOR A, ; READ COMPIL-GENERATED COMMAND + RET ; NO COMMAND, PUNT + MOVE A,[440700,,CMBUF] ; LOAD A BYTE POINTER TO THE COMMAND + SKIPN CMBUF ; ONE LAST CHECK FOR IT TO BE THERE + RET ; ALAS, THERE IS NONE + SETOM CCLFLG + MOVEM A,CMPTR ; THERE IS, SET COMMAND POINTER + SAVE B +JCLIN1: ILDB B,A + CAIE B,^J ;SEE IF OUR COMMAND FILE HAS ANYTHING AFTER 1ST LINE. + JRST JCLIN1 + ILDB B,A + JUMPE B,POPBJ + SETOM MORJCL ;IT DOES; SET FLAG SO AFTER HANDLING 1ST LINE WE'LL + SAVE C + MOVE C,[440700,,UTIBUF+2] +JCLIN2: IDPB B,C + ILDB B,A + JUMPN B,JCLIN2 + SUBI C,UTIBUF+1 ;GET # WORDS WRITTEN IN UTIBUF. OPERAND IS RELOCATABLE! + HRLOI C,-1(C) ;THESE 2 INSNS TURN SIZE INTO -SIZE,,UTIBUF+1 + EQVI C,UTIBUF+1 + MOVEM C,(C) + MOVSI C,'MID + MOVEM C,UTIBUF + MOVE C,[3,,UTIBUF] + TMPCOR C, + JFCL + REST C + REST B + RET +];END IFN DECSW + + ;TS DATA STORAGE + +VBLK + +TYPDLS==TYPDLC*TYPDEL+INPDEL*MX.INS + ;"TTY PDL", STORES INFORMATION ABOUT CURRENT INPUT MODE + ;(SIMILAR TO MACRO PDL BUT NOT GARBAGE COLLECTED) + +ITTYP: -TYPDLS-1,,TTYPDL ;PDL POINTER (TYPDEL=LENGTH OF EACH ENTRY) +TTYPDL: NEDCHK ;ACTUAL PDL: INITIAL ENTRY TO OVERPOP ROUTINE + BLOCK TYPDLS ;PDL PROPER + + ;INPUT BUFFER AND VARIABLES + +UTIBUF: BLOCK UTIBFL +UTIHDR: 0 ;INPUT BUFFER HEADER (DEC VERSION) +UREDP: 440700,,UTIBUF ;INPUT BYTE POINTER +UTICNT: 0 ;INPUT BYTE COUNT (DEC VERSION) +UTIBED: UTIBUF ;EOF COMPARISON WITH RH(UREDP), 4.9 => EOF ON .IOT +IFSTS: 0 ;.STATUS WORD STORED BY OPNRD1 WHEN .OPEN LOSES +IFN DECSW,UTICHN: UTYIC + + ;FILE DESCRIPTION STORAGE + +INDDP: MAXIND,,FDSOFS ;POINTER INTO TABLE +FDSBEG==. ;BEGINNING OF TABLE AREA +DNAM: 0 ;DEVICE NAME +FNAM1: 0 ;FILE NAME 1 +FNAM2: 0 ;" " 2 +SNAM: 0 ;SYSTEM NAME +LFDSE==.-FDSBEG ;LENGTH OF TABLE ENTRY +IFDS: BLOCK LFDSE ;SPECIFIED INPUT FILE + 0 ;FOR .FDELE AT .FILE TIME +ONAM: BLOCK 3 ;OUTPUT DEVICE/FILENAMES SPECIFIED +OFNM1==ONAM+1 +OFNM2==ONAM+2 +OSYSNM: -1 ;SPECIFIED OUTPUT SYSTEM NAME +IFN CREFSW,[ 0 +CRFDEV: BLOCK 3 ;CREF DEV, FN1, FN2. +CRFSNM: 0 ;CREF SNAME. +] +IFN ERRSW,ERRDEV: BLOCK 4 ;ERROR OUTPUT FILE NAMES. +IFN LISTSW,[ +LSTDEV: BLOCK 3 ;LISTING FILE NAMES. +LSTSNM: 0 +] +FNMEND:: +INFDEV: 0 +INFFN1: BLOCK 3 ;FILENAMES OF INPUT FILE BEING READ NOW. +INFCNT: 0 ;# INPUT FILE OPENED. +INFCUR: 0 ;WHAT INFCNT WAS WHEN CURRENT FILE OPENED. +INFERR: 0 ;WHAT INFCUR HELD AT LAST ERROR MSG. +FDSOFS==.-FDSBEG ;OFFSET TO BEGINNING OF NON-DEDICATED AREA + BLOCK LFDSE*MAXIND ;OPEN NAMES @: FILES (AND FNF'S) +SFSFDS=.-FDSOFS ;SOURCE SPECIFIED NAMES @: FILES + BLOCK LFDSE*MAXIND ;STORAGE FOR " + +RFNAM1: 0 ;.FNAM1 +RFNAM2: 0 +IFNM1: 0 ;.IFNM1 +IFNM2: 0 +RSYSNM: 0 ;INITIAL SYSTEM NAME + +IFN CMUSW, PPNBUF: BLOCK 4 ;FOR CONVERTING CMU PPNs + +IFN DECSW,IFE SAILSW, V.SITE: BLOCK 5 ;SYSTEM NAME IN SIXBIT, FOR .SITE. + + ;TTY VARIABLES + +CMBUF: BLOCK CMBFL ;TYPEIN BUFFER +CMPTR: 0 ;BYTE POINTER TO CMBUF, CLEARED AT GO2 IF >0. +CMEOF: 0 ;-1 => POPTT INSTEAD RELOAD AFTER THIS BUFFERFULL. +IFN DECSW,MORJCL: 0 ;-1 => THERE ARE MORE LINES OF CCL COMMANDS + ;SO DO A RUN SYS:MIDAS WHEN FINISHED. +TTYOP: 0 ;-1 => THE TTY IS ALREADY OPEN. +LINEL: 0 ;WIDTH OF TTY (MAY BE 1,, MEANING ASSUME INFINITE). +A.TTYFLG: ;VALUE OF .TTYFLG: +TTYFLG: 0 ;TTY TYPEOUT PERMITTED IFF >= 0. +WSWCNT: 0 ;THE NUMBER OF W-SWITCHES IN THE LAST CMD STRING. +TTYBRF: 0 ;-1 => ^H BREAK HAS BEEN REQUESTED BUT NOT DONE. +FATAL: 0 ;AT END OF ASSEMBLY, NOT 0 IFF FATAL ERROR OCCURRED. +NEDCRL: 0 ;-1 => HAVEN'T YET SUPPLIED A CRLF AT EOF OF MAIN FILE. +NVRRUN: -1 ;0 => MIDAS WAS RUN; ERROR TO START OR PURIFY. + + ;OPNER VARIABLES + +ERRDNM: (SIXBIT /ERR/) + 3 +ERRNM2: 0 ;.STATUS WORD + +IFN ITSSW,OCLOSP: @1(C) ;TURNED INTO BP TO UNUSED PART OF LAST BFFER WD USED. + + ;OUTPUT VARIABLES + +UTOBUF: BLOCK UTOBFL ;OUTPUT BUFFER +UTOHDR: UTOBFL,,UTOBUF-1 +UTYOP: 444400,, ;OUTPUT (36. BIT) BYTE POINTER +UTYOCT: 0 ;# WORDS LEFT IN UTOBUF + +IFN CREFSW,[ ;CREF OUTPUT VARS. +CRFBUF: BLOCK CRFBSZ +CRFHDR: CRFBSZ,,CRFBUF-1 ;HEADER, ASSEMBLED VALUE USED ONLY IFN ITSSW +CRFPTR: 444400,, ;BP FOR FILLING BUFFER +CRFCNT: 0 ;NUM. CHARS. EMPTY IN BUFFER +] + +IFN LISTSW,[ +LSTBUF: BLOCK LSTBSZ +LSTHDR: 5*LSTBSZ,,LSTBUF-1 +LSTPTR: 440700,, +LSTCNT: 0 +] + +IFN ERRSW,[ +ERRBUF: BLOCK ERRBSZ +ERRHDR: 5*ERRBSZ,,ERRBUF-1 +ERRPNT: 440700,, +ERRCNT: 0 +ERRFP: 0 ;NON-0 IF WANT ERROR OUTPUT FILE. +ERRFOP: 0 ;NON-0 IF ERROR FILE OPEN (IE TRY OUTPUTTING TO IT) +] +PBLK + + ;.INSRT FILEDESCRIPTION + ;INSERT FILE HERE + ;TTY: => OK, READS LINE AT A TIME, RUBOUT ALLOWED WITHIN LINE + ;PUSHES MACRO EXPANSION, OTHER .INSRT'S + ;IN FILEDESCRIPTION, ^R => RESET FILE NAME COUNTER + +A.INSR: NOVAL + MOVEI F,IFDS-DNAM ;SET UP POINTER TO INPUT FILE NAMES + PUSHJ P,A.IMAP ;DEFAULT NAMES = INPUT NAMES + MOVSI A,(SIXBIT /DSK/) + MOVS B,DNAM + CAIN B,(SIXBIT /TTY/) ;IF INPUTTING FROM TTY, + MOVEM A,DNAM ;THEN SET DEFAULT DEVICE TO DSK INSTEAD +IFN ITSSW,MOVSI A,(SIXBIT/>/) +IFN DECSW,MOVSI A,'MID + MOVEM A,FNAM2 ;USE > AS THE DEFAULT FN2. + TLO FF,FLUNRD +A.IN1: PUSHJ P,RFD ;READ FILE DESCRIPTION + MOVS A,DNAM ;GET SPECIFIED DEVICE NAME + CAIE A,(SIXBIT /@/) ;ATSIGN? + PUSHJ P,A.ITRY ;NO, TRY OPENING FILE + MOVE A,DNAM(F) + AOJE A,A.INT1 ;ALREADY TRYING TO SET UP TABLE ENTRY + SKIPA F,[MAXIND,,FDSOFS] ;ATSIGN, OR FNF, SEARCH TABLE +A.IN2: SUBI F,-LFDSE ;LOOP POINT SEARCHING TABLE, INCREMENT TO NEXT ENTRY, COUNT DOWN LH + CAMN F,INDDP ;COMPARE WITH POINTER TO TOP OF TABLE + JRST A.IN3 ;AGREE => THIS FILE NOT IN TABLE + MOVE A,F ;-> SFSFDS + MOVSI B,-LFDSE ;-> DNAM, LH FOR COUNT + MOVE T,SFSFDS(A) ;GET SPECIFICATION NAME THIS ENTRY + CAMN T,DNAM(B) ;COMPARE WITH THAT JUST SPECIFIED + AOBJN B,[AOJA A,.-2] ;CHECK ALL NAMES THIS ENTRY + JUMPL B,A.IN2 ;LOOP IF NAMES DON'T ALL AGREE + ;FILE IS IN TABLE + PUSHJ P,A.IMAP ;SET NEW FILE DESCRIPTION FROM THAT IN TABLE ENTRY + PUSHJ P,A.ITRY ;TRY OPENING FILE + MOVSI A,SFSFDS(F) ;SET UP LH(BLT POINTER), + PUSHJ P,A.IMP1 ;UNMAP TO ORIGINAL NAMES + PUSHJ P,TYPFIL ;TYPE OUT SPECIFIED NAMES + TYPR [ASCIZ / -> /] ;TYPE OUT POINTER + PUSHJ P,A.IMAP ;RE-MAP INTO TRANSLATION ENTRY IN TABLE + SETOM DNAM(F) ;"HALF-KILL" ENTRY +A.INT1: PUSHJ P,IOPNR1 ;TYPE OUT ALL KINDS OF STUFF +A.INT2: PUSHJ P,GTYIP ;PREPARE TO READ ONE LINE FROM TTY + JRST A.IN1 ;TRY AGAIN WITH WHAT HE TYPES IN + + ;FILE NOT IN TABLE + +A.IN3: TLNN F,-1 ;MORE ROOM FOR ANOTHER ENTRY IN TABLE? + ETF [ASCIZ /Too many @: files/] + MOVEI A,SFSFDS(F) + HRLI A,DNAM + BLT A,SFSFDS+LFDSE-1(F) ;SET UP KEY OF NEW ENTRY + SETOM DNAM(F) ;DOCUMENT FACT THAT ENTRY HAS ONLY KEY, NOT TRANSLATION + MOVNI A,-LFDSE + ADDM A,INDDP ;UPDATE POINTER INTO TABLE + MOVS A,DNAM ;GET SPECIFIED DEVICE NAME + CAIE A,(SIXBIT /@/) ;ATSIGN? + JRST A.INT1 ;NO, TYPE OUT GARBAGE AND TRY AGAIN, READING FROM TTY + MOVE A,IFDS ;YES, CLOBBER FROM INPUT DEVICE NAME + MOVEM A,DNAM + JRST A.INT2 + + ;TRY OPENING INPUT FILE FOR .INSRT, RETURN IF UNSUCCESSFUL + +A.ITRY: MOVS A,DNAM ;GET SPECIFIED DEVICE NAME + CAIN A,(SIXBIT /TTY/) ;TTY? + JRST A.ITRT ;YES, TREAT SPECIAL + TLO FF,FLUNRD + PUSHJ P,IPUSH ;SAVE CURRENT STATUS + PUSHJ P,OPNRD1 ;TRY OPENING FILE + JRST IPOPL ;LOSE, POP AND RETURN +IFN ITSSW,CALL SETWH2 + MOVE B,ITTYP + MOVEI A,-1-TYPDEL(B) + HRLI A,IFNM1 + BLT A,-TYPDEL(B) ;INTRODUCE HYSTERESIS SO .INSRT'ING FILE CAN REFERENCE .IFNM1, .IFNM2 +IFN CREFSW,[ + SKIPE CRFONP ;IF CREFFING, OUTPUT PUSH-FILE BLOCK. + PUSHJ P,CRFPSH ;(POP-FILE BLOCK OUTPUT AT IPOP) +] +A.ITR2: + MOVE A,DNAM(F) ;PUSH SUCCESSFUL, NOW CHECK TO SEE IF TABLE ENTRY SHOULD BE FINISHED + AOJN A,ASSEM1 + PUSHJ P,A.OMAP ;YES, DO IT + JRST ASSEM1 ;NOW ASSEMBLE FROM FILE (ASSEM1 CLOBBERS PDL) + + ;.INSRT TTY: + +A.ITRT: PUSHJ P,GTYIPA ;READ FROM TTY, DON'T QUIT UNTIL .INEOF + JRST A.ITR2 ;FALL BACK IN (DOESN'T TOUCH .IFNM1, .IFNM2) + + ;.INEOF ;EOF PSEUDO (MAINLY USEFUL FROM TTY) + +A.IEF2: PUSHJ P,PMACP ;LOOP POINT, POP ENTRY OFF MACRO PDL +A.INEO: TLNE FF,FLMAC ;INPUTTING FROM MACRO? + JRST A.IEF2 ;YES, POP IT OFF + PUSH P,CMACCR ;BACK TO INPUTTING FROM FILE OR TTY, CAUSE RETURN TO MACCR + MOVE B,ITTYP ;GET PDL POINTER + POPJ B, ;RETURN TO POP ROUTINE + + ;MISC .INSRT + +A.IMAP: MOVSI A,DNAM(F) ;CLOBBER DNAM ETC. FROM TABLE TRANSLATION ENTRY POINTED TO BY F +A.IMP1: HRRI A,DNAM ;ENTRY FOR LH(BLT POINTER) ALREADY SET UP + BLT A,DNAM+LFDSE-1 ;DO IT + POPJ P, + +A.OMAP: MOVEI A,DNAM(F) ;CLOBBER TRANSLATION OF TABLE ENTRY POINTED TO BY F FROM DNAM ETC. + HRLI A,DNAM + BLT A,DNAM+LFDSE-1(F) + POPJ P, + +;CALL FROM ERRH; TYPE INPUT FILE'S NAMES IF CHANGED SINCE LAST ERR MSG. +ERRTFL: MOVE C,INFCUR + EXCH C,INFERR ;SAY LAST ERROR MSG IN THIS FILE. + CAMN C,INFERR ;IF PREV. MSG WAS IN OTHER FILE, + POPJ P, + MOVE C,[-4+DECSW,,INFDEV-DNAM] + PUSHJ P,TYPF1 ;TYPE THIS FILE'S NAMES. + JRST CRRERR + + ;MISC TS + +IOPNR1: PUSHJ P,IOPNER ;TYPE OUT CRUFT + TYPR OINITS + RET + + ;TYPE OUT DNAM ETC. AS FILE SPECIFICATION + +TYPFIL: MOVSI C,-4+DECSW +TYPF1: MOVE B,DNAM(C) ;GET NEXT NAME + PUSHJ P,SIXTYO ;TYPE OUT NAME + HLRZ A,C + MOVE A,FILSPC+4-DECSW(A) ;NOW GET DELIMITING CHARACTER + PUSHJ P,TYOERR ;TYPE OUT + AOBJN C,TYPF1 ;LOOP FOR ALL NAMES +IFN ITSSW, POPJ P, +.ELSE,[ SKIPN B,DNAM(C) ;ON DEC SYSTEM PPN IS A SPECIAL CASE + POPJ P, + MOVEI A,"[ ;] + CALL TYOERR +IFN CMUSW,[ + MOVE A,[B,,PPNBUF] + DECCMU A, + JRST OCTPPN + MOVEI B,PPNBUF + PUSHJ P,TYPR3 + JRST PPNRB +];IFN CMUSW +IFE SAILSW,[ +OCTPPN: HLRZ B,DNAM(C) ;LH IS PROJ, + CALL OCTPNT +] +.ELSE [ HLLZ B,DNAM(C) + CALL SIXTYO +] + MOVEI A,", + CALL TYOERR +IFE SAILSW,[ + HRRZ B,DNAM(C) + CALL OCTPNT ;RH IS PROG. +] +.ELSE [ HRLZ B,DNAM(C) + CALL SIXTYO +] +PPNRB: ;[ + MOVEI A,"] + JRST TYOERR +];IFN DECSW + +FILSPC: ": +IFN ITSSW, 40 ? 40 ? "; +IFN DECSW, ". ? 0 + + ;OPENLOSS DOCUMENTATION ROUTINE +IOPNER: MOVE A,IFSTS ;INPUT +OPNER: MOVEM A,ERRNM2 ;SAVE .STATUS WORD + PUSHJ P,TYPFIL ;TYPE OUT FILE DESCRIPTION + PUSHJ P,CRRERR ;NOW CRLF TO ENSURE ROOM FOR FOLLOWING +IFN DECSW,[ + TYPR [ASCIZ/OPEN failed/] + JRST CRRERR +] +IFN ITSSW,[ + .OPEN ERRC,ERRDNM ;NOW GET THE SYSTEM TO SAY WHAT'S WRONG + .VALUE ;CAN'T OPEN ERR DEVICE? +IOPNR2: .IOT ERRC,A ;GET CHARACTER FROM SYSTEM + CAIN A,14 ;ENDS WITH FORM FEED + POPJ P, + PUSHJ P,TYOERR ;TYPE OUT CHARACTER + JRST IOPNR2 ;LOOP BACK FOR NEXT +] ;END IFN ITSSW + +;READ SINGLE FILE DESCRIPTION INTO DNAM ... SNAM . +;FRNNUL 1 IFF SPEC WAS NONNULL. +;FRMRGO 1 IFF "." WAS SEEN IN DEC VERSION - FORCE NULL FN2. +;FRCMND 1 IFF SHOULD RECOGNIZE -, COMMA, / AND ( AS SPECIAL CHARACTERS. +RFD: TRZ FF,FRNNUL+FRMRGO +RFD8: SETZ D, ;D COUNTS FILENAMES. 0 BEFORE 1ST. +RFD1: MOVEI C,0 ;INITIALIZE SIXBIT NAME. + MOVE B,[440600,,C] ;SET UP BP FOR INPUT +RFD2: PUSHJ P,RCH ;GET CHARACTER IN A + CAIN A,": ;IF COLON... + JRST RFDCOL ;THEN PROCESS AS SUCH + CAIN A,"; ;SIMILARLY FOR SEMICOLON + JRST RFDSEM +IFN DECSW,[ + CAIN A,"! ; FOO! MEANS RUN SYS:FOO WITH OFFSET 1 + JRST RFDRUN +] + CAIN A,^Q ;IF CONTROL Q... + JRST RFDCQ ;THEN GET NEXT CHARACTER AND TREAT AS NON-SYNTACTICAL + TRNN FF,FRCMND ;IF READING COMMAND, _, COMMA, / AND ( ARE SPECIAL. + JRST RFD3 + CAIN A,"( + JRST CMDSW ;READ SWITCHES. + CAIN A,"/ + JRST CMDSL ;READ 1 SWITCH +IFN DECSW,CAIN A,"= +.ALSO JRST RFD6 ;ON DEC SYS, "=" = "_" + CAIE A,", + CAIN A,"_ + JRST RFD6 ;COMMA AND _ END SPEC. +RFD3: +IFN DECSW,[ + CAIE A,"[ ;] + CAIN A,". ;. LIK SPACE ON DEC SYS. + JRST RFD6] + CAILE A,40 ;LOGICAL SPACE? (INCLUDING CR) + JRST RFDC ;NO +RFD6: TRZN FF,FRMRGO ;EXCEPT AFTER ".", + JUMPE C,RFD5 ;IGNORE NULL FILENAMES + XCT RFDTAB(D) ;STORE THE NAME (MAY SKIP) + ADDI D,1 ;NEXT NAME PUT ELSEWHERE +IFN DECSW,[ + CAIN A,". + IORI FF,FRMRGO +] + TRO FF,FRNNUL ;SPEC NOT NULL. +RFD5: IFN DECSW,[CAIN A,"[ ;] READ PPN FOR DEC SYS. + JRST RFD7] + CAIN A,^R ;CONTROL R, + JRST RFD8 ;RESETS FILENAME COUNT +IFN DECSW,[ + CAIN A,"= ;ON DEC SYS, "=" = "_". + MOVEI A,"_ +] + CAIN A,", + RET + CAIE A,"_ ;RETURN IF SPEC TERMINATOR, + CAIN A,^M + RET + JRST RFD1 ;ELSE NEXT NAME. + +RFDCQ: PUSHJ P,RCH ;CONTROL Q EATS UP THE NEXT CHARACTER + CAIN A,15 + JRST RFD6 ;BUT NOT IF CR +RFDC: CAIL A,140 ;CONVERT LOWER CASE TO UPPER. + SUBI A,40 + SUBI A,40 ;CONVERT CHARACTER TO SIXBIT + TLNE B,770000 ;TOO MANY CHARACTERS? + IDPB A,B ;NO + JRST RFD2 ;LOOP + +RFDTAB: MOVEM C,FNAM1 ;1ST NAME. + MOVEM C,FNAM2 ;2ND NAME. + MOVEM C,DNAM ;3RD NAME IS DEV. + MOVEM C,SNAM ;4TH IS SNAME. + CAIA ;5TH AND ON IGNORED, DON'T INCR. D. + +RFDCOL: TRO FF,FRNNUL + JUMPE C,RFD1 ;IF HE WANTS THE NULL DEVICE HE GETS TO TYPE IT IN + MOVEM C,DNAM ;MOVE TO RH OF DEVICE LOCATION + JRST RFD1 ;LOOP + +IFN DECSW,[ +RFD7: PUSHJ P,RFDPPN ;READ PPN, USE AS "SNAME". +] +RFDSEM: TRO FF,FRNNUL + JUMPE C,RFD1 ;NO NULL SYSTEM NAMES PLEASE + MOVEM C,SNAM ;MOVE TO SYSTEM NAME LOCATION + JRST RFD1 ;LOOP + +IFN DECSW,[ +RFDPPN: PUSHJ P,RFDOCT ;READ PROJECT NUM, +IFN CMUSW, JUMPE C,RCMUPP ;AT CMU WATCH FOR OUR FUNNY PPNs + HRLM C,(P) + PUSHJ P,RFDOCT ;READ PROGRAMMER NUM. + HLL C,(P) + POPJ P, + +IFE SAILSW,RFDOCL=="0 ? RFDOCH=="8 ;READ OCTAL NUMBERS. +.ELSE RFDOCL==40 ? RFDOCH==140 ;READ SIXBIT (RIGHT-JUSTIFIED). + +RFDOCT: SETZ C, ;READ OCTAL NUM, RETURN IN C. +RFDOC1: PUSHJ P,RCH + CAIL A,140 + SUBI A,40 +IFN SAILSW,[ ;[ ;EVEN IF READING SIXBIT NAMES (FOR SAIL), + CAIE A,", ;COMMA AND CLOSEBRACKET ARE STILL SPECIAL. + CAIN A,"] + POPJ P, +] + CAIL A,RFDOCL + CAIL A,RFDOCH + POPJ P, ;NOT OCTAL OR NOT 6BIT, RETURN. + IMULI C,RFDOCH-RFDOCL + ADDI C,-RFDOCL(A) + JRST RFDOC1 + +IFN CMUSW,[ ;[ +RCMUPP: CAIN A,"] ;WATCH OUT FOR [] + POPJ P, +REPEAT 4, SETZM PPNBUF+.RPCNT + MOVE C,[440700,,PPNBUF] +RCMUPL: CAIE A,^M ;Don't look too far + SKIPE PPNBUF+3 + JRST RCMUPD + IDPB A,C + PUSHJ P,RCH ;[ + CAIE A,"] + JRST RCMUPL +RCMUPD: MOVE A,[C,,PPNBUF] + CMUDEC A, + SETZ C, + POPJ P, +];IFN CMUSW +];IFN DECSW + +IFN DECSW,[ + +;PROCESS "FOO!", WHICH MEANS "RUN SYS:FOO WITH AN OFFSET OF 1". + +RFDRUN: MOVSI A,'SYS ;DEV NAME + MOVE B,C ;FN1 + SETZB C,D ;DEFAULT THE FN2. 4TH WORD NOT USED. + SETZB T,TT ;DEFAULT THE PPN (UNUSED ANYWAY). DON'T SPECIFY CORE SIZE. + MOVE AA,[1,,A] ;,,
+ JRST RFDRU1 +VBLK +RFDRU1: MOVE F,[1,,RFDRUE] + CORE F, ;FLUSH AS MUCH CORE AS POSSIBLE, SINCE RUN UUO CAN LOSE + HALT ;BECAUSE OF HOW MUCH WE HAVE. + RUN AA, + HALT +RFDRUE: + +PBLK +];END IFN DECSW, + +;COMMAND SWITCH PROCESSING. + +CMDSL: CALL RCH ;COME HERE AFTER A SLASH. READ ONE SWITCH. + CAIN A,^M + JRST RFD6 + CALL CMDSW1 + JRST RFD2 + +CMDSW: PUSHJ P,RCH + CAIN A,") + JRST RFD2 + CAIN A,^M + JRST RFD6 ;DON'T CRASH IF USER PUTS CR IN SWITCH LIST. + CALL CMDSW1 + JRST CMDSW + +CMDSW1: CAIL A,140 ;LOWER CASE TO UPPER. + SUBI A,40 + CAIN A,"T + SOS TTYINS ;COUNT # T-SWITCHES. +IFN LISTSW,[ + CAIN A,"L + JRST CMDLST +] + CAIN A,"W ;W - PREVENT TTY MESSAGES, AND RQ ERROR OUTPUT FILE IF POSSIBLE. +IFE ERRSW,AOS WSWCNT +.ELSE [ + AOSA WSWCNT + CAIN A,"E ;E - RQ ERROR LOG FILE. + SETOM ERRFP +] +IFN CREFSW,[ + CAIN A,"C ;C - RQ CREF OUTPUT. + SETOM CREFP +] + RET + +;READ COMMAND, DEFAULT FILENAMES. +CMD: SKIPN CMPTR + CALL CRR + SKIPN CMPTR ;UNLESS HAVE DDT COMMAND STRING, PROMPT. +CMDB: TYPR [ASCIZ/*/] + MOVEI A,3 ;READ FROM TTY (OR STRING <- CMPTR) + CALL RCHSET + TRO FF,FRCMND+FRARRO ;TELL RFD ABOUT COMMA, _ AND (. + CALL RFD ;NOW SEE IF COMMAND NULL, AND WHETHER HAS _. + TRNN FF,FRNNUL + CAIE A,^M + CAIA + JRST CMDB ;JUST A CR WITH NOTHING SIGNIFICANT BEFORE IT. +CMD0: CAIN A,"_ + TRZ FF,FRARRO ;FRARRO WILL BE ON IFF NO _ IN STRING. + CAIN A,^M + JRST CMD1 ;READ THRU THE WHOLE COMMAND. + CALL RFD + JRST CMD0 + +;NOW RE-READ THE STRING, FOR REAL THIS TIME. +CMD1: MOVE F,[440700,,CMBUF] + MOVEM F,CMPTR ;START FROM BEGINNING OF STRING. +IFN CREFSW,SETZM CREFP ;CLEAR ALL SWITCHES BEFORE DECODING THEM. +INSIRP SETZM 0,ERRFP TTYINS WSWCNT +IFN LISTSW,[ + SETZM LISTP + SETOM LISTP1 ;WILL BE AOSED BY EACH (L) SWITCH. +] + SETZM DNAM ;CLEAR OUT ALL FILENAMES. + MOVE T,[DNAM,,DNAM+1] + BLT T,FNMEND-1 + MOVSI T,'DSK ;DEFAULT DEV IS DSK + MOVEM T,DNAM ;EXCEPT PERHAPS IF OUTPUT SPEC NULL. + MOVE T,RSYSNM + MOVEM T,SNAM ;DEFAULT SNAME IS INITIAL SNAME. + TRZ FF,FRNNUL + TRNN FF,FRARRO ;DON'T GOBBLE INPUT SPEC AS OUTPUT! + CALL RFD ;READ BIN FILE SPEC. + MOVE F,FF ;REMEMBER WHETHER NULL + MOVE T,[DNAM,,ONAM] + BLT T,OSYSNM + MOVS T,DNAM + CAIN T,'NUL ;IF BIN WENT TO NUL:, + MOVEI T,'DSK ;CREF GOES TO DSK. + MOVSM T,DNAM ;ELSE DEFAULT DEV FOR CREF IS BIN'S DEV. +IFN DECSW,MOVSI T,'CRF +IFN ITSSW,MOVE T,[SIXBIT/CREF/] + MOVEM T,FNAM2 ;DEFAULT THE CREF FILE'S NAMES. + TRNE FF,FRARRO + MOVEI A,"_ + CAIN A,"_ + JRST CMD2 ;RAN OUT OF OUTPUT SPECS => JUST USE DEFAULTS. + CALL RFD ;READ CREF FILE SPEC. +IFN CREFSW,[ + TRNN FF,FRNNUL ;IF SPEC NOT NULL OR ENDED BY _, + CAIN A,"_ + SETOM CREFP ;WE MUST WANT TO CREF. +CMD2: MOVE T,[DNAM,,CRFDEV] + BLT T,CRFSNM +]IFE CREFSW,CMD2: + MOVSI T,'ERR ;DEFAULT THE ERROR OUTPUT FILE'S NNAMES. + MOVEM T,FNAM2 + CAIN A,"_ + JRST CMD6 ;NO MORE OUTPUT SPECS. + CALL RFD ;READ ERROR FILE SPPEC. +IFN ERRSW,[ + TRNN FF,FRNNUL ;NONNULL SPEC OR LAST SPEC => + CAIN A,"_ + SETOM ERRFP ;MUST WAANT ANN ERROR FILE. +CMD6: MOVE T,[DNAM,,ERRDEV] + BLT T,ERRDEV+3 +] +IFE ERRSW,CMD6: +IFN LISTSW,[ +IFN DECSW,MOVSI T,'LST +IFN ITSSW,MOVE T,[SIXBIT/LIST/] + MOVEM T,FNAM2 ;DEFAULT LST FILE FN2. + CAIN A,"_ ;ANY OUTPUT SPEC REMAINING? + JRST CMD3 + CALL RFD ;YES, READ ONE. + SETOM LISTP ;LIST SPEC GIVEN IMPLIES WANT LISTING. +CMD3: MOVE T,[DNAM,,LSTDEV] + BLT T,LSTSNM +] ;END IFN LISTSW, +CMD5: CAIN A,"_ + JRST CMD4 + CALL RFD ;IGNORE ANY OUTPUT SPECS NOT NEEDED. + JRST CMD5 + +CMD4: MOVSI T,'DSK ;DEFAULT THE INPUT NAMES. + MOVS A,DNAM + CAIE A,'PTP ;DON'T LEAVE DEV NAME SET TO COMMON OUTPUT-ONLY DEVS. + CAIN A,'NUL + MOVEM T,DNAM +IFN DECSW,MOVSI T,'MID +IFN ITSSW,MOVSI T,'>_14 + MOVEM T,FNAM2 + MOVE T,[SIXBIT/PROG/] + SKIPN FNAM1 ;THE FN1 ALONE IS STICKY ACROSS THE _. + MOVEM T,FNAM1 + TRO FF,FRARRO ;IF ONLY 1 NAME IT SHOULD BE FNAM1. + CALL RFD ;READ INPUT SPEC. + MOVE T,[DNAM,,IFDS] + BLT T,IFDS+3 + MOVE T,FNAM1 ;DEFAULT OUTPUT FN1'S TO INPUT. + SKIPN ONAM+1 + MOVEM T,ONAM+1 +IFN CREFSW,[ + SKIPN CRFDEV+1 + MOVEM T,CRFDEV+1 +] +IFN LISTSW,[ + SKIPN LSTDEV+1 + MOVEM T,LSTDEV+1 +] +IFN ERRSW,[SKIPN ERRDEV+1 + MOVEM T,ERRDEV+1 +] + MOVSI A,'NUL ;THE OUTPUT DEV DEFAULTS TO NUL: + MOVS T,DNAM ;IF THE INPUT IS FROM TTY: + CAIN T,'TTY + TRNE F,FRNNUL ;AND THE BIN SPEC WAS NULL. + CAIA + MOVEM A,ONAM + TRZ FF,FRARRO ;DON'T LOUSE UP .INSRT'S READING. + RET + +IFN CREFSW,[ + +CRFOUT: SOSGE CRFCNT + JRST CRFOU1 ;NO ROOM, OUTPUT AND INIT BUFFER. + IDPB A,CRFPTR + POPJ P, + +CRFOU1: SAVE C + MOVE C,[0 CREFC,CRFHDR] + CALL OBUFO + REST C + JRST CRFOUT + +CRFSSF: SKIPA A,[1] ;OUTPUT SET-SOURCE-FILE BLOCK. +CRFPSH: MOVEI A,3 ;OUTPUT PUSH-SOURCE-FILE BLOCK. +REPEAT 4,[ CALL CRFOUT + MOVE A,INFDEV+.RPCNT +] + JRST CRFOUT +] + +IFN LISTSW,[ + ;PRINTING ROUTINES + +;L SWITCH TYPED IN DURING COMMAND, SET UP FOR LISTING +CMDLST: SETOM LISTP ;SAY WANT LISTING. + AOS LISTP1 ;(STARTS AS -1, WILL BE POS. AFTER 2ND (L)) + RET + +;PRINT CHARACTER IN A +PILPT: SOSGE LSTCNT + JRST PILPT1 + IDPB A,LSTPTR + RET + +PILPT1: SAVE C + MOVE C,[0 LPTC,LSTHDR] + CALL OBUFO + REST C + JRST PILPT + +LPTCLS==CPOPJ +] ;END IFN LISTSW, + ;GET ANOTHER K OF MACTAB SPACE. + +CORRQB: IFN ITSSW,.VALUE ;LOOP POINT FOR DON'T PROCEED +IFN DECSW,EXIT 1, + TLZ AA,400000 +CORRQA: POP P,D + POP P,C + MOVE A,(P) ;RESTORE A FROM PDL + JRST CORRQ1 + +GCCORQ: MOVE A,MACHI + LSH A,-2 ;CONVERT TO WORD # + CAIL A,MXMACL ;WANT MORE THAN ALLOWED? + POPJ P, + MOVE A,MACTND ;NO, GET ADDR OF BLOCK WE WANT TO GET. + PUSH P,A ;ENTRY, SAVE A IN CASE HAVE TO TRY AGAIN +CORRQ1:IFN ITSSW,[ + HRLI A,10001 ;(CODE FOR FRESH PAGE, _1) + LSH A,-1 + .CBLK A, ;TRY GETTING BLOCK +] +IFN DECSW,[ + IORI A,1777 + CORE A, +] + JRST CORRQL ;LOSE + REST A + ADDI A,2000 + JRST MACIN2 ;UPDATE POINTERS TO END OF MACTAB. + +CORRQL: PUSH P,C + PUSH P,D + TLOE AA,400000 + JRST CORQL1 + TYPR [ASCIZ / +No core for macro table./] +CORQL1: TYPR [ASCIZ / +Try again? /] +CORQL2: PUSHJ P,TYI ;GET CHAR + TRZ A," + CAIN A,"Y ;Y, + JRST CORRQA ;=> TRY AGAIN + CAIN A,"N ;N, + JRST CORRQB ;=> BACK TO DDT THEN TRY AGAIN + CAIN A,"? ;?, + ERJ CORQL1 ;=> TYPE OUT ERROR-TYPE BLURB + TYPR [ASCIZ /? /] ;SOMETHING ELSE + JRST CORQL2 + +] ;END TS CONDITIONAL + +FEED1: SKIPA B,[40] +FEED: MOVEI B,5 + JRST TFEED + +VBLK + +IFG PURESW-DECSW,[ ;PURIFICATION ROUTINE + +PURIFG: -1 ;-1 IF NOT (YET) PURIFIED +] + VARIAB +VPAT: +VPATCH: BLOCK 20 +VPATCE=.-1 + +PBLK + +CONSTANTS + +PAT: +PATCH: BLOCK 100 +PATCHE: -1 + +IFG PURESW-DECSW,[LOC <.+1777>&-2000 ;SKIP TO NEXT PAGE + MAXPUR==./2000 ;FIRST PAGE ABOVE PURE PAGES +PRINTA Pure pages = ,\MAXPUR-MINPUR +] + +VBLK +PDL: BLOCK LPDL+1 + +IFN DECDBG, DECDBB: BLOCK 8000. ;SPACE FOR DEC DDT'S SYMS. + +.NSTGW +BBKCOD==. ;BEGIN BLANK CODING, CLEARED OUT DURING INITIALIZATION +IFG PURESW-DECSW,MINBNK==<.+1777>/2000 ;FIRST PAGE OF BLANK CODE +BNKBLK ;DUMP OUT ACCUMULATED BLANK CODING + + ;NOW MORE BLANK CODING + +BKBUF: BLOCK BSIZE+5 ;CURRENT BLOCK TO OUTPUT +GLOTB: BLOCK 20 ;GLOBAL TABLE, EACH ENTRY FLAGS,,ADR OF SQUOZE (SEE COMMENTS NEAR BEGINNING) +STRSTO: BLOCK STRL ;STRING STORAGE FOR GSYL AND FRIENDS +IFN FASLP,[ +FASB: BLOCK FASBL ;OUTPUT BUFFER FOR FASL MODE + ;FIRST WD 9 FOUR BIT CODE GROUPS, REST ASSOC STUFF +FASAT: BLOCK FASATL ;ATOM TABLE FOR FASL MODE + ;EACH ENTRY CONSISTS OF ATOM IN FORMAT DESIRED BY FASLOAD, + ;NAMELY: + ; HEADER WD. RH LENGTH IN WDS + ; 4.8-4.7 TYPE 0-PN 1 FIX 2 FLO 3 BIG (NOT IMPLEMENTED) + ; FOLLOWED BY PN OR VALUE + ;-EXCEPT- IF RH OF HEADER =0, THIS SLOT RESERVED FOR LIST + +] + +EBKCOD==. ;END BLANK CODING +.YSTGW + +PRINTA ST = ,\.-RL0 + +ST: ;SYMBOL TABLE 3 WORDS/SYM FIRST SQUOZE, SECOND "VALUE", 3RD FLAGS,,BLOCK. + BLOCK NRMWPS*SYMDSZ + +;LITERALS TABLES - CAN MOVE AND GROW. THESE TAGS & LENGTHS ARE JUST THE DEFAULTS +.SEE CONTBA ;ETC, WHICH CONTAIN THE ACTUAL ADDRESSES. SO DON'T USE THEM! +CONTAB: BLOCK LCONTB ;CONSTANTS TABLE, VALUES OF CONSTANTS THIS CONSTANTS AREA +CONGLO: BLOCK LCNGLO ;CONSTANTS GLOBAL TABLE, EACH ENTRY TWO WORDS + ;FIRST WD GLOTB ENTRY. SECOND WD ADR IN CONTAB OF CONSTANT TO WHICH IT REFERS +CONBIT: BLOCK LCONTB/12.+1 ;RELOCATION BITS AND ILNOPT BIT(SEE CPTMK) + ;3 BITS FOR EACH WORD OF CONTAB. + +;;INIT ;INITIALIZATION ROUTINES (IN MACRO TABLE, GET WIPED OUT) +IFN ITSSW,MINMAC==./2000 ;# OF 1ST PAGE HOLDING PART OF MACTAB. +;NOTE THAT THIS CODE IS COPIED UPWARD WHEN MACTAB IS MOVED +;DUE TO SYMTAB EXPANSION. THEREFOR IT MUST REFER TO ITSELF +;INDEXED BY THE OFFSET OF WHERE IT IS FROM WHERE IT WAS ASSEMBLED. +;THAT IS KEPT IN CH1. ALL LITERALS MUST BE USED INDEX OF CH1, TOO. + +;MAC PROC TABLES +MACTBA: 773767750000 ;MACRO CHARACTER STORAGE (FIRST WORD 3 375'S) +INIT1: MOVE CH1,MACTAD ;GET ADDR THIS COODE REALLY STARTS AT. + SUBI CH1,MACTBA ;GET OFFSET FROM WHERE ASSEMBLED. + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1](CH1) + BLT A,EBKCOD-1 ;CLEAR OUT BLANK CODING + PUSH P,[SP4](CH1) ;NOW INIT THE SYMTAB & FINISHED. + +;INITIALIZE THE SYMTAB, EXPECT SIZE IN SYMLEN. +INITS: MOVE AA,SYMLEN ;SET UP THE OTHER VARS + IMUL AA,WPSTE ;DEALING WITH SYMTAB SIZE. + MOVEM AA,SYMSIZ + ADDI AA,ST ;ADDR OF START OF CONTAB. + MOVEM AA,CONTBA + MOVEM AA,PLIM + ADD AA,CONLEN ;ADD LENGTH OF CONTAB TO GET ADDR OF CONGLO TAB. + MOVEM AA,CONTBE ;WHICH IS ALSO THE END OF CONTAB. + MOVEM AA,CONGLA + MOVEM AA,CONGOL + MOVE A,CONLEN ;ADD IN LENGTH OF CONGLO (1/4 OF CONLEN) + LSH A,-2 + ADD AA,A + MOVEM AA,CONGLE ;TO GET END OF CONGLO, AND START OF CONBIT TABLE. + MOVEM AA,CONBIA + MOVE A,CONLEN + ADDI A,11. + IDIVI A,12. + ADD AA,A ;ADD LENGTH OF CONBIT (1/12 OF CONLEN) GETTING ADDR OF MACTAB. +IFN DECSW,[ + SAVE AA + ADDI AA,MACL-1 + IORI AA,1777 ;FIX ALLOCATION PROBLEMS ON KI-10 + CORE AA, + ETF [ASCIZ /No core for symbols/](CH1) + REST AA +] + MOVN A,SYMLEN + HRLZM A,SYMAOB ;AOBJN -> SYMTAB. + MOVE A,WPSTE + SUBI A,1 + MOVEM A,WPSTE1 + MOVN A,WPSTE + HRRM A,WPSTEB + CAMG AA,MACTAD ;MOVED MACTAB UP? + JRST INITS1(CH1) +IFN ITSSW,[ ;YES, GET CORE FOR INCREASE. + SAVE AA + MOVEI AA,MACL+1777(AA) + LSH AA,-10. ;1ST PAGE NOT NEEDED BY MACTAB. + MOVEI A,MACL+1777+MACTBA(CH1) + LSH A,-10. ;1ST PAGE MACTAB DOESN'T YET HAVE. + SUBM A,AA ;# PAGES NEEDED. + HRLZI AA,(AA) + HRRI AA,(A) ;-<# PAGES>,,<1ST NEEDED> + JUMPGE AA,.+3(CH1) ;DON'T CALL IF NEED 0 PAGES, WOULD GET ONE. + .CALL INITSB(CH1) + .VALUE + REST AA +] + SUBM AA,MACTAD ;MACTAD _ SHIFT IN START OF MACTAB. + EXCH AA,MACTAD ;MACTAD GETS NEW START, AA HAS SHIFT. + MOVSI A,PTAB-CCOMPB + ADDM AA,PTAB(A) ;RELOCATE BYTE-PTRS INTO MACTAB. + AOBJN A,.-1(CH1) + MOVNI B,INITS2(CH1) + HRROI A,@EISYMP(CH1) + ADDI B,1(A) ;GET # WDS IN SECOND HALF OF INIT CODE. + HRRM AA,.+1(CH1) ;COPY 2ND HALF UPWARD WITH POP-LOOP. + POP A,(A) ;THIS INSN IMPURE. + SOJG B,.-1(CH1) + ADDI CH1,(AA) ;CHANGE OFFSET TO PT. TO NEW LOCATIONN OF INIT CODE. + JRST INITS2(CH1) ;JUMP INTO 2ND HALF, WHERE IT'S BEEN COPIED TO. +INITS2: HRROI A,INITS2-1(CH1) ;THEN COPY 1ST HALF (WHICH ENNDS BEFORE INITS2) + SUBI A,(AA) ;GET WHERE NOW ENDS, NOT WHERE WILL END. + MOVEI B,INITS2-MACTBA ;UP UNDERNEATH THE 2ND HALF. + HRRM AA,.+1(CH1) ;(THIS TWO-STEP COPYING HANDLES ALL OVERLAPS) + POP A,(A) + SOJG B,.-1(CH1) +INITS1: MOVE AA,SYMSIZ + SETZM ST + MOVE A,[ST,,ST+1](CH1) + BLT A,ST-1(AA) ;CLEAR OUT SYMBOL TABLE + SETZM ESBK ;DEFINE THEM IN OUTER BLOCK. + MOVEI AA,ISYMTB(CH1) + MOVS F,ISMTBB(CH1) ;GET SWAPPED VALUE OF FIRST INSTRUCTION +SP3: CAIL AA,EISYM1(CH1) + JRST SP1(CH1) ;DONE WITH INSTRUCTIONS + MOVE SYM,(AA) + JUMPE SYM,SP2(CH1) + TLZ SYM,740000 + PUSHJ P,ES ;WON'T SKIP + HRLZI T,SYMC + HRLZ B,F + MOVSI C,3KILL + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP2: ADDI F,1000 + AOJA AA,SP3(CH1) +EISYMP: ;MAY BE MUNGED +SP1: CAIL AA,EISYMT(CH1) + POPJ P, + MOVE SYM,(AA) + LDB T,[400400,,SYM](CH1) + ROT T,-4 + TLZ SYM,740000 + PUSHJ P,ES + MOVE B,1(AA) + MOVSI C,3KILL + CAME T,[GLOETY,,](CH1) ;GLOBAL ENTRIES REALLY EXITS, HACKED TO DEFEAT ADDRESS LINKING + CAMN T,[GLOEXT,,](CH1) + TLO C,3LLV + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 + AOS AA + AOJA AA,SP1(CH1) + +IFN ITSSW,[ +INITSB: SETZ ? 'CORBLK + 1000,,600000 ;BOTH READ AND WRITE. + 1000,,-1 ? AA ;INTO SELF, AA IS AOBJN -> PAGES. + SETZI 400001 ;FRESH PAGES. + + ;GOBBLE SYMS FROM SYSTEM + ;TABLE AREA IN SYSTEM: + ;FIRST LOC SYSYMB + ;LAST (AS OPPOSED TO LAST + 1) SYSYME + +TSYMGT: MOVE AA,[MXICLR-MXIMAC,,MXICLR] + .CALL INITSB ;GET MACTAB PAGES NNOT LOADED INTO. + .VALUE +IFN PURESW,[ + MOVE AA,[MINBNK-MINMAC,,MINBNK] + .CALL INITSB ;GET PAGES FOR BLANK CODE & SYMTAB. + .VALUE + SKIPN PURIFG + JRST TSYMG3 + JSP F,PURIFD ;NOT PURIFIED => FLUSH PAGES + MINPUR-MXIMAC ;OF MACTAB CREATED BY LOADING BUT NOT NEEDED. + MXIMAC*1001 +TSYMG3: +] + MOVEI A,EISYMT ;EISYMT FIRST LOC FOR ITS SYMS + MOVE B,[SIXBIT /CALLS/] ;SYSTEM CALLS + .GETSYS A, ;READ IN SYSTEM CALLS (SHOULD SKIP) + .VALUE + SKIPGE A + .VALUE ;.GETSYS DIDN'T UPDATE AOBJN POINTER + HRRM A,SP1 ;MARK END OF SYMS + ANDI A,-1 + CAIL A,MACTBA+MACL + .VALUE ;MACL TOO SMALL! INITS MIGHT LOSE. + MOVEI B,EISYMT + MOVEI AA,SYMC_<-18.+4> ;SQUOZE FLAG FOR SYM +TSYMG2: DPB AA,[400400,,(B)] + ADDI B,2 + CAIE B,(A) + JRST TSYMG2 + POPJ P, + +IFN PURESW,[ ;HERE ARE THE GUTS OF THE PURIFY ROUTINE + +PURIFY: SKIPL NVRRUN + .VALUE [ASCIZ /:Already run +/] +PURIF1: MOVEI P,17 ;START PDL AT 20 + JSP F,PURIFD ;CALL .CBLK ROUTINE + MINMAC-MINBNK ;FLUSH BLANK CODE PAGES (INCL. SYM TAB) + MINBNK*1001 + MINPUR-MXICLR ;FLUSH MACTAB PAGES CREATED BY LOAD BUT NOT NNEEDED. + MXICLR*1001 + MAXPUR-MINPUR ;PURIFY PURE PAGES. + 400000+MINPUR*1001 + SETZM PURIFG ;SET "PURIFIED" FLAG + MOVE [1,,2] ;NOW CLEAR OUT REMAINS OF DATA OF SELF + MOVEI 1,0 + BLT 40 + .VALUE [ASCIZ /:Purifiedpdump SYS;TS MIDAS/] + +GAPFLS: JSP F,PURIFD ;FLUSH GAP PAGES CREATED ON INITIAL LOAD. + MINPUR-MXIMAC + MXIMAC*1001 + .BREAK 16,300000 + + ;JSP F,PURIFD ;DO A SEQUENCE OF .CBLKS + ;FOLLOW WITH AN ARBITRARY NUMBER OF PAIRS OF ARGUMENTS + ;FIRST ARG OF PAIR # PAGES TO PROCESS, MAY BE ZERO + ;SECOND INITIAL .CBLK AC CONTENTS + +PURIFD: MOVE C,(F) ;GET COUNT + TLNE C,777000 ;CHECK INSTRUCTION PART + JRST (F) ;INSTRUCTION => RETURN TO IT + JUMPE C,PURID2 ;JUMP IF NO PAGES IN COUNT + MOVE A,1(F) ;GET INITIAL .CBLK ARG +PURID1: .CBLK A, + .VALUE + ADDI A,1001 ;INCREMENT .CBLK ARG TO NEXT PAGE + SOJG C,PURID1 ;DO IT THE APPROPRIATE NUMBER OF TIMES +PURID2: ADDI F,2 + JRST PURIFD + +] ;END PURESW CONDITIONAL +] ;END ITSSW, CONDITIONAL + +IFN DECDBG,[ +DECDBM: 0 +IFE SAILSW,HRLZ A,.JBSYM ;GET ADDR OF START OF DDT SYMS, +.ELSE HRLZ A,JOBSYM + HRRI A,DECDBB+200 ;LEAVE 200 WD SPACE BEFORE THEM. +IFE SAILSW,[HRRM A,.JBSYM ;MOVE THEM INTO SPACE PROVIDED + HLRE B,.JBSYM] +.ELSE [HRRM A,JOBSYM + HLRE B,JOBSYM] + MOVMS B + BLT A,DECDBB+177(B) ;SO THEY WON'T GET IN MACTAB'S WAY. + JRST @DECDBM +] + +CONSTANTS + +;;ISYMS ;INITIAL SYMBOL TABLE + +ADJSP=105_33 ;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE + +ISMTBB: ADJSP ;FIRST OP. CODE IN ISYMTB + +ISYMTB: + +SQUOZE 10,ADJSP + 0 + 0 +SQUOZE 10,DFAD +SQUOZE 10,DFSB +SQUOZE 10,DFMP +SQUOZE 10,DFDV +SQUOZE 10,DADD +SQUOZE 10,DSUB +SQUOZE 10,DMUL +SQUOZE 10,DDIV +SQUOZE 10,DMOVE +SQUOZE 10,DMOVN +SQUOZE 10,FIX +SQUOZE 10,EXTEND +SQUOZE 10,DMOVEM +SQUOZE 10,DMOVNM +SQUOZE 10,FIXR +SQUOZE 10,FLTR +SQUOZE 10,UFA +SQUOZE 10,DFN +SQUOZE 10,FSC +SQUOZE 10,IBP +SQUOZE 10,ILDB +SQUOZE 10,LDB +SQUOZE 10,IDPB +SQUOZE 10,DPB +SQUOZE 10,FAD +SQUOZE 10,FADL +SQUOZE 10,FADM +SQUOZE 10,FADB +SQUOZE 10,FADR +SQUOZE 10,FADRL +SQUOZE 10,FADRM +SQUOZE 10,FADRB +SQUOZE 10,FSB +SQUOZE 10,FSBL +SQUOZE 10,FSBM +SQUOZE 10,FSBB +SQUOZE 10,FSBR +SQUOZE 10,FSBRL +SQUOZE 10,FSBRM +SQUOZE 10,FSBRB +SQUOZE 10,FMP +SQUOZE 10,FMPL +SQUOZE 10,FMPM +SQUOZE 10,FMPB +SQUOZE 10,FMPR + SQUOZE 10,FMPRL +SQUOZE 10,FMPRM +SQUOZE 10,FMPRB +SQUOZE 10,FDV +SQUOZE 10,FDVL +SQUOZE 10,FDVM +SQUOZE 10,FDVB +SQUOZE 10,FDVR +SQUOZE 10,FDVRL +SQUOZE 10,FDVRM +SQUOZE 10,FDVRB +SQUOZE 10,MOVE +SQUOZE 10,MOVEI +SQUOZE 10,MOVEM +SQUOZE 10,MOVES +SQUOZE 10,MOVS +SQUOZE 10,MOVSI +SQUOZE 10,MOVSM +SQUOZE 10,MOVSS +SQUOZE 10,MOVN +SQUOZE 10,MOVNI +SQUOZE 10,MOVNM +SQUOZE 10,MOVNS +SQUOZE 10,MOVM +SQUOZE 10,MOVMI +SQUOZE 10,MOVMM +SQUOZE 10,MOVMS + +SQUOZE 10,IMUL +SQUOZE 10,IMULI +SQUOZE 10,IMULM +SQUOZE 10,IMULB +SQUOZE 10,MUL +SQUOZE 10,MULI +SQUOZE 10,MULM +SQUOZE 10,MULB +SQUOZE 10,IDIV +SQUOZE 10,IDIVI +SQUOZE 10,IDIVM +SQUOZE 10,IDIVB +SQUOZE 10,DIV +SQUOZE 10,DIVI +SQUOZE 10,DIVM +SQUOZE 10,DIVB +SQUOZE 10,ASH +SQUOZE 10,ROT +SQUOZE 10,LSH +SQUOZE 10,JFFO ;PDP10 INSTRUCTION +SQUOZE 10,ASHC +SQUOZE 10,ROTC +SQUOZE 10,LSHC +SQUOZE 10,CIRC ;CIRCULATE: ROTC WITH AC+1 GOING THE WRONG WAY +SQUOZE 10,EXCH +SQUOZE 10,BLT +SQUOZE 10,AOBJP +SQUOZE 10,AOBJN +SQUOZE 10,JRST +SQUOZE 10,JFCL +SQUOZE 10,XCT +0 + SQUOZE 10,PUSHJ +SQUOZE 10,PUSH +SQUOZE 10,POP +SQUOZE 10,POPJ +SQUOZE 10,JSR +SQUOZE 10,JSP +SQUOZE 10,JSA +SQUOZE 10,JRA +SQUOZE 10,ADD +SQUOZE 10,ADDI +SQUOZE 10,ADDM +SQUOZE 10,ADDB +SQUOZE 10,SUB +SQUOZE 10,SUBI +SQUOZE 10,SUBM +SQUOZE 10,SUBB +SQUOZE 10,CAI +SQUOZE 10,CAIL +SQUOZE 10,CAIE +SQUOZE 10,CAILE +SQUOZE 10,CAIA +SQUOZE 10,CAIGE +SQUOZE 10,CAIN +SQUOZE 10,CAIG + +SQUOZE 10,CAM +SQUOZE 10,CAML +SQUOZE 10,CAME +SQUOZE 10,CAMLE +SQUOZE 10,CAMA +SQUOZE 10,CAMGE +SQUOZE 10,CAMN +SQUOZE 10,CAMG +SQUOZE 10,JUMP +SQUOZE 10,JUMPL +SQUOZE 10,JUMPE +SQUOZE 10,JUMPLE +SQUOZE 10,JUMPA +SQUOZE 10,JUMPGE +SQUOZE 10,JUMPN +SQUOZE 10,JUMPG +SQUOZE 10,SKIP +SQUOZE 10,SKIPL +SQUOZE 10,SKIPE +SQUOZE 10,SKIPLE +SQUOZE 10,SKIPA +SQUOZE 10,SKIPGE +SQUOZE 10,SKIPN +SQUOZE 10,SKIPG +SQUOZE 10,AOJ +SQUOZE 10,AOJL +SQUOZE 10,AOJE +SQUOZE 10,AOJLE +SQUOZE 10,AOJA +SQUOZE 10,AOJGE +SQUOZE 10,AOJN +SQUOZE 10,AOJG +SQUOZE 10,AOS +SQUOZE 10,AOSL +SQUOZE 10,AOSE + SQUOZE 10,AOSLE +SQUOZE 10,AOSA +SQUOZE 10,AOSGE +SQUOZE 10,AOSN +SQUOZE 10,AOSG +SQUOZE 10,SOJ +SQUOZE 10,SOJL +SQUOZE 10,SOJE +SQUOZE 10,SOJLE +SQUOZE 10,SOJA +SQUOZE 10,SOJGE +SQUOZE 10,SOJN +SQUOZE 10,SOJG +SQUOZE 10,SOS +SQUOZE 10,SOSL +SQUOZE 10,SOSE +SQUOZE 10,SOSLE +SQUOZE 10,SOSA +SQUOZE 10,SOSGE +SQUOZE 10,SOSN +SQUOZE 10,SOSG + +SQUOZE 10,SETZ +SQUOZE 10,SETZI +SQUOZE 10,SETZM +SQUOZE 10,SETZB +SQUOZE 10,AND +SQUOZE 10,ANDI +SQUOZE 10,ANDM +SQUOZE 10,ANDB +SQUOZE 10,ANDCA +SQUOZE 10,ANDCAI +SQUOZE 10,ANDCAM +SQUOZE 10,ANDCAB +SQUOZE 10,SETM +SQUOZE 10,SETMI +SQUOZE 10,SETMM +SQUOZE 10,SETMB +SQUOZE 10,ANDCM +SQUOZE 10,ANDCMI +SQUOZE 10,ANDCMM +SQUOZE 10,ANDCMB +SQUOZE 10,SETA +SQUOZE 10,SETAI +SQUOZE 10,SETAM +SQUOZE 10,SETAB +SQUOZE 10,XOR +SQUOZE 10,XORI +SQUOZE 10,XORM +SQUOZE 10,XORB +SQUOZE 10,IOR +SQUOZE 10,IORI +SQUOZE 10,IORM +SQUOZE 10,IORB +SQUOZE 10,ANDCB +SQUOZE 10,ANDCBI +SQUOZE 10,ANDCBM +SQUOZE 10,ANDCBB +SQUOZE 10,EQV +SQUOZE 10,EQVI + SQUOZE 10,EQVM +SQUOZE 10,EQVB +SQUOZE 10,SETCA +SQUOZE 10,SETCAI +SQUOZE 10,SETCAM +SQUOZE 10,SETCAB +SQUOZE 10,ORCA +SQUOZE 10,ORCAI +SQUOZE 10,ORCAM +SQUOZE 10,ORCAB +SQUOZE 10,SETCM +SQUOZE 10,SETCMI +SQUOZE 10,SETCMM +SQUOZE 10,SETCMB + +SQUOZE 10,ORCM +SQUOZE 10,ORCMI +SQUOZE 10,ORCMM +SQUOZE 10,ORCMB +SQUOZE 10,ORCB +SQUOZE 10,ORCBI +SQUOZE 10,ORCBM +SQUOZE 10,ORCBB +SQUOZE 10,SETO +SQUOZE 10,SETOI +SQUOZE 10,SETOM +SQUOZE 10,SETOB +SQUOZE 10,HLL +SQUOZE 10,HLLI +SQUOZE 10,HLLM +SQUOZE 10,HLLS +SQUOZE 10,HRL +SQUOZE 10,HRLI +SQUOZE 10,HRLM +SQUOZE 10,HRLS +SQUOZE 10,HLLZ +SQUOZE 10,HLLZI +SQUOZE 10,HLLZM +SQUOZE 10,HLLZS +SQUOZE 10,HRLZ +SQUOZE 10,HRLZI +SQUOZE 10,HRLZM +SQUOZE 10,HRLZS +SQUOZE 10,HLLO +SQUOZE 10,HLLOI +SQUOZE 10,HLLOM +SQUOZE 10,HLLOS +SQUOZE 10,HRLO +SQUOZE 10,HRLOI +SQUOZE 10,HRLOM +SQUOZE 10,HRLOS +SQUOZE 10,HLLE +SQUOZE 10,HLLEI +SQUOZE 10,HLLEM +SQUOZE 10,HLLES +SQUOZE 10,HRLE +SQUOZE 10,HRLEI +SQUOZE 10,HRLEM +SQUOZE 10,HRLES +SQUOZE 10,HRR + SQUOZE 10,HRRI +SQUOZE 10,HRRM +SQUOZE 10,HRRS +SQUOZE 10,HLR +SQUOZE 10,HLRI +SQUOZE 10,HLRM +SQUOZE 10,HLRS + +SQUOZE 10,HRRZ +SQUOZE 10,HRRZI +SQUOZE 10,HRRZM +SQUOZE 10,HRRZS +SQUOZE 10,HLRZ +SQUOZE 10,HLRZI +SQUOZE 10,HLRZM +SQUOZE 10,HLRZS +SQUOZE 10,HRRO +SQUOZE 10,HRROI +SQUOZE 10,HRROM +SQUOZE 10,HRROS +SQUOZE 10,HLRO +SQUOZE 10,HLROI +SQUOZE 10,HLROM +SQUOZE 10,HLROS +SQUOZE 10,HRRE +SQUOZE 10,HRREI +SQUOZE 10,HRREM +SQUOZE 10,HRRES +SQUOZE 10,HLRE +SQUOZE 10,HLREI +SQUOZE 10,HLREM +SQUOZE 10,HLRES +SQUOZE 10,TRN +SQUOZE 10,TLN +SQUOZE 10,TRNE +SQUOZE 10,TLNE +SQUOZE 10,TRNA +SQUOZE 10,TLNA +SQUOZE 10,TRNN +SQUOZE 10,TLNN +SQUOZE 10,TDN +SQUOZE 10,TSN +SQUOZE 10,TDNE +SQUOZE 10,TSNE +SQUOZE 10,TDNA +SQUOZE 10,TSNA +SQUOZE 10,TDNN +SQUOZE 10,TSNN +SQUOZE 10,TRZ +SQUOZE 10,TLZ +SQUOZE 10,TRZE +SQUOZE 10,TLZE +SQUOZE 10,TRZA +SQUOZE 10,TLZA +SQUOZE 10,TRZN +SQUOZE 10,TLZN +SQUOZE 10,TDZ +SQUOZE 10,TSZ +SQUOZE 10,TDZE +SQUOZE 10,TSZE + +SQUOZE 10,TDZA +SQUOZE 10,TSZA +SQUOZE 10,TDZN +SQUOZE 10,TSZN + +SQUOZE 10,TRC +SQUOZE 10,TLC +SQUOZE 10,TRCE +SQUOZE 10,TLCE +SQUOZE 10,TRCA +SQUOZE 10,TLCA +SQUOZE 10,TRCN +SQUOZE 10,TLCN +SQUOZE 10,TDC +SQUOZE 10,TSC +SQUOZE 10,TDCE +SQUOZE 10,TSCE +SQUOZE 10,TDCA +SQUOZE 10,TSCA +SQUOZE 10,TDCN +SQUOZE 10,TSCN +SQUOZE 10,TRO +SQUOZE 10,TLO +SQUOZE 10,TROE +SQUOZE 10,TLOE +SQUOZE 10,TROA +SQUOZE 10,TLOA +SQUOZE 10,TRON +SQUOZE 10,TLON +SQUOZE 10,TDO +SQUOZE 10,TSO +SQUOZE 10,TDOE +SQUOZE 10,TSOE +SQUOZE 10,TDOA +SQUOZE 10,TSOA +SQUOZE 10,TDON +SQUOZE 10,TSON + +EISYM1: +SQUOZE 4,BLKI +BLKI IOINST +SQUOZE 4,DATAI +DATAI IOINST +SQUOZE 4,BLKO +BLKO IOINST +SQUOZE 4,DATAO +DATAO IOINST +SQUOZE 4,CONO +CONO IOINST +SQUOZE 4,CONI +CONI IOINST +SQUOZE 4,CONSZ +CONSZ IOINST +SQUOZE 4,CONSO +CONSO IOINST + +SQUOZE 10,APR +0 +SQUOZE 10,PI +4 +SQUOZE 10,PTP +100 +SQUOZE 10,PTR +104 +SQUOZE 10,TTY +120 +SQUOZE 10,LPT +124 +SQUOZE 10,DIS +130 +SQUOZE 10,DC +200 +SQUOZE 10,UTC +210 +SQUOZE 10,UTS +214 + + +SQUOZE 10,LDBI ;REALLY ILDB, +LDBI +SQUOZE 10,DPBI ;AND IDPB +DPBI +SQUOZE 10,CLEAR +CLEAR +SQUOZE 10,CLEARI +CLEARI +SQUOZE 10,CLEARM +CLEARM +SQUOZE 10,CLEARB +CLEARB +SQUOZE 10,ADJBP +IBP +IRPS INST,,FAD FSB FMP FDV +SQUOZE 10,INST!RI +INST!RL +TERMIN + +IFN DECSW\TNXSW,[ +IFE TNXSW,[ +DEFINE DECDF1 FOO/ +IRPS X,,FOO +SQUOZE 10,X +X +.ISTOP TERMIN TERMIN +] +IFN TNXSW,[;; RESET IS BOTH A JSYS AND A CALLI!! +DEFINE DECDF1 FOO/ +IRPS X,,FOO +IFSN X,RESET,[SQUOZE 10,X +X] +.ISTOP TERMIN TERMIN +] +.DECUU DECDF1 +.DECTT DECDF1 +IFE SAILSW,.DECMT DECDF1 +.DECCL DECDF1 +IFN SAILSW,.DECMS DECDF1 +IFE SAILSW,.DEC.J DECDF1 +IFN SAILSW,.DECJB DECDF1 +.DECJH DECDF1 + +IFN TNXSW,[;; DEFINE JSYS'S ON TENEX VERSION +DEFINE TNXDF1 FOO/ +IRPS X,,FOO +SQUOZE 10,X +X +.ISTOP TERMIN TERMIN +.TNXJS TNXDF1 +]] +SQUOZE 10,.OSMID +OSMIDAS +SQUOZEE 4,.SITE +A.SITE +SQUOZE 4,RIM10 +ARIM10,,SRIM +SQUOZE 4,SBLK +SBLKS,,SRIM +SQUOZE 4,RIM +ARIM,,SRIM +SQUOZE 4,SQUOZE +ASQOZ +SQUOZE 4,.RSQZ +-1,,ASQOZ +SQUOZE 4,XWD +AXWORD +SQUOZE 4,CONSTA +CNSTNT +SQUOZE 4,ASCIC +EOFCH,,AASCIZ +SQUOZE 4,RADIX +ARDIX + +SQUOZE 4,END +AEND +SQUOZE 4,TITLE +ATITLE +SQUOZE 4,.BEGIN +A.BEGIN +SQUOZE 4,.END +A.END +SQUOZE 4,VARIAB +AVARIAB +SQUOZE 4,SIXBIT +ASIXBIT +SQUOZE 4,ASCII +AASCII +SQUOZE 4,ASCIZ +AASCIZ +SQUOZE 4,.ASCII +A.ASCII +SQUOZE 4,.ASCVL +A.ASCV +SQUOZE 4,BLOCK +ABLOCK +SQUOZE 4,LOC +ALOC +SQUOZE 4,OFFSET +AOFFSET +SQUOZE 4,.SBLK +SIMBLK +SQUOZE 4,RELOCA +ARELOCA +SQUOZE 4,1PASS +A1PASS +SQUOZE 4,.DECRE +A.DECRE +SQUOZE 4,.DECTX +A.DCTX + +SQUOZE 4,.DECTW +A.DECTW +SQUOZE 4,NOSYMS +ANOSYMS +SQUOZE 4,EXPUNGE +AEXPUNGE +SQUOZE 4,EQUALS +AEQUALS +SQUOZE 4,NULL +ANULL +SQUOZE 4,SUBTTL +ANULL +SQUOZE 4,WORD +AWORD +SQUOZE 4,.SYMTAB +A.SYMTAB +SQUOZE 4,.SEE +A.SEE +SQUOZE 4,.AUXIL +MACCR +SQUOZE 4,.MRUNT +A.MRUNT +SQUOZE 4,.SYMCN +A.SYMC +SQUOZE 4,.TYPE +A.TYPE +SQUOZE 4,.FORMAT +A.FORMAT +SQUOZE 4,.OP +A.OP +SQUOZE 4,.AOP +A.AOP +SQUOZE 4,.RADIX +A.RADIX +SQUOZE 4,.FATAL +A.FATAL +SQUOZE 4,.BP +A.BP +SQUOZE 4,.BM +A.BM +SQUOZE 4,.LZ +A.LZ +SQUOZE 4,.TZ +A.TZ +SQUOZE 4,.DPB +A.DPB +SQUOZE 4,.LDB +A.LDB +SQUOZE 4,.1STWD +A.1STWD +SQUOZE 4,.NTHWD +A.NTHWD + +IRPS X,,[.BIND=0,.KILL=3KILL,.HKILL=3SKILL,.XCREF=3NCRF,.DOWN=3DOWN] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,A.KILL +TERMIN + +SQUOZE 4,.LSTON +A.LSTN +SQUOZE 4,.LSTOF +A.LSTF + +IRPS X,,[.MLLIT=CONSML,.PASS=A.PASS,.PPASS=A.PPASS,.SUCCESS=A.SUCCESS +.HKALL=HKALL,.STGSW=STGSW,.LITSW=LITSW,.AVAL1=AVAL1,.AVAL2=AVAL2 +.ASKIP=A.ASKIP,.CURLN=CLNN,.CURPG=CPGN,.QMTCH=QMTCH,.STPLN=A.STPLN,.STPPG=A.STPPG] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,INTSYM +TERMIN + + ;CONDITIONALS (SEE ALSO IFSE, IFSN) +SQUOZE 4,IFG +JUMPG A,COND +SQUOZE 4,IFGE +JUMPGE A,COND +SQUOZE 4,IFE +JUMPE A,COND +SQUOZE 4,IFLE +JUMPLE A,COND +SQUOZE 4,IFL +JUMPL A,COND +SQUOZE 4,IFN +JUMPN A,COND +SQUOZE 4,.ELSE +SKIPE A.ELSE +SQUOZE 4,.ALSO +SKIPN A.ELSE + +SQUOZE 4,IF1 +TRNE FF,COND1 +SQUOZE 4,IF2 +TRNN FF,COND1 +SQUOZE 4,IFDEF ;ASSEMBLE IF SYM DEFINED +JUMPG A,DEFCND +SQUOZE 4,IFNDEF ;ASSEMBLE IF SYM NOT DEFINED +JUMPE A,DEFCND +SQUOZE 4,IFB ;ASSEMBLE IF STRING BLANK (HAS NO SQUOZE CHARS) +JUMPLE C,SBCND +SQUOZE 4,IFNB ;ASSEMBLE IF STRING NOT BLANK +JUMPG C,SBCND +SQUOZE 4,IFSQ ;ASSEMBLE IF STRING ARG IS ALL SQUOZE +JUMPLE B,SBCND +SQUOZE 4,IFNSQ ;ASSEMBLE IF STRING ARG IS NOT ALL SQUOZE. +JUMPG B,SBCND + +SQUOZE 4,PRINTX +APRIN2,,APRINT +SQUOZE 4,PRINTC +APRIN3,,APRINT +SQUOZE 4,COMMEN +APRIN1,,APRINT +SQUOZE 4,.TYO +A.TYO +SQUOZE 4,.TYO6 +A.TYO6 +SQUOZE 4,.ERR +A.ERR + +SQUOZE 4,.RELP +A.RELP +SQUOZE 4,.ABSP +A.ABSP +SQUOZE 4,.RL1 +A.RL1 +SQUOZE 4,.LIBRA +LLIB,,A.LIB +SQUOZE 4,.LENGTH +A.LENGTH +SQUOZE 4,.LIFS +LTCP,,A.LIB +SQUOZE 4,.ELDC +A.ELDC +IRPS A,,E N G LE GE L +SQUOZE 4,.LIF!A +JUMP!A A.LDCV +TERMIN +SQUOZE 4,.SLDR +A.SLDR + +SQUOZE 4,. +GTVLP +SQUOZE 4,.LOP +A.LOP +SQUOZE 40,$. +0 +SQUOZE 44,$R. +0 +SQUOZE 40,$O. ;(OH) GLOBAL OFFSET +0 +SQUOZE 40,$L. ;REAL LOCATION (WITHOUT OFFSET) +0 +SQUOZE 40,.LVAL1 +0 +SQUOZE 40,.LVAL2 +0 +SQUOZE 4,.LNKOT +A.LNKOT +SQUOZE 4,.NSTGW +1,,STGWS +SQUOZE 4,.YSTGW +-1,,STGWS +SQUOZE 4,.LIBRQ +A.LIBRQ +SQUOZE 4,.GLOBAL +ILGLI,,A.GLOB +SQUOZE 4,.SCALAR +ILVAR,,A.GLOB +SQUOZE 4,.VECTOR +ILVAR\ILFLO,,A.GLOB + +SQUOZE 4,.BYTC +NBYTS,,INTSYM +SQUOZE 4,.BYTE +A.BYTE +SQUOZE 4,.WALGN +A.WALGN + +;CREF PSEUDO-OPS. +SQUOZE 4,.CRFON +A.CRFN ;START CREFFING. +SQUOZE 4,.CRFOFF +A.CRFFF ;STOP CREFFING. +SQUOZE 4,.CRFIL +CRFILE,,INTSYM + +IFE CREFSW,[ + A.CRFN==ASSEM1 ;THESE DO NOTHING IF CAN'T CREF. + A.CRFFF==ASSEM1 +] + +IFN MACSW,[ ;MACRO PROCESSOR PSEUDOS +;MACROS GET DEFINED AS +;SQUOZE 4, +;,, MACCL + +SQUOZE 4,REPEAT +AREPEAT +SQUOZE 4,DEFINE +ADEFINE +SQUOZE 4,IRP +NIRPO,,AIRP +SQUOZE 4,IRPC +NIRPC,,AIRP +SQUOZE 4,IRPS +NIRPS,,AIRP +SQUOZE 4,IRPW +NIRPW,,AIRP +SQUOZE 4,IRPNC +NIRPN,,AIRP +SQUOZE 4,TERMIN +ATERMIN +SQUOZE 4,.QUOTE +A.QOTE +SQUOZE 4,.STOP +(400000)A.STOP +SQUOZE 4,.ISTOP +A.STOP +SQUOZE 4,.RPCNT +CRPTCT,,INTSYM +SQUOZE 4,.GSSET +A.GSSET +SQUOZE 4,.GSCNT +GENSM,,INTSYM +SQUOZE 4,.GO +A.GO +SQUOZE 4,.TAG +A.TAG +SQUOZE 4,.IRPCNT +CIRPCT,,INTSYM +IFN RCHASW,[SQUOZE 4,.TTYMAC +A.TTYM +] +SQUOZE 4,IFSE +SKIPN SCOND +SQUOZE 4,IFSN +SKIPE SCOND +] + +IFN FASLP,[ +SQUOZE 4,.FASL +A.FASL +SQUOZE 4,.ARRAY ;3 INDEX TO AFDMY1 TBL +AFATOM(3) +SQUOZE 4,.ATOM +AFATOM(AFDMAI) ;2 INDEX TO AFDMY1 TBL +AFDMAI==2 ;INDEX OF ATOM IN AFDMY1 TBL +SQUOZE 4,.FUNCT +AFATOM(1) ;1 " " " " +SQUOZE 4,.SPECI +AFATOM(0) ;0 " " " " +SQUOZE 4,.SX +AFLIST(1) ;NORMAL LIST +SQUOZE 4,.SXEVA +AFLIST ;EVAL LIST AND THROW VALUE AWAY +SQUOZE 4,.SXE +AFLIST(2) ;EVAL LIST AND "RETURN" VALUE +SQUOZE 4,.ENTRY +AFENTY ;DECLARE LISP ENTRY POINT (SUBR ETC) +] + +IFN TS,[ +SQUOZE 4,.FNAM1 +RFNAM1,,INTSYM +SQUOZE 4,.FNAM2 +RFNAM2,,INTSYM +SQUOZE 4,.INSRT +A.INSRT +SQUOZE 4,.INEOF +A.INEO +IRPS X,,I O +IRPS Y,,1 2 +SQUOZE 4,.!X!FNM!Y +X!FNM!Y,,INTSYM +TERMIN TERMIN +SQUOZE 4,.TTYFLG +A.TTYFLG,,INTSYM +] +IFN .I.FSW,[ +SQUOZE 4,.F +A.F +SQUOZE 4,.I +A.I +] +IFN TSSYMS,[ +IRPS X,,UAI UAO BAI BAO UII UIO BII BIO +SQUOZE 10,.!X +.IRPCN +TERMIN + +IRPS X,Y,START LFILE STP+SYM JCL PFILE STB CONV+XUNAME + SQUOZE 10,..R!X + .IRPCN+1 +IFSN Y,+,[ + SQUOZE 10,..S!X + 400000+.IRPCN+1 +] TERMIN +] + +EISYMT: PRINTA \.-MACTBA-1, words initialization coding. +IFN DECSW,[ +IFNDEF MACL,MACL=.+5-MACTBA +IFGE .-MACTBA-MACL,.ERR MACL TOO SMALL +] + +IFN ITSSW,[ +IFGE .+2400-MACTBA-MACL,.ERR MACL TOO SMALL + LOC <.+1777>&-2000 +MXICLR==./2000 ;FIRST PAGE ABOVE INITIALIZING CODING + LOC &-2000 +MXIMAC==./2000 ;FIRST PAGE ABOVE INITIAL MACTBA +MAXMAC==/2000 + ;1ST PAGE MACRO TABLE CAN'T POSSIBLY USE. +IFLE MINPUR-MAXMAC,.ERR PURE TOO LOW. +PRINTA MINPUR-MAXMAC = ,\MINPUR-MAXMAC +] + +IFN TS,END BEG ;MUST BE BEFORE RELOCATABLE END STATEMENT, + ;SINCE TS MIDAS NOW TRIES TO DO MULTIPLE 1PASS ASSEMBLIES FROM SAME FILE. + ;PUTTING RELOCABLE END STATEMENT FIRST CAUSES IT TO ENCOUNTER OTHER + ;END STATEMENT IN NEW ASSEMBLY CAUSING CONFUSION + +END 100 diff --git a/src/midas/midas.352 b/src/midas/midas.352 new file mode 100644 index 00000000..e5f3f425 --- /dev/null +++ b/src/midas/midas.352 @@ -0,0 +1,13549 @@ +; -*-MIDAS-*- + +.SYMTAB 4003.,2000. ;THIS MANY FOR DEC VERSION ON DEC SYSTEM. +IFN .OSMIDAS-SIXBIT/DEC/, .SYMTAB 6003. ;ON ITS ASSEMBLE FASTER. + +TITLE MIDAS + +;AC DEFS + +FF=0 ;FLAGS +P=1 +I=2 ;INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF +AA=3 +A=4 +B=5 +C=6 +D=7 +T=10 ;NOT SO TEMP AS IN MOST PROGS W/ T +TT=11 +SYM=12 ;FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR +LINK=13 +F=14 +CH1=15 ;MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH +CH2=16 ;" " " +TM=17 ;SUPER TEMPORARY + +IFDEF .XCREF, .XCREF FF,P,I,A,B,C,D,T + +IF1,[ ;FOR PASS 1 TTY CONDITIONALS +IFDEF SAILSW,IFN SAILSW,DECSW==1 +IFDEF CMUSW,IFN CMUSW,DECSW==1 +IFDEF DECDBG,IFN DECDBG,DECSW==1 +IFDEF DECSW,IFN DECSW,DECSW==1 ? ITSSW==0 ? TNXSW==0 +IFDEF ITSSW,IFN ITSSW,ITSSW==1 ? DECSW==0 ? TNXSW==0 +IFDEF TNXSW,IFN TNXSW,TNXSW==1 ? DECSW==0 ? ITSSW==0 +] ; IF1 +IFNDEF ITSSW,ITSSW==IFDEF .IOT,[1] .ELSE 0 ;NON-ZERO => ITS VERSION +IFNDEF TNXSW,TNXSW==IFDEF GTJFN,[1] .ELSE 0 ;NON-ZERO => TENEX VERSION +IFNDEF DECSW,DECSW==IFDEF LOOKUP,[1-TNXSW] .ELSE 0 ;NON-ZERO => DEC VERSION + ; TNXSW SINCE OLD VERSIONS OF TENEX MIDAS HAD DEC + ; UUO'S DEFINED TOO ONCE UPON A TIME +IF1 IFN ITSSW+DECSW+TNXSW-1,.FATAL So what monitor is MIDAS supposed to run under? +IFNDEF DECDBG,DECDBG==0 ;NON-ZERO => DEC VERSION TO RUN WITH DEC DDT. +IFN DECSW,[ +IFNDEF SAILSW,SAILSW==IFDEF SPCWAR,[1] .ELSE 0 ;NON-ZERO => SAIL VERSION. +IFNDEF CMUSW,CMUSW==IFDEF CMUDEC,[1] .ELSE 0 ;NON-ZERO => CMU VERSION. +] +IFE DECSW,SAILSW==0 ? CMUSW==0 ;CAN'T BE SAIL OR CMU FOR ITS OR TENEX VERSION +IFNDEF SMALSW,SMALSW==DECSW- ;NON-ZERO => SMALL MIDAS (NORMALLY + ; FOR RANDOM DEC SITES ONLY) +IFNDEF DECBSW,DECBSW==IFE DECSW,[0] .ELSE IFN SAILSW,[0] .ELSE SMALSW + ;NON-ZERO => INCLUDE DECBTS +IFN ITSSW\DECSW\TNXSW,TS==1 +IFNDEF TS,TS==1 ;NON-ZERO => TIME-SHARING VERSION +IFE TS,1PASS +IFNDEF A1PSW, A1PSW==TS ;NON-ZERO => 1PASS END-OF-PROGRAM AUTO-REASSEMBLY +IF1 .ERR Why not flush TSSYMS switch? +IFNDEF TSSYMS, TSSYMS==ITSSW ;NON-ZERO => .UAI, ETC. (AND ..RJCL, ETC) + ; - EVER USE THEM? +IFNDEF BRCFLG, BRCFLG==0 ;NON-ZERO => BRACES { AND ~ ARE SPECIAL IN MACRO + ; ARGS, ETC. JUST LIKE BRACKETS. BRACES ARE SPECIAL + ; IN CONDITIONALS REGARDLESS OF BRCFLG. +IFNDEF CREFSW, CREFSW==ITSSW ;NON-ZERO => ALLOW C SWITCH TO CAUSE CREF OUTPUT. +IFNDEF LISTSW, LISTSW==1 ;NON-ZERO => ALLOW L SWITCH TO CAUSE A LISTING. +IFNDEF RCHASW, RCHASW==TS ;NON-ZERO => INCLUDE TTY AS POSSIBLE INPUT DEVICE +IFNDEF PURESW, PURESW==TS ;NON-ZERO => SEPARATE PURE CODING FROM IMPURE AND + ; DO PAGE SKIPS. +IFNDEF FASLP, FASLP==1-SMALSW ;NON-ZERO => INCLUDE FASL OUTPUT CAPABILITY + ; NOTE!! IF RUNNING UNDER 10/50 THIS MAKES THINGS + ; SEVERAL K BIGGER THAN OTHERWISE. +IFNDEF .I.FSW, .I.FSW==1-SMALSW;NON-ZERO => INCLUDE .I, .F +IFNDEF MACSW, MACSW==1 ;NON-ZERO => INCLUDE MACRO PROCESSOR (!) +IFNDEF RUNTSW, RUNTSW==1 ;NON-ZERO => TYPE OUT RUN TIME AT END OF ASSEMBLY +IFNDEF WRQTSW, WRQTSW==1 ;WRQOTE (MACRO DEFINITION READER) VERSION + ; ^ 0 => SLOW, 1 => FAST; MAYBE 2 WILL EVENTUALLY BE CREATED +IFE TS,IFNDEF MACL,MACL==6*2000 ;MACRO TABLE SIZE +IFN TS,[ +IFN ITSSW,IFNDEF MACL,MACL==6000;DEFAULT MACL SIZE FOR ITS. IF WE HAVE DECBTS OR + ; TWXBTS, THIS GETS INCREASED, CAUSE THEY ARE HUGE! +.ELSE IFNDEF MACL,MACL==0 ;NON-ITS: WE WANT MACL TO JUST COVER THE INIT CODE. +IFNDEF MXMACL,MXMACL==32.*2000 ;MAXIMUM LENGTH MACTAB +] +IFNDEF MACRUM,MACRUM==4 ;# WORDS NOT USED AT END OF MACTAB +IFNDEF STRL,STRL==20 ;LENGTH OF STRING STORAGE (USED BY GSYL) +IFNDEF DMDEFL,DMDEFL==40 ;MAX NO OF DMY ARGS IN DEFINE +IFNDEF DMYAGL,DMYAGL==400 ;MAX NO COMBINED DMYARGS ALL MACROS CURRENTLY EXPANDING OR PUSHED +IFNDEF MPDLL,MPDLL==300 ;MACRO PDL LENGTH +IFNDEF DSSIZ,DSSIZ==40 ;MAX # ARGS MACRO WHOSE ARGS BEING SCANNED (SHOULD BE .GE. DMDEFL) +IFNDEF BKTABL,BKTABL==40 ;MAX NUM .BEGIN BLOCKS. +IFNDEF BKPDLS,BKPDLS==10 ;MAXIMUM .BEGIN BLOCK NESTING DEPTH. +IFNDEF BSIZE,BSIZE==37 ;PREFERRED SIZE BLOCK MAX SIZE-3 +IFN SMALSW,IFNDEF LPDL,LPDL==200. +IFNDEF LPDL,LPDL==500 ;LENGTH OF PDL +IFN SMALSW,IFNDEF CONMIN,CONMIN==1000 +IFNDEF CONMIN,CONMIN==3300 ;MINIMUM AMT OF SPACE FOR CONSTANTS TABLES. +IFNDEF CONMAX,CONMAX==20000 ;MAXIMUM SPACE USER CAN ASK FOR. +IFNDEF NCONS,NCONS==75. ;MAXIMUM NUMBER OF CONSTANTS AREAS +IFNDEF NVARS,NVARS==25. ;MAX. NUM. VARIABLES AREAS. +IFN SMALSW,IFNDEF SYMDSZ,SYMDSZ==2003. +IFNDEF SYMDSZ,SYMDSZ==2707. ;DEFAULT # SYMS IN SYMTAB. +IFNDEF SYMMSZ,SYMMSZ==10177*2 ;# SYMS IF JNAME IS MMIDAS. +IFNDEF SYMMAX,SYMMAX==40000 ;MAX SYMTAB SIZE (# SYMS) +IFNDEF FASBL,FASBL==400 ;WORDS USED FOR FASL OUTPUT BUFFER + ; MUST HOLD STUFF ASSOC WITH ONE GROUP OF 9 CODE BYTES +IFNDEF FASATL,FASATL==2000 ;WORDS USED FOR FASL ATOM TABLE + ; HOLDS PNAMES ETC OF ALL ATOMS AS WILL BE IN FASLOAD'S + ; SYMTAB AT LOAD TIME +IFNDEF MINWPS,MINWPS==3 ;MIN # WORDS IN SYMTAB ENTRY +IFNDEF MAXWPS,MAXWPS==3 ;MAX # ALLOWED (WILL BE BIGGER SOME DAY) +IFNDEF NRMWPS,NRMWPS==3 ;DEFAULT #. 2 WDS FOR VALUE & FLAGS, 1 FOR NAME. + ; VERSION, FLAGS, ETC. + +IF1 [ + +IFNDEF MIDVRS,MIDVRS=.FNAM2 +IFE MIDVRS-SIXBIT/MID/,[ +PRINTX /What is MIDAS version number? / +.TTYMAC VRS +MIDVRS=SIXBIT/VRS/ +TERMIN +] + +;OSMIDAS GETS THE SIXBIT NAME OF THE TYPE OF OP. SYS. THE VERSION OF MIDAS +;IS BEING ASSEMBLED TO RUN UNDER. IT WILL BE THE VALUE OF ".OSMIDAS" WHEN PROGRAMS +;ARE ASSEMBLED WITH THIS MIDAS. +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/ + +;FF FLAGS NOT PUSHED +;LEFT HALF +FL==1,,525252 +FLPPSS==400000 ;ONE IF PUNCHING PASS; MUST BE SIGN +FLHKIL==100000 ;ONE IF SYM TO BE SEMI KILLED IN DDT + +FLVOT==40000 ;ALL RCH S MUST GO THRU RCH + ; IE TYPCTL .NE. POPJ P, (SET/CLEARED BY MDSSET, MDSCLR) +FLMAC==20000 ;ONE IF CHARS COMING FROM MACRO PROCESSOR, DON'T HACK CPGN/CLNN +FLTTY==10000 ;ONE IF CHARS FROM SOMEWHERE ELSE BUT NOT HACKING CPGN/CLNN +$FLOUT==4000 ;ONE IF OUTPUT HAS OCCURED IN CURRENT MODE (USED BY TS NED LOGIC) +FLPTPF==2000 ;SET IF (TIME SHARING) OUTPUT DEVICE IS PTP +FLUNRD==1000 ;=> RE-INPUT LAST CHARACTER (SEE RCH) + + +;FF RIGHT HALF FLAGS + +FR==525252 +FRFIRWD==400000 ;ONE FOR FIRST WORD OF BLOCK +FRSYMS==200000 ;ONE IF SYM PUNCH DESIRED +FRLOC==100000 ;ONE BETWEEN ABS LOC ASSIGN AND + ;FIRST BLOCK OUTPUT THEREAFTER (EBLK TO OUTPUT NULL BLOCK SO LINKING LOADER KNOWS $.) + +FRNPSS==40000 ;ONE IF TWO PASS ASSEMBLY +FRPSS2==20000 ;ONE ON PASS 2 + +FRINVT==4000 ;USED BY PBITS AND OUTPUT TO OUTPUT WORDS OF CODE BITS IN CORRECT ORDER (STEAD LOGICAL) +FRNLIK==2000 ;TEMPORARILY SUPPRESS ADR LINKING +FRGLOL==1000 ;ONE IF LOCATION PLUS OFFSET IS GLOBAL + +FRBIT7==400 ;SET IF LAST TIPLE OF CODEBITS WAS 7. +FRMRGO==200 ;MACRO PROC TO RETURN TO .GO HACKER W/O READING NEXT CHAR (SEE RCHSAV) + +FRCMND==40 ;SET WHILE READING CMD, TELLS RFD TO NOTICE (, _, COMMA. +FRNNUL==20 ;SET ON RETURN FROM RFD IFF NONNULL SPEC. +FRARRO==10 ;TELLS RFD THAT 1ST NAME IS FN1, NOT FN2. + +] ;END IF1 + ;INDICATOR REGISTER + +IF1 [ + +;LEFT HALF +IL==1,,525252 +ILGLI==1 ;SET ON " CLEARED EACH SYL +ILVAR==2 ;SET ON ' " " " +ILFLO==4 ;FLOATING NUM, SET ON DIGIT AFTER . +ILDECP==10 ;DECIMAL PREFER, SET WHEN . SEEN. +ILUARI==20 ;1 => RIGHT OPERAND TO UPARROW BEING READ +ILLSRT==40 ;RETURN FROM < +ILWORD==400 ;SET IF CURRENT WORD IS NOT NULL RETURNED BY GETWORD +ILNPRC==1000 ;ONE IF NUMBER ALREADY PROCESSED BY UPARROW +ILMWRD==4000 ;SET ON MULTIPLE WORD +ILPRN==10000 ;SET DURING MACCL IF MACRO NAME WAS FOLLOWED BY (. +ILMWR1==20000 ;SET BY LBRAK AS SIGNAL TO ITSELF THAT THIS NOT FIRST + ;WORD OF MULTI-WORD CONSTANT +ILNOPT==40000 ;CONSTANTS OPTIMIZATION SUPPRESSION FLAG; SHOULD BE SET BY + ;VALUE-RETURNING PSEUDO DURING NOT PUNCHING PASS TO KEEP ITSELF OUT OF + ;CONSTANTS OPTIMIZATION + +;RIGHT HALF + +IR==525252 +IRFLD==1 ;SET IF FLD NOT NULL +IRSYL==2 ;SET IF SYL NOT NULL +IRLET==4 ;SET IF SYL IS SYMBOL +IRDEF==10 ;SET IF CURRENT EXPR DEFINED +IRNOEQ==20 ;SET IF = ISN'T ALLOWED IN CURRENT CONTEXT. +IRCOM==40 ;SET IF CURRENT QUAN IS COMMON +IRPERI==100 ;SET IF PERIOD SEEN IN WHAT IS SO FAR (INCL .) A NUMBER +IREQL==200 ;ONE DURING READING WORD TO RIGHT OF = +IRIOINS==400 ;FIRST FIELD OF CURRENT WORD HAS IO INST +IRCONT==1000 ;SET IF NOT OK TO END BLOCK +IRPSUD==4000 ;SET IF ERROR COMMENTS WILL COME FROM PSEUDO +IRGMNS==20000 ;SET IF ILUARI OR BAKARI HAS GOBBLED MINUS +IROP==200000 ;SET IF OPERATOR SEEN IN CURRENT FIELD + +CALL=PUSHJ P, +RET=POPJ P, +SAVE=PUSH P, +REST=POP P, + +ETSM=1000,, ;ERROR, TYPE SYM. +ETR=2000,, ;ERROR, ORDINARY MESSAGE. +ERJ=3000,, ;ERROR, NO MESSAGE, RETURN TO ADDR. +ETI=4000,, ;ERROR, IGNORE LINE, RET. TO ASSEM1. +ETA=5000,, ;ERROR, RET. TO ASSEM1. +ETASM=6000,, ;ERROR, TYPE SYM AND RETURN TO ASSEM1 +ETF=7000,, ;FATAL ERROR. +TYPR=(37000) ;UUO, TYPE OUT ASCIZ STRING +] ;END IF1 + IF1 [ +;LINK TABLE (GLOTB), ACCUMULATES GLOBAL REFERENCES FOR CURRENT FROB (USUALLY WORD) TO OUTPUT +;GLSP2 POINTS TO (I.E. HAS ADR 1 LESS THAN) BOTTOM OF ACTIVE PART OF TABLE +;GLSP1 POINTS TO TOP (HAS ADR OF LAST ENTRY ACTIVE) + +;ACTUAL ENTRIES IN GLOTB: +;IF ENTIRE WORD ZERO, ENTRY IS NULL, WILL (OR SHOULD) BE IGNORED +;RH ADR OF SQUOZE WITH INTERNAL MIDAS FLAGS (USUALLY IN SYMBOL TABLE, BUT MAY BE ANYWHERE IN CORE) +;LH: RIGHT 10. BITS MULTIPLICATION FACTOR OR 0 => 1 + ;GLOBAL SHOULD BE MULTIPLIED BY IT +;REST OF LH FLAGS: + +;SIGN BIT => THIS NOT PART OF FIELD, DON'T PLAY WITH FLAGS AT GETFLD, INTFD +ACF==40000 ;AC LOW OR HIGH (SWAPF => HIGH) +HFWDF==100000 ;MASK GLOBAL TO HALFWORD +SWAPF==200000 ;SWAP +MINF==20000 ;NEGATIVE OF GLOBAL + +IFNDEF LBRKT,LBRKT=="[ ;LEFT DELIMITER FOR EXPLICITLY GROUPED CONDITIONALS, MACRO ARGS, REPEAT BODY, ETC. +IFNDEF RBRKT,RBRKT=="] ;RIGHT " +IFNDEF WPS, WPS==3 ;# CONTIG. WDS /STE. IFNDEF FOR DEBUGGING. +IFNDEF BKWPB,BKWPB==3 ;# WDS/BKTAB ENTRY. +IFNDEF EOFCH,EOFCH==3 ;EOF CHAR, BEWARE DISPATCH TABLE ENTRIES. +IFNDEF LBRACE,LBRACE=="{ +IFNDEF RBRACE,RBRACE=="~ + +;3RDWRD LH. SYM TAB BITS + +3REL==600000 ;RELOC BITS, DO NOT CHANGE, SOMETIMES REFERENCED BY NUMERIC BYTE POINTERS +3RLL==400000 ;R(LH) +3RLR==200000 ;R(RH) +3RLNK==100000 ;R(LINK) +3KILL==40000 ;FULLY-KILLED SYM (DON'T GIVE TO DDT). +3VP==20000 ;VALUE PUNCHED +3SKILL==10000 ;SEMI KILL IN DDT +3LLV==4000 ;LINKING LOADER MUST INSERT VAL +3VAS2==2000 ;VAR SEEN ON PASS TWO WITH ' +3VCNT==1000 ;USED IN CONSTANT +3MAS==400 ;THIS ISN'T THE LAST DEFINITION OF A SYM WITH THIS NAME + ;(SO ES MUST KEEP SEARCHING). +3NCRF==200 ;DON'T CREF THIS SYMBOL. +3MACOK==100 ;OK TO (RE)DEFINE THIS SYM AS MACRO. + ;(IE IS A MACRO OR SEEN ONLY IN .XCREF) +3LABEL==40 ;ILLEGAL TO REDEFINE THIS SYM TO DIFFERENT VALUE +3MULTI==20 ;THIS SYM IS MULTIPLY DEFINED, SO FLAG ALL DEFINITIONS. +3DOWN==10 ;THIS DEFINITION SHOULD BE SEEN BY SUBBLOCKS IN 1PASS MODE. + +3DFCLR==737110 ;BITS IN LH TO CLEAR ON REDEFINITION. + +;CONTROL FLAGS +;LEFT HALF +TRIV==400000 ;1 IF OUT FORM IS FOR TRIVIAL LOADER (ABSOLUTE) +;RIGHT HALF +ARIM==2 ;IF ONE OUT FOR IS RIM +SBLKS==10 ;IF ONE OUT FORM IS SIMPLE BLOCKS +ARIM10==20 ;PDP-10 RIM +DECREL==40 ;DEC RELOCATABLE FORMAT (CONSIDERED "ABSOLUTE" INSIDE MIDAS) +FASL==100 ;LISP FASL COMPATIBLE RELOCATABLE FORMAT ( " " ") + +PTR==104 ;DEVICE CODE FOR PAPER TAPE READER. + +] ;END IF1 + IF1 [ + +;SQUOZE FLAG DEFINITIONS IN MIDAS SYMBOL TABLE + +CMMN==0 ;COMMON (NOT USED) +PSUDO==40000 ;PSEUDO OR MACRO, VALUE RH ADDR OF RTN (MACCL FOR MACRO), + ; LH WILL BE IN LH OF B WHEN RTN CALLED. +SYMC==100000 ;SYM, VALUE IS VALUE OF SYM. +LCUDF==140000 ;LOCAL UNDEF +DEFLVR==200000 ;DEF LOC VAR, VALUE IS VALUE. +UDEFLV==240000 ;UNDEF LOC VAR, VALUE IS 1+ IDX IN VARIAB. AREA, BUT IGNORD IF VAR AREA GLOB. +LGBLCB==300000 ;CODE BITS EQUAL TO THIS OR HIGHER REPRESENT GLOBAL QUANTITIES +DEFGVR==300000 ;DEF GLO VAR, VALUE IS VALUE +UDEFGV==340000 ;UNDEF GLO VAR, VALUE LIKE UNDEF LOCAL VAR. +GLOETY==400000 ;GLO ENTRY +GLOEXT==440000 ;GLO EXIT +NCDBTS==GLOEXT_<-18.+4>+1 ;# CODE BIT TYPES + +DEFINE CDBCHK TBLNAM +IFN .--NCDBTS,.ERR TBLNAM LOSES +TERMIN + +;LOADER BLOCK TYPES LINK +LLDCM==1 ;LOADER COMMAND BLOCK +LABS==2 ;ABSOLUTE +LREL==3 ;RELOCATABLE +LPRGN==4 ;PROG NAME +LLIB==5 ;LIBRARY BLOCK +LCOMLOD==6 ;LOAD INTO COMMON +LGPA==7 ;GLOBAL PARAMETER ASSIGN +LDDSYM==10 ;LOCAL SYMS +LTCP==11 ;LOAD TIME COND ON PRESENCE +ELTCB==12 ;END LOAD TIME COND +LPLSH==22 ;POLISH FIXUP + +;LOADER COMMANDS +;IN ADR OF LDCMD BLK +LCJMP==1 ;JUMP +LCGLO==2 ;GLOBAL LOC ASSIGN +LCCMST==3 ;SET COMMON BENCHMARK +LCEGLO==4 ;END OF GLOBAL BLOCK +LDCV==5 ;LOAD TIME COND ON VALUE +LDOFS==6 ;LOADER SET GLOBAL OFFSET +LD.OP==7 ;LOADER .OP + +;LOADER CODEBITS SECOND SPEC AFTER 7 +CDEF==0 ;DEF +CCOMN==1 ;COMMON REL +CLGLO==2 ;LOC-GLO REC +CLIBQ==3 ;LIBREQ +CRDF==4 ;GLO REDEF +CRPT==5 ;REPEAT GLOBAL VALUE +CDEFPT==6 ;DEFINE SYM AS $. + +;DEC RELOCATABLE BLOCK TYPES. +DECWDS==1 ;STORAGE WORDS. +DECSYM==2 ;SYMBOL DEFS OR GLOBAL ADDITIVE RQS. +DECHSG==3 ;LOAD INTO HIGH SEG (FOR .DECTWO) +DECENT==4 ;ENTRY NAMES +DECEND==5 ;END BLOCK, HAS PROGRAM BREAK. +DECNAM==6 ;PROGRAM NAME. +DECSTA==7 ;STARTING ADDRESS BLOCK. +DECINT==10 ;INTERNAL REQUEST +DECRQF==16 ;REQUEST LOADING A FILE +DECRQL==17 ;REQUEST LOADING A LIBRARY +] ;END IF1 + IF1 [ + +DEFINE PRINTA A,B,C,D,E,F +IF1,[PRINTC A!B!C!D!E!F +] +TERMIN + +IF1 [DEFINE BNKBLK OP +OP +TERMIN ] + + ;ADD A LINE TO BNKBLK, ACCUMULATED CONTENT OF + ;WHICH IS DUMPED OUT AT END OF ASSEMBLY + ;ARG TO BLCODE SHOULD BE FREE OF STORAGE WORDS + +DEFINE BLCODE NEWCFT +IF1 [BNKBLK [DEFINE BNKBLK OP +OP]NEWCFT +TERMIN ] +IF2 [IRPW X,,[ +NEWCFT +] +IRPS Y,,X +Y=Y +.ISTOP TERMIN TERMIN ] TERMIN + + ;3RDWRD MANIPULATING MACROS + ;GET 3RDWRD INTO LH("A"), "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3GET A,B + MOVE A,ST+2(B) + TERMIN + + ;GET 3RDWRD INTO "A", "B" HAS ADR OF 1STWRD + +DEFINE 3GET1 A,B + MOVE A,2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3PUT A,B + MOVEM A,ST+2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS ADR OF 1STWRD + +DEFINE 3PUT1 A,B + MOVEM A,2(B) + TERMIN + +] ;END IF1 + ;RANDOM MACRO DEFINITIONS + +IF1 [ + + ;A HAS ADR OF SYM SQUOZE, SKIP IF IT'S IN SYMBOL TABLE + +DEFINE SKPST A + CAIL A,ST + CAML A,MACTAD +TERMIN + + ;EXECUTE AN INSTRUCTION WITH VARIOUS ADDRESSES (USUALLY PUSH OR POP) + +DEFINE INSIRP A,B + IRPS %ADR,,[B] + A,%ADR + TERMIN +TERMIN + +DEFINE NOVAL + TDNE I,[ILWORD,,IRNOEQ\IRFLD] + ETSM ERRNVL +TERMIN + +DEFINE NOABS + SKIPGE CONTRL + ETASM ERRABS +TERMIN + +] ;END IF1 + +ERRNVL==[ASCIZ /Returns no value/] +ERRABS==[ASCIZ /Allowed only for STINK relocatable format/] + +IF1 [ + +DEFINE MOVEIM B,C + MOVEI A,C + MOVEM A,B +TERMIN + +DEFINE MOVEMM B,C + MOVE A,C + MOVEM A,B +TERMIN +] ;END IF1 + IF1 [ +IFN 0,[ +;THESE ARE SOME MACRO DEFINITIONS FOR THE UNFINISHED MULTI-WORD +;SYMBOL NAME FEATURE. FOR COMPATIBILITY, THEY ALL NOW HAVE DEFINITIONS +;THAT ONLY HANDLE ONE WORD. THOSE OTHER DEFINITIONS COME AFTER THESE. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +IFSN X,SYM,SKIPE A,X+1 +.ELSE SKIPE A,SYMX + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y + MOVE Z,X+1 + MOVEM Z,Y+1 +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y + MOVE Z,AC!X + MOVEM Z,Y+1 +TERMIN +] + +.ELSE [ +;THESE ARE THE DEFINITIONS OF THE MACROS THAT DO NOT IMPLEMENT +;MULTI-WORD SYMBOL NAMES. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y +TERMIN +] + +DEFINE USING X +X,TERMIN + +] ;END IF1 + IFN DECSW\TNXSW,[ +IF1 [ +IFE .OSMIDAS-SIXBIT/ITS/,[ + IFE CMUSW\SAILSW\TNXSW,.INSRT SYS:DECDFS + IFN SAILSW, .INSRT SYS:SAIDFS + IFN CMUSW, .INSRT SYS:CMUDFS + IFN TNXSW, .INSRT SYS:TNXDFS +] ;IF ASSEMBLED ON ITS +IFN .OSMIDAS-SIXBIT/ITS/,[ ;OTHER PLACES DON'T KEEP THESE ON SYS: + IFE CMUSW\SAILSW\TNXSW,.INSRT DECDFS + IFN SAILSW, .INSRT SAIDFS + IFN CMUSW, .INSRT CMUDFS + IFN TNXSW, .INSRT TNXDFS +] ;IF ASSEMBLED ON A NON-ITS PLACE +IFN DECSW,.DECDF + +IFN TNXSW,.TNXDF + +EXPUNGE .SUSET +DEFINE .SUSET A +TERMIN + +EXPUNGE HALT +DEFINE HALT + JRST 4,. +TERMIN + +EXPUNGE .VALUE +EQUALS .VALUE HALT +DEFINE .LOSE A + JRST 4,.-1 +TERMIN +] ;IF1 +IFN PURESW,.DECTWO +IFE PURESW,.DECREL +RL0==. +] ;IFN DECSW\TNXSW + +IFN ITSSW,[IF1 [IFNDEF .IOT,[.INSRT SYS:ITSDFS + .ITSDF +] ;IFNDEF .IOT +IFNDEF %PIPDL,.INSRT SYS:ITSBTS + HALT==.VALUE + EXPUNG .JBTPC,.JBCNI + +DEFINE SYSCAL A,B + .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] +TERMIN +] ;IF1 +RL0==0 +IFDEF .SBLK,.SBLK +] ;IFN ITSSW + IFE PURESW,[ ;FOLLOWING IF NOT ASSEMBLING PURE CODING + +DEFINE PBLK +TERMIN + +DEFINE VBLK +TERMIN +] + +IFN PURESW,[ ;FOLLOWING IF ASSEMBLING PURE CODING + +;MEMORY ORGANIZATION PURE CODING + +;MAXVAR BLOCKS OF IMPURE CODING, NO DYNAMIC ALLOCATION + ;BLCODE MACRO ACCUMULATES CODING TO BE PUT AT END OF + ;IMPURE CODING, NO STORAGE WORDS ALLOWED +;THEN SYM TAB, STARTING AT ST. +;THEN MACRO TABLE (WITH INIT. CODE IN IT) +;STARTING INITIALLY AT MACTBA, ACTUAL ADDR IN MACTAD. +;SYMTAB AND MACTAB DON'T NECESSARILY START ON PAGE BNDRYS. +;THEN GAP TO MINPUR*2000 (HEREAFTER KNOWN AS "THE GAP") +IFN DECSW\TNXSW,MINPUR==200 +IFN ITSSW,MINPUR==160 ;BLOCK NUMBER BEGINNING OF PURE CODING +;PURE CODING UNTIL MAXPUR*2000-SOMETHING +;THE FOLLOWING MACROS AND BLCODE MAKE IT NOT COMPLETELY NECESSARY +;TO SEPARATE PURE CODING FROM IMPURE + +CKPUR==0 ;0 => ASSEMBLING BELOW THE GAP, 1 ABOVE + + ;SWITCH TO CODING ABOVE THE GAP + +DEFINE PBLK +IFN CKPUR,.ERR PBLK +IFE CKPUR,[VAR.LC==. +LOC PUR.LC +]CKPUR==1 +TERMIN + +PUR.LC==MINPUR*2000+IFN DECSW\TNXSW,[RL0] ;SAVED LOCATION COUNTER ABOVE THE GAP WHEN ASSEMBLING BELOW + + ;SWITCH TO CODING BELOW THE GAP + +DEFINE VBLK +IFE CKPUR,.ERR VBLK +IFN CKPUR,[PUR.LC==. +LOC VAR.LC +]CKPUR==0 +TERMIN + +PBLK ;PBLK NORMAL MODE, VARIABLE AREAS BRACKETED WITH VBLK AND PBLK + +] ;END PURESW CONDITIONAL + +.YSTGW ;SET UP NOW, STORAGE WORDS OK + FOO==. +LOC 41 + JSR ERROR +IFN ITSSW,JSR TSINT +IFN DECSW,[ +LOC .JBAPR + TSINT1 +] +LOC FOO + + ;DISPATCH TABLE FOR NON-SQUOZE CHARACTERS + ;REFERENCED AS DTB-40(RH OF POPJ IN GDTAB) + ;DTB ENTRY OF SYL TERMINATOR PUT IN CDISP BY GETSYL + +DSYL==400000 ;SYL OPERATOR, DISPATCH INDEXED BY RH AT GETSYL (MUST BE SIGN) +DFLD==200000 ;FIELD OPERATOR, GETFD +DWRD==100000 ;WORD OP, GETWD +DSY1==1000 ;SET ONLY IF DSYL SET, + ;SET IF OP MIGHT BE 1ST CHAR OF NONNULL SYL. +DSYL1==DSYL+DSY1 +DSY2==400 ;SET FOR _ ONLY. + +;ALL CLEAR => WORD TERMINATOR, NO DISPATCH + +DTB: DWRD,,SPACE ;40 SP, TAB, RUBOUT + DSYL1,,RRL2 ;EXCLAIM AND OPEN-BRACE + DSYL1,,DQUOTE ;" + DFLD,,XORF ;NUM SIGN + DSYL,,RBRAK2 ;CLOSE-BRACE. + 0 ;(USED TO BE PERCENT SIGN) + DFLD,,ANDF ;AMPERSAND + DSYL1,,SQUOTE ;' + DFLD,,LEFTP ;( 50 + DSYL,,RPARN ;) + DFLD,,MULTP ; STAR TIMES + DFLD,,PLS ;+ PLUS + DWRD,,COMMA ; , + DFLD,,MINUS ;- + DSYL1,,CTLAT ;^@ (56) + DFLD,,DIVID ;/ + DSYL1,,COLON ;COLON 60 + DSYL,,SEMIC ;SEMI + DFLD,,LSSTH ;< + DSYL1,,EQUAL ;= + DSYL,,GRTHN ;> + 0 ;? + DSYL1,,ATSGN ;AT SIGN + DFLD,,LBRAK ;[ + DFLD,,IORF ;BACKSLASH 70 + DSYL,,RBRAK ;] + DSYL1,,UPARR ;^ + DSYL+DSY2,,BAKAR ;BACKARR + 0 ;CR + 0 ;(USED TO BE TAB) + 0 ;ALL OTHER + DSYL,,LINEF ;LF (DSYL TO HACK CLNN) + DSYL,,FORMF ;FORM FEED (") 100 + ;NOTE THAT POPJ P, IS VALID TEST FOR SQUOZENESS +;EXCEPT FOR EOFCH + +GDTAB: POPJ P,56 ; ^@ GETS IGNORED. + REPEAT 2,POPJ P,76 ;(GDTAB GLOBAL SO OUT OF TS, AIO CAN CLOBBER GDTAB+141 WITH JRST RREOF + ;ON OLD FILES) +IFN .-GDTAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH GDTAB. +IFE TS,[POPJ P,76] IFN TS,[JRST RREOF] + REPEAT 5,POPJ P,76 + POPJ P,40 ; TAB + POPJ P,77 ; LF + POPJ P,76 ; VERT TAB + POPJ P,100 ; FORM FEED + POPJ P,74 ; CR + REPEAT "!-16-1,POPJ P,76 + POPJ P,40 ; SPACE + POPJ P,41 ; ! + POPJ P,42 ; " + POPJ P,43 ; # + ADD SYM,%$SQ(D) ; $ + ADD SYM,%%SQ(D) ; % + POPJ P,46 ; & + POPJ P,47 ; ' + POPJ P,50 ; ( + POPJ P,51 ; ) + POPJ P,52 ; * + POPJ P,53 ; + + POPJ P,54 ; , + POPJ P,55 ; - + JSP CH1,POINT ; . + POPJ P,57 ; / + REPEAT 10.,JSP CH2,RR2 ; DIGITS + POPJ P,60 ; : + POPJ P,61 ; ; + POPJ P,62 ; < + POPJ P,63 ; = + POPJ P,64 ; > + POPJ P,65 ; ? + POPJ P,66 ; @ +IFDEF .CRFOFF,.CRFOFF +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN + POPJ P,67 ; [ + POPJ P,70 ; \ + POPJ P,71 ; ] + POPJ P,72 ; ^ + POPJ P,73 ; _ + POPJ P,76 ; NOW LOWER CASE GRAVE ACCENT + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN +IFDEF .CRFON,.CRFON + POPJ P,41 ;{ + POPJ P,76 ;| + POPJ P,44 ;~ + POPJ P,76 ; + POPJ P,40 ; RUBOUT, LIKE SPACE + IFN .-GDTAB-200,.ERR GDTAB LOSES + NSQTB: IFDEF .CRFOFF,.CRFOFF +IRPC Q,,0123456789 + ADD SYM,%!Q!SQ(D) +TERMIN + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890$%. +%!Q!SQ: 0 + SQUOZE 0,Q/50/50/50/50/50 + SQUOZE 0,Q/50/50/50/50 + SQUOZE 0,Q/50/50/50 + SQUOZE 0,Q/50/50 + SQUOZE 0,Q/50 + SQUOZE 0,Q +TERMIN +IFDEF .CRFON,.CRFON + +;FORMAT TABLE(S) +;4.9-4.4 ETC SPECIFY SHIFT +;4.4-3.6 ETC SPECIFY NUMBER BITS +;FIELD SPECS IN REVERSE ORDER + +IFORTB: 0 ;NCNSN 10 , + 0 ;NCNSF 11 IMPOS + 0 ;NCNCN 12 ,, + 2200,, ;NCNCF 13 ,,C + 2200000000 ;NCFSN 14 ,B + 0 ;NCFSF 15 ,B C + 0 ;NCFCN 16 ,B, + 0 ;NCFCF 17 ,B,C + 4400000000 ;FSNSN 20 A + 0 ;FSNSF 21 IMPOS + 0 ;FSNCN 22 IMPOS + 0 ;FSNCF 23 IMPOS + 2200440000 ;FSFSN 24 A B + 2200220044 ;FSFSF 25 A B C + 270400440000 ;FSFCN 26 A B, + 2227040044 ;FSFCF 27 A B,C + 4400000000 ;FCNSN 30 A, + 0 ;FCNSF 31 IMPOS + 22220000 ;FCNCN 32 A,, + 2200002222 ;FCNCF 33 A,,B + 2200440000 ;FCFSN 34 A,B + 0 ;FCFSF 35 A,B C + 0 ;FCFCN 36 A,B, + 0 ;FCFCF 37 A,B,C +FRTBL==.-IFORTB ;LENGTH OF FORMAT TABLE +VBLK +FORTAB: BLOCK FRTBL ;ACTUAL FORMAT TABLE +FRTBE=.-1 +PBLK + ;VARIABLE STORAGE + +VBLK + +RETURN: JRST . ;RH HAS RETURN ADR FOR END OF MAJOR ROUTINE (E.G PASS 2) +CDISP: 0 ;CURRENT DISPATCH CODE +PPRIME: 0 ;PUSH DOWN LIST MARKER (GETFLD) +SCNDEP: 0 ;DEPTH IN SUCCESSFUL BRACKET CONDITIONALS INSIDE INNERMOST LITERAL. +CONDLN: 0 ;LINE NUMBER AT WHICH LAST TOP LEVEL SUCCESSFUL CONDITIONAL ENCOUNTERED +CONDPN: 0 ;PAGE NUMBER-- PRINT THESE IF REACH END AND CONDITIONAL NOT TERMINATED +CONDFI: 0 ;SIXBIT FN1 OF FILE CONTAINING LAST TOP LEVEL SUCCESSFUL CONDITIONAL. +A.SUCC: 0 ;NONZERO IFF LAST CONDITIONAL SUCCEEDED. +ASMOUT: 0 ;0 NORMAL, 1 WITHIN <>, 2 IN (), 3 IN []. +ASMDSP: ASSEM3 ;PLACE TO JUMP TO FROM ASSEM1 LOOP. + ;ASSEM3 NORMAL. ASSEMC IF WITHIN <>, () OR [] + ;AND .MLLIT ISN'T POS. LSSTHA AFTER > OR ) SEEN. + ;[ ;CONND AFTER ] SEEN. +ASMDS1: 0 ;ASMDSP SAVED HERE DURING ASCII, SIXBIT PSEUDOS. +ASSEMP: 0 ;RESTORE P FROM HERE AT ASSEM1. SAVED OVER LITERAL. +ASMI: 0 ;REINIT I AT ASSEM2 FROM ASMI. +GLSPAS: 0 ;RESTORE GLSP1 AT ASSEM1. SAVED OVER LITERAL. +GLSP1: 0 ;POINTER TO BOT OF LINKAGE TABLE IN USE HIGH ADR +GLSP2: 0 ;POINTER TO TOP OF LINKAGE TABLE IN USE LOW ADR +FORMAT: 0 ;ACCUMULATES FORMAT WORD +FORPNR: 0 ;POINTER INTO FORMAT WORD, SHOULD BE FORMAT+1 SO CLOBBERABLE BY LAST IDPB +FLDCNT: 0 ;NUMBER OF FIELDS PUSHED DOWN IN CURRENT WORD +WRD: 0 ;ACCUMULATES VALUE OF WORD +WRDRLC: 0 ;RELOC OF WRD, MUST COME RIGHT AFTER WRD. +T1: 0 ;TEMP +T2: 0 ;TEMP +PBITS1: 0 ;CURRENT CODE BITS +PBITS2: 0 ;NO OF SPECS LEFT IN CURRENT WORD +PBITS4: 0 ;POINTER TO WHERE CURRENT CODE BITS WILL GO +OPT1: 0 ;POINTER FOR STORING IN BKBUF (OUTPUT BUFFER) +CONTRL: 0 ;FLAG REG FOR IO CONTROL ETC, .GE. 0 => RELOCATABLE/1PASS +CDATBC: 0 ;CURRENT DATA BLOCK CODE TYPE +SCKSUM: 0 ;CKSUM FOR SIMPLE BLOCK FORMAT +IFN A1PSW,[ +PRGC: -1 ;ONE LESS THAN # TIMES END HAS BEEN ENCOUNTERED +OUTN1: -1 ;.GE. 0 => OUTPUT HAS OCCURED IN OTHER THAN 1PASS MODE (NOT INITIALIZED) +OUTC: -1 ;.GE. 0 => OUTPUT HAS OCCURED DURING CURRENT ASSEMBLY +] +LINKL: 0 ;SAVE LIMIT OF GLOTB GETWRD +STRCNT: 0 ;COUNT OF CHARS READ (INCL. DELIM) BY GSYL +STRPNT: 0 ;TEMP AT GSYL, BYTE POINTER TO STRING STORAGE +ISYMF: -1 ;-1 IF ISYMS HAVE NOT BEEN SPREAD +SMSRTF: -1 ;-1 IF SYMTAB HASN'T BEEN SORTED (PSEUDOS DELETED) +BITP: 0 ;BYTE PNTR TO CODE BITS IN CURRENT (RELOC) BLOCK +LDCCC: 0 ;DEPTH IN LOADTIME CONDS +PARBIT: 0 ;0 OR 4 FOR : OR = (IN GENERAL, TEMP AT P7X) +LABELF: 0 ;-1 IN COLON, SOMETIMES IN EQUAL. CAUSES 3LABEL TO BE SET. +STGSW: 0 ;NON ZERO GIVES ERROR PRINT ON STORAGE WORDS +HKALL: 0 ;NONZERO => HALF-KILL ALL LABELS (.HKALL'S VALUE) +LITSW: 0 ;-1 => USING A LITERAL GIVES AN ERROR +QMTCH: 0 ;-1 => ' AND " NEED MATCHING CLOSINGS (A LA FAIL, MACRO-10) +STARTA: 0 ;STARTING ADDRESS FOR SBLK, RIM +DECBRK: 0 ;LARGEST RELOC. ADDR. LOADED INTO. (USED FOR DEC FMT) +DECBRA: 0 ;LARGEST ABS. ADDR LOADED INTO. +DECBRH: 0 ;LIKE DECBRK BUT FOR ADDRS IN HI SEG. +DECTWO: MOVE ;NOT = MOVE => .DECTWO WAS DONE, AND THIS WD HAS + ;ADDR START OF HISEG. +ISAV: 0 ;I FROM FIELD AT AGETFLD +A.PASS: 0 ; .PASS INTSYM, # OF THIS PASS. +A.PPAS: 0 ;.PPASS INTSYM, # OF PASSES. +WPSTE: NRMWPS ;# WORDS PER SYMTAB ENTRY +WPSTE1: NRMWPS-1;ONE LESS THAN WPSTE - FOR SPEED. +WPSTEB: ,-NRMWPS(B) ;RH HAS - # WORDS PER SYMTAB ENTRY; LH HAS INDEX OF B. +SYMSIZ: 0 ;#WDS IN SYMTAB = WPS* +SYMLEN: SYMMSZ ;SYMTAB SIZE (# SYMS) + ;ASSEMBLED-IN VALUE USED AS DEFAULT, ONLY IF NON-TS. +SYMAOB: 0 ;-<# SYMS>,,0 +INICLB: 0 ;-1 IF INITIALIZATION CODE CLOBBERED. +TTYINS: 0 ;AT START OF ASSEMBLY, -1 => .INSRT TTY PASS1, -2 => PASS2 ALSO. +IFN FASLP,[ +FASBP: 0 ;PNTR TO FASL OUTPUT BUFFER +FASATP: 0 ;PNTR TO FASL ATOM TABLE +FASAT1: 0 ;PNTR TO FASL ATOM TABLE AFTER READING IN NEW ATOM + ; (MAYBE UPDATE FASATP TO THIS IF ATOM WAS UNIQUE9 +FASAT2: 0 ;BYTE PNTR USED TO STORE ATOM IN +FASIDX: 0 ;INDEX NEXT ATOM LOADED INTO FASAT WILL BE +FASPCH: 0 ;AMOUNT OF FASAT "PUNCHED" +FASCBP: 440400,,FASB ;BYTE PNTR TO FASL CODE BIT WORD +FASPWB: 0 ;FASL CODE AT PWRD +FASBLC: 0 ;LOSING BLOCK "COUNT" +FASBLS: 0 ;LOSING BLOCK "SYMBOL" +AFRLD: 0 ;LIST READ CURRENT DEPTH +AFRLEN: 0 ;LIST READ CURRENT LENGTH +AFRDTF: 0 ;LIST READ DOT CONTEXT FLAG (0 NORMAL, 1 SAW DOT, 2 SAW "FROB AFTER DOT" +AFRFTP: 0 ;LIST READ SAVED STATE OF FASATP +AFLTYP: 0 ;TYPE LIST OP IN- 0 EVAL AND THROW AWAY VALUE + ;1 "RETURN" LIST + ;2 "RETURN" VALUE OF LIST +] +PBLK + ;INFO CONVENIENT TO ANYONE GENERATING AN OUT OF TIME-SHARING MIDAS + +;MIDAS OUT OF TIME-SHARING ASSEMBLES INTO A COLLECTION OF SUBROUTINES +;IO IS EXPECTED TO BE HANDLED BY OTHER PROGRAMS. + +;EXITS FROM THE ASSEMBLER: +;TPPB OUTPUT BINARY WORD IN A +;TFEED IF OUTPUT DEVICE IS PTP, PUNCH OUT # FRAMES OF BLANK TAPE + ;SPECIFIED BY B, MAY CLOBBER A AND B +;GO2 RETURN POINT FROM FATAL ERRORS +;TYO TYPE OUT CHARACTER IN A +;TAB TYPE OUT A TAB (MAY CLOBBER A OF COURSE) +;RCHTBL SEE THE RCH ROUTINES + +;ENTRIES + +;PDL, LPDL MAY BE USED BY COMMAND PROCESSOR BUT WILL BE CLOBBERED BY MAIN ROUTINES +;MAIN ROUTINES, CALLED WITH JSP A, , CLOBBER THE WHOLE WORLD (INCLUDING P) +;INIT INITIALIZE +;PS1 PASS 1 +;PLOD IF APPROPRIATE, PUNCH OUT LOADER +;PS2 PASS 2 (DOES ITS OWN PARTIAL INITIALIZATION) +;PSYMS PUNCH OUT SYMBOL TABLE + +;OTHER ENTRIES + +;CONTRL AFTER ASSEMBLY, .GE. 0 => RELOCATABLE, .LT. 0 => ABSOLUTE +;ISYMF -1 IF SYMS HAVE NOT BEEN SPREAD, ELSE DON'T TRY TO ADD TO INITIAL SYMBOL TABLE +;SMSRTF -1 IF SYMTAB HASN'T BEEN SORTED, ELSE SYMTAB CLOBBERED, DON'T RE-ASSEMBLE +;MIDVRS .FNAM2 OF MIDAS ENGLISH + +;SOME FF FLAGS ARE GLOBAL SO COMMAND PROCESSOR CAN KNOW WHAT'S HAPPENED ON RETURN + +;COMMAND PROCESSOR MAY ADD TO INITIAL SYMBOL TABLE BEFORE CALLING INIT THE FIRST TIME +;EISYMT IS THE FIRST LOCATION OK TO DUMP INTO +;EISYMP RH SHOULD BE SET BY COMMAND PROCESSOR TO FIRST LOC NOT DUMPED INTO +;INTSYM RH OF SYMTAB VALUE TO RETURN VALUE ADDRESSED BY LH(SYMTAB ENTRY) + +;RCH HAS AN ELABORATE SET OF GLOBALS, WHICH I DON'T FEEL LIKE PUTTING DOWN NOW, BUT THEY INCLUDE +;RCH (GET CHAR) SEMIC, RRL1, RREOF, SEMICR, SEMIC, TYPCTL, GDTAB, CPGN, CLNN, +;RCHMOD, MDSCLR, MDSSET, RCHSET, POPLMB, PSHLMB +;ALSO RCHTBL ONLY EXIT + +;LISTING FEATURE GLOBALS: +;PILPT PRINT CHAR IN A +;LISTON LISTING ON/OFF FLAG, -1 => ON +;LISTP SAME WORD AS LISTON. +;LISTP1 POSITIVE => LIST EVEN ON NON-PUNCHING PASS. +;LPTCLS END OF LISTING, PRINT FORM FEED, IF TS THEN CLOSE LPT + +;CREF FEATURE GLOBALS: +;CRFOUT OUTPUT WORD IN A. +;CREFP -1 => REQUEST GENERATION OF CREF OUTPUT. +;THE RUBOUT-B-^W HEADER, THE SET-SOURCE-FILE BLOCK, AND THE EOF BLOCK +;ARE THE RESPONSIBILITY OF THE COMMAND PROCESSOR. + ;;RCH ;CHARACTER INPUT ROUTINES + +IFN RCHASW\MACSW,[ + ;SAVE LIMBO1 STATUS AND RH(B) + ;THEN SET UP FOR NEW INPUT MODE (DESCRIPTOR IN A) + ;CALLED BY PUSHEM AND PUSHTT + +PSHLMB: HRL B,LIMBO1 ;LAST CHARACTER INPUT + TLZE FF,FLUNRD ;RE-INPUT CHARACTER ON RETURN? + XCT LSTPLM ;SET B'S SIGN; IF LISTING, JRST PSHLML. +PSHLMN: EXCH A,RCHMOD ;GET OLD MODE IN A + DPB A,[360500,,B] ;STORE IN 5 OF HIGH 6 BITS IN B + PUSH F,B ;SAVE RESULTANT CRUD + CAMN A,RCHMOD ;COMPARE NEW WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + MOVE A,RCHMOD ;NOW GET NEW MODE + JRST PSHLM1 ;SET UP INSTRUCTIONS FOR NEW MODE + +IFN LISTSW,[ +;IF LISTING, LSTPLM HOLDS JRST PSHLML +PSHLML: AOSN PNTSW + JRST PSHLMM ;LAST WAS BREAK CHR + REPEAT 4,IBP PNTBP + SOSA PNTBP +PSHLMM: SETOM LISTBC + TLO B,400000 + JRST PSHLMN +] + + ;UNDO A PSHLMB (NOTE: IN COMMENTS BELOW, "NEW" MODE IS ON PDL, OLD IN RCHMOD) + +POPLMB: POP F,A ;GET WORD THAT PSHLMB PUSHED + HLRZS A ;JUST INTERESTED IN LEFT HALF + TRZE A,400000 ;SIGN BIT SET? + TLOA FF,FLUNRD ;YES, SET FLAG TO RE-INPUT LAST CHAR + TLZA FF,FLUNRD ;NO, CLEAR FLAG. + XCT POPLML ;JFCL\IDPB A,PNTBP ;THE LATTER IFF LISTING. + SETZM LIMBO1 ;INITIALIZE FOR DPB + DPB A,[700,,LIMBO1] ;RESTORE LIMBO1 + LSH A,-<18.-6> ;RIGHT JUSTIFY RCHMOD DESCRIPTOR + CAMN A,RCHMOD ;COMPARE NEW MODE WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + JRST RCHSET ;SET UP FOR NEW MODE AND RETURN +] + FOO==0 ;INITIALIZE COUNTER FOR FOLLOWING + +DEFINE RCHBLT SIZE,ADR/ + MOVSI T,FOO(A) + HRRI T,ADR + BLT T,-1+ADR +FOO==FOO+ +TERMIN + +DEFINE RCHMOV ADR/ + MOVE T,FOO(A) + MOVEM T,ADR +FOO==FOO+1 +TERMIN + + ;SET UP FOR INPUT OF MODE TYPE SPECIFIED IN A, CLOBBER A ONLY + +RCHSET: MOVEM A,RCHMOD ;STORE NEW RCHMOD +PSHLM1: TLZ FF,FLMAC\FLTTY ;CLEAR FLAGS (MAYBE DEVICE ROUTINE SETS ONE) + XCT RCHTBL(A) ;GET IN A A POINTER TO A DESCRIPTOR TABLE (MAYBE ALSO SET FLAG) + PUSH P,T ;SAVE T, NEED IT FOR TEMP + RCHBLT 3,RCH2 ;FIRST 3 WORDS RCH2 + TLNE FF,FLVOT + JRST POPTJ ;ALL RCH'S TO GO THROUGH RCH, DON'T DO ANYTHING ELSE +MDSST1: RCHBLT 3,RR1 ;NEXT 3 RR1 + RCHMOV RRL1 ;NEXT WORD RRL1 +RCHPSN==FOO ;# WORDS IN ALL TABLES BUT LAST (NOT OF CONSTANT LENGTH) + RCHBLT 6,SEMIC ;LAST N SEMIC +POPTJ: POP P,T + POPJ P, + +IFN LISTSW,[ + ;SET UP TO "DISPLAY" (ALL RCH'S THROUGH RCH) + +MDSSET: TLO FF,FLVOT ;SET FLAG + MOVEI A,MDSSTB-3 ;SET UP AC + PUSH P,T ;SAVE T FOR RESTORATION + JRST MDSST1 ;NOW SET UP + +MDSSTB: JRST RRL1 ;RR1 + HALT + PUSHJ P,RCH ;RREOF + + PUSHJ P,RCH ;RRL1 +IFN .--RCHPSN,.ERR LOSSAGE AT MDSSTB. + PUSHJ P,RCH ;SEMIC + CAIE A,15 + JRST SEMIC + JRST SEMICR + + ;CLEAR OUT DISPLAY MODE + +MDSCLR: TLZ FF,FLVOT ;CLEAR FLAG + MOVE A,RCHMOD + JRST RCHSET ;NOW SET UP FOR REAL IN CURRENT MODE +] ;END IFN LISTSW, + IFN TS,[ ;TABLE FOR RCHSET, INDEXED BY MODE + ;MAYBE THIS CONDITIONAL WANTS TO BE CHANGED TO SOMETHING ELSE + +RCHTBL: MOVEI A,RCHFIL ;0 => INPUT FROM FILE +IFN MACSW,PUSHJ P,RCHMAC ;1 => INPUT FROM MACRO (DO NOT CHANGE, USED BY MACRO PROCESSOR) +IFN RCHASW,[IFE MACSW,HALT + PUSHJ P,RCHTRC ;2 => TTY, QUIT ON CR + PUSHJ P,RCHARC ;3 => TTY, DON'T QUIT ON CR +] + ;TABLE FOR INPUTTING FROM FILE + ;MAYBE THIS CONDITIONAL ALSO WANTS TO BE CHANGED + +RCHFIL: ILDB A,UREDP ;GETCHR, GET CHARACTER + CAIG A,14 ;SKIP IF TOO BIG TO BE SPECIAL + XCT RPATAB(A) ;SPECIAL, DO THE APPROPRIATE THING + + JRST RRL1 ;RR1 + HALT + PUSHJ P,[ MOVEI A,0 ;^C IN SYMBOL TREATED LIKE A ^@, + JRST INCHR3] ;BUT ALSO SEE IF REALLY END OF BUFFER. THIS GOES IN RREOF. + + ILDB A,UREDP ;RRL1 +IFN .-RCHPSN-RCHFIL,.ERR RCHFIL LOSES. + LDB CH1,[360600,,UREDP] ;SEMIC; FIND WHERE IN ITS WORD UREDP POINTS + IDIVI CH1,7 + JRST @SEMIC3(CH1) ;AND ENTER THE CR-SCANNING LOOP AT THE APPROPRIATE + JFCL ;PLACE (IT IS A WORD-BY-WORD LOOP). + +;TABLE FOR ABOVE, EXECUTED INDEXED BY CHAR, 15 ONLY FROM SEMIC ELSE ANYTHING +;NOTE: MANY OF THESE ROUTINES SUBTRACT 3 FROM THE PC BEFORE RETURNING. +;THE CALLER MUST MAKE SURE THAT THE ILDB UREDP IS WHAT THEY RETURN TO THAT WAY. + +RPATAB: +IFN ITSSW, JFCL ;0, ON I.T.S. IS NORMAL CHARACTER +.ELSE CALL RPANUL ;0, ON DEC SYSTEM, IGNORE IT. + JFCL + JFCL +IFN .-RPATAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH ENTRY IN RPATAB. + PUSHJ P,INCHR3 ;3, EOFCH + REPEAT 6,JFCL + CALL RPALF ;LINE FEED + JFCL ;13 + PUSHJ P,RPAFF ;FORM FEED + JRST SEMICR ;FROM SEMIC ONLY, EXIT FROM LOOP + +RPAFF: SKIPE ASMOUT ;FORM FEED + ETR [ASCIZ/Formfeed within <>, () or []/] + AOS CH1,CPGN + SETOM CLNN +IFN ITSSW,[ + ADD CH1,[SIXBIT /P0/+1] + MOVE CH2,A.PASS + DPB CH2,[300200,,CH1] + .SUSET [.SWHO3,,CH1] ;PUT THE NEW PAGE # IN THE WHO-LINE. +] +RPALF: AOS CH2,CLNN + CAME CH2,A.STPLN + RET + MOVE CH1,CPGN + CAMN CH1,A.STPPG + SETOM TTYBRF + RET + +IFN DECSW\TNXSW,[ +RPANUL: MOVE CH1,@UREDP ;SAW A NULL - IN A LINE NUMBER? + TRNN CH1,1 + JRST RCHTRA ;NO, JUST IGNORE IT. + MOVEI CH1,010700 + HRLM CH1,UREDP ;YES, SKIP THIS WHOLE WORD, THEN + CALL RCH ;SKIP THE 1ST CHAR AFTER THE LINE NUMBER + JRST RCHTRA ;RETURN THE NEXT CHAR FROM THIS CALL TO RCH. +] +] ;END IFN TS, + VBLK +LIMBO1: 0 ;LAST CHARACTER READ BY RCH +RCHMOD: 0 ;CURRENT INPUT MODE, 0 => INPUT FROM FILE, 1 => MACRO, ETC. +CLNN: 0 ;1 LESS THAN LINE # IN CURRENT INPUT FILE. +CPGN: 0 ;1 LESS THAN PAGE # IN CURRENT INPUT FILE +A.STPL: 0 ;1 LESS THAN LINE # TO STOP AT. +A.STPP: 0 ;1 LESS THAN PAGE # TO STOP AT. + ;(STOPPING MEANS INSERTING THE TTY) + +;READ CHARACTER INTO A FROM INPUT FILE, MACRO, OR WHATEVER (RCH) +;CLOBBERS A,CH1,CH2. + +RCH: TLZE FF,FLUNRD + JRST RCH1 ;RE-INPUT LAST ONE +RCH2: HALT ;ILDB A,UREDP ;ILDB A,CPTR ;GET CHAR + 0 ;CAIG A,14 ;TRZE A,200 ;CHECK FOR SPECIAL + 0 ;XCT RPATAB(A) ;PUSHJ P,MACTRM ;SPECIAL, PROCESS + MOVEM A,LIMBO1 ;GOT CHAR, SAVE AS LAST CHAR GOTTEN +IFE TS,RCHLS1==JRST TYPCTL +IFN TS,RCHLS1==RET ;DEFAULT CONTENTS OF RCHLST (IF NOT LISTING) +RCHLST: RCHLS1 ;AOSN PNTSW IF LISTING. +IFN LISTSW,[ + PUSHJ P,PNTR + CAIG A,15 + JRST RCHL1 +RCHL3: IDPB A,PNTBP +TYPCTL: POPJ P, ;OR JRST SOMEWHERE +PBLK + +RCHL1: CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + JRST RCHL3 +RCHL2: MOVEM A,LISTBC + SETOM PNTSW + JRST TYPCTL + +VBLK +RCH1: MOVE A,LIMBO1 +RCH1LS: RET ;OR CAILE A,15 IF LISTING. + RET ;NEEDED IN CASE LISTING. + CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + POPJ P, + JRST RCHL2 +PBLK +] ;END IFN LISTSW, + +IFE LISTSW,[ +PBLK +RCH1: MOVE A,LIMBO1 + RET +] ;END IFE LISTSW, + ;;GETSYL ;VARIOUS SYLLABLE READING ROUTINES (BUT NOT ALL OF THEM) + +GSYL: CLEARB SYM,STRCNT +GSYL1: MOVEI D,6 + MOVE T,[440700,,STRSTO] + MOVEM T,STRPNT +GSYL3: AOSG A,STRCNT + JRST (F) + PUSHJ P,RCH + IDPB A,STRPNT ;STORE CHAR IN STRING EVEN IF DELIMITER (MINIMUM STRCNT = 1) +A.GSY2: CAIN A,". + JRST GSYL1C + HLRZ CH1,GDTAB(A) + CAIN CH1,(JSP CH2,) + JRST GSYL1A ;NUMBER + PUSHJ P,GSYL1B ;RETURN ONLY ON SYL SEP + HRRZ A,GDTAB(A) + MOVE T,LIMBO1 +C%: POPJ P,"% + +GSYL1B: XCT GDTAB(A) ;POPJ FOR SYL SEPS + SUB P,[1,,1] +GSYL1D: SOJGE D,GSYL3 + AOJA D,GSYL3 + +GSYL1C: ADD SYM,%.SQ(D) + JRST GSYL1D + +GSYL1A: XCT NSQTB-60(A) + JRST GSYL1D + + ;VERSION OF GETSYL TO TRY UNTIL SYL OR WORD TERMINATOR FOUND + ;SKIPS IF NAME THERE (FOR .TYPE, SQUOZE) + +GTSLD2: TLNN C,DWRD\DFLD + JRST GTSLD3 ;DELIMITER IS WORD TERMINATOR, TOLERATE THE NULL SYLLABLE +GETSLD: PUSHJ P,GETSYL ;ENTRY, GET A SYL + MOVE C,CDISP ;GET CDISP + TRNN I,IRSYL + JRST GTSLD2 ;NO SYL + AOS (P) ;GOT SYL, CAUSE RETURN TO SKIP +GTSLD3: TLNN C,DWRD\DFLD + TLO FF,FLUNRD ;CAUSE DELIMITER TO BE RE-INPUT + POPJ P, + +PASSPS: SKIPA A,LIMBO1 +GPASST: CALL RCH + CAIE A,40 + CAIN A,^I + JRST GPASST + RET + GETSYL: TLZ I,ILUARI+ILNPRC+ILLSRT +GTSL1: CLEARB SYM,NUMTAB ;RECUR HERE FOR RIGHT ARG TO ^ AND _. + MOVE AA,[NUMTAB,,NUMTAB+1] + AOSN NTCLF + BLT AA,NUMTAB+10 ;NUMTAB NOT CLEAR, HAVE TO CLEAR IT + MOVEI D,6 ;CHARACTER COUNTER FOR BUILDING UP SYM + SETOM ESBK ;NO SPECIFIC BLOCK DESIRED. + TDZ I,[ILDECP+ILFLO+ILVAR+ILGLI,,IRPERI+IRLET+IRSYL] +RRL2: PUSHJ P,RR ;CALL MAIN LOOP ROUTINE, READ UNTIL NON-SQUOZE CHAR +SEMICR: ;RETURN HERE FROM SEMIC WITH CR IN A + MOVEM A,LIMBO1 ;SYLLABLE OPERATOR OR TERMINATOR IN A, SAVE + HRRZ A,GDTAB(A) ;NOW GET RIGHT HALF OF POPJ, INDEX INTO DTB + MOVE C,DTB-40(A) ;GET DTB ENTRY (FLAGS,,JUMP ADR) + MOVEM C,CDISP ;STORE AS DISPATCH CODE FOR LAST CHAR (SORT OF AN INTERPRETED LIMBO1) +RR8: TLNE C,DSYL ;NOW SEE IF SYL OPERATOR FLAG SET + JRST (C) ;SET => INTRA-SYLLABLE OPERATOR +RR10: TRNE I,IRLET ;NOT SET => SYLLABLE TERMINATOR: SYL? + POPJ P, ;SYL HAS LETTERS + TRNN I,IRSYL + JRST CABPOP ;NO SYL + CAMN SYM,[SQUOZE 0,.] + JRST PT1 ;SYM IS . + ;NUMBER + +RR5: TLNN I,ILNPRC + PUSHJ P,NUMSL + TLNN I,ILFLO + JRST RR9 ;NOT FLOATING POINT + MOVE A,B ;FLOATING, HIGH IN AA,LOW IN A,EXP IN B + ADDI A,306 ;201+105 TO ROUND + ADDI AA,200 ;CAUSE EXPONENT TO BE ACCEPTABLE TO MACHINE + JUMPGE AA,.+3 ;NOW CHECK FOR OVERFLOW ON ROUNDING + LSH AA,-1 ;OVERFLOW, SHIFT BACK ONE + AOS A ;INCREMENT EXPONENT TO COMPENSATE FOR SHIFT + EXCH A,AA ;GET EXPONENT IN AA, REST IN A + ASHC AA,-10 ;SHIFT TO MACHINE FLOATING POINT FORMAT + SKIPE AA ;NOW CHECK HIGH ORDER BITS OF EXPONENT NOT SHIFTED INTO NUMBER + ETR [ASCIZ /Exponent overflow/] +RR9: TLZ I,ILGLI+ILVAR ;NOT TRYING TO DEFINE NUMBER AS VARIABLE OR GLOBAL +CLBPOP: TDZA B,B ;CLEAR OUT B (RELOCATION BITS OF VALUE) +CABPOP: SETZB A,B ;DO JRST CABPOP TO RETURN ZERO AS VALUE + POPJ P, + RRU: MOVE A,LIMBO1 ;GET HERE WHEN FLUNRD SET AT RR, RETRIEVE CHARACTER FROM LIMBO1 + CAIG A,14 ;IF TOO BIG, + CAIGE A,12 ;OR IF TOO SMALL, + JRST RR1B ;THEN JUST FALL BACK IN + TLNN FF,FLVOT\FLMAC\FLTTY ;SKIP IF NOT HACKING CPGN/CLNN + XCT RRUTAB-12(A) ;HACKING, UNHACK FOR HACK COMING UP + JRST RR1B ;FALL BACK IN + +RRUTAB: SOS CLNN ;LINE FEED (TABLE FOR RRU) + JRST RR1B ;13 + SOS CPGN ;FORM FEED + + ;MAIN LOOP ROUTINE FOR GETSYL, READ SYM OR NUMBER +VBLK +RR: TLZE FF,FLUNRD ;RE-INPUT LAST CHARACTER? + JRST RRU ;YES +RR1: JRST RRL1 ;ILDB A,CPTR ;GET CHAR (" " ") + HALT ;TRZE A,200 ;CHECK FOR END OF STRING +RREOF: PUSHJ P,RCH ;PUSHJ P,MACTRM ;PROCESS CONDITION, GET NEXT CHAR OR JRST RR1 OR RRU + .SEE RCHTRA ;SPECIAL HANDLING OF UNRCHF IN RCHTRA IF CALLED FROM HERE. +RR1B: XCT GDTAB(A) ;GOT CHAR, DO SOMETHING APPROPRIATE (POPJ ON NOT SQUOZE) + TROA I,IRLET\IRSYL ;LETTERS RETURN, JUST UPDATED SYM, SET FLAGS + TRO I,IRSYL ;NUMBERS RETURN, SET FEWER FLAGS + SOJGE D,RR1 ;DECREMENT SYM COUNTER AND LOOP + AOJA D,RR1 ;COUNTER EXHAUSTED, INCREMENT BACK TO 0 AND LOOP + +RRL1: PUSHJ P,RCH ;ILDB A,UREDP ;GET CHAR + XCT GDTAB(A) ;NOW MAKE LIKE RR1B (EOFCH => JRST RREOF) + TROA I,IRLET\IRSYL + TRO I,IRSYL + SOJGE D,RRL1 + AOJA D,RRL1 + + ;SEMICOLON (GET HERE FROM RR8) + + JRST SEMICL ;RETURN HERE FROM SEMIC+2 WHEN FLUNRD SET +;NEXT 4 INSNS ALTERED IN DIFFERENT INPUT MODES. SEE RCHFIL, ETC. +SEMIC: PUSHJ P,RCH ;GET CHAR + CAIE A,15 ;SEE IF SPECIAL + JRST SEMIC ;SPECIAL => DO SOMETHING (JRST SEMICR ON CR) + JRST SEMICR ;IF NOT SPECIAL THEN GO BACK FOR NEXT CHAR + +LOC SEMIC+6 ;LEAVE A LITTLE EXTRA ROOM FOR BIG ROUTINES +PBLK + +SEMICL: MOVE A,LIMBO1 ;HERE FROM SEMIC-1, RETRIEVE CHARACTER FROM LIMBO1 + CAIE A,15 ;SKIP IF SHOULD TERMINATE SCAN + JRST SEMIC ;NOT CR, FALL BACK IN + JRST SEMICR ;DONE + +SEMIC2: +REPEAT 5,[ + ILDB A,UREDP + CAIG A,15 + XCT RPATAB(A) +] + MOVE A,[ASCII /@@@@@/] +SEMIC1: AOS CH1,UREDP + MOVE CH1,(CH1) ;ANY CONTROL CHARS IN THE WORD UREDP POINTS AT? + MOVE CH2,CH1 + AND CH1,A + AND CH2,[ASCII/ /] + LSH CH2,1 + IOR CH1,CH2 + CAMN CH1,A + JRST SEMIC1 ;NO, ADVANCE TO NEXT WORD AND TEST IT. + MOVEI A,440700 + HRLM A,UREDP + JRST SEMIC2 ;YES, LOOK AT EACH CHAR AND PROCESS IT. + +SEMIC3: REPEAT 6,JRST SEMIC2+3*<5-.RPCNT> + ;JSP CH2,RR2 => DIGIT (FROM GDTAB) +;THIS ROUTINE IS GROSSLY SLOW, AND SHOULD BE SPEEDED UP SOMETIME + +RR2: XCT NSQTB-"0(A) ;UPDATE SQUOZE. + TRNE I,IRLET + JRST 1(CH2) ;SYL IS SYM, DON'T WASTE TIME. + TRNE I,IRPERI + TLO I,ILFLO ;DIGIT AFTER . => FLOATING. +MAKNUM: SETOM NTCLF ;NUMTAB ABOUT TO NOT BE CLEAR, SET FLAG FOR GETSYL TO CLEAR IT OUT NEXT TIME + MOVEI AA,2 ;INDEX INTO NUMTAB ETC., SOJGE'D TO GET ALL RADICES +MAKNM1: MOVE T,ARADIX(AA) ;GET THIS RADIX, + CAMN T,ARADIX ;REDUNDANT => SKIP THIS PASS. + JUMPN AA,MAKNM4 + SKIPGE CH1,HIGHPT(AA) + JRST MAKNM3 + MUL T,LOWPT(AA) ;TT HAS OLD LOW TIMES RADIX, T HAS OVFLO TO HIGH. + ADDI TT,-"0(A) ;ADD DIGIT TO LOW PART + TLZE TT,400000 + AOJ T, ;OVERFLOW, INCREMENT SPILLOVER FROM MUL OF LOWPT + JUMPE CH1,MAKNM5 ;OLG HIGHPT WAS 0 => SAVE TIME. + JFCL 17,.+1 ;NOW CLEAR OV, ETC. + IMUL CH1,ARADIX(AA) ;MULTIPLY HIGHPT BY RADIX + ADD T,CH1 ;ADD HIGH PARTS + JFCL 10,MAKNM2 ;JUMP ON OVERFLOW FROM IMUL OR ADD +MAKNM5: TLNE I,ILFLO + SOS NUMTAB(AA) ;FLOATING, DECREMENT EXP TO COMPENSATE FOR MULT OF HIGHPT/LOWPT + MOVEM T,HIGHPT(AA) ;NOW STORE STUFF BACK + MOVEM TT,LOWPT(AA) +MAKNM4: SOJGE AA,MAKNM1 ;NOW DO ALL THIS FOR NEXT RADIX + JRST 1(CH2) + +MAKNM2: MOVSI B,400000 ;OVERFLOW FROM UPDATING HIGH PARTS + IORM B,HIGHPT(AA) ;SET SIGN BIT +MAKNM3: TLNN I,ILFLO + AOS NUMTAB(AA) ;NOT FLOATING, INCREMENT EXP, MAY NOT WANT TRAILING BITS + JRST MAKNM4 + +VBLK +NUMTAB: 0 ;EXPONENT + 0 + 0 +HIGHPT: 0 ;HIGH PART OF CURRENT NUMBER THIS RADIX + 0 ;4.9 => OVERFLOW, TRAILING DIGITS DROPPED + 0 +LOWPT: 0 ;LOW PART OF CURRENT NUMBER THIS RADIX + 0 ;HIGHPT/LOWPT TAKEN AS 70. BIT POSITIVE INTEGER EXCEPT 4.9(HIGHPT) IS FLAG INSTEAD OF + 0 ;EXPONENTIATE 70. BIT INTEGER BY NUMTAB (WHICH MAY BE NEGATIVE) TO GET ACTUAL VALUE +ARADIX: 10 ;CURRENT RADIX + 12 + 10 + +NTCLF: -1 ;-1 => NUMTAB NOT CLEAR (TO SAVE BLT AT GETSYL WHEN CLEAR) +PBLK + ;JRST POINT => . (FROM GDTAB) + +POINT: TLO I,ILDECP ;PREFER DECIMAL + TROE I,IRPERI ;SET PERIOD FLAG + TRO I,IRLET ;2 POINTS => NAME + ADD SYM,%.SQ(D) ;UPDATE SYM + JRST 1(CH1) ;RETURN + +RBRAK: SOSL SCNDEP ;IF A CONDITIONAL TO TERMINATE, + JRST RBRAK2 ;HAVE DONE SO, IGNORE CHAR. + SETZM SCNDEP +;CLOSES OF ALL KINDS COME HERE. +RPARN: +GRTHN: MOVE A,LIMBO1 + SKIPE CH1,ASMOUT ;WHAT KIND OF OPEN ARE WE IN? + CAIN CH1,4 ;WITHIN A .ASCII OR + JRST RBRAK1 ;NOT WITHIN GROUPING => THIS CLOSE IS STRAY. + CAME A,ASMOT1(CH1) ;RIGHT KIND OF CLOSE FOR THAT OPEN? + ERJ RBRAK3 +RBRAK4: MOVE CH1,ASMOT2(CH1) + MOVEM CH1,ASMDSP ;ARRANGE FOR THIS ASSEM1 LEVEL TO EXIT +RBRAK5: SETZM CDISP + JRST RR10 ;AND GO TERMINATE WORD. + +RBRAK3: CALL TYOERR ;COME HERE ON CLOSE WRONG FOR OPEN. + ;(EG, ")" MATCHING "<"). + TYPR [ASCIZ/ Seen when /] + MOVE A,ASMOT1(CH1) + CALL TYOERR + TYPR [ASCIZ/ expected +/] + JRST RBRAK4 + +RBRAK1: CAIN CH1,4 ;CLOSE INSIDE A .ASCII => + JRST RBRAK5 ;TERMINATE WORD BUT DON'T CLOSE ANYTHING. + SKIPN CONSML ;COME HERE FOR STRAY CLOSE. + JRST RRL2 + ERJ .+1 + TYPR [ASCIZ/Stray /] + MOVE A,LIMBO1 ;GET THE CLOSE WE SAW. + CALL TYOERR + CALL CRRERR + JRST RRL2 + +;COME HERE FOR CLOSE-BRACE, AND CERTAIN CLOSE-BRACKETS. +RBRAK2: SETOM A.SUCC ;HAVE JUST ENDED SUCCESSFUL BRACKETED CONDIT, + JRST RRL2 ;REMEMBER THAT MOST RECENT CONDITIONAL WAS TRUE. + +FORMF: TLNN FF,FLVOT\FLMAC\FLTTY ;FORM FEED SYLLABLE OPERATOR ROUTINE + PUSHJ P,RPAFF ;UNLESS ALREADY DONE, INCREMENT PAGE #. + JRST RR10 + +LINEF: TLNN FF,FLVOT\FLMAC\FLTTY ;LINE FEED SYLLABLE OPERATOR ROUTINE + CALL RPALF + JRST RR10 + +CTLAT: +IFN DECSW\TNXSW,[ + TLNN FF,FLVOT\FLMAC\FLTTY ;^@ SYLLABLE OPERATOR ROUTINE. + CALL RPANUL +] + JRST RRL2 + ;DECIPHER A VALUE FROM NUMTABS +;LEAVES HIGH PART IN AA, LOW PART IN A, BINARY EXPONENT IN B +;AND RADIX USED IN D. + +NUMSL: TLNN I,ILVAR\ILDECP\ILFLO + SKIPE B,HIGHPT + JRST NUMSLS + MOVE A,LOWPT ;BE VERY FAST IN CASE OF SMALL FIXNUM IN CURRENT RADIX. + MOVE D,ARADIX ;SAVE RADIX AND HIGH PART FOR ^. + SETZ AA, + RET + +NUMSLS: CLEARB TT,D ;TT BIT EXPONENT, D INDEX INTO NUMTAB, ETC. + TLNE I,ILDECP+ILVAR ;NEITHER . NOR ', CURRENT RADIX. + TLNE I,ILGLI ;" => CURRENT RADIX DESPITE . OR '. + JRST NUMSL0 + MOVEI D,1 ;DECIMAL UNLESS ' + TLNE I,ILVAR ;WHICH FORCES OCTAL. + MOVEI D,2 + MOVE A,ARADIX(D) + CAMN A,ARADIX ;IF REALLY SAME AS CURRENT RADIX, + MOVEI D,0 ;COMPUTATION WASN'T DONE FOR THIS VALUE OF D, + ;SO USE COMPUTATIONS DONE FOR CURRENT RADIX. +NUMSL0: MOVE AA,HIGHPT(D) ;AA := HIGH PART + MOVE B,LOWPT(D) ;B := LOW PART + MOVE T,NUMTAB(D) ;T := EXPONENT + MOVE D,ARADIX(D) ;NO LONGER NEED IDX, GET RADIX VALUE. + TLNN I,ILFLO + JRST FIXNUM ;NOT FLOATING + TLZ AA,400000 ;FLOATING, DON'T NEED DIGITS LOST ON OVERFLOW +NUMC1: JUMPN AA,.+2 ;ENTRY FROM UPARR + JUMPE B,FIX0 ;COMPLETELY ZERO => RETURN FIXED ZERO + JUMPL T,NUMSL1 ;JUMP IF EXPONENT NEGATIVE + JUMPE T,NUMSL2 ;JUMP (SKIP FOLLOWING) IF EXPONENT ZERO + ;EXPONENT POSITIVE, DO THE APPROPRIATE THING +NUMSL5: MULI B,(D) ;MULITIPLY LOW PART BY RADIX + MULI AA,(D) ;MULTIPLY HIGH PART BY RADIX + ADD A,B ;A := LOW PART OF HIGH + HIGH PART OF LOW + TLZE A,400000 + ADDI AA,1 ;OVERFLOW ON ADDITION, INCREMENT HIGH PART OF HIGH + MOVE B,C ;NO LONGER NEED HIGH OF LOW, GET LOW OF LOW IN B +NUMSL3: JUMPE AA,NUMSL4 ;NOW CHECK FOR OVERFLOW INTO HIGH OF HIGH, JUMP ON NONE + ASHC A,-1 ;NEXT THREE INSTRUCTIONS TO DO ASH3 AA,-1 + ASH A,1 + ASHC AA,-1 + AOJA TT,NUMSL3 ;INCREMENT BIT EXPONENT AND TRY AGAIN + +NUMSL4: MOVE AA,A ;FLUSHED OVERFLOW, NOW GET (LOW PART OF) HIGH PART IN AA + SOJG T,NUMSL5 ;COUNT DOWN + +NUMSL2: TLNN I,ILFLO + JRST NUMSL9 ;NOT FLOATING, DON'T WASTE TIME NORMALIZING. + SKIPA A,B ;EXPONENT NOW ZERO, GET LOW PART OF NUMBER IN A +NUMSL7: ASHC AA,1 ;NOW NORMALIZE + TLNN AA,200000 + SOJA TT,NUMSL7 + SKIPA B,TT ;DONE NORMALIZING, RETURN BINARY EXPONENT IN B +PT1: TRO I,IRLET + POPJ P, + +NUMSL9: MOVE A,B + MOVEI B,0 + ASHC AA,(TT) ;SHIFT 2-WD NUM. BY EXPONENT, + LSH A,1 ;PUT HIGH BIT IN WITH REST. + JRST FIX1 + FIX0: TLZ I,ILFLO +FIXNUM: LSHC A,45 +FIX1: LSHC AA,-1 + JUMPE AA,.+2 + ETR [ASCIZ /FIXNUM too big for 36 bits/] + POPJ P, + +NUMSL1: SKIPA A,B ;EXPONENT NEGATIVE: NORMALIZE NOW +NUMSL8: ASHC AA,1 +NUMSL6: TLNN AA,200000 + SOJA TT,NUMSL8 ;NOT NORMALIZED YET + AOS T + MOVEI TM,(D) + TLNN TM,-1 ;GET CONVIENT POWER OF RADIX + JUMPL T,[ IMULI TM,(D) + AOJA T,.-1] + MOVE B,A ;GET NORMALIZED LOW PART IN B + IDIV AA,TM ;DIVIDE HIGH PART BY APPROPRIATE RADIX + DIV A,TM + JUMPL T,NUMSL6 + MOVE B,A + JRST NUMSL2 + +UPARR: TRON I,IRSYL + JRST UPCTRC ;"UNARY UPARROW" => GOBBLE CHARS + TRNE I,IRLET + ETR [ASCIZ /Symbolic 1st arg to "^"/] + PUSHJ P,NUMSL ;DECIPHER NUMTABS + PUSHJ P,UA3 ;GET RIGHT OPERAND IN T + MOVE TT,B ;EXPONENT + MOVE B,A ;LOW PART + PUSHJ P,NUMC1 ;T EXP HIGH IN AA LOW IN B TT BIN EXP + MOVE C,CDISP ;IF A _ WAS DEFERRED WHILE ILUARI WAS SET, + TLO I,ILNPRC + CAME C,[DSYL,,BAKAR] ;DO IT NOW. + JRST RR10 + +BAKAR: TLNE I,ILUARI + JRST RR5 ;RETURN TO UPARROW (WILL COME BACK HERE LATER) + TRNE I,IRSYL + TRNE I,IRLET + JRST BAK1 ;NO SYL, OR SYL IS NAME + CAMN SYM,[SQUOZE 0,.] + JRST BAK1 ;. ALSO NAME + TLZN I,ILNPRC + PUSHJ P,NUMSL + PUSHJ P,UA3 + ADD B,T + ASHC AA,(B) + LSH A,1 + LSHC AA,-1 + CLEARB B,AA + TLZ I,ILFLO + MOVE C,[DFLD,,CBAKAR] + EXCH C,CDISP ;IF 2ND ARG ENDED WITH A _, TURN INTO FIELD OP. + CAME C,[DSYL,,BAKAR] + EXCH C,CDISP + POPJ P, + UPCTRC: SETZ T, +UPCTR1: JSP F,QOTCOM ;UP ARROW TO GOBBLE SYL AND RETURN MASKED ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + CAIL A,140 + SUBI A,40 + ANDI A,77 ;NOW MASK CHARACTER IN TO TO BOTTOM 6 BITS + ADD T,A ;ADD TO ACCUMULATED + POPJ P, + +BAK1: MOVE TT,[DFLD,,CBAKAR] + MOVEM TT,CDISP + JRST RR10 + +UA3: HRLM D,(P) ;SAVE RADIX (FOR UPARR) + JSP LINK,SGTSY ;PUSH I,AA,A,B + TLO I,ILUARI ;TELL _ TO WAIT TILL LATER (SEE UPARR, BAKARR) + PUSHJ P,RCH + CAIN A,"- + TROA I,IRGMNS + TLO FF,FLUNRD + PUSHJ P,RCH + CAIN A,"< + JRST UAR1 + TLO FF,FLUNRD +UA3L: PUSHJ P,GTSL1 ;GOBBLE SYL, LOOP POINT FOR PSEUDO OR MACRO RETURNED WITHOUT VALUE + TRNE I,IRLET + JRST UA3S ;NAME + TLNE I,ILFLO + ETR [ASCIZ /Floating point 2nd arg to "_"/] +UAR2: TRZN I,IRGMNS + SKIPA T,A + MOVN T,A + JSP LINK,SGTSY1 ;RESTORE GETSYL TEMPS. + HLRZ D,(P) + POPJ P, + +UA3S: PUSHJ P,GETVAL ;MAKE NUMBER_NAME WORK + JRST UA3SR ;GOT VALUE, PROCESS + JRST UA3L ;NO VALUE, TRY AGAIN + +UAR1: TLO I,ILLSRT + TRZ I,IRSYL ;(OR ELSE LSSTH GIVES NOS ERROR.) + SETZB A,B + PUSHJ P,LSSTH +UA3SR: JUMPN B,RLCERR ;RELOC ERR + JRST UAR2 + +ATSGN: MOVSI A,20 ;ATSIGN + IORM A,WRD + TRO I,IRFLD ;SET IRFLD FLAG EVEN THOUGH NOT DIRECTLY RETURNING VALUE + ; ^ CHANGED FROM SYL TO FIELD 9/6/70 + JRST RRL2 ;FALL BACK IN + DQUOTE: TRON I,IRSYL + JRST DQUOT8 + TRNN I,IRLET ;AFTER NUMBER => CURRENT RADIX. + JRST DQUOT7 + PUSHJ P,RCH + TLO FF,FLUNRD ;NEXT CHAR. SQUOZE? + HLRZ A,GDTAB(A) + CAIN A,(POPJ P,) + JRST DQUOT7 ;NO => MAKE PREV. SYM. GLOBAL. + CAMN SYM,[SQUOZE 0,.M] ;SPECIAL BLOCK NAMES + JRST DQUOTM ;.M MEANS MAIN BLOCK, + CAMN SYM,[SQUOZE 0,.U] + JRST DQUOTU ;.U MEANS SUPERIOR. + CAMN SYM,[SQUOZE 0,.C] + JRST DQUOTC ;.C MEANS CURRENT BLOCK. + SKIPGE A,ESBK ;GET SPEC'D BLOCK OR CURRENT, + HRR A,BKCUR ;LOOK FOR SUBBLOCK OF THAT BLOCK. + HLL A,BKTAB+1(A) + ADD A,[1,,] ;LH HAS LEVEL SUBBLOCK OUGHT TO HAVE. + MOVEI T,0 + SETO D, ;NO POSSIBLE ALTERNATE CHOICE YET. +DQUOT0: CAME SYM,BKTAB(T) ;LOOK AT ALL BLOCKS SEEN. + JRST DQUOT1 ;HAS THE NAME WE'RE LOOKING FOR? + SKIPGE ESBK ;IF LOOKING FOR A SUBBLOCK OF A PARTICULAR BLOCK, + JRST DQUOT4 + CAMN A,BKTAB+1(T) + JRST DQUOT2 ;SUCH A BLOCK WINS; ALL OTHERS LOSE. + JRST DQUOT1 + +DQUOT4: SKIPN BKTAB+2(T) ;ELSE PREFER DEFINED BLOCKS TO UNDEFINED ONES. + JUMPGE D,DQUOT1 + SKIPE BKTAB+2(T) + JUMPL D,DQUOT5 + CAME D,[-1] ;THAT'S THE SAME EITHER WAY => PREFER AN INFERIOR + CAMN A,BKTAB+1(T) ;OF THE CURRENT BLOCK TO ONE THAT'S NOT. + JRST DQUOT5 + JRST DQUOT1 + +DQUOT5: HRROI D,(T) ;FOUND A BLOCK WE LIKE BEST SO FAR. + SKIPE BKTAB+2(T) + ANDI D,-1 ;LEAVE SIGN OF D SET UNLESS THE BLOCK IS DEFINED. +DQUOT1: ADDI T,BKWPB + CAMGE T,BKTABP + JRST DQUOT0 + HRRZI T,(D) ;NOW USE THE BEST BLOCK FOUND, IF THERE WAS ONE. + CAIE T,-1 + JRST DQUOT2 + MOVE T,BKTABP ;NOT FOUND, GET IDX OF 1ST UNUSED ENTRY. + CAIL T,BKTABS + ETF ERRTMB ;NO ROOM FOR MORE BLOCKS. + MOVEM SYM,BKTAB(T) + MOVEM A,BKTAB+1(T) ;ADD BLOCK AT END. + MOVEI A,BKWPB(T) + MOVEM A,BKTABP ;POINTS AFTER LAST USED ENTRY. +DQUOT2: MOVEM T,ESBK + SETZ SYM, +DQUOT3: MOVEI D,6 ;NEXT CHAR GOES IN 1ST SQUOZE POS. + JRST RRL2 + +DQUOTM: MOVEI T,BKWPB ;.M - MAIN BLOCK FOLLOWS INITIAL SYMS BLOCK. + JRST DQUOT2 + +DQUOTU: SKIPGE T,ESBK ;.U SPEC'D - GET SPEC'D OR CURRENT BLOCK, + MOVE T,BKCUR + HRRZ T,BKTAB+1(T) + JRST DQUOT2 ;SPEC. ITS SUPERIOR. + +DQUOTC: SKIPGE T,ESBK ;.C => SPEC THE CURRENT BLOCK. + MOVE T,BKCUR + JRST DQUOT2 + SQUOT1: TLOA I,ILVAR +DQUOT7: TLO I,ILGLI + MOVE A,BKCUR ;IF NO SPEC'D BLOCK, + SKIPGE ESBK + MOVEM A,ESBK ;SPEC. CURRENT BLOCK. + JRST RRL2 + +DQUOT8: SETZ T, +DQUOT9: JSP F,QOTCON ;DOUBLE QUOTE TO GOBBLE SYL AND RETURN ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + ADD T,A ;ADD IN ASCII CHARACTER IN A + POPJ P, ;RETURN TO SOMETHING + +SQUOTE: TROE I,IRSYL + JRST SQUOT1 + SETZ T, +SQUOT9: JSP F,QOTCON ;SIXBIT SYL + CAIGE A,40 + ETR ERRN6B ;NOT SIXBIT + CAIL A,140 + SUBI A,40 ;CONVERT TO UPPER CASE + LSH T,6 ;SHIFT OVER ACCUMULATED VALUE + ADDI T,-40(A) ;ADD IN SIXBIT FOR CHARACTER IN A + POPJ P, + +;COMMON ROUTINE FOR RIGHT JUSTIFIED TEXT SYLS +;CALLED WITH JSP F,; ROUTINE PUSHJ'S BACK W/ CHAR IN T, ACCUM VALUE IN A +;SYL FLAG EXPECTED TO BE ALREADY SET +QOTCON: SKIPE QMTCH ;' AND " COME HERE, BUT NOT ^: IF IN QUOTES-MATCHING MODE, USE A + JRST QOTCO4 ;FAIL-LIKE ALGORITHM. HERE FOLLOWS THE OLD MIDAS WAY OF DOING IT +QOTCOM: CALL RCH ;USE AT LEAST 1 CHAR IN ANY CASE. + JRST QOTCO1 + +QOTCO2: CALL RCH ;USE SUCCEEDING CHARS IF SQUOZE CHARS. + HLRZ CH1,GDTAB(A) + CAIN CH1,(POPJ P,) + JRST QOTCO3 +QOTCO1: CALL (F) + JRST QOTCO2 + +QOTCO3: CAIN A,"" ;NONSQUOZE: IF IT IS A TEXT SYL INDICATOR, + JRST DQUOT9 ;CONTINUE WITH WHATEVER TYPE OF TEXT + CAIN A,"' + JRST SQUOT9 ;IT INDICATES. + CAIN A,"^ + JRST UPCTR1 +QOTCO6: TLO FF,FLUNRD + JRST TEXT5 + +QOTCO4: MOVE B,LIMBO1 ;GET ' OR ", WHICHEVER STARTED THIS SYL, AS THE DELIMITER. + MOVE SYM,[SQUOZE 0,TEXT] + JSP TM,ERMARK +QOTCO5: CALL RCH + CAMN A,B ;FOUND ANOTHER EXAMPLE OF THE DELIMITER? + JRST [ CALL RCH ;IF DUPLICATED, IT PUTS THE DELIMITER IN THE CONSTANT. + CAMN A,B + JRST .+1 + JRST QOTCO6] ;OTHERWISE UNREAD THE CHAR AFTER THE DELIMITER AND EXIT. + CALL (F) ;HAVE CHAR TO PUT IN STRING IN A; GO MERGE IT IN. + JRST QOTCO5 + +;RETURN A VALUE FROM A PSEUDO WHOSE ARGS CAN BE TERMINATED BY EITHER COMMA (GOBBLED) +;OR CR (NOT GOBBLED). +VALRET: MOVE T,A ;ROUTINE TO RETURN VALUE IN A AFTER LAST CHAR GOBBLED BY GETSYL + MOVE B,CDISP ;GET STORED DISPATCH CODE + TLNN B,DWRD\DFLD + JRST VALR1 ;WORD TERMINATOR +;COME HERE TO RETURN A VALUE, AND ALSO +;BARF IF THE NEXT CHARACTER ISN'T A SYLLABLE SEPARATOR +TEXT5: PUSH P,T ;ENTRY FROM TEXT ROUTINES (NLAST CHAR NOT GOBBLED BY GETSYL) TO RETURN VALUE IN T + PUSHJ P,GETSYL ;SEE IF IMMEDIATELY FOLLOWED BY SYL + TRNE I,IRSYL + ETR ERRNOS ;NO SEPARATOR BETWEEN TWO VALUES + POP P,A ;RESTORE VALUE TO RETURN +VALR1: TRO I,IRSYL + JRST CLBPOP + ;VARIOUS PUSH AND POP ROUTINES, ALL CALLED W/ JSP LINK, + +SGTSY: PUSH P,I + PUSH P,AA + PUSH P,A + PUSH P,B + JRST (LINK) + +SGTSY1: POP P,B + POP P,A + POP P,AA + POP P,I + JRST (LINK) + +;JSP LINK,SAVWD1 TO SAVE STUFF FOR < OR (, ETC. + +SAVWD1: PUSH P,A ;SYLL. BEFORE GROUPING NOW STARTING. + PUSH P,B ;AND ITS RELOC. + +SAVWLD: PUSH P,FORMAT + PUSH P,FORPNR + PUSH P,FLDCNT + PUSH P,GLSP2 + PUSH P,I + PUSH P,WRD + PUSH P,WRDRLC + PUSH P,SYM + PUSH P,PPRIME + PUSHJ P,(LINK) +SAVL1==. + +;POP OFF WHAT PUSHED BY SAVWLD. CLEARS FLUNRD, IN CASE THE > OR ) WAS UN-READ. + +USVWLD: POP P,SYM + HRRZS SYM + CAIE SYM,SAVL1 + HALT + TLZ FF,FLUNRD + POP P,PPRIME + POP P,SYM + POP P,WRDRLC + POP P,WRD + TDZ I,[-1-(ILWORD)] + IOR I,(P) + POP P,1(P) + POP P,GLSP2 + POP P,FLDCNT + POP P,FORPNR + POP P,FORMAT + JRST (LINK) + ;;GETFD ;GET FIELD (EXPRESSION); RETURN VALUE IN A, RELOC BITS IN B + + ;GET FIELD FOR PSEUDO + ;SYM SHOULD CONTAIN THE SQUOZE NAME OF THE PSEUDO + ;OR A POINTER TO AN INSN TO EXECUTE WHEN UNDEF + ;SYMBOL SEEN. SYM IS NOT CLOBBERED. + +AGETFD: PUSH P,I ;SAVE I + TRO I,IRPSUD+IRNOEQ ;SET FLAG TO GETVAL TO EXECUTE GTVER ON UNDEFINED SYM ON EITHER PASS + SAVE GTVER ;OLD VALUE OF GTVER + MOVEM SYM,GTVER ;ERROR MSG SHOULD GIVE NAME OF PSEUDO. + CALL YGETFD + MOVE SYM,GTVER + REST GTVER + MOVEM I,ISAV ;SAVE FLAGS FOR FIELD GOTTEN +POPIJ: POP P,I + POPJ P, + +;READ A FIELD, NOT PART OF THE CURRENT WORD. +YGETFD: PUSH P,WRD + SETZM WRD + CALL XGETFD + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + ADD A,WRD ;ADD IN INDEX, INDIRECT FIELDS + POP P,WRD + POPJ P, + +IFN FASLP,[ +FAGTFD: PUSHJ P,AGETFD ;DO AGETFD, COMPLAIN IF RELOCATABLE OR GLOBAL + MOVE TM,GLSP1 + CAMN TM,GLSP2 + SKIPE B + ETSM [ASCIZ /relocatable or external argument/] + POPJ P, +] +;READ A FIELD PART OF CURRENT WORD (FOR XWD, ETC). +XGETFD: SAVE PPRIME +AGTFD3: PUSHJ P,GETFLD + MOVE CH1,CDISP + TLNN CH1,DWRD + TLOA FF,FLUNRD ;DELIMITER IS WORD TERMINATOR => RE-READ IT. + TRNE I,IRFLD ;NON-NULL FIELD SUPPLIED => RETURN IT. + JRST AGTFD4 + HRRZ C,CDISP ;ELSE COMMA => RETURN NULL VALUE (0) + CAIN C,SPACE ;SPACE => TRY AGAIN TO READ A FIELD. + JRST AGTFD3 ;NO FIELD, TRY AGAIN +AGTFD4: REST PPRIME + POPJ P, + + ;IN RELOCATABLE FORMAT + ;READ FIELD AND COPY OUT AS WORD + +RGETFD: SETZM WRD ;FIRST INITIALIZE SOME STUFF AS THOUGH AT GETWD + SETZM WRDRLC + MOVE A,GLSPAS + MOVEM A,GLSP1 + MOVEM A,GLSP2 + CALL XGETFD + ADDM A,WRD + ADDM B,WRDRLC + PUSHJ P,PWRDA ;OUTPUT WORD + TLNE I,ILMWRD + JRST IGTXT ;SOAK UP MULTI-WORD FIELD + POPJ P, + ;READ IN A FIELD, RETURN IN A,B SETTING IRFLD IF FIELD NOT NULL. +GETFLD: SAVE GLSP1 ;REFERED TO AS GETFLB(P) WHEN ONLY 1 SYL PUSHED. + MOVEM P,PPRIME + TRZ I,IRFLD+IROP +GETFD1: TLNE I,ILMWRD + JRST GETFD9 ;MULTIPLE WORD, RE-CALL PSEUDO + PUSHJ P,GETSYL + TRNE I,IRLET +GETFD9: PUSHJ P,GETVAL ;GET OPERAND (MAYBE SKIPS) +GETFD6: SKIPA C,CDISP ;GET INFO ON SYLLABLE TERMINATOR + JRST GETFD1 ;GETVAL SKIPPED => PSEUDO/MACRO WITH NO VALUE, TRY AGAIN + TLNE C,DFLD + JRST (C) ;FIELD OPERATOR, GO PROCESS + TRNE I,IRSYL ;NO DISP MEANS FIELD TERMINATOR. + TRO I,IRFLD + CAME P,PPRIME ;IF ANY OPERATORS PUSHED, + JSP LINK,GETFD8 ;EVAL THEM. + SUB P,[1,,1] ;FLUSH GLSP1 SAVED AT GETFLD. + RET + +GETFD8: MOVEI TT, ;END OF FIELD HAS VERY LOW PRIORITY. + JRST GETFD7 + +;PUSH AN OPERATOR, MAYBE EVALLING STUFF TO LEFT. +;A HAS LEFT OPERAND (IF ANY), B RELOCATION BITS, +;C ADR OF ROUTINE TO PERFORM OPERATION, LH OF TT HAS PRECEDANCE OF OPERATOR + +GETFDL: MOVEI LINK,GETFD3 ;AFTER MAYBE EVALLING, GO PUSH OPERATOR. + TRO I,IRFLD+IROP + TRNN I,IRSYL + JRST GETFD5 ;UNARY, EVAL NOTHING, JUST PUSH WITH HIGH PRIO. +GETFD2: CAME P,PPRIME ;NO OPS TO LEFT => NOTHING TO EVAL. + CAMLE TT,GETFLP(P) ;COMPARE PRIO OF PREV. OP. AND CURRENT. + JRST (LINK) ;WAIT UNTIL LATER +GETFD7: HRRZ T,GETFLP(P) ;EVAL THE LAST OP ON STACK. + JRST (T) ;GO DO IT NOW (ROUTINE RETURNS TO GETFD4) +GETFD4: SUB P,[4,,4] + JRST GETFD2 + +GETFD5: MOVSI TT,200 ;GIVE UNARY OP HIGH PRIO. TO DO BEFORE NEXT BINARY. +GETFD3: PUSH P,B ;GETFLR(P) + PUSH P,A ;GETFLV(P) + HLL C,TT + PUSH P,C ;GETFLP(P) + PUSH P,GLSP1 ;GETFLG(P) + JRST GETFD1 + +GETFLB==,-4 ;PDL IDX OF GLSP1 BEFORE LEFT OPERAND. +GETFLR==,-3 ;PDL IDX OF RELOC OF LEFT OPERAND. +GETFLV==,-2 ;PDL IDX OF VALUE OF LEFT OPERAND. +GETFLP==,-1 ;PDL IDX OF PRIO,,DISPATCH +GETFLG==0 ;PDL IDX OF GLSP1 AFTER LEFT OPERAND (=BEFORE RIGHT) + PLS: MOVEI C,PLS1 ;PLUS SIGN, PLS1 IS ROUTINE TO PERFORM OPERATION +MINUS2: MOVSI TT,10 ;SET UP PRECEDENCE OF 10 FOR +, - + JRST GETFDL + +MINUS: JSP C,MINUS2 ;MINUS SIGN + MOVNS A ;NEGATE VALUE OF RIGHT OPERAND + MOVNS B ;ALSO RELOCATION + JUMPGE FF,PLS1 + MOVE T,GETFLG(P) + PUSH P,B + HRLZI B,MINF + PUSH P,C + PUSHJ P,LNKTZ ;COMPLEMENT THE MINUS FLAG ON GLOBALS IN RIGHT OPERAND + POP P,C + POP P,B +PLS1: ADD A,GETFLV(P) ;ADD VALUES + ADD B,GETFLR(P) ;ADD RELOCATIONS + JRST GETFD4 + +LNKTZ: TDZA C,C +LNKTC1: MOVE T,GLSP2 +LINKTC: CAML T,GLSP1 + POPJ P, + SKIPL 1(T) + XORM B,1(T) + SKIPL 1(T) + IORM C,1(T) + AOJA T,LINKTC + MULTP: MOVEI C,MULTP1 ;ASTERISK, MULTP1 ROUTINE TO PERFORM MULTIPLICATION +DIVID2: MOVSI TT,20 ;20 PRECEDENCE OF MULTIPLICATION, DIVISION + JRST GETFDL + +MULTP1: JUMPGE FF,MULTR ;ON P1, DON'T CHECK THIS, SINCE UNDEF SYMS ARE EXTERNALS + SKIPL CONTRL ;ELSE IN DECREL ASSEMBLY, TEST FOR EXTERNALS. + JRST MULTR + MOVE D,GETFLB(P) ;ACTUALLY, GET HERE FOR ABS ASSEMBLIES TOO, BUT SO WHAT? + CAME D,GLSP1 + ETR [ASCIZ /Externals multiplied/] +MULTR: JUMPE B,MULTP3 ;JUMP ON RIGHT OPERAND NOT RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;BOTH OPERANDS RELOCATED + MOVE T,GETFLV(P) ;GET VALUE OF LEFT OPERAND AND FALL IN + JRST MULTP5 + +MULTP3: MOVE T,A ;RIGHT OPERAND NOT RELOCATED, GET VALUE IN T + MOVE B,GETFLR(P) ;RELOCATION BITS OF LEFT OPERAND +MULTP5: MOVE D,GETFLG(P) ;GLOTB POINTER TO BETWEEN OPERANDS + CAME D,GETFLB(P) + JRST GMUL1 ;LEFT OPERAND HAS GLOBALS + CAME D,GLSP1 + JRST GMUL2 ;RIGHT OPERAND HAS GLOBALS + ;AT THIS POINT, T HAS VALUE OF ABS OPERAND, B RELOC BITS OF OTHER +GMUL4: IMUL A,GETFLV(P) ;MULTIPLY VALUES + IMULB B,T ;MULTIPLY RELOCATION OF ONE BY VALUE OF OTHER + TRZ T,1 + SKIPL CONTRL ;EXCEPT IN STINK ASSEMBLY, OBJECT TO RELOCATION + JRST GETFD4 ;OTHER THAN 0 OR 1 (ONLY AFFECTS DECREL, SINCE + JUMPE T,GETFD4 ;RELOCATION CAN'T BE NONZERO IN ABS ASSEMBLY). +MULTP4: ETR [ASCIZ+Relocatable arg to * or / or Boolean+] + JRST GETFD4 + +GMUL1: TLNE FF,FLPPSS ;LEFT OPERAND HAS GLOBALS, CHEK RIGHT OPERAND + CAMN D,GLSP1 + SKIPA CH1,A ;LOOKS OK, GET VALUE IN CH1 + ETR [ASCIZ /Multiplying two externals/] + SKIPA D,GETFLB(P) ;GET GLOTB POINTER TO BOTTOM OF LEFT OPERAND +GMUL2: MOVE CH1,GETFLV(P) ;GLOBALS IN RIGHT OPERAND ONLY, GET LEFT OPERAND +GMUL3: CAML D,GLSP1 + JRST GMUL4 ;TABLE COUNTED OUT + SKIPGE 1(D) + AOJA D,GMUL3 + JUMPE CH1,GMUL5 ;MULTIPLYING BY ZERO, CLEAR OUT GLOTB ENTRY AND LOOP BACK + LDB CH2,[221200,,1(D)] ;PICK UP MULTIPLICATION FIELD THIS GLOBAL + SKIPN CH2 + MOVEI CH2,1 ;0 => 1 + IMUL CH2,CH1 + CAIN CH2,1 + MOVEI CH2,0 ;IF ONE THEN USE ZERO + DPB CH2,[221200,,1(D)] + AOJA D,GMUL3 + + +GMUL5: CLEARM 1(D) + AOJA D,GMUL3 + DIVID: JSP C,DIVID2 ;SLASH, PRECEDENCE = 20 +DIVID1: JUMPN B,MULTP4 ;JUMP IF RIGHT OPERAND RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;LEFT OPERAND RELOCATED + EXCH A,GETFLV(P) + IDIV A,GETFLV(P) + MOVEI B,0 + JUMPGE FF,GETFD4 + MOVE D,GETFLB(P) + CAME D,GLSP1 + ETR [ASCIZ /Division involving externals/] + JRST GETFD4 + + ;LOGIC OPERATORS & (PREC = 40), # (PREC = 34), \ (PREC = 30) + +ANDF: MOVSI TT,40 ;& + JSP C,GETFDL + JSP D,LOGIC1 ;GO DO IT + AND A,GETFLV(P) ;INSTRUCTION ARGUMENT TO LOGIC1 + +XORF: MOVSI TT,34 ;# + TRNN I,IRSYL ;IF ABOUT TO BE UNARY, + MOVNI A,1 ;THEN TURN LEFT OPERAND INTO -1 + JSP C,GETFDL + JSP D,LOGIC1 + XOR A,GETFLV(P) + +IORF: MOVSI TT,30 ;\ + JSP C,GETFDL + JSP D,LOGIC1 + IOR A,GETFLV(P) + + ;COMMON EXECUTION ROUTINE FOR LOGICAL OPERATORS + +LOGIC1: JUMPN B,MULTP4 ;NO RELOCATION ALLOWED + SKIPE GETFLR(P) ;NOW CHECK RELOCATION OF LEFT OPERAND + JRST MULTP4 + XCT (D) ;ALL TESTS PASSED, DO IT + JUMPGE FF,GETFD4 ;DON'T CHECK FOR GLOBALS EXCEPT DURING PUNCHING PASS + MOVE D,GETFLB(P) ;PICK UP POINTER TO LEFT OPERAND GLOTB ENTRIES + CAME D,GLSP1 + ETR [ASCIZ /External in arg to \, & or #/] + JRST GETFD4 + +CBAKAR: MOVSI TT,100 ;BACKARROW AS FIELD OPERATOR, PREC = 100 + JSP C,GETFDL ;RETURN TO GETFLD TO READ 2ND ARGUMENT. + JSP D,LOGIC1 ;FOR EVALUATION, CALL LOGIC1 + JSP D,.+1 ;WHICH EXECUTES THIS INSTRUCTION, + MOVE T,A ;TO CALL THIS SUBROUTINE. + MOVE A,GETFLV(P) + LSH A,(T) + JRST (D) + ;D SHOULD HAVE 1 FOR <, 2 FOR (, 3 FOR [ ;] +LSSTH9: JSP LINK,SAVAS1 ;SAVE ASSEM1 PDL LEVELS, .BYTE MODE, ETC. + MOVEM D,ASMOUT ;SAY WHAT KIND OF OPEN WE JUST DID + JRST ASSEM3 ;REENTER ASSEM1 LOOP AT INNER LEVEL. + +;COME HERE TO EXIT FROM AN ASSEM1 LEVEL THAT WAS ENTERED BY LSSTH9. +LSSTHA: SKIPE BYTM ;IN BYTE MODE, DO .WALGN. SINCE ASMDSP + JRST A.BY3 ;STILL POINTS HERE, WE'LL COME BACK. + MOVE P,CONSTP + JSP T,CONNDP ;POP STUFF SAVED BY SAVAS1 + MOVE A,WRD ;RETURN THE WORD IN THE GROUPING + MOVE B,WRDRLC ;(OUR CALLER WILL USVWLD, CLOBBERING WRD) + POPJ P, + +LSSTH: MOVEI D,1 ;1 FOR <. + JSP LINK,SAVWD1 + PUSHJ P,LSSTH9 +LSSTH3: JSP LINK,USVWLD ;POP OFF ALL BUTPREVIOUS SYLL. + +;GROUPINGS EXCEPT (PARENS THAT ADD TO WORD) +;SYLL IMMEDIATELY BEFORE OR AFTER IS ERROR. +LSSTH2: ADDM A,-1(P) ;SYLL BEFORE GROUPING, PUSHED BY SAVWD1. + ADDM B,(P) + TRNE I,IRSYL ;IF WAS SYLL BEFORE GROUPING, ERROR. + ETR ERRNOS +LSSTH5: MOVE A,LIMBO1 ;CHECK FOR FOLLOWING SYLL. + CAIE A,15 + CAIN A,12 + JRST LSSTH6 ;DELIMITER CR OR LF + PUSHJ P,RCH ;NOT CR OR LF, GET NEXT CHAR + CAIN A,"! ;IGNORE EXCLAMATION POINT + JRST .-2 + TLO FF,FLUNRD ;CAUSE IT TO BE RE-INPUT + HLRZ CH1,GDTAB(A) + CAIE CH1,(POPJ P,) + JRST LSSTH4 ;SQUOZE CHAR. MEANS FOLLOWING SYLL. + HRRZ CH1,GDTAB(A) + MOVE CH1,DTB-40(CH1) ;GET DISPATCH FOR CHAR. + TLNE CH1,DSY1 ;MIGHT START SYL => NOS ERROR. + JRST LSSTH4 +LSSTH7: PUSHJ P,GTSL1 +LSSTH6: TRO I,IRSYL + POP P,B + POP P,A ;VALUE OF GROUPING WAS ADDM'ED INTO THESE. + TLZE I,ILLSRT ?.SEE UA3 + RET ;IF CALLED BY ^ OR _ AS SYL OP, RETURN TO IT. + JRST GETFD6 + LSSTH1: TLO I,ILWORD ;A NUMBER IN PARENS BY ITSELF IS A NONNULL WORD. + ADDM A,WRD + ADDM B,WRDRLC + TRNE I,IRSYL ;IF SYLL BEFORE, + JRST LSSTH5 ;ERROR IF SYL AFTER. + JRST LSSTH8 ;ELSE NO ERROR. + +LSSTH4: ETR ERRNOS ;FOLLOWING SYLL WHEN THAT IS ERROR. +LSSTH8: TLNE I,ILLSRT ?.SEE UA3 + JRST LSSTH6 + SUB P,[2,,2] + JRST GETFD1 + +ERRNOS: ASCIZ /Syllables not separated/ + +POP2J: SUB P,[2,,2] + POPJ P, + +LEFTP: MOVEI D,2 ;2 FOR ). + JSP LINK,SAVWD1 + MOVEI C,0 + TRNE I,IROP + TRNE I,IRSYL + TLO C,400000 ;CAUSE IT TO GET ADDED INTO WORD STEAD HAVE VALUE AS SYL + PUSH P,C + PUSHJ P,LSSTH9 + POP P,C + MOVSM A,T1 ;STORE SWAPPED VALUE + ADDI B,400000 ;NOW WANT TO SWAP RELOCATION, MAKE LH CORRECT + HLREM B,T2 ;STORE AS RH WITH SIGN EXTENDED + MOVSI B,400000(B) ;GET RIGHT HALF IN LEFT + ADDM B,T2 ;FINISH RELOCATION SWAP (THIS IS PAINLESS COMPARED TO THE HAIR EVERYWHERE + ;ELSE WHEN KEEPING THE HALFWORDS SEPARATE) + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + JSP LINK,USVWLD + MOVE A,T1 + MOVE B,T2 + JUMPL C,LSSTH1 ;ADD TO WHOLE WORD + JRST LSSTH2 + +;VERSION OF GETWRD FOR PSEUDO, +;PSEUDO MUST EITHER SAVE I, PPRIME AND GTVER OR RETURN TO ASSEM1. +;SYM SHOULD HOLD NAME OF PSUEUDO. + +AGETWD: MOVEM SYM,GTVER ;STORE NAME OF PSEUDO FOR UNDEF SYM MSGS. + TRO I,IRPSUD\IRDEF\IRNOEQ + PUSHJ P,GETWRD + MOVE SYM,GTVER ;RESTORE SYM. + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + RET + ;;GETWD ;READ A WORD, LEAVE VALUE IN A AND WRD, RELOC IN WRDRLC AND B + +GETWRD: MOVE T,GLSP1 + MOVEM T,GLSP2 + CLEARM FORMAT ;CLEAR FORMAT, WILL ACCUMULATE FORMAT NUMBER BY IDPB + CLEARM WRD ;CLEAR WRD, WILL ACCUMULATE ABSOLUTE PART OF WORD + CLEARM WRDRLC ; " RELOCATION BITS, " + TDZ I,[ILWORD,,IRIOINS] + CLEARM FLDCNT ;NO FIELDS YET + MOVE T,[50100,,FORMAT] ;SET UP BIT POINTER TO FORMAT + MOVEM T,FORPNR +GTWD1: PUSHJ P,GETFLD ;READ NEXT FIELD +SPACE6: MOVEI T,1 ;SET T TO 1, AC FOR IDPB ON ROUTINE DISPATCHED TO + SKIPA C,CDISP +SPACE5: REST A + TLNE C,DWRD + JRST (C) ;NO DISPATCH MEANS WD TERMINATOR + MOVE C,GLSP1 + MOVEM C,LINKL ;MARK END OF ACTIVE PART OF GLOTB + TRNN I,IRFLD + JRST GETWD2 ;LAST FIELD NULL, MAYBE HAVE TO POP STUFF OFF + IDPB T,FORPNR ;MARK NON-NULL FIELD IN FORMAT +GTWD4A: TLO I,ILWORD ;NON-NULL WORD + MOVE TT,FORMAT + SKIPN TT,FORTAB-10(TT) ;PICK UP BYTE POINTER POSITION/SIZE FIELDS FOR FIELDS IN WORD + ETR [ASCIZ /Undefined format/] + MOVEM TT,FORMAT ;STORE IN FORMAT + MOVE T,[301400,,FORMAT] + MOVEM T,FORPNR + ;AT THIS POINT, FLDCNT HAS 1 LESS THAN # FIELDS; PUT FIELDS TOGETHER TO FORM WORD +GTWD3: LDB T,FORPNR + MOVE D,FLDCNT + CAIG D,2 + IBP FORPNR ;HAVEN'T BACKED UP TO THIRD FIELD YET, INCREMENT TO DESC FOR PREV + TRNE I,IRIOINS + PUSHJ P,INTIOW + PUSHJ P,INTFLD ;PUT FIELD WHERE IT BELONGS + SOSGE FLDCNT + JRST GTWD5 ;THIS WAS LAST (FIRST) FIELD + POP P,GLSP2 ;NOT YET, POP OFF MORE + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD3 + +GTWD5: MOVE A,WRD + MOVE B,WRDRLC + MOVE C,LINKL + MOVEM C,GLSP1 + TRZ I,IRIOINS + POPJ P, + COMMA: TRNN I,IRFLD ;FIELD DELIMITER WAS COMMA (T HAS 1) + JRST COMMA1 ;NO FIELD + IDPB T,FORPNR ;MARK NON-NULL FIELD +COMMA4: IDPB T,FORPNR ;MARK FIELD TERMINATOR WAS COMMA + MOVE TT,FLDCNT + CAIL TT,2 + ETR [ASCIZ /Comma past the 3rd field of a word/] +PUSHFD: PUSH P,A ;DONE WITH THIS FIELD, NOW TO GET NEXT + PUSH P,B + PUSH P,GLSP1 + PUSH P,GLSP2 + AOS FLDCNT ;ANOTHER FIELD + MOVE TT,GLSP1 + MOVEM TT,GLSP2 + HRRZ T,FORPNR + CAIE T,FORMAT + HRRZS FORPNR ;STABILIZE FORPNR + TLO I,ILWORD ;SAY WE HAVE A NON-NULL WORD IN PROGRESS (LOC, ETC. ILLEGAL). + JRST GTWD1 + +GETWD2: SKIPN FORMAT ;LAST FIELD OF WORD IS NULL + JRST GTWD5 ;ENTIRE WORD NULL, MAYBE WERE PARENS. + SOS FLDCNT + POP P,GLSP2 + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD4A + +COMMA1: LDB TT,FORPNR ;COMMA TERMINATED NULL FOELD. + SKIPE FORMAT + JUMPE TT,COMMA2 ;NOT 1ST FIELD, JMP IF PREV WAS TERM BY SPACE. + IBP FORPNR ;ELSE MARK NULL FIELD IN FORMAT. + JRST COMMA4 + +;FIELD SPACE COMMA, PATHOLOGICAL CASE +;(EG MACRO STARTED WITH A COMMA) +COMMA2: DPB T,FORPNR ;REPLACE SPACE WITH COMMA. + JRST GTWD1 + + ;FIELD TERMINATOR IS SPACE (T HAS 1) + +SPACE: MOVE TT,LIMBO1 + CAIE TT,^I ;HEURISTIC: REAL SPACES ARE LIKELY TO BE FOLLOWED BY SQUOZE, + JRST SPACE4 ;WHILE TABS ARE LIKELY TO BE FOLLOWED BY COMMENTS. + PUSH P,A + MOVE TT,GDTAB+40 + PUSHJ P,RCH + CAMN TT,GDTAB(A) + JRST .-2 ;FLUSH OTHER LOGICAL SPACES + CAIN A,"; ;TAB WAS FOLLOWED BY SEMICOLON: + JRST [ SAVE B + TRZ I,IRSYL + CALL SEMIC ;FLUSH THE COMMENT + MOVEI T,1 + REST B + JRST SPACE5] ;AND HANDLE THE C.R. +SPACE3: POP P,A + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-READ NEXT TIME +SPACE4: TRNN I,IRFLD + JRST GTWD1 ;NO FIELD + IDPB T,FORPNR ;T HAS 1, MARK NON-NULL FIELD IN FORMAT + IBP FORPNR ;MARK FIELD TERMINATOR WAS SPACE + JRST PUSHFD + ;T HAS DESC BYTE, PUT FIELD IN ITS PLACE +;ALSO CALLED FROM PBYTE, MUSTN'T CLOBBER AA. + +INTFLD: MOVE TT,GLSP2 + CAMN TT,GLSP1 + JUMPE B,INTFD1 ;NO GLOBALS, JUMP IF NO RELOCATION + CAIN T,2222 ;LH + JRST INTL + CAIN T,22 ;RH + JRST INTR + CAIN T,44 ;WHOLE WORD + JRST INTW + SKIPE B + ETR [ASCIZ/Relocation attempted in irrelocatable field/] + ;(ASSUME) NO RELOCATION, CHECK FOR GLOBAL AC FIELDS + CAIN T,2704 ;HIGH AC + JRST INTACH + CAIN T,504 ;AC LOW + JRST INTACL + JUMPGE FF,INTFD1 ;JUMP ON NOT PUNCHING PASS + CAME TT,GLSP1 + ETR [ASCIZ/Global symbol in illegal field/] +INTFD1: MOVEI TT,C_12. + ROTC T,-12. ;SHIFT BYTE POINTER INTO TT + MOVEI C,0 ;INITIALIZE C TO RECEIVE FIELD IN PROPER PLACE + DPB A,TT + CAMN TT,[2200,,C] + JRST INTFD2 ;RIGHT HALF, DON'T ALLOW CARRY INTO LH + ADDM C,WRD ;ALLOW CARRY +INTFD3: ADDM B,WRDRLC ;ADD RELOCATIONS, WILL BE BROKEN BACK INTO HALF-WORDS LATER + POPJ P, + +INTFD2: ADD C,WRD ;ADD RIGHT HALVES + HRRM C,WRD + JRST INTFD3 + +INTIOW: CAIE T,2704 + CAIN T,504 + TRZA A,3 ;IO DEVICE FIELD + POPJ P, ;NOT "AC" FIELD + ADDI T,611-504 + POPJ P, + INTR: HRRE D,B ;RH + MOVEI B,0 + PUSH P,T + HRLZI C,HFWDF + PUSHJ P,LNKTC1 ;THIS IS A BUG WHICH SHOULD BE FIXED SOMETIME +PRTCL: MOVE B,D ;GET BACK MAPPED RELOCATION BITS +PRTCL2: POP P,T +INTW: MOVE D,GLSP2 ;WHOLE WORD + HRLOI LINK,377777 + CAML D,GLSP1 + JRST INTFD1 + ANDM LINK,1(D) + AOJA D,.-3 + +INTL: HRLZ D,B ;LH + MOVSI B,SWAPF + MOVSI C,HFWDF + PUSH P,T + MOVE T,GLSP2 +INTL2: CAML T,GLSP1 + JRST PRTCL + SKIPGE 1(T) + AOJA T,INTL2 ;INDEX FIELD, ETC => LEAVE ALONE + IORM C,1(T) ;SET HFWDF + XORM B,1(T) ;COMPLEMENT SWAP STATUS + TDNN B,1(T) + SETZM 1(T) ;SWAPPED TO RH, FLUSH IT + AOJA T,INTL2 + +INTACL: TDZA B,B ;AC LOW +INTACH: HRLZI B,SWAPF ;AC HIGH + HRLZI C,ACF + PUSH P,T + PUSHJ P,LNKTC1 + MOVEI B,0 + JRST PRTCL2 + +IOINST: HLLZ A,B ;IO INSTRUCTION, GET WHICH ONE INTO A + SKIPN FLDCNT ;THIS FIRST FIELD OF WORD? + TRO I,IRIOINS ;YES + JRST CLBPOP ;RETURN VALUE + ;TOP LEVEL LOOP, ASSEMBLE STORAGE WORDS +;LOTS OF PSEUDOS MEANINGLESS IN STORAGE WORDS +;(E.G. BLOCK, CONSTA) DO JRST ASSEM1 WHEN DONE +;THERE'S ALSO AN ERROR UUO WHICH RETURNS TO ASSEM1 + +ASSEM1: MOVE P,ASSEMP + JRST @ASMDSP + +;COME HERE TO START THE NEXT EXPRESSION OR WHATEVER. +ASSEM3: PUSHJ P,RCH + CAIN A,^I + JRST ASSEM2 ;PROBABLY NOT PROFITABLE TO SKIP AFTER SEE A TAB. + CAIG A,40 + JRST ASSEM3 ;FLUSH LEADING GARBAGE + TLO FF,FLUNRD ;CAUSE NON-GARBAGE CHAR FOUND TO BE RE-INPUT +;ASMDSP POINTS HERE WITHIN ASCII, SIXBIT ETC. +ASSEM2: TRZ I,IRFLD+IRSYL+IRLET+IRPSUD+IRCOM+IRCONT+IRGMNS+IROP+IRNOEQ+IREQL + TLZ I,ILGLI+ILVAR+ILFLO+ILDECP+ILUARI+ILWORD+ILNPRC + IOR I,ASMI ;SET DEF AND RESTORE PSEUDF. + MOVE A,GLSPAS + SKIPL BYTM + MOVEM A,GLSP1 + ;GETWRD WILL COPY GLSP1 INTO GLSP2 +IFN TS,[AOSN TTYBRF ;DO A ^H-BREAK IF REQUESTED. + CALL TTYBRK] + PUSHJ P,GETWRD + TLZN I,ILWORD + JRST @ASMDSP ;NO WORD ASSEMBLED,TRY AGAIN + SKIPGE BYTM + JRST PBYTE ;IN BYTE MODE, OUTPUT BYTE INSTEAD OF WORD, A,B MUST HAVE WRD,WRDRLC. + MOVE AA,ASMOUT ;OUTPUT WD AS APPRO. FOR GROUPING, IF ANY. + JRST @ASMOT0(AA) + +ASSEM6: SKIPE STGSW ;ASMOT0 POINS HERE. COME IF NOT IN GROUPING. + ETR ERRSWD ;STORAGE WORD ASSEMBLED + PUSHJ P,PWRD ;OUTPUT THE WORD. + AOS CLOC + HRRZS CLOC ;INCREM. POINT . + JRST @ASMDSP ;ASSEM3 OR ASSEM2 + +ERRSWD: ASCIZ /Storage word assembled/ + +ASSEM4: JSP T,PCONST ;ASMOT0+3 POINTS HERE. COME IF IN CONSTANT. + JRST @ASMDSP + +;ASMDSP POINTS HERE WITHIN GROUPING IF NOT IN MULTI-LINE MODE +;[ ;AND NO CLOSE (">)]") HAS BEEN SEEN. +ASSEMC: MOVE AA,ASMOUT + SKIPE CONSML ;IN ERROR MODE, GIVE APPROPRIATE ERROR MSG. + XCT ASMOT3(AA) + JRST @ASMOT2(AA) ;CLOSE WHATEVER TYPE GRPING WE'RE IN. + ;JUMP THRU THIS TABLE TO OUTPUT A WORD. +ASMOT0: ASSEM6? ASSEM1? ASSEM1? ASSEM4? [HALT ] + +;THIS TABLE GIVES APPRO. CLOSE FOR EACH TYPE OF GROUPING. ;[ +ASMOT1: "? ? "> ? ") ? "] ? "? + +;THIS TABLE SAYS WHERE TO GO TO END THE GROUPING. +ASMOT2: [HALT ]? LSSTHA? LSSTHA? CONND? [HALT ] + +;APPROPRIATE ERROR MESSAGE FOR MISSING CLOSE OF GROUPING. [ +ASMOT3: HALT + ETR [ASCIZ /Missing >/] + ETR [ASCIZ /Missing )/] + ETR [ASCIZ /Missing ]/] + HALT + +;THIS TABLE TELLS PBYTE HOW TO HANDLE BYTE MODE. +ASMOT4: PBY4 ? PBY5 ? PBY5 ? PBY3 ? [HALT ] + +;TABLE SAYING WHAT CHAR MUST HAVE OPENED THE GROUPING. +ASMOT5: "? ? "< ? "( ? "[ ? "? ;] + ;;GETVAL ;GET VALUE OF SYM + ;SKIPS ON PSEUDO NOT RETURNING VALUE (E.G. MACRO STARTING TO BE EXPANDED) + ;ELSE RETURNS VALUE IN A, RELOCATION BITS IN B + +VBLK +GTVER: 0 ;SQUOZE NAME OF CALLING PSEUDO, OR POINTER + ;TO INSN TO EXECUTE WHEN IF SYM IS UNDEF. +PBLK + +GETVAL: PUSHJ P,ES + JRST GVNF ;NO STE. +IFN CREFSW,XCT CRFINU ;JFCL OR CALL TO CREF RTN. + JRST @.+1(A) ;FOUND, DISPATCH ON SQUOZE FLAGS + +GVTAB: GVCOM ;COMMON (UNUSED) + GVPSEU ;PSEUDO OR MACRO. + GVSYM ;LOCAL SYMBOL. + GVUL ;LOCAL UNDEF (MAYBE STINK KNOWS VALUE) + GVDLV ;DEFINED LOCAL VAR. + GVULV ;UNDEF LOC VAR. + GVDGV ;DEF GLO VAR + GVUGV ;UNDEF GLO VAR + GVDG ;DEF GLOBAL + GVUG ;UNDEF GLOBAL + +;DEF LOCAL VAR. +GVDLV: PUSHJ P,GVDLGV ;IF PASS2 AND HAS ' THIS TIME, SET 3VAS2 FOR AVARIAB + TLZN I,ILGLI + JRST GVDLV2 + MOVSI T,DEFGVR ;NOW DEF GLO VAR. + PUSHJ P,VSM2 + JRST GVDG1 ;MAYBE OUTPUT GLOBAL DEF. TO STINK. + +GVDGV: PUSHJ P,GVDLGV ;DEF GLO VAR; IF PASS 2 AND ' THIS TIME, SET 3VAS2 + JRST GVDG2 ;MUSN'T PUNCH VALUE, AVARIAB WILL. + +GVDLGV: TRNE FF,FRPSS2 ;IF PASS 2 + TLNN I,ILVAR ;AND THIS TIME HAVE SINGLEQUOTE + POPJ P, + TLO C,3VAS2 ;TELL AVARIAB SEEN IN PASS 2 WITH '. + 3PUT C,D + POPJ P, + +GVULV: TLZN I,ILGLI ;UNDEF LOCAL VAR, MAYBE MAKE GLOBAL. + JRST GVUNDF + PUSHJ P,PLOGLO ;IF SO, TELL STINK SYM IS GLOBAL, + MOVSI T,UDEFGV ;SYM NOW UNDEF GLO VAR + PUSHJ P,VSM2 + JRST GVUNDF ;IN EITHER CASE, HANDLE UNDEF SYM. + GVUL: TLZE C,3MACOK ;UNDEF LOCAL, PRESUMED NUMERIC + 3PUT C,D ;DON'T LET IT BECOME MACRO AND SCREW PASS2. + TLNE C,3LLV + JRST GVGLTB ;(REALLY DEFINED BUT ONLY STINK KNOWS HOW) + TLNE I,ILGLI ;IF MAKING GLOBAL, TELL STINK. + PUSHJ P,PLOGLO +GVNF1: TLZE I,ILVAR ;IF ', MAKE VAR (WILL CHECK ILGLI) + JRST GVUL1 + TLZN I,ILGLI ;NOT MAKING VAR, MAYBE GLOBAL? + JRST GVUNDF ;NO, MAYBE ERROR, MAKE GLOTB ENTRY. + MOVSI T,GLOEXT + PUSHJ P,VSM2 ;NOW GLOBAL UNDEF, + JRST GVGLTB ;NO ERROR, JUST GLOTB ENTRY. + +GVUL1: TLZN I,ILGLI ;UNDEF LOCAL BECOMES + SKIPA T,[UDEFLV,,] ;UNDEF LOC VAR OR +GVGVAR: MOVSI T,UDEFGV ;UNDEF GLO VAR. +GVVAR: CALL ESDEF ;DEFINING SYM AS A VAR => INSIST ON DEFINING LOCAL TO INNERMOST BLOCK. + JFCL + AOS VARCNT + HRR B,VARCNT + PUSHJ P,VSM2 ;MAKE IT A VAR, + JRST GVUNDF ;PRETEND HAD ALREADY BEEN A VAR. + +GVUG: TLZE I,ILVAR ;UNDEF GLOBAL: MAYBE MAKE UNDEF GLO VAR. + JRST GVGVAR +GVGLTB: SKIPGE CONTRL ;UNDEF GLO IN ABS ASSEM => + JRST GVUND1 ;MAYBE TREAT AS UNDEF. +GVGLT1: AOS GLSP1 ;DON'T KNOW SYM'S VALUE, MAKE GLOTB ENTRY. + MOVEI T,ST(D) + HRRZM T,@GLSP1 + JRST CABPOP ;RETURN 0 AS VALUE. + +GVNF: +IFN CREFSW,XCT CRFINU ;ONLY IF NOT FOUND WOULD NOT CREF AFTER ES. + TLNE I,ILVAR+ILGLI ;MAKING VAR OR GLOBAL FORCED CURRENTBLOCK ALREADY + JRST GVNF1 ;AND WILL STORE NAME IN STE ANYWAY. + SKIPGE ESBK ;ELSE IF NO SPEC'D BLOCK, + TRNN FF,FRNPSS ;FORCE .MAIN BLOCK SO DON'T GET LOTS OF UNDEF ENTRIES. + CAIA ;BUT CAN'T DO THAT FOR 1PASS OR WOULD MISS FWD REFS. + HRRI C,BKWPB + MOVSI T,LCUDF + PUSHJ P,VSM2 + JRST GVUNDF ;MAYBE ERROR, MAKE GLOTB ENTRY. + +GVCOM: TRO I,IRCOM ;COMMON: SAY THIS WAS ONE. + HRRZ A,B ;RETURN RH OF VALUE, ABSOLUTE. + JRST CLBPOP + +GVPSEU: TLNN I,ILVAR+ILGLI ;CAN'T MAKE PSEUD OR MACRO GLOBAL OR VAR. + JRST (B) ;OTHERWISE, DISPATCH TO IT. + TLZE I,ILVAR + ETSM ERRCBV + TLZE I,ILGLI + ETSM ERRCBG + JRST (B) ;DISPATCH TO PSEUDO (OR MACCL IF MACRO) + ;EXPECTS LH OF VALUE IN LH OF B. + +ERRCBV: ASCIZ /Can't be a variable/ +ERRCBG: ASCIZ /Can't be global/ + +GTVL7B: TLNE C,3RLL ;R(LH) + TLO SYM,200000 + TLNE C,3RLR ;R(RH) + TLO SYM,100000 + POPJ P, + GVSYM: TLNN C,3REL + TLNE I,ILVAR\ILGLI + JRST GVSYM2 + MOVE A,B ;THIS CODE DOES WHAT GVSYM2 WOULD DO, BUT FASTER. + SETZ B, + RET + +GVSYM2: TLZE I,ILVAR ;LOCAL SYM: CAN'T MAKE VARIABLE. + ETSM ERRMDV + TLZN I,ILGLI + JRST GVSYM0 ;NOT MAKING GLOBAL, GET VALUE & RETURN. +GVSYM1: MOVSI T,GLOETY ;BECOMES DEF. GLOBAL. + PUSHJ P,VSM2 + JRST GVDG1 ;HANDLE AS IF WAS DEF GLOBAL. + +ERRMDV: ASCIZ /Multiply-defined variable/ + +GVDG: TLZE I,ILVAR ;GLOBAL ENTRY + ETSM ERRMDV +;COME HERE FOR DEF GLOBAL +GVDG1: SKIPGE CONTRL + JRST GVDLV2 ;DON'T PUNCH VALUE IF ABSOLUTE. + TLNE C,3VP + JRST GVDG2 ;VALUE PUNCHED ALREADY, NOT AGAIN. + JUMPGE FF,GVDG2 + TLNN C,3LLV + TRNE I,IRPSUD+IREQL + JRST GVDG2 + TLO SYM,40000 + PUSH P,WRD + PUSHJ P,OUTDE2 + POP P,WRD +GVDG2: TRNN I,IRPSUD\IREQL ;IF INSIDE AN ORDINARY STORAGE WORD, + TLNN C,3REL ;GENERATE A GLOBAL REF IF GLOBAL IS RELOCATABLE (HEURISTIC). +GVDLV2: TLNE C,3LLV ;IF VAL KNOWN ONLY BY STINK, MUST MAKE A GLOBAL REF. + JRST GVGLTB +GVSYM0: MOVE A,B ;USED IN LBRAK + LDB B,[.BP (3RLR),C] + TLNE C,3RLL + TLO B,1 + POPJ P, + +GVUND1: MOVE A,CONTRL + TRNE A,DECREL+FASL ;DEC FMT OR FASL => UNDEF GLOBALS OK. + JRST GVGLT1 +GVUGV: +GVUNDF: TRZ I,IRDEF ;UNDEFINED, MAYBE ERROR, MAKE GLOTB ENTRY. + TRNE I,IRPSUD\IREQL + JRST GVUND2 ;PSEUDO + TRNN FF,FRPSS2 + JRST GVGLT1 ;PASS 1 + SKIPN CONDEP + ETSM [ASCIZ/Undefined/] + SKIPE CONDEP + ETSM [ASCIZ/Undefined in literal/] + JRST CABPOP + +GVUND2: HLRZ A,GTVER ;DOES GTVER POINT TO AN INSN? + JUMPE A,[XCT @GTVER ? JRST CABPOP] + ERJ .+1 ;NO, IT IS NAME OF PSEUDO. + MOVE A,LINEL + CAIGE A,75. ;CR-LF-TAB NOW IF WHOLE MSG WON'T FIT ON A LINE. + CALL CRRTBX + TYPE2 SYM ;TYPE NAME OF UNDEF SYM. + TYPR [ASCIZ/ Undefined in /] + TYPE2 GTVER + CALL CRRERR + JRST CABPOP + ;EVALUATE SYMBOL, SQUOZE (FLAGS OFF) IN SYM +;IDX OF BLOCK TO DEFINE IN IN ESBK (OR -1 => ANY BLOCK NOW IN PROGRESS). +;DOESN'T CLOBBER F (FOR WRQOTE) +;RETURNS SKIPPING IF SYM FOUND, WITH SQUOZE FLAGS IN BOTTOM OF A, +;VALUE OF SYM IN B, STE IDX IN D, AND 3RDWD IN C. +;IF NOT FOUND, RETURNS IN D THE IDX OF A PLACE TO DEFINE SYM. +;CALL ESDCHK TO GET THE FOLLOWING EXTRA INFO (WHETHER SYM FOUND OR NOT): +;ESLAST -> LAST STE WITH DESIRED NAME SEEN, REGARDLESS OF WHAT BLOCK IT'S IN +;ESL1 HAS LEVEL OF BLOCK OF BEST STE SEEN, -1 IF NOT FOUND +;ESL2 HAS 3RDWRD OF BEST. +;ESXPUN HAS -1 OR IDX OF A STE WHICH MIGHT BE USED TO DEFINE THE SYM. +;RH(TM) GETS BLOCK IDX TO DEFINE IN IF DEFINE THE SYM. +;TT HAS -<# STE NOT LOOKED AT YET> +;THEN IF SYM IS FOUND IN A CONTAINING BLOCK AND YOU WANT TO DEFINE +;IT IN THE CURRENT BLOCK, YOU CAN CALL DEFCHK TO FIND AN STE TO DO IT IN. +;CALLING ESDEF IS AS GOOD AS CALLING ESDCHK AND DEFCHK, BUT DOESN'T +;LET YOU SEE WHAT YOU ARE GOING TO SHADOW. + +ESDEF: MOVE A,BKCUR ;EVAL SYM IN ORDER TO DEFINE IT: + SKIPGE ESBK ;IF NO SPEC'D BLOCK, SPEC THE CURRENT BLOCK, + MOVEM A,ESBK ;SO DEFS IN CONTAINING BLOCKS WON'T BE SEEN + +ESDCHK: SETOM ESLAST ;CALL HERE IF WE MIGHT END UP CALLING DEFCHK, + SETOM ESL1 ;SINCE IN THAT CASE WE'LL NEED THESE VARS EVEN IF SYM IS FOUND + SETOM ESXPUN ;RIGHT AWAY. + MOVN TT,SYMLEN +ES: MOVE C,SYM ;HASH AWAY + TSC C,SYM ;THIS MAKES SURE THAT THE FIRST FEW CHARS OF SYMBOL DON'T GIVE + ;A ZERO REMAINDER, IF SYMLEN IS A ROUND NUMBER. + MOVMS C ;THIS IS BECAUSE IDIV OF NEGATIVE NUMBER GIVES NEG. REMAINDER. + IDIV C,SYMLEN + IMUL D,WPSTE + SKIPGE TM,ESBK ;GET BKTAB IDX OF SPEC'D BLOCK + HRR TM,BKCUR ;OR -1,,BKTAB IDX OF CURRENT BLOCK. +;NOW CHECK FAST FOR AN IMMEDIATE MATCH - AVOID SETTING UP FLAGS NEEDED ONLY WHEN +;SYM APPEARS IN MULTIPLE BLOCKS OR ISN'T DEFINED. + SKIPN B,ST(D) + JRST ESEND0 ;SYM IS KNOWN NOT TO BE DEFINED. + TLZ B,740000 + CAME B,SYM + JRST ESBAD0 ;NOT FOUND IN 1ST ENTRY - MUST SET UP INFO AND LOOP + 3GET C,D + MOVEI A,(C) + CAIN A,(TM) + JRST ESGOOD ;IN THE DESIRED BLOCK => GOOD. + TDNN C,[3MAS,,-1] ;IN THE INITIAL SYMS BLOCK, NOT PRESENT IN ANY OTHER, + JUMPL TM,ESGOOD ;AND BLOCK WASN'T EXPLICITLY SPEC'D => GOOD. + MOVN TT,SYMLEN ;ELSE MUST KEEP LOOKING TO SEE IF THIS DEF IS REALLY ONE WE WANT. + SETOM ESLAST + SETOM ESL1 + SETOM ESXPUN + JUMPGE TM,ESIGN + JRST ESLP1 + ;LOOK AT THE NEXT STE, WHILE LOOPING. +ESLP: SKIPN B,ST(D) ;GET SQUOZE IN THIS ST SLOT + JRST ESEND ;NOTHING WHERE SYM BELONGS, END SEARCH + TLZ B,740000 ;CLEAR OUT FLAGS + CAME B,SYM ;COMPARE WITH WANTED + JRST ESBAD ;NO MATCH BUT MAYBE KEEP GOING + 3GET C,D ;FOUND SYM, GET 3RDWRD + MOVEI A,(C) + CAIN A,(TM) ;DEFINED IN DESIRED BLOCK + JRST ESGOOD ; => MUST BE GOOD. +ESLP0: JUMPGE TM,ESIGN ;BLOCK SPEC'D => ALLOW NO OTHERS. + TDNE C,[3MAS,,-1] ;IF IN INITIAL SYMS BLK, NO MORE DEFS, + JRST ESLP1 + SKIPGE ESL1 ;AND NO PREVIOUS DEFS, + JRST ESGOOD ;UNREDEFINED INITL SYM MUST BE GOOD. +ESLP1: HLRZ B,BKTAB+1(C) ;GET LEVEL OF BLOCK DEF. IS IN. + CAMN A,BKPDL(B) ;SAME AS BLOCK WE'RE IN AT THAT LEVEL? + CAMLE B,BKLVL ;AND NOT A BLOCK WE'VE EXITED + JRST ESIGN + CAMG B,ESL1 ;OR HIGHER LEVEL THAN PREVIOUS BEST + JRST ESIGN + MOVEM C,ESL2 ;REPLACE BEST'S 3RDWRD, LEVEL, ADDR. + MOVEM B,ESL1 + MOVEM D,SADR +ESIGN: HRRZM D,ESLAST ;THIS ENTRY LAST SEEN WITH THIS NAME. + TLNN C,3MAS ;MORE STE'S FOR THIS SYM => + JRST ESEND1 + JRST ESNXT ;KEEP LOOKING. + +;COME HERE IF 1ST SYM SEEN ISN'T THE SAME NAME. SET UP TO LOOP. +ESBAD0: MOVN TT,SYMLEN + SETOM ESLAST + SETOM ESL1 + SETOB C,ESXPUN +;HERE WHILE LOOPING WHEN SYM WITH WRONG NAME IS SEEN. +ESBAD: JUMPN B,ESNXT + SKIPGE A,ESXPUN ;IF THIS IS 1ST EXPUNGED ENTRY SEEN + MOVEM D,ESXPUN ;REMEMBER IT FOR DEFINITION. + SKIPGE A + HRROS ESLAST ;AND SET OLD ENTRY'S 3MAS. +ESNXT: ADD D,WPSTE + CAML D,SYMSIZ ;AT END => GO TO BEGINNING + MOVEI D,0 + AOJN TT,ESLP + JRST ESEND1 ;NOT FOUND. + ESEND0: MOVEI C,(TM) ;COME HERE IF 1ST PLACE LOOKED AT SHOWS THE SYM ISN'T DEFINED + MOVEM D,ESXPUN + POPJ P, + +ESEND: SKIPGE A,ESXPUN ;FREE ENTRY CAN BE USED TO DEFINE. + MOVEM D,ESXPUN + SKIPGE A + HRROS ESLAST +ESEND1: SKIPGE ESL1 ;NOT FOUND => FIND PLACE TO DEFINE IT. + JRST DEFCH1 + MOVE D,SADR ;IDX OF BEST FOUND. + TRNN FF,FRNPSS + JRST ES1PS ;1-PASS, SPECIAL CHECK. + MOVE C,ESL2 ;GET BEST'S 3RDWRD. +ESGOOD: LDB A,[400400,,ST(D)] ;GET SQUOZE FLAGS IN A. +ES1POK: MOVE B,ST+1(D) ;VALUE OF SYM. IN B. + ;D HAS IDX OF 1STWRD IN SYM TAB. + ;C HAS 3RDWRD +POPJ1: AOS (P) +CPOPJ: POPJ P, + +;ESDCHK THEN DEFCHK IS SAME AS CALLING ESDEF. +;WE ASSUME THAT D AND TT ARE STILL SET UP FROM A CALL TO ESDCHK. +DEFCHK: SKIPGE ESL1 ;IF WE DIDN'T TAKE TIME TO SET ESLAST BEFORE, + HRRZM D,ESLAST ;DO IT NOW. (SEE BEFORE ESLP1) + JRST DEFCH1 + +ES1PS: LDB A,[400400,,ST(D)] ;1PASS & FOUND IN CONTAINING BLOCK: + MOVE C,ESL2 + TRNN C,-1 ;INITIAL SYM, OK; + JRST ES1POK + CAIE A,1 ;PSEUDO OR MACRO + TLNE C,3DOWN ;OR .DOWN'D SYMBOL OK; + JRST ES1POK ;ELSE GET NEW STE TO DEF. +DEFCH1: MOVEI C,(TM) ;INITIALIZE NEW 3RDWRD WITH BLOCK TO DEF IN. + SKIPL D,ESXPUN ;IF FOUND EXPUNGED OR FREE ENTRY, USE IT. + JRST DEFCH2 + SKIPGE D,ESLAST ;ELSE LOOK FOR ONE. + ETF ERRSCE +DEFCH4: MOVE B,ST(D) + TLZ B,740000 + JUMPE B,DEFCH3 ;MUST RETURN 0 IN B IF DON'T SKIP. + ADD D,WPSTE + CAML D,SYMSIZ + MOVEI D,0 + AOJL TT,DEFCH4 ;ASSUME TT LEFT AROUND FROM ES. + ETF ERRSCE +ERRSCE: ASCIZ /Symbol table full/ + +;ESLAST HAS -1 IF NO ENTRY SEEN; ELSE +;RH HAS IDX OF LAST SEEN, SIGN SET IF SEEN BEFORE PLACE TO DEFINE. +DEFCH3: MOVEM D,ESXPUN ;REMEMBER ADDR WHERE CAN DEFINE + HRROS ESLAST ;LAST PLACE SEEN MUST BE EARLIER. +DEFCH2: SKIPL A,ESLAST + JRST DEFCH5 ;LAST PLACE SEEN WAS SEEN AFTER PLACE TO DEFINE. + CAMN A,[-1] + POPJ P, ;REALLY NEVER SEEN. + MOVSI TM,3MAS + IORM TM,ST+2(A) ;PLACE SEEN IS EARLIER, SET ITS 3MAS. + POPJ P, + +DEFCH5: TLO C,3MAS ;PLACE TO DEF BEFORE EXISTING STES. + POPJ P, + ;ENTER A SYM IN SYMBOL TABLE + ;B HAS VALUE + ;C HAS 3RDWRD + ;D HAS INDEX INTO ST (PROBABLY SET UP BY ES) + ;T HAS SQUOZE FLAGS (ONLY) IN PLACE FOR IOR OF SQUOZE + ;SYM HAS SQUOZE, FLAGS OF WHICH ARE IGNORED + +VSM2LV: TLOA C,3LLV ;ENTRY FOR LINKING LOADER MUST SUPPLY VALUE +VSM2W: MOVE B,WRD ;ENTRY TO ENTER VALUE OF WRD STEAD B +VSM2: MOVE CH1,SYM + TLZ CH1,740000 + IOR CH1,T ;CH1 := SQUOZE WITH FLAGS + MOVEM CH1,ST(D) ;STORE SQUOZE + MOVEM B,ST+1(D) ;STORE VALUE +VSM3A: 3PUT C,D ;STORE 3RDWRD + POPJ P, + +;RETURN THE NUMBER OF SYMTAB SLOTS IN USE. +A.SYMCN:MOVE D,SYMAOB + SETZ A, +A.SYC1: MOVE B,ST(D) + TLZ B,740000 + SKIPE B + AOS A + ADD D,WPSTE1 + AOBJN D,A.SYC1 + JRST CLBPOP + ;;EQUAL ;EQUAL SIGN ENCOUNTERED, DO PARAMETER ASSIGNMENT + +EQUAL: TLZ FF,FLHKIL + PUSHJ P,RCH + CAIE A,"= ;DECIDE WHETHER TO HALF-KILL THE SYM. + TLOA FF,FLUNRD + TLO FF,FLHKIL + SETZM LABELF + CALL RCH + CAIE A,": ;DECIDE WHETHER TO MARK SYM AS NOT REDEFINABLE. + TLOA FF,FLUNRD + SETOM LABELF + CAMN SYM,[SQUOZE 0,.] ;.=FOO, SAME AS LOC FOO + JRST PTEQ + TDNN I,[ILWORD,,IROP+IRNOEQ] + TRNN I,IRLET + ETR [ASCIZ/= With bad format or bad context/] + PUSH P,SYM + PUSH P,ESBK + PUSH P,I + MOVEI A,[ETSM [ASCIZ/Undefined in =/]] + MOVEM A,GTVER + TRO I,IRNOEQ+IRDEF+IREQL + PUSHJ P,GETWRD + TRNN I,IRDEF + JRST ASEM1A ;UNDEFINED SYMS IN VALUE, IGNORE +IFN LISTSW,[ + SKIPN LSTONP + JRST EQUAL1 ;NOT LISTING. + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE SYM,WRD + MOVEM SYM,LISTWD + MOVE SYM,WRDRLC + MOVEM SYM,LSTRLC + SETOM LISTAD + SETOM LISTPF +EQUAL1: +] ;END IFN LISTSW, + TDZ I,[-1-(ILMWRD)] + IOR I,(P) + TLZ FF,FLUNRD + POP P,(P) + POP P,ESBK + POP P,SYM + MOVE A,WRDRLC ;GET RELOCATION + TDNN A,[-2,,-2] ;SKIP ON NON-STANDARD RELOCATION BITS + SKIPE LDCCC + JRST EQG1 ;STRANGE RELOCATION OR IN LOAD TIME CONDITIONALS => HAND PROBLEM TO LOADER + MOVE A,GLSP1 + CAMN A,GLSP2 + JRST EQL1 ;NO GLOBALS IN DEFINITION +;FALLS THROUGH. + ;FALLS THROUGH. +;GLOBALS TO RIGHT OF = OR WITHIN LOADER CONDIT. +EQG1: IFN CREFSW, XCT CRFLBL ;CREF DEF. OF NORMAL SYM, + SKIPGE CONTRL + JUMPL FF,[ETASM [ASCIZ /Externals in =/]] + CALL ESDCHK ;SEARCH SYM TAB. + JRST EQL2 ;NOT FOUND IN CURRENT OR CONTAINING BLKS. + HRRZI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQG1A + XCT EQG1TB(A) ;FOUND IN DESIRED BLOCK. + JRST ASSEM1 + +EQG1A: JUMPN T,EQG2 + CAIN A,PSUDO_-16 ;FOUND AS INITIAL PSEUDO => ERROR. + ETSM ERRQPA +EQG2: CALL DEFCHK ;FIND FREE STE TO DEFINE IN DESIRED BLOCK. + JRST EQL2 ;PRETEND WASN'T FOUND. + +ERRQPA: ASCIZ /Shadowing a pseudo-op/ +ERRIPA: ASCIZ /Illegal =/ + +EQG1TB: ETSM ERRIPA ;COMMON + ETSM ERRIPA ;PSEUDO OR MACRO + JRST EQL2 ;SYM + JRST EQGUL ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL7 ;GLO ENTRY + JRST EQL8 ;GLO EXIT + +EQL8: PUSHJ P,GLKPNR + TLZ C,3LABEL\3MULTI +EQL7: MOVSI T,GLOETY ;GLOBAL PARA ASSIGN + MOVEI B,0 + TLO SYM,40000 +LOPRA1: PUSH P,CASM1A ;RETURN TO ASSEM1A AFTER FOLLOWING. + TLNE C,3MULTI + ETSM ERRMDT + SKIPE LABELF + TLO C,3LABEL + TLNE FF,FLHKIL + TLOA SYM,400000 ;SET FLAG TO HALF-KILL SYM + TLZA C,3SKILL + TLO C,3SKILL ;SET CORRESPONDING FLAG IN 3RDWRD + PUSHJ P,VSM2LV + JUMPGE FF,CPOPJ ;JUMP ON NOT PUNCHING PASS + TRNN I,IREQL ;IF CAME FROM COLON ROUTINE, + JRST PDEFPT ;PUNCH "DEFINE SYM AS $.". + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D ;STORE UPDATED 3RDWRD + PUSHJ P,EBLK + MOVEI TT,LGPA + DPB TT,[310700,,BKBUF] + PUSHJ P,OUTSM0 + PUSHJ P,PWRDA + JRST EBLK + +EQGUL: PUSHJ P,LKPNRO ;LOCAL UNDEF, OUTPUT LINK REQUEST. + TLZ C,3LABEL\3MULTI ;CAN'T DETECT MDT'S WHEN ONLY STINK KNOWS FOR SURE. +EQL2: TLNE I,ILGLI + JRST EQL7 ;MAKE IT GLOBAL + MOVSI T,LCUDF ;LOCAL UNDEFINED + JRST LOPRA1 + +CASM1A: JRST ASEM1A + ;MAYBE PUNCH OUT LINK REQUEST +;SYM HAS NAME OF SYM TO REQUEST, D STE IDX OF SYM, C 3RDWRD, B ADR OF REQUEST +;REQUEST WILL BE PUNCHED IF 3RLNK SET IN C OR IF ANYTHING SET IN LH(B) + +GLKPNR: TLO SYM,40000 ;GLO BIT +LKPNRO: TLNN C,3RLNK + TLNE B,-1 + TROA I,IRCONT + POPJ P, ;DON'T PUNCH REQUEST + MOVE A,CONTRL + TRNE A,DECREL + JRST LKPNDR ;DIFFERENT WAY TO OUTPUT THIS INFO IN DECREL FMT + MOVEI A,6 + PUSHJ P,PBITS + PUSHJ P,OUTSM0 ;PUNCH SYM + HLRZ A,B + TLZE C,3RLNK ;RELOC OF LINK PNR + TLO A,100000 + HRRZS B ;CLEAR OUT LH OF B + TRZ I,IRCONT ;OK TO END BLOCK NOW + JRST $OUTPT ;PUNCH OUT A AND RETURN + +LKPNDR: MOVSI A,DECINT ;WRITE AN "INTERNAL REQUEST" WITH ONE DATA WORD. + CALL DECBLK + SETZ TM, ;COMPUTE RELOC OF ADDRESS AND DATA IN TM. + TLNE C,3RLNK + TRO TM,2 + SKIPE WRDRLC + TRO TM,1 + MOVE A,WRD ;ADDRESS TO LINK,,DATA + HRL A,B + CALL DECWR1 + JRST EBLK + +;THESE ASSUME STE IDX IN D, SQUOZE W/ FLAGS IN SYM. +;C HAS 3RDWRD, B OR WRD HAS VALUE TO DEF. WITH. +;CALL ONLY IN RELOCATABLE ASSEMBLY. +OUTDE2: MOVEM B,WRD +OUTDE1: TLNE FF,FLPPSS + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D + SKIPGE CONTRL + RET + TRO I,IRCONT + SETZ A, + TLNN C,3LABEL ;WHAT KIND OF DEFINITION DEPENDS ON WHETHER SYM IS REDEFINABLE. + MOVEI A,CRDF + CALL P7X ;PUNCH OUT CODE BITS + PUSHJ P,GTVL7B ;SET RELOCATION BITS IN SQUOZE + PUSHJ P,OUTSM0 + TRZ I,IRCONT + JRST OUTWD ;OUTPUT VALUE + +;PUNCH OUT LOCAL-GLOBAL RECOVERY BITS AND SYM +;I.E. TELL LOADER THAT SQUOZE IN SYM, FORMERLY CONSIDERED LOCAL, IS REALLY GLOBAL +PLOGLO: SKIPGE CONTRL + RET + PUSH P,A + PUSHJ P,PBITS7 + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY THIS IS NEW STYLE RQ, + PUSHJ P,OUTSM0 ;PUNCH "OLD NAME" = SYMTAB IDX, + TLC SYM,440000 ;SAY MAKE GLOBAL, OUTPUT ACTUAL NAME OF SYM. + PUSHJ P,OUTSM + JRST POPAJ + ;NO GLOBALS TO RIGHT OF EQUAL SIGN + +EQL1: PUSHJ P,ESDCHK + JRST EQL1A ;NOT FOUND +IFN CREFSW,XCT CRFEQL ;DEF. OCCUR. OF NORMAL SYM. OR INTSYM. + MOVEI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQL1F + SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL + XCT EQL1TB(A) ;FOUND IN DESIRED BLOCK => NOW REDEFINE. + JRST ASSEM1 + +EQL1F: JUMPN T,EQL10 + CAIE A,PSUDO_-16 + JRST EQL10 + MOVEI T,(B) ;FOUND AS PSEUDO IN INITIAL SYMS BLOCK, + CAIN T,INTSYM ;SPECIAL WAY TO REDEFINE IF LIKE .MLLIT, ETC. + JRST EQLINT + ETSM ERRQPA ;SHADOWING AN INITIAL PSEUDO, TELL USER. +EQL10: CALL DEFCHK ;FOUND IN OUTER BLOCK, GET NEW STE, + JRST EQL1A ;DEFINE THERE AS IF NOT FOUND. + +EQL1TB: ETSM ERRIPA ;COMMON + JRST EQL1B2 ;PSEUDO OR MACRO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL1D ;GLO ENTRY + JRST EQL1E ;GLO EXIT + +EQL1E: PUSHJ P,GLKPNR ;DUMP LINKING POINTER + CAIA +EQL1D: CALL MDTCHK + PUSHJ P,RCHKT ;GLO ENTRY +EQLB2: PUSHJ P,RMOVET + TLNE FF,FLHKIL + TLOA SYM,400000 + TLZA C,3SKILL + TLO C,3SKILL + HRLZI T,GLOETY + SKIPE LDCCC ;IF IN LOADER CONDITIONAL, + TLO C,3LLV ;THEN LOADER MUST SUPPLY VALUE + PUSHJ P,VSM2W ;DEFINE SYM + TLO SYM,40000 ;SET GLOBAL BIT IN SQUOZE +EQL1CE: JUMPGE FF,ASEM1A + PUSHJ P,OUTDE1 +ASEM1A: TLNE I,ILMWRD + PUSHJ P,IGTXT + JRST ASSEM1 + +;CHECK WHETHER DEFINING AN MDT, OR REDEFINING A LABEL (=> THIS IS AN MDT) +MDTCHK: TLNN C,3LABEL + JRST MDTCH1 + CALL GVSYM0 ;MOVE VALUE OF SYM TO A, GET RELOC (WRDRLC STYLE) IN B + CAMN A,WRD + CAME B,WRDRLC ;IF WE'RE CHANGING THE VALUE, MARK SYM AS MDT +MDTCHL: TLO C,3MULTI +MDTCH1: TLNE C,3MULTI ;EVER ASSIGNING TO MDT, EVEN SAME VALUE, GIVES ERR MSG + ETSM ERRMDT + RET + EQL1C: TLNE I,ILGLI + JRST EQL1CA ;MAKE GLOBAL + PUSH P,C + PUSHJ P,LKPNRO ;MAYBE OUTPUT LINK REQUEST + PUSHJ P,RCHKT + PUSHJ P,RMOVET ;INITIALIZE 3RDWRD + MOVSI T,SYMC ;SYM + PUSHJ P,EQA2A ;ENTER DEF IN SYMTAB + TLNE C,3SKILL + TLO SYM,400000 + POP P,AA + TLNE AA,3VCNT ;USED IN CONSTANT + PUSHJ P,CONBUG + JRST EQL1CE + + ;PUNCH OUT CODE BIT PAIR, FIRST OF WHICH IS 7 + +P7X: MOVEM A,PARBIT ;ENTRY FOR SECOND BYTE IN A +P70: PUSHJ P,PBITS7 ;ENTRY FOR SECOND BITE IN PARBIT, PUNCH OUT THE 7 + SKIPA A,PARBIT ;GET SECOND BYTE BACK +PBITS7: MOVEI A,7 ;ENTRY TO JUST PUNCH OUT 7 + JRST PBITS + +EQL1CA: PUSHJ P,PLOGLO + JRST EQL1E +EQA2: PUSH P,CASM1A +EQA2A: TLNE FF,FLHKIL + TLO C,3SKILL + JRST VSM2W + +EQL1B2: HRRZ A,B ;ATTEMPT TO ASSIGN PSEUDO-OP, IS IT AN INTSYM? + CAIN A,INTSYM + JRST EQLINT ;YES, GO SET WD IT POINTS TO. + ETSM [ASCIZ /Pseudo or macro ='D/] +EQL1B: CALL MDTCHK + PUSHJ P,RCHKT + TLNE I,ILGLI + JRST EQLB2 ;WAS LOCAL, MAKE IT GLOBAL + ;WAS LOCAL, LEAVE IT LOCAL + PUSHJ P,RMOVET ;PUT RELOCATION BITS IN BITS 0 AND 1 OF C (I.E. START SETTING UP 3RDWRD) + MOVSI T,SYMC ;SYM + JRST EQA2 + +EQL1A1: PUSHJ P,RCHKT + PUSHJ P,RMOVET + HRLZI T,SYMC + JRST EQA2 + +EQL1A: SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL +IFN CREFSW,XCT CRFLBL ;DEF. OCCUR. OF NORMAL SYM. + TLNN I,ILGLI + JRST EQL1A1 + JRST EQL1E + +EQLINT: HLRZS B ;GET ADDR OF WD HOLDING VALUE. + MOVEMM (B),WRD ;PUT NEW VALUE IN IT. + JRST ASEM1A + ;;. ;ROUTINES DEALING WITH THE CURRENT LOCATION AND OFFSET + +VBLK +CLOC: 0 ;PUNCHING LOC +CRLOC: 0 ;PUNCHING RELOC +OFLOC: 0 ;OFSET VAL +OFRLOC: 0 ;OFSET RELOC +;VAL OF PT=CLOC+OFLOC,CRLOC+OFLOC +SYLOC: 0 ;VAL OF LAST TAG +SYSYM: 0 ;LAST TAG +SYLOC1: 0 ;VALUE OF NEXT TO LAST TAG +SYSYM1: 0 ;NEXT TO LAST TAG +GLOCTP: 0 ;4.9 => CURRENT LOCATION GLOBAL, 2.9 => OFFSET GLOBAL + ;FRGLOL (FLAG IN FF) IS IOR OF BITS 4.9 AND 2.9 OF GLOCTP + ;EXCEPT AFTER .=NON-GLOBAL WITH GLOBAL OFFSET + ;OTHER BITS USED ONLY WHEN IN LINK (NEVER SET IN GLOCTP): + ;400 => ARG GLOBAL +PBLK + + + ;POINT (.) AS PSEUDO-OP + +GTVLP: TRNE FF,FRGLOL + JRST GTVLP2 ;LOCATION GLOBAL + MOVE B,OFRLOC ;GET RELOCATION OF OFFSET + ADD B,CRLOC ;ADD CURRENT RELOCATION + MOVE A,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 ;IF IN BYTE MODE, + HLL A,BYTWP ;SET LEFT HALF TO BYTE POINTER LEFT HALF FOR ILDB + ADD A,OFLOC ;NOW ADD OFFSET + TLZ I,ILFLO+ILDECP+IRPERI ;CLEAR OUT FLAGS SET WHEN LOOKED LIKE FLOATING POINT NUMBER + POPJ P, + + +GTVLP2: MOVEI T,$.H ;LOCATION GLOBAL + AOS GLSP1 + HRRZM T,@GLSP1 ;PUT $. ON GLOBAL LIST (INCLUDES OFFSET, WHETHER GLOBAL OR NOT) + SKIPL BYTM1 ;IN BYTE MODE? + TDZA A,A ;NO, CLEAR ABS PART OF VALUE + HLLZ A,BYTWP ;YES, USE LH(BP) AS ABS PART + JRST CLBPOP + +$.H: (GLOETY)+SQUOZE 0,$. ;CURRENT LOCATION + OFFSET IN LOADER +$L.H: (GLOETY)+SQUOZE 0,$L. ;LOCATION BEING LOADED INTO BY LOADER, USED BY ABLOCK +$O.H: (GLOETY)+SQUOZE 0,$O. ;LOADER OFFSET +$R.H: (GLOEXT)+SQUOZE 0,$R. ;RELOCATION AS GLOBAL + COLON: TRNE I,IRLET + TRNN I,IRSYL + ETA [ASCIZ/Colon without preceding symbol/] + TLNN I,ILWORD + TRNE I,IROP+IRPSUD+IREQL+IRNOEQ + ETSM [ASCIZ/Label inside an expression/] + SKIPE ASMOUT + ETSM [ASCIZ /Label inside <>, () or []/] + TLZ FF,FLHKIL + PUSHJ P,RCH ;GET NEXT CHAR + CAIN A,": ;IF NEXT CHAR ANOTHER COLON, + TLOA FF,FLHKIL ;THEN SET FLAG TO HALF-KILL + TLO FF,FLUNRD ;NOT COLON, CAUSE IT TO BE RE-INPUT + SKIPE HKALL ;CHECK FOR HALF-KILL-ALL-LABELS MODE. + TLO FF,FLHKIL + MOVE T,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 + HLL T,BYTWP ;BYTE MODE, SET LEFT HALF OF VALUE TO LEFT HALF OF BYTE POINTER + ADD T,OFLOC ;ADD OFFSET + MOVEM T,WRD ;STORE RESULT AWAY FOR POSSIBLE PUNCHOUT + EXCH T,SYLOC ;NOW SET UP STUFF FOR ERROR PRINTOUT + MOVEM T,SYLOC1 + EXCH SYM,SYSYM + MOVEM SYM,SYSYM1 + MOVE SYM,SYSYM + MOVE A,CRLOC ;SET UP RELOCATION + ADD A,OFRLOC + MOVEM A,WRDRLC + SETOM LABELF ;SET FLAG CAUSING 3LABEL (DON'T REDEFINE) TO BE SET. + SKIPN LDCCC + TRNE FF,FRGLOL + JRST GCOL1 ;LOCATION VIRTUAL OR IN LOAD TIME CONDITIONAL + PUSHJ P,ESDCHK ;TRY FINDING CURRENT ENTRY IN ST + JRST EQL1A ;NOT ALREADY DEFINED +IFN CREFSW,XCT CRFLBL +COLON1: MOVEI T,(C) ;BKTAB IDX OF BLOCK FOUND IN, + CAIE T,(TM) ;FOUND IN DESIRED BLOCK => TRY REDEFINING. + JRST COLON3 + TLO C,3LABEL ;CAUSE REDEFINING SYMBOL TO BARF + XCT COLON2(A) ;BUT MAYBE PRINT ERR MSG FIRST. + JRST EQL1B + +CASSM1: JRST ASSEM1 + +COLON3: JUMPN T,EQL10 ;NOT INITIAL SYM => CAN SHADOW, + CAIN A,SYMC_-14. ;INITIAL SYM => CAN SHADOW IF IT'S AN ORDINARY LOCAL SYM + CAME B,WRD ;AND NEW VALUE SAME AS OLD VALUE. + CAIA + SKIPE WRDRLC + ETSM ERRRES ;ELSE GIVE ERROR MESSAGE BEFORE SHADOWING, TO WARN USER. + JRST EQL10 + +ERRRES: ASCIZ /Pseudo, macro or initial sym as label/ +ERRMDT: ASCIZ /Multiply defined/ + +COLON2: TLO C,3MULTI ;COMMON + ETSM ERRRES ;MACRO OR PSEUDO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI ;SETTING 3MULTI CAUSES EQL1B TO PRINT AN MDT ERROR. + JRST EQL1D ;GLOBAL ENTRY + JRST EQL1E ;GLO EXIT + ;COLON WHEN LOCATION VIRTUAL, OR IN LOAD TIME CONDITIONAL + +GCOL1: IFN CREFSW,XCT CRFLBL ;DEFINING ORDINARY SYM. + SKIPGE CONTRL + ETASM [ASCIZ /Virtual label in abs assembly/] + PUSHJ P,ESDCHK ;FIND ITS SLOT IN ST + JRST EQL2 ;JUST LIKE EQG1 EXCEPT FOR ERROR MESSAGES. + MOVEI T,(C) + CAIE T,(TM) + JRST COLON5 + XCT GCOL1T(A) ;FOUND IN DESIRED BLOCK, REDEFINING. + JRST EQL2 + +COLON5: JUMPN T,EQG2 ;SHADOWING, OK UNLESS INITIAL SYM. + ETSM ERRRES + JRST EQG2 + +GCOL1T: TLO C,3MULTI ;COMMON + ETSM ERRRES ;PSEUDO. + JRST EQL2 ;SYM. + JRST EQGUL ;LOCAL UNDEF. + TLO C,3MULTI ;VAR + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + JRST EQL7 ;DEF GLO + JRST EQL8 ;UNDEF GLO. + + + ;PUNCH OUT "DEFINE SYM AS $." + +PDEFPT: MOVEI A,CDEFPT + PUSHJ P,P7X ;OUTPUT 7 THEN PDEFPT + JRST OUTSM0 ;OUTPUT SYM, WITHOUT BITS + ;LOC, BLOCK, .= + +ALOC: PUSHJ P,ALOCRG ;LOC, GET ARG +ALOC1: SETZM SYLOC ;CLEAR OUT LOC OF LAST TAG + SETZM SYSYM ;CLEAR OUT LAST TAG SO ERROR MESSAGES DON'T PRINT OBSCENE INCREMENTS +IFN FASLP,[ + SKIPGE TM,CONTRL + TRNN TM,FASL + JRST .+2 + ETA [ASCIZ /LOC illegal in FASL assembly/] +] + TRZE LINK,400 ;GLOBALS IN ARG? + JRST ALOC2 ;YES + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF CURRENT LOCATION + CALL SLOCF ;RE-INIT NEXT OUTPUT BLOCK'S HEADER; SET LOCF. + MOVEI A,LCEGLO ;=> RESET GLOBAL RELOCATION (BACK TO ORIGINAL NON-GLOBAL RELOCATION) + TLZE LINK,400000 ;IS CURRENT LOCATION NOW GLOBAL? + PUSHJ P,PLDCM ;YES, RESET IT + MOVE B,WRDRLC ;GET BACK NEW RELOCATION +ALOC2B: TRZE B,-2 ;NO BITS ALLOWED EXCEPT LOW ORDER + ETR [ASCIZ *Illegal relocation in LOC/BLOCK/.=*] + HRRZM B,CRLOC ;STORE NEW RELOCATION + SKIPGE CONTRL + JRST ASSEM1 ;DON'T BOTHER WITH REST IF ABS. + MOVEI B,2(B) ;LABS OR LREL + DPB B,[310700,,BKBUF] ;STORE NEW BLOCK TYPE + MOVEM B,CDATBC ;ALSO STORE AS NORMAL BLOCK TYPE +AOFSTX: TDNN LINK,[SETZ(SETZ)] ;ENTRY FROM AOFFSET, SKIP IF FRGLOL SHOULD BE SET + TRZA FF,FRGLOL ;CURRENT LOCATION PLUS OFFSET NOT GLOBAL, CLEAR FLAG + TRO FF,FRGLOL ;GLOBAL, SET FLAG + TRZ LINK,600 ;CLEAR OUT TEMPORARY FLAGS SO WON'T GET STORED IN GLOCTP + MOVEM LINK,GLOCTP ;STORE BACK STATUS FLAGS + JRST ASSEM1 + +PTEQ: MOVE SYM,[SQUOZE 0,LOC] + PUSHJ P,ALOCRG ;.=, GET ARG + MOVE T,[MINF+HFWDF,,$O.H] ;GLOTB ENTRY IF .+1 DOESN'T SKIP + TRNE LINK,400000 ;OFFSET GLOBAL? + JRST PTEQ2 ;YES, WANT TO DO LOC ARG-$O." + PUSHJ P,SBWDOF ;OFFSET IS LOCAL, SUBTRACT FROM ARG + JRST ALOC1 + ABLOCK: PUSHJ P,ABLKRG ;GET ARG TO "BLOCK" PSEUDOOP. + TRNE LINK,400 ;GLOBALS IN ARG? + JRST ABLKG ;GLOBALS IN ARG + TLNE LINK,400000 + JRST ABLKG ;JUMP IF LOSER CHANGING RELOCATION WHILE CLOC GLOBAL +IFN FASLP,[ + MOVE D,CONTRL + TRNN D,FASL ;IN FASL FORMAT, CAN'T SET LOC. CTR., + JRST ABLKF1 + SKIPE B + ETA [ASCIZ /BLOCK size relocatable/] + JUMPGE FF,ABLKF1 + CALL ABLKF ;SO ON PASS 2 OUTPUT A BUNCH OF ZEROS. + JRST ABLKF1 + +;OUTPUT C(A) ZEROS, IN FASL FORMAT. NO-OP ON PASS 1. DOESN'T SET THE LOCATION COUNTER. +ABLKF: JUMPE A,CPOPJ + JUMPGE FF,CPOPJ + SETZM WRD + SETZM WRDRLC + SAVE A + SAVE A +ABLKF2: CALL FASPW + MOVEMM GLSP2,GLSP1 + SOSE (P) + JRST ABLKF2 + JRST POPBAJ +] + +ABLKF1: ADD A,CLOC ;ARG TO BLOCK IS LOCAL, ADD DIRECTLY TO CLOC + ADD B,CRLOC ;ALSO ADD RELOCATIONS + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF LOCATION + CALL SLOCF ;FALL INTO ALOC ROUTINE, MAKING SURE FRLOC GETS SET + JRST ALOC2B + + +SBWDOF: SUB A,OFLOC ;SUBTRACT OFFSET FROM WRD, ETC. IN A,B + HRRZM A,WRD ;MAKE SURE RESULT GETS STORED IN WRD, AS WELL AS AC'S + SUB B,OFRLOC ;NOW DO RELOCATIONS + HRRZM B,WRDRLC + POPJ P, + +ABLKG: TRNE LINK,400000 ;GLOBAL BLOCK, IS OFFSET GLOBAL? + JRST ABLKG2 ;YES, OK TO REFERENCE $L. + PUSHJ P,SBWDOF ;NO, FOR COMPATIBILITY, DON'T REFERENCE $L. + SKIPA T,[HFWDF,,$.H] +ABLKG2: MOVE T,[HFWDF,,$L.H] +PTEQ2: AOS GLSP1 ;STORE T IN GLOTB + MOVEM T,@GLSP1 +ALOC2: TLO LINK,400000 ;SET GLOBAL LOCATION FLAG + MOVEI A,LCGLO ;=> GLOBAL LOCATION ASSIGNMENT + PUSHJ P,PLDCM ;PUNCH OUT GLOBAL LOCATION ASSIGNMENT + SETZM CLOC ;CLEAR OUT CLOC, NEW RELOCATION NOW + SETZB B,BKBUF ;ALSO CLEAR OUT HEADER, JUST TO BE SURE + AOJA B,ALOC2B ;SET RELOCATION TO 1 AND FALL IN + +AOFFSET: PUSHJ P,AOFFS2 ;OFFSET, GET ARG + MOVE A,T + MOVEM A,WRD ;RESTORE UNTRUNCATED ARG. + TRZE LINK,400 ;GLOBALS IN ARG? + TROA LINK,400000 ;GLOBALS IN ARG, SET GLOBAL OFFSET FLAG + TRZ LINK,400000 ;NO GLOBALS IN ARG + MOVEM A,OFLOC ;STORE NEW OFFSET + MOVEM B,OFRLOC ;ALSO STORE RELOCATION BITS + SKIPGE CONTRL ;IN RELOCATABLE, + JRST AOFSTX + MOVEI A,LDOFS ;LOADER OFFSET LOADER COMMAND TYPE + PUSHJ P,PLDCM ;PUNCH OUT LOADER COMMAND + JRST AOFSTX + ;GET ARG TO LOC, BLOCK, .=, OFFSET + +ALOCRG: +ABLKRG: MOVE A,CLOC + SKIPN CRLOC + JRST [ CAML A,DECBRA ;IF ADDR BEFORE THE LOC WAS ABS, + MOVEM A,DECBRA ;UPDATE HIGHEST ABS ADDR IF NEC. + JRST ABLKR1] + CAML A,DECTWO ;IT WAS RELOCA; UPDATE HIGHEST + JRST [ CAML A,DECBRH ;ADDR OF APPROPRIATE SEG. + MOVEM A,DECBRH + JRST ABLKR1] + CAML A,DECBRK + MOVEM A,DECBRK +AOFFS2: +ABLKR1: SAVE SYM + PUSHJ P,CONBAD ;ERROR IF IN GROUPING + REST SYM + TRNE I,IRNOEQ\IRPSUD\IREQL + ETSM [ASCIZ /Inside pseudo or =/] + TDNE I,[ILWORD,,IRFLD] + ETSM ERRNVL + PUSHJ P,EBLK ;MAYBE END CURRENT OUTPUT BLOCK + PUSHJ P,AGETWD ;GET ARG + MOVE LINK,GLOCTP ;GET GLOCTP FLAGS IN LINK, STAYS THERE UNTIL ALMOST DONE + MOVE T,GLSP2 + CAME T,GLSP1 + TROA LINK,400 ;SIGNAL GLOBAL ARG + TRZ LINK,400 ;LOCAL + MOVE T,A ;SAVE UNTRUNCATED FOR AOFFSET, + HRRZS A,WRD ;TRUNCATE FOR LOC, BLOCK, .=. + TRNN I,IRDEF ;ALL DEFINED? + JRST ASSEM1 + SKIPGE CONTRL ;YES, RETURN SKIPPING OVER ARG + TRNN LINK,400 + RET + MOVE SYM,GTVER + ETASM [ASCIZ *Argument has externals*] + ;;CONSTANTS AND VARIABLES + ;VARIABLES AREA +VBLK + +LCNGLO==CONMIN/4 +LCONTB==CONMIN + +BLCODE [ +PCNTB: BLOCK NCONS*3 ;CONSTANTS AREAS TABLE +VARTAB: BLOCK NVARS +] +CONTBA: CONTAB ;ADDRESS OF BEGINNING OF CONSTANTS TABLE. +CONTBE: CONTAB+LCONTB ;ADDRESS OF WORD AFTER END OF CONSTANTS TABLE. +PLIM: 0 ;POINTER TO FIRST UNUSED WORD IN CONSTANTS TABLE. + +CONGLA: CONGLO ;ADDRESS OF BEGINNING OF CONSTANT-GLOBALS TABLE. +CONGLE: CONGLO+LCNGLO ;ADDRESS OF WORD AFTER END OF CONSTANT GLOBALS TABLE. +CONGOL: 0 ;HAS ADR OF FIRST WORD INACTIVE IN CONSTANT-GLOBALS TABLE. + +CONBIA: CONBIT ;ADDRESS OF BEGINNING OF CONSTANT-RELOCATION-BITS TABLE. + +CONLEN: CONMIN ;TOTAL SPACE ALLOCATED TO CONSTANTS TABLES. + ;ALL THE HOOKS ARE IN FOR DYNAMIC ALLOCATION OF THESE TABLES + ;(CONTAB, CONGLO, AND CONBIT). ALL THAT IS NEEDED IS TO GET + ;THE SPACE AND INITIALIZE CONTBA, CONTBE, CONGLA, CONGLE, CONBIA. + + ;PCNTB STUFF + + ;EACH ENTRY 3 WORDS; FIRST WORD SQUOZE, NAME OF AREA IF GLOBAL +CSQZ: 0 ;SQUOZE COUNTER + ;SECOND WORD RH LOC OF AREA (WITH OFFSET), LH LOC FIRST AFTER AREA (WITHOUT OFFSET) + ;THIRD WORD LH FLAGS + +CGBAL==100000 ;GLOBAL (INCLUDING OFFSET) +CTRL==200000 ;RELOCATED ( " ) +CTDEF==400000 ;DEFINED (MUST BE SIGN) + +PBCON: 0 ;POINTER INTO PCNTB, HAS ADR OF ENTRY FOR NEXT CONSTA +PBCONL: 0 ;POINTER TO ABSOLUTE TOP OF PCNTB +CONCNT: 0 ;NUMBER OF TIMES CONSTANTS CAN APPEAR (DECREMENTED BY CONSTA) +CONDEP: 0 ;DEPTH IN CONSTANTS (0 TOP LEVEL) +CONSAD: 0 ;ADDR IN CONSTANTS TABLE OF ENTRY FOR CURRENT CONST. +CONSML: 0 ;VALUE OF .MLLIT INTSYM. + ;NEGATIVE => ERROR MODE (DEFAULT) + ;ZERO => OLD MODE. + ;POSITIVE => NEW (MULTI-LINE) MODE. + +CONSTP: 0 ;PDL POINTER BELOW WDS FOR INNERMOST CONSTANT. +CONSP1: 0 + + ;VARIABLES FOR VARIABLES CODING + +VARCNT: 0 ;NO OF VAR IN CURRENT VAR AREA SO FAR +VARPNT: 0 ;POINTER TO CURRENT PLACE IN VARTAB +VARCNR: 0 ;NO OF TIMES VARIABLES MAY APPEAR +VCLOC: 0 ;TEM FOR VARIAB +VECSIZ: 0 ;DEFAULT SIZE FOR .VECTOR. + +PBLK + ;LEFT-BRACKET ENCOUNTERED; HERE ON DISPATCH FROM GETFD +;SAVE WORLD, BYTE MODE, ASSEM1 PDL LEVELS. +;THEN SET ASSEM1 PDL LEVELS TO CURRENT LEVELS +;SO ASSEM1 WON'T FLUSH PAST LEVEL OF CONSTANT. +;SET CONSTP _ CURRENT PDL LEVEL. PCONS WILL PUT WORDS +;OF CONSTANT ABOVE CONSTP, AND SET ASSEMP ABOVE THEM. + +LBRAK: SKIPE LITSW + ETR [ASCIZ /Literal/] + TRO I,IRFLD ;LEFT BRACKET + JSP LINK,SAVWD1 ;SAVE CRUFT + PUSH P,SCNDEP ;SO THE NEXT RBRKT WON'T TRY TO CLOSE CONDIT. + JSP LINK,SAVAS1 + MOVEIM ASMOUT,3 + SETZM SCNDEP ;NOT WITHIN CONDITIONALS IN THIS LITERAL. + AOS CONDEP ;ONE DEEPER IN LITERALS. + JRST ASSEM3 ;GO ASSEMBLE THE WORDS OF THE CONSTANT. + +;OUTPUT WORD TO CONSTANT. P MUST EQUAL ASSEMP HERE. +PCONS: SKIPL CONTRL ;IF RELOCATABLE, + PUSHJ P,$RSET ;HANDLE STRANGE RELOCATIONS. + MOVE B,GLSP1 + SUB B,GLSP2 ;NUM. GLOBAL ENTRIES FOR THIS WD. + HLRZ A,WRDRLC ;ONLY 1.1 AND 3.1 BITS MATTER. + LSH A,1 + IOR A,WRDRLC ;GET THEM INTO 1.1, 1.2 BITS. + TLNE I,ILNOPT ;REMEMBER ILNOPT ALSO. + IORI A,4 + DPB B,[032200,,A] ;AND # GLBLS. + PUSH P,A ;SAVE THEM ALL. + HRLI B,(B) ;GET # GLBLS,,# GLBLS . + JUMPE B,PCONS1 + MOVE A,GLSP2 + MOVSI A,1(A) + HRRI A,1(P) ;SAVE THE GLBLS, IF ANY. + ADD P,B + JUMPGE P,CONFLP + BLT A,(P) +PCONS1: PUSH P,WRD + MOVEM P,ASSEMP ;ASSEMP -> ABOVE WDS FOR LIT.; CONSTP, BELOW. + JRST (T) + ;JSP LINK,SAVAS1 TO PUSH DATA ON ASSEM1 LEVEL AND CALL ASSEM1 +;LOOP RECURSIVELY. +.SEE CONNDP ;WHICH IS WHERE THESE THINGS ARE POPPED. +SAVAS1: SKIPN BYTM ;IF IN BYTM NOW (WILL PUSH AND TURN OFF) + JRST LBRAK1 + MOVSI A,BYBYT ;SAVE ALL THE DETAILS. + HRRI A,1(P) + ADD P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] + JUMPGE P,CONFLP ;(SOFTWARE-DETECTED PDL-OV) + BLT A,-BYTMCL(P) + MOVSI A,BYTMC + HRRI A,1-BYTMCL(P) + BLT A,(P) +LBRAK1: PUSH P,BYTM + SETZM BYTM + SAVE ASMOUT + SAVE ASMDSP + SAVE ASMI + PUSH P,GLSPAS ;SAVE ASSEM1 PDL LEVELS. + PUSH P,ASSEMP + PUSH P,CONSTP + MOVE A,I + ANDI A,IRPSUD+IREQL + IORI A,IRDEF + MOVEM A,ASMI ;ASMI IOR'D INTO I AT ASSEM2 LOOP. + HRRZ A,CPGN + HRL A,CLNN ;REMEMBER WHERE THIS LITERAL STARTS. + INSIRP PUSH P,[A SYSYM SYLOC] + MOVEM P,ASSEMP ;SO ASSEM1 WON'T FLUSH WHAT WE PUSHED. + MOVEM P,CONSTP ;SO CONND CAN FIND 1ST WD OF CONSTANT. + MOVEMM GLSPAS,GLSP1 +SAVAS2: MOVEI A,ASSEM3 ;IF NOT MULTI-LINE MODE, ARRANGE TO + SKIPG CONSML ;END THE CONSTANT AFTER 1 WORD. + MOVEI A,ASSEMC + MOVEM A,ASMDSP + JRST (LINK) + PCONST: MOVE CH1,ASMDSP ;OUTPUT TO CONST. FROM ASSEM1 + CAIN CH1,CONND ;LAST WD OF CONST? + CAME P,CONSTP ;1ST WD? + JRST PCONS ;NO, DO THE GENERAL THING. + SKIPL CONTRL ;THIS MUST BE ONLY WORD OF CONST, + PUSHJ P,$RSET ;DON'T BOTHER PUSHING, END CONST. NOW. + PUSH P,CONSTP + TLZ I,ILMWRD+ILMWR1 ;THIS IS 1ST WD, NO MORE WDS. + JRST CONND3 ;PRETEND JUST POPPED IT. + +;COME HERE FROM ASSEM1 TO END A CONSTANT. +CONND: SKIPE BYTM ;IF IN BYTE MODE, LEAVE IT AND DO .WALGN + JRST A.BY3 ;(WILL COME BACK SINCE ASMDSP STILL SET) +CONNDW: MOVEMM CONSP1,CONSTP + TLZ I,ILMWR1 ;THIS IS 1ST WORD COMING UP. +CONND0: TLZ I,ILMWRD+ILNOPT + SETZM WRDRLC + MOVE F,CONSP1 ;ADDR IN IN PDL OF NEXT WD. + CAMN F,ASSEMP + JRST CONND2 ;J IF NO WORDS. + MOVE A,1(F) ;GET SAVED NUM GLBLS,,NUM GLBLS + DPB A,[100,,WRDRLC] + LSH A,-1 ;RESTORE WRDRLC BITS 1.1, 3.1 + DPB A,[220100,,WRDRLC] + TRNE A,2 + TLO I,ILNOPT ;RESTORE NOOPTF. + LSH A,-2 ;GET # GLBLS. + HRLI A,(A) ;# GLBLS,,# GLBLS. + AOBJN F,.+1 + HRRZM F,GLSP2 ;ADDR BEFORE 1ST GLOBAL ENTRY. + ADD F,A + HRRZM F,GLSP1 ;ADDR OF LAST GLOBAL ENTRY. + MOVE A,1(F) + MOVEM A,WRD + AOBJN F,.+1 ;POINT TO NEXT CONST WD IF ANY, + MOVEM F,CONSP1 + CAME F,ASSEMP ;IF MORE WORDS SET ILMWRD + TLO I,ILMWRD + JRST CONND3 + +CONND2: INSIRP SETZM,[WRD,GLSP1,GLSP2] +CONND3: MOVE F,GLSP1 + SUB F,GLSP2 + JUMPE F,SCON ;JUMP IF NOTHING VIRTUAL + MOVEI B,-1(F) + MOVN TT,B + JUMPE B,SCON ;JUMP IF ONLY ONE GLOBAL + ;SORT GLOTB ENTRIES THIS CONSTANT +LSORT: HRL T,TT ;SET UP AOBJN POINTER TO GLOBALS REMAINING + HRR T,GLSP2 +LSORT2: MOVE A,1(T) + CAMLE A,2(T) + EXCH A,2(T) ;INTERCHANGE + MOVEM A,1(T) + AOBJN T,LSORT2 ;INNER LOOP POINT + SOJG B,LSORT ;OUTER LOOP + ;DROPS THROUGH + ;DROPS THROUGH +SCON: PUSHJ P,RCHKT + PUSHJ P,RMOVET ;SET UP RELOACTION BITS. + ROT T,2 ;ROTATE TO BOTTOM TWO BITS OF T + TLNE I,ILMWRD+ILMWR1+ILNOPT + JRST NOCON ;MULTIPLE WORD OR OPTIMIZATION SUPPRESSED, DON'T TRY TO FIND MATCH + MOVE A,CONTBA +SCON1: CAML A,PLIM ;SEARCH CONSTANTS TABLE TO SEE IF ALREADY THERE + JRST NOCON ;END OF TABLE, NO MATCH + MOVE B,WRD + CAME B,(A) +SCON2: AOJA A,SCON1 ;VAL DISAGREES + PUSHJ P,CPTMK ;GET BP TO CONSTANTS-BIT TABLE IN C + LDB F,C ;GET RELOCATION BITS THIS CONSTANT + CAME F,T + JRST SCON2 ;RLC DIFFRS + MOVE B,CONGLA ;VALUE AND RELOCATION AGREE, NOW TO CHECK GLOBALS + SKIPA C,GLSP2 +SCON2B: AOS B ;SEARCH FOR GLOBAL POINTING TO CONSTANT WHICH HAS MATCHED SO FAR + CAML B,CONGOL + JRST SCON3 ;GLOBALS MATCH SO FAR + CAME A,1(B) ;SKIP IF ONE FOUND +SCON7: AOJA B,SCON2B ;NOT YET + MOVE D,(B) ;FOUND ONE, GET GLOTB ENTRY + CAME D,1(C) ;COMPARE WITH THIS ENTRY IN GLOTB + JRST SCON2 ;NO MATCH, FLUSH THIS CONSTANT + AOJA C,SCON7 ;MATCH, TRY NEXT GLOBAL + +SCON3: CAME C,GLSP1 ;GLOBALS MATCH, BUT ARE WE EXACTLY AT END OF GLOTB? + JRST SCON2 ;NO, BACK TO SEARCH + JRST NOCON4 + NOCON: AOS A,PLIM ;CONSTANT NOT ALREADY IN TABLE + CAMLE A,CONTBE + ETF [ASCIZ/Literal table full/] + MOVE AA,WRD + MOVEM AA,-1(A) + SOS A + PUSHJ P,CPTMK + TLNE I,ILNOPT + TRO T,4 ;1.3 OF RELOCATION BITS => DON'T OPTIMIZE ON TOP OF ME + DPB T,C + MOVE B,GLSP2 +NOCON3: CAML B,GLSP1 + JRST NOCON4 + SKIPN C,1(B) + AOJA B,NOCON3 ;THIS ENTRY NOT REALLY HERE + MOVEM C,@CONGOL + HRRZS C + PUSHJ P,NOCON5 + MOVEM A,@CONGOL + PUSHJ P,NOCON5 + SKPST C, ;SKIP IF IN SYMBOL TABLE + AOJA B,NOCON3 + 3GET1 D,C ;IN SYMBOL TABLE + TLO D,3VCNT ;THIS SYM USED IN CONSTANT + 3PUT1 D,C ;UPDATE 3RDWRD TABLE ENTRY + AOJA B,NOCON3 + +NOCON5: AOS AA,CONGOL + CAML AA,CONGLE + ETF [ASCIZ/Constants-global table full/] + POPJ P, + + ;SET UP BYTE POINTER TO CONSTANTS-BIT TABLE + ;A SHOULD HAVE ADR OF CONSTANTS TABLE ENTRY + ;LEAVES ANSWER IN C + ;BITS IN CONSTANTS-BIT TABLE PER ENTRY: + ;1.2, 1.1 RELOCATION BITS + ;1.3 ILNOPT BIT => DON'T OPTIMIZE ON TOP OF ME + +CPTMK: PUSH P,A + SUB A,CONTBA + PUSH P,B + IDIVI A,12. + MOVEI C,(A) + ADD C,CONBIA ;SET UP ADDRESS PART + IMULI B,3 + DPB B,[360600,,C] ;STORE POSITION FIELD FROM REMAINDER + TLO C,200 ;SET UP SIZE FIELD +POPBAJ: POP P,B + JRST POPAJ + NOCON4: TLON I,ILMWR1 + MOVEM A,CONSAD ;IF 1ST WD SAVE ADDR. + TLNE I,ILMWRD ;IF MORE WORDS, HANDLE NEXT. + JRST CONND0 + MOVE P,CONSTP ;VALUE OF CONSTP AT CONND. + MOVE C,GLSPAS ;TO RESTORE GLSP1 + JSP T,CONNDP ;POP STUFF. + HRRZ A,CONSAD ;ADDR OF CONSTANTS TABLE ENTRY OF 1ST WD. + MOVE B,PBCON ;ADDR OF WDS DESCRIBING CONST. AREA. + SKIPL 2(B) ;CONST. AREA LOCATION DEFINITE? + AOJA C,CONND6 ;NO, USE GLOBAL. + MOVEM C,GLSP1 + HRRZ C,1(B) ;ADD ACTUAL ADDR OF CONST. AREA. + ADDI A,(C) ;GET C(CONTBA) + ADDR OF CONSTANT. + LDB B,[420100,,2(B)] + JRST CONND7 + +CONND6: MOVEM C,GLSP1 + MOVEM B,(C) + MOVEI B,0 +CONND7: SUB A,CONTBA + JRST LSSTH3 ;POP OUT INTO OUTER WORD. + +.SEE SAVAS1 ;WHICH IS WHAT PUSHES WHAT CONNDP POPS. +CONNDP: SUB P,[3,,3] ;FLUSH SAVED SYLOC AND SYSYM AND CLNN,,CPGN. +CONFL2: HRL T,ASMOUT ;REMEMBER IF POPPING A LITERAL OR NOT. + INSIRP POP P,[CONSTP,ASSEMP,GLSPAS,ASMI,ASMDSP,ASMOUT,BYTM] + SKIPN BYTM ;IF IN BYTE MODE, POP DETAILS. + JRST CONND5 + MOVSI A,1-BYTMCL(P) + HRRI A,BYTMC + BLT A,BYTMC+BYTMCL-1 + MOVSI A,1-BYTMCL-LBYBYT(P) + HRRI A,BYBYT + BLT A,BYBYT+LBYBYT-1 + SUB P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] +CONND5: HLRZ A,T + CAIE A,3 + JRST (T) + POP P,A + ADDM A,SCNDEP ;DON'T FORGET ABOUT ANY CONDITIONALS. + SOS CONDEP ;HAVE POPPED ONE CONSTANT. + JRST (T) + +CONFLS: MOVE P,ASSEMP ;FLUSH ALL CONSTANTS. + CAMN P,[-LPDL,,PDL] ;IF IN ANY, + JRST (LINK) + MOVE P,CONSTP ;POINT AFTER ITS PDL ENTRY, + JSP T,CONNDP ;POP IT, + JRST CONFLS ;TRY AGAIN. + +CONBAD: SKIPN ASMOUT ;IF IN GROUPING, ERROR. + POPJ P, + ETSM [ASCIZ/Within <>, () or []/] + JRST ASSEM1 + ;COME HERE FOR PDL-OV ON P. +;IF IN A CONSTANT, FLUSH ALL OF THEM, SAYING WHERE EACH STARTED. +;THEN TYPE A PDL ERROR MSG AND RETURN TO ASSEM1. +;OTHERWISE FATAL ERROR. +CONFLP: MOVEI LINK,ASSEM1 + MOVEI CH1,ERRPDL + SKIPE CONDEP + JRST CONFL3 ;IN A CONSTANT. + MOVEI P,PDL ;RE-INIT PDL SO NO MORE PDL-OV. + ETF ERRPDL +ERRPDL: ASCIZ /PDL overflow/ + +;JSP LINK,CONFLM TO FLUSH CONSTANTS, SAYING WHERE THEYY STARTED, +;AND GIVE ERROR MSG. +CONFLM: MOVE CH1,ASMOUT + SKIPA CH1,ASMOT3(CH1) +CONFLZ: SETZ CH1, ;LIKE CONFLM BUT NO ERR MSG AT END. +CONFL3: SETO C, +CONFL1: MOVE P,CONSTP ;GET STACK ABOVE INNERMOST LITERAL. + REST SYLOC + REST SYSYM + REST D ;GET INFO ON WHERE STARTED + AOSN C ;THE 1ST TIME ONLY, SAY WHAT'S GOING ON. + TYPR [ASCIZ/Within groupings: /] + SKIPE C + TYPR [ASCIZ/, /] + MOVE A,ASMOUT ;SAY WHAT KIND OF GROUPING IS BEING CLOSED + MOVE A,ASMOT5(A) + CALL TYOERR ;BY SAYING WHAT CHAR OPENED IT. + JSP T,CONFL2 ;POP REST OF WDS SAVED AT LBRAK. + TYPR [ASCIZ/ at /] + MOVEI A,1(D) ;PAGE # GROUPING STARTED ON. + CALL DPNT ;PRINT IN DECIMAL. + MOVEI A,"- + CALL TYOERR + HLRZ A,D ;LINE NUMBER IT STARTED ON. + ADDI A,1 + CALL D3PNT2 ;PRINT W/ AT LEAST 3 CHARS, NO ZERO SUPPR. + MOVE A,ASSEMP + CAME A,[-LPDL,,PDL] ;MORE GROUPINGS TO POP => DO. + JRST CONFL1 + CALL CRRERR + MOVE P,ASSEMP + JUMPE CH1,(LINK) ;IF CALLED CONFLZ, NO ERR MSG (CALLER WILL GIVE ONE) + ETR (CH1) ;[ NO] OR PDL. + CALL CRRERR + JRST (LINK) + ;CONSTA + +CNSTNT: NOVAL + SKIPE ASMOUT ;IF ANY GROUPNGS, + JSP LINK,CONFLM ;FLUSH THEM, GIVE ERROR. + PUSHJ P,CNSTN0 + JRST ASSEM1 + +CNSTN0: SOSGE CONCNT ;ENTRY FROM AEND + ETF [ASCIZ /Too many constants areas/] + MOVE B,CLOC + ADD B,OFLOC + HRRZ T,PBCON + TRNN FF,FRPSS2 + JRST CNST1 ;PASS 1 + + MOVSI A,CGBAL + TDZ A,2(T) + TRNE FF,FRGLOL + TLC A,CGBAL + SKIPN A + ETR [ASCIZ /Constants globality phase error/] + HRRZ B,1(T) + SUB B,OFLOC + HRRZS B + CAME B,CLOC + ETR [ASCIZ /Constants location phase error/] + MOVE B,2(T) + ROT B,2 + XOR B,CRLOC + XOR B,OFRLOC + TRNE B,1 + ETR [ASCIZ /Constants relocation phase error/] + ;DROPS THROUGH + ;DROPS THROUGH +CNST2: MOVEI D,(T) ;STE IDX IN D FOR OUTSM0 + MOVE SYM,(T) ;GET NAME OF AREA + TLC SYM,400000#LCUDF ;CLEAR LCUDF, SET HALF-KILL + TRNE FF,FRGLOL + PUSHJ P,PDEFPT ;DEFINE SYM FOR BEGINNING OF CONSTANTS AREA + MOVE A,CONTBA +CNSTH: CAML A,PLIM + JRST CNSTA ;THRU + MOVE TT,(A) + MOVEM TT,WRD + PUSHJ P,CPTMK + LDB F,C ;GET THIS CONSTANT'S RELOCATION BITS + TRZE F,2 + TLO F,1 ;RELOCATE LEFT HALF + MOVEM F,WRDRLC ;STORE RELOCATION + MOVEI D,GLOTB ;AND NOW TO SET UP GLOTB! + MOVEM D,GLSP2 + MOVE C,CONGLA +CNSTC: CAML C,CONGOL + JRST CNSTB ;END OF CONSTANT-GLOBAL TABLE + CAMN A,1(C) ;POINTS TO THIS CONSTANT? + PUSH D,(C) ;YES, STORE ENTRY IN GLOTB + AOS C + AOJA C,CNSTC + +CNSTB: HRRZM D,GLSP1 ;MARK END OF ACTIVE PART OF GLOTB + PUSH P,A + PUSHJ P,PWRD ;OUTPUT THIS CONSTANT + AOS CLOC ;INCREMENT CLOC TO NEXT + HRRZS CLOC ;MAKE SURE IT STAYS IN A HALF-WORD (IMPORTANT SINCE MAY BE LESS THAN RELOCATION) + POP P,A ;RESTORE POINTER INTO CONSTANTS TABLE + AOJA A,CNSTH + +CNST3: HLRZ A,1(T) ;GET POINTER TO TOP OF AREA STORED DURING PASS 1 + CAMN A,CLOC ;SAME AS CURRENT? + JRST CNSTE ;YES, NO HAIR + CAMGE A,CLOC ;DIFFERENT; LOWER? + ETR [ASCIZ /More constants on pass 2 than 1/] + ;INSUFFICIENT CONSTANT SPACE; CONSTANTS AREA TRYING TO BE BIGGER + ;IN PASS 2 THAN PASS 1; THE EXTRA CONSTANTS WERE BACKED OVER + MOVEM A,CLOC ;EITHER WAY, SET CLOC TO TOP OF AREA SO WON'T HAVE MDT TROUBLE + PUSHJ P,EBLK ;END CURRENT BLOCK + CALL SLOCF ;IF RELOCATABLE, MAKE SURE NEW VALUE OF $. GETS PUNCHED + JRST CNSTE + +;CALL SLOCF WHENEVER "." IS CHANGED WITHOUT THE OUTPUTTING OF A STORAGE WORD. +SLOCF: MOVE A,CLOC ;STORE NEW "." IN HEADER FOR NEXT BLOCK OF OUTPUT. + SKIPGE TM,CONTRL + TRNN TM,DECREL+FASL ;BUT NOT IN DEC OR FASL OUTPUT FORMATS. + HRRM A,BKBUF + IORI FF,FRLOC ;MAKE SURE NULL BLOCK IS OUTPUT IF NEC. TO TELL LOADER "." HAS CHANGED. + RET + ;CONSTA DURING PASS 1 + +CNST1: HRRM B,1(T) ;STORE LOCATION OF AREA + MOVEI D,0 + MOVE A,CRLOC + ADD A,OFRLOC + TRNE A,1 + TLO D,CTRL ;RELOCATED + TRNE FF,FRGLOL + TLO D,CGBAL ;GLOBAL + IORM D,2(T) ;STORE FLAGS DESCRIBING AREA + JUMPL FF,CNST2 ;JUMP ON PUNCHING PASS, PUNCH OUT AREA NOW + MOVE T,PLIM + SUB T,CONTBA + ADDM T,CLOC ;PASS 1, JUST UPDATE CLOC + HRRZS CLOC + +CNSTA: HRRZ T,PBCON + TRNE FF,FRGLOL + JRST CNSTD ;LOCATION GLOBAL + TRNN FF,FRNPSS + SKIPGE 2(T) + JRST CNSTDA ;2 PASS ASSEMBLY OR AREA DEFINED + TRO I,IRCONT ;1PASS AND NOT DEFINED + SETZM PARBIT + PUSHJ P,P70 ;DEFINE SYM + MOVE A,(T) + TLC A,400000#LCUDF + SKIPE CRLOC + TLO A,100000 ;RELOCATE + PUSHJ P,$OUTPT + HRRZ A,1(T) + PUSHJ P,$OUTPT ;OUTPUT VALUE, FIRST LOCATION IN AREA + TRZ I,IRCONT +CNSTDA: MOVSI A,CTDEF + IORM A,2(T) ;CALL IT DEFINED +CNSTD: TRNE FF,FRPSS2 + JRST CNST3 ;PASS 2 + MOVE A,CLOC + HRLM A,1(T) ;MARK END OF AREA + +CNSTE: MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + MOVEI T,3 + ADDB T,PBCON + CAML T,PBCONL + MOVEM T,PBCONL + AOS A,CSQZ + MOVEM A,(T) + POPJ P, + ;DEFINING SYM USED IN CONSTANT, DELETE REFERENCES FROM CONSTANT-GLOBAL TABLE + +CONBUG: MOVE A,CONGLA ;B VAL C FLAGS ST(D) SADR + PUSH P,T + PUSH P,C ;SAVE FLAGS +CONBG2: MOVE C,(P) ;GET FLAGS + CAML A,CONGOL ;DONE WITH SCAN? + JRST CONBG1 ;YES + HRRZ F,(A) ;NO, GET CONSTANT-GLOBAL TABLE ENTRY + CAIE F,ST(D) ;POINT TO THIS SYM? + AOJA A,CONBG6 + PUSH P,B ;YES, SAVE VALUE, ABOUT TO WORK WITH B + MOVE T,(A) ;GET ENTIRE CONSTANT-GLOBAL TABLE ENTRY + LDB CH2,[221200,,T] ;GET MULTIPLICATION FIELD + SKIPE CH2 + IMUL B,CH2 ;NON-ZERO => MULTIPLY VALUE OF SYM + TLNE T,MINF + MOVNS B ;NEGATE VALUE + TLNE T,HFWDF + HRRZS B ;TRUNCATE TO HALFWORD + TLNE T,ACF + ANDI B,17 ;AC, MASK TO FOUR BITS + TLNE T,SWAPF + MOVSS B ;SWAP VALUE + TLNE T,ACF + LSH B,5 ;AC, SHIFT FIVE + ADD B,@1(A) ;ADD ABS PART OF VALUE + TLNN T,SWAPF + HRRM B,@1(A) ;NOT SWAPPED, STORE LH + TLNE T,SWAPF + HLLM B,@1(A) ;SWAPPED, STORE LH + TLNN T,HFWDF + MOVEM B,@1(A) ;FULL WORD, STORE VALUE + LDB CH1,[420200+P,,-1] ;GET HIGH BITS OF 3RDWRD, RELOCATION BITS + TLNE T,HFWDF ;NOW TO MAP RELOCATION BITS + TRZ CH1,2 + TLNE T,SWAPF + LSH CH1,1 + TRZE CH1,4 + TRO CH1,1 + PUSH P,A + HRRZ A,1(A) ;GET POINTER INTO CONSTANTS TABLE + PUSHJ P,CPTMK + LDB B,C ;GET RELOCATION BITS + TLNE T,MINF + JRST CONBG8 ;NEGATE + TRNE B,(CH1) + ETA ERRCRI + ;ATTEMPTED MULTIPLE RELOCATION IN CONSTANT + ; ^ ABOVE SHOULD BE REPLACED WITH A $RSET LIKE ROUTINE + ;THAT ALSO SEARCHES CONSTANT-GLOBAL TABLE FOR $R. ALREADY THERE + IOR B,CH1 ;LOOKS OK, IOR IN BITS FOR GLOBAL +CONB8A: DPB B,C ;STORE BACK NEW RELOCATION BITS FOR CONSTANT + POP P,A + CLEARM (A) ;CLEAR OUT CONSTANT-GLOBAL TABLE ENTRY + CLEARM 1(A) + POP P,B + AOS A +CONBG6: AOJA A,CONBG2 ;BACK FOR NEXT CONSTANT, DON'T KNOW HOW MANY THIS SYM USED IN + CONBG1: MOVE A,CONGLA + PUSH P,B + MOVE B,CONGLA +CONBG7: CAML A,CONGOL + JRST CONBG3 + SKIPN C,(A) +CONBG5: AOJA A,CONBG4 + MOVEM C,(B) + MOVE C,1(A) + MOVEM C,1(B) + AOS B + AOJA B,CONBG5 + +CONBG4: AOJA A,CONBG7 +CONBG3: MOVEM B,CONGOL + POP P,B + POP P,C + POP P,T + POPJ P, +CONBG8: XORI B,3 + TRNE B,(CH1) + ETA ERRCRI + ANDCB B,CH1 + JRST CONB8A + +ERRCRI: ASCIZ /Multiple relocation in constant/ + ;VARIAB + +AVARIAB: NOVAL + SKIPE ASMOUT ;FLUSH ANY GROUPINGS IN PROGRESS. + JSP LINK,CONFLM + PUSHJ P,AVARI0 + JRST ASSEM1 + +AVARI0: SOSG VARCNR ;ENTRY FROM AEND + ETF [ASCIZ /Too many variable areas/] + MOVE D,SYMAOB ;SET UP AOBJN POINTER TO ST + MOVE T,CLOC + MOVEM T,VCLOC ;STORE AS LOCATION OF VARIABLE AREA + ADD T,OFLOC + MOVE C,CRLOC + ADD C,OFRLOC + TRNE FF,FRPSS2 + JRST AVAR1 ;PASS 2 + HRL T,VARCNT ;SIZE OF AREA + TRNE C,1 + TLO T,400000 ;RELOCATED + MOVEM T,@VARPNT + JRST AVAR2E + +AVAR1: HRRZ A,@VARPNT ;VARIAB DURING PASS 2 + CAIE A,(T) + ETR [ASCIZ /Variables location phase error/] + HLRZ A,@VARPNT + TRZE A,400000 + XORI C,1 + TRNE C,1 + ETR [ASCIZ /Variables relocation phase error/] + SKIPE VARCNT + ETR [ASCIZ /Variables area size phase error/] + +AVAR2E: HLRZ T,@VARPNT + TRNN T,377777 + JRST AVAR2C ;IF THIS VAR AREA IS EMPTY, DON'T SCAN SYMTAB. +AVAR2: HLRZ LINK,ST(D) ;SCAN, CHECKING EACH SYM FOR WHETHER IT'S A VARIABLE + CAIL LINK,DEFLVR + JRST AVAR2B + ADD D,WPSTE1 + AOBJN D,AVAR2 + JRST AVAR2C ;ALL SCANNED. + +AVAR2B: 3GET C,D ;FOUND A VARIABLE; DECIDE WHAT TO DO WITH IT. + MOVE B,ST+1(D) + MOVE SYM,ST(D) + TLZ SYM,740000 + LDB LINK,[400400,,ST(D)] + CAIE LINK,UDEFLV_-14. + CAIN LINK,UDEFGV_-14. + JRST AVAR3 ;UNDEFINED VARIABLE + CAIE LINK,DEFGVR_-14. + CAIN LINK,DEFLVR_-14. + JRST AVAR4 ;DEFINED VARIABLE +AVAR2A: ADD D,WPSTE1 + AOBJN D,AVAR2 ;CHECK ENTIRE SYMTAB +AVAR2C: HLRZ A,@VARPNT ;NOW GET SIZE OF AREA + TRZ A,400000 ;CLEAR OUT RELOCATION CHECK BIT +IFN FASLP,[ + MOVE D,CONTRL + TRNE D,FASL ;IN FASL ASSEMBLY, CAN'T JUST SET LOC CTR; MUST OUTPUT 0'S. + CALL ABLKF +] + ADD A,VCLOC ;ADD LOCATION OF BEGINNING OF VARIABLE AREA + MOVEM A,CLOC ;STORE AS NEW CURRENT LOCATION + PUSHJ P,EBLK + CALL SLOCF + CLEARM VARCNT ;INITIALIZE COUNT OF VARIABLES IN NEXT AREA + AOS VARPNT ;INCREMENT POINTER TO POINT TO NEXT AREA + POPJ P, + ;UNDEFINED VARIABLE FOUND IN SYMTAB SCAN + +AVAR3: CAIN LINK,UDEFGV_-14. ;GLOBAL? + TLO SYM,40000 ;GLOBAL + PUSHJ P,LKPNRO + MOVSI T,DEFLVR + CAIN LINK,UDEFGV_-14. + MOVSI T,DEFGVR + TRNE FF,FRGLOL + JRST AVAR3A ;LOCATION GLOBAL + MOVEI B,-1(B) + ADD B,VCLOC + ADD B,OFLOC + MOVE TT,CRLOC + ADD TT,OFRLOC + SKIPE TT + TLO C,3RLR + CAIE LINK,UDEFGV_-14. + TLZN C,3VCNT + SKIPA + PUSHJ P,CONBUG +AVAR4B: PUSHJ P,VSM2 + JUMPGE FF,AVAR2A ;IF PUNCHING PASS, OUTPUT DEFINITION. + PUSHJ P,OUTDE2 + JRST AVAR2A + +AVAR4: TLNE C,3VAS2 ;DEFINED VARIABLE FOUND DURING SYMTAB SCAN + TLOE C,3VP + JRST AVAR2A + MOVSI T,(LINK) ;CAUSE AVAR4B TO REDEFINE AS SAME TYPE. + LSH T,14. + TRNN FF,FRGLOL + JRST AVAR4A +AVAR3A: PUSHJ P,VSM2LV + JUMPGE FF,AVAR2A + PUSHJ P,PDEFPT + MOVEI A,0 + PUSHJ P,PBITS + PUSHJ P,$OUTPT + AOS CLOC + JRST AVAR2A + +AVAR4A: CAIN LINK,DEFGVR_-14. ;DEF VAR, 3VAS2, POINT NOT GLOBAL. + JRST AVAR4B ;VAR GLOBAL, MUST PUNCH DEF SINCE DIDN'T ON PASS1. + 3PUT C,D ;LOCAL, JUST SET 3VP SO DON'T SEE IT NEXT VARIAB. + JRST AVAR2A ;NO NEED TO PUNCH DEF SINCE WAS DEF ON PASS1. + ;;MAIN ;"MAIN" MIDAS ROUTINES: INIT, PS1, PLOD, PS2, PSYMS + ;ALL CALLED WITH JSP A,; ALL GLOBAL + ;RETURN INSTRUCTION FROM JSP IN LOCATION RETURN +PS1: HRRM A,RETURN ;PASS 1, (PASS 1 INITIALIZATION ALREADY DONE), SAVE RETURN + SAVE [ASSEM1-1] ;SIMBLK WILL POPJ1. +IFN A1PSW,[SKIPL PRGC + JRST A1PAS1 ;THIS NOT FIRST PROGRAM THIS ASSEMBLY, SET MODE TO 1PASS +] + TRO FF,FRNPSS +IFN ITSSW,JRST SIMBLK ;SELECT SBLK AND ASSEMBLE +IFN DECSW\TNXSW,JRST A.DECRE ;SELECT .DECREL AND ASSEMBLE. + +PS2: HRRM A,RETURN ;PASS 2 (MAIN ROUTINE, PASS 2 INITIALIZATION NOT ALREADY DONE), SAVE RETURN + JUMPL FF,PA2A ;JUMP IF PASS 1 ENDED IN 1PASS MODE + TDO FF,[FLPPSS,,FRPSS2] ;SET PUNCHING PASS AND PASS 2 FLAGS + PUSHJ P,P2INI ;INITIALIZE + JRST ASSEM1 ;START ASSEMBLING + +PA2A: MOVE A,SYMAOB ;PASS 2 OF 1PASS ASSEMBLY, CHECK FOR UNDEFINED LOCALS +PA2C: MOVE SYM,ST(A) ;GET SQUOZE THIS SYMTAB ENTRY + LDB B,[400400,,SYM] ;GET FLAGS + CAIE B,LCUDF_-14. ;LOCAL UNDEFINED? + JRST PA2B ;NOT LOCAL UNDEFINED, DON'T COMPLAIN + 3GET C,A ;LOCAL UNDEFINED, GET 3RDWRD ST ENTRY + TLZ SYM,740000 ;CLEAR OUT FLAGS IN SYM IN ANTICIPATION OF TYPING OUT COMPLAINT + TLNN C,3LLV ;PROBLEM HANDED TO LINKING LOADER? + ETSM [ASCIZ /Undefined/] ;NO +PA2B: ADD A,WPSTE1 ;NOW GO FOR NEXT ST ENTRY + AOBJN A,PA2C + JRST RETURN + +$INIT: HRRM A,RETURN ;INITIALIZATION (BEFORE PASS 1 ONLY) ROUTINE, SAVE RETURN POINT +IFN CREFSW,PUSHJ P,CRFOFF ;DON'T CREF ON 1ST PASS. +IFN LISTSW,CALL LSTOFF ;DON'T LIST ON 1ST PASS. + SKIPGE ISYMF + JRST INIT1 ;SPREAD SYMS (RETURNS TO SP4) + MOVE A,SYMAOB ;ALREADY SPREAD, JUST FLUSH ALL BUT INITIAL SYMS +INIT4: SKIPN B,ST(A) + JRST INIT2 + 3GET C,A + TRNE C,-1 ;INITIAL SYM? + CLEARM ST(A) ;NO +INIT2: ADD A,WPSTE1 + AOBJN A,INIT4 + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1] + BLT A,EBKCOD ;CLEAR OUT BLANK CODE + +SP4: PUSH P,CRETN +P1INI: CLEARB I, LDCCC + INSIRP SETZM,BKBUF ISYMF A.PASS +IFN FASLP,[ + INSIRP SETZM,FASATP FASPCH + CLEARM FASIDX +] + MOVEMM DECTWO,[[MOVE]] + TDZ FF,[-1-FLVOT-FLPTPF-FLTTY,,-1] ;INITIALIZE MOST FF FLAGS + MOVEIM A.PPASS,2 ;DEFAULT IS 2-PASS. + PUSHJ P,MACINI ;INITIALIZE MACRO STATUS + MOVEI A,PCNTB + MOVEM A,PBCONL + MOVS A,[BKTAB,,P1INI1] + BLT A,BKTAB+4 + MOVEIM BKTABP,BKWPB*2 + ;DROPS IN. +P2INI: INSIRP SETZM,[CPGN,CLNN,GENSM,OFLOC,OFRLOC,CRLOC,BKPDL +SYLOC,SYSYM,BYTW,BYTRLC,STGSW,DECBRK,DEFNPS,BYTM,BYTM1,HKALL,QMTCH] + AOS B,A.PASS +IFN ITSSW,[ + CALL SETWH2 ;SET UP .WHO2, PREPARE .WHO3 IN A WITH PAGENUM=1. + .SUSET [.SWHO3,,A] ;'P1 ',,PAGENUM OR 'P2 ',,PAGENUM + .SUSET [.SWHO1,,[.BYTE 8 ? 166 ? 0 ? 165 ? 0]] +] + TDZ FF,[FLUNRD,,FRGLOL] +IRP X,,[BKWPB,BKCUR,,BKPDL+1,1,BKLVL,IRDEF,ASMI +NCONS,CONCNT,VARTAB,VARPNT,NVARS,VARCNR,1,VECSIZ] +IFE 1&.IRPCN,IFSN [X], MOVEI A,X +IFN 1&.IRPCN, MOVEM A,X +TERMIN + MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + CLEARM VARCNT + CLEARM PBITS2 + MOVE A,[440300,,PBITS1] + MOVEM A,BITP + MOVEI A,PBITS4 + HRRZM A,PBITS4 + CLEARB I,PBITS1 + MOVEI A,PCNTB + MOVEM A,PBCON + MOVE A,[(LCUDF)++1] ;< AND > FOR COMPATIBILITY WITH OLD + MOVEM A,PCNTB + MOVEM A,CSQZ + MOVEI A,8 + MOVEM A,ARADIX +IFN ITSSW,[ + MOVEI A,100 + MOVEM A,CLOC +] +.ELSE [ SETZM CLOC + AOS CRLOC ;CRLOC GETS 1 +] + SETZM GLOCTP + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,CONTRL ;IN DEC FORMAT, OUTPUT PROGRAM NAME. + TRNE A,DECREL + CALL DECPGN ;CLOBBERS A +IFN FASLP,[ + SETOM FASBLC ;LOSING BLOCK COUNT + MOVE A,CONTRL ;IN FASL FORMAT, OUTPUT FASL HEADER + TRNE A,FASL + CALL FASOIN ;INITIALIZE FASL OUTPUT +] + SETZM DECBRH + TRO FF,FRSYMS+FRFIRWD + MOVE A,[IFORTB,,FORTAB] ;INITIALIZE FORMAT TABLE ON EACH PASS + BLT A,FRTBE + MOVEIM GLSPAS,GLOTB ;INIT. ASSEM1 PDL LEVELS TO BOTTOM. + MOVEMM ASSEMP,[[-LPDL,,PDL]] + MOVEIM ASMDSP,ASSEM3 + SETZM ASMOUT + SETZM CONSTP + SETZM SCNDEP ;NOT IN CONDIT. OR CONSTANT. + SETZM CONDEP + HRRZM P,CONSML ;START OUT IN MULTI-LINE MODE. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + MOVEM A,PNTBP + CLEARM LISTPF + SETOM LISTBC + SKIPG LISTP1 ;IF LIST ON PASS 1 + JUMPGE FF,CRETN ;OR PUNCHING PASS, + SKIPE LISTP ;IF WANT LISTING, + CALL LSTON ;TURN ON OUTPUT OF LISTING. +] +IFN CREFSW,[ + JUMPGE FF,CRETN + SKIPE CREFP ;IF C SWITCH WAS SEEN, + PUSHJ P,CRFON ;TURN ON CREFFING, +] +CRETN: POPJ P,RETURN + +P1INI1: SQUOZE 0,.INIT ? 0 ? 3 + SQUOZE 0,.MAIN ? 1,, + PLOD: HRRM A,RETURN ;MAIN ROUTINE TO PUNCH LOADER, CALLED BEFORE PASS 2 (PS2"), SAVE RETURN POINT + PUSHJ P,PLOD1 ;PUNCH LOADER + JRST RETURN ;RETURN + + ;PUNCH OUT THE LOADER + +PLOD1: PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE + MOVE B,CONTRL + TRNE B,ARIM10 + JRST PLOD2 ;RIM10 => PUNCH OUT SBLK LOADER FOR PDP10 READIN-MODE READIN + TRNN B,SBLKS + POPJ P, ;NOT SBLK => DON'T PUNCH LOADER +PLOD1A: MOVSI B,SLOAD-SLOADP ;PUNCH SBLK LOADER IN RIM FORMAT + MOVSI C,(DATAI PTR,) +PLOAD1: MOVE A,C + PUSHJ P,PPBA + CAMN C,[DATAI PTR,13] + HRRI C,27 + MOVE A,SLOAD(B) + PUSHJ P,PPBA + AOS C + AOBJN B,PLOAD1 + MOVE A,[JRST 1] + PUSHJ P, PPBA + JRST FEED1 + +PLOD2: MOVSI C,LDR10-ELDR10 ;PUNCH SBLK LOADER FOR PDP10 READIN +PLOD3: MOVE A,LDR10(C) + PUSHJ P,PPBA + AOBJN C,PLOD3 + JRST FEED1 + + ;SBLK LOADER NORMALLY PUNCHED OUT IN RIM FORMAT + +SLOAD: CONO PTR,60 ;0 RESTART POINT (NEW BLOCK) + JSP 14,30 ;1 START POINT, LOOP POINT FOR NEW BLOCK; WAIT FOR DATA WORD READY + DATAI PTR,16 ;GET HEADER + MOVE 15,16 ;INITIALIZE CHECKSUM + JUMPGE 16,16 ;HEADER .GE. 0 => STARTING INSTRUCTION + JSP 14,30 ;5 LOOP POINT FOR NEXT DATA WORD: WAIT FOR READY + DATAI PTR,(16) ;READ IN DATA WORD + ROT 15,1 ;NOW UPDATE CHECKSUM + ADD 15,(16) + AOBJN 16,5 ;LOOP FOR ALL DATA WORDS THIS BLOCK + MOVEI 14,33 ;30 TO RETURN TO 33 + JRST 30 ;WAIT FOR READY THEN GO TO 33 + ;14 JSP AC FOR ROUTINE AT 30 + ;15 CHECKSUM + ;16 AOBJN POINTER (UPDATED HEADER) + CONSO PTR,10 ;30 ROUTINE TO WAIT FOR DATA WORD READY FOR DATAI + JRST 30 + JRST (14) + DATAI PTR,16 ;33 GET CHECKSUM + CAMN 15,16 ;COMPARE WITH CALCULATED + JUMPA 1 ;OK, GO GET NEXT BLOCK (DON'T CHANGE TO JRST OR REAL LOADERS WILL GET CONFUSED) + JRST 4, ;CHECKSUM ERROR +SLOADP==. + ;PDP10 SBLK LOADER +;FOLLOWING CODING ACTUAL WORDS TO BE OUTPUT + ;BY ASSEMBLER, COMPILER, OR WHATEVER +;SHOULD BE EXECUTED BY PDP10 HARDWARE READIN FEATURE +;USES ONLY THE AC'S (BUT ALL OF THEM) + +LDR10: + -17,,0 ;BLKI POINTER FOR READ SWITCH + +LDRC=0 ;CHECKSUM (OK, SO YOU'RE NOT ALLOWED TO LOAD + ;INTO IT DURING HARDWARE READIN, BUT WHO SAYS + ;YOUR PROGRAM CAN'T USE IT?) +OFFSET -.+1 ;BEGIN LOADING INTO 1 AS PER HEADER +LDRGO==. + CONO PTR,60 ;START UP PTR (RESTART POINT) +LDRRD==. + HRRI LDRB,.+2 ;INITIALIZE INDEX +LDRW==. + CONSO PTR,10 ;WAIT FOR WORD TO BE AVAILABLE + JRST .-1 + ROT LDRC,-LDRRD(LDRB) ;BEFORE READING IN HEADER, ROTATE 2 BITS (THEN IGNORE) + ;BEFORE READING IN EACH DATA WORD, ROTATE 1 BIT (FOR UPDATING CHECKSUM) + ;BEFORE READING IN CHECKSUM, ROTATE NOT AT ALL (DON'T ROTATE CALCULATED CHECKSUM) + DATAI PTR,@LDRT1-LDRRD(LDRB) ;READ WORD INTO RIGHT PLACE + ;HEADER => READ INTO C + ;STORAGE WORD => READ INDEXED BY AOBJN POINTER IN A + ;CHECKSUM => READ INTO A FOR COMPARISON WITH C(C) + XCT LDRT1-LDRRD(LDRB) ;EXECUTE RELEVANT T1 ENTRY (MAYBE SKIPS) + XCT LDRT2-LDRRD(LDRB) ;EXECUTE RELEVANT T2 ENTRY (MAYBE JUMPS) +LDRB==. + SOJA ., ;-RD(B) IS 2, 1, AND 0 FOR SUCCESSIVE ENCOUNTERS OF THIS INSTRUCTION + ;USED AS INDEX INTO TABLES, ETC. + + ;TABLE 1 + ;INDIRECTED THROUGH FOR DATAI + ;THEN EXECUTED TO SEE WHAT TO DO WITH READ IN WORD + ;ENTRIES EXECUTED IN REVERSE ORDER + +LDRT1==. + CAME LDRC,LDRA ;COMPARE CHECKSUM WITH CALCULATED, SKIP TO B IF THEY AGREE + ADD LDRC,(LDRA) ;UPDATE CHECKSUM + SKIPL LDRA,LDRC ;INITIALIZE HEADER AND SKIP UNLESS JUMP BLOCK + + ;TABLE 2 + ;EXECUTED IF CORRESPONDING ENTRY IN TABLE 1 DIDN'T SKIP WHEN EXECUTED + +LDRT2==. + JRST 4,LDRGO ;CHECKSUM ERROR + AOBJN LDRA,LDRW ;UPDATE AOBJN POINTER AND GO BACK FOR NEXT STORAGE WORD IF NOT EXHAUSTED +LDRA==. + JRST LDRRD ;WHEN INITIALLY LOADED IS JUMP BLOCK TO THIS LOADER + ;DURING LOADING USED TO HOLD HEADER (AOBJN POINTER), WHICH MAY BE LOADED JUMP BLOCK + +OFFSET 0 +ELDR10==. + ;FLAGS IN SQUOZE OF SYMS TO OUTPUT + +ABSGLO==040000 ;SYM IS GLOBAL (IF RELOCA, SAYS THIS IS BLOCK NAME) +ABSLCL==100000 ;LOCAL +ABSDLI==200000 ;DELETE INPUT (DON'T RECOGNIZE IT IF TYPED IN) +ABSDLO==400000 ;DELETE OUTPUT (DON'T TYPE IT OUT) + +PSYMS: HRRM A,RETURN ;PUNCH OUT SYMBOL TABLE, CALLED AFTER EVERYTHING ELSE, SAVE RETURN POINT + PUSH P,PSYMS ;AT END, POPJ TO RETURN. + TRNE FF,FRSYMS + JRST SYMDMP ;PUNCH SYMS IF NEC. + SKIPL A,CONTRL + JRST SYMDA ;IF RELOCA, PUNCH PROGRAM NAME. + TRNN A,DECREL + POPJ P, +PSYMSD: MOVSI A,DECEND + PUSHJ P,DECBLK ;START AN END-BLOCK. + MOVE A,DECTWO ;IN 2-SEG PROGRAMS, + CAME A,[MOVE] + JRST [ CAMG A,DECBRH ;OUTPUT HISEG BREAK + MOVE A,DECBRH + MOVEM A,WRD + MOVEIM WRDRLC,1 + CALL PWRD + MOVEMM WRD,DECBRK + CALL PWRD ;FOLLOWED BY LOSEG BREAK + JRST EBLK] + MOVEMM WRD,DECBRK ;OUTPUT THE PROGRAM BREAK. + MOVEIM WRDRLC,1 + PUSHJ P,PWRD + MOVE A,DECBRA ;OUTPUT HIGHEST ABS. ADDR + CAIG A,140 + SETZ A, ;IF IT'S ABOVE THE JOBDAT AREA. + PUSHJ P,DECWRD + JRST EBLK + +SYMDA: MOVEI A,LPRGN ;NOW PUNCH PROGRAM NAME + DPB A,[310700,,BKBUF] + MOVE A,PRGNM + TLO A,40000 + PUSHJ P,$OUTPT + PUSHJ P,EBLK + TLZ FF,$FLOUT + POPJ P, + + ;DUMP OUT THE SYMBOL TABLE + +SYMDMP: TRZ I,IRCONT ;OK TO END BLOCK + CLEARM GLSP1 + CLEARM GLSP2 + CLEARM WRDRLC + MOVE T,CONTRL + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + CLEARM CLOC + CLEARM BKBUF +IFN FASLP,[ + TRNE T,FASL + JRST SYMDM1 +] + TRNE T,DECREL + JRST SYMDMD + JUMPL T,SSYMD ;JUMP IF NOT RELOCATABLE + MOVEI B,LDDSYM ;LOCAL SYMS BLOCK TYPE + DPB B,[310700,,BKBUF] ;SET BLOCK TYPE + MOVEM B,CDATBC + MOVE B,SYMAOB ;CAUSE SSYMD3 TO LOOK AT ENTIRE SYM TAB. + JRST SSYMDR + +SYMDMD: MOVSI A,DECSYM ;IN DEC FMT, START SYMBOLS BLOCK. + PUSHJ P,DECBLK +SYMDM1: MOVE B,SYMAOB + JRST SSYMDR + ;AC ALLOCATIONS DURING PHASE 1 (COMPACTING THE SYMBOL TABLE): + ;AA INITIALLY HAS -SMK,,; INPUT INDEX INTO ST + ;A TEMP + ;B SQUOZE + ;D OUTPUT INDEX INTO SYMTAB + ;CH1 VALUE OF SYM + ;CH2 3RDWRD +SSYMD: MOVEI D,ST-1 + SETZB C,SMSRTF ;SYMS SORTED => INITIAL SYMS CLOBBERED + MOVE AA,SYMAOB +SSYMD1: SKIPE B,ST(AA) ;GET SYM NAME FROM TABLE + TDNN B,[37777,,-1] ;MAKE SURE NOT EXPUNGED + JRST SSYMDL ;NOT (REALLY) THERE, TRY NEXT + MOVE CH1,ST+1(AA) ;GET VALUE OF SYM + 3GET CH2,AA ;GET 3RDWRD + TRNE CH2,-1 + TLNE CH2,3KILL+3LLV + JRST SSYMDL ;DON'T PUNCH INITIAL OR KILLED SYMS. + MOVEI A,0 ;INITIALIZE FOR SHIFTING IN FLAGS + LSHC A,4 ;SHIFT FLAGS INTO A + XCT SSYMDT(A) ;DO THE APPROPRIATE THING THIS KIND OF SYMTAB ENTRY + JRST SSYMDL +SSYMD2: LSH B,-4 ;SHIFT SQUOZE BACK TO WHERE IT BELONGS + TLO B,ABSLCL ;SET LOCAL BIT + TLNE CH2,3SKILL + TLO B,ABSDLO ;HALF-KILL SYM + CAIL A,DEFGVR_-16 + TLC B,ABSGLO\ABSLCL ;FOR GLOBAL SYM, SET GLOBAL BIT INSTEAD OF LOCAL BIT, + CAIGE A,DEFGVR_-16 ;AND PUT IT IN THE GLOBAL BLOCK IN THE SYMTAB. + SKIPN PRGNM+BKWPB ;IF ONLY ONE BLOCK IN PROGRAM, PUT ALL SYMS IN GLOBAL BLOCK. + HRRI CH2,0 + PUSH D,B ;STORE NAME OF SYM IN OUTPUT SLOT + PUSH D,CH1 ;STORE VALUE + PUSH D,CH2 ;STORE 3RDWRD +SSYMDL: ADD AA,WPSTE1 + AOBJN AA,SSYMD1 ;LOOP FOR ALL SYMS IN TABLE + MOVSI CH2,4^5 ;1ST BIT TO SORT ON IS TOPO BIT, + MOVEI A,ST ;SORT FROM BOTTOM OOF SYMTAB + MOVEI B,1(D) ;TO WHERE WE FILLED UP TO. + MOVE CH1,[TDNE CH2,1(A)] ;SORT ON 2ND WD, WDS WITH BIT ON COME FIRST. + MOVE C,[TDNN CH2,1(B)] + JSP AA,SSYMD9 + TLC C,(TDNE#TDNN) ;ON BITS AFTER 1ST, ENTRIES WITH BIT OFF COME FIRST. + TLC CH1,(TDNE#TDNN) + MOVEI AA,SSRTX ;NEED ONLY CHANGE C, CH1 THE FIRST TIME. + JRST SSRTX + +SSYMD9: PUSHJ P,SSRTX ;SORT SYMS ARITHMETICALLY BY VALUE. + MOVNI B,(B) + ADDI B,ST ;SIZE OF AREA OF SYMTAB STILL IN USE. + IDIV B,WPSTE + HRLZI B,(B) + MOVE C,BKTABP + MOVE A,[SQUOZE 0,GLOBAL] + MOVEM A,BKTAB ;CALL THE .INIT BLOCK "GLOBAL" WHICH IS WHAT DDT WANTS AS TOP BLOCK. + IDIVI C,BKWPB ;# BLOCKS (INCL. GLOBAL BLOCK). + CAIN C,2 ;IF ONLY GLOBAL AND MAIN, TELL BKSRT TO IGNORE MAIN. + SETZM PRGNM+1 + CAIN C,2 + MOVEI C,1 ;IF ONLY GLOBAL AND MAIN, FILE WILL HAVE ONLY 1 BLOCK (GLOBAL). + MOVSI A,(C) + SUBM B,A ;-<# ENTRIES IN SYMTAB IN FILE>,, + LSH A,1 ;-<# WDS IN SYMTAB IN FILE>,, + MOVEM A,SCKSUM ;SAVE THIS. + PUSHJ P,PPB + PUSHJ P,BKCNT ;PUT -<# SYMS IN BLOCK> IN 3RD WD OF EACH BKTAB ENTRY. + +;DROPS THROUGH. + ;DROPS IN IF ABS, JUMPS HERE IF RELOC. +;NOTE THAT IN ABS ASSEMBLY, B WILL CONTAIN THE CHECKSUM AND +;SHOULD NOT BE CLOBBERED. +SSYMDR: PUSH P,B ;-<# SYMS>,,0 ;IT WILL BE -1(P) + PUSHJ P,BKSRT ;SORT BLOCKS INTO BKTAB1 + MOVE A,BKTAB + CAME A,[SQUOZE 0,GLOBAL] ;IF ABS, WE RENAMED .INIT TO GLOBAL, SO LEAVE IT IN BKTAB1 + SOS D ;ELSE FLUSH .INIT FROM THE END OF BKTAB1. + SETOM 1(D) ;PUT A -1 AT END OF BKTAB1. + MOVE B,SCKSUM ;GET CHKSUM AFTER 1SS WD. (PPBCK WILL UPDATE) + PUSH P,[-1] ;(P) WILL BE BKTAB1 IDX OF NEXT BLOCK TO OUTPUT. +SSYMD3: AOS F,(P) ;F HAS BKTAB1 IDX OF BLOCK. + SKIPGE C,BKTAB1(F) ;BKTAB1 ELT HAS BKTAB IDX OR + JRST SSYMDX ; -1 AFTER LAST BLOCK. + SKIPL LINK,CONTRL + JRST SSYMD7 ;DIFFERENT RTN TO OUTPUT BLOCK NAME IF RELOCA. + TRNE LINK,DECREL+FASL + JRST SSYMD6 ;NO BLOCKS IN DEC FMT. (OR FASL EITHER) + MOVE A,BKTAB(C) + PUSHJ P,PPBCK ;OUTPUT BLOCK NAME WITH NO FLAG BITS SET. + HLRZ A,BKTAB+1(C) + SKIPE A + ADDI A,1 ;A GETS 0 FOR GLOBAL BLOCK, ELSE DDT LEVEL (= 1 + MIDAS LEVEL). + HRL A,BKTAB+2(C) ;PUT IN -2* + ADD A,[-2,,] +SSYMG2: PUSHJ P,PPBCK ;OUTPUT -SIZE,,LEVEL WORD OF BLOCK NAME ENTRY. + JRST SSYMD6 + +SSYMD7: MOVE A,BKTAB(C) ;OUTPUT BLOCK NAME IN RELOCATABLE. + TLO A,ABSGLO ;TELL STINK IT'S BLOCK NAME. + PUSHJ P,$OUTPT + HLRZ A,BKTAB+1(C) + SUBI A,1 + PUSHJ P,$OUTPT +SSYMD6: SKIPL C,-1(P) ;AOBJN PTR TO SYMS. + JRST SSYMD3 ;IN CASE NO SYMS. +SSYMD4: HRRZ A,ST+2(C) ;OUPUT ONLY THE SYMS IN THE BLOCK + CAME A,BKTAB1(F) ;NOW BEING HANDLED. + JRST SSYMD5 + SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL + JRST SYMD2 ;SPECIAL IF RELOCA. + MOVE A,ST(C) + PUSHJ P,PPBCK ;1ST, SQUOZE WITH FLAGS. + MOVE A,ST+1(C) + PUSHJ P,PPBCK ;2ND, VALUE. +SSYMD5: ADD C,WPSTE1 + AOBJN C,SSYMD4 ;HANDLE NEXT SYM. + JRST SSYMD3 ;ALL SYMS FORR THIS BLOCK DONE, DO NEXT BLOCK. + ;PUNCH OUT LOCAL SYM (RELOCATABLE ASSEMBLY) +;NORMALLY OUTPUT SQUOZE W/ FLAGS ? VALUE, +;IF 3LLV SET OUTPUT PHONY NAME (= STE ADDR) ? SQUOZE W/ FLAGS, STINK FIXES IT UP. +SYMD2: LDB A,[400400,,ST(C)] + MOVE CH1,ST+1(C) ;SSYMDT MAY CHANGE CH1. + MOVE CH2,ST+2(C) + XCT SSYMDT(A) ;SKIPS IF SHOULD OUTPUT SYM. + JRST SSYMD5 + TLNE CH2,3KILL + JRST SSYMD5 + MOVE B,ST(C) + TLZ B,740000 + JUMPE B,SSYMD5 ;UNUSED ENTRY. + JUMPL LINK,SYMDEC ;J IF DEC OR FASL FMT + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LEFT HALF + TLNE CH2,3RLR + TLO B,100000 ;RELOCATE RIGHT HALF + TLNE CH2,3SKILL + TLO B,400000 ;HALF-KILL + MOVEI A,ST(C) + TLNE CH2,3LLV ;IF STINK HAS VALUE, + PUSHJ P,$OUTPT ;GIVE STINK NAME STINK KNOWS SYMBOL BY. + TLNE CH2,3LLV ;IF GIVING PHONY NAME, INSURE LOCAL FLAG SET + TLO B,ABSLCL ;(STINK WILL DO SO OTHERWISE) + MOVE A,B + PUSHJ P,$OUTPT ;OUTPUT SYM + MOVE A,CH1 + TLNN CH2,3LLV ;DON'T OUTPUT VALUE IF DON'T KNOW IT. + PUSHJ P,$OUTPT ;OUTPUT VALUE + JRST SSYMD5 + +SYMDEC: IFN FASLP,[ + TRNE LINK,FASL + JRST SYMFSL ;FASL ASSMBLY +] + PUSHJ P,ASQOZR ;RIGHT-JUSTIFY THE SQUOZE, + TLNE CH2,3SKILL + TLO B,ABSDLO ;MAYBE HALFKILL, + TLO B,ABSGLO + LDB A,[400400,,ST(C)] + CAIGE A,DEFGVR_-14. + TLC B,ABSGLO+ABSLCL ;LOCAL SYM, CHANGE GLO TO LCL. + MOVEM B,WRD + PUSH P,C + PUSHJ P,DECPW ;FIRST, THE NAME, + POP P,C + LDB TM,[420200,,ST+2(C)] + MOVE A,ST+1(C) ;THEN THE VALUE AND RELOCATION BITS. + PUSHJ P,DECWR1 + JRST SSYMD5 + +IFN FASLP,[ +SYMFSL: TLO B,400000 ;GET VALUE FROM SECOND WD + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LH + TLNE CH2,3RLR + TLO B,100000 + CAIL A,LGBLCB_<-18.+4> + TLO B,40000 ;GLOBAL FLAG + MOVE A,B + MOVEI B,15 ;PUTDDTSYM + PUSHJ P,FASO + MOVE A,CH1 + PUSHJ P,FASO1 + JRST SSYMD5 +] + ;XCT INDEXED ON SQUOZE FLAGS; SHOULDN'T PUNCH SYM IF DOESN'T SKIP. +SSYMDT: JFCL ;COM + JFCL ;PSEUDO OR MACRO + CAIA ;SYM, PUNCH OUT + TLNN CH2,3LLV ;LOCAL UNDEFINED, OUTPUT IF STINK HAS VALUE TO TELL STINK WHERE TO PUT IT. + TLZA CH1,-1 ;DEFINED LOCAL VARIABLE, CLEAR OUT LH(VALUE) + JFCL ;UNDEFINED LOCAL VARIABLE + SKIPL CONTRL ;DEFINED GLOBAL VARIABLE, PUNCH OUT IF ABS. + JFCL ;UNDEFINED GLOBAL VARIABLE + SKIPL CONTRL ;GLOBAL ENTRY, PUNCH OUT IF ABS ASSEM. + JFCL ;GLOBAL EXIT, DON'T PUNCH OUT +IFN .-SSYMDT-NCDBTS,.ERR SSYMDT LOSES. + +SSYMDX: SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL + JRST SSYMG3 + MOVE A,B ;ABS ASSEMBLY, OUTPUT CHKSUM. + PUSHJ P,PPB +SSYMG3: SUB P,[2,,2] + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK + SKIPL A,CONTRL ;RELOCATABLE => OUTPUT PROG NAME. + JRST SYMDA +IFN FASLP,[ + TRNE A,FASL + POPJ P, +] + TRNE A,DECREL ;DEC FMT => OUTPUT END BLOCK. + JRST PSYMSD + MOVE A,STARTA ;NOW GET STARTING INSTRUCTION + JRST PPB ;PUNCH IT OUT AND RETURN + +;PUT INTO BKTAB1 THE BKTAB IDXS OF ALL THE BLOCKS IN THE ORDER THEIR +;SYMS SHOULD BE PUNCHED (A BLOCK'S SUBBLOCKS PRECEDE IT) +;THE .INIT BLOCK (MAYBE BY NOW RENAMED "GLOBAL") GOES IN LAST. D POINTS AT WHERE IT WAS PUT. +BKSRT: MOVEI D,BKTAB1-1 ;D IS FOR PUSHING INTO BKTAB1. + MOVSI A,1 ;START WITH BLOCK 0 (OUTERMOST, .INIT). +BKSR1: SETZ C, ;HANDLE BLOCK IN A: LOOK FOR ITS SUBBLOCKS. +BKSR2: CAME A,BKTAB+1(C) + JRST BKSR3 ;THIS BLOCK ISN'T A SUBBLOCK. + ADD A,[1,,] ;LH HAS SUBBLOCK'S LEVEL. + HRRI A,(C) ;RH HAS SUBBLOCK. + PUSHJ P,BKSR1 ;HANDLE THE SUBBLOCK + MOVE A,BKTAB+1(C) +BKSR3: ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKSR2 + MOVEI C,(A) + PUSH D,C ;PUT THE BLOCK IN BKTAB1 (AFTER SUBBLOCKS) + POPJ P, + +PPBCK: ROT B,1 ;OUTPUT WD IN A, UPDATING CKSUM IN B. + ADD B,A + JRST PPB + ;THE THIRD WORD OF EACH BLOCK'S ENTRY IN BKTAB GETS THE NUMBER OF +;SYMBOLS IN THAT BLOCK (OF THE SYMBOLS THAT WE WILL PUT IN THE SYMTAB). + +BKCNT: PUSH P,B + MOVEI C,0 +BKCNT0: SETZM BKTAB+2(C) ;ZERO 3RD WD OF EACH BKTAB ENTRY. + ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKCNT0 +BKCNT1: MOVE C,ST+2(B) + SOS BKTAB+2(C) ;ADD -2 FOR EACH SYM IN THE BLOCK. + SOS BKTAB+2(C) + ADD B,WPSTE1 + AOBJN B,BKCNT1 +POPBJ: POP P,B + POPJ P, + +SSRTX: HRLM B,(P) ;DO ONE PASS OF RADIX-EXCHANGE. SAVE END. + CAIL A,@WPSTEB ;ONLY 1 ENTRY, NOTHING TO DO. + JRST SSRTX7 + PUSH P,A ;SAVE START. +SSRTX3: XCT CH1 + JRST SSRTX4 ;MOVE UP TO 1ST WITH BIT ON. + SUB B,WPSTE + XCT C ;MOVE DOWN TO LAST WITH BIT OFF. + JRST SSRTX5 + MOVE D,WPSTE + CAIE D,MAXWPS + JRST .+4 +REPEAT MAXWPS,[ + MOVE D,.RPCNT(A) ;EXCHANGE THEM, + EXCH D,.RPCNT(B) + MOVEM D,.RPCNT(A)] +SSRTX4: ADD A,WPSTE +SSRTX5: CAME A,B ;ALL DONE => DO NEXT BIT. + JRST SSRTX3 ;MORE IN THIS PASS. + ROT CH2,-1 ;NEXT BIT DOWN. + POP P,A ;A -> START, B -> END OF 1ST HALF. + JUMPL CH2,SSRTX6 ;ALL BITS IN WD DONE, STOP. + PUSHJ P,(AA) ;DO NEXT BIT ON 1ST HALF. + HLRZ B,(P) ;A -> END OF 1ST HALF, B -> END OF ALL. + PUSHJ P,(AA) ;DO SECOND HALF. +SSRTX6: ROT CH2,1 ;LEAVE CH2 AS FOUND IT. +SSRTX7: HLRZ A,(P) ;LEAVE A -> END OF AREA SORTED. + POPJ P, + ;ARITHMETIC CONDITIONALS (B HAS JUMP A,) + +COND: PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,AGETFD ;GET FIELD TO TEST VALUE OF +CONDPP: POP P,T ;RESTORE CONDITIONAL JUMP INSTRUCTION + HRRI T,COND2 ;HRRI IN JUMP ADDRESS, GO TO COND2 IF CONDITIONAL TRUE + XCT T ;JUMP IF COND T,ASSEMBLE STRING +COND4: SETZM A.SUCC ;MOST RECENT CONDIT. FAILED. +COND5: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WHAT PSEUDO WE'RE IN. + CALL RCH + JSP D,RARL4 ;INIT FOR THE CONDITIONALIZED STUFF. + CAIA + CALL RARFLS ;READ AND IGNORE THE ARG. + JRST MACCR + +ANULL: TLO FF,FLUNRD + JRST COND5 + +;.ELSE, .ALSO - B'S LH WILL HAVE SKIPE OR SKIPN. +A.ELSE: HRRI B,A.SUCC + XCT B + JRST COND4 ;CONDITION FALSE. + JRST COND2 ;TRUE. + +;IF1, IF2 - B'S LH WILL HAVE TRNE FF, OR TRNN FF, +COND1: HRRI B,FRPSS2 + XCT B + JRST COND4 ;NO + ;CONDITION TRUE, ASSEMBLE STRING +COND2: SETOM A.SUCC ;LAST CONDITIONAL SUCCEEDED. +COND6: PUSHJ P,RCH ;GET NEXT CHAR + CAIE A,LBRKT + JRST [ CAIE A,LBRACE + TLO FF,FLUNRD + JRST MACCR] + SKIPN SCNDEP ;BRACKET TYPE CONDITIONAL. + SKIPE CONDEP + JRST COND7 + MOVEMM CONDLN,CLNN ;AT TOP LEVEL, SAVE IN CASE THIS UNTERMINATED + MOVEMM CONDPN,CPGN +IFN TS, MOVEMM CONDFI,INFFN1 +COND7: AOS SCNDEP ;COUNT IT FOR RBRAK'S SAKE. + JRST MACCR + ;IFB, IFNB + +SBCND: PUSH P,B ;SAVE TEST JUMP + SETZB B,C ;C COUNTS SQUOZE CHARS FOR IFB/IFNB + ;B COUNTS NONSQUOZE FOR IFSQ/IFNSQ + JSP D,RARG ;INIT FOR READING OF ARG WHOSE BLANKNESS + JRST CONDPP ;IS TO BE TESTED. + JSP D,RARGCH(T) ;READ 1 CHAR, + JRST CONDPP ;(NO MORE CHARS) + HLRZ A,GDTAB(A) ;GET GDTAB ENTRY + CAIE A,(POPJ P,) ;POPJ => NOT SQUOZE + AOJA C,RARGCH(T) + AOJA B,RARGCH(T) + + ;IFDEF, IFNDEF + +DEFCND: SAVE SYM + PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + PUSHJ P,ES + MOVEI A,0 ;UNDEFINED +IFN CREFSW,XCT CRFINU + CAIN A,GLOEXT_-14. ;GLOBAL EXIT... + SKIPL CONTRL ;DURING ABSOLUTE ASSEMBLY? + CAIN A,3 ;NO, LOCAL UNDEF? + MOVEI A,0 ;ONE OF THESE => UNDEF + REST SYM + EXCH SYM,(P) ;POP SYM OUT FROM UNDER THE CONDITIONAL JUMP. + JRST CONDPP + ;;PWRD ;ROUTINES TO OUTPUT ASSEMBLES WORDS AND PORTIONS THEREOF + + ;HERE FROM PBITS TO OUTPUT WORD OF CODE BITS + +PBITS3: PUSH P,A + MOVEI A,14 + MOVEM A,PBITS2 ;INITIALIZE PBITS2 FOR COUNTING DOWN THROUGH NEXT SET OF CODE BITS + MOVE A,[440300,,PBITS1] + MOVEM A,BITP ;SET UP BITP FOR RELOADING PBITS1 WITH CODE BITS + MOVE A,PBITS1 ;NOW GET ACCUMULATED WORD OF BITS + MOVEM A,@PBITS4 ;STORE IN BKBUF + AOS A,OPT1 ;RESERVE SPACE FOR NEW WORD + ;IF FRBIT7 SET (LAST CALL TO PBITS HAD 7) THEN NEXT WORD OF CODE BITS GOES + ;AFTER NEXT WORD OUTPUT (REALLY!), OTHERWISE BEFORE + TRNN FF,FRBIT7 + SOSA A + TRO FF,FRINVT + HRRZM A,PBITS4 + POP P,A + CLEARM PBITS1 + ;DROPS THROUGH + ;OUTPUT RELOCATION CODE BITS IN A + +PBITS: SKIPGE CONTRL + POPJ P, ;NOT RELOCATABLE + SOSGE PBITS2 + JRST PBITS3 ;NO MORE ROOM IN WORD, OUTPUT IT AND TRY AGAIN + CAIN A,7 + TROA FF,FRBIT7 + TRZ FF,FRBIT7 + IDPB A,BITP + POPJ P, + + ;FOLLOWING ROUTINES SAVE AC'S EXCEPT FOR A + +OUTSM0: MOVE A,SYM ;OUTPUT NAME STINK KNOWS SYMBOL BY. + TLZ A,37777 ;FOR LOCALS, THAT'S THE STE ADDR, + HRRI A,ST(D) + TLNN SYM,40000 ;FOR GLOBALS, THAT'S THE SQUOZE. + JRST $OUTPT +OUTSM: SKIPA A,SYM +OUTWD: MOVE A,WRD +$OUTPT: SKIPGE CONTRL ;DIRECTLY PUNCH OUT WORD IN A IN RELOCATABLE ASSEMBLY ONLY + POPJ P, ;DO NOTHING IF ABSOLUTE ASSEMBLY + PUSH P,AA + MOVE AA,OPT1 + TRZN FF,FRINVT ;SKIP IF BEING HACKED FROM PBITS3, PUT WORD BEFORE WHERE IT NORMALLY BELONGS + AOS AA + MOVEM A,-1(AA) + MOVE A,CLOC + TRZE FF,FRFIRWD + HRRM A,BKBUF + POP P,AA + AOS A,OPT1 + CAIL A,BSIZE+BKBUF + TRNE I,IRCONT + POPJ P, + ;MAY DROP THROUGH + ;END CURRENT OUTPUT BLOCK + +EBLK: PUSH P,T + PUSH P,TT + PUSH P,A + PUSH P,B + MOVE T,CONTRL + JUMPGE T,EBLK3 ;JUMP IF RELOCATABLE ASSEMBLY + TRNE T,ARIM10\SBLKS + JRST ESBLK +IFN FASLP,[ + TRNE T,FASL + JRST FASLE ;FASL HAS NO BLOCKS TO END - IGNORE +] + TRNE T,DECREL + JRST DECEBL + JRST EBLK5 + +EBLK3: MOVE T,PBITS1 + MOVEM T,@PBITS4 + MOVEI T,PBITS4 + MOVEM T,PBITS4 + MOVE T,[440300,,PBITS1] + MOVEM T,BITP + CLEARB TT,PBITS2 + CLEARM PBITS1 + MOVEI T,BKBUF + MOVE B,OPT1 ;GET POINTER TO END OF BLOCK + SUBI B,BKBUF+1 ;CONVERT TO # WORDS IN BLOCK (EXCLUDING HEADER) + DPB B,[220700,,BKBUF] ;SET COUNT FIELD IN HEADER + TRZN FF,FRLOC + JUMPLE B,EBLK5 ;IGNORE NULL BLOCK UNLESS FRLOC SET + TLO FF,$FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) + PUSHJ P,FEED +EBK1: CAML T,OPT1 ;DONE WITH BLOCK? + JRST EBK2 ;YES + MOVE A,(T) ;NO, GET DATA WORD + JFCL 4,.+1 ;UPDATE CHECKSUM + ADD TT,A + JFCL 4,[AOJA TT,.+1] + PUSHJ P,PPB ;OUTPUT WORD + AOJA T,EBK1 +EBK2: SETCM A,TT ;DONE OUTPUTTING BLOCK, NOW GET CHECKSUM + PUSHJ P,PPB ;OUTPUT CHECKSUM + MOVE T,CDATBC ;GET BLOCK TYPE + DPB T,[310700,,BKBUF] ;SET NE T BLOCK TYPE TO STORAGE WORDS BLOCK TYPE + MOVEI T,BKBUF+1 + MOVEM T,OPT1 +EBLK4: TLO FF,$FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) +EBLK5: TRO FF,FRFIRWD +FASLE: POP P,B + POP P,A +PTT.TJ: POP P,TT + POP P,T + POPJ P, + ;PUNCH OUT WORD OF CODED DATA (E.G. STORAGE WORD); WRD, WRDRLC, GLOTB ENTRIES + +PWRDA: TROA FF,FRNLIK ;SUPPRESS ADR LINKING +PWRD: TRZ FF,FRNLIK ;PERMIT ADR LINKING + JUMPGE FF,CPOPJ ;IGNORE IF NOT PUNCHING PASS +IFN LISTSW,[ + SKIPN LSTONP + JRST PWRDL ;NOT MAKING LISTING NOW. + SKIPGE LISTPF + PUSHJ P,PNTR + SETOM LISTPF + MOVE LINK,WRD + MOVEM LINK,LISTWD + MOVE LINK,WRDRLC + MOVEM LINK,LSTRLC + MOVE LINK,CLOC + MOVEM LINK,LISTAD + MOVE LINK,CRLOC + DPB LINK,[220100,,LISTAD] +PWRDL: +] ;END IFN LISTSW, + SKIPGE LINK,CONTRL + JRST PWRD1 ;ABSOLUTE ASSEMBLY + ;RELOCATABLE ASSEMBLY + PUSHJ P,$RSET ;CHECK VALIDITY OF RELOCATION, STANDARDIZE IF NON-STANDARD + MOVE A,GLSP2 + CAMN A,GLSP1 + JRST PWRD2 ;NO GLOBALS + + ;NOW TO SEE IF IT'S POSSIBLE OR DESIRABLE TO ADDRESS LINK + + HRLZ B,WRD + HRR B,WRDRLC + JUMPN B,PWRD3 ;JUMP IF RH NON-ZERO + TRNN FF,FRNLIK + SKIPGE GLOCTP + JRST PWRD3 ;ADR LINKING SUPPRESSED OR CLOC GLOBAL + SKIPE LDCCC + JRST PWRD3 ;IN LOAD TIME CONDITIONALS + MOVNI T,1 ;INITIALIZE T FOR COUNTING +PWRD4: CAML A,GLSP1 + JRST PWRD5 ;DONE + HRRZ TT,1(A) ;GET GLOTB ENTRY + JUMPE TT,PWRD7A + LDB TT,[400400,,(TT)] ;GET SQUOZE FLAGS FROM SYM + CAIE TT,DEFGVR_-14. + CAIN TT,GLOETY_-14. + JRST PWRD3 ;DEFINED, BUT MUST BE HERE FOR A REASON (SEE $.H) + HLRZ TT,1(A) + TRNE TT,1777+MINF + JRST PWRD3 ;NEGATED OR MULTIPLIED + TRNE TT,HFWDF + JRST PWRD7 + TRNE TT,ACF + TRNN TT,SWAPF + JRST PWRD3 ;NOT HIGH AC +PWRD7A: AOJA A,PWRD4 +PWRD7: TRNE TT,SWAPF + AOJA A,PWRD4 ;LEFT HALF + AOJN T,PWRD3 ;JUMP IF THIS NOT FIRST GLOBAL IN RIGHT HALF + MOVEI D,1(A) ;FIRST GLOBAL, SET UP POINTER TO GLOTB ENTRY + AOJA A,PWRD4 + PWRD5: AOJE T,PWRD3 ;NO GLOBALS LOOK BAD AND THERE AREN'T TOO MANY; JUMP IF NONE IN RH + HRRZ T,(D) ;GET ADR OF SQUOZE + SKPST T, ;SKIP IF IN SYMBOL TABLE + JRST PWRD3 ;BELOW SYMBOL TABLE, DON'T ADDRESS LINK AFTER ALL + PUSH P,T ;HOORAY, WE CAN ADDRESS LINK + SETZM (D) ;CLEAR OUT GLOTB ENTRY, DON'T NEED IT ANY MORE + PUSHJ P,PWRD31 ;DUMP OUT THE OTHER GLOBALS + POP P,D ;GET ST ADR OF THIS AGAIN + 3GET1 A,D + LDB A,[.BP (3RLNK),A] + MOVE B,WRDRLC + TLNE B,1 + TRO A,2 ;RELOCATE LEFT HALF + PUSHJ P,PBITS ;PUNCH OUT APPROPRIATE BITS FOR LINK LIST ENTRY + HLR A,1(D) ;GET ADR OF LAST + HLL A,WRD + PUSHJ P,$OUTPT ;OUTPUT WORD WITH RH = ADR OF LAST RQ FOR SYM TO PUT IN RH'S + MOVE A,CLOC ;NOW UPDATE ST ENTRY + HRLM A,1(D) + 3GET1 B,D + SKIPN CRLOC + TLZA B,3RLNK ;CLOC NOT RELOCATED LAST TIME THIS SYM USED + TLO B,3RLNK ;RELOCATED + 3PUT1 B,D + POPJ P, + PWRD31: MOVE T,GLSP2 ;DUMP ALL GLO S IN GENERAL FORMAT +PWRD3A: CAML T,GLSP1 + POPJ P, + MOVE B,1(T) + TRNN B,-1 + AOJA T,PWRD3A + TLNE B,1777 + JRST RPWRD ;REPEAT +RPWRD1: LDB A,[.BP (MINF),B] + TRO A,4 + PUSHJ P,PBITS + MOVE A,(B) ;CODEBITS +SQUOZE FOR SYM + HLRZ C,A + TLZ A,740000 + CAIL C,DEFGVR + TLOA A,40000 ;SYM IS GLO + JRST [ MOVEI C,(B) ;IF WE ARE OUTPUTTING A REFERENCE TO THE + CAIL C,PCNTB ;"LABEL" AT THE BEGINNING OF A CONSTANTS AREA + CAIL C,PCNTB+NCONS*3 ;(BECAUSE THIS IS A 1PASS ASSEMBLY) USE THE + MOVEI A,(B) ;NAME, SINCE THE SYMBOL ISN'T IN THE + JRST .+1] ;SYMTAB + TLNE B,SWAPF + TLO A,400000 + TLNE B,ACF + JRST PWRD3E ;AC HIGH OR LOW + TLNN B,HFWDF + JRST PWRD3F ;ALL THROUGH + TLO A,100000 + TLNE B,SWAPF + TLC A,300000 +PWRD3F: PUSHJ P,$OUTPT + AOJA T,PWRD3A + + + +RPWRD: PUSHJ P,PBITS7 + MOVEI A,CRPT + PUSHJ P,PBITS + LDB A,[221200,,B] + PUSHJ P,$OUTPT + JRST RPWRD1 + +PWRD3E: TLO A,300000 + JRST PWRD3F + +PWRD3: PUSHJ P,PWRD31 +PWRD2: PUSHJ P,RCHKT + HRRZ A,B + DPB T,[10100,,A] + PUSHJ P,PBITS + JRST OUTWD + ;CHECK FOR VALIDITY OF RELOCATION BITS OF CURRENT WORD +;LEAVE RELOC (RH) IN B, RELOC (LH) IN T + +RCHKT: HRRZ B,WRDRLC ;CHECK FOR RELOC. OTHER THAN 0 OR 1. + HLRZ T,WRDRLC + TRZN B,-2 + TRZE T,-2 +RLCERR: ETSM [ASCIZ /Illegal relocation/] + POPJ P, + +RMOVET: ROT T,-1 + DPB B,[420100,,T] + TLZ C,3DFCLR ;SET RELOC BITS IN C + IOR C,T ;FROM B AND T. + POPJ P, + + ;CHECK WRDRLC FOR VALIDITY (CAPABILITY OF BEING PUNCHED OUT) + ;IF STANDARD THEN JUST RETURN + ;IF NON-STANDARD BUT OTHERWISE OK, PUT $R. ON GLOBAL LIST, RESET WRDRLC, AND RETURN + ;LEAVES B AND C SET UP WITH RH, LH OF WRDRLC. + +$RSET: MOVE C,WRDRLC ;GET RELOCATION + ADDI C,400000 ;WANT TO SEPARATE HALFWORDS + HLRE B,C ;GET LH IN B + HRREI C,400000(C) ;GET RH IN C (WILL EXCHANGE LATER) + MOVE A,[SWAPF+HFWDF,,$R.H] ;PUT THIS ON GLOBAL LIST IF LH NEEDS $R. + TRNE B,-2 ;CHECK LH + PUSHJ P,$RSET1 ;LH NEEDS GLOBAL REFERENCE + EXCH B,C + HRLI A,HFWDF + TRNE B,-2 ;CHECK RH + PUSHJ P,$RSET1 ;RH NEEDS GLOBAL REFERENCE + HRLZM C,WRDRLC ;RELOC OF LH + ADDM B,WRDRLC ;COMPLETE SETTING UP WRDRLC + POPJ P, + +$RSET1: JUMPGE B,$RSET2 ;STRANGE RELOCATION IN B, JUMP IF NON-NEGATIVE + MOVN T,B ;NEGATIVE, GET MAGNITUDE + TLOA A,MINF ;SET FLAG TO NEGATE GLOBAL +$RSET2: SOSA T,B ;POSITIVE, GET ONE LESS THAN IT IN T + TDZA B,B ;NEGATIVE, CLEAR B, RELOCATION LEFT OVER + MOVEI B,1 ;POSITIVE, SET RELOCATION LEFT OVER TO 1 + CAIN T,1 + MOVEI T,0 ;MULTIPLYING BY TWO OR SUBTRACTING TIMES 1 + TRNE T,-2000 + ETSM [ASCIZ /Relocation too large/] ;TOO BIG EVEN FOR $RSET + DPB T,[221200,,A] ;LOOKS OK, STORE TIMES FIELD IN $R. REFERENCE + AOS GLSP1 ;NOW PUT $R. ON GLOBAL LIST + MOVEM A,@GLSP1 + POPJ P, + ;PWRD DURING ABSOLUTE ASSEMBLY + +PWRD1: TRNE LINK,DECREL ;DEC FMT IS CONSIDERED ABSOLUTE. + JRST DECPW +IFN FASLP,[ + TRNE LINK,FASL + JRST FASPW ;SO IS FASL +] + MOVE A,GLSP1 + CAME A,GLSP2 + ETR ERRILG ;GLOBALS APPEARING ILLEGALLY + SKIPE WRDRLC + ETR ERRIRL ;RELOCATION APPEARING ILLEGALLY + TRNE LINK,ARIM + JRST PRIM ;RIM +SBLKS1: MOVE A,WRD ;SBLK + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FRFIRWD + MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER + AOS A,OPT1 + CAIGE A,BKBUF+BSIZE + POPJ P, ;BKBUF NOT FULL YET + +SBLKS2: SUBI A,BKBUF+1 + JUMPE A,CPOPJ + MOVNS A + HRLM A,BKBUF + PUSHJ P,FEED + MOVEI T,BKBUF + CLEARM SCKSUM +SBLK1: CAML T,OPT1 + JRST SBLK2 + MOVE A,SCKSUM + ROT A,1 + ADD A,(T) + MOVEM A,SCKSUM + MOVE A,(T) + PUSHJ P,PPB + AOJA T,SBLK1 + +SBLK2: TRO FF,FRFIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,SCKSUM + JRST PPB + +ESBLK: MOVE A,OPT1 + CAIN A,BKBUF+1 + JRST EBLK5 ;AVOID SETTING $FLOUT IF NULL BLOCK. + PUSHJ P,SBLKS2 + JRST EBLK4 + +PRIM: MOVSI A,(DATAI PTR,) + HRR A,CLOC + PUSHJ P,PPB + MOVE A,WRD + JRST PPB + ;END A BLOCK IN DEC FMT. COME FROM EBLK. +DECEBL: PUSH P,[EBLK5] +DECEB1: MOVSI A,DECWDS ;JUST INIT. AN ORDINARY BLOCK, + +;COME HERE TO OUTPUT PREVIOUS BLOCK AND START NEW BLOCK OF TYPE IN LH OF A. +DECBLK: PUSH P,A + HRRZ A,BKBUF ;GET DATA-WORD COUNT OF CURRENT BLOCK. + JUMPE A,DECB1 ;NO WORDS => CAN IGNORE. + MOVEI TT,BKBUF+1 +DECB0: MOVE A,-1(TT) ;GET AND PUNCH NEXT WD OF BLOCK. + PUSHJ P,PPB + CAME TT,OPT1 ;STOP WHEN NEXT WD ISN'T IN BLOCK. + AOJA TT,DECB0 +DECB1: POP P,A + HLLZM A,BKBUF ;PUT BLOCK TYPE IN LH OF HEADER, DATA WD COUNT IN RH IS 0. + MOVEI TT,BKBUF+2 ;ADDR OF PLACE FOR 1ST DATA WD + MOVEM TT,OPT1 ;(LEAVE SPACE FOR WD OF RELOC BITS) + MOVE TT,[440200,,BKBUF+1] + MOVEM TT,BITP ;BP FOR STORING PAIRS OF RELOC BITS. + SETZM BKBUF+1 ;CLEAR THE WD OF RELOC BITS. + TLO FF,$FLOUT + POPJ P, + +;COME HERE TO OUTPUT A WORD IN DEC FORMAT. +DECPW: MOVS A,BKBUF + CAIE A,DECWDS ;BEFORE THE 1ST STORAGE WD IN ORDINARY BLOCK, + JRST DECPW0 + MOVE A,CRLOC ;MUST GO THE LOCATION CTR. + IDPB A,BITP + MOVE A,CLOC + MOVEM A,@OPT1 + AOS OPT1 + AOS BKBUF ;IT COUNTS AS DATA WORD. +DECPW0: MOVE A,BITP + TLNE A,77^4 ;IF NO ROOM FOR MORE RELOC BITS, + JRST DECPW1 + HLLZ A,BKBUF ;START A NEW BLOCK. + PUSHJ P,DECBLK + JRST DECPW + +DECPW1: PUSHJ P,$RSET ;SET UP RELOC BITS OF HALVES IN B,C. + LSH C,1 + IORI B,(C) ;COMBINE THEM. + MOVE A,GLSP1 + CAME A,GLSP2 + JRST DECPG ;GO HANDLE GLOBALS. +DECPW3: IDPB B,BITP ;STORE THE RELOC BITS + MOVE A,WRD +DECPW2: MOVEM A,@OPT1 ;AND THE VALUE. + AOS OPT1 + AOS BKBUF + POPJ P, + ;PUT A WORD DIRECTLY INTO DEC FMT BLOCK. +DECWRD: SETZ TM, +DECWR1: IDPB TM,BITP ;SKIP A PAIR OF RELOC BITS, + JRST DECPW2 ;STORE THE WORD. + +;HANDLE GLOBAL REFS IN DEC FMT. +DECPG: PUSHJ P,DECPW3 ;FIRST, OUTPUT THE WORD, +DECPG0: MOVSI A,DECSYM + PUSHJ P,DECBLK ;THEN STRT A SYMBOLS BLOCK. + MOVE C,GLSP2 + SAVE SYM +DECPG1: CAMN C,GLSP1 ;ALL DONE => + JRST DECPG2 ;GO START AN ORDINARY BLOCK FOR NEXT WD. + MOVE A,BITP + TLNN A,77^4 ;BLOCK FULL => START ANOTHER. + JRST DECPG0 + AOS C,GLSP2 ;GET ADDR OF NEXT GLOBAL REF. + MOVE B,(C) + MOVE B,(B) ;GET NAME OF SYM. + TLZ B,740000 + CAMN B,[SQUOZE 0,$R.] + JRST DECPG3 ;(DEC'S LOADER HAS NO SUCH HACK.) + CALL ASQOZR ;RIGHT-JUSTIFY THE SQUOZE FOR DEC SYSTEM. + MOVE A,B + TLO A,600000 ;PUT IN FLAGS SAYING ADDITIVE GLOBAL RQ. + PUSHJ P,DECWRD ;OUTPUT NAME. + HRRZ A,CLOC ;GET ADDR OF RQ, + TLO A,400000 ;MACRO-10 SETS THIS BIT SO I WILL. + MOVE B,(C) + TLNE B,SWAPF ;SWAPPED => TELL LOADER.. + TLO A,200000 + TLNE B,ACF+MINF + ETSM ERRILG ;CAN'T NEGATE GLOBAL OR PUT IN AC. + MOVE TM,CRLOC + PUSHJ P,DECWR1 ;OUTPUT 2ND WD, + JRST DECPG1 ;GO BACK FOR MORE GLOBAL REFS. + +DECPG2: REST SYM + JRST DECEB1 + +DECPG3: ETR ERRIRL ;WE NEEDED $R. BUT DIDN'T HAVE IT. + JRST DECPG1 + +ERRILG: ASCIZ /Illegal use of external/ +ERRIRL: ASCIZ /Illegal use of relocatables/ + + +;OUTPUT PROGRAM NAME BLOCK (AT START OF PASS 2) +;IF 2-SEG PROGRAM, ALSO OUTPUT A TYPE-3 BLOCK (LOAD INTO HISEG) +DECPGN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2. + SAVE [EBLK] + MOVSI A,DECNAM + CALL DECBLK + MOVE B,PRGNM + CALL ASQOZR + MOVE A,B + CALL DECWRD + MOVSI A,14 ;IDENTIFY THIS REL FILE AS MADE BY MIDAS. + CALL DECWRD + MOVE A,DECTWO + CAMN A,[MOVE] + RET ;NOT A 2-SEG PROGRAM. +DECP2S: MOVSI A,DECHSG + CALL DECBLK ;START A LOAD-INTO-HISEG BLOCK. + MOVE A,DECTWO + HRL A,DECBRH ;HISEG BRK,,TWOSEG ORIGIN. + SKIPL A + HRLI A,(A) + MOVEI TM,1 ;RELOCATION IS 1. + JRST DECWR1 + IFN FASLP,[ +;INITIALIZE OUTPUT FOR FASL ASSEMBLY +FASOIN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2 + MOVE A,[SIXBIT /*FASL*/] + PUSHJ P,PPB + MOVE A,[MIDVRS] + LSH A,-6 + TLO A,(SIXBIT /M/) + PUSHJ P,PPB ;"LISP" VERSION NUMBER (USE M AND MIDAS NUMBER) + MOVE A,[440400,,FASB] ;INITIALIZE FASL OUTPUT BUFFER + MOVEM A,FASCBP + MOVEI A,FASB+1 + MOVEM A,FASBP + POPJ P, + + +;COME HERE TO OUTPUT A WORD IN FASL FORMAT +FASPW: MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;"PUNCH" OUT ATOM TBL (IF MORE HAS APPEARED) + PUSHJ P,$RSET ;GET RELOC + PUSH P,C ;SAVE LH RELOC + MOVEM B,FASPWB ;B HAS RELOC, WHICH IS ALSO FASL CODE FOR RELOC =1 + MOVE A,GLSP2 +FASPW3: CAME A,GLSP1 + JRST FASPW1 ;LOOK TO SEE .. +FASPW2: MOVE A,WRD ;B HAS RELOC, WHICH ALSO HAPPENS TO BE FASL CODE TYPE + MOVE B,FASPWB + PUSHJ P,FASO ;OUTPUT WORD IN A WITH FASL CODE IN B + POP P,TM + JUMPE TM,FASPW5 ;NO LEFT HALF RELOC, OK + MOVNI A,1 ;ACTIVATE FASL HACK FOR LH RELOC + MOVEI B,7 ;WOULD OTHERWISE BE GETDDTSYM + PUSHJ P,FASO +FASPW5: MOVE C,GLSP2 +FASPW6: CAMN C,GLSP1 + POPJ P, + HRRZ TM,1(C) + JUMPE TM,[AOJA C,FASPW6] + MOVE SYM,(TM) ;GET SQUOZE OF SYM + TLZ SYM,740000 ;CLEAR CODE BITS + HLRZ D,1(C) + TRZ D,400000 ;DONT WORRY ABOUT THAT BIT + TRZE D,MINF + TLO SYM,400000 ;NEGATE + CAIN D,SWAPF + JRST FSPWSW + CAIN D,HFWDF + JRST FSPWRH + CAIN D,ACF+SWAPF + JRST FSPWAC + JUMPE D,FSPWWD + ETSM [ASCIZ /Global in illegal FASL context/] + +FSPWWD: TLOA SYM,140000 +FSPWAC: TLOA SYM,100000 +FSPWRH: TLO SYM,40000 +FSPWSW: MOVE A,SYM + MOVEI B,7 ;DDT SYM + PUSHJ P,FASO + AOJA C,FASPW6 + +FASPW1: HRRZ TM,1(A) ;GLOTB ENTRY + JUMPE TM,FASPW4 + CAIL TM,AFDMY1 + CAIL TM,AFDMY2 +FASPW4: AOJA A,FASPW3 + MOVE C,1(A) ;ITS A LIST STRUCTURE REF + TLNN C,-1-HFWDF + SKIPE FASPWB + ETA [ASCIZ /Illegal LISP structure reference/] + MOVE TM,AFDMY2-AFDMY1(TM) ;GET FASL BITS + MOVEM TM,FASPWB ;FASL BITS + CLEARM 1(A) ;FLUSH THAT GUY + AOJA A,FASPW3 + +FPATB: CAMN C,FASATP ;PUNCH OUT ATOM TBL, AMT ALREADY PUNCHED IN C + POPJ P, ;THRU + MOVEI B,12 ;ATOM TBL INFO + MOVE A,FASAT(C) + TRNN A,-1 + AOJA C,FPATB3 ;LIST WORD .. SHOULD HAVE PUNCHED ITSELF + PUSHJ P,FASO + HRRZ D,FASAT(C) ;ATOM "LENGTH" + AOS C +FPATB1: SOJL D,FPATB2 + MOVE A,FASAT(C) + PUSHJ P,FASO1 + AOJA C,FPATB1 + +FPATB3: ETR [ASCIZ /Internal loss at FPATB3/] +FPATB2: MOVEM C,FASPCH ;RECORD AMOUNT PUNCHED + JRST FPATB ;LOOP BACK IF MORE + + +FASO: PUSHJ P,FASBO ;WRITE BITS +FASO1: MOVEM A,@FASBP ;STORE A IN FASL OUTPUT BUFFER + AOS TM,FASBP + CAIL TM,FASB+FASBL + ETF [ASCIZ /.FASL output block too long/] + POPJ P, + +FASBO: MOVE TM,FASCBP ;OUTPUT FASL CODEBITS IN B, WRITE PREV BLOCK IF NECC + TLNN TM,770000 + PUSHJ P,FASBE ;WRITE PREV FASL BLOCK + IDPB B,FASCBP + POPJ P, + +FASBE: PUSH P,A + PUSH P,B + MOVEI TT,FASB +FASBO2: CAML TT,FASBP + JRST FASBO3 + MOVE A,(TT) + PUSHJ P,PPB + AOJA TT,FASBO2 + +FASBO3: POP P,B + POP P,A + CLEARM FASB ;NEW CODE WORD + MOVEI TM,FASB+1 + MOVEM TM,FASBP + SOS FASCBP + POPJ P, + AFATOM: PUSH P,B ;SAVE CODEBITS + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ATOM illegal except in FASL assembly/] + PUSHJ P,AFRATM ;READ "ATOM", RETURN INDEX IN A + POP P,B + HLRZS B +AFLST1: AOS GLSP1 + MOVEI T,AFDMY1(B) ;DUMMY (STORE THIS INFO IN SYM SO CONSTANTS WILL WIN + HRRZM T,@GLSP1 + MOVEI B,0 ;NO RELOCATION + POPJ P, + +;GLOBALS IN THIS TABLE KEEP TRACK OF LIST REFS +;UNDEF GLOBAL GODEBITS +AFDMY1: SQUOZE 44,.%VCEL ;EVENTUALLY POINT TO VALUE CELL + SQUOZE 44,.%SCAL ;EVENTUALLY BECOME "SMASHABLE CALL" + SQUOZE 44,.%ATM ;EVENTUALLY POINT TO ATOM + SQUOZE 44,.%ARY ;EVENTUALLY POINT TO ARRAY +AFDMY2: 2 ;CODE BITS FOR VALUE CELL REF + 3 ;CODE BITS FOR SMASHABLE CALL + 4 ;CODE BITS FOR POINTER TO ATOM + 10 ;CODE BITS FOR POINTER TO ARRAY + +AFRATM: PUSHJ P,AFRTKN ;READ TOKEN, LEAVING IT AT END OF FASAT + PUSHJ P,AFRITN ;"INTERN" IT, SKIP IF NOT FOUND + POPJ P, ;IF FOUND, INDEX IN A + PUSHJ P,AFRENT ;ENTER IN FASAT + POPJ P, + +AFRENT: MOVE A,FASAT1 ;STORE FASAT1 IN FASATP + MOVEM A,FASATP + AOS A,FASIDX ;RETURN LOAD TIME ATOM INDEX + POPJ P, + +AFRTKN: MOVE A,FASATP + ADD A,[700,,FASAT] + MOVEM A,FASAT2 ;BYTE PNTR TO USE TO STORE ATOM + CLEARM (A) + CLEARM 1(A) ;MAKE SURE ALL LOW BITS CLEARED + PUSHJ P,RCH + CAIN A,"# + JRST AFRTK1 ;READ NUMBER INTO FIXNUM SPACE + CAIN A,"& + JRST AFRTK2 ;READ NUMBER INTO FLONUM SPACE +AFRTKL: IDPB A,FASAT2 ;STORE CHAR + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 +AFTERR: ETA [ASCIZ /LISP atom name table full/] + CLEARM 1(A) +AFRTL2: PUSHJ P,RCH + CAIN A,12 + JRST AFRTL2 ;IGNORE LF IN ATOM NAMES (PRIMARILY SO /CR WINS WITH ONE + CAIN A,"/ ;SLASH + JRST AFRQT ;QUOTE CHAR + CAIE A,40 + CAIN A,15 + JRST AFREND + CAIE A,"; + CAIN A,11 + JRST AFREND + CAIE A,"( + CAIN A,") + JRST AFREN2 + CAIL A,"A+40 + CAILE A,"Z+40 + JRST AFRTKL ;THAT CHAR WINS, SALT IT + SUBI A,40 + JRST AFRTKL ;MAYBE MUST CONVERT TO L.C. BEFORE SALTING IT. + +AFRQT: PUSHJ P,RCH ;TAKE NEXT CHR NO MATTER WHAT + JRST AFRTKL + +AFRTK1: SKIPA TM,[100000,,1] ;PUT VAL IN FIXNUM SPACE +AFRTK2: MOVE TM,[200000,,1] ;PUT IT IN FLONUM SPACE + PUSH P,TM + MOVE SYM,[SQUOZE 0,ATOM] + PUSHJ P,FAGTFD + POP P,TM + MOVE B,FASATP + ADDI B,2 + CAIL B,FASAT+FASATL + XCT AFTERR + MOVEM TM,FASAT-2(B) + MOVEM A,FASAT-1(B) + MOVEM B,FASAT1 + POPJ P, + +AFREN2: TLO FF,FLUNRD ;SAVE ( OR ) AS WELL AS FLUSHING +AFREND: MOVEI B,5 ;PAD END OF P.N. WITH 0 S + MOVEI TM,0 +AFREN1: IDPB TM,FASAT2 + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 + XCT AFTERR + CLEARM 1(A) + SOJG B,AFREN1 + SUBI A,FASAT + MOVEM A,FASAT1 ;STORE PNTR TO WORD BEYOND ATOM + ; MAYBE PUT THIS IN FASATP + MOVE B,FASATP ;ADR OF START OF ATOM READ + SUBI A,1(B) ;COMPUTE LENGTH OF FASAT + HRRZM A,FASAT(B) ;PN ATOM 4.8-4.7 =0 STORE LENGTH IN HEADER WD + + POPJ P, + +AFRITN: MOVEI B,0 ;"INTERN" LAST ATOM READ IN + MOVEI A,1 ;A CONTAINS RUNTIME ATOM TBL INDEX + ;B INDEX WITHIN FASAT +AFRIT1: CAML B,FASATP + JRST POPJ1 ;NOT FOUND + MOVE C,FASATP ;POINTS AT HEADER OF WORD OF NEW (?) ATOM + HRRZ D,FASAT(B) ;HEADER WD OF GUY IN TBL(RIGHT HALF HAS LENGTH) + JUMPE D,AFRIT4 ;JUMP ON RESERVED FOR LIST +AFRIT2: MOVE TM,FASAT(C) + CAME TM,FASAT(B) + AOJA B,AFRIT3 ;THIS ONE LOSES + SOJL D,CPOPJ ;THIS ONE WINS! + AOS B + AOJA C,AFRIT2 + +AFRIT3: SOJL D,[AOJA A,AFRIT1] ;FINISH SPACING OVER THIS GUY +AFRIT4: AOJA B,AFRIT3 + +AFENTY: SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ENTRY in NON-FASL/] + SKIPN CRLOC + ETI [ASCIZ /.ENTRY when . is absolute/] + PUSHJ P,AFRATM ;READ FUNCTION NAME + HRLZS A + PUSH P,A + PUSHJ P,AFRATM ;READ TYPE (SUBR, LSUBR, ETC) + HRRM A,(P) + MOVE SYM,[SQUOZE 0,.ENTRY] + PUSHJ P,FAGTFD ;READ ARGS PROP + JUMPGE FF,ASSEM1 ;NOT PUNCHING PASS + PUSH P,A + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ANY NEW ATOMS OUT + POP P,C + POP P,A + MOVEI B,13 + PUSHJ P,FASO + HRL A,C + HRR A,CLOC + PUSHJ P,FASO1 + JRST ASSEM1 + +AFLIST: HLRZM B,AFLTYP + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.LIST illegal except in FASL assembly/] + PUSHJ P,AFRLST ;READ LIST, RTN ATM TBL INDEX IN A + SKIPN AFLTYP + JRST ASSEM1 ;JUST EVAL IN LISP AND THROW AWAY VALUE + MOVEI B,AFDMAI ;"ATOM" INDEX IN AFDMY1 TBL + JRST AFLST1 ;TREAT AS ATOM + +AFRLST: CLEARM AFRLD ;"DEPTH" + CLEARM AFRLEN ;"LENGTH" OF LIST AT CURRENT LEVEL + CLEARM AFRDTF ;DOT CONTEXT FLAG + JUMPGE FF,AFRLI1 + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ALL ATOMS "PUNCHED" + MOVE A,FASATP + MOVEM A,AFRFTP ;SAVED STATE OF FASAT POINTER + MOVE C,AFLTYP + MOVEI B,16 ;EVAL TYPE HACK + CAIN C,1 + MOVEI B,5 ;LIST TYPE HACK + PUSHJ P,FASBO ;WRITE CODE BITS +AFRLI1: +AFRL1: PUSHJ P,RCH + CAIE A,40 ;PREV ATOM (OR WHATEVER) "DELIMITED", SO THESE MEANINGLESS + CAIN A,15 ;UNLESS AT TOP LEVEL AND HAVE READ SOMETHING + JRST AFRL1A + CAIE A,11 + CAIN A,12 + JRST AFRL1A + CAIN A,"( + JRST AFRLO + CAIN A,") + JRST AFRLC + CAIN A,". + JRST AFRDT ;DOT.. + TLO FF,FLUNRD + SKIPE AFRLD + JRST AFRNXT ;READ NEXT GUY THIS LVL + SKIPE AFRLEN +AFRLO2: ETI [ASCIZ /LISP read context error/] +AFRNXT: SKIPN TM,AFRDTF + JRST AFRNX2 ;NOT HACKING DOTS, OK + AOS TM,AFRDTF + CAIE TM,2 + JRST AFRLO2 ;DIDNT JUST SEE THE DOT +AFRNX2: PUSHJ P,AFRATM + JUMPGE FF,AFRNX1 ;XFER ON NOT PUNCHING PASS + PUSHJ P,FASO1 ;TELL LOADER TO PUSH THIS ON ITS STACK +AFRNX1: AOS AFRLEN ;LIST NOW ONE LONGER THIS LVL + JRST AFRL1 + +AFRLO: SKIPN TM,AFRDTF + JRST AFRLO3 ;NOT HACKING DOTS + SOJN TM,AFRLO2 + CLEARM AFRDTF + JRST AFRL1 ;IGNORE BOTH . AND ( +AFRLO3: SKIPE AFRLD ;( + JRST AFRLO1 + SKIPE AFRLEN + JRST AFRLO2 +AFRLO1: PUSH P,AFRLEN + CLEARM AFRLEN ;START NEW LVL + AOS AFRLD ;DEPTH NOW ONE GREATER + JRST AFRL1 + +AFRLC: SOSGE AFRLD ;) + JRST AFRLO2 ;AT TOP LEVEL, BARF + MOVE A,AFRLEN + SKIPN TM,AFRDTF + JRST AFRLC2 ;NOT HACKING DOTS + CAIE TM,2 + JRST AFRLO2 + SOS A ;MAIN LIST NOW ONE SHORTER + TLOA A,200000 ;DOT WITH LAST THING ON STACK +AFRLC2: TLO A,100000 ;TELL LOADER TO MAKE LIST THIS LONG + JUMPGE FF,AFRLC5 + PUSHJ P,FASO1 +AFRLC5: POP P,AFRLEN ;LENGTH AT PREV LVL + AOS AFRLEN ;NOW ONE MORE + CLEARM AFRDTF ;NOT HACKING DOTS NOW + SKIPE AFRLD ;RETURNING TO TOP LEVEL? + JRST AFRL1 + JRST AFRX1 ;YES THRU + +AFRDT: SKIPN AFRDTF + SKIPN AFRLEN + JRST AFRLO2 ;DOT IN FIRST POSITION OF LIST + AOS AFRDTF ;ENTER STATE 1 OF DOT HACKING + JRST AFRL1 + +AFRL1A: SKIPN AFRLD ;SPACER CHAR TERMINATES AT TOP LVL IF HAVE RD SOMETHING + SKIPN AFRLEN + JRST AFRL1 +AFRX1: JUMPGE FF,AFRX2 ;NOT PUNCHING PASS + MOVE A,AFRFTP + CAME A,FASATP + ETR [ASCIZ /Saw atoms in list on pass 2 for first time/] + SKIPN B,AFLTYP ;TYP LIST OP + SKIPA A,[-1,,] + MOVSI A,-2 ;PUT LIST OR VALUE OF LIST IN ATOM TBL + PUSHJ P,FASO1 ;TERM OP AND PUT IT IN ATOM TBL + MOVEI A,0 + MOVE B,AFLTYP + JUMPE B,CPOPJ ;JUST WANT VALUE OF LIST + CAIN B,1 ;ONLY WANT THIS FOR STRAIGHT LIST + PUSHJ P,FASO1 ;OUTPUT "SXHASH" WORD + AOS A,FASATP + CLEARM FASAT-1(A) ;RESERVE SLOT IN FASAT TBL + MOVEM A,FASPCH ;SAY ALREADY PUNCHED OUT + AOS A,FASIDX + POPJ P, + +AFRX2: TLO I,ILNOPT ;DONT TRY TO OPTIMIZE IF IN CONSTANT + CLEARB A,B + POPJ P, +] + ;.LIBRA, .LIFS, ETC. + +A.LIB: NOVAL ? NOABS + HLRZM B,LIBTYP' ;STORE BLOCK TYPE TO OUTPUT + CLEARM LIBOP ;INITIALIZE SQUOZE FLAGS + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK, MAKING SURE LOADER KNOWS $. +LIB1: PUSHJ P,GETSYL ;GET NAME + TRNN I,IRSYL + JRST LIB2 ;NO SYL, DON'T OUTPUT + IOR SYM,LIBOP + TLO SYM,40000 + PUSHJ P,OUTSM + MOVSI A,400000 + ANDCAM A,LIBOP +LIB2: MOVE B,CDISP ;GET CDISP + TLNN B,DWRD\DFLD ;CHECK FOR WORD TERMINATOR + JRST LIB3 ;WORD TERMINATOR => DONE + MOVE A,LIBOP + MOVE B,LIMBO1 ;RETRIEVE LAST CHAR READ + CAIN B,", + MOVSI A,400000 + CAIN B,"+ + TLZ A,200000 + CAIN B,"- + TLO A,200000 + MOVEM A,LIBOP' ;STORE SQUOZE FLAGS (LESS GLBL BIT) FOR NEXT SYM + JRST LIB1 + +LIB3: MOVE A,LIBTYP ;GET BLOCK TYPE TO OUTPUT + DPB A,[310700,,BKBUF] + PUSHJ P,EBLK + CAIN A,LLIB ;.LIBRA? + JRST ARELC1 ;.LIBRA, NOW PLAY LIKE RELOCA PSEUDO + JRST LIB5 ;SOMETHING ELSE (.LIFS), INCREMENT DEPTH IN LOAD TIME CONDITIONALS + +A.ELDC: NOVAL ? NOABS + PUSHJ P,EBLK + MOVEI A,ELTCB + DPB A,[310700,,BKBUF] + TRO FF,FRLOC ;MAKE EBLK OUTPUT NULL BLOCK + PUSHJ P,EBLK + SOSGE LDCCC + CLEARM LDCCC ;LOADER CONDITIONAL UNDERFLOW + JRST ASSEM1 + + ;LOADER CONDITIONAL ON VALUE + +A.LDCV: NOVAL ? NOABS + LSH B,-27. + PUSH P,B + PUSHJ P,AGETWD + POP P,B + DPB B,[400300,,BKBUF] + MOVEI A,LDCV + PUSHJ P,PLDCM + MOVEI A,0 + DPB A,[400300,,BKBUF] +LIB5: AOS LDCCC +CCASM1: JRST ASSEM1 + ;.GLOBAL, .SCALAR, .VECTOR +;LH(B) HAS ILGLI, ILVAR, ILVAR+ILFLO RESPECTIVELY. + +A.GLOB: NOVAL + HLLZ LINK,B ;REMEMBER WHICH OF THE THREE PSEUDO'S THIS IS. +A.GLO2: MOVE A,GLSPAS + MOVEM A,GLSP1 + SETOM FLDCNT + PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO NAME => DONE + CALL ES + JRST A.GLO1 + CAIE A,PSUDO_-14. + JRST A.GLO1 + JSP B,GVPSEU ;TRYING TO .GLOBAL A PSEUDO => TYPE APPRO. ERR MSG AND RETURN. + JRST A.GLO2 ;DON'T DO ANYTHING TO IT; MOVE ON TO NEXT ARG. + +A.GLO1: IOR I,LINK ;SET THE GLOBAL FLAG OR THE VARIABLE FLAG. + TLNE LINK,ILFLO ;FOR .VECTOR, SAVE # VARS CREATED BEFORE CREATING THIS ONE. + SAVE VARCNT ;SO WE CAN TELL IF THIS CALL TO GETVAL ACTUALY CREATES IT. + PUSHJ P,GETVAL ;NOW GET VALUE (CLOBBERS SQUOZE FLAGS) + CAIA + HALT + TLNN LINK,ILFLO + JRST A.GLO2 + SAVE LINK ;.VECTOR - READ THE SIZE. + TLO FF,FLUNRD ;RE-READ THE TERMINATOR AFTER THE SYM, SO "FOO(1)" AND "FOO," WIN + MOVE SYM,[SQUOZE 0,.VECTOR] + CALL AGETFD + REST LINK + REST B ;GET PREV. VARCNT, SO WE CAN SEE IF IT WAS INCREMENTED. + TRNN A,-1 ;MAKE (N) WORK AS SIZE BY USIN L.H. IF R.H. IS 0. + HLRZS A + SKIPE A + MOVEM A,VECSIZ ;IF NONZERO SIZE SPEC'D, USE IT AND SET DEFAULT. + MOVE A,VECSIZ ;ELSE USE THE DEFAULT. + SUBI A,1 ;1 WORD WAS ALLOCATED BY GETVAL - HOW MANY MORE WANTED? + CAME B,VARCNT ;(MAYBE SYM ALREADY DEFINED, MAYBE PASS2, ...) + ADDM A,VARCNT ;IF GETVAL REALLY ALLOCATED THE SPACE THIS TIME, ALLOCATE THE + JRST A.GLO2 ;RIGHT AMOUNT. + + ;.LOP + +A.LOP: NOVAL ? NOABS + PUSHJ P,EBLK ;TERMINATE CURRENT BLOCK + REPEAT 3,PUSHJ P,RGETFD ;GET THE FIELDS + MOVEI A,LD.OP + PUSHJ P,PLDCN + JRST ASSEM1 + + ;.LIBRQ + +A.LIBRQ: NOVAL ? NOABS +A.LBR1: PUSHJ P,GETSLD + JRST MACCR + PUSHJ P,PBITS7 + MOVEI A,3 + PUSHJ P,PBITS + TLO SYM,40000 + PUSHJ P,OUTSM + JRST A.LBR1 + A.LNKOT: AOS (P) ;THIS PSEUDO RETURNS NO VALUE. + NOVAL + +AEND5: JUMPGE FF,CPOPJ ;IGNORE FOLLOWING ON NOT PUNCHING PASS + MOVE D,SYMAOB +AEND5A: MOVE SYM,ST(D) + LDB T,[400400,,SYM] + CAIE T,DEFLVR_-14. + CAIN T,DEFGVR_-14. + JRST AEND5E + CAIE T,LCUDF_-14. + CAIN T,GLOEXT_-14. + JRST AEND5B +AEND5C: ADD D,WPSTE1 + AOBJN D,AEND5A + POPJ P, + +AEND5E: 3GET C,D + TLNN C,3LLV + JRST AEND5C +AEND5B: HLLZ B,ST+1(D) + 3GET C,D + TLNN C,3RLNK + JUMPE B,AEND5C + TLZ SYM,740000 + CAIE T,LCUDF_-14. + CAIN T,DEFLVR_-14. + SKIPA + TLO SYM,40000 + PUSHJ P,LKPNRO + HRRZS ST+1(D) ;CLEAR OUT LIST HEAD POINTER. + TLZ C,3RLNK ;INDICATE NO LIST. + 3PUT C,D + JRST AEND5C + + ;PUNCH OUT COMPLETE LOADER COMMAND, PUNCHING OUT WRD AS ONLY CONTENTS + +PLDCM: PUSH P,LINK ;SAVE LINK FOR ALOC AND FRIENDS (CLOBBERS OTHER AC'S) + PUSH P,A ;SAVE LOADER COMMAND TYPE + PUSHJ P,EBLK ;TERMINATE PREV BLOCK, MAKING SURE LOADER KNOWS $. + PUSHJ P,PWRDA ;PUNCH OUT THE WORD + POP P,A ;GET BACK LOADER COMMAND TYPE FOR PLDCN + PUSHJ P,PLDCN ;OUTPUT THE RESULTING BLOCK +PLINKJ: POP P,LINK ;RESTORE LINK + POPJ P, + +PLDCN: HRRM A,BKBUF ;STORE LOADER COMMAND TYPE IN BKBUF HEADER + MOVEI A,LLDCM ;LOADER COMMAND BLOCK TYPE + DPB A,[310700,,BKBUF] ;STORE BLOCK TYPE IN HEADER + TRO FF,FRLOC ;MAKE EBLK OUTPUT BLOCK EVEN IF EMPTY + JRST EBLK + +;.RELP RETURNS RELOCATION OF ARG +A.RELP: CALL AGETFD + MOVE A,B + JRST VALRET + +;.ABSP RETURNS ABSOLUTE PART OF ARG. +A.ABSP: CALL AGETFD + JRST VALRET + +;.RL1 IN RELOCATABLE ASSEMBLY RETURNS ZERO WITH RELOCATION FACTOR ONE. +;IN ABSOLUTE ASSEMBLY, IT RETURNS JUST ZERO. +;IFN <.RELP .RL1>, IS A TEST FOR A RELOCATABLE ASSEMBLY. +A.RL1: SKIPGE A,CONTRL + TRNE A,DECREL\FASL + SKIPA B,[1] + SETZ B, + SETZ A, + RET + AEND: NOVAL + SKIPE ASMOUT ; ERROR IF IN GROUPING. + JSP LINK,CONFLM ;FLUSH CONSTANTS, GIVE ERROR MSG. + SKIPE SCNDEP ;IF THERE ARE UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS, MENTION THEM. + MOVE A,BKCUR + CAIE A,BKWPB ;NOT IN .MAIN BLOCK => ERROR. + ETR ERRUMB + MOVE A,CDISP + TLNN A,DWRD + TLO FF,FLUNRD ;IF LAST TERM. WAS WORD TERM., RE-READ. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + EXCH A,PNTBP + MOVEM A,LISTTM +] + PUSHJ P,AVARI0 + PUSHJ P,CNSTN0 + SKIPL A,CONTRL + PUSHJ P,AEND5 ;RELOCATABLE => .LNKOT + SKIPGE A,CONTRL + TRNN A,DECREL + JRST AEND6 + MOVE A,CLOC ;IN DEC FMT, UPDATE HIGHEST ADDR SEEN, + SKIPN CRLOC ;UPDATE EITHER THE HIGHEST ABS ADDR + JRST [ CAML A,DECBRA + MOVEM A,DECBRA + JRST AEND6] + CAML A,DECTWO ;OR THE HIGHEST REL ADDR IN THE + JRST [ CAML A,DECBRH ;APPROPRIATE SEG. + MOVEM A,DECBRH + JRST AEND6] + CAML A,DECBRK + MOVEM A,DECBRK +AEND6: JUMPL FF,AEND1 ;ON PUNCHING PASS, SPECIAL STUFF + PUSHJ P,GETWRD ;OTHERWISE EAT UP WORD, + JRST RETURN ;AND RETURN + +AEND1: PUSHJ P,EBLK +IFN LISTSW,[ + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE A,LISTTM + MOVEM A,PNTBP +] + MOVE SYM,[SQUOZE 0,END] + TLZ I,ILWORD + PUSHJ P,AGETWD +IFN LISTSW,[ + MOVEM A,LISTWD + MOVEM B,LSTRLC + SETOM LISTAD + SETOM LISTPF + SKIPE LSTONP + PUSHJ P,PNTR + SKIPE LISTP + PUSHJ P,LPTCLS ;DONE LISTING + MOVE A,LISTWD +] ;END IFN LISTSW, + SKIPL B,CONTRL + JRST AEND3 ;RELOCATABLE +IFN FASLP,[ + TRNE B,FASL + JRST FASEN ;FASL FORM +] + TRNN B,DECREL ;IF DEC FORMAT, + JRST AEND1A + TLNN I,ILWORD ;THEN IF THERE7S A STARTING ADDRESS, + JRST AEND2 + MOVSI A,DECSTA ;OUTPUT START-ADDRESS BLOCK. + PUSHJ P,DECBLK + PUSHJ P,PWRD + PUSHJ P,EBLK + JRST AEND2 + +IFN FASLP,[ +FASEN: JRST AEND2 +] + +AEND3: HRRZ A,CLOC + HRRM A,BKBUF ;SET UP PROGRAM BREAK JUST IN CASE OUTPUTTING MORE NULL DATA BLOCKS + MOVEI A,LCJMP + PUSHJ P,PLDCM + JRST AEND2 + +AEND1A: TLNN A,777000 ;CHECK INSTRUCTION PART + TLO A,(JRST) ;INSTRUCTION PART 0; HE WANTS JRST + PUSHJ P,PPB + JUMPG A,.+3 + ETR [ASCIZ /Start instruction negative/] + HRLI A,(JRST) ;END SYMTAB WITH POSITIVE WORD + MOVEM A,STARTA ;SAVE FOR PUNCHOUT AT END OF SYMTAB + PUSHJ P,FEED1 +AEND2: PUSH P,[RETURN] +CNARTP: +IFN DECSW\TNXSW,[ + SAVE TTYFLG + SKIPE CCLFLG ;IN DEC VERSION, IF RUN BY CCL, DON'T PRINT + AOS TTYFLG ;THIS STUFF ON THE TTY - ONLY IN ERROR FILE AND LISTING. + CALL CNTPD + REST TTYFLG + RET + +CNTPD: +] + MOVNI D,1 + MOVEI TT,PCNTB +CNTP1: CAML TT,PBCONL + RET + HRRZ B,1(TT) + HLRZ A,1(TT) + CAMN A,B + JRST CNTP2 + AOSN D + TYPR [ASCIZ /Constants area inclusive +From To +/] + LDB B,[.BP (CGBAL),2(TT)] + SKIPE B + TYPR [ASCIZ /Global+/] + HRRZ B,1(TT) + PUSHJ P,OCTPNT + PUSHJ P,TABERR + HLRZ B,1(TT) + SOS B + PUSHJ P,OCTPNT + PUSHJ P,CRRERR +CNTP2: ADDI TT,3 + JRST CNTP1 + +AENDM1: TYPR [ASCIZ /Unterminated successful bracketed conditionals +The first was at /] + AOS A,CONDPN + CALL DPNT + MOVEI A,"- + CALL TYOERR + AOS A,CONDLN + CALL D3PNT2 +IFN TS,[ + TYPR [ASCIZ/ of file /] + MOVE B,CONDFI + CALL SIXTYO +] + JRST CRRERR + AXWORD: CALL XGETFD ;READ 1ST FIELD, + TLNE I,ILMWRD + CALL IGTXT ;SOAK UP REST OF TEXT PSEUDO. + HRLM A,WRD + HRLM B,WRDRLC + MOVSI C,HFWDF + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + PUSH P,GLSP1 + CALL XGETFD ;NOW THE SECOND FIELD + HRRM A,WRD + HRRES B + ADDM B,WRDRLC + MOVSI C,HFWDF + MOVEI B,0 + POP P,T + PUSHJ P,LINKTC + JRST CABPOP + +A.NTHWD: CALL AGETFD ;READ THE NUMBER OF THE WORD WE WANT. + SOJL A,CABPOP ;NEGATIVE OR 0 => RETURN 0. + SOJL A,A.1STWD ;1 => TURN INTO .1STWD. + ;ELSE SKIP APPRO. # OF WORDS, THEN DO .1STWD. + +A.NTH1: SAVE A + SAVE WRD + CALL XGETFD + TLZ FF,FLUNRD + REST WRD + REST A + TLNN I,ILMWRD + JRST CABPOP ;IF STRING ENDS BEFORE DESIRED WORD, RETURN 0. + SOJGE A,A.NTH1 + +A.1STWD: CALL XGETFD ;GET THE 1ST WD OF FOLLOWING TEXT PSEUDO, + CALL IGTXT ;THROW AWAY THE REST. + MOVE T,A ;RETURN THE VALUE + JRST TEXT5 ;COMPLAINING IF FOLLOWED IMMEDIATELY BY SYLLABLE. + +A.LENGTH: CALL PASSPS + PUSH P,[0] + PUSH P,A +A.LN1: PUSHJ P,RCH + AOS -1(P) + CAME A,(P) + JRST A.LN1 + SOS T,-1(P) + SUB P,[2,,2] + JRST TEXT5 ;RETURN VALUE IN T + +ARDIX: NOVAL + PUSHJ P,AGETFD ;GET FIELD ARG + MOVEM A,ARADIX + JRST MACCR ;RETURN WITHOUT CLOBBERING CURRENT VALUE + +A.RADIX: CALL AGETFD ;READ THE TEMP. RADIX. + SAVE ARADIX ;LAMBDABIND RADIX TO THAT VALUE. + MOVEM A,ARADIX + CALL XGETFD ;READ IN THE NEXT FIELD USING THAT RADIX. + REST ARADIX + JRST VALRET + ;READ A BIT-MASK AS ARG, RETURN THE LH OF BP. FOR THAT BYTE. +A.BP: CALL YGETFD + MOVEI C,SPACE + SKIPE CDISP ;IF ARG WAS ENDED BY A COMMA, TURN IT INTO A SPACE + HRRM C,CDISP ;SO THAT .BP FOO,BAR USES THE FLD SPACE FLD FORMAT. + JUMPE A,VALR1 + SAVE A + JFFO A,.+2 + MOVEI B,36. + EXCH B,(P) ;(P) HAS # LEADING ZEROS. + MOVN A,B + AND A,B ;A HAS ONLY THE LOW BIT OF THE BYTE. + JFFO A,.+2 + MOVNI B,1 ;B HAS 35.-<# TRAILING ZREROS.> + MOVEI A,1(B) + SUB A,(P) ;A HAS SIZE OF BYTE + LSH A,30 ;PUT IN S FIELD OF BP. + SUB P,[1,,1] + MOVNS B + ADDI B,35. ;B HAS # TRAILING ZEROS. + DPB B,[360600,,A] ;PUT THAT IN P FIELD OF BP. + JRST VALR1 + +;READ IN BP, RETURN BIT MASK TO SPEC'D BYTE. +;THE ARG SHOULD BE JUST THE LH OF A BP, WHICH MAY BE IN EITHER HALF OF THE ARG. +A.BM: CALL GETBPT ;READ IN A BYTE POINTER ARG, IN A, POINTING AT T. + SETZ T, + SETO C, +A.DPB1: DPB C,A ;PUT 1'S IN SPEC'D PART OF ACCUM T + MOVE A,T + JRST VALRET + +;READ IN A BYTE POINTER (REALLY JUST S AND P FIELDS) AND MAKE POINT AT AC T. +;RETURN IT IN AC A. +GETBPT: CALL YGETFD + TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH. + HRLI A,(A) + TLZ A,77 ;MAKE BP. -> AC T + HRRI A,T + RET + +;RETURN # TRAILING ZEROS IN ARGUMENT. +A.TZ: CALL YGETFD + MOVN B,A + AND A,B ;A HAS JUST LOW BIT OF ARG SET. + JFFO A,.+2 + MOVNI B,1 ;# OF ZEROS BEFORE LOW BIT = + MOVN A,B ;35. - <# TRAILING ZEROS> + ADDI A,35. + JRST VALRET + +;RETURN # LEADING ZEROS IN ARG. +A.LZ: CALL YGETFD + JFFO A,.+2 + MOVEI B,36. + MOVE A,B + JRST VALRET + +;.DPB STUFF,BP,WORD DOES A DPB OF STUFF INTO THE FIELD OF WORD SPEC'D BY BP, +;RETURNING THE RESULTING WORD. +A.DPB: CALL YGETFD ;READ STUFF. + SAVE A + CALL GETBPT ;READ BP AND TURN INTO ACTUAL BP POINTING AT T + SAVE A + CALL YGETFD ;READ IN WORD AND PUT IN T. + MOVE T,A + REST A ;A HAS BP + REST C ;C HAS STUFF + JRST A.DPB1 ;GO DO THE DEPOSIT AND RETURN THE ALTERED WORD. + +;.LDB BP,WORD RETURNS THE CONTENTS OF THE BYTE IN WORD SELECTED BY BP +A.LDB: CALL GETBPT + SAVE A + CALL YGETFD + MOVE T,A + REST A + LDB A,A + JRST VALRET + AWORD: NOVAL + PUSHJ P,EBLK + PUSHJ P,GETWRD ;ON UNDEFINED SYM, WYB UNDEFINED SYM IN "WORD"? + PUSHJ P,PPB + JRST ASSEM1 + +;.BIND - MAKE SYMS BE DEFINED IN CURRENT (SPEC'D) BLOCK. LH(B) HAS 0. +;.KILL - FULLY KILL THE SYMS.LH(B) HAS 3KILL. +;.HKILL - HALFKILL THEM. LH(B) HAS 3SKILL. +;.XCREF - PREVENT CREFFING OF SYMS. LH(B) HAS 3NCRF. +;.DOWN - SET 3DOWN, MAKING SYM VISIBLE IN SUBBLOCKS IN 1 PASS ASSEMBLY. +A.KILL: NOVAL + HLLZ LINK,B ;REMEMBER BIT TO SET. +A.KIL1: CALL GETSLD ;READ NEXT SYMBOL NAME. + JRST MACCR ;NO MORE, EXIT. + SKIPE LINK ;EXCEPT FOR .BIND, DO NOTHING ON PASS 1. + JUMPGE FF,A.KIL1 + CALL ESDEF ;DEFINE THE SYMBOL, D HAS STE IDX. + JRST A.KIL2 ;SYMBOL NEVER SEEN. + IORM LINK,ST+2(D) ;SET THE BIT IN 3RDWRD.. + IOR C,LINK ;(IF .XCREF, PREVENT CREFFING THIS TIME) +IFN CREFSW,XCT CRFINU ;CREF THE SYMBOL + JRST A.KIL1 + +A.KIL2: MOVSI T,LCUDF ;SYMBOL UNDEFINED, MAKE UNDEF LOCAL. + IOR C,LINK ;WITH THE DESIRED BIT SET. + TLO C,3MACOK ;SHOULDN'T BE ERROR IF IT BECOMES MACRO. + CALL VSM2 +IFN CREFSW,XCT CRFINU + JRST A.KIL1 + +;EXPUNG SYM1,SYM2 ... ;UNDEFINE THOSE SYMS. +AEXPUNG: NOVAL +AEXPU2: PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO MORE NAMES + SAVE [AEXPU2] ;AFTER THIS SYM, POPJ TO READ ANOTHER. +;EXPUNGE 1 SYMBOL, SQUOZE IN SYM. +AEXPU1: PUSHJ P,ES + JFCL ;NOT FOUND, DON'T COMPLAIN, JUST CREF. +IFN CREFSW,XCT CRFDEF + HRLZI T,400000 ;EXPUNGED ZERO SYM + SKIPE ST(D) + MOVEM T,ST(D) + SKIPL CONTRL ;IF RELOCATABLE ANDLOCAL SYMBOL, + CAIL A,DEFGVR_-33. + RET + PUSHJ P,PBITS7 ;TELL STINK TO EXPUNGE SYM. + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY IS NEW TYPE RQ, + PUSHJ P,OUTSM0 + MOVSI A,400000 ;NEW NAME NULL => DELETE. + JRST $OUTPT + ;EQUAL SYM1,SYM2 ;DEFINE SYM1 SAME AS SYM2. +AEQUAL: NOVAL + PUSHJ P,GETSLD + ETR ERRTFA + SAVE SYM ;REMEMBER SYM NAME AND BLOCK TO DEF. IN. + SAVE ESBK + PUSHJ P,GETSLD + ETR ERRTFA +IFN CREFSW,XCT CRFINU ;CREF SYM DEFINED AS. + CALL ES ;LOOK UP SYM TO EQUATE TO. + JRST [ REST ESBK ;NOT FOUND => EXPUNGE THE 1ST SYM. + REST SYM + JRST AEXPU1] + REST ESBK + REST SYM +IFN CREFSW,XCT CRFDEF + SAVE A + SAVE B ;SAVE INFO ON VALUE OF SYM TO EQUATE TO. + SAVE C + CALL ESDEF + MOVEM SYM,ST(D) + REST B ;3RDWRD OF 2ND SYMBOL. + REST ST+1(D) ;(WHAT WAS PUSHED FROM B) + REST A + DPB A,[400400,,ST(D)] + TLZ C,3DFCLR ;SAVE OLD 3MAS, 3NCRF OF 1ST SYMBOL (AND ITS BLOCK #). + AND B,[3DFCLR,,] ;SET REST OF 3RDWRD BITS FROM 2ND SYMBOL. + IOR B,C + 3PUT B,D + JRST MACCR + +ERRTFA: ASCIZ /Too few args - EQUAL/ + +;.SEE SYM1,SYM2,... ;CREF THOSE SYMS. +A.SEE: CALL GETSLD ;READ 1 SYMBOL. + JRST MACCR ;NONE TO BE READ. +IFN CREFSW,[ + SKIPN CRFONP ;IF CREFFING, + JRST A.SEE + CALL ES + MOVEI A,SYMC_-33. + XCT CRFINU ;CREF THE SYMBOL. +] + JRST A.SEE + ;UUO HANDLING ROUTINE +;41 HAS JSR ERROR + +VBLK +ERRCNT: 0 ; NUMBER OF ERRORS HIT -- VALUE OF .ERRCNT +ERRCCT: 0 ;NUM CHARS OUTPUT ON LINE, FOR MAKING MSGS LINE UP. +ERRJPC: 0 ;JPC READ WHEN UUO. +ERROR: 0 +IFN TS, .SUSET [.RJPC,,ERRJPC] + JRST ERRH ;GO HANDLE IT +PBLK +ERRH: PUSH P,T + PUSH P,B ;NOT TYPR => ERROR OF SOME KIND + PUSH P,A + SAVE C + LDB T,[331100,,40] ;PICK UP OP CODE + CAIN T,TYPR_-33 ;TYPR? + JRST TYPR1 ;YES + ;ERROR OF SOME KIND + CAIE T,ETASM_-33 ;CHECK FOR SPECIAL LOSSAGES AT COLON + CAIN T,ETSM_-33 + CAME SYM,SYSYM ;ARE WE ABOUT TO MENTIO THIS LOSING LABEL AS THE LAST ONE? + JRST ERRH1 + MOVE T,SYSYM1 + + MOVEM T,SYSYM ;COLON LOSSAGE, DE-MUNG TAG WORDS FOR PRINTOUT + MOVE T,SYLOC1 + MOVEM T,SYLOC +ERRH1: +IFN TS,[ +IFN LISTSW,[ + CALL PNTR ;FORCE OUT BUFFERED LISTING OUTPUT + CALL PNTCRR ;AND CR, SO USER CAN SEE WHERE ERROR WAS. +] + PUSHJ P,ERRTFL ;IF NOT SAME FILE AS LAST, PRINT FILE NAME. +] + SETZM ERRCCT + AOS ERRCNT ; BUMP ERROR TOTAL +IFE ITSSW,AOS .JBERR ; BUMP ERROR MESSAGE COUNTER FOR LOADER TO ABORT + MOVE A,SYSYM ;GET LAST TAG DEFINED + JUMPE A,ERR1 ;SKIP PRINTOUT IF NONE THERE + PUSHJ P,SYMTYP ;THERE, TYPE IT OUT + MOVE B,CLOC ;NOW GET CURRENT LOCATION + SUB B,SYLOC ;SUBTRACT VALUE OF LAST TAG + JUMPE B,ERR1 ;SKIP NUMERIC PRINTOUT IF RIGHT AT TAG + MOVEI A,"+ ;NOT AT TAG, + PUSHJ P,TYOERR ;TYPE OUT PLUS SIGN, + AOS ERRCCT ;(1 MORE CHAR TYPED) + PUSHJ P,OCTPNT ;THEN TYPE OUT DIFFERENCE IN OCTAL +ERR1: PUSHJ P,TABERR ;NOW SEPARATE WITH TAB + MOVE A,ERRCCT + CAIGE A,8 ;MAKE SURE MOVE TO COLUMN 16. + PUSHJ P,TABERR + MOVEI B,[ASCIZ/GL+/] + SKIPGE GLOCTP ;LOCATION GLOBAL? + PUSHJ P,TYPR3 ;YES, TYPE OUT THAT FACT. + MOVE B,CLOC ;GET CURRENT LOCATION + PUSHJ P,OCTPNT ;TYPE OUT IN OCTAL +;DROPS THROUGH + ;DROPS THROUGH. + PUSHJ P,TABERR + MOVE A,MDEPTH ;NOW DEPTH IN MACRO (NOT IRP, REPEAT, ETC.) EXPANSIONS + MOVSI T,-2 + CALL DPNT0 ;PRINT, IN 2-CHAR FIELD. + MOVEI A,". + CALL TYOERR ;(USED TO BE OCTAL) + MOVE A,CPGN ;CURRENT PAGE NUMBER (FIRST PAGE OF FILE => 0) + PUSHJ P,[AOJA A,D6PNT] ;TYPE IT OUT IN DECIMAL + MOVEI A,"- + CALL TYOERR + MOVE A,CLNN ;ALSO CURRENT LINE NUMBER + PUSHJ P,[AOJA A,D3PNT2] + PUSHJ P,TABERR + MOVEI A,48. ;ASSUME ALL THE STUFF WE'VE PRINTED TAKES 48. CHARS + MOVEM A,ERRCCT ;MAYBE SOMEDAY TABERR, ETC. WILL REALLY UPDATE ERRCCT PROPERLY. + LDB A,[331100,,40] ;PICK UP OP CODE AGAIN + CAIGE A,8 ;ERROR UUO MAX + JRST .+1(A) + JRST [HALT ? JRST .-1] ;OPCODE 0, OR TOO BIG. + JRST ERRSM ;ETSM => TYPE SYM AND MESSAGE. + JRST ERRR ;ETR => JUST PRINT MESSAGE + JRST ERRJ ;ERJ => RH(40) HAS JUMP ADR + JRST ERRI ;ETI => IGNORE LINE RET TO ASSEM1 + JRST ERRA ;ETA => RET TO ASSEM1 + JRST ERRASM ;ETASM => TYPE SYM AND GO TO ASSEM1 + JRST IAE ;ERF => FATAL. + +ERRJ: MOVE A,40 ;ERJ => RH(40) HAS JUMP ADR + HRRM A,ERROR + JRST ERRET1 + +ERRI: PUSHJ P,RCH ;ETI => IGNORE LINE, RETURN TO ASSEM1: EAT UP LINE + CAIE A,12 + JRST .-2 +ERRA: MOVEI A,ASSEM1 ;ETA => RETURN TO ASSEM1, DON'T TYPE SYM. + MOVEM A,ERROR + JRST ERRR + +ERRASM: MOVEI A,ASSEM1 ;ETASM => TYPE SYM AND RETURN TO ASSEM1 + MOVEM A,ERROR +ERRSM: MOVEI C,56. ;ETSM OR ETASM => TYPE OUT SYM THEN MESSAGE + CALL TYPE37 ;CR NOW IF WHOLE MSG WON'T FIT ON ONE LINE. + MOVE A,SYM + PUSHJ P,SYMTYP + PUSHJ P,TABERR +ERRR: CALL TYPE40 ;TYPE THE ERROR MESSAGE. +ERRET1: REST C + POP P,A ;COMMON RETURN POINT FROM UUOS + POP P,B + POP P,T + JRST 2,@ERROR + ;FINISH UP AN ERROR UUO'S ERROR MESSAGE. PRINT THE SPECIFIED STRING +;AND ALSO "IN DEFINE AT ..." IF NECESSARY, ALONG WITH APPROPRIATE CR'S. +TYPE40: MOVE C,ERRCCT + CALL TYPE37 + CALL TYPR4 ;PRINT THE ASCIZ STRING + CALL CRRERR + SKIPN A,DEFNPS ;IF INSIDE A LONG PSEUDO, + RET + MOVE A,DEFNLN + MOVE B,DEFNPN + CAMN A,CLNN ;WHICH DIDN'T START IN THIS VERY LINE, + CAME B,CPGN + JRST TYPE42 + MOVE A,DEFNFI + CAMN A,INFFN1 + JRST TYPE43 +TYPE42: MOVEI B,[ASCIZ/ in /] + CALL TYPR3 + MOVE A,DEFNPS + CALL SYMTYP ;SAY WHAT PSEUDO, AND WHERE IT STARTED. + MOVEI B,[ASCIZ/ Starting at /] + CALL TYPR3 + MOVE A,DEFNPN ;PAGE # -1. + CALL [AOJA A,DPNT] ;PRINT PAGE #. + MOVEI A,"- + CALL TYOERR + AOS A,DEFNLN + CALL D3PNT2 ;PRINT LINE #. +IFN TS,[ + MOVE B,DEFNFI ;PRINT FILE NAME IF IT ISN'T THE CURRENT FILE. + CAMN B,INFFN1 + JRST TYPE41 + MOVEI B,[ASCIZ/ of file /] + CALL TYPR3 + MOVE B,DEFNFI + CALL SIXTYO +] +TYPE41: CALL CRRERR ;AND CRLF. +TYPE43: MOVE A,ERROR + CAIN A,ASSEM1 ;IF THIS ERROR IS EXITING THE PSEUDO, + SETZM DEFNPS ;SAY WE'RE NOT IN IT ANY MORE. + RET + +;JSP TM,ERMARK IN A PSEUDO, TO ARRANGE FOR ERROR MESSAGES TO MENTION +;THAT PSEUDO. SYM SHOULD CONTAIN THE NAME OF THE PSEUDO. +;PUSHES A WORD ON THE STACK SO THAT WHEN THE PSEUDO RETURNS DEFNPS WILL BE CLEARED. +;IF DEFNPS IS SET UP ALREADY, DOES NOTHING (DOESN'T SET DEFNPS; DOESN'T PUSH THE WORD) +ERMARK: SKIPE DEFNPS + JRST (TM) + MOVEM SYM,DEFNPS + MOVE SYM,CLNN + MOVEM SYM,DEFNLN + MOVE SYM,CPGN + MOVEM SYM,DEFNPN + MOVE SYM,INFFN1 + MOVEM SYM,DEFNFI + MOVE SYM,DEFNPS + CALL (TM) + CAIA + AOS (P) + SETZM DEFNPS + RET + ;C SHOULD HAVE CURRENT HORIZ POS. IF TYPING THE STRING 40 POINTS AT +;WOULD OVERFLOW THE LINE, TYPE A CRLF AND TAB NOW ON THE TTY ONLY. +TYPE37: HRRZ B,40 + HRLI B,440700 ;FIRST, FIGURE OUT HOW FAR ON LINE WE'LL TYPE IF WE DON'T CR. + ILDB A,B + CAIE A, ;AND COUNT CHARS IN THE ERR MSG. + AOJA C,.-2 + CAMGE C,LINEL + RET +CRRTBX: MOVEI A,10 + MOVEM A,ERRCCT ;PREVENT THIS FROM BEING DONE TWICE. + SKIPE TTYFLG + RET + MOVEI A,^M ;IF THERE'S NO ROOM, CRLF ON THE TTY ONLY (NOT THE ERR FILE). + PUSHJ P,TYOX + MOVEI A,^J + PUSHJ P,TYOX + MOVEI A,^I + JRST TYOX + + ;TYPE OUT SQUOZE (FLAGS OFF) IN A + +SYMTYP: PUSHJ P,SQCCV ;GET NEXT CHAR IN ASCII. + AOS ERRCCT + PUSHJ P,TYOERR ;TYPE IT OUT. + JUMPE B,CPOPJ ;RETURN IF NOTHING LEFT (TYPED OUT AT LEAST ONE CHAR THOUGH) + IMULI B,50 ;LEFT-JUSTIFY REMAINDER + MOVE A,B ;GET LEFT-JUSTIFIED REMAINDER IN A + JRST SYMTYP ;TYPE OUT REMAINDER OF SYM + + ;TYPE OUT SQUOZE CHARACTER (IN A) + +SQCCV: IDIV A,[50*50*50*50*50] + CAIG A,10. + SOJA A,SQCDTO ;NUMBER (OR BLANK =>SLASH) + CAIL A,45 + SKIPA A,SYTB-45(A) ;SPECIAL + ADDI A,"A-13 ;LETTER + POPJ P, + +SQCDTO: ADDI A,"0 + POPJ P, + +SYTB: ". + "$ + "% + +D3PNT2: MOVE T,[-3,,400000] ;3 CHAR FIELD, NO ZERO SUPPRESSION. + JRST DPNT0 + +DPNT: TDZA T,T ;ORDINARY DECIMAL PRINT. +D6PNT: MOVSI T,-6 ;6 CHAR FIELD, ZERO SUPPRESSION. +DPNT0: IDIVI A,10. + HRLM B,(P) + TRNE T,377777 ;IF NOT LAST DIGIT, + TRNE T,400000 ;AND ZERO-SUPPR. WANTED, + JRST DPNT2 + JUMPN A,DPNT2 ;IF THIS IS A LEADING 0, + JUMPN B,DPNT2 + MOVEI B," -"0 + HRLM B,(P) ;REPLACE WITH A SPACE. +DPNT2: AOBJN T,.+2 ;J IF NOT ENOUGH CHARS YET. + JUMPE A,DPNT1 ;ENOUGH, DON'T MAKE MORE IF NOT NEEDED. + CALL DPNT0 + JRST DPNT1 + ;TYPE HALFWORD IN B IN OCTAL. +OCTPNT: HRRZ A,B + IDIVI A,10 + HRLM B,(P) + JUMPE A,.+2 + PUSHJ P,.-3 + AOS ERRCCT +DPNT1: HLRZ A,(P) +ADGTYO: ADDI A,"0 + JRST TYOERR + +;TYPE OUT THE SIXBIT WORD IN B + +SIXTYO: JUMPE B,CPOPJ + MOVEI A,0 + ROTC A,6 + ADDI A,40 + PUSHJ P,TYOERR + JRST SIXTYO + + ;TYPE CRLF + +CRR: MOVEI A,15 + PUSHJ P,TYO + MOVEI A,12 + JRST TYO + +;OP CODE 0 => NO RECOVERY RETURN TO GO2 +IAE: CALL TYPE40 ;PRINT THE ERROR MESSAGE. + SKIPE ASMOUT + JSP LINK,CONFLZ ;TELL USER ABOUT UNTERM. GROUPINGS. + SKIPE SCNDEP ;MENTION ANY UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS. +IFN ITSSW,[ + .SUSET [.RTTY,,A] + SKIPL A + .RESET TYIC, +] + JRST GO2 + + ;TYPR [ASCIZ /STRING/] ;TYPE OUT STRING + +TYPR1: PUSH P,[ERRET1] +TYPR4: HRRZ B,40 ;GET ADR OF BEGINNING OF STRING +TYPR3: HRLI B,440700 ;CONVERT TO BYTE POINTER +TYPR2: ILDB A,B ;GET NEXT CHAR + JUMPE A,CPOPJ ;JUMP IF ZERO, END OF STRING + PUSHJ P,TYOERR ;NON-ZERO, TYPE IT OUT + JRST TYPR2 + +CRRERR: MOVEI A,^M ;CRLF IN ERROR MESSAGE. + CALL TYOERR + SKIPA A,[^J] +TABERR: MOVEI A,^I ;TAB INN ERROR MESSAGE. +TYOERR: +IFN LISTSW,[ + SKIPE LSTTTY ;OUTPUT TO LISTING UNLESS LSTTTY ZERO. + CALL PILPTX +] + SKIPG LSTTTY + JRST TYO ;TO TTY UNLESS LSTTTY POSITIVE. + RET + ;OUTPUT-FORMAT SELECTING PSEUDOS: + +;.SLDR -- ON PASS 2, PUNCH OUT SBLK LOADER AND SELECT SBLK FORMAT +A.SLDR: NOVAL + JUMPGE FF,MACCR ;DO NOTHING ON PASS 1. + PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE FIRST + PUSHJ P,PLOD1A ;PUNCH OUT LOADER +SIMBLK: MOVSI B,SBLKS ;ENTRY FROM PS1, A.SLDR SELECT SBLK + JRST SIMBL1 + +SRIM: MOVE A,SYM ;ENTRY FROM GETVAL, LH(B) HAS RH(CONTRL) + SAVE B + CALL SYMTYP + TYPR [ASCIZ/ Encountered +/] + REST B +SIMBL1: TRO FF,FRNPSS + HRRI B,TRIV ;SET UP TRIV FLAG FOR LH(CONTRL) + MOVSS B + CAME B,CONTRL ;IF CHANGING MODES, END THE BLOCK IN THE OLD MODE + CALL EBLK + MOVE A,CONTRL ;IF OLD MODE WAS RELOCATABLE OF SOME KIND, + TRNN A,DECREL\FASL + JUMPL A,SIMBL2 + SETZM CRLOC ;INITIALIZE LOCATION COUNTER. + MOVEI A,100 + MOVEM A,CLOC +SIMBL2: MOVEM B,CONTRL ;STORE NEW MODE. + AOS (P) + + ;ROUTINE TO SET VARIABLES FOR BENEFIT OF NED LOGIC + ;CALLED BY OUTPUT SELECTING PSEUDOS +OUTUPD: NOVAL +IFN A1PSW,[ + TRNE FF,FRNPSS ;IF PASS 1, + TLNN FF,$FLOUT + JRST OUTCHK + AOS OUTN1 ;INDICATE "OUTPUT" HAS OCCURED OTHER THAN IN 1PASS MODE +OUTCHK: TLZE FF,$FLOUT + AOS OUTC ;INDICATE "OUTPUT" HAS OCCURED DURING CURRENT ASSEMBLY +] + RET + +ANOSYMS: NOVAL + TRZ FF,FRSYMS + JRST MACCR + +A1PASS: PUSHJ P,OUTUPD +A1PAS1: TLO FF,FLPPSS + MOVEIM A.PPASS,1 ;SET .PPASS TO 1. +IFN CREFSW,[ SKIPE CREFP ;THIS NOW PUNCHING PASS, + PUSHJ P,CRFON ;MAYBE TURN ON CREFFING. +] +IFN LISTSW,[ + SKIPE LISTP + CALL LSTON ;LIST NOW IF WANT LISTING AT ALL. +] + MOVE A,CONTRL + TRNE A,DECREL + CALL DECPGN + TRZA FF,FRNPSS +ARELOC: PUSHJ P,OUTUPD +ARELC1: PUSHJ P,EBLK ;FINISH CURRENT OUTPUT BLOCK + TRO FF,FRLOC ;DOING LOCATION ASSIGNMENT, MAKE SURE NEXT GETS OUTPUT + CLEARM CLOC + MOVEI A,1 + MOVEM A,CRLOC + CLEARM CONTRL + SETZM BKBUF + MOVEI A,LREL + DPB A,[310700,,BKBUF] + MOVEM A,CDATBC + JRST MACCR + +A.DECTWO: CALL AGETFD ;READ THE TWOSEG ORIGIN. + TRNN FF,FRNPSS + ETF [ASCIZ /.DECTWO follows 1PASS/] + MOVE C,ISAV + TRNN C,IRFLD ;NO ARG => DEFAULT IT TO 400000 + MOVEI A,400000 + MOVEM A,DECTWO + +A.DECREL: PUSHJ P,OUTUPD + TRZ FF,FRLOC + PUSHJ P,EBLK ;FORCE OUT BLOCK IN OTHER FMT. + MOVE A,[SETZ DECREL] + CAME A,CONTRL ;SWITCHING TO .DECREL MODE FOR 1ST TIME + TRNE FF,FRNPSS ;IN A 1PASS ASSEMBLY + JRST A.FAS1 + CALL A.FAS1 ;DO THE SWITCH + JFCL + CALL DECPGN ;THEN WRITE THE PROGRAM NAME + JRST MACCR + +A.FAS1: MOVEM A,CONTRL ;DEC FMT COUNTS AS ABS ASSEMBLY. + SETZM BKBUF ;(SO EBLK W0N'T OUTPUT ANYTHING) + SETZM CLOC ;START ASSEMBLING FROM RELOCATABLE 0. + MOVEI A,1 + MOVEM A,CRLOC + PUSHJ P,EBLK ;INITIALIZE AN ORDINARY (DECWDS) BLOCK. + JRST MACCR + +IFN FASLP,[ +A.FASL: PUSHJ P,OUTUPD + PUSHJ P,EBLK + MOVE A,[SETZ FASL] ;FASL ALSO COUNTS AS ABS + JRST A.FAS1 +] + ATITLE: NOVAL + SAVE CASSM1 ;RETURN TO ASSEM1. + PUSHJ P,GSYL + SKIPE SYM + MOVEM SYM,PRGNM + MOVE T,[440700,,STRSTO] +ATIT2: ILDB A,T ;GET CHAR FROM TITLE STRING + SOSG STRCNT + JRST ATIT3 ;CHAR IS SYLLABLE TERMINATOR +IFE ITSSW,[ + SKIPE CCLFLG + TRNN FF,FRPSS2 +] + PUSHJ P,TYO ;NOT TERMINATOR, TYPE OUT AND LOOP BACK + JRST ATIT2 + +ATIT3: CALL ATIT1 ;PRINT THE REST OF THIS LINE. + MOVE A,CONTRL + TRNE A,DECREL + TRNE FF,FRNPSS + CAIA + ETF [ASCIZ /TITLE follows 1PASS/] + MOVE A,TTYINS + ADD A,A.PASS ;SHOULD WE .INSRT TTY: THIS PASS (T SWITCH) + JUMPG A,CPOPJ +IFDEF GTYIPA,JRST GTYIPA ;GO PUSH TO TTY IF CAN, +IFNDEF GTYIPA,HALT ;WHY DID YOU SET TTYINS IF CAN'T? + +ATIT1: CAIE A,15 ;CR? + CAIN A,12 ;LF? +IFN ITSSW,JRST CRR ;ONE OF THESE, FINISH TYPEOUT WITH CR +.ELSE [ JRST [ SKIPE CCLFLG + TRNN FF,FRPSS2 + JRST CRR + RET] + SKIPE CCLFLG ;NEITHER OF THESE, PRINT CHAR. + TRNN FF,FRPSS2 ;ON DEC SYS, DON'T PRINT THE TITLE ON P2, OR AT ALL IF RUN BY CCL. +] + PUSHJ P,TYO +A.ERR1: PUSHJ P,RCH ;GET NEXT CHAR IN TITLE + JRST ATIT1 + +;.ERR PSEUDO-OP -- FOLLOWED BY LINE WHICH IS ERROR MSG. +A.ERR: SAVE CASSM1 ;RETURN TO ASSEM1, + ERJ A.ERR1 ;AFTER NUMBERS AND USER'S STRING. + +A.FATAL: SAVE [GO2] ;.FATAL - CAUSE A FATAL ERROR. + ERJ A.ERR1 + +APRINT: NOVAL + HLRZS B ;B SAYS WHETHER PRINTX, PRINTC OR COMMENT. + JSP TM,ERMARK + CALL PASSPS + MOVE T,A +APRIN1: PUSHJ P,RCH + CAME A,T + JRST (B) ;GO TO APRIN1 FOR COMMENT, + JRST MACCR + +APRIN2: CAIE A,"! ;COME HERE FOR PRINTX +APRIN3: PUSHJ P,TYO ;HERE FOR PRINTC + JRST APRIN1 + +A.TYO: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A CHARACTER (AS NUMERIC ARG). + CALL TYOERR + JRST MACCR + +A.TYO6: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A WORD OF SIXBIT. + MOVE B,A + CALL SIXTYO + JRST MACCR + ;.BEGIN - START NEW BLOCK WITH NAME = ARG, OR LAST LABEL DEFINED. +A.BEGIN: NOVAL + SKIPE ASMOUT ;IF IN GROUPING, FLUSH IT & ERROR. + JSP LINK,CONFLM + PUSHJ P,GETSLD ;READ A NAME. + MOVE SYM,SYSYM ;NO ARG, USE NAME OF LAST LABEL. + MOVE A,SYM ;NAME TO USE FOR BLOCK. + MOVE B,BKLVL ;CURRENT LEVEL + 1 + HRLZI B,1(B) ;IS LEVEL OF NEW BLOCK. + HRR B,BKCUR ;ITS SUPERIOR IS CURRENT BLOCK. + MOVEI C,0 ;SEE IF AN ENTRY EXISTS FOR THIS BLOCK. + MOVE AA,A.PASS +A.BEG0: CAMN A,BKTAB(C) + CAME B,BKTAB+1(C) + JRST A.BEG1 ;THIS ENTRY ISN'T FOR BLOCK BEING ENTERED. + TDNE AA,BKTAB+2(C) ;FOUND: DEFINED IN THIS PASS? + ETSM [ASCIZ /Multiply defined BLOCK/] + JRST A.BEG2 ;NO, SAY IT'S DEFINED. + +A.BEG1: ADDI C,BKWPB ;LOOK THRU ALL ENTRIES. + CAMGE C,BKTABP + JRST A.BEG0 + CAIL C,BKTABS ;ALL ENTRIES USED => ERROR. + ETF ERRTMB + MOVEM A,BKTAB(C) ;ALLOCATE NEW ENTRY + MOVEM B,BKTAB+1(C) ;STORE NAME, LEVEL, SUPPRO. + MOVEI A,BKWPB(C) + MOVEM A,BKTABP ;POINTS TO 1ST UNUSED ENTRY. +A.BEG2: IORM AA,BKTAB+2(C) ;INDICATE BLOCK SEEN THIS PASS. + MOVEM C,BKCUR ;NEW BLOCK NOW CURRENT BLOCK, + AOS A,BKLVL ;ITS LEVEL NOW CURRENT LEVEL, + CAIL A,BKPDLS ;PUSH IT ON BLOCK PDL + ETF [ASCIZ /.BEGIN nesting too deep/] + MOVEM C,BKPDL(A) + JRST ASSEM1 + +ERRTMB: ASCIZ /Too many symbol blocks/ +ERRUMB: ASCIZ /Unmatched .BEGIN - .END/ + +;.END - POP CURRENT BLOCK. +A.END: NOVAL + SKIPE ASMOUT ;IN GROUPING => TERMINATE IT & ERROR. + JSP LINK,CONFLM + MOVE A,CDISP ;IF FOLLOWED BY WORD TERM, + TLNN A,DWRD ;CAUSE IT TO BE RE-READ + TLO FF,FLUNRD ;SO ARG WILL BE NULL. + PUSHJ P,GETSLD ;READ ARG. + JRST A.END0 ;NO ARG. + MOVE C,BKCUR ;ERROR UNLESS BLOCK BEING TERMINATED + MOVE A,BKTAB(C) ;HAS SAME NAME AS ARG. + EXCH A,SYM ;(MAKE SURE SYM NAME TYPED IS BLOCK'S NAME) + CAME A,SYM + ETSM ERRUMB ;ERROR, PRINT SYM (BLOCK'S NAME) +A.END0: MOVE C,BKCUR ;NOT OK TO END .MAIN BLOCK OR .INIT BLOCK. + CAIG C,BKWPB + ETA ERRUMB + HRRZ C,BKTAB+1(C) + MOVEM C,BKCUR ;POP INTO FATHER OF PREV. CURRENT BLOCK. + SOS BKLVL + JRST ASSEM1 + ;BKTAB: 3-WORD ENTRIES, 1 PER BLOCK, IN NO PARTICULAR ORDER. +;1ST WD HAS SQUOZE NAME OF BLOCK, FLAGS CLEAR. +;2ND WD HAS LEVEL,,BKTAB IDX OF CONTAINING BLOCK("FATHER", "SUPERIOR") +;3RD WD BIT 1.N ON => BLOCK ENTERED ON PASS N. +;SYMBOL TABLE OUTPUT RTN PUTS -2* IN 3RD WD. +;THE FIRST BKTAB ENTRY IS THAT OF THE OUTERMOST BLOCK (.INIT) +;IN WHICH INITIAL SYMS ARE DEFINED. +;THAT ENTRY'S 2ND AND 3RD WDS ARE 0. +;THE NEXT IS THAT OF THE MAIN BLOCK (.MAIN) IN WHICH +;ALL SYMBOLS ARE NORMALLY DEFINED (THAT IS, YOU ARE IN THAT BLOCK +;BEFORE YOU DO ANY .BEGIN'S). +;THAT ENTRY'S 2ND WD IS 1,, ; ITS 3RD, 0. + +;THE BKPDL IS A TABLE OF BLOCKS CURRENTLY ENTERED & NOT ENDED. +;BKPDL'S 1ST ENTRY IS FOR OUTERMOST BLOCK. +;LAST ENTRY IS BKPDL+@BKLVL, FOR CURRENT BLOCK. + +BKTABS==BKTABL*BKWPB + +VBLK +BLCODE [ +BKTAB: BLOCK 3 ;ENTRY FOR .INIT BLOCK. +PRGNM: BLOCK BKTABS-BKWPB ;PROGRAM NAME IS NAME OF MAIN BLOCK. +] +BKTABP: 0 ;IDX IN BKTAB OF 1ST UNUSED ENTRY. +BKPDL: BLOCK BKPDLS ;TABLE OF BLOCKS STARTED, NOT FINISHED. +BKLVL: 0 ;CURRENT BLOCK LEVEL, IDX OF LAST USED IN BKPDL. +BKCUR: 0 ;BKTAB IDX OF CURRENT BLOCK. +ESBK: 0 ;-1 OR BLOCK TO EVAL SYM. IN. +ESL1: 0 ;IN ES, LEVEL OF BLOCK OF BEST SYM SO FAR. +ESL2: 0 ;3RDWRD OF BEST SO FAR. +SADR: 0 ;SYM TAB IDX OF BEST SO FAR. +ESLAST: 0 ;RH IDX OF LAST DEF (EVEN IF NO GOOD) -1 IF NONE + ;SIGN NEG. IF LAST DEF SEEN BEFORE @ESXPUN +ESXPUN: -1 ;IF SEE EXPUNGED OR FREE ENTRY, PUT IDX HERE. +BKTAB1: BLOCK BKTABL ;USED BY SSYMD. +PBLK + +;.SYMTAB ARG ;SAY WANT AT LEAST ARG STE'S IN SYMTAB. +A.SYMTAB: NOVAL + SAVE [0] ;THIS WORD WILL BE SETOM'ED IF THERE IS REALLY ANY WORK NEEDED. + PUSHJ P,AGETFD ;GET DESIRED SYM TAB SIZE. + CAMG A,SYMLEN ;IF HAVE ENOGH ROOM ALREADY, + JRST A.SYM1 ;NO NEED TO RE-INIT. + CAILE A,SYMMAX ;IF WANTS MORE THAN MAXIMUM, ERROR. + ETF [ASCIZ/.SYMTAB 1st arg too big/] + MOVEM A,SYMLEN ;TELL INITS ABOUT NEW SIZE. + SETOM (P) +A.SYM1: CALL AGETFD ;READ DESIRED CONSTANTS TABLE SPACE ALLOCATION. + CAMG A,CONLEN ;IF TABLE ALREADY BUG ENOUGH, NOTHING TO DO. + JRST A.SYM2 + CAILE A,CONMAX + ETF [ASCIZ/.SYMTAB 2nd arg too big/] + MOVEM A,CONLEN ;ELSE REMEMBER IT AND SAY REALLOCATION NECESSARY. + SETOM (P) +A.SYM2: CALL AGETFD ;3RD ARG IS # WORDS PER SYMBOL - BUT ONLY 3 IS ALLOWED NOW. + JUMPE A,A.SYM3 ;EVENTUALLY 4 WILL GET 12-CHARACTER SYMBOLS. + CAIL A,MINWPS + CAILE A,MAXWPS + ETF [ASCIZ/.SYMTAB 3rd arg out of range/] + CAME A,WPSTE + SETOM (P) + MOVEM A,WPSTE +A.SYM3: REST A ;IS THERE ANYTHING THAT ACTUALLY NEEDS TO BE CHANGED? + JUMPE A,ASSEM1 ;IF NOT, NEVER GIVE ERROR - ELSE WOULD ALWAYS LOSE ON PASS 2. + MOVE B,PLIM + CAMN B,CONTBA ;IF THERE HAVE BEEN ANY LITERALS + SKIPE INICLB ;OR ANY MACROS, IRPS, REPEATS, ETC., THEN ... + ETF [ASCIZ/Too late to do .SYMTAB/] + MOVE CH1,MACTAD ;SET UP AC -> START OF INIT CODE + SUBI CH1,MACTBA ;SO IT CAN REFER TO ITSELF. + PUSHJ P,INITS(CH1) ;RE-INIT, SET SYMSIZ, SYMAOB, ETC. + PUSHJ P,MACINI ;INIT PTRS TO END OF MACTAB. + JRST ASSEM1 + A.OP: PUSHJ P,A.OP1 ;.OP, + JRST VALRET ;RETURNS VALUE + +A.AOP: NOVAL + AOS (P) ;.AOP DOESN'T RETURN VALUE +A.OP1: PUSHJ P,AGETFD + PUSH P,A + PUSHJ P,AGETFD + PUSH P,A ;PDL NOW HAS FIELD 0 AND FIELD 1 + PUSHJ P,AGETFD + POP P,B ;B NOW HAS FIELD 1, A HAS FIELD 2, PDL HAS FIELD 0 + EXCH A,B + POP P,T ;T HAS FIELD 0, A HAS FIELD 1, B HAS FIELD 2 + TLNN T,(0 17,) ;IF AC FIELD NOT PRESENT IN INSN, SUPPLY ONE. + TLO T,(0 A,) + TDNN T,[0 -1(17)] ;IF NO ADDR OR IDX FIELD IN INSTRUCTION, + HRRI T,B ;SUPPLY ONE. + SETOM A.ASKIP' ;.ASKIP WILL BE -1 IFF INSN SKIPPED, ELSE 0. + TLNE T,74000 ;AVOID EXECUTING OPCODE ZERO. + XCT T + SETZM A.ASKIP + MOVEM A,AVAL1' ;STORE C(AC) AS .AVAL1 + MOVEM B,AVAL2' ;STORE C(E) FOR .AVAL2 + POPJ P, ;RETURN TO WHATEVER + +AASCIZ: TDZA T,T +A.ASCII: MOVEI T,1 + MOVEM T,AASCF1 ;STORE TYPE + MOVE D,[440700,,T] + SETZM AASCFT + JRST AASC1 + +AASCII: SKIPA D,[440700,,T] +ASIXBI: MOVE D,[440600,,T] + SETZM AASCFT ;INDICATE NOT .DECTXT + SETOM AASCF1 ;INDICATE REGULAR (NOT ASCIZ) + JRST AASC1 + +A.DCTX: NOVAL + MOVE A,CONTRL + TRNN A,DECREL + ETA [ASCIZ /.DECTXT in non-DECREL assembly/] + CALL EBLK + SETZ B, + SETOM AASCFT + SETOM AASCF1 ;INDICATE ASCIZ-STYLE PADDING + MOVE D,[440700,,T] +AASC1: TLZE I,ILMWRD + JRST TEXT2 ;MULTIPLE WORD, FALL IN FOR NEXT SET OF CHARS + MOVEMM ASMDS1,ASMDSP + MOVEM SYM,DEFNPS ;REMEMBER LOCATION IN FILE OF PSEUDO + MOVEMM DEFNLN,CLNN ;IN CASE THE DELIMITER IS MISSING. + MOVEMM DEFNPN,CPGN +IFN TS, MOVEMM DEFNFI,INFFN1 + HLRZ T,B ;GET FILL CHARACTER + IMUL T,[REPEAT 5,[1_<.RPCNT*7>+]0] ;CONVERT TO ASCII FILL WORD SHIFTED -1 (IMUL SCREW) + LSH T,1 ;SHIFT TO PROPER POSITION (EXTRA IN CASE WANT TO FILL W/ HIGH BIT SET) + MOVEM T,AASEFW ;STORE AS FILL WORD, T NOW SET UP TO ACCUMULATE VALUE + CALL PASSPS + MOVEM A,TEXT4 ;STORE TERMINATOR +TEXT7: PUSHJ P,RCH +AASC8: CAMN A,TEXT4 + JRST AASC1A ;TERMINATOR + TLNN D,760000 + JRST TEXT6 ;WORD FULL +TEXT9: TLNE D,100 ;CHECK BOTTOM BIT OF SIZE FIELD OF BP + JRST AASC2 ;SET => NOT SIXBIT + SUBI A,40 + CAILE A,77 + SUBI A,40 ;CONVERT LOWER CASE ASCII TO UPPER CASE + JUMPGE A,.+2 + ETR ERRN6B +AASC3: IDPB A,D + TRO I,IRSYL + JRST TEXT7 + +ERRN6B: ASCIZ /Character not SIXBIT/ + ;TERMINATOR + +AASC1A: TLNN D,760000 ;SKIP UNLESS END OF WORD + SKIPGE AASCF1 ;SKIP UNLESS REGULAR + JRST [ MOVE CH1,ASMDS1 ;REGULAR OR NOT END OF WORD + MOVEM CH1,ASMDSP ;RESTORE ASMDSP AS SAVED AT START OF PSEUDO. + JRST TEXTX] + MOVEI CH1,1 ;END OF WORD AND NOT REGULAR + JRST AASC1B ;EXTRA 0 NEED FOR Z FLAVOR + +AASC2: CAIN A,"! + SKIPG AASCF1 + JRST AASC3 ;NOT .ASCII OR NOT EXCL + PUSH P,T ;READ FIELD + PUSH P,D + PUSH P,SYM + SAVE ASMOUT ;PREVENT CLOSEBRACKETS FROM TRYING TO TAKE EFFECT. + MOVEIM ASMOUT,4 ;NOTE THIS LOSES IF CALL PSEUDO THAT RETURNS TO ASSEM1. + MOVEI SYM,[SETOM ASUDS1] ;NOW TO SET UP UNDEFINED SYM CONDITION + TLNE FF,FLPPSS + MOVE SYM,[SQUOZE 0,.ASCII] ;PUNCHING PASS, UNDEFINED => REAL ERROR + CLEARM ASUDS1 + PUSHJ P,AGETFD + ;"UNDEFINED IN .ASCII" ERROR INSTR, ERROR MESSAGE BUT ONLY ON PASS 2 + ;BUT NOTE THAT ON PASS 2 IT MIGHT ASSEMBLE DIFFERENT NUMBER OF WORDS, + ;CAUSING LOSSAGE IF NOT IN CONSTANT + REST ASMOUT + POP P,SYM + POP P,D + POP P,T + SKIPGE ASUDS1 + MOVNI A,1 ;HAD UNDEFINED SYMS SO ASSUME MAX + SKIPGE ASUDS1 + TLO I,ILNOPT ;ALSO DON'T OPTIMIZE OVER IN CONSTANT + MOVE CH1,[440700,,AASBF] + MOVEM CH1,ASBP1 + MOVEM CH1,ASBP2 + PUSH P,[AASC5] + MOVE CH1,A +AASC6: LSHC CH1,-35. + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,AASC6 + HLRZ A,(P) + ADDI A,"0 + IDPB A,ASBP1 + POPJ P, + +AASC5: MOVEI A,0 + IDPB A,ASBP1 ;END .ASCII NUMBER WITH ZERO +AASC8A: TLNN D,760000 + JRST AASC7 ;END OF WORD + ILDB A,ASBP2 + JUMPE A,AASC9 + IDPB A,D + JRST AASC8A + +AASC9: TLO FF,FLUNRD + JRST TEXT7 + AASC7: TDZA CH1,CH1 +TEXT6: MOVNI CH1,1 ;WORD FULL +AASC1B: MOVEM CH1,AASCF2 + CLEARM CDISP + MOVEM A,TEXT8 + MOVE A,T + SKIPE AASCFT ;FOR .DECTXT, OUTPUT WORD INSTEAD OF RETURNING IT. + JRST [ CALL PPB + MOVE D,[440700,,T] + JRST TEXT2A] + TLO I,ILMWRD ;ELSE ARRANGE TO BE CALLED BACK TO RETURN NEXT WORD. + MOVEI T,ASSEM2 + MOVEM T,ASMDSP + SKIPLE CONSML ;IF NOT MULTI-LINE MODE, + JRST CLBPOP + MOVE T,ASMOUT ;IF THE TEXT IS IN <>'S OR ()'S, + HRRZ T,ASMOT2(T) + CAIE T,LSSTHA + JRST CLBPOP + CALL IGTXT ;USE ONLY THE FIRST WORD. + SKIPE CONSML ;AND ERROR IF IN ERROR MODE. + ETR [ASCIZ/Multi-word text pseudo in brackets/] + JRST CLBPOP + + ;GET NEXT WORD + +TEXT2: TRO I,IRFLD +TEXT2A: MOVE T,AASEFW ;INITIALIZE T TO FILL WORD + MOVE A,TEXT8 ;GET NEXT CHAR (ALREADY READ BY RCH) + SKIPGE B,AASCF2 + JRST TEXT9 ;REG OR HAVEN'T READ SECOND DELIMITER, FALL BACK IN + JUMPE B,AASC8A +TEXTX: SETZM DEFNPS + SKIPN AASCFT + JRST TEXT5 ;RETURNING FROM ASCIZ AFTER PUTTING THE TRAILING ZERO OUT. + MOVE A,T + CALL PPB ;FOR .DECTXT, OUTPUT THE FILL WORD INSTEAD. + JRST MACCR + +VBLK + +AASCF1: 0 ;-1 REG OR SIXBIT, 1 .ASCI 0 ASCIZ +AASCF2: 0 ;MULTIPLE WORD RETURN FLAG -1 REG 0 FINISH ! HACK 1 OUTPUT FILL WORD FOR Z +AASCFT: 0 ;0 REGULAR, -1 => .DECTXT (OUTPUT WORDS TO FILE INSTEAD OF RETURNING THEM) +TEXT4: 0 ;DELIMITER +TEXT8: 0 ;SAVED NEXT CHAR WHILE RETURNING BETWEEN WORDS +ASBP1: 0 ;IDPB TO AASBF ON .ASCII FIELD +ASBP2: 0 ;ILDB FROM AASBF " +AASBF: BLOCK 8 ;ACCUMULATED TYPEOUT OF NUMBER FOR .ASCII, EXTRA LONG FOR HACKERS TYPING OUT BINARY +ASUDS1: 0 ;UNDEFINED SYM FLAG FOR .ASCII DURING PASS 1 +AASEFW: 0 ;FILL WORD + +PBLK + +IGTXT: TLNN I,ILMWRD + RET + PUSH P,A ;ROUTINE TO EAT UP TEXT OF UNDESIRED MULTIPLE WORD + SKIPLE AASCF2 ;DETECT SCREW CASE: AFTER ASCIZ OF 5 CHARS, DELIMITER IS + JRST IGTXT1 ;ALREADY GOBBLED, BUT SOME OF THE ASCIZ REMAINS. + PUSHJ P,RCH + CAME A,TEXT4 + JRST .-2 +IGTXT1: TLZ I,ILMWRD + MOVEMM ASMDSP,ASMDS1 + SETZM DEFNPS + JRST POPAJ + +;".ASCVL /X" RETURNS THE ASCII VALUE OF "X". NOTE THE DELIMITER IS NOT REPEATED +;AND SERVES ONLY TO ALLOW SPACES TO BE IGNORED WHILE WINNING IF X IS A SPACE. +A.ASCV: CALL PASSPS ;SKIP SPACES TO REACH THE DELIMITER. + CALL RCH ;READ THE CHAR AFTER THE DELIMITER + MOVE T,A + JRST TEXT5 ;AND RETURN ITS ASCII VALUE. + ASQOZ: HLLM B,(P) ;SAVE FLAG THAT'S 0 FOR SQUOZE, -1 FOR .RSQZ . + SAVE SYM + PUSHJ P,AGETFD + LSH A,36 + PUSH P,A + PUSHJ P,GETSLD ;GET SYM, SAVE DELIMITER FOR REINPUT + CALL NONAME + REST A + LDB B,[4000,,SYM] ;GET JUST THE SQUOZE. + SKIPGE -1(P) + PUSHJ P,ASQOZR ;FOR .RSQZ, RIGHT-JUSTIFY IT. + SUB P,[1,,1] + ADD A,B + JRST CLBPOP + +;RIGHT-JUSTIFY THE SQUOZE WORD IN B. +ASQOZR: MOVE SYM,B + IDIVI SYM,50 + JUMPN LINK,CPOPJ ;LAST ISN'T BLANK, DONE. + MOVE B,SYM ;ELSE REPLACE BY WHAT'S SHIFTED RIGHT 1 CHAR. + JRST ASQOZR + + ;COMMON PSEUDO ROUTINE TO RETURN MIDAS INTERNAL QUANTITY + ;ADR IN LH(B)) AS VALUE (EG. .RPCNT, .FNAM1, .AVAL2, ETC. + ;INTSYMS MAY APPEAR TO LEFT OF = + +INTSYM: MOVE A,B ;GET ADR IN LH(A) + JRA A,CLBPOP ;RETURN IT + + ;.YSTGW, .NSTGW ACCORDING TO WHAT'S IN LH(B) + +STGWS: HLRES B ;.NSTGW INCREMENTS STGSW, .YSTGW DECREMENTS. + ADDB B,STGSW + SKIPGE B ;BUT DON'T DECREMENT PAST 0. + SETZM STGSW + JRST MACCR ;STORAGE WORDS ARE ALLOWED IF STGSW IS ZERO. + + ;.TYPE + +A.TYPE: SAVE SYM + SAVE SYM + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + SUB P,[2,,2] + TRNN I,IRLET ;IF SYLLABLE IS A NUMBER, + JRST [ SETO A, ;RETURN -1. + JRST CLBPOP] + PUSHJ P,ES ;EVALUATE SYM, INTERESTED IN SQUOZE FLAGS RETURNED IN A + MOVEI A,17 ;DIDN'T SKIP, RETURN 17 => UNSEEN +IFN CREFSW,XCT CRFINU + JRST CLBPOP + +NONAME: MOVE SYM,-2(P) + ETSM [ASCIZ /No arg/] + SETZ SYM, + POPJ P, + + ;.FORMAT + +A.FORMAT: PUSHJ P,AGETFD ;GET FIRST FIELD (FORMAT #) + MOVE B,CDISP ;WORD TERMINATOR ENDED 1ST ARG => + TLNN B,DWRD + JRST A.FOR1 ;RETURN CURRENT SPEC FOR THAT FORMAT. + PUSH P,A + PUSHJ P,AGETFD ;GET SECOND FIELD (TABLE ENTRY FOR FORMAT NUMBER) + POP P,B + MOVEM A,FORTAB-10(B) + JRST ASSEM1 + +A.FOR1: MOVE A,FORTAB-10(A) + JRST CLBPOP + A.BYTE: NOVAL + CLEARM NBYTS ;# BYTES ASSEMBLED + CLEARM BYTMT ;TOTAL ACTIVE BYTES IN TABLE + MOVE A,[440700,,BYBYT] ;POINTER TO NEW TABLE + MOVEM A,BYTMP +A.BY1: PUSHJ P,AGETFD ;GET FIELD, .GE. 0 => BYTE, .LT. 0 => HOLE + MOVE C,ISAV + TRNN C,IRFLD + JRST A.BY2 ;NO FIELD + MOVM B,A + SKIPGE A + TRO B,100 + IDPB B,BYTMP + AOS BYTMT +A.BY2: TLNE CH1,DWRD ;CDISP LEFT IN CH1 BY AGETFD + JRST A.BY1 ;NOT WORD TERMINATOR + SKIPN BYTMT ;WORD TERMINATOR, ANY FIELDS? + JRST A.BY3 ;NO, DO .WALGN AND RESET TO WORD MODE + SETOM BYTM ;ENTERING BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETOM BYTM1 + PUSHJ P,BYSET + MOVE A,GLSPAS + MOVEM A,GLSP1 + JRST ASSEM1 + + ;RESET THE BYTE DESCRIPTOR TABLE POINTERS TO POINT TO NEW WORD + +BYSET: CLEARM BYTMC ;COUNT OF BYTES PROCESSED THIS TABLE SCAN + MOVE A,[440700,,BYBYT] ;POINTER TO DESCRIPTOR TABLE + MOVEM A,BYTMP + ILDB A,BYTMP ;FIRST DESCRIPTOR BYTE + AOS BYTMC + DPB A,[300600,,BYTWP] ;DEPOSIT AS FIRST BYTE SIZE + POPJ P, + +A.BY3: CLEARM BYTM ;NO LONGER IN BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETZM BYTM1 + JRST A.WAL1 + +A.WALGN: NOVAL +A.WAL1: LDB A,[360600,,BYTWP] + CAIN A,44 + JRST ASSEM1 ;ALREADY AT BEGINNING OF WORD + MOVEI A,44 + DPB A,[360600,,BYTWP] ;MAKE IT POINT TO BEGINNING OF WORD + PUSHJ P,BYSET + CLEARM T1 + JRST PBY1 + BYTIN1: CLEARM BYTMC + MOVE A,[440700,,BYBYT] + MOVEM A,BYTMP +BYTINC: AOS A,BYTMC + CAMLE A,BYTMT + JRST BYTIN1 + ILDB A,BYTMP + DPB A,[300600,,BYTWP] + MOVEM A,T1 + HLLZ A,BYTWP + IBP A + TRNN A,-1 + JRST BYTINR + ;NEXT BYTE GOES IN NEXT WORD +PBY1: MOVE P,ASSEMP ;PCONS NEEDS THIS. + MOVEI A,WRD-1 + PUSH A,BYTW ;INTO WRD, + PUSH A,BYTRLC ;INTO WRDRLC + CLEARM BYTW + SETZM BYTRLC + MOVEI A,44 + DPB A,[360600,,BYTWP] + MOVE AA,ASMOUT + JRST @ASMOT4(AA) ;TO PBY4 OR PBY5 OR PBY3 + +PBY4: SKIPE STGSW + ETR ERRSWD + PUSHJ P,PWRD ;NOT IN CONST., OUTPUT WORD. + AOSA CLOC +PBY3: JSP T,PCONS ;OUTPUT INTO CONST. +PBY5: MOVE A,GLSPAS + MOVEM A,GLSP1 +BYTINR: MOVE A,T1 ;CURRENT BYTE SIZE + TRNN A,100 + JRST @ASMDSP + SETZB A,B ;ASSEMBLE HOLE (BLANK BYTE) IMMEDIATELY AFTER PREVIOUS BYTE + JRST PBY2 + +PBYTE: AOS NBYTS +PBY2: MOVEI AA,WRD-1 + PUSH AA,BYTW ;INTO WRD + PUSH AA,BYTRLC ;INTO WRDRLC + IBP BYTWP + LDB T,[301400,,BYTWP] + PUSHJ P,INTFLD + POP AA,BYTRLC ;WRDRLC + POP AA,BYTW ;WRD + JRST BYTINC + + ;VARIABLES FOR .BYTE, .BYTC, .WALGN + +VBLK +BYTM: 0 ;-1 FOR IN BYTE MODE, LAMBDA BOUND BY <'S, ('S, AND ['S ;] +BYTMC: 0 ;COUNT CORRESP WITH BYTMP +BYTMP: 0 ;POINTER TO BYTE DESC TABLE +BYTMT: 0 ;TOTAL ACTIVE BYTES IN TABLE +BYTM1: 0 ;GLOBAL VALUE OF BYTM - WHAT IT WAS OUTSIDE THE OUTERMOST BRACKET + +;FORMAT OF BYTE DESC TABLE +;SEVEN BIT BYTES +;1.7=0 ASSEMBLE =1 BLANK +;1.1 - 1.6 NUMBER OF BITS + +IFNDEF LBYBYT,LBYBYT==5 ;LENGTH OF BYBYT +BLCODE [BYBYT: BLOCK LBYBYT] ;BYTE DESC TABLE, 7 BITS PER DESC + +BYTWP: 440000,,BYTW ;POINTER TO BYTW IDPB TO DEPOSIT CURRENT BYTE +BYTW: 0 ;WORD BEING ASSEMBLED IN BYTE MODE +BYTRLC: 0 ;RELOC OF BYTW. +NBYTS: 0 ;NUMBER BYTES ASSEMBLED (FOR .BYTC) +BYTMCL==.-BYTMC +PBLK + ;;MACRO PROCESSOR +IFN MACSW,[ + ;GET IN B THE CHAR WHOSE ADR IS IN A, INCREMENT A + +REDINC: MOVE CH1,A + IDIVI CH1,4 + LDB B,PTAB(CH2) + AOJA A,CPOPJ + +VBLK ;THIS STUFF ALL RELOCATED WHEN MACTAB ADDR CHANGED. +PTAB: (341000+CH1)MACTBA ;BYTE TABLE + (241000+CH1)MACTBA + (141000+CH1)MACTBA + (41000+CH1)MACTBA + (341000+CH1)MACTBA+1 + + ;IN FOLLOWING MACROS, B = -1, 0, OR +1 (+ SIGN MUST BE GIVEN) + ;0 => BP SAME AS CHAR ADR, -1 => BP FOR ILDB, 1 => BP ONE AHEAD + + ;CHAR ADR IN A, RETURNS BP IN A, CLOBBERS A+1 + +DEFINE BCOMP A,B/ + IDIVI ,4 + ADD ,(+1)BCOMPT!B +TERMIN + +STOPPT: 041000,,MACTBA-1 +BCOMPT: 341000,,MACTBA + 241000,,MACTBA +BCOMPU: 141000,,MACTBA + 041000,,MACTBA + 341000,,MACTBA+1 + +;BP IN A RETURN CHAR ADR IN A, CLOBBERS A-1 (YES, A MINUS 1) +;2ND ARG IS SUBTRACTED - -1 GIVES ADDR OF THE NEXT CHAR. +DEFINE CCOMP A,B/ + MOVEI -1,0 + ASHC -1,2 + SUB ,(-1)CCOMPT!B +TERMIN + + ;BP IN A RETURN CHAR ADR IN A+1, CLOBBERS A + +DEFINE CCOMP1 A,B/ + MULI ,4 + SUB +1,(A)CCOMPT!B +TERMIN + +;FROM HERE THRU CCOMPE SET BY MACINI. +CCOMPB: 0 ;4*<41000,,MACTBA>-4 +CCOMPT: REPEAT 5,0 ;4*<41000,,MACTBA>+.RPCNT-3 +CCOMPE::PBLK + + ;BP IN A, DECREMENT IT + +DEFINE DBPM A + ADD A,[100000,,] + SKIPGE A + SUB A,[400000,,1] +TERMIN + ;SET UP CPTR FROM CHAR ADR IN A + +ACPTRS: MOVEI CH1,(A) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE COMPUTED CPTR + POPJ P, + +AFCOMP: HRRZM A,FREEPT ;ENTRY TO STORE C(A) INTO FREEPT +FCOMP: MOVE CH1,FREEPT ;COMPUTE FREPTB FROM FREEPT + BCOMP CH1,-1 + MOVEM CH1,FREPTB ;STORE CALCULATED BYTE POINTER + POPJ P, + +STPWR: MOVEI A,375 + JRST PUTREL + +VBLK +PUT377: MOVEI A,377 +PUTREL: JRST PUTRE1 ;IDPB A,FREPTB;STORE CHAR INTO FREE CHARACTER STORAGE + AOS A,FREEPT ;CLOBBERS ONLY A. + AOS PUTCNT + CAMGE A,MACHI + POPJ P, + JRST GCA +PBLK +PUTRE1: PUSH P,[IDPB A,FREPTB] + POP P,PUTREL ;COME HERE ONLY ON 1ST CALL TO PUTREL. + SETOM INICLB ;HAVE WRITTEN IN MACRO TAB & CLOBBERED INIT. + JRST PUTREL ;NOW GO BACK AND REALLY WRITE CHAR. + +;200 BIT SET ON CHAR READ FROM MACTAB, PROCESS SPECIAL CONDITION +;CLOBBERS A,CH1,CH2. + +MACTRM: CAIN A,176 ;376? + JRST RCHTRA ;376 => IGNORE, CHARACTER USED TO CLOBBER UNDESIRED CHARACTERS IN MACRO STORAGE + PUSH P,B ;SAVE B + CAIE A,177 + CAIN A,175 + JRST MRCH1 ;377, 375 => STOP + ADD A,BBASE ;DUMMY, RELOCATE TO POINT TO DUMMY TABLE + MOVEI B,RCHSAV ;RETURN TO RCHSAV ON END OF DUMMY + PUSHJ P,PUSHEM ;SAVE CURRENT STATUS + HRRZ A,(A) ;GET CHAR ADR OF DUMMY + BCOMP A,-1 ;CONVERT TO BYTE POINTER + MOVEM A,CPTR ;STORE AS NEW CPTR + MOVE A,TOPP + MOVEM A,BBASE +RCHTRB: POP P,B +RCHTRA: POP P,A ;POP RETURN + TLZN FF,FLUNRD ;IF NO CHAR TO RE-READ, JUST RETURN BACK TO THE ILDB A,UREDP. + JRST -3(A) + ANDI A,-1 ;IF A CHAR TO RE-READ, IF CALLED FROM RREOF, WE CAN RETURN TO RRU + CAIN A,RREOF+1 + JRST RRU + SAVE A ;OTHERWISE, CALL RCH TO RE-READ THAT CHAR, AND RETURN IT FROM + JRST RCH1 ;THE CURRENT ATTEMPT TO READ A CHAR. + +MRCH1: MOVE B,MACP +BPOPJ: POPJ B, ;RETURN AT END OF STRING EXPANSION + ;RCHSET ROUTINE TO CAUSE INPUT FROM MACRO PROCESSOR + +RCHMAC: TLO FF,FLMAC ;SET FLAG + JSP A,CPOPJ +RCHMC0: REPEAT 2,[ ;GETCHR, RR1 + ILDB A,CPTR ;GET CHAR + TRZE A,200 ;200 BIT... + PUSHJ P,MACTRM ;=> SPECIAL, PROCESS +] + .VALUE +IFN .-RCHPSN-RCHMC0,.ERR RCHMC0 LOSES. + ILDB A,CPTR ;SEMIC + TRZE A,200 + PUSHJ P,MACTRM + CAIE A,15 + JRST SEMIC ;NOT YET + JRST SEMICR ;YET + + ;PUSH INPUT STATUS IN FAVOR OF MACRO + ;B HAS RETURN ADR FOR END OF MACRO (OR WHATEVER) + ;SEE ALSO PMACP + +PUSHEM: PUSH P,A + PUSH P,F + MOVE F,MACP ;GET MACRO PDL POINTER + MOVE CH1,CPTR + CCOMP1 CH1,-1 ;CONVERT TO CHARACTER ADDRESS + HRL CH2,BBASE + PUSH F,CH2 ;PUSH BBASE,,CPTR + MOVEI A,1 ;=> EXPAND MACRO + PUSHJ P,PSHLMB ;SAVE LIMBO1 STATUS AND RETURN + JRST PSHM1 + + ;UNDO A PUSHEM + ;RETURNS BBASE,,CPTR IN B (CPTR RE-INITIALIZED, BBASE NOT) + +POPEM: PUSH P,A + PUSH P,F + MOVE F,MACP + PUSHJ P,POPLMB ;RESTORE LIMBO1 STATUS + POP F,B ;BBASE,,CPTR + MOVEI CH1,(B) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE NEW CPTR +PSHM1: MOVEM F,MACP ;STORE BACK MACRO PDL POINTER +POPFAJ: POP P,F +POPAJ: POP P,A + POPJ P, + PMACP: MOVE B,MACP ;POP MACRO PDL + HRRZ A,(B) + SUB B,[1,,1] +IFN RCHASW,CAIE A,A.TYM8 + CAIN A,AIRR + JRST A.GO6 ;IRP OR .TTYMAC + CAIN A,REPT1 + JRST A.GO4 ;REPEAT + CAIE A,RCHSV1 ;MACRO + CAIN A,RCHSAV ;ARG + JRST A.GO6 + .VALUE ;DON'T HAVE RETURN, + JRST A.GO6 ;BUT TRY A.GO6 LIKE EVERYTHING BUT REPEAT + +A.GO4: HLLZS -1(B) ;REPEAT, CLEAR OUT COUNT REMAINING +A.GO6: TRO FF,FRMRGO ;EVERYTHING ELSE, SET FLAG TO QUIT + JRST (A) + + ;4.9(B) => .STOP ELSE .ISTOP + +A.STOP: HRRZ A,MACP + JUMPL B,A.STP1 + HRRZ B,(A) ;.ISTOP + CAIN B,REPT1 + HLLZS -2(A) ;REPEAT, STOP ALL INTERATIONS + CAIN B,AIRR + HRRZS -1(A) ;IRP TYPE, CLEAR OUT # GROUPS, DON'T ALLOW RECYCLE +A.STP1: MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP + JRST POPJ1 + +A.QOTE: JFCL +ATERMI: ETSM [ASCIZ/Not in macro/] + JRST MACCR ;MAYBE FLUSH MESSAGE IF PEOPLE HAVE PROBLEMS + ;PDL STRUCTURE FOR REPEAT +;TWO TWO WORD ENTRIES +;BBASE,,CPTR +;LIMBO1 STATUS,,# TIMES LEFT +;OLD .RPCNT,,BEG OF BODY +;GARBAGE,,REPT1 + +AREPEAT: PUSHJ P,AGETFD + JUMPLE A,COND5 ;NO REPEAT PLAY LIKE STRING COND FALSE + PUSH P,A + MOVE A,FREEPT + MOVEM A,PRREPT ;CHAR ADR BEGINNING OF REPEAT + MOVEI A,373 ;CHECK CHAR FOR REPEAT + PUSHJ P,PUTREL ;STORE AS FIRST CHR OF BODY + JSP D,RARL1 + CAIA + CALL RARGCP ;READ THE ARG & COPY INTO MACRO STORAGE. + MOVEI A,^M ;IF THE ARG WASN'T BRACKETED, + TLNE FF,FLUNRD + CALL PUTREL ;INCLUDE THE TERMINATING CR. +SWRET1: PUSHJ P,STPWR ;ALSO RETURN FROM STRING WRITE (.F .I) + POP P,B ;# TIMES TO GO THROUGH + PUSHJ P,PUSHEM + MOVE B,MACP ;NOW GET MACRO PDL POINTER FOR PUSH OF SECOND ENTRY + MOVNI T,1 + EXCH T,CRPTCT ;GET OLD .RPCNT, INITIALIZE NEW ONE TO -1 +CREPT1: SETZI TT,REPT1 + EXCH TT,PRREPT ;GET LOC BEGINNING OF BODY, CLEAR OUT PRREPT, DON'T NEED IT ANYMORE + HRL TT,T + PUSH B,TT ;SAVE OLD .RPCNT,,ADDRESS OF BODY. + PUSH B,CREPT1 ;PUSH CRUD,,REPT1 FOR RETURN + MOVEM B,MACP ;STORE BACK UPDATED MACRO POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE IMMEDIATE CYCLE + JRST MACCR + +IFN .I.FSW,[ ;CODING FOR .I, .F + +SWINI: MOVE A,FREEPT ;INITIALIZE, WILL EVENTUALLY PLAY LIKE REPEAT 1 + MOVEM A,PRREPT + MOVEI A,373 + JRST PUTREL + +SWRET: PUSH P,[1] ;REPEAT COUNT + JRST SWRET1 + +SWFLS: MOVE A,PRREPT ;FLUSH RETURN + PUSHJ P,AFCOMP + JRST MACCR +] + ;RECYCLE AROUND REPEAT + +REPT1: PUSH P,A + PUSH P,C + HRRZ A,(B) ;CHAR ADR BEG BODY + PUSHJ P,REDINC + CAIE B,373 + HALT ;FIRST CHAR OF REPEAT BODY NOT 373 + HRRZ C,MACP + HRRZ B,-2(C) ;# TIMES LEFT + SOJL B,REPT2 ;JUMP IF LAST TIME THROUGH WAS LAST TIME TO GO THROUGH + AOS CRPTCT + PUSHJ P,ACPTRS ;SET UP CPTR (CHAR ADR IN A) + HRRM B,-2(C) ;STORE UPDATED COUNTDOWN +REPT3: POP P,C + POP P,A + JRST REPT6 + +REPT2: SOS A ;MOVE BACK TO BEG OF REPEAT + ;(IN CASE GETS STORED INTO FREEPT) + MOVE CH2,CPTR + CCOMP CH2,-1 ;CONVERT TO CHARACTER ADDRESS + CAMN CH2,FREEPT + PUSHJ P,AFCOMP + MOVE A,[-3,,-2] + ADDB A,MACP + HLRZ A,1(A) + MOVEM A,CRPTCT + PUSHJ P,POPEM + JRST REPT3 + ;STRING CONDITIONALS (IFSE, IFSN) + +SCOND: MOVE A,FREEPT + MOVEM A,PRSCND + MOVEM A,PRSCN1 + SAVE SYM + HRRI B,SCONDF + SAVE B ;REMEMBER TEST INSTRUCTION. + SETOB C,SCONDF + JSP D,RARG ;COPY THE 1ST OF THE 2 STRINGS + CAIA + CALL RARGCP ;INTO MACRO STORAGE, FOLLOWED BY 375. + CALL STPWR + JSP D,RARG ;THEN START READING THE 2ND ARG, + JRST SCOND3 ;GO TO SCOND3 WHEN REACH END OF 2ND ARG. + JSP D,RARGCH(T) ;READ NEXT CHAR OF 2ND ARG, + JRST SCOND3 + EXCH A,PRSCND + PUSHJ P,REDINC ;RE-FETCH NEXT CHAR OF 1ST ARG + EXCH A,PRSCND + CAMN B,A ;COMPARE CHARACTERS + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CAIL A,"A+40 + CAILE A,"Z+40 ;NOT EQUAL => CONVERT BOTH TO UPPER CASE. + CAIA + SUBI A,40 + CAIL B,"A+40 + CAILE B,"Z+40 + CAIA + SUBI B,40 + CAMN B,A ;ARE THEY SAME EXCEPT FOR CASE? + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CLEARM SCONDF ;STRINGS DIFFER + CALL RARFLS ;IGNORE REMAINDER OF 2ND ARG. +SCOND3: CLEARB A,C ;END OF (SECOND) STRING ARG ENCOUNTERED + EXCH C,PRSCN1 + MOVEM C,FREEPT + PUSHJ P,FCOMP + EXCH A,PRSCND + PUSHJ P,REDINC + CAIE B,375 + CLEARM SCONDF + REST B + REST SYM + XCT B ;DO THE TEST. + JRST COND4 + JRST COND2 + VBLK +BLCODE [DMYDEF: BLOCK DMDEFL] ;TABLE OF DUMMY NAMES FOR THING BEING DEFINED +DMYTOP: DMYDEF ;POINTER INTO DMYDEF, POINTS TO AVAILABLE WORD + ;SINCE ONLY ONE THING CAN BE DEFINED AT ONCE, IT IS NOT NECESSARY TO SAVE AND RESTORE DMYTOP +DMYBOT: DMYDEF ;-> 1ST DMYDEF WD USED AT THIS LEVEL. + ;RIGHT NOW, ALWAYS -> DMYDEF SINCE CAN'T HAVE DEFINITION + ;WITHIN A DEFINITION YET. + +PBLK + +PDEF: PUSHJ P,GSYL ;READ IN SYL + CAIE T,", ;IF DELIMITING CHR NOT , + JUMPE SYM,CPOPJ ;AND SYM NULL, RETURN +PDEF1: MOVEM SYM,@DMYTOP ;STORE SYM + AOS D,DMYTOP ;INCR PNTR + CAIL D,DMYDEF+DMDEFL ;CHECK FOR TABLE SIZE EXCEEDED + ETF [ASCIZ/Too many dummies in DEFINE or IRP/] + POPJ P, + +VBLK +BLCODE [DSTG: BLOCK DSSIZ] ;TABLE OF CHAR ADRS OF DUMMIES BEING DEFINED PRIOR TO MACRO EXPANSION +RDWRDP: DSTG ;POINTER TO DSTG, POINTS TO FREE WORD + ;NOTE THAT RDWRDP MUST BE SAVED AND RESTORED SINCE MORE MACROS CAN + ;BE EXPANDED DURING FIELD READ FOR DUMMY +PBLK + +ADDTR1: CLEARM PUTCNT +ADDTRN: MOVE A,FREEPT +ADDTR2: MOVEM A,@RDWRDP + AOS A,RDWRDP + CAIL A,DSTG+DSSIZ + ETF [ASCIZ/Too many dummies in all macros & IRPs being expanded/] + RET + +VBLK +BLCODE [DMYAGT: BLOCK DMYAGL] ;TABLE OF CHAR ADRS OF DUMMYS OF MACROS BEING EXPANDED + ;DMYAGT TRACKS WITH THE MACRO PDL; + ;DMYAGT CAN'T BE COMBINED WITH DSTG SINCE DMYAGT CAN BE SHIFTING AROUND RANDOMLY DURING ARG SCAN +BBASE: DMYAGT ;POINTER TO BEGINNING OF ACTIVE DUMMY LIST (FOR DEEPEST-NESTED MACRO BEING EXPANDED) + ;ADD TO DUMMY # TO GET LOCATION CONTAINING CHAR ADR OF DUMMY +TOPP: DMYAGT ;POINTER TO TOP OF DMYAGT ACTIVE, POINTS TO FREE REGISTER +PBLK + + ;ACTIVATE DUMMYS ON TOP OF DSTG TABLE + ;A -> FIRST (LOWEST) DUMMY IN DSTG TO ACTIVATE + +DMYTRN: MOVE B,TOPP + MOVEM B,BBASE + PUSH P,A +DMYTR2: CAML A,RDWRDP + JRST DMYTR1 + MOVE B,(A) + MOVEM B,@TOPP + AOS B,TOPP + CAIL B,DMYAGT+DMYAGL + ETF [ASCIZ /Too many dummy args active/] + AOJA A,DMYTR2 +DMYTR1: POP P,RDWRDP + POPJ P, + ;THE MACRO TABLE IS FILLED MAINLY WITH 8-BIT BYTES. +;THE FIRST WORD'S ADDR IS IN MACTAD; THE LAST+1'S IN MACTND. +;THE CHARACTER NUMBER OF THE LAST+1ST CHAR IS IN MACHI. +;MACHIB IS BP. TO HIGHEST BYTE OK TO FILL (LAST IN C(MACTND)-1) + +;IF A BYTE IN THE TABLE HAS ITS HIGH BIT OFF, IT IS AN ASCII CHARACTER. +;OTHERWISE, IT IS SPECIAL. IF THE 100 BIT IS OFF IT MEANS +;SUBSTITUTE A MACRO DUMMY ARG WHEN READ; THE CHAR IS THE NUMBER OF THE ARG+200 . + +;377 AND 375 ARE STOP CODES, CAUSING A POP OUT OF THE CURRENT STRING. +;GC CONSIDERS THE CHAR. AFTER A 375 TO START A NEW STRING. + +;376 IS IGNORED WHEN READ; USED TO CLOBBER UNWANTED CHARACTERS IN STRINHGS. + +;374 STARTS EVERY MACRO-DEFINITION. +;373 STARTS THE BODY OF A REPEAT. + +;370 STARTS A WORD STRING: +;THE WORD AFTER THAT WHICH CONTAINS THE 370 +; HAS THE LENGTH IN WORDS OF THE STRING IN ITS LH, +; IN ITS RH, THE ADDRESS OF WD WHICH POINTS BACK TO THIS ONE. +; THEN FOLLOW RANDOM WDS HOLDING ANYTHING AT ALL. +; GC WILL MAKE SURE IT STAYS ON WD BOUNDARY. +; THE LENGTH INCLUDES THE WD HOLDING THE LENGTH. +; IF THE RH OF 1ST WD HAS 0, GC WILL FLUSH THE STRING + +STRTYP: PUSHJ P,REDINC ;DEBUGGING AID ONLY + EXCH A,B + TRZE A,200 + JRST STRTP1 +STRTP2: PUSHJ P,TYO ;NORMAL CHAR, JUST TYPE OUT + MOVE A,B + JRST STRTYP + +STRTP1: PUSH P,A + MOVEI A,"* ;SPECIAL CHAR, TYPE * + PUSHJ P,TYO + POP P,A + TRNE A,100 + JRST STRTP3 ;CONTROL CHAR + ADDI A,260 ;DUMMY, CONVERT TO # + JRST STRTP2 ;TYPE OUT (SINGLE DIGIT) NUMBER + +STRTP3: CAIN A,175 + SKIPA A,C% ;STOP, TYPE % + MOVEI A,"/ ;SOMETHING ELSE, TYPE / + JRST STRTP2 + + + ;.GSSET, SET GENERATED SYM COUNTER + +A.GSSET: CALL AGETFD + MOVEM A,GENSM + JRST ASSEM1 + ;GSYL-LIKE ROUTINE, READ A SYL FOR WRQOTE + +WRQRR: PUSHJ P,RCH ;GET CHAR (MAYBE WANT THIS TO BE FASTER YET) + IDPB A,FREPTB ;DEPOSIT IN MACRO TABLE + CAMN F,FREPTB ;WAS THIS LAST CHAR IN TABLE? + JRST WRQRGC ;YES, NEED GARBAGE COLLECTION +WRQRR2: XCT GDTAB(A) ;DISPATCH ON CHAR + JFCL ;(MAYBE SKIPS) + SOJGE D,WRQRR ;LOOP FOR FIRST SEVEN CHARS + HRRI D,0 + JRST WRQRR + + ;HERE FROM WRQRR WHEN NEED GARBAGE COLLECTION OF MACRO TABLE + +WRQRGC: MOVEM C,WRQTBP ;PUT POINTER TO BEGINNING OF SYL WHERE IT WILL BE GC'D + MOVE A,MACHI + PUSHJ P,GCA ;GARBAGE COLLECT + MOVE F,MACHIB ;RESET F TO POINT TO NEW LAST CHAR IN MACTAB + MOVEI C,0 + EXCH C,WRQTBP ;GET BACK POINTER TO CHAR BEFORE SYL + MOVE A,LIMBO1 ;RETRIEVE LAST CHAR READ + JRST WRQRR2 ;LOOP BACK, PROCESS CHAR + + ;HERE FROM WRQOTE IF .QUOTE SEEN + ;.QUOTE TAKES ARG LIKE ASCII, PRINTC, ETC. + +A.QOT1: MOVE A,WRQBEG(P) ;GET BACK BP TO CHAR BEFORE .QUOTE + PUSHJ P,A.QOTS ;SET UP FREEPT AND FREPTB PROPERLY + MOVE A,LIMBO1 ;NOW GET CHAR AFTER .QUOTE + CAIE A,^I + CAIN A,40 ;COMPARE WITH SPACE + PUSHJ P,RCH ;SPACE, GOBBLE NEXT CHAR FOR DELIMITER, ELSE THIS ONE + MOVEM A,A.QOT2 ;STORE AS TERMINATOR OF STRING +A.QOT3: PUSHJ P,RCH ;GET CHAR TO QUOTE + CAMN A,A.QOT2 ;TERMINATOR? + JRST WRQOT1 ;TERMINATOR, BACK FOR MORE DEFINITION + PUSHJ P,PUTREL ;DEPOSIT CHAR + JRST A.QOT3 + ;READ IN BODY OF MACRO, IRP, OR WHATEVER + +WRQOTE: SAVE [0] ;USED FOR LENGTH OF SYMBOL (REALLY 6 MINUS IT). +WRQLEN==,-2 + SAVE [0] ;THIS WD USED FOR DEFINE/TERMIN COUNT. +WRQLVL==,-1 + SAVE [0] ;USED TO REMEMBER BEGINNING OF SYMBOL. +WRQBEG==0 + SETOM INICLB ;CLOBBERED INITS, .SYMTAB NOW ILLEGAL. + PUSHJ P,RCH ;MAYBE POP UP A LEVEL IN EXPANSIONS, SAVE MACTAB SPACE + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-INPUT + MOVE F,MACHIB ;POINTER TO LAST CHAR OK TO PUT IN MACTAB, STAYS IN F + TRO I,IRSYL\IRLET ;MAKE SURE FLAGS SET SO WON'T WASTE TIME AT MAKNUM, POINT +WRQOT0: +WRQOT1: MOVEI D,6 ;SQUOZE COUNTER + MOVEI SYM,0 ;INITIALIZE SYM + MOVE C,FREPTB ;GET POINTER TO CHAR BEFORE SYL ABOUT TO READ + PUSHJ P,WRQRR ;READ SYL + JUMPE SYM,.-2 ;LOOP UNTIL NON-NULL + ;NOW SEE IF DUMMY; **NOTE**: C STILL HAS BYTE POINTER, A SYL TERMINATOR + MOVE B,DMYBOT + CAML B,DMYTOP + JRST WRQOT2 ;NOT DUMMY + CAME SYM,(B) ;COMPARE WITH DUMMY NAME + AOJA B,.-3 ;LOOP ON NO MATCH + SUB B,DMYBOT ;DUMMY, CONVERT TO NUMBER + 200 + SUBI B,200 + LDB T,C ;GET LAST CHAR BEFORE SYL + CAIE T,"! ; ^ NOTE THAT THIS CAN LOSE IF MACRO HAS 33. ARGS + IDPB B,C ;NOT EXCLAMATION POINT, LEAVE THERE, DEPOSITING DUMMY CHAR + CAIN T,"! + DPB B,C ;EXCL, WIPE IT OUT + MOVEM C,FREPTB ;RESET FREPTB + CAIE A,"! ;A HAS DUMMY TERMINATOR, COMPARE WITH EXCL + TLO FF,FLUNRD ;NOT EXCLAMATION POINT, CAUSE IT TO BE RE-INPUT + JRST WRQOT1 ;LOOP BACK FOR NEXT SYL + +;SYL ISN'T DUMMY, CHECK FOR PSEUDO +WRQOT2: MOVEM D,WRQLEN(P) ;REMEMBER START OF AND LENGHTH OF THE SYMBOL. + MOVEM C,WRQBEG(P) + SETOM ESBK ;EVAL IN CURRENT BLOCK. + PUSHJ P,ES ;EVALUATE SYM (DOESN'T CLOBBER F) + JRST WRQOT0 ;NOT SEEN + CAIE A,PSUDO/40000 + JRST WRQOT0 ;NOT PSEUDO + TLZ B,-1 ;CLEAR OUT LH OF VALUE, ONLY INTERESTED IN RH + CAIN B,A.QOTE + JRST A.QOT1 ;.QUOTE + CAIE B,ADEFINE + CAIN B,AIRP + AOS WRQLVL(P) ;DEFINE OR IRP +IFN RCHASW,[CAIN B,A.TTYM + AOS WRQLVL(P) ;.TTYMAC +] + CAIE B,ATERMIN + JRST WRQOT0 + SKIPGE WRQLEN(P) + ETR [ASCIZ /TERMIN longer than 6 chars/] + SOSL WRQLVL(P) ;TERMIN, SKIP IF THE TERMINATING ONE + JRST WRQOT0 ;NOT MATCHING TERMIN, BACK FOR NEXT SYL + POP P,A ;GET BACK BP TO LAST CHAR BEFORE TERMIN + SUB P,[2,,2] .SEE WRQLVL,WRQBEG + MOVE T,DMYBOT ;WE'RE NO LONGER USING SPACE IN DMYDEF. + MOVEM T,DMYTOP +A.QOTS: LDB T,A ;HERE ALSO FROM A.QOT1, GET CHAR BEFORE .QUOTE OR TERMIN + CAIE T,"! + JRST A.QTS2 ;NOT EXCLAMATION POINT => OK + DBPM A, ;EXCLAMATION POINT, DECREMENT POINTER +A.QTS2: MOVEM A,FREPTB ;STORE AS NEW FREPTB + CCOMP1 A,-1 ;CONVERT TO CHAR ADR + MOVEM B,FREEPT ;STORE CHAR ADR AS NEW FREEPT + POPJ P, + ;FORMAT OF A MACRO: +;IT STARTS WITH A 374. +;THEN COME ARGUMENT DESCRIPTORS, ONE PER ARGUMENT. +MCF==777650 ;BITS AND FIELDS ARE: +MCFDEF==200 ;ARG IS DEFAULTED. MCFDEF AND MCFGEN NEVER BOTH SET. +MCFGEN==100 ;ARG SHOULD BE GENSYMMED IF NOT GIVEN IN CALL. +MCFKWD==40 ;ARG IS A KEYWORD ARG, SELECTED BY = RATHER THAN POSITION. +MCFSYN==7 ;FIELD THAT SPECIFIES THE ARGUMENT'S SYNTAX. + MCFNRM==1 ;MCFSYN CONTAINS MCFNRM => NORMAL-SYNTAX ARG + MCFLIN==2 ;MCFSYN CONTAINS MCFLIN => WHOLE LINE ARG + MCFBAL==3 ;MCFSYN CONTAINS MCFBAL => BALANCED ARG + MCFSTR==4 ;MCFSYN CONTAINS MCFSTR => ARG IS A DELIMITED STRING, AS IN "ASCIZ". + MCFEVL==5 ;MCFSYN CONTAINS MCFEVL => ARG IS BY VALUE (PREEVALUATED). +;IF MCFKWD IS SET, THE DESCRIPTOR IS FOLLOWED BY THE NAME OF THE ARGUMENT, +;TERMINATED BY A 377. +;IF MCFDEF IS SET, THE DESCRIPTOR IS FOLLOWED BY THE DEFAULT VALUE OF THE ARG, +;TERMINATED BY A 377. +;IF MCFKWD AND MCFDEF ARE BOTH SET, THE ARG NAME COMES FIRST. +;A ZERO BYTE ENDS THE DESCRIPTOR LIST. +;THEN COMES THE BODY OF THE MACRO, FOLLOWED BY A 375. + +ADEFINE: NOVAL ;ERROR IF CONTEXT WANTS A VALUE. + SAVE CASSM1 ;RETURN TO ASSEM1 EVENTUALLY + JSP TM,ERMARK ;ERR MSGS SHOULD SAY WE'RE INSIDE A DEFINE. + SAVE SYM ;THESE 2 PUSHES ARE FOR NONAME'S SAKE. + SAVE SYM + CALL GETSLD + CALL NONAME + TLZ FF,FLUNRD + SUB P,[2,,2] + SAVE SYM + SAVE ESBK ;SAVE BLOCK!TO DEFINE IN FOR ES'S SAKE. +IFN CREFSW,XCT CRFMCD + CALL A.TYM1 + POP P,ESBK + REST SYM + PUSHJ P,ESDEF ;FIND SLOT IN SYMBOL TABLE FOR IT + TLO C,3MACOK ;NEVER SEEN, OK TO MAKE MACRO. + TLON C,3MACOK ;ELSE ERROR IF NUMERIC OR ALREADY USED. + ETSM [ASCIZ/Non-macro made macro/] + MOVEI B,MACCL ;RH(VALUE) = MACCL + HRL B,PRDEF ;LH(VALUE) = CHAR ADR OF MACRO + CLEARM PRDEF ;NO LONGER NEED PRDEF + MOVSI T,PSUDO ;SYMBOL TABLE ENTRY LOOKS LIKE PSEUDO + JRST VSM2 + +IFN RCHASW,[ + ;.TTYMAC NAME + ;BODY + ;TERMIN + + ;NAME DUMMY, CAUSES READIN OF CRUD FROM TTY -> CR (NOT INCLUSIVE) + +A.TTYM: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WE'RE INSIDE A .TTYMAC + CALL A.TYM1 ;READ IN A MACRO-DEFINITION. + MOVEI A,40 ;DON'T LET THE CHAR ENDING THE TERMIN + MOVEM A,LIMBO1 ;MAKE MACCL THINK THERE ARE NO ARGS. + CALL GTYIP1 ;PUSH INTO TTY FOR INPUT + HRLZ B,PRDEF ;PHONY UP A MACRO WHOSE DEFN IS WHAT WE READ. + SETZM PRDEF + MOVEI A,A.TYM8 + JRST A.TYM2 ;CALL THE MACRO: + ;READ THE ARGS, POP OUT OF TTY, EXPAND THE MACRO + ;AND THEN EXIT TO A.TYM8 +] + A.TYM1: MOVE A,FREEPT + MOVEM A,PRDEF + MOVEI LINK,MCFNRM ;INITIALLY, DUMMIES ARE NORMAL. + MOVEI A,374 + PUSHJ P,PUTREL ;MARK BEGINNING OF MACRO +DEFNI: MOVE T,LIMBO1 + MOVE A,LINK +DEFNC: CAIE T,12 + CAIN T,15 + JRST DEFNA ;NO MORE ARGS (DONE WITH LINE) + CAIE T,LBRACE + CAIN T,LBRKT + JRST DEFNB1 + CAIE T,RBRACE + CAIN T,RBRKT + JRST DEFNB2 + CAIE T,"< ;OPENS TURN ON BALANCEDNESS. + CAIN T,"( + JRST DEFNB1 + CAIE T,"> ;CLOSES TURN OFF BALANCEDNESS. + CAIN T,") + JRST DEFNB2 + CAIN T,"? ;? TURNS BALANCEDNESS ON OR OFF. + JRST DEFBAL + CAIN T,"+ ;+ COMPLEMENTS KEYWORDNESS + XORI LINK,MCFKWD + CAIN T,"\ ;\ COMPLEMENTS GENSYMMEDNESS + XORI LINK,MCFGEN + CAIN T,"- ;- TURNS WHOLELINENESS ON OR OFF. + JRST DEFWHL + CAIN T,"* ;* TURNS ASCIZ-STYLE-NESS ON OR OFF. + JRST DEFASC + CAIN T,"# ;# TURNS EVALUATEDNESS ON OR OFF. + JRST DEFEVL + CAIN T,": ;: MAKES FOLLOWING ARGS NORMAL + MOVEI LINK,MCFNRM ;IN ALL RESPECTS + CAIN T,"; + JRST DEFNSM ;ALLOW DEFINE LINE TO BE COMMENTED +DEFND: SAVE A + CALL GSYL ;READ IN SYMBOL AS SQUOZE IN SYM. + REST A + CAIN T,"/ ;/ MEANS PREVIOUS ARG IS WHOLE-LINE. + XORI LINK,MCFLIN#MCFNRM + JUMPE SYM,DEFNC ;JUMP IF SYMBOL NAME WAS NULL. + CALL PDEF1 ;ELSE PUSH IT ON LIST OF DUMMIES. + MOVE A,LINK + CAIE T,"= + JRST DEFNL + IORI A,MCFDEF ;ONE ARG, WITH DEFAULT VALUE. + ANDCMI A,MCFGEN ;NOT TO BE GENSYMMED. +DEFNL: CALL PUTREL ;OUTPUT A DESCRIPTOR FOR THIS ARG + TRNE LINK,MCFKWD + CALL DEFNM ;PUT OUT ARG NAME IF KWD ARG + CAIE T,"= ;THEN DEFAULT VALUE IF DEFAULTED. + JRST DEFNI + JSP D,RARG ;INIT. FOR READING THE DEFAULT VALUE. + CAIA + CALL RARGCP ;COPY THE ARG INTO MACRO SPACE, + CALL PUT377 ;TERMINATED BY A 377. + JRST DEFNI ;NOW FOR THE NEXT ARG. + +DEFNM: MOVE D,[440700,,STRSTO] +DEFNM1: ILDB A,D + CAMN D,STRPNT + JRST PUT377 + CALL PUTREL + JRST DEFNM1 + +DEFEVL: SKIPA A,[MCFEVL] ;TURN EVALUATEDNESS ON OR OFF. +DEFASC: MOVEI A,MCFSTR ;TURN ASCIINESS ON OR OFF. + JRST DEFN9 + +DEFBAL: SKIPA A,[MCFBAL] ;TURN ON BALANCEDNESS, BUT IF ALREADY ON TURN OFF. +DEFWHL: MOVEI A,MCFLIN ;SIMILAR FOR WHOLELINENESS. +DEFN9: LDB B,[.BP MCFSYN,LINK] + CAMN A,B ;IF CURRENT STATE IS SAME AS IN A, + MOVEI A,MCFNRM ;SWITCH TO NORMAL MODE INSTEAD. + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNB2: SKIPA A,[MCFNRM] ;TURN OFF BALANCEDNESS +DEFNB1: MOVEI A,MCFBAL ;TURN ON BALANCEDNESS + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNSM: PUSHJ P,RCH ;SEMICOLON IN DEFINE LINE + CAIE A,15 + CAIN A,12 +DEFNA: SKIPA A,LINK ;END OF DEFINE LINE, GET COUNT + JRST DEFNSM + MOVEI A,0 + PUSHJ P,PUTREL ;DEPOSIT END-OF-DESCRIPTORS MARK + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD ;CHAR AFTER CR NOT LF + PUSHJ P,WRQOTE ;READ IN BODY + JRST STPWR + ;COME HERE TO EXPAND MACRO; LH OF B POINTS TO STRING. +;SYM HOLDS NAME OF MACRO (USED BY CALL TO AGETFD IN MACEVL). +MACCL: JSP TM,ERMARK ;ERROR MESSAGE DURING ARG SCAN SHOULD SAY WE'RE IN IT. + MOVEI A,RCHSV1 +A.TYM2: SAVE I + AOS PRCALP + AOS MDEPTH + SAVE RDWRDP + SAVE A ;RCHSV1 FOR MACRO, A.TYM8 FOR .TTYMA + MOVEI LINK,0 + HLRZ A,B + PUSHJ P,REDINC + CAIE B,374 + HALT + MOVEM A,@PRCALP + PUSHJ P,REDINC + TLZ I,ILPRN + JUMPE B,MACCLE ;MACRO TAKES NO ARGS => UN-READ NEXT CHARACTER. + MOVE A,LIMBO1 + CAIE A,") ;MACRO NAME TERMINATED WITH A CLOSE-BRACKET OF SOME SORT + CAIN A,"> ;=> UN-READ THE FOLLOWING CHARACTER. + JRST MACCLE + CAIN A,RBRKT + JRST MACCLE + CAIE A,15 ;MACRO NAME ENDED BY A CR OR LF => + CAIN A,12 + JRST MACCLD ;NO ARGS IN THIS CALL; NULLIFY ALL ARGS. + CAIE A,"< + CAIN A,"( + TLO I,ILPRN ;BUT MAYBE THERE IS A (. IF SO, IT'S A PAREN'D CALL, + CAIN A,LBRKT ;AND WON'T END TILL THE MATCHING CLOSE. + TLO I,ILPRN + CAIE A,40 ;IF THE CHAR ENDING THE MACRO NAME ISN'T AN OPENPAREN, + CAIN A,^I ;EOL, OR SPACE, RE-READ IT AS PART OF 1ST MACRO ARG. + JRST MACNX0 + TLNN I,ILPRN + TLO FF,FLUNRD +MACNX0: TDZ LINK,LINK +MACNXD: CALL MACDES ;FETCH NEXT DESCRIPTOR + JRST MACPUS ;NO MORE => THIS IS END OF THE CALL + TRNE LINK,MCFKWD + JRST MACK ;KEYWORD PARAM => SPECIAL SCANNER +;READ IN THE VALUE OF THE NEXT ARG, WHICH IS NORMAL (NOT KEYWORD) +MACNRM: CALL ADDTRN ;PUSH WORD TO HOLD VALUE OF ARG ONTO DSTG, + ;INITIALIZED -> FREEPT, WHERE WE WILL NOW WRITE THE ARG. + SOS C,A ;TELL MACRED WHERE THAT WORD IS. + CALL MACRED ;READ IN THE ARGUMENT VALUE. + JRST MACNXD ;THEN HANDLE ANOTHER ARG + .VALUE + JRST MACCLD ;END OF ARG LIST => NULLIFY REMAINING ARGS. + +MACCLE: TLO FF,FLUNRD ;SAVE CHR FOLLOWING MACRO W/NO ARGUMENTS + ;AND IF THAT CHAR WAS A CLOSE-BRACKET, + SKIPE B,ASMOUT ;CLEAR OUT THE CHANGE IT MADE TO ASMDSP. + CAIN B,4 + CAIA + JSP LINK,SAVAS2 + SETZ LINK, + JRST MACCLD ;NOW GO NULLIFY ANY ARGS THE MACRO WANTED, AND EXIT. + ;READ IN THE NEXT MACRO ARGUMENT ACC TO SYNTAX FLAGS IN LINK. +;C HAS ADDRESS OF WORD ON THE RDWRDP STACK WHICH HOLDS THE POINTER TO THIS ARG +;IN CASE WE WISH TO SET THE ARG TO THE NULL STRING. B AND LINK NOT CLOBBERED. +;RETURNS SKIPPING TWICE IF NO ARG BECAUSE END OF MACRO CALL SEEN. +MACRED: MOVEI D,MACNXR ;RARL3, RARB, RARGBR RETURN TO MACNXR + CALL RCH + CAIE A,^M + CAIN A,^J + JRST MACEND ;MAYBE WE HAVE REACHED THE END OF THE MACRO CALL. + LDB B,[.BP MCFSYN,LINK] + CAIN B,MCFLIN + JRST RARL3 ;ELSE, IF WHOLELINE ARG, NOTHING ELSE TO CHECK, + ;SO INIT FOR READING IT IN. + CAIN A,", + JRST MACNUL ;NON-WHOLELINE ARG IS NULL IF NEXT CHAR IS COMMA + CAIN A,"; ;SEMICOLON ENDS ARG LIST UNLESS INSIDE WHOLELINE ARG + JRST MACEND + CAIN B,MCFBAL + JRST RARB ;FOR BALANCED ARG, NOTHING ELSE SPECIAL, SO INIT. + CAIN B,MCFSTR + JRST MACSTR + CAIN B,MCFEVL ;FOR EVALUATED ARG, READ FIELD AND EXPRESS AS NUMERAL. + TLOA FF,FLUNRD ;AND THE CHAR WE JUST READ WAS THE 1ST CHAR OF THE FIELD. + CAIN A,"\ ;NORMAL ARG STARTING WITH "\" TREATED THE SAME WAY, BUT FIELD + JRST MACEVL ;STARTS WITH NEXT CHAR. + CAIN A,LBRKT + JRST RARGBR ;FOR ORDINARY ARG, OPEN-BRACKET MAKES IT SPECIAL +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + MOVEI T,RARGN ;OTHERWISE IT'S A NORMAL ARG + TLOA FF,FLUNRD ;AND THE CHAR WE RCH'ED IS THE 1ST CHAR OF IT +MACNXR: JRST MACEN1 ;NON-SKIP RETURN FROM RARB, RARL3 OR RARGBR => ARG NULL + CALL RARGCP ;ARG NON-NULL => COPY IT INTO STRING SPACE + CAIE A,"; +CSTPWR: JRST STPWR ;AND TERMINATE IT +MACSC: MOVE A,(C) ;EXCEPT THAT SEMICOLONS INVALIDATE ALL THE SPACES + CAME A,FREEPT ;AND TABS THAT PRECEDE THEM. + JRST STPWR ;IF, AS A RESULT OF THAT, THE ARG IS NULL, END THE ARGLIST. +;COME HERE WHEN THE END OF THE MACRO'S WHOLE ARGLIST IS SEEN. +MACEND: TLO FF,FLUNRD +MACEN1: AOS (P) ;2-SKIP RETURN FROM MACRED INDICATES END OF ARGLIST + AOS (P) ;END OF ARGLIST => THIS ARG IS NULL. +;COME HERE TO NULLIFY CURRENT ARG (WHERE C POINTS) +MACNUL: TRZE LINK,MCFDEF + JRST MACDEF ;MAYBE DEFAULT IT + TRNE LINK,MCFGEN + JRST MACGEN ;MAYBE GENSYM IT + SETZM (C) ;ELSE SET TO NULL STRING. + RET + +MACST1: CALL RCH + CAIN A,", + JRST MACNUL +MACSTR: CAIE A,40 ;HERE FOR ARG DELIMITED LIKE TEXT STRINGS: /TEXT/. + CAIN A,^I ;SKIP ALL SPACES AND TABS BEFORE THE ARG. + JRST MACST1 + JSP D,RARB ;FIND END OF LINE, COMMENT, OR CLOSEBRACKET => + JRST MACEND ;NULLIFY ARG AND END MACRO CALL. + MOVE T,A ;ELSE SAVE THIS CHAR; IT'S THE DELIMITER. + TLZA FF,FLUNRD +MACST2: CALL PUTREL + CALL RCH ;READ ANOTHER CHARACTER. IF IT ISN'T THE DELIMITER, + CAME A,T + JRST MACST2 ;STORE IT AND READ ANOTHER. + CALL STPWR +MACST3: CALL RCH ;PASS BY SPACES AFTER THE CLOSING DELIMITER + CAIE A,40 + CAIN A,^I + JRST MACST3 + CAIE A,", ;COMMA HERE ENDS THE ARG BUT NOT THE MACRO CALL. + JSP D,RARB ;ELSE CHECK FOR OTHER TERMINATORS. + RET ;WE FOUND AN ACCEPTABLE ARG TERMINATOR. + ETR [ASCIZ /Garbage in ASCIZ-style macro arg/] + JRST RARFLS ;IF THERE'S ANYTHING ELSE, COMPLAIN AND SKIP IT. + ;COME HERE TO GIVE AN ARG ITS DEFAULT VALUE. +;MCFDEF WAS CLEARED SO MACDES WILL KNOW THE DEFAULT VALUE HAS +;ALREADY BEEN PASSED OVER AND WON'T TRY TO SKIP OVER IT. +;IF MCFKWD IS SET, WE MUST SKIP OVER THE KWD ARG'S NAME FIRST. +MACDEF: MOVE A,@PRCALP ;COPY THE DEFAULT VALUE FROM THE MACRO BODY + TRZN LINK,MCFKWD + JRST MACDF1 +MACDF0: CALL REDINC + CAIE B,377 + JRST MACDF0 +MACDF1: CALL REDINC ;AS THE ARGUMENT STRING. + CAIN B,377 + JRST MACDF2 ;END OF THE DEFAULT VALUE. + EXCH A,B + CALL PUTREL + EXCH A,B + JRST MACDF1 + +MACDF2: MOVEM A,@PRCALP + JRST STPWR + +;COME HERE IF GENSYMMABLE ARG IS SPEC'D AS NULL. +MACGEN: MOVEI A,5 + MOVEM A,SCKSUM + MOVEI A,"G + PUSHJ P,PUTREL + SAVE CSTPWR + AOS A,GENSM + IDIVI A,10 + HRLM B,(P) + SOSLE SCKSUM + PUSHJ P,.-3 + JRST MACEV2 + +;PROCESS ARG THAT STARTS WITH \, OR #-TYPE ARG. +MACEVL: CALL RCH ;FIRST, CHECK FOR IMMEDIATE END OF MACRO CALL. + JSP D,RARB + JRST MACEN1 + SAVE C + PUSH P,LINK ;SAVE LINK, NEED FLAGS + PUSHJ P,AGETFD ;GET THE FIELD + SKIPE B + ETR [ASCIZ /Relocatable \'d macro arg/] + POP P,LINK + REST C ;IF AGETFD EXPANDED A MACRO, FREEPT HAS CHANGED, SO + MOVE CH1,FREEPT ;PUT NEW VALUE INTO THE POINTER TO THIS DUMMY. + MOVEM CH1,(C) + MOVE CH1,A ;SAVE VALUE OF FIELD FROM CLOBBERAGE + SAVE CSTPWR +MACEV1: LSHC CH1,-35. ;NOW "TYPE OUT" VALUE OF FIELD IN CURRENT RADIX + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,MACEV1 +MACEV2: HLRZ A,(P) + ADDI A,60 + JRST PUTREL ;OUTPUT TO MACTAB STRING BEING DEFINED + ;HANDLE KEYWORD PARAMETERS. COME HERE WHEN A DESCRIPTOR IS SEEN +;THAT SPECIFIES A KEYWORD PARAMETER. +MACK: SAVE RDWRDP + SAVE @PRCALP + SAVE LINK +;FIRST, PUSH A "NOT SET" MARKER FOR EACH OF THE KEYWORD PARAMS IN THIS RUN OF SUCH. +MACK2: SETO A, + CALL ADDTR2 + CALL MACDES ;NOTE THAT THERE IS ONLY ONE PARAM PER DESCRIPTOR + JRST MACK1 ;FOR KEYWORD PARAMS, SO NO NEED TO COUNT DOWN. + TRNE LINK,MCFKWD + JRST MACK2 +MACK1: REST LINK + REST @PRCALP ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM. +MACKLP: CALL GPASST ;NOW SEE IF THERE'S AN ARGUMENT TO BE FOUND + CAIE A,^M ;IF SO, IT SHOULD START WITH A KEYWORD. + CAIN A,^J + JRST MACKND ;CR OR LF => NO KEYWORD, AND END SCAN. + CAIN A,"; + JRST MACKND + CAIN A,", + JRST MACKN1 ;NULL ARG => NO KEYWORD, BUT DON'T END SCAN. + CAIE A,") + CAIN A,"> + JRST MACKND ;DETECT END OF PARENTHESIZED CALLS, ETC. + CAIE A,RBRKT + CAIN A,RBRACE + JRST MACKND + TLO FF,FLUNRD + CALL GSYL ;THERE SHOULD BE ANOTHER ARG, SO TRY READING KEYWORD NAME + CALL PASSPS + MOVE C,(P) ;NOW SCAN THROUGH THIS RUN OF KEYWORD PARAMS FOR THE + SAVE @PRCALP ;ONE WHOSE NAME MATCHES WHAT GSYL READ. + SAVE LINK + CAIE A,"= + JRST MACKL5 ;NOT FOLLOWED BY "="?? + DPB A,STRPNT +MACKL4: MOVE D,[440700,,STRSTO] + MOVE A,@PRCALP +MACKL1: CALL REDINC + ILDB AA,D + CAIN B,377 ;IF REACHED END OF KEYWORD'S NAME, AND EQUAL SO FAR + JRST MACKL2 ;SEE IF ARG'S NAME ALSO OVER. + CAMN B,AA + JRST MACKL1 ;ELSE KEEP COMPARING IF NAMES STILL SAME SO FAR. +MACKL6: MOVEM A,@PRCALP + CALL MACDES ;THIS KEYWORD DOESN'T MATCH SO FIND THE NEXT + JRST MACKL3 ;THERE ARE NO MORE; LOSE - ARG WITH BAD KEYWORD. + TRNN LINK,MCFKWD + JRST MACKL3 + AOJA C,MACKL4 + +MACKL5: ETR [ASCIZ /Bad format keyword argument/] + TLOA FF,FLUNRD ;INCLUDE THE BAD NON-"=" AS PART OF WHAT WE DISCARD +MACKL3: ETR [ASCIZ /Arg with undefined keyword/] + MOVEI T,RARGN + CALL RARFLS ;SKIP AN ORDINARY-SYNTAX MACRO ARG TO TRY TO RECOVER. + JRST MACK1 + +;COME HERE AFTER FINDING THE PARAM THAT MATCHES THIS ARG. +;C POINTS TO THE WORD IN DSTG FOR THAT ARG (DSTG IS WHAT ADDTRN PUSHES IN) +MACKL2: TRZ LINK,MCFKWD ;(IN CASE WE GO TO MACKL6, SINCE KWD NAME SKIPPED ALREADY) + CAIE AA,"= + JRST MACKL6 ;KWD NAME OVER BUT SPEC'D NAME NOT => MISMATCH + MOVEMM (C),FREEPT + CALL MACRED ;READ IN THE VALUE OF THE ARG, THUS SETTING THIS PARAM. + JRST MACK1 ;THERE ARE MORE ARGS => HANDLE THEM + .VALUE + REST LINK + REST @PRCALP +MACKND: TLO FF,FLUNRD ;MACRO CALL TERMINATOR SEEN. +;NULL ARG SEEN; ENDS THIS RUN OF KEYWORD ARGS BUT NOT THE CALL. +MACKN1: REST C ;GET PTR TO 1ST KWD ARG'S VALUE-WORD +MACKN2: MOVE A,(C) + AOJN A,MACKN4 ;IF THIS ARG WASN'T SPECIFIED, + MOVEMM (C),FREEPT + CALL MACNUL ;NULLIFY IT (MAYBE DEFAULT OR GENSYM) +MACKN4: CALL MACDES ;NOW SKIP OVER THE DESCRIPTORS OF THIS RUN OF KEYWORD PARAMS + JRST MACPUS ;EXHAUSTED ALL THE DESCR'S => END OF MACRO CALL. + TRNE LINK,MCFKWD ;SAME IF REACH A NON-KWD ARG. + AOJA C,MACKN2 + TLNN FF,FLUNRD ;REACHED A NON-KEYWORD PARAM: IF TERMINATOR WAS A NULL ARG, + JRST MACNRM ;GO ON TO READ THE VALUE OF THE NON-KEYWORD PARAM. + JRST MACCLS ;ELSE CALL WAS REALLY ENDED, SO NULLIFY REMAINING ARGS. + ;COME HERE TO FIND THE NEXT DESCRIPTOR. +;SKIPS OVER THE NAME AND DEFAULT VALUE OF THE PREVIOUS DESCRIPTOR, IF ANY. +;THE CONTENTS OF LINKK SAY WHETHER THEY EXIST TO BE SKIPPED OVER. +MACDES: MOVE A,@PRCALP + CALL REDINC ;READ NEXT CHAR OF MACRO + MOVEM A,@PRCALP + TRNE LINK,MCFKWD\MCFDEF + JRST [ CAIE B,377 ;IF THERE'S NAME OR DEFAULT TO SKIP, GO PAST TERMINATOR + JRST MACDES + TRZN LINK,MCFKWD ;AND SAY WE FOUND ONE + TRZ LINK,MCFDEF ;NOTE THERE MAY BE ANOTHER, IN WHICH CASE WE WILL + JRST MACDES] ;SKIP TILL ANOTHER 377 + JUMPE B,CPOPJ ;THIS DESC IS TERMINATOR => RETURN NO SKIP. + MOVEI LINK,(B) ;ELSE PUT FLAGS IN LINK. + JRST POPJ1 + +;COME HERE WHEN A MACRO CALL TERMINATOR IS ENCOUNTERED, TO NULLIFY ALL +;THE REMAINING PARAMS THAT THE MACRO WANTS, THEN ENTER THE MACRO. +;ENTER AT MACCLS IF HAVE JUST READ A DESCRIPTOR AND NOT NULLIFIED THE ARG, +;OR AT MACCLD IF HAVE JUST PROCESSED AN ARG, TO READ THE NEXT DESCRIPTOR. +MACCLS: TRNE LINK,MCFDEF\MCFGEN + JRST MACCL2 + SETZ A, ;NULLIFY NON-GENSYMMED, NON-DEFAULTED ARGS QUICKLY + CALL ADDTR2 +MACCLD: CALL MACDES ;THEN READ THE NEXT DESCRIPTOR. + JRST MACPUS ;IF NO MORE ARGS, ENTER THE MACRO. + JRST MACCLS + +MACCL2: CALL ADDTRN ;FOR GENSYMMED OR DEFAULTED ARG, PUSH PTR TO FREE STG + SOS C,A + CALL MACNUL ;THEN WRITE THE DESIRED VALUE THERE + JRST MACCLD ;THEN HANDLE NEXT DESCRIPTOR. + +;COME TO MACPUS WHEN ALL THE PARAMS HAVE HAD VALUES PUT IN DSTG (USING ADDTRN) +;TO ENTER THE MACRO. +MACPUS: TLZE I,ILPRN ;SPECIAL PARENTHESIZED CALL? + CALL MACPRN ;YES, SKIP PAST THE CLOSING PAREN. + MOVE B,(P) ;IS THIS A .TTYMAC? + CAIN B,A.TYM8 + CALL A.INEO ;YES, POP OUT OF TTY AFTER READING ARGS. + JFCL + REST B ;RCHSV1 OR A.TYM8 + PUSHJ P,PUSHEM + MOVE A,@PRCALP + PUSHJ P,ACPTRS ;SET UP CPTR + POP P,A + PUSHJ P,DMYTRN + SOS PRCALP + REST I +MACCR: AOS (P) ;COMMON RETURN FROM PSEUDOS TO RETURN FROM GETVAL WITHOUT VALUE +CMACCR: POPJ P,MACCR + +MACPRN: MOVEI TT,1 ;START PAREN-DEPTH AT 1 + JSP D,RARBC ;AND READ CHARS, UPDATING THE DEPTH, UNTIL + HALT + JUMPN TT,.-2 ;THE DEPTH GETS TO BE 0. + RET + A.GOMC: ILDB B,A ;.GO ROUTINE TO SKIP PAST DESCRIPTORS + JUMPN B,A.GOMC ;IN HEADER OF MACRO DEFINITION. + JRST A.GORT + +RCHSV1: SOS MDEPTH ;END OF MACRO EXPANSION, DECREMENT DEPTH IN MACRO EXPANSIONS +A.TYM8: PUSH P,A ;ENTRY FROM .TTYMAC END OF EXPANSION + MOVE B,TOPP +RCHSV3: CAMG B,BBASE + JRST RCHSV2 + HLRZ A,-1(B) + ADD A,-1(B) + MOVEI A,1(A) + CAME A,FREEPT + JRST RCHSV2 + HRRZ A,-1(B) ;GET NEW FREEPT + SOJA B,RCHSV3 + +RCHSV2: POP P,A + ;RETURN ROUTINE FOR END OF DUMMY +RCHSAV: MOVE B,BBASE + MOVEM B,TOPP + PUSHJ P,POPEM + HLRM B,BBASE +REPT6: TRZE FF,FRMRGO + POPJ P, ;RETURN TO .GO + JRST RCHTRB + ;IRP, IRPS, IRPC, IRPW, IRPNC ALL CALL HERE. +;ALL USE 2 FRAMES ON THE MACRO PDL: +; ,, +; ,, +; \<# GROUPS>,, +; ,,AIRR +;THE 3RD WORD HAS IN BITS 4.1-4.3 THE IRP TYPE CODE +; (NIRPO, NIRPC, ETC) +;AND IN THE REST OF THE LH, THE NUMBER OF GROUPS +; (TRIPLES OF TWO DUMMIES AND A LIST) + +.SEE NIRPO ;FOR DEFINITIONS OF IRP TYPE CODES. + +AIRP: JSP TM,ERMARK ;ERROR MESSAGES SHOULD SAY WE'RE INSIDE IT. + SAVE I + SAVE RDWRDP + HLRZ LINK,B ;GET IRP TYPE CODE TO INDEX BY. + CAIE LINK,NIRPN + JRST AIRP0 + CALL AGETFD ;IRPNC, READ THE 3 NUMERIC ARGS. + SAVE A + CALL AGETFD + SAVE A + CALL AGETFD + MOVEM A,AIRPN2 ;THE LAST ARG, + REST AIRPN1 ;THE MIDDLE, + REST AIRPN0 ;THE FIRST. + MOVEI LINK,NIRPN +AIRP0: SETZM IRPCR ;NO GROUPS SEEN YET. + +;FALLS THROUGH. + ;FALLS THROUGH. + +;TRY TO READ IN ANOTHER GROUP. +AIRP1: CALL PDEF ;READ IN DUMMY NAME, PUSH ON DMYTOP. + CAIE T,", ;TERMINATOR WASN'T COMMA AND NAME WAS NULL + JUMPE SYM,AIRP2 ;=> NO MORE GROUPS. + CALL PDEF ;NONNULL GROUP, READ & PUSH 2ND NAME. + CAIN T,"[ ;] TRY TO DETECT "IRP X,[", ETC. ] + CALL [ETR [ASCIZ/Comma missing in IRP/] + TLO FF,FLUNRD ;GENERATE A COMMA. + RET] + CALL ADDTRN ;PUSH CHAR ADDR OF 1ST DUMMY, + CAIE LINK,NIRPS + CAIN LINK,NIRPC ;LEAVE SPACE FOR IRPC'S 1ST ARG, IRPS'S 2ND. + CALL PUT377 + MOVE A,RDWRDP + CAIN LINK,NIRPS + AOS -1(A) ;IRPS - 1ST ARG GOES AFTER NEXT 377. + CALL ADDTRN ;PUSH CHAR ADDR OF 2ND DUMMY. + CALL PUT377 + MOVE A,RDWRDP + XCT AIRP1T-1(LINK) ;MAYBE INCREMENT THAT ADDR. + AOS IRPCR ;ONE MORE GROUP SEEN. + JSP D,RARG ;INITIALIZE READING LIST. + JRST AIRP3 ;NO LIST. + JRST @.(LINK) + OFFSET 1-. +NIRPO:: AIRPO ;IRP +NIRPC:: AIRPC ;IRPC +NIRPS:: AIRPS ;IRPS +NIRPW:: AIRPW ;IRPW +NIRPN:: AIRPN ;IRPNC + OFFSET 0 + +AIRP1T: AOS -1(A) + AOS -1(A) ;INCR. THE 2ND DUMMY ADDR FOR IRP, IRPC. + SOS -1(A) + JFCL ;DECR. FOR IRPS, NOTHING FOR IRPW. + AOS -1(A) ;INCR. FOR IRPNC. + ;READ LIST FOR IRPC OR IRP AND STUFF INTO STRING. +AIRPC: +AIRPO: CALL RARGCP ;COPY UP TO END OF ARG INTO MACRO SPACE. + JRST AIRP3 + +AIRPW3: CALL PUT377 ;END A LINE, + CAIGE C, + CALL PUT377 ;IF NO ; YET, MAKE NULL 2ND ARG. +;COME HERE FOR IRPW, LOOP BACK FOR NEXT LINE. +AIRPW: SETO C, ;NO ; SEEN YET IN LINE. +AIRPW1: JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST, GO WRITE 375. + CAIE A,^M + CAIN A,^J + JRST AIRPW1 ;IGNORE NULL LINES. +AIRPW4: CAIN A,"; + AOJE C,AIRPW2 ;ON 1ST SEMI, SWITCH TO 2ND ARG. + CAIE A,^J + CAIN A,^M + JRST AIRPW3 ;END OF LINE => END BOTH ARGS, START OVER. +AIRPW5: CALL PUTREL + JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST. + JRST AIRPW4 + +AIRPW2: MOVEI A,377 + JRST AIRPW5 + +AIRPS: SETO C, ;NO SQUOZE CHAR SEEN YET. +AIRPS2: JSP D,RARGCH(T) + JRST AIRP3 + HLRZ CH1,GDTAB(A) + CAIN CH1,(RET) + CAIN A,"! + AOJA C,AIRPS0 ;A SQUOZE CHAR OR !. + JUMPL C,AIRPS2 ;NON SQUOZE FOLLOWING ANOTHER, FLUSH. + DPB A,AIRPSP ;NONSQUOZE ENDING NONNULL SYL, PUT BEFORE SYL. + SETZM AIRPSP + CALL PUT377 ;FOLLOW SYL WITH 377. + JRST AIRPS + +AIRPS0: JUMPN C,AIRPS3 ;NOT 1ST CHAR IN SYL? + SAVE A + CALL PUT377 ;1ST, LEAVE A SPACE FOR THE SYL'S TERMINATOR. + MOVE A,FREPTB + MOVEM A,AIRPSP ;REMEMBER WHERE THE SPACE IS. + REST A +AIRPS3: CALL PUTREL + JRST AIRPS2 + AIRPN: SKIPG C,AIRPN0 ;ANY CHARS TO IGNORE? + JRST AIRPN4 + JSP D,RARGCH(T) + JRST AIRP3 + SOJG C,.-2 +AIRPN4: SKIPN C,AIRPN2 ;GET MAX # GRPS OF CHARS. + JRST AIRPN7 ;0 => IGNORE THE REST. +AIRPN5: MOVE B,AIRPN1 ;DO NEXT GRP, GET # CHARS/GRP. +AIRPN6: JSP D,RARGCH(T) + JRST AIRP3 + CALL PUTREL ;STORE THE NEXT CHAR. + SOJG B,RARGCH(T) ;COUNT CHARS IN GRP. + MOVEI A,376 + CALL PUTREL ;FOLLOW GRP BY 376. + SOJN C,AIRPN5 ;MAYBE CAN DO MORE GRPS. +AIRPN7: CALL RARFLS ;DID AS MANY GRPS AS CAN DO, + ;IGNORE REMAINDER OF LIST. + +;COME HERE WHEN EXHAUST THE LIST. +AIRP3: CALL STPWR + JRST AIRP1 ;READ ANOTHER GROUP. + +;ALL GROUPS READ IN; NOW READ IN BODY. +AIRP2: CAIE T,"; ;IF A SEMICOLON ENDED THE ARGS, SKIP THE COMMENT. + JRST AIRP4 +AIRP5: CALL RCH + CAIE A,^M + JRST AIRP5 +AIRP4: SAVE LINK + MOVE A,FREEPT ;SAVE CHAR ADDR START OF BODY + MOVEM A,PRIRP ;WHERE GC WILL RELOCATE IT. + PUSHJ P,RCH ;IF NEXT CHAR LF, THEN FLUSH IT + CAIE A,12 + TLO FF,FLUNRD + PUSHJ P,WRQOTE ;READ BODY OF IRP + PUSHJ P,STPWR ;WRITE STOP + PUSHJ P,PUSHEM ;SAVE WORLD + REST LINK + POP P,A ;RESTORE RDWRDP FROM LONG AGO + PUSH P,TOPP ;NOW SAVE TOPP + PUSHJ P,DMYTRN ;ACTIVATE DUMMYS + MOVE B,MACP ;NOW GET MACRO PDL POINTER + MOVE A,CIRPCT ;GET .IRPCNT + HRRM A,(B) ;CLOBBER "RETURN" ON PDL TO OLD IRPCNT + SETOM CIRPCT ;INITIALIZE IRPCNT + MOVS A,IRPCR ;GET # GROUPS + HRR A,PRIRP ;CHAR ADR OF BEGINNING OF BODY + SETZM PRIRP + DPB LINK,[410300,,A] ;PUT IN TYPE OF IRP. + PUSH B,A ;PUSH ,,CHAR ADR BEGINNING + POP P,A ;NOW GET OLD TOPP + HRLS A ;MOVE TO LEFT HALF + HRRI A,AIRR ;RETURN TO AIRR ON END OF BODY + PUSH B,A ;PUSH OLD TOPP,,AIRP4 + MOVEM B,MACP ;STORE BACK UPDATED MACRO PDL POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP RIGHT AWAY TO CAUSE CYCLING + REST I + JRST MACCR + ;RECYCLE THROUGH IRP + + ;AC ALLOCATIONS: +AIRR: PUSH P,A ;A GETS BP ILDBING THRU ARG LIST. + PUSH P,C ;C # GROUPS LEFT + PUSH P,T ;T ADR OF PAIR OF CHAR ADR'S OF DUMMYS + PUSH P,TT ;TT TYPE OF IRP (NIRPO, NIRPC, ETC) + AOS CIRPCT ;INCREMENT .IRPCNT + HRRZ A,(B) ;GET CHARACTER ADR BEG BODY FROM PDL + PUSHJ P,ACPTRS ;SET UP CPTR + SETOM AIRPT + TRNE FF,FRMRGO + JRST AIRR9 ;RETURN TO .GO + HLRZ T,1(B) ;DUMMY TAB ADR + LDB C,[220600,,(B)] ;# GROUPS + JUMPE C,AIRR9 ;JUMP IF NO GROUPS + LDB TT,[410300,,(B)] ;GET TYPE OF IRP (NIRPO, ETC) +AIRR6: JRST @.+1(TT) +AIRRER ? AIRRO ? AIRRC ? AIRRS ? AIRRW ? AIRRN ? AIRRER ? AIRRER +AIRRER: .VALUE + +;MOVE 1 ARG THRU 1 GROUP OF IRP. +AIRRO: HRRZ A,1(T) ;THE 1ST ARG WILL START THIS TIME + HRRZM A,(T) ;WHERE THE "REST OF STRING" STARTED LAST TIME. + BCOMP A,-1 ;GET BP THAT'LL ILDB THAT CHAR. + SETO CH1, ;COUNT [-] DEPTH. +AIRRO1: ILDB B,A + CAIN B,375 + JRST AIRRO4 ;END OF STRING IS END OF ARG. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIN B,"[ + AOJE CH1,AIRRO3 ;FLUSH OUTERMOST [-] PAIRS. + CAIN B,"] + SOJL CH1,AIRRO3 + JUMPGE CH1,AIRRO1 ;DON'T LOOK FOR , WITHIN [-]. + CAIE B,^J + CAIN B,", + JRST AIRRO2 ;END OF ARG. + CAIE B,^M ;^M IS IGNORED (FLUSHED.) + JRST AIRRO1 +AIRRO3: MOVEI B,376 ;FLUSH A CHAR BY REPLACING WITH 376 + DPB B,A + JRST AIRRO1 + +AIRRC4: SUB P,[1,,1] +AIRRC3: SETZM (T) ;NULLIFY BOTH ARGS PERMANENTLY. +AIRRO4: SETZM 1(T) ;NULLIFY 2ND ARG PERMANENTLY + JRST AIRR8 ;DONE WITH THIS GROUP. + +AIRRO2: MOVEI B,377 ;REPLACE CHAR THAT ENDED ARG WITH TERMINATOR. + DPB B,A +AIRRW3: CCOMP1 A,-1 ;GET ADDR OF CHAR AFTER. + HRRZM B,1(T) ;"REST OF STRING" STARTS THERE. + JRST AIRR8 + +AIRRN: MOVE A,1(T) ;NEW 1ST DUMMY STARTS AT OLD "REST OF STRING". + MOVEM A,(T) + BCOMP A,-1 ;NEW "REST OF STRING" STARTS AFTER 376, + JRST AIRRW2 ;WHICH WILL BECOME A 377. + AIRRW: MOVE A,1(T) ;GET CHAR ADDR START OF 2ND HALF OF PREV LINE. + CALL AIRRM ;SET 1ST DUMMY -> AFTER NEXT 376 OR 377 . +AIRRW2: ILDB B,A ;MOVE UP TO NEXT 377 OR END OF STRING. + CAIN B,375 ;END OF STRING ENDS 1ST DUMMY'S ARG => + JRST AIRRO4 ;NULLIFY THE 2ND DUMMY. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIGE B,376 + JRST AIRRW2 + JRST AIRRO2 ;SET UP 2ND DUMMY -> NEXT CHAR. + + +;MOVE UP IN 1 GROUP OF IRPS. +AIRRS: MOVE A,(T) ;MOVE FROM 1ST DUMMY, + CALL AIRRM ;PUT 1ST DUMMY AFTER NEXT 377, + AOS (T) ;MOVE IT PAST THE SYL'S TERMINATING CHAR, + ILDB CH1,A ;GET THAT CHAR, + MOVE A,1(T) + JRST AIRRS2 ;STORE AS 2ND DUMMY. + +AIRRM: BCOMP A,-1 ;A HAS CHAR ADDR; WILL ILDB THAT CHAR. +AIRRM1: ILDB B,A + CAIN B,375 ;END OF STRING => NULLIFY BOTH ARGS + JRST AIRRC4 ;AND FINISHED WITH GROUP. + CAIE B,377 + JRST AIRRM1 + MOVE CH1,A + CCOMP1 CH1,-1 ;GET CHAR ADDR OF CHAR AFTER 377 + MOVEM CH2,(T) ;PUT 1ST DUMMY THERE. + RET ;NOTE A NOT CLOBBERED, CAN GO ON ILDB'ING. + +;MOVE UP IN ONE GROUP OF IRPC. +AIRRC: AOS A,1(T) ;DELETE 1ST CHAR FROM "REST OF STRING". + BCOMP A,-1 ;GET BP -> THAT CHAR. + LDB CH1,A ;GET THE CHAR. + MOVE A,(T) ;GET CHAR ADDR OF PLACE TO PUT IT. +AIRRS2: CAIN CH1,375 ;REACHED END OF STRING => + JRST AIRRC3 ;NULLIFY BOTH ARGS. + BCOMP A,0 + DPB CH1,A ;STORE IT IN THE 1-CHAR ARG. +AIRR7: SETZM AIRPT ;THIS GROUP NOT EXHAUSTED YET. +AIRR8: ADDI T,2 + SOJG C,AIRR6 ;MORE GROUPS => DO THE NEXT. +AIRR9: POP P,TT ;RETURN FROM AAIRPC + POP P,T + SKIPL AIRPT + JRST REPT3 + MOVN A,[2,,2] ;ARGS EXHAUSTED, RETURN + ADDB A,MACP + HRRZ A,(A) + MOVEM A,CIRPCT + POP P,C + POP P,A + JRST RCHSAV + ;IRP ARG-STRING READING COROUTINES: CALL WITH JSP D, +;INITIALIZE FOR READIN OF ARG BUT DON'T GET A CHAR. +;SKIPS IF NONNULL ARG AVAILABLE. +;COROUTINES REMEMBER INFO IN T AND TT BETWEEN CALLS. +;THE CALLER SHOULDN'T CLOBBER THEM. +RARG: CALL RCH ;DECIDE WHAT TYPE OF ARG FOLLOWS, IF ANY. + CAIN A,LBRKT ;RARG ALLOWS [-] AND MAYBE {-~ ARGS AS WELL AS SIMPLE ONES. + JRST RARGBR +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + TLO FF,FLUNRD + JSP T,RARGXT ;CAUSE FAILURE RETURN ON SEMI, CR, LF. +RARGN: CALL RCH ;RARGCH RTN FOR NORMAL ARG. +RARGX1: CAIN A,", + JRST (D) ;COMMA ENDS ARG. +RARGXT: CAIN A,"; + JRST RARGSM ;SEMI ENDS SCAN. +RARGX2: CAIE A,^M + CAIN A,^J ;CR, LF END SCAN. +RARGSM: TLOA FF,FLUNRD + JRST 1(D) + JRST (D) + +RARGBR: SETZ TT, ;TT USED AS BRACKET COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR [-] TYPE ARGS. +RARGBC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRKT + AOJA TT,1(D) + CAIN A,RBRKT + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACKET. + +RARGRR: SETZ TT, ;TT USED AS BRACE COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR {-~ TYPE ARGS. +RARGRC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRACE + AOJA TT,1(D) + CAIN A,RBRACE + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACE. + +;TO GET THE NEXT CHAR OF THE ARG IN A, DO JSP D,RARGCH(T). +;SKIPS UNLESS NO MORE CHARS TO GET. +;NO SKIP AND SET => SCAN SHOULD BE TERMINATED. +;RARG SHOULD NOT BE CALLED AGAIN IN THAT CASE. +RARGCH==0 ;THIS SYMBOL IS FOR CREF'S SAKE. + +;COPY THE ARG BEING READ INTO MACRO SPACE. +;ON RETURN, A WILL HOLD "; IF ARGUMENT WAS ENDED BY ";". +RARGCP: JSP D,RARGCH(T) + JRST RARGC1 + CALL PUTREL + JRST RARGCH(T) + +RARGC1: CAIE A,"; ;IF SEMI ENDED THE ARG, FLUSH THE + RET ;SPACES AND TABS BEFORE IT. +RARGC2: LDB A,FREPTB + CAIN A,^I + JRST RARGC3 + CAIE A,40 + JRST [ MOVEI A,"; ;LAST CHAR OF ARG ISN'T SP OR TAB. + RET] ;MAKE SURE A HAS ";" IF ARG WAS ENDED BY ";". +RARGC3: SOS FREEPT ;IT IS ONE; BACK OVER IT. + MOVE A,FREPTB + DBPM A + MOVEM A,FREPTB + JRST RARGC2 + +;IGNORE THE REST OF THE ARG NOW BEING READ. +RARFLS: JSP D,RARGCH(T) + RET + JRST RARGCH(T) + ;COME HERE TO SET UP TO READ A BALANCED ARG. +;IF THERE'S NO ARG, RETURNS WOTH JRST (D). +;ELSE RETURNS WITH JRST 1(D) SETTING UNRCHF. +RARB: TLO FF,FLUNRD + SETZ TT, ;TT USED AS BRACKET COUNTER. + CAIE A,RBRACE + CAIN A,") ;IF 1ST CHAR IS A CLOSE, + JRST RARB4 ;THERE'S NO ARG. + CAIE A,"> + CAIN A,RBRKT + JRST RARB4 + JSP T,RARGXT ;CHECK FOR CR, LF, SEMI, AND RETURN. +;1-CHAR RTN FOR READING BALANCED ARG. +RARBC: CALL RCH + CAIE A,RBRACE + CAIN A,"> ;FOR CLOSES, MAYBE END ARG. + JRST RARB2 + CAIE A,") + CAIN A,RBRKT + JRST RARB2 + CAIE A,LBRACE + CAIN A,"< ;FOR OPEN BRACKETS, INCR. THE COUNT. + AOJA TT,1(D) ;OPENS CAN'T END THE ARG. + CAIE A,"( + CAIN A,LBRKT + AOJA TT,1(D) + JUMPN TT,1(D) + JRST RARGX1 ;NOT WITHIN BRACKETS, TEST FOR COMMA, ETC. + +RARB2: SOJGE TT,1(D) ;COME HERE FOR CLOSEBRKTS. +RARB4: TLO FF,FLUNRD + JRST (D) + +;COME HERE TO INIT FOR AN ARG FOR REPEAT, ETC. +;THAT IS, EITHER A BRACKETED ARG OR A 1-LINE ARG. +RARL1: CALL RCH +RARL2: +IFN BRCFLG,[ +RARL4: CAIN A,LBRACE + JRST RARGRR ;1ST CHAR A BRACE => BRACED ARG. +] + CAIN A,LBRKT ;1ST CHAR A BRKT => BRKT ARG. + JRST RARGBR + TLO FF,FLUNRD + +;INIT FOR A 1-LINE ARG. +RARL: JSP T,1(D) +;1-CHAR RTN FOR 1-LINE ARGS. +RARLC: CALL RCH + JRST RARGX2 + +IFE BRCFLG,[ +;IF BRACES AREN'T USED BY MOST THINGS, THE NORMAL ROUTINE RARL1 DOESN'T +;CHECK FOR THEM, BUT RALR4 (CALLED BY CONDITIONALS) STILL MUST. +RARL4: CAIN A,LBRACE + JRST RARGRR + JRST RARL2 +] + +;1-LINE ARGS TO MACROS: DON'T TERMINATE THE SPEC, +;AND SKIP OVER THE CR AND LF. +RARL3: TLO FF,FLUNRD + JSP T,1(D) + CALL RCH + CAIN A,^J + JRST (D) ;LF IS THE END - SKIP IT. + CAIE A,^M + JRST 1(D) + CALL RCH ;CR => SKIP FOLLOWING LF, END ARG. + CAIE A,^J + TLO FF,FLUNRD + JRST (D) + ;PUSHJ P,A.GST SEARCH CURRENT MACRO STRING FOR TAG (IN A.GST4) +;SKIP IF FOUND, RETURN ON END OF STRING ANYWAY +;BYTE POINTER (ILDB TO GET FIRST CHARACTER) IN A + +A.GST: MOVEM A,A.GST3 ;SAVE BYTE POINTER +A.GST1: ILDB B,A.GST3 ;GET CHAR + CAIL B,300 + POPJ P, ;END OF STRING => STOP + CAIE B,". + JRST A.GST1 ;WAIT FOR POINT + PUSHJ P,A.GSYL ;FOUND POINT, GET REST OF NAME + JUMPL T,CPOPJ ;RETURN ON END OF STRING + CAME SYM,[SQUOZE 0,TAG] ;TAG? + JRST A.GST1 ;NO, KEEP GOING + PUSHJ P,A.GSYL ;GET THE TAG + JUMPL T,CPOPJ ;RETURN ON END OF STRING (THERE MUST BE BREAK CHAR AFTER TAG BEFORE STOP) + CAME SYM,A.GST4 + JRST A.GST1 ;NOT THE ONE BEING LOOKED FOR + MOVE A,A.GST3 + LDB B,A ;GET DELIMITER + CAIE B,15 ;CR? + JRST POPJ1 + ILDB B,A ;CR, GET NEXT CHAR + CAIE B,12 ;LINE FEED? + MOVE A,A.GST3 ;NO, DON'T FLUSH + JRST POPJ1 + + ;LOOK BACKWARD FOR BEGINNING OF STRING, BYTE POINTER AN A + ;LEAVES POINTER POINTING AT STOP CHAR (NOT BEFORE); ALSO LEAVES STOP CHAR IN B + +AG.SP: MOVE B,(A) ;GET WORD FROM MACTAB + XOR B,[300_28.+300_20.+300_12.+300_4] ;DO XOR TO ANITIALLY SET UP + LDB CH1,[400400,,A] ;PICK UP 4 HIGH ORDER BITS OF POSITION FIELD + JRST A.GSP2-1(CH1) ;DISPATCH ON POSITION FIELD (-1 SINCE BIT SET IN POSITION FIELD) + +AG.SP3: MOVE B,(A) + XOR B,[300_28.+300_20.+300_12.+300_4] + +A.GSP2: TRNN B,300_4 + JSP CH1,AG.SF + TLNN B,3 + JSP CH1,AG.SF + TLNN B,300_2 + JSP CH1,AG.SF + TLNN B,300_10. + JSP CH1,AG.SF + SOJA A,AG.SP3 + +AG.SF: SUBI CH1,A.GSP2-1 ;GET HERE WHEN STOP CHAR FOUND + DPB CH1,[400400,,A] ;CLOBBER POSITION FIELD OF BYTE POINTER AGAIN + ILDB B,A ;INCREMENT TO UNIVERSALLY ACCEPTABLE POINTER, GETTING STOP CHAR IN B AT SAME TIME + POPJ P, ;THAT'S ALL + A.TAG: PUSHJ P,GSYL + CAIE T,15 + JRST MACCR + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD + JRST MACCR + +A.GO: PUSHJ P,GSYL ;DOESN'T WORK RELIABLY FROM DUMMY + MOVEM SYM,A.GST4 + +A.GO1: TLNN FF,FLMAC + JRST MACCR ;NOT GETTING CHARS FROM MACRO => STOP + MOVE A,CPTR + PUSHJ P,AG.SP ;BACK TO BEGINNING + CAIN B,374 + JRST A.GOMC ;MACRO, SKIP PAST HEADER +A.GORT: PUSHJ P,A.GST + JRST A.GO2 ;END OF STRING, TRY POPPING UP ONE + MOVEM A,CPTR + JRST MACCR + +A.GO2: PUSHJ P,PMACP + JRST A.GO1 + +A.GSYL: MOVNI D,100000 ;GET SYL FOR .GO WHILE LOOKING FOR TAG + MOVEM D,STRCNT ;STRCNT .LT. 0 SIGNAL FOR GSYL TO JRST (F) + MOVEI SYM,0 + JSP F,GSYL1 +A.GSY3: ILDB A,A.GST3 ;GET CHAR + TRZN A,200 ;CHECK FOR SPECIAL + JRST A.GSY2 ;NO, FALL BACK IN + CAIG A,100 ;BIG ENOUGH TO BE SPECIAL? + JRST A.GSY3 ;NO, MUST BE DUMMY, IGNORE + HRROI T,(A) ;SPECIAL => ASSUME STOP: T .LT. 0 SIGNAL TO CALLING ROUTINE + POPJ P, ;RETURN TO CALLING ROUTINE + ;INITIALIZE MACRO STATUS + +MACINI: MOVEI A,3 + MOVEM A,FREEPT ;FORGET ALL STRINGS IN MACTAB + PUSHJ P,FCOMP + MOVE A,MACTAD + HRLI A,41000 ;SET UP CCOMPB THRU CCOMPE + LSH A,2 ;(THEIR VALUES CAN'T BE ASSEMBLED IN BECAUSE + SUBI A,4 ;THEY ARE MUTLTIPLY RELOCATABLE, AND IN DEC + MOVSI AA,CCOMPB-CCOMPE ;VERSION THAT CAN'T BE DONE) +MACIN0: MOVEM A,CCOMPB(AA) + AOJ A, + AOBJN AA,MACIN0 + MOVE A,MACTAD + ADDI A,MACL+1777 + ANDI A,-2000 ;ADDR OF 1ST WD AFTER MACTAB. + CALL MACIN2 ;SET UP PTRS TO END OF MACTAB. + SETZM GCCNT ;CLEAR OUT GC COUNT SO WILL GET MORE CORE FIRST THREE +MACIN1: SETZM MDEPTH ;NOW INITIALIZE MACRO EXPANSION STATUS + SETZM PRSTG ;NOW TO CLEAR OUT BYTE POINTERS + MOVE A,[PRSTG,,PRSTG+1] + BLT A,EPRSTT-1 + MOVEI A,DSTG + MOVEM A,RDWRDP + MOVEI A,DMYAGT + MOVEM A,TOPP + MOVEM A,BBASE + MOVE A,[-MPDLL,,MACPDL] + MOVEM A,MACP + POPJ P, + +;A -> 1ST WD AFTER MACTAB, SET UP ALL POINTERS TO END OF MACTAB. +MACIN2: MOVEM A,MACTND + SUB A,MACTAD + LSH A,2 ;1ST BYTE MACTAB DOESN'T HAVE. + MOVEM A,MACHI + SUBI A,MACRUM*4 + MOVEM A,GCRDHI + MOVE A,STOPPT + HRR A,MACTND + SOS A ;LAST WD IN MACTAB. + MOVEM A,MACHIB ;INITIALIZE BYTE POINTER TO HIGHEST BYTE OK TO FILL + RET + + ;MACRO VARIABLE AREA (MOST THEREOF) + +VBLK +MACP: 0 ;MAC PDL POINTER +BLCODE [MACPDL: BLOCK MPDLL+1] ;MACRO PDL +FREEPT: 0 ;MACRO STG PNTR POINTS TO FREE CHAR +FREPTB: 0 ;FREEPT IN BYTE POINTER FORM +MACTAD: MACTBA ;ADDR OF START OF MACRO TABLE. +MACTND: 0 ;ADDR OF 1ST WD AFTER MACTAB. +MACHI: 0 ;CHAR ADR ONE ABOVE ACTIVE MACTAB +MACHIB: 0 ;POINTS TO LAST BYTE IN MACTAB + SCONDF: 0 ;STRING CONDITIONAL FLAG, -1 => IDENTICAL, 0 DIFFERENT +GENSM: 0 ;GENERATED SYM COUNT +DEFNPS: 0 ;NONZERO => NAME OF PSEUDO NOW READING ITS ARG. + ;A FATAL ERROR WILL TYPE THE PSEUDO'S NAME. +DEFNPN: 0 ;PAGE # -1 OF THAT PSEUDO. ALSO TYPED BY FATAL ERRORS. +DEFNLN: 0 ;LINE # -1. +DEFNFI: 0 ;SIXBIT FN1 OF FILE CONTAINING PSEUDO THAT DEFNPS REFERS TO. +MDEPTH: 0 ;DEPTH IN MACRO (NOT IRP OR REPEAT) EXPANSIONS +PUTCNT: 0 ;AOS'D BY PUTREL, USED BY CALLING ROUTINE, USUALLY TO COUNT ACTIVE CHARS (DURING DEFINITION) +IRPCR: 0 ;COUNT OF A,B,[LIST] GROUPS IN IRP IRPC IRPS, " " " +AIRPT: 0 ;IRP EXPANSION TEMP, -1 => NO NON-NULL DUMMYS YET, ELSE 0 +AIRPN0: 0 ;1ST NUMERIC ARG TO IRPNC +AIRPN1: 0 ;2ND, +AIRPN2: 0 ;3RD. +A.QOT2: 0 ;DELIMITER FOR .QUOTE +CRPTCT: -1 ;COUNT THROUGH CURRENT REPEAT (FOR .RPCNT) +CIRPCT: -1 ;COUNT THOUGH CURRENT IRP (FOR .IRPCNT) +A.GST3: 0 ;ON .GO, NAME (IN SQUOZE) OF TAG BEING SEARCHED FOR +A.GST4: 0 ;BYTE POINTER FOR ILDB WHILE SEARCHING FOR TAG +PRCALP: PRCAL-1 ;POINTER INTO PRCALP, POINTS TO LAST ACTIVE ENTRY + +PRSTG: ;BEGIN WORDS GARBAGE COLLECTED: FIRST BYTE POINTERS ILDB'D + +CPTR: 0 ;ILDB TO GET NEXT CHAR FROM MACRO OR WHATEVER +IFE WRQTSW-1,WRQTBP: 0 ;POINTS TO LAST CHAR BEFORE CURRENT SYL AT WRQOTE +AIRPSP: 0 ;-> PLACE TO STORE SYL-TERMINATOR, IN IRPS READIN. +GCBPL==.-PRSTG ;END BYTE POINTERS, BEGIN CHARACTER ADDRESSES +PRSCND: 0 ;CHARACTER ADDRESS OF CURRENT LOCATION IN FIRST STRING OF IFSE,IFSN WHILE COMPARING WITH SECOND +PRSCN1: 0 ;CHAR ADR BEG OF FIRST STRING IFSE, IFSN +PRREPT: 0 ;CHAR ADR BEG OF BODY OF REPT +PRIRP: 0 ;CHAR ADR BEG OF IRP BODY +PRDEF: 0 ;CHAR ADR BEG OF MACRO BEING DEFINED +PRCAL: REPEAT 10,0 ;TEMP STORAGE FOR CHAR ADR BEG MACRO BODY, USED TO READ DUMMY SPECS +EPRSTT: ;END CHAR ADR WORDS GARBAGE COLLECTED + + ;BEGIN GARBAGE COLLECTOR VARIABLES + +GCCNT: 0 ;CNT OF GC'S +SYMSTR: 0 ;PNTR TO CHAIN OF MACRO PNTRS IN SYM TABLE (DURING GC), LINKED THROUGH RH'S OF "VALUE" +REDPT: 0 ;CHAR ADR READING FROM WHEN MOVING STRING DOWN +REDPTB: 0 ;REDPT IN BYTE POINTER FORM + ;GC WRITES WITH FREEPT/FREPTB +COFST: 0 ;AMOUNT CHARS MOVED DOWN BY, SUBTRACTED FROM CHAR ADR TO RELOCATE +SVF: 0 ;FLAG, .GE. 0 => NO POINTERS FOUND POINTING TO CURRENT STRING +FREPTS: 0 ;-> BEGINNING OF CURRENT STRING BEING COPIED DOWN +FRPTBS: 0 ;FREPTS IN BYTE POINTER FORM +GCENDF: 0 ;-1 => END OF LAST STRING FOUND, AFTER RELOCATING POINTERS, MSTG2 SHOULD EXIT +GCHI: 0 ;GC HIGH POINTER, CHAR ADR FIRST NOT TO GARBAGE COLLECT +GCRDHI: *4 ;GC DROPS DEAD (MACTAB FULL) IFWRITING INTO THIS CHAR ADR +BLCODE [GCSV: BLOCK 16] ;AC SAVE AREA FOR GC +PBLK + ;GARBAGE COLLECT THE MACRO TABLE + +GCA1: MOVE A,FREEPT ;GC ALL IN MACTAB. +GCA: MOVEM A,GCHI ;ENTRY TO STORE A IN GCHI -> FIRST CHAR NOT TO GARBAGE COLLECT +GC: MOVEM 17,GCSV+15 + MOVE 17,[2,,GCSV] + BLT 17,GCSV+14 +IFN TS,[AOS A,GCCNT + CAIGE A,4 + PUSHJ P,GCCORQ ;EXPAND CORE ON FIRST THREE GC'S +] CLEARB T,GCENDF + MOVEI A,3 + MOVEM A,REDPT ;SET UP FOR READING + MOVEM A,FREEPT ;ALSO FOR WRITING + MOVE A,BCOMPU ;ALSO SET UP CORRESPINDING BYTE POINTERS + MOVEM A,FREPTB + MOVEM A,REDPTB + MOVE C,[-GCBPL,,PRSTG] +GCLP1: SKIPN B,(C) ;NOW CONVERT BYTE POINTERS... + JRST GCLP1B ;(INACTIVE) + CCOMP B,-1 ;TO CHARACTER ADDRESSES + MOVEM B,(C) ;STORE BACK CHARACTER ADDRESS +GCLP1B: AOBJN C,GCLP1 ;LOOP FOR ALL SUCH BYTE POINTERS + MOVE A,SYMAOB ;NOW SET UP MACRO LIST; T INITIALLY HAS 0 => END OF LIST DURING COMPUTATION +SYMMG: ;POINTS TO FIRST MACRO SYMTAB ENTRY ON LIST + LDB B,[400400,,ST(A)] ;GET SQUOZE FLAGS THIS SYM + CAIN B,PSUDO_-14. ;PSEUDO? (=> MAYBE MACRO) + JRST SYMMG1 ;YES, MAYBE PUT ON LIST (RETURNS TO SYMMG2) +SYMMG2: ADD A,WPSTE1 + AOBJN A,SYMMG ;LOOP FOR ENTIRE SYMTAB + MOVEM T,SYMSTR ;STORE INITIAL LIST ENTRY FOR MACROS + ;DROPS THROUGH + ;GC DEALS WITH "UNIT STRINGS", EACH STRING ENDS WITH 375 + ;GENERAL PROCEDURE IS TO COPY A STRING DOWN THEN SEARCH FOR POINTERS TO WHERE STRING USED TO BE + ;IF POINTERS FOUND THEY ARE RELOCATED TO POINT TO COPIED DOWN STRING + ;IF POINTERS ARE NOT FOUND THE STRING IS WIPED OUT + ;DROPS THROUGH + +MSTG: MOVE C,REDPT ;SET UP C TO POINT TO BEG OF STRING BEING READ + ;(FOR EVENTUALLY SEARCHING FOR POINTERS TO STRING, NOTE C STAYS AROUND FOR AWHILE) + MOVE TT,FREEPT + MOVEM TT,FREPTS ;-> BEGINNING OF WRITTEN STRING + MOVE TT,FREPTB + MOVEM TT,FRPTBS ;BYTE POINTER -> BEGINNING OF WRITTEN STRING + PUSHJ P,RDTRNS ;COPY CHARACTER + CAIN B,370 + JRST MSTGB ;THAT WAS NO STRING, THAT WAS MY IO-BUFFER! + MOVE TT,B ;SAVE CHARACTER JUST COPIED +MSTG1: CAML LINK,GCHI + JRST GCEND ;JUST READ LAST CHAR IN PART OF MACTAB TO GARBAGE COLLECT => DONE + CAIN B,375 + JRST MSTG2 ;END THIS STRING, NOW SEARCH FOR POINTERS, RETURNS TO MSTG + PUSHJ P,RDTRNS ;STRING NOT EXHAUSTED, COPY NEXT CHAR + JRST MSTG1 + SYMMG1: HRRZ B,ST+1(A) ;PSEUDO FOUND IN SYMTAB, GET "VALUE" + CAIE B,MACCL ;MACCL? (=> MACRO, CHAR ADR OF BODY IN LH) + JRST SYMMG2 ;NO, JUST FALL BACK INTO LOOP + HRRM T,ST+1(A) ;MACRO, REPLACE MACCL PART OF VALUE WITH POINTER TO NEXT + MOVEI T,ST+1(A) ;UPDATE T (INITIAL LIST ENTRY) TO POINT TO WORD JUST CLOBBERED + PUSH P,A + HLRZ A,ST+1(A) + PUSHJ P,REDINC + CAIE B,374 + HALT + POP P,A + JRST SYMMG2 + + ;COPY CHARACTER DOWN (REDPTB -> FREPTB) + ;LEAVE INCREMENTED REDPT IN LINK, FREEPT IN A, CHAR IN B + +RDTRNS: ILDB B,REDPTB + IDPB B,FREPTB + AOS LINK,REDPT + AOS A,FREEPT + POPJ P, + +MSTGB: ADDI A,3 ;COPY AN IO-BUFFER: + TRZ A,3 + MOVEM A,FREEPT ;WRITE INTO WORD BOUNDARY. + ADDI LINK,3 + TRZ LINK,3 + MOVEM LINK,REDPT ;READ FROM WORD BOUNDARY. + MOVEI B,041000 + HRLM B,REDPTB + HRLM B,FREPTB + MOVE B,FREPTB + MOVE A,REDPTB + ADDI B,1 ;NEW ADDR OF 1ST WD. + HRRZ LINK,1(A) ;GET ADDR OF POINTER TO STRING. + MOVEM LINK,SVF ;REMEMBER WHETHER TO FLUSH STRING. + SKIPE LINK + HRRM B,(LINK) ;RELOCATE THAT POINTER (IF ANY) + HRLI B,1(A) ;SET UP AC FOR BLT. + HLRZ LINK,1(A) ;GET LENGTH OF STRING. + ADDM LINK,REDPTB + LSH LINK,2 + ADDM LINK,FREEPT + ADDM LINK,REDPT + LSH LINK,-2 + ADDB LINK,FREPTB + BLT B,(LINK) + MOVE LINK,REDPT + CAML LINK,GCHI ;IF THIS IO-BUFFER IS LAST THING IN MACRO SPACE, + SETOM GCENDF ;DON'T LOOK FOR ANYTHING FOLLOWING IT. + JRST MSTGB1 ;NOW MAYBE FLUSH THIS STRING, COPY NEXT. + ;GET HERE WHEN MSTG2 FINISHES WITH FLAG SET TO EXIT: UNDO INITIALIZATION AND RETURN + +GCEND1: IFN TS,[ + MOVE A,FREEPT + ADDI A,2000*4 + CAML A,MACHI + PUSHJ P,GCCORQ +] MOVE A,FREEPT + CAML A,GCRDHI + ETF [ASCIZ /Macro space full/] + SKIPN T,SYMSTR + JRST USYMG1 ;EMPTY LIST + MOVEI C,MACCL ;SET UP C FOR HRRM'ING +USYMG: HRRZ TT,(T) ;GET ADR ON LIST + HRRM C,(T) ;CLOBBER RH JUST GOT NEXT POINTER FROM TO MACCL + HLRZ A,(T) + PUSHJ P,REDINC + CAIE B,374 + HALT + SKIPE T,TT ;MAKE NEXT POINTER CURRENT, SKIP IF END OF LIST + JRST USYMG + +USYMG1: MOVE C,[-GCBPL,,PRSTG] +GCLP2: MOVE A,(C) ;NOW CONVERT CHARACTER ADDRESSES... + BCOMP A,-1 ;BACK TO BYTE POINTERS + MOVEM A,(C) + AOBJN C,GCLP2 + MOVS 17,[2,,GCSV] + BLT 17,17 + POPJ P, ;EXIT FROM GARBAGE COLLECTOR + + ;GC ROUTINE TO SCAN TABLE AREA FOR POINTERS TO CURRENT STRING + ;CH1 -> BEGINNING OF TABLE, 4.9 => LOOK AT PAIRS SKIPPING SECOND OF EACH PAIR + ;T POINTS TO LAST WORD IN TABLE + 1 + ;RELOCATE POINTERS IN TABLE POINTED TO + ;C POINTS TO BEGINNING OF STRING, B -> END + 1 + +MSCN: CAIG T,(CH1) + POPJ P, ;TABLE EXHAUSTED + HRRZ TT,-1(T) ;GET LAST ENTRY IN TABLE (UPPER POINTER UPDATED TO COUNT DOWN) + CAML TT,C + CAML TT,B + JRST MSCN1 ;DOESN'T POINT TO CURRENT STRING + SUB TT,COFST ;POINTS TO STRING, RELOCATE + HRRM TT,-1(T) ;STORE BACK RELOCATED POINTER + SETOM SVF ;SET FLAG TO SAVE STRING +MSCN1: SKIPGE CH1 + SOS T ;CH1 NEGATIVE => SKIP A WORD + SOJA T,MSCN + GCEND: SETOM GCENDF ;DONE READING FROM MACTAB, BUT FIRST HAVE TO RELOCATE POINTERS TO LAST STRING +MSTG2: CLEARM SVF ;NO POINTERS FOUND TO STRING YET + MOVE D,REDPT + SUB D,FREEPT + MOVEM D,COFST ;STORE AMOUNT CHARS COPIED DOWN BY FOR CHAR ADR RELOCATION + MOVE B,REDPT + CAIE TT,374 + JRST MSTG3 ;NOT A MACRO + MOVE T,SYMSTR + JUMPE T,MSTG3 ;JUMP IF NO MACROS ON LIST +MSTG5: HLRZ TT,(T) ;GET CHAR ADR THIS MACRO + CAML TT,C ;SKIP IF POINTS BELOW BEGINNING THIS STRING + CAML TT,B ;SKIP UNLESS POINTS TO OR ABOVE FIRST CHAR NOT YET READ + JRST MSTG4 ;DOESN'T POINT TO THIS STRING + SETOM SVF ;POINTS TO THIS STRING, SET FLAG TO SAVE STRING + SUB TT,COFST ;RELOCATE + HRLM TT,(T) ;STORE BACK UPDATED CHAR ADR THIS MACRO +MSTG4: HRRZ T,(T) ;NOW GET POINTER TO NEXT MACRO + JUMPN T,MSTG5 ;LOOP FOR ALL MACROS ON LIST + +MSTG3: MOVE T,TOPP + MOVEI CH1,DMYAGT + PUSHJ P,MSCN ;RELOCATE POINTERS IN DUMMY ARG TABLE + HRRZ T,MACP + HRROI CH1,MACPDL + PUSHJ P,MSCN ;RELOCATE POINTERS IN MACRO PDL + HRRZ T,PRCALP + AOS T + MOVEI CH1,PRSTG + PUSHJ P,MSCN ;RELOCATE POINTERS IN PRSTG + HRRZ T,RDWRDP + MOVEI CH1,DSTG + PUSHJ P,MSCN ;RELOCATE DUMMY ARGS READ (OR BEING READ) IN BUT NOT YET ACTIVATED + SKIPGE GCENDF + JRST GCEND1 ;EXIT +MSTGB1: SKIPE SVF + JRST MSTGB2 ;FOUND POINTERS TO THIS STRING, DON'T FLUSH + MOVE TT,FREPTS ;NO POINTERS FOUND, FLUSH STRING + MOVEM TT,FREEPT + MOVE TT,FRPTBS + MOVEM TT,FREPTB +MSTGB2: SKIPGE GCENDF ;IF WE JUST HACKED AN I-O BUFFER, MAYBE IT'S THE LAST + JRST GCEND1 ;THING IN MACRO SPACE. + JRST MSTG + +] ;END MACSW CONDITIONAL (AND MACRO PROCESSOR ROUTINES) + IFN .I.FSW,[ ;;.I.F ;ALGEBRAIC COMPILER ROUTINE +; 'ALGEBRAIC' CRUFT MARO DEFINITIONS + +DEFINE MOAN ARG/ + MOVEI D,[SIXBIT /ARG!!/] + JRST ERRCON +TERMIN + +DEFINE RETLIN + MOVEI A,15 ;CARRIAGE RETURN + PUSHJ P,PUTREL + MOVEI A,12 ;LINE FEED + PUSHJ P,PUTREL +TERMIN + +DEFINE NUMBER + MOVE A,BTPNT + ILDB I,A + CAIE I,"# + CAIGE I,"@ +TERMIN + +DEFINE RESTOR + MOVE D,BTPNT + SETZM STRING + SETZM STRING+1 + SETZM STRING+2 +TERMIN + + +DEFINE SPECN + POP P,RANDM + MOVE A,ENN + SUB A,RANDM + MOVEM A,ENN +TERMIN + +DEFINE GET + EXCH I,ACSAV+1 + PUSHJ P,RCH + EXCH I,ACSAV+1 +TERMIN + +DEFINE GETT + EXCH I,ACSAV+1 + PUSHJ P,RCH + EXCH I,ACSAV+1 + IDPB A,TPN +TERMIN + ; START OF COMPILER PROPER + +OPDL: CH?CH?CH?CH?CH?CH?CH?CH ;COMMUTATOR + CH?SP?CH?CH?CH?CR?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + SP?CH?CH?CH?DL?CH?CH?CH + LP?RP?TX?PL?CM?MN?CH?DV + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?KL?LB?EQ?RB?CH + +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?UP?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH + +VBLK + +ENN: 60 ;ACCUMULATOR NUMBER - TROUBLE IF GOES PAST 9 + +BTPNT: 440700,,STRING ;D +STRING: BLOCK 10 ;CHARACTER ASSEMBLY (D) - TROUBLE IF OVERFLOWS + +TPN: 0 +DIRPNT: 440700,,DIROUT ;TPN +DIROUT: BLOCK 40 ;COPY OF LINE IN PROGRESS (TPN) - TROUBLE IF OVERFLOWS + +OPSTKL==40 + 0 +OPSTK: BLOCK OPSTKL ;OPERATOR STACK (R) - TROUBLE IF OVERFLOWS + 0 + + + +ENDSTT: 0 ;ON IF END OF STATEMENT ENCOUNTERED +CHARF: 0 ;LAST WAS NOT OPERATOR +NUMFL: 0 ;STRING IS NUMERIC CONSTANT (NEEDS [ AND ]) +R1SV: 0 ;SAVED A +R2SV: 0 ;SAVED I, CALLED V EARLIER ON + +INTEGR: 0 ;INTEGER ARITHMETIC +WARN: 0 ;ON AFTER ) TO STOP NON-OPERATOR +RANDM: 0 ;DUMP COMMA COUNT HERE +ACSAV: BLOCK 7 +TEMP: 440600,,(D) ;INDIRECT VIA D +BYTPNT: 0 +PBLK + ; ENTRANCE TO 'ALGEBRAIC' TRANSLATOR + +A.I: SETOM INTEGR + SKIPA +A.F: SETZM INTEGR + PUSHJ P,SWINI ;INITIALISE PASSAGE TO MIDAS ASSEMBLER + MOVE TM,[P,,ACSAV] + BLT TM,ACSAV+6 + SETZM ENDSTT ;RESET END OF STMNT FLAG + SETZM EQHIT' ;RESET LAST CHAR WAS= FLAG + SETZM WARN ;SET OFF ERROR DETECTOR + MOVEI A,"0 ;INITIALISE POINTERS + MOVEM A,ENN + MOVE A,DIRPNT + MOVEM A,TPN ;POINTER TO SAVED INPUT + MOVE SYM,[-OPSTKL,,OPSTK] + PUSH SYM,[0,,ENDSAT] + PUSH P,[0] ;INITIALISE COMMA-COUNTER + SETZM CHARF +CLSTR: RESTOR +RDITTS: SKIPE ENDSTT + JRST BDEND +RDITA: GETT + CAIGE A,100 ;FOR ABBREVIATED DISPATCH TABLE + JRST @OPDL(A) + CAIN A,"\ + JRST AB + CAIN A,"^ + JRST UP + +CH: SETZM EQHIT + SKIPE WARN + JRST CHBRT +CHEY: IDPB A,D + SETOM CHARF ;NON UNARY FLAG + JRST RDITA + +GAMB: RESTOR +COMMT: MOVE I,R2SV + JRST GOPURT + +SHORT: ;DECIDES IF STRING CAN BE USED IN IMMEDIATE TYPE OPS + SETZM IMMED' + SKIPN STRING + POPJ P, ;NO STRING + MOVE A,BTPNT + ILDB I,A + CAIN I,"# + JRST APUPJ ;YEPE HE ASKED FOR IT + SKIPE STRING+1 + POPJ P, ;STRING IS LONG + SKIPA + TSTSHL: ILDB I,A + JUMPE I,APUPJ ;ITS OK FOUND ONLY NUMBERS + CAILE I,"@ + POPJ P, ;NON-NUMBER IN STRING + CAIE I,". + JRST TSTSHL + ILDB I,A + SKIPN I ;ANYTHING FOLLOW '.' QST +APUPJ: SETOM IMMED' ;INDICATE IMMEDIATE USAGE IS POSSIBLE + POPJ P, + +SZPRT: SETZM CHARF +GOPRT: SETZM WARN +GOPART: MOVEM I,R2SV +GOPURT: HLRZ B,I + HLRZ C,(SYM) + CAMLE B,C + JRST PSOPR ;GO PUSH OPERATOR + SKIPN INTEGR + SETOM IMMED ;FOR ARITH OPS ONLY FIXED WILL DO IMMEDIATE + PUSHJ P,SHORT ;ESTABLISH IF STRING CAN BE IMMEDIFIED + POP SYM,A ;POP AN OPERATOR + JUMPN A,(A) + + MOAN OVERPOPPED OPERATOR STACK + +CHEX: MOVE A,R1SV + JRST CHEY + +RP: SKIPE EQHIT + AOS ENN ;TAKE CARE OF UNSATISFIED = AT END + SKIPN CHARF + JRST RTONOP + SETOM CHARF +BUDDY: SETOM WARN + MOVEI I,RPAR + JRST GOPART + +RTONOP: MOVE I,(SYM) + CAIN I,FUNCT + JRST BUDDY ;NO ARGUMENT FUNCTION + + MOAN ) FOLLOWS OPERATOR + +BDEND: MOAN TOO MANY ('S + +CHBRT: MOAN NON-OPERATOR FOLLOWS ) + CR: SKIPE EQHIT + AOS ENN ;HANDLES UNSATISFIED = AT END + SETOM ENDSTT + MOVEI I,RCAR + JRST GOPRT + +LP: SETZM EQHIT + SKIPE WARN + JRST LFRHT + SETZM CHARF + SKIPE STRING + JRST INDX + PUSH P,[0] ;INITIALISE COMMA-COUNTER + PUSH SYM,[0,,LFTPR] + JRST RDITA + +INDX: NUMBER + JRST NUSTRB + GETT + CAIG A,"9 + JRST NMRINX + MOVEI I,"( + IDPB I,D +INDY: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDN + CAIN A,"- + JRST CMPNDN + CAIE A,") ;SEARCH FOR NEXT RP + JRST INDY + IDPB A,D +CMBAN: SETOM CHARF ;MAKE BELIEVE CHARATER LAST + SETOM WARN ;YET SET ) TRAP + JRST RDITA + +NMRINX: CAIN A,"- ;IS IT A MINUS + JRST INDZ + CAIN A,"+ + JRST INDZ + MOVEI I,"+ ;NUMERICAL SUBSCRIPT + IDPB I,D +INDZ: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDC + CAIE A,") + JRST INDZ + JRST CMBAN + +CMPNDN: MOVEI I,") + IDPB I,D + JRST INDZ + +CMPNDC: MOVEI I,"( + IDPB I,D + JRST INDY + +LFRHT: MOAN ( FOLLOWS DIRECTLY ON ) + SP=RDITA ;USE FOR NON ARITH STATS + +CM: MOVE I,[1,,COMMX] + SKIPN CHARF + AOS ENN + JRST SZPRT + +EQ: SETOM EQHIT + SETZM WARN + SKIPN CHARF ;TEST FOR EXISTANCE OF L H S + JRST EQFLOP + NUMBER ;IS L H S A NUMBER + JRST EQNUMB + MOVEI I,EQAAL +EQVAL: SETZM CHARF + PUSH SYM,I + PUSH P,STRING + PUSH P,STRING+1 + PUSH P,STRING+2 + PUSH P,[0] + JRST CLSTR + +PL: MOVE I,[2,,PLUS] + SKIPN CHARF + JRST RDITA ;UNARY PLUS + JRST SZPRT + +MN: MOVE I,[2,,MINUX] + SKIPN CHARF + MOVE I,[5,,UMINU] + JRST SZPRT + +AB: SKIPE CHARF ;ABSOLUTE VALUE + JRST ABERR ;NOT UNARY + MOVE I,[5,,UABS] + JRST SZPRT + +LB: SKIPN CHARF + JRST LP ;TREAT LIKE ( + NUMBER + JRST NUBRST + MOVEI I,FUNCT + JRST EQVAL + +RB=RP + +NUBRST: MOAN '<' FOLLOWS NUMBER + +NUSTRB: MOAN '(' FOLLOWS NUMBER + +EQFLOP: MOAN '=' FOLLOWS OPERATOR + +EQNUMB: MOAN '=' FOLLOWS NUMBER + +ABERR: MOAN NON-UNARY ABS + TX: MOVE I,[4,,TIMES] + SKIPN CHARF + JRST RDITA ;UNARY TIMES + JRST SZPRT + +DL: GET ;CONTINUE STATEMENT RC + GET ;LF + GET ;. + CAIE A,". ;DOT + JRST BDCONT + GET ;F OR I + GET ;CONTROL I OR SPACE + MOVE A,DIRPNT + MOVEM A,TPN ;RESET SAVED INPUT POINTER TO AVOID FILLING ITS BUFFER + MOVEI A,"$ + IDPB A,TPN + MOVEI A,40 + IDPB A,TPN + JRST RDITA + +ERRCON: TRNE FF,FRPSS2 ;NO OUTPUT ON SECOND PASS + JRST CONRBT +;MAY ALSO WANT TO USE STATEMENT PLUS LINE NUMBER TYPE TACTIC + MOVE B,DIRPNT +OUTRR: ILDB A,B + PUSHJ P,TYO + CAME B,TPN + JRST OUTRR + SKIPE ENDSTT + JRST CONERT +DORSTL: MOVEI A,40 + PUSHJ P,TYO + MOVEI A,"? ;POINT AT ERROR + PUSHJ P,TYO + MOVEI A,40 + PUSHJ P,TYO +DORSAL: GET ;COPY UP TO LINE FEED + PUSHJ P,TYO + CAIE A,12 ;LF + JRST DORSAL +CONERT: PUSHJ P,TIPIS + PUSHJ P,CRR +CONRAT: MOVE TM,[ACSAV,,P] + BLT TM,P+6 + JRST SWFLS ;GO BACK AND FLUSH + + +CONRBT: GET + CAIE A,12 ;LF + JRST CONRBT + JRST CONRAT + UP: SKIPN WARN ;FOR (NUMBER)^N + SKIPN STRING + JRST ITSEX + MOVEM A,R1SV ;SAVE THE ARROW + NUMBER + JRST CHEX ;ITS PART OF A NUMBER +ITSEX: MOVE I,[6,,STRSTR] + SKIPN CHARF + JRST EXMB + JRST SZPRT + +EXMB: MOAN UNARY ^ + +BDCONT: MOAN BAD CONTINUATION + +KL=CR ;SEMICOLON ACTS LIKE CR IN TERMINATING + +STRSTR: SKIPN STRING + JRST EXLS + NUMBER + SKIPA + JRST EXLS + SUBI I,61 + TDNE I,[-1,,777774] + JRST EXLS + MOVE A,STRING + TDNE A,[3777,,-1] + JRST EXLS + ADDI I,POWR + JRST @(I) + +EXLS: PUSH P,[ASCII !EXPLO!] + PUSH P,[ASCII !G !] + PUSH P,[0] + PUSH P,[1] + SETOM EXRET' + JRST FUNET + +DV: MOVE I,[4,,DIVIX] + SKIPN CHARF + MOVE I,[5,,UDIVI] + JRST SZPRT + +PSOPR: PUSH SYM,I ;PUSH OPERATOR FOR LATER EXCECUTION + SKIPN STRING + JRST RDITTS + PUSHJ P,SHORT ;CAN WE IMMEDIFY + PUSHJ P,MVOI ;AND MOVE OPERAND INTO STACK + JRST CLSTR + PRODB: NUMBER ;OUTPUT WHAT IS IN STRING + SKIPE IMMED ;NO [ & ] IF IMMEDIATE USE + JRST OVNM + PUSH P,A + MOVEI A,"[ ;[ FOR CONSTANT + PUSHJ P,PUTREL + POP P,A + SETOM NUMFL +OVNM: CAIN I,"# + JRST PRDOC + + EXCH A,I + PUSHJ P,PUTREL + MOVE A,I +PRDOC: ILDB I,A + JUMPN I,OVNM + SKIPN NUMFL + POPJ P, + MOVEI A,"] ;] FOR CONSTANT + PUSHJ P,PUTREL + SETZM NUMFL + POPJ P, + +PRODC: HRLI A,440700 ;MAKE BYTE POINTER + JRST PRDOC + +LFTPR: SPECN + JRST RDITTS ;IGNORE LP ON STACK + RCAR: HALT ;IMPOSSIBLE FOR THESE TO BE ON STACK +RPAR: HALT + +EQAAL: SPECN + SKIPE STRING + PUSHJ P,MVOI + MOVEI A,[ASCIZ ! MOVEM A!] + PUSHJ P,PRODC + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +ENDSAT: SPECN + SKIPN ENDSTT + JRST TOEARL + SKIPE STRING + PUSHJ P,MVOI +GETLF: GET + CAIE A,12 ;LF + JRST GETLF + MOVE TM,[ACSAV,,P] + BLT TM,P+6 + JRST SWRET ;GO BACK + +MVOI: MOVE A,BTPNT + ILDB I,A + CAIN I,"& + JRST MVOALR ;OPERAND ALREADY THERE + MOVEI A,[ASCIZ ! MOVE A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVEI A!] +MVOIK: PUSHJ P,PRODC + MOVE A,ENN + AOS ENN +FINOF: PUSHJ P,PUTREL + MOVEI A,", + PUSHJ P,PUTREL + PUSHJ P,PRODB + RETLIN + POPJ P, + +MVOALR: AOS ENN + POPJ P, + +TOEARL: MOAN TOO MANY )'S + PLUS: MOVEI A,[ASCIZ ! FADR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! ADD A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! ADDI A!] +OPERT: PUSHJ P,PRODC + SKIPE STRING + JRST GAINS + SOS ENN +OPRTE: MOVE A,ENN + SOS A + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +COMMAA: MOVEI A,", + PUSHJ P,PUTREL + MOVEI A,"A + JRST PUTREL + +GAINS: MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +MINUX: MOVEI A,[ASCIZ ! FSBR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! SUB A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! SUBI A!] + JRST OPERT + +TIMES: PUSHJ P,TMSTR + SKIPE IMMED + MOVEI A,[ASCIZ ! IMULI A!] + JRST OPERT + +DIVIX: MOVEI A,[ASCIZ ! FDVR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IDIV A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! IDIVI A!] + JRST OPERT + UMINU: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE STRING + JRST MOABC + MOVEI A,[ASCIZ ! MOVNS A!] +UMINUC: PUSHJ P,PRODC + MOVE A,ENN + SOS A + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +MOABC: MOVEI A,[ASCIZ ! MOVN A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVNI A!] + PUSHJ P,MVOIK + JRST GAMB + +UABS: CAMN B,C + JRST BAKWD + SKIPE STRING + JRST MOABS + MOVEI A,[ASCIZ ! MOVMS A!] + JRST UMINUC + +MOABS: MOVEI A,[ASCIZ ! MOVM A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVMI A!] + PUSHJ P,MVOIK + JRST GAMB + +MVONT: MOVEI A,[ASCIZ ! MOVE A!] + PUSHJ P,PRODC + MOVE A,ENN + JRST ONMVS + +TMSTR: MOVEI A,[ASCIZ ! FMPR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IMUL A!] + POPJ P, + BAKWD: PUSH SYM,A + JRST PSOPR + +UDIVI: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE INTEGR + JRST UINDV + SKIPN STRING + PUSHJ P,MVONT + MOVEI A,[ASCIZ ! HRLZI A!] + PUSHJ P,PRODC + MOVE A,ENN + SKIPN STRING + SOS A + PUSHJ P,PUTREL + MOVEI A,[ASCIZ !,201400!] + PUSHJ P,PRODC + RETLIN + AOS ENN + JRST DIVIX + +ONTMS: PUSHJ P,TMSTR + PUSHJ P,PRODC + MOVE A,ENN + SOS A +ONMVS: PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A +LSTCHX: PUSHJ P,PUTREL + RETLIN + POPJ P, + +POWR: GAMB?POWR2?POWAA?POWR4 + +POWR4: PUSHJ P,ONTMS +POWR2: PUSHJ P,ONTMS + JRST GAMB + +POWAA: PUSHJ P,MVONT + AOS ENN + PUSHJ P,ONTMS + SOS ENN + PUSHJ P,TMSTR + PUSHJ P,PRODC + RESTOR + JRST OPRTE + +COMMX: AOS (P) + SKIPE STRING + PUSHJ P,MVOI + JRST GAMB + UINDV: MOAN INTEGER UNARY DIVIDE + +FUNCT: SETZM EXRET +FUNET: SKIPE STRING + PUSHJ P,MVOI + SPECN + PUSHJ P,MORFMC + MOVEI A,[ASCIZ ! PUSHJ P,!] + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + PUSHJ P,PRODC + PUSHJ P,PRODB + RESTOR + RETLIN + PUSHJ P,MORFNC + SKIPN EXRET + JRST RDITTS ;AS USED FROM FUNCT + JRST COMMT ;AS USED FROM STRSTR + +MORFMC: MOVE A,RANDM + MOVEM A,RANSV' + SKIPN CHARF ;NO ARGUMENTS + AOS ENN + SETOM CHARF + MOVEI A,"1 + CAMN A,ENN ;ARE ARGUMENT ALREADY IN A0 AND UP + POPJ P, + SETZM CORDM +MORYLP: PUSHJ P,ZENBD + AOS CORDM + SOSL RANSV + JRST MORYLP + POPJ P, + +MORFNC: MOVEI A,"1 + CAMN A,ENN + POPJ P, + MOVE A,RANDM + MOVEM A,CORDM' +MORXLP: PUSHJ P,ZENBD + SOSL CORDM + JRST MORXLP + POPJ P, + +ZENBD: MOVEI A,[ASCIZ ! EXCH A!] + PUSHJ P,PRODC + MOVE A,CORDM + ADDI A,"0 + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A + ADD A,CORDM + JRST LSTCHX + TIPIS: MOVE A,TEMP + MOVEM A,BYTPNT +MORTP: ILDB A,BYTPNT + CAIN A,1 ;EXCLAMATION + POPJ P, + ADDI A," ;SPACE + PUSHJ P,TYO + JRST MORTP + +] ;END .I.FSW CONDITIONAL + IFN LISTSW,[ + +;LISTING ROUTINES. + +PNTR: MOVEM 17,PNTSA+17 + MOVEI 17,PNTSA + BLT 17,PNTSA+16 + SKIPL LSTONP + JRST PNTR5 + AOSE LISTPF + JRST PNTR1 + SKIPGE T,LISTAD + JRST PNTR2 + PUSHJ P,P6OD + HLRZS T + PUSHJ P,PSOS ;PRINT SPACE OR ' + PUSHJ P,PILPTS +PNTR3: HLRZ T,LISTWD + PUSHJ P,P6OD + MOVS T,LSTRLC + TLNE T,400000 + AOJ T, + PUSHJ P,PSOS + HRRZ T,LISTWD + PUSHJ P,P6OD + HRRZ T,LSTRLC + PUSHJ P,PSOS + PUSHJ P,PILPTS + PUSHJ P,PILPTS +PNTR4: MOVE TT,[440700,,LISTBF] +PNTR6: CAMN TT,PNTBP + JRST PNTR5A + ILDB A,TT + PUSHJ P,PILPT + JRST PNTR6 + +PNTR5A: CALL PNTCR + MOVE A,LISTBC + CAIE A,14 + JRST PNTR7 +PNTR5C: CALL PILPT ;OUTPUT THE ^L, + CALL PNTHDR ;AND THE PAGE NUMBER. + JRST PNTR5D + +PNTR7: MOVEI A,12 + PUSHJ P,PILPT +PNTR5D: SETOM LISTBC +PNTR5: MOVNI A,LISTBS*5-1 + MOVEM A,PNTSW ;DETECT OVERFLOW OF LISTBF + MOVE TT,[440700,,LISTBF] + MOVEM TT,PNTBP + MOVSI 17,PNTSA + BLT 17,17 + POPJ P, + PNTR5B: MOVE A,LISTBC + CAIN A,14 + JRST PNTR5C + JRST PNTR5D + +PNTR2: MOVEI T,8 + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR3 + +PNTR1: MOVE TT,[440700,,LISTBF] + CAMN TT,PNTBP + JRST PNTR5B + MOVEI T,25. + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR4 + +PSOS: MOVEI A,"' + TRNN T,-1 +PILPTS: MOVEI A,40 + JRST PILPT + +P6OD: MOVE TT,[220300,,T] +P6OD1: ILDB A,TT + ADDI A,"0 + PUSHJ P,PILPT + TLNE TT,770000 + JRST P6OD1 + POPJ P, + +PNTCR: MOVEI A,^M ;OUTPUT ^M TO LST IF OPEN. +PILPTX: SKIPE LSTONP;OUTPUT CHAR TO LST IF LSTING. + JRST PILPT + RET + +PNTHDR: MOVEI A,^I + MOVEI B,10. ;MOVE TO COLUMN 80., + CALL PILPT + SOJG B,.-1 + SAVE LSTTTY + HLLOM B,LSTTTY ;POSITIVE SO TYOERR GOES ONLY TO LST. + TYPR [ASCIZ/Page /] + MOVE A,CPGN + CALL [AOJA A,DPNT] + REST LSTTTY +PNTCRR: CALL PNTCR ;OUTPUT CRLF TO LST IF OPEN. +PNTLF: MOVEI A,^J + JRST PILPTX + DEFINE LSTM %A,B,C +IF1 [ [B] ? [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+LSTM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-LSTM0 +] +TERMIN + +A.LSTFF: AOS (P) ;RETURN NO VALUE. +; ADDR, CONTENTS IF NOT LISTING, CONTENTS IF LISTING. +LSTOFF: LSTM LSTONP,0,-1 + LSTM LSTPLM,[TLO B,4^5][JRST PSHLML] + LSTM RCHLST,RCHLS1,AOSN PNTSW + LSTM RCH1LS,RET,[CAILE A,^M] + LSTM POPLML,JFCL,[IDPB A,PNTBP] + JRST MDSCLR +LSTM0==.-LSTOFF + +LSTON: BLOCK LSTM0-1 + JRST MDSSET + +A.LSTN: SKIPN LISTP1 ;IF SHOULD LIST THIS PASS + JUMPGE FF,MACCR + SKIPE LISTP ;AND WANT LISTING, + CALL LSTON ;TURN ON LISTING OUTPUT. + JRST MACCR + +IFNDEF LISTBS,LISTBS==50. ;LISTBF SIZE IN WORDS. + +VBLK ;LISTING FEATURE VARIABLES + +PNTBP: 0 ;POINTER TO LISTING LINE BUFFER +LSTONP: 0 ;NONZERO WHEN OUTPUTTING TO LISTING FILE. +LISTP: +LISTON: 0 ;-1 IF LISTING ON +PNTSW: 0 ;-1 IF LAST CHR CR OR LF, OR -<# CHARS SPACE LEFT IN LISTBF> +LISTBF: BLOCK LISTBS +LISTAD: 0 ;ADDRESS OR -1 NONE 3.1 RELOC +LISTWD: 0 ;WORD +LSTRLC: 0 ;RELOCATION +LISTPF: 0 ;-1 OTHERS CONTAIN SOMETHING +LISTBC: 0 ;BREAK CHR CR LF OR FF OR -1 IF NONE SINCE LAST PNTR +LISTTM: 0 ;TEMP AT AEND +PNTSA: BLOCK 20 ;AC SAVE AREA FOR LISTING FEATURE +LISTP1: 0 ;POSITIVE => WANT TO LIST EVEN ON PASS 1. +] ;END IFN LISTSW, + +IFE LISTSW,VBLK + +;THESE VARIABLES ARE REFERENCED EVEN IF LISTSW IS 0. +LSTTTY: 0 ;TYOERR TYPES ON TTY IFF LE 0, ON LST IF NOT 0. +LSTPLM: TLO B,4^5 ;OR JRST PSHLML ;XCT'D BY PSHLMB. +POPLML: JFCL ;OR IDPB A,PNTSW ;XCT'D IN POPLMB. + +PBLK +IFE LISTSW, A.LSTN: A.LSTF: RET + VBLK +IFN CREFSW,[ +CREFP: 0 ;SET BY C SWITCH TO REQUEST CREFFING. +CRFONP: 0 ;SET WHILE CREFFING. +CRFLFL: 0 ;LAST PAGNUM,,LINENUM OUTPUT. +CRFINU: JFCL\PUSHJ P,CRFUSE ;XCT THIS TO CREF NON-DEF OCCUR. +CRFLBL: JFCL\PUSHJ P,CRFLB1 ;XCT FOR DEF. OF NORMAL SYM. +CRFEQL: JFCL\PUSHJ P,CRFEQ1 ; FOR DEF. OF NORMAL SYM. OR INTSYM. +CRFMCD: JFCL\PUSHJ P,CRFMC1 ; FOR DEF. OF MACRO. +CRFDEF: JFCL\PUSHJ P,CRFDF1 ; FOR RANDOM DEF, CHECK FLAGS. +] +CRFILE: 0 ;SET => SHOULDN'T OUTPUT PAGNUM,,LINENUM'S +;USED BY .CRFILE INTSYM SO CAN'T BE IN CONDIT. +PBLK +IFN CREFSW,[ +CRFEQ1: MOVEI T,(B) + CAIN A,1 ;IF NOT PSEUDO OR NOT INTSYM, + CAIE T,INTSYM + JRST CRFLB1 ;IS NORMAL SYM. +CRFOD1: MOVSI T,600000 ;ELSE DEFINING INSN. + JRST CRFEQ2 + +CRFDF2: MOVEI T,(B) ;DECIDE WHETHER DEFINING MACRO OR PSEUDO. + CAIE T,MACCL + JRST CRFOD1 +CRFMC1: SKIPA T,[500000,,] ;DEFINING MACRO. +CRFLB1: MOVSI T,440000 ;DEFINING NORMAL SYM. +CRFEQ2: PUSH P,A + MOVE A,T + JRST CRFMA1 + +;COME HERE FOR NON-DEF; MUST DECIDE WHAT TYPE SYM. +CRFUSE: TLNE C,3NCRF ;SYM MAY HAVE CREFFING SUPPRESSED. + POPJ P, + PUSH P,A + CAIN A,1 + JRST CRFMAC ;PSEUDOS, MACROS. + MOVSI A,40000 ;FLAG FOR NORMAL SYM. + TRNN C,-1 + MOVSI A,200000 ;FLAG FOR INSNS. +CRFMA1: PUSH P,A + MOVE A,CLNN + HRL A,CPGN + AOBJN A,.+1 ;A HAS PAGNUM,,LINENUM . + SKIPGE CRFILE ;IF SHOULD OUTPUT IT, + JRST CRFUS1 + CAME A,CRFLFL ;AND HAS CHANGED, DO SO. + PUSHJ P,CRFOUT + MOVEM A,CRFLFL +CRFUS1: POP P,A + IOR A,SYM ;COMBINE SYM AND CREF FLAG. + PUSHJ P,CRFOUT + JRST POPAJ + +CRFMAC: MOVEI A,(B) + CAIN A,MACCL + SKIPA A,[100000,,] ;MACRO + MOVSI A,200000 ;PSEUDO-OP. + JRST CRFMA1 + ;DEFINING OCCURRENCE, MIGHT BE ANY TYPE SYM. +CRFDF1: CAIN A,1 ;TYPE 1 => MACRO OR PSEUDO. + JRST CRFDF2 + TRNE C,-1 ;ELSE INSN OR NORMAL SYM. + JRST CRFLB1 + JRST CRFOD1 + +DEFINE CRFM %A,B,C +IF1 [ [B] + [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+CRFM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-CRFM0] +TERMIN + + +A.CRFFF: AOS (P) ;.CRFOFF - STOP CREFFING. NO VAUE. +; LOCATION, NORMAL VALUE, VALUE WHILE CREFFING +CRFOFF: CRFM CRFONP,0,-1 + CRFM CRFLBL,JFCL,[PUSHJ P,CRFLB1] + CRFM CRFEQL,JFCL,[PUSHJ P,CRFEQ1] + CRFM CRFMCD,JFCL,[PUSHJ P,CRFMC1] + CRFM CRFINU,JFCL,[PUSHJ P,CRFUSE] + CRFM CRFDEF,JFCL,[PUSHJ P,CRFDF1] + POPJ P, +CRFM0==.-CRFOFF + +CRFON: BLOCK CRFM0-1 + POPJ P, + +A.CRFN: JUMPGE FF,MACCR + SKIPE CREFP ;.CRFON, IF HAVE CREF FILE, START CREFFING. + PUSHJ P,CRFON + JRST MACCR +] ;END IFN CREFSW, + IFN TS,[ ;;TS ;TIME-SHARING ROUTINES + +IFNDEF TYPDLC,TYPDLC==7 ;MAXIMUM TOTAL DEPTH OF .INSRT (INCLUDING TTY) +IFNDEF MX.INS,MX.INS==5 ;MAXIMUM DEPTH .INSRT FILES ONLY +IFNDEF MAXIND,MAXIND==6 ;MAXIMUM # @: TABLE ENTRIES FOR .INSRT +IFN DECSW,[ + UTOBFL==203 + CRFBSZ==203 + UTIBFL==410 + LSTBSZ==203 + ERRBSZ==203 +] +IFNDEF UTIBFL,UTIBFL==400 ;INPUT BUFFER SPACE. +IFNDEF UTOBFL,UTOBFL==200 +IFNDEF CMBFL,CMBFL==50 ;COMMAND BUFFER LENGTH. +IFNDEF CRFBSZ,CRFBSZ==200 ;# WDS CREF OUTPUT BUFFER. +IFNDEF LSTBSZ,LSTBSZ==200 +IFNDEF ERRSW,ERRSW==1 ;1 FOR ERROR FILE OUTPUT CAPABILITY. +IFNDEF ERRBSZ,ERRBSZ==1 ;ERROR FILE BUFFER SIZE. + +ERRC==0 ;ERR DEVICE CHANNEL. +TYIC==1 ;TTY INPUT CHANNEL +TYOC==2 ;TTY OUTPUT CHANNEL +CREFC==3 ;CREF OUTPUT. +UTYOC==4 ;OUTPUT FILE +LPTC==5 ;LISTING (LPT) +ERRFC==6 ;ASSEMBLY ERROR OUTPUT FILE. +UTYIC==7 ;1ST INPUT CHANNEL, UTYIC+N USED FOR NTH .INSRT LEVEL IN DEC VERSION. + +VBLK +INTJPC: 0 ;SAVES .JPC AT INTERRUPT. +INTSVP: 0 ;SAVES P ON INTERRUPT FOR DEBUGGING + +;NOTE THAT ONLY PDL OV IS NOW ENABLED. + +IFN ITSSW,[ +.JBCNI: +TSINT: 0 ;1ST WD INTERRUPTS (AT PRESENT) ARE CONSIDERED FATAL ERRORS +.JBTPC: 0 ;ERROR PROCESSOR RE-ENABLES INTERRUPTS + .SUSET [.RJPC,,INTJPC] + SKIPGE TSINT + JRST TTYINT ;SECOND-WORD INTS. + JRST TSINT1 ;JUMP INTO PURE CODING AND PROCESS INTERRUPT +] +IFE ITSSW,[ +CCLFIL: 0 ; FLAGS TO INDICATE CCL ENTRY FROM COMPIL OR SNAIL OR CCL OR EXEC +CCLFLG: 0 +] + +PBLK +TSINT1: MOVEM P,INTSVP ;SAVE P FOR POSSIBLE DEBUGGING + .SUSET [.SPICL,,[-1]] + MOVE A,.JBCNI ;GET INTERRUPT REQUEST WORD + TRNE A,200000 ;PDL OVERFLOW? + JRST CONFLP + MOVE B,[TYPR [ASCIZ/Unknown interrupt - Fatal/]] + MOVEM B,40 + MOVE A,.JBTPC ;SO ERROR ROUTINE WILL PRINT OUT PROPERLY + JSA A,ERROR + +IFN TNXSW,[ + +XJSYSP==TM ; HOPE THIS WORKS + +.INSRT XJSYS +] + ;MIDAS STARTS HERE. +BEG: +IFN DECSW\TNXSW,[ + TDZA A,A + SETO A, + MOVEM A,CCLFLG ; REMEMBER TYPE OF START-UP +] +IFN DECSW,[ + RESET + MOVEI A,600000 + APRENB A, +] +IFN ITSSW,[ + .SUSET [.RSNAM,,RSYSNM] ;GET SYSTEM NAME + .SUSET [.SMASK,,[%PIPDL]] ;PDL OVERFLOW ONLY. + .SUSET [.SMSK2,,[1_TYIC]] + SYSCAL TTYSET,[1000,,TYIC + [232020,,202020] + [232020,,220220]] + .SUSET [.SPICL,,[-1]] ;PERMIT INTERRUPTS (IN CASE RESTARTED DURING INTERRUPT) +] + MOVEI FF,0 ;INITIALIZE FLAGS + MOVE P,[-LPDL,,PDL-1] ;INITIALIZE P + AOSN NVRRUN + JRST BEG9 + TYPR [ASCIZ /Can't restart MIDAS/] + JRST TSRETN + +BEG9: MOVEI D,SYMDSZ ;GET DEFAULT SYMTAB SIZE +IFN ITSSW,[ + .SUSET [.RXJNAM,,A] + CAME A,['MMIDAS] ;OR LARGER FOR MMIDAS + CAMN A,[SIXBIT/MM/] + MOVEI D,SYMMSZ +] + SKIPGE ISYMF ;THE FIRST TIME THROUGH, + MOVEM D,SYMLEN ;MAKE THAT THE SIZE TO USE. + CALL JCLINI ;NOW TRY TO FETCH JCL. +IFN ITSSW,[SKIPGE ISYMF ;SKIP IF SYMS SPREAD + CALL TSYMGT ;GET TS SYMS FROM SYSTEM +] + SKIPGE CMPTR ;IF NO CMD FROM DDT, + JRST GO2A ;ANNOUNCE MIDAS'S NAME AND VERSION. +IFG PURESW-DECSW,[ + SKIPGE PURIFG + TYPR [ASCIZ /NOTPUR /] +] + MOVE B,[SIXBIT /MIDAS./] + PUSHJ P,SIXTYO + MOVE B,[MIDVRS] + PUSHJ P,SIXTYO +; JRST GO2A + GO2A: SETOM FATAL + SETZM TTYFLG + SETZM ERRCNT ; INITIALIZE ERROR COUNTER + MOVEI FF,0 ;INITIALIZE FLAGS + SKIPLE CMPTR + SETZM CMPTR +IFN RUNTSW,[ PUSHJ P,RNTTMA ;GET INITIAL RUN TIME. + MOVEM A,IRUNTM'] + SETZM LSTTTY + PUSHJ P,CMD ;GET TYPED IN COMMAND + SKIPGE SMSRTF + JRST GO21 + TYPR [ASCIZ/SYMTAB clobbered +/] + JRST GO2A + +GO21: PUSHJ P,GINIT ;INITIALIZE STUFF + PUSHJ P,OPNRD ;OPEN INPUT FILE + PUSHJ P,WINIT ;OPEN OUTPUT FILE, CREF FILE. +IFN DECSW\TNXSW,[ + SKIPGE CCLFLG + TYPR [ASCIZ /MIDAS: /] +] +GO3: MOVEMM TTYFLG,WSWCNT ;TURN OFF TYPEOUT IF THERE WERE (W) SWITCHS. + SETOM LSTTTY + JSP A,$INIT ;INITIALIZE FOR ASSEMBLY + JSP A,PS1 ;DO PASS 1 + TRNE FF,FRNPSS ;IF 2 PASS ASSEMBLY, + PUSHJ P,OPNRD ;THEN RE-OPEN INPUT FILE + JSP A,PLOD ;MAYBE PUNCH OUT SBLK LOADER IN SOME FORMAT + JSP A,PS2 ;DO PASS 2 + JSP A,PSYMS ;MAYBE PUNCH OUT SYMBOL TABLE +IFN A1PSW,[ + TLZ FF,$FLOUT + AOS PRGC ;INDICATE END STATEMENT ENCOUNTERED + SETOM OUTC ;" " " + TRNN FF,FRNPSS ;IF 1 PASS ASSEMBLY, + SKIPGE CONTRL + CAIA + JRST GO3 ;THEN TRY TO ASSEMBLE ANOTHER PROGRAM +] +IFN FASLP,[ + SKIPGE A,CONTRL + TRNN A,FASL + JRST GO4 + MOVE A,[SIXBIT /*FASL*/] ;"FINISH" FASL FILE + MOVEI B,17 + PUSHJ P,FASO ;IGNORE END FROB, BUT OUTPUT FASL END CODE + MOVE A,[.BYTE 7 ?3 ? 3 ? 3? 3? 3] + PUSHJ P,FASO1 ;RANDOMNESS + PUSHJ P,FASBE ;WRITE OUT LAST BLOCK +] +GO4: SETZM FATAL ;THERE WAS NO FATAL ERROR: OUTPUT FILES GET RENAMED. +GO2: +RETN2: PUSHJ P,.FILE + SETZM LSTTTY +IFN RUNTSW,[ + PUSHJ P,RNTTYO ;TYPE OUT RUN TIME USED SINCE GO2A +];IFN RUNTSW + CALL ERRCLS ;FILE AWAY ERROR FILE. + JRST TSRETN + + ;INITIALIZATION ROUTINE CALLED ONCE PER (COMMANDED) ASSEMBLY + +GINIT: IFN A1PSW,[ + SETOM PRGC + SETOM OUTC +] +IFN DECSW,[ IFE SAILSW,[ + SETZM V.SITE ;; CODE TO SET UP .SITE'S VALUE, ON DEC SYSTEM. + MOVE A,[V.SITE,,V.SITE+1] + BLT A,V.SITE+4 + MOVE B,[440600,,V.SITE] + MOVSI C,-5 ;PROCESS 5 WORDS OF .GTCNF +GINIT1: HRLZ A,C + HRRI A,11 ;11 = .GTCNF + GETTAB A, ;GET 1 WORD + SETZ A, +GINIT2: SETZ AA, ;EXTRACT THE ASCII CHARS AND STORE THEM. + ROTC AA,7 + TRCE AA,140 ;SWAP BIT 40 WITH BIT 100, THUS TURNING + TRCE AA,140 ;"A TO 'A, "a TO 'A, "1 TO '1, ETC, AND ^@ TO ' . + TRCE AA,140 + IDPB AA,B ;STORE THE SIXBIT INTO .SITE'S VALUE STRING. + JUMPN A,GINIT2 ;WHEN NOTHING LEFT OF THIS WORD OF .GTCNF, GET THE NEXT. + AOBJN C,GINIT1 +]];END DECSW +IFN TNXSW,[ + SETZM V.SITE ;; CODE TO SET UP .SITE'S VALUE, ON TENEX + MOVE A,[V.SITE,,V.SITE+1] + BLT A,V.SITE+4 + MOVE B,[440600,,V.SITE] + MOVSI C,-5 ;PROCESS 5 WORDS OF SYSVER + SYSCAL SYSGT,[['SYSVER]],[D] + JUMPE D,GINIT3 ;IF TABLE NOT FOUND +GINIT1: HRLZ A,C + HRR A,D + SYSCAL GETAB,[A],[A] ;GET 1 WORD + SETZ A, +GINIT2: SETZ AA, ;EXTRACT THE ASCII CHARS AND STORE THEM. + ROTC AA,7 + TRCE AA,140 ;SWAP BIT 40 WITH BIT 100, THUS TURNING + TRCE AA,140 ;"A TO 'A, "a TO 'A, "1 TO '1, ETC, AND ^@ TO ' . + TRCE AA,140 + IDPB AA,B ;STORE THE SIXBIT INTO .SITE'S VALUE STRING. + JUMPN A,GINIT2 ;WHEN NOTHING LEFT OF THIS WORD OF .GTCNF, GET THE NEXT. + AOBJN C,GINIT1 +];END TNXSW + MOVE A,[MAXIND,,FDSOFS] + MOVEM A,INDDP ;INITIALIZE POINTER INTO INDIRECT FILE TABLE +IFDINI: MOVE A,[DNAM,,IFDS] + BLT A,IFDS+LFDSE-1 ;SET UP INPUT FILE NAMES FROM DNAM ETC. + POPJ P, + IFN RUNTSW,[ ;TYPE OUT RUN TIME USED + +RNTTYO: +IFE ITSSW,[ ; NOBODY WANTS THIS ON ITS, BUT OTHER PEOPLE DO...SIGH... + SKIPE A,ERRCNT ; ANY ASSEMBLY ERRORS? + JRST [ TYPR [ASCIZ/? /] ; YES, ERROR MESSAGE FOR BATCH CONTROLLERS + CALL DPNT + TYPR [ASCIZ/ error(s) detected +/] + JRST .+1] +IFN DECSW\TNXSW,[ + SKIPE CCLFLG ; CALLED VIA CCL? + RET +] ; IFN DECSW\TNXSW +] ; IFE ITSSW + TYPR [ASCIZ /Run time = /] + CALL A.MRUNT ;GET RUNTIME IN MILLISEC. IN A. + IDIVI A,10. + IDIVI A,100. ;GET SECS AND HUNDREDTHS. + HRLM B,(P) ;SAVE REMAINDER + PUSHJ P,HMSTYO ;TYPE OUT SECS + MOVEI A,". + CALL TYO + HLRZ A,(P) + CALL RNTYO3 ;TYPE OUT HUNDREDTHS + CALL CRR + CALL A.SYMC + CALL DPNT + TYPR [ASCIZ/ Symbols including initial ones +/] + RET + + ;TYPE OUT H:MM:SS TIME IN A + ;DOESN'T WORK FOR TIMES .GE. 60. HOURS + +HMSTYO: IDIVI A,60. + JUMPE A,HMSTY2 + HRLM B,(P) + PUSHJ P,HMSTYO + MOVEI A,": +RNTYO2: PUSHJ P,TYO ;TYPE DELIMITING CHAR + HLRZ A,(P) +RNTYO3: IDIVI A,10. + PUSHJ P,ADGTYO ;TYPE OUT DIGIT IN A + MOVEI A,"0(B) + JRST TYO + +HMSTY2: MOVE A,B + JRST DPNT + +RNTTMA: .SUSET [.RRUNT,,A] +IFN DECSW,[SETZ A, + RUNTIM A,] + POPJ P, + +A.MRUNT: PUSHJ P,RNTTMA ;GET CURRENT RUN TIME + SUB A,IRUNTM' ;SUBTRACT RUN TIME AS OF GO2 +IFN ITSSW,[MULI A,4069. ;CONVERT TO NANOSECONDS + DIV A,[1.^6] ;THEN TO MILLISECONDS. +] + JRST CLBPOP +] + ;TS OUTPUT ROUTINES + +PPB: JUMPGE FF,CPOPJ +PPBA: +TPPB: SOSGE UTYOCT + JRST TPPB1 + IDPB A,UTYOP + RET + +TPPB1: CALL TPPBF ;OUTPUT THE BUFFER, + JRST TPPB + +TPPBF: SAVE C + MOVE C,[0 UTYOC,UTOHDR] + CALL OBUFO ;OUTPUT & RE-INIT BUFFER. + REST C + RET + +WINIT: +IFN ERRSW,[ + SKIPN ERRFP ;IF WANT ERROR OUTPUT FILE, + JRST WINIT2 + CALL OINIT ;OPEN IT. + 0 ERRFC,ERRDEV + SIXBIT/ERROUT/ + ERRHDR,,ERRBUF + SETOM ERRFOP ;ERROR FILE NOW OPEN. +WINIT2: ] + PUSHJ P,OINIT ;OPEN OUTPUT FILE, FN2=OUTPUT. + 13^9 UTYOC,ONAM ; CHNL,NAME-BLOCK. + SIXBIT/OUTPUT/ + UTOHDR,,UTOBUF +IFN ITSSW,[ + TLZ FF,FLPTPF ;INITIALLY ASSUME DEVICE NOT PAPER TAPE PUNCH + .STATUS UTYOC,A ;GET STATUS OF OUTPUT CHANNEL + ANDI A,77 ;MASK TO DEVICE CODE + CAIN A,7 ;IF PAPER TAPE PUNCH, + TLO FF,FLPTPF ;THEN SET FLPTPF +] +IFN LISTSW,[ + SKIPN LISTP + JRST WINIT1 + CALL OINIT + 0 LPTC,LSTDEV ;OPEN LISTING FILE IF DESIRED. + SIXBIT/LSTOUT/ + LSTHDR,,LSTBUF +WINIT1: +] +IFN CREFSW,[ + SKIPN CREFP ;IF CREF REQUESTED, + RET + PUSHJ P,OINIT ;OPEN CREF FILE, FN2=CRFOUT + 13^9 CREFC,CRFDEV + SIXBIT/CRFOUT/ + CRFHDR,,CRFBUF + MOVE A,[.BYTE 7 ? 177 ? "B ? ^W] + PUSHJ P,CRFOUT ;OUTPUT HEADER TO INDICATE IMAGE INPUT. + PUSHJ P,CRFSSF ;OUTPUT SET-SOURCE-FILE BLOCK. +] + RET + IFN ITSSW,RELEAS==.CLOSE + +;CLOSE INPUT, BIN, CREF AND LIST FILES. +.FILE: RELEAS UTYIC, + MOVNI A,1 + SKIPL B,CONTRL ;IF RELOCATABLE, + PUSHJ P,TPPB ;OUTPUT A -1 SO STINK WILL SEE EOF + SETZ A, ;IN DEC FMT, OUTPUT A 0 AT END. + TRNE B,DECREL + CALL TPPB + SKIPE ONAM+2 + JRST .FILE2 ;OUTPUT FNAM2 WAS EXPLICITLY SPECIFIED + SKIPL B,CONTRL + SKIPA A,[IFE ITSSW,['STK,,] .ELSE ['REL,,]] + MOVSI A,(SIXBIT /BIN/) + TRNE B,DECREL ;THE DEFAULT DEPENDS ON OUTPUT TYPE. + MOVSI A,'REL +IFN FASLP,[ + TRNE B,FASL + MOVE A,[IFN ITSSW,[SIXBIT /FASL/] .ELSE ['FAS,,]] +] + MOVEM A,ONAM+2 +.FILE2: JSP A,OCLOSE + 0 UTYOC,UTOHDR ;WRITE OUT BUFFER, RENAME AND CLOSE OUTPUT FILE. + ONAM +IFN LISTSW,[ + SKIPN LISTP ;LISTING FILE OPEN => + JRST .FILE3 + CALL PNTCR ;END WITH CR AND FF. + MOVEI A,^L + CALL PILPT + JSP A,OCLOSE + 0 LPTC,LSTHDR ;OUTPUT BUFFER, RENAME & CLOSE IT. + LSTDEV +.FILE3: +] ;END IFN LISTSW +IFN CREFSW,[ + SKIPN CREFP ;IF CREF FILE OPEN, + POPJ P, + MOVEI A,0 + PUSHJ P,CRFOUT ;OUTPUT EOF BLOCK, + JSP A,OCLOSE ;WRITE BUFFER, CLOSE. + 0 CREFC,CRFHDR ; 0 CHNL,HEADER + CRFDEV +] + RET + +;FILE OUT ERROR OUTPUT FILE. +ERRCLS: SETZM FATAL ;ERR FILE RENAMED EVEN AFTER FATAL ERROR. +IFN ERRSW,[ + SKIPN ERRFOP + RET ;THERE IS NONE. + MOVEI A,^M + CALL ERRCHR ;PUT CRLF AT ENND. + MOVEI A,^J + CALL ERRCHR + JSP A,OCLOSE ;RENAME AND CLOSE. + 0 ERRFC,ERRHDR + ERRDEV + SETZM ERRFOP +] + RET + ; PUSHJ P,OINIT ;OPEN OUTPUT FILE +; MODE CHNL,NAME-BLOCK-ADDR +; SIXBIT/DESIRED-TEMPORARY-FN2/ +; HEADER,,BUFFER SPACE ;USED ONLY IN DEC VERSION. +;THE MODE SHOULD BE 13^9 FOR BINARY, 0 FOR ASCII. +IFN ITSSW,[ +OINIT: MOVE A,(P) + HLRZ B,2(A) ;GET ADDR OF HEADER, + SETOM 2(B) ;SET BUFFER BYTE COUNT TO -1 => NOT INITTED. + MOVE AA,1(A) ;GET 2ND ARG, + MOVS A,@(P) ;COPY OUTPUT FILE'S EVENTUAL NAMES INTO DNAM, ETC. + CALL A.IMP1 + .CALL OINITR ;TRANSLATE THEM AS IF OPENING THAT FILE, + JRST OINITL ;(TOO MANY TRANSLATIONS) + .CALL OINITB ;DELETE OLD TEMP NAME FILE. + JFCL ;THERE WAS NONE. + LDB A,[270400,,@(P)] ;GET CHANNEL NUM. + HRLI A,7 ;OPEN MODE. + LDB B,[331100,,@(P)] + CAIN B,0 ;BUT MAYBE WANT ASCII MODE. + HRLI A,3 + .CALL OINITO + JRST OINITL + HRRZ A,@(P) + MOVEI B,3(A) ;SUCCESSFUL OPEN, COPY TRANSLATED NAMES INTO NAME-BLOCK FOR FILE + HRLI A,DNAM + BLT A,(B) ;FOR EVENTUAL RENAME. +POPJ3: AOS (P) ;SKIP OVER 3 ARGS. +POPJ2: AOS (P) + JRST POPJ1 + +; JSP A,OCLOSE +; 0 CHNL,HEADER +; NAMEBLOCKADDR +;WRITE OUT LAST BUFFER, RENAME TO NAMES IN NAMEBLOCK AND CLOSE. +OCLOSE: MOVE C,(A) ;1ST WD OF ARGS IS WHAT OBUFO WANTS. + LDB B,[360600,,1(C)] ;JUST IN CASE THIS IS ASCII FILE, + DPB B,[300600,,OCLOSP] ;GET BP TO UNUSED PART OF LAST WD OF BUFFER, + MOVE B,[ASCIC//] + DPB B,OCLOSP ;AND PAD WITH ^C'S. + SOS 2(C) ;OBUFO ASSUMES BYTE COUNT WAS SOS'D. + CALL OBUFO ;WRITE OUT LAST PARTIAL BUFFER + MOVE B,1(A) + LDB C,[270400,,(A)] ;GET CHNL NUM. + SKIPE FATAL + JRST OCLOS1 ;AFTER FATAL ERROR, DON'T RENAME OUTPUTFILES. + .CALL ORENMB ;RENAME (B HAS NAMEBLOCK ADDR) + HALT +OCLOS1: .CALL OCLOSB ;CLOSE + HALT + JRST 2(A) + ORENMB: SETZ ? SIXBIT/RENMWO/ + C ? 1(B) ? SETZ 2(B) ;[CHNL] ? [FN1] ? [FN2] ((SETZ)) + +OCLOSB: SETZ ? SIXBIT/CLOSE/ + SETZ C + +OINITB: SETZ ? SIXBIT/DELETE/ + DNAM ? ['_MIDAS] ? AA ? SETZ SNAM + +OINITR: SETZ ? SIXBIT/TRANS/ + REPEAT 4,DNAM+.RPCNT + REPEAT 4,[? 2000,,DNAM+.RPCNT ] ((SETZ)) + +OINITO: SETZ ? SIXBIT/OPEN/ ? A + DNAM ? ['_MIDAS] ? AA ? SETZ SNAM + +;WRITE OUT AND REINITIALIZE BUFFER FOR FILE. +;ASSUMES BYTE COUNT (HEADER 3RD WD) WAS SOS'D. +;C HAS <0 CHNL,HEADER> +;IN ITS VERSION, HEADER 1ST WD HAS ,,-1 +OBUFO: SAVE A + SAVE AA + AOSGE 2(C) ;WAS COUNT SOS'D FROM -1? + JRST OBUFO1 ;YES, BUFFER HADN'T BEEN INITTED, DON'T WRITE IT. + MOVN A,1(C) + ADD A,(C) ;RH(A) HAS -<# WDS USED IN BUFFER>. + MOVSI A,(A) + HRR A,(C) + AOS A ;A HAS AOBJN -> USED PART OF BUFFER. + HLLZ AA,C + IOR AA,[.IOT A] + SKIPGE A + XCT AA ;WRITE IT IN FILE. +OBUFO1: MOVE A,1(C) + HRR A,(C) ;POSITION THE B.P. BEFORE START OF BUFFER, + TLZ A,770000 ;AFTER LAST BYTE IN WD (IDPB WILL USE 1ST BUFFER WD) + MOVEM A,1(C) + HLRE A,(C) + MOVEM A,2(C) ;SET UP BYTE COUNT. + REST AA + JRST POPAJ + +TFEED: TLNN FF,FLPTPF ;IF OUTPUT DEVICE NOT PTP, + POPJ P, ;THEN DO NOTHING + PUSHJ P,TPPBF ;OTHERWISE OUTPUT THE BUFFER, +TFEED1: .FEED UTYOC, ;FEED A LINE, + TLZA FF,FLPTPF ;IF THIS IS EXECUTED, UTYOC DOESN'T HAVE PTP AFTER ALL + SOJG B,TFEED1 ;FEED THE SPECIFIED NUMBER OF LINES, + POPJ P, ;AND RETURN + +TSRETN: +IFN PURESW,[ + SKIPGE PURIFG ;IF NOT YET PURIFIED, ASSUME BEING DEBUGGED. + .VALUE +] + .LOGOUT ;COME HERE TO COMMIT SUICIDE. + .BREAK 16,160000 + +A.SITE: CALL AGETFD ;.SITE N, RETURNS NTH WORD OF SIXBIT MACHINE NAME. + CAIE A,0 ;ON ITS, ONLY WORD 0 IS NONZERO. IT'S THE "MACHINE NAME". + JRST CABPOP + SYSCAL SSTATU,[MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A ? MOVEM A] + .LOSE 1000 + JRST CLBPOP +] ;END IFN ITSSW + OINITL: IFN ITSSW,[ + HLLZ A,@(P) ;GET CHNL NUM, + TLZ A,777037 ;MASK TO JUST AC FIELD (CHNL NUM) + IOR A,[.STATUS A] + XCT A ;READ ITS STATUS, +] + PUSHJ P,OPNER ;TYPE OUT REASON FOR OPEN FAILURE, + TYPR OINITS + PUSHJ P,GTYIP ;GET TYPEIN + HRLZ A,@(P) ;REPLACE '_MIDAS' WHATEVER BY ACTUAL NAMES. + PUSHJ P,A.IMP1 + PUSHJ P,RFD ;GET NEW FILE DESCRIPTION + HRRZ A,@(P) ;GET NAME BLOCK ADDR, + MOVEI B,3(A) + HRLI A,DNAM ;COPY NAMES JUST READ INTO IT. + BLT A,(B) + JRST OINIT + +OINITS: ASCIZ/Use what filename instead? / + +IFN DECSW,[ +OINIT: MOVE AA,(P) + MOVS A,(AA) ;GET NAME-BLOCK ADDR IN LH, + HRLZ TT,A ;GET CHNL NUM IN LH. + TLZ TT,#(0 17,) ;MASK TO AC FIELD (CHANNEL NUM) + HRRI A,DNAM + BLT A,SNAM ;COPY NAMES INTO DNAM THRU SNAM. + HRRZ D,2(AA) ;GET BUFFER SPACE ADDR. + HLLZ C,2(AA) ;GET HEADER ADDR. + HLRZ A,C + SETZM (A) ;CLEAR OUT ITS-VERSION CONTENTS OF 1ST HEADER WD. + LDB A,[331100,,(AA)] ;GET MODE TO OPEN IN (WILL BE ASCII OR IMAGE BINARY) + CALL OPNRD2 ;DO OPEN. + JRST OINITL + SAVE .JBFF + MOVEM D,.JBFF + XOR TT,[#] + XCT TT + REST .JBFF + MOVE A,[SIXBIT /000MD /] + PJOB B, ;GET JOB NUMBER, TO MAKE SIXBIT /MD/ + JFCL ;CAN IT SKIP? + IDIVI B,10. + DPB C,[220400,,A] + IDIVI B,10. + DPB C,[300400,,A] ;PUT THE DIGITS OF THE JOB NUMBER INTO THE SIXBIT WORD. + DPB B,[360400,,A] + MOVE AA,(P) + LDB B,[360600,,1(AA)] ;GET 1ST CHAR OF 'OUTPUT, 'LSTOUT, 'CRFOUT, 'ERROUT. + IOR A,B ;USE IT AS LAST CHAR OF TEMP FILE NAME. + MOVSI B,'TMP + SETZ C, + MOVE D,SNAM + XOR TT,[#] + XCT TT ;DO ENTER UTYOC,A + JRST OINITL +POPJ3: AOS (P) +POPJ2: AOS (P) + JRST POPJ1 + ;CLOSE AN OUTPUT FILE, SEE NON-DEC VERSION FOR ARGS. +OCLOSE: MOVE AA,1(A) ;NAME BLOCK ADDR. + SKIPGE FATAL + JRST OCLOS2 + MOVE C,(AA) ;DELETE ANY FILE WITH NAMES + SETZB B,D ;WE WANT TO RENAME TO. + OPEN ERRC,B + JRST OCLOS1 + MOVE B,1(AA) + HLLZ C,2(AA) + SETZ D, + MOVE T,3(AA) + LOOKUP ERRC,B + JRST OCLOS1 ;THERE IS NONE, JUST RENAME. + SETZ B, + MOVE T,3(AA) + RENAME ERRC,B + JFCL + RELEAS ERRC, +OCLOS1: MOVE B,1(AA) ;DESIRED FN1. + HLLZ C,2(AA) ;DESIRED FN2. + SETZ D, + MOVE T,3(AA) ;SNAME (THAT IS, PPN) + HLLZ AA,(A) ;GET JUST CHNL NUM. + IOR AA,[CLOSE] + XCT AA + XOR AA,[CLOSE#] + XCT AA + JFCL +OCLOS2: HLLZ B,(A) ;GET CHNL IN AC FIELD. + IOR B,[RELEAS] + XCT B + JRST 2(A) + +;WRITE OUT BUFFER OF OUTPUT FILE, C HAS <0 CHNL,HEADER> +OBUFO: AND C,[0 17,] ;GET JUST CHNL NUM. + TLO C,(OUT) + XCT C + RET + SAVE A ;ERROR RETURN FROM OUT UUO. + XOR C,[OUT#] + XCT C ;READ FILE STATUS. + TRZ A,74^4 ;CLEAR ERROR BITS. + ETR [ASCIZ /Output data error/] + XOR C,[#] + XCT C + JRST POPAJ + TFEED: RET + +TSRETN: MOVSI A,'SYS + MOVE B,[SIXBIT /MIDAS/] + SETZB C,T + SKIPE MORJCL + JRST RFDRU2 + EXIT + +A.SITE: +IFE SAILSW,[ + CALL AGETFD ;.SITE ON DEC SYSTEM; VALUE HAS BEEN PRECOMPUTED INTO V.SITE. + JUMPL A,CABPOP + CAIL A,5 + JRST CABPOP + MOVE A,V.SITE(A) + JRST CLBPOP +];END IFE SAILSW +.ELSE JRST CABPOP ;SAIL DOESN'T HAVE GETTAB USED IN SETTING UP V.SITE. + +;DEVICE NAME IN B, MODE IN A, +;HEADER ADDR IN C, BUFFER SPACE ADDR IN D, +;CREAT DEC-STYLE BUFFER RING LEAVING 1 WD BETWEEN BUFFERS. +BUFINI: MOVEI AA,A +IFE SAILSW,DEVSIZ AA, + SKIPA AA,[204] ;DEFAULT BUFFER SIZE IS THAT FOR DSK. + AOJLE AA,.-1 ;GET SIZE INCLUDING EXTRA WD. + MOVEI T,1(D) ;ADDR OF WD 2 OF 1ST BUFFER. + HRLI AA,T ;@AA IS ADDR OF 2ND WD OF NEXT BUFFER. + SUBI D,(AA) ;FACILITATE TEST FOR END OF BUFFER SPACE. + HRLI T,400000 + MOVEM T,(C) ;HEADER -> A BUFFER, SIGN SET. + HRRM T,1(C) ;MAKE RH OF BP -> BUFFER 1ST WD. + MOVSI T,440000 ;SET UP P-FIELD OF B.P. + IORM T,1(C) + HRRZ T,1(C) + AOS 1(C) + HRLI T,-3(AA) ;DATA-AREA-SIZE +1,,ADDR-OF-2ND-WD +BUFIN1: CAIGE D,-410(T) ;ROOM FOR ANOTHER AFTER THIS BUFFER? + JRST BUFIN2 ;NO, ASSUMING 410 WDS BUFFERRrSPACE. + MOVEM T,@AA ;YES, MAKE NEXT BUFFER -> THIS ONE, + HRRI T,@AA ;POINT TO NEXT ONE. + JRST BUFIN1 + +BUFIN2: ADDI D,1(AA) ;-> 2ND WD OF 1ST BUFFER. + MOVEM T,(D) ;1ST BUFFER -> LAST, MAKING RING. + RET + +;CLOSE ALL INPUT CHANNELS - EQUIVALENT TO ITS .IOPDL. +IOPDLC: MOVEI A,UTYIC + EXCH A,UTICHN ;SET INPUT CHNL NUM. TO LOWEST. + LSH A,27 + IOR A,[RELEAS] ;SET UP TO RELEAS THE HIGHEST IN USE FIRST. +IOPDL1: XCT A ;RELEAS ONE INPUT CHANNEL, + CAMN A,[RELEAS UTYIC,] + RET ;ALL DONE. + SUB A,[0 1,] + JRST IOPDL1 ;RELEAS THE NEXT ONE DOWN. + +.IOPDL==CALL IOPDLC +] ;END IFN DECSW, + IFN TNXSW,[ + +TFEED: RET + +TSRETN: MOVE C,[SIXBIT /MIDAS/] + SKIPE MORJCL + JRST RFDRUN +TSRET1: HALTF + HRROI 1,[ASCIZ/Can't continue/] + PSOUT ; BETTER THAN DYING RANDOMLY + JRST TSRET1 + +A.SITE: CALL AGETFD + JUMPL A,CABPOP + CAIL A,5 + JRST CABPOP + MOVE A,V.SITE(A) + JRST CLBPOP + +] ;END IFN TNXSW + ;TS INPUT ROUTINES + +;OPEN MAIN INPUT FILE FOR READING + +OPNRD: .IOPDL ;RE-INITIALIZE IO PDL + INSIRP SETZM,INFCNT INFCUR INFERR + MOVE A,[-TYPDLS-1,,TTYPDL] + MOVEM A,ITTYP ;INITIALIZE "TTY PDL" + PUSHJ P,MACIN1 ;CLOBBER MACRO EXPANSION STATUS + MOVS A,IFDS ;GET DEVICE NAME + CAIN A,(SIXBIT /TTY/) ;TTY? + JRST OPNRDT ;YES, TREAT SPECIAL + MOVSI A,IFDS ;NOT TTY, TRY OPENING FILE + PUSHJ P,A.IMP1 ;SET UP DNAM, ETC. + PUSHJ P,OPNRD1 ;TRY OPENING FILE + JRST OPNRDL ;LOSE + MOVEM A,INFERR ;ERR MSG IN MAIN FILE SHOULDN'T TYPE NAMES. + MOVEI A,0 ;=> INPUT FROM FILE +OPNRT2: MOVE T,[IFNM1,,RFNAM1] + BLT T,RFNAM2 ;SET UP .FNAM1, .FNAM2 + SETOM NEDCRL + JRST RCHSET ;SET UP TO READ FROM FILE OR TTY. (ARG IN A) + +OPNRDT: MOVE A,[IFDS+1,,IFNM1] ;TTY SPECIFIED, TREAT SPECIAL + BLT A,IFNM2 ;CLOBBER .IFNM1, .IFNM2 TO SPECIFIED + TYPR [ASCIZ /Reading from TTY: +/] + MOVEI A,3 ;=> INPUT FROM TTY, DON'T QUIT ON CR + JRST OPNRT2 + +OPNRDL: PUSHJ P,IOPNER ;.OPEN LOST, TYPE OUT MESSAGE + JRST GO2A ;READ NEW COMMAND + + +;COMMON STUFF FOR OPNRD1 IN DEC AND ITS VERSIONS. +OPNRD3: HRRZM A,UTIBED ;SAY BUFFER EMPTY, + MOVSI A,^C_13 + MOVEM A,@UTIBED ;CAUSE IMMEDIATE RELOAD. + MOVE A,[INFDEV+1,,IFNM1] + BLT A,IFNM2 ;SET UP .IFNM1, .IFNM2. + AOS A,INFCNT ;ASSIGN THIS FILE A NUMBER. + MOVEM A,INFCUR ;OPNRD EXPECTS THIS LEFT IN A. + JRST POPJ1 + + ;EOF WHILE TRYING TO READ CHARACTER + +RPAEOF: PUSH P,B ;SAVE B +RPAEO1: MOVE B,ITTYP ;GET PDL POINTER + PUSHJ P,BPOPJ ;CALL POP ROUTINE (MAYBE NED'S OUT) + JRST RCHTRB ;RETURN TO GET CHARACTER + + ;EOF FROM MAIN FILE + +NEDCHK: TRNE FF,FRCMND ;^C READ IN COMMANND, :KILL SELF. + JRST TSRETN + SKIPE RCHMOD + JRST NEDCH1 + AOSN NEDCRL ;INVENT ONE CRLF AFTER END OF MAIN FILE. + JRST [ MOVE B,[440700,,[.BYTE 7 ? ^M ? ^J ? ^C]] + MOVEM B,UREDP + HRRZM B,UTIBED + RET] +NEDCH1: +IFN A1PSW,[ PUSHJ P,OUTCHK + MOVSI A,-LNEDT + XCT NEDT(A) ;SKIPS IF NED CONDITION TO BE COMPLAINED ABOUT + AOBJN A,.-1 + JUMPGE A,GO4 +] + ETF [ASCIZ /No END statement/] + +IFN A1PSW,[ ;HOLLER "NED" IF ANY OF THE FOLLOWING: +NEDT: SKIPL PRGC ;NO END STATEMENTS HAVE BEEN ENCOUNTERED + SKIPGE OUTC ;OUTPUT HAS OCCURED NOT MATCHED BY AN END STATEMENT + SKIPGE OUTN1 ;OUTPUT HAS OCCURED OTHER THAN IN 1PASS MODE + TRNN FF,FRPSS2 ;CURRENTLY IN PASS 2 +LNEDT==.-NEDT ;LENGTH OF TABLE +] + IFN ITSSW,[ + ;TRY .OPENING INPUT FILE (DESCRIPTION IN DNAM, ETC.) SKIPS IF SUCCESSFUL + +OPNRD1: MOVE A,[2,,UTYIC] ;MODE,,CHANNEL. + .CALL OPENB + JRST OPNRD2 ;CAN'T OPEN INPUT FILE. + MOVE AA,[UTYIC,,A] + .RCHST AA, + SKIPN B ;GET SYSTEM FILE NAME 1 + MOVE B,FNAM1 ;SYSTEM DOESN'T KNOW, USE SPEC'D. + SKIPN C ;NOW SAME FOR FN2. + MOVE C,FNAM2 + MOVE AA,[A,,INFDEV] + BLT AA,INFDEV+3 ;REMEMBER NAMES OF CURRENT INPUT FILE. + HRLZS INFDEV ;MAKE THE DEV NAME BE LEFT-JUST. + MOVE A,IUREDP ;SET UP READING PTR, + MOVEM A,UREDP + JRST OPNRD3 ;SET UP ^C AFTER BUFFER, INFCUR, ETC. + +OPNRD2: .STATUS UTYIC,IFSTS ;.OPEN LOST, GET CHANNEL STATUS NOW BEFORE POSSIBLE .IOPOP + POPJ P, + +OPENB: SETZ ? SIXBIT/OPEN/ + A ;SHOULD HOLD MODE,,CHANNEL. + DNAM ? DNAM+1 ? DNAM+2 ? SETZ SNAM + +IUREDP: 440700,,UTIBUF + + ;EOFCH ENCOUNTERED ON READ, RELOAD AND JUMP BACK FOR NEXT CHAR + +INCHR3: HRRZ CH1,UREDP ;GET BYTE POINTER + CAME CH1,UTIBED ;END OF BLOCK? + RET ;NO, ^C IN FILE. + MOVE A,IUREDP + MOVEM A,UREDP + MOVE A,[-UTIBFL,,UTIBUF] + .IOT UTYIC,A ;READ IN BLOCK + ANDI A,-1 + CAIN A,UTIBUF ;IF THE IOT DIDN'T GIVE US ANYTHING, WE ARE AT EOF. + JRST RPAEOF + HRRZM A,UTIBED ;STORE RH (UPDATED POINTER) FOR EOF CHECK AT INCHR3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ;STORE A ^C AFTER THE DATA WE READ, SO AT EOB WE COME TO INCHR3. + JRST RCHTRA ;NOW TRY NEXT CHAR +] ;END IFN ITSSW + IFN TNXSW,[ + +INCHR3: HRRZ CH1,UREDP ;GET BYTE POINTER + CAME CH1,UTIBED ;END OF BLOCK? + RET ;NO, ^C IN FILE. + MOVE A,IUREDP + MOVEM A,UREDP + SYSCAL SIN,[UTIJFN ? [444400,,UTIBUF] ? [-UTIBFL]],[A ? A] + HRRZS A + CAIN A,UTIBUF ;IF THE SIN DIDN'T GIVE US ANYTHING, WE ARE AT EOF. + JRST RPAEOF + HRRZM A,UTIBED ;STORE RH (UPDATED POINTER) FOR EOF CHECK AT INCHR3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ;STORE A ^C AFTER THE DATA WE READ + JRST RCHTRA ;NOW TRY NEXT CHARACTER + +IUREDP: 440700,,UTIBUF + +] ;END IFN TNXSW + IFN DECSW,[ +OPNRD1: MOVEI C,UTIHDR ;OPEN THE INPUT FILE W/ NAMES IN DNAM ... SNAM. + SETZ A, ;MODE ASCII. + MOVEI D,UTIBUF + MOVE TT,UTICHN ;GET CHANNEL NUM. TO USE. + LSH TT,27 ;PUT IN AC FIELD. + CALL OPNRD2 ;DO OPEN. + RET ;FAILED. + CALL BUFINI ;INITIALIZE THE INPUT BUFFERS AND HEADER. + MOVE D,SNAM + MOVE A,FNAM1 + HLLZ B,FNAM2 + TLC TT,(OPEN#LOOKUP) + XCT TT ;LOOKUP CHANNEL,A + RET ;FAILED. +IFE SAILSW,[ + MOVE A,DNAM + DEVNAM A, ;GET REAL NAME OF DEVICE. + CAIA + MOVEM A,DNAM +] + MOVE A,[DNAM,,INFDEV] + BLT A,INFDEV+3 + MOVE A,UREDP + JRST OPNRD3 + +;TAKE C -> HEADER, D -> BUFFER SPACE, A HAS MODE, TT HAS CHNL IN AC FLD. +;OPEN FILE IN DNAM ... SNAM, INIT BUFFERS, +;THEN SET UP FOR LOOKUP OR ENTER. +;SKIP IF SUCCEED. +OPNRD2: IOR TT,[OPEN A] + MOVE B,DNAM + XCT TT ;OPEN CHANNEL,A + RET + JRST POPJ1 + +;RELOAD BUFFER, DEC STYLE. +INCHR3: HRRZ CH1,UREDP ;IS THIS ^C AT END OF BUFFER? + CAME CH1,UTIBED + RET ;NO, ^C IN FILE. + SAVE B + MOVE A,UTICHN + LSH A,27 ;CHANNEL NUM. N AC FLD. + TLO A,(IN) + XCT A ;GET NEXT BUFFERFULL. + CAIA ;SUCCEED. + JRST INCHR4 ;ERROR. +INCHR5: MOVE A,UTICNT + ADDI A,9 + IDIVI A,5 + ADD A,UREDP ;-> 1ST WD NOT READ INTO. + HRRZM A,UTIBED + HRRZ A,UREDP + AOS A + MOVEI B,1 ;SCAN THE FILE AND REPLACE ALL LINE NUMBERS WITH NULLS. +INCHR6: CAMN A,UTIBED + JRST INCHR7 + TDNE B,(A) + MOVEM B,(A) + AOJA A,INCHR6 + +INCHR7: MOVSI B,^C_13 + MOVEM B,(A) ;PUT EOF CHAR AFTER BUFFER. + JRST RCHTRB ;RETRY RCH. + +INCHR4: XOR A,[#IN] + XCT A + TRZE B,74^4 + ETR [ASCIZ /Input data error/] + XOR A,[#] + XCT A ;CLEAR ERROR BITS IN STATUS. + TRNN B,2^4 + JRST INCHR5 + JRST RPAEO1 ;EOF. +] ;END IFN DECSW, + ;IO PDL ROUTINES FOR INPUT FILE +;PUSH THE INPUT FILE + +IPUSH: AOSN CMEOF ;WANT TO POP OUT OF TTY? (^C TYPED IN) + CALL POPTT ;YES, DO NOW BEFORE FORGET. + MOVE D,UREDP ;GET INPUT BYTE POINTER +IFN ITSSW,[ + .IOPUS UTYIC, + TLNN D,760000 ;AT END OF WORD? + ADD D,[430000,,1] ;YES, MAKE IT POINT TO BEGINNING OF NEXT WORD + MOVEM D,UREDP + MOVNI A,-2(D) + ADD A,UTIBED ;GET # WDS WE'LL NEED IN MACTAB. + HLR D,UTIBED ;REMEMBER WHETHER EOF ON LAST .IOT. + HRRZS UTIBED ;NOW CLEAR OUT LEFT HALF FOR FOLLOWING +] +IFN DECSW,[ + AOS A,UTICHN ;DO ".IOPUSH" - USE NEXT CHANNEL. + LSH A,27 + ADD A,[WAIT-<0 1,>];CONSTRUCT A "WAIT" UUO FOR THE CURRENT INPUT CHANNEL. + MOVE C,RCHMOD ;WE MUSTN'T COPY THE BUFFERS WHILE I/O IS GOING ON. + CAMN A,[WAIT UTYIC,] ;BUT: IF WE ARE CURRENTLY IN THE TOP-LEVEL INPUT FILE + CAIE C,3 ;AND IT IS DEVICE TTY:, THIS CHANNEL WAS NEVER OPENED. + XCT A ;DON'T MOVE BUFFERS WHILE IO GOING ON! + MOVEI A,UTIBFL+2 ;ASSUME MUST SAVE ALL BUFFER SPACE. +] + SAVE A + ADD A,FREPTB + ANDI A,-1 + CAML A,MACTND ;NO ROOM IN MACTAB => GC IT. + CALL GCA1 + MOVEI A,370 + CALL PUTREL ;INDICATE START OF SAVED BUFFER. + REST A + AOS B,FREPTB + SUBI A,1 + MOVE C,ITTYP ;GET ADDR OF TTY PDL WD THAT'LL POINT TO SAVED BUFFER. + ADDI C,1 + HRRZM C,(B) ;STORE IN RH OF 1ST WD, + MOVEI C,(B) ;REMEMBER ADDR OF SAVED BUFFER TO PUSH ON TTYPDL. + HRLM A,(B) ;PUT LENGTH IN LH. + AOS B +IFN ITSSW,HRL B,UREDP ;ILH _ ADDR OF 1ST WD TO SAVE. +IFN DECSW,HRLI B,UTIBUF + ADDI A,-2(B) ;ADDR OF LAST WD TO BLT INTO. + BLT B,(A) + HRLI A,041000 + MOVEM A,FREPTB ;MAKE FREE BP -> LAST BYTE JUST USED. + SUB A,MACTAD + ANDI A,-1 + LSH A,2 + ADDI A,4 ;GET CHAR ADDR OF NEXT FREE BYTE. + MOVEM A,FREEPT + MOVE B,ITTYP ;GET LOCAL VERSION OF IOPDL +IPSHP: PUSH B,C ;PUSH -> SAVED BUFFER (GC WILL RELOCATE) +IFN DECSW,PUSH B,UTIBED +IFN DECSW,PUSH B,UTIHDR +REPEAT 4,PUSH B,INFDEV+.RPCNT ;SAVE NAMES OF INPUT FILE. + PUSH B,INFCUR ;SAVE NUMBER OF INPUT FILE. + PUSH B,D ;LH=LH(OLD UREDP), RH=LH(OLD UTIBED) + ;FOLLOWING TWO MUST BE LAST PUSHED + INSIRP PUSH B,[IFNM1 IFNM2] ;CLOBBERED ON PDL IF .OPEN SUCCESSFUL +INPDEL==.-IPSHP ;LENGTH OF EACH ENTRY ON PDL + MOVE A,FREEPT ;W MUST USE SAME GC CONVENTION AS PUTREL; + CAML A,MACHI ;NAMELY, GC AFTER USING UP THE LAST BYTE. + CALL GCA1 + MOVEI A,0 ;=> INPUT FROM FILE + MOVEM B,ITTYP ;STORE BACK UPDATED POINTER + JSP B,PUSHTT ;SAVE STUFF, ADDRESS MODIFY AND RETURN + ;POP INTO THE INPUT FILE +IPOP: +IFN CREFSW,[ MOVEI A,2 ;IF CREFFING, OUTPUT POP-FILE BLOCK. + SKIPE CRFONP + PUSHJ P,CRFOUT] +IPOPL: PUSHJ P,POPTT ;COME HERE IF .INSRT'S OPEN FAILED. + SAVE C + MOVE B,ITTYP ;GET POINTER + INSIRP POP B,[IFNM2 IFNM1 A] ;POP STUFF + POP B,INFCUR +REPEAT 4,POP B,INFDEV+3-.RPCNT +IFN DECSW,[ + POP B,C + SAVE C ;OLD UTIHDR + POP B,UTIBED +] + POP B,C + MOVEM B,ITTYP ;SAVED UPDATED PDL POINTERR. + HLRZ B,(C) ;GET LENGTH OF SAVED BUFFER, +IFN ITSSW,[ + SAVE A + CALL SETWH2 + REST A + .IOPOP UTYIC, + MOVEI AA,UTIBUF-1(B) ;GET ADDR OF 1ST WD WON'T BLT INTO IN UTIBUF, + HRLI AA,(A) ;GET SAVED LH OF UTIBED, + MOVEM AA,UTIBED + HRRI A,UTIBUF ;MAKE A -> 1ST WD IN BUFFER, +] +IFN DECSW,[ + MOVE AA,UTICHN + LSH AA,27 + IOR AA,[RELEAS] + XCT AA ;THIS CODE EQUIVALENT TO .IOPOP. + SOS UTICHN + REST UTIHDR +] + MOVEM A,UREDP + MOVSI A,^C_13 + MOVEM A,@UTIBED ;PUT EOF CHAR AFTER BUFFER. + MOVSI A,1(C) ;GET ADDR OF 1ST DATA WD OF SAVED BUFFER, + HRRI A,UTIBUF + CAIE B,1 + BLT A,UTIBUF-2(B) + HLLZS (C) ;TELL GC TO RECLAIM SAVED BUFFER. +POPCJ: REST C + RET + ;SAVE INTERNAL POINTERS CONCERNING INPUT MODE + +TYPDEL==2 ;NUMBER OF WORDS IN RELEVANT PDL ENTRY + +PUSHTT: PUSH P,A + PUSH P,F + AOSN CMEOF ;IF SUPPOSED TO POP OUT OF TTY SOON, + CALL POPTT ;DO IT NOW BEFORE CMEOF CLOBBERED. + MOVE F,ITTYP ;GET RELEVANT PDL POINTER + MOVEI A,0 + EXCH A,CLNN ;SET UP NEW LINE NUMBER + HRL A,CPGN ;SAVE CURRENT PAGE NUMBER + SETZM CPGN ;NOW RE-INITIALIZE + SKIPGE CRFILE ;SAVE CREF-ALL-ON-ONE-LINE FLAG. + TLO A,400000 + PUSH F,A ;SAVE CPGN,,CLNN + MOVE A,-1(P) ;RETRIEVE NEW MODE + PUSHJ P,PSHLMB ;SAVE LIMBO1 AND SET UP INSTRUCTIONS FOR NEW MODE +IFN ITSSW,[ + CALL SETWH2 + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ;STORE BACK UPDATED POINTER + JRST POPFAJ + + ;RESTORE INTERNAL POINTERS CONCERNING INPUT MODE + +POPTT: PUSH P,A + PUSH P,F + MOVE F,ITTYP ;GET PDL POINTER + PUSHJ P,POPLMB ;POP INTO LIMBO1, SET UP NEW MODE + POP F,A ;GET CPGN,,CLNN + SETZM CRFILE ;RESTORE ALL-ON-ONE-LINE FLAG. + TLZE A,400000 + SETOM CRFILE + HLRZM A,CPGN + HRRZM A,CLNN +IFN ITSSW,[ + CALL SETWH2 + ADD A,CPGN + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ;STORE BACK UPDATED POINTER + JRST POPFAJ + +IFN ITSSW,[ +SETWH2: MOVE A,RCHMOD + CAIL A,2 + SKIPA A,[SIXBIT /TTY:/] + MOVE A,INFFN1 + .SUSET [.SWHO2,,A] + MOVE A,A.PASS + LSH A,30 + ADD A,[SIXBIT /P0/+1] + RET +] + ;TTY ROUTINES + +;CAUSE INPUT FROM TTY (MAIN ROUTINES) + +GTYIPA: ;PUSH TO TTY, DON'T STO@ AT CR. + SETZM A.TTYF +IFN ITSSW,[ TYPR [ASCIZ/TTY: .INSRTed, end input with ^C +/] ] +.ELSE [ IFE SAILSW,[ TYPR [ASCIZ/TTY: .INSRTed, end input with ^Z +/] ] + .ELSE [ TYPR [ASCIZ /TTY: .INSRTed, end input with CTL-META-LF +/] ]] +GTYIP1: SKIPA A,[3] +GTYIP: MOVEI A,2 ;INPUT FROM TTY, STOP AFTER 1 LINE. + SETZM CMPTR ;FORCE RELOAD ON 1ST READ. + JSP B,PUSHTT ;SET UP VARIABLES AND RETURN +GTYIPR: SETZM CMPTR ;RETURN ON .INEOF OR CR + JRST POPTT + +;CALL HERE FROM ASSEM1 LOOP WHEN A ^H INTERRUPT IS DETECTED. +TTYBRK: SETZM A.TTYF + ETR [ASCIZ/^H - break /] ;TYPE FILENAME, PAGE AND LINE #. + SKIPE ASMOUT + TYPR [ASCIZ/within a <>, () or [] +/] + JRST GTYIPA + + ;RCHSET ROUTINES FOR READING FROM TTY + ;RCHMOD=3 => DON'T QUIT ON CR + ;2 => QUIT ON CR. + +RCHTRC: +RCHARC: TLO FF,FLTTY ;SET FLAG + JSP A,CPOPJ +RCHAC1: REPEAT 2,[ ;RCH2, RR1 + ILDB A,CMPTR ;GET CHAR + CAIN A,0 ;END OF STRING MARKED WITH 0 + PUSHJ P,TYRLDR ;RELOAD, JUMP BACK FOR NEXT CHAR +] + HALT ;RRL1 +IFN .-RCHAC1-RCHPSN,.ERR RCHAC1 LOSES. + ILDB A,CMPTR ;SEMIC + CAIN A,15 + JRST SEMICR + JUMPN A,SEMIC + PUSHJ P,TYRLD + JRST SEMIC + TYRLD: MOVEI A,3 ;RETURN AFTER THE CALL, NOT BEFORE. + ADDM A,(P) + + ;READ IN STRING + +;RELOAD BUFFER IF RAN OUT IN CALL TO RCH. +TYRLDR: AOSN CMEOF ;EOF DETECTED AFTER LAST RELOAD => + JRST RPAEOF ;POP OUT OF TTY. + SAVE A + SAVE B + MOVE B,RCHMOD + PUSH P,F + SAVE A.TTYF ;IF CHARS RUBBED OUT THEY SHOULD BE PRINTED. + SETZM A.TTYF + MOVE F,[10700,,CMBUF-1] ;INITIAL BYTE POINTER TO BUFFER + MOVEM F,CMPTR ;STORE AS BYTE POINTER FOR READ +TYRLD2: PUSHJ P,TYI ;GET CHARACTER + CAIN A,177 ;RUBOUT? + JRST TYRLD3 ;YES + CAIE A,^C + CAIN A,^Z + JRST TYRLD7 ;^C, ^Z => EOF. + CAIN A,^U + JRST TYRLD5 ;RUB OUT ALL + CAIE B,2 ;FOR .TTYMAC HANDLING, CONVERT LOWER CASE TO UPPER. + JRST TYRLD6 + CAIL A,"A+40 + CAILE A,"Z+40 + CAIA + SUBI A,40 +TYRLD6: CAME F,[010700,,CMBUF+CMBFL-2] + IDPB A,F ;STORE CHARACTER IN BUFFER UNLESS BUFFER NEARLY FULL. + CAIE A,^M ;CR? + JRST TYRLD2 ;NO, GO BACK FOR NEXT + CAIN B,2 ;.TTYMAC (MODE 2) => CR ENDS INPUT, SO FAKE EOF. + SETOM CMEOF + MOVEI A,^J ;FOLLOW THE CR WITH A LF. + IDPB A,F + SAVE F ;OUTPUT THE ENTIRE LINE TO THE ERROR FILE + MOVE F,[10700,,CMBUF-1] +TYRLD8: CAMN F,(P) + JRST TYRLD9 + ILDB A,F + CAIN A,^M ;IF LINE WAS ENDED BY A ^C OR ^Z, PUT THAT IN ERROR + SKIPL CMEOF ;FILE, WHICH NEEDS HAIR SINCE THAT CHAR IS NOT + JRST TYRLD0 ;IN THE STRING WE STORED. + MOVEI A,"^ + CALL ERRCHR + MOVEI A,IFN DECSW,["Z] .ELSE "C + CALL ERRCHR + LDB A,F +TYRLD0: CALL ERRCHR + JRST TYRLD8 + +TYRLD9: REST F + MOVEI A,0 + IDPB A,F ;MARK END OF STRING + IDPB A,F + REST A.TTYF + REST F + REST B + REST A + JRST RCHTRA + +TYRLD7: SETOM CMEOF ;^C, ^Z FORCE EOF, + CALL TYRLCR ;AFTER TURNING INTO ^M. + MOVEI A,^M + JRST TYRLD6 + +TYRLCR: MOVEI A,^M + CALL TYOX + MOVEI A,^J + JRST TYOX + +TYRLD3: CAMN F,[10700,,CMBUF-1] ;RUBOUT, BEGINNING OF BUFFER? + JRST TYRLD4 ;YES + LDB A,F ;GET LAST CHARACTER IN BUFFER + CALL TYOX ;TYPE IT OUT, DON'T WRITE IN ERROR FILE. + ADD F,[70000,,] ;DECREMENT POINTER + JUMPGE F,TYRLD2 ;JUMP IF VALID + SUB F,[430000,,1] ;WAS 440700,,SOMETHING, BACK IT UP + JRST TYRLD2 + +TYRLD5: MOVE F,[10700,,CMBUF-1] ;^U, BACK TO BEGINNING OF LINE +TYRLD4: PUSHJ P,TYRLCR ;RUBOUT WHEN AT BEGINNING OF BUFFER, TYPE CR + JRST TYRLD2 + IFN ITSSW,[ ;GET (JUST TYPED IN) CHAR IN A + +TYI: SKIPN TTYOP + CALL TTYINI ;OPEN THE TTY IF NOT ALREADY DONE. + .IOT TYIC,A + ANDI A,-1 ;NON-TTY DEVICES CAN RETURN -1,,3. + JUMPE A,TYI + CAIN A,^L + JRST TYI + POPJ P, + + ;INITIALIZE TTY + +TTYINI: SAVE A + .OPEN TYIC,[SIXBIT / TTYMIDAS TYI/] ;INPUT, CONVERT LOWER CASE TO UPPER + .LOSE + .OPEN TYOC,[21,,SIXBIT / TTYMIDAS TYO/] ;DISPLAY MODE OUTPUT + .LOSE + SYSCAL CNSGET,[1000,,TYOC ? 2000,,A ? 2000,,A] + MOVSI A,1 ;TTY: IS TRANSLATED TO SOMETHING ELSE => ASSUME INFINITE LINEL + MOVEM A,LINEL ;ELSE LINEL GETS WIDTH OF TTY. + SETOM TTYOP ;SAY THE TTY IS NOW OPEN. + JRST POPAJ + +JCLINI: .SUSET [.ROPTIO,,A] + TLNN A,40000 ;HAS OUR SUPERIOR SAID IT HAS A CMD? + RET ;NO. + MOVE A,[CMBUF,,CMBUF+1] + BLT A,CMBUF+CMBFL-2 ;ZERO ALL BUT LAST WD, + MOVEM A,CMBUF+CMBFL-1 ;NONZERO LAST WD. + .BREAK 12,[5,,CMBUF] ;TRY TO READ COMMAND STRING. + MOVE A,[440700,,CMBUF] + SKIPE CMBUF ;IF READ A CMD-STRING, + MOVEM A,CMPTR ;TELL TYRLD, GO2 IT'S THERE. + POPJ P, + +;JRST HERE FROM TSINT FOR 2ND WD INTERRUPTS. +TTYINT: SAVE A + MOVEI A,TYIC ;THE TTY CHNL IS THE ONLY ONE ENABLED. + .ITYIC A, + JRST TTYINX ;NO INT. CHAR. + CAIN A,^W + AOS A,TTYFLG ;^W SILENCES, + CAIN A,^V + SOS A,TTYFLG ;^V UNSILENCES, + CAIN A,^H + SETOM TTYBRF ;^H SAYS BREAK NEXT TIME THRU ASSEM1 LOOP. +TTYINX: REST A + .DISMIS .JBTPC +] ;END IFN ITSSW + IFN TNXSW,[ ;GET (JUST TYPED IN) CHAR IN A + +TYI: SKIPN TTYOP + CALL TTYINI ;OPEN THE TTY IF NOT ALREADY DONE. + PUSH P,1 + PBIN + MOVE A,1 + POP P,1 + JUMPE A,TYI + CAIN A,^M ;TWENEX RETURNS ^M^J + JRST [ PUSH P,1 + PBIN + POP P,1 + POPJ P,] + CAIN A,^_ ;TENEX RETURNS EOL ON CR + MOVEI A,^M + POPJ P, + + ;INITIALIZE TTY + +TTYINI: SYSCAL RFMOD,[1000,,101],[A ? A] + HLRZS A + ANDI A,177 ;TERMINAL WIDTH + CAIGE A,30. ;IF TOO LOW, + ADDI A,128. ;ASSUME TWENEX CROCKISHNESS + MOVEM A,LINEL ;LINEL GETS WIDTH OF TTY. + SETOM TTYOP ;SAY THE TTY IS NOW OPEN. + POPJ P, + +] ;END IFN TNXSW + IFN DECSW,[ + +TYI: SKIPN TTYOP ;OPEN THE TTY, IF NOT ALREADY DONE. + CALL TTYINI + INCHWL A +IFN SAILSW,[ + CAIN A,612 ;SAIL => EOF IS 612. SO TURN INTO NORMAL EOF. + MOVEI A,^Z +] + CAIE A,^M ;THROW AWAY THE LF AFTER A CR + RET + INCHWL A + MOVEI A,^M ;NOTE THAT TYRLDR WILL PUT IT BACK IN. + RET + +TTYINI: INSIRP PUSH P,AA A B +IFE SAILSW,[ + PJOB A, + TRMNO. A, + JRST TTYIN1 + MOVEI AA,1012 ;.TOWID + MOVE B,[2,,AA] + TRMOP. B, ;READ WIDTH OF TTY LINE INTO B. +] +TTYIN1: MOVEI B,80. ;TRMOP. FAILED OR NOT TRIED => ASSUME WIDTH IS 80. + MOVEM B,LINEL + INSIRP POP P,B A AA + SETOM TTYOP + RET + +TTYREN: LOC .JBREN ? TTYREN ? LOC TTYREN + SETOM TTYBRF ;"REENTER" COMMAND COMES HERE +R: G: JRST @.JBOPC ;TO REQUEST A ^H-BREAK. +];IFN DECSW + +TAB: MOVEI A,^I +TYO: SKIPG A.TTYF + CALL TYOX +ERRCHR: IFN ERRSW,[ + SKIPN ERRFOP ;OUTPUT CHAR IN A TO ERROR FILE IF ONE IS OPEN. + RET + SOSGE ERRCTR + JRST ERRCH1 ;OUTPUT BUFFER. + IDPB A,ERRPNT + RET + +ERRCH1: SAVE C + MOVE C,[0 ERRFC,ERRHDR] + CALL OBUFO + REST C + JRST ERRCHR +]IFE ERRSW,RET + +TYOX: SKIPN TTYOP + CALL TTYINI +IFN ITSSW,.IOT TYOC,A +IFN DECSW,OUTCHR A +IFN TNXSW,[ + PUSH P,1 + MOVE 1,A + PSOUT + POP P,1 +];IFN TNXSW + RET + IFN DECSW,[ + +; READ MID TEMP CORE FILE, IF THAT LOSES, TRY nnnMID.TMP FILE. CLOBBERS +; A,B,C,D. + +JCLINI: SKIPN CCLFLG ; WAS MIDAS CALLED FROM CCL LEVEL? + RET ; NO, DO NOT SNARF TEMPCORE + SETZM CCLFIL ; NO CCL FILE YET + SETZM CCLFLG ; IF TMPCOR LOSES WANT THIS 0 (WILL RE-SETOM BELOW) + SETZM CMBUF ; ZERO FIRST COMMAND WORD + MOVE A,[CMBUF,,CMBUF+1] ; LOAD BLT POINTER + BLT A,CMBUF+CMBFL-2 ; ZERO ALL BUT LAST WORD + MOVEM A,CMBUF+CMBFL-1 ; NON-ZERO LAST WORD + MOVE A,[2,,['MID,, ? -CMBFL,,CMBUF-1]] + TMPCOR A, ; READ COMPIL-GENERATED COMMAND + JRST [ OPEN [17 ? 'DSK,, ? 0]; NO TEMPCORE, MAYBE TRY DUMP MODE + RET ; ARGH BUT LET SOMETHING ELSE DIE + PJOB A, ; GET JOB # + IDIVI A,100. ; WANT DECIMAL JOB NUMBER IN SIXBIT + ADDI A,'0 + LSH A,6 + IDIVI B,10. + ADDI A,'0(B) + LSH A,6 + ADDI A,'0(C) + LSH A,18. + HRRI A,'MID ; FORM FILE NAME AS nnnMID.TMP + MOVEM A,CCLFIL ; SAVE FOR WRITING BELOW + MOVSI B,'TMP + SETZB C,D ; NO PROTECT OR PPN TRASH + LOOKUP A ; TRY TO GET FILE + RET ; GIVE UP + MOVE A,[-CMBFL,,CMBUF-1] + SETZ B, + INPUT A ; TRY TO READ COMMAND + SETZB A,B + RENAME A ; TRY TO DELETE IT NOW + JFCL ; IGNORE FAILURE + CLOSE ; HAPPY SAIL + JRST .+1] + SKIPN CMBUF ; ONE LAST CHECK FOR IT TO BE THERE + RET ; ALAS, THERE IS NONE + MOVE A,[440700,,CMBUF] ; LOAD A BYTE POINTER TO THE COMMAND + SETOM CCLFLG + MOVEM A,CMPTR ; THERE IS, SET COMMAND POINTER +JCLIN1: ILDB B,A + CAIE B,^J ;SEE IF OUR COMMAND FILE HAS ANYTHING AFTER 1ST LINE. + JRST JCLIN1 + ILDB B,A + JUMPE B,JCLIN3 + SETOM MORJCL ;IT DOES; SET FLAG SO AFTER HANDLING 1ST LINE WE'LL + MOVE C,[440700,,UTIBUF+2] +JCLIN2: IDPB B,C + ILDB B,A + JUMPN B,JCLIN2 + SUBI C,UTIBUF+1 ;GET # WORDS WRITTEN IN UTIBUF. OPERAND IS RELOCATABLE! + HRLOI C,-1(C) ;THESE 2 INSNS TURN SIZE INTO -SIZE,,UTIBUF+1 + EQVI C,UTIBUF+1 + MOVEM C,UTIBUF+1 + SKIPE A,CCLFIL ; WAS THIS CALLED WITH A TEMP FILE? + JRST [ MOVSI B,'TMP + SETZB C,D + ENTER A ; TRY TO RE-WRITE FILE + RET ; SIGH + MOVE A,UTIBUF+1 + SETZ B, + OUTPUT A + RELEASE + RET] + MOVSI C,'MID + MOVEM C,UTIBUF + MOVE C,[3,,UTIBUF] + TMPCOR C, +TMPWRT: JRST [ OPEN [17 ? 'DSK,, ? 0]; NO TEMPCORE, MAYBE TRY DUMP MODE + RET ; ARGH BUT LET SOMETHING ELSE DIE + PJOB A, ; GET JOB # + IDIVI A,100. ; WANT DECIMAL JOB NUMBER IN SIXBIT + ADDI A,'0 + LSH A,6 + IDIVI B,10. + ADDI A,'0(B) + LSH A,6 + ADDI A,'0(C) + LSH A,18. + HRRI A,'MID ; FORM FILE NAME AS nnnMID.TMP + MOVEM A,CCLFIL ; SAVE FOR WRITING BELOW + JRST TMPWRT] ; TMPCORE READ BUT NOT WRITE! TWENEX DOES THIS +JCLIN3: RET +];END IFN DECSW + ;TS DATA STORAGE + +VBLK + +TYPDLS==TYPDLC*TYPDEL+INPDEL*MX.INS + ;"TTY PDL", STORES INFORMATION ABOUT CURRENT INPUT MODE + ;(SIMILAR TO MACRO PDL BUT NOT GARBAGE COLLECTED) + +ITTYP: -TYPDLS-1,,TTYPDL ;PDL POINTER (TYPDEL=LENGTH OF EACH ENTRY) +TTYPDL: NEDCHK ;ACTUAL PDL: INITIAL ENTRY TO OVERPOP ROUTINE + BLOCK TYPDLS ;PDL PROPER + + ;INPUT BUFFER AND VARIABLES + +IFN TNXSW,UTIJFN: 0 ;JFN OF FILE BEING READ NOW +UTIBUF: BLOCK UTIBFL +UTIHDR: 0 ;INPUT BUFFER HEADER (DEC VERSION) +UREDP: 440700,,UTIBUF ;INPUT BYTE POINTER +UTICNT: 0 ;INPUT BYTE COUNT (DEC VERSION) +UTIBED: UTIBUF ;EOF COMPARISON WITH RH(UREDP), 4.9 => EOF ON .IOT +IFSTS: 0 ;.STATUS WORD STORED BY OPNRD1 WHEN .OPEN LOSES +IFN DECSW,UTICHN: UTYIC + + ;FILE DESCRIPTION STORAGE + +INDDP: MAXIND,,FDSOFS ;POINTER INTO TABLE +FDSBEG==. ;BEGINNING OF TABLE AREA +DNAM: 0 ;DEVICE NAME +FNAM1: 0 ;FILE NAME 1 +FNAM2: 0 ;" " 2 +SNAM: 0 ;SYSTEM NAME +LFDSE==.-FDSBEG ;LENGTH OF TABLE ENTRY +IFDS: BLOCK LFDSE ;SPECIFIED INPUT FILE + 0 ;FOR .FDELE AT .FILE TIME +ONAM: BLOCK 3 ;OUTPUT DEVICE/FILENAMES SPECIFIED +OFNM1==ONAM+1 +OFNM2==ONAM+2 +OSYSNM: -1 ;SPECIFIED OUTPUT SYSTEM NAME +IFN CREFSW,[ 0 +CRFDEV: BLOCK 3 ;CREF DEV, FN1, FN2. +CRFSNM: 0 ;CREF SNAME. +] +IFN ERRSW,ERRDEV: BLOCK 4 ;ERROR OUTPUT FILE NAMES. +IFN LISTSW,[ +LSTDEV: BLOCK 3 ;LISTING FILE NAMES. +LSTSNM: 0 +] +FNMEND:: +INFDEV: 0 +INFFN1: BLOCK 3 ;FILENAMES OF INPUT FILE BEING READ NOW. +INFCNT: 0 ;# INPUT FILE OPENED. +INFCUR: 0 ;WHAT INFCNT WAS WHEN CURRENT FILE OPENED. +INFERR: 0 ;WHAT INFCUR HELD AT LAST ERROR MSG. +FDSOFS==.-FDSBEG ;OFFSET TO BEGINNING OF NON-DEDICATED AREA + BLOCK LFDSE*MAXIND ;OPEN NAMES @: FILES (AND FNF'S) +SFSFDS=.-FDSOFS ;SOURCE SPECIFIED NAMES @: FILES + BLOCK LFDSE*MAXIND ;STORAGE FOR " + +RFNAM1: 0 ;.FNAM1 +RFNAM2: 0 +IFNM1: 0 ;.IFNM1 +IFNM2: 0 +RSYSNM: 0 ;INITIAL SYSTEM NAME + +IFN CMUSW, PPNBUF: BLOCK 4 ;FOR CONVERTING CMU PPNs + +IFN DECSW,IFE SAILSW, V.SITE: BLOCK 5 ;SYSTEM NAME IN SIXBIT, FOR .SITE. +IFN TNXSW,V.SITE: BLOCK 5 ;SYSTEM NAME IN SIXBIT FOR .SITE + ;TTY VARIABLES + +CMBUF: BLOCK CMBFL ;TYPEIN BUFFER +CMPTR: 0 ;BYTE POINTER TO CMBUF, CLEARED AT GO2 IF >0. +CMEOF: 0 ;-1 => POPTT INSTEAD RELOAD AFTER THIS BUFFERFULL. +IFN DECSW\TNXSW,MORJCL: 0 ;-1 => THERE ARE MORE LINES OF CCL COMMANDS + ;SO DO A RUN SYS:MIDAS WHEN FINISHED. +TTYOP: 0 ;-1 => THE TTY IS ALREADY OPEN. +LINEL: 0 ;WIDTH OF TTY (MAY BE 1,, MEANING ASSUME INFINITE). +A.TTYFLG: ;VALUE OF .TTYFLG: +TTYFLG: 0 ;TTY TYPEOUT PERMITTED IFF >= 0. +WSWCNT: 0 ;THE NUMBER OF W-SWITCHES IN THE LAST CMD STRING. +TTYBRF: 0 ;-1 => ^H BREAK HAS BEEN REQUESTED BUT NOT DONE. +FATAL: 0 ;AT END OF ASSEMBLY, NOT 0 IFF FATAL ERROR OCCURRED. +NEDCRL: 0 ;-1 => HAVEN'T YET SUPPLIED A CRLF AT EOF OF MAIN FILE. +NVRRUN: -1 ;0 => MIDAS WAS RUN; ERROR TO START OR PURIFY. + + ;OPNER VARIABLES + +ERRDNM: (SIXBIT /ERR/) + 3 +ERRNM2: 0 ;.STATUS WORD + +IFN ITSSW,OCLOSP: @1(C) ;TURNED INTO BP TO UNUSED PART OF LAST BFFER WD USED. + + ;OUTPUT VARIABLES + +UTOBUF: BLOCK UTOBFL ;OUTPUT BUFFER +UTOHDR: UTOBFL,,UTOBUF-1 +UTYOP: 444400,, ;OUTPUT (36. BIT) BYTE POINTER +UTYOCT: 0 ;# WORDS LEFT IN UTOBUF + +IFN CREFSW,[ ;CREF OUTPUT VARS. +CRFBUF: BLOCK CRFBSZ +CRFHDR: CRFBSZ,,CRFBUF-1 ;HEADER, ASSEMBLED VALUE USED ONLY IFN ITSSW +CRFPTR: 444400,, ;BP FOR FILLING BUFFER +CRFCNT: 0 ;NUM. CHARS. EMPTY IN BUFFER +] + +IFN LISTSW,[ +LSTBUF: BLOCK LSTBSZ +LSTHDR: 5*LSTBSZ,,LSTBUF-1 +LSTPTR: 440700,, +LSTCNT: 0 +] + +IFN ERRSW,[ +ERRBUF: BLOCK ERRBSZ +ERRHDR: 5*ERRBSZ,,ERRBUF-1 +ERRPNT: 440700,, +ERRCTR: 0 +ERRFP: 0 ;NON-0 IF WANT ERROR OUTPUT FILE. +ERRFOP: 0 ;NON-0 IF ERROR FILE OPEN (IE TRY OUTPUTTING TO IT) +] +PBLK + ;.INSRT FILEDESCRIPTION +;INSERT FILE HERE +;TTY: => OK, READS LINE AT A TIME, RUBOUT ALLOWED WITHIN LINE +;PUSHES MACRO EXPANSION, OTHER .INSRT'S +;IN FILEDESCRIPTION, ^R => RESET FILE NAME COUNTER + +A.INSR: NOVAL + MOVEI F,IFDS-DNAM ;SET UP POINTER TO INPUT FILE NAMES + PUSHJ P,A.IMAP ;DEFAULT NAMES = INPUT NAMES + MOVSI A,(SIXBIT /DSK/) + MOVS B,DNAM + CAIN B,(SIXBIT /TTY/) ;IF INPUTTING FROM TTY, + MOVEM A,DNAM ;THEN SET DEFAULT DEVICE TO DSK INSTEAD +IFN ITSSW,MOVSI A,(SIXBIT/>/) +IFE ITSSW,MOVSI A,'MID + MOVEM A,FNAM2 ;USE > AS THE DEFAULT FN2. + TLO FF,FLUNRD +A.IN1: PUSHJ P,RFD ;READ FILE DESCRIPTION + MOVS A,DNAM ;GET SPECIFIED DEVICE NAME + CAIE A,(SIXBIT /@/) ;ATSIGN? + PUSHJ P,A.ITRY ;NO, TRY OPENING FILE + MOVE A,DNAM(F) + AOJE A,A.INT1 ;ALREADY TRYING TO SET UP TABLE ENTRY + SKIPA F,[MAXIND,,FDSOFS] ;ATSIGN, OR FNF, SEARCH TABLE +A.IN2: SUBI F,-LFDSE ;LOOP POINT SEARCHING TABLE, INCREMENT TO NEXT ENTRY, COUNT DOWN LH + CAMN F,INDDP ;COMPARE WITH POINTER TO TOP OF TABLE + JRST A.IN3 ;AGREE => THIS FILE NOT IN TABLE + MOVE A,F ;-> SFSFDS + MOVSI B,-LFDSE ;-> DNAM, LH FOR COUNT + MOVE T,SFSFDS(A) ;GET SPECIFICATION NAME THIS ENTRY + CAMN T,DNAM(B) ;COMPARE WITH THAT JUST SPECIFIED + AOBJN B,[AOJA A,.-2] ;CHECK ALL NAMES THIS ENTRY + JUMPL B,A.IN2 ;LOOP IF NAMES DON'T ALL AGREE + ;FILE IS IN TABLE + PUSHJ P,A.IMAP ;SET NEW FILE DESCRIPTION FROM THAT IN TABLE ENTRY + PUSHJ P,A.ITRY ;TRY OPENING FILE + MOVSI A,SFSFDS(F) ;SET UP LH(BLT POINTER), + PUSHJ P,A.IMP1 ;UNMAP TO ORIGINAL NAMES + PUSHJ P,TYPFIL ;TYPE OUT SPECIFIED NAMES + TYPR [ASCIZ / -> /] ;TYPE OUT POINTER + PUSHJ P,A.IMAP ;RE-MAP INTO TRANSLATION ENTRY IN TABLE + SETOM DNAM(F) ;"HALF-KILL" ENTRY +A.INT1: PUSHJ P,IOPNR1 ;TYPE OUT ALL KINDS OF STUFF +A.INT2: PUSHJ P,GTYIP ;PREPARE TO READ ONE LINE FROM TTY + JRST A.IN1 ;TRY AGAIN WITH WHAT HE TYPES IN + + ;FILE NOT IN TABLE + +A.IN3: TLNN F,-1 ;MORE ROOM FOR ANOTHER ENTRY IN TABLE? + ETF [ASCIZ /Too many @: files/] + MOVEI A,SFSFDS(F) + HRLI A,DNAM + BLT A,SFSFDS+LFDSE-1(F) ;SET UP KEY OF NEW ENTRY + SETOM DNAM(F) ;DOCUMENT FACT THAT ENTRY HAS ONLY KEY, NOT TRANSLATION + MOVNI A,-LFDSE + ADDM A,INDDP ;UPDATE POINTER INTO TABLE + MOVS A,DNAM ;GET SPECIFIED DEVICE NAME + CAIE A,(SIXBIT /@/) ;ATSIGN? + JRST A.INT1 ;NO, TYPE OUT GARBAGE AND TRY AGAIN, READING FROM TTY + MOVE A,IFDS ;YES, CLOBBER FROM INPUT DEVICE NAME + MOVEM A,DNAM + JRST A.INT2 + ;TRY OPENING INPUT FILE FOR .INSRT, RETURN IF UNSUCCESSFUL + +A.ITRY: MOVS A,DNAM ;GET SPECIFIED DEVICE NAME + CAIN A,(SIXBIT /TTY/) ;TTY? + JRST A.ITRT ;YES, TREAT SPECIAL + TLO FF,FLUNRD + PUSHJ P,IPUSH ;SAVE CURRENT STATUS + PUSHJ P,OPNRD1 ;TRY OPENING FILE + JRST IPOPL ;LOSE, POP AND RETURN +IFN ITSSW,CALL SETWH2 + MOVE B,ITTYP + MOVEI A,-1-TYPDEL(B) + HRLI A,IFNM1 + BLT A,-TYPDEL(B) ;INTRODUCE HYSTERESIS SO .INSRT'ING FILE CAN REFERENCE .IFNM1, .IFNM2 +IFN CREFSW,[ + SKIPE CRFONP ;IF CREFFING, OUTPUT PUSH-FILE BLOCK. + PUSHJ P,CRFPSH ;(POP-FILE BLOCK OUTPUT AT IPOP) +] +A.ITR2: + MOVE A,DNAM(F) ;PUSH SUCCESSFUL, NOW CHECK TO SEE IF TABLE ENTRY SHOULD BE FINISHED + AOJN A,ASSEM1 + PUSHJ P,A.OMAP ;YES, DO IT + JRST ASSEM1 ;NOW ASSEMBLE FROM FILE (ASSEM1 CLOBBERS PDL) + + ;.INSRT TTY: + +A.ITRT: PUSHJ P,GTYIPA ;READ FROM TTY, DON'T QUIT UNTIL .INEOF + JRST A.ITR2 ;FALL BACK IN (DOESN'T TOUCH .IFNM1, .IFNM2) + + ;.INEOF ;EOF PSEUDO (MAINLY USEFUL FROM TTY) + +A.IEF2: PUSHJ P,PMACP ;LOOP POINT, POP ENTRY OFF MACRO PDL +A.INEO: TLNE FF,FLMAC ;INPUTTING FROM MACRO? + JRST A.IEF2 ;YES, POP IT OFF + PUSH P,CMACCR ;BACK TO INPUTTING FROM FILE OR TTY, CAUSE RETURN TO MACCR + MOVE B,ITTYP ;GET PDL POINTER + POPJ B, ;RETURN TO POP ROUTINE + + ;MISC .INSRT + +A.IMAP: MOVSI A,DNAM(F) ;CLOBBER DNAM ETC. FROM TABLE TRANSLATION ENTRY POINTED TO BY F +A.IMP1: HRRI A,DNAM ;ENTRY FOR LH(BLT POINTER) ALREADY SET UP + BLT A,DNAM+LFDSE-1 ;DO IT + POPJ P, + +A.OMAP: MOVEI A,DNAM(F) ;CLOBBER TRANSLATION OF TABLE ENTRY POINTED TO BY F FROM DNAM ETC. + HRLI A,DNAM + BLT A,DNAM+LFDSE-1(F) + POPJ P, + +;CALL FROM ERRH; TYPE INPUT FILE'S NAMES IF CHANGED SINCE LAST ERR MSG. +ERRTFL: MOVE C,INFCUR + EXCH C,INFERR ;SAY LAST ERROR MSG IN THIS FILE. + CAMN C,INFERR ;IF PREV. MSG WAS IN OTHER FILE, + POPJ P, + MOVE C,[-3-ITSSW,,INFDEV-DNAM] + PUSHJ P,TYPF1 ;TYPE THIS FILE'S NAMES. + JRST CRRERR + ;MISC TS + +IOPNR1: PUSHJ P,IOPNER ;TYPE OUT CRUFT + TYPR OINITS + RET + + ;TYPE OUT DNAM ETC. AS FILE SPECIFICATION + +TYPFIL: MOVSI C,-3-ITSSW +TYPF1: MOVE B,DNAM(C) ;GET NEXT NAME + PUSHJ P,SIXTYO ;TYPE OUT NAME + HLRZ A,C + MOVE A,FILSPC+3+ITSSW(A) ;NOW GET DELIMITING CHARACTER + PUSHJ P,TYOERR ;TYPE OUT + AOBJN C,TYPF1 ;LOOP FOR ALL NAMES +IFN ITSSW, POPJ P, +.ELSE,[ SKIPN B,DNAM(C) ;ON DEC SYSTEM PPN IS A SPECIAL CASE + POPJ P, + MOVEI A,"[ ;] + CALL TYOERR +IFN CMUSW,[ + MOVE A,[B,,PPNBUF] + DECCMU A, + JRST OCTPPN + MOVEI B,PPNBUF + PUSHJ P,TYPR3 + JRST PPNRB +];IFN CMUSW +IFE SAILSW,[ +OCTPPN: HLRZ B,DNAM(C) ;LH IS PROJ, + CALL OCTPNT +] +.ELSE [ HLLZ B,DNAM(C) + CALL SIXTYO +] + MOVEI A,", + CALL TYOERR +IFE SAILSW,[ + HRRZ B,DNAM(C) + CALL OCTPNT ;RH IS PROG. +] +.ELSE [ HRLZ B,DNAM(C) + CALL SIXTYO +] +PPNRB: ;[ + MOVEI A,"] + JRST TYOERR +];IFN DECSW + +FILSPC: ": +IFN ITSSW, 40 ? 40 ? "; +IFN DECSW, ". ? 0 + + ;OPENLOSS DOCUMENTATION ROUTINE +IOPNER: MOVE A,IFSTS ;INPUT +OPNER: MOVEM A,ERRNM2 ;SAVE .STATUS WORD + PUSHJ P,TYPFIL ;TYPE OUT FILE DESCRIPTION + PUSHJ P,CRRERR ;NOW CRLF TO ENSURE ROOM FOR FOLLOWING +IFE ITSSW,[ + TYPR [ASCIZ/OPEN failed/] + JRST CRRERR +] +IFN ITSSW,[ + .OPEN ERRC,ERRDNM ;NOW GET THE SYSTEM TO SAY WHAT'S WRONG + .VALUE ;CAN'T OPEN ERR DEVICE? +IOPNR2: .IOT ERRC,A ;GET CHARACTER FROM SYSTEM + CAIN A,14 ;ENDS WITH FORM FEED + POPJ P, + PUSHJ P,TYOERR ;TYPE OUT CHARACTER + JRST IOPNR2 ;LOOP BACK FOR NEXT +] ;END IFN ITSSW + ;READ SINGLE FILE DESCRIPTION INTO DNAM ... SNAM . +;FRNNUL 1 IFF SPEC WAS NONNULL. +;FRMRGO 1 IFF "." WAS SEEN IN DEC VERSION - FORCE NULL FN2. +;FRCMND 1 IFF SHOULD RECOGNIZE -, COMMA, / AND ( AS SPECIAL CHARACTERS. +RFD: TRZ FF,FRNNUL+FRMRGO +RFD8: SETZ D, ;D COUNTS FILENAMES. 0 BEFORE 1ST. +RFD1: MOVEI C,0 ;INITIALIZE SIXBIT NAME. + MOVE B,[440600,,C] ;SET UP BP FOR INPUT +RFD2: PUSHJ P,RCH ;GET CHARACTER IN A + CAIN A,": ;IF COLON... + JRST RFDCOL ;THEN PROCESS AS SUCH + CAIN A,"; ;SIMILARLY FOR SEMICOLON + JRST RFDSEM + CAIN A,^Q ;IF CONTROL Q... + JRST RFDCQ ;THEN GET NEXT CHARACTER AND TREAT AS NON-SYNTACTICAL + TRNN FF,FRCMND ;IF READING COMMAND, _, COMMA, / AND ( ARE SPECIAL. + JRST RFD3 + CAIN A,"( + JRST CMDSW ;READ SWITCHES. + CAIN A,"/ + JRST CMDSL ;READ 1 SWITCH +IFN SAILSW\ITSSW,[ + CAIN A," ;UNDERSCORE AT SAIL, BACKARROW ON ITS, + JRST RFD6 ;EITHER WAY, YOU CAN DO BOTH ON BOTH! +] +IFN DECSW\TNXSW,[ + CAIN A,"! ; FOO! MEANS RUN SYS:FOO WITH OFFSET 1. ! ENDS THE FILESPEC. + JRST RFD6 +] +IFE ITSSW,CAIN A,"= +.ALSO JRST RFD6 ;ON DEC SYS, "=" = "_" + CAIE A,", + CAIN A,"_ + JRST RFD6 ;COMMA AND _ END SPEC. +RFD3: +IFN DECSW,[ + CAIE A,"[ ;] + CAIN A,". ;. LIK SPACE ON DEC SYS. + JRST RFD6] + CAILE A,40 ;LOGICAL SPACE? (INCLUDING CR) + JRST RFDC ;NO +RFD6: TRZN FF,FRMRGO ;EXCEPT AFTER ".", + JUMPE C,RFD5 ;IGNORE NULL FILENAMES + XCT RFDTAB(D) ;STORE THE NAME (MAY SKIP) + ADDI D,1 ;NEXT NAME PUT ELSEWHERE +IFN DECSW,[ + CAIN A,". + IORI FF,FRMRGO +] + TRO FF,FRNNUL ;SPEC NOT NULL. +RFD5: IFN DECSW,[CAIN A,"[ ;] READ PPN FOR DEC SYS. + JRST RFD7] + CAIN A,^R ;CONTROL R, + JRST RFD8 ;RESETS FILENAME COUNT +IFE ITSSW,[ + CAIN A,"= ;ON DEC SYS, "=" = "_". + MOVEI A,"_ +] +IFN ITSSW\SAILSW,[ + CAIN A," ;THIS ALLOWS SAIL AND ITS TV USERS + MOVEI A,"_ ;TO BE ABLE TO USE EITHER BACKARROW OR UNDERSCORE +] +IFN DECSW,CAIE A,"! + CAIN A,", + RET + CAIE A,"_ ;RETURN IF SPEC TERMINATOR, + CAIN A,^M + RET + JRST RFD1 ;ELSE NEXT NAME. + +RFDCQ: PUSHJ P,RCH ;CONTROL Q EATS UP THE NEXT CHARACTER + CAIN A,^M + JRST RFD6 ;BUT NOT IF CR +RFDC: CAIL A,140 ;CONVERT LOWER CASE TO UPPER. + SUBI A,40 + SUBI A,40 ;CONVERT CHARACTER TO SIXBIT + TLNE B,770000 ;TOO MANY CHARACTERS? + IDPB A,B ;NO + JRST RFD2 ;LOOP + +RFDTAB: MOVEM C,FNAM1 ;1ST NAME. + MOVEM C,FNAM2 ;2ND NAME. + MOVEM C,DNAM ;3RD NAME IS DEV. + MOVEM C,SNAM ;4TH IS SNAME. + CAIA ;5TH AND ON IGNORED, DON'T INCR. D. + RFDCOL: TRO FF,FRNNUL + JUMPE C,RFD1 ;IF HE WANTS THE NULL DEVICE HE GETS TO TYPE IT IN + MOVEM C,DNAM ;MOVE TO RH OF DEVICE LOCATION + JRST RFD1 ;LOOP + +IFN DECSW,[ +RFD7: PUSHJ P,RFDPPN ;READ PPN, USE AS "SNAME". +] +RFDSEM: TRO FF,FRNNUL + JUMPE C,RFD1 ;NO NULL SYSTEM NAMES PLEASE + MOVEM C,SNAM ;MOVE TO SYSTEM NAME LOCATION + JRST RFD1 ;LOOP + +IFN DECSW,[ +RFDPPN: PUSHJ P,RFDOCT ;READ PROJECT NUM, +IFN CMUSW, JUMPE C,RCMUPP ;AT CMU WATCH FOR OUR FUNNY PPNs + HRLM C,(P) + PUSHJ P,RFDOCT ;READ PROGRAMMER NUM. + HLL C,(P) + POPJ P, + +IFE SAILSW,RFDOCL=="0 ? RFDOCH=="8 ;READ OCTAL NUMBERS. +.ELSE RFDOCL==40 ? RFDOCH==140 ;READ SIXBIT (RIGHT-JUSTIFIED). + +RFDOCT: SETZ C, ;READ OCTAL NUM, RETURN IN C. +RFDOC1: PUSHJ P,RCH + CAIL A,140 + SUBI A,40 +IFN SAILSW,[ ;[ ;EVEN IF READING SIXBIT NAMES (FOR SAIL), + CAIE A,", ;COMMA AND CLOSEBRACKET ARE STILL SPECIAL. + CAIN A,"] + POPJ P, +] + CAIL A,RFDOCL + CAIL A,RFDOCH + POPJ P, ;NOT OCTAL OR NOT 6BIT, RETURN. + IMULI C,RFDOCH-RFDOCL + ADDI C,-RFDOCL(A) + JRST RFDOC1 + +IFN CMUSW,[ ;[ +RCMUPP: CAIN A,"] ;WATCH OUT FOR [] + POPJ P, +REPEAT 4, SETZM PPNBUF+.RPCNT + MOVE C,[440700,,PPNBUF] +RCMUPL: CAIE A,^M ;Don't look too far + SKIPE PPNBUF+3 + JRST RCMUPD + IDPB A,C + PUSHJ P,RCH ;[ + CAIE A,"] + JRST RCMUPL +RCMUPD: MOVE A,[C,,PPNBUF] + CMUDEC A, + SETZ C, + POPJ P, +];IFN CMUSW +];IFN DECSW + IFN DECSW\TNXSW,[ + +;PROCESS "FOO!", WHICH MEANS "RUN SYS:FOO WITH AN OFFSET OF 1". + +RFDRUN: MOVE A,DNAM ;LOAD UP THE 4 FILENAMES TO USE. + MOVE B,FNAM1 + MOVE C,FNAM2 + MOVE T,SNAM + JUMPN A,RFDRU2 ;DEFAULT THE DEVICE TO SYS, UNLESS A PPN WAS GIVEN, IN WHICH CASE DSK + MOVSI A,'SYS + SKIPE SNAM + MOVSI A,'DSK + MOVE AA,[1,,A] ;,,
+ JRST RFDRU1 +VBLK +RFDRU1: MOVE F,[1,,RFDRUE] +IFN DECSW,[; UNNECESSARY ON TENEX + CORE F, ;FLUSH AS MUCH CORE AS POSSIBLE, SINCE RUN UUO CAN LOSE + HALT ;BECAUSE OF HOW MUCH WE HAVE. +] +IFNDEF RUN,RUN==047000,,35 ; NO UUO'S ARE DEFINED IN TENEX MIDAS; HOWEVER + ; HERE IT IS ALRIGHT TO USE RUN UUO AS IT GIVES + ; A CONVENTION FOR CALLING OTHER THINGS. THIS + ; SHOULD BE THE ONLY UUO IN TENEX MIDAS. + RUN AA, + HALT +RFDRUE: + +PBLK +];END IFN DECSW\TNXSW, + +;COMMAND SWITCH PROCESSING. + +CMDSL: CALL RCH ;COME HERE AFTER A SLASH. READ ONE SWITCH. + CAIN A,^M + JRST RFD6 + CALL CMDSW1 + JRST RFD2 + +CMDSW: PUSHJ P,RCH + CAIN A,") + JRST RFD2 + CAIN A,^M + JRST RFD6 ;DON'T CRASH IF USER PUTS CR IN SWITCH LIST. + CALL CMDSW1 + JRST CMDSW + +CMDSW1: CAIL A,140 ;LOWER CASE TO UPPER. + SUBI A,40 + CAIN A,"T + SOS TTYINS ;COUNT # T-SWITCHES. +IFN LISTSW,[ + CAIN A,"L + JRST CMDLST +] + CAIN A,"W ;W - PREVENT TTY MESSAGES, AND RQ ERROR OUTPUT FILE IF POSSIBLE. +IFE ERRSW,AOS WSWCNT +.ELSE [ + AOSA WSWCNT + CAIN A,"E ;E - RQ ERROR LOG FILE. + SETOM ERRFP +] +IFN CREFSW,[ + CAIN A,"C ;C - RQ CREF OUTPUT. + SETOM CREFP +] + RET + ;READ COMMAND, DEFAULT FILENAMES. +CMD: SKIPN CMPTR + CALL CRR + SKIPN CMPTR ;UNLESS HAVE DDT COMMAND STRING, PROMPT. +CMDB: TYPR [ASCIZ/*/] + MOVEI A,3 ;READ FROM TTY (OR STRING <- CMPTR) + CALL RCHSET +REPEAT 4,SETZM DNAM+.RPCNT ;LET RFDRUN SEE UNSPECIFIED NAMES AS 0. + TRO FF,FRCMND+FRARRO ;TELL RFD ABOUT COMMA, _ AND (. + CALL RFD ;NOW SEE IF COMMAND NULL, AND WHETHER HAS _. +IFN DECSW\TNXSW,[ + CAIN A,"! + JRST RFDRUN +] + TRNN FF,FRNNUL + CAIE A,^M + CAIA + JRST CMDB ;JUST A CR WITH NOTHING SIGNIFICANT BEFORE IT. +CMD0: CAIN A,"_ + TRZ FF,FRARRO ;FRARRO WILL BE ON IFF NO _ IN STRING. + CAIN A,^M + JRST CMD1 ;READ THRU THE WHOLE COMMAND. + CALL RFD + JRST CMD0 + +;NOW RE-READ THE STRING, FOR REAL THIS TIME. +CMD1: MOVE F,[440700,,CMBUF] + MOVEM F,CMPTR ;START FROM BEGINNING OF STRING. +IFN CREFSW,SETZM CREFP ;CLEAR ALL SWITCHES BEFORE DECODING THEM. +INSIRP SETZM 0,ERRFP TTYINS WSWCNT +IFN LISTSW,[ + SETZM LISTP + SETOM LISTP1 ;WILL BE AOSED BY EACH (L) SWITCH. +] + SETZM DNAM ;CLEAR OUT ALL FILENAMES. + MOVE T,[DNAM,,DNAM+1] + BLT T,FNMEND-1 + MOVSI T,'DSK ;DEFAULT DEV IS DSK + MOVEM T,DNAM ;EXCEPT PERHAPS IF OUTPUT SPEC NULL. + MOVE T,RSYSNM + MOVEM T,SNAM ;DEFAULT SNAME IS INITIAL SNAME. + TRZ FF,FRNNUL + TRNN FF,FRARRO ;DON'T GOBBLE INPUT SPEC AS OUTPUT! + CALL RFD ;READ BIN FILE SPEC. + MOVE F,FF ;REMEMBER WHETHER NULL + MOVE T,[DNAM,,ONAM] + BLT T,OSYSNM + MOVS T,DNAM + CAIN T,'NUL ;IF BIN WENT TO NUL:, + MOVEI T,'DSK ;CREF GOES TO DSK. + MOVSM T,DNAM ;ELSE DEFAULT DEV FOR CREF IS BIN'S DEV. +IFE ITSSW,MOVSI T,'CRF +IFN ITSSW,MOVE T,[SIXBIT/CREF/] + MOVEM T,FNAM2 ;DEFAULT THE CREF FILE'S NAMES. + TRNE FF,FRARRO + MOVEI A,"_ + CAIN A,"_ + JRST CMD2 ;RAN OUT OF OUTPUT SPECS => JUST USE DEFAULTS. + CALL RFD ;READ CREF FILE SPEC. +IFN CREFSW,[ + TRNN FF,FRNNUL ;IF SPEC NOT NULL OR ENDED BY _, + CAIN A,"_ + SETOM CREFP ;WE MUST WANT TO CREF. +CMD2: MOVE T,[DNAM,,CRFDEV] + BLT T,CRFSNM +]IFE CREFSW,CMD2: + MOVSI T,'ERR ;DEFAULT THE ERROR OUTPUT FILE'S NNAMES. + MOVEM T,FNAM2 + CAIN A,"_ + JRST CMD6 ;NO MORE OUTPUT SPECS. + CALL RFD ;READ ERROR FILE SPPEC. +IFN ERRSW,[ + TRNN FF,FRNNUL ;NONNULL SPEC OR LAST SPEC => + CAIN A,"_ + SETOM ERRFP ;MUST WAANT ANN ERROR FILE. +CMD6: MOVE T,[DNAM,,ERRDEV] + BLT T,ERRDEV+3 +] +IFE ERRSW,CMD6: +IFN LISTSW,[ +IFE ITSSW,MOVSI T,'LST +IFN ITSSW,MOVE T,[SIXBIT/LIST/] + MOVEM T,FNAM2 ;DEFAULT LST FILE FN2. + CAIN A,"_ ;ANY OUTPUT SPEC REMAINING? + JRST CMD3 + CALL RFD ;YES, READ ONE. + SETOM LISTP ;LIST SPEC GIVEN IMPLIES WANT LISTING. +CMD3: MOVE T,[DNAM,,LSTDEV] + BLT T,LSTSNM +] ;END IFN LISTSW, +CMD5: CAIN A,"_ + JRST CMD4 + CALL RFD ;IGNORE ANY OUTPUT SPECS NOT NEEDED. + JRST CMD5 + +CMD4: MOVSI T,'DSK ;DEFAULT THE INPUT NAMES. + MOVS A,DNAM + CAIE A,'PTP ;DON'T LEAVE DEV NAME SET TO COMMON OUTPUT-ONLY DEVS. + CAIN A,'NUL + MOVEM T,DNAM +IFE ITSSW,MOVSI T,'MID +IFN ITSSW,MOVSI T,'>_14 + MOVEM T,FNAM2 + MOVE T,[SIXBIT/PROG/] + SKIPN FNAM1 ;THE FN1 ALONE IS STICKY ACROSS THE _. + MOVEM T,FNAM1 + TRO FF,FRARRO ;IF ONLY 1 NAME IT SHOULD BE FNAM1. + CALL RFD ;READ INPUT SPEC. + MOVE T,[DNAM,,IFDS] + BLT T,IFDS+3 + MOVE T,FNAM1 ;DEFAULT OUTPUT FN1'S TO INPUT. + SKIPN ONAM+1 + MOVEM T,ONAM+1 +IFN CREFSW,[ + SKIPN CRFDEV+1 + MOVEM T,CRFDEV+1 +] +IFN LISTSW,[ + SKIPN LSTDEV+1 + MOVEM T,LSTDEV+1 +] +IFN ERRSW,[SKIPN ERRDEV+1 + MOVEM T,ERRDEV+1 +] + MOVSI A,'NUL ;THE OUTPUT DEV DEFAULTS TO NUL: + MOVS T,DNAM ;IF THE INPUT IS FROM TTY: + CAIN T,'TTY + TRNE F,FRNNUL ;AND THE BIN SPEC WAS NULL. + CAIA + MOVEM A,ONAM + TRZ FF,FRARRO ;DON'T LOUSE UP .INSRT'S READING. + RET + IFN CREFSW,[ + +CRFOUT: SOSGE CRFCNT + JRST CRFOU1 ;NO ROOM, OUTPUT AND INIT BUFFER. + IDPB A,CRFPTR + POPJ P, + +CRFOU1: SAVE C + MOVE C,[0 CREFC,CRFHDR] + CALL OBUFO + REST C + JRST CRFOUT + +CRFSSF: SKIPA A,[1] ;OUTPUT SET-SOURCE-FILE BLOCK. +CRFPSH: MOVEI A,3 ;OUTPUT PUSH-SOURCE-FILE BLOCK. +REPEAT 4,[ CALL CRFOUT + MOVE A,INFDEV+.RPCNT +] + JRST CRFOUT +] + +IFN LISTSW,[ + ;PRINTING ROUTINES + +;L SWITCH TYPED IN DURING COMMAND, SET UP FOR LISTING +CMDLST: SETOM LISTP ;SAY WANT LISTING. + AOS LISTP1 ;(STARTS AS -1, WILL BE POS. AFTER 2ND (L)) + RET + +;PRINT CHARACTER IN A +PILPT: SOSGE LSTCNT + JRST PILPT1 + IDPB A,LSTPTR + RET + +PILPT1: SAVE C + MOVE C,[0 LPTC,LSTHDR] + CALL OBUFO + REST C + JRST PILPT + +LPTCLS==CPOPJ +] ;END IFN LISTSW, + ;GET ANOTHER K OF MACTAB SPACE. + +CORRQB: IFN ITSSW,.VALUE ;LOOP POINT FOR DON'T PROCEED +IFN DECSW,EXIT 1, + TLZ AA,400000 +CORRQA: POP P,D + POP P,C + MOVE A,(P) ;RESTORE A FROM PDL + JRST CORRQ1 + +GCCORQ: MOVE A,MACHI + LSH A,-2 ;CONVERT TO WORD # + CAIL A,MXMACL ;WANT MORE THAN ALLOWED? + POPJ P, + MOVE A,MACTND ;NO, GET ADDR OF BLOCK WE WANT TO GET. + PUSH P,A ;ENTRY, SAVE A IN CASE HAVE TO TRY AGAIN +CORRQ1:IFN ITSSW,[ + HRLI A,10001 ;(CODE FOR FRESH PAGE, _1) + LSH A,-1 + .CBLK A, ;TRY GETTING BLOCK +] +IFN DECSW,[ + IORI A,1777 + CORE A, +] + JRST CORRQL ;LOSE + REST A + ADDI A,2000 + JRST MACIN2 ;UPDATE POINTERS TO END OF MACTAB. + +CORRQL: PUSH P,C + PUSH P,D + TLOE AA,400000 + JRST CORQL1 + TYPR [ASCIZ / +No core for macro table./] +CORQL1: TYPR [ASCIZ / +Try again? /] +CORQL2: PUSHJ P,TYI ;GET CHAR + TRZ A," + CAIN A,"Y ;Y, + JRST CORRQA ;=> TRY AGAIN + CAIN A,"N ;N, + JRST CORRQB ;=> BACK TO DDT THEN TRY AGAIN + CAIN A,"? ;?, + ERJ CORQL1 ;=> TYPE OUT ERROR-TYPE BLURB + TYPR [ASCIZ /? /] ;SOMETHING ELSE + JRST CORQL2 + +] ;END TS CONDITIONAL + FEED1: SKIPA B,[40] +FEED: MOVEI B,5 + JRST TFEED + +VBLK + +IFG PURESW-DECSW,[ ;PURIFICATION ROUTINE + +PURIFG: -1 ;-1 IF NOT (YET) PURIFIED +] + VARIAB +VPAT: +VPATCH: BLOCK 20 +VPATCE=.-1 + +PBLK + +CONSTANTS + +PAT: +PATCH: BLOCK 100 +PATCHE: -1 + +IFG PURESW-,[LOC <.+1777>&-2000 ;SKIP TO NEXT PAGE + MAXPUR==./2000 ;FIRST PAGE ABOVE PURE PAGES +PRINTA Pure pages = ,\MAXPUR-MINPUR +] + +VBLK +PDL: BLOCK LPDL+1 + +IFN DECDBG, DECDBB: BLOCK 8000. ;SPACE FOR DEC DDT'S SYMS. + +.NSTGW +BBKCOD==. ;BEGIN BLANK CODING, CLEARED OUT DURING INITIALIZATION +IFG PURESW-,MINBNK==<.+1777>/2000 ;FIRST PAGE OF BLANK CODE +BNKBLK ;DUMP OUT ACCUMULATED BLANK CODING + + ;NOW MORE BLANK CODING + +BKBUF: BLOCK BSIZE+5 ;CURRENT BLOCK TO OUTPUT +GLOTB: BLOCK 20 ;GLOBAL TABLE, EACH ENTRY FLAGS,,ADR OF SQUOZE (SEE COMMENTS NEAR BEGINNING) +STRSTO: BLOCK STRL ;STRING STORAGE FOR GSYL AND FRIENDS +IFN FASLP,[ +FASB: BLOCK FASBL ;OUTPUT BUFFER FOR FASL MODE + ;FIRST WD 9 FOUR BIT CODE GROUPS, REST ASSOC STUFF +FASAT: BLOCK FASATL ;ATOM TABLE FOR FASL MODE + ;EACH ENTRY CONSISTS OF ATOM IN FORMAT DESIRED BY FASLOAD, + ;NAMELY: + ; HEADER WD. RH LENGTH IN WDS + ; 4.8-4.7 TYPE 0-PN 1 FIX 2 FLO 3 BIG (NOT IMPLEMENTED) + ; FOLLOWED BY PN OR VALUE + ;-EXCEPT- IF RH OF HEADER =0, THIS SLOT RESERVED FOR LIST + +] + +EBKCOD==. ;END BLANK CODING +.YSTGW + +PRINTA ST = ,\.-RL0 + +ST: ;SYMBOL TABLE 3 WORDS/SYM FIRST SQUOZE, SECOND "VALUE", 3RD FLAGS,,BLOCK. + BLOCK NRMWPS*SYMDSZ + +;LITERALS TABLES - CAN MOVE AND GROW. THESE TAGS & LENGTHS ARE JUST THE DEFAULTS +.SEE CONTBA ;ETC, WHICH CONTAIN THE ACTUAL ADDRESSES. SO DON'T USE THEM! +CONTAB: BLOCK LCONTB ;CONSTANTS TABLE, VALUES OF CONSTANTS THIS CONSTANTS AREA +CONGLO: BLOCK LCNGLO ;CONSTANTS GLOBAL TABLE, EACH ENTRY TWO WORDS + ;FIRST WD GLOTB ENTRY. SECOND WD ADR IN CONTAB OF CONSTANT TO WHICH IT REFERS +CONBIT: BLOCK LCONTB/12.+1 ;RELOCATION BITS AND ILNOPT BIT(SEE CPTMK) + ;3 BITS FOR EACH WORD OF CONTAB. + ;;INIT ;INITIALIZATION ROUTINES (IN MACRO TABLE, GET WIPED OUT) +IFN ITSSW,MINMAC==./2000 ;# OF 1ST PAGE HOLDING PART OF MACTAB. +;NOTE THAT THIS CODE IS COPIED UPWARD WHEN MACTAB IS MOVED +;DUE TO SYMTAB EXPANSION. THEREFOR IT MUST REFER TO ITSELF +;INDEXED BY THE OFFSET OF WHERE IT IS FROM WHERE IT WAS ASSEMBLED. +;THAT IS KEPT IN CH1. ALL LITERALS MUST BE USED INDEX OF CH1, TOO. + +;MAC PROC TABLES +MACTBA: 773767750000 ;MACRO CHARACTER STORAGE (FIRST WORD 3 375'S) +INIT1: MOVE CH1,MACTAD ;GET ADDR THIS COODE REALLY STARTS AT. + SUBI CH1,MACTBA ;GET OFFSET FROM WHERE ASSEMBLED. + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1](CH1) + BLT A,EBKCOD-1 ;CLEAR OUT BLANK CODING + PUSH P,[SP4](CH1) ;NOW INIT THE SYMTAB & FINISHED. + +;INITIALIZE THE SYMTAB, EXPECT SIZE IN SYMLEN. +INITS: MOVE AA,SYMLEN ;SET UP THE OTHER VARS + IMUL AA,WPSTE ;DEALING WITH SYMTAB SIZE. + MOVEM AA,SYMSIZ + ADDI AA,ST ;ADDR OF START OF CONTAB. + MOVEM AA,CONTBA + MOVEM AA,PLIM + ADD AA,CONLEN ;ADD LENGTH OF CONTAB TO GET ADDR OF CONGLO TAB. + MOVEM AA,CONTBE ;WHICH IS ALSO THE END OF CONTAB. + MOVEM AA,CONGLA + MOVEM AA,CONGOL + MOVE A,CONLEN ;ADD IN LENGTH OF CONGLO (1/4 OF CONLEN) + LSH A,-2 + ADD AA,A + MOVEM AA,CONGLE ;TO GET END OF CONGLO, AND START OF CONBIT TABLE. + MOVEM AA,CONBIA + MOVE A,CONLEN + ADDI A,11. + IDIVI A,12. + ADD AA,A ;ADD LENGTH OF CONBIT (1/12 OF CONLEN) GETTING ADDR OF MACTAB. +IFN DECSW,[ + SAVE AA + ADDI AA,MACL-1 + IORI AA,1777 ;FIX ALLOCATION PROBLEMS ON KI-10 + CORE AA, + ETF [ASCIZ /No core for symbols/](CH1) + REST AA +] + MOVN A,SYMLEN + HRLZM A,SYMAOB ;AOBJN -> SYMTAB. + MOVE A,WPSTE + SUBI A,1 + MOVEM A,WPSTE1 + MOVN A,WPSTE + HRRM A,WPSTEB + CAMG AA,MACTAD ;MOVED MACTAB UP? + JRST INITS1(CH1) +IFN ITSSW,[ ;YES, GET CORE FOR INCREASE. + SAVE AA + MOVEI AA,MACL+1777(AA) + LSH AA,-10. ;1ST PAGE NOT NEEDED BY MACTAB. + MOVEI A,MACL+1777+MACTBA(CH1) + LSH A,-10. ;1ST PAGE MACTAB DOESN'T YET HAVE. + SUBM A,AA ;# PAGES NEEDED. + HRLZI AA,(AA) + HRRI AA,(A) ;-<# PAGES>,,<1ST NEEDED> + JUMPGE AA,.+3(CH1) ;DON'T CALL IF NEED 0 PAGES, WOULD GET ONE. + .CALL INITSB(CH1) + .VALUE + REST AA +] + SUBM AA,MACTAD ;MACTAD _ SHIFT IN START OF MACTAB. + EXCH AA,MACTAD ;MACTAD GETS NEW START, AA HAS SHIFT. + MOVSI A,PTAB-CCOMPB + ADDM AA,PTAB(A) ;RELOCATE BYTE-PTRS INTO MACTAB. + AOBJN A,.-1(CH1) + MOVNI B,INITS2(CH1) + HRROI A,@EISYMP(CH1) + ADDI B,1(A) ;GET # WDS IN SECOND HALF OF INIT CODE. + HRRM AA,.+1(CH1) ;COPY 2ND HALF UPWARD WITH POP-LOOP. + POP A,(A) ;THIS INSN IMPURE. + SOJG B,.-1(CH1) + ADDI CH1,(AA) ;CHANGE OFFSET TO PT. TO NEW LOCATIONN OF INIT CODE. + JRST INITS2(CH1) ;JUMP INTO 2ND HALF, WHERE IT'S BEEN COPIED TO. +INITS2: HRROI A,INITS2-1(CH1) ;THEN COPY 1ST HALF (WHICH ENNDS BEFORE INITS2) + SUBI A,(AA) ;GET WHERE NOW ENDS, NOT WHERE WILL END. + MOVEI B,INITS2-MACTBA ;UP UNDERNEATH THE 2ND HALF. + HRRM AA,.+1(CH1) ;(THIS TWO-STEP COPYING HANDLES ALL OVERLAPS) + POP A,(A) + SOJG B,.-1(CH1) +INITS1: MOVE AA,SYMSIZ + SETZM ST + MOVE A,[ST,,ST+1](CH1) + BLT A,ST-1(AA) ;CLEAR OUT SYMBOL TABLE + SETZM ESBK ;DEFINE THEM IN OUTER BLOCK. + MOVEI AA,ISYMTB(CH1) + MOVS F,ISMTBB(CH1) ;GET SWAPPED VALUE OF FIRST INSTRUCTION +SP3: CAIL AA,EISYM1(CH1) + JRST SP1(CH1) ;DONE WITH INSTRUCTIONS + MOVE SYM,(AA) + JUMPE SYM,SP2(CH1) + TLZ SYM,740000 + PUSHJ P,ES ;WON'T SKIP + CAIA + .VALUE ;INSTRUCTION PRESENT TWICE IN TABLE!!?!? + HRLZI T,SYMC + HRLZ B,F + MOVSI C,3KILL + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP2: ADDI F,1000 + AOJA AA,SP3(CH1) +;AFTER HACKING ALL THE INSTRUCTIONS, STORED AS JUST THE NAMES IN NUMERIC ORDER, +;HACK ALL THE OTHER PREDEFINED SYMS, STORED AS 2 WORDS (NAME ? VALUE). +EISYMP: ;MAY BE MUNGED IF MORE SYMBOLS ARE ADDED AFTER EISYMT. +SP1: CAIL AA,EISYMT(CH1) + POPJ P, + MOVE SYM,(AA) + LDB T,[400400,,SYM](CH1) + ROT T,-4 + TLZ SYM,740000 + PUSHJ P,ES + CAIA + JRST SP5(CH1) ;SYM ALREADY DEFINED? (MIGHT BE .UAI, IN ITS AND IN MIDAS). + MOVE B,1(AA) + MOVSI C,3KILL + CAME T,[GLOETY,,](CH1) ;GLOBAL ENTRIES REALLY EXITS, HACKED TO DEFEAT ADDRESS LINKING + CAMN T,[GLOEXT,,](CH1) + TLO C,3LLV + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP5: AOS AA + AOJA AA,SP1(CH1) + IFN ITSSW,[ +INITSB: SETZ ? 'CORBLK + 1000,,600000 ;BOTH READ AND WRITE. + 1000,,-1 ? AA ;INTO SELF, AA IS AOBJN -> PAGES. + SETZI 400001 ;FRESH PAGES. + + ;GOBBLE SYMS FROM SYSTEM + ;TABLE AREA IN SYSTEM: + ;FIRST LOC SYSYMB + ;LAST (AS OPPOSED TO LAST + 1) SYSYME + +TSYMGT: MOVE AA,[MXICLR-MXIMAC,,MXICLR] + .CALL INITSB ;GET MACTAB PAGES NNOT LOADED INTO. + .VALUE +IFN PURESW,[ + MOVE AA,[MINBNK-MINMAC,,MINBNK] + .CALL INITSB ;GET PAGES FOR BLANK CODE & SYMTAB. + .VALUE + SKIPN PURIFG + JRST TSYMG3 + JSP F,PURIFD ;NOT PURIFIED => FLUSH PAGES + MINPUR-MXIMAC ;OF MACTAB CREATED BY LOADING BUT NOT NEEDED. + MXIMAC*1001 +TSYMG3: +] + MOVEI A,EISYMT ;EISYMT FIRST LOC FOR ITS SYMS + MOVE B,[SIXBIT /CALLS/] ;SYSTEM CALLS + .GETSYS A, ;READ IN SYSTEM CALLS (SHOULD SKIP) + .VALUE + SKIPGE A + .VALUE ;.GETSYS DIDN'T UPDATE AOBJN POINTER + HRRM A,SP1 ;MARK END OF SYMS + ANDI A,-1 + CAIL A,MACTBA+MACL + .VALUE ;MACL TOO SMALL! INITS MIGHT LOSE. + MOVEI B,EISYMT + MOVEI AA,SYMC_<-18.+4> ;SQUOZE FLAG FOR SYM +TSYMG2: DPB AA,[400400,,(B)] + ADDI B,2 + CAIE B,(A) + JRST TSYMG2 + POPJ P, + IFN PURESW,[ ;HERE ARE THE GUTS OF THE PURIFY ROUTINE + +PURIFY: SKIPL NVRRUN + .VALUE [ASCIZ /:Already run +/] +PURIF1: MOVEI P,17 ;START PDL AT 20 + JSP F,PURIFD ;CALL .CBLK ROUTINE + MINMAC-MINBNK ;FLUSH BLANK CODE PAGES (INCL. SYM TAB) + MINBNK*1001 + MINPUR-MXICLR ;FLUSH MACTAB PAGES CREATED BY LOAD BUT NOT NNEEDED. + MXICLR*1001 + MAXPUR-MINPUR ;PURIFY PURE PAGES. + 400000+MINPUR*1001 + SETZM PURIFG ;SET "PURIFIED" FLAG + MOVE [1,,2] ;NOW CLEAR OUT REMAINS OF DATA OF SELF + MOVEI 1,0 + BLT 40 + .VALUE [ASCIZ /:Purifiedpdump SYS;TS MIDAS/] + +GAPFLS: JSP F,PURIFD ;FLUSH GAP PAGES CREATED ON INITIAL LOAD. + MINPUR-MXIMAC + MXIMAC*1001 + .BREAK 16,300000 + + ;JSP F,PURIFD ;DO A SEQUENCE OF .CBLKS + ;FOLLOW WITH AN ARBITRARY NUMBER OF PAIRS OF ARGUMENTS + ;FIRST ARG OF PAIR # PAGES TO PROCESS, MAY BE ZERO + ;SECOND INITIAL .CBLK AC CONTENTS + +PURIFD: MOVE C,(F) ;GET COUNT + TLNE C,777000 ;CHECK INSTRUCTION PART + JRST (F) ;INSTRUCTION => RETURN TO IT + JUMPE C,PURID2 ;JUMP IF NO PAGES IN COUNT + MOVE A,1(F) ;GET INITIAL .CBLK ARG +PURID1: .CBLK A, + .VALUE + ADDI A,1001 ;INCREMENT .CBLK ARG TO NEXT PAGE + SOJG C,PURID1 ;DO IT THE APPROPRIATE NUMBER OF TIMES +PURID2: ADDI F,2 + JRST PURIFD + +] ;END PURESW CONDITIONAL +] ;END ITSSW, CONDITIONAL + +IFN DECDBG,[ +DECDBM: 0 + HRLZ A,.JBSYM ;GET ADDR OF START OF DDT SYMS, + HRRI A,DECDBB+200 ;LEAVE 200 WD SPACE BEFORE THEM. + HRRM A,.JBSYM ;MOVE THEM INTO SPACE PROVIDED + HLRE B,.JBSYM + MOVMS B + BLT A,DECDBB+177(B) ;SO THEY WON'T GET IN MACTAB'S WAY. + JRST @DECDBM +] + +CONSTANTS + ;;ISYMS ;INITIAL SYMBOL TABLE + +IFNDEF JSYS,JSYS=104_33 ;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE + +ISMTBB: JSYS ;FIRST OP. CODE IN ISYMTB + +ISYMTB: + +; 104-177 (JSYS - FDVRB) + +SQUOZE 10,JSYS ;BBN PAGER INSTRUCTION +SQUOZE 10,ADJSP ;KL10 INSTRUCTION + 0 + 0 + +SQUOZE 10,DFAD ;KI10 INSTRUCTION +SQUOZE 10,DFSB ;KI10 INSTRUCTION +SQUOZE 10,DFMP ;KI10 INSTRUCTION +SQUOZE 10,DFDV ;KI10 INSTRUCTION +SQUOZE 10,DADD ;KL10 INSTRUCTION +SQUOZE 10,DSUB ;KL10 INSTRUCTION +SQUOZE 10,DMUL ;KL10 INSTRUCTION +SQUOZE 10,DDIV ;KL10 INSTRUCTION +SQUOZE 10,DMOVE ;KI10 INSTRUCTION +SQUOZE 10,DMOVN ;KI10 INSTRUCTION + +SQUOZE 10,FIX ;KI10 INSTRUCTION +SQUOZE 10,EXTEND ;KL10 INSTRUCTION +SQUOZE 10,DMOVEM ;KI10 INSTRUCTION +SQUOZE 10,DMOVNM ;KI10 INSTRUCTION +SQUOZE 10,FIXR ;KI10 INSTRUCTION +SQUOZE 10,FLTR ;KI10 INSTRUCTION + +SQUOZE 10,UFA ;KA/KI10 INSTRUCTION +SQUOZE 10,DFN ;KA/KI10 INSTRUCTION +SQUOZE 10,FSC + +SQUOZE 10,IBP +SQUOZE 10,ILDB +SQUOZE 10,LDB +SQUOZE 10,IDPB +SQUOZE 10,DPB + +SQUOZE 10,FAD +SQUOZE 10,FADL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FADM +SQUOZE 10,FADB +SQUOZE 10,FADR +SQUOZE 10,FADRI ;PDP10 INSTRUCTION +SQUOZE 10,FADRM +SQUOZE 10,FADRB +SQUOZE 10,FSB +SQUOZE 10,FSBL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FSBM +SQUOZE 10,FSBB +SQUOZE 10,FSBR +SQUOZE 10,FSBRI ;PDP10 INSTRUCTION +SQUOZE 10,FSBRM +SQUOZE 10,FSBRB +SQUOZE 10,FMP +SQUOZE 10,FMPL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FMPM +SQUOZE 10,FMPB +SQUOZE 10,FMPR +SQUOZE 10,FMPRI ;PDP10 INSTRUCTION +SQUOZE 10,FMPRM +SQUOZE 10,FMPRB +SQUOZE 10,FDV +SQUOZE 10,FDVL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FDVM +SQUOZE 10,FDVB +SQUOZE 10,FDVR +SQUOZE 10,FDVRI ;PDP10 INSTRUCTION +SQUOZE 10,FDVRM +SQUOZE 10,FDVRB + ; 200-277 (MOVE - SUBB) + +SQUOZE 10,MOVE +SQUOZE 10,MOVEI +SQUOZE 10,MOVEM +SQUOZE 10,MOVES +SQUOZE 10,MOVS +SQUOZE 10,MOVSI +SQUOZE 10,MOVSM +SQUOZE 10,MOVSS +SQUOZE 10,MOVN +SQUOZE 10,MOVNI +SQUOZE 10,MOVNM +SQUOZE 10,MOVNS +SQUOZE 10,MOVM +SQUOZE 10,MOVMI +SQUOZE 10,MOVMM +SQUOZE 10,MOVMS + +SQUOZE 10,IMUL +SQUOZE 10,IMULI +SQUOZE 10,IMULM +SQUOZE 10,IMULB +SQUOZE 10,MUL +SQUOZE 10,MULI +SQUOZE 10,MULM +SQUOZE 10,MULB +SQUOZE 10,IDIV +SQUOZE 10,IDIVI +SQUOZE 10,IDIVM +SQUOZE 10,IDIVB +SQUOZE 10,DIV +SQUOZE 10,DIVI +SQUOZE 10,DIVM +SQUOZE 10,DIVB + +SQUOZE 10,ASH +SQUOZE 10,ROT +SQUOZE 10,LSH +SQUOZE 10,JFFO ;PDP10 INSTRUCTION +SQUOZE 10,ASHC +SQUOZE 10,ROTC +SQUOZE 10,LSHC +SQUOZE 10,CIRC ;AI PDP10 INST. CIRCULATE: ROTC WITH AC+1 GOING THE WRONG WAY + +SQUOZE 10,EXCH +SQUOZE 10,BLT +SQUOZE 10,AOBJP +SQUOZE 10,AOBJN +SQUOZE 10,JRST +SQUOZE 10,JFCL +SQUOZE 10,XCT +;SQUOZE 10,MAP ;KI10 INSTRUCTION +0 ;DON'T DEFINE MAP SINCE MANY PROGRAMS USE IT AS A LABEL + +SQUOZE 10,PUSHJ +SQUOZE 10,PUSH +SQUOZE 10,POP +SQUOZE 10,POPJ +SQUOZE 10,JSR +SQUOZE 10,JSP +SQUOZE 10,JSA +SQUOZE 10,JRA + +SQUOZE 10,ADD +SQUOZE 10,ADDI +SQUOZE 10,ADDM +SQUOZE 10,ADDB +SQUOZE 10,SUB +SQUOZE 10,SUBI +SQUOZE 10,SUBM +SQUOZE 10,SUBB + ; 300-377 (CAI - SOSG) + +SQUOZE 10,CAI +SQUOZE 10,CAIL +SQUOZE 10,CAIE +SQUOZE 10,CAILE +SQUOZE 10,CAIA +SQUOZE 10,CAIGE +SQUOZE 10,CAIN +SQUOZE 10,CAIG +SQUOZE 10,CAM +SQUOZE 10,CAML +SQUOZE 10,CAME +SQUOZE 10,CAMLE +SQUOZE 10,CAMA +SQUOZE 10,CAMGE +SQUOZE 10,CAMN +SQUOZE 10,CAMG + +SQUOZE 10,JUMP +SQUOZE 10,JUMPL +SQUOZE 10,JUMPE +SQUOZE 10,JUMPLE +SQUOZE 10,JUMPA +SQUOZE 10,JUMPGE +SQUOZE 10,JUMPN +SQUOZE 10,JUMPG +SQUOZE 10,SKIP +SQUOZE 10,SKIPL +SQUOZE 10,SKIPE +SQUOZE 10,SKIPLE +SQUOZE 10,SKIPA +SQUOZE 10,SKIPGE +SQUOZE 10,SKIPN +SQUOZE 10,SKIPG + +SQUOZE 10,AOJ +SQUOZE 10,AOJL +SQUOZE 10,AOJE +SQUOZE 10,AOJLE +SQUOZE 10,AOJA +SQUOZE 10,AOJGE +SQUOZE 10,AOJN +SQUOZE 10,AOJG +SQUOZE 10,AOS +SQUOZE 10,AOSL +SQUOZE 10,AOSE +SQUOZE 10,AOSLE +SQUOZE 10,AOSA +SQUOZE 10,AOSGE +SQUOZE 10,AOSN +SQUOZE 10,AOSG +SQUOZE 10,SOJ +SQUOZE 10,SOJL +SQUOZE 10,SOJE +SQUOZE 10,SOJLE +SQUOZE 10,SOJA +SQUOZE 10,SOJGE +SQUOZE 10,SOJN +SQUOZE 10,SOJG +SQUOZE 10,SOS +SQUOZE 10,SOSL +SQUOZE 10,SOSE +SQUOZE 10,SOSLE +SQUOZE 10,SOSA +SQUOZE 10,SOSGE +SQUOZE 10,SOSN +SQUOZE 10,SOSG + ; 400-477 (SETZ - SETOB) + +SQUOZE 10,SETZ +SQUOZE 10,SETZI +SQUOZE 10,SETZM +SQUOZE 10,SETZB +SQUOZE 10,AND +SQUOZE 10,ANDI +SQUOZE 10,ANDM +SQUOZE 10,ANDB +SQUOZE 10,ANDCA +SQUOZE 10,ANDCAI +SQUOZE 10,ANDCAM +SQUOZE 10,ANDCAB +SQUOZE 10,SETM +SQUOZE 10,SETMI +SQUOZE 10,SETMM +SQUOZE 10,SETMB +SQUOZE 10,ANDCM +SQUOZE 10,ANDCMI +SQUOZE 10,ANDCMM +SQUOZE 10,ANDCMB +SQUOZE 10,SETA +SQUOZE 10,SETAI +SQUOZE 10,SETAM +SQUOZE 10,SETAB +SQUOZE 10,XOR +SQUOZE 10,XORI +SQUOZE 10,XORM +SQUOZE 10,XORB +SQUOZE 10,IOR +SQUOZE 10,IORI +SQUOZE 10,IORM +SQUOZE 10,IORB +SQUOZE 10,ANDCB +SQUOZE 10,ANDCBI +SQUOZE 10,ANDCBM +SQUOZE 10,ANDCBB +SQUOZE 10,EQV +SQUOZE 10,EQVI +SQUOZE 10,EQVM +SQUOZE 10,EQVB +SQUOZE 10,SETCA +SQUOZE 10,SETCAI +SQUOZE 10,SETCAM +SQUOZE 10,SETCAB +SQUOZE 10,ORCA +SQUOZE 10,ORCAI +SQUOZE 10,ORCAM +SQUOZE 10,ORCAB +SQUOZE 10,SETCM +SQUOZE 10,SETCMI +SQUOZE 10,SETCMM +SQUOZE 10,SETCMB +SQUOZE 10,ORCM +SQUOZE 10,ORCMI +SQUOZE 10,ORCMM +SQUOZE 10,ORCMB +SQUOZE 10,ORCB +SQUOZE 10,ORCBI +SQUOZE 10,ORCBM +SQUOZE 10,ORCBB +SQUOZE 10,SETO +SQUOZE 10,SETOI +SQUOZE 10,SETOM +SQUOZE 10,SETOB + ; 500-577 (HLL - HLRES) + +SQUOZE 10,HLL +SQUOZE 10,HLLI +SQUOZE 10,HLLM +SQUOZE 10,HLLS +SQUOZE 10,HRL +SQUOZE 10,HRLI +SQUOZE 10,HRLM +SQUOZE 10,HRLS +SQUOZE 10,HLLZ +SQUOZE 10,HLLZI +SQUOZE 10,HLLZM +SQUOZE 10,HLLZS +SQUOZE 10,HRLZ +SQUOZE 10,HRLZI +SQUOZE 10,HRLZM +SQUOZE 10,HRLZS +SQUOZE 10,HLLO +SQUOZE 10,HLLOI +SQUOZE 10,HLLOM +SQUOZE 10,HLLOS +SQUOZE 10,HRLO +SQUOZE 10,HRLOI +SQUOZE 10,HRLOM +SQUOZE 10,HRLOS +SQUOZE 10,HLLE +SQUOZE 10,HLLEI +SQUOZE 10,HLLEM +SQUOZE 10,HLLES +SQUOZE 10,HRLE +SQUOZE 10,HRLEI +SQUOZE 10,HRLEM +SQUOZE 10,HRLES +SQUOZE 10,HRR +SQUOZE 10,HRRI +SQUOZE 10,HRRM +SQUOZE 10,HRRS +SQUOZE 10,HLR +SQUOZE 10,HLRI +SQUOZE 10,HLRM +SQUOZE 10,HLRS +SQUOZE 10,HRRZ +SQUOZE 10,HRRZI +SQUOZE 10,HRRZM +SQUOZE 10,HRRZS +SQUOZE 10,HLRZ +SQUOZE 10,HLRZI +SQUOZE 10,HLRZM +SQUOZE 10,HLRZS +SQUOZE 10,HRRO +SQUOZE 10,HRROI +SQUOZE 10,HRROM +SQUOZE 10,HRROS +SQUOZE 10,HLRO +SQUOZE 10,HLROI +SQUOZE 10,HLROM +SQUOZE 10,HLROS +SQUOZE 10,HRRE +SQUOZE 10,HRREI +SQUOZE 10,HRREM +SQUOZE 10,HRRES +SQUOZE 10,HLRE +SQUOZE 10,HLREI +SQUOZE 10,HLREM +SQUOZE 10,HLRES + ; 600-677 (TRN - TSON) + +SQUOZE 10,TRN +SQUOZE 10,TLN +SQUOZE 10,TRNE +SQUOZE 10,TLNE +SQUOZE 10,TRNA +SQUOZE 10,TLNA +SQUOZE 10,TRNN +SQUOZE 10,TLNN +SQUOZE 10,TDN +SQUOZE 10,TSN +SQUOZE 10,TDNE +SQUOZE 10,TSNE +SQUOZE 10,TDNA +SQUOZE 10,TSNA +SQUOZE 10,TDNN +SQUOZE 10,TSNN +SQUOZE 10,TRZ +SQUOZE 10,TLZ +SQUOZE 10,TRZE +SQUOZE 10,TLZE +SQUOZE 10,TRZA +SQUOZE 10,TLZA +SQUOZE 10,TRZN +SQUOZE 10,TLZN +SQUOZE 10,TDZ +SQUOZE 10,TSZ +SQUOZE 10,TDZE +SQUOZE 10,TSZE +SQUOZE 10,TDZA +SQUOZE 10,TSZA +SQUOZE 10,TDZN +SQUOZE 10,TSZN +SQUOZE 10,TRC +SQUOZE 10,TLC +SQUOZE 10,TRCE +SQUOZE 10,TLCE +SQUOZE 10,TRCA +SQUOZE 10,TLCA +SQUOZE 10,TRCN +SQUOZE 10,TLCN +SQUOZE 10,TDC +SQUOZE 10,TSC +SQUOZE 10,TDCE +SQUOZE 10,TSCE +SQUOZE 10,TDCA +SQUOZE 10,TSCA +SQUOZE 10,TDCN +SQUOZE 10,TSCN +SQUOZE 10,TRO +SQUOZE 10,TLO +SQUOZE 10,TROE +SQUOZE 10,TLOE +SQUOZE 10,TROA +SQUOZE 10,TLOA +SQUOZE 10,TRON +SQUOZE 10,TLON +SQUOZE 10,TDO +SQUOZE 10,TSO +SQUOZE 10,TDOE +SQUOZE 10,TSOE +SQUOZE 10,TDOA +SQUOZE 10,TSOA +SQUOZE 10,TDON +SQUOZE 10,TSON + ; I/O INSTRUCTIONS, OBSOLETE INSTRUCTIONS, ALIASES + +EISYM1: + +SQUOZE 4,BLKI +BLKI IOINST +SQUOZE 4,DATAI +DATAI IOINST +SQUOZE 4,BLKO +BLKO IOINST +SQUOZE 4,DATAO +DATAO IOINST +SQUOZE 4,CONO +CONO IOINST +SQUOZE 4,CONI +CONI IOINST +SQUOZE 4,CONSZ +CONSZ IOINST +SQUOZE 4,CONSO +CONSO IOINST + +;OLD PROGRAMS USE THESE NAMES + +SQUOZE 10,CLEAR +CLEAR +SQUOZE 10,CLEARI +CLEARI +SQUOZE 10,CLEARM +CLEARM +SQUOZE 10,CLEARB +CLEARB + +; MACRO-10 AND FAIL'S RANDOM ALIAS NAMES + +SQUOZE 10,ADJBP ;KL10 FORM OF IBP WITH VARIABLE NUMBER TO INCREMENT +IBP +SQUOZE 10,JFOV ;PDP10 INSTRUCTION (PC CHANGE ON PDP6) +JFCL 1, +SQUOZE 10,JCRY1 +JFCL 2, +SQUOZE 10,JCRY0 +JFCL 4, +SQUOZE 10,JCRY +JFCL 6, +SQUOZE 10,JOV +JFCL 10, +SQUOZE 10,PORTAL ;KI10 INSTRUCTION +JRST 1, +SQUOZE 10,JRSTF +JRST 2, +SQUOZE 10,HALT +JRST 4, +SQUOZE 10,JEN +JRST 12, + +;PDP6 HAS LONG FORM ROUNDED INSTEAD OF IMMEDIATES + +IRPS INST,,FAD FSB FMP FDV + SQUOZE 10,INST!RL + INST!RI +TERMIN + IFN DECSW,[ +DEFINE DEFSYM X/ + IF2,[ + IRPS Z,,[X] + EXPUNGE Z + .ISTOP + TERMIN + X + ] + IRPS Z,,[X] + SQUOZE 10,Z + IF1 0 + .ELSE Z + .ISTOP + TERMIN +TERMIN + +.DECUU DEFSYM +.DECTT DEFSYM +.DECMT DEFSYM +.DECCL DEFSYM +.DEC.J DEFSYM +.DECJH DEFSYM + +IFN DECBSW,.INSRT DECBTS + +EXPUNG DEFSYM + +] ;IFN DECSW + +IFN TNXSW,[;; DEFINE JSYS'S ON TENEX VERSION +DEFINE DEFSYM X/ + IF2,[ + IRPS Z,,[X] + EXPUNGE Z + .ISTOP + TERMIN + X + ] + IRPS Z,,[X] + SQUOZE 10,Z + IF1 0 + .ELSE Z + .ISTOP + TERMIN +TERMIN + +.TNXJS DEFSYM +.INSRT TWXBTS +EXPUNG DEFSYM +] ;IFN TNXSW + SQUOZE 10,.OSMID +OSMIDAS +SQUOZEE 4,.SITE +A.SITE +SQUOZE 4,RIM10 +ARIM10,,SRIM +SQUOZE 4,SBLK +SBLKS,,SRIM +SQUOZE 4,RIM +ARIM,,SRIM +SQUOZE 4,SQUOZE +ASQOZ +SQUOZE 4,.RSQZ +-1,,ASQOZ +SQUOZE 4,XWD +AXWORD +SQUOZE 4,CONSTA +CNSTNT +SQUOZE 4,ASCIC +EOFCH,,AASCIZ +SQUOZE 4,RADIX +ARDIX + +SQUOZE 4,END +AEND +SQUOZE 4,TITLE +ATITLE +SQUOZE 4,.BEGIN +A.BEGIN +SQUOZE 4,.END +A.END +SQUOZE 4,VARIAB +AVARIAB +SQUOZE 4,SIXBIT +ASIXBIT +SQUOZE 4,ASCII +AASCII +SQUOZE 4,ASCIZ +AASCIZ +SQUOZE 4,.ASCII +A.ASCII +SQUOZE 4,.ASCVL +A.ASCV +SQUOZE 4,BLOCK +ABLOCK +SQUOZE 4,LOC +ALOC +SQUOZE 4,OFFSET +AOFFSET +SQUOZE 4,.SBLK +SIMBLK +SQUOZE 4,RELOCA +ARELOCA +SQUOZE 4,1PASS +A1PASS +SQUOZE 4,.DECRE +A.DECRE +SQUOZE 4,.DECTX +A.DCTX + SQUOZE 4,.DECTW +A.DECTW +SQUOZE 4,NOSYMS +ANOSYMS +SQUOZE 4,EXPUNGE +AEXPUNGE +SQUOZE 4,EQUALS +AEQUALS +SQUOZE 4,NULL +ANULL +SQUOZE 4,SUBTTL +ANULL +SQUOZE 4,WORD +AWORD +SQUOZE 4,.SYMTAB +A.SYMTAB +SQUOZE 4,.SEE +A.SEE +SQUOZE 4,.AUXIL +MACCR +SQUOZE 4,.MRUNT +A.MRUNT +SQUOZE 4,.SYMCN +A.SYMC +SQUOZE 4,.TYPE +A.TYPE +SQUOZE 4,.FORMAT +A.FORMAT +SQUOZE 4,.OP +A.OP +SQUOZE 4,.AOP +A.AOP +SQUOZE 4,.RADIX +A.RADIX +SQUOZE 4,.FATAL +A.FATAL +SQUOZE 4,.BP +A.BP +SQUOZE 4,.BM +A.BM +SQUOZE 4,.LZ +A.LZ +SQUOZE 4,.TZ +A.TZ +SQUOZE 4,.DPB +A.DPB +SQUOZE 4,.LDB +A.LDB +SQUOZE 4,.1STWD +A.1STWD +SQUOZE 4,.NTHWD +A.NTHWD + +IRPS X,,[.BIND=0,.KILL=3KILL,.HKILL=3SKILL,.XCREF=3NCRF,.DOWN=3DOWN] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,A.KILL +TERMIN + +SQUOZE 4,.LSTON +A.LSTN +SQUOZE 4,.LSTOF +A.LSTF + +IRPS X,,[.MLLIT=CONSML,.PASS=A.PASS,.PPASS=A.PPASS,.SUCCESS=A.SUCCESS +.HKALL=HKALL,.STGSW=STGSW,.LITSW=LITSW,.AVAL1=AVAL1,.AVAL2=AVAL2,.ERRCNT=ERRCNT +.ASKIP=A.ASKIP,.CURLN=CLNN,.CURPG=CPGN,.QMTCH=QMTCH,.STPLN=A.STPLN,.STPPG=A.STPPG] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,INTSYM +TERMIN + ;CONDITIONALS (SEE ALSO IFSE, IFSN) + +SQUOZE 4,IFG +JUMPG A,COND +SQUOZE 4,IFGE +JUMPGE A,COND +SQUOZE 4,IFE +JUMPE A,COND +SQUOZE 4,IFLE +JUMPLE A,COND +SQUOZE 4,IFL +JUMPL A,COND +SQUOZE 4,IFN +JUMPN A,COND +SQUOZE 4,.ELSE +SKIPE A.ELSE +SQUOZE 4,.ALSO +SKIPN A.ELSE + +SQUOZE 4,IF1 +TRNE FF,COND1 +SQUOZE 4,IF2 +TRNN FF,COND1 +SQUOZE 4,IFDEF ;ASSEMBLE IF SYM DEFINED +JUMPG A,DEFCND +SQUOZE 4,IFNDEF ;ASSEMBLE IF SYM NOT DEFINED +JUMPE A,DEFCND +SQUOZE 4,IFB ;ASSEMBLE IF STRING BLANK (HAS NO SQUOZE CHARS) +JUMPLE C,SBCND +SQUOZE 4,IFNB ;ASSEMBLE IF STRING NOT BLANK +JUMPG C,SBCND +SQUOZE 4,IFSQ ;ASSEMBLE IF STRING ARG IS ALL SQUOZE +JUMPLE B,SBCND +SQUOZE 4,IFNSQ ;ASSEMBLE IF STRING ARG IS NOT ALL SQUOZE. +JUMPG B,SBCND + +SQUOZE 4,PRINTX +APRIN2,,APRINT +SQUOZE 4,PRINTC +APRIN3,,APRINT +SQUOZE 4,COMMEN +APRIN1,,APRINT +SQUOZE 4,.TYO +A.TYO +SQUOZE 4,.TYO6 +A.TYO6 +SQUOZE 4,.ERR +A.ERR + +SQUOZE 4,.RELP +A.RELP +SQUOZE 4,.ABSP +A.ABSP +SQUOZE 4,.RL1 +A.RL1 +SQUOZE 4,.LIBRA +LLIB,,A.LIB +SQUOZE 4,.LENGTH +A.LENGTH +SQUOZE 4,.LIFS +LTCP,,A.LIB +SQUOZE 4,.ELDC +A.ELDC +IRPS A,,E N G LE GE L +SQUOZE 4,.LIF!A +JUMP!A A.LDCV +TERMIN +SQUOZE 4,.SLDR +A.SLDR + SQUOZE 4,. +GTVLP +SQUOZE 4,.LOP +A.LOP +SQUOZE 40,$. +0 +SQUOZE 44,$R. +0 +SQUOZE 40,$O. ;(OH) GLOBAL OFFSET +0 +SQUOZE 40,$L. ;REAL LOCATION (WITHOUT OFFSET) +0 +SQUOZE 40,.LVAL1 +0 +SQUOZE 40,.LVAL2 +0 +SQUOZE 4,.LNKOT +A.LNKOT +SQUOZE 4,.NSTGW +1,,STGWS +SQUOZE 4,.YSTGW +-1,,STGWS +SQUOZE 4,.LIBRQ +A.LIBRQ +SQUOZE 4,.GLOBAL +ILGLI,,A.GLOB +SQUOZE 4,.SCALAR +ILVAR,,A.GLOB +SQUOZE 4,.VECTOR +ILVAR\ILFLO,,A.GLOB + +SQUOZE 4,.BYTC +NBYTS,,INTSYM +SQUOZE 4,.BYTE +A.BYTE +SQUOZE 4,.WALGN +A.WALGN + +;CREF PSEUDO-OPS. +SQUOZE 4,.CRFON +A.CRFN ;START CREFFING. +SQUOZE 4,.CRFOFF +A.CRFFF ;STOP CREFFING. +SQUOZE 4,.CRFIL +CRFILE,,INTSYM + +IFE CREFSW,[ + A.CRFN==ASSEM1 ;THESE DO NOTHING IF CAN'T CREF. + A.CRFFF==ASSEM1 +] + IFN MACSW,[ ;MACRO PROCESSOR PSEUDOS +;MACROS GET DEFINED AS +;SQUOZE 4, +;,, MACCL + +SQUOZE 4,REPEAT +AREPEAT +SQUOZE 4,DEFINE +ADEFINE +SQUOZE 4,IRP +NIRPO,,AIRP +SQUOZE 4,IRPC +NIRPC,,AIRP +SQUOZE 4,IRPS +NIRPS,,AIRP +SQUOZE 4,IRPW +NIRPW,,AIRP +SQUOZE 4,IRPNC +NIRPN,,AIRP +SQUOZE 4,TERMIN +ATERMIN +SQUOZE 4,.QUOTE +A.QOTE +SQUOZE 4,.STOP +(400000)A.STOP +SQUOZE 4,.ISTOP +A.STOP +SQUOZE 4,.RPCNT +CRPTCT,,INTSYM +SQUOZE 4,.GSSET +A.GSSET +SQUOZE 4,.GSCNT +GENSM,,INTSYM +SQUOZE 4,.GO +A.GO +SQUOZE 4,.TAG +A.TAG +SQUOZE 4,.IRPCNT +CIRPCT,,INTSYM +IFN RCHASW,[SQUOZE 4,.TTYMAC +A.TTYM +] +SQUOZE 4,IFSE +SKIPN SCOND +SQUOZE 4,IFSN +SKIPE SCOND +] + +IFN FASLP,[ +SQUOZE 4,.FASL +A.FASL +SQUOZE 4,.ARRAY ;3 INDEX TO AFDMY1 TBL +AFATOM(3) +SQUOZE 4,.ATOM +AFATOM(AFDMAI) ;2 INDEX TO AFDMY1 TBL +AFDMAI==2 ;INDEX OF ATOM IN AFDMY1 TBL +SQUOZE 4,.FUNCT +AFATOM(1) ;1 " " " " +SQUOZE 4,.SPECI +AFATOM(0) ;0 " " " " +SQUOZE 4,.SX +AFLIST(1) ;NORMAL LIST +SQUOZE 4,.SXEVA +AFLIST ;EVAL LIST AND THROW VALUE AWAY +SQUOZE 4,.SXE +AFLIST(2) ;EVAL LIST AND "RETURN" VALUE +SQUOZE 4,.ENTRY +AFENTY ;DECLARE LISP ENTRY POINT (SUBR ETC) +] + IFN TS,[ +SQUOZE 4,.FNAM1 +RFNAM1,,INTSYM +SQUOZE 4,.FNAM2 +RFNAM2,,INTSYM +SQUOZE 4,.INSRT +A.INSRT +SQUOZE 4,.INEOF +A.INEO +IRPS X,,I O +IRPS Y,,1 2 +SQUOZE 4,.!X!FNM!Y +X!FNM!Y,,INTSYM +TERMIN TERMIN +SQUOZE 4,.TTYFLG +A.TTYFLG,,INTSYM +] +IFN .I.FSW,[ +SQUOZE 4,.F +A.F +SQUOZE 4,.I +A.I +] +IFN TSSYMS,[ +IRPS X,,UAI UAO BAI BAO UII UIO BII BIO +SQUOZE 10,.!X +.IRPCN +TERMIN + +IRPS X,Y,START LFILE STP+SYM JCL PFILE STB CONV+XUNAME XJNAME LJB+ + SQUOZE 10,..R!X + .IRPCN+1 +IFSN Y,+,[ + SQUOZE 10,..S!X + 400000+.IRPCN+1 +] TERMIN +] + +EISYMT: PRINTA \.-MACTBA-1, words initialization coding. + VARIAB +IFN .-EISYMT,.ERR Non-empty variables area + +IFE ITSSW,[ + IFGE .-MACTBA-MACL,[ +IFN MACL, PRINTA [MACL too small, set to ]\.-MACTBA + MACL==.-MACTBA +]] + +IFN ITSSW,[ +IFGE .+2400-MACTBA-MACL,.ERR MACL TOO SMALL + LOC <.+1777>&-2000 +MXICLR==./2000 ;FIRST PAGE ABOVE INITIALIZING CODING + LOC &-2000 +MXIMAC==./2000 ;FIRST PAGE ABOVE INITIAL MACTBA +MAXMAC==/2000 + ;1ST PAGE MACRO TABLE CAN'T POSSIBLY USE. +IFLE MINPUR-MAXMAC,.ERR PURE TOO LOW. +PRINTA MINPUR-MAXMAC = ,\MINPUR-MAXMAC +] + +IFN TS,END BEG ;MUST BE BEFORE RELOCATABLE END STATEMENT, + ; SINCE TS MIDAS NOW TRIES TO DO MULTIPLE 1PASS ASSEMBLIES FROM SAME FILE. + ; PUTTING RELOCABLE END STATEMENT FIRST CAUSES IT TO ENCOUNTER OTHER + ; END STATEMENT IN NEW ASSEMBLY CAUSING CONFUSION + +END 100 diff --git a/src/midas/midas.400 b/src/midas/midas.400 new file mode 100644 index 00000000..4f29889f --- /dev/null +++ b/src/midas/midas.400 @@ -0,0 +1,11849 @@ +; -*-MIDAS-*- +IFE .OSMIDAS-SIXBIT/DEC/,.SYMTAB 4003.,2000. ;THIS MANY ON DEC SYSTEM +.ELSE .SYMTAB 8003. ;ELSEWHERE ASSEMBLE FASTER. + +TITLE MIDAS +SUBTTL INITIAL DEFINITIONS + +; AC DEFINITIONS. FF AND P MUST BE 0 AND 17 RESPECTIVELY, OTHERWISE +; ONLY CONSTRAINTS ARE EXPRESSED AS SEQUENTIAL ORDERINGS, E.G. B+1 ETC. +; ALSO, +.SEE R1 + +FF=:0 ; FLAGS. MUST BE AC 0. +AA=:1 ; GENERAL PURPOSE REGS, MUST BE SEQUENTIAL. +A=:AA+1 ; 2 +B=:A+1 ; 3 +C=:B+1 ; 4 +D=:C+1 ; 5 +T=:6 ; NOT SO TEMP AS IN MOST PROGS W/ T +TT=:T+1 ; 7 +I=:10 ; INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF +SYM=:11 ; FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR +LINK=:SYM+1 +F=:13 +CH1=:14 ; MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH +CH2=:CH1+1 ;" " " +TM=:16 ; SUPER TEMPORARY +P=:17 ; PDL AC, MUST BE 17. AS WELL AS RANDOM CROCKS IN PROGRAM, 20X ERCAL + ; ASSUMES P=17. + + +IFDEF .XCREF, .XCREF FF,P,I,A,B,C,D,T + +IF1,[ ;FOR PASS 1 TTY CONDITIONALS +IFDEF SAILSW,IFN SAILSW,DECSW==1 +IFDEF CMUSW,IFN CMUSW,DECSW==1 +IFDEF DECDBG,IFN DECDBG,DECSW==1 +IFDEF DECSW,IFN DECSW,DECSW==1 ? ITSSW==0 ? TNXSW==0 +IFDEF ITSSW,IFN ITSSW,ITSSW==1 ? DECSW==0 ? TNXSW==0 +IFDEF TNXSW,IFN TNXSW,TNXSW==1 ? DECSW==0 ? ITSSW==0 +] ; IF1 +IFNDEF ITSSW,ITSSW==IFDEF .IOT,[1] .ELSE 0 ;NON-ZERO => ITS VERSION +IFNDEF TNXSW,TNXSW==IFDEF GTJFN,[1] .ELSE 0 ;NON-ZERO => TENEX VERSION +IFNDEF DECSW,DECSW==IFDEF LOOKUP,[1-TNXSW] .ELSE 0 ;NON-ZERO => DEC VERSION + ; TNXSW SINCE OLD VERSIONS OF TENEX MIDAS HAD DEC + ; UUO'S DEFINED TOO ONCE UPON A TIME +IF1 IFN ITSSW+DECSW+TNXSW-1,.FATAL So what monitor is MIDAS supposed to run under? +IFNDEF DECDBG,DECDBG==0 ;NON-ZERO => DEC VERSION TO RUN WITH DEC DDT. +IFN DECSW,[ +IFNDEF SAILSW,SAILSW==IFDEF SPCWAR,[1] .ELSE 0 ;NON-ZERO => SAIL VERSION. +IFNDEF CMUSW,CMUSW==IFDEF CMUDEC,[1] .ELSE 0 ;NON-ZERO => CMU VERSION. +] +IFE DECSW,SAILSW==0 ? CMUSW==0 ;CAN'T BE SAIL OR CMU FOR ITS OR TENEX VERSION +IFNDEF SMALSW,SMALSW==DECSW- ;NON-ZERO => SMALL MIDAS (NORMALLY + ; FOR RANDOM DEC SITES ONLY) +IFNDEF DECBSW,DECBSW==IFE DECSW,[0] .ELSE IFN SAILSW,[0] .ELSE SMALSW + ;NON-ZERO => INCLUDE DECBTS +IFN ITSSW\DECSW\TNXSW,TS==1 +IFNDEF TS,TS==1 ;NON-ZERO => TIME-SHARING VERSION +IFE TS,1PASS +IFNDEF A1PSW, A1PSW==TS ;NON-ZERO => 1PASS END-OF-PROGRAM AUTO-REASSEMBLY +IFNDEF BRCFLG, BRCFLG==0 ;NON-ZERO => BRACES { AND } ARE SPECIAL IN MACRO + ; ARGS, ETC. JUST LIKE BRACKETS. BRACES ARE SPECIAL + ; IN CONDITIONALS REGARDLESS OF BRCFLG. +IFNDEF CREFSW, CREFSW==ITSSW ;NON-ZERO => ALLOW C SWITCH TO CAUSE CREF OUTPUT. +IFNDEF LISTSW, LISTSW==1 ;NON-ZERO => ALLOW L SWITCH TO CAUSE A LISTING. +IFNDEF RCHASW, RCHASW==TS ;NON-ZERO => INCLUDE TTY AS POSSIBLE INPUT DEVICE +IFNDEF PURESW, PURESW==TS-SAILSW ;NON-ZERO => SEPARATE PURE CODING FROM IMPURE AND + ; DO PAGE SKIPS. TWO SEGMENTS HURTS EFFICIENCY AT SAIL. +IFNDEF FASLP, FASLP==1-SMALSW ;NON-ZERO => INCLUDE FASL OUTPUT CAPABILITY + ; NOTE!! IF RUNNING UNDER 10/50 THIS MAKES THINGS + ; SEVERAL K BIGGER THAN OTHERWISE. +IFNDEF .I.FSW, .I.FSW==1-SMALSW;NON-ZERO => INCLUDE .I, .F +IFNDEF MACSW, MACSW==1 ;NON-ZERO => INCLUDE MACRO PROCESSOR (!) +IFNDEF RUNTSW, RUNTSW==1 ;NON-ZERO => TYPE OUT RUN TIME AT END OF ASSEMBLY +IFNDEF WRQTSW, WRQTSW==1 ;WRQOTE (MACRO DEFINITION READER) VERSION + ; ^ 0 => SLOW, 1 => FAST; MAYBE 2 WILL EVENTUALLY BE CREATED +IFE TS,IFNDEF MACL,MACL==6*2000 ;MACRO TABLE SIZE +IFN TS,[ +IFN ITSSW,IFNDEF MACL,MACL==6000;DEFAULT MACL SIZE FOR ITS. IF WE HAVE DECBTS OR +IFN TNXSW,IFNDEF MACL,MACL==12*2000 ; TWXBTS, THIS GETS INCREASED, CAUSE THEY ARE HUGE! +IFN DECSW,IFNDEF MACL,MACL==0 ;NON-ITS: WE WANT MACL TO JUST COVER THE INIT CODE. +IFNDEF MXMACL,MXMACL==32.*2000 ;MAXIMUM LENGTH MACTAB +] +IFNDEF MACRUM,MACRUM==4 ;# WORDS NOT USED AT END OF MACTAB +IFNDEF STRL,STRL==20 ;LENGTH OF STRING STORAGE (USED BY GSYL) +IFNDEF DMDEFL,DMDEFL==40 ;MAX NO OF DMY ARGS IN DEFINE +IFNDEF DMYAGL,DMYAGL==400 ;MAX NO COMBINED DMYARGS ALL MACROS CURRENTLY EXPANDING OR PUSHED +IFNDEF MPDLL,MPDLL==300 ;MACRO PDL LENGTH +IFNDEF DSSIZ,DSSIZ==40 ;MAX # ARGS MACRO WHOSE ARGS BEING SCANNED (SHOULD BE .GE. DMDEFL) +IFNDEF BKTABL,BKTABL==40 ;MAX NUM .BEGIN BLOCKS. +IFNDEF BKPDLS,BKPDLS==10 ;MAXIMUM .BEGIN BLOCK NESTING DEPTH. +IFNDEF BSIZE,BSIZE==37 ;PREFERRED SIZE BLOCK MAX SIZE-3 +IFN SMALSW,IFNDEF LPDL,LPDL==200. +IFNDEF LPDL,LPDL==500. ;LENGTH OF PDL +IFN SMALSW,IFNDEF CONMIN,CONMIN==1000 +IFNDEF CONMIN,CONMIN==3300 ;MINIMUM AMT OF SPACE FOR CONSTANTS TABLES. +IFNDEF CONMAX,CONMAX==20000 ;MAXIMUM SPACE USER CAN ASK FOR. +IFNDEF NCONS,NCONS==75. ;MAXIMUM NUMBER OF CONSTANTS AREAS +IFNDEF NVARS,NVARS==25. ;MAX. NUM. VARIABLES AREAS. +IFN SMALSW,IFNDEF SYMDSZ,SYMDSZ==2003. +IFN TNXSW, IFNDEF SYMDSZ,SYMDSZ==4003. ; MUST INCLUDE TONS OF SYSTEM DEFS +IFNDEF SYMDSZ,SYMDSZ==2707. ;DEFAULT # SYMS IN SYMTAB. +IFNDEF SYMMSZ,SYMMSZ==10177*2 ;# SYMS IF JNAME IS MMIDAS. +IFNDEF SYMMAX,SYMMAX==40000 ;MAX SYMTAB SIZE (# SYMS) +IFNDEF FASBL,FASBL==400 ;WORDS USED FOR FASL OUTPUT BUFFER + ; MUST HOLD STUFF ASSOC WITH ONE GROUP OF 9 CODE BYTES +IFNDEF FASATL,FASATL==2000 ;WORDS USED FOR FASL ATOM TABLE + ; HOLDS PNAMES ETC OF ALL ATOMS AS WILL BE IN FASLOAD'S + ; SYMTAB AT LOAD TIME +IFNDEF MINWPS,MINWPS==3 ;MIN # WORDS IN SYMTAB ENTRY +IFNDEF MAXWPS,MAXWPS==3 ;MAX # ALLOWED (WILL BE BIGGER SOME DAY) +IFNDEF NRMWPS,NRMWPS==3 ;DEFAULT #. 2 WDS FOR VALUE & FLAGS, 1 FOR NAME. + +; VERSION, FLAGS, ETC. + +IF1 [ + +IFNDEF MIDVRS,MIDVRS=.FNAM2 +IFE MIDVRS-SIXBIT/MID/,[ +PRINTX /What is MIDAS version number? / +.TTYMAC VRS +MIDVRS=SIXBIT/VRS/ +TERMIN +] + +;OSMIDAS GETS THE SIXBIT NAME OF THE TYPE OF OP. SYS. THE VERSION OF MIDAS +;IS BEING ASSEMBLED TO RUN UNDER. IT WILL BE THE VALUE OF ".OSMIDAS" WHEN PROGRAMS +;ARE ASSEMBLED WITH THIS MIDAS. +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/ + +;FF FLAGS NOT PUSHED +;LEFT HALF +FL==1,,525252 +FLPPSS==400000 ;ONE IF PUNCHING PASS; MUST BE SIGN +FLHKIL==100000 ;ONE IF SYM TO BE SEMI KILLED IN DDT + +FLVOT== 40000 ;ALL RCH S MUST GO THRU RCH + ; IE TYPCTL .NE. POPJ P, (SET/CLEARED BY MDSSET, MDSCLR) +FLMAC== 20000 ;ONE IF CHARS COMING FROM MACRO PROCESSOR, DON'T HACK CPGN/CLNN +FLTTY== 10000 ;ONE IF CHARS FROM SOMEWHERE ELSE BUT NOT HACKING CPGN/CLNN +$FLOUT== 4000 ;ONE IF OUTPUT HAS OCCURED IN CURRENT MODE (USED BY TS NED LOGIC) +FLPTPF== 2000 ;SET IF (TIME SHARING) OUTPUT DEVICE IS PTP +FLUNRD== 1000 ;=> RE-INPUT LAST CHARACTER (SEE RCH) +FL20X==400 ; IN TENEX VERSION, 1= RUNNING ON TOPS-20, 0 = TENEX. + +;FF RIGHT HALF FLAGS + +FR==525252 +FRFIRWD==400000 ;ONE FOR FIRST WORD OF BLOCK +FRSYMS==200000 ;ONE IF SYM PUNCH DESIRED +FRLOC==100000 ;ONE BETWEEN ABS LOC ASSIGN AND + ;FIRST BLOCK OUTPUT THEREAFTER (EBLK TO OUTPUT NULL BLOCK SO LINKING LOADER KNOWS $.) + +FRNPSS==40000 ;ONE IF TWO PASS ASSEMBLY +FRPSS2==20000 ;ONE ON PASS 2 + +FRINVT==4000 ;USED BY PBITS AND OUTPUT TO OUTPUT WORDS OF CODE BITS IN CORRECT ORDER (STEAD LOGICAL) +FRNLIK==2000 ;TEMPORARILY SUPPRESS ADR LINKING +FRGLOL==1000 ;ONE IF LOCATION PLUS OFFSET IS GLOBAL + +FRBIT7==400 ;SET IF LAST TIPLE OF CODEBITS WAS 7. +FRMRGO==200 ;MACRO PROC TO RETURN TO .GO HACKER W/O READING NEXT CHAR (SEE RCHSAV) + +FRCMND==40 ;SET WHILE READING CMD, TELLS RFD TO NOTICE (, _, COMMA. +FRNNUL==20 ;SET ON RETURN FROM RFD IFF NONNULL SPEC. +FRARRO==10 ;TELLS RFD THAT 1ST NAME IS FN1, NOT FN2. +FRFN1==4 ; TELLS RFD THAT 1ST NAME WAS READ. + + + ; FLAGS TO ZERO AT BEGINNING OF PASS 1 ONLY, BY $INIT. +FFINIT==<-1-FLVOT-FLPTPF-FLTTY-FL20X,,-1> + +] ;END IF1 + +;INDICATOR REGISTER + +IF1 [ + +;LEFT HALF +IL==1,,525252 +ILGLI==1 ;SET ON " CLEARED EACH SYL +ILVAR==2 ;SET ON ' " " " +ILFLO==4 ;FLOATING NUM, SET ON DIGIT AFTER . +ILDECP==10 ;DECIMAL PREFER, SET WHEN . SEEN. +ILUARI==20 ;1 => RIGHT OPERAND TO UPARROW BEING READ +ILLSRT==40 ;RETURN FROM < +ILWORD==400 ;SET IF CURRENT WORD IS NOT NULL RETURNED BY GETWORD +ILNPRC==1000 ;ONE IF NUMBER ALREADY PROCESSED BY UPARROW +ILMWRD==4000 ;SET ON MULTIPLE WORD +ILPRN==10000 ;SET DURING MACCL IF MACRO NAME WAS FOLLOWED BY (. +ILMWR1==20000 ;SET BY LBRAK AS SIGNAL TO ITSELF THAT THIS NOT FIRST + ;WORD OF MULTI-WORD CONSTANT +ILNOPT==40000 ;CONSTANTS OPTIMIZATION SUPPRESSION FLAG; SHOULD BE SET BY + ;VALUE-RETURNING PSEUDO DURING NOT PUNCHING PASS TO KEEP ITSELF OUT OF + ;CONSTANTS OPTIMIZATION + +;RIGHT HALF + +IR==525252 +IRFLD==1 ;SET IF FLD NOT NULL +IRSYL==2 ;SET IF SYL NOT NULL +IRLET==4 ;SET IF SYL IS SYMBOL +IRDEF==10 ;SET IF CURRENT EXPR DEFINED +IRNOEQ==20 ;SET IF = ISN'T ALLOWED IN CURRENT CONTEXT. +IRCOM==40 ;SET IF CURRENT QUAN IS COMMON +IRPERI==100 ;SET IF PERIOD SEEN IN WHAT IS SO FAR (INCL .) A NUMBER +IREQL==200 ;ONE DURING READING WORD TO RIGHT OF = +IRIOINS==400 ;FIRST FIELD OF CURRENT WORD HAS IO INST +IRCONT==1000 ;SET IF NOT OK TO END BLOCK +IRPSUD==4000 ;SET IF ERROR COMMENTS WILL COME FROM PSEUDO +IRGMNS==20000 ;SET IF ILUARI OR BAKARI HAS GOBBLED MINUS +IROP==200000 ;SET IF OPERATOR SEEN IN CURRENT FIELD + +CALL==PUSHJ P, +RET==POPJ P, +;SAVE=PUSH P, ;DON'T USE SAVE! IT'S A JSYS ON TENEX AND TWENEX +REST==POP P, +PJRST==JRST ; FOR JRST'ING TO A POPJ'ING ROUTINE. + +ETSM=1000,, ;ERROR, TYPE SYM. +ETR=2000,, ;ERROR, ORDINARY MESSAGE. +ERJ=3000,, ;ERROR, NO MESSAGE, RETURN TO ADDR. +ETI=4000,, ;ERROR, IGNORE LINE, RET. TO ASSEM1. +ETA=5000,, ;ERROR, RET. TO ASSEM1. +ETASM=6000,, ;ERROR, TYPE SYM AND RETURN TO ASSEM1 +ETF=7000,, ;FATAL ERROR. +TYPR=(37000) ;UUO, TYPE OUT ASCIZ STRING +TYPCR=(36000) ; LIKE TYPR BUT ADDS CR AT END. +] ;END IF1 + +IF1 [ +;LINK TABLE (GLOTB), ACCUMULATES GLOBAL REFERENCES FOR CURRENT FROB (USUALLY WORD) TO OUTPUT +;GLSP2 POINTS TO (I.E. HAS ADR 1 LESS THAN) BOTTOM OF ACTIVE PART OF TABLE +;GLSP1 POINTS TO TOP (HAS ADR OF LAST ENTRY ACTIVE) + +;ACTUAL ENTRIES IN GLOTB: +;IF ENTIRE WORD ZERO, ENTRY IS NULL, WILL (OR SHOULD) BE IGNORED +;RH ADR OF SQUOZE WITH INTERNAL MIDAS FLAGS (USUALLY IN SYMBOL TABLE, BUT MAY BE ANYWHERE IN CORE) +;LH: RIGHT 10. BITS MULTIPLICATION FACTOR OR 0 => 1 + ;GLOBAL SHOULD BE MULTIPLIED BY IT +;REST OF LH FLAGS: + +;SIGN BIT => THIS NOT PART OF FIELD, DON'T PLAY WITH FLAGS AT GETFLD, INTFD +ACF==40000 ;AC LOW OR HIGH (SWAPF => HIGH) +HFWDF==100000 ;MASK GLOBAL TO HALFWORD +SWAPF==200000 ;SWAP +MINF==20000 ;NEGATIVE OF GLOBAL + +IFNDEF LBRKT,LBRKT=="[ ;LEFT DELIMITER FOR EXPLICITLY GROUPED CONDITIONALS, MACRO ARGS, REPEAT BODY, ETC. +IFNDEF RBRKT,RBRKT=="] ;RIGHT " +IFNDEF WPS, WPS==3 ;# CONTIG. WDS /STE. IFNDEF FOR DEBUGGING. +IFNDEF BKWPB,BKWPB==3 ;# WDS/BKTAB ENTRY. +IFNDEF EOFCH,EOFCH==3 ;EOF CHAR, BEWARE DISPATCH TABLE ENTRIES. +IFNDEF LBRACE,LBRACE==173 +IFNDEF RBRACE,RBRACE==175 + +;3RDWRD LH. SYM TAB BITS + +3REL==600000 ;RELOC BITS, DO NOT CHANGE, SOMETIMES REFERENCED BY NUMERIC BYTE POINTERS +3RLL==400000 ;R(LH) +3RLR==200000 ;R(RH) +3RLNK==100000 ;R(LINK) +3KILL==40000 ;FULLY-KILLED SYM (DON'T GIVE TO DDT). +3VP==20000 ;VALUE PUNCHED +3SKILL==10000 ;SEMI KILL IN DDT +3LLV==4000 ;LINKING LOADER MUST INSERT VAL +3VAS2==2000 ;VAR SEEN ON PASS TWO WITH ' +3VCNT==1000 ;USED IN CONSTANT +3MAS==400 ;THIS ISN'T THE LAST DEFINITION OF A SYM WITH THIS NAME + ;(SO ES MUST KEEP SEARCHING). +3NCRF==200 ;DON'T CREF THIS SYMBOL. +3MACOK==100 ;OK TO (RE)DEFINE THIS SYM AS MACRO. + ;(IE IS A MACRO OR SEEN ONLY IN .XCREF) +3LABEL==40 ;ILLEGAL TO REDEFINE THIS SYM TO DIFFERENT VALUE +3MULTI==20 ;THIS SYM IS MULTIPLY DEFINED, SO FLAG ALL DEFINITIONS. +3DOWN==10 ;THIS DEFINITION SHOULD BE SEEN BY SUBBLOCKS IN 1PASS MODE. + +3DFCLR==737110 ;BITS IN LH TO CLEAR ON REDEFINITION. + +; FLAGS IN "CONTROL" VARIABLE +.SEE CONTRL + ;LEFT HALF +TRIV==400000 ; 1 IF OUTPUT FORMAT IS FOR TRIVIAL LOADER (ABSOLUTE) + ; ELSE RELOCATABLE (NOTE THIS CROCKISHLY ONLY MEANS + ; STINK FORMAT, SINCE DEC RELOC FORMAT HAS THIS FLAG SET) + + ;RIGHT HALF +ARIM== 2 ; 1 => OUTPUT FORMAT IS RIM +SBLKS== 10 ; 1 => OUTPUT FORMAT IS SBLK (SIMPLE BLOCKS) +ARIM10== 20 ; 1 => OUTPUT FORMAT IS PDP-10 RIM +DECREL== 40 ; 1 => DEC RELOCATABLE FORMAT (CONSIDERED "ABSOLUTE" INSIDE MIDAS) +FASL== 100 ; 1 => LISP FASL COMPATIBLE RELOCATABLE FORMAT ( " " ") +DECSAV==200 ; 1 => DEC SAV FORMAT (ABSOLUTE) ALSO WINS ON 10X, 20X + +PTR==104 ;DEVICE CODE FOR PAPER TAPE READER. + +] ;END IF1 + +IF1 [ + +;SQUOZE FLAG DEFINITIONS IN MIDAS SYMBOL TABLE + +CMMN==0 ;COMMON (NOT USED) +PSUDO==40000 ;PSEUDO OR MACRO, VALUE RH ADDR OF RTN (MACCL FOR MACRO), + ; LH WILL BE IN LH OF B WHEN RTN CALLED. +SYMC==100000 ;SYM, VALUE IS VALUE OF SYM. +LCUDF==140000 ;LOCAL UNDEF +DEFLVR==200000 ;DEF LOC VAR, VALUE IS VALUE. +UDEFLV==240000 ;UNDEF LOC VAR, VALUE IS 1+ IDX IN VARIAB. AREA, BUT IGNORD IF VAR AREA GLOB. +LGBLCB==300000 ;CODE BITS EQUAL TO THIS OR HIGHER REPRESENT GLOBAL QUANTITIES +DEFGVR==300000 ;DEF GLO VAR, VALUE IS VALUE +UDEFGV==340000 ;UNDEF GLO VAR, VALUE LIKE UNDEF LOCAL VAR. +GLOETY==400000 ;GLO ENTRY +GLOEXT==440000 ;GLO EXIT +NCDBTS==GLOEXT_<-18.+4>+1 ;# CODE BIT TYPES + +DEFINE CDBCHK TBLNAM +IFN .--NCDBTS,.ERR TBLNAM LOSES +TERMIN + +;LOADER BLOCK TYPES LINK +LLDCM==1 ;LOADER COMMAND BLOCK +LABS==2 ;ABSOLUTE +LREL==3 ;RELOCATABLE +LPRGN==4 ;PROG NAME +LLIB==5 ;LIBRARY BLOCK +LCOMLOD==6 ;LOAD INTO COMMON +LGPA==7 ;GLOBAL PARAMETER ASSIGN +LDDSYM==10 ;LOCAL SYMS +LTCP==11 ;LOAD TIME COND ON PRESENCE +ELTCB==12 ;END LOAD TIME COND +LPLSH==22 ;POLISH FIXUP + +;LOADER COMMANDS +;IN ADR OF LDCMD BLK +LCJMP==1 ;JUMP +LCGLO==2 ;GLOBAL LOC ASSIGN +LCCMST==3 ;SET COMMON BENCHMARK +LCEGLO==4 ;END OF GLOBAL BLOCK +LDCV==5 ;LOAD TIME COND ON VALUE +LDOFS==6 ;LOADER SET GLOBAL OFFSET +LD.OP==7 ;LOADER .OP + +;LOADER CODEBITS SECOND SPEC AFTER 7 +CDEF==0 ;DEF +CCOMN==1 ;COMMON REL +CLGLO==2 ;LOC-GLO REC +CLIBQ==3 ;LIBREQ +CRDF==4 ;GLO REDEF +CRPT==5 ;REPEAT GLOBAL VALUE +CDEFPT==6 ;DEFINE SYM AS $. + +;DEC RELOCATABLE BLOCK TYPES. +DECWDS==1 ;STORAGE WORDS. +DECSYM==2 ;SYMBOL DEFS OR GLOBAL ADDITIVE RQS. +DECHSG==3 ;LOAD INTO HIGH SEG (FOR .DECTWO) +DECENT==4 ;ENTRY NAMES +DECEND==5 ;END BLOCK, HAS PROGRAM BREAK. +DECNAM==6 ;PROGRAM NAME. +DECSTA==7 ;STARTING ADDRESS BLOCK. +DECINT==10 ;INTERNAL REQUEST +DECRQF==16 ;REQUEST LOADING A FILE +DECRQL==17 ;REQUEST LOADING A LIBRARY +] ;END IF1 + +IF1 [ + +DEFINE TYPE &STR +TYPR [ASCIZ STR] +TERMIN + +DEFINE TYPECR &STR +TYPCR [ASCIZ STR] +TERMIN + +DEFINE PRINTA A,B,C,D,E,F +IF1,[PRINTC ~A!B!C!D!E!F +~] +TERMIN + +IF1 [DEFINE BNKBLK OP +OP +TERMIN ] + + ;ADD A LINE TO BNKBLK, ACCUMULATED CONTENT OF + ;WHICH IS DUMPED OUT AT END OF ASSEMBLY + ;ARG TO BLCODE SHOULD BE FREE OF STORAGE WORDS + +DEFINE BLCODE NEWCFT +IF1 [BNKBLK [DEFINE BNKBLK OP +OP]NEWCFT +TERMIN ] +IF2 [IRPW X,,[ +NEWCFT +] +IRPS Y,,X +Y=Y +.ISTOP TERMIN TERMIN ] TERMIN + + ;3RDWRD MANIPULATING MACROS + ;GET 3RDWRD INTO LH("A"), "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3GET A,B + MOVE A,ST+2(B) + TERMIN + + ;GET 3RDWRD INTO "A", "B" HAS ADR OF 1STWRD + +DEFINE 3GET1 A,B + MOVE A,2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3PUT A,B + MOVEM A,ST+2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS ADR OF 1STWRD + +DEFINE 3PUT1 A,B + MOVEM A,2(B) + TERMIN + +] ;END IF1 + +;RANDOM MACRO DEFINITIONS + +IF1 [ + + ;A HAS ADR OF SYM SQUOZE, SKIP IF IT'S IN SYMBOL TABLE + +DEFINE SKPST A + CAIL A,ST + CAML A,MACTAD +TERMIN + + ;EXECUTE AN INSTRUCTION WITH VARIOUS ADDRESSES (USUALLY PUSH OR POP) + +DEFINE INSIRP A,B + IRPS %ADR,,[B] + A,%ADR + TERMIN +TERMIN + +DEFINE NOVAL + TDNE I,[ILWORD,,IRNOEQ\IRFLD] + ETSM ERRNVL +TERMIN + +DEFINE NOABS + SKIPGE CONTRL + ETASM ERRABS +TERMIN + +] ;END IF1 + +ERRNVL==[ASCIZ /Returns no value/] +ERRABS==[ASCIZ /Allowed only for STINK relocatable format/] + +IF1 [ + +DEFINE MOVEIM B,C + MOVEI A,C + MOVEM A,B +TERMIN + +DEFINE MOVEMM B,C + MOVE A,C + MOVEM A,B +TERMIN +] ;END IF1 + +IF1 [ +IFN 0,[ +;THESE ARE SOME MACRO DEFINITIONS FOR THE UNFINISHED MULTI-WORD +;SYMBOL NAME FEATURE. FOR COMPATIBILITY, THEY ALL NOW HAVE DEFINITIONS +;THAT ONLY HANDLE ONE WORD. THOSE OTHER DEFINITIONS COME AFTER THESE. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +IFSN X,SYM,SKIPE A,X+1 +.ELSE SKIPE A,SYMX + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y + MOVE Z,X+1 + MOVEM Z,Y+1 +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y + MOVE Z,AC!X + MOVEM Z,Y+1 +TERMIN +] + +.ELSE [ +;THESE ARE THE DEFINITIONS OF THE MACROS THAT DO NOT IMPLEMENT +;MULTI-WORD SYMBOL NAMES. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y +TERMIN +] + +DEFINE USING X +X,TERMIN + +] ;END IF1 + +SUBTTL DEFINE SYS DEPENDENT SYMBOLS & SELECT OUTPUT FORMAT + +; THIS DEFSYM MACRO IS FOR COMPILING MIDAS ON ANOTHER OPERATING SYSTEM. THIS +; AVOIDS SAME-NAME SCREWS (IE, "LOCK" IS SOMETHING DIFFERENT ON TWENEX, SAIL, +; AND DEC). + +IF1 [ +DEFINE DEFSYM X/ + IRPS Z,,[X] + EXPUNGE Z + .ISTOP + TERMIN + X +TERMIN +]; IF1 + +IFN DECSW\TNXSW,[ +IF1 [ +IFE .OSMIDAS-SIXBIT/ITS/,[ + IFE CMUSW\SAILSW\TNXSW,.INSRT SYS:DECDFS + IFN SAILSW, .INSRT SYS:SAIDFS + IFN CMUSW, .INSRT SYS:CMUDFS + IFN TNXSW, .INSRT SYS:TNXDFS +] ;IF ASSEMBLED ON ITS +IFN .OSMIDAS-SIXBIT/ITS/,[ ;OTHER PLACES DON'T KEEP THESE ON SYS: + IFE CMUSW\SAILSW\TNXSW,.INSRT DECDFS + IFN SAILSW, .INSRT SAIDFS + IFN CMUSW, .INSRT CMUDFS + IFN TNXSW, .INSRT TNXDFS +] ;IF ASSEMBLED ON A NON-ITS PLACE + +IFN TNXSW,[ ; AC DEFS FOR DIRECT REFERENCE TO JSYS ARGS +R1==:1 ; SOMEDAY MAYBE THE SYMBOLS A,B ETC WILL CORRESPOND... +R2==:2 +R3==:3 +R4==:4 +R5==:5 +] +IFN DECSW,.DECDF DEFSYM + +IFN TNXSW,[.TNXDF DEFSYM +IFNDEF .PRIIN,.INSRT TWXBTS +] + +EXPUNGE HALT +DEFINE HALT + JRST 4,. +TERMIN + +EXPUNGE .VALUE +EQUALS .VALUE HALT + +DEFINE .LOSE A + JRST 4,.-1 +TERMIN +] ;IF1 + +IFN DECSW,[ ; SELECT OUTPUT FORMAT FOR DEC VERSION +IFN PURESW,.DECTWO +IFE PURESW,.DECREL + RL0==. +] +IFN TNXSW,[ ; SELECT OUTPUT FORMAT FOR TNX VERSION + .DECSAV + RL0==0 +] +] ;IFN DECSW\TNXSW + +IFN ITSSW,[ +IF1 [IFNDEF .IOT,[.INSRT SYS:ITSDFS + .ITSDF DEFSYM + ] ;IFNDEF .IOT +IFNDEF %PIPDL,.INSRT SYS:ITSBTS + HALT==.VALUE + EXPUNG .JBTPC,.JBCNI + +DEFINE SYSCAL A,B + .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] +TERMIN +] ;IF1 + +IFDEF .SBLK,.SBLK ; SELECT OUTPUT FORMAT FOR ITS VERSION + RL0==0 +] ;IFN ITSSW + +IFE PURESW,[ ;FOLLOWING IF NOT ASSEMBLING PURE CODING + +DEFINE PBLK +TERMIN + +DEFINE VBLK +TERMIN +] + +IFN PURESW,[ ;FOLLOWING IF ASSEMBLING PURE CODING + +;MEMORY ORGANIZATION PURE CODING + +;MAXVAR BLOCKS OF IMPURE CODING, NO DYNAMIC ALLOCATION + ;BLCODE MACRO ACCUMULATES CODING TO BE PUT AT END OF + ;IMPURE CODING, NO STORAGE WORDS ALLOWED +;THEN SYM TAB, STARTING AT ST. +;THEN MACRO TABLE (WITH INIT. CODE IN IT) +;STARTING INITIALLY AT MACTBA, ACTUAL ADDR IN MACTAD. +;SYMTAB AND MACTAB DON'T NECESSARILY START ON PAGE BNDRYS. +;THEN GAP TO MINPUR*2000 (HEREAFTER KNOWN AS "THE GAP") + +IFN DECSW\TNXSW,MINPUR==200 +IFN ITSSW,MINPUR==160 ;BLOCK NUMBER BEGINNING OF PURE CODING + +;PURE CODING UNTIL MAXPUR*2000-SOMETHING +;THE FOLLOWING MACROS AND BLCODE MAKE IT NOT COMPLETELY NECESSARY +;TO SEPARATE PURE CODING FROM IMPURE + +CKPUR==0 ;0 => ASSEMBLING BELOW THE GAP, 1 ABOVE + + ; PBLK - SWITCH TO CODING ABOVE THE GAP +DEFINE PBLK +IFN CKPUR,.ERR PBLK +IFE CKPUR,[VAR.LC==. +LOC PUR.LC +]CKPUR==1 +TERMIN + + ; SET INITIAL LOCATION COUNTER FOR ASSEMBLING PURE CODE ABOVE GAP. +IFN ITSSW\TNXSW, PUR.LC==MINPUR*2000 +IFN DECSW, PUR.LC==MINPUR*2000+RL0 + + ; VBLK - SWITCH TO CODING BELOW THE GAP +DEFINE VBLK +IFE CKPUR,.ERR VBLK +IFN CKPUR,[PUR.LC==. +LOC VAR.LC +]CKPUR==0 +TERMIN + +PBLK ;PBLK NORMAL MODE, VARIABLE AREAS BRACKETED WITH VBLK AND PBLK + +] ;END PURESW CONDITIONAL + +.YSTGW ;SET UP NOW, STORAGE WORDS OK + +FOO==. +LOC 41 + JSR ERROR +IFN ITSSW,JSR TSINT +IFN DECSW,[ +LOC .JBAPR + TSINT1 +] +LOC FOO + + ;DISPATCH TABLE FOR NON-SQUOZE CHARACTERS + ;REFERENCED AS DTB-40(RH OF POPJ IN GDTAB) + ;DTB ENTRY OF SYL TERMINATOR PUT IN CDISP BY GETSYL + +DSYL==400000 ;SYL OPERATOR, DISPATCH INDEXED BY RH AT GETSYL (MUST BE SIGN) +DFLD==200000 ;FIELD OPERATOR, GETFD +DWRD==100000 ;WORD OP, GETWD +DSY1==1000 ;SET ONLY IF DSYL SET, + ;SET IF OP MIGHT BE 1ST CHAR OF NONNULL SYL. +DSYL1==DSYL+DSY1 +DSY2==400 ;SET FOR _ ONLY. + +;ALL CLEAR => WORD TERMINATOR, NO DISPATCH + +DTB: DWRD,,SPACE ;40 SP, TAB, RUBOUT + DSYL1,,RRL2 ;EXCLAIM AND OPEN-BRACE + DSYL1,,DQUOTE ;" + DFLD,,XORF ;NUM SIGN + DSYL,,RBRAK2 ;CLOSE-BRACE. + 0 ;(USED TO BE PERCENT SIGN) + DFLD,,ANDF ;AMPERSAND + DSYL1,,SQUOTE ;' + DFLD,,LEFTP ;( 50 + DSYL,,RPARN ;) + DFLD,,MULTP ; STAR TIMES + DFLD,,PLS ;+ PLUS + DWRD,,COMMA ; , + DFLD,,MINUS ;- + DSYL1,,CTLAT ;^@ (56) + DFLD,,DIVID ;/ + DSYL1,,COLON ;COLON 60 + DSYL,,SEMIC ;SEMI + DFLD,,LSSTH ;< + DSYL1,,EQUAL ;= + DSYL,,GRTHN ;> + 0 ;? + DSYL1,,ATSGN ;AT SIGN + DFLD,,LBRAK ;[ + DFLD,,IORF ;BACKSLASH 70 + DSYL,,RBRAK ;] + DSYL1,,UPARR ;^ + DSYL+DSY2,,BAKAR ;BACKARR + 0 ;CR + 0 ;(USED TO BE TAB) + 0 ;ALL OTHER + DSYL,,LINEF ;LF (DSYL TO HACK CLNN) + DSYL,,FORMF ;FORM FEED (") 100 + +;NOTE THAT POPJ P, IS VALID TEST FOR SQUOZENESS +;EXCEPT FOR EOFCH + +GDTAB: POPJ P,56 ; ^@ GETS IGNORED. + REPEAT 2,POPJ P,76 ;(GDTAB GLOBAL SO OUT OF TS, AIO CAN CLOBBER GDTAB+141 WITH JRST RREOF + ;ON OLD FILES) +IFN .-GDTAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH GDTAB. +IFE TS,[POPJ P,76] IFN TS,[JRST RREOF] + REPEAT 5,POPJ P,76 + POPJ P,40 ; TAB + POPJ P,77 ; LF + POPJ P,76 ; VERT TAB + POPJ P,100 ; FORM FEED + POPJ P,74 ; CR + REPEAT "!-16-1,POPJ P,76 + POPJ P,40 ; SPACE + POPJ P,41 ; ! + POPJ P,42 ; " + POPJ P,43 ; # + ADD SYM,%$SQ(D) ; $ + ADD SYM,%%SQ(D) ; % + POPJ P,46 ; & + POPJ P,47 ; ' + POPJ P,50 ; ( + POPJ P,51 ; ) + POPJ P,52 ; * + POPJ P,53 ; + + POPJ P,54 ; , + POPJ P,55 ; - + JSP CH1,POINT ; . + POPJ P,57 ; / + REPEAT 10.,JSP CH2,RR2 ; DIGITS + POPJ P,60 ; : + POPJ P,61 ; ; + POPJ P,62 ; < + POPJ P,63 ; = + POPJ P,64 ; > + POPJ P,65 ; ? + POPJ P,66 ; @ +IFDEF .CRFOFF,.CRFOFF +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN + POPJ P,67 ; [ + POPJ P,70 ; \ + POPJ P,71 ; ] + POPJ P,72 ; ^ + POPJ P,73 ; _ + POPJ P,76 ; NOW LOWER CASE GRAVE ACCENT + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN +IFDEF .CRFON,.CRFON + POPJ P,41 ;{ + POPJ P,76 ;| + POPJ P,44 ;} + POPJ P,76 ;~ + POPJ P,40 ; RUBOUT, LIKE SPACE + IFN .-GDTAB-200,.ERR GDTAB LOSES + +NSQTB: IFDEF .CRFOFF,.CRFOFF +IRPC Q,,0123456789 + ADD SYM,%!Q!SQ(D) +TERMIN + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890$%. +%!Q!SQ: 0 + SQUOZE 0,Q/50/50/50/50/50 + SQUOZE 0,Q/50/50/50/50 + SQUOZE 0,Q/50/50/50 + SQUOZE 0,Q/50/50 + SQUOZE 0,Q/50 + SQUOZE 0,Q +TERMIN +IFDEF .CRFON,.CRFON + +;FORMAT TABLE(S) +;4.9-4.4 ETC SPECIFY SHIFT +;4.4-3.6 ETC SPECIFY NUMBER BITS +;FIELD SPECS IN REVERSE ORDER + +IFORTB: 0 ;NCNSN 10 , + 0 ;NCNSF 11 IMPOS + 0 ;NCNCN 12 ,, + 2200,, ;NCNCF 13 ,,C + 2200000000 ;NCFSN 14 ,B + 0 ;NCFSF 15 ,B C + 0 ;NCFCN 16 ,B, + 0 ;NCFCF 17 ,B,C + 4400000000 ;FSNSN 20 A + 0 ;FSNSF 21 IMPOS + 0 ;FSNCN 22 IMPOS + 0 ;FSNCF 23 IMPOS + 2200440000 ;FSFSN 24 A B + 2200220044 ;FSFSF 25 A B C + 270400440000 ;FSFCN 26 A B, + 2227040044 ;FSFCF 27 A B,C + 4400000000 ;FCNSN 30 A, + 0 ;FCNSF 31 IMPOS + 22220000 ;FCNCN 32 A,, + 2200002222 ;FCNCF 33 A,,B + 2200440000 ;FCFSN 34 A,B + 0 ;FCFSF 35 A,B C + 0 ;FCFCN 36 A,B, + 0 ;FCFCF 37 A,B,C +FRTBL==.-IFORTB ;LENGTH OF FORMAT TABLE +VBLK +FORTAB: BLOCK FRTBL ;ACTUAL FORMAT TABLE +FRTBE=.-1 +PBLK + +;VARIABLE STORAGE + +VBLK + +RETURN: JRST . ;RH HAS RETURN ADR FOR END OF MAJOR ROUTINE (E.G PASS 2) +CDISP: 0 ;CURRENT DISPATCH CODE +PPRIME: 0 ;PUSH DOWN LIST MARKER (GETFLD) +SCNDEP: 0 ;DEPTH IN SUCCESSFUL BRACKET CONDITIONALS INSIDE INNERMOST LITERAL. +CONDLN: 0 ;LINE NUMBER AT WHICH LAST TOP LEVEL SUCCESSFUL CONDITIONAL ENCOUNTERED +CONDPN: 0 ;PAGE NUMBER-- PRINT THESE IF REACH END AND CONDITIONAL NOT TERMINATED +CONDFI: 0 ;SIXBIT FN1 OF FILE CONTAINING LAST TOP LEVEL SUCCESSFUL CONDITIONAL. +A.SUCC: 0 ;NONZERO IFF LAST CONDITIONAL SUCCEEDED. +ASMOUT: 0 ;0 NORMAL, 1 WITHIN <>, 2 IN (), 3 IN []. +ASMDSP: ASSEM3 ;PLACE TO JUMP TO FROM ASSEM1 LOOP. + ;ASSEM3 NORMAL. ASSEMC IF WITHIN <>, () OR [] + ;AND .MLLIT ISN'T POS. LSSTHA AFTER > OR ) SEEN. + ;[ ;CONND AFTER ] SEEN. +ASMDS1: 0 ;ASMDSP SAVED HERE DURING ASCII, SIXBIT PSEUDOS. +ASSEMP: 0 ;RESTORE P FROM HERE AT ASSEM1. SAVED OVER LITERAL. +ASMI: 0 ;REINIT I AT ASSEM2 FROM ASMI. +GLSPAS: 0 ;RESTORE GLSP1 AT ASSEM1. SAVED OVER LITERAL. +GLSP1: 0 ;POINTER TO BOT OF LINKAGE TABLE IN USE HIGH ADR +GLSP2: 0 ;POINTER TO TOP OF LINKAGE TABLE IN USE LOW ADR +FORMAT: 0 ;ACCUMULATES FORMAT WORD +FORPNR: 0 ;POINTER INTO FORMAT WORD, SHOULD BE FORMAT+1 SO CLOBBERABLE BY LAST IDPB +FLDCNT: 0 ;NUMBER OF FIELDS PUSHED DOWN IN CURRENT WORD +WRD: 0 ;ACCUMULATES VALUE OF WORD +WRDRLC: 0 ;RELOC OF WRD, MUST COME RIGHT AFTER WRD. +T1: 0 ;TEMP +T2: 0 ;TEMP +PBITS1: 0 ;CURRENT CODE BITS +PBITS2: 0 ;NO OF SPECS LEFT IN CURRENT WORD +PBITS4: 0 ;POINTER TO WHERE CURRENT CODE BITS WILL GO +OPT1: 0 ;POINTER FOR STORING IN BKBUF (OUTPUT BUFFER) +CONTRL: 0 ;FLAG REG FOR IO CONTROL ETC, .GE. 0 => RELOCATABLE/1PASS +CDATBC: 0 ;CURRENT DATA BLOCK CODE TYPE +SCKSUM: 0 ;CKSUM FOR SIMPLE BLOCK FORMAT +IFN A1PSW,[ +PRGC: -1 ;ONE LESS THAN # TIMES END HAS BEEN ENCOUNTERED +OUTN1: -1 ;.GE. 0 => OUTPUT HAS OCCURED IN OTHER THAN 1PASS MODE (NOT INITIALIZED) +OUTC: -1 ;.GE. 0 => OUTPUT HAS OCCURED DURING CURRENT ASSEMBLY +] +LINKL: 0 ;SAVE LIMIT OF GLOTB GETWRD +STRCNT: 0 ;COUNT OF CHARS READ (INCL. DELIM) BY GSYL +STRPNT: 0 ;TEMP AT GSYL, BYTE POINTER TO STRING STORAGE +ISYMF: -1 ;-1 IF ISYMS HAVE NOT BEEN SPREAD +SMSRTF: -1 ;-1 IF SYMTAB HASN'T BEEN SORTED (PSEUDOS DELETED) +BITP: 0 ;BYTE PNTR TO CODE BITS IN CURRENT (RELOC) BLOCK +LDCCC: 0 ;DEPTH IN LOADTIME CONDS +PARBIT: 0 ;0 OR 4 FOR : OR = (IN GENERAL, TEMP AT P7X) +LABELF: 0 ;-1 IN COLON, SOMETIMES IN EQUAL. CAUSES 3LABEL TO BE SET. +STGSW: 0 ;NON ZERO GIVES ERROR PRINT ON STORAGE WORDS +HKALL: 0 ;NONZERO => HALF-KILL ALL LABELS (.HKALL'S VALUE) +LITSW: 0 ;-1 => USING A LITERAL GIVES AN ERROR +QMTCH: 0 ;-1 => ' AND " NEED MATCHING CLOSINGS (A LA FAIL, MACRO-10) +STARTA: 0 ;STARTING ADDRESS FOR SBLK, RIM, DECSAV +DECSYA: 0 ; ADDRESS TO LOAD SYMBOLS AT (FOR DECSAV FORMAT) +DECBRK: 0 ;LARGEST RELOC. ADDR. LOADED INTO. (USED FOR DEC FMT) +DECBRA: 0 ;LARGEST ABS. ADDR LOADED INTO. +DECBRH: 0 ;LIKE DECBRK BUT FOR ADDRS IN HI SEG. +DECTWO: MOVE ;NOT = MOVE => .DECTWO WAS DONE, AND THIS WD HAS + ;ADDR START OF HISEG. +ISAV: 0 ;I FROM FIELD AT AGETFLD +A.PASS: 0 ; .PASS INTSYM, # OF THIS PASS. +A.PPAS: 0 ;.PPASS INTSYM, # OF PASSES. +WPSTE: NRMWPS ;# WORDS PER SYMTAB ENTRY +WPSTE1: NRMWPS-1;ONE LESS THAN WPSTE - FOR SPEED. +WPSTEB: ,-NRMWPS(B) ;RH HAS - # WORDS PER SYMTAB ENTRY; LH HAS INDEX OF B. +SYMSIZ: 0 ;#WDS IN SYMTAB = WPS* +SYMLEN: SYMMSZ ;SYMTAB SIZE (# SYMS) + ;ASSEMBLED-IN VALUE USED AS DEFAULT, ONLY IF NON-TS. +SYMAOB: 0 ;-<# SYMS>,,0 +INICLB: 0 ;-1 IF INITIALIZATION CODE CLOBBERED. +TTYINS: 0 ;AT START OF ASSEMBLY, -1 => .INSRT TTY PASS1, -2 => PASS2 ALSO. +IFN FASLP,[ +FASBP: 0 ;PNTR TO FASL OUTPUT BUFFER +FASATP: 0 ;PNTR TO FASL ATOM TABLE +FASAT1: 0 ;PNTR TO FASL ATOM TABLE AFTER READING IN NEW ATOM + ; (MAYBE UPDATE FASATP TO THIS IF ATOM WAS UNIQUE9 +FASAT2: 0 ;BYTE PNTR USED TO STORE ATOM IN +FASIDX: 0 ;INDEX NEXT ATOM LOADED INTO FASAT WILL BE +FASPCH: 0 ;AMOUNT OF FASAT "PUNCHED" +FASCBP: 440400,,FASB ;BYTE PNTR TO FASL CODE BIT WORD +FASPWB: 0 ;FASL CODE AT PWRD +FASBLC: 0 ;LOSING BLOCK "COUNT" +FASBLS: 0 ;LOSING BLOCK "SYMBOL" +AFRLD: 0 ;LIST READ CURRENT DEPTH +AFRLEN: 0 ;LIST READ CURRENT LENGTH +AFRDTF: 0 ;LIST READ DOT CONTEXT FLAG (0 NORMAL, 1 SAW DOT, 2 SAW "FROB AFTER DOT" +AFRFTP: 0 ;LIST READ SAVED STATE OF FASATP +AFLTYP: 0 ;TYPE LIST OP IN- 0 EVAL AND THROW AWAY VALUE + ;1 "RETURN" LIST + ;2 "RETURN" VALUE OF LIST +] +PBLK + +;INFO CONVENIENT TO ANYONE GENERATING AN OUT OF TIME-SHARING MIDAS + +;MIDAS OUT OF TIME-SHARING ASSEMBLES INTO A COLLECTION OF SUBROUTINES +;IO IS EXPECTED TO BE HANDLED BY OTHER PROGRAMS. + +;EXITS FROM THE ASSEMBLER: +;TPPB OUTPUT BINARY WORD IN A +;TFEED IF OUTPUT DEVICE IS PTP, PUNCH OUT # FRAMES OF BLANK TAPE + ;SPECIFIED BY B, MAY CLOBBER A AND B +;GO9 RETURN POINT FROM FATAL ERRORS +;TYO TYPE OUT CHARACTER IN A +;TAB TYPE OUT A TAB (MAY CLOBBER A OF COURSE) +;RCHTBL SEE THE RCH ROUTINES + +;ENTRIES + +;PDL, LPDL MAY BE USED BY COMMAND PROCESSOR BUT WILL BE CLOBBERED BY MAIN ROUTINES +;MAIN ROUTINES, CALLED WITH JSP A, , CLOBBER THE WHOLE WORLD (INCLUDING P) +;INIT INITIALIZE +;PS1 PASS 1 +;PLOD IF APPROPRIATE, PUNCH OUT LOADER +;PS2 PASS 2 (DOES ITS OWN PARTIAL INITIALIZATION) +;PSYMS PUNCH OUT SYMBOL TABLE + +;OTHER ENTRIES + +;CONTRL AFTER ASSEMBLY, .GE. 0 => RELOCATABLE, .LT. 0 => ABSOLUTE +;ISYMF -1 IF SYMS HAVE NOT BEEN SPREAD, ELSE DON'T TRY TO ADD TO INITIAL SYMBOL TABLE +;SMSRTF -1 IF SYMTAB HASN'T BEEN SORTED, ELSE SYMTAB CLOBBERED, DON'T RE-ASSEMBLE +;MIDVRS .FNAM2 OF MIDAS ENGLISH + +;SOME FF FLAGS ARE GLOBAL SO COMMAND PROCESSOR CAN KNOW WHAT'S HAPPENED ON RETURN + +;COMMAND PROCESSOR MAY ADD TO INITIAL SYMBOL TABLE BEFORE CALLING INIT THE FIRST TIME +;EISYMT IS THE FIRST LOCATION OK TO DUMP INTO +;EISYMP RH SHOULD BE SET BY COMMAND PROCESSOR TO FIRST LOC NOT DUMPED INTO +;INTSYM RH OF SYMTAB VALUE TO RETURN VALUE ADDRESSED BY LH(SYMTAB ENTRY) + +;RCH HAS AN ELABORATE SET OF GLOBALS, WHICH I DON'T FEEL LIKE PUTTING DOWN NOW, BUT THEY INCLUDE +;RCH (GET CHAR) SEMIC, RRL1, RREOF, SEMICR, SEMIC, TYPCTL, GDTAB, CPGN, CLNN, +;RCHMOD, MDSCLR, MDSSET, RCHSET, POPLMB, PSHLMB +;ALSO RCHTBL ONLY EXIT + +;LISTING FEATURE GLOBALS: +;PILPT PRINT CHAR IN A +;LISTON LISTING ON/OFF FLAG, -1 => ON +;LISTP SAME WORD AS LISTON. +;LISTP1 POSITIVE => LIST EVEN ON NON-PUNCHING PASS. +;LPTCLS END OF LISTING, PRINT FORM FEED, IF TS THEN CLOSE LPT + +;CREF FEATURE GLOBALS: +;CRFOUT OUTPUT WORD IN A. +;CREFP -1 => REQUEST GENERATION OF CREF OUTPUT. +;THE RUBOUT-B-^W HEADER, THE SET-SOURCE-FILE BLOCK, AND THE EOF BLOCK +;ARE THE RESPONSIBILITY OF THE COMMAND PROCESSOR. + +;;RCH ;CHARACTER INPUT ROUTINES + +IFN RCHASW\MACSW,[ + ;SAVE LIMBO1 STATUS AND RH(B) + ;THEN SET UP FOR NEW INPUT MODE (DESCRIPTOR IN A) + ;CALLED BY PUSHEM AND PUSHTT + +PSHLMB: HRL B,LIMBO1 ;LAST CHARACTER INPUT + TLZE FF,FLUNRD ;RE-INPUT CHARACTER ON RETURN? + XCT LSTPLM ;SET B'S SIGN; IF LISTING, JRST PSHLML. +PSHLMN: EXCH A,RCHMOD ;GET OLD MODE IN A + DPB A,[360500,,B] ;STORE IN 5 OF HIGH 6 BITS IN B + PUSH F,B ;SAVE RESULTANT CRUD + CAMN A,RCHMOD ;COMPARE NEW WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + MOVE A,RCHMOD ;NOW GET NEW MODE + JRST PSHLM1 ;SET UP INSTRUCTIONS FOR NEW MODE + +IFN LISTSW,[ +;IF LISTING, LSTPLM HOLDS JRST PSHLML +PSHLML: AOSN PNTSW + JRST PSHLMM ;LAST WAS BREAK CHR + REPEAT 4,IBP PNTBP + SOSA PNTBP +PSHLMM: SETOM LISTBC + TLO B,400000 + JRST PSHLMN +] + + ;UNDO A PSHLMB (NOTE: IN COMMENTS BELOW, "NEW" MODE IS ON PDL, OLD IN RCHMOD) + +POPLMB: POP F,A ;GET WORD THAT PSHLMB PUSHED + HLRZS A ;JUST INTERESTED IN LEFT HALF + TRZE A,400000 ;SIGN BIT SET? + TLOA FF,FLUNRD ;YES, SET FLAG TO RE-INPUT LAST CHAR + TLZA FF,FLUNRD ;NO, CLEAR FLAG. + XCT POPLML ;JFCL\IDPB A,PNTBP ;THE LATTER IFF LISTING. + SETZM LIMBO1 ;INITIALIZE FOR DPB + DPB A,[700,,LIMBO1] ;RESTORE LIMBO1 + LSH A,-<18.-6> ;RIGHT JUSTIFY RCHMOD DESCRIPTOR + CAMN A,RCHMOD ;COMPARE NEW MODE WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + JRST RCHSET ;SET UP FOR NEW MODE AND RETURN +] + +FOO==0 ;INITIALIZE COUNTER FOR FOLLOWING + +DEFINE RCHBLT SIZE,ADR/ + MOVSI T,FOO(A) + HRRI T,ADR + BLT T,-1+ADR +FOO==FOO+ +TERMIN + +DEFINE RCHMOV ADR/ + MOVE T,FOO(A) + MOVEM T,ADR +FOO==FOO+1 +TERMIN + + ;SET UP FOR INPUT OF MODE TYPE SPECIFIED IN A, CLOBBER A ONLY + +RCHSET: MOVEM A,RCHMOD ;STORE NEW RCHMOD +PSHLM1: TLZ FF,FLMAC\FLTTY ;CLEAR FLAGS (MAYBE DEVICE ROUTINE SETS ONE) + XCT RCHTBL(A) ;GET IN A A POINTER TO A DESCRIPTOR TABLE (MAYBE ALSO SET FLAG) + PUSH P,T ;SAVE T, NEED IT FOR TEMP + RCHBLT 3,RCH2 ;FIRST 3 WORDS RCH2 + TLNE FF,FLVOT + JRST POPTJ ;ALL RCH'S TO GO THROUGH RCH, DON'T DO ANYTHING ELSE +MDSST1: RCHBLT 3,RR1 ;NEXT 3 RR1 + RCHMOV RRL1 ;NEXT WORD RRL1 +RCHPSN==FOO ;# WORDS IN ALL TABLES BUT LAST (NOT OF CONSTANT LENGTH) + RCHBLT 6,SEMIC ;LAST N SEMIC +POPTJ: POP P,T + POPJ P, + +IFN LISTSW,[ + ;SET UP TO "DISPLAY" (ALL RCH'S THROUGH RCH) + +MDSSET: TLO FF,FLVOT ;SET FLAG + MOVEI A,MDSSTB-3 ;SET UP AC + PUSH P,T ;SAVE T FOR RESTORATION + JRST MDSST1 ;NOW SET UP + +MDSSTB: JRST RRL1 ;RR1 + HALT + PUSHJ P,RCH ;RREOF + + PUSHJ P,RCH ;RRL1 +IFN .--RCHPSN,.ERR LOSSAGE AT MDSSTB. + PUSHJ P,RCH ;SEMIC + CAIE A,15 + JRST SEMIC + JRST SEMICR + + ;CLEAR OUT DISPLAY MODE + +MDSCLR: TLZ FF,FLVOT ;CLEAR FLAG + MOVE A,RCHMOD + JRST RCHSET ;NOW SET UP FOR REAL IN CURRENT MODE +] ;END IFN LISTSW, + +IFN TS,[ ;TABLE FOR RCHSET, INDEXED BY MODE + ;MAYBE THIS CONDITIONAL WANTS TO BE CHANGED TO SOMETHING ELSE + +RCHTBL: MOVEI A,RCHFIL ;0 => INPUT FROM FILE +IFN MACSW,PUSHJ P,RCHMAC ;1 => INPUT FROM MACRO (DO NOT CHANGE, USED BY MACRO PROCESSOR) +IFN RCHASW,[IFE MACSW,HALT + PUSHJ P,RCHTRC ;2 => TTY, QUIT ON CR + PUSHJ P,RCHARC ;3 => TTY, DON'T QUIT ON CR +] + ;TABLE FOR INPUTTING FROM FILE + ;MAYBE THIS CONDITIONAL ALSO WANTS TO BE CHANGED + +RCHFIL: ILDB A,UREDP ;GETCHR, GET CHARACTER + CAIG A,14 ;SKIP IF TOO BIG TO BE SPECIAL + XCT RPATAB(A) ;SPECIAL, DO THE APPROPRIATE THING + + JRST RRL1 ;RR1 + HALT + PUSHJ P,[ MOVEI A,0 ;^C IN SYMBOL TREATED LIKE A ^@, + JRST INCHR3] ;BUT ALSO SEE IF REALLY END OF BUFFER. THIS GOES IN RREOF. + + ILDB A,UREDP ;RRL1 +IFN .-RCHPSN-RCHFIL,.ERR RCHFIL LOSES. + LDB CH1,[360600,,UREDP] ;SEMIC; FIND WHERE IN ITS WORD UREDP POINTS + IDIVI CH1,7 + JRST @SEMIC3(CH1) ;AND ENTER THE CR-SCANNING LOOP AT THE APPROPRIATE + JFCL ;PLACE (IT IS A WORD-BY-WORD LOOP). + +;TABLE FOR ABOVE, EXECUTED INDEXED BY CHAR, 15 ONLY FROM SEMIC ELSE ANYTHING +;NOTE: MANY OF THESE ROUTINES SUBTRACT 3 FROM THE PC BEFORE RETURNING. +;THE CALLER MUST MAKE SURE THAT THE ILDB UREDP IS WHAT THEY RETURN TO THAT WAY. + +RPATAB: +IFN ITSSW, JFCL ;0, ON I.T.S. IS NORMAL CHARACTER +.ELSE CALL RPANUL ;0, ON DEC SYSTEM, IGNORE IT. + JFCL + JFCL +IFN .-RPATAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH ENTRY IN RPATAB. + PUSHJ P,INCHR3 ;3, EOFCH + REPEAT 6,JFCL + CALL RPALF ;LINE FEED + JFCL ;13 + PUSHJ P,RPAFF ;FORM FEED + JRST SEMICR ;FROM SEMIC ONLY, EXIT FROM LOOP + +RPAFF: SKIPE ASMOUT ;FORM FEED + ETR [ASCIZ/Formfeed within <>, () or []/] + AOS CH1,CPGN + SETOM CLNN +IFN ITSSW,[ + ADD CH1,[SIXBIT /P0/+1] + MOVE CH2,A.PASS + DPB CH2,[300200,,CH1] + .SUSET [.SWHO3,,CH1] ;PUT THE NEW PAGE # IN THE WHO-LINE. +] +RPALF: AOS CH2,CLNN + CAME CH2,A.STPLN + RET + MOVE CH1,CPGN + CAMN CH1,A.STPPG + SETOM TTYBRF + RET + +IFN DECSW\TNXSW,[ +RPANUL: MOVE CH1,@UREDP ;SAW A NULL - IN A LINE NUMBER? + TRNN CH1,1 + JRST RCHTRA ;NO, JUST IGNORE IT. + MOVEI CH1,010700 + HRLM CH1,UREDP ;YES, SKIP THIS WHOLE WORD, THEN + CALL RCH ;SKIP THE 1ST CHAR AFTER THE LINE NUMBER + JRST RCHTRA ;RETURN THE NEXT CHAR FROM THIS CALL TO RCH. +] +] ;END IFN TS, + +VBLK +LIMBO1: 0 ;LAST CHARACTER READ BY RCH +RCHMOD: 0 ;CURRENT INPUT MODE, 0 => INPUT FROM FILE, 1 => MACRO, ETC. +CLNN: 0 ;1 LESS THAN LINE # IN CURRENT INPUT FILE. +CPGN: 0 ;1 LESS THAN PAGE # IN CURRENT INPUT FILE +A.STPL: 0 ;1 LESS THAN LINE # TO STOP AT. +A.STPP: 0 ;1 LESS THAN PAGE # TO STOP AT. + ;(STOPPING MEANS INSERTING THE TTY) + +;READ CHARACTER INTO A FROM INPUT FILE, MACRO, OR WHATEVER (RCH) +;CLOBBERS A,CH1,CH2. + +RCH: TLZE FF,FLUNRD + JRST RCH1 ;RE-INPUT LAST ONE +RCH2: HALT ;ILDB A,UREDP ;ILDB A,CPTR ;GET CHAR + 0 ;CAIG A,14 ;TRZE A,200 ;CHECK FOR SPECIAL + 0 ;XCT RPATAB(A) ;PUSHJ P,MACTRM ;SPECIAL, PROCESS + MOVEM A,LIMBO1 ;GOT CHAR, SAVE AS LAST CHAR GOTTEN +IFE TS,RCHLS1==JRST TYPCTL +IFN TS,RCHLS1==RET ;DEFAULT CONTENTS OF RCHLST (IF NOT LISTING) +RCHLST: RCHLS1 ;AOSN PNTSW IF LISTING. +IFN LISTSW,[ + PUSHJ P,PNTR + CAIG A,15 + JRST RCHL1 +RCHL3: IDPB A,PNTBP +TYPCTL: POPJ P, ;OR JRST SOMEWHERE +PBLK + +RCHL1: CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + JRST RCHL3 +RCHL2: MOVEM A,LISTBC + SETOM PNTSW + JRST TYPCTL + +VBLK +RCH1: MOVE A,LIMBO1 +RCH1LS: RET ;OR CAILE A,15 IF LISTING. + RET ;NEEDED IN CASE LISTING. + CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + POPJ P, + JRST RCHL2 +PBLK +] ;END IFN LISTSW, + +IFE LISTSW,[ +PBLK +RCH1: MOVE A,LIMBO1 + RET +] ;END IFE LISTSW, + +;;GETSYL ;VARIOUS SYLLABLE READING ROUTINES (BUT NOT ALL OF THEM) + +GSYL: CLEARB SYM,STRCNT +GSYL1: MOVEI D,6 + MOVE T,[440700,,STRSTO] + MOVEM T,STRPNT +GSYL3: AOSG A,STRCNT + JRST (F) + PUSHJ P,RCH + IDPB A,STRPNT ;STORE CHAR IN STRING EVEN IF DELIMITER (MINIMUM STRCNT = 1) +A.GSY2: CAIN A,". + JRST GSYL1C + HLRZ CH1,GDTAB(A) + CAIN CH1,(JSP CH2,) + JRST GSYL1A ;NUMBER + PUSHJ P,GSYL1B ;RETURN ONLY ON SYL SEP + HRRZ A,GDTAB(A) + MOVE T,LIMBO1 +C%: POPJ P,"% + +GSYL1B: XCT GDTAB(A) ;POPJ FOR SYL SEPS + SUB P,[1,,1] +GSYL1D: SOJGE D,GSYL3 + AOJA D,GSYL3 + +GSYL1C: ADD SYM,%.SQ(D) + JRST GSYL1D + +GSYL1A: XCT NSQTB-60(A) + JRST GSYL1D + + ;VERSION OF GETSYL TO TRY UNTIL SYL OR WORD TERMINATOR FOUND + ;SKIPS IF NAME THERE (FOR .TYPE, SQUOZE) + +GTSLD2: TLNN C,DWRD\DFLD + JRST GTSLD3 ;DELIMITER IS WORD TERMINATOR, TOLERATE THE NULL SYLLABLE +GETSLD: PUSHJ P,GETSYL ;ENTRY, GET A SYL + MOVE C,CDISP ;GET CDISP + TRNN I,IRSYL + JRST GTSLD2 ;NO SYL + AOS (P) ;GOT SYL, CAUSE RETURN TO SKIP +GTSLD3: TLNN C,DWRD\DFLD + TLO FF,FLUNRD ;CAUSE DELIMITER TO BE RE-INPUT + POPJ P, + +PASSPS: SKIPA A,LIMBO1 +GPASST: CALL RCH + CAIE A,40 + CAIN A,^I + JRST GPASST + RET + +GETSYL: TLZ I,ILUARI+ILNPRC+ILLSRT +GTSL1: CLEARB SYM,NUMTAB ;RECUR HERE FOR RIGHT ARG TO ^ AND _. + MOVE AA,[NUMTAB,,NUMTAB+1] + AOSN NTCLF + BLT AA,NUMTAB+10 ;NUMTAB NOT CLEAR, HAVE TO CLEAR IT + MOVEI D,6 ;CHARACTER COUNTER FOR BUILDING UP SYM + SETOM ESBK ;NO SPECIFIC BLOCK DESIRED. + TDZ I,[ILDECP+ILFLO+ILVAR+ILGLI,,IRPERI+IRLET+IRSYL] +RRL2: PUSHJ P,RR ;CALL MAIN LOOP ROUTINE, READ UNTIL NON-SQUOZE CHAR +SEMICR: ;RETURN HERE FROM SEMIC WITH CR IN A + MOVEM A,LIMBO1 ;SYLLABLE OPERATOR OR TERMINATOR IN A, SAVE + HRRZ A,GDTAB(A) ;NOW GET RIGHT HALF OF POPJ, INDEX INTO DTB + MOVE C,DTB-40(A) ;GET DTB ENTRY (FLAGS,,JUMP ADR) + MOVEM C,CDISP ;STORE AS DISPATCH CODE FOR LAST CHAR (SORT OF AN INTERPRETED LIMBO1) +RR8: TLNE C,DSYL ;NOW SEE IF SYL OPERATOR FLAG SET + JRST (C) ;SET => INTRA-SYLLABLE OPERATOR +RR10: TRNE I,IRLET ;NOT SET => SYLLABLE TERMINATOR: SYL? + POPJ P, ;SYL HAS LETTERS + TRNN I,IRSYL + JRST CABPOP ;NO SYL + CAMN SYM,[SQUOZE 0,.] + JRST PT1 ;SYM IS . + ;NUMBER + +RR5: TLNN I,ILNPRC + PUSHJ P,NUMSL + TLNN I,ILFLO + JRST RR9 ;NOT FLOATING POINT + MOVE A,B ;FLOATING, HIGH IN AA,LOW IN A,EXP IN B + ADDI A,306 ;201+105 TO ROUND + ADDI AA,200 ;CAUSE EXPONENT TO BE ACCEPTABLE TO MACHINE + JUMPGE AA,.+3 ;NOW CHECK FOR OVERFLOW ON ROUNDING + LSH AA,-1 ;OVERFLOW, SHIFT BACK ONE + AOS A ;INCREMENT EXPONENT TO COMPENSATE FOR SHIFT + EXCH A,AA ;GET EXPONENT IN AA, REST IN A + ASHC AA,-10 ;SHIFT TO MACHINE FLOATING POINT FORMAT + SKIPE AA ;NOW CHECK HIGH ORDER BITS OF EXPONENT NOT SHIFTED INTO NUMBER + ETR [ASCIZ /Exponent overflow/] +RR9: TLZ I,ILGLI+ILVAR ;NOT TRYING TO DEFINE NUMBER AS VARIABLE OR GLOBAL +CLBPOP: TDZA B,B ;CLEAR OUT B (RELOCATION BITS OF VALUE) +CABPOP: SETZB A,B ;DO JRST CABPOP TO RETURN ZERO AS VALUE + POPJ P, + +RRU: MOVE A,LIMBO1 ;GET HERE WHEN FLUNRD SET AT RR, RETRIEVE CHARACTER FROM LIMBO1 + CAIG A,14 ;IF TOO BIG, + CAIGE A,12 ;OR IF TOO SMALL, + JRST RR1B ;THEN JUST FALL BACK IN + TLNN FF,FLVOT\FLMAC\FLTTY ;SKIP IF NOT HACKING CPGN/CLNN + XCT RRUTAB-12(A) ;HACKING, UNHACK FOR HACK COMING UP + JRST RR1B ;FALL BACK IN + +RRUTAB: SOS CLNN ;LINE FEED (TABLE FOR RRU) + JRST RR1B ;13 + SOS CPGN ;FORM FEED + + ;MAIN LOOP ROUTINE FOR GETSYL, READ SYM OR NUMBER +VBLK +RR: TLZE FF,FLUNRD ;RE-INPUT LAST CHARACTER? + JRST RRU ;YES +RR1: JRST RRL1 ;ILDB A,CPTR ;GET CHAR (" " ") + HALT ;TRZE A,200 ;CHECK FOR END OF STRING +RREOF: PUSHJ P,RCH ;PUSHJ P,MACTRM ;PROCESS CONDITION, GET NEXT CHAR OR JRST RR1 OR RRU + .SEE RCHTRA ;SPECIAL HANDLING OF UNRCHF IN RCHTRA IF CALLED FROM HERE. +RR1B: XCT GDTAB(A) ;GOT CHAR, DO SOMETHING APPROPRIATE (POPJ ON NOT SQUOZE) + TROA I,IRLET\IRSYL ;LETTERS RETURN, JUST UPDATED SYM, SET FLAGS + TRO I,IRSYL ;NUMBERS RETURN, SET FEWER FLAGS + SOJGE D,RR1 ;DECREMENT SYM COUNTER AND LOOP + AOJA D,RR1 ;COUNTER EXHAUSTED, INCREMENT BACK TO 0 AND LOOP + +RRL1: PUSHJ P,RCH ;ILDB A,UREDP ;GET CHAR + XCT GDTAB(A) ;NOW MAKE LIKE RR1B (EOFCH => JRST RREOF) + TROA I,IRLET\IRSYL + TRO I,IRSYL + SOJGE D,RRL1 + AOJA D,RRL1 + + ;SEMICOLON (GET HERE FROM RR8) + + JRST SEMICL ;RETURN HERE FROM SEMIC+2 WHEN FLUNRD SET +;NEXT 4 INSNS ALTERED IN DIFFERENT INPUT MODES. SEE RCHFIL, ETC. +SEMIC: PUSHJ P,RCH ;GET CHAR + CAIE A,15 ;SEE IF SPECIAL + JRST SEMIC ;SPECIAL => DO SOMETHING (JRST SEMICR ON CR) + JRST SEMICR ;IF NOT SPECIAL THEN GO BACK FOR NEXT CHAR + +LOC SEMIC+6 ;LEAVE A LITTLE EXTRA ROOM FOR BIG ROUTINES +PBLK + +SEMICL: MOVE A,LIMBO1 ;HERE FROM SEMIC-1, RETRIEVE CHARACTER FROM LIMBO1 + CAIE A,15 ;SKIP IF SHOULD TERMINATE SCAN + JRST SEMIC ;NOT CR, FALL BACK IN + JRST SEMICR ;DONE + +SEMIC2: +REPEAT 5,[ + ILDB A,UREDP + CAIG A,15 + XCT RPATAB(A) +] + MOVE A,[ASCII /@@@@@/] +SEMIC1: AOS CH1,UREDP + MOVE CH1,(CH1) ;ANY CONTROL CHARS IN THE WORD UREDP POINTS AT? + MOVE CH2,CH1 + AND CH1,A + AND CH2,[ASCII/ /] + LSH CH2,1 + IOR CH1,CH2 + CAMN CH1,A + JRST SEMIC1 ;NO, ADVANCE TO NEXT WORD AND TEST IT. + MOVEI A,440700 + HRLM A,UREDP + JRST SEMIC2 ;YES, LOOK AT EACH CHAR AND PROCESS IT. + +SEMIC3: REPEAT 6,JRST SEMIC2+3*<5-.RPCNT> + +;JSP CH2,RR2 => DIGIT (FROM GDTAB) +;THIS ROUTINE IS GROSSLY SLOW, AND SHOULD BE SPEEDED UP SOMETIME + +RR2: XCT NSQTB-"0(A) ;UPDATE SQUOZE. + TRNE I,IRLET + JRST 1(CH2) ;SYL IS SYM, DON'T WASTE TIME. + TRNE I,IRPERI + TLO I,ILFLO ;DIGIT AFTER . => FLOATING. +MAKNUM: SETOM NTCLF ;NUMTAB ABOUT TO NOT BE CLEAR, SET FLAG FOR GETSYL TO CLEAR IT OUT NEXT TIME + MOVEI AA,2 ;INDEX INTO NUMTAB ETC., SOJGE'D TO GET ALL RADICES +MAKNM1: MOVE T,ARADIX(AA) ;GET THIS RADIX, + CAMN T,ARADIX ;REDUNDANT => SKIP THIS PASS. + JUMPN AA,MAKNM4 + SKIPGE CH1,HIGHPT(AA) + JRST MAKNM3 + MUL T,LOWPT(AA) ;TT HAS OLD LOW TIMES RADIX, T HAS OVFLO TO HIGH. + ADDI TT,-"0(A) ;ADD DIGIT TO LOW PART + TLZE TT,400000 + AOJ T, ;OVERFLOW, INCREMENT SPILLOVER FROM MUL OF LOWPT + JUMPE CH1,MAKNM5 ;OLG HIGHPT WAS 0 => SAVE TIME. + JFCL 17,.+1 ;NOW CLEAR OV, ETC. + IMUL CH1,ARADIX(AA) ;MULTIPLY HIGHPT BY RADIX + ADD T,CH1 ;ADD HIGH PARTS + JFCL 10,MAKNM2 ;JUMP ON OVERFLOW FROM IMUL OR ADD +MAKNM5: TLNE I,ILFLO + SOS NUMTAB(AA) ;FLOATING, DECREMENT EXP TO COMPENSATE FOR MULT OF HIGHPT/LOWPT + MOVEM T,HIGHPT(AA) ;NOW STORE STUFF BACK + MOVEM TT,LOWPT(AA) +MAKNM4: SOJGE AA,MAKNM1 ;NOW DO ALL THIS FOR NEXT RADIX + JRST 1(CH2) + +MAKNM2: MOVSI B,400000 ;OVERFLOW FROM UPDATING HIGH PARTS + IORM B,HIGHPT(AA) ;SET SIGN BIT +MAKNM3: TLNN I,ILFLO + AOS NUMTAB(AA) ;NOT FLOATING, INCREMENT EXP, MAY NOT WANT TRAILING BITS + JRST MAKNM4 + +VBLK +NUMTAB: 0 ;EXPONENT + 0 + 0 +HIGHPT: 0 ;HIGH PART OF CURRENT NUMBER THIS RADIX + 0 ;4.9 => OVERFLOW, TRAILING DIGITS DROPPED + 0 +LOWPT: 0 ;LOW PART OF CURRENT NUMBER THIS RADIX + 0 ;HIGHPT/LOWPT TAKEN AS 70. BIT POSITIVE INTEGER EXCEPT 4.9(HIGHPT) IS FLAG INSTEAD OF + 0 ;EXPONENTIATE 70. BIT INTEGER BY NUMTAB (WHICH MAY BE NEGATIVE) TO GET ACTUAL VALUE +ARADIX: 10 ;CURRENT RADIX + 12 + 10 + +NTCLF: -1 ;-1 => NUMTAB NOT CLEAR (TO SAVE BLT AT GETSYL WHEN CLEAR) +PBLK + +;JRST POINT => . (FROM GDTAB) + +POINT: TLO I,ILDECP ;PREFER DECIMAL + TROE I,IRPERI ;SET PERIOD FLAG + TRO I,IRLET ;2 POINTS => NAME + ADD SYM,%.SQ(D) ;UPDATE SYM + JRST 1(CH1) ;RETURN + +RBRAK: SOSL SCNDEP ;IF A CONDITIONAL TO TERMINATE, + JRST RBRAK2 ;HAVE DONE SO, IGNORE CHAR. + SETZM SCNDEP +;CLOSES OF ALL KINDS COME HERE. +RPARN: +GRTHN: MOVE A,LIMBO1 + SKIPE CH1,ASMOUT ;WHAT KIND OF OPEN ARE WE IN? + CAIN CH1,4 ;WITHIN A .ASCII OR + JRST RBRAK1 ;NOT WITHIN GROUPING => THIS CLOSE IS STRAY. + CAME A,ASMOT1(CH1) ;RIGHT KIND OF CLOSE FOR THAT OPEN? + ERJ RBRAK3 +RBRAK4: MOVE CH1,ASMOT2(CH1) + MOVEM CH1,ASMDSP ;ARRANGE FOR THIS ASSEM1 LEVEL TO EXIT +RBRAK5: SETZM CDISP + JRST RR10 ;AND GO TERMINATE WORD. + +RBRAK3: CALL TYOERR ;COME HERE ON CLOSE WRONG FOR OPEN. + ;(EG, ")" MATCHING "<"). + TYPR [ASCIZ/ Seen when /] + MOVE A,ASMOT1(CH1) + CALL TYOERR + TYPR [ASCIZ/ expected +/] + JRST RBRAK4 + +RBRAK1: CAIN CH1,4 ;CLOSE INSIDE A .ASCII => + JRST RBRAK5 ;TERMINATE WORD BUT DON'T CLOSE ANYTHING. + SKIPN CONSML ;COME HERE FOR STRAY CLOSE. + JRST RRL2 + ERJ .+1 + TYPR [ASCIZ/Stray /] + MOVE A,LIMBO1 ;GET THE CLOSE WE SAW. + CALL TYOERR + CALL CRRERR + JRST RRL2 + +;COME HERE FOR CLOSE-BRACE, AND CERTAIN CLOSE-BRACKETS. +RBRAK2: SETOM A.SUCC ;HAVE JUST ENDED SUCCESSFUL BRACKETED CONDIT, + JRST RRL2 ;REMEMBER THAT MOST RECENT CONDITIONAL WAS TRUE. + +FORMF: TLNN FF,FLVOT\FLMAC\FLTTY ;FORM FEED SYLLABLE OPERATOR ROUTINE + PUSHJ P,RPAFF ;UNLESS ALREADY DONE, INCREMENT PAGE #. + JRST RR10 + +LINEF: TLNN FF,FLVOT\FLMAC\FLTTY ;LINE FEED SYLLABLE OPERATOR ROUTINE + CALL RPALF + JRST RR10 + +CTLAT: +IFN DECSW\TNXSW,[ + TLNN FF,FLVOT\FLMAC\FLTTY ;^@ SYLLABLE OPERATOR ROUTINE. + CALL RPANUL +] + JRST RRL2 + +;DECIPHER A VALUE FROM NUMTABS +;LEAVES HIGH PART IN AA, LOW PART IN A, BINARY EXPONENT IN B +;AND RADIX USED IN D. + +NUMSL: TLNN I,ILVAR\ILDECP\ILFLO + SKIPE B,HIGHPT + JRST NUMSLS + MOVE A,LOWPT ;BE VERY FAST IN CASE OF SMALL FIXNUM IN CURRENT RADIX. + MOVE D,ARADIX ;SAVE RADIX AND HIGH PART FOR ^. + SETZ AA, + RET + +NUMSLS: CLEARB TT,D ;TT BIT EXPONENT, D INDEX INTO NUMTAB, ETC. + TLNE I,ILDECP+ILVAR ;NEITHER . NOR ', CURRENT RADIX. + TLNE I,ILGLI ;" => CURRENT RADIX DESPITE . OR '. + JRST NUMSL0 + MOVEI D,1 ;DECIMAL UNLESS ' + TLNE I,ILVAR ;WHICH FORCES OCTAL. + MOVEI D,2 + MOVE A,ARADIX(D) + CAMN A,ARADIX ;IF REALLY SAME AS CURRENT RADIX, + MOVEI D,0 ;COMPUTATION WASN'T DONE FOR THIS VALUE OF D, + ;SO USE COMPUTATIONS DONE FOR CURRENT RADIX. +NUMSL0: MOVE AA,HIGHPT(D) ;AA := HIGH PART + MOVE B,LOWPT(D) ;B := LOW PART + MOVE T,NUMTAB(D) ;T := EXPONENT + MOVE D,ARADIX(D) ;NO LONGER NEED IDX, GET RADIX VALUE. + TLNN I,ILFLO + JRST FIXNUM ;NOT FLOATING + TLZ AA,400000 ;FLOATING, DON'T NEED DIGITS LOST ON OVERFLOW +NUMC1: JUMPN AA,.+2 ;ENTRY FROM UPARR + JUMPE B,FIX0 ;COMPLETELY ZERO => RETURN FIXED ZERO + JUMPL T,NUMSL1 ;JUMP IF EXPONENT NEGATIVE + JUMPE T,NUMSL2 ;JUMP (SKIP FOLLOWING) IF EXPONENT ZERO + ;EXPONENT POSITIVE, DO THE APPROPRIATE THING +NUMSL5: MULI B,(D) ;MULITIPLY LOW PART BY RADIX + MULI AA,(D) ;MULTIPLY HIGH PART BY RADIX + ADD A,B ;A := LOW PART OF HIGH + HIGH PART OF LOW + TLZE A,400000 + ADDI AA,1 ;OVERFLOW ON ADDITION, INCREMENT HIGH PART OF HIGH + MOVE B,C ;NO LONGER NEED HIGH OF LOW, GET LOW OF LOW IN B +NUMSL3: JUMPE AA,NUMSL4 ;NOW CHECK FOR OVERFLOW INTO HIGH OF HIGH, JUMP ON NONE + ASHC A,-1 ;NEXT THREE INSTRUCTIONS TO DO ASH3 AA,-1 + ASH A,1 + ASHC AA,-1 + AOJA TT,NUMSL3 ;INCREMENT BIT EXPONENT AND TRY AGAIN + +NUMSL4: MOVE AA,A ;FLUSHED OVERFLOW, NOW GET (LOW PART OF) HIGH PART IN AA + SOJG T,NUMSL5 ;COUNT DOWN + +NUMSL2: TLNN I,ILFLO + JRST NUMSL9 ;NOT FLOATING, DON'T WASTE TIME NORMALIZING. + SKIPA A,B ;EXPONENT NOW ZERO, GET LOW PART OF NUMBER IN A +NUMSL7: ASHC AA,1 ;NOW NORMALIZE + TLNN AA,200000 + SOJA TT,NUMSL7 + SKIPA B,TT ;DONE NORMALIZING, RETURN BINARY EXPONENT IN B +PT1: TRO I,IRLET + POPJ P, + +NUMSL9: MOVE A,B + MOVEI B,0 + ASHC AA,(TT) ;SHIFT 2-WD NUM. BY EXPONENT, + LSH A,1 ;PUT HIGH BIT IN WITH REST. + JRST FIX1 + +FIX0: TLZ I,ILFLO +FIXNUM: LSHC A,45 +FIX1: LSHC AA,-1 + JUMPE AA,.+2 + ETR [ASCIZ /FIXNUM too big for 36 bits/] + POPJ P, + +NUMSL1: SKIPA A,B ;EXPONENT NEGATIVE: NORMALIZE NOW +NUMSL8: ASHC AA,1 +NUMSL6: TLNN AA,200000 + SOJA TT,NUMSL8 ;NOT NORMALIZED YET + AOS T + MOVEI TM,(D) + TLNN TM,-1 ;GET CONVIENT POWER OF RADIX + JUMPL T,[ IMULI TM,(D) + AOJA T,.-1] + MOVE B,A ;GET NORMALIZED LOW PART IN B + IDIV AA,TM ;DIVIDE HIGH PART BY APPROPRIATE RADIX + DIV A,TM + JUMPL T,NUMSL6 + MOVE B,A + JRST NUMSL2 + +UPARR: TRON I,IRSYL + JRST UPCTRC ;"UNARY UPARROW" => GOBBLE CHARS + TRNE I,IRLET + ETR [ASCIZ /Symbolic 1st arg to "^"/] + PUSHJ P,NUMSL ;DECIPHER NUMTABS + PUSHJ P,UA3 ;GET RIGHT OPERAND IN T + MOVE TT,B ;EXPONENT + MOVE B,A ;LOW PART + PUSHJ P,NUMC1 ;T EXP HIGH IN AA LOW IN B TT BIN EXP + MOVE C,CDISP ;IF A _ WAS DEFERRED WHILE ILUARI WAS SET, + TLO I,ILNPRC + CAME C,[DSYL,,BAKAR] ;DO IT NOW. + JRST RR10 + +BAKAR: TLNE I,ILUARI + JRST RR5 ;RETURN TO UPARROW (WILL COME BACK HERE LATER) + TRNE I,IRSYL + TRNE I,IRLET + JRST BAK1 ;NO SYL, OR SYL IS NAME + CAMN SYM,[SQUOZE 0,.] + JRST BAK1 ;. ALSO NAME + TLZN I,ILNPRC + PUSHJ P,NUMSL + PUSHJ P,UA3 + ADD B,T + ASHC AA,(B) + LSH A,1 + LSHC AA,-1 + CLEARB B,AA + TLZ I,ILFLO + MOVE C,[DFLD,,CBAKAR] + EXCH C,CDISP ;IF 2ND ARG ENDED WITH A _, TURN INTO FIELD OP. + CAME C,[DSYL,,BAKAR] + EXCH C,CDISP + POPJ P, + +UPCTRC: SETZ T, +UPCTR1: JSP F,QOTCOM ;UP ARROW TO GOBBLE SYL AND RETURN MASKED ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + CAIL A,140 + SUBI A,40 + ANDI A,77 ;NOW MASK CHARACTER IN TO TO BOTTOM 6 BITS + ADD T,A ;ADD TO ACCUMULATED + POPJ P, + +BAK1: MOVE TT,[DFLD,,CBAKAR] + MOVEM TT,CDISP + JRST RR10 + +UA3: HRLM D,(P) ;SAVE RADIX (FOR UPARR) + JSP LINK,SGTSY ;PUSH I,AA,A,B + TLO I,ILUARI ;TELL _ TO WAIT TILL LATER (SEE UPARR, BAKARR) + PUSHJ P,RCH + CAIN A,"- + TROA I,IRGMNS + TLO FF,FLUNRD + PUSHJ P,RCH + CAIN A,"< + JRST UAR1 + TLO FF,FLUNRD +UA3L: PUSHJ P,GTSL1 ;GOBBLE SYL, LOOP POINT FOR PSEUDO OR MACRO RETURNED WITHOUT VALUE + TRNE I,IRLET + JRST UA3S ;NAME + TLNE I,ILFLO + ETR [ASCIZ /Floating point 2nd arg to "_"/] +UAR2: TRZN I,IRGMNS + SKIPA T,A + MOVN T,A + JSP LINK,SGTSY1 ;RESTORE GETSYL TEMPS. + HLRZ D,(P) + POPJ P, + +UA3S: PUSHJ P,GETVAL ;MAKE NUMBER_NAME WORK + JRST UA3SR ;GOT VALUE, PROCESS + JRST UA3L ;NO VALUE, TRY AGAIN + +UAR1: TLO I,ILLSRT + TRZ I,IRSYL ;(OR ELSE LSSTH GIVES NOS ERROR.) + SETZB A,B + PUSHJ P,LSSTH +UA3SR: JUMPN B,RLCERR ;RELOC ERR + JRST UAR2 + +ATSGN: MOVSI A,20 ;ATSIGN + IORM A,WRD + TRO I,IRFLD ;SET IRFLD FLAG EVEN THOUGH NOT DIRECTLY RETURNING VALUE + ; ^ CHANGED FROM SYL TO FIELD 9/6/70 + JRST RRL2 ;FALL BACK IN + +DQUOTE: TRON I,IRSYL + JRST DQUOT8 + TRNN I,IRLET ;AFTER NUMBER => CURRENT RADIX. + JRST DQUOT7 + PUSHJ P,RCH + TLO FF,FLUNRD ;NEXT CHAR. SQUOZE? + HLRZ A,GDTAB(A) + CAIN A,(POPJ P,) + JRST DQUOT7 ;NO => MAKE PREV. SYM. GLOBAL. + CAMN SYM,[SQUOZE 0,.M] ;SPECIAL BLOCK NAMES + JRST DQUOTM ;.M MEANS MAIN BLOCK, + CAMN SYM,[SQUOZE 0,.U] + JRST DQUOTU ;.U MEANS SUPERIOR. + CAMN SYM,[SQUOZE 0,.C] + JRST DQUOTC ;.C MEANS CURRENT BLOCK. + SKIPGE A,ESBK ;GET SPEC'D BLOCK OR CURRENT, + HRR A,BKCUR ;LOOK FOR SUBBLOCK OF THAT BLOCK. + HLL A,BKTAB+1(A) + ADD A,[1,,] ;LH HAS LEVEL SUBBLOCK OUGHT TO HAVE. + MOVEI T,0 + SETO D, ;NO POSSIBLE ALTERNATE CHOICE YET. +DQUOT0: CAME SYM,BKTAB(T) ;LOOK AT ALL BLOCKS SEEN. + JRST DQUOT1 ;HAS THE NAME WE'RE LOOKING FOR? + SKIPGE ESBK ;IF LOOKING FOR A SUBBLOCK OF A PARTICULAR BLOCK, + JRST DQUOT4 + CAMN A,BKTAB+1(T) + JRST DQUOT2 ;SUCH A BLOCK WINS; ALL OTHERS LOSE. + JRST DQUOT1 + +DQUOT4: SKIPN BKTAB+2(T) ;ELSE PREFER DEFINED BLOCKS TO UNDEFINED ONES. + JUMPGE D,DQUOT1 + SKIPE BKTAB+2(T) + JUMPL D,DQUOT5 + CAME D,[-1] ;THAT'S THE SAME EITHER WAY => PREFER AN INFERIOR + CAMN A,BKTAB+1(T) ;OF THE CURRENT BLOCK TO ONE THAT'S NOT. + JRST DQUOT5 + JRST DQUOT1 + +DQUOT5: HRROI D,(T) ;FOUND A BLOCK WE LIKE BEST SO FAR. + SKIPE BKTAB+2(T) + ANDI D,-1 ;LEAVE SIGN OF D SET UNLESS THE BLOCK IS DEFINED. +DQUOT1: ADDI T,BKWPB + CAMGE T,BKTABP + JRST DQUOT0 + HRRZI T,(D) ;NOW USE THE BEST BLOCK FOUND, IF THERE WAS ONE. + CAIE T,-1 + JRST DQUOT2 + MOVE T,BKTABP ;NOT FOUND, GET IDX OF 1ST UNUSED ENTRY. + CAIL T,BKTABS + ETF ERRTMB ;NO ROOM FOR MORE BLOCKS. + MOVEM SYM,BKTAB(T) + MOVEM A,BKTAB+1(T) ;ADD BLOCK AT END. + MOVEI A,BKWPB(T) + MOVEM A,BKTABP ;POINTS AFTER LAST USED ENTRY. +DQUOT2: MOVEM T,ESBK + SETZ SYM, +DQUOT3: MOVEI D,6 ;NEXT CHAR GOES IN 1ST SQUOZE POS. + JRST RRL2 + +DQUOTM: MOVEI T,BKWPB ;.M - MAIN BLOCK FOLLOWS INITIAL SYMS BLOCK. + JRST DQUOT2 + +DQUOTU: SKIPGE T,ESBK ;.U SPEC'D - GET SPEC'D OR CURRENT BLOCK, + MOVE T,BKCUR + HRRZ T,BKTAB+1(T) + JRST DQUOT2 ;SPEC. ITS SUPERIOR. + +DQUOTC: SKIPGE T,ESBK ;.C => SPEC THE CURRENT BLOCK. + MOVE T,BKCUR + JRST DQUOT2 + +SQUOT1: TLOA I,ILVAR +DQUOT7: TLO I,ILGLI + MOVE A,BKCUR ;IF NO SPEC'D BLOCK, + SKIPGE ESBK + MOVEM A,ESBK ;SPEC. CURRENT BLOCK. + JRST RRL2 + +DQUOT8: SETZ T, +DQUOT9: JSP F,QOTCON ;DOUBLE QUOTE TO GOBBLE SYL AND RETURN ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + ADD T,A ;ADD IN ASCII CHARACTER IN A + POPJ P, ;RETURN TO SOMETHING + +SQUOTE: TROE I,IRSYL + JRST SQUOT1 + SETZ T, +SQUOT9: JSP F,QOTCON ;SIXBIT SYL + CAIGE A,40 + ETR ERRN6B ;NOT SIXBIT + CAIL A,140 + SUBI A,40 ;CONVERT TO UPPER CASE + LSH T,6 ;SHIFT OVER ACCUMULATED VALUE + ADDI T,-40(A) ;ADD IN SIXBIT FOR CHARACTER IN A + POPJ P, + +;COMMON ROUTINE FOR RIGHT JUSTIFIED TEXT SYLS +;CALLED WITH JSP F,; ROUTINE PUSHJ'S BACK W/ CHAR IN T, ACCUM VALUE IN A +;SYL FLAG EXPECTED TO BE ALREADY SET +QOTCON: SKIPE QMTCH ;' AND " COME HERE, BUT NOT ^: IF IN QUOTES-MATCHING MODE, USE A + JRST QOTCO4 ;FAIL-LIKE ALGORITHM. HERE FOLLOWS THE OLD MIDAS WAY OF DOING IT +QOTCOM: CALL RCH ;USE AT LEAST 1 CHAR IN ANY CASE. + JRST QOTCO1 + +QOTCO2: CALL RCH ;USE SUCCEEDING CHARS IF SQUOZE CHARS. + HLRZ CH1,GDTAB(A) + CAIN CH1,(POPJ P,) + JRST QOTCO3 +QOTCO1: CALL (F) + JRST QOTCO2 + +QOTCO3: CAIN A,"" ;NONSQUOZE: IF IT IS A TEXT SYL INDICATOR, + JRST DQUOT9 ;CONTINUE WITH WHATEVER TYPE OF TEXT + CAIN A,"' + JRST SQUOT9 ;IT INDICATES. + CAIN A,"^ + JRST UPCTR1 +QOTCO6: TLO FF,FLUNRD + JRST TEXT5 + +QOTCO4: MOVE B,LIMBO1 ;GET ' OR ", WHICHEVER STARTED THIS SYL, AS THE DELIMITER. + MOVE SYM,[SQUOZE 0,TEXT] + JSP TM,ERMARK +QOTCO5: CALL RCH + CAMN A,B ;FOUND ANOTHER EXAMPLE OF THE DELIMITER? + JRST [ CALL RCH ;IF DUPLICATED, IT PUTS THE DELIMITER IN THE CONSTANT. + CAMN A,B + JRST .+1 + JRST QOTCO6] ;OTHERWISE UNREAD THE CHAR AFTER THE DELIMITER AND EXIT. + CALL (F) ;HAVE CHAR TO PUT IN STRING IN A; GO MERGE IT IN. + JRST QOTCO5 + +;RETURN A VALUE FROM A PSEUDO WHOSE ARGS CAN BE TERMINATED BY EITHER COMMA (GOBBLED) +;OR CR (NOT GOBBLED). +VALRET: MOVE T,A ;ROUTINE TO RETURN VALUE IN A AFTER LAST CHAR GOBBLED BY GETSYL + MOVE B,CDISP ;GET STORED DISPATCH CODE + TLNN B,DWRD\DFLD + JRST VALR1 ;WORD TERMINATOR +;COME HERE TO RETURN A VALUE, AND ALSO +;BARF IF THE NEXT CHARACTER ISN'T A SYLLABLE SEPARATOR +TEXT5: PUSH P,T ;ENTRY FROM TEXT ROUTINES (NLAST CHAR NOT GOBBLED BY GETSYL) TO RETURN VALUE IN T + PUSHJ P,GETSYL ;SEE IF IMMEDIATELY FOLLOWED BY SYL + TRNE I,IRSYL + ETR ERRNOS ;NO SEPARATOR BETWEEN TWO VALUES + POP P,A ;RESTORE VALUE TO RETURN +VALR1: TRO I,IRSYL + JRST CLBPOP + +;VARIOUS PUSH AND POP ROUTINES, ALL CALLED W/ JSP LINK, + +SGTSY: PUSH P,I + PUSH P,AA + PUSH P,A + PUSH P,B + JRST (LINK) + +SGTSY1: POP P,B + POP P,A + POP P,AA + POP P,I + JRST (LINK) + +;JSP LINK,SAVWD1 TO SAVE STUFF FOR < OR (, ETC. + +SAVWD1: PUSH P,A ;SYLL. BEFORE GROUPING NOW STARTING. + PUSH P,B ;AND ITS RELOC. + +SAVWLD: PUSH P,FORMAT + PUSH P,FORPNR + PUSH P,FLDCNT + PUSH P,GLSP2 + PUSH P,I + PUSH P,WRD + PUSH P,WRDRLC + PUSH P,SYM + PUSH P,PPRIME + PUSHJ P,(LINK) +SAVL1==. + +;POP OFF WHAT PUSHED BY SAVWLD. CLEARS FLUNRD, IN CASE THE > OR ) WAS UN-READ. + +USVWLD: POP P,SYM + HRRZS SYM + CAIE SYM,SAVL1 + HALT + TLZ FF,FLUNRD + POP P,PPRIME + POP P,SYM + POP P,WRDRLC + POP P,WRD + TDZ I,[-1-(ILWORD)] + IOR I,(P) + POP P,1(P) + POP P,GLSP2 + POP P,FLDCNT + POP P,FORPNR + POP P,FORMAT + JRST (LINK) + +;;GETFD ;GET FIELD (EXPRESSION); RETURN VALUE IN A, RELOC BITS IN B + + ;GET FIELD FOR PSEUDO + ;SYM SHOULD CONTAIN THE SQUOZE NAME OF THE PSEUDO + ;OR A POINTER TO AN INSN TO EXECUTE WHEN UNDEF + ;SYMBOL SEEN. SYM IS NOT CLOBBERED. + +AGETFD: PUSH P,I ;SAVE I + TRO I,IRPSUD+IRNOEQ ;SET FLAG TO GETVAL TO EXECUTE GTVER ON UNDEFINED SYM ON EITHER PASS + PUSH P,GTVER ;OLD VALUE OF GTVER + MOVEM SYM,GTVER ;ERROR MSG SHOULD GIVE NAME OF PSEUDO. + CALL YGETFD + MOVE SYM,GTVER + REST GTVER + MOVEM I,ISAV ;SAVE FLAGS FOR FIELD GOTTEN +POPIJ: POP P,I + POPJ P, + +;READ A FIELD, NOT PART OF THE CURRENT WORD. +YGETFD: PUSH P,WRD + SETZM WRD + CALL XGETFD + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + ADD A,WRD ;ADD IN INDEX, INDIRECT FIELDS + POP P,WRD + POPJ P, + +IFN FASLP,[ +FAGTFD: PUSHJ P,AGETFD ;DO AGETFD, COMPLAIN IF RELOCATABLE OR GLOBAL + MOVE TM,GLSP1 + CAMN TM,GLSP2 + SKIPE B + ETSM [ASCIZ /relocatable or external argument/] + POPJ P, +] +;READ A FIELD PART OF CURRENT WORD (FOR XWD, ETC). +XGETFD: PUSH P,PPRIME +AGTFD3: PUSHJ P,GETFLD + MOVE CH1,CDISP + TLNN CH1,DWRD + TLOA FF,FLUNRD ;DELIMITER IS WORD TERMINATOR => RE-READ IT. + TRNE I,IRFLD ;NON-NULL FIELD SUPPLIED => RETURN IT. + JRST AGTFD4 + HRRZ C,CDISP ;ELSE COMMA => RETURN NULL VALUE (0) + CAIN C,SPACE ;SPACE => TRY AGAIN TO READ A FIELD. + JRST AGTFD3 ;NO FIELD, TRY AGAIN +AGTFD4: REST PPRIME + POPJ P, + + ;IN RELOCATABLE FORMAT + ;READ FIELD AND COPY OUT AS WORD + +RGETFD: SETZM WRD ;FIRST INITIALIZE SOME STUFF AS THOUGH AT GETWD + SETZM WRDRLC + MOVE A,GLSPAS + MOVEM A,GLSP1 + MOVEM A,GLSP2 + CALL XGETFD + ADDM A,WRD + ADDM B,WRDRLC + PUSHJ P,PWRDA ;OUTPUT WORD + TLNE I,ILMWRD + JRST IGTXT ;SOAK UP MULTI-WORD FIELD + POPJ P, + +;READ IN A FIELD, RETURN IN A,B SETTING IRFLD IF FIELD NOT NULL. +GETFLD: PUSH P,GLSP1 ;REFERED TO AS GETFLB(P) WHEN ONLY 1 SYL PUSHED. + MOVEM P,PPRIME + TRZ I,IRFLD+IROP +GETFD1: TLNE I,ILMWRD + JRST GETFD9 ;MULTIPLE WORD, RE-CALL PSEUDO + PUSHJ P,GETSYL + TRNE I,IRLET +GETFD9: PUSHJ P,GETVAL ;GET OPERAND (MAYBE SKIPS) +GETFD6: SKIPA C,CDISP ;GET INFO ON SYLLABLE TERMINATOR + JRST GETFD1 ;GETVAL SKIPPED => PSEUDO/MACRO WITH NO VALUE, TRY AGAIN + TLNE C,DFLD + JRST (C) ;FIELD OPERATOR, GO PROCESS + TRNE I,IRSYL ;NO DISP MEANS FIELD TERMINATOR. + TRO I,IRFLD + CAME P,PPRIME ;IF ANY OPERATORS PUSHED, + JSP LINK,GETFD8 ;EVAL THEM. + SUB P,[1,,1] ;FLUSH GLSP1 SAVED AT GETFLD. + RET + +GETFD8: MOVEI TT, ;END OF FIELD HAS VERY LOW PRIORITY. + JRST GETFD7 + +;PUSH AN OPERATOR, MAYBE EVALLING STUFF TO LEFT. +;A HAS LEFT OPERAND (IF ANY), B RELOCATION BITS, +;C ADR OF ROUTINE TO PERFORM OPERATION, LH OF TT HAS PRECEDANCE OF OPERATOR + +GETFDL: MOVEI LINK,GETFD3 ;AFTER MAYBE EVALLING, GO PUSH OPERATOR. + TRO I,IRFLD+IROP + TRNN I,IRSYL + JRST GETFD5 ;UNARY, EVAL NOTHING, JUST PUSH WITH HIGH PRIO. +GETFD2: CAME P,PPRIME ;NO OPS TO LEFT => NOTHING TO EVAL. + CAMLE TT,GETFLP(P) ;COMPARE PRIO OF PREV. OP. AND CURRENT. + JRST (LINK) ;WAIT UNTIL LATER +GETFD7: HRRZ T,GETFLP(P) ;EVAL THE LAST OP ON STACK. + JRST (T) ;GO DO IT NOW (ROUTINE RETURNS TO GETFD4) +GETFD4: SUB P,[4,,4] + JRST GETFD2 + +GETFD5: MOVSI TT,200 ;GIVE UNARY OP HIGH PRIO. TO DO BEFORE NEXT BINARY. +GETFD3: PUSH P,B ;GETFLR(P) + PUSH P,A ;GETFLV(P) + HLL C,TT + PUSH P,C ;GETFLP(P) + PUSH P,GLSP1 ;GETFLG(P) + JRST GETFD1 + +GETFLB==,-4 ;PDL IDX OF GLSP1 BEFORE LEFT OPERAND. +GETFLR==,-3 ;PDL IDX OF RELOC OF LEFT OPERAND. +GETFLV==,-2 ;PDL IDX OF VALUE OF LEFT OPERAND. +GETFLP==,-1 ;PDL IDX OF PRIO,,DISPATCH +GETFLG==0 ;PDL IDX OF GLSP1 AFTER LEFT OPERAND (=BEFORE RIGHT) + +PLS: MOVEI C,PLS1 ;PLUS SIGN, PLS1 IS ROUTINE TO PERFORM OPERATION +MINUS2: MOVSI TT,10 ;SET UP PRECEDENCE OF 10 FOR +, - + JRST GETFDL + +MINUS: JSP C,MINUS2 ;MINUS SIGN + MOVNS A ;NEGATE VALUE OF RIGHT OPERAND + MOVNS B ;ALSO RELOCATION + JUMPGE FF,PLS1 + MOVE T,GETFLG(P) + PUSH P,B + HRLZI B,MINF + PUSH P,C + PUSHJ P,LNKTZ ;COMPLEMENT THE MINUS FLAG ON GLOBALS IN RIGHT OPERAND + POP P,C + POP P,B +PLS1: ADD A,GETFLV(P) ;ADD VALUES + ADD B,GETFLR(P) ;ADD RELOCATIONS + JRST GETFD4 + +LNKTZ: TDZA C,C +LNKTC1: MOVE T,GLSP2 +LINKTC: CAML T,GLSP1 + POPJ P, + SKIPL 1(T) + XORM B,1(T) + SKIPL 1(T) + IORM C,1(T) + AOJA T,LINKTC + +MULTP: MOVEI C,MULTP1 ;ASTERISK, MULTP1 ROUTINE TO PERFORM MULTIPLICATION +DIVID2: MOVSI TT,20 ;20 PRECEDENCE OF MULTIPLICATION, DIVISION + JRST GETFDL + +MULTP1: JUMPGE FF,MULTR ;ON P1, DON'T CHECK THIS, SINCE UNDEF SYMS ARE EXTERNALS + SKIPL CONTRL ;ELSE IN DECREL ASSEMBLY, TEST FOR EXTERNALS. + JRST MULTR + MOVE D,GETFLB(P) ;ACTUALLY, GET HERE FOR ABS ASSEMBLIES TOO, BUT SO WHAT? + CAME D,GLSP1 + ETR [ASCIZ /Externals multiplied/] +MULTR: JUMPE B,MULTP3 ;JUMP ON RIGHT OPERAND NOT RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;BOTH OPERANDS RELOCATED + MOVE T,GETFLV(P) ;GET VALUE OF LEFT OPERAND AND FALL IN + JRST MULTP5 + +MULTP3: MOVE T,A ;RIGHT OPERAND NOT RELOCATED, GET VALUE IN T + MOVE B,GETFLR(P) ;RELOCATION BITS OF LEFT OPERAND +MULTP5: MOVE D,GETFLG(P) ;GLOTB POINTER TO BETWEEN OPERANDS + CAME D,GETFLB(P) + JRST GMUL1 ;LEFT OPERAND HAS GLOBALS + CAME D,GLSP1 + JRST GMUL2 ;RIGHT OPERAND HAS GLOBALS + ;AT THIS POINT, T HAS VALUE OF ABS OPERAND, B RELOC BITS OF OTHER +GMUL4: IMUL A,GETFLV(P) ;MULTIPLY VALUES + IMULB B,T ;MULTIPLY RELOCATION OF ONE BY VALUE OF OTHER + TRZ T,1 + SKIPL CONTRL ;EXCEPT IN STINK ASSEMBLY, OBJECT TO RELOCATION + JRST GETFD4 ;OTHER THAN 0 OR 1 (ONLY AFFECTS DECREL, SINCE + JUMPE T,GETFD4 ;RELOCATION CAN'T BE NONZERO IN ABS ASSEMBLY). +MULTP4: ETR [ASCIZ+Relocatable arg to * or / or Boolean+] + JRST GETFD4 + +GMUL1: TLNE FF,FLPPSS ;LEFT OPERAND HAS GLOBALS, CHEK RIGHT OPERAND + CAMN D,GLSP1 + SKIPA CH1,A ;LOOKS OK, GET VALUE IN CH1 + ETR [ASCIZ /Multiplying two externals/] + SKIPA D,GETFLB(P) ;GET GLOTB POINTER TO BOTTOM OF LEFT OPERAND +GMUL2: MOVE CH1,GETFLV(P) ;GLOBALS IN RIGHT OPERAND ONLY, GET LEFT OPERAND +GMUL3: CAML D,GLSP1 + JRST GMUL4 ;TABLE COUNTED OUT + SKIPGE 1(D) + AOJA D,GMUL3 + JUMPE CH1,GMUL5 ;MULTIPLYING BY ZERO, CLEAR OUT GLOTB ENTRY AND LOOP BACK + LDB CH2,[221200,,1(D)] ;PICK UP MULTIPLICATION FIELD THIS GLOBAL + SKIPN CH2 + MOVEI CH2,1 ;0 => 1 + IMUL CH2,CH1 + CAIN CH2,1 + MOVEI CH2,0 ;IF ONE THEN USE ZERO + DPB CH2,[221200,,1(D)] + AOJA D,GMUL3 + + +GMUL5: CLEARM 1(D) + AOJA D,GMUL3 + +DIVID: JSP C,DIVID2 ;SLASH, PRECEDENCE = 20 +DIVID1: JUMPN B,MULTP4 ;JUMP IF RIGHT OPERAND RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;LEFT OPERAND RELOCATED + EXCH A,GETFLV(P) + IDIV A,GETFLV(P) + MOVEI B,0 + JUMPGE FF,GETFD4 + MOVE D,GETFLB(P) + CAME D,GLSP1 + ETR [ASCIZ /Division involving externals/] + JRST GETFD4 + + ;LOGIC OPERATORS & (PREC = 40), # (PREC = 34), \ (PREC = 30) + +ANDF: MOVSI TT,40 ;& + JSP C,GETFDL + JSP D,LOGIC1 ;GO DO IT + AND A,GETFLV(P) ;INSTRUCTION ARGUMENT TO LOGIC1 + +XORF: MOVSI TT,34 ;# + TRNN I,IRSYL ;IF ABOUT TO BE UNARY, + MOVNI A,1 ;THEN TURN LEFT OPERAND INTO -1 + JSP C,GETFDL + JSP D,LOGIC1 + XOR A,GETFLV(P) + +IORF: MOVSI TT,30 ;\ + JSP C,GETFDL + JSP D,LOGIC1 + IOR A,GETFLV(P) + + ;COMMON EXECUTION ROUTINE FOR LOGICAL OPERATORS + +LOGIC1: JUMPN B,MULTP4 ;NO RELOCATION ALLOWED + SKIPE GETFLR(P) ;NOW CHECK RELOCATION OF LEFT OPERAND + JRST MULTP4 + XCT (D) ;ALL TESTS PASSED, DO IT + JUMPGE FF,GETFD4 ;DON'T CHECK FOR GLOBALS EXCEPT DURING PUNCHING PASS + MOVE D,GETFLB(P) ;PICK UP POINTER TO LEFT OPERAND GLOTB ENTRIES + CAME D,GLSP1 + ETR [ASCIZ /External in arg to \, & or #/] + JRST GETFD4 + +CBAKAR: MOVSI TT,100 ;BACKARROW AS FIELD OPERATOR, PREC = 100 + JSP C,GETFDL ;RETURN TO GETFLD TO READ 2ND ARGUMENT. + JSP D,LOGIC1 ;FOR EVALUATION, CALL LOGIC1 + JSP D,.+1 ;WHICH EXECUTES THIS INSTRUCTION, + MOVE T,A ;TO CALL THIS SUBROUTINE. + MOVE A,GETFLV(P) + LSH A,(T) + JRST (D) + +;D SHOULD HAVE 1 FOR <, 2 FOR (, 3 FOR [ ;] +LSSTH9: JSP LINK,SAVAS1 ;SAVE ASSEM1 PDL LEVELS, .BYTE MODE, ETC. + MOVEM D,ASMOUT ;SAY WHAT KIND OF OPEN WE JUST DID + JRST ASSEM3 ;REENTER ASSEM1 LOOP AT INNER LEVEL. + +;COME HERE TO EXIT FROM AN ASSEM1 LEVEL THAT WAS ENTERED BY LSSTH9. +LSSTHA: SKIPE BYTM ;IN BYTE MODE, DO .WALGN. SINCE ASMDSP + JRST A.BY3 ;STILL POINTS HERE, WE'LL COME BACK. + MOVE P,CONSTP + JSP T,CONNDP ;POP STUFF SAVED BY SAVAS1 + MOVE A,WRD ;RETURN THE WORD IN THE GROUPING + MOVE B,WRDRLC ;(OUR CALLER WILL USVWLD, CLOBBERING WRD) + POPJ P, + +LSSTH: MOVEI D,1 ;1 FOR <. + JSP LINK,SAVWD1 + PUSHJ P,LSSTH9 +LSSTH3: JSP LINK,USVWLD ;POP OFF ALL BUTPREVIOUS SYLL. + +;GROUPINGS EXCEPT (PARENS THAT ADD TO WORD) +;SYLL IMMEDIATELY BEFORE OR AFTER IS ERROR. +LSSTH2: ADDM A,-1(P) ;SYLL BEFORE GROUPING, PUSHED BY SAVWD1. + ADDM B,(P) + TRNE I,IRSYL ;IF WAS SYLL BEFORE GROUPING, ERROR. + ETR ERRNOS +LSSTH5: MOVE A,LIMBO1 ;CHECK FOR FOLLOWING SYLL. + CAIE A,15 + CAIN A,12 + JRST LSSTH6 ;DELIMITER CR OR LF + PUSHJ P,RCH ;NOT CR OR LF, GET NEXT CHAR + CAIN A,"! ;IGNORE EXCLAMATION POINT + JRST .-2 + TLO FF,FLUNRD ;CAUSE IT TO BE RE-INPUT + HLRZ CH1,GDTAB(A) + CAIE CH1,(POPJ P,) + JRST LSSTH4 ;SQUOZE CHAR. MEANS FOLLOWING SYLL. + HRRZ CH1,GDTAB(A) + MOVE CH1,DTB-40(CH1) ;GET DISPATCH FOR CHAR. + TLNE CH1,DSY1 ;MIGHT START SYL => NOS ERROR. + JRST LSSTH4 +LSSTH7: PUSHJ P,GTSL1 +LSSTH6: TRO I,IRSYL + POP P,B + POP P,A ;VALUE OF GROUPING WAS ADDM'ED INTO THESE. + TLZE I,ILLSRT ?.SEE UA3 + RET ;IF CALLED BY ^ OR _ AS SYL OP, RETURN TO IT. + JRST GETFD6 + +LSSTH1: TLO I,ILWORD ;A NUMBER IN PARENS BY ITSELF IS A NONNULL WORD. + ADDM A,WRD + ADDM B,WRDRLC + TRNE I,IRSYL ;IF SYLL BEFORE, + JRST LSSTH5 ;ERROR IF SYL AFTER. + JRST LSSTH8 ;ELSE NO ERROR. + +LSSTH4: ETR ERRNOS ;FOLLOWING SYLL WHEN THAT IS ERROR. +LSSTH8: TLNE I,ILLSRT ?.SEE UA3 + JRST LSSTH6 + SUB P,[2,,2] + JRST GETFD1 + +ERRNOS: ASCIZ /Syllables not separated/ + +POP2J: SUB P,[2,,2] + POPJ P, + +LEFTP: MOVEI D,2 ;2 FOR ). + JSP LINK,SAVWD1 + MOVEI C,0 + TRNE I,IROP + TRNE I,IRSYL + TLO C,400000 ;CAUSE IT TO GET ADDED INTO WORD STEAD HAVE VALUE AS SYL + PUSH P,C + PUSHJ P,LSSTH9 + POP P,C + MOVSM A,T1 ;STORE SWAPPED VALUE + ADDI B,400000 ;NOW WANT TO SWAP RELOCATION, MAKE LH CORRECT + HLREM B,T2 ;STORE AS RH WITH SIGN EXTENDED + MOVSI B,400000(B) ;GET RIGHT HALF IN LEFT + ADDM B,T2 ;FINISH RELOCATION SWAP (THIS IS PAINLESS COMPARED TO THE HAIR EVERYWHERE + ;ELSE WHEN KEEPING THE HALFWORDS SEPARATE) + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + JSP LINK,USVWLD + MOVE A,T1 + MOVE B,T2 + JUMPL C,LSSTH1 ;ADD TO WHOLE WORD + JRST LSSTH2 + +;VERSION OF GETWRD FOR PSEUDO, +;PSEUDO MUST EITHER SAVE I, PPRIME AND GTVER OR RETURN TO ASSEM1. +;SYM SHOULD HOLD NAME OF PSUEUDO. + +AGETWD: MOVEM SYM,GTVER ;STORE NAME OF PSEUDO FOR UNDEF SYM MSGS. + TRO I,IRPSUD\IRDEF\IRNOEQ + PUSHJ P,GETWRD + MOVE SYM,GTVER ;RESTORE SYM. + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + RET + +;;GETWD ;READ A WORD, LEAVE VALUE IN A AND WRD, RELOC IN WRDRLC AND B + +GETWRD: MOVE T,GLSP1 + MOVEM T,GLSP2 + CLEARM FORMAT ;CLEAR FORMAT, WILL ACCUMULATE FORMAT NUMBER BY IDPB + CLEARM WRD ;CLEAR WRD, WILL ACCUMULATE ABSOLUTE PART OF WORD + CLEARM WRDRLC ; " RELOCATION BITS, " + TDZ I,[ILWORD,,IRIOINS] + CLEARM FLDCNT ;NO FIELDS YET + MOVE T,[50100,,FORMAT] ;SET UP BIT POINTER TO FORMAT + MOVEM T,FORPNR +GTWD1: PUSHJ P,GETFLD ;READ NEXT FIELD +SPACE6: MOVEI T,1 ;SET T TO 1, AC FOR IDPB ON ROUTINE DISPATCHED TO + SKIPA C,CDISP +SPACE5: REST A + TLNE C,DWRD + JRST (C) ;NO DISPATCH MEANS WD TERMINATOR + MOVE C,GLSP1 + MOVEM C,LINKL ;MARK END OF ACTIVE PART OF GLOTB + TRNN I,IRFLD + JRST GETWD2 ;LAST FIELD NULL, MAYBE HAVE TO POP STUFF OFF + IDPB T,FORPNR ;MARK NON-NULL FIELD IN FORMAT +GTWD4A: TLO I,ILWORD ;NON-NULL WORD + MOVE TT,FORMAT + SKIPN TT,FORTAB-10(TT) ;PICK UP BYTE POINTER POSITION/SIZE FIELDS FOR FIELDS IN WORD + ETR [ASCIZ /Undefined format/] + MOVEM TT,FORMAT ;STORE IN FORMAT + MOVE T,[301400,,FORMAT] + MOVEM T,FORPNR + ;AT THIS POINT, FLDCNT HAS 1 LESS THAN # FIELDS; PUT FIELDS TOGETHER TO FORM WORD +GTWD3: LDB T,FORPNR + MOVE D,FLDCNT + CAIG D,2 + IBP FORPNR ;HAVEN'T BACKED UP TO THIRD FIELD YET, INCREMENT TO DESC FOR PREV + TRNE I,IRIOINS + PUSHJ P,INTIOW + PUSHJ P,INTFLD ;PUT FIELD WHERE IT BELONGS + SOSGE FLDCNT + JRST GTWD5 ;THIS WAS LAST (FIRST) FIELD + POP P,GLSP2 ;NOT YET, POP OFF MORE + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD3 + +GTWD5: MOVE A,WRD + MOVE B,WRDRLC + MOVE C,LINKL + MOVEM C,GLSP1 + TRZ I,IRIOINS + POPJ P, + +COMMA: TRNN I,IRFLD ;FIELD DELIMITER WAS COMMA (T HAS 1) + JRST COMMA1 ;NO FIELD + IDPB T,FORPNR ;MARK NON-NULL FIELD +COMMA4: IDPB T,FORPNR ;MARK FIELD TERMINATOR WAS COMMA + MOVE TT,FLDCNT + CAIL TT,2 + ETR [ASCIZ /Comma past the 3rd field of a word/] +PUSHFD: PUSH P,A ;DONE WITH THIS FIELD, NOW TO GET NEXT + PUSH P,B + PUSH P,GLSP1 + PUSH P,GLSP2 + AOS FLDCNT ;ANOTHER FIELD + MOVE TT,GLSP1 + MOVEM TT,GLSP2 + HRRZ T,FORPNR + CAIE T,FORMAT + HRRZS FORPNR ;STABILIZE FORPNR + TLO I,ILWORD ;SAY WE HAVE A NON-NULL WORD IN PROGRESS (LOC, ETC. ILLEGAL). + JRST GTWD1 + +GETWD2: SKIPN FORMAT ;LAST FIELD OF WORD IS NULL + JRST GTWD5 ;ENTIRE WORD NULL, MAYBE WERE PARENS. + SOS FLDCNT + POP P,GLSP2 + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD4A + +COMMA1: LDB TT,FORPNR ;COMMA TERMINATED NULL FOELD. + SKIPE FORMAT + JUMPE TT,COMMA2 ;NOT 1ST FIELD, JMP IF PREV WAS TERM BY SPACE. + IBP FORPNR ;ELSE MARK NULL FIELD IN FORMAT. + JRST COMMA4 + +;FIELD SPACE COMMA, PATHOLOGICAL CASE +;(EG MACRO STARTED WITH A COMMA) +COMMA2: DPB T,FORPNR ;REPLACE SPACE WITH COMMA. + JRST GTWD1 + + ;FIELD TERMINATOR IS SPACE (T HAS 1) + +SPACE: MOVE TT,LIMBO1 + CAIE TT,^I ;HEURISTIC: REAL SPACES ARE LIKELY TO BE FOLLOWED BY SQUOZE, + JRST SPACE4 ;WHILE TABS ARE LIKELY TO BE FOLLOWED BY COMMENTS. + PUSH P,A + MOVE TT,GDTAB+40 + PUSHJ P,RCH + CAMN TT,GDTAB(A) + JRST .-2 ;FLUSH OTHER LOGICAL SPACES + CAIN A,"; ;TAB WAS FOLLOWED BY SEMICOLON: + JRST [ PUSH P,B + TRZ I,IRSYL + CALL SEMIC ;FLUSH THE COMMENT + MOVEI T,1 + REST B + JRST SPACE5] ;AND HANDLE THE C.R. +SPACE3: POP P,A + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-READ NEXT TIME +SPACE4: TRNN I,IRFLD + JRST GTWD1 ;NO FIELD + IDPB T,FORPNR ;T HAS 1, MARK NON-NULL FIELD IN FORMAT + IBP FORPNR ;MARK FIELD TERMINATOR WAS SPACE + JRST PUSHFD + +;T HAS DESC BYTE, PUT FIELD IN ITS PLACE +;ALSO CALLED FROM PBYTE, MUSTN'T CLOBBER AA. + +INTFLD: MOVE TT,GLSP2 + CAMN TT,GLSP1 + JUMPE B,INTFD1 ;NO GLOBALS, JUMP IF NO RELOCATION + CAIN T,2222 ;LH + JRST INTL + CAIN T,22 ;RH + JRST INTR + CAIN T,44 ;WHOLE WORD + JRST INTW + SKIPE B + ETR [ASCIZ/Relocation attempted in irrelocatable field/] + ;(ASSUME) NO RELOCATION, CHECK FOR GLOBAL AC FIELDS + CAIN T,2704 ;HIGH AC + JRST INTACH + CAIN T,504 ;AC LOW + JRST INTACL + JUMPGE FF,INTFD1 ;JUMP ON NOT PUNCHING PASS + CAME TT,GLSP1 + ETR [ASCIZ/Global symbol in illegal field/] +INTFD1: MOVEI TT,C_12. + ROTC T,-12. ;SHIFT BYTE POINTER INTO TT + MOVEI C,0 ;INITIALIZE C TO RECEIVE FIELD IN PROPER PLACE + DPB A,TT + CAMN TT,[2200,,C] + JRST INTFD2 ;RIGHT HALF, DON'T ALLOW CARRY INTO LH + ADDM C,WRD ;ALLOW CARRY +INTFD3: ADDM B,WRDRLC ;ADD RELOCATIONS, WILL BE BROKEN BACK INTO HALF-WORDS LATER + POPJ P, + +INTFD2: ADD C,WRD ;ADD RIGHT HALVES + HRRM C,WRD + JRST INTFD3 + +INTIOW: CAIE T,2704 + CAIN T,504 + TRZA A,3 ;IO DEVICE FIELD + POPJ P, ;NOT "AC" FIELD + ADDI T,611-504 + POPJ P, + +INTR: HRRE D,B ;RH + MOVEI B,0 + PUSH P,T + HRLZI C,HFWDF + PUSHJ P,LNKTC1 ;THIS IS A BUG WHICH SHOULD BE FIXED SOMETIME +PRTCL: MOVE B,D ;GET BACK MAPPED RELOCATION BITS +PRTCL2: POP P,T +INTW: MOVE D,GLSP2 ;WHOLE WORD + HRLOI LINK,377777 + CAML D,GLSP1 + JRST INTFD1 + ANDM LINK,1(D) + AOJA D,.-3 + +INTL: HRLZ D,B ;LH + MOVSI B,SWAPF + MOVSI C,HFWDF + PUSH P,T + MOVE T,GLSP2 +INTL2: CAML T,GLSP1 + JRST PRTCL + SKIPGE 1(T) + AOJA T,INTL2 ;INDEX FIELD, ETC => LEAVE ALONE + IORM C,1(T) ;SET HFWDF + XORM B,1(T) ;COMPLEMENT SWAP STATUS + TDNN B,1(T) + SETZM 1(T) ;SWAPPED TO RH, FLUSH IT + AOJA T,INTL2 + +INTACL: TDZA B,B ;AC LOW +INTACH: HRLZI B,SWAPF ;AC HIGH + HRLZI C,ACF + PUSH P,T + PUSHJ P,LNKTC1 + MOVEI B,0 + JRST PRTCL2 + +IOINST: HLLZ A,B ;IO INSTRUCTION, GET WHICH ONE INTO A + SKIPN FLDCNT ;THIS FIRST FIELD OF WORD? + TRO I,IRIOINS ;YES + JRST CLBPOP ;RETURN VALUE + +;TOP LEVEL LOOP, ASSEMBLE STORAGE WORDS +;LOTS OF PSEUDOS MEANINGLESS IN STORAGE WORDS +;(E.G. BLOCK, CONSTA) DO JRST ASSEM1 WHEN DONE +;THERE'S ALSO AN ERROR UUO WHICH RETURNS TO ASSEM1 + +ASSEM1: MOVE P,ASSEMP + JRST @ASMDSP + +;COME HERE TO START THE NEXT EXPRESSION OR WHATEVER. +ASSEM3: PUSHJ P,RCH + CAIN A,^I + JRST ASSEM2 ;PROBABLY NOT PROFITABLE TO SKIP AFTER SEE A TAB. + CAIG A,40 + JRST ASSEM3 ;FLUSH LEADING GARBAGE + TLO FF,FLUNRD ;CAUSE NON-GARBAGE CHAR FOUND TO BE RE-INPUT +;ASMDSP POINTS HERE WITHIN ASCII, SIXBIT ETC. +ASSEM2: TRZ I,IRFLD+IRSYL+IRLET+IRPSUD+IRCOM+IRCONT+IRGMNS+IROP+IRNOEQ+IREQL + TLZ I,ILGLI+ILVAR+ILFLO+ILDECP+ILUARI+ILWORD+ILNPRC + IOR I,ASMI ;SET DEF AND RESTORE PSEUDF. + MOVE A,GLSPAS + SKIPL BYTM + MOVEM A,GLSP1 + ;GETWRD WILL COPY GLSP1 INTO GLSP2 +IFN TS,[AOSN TTYBRF ;DO A ^H-BREAK IF REQUESTED. + CALL TTYBRK] + PUSHJ P,GETWRD + TLZN I,ILWORD + JRST @ASMDSP ;NO WORD ASSEMBLED,TRY AGAIN + SKIPGE BYTM + JRST PBYTE ;IN BYTE MODE, OUTPUT BYTE INSTEAD OF WORD, A,B MUST HAVE WRD,WRDRLC. + MOVE AA,ASMOUT ;OUTPUT WD AS APPRO. FOR GROUPING, IF ANY. + JRST @ASMOT0(AA) + +ASSEM6: SKIPE STGSW ;ASMOT0 POINS HERE. COME IF NOT IN GROUPING. + ETR ERRSWD ;STORAGE WORD ASSEMBLED + PUSHJ P,PWRD ;OUTPUT THE WORD. + AOS CLOC + HRRZS CLOC ;INCREM. POINT . + JRST @ASMDSP ;ASSEM3 OR ASSEM2 + +ERRSWD: ASCIZ /Storage word assembled/ + +ASSEM4: JSP T,PCONST ;ASMOT0+3 POINTS HERE. COME IF IN CONSTANT. + JRST @ASMDSP + +;ASMDSP POINTS HERE WITHIN GROUPING IF NOT IN MULTI-LINE MODE +;[ ;AND NO CLOSE (">)]") HAS BEEN SEEN. +ASSEMC: MOVE AA,ASMOUT + SKIPE CONSML ;IN ERROR MODE, GIVE APPROPRIATE ERROR MSG. + XCT ASMOT3(AA) + JRST @ASMOT2(AA) ;CLOSE WHATEVER TYPE GRPING WE'RE IN. + +;JUMP THRU THIS TABLE TO OUTPUT A WORD. +ASMOT0: ASSEM6? ASSEM1? ASSEM1? ASSEM4? [HALT ] + +;THIS TABLE GIVES APPRO. CLOSE FOR EACH TYPE OF GROUPING. ;[ +ASMOT1: "? ? "> ? ") ? "] ? "? + +;THIS TABLE SAYS WHERE TO GO TO END THE GROUPING. +ASMOT2: [HALT ]? LSSTHA? LSSTHA? CONND? [HALT ] + +;APPROPRIATE ERROR MESSAGE FOR MISSING CLOSE OF GROUPING. [ +ASMOT3: HALT + ETR [ASCIZ /Missing >/] + ETR [ASCIZ /Missing )/] + ETR [ASCIZ /Missing ]/] + HALT + +;THIS TABLE TELLS PBYTE HOW TO HANDLE BYTE MODE. +ASMOT4: PBY4 ? PBY5 ? PBY5 ? PBY3 ? [HALT ] + +;TABLE SAYING WHAT CHAR MUST HAVE OPENED THE GROUPING. +ASMOT5: "? ? "< ? "( ? "[ ? "? ;] + +;;GETVAL ;GET VALUE OF SYM + ;SKIPS ON PSEUDO NOT RETURNING VALUE (E.G. MACRO STARTING TO BE EXPANDED) + ;ELSE RETURNS VALUE IN A, RELOCATION BITS IN B + +VBLK +GTVER: 0 ;SQUOZE NAME OF CALLING PSEUDO, OR POINTER + ;TO INSN TO EXECUTE WHEN IF SYM IS UNDEF. +PBLK + +GETVAL: PUSHJ P,ES + JRST GVNF ;NO STE. +IFN CREFSW,XCT CRFINU ;JFCL OR CALL TO CREF RTN. + JRST @.+1(A) ;FOUND, DISPATCH ON SQUOZE FLAGS + +GVTAB: GVCOM ;COMMON (UNUSED) + GVPSEU ;PSEUDO OR MACRO. + GVSYM ;LOCAL SYMBOL. + GVUL ;LOCAL UNDEF (MAYBE STINK KNOWS VALUE) + GVDLV ;DEFINED LOCAL VAR. + GVULV ;UNDEF LOC VAR. + GVDGV ;DEF GLO VAR + GVUGV ;UNDEF GLO VAR + GVDG ;DEF GLOBAL + GVUG ;UNDEF GLOBAL + +;DEF LOCAL VAR. +GVDLV: PUSHJ P,GVDLGV ;IF PASS2 AND HAS ' THIS TIME, SET 3VAS2 FOR AVARIAB + TLZN I,ILGLI + JRST GVDLV2 + MOVSI T,DEFGVR ;NOW DEF GLO VAR. + PUSHJ P,VSM2 + JRST GVDG1 ;MAYBE OUTPUT GLOBAL DEF. TO STINK. + +GVDGV: PUSHJ P,GVDLGV ;DEF GLO VAR; IF PASS 2 AND ' THIS TIME, SET 3VAS2 + JRST GVDG2 ;MUSN'T PUNCH VALUE, AVARIAB WILL. + +GVDLGV: TRNE FF,FRPSS2 ;IF PASS 2 + TLNN I,ILVAR ;AND THIS TIME HAVE SINGLEQUOTE + POPJ P, + TLO C,3VAS2 ;TELL AVARIAB SEEN IN PASS 2 WITH '. + 3PUT C,D + POPJ P, + +GVULV: TLZN I,ILGLI ;UNDEF LOCAL VAR, MAYBE MAKE GLOBAL. + JRST GVUNDF + PUSHJ P,PLOGLO ;IF SO, TELL STINK SYM IS GLOBAL, + MOVSI T,UDEFGV ;SYM NOW UNDEF GLO VAR + PUSHJ P,VSM2 + JRST GVUNDF ;IN EITHER CASE, HANDLE UNDEF SYM. + +GVUL: TLZE C,3MACOK ;UNDEF LOCAL, PRESUMED NUMERIC + 3PUT C,D ;DON'T LET IT BECOME MACRO AND SCREW PASS2. + TLNE C,3LLV + JRST GVGLTB ;(REALLY DEFINED BUT ONLY STINK KNOWS HOW) + TLNE I,ILGLI ;IF MAKING GLOBAL, TELL STINK. + PUSHJ P,PLOGLO +GVNF1: TLZE I,ILVAR ;IF ', MAKE VAR (WILL CHECK ILGLI) + JRST GVUL1 + TLZN I,ILGLI ;NOT MAKING VAR, MAYBE GLOBAL? + JRST GVUNDF ;NO, MAYBE ERROR, MAKE GLOTB ENTRY. + MOVSI T,GLOEXT + PUSHJ P,VSM2 ;NOW GLOBAL UNDEF, + JRST GVGLTB ;NO ERROR, JUST GLOTB ENTRY. + +GVUL1: TLZN I,ILGLI ;UNDEF LOCAL BECOMES + SKIPA T,[UDEFLV,,] ;UNDEF LOC VAR OR +GVGVAR: MOVSI T,UDEFGV ;UNDEF GLO VAR. +GVVAR: CALL ESDEF ;DEFINING SYM AS A VAR => INSIST ON DEFINING LOCAL TO INNERMOST BLOCK. + JFCL + AOS VARCNT + HRR B,VARCNT + PUSHJ P,VSM2 ;MAKE IT A VAR, + JRST GVUNDF ;PRETEND HAD ALREADY BEEN A VAR. + +GVUG: TLZE I,ILVAR ;UNDEF GLOBAL: MAYBE MAKE UNDEF GLO VAR. + JRST GVGVAR +GVGLTB: SKIPGE CONTRL ;UNDEF GLO IN ABS ASSEM => + JRST GVUND1 ;MAYBE TREAT AS UNDEF. +GVGLT1: AOS GLSP1 ;DON'T KNOW SYM'S VALUE, MAKE GLOTB ENTRY. + MOVEI T,ST(D) + HRRZM T,@GLSP1 + JRST CABPOP ;RETURN 0 AS VALUE. + +GVNF: +IFN CREFSW,XCT CRFINU ;ONLY IF NOT FOUND WOULD NOT CREF AFTER ES. + TLNE I,ILVAR+ILGLI ;MAKING VAR OR GLOBAL FORCED CURRENTBLOCK ALREADY + JRST GVNF1 ;AND WILL STORE NAME IN STE ANYWAY. + SKIPGE ESBK ;ELSE IF NO SPEC'D BLOCK, + TRNN FF,FRNPSS ;FORCE .MAIN BLOCK SO DON'T GET LOTS OF UNDEF ENTRIES. + CAIA ;BUT CAN'T DO THAT FOR 1PASS OR WOULD MISS FWD REFS. + HRRI C,BKWPB + MOVSI T,LCUDF + PUSHJ P,VSM2 + JRST GVUNDF ;MAYBE ERROR, MAKE GLOTB ENTRY. + +GVCOM: TRO I,IRCOM ;COMMON: SAY THIS WAS ONE. + HRRZ A,B ;RETURN RH OF VALUE, ABSOLUTE. + JRST CLBPOP + +GVPSEU: TLNN I,ILVAR+ILGLI ;CAN'T MAKE PSEUD OR MACRO GLOBAL OR VAR. + JRST (B) ;OTHERWISE, DISPATCH TO IT. + TLZE I,ILVAR + ETSM ERRCBV + TLZE I,ILGLI + ETSM ERRCBG + JRST (B) ;DISPATCH TO PSEUDO (OR MACCL IF MACRO) + ;EXPECTS LH OF VALUE IN LH OF B. + +ERRCBV: ASCIZ /Can't be a variable/ +ERRCBG: ASCIZ /Can't be global/ + +GTVL7B: TLNE C,3RLL ;R(LH) + TLO SYM,200000 + TLNE C,3RLR ;R(RH) + TLO SYM,100000 + POPJ P, + +GVSYM: TLNN C,3REL + TLNE I,ILVAR\ILGLI + JRST GVSYM2 + MOVE A,B ;THIS CODE DOES WHAT GVSYM2 WOULD DO, BUT FASTER. + SETZ B, + RET + +GVSYM2: TLZE I,ILVAR ;LOCAL SYM: CAN'T MAKE VARIABLE. + ETSM ERRMDV + TLZN I,ILGLI + JRST GVSYM0 ;NOT MAKING GLOBAL, GET VALUE & RETURN. +GVSYM1: MOVSI T,GLOETY ;BECOMES DEF. GLOBAL. + PUSHJ P,VSM2 + JRST GVDG1 ;HANDLE AS IF WAS DEF GLOBAL. + +ERRMDV: ASCIZ /Multiply-defined variable/ + +GVDG: TLZE I,ILVAR ;GLOBAL ENTRY + ETSM ERRMDV +;COME HERE FOR DEF GLOBAL +GVDG1: SKIPGE CONTRL + JRST GVDLV2 ;DON'T PUNCH VALUE IF ABSOLUTE. + TLNE C,3VP + JRST GVDG2 ;VALUE PUNCHED ALREADY, NOT AGAIN. + JUMPGE FF,GVDG2 + TLNN C,3LLV + TRNE I,IRPSUD+IREQL + JRST GVDG2 + TLO SYM,40000 + PUSH P,WRD + PUSHJ P,OUTDE2 + POP P,WRD +GVDG2: TRNN I,IRPSUD\IREQL ;IF INSIDE AN ORDINARY STORAGE WORD, + TLNN C,3REL ;GENERATE A GLOBAL REF IF GLOBAL IS RELOCATABLE (HEURISTIC). +GVDLV2: TLNE C,3LLV ;IF VAL KNOWN ONLY BY STINK, MUST MAKE A GLOBAL REF. + JRST GVGLTB +GVSYM0: MOVE A,B ;USED IN LBRAK + LDB B,[.BP (3RLR),C] + TLNE C,3RLL + TLO B,1 + POPJ P, + +GVUND1: MOVE A,CONTRL + TRNE A,DECREL+FASL ;DEC FMT OR FASL => UNDEF GLOBALS OK. + JRST GVGLT1 +GVUGV: +GVUNDF: TRZ I,IRDEF ;UNDEFINED, MAYBE ERROR, MAKE GLOTB ENTRY. + TRNE I,IRPSUD\IREQL + JRST GVUND2 ;PSEUDO + TRNN FF,FRPSS2 + JRST GVGLT1 ;PASS 1 + SKIPN CONDEP + ETSM [ASCIZ/Undefined/] + SKIPE CONDEP + ETSM [ASCIZ/Undefined in literal/] + JRST CABPOP + +GVUND2: HLRZ A,GTVER ;DOES GTVER POINT TO AN INSN? + JUMPE A,[XCT @GTVER ? JRST CABPOP] + ERJ .+1 ;NO, IT IS NAME OF PSEUDO. + MOVE A,LINEL + CAIGE A,75. ;CR-LF-TAB NOW IF WHOLE MSG WON'T FIT ON A LINE. + CALL CRRTBX + TYPE2 SYM ;TYPE NAME OF UNDEF SYM. + TYPR [ASCIZ/ Undefined in /] + TYPE2 GTVER + CALL CRRERR + JRST CABPOP + +;EVALUATE SYMBOL, SQUOZE (FLAGS OFF) IN SYM +;IDX OF BLOCK TO DEFINE IN IN ESBK (OR -1 => ANY BLOCK NOW IN PROGRESS). +;DOESN'T CLOBBER F (FOR WRQOTE) +;RETURNS SKIPPING IF SYM FOUND, WITH SQUOZE FLAGS IN BOTTOM OF A, +;VALUE OF SYM IN B, STE IDX IN D, AND 3RDWD IN C. +;IF NOT FOUND, RETURNS IN D THE IDX OF A PLACE TO DEFINE SYM. +;CALL ESDCHK TO GET THE FOLLOWING EXTRA INFO (WHETHER SYM FOUND OR NOT): +;ESLAST -> LAST STE WITH DESIRED NAME SEEN, REGARDLESS OF WHAT BLOCK IT'S IN +;ESL1 HAS LEVEL OF BLOCK OF BEST STE SEEN, -1 IF NOT FOUND +;ESL2 HAS 3RDWRD OF BEST. +;ESXPUN HAS -1 OR IDX OF A STE WHICH MIGHT BE USED TO DEFINE THE SYM. +;RH(TM) GETS BLOCK IDX TO DEFINE IN IF DEFINE THE SYM. +;TT HAS -<# STE NOT LOOKED AT YET> +;THEN IF SYM IS FOUND IN A CONTAINING BLOCK AND YOU WANT TO DEFINE +;IT IN THE CURRENT BLOCK, YOU CAN CALL DEFCHK TO FIND AN STE TO DO IT IN. +;CALLING ESDEF IS AS GOOD AS CALLING ESDCHK AND DEFCHK, BUT DOESN'T +;LET YOU SEE WHAT YOU ARE GOING TO SHADOW. + +ESDEF: MOVE A,BKCUR ;EVAL SYM IN ORDER TO DEFINE IT: + SKIPGE ESBK ;IF NO SPEC'D BLOCK, SPEC THE CURRENT BLOCK, + MOVEM A,ESBK ;SO DEFS IN CONTAINING BLOCKS WON'T BE SEEN + +ESDCHK: SETOM ESLAST ;CALL HERE IF WE MIGHT END UP CALLING DEFCHK, + SETOM ESL1 ;SINCE IN THAT CASE WE'LL NEED THESE VARS EVEN IF SYM IS FOUND + SETOM ESXPUN ;RIGHT AWAY. + MOVN TT,SYMLEN +ES: MOVE C,SYM ;HASH AWAY + TSC C,SYM ;THIS MAKES SURE THAT THE FIRST FEW CHARS OF SYMBOL DON'T GIVE + ;A ZERO REMAINDER, IF SYMLEN IS A ROUND NUMBER. + MOVMS C ;THIS IS BECAUSE IDIV OF NEGATIVE NUMBER GIVES NEG. REMAINDER. + IDIV C,SYMLEN + IMUL D,WPSTE + SKIPGE TM,ESBK ;GET BKTAB IDX OF SPEC'D BLOCK + HRR TM,BKCUR ;OR -1,,BKTAB IDX OF CURRENT BLOCK. +;NOW CHECK FAST FOR AN IMMEDIATE MATCH - AVOID SETTING UP FLAGS NEEDED ONLY WHEN +;SYM APPEARS IN MULTIPLE BLOCKS OR ISN'T DEFINED. + SKIPN B,ST(D) + JRST ESEND0 ;SYM IS KNOWN NOT TO BE DEFINED. + TLZ B,740000 + CAME B,SYM + JRST ESBAD0 ;NOT FOUND IN 1ST ENTRY - MUST SET UP INFO AND LOOP + 3GET C,D + MOVEI A,(C) + CAIN A,(TM) + JRST ESGOOD ;IN THE DESIRED BLOCK => GOOD. + TDNN C,[3MAS,,-1] ;IN THE INITIAL SYMS BLOCK, NOT PRESENT IN ANY OTHER, + JUMPL TM,ESGOOD ;AND BLOCK WASN'T EXPLICITLY SPEC'D => GOOD. + MOVN TT,SYMLEN ;ELSE MUST KEEP LOOKING TO SEE IF THIS DEF IS REALLY ONE WE WANT. + SETOM ESLAST + SETOM ESL1 + SETOM ESXPUN + JUMPGE TM,ESIGN + JRST ESLP1 + +;LOOK AT THE NEXT STE, WHILE LOOPING. +ESLP: SKIPN B,ST(D) ;GET SQUOZE IN THIS ST SLOT + JRST ESEND ;NOTHING WHERE SYM BELONGS, END SEARCH + TLZ B,740000 ;CLEAR OUT FLAGS + CAME B,SYM ;COMPARE WITH WANTED + JRST ESBAD ;NO MATCH BUT MAYBE KEEP GOING + 3GET C,D ;FOUND SYM, GET 3RDWRD + MOVEI A,(C) + CAIN A,(TM) ;DEFINED IN DESIRED BLOCK + JRST ESGOOD ; => MUST BE GOOD. +ESLP0: JUMPGE TM,ESIGN ;BLOCK SPEC'D => ALLOW NO OTHERS. + TDNE C,[3MAS,,-1] ;IF IN INITIAL SYMS BLK, NO MORE DEFS, + JRST ESLP1 + SKIPGE ESL1 ;AND NO PREVIOUS DEFS, + JRST ESGOOD ;UNREDEFINED INITL SYM MUST BE GOOD. +ESLP1: HLRZ B,BKTAB+1(C) ;GET LEVEL OF BLOCK DEF. IS IN. + CAMN A,BKPDL(B) ;SAME AS BLOCK WE'RE IN AT THAT LEVEL? + CAMLE B,BKLVL ;AND NOT A BLOCK WE'VE EXITED + JRST ESIGN + CAMG B,ESL1 ;OR HIGHER LEVEL THAN PREVIOUS BEST + JRST ESIGN + MOVEM C,ESL2 ;REPLACE BEST'S 3RDWRD, LEVEL, ADDR. + MOVEM B,ESL1 + MOVEM D,SADR +ESIGN: HRRZM D,ESLAST ;THIS ENTRY LAST SEEN WITH THIS NAME. + TLNN C,3MAS ;MORE STE'S FOR THIS SYM => + JRST ESEND1 + JRST ESNXT ;KEEP LOOKING. + +;COME HERE IF 1ST SYM SEEN ISN'T THE SAME NAME. SET UP TO LOOP. +ESBAD0: MOVN TT,SYMLEN + SETOM ESLAST + SETOM ESL1 + SETOB C,ESXPUN +;HERE WHILE LOOPING WHEN SYM WITH WRONG NAME IS SEEN. +ESBAD: JUMPN B,ESNXT + SKIPGE A,ESXPUN ;IF THIS IS 1ST EXPUNGED ENTRY SEEN + MOVEM D,ESXPUN ;REMEMBER IT FOR DEFINITION. + SKIPGE A + HRROS ESLAST ;AND SET OLD ENTRY'S 3MAS. +ESNXT: ADD D,WPSTE + CAML D,SYMSIZ ;AT END => GO TO BEGINNING + MOVEI D,0 + AOJN TT,ESLP + JRST ESEND1 ;NOT FOUND. + +ESEND0: MOVEI C,(TM) ;COME HERE IF 1ST PLACE LOOKED AT SHOWS THE SYM ISN'T DEFINED + MOVEM D,ESXPUN + POPJ P, + +ESEND: SKIPGE A,ESXPUN ;FREE ENTRY CAN BE USED TO DEFINE. + MOVEM D,ESXPUN + SKIPGE A + HRROS ESLAST +ESEND1: SKIPGE ESL1 ;NOT FOUND => FIND PLACE TO DEFINE IT. + JRST DEFCH1 + MOVE D,SADR ;IDX OF BEST FOUND. + TRNN FF,FRNPSS + JRST ES1PS ;1-PASS, SPECIAL CHECK. + MOVE C,ESL2 ;GET BEST'S 3RDWRD. +ESGOOD: LDB A,[400400,,ST(D)] ;GET SQUOZE FLAGS IN A. +ES1POK: MOVE B,ST+1(D) ;VALUE OF SYM. IN B. + ;D HAS IDX OF 1STWRD IN SYM TAB. + ;C HAS 3RDWRD +POPJ1: AOS (P) +APOPJ: +CPOPJ: POPJ P, + +;ESDCHK THEN DEFCHK IS SAME AS CALLING ESDEF. +;WE ASSUME THAT D AND TT ARE STILL SET UP FROM A CALL TO ESDCHK. +DEFCHK: SKIPGE ESL1 ;IF WE DIDN'T TAKE TIME TO SET ESLAST BEFORE, + HRRZM D,ESLAST ;DO IT NOW. (SEE BEFORE ESLP1) + JRST DEFCH1 + +ES1PS: LDB A,[400400,,ST(D)] ;1PASS & FOUND IN CONTAINING BLOCK: + MOVE C,ESL2 + TRNN C,-1 ;INITIAL SYM, OK; + JRST ES1POK + CAIE A,1 ;PSEUDO OR MACRO + TLNE C,3DOWN ;OR .DOWN'D SYMBOL OK; + JRST ES1POK ;ELSE GET NEW STE TO DEF. +DEFCH1: MOVEI C,(TM) ;INITIALIZE NEW 3RDWRD WITH BLOCK TO DEF IN. + SKIPL D,ESXPUN ;IF FOUND EXPUNGED OR FREE ENTRY, USE IT. + JRST DEFCH2 + SKIPGE D,ESLAST ;ELSE LOOK FOR ONE. + ETF ERRSCE +DEFCH4: MOVE B,ST(D) + TLZ B,740000 + JUMPE B,DEFCH3 ;MUST RETURN 0 IN B IF DON'T SKIP. + ADD D,WPSTE + CAML D,SYMSIZ + MOVEI D,0 + AOJL TT,DEFCH4 ;ASSUME TT LEFT AROUND FROM ES. + ETF ERRSCE +ERRSCE: ASCIZ /Symbol table full/ + +;ESLAST HAS -1 IF NO ENTRY SEEN; ELSE +;RH HAS IDX OF LAST SEEN, SIGN SET IF SEEN BEFORE PLACE TO DEFINE. +DEFCH3: MOVEM D,ESXPUN ;REMEMBER ADDR WHERE CAN DEFINE + HRROS ESLAST ;LAST PLACE SEEN MUST BE EARLIER. +DEFCH2: SKIPL A,ESLAST + JRST DEFCH5 ;LAST PLACE SEEN WAS SEEN AFTER PLACE TO DEFINE. + CAMN A,[-1] + POPJ P, ;REALLY NEVER SEEN. + MOVSI TM,3MAS + IORM TM,ST+2(A) ;PLACE SEEN IS EARLIER, SET ITS 3MAS. + POPJ P, + +DEFCH5: TLO C,3MAS ;PLACE TO DEF BEFORE EXISTING STES. + POPJ P, + +;ENTER A SYM IN SYMBOL TABLE + ;B HAS VALUE + ;C HAS 3RDWRD + ;D HAS INDEX INTO ST (PROBABLY SET UP BY ES) + ;T HAS SQUOZE FLAGS (ONLY) IN PLACE FOR IOR OF SQUOZE + ;SYM HAS SQUOZE, FLAGS OF WHICH ARE IGNORED + +VSM2LV: TLOA C,3LLV ;ENTRY FOR LINKING LOADER MUST SUPPLY VALUE +VSM2W: MOVE B,WRD ;ENTRY TO ENTER VALUE OF WRD STEAD B +VSM2: MOVE CH1,SYM + TLZ CH1,740000 + IOR CH1,T ;CH1 := SQUOZE WITH FLAGS + MOVEM CH1,ST(D) ;STORE SQUOZE + MOVEM B,ST+1(D) ;STORE VALUE +VSM3A: 3PUT C,D ;STORE 3RDWRD + POPJ P, + +;RETURN THE NUMBER OF SYMTAB SLOTS IN USE. +A.SYMCN:MOVE D,SYMAOB + SETZ A, +A.SYC1: MOVE B,ST(D) + TLZ B,740000 + SKIPE B + AOS A + ADD D,WPSTE1 + AOBJN D,A.SYC1 + JRST CLBPOP + +;;EQUAL ;EQUAL SIGN ENCOUNTERED, DO PARAMETER ASSIGNMENT + +EQUAL: TLZ FF,FLHKIL + PUSHJ P,RCH + CAIE A,"= ;DECIDE WHETHER TO HALF-KILL THE SYM. + TLOA FF,FLUNRD + TLO FF,FLHKIL + SETZM LABELF + CALL RCH + CAIE A,": ;DECIDE WHETHER TO MARK SYM AS NOT REDEFINABLE. + TLOA FF,FLUNRD + SETOM LABELF + CAMN SYM,[SQUOZE 0,.] ;.=FOO, SAME AS LOC FOO + JRST PTEQ + TDNN I,[ILWORD,,IROP+IRNOEQ] + TRNN I,IRLET + ETR [ASCIZ/= With bad format or bad context/] + PUSH P,SYM + PUSH P,ESBK + PUSH P,I + MOVEI A,[ETSM [ASCIZ/Undefined in =/]] + MOVEM A,GTVER + TRO I,IRNOEQ+IRDEF+IREQL + PUSHJ P,GETWRD + TRNN I,IRDEF + JRST ASEM1A ;UNDEFINED SYMS IN VALUE, IGNORE +IFN LISTSW,[ + SKIPN LSTONP + JRST EQUAL1 ;NOT LISTING. + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE SYM,WRD + MOVEM SYM,LISTWD + MOVE SYM,WRDRLC + MOVEM SYM,LSTRLC + SETOM LISTAD + SETOM LISTPF +EQUAL1: +] ;END IFN LISTSW, + TDZ I,[-1-(ILMWRD)] + IOR I,(P) + TLZ FF,FLUNRD + POP P,(P) + POP P,ESBK + POP P,SYM + MOVE A,WRDRLC ;GET RELOCATION + TDNN A,[-2,,-2] ;SKIP ON NON-STANDARD RELOCATION BITS + SKIPE LDCCC + JRST EQG1 ;STRANGE RELOCATION OR IN LOAD TIME CONDITIONALS => HAND PROBLEM TO LOADER + MOVE A,GLSP1 + CAMN A,GLSP2 + JRST EQL1 ;NO GLOBALS IN DEFINITION +;FALLS THROUGH. + +;FALLS THROUGH. +;GLOBALS TO RIGHT OF = OR WITHIN LOADER CONDIT. +EQG1: IFN CREFSW, XCT CRFLBL ;CREF DEF. OF NORMAL SYM, + SKIPGE CONTRL + JUMPL FF,[ETASM [ASCIZ /Externals in =/]] + CALL ESDCHK ;SEARCH SYM TAB. + JRST EQL2 ;NOT FOUND IN CURRENT OR CONTAINING BLKS. + HRRZI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQG1A + XCT EQG1TB(A) ;FOUND IN DESIRED BLOCK. + JRST ASSEM1 + +EQG1A: JUMPN T,EQG2 + CAIN A,PSUDO_-16 ;FOUND AS INITIAL PSEUDO => ERROR. + ETSM ERRQPA +EQG2: CALL DEFCHK ;FIND FREE STE TO DEFINE IN DESIRED BLOCK. + JRST EQL2 ;PRETEND WASN'T FOUND. + +ERRQPA: ASCIZ /Shadowing a pseudo-op/ +ERRIPA: ASCIZ /Illegal =/ + +EQG1TB: ETSM ERRIPA ;COMMON + ETSM ERRIPA ;PSEUDO OR MACRO + JRST EQL2 ;SYM + JRST EQGUL ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL7 ;GLO ENTRY + JRST EQL8 ;GLO EXIT + +EQL8: PUSHJ P,GLKPNR + TLZ C,3LABEL\3MULTI +EQL7: MOVSI T,GLOETY ;GLOBAL PARA ASSIGN + MOVEI B,0 + TLO SYM,40000 +LOPRA1: PUSH P,CASM1A ;RETURN TO ASSEM1A AFTER FOLLOWING. + TLNE C,3MULTI + ETSM ERRMDT + SKIPE LABELF + TLO C,3LABEL + TLNE FF,FLHKIL + TLOA SYM,400000 ;SET FLAG TO HALF-KILL SYM + TLZA C,3SKILL + TLO C,3SKILL ;SET CORRESPONDING FLAG IN 3RDWRD + PUSHJ P,VSM2LV + JUMPGE FF,CPOPJ ;JUMP ON NOT PUNCHING PASS + TRNN I,IREQL ;IF CAME FROM COLON ROUTINE, + JRST PDEFPT ;PUNCH "DEFINE SYM AS $.". + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D ;STORE UPDATED 3RDWRD + PUSHJ P,EBLK + MOVEI TT,LGPA + DPB TT,[310700,,BKBUF] + PUSHJ P,OUTSM0 + PUSHJ P,PWRDA + JRST EBLK + +EQGUL: PUSHJ P,LKPNRO ;LOCAL UNDEF, OUTPUT LINK REQUEST. + TLZ C,3LABEL\3MULTI ;CAN'T DETECT MDT'S WHEN ONLY STINK KNOWS FOR SURE. +EQL2: TLNE I,ILGLI + JRST EQL7 ;MAKE IT GLOBAL + MOVSI T,LCUDF ;LOCAL UNDEFINED + JRST LOPRA1 + +CASM1A: JRST ASEM1A + +;MAYBE PUNCH OUT LINK REQUEST +;SYM HAS NAME OF SYM TO REQUEST, D STE IDX OF SYM, C 3RDWRD, B ADR OF REQUEST +;REQUEST WILL BE PUNCHED IF 3RLNK SET IN C OR IF ANYTHING SET IN LH(B) + +GLKPNR: TLO SYM,40000 ;GLO BIT +LKPNRO: TLNN C,3RLNK + TLNE B,-1 + TROA I,IRCONT + POPJ P, ;DON'T PUNCH REQUEST + MOVE A,CONTRL + TRNE A,DECREL + JRST LKPNDR ;DIFFERENT WAY TO OUTPUT THIS INFO IN DECREL FMT + MOVEI A,6 + PUSHJ P,PBITS + PUSHJ P,OUTSM0 ;PUNCH SYM + HLRZ A,B + TLZE C,3RLNK ;RELOC OF LINK PNR + TLO A,100000 + HRRZS B ;CLEAR OUT LH OF B + TRZ I,IRCONT ;OK TO END BLOCK NOW + JRST $OUTPT ;PUNCH OUT A AND RETURN + +LKPNDR: MOVSI A,DECINT ;WRITE AN "INTERNAL REQUEST" WITH ONE DATA WORD. + CALL DECBLK + SETZ TM, ;COMPUTE RELOC OF ADDRESS AND DATA IN TM. + TLNE C,3RLNK + TRO TM,2 + SKIPE WRDRLC + TRO TM,1 + MOVE A,WRD ;ADDRESS TO LINK,,DATA + HRL A,B + CALL DECWR1 + JRST EBLK + +;THESE ASSUME STE IDX IN D, SQUOZE W/ FLAGS IN SYM. +;C HAS 3RDWRD, B OR WRD HAS VALUE TO DEF. WITH. +;CALL ONLY IN RELOCATABLE ASSEMBLY. +OUTDE2: MOVEM B,WRD +OUTDE1: TLNE FF,FLPPSS + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D + SKIPGE CONTRL + RET + TRO I,IRCONT + SETZ A, + TLNN C,3LABEL ;WHAT KIND OF DEFINITION DEPENDS ON WHETHER SYM IS REDEFINABLE. + MOVEI A,CRDF + CALL P7X ;PUNCH OUT CODE BITS + PUSHJ P,GTVL7B ;SET RELOCATION BITS IN SQUOZE + PUSHJ P,OUTSM0 + TRZ I,IRCONT + JRST OUTWD ;OUTPUT VALUE + +;PUNCH OUT LOCAL-GLOBAL RECOVERY BITS AND SYM +;I.E. TELL LOADER THAT SQUOZE IN SYM, FORMERLY CONSIDERED LOCAL, IS REALLY GLOBAL +PLOGLO: SKIPGE CONTRL + RET + PUSH P,A + PUSHJ P,PBITS7 + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY THIS IS NEW STYLE RQ, + PUSHJ P,OUTSM0 ;PUNCH "OLD NAME" = SYMTAB IDX, + TLC SYM,440000 ;SAY MAKE GLOBAL, OUTPUT ACTUAL NAME OF SYM. + PUSHJ P,OUTSM + JRST POPAJ + +;NO GLOBALS TO RIGHT OF EQUAL SIGN + +EQL1: PUSHJ P,ESDCHK + JRST EQL1A ;NOT FOUND +IFN CREFSW,XCT CRFEQL ;DEF. OCCUR. OF NORMAL SYM. OR INTSYM. + MOVEI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQL1F + SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL + XCT EQL1TB(A) ;FOUND IN DESIRED BLOCK => NOW REDEFINE. + JRST ASSEM1 + +EQL1F: JUMPN T,EQL10 + CAIE A,PSUDO_-16 + JRST EQL10 + MOVEI T,(B) ;FOUND AS PSEUDO IN INITIAL SYMS BLOCK, + CAIN T,INTSYM ;SPECIAL WAY TO REDEFINE IF LIKE .MLLIT, ETC. + JRST EQLINT + ETSM ERRQPA ;SHADOWING AN INITIAL PSEUDO, TELL USER. +EQL10: CALL DEFCHK ;FOUND IN OUTER BLOCK, GET NEW STE, + JRST EQL1A ;DEFINE THERE AS IF NOT FOUND. + +EQL1TB: ETSM ERRIPA ;COMMON + JRST EQL1B2 ;PSEUDO OR MACRO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL1D ;GLO ENTRY + JRST EQL1E ;GLO EXIT + +EQL1E: PUSHJ P,GLKPNR ;DUMP LINKING POINTER + CAIA +EQL1D: CALL MDTCHK + PUSHJ P,RCHKT ;GLO ENTRY +EQLB2: PUSHJ P,RMOVET + TLNE FF,FLHKIL + TLOA SYM,400000 + TLZA C,3SKILL + TLO C,3SKILL + HRLZI T,GLOETY + SKIPE LDCCC ;IF IN LOADER CONDITIONAL, + TLO C,3LLV ;THEN LOADER MUST SUPPLY VALUE + PUSHJ P,VSM2W ;DEFINE SYM + TLO SYM,40000 ;SET GLOBAL BIT IN SQUOZE +EQL1CE: JUMPGE FF,ASEM1A + PUSHJ P,OUTDE1 +ASEM1A: TLNE I,ILMWRD + PUSHJ P,IGTXT + JRST ASSEM1 + +;CHECK WHETHER DEFINING AN MDT, OR REDEFINING A LABEL (=> THIS IS AN MDT) +MDTCHK: TLNN C,3LABEL + JRST MDTCH1 + CALL GVSYM0 ;MOVE VALUE OF SYM TO A, GET RELOC (WRDRLC STYLE) IN B + CAMN A,WRD + CAME B,WRDRLC ;IF WE'RE CHANGING THE VALUE, MARK SYM AS MDT +MDTCHL: TLO C,3MULTI +MDTCH1: TLNE C,3MULTI ;EVER ASSIGNING TO MDT, EVEN SAME VALUE, GIVES ERR MSG + ETSM ERRMDT + RET + +EQL1C: TLNE I,ILGLI + JRST EQL1CA ;MAKE GLOBAL + PUSH P,C + PUSHJ P,LKPNRO ;MAYBE OUTPUT LINK REQUEST + PUSHJ P,RCHKT + PUSHJ P,RMOVET ;INITIALIZE 3RDWRD + MOVSI T,SYMC ;SYM + PUSHJ P,EQA2A ;ENTER DEF IN SYMTAB + TLNE C,3SKILL + TLO SYM,400000 + POP P,AA + TLNE AA,3VCNT ;USED IN CONSTANT + PUSHJ P,CONBUG + JRST EQL1CE + + ;PUNCH OUT CODE BIT PAIR, FIRST OF WHICH IS 7 + +P7X: MOVEM A,PARBIT ;ENTRY FOR SECOND BYTE IN A +P70: PUSHJ P,PBITS7 ;ENTRY FOR SECOND BITE IN PARBIT, PUNCH OUT THE 7 + SKIPA A,PARBIT ;GET SECOND BYTE BACK +PBITS7: MOVEI A,7 ;ENTRY TO JUST PUNCH OUT 7 + JRST PBITS + +EQL1CA: PUSHJ P,PLOGLO + JRST EQL1E +EQA2: PUSH P,CASM1A +EQA2A: TLNE FF,FLHKIL + TLO C,3SKILL + JRST VSM2W + +EQL1B2: HRRZ A,B ;ATTEMPT TO ASSIGN PSEUDO-OP, IS IT AN INTSYM? + CAIN A,INTSYM + JRST EQLINT ;YES, GO SET WD IT POINTS TO. + ETSM [ASCIZ /Pseudo or macro ='D/] +EQL1B: CALL MDTCHK + PUSHJ P,RCHKT + TLNE I,ILGLI + JRST EQLB2 ;WAS LOCAL, MAKE IT GLOBAL + ;WAS LOCAL, LEAVE IT LOCAL + PUSHJ P,RMOVET ;PUT RELOCATION BITS IN BITS 0 AND 1 OF C (I.E. START SETTING UP 3RDWRD) + MOVSI T,SYMC ;SYM + JRST EQA2 + +EQL1A1: PUSHJ P,RCHKT + PUSHJ P,RMOVET + HRLZI T,SYMC + JRST EQA2 + +EQL1A: SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL +IFN CREFSW,XCT CRFLBL ;DEF. OCCUR. OF NORMAL SYM. + TLNN I,ILGLI + JRST EQL1A1 + JRST EQL1E + +EQLINT: HLRZS B ;GET ADDR OF WD HOLDING VALUE. + MOVEMM (B),WRD ;PUT NEW VALUE IN IT. + JRST ASEM1A + +;;. ;ROUTINES DEALING WITH THE CURRENT LOCATION AND OFFSET + +VBLK +CLOC: 0 ;PUNCHING LOC +CRLOC: 0 ;PUNCHING RELOC +OFLOC: 0 ;OFSET VAL +OFRLOC: 0 ;OFSET RELOC +;VAL OF PT=CLOC+OFLOC,CRLOC+OFLOC +SYLOC: 0 ;VAL OF LAST TAG +SYSYM: 0 ;LAST TAG +SYLOC1: 0 ;VALUE OF NEXT TO LAST TAG +SYSYM1: 0 ;NEXT TO LAST TAG +GLOCTP: 0 ;4.9 => CURRENT LOCATION GLOBAL, 2.9 => OFFSET GLOBAL + ;FRGLOL (FLAG IN FF) IS IOR OF BITS 4.9 AND 2.9 OF GLOCTP + ;EXCEPT AFTER .=NON-GLOBAL WITH GLOBAL OFFSET + ;OTHER BITS USED ONLY WHEN IN LINK (NEVER SET IN GLOCTP): + ;400 => ARG GLOBAL +PBLK + + + ;POINT (.) AS PSEUDO-OP + +GTVLP: TRNE FF,FRGLOL + JRST GTVLP2 ;LOCATION GLOBAL + MOVE B,OFRLOC ;GET RELOCATION OF OFFSET + ADD B,CRLOC ;ADD CURRENT RELOCATION + MOVE A,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 ;IF IN BYTE MODE, + HLL A,BYTWP ;SET LEFT HALF TO BYTE POINTER LEFT HALF FOR ILDB + ADD A,OFLOC ;NOW ADD OFFSET + TLZ I,ILFLO+ILDECP+IRPERI ;CLEAR OUT FLAGS SET WHEN LOOKED LIKE FLOATING POINT NUMBER + POPJ P, + + +GTVLP2: MOVEI T,$.H ;LOCATION GLOBAL + AOS GLSP1 + HRRZM T,@GLSP1 ;PUT $. ON GLOBAL LIST (INCLUDES OFFSET, WHETHER GLOBAL OR NOT) + SKIPL BYTM1 ;IN BYTE MODE? + TDZA A,A ;NO, CLEAR ABS PART OF VALUE + HLLZ A,BYTWP ;YES, USE LH(BP) AS ABS PART + JRST CLBPOP + +$.H: (GLOETY)+SQUOZE 0,$. ;CURRENT LOCATION + OFFSET IN LOADER +$L.H: (GLOETY)+SQUOZE 0,$L. ;LOCATION BEING LOADED INTO BY LOADER, USED BY ABLOCK +$O.H: (GLOETY)+SQUOZE 0,$O. ;LOADER OFFSET +$R.H: (GLOEXT)+SQUOZE 0,$R. ;RELOCATION AS GLOBAL + +COLON: TRNE I,IRLET + TRNN I,IRSYL + ETA [ASCIZ/Colon without preceding symbol/] + TLNN I,ILWORD + TRNE I,IROP+IRPSUD+IREQL+IRNOEQ + ETSM [ASCIZ/Label inside an expression/] + SKIPE ASMOUT + ETSM [ASCIZ /Label inside <>, () or []/] + TLZ FF,FLHKIL + PUSHJ P,RCH ;GET NEXT CHAR + CAIN A,": ;IF NEXT CHAR ANOTHER COLON, + TLOA FF,FLHKIL ;THEN SET FLAG TO HALF-KILL + TLO FF,FLUNRD ;NOT COLON, CAUSE IT TO BE RE-INPUT + SKIPE HKALL ;CHECK FOR HALF-KILL-ALL-LABELS MODE. + TLO FF,FLHKIL + MOVE T,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 + HLL T,BYTWP ;BYTE MODE, SET LEFT HALF OF VALUE TO LEFT HALF OF BYTE POINTER + ADD T,OFLOC ;ADD OFFSET + MOVEM T,WRD ;STORE RESULT AWAY FOR POSSIBLE PUNCHOUT + EXCH T,SYLOC ;NOW SET UP STUFF FOR ERROR PRINTOUT + MOVEM T,SYLOC1 + EXCH SYM,SYSYM + MOVEM SYM,SYSYM1 + MOVE SYM,SYSYM + MOVE A,CRLOC ;SET UP RELOCATION + ADD A,OFRLOC + MOVEM A,WRDRLC + SETOM LABELF ;SET FLAG CAUSING 3LABEL (DON'T REDEFINE) TO BE SET. + SKIPN LDCCC + TRNE FF,FRGLOL + JRST GCOL1 ;LOCATION VIRTUAL OR IN LOAD TIME CONDITIONAL + PUSHJ P,ESDCHK ;TRY FINDING CURRENT ENTRY IN ST + JRST EQL1A ;NOT ALREADY DEFINED +IFN CREFSW,XCT CRFLBL +COLON1: MOVEI T,(C) ;BKTAB IDX OF BLOCK FOUND IN, + CAIE T,(TM) ;FOUND IN DESIRED BLOCK => TRY REDEFINING. + JRST COLON3 + TLO C,3LABEL ;CAUSE REDEFINING SYMBOL TO BARF + XCT COLON2(A) ;BUT MAYBE PRINT ERR MSG FIRST. + JRST EQL1B + +CASSM1: JRST ASSEM1 + +COLON3: JUMPN T,EQL10 ;NOT INITIAL SYM => CAN SHADOW, + CAIN A,SYMC_-14. ;INITIAL SYM => CAN SHADOW IF IT'S AN ORDINARY LOCAL SYM + CAME B,WRD ;AND NEW VALUE SAME AS OLD VALUE. + CAIA + SKIPE WRDRLC + ETSM ERRRES ;ELSE GIVE ERROR MESSAGE BEFORE SHADOWING, TO WARN USER. + JRST EQL10 + +ERRRES: ASCIZ /Pseudo, macro or initial sym as label/ +ERRMDT: ASCIZ /Multiply defined/ + +COLON2: TLO C,3MULTI ;COMMON + ETSM ERRRES ;MACRO OR PSEUDO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI ;SETTING 3MULTI CAUSES EQL1B TO PRINT AN MDT ERROR. + JRST EQL1D ;GLOBAL ENTRY + JRST EQL1E ;GLO EXIT + +;COLON WHEN LOCATION VIRTUAL, OR IN LOAD TIME CONDITIONAL + +GCOL1: IFN CREFSW,XCT CRFLBL ;DEFINING ORDINARY SYM. + SKIPGE CONTRL + ETASM [ASCIZ /Virtual label in abs assembly/] + PUSHJ P,ESDCHK ;FIND ITS SLOT IN ST + JRST EQL2 ;JUST LIKE EQG1 EXCEPT FOR ERROR MESSAGES. + MOVEI T,(C) + CAIE T,(TM) + JRST COLON5 + XCT GCOL1T(A) ;FOUND IN DESIRED BLOCK, REDEFINING. + JRST EQL2 + +COLON5: JUMPN T,EQG2 ;SHADOWING, OK UNLESS INITIAL SYM. + ETSM ERRRES + JRST EQG2 + +GCOL1T: TLO C,3MULTI ;COMMON + ETSM ERRRES ;PSEUDO. + JRST EQL2 ;SYM. + JRST EQGUL ;LOCAL UNDEF. + TLO C,3MULTI ;VAR + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + JRST EQL7 ;DEF GLO + JRST EQL8 ;UNDEF GLO. + + + ;PUNCH OUT "DEFINE SYM AS $." + +PDEFPT: MOVEI A,CDEFPT + PUSHJ P,P7X ;OUTPUT 7 THEN PDEFPT + JRST OUTSM0 ;OUTPUT SYM, WITHOUT BITS + +;LOC, BLOCK, .= + +ALOC: PUSHJ P,ALOCRG ;LOC, GET ARG +ALOC1: SETZM SYLOC ;CLEAR OUT LOC OF LAST TAG + SETZM SYSYM ;CLEAR OUT LAST TAG SO ERROR MESSAGES DON'T PRINT OBSCENE INCREMENTS +IFN FASLP,[ + SKIPGE TM,CONTRL + TRNN TM,FASL + JRST .+2 + ETA [ASCIZ /LOC illegal in FASL assembly/] +] + TRZE LINK,400 ;GLOBALS IN ARG? + JRST ALOC2 ;YES + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF CURRENT LOCATION + CALL SLOCF ;RE-INIT NEXT OUTPUT BLOCK'S HEADER; SET LOCF. + MOVEI A,LCEGLO ;=> RESET GLOBAL RELOCATION (BACK TO ORIGINAL NON-GLOBAL RELOCATION) + TLZE LINK,400000 ;IS CURRENT LOCATION NOW GLOBAL? + PUSHJ P,PLDCM ;YES, RESET IT + MOVE B,WRDRLC ;GET BACK NEW RELOCATION +ALOC2B: TRZE B,-2 ;NO BITS ALLOWED EXCEPT LOW ORDER + ETR [ASCIZ *Illegal relocation in LOC/BLOCK/.=*] + HRRZM B,CRLOC ;STORE NEW RELOCATION + SKIPGE CONTRL + JRST ASSEM1 ;DON'T BOTHER WITH REST IF ABS. + MOVEI B,2(B) ;LABS OR LREL + DPB B,[310700,,BKBUF] ;STORE NEW BLOCK TYPE + MOVEM B,CDATBC ;ALSO STORE AS NORMAL BLOCK TYPE +AOFSTX: TDNN LINK,[SETZ(SETZ)] ;ENTRY FROM AOFFSET, SKIP IF FRGLOL SHOULD BE SET + TRZA FF,FRGLOL ;CURRENT LOCATION PLUS OFFSET NOT GLOBAL, CLEAR FLAG + TRO FF,FRGLOL ;GLOBAL, SET FLAG + TRZ LINK,600 ;CLEAR OUT TEMPORARY FLAGS SO WON'T GET STORED IN GLOCTP + MOVEM LINK,GLOCTP ;STORE BACK STATUS FLAGS + JRST ASSEM1 + +PTEQ: MOVE SYM,[SQUOZE 0,LOC] + PUSHJ P,ALOCRG ;.=, GET ARG + MOVE T,[MINF+HFWDF,,$O.H] ;GLOTB ENTRY IF .+1 DOESN'T SKIP + TRNE LINK,400000 ;OFFSET GLOBAL? + JRST PTEQ2 ;YES, WANT TO DO LOC ARG-$O." + PUSHJ P,SBWDOF ;OFFSET IS LOCAL, SUBTRACT FROM ARG + JRST ALOC1 + +ABLOCK: PUSHJ P,ABLKRG ;GET ARG TO "BLOCK" PSEUDOOP. + TRNE LINK,400 ;GLOBALS IN ARG? + JRST ABLKG ;GLOBALS IN ARG + TLNE LINK,400000 + JRST ABLKG ;JUMP IF LOSER CHANGING RELOCATION WHILE CLOC GLOBAL +IFN FASLP,[ + MOVE D,CONTRL + TRNN D,FASL ;IN FASL FORMAT, CAN'T SET LOC. CTR., + JRST ABLKF1 + SKIPE B + ETA [ASCIZ /BLOCK size relocatable/] + JUMPGE FF,ABLKF1 + CALL ABLKF ;SO ON PASS 2 OUTPUT A BUNCH OF ZEROS. + JRST ABLKF1 + +;OUTPUT C(A) ZEROS, IN FASL FORMAT. NO-OP ON PASS 1. DOESN'T SET THE LOCATION COUNTER. +ABLKF: JUMPE A,CPOPJ + JUMPGE FF,CPOPJ + SETZM WRD + SETZM WRDRLC + PUSH P,A + PUSH P,A +ABLKF2: CALL FASPW + MOVEMM GLSP2,GLSP1 + SOSE (P) + JRST ABLKF2 + JRST POPBAJ +] + +ABLKF1: ADD A,CLOC ;ARG TO BLOCK IS LOCAL, ADD DIRECTLY TO CLOC + ADD B,CRLOC ;ALSO ADD RELOCATIONS + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF LOCATION + CALL SLOCF ;FALL INTO ALOC ROUTINE, MAKING SURE FRLOC GETS SET + JRST ALOC2B + + +SBWDOF: SUB A,OFLOC ;SUBTRACT OFFSET FROM WRD, ETC. IN A,B + HRRZM A,WRD ;MAKE SURE RESULT GETS STORED IN WRD, AS WELL AS AC'S + SUB B,OFRLOC ;NOW DO RELOCATIONS + HRRZM B,WRDRLC + POPJ P, + +ABLKG: TRNE LINK,400000 ;GLOBAL BLOCK, IS OFFSET GLOBAL? + JRST ABLKG2 ;YES, OK TO REFERENCE $L. + PUSHJ P,SBWDOF ;NO, FOR COMPATIBILITY, DON'T REFERENCE $L. + SKIPA T,[HFWDF,,$.H] +ABLKG2: MOVE T,[HFWDF,,$L.H] +PTEQ2: AOS GLSP1 ;STORE T IN GLOTB + MOVEM T,@GLSP1 +ALOC2: TLO LINK,400000 ;SET GLOBAL LOCATION FLAG + MOVEI A,LCGLO ;=> GLOBAL LOCATION ASSIGNMENT + PUSHJ P,PLDCM ;PUNCH OUT GLOBAL LOCATION ASSIGNMENT + SETZM CLOC ;CLEAR OUT CLOC, NEW RELOCATION NOW + SETZB B,BKBUF ;ALSO CLEAR OUT HEADER, JUST TO BE SURE + AOJA B,ALOC2B ;SET RELOCATION TO 1 AND FALL IN + +AOFFSET: PUSHJ P,AOFFS2 ;OFFSET, GET ARG + MOVE A,T + MOVEM A,WRD ;RESTORE UNTRUNCATED ARG. + TRZE LINK,400 ;GLOBALS IN ARG? + TROA LINK,400000 ;GLOBALS IN ARG, SET GLOBAL OFFSET FLAG + TRZ LINK,400000 ;NO GLOBALS IN ARG + MOVEM A,OFLOC ;STORE NEW OFFSET + MOVEM B,OFRLOC ;ALSO STORE RELOCATION BITS + SKIPGE CONTRL ;IN RELOCATABLE, + JRST AOFSTX + MOVEI A,LDOFS ;LOADER OFFSET LOADER COMMAND TYPE + PUSHJ P,PLDCM ;PUNCH OUT LOADER COMMAND + JRST AOFSTX + +;GET ARG TO LOC, BLOCK, .=, OFFSET + +ALOCRG: +ABLKRG: MOVE A,CLOC + SKIPN CRLOC + JRST [ CAML A,DECBRA ;IF ADDR BEFORE THE LOC WAS ABS, + MOVEM A,DECBRA ;UPDATE HIGHEST ABS ADDR IF NEC. + JRST ABLKR1] + CAML A,DECTWO ;IT WAS RELOCA; UPDATE HIGHEST + JRST [ CAML A,DECBRH ;ADDR OF APPROPRIATE SEG. + MOVEM A,DECBRH + JRST ABLKR1] + CAML A,DECBRK + MOVEM A,DECBRK +AOFFS2: +ABLKR1: PUSH P,SYM + PUSHJ P,CONBAD ;ERROR IF IN GROUPING + REST SYM + TRNE I,IRNOEQ\IRPSUD\IREQL + ETSM [ASCIZ /Inside pseudo or =/] + TDNE I,[ILWORD,,IRFLD] + ETSM ERRNVL + PUSHJ P,EBLK ;MAYBE END CURRENT OUTPUT BLOCK + PUSHJ P,AGETWD ;GET ARG + MOVE LINK,GLOCTP ;GET GLOCTP FLAGS IN LINK, STAYS THERE UNTIL ALMOST DONE + MOVE T,GLSP2 + CAME T,GLSP1 + TROA LINK,400 ;SIGNAL GLOBAL ARG + TRZ LINK,400 ;LOCAL + MOVE T,A ;SAVE UNTRUNCATED FOR AOFFSET, + HRRZS A,WRD ;TRUNCATE FOR LOC, BLOCK, .=. + TRNN I,IRDEF ;ALL DEFINED? + JRST ASSEM1 + SKIPGE CONTRL ;YES, RETURN SKIPPING OVER ARG + TRNN LINK,400 + RET + MOVE SYM,GTVER + ETASM [ASCIZ *Argument has externals*] + +;;CONSTANTS AND VARIABLES + ;VARIABLES AREA +VBLK + +LCNGLO==CONMIN/4 +LCONTB==CONMIN + +BLCODE [ +PCNTB: BLOCK NCONS*3 ;CONSTANTS AREAS TABLE +VARTAB: BLOCK NVARS +] +CONTBA: CONTAB ;ADDRESS OF BEGINNING OF CONSTANTS TABLE. +CONTBE: CONTAB+LCONTB ;ADDRESS OF WORD AFTER END OF CONSTANTS TABLE. +PLIM: 0 ;POINTER TO FIRST UNUSED WORD IN CONSTANTS TABLE. + +CONGLA: CONGLO ;ADDRESS OF BEGINNING OF CONSTANT-GLOBALS TABLE. +CONGLE: CONGLO+LCNGLO ;ADDRESS OF WORD AFTER END OF CONSTANT GLOBALS TABLE. +CONGOL: 0 ;HAS ADR OF FIRST WORD INACTIVE IN CONSTANT-GLOBALS TABLE. + +CONBIA: CONBIT ;ADDRESS OF BEGINNING OF CONSTANT-RELOCATION-BITS TABLE. + +CONLEN: CONMIN ;TOTAL SPACE ALLOCATED TO CONSTANTS TABLES. + ;ALL THE HOOKS ARE IN FOR DYNAMIC ALLOCATION OF THESE TABLES + ;(CONTAB, CONGLO, AND CONBIT). ALL THAT IS NEEDED IS TO GET + ;THE SPACE AND INITIALIZE CONTBA, CONTBE, CONGLA, CONGLE, CONBIA. + + ;PCNTB STUFF + + ;EACH ENTRY 3 WORDS; FIRST WORD SQUOZE, NAME OF AREA IF GLOBAL +CSQZ: 0 ;SQUOZE COUNTER + ;SECOND WORD RH LOC OF AREA (WITH OFFSET), LH LOC FIRST AFTER AREA (WITHOUT OFFSET) + ;THIRD WORD LH FLAGS + +CGBAL==100000 ;GLOBAL (INCLUDING OFFSET) +CTRL==200000 ;RELOCATED ( " ) +CTDEF==400000 ;DEFINED (MUST BE SIGN) + +PBCON: 0 ;POINTER INTO PCNTB, HAS ADR OF ENTRY FOR NEXT CONSTA +PBCONL: 0 ;POINTER TO ABSOLUTE TOP OF PCNTB +CONCNT: 0 ;NUMBER OF TIMES CONSTANTS CAN APPEAR (DECREMENTED BY CONSTA) +CONDEP: 0 ;DEPTH IN CONSTANTS (0 TOP LEVEL) +CONSAD: 0 ;ADDR IN CONSTANTS TABLE OF ENTRY FOR CURRENT CONST. +CONSML: 0 ;VALUE OF .MLLIT INTSYM. + ;NEGATIVE => ERROR MODE (DEFAULT) + ;ZERO => OLD MODE. + ;POSITIVE => NEW (MULTI-LINE) MODE. + +CONSTP: 0 ;PDL POINTER BELOW WDS FOR INNERMOST CONSTANT. +CONSP1: 0 + + ;VARIABLES FOR VARIABLES CODING + +VARCNT: 0 ;NO OF VAR IN CURRENT VAR AREA SO FAR +VARPNT: 0 ;POINTER TO CURRENT PLACE IN VARTAB +VARCNR: 0 ;NO OF TIMES VARIABLES MAY APPEAR +VCLOC: 0 ;TEM FOR VARIAB +VECSIZ: 0 ;DEFAULT SIZE FOR .VECTOR. + +PBLK + +;LEFT-BRACKET ENCOUNTERED; HERE ON DISPATCH FROM GETFD +;SAVE WORLD, BYTE MODE, ASSEM1 PDL LEVELS. +;THEN SET ASSEM1 PDL LEVELS TO CURRENT LEVELS +;SO ASSEM1 WON'T FLUSH PAST LEVEL OF CONSTANT. +;SET CONSTP _ CURRENT PDL LEVEL. PCONS WILL PUT WORDS +;OF CONSTANT ABOVE CONSTP, AND SET ASSEMP ABOVE THEM. + +LBRAK: SKIPE LITSW + ETR [ASCIZ /Literal/] + TRO I,IRFLD ;LEFT BRACKET + JSP LINK,SAVWD1 ;SAVE CRUFT + PUSH P,SCNDEP ;SO THE NEXT RBRKT WON'T TRY TO CLOSE CONDIT. + JSP LINK,SAVAS1 + MOVEIM ASMOUT,3 + SETZM SCNDEP ;NOT WITHIN CONDITIONALS IN THIS LITERAL. + AOS CONDEP ;ONE DEEPER IN LITERALS. + JRST ASSEM3 ;GO ASSEMBLE THE WORDS OF THE CONSTANT. + +;OUTPUT WORD TO CONSTANT. P MUST EQUAL ASSEMP HERE. +PCONS: SKIPL CONTRL ;IF RELOCATABLE, + PUSHJ P,$RSET ;HANDLE STRANGE RELOCATIONS. + MOVE B,GLSP1 + SUB B,GLSP2 ;NUM. GLOBAL ENTRIES FOR THIS WD. + HLRZ A,WRDRLC ;ONLY 1.1 AND 3.1 BITS MATTER. + LSH A,1 + IOR A,WRDRLC ;GET THEM INTO 1.1, 1.2 BITS. + TLNE I,ILNOPT ;REMEMBER ILNOPT ALSO. + IORI A,4 + DPB B,[032200,,A] ;AND # GLBLS. + PUSH P,A ;SAVE THEM ALL. + HRLI B,(B) ;GET # GLBLS,,# GLBLS . + JUMPE B,PCONS1 + MOVE A,GLSP2 + MOVSI A,1(A) + HRRI A,1(P) ;SAVE THE GLBLS, IF ANY. + ADD P,B + JUMPGE P,CONFLP + BLT A,(P) +PCONS1: PUSH P,WRD + MOVEM P,ASSEMP ;ASSEMP -> ABOVE WDS FOR LIT.; CONSTP, BELOW. + JRST (T) + +;JSP LINK,SAVAS1 TO PUSH DATA ON ASSEM1 LEVEL AND CALL ASSEM1 +;LOOP RECURSIVELY. +.SEE CONNDP ;WHICH IS WHERE THESE THINGS ARE POPPED. +SAVAS1: SKIPN BYTM ;IF IN BYTM NOW (WILL PUSH AND TURN OFF) + JRST LBRAK1 + MOVSI A,BYBYT ;SAVE ALL THE DETAILS. + HRRI A,1(P) + ADD P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] + JUMPGE P,CONFLP ;(SOFTWARE-DETECTED PDL-OV) + BLT A,-BYTMCL(P) + MOVSI A,BYTMC + HRRI A,1-BYTMCL(P) + BLT A,(P) +LBRAK1: PUSH P,BYTM + SETZM BYTM + PUSH P,ASMOUT + PUSH P,ASMDSP + PUSH P,ASMI + PUSH P,GLSPAS ;SAVE ASSEM1 PDL LEVELS. + PUSH P,ASSEMP + PUSH P,CONSTP + MOVE A,I + ANDI A,IRPSUD+IREQL + IORI A,IRDEF + MOVEM A,ASMI ;ASMI IOR'D INTO I AT ASSEM2 LOOP. + HRRZ A,CPGN + HRL A,CLNN ;REMEMBER WHERE THIS LITERAL STARTS. + INSIRP PUSH P,[A SYSYM SYLOC] + MOVEM P,ASSEMP ;SO ASSEM1 WON'T FLUSH WHAT WE PUSHED. + MOVEM P,CONSTP ;SO CONND CAN FIND 1ST WD OF CONSTANT. + MOVEMM GLSPAS,GLSP1 +SAVAS2: MOVEI A,ASSEM3 ;IF NOT MULTI-LINE MODE, ARRANGE TO + SKIPG CONSML ;END THE CONSTANT AFTER 1 WORD. + MOVEI A,ASSEMC + MOVEM A,ASMDSP + JRST (LINK) + +PCONST: MOVE CH1,ASMDSP ;OUTPUT TO CONST. FROM ASSEM1 + CAIN CH1,CONND ;LAST WD OF CONST? + CAME P,CONSTP ;1ST WD? + JRST PCONS ;NO, DO THE GENERAL THING. + SKIPL CONTRL ;THIS MUST BE ONLY WORD OF CONST, + PUSHJ P,$RSET ;DON'T BOTHER PUSHING, END CONST. NOW. + PUSH P,CONSTP + TLZ I,ILMWRD+ILMWR1 ;THIS IS 1ST WD, NO MORE WDS. + JRST CONND3 ;PRETEND JUST POPPED IT. + +;COME HERE FROM ASSEM1 TO END A CONSTANT. +CONND: SKIPE BYTM ;IF IN BYTE MODE, LEAVE IT AND DO .WALGN + JRST A.BY3 ;(WILL COME BACK SINCE ASMDSP STILL SET) +CONNDW: MOVEMM CONSP1,CONSTP + TLZ I,ILMWR1 ;THIS IS 1ST WORD COMING UP. +CONND0: TLZ I,ILMWRD+ILNOPT + SETZM WRDRLC + MOVE F,CONSP1 ;ADDR IN IN PDL OF NEXT WD. + CAMN F,ASSEMP + JRST CONND2 ;J IF NO WORDS. + MOVE A,1(F) ;GET SAVED NUM GLBLS,,NUM GLBLS + DPB A,[100,,WRDRLC] + LSH A,-1 ;RESTORE WRDRLC BITS 1.1, 3.1 + DPB A,[220100,,WRDRLC] + TRNE A,2 + TLO I,ILNOPT ;RESTORE NOOPTF. + LSH A,-2 ;GET # GLBLS. + HRLI A,(A) ;# GLBLS,,# GLBLS. + AOBJN F,.+1 + HRRZM F,GLSP2 ;ADDR BEFORE 1ST GLOBAL ENTRY. + ADD F,A + HRRZM F,GLSP1 ;ADDR OF LAST GLOBAL ENTRY. + MOVE A,1(F) + MOVEM A,WRD + AOBJN F,.+1 ;POINT TO NEXT CONST WD IF ANY, + MOVEM F,CONSP1 + CAME F,ASSEMP ;IF MORE WORDS SET ILMWRD + TLO I,ILMWRD + JRST CONND3 + +CONND2: INSIRP SETZM,[WRD,GLSP1,GLSP2] +CONND3: MOVE F,GLSP1 + SUB F,GLSP2 + JUMPE F,SCON ;JUMP IF NOTHING VIRTUAL + MOVEI B,-1(F) + MOVN TT,B + JUMPE B,SCON ;JUMP IF ONLY ONE GLOBAL + ;SORT GLOTB ENTRIES THIS CONSTANT +LSORT: HRL T,TT ;SET UP AOBJN POINTER TO GLOBALS REMAINING + HRR T,GLSP2 +LSORT2: MOVE A,1(T) + CAMLE A,2(T) + EXCH A,2(T) ;INTERCHANGE + MOVEM A,1(T) + AOBJN T,LSORT2 ;INNER LOOP POINT + SOJG B,LSORT ;OUTER LOOP + ;DROPS THROUGH + +;DROPS THROUGH +SCON: PUSHJ P,RCHKT + PUSHJ P,RMOVET ;SET UP RELOACTION BITS. + ROT T,2 ;ROTATE TO BOTTOM TWO BITS OF T + TLNE I,ILMWRD+ILMWR1+ILNOPT + JRST NOCON ;MULTIPLE WORD OR OPTIMIZATION SUPPRESSED, DON'T TRY TO FIND MATCH + MOVE A,CONTBA +SCON1: CAML A,PLIM ;SEARCH CONSTANTS TABLE TO SEE IF ALREADY THERE + JRST NOCON ;END OF TABLE, NO MATCH + MOVE B,WRD + CAME B,(A) +SCON2: AOJA A,SCON1 ;VAL DISAGREES + PUSHJ P,CPTMK ;GET BP TO CONSTANTS-BIT TABLE IN C + LDB F,C ;GET RELOCATION BITS THIS CONSTANT + CAME F,T + JRST SCON2 ;RLC DIFFRS + MOVE B,CONGLA ;VALUE AND RELOCATION AGREE, NOW TO CHECK GLOBALS + SKIPA C,GLSP2 +SCON2B: AOS B ;SEARCH FOR GLOBAL POINTING TO CONSTANT WHICH HAS MATCHED SO FAR + CAML B,CONGOL + JRST SCON3 ;GLOBALS MATCH SO FAR + CAME A,1(B) ;SKIP IF ONE FOUND +SCON7: AOJA B,SCON2B ;NOT YET + MOVE D,(B) ;FOUND ONE, GET GLOTB ENTRY + CAME D,1(C) ;COMPARE WITH THIS ENTRY IN GLOTB + JRST SCON2 ;NO MATCH, FLUSH THIS CONSTANT + AOJA C,SCON7 ;MATCH, TRY NEXT GLOBAL + +SCON3: CAME C,GLSP1 ;GLOBALS MATCH, BUT ARE WE EXACTLY AT END OF GLOTB? + JRST SCON2 ;NO, BACK TO SEARCH + JRST NOCON4 + +NOCON: AOS A,PLIM ;CONSTANT NOT ALREADY IN TABLE + CAMLE A,CONTBE + ETF [ASCIZ/Literal table full/] + MOVE AA,WRD + MOVEM AA,-1(A) + SOS A + PUSHJ P,CPTMK + TLNE I,ILNOPT + TRO T,4 ;1.3 OF RELOCATION BITS => DON'T OPTIMIZE ON TOP OF ME + DPB T,C + MOVE B,GLSP2 +NOCON3: CAML B,GLSP1 + JRST NOCON4 + SKIPN C,1(B) + AOJA B,NOCON3 ;THIS ENTRY NOT REALLY HERE + MOVEM C,@CONGOL + HRRZS C + PUSHJ P,NOCON5 + MOVEM A,@CONGOL + PUSHJ P,NOCON5 + SKPST C, ;SKIP IF IN SYMBOL TABLE + AOJA B,NOCON3 + 3GET1 D,C ;IN SYMBOL TABLE + TLO D,3VCNT ;THIS SYM USED IN CONSTANT + 3PUT1 D,C ;UPDATE 3RDWRD TABLE ENTRY + AOJA B,NOCON3 + +NOCON5: AOS AA,CONGOL + CAML AA,CONGLE + ETF [ASCIZ/Constants-global table full/] + POPJ P, + + ;SET UP BYTE POINTER TO CONSTANTS-BIT TABLE + ;A SHOULD HAVE ADR OF CONSTANTS TABLE ENTRY + ;LEAVES ANSWER IN C + ;BITS IN CONSTANTS-BIT TABLE PER ENTRY: + ;1.2, 1.1 RELOCATION BITS + ;1.3 ILNOPT BIT => DON'T OPTIMIZE ON TOP OF ME + +CPTMK: PUSH P,A + SUB A,CONTBA + PUSH P,B + IDIVI A,12. + MOVEI C,(A) + ADD C,CONBIA ;SET UP ADDRESS PART + IMULI B,3 + DPB B,[360600,,C] ;STORE POSITION FIELD FROM REMAINDER + TLO C,200 ;SET UP SIZE FIELD +POPBAJ: POP P,B + JRST POPAJ + +NOCON4: TLON I,ILMWR1 + MOVEM A,CONSAD ;IF 1ST WD SAVE ADDR. + TLNE I,ILMWRD ;IF MORE WORDS, HANDLE NEXT. + JRST CONND0 + MOVE P,CONSTP ;VALUE OF CONSTP AT CONND. + MOVE C,GLSPAS ;TO RESTORE GLSP1 + JSP T,CONNDP ;POP STUFF. + HRRZ A,CONSAD ;ADDR OF CONSTANTS TABLE ENTRY OF 1ST WD. + MOVE B,PBCON ;ADDR OF WDS DESCRIBING CONST. AREA. + SKIPL 2(B) ;CONST. AREA LOCATION DEFINITE? + AOJA C,CONND6 ;NO, USE GLOBAL. + MOVEM C,GLSP1 + HRRZ C,1(B) ;ADD ACTUAL ADDR OF CONST. AREA. + ADDI A,(C) ;GET C(CONTBA) + ADDR OF CONSTANT. + LDB B,[420100,,2(B)] + JRST CONND7 + +CONND6: MOVEM C,GLSP1 + MOVEM B,(C) + MOVEI B,0 +CONND7: SUB A,CONTBA + JRST LSSTH3 ;POP OUT INTO OUTER WORD. + +.SEE SAVAS1 ;WHICH IS WHAT PUSHES WHAT CONNDP POPS. +CONNDP: SUB P,[3,,3] ;FLUSH SAVED SYLOC AND SYSYM AND CLNN,,CPGN. +CONFL2: HRL T,ASMOUT ;REMEMBER IF POPPING A LITERAL OR NOT. + INSIRP POP P,[CONSTP,ASSEMP,GLSPAS,ASMI,ASMDSP,ASMOUT,BYTM] + SKIPN BYTM ;IF IN BYTE MODE, POP DETAILS. + JRST CONND5 + MOVSI A,1-BYTMCL(P) + HRRI A,BYTMC + BLT A,BYTMC+BYTMCL-1 + MOVSI A,1-BYTMCL-LBYBYT(P) + HRRI A,BYBYT + BLT A,BYBYT+LBYBYT-1 + SUB P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] +CONND5: HLRZ A,T + CAIE A,3 + JRST (T) + POP P,A + ADDM A,SCNDEP ;DON'T FORGET ABOUT ANY CONDITIONALS. + SOS CONDEP ;HAVE POPPED ONE CONSTANT. + JRST (T) + +CONFLS: MOVE P,ASSEMP ;FLUSH ALL CONSTANTS. + CAMN P,[-LPDL,,PDL] ;IF IN ANY, + JRST (LINK) + MOVE P,CONSTP ;POINT AFTER ITS PDL ENTRY, + JSP T,CONNDP ;POP IT, + JRST CONFLS ;TRY AGAIN. + +CONBAD: SKIPN ASMOUT ;IF IN GROUPING, ERROR. + POPJ P, + ETSM [ASCIZ/Within <>, () or []/] + JRST ASSEM1 + +;COME HERE FOR PDL-OV ON P. +;IF IN A CONSTANT, FLUSH ALL OF THEM, SAYING WHERE EACH STARTED. +;THEN TYPE A PDL ERROR MSG AND RETURN TO ASSEM1. +;OTHERWISE FATAL ERROR. +CONFLP: MOVEI LINK,ASSEM1 + MOVEI CH1,ERRPDL + SKIPE CONDEP + JRST CONFL3 ;IN A CONSTANT. + MOVEI P,PDL ;RE-INIT PDL SO NO MORE PDL-OV. + ETF ERRPDL +ERRPDL: ASCIZ /PDL overflow/ + +;JSP LINK,CONFLM TO FLUSH CONSTANTS, SAYING WHERE THEYY STARTED, +;AND GIVE ERROR MSG. +CONFLM: MOVE CH1,ASMOUT + SKIPA CH1,ASMOT3(CH1) +CONFLZ: SETZ CH1, ;LIKE CONFLM BUT NO ERR MSG AT END. +CONFL3: SETO C, +CONFL1: MOVE P,CONSTP ;GET STACK ABOVE INNERMOST LITERAL. + REST SYLOC + REST SYSYM + REST D ;GET INFO ON WHERE STARTED + AOSN C ;THE 1ST TIME ONLY, SAY WHAT'S GOING ON. + TYPR [ASCIZ/Within groupings: /] + SKIPE C + TYPR [ASCIZ/, /] + MOVE A,ASMOUT ;SAY WHAT KIND OF GROUPING IS BEING CLOSED + MOVE A,ASMOT5(A) + CALL TYOERR ;BY SAYING WHAT CHAR OPENED IT. + JSP T,CONFL2 ;POP REST OF WDS SAVED AT LBRAK. + TYPR [ASCIZ/ at /] + MOVEI A,1(D) ;PAGE # GROUPING STARTED ON. + CALL DPNT ;PRINT IN DECIMAL. + MOVEI A,"- + CALL TYOERR + HLRZ A,D ;LINE NUMBER IT STARTED ON. + ADDI A,1 + CALL D3PNT2 ;PRINT W/ AT LEAST 3 CHARS, NO ZERO SUPPR. + MOVE A,ASSEMP + CAME A,[-LPDL,,PDL] ;MORE GROUPINGS TO POP => DO. + JRST CONFL1 + CALL CRRERR + MOVE P,ASSEMP + JUMPE CH1,(LINK) ;IF CALLED CONFLZ, NO ERR MSG (CALLER WILL GIVE ONE) + ETR (CH1) ;[ NO] OR PDL. + CALL CRRERR + JRST (LINK) + +;CONSTA + +CNSTNT: NOVAL + SKIPE ASMOUT ;IF ANY GROUPNGS, + JSP LINK,CONFLM ;FLUSH THEM, GIVE ERROR. + PUSHJ P,CNSTN0 + JRST ASSEM1 + +CNSTN0: SOSGE CONCNT ;ENTRY FROM AEND + ETF [ASCIZ /Too many constants areas/] + MOVE B,CLOC + ADD B,OFLOC + HRRZ T,PBCON + TRNN FF,FRPSS2 + JRST CNST1 ;PASS 1 + + MOVSI A,CGBAL + TDZ A,2(T) + TRNE FF,FRGLOL + TLC A,CGBAL + SKIPN A + ETR [ASCIZ /Constants globality phase error/] + HRRZ B,1(T) + SUB B,OFLOC + HRRZS B + CAME B,CLOC + ETR [ASCIZ /Constants location phase error/] + MOVE B,2(T) + ROT B,2 + XOR B,CRLOC + XOR B,OFRLOC + TRNE B,1 + ETR [ASCIZ /Constants relocation phase error/] + ;DROPS THROUGH + +;DROPS THROUGH +CNST2: MOVEI D,(T) ;STE IDX IN D FOR OUTSM0 + MOVE SYM,(T) ;GET NAME OF AREA + TLC SYM,400000#LCUDF ;CLEAR LCUDF, SET HALF-KILL + TRNE FF,FRGLOL + PUSHJ P,PDEFPT ;DEFINE SYM FOR BEGINNING OF CONSTANTS AREA + MOVE A,CONTBA +CNSTH: CAML A,PLIM + JRST CNSTA ;THRU + MOVE TT,(A) + MOVEM TT,WRD + PUSHJ P,CPTMK + LDB F,C ;GET THIS CONSTANT'S RELOCATION BITS + TRZE F,2 + TLO F,1 ;RELOCATE LEFT HALF + MOVEM F,WRDRLC ;STORE RELOCATION + MOVEI D,GLOTB ;AND NOW TO SET UP GLOTB! + MOVEM D,GLSP2 + MOVE C,CONGLA +CNSTC: CAML C,CONGOL + JRST CNSTB ;END OF CONSTANT-GLOBAL TABLE + CAMN A,1(C) ;POINTS TO THIS CONSTANT? + PUSH D,(C) ;YES, STORE ENTRY IN GLOTB + AOS C + AOJA C,CNSTC + +CNSTB: HRRZM D,GLSP1 ;MARK END OF ACTIVE PART OF GLOTB + PUSH P,A + PUSHJ P,PWRD ;OUTPUT THIS CONSTANT + AOS CLOC ;INCREMENT CLOC TO NEXT + HRRZS CLOC ;MAKE SURE IT STAYS IN A HALF-WORD (IMPORTANT SINCE MAY BE LESS THAN RELOCATION) + POP P,A ;RESTORE POINTER INTO CONSTANTS TABLE + AOJA A,CNSTH + +CNST3: HLRZ A,1(T) ;GET POINTER TO TOP OF AREA STORED DURING PASS 1 + CAMN A,CLOC ;SAME AS CURRENT? + JRST CNSTE ;YES, NO HAIR + CAMGE A,CLOC ;DIFFERENT; LOWER? + ETR [ASCIZ /More constants on pass 2 than 1/] + ;INSUFFICIENT CONSTANT SPACE; CONSTANTS AREA TRYING TO BE BIGGER + ;IN PASS 2 THAN PASS 1; THE EXTRA CONSTANTS WERE BACKED OVER + MOVEM A,CLOC ;EITHER WAY, SET CLOC TO TOP OF AREA SO WON'T HAVE MDT TROUBLE + PUSHJ P,EBLK ;END CURRENT BLOCK + CALL SLOCF ;IF RELOCATABLE, MAKE SURE NEW VALUE OF $. GETS PUNCHED + JRST CNSTE + +;CALL SLOCF WHENEVER "." IS CHANGED WITHOUT THE OUTPUTTING OF A STORAGE WORD. +SLOCF: MOVE A,CLOC ;STORE NEW "." IN HEADER FOR NEXT BLOCK OF OUTPUT. + SKIPGE TM,CONTRL + TRNN TM,DECREL+FASL ;BUT NOT IN DEC OR FASL OUTPUT FORMATS. + HRRM A,BKBUF + IORI FF,FRLOC ;MAKE SURE NULL BLOCK IS OUTPUT IF NEC. TO TELL LOADER "." HAS CHANGED. + RET + +;CONSTA DURING PASS 1 + +CNST1: HRRM B,1(T) ;STORE LOCATION OF AREA + MOVEI D,0 + MOVE A,CRLOC + ADD A,OFRLOC + TRNE A,1 + TLO D,CTRL ;RELOCATED + TRNE FF,FRGLOL + TLO D,CGBAL ;GLOBAL + IORM D,2(T) ;STORE FLAGS DESCRIBING AREA + JUMPL FF,CNST2 ;JUMP ON PUNCHING PASS, PUNCH OUT AREA NOW + MOVE T,PLIM + SUB T,CONTBA + ADDM T,CLOC ;PASS 1, JUST UPDATE CLOC + HRRZS CLOC + +CNSTA: HRRZ T,PBCON + TRNE FF,FRGLOL + JRST CNSTD ;LOCATION GLOBAL + TRNN FF,FRNPSS + SKIPGE 2(T) + JRST CNSTDA ;2 PASS ASSEMBLY OR AREA DEFINED + TRO I,IRCONT ;1PASS AND NOT DEFINED + SETZM PARBIT + PUSHJ P,P70 ;DEFINE SYM + MOVE A,(T) + TLC A,400000#LCUDF + SKIPE CRLOC + TLO A,100000 ;RELOCATE + PUSHJ P,$OUTPT + HRRZ A,1(T) + PUSHJ P,$OUTPT ;OUTPUT VALUE, FIRST LOCATION IN AREA + TRZ I,IRCONT +CNSTDA: MOVSI A,CTDEF + IORM A,2(T) ;CALL IT DEFINED +CNSTD: TRNE FF,FRPSS2 + JRST CNST3 ;PASS 2 + MOVE A,CLOC + HRLM A,1(T) ;MARK END OF AREA + +CNSTE: MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + MOVEI T,3 + ADDB T,PBCON + CAML T,PBCONL + MOVEM T,PBCONL + AOS A,CSQZ + MOVEM A,(T) + POPJ P, + +;DEFINING SYM USED IN CONSTANT, DELETE REFERENCES FROM CONSTANT-GLOBAL TABLE + +CONBUG: MOVE A,CONGLA ;B VAL C FLAGS ST(D) SADR + PUSH P,T + PUSH P,C ;SAVE FLAGS +CONBG2: MOVE C,(P) ;GET FLAGS + CAML A,CONGOL ;DONE WITH SCAN? + JRST CONBG1 ;YES + HRRZ F,(A) ;NO, GET CONSTANT-GLOBAL TABLE ENTRY + CAIE F,ST(D) ;POINT TO THIS SYM? + AOJA A,CONBG6 + PUSH P,B ;YES, SAVE VALUE, ABOUT TO WORK WITH B + MOVE T,(A) ;GET ENTIRE CONSTANT-GLOBAL TABLE ENTRY + LDB CH2,[221200,,T] ;GET MULTIPLICATION FIELD + SKIPE CH2 + IMUL B,CH2 ;NON-ZERO => MULTIPLY VALUE OF SYM + TLNE T,MINF + MOVNS B ;NEGATE VALUE + TLNE T,HFWDF + HRRZS B ;TRUNCATE TO HALFWORD + TLNE T,ACF + ANDI B,17 ;AC, MASK TO FOUR BITS + TLNE T,SWAPF + MOVSS B ;SWAP VALUE + TLNE T,ACF + LSH B,5 ;AC, SHIFT FIVE + ADD B,@1(A) ;ADD ABS PART OF VALUE + TLNN T,SWAPF + HRRM B,@1(A) ;NOT SWAPPED, STORE LH + TLNE T,SWAPF + HLLM B,@1(A) ;SWAPPED, STORE LH + TLNN T,HFWDF + MOVEM B,@1(A) ;FULL WORD, STORE VALUE + LDB CH1,[420200+P,,-1] ;GET HIGH BITS OF 3RDWRD, RELOCATION BITS + TLNE T,HFWDF ;NOW TO MAP RELOCATION BITS + TRZ CH1,2 + TLNE T,SWAPF + LSH CH1,1 + TRZE CH1,4 + TRO CH1,1 + PUSH P,A + HRRZ A,1(A) ;GET POINTER INTO CONSTANTS TABLE + PUSHJ P,CPTMK + LDB B,C ;GET RELOCATION BITS + TLNE T,MINF + JRST CONBG8 ;NEGATE + TRNE B,(CH1) + ETA ERRCRI + ;ATTEMPTED MULTIPLE RELOCATION IN CONSTANT + ; ^ ABOVE SHOULD BE REPLACED WITH A $RSET LIKE ROUTINE + ;THAT ALSO SEARCHES CONSTANT-GLOBAL TABLE FOR $R. ALREADY THERE + IOR B,CH1 ;LOOKS OK, IOR IN BITS FOR GLOBAL +CONB8A: DPB B,C ;STORE BACK NEW RELOCATION BITS FOR CONSTANT + POP P,A + CLEARM (A) ;CLEAR OUT CONSTANT-GLOBAL TABLE ENTRY + CLEARM 1(A) + POP P,B + AOS A +CONBG6: AOJA A,CONBG2 ;BACK FOR NEXT CONSTANT, DON'T KNOW HOW MANY THIS SYM USED IN + +CONBG1: MOVE A,CONGLA + PUSH P,B + MOVE B,CONGLA +CONBG7: CAML A,CONGOL + JRST CONBG3 + SKIPN C,(A) +CONBG5: AOJA A,CONBG4 + MOVEM C,(B) + MOVE C,1(A) + MOVEM C,1(B) + AOS B + AOJA B,CONBG5 + +CONBG4: AOJA A,CONBG7 +CONBG3: MOVEM B,CONGOL + POP P,B + POP P,C + POP P,T + POPJ P, +CONBG8: XORI B,3 + TRNE B,(CH1) + ETA ERRCRI + ANDCB B,CH1 + JRST CONB8A + +ERRCRI: ASCIZ /Multiple relocation in constant/ + +;VARIAB + +AVARIAB: NOVAL + SKIPE ASMOUT ;FLUSH ANY GROUPINGS IN PROGRESS. + JSP LINK,CONFLM + PUSHJ P,AVARI0 + JRST ASSEM1 + +AVARI0: SOSG VARCNR ;ENTRY FROM AEND + ETF [ASCIZ /Too many variable areas/] + MOVE D,SYMAOB ;SET UP AOBJN POINTER TO ST + MOVE T,CLOC + MOVEM T,VCLOC ;STORE AS LOCATION OF VARIABLE AREA + ADD T,OFLOC + MOVE C,CRLOC + ADD C,OFRLOC + TRNE FF,FRPSS2 + JRST AVAR1 ;PASS 2 + HRL T,VARCNT ;SIZE OF AREA + TRNE C,1 + TLO T,400000 ;RELOCATED + MOVEM T,@VARPNT + JRST AVAR2E + +AVAR1: HRRZ A,@VARPNT ;VARIAB DURING PASS 2 + CAIE A,(T) + ETR [ASCIZ /Variables location phase error/] + HLRZ A,@VARPNT + TRZE A,400000 + XORI C,1 + TRNE C,1 + ETR [ASCIZ /Variables relocation phase error/] + SKIPE VARCNT + ETR [ASCIZ /Variables area size phase error/] + +AVAR2E: HLRZ T,@VARPNT + TRNN T,377777 + JRST AVAR2C ;IF THIS VAR AREA IS EMPTY, DON'T SCAN SYMTAB. +AVAR2: HLRZ LINK,ST(D) ;SCAN, CHECKING EACH SYM FOR WHETHER IT'S A VARIABLE + CAIL LINK,DEFLVR + JRST AVAR2B + ADD D,WPSTE1 + AOBJN D,AVAR2 + JRST AVAR2C ;ALL SCANNED. + +AVAR2B: 3GET C,D ;FOUND A VARIABLE; DECIDE WHAT TO DO WITH IT. + MOVE B,ST+1(D) + MOVE SYM,ST(D) + TLZ SYM,740000 + LDB LINK,[400400,,ST(D)] + CAIE LINK,UDEFLV_-14. + CAIN LINK,UDEFGV_-14. + JRST AVAR3 ;UNDEFINED VARIABLE + CAIE LINK,DEFGVR_-14. + CAIN LINK,DEFLVR_-14. + JRST AVAR4 ;DEFINED VARIABLE +AVAR2A: ADD D,WPSTE1 + AOBJN D,AVAR2 ;CHECK ENTIRE SYMTAB +AVAR2C: HLRZ A,@VARPNT ;NOW GET SIZE OF AREA + TRZ A,400000 ;CLEAR OUT RELOCATION CHECK BIT +IFN FASLP,[ + MOVE D,CONTRL + TRNE D,FASL ;IN FASL ASSEMBLY, CAN'T JUST SET LOC CTR; MUST OUTPUT 0'S. + CALL ABLKF +] + ADD A,VCLOC ;ADD LOCATION OF BEGINNING OF VARIABLE AREA + MOVEM A,CLOC ;STORE AS NEW CURRENT LOCATION + PUSHJ P,EBLK + CALL SLOCF + CLEARM VARCNT ;INITIALIZE COUNT OF VARIABLES IN NEXT AREA + AOS VARPNT ;INCREMENT POINTER TO POINT TO NEXT AREA + POPJ P, + +;UNDEFINED VARIABLE FOUND IN SYMTAB SCAN + +AVAR3: CAIN LINK,UDEFGV_-14. ;GLOBAL? + TLO SYM,40000 ;GLOBAL + PUSHJ P,LKPNRO + MOVSI T,DEFLVR + CAIN LINK,UDEFGV_-14. + MOVSI T,DEFGVR + TRNE FF,FRGLOL + JRST AVAR3A ;LOCATION GLOBAL + MOVEI B,-1(B) + ADD B,VCLOC + ADD B,OFLOC + MOVE TT,CRLOC + ADD TT,OFRLOC + SKIPE TT + TLO C,3RLR + CAIE LINK,UDEFGV_-14. + TLZN C,3VCNT + SKIPA + PUSHJ P,CONBUG +AVAR4B: PUSHJ P,VSM2 + JUMPGE FF,AVAR2A ;IF PUNCHING PASS, OUTPUT DEFINITION. + PUSHJ P,OUTDE2 + JRST AVAR2A + +AVAR4: TLNE C,3VAS2 ;DEFINED VARIABLE FOUND DURING SYMTAB SCAN + TLOE C,3VP + JRST AVAR2A + MOVSI T,(LINK) ;CAUSE AVAR4B TO REDEFINE AS SAME TYPE. + LSH T,14. + TRNN FF,FRGLOL + JRST AVAR4A +AVAR3A: PUSHJ P,VSM2LV + JUMPGE FF,AVAR2A + PUSHJ P,PDEFPT + MOVEI A,0 + PUSHJ P,PBITS + PUSHJ P,$OUTPT + AOS CLOC + JRST AVAR2A + +AVAR4A: CAIN LINK,DEFGVR_-14. ;DEF VAR, 3VAS2, POINT NOT GLOBAL. + JRST AVAR4B ;VAR GLOBAL, MUST PUNCH DEF SINCE DIDN'T ON PASS1. + 3PUT C,D ;LOCAL, JUST SET 3VP SO DON'T SEE IT NEXT VARIAB. + JRST AVAR2A ;NO NEED TO PUNCH DEF SINCE WAS DEF ON PASS1. + +;;MAIN ;"MAIN" MIDAS ROUTINES: INIT, PS1, PLOD, PS2, PSYMS + ;ALL CALLED WITH JSP A,; ALL GLOBAL + ;RETURN INSTRUCTION FROM JSP IN LOCATION RETURN +PS1: HRRM A,RETURN ;PASS 1, (PASS 1 INITIALIZATION ALREADY DONE), SAVE RETURN + PUSH P,[ASSEM1-1] ;SIMBLK WILL POPJ1. +IFN A1PSW,[SKIPL PRGC + JRST A1PAS1 ;THIS NOT FIRST PROGRAM THIS ASSEMBLY, SET MODE TO 1PASS +] + TRO FF,FRNPSS +IFN ITSSW,JRST SIMBLK ;SELECT SBLK AND ASSEMBLE +IFN DECSW\TNXSW,JRST A.DECRE ;SELECT .DECREL AND ASSEMBLE. + +PS2: HRRM A,RETURN ;PASS 2 (MAIN ROUTINE, PASS 2 INITIALIZATION NOT ALREADY DONE), SAVE RETURN + JUMPL FF,PA2A ;JUMP IF PASS 1 ENDED IN 1PASS MODE + TDO FF,[FLPPSS,,FRPSS2] ;SET PUNCHING PASS AND PASS 2 FLAGS + PUSHJ P,P2INI ;INITIALIZE + JRST ASSEM1 ;START ASSEMBLING + +PA2A: MOVE A,SYMAOB ;PASS 2 OF 1PASS ASSEMBLY, CHECK FOR UNDEFINED LOCALS +PA2C: MOVE SYM,ST(A) ;GET SQUOZE THIS SYMTAB ENTRY + LDB B,[400400,,SYM] ;GET FLAGS + CAIE B,LCUDF_-14. ;LOCAL UNDEFINED? + JRST PA2B ;NOT LOCAL UNDEFINED, DON'T COMPLAIN + 3GET C,A ;LOCAL UNDEFINED, GET 3RDWRD ST ENTRY + TLZ SYM,740000 ;CLEAR OUT FLAGS IN SYM IN ANTICIPATION OF TYPING OUT COMPLAINT + TLNN C,3LLV ;PROBLEM HANDED TO LINKING LOADER? + ETSM [ASCIZ /Undefined/] ;NO +PA2B: ADD A,WPSTE1 ;NOW GO FOR NEXT ST ENTRY + AOBJN A,PA2C + JRST RETURN + +$INIT: HRRM A,RETURN ;INITIALIZATION (BEFORE PASS 1 ONLY) ROUTINE, SAVE RETURN POINT +IFN CREFSW,PUSHJ P,CRFOFF ;DON'T CREF ON 1ST PASS. +IFN LISTSW,CALL LSTOFF ;DON'T LIST ON 1ST PASS. + SKIPGE ISYMF + JRST INIT1 ;SPREAD SYMS (RETURNS TO SP4) + MOVE A,SYMAOB ;ALREADY SPREAD, JUST FLUSH ALL BUT INITIAL SYMS +INIT4: SKIPN B,ST(A) + JRST INIT2 + 3GET C,A + TRNE C,-1 ;INITIAL SYM? + CLEARM ST(A) ;NO +INIT2: ADD A,WPSTE1 + AOBJN A,INIT4 + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1] + BLT A,EBKCOD ;CLEAR OUT BLANK CODE + +SP4: PUSH P,CRETN +P1INI: CLEARB I, LDCCC + INSIRP SETZM,BKBUF ISYMF A.PASS +IFN FASLP,[ + INSIRP SETZM,FASATP FASPCH + CLEARM FASIDX +] + MOVEMM DECTWO,[[MOVE]] + TDZ FF,[FFINIT] ;INITIALIZE MOST FF FLAGS + MOVEIM A.PPASS,2 ;DEFAULT IS 2-PASS. + PUSHJ P,MACINI ;INITIALIZE MACRO STATUS + MOVEI A,PCNTB + MOVEM A,PBCONL + MOVS A,[BKTAB,,P1INI1] + BLT A,BKTAB+4 + MOVEIM BKTABP,BKWPB*2 + +;DROPS IN. +P2INI: INSIRP SETZM,[CPGN,CLNN,GENSM,OFLOC,OFRLOC,CRLOC,BKPDL +SYLOC,SYSYM,BYTW,BYTRLC,STGSW,DECBRK,DEFNPS,BYTM,BYTM1,HKALL,QMTCH] + AOS B,A.PASS +IFN ITSSW,[ + CALL SETWH2 ;SET UP .WHO2, PREPARE .WHO3 IN A WITH PAGENUM=1. + .SUSET [.SWHO3,,A] ;'P1 ',,PAGENUM OR 'P2 ',,PAGENUM + .SUSET [.SWHO1,,[.BYTE 8 ? 166 ? 0 ? 165 ? 0]] +] + TDZ FF,[FLUNRD,,FRGLOL] +IRP X,,[BKWPB,BKCUR,,BKPDL+1,1,BKLVL,IRDEF,ASMI +NCONS,CONCNT,VARTAB,VARPNT,NVARS,VARCNR,1,VECSIZ] +IFE 1&.IRPCN,IFSN [X], MOVEI A,X +IFN 1&.IRPCN, MOVEM A,X +TERMIN + MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + CLEARM VARCNT + CLEARM PBITS2 + MOVE A,[440300,,PBITS1] + MOVEM A,BITP + MOVEI A,PBITS4 + HRRZM A,PBITS4 + CLEARB I,PBITS1 + MOVEI A,PCNTB + MOVEM A,PBCON + MOVE A,[(LCUDF)++1] ;< AND > FOR COMPATIBILITY WITH OLD + MOVEM A,PCNTB + MOVEM A,CSQZ + MOVEI A,8 + MOVEM A,ARADIX + +IFN ITSSW,[ + MOVEI A,100 + MOVEM A,CLOC +] +.ELSE [ + SETZ A, ; SET LOC COUNTERS APPROPRIATELY + SKIPGE B,CONTRL + TRNE B,DECREL+FASL + JRST [SETZM CLOC ; ASSUME RELOCATABLE + AOS CRLOC ; CRLOC GETS 1 + JRST P2INI5] + TRNE B,DECSAV ; ASSUME ABSOLUTE + MOVEI A,140 + TRNE B,SBLKS + MOVEI A,100 ; IF SBLK FORMAT ASSUME FOR ITS. + MOVEM A,CLOC +P2INI5: +] + SETZM GLOCTP + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,CONTRL ;IN DEC FORMAT, OUTPUT PROGRAM NAME. + TRNE A,DECREL + CALL DECPGN ;CLOBBERS A +IFN FASLP,[ + SETOM FASBLC ;LOSING BLOCK COUNT + MOVE A,CONTRL ;IN FASL FORMAT, OUTPUT FASL HEADER + TRNE A,FASL + CALL FASOIN ;INITIALIZE FASL OUTPUT +] + SETZM DECBRH + TRO FF,FRSYMS+FRFIRWD + MOVE A,[IFORTB,,FORTAB] ;INITIALIZE FORMAT TABLE ON EACH PASS + BLT A,FRTBE + MOVEIM GLSPAS,GLOTB ;INIT. ASSEM1 PDL LEVELS TO BOTTOM. + MOVEMM ASSEMP,[[-LPDL,,PDL]] + MOVEIM ASMDSP,ASSEM3 + SETZM ASMOUT + SETZM CONSTP + SETZM SCNDEP ;NOT IN CONDIT. OR CONSTANT. + SETZM CONDEP + HRRZM P,CONSML ;START OUT IN MULTI-LINE MODE. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + MOVEM A,PNTBP + CLEARM LISTPF + SETOM LISTBC + SKIPG LISTP1 ;IF LIST ON PASS 1 + JUMPGE FF,CRETN ;OR PUNCHING PASS, + SKIPE LISTP ;IF WANT LISTING, + CALL LSTON ;TURN ON OUTPUT OF LISTING. +] +IFN CREFSW,[ + JUMPGE FF,CRETN + SKIPE CREFP ;IF C SWITCH WAS SEEN, + PUSHJ P,CRFON ;TURN ON CREFFING, +] +CRETN: POPJ P,RETURN + +P1INI1: SQUOZE 0,.INIT ? 0 ? 3 + SQUOZE 0,.MAIN ? 1,, + +PLOD: HRRM A,RETURN ;MAIN ROUTINE TO PUNCH LOADER, CALLED BEFORE PASS 2 (PS2"), SAVE RETURN POINT + PUSHJ P,PLOD1 ;PUNCH LOADER + JRST RETURN ;RETURN + + ;PUNCH OUT THE LOADER + +PLOD1: PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE + MOVE B,CONTRL + TRNE B,ARIM10 + JRST PLOD2 ;RIM10 => PUNCH OUT SBLK LOADER FOR PDP10 READIN-MODE READIN + TRNN B,SBLKS + POPJ P, ;NOT SBLK => DON'T PUNCH LOADER +PLOD1A: MOVSI B,SLOAD-SLOADP ;PUNCH SBLK LOADER IN RIM FORMAT + MOVSI C,(DATAI PTR,) +PLOAD1: MOVE A,C + PUSHJ P,PPBA + CAMN C,[DATAI PTR,13] + HRRI C,27 + MOVE A,SLOAD(B) + PUSHJ P,PPBA + AOS C + AOBJN B,PLOAD1 + MOVE A,[JRST 1] + PUSHJ P, PPBA + JRST FEED1 + +PLOD2: MOVSI C,LDR10-ELDR10 ;PUNCH SBLK LOADER FOR PDP10 READIN +PLOD3: MOVE A,LDR10(C) + PUSHJ P,PPBA + AOBJN C,PLOD3 + JRST FEED1 + + ;SBLK LOADER NORMALLY PUNCHED OUT IN RIM FORMAT + +SLOAD: CONO PTR,60 ;0 RESTART POINT (NEW BLOCK) + JSP 14,30 ;1 START POINT, LOOP POINT FOR NEW BLOCK; WAIT FOR DATA WORD READY + DATAI PTR,16 ;GET HEADER + MOVE 15,16 ;INITIALIZE CHECKSUM + JUMPGE 16,16 ;HEADER .GE. 0 => STARTING INSTRUCTION + JSP 14,30 ;5 LOOP POINT FOR NEXT DATA WORD: WAIT FOR READY + DATAI PTR,(16) ;READ IN DATA WORD + ROT 15,1 ;NOW UPDATE CHECKSUM + ADD 15,(16) + AOBJN 16,5 ;LOOP FOR ALL DATA WORDS THIS BLOCK + MOVEI 14,33 ;30 TO RETURN TO 33 + JRST 30 ;WAIT FOR READY THEN GO TO 33 + ;14 JSP AC FOR ROUTINE AT 30 + ;15 CHECKSUM + ;16 AOBJN POINTER (UPDATED HEADER) + CONSO PTR,10 ;30 ROUTINE TO WAIT FOR DATA WORD READY FOR DATAI + JRST 30 + JRST (14) + DATAI PTR,16 ;33 GET CHECKSUM + CAMN 15,16 ;COMPARE WITH CALCULATED + JUMPA 1 ;OK, GO GET NEXT BLOCK (DON'T CHANGE TO JRST OR REAL LOADERS WILL GET CONFUSED) + JRST 4, ;CHECKSUM ERROR +SLOADP==. + +;PDP10 SBLK LOADER +;FOLLOWING CODING ACTUAL WORDS TO BE OUTPUT + ;BY ASSEMBLER, COMPILER, OR WHATEVER +;SHOULD BE EXECUTED BY PDP10 HARDWARE READIN FEATURE +;USES ONLY THE AC'S (BUT ALL OF THEM) + +LDR10: + -17,,0 ;BLKI POINTER FOR READ SWITCH + +LDRC=0 ;CHECKSUM (OK, SO YOU'RE NOT ALLOWED TO LOAD + ;INTO IT DURING HARDWARE READIN, BUT WHO SAYS + ;YOUR PROGRAM CAN'T USE IT?) +OFFSET -.+1 ;BEGIN LOADING INTO 1 AS PER HEADER +LDRGO==. + CONO PTR,60 ;START UP PTR (RESTART POINT) +LDRRD==. + HRRI LDRB,.+2 ;INITIALIZE INDEX +LDRW==. + CONSO PTR,10 ;WAIT FOR WORD TO BE AVAILABLE + JRST .-1 + ROT LDRC,-LDRRD(LDRB) ;BEFORE READING IN HEADER, ROTATE 2 BITS (THEN IGNORE) + ;BEFORE READING IN EACH DATA WORD, ROTATE 1 BIT (FOR UPDATING CHECKSUM) + ;BEFORE READING IN CHECKSUM, ROTATE NOT AT ALL (DON'T ROTATE CALCULATED CHECKSUM) + DATAI PTR,@LDRT1-LDRRD(LDRB) ;READ WORD INTO RIGHT PLACE + ;HEADER => READ INTO C + ;STORAGE WORD => READ INDEXED BY AOBJN POINTER IN A + ;CHECKSUM => READ INTO A FOR COMPARISON WITH C(C) + XCT LDRT1-LDRRD(LDRB) ;EXECUTE RELEVANT T1 ENTRY (MAYBE SKIPS) + XCT LDRT2-LDRRD(LDRB) ;EXECUTE RELEVANT T2 ENTRY (MAYBE JUMPS) +LDRB==. + SOJA ., ;-RD(B) IS 2, 1, AND 0 FOR SUCCESSIVE ENCOUNTERS OF THIS INSTRUCTION + ;USED AS INDEX INTO TABLES, ETC. + + ;TABLE 1 + ;INDIRECTED THROUGH FOR DATAI + ;THEN EXECUTED TO SEE WHAT TO DO WITH READ IN WORD + ;ENTRIES EXECUTED IN REVERSE ORDER + +LDRT1==. + CAME LDRC,LDRA ;COMPARE CHECKSUM WITH CALCULATED, SKIP TO B IF THEY AGREE + ADD LDRC,(LDRA) ;UPDATE CHECKSUM + SKIPL LDRA,LDRC ;INITIALIZE HEADER AND SKIP UNLESS JUMP BLOCK + + ;TABLE 2 + ;EXECUTED IF CORRESPONDING ENTRY IN TABLE 1 DIDN'T SKIP WHEN EXECUTED + +LDRT2==. + JRST 4,LDRGO ;CHECKSUM ERROR + AOBJN LDRA,LDRW ;UPDATE AOBJN POINTER AND GO BACK FOR NEXT STORAGE WORD IF NOT EXHAUSTED +LDRA==. + JRST LDRRD ;WHEN INITIALLY LOADED IS JUMP BLOCK TO THIS LOADER + ;DURING LOADING USED TO HOLD HEADER (AOBJN POINTER), WHICH MAY BE LOADED JUMP BLOCK + +OFFSET 0 +ELDR10==. + +;FLAGS IN SQUOZE OF SYMS TO OUTPUT + +ABSGLO==040000 ;SYM IS GLOBAL (IF RELOCA, SAYS THIS IS BLOCK NAME) +ABSLCL==100000 ;LOCAL +ABSDLI==200000 ;DELETE INPUT (DON'T RECOGNIZE IT IF TYPED IN) +ABSDLO==400000 ;DELETE OUTPUT (DON'T TYPE IT OUT) + +PSYMS: HRRM A,RETURN ;PUNCH OUT SYMBOL TABLE, CALLED AFTER EVERYTHING ELSE, SAVE RETURN POINT + PUSH P,PSYMS ;AT END, POPJ TO RETURN. + TRNE FF,FRSYMS + JRST SYMDMP ;PUNCH SYMS IF NEC. + SKIPL A,CONTRL + JRST SYMDA ;IF RELOCA, PUNCH PROGRAM NAME. + TRNN A,DECREL + POPJ P, +PSYMSD: MOVSI A,DECEND + PUSHJ P,DECBLK ;START AN END-BLOCK. + MOVE A,DECTWO ;IN 2-SEG PROGRAMS, + CAME A,[MOVE] + JRST [ CAMG A,DECBRH ;OUTPUT HISEG BREAK + MOVE A,DECBRH + MOVEM A,WRD + MOVEIM WRDRLC,1 + CALL PWRD + MOVEMM WRD,DECBRK + CALL PWRD ;FOLLOWED BY LOSEG BREAK + JRST EBLK] + MOVEMM WRD,DECBRK ;OUTPUT THE PROGRAM BREAK. + MOVEIM WRDRLC,1 + PUSHJ P,PWRD + MOVE A,DECBRA ;OUTPUT HIGHEST ABS. ADDR + CAIG A,140 + SETZ A, ;IF IT'S ABOVE THE JOBDAT AREA. + PUSHJ P,DECWRD + JRST EBLK + +SYMDA: MOVEI A,LPRGN ;NOW PUNCH PROGRAM NAME + DPB A,[310700,,BKBUF] + MOVE A,PRGNM + TLO A,40000 + PUSHJ P,$OUTPT + PUSHJ P,EBLK + TLZ FF,$FLOUT + POPJ P, + + ;DUMP OUT THE SYMBOL TABLE + +SYMDMP: TRZ I,IRCONT ;OK TO END BLOCK + CLEARM GLSP1 + CLEARM GLSP2 + CLEARM WRDRLC + MOVE T,CONTRL + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + CLEARM CLOC + CLEARM BKBUF +IFN FASLP,[ + TRNE T,FASL + JRST SYMDM1 +] + TRNE T,DECREL + JRST SYMDMD + JUMPL T,SSYMD ;JUMP IF NOT RELOCATABLE + MOVEI B,LDDSYM ;LOCAL SYMS BLOCK TYPE + DPB B,[310700,,BKBUF] ;SET BLOCK TYPE + MOVEM B,CDATBC + MOVE B,SYMAOB ;CAUSE SSYMD3 TO LOOK AT ENTIRE SYM TAB. + JRST SSYMDR + +SYMDMD: MOVSI A,DECSYM ;IN DEC FMT, START SYMBOLS BLOCK. + PUSHJ P,DECBLK +SYMDM1: MOVE B,SYMAOB + JRST SSYMDR + +;AC ALLOCATIONS DURING PHASE 1 (COMPACTING THE SYMBOL TABLE): + ;AA INITIALLY HAS -SMK,,; INPUT INDEX INTO ST + ;A TEMP + ;B SQUOZE + ;D OUTPUT INDEX INTO SYMTAB + ;CH1 VALUE OF SYM + ;CH2 3RDWRD +SSYMD: MOVEI D,ST-1 + SETZB C,SMSRTF ;SYMS SORTED => INITIAL SYMS CLOBBERED + MOVE AA,SYMAOB +SSYMD1: SKIPE B,ST(AA) ;GET SYM NAME FROM TABLE + TDNN B,[37777,,-1] ;MAKE SURE NOT EXPUNGED + JRST SSYMDL ;NOT (REALLY) THERE, TRY NEXT + MOVE CH1,ST+1(AA) ;GET VALUE OF SYM + 3GET CH2,AA ;GET 3RDWRD + TRNE CH2,-1 + TLNE CH2,3KILL+3LLV + JRST SSYMDL ;DON'T PUNCH INITIAL OR KILLED SYMS. + MOVEI A,0 ;INITIALIZE FOR SHIFTING IN FLAGS + LSHC A,4 ;SHIFT FLAGS INTO A + XCT SSYMDT(A) ;DO THE APPROPRIATE THING THIS KIND OF SYMTAB ENTRY + JRST SSYMDL +SSYMD2: LSH B,-4 ;SHIFT SQUOZE BACK TO WHERE IT BELONGS + TLO B,ABSLCL ;SET LOCAL BIT + TLNE CH2,3SKILL + TLO B,ABSDLO ;HALF-KILL SYM + CAIL A,DEFGVR_-16 + TLC B,ABSGLO\ABSLCL ;FOR GLOBAL SYM, SET GLOBAL BIT INSTEAD OF LOCAL BIT, + CAIGE A,DEFGVR_-16 ;AND PUT IT IN THE GLOBAL BLOCK IN THE SYMTAB. + SKIPN PRGNM+BKWPB ;IF ONLY ONE BLOCK IN PROGRAM, PUT ALL SYMS IN GLOBAL BLOCK. + HRRI CH2,0 + PUSH D,B ;STORE NAME OF SYM IN OUTPUT SLOT + PUSH D,CH1 ;STORE VALUE + PUSH D,CH2 ;STORE 3RDWRD +SSYMDL: ADD AA,WPSTE1 + AOBJN AA,SSYMD1 ;LOOP FOR ALL SYMS IN TABLE + MOVSI CH2,4^5 ;1ST BIT TO SORT ON IS TOPO BIT, + MOVEI A,ST ;SORT FROM BOTTOM OOF SYMTAB + MOVEI B,1(D) ;TO WHERE WE FILLED UP TO. + MOVE CH1,[TDNE CH2,1(A)] ;SORT ON 2ND WD, WDS WITH BIT ON COME FIRST. + MOVE C,[TDNN CH2,1(B)] + JSP AA,SSYMD9 + TLC C,(TDNE#TDNN) ;ON BITS AFTER 1ST, ENTRIES WITH BIT OFF COME FIRST. + TLC CH1,(TDNE#TDNN) + MOVEI AA,SSRTX ;NEED ONLY CHANGE C, CH1 THE FIRST TIME. + JRST SSRTX + +SSYMD9: PUSHJ P,SSRTX ;SORT SYMS ARITHMETICALLY BY VALUE. + MOVNI B,(B) + ADDI B,ST ;SIZE OF AREA OF SYMTAB STILL IN USE. + IDIV B,WPSTE + HRLZI B,(B) + MOVE C,BKTABP + MOVE A,[SQUOZE 0,GLOBAL] + MOVEM A,BKTAB ;CALL THE .INIT BLOCK "GLOBAL" WHICH IS WHAT DDT WANTS AS TOP BLOCK. + IDIVI C,BKWPB ;# BLOCKS (INCL. GLOBAL BLOCK). + CAIN C,2 ;IF ONLY GLOBAL AND MAIN, TELL BKSRT TO IGNORE MAIN. + SETZM PRGNM+1 + CAIN C,2 + MOVEI C,1 ;IF ONLY GLOBAL AND MAIN, FILE WILL HAVE ONLY 1 BLOCK (GLOBAL). +IFN ITSSW,[ + MOVE A,CONTRL + TRNN A,SBLKS + JRST SSYMJ1 + MOVE A,[-6,,3] ;OUTPUT A "DEBUGGING INFORMATION" BLOCK + MOVE B,A ;UPDATING THE CHECKSUM IN B. + PUSHJ P,PPB + .SUSET [.RXUNAME,,A] ;CONTAINING NAME OF USER, DATE IN DISK FORMAT, + PUSHJ P,PPBCK + SYSCAL RQDATE,[%CLOUT,,A] + .LOSE %LSSYS + PUSHJ P,PPBCK ;AND THE SOURCE FILE NAMES (DEV, FN1, FN2, SNAME). +REPEAT 4,[ + MOVE A,INFB+$F6DEV+.RPCNT + PUSHJ P,PPBCK +] + MOVE A,B + PUSHJ P,PPB +SSYMJ1: +] ;IFN ITSSW, + + MOVSI A,(C) + SUBM B,A ;-<# ENTRIES IN SYMTAB IN FILE>,, + LSH A,1 ;-<# WDS IN SYMTAB IN FILE>,, + MOVE C,CONTRL + TRNE C,DECSAV ; IF OUTPUT FORMAT IS DEC SAV, + JRST [ HRR A,DECSYA ; GET LOC TO STORE SYMS AT + MOVE C,A + MOVE A,[-1,,116-1] ; STORE IT AT .JBSYM + CALL PPB + MOVE A,C + CALL PPB + HRRI A,-1(A) ; SET -<# WDS IN SYMTAB>,, + JRST .+1] + MOVEM A,SCKSUM ;SAVE 1ST WD FOR CHECKSUM (DECSAV IGNORES IT) + PUSHJ P,PPB + PUSHJ P,BKCNT ;PUT -<# SYMS IN BLOCK> IN 3RD WD OF EACH BKTAB ENTRY. + +;DROPS THROUGH. + +;DROPS IN IF ABS, JUMPS HERE IF RELOC. +;NOTE THAT IN ABS ASSEMBLY, B WILL CONTAIN THE CHECKSUM AND +;SHOULD NOT BE CLOBBERED. +SSYMDR: PUSH P,B ;-<# SYMS>,,0 ;IT WILL BE -1(P) + PUSHJ P,BKSRT ;SORT BLOCKS INTO BKTAB1 + MOVE A,BKTAB + CAME A,[SQUOZE 0,GLOBAL] ;IF ABS, WE RENAMED .INIT TO GLOBAL, SO LEAVE IT IN BKTAB1 + SOS D ;ELSE FLUSH .INIT FROM THE END OF BKTAB1. + SETOM 1(D) ;PUT A -1 AT END OF BKTAB1. + MOVE B,SCKSUM ;GET CHKSUM AFTER 1ST WD. (PPBCK WILL UPDATE) + PUSH P,[-1] ;(P) WILL BE BKTAB1 IDX OF NEXT BLOCK TO OUTPUT. +SSYMD3: AOS F,(P) ;F HAS BKTAB1 IDX OF BLOCK. + SKIPGE C,BKTAB1(F) ;BKTAB1 ELT HAS BKTAB IDX OR + JRST SSYMDX ; -1 AFTER LAST BLOCK. + SKIPL LINK,CONTRL + JRST SSYMD7 ;DIFFERENT RTN TO OUTPUT BLOCK NAME IF RELOCA. + TRNE LINK,DECREL+FASL + JRST SSYMD6 ;NO BLOCKS IN DEC FMT. (OR FASL EITHER) + MOVE A,BKTAB(C) + TRNE LINK,DECSAV ; IF DECSAV, SAVE BLK NAME TO OUTPUT LATER. + MOVE T,A + TRNN LINK,DECSAV + PUSHJ P,PPBCK ;OUTPUT BLOCK NAME WITH NO FLAG BITS SET. + HLRZ A,BKTAB+1(C) + SKIPE A + ADDI A,1 ;A GETS 0 FOR GLOBAL BLOCK, ELSE DDT LEVEL (= 1 + MIDAS LEVEL). + HRL A,BKTAB+2(C) ;PUT IN -2* + ADD A,[-2,,] + TRNE LINK,DECSAV ; IF DECSAV, + MOVE TT,A ; SAVE TO OUTPUT LATER. + TRNN LINK,DECSAV +SSYMG2: PUSHJ P,PPBCK ;OUTPUT -SIZE,,LEVEL WORD OF BLOCK NAME ENTRY. + JRST SSYMD6 + +SSYMD7: MOVE A,BKTAB(C) ;OUTPUT BLOCK NAME IN RELOCATABLE. + TLO A,ABSGLO ;TELL STINK IT'S BLOCK NAME. + PUSHJ P,$OUTPT + HLRZ A,BKTAB+1(C) + SUBI A,1 + PUSHJ P,$OUTPT +SSYMD6: SKIPL C,-1(P) ;AOBJN PTR TO SYMS. + JRST SSYMD8 ;IN CASE NO SYMS. +SSYMD4: HRRZ A,ST+2(C) ;OUPUT ONLY THE SYMS IN THE BLOCK + CAME A,BKTAB1(F) ;NOW BEING HANDLED. + JRST SSYMD5 + SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL + JRST SYMD2 ;SPECIAL IF RELOCA. + MOVE A,ST(C) + TRNE LINK,DECSAV + CALL RSQZA ; RIGHT-JUSTIFY THE SQUOZE (SIGH) + PUSHJ P,PPBCK ;1ST, SQUOZE WITH FLAGS. + MOVE A,ST+1(C) + PUSHJ P,PPBCK ;2ND, VALUE. +SSYMD5: ADD C,WPSTE1 + AOBJN C,SSYMD4 ;HANDLE NEXT SYM. +SSYMD8: TRNN LINK,DECSAV + JRST SSYMD3 ;ALL SYMS FOR THIS BLOCK DONE, DO NEXT BLOCK. + MOVE A,T ; DECSAV FMT HAS BLOCK NAMES OUTPUT LAST. + CALL PPB + MOVE A,TT + CALL PPB + JRST SSYMD3 + + ; RIGHT-JUSTIFY SQUOZE IN A, PRESERVING FLAGS. + ; (WHICH ASQOZR RTN DOESN'T) + ; CLOBBERS B. +RSQZA: PUSH P,A ; SAVE FLAGS + TLZA A,740000 ; ZAP +RSQZA2: DPB A,[004000,,(P)] ; UPDATE + IDIVI A,50 + JUMPE B,RSQZA2 + POP P,A + POPJ P, + +;PUNCH OUT LOCAL SYM (RELOCATABLE ASSEMBLY) +;NORMALLY OUTPUT SQUOZE W/ FLAGS ? VALUE, +;IF 3LLV SET OUTPUT PHONY NAME (= STE ADDR) ? SQUOZE W/ FLAGS, STINK FIXES IT UP. +SYMD2: LDB A,[400400,,ST(C)] + MOVE CH1,ST+1(C) ;SSYMDT MAY CHANGE CH1. + MOVE CH2,ST+2(C) + XCT SSYMDT(A) ;SKIPS IF SHOULD OUTPUT SYM. + JRST SSYMD5 + TLNE CH2,3KILL + JRST SSYMD5 + MOVE B,ST(C) + TLZ B,740000 + JUMPE B,SSYMD5 ;UNUSED ENTRY. + JUMPL LINK,SYMDEC ;J IF DEC OR FASL FMT + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LEFT HALF + TLNE CH2,3RLR + TLO B,100000 ;RELOCATE RIGHT HALF + TLNE CH2,3SKILL + TLO B,400000 ;HALF-KILL + MOVEI A,ST(C) + TLNE CH2,3LLV ;IF STINK HAS VALUE, + PUSHJ P,$OUTPT ;GIVE STINK NAME STINK KNOWS SYMBOL BY. + TLNE CH2,3LLV ;IF GIVING PHONY NAME, INSURE LOCAL FLAG SET + TLO B,ABSLCL ;(STINK WILL DO SO OTHERWISE) + MOVE A,B + PUSHJ P,$OUTPT ;OUTPUT SYM + MOVE A,CH1 + TLNN CH2,3LLV ;DON'T OUTPUT VALUE IF DON'T KNOW IT. + PUSHJ P,$OUTPT ;OUTPUT VALUE + JRST SSYMD5 + +SYMDEC: IFN FASLP,[ + TRNE LINK,FASL + JRST SYMFSL ;FASL ASSMBLY +] + PUSHJ P,ASQOZR ;RIGHT-JUSTIFY THE SQUOZE, + TLNE CH2,3SKILL + TLO B,ABSDLO ;MAYBE HALFKILL, + TLO B,ABSGLO + LDB A,[400400,,ST(C)] + CAIGE A,DEFGVR_-14. + TLC B,ABSGLO+ABSLCL ;LOCAL SYM, CHANGE GLO TO LCL. + MOVEM B,WRD + PUSH P,C + PUSHJ P,DECPW ;FIRST, THE NAME, + POP P,C + LDB TM,[420200,,ST+2(C)] + MOVE A,ST+1(C) ;THEN THE VALUE AND RELOCATION BITS. + PUSHJ P,DECWR1 + JRST SSYMD5 + +IFN FASLP,[ +SYMFSL: TLO B,400000 ;GET VALUE FROM SECOND WD + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LH + TLNE CH2,3RLR + TLO B,100000 + CAIL A,LGBLCB_<-18.+4> + TLO B,40000 ;GLOBAL FLAG + MOVE A,B + MOVEI B,15 ;PUTDDTSYM + PUSHJ P,FASO + MOVE A,CH1 + PUSHJ P,FASO1 + JRST SSYMD5 +] + +;XCT INDEXED ON SQUOZE FLAGS; SHOULDN'T PUNCH SYM IF DOESN'T SKIP. +SSYMDT: JFCL ;COM + JFCL ;PSEUDO OR MACRO + CAIA ;SYM, PUNCH OUT + TLNN CH2,3LLV ;LOCAL UNDEFINED, OUTPUT IF STINK HAS VALUE TO TELL STINK WHERE TO PUT IT. + TLZA CH1,-1 ;DEFINED LOCAL VARIABLE, CLEAR OUT LH(VALUE) + JFCL ;UNDEFINED LOCAL VARIABLE + SKIPL CONTRL ;DEFINED GLOBAL VARIABLE, PUNCH OUT IF ABS. + JFCL ;UNDEFINED GLOBAL VARIABLE + SKIPL CONTRL ;GLOBAL ENTRY, PUNCH OUT IF ABS ASSEM. + JFCL ;GLOBAL EXIT, DON'T PUNCH OUT +IFN .-SSYMDT-NCDBTS,.ERR SSYMDT LOSES. + +SSYMDX: SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL+DECSAV + JRST SSYMG3 + MOVE A,B ; SBLK OR RIM ASSEMBLY, OUTPUT CHKSUM. + PUSHJ P,PPB +SSYMG3: SUB P,[2,,2] + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK + SKIPL A,CONTRL ;RELOCATABLE => OUTPUT PROG NAME. + JRST SYMDA +IFN FASLP,[ + TRNE A,FASL + POPJ P, +] + TRNE A,DECREL ;DEC FMT => OUTPUT END BLOCK. + JRST PSYMSD + MOVE A,STARTA ;NOW GET STARTING INSTRUCTION + JRST PPB ;PUNCH IT OUT AND RETURN + +;PUT INTO BKTAB1 THE BKTAB IDXS OF ALL THE BLOCKS IN THE ORDER THEIR +;SYMS SHOULD BE PUNCHED (A BLOCK'S SUBBLOCKS PRECEDE IT) +;THE .INIT BLOCK (MAYBE BY NOW RENAMED "GLOBAL") GOES IN LAST. D POINTS AT WHERE IT WAS PUT. +; NOTE THAT FOR DECSAV FORMAT THE ORDERING IS REVERSED; A BLOCK'S SUBBLOCKS +; FOLLOW IT, AND THE .INIT BLOCK GOES IN FIRST. + +BKSRT: MOVEI D,BKTAB1-1 ;D IS FOR PUSHING INTO BKTAB1. + MOVSI A,1 ;START WITH BLOCK 0 (OUTERMOST, .INIT). + MOVE LINK,CONTRL + + ;HANDLE BLOCK IN A: LOOK FOR ITS SUBBLOCKS. +BKSR1: TRNE LINK,DECSAV + JRST [ MOVEI C,(A) ? PUSH D,C ? JRST .+1] + SETZ C, +BKSR2: CAME A,BKTAB+1(C) + JRST BKSR3 ;THIS BLOCK ISN'T A SUBBLOCK. + ADD A,[1,,] ;LH HAS SUBBLOCK'S LEVEL. + HRRI A,(C) ;RH HAS SUBBLOCK. + PUSHJ P,BKSR1 ;HANDLE THE SUBBLOCK + MOVE A,BKTAB+1(C) +BKSR3: ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKSR2 + TRNE LINK,DECSAV + POPJ P, + MOVEI C,(A) + PUSH D,C ;PUT THE BLOCK IN BKTAB1 (AFTER SUBBLOCKS) + POPJ P, + +PPBCK: ROT B,1 ;OUTPUT WD IN A, UPDATING CKSUM IN B. + ADD B,A + JRST PPB + +;THE THIRD WORD OF EACH BLOCK'S ENTRY IN BKTAB GETS THE NUMBER OF +;SYMBOLS IN THAT BLOCK (OF THE SYMBOLS THAT WE WILL PUT IN THE SYMTAB). + +BKCNT: PUSH P,B + MOVEI C,0 +BKCNT0: SETZM BKTAB+2(C) ;ZERO 3RD WD OF EACH BKTAB ENTRY. + ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKCNT0 +BKCNT1: MOVE C,ST+2(B) + SOS BKTAB+2(C) ;ADD -2 FOR EACH SYM IN THE BLOCK. + SOS BKTAB+2(C) + ADD B,WPSTE1 + AOBJN B,BKCNT1 +POPBJ: POP P,B + POPJ P, + +SSRTX: HRLM B,(P) ;DO ONE PASS OF RADIX-EXCHANGE. SAVE END. + CAIL A,@WPSTEB ;ONLY 1 ENTRY, NOTHING TO DO. + JRST SSRTX7 + PUSH P,A ;SAVE START. +SSRTX3: XCT CH1 + JRST SSRTX4 ;MOVE UP TO 1ST WITH BIT ON. + SUB B,WPSTE + XCT C ;MOVE DOWN TO LAST WITH BIT OFF. + JRST SSRTX5 + MOVE D,WPSTE + CAIE D,MAXWPS + JRST .+4 +REPEAT MAXWPS,[ + MOVE D,.RPCNT(A) ;EXCHANGE THEM, + EXCH D,.RPCNT(B) + MOVEM D,.RPCNT(A)] +SSRTX4: ADD A,WPSTE +SSRTX5: CAME A,B ;ALL DONE => DO NEXT BIT. + JRST SSRTX3 ;MORE IN THIS PASS. + ROT CH2,-1 ;NEXT BIT DOWN. + POP P,A ;A -> START, B -> END OF 1ST HALF. + JUMPL CH2,SSRTX6 ;ALL BITS IN WD DONE, STOP. + PUSHJ P,(AA) ;DO NEXT BIT ON 1ST HALF. + HLRZ B,(P) ;A -> END OF 1ST HALF, B -> END OF ALL. + PUSHJ P,(AA) ;DO SECOND HALF. +SSRTX6: ROT CH2,1 ;LEAVE CH2 AS FOUND IT. +SSRTX7: HLRZ A,(P) ;LEAVE A -> END OF AREA SORTED. + POPJ P, + +;ARITHMETIC CONDITIONALS (B HAS JUMP A,) + +COND: PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,AGETFD ;GET FIELD TO TEST VALUE OF +CONDPP: POP P,T ;RESTORE CONDITIONAL JUMP INSTRUCTION + HRRI T,COND2 ;HRRI IN JUMP ADDRESS, GO TO COND2 IF CONDITIONAL TRUE + XCT T ;JUMP IF COND T,ASSEMBLE STRING +COND4: SETZM A.SUCC ;MOST RECENT CONDIT. FAILED. +COND5: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WHAT PSEUDO WE'RE IN. + CALL RCH + JSP D,RARL4 ;INIT FOR THE CONDITIONALIZED STUFF. + CAIA + CALL RARFLS ;READ AND IGNORE THE ARG. + JRST MACCR + +ANULL: TLO FF,FLUNRD + JRST COND5 + +;.ELSE, .ALSO - B'S LH WILL HAVE SKIPE OR SKIPN. +A.ELSE: HRRI B,A.SUCC + XCT B + JRST COND4 ;CONDITION FALSE. + JRST COND2 ;TRUE. + +;IF1, IF2 - B'S LH WILL HAVE TRNE FF, OR TRNN FF, +COND1: HRRI B,FRPSS2 + XCT B + JRST COND4 ;NO + ;CONDITION TRUE, ASSEMBLE STRING +COND2: SETOM A.SUCC ;LAST CONDITIONAL SUCCEEDED. +COND6: PUSHJ P,RCH ;GET NEXT CHAR + CAIE A,LBRKT + JRST [ CAIE A,LBRACE + TLO FF,FLUNRD + JRST MACCR] + SKIPN SCNDEP ;BRACKET TYPE CONDITIONAL. + SKIPE CONDEP + JRST COND7 + MOVEMM CONDLN,CLNN ;AT TOP LEVEL, SAVE IN CASE THIS UNTERMINATED + MOVEMM CONDPN,CPGN +IFN TS, MOVEMM CONDFI,INFFN1 +COND7: AOS SCNDEP ;COUNT IT FOR RBRAK'S SAKE. + JRST MACCR + +;IFB, IFNB + +SBCND: PUSH P,B ;SAVE TEST JUMP + SETZB B,C ;C COUNTS SQUOZE CHARS FOR IFB/IFNB + ;B COUNTS NONSQUOZE FOR IFSQ/IFNSQ + JSP D,RARG ;INIT FOR READING OF ARG WHOSE BLANKNESS + JRST CONDPP ;IS TO BE TESTED. + JSP D,RARGCH(T) ;READ 1 CHAR, + JRST CONDPP ;(NO MORE CHARS) + HLRZ A,GDTAB(A) ;GET GDTAB ENTRY + CAIE A,(POPJ P,) ;POPJ => NOT SQUOZE + AOJA C,RARGCH(T) + AOJA B,RARGCH(T) + + ;IFDEF, IFNDEF + +DEFCND: PUSH P,SYM + PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + PUSHJ P,ES + MOVEI A,0 ;UNDEFINED +IFN CREFSW,XCT CRFINU + CAIN A,GLOEXT_-14. ;GLOBAL EXIT... + SKIPL CONTRL ;DURING ABSOLUTE ASSEMBLY? + CAIN A,3 ;NO, LOCAL UNDEF? + MOVEI A,0 ;ONE OF THESE => UNDEF + REST SYM + EXCH SYM,(P) ;POP SYM OUT FROM UNDER THE CONDITIONAL JUMP. + JRST CONDPP + +;;PWRD ;ROUTINES TO OUTPUT ASSEMBLES WORDS AND PORTIONS THEREOF + + ;HERE FROM PBITS TO OUTPUT WORD OF CODE BITS + +PBITS3: PUSH P,A + MOVEI A,14 + MOVEM A,PBITS2 ;INITIALIZE PBITS2 FOR COUNTING DOWN THROUGH NEXT SET OF CODE BITS + MOVE A,[440300,,PBITS1] + MOVEM A,BITP ;SET UP BITP FOR RELOADING PBITS1 WITH CODE BITS + MOVE A,PBITS1 ;NOW GET ACCUMULATED WORD OF BITS + MOVEM A,@PBITS4 ;STORE IN BKBUF + AOS A,OPT1 ;RESERVE SPACE FOR NEW WORD + ;IF FRBIT7 SET (LAST CALL TO PBITS HAD 7) THEN NEXT WORD OF CODE BITS GOES + ;AFTER NEXT WORD OUTPUT (REALLY!), OTHERWISE BEFORE + TRNN FF,FRBIT7 + SOSA A + TRO FF,FRINVT + HRRZM A,PBITS4 + POP P,A + CLEARM PBITS1 + ;DROPS THROUGH + ;OUTPUT RELOCATION CODE BITS IN A + +PBITS: SKIPGE CONTRL + POPJ P, ;NOT RELOCATABLE + SOSGE PBITS2 + JRST PBITS3 ;NO MORE ROOM IN WORD, OUTPUT IT AND TRY AGAIN + CAIN A,7 + TROA FF,FRBIT7 + TRZ FF,FRBIT7 + IDPB A,BITP + POPJ P, + + ;FOLLOWING ROUTINES SAVE AC'S EXCEPT FOR A + +OUTSM0: MOVE A,SYM ;OUTPUT NAME STINK KNOWS SYMBOL BY. + TLZ A,37777 ;FOR LOCALS, THAT'S THE STE ADDR, + HRRI A,ST(D) + TLNN SYM,40000 ;FOR GLOBALS, THAT'S THE SQUOZE. + JRST $OUTPT +OUTSM: SKIPA A,SYM +OUTWD: MOVE A,WRD +$OUTPT: SKIPGE CONTRL ;DIRECTLY PUNCH OUT WORD IN A IN RELOCATABLE ASSEMBLY ONLY + POPJ P, ;DO NOTHING IF ABSOLUTE ASSEMBLY + PUSH P,AA + MOVE AA,OPT1 + TRZN FF,FRINVT ;SKIP IF BEING HACKED FROM PBITS3, PUT WORD BEFORE WHERE IT NORMALLY BELONGS + AOS AA + MOVEM A,-1(AA) + MOVE A,CLOC + TRZE FF,FRFIRWD + HRRM A,BKBUF + POP P,AA + AOS A,OPT1 + CAIL A,BSIZE+BKBUF + TRNE I,IRCONT + POPJ P, + ;MAY DROP THROUGH + +;END CURRENT OUTPUT BLOCK + +EBLK: PUSH P,T + PUSH P,TT + PUSH P,A + PUSH P,B + MOVE T,CONTRL + JUMPGE T,EBLK3 ;JUMP IF RELOCATABLE ASSEMBLY + TRNE T,ARIM10\SBLKS + JRST ESBLK + TRNE T,DECSAV + JRST EDSBLK +IFN FASLP,[ + TRNE T,FASL + JRST FASLE ;FASL HAS NO BLOCKS TO END - IGNORE +] + TRNE T,DECREL + JRST DECEBL + JRST EBLK5 + +EBLK3: MOVE T,PBITS1 + MOVEM T,@PBITS4 + MOVEI T,PBITS4 + MOVEM T,PBITS4 + MOVE T,[440300,,PBITS1] + MOVEM T,BITP + CLEARB TT,PBITS2 + CLEARM PBITS1 + MOVEI T,BKBUF + MOVE B,OPT1 ;GET POINTER TO END OF BLOCK + SUBI B,BKBUF+1 ;CONVERT TO # WORDS IN BLOCK (EXCLUDING HEADER) + DPB B,[220700,,BKBUF] ;SET COUNT FIELD IN HEADER + TRZN FF,FRLOC + JUMPLE B,EBLK5 ;IGNORE NULL BLOCK UNLESS FRLOC SET + TLO FF,$FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) + PUSHJ P,FEED +EBK1: CAML T,OPT1 ;DONE WITH BLOCK? + JRST EBK2 ;YES + MOVE A,(T) ;NO, GET DATA WORD + JFCL 4,.+1 ;UPDATE CHECKSUM + ADD TT,A + JFCL 4,[AOJA TT,.+1] + PUSHJ P,PPB ;OUTPUT WORD + AOJA T,EBK1 +EBK2: SETCM A,TT ;DONE OUTPUTTING BLOCK, NOW GET CHECKSUM + PUSHJ P,PPB ;OUTPUT CHECKSUM + MOVE T,CDATBC ;GET BLOCK TYPE + DPB T,[310700,,BKBUF] ;SET NE T BLOCK TYPE TO STORAGE WORDS BLOCK TYPE + MOVEI T,BKBUF+1 + MOVEM T,OPT1 +EBLK4: TLO FF,$FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) +EBLK5: TRO FF,FRFIRWD +FASLE: POP P,B + POP P,A +PTT.TJ: POP P,TT + POP P,T + POPJ P, + +;PUNCH OUT WORD OF CODED DATA (E.G. STORAGE WORD); WRD, WRDRLC, GLOTB ENTRIES + +PWRDA: TROA FF,FRNLIK ;SUPPRESS ADR LINKING +PWRD: TRZ FF,FRNLIK ;PERMIT ADR LINKING + JUMPGE FF,CPOPJ ;IGNORE IF NOT PUNCHING PASS +IFN LISTSW,[ + SKIPN LSTONP + JRST PWRDL ;NOT MAKING LISTING NOW. + SKIPGE LISTPF + PUSHJ P,PNTR + SETOM LISTPF + MOVE LINK,WRD + MOVEM LINK,LISTWD + MOVE LINK,WRDRLC + MOVEM LINK,LSTRLC + MOVE LINK,CLOC + MOVEM LINK,LISTAD + MOVE LINK,CRLOC + DPB LINK,[220100,,LISTAD] +PWRDL: +] ;END IFN LISTSW, + SKIPGE LINK,CONTRL + JRST PWRD1 ;ABSOLUTE ASSEMBLY + ;RELOCATABLE ASSEMBLY + PUSHJ P,$RSET ;CHECK VALIDITY OF RELOCATION, STANDARDIZE IF NON-STANDARD + MOVE A,GLSP2 + CAMN A,GLSP1 + JRST PWRD2 ;NO GLOBALS + + ;NOW TO SEE IF IT'S POSSIBLE OR DESIRABLE TO ADDRESS LINK + + HRLZ B,WRD + HRR B,WRDRLC + JUMPN B,PWRD3 ;JUMP IF RH NON-ZERO + TRNN FF,FRNLIK + SKIPGE GLOCTP + JRST PWRD3 ;ADR LINKING SUPPRESSED OR CLOC GLOBAL + SKIPE LDCCC + JRST PWRD3 ;IN LOAD TIME CONDITIONALS + MOVNI T,1 ;INITIALIZE T FOR COUNTING +PWRD4: CAML A,GLSP1 + JRST PWRD5 ;DONE + HRRZ TT,1(A) ;GET GLOTB ENTRY + JUMPE TT,PWRD7A + LDB TT,[400400,,(TT)] ;GET SQUOZE FLAGS FROM SYM + CAIE TT,DEFGVR_-14. + CAIN TT,GLOETY_-14. + JRST PWRD3 ;DEFINED, BUT MUST BE HERE FOR A REASON (SEE $.H) + HLRZ TT,1(A) + TRNE TT,1777+MINF + JRST PWRD3 ;NEGATED OR MULTIPLIED + TRNE TT,HFWDF + JRST PWRD7 + TRNE TT,ACF + TRNN TT,SWAPF + JRST PWRD3 ;NOT HIGH AC +PWRD7A: AOJA A,PWRD4 +PWRD7: TRNE TT,SWAPF + AOJA A,PWRD4 ;LEFT HALF + AOJN T,PWRD3 ;JUMP IF THIS NOT FIRST GLOBAL IN RIGHT HALF + MOVEI D,1(A) ;FIRST GLOBAL, SET UP POINTER TO GLOTB ENTRY + AOJA A,PWRD4 + +PWRD5: AOJE T,PWRD3 ;NO GLOBALS LOOK BAD AND THERE AREN'T TOO MANY; JUMP IF NONE IN RH + HRRZ T,(D) ;GET ADR OF SQUOZE + SKPST T, ;SKIP IF IN SYMBOL TABLE + JRST PWRD3 ;BELOW SYMBOL TABLE, DON'T ADDRESS LINK AFTER ALL + PUSH P,T ;HOORAY, WE CAN ADDRESS LINK + SETZM (D) ;CLEAR OUT GLOTB ENTRY, DON'T NEED IT ANY MORE + PUSHJ P,PWRD31 ;DUMP OUT THE OTHER GLOBALS + POP P,D ;GET ST ADR OF THIS AGAIN + 3GET1 A,D + LDB A,[.BP (3RLNK),A] + MOVE B,WRDRLC + TLNE B,1 + TRO A,2 ;RELOCATE LEFT HALF + PUSHJ P,PBITS ;PUNCH OUT APPROPRIATE BITS FOR LINK LIST ENTRY + HLR A,1(D) ;GET ADR OF LAST + HLL A,WRD + PUSHJ P,$OUTPT ;OUTPUT WORD WITH RH = ADR OF LAST RQ FOR SYM TO PUT IN RH'S + MOVE A,CLOC ;NOW UPDATE ST ENTRY + HRLM A,1(D) + 3GET1 B,D + SKIPN CRLOC + TLZA B,3RLNK ;CLOC NOT RELOCATED LAST TIME THIS SYM USED + TLO B,3RLNK ;RELOCATED + 3PUT1 B,D + POPJ P, + +PWRD31: MOVE T,GLSP2 ;DUMP ALL GLO S IN GENERAL FORMAT +PWRD3A: CAML T,GLSP1 + POPJ P, + MOVE B,1(T) + TRNN B,-1 + AOJA T,PWRD3A + TLNE B,1777 + JRST RPWRD ;REPEAT +RPWRD1: LDB A,[.BP (MINF),B] + TRO A,4 + PUSHJ P,PBITS + MOVE A,(B) ;CODEBITS +SQUOZE FOR SYM + HLRZ C,A + TLZ A,740000 + CAIL C,DEFGVR + TLOA A,40000 ;SYM IS GLO + JRST [ MOVEI C,(B) ;IF WE ARE OUTPUTTING A REFERENCE TO THE + CAIL C,PCNTB ;"LABEL" AT THE BEGINNING OF A CONSTANTS AREA + CAIL C,PCNTB+NCONS*3 ;(BECAUSE THIS IS A 1PASS ASSEMBLY) USE THE + MOVEI A,(B) ;NAME, SINCE THE SYMBOL ISN'T IN THE + JRST .+1] ;SYMTAB + TLNE B,SWAPF + TLO A,400000 + TLNE B,ACF + JRST PWRD3E ;AC HIGH OR LOW + TLNN B,HFWDF + JRST PWRD3F ;ALL THROUGH + TLO A,100000 + TLNE B,SWAPF + TLC A,300000 +PWRD3F: PUSHJ P,$OUTPT + AOJA T,PWRD3A + + + +RPWRD: PUSHJ P,PBITS7 + MOVEI A,CRPT + PUSHJ P,PBITS + LDB A,[221200,,B] + PUSHJ P,$OUTPT + JRST RPWRD1 + +PWRD3E: TLO A,300000 + JRST PWRD3F + +PWRD3: PUSHJ P,PWRD31 +PWRD2: PUSHJ P,RCHKT + HRRZ A,B + DPB T,[10100,,A] + PUSHJ P,PBITS + JRST OUTWD + +;CHECK FOR VALIDITY OF RELOCATION BITS OF CURRENT WORD +;LEAVE RELOC (RH) IN B, RELOC (LH) IN T + +RCHKT: HRRZ B,WRDRLC ;CHECK FOR RELOC. OTHER THAN 0 OR 1. + HLRZ T,WRDRLC + TRZN B,-2 + TRZE T,-2 +RLCERR: ETSM [ASCIZ /Illegal relocation/] + POPJ P, + +RMOVET: ROT T,-1 + DPB B,[420100,,T] + TLZ C,3DFCLR ;SET RELOC BITS IN C + IOR C,T ;FROM B AND T. + POPJ P, + + ;CHECK WRDRLC FOR VALIDITY (CAPABILITY OF BEING PUNCHED OUT) + ;IF STANDARD THEN JUST RETURN + ;IF NON-STANDARD BUT OTHERWISE OK, PUT $R. ON GLOBAL LIST, RESET WRDRLC, AND RETURN + ;LEAVES B AND C SET UP WITH RH, LH OF WRDRLC. + +$RSET: MOVE C,WRDRLC ;GET RELOCATION + ADDI C,400000 ;WANT TO SEPARATE HALFWORDS + HLRE B,C ;GET LH IN B + HRREI C,400000(C) ;GET RH IN C (WILL EXCHANGE LATER) + MOVE A,[SWAPF+HFWDF,,$R.H] ;PUT THIS ON GLOBAL LIST IF LH NEEDS $R. + TRNE B,-2 ;CHECK LH + PUSHJ P,$RSET1 ;LH NEEDS GLOBAL REFERENCE + EXCH B,C + HRLI A,HFWDF + TRNE B,-2 ;CHECK RH + PUSHJ P,$RSET1 ;RH NEEDS GLOBAL REFERENCE + HRLZM C,WRDRLC ;RELOC OF LH + ADDM B,WRDRLC ;COMPLETE SETTING UP WRDRLC + POPJ P, + +$RSET1: JUMPGE B,$RSET2 ;STRANGE RELOCATION IN B, JUMP IF NON-NEGATIVE + MOVN T,B ;NEGATIVE, GET MAGNITUDE + TLOA A,MINF ;SET FLAG TO NEGATE GLOBAL +$RSET2: SOSA T,B ;POSITIVE, GET ONE LESS THAN IT IN T + TDZA B,B ;NEGATIVE, CLEAR B, RELOCATION LEFT OVER + MOVEI B,1 ;POSITIVE, SET RELOCATION LEFT OVER TO 1 + CAIN T,1 + MOVEI T,0 ;MULTIPLYING BY TWO OR SUBTRACTING TIMES 1 + TRNE T,-2000 + ETSM [ASCIZ /Relocation too large/] ;TOO BIG EVEN FOR $RSET + DPB T,[221200,,A] ;LOOKS OK, STORE TIMES FIELD IN $R. REFERENCE + AOS GLSP1 ;NOW PUT $R. ON GLOBAL LIST + MOVEM A,@GLSP1 + POPJ P, + +;PWRD DURING ABSOLUTE ASSEMBLY + +PWRD1: TRNE LINK,DECREL ; DEC REL FMT IS CONSIDERED ABSOLUTE. + JRST DECPW +IFN FASLP,[ + TRNE LINK,FASL + JRST FASPW ;SO IS FASL +] + MOVE A,GLSP1 + CAME A,GLSP2 + ETR ERRILG ;GLOBALS APPEARING ILLEGALLY + SKIPE WRDRLC + ETR ERRIRL ;RELOCATION APPEARING ILLEGALLY + TRNE LINK,ARIM + JRST PRIM ;RIM + TRNE LINK,DECSAV + JRST DSBLK1 +SBLKS1: MOVE A,WRD ;SBLK + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FRFIRWD + MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER + AOS A,OPT1 + CAIGE A,BKBUF+BSIZE + POPJ P, ;BKBUF NOT FULL YET + +SBLKS2: SUBI A,BKBUF+1 + JUMPE A,CPOPJ + MOVNS A + HRLM A,BKBUF + PUSHJ P,FEED + MOVEI T,BKBUF + CLEARM SCKSUM +SBLK1: CAML T,OPT1 + JRST SBLK2 + MOVE A,SCKSUM + ROT A,1 + ADD A,(T) + MOVEM A,SCKSUM + MOVE A,(T) + PUSHJ P,PPB + AOJA T,SBLK1 + +SBLK2: TRO FF,FRFIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,SCKSUM + JRST PPB + +ESBLK: MOVE A,OPT1 + CAIN A,BKBUF+1 + JRST EBLK5 ;AVOID SETTING $FLOUT IF NULL BLOCK. + PUSHJ P,SBLKS2 + JRST EBLK4 + +PRIM: MOVSI A,(DATAI PTR,) + HRR A,CLOC + PUSHJ P,PPB + MOVE A,WRD + JRST PPB + +; COME HERE TO OUTPUT WD IN ABSOLUTE DEC FMT (DECSAV) + +DSBLK1: MOVE A,WRD + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FRFIRWD + MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER + AOS A,OPT1 + CAIGE A,BKBUF+BSIZE + POPJ P, ;BKBUF NOT FULL YET, RETURN + +DSBLK2: SUBI A,BKBUF+1 + JUMPE A,CPOPJ + MOVNS A + SOS BKBUF ; DEC "IOWD" FMT, POINT AT LOC-1 + HRLM A,BKBUF + PUSHJ P,FEED + MOVEI T,BKBUF +DSBLK3: CAML T,OPT1 + JRST DSBLK4 + MOVE A,(T) + PUSHJ P,PPB + AOJA T,DSBLK3 + +DSBLK4: TRO FF,FRFIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + POPJ P, + +; END A BLOCK IN DEC SAV FMT, COME HERE FROM EBLK. + +EDSBLK: MOVE A,OPT1 + CAIN A,BKBUF+1 + JRST EBLK5 ;AVOID SETTING $FLOUT IF NULL BLOCK. + PUSHJ P,DSBLK2 + JRST EBLK4 + + +;END A BLOCK IN DEC FMT. COME FROM EBLK. +DECEBL: PUSH P,[EBLK5] +DECEB1: MOVSI A,DECWDS ;JUST INIT. AN ORDINARY BLOCK, + +;COME HERE TO OUTPUT PREVIOUS BLOCK AND START NEW BLOCK OF TYPE IN LH OF A. +DECBLK: PUSH P,A + HRRZ A,BKBUF ;GET DATA-WORD COUNT OF CURRENT BLOCK. + JUMPE A,DECB1 ;NO WORDS => CAN IGNORE. + MOVEI TT,BKBUF+1 +DECB0: MOVE A,-1(TT) ;GET AND PUNCH NEXT WD OF BLOCK. + PUSHJ P,PPB + CAME TT,OPT1 ;STOP WHEN NEXT WD ISN'T IN BLOCK. + AOJA TT,DECB0 +DECB1: POP P,A + HLLZM A,BKBUF ;PUT BLOCK TYPE IN LH OF HEADER, DATA WD COUNT IN RH IS 0. + MOVEI TT,BKBUF+2 ;ADDR OF PLACE FOR 1ST DATA WD + MOVEM TT,OPT1 ;(LEAVE SPACE FOR WD OF RELOC BITS) + MOVE TT,[440200,,BKBUF+1] + MOVEM TT,BITP ;BP FOR STORING PAIRS OF RELOC BITS. + SETZM BKBUF+1 ;CLEAR THE WD OF RELOC BITS. + TLO FF,$FLOUT + POPJ P, + +;COME HERE TO OUTPUT A WORD IN DEC FORMAT. +DECPW: MOVS A,BKBUF + CAIE A,DECWDS ;BEFORE THE 1ST STORAGE WD IN ORDINARY BLOCK, + JRST DECPW0 + MOVE A,CRLOC ;MUST GO THE LOCATION CTR. + IDPB A,BITP + MOVE A,CLOC + MOVEM A,@OPT1 + AOS OPT1 + AOS BKBUF ;IT COUNTS AS DATA WORD. +DECPW0: MOVE A,BITP + TLNE A,77^4 ;IF NO ROOM FOR MORE RELOC BITS, + JRST DECPW1 + HLLZ A,BKBUF ;START A NEW BLOCK. + PUSHJ P,DECBLK + JRST DECPW + +DECPW1: PUSHJ P,$RSET ;SET UP RELOC BITS OF HALVES IN B,C. + LSH C,1 + IORI B,(C) ;COMBINE THEM. + MOVE A,GLSP1 + CAME A,GLSP2 + JRST DECPG ;GO HANDLE GLOBALS. +DECPW3: IDPB B,BITP ;STORE THE RELOC BITS + MOVE A,WRD +DECPW2: MOVEM A,@OPT1 ;AND THE VALUE. + AOS OPT1 + AOS BKBUF + POPJ P, + +;PUT A WORD DIRECTLY INTO DEC FMT BLOCK. +DECWRD: SETZ TM, +DECWR1: IDPB TM,BITP ;SKIP A PAIR OF RELOC BITS, + JRST DECPW2 ;STORE THE WORD. + +;HANDLE GLOBAL REFS IN DEC FMT. +DECPG: PUSHJ P,DECPW3 ;FIRST, OUTPUT THE WORD, +DECPG0: MOVSI A,DECSYM + PUSHJ P,DECBLK ;THEN STRT A SYMBOLS BLOCK. + MOVE C,GLSP2 + PUSH P,SYM +DECPG1: CAMN C,GLSP1 ;ALL DONE => + JRST DECPG2 ;GO START AN ORDINARY BLOCK FOR NEXT WD. + MOVE A,BITP + TLNN A,77^4 ;BLOCK FULL => START ANOTHER. + JRST DECPG0 + AOS C,GLSP2 ;GET ADDR OF NEXT GLOBAL REF. + MOVE B,(C) + MOVE B,(B) ;GET NAME OF SYM. + TLZ B,740000 + CAMN B,[SQUOZE 0,$R.] + JRST DECPG3 ;(DEC'S LOADER HAS NO SUCH HACK.) + CALL ASQOZR ;RIGHT-JUSTIFY THE SQUOZE FOR DEC SYSTEM. + MOVE A,B + TLO A,600000 ;PUT IN FLAGS SAYING ADDITIVE GLOBAL RQ. + PUSHJ P,DECWRD ;OUTPUT NAME. + HRRZ A,CLOC ;GET ADDR OF RQ, + TLO A,400000 ;MACRO-10 SETS THIS BIT SO I WILL. + MOVE B,(C) + TLNE B,SWAPF ;SWAPPED => TELL LOADER.. + TLO A,200000 + TLNE B,ACF+MINF + ETSM ERRILG ;CAN'T NEGATE GLOBAL OR PUT IN AC. + MOVE TM,CRLOC + PUSHJ P,DECWR1 ;OUTPUT 2ND WD, + JRST DECPG1 ;GO BACK FOR MORE GLOBAL REFS. + +DECPG2: REST SYM + JRST DECEB1 + +DECPG3: ETR ERRIRL ;WE NEEDED $R. BUT DIDN'T HAVE IT. + JRST DECPG1 + +ERRILG: ASCIZ /Illegal use of external/ +ERRIRL: ASCIZ /Illegal use of relocatables/ + + +;OUTPUT PROGRAM NAME BLOCK (AT START OF PASS 2) +;IF 2-SEG PROGRAM, ALSO OUTPUT A TYPE-3 BLOCK (LOAD INTO HISEG) +DECPGN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2. + PUSH P,[EBLK] + MOVSI A,DECNAM + CALL DECBLK + MOVE B,PRGNM + CALL ASQOZR + MOVE A,B + CALL DECWRD + MOVSI A,14 ;IDENTIFY THIS REL FILE AS MADE BY MIDAS. + CALL DECWRD + MOVE A,DECTWO + CAMN A,[MOVE] + RET ;NOT A 2-SEG PROGRAM. +DECP2S: MOVSI A,DECHSG + CALL DECBLK ;START A LOAD-INTO-HISEG BLOCK. + MOVE A,DECTWO + HRL A,DECBRH ;HISEG BRK,,TWOSEG ORIGIN. + SKIPL A + HRLI A,(A) + MOVEI TM,1 ;RELOCATION IS 1. + JRST DECWR1 + +IFN FASLP,[ +;INITIALIZE OUTPUT FOR FASL ASSEMBLY +FASOIN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2 + MOVE A,[SIXBIT /*FASL*/] + PUSHJ P,PPB + MOVE A,[MIDVRS] + LSH A,-6 + TLO A,(SIXBIT /M/) + PUSHJ P,PPB ;"LISP" VERSION NUMBER (USE M AND MIDAS NUMBER) + MOVE A,[440400,,FASB] ;INITIALIZE FASL OUTPUT BUFFER + MOVEM A,FASCBP + MOVEI A,FASB+1 + MOVEM A,FASBP + POPJ P, + + +;COME HERE TO OUTPUT A WORD IN FASL FORMAT +FASPW: MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;"PUNCH" OUT ATOM TBL (IF MORE HAS APPEARED) + PUSHJ P,$RSET ;GET RELOC + PUSH P,C ;SAVE LH RELOC + MOVEM B,FASPWB ;B HAS RELOC, WHICH IS ALSO FASL CODE FOR RELOC =1 + MOVE A,GLSP2 +FASPW3: CAME A,GLSP1 + JRST FASPW1 ;LOOK TO SEE .. +FASPW2: MOVE A,WRD ;B HAS RELOC, WHICH ALSO HAPPENS TO BE FASL CODE TYPE + MOVE B,FASPWB + PUSHJ P,FASO ;OUTPUT WORD IN A WITH FASL CODE IN B + POP P,TM + JUMPE TM,FASPW5 ;NO LEFT HALF RELOC, OK + MOVNI A,1 ;ACTIVATE FASL HACK FOR LH RELOC + MOVEI B,7 ;WOULD OTHERWISE BE GETDDTSYM + PUSHJ P,FASO +FASPW5: MOVE C,GLSP2 +FASPW6: CAMN C,GLSP1 + POPJ P, + HRRZ TM,1(C) + JUMPE TM,[AOJA C,FASPW6] + MOVE SYM,(TM) ;GET SQUOZE OF SYM + TLZ SYM,740000 ;CLEAR CODE BITS + HLRZ D,1(C) + TRZ D,400000 ;DONT WORRY ABOUT THAT BIT + TRZE D,MINF + TLO SYM,400000 ;NEGATE + CAIN D,SWAPF + JRST FSPWSW + CAIN D,HFWDF + JRST FSPWRH + CAIN D,ACF+SWAPF + JRST FSPWAC + JUMPE D,FSPWWD + ETSM [ASCIZ /Global in illegal FASL context/] + +FSPWWD: TLOA SYM,140000 +FSPWAC: TLOA SYM,100000 +FSPWRH: TLO SYM,40000 +FSPWSW: MOVE A,SYM + MOVEI B,7 ;DDT SYM + PUSHJ P,FASO + AOJA C,FASPW6 + +FASPW1: HRRZ TM,1(A) ;GLOTB ENTRY + JUMPE TM,FASPW4 + CAIL TM,AFDMY1 + CAIL TM,AFDMY2 +FASPW4: AOJA A,FASPW3 + MOVE C,1(A) ;ITS A LIST STRUCTURE REF + TLNN C,-1-HFWDF + SKIPE FASPWB + ETA [ASCIZ /Illegal LISP structure reference/] + MOVE TM,AFDMY2-AFDMY1(TM) ;GET FASL BITS + MOVEM TM,FASPWB ;FASL BITS + CLEARM 1(A) ;FLUSH THAT GUY + AOJA A,FASPW3 + +FPATB: CAMN C,FASATP ;PUNCH OUT ATOM TBL, AMT ALREADY PUNCHED IN C + POPJ P, ;THRU + MOVEI B,12 ;ATOM TBL INFO + MOVE A,FASAT(C) + TRNN A,-1 + AOJA C,FPATB3 ;LIST WORD .. SHOULD HAVE PUNCHED ITSELF + PUSHJ P,FASO + HRRZ D,FASAT(C) ;ATOM "LENGTH" + AOS C +FPATB1: SOJL D,FPATB2 + MOVE A,FASAT(C) + PUSHJ P,FASO1 + AOJA C,FPATB1 + +FPATB3: ETR [ASCIZ /Internal loss at FPATB3/] +FPATB2: MOVEM C,FASPCH ;RECORD AMOUNT PUNCHED + JRST FPATB ;LOOP BACK IF MORE + + +FASO: PUSHJ P,FASBO ;WRITE BITS +FASO1: MOVEM A,@FASBP ;STORE A IN FASL OUTPUT BUFFER + AOS TM,FASBP + CAIL TM,FASB+FASBL + ETF [ASCIZ /.FASL output block too long/] + POPJ P, + +FASBO: MOVE TM,FASCBP ;OUTPUT FASL CODEBITS IN B, WRITE PREV BLOCK IF NECC + TLNN TM,770000 + PUSHJ P,FASBE ;WRITE PREV FASL BLOCK + IDPB B,FASCBP + POPJ P, + +FASBE: PUSH P,A + PUSH P,B + MOVEI TT,FASB +FASBO2: CAML TT,FASBP + JRST FASBO3 + MOVE A,(TT) + PUSHJ P,PPB + AOJA TT,FASBO2 + +FASBO3: POP P,B + POP P,A + CLEARM FASB ;NEW CODE WORD + MOVEI TM,FASB+1 + MOVEM TM,FASBP + SOS FASCBP + POPJ P, + +AFATOM: PUSH P,B ;SAVE CODEBITS + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ATOM illegal except in FASL assembly/] + PUSHJ P,AFRATM ;READ "ATOM", RETURN INDEX IN A + POP P,B + HLRZS B +AFLST1: AOS GLSP1 + MOVEI T,AFDMY1(B) ;DUMMY (STORE THIS INFO IN SYM SO CONSTANTS WILL WIN + HRRZM T,@GLSP1 + MOVEI B,0 ;NO RELOCATION + POPJ P, + +;GLOBALS IN THIS TABLE KEEP TRACK OF LIST REFS +;UNDEF GLOBAL GODEBITS +AFDMY1: SQUOZE 44,.%VCEL ;EVENTUALLY POINT TO VALUE CELL + SQUOZE 44,.%SCAL ;EVENTUALLY BECOME "SMASHABLE CALL" + SQUOZE 44,.%ATM ;EVENTUALLY POINT TO ATOM + SQUOZE 44,.%ARY ;EVENTUALLY POINT TO ARRAY +AFDMY2: 2 ;CODE BITS FOR VALUE CELL REF + 3 ;CODE BITS FOR SMASHABLE CALL + 4 ;CODE BITS FOR POINTER TO ATOM + 10 ;CODE BITS FOR POINTER TO ARRAY + +AFRATM: PUSHJ P,AFRTKN ;READ TOKEN, LEAVING IT AT END OF FASAT + PUSHJ P,AFRITN ;"INTERN" IT, SKIP IF NOT FOUND + POPJ P, ;IF FOUND, INDEX IN A + PUSHJ P,AFRENT ;ENTER IN FASAT + POPJ P, + +AFRENT: MOVE A,FASAT1 ;STORE FASAT1 IN FASATP + MOVEM A,FASATP + AOS A,FASIDX ;RETURN LOAD TIME ATOM INDEX + POPJ P, + +AFRTKN: MOVE A,FASATP + ADD A,[700,,FASAT] + MOVEM A,FASAT2 ;BYTE PNTR TO USE TO STORE ATOM + CLEARM (A) + CLEARM 1(A) ;MAKE SURE ALL LOW BITS CLEARED + PUSHJ P,RCH + CAIN A,"# + JRST AFRTK1 ;READ NUMBER INTO FIXNUM SPACE + CAIN A,"& + JRST AFRTK2 ;READ NUMBER INTO FLONUM SPACE +AFRTKL: IDPB A,FASAT2 ;STORE CHAR + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 +AFTERR: ETA [ASCIZ /LISP atom name table full/] + CLEARM 1(A) +AFRTL2: PUSHJ P,RCH + CAIN A,12 + JRST AFRTL2 ;IGNORE LF IN ATOM NAMES (PRIMARILY SO /CR WINS WITH ONE + CAIN A,"/ ;SLASH + JRST AFRQT ;QUOTE CHAR + CAIE A,40 + CAIN A,15 + JRST AFREND + CAIE A,"; + CAIN A,11 + JRST AFREND + CAIE A,"( + CAIN A,") + JRST AFREN2 + CAIL A,"A+40 + CAILE A,"Z+40 + JRST AFRTKL ;THAT CHAR WINS, SALT IT + SUBI A,40 + JRST AFRTKL ;MAYBE MUST CONVERT TO L.C. BEFORE SALTING IT. + +AFRQT: PUSHJ P,RCH ;TAKE NEXT CHR NO MATTER WHAT + JRST AFRTKL + +AFRTK1: SKIPA TM,[100000,,1] ;PUT VAL IN FIXNUM SPACE +AFRTK2: MOVE TM,[200000,,1] ;PUT IT IN FLONUM SPACE + PUSH P,TM + MOVE SYM,[SQUOZE 0,ATOM] + PUSHJ P,FAGTFD + POP P,TM + MOVE B,FASATP + ADDI B,2 + CAIL B,FASAT+FASATL + XCT AFTERR + MOVEM TM,FASAT-2(B) + MOVEM A,FASAT-1(B) + MOVEM B,FASAT1 + POPJ P, + +AFREN2: TLO FF,FLUNRD ;SAVE ( OR ) AS WELL AS FLUSHING +AFREND: MOVEI B,5 ;PAD END OF P.N. WITH 0 S + MOVEI TM,0 +AFREN1: IDPB TM,FASAT2 + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 + XCT AFTERR + CLEARM 1(A) + SOJG B,AFREN1 + SUBI A,FASAT + MOVEM A,FASAT1 ;STORE PNTR TO WORD BEYOND ATOM + ; MAYBE PUT THIS IN FASATP + MOVE B,FASATP ;ADR OF START OF ATOM READ + SUBI A,1(B) ;COMPUTE LENGTH OF FASAT + HRRZM A,FASAT(B) ;PN ATOM 4.8-4.7 =0 STORE LENGTH IN HEADER WD + + POPJ P, + +AFRITN: MOVEI B,0 ;"INTERN" LAST ATOM READ IN + MOVEI A,1 ;A CONTAINS RUNTIME ATOM TBL INDEX + ;B INDEX WITHIN FASAT +AFRIT1: CAML B,FASATP + JRST POPJ1 ;NOT FOUND + MOVE C,FASATP ;POINTS AT HEADER OF WORD OF NEW (?) ATOM + HRRZ D,FASAT(B) ;HEADER WD OF GUY IN TBL(RIGHT HALF HAS LENGTH) + JUMPE D,AFRIT4 ;JUMP ON RESERVED FOR LIST +AFRIT2: MOVE TM,FASAT(C) + CAME TM,FASAT(B) + AOJA B,AFRIT3 ;THIS ONE LOSES + SOJL D,CPOPJ ;THIS ONE WINS! + AOS B + AOJA C,AFRIT2 + +AFRIT3: SOJL D,[AOJA A,AFRIT1] ;FINISH SPACING OVER THIS GUY +AFRIT4: AOJA B,AFRIT3 + +AFENTY: SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ENTRY in NON-FASL/] + SKIPN CRLOC + ETI [ASCIZ /.ENTRY when . is absolute/] + PUSHJ P,AFRATM ;READ FUNCTION NAME + HRLZS A + PUSH P,A + PUSHJ P,AFRATM ;READ TYPE (SUBR, LSUBR, ETC) + HRRM A,(P) + MOVE SYM,[SQUOZE 0,.ENTRY] + PUSHJ P,FAGTFD ;READ ARGS PROP + JUMPGE FF,ASSEM1 ;NOT PUNCHING PASS + PUSH P,A + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ANY NEW ATOMS OUT + POP P,C + POP P,A + MOVEI B,13 + PUSHJ P,FASO + HRL A,C + HRR A,CLOC + PUSHJ P,FASO1 + JRST ASSEM1 + +AFLIST: HLRZM B,AFLTYP + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.LIST illegal except in FASL assembly/] + PUSHJ P,AFRLST ;READ LIST, RTN ATM TBL INDEX IN A + SKIPN AFLTYP + JRST ASSEM1 ;JUST EVAL IN LISP AND THROW AWAY VALUE + MOVEI B,AFDMAI ;"ATOM" INDEX IN AFDMY1 TBL + JRST AFLST1 ;TREAT AS ATOM + +AFRLST: CLEARM AFRLD ;"DEPTH" + CLEARM AFRLEN ;"LENGTH" OF LIST AT CURRENT LEVEL + CLEARM AFRDTF ;DOT CONTEXT FLAG + JUMPGE FF,AFRLI1 + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ALL ATOMS "PUNCHED" + MOVE A,FASATP + MOVEM A,AFRFTP ;SAVED STATE OF FASAT POINTER + MOVE C,AFLTYP + MOVEI B,16 ;EVAL TYPE HACK + CAIN C,1 + MOVEI B,5 ;LIST TYPE HACK + PUSHJ P,FASBO ;WRITE CODE BITS +AFRLI1: +AFRL1: PUSHJ P,RCH + CAIE A,40 ;PREV ATOM (OR WHATEVER) "DELIMITED", SO THESE MEANINGLESS + CAIN A,15 ;UNLESS AT TOP LEVEL AND HAVE READ SOMETHING + JRST AFRL1A + CAIE A,11 + CAIN A,12 + JRST AFRL1A + CAIN A,"( + JRST AFRLO + CAIN A,") + JRST AFRLC + CAIN A,". + JRST AFRDT ;DOT.. + TLO FF,FLUNRD + SKIPE AFRLD + JRST AFRNXT ;READ NEXT GUY THIS LVL + SKIPE AFRLEN +AFRLO2: ETI [ASCIZ /LISP read context error/] +AFRNXT: SKIPN TM,AFRDTF + JRST AFRNX2 ;NOT HACKING DOTS, OK + AOS TM,AFRDTF + CAIE TM,2 + JRST AFRLO2 ;DIDNT JUST SEE THE DOT +AFRNX2: PUSHJ P,AFRATM + JUMPGE FF,AFRNX1 ;XFER ON NOT PUNCHING PASS + PUSHJ P,FASO1 ;TELL LOADER TO PUSH THIS ON ITS STACK +AFRNX1: AOS AFRLEN ;LIST NOW ONE LONGER THIS LVL + JRST AFRL1 + +AFRLO: SKIPN TM,AFRDTF + JRST AFRLO3 ;NOT HACKING DOTS + SOJN TM,AFRLO2 + CLEARM AFRDTF + JRST AFRL1 ;IGNORE BOTH . AND ( +AFRLO3: SKIPE AFRLD ;( + JRST AFRLO1 + SKIPE AFRLEN + JRST AFRLO2 +AFRLO1: PUSH P,AFRLEN + CLEARM AFRLEN ;START NEW LVL + AOS AFRLD ;DEPTH NOW ONE GREATER + JRST AFRL1 + +AFRLC: SOSGE AFRLD ;) + JRST AFRLO2 ;AT TOP LEVEL, BARF + MOVE A,AFRLEN + SKIPN TM,AFRDTF + JRST AFRLC2 ;NOT HACKING DOTS + CAIE TM,2 + JRST AFRLO2 + SOS A ;MAIN LIST NOW ONE SHORTER + TLOA A,200000 ;DOT WITH LAST THING ON STACK +AFRLC2: TLO A,100000 ;TELL LOADER TO MAKE LIST THIS LONG + JUMPGE FF,AFRLC5 + PUSHJ P,FASO1 +AFRLC5: POP P,AFRLEN ;LENGTH AT PREV LVL + AOS AFRLEN ;NOW ONE MORE + CLEARM AFRDTF ;NOT HACKING DOTS NOW + SKIPE AFRLD ;RETURNING TO TOP LEVEL? + JRST AFRL1 + JRST AFRX1 ;YES THRU + +AFRDT: SKIPN AFRDTF + SKIPN AFRLEN + JRST AFRLO2 ;DOT IN FIRST POSITION OF LIST + AOS AFRDTF ;ENTER STATE 1 OF DOT HACKING + JRST AFRL1 + +AFRL1A: SKIPN AFRLD ;SPACER CHAR TERMINATES AT TOP LVL IF HAVE RD SOMETHING + SKIPN AFRLEN + JRST AFRL1 +AFRX1: JUMPGE FF,AFRX2 ;NOT PUNCHING PASS + MOVE A,AFRFTP + CAME A,FASATP + ETR [ASCIZ /Saw atoms in list on pass 2 for first time/] + SKIPN B,AFLTYP ;TYP LIST OP + SKIPA A,[-1,,] + MOVSI A,-2 ;PUT LIST OR VALUE OF LIST IN ATOM TBL + PUSHJ P,FASO1 ;TERM OP AND PUT IT IN ATOM TBL + MOVEI A,0 + MOVE B,AFLTYP + JUMPE B,CPOPJ ;JUST WANT VALUE OF LIST + CAIN B,1 ;ONLY WANT THIS FOR STRAIGHT LIST + PUSHJ P,FASO1 ;OUTPUT "SXHASH" WORD + AOS A,FASATP + CLEARM FASAT-1(A) ;RESERVE SLOT IN FASAT TBL + MOVEM A,FASPCH ;SAY ALREADY PUNCHED OUT + AOS A,FASIDX + POPJ P, + +AFRX2: TLO I,ILNOPT ;DONT TRY TO OPTIMIZE IF IN CONSTANT + CLEARB A,B + POPJ P, +] + +;.LIBRA, .LIFS, ETC. + +A.LIB: NOVAL ? NOABS + HLRZM B,LIBTYP' ;STORE BLOCK TYPE TO OUTPUT + CLEARM LIBOP ;INITIALIZE SQUOZE FLAGS + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK, MAKING SURE LOADER KNOWS $. +LIB1: PUSHJ P,GETSYL ;GET NAME + TRNN I,IRSYL + JRST LIB2 ;NO SYL, DON'T OUTPUT + IOR SYM,LIBOP + TLO SYM,40000 + PUSHJ P,OUTSM + MOVSI A,400000 + ANDCAM A,LIBOP +LIB2: MOVE B,CDISP ;GET CDISP + TLNN B,DWRD\DFLD ;CHECK FOR WORD TERMINATOR + JRST LIB3 ;WORD TERMINATOR => DONE + MOVE A,LIBOP + MOVE B,LIMBO1 ;RETRIEVE LAST CHAR READ + CAIN B,", + MOVSI A,400000 + CAIN B,"+ + TLZ A,200000 + CAIN B,"- + TLO A,200000 + MOVEM A,LIBOP' ;STORE SQUOZE FLAGS (LESS GLBL BIT) FOR NEXT SYM + JRST LIB1 + +LIB3: MOVE A,LIBTYP ;GET BLOCK TYPE TO OUTPUT + DPB A,[310700,,BKBUF] + PUSHJ P,EBLK + CAIN A,LLIB ;.LIBRA? + JRST ARELC1 ;.LIBRA, NOW PLAY LIKE RELOCA PSEUDO + JRST LIB5 ;SOMETHING ELSE (.LIFS), INCREMENT DEPTH IN LOAD TIME CONDITIONALS + +A.ELDC: NOVAL ? NOABS + PUSHJ P,EBLK + MOVEI A,ELTCB + DPB A,[310700,,BKBUF] + TRO FF,FRLOC ;MAKE EBLK OUTPUT NULL BLOCK + PUSHJ P,EBLK + SOSGE LDCCC + CLEARM LDCCC ;LOADER CONDITIONAL UNDERFLOW + JRST ASSEM1 + + ;LOADER CONDITIONAL ON VALUE + +A.LDCV: NOVAL ? NOABS + LSH B,-27. + PUSH P,B + PUSHJ P,AGETWD + POP P,B + DPB B,[400300,,BKBUF] + MOVEI A,LDCV + PUSHJ P,PLDCM + MOVEI A,0 + DPB A,[400300,,BKBUF] +LIB5: AOS LDCCC +CCASM1: JRST ASSEM1 + +;.GLOBAL, .SCALAR, .VECTOR +;LH(B) HAS ILGLI, ILVAR, ILVAR+ILFLO RESPECTIVELY. +; Note that use of ILFLO flag is a crock here. + +A.GLOB: NOVAL + HLLZ LINK,B ;REMEMBER WHICH OF THE THREE PSEUDO'S THIS IS. +A.GLO2: MOVE A,GLSPAS + MOVEM A,GLSP1 + SETOM FLDCNT + PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO NAME => DONE + CALL ES + JRST A.GLO1 + CAIE A,PSUDO_-14. + JRST A.GLO1 + JSP B,GVPSEU ;TRYING TO .GLOBAL A PSEUDO => TYPE APPRO. ERR MSG AND RETURN. + JRST A.GLO2 ;DON'T DO ANYTHING TO IT; MOVE ON TO NEXT ARG. + +A.GLO1: IOR I,LINK ;SET THE GLOBAL FLAG OR THE VARIABLE FLAG. + TLNE LINK,ILVAR ;FOR .VECTOR OR .SCALAR, SAVE # VARS CREATED BEFORE CREATING THIS ONE. + PUSH P,VARCNT ;SO WE CAN TELL IF THIS CALL TO GETVAL ACTUALY CREATES IT. + PUSHJ P,GETVAL ;NOW GET VALUE (CLOBBERS SQUOZE FLAGS) + CAIA + HALT + TLNN LINK,ILVAR ; THAT'S IT IF .GLOBAL, ELSE CONTINUE + JRST A.GLO2 + PUSH P,LINK ;.VECTOR OR .SCALAR, MUST READ THE SIZE. + TLO FF,FLUNRD ;RE-READ THE TERMINATOR AFTER THE SYM, SO "FOO(1)" AND "FOO," WIN + MOVE SYM,[SQUOZE 0,.SCALAR] + TLNE LINK,ILFLO ; USE RIGHT SYM + MOVE SYM,[SQUOZE 0,.VECTOR] + CALL AGETFD + REST LINK + REST B ;GET PREV. VARCNT, SO WE CAN SEE IF IT WAS INCREMENTED. + TRNN A,-1 ;MAKE (N) WORK AS SIZE BY USIN L.H. IF R.H. IS 0. + HLRZS A + JUMPN A,A.GLO3 ;JUMP IF NONZERO SIZE SPEC'D + TLNN LINK,ILFLO ; ZERO, USE DEFAULT + JRST A.GLO2 ; WHICH IS ALWAYS 1 FOR .SCALAR + SKIPA A,VECSIZ ; AND VECSIZ FOR .VECTOR. +A.GLO3: TLNE LINK,ILFLO ;NONZERO SIZE, SO + MOVEM A,VECSIZ ;DEFAULT MUST BE REMEMBERED FOR .VECTOR. + SUBI A,1 ;1 WORD WAS ALLOCATED BY GETVAL - HOW MANY MORE WANTED? + CAME B,VARCNT ;(MAYBE SYM ALREADY DEFINED, MAYBE PASS2, ...) + ADDM A,VARCNT ;IF GETVAL REALLY ALLOCATED THE SPACE THIS TIME, ALLOCATE THE + JRST A.GLO2 ;RIGHT AMOUNT. + + ;.LOP + +A.LOP: NOVAL ? NOABS + PUSHJ P,EBLK ;TERMINATE CURRENT BLOCK + REPEAT 3,PUSHJ P,RGETFD ;GET THE FIELDS + MOVEI A,LD.OP + PUSHJ P,PLDCN + JRST ASSEM1 + + ;.LIBRQ + +A.LIBRQ: NOVAL ? NOABS +A.LBR1: PUSHJ P,GETSLD + JRST MACCR + PUSHJ P,PBITS7 + MOVEI A,3 + PUSHJ P,PBITS + TLO SYM,40000 + PUSHJ P,OUTSM + JRST A.LBR1 + +A.LNKOT: AOS (P) ;THIS PSEUDO RETURNS NO VALUE. + NOVAL + +AEND5: JUMPGE FF,CPOPJ ;IGNORE FOLLOWING ON NOT PUNCHING PASS + MOVE D,SYMAOB +AEND5A: MOVE SYM,ST(D) + LDB T,[400400,,SYM] + CAIE T,DEFLVR_-14. + CAIN T,DEFGVR_-14. + JRST AEND5E + CAIE T,LCUDF_-14. + CAIN T,GLOEXT_-14. + JRST AEND5B +AEND5C: ADD D,WPSTE1 + AOBJN D,AEND5A + POPJ P, + +AEND5E: 3GET C,D + TLNN C,3LLV + JRST AEND5C +AEND5B: HLLZ B,ST+1(D) + 3GET C,D + TLNN C,3RLNK + JUMPE B,AEND5C + TLZ SYM,740000 + CAIE T,LCUDF_-14. + CAIN T,DEFLVR_-14. + SKIPA + TLO SYM,40000 + PUSHJ P,LKPNRO + HRRZS ST+1(D) ;CLEAR OUT LIST HEAD POINTER. + TLZ C,3RLNK ;INDICATE NO LIST. + 3PUT C,D + JRST AEND5C + + ;PUNCH OUT COMPLETE LOADER COMMAND, PUNCHING OUT WRD AS ONLY CONTENTS + +PLDCM: PUSH P,LINK ;SAVE LINK FOR ALOC AND FRIENDS (CLOBBERS OTHER AC'S) + PUSH P,A ;SAVE LOADER COMMAND TYPE + PUSHJ P,EBLK ;TERMINATE PREV BLOCK, MAKING SURE LOADER KNOWS $. + PUSHJ P,PWRDA ;PUNCH OUT THE WORD + POP P,A ;GET BACK LOADER COMMAND TYPE FOR PLDCN + PUSHJ P,PLDCN ;OUTPUT THE RESULTING BLOCK +PLINKJ: POP P,LINK ;RESTORE LINK + POPJ P, + +PLDCN: HRRM A,BKBUF ;STORE LOADER COMMAND TYPE IN BKBUF HEADER + MOVEI A,LLDCM ;LOADER COMMAND BLOCK TYPE + DPB A,[310700,,BKBUF] ;STORE BLOCK TYPE IN HEADER + TRO FF,FRLOC ;MAKE EBLK OUTPUT BLOCK EVEN IF EMPTY + JRST EBLK + +;.RELP RETURNS RELOCATION OF ARG +A.RELP: CALL AGETFD + MOVE A,B + JRST VALRET + +;.ABSP RETURNS ABSOLUTE PART OF ARG. +A.ABSP: CALL AGETFD + JRST VALRET + +;.RL1 IN RELOCATABLE ASSEMBLY RETURNS ZERO WITH RELOCATION FACTOR ONE. +;IN ABSOLUTE ASSEMBLY, IT RETURNS JUST ZERO. +;IFN <.RELP .RL1>, IS A TEST FOR A RELOCATABLE ASSEMBLY. +A.RL1: SKIPGE A,CONTRL + TRNE A,DECREL\FASL + SKIPA B,[1] + SETZ B, + SETZ A, + RET + +AEND: NOVAL + SKIPE ASMOUT ; ERROR IF IN GROUPING. + JSP LINK,CONFLM ;FLUSH CONSTANTS, GIVE ERROR MSG. + SKIPE SCNDEP ;IF THERE ARE UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS, MENTION THEM. + MOVE A,BKCUR + CAIE A,BKWPB ;NOT IN .MAIN BLOCK => ERROR. + ETR ERRUMB + MOVE A,CDISP + TLNN A,DWRD + TLO FF,FLUNRD ;IF LAST TERM. WAS WORD TERM., RE-READ. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + EXCH A,PNTBP + MOVEM A,LISTTM +] + PUSHJ P,AVARI0 + PUSHJ P,CNSTN0 + SKIPL A,CONTRL + JRST [ PUSHJ P,AEND5 ; STINK RELOCATABLE => .LNKOT + JRST AEND6] + TRNE A,DECSAV ; IF DECSAV FMT, + JRST [ MOVE A,CLOC ; USE LOC COUNTER AT END AS LOC OF SYMBOLS + SKIPN DECSYA ; UNLESS LOC ALREADY SPECIFIED. + MOVEM A,DECSYA + JRST AEND6] + TRNN A,DECREL + JRST AEND6 + MOVE A,CLOC ;IN DEC FMT, UPDATE HIGHEST ADDR SEEN, + SKIPN CRLOC ;UPDATE EITHER THE HIGHEST ABS ADDR + JRST [ CAML A,DECBRA + MOVEM A,DECBRA + JRST AEND6] + CAML A,DECTWO ;OR THE HIGHEST REL ADDR IN THE + JRST [ CAML A,DECBRH ;APPROPRIATE SEG. + MOVEM A,DECBRH + JRST AEND6] + CAML A,DECBRK + MOVEM A,DECBRK +AEND6: JUMPL FF,AEND1 ;ON PUNCHING PASS, SPECIAL STUFF + PUSHJ P,GETWRD ;OTHERWISE EAT UP WORD, + JRST RETURN ;AND RETURN + +AEND1: PUSHJ P,EBLK +IFN LISTSW,[ + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE A,LISTTM + MOVEM A,PNTBP +] + MOVE SYM,[SQUOZE 0,END] + TLZ I,ILWORD + PUSHJ P,AGETWD +IFN LISTSW,[ + MOVEM A,LISTWD + MOVEM B,LSTRLC + SETOM LISTAD + SETOM LISTPF + SKIPE LSTONP + PUSHJ P,PNTR + SKIPE LISTP + PUSHJ P,LPTCLS ;DONE LISTING + MOVE A,LISTWD +] ;END IFN LISTSW, + SKIPL B,CONTRL + JRST AEND3 ;RELOCATABLE +IFN FASLP,[ + TRNE B,FASL + JRST FASEN ;FASL FORM +] + TRNE B,DECSAV + JRST AEND4 + TRNN B,DECREL ;IF DEC FORMAT, + JRST AEND1A + TLNN I,ILWORD ;THEN IF THERE7S A STARTING ADDRESS, + JRST AEND2 + MOVSI A,DECSTA ;OUTPUT START-ADDRESS BLOCK. + PUSHJ P,DECBLK + PUSHJ P,PWRD + PUSHJ P,EBLK + JRST AEND2 + +IFN FASLP,[ +FASEN: JRST AEND2 +] + +AEND3: HRRZ A,CLOC + HRRM A,BKBUF ;SET UP PROGRAM BREAK JUST IN CASE OUTPUTTING MORE NULL DATA BLOCKS + MOVEI A,LCJMP + PUSHJ P,PLDCM + JRST AEND2 + + ; HERE FOR DECSAV FORMAT. +AEND4: TLNE A,-1 + JRST AEND1B ; IF SOMETHING IN LH, MAY BE ENTRY VECTOR. + MOVE B,A + MOVE A,[-1,,120-1] ; NOTHING, SO ASSUME SIMPLE JRST. MUST + PUSHJ P,PPB ; FIRST SAVE S.A. IN .JBSA CROCK. + MOVE A,B + PUSHJ P,PPB + TLO A,(JRST) ; FURNISH JRST FOR PUTTING AT END OF OUTPUT. + JRST AEND1B + +AEND1A: ; CHECK WORD AND MAYBE MAKE IT A JRST + TLNN A,777000 ; CHECK INSTRUCTION PART + TLO A,(JRST) ; WANTS JRST + PUSHJ P,PPB +AEND1B: JUMPG A,.+3 + ETR [ASCIZ /Start instruction negative/] + HRLI A,(JRST) ;END SYMTAB WITH POSITIVE WORD + MOVEM A,STARTA ;SAVE FOR PUNCHOUT AT END OF SYMTAB + PUSHJ P,FEED1 +AEND2: PUSH P,[RETURN] +CNARTP: +IFN DECSW\TNXSW,[ + PUSH P,TTYFLG + SKIPE CCLFLG ;IN DEC VERSION, IF RUN BY CCL, DON'T PRINT + AOS TTYFLG ;THIS STUFF ON THE TTY - ONLY IN ERROR FILE AND LISTING. + CALL CNTPD + REST TTYFLG + RET + +CNTPD: +] + MOVNI D,1 + MOVEI TT,PCNTB +CNTP1: CAML TT,PBCONL + RET + HRRZ B,1(TT) + HLRZ A,1(TT) + CAMN A,B + JRST CNTP2 + AOSN D + TYPR [ASCIZ /Constants area inclusive +From To +/] + LDB B,[.BP (CGBAL),2(TT)] + SKIPE B + TYPR [ASCIZ /Global+/] + HRRZ B,1(TT) + PUSHJ P,OCTPNT + PUSHJ P,TABERR + HLRZ B,1(TT) + SOS B + PUSHJ P,OCTPNT + PUSHJ P,CRRERR +CNTP2: ADDI TT,3 + JRST CNTP1 + +AENDM1: TYPR [ASCIZ /Unterminated successful bracketed conditionals +The first was at /] + AOS A,CONDPN + CALL DPNT + MOVEI A,"- + CALL TYOERR + AOS A,CONDLN + CALL D3PNT2 +IFN TS,[ + TYPR [ASCIZ/ of file /] + MOVE B,CONDFI + CALL SIXTYO +] + JRST CRRERR + +AXWORD: CALL XGETFD ;READ 1ST FIELD, + TLNE I,ILMWRD + CALL IGTXT ;SOAK UP REST OF TEXT PSEUDO. + HRLM A,WRD + HRLM B,WRDRLC + MOVSI C,HFWDF + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + PUSH P,GLSP1 + CALL XGETFD ;NOW THE SECOND FIELD + HRRM A,WRD + HRRES B + ADDM B,WRDRLC + MOVSI C,HFWDF + MOVEI B,0 + POP P,T + PUSHJ P,LINKTC + JRST CABPOP + +A.NTHWD:CALL AGETFD ;READ THE NUMBER OF THE WORD WE WANT. + SOJL A,CABPOP ;NEGATIVE OR 0 => RETURN 0. + SOJL A,A.1STWD ;1 => TURN INTO .1STWD. + ;ELSE SKIP APPRO. # OF WORDS, THEN DO .1STWD. + +A.NTH1: PUSH P,A + PUSH P,WRD + CALL XGETFD + TLZ FF,FLUNRD + REST WRD + REST A + TLNN I,ILMWRD + JRST CABPOP ;IF STRING ENDS BEFORE DESIRED WORD, RETURN 0. + SOJGE A,A.NTH1 + +A.1STWD: CALL XGETFD ;GET THE 1ST WD OF FOLLOWING TEXT PSEUDO, + CALL IGTXT ;THROW AWAY THE REST. + MOVE T,A ;RETURN THE VALUE + JRST TEXT5 ;COMPLAINING IF FOLLOWED IMMEDIATELY BY SYLLABLE. + +A.LENGTH: CALL PASSPS + PUSH P,[0] + PUSH P,A +A.LN1: PUSHJ P,RCH + AOS -1(P) + CAME A,(P) + JRST A.LN1 + SOS T,-1(P) + SUB P,[2,,2] + JRST TEXT5 ;RETURN VALUE IN T + +ARDIX: NOVAL + PUSHJ P,AGETFD ;GET FIELD ARG + MOVEM A,ARADIX + JRST MACCR ;RETURN WITHOUT CLOBBERING CURRENT VALUE + +A.RADIX: CALL AGETFD ;READ THE TEMP. RADIX. + PUSH P,ARADIX ;LAMBDABIND RADIX TO THAT VALUE. + MOVEM A,ARADIX + CALL XGETFD ;READ IN THE NEXT FIELD USING THAT RADIX. + REST ARADIX + JRST VALRET + +;READ A BIT-MASK AS ARG, RETURN THE LH OF BP. FOR THAT BYTE. +A.BP: CALL YGETFD + MOVEI C,SPACE + SKIPE CDISP ;IF ARG WAS ENDED BY A COMMA, TURN IT INTO A SPACE + HRRM C,CDISP ;SO THAT .BP FOO,BAR USES THE FLD SPACE FLD FORMAT. + JUMPE A,VALR1 + PUSH P,A + JFFO A,.+2 + MOVEI B,36. + EXCH B,(P) ;(P) HAS # LEADING ZEROS. + MOVN A,B + AND A,B ;A HAS ONLY THE LOW BIT OF THE BYTE. + JFFO A,.+2 + MOVNI B,1 ;B HAS 35.-<# TRAILING ZREROS.> + MOVEI A,1(B) + SUB A,(P) ;A HAS SIZE OF BYTE + LSH A,30 ;PUT IN S FIELD OF BP. + SUB P,[1,,1] + MOVNS B + ADDI B,35. ;B HAS # TRAILING ZEROS. + DPB B,[360600,,A] ;PUT THAT IN P FIELD OF BP. + JRST VALR1 + +;READ IN BP, RETURN BIT MASK TO SPEC'D BYTE. +;THE ARG SHOULD BE JUST THE LH OF A BP, WHICH MAY BE IN EITHER HALF OF THE ARG. +A.BM: CALL GETBPT ;READ IN A BYTE POINTER ARG, IN A, POINTING AT T. + SETZ T, + SETO C, +A.DPB1: DPB C,A ;PUT 1'S IN SPEC'D PART OF ACCUM T + MOVE A,T + JRST VALRET + +;READ IN A BYTE POINTER (REALLY JUST S AND P FIELDS) AND MAKE POINT AT AC T. +;RETURN IT IN AC A. +GETBPT: CALL YGETFD + TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH. + HRLI A,(A) + TLZ A,77 ;MAKE BP. -> AC T + HRRI A,T + RET + +;RETURN # TRAILING ZEROS IN ARGUMENT. +A.TZ: CALL YGETFD + MOVN B,A + AND A,B ;A HAS JUST LOW BIT OF ARG SET. + JFFO A,.+2 + MOVNI B,1 ;# OF ZEROS BEFORE LOW BIT = + MOVN A,B ;35. - <# TRAILING ZEROS> + ADDI A,35. + JRST VALRET + +;RETURN # LEADING ZEROS IN ARG. +A.LZ: CALL YGETFD + JFFO A,.+2 + MOVEI B,36. + MOVE A,B + JRST VALRET + +;.DPB STUFF,BP,WORD DOES A DPB OF STUFF INTO THE FIELD OF WORD SPEC'D BY BP, +;RETURNING THE RESULTING WORD. +A.DPB: CALL YGETFD ;READ STUFF. + PUSH P,A + CALL GETBPT ;READ BP AND TURN INTO ACTUAL BP POINTING AT T + PUSH P,A + CALL YGETFD ;READ IN WORD AND PUT IN T. + MOVE T,A + REST A ;A HAS BP + REST C ;C HAS STUFF + JRST A.DPB1 ;GO DO THE DEPOSIT AND RETURN THE ALTERED WORD. + +;.LDB BP,WORD RETURNS THE CONTENTS OF THE BYTE IN WORD SELECTED BY BP +A.LDB: CALL GETBPT + PUSH P,A + CALL YGETFD + MOVE T,A + REST A + LDB A,A + JRST VALRET + +AWORD: NOVAL + PUSHJ P,EBLK + PUSHJ P,GETWRD ;ON UNDEFINED SYM, WYB UNDEFINED SYM IN "WORD"? + PUSHJ P,PPB + JRST ASSEM1 + +;.BIND - MAKE SYMS BE DEFINED IN CURRENT (SPEC'D) BLOCK. LH(B) HAS 0. +;.KILL - FULLY KILL THE SYMS.LH(B) HAS 3KILL. +;.HKILL - HALFKILL THEM. LH(B) HAS 3SKILL. +;.XCREF - PREVENT CREFFING OF SYMS. LH(B) HAS 3NCRF. +;.DOWN - SET 3DOWN, MAKING SYM VISIBLE IN SUBBLOCKS IN 1 PASS ASSEMBLY. +A.KILL: NOVAL + HLLZ LINK,B ;REMEMBER BIT TO SET. +A.KIL1: CALL GETSLD ;READ NEXT SYMBOL NAME. + JRST MACCR ;NO MORE, EXIT. + SKIPE LINK ;EXCEPT FOR .BIND, DO NOTHING ON PASS 1. + JUMPGE FF,A.KIL1 + CALL ESDEF ;DEFINE THE SYMBOL, D HAS STE IDX. + JRST A.KIL2 ;SYMBOL NEVER SEEN. + IORM LINK,ST+2(D) ;SET THE BIT IN 3RDWRD.. + IOR C,LINK ;(IF .XCREF, PREVENT CREFFING THIS TIME) +IFN CREFSW,XCT CRFINU ;CREF THE SYMBOL + JRST A.KIL1 + +A.KIL2: MOVSI T,LCUDF ;SYMBOL UNDEFINED, MAKE UNDEF LOCAL. + IOR C,LINK ;WITH THE DESIRED BIT SET. + TLO C,3MACOK ;SHOULDN'T BE ERROR IF IT BECOMES MACRO. + CALL VSM2 +IFN CREFSW,XCT CRFINU + JRST A.KIL1 + +;EXPUNG SYM1,SYM2 ... ;UNDEFINE THOSE SYMS. +AEXPUNG: NOVAL +AEXPU2: PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO MORE NAMES + PUSH P,[AEXPU2] ;AFTER THIS SYM, POPJ TO READ ANOTHER. +;EXPUNGE 1 SYMBOL, SQUOZE IN SYM. +AEXPU1: PUSHJ P,ES + JFCL ;NOT FOUND, DON'T COMPLAIN, JUST CREF. +IFN CREFSW,XCT CRFDEF + HRLZI T,400000 ;EXPUNGED ZERO SYM + SKIPE ST(D) + MOVEM T,ST(D) + SKIPL CONTRL ;IF RELOCATABLE ANDLOCAL SYMBOL, + CAIL A,DEFGVR_-33. + RET + PUSHJ P,PBITS7 ;TELL STINK TO EXPUNGE SYM. + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY IS NEW TYPE RQ, + PUSHJ P,OUTSM0 + MOVSI A,400000 ;NEW NAME NULL => DELETE. + JRST $OUTPT + +;EQUAL SYM1,SYM2 ;DEFINE SYM1 SAME AS SYM2. +AEQUAL: NOVAL + PUSHJ P,GETSLD + ETR ERRTFA + PUSH P,SYM ;REMEMBER SYM NAME AND BLOCK TO DEF. IN. + PUSH P,ESBK + PUSHJ P,GETSLD + ETR ERRTFA +IFN CREFSW,XCT CRFINU ;CREF SYM DEFINED AS. + CALL ES ;LOOK UP SYM TO EQUATE TO. + JRST [ REST ESBK ;NOT FOUND => EXPUNGE THE 1ST SYM. + REST SYM + JRST AEXPU1] + REST ESBK + REST SYM +IFN CREFSW,XCT CRFDEF + PUSH P,A + PUSH P,B ;SAVE INFO ON VALUE OF SYM TO EQUATE TO. + PUSH P,C + CALL ESDEF + MOVEM SYM,ST(D) + REST B ;3RDWRD OF 2ND SYMBOL. + REST ST+1(D) ;(WHAT WAS PUSHED FROM B) + REST A + DPB A,[400400,,ST(D)] + TLZ C,3DFCLR ;SAVE OLD 3MAS, 3NCRF OF 1ST SYMBOL (AND ITS BLOCK #). + AND B,[3DFCLR,,] ;SET REST OF 3RDWRD BITS FROM 2ND SYMBOL. + IOR B,C + 3PUT B,D + JRST MACCR + +ERRTFA: ASCIZ /Too few args - EQUAL/ + +;.SEE SYM1,SYM2,... ;CREF THOSE SYMS. +A.SEE: CALL GETSLD ;READ 1 SYMBOL. + JRST MACCR ;NONE TO BE READ. +IFN CREFSW,[ + SKIPN CRFONP ;IF CREFFING, + JRST A.SEE + CALL ES + MOVEI A,SYMC_-33. + XCT CRFINU ;CREF THE SYMBOL. +] + JRST A.SEE + +;UUO HANDLING ROUTINE +;41 HAS JSR ERROR + +VBLK +ERRCNT: 0 ; NUMBER OF ERRORS HIT -- VALUE OF .ERRCNT +ERRCCT: 0 ;NUM CHARS OUTPUT ON LINE, FOR MAKING MSGS LINE UP. +ERRJPC: 0 ;JPC READ WHEN UUO. +ERROR: 0 +IFN ITSSW, .SUSET [.RJPC,,ERRJPC] + JRST ERRH ;GO HANDLE IT +PBLK +ERRH: PUSH P,T + PUSH P,B ;NOT TYPR => ERROR OF SOME KIND + PUSH P,A + PUSH P,C + LDB T,[331100,,40] ;PICK UP OP CODE + CAIN T,TYPCR_-33 ; TYPCR? + JRST TYPCR1 + CAIN T,TYPR_-33 ; OR TYPR? + JRST TYPR1 ; YES + ;ERROR OF SOME KIND + CAIE T,ETASM_-33 ;CHECK FOR SPECIAL LOSSAGES AT COLON + CAIN T,ETSM_-33 + CAME SYM,SYSYM ;ARE WE ABOUT TO MENTIO THIS LOSING LABEL AS THE LAST ONE? + JRST ERRH1 + MOVE T,SYSYM1 + + MOVEM T,SYSYM ;COLON LOSSAGE, DE-MUNG TAG WORDS FOR PRINTOUT + MOVE T,SYLOC1 + MOVEM T,SYLOC +ERRH1: +IFN TS,[ +IFN LISTSW,[ + CALL PNTR ;FORCE OUT BUFFERED LISTING OUTPUT + CALL PNTCRR ;AND CR, SO USER CAN SEE WHERE ERROR WAS. +] + PUSHJ P,ERRTFL ;IF NOT SAME FILE AS LAST, PRINT FILE NAME. +] + SETZM ERRCCT + AOS ERRCNT ; BUMP ERROR TOTAL +IFN DECSW,AOS .JBERR ; BUMP ERROR MESSAGE COUNTER FOR LOADER TO ABORT + MOVE A,SYSYM ;GET LAST TAG DEFINED + JUMPE A,ERR1 ;SKIP PRINTOUT IF NONE THERE + PUSHJ P,SYMTYP ;THERE, TYPE IT OUT + MOVE B,CLOC ;NOW GET CURRENT LOCATION + SUB B,SYLOC ;SUBTRACT VALUE OF LAST TAG + JUMPE B,ERR1 ;SKIP NUMERIC PRINTOUT IF RIGHT AT TAG + MOVEI A,"+ ;NOT AT TAG, + PUSHJ P,TYOERR ;TYPE OUT PLUS SIGN, + AOS ERRCCT ;(1 MORE CHAR TYPED) + PUSHJ P,OCTPNT ;THEN TYPE OUT DIFFERENCE IN OCTAL +ERR1: PUSHJ P,TABERR ;NOW SEPARATE WITH TAB + MOVE A,ERRCCT + CAIGE A,8 ;MAKE SURE MOVE TO COLUMN 16. + PUSHJ P,TABERR + MOVEI B,[ASCIZ/GL+/] + SKIPGE GLOCTP ;LOCATION GLOBAL? + PUSHJ P,TYPR3 ;YES, TYPE OUT THAT FACT. + MOVE B,CLOC ;GET CURRENT LOCATION + PUSHJ P,OCTPNT ;TYPE OUT IN OCTAL +;DROPS THROUGH + +;DROPS THROUGH. + PUSHJ P,TABERR + MOVE A,MDEPTH ;NOW DEPTH IN MACRO (NOT IRP, REPEAT, ETC.) EXPANSIONS + MOVSI T,-2 + CALL DPNT0 ;PRINT, IN 2-CHAR FIELD. + MOVEI A,". + CALL TYOERR ;(USED TO BE OCTAL) + MOVE A,CPGN ;CURRENT PAGE NUMBER (FIRST PAGE OF FILE => 0) + PUSHJ P,[AOJA A,D6PNT] ;TYPE IT OUT IN DECIMAL + MOVEI A,"- + CALL TYOERR + MOVE A,CLNN ;ALSO CURRENT LINE NUMBER + PUSHJ P,[AOJA A,D3PNT2] + PUSHJ P,TABERR + MOVEI A,48. ;ASSUME ALL THE STUFF WE'VE PRINTED TAKES 48. CHARS + MOVEM A,ERRCCT ;MAYBE SOMEDAY TABERR, ETC. WILL REALLY UPDATE ERRCCT PROPERLY. + LDB A,[331100,,40] ;PICK UP OP CODE AGAIN + CAIGE A,8 ;ERROR UUO MAX + JRST .+1(A) + JRST [HALT ? JRST .-1] ;OPCODE 0, OR TOO BIG. + JRST ERRSM ;ETSM => TYPE SYM AND MESSAGE. + JRST ERRR ;ETR => JUST PRINT MESSAGE + JRST ERRJ ;ERJ => RH(40) HAS JUMP ADR + JRST ERRI ;ETI => IGNORE LINE RET TO ASSEM1 + JRST ERRA ;ETA => RET TO ASSEM1 + JRST ERRASM ;ETASM => TYPE SYM AND GO TO ASSEM1 + JRST IAE ;ERF => FATAL. + +ERRJ: MOVE A,40 ;ERJ => RH(40) HAS JUMP ADR + HRRM A,ERROR + JRST ERRET1 + +ERRI: PUSHJ P,RCH ;ETI => IGNORE LINE, RETURN TO ASSEM1: EAT UP LINE + CAIE A,12 + JRST .-2 +ERRA: MOVEI A,ASSEM1 ;ETA => RETURN TO ASSEM1, DON'T TYPE SYM. + MOVEM A,ERROR + JRST ERRR + +ERRASM: MOVEI A,ASSEM1 ;ETASM => TYPE SYM AND RETURN TO ASSEM1 + MOVEM A,ERROR +ERRSM: MOVEI C,56. ;ETSM OR ETASM => TYPE OUT SYM THEN MESSAGE + CALL TYPE37 ;CR NOW IF WHOLE MSG WON'T FIT ON ONE LINE. + MOVE A,SYM + PUSHJ P,SYMTYP + PUSHJ P,TABERR +ERRR: CALL TYPE40 ;TYPE THE ERROR MESSAGE. +ERRET1: REST C + POP P,A ;COMMON RETURN POINT FROM UUOS + POP P,B + POP P,T + JRST 2,@ERROR + +;FINISH UP AN ERROR UUO'S ERROR MESSAGE. PRINT THE SPECIFIED STRING +;AND ALSO "IN DEFINE AT ..." IF NECESSARY, ALONG WITH APPROPRIATE CR'S. +TYPE40: MOVE C,ERRCCT + CALL TYPE37 + CALL TYPR4 ;PRINT THE ASCIZ STRING + CALL CRRERR + SKIPN A,DEFNPS ;IF INSIDE A LONG PSEUDO, + RET + MOVE A,DEFNLN + MOVE B,DEFNPN + CAMN A,CLNN ;WHICH DIDN'T START IN THIS VERY LINE, + CAME B,CPGN + JRST TYPE42 + MOVE A,DEFNFI + CAMN A,INFFN1 + JRST TYPE43 +TYPE42: MOVEI B,[ASCIZ/ in /] + CALL TYPR3 + MOVE A,DEFNPS + CALL SYMTYP ;SAY WHAT PSEUDO, AND WHERE IT STARTED. + MOVEI B,[ASCIZ/ Starting at /] + CALL TYPR3 + MOVE A,DEFNPN ;PAGE # -1. + CALL [AOJA A,DPNT] ;PRINT PAGE #. + MOVEI A,"- + CALL TYOERR + AOS A,DEFNLN + CALL D3PNT2 ;PRINT LINE #. +IFN TS,[ + MOVE B,DEFNFI ;PRINT FILE NAME IF IT ISN'T THE CURRENT FILE. + CAMN B,INFFN1 + JRST TYPE41 + MOVEI B,[ASCIZ/ of file /] + CALL TYPR3 + MOVE B,DEFNFI + CALL SIXTYO +] +TYPE41: CALL CRRERR ;AND CRLF. +TYPE43: MOVE A,ERROR + CAIN A,ASSEM1 ;IF THIS ERROR IS EXITING THE PSEUDO, + SETZM DEFNPS ;SAY WE'RE NOT IN IT ANY MORE. + RET + +;JSP TM,ERMARK IN A PSEUDO, TO ARRANGE FOR ERROR MESSAGES TO MENTION +;THAT PSEUDO. SYM SHOULD CONTAIN THE NAME OF THE PSEUDO. +;PUSHES A WORD ON THE STACK SO THAT WHEN THE PSEUDO RETURNS DEFNPS WILL BE CLEARED. +;IF DEFNPS IS SET UP ALREADY, DOES NOTHING (DOESN'T SET DEFNPS; DOESN'T PUSH THE WORD) +ERMARK: SKIPE DEFNPS + JRST (TM) + MOVEM SYM,DEFNPS + MOVE SYM,CLNN + MOVEM SYM,DEFNLN + MOVE SYM,CPGN + MOVEM SYM,DEFNPN + MOVE SYM,INFFN1 + MOVEM SYM,DEFNFI + MOVE SYM,DEFNPS + CALL (TM) + CAIA + AOS (P) + SETZM DEFNPS + RET + +;C SHOULD HAVE CURRENT HORIZ POS. IF TYPING THE STRING 40 POINTS AT +;WOULD OVERFLOW THE LINE, TYPE A CRLF AND TAB NOW ON THE TTY ONLY. +TYPE37: HRRZ B,40 + HRLI B,440700 ;FIRST, FIGURE OUT HOW FAR ON LINE WE'LL TYPE IF WE DON'T CR. + ILDB A,B + CAIE A, ;AND COUNT CHARS IN THE ERR MSG. + AOJA C,.-2 + CAMGE C,LINEL + RET +CRRTBX: MOVEI A,10 + MOVEM A,ERRCCT ;PREVENT THIS FROM BEING DONE TWICE. + SKIPE TTYFLG + RET + MOVEI A,^M ;IF THERE'S NO ROOM, CRLF ON THE TTY ONLY (NOT THE ERR FILE). + PUSHJ P,TYOX + MOVEI A,^J + PUSHJ P,TYOX + MOVEI A,^I + JRST TYOX + + ;TYPE OUT SQUOZE (FLAGS OFF) IN A + +SYMTYP: PUSHJ P,SQCCV ;GET NEXT CHAR IN ASCII. + AOS ERRCCT + PUSHJ P,TYOERR ;TYPE IT OUT. + JUMPE B,CPOPJ ;RETURN IF NOTHING LEFT (TYPED OUT AT LEAST ONE CHAR THOUGH) + IMULI B,50 ;LEFT-JUSTIFY REMAINDER + MOVE A,B ;GET LEFT-JUSTIFIED REMAINDER IN A + JRST SYMTYP ;TYPE OUT REMAINDER OF SYM + + ;TYPE OUT SQUOZE CHARACTER (IN A) + +SQCCV: IDIV A,[50*50*50*50*50] + CAIG A,10. + SOJA A,SQCDTO ;NUMBER (OR BLANK =>SLASH) + CAIL A,45 + SKIPA A,SYTB-45(A) ;SPECIAL + ADDI A,"A-13 ;LETTER + POPJ P, + +SQCDTO: ADDI A,"0 + POPJ P, + +SYTB: ". + "$ + "% + +D3PNT2: MOVE T,[-3,,400000] ;3 CHAR FIELD, NO ZERO SUPPRESSION. + JRST DPNT0 + +DPNT: TDZA T,T ;ORDINARY DECIMAL PRINT. +D6PNT: MOVSI T,-6 ;6 CHAR FIELD, ZERO SUPPRESSION. +DPNT0: IDIVI A,10. + HRLM B,(P) + TRNE T,377777 ;IF NOT LAST DIGIT, + TRNE T,400000 ;AND ZERO-SUPPR. WANTED, + JRST DPNT2 + JUMPN A,DPNT2 ;IF THIS IS A LEADING 0, + JUMPN B,DPNT2 + MOVEI B," -"0 + HRLM B,(P) ;REPLACE WITH A SPACE. +DPNT2: AOBJN T,.+2 ;J IF NOT ENOUGH CHARS YET. + JUMPE A,DPNT1 ;ENOUGH, DON'T MAKE MORE IF NOT NEEDED. + CALL DPNT0 + JRST DPNT1 + +;TYPE HALFWORD IN B IN OCTAL. +OCTPNT: HRRZ A,B + IDIVI A,10 + HRLM B,(P) + JUMPE A,.+2 + PUSHJ P,.-3 + AOS ERRCCT +DPNT1: HLRZ A,(P) +ADGTYO: ADDI A,"0 + JRST TYOERR + +;TYPE OUT THE SIXBIT WORD IN B + +SIXTYO: JUMPE B,CPOPJ + MOVEI A,0 + ROTC A,6 + ADDI A,40 + PUSHJ P,TYOERR + JRST SIXTYO + + ;TYPE CRLF + +CRR: MOVEI A,15 + PUSHJ P,TYO + MOVEI A,12 + JRST TYO + +;OP CODE 0 => NO RECOVERY RETURN TO GO9 +IAE: CALL TYPE40 ;PRINT THE ERROR MESSAGE. + SKIPE ASMOUT + JSP LINK,CONFLZ ;TELL USER ABOUT UNTERM. GROUPINGS. + SKIPE SCNDEP ;MENTION ANY UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS. +IFN ITSSW,[ + .SUSET [.RTTY,,A] + SKIPL A + .RESET TYIC, +] + JRST GO9 + + ;TYPR [ASCIZ /STRING/] ;TYPE OUT STRING + +TYPR1: PUSH P,[ERRET1] +TYPR4: HRRZ B,40 ;GET ADR OF BEGINNING OF STRING +TYPR3: HRLI B,440700 ;CONVERT TO BYTE POINTER +TYPR2: ILDB A,B ;GET NEXT CHAR + JUMPE A,CPOPJ ;JUMP IF ZERO, END OF STRING + PUSHJ P,TYOERR ;NON-ZERO, TYPE IT OUT + JRST TYPR2 + + ; TYPCR [ASCIZ /STRING/] ; Type out string, followed by CRLF + +TYPCR1: PUSH P,[ERRET1] + PUSHJ P,TYPR4 ; When done, fall thru. + +CRRERR: MOVEI A,^M ;CRLF IN ERROR MESSAGE. + CALL TYOERR + SKIPA A,[^J] +TABERR: MOVEI A,^I ;TAB INN ERROR MESSAGE. +TYOERR: +IFN LISTSW,[ + SKIPE LSTTTY ;OUTPUT TO LISTING UNLESS LSTTTY ZERO. + CALL PILPTX +] + SKIPG LSTTTY + JRST TYO ;TO TTY UNLESS LSTTTY POSITIVE. + RET + +;OUTPUT-FORMAT SELECTING PSEUDOS: + +;.SLDR -- ON PASS 2, PUNCH OUT SBLK LOADER AND SELECT SBLK FORMAT +A.SLDR: NOVAL + JUMPGE FF,MACCR ;DO NOTHING ON PASS 1. + PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE FIRST + PUSHJ P,PLOD1A ;PUNCH OUT LOADER +SIMBLK: MOVSI B,SBLKS ;ENTRY FROM PS1, A.SLDR SELECT SBLK + JRST SIMBL1 + +SRIM: MOVE A,SYM ;ENTRY FROM GETVAL, LH(B) HAS RH(CONTRL) + PUSH P,B + CALL SYMTYP + TYPR [ASCIZ/ Encountered +/] + REST B +SIMBL1: TRO FF,FRNPSS + HRRI B,TRIV ;SET UP TRIV FLAG FOR LH(CONTRL) + MOVSS B + CAME B,CONTRL ;IF CHANGING MODES, END THE BLOCK IN THE OLD MODE + CALL EBLK + MOVE A,CONTRL ;IF OLD MODE WAS RELOCATABLE OF SOME KIND, + TRNN A,DECREL\FASL + JUMPL A,SIMBL2 + SETZM CRLOC ;INITIALIZE LOCATION COUNTER. + MOVEI A,100 ; USE 100 ASSUMING ITS SBLK + TRNE B,DECSAV + MOVEI A,140 ; BUT USE 140 FOR DEC ABS. + MOVEM A,CLOC +SIMBL2: MOVEM B,CONTRL ;STORE NEW MODE. + TRNE B,ARIM\ARIM10 + TRZ F,FRSYMS ;RIM AND RIM10 MODES IMPLY NO SYMBOLS. + AOS (P) + + ;ROUTINE TO SET VARIABLES FOR BENEFIT OF NED LOGIC + ;CALLED BY OUTPUT SELECTING PSEUDOS +OUTUPD: NOVAL +IFN A1PSW,[ + TRNE FF,FRNPSS ;IF PASS 1, + TLNN FF,$FLOUT + JRST OUTCHK + AOS OUTN1 ;INDICATE "OUTPUT" HAS OCCURED OTHER THAN IN 1PASS MODE +OUTCHK: TLZE FF,$FLOUT + AOS OUTC ;INDICATE "OUTPUT" HAS OCCURED DURING CURRENT ASSEMBLY +] + RET + +ANOSYMS: NOVAL + TRZ FF,FRSYMS + JRST MACCR + +A1PASS: PUSHJ P,OUTUPD +A1PAS1: TLO FF,FLPPSS + MOVEIM A.PPASS,1 ;SET .PPASS TO 1. +IFN CREFSW,[ SKIPE CREFP ;THIS NOW PUNCHING PASS, + PUSHJ P,CRFON ;MAYBE TURN ON CREFFING. +] +IFN LISTSW,[ + SKIPE LISTP + CALL LSTON ;LIST NOW IF WANT LISTING AT ALL. +] + MOVE A,CONTRL + TRNE A,DECREL + CALL DECPGN + TRZA FF,FRNPSS +ARELOC: PUSHJ P,OUTUPD +ARELC1: PUSHJ P,EBLK ;FINISH CURRENT OUTPUT BLOCK + TRO FF,FRLOC ;DOING LOCATION ASSIGNMENT, MAKE SURE NEXT GETS OUTPUT + CLEARM CLOC + MOVEI A,1 + MOVEM A,CRLOC + CLEARM CONTRL + SETZM BKBUF + MOVEI A,LREL + DPB A,[310700,,BKBUF] + MOVEM A,CDATBC + JRST MACCR + + + ; .DECSAV - SELECT DEC ABSOLUTE ZERO-COMPRESSED (SAV) FORMAT +A.DECSAV: NOVAL + MOVSI B,DECSAV ; SET FLAG + JRST SIMBL1 ; THEN HANDLE ALMOST LIKE .SBLK + + +A.DECTWO: CALL AGETFD ;READ THE TWOSEG ORIGIN. + TRNN FF,FRNPSS + ETF [ASCIZ /.DECTWO follows 1PASS/] + MOVE C,ISAV + TRNN C,IRFLD ;NO ARG => DEFAULT IT TO 400000 + MOVEI A,400000 + MOVEM A,DECTWO + +A.DECREL: PUSHJ P,OUTUPD + TRZ FF,FRLOC + PUSHJ P,EBLK ;FORCE OUT BLOCK IN OTHER FMT. + MOVE A,[SETZ DECREL] + CAME A,CONTRL ;SWITCHING TO .DECREL MODE FOR 1ST TIME + TRNE FF,FRNPSS ;IN A 1PASS ASSEMBLY + JRST A.FAS1 + CALL A.FAS1 ;DO THE SWITCH + JFCL + CALL DECPGN ;THEN WRITE THE PROGRAM NAME + JRST MACCR + +A.FAS1: MOVEM A,CONTRL ;DEC FMT COUNTS AS ABS ASSEMBLY. + SETZM BKBUF ;(SO EBLK W0N'T OUTPUT ANYTHING) + SETZM CLOC ;START ASSEMBLING FROM RELOCATABLE 0. + MOVEI A,1 + MOVEM A,CRLOC + PUSHJ P,EBLK ;INITIALIZE AN ORDINARY (DECWDS) BLOCK. + JRST MACCR + +IFN FASLP,[ +A.FASL: PUSHJ P,OUTUPD + PUSHJ P,EBLK + MOVE A,[SETZ FASL] ;FASL ALSO COUNTS AS ABS + JRST A.FAS1 +] + +ATITLE: NOVAL + PUSH P,CASSM1 ;RETURN TO ASSEM1. + PUSHJ P,GSYL + SKIPE SYM + MOVEM SYM,PRGNM + MOVE T,[440700,,STRSTO] +ATIT2: ILDB A,T ;GET CHAR FROM TITLE STRING + SOSG STRCNT + JRST ATIT3 ;CHAR IS SYLLABLE TERMINATOR +IFE ITSSW,[ + SKIPE CCLFLG + TRNN FF,FRPSS2 +] + PUSHJ P,TYO ;NOT TERMINATOR, TYPE OUT AND LOOP BACK + JRST ATIT2 + +ATIT3: CALL ATIT1 ;PRINT THE REST OF THIS LINE. + MOVE A,CONTRL + TRNE A,DECREL + TRNE FF,FRNPSS + CAIA + ETF [ASCIZ /TITLE follows 1PASS/] + MOVE A,TTYINS + ADD A,A.PASS ;SHOULD WE .INSRT TTY: THIS PASS (T SWITCH) + JUMPG A,CPOPJ +IFDEF GTYIPA,JRST GTYIPA ;GO PUSH TO TTY IF CAN, +IFNDEF GTYIPA,HALT ;WHY DID YOU SET TTYINS IF CAN'T? + +ATIT1: CAIE A,15 ;CR? + CAIN A,12 ;LF? +IFN ITSSW,JRST CRR ;ONE OF THESE, FINISH TYPEOUT WITH CR +.ELSE [ JRST [ SKIPE CCLFLG + TRNN FF,FRPSS2 + JRST CRR + RET] + SKIPE CCLFLG ;NEITHER OF THESE, PRINT CHAR. + TRNN FF,FRPSS2 ;ON DEC SYS, DON'T PRINT THE TITLE ON P2, OR AT ALL IF RUN BY CCL. +] + PUSHJ P,TYO +A.ERR1: PUSHJ P,RCH ;GET NEXT CHAR IN TITLE + JRST ATIT1 + +;.ERR PSEUDO-OP -- FOLLOWED BY LINE WHICH IS ERROR MSG. +A.ERR: PUSH P,CASSM1 ;RETURN TO ASSEM1, + ERJ A.ERR1 ;AFTER NUMBERS AND USER'S STRING. + +A.FATAL:PUSH P,[GO9] ;.FATAL - CAUSE A FATAL ERROR. + ERJ A.ERR1 + +APRINT: NOVAL + HLRZS B ;B SAYS WHETHER PRINTX, PRINTC OR COMMENT. + JSP TM,ERMARK + CALL PASSPS + MOVE T,A +APRIN1: PUSHJ P,RCH + CAME A,T + JRST (B) ;GO TO APRIN1 FOR COMMENT, + JRST MACCR + +APRIN2: CAIE A,"! ;COME HERE FOR PRINTX +APRIN3: PUSHJ P,TYO ;HERE FOR PRINTC + JRST APRIN1 + +A.TYO: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A CHARACTER (AS NUMERIC ARG). + CALL TYOERR + JRST MACCR + +A.TYO6: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A WORD OF SIXBIT. + MOVE B,A + CALL SIXTYO + JRST MACCR + +;.BEGIN - START NEW BLOCK WITH NAME = ARG, OR LAST LABEL DEFINED. +A.BEGIN: NOVAL + SKIPE ASMOUT ;IF IN GROUPING, FLUSH IT & ERROR. + JSP LINK,CONFLM + PUSHJ P,GETSLD ;READ A NAME. + MOVE SYM,SYSYM ;NO ARG, USE NAME OF LAST LABEL. + MOVE A,SYM ;NAME TO USE FOR BLOCK. + MOVE B,BKLVL ;CURRENT LEVEL + 1 + HRLZI B,1(B) ;IS LEVEL OF NEW BLOCK. + HRR B,BKCUR ;ITS SUPERIOR IS CURRENT BLOCK. + MOVEI C,0 ;SEE IF AN ENTRY EXISTS FOR THIS BLOCK. + MOVE AA,A.PASS +A.BEG0: CAMN A,BKTAB(C) + CAME B,BKTAB+1(C) + JRST A.BEG1 ;THIS ENTRY ISN'T FOR BLOCK BEING ENTERED. + TDNE AA,BKTAB+2(C) ;FOUND: DEFINED IN THIS PASS? + ETSM [ASCIZ /Multiply defined BLOCK/] + JRST A.BEG2 ;NO, SAY IT'S DEFINED. + +A.BEG1: ADDI C,BKWPB ;LOOK THRU ALL ENTRIES. + CAMGE C,BKTABP + JRST A.BEG0 + CAIL C,BKTABS ;ALL ENTRIES USED => ERROR. + ETF ERRTMB + MOVEM A,BKTAB(C) ;ALLOCATE NEW ENTRY + MOVEM B,BKTAB+1(C) ;STORE NAME, LEVEL, SUPPRO. + MOVEI A,BKWPB(C) + MOVEM A,BKTABP ;POINTS TO 1ST UNUSED ENTRY. +A.BEG2: IORM AA,BKTAB+2(C) ;INDICATE BLOCK SEEN THIS PASS. + MOVEM C,BKCUR ;NEW BLOCK NOW CURRENT BLOCK, + AOS A,BKLVL ;ITS LEVEL NOW CURRENT LEVEL, + CAIL A,BKPDLS ;PUSH IT ON BLOCK PDL + ETF [ASCIZ /.BEGIN nesting too deep/] + MOVEM C,BKPDL(A) + JRST ASSEM1 + +ERRTMB: ASCIZ /Too many symbol blocks/ +ERRUMB: ASCIZ /Unmatched .BEGIN - .END/ + +;.END - POP CURRENT BLOCK. +A.END: NOVAL + SKIPE ASMOUT ;IN GROUPING => TERMINATE IT & ERROR. + JSP LINK,CONFLM + MOVE A,CDISP ;IF FOLLOWED BY WORD TERM, + TLNN A,DWRD ;CAUSE IT TO BE RE-READ + TLO FF,FLUNRD ;SO ARG WILL BE NULL. + PUSHJ P,GETSLD ;READ ARG. + JRST A.END0 ;NO ARG. + MOVE C,BKCUR ;ERROR UNLESS BLOCK BEING TERMINATED + MOVE A,BKTAB(C) ;HAS SAME NAME AS ARG. + EXCH A,SYM ;(MAKE SURE SYM NAME TYPED IS BLOCK'S NAME) + CAME A,SYM + ETSM ERRUMB ;ERROR, PRINT SYM (BLOCK'S NAME) +A.END0: MOVE C,BKCUR ;NOT OK TO END .MAIN BLOCK OR .INIT BLOCK. + CAIG C,BKWPB + ETA ERRUMB + HRRZ C,BKTAB+1(C) + MOVEM C,BKCUR ;POP INTO FATHER OF PREV. CURRENT BLOCK. + SOS BKLVL + JRST ASSEM1 + +;BKTAB: 3-WORD ENTRIES, 1 PER BLOCK, IN NO PARTICULAR ORDER. +;1ST WD HAS SQUOZE NAME OF BLOCK, FLAGS CLEAR. +;2ND WD HAS LEVEL,,BKTAB IDX OF CONTAINING BLOCK("FATHER", "SUPERIOR") +;3RD WD BIT 1.N ON => BLOCK ENTERED ON PASS N. +;SYMBOL TABLE OUTPUT RTN PUTS -2* IN 3RD WD. +;THE FIRST BKTAB ENTRY IS THAT OF THE OUTERMOST BLOCK (.INIT) +;IN WHICH INITIAL SYMS ARE DEFINED. +;THAT ENTRY'S 2ND AND 3RD WDS ARE 0. +;THE NEXT IS THAT OF THE MAIN BLOCK (.MAIN) IN WHICH +;ALL SYMBOLS ARE NORMALLY DEFINED (THAT IS, YOU ARE IN THAT BLOCK +;BEFORE YOU DO ANY .BEGIN'S). +;THAT ENTRY'S 2ND WD IS 1,, ; ITS 3RD, 0. + +;THE BKPDL IS A TABLE OF BLOCKS CURRENTLY ENTERED & NOT ENDED. +;BKPDL'S 1ST ENTRY IS FOR OUTERMOST BLOCK. +;LAST ENTRY IS BKPDL+@BKLVL, FOR CURRENT BLOCK. + +BKTABS==BKTABL*BKWPB + +VBLK +BLCODE [ +BKTAB: BLOCK 3 ;ENTRY FOR .INIT BLOCK. +PRGNM: BLOCK BKTABS-BKWPB ;PROGRAM NAME IS NAME OF MAIN BLOCK. +] +BKTABP: 0 ;IDX IN BKTAB OF 1ST UNUSED ENTRY. +BKPDL: BLOCK BKPDLS ;TABLE OF BLOCKS STARTED, NOT FINISHED. +BKLVL: 0 ;CURRENT BLOCK LEVEL, IDX OF LAST USED IN BKPDL. +BKCUR: 0 ;BKTAB IDX OF CURRENT BLOCK. +ESBK: 0 ;-1 OR BLOCK TO EVAL SYM. IN. +ESL1: 0 ;IN ES, LEVEL OF BLOCK OF BEST SYM SO FAR. +ESL2: 0 ;3RDWRD OF BEST SO FAR. +SADR: 0 ;SYM TAB IDX OF BEST SO FAR. +ESLAST: 0 ;RH IDX OF LAST DEF (EVEN IF NO GOOD) -1 IF NONE + ;SIGN NEG. IF LAST DEF SEEN BEFORE @ESXPUN +ESXPUN: -1 ;IF SEE EXPUNGED OR FREE ENTRY, PUT IDX HERE. +BKTAB1: BLOCK BKTABL ;USED BY SSYMD. +PBLK + +;.SYMTAB ARG ;SAY WANT AT LEAST ARG STE'S IN SYMTAB. +A.SYMTAB: NOVAL + PUSH P,[0] ;THIS WORD WILL BE SETOM'ED IF THERE IS REALLY ANY WORK NEEDED. + PUSHJ P,AGETFD ;GET DESIRED SYM TAB SIZE. + CAMG A,SYMLEN ;IF HAVE ENOGH ROOM ALREADY, + JRST A.SYM1 ;NO NEED TO RE-INIT. + CAILE A,SYMMAX ;IF WANTS MORE THAN MAXIMUM, ERROR. + ETF [ASCIZ/.SYMTAB 1st arg too big/] + MOVEM A,SYMLEN ;TELL INITS ABOUT NEW SIZE. + SETOM (P) +A.SYM1: CALL AGETFD ;READ DESIRED CONSTANTS TABLE SPACE ALLOCATION. + CAMG A,CONLEN ;IF TABLE ALREADY BUG ENOUGH, NOTHING TO DO. + JRST A.SYM2 + CAILE A,CONMAX + ETF [ASCIZ/.SYMTAB 2nd arg too big/] + MOVEM A,CONLEN ;ELSE REMEMBER IT AND SAY REALLOCATION NECESSARY. + SETOM (P) +A.SYM2: CALL AGETFD ;3RD ARG IS # WORDS PER SYMBOL - BUT ONLY 3 IS ALLOWED NOW. + JUMPE A,A.SYM3 ;EVENTUALLY 4 WILL GET 12-CHARACTER SYMBOLS. + CAIL A,MINWPS + CAILE A,MAXWPS + ETF [ASCIZ/.SYMTAB 3rd arg out of range/] + CAME A,WPSTE + SETOM (P) + MOVEM A,WPSTE +A.SYM3: REST A ;IS THERE ANYTHING THAT ACTUALLY NEEDS TO BE CHANGED? + JUMPE A,ASSEM1 ;IF NOT, NEVER GIVE ERROR - ELSE WOULD ALWAYS LOSE ON PASS 2. + MOVE B,PLIM + CAMN B,CONTBA ;IF THERE HAVE BEEN ANY LITERALS + SKIPE INICLB ;OR ANY MACROS, IRPS, REPEATS, ETC., THEN ... + ETF [ASCIZ/Too late to do .SYMTAB/] + MOVE CH1,MACTAD ;SET UP AC -> START OF INIT CODE + SUBI CH1,MACTBA ;SO IT CAN REFER TO ITSELF. + PUSHJ P,INITS(CH1) ;RE-INIT, SET SYMSIZ, SYMAOB, ETC. + PUSHJ P,MACINI ;INIT PTRS TO END OF MACTAB. + JRST ASSEM1 + +A.OP: PUSHJ P,A.OP1 ;.OP, + JRST VALRET ;RETURNS VALUE + +A.AOP: NOVAL + AOS (P) ;.AOP DOESN'T RETURN VALUE +A.OP1: PUSHJ P,AGETFD + PUSH P,A + PUSHJ P,AGETFD + PUSH P,A ;PDL NOW HAS FIELD 0 AND FIELD 1 + PUSHJ P,AGETFD + POP P,B ;B NOW HAS FIELD 1, A HAS FIELD 2, PDL HAS FIELD 0 + EXCH A,B + POP P,T ;T HAS FIELD 0, A HAS FIELD 1, B HAS FIELD 2 + TLNN T,(0 17,) ;IF AC FIELD NOT PRESENT IN INSN, SUPPLY ONE. + TLO T,(0 A,) + TDNN T,[0 -1(17)] ;IF NO ADDR OR IDX FIELD IN INSTRUCTION, + HRRI T,B ;SUPPLY ONE. + SETOM A.ASKIP' ;.ASKIP WILL BE -1 IFF INSN SKIPPED, ELSE 0. + TLNE T,74000 ;AVOID EXECUTING OPCODE ZERO. + XCT T + SETZM A.ASKIP + MOVEM A,AVAL1' ;STORE C(AC) AS .AVAL1 + MOVEM B,AVAL2' ;STORE C(E) FOR .AVAL2 + POPJ P, ;RETURN TO WHATEVER + +AASCIZ: TDZA T,T +A.ASCII: MOVEI T,1 + MOVEM T,AASCF1 ;STORE TYPE + MOVE D,[440700,,T] + SETZM AASCFT + JRST AASC1 + +AASCII: SKIPA D,[440700,,T] +ASIXBI: MOVE D,[440600,,T] + SETZM AASCFT ;INDICATE NOT .DECTXT + SETOM AASCF1 ;INDICATE REGULAR (NOT ASCIZ) + JRST AASC1 + +A.DCTX: NOVAL + MOVE A,CONTRL + TRNN A,DECREL + ETA [ASCIZ /.DECTXT in non-DECREL assembly/] + CALL EBLK + SETZ B, + SETOM AASCFT + SETOM AASCF1 ;INDICATE ASCIZ-STYLE PADDING + MOVE D,[440700,,T] +AASC1: TLZE I,ILMWRD + JRST TEXT2 ;MULTIPLE WORD, FALL IN FOR NEXT SET OF CHARS + MOVEMM ASMDS1,ASMDSP + MOVEM SYM,DEFNPS ;REMEMBER LOCATION IN FILE OF PSEUDO + MOVEMM DEFNLN,CLNN ;IN CASE THE DELIMITER IS MISSING. + MOVEMM DEFNPN,CPGN +IFN TS, MOVEMM DEFNFI,INFFN1 + HLRZ T,B ;GET FILL CHARACTER + IMUL T,[REPEAT 5,[1_<.RPCNT*7>+]0] ;CONVERT TO ASCII FILL WORD SHIFTED -1 (IMUL SCREW) + LSH T,1 ;SHIFT TO PROPER POSITION (EXTRA IN CASE WANT TO FILL W/ HIGH BIT SET) + MOVEM T,AASEFW ;STORE AS FILL WORD, T NOW SET UP TO ACCUMULATE VALUE + CALL PASSPS + MOVEM A,TEXT4 ;STORE TERMINATOR +TEXT7: PUSHJ P,RCH +AASC8: CAMN A,TEXT4 + JRST AASC1A ;TERMINATOR + TLNN D,760000 + JRST TEXT6 ;WORD FULL +TEXT9: TLNE D,100 ;CHECK BOTTOM BIT OF SIZE FIELD OF BP + JRST AASC2 ;SET => NOT SIXBIT + SUBI A,40 + CAILE A,77 + SUBI A,40 ;CONVERT LOWER CASE ASCII TO UPPER CASE + JUMPGE A,.+2 + ETR ERRN6B +AASC3: IDPB A,D + TRO I,IRSYL + JRST TEXT7 + +ERRN6B: ASCIZ /Character not SIXBIT/ + +;TERMINATOR + +AASC1A: TLNN D,760000 ;SKIP UNLESS END OF WORD + SKIPGE AASCF1 ;SKIP UNLESS REGULAR + JRST [ MOVE CH1,ASMDS1 ;REGULAR OR NOT END OF WORD + MOVEM CH1,ASMDSP ;RESTORE ASMDSP AS SAVED AT START OF PSEUDO. + JRST TEXTX] + MOVEI CH1,1 ;END OF WORD AND NOT REGULAR + JRST AASC1B ;EXTRA 0 NEED FOR Z FLAVOR + +AASC2: CAIN A,"! + SKIPG AASCF1 + JRST AASC3 ;NOT .ASCII OR NOT EXCL + PUSH P,T ;READ FIELD + PUSH P,D + PUSH P,SYM + PUSH P,ASMOUT ;PREVENT CLOSEBRACKETS FROM TRYING TO TAKE EFFECT. + MOVEIM ASMOUT,4 ;NOTE THIS LOSES IF CALL PSEUDO THAT RETURNS TO ASSEM1. + MOVEI SYM,[SETOM ASUDS1] ;NOW TO SET UP UNDEFINED SYM CONDITION + TLNE FF,FLPPSS + MOVE SYM,[SQUOZE 0,.ASCII] ;PUNCHING PASS, UNDEFINED => REAL ERROR + CLEARM ASUDS1 + PUSHJ P,AGETFD + ;"UNDEFINED IN .ASCII" ERROR INSTR, ERROR MESSAGE BUT ONLY ON PASS 2 + ;BUT NOTE THAT ON PASS 2 IT MIGHT ASSEMBLE DIFFERENT NUMBER OF WORDS, + ;CAUSING LOSSAGE IF NOT IN CONSTANT + REST ASMOUT + POP P,SYM + POP P,D + POP P,T + SKIPGE ASUDS1 + MOVNI A,1 ;HAD UNDEFINED SYMS SO ASSUME MAX + SKIPGE ASUDS1 + TLO I,ILNOPT ;ALSO DON'T OPTIMIZE OVER IN CONSTANT + MOVE CH1,[440700,,AASBF] + MOVEM CH1,ASBP1 + MOVEM CH1,ASBP2 + PUSH P,[AASC5] + MOVE CH1,A +AASC6: LSHC CH1,-35. + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,AASC6 + HLRZ A,(P) + ADDI A,"0 + IDPB A,ASBP1 + POPJ P, + +AASC5: MOVEI A,0 + IDPB A,ASBP1 ;END .ASCII NUMBER WITH ZERO +AASC8A: TLNN D,760000 + JRST AASC7 ;END OF WORD + ILDB A,ASBP2 + JUMPE A,AASC9 + IDPB A,D + JRST AASC8A + +AASC9: TLO FF,FLUNRD + JRST TEXT7 + +AASC7: TDZA CH1,CH1 +TEXT6: MOVNI CH1,1 ;WORD FULL +AASC1B: MOVEM CH1,AASCF2 + CLEARM CDISP + MOVEM A,TEXT8 + MOVE A,T + SKIPE AASCFT ;FOR .DECTXT, OUTPUT WORD INSTEAD OF RETURNING IT. + JRST [ CALL PPB + MOVE D,[440700,,T] + JRST TEXT2A] + TLO I,ILMWRD ;ELSE ARRANGE TO BE CALLED BACK TO RETURN NEXT WORD. + MOVEI T,ASSEM2 + MOVEM T,ASMDSP + SKIPLE CONSML ;IF NOT MULTI-LINE MODE, + JRST CLBPOP + MOVE T,ASMOUT ;IF THE TEXT IS IN <>'S OR ()'S, + HRRZ T,ASMOT2(T) + CAIE T,LSSTHA + JRST CLBPOP + CALL IGTXT ;USE ONLY THE FIRST WORD. + SKIPE CONSML ;AND ERROR IF IN ERROR MODE. + ETR [ASCIZ/Multi-word text pseudo in brackets/] + JRST CLBPOP + + ;GET NEXT WORD + +TEXT2: TRO I,IRFLD +TEXT2A: MOVE T,AASEFW ;INITIALIZE T TO FILL WORD + MOVE A,TEXT8 ;GET NEXT CHAR (ALREADY READ BY RCH) + SKIPGE B,AASCF2 + JRST TEXT9 ;REG OR HAVEN'T READ SECOND DELIMITER, FALL BACK IN + JUMPE B,AASC8A +TEXTX: SETZM DEFNPS + SKIPN AASCFT + JRST TEXT5 ;RETURNING FROM ASCIZ AFTER PUTTING THE TRAILING ZERO OUT. + MOVE A,T + CALL PPB ;FOR .DECTXT, OUTPUT THE FILL WORD INSTEAD. + JRST MACCR + +VBLK + +AASCF1: 0 ;-1 REG OR SIXBIT, 1 .ASCI 0 ASCIZ +AASCF2: 0 ;MULTIPLE WORD RETURN FLAG -1 REG 0 FINISH ! HACK 1 OUTPUT FILL WORD FOR Z +AASCFT: 0 ;0 REGULAR, -1 => .DECTXT (OUTPUT WORDS TO FILE INSTEAD OF RETURNING THEM) +TEXT4: 0 ;DELIMITER +TEXT8: 0 ;SAVED NEXT CHAR WHILE RETURNING BETWEEN WORDS +ASBP1: 0 ;IDPB TO AASBF ON .ASCII FIELD +ASBP2: 0 ;ILDB FROM AASBF " +AASBF: BLOCK 8 ;ACCUMULATED TYPEOUT OF NUMBER FOR .ASCII, EXTRA LONG FOR HACKERS TYPING OUT BINARY +ASUDS1: 0 ;UNDEFINED SYM FLAG FOR .ASCII DURING PASS 1 +AASEFW: 0 ;FILL WORD + +PBLK + +IGTXT: TLNN I,ILMWRD + RET + PUSH P,A ;ROUTINE TO EAT UP TEXT OF UNDESIRED MULTIPLE WORD + SKIPLE AASCF2 ;DETECT SCREW CASE: AFTER ASCIZ OF 5 CHARS, DELIMITER IS + JRST IGTXT1 ;ALREADY GOBBLED, BUT SOME OF THE ASCIZ REMAINS. + PUSHJ P,RCH + CAME A,TEXT4 + JRST .-2 +IGTXT1: TLZ I,ILMWRD + MOVEMM ASMDSP,ASMDS1 + SETZM DEFNPS + JRST POPAJ + +;".ASCVL /X" RETURNS THE ASCII VALUE OF "X". NOTE THE DELIMITER IS NOT REPEATED +;AND SERVES ONLY TO ALLOW SPACES TO BE IGNORED WHILE WINNING IF X IS A SPACE. +A.ASCV: CALL PASSPS ;SKIP SPACES TO REACH THE DELIMITER. + CALL RCH ;READ THE CHAR AFTER THE DELIMITER + MOVE T,A + JRST TEXT5 ;AND RETURN ITS ASCII VALUE. + +ASQOZ: HLLM B,(P) ;SAVE FLAG THAT'S 0 FOR SQUOZE, -1 FOR .RSQZ . + PUSH P,SYM + PUSHJ P,AGETFD + LSH A,36 + PUSH P,A + PUSHJ P,GETSLD ;GET SYM, SAVE DELIMITER FOR REINPUT + CALL NONAME + REST A + LDB B,[4000,,SYM] ;GET JUST THE SQUOZE. + SKIPGE -1(P) + PUSHJ P,ASQOZR ;FOR .RSQZ, RIGHT-JUSTIFY IT. + SUB P,[1,,1] + ADD A,B + JRST CLBPOP + +;RIGHT-JUSTIFY THE SQUOZE WORD IN B. +ASQOZR: MOVE SYM,B + IDIVI SYM,50 + JUMPN LINK,CPOPJ ;LAST ISN'T BLANK, DONE. + MOVE B,SYM ;ELSE REPLACE BY WHAT'S SHIFTED RIGHT 1 CHAR. + JRST ASQOZR + + ;COMMON PSEUDO ROUTINE TO RETURN MIDAS INTERNAL QUANTITY + ;ADR IN LH(B)) AS VALUE (EG. .RPCNT, .FNAM1, .AVAL2, ETC. + ;INTSYMS MAY APPEAR TO LEFT OF = + +INTSYM: MOVE A,B ;GET ADR IN LH(A) + JRA A,CLBPOP ;RETURN IT + + ;.YSTGW, .NSTGW ACCORDING TO WHAT'S IN LH(B) + +STGWS: HLRES B ;.NSTGW INCREMENTS STGSW, .YSTGW DECREMENTS. + ADDB B,STGSW + SKIPGE B ;BUT DON'T DECREMENT PAST 0. + SETZM STGSW + JRST MACCR ;STORAGE WORDS ARE ALLOWED IF STGSW IS ZERO. + + ;.TYPE + +A.TYPE: PUSH P,SYM + PUSH P,SYM + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + SUB P,[2,,2] + TRNN I,IRLET ;IF SYLLABLE IS A NUMBER, + JRST [ SETO A, ;RETURN -1. + JRST CLBPOP] + PUSHJ P,ES ;EVALUATE SYM, INTERESTED IN SQUOZE FLAGS RETURNED IN A + MOVEI A,17 ;DIDN'T SKIP, RETURN 17 => UNSEEN +IFN CREFSW,XCT CRFINU + JRST CLBPOP + +NONAME: MOVE SYM,-2(P) + ETSM [ASCIZ /No arg/] + SETZ SYM, + POPJ P, + + ;.FORMAT + +A.FORMAT: PUSHJ P,AGETFD ;GET FIRST FIELD (FORMAT #) + MOVE B,CDISP ;WORD TERMINATOR ENDED 1ST ARG => + TLNN B,DWRD + JRST A.FOR1 ;RETURN CURRENT SPEC FOR THAT FORMAT. + PUSH P,A + PUSHJ P,AGETFD ;GET SECOND FIELD (TABLE ENTRY FOR FORMAT NUMBER) + POP P,B + MOVEM A,FORTAB-10(B) + JRST ASSEM1 + +A.FOR1: MOVE A,FORTAB-10(A) + JRST CLBPOP + +A.BYTE: NOVAL + CLEARM NBYTS ;# BYTES ASSEMBLED + CLEARM BYTMT ;TOTAL ACTIVE BYTES IN TABLE + MOVE A,[440700,,BYBYT] ;POINTER TO NEW TABLE + MOVEM A,BYTMP +A.BY1: PUSHJ P,AGETFD ;GET FIELD, .GE. 0 => BYTE, .LT. 0 => HOLE + MOVE C,ISAV + TRNN C,IRFLD + JRST A.BY2 ;NO FIELD + MOVM B,A + SKIPGE A + TRO B,100 + IDPB B,BYTMP + AOS BYTMT +A.BY2: TLNE CH1,DWRD ;CDISP LEFT IN CH1 BY AGETFD + JRST A.BY1 ;NOT WORD TERMINATOR + SKIPN BYTMT ;WORD TERMINATOR, ANY FIELDS? + JRST A.BY3 ;NO, DO .WALGN AND RESET TO WORD MODE + SETOM BYTM ;ENTERING BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETOM BYTM1 + PUSHJ P,BYSET + MOVE A,GLSPAS + MOVEM A,GLSP1 + JRST ASSEM1 + + ;RESET THE BYTE DESCRIPTOR TABLE POINTERS TO POINT TO NEW WORD + +BYSET: CLEARM BYTMC ;COUNT OF BYTES PROCESSED THIS TABLE SCAN + MOVE A,[440700,,BYBYT] ;POINTER TO DESCRIPTOR TABLE + MOVEM A,BYTMP + ILDB A,BYTMP ;FIRST DESCRIPTOR BYTE + AOS BYTMC + DPB A,[300600,,BYTWP] ;DEPOSIT AS FIRST BYTE SIZE + POPJ P, + +A.BY3: CLEARM BYTM ;NO LONGER IN BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETZM BYTM1 + JRST A.WAL1 + +A.WALGN: NOVAL +A.WAL1: LDB A,[360600,,BYTWP] + CAIN A,44 + JRST ASSEM1 ;ALREADY AT BEGINNING OF WORD + MOVEI A,44 + DPB A,[360600,,BYTWP] ;MAKE IT POINT TO BEGINNING OF WORD + PUSHJ P,BYSET + CLEARM T1 + JRST PBY1 + +BYTIN1: CLEARM BYTMC + MOVE A,[440700,,BYBYT] + MOVEM A,BYTMP +BYTINC: AOS A,BYTMC + CAMLE A,BYTMT + JRST BYTIN1 + ILDB A,BYTMP + DPB A,[300600,,BYTWP] + MOVEM A,T1 + HLLZ A,BYTWP + IBP A + TRNN A,-1 + JRST BYTINR + ;NEXT BYTE GOES IN NEXT WORD +PBY1: MOVE P,ASSEMP ;PCONS NEEDS THIS. + MOVEI A,WRD-1 + PUSH A,BYTW ;INTO WRD, + PUSH A,BYTRLC ;INTO WRDRLC + CLEARM BYTW + SETZM BYTRLC + MOVEI A,44 + DPB A,[360600,,BYTWP] + MOVE AA,ASMOUT + JRST @ASMOT4(AA) ;TO PBY4 OR PBY5 OR PBY3 + +PBY4: SKIPE STGSW + ETR ERRSWD + PUSHJ P,PWRD ;NOT IN CONST., OUTPUT WORD. + AOSA CLOC +PBY3: JSP T,PCONS ;OUTPUT INTO CONST. +PBY5: MOVE A,GLSPAS + MOVEM A,GLSP1 +BYTINR: MOVE A,T1 ;CURRENT BYTE SIZE + TRNN A,100 + JRST @ASMDSP + SETZB A,B ;ASSEMBLE HOLE (BLANK BYTE) IMMEDIATELY AFTER PREVIOUS BYTE + JRST PBY2 + +PBYTE: AOS NBYTS +PBY2: MOVEI AA,WRD-1 + PUSH AA,BYTW ;INTO WRD + PUSH AA,BYTRLC ;INTO WRDRLC + IBP BYTWP + LDB T,[301400,,BYTWP] + PUSHJ P,INTFLD + POP AA,BYTRLC ;WRDRLC + POP AA,BYTW ;WRD + JRST BYTINC + + ;VARIABLES FOR .BYTE, .BYTC, .WALGN + +VBLK +BYTM: 0 ;-1 FOR IN BYTE MODE, LAMBDA BOUND BY <'S, ('S, AND ['S ;] +BYTMC: 0 ;COUNT CORRESP WITH BYTMP +BYTMP: 0 ;POINTER TO BYTE DESC TABLE +BYTMT: 0 ;TOTAL ACTIVE BYTES IN TABLE +BYTM1: 0 ;GLOBAL VALUE OF BYTM - WHAT IT WAS OUTSIDE THE OUTERMOST BRACKET + +;FORMAT OF BYTE DESC TABLE +;SEVEN BIT BYTES +;1.7=0 ASSEMBLE =1 BLANK +;1.1 - 1.6 NUMBER OF BITS + +IFNDEF LBYBYT,LBYBYT==5 ;LENGTH OF BYBYT +BLCODE [BYBYT: BLOCK LBYBYT] ;BYTE DESC TABLE, 7 BITS PER DESC + +BYTWP: 440000,,BYTW ;POINTER TO BYTW IDPB TO DEPOSIT CURRENT BYTE +BYTW: 0 ;WORD BEING ASSEMBLED IN BYTE MODE +BYTRLC: 0 ;RELOC OF BYTW. +NBYTS: 0 ;NUMBER BYTES ASSEMBLED (FOR .BYTC) +BYTMCL==.-BYTMC +PBLK + +;;MACRO PROCESSOR +IFN MACSW,[ + ;GET IN B THE CHAR WHOSE ADR IS IN A, INCREMENT A + +REDINC: MOVE CH1,A + IDIVI CH1,4 + LDB B,PTAB(CH2) + AOJA A,CPOPJ + +VBLK ;THIS STUFF ALL RELOCATED WHEN MACTAB ADDR CHANGED. +PTAB: (341000+CH1)MACTBA ;BYTE TABLE + (241000+CH1)MACTBA + (141000+CH1)MACTBA + (41000+CH1)MACTBA + (341000+CH1)MACTBA+1 + + ;IN FOLLOWING MACROS, B = -1, 0, OR +1 (+ SIGN MUST BE GIVEN) + ;0 => BP SAME AS CHAR ADR, -1 => BP FOR ILDB, 1 => BP ONE AHEAD + + ;CHAR ADR IN A, RETURNS BP IN A, CLOBBERS A+1 + +DEFINE BCOMP A,B/ + IDIVI ,4 + ADD ,(+1)BCOMPT!B +TERMIN + +STOPPT: 041000,,MACTBA-1 +BCOMPT: 341000,,MACTBA + 241000,,MACTBA +BCOMPU: 141000,,MACTBA + 041000,,MACTBA + 341000,,MACTBA+1 + +;BP IN A RETURN CHAR ADR IN A, CLOBBERS A-1 (YES, A MINUS 1) +;2ND ARG IS SUBTRACTED - -1 GIVES ADDR OF THE NEXT CHAR. +DEFINE CCOMP A,B/ + MOVEI -1,0 + ASHC -1,2 + SUB ,(-1)CCOMPT!B +TERMIN + + ;BP IN A RETURN CHAR ADR IN A+1, CLOBBERS A + +DEFINE CCOMP1 A,B/ + MULI ,4 + SUB +1,(A)CCOMPT!B +TERMIN + +;FROM HERE THRU CCOMPE SET BY MACINI. +CCOMPB: 0 ;4*<41000,,MACTBA>-4 +CCOMPT: REPEAT 5,0 ;4*<41000,,MACTBA>+.RPCNT-3 +CCOMPE::PBLK + + ;BP IN A, DECREMENT IT + +DEFINE DBPM A + ADD A,[100000,,] + SKIPGE A + SUB A,[400000,,1] +TERMIN + +;SET UP CPTR FROM CHAR ADR IN A + +ACPTRS: MOVEI CH1,(A) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE COMPUTED CPTR + POPJ P, + +AFCOMP: HRRZM A,FREEPT ;ENTRY TO STORE C(A) INTO FREEPT +FCOMP: MOVE CH1,FREEPT ;COMPUTE FREPTB FROM FREEPT + BCOMP CH1,-1 + MOVEM CH1,FREPTB ;STORE CALCULATED BYTE POINTER + POPJ P, + +STPWR: MOVEI A,375 + JRST PUTREL + +VBLK +PUT377: MOVEI A,377 +PUTREL: JRST PUTRE1 ;IDPB A,FREPTB;STORE CHAR INTO FREE CHARACTER STORAGE + AOS A,FREEPT ;CLOBBERS ONLY A. + AOS PUTCNT + CAMGE A,MACHI + POPJ P, + JRST GCA +PBLK +PUTRE1: PUSH P,[IDPB A,FREPTB] + POP P,PUTREL ;COME HERE ONLY ON 1ST CALL TO PUTREL. + SETOM INICLB ;HAVE WRITTEN IN MACRO TAB & CLOBBERED INIT. + JRST PUTREL ;NOW GO BACK AND REALLY WRITE CHAR. + +;200 BIT SET ON CHAR READ FROM MACTAB, PROCESS SPECIAL CONDITION +;CLOBBERS A,CH1,CH2. + +MACTRM: CAIN A,176 ;376? + JRST RCHTRA ;376 => IGNORE, CHARACTER USED TO CLOBBER UNDESIRED CHARACTERS IN MACRO STORAGE + PUSH P,B ;SAVE B + CAIE A,177 + CAIN A,175 + JRST MRCH1 ;377, 375 => STOP + ADD A,BBASE ;DUMMY, RELOCATE TO POINT TO DUMMY TABLE + MOVEI B,RCHSAV ;RETURN TO RCHSAV ON END OF DUMMY + PUSHJ P,PUSHEM ;SAVE CURRENT STATUS + HRRZ A,(A) ;GET CHAR ADR OF DUMMY + BCOMP A,-1 ;CONVERT TO BYTE POINTER + MOVEM A,CPTR ;STORE AS NEW CPTR + MOVE A,TOPP + MOVEM A,BBASE +RCHTRB: POP P,B +RCHTRA: POP P,A ;POP RETURN + TLZN FF,FLUNRD ;IF NO CHAR TO RE-READ, JUST RETURN BACK TO THE ILDB A,UREDP. + JRST -3(A) + ANDI A,-1 ;IF A CHAR TO RE-READ, IF CALLED FROM RREOF, WE CAN RETURN TO RRU + CAIN A,RREOF+1 + JRST RRU + PUSH P,A ;OTHERWISE, CALL RCH TO RE-READ THAT CHAR, AND RETURN IT FROM + JRST RCH1 ;THE CURRENT ATTEMPT TO READ A CHAR. + +MRCH1: MOVE B,MACP +BPOPJ: POPJ B, ;RETURN AT END OF STRING EXPANSION + +;RCHSET ROUTINE TO CAUSE INPUT FROM MACRO PROCESSOR + +RCHMAC: TLO FF,FLMAC ;SET FLAG + JSP A,CPOPJ +RCHMC0: REPEAT 2,[ ;GETCHR, RR1 + ILDB A,CPTR ;GET CHAR + TRZE A,200 ;200 BIT... + PUSHJ P,MACTRM ;=> SPECIAL, PROCESS +] + .VALUE +IFN .-RCHPSN-RCHMC0,.ERR RCHMC0 LOSES. + ILDB A,CPTR ;SEMIC + TRZE A,200 + PUSHJ P,MACTRM + CAIE A,15 + JRST SEMIC ;NOT YET + JRST SEMICR ;YET + + ;PUSH INPUT STATUS IN FAVOR OF MACRO + ;B HAS RETURN ADR FOR END OF MACRO (OR WHATEVER) + ;SEE ALSO PMACP + +PUSHEM: PUSH P,A + PUSH P,F + MOVE F,MACP ;GET MACRO PDL POINTER + MOVE CH1,CPTR + CCOMP1 CH1,-1 ;CONVERT TO CHARACTER ADDRESS + HRL CH2,BBASE + PUSH F,CH2 ;PUSH BBASE,,CPTR + MOVEI A,1 ;=> EXPAND MACRO + PUSHJ P,PSHLMB ;SAVE LIMBO1 STATUS AND RETURN + JRST PSHM1 + + ;UNDO A PUSHEM + ;RETURNS BBASE,,CPTR IN B (CPTR RE-INITIALIZED, BBASE NOT) + +POPEM: PUSH P,A + PUSH P,F + MOVE F,MACP + PUSHJ P,POPLMB ;RESTORE LIMBO1 STATUS + POP F,B ;BBASE,,CPTR + MOVEI CH1,(B) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE NEW CPTR +PSHM1: MOVEM F,MACP ;STORE BACK MACRO PDL POINTER +POPFAJ: POP P,F +POPAJ: POP P,A + POPJ P, + +PMACP: MOVE B,MACP ;POP MACRO PDL + HRRZ A,(B) + SUB B,[1,,1] +IFN RCHASW,CAIE A,A.TYM8 + CAIN A,AIRR + JRST A.GO6 ;IRP OR .TTYMAC + CAIN A,REPT1 + JRST A.GO4 ;REPEAT + CAIE A,RCHSV1 ;MACRO + CAIN A,RCHSAV ;ARG + JRST A.GO6 + .VALUE ;DON'T HAVE RETURN, + JRST A.GO6 ;BUT TRY A.GO6 LIKE EVERYTHING BUT REPEAT + +A.GO4: HLLZS -1(B) ;REPEAT, CLEAR OUT COUNT REMAINING +A.GO6: TRO FF,FRMRGO ;EVERYTHING ELSE, SET FLAG TO QUIT + JRST (A) + + ;4.9(B) => .STOP ELSE .ISTOP + +A.STOP: HRRZ A,MACP + JUMPL B,A.STP1 + HRRZ B,(A) ;.ISTOP + CAIN B,REPT1 + HLLZS -2(A) ;REPEAT, STOP ALL INTERATIONS + CAIN B,AIRR + HRRZS -1(A) ;IRP TYPE, CLEAR OUT # GROUPS, DON'T ALLOW RECYCLE +A.STP1: MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP + JRST POPJ1 + +A.QOTE: JFCL +ATERMI: ETSM [ASCIZ/Not in macro/] + JRST MACCR ;MAYBE FLUSH MESSAGE IF PEOPLE HAVE PROBLEMS + +;PDL STRUCTURE FOR REPEAT +;TWO TWO WORD ENTRIES +;BBASE,,CPTR +;LIMBO1 STATUS,,# TIMES LEFT +;OLD .RPCNT,,BEG OF BODY +;GARBAGE,,REPT1 + +AREPEAT: PUSHJ P,AGETFD + JUMPLE A,COND5 ;NO REPEAT PLAY LIKE STRING COND FALSE + PUSH P,A + MOVE A,FREEPT + MOVEM A,PRREPT ;CHAR ADR BEGINNING OF REPEAT + MOVEI A,373 ;CHECK CHAR FOR REPEAT + PUSHJ P,PUTREL ;STORE AS FIRST CHR OF BODY + JSP D,RARL1 + CAIA + CALL RARGCP ;READ THE ARG & COPY INTO MACRO STORAGE. + MOVEI A,^M ;IF THE ARG WASN'T BRACKETED, + TLNE FF,FLUNRD + CALL PUTREL ;INCLUDE THE TERMINATING CR. +SWRET1: PUSHJ P,STPWR ;ALSO RETURN FROM STRING WRITE (.F .I) + POP P,B ;# TIMES TO GO THROUGH + PUSHJ P,PUSHEM + MOVE B,MACP ;NOW GET MACRO PDL POINTER FOR PUSH OF SECOND ENTRY + MOVNI T,1 + EXCH T,CRPTCT ;GET OLD .RPCNT, INITIALIZE NEW ONE TO -1 +CREPT1: SETZI TT,REPT1 + EXCH TT,PRREPT ;GET LOC BEGINNING OF BODY, CLEAR OUT PRREPT, DON'T NEED IT ANYMORE + HRL TT,T + PUSH B,TT ;SAVE OLD .RPCNT,,ADDRESS OF BODY. + PUSH B,CREPT1 ;PUSH CRUD,,REPT1 FOR RETURN + MOVEM B,MACP ;STORE BACK UPDATED MACRO POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE IMMEDIATE CYCLE + JRST MACCR + +IFN .I.FSW,[ ;CODING FOR .I, .F + +SWINI: MOVE A,FREEPT ;INITIALIZE, WILL EVENTUALLY PLAY LIKE REPEAT 1 + MOVEM A,PRREPT + MOVEI A,373 + JRST PUTREL + +SWRET: PUSH P,[1] ;REPEAT COUNT + JRST SWRET1 + +SWFLS: MOVE A,PRREPT ;FLUSH RETURN + PUSHJ P,AFCOMP + JRST MACCR +] + +;RECYCLE AROUND REPEAT + +REPT1: PUSH P,A + PUSH P,C + HRRZ A,(B) ;CHAR ADR BEG BODY + PUSHJ P,REDINC + CAIE B,373 + HALT ;FIRST CHAR OF REPEAT BODY NOT 373 + HRRZ C,MACP + HRRZ B,-2(C) ;# TIMES LEFT + SOJL B,REPT2 ;JUMP IF LAST TIME THROUGH WAS LAST TIME TO GO THROUGH + AOS CRPTCT + PUSHJ P,ACPTRS ;SET UP CPTR (CHAR ADR IN A) + HRRM B,-2(C) ;STORE UPDATED COUNTDOWN +REPT3: POP P,C + POP P,A + JRST REPT6 + +REPT2: SOS A ;MOVE BACK TO BEG OF REPEAT + ;(IN CASE GETS STORED INTO FREEPT) + MOVE CH2,CPTR + CCOMP CH2,-1 ;CONVERT TO CHARACTER ADDRESS + CAMN CH2,FREEPT + PUSHJ P,AFCOMP + MOVE A,[-3,,-2] + ADDB A,MACP + HLRZ A,1(A) + MOVEM A,CRPTCT + PUSHJ P,POPEM + JRST REPT3 + +;STRING CONDITIONALS (IFSE, IFSN) + +SCOND: MOVE A,FREEPT + MOVEM A,PRSCND + MOVEM A,PRSCN1 + PUSH P,SYM + HRRI B,SCONDF + PUSH P,B ;REMEMBER TEST INSTRUCTION. + SETOB C,SCONDF + JSP D,RARG ;COPY THE 1ST OF THE 2 STRINGS + CAIA + CALL RARGCP ;INTO MACRO STORAGE, FOLLOWED BY 375. + CALL STPWR + JSP D,RARG ;THEN START READING THE 2ND ARG, + JRST SCOND3 ;GO TO SCOND3 WHEN REACH END OF 2ND ARG. + JSP D,RARGCH(T) ;READ NEXT CHAR OF 2ND ARG, + JRST SCOND3 + EXCH A,PRSCND + PUSHJ P,REDINC ;RE-FETCH NEXT CHAR OF 1ST ARG + EXCH A,PRSCND + CAMN B,A ;COMPARE CHARACTERS + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CAIL A,"A+40 + CAILE A,"Z+40 ;NOT EQUAL => CONVERT BOTH TO UPPER CASE. + CAIA + SUBI A,40 + CAIL B,"A+40 + CAILE B,"Z+40 + CAIA + SUBI B,40 + CAMN B,A ;ARE THEY SAME EXCEPT FOR CASE? + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CLEARM SCONDF ;STRINGS DIFFER + CALL RARFLS ;IGNORE REMAINDER OF 2ND ARG. +SCOND3: CLEARB A,C ;END OF (SECOND) STRING ARG ENCOUNTERED + EXCH C,PRSCN1 + MOVEM C,FREEPT + PUSHJ P,FCOMP + EXCH A,PRSCND + PUSHJ P,REDINC + CAIE B,375 + CLEARM SCONDF + REST B + REST SYM + XCT B ;DO THE TEST. + JRST COND4 + JRST COND2 + +VBLK +BLCODE [DMYDEF: BLOCK DMDEFL] ;TABLE OF DUMMY NAMES FOR THING BEING DEFINED +DMYTOP: DMYDEF ;POINTER INTO DMYDEF, POINTS TO AVAILABLE WORD + ;SINCE ONLY ONE THING CAN BE DEFINED AT ONCE, IT IS NOT NECESSARY TO SAVE AND RESTORE DMYTOP +DMYBOT: DMYDEF ;-> 1ST DMYDEF WD USED AT THIS LEVEL. + ;RIGHT NOW, ALWAYS -> DMYDEF SINCE CAN'T HAVE DEFINITION + ;WITHIN A DEFINITION YET. + +PBLK + +PDEF: PUSHJ P,GSYL ;READ IN SYL + CAIE T,", ;IF DELIMITING CHR NOT , + JUMPE SYM,CPOPJ ;AND SYM NULL, RETURN +PDEF1: MOVEM SYM,@DMYTOP ;STORE SYM + AOS D,DMYTOP ;INCR PNTR + CAIL D,DMYDEF+DMDEFL ;CHECK FOR TABLE SIZE EXCEEDED + ETF [ASCIZ/Too many dummies in DEFINE or IRP/] + POPJ P, + +VBLK +BLCODE [DSTG: BLOCK DSSIZ] ;TABLE OF CHAR ADRS OF DUMMIES BEING DEFINED PRIOR TO MACRO EXPANSION +RDWRDP: DSTG ;POINTER TO DSTG, POINTS TO FREE WORD + ;NOTE THAT RDWRDP MUST BE SAVED AND RESTORED SINCE MORE MACROS CAN + ;BE EXPANDED DURING FIELD READ FOR DUMMY +PBLK + +ADDTR1: CLEARM PUTCNT +ADDTRN: MOVE A,FREEPT +ADDTR2: MOVEM A,@RDWRDP + AOS A,RDWRDP + CAIL A,DSTG+DSSIZ + ETF [ASCIZ/Too many dummies in all macros & IRPs being expanded/] + RET + +VBLK +BLCODE [DMYAGT: BLOCK DMYAGL] ;TABLE OF CHAR ADRS OF DUMMYS OF MACROS BEING EXPANDED + ;DMYAGT TRACKS WITH THE MACRO PDL; + ;DMYAGT CAN'T BE COMBINED WITH DSTG SINCE DMYAGT CAN BE SHIFTING AROUND RANDOMLY DURING ARG SCAN +BBASE: DMYAGT ;POINTER TO BEGINNING OF ACTIVE DUMMY LIST (FOR DEEPEST-NESTED MACRO BEING EXPANDED) + ;ADD TO DUMMY # TO GET LOCATION CONTAINING CHAR ADR OF DUMMY +TOPP: DMYAGT ;POINTER TO TOP OF DMYAGT ACTIVE, POINTS TO FREE REGISTER +PBLK + + ;ACTIVATE DUMMYS ON TOP OF DSTG TABLE + ;A -> FIRST (LOWEST) DUMMY IN DSTG TO ACTIVATE + +DMYTRN: MOVE B,TOPP + MOVEM B,BBASE + PUSH P,A +DMYTR2: CAML A,RDWRDP + JRST DMYTR1 + MOVE B,(A) + MOVEM B,@TOPP + AOS B,TOPP + CAIL B,DMYAGT+DMYAGL + ETF [ASCIZ /Too many dummy args active/] + AOJA A,DMYTR2 +DMYTR1: POP P,RDWRDP + POPJ P, + +;THE MACRO TABLE IS FILLED MAINLY WITH 8-BIT BYTES. +;THE FIRST WORD'S ADDR IS IN MACTAD; THE LAST+1'S IN MACTND. +;THE CHARACTER NUMBER OF THE LAST+1ST CHAR IS IN MACHI. +;MACHIB IS BP. TO HIGHEST BYTE OK TO FILL (LAST IN C(MACTND)-1) + +;IF A BYTE IN THE TABLE HAS ITS HIGH BIT OFF, IT IS AN ASCII CHARACTER. +;OTHERWISE, IT IS SPECIAL. IF THE 100 BIT IS OFF IT MEANS +;SUBSTITUTE A MACRO DUMMY ARG WHEN READ; THE CHAR IS THE NUMBER OF THE ARG+200 . + +;377 AND 375 ARE STOP CODES, CAUSING A POP OUT OF THE CURRENT STRING. +;GC CONSIDERS THE CHAR. AFTER A 375 TO START A NEW STRING. + +;376 IS IGNORED WHEN READ; USED TO CLOBBER UNWANTED CHARACTERS IN STRINHGS. + +;374 STARTS EVERY MACRO-DEFINITION. +;373 STARTS THE BODY OF A REPEAT. + +;370 STARTS A WORD STRING: +;THE WORD AFTER THAT WHICH CONTAINS THE 370 +; HAS THE LENGTH IN WORDS OF THE STRING IN ITS LH, +; IN ITS RH, THE ADDRESS OF WD WHICH POINTS BACK TO THIS ONE. +; THEN FOLLOW RANDOM WDS HOLDING ANYTHING AT ALL. +; GC WILL MAKE SURE IT STAYS ON WD BOUNDARY. +; THE LENGTH INCLUDES THE WD HOLDING THE LENGTH. +; IF THE RH OF 1ST WD HAS 0, GC WILL FLUSH THE STRING + +STRTYP: PUSHJ P,REDINC ;DEBUGGING AID ONLY + EXCH A,B + TRZE A,200 + JRST STRTP1 +STRTP2: PUSHJ P,TYO ;NORMAL CHAR, JUST TYPE OUT + MOVE A,B + JRST STRTYP + +STRTP1: PUSH P,A + MOVEI A,"* ;SPECIAL CHAR, TYPE * + PUSHJ P,TYO + POP P,A + TRNE A,100 + JRST STRTP3 ;CONTROL CHAR + ADDI A,260 ;DUMMY, CONVERT TO # + JRST STRTP2 ;TYPE OUT (SINGLE DIGIT) NUMBER + +STRTP3: CAIN A,175 + SKIPA A,C% ;STOP, TYPE % + MOVEI A,"/ ;SOMETHING ELSE, TYPE / + JRST STRTP2 + + + ;.GSSET, SET GENERATED SYM COUNTER + +A.GSSET: CALL AGETFD + MOVEM A,GENSM + JRST ASSEM1 + +;GSYL-LIKE ROUTINE, READ A SYL FOR WRQOTE + +WRQRR: PUSHJ P,RCH ;GET CHAR (MAYBE WANT THIS TO BE FASTER YET) + IDPB A,FREPTB ;DEPOSIT IN MACRO TABLE + CAMN F,FREPTB ;WAS THIS LAST CHAR IN TABLE? + JRST WRQRGC ;YES, NEED GARBAGE COLLECTION +WRQRR2: XCT GDTAB(A) ;DISPATCH ON CHAR + JFCL ;(MAYBE SKIPS) + SOJGE D,WRQRR ;LOOP FOR FIRST SEVEN CHARS + HRRI D,0 + JRST WRQRR + + ;HERE FROM WRQRR WHEN NEED GARBAGE COLLECTION OF MACRO TABLE + +WRQRGC: MOVEM C,WRQTBP ;PUT POINTER TO BEGINNING OF SYL WHERE IT WILL BE GC'D + MOVE A,MACHI + PUSHJ P,GCA ;GARBAGE COLLECT + MOVE F,MACHIB ;RESET F TO POINT TO NEW LAST CHAR IN MACTAB + MOVEI C,0 + EXCH C,WRQTBP ;GET BACK POINTER TO CHAR BEFORE SYL + MOVE A,LIMBO1 ;RETRIEVE LAST CHAR READ + JRST WRQRR2 ;LOOP BACK, PROCESS CHAR + + ;HERE FROM WRQOTE IF .QUOTE SEEN + ;.QUOTE TAKES ARG LIKE ASCII, PRINTC, ETC. + +A.QOT1: MOVE A,WRQBEG(P) ;GET BACK BP TO CHAR BEFORE .QUOTE + PUSHJ P,A.QOTS ;SET UP FREEPT AND FREPTB PROPERLY + MOVE A,LIMBO1 ;NOW GET CHAR AFTER .QUOTE + CAIE A,^I + CAIN A,40 ;COMPARE WITH SPACE + PUSHJ P,RCH ;SPACE, GOBBLE NEXT CHAR FOR DELIMITER, ELSE THIS ONE + MOVEM A,A.QOT2 ;STORE AS TERMINATOR OF STRING +A.QOT3: PUSHJ P,RCH ;GET CHAR TO QUOTE + CAMN A,A.QOT2 ;TERMINATOR? + JRST WRQOT1 ;TERMINATOR, BACK FOR MORE DEFINITION + PUSHJ P,PUTREL ;DEPOSIT CHAR + JRST A.QOT3 + +;READ IN BODY OF MACRO, IRP, OR WHATEVER + +WRQOTE: PUSH P,[0] ;USED FOR LENGTH OF SYMBOL (REALLY 6 MINUS IT). +WRQLEN==,-2 + PUSH P,[0] ;THIS WD USED FOR DEFINE/TERMIN COUNT. +WRQLVL==,-1 + PUSH P,[0] ;USED TO REMEMBER BEGINNING OF SYMBOL. +WRQBEG==0 + SETOM INICLB ;CLOBBERED INITS, .SYMTAB NOW ILLEGAL. + PUSHJ P,RCH ;MAYBE POP UP A LEVEL IN EXPANSIONS, SAVE MACTAB SPACE + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-INPUT + MOVE F,MACHIB ;POINTER TO LAST CHAR OK TO PUT IN MACTAB, STAYS IN F + TRO I,IRSYL\IRLET ;MAKE SURE FLAGS SET SO WON'T WASTE TIME AT MAKNUM, POINT +WRQOT0: +WRQOT1: MOVEI D,6 ;SQUOZE COUNTER + MOVEI SYM,0 ;INITIALIZE SYM + MOVE C,FREPTB ;GET POINTER TO CHAR BEFORE SYL ABOUT TO READ + PUSHJ P,WRQRR ;READ SYL + JUMPE SYM,.-2 ;LOOP UNTIL NON-NULL + ;NOW SEE IF DUMMY; **NOTE**: C STILL HAS BYTE POINTER, A SYL TERMINATOR + MOVE B,DMYBOT + CAML B,DMYTOP + JRST WRQOT2 ;NOT DUMMY + CAME SYM,(B) ;COMPARE WITH DUMMY NAME + AOJA B,.-3 ;LOOP ON NO MATCH + SUB B,DMYBOT ;DUMMY, CONVERT TO NUMBER + 200 + SUBI B,200 + LDB T,C ;GET LAST CHAR BEFORE SYL + CAIE T,"! ; ^ NOTE THAT THIS CAN LOSE IF MACRO HAS 33. ARGS + IDPB B,C ;NOT EXCLAMATION POINT, LEAVE THERE, DEPOSITING DUMMY CHAR + CAIN T,"! + DPB B,C ;EXCL, WIPE IT OUT + MOVEM C,FREPTB ;RESET FREPTB + CAIE A,"! ;A HAS DUMMY TERMINATOR, COMPARE WITH EXCL + TLO FF,FLUNRD ;NOT EXCLAMATION POINT, CAUSE IT TO BE RE-INPUT + JRST WRQOT1 ;LOOP BACK FOR NEXT SYL + +;SYL ISN'T DUMMY, CHECK FOR PSEUDO +WRQOT2: MOVEM D,WRQLEN(P) ;REMEMBER START OF AND LENGHTH OF THE SYMBOL. + MOVEM C,WRQBEG(P) + SETOM ESBK ;EVAL IN CURRENT BLOCK. + PUSHJ P,ES ;EVALUATE SYM (DOESN'T CLOBBER F) + JRST WRQOT0 ;NOT SEEN + CAIE A,PSUDO/40000 + JRST WRQOT0 ;NOT PSEUDO + TLZ B,-1 ;CLEAR OUT LH OF VALUE, ONLY INTERESTED IN RH + CAIN B,A.QOTE + JRST A.QOT1 ;.QUOTE + CAIE B,ADEFINE + CAIN B,AIRP + AOS WRQLVL(P) ;DEFINE OR IRP +IFN RCHASW,[CAIN B,A.TTYM + AOS WRQLVL(P) ;.TTYMAC +] + CAIE B,ATERMIN + JRST WRQOT0 + SKIPGE WRQLEN(P) + ETR [ASCIZ /TERMIN longer than 6 chars/] + SOSL WRQLVL(P) ;TERMIN, SKIP IF THE TERMINATING ONE + JRST WRQOT0 ;NOT MATCHING TERMIN, BACK FOR NEXT SYL + POP P,A ;GET BACK BP TO LAST CHAR BEFORE TERMIN + SUB P,[2,,2] .SEE WRQLVL,WRQBEG + MOVE T,DMYBOT ;WE'RE NO LONGER USING SPACE IN DMYDEF. + MOVEM T,DMYTOP +A.QOTS: LDB T,A ;HERE ALSO FROM A.QOT1, GET CHAR BEFORE .QUOTE OR TERMIN + CAIE T,"! + JRST A.QTS2 ;NOT EXCLAMATION POINT => OK + DBPM A, ;EXCLAMATION POINT, DECREMENT POINTER +A.QTS2: MOVEM A,FREPTB ;STORE AS NEW FREPTB + CCOMP1 A,-1 ;CONVERT TO CHAR ADR + MOVEM B,FREEPT ;STORE CHAR ADR AS NEW FREEPT + POPJ P, + +;FORMAT OF A MACRO: +;IT STARTS WITH A 374. +;THEN COME ARGUMENT DESCRIPTORS, ONE PER ARGUMENT. +MCF==777650 ;BITS AND FIELDS ARE: +MCFDEF==200 ;ARG IS DEFAULTED. MCFDEF AND MCFGEN NEVER BOTH SET. +MCFGEN==100 ;ARG SHOULD BE GENSYMMED IF NOT GIVEN IN CALL. +MCFKWD==40 ;ARG IS A KEYWORD ARG, SELECTED BY = RATHER THAN POSITION. +MCFSYN==7 ;FIELD THAT SPECIFIES THE ARGUMENT'S SYNTAX. + MCFNRM==1 ;MCFSYN CONTAINS MCFNRM => NORMAL-SYNTAX ARG + MCFLIN==2 ;MCFSYN CONTAINS MCFLIN => WHOLE LINE ARG + MCFBAL==3 ;MCFSYN CONTAINS MCFBAL => BALANCED ARG + MCFSTR==4 ;MCFSYN CONTAINS MCFSTR => ARG IS A DELIMITED STRING, AS IN "ASCIZ". + MCFKST==5 ;MCFSYN CONTAINS MCFKST => JUST LIKE MCFSTR, BUT DELIMITERS ARE RETAINED. + MCFEVL==6 ;MCFSYN CONTAINS MCFEVL => ARG IS BY VALUE (PREEVALUATED). +;IF MCFKWD IS SET, THE DESCRIPTOR IS FOLLOWED BY THE NAME OF THE ARGUMENT, +;TERMINATED BY A 377. +;IF MCFDEF IS SET, THE DESCRIPTOR IS FOLLOWED BY THE DEFAULT VALUE OF THE ARG, +;TERMINATED BY A 377. +;IF MCFKWD AND MCFDEF ARE BOTH SET, THE ARG NAME COMES FIRST. +;A ZERO BYTE ENDS THE DESCRIPTOR LIST. +;THEN COMES THE BODY OF THE MACRO, FOLLOWED BY A 375. + +ADEFINE: NOVAL ;ERROR IF CONTEXT WANTS A VALUE. + PUSH P,CASSM1 ;RETURN TO ASSEM1 EVENTUALLY + JSP TM,ERMARK ;ERR MSGS SHOULD SAY WE'RE INSIDE A DEFINE. + PUSH P,SYM ;THESE 2 PUSHES ARE FOR NONAME'S SAKE. + PUSH P,SYM + CALL GETSLD + CALL NONAME + TLZ FF,FLUNRD + SUB P,[2,,2] + PUSH P,SYM + PUSH P,ESBK ;SAVE BLOCK TO DEFINE IN FOR ES'S SAKE. +IFN CREFSW,XCT CRFMCD + CALL A.TYM1 + POP P,ESBK + REST SYM + PUSHJ P,ESDEF ;FIND SLOT IN SYMBOL TABLE FOR IT + TLO C,3MACOK ;NEVER SEEN, OK TO MAKE MACRO. + TLON C,3MACOK ;ELSE ERROR IF NUMERIC OR ALREADY USED. + ETSM [ASCIZ/Non-macro made macro/] + MOVEI B,MACCL ;RH(VALUE) = MACCL + HRL B,PRDEF ;LH(VALUE) = CHAR ADR OF MACRO + CLEARM PRDEF ;NO LONGER NEED PRDEF + MOVSI T,PSUDO ;SYMBOL TABLE ENTRY LOOKS LIKE PSEUDO + JRST VSM2 + +IFN RCHASW,[ + ;.TTYMAC NAME + ;BODY + ;TERMIN + + ;NAME DUMMY, CAUSES READIN OF CRUD FROM TTY -> CR (NOT INCLUSIVE) + +A.TTYM: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WE'RE INSIDE A .TTYMAC + CALL A.TYM1 ;READ IN A MACRO-DEFINITION. + MOVEI A,40 ;DON'T LET THE CHAR ENDING THE TERMIN + MOVEM A,LIMBO1 ;MAKE MACCL THINK THERE ARE NO ARGS. + CALL GTYIP1 ;PUSH INTO TTY FOR INPUT + HRLZ B,PRDEF ;PHONY UP A MACRO WHOSE DEFN IS WHAT WE READ. + SETZM PRDEF + MOVEI A,A.TYM8 + JRST A.TYM2 ;CALL THE MACRO: + ;READ THE ARGS, POP OUT OF TTY, EXPAND THE MACRO + ;AND THEN EXIT TO A.TYM8 +] + +A.TYM1: MOVE A,FREEPT + MOVEM A,PRDEF + MOVEI LINK,MCFNRM ;INITIALLY, DUMMIES ARE NORMAL. + MOVEI A,374 + PUSHJ P,PUTREL ;MARK BEGINNING OF MACRO +DEFNI: MOVE T,LIMBO1 + MOVE A,LINK +DEFNC: CAIE T,12 + CAIN T,15 + JRST DEFNA ;NO MORE ARGS (DONE WITH LINE) + CAIE T,LBRACE + CAIN T,LBRKT + JRST DEFNB1 + CAIE T,RBRACE + CAIN T,RBRKT + JRST DEFNB2 + CAIE T,"< ;OPENS TURN ON BALANCEDNESS. + CAIN T,"( + JRST DEFNB1 + CAIE T,"> ;CLOSES TURN OFF BALANCEDNESS. + CAIN T,") + JRST DEFNB2 + CAIN T,"? ;? TURNS BALANCEDNESS ON OR OFF. + JRST DEFBAL + CAIN T,"+ ;+ COMPLEMENTS KEYWORDNESS + XORI LINK,MCFKWD + CAIN T,"\ ;\ COMPLEMENTS GENSYMMEDNESS + XORI LINK,MCFGEN + CAIN T,"- ;- TURNS WHOLELINENESS ON OR OFF. + JRST DEFWHL + CAIN T,"* ;* TURNS ASCIZ-STYLE-NESS ON OR OFF. + JRST DEFASC + CAIN T,"& ;& TURNS KEEP-STRUNGNESS ON OR OFF. + JRST DEFKST + CAIN T,"# ;# TURNS EVALUATEDNESS ON OR OFF. + JRST DEFEVL + CAIN T,": ;: MAKES FOLLOWING ARGS NORMAL + MOVEI LINK,MCFNRM ;IN ALL RESPECTS + CAIN T,"; + JRST DEFNSM ;ALLOW DEFINE LINE TO BE COMMENTED +DEFND: PUSH P,A + CALL GSYL ;READ IN SYMBOL AS SQUOZE IN SYM. + REST A + CAIN T,"/ ;/ MEANS PREVIOUS ARG IS WHOLE-LINE. + XORI LINK,MCFLIN#MCFNRM + JUMPE SYM,DEFNC ;JUMP IF SYMBOL NAME WAS NULL. + CALL PDEF1 ;ELSE PUSH IT ON LIST OF DUMMIES. + MOVE A,LINK + CAIE T,"= + JRST DEFNL + IORI A,MCFDEF ;ONE ARG, WITH DEFAULT VALUE. + ANDCMI A,MCFGEN ;NOT TO BE GENSYMMED. +DEFNL: CALL PUTREL ;OUTPUT A DESCRIPTOR FOR THIS ARG + TRNE LINK,MCFKWD + CALL DEFNM ;PUT OUT ARG NAME IF KWD ARG + CAIE T,"= ;THEN DEFAULT VALUE IF DEFAULTED. + JRST DEFNI + JSP D,RARG ;INIT. FOR READING THE DEFAULT VALUE. + CAIA + CALL RARGCP ;COPY THE ARG INTO MACRO SPACE, + CALL PUT377 ;TERMINATED BY A 377. + JRST DEFNI ;NOW FOR THE NEXT ARG. + +DEFNM: MOVE D,[440700,,STRSTO] +DEFNM1: ILDB A,D + CAMN D,STRPNT + JRST PUT377 + CALL PUTREL + JRST DEFNM1 + +DEFEVL: SKIPA A,[MCFEVL] ;TURN EVALUATEDNESS ON OR OFF. +DEFASC: MOVEI A,MCFSTR ;TURN ASCIINESS ON OR OFF. + JRST DEFN9 +DEFKST: MOVEI A,MCFKST ;TURN KEEP-STRUNGNESS ON OR OFF. + JRST DEFN9 +DEFBAL: SKIPA A,[MCFBAL] ;TURN ON BALANCEDNESS, BUT IF ALREADY ON TURN OFF. +DEFWHL: MOVEI A,MCFLIN ;SIMILAR FOR WHOLELINENESS. +DEFN9: LDB B,[.BP MCFSYN,LINK] + CAMN A,B ;IF CURRENT STATE IS SAME AS IN A, + MOVEI A,MCFNRM ;SWITCH TO NORMAL MODE INSTEAD. + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNB2: SKIPA A,[MCFNRM] ;TURN OFF BALANCEDNESS +DEFNB1: MOVEI A,MCFBAL ;TURN ON BALANCEDNESS + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNSM: PUSHJ P,RCH ;SEMICOLON IN DEFINE LINE + CAIE A,15 + CAIN A,12 +DEFNA: SKIPA A,LINK ;END OF DEFINE LINE, GET COUNT + JRST DEFNSM + MOVEI A,0 + PUSHJ P,PUTREL ;DEPOSIT END-OF-DESCRIPTORS MARK + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD ;CHAR AFTER CR NOT LF + PUSHJ P,WRQOTE ;READ IN BODY + JRST STPWR + +;COME HERE TO EXPAND MACRO; LH OF B POINTS TO STRING. +;SYM HOLDS NAME OF MACRO (USED BY CALL TO AGETFD IN MACEVL). +MACCL: JSP TM,ERMARK ;ERROR MESSAGE DURING ARG SCAN SHOULD SAY WE'RE IN IT. + MOVEI A,RCHSV1 +A.TYM2: PUSH P,I + AOS PRCALP + AOS MDEPTH + PUSH P,RDWRDP + PUSH P,A ;RCHSV1 FOR MACRO, A.TYM8 FOR .TTYMA + MOVEI LINK,0 + HLRZ A,B + PUSHJ P,REDINC + CAIE B,374 + HALT + MOVEM A,@PRCALP + PUSHJ P,REDINC + TLZ I,ILPRN + JUMPE B,MACCLE ;MACRO TAKES NO ARGS => UN-READ NEXT CHARACTER. + MOVE A,LIMBO1 + CAIE A,") ;MACRO NAME TERMINATED WITH A CLOSE-BRACKET OF SOME SORT + CAIN A,"> ;=> UN-READ THE FOLLOWING CHARACTER. + JRST MACCLE + CAIN A,RBRKT + JRST MACCLE + CAIE A,15 ;MACRO NAME ENDED BY A CR OR LF => + CAIN A,12 + JRST MACCLD ;NO ARGS IN THIS CALL; NULLIFY ALL ARGS. + CAIE A,"< + CAIN A,"( + TLO I,ILPRN ;BUT MAYBE THERE IS A (. IF SO, IT'S A PAREN'D CALL, + CAIN A,LBRKT ;AND WON'T END TILL THE MATCHING CLOSE. + TLO I,ILPRN + CAIE A,40 ;IF THE CHAR ENDING THE MACRO NAME ISN'T AN OPENPAREN, + CAIN A,^I ;EOL, OR SPACE, RE-READ IT AS PART OF 1ST MACRO ARG. + JRST MACNX0 + TLNN I,ILPRN + TLO FF,FLUNRD +MACNX0: TDZ LINK,LINK +MACNXD: CALL MACDES ;FETCH NEXT DESCRIPTOR + JRST MACPUS ;NO MORE => THIS IS END OF THE CALL + TRNE LINK,MCFKWD + JRST MACK ;KEYWORD PARAM => SPECIAL SCANNER +;READ IN THE VALUE OF THE NEXT ARG, WHICH IS NORMAL (NOT KEYWORD) +MACNRM: CALL ADDTRN ;PUSH WORD TO HOLD VALUE OF ARG ONTO DSTG, + ;INITIALIZED -> FREEPT, WHERE WE WILL NOW WRITE THE ARG. + SOS C,A ;TELL MACRED WHERE THAT WORD IS. + CALL MACRED ;READ IN THE ARGUMENT VALUE. + JRST MACNXD ;THEN HANDLE ANOTHER ARG + .VALUE + JRST MACCLD ;END OF ARG LIST => NULLIFY REMAINING ARGS. + +MACCLE: TLO FF,FLUNRD ;SAVE CHR FOLLOWING MACRO W/NO ARGUMENTS + ;AND IF THAT CHAR WAS A CLOSE-BRACKET, + SKIPE B,ASMOUT ;CLEAR OUT THE CHANGE IT MADE TO ASMDSP. + CAIN B,4 + CAIA + JSP LINK,SAVAS2 + SETZ LINK, + JRST MACCLD ;NOW GO NULLIFY ANY ARGS THE MACRO WANTED, AND EXIT. + +;READ IN THE NEXT MACRO ARGUMENT ACC TO SYNTAX FLAGS IN LINK. +;C HAS ADDRESS OF WORD ON THE RDWRDP STACK WHICH HOLDS THE POINTER TO THIS ARG +;IN CASE WE WISH TO SET THE ARG TO THE NULL STRING. B AND LINK NOT CLOBBERED. +;RETURNS SKIPPING TWICE IF NO ARG BECAUSE END OF MACRO CALL SEEN. +MACRED: MOVEI D,MACNXR ;RARL3, RARB, RARGBR RETURN TO MACNXR + CALL RCH + CAIE A,^M + CAIN A,^J + JRST MACEND ;MAYBE WE HAVE REACHED THE END OF THE MACRO CALL. + LDB B,[.BP MCFSYN,LINK] + CAIN B,MCFLIN + JRST RARL3 ;ELSE, IF WHOLELINE ARG, NOTHING ELSE TO CHECK, + ;SO INIT FOR READING IT IN. + CAIN A,", + JRST MACNUL ;NON-WHOLELINE ARG IS NULL IF NEXT CHAR IS COMMA + CAIN A,"; ;SEMICOLON ENDS ARG LIST UNLESS INSIDE WHOLELINE ARG + JRST MACEND + CAIN B,MCFBAL + JRST RARB ;FOR BALANCED ARG, NOTHING ELSE SPECIAL, SO INIT. + CAIE B,MCFSTR ;FOR BOTH FLAVORS OF STRUNGNESS, + CAIN B,MCFKST ;GO GOBBLE AN ASCIZ-STYLE ARGUMENT. + JRST MACSTR + CAIN B,MCFEVL ;FOR EVALUATED ARG, READ FIELD AND EXPRESS AS NUMERAL. + TLOA FF,FLUNRD ;AND THE CHAR WE JUST READ WAS THE 1ST CHAR OF THE FIELD. + CAIN A,"\ ;NORMAL ARG STARTING WITH "\" TREATED THE SAME WAY, BUT FIELD + JRST MACEVL ;STARTS WITH NEXT CHAR. + CAIN A,LBRKT + JRST RARGBR ;FOR ORDINARY ARG, OPEN-BRACKET MAKES IT SPECIAL +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + MOVEI T,RARGN ;OTHERWISE IT'S A NORMAL ARG + TLOA FF,FLUNRD ;AND THE CHAR WE RCH'ED IS THE 1ST CHAR OF IT +MACNXR: JRST MACEN1 ;NON-SKIP RETURN FROM RARB, RARL3 OR RARGBR => ARG NULL + CALL RARGCP ;ARG NON-NULL => COPY IT INTO STRING SPACE + CAIE A,"; +CSTPWR: JRST STPWR ;AND TERMINATE IT +MACSC: MOVE A,(C) ;EXCEPT THAT SEMICOLONS INVALIDATE ALL THE SPACES + CAME A,FREEPT ;AND TABS THAT PRECEDE THEM. + JRST STPWR ;IF, AS A RESULT OF THAT, THE ARG IS NULL, END THE ARGLIST. +;COME HERE WHEN THE END OF THE MACRO'S WHOLE ARGLIST IS SEEN. +MACEND: TLO FF,FLUNRD +MACEN1: AOS (P) ;2-SKIP RETURN FROM MACRED INDICATES END OF ARGLIST + AOS (P) ;END OF ARGLIST => THIS ARG IS NULL. +;COME HERE TO NULLIFY CURRENT ARG (WHERE C POINTS) +MACNUL: TRZE LINK,MCFDEF + JRST MACDEF ;MAYBE DEFAULT IT + TRNE LINK,MCFGEN + JRST MACGEN ;MAYBE GENSYM IT + SETZM (C) ;ELSE SET TO NULL STRING. + RET + +MACST1: CALL RCH + CAIN A,", + JRST MACNUL +MACSTR: CAIE A,40 ;HERE FOR ARG DELIMITED LIKE TEXT STRINGS: /TEXT/. + CAIN A,^I ;SKIP ALL SPACES AND TABS BEFORE THE ARG. + JRST MACST1 + JSP D,RARB ;FIND END OF LINE, COMMENT, OR CLOSEBRACKET => + JRST MACEND ;NULLIFY ARG AND END MACRO CALL. + MOVEI T,(A) ;ELSE SAVE THIS CHAR; IT'S THE DELIMITER. + TLZ FF,FLUNRD ;DON'T RE-READ DELIMITER, + CAIN B,MCFKST ;BUT IF ARG IS KEEP-STRUNG, DROP THRU TO STORE IT. +MACST2: CALL PUTREL + CALL RCH ;READ ANOTHER CHARACTER. IF IT ISN'T THE DELIMITER, + CAIE A,(T) + JRST MACST2 ;STORE IT AND READ ANOTHER. + CAIN B,MCFKST ;HIT DELIMITER, DONE. BUT IF ARG IS KEEP-STRUNG, + CALL PUTREL ;KEEP DELIMITER BY STORING IT TOO. + CALL STPWR +MACST3: CALL RCH ;PASS BY SPACES AFTER THE CLOSING DELIMITER + CAIE A,40 + CAIN A,^I + JRST MACST3 + CAIE A,", ;COMMA HERE ENDS THE ARG BUT NOT THE MACRO CALL. + JSP D,RARB ;ELSE CHECK FOR OTHER TERMINATORS. + RET ;WE FOUND AN ACCEPTABLE ARG TERMINATOR. + ETR [ASCIZ /Garbage in ASCIZ-style macro arg/] + JRST RARFLS ;IF THERE'S ANYTHING ELSE, COMPLAIN AND SKIP IT. + +;COME HERE TO GIVE AN ARG ITS DEFAULT VALUE. +;MCFDEF WAS CLEARED SO MACDES WILL KNOW THE DEFAULT VALUE HAS +;ALREADY BEEN PASSED OVER AND WON'T TRY TO SKIP OVER IT. +;IF MCFKWD IS SET, WE MUST SKIP OVER THE KWD ARG'S NAME FIRST. +MACDEF: MOVE A,@PRCALP ;COPY THE DEFAULT VALUE FROM THE MACRO BODY + TRZN LINK,MCFKWD + JRST MACDF1 +MACDF0: CALL REDINC + CAIE B,377 + JRST MACDF0 +MACDF1: CALL REDINC ;AS THE ARGUMENT STRING. + CAIN B,377 + JRST MACDF2 ;END OF THE DEFAULT VALUE. + EXCH A,B + CALL PUTREL + EXCH A,B + JRST MACDF1 + +MACDF2: MOVEM A,@PRCALP + JRST STPWR + +;COME HERE IF GENSYMMABLE ARG IS SPEC'D AS NULL. +MACGEN: MOVEI A,5 + MOVEM A,SCKSUM + MOVEI A,"G + PUSHJ P,PUTREL + PUSH P,CSTPWR + AOS A,GENSM + IDIVI A,10 + HRLM B,(P) + SOSLE SCKSUM + PUSHJ P,.-3 + JRST MACEV2 + +;PROCESS ARG THAT STARTS WITH \, OR #-TYPE ARG. +MACEVL: CALL RCH ;FIRST, CHECK FOR IMMEDIATE END OF MACRO CALL. + JSP D,RARB + JRST MACEN1 + PUSH P,C + PUSH P,LINK ;SAVE LINK, NEED FLAGS + PUSHJ P,AGETFD ;GET THE FIELD + SKIPE B + ETR [ASCIZ /Relocatable \'d macro arg/] + POP P,LINK + REST C ;IF AGETFD EXPANDED A MACRO, FREEPT HAS CHANGED, SO + MOVE CH1,FREEPT ;PUT NEW VALUE INTO THE POINTER TO THIS DUMMY. + MOVEM CH1,(C) + MOVE CH1,A ;SAVE VALUE OF FIELD FROM CLOBBERAGE + PUSH P,CSTPWR +MACEV1: LSHC CH1,-35. ;NOW "TYPE OUT" VALUE OF FIELD IN CURRENT RADIX + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,MACEV1 +MACEV2: HLRZ A,(P) + ADDI A,60 + JRST PUTREL ;OUTPUT TO MACTAB STRING BEING DEFINED + +;HANDLE KEYWORD PARAMETERS. COME HERE WHEN A DESCRIPTOR IS SEEN +;THAT SPECIFIES A KEYWORD PARAMETER. +MACK: PUSH P,RDWRDP + PUSH P,@PRCALP + PUSH P,LINK +;FIRST, PUSH A "NOT SET" MARKER FOR EACH OF THE KEYWORD PARAMS IN THIS RUN OF SUCH. +MACK2: SETO A, + CALL ADDTR2 + CALL MACDES ;NOTE THAT THERE IS ONLY ONE PARAM PER DESCRIPTOR + JRST MACK1 ;FOR KEYWORD PARAMS, SO NO NEED TO COUNT DOWN. + TRNE LINK,MCFKWD + JRST MACK2 +MACK1: REST LINK + REST @PRCALP ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM. +MACKLP: CALL GPASST ;NOW SEE IF THERE'S AN ARGUMENT TO BE FOUND + CAIE A,^M ;IF SO, IT SHOULD START WITH A KEYWORD. + CAIN A,^J + JRST MACKND ;CR OR LF => NO KEYWORD, AND END SCAN. + CAIN A,"; + JRST MACKND + CAIN A,", + JRST MACKN1 ;NULL ARG => NO KEYWORD, BUT DON'T END SCAN. + CAIE A,") + CAIN A,"> + JRST MACKND ;DETECT END OF PARENTHESIZED CALLS, ETC. + CAIE A,RBRKT + CAIN A,RBRACE + JRST MACKND + TLO FF,FLUNRD + CALL GSYL ;THERE SHOULD BE ANOTHER ARG, SO TRY READING KEYWORD NAME + CALL PASSPS + MOVE C,(P) ;NOW SCAN THROUGH THIS RUN OF KEYWORD PARAMS FOR THE + PUSH P,@PRCALP ;ONE WHOSE NAME MATCHES WHAT GSYL READ. + PUSH P,LINK + CAIE A,"= + JRST MACKL5 ;NOT FOLLOWED BY "="?? + DPB A,STRPNT +MACKL4: MOVE D,[440700,,STRSTO] + MOVE A,@PRCALP +MACKL1: CALL REDINC + ILDB AA,D + CAIN B,377 ;IF REACHED END OF KEYWORD'S NAME, AND EQUAL SO FAR + JRST MACKL2 ;SEE IF ARG'S NAME ALSO OVER. + CAMN B,AA + JRST MACKL1 ;ELSE KEEP COMPARING IF NAMES STILL SAME SO FAR. +MACKL6: MOVEM A,@PRCALP + CALL MACDES ;THIS KEYWORD DOESN'T MATCH SO FIND THE NEXT + JRST MACKL3 ;THERE ARE NO MORE; LOSE - ARG WITH BAD KEYWORD. + TRNN LINK,MCFKWD + JRST MACKL3 + AOJA C,MACKL4 + +MACKL5: ETR [ASCIZ /Bad format keyword argument/] + TLOA FF,FLUNRD ;INCLUDE THE BAD NON-"=" AS PART OF WHAT WE DISCARD +MACKL3: ETR [ASCIZ /Arg with undefined keyword/] + MOVEI T,RARGN + CALL RARFLS ;SKIP AN ORDINARY-SYNTAX MACRO ARG TO TRY TO RECOVER. + JRST MACK1 + +;COME HERE AFTER FINDING THE PARAM THAT MATCHES THIS ARG. +;C POINTS TO THE WORD IN DSTG FOR THAT ARG (DSTG IS WHAT ADDTRN PUSHES IN) +MACKL2: TRZ LINK,MCFKWD ;(IN CASE WE GO TO MACKL6, SINCE KWD NAME SKIPPED ALREADY) + CAIE AA,"= + JRST MACKL6 ;KWD NAME OVER BUT SPEC'D NAME NOT => MISMATCH + MOVEMM (C),FREEPT + CALL MACRED ;READ IN THE VALUE OF THE ARG, THUS SETTING THIS PARAM. + JRST MACK1 ;THERE ARE MORE ARGS => HANDLE THEM + .VALUE + REST LINK + REST @PRCALP +MACKND: TLO FF,FLUNRD ;MACRO CALL TERMINATOR SEEN. +;NULL ARG SEEN; ENDS THIS RUN OF KEYWORD ARGS BUT NOT THE CALL. +MACKN1: REST C ;GET PTR TO 1ST KWD ARG'S VALUE-WORD +MACKN2: MOVE A,(C) + AOJN A,MACKN4 ;IF THIS ARG WASN'T SPECIFIED, + MOVEMM (C),FREEPT + CALL MACNUL ;NULLIFY IT (MAYBE DEFAULT OR GENSYM) +MACKN4: CALL MACDES ;NOW SKIP OVER THE DESCRIPTORS OF THIS RUN OF KEYWORD PARAMS + JRST MACPUS ;EXHAUSTED ALL THE DESCR'S => END OF MACRO CALL. + TRNE LINK,MCFKWD ;SAME IF REACH A NON-KWD ARG. + AOJA C,MACKN2 + TLNN FF,FLUNRD ;REACHED A NON-KEYWORD PARAM: IF TERMINATOR WAS A NULL ARG, + JRST MACNRM ;GO ON TO READ THE VALUE OF THE NON-KEYWORD PARAM. + JRST MACCLS ;ELSE CALL WAS REALLY ENDED, SO NULLIFY REMAINING ARGS. + +;COME HERE TO FIND THE NEXT DESCRIPTOR. +;SKIPS OVER THE NAME AND DEFAULT VALUE OF THE PREVIOUS DESCRIPTOR, IF ANY. +;THE CONTENTS OF LINKK SAY WHETHER THEY EXIST TO BE SKIPPED OVER. +MACDES: MOVE A,@PRCALP + CALL REDINC ;READ NEXT CHAR OF MACRO + MOVEM A,@PRCALP + TRNE LINK,MCFKWD\MCFDEF + JRST [ CAIE B,377 ;IF THERE'S NAME OR DEFAULT TO SKIP, GO PAST TERMINATOR + JRST MACDES + TRZN LINK,MCFKWD ;AND SAY WE FOUND ONE + TRZ LINK,MCFDEF ;NOTE THERE MAY BE ANOTHER, IN WHICH CASE WE WILL + JRST MACDES] ;SKIP TILL ANOTHER 377 + JUMPE B,CPOPJ ;THIS DESC IS TERMINATOR => RETURN NO SKIP. + MOVEI LINK,(B) ;ELSE PUT FLAGS IN LINK. + JRST POPJ1 + +;COME HERE WHEN A MACRO CALL TERMINATOR IS ENCOUNTERED, TO NULLIFY ALL +;THE REMAINING PARAMS THAT THE MACRO WANTS, THEN ENTER THE MACRO. +;ENTER AT MACCLS IF HAVE JUST READ A DESCRIPTOR AND NOT NULLIFIED THE ARG, +;OR AT MACCLD IF HAVE JUST PROCESSED AN ARG, TO READ THE NEXT DESCRIPTOR. +MACCLS: TRNE LINK,MCFDEF\MCFGEN + JRST MACCL2 + SETZ A, ;NULLIFY NON-GENSYMMED, NON-DEFAULTED ARGS QUICKLY + CALL ADDTR2 +MACCLD: CALL MACDES ;THEN READ THE NEXT DESCRIPTOR. + JRST MACPUS ;IF NO MORE ARGS, ENTER THE MACRO. + JRST MACCLS + +MACCL2: CALL ADDTRN ;FOR GENSYMMED OR DEFAULTED ARG, PUSH PTR TO FREE STG + SOS C,A + CALL MACNUL ;THEN WRITE THE DESIRED VALUE THERE + JRST MACCLD ;THEN HANDLE NEXT DESCRIPTOR. + +;COME TO MACPUS WHEN ALL THE PARAMS HAVE HAD VALUES PUT IN DSTG (USING ADDTRN) +;TO ENTER THE MACRO. +MACPUS: TLZE I,ILPRN ;SPECIAL PARENTHESIZED CALL? + CALL MACPRN ;YES, SKIP PAST THE CLOSING PAREN. + MOVE B,(P) ;IS THIS A .TTYMAC? + CAIN B,A.TYM8 + CALL A.INEO ;YES, POP OUT OF TTY AFTER READING ARGS. + JFCL + REST B ;RCHSV1 OR A.TYM8 + PUSHJ P,PUSHEM + MOVE A,@PRCALP + PUSHJ P,ACPTRS ;SET UP CPTR + POP P,A + PUSHJ P,DMYTRN + SOS PRCALP + REST I +MACCR: AOS (P) ;COMMON RETURN FROM PSEUDOS TO RETURN FROM GETVAL WITHOUT VALUE +CMACCR: POPJ P,MACCR + +MACPRN: MOVEI TT,1 ;START PAREN-DEPTH AT 1 + JSP D,RARBC ;AND READ CHARS, UPDATING THE DEPTH, UNTIL + HALT + JUMPN TT,.-2 ;THE DEPTH GETS TO BE 0. + RET + +A.GOMC: ILDB B,A ;.GO ROUTINE TO SKIP PAST DESCRIPTORS + JUMPN B,A.GOMC ;IN HEADER OF MACRO DEFINITION. + JRST A.GORT + +RCHSV1: SOS MDEPTH ;END OF MACRO EXPANSION, DECREMENT DEPTH IN MACRO EXPANSIONS +A.TYM8: PUSH P,A ;ENTRY FROM .TTYMAC END OF EXPANSION + MOVE B,TOPP +RCHSV3: CAMG B,BBASE + JRST RCHSV2 + HLRZ A,-1(B) + ADD A,-1(B) + MOVEI A,1(A) + CAME A,FREEPT + JRST RCHSV2 + HRRZ A,-1(B) ;GET NEW FREEPT + SOJA B,RCHSV3 + +RCHSV2: POP P,A + ;RETURN ROUTINE FOR END OF DUMMY +RCHSAV: MOVE B,BBASE + MOVEM B,TOPP + PUSHJ P,POPEM + HLRM B,BBASE +REPT6: TRZE FF,FRMRGO + POPJ P, ;RETURN TO .GO + JRST RCHTRB + +;IRP, IRPS, IRPC, IRPW, IRPNC ALL CALL HERE. +;ALL USE 2 FRAMES ON THE MACRO PDL: +; ,, +; ,, +; \<# GROUPS>,, +; ,,AIRR +;THE 3RD WORD HAS IN BITS 4.1-4.3 THE IRP TYPE CODE +; (NIRPO, NIRPC, ETC) +;AND IN THE REST OF THE LH, THE NUMBER OF GROUPS +; (TRIPLES OF TWO DUMMIES AND A LIST) + +.SEE NIRPO ;FOR DEFINITIONS OF IRP TYPE CODES. + +AIRP: JSP TM,ERMARK ;ERROR MESSAGES SHOULD SAY WE'RE INSIDE IT. + PUSH P,I + PUSH P,RDWRDP + HLRZ LINK,B ;GET IRP TYPE CODE TO INDEX BY. + CAIE LINK,NIRPN + JRST AIRP0 + CALL AGETFD ;IRPNC, READ THE 3 NUMERIC ARGS. + PUSH P,A + CALL AGETFD + PUSH P,A + CALL AGETFD + MOVEM A,AIRPN2 ;THE LAST ARG, + REST AIRPN1 ;THE MIDDLE, + REST AIRPN0 ;THE FIRST. + MOVEI LINK,NIRPN +AIRP0: SETZM IRPCR ;NO GROUPS SEEN YET. + +;FALLS THROUGH. + +;FALLS THROUGH. + +;TRY TO READ IN ANOTHER GROUP. +AIRP1: CALL PDEF ;READ IN DUMMY NAME, PUSH ON DMYTOP. + CAIE T,", ;TERMINATOR WASN'T COMMA AND NAME WAS NULL + JUMPE SYM,AIRP2 ;=> NO MORE GROUPS. + CALL PDEF ;NONNULL GROUP, READ & PUSH 2ND NAME. + CAIN T,"[ ;] TRY TO DETECT "IRP X,[", ETC. ] + CALL [ETR [ASCIZ/Comma missing in IRP/] + TLO FF,FLUNRD ;GENERATE A COMMA. + RET] + CALL ADDTRN ;PUSH CHAR ADDR OF 1ST DUMMY, + CAIE LINK,NIRPS + CAIN LINK,NIRPC ;LEAVE SPACE FOR IRPC'S 1ST ARG, IRPS'S 2ND. + CALL PUT377 + MOVE A,RDWRDP + CAIN LINK,NIRPS + AOS -1(A) ;IRPS - 1ST ARG GOES AFTER NEXT 377. + CALL ADDTRN ;PUSH CHAR ADDR OF 2ND DUMMY. + CALL PUT377 + MOVE A,RDWRDP + XCT AIRP1T-1(LINK) ;MAYBE INCREMENT THAT ADDR. + AOS IRPCR ;ONE MORE GROUP SEEN. + JSP D,RARG ;INITIALIZE READING LIST. + JRST AIRP3 ;NO LIST. + JRST @.(LINK) + OFFSET 1-. +NIRPO:: AIRPO ;IRP +NIRPC:: AIRPC ;IRPC +NIRPS:: AIRPS ;IRPS +NIRPW:: AIRPW ;IRPW +NIRPN:: AIRPN ;IRPNC + OFFSET 0 + +AIRP1T: AOS -1(A) + AOS -1(A) ;INCR. THE 2ND DUMMY ADDR FOR IRP, IRPC. + SOS -1(A) + JFCL ;DECR. FOR IRPS, NOTHING FOR IRPW. + AOS -1(A) ;INCR. FOR IRPNC. + +;READ LIST FOR IRPC OR IRP AND STUFF INTO STRING. +AIRPC: +AIRPO: CALL RARGCP ;COPY UP TO END OF ARG INTO MACRO SPACE. + JRST AIRP3 + +AIRPW3: CALL PUT377 ;END A LINE, + CAIGE C, + CALL PUT377 ;IF NO ; YET, MAKE NULL 2ND ARG. +;COME HERE FOR IRPW, LOOP BACK FOR NEXT LINE. +AIRPW: SETO C, ;NO ; SEEN YET IN LINE. +AIRPW1: JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST, GO WRITE 375. + CAIE A,^M + CAIN A,^J + JRST AIRPW1 ;IGNORE NULL LINES. +AIRPW4: CAIN A,"; + AOJE C,AIRPW2 ;ON 1ST SEMI, SWITCH TO 2ND ARG. + CAIE A,^J + CAIN A,^M + JRST AIRPW3 ;END OF LINE => END BOTH ARGS, START OVER. +AIRPW5: CALL PUTREL + JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST. + JRST AIRPW4 + +AIRPW2: MOVEI A,377 + JRST AIRPW5 + +AIRPS: SETO C, ;NO SQUOZE CHAR SEEN YET. +AIRPS2: JSP D,RARGCH(T) + JRST AIRP3 + HLRZ CH1,GDTAB(A) + CAIN CH1,(RET) + CAIN A,"! + AOJA C,AIRPS0 ;A SQUOZE CHAR OR !. + JUMPL C,AIRPS2 ;NON SQUOZE FOLLOWING ANOTHER, FLUSH. + DPB A,AIRPSP ;NONSQUOZE ENDING NONNULL SYL, PUT BEFORE SYL. + SETZM AIRPSP + CALL PUT377 ;FOLLOW SYL WITH 377. + JRST AIRPS + +AIRPS0: JUMPN C,AIRPS3 ;NOT 1ST CHAR IN SYL? + PUSH P,A + CALL PUT377 ;1ST, LEAVE A SPACE FOR THE SYL'S TERMINATOR. + MOVE A,FREPTB + MOVEM A,AIRPSP ;REMEMBER WHERE THE SPACE IS. + REST A +AIRPS3: CALL PUTREL + JRST AIRPS2 + +AIRPN: SKIPG C,AIRPN0 ;ANY CHARS TO IGNORE? + JRST AIRPN4 + JSP D,RARGCH(T) + JRST AIRP3 + SOJG C,.-2 +AIRPN4: SKIPN C,AIRPN2 ;GET MAX # GRPS OF CHARS. + JRST AIRPN7 ;0 => IGNORE THE REST. +AIRPN5: MOVE B,AIRPN1 ;DO NEXT GRP, GET # CHARS/GRP. +AIRPN6: JSP D,RARGCH(T) + JRST AIRP3 + CALL PUTREL ;STORE THE NEXT CHAR. + SOJG B,RARGCH(T) ;COUNT CHARS IN GRP. + MOVEI A,376 + CALL PUTREL ;FOLLOW GRP BY 376. + SOJN C,AIRPN5 ;MAYBE CAN DO MORE GRPS. +AIRPN7: CALL RARFLS ;DID AS MANY GRPS AS CAN DO, + ;IGNORE REMAINDER OF LIST. + +;COME HERE WHEN EXHAUST THE LIST. +AIRP3: CALL STPWR + JRST AIRP1 ;READ ANOTHER GROUP. + +;ALL GROUPS READ IN; NOW READ IN BODY. +AIRP2: CAIE T,"; ;IF A SEMICOLON ENDED THE ARGS, SKIP THE COMMENT. + JRST AIRP4 +AIRP5: CALL RCH + CAIE A,^M + JRST AIRP5 +AIRP4: PUSH P,LINK + MOVE A,FREEPT ;SAVE CHAR ADDR START OF BODY + MOVEM A,PRIRP ;WHERE GC WILL RELOCATE IT. + PUSHJ P,RCH ;IF NEXT CHAR LF, THEN FLUSH IT + CAIE A,12 + TLO FF,FLUNRD + PUSHJ P,WRQOTE ;READ BODY OF IRP + PUSHJ P,STPWR ;WRITE STOP + PUSHJ P,PUSHEM ;SAVE WORLD + REST LINK + POP P,A ;RESTORE RDWRDP FROM LONG AGO + PUSH P,TOPP ;NOW SAVE TOPP + PUSHJ P,DMYTRN ;ACTIVATE DUMMYS + MOVE B,MACP ;NOW GET MACRO PDL POINTER + MOVE A,CIRPCT ;GET .IRPCNT + HRRM A,(B) ;CLOBBER "RETURN" ON PDL TO OLD IRPCNT + SETOM CIRPCT ;INITIALIZE IRPCNT + MOVS A,IRPCR ;GET # GROUPS + HRR A,PRIRP ;CHAR ADR OF BEGINNING OF BODY + SETZM PRIRP + DPB LINK,[410300,,A] ;PUT IN TYPE OF IRP. + PUSH B,A ;PUSH ,,CHAR ADR BEGINNING + POP P,A ;NOW GET OLD TOPP + HRLS A ;MOVE TO LEFT HALF + HRRI A,AIRR ;RETURN TO AIRR ON END OF BODY + PUSH B,A ;PUSH OLD TOPP,,AIRP4 + MOVEM B,MACP ;STORE BACK UPDATED MACRO PDL POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP RIGHT AWAY TO CAUSE CYCLING + REST I + JRST MACCR + +;RECYCLE THROUGH IRP + + ;AC ALLOCATIONS: +AIRR: PUSH P,A ;A GETS BP ILDBING THRU ARG LIST. + PUSH P,C ;C # GROUPS LEFT + PUSH P,T ;T ADR OF PAIR OF CHAR ADR'S OF DUMMYS + PUSH P,TT ;TT TYPE OF IRP (NIRPO, NIRPC, ETC) + AOS CIRPCT ;INCREMENT .IRPCNT + HRRZ A,(B) ;GET CHARACTER ADR BEG BODY FROM PDL + PUSHJ P,ACPTRS ;SET UP CPTR + SETOM AIRPT + TRNE FF,FRMRGO + JRST AIRR9 ;RETURN TO .GO + HLRZ T,1(B) ;DUMMY TAB ADR + LDB C,[220600,,(B)] ;# GROUPS + JUMPE C,AIRR9 ;JUMP IF NO GROUPS + LDB TT,[410300,,(B)] ;GET TYPE OF IRP (NIRPO, ETC) +AIRR6: JRST @.+1(TT) +AIRRER ? AIRRO ? AIRRC ? AIRRS ? AIRRW ? AIRRN ? AIRRER ? AIRRER +AIRRER: .VALUE + +;MOVE 1 ARG THRU 1 GROUP OF IRP. +AIRRO: HRRZ A,1(T) ;THE 1ST ARG WILL START THIS TIME + HRRZM A,(T) ;WHERE THE "REST OF STRING" STARTED LAST TIME. + BCOMP A,-1 ;GET BP THAT'LL ILDB THAT CHAR. + SETO CH1, ;COUNT [-] DEPTH. +AIRRO1: ILDB B,A + CAIN B,375 + JRST AIRRO4 ;END OF STRING IS END OF ARG. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIN B,"[ + AOJE CH1,AIRRO3 ;FLUSH OUTERMOST [-] PAIRS. + CAIN B,"] + SOJL CH1,AIRRO3 + JUMPGE CH1,AIRRO1 ;DON'T LOOK FOR , WITHIN [-]. + CAIE B,^J + CAIN B,", + JRST AIRRO2 ;END OF ARG. + CAIE B,^M ;^M IS IGNORED (FLUSHED.) + JRST AIRRO1 +AIRRO3: MOVEI B,376 ;FLUSH A CHAR BY REPLACING WITH 376 + DPB B,A + JRST AIRRO1 + +AIRRC4: SUB P,[1,,1] +AIRRC3: SETZM (T) ;NULLIFY BOTH ARGS PERMANENTLY. +AIRRO4: SETZM 1(T) ;NULLIFY 2ND ARG PERMANENTLY + JRST AIRR8 ;DONE WITH THIS GROUP. + +AIRRO2: MOVEI B,377 ;REPLACE CHAR THAT ENDED ARG WITH TERMINATOR. + DPB B,A +AIRRW3: CCOMP1 A,-1 ;GET ADDR OF CHAR AFTER. + HRRZM B,1(T) ;"REST OF STRING" STARTS THERE. + JRST AIRR8 + +AIRRN: MOVE A,1(T) ;NEW 1ST DUMMY STARTS AT OLD "REST OF STRING". + MOVEM A,(T) + BCOMP A,-1 ;NEW "REST OF STRING" STARTS AFTER 376, + JRST AIRRW2 ;WHICH WILL BECOME A 377. + +AIRRW: MOVE A,1(T) ;GET CHAR ADDR START OF 2ND HALF OF PREV LINE. + CALL AIRRM ;SET 1ST DUMMY -> AFTER NEXT 376 OR 377 . +AIRRW2: ILDB B,A ;MOVE UP TO NEXT 377 OR END OF STRING. + CAIN B,375 ;END OF STRING ENDS 1ST DUMMY'S ARG => + JRST AIRRO4 ;NULLIFY THE 2ND DUMMY. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIGE B,376 + JRST AIRRW2 + JRST AIRRO2 ;SET UP 2ND DUMMY -> NEXT CHAR. + + +;MOVE UP IN 1 GROUP OF IRPS. +AIRRS: MOVE A,(T) ;MOVE FROM 1ST DUMMY, + CALL AIRRM ;PUT 1ST DUMMY AFTER NEXT 377, + AOS (T) ;MOVE IT PAST THE SYL'S TERMINATING CHAR, + ILDB CH1,A ;GET THAT CHAR, + MOVE A,1(T) + JRST AIRRS2 ;STORE AS 2ND DUMMY. + +AIRRM: BCOMP A,-1 ;A HAS CHAR ADDR; WILL ILDB THAT CHAR. +AIRRM1: ILDB B,A + CAIN B,375 ;END OF STRING => NULLIFY BOTH ARGS + JRST AIRRC4 ;AND FINISHED WITH GROUP. + CAIE B,377 + JRST AIRRM1 + MOVE CH1,A + CCOMP1 CH1,-1 ;GET CHAR ADDR OF CHAR AFTER 377 + MOVEM CH2,(T) ;PUT 1ST DUMMY THERE. + RET ;NOTE A NOT CLOBBERED, CAN GO ON ILDB'ING. + +;MOVE UP IN ONE GROUP OF IRPC. +AIRRC: AOS A,1(T) ;DELETE 1ST CHAR FROM "REST OF STRING". + BCOMP A,-1 ;GET BP -> THAT CHAR. + LDB CH1,A ;GET THE CHAR. + MOVE A,(T) ;GET CHAR ADDR OF PLACE TO PUT IT. +AIRRS2: CAIN CH1,375 ;REACHED END OF STRING => + JRST AIRRC3 ;NULLIFY BOTH ARGS. + BCOMP A,0 + DPB CH1,A ;STORE IT IN THE 1-CHAR ARG. +AIRR7: SETZM AIRPT ;THIS GROUP NOT EXHAUSTED YET. +AIRR8: ADDI T,2 + SOJG C,AIRR6 ;MORE GROUPS => DO THE NEXT. +AIRR9: POP P,TT ;RETURN FROM AAIRPC + POP P,T + SKIPL AIRPT + JRST REPT3 + MOVN A,[2,,2] ;ARGS EXHAUSTED, RETURN + ADDB A,MACP + HRRZ A,(A) + MOVEM A,CIRPCT + POP P,C + POP P,A + JRST RCHSAV + +;IRP ARG-STRING READING COROUTINES: CALL WITH JSP D, +;INITIALIZE FOR READIN OF ARG BUT DON'T GET A CHAR. +;SKIPS IF NONNULL ARG AVAILABLE. +;COROUTINES REMEMBER INFO IN T AND TT BETWEEN CALLS. +;THE CALLER SHOULDN'T CLOBBER THEM. +RARG: CALL RCH ;DECIDE WHAT TYPE OF ARG FOLLOWS, IF ANY. + CAIN A,LBRKT ;RARG ALLOWS [-] AND MAYBE {-} ARGS AS WELL AS SIMPLE ONES. + JRST RARGBR +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + TLO FF,FLUNRD + JSP T,RARGXT ;CAUSE FAILURE RETURN ON SEMI, CR, LF. +RARGN: CALL RCH ;RARGCH RTN FOR NORMAL ARG. +RARGX1: CAIN A,", + JRST (D) ;COMMA ENDS ARG. +RARGXT: CAIN A,"; + JRST RARGSM ;SEMI ENDS SCAN. +RARGX2: CAIE A,^M + CAIN A,^J ;CR, LF END SCAN. +RARGSM: TLOA FF,FLUNRD + JRST 1(D) + JRST (D) + +RARGBR: SETZ TT, ;TT USED AS BRACKET COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR [-] TYPE ARGS. +RARGBC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRKT + AOJA TT,1(D) + CAIN A,RBRKT + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACKET. + +RARGRR: SETZ TT, ;TT USED AS BRACE COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR {-} TYPE ARGS. +RARGRC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRACE + AOJA TT,1(D) + CAIN A,RBRACE + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACE. + +;TO GET THE NEXT CHAR OF THE ARG IN A, DO JSP D,RARGCH(T). +;SKIPS UNLESS NO MORE CHARS TO GET. +;NO SKIP AND SET => SCAN SHOULD BE TERMINATED. +;RARG SHOULD NOT BE CALLED AGAIN IN THAT CASE. +RARGCH==0 ;THIS SYMBOL IS FOR CREF'S SAKE. + +;COPY THE ARG BEING READ INTO MACRO SPACE. +;ON RETURN, A WILL HOLD "; IF ARGUMENT WAS ENDED BY ";". +RARGCP: JSP D,RARGCH(T) + JRST RARGC1 + CALL PUTREL + JRST RARGCH(T) + +RARGC1: CAIE A,"; ;IF SEMI ENDED THE ARG, FLUSH THE + RET ;SPACES AND TABS BEFORE IT. +RARGC2: LDB A,FREPTB + CAIN A,^I + JRST RARGC3 + CAIE A,40 + JRST [ MOVEI A,"; ;LAST CHAR OF ARG ISN'T SP OR TAB. + RET] ;MAKE SURE A HAS ";" IF ARG WAS ENDED BY ";". +RARGC3: SOS FREEPT ;IT IS ONE; BACK OVER IT. + MOVE A,FREPTB + DBPM A + MOVEM A,FREPTB + JRST RARGC2 + +;IGNORE THE REST OF THE ARG NOW BEING READ. +RARFLS: JSP D,RARGCH(T) + RET + JRST RARGCH(T) + +;COME HERE TO SET UP TO READ A BALANCED ARG. +;IF THERE'S NO ARG, RETURNS WOTH JRST (D). +;ELSE RETURNS WITH JRST 1(D) SETTING UNRCHF. +RARB: TLO FF,FLUNRD + SETZ TT, ;TT USED AS BRACKET COUNTER. + CAIE A,RBRACE + CAIN A,") ;IF 1ST CHAR IS A CLOSE, + JRST RARB4 ;THERE'S NO ARG. + CAIE A,"> + CAIN A,RBRKT + JRST RARB4 + JSP T,RARGXT ;CHECK FOR CR, LF, SEMI, AND RETURN. +;1-CHAR RTN FOR READING BALANCED ARG. +RARBC: CALL RCH + CAIE A,RBRACE + CAIN A,"> ;FOR CLOSES, MAYBE END ARG. + JRST RARB2 + CAIE A,") + CAIN A,RBRKT + JRST RARB2 + CAIE A,LBRACE + CAIN A,"< ;FOR OPEN BRACKETS, INCR. THE COUNT. + AOJA TT,1(D) ;OPENS CAN'T END THE ARG. + CAIE A,"( + CAIN A,LBRKT + AOJA TT,1(D) + JUMPN TT,1(D) + JRST RARGX1 ;NOT WITHIN BRACKETS, TEST FOR COMMA, ETC. + +RARB2: SOJGE TT,1(D) ;COME HERE FOR CLOSEBRKTS. +RARB4: TLO FF,FLUNRD + JRST (D) + +;COME HERE TO INIT FOR AN ARG FOR REPEAT, ETC. +;THAT IS, EITHER A BRACKETED ARG OR A 1-LINE ARG. +RARL1: CALL RCH +RARL2: +IFN BRCFLG,[ +RARL4: CAIN A,LBRACE + JRST RARGRR ;1ST CHAR A BRACE => BRACED ARG. +] + CAIN A,LBRKT ;1ST CHAR A BRKT => BRKT ARG. + JRST RARGBR + TLO FF,FLUNRD + +;INIT FOR A 1-LINE ARG. +RARL: JSP T,1(D) +;1-CHAR RTN FOR 1-LINE ARGS. +RARLC: CALL RCH + JRST RARGX2 + +IFE BRCFLG,[ +;IF BRACES AREN'T USED BY MOST THINGS, THE NORMAL ROUTINE RARL1 DOESN'T +;CHECK FOR THEM, BUT RALR4 (CALLED BY CONDITIONALS) STILL MUST. +RARL4: CAIN A,LBRACE + JRST RARGRR + JRST RARL2 +] + +;1-LINE ARGS TO MACROS: DON'T TERMINATE THE SPEC, +;AND SKIP OVER THE CR AND LF. +RARL3: TLO FF,FLUNRD + JSP T,1(D) + CALL RCH + CAIN A,^J + JRST (D) ;LF IS THE END - SKIP IT. + CAIE A,^M + JRST 1(D) + CALL RCH ;CR => SKIP FOLLOWING LF, END ARG. + CAIE A,^J + TLO FF,FLUNRD + JRST (D) + +;PUSHJ P,A.GST SEARCH CURRENT MACRO STRING FOR TAG (IN A.GST4) +;SKIP IF FOUND, RETURN ON END OF STRING ANYWAY +;BYTE POINTER (ILDB TO GET FIRST CHARACTER) IN A + +A.GST: MOVEM A,A.GST3 ;SAVE BYTE POINTER +A.GST1: ILDB B,A.GST3 ;GET CHAR + CAIL B,300 + POPJ P, ;END OF STRING => STOP + CAIE B,". + JRST A.GST1 ;WAIT FOR POINT + PUSHJ P,A.GSYL ;FOUND POINT, GET REST OF NAME + JUMPL T,CPOPJ ;RETURN ON END OF STRING + CAME SYM,[SQUOZE 0,TAG] ;TAG? + JRST A.GST1 ;NO, KEEP GOING + PUSHJ P,A.GSYL ;GET THE TAG + JUMPL T,CPOPJ ;RETURN ON END OF STRING (THERE MUST BE BREAK CHAR AFTER TAG BEFORE STOP) + CAME SYM,A.GST4 + JRST A.GST1 ;NOT THE ONE BEING LOOKED FOR + MOVE A,A.GST3 + LDB B,A ;GET DELIMITER + CAIE B,15 ;CR? + JRST POPJ1 + ILDB B,A ;CR, GET NEXT CHAR + CAIE B,12 ;LINE FEED? + MOVE A,A.GST3 ;NO, DON'T FLUSH + JRST POPJ1 + + ;LOOK BACKWARD FOR BEGINNING OF STRING, BYTE POINTER AN A + ;LEAVES POINTER POINTING AT STOP CHAR (NOT BEFORE); ALSO LEAVES STOP CHAR IN B + +AG.SP: MOVE B,(A) ;GET WORD FROM MACTAB + XOR B,[300_28.+300_20.+300_12.+300_4] ;DO XOR TO ANITIALLY SET UP + LDB CH1,[400400,,A] ;PICK UP 4 HIGH ORDER BITS OF POSITION FIELD + JRST A.GSP2-1(CH1) ;DISPATCH ON POSITION FIELD (-1 SINCE BIT SET IN POSITION FIELD) + +AG.SP3: MOVE B,(A) + XOR B,[300_28.+300_20.+300_12.+300_4] + +A.GSP2: TRNN B,300_4 + JSP CH1,AG.SF + TLNN B,3 + JSP CH1,AG.SF + TLNN B,300_2 + JSP CH1,AG.SF + TLNN B,300_10. + JSP CH1,AG.SF + SOJA A,AG.SP3 + +AG.SF: SUBI CH1,A.GSP2-1 ;GET HERE WHEN STOP CHAR FOUND + DPB CH1,[400400,,A] ;CLOBBER POSITION FIELD OF BYTE POINTER AGAIN + ILDB B,A ;INCREMENT TO UNIVERSALLY ACCEPTABLE POINTER, GETTING STOP CHAR IN B AT SAME TIME + POPJ P, ;THAT'S ALL + +A.TAG: PUSHJ P,GSYL + CAIE T,15 + JRST MACCR + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD + JRST MACCR + +A.GO: PUSHJ P,GSYL ;DOESN'T WORK RELIABLY FROM DUMMY + MOVEM SYM,A.GST4 + +A.GO1: TLNN FF,FLMAC + JRST MACCR ;NOT GETTING CHARS FROM MACRO => STOP + MOVE A,CPTR + PUSHJ P,AG.SP ;BACK TO BEGINNING + CAIN B,374 + JRST A.GOMC ;MACRO, SKIP PAST HEADER +A.GORT: PUSHJ P,A.GST + JRST A.GO2 ;END OF STRING, TRY POPPING UP ONE + MOVEM A,CPTR + JRST MACCR + +A.GO2: PUSHJ P,PMACP + JRST A.GO1 + +A.GSYL: MOVNI D,100000 ;GET SYL FOR .GO WHILE LOOKING FOR TAG + MOVEM D,STRCNT ;STRCNT .LT. 0 SIGNAL FOR GSYL TO JRST (F) + MOVEI SYM,0 + JSP F,GSYL1 +A.GSY3: ILDB A,A.GST3 ;GET CHAR + TRZN A,200 ;CHECK FOR SPECIAL + JRST A.GSY2 ;NO, FALL BACK IN + CAIG A,100 ;BIG ENOUGH TO BE SPECIAL? + JRST A.GSY3 ;NO, MUST BE DUMMY, IGNORE + HRROI T,(A) ;SPECIAL => ASSUME STOP: T .LT. 0 SIGNAL TO CALLING ROUTINE + POPJ P, ;RETURN TO CALLING ROUTINE + +;INITIALIZE MACRO STATUS + +MACINI: MOVEI A,3 + MOVEM A,FREEPT ;FORGET ALL STRINGS IN MACTAB + PUSHJ P,FCOMP + MOVE A,MACTAD + HRLI A,41000 ;SET UP CCOMPB THRU CCOMPE + LSH A,2 ;(THEIR VALUES CAN'T BE ASSEMBLED IN BECAUSE + SUBI A,4 ;THEY ARE MUTLTIPLY RELOCATABLE, AND IN DEC + MOVSI AA,CCOMPB-CCOMPE ;VERSION THAT CAN'T BE DONE) +MACIN0: MOVEM A,CCOMPB(AA) + AOJ A, + AOBJN AA,MACIN0 + MOVE A,MACTAD + ADDI A,MACL+1777 + ANDI A,-2000 ;ADDR OF 1ST WD AFTER MACTAB. + CALL MACIN2 ;SET UP PTRS TO END OF MACTAB. + SETZM GCCNT ;CLEAR OUT GC COUNT SO WILL GET MORE CORE FIRST THREE +MACIN1: SETZM MDEPTH ;NOW INITIALIZE MACRO EXPANSION STATUS + SETZM PRSTG ;NOW TO CLEAR OUT BYTE POINTERS + MOVE A,[PRSTG,,PRSTG+1] + BLT A,EPRSTT-1 + MOVEI A,DSTG + MOVEM A,RDWRDP + MOVEI A,DMYAGT + MOVEM A,TOPP + MOVEM A,BBASE + MOVE A,[-MPDLL,,MACPDL] + MOVEM A,MACP + POPJ P, + +;A -> 1ST WD AFTER MACTAB, SET UP ALL POINTERS TO END OF MACTAB. +MACIN2: MOVEM A,MACTND + SUB A,MACTAD + LSH A,2 ;1ST BYTE MACTAB DOESN'T HAVE. + MOVEM A,MACHI + SUBI A,MACRUM*4 + MOVEM A,GCRDHI + MOVE A,STOPPT + HRR A,MACTND + SOS A ;LAST WD IN MACTAB. + MOVEM A,MACHIB ;INITIALIZE BYTE POINTER TO HIGHEST BYTE OK TO FILL + RET + + ;MACRO VARIABLE AREA (MOST THEREOF) + +VBLK +MACP: 0 ;MAC PDL POINTER +BLCODE [MACPDL: BLOCK MPDLL+1] ;MACRO PDL +FREEPT: 0 ;MACRO STG PNTR POINTS TO FREE CHAR +FREPTB: 0 ;FREEPT IN BYTE POINTER FORM +MACTAD: MACTBA ;ADDR OF START OF MACRO TABLE. +MACTND: 0 ;ADDR OF 1ST WD AFTER MACTAB. +MACHI: 0 ;CHAR ADR ONE ABOVE ACTIVE MACTAB +MACHIB: 0 ;POINTS TO LAST BYTE IN MACTAB + +SCONDF: 0 ;STRING CONDITIONAL FLAG, -1 => IDENTICAL, 0 DIFFERENT +GENSM: 0 ;GENERATED SYM COUNT +DEFNPS: 0 ;NONZERO => NAME OF PSEUDO NOW READING ITS ARG. + ;A FATAL ERROR WILL TYPE THE PSEUDO'S NAME. +DEFNPN: 0 ;PAGE # -1 OF THAT PSEUDO. ALSO TYPED BY FATAL ERRORS. +DEFNLN: 0 ;LINE # -1. +DEFNFI: 0 ;SIXBIT FN1 OF FILE CONTAINING PSEUDO THAT DEFNPS REFERS TO. +MDEPTH: 0 ;DEPTH IN MACRO (NOT IRP OR REPEAT) EXPANSIONS +PUTCNT: 0 ;AOS'D BY PUTREL, USED BY CALLING ROUTINE, USUALLY TO COUNT ACTIVE CHARS (DURING DEFINITION) +IRPCR: 0 ;COUNT OF A,B,[LIST] GROUPS IN IRP IRPC IRPS, " " " +AIRPT: 0 ;IRP EXPANSION TEMP, -1 => NO NON-NULL DUMMYS YET, ELSE 0 +AIRPN0: 0 ;1ST NUMERIC ARG TO IRPNC +AIRPN1: 0 ;2ND, +AIRPN2: 0 ;3RD. +A.QOT2: 0 ;DELIMITER FOR .QUOTE +CRPTCT: -1 ;COUNT THROUGH CURRENT REPEAT (FOR .RPCNT) +CIRPCT: -1 ;COUNT THOUGH CURRENT IRP (FOR .IRPCNT) +A.GST3: 0 ;ON .GO, NAME (IN SQUOZE) OF TAG BEING SEARCHED FOR +A.GST4: 0 ;BYTE POINTER FOR ILDB WHILE SEARCHING FOR TAG +PRCALP: PRCAL-1 ;POINTER INTO PRCALP, POINTS TO LAST ACTIVE ENTRY + +PRSTG: ;BEGIN WORDS GARBAGE COLLECTED: FIRST BYTE POINTERS ILDB'D + +CPTR: 0 ;ILDB TO GET NEXT CHAR FROM MACRO OR WHATEVER +IFE WRQTSW-1,WRQTBP: 0 ;POINTS TO LAST CHAR BEFORE CURRENT SYL AT WRQOTE +AIRPSP: 0 ;-> PLACE TO STORE SYL-TERMINATOR, IN IRPS READIN. +GCBPL==.-PRSTG ;END BYTE POINTERS, BEGIN CHARACTER ADDRESSES +PRSCND: 0 ;CHARACTER ADDRESS OF CURRENT LOCATION IN FIRST STRING OF IFSE,IFSN WHILE COMPARING WITH SECOND +PRSCN1: 0 ;CHAR ADR BEG OF FIRST STRING IFSE, IFSN +PRREPT: 0 ;CHAR ADR BEG OF BODY OF REPT +PRIRP: 0 ;CHAR ADR BEG OF IRP BODY +PRDEF: 0 ;CHAR ADR BEG OF MACRO BEING DEFINED +PRCAL: REPEAT 10,0 ;TEMP STORAGE FOR CHAR ADR BEG MACRO BODY, USED TO READ DUMMY SPECS +EPRSTT: ;END CHAR ADR WORDS GARBAGE COLLECTED + + ;BEGIN GARBAGE COLLECTOR VARIABLES + +GCCNT: 0 ;CNT OF GC'S +SYMSTR: 0 ;PNTR TO CHAIN OF MACRO PNTRS IN SYM TABLE (DURING GC), LINKED THROUGH RH'S OF "VALUE" +REDPT: 0 ;CHAR ADR READING FROM WHEN MOVING STRING DOWN +REDPTB: 0 ;REDPT IN BYTE POINTER FORM + ;GC WRITES WITH FREEPT/FREPTB +COFST: 0 ;AMOUNT CHARS MOVED DOWN BY, SUBTRACTED FROM CHAR ADR TO RELOCATE +SVF: 0 ;FLAG, .GE. 0 => NO POINTERS FOUND POINTING TO CURRENT STRING +FREPTS: 0 ;-> BEGINNING OF CURRENT STRING BEING COPIED DOWN +FRPTBS: 0 ;FREPTS IN BYTE POINTER FORM +GCENDF: 0 ;-1 => END OF LAST STRING FOUND, AFTER RELOCATING POINTERS, MSTG2 SHOULD EXIT +GCHI: 0 ;GC HIGH POINTER, CHAR ADR FIRST NOT TO GARBAGE COLLECT +GCRDHI: *4 ;GC DROPS DEAD (MACTAB FULL) IFWRITING INTO THIS CHAR ADR +BLCODE [GCSV: BLOCK 16] ;AC SAVE AREA FOR GC +PBLK + +;GARBAGE COLLECT THE MACRO TABLE + +GCA1: MOVE A,FREEPT ;GC ALL IN MACTAB. +GCA: MOVEM A,GCHI ;ENTRY TO STORE A IN GCHI -> FIRST CHAR NOT TO GARBAGE COLLECT +IFN 17-P+FF,.ERR GC ac saver wants FF=0, P=17! +GC: MOVEM 16,GCSV+15 ; Save all ACs except FF and P. + MOVE 16,[1,,GCSV] + BLT 16,GCSV+14 +IFN TS,[AOS A,GCCNT + CAIGE A,4 + PUSHJ P,GCCORQ ;EXPAND CORE ON FIRST THREE GC'S +] CLEARB T,GCENDF + MOVEI A,3 + MOVEM A,REDPT ;SET UP FOR READING + MOVEM A,FREEPT ;ALSO FOR WRITING + MOVE A,BCOMPU ;ALSO SET UP CORRESPINDING BYTE POINTERS + MOVEM A,FREPTB + MOVEM A,REDPTB + MOVE C,[-GCBPL,,PRSTG] +GCLP1: SKIPN B,(C) ;NOW CONVERT BYTE POINTERS... + JRST GCLP1B ;(INACTIVE) + CCOMP B,-1 ;TO CHARACTER ADDRESSES + MOVEM B,(C) ;STORE BACK CHARACTER ADDRESS +GCLP1B: AOBJN C,GCLP1 ;LOOP FOR ALL SUCH BYTE POINTERS + MOVE A,SYMAOB ;NOW SET UP MACRO LIST; T INITIALLY HAS 0 => END OF LIST DURING COMPUTATION +SYMMG: ;POINTS TO FIRST MACRO SYMTAB ENTRY ON LIST + LDB B,[400400,,ST(A)] ;GET SQUOZE FLAGS THIS SYM + CAIN B,PSUDO_-14. ;PSEUDO? (=> MAYBE MACRO) + JRST SYMMG1 ;YES, MAYBE PUT ON LIST (RETURNS TO SYMMG2) +SYMMG2: ADD A,WPSTE1 + AOBJN A,SYMMG ;LOOP FOR ENTIRE SYMTAB + MOVEM T,SYMSTR ;STORE INITIAL LIST ENTRY FOR MACROS + ;DROPS THROUGH + ;GC DEALS WITH "UNIT STRINGS", EACH STRING ENDS WITH 375 + ;GENERAL PROCEDURE IS TO COPY A STRING DOWN THEN SEARCH FOR POINTERS TO WHERE STRING USED TO BE + ;IF POINTERS FOUND THEY ARE RELOCATED TO POINT TO COPIED DOWN STRING + ;IF POINTERS ARE NOT FOUND THE STRING IS WIPED OUT + ;DROPS THROUGH + +MSTG: MOVE C,REDPT ;SET UP C TO POINT TO BEG OF STRING BEING READ + ;(FOR EVENTUALLY SEARCHING FOR POINTERS TO STRING, NOTE C STAYS AROUND FOR AWHILE) + MOVE TT,FREEPT + CAML TT,GCHI ;IF ALL OF ACTIVE PART OF MACTAB ALREAD GC'D, STOP NOW. + JRST GCEND + MOVEM TT,FREPTS ;-> BEGINNING OF WRITTEN STRING + MOVE TT,FREPTB + MOVEM TT,FRPTBS ;BYTE POINTER -> BEGINNING OF WRITTEN STRING + PUSHJ P,RDTRNS ;COPY CHARACTER + CAIN B,370 + JRST MSTGB ;THAT WAS NO STRING, THAT WAS MY IO-BUFFER! + MOVE TT,B ;SAVE CHARACTER JUST COPIED +MSTG1: CAML LINK,GCHI + JRST GCEND ;JUST READ LAST CHAR IN PART OF MACTAB TO GARBAGE COLLECT => DONE + CAIN B,375 + JRST MSTG2 ;END THIS STRING, NOW SEARCH FOR POINTERS, RETURNS TO MSTG + PUSHJ P,RDTRNS ;STRING NOT EXHAUSTED, COPY NEXT CHAR + JRST MSTG1 + +SYMMG1: HRRZ B,ST+1(A) ;PSEUDO FOUND IN SYMTAB, GET "VALUE" + CAIE B,MACCL ;MACCL? (=> MACRO, CHAR ADR OF BODY IN LH) + JRST SYMMG2 ;NO, JUST FALL BACK INTO LOOP + HRRM T,ST+1(A) ;MACRO, REPLACE MACCL PART OF VALUE WITH POINTER TO NEXT + MOVEI T,ST+1(A) ;UPDATE T (INITIAL LIST ENTRY) TO POINT TO WORD JUST CLOBBERED + PUSH P,A + HLRZ A,ST+1(A) + PUSHJ P,REDINC + CAIE B,374 + HALT + POP P,A + JRST SYMMG2 + + ;COPY CHARACTER DOWN (REDPTB -> FREPTB) + ;LEAVE INCREMENTED REDPT IN LINK, FREEPT IN A, CHAR IN B + +RDTRNS: ILDB B,REDPTB + IDPB B,FREPTB + AOS LINK,REDPT + AOS A,FREEPT + POPJ P, + +MSTGB: ADDI A,3 ;COPY AN IO-BUFFER: + TRZ A,3 + MOVEM A,FREEPT ;WRITE INTO WORD BOUNDARY. + ADDI LINK,3 + TRZ LINK,3 + MOVEM LINK,REDPT ;READ FROM WORD BOUNDARY. + MOVEI B,041000 + HRLM B,REDPTB + HRLM B,FREPTB + MOVE B,FREPTB + MOVE A,REDPTB + ADDI B,1 ;NEW ADDR OF 1ST WD. + HRRZ LINK,1(A) ;GET ADDR OF POINTER TO STRING. + MOVEM LINK,SVF ;REMEMBER WHETHER TO FLUSH STRING. + SKIPE LINK + HRRM B,(LINK) ;RELOCATE THAT POINTER (IF ANY) + HRLI B,1(A) ;SET UP AC FOR BLT. + HLRZ LINK,1(A) ;GET LENGTH OF STRING. + ADDM LINK,REDPTB + LSH LINK,2 + ADDM LINK,FREEPT + ADDM LINK,REDPT + LSH LINK,-2 + ADDB LINK,FREPTB + BLT B,(LINK) + MOVE LINK,REDPT + CAML LINK,GCHI ;IF THIS IO-BUFFER IS LAST THING IN MACRO SPACE, + SETOM GCENDF ;DON'T LOOK FOR ANYTHING FOLLOWING IT. + JRST MSTGB1 ;NOW MAYBE FLUSH THIS STRING, COPY NEXT. + +;GET HERE WHEN MSTG2 FINISHES WITH FLAG SET TO EXIT: UNDO INITIALIZATION AND RETURN + +GCEND1: IFN TS,[ + MOVE A,FREEPT + ADDI A,2000*4 + CAML A,MACHI + PUSHJ P,GCCORQ +] MOVE A,FREEPT + CAML A,GCRDHI + ETF [ASCIZ /Macro space full/] + SKIPN T,SYMSTR + JRST USYMG1 ;EMPTY LIST + MOVEI C,MACCL ;SET UP C FOR HRRM'ING +USYMG: HRRZ TT,(T) ;GET ADR ON LIST + HRRM C,(T) ;CLOBBER RH JUST GOT NEXT POINTER FROM TO MACCL + HLRZ A,(T) + PUSHJ P,REDINC + CAIE B,374 + HALT + SKIPE T,TT ;MAKE NEXT POINTER CURRENT, SKIP IF END OF LIST + JRST USYMG + +USYMG1: MOVE C,[-GCBPL,,PRSTG] +GCLP2: MOVE A,(C) ;NOW CONVERT CHARACTER ADDRESSES... + BCOMP A,-1 ;BACK TO BYTE POINTERS + MOVEM A,(C) + AOBJN C,GCLP2 +IFN 17-P+FF,.ERR GC AC restorer wants FF=0 and P=17! + MOVS 16,[1,,GCSV] ; Restore all ACs except FF and P. + BLT 16,16 + POPJ P, ;EXIT FROM GARBAGE COLLECTOR + + ;GC ROUTINE TO SCAN TABLE AREA FOR POINTERS TO CURRENT STRING + ;CH1 -> BEGINNING OF TABLE, 4.9 => LOOK AT PAIRS SKIPPING SECOND OF EACH PAIR + ;T POINTS TO LAST WORD IN TABLE + 1 + ;RELOCATE POINTERS IN TABLE POINTED TO + ;C POINTS TO BEGINNING OF STRING, B -> END + 1 + +MSCN: CAIG T,(CH1) + POPJ P, ;TABLE EXHAUSTED + HRRZ TT,-1(T) ;GET LAST ENTRY IN TABLE (UPPER POINTER UPDATED TO COUNT DOWN) + CAML TT,C + CAML TT,B + JRST MSCN1 ;DOESN'T POINT TO CURRENT STRING + SUB TT,COFST ;POINTS TO STRING, RELOCATE + HRRM TT,-1(T) ;STORE BACK RELOCATED POINTER + SETOM SVF ;SET FLAG TO SAVE STRING +MSCN1: SKIPGE CH1 + SOS T ;CH1 NEGATIVE => SKIP A WORD + SOJA T,MSCN + +GCEND: SETOM GCENDF ;DONE READING FROM MACTAB, BUT FIRST HAVE TO RELOCATE POINTERS TO LAST STRING +MSTG2: CLEARM SVF ;NO POINTERS FOUND TO STRING YET + MOVE D,REDPT + SUB D,FREEPT + MOVEM D,COFST ;STORE AMOUNT CHARS COPIED DOWN BY FOR CHAR ADR RELOCATION + MOVE B,REDPT + CAIE TT,374 + JRST MSTG3 ;NOT A MACRO + MOVE T,SYMSTR + JUMPE T,MSTG3 ;JUMP IF NO MACROS ON LIST +MSTG5: HLRZ TT,(T) ;GET CHAR ADR THIS MACRO + CAML TT,C ;SKIP IF POINTS BELOW BEGINNING THIS STRING + CAML TT,B ;SKIP UNLESS POINTS TO OR ABOVE FIRST CHAR NOT YET READ + JRST MSTG4 ;DOESN'T POINT TO THIS STRING + SETOM SVF ;POINTS TO THIS STRING, SET FLAG TO SAVE STRING + SUB TT,COFST ;RELOCATE + HRLM TT,(T) ;STORE BACK UPDATED CHAR ADR THIS MACRO +MSTG4: HRRZ T,(T) ;NOW GET POINTER TO NEXT MACRO + JUMPN T,MSTG5 ;LOOP FOR ALL MACROS ON LIST + +MSTG3: MOVE T,TOPP + MOVEI CH1,DMYAGT + PUSHJ P,MSCN ;RELOCATE POINTERS IN DUMMY ARG TABLE + HRRZ T,MACP + HRROI CH1,MACPDL + PUSHJ P,MSCN ;RELOCATE POINTERS IN MACRO PDL + HRRZ T,PRCALP + AOS T + MOVEI CH1,PRSTG + PUSHJ P,MSCN ;RELOCATE POINTERS IN PRSTG + HRRZ T,RDWRDP + MOVEI CH1,DSTG + PUSHJ P,MSCN ;RELOCATE DUMMY ARGS READ (OR BEING READ) IN BUT NOT YET ACTIVATED + SKIPGE GCENDF + JRST GCEND1 ;EXIT +MSTGB1: SKIPE SVF + JRST MSTGB2 ;FOUND POINTERS TO THIS STRING, DON'T FLUSH + MOVE TT,FREPTS ;NO POINTERS FOUND, FLUSH STRING + MOVEM TT,FREEPT + MOVE TT,FRPTBS + MOVEM TT,FREPTB +MSTGB2: SKIPGE GCENDF ;IF WE JUST HACKED AN I-O BUFFER, MAYBE IT'S THE LAST + JRST GCEND1 ;THING IN MACRO SPACE. + JRST MSTG + +] ;END MACSW CONDITIONAL (AND MACRO PROCESSOR ROUTINES) + +IFN .I.FSW,[ ;;.I.F ;ALGEBRAIC COMPILER ROUTINE +; 'ALGEBRAIC' CRUFT MARO DEFINITIONS + +DEFINE MOAN ARG/ + MOVEI D,[SIXBIT /ARG!!/] + JRST ERRCON +TERMIN + +DEFINE RETLIN + MOVEI A,15 ;CARRIAGE RETURN + PUSHJ P,PUTREL + MOVEI A,12 ;LINE FEED + PUSHJ P,PUTREL +TERMIN + +DEFINE NUMBER + MOVE A,BTPNT + ILDB I,A + CAIE I,"# + CAIGE I,"@ +TERMIN + +DEFINE RESTOR + MOVE D,BTPNT + SETZM STRING + SETZM STRING+1 + SETZM STRING+2 +TERMIN + + +DEFINE SPECN + POP P,RANDM + MOVE A,ENN + SUB A,RANDM + MOVEM A,ENN +TERMIN + +DEFINE $GET + EXCH I,ACSVI + PUSHJ P,RCH + EXCH I,ACSVI +TERMIN + +DEFINE GETT + EXCH I,ACSVI + PUSHJ P,RCH + EXCH I,ACSVI + IDPB A,TPN +TERMIN + +; START OF COMPILER PROPER + +OPDL: CH?CH?CH?CH?CH?CH?CH?CH ;COMMUTATOR + CH?SP?CH?CH?CH?CR?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + SP?CH?CH?CH?DL?CH?CH?CH + LP?RP?TX?PL?CM?MN?CH?DV + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?KL?LB?EQ?RB?CH + +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?UP?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH + +VBLK + +ENN: 60 ;ACCUMULATOR NUMBER - TROUBLE IF GOES PAST 9 + +BTPNT: 440700,,STRING ;D +STRING: BLOCK 10 ;CHARACTER ASSEMBLY (D) - TROUBLE IF OVERFLOWS + +TPN: 0 +DIRPNT: 440700,,DIROUT ;TPN +DIROUT: BLOCK 40 ;COPY OF LINE IN PROGRESS (TPN) - TROUBLE IF OVERFLOWS + +OPSTKL==40 + 0 +OPSTK: BLOCK OPSTKL ;OPERATOR STACK (R) - TROUBLE IF OVERFLOWS + 0 + + + +ENDSTT: 0 ;ON IF END OF STATEMENT ENCOUNTERED +CHARF: 0 ;LAST WAS NOT OPERATOR +NUMFL: 0 ;STRING IS NUMERIC CONSTANT (NEEDS [ AND ]) +R1SV: 0 ;SAVED A +R2SV: 0 ;SAVED I, CALLED V EARLIER ON + +INTEGR: 0 ;INTEGER ARITHMETIC +WARN: 0 ;ON AFTER ) TO STOP NON-OPERATOR +RANDM: 0 ;DUMP COMMA COUNT HERE +TEMP: 440600,,(D) ;INDIRECT VIA D +BYTPNT: 0 + ; Save 7 acs here, done by move(m)s for robustness +IRP AC,,[AA,A,B,C,D,I,P] +ACSV!AC: 0 +TERMIN +PBLK + +; ENTRANCE TO 'ALGEBRAIC' TRANSLATOR + +A.I: SETOM INTEGR + SKIPA +A.F: SETZM INTEGR + PUSHJ P,SWINI ;INITIALISE PASSAGE TO MIDAS ASSEMBLER +IRP AC,,[AA,A,B,C,D,I,P] + MOVEM AC,ACSV!AC +TERMIN + SETZM ENDSTT ;RESET END OF STMNT FLAG + SETZM EQHIT' ;RESET LAST CHAR WAS= FLAG + SETZM WARN ;SET OFF ERROR DETECTOR + MOVEI A,"0 ;INITIALISE POINTERS + MOVEM A,ENN + MOVE A,DIRPNT + MOVEM A,TPN ;POINTER TO SAVED INPUT + MOVE SYM,[-OPSTKL,,OPSTK] + PUSH SYM,[0,,ENDSAT] + PUSH P,[0] ;INITIALISE COMMA-COUNTER + SETZM CHARF +CLSTR: RESTOR +RDITTS: SKIPE ENDSTT + JRST BDEND +RDITA: GETT + CAIGE A,100 ;FOR ABBREVIATED DISPATCH TABLE + JRST @OPDL(A) + CAIN A,"\ + JRST AB + CAIN A,"^ + JRST UP + +CH: SETZM EQHIT + SKIPE WARN + JRST CHBRT +CHEY: IDPB A,D + SETOM CHARF ;NON UNARY FLAG + JRST RDITA + +GAMB: RESTOR +COMMT: MOVE I,R2SV + JRST GOPURT + +SHORT: ;DECIDES IF STRING CAN BE USED IN IMMEDIATE TYPE OPS + SETZM IMMED' + SKIPN STRING + POPJ P, ;NO STRING + MOVE A,BTPNT + ILDB I,A + CAIN I,"# + JRST APUPJ ;YEPE HE ASKED FOR IT + SKIPE STRING+1 + POPJ P, ;STRING IS LONG + SKIPA + +TSTSHL: ILDB I,A + JUMPE I,APUPJ ;ITS OK FOUND ONLY NUMBERS + CAILE I,"@ + POPJ P, ;NON-NUMBER IN STRING + CAIE I,". + JRST TSTSHL + ILDB I,A + SKIPN I ;ANYTHING FOLLOW '.' QST +APUPJ: SETOM IMMED' ;INDICATE IMMEDIATE USAGE IS POSSIBLE + POPJ P, + +SZPRT: SETZM CHARF +GOPRT: SETZM WARN +GOPART: MOVEM I,R2SV +GOPURT: HLRZ B,I + HLRZ C,(SYM) + CAMLE B,C + JRST PSOPR ;GO PUSH OPERATOR + SKIPN INTEGR + SETOM IMMED ;FOR ARITH OPS ONLY FIXED WILL DO IMMEDIATE + PUSHJ P,SHORT ;ESTABLISH IF STRING CAN BE IMMEDIFIED + POP SYM,A ;POP AN OPERATOR + JUMPN A,(A) + + MOAN OVERPOPPED OPERATOR STACK + +CHEX: MOVE A,R1SV + JRST CHEY + +RP: SKIPE EQHIT + AOS ENN ;TAKE CARE OF UNSATISFIED = AT END + SKIPN CHARF + JRST RTONOP + SETOM CHARF +BUDDY: SETOM WARN + MOVEI I,RPAR + JRST GOPART + +RTONOP: MOVE I,(SYM) + CAIN I,FUNCT + JRST BUDDY ;NO ARGUMENT FUNCTION + + MOAN ) FOLLOWS OPERATOR + +BDEND: MOAN TOO MANY ('S + +CHBRT: MOAN NON-OPERATOR FOLLOWS ) + +CR: SKIPE EQHIT + AOS ENN ;HANDLES UNSATISFIED = AT END + SETOM ENDSTT + MOVEI I,RCAR + JRST GOPRT + +LP: SETZM EQHIT + SKIPE WARN + JRST LFRHT + SETZM CHARF + SKIPE STRING + JRST INDX + PUSH P,[0] ;INITIALISE COMMA-COUNTER + PUSH SYM,[0,,LFTPR] + JRST RDITA + +INDX: NUMBER + JRST NUSTRB + GETT + CAIG A,"9 + JRST NMRINX + MOVEI I,"( + IDPB I,D +INDY: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDN + CAIN A,"- + JRST CMPNDN + CAIE A,") ;SEARCH FOR NEXT RP + JRST INDY + IDPB A,D +CMBAN: SETOM CHARF ;MAKE BELIEVE CHARATER LAST + SETOM WARN ;YET SET ) TRAP + JRST RDITA + +NMRINX: CAIN A,"- ;IS IT A MINUS + JRST INDZ + CAIN A,"+ + JRST INDZ + MOVEI I,"+ ;NUMERICAL SUBSCRIPT + IDPB I,D +INDZ: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDC + CAIE A,") + JRST INDZ + JRST CMBAN + +CMPNDN: MOVEI I,") + IDPB I,D + JRST INDZ + +CMPNDC: MOVEI I,"( + IDPB I,D + JRST INDY + +LFRHT: MOAN ( FOLLOWS DIRECTLY ON ) + +SP=RDITA ;USE FOR NON ARITH STATS + +CM: MOVE I,[1,,COMMX] + SKIPN CHARF + AOS ENN + JRST SZPRT + +EQ: SETOM EQHIT + SETZM WARN + SKIPN CHARF ;TEST FOR EXISTANCE OF L H S + JRST EQFLOP + NUMBER ;IS L H S A NUMBER + JRST EQNUMB + MOVEI I,EQAAL +EQVAL: SETZM CHARF + PUSH SYM,I + PUSH P,STRING + PUSH P,STRING+1 + PUSH P,STRING+2 + PUSH P,[0] + JRST CLSTR + +PL: MOVE I,[2,,PLUS] + SKIPN CHARF + JRST RDITA ;UNARY PLUS + JRST SZPRT + +MN: MOVE I,[2,,MINUX] + SKIPN CHARF + MOVE I,[5,,UMINU] + JRST SZPRT + +AB: SKIPE CHARF ;ABSOLUTE VALUE + JRST ABERR ;NOT UNARY + MOVE I,[5,,UABS] + JRST SZPRT + +LB: SKIPN CHARF + JRST LP ;TREAT LIKE ( + NUMBER + JRST NUBRST + MOVEI I,FUNCT + JRST EQVAL + +RB=RP + +NUBRST: MOAN '<' FOLLOWS NUMBER + +NUSTRB: MOAN '(' FOLLOWS NUMBER + +EQFLOP: MOAN '=' FOLLOWS OPERATOR + +EQNUMB: MOAN '=' FOLLOWS NUMBER + +ABERR: MOAN NON-UNARY ABS + +TX: MOVE I,[4,,TIMES] + SKIPN CHARF + JRST RDITA ;UNARY TIMES + JRST SZPRT + +DL: $GET ;CONTINUE STATEMENT RC + $GET ;LF + $GET ;. + CAIE A,". ;DOT + JRST BDCONT + $GET ;F OR I + $GET ;CONTROL I OR SPACE + MOVE A,DIRPNT + MOVEM A,TPN ;RESET SAVED INPUT POINTER TO AVOID FILLING ITS BUFFER + MOVEI A,"$ + IDPB A,TPN + MOVEI A,40 + IDPB A,TPN + JRST RDITA + +ERRCON: TRNE FF,FRPSS2 ;NO OUTPUT ON SECOND PASS + JRST CONRBT +;MAY ALSO WANT TO USE STATEMENT PLUS LINE NUMBER TYPE TACTIC + MOVE B,DIRPNT +OUTRR: ILDB A,B + PUSHJ P,TYO + CAME B,TPN + JRST OUTRR + SKIPE ENDSTT + JRST CONERT +DORSTL: MOVEI A,40 + PUSHJ P,TYO + MOVEI A,"? ;POINT AT ERROR + PUSHJ P,TYO + MOVEI A,40 + PUSHJ P,TYO +DORSAL: $GET ;COPY UP TO LINE FEED + PUSHJ P,TYO + CAIE A,12 ;LF + JRST DORSAL +CONERT: PUSHJ P,TIPIS + PUSHJ P,CRR +CONRAT: +IRP AC,,[AA,A,B,C,D,I,P] + MOVE AC,ACSV!AC +TERMIN + JRST SWFLS ;GO BACK AND FLUSH + + +CONRBT: $GET + CAIE A,12 ;LF + JRST CONRBT + JRST CONRAT + +UP: SKIPN WARN ;FOR (NUMBER)^N + SKIPN STRING + JRST ITSEX + MOVEM A,R1SV ;SAVE THE ARROW + NUMBER + JRST CHEX ;ITS PART OF A NUMBER +ITSEX: MOVE I,[6,,STRSTR] + SKIPN CHARF + JRST EXMB + JRST SZPRT + +EXMB: MOAN UNARY ^ + +BDCONT: MOAN BAD CONTINUATION + +KL=CR ;SEMICOLON ACTS LIKE CR IN TERMINATING + +STRSTR: SKIPN STRING + JRST EXLS + NUMBER + SKIPA + JRST EXLS + SUBI I,61 + TDNE I,[-1,,777774] + JRST EXLS + MOVE A,STRING + TDNE A,[3777,,-1] + JRST EXLS + ADDI I,POWR + JRST @(I) + +EXLS: PUSH P,[ASCII !EXPLO!] + PUSH P,[ASCII !G !] + PUSH P,[0] + PUSH P,[1] + SETOM EXRET' + JRST FUNET + +DV: MOVE I,[4,,DIVIX] + SKIPN CHARF + MOVE I,[5,,UDIVI] + JRST SZPRT + +PSOPR: PUSH SYM,I ;PUSH OPERATOR FOR LATER EXCECUTION + SKIPN STRING + JRST RDITTS + PUSHJ P,SHORT ;CAN WE IMMEDIFY + PUSHJ P,MVOI ;AND MOVE OPERAND INTO STACK + JRST CLSTR + +PRODB: NUMBER ;OUTPUT WHAT IS IN STRING + SKIPE IMMED ;NO [ & ] IF IMMEDIATE USE + JRST OVNM + PUSH P,A + MOVEI A,"[ ;[ FOR CONSTANT + PUSHJ P,PUTREL + POP P,A + SETOM NUMFL +OVNM: CAIN I,"# + JRST PRDOC + + EXCH A,I + PUSHJ P,PUTREL + MOVE A,I +PRDOC: ILDB I,A + JUMPN I,OVNM + SKIPN NUMFL + POPJ P, + MOVEI A,"] ;] FOR CONSTANT + PUSHJ P,PUTREL + SETZM NUMFL + POPJ P, + +PRODC: HRLI A,440700 ;MAKE BYTE POINTER + JRST PRDOC + +LFTPR: SPECN + JRST RDITTS ;IGNORE LP ON STACK + +RCAR: HALT ;IMPOSSIBLE FOR THESE TO BE ON STACK +RPAR: HALT + +EQAAL: SPECN + SKIPE STRING + PUSHJ P,MVOI + MOVEI A,[ASCIZ ! MOVEM A!] + PUSHJ P,PRODC + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +ENDSAT: SPECN + SKIPN ENDSTT + JRST TOEARL + SKIPE STRING + PUSHJ P,MVOI +GETLF: $GET + CAIE A,12 ;LF + JRST GETLF +IRP AC,,[AA,A,B,C,D,I,P] + MOVE AC,ACSV!AC +TERMIN + JRST SWRET ;GO BACK + +MVOI: MOVE A,BTPNT + ILDB I,A + CAIN I,"& + JRST MVOALR ;OPERAND ALREADY THERE + MOVEI A,[ASCIZ ! MOVE A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVEI A!] +MVOIK: PUSHJ P,PRODC + MOVE A,ENN + AOS ENN +FINOF: PUSHJ P,PUTREL + MOVEI A,", + PUSHJ P,PUTREL + PUSHJ P,PRODB + RETLIN + POPJ P, + +MVOALR: AOS ENN + POPJ P, + +TOEARL: MOAN TOO MANY )'S + +PLUS: MOVEI A,[ASCIZ ! FADR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! ADD A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! ADDI A!] +OPERT: PUSHJ P,PRODC + SKIPE STRING + JRST GAINS + SOS ENN +OPRTE: MOVE A,ENN + SOS A + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +COMMAA: MOVEI A,", + PUSHJ P,PUTREL + MOVEI A,"A + JRST PUTREL + +GAINS: MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +MINUX: MOVEI A,[ASCIZ ! FSBR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! SUB A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! SUBI A!] + JRST OPERT + +TIMES: PUSHJ P,TMSTR + SKIPE IMMED + MOVEI A,[ASCIZ ! IMULI A!] + JRST OPERT + +DIVIX: MOVEI A,[ASCIZ ! FDVR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IDIV A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! IDIVI A!] + JRST OPERT + +UMINU: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE STRING + JRST MOABC + MOVEI A,[ASCIZ ! MOVNS A!] +UMINUC: PUSHJ P,PRODC + MOVE A,ENN + SOS A + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +MOABC: MOVEI A,[ASCIZ ! MOVN A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVNI A!] + PUSHJ P,MVOIK + JRST GAMB + +UABS: CAMN B,C + JRST BAKWD + SKIPE STRING + JRST MOABS + MOVEI A,[ASCIZ ! MOVMS A!] + JRST UMINUC + +MOABS: MOVEI A,[ASCIZ ! MOVM A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVMI A!] + PUSHJ P,MVOIK + JRST GAMB + +MVONT: MOVEI A,[ASCIZ ! MOVE A!] + PUSHJ P,PRODC + MOVE A,ENN + JRST ONMVS + +TMSTR: MOVEI A,[ASCIZ ! FMPR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IMUL A!] + POPJ P, + +BAKWD: PUSH SYM,A + JRST PSOPR + +UDIVI: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE INTEGR + JRST UINDV + SKIPN STRING + PUSHJ P,MVONT + MOVEI A,[ASCIZ ! HRLZI A!] + PUSHJ P,PRODC + MOVE A,ENN + SKIPN STRING + SOS A + PUSHJ P,PUTREL + MOVEI A,[ASCIZ !,201400!] + PUSHJ P,PRODC + RETLIN + AOS ENN + JRST DIVIX + +ONTMS: PUSHJ P,TMSTR + PUSHJ P,PRODC + MOVE A,ENN + SOS A +ONMVS: PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A +LSTCHX: PUSHJ P,PUTREL + RETLIN + POPJ P, + +POWR: GAMB?POWR2?POWAA?POWR4 + +POWR4: PUSHJ P,ONTMS +POWR2: PUSHJ P,ONTMS + JRST GAMB + +POWAA: PUSHJ P,MVONT + AOS ENN + PUSHJ P,ONTMS + SOS ENN + PUSHJ P,TMSTR + PUSHJ P,PRODC + RESTOR + JRST OPRTE + +COMMX: AOS (P) + SKIPE STRING + PUSHJ P,MVOI + JRST GAMB + +UINDV: MOAN INTEGER UNARY DIVIDE + +FUNCT: SETZM EXRET +FUNET: SKIPE STRING + PUSHJ P,MVOI + SPECN + PUSHJ P,MORFMC + MOVEI A,[ASCIZ ! PUSHJ P,!] + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + PUSHJ P,PRODC + PUSHJ P,PRODB + RESTOR + RETLIN + PUSHJ P,MORFNC + SKIPN EXRET + JRST RDITTS ;AS USED FROM FUNCT + JRST COMMT ;AS USED FROM STRSTR + +MORFMC: MOVE A,RANDM + MOVEM A,RANSV' + SKIPN CHARF ;NO ARGUMENTS + AOS ENN + SETOM CHARF + MOVEI A,"1 + CAMN A,ENN ;ARE ARGUMENT ALREADY IN A0 AND UP + POPJ P, + SETZM CORDM +MORYLP: PUSHJ P,ZENBD + AOS CORDM + SOSL RANSV + JRST MORYLP + POPJ P, + +MORFNC: MOVEI A,"1 + CAMN A,ENN + POPJ P, + MOVE A,RANDM + MOVEM A,CORDM' +MORXLP: PUSHJ P,ZENBD + SOSL CORDM + JRST MORXLP + POPJ P, + +ZENBD: MOVEI A,[ASCIZ ! EXCH A!] + PUSHJ P,PRODC + MOVE A,CORDM + ADDI A,"0 + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A + ADD A,CORDM + JRST LSTCHX + +TIPIS: MOVE A,TEMP + MOVEM A,BYTPNT +MORTP: ILDB A,BYTPNT + CAIN A,1 ;EXCLAMATION + POPJ P, + ADDI A," ;SPACE + PUSHJ P,TYO + JRST MORTP + +] ;END .I.FSW CONDITIONAL + +IFN LISTSW,[ + +;LISTING ROUTINES. + +PNTR: MOVEM 17,PNTSA+17 + MOVEI 17,PNTSA + BLT 17,PNTSA+16 + MOVE P,PNTSA+P ; P = 17 so must restore. +IFN P-17, .ERR P=17 assumption at PNTR! + SKIPL LSTONP + JRST PNTR5 + AOSE LISTPF + JRST PNTR1 + SKIPGE T,LISTAD + JRST PNTR2 + PUSHJ P,P6OD + HLRZS T + PUSHJ P,PSOS ;PRINT SPACE OR ' + PUSHJ P,PILPTS +PNTR3: HLRZ T,LISTWD + PUSHJ P,P6OD + MOVS T,LSTRLC + TLNE T,400000 + AOJ T, + PUSHJ P,PSOS + HRRZ T,LISTWD + PUSHJ P,P6OD + HRRZ T,LSTRLC + PUSHJ P,PSOS + PUSHJ P,PILPTS + PUSHJ P,PILPTS +PNTR4: MOVE TT,[440700,,LISTBF] +PNTR6: CAMN TT,PNTBP + JRST PNTR5A + ILDB A,TT + PUSHJ P,PILPT + JRST PNTR6 + +PNTR5A: CALL PNTCR + MOVE A,LISTBC + CAIE A,14 + JRST PNTR7 +PNTR5C: CALL PILPT ;OUTPUT THE ^L, + CALL PNTHDR ;AND THE PAGE NUMBER. + JRST PNTR5D + +PNTR7: MOVEI A,12 + PUSHJ P,PILPT +PNTR5D: SETOM LISTBC +PNTR5: MOVNI A,LISTBS*5-1 + MOVEM A,PNTSW ;DETECT OVERFLOW OF LISTBF + MOVE TT,[440700,,LISTBF] + MOVEM TT,PNTBP + MOVSI 17,PNTSA + BLT 17,17 + POPJ P, + +PNTR5B: MOVE A,LISTBC + CAIN A,14 + JRST PNTR5C + JRST PNTR5D + +PNTR2: MOVEI T,8 + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR3 + +PNTR1: MOVE TT,[440700,,LISTBF] + CAMN TT,PNTBP + JRST PNTR5B + MOVEI T,25. + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR4 + +PSOS: MOVEI A,"' + TRNN T,-1 +PILPTS: MOVEI A,40 + JRST PILPT + +P6OD: MOVE TT,[220300,,T] +P6OD1: ILDB A,TT + ADDI A,"0 + PUSHJ P,PILPT + TLNE TT,770000 + JRST P6OD1 + POPJ P, + +PNTCR: MOVEI A,^M ;OUTPUT ^M TO LST IF OPEN. +PILPTX: SKIPE LSTONP;OUTPUT CHAR TO LST IF LSTING. + JRST PILPT + RET + +PNTHDR: MOVEI A,^I + MOVEI B,10. ;MOVE TO COLUMN 80., + CALL PILPT + SOJG B,.-1 + PUSH P,LSTTTY + HLLOM B,LSTTTY ;POSITIVE SO TYOERR GOES ONLY TO LST. + TYPR [ASCIZ/Page /] + MOVE A,CPGN + CALL [AOJA A,DPNT] + REST LSTTTY +PNTCRR: CALL PNTCR ;OUTPUT CRLF TO LST IF OPEN. +PNTLF: MOVEI A,^J + JRST PILPTX + +DEFINE LSTM %A,B,C +IF1 [ [B] ? [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+LSTM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-LSTM0 +] +TERMIN + +A.LSTFF: AOS (P) ;RETURN NO VALUE. +; ADDR, CONTENTS IF NOT LISTING, CONTENTS IF LISTING. +LSTOFF: LSTM LSTONP,0,-1 + LSTM LSTPLM,[TLO B,4^5][JRST PSHLML] + LSTM RCHLST,RCHLS1,AOSN PNTSW + LSTM RCH1LS,RET,[CAILE A,^M] + LSTM POPLML,JFCL,[IDPB A,PNTBP] + JRST MDSCLR +LSTM0==.-LSTOFF + +LSTON: BLOCK LSTM0-1 + JRST MDSSET + +A.LSTN: SKIPN LISTP1 ;IF SHOULD LIST THIS PASS + JUMPGE FF,MACCR + SKIPE LISTP ;AND WANT LISTING, + CALL LSTON ;TURN ON LISTING OUTPUT. + JRST MACCR + +IFNDEF LISTBS,LISTBS==50. ;LISTBF SIZE IN WORDS. + +VBLK ;LISTING FEATURE VARIABLES + +PNTBP: 0 ;POINTER TO LISTING LINE BUFFER +LSTONP: 0 ;NONZERO WHEN OUTPUTTING TO LISTING FILE. +LISTP: +LISTON: 0 ;-1 IF LISTING ON +PNTSW: 0 ;-1 IF LAST CHR CR OR LF, OR -<# CHARS SPACE LEFT IN LISTBF> +LISTBF: BLOCK LISTBS +LISTAD: 0 ;ADDRESS OR -1 NONE 3.1 RELOC +LISTWD: 0 ;WORD +LSTRLC: 0 ;RELOCATION +LISTPF: 0 ;-1 OTHERS CONTAIN SOMETHING +LISTBC: 0 ;BREAK CHR CR LF OR FF OR -1 IF NONE SINCE LAST PNTR +LISTTM: 0 ;TEMP AT AEND +PNTSA: BLOCK 20 ;AC SAVE AREA FOR LISTING FEATURE +LISTP1: 0 ;POSITIVE => WANT TO LIST EVEN ON PASS 1. +] ;END IFN LISTSW, + +IFE LISTSW,VBLK + +;THESE VARIABLES ARE REFERENCED EVEN IF LISTSW IS 0. +LSTTTY: 0 ;TYOERR TYPES ON TTY IFF LE 0, ON LST IF NOT 0. +LSTPLM: TLO B,4^5 ;OR JRST PSHLML ;XCT'D BY PSHLMB. +POPLML: JFCL ;OR IDPB A,PNTSW ;XCT'D IN POPLMB. + +PBLK +IFE LISTSW, A.LSTN: A.LSTF: RET + +VBLK +IFN CREFSW,[ +CREFP: 0 ;SET BY C SWITCH TO REQUEST CREFFING. +CRFONP: 0 ;SET WHILE CREFFING. +CRFLFL: 0 ;LAST PAGNUM,,LINENUM OUTPUT. +CRFINU: JFCL\PUSHJ P,CRFUSE ;XCT THIS TO CREF NON-DEF OCCUR. +CRFLBL: JFCL\PUSHJ P,CRFLB1 ;XCT FOR DEF. OF NORMAL SYM. +CRFEQL: JFCL\PUSHJ P,CRFEQ1 ; FOR DEF. OF NORMAL SYM. OR INTSYM. +CRFMCD: JFCL\PUSHJ P,CRFMC1 ; FOR DEF. OF MACRO. +CRFDEF: JFCL\PUSHJ P,CRFDF1 ; FOR RANDOM DEF, CHECK FLAGS. +] +CRFILE: 0 ;SET => SHOULDN'T OUTPUT PAGNUM,,LINENUM'S +;USED BY .CRFILE INTSYM SO CAN'T BE IN CONDIT. +PBLK +IFN CREFSW,[ +CRFEQ1: MOVEI T,(B) + CAIN A,1 ;IF NOT PSEUDO OR NOT INTSYM, + CAIE T,INTSYM + JRST CRFLB1 ;IS NORMAL SYM. +CRFOD1: MOVSI T,600000 ;ELSE DEFINING INSN. + JRST CRFEQ2 + +CRFDF2: MOVEI T,(B) ;DECIDE WHETHER DEFINING MACRO OR PSEUDO. + CAIE T,MACCL + JRST CRFOD1 +CRFMC1: SKIPA T,[500000,,] ;DEFINING MACRO. +CRFLB1: MOVSI T,440000 ;DEFINING NORMAL SYM. +CRFEQ2: PUSH P,A + MOVE A,T + JRST CRFMA1 + +;COME HERE FOR NON-DEF; MUST DECIDE WHAT TYPE SYM. +CRFUSE: TLNE C,3NCRF ;SYM MAY HAVE CREFFING SUPPRESSED. + POPJ P, + PUSH P,A + CAIN A,1 + JRST CRFMAC ;PSEUDOS, MACROS. + MOVSI A,40000 ;FLAG FOR NORMAL SYM. + TRNN C,-1 + MOVSI A,200000 ;FLAG FOR INSNS. +CRFMA1: PUSH P,A + MOVE A,CLNN + HRL A,CPGN + AOBJN A,.+1 ;A HAS PAGNUM,,LINENUM . + SKIPGE CRFILE ;IF SHOULD OUTPUT IT, + JRST CRFUS1 + CAME A,CRFLFL ;AND HAS CHANGED, DO SO. + PUSHJ P,CRFOUT + MOVEM A,CRFLFL +CRFUS1: POP P,A + IOR A,SYM ;COMBINE SYM AND CREF FLAG. + PUSHJ P,CRFOUT + JRST POPAJ + +CRFMAC: MOVEI A,(B) + CAIN A,MACCL + SKIPA A,[100000,,] ;MACRO + MOVSI A,200000 ;PSEUDO-OP. + JRST CRFMA1 + +;DEFINING OCCURRENCE, MIGHT BE ANY TYPE SYM. +CRFDF1: CAIN A,1 ;TYPE 1 => MACRO OR PSEUDO. + JRST CRFDF2 + TRNE C,-1 ;ELSE INSN OR NORMAL SYM. + JRST CRFLB1 + JRST CRFOD1 + +DEFINE CRFM %A,B,C +IF1 [ [B] + [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+CRFM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-CRFM0] +TERMIN + + +A.CRFFF: AOS (P) ;.CRFOFF - STOP CREFFING. NO VAUE. +; LOCATION, NORMAL VALUE, VALUE WHILE CREFFING +CRFOFF: CRFM CRFONP,0,-1 + CRFM CRFLBL,JFCL,[PUSHJ P,CRFLB1] + CRFM CRFEQL,JFCL,[PUSHJ P,CRFEQ1] + CRFM CRFMCD,JFCL,[PUSHJ P,CRFMC1] + CRFM CRFINU,JFCL,[PUSHJ P,CRFUSE] + CRFM CRFDEF,JFCL,[PUSHJ P,CRFDF1] + POPJ P, +CRFM0==.-CRFOFF + +CRFON: BLOCK CRFM0-1 + POPJ P, + +A.CRFN: JUMPGE FF,MACCR + SKIPE CREFP ;.CRFON, IF HAVE CREF FILE, START CREFFING. + PUSHJ P,CRFON + JRST MACCR +] ;END IFN CREFSW, + +SUBTTL TS Routines for I/O & overall control + +IFN TS,.INSRT TSRTNS + +FEED1: SKIPA B,[40] +FEED: MOVEI B,5 + JRST TFEED + +VBLK + +IFG PURESW-DECSW,[ ;PURIFICATION ROUTINE + +PURIFG: -1 ;-1 IF NOT (YET) PURIFIED +] + VARIAB +VPAT: +VPATCH: BLOCK 20 +VPATCE=.-1 + +PBLK + +CONSTANTS + +PAT: +PATCH: BLOCK 100 +PATCHE: -1 + +IFG PURESW-DECSW,[LOC <.+1777>&-2000 ;SKIP TO NEXT PAGE + MAXPUR==._-10. ;FIRST PAGE ABOVE PURE PAGES +PRINTA Pure pages = ,\MAXPUR-MINPUR +] + +VBLK +PDL: BLOCK LPDL+1 + +IFN DECDBG, DECDBB: BLOCK 8000. ;SPACE FOR DEC DDT'S SYMS. + +.NSTGW +BBKCOD==. ;BEGIN BLANK CODING, CLEARED OUT DURING INITIALIZATION +IFG PURESW-DECSW,MINBNK==<.+1777>_-10. ;FIRST PAGE OF BLANK CODE +BNKBLK ;DUMP OUT ACCUMULATED BLANK CODING + + ;NOW MORE BLANK CODING + +BKBUF: BLOCK BSIZE+5 ;CURRENT BLOCK TO OUTPUT +GLOTB: BLOCK 20 ;GLOBAL TABLE, EACH ENTRY FLAGS,,ADR OF SQUOZE (SEE COMMENTS NEAR BEGINNING) +STRSTO: BLOCK STRL ;STRING STORAGE FOR GSYL AND FRIENDS +IFN FASLP,[ +FASB: BLOCK FASBL ;OUTPUT BUFFER FOR FASL MODE + ;FIRST WD 9 FOUR BIT CODE GROUPS, REST ASSOC STUFF +FASAT: BLOCK FASATL ;ATOM TABLE FOR FASL MODE + ;EACH ENTRY CONSISTS OF ATOM IN FORMAT DESIRED BY FASLOAD, + ;NAMELY: + ; HEADER WD. RH LENGTH IN WDS + ; 4.8-4.7 TYPE 0-PN 1 FIX 2 FLO 3 BIG (NOT IMPLEMENTED) + ; FOLLOWED BY PN OR VALUE + ;-EXCEPT- IF RH OF HEADER =0, THIS SLOT RESERVED FOR LIST + +] + +EBKCOD==. ;END BLANK CODING +.YSTGW + +PRINTA ST = ,\.-RL0 + +ST: ;SYMBOL TABLE 3 WORDS/SYM FIRST SQUOZE, SECOND "VALUE", 3RD FLAGS,,BLOCK. + BLOCK NRMWPS*SYMDSZ + +;LITERALS TABLES - CAN MOVE AND GROW. THESE TAGS & LENGTHS ARE JUST THE DEFAULTS +.SEE CONTBA ;ETC, WHICH CONTAIN THE ACTUAL ADDRESSES. SO DON'T USE THEM! +CONTAB: BLOCK LCONTB ;CONSTANTS TABLE, VALUES OF CONSTANTS THIS CONSTANTS AREA +CONGLO: BLOCK LCNGLO ;CONSTANTS GLOBAL TABLE, EACH ENTRY TWO WORDS + ;FIRST WD GLOTB ENTRY. SECOND WD ADR IN CONTAB OF CONSTANT TO WHICH IT REFERS +CONBIT: BLOCK LCONTB/12.+1 ;RELOCATION BITS AND ILNOPT BIT(SEE CPTMK) + ;3 BITS FOR EACH WORD OF CONTAB. + +;;INIT ;INITIALIZATION ROUTINES (IN MACRO TABLE, GET WIPED OUT) +IFN ITSSW\TNXSW,MINMAC==./2000 ;# OF 1ST PAGE HOLDING PART OF MACTAB. + +;NOTE THAT THIS CODE IS COPIED UPWARD WHEN MACTAB IS MOVED +;DUE TO SYMTAB EXPANSION. THEREFOR IT MUST REFER TO ITSELF +;INDEXED BY THE OFFSET OF WHERE IT IS FROM WHERE IT WAS ASSEMBLED. +;THAT IS KEPT IN CH1. ALL LITERALS MUST BE USED INDEX OF CH1, TOO. + +;MAC PROC TABLES +MACTBA: 773767750000 ;MACRO CHARACTER STORAGE (FIRST WORD 3 375'S) +INIT1: MOVE CH1,MACTAD ;GET ADDR THIS CODE REALLY STARTS AT. + SUBI CH1,MACTBA ;GET OFFSET FROM WHERE ASSEMBLED. + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1](CH1) + BLT A,EBKCOD-1 ;CLEAR OUT BLANK CODING + PUSH P,[SP4](CH1) ;NOW INIT THE SYMTAB & FINISHED. + +;INITIALIZE THE SYMTAB, EXPECT SIZE IN SYMLEN. +INITS: MOVE AA,SYMLEN ;SET UP THE OTHER VARS + IMUL AA,WPSTE ;DEALING WITH SYMTAB SIZE. + MOVEM AA,SYMSIZ + ADDI AA,ST ;ADDR OF START OF CONTAB. + MOVEM AA,CONTBA + MOVEM AA,PLIM + ADD AA,CONLEN ;ADD LENGTH OF CONTAB TO GET ADDR OF CONGLO TAB. + MOVEM AA,CONTBE ;WHICH IS ALSO THE END OF CONTAB. + MOVEM AA,CONGLA + MOVEM AA,CONGOL + MOVE A,CONLEN ;ADD IN LENGTH OF CONGLO (1/4 OF CONLEN) + LSH A,-2 + ADD AA,A + MOVEM AA,CONGLE ;TO GET END OF CONGLO, AND START OF CONBIT TABLE. + MOVEM AA,CONBIA + MOVE A,CONLEN + ADDI A,11. + IDIVI A,12. + ADD AA,A ;ADD LENGTH OF CONBIT (1/12 OF CONLEN) GETTING ADDR OF MACTAB. +IFN DECSW,[ + PUSH P,AA + ADDI AA,MACL-1 + IORI AA,1777 ;FIX ALLOCATION PROBLEMS ON KI-10 + CORE AA, + ETF [ASCIZ /No core for symbols/](CH1) + REST AA +] + MOVN A,SYMLEN + HRLZM A,SYMAOB ;AOBJN -> SYMTAB. + MOVE A,WPSTE + SUBI A,1 + MOVEM A,WPSTE1 + MOVN A,WPSTE + HRRM A,WPSTEB + CAMG AA,MACTAD ;MOVED MACTAB UP? + JRST INITS1(CH1) +IFN ITSSW\TNXSW,[ ;YES, GET CORE FOR INCREASE. + PUSH P,AA + MOVEI AA,MACL+1777(AA) + LSH AA,-10. ;1ST PAGE NOT NEEDED BY MACTAB. + MOVEI A,MACL+1777+MACTBA(CH1) + LSH A,-10. ;1ST PAGE MACTAB DOESN'T YET HAVE. + SUBM A,AA ;# PAGES NEEDED. + HRLZI AA,(AA) + HRRI AA,(A) ;-<# PAGES>,,<1ST NEEDED> + JUMPGE AA,INITS3(CH1) ;DON'T CALL IF NEED 0 PAGES, WOULD GET ONE. +IFN TNXSW, PUSHJ P,TCORGT +IFN ITSSW, .CALL INITSB(CH1) ? .VALUE +INITS3: REST AA +] + SUBM AA,MACTAD ;MACTAD _ SHIFT IN START OF MACTAB. + EXCH AA,MACTAD ;MACTAD GETS NEW START, AA HAS SHIFT. + MOVSI A,PTAB-CCOMPB + ADDM AA,PTAB(A) ;RELOCATE BYTE-PTRS INTO MACTAB. + AOBJN A,.-1(CH1) + MOVNI B,INITS2(CH1) + HRROI A,@EISYMP(CH1) + ADDI B,1(A) ;GET # WDS IN SECOND HALF OF INIT CODE. + HRRM AA,.+1(CH1) ;COPY 2ND HALF UPWARD WITH POP-LOOP. + POP A,(A) ;THIS INSN IMPURE. + SOJG B,.-1(CH1) + ADDI CH1,(AA) ;CHANGE OFFSET TO PT. TO NEW LOCATIONN OF INIT CODE. + JRST INITS2(CH1) ;JUMP INTO 2ND HALF, WHERE IT'S BEEN COPIED TO. +INITS2: HRROI A,INITS2-1(CH1) ;THEN COPY 1ST HALF (WHICH ENNDS BEFORE INITS2) + SUBI A,(AA) ;GET WHERE NOW ENDS, NOT WHERE WILL END. + MOVEI B,INITS2-MACTBA ;UP UNDERNEATH THE 2ND HALF. + HRRM AA,.+1(CH1) ;(THIS TWO-STEP COPYING HANDLES ALL OVERLAPS) + POP A,(A) + SOJG B,.-1(CH1) +INITS1: MOVE AA,SYMSIZ + SETZM ST + MOVE A,[ST,,ST+1](CH1) + BLT A,ST-1(AA) ;CLEAR OUT SYMBOL TABLE + SETZM ESBK ;DEFINE THEM IN OUTER BLOCK. + MOVEI AA,ISYMTB(CH1) + MOVS F,ISMTBB(CH1) ;GET SWAPPED VALUE OF FIRST INSTRUCTION +SP3: CAIL AA,EISYM1(CH1) + JRST SP1(CH1) ;DONE WITH INSTRUCTIONS + MOVE SYM,(AA) + JUMPE SYM,SP2(CH1) + TLZ SYM,740000 + PUSHJ P,ES ;WON'T SKIP + CAIA + .VALUE ;INSTRUCTION PRESENT TWICE IN TABLE!!?!? + HRLZI T,SYMC + HRLZ B,F + MOVSI C,3KILL + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP2: ADDI F,1000 + AOJA AA,SP3(CH1) +;AFTER HACKING ALL THE INSTRUCTIONS, STORED AS JUST THE NAMES IN NUMERIC ORDER, +;HACK ALL THE OTHER PREDEFINED SYMS, STORED AS 2 WORDS (NAME ? VALUE). +EISYMP: ;MAY BE MUNGED IF MORE SYMBOLS ARE ADDED AFTER EISYMT. +SP1: CAIL AA,EISYMT(CH1) + POPJ P, + MOVE SYM,(AA) + LDB T,[400400,,SYM](CH1) + ROT T,-4 + TLZ SYM,740000 + PUSHJ P,ES + CAIA + JRST SP5(CH1) ;SYM ALREADY DEFINED? (MIGHT BE .UAI, IN ITS AND IN MIDAS). + MOVE B,1(AA) + MOVSI C,3KILL + CAME T,[GLOETY,,](CH1) ;GLOBAL ENTRIES REALLY EXITS, HACKED TO DEFEAT ADDRESS LINKING + CAMN T,[GLOEXT,,](CH1) + TLO C,3LLV + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP5: AOS AA + AOJA AA,SP1(CH1) + +IFN ITSSW,[ +INITSB: SETZ ? 'CORBLK + MOVEI %CBNDR+%CBNDW ;BOTH READ AND WRITE. + MOVEI %JSELF ? AA ;INTO SELF, AA IS AOBJN -> PAGES. + SETZI %JSNEW ;FRESH PAGES. + + ;GOBBLE SYMS FROM SYSTEM + ;TABLE AREA IN SYSTEM: + ;FIRST LOC SYSYMB + ;LAST (AS OPPOSED TO LAST + 1) SYSYME + +TSYMGT: MOVE AA,[MXICLR-MXIMAC,,MXICLR] + .CALL INITSB ;GET MACTAB PAGES NNOT LOADED INTO. + .VALUE +IFN PURESW,[ + MOVE AA,[MINBNK-MINMAC,,MINBNK] + .CALL INITSB ;GET PAGES FOR BLANK CODE & SYMTAB. + .VALUE + SKIPN PURIFG + JRST TSYMG3 + JSP F,FLSPGS ;NOT PURIFIED => FLUSH PAGES + ,,MXIMAC ;OF MACTAB CREATED BY LOADING BUT NOT NEEDED. + +TSYMG3: +] + MOVEI A,EISYMT ;EISYMT FIRST LOC FOR ITS SYMS + MOVE B,[SIXBIT /CALLS/] ;SYSTEM CALLS + .GETSYS A, ;READ IN SYSTEM CALLS (SHOULD SKIP) + .VALUE + SKIPGE A + .VALUE ;.GETSYS DIDN'T UPDATE AOBJN POINTER + HRRM A,SP1 ;MARK END OF SYMS + ANDI A,-1 + CAIL A,MACTBA+MACL + .VALUE ;MACL TOO SMALL! INITS MIGHT LOSE. + MOVEI B,EISYMT + MOVEI AA,SYMC_<-18.+4> ;SQUOZE FLAG FOR SYM +TSYMG2: DPB AA,[400400,,(B)] + ADDI B,2 + CAIE B,(A) + JRST TSYMG2 + POPJ P, +]; IFN ITSSW + +SUBTTL Purifier routines - PURIFY$G, GAPFLS$G, also DECDBM + +IFN ITSSW\TNXSW,[ +IFN PURESW,[ ;HERE ARE THE GUTS OF THE PURIFY ROUTINE + +PURIFY: SKIPL NVRRUN +IFN ITSSW,[ .VALUE [ASCIZ /:Already run +/]] +IFN TNXSW,[ + JRST [ HRROI 1,[ASCIZ /? Already run +/] + PSOUT + HALTF + JRST .+1] ; If continued, go ahead anyway. +] ;IFN TNXSW +PURIF1: MOVEI P,17 ; Start PDL at 20 + JSP F,FLSPGS ; First flush blank-code pages, + ,,MINBNK ; incl. symbol table. + JSP F,FLSPGS + ,,MXICLR ; Flush MACTAB pages created by load but not needed. + JSP F,PURIFD + ,,MINPUR ; Purify pure pages. + SETZM PURIFG ; Set "purified" flag + MOVE [1,,2] ; Now clear out remains of data of self + MOVEI 1,0 + BLT 40 +IFN ITSSW,.VALUE [ASCIZ /:Purifiedpdump SYS;TS MIDAS/] +IFN TNXSW,[ + HRROI 1,[ASCIZ / Purified, now SAVE +/] + PSOUT + HALTF +] ; IFN TNXSW + +GAPFLS: JSP F,FLSPGS ; Flush gap pages created on initial load. + ,,MXIMAC +IFN ITSSW, .BREAK 16,300000 +IFN TNXSW, HALTF + + ; JSP F,FLSPGS + ; -<# pgs>,, + ; Flush pages specified by page AOBJN + +FLSPGS: MOVE A,(F) ; Get the page AOBJN +IFN ITSSW,[ + SYSCAL CORBLK,[MOVEI 0 ? MOVEI %JSELF ? A] + .LOSE 1000 +] +IFN TNXSW,[ + ASH A,1 ; Multiply # pages, page # by 2. + HLRE B,A + HRLI A,.FHSLF + MOVNS B + TLO B,(PM%CNT) ; Say hacking repeat count +FLSPG2: SYSCAL PMAP,[[-1] ? A ? B] ; Flush these pages. + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI B,-1(B) ; Else, on 10X, must iterate manually. + TRNE B,400000 ; See if became "negative". + JRST .+1 ; Yep, done with manual iteration. + AOJA A,FLSPG2] ; Nope, bump page #. +] + JRST 1(F) + + ; JSP F,PURIFD - Just like FLSPGS, but purifies the pages instead. + +PURIFD: MOVE A,(F) ; Get page AOBJN +IFN ITSSW,[ + SYSCAL CORBLK,[MOVEI %CBNDR ; Read access only. + MOVEI %JSELF ? A] + .LOSE 1000 +] +IFN TNXSW,[ + ASH A,1 ; Double everything. + HLRE B,A + MOVNS B + HRLI A,.FHSLF +PURID1: SYSCAL SPACS,[A ? [PA%RD+PA%EX]] + ADDI A,1 + SOJG B,PURID1 +] + JRST 1(F) + +IFN TNXSW,[ + + ; PURSAV - More useful hack for 10X/20X since it preserves page access +PURSV0: PUSHJ P,RDJERR +PURSAV: MOVEI P,20 + HRROI R1,[ASCIZ /Pure-Save to file: /] + PSOUT + MOVSI R1,(GJ%NEW+GJ%FOU+GJ%SHT+GJ%FNS) + MOVE R2,[.PRIIN,,.PRIOU] + GTJFN ; Get JFN from TTY + JRST PURSV0 + SETZM PURIFG ; Claim purified... + SETOM MEMDBG ; and keeping watch on memory. + HRLI R1,.FHSLF + MOVEI R2,[ + 2*<0-MINBNK>,,0+SS%RD+SS%WR+SS%EXE ; Variables/buffers + 2*,,2*MINMAC+SS%RD+SS%WR+SS%EXE ; MACTAB init + 2*,,2*MINPUR+SS%RD+SS%EXE ; Purify pure pages. + 0 ] ; End of SSAVE table + SETZ R3, + SSAVE ; Do it! + HRROI R1,[ASCIZ /Saved./] + PSOUT + HALTF +] ; IFN TNXSW + +] ; IFN PURESW +] ; IFN ITSSW\TNXSW + +IFN DECDBG,[ +DECDBM: 0 + HRLZ A,.JBSYM ;GET ADDR OF START OF DDT SYMS, + HRRI A,DECDBB+200 ;LEAVE 200 WD SPACE BEFORE THEM. + HRRM A,.JBSYM ;MOVE THEM INTO SPACE PROVIDED + HLRE B,.JBSYM + MOVMS B + BLT A,DECDBB+177(B) ;SO THEY WON'T GET IN MACTAB'S WAY. + JRST @DECDBM +] + +CONSTANTS + +;;ISYMS ;INITIAL SYMBOL TABLE + +IFNDEF JSYS,JSYS=104_33 ;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE + +ISMTBB: JSYS ;FIRST OP. CODE IN ISYMTB + +ISYMTB: + +; 104-177 (JSYS - FDVRB) + +SQUOZE 10,JSYS ;BBN PAGER INSTRUCTION +SQUOZE 10,ADJSP ;KL10 INSTRUCTION + 0 + 0 + +SQUOZE 10,DFAD ;KI10 INSTRUCTION +SQUOZE 10,DFSB ;KI10 INSTRUCTION +SQUOZE 10,DFMP ;KI10 INSTRUCTION +SQUOZE 10,DFDV ;KI10 INSTRUCTION +SQUOZE 10,DADD ;KL10 INSTRUCTION +SQUOZE 10,DSUB ;KL10 INSTRUCTION +SQUOZE 10,DMUL ;KL10 INSTRUCTION +SQUOZE 10,DDIV ;KL10 INSTRUCTION +SQUOZE 10,DMOVE ;KI10 INSTRUCTION +SQUOZE 10,DMOVN ;KI10 INSTRUCTION + +SQUOZE 10,FIX ;KI10 INSTRUCTION +SQUOZE 10,EXTEND ;KL10 INSTRUCTION +SQUOZE 10,DMOVEM ;KI10 INSTRUCTION +SQUOZE 10,DMOVNM ;KI10 INSTRUCTION +SQUOZE 10,FIXR ;KI10 INSTRUCTION +SQUOZE 10,FLTR ;KI10 INSTRUCTION + +SQUOZE 10,UFA ;KA/KI10 INSTRUCTION +SQUOZE 10,DFN ;KA/KI10 INSTRUCTION +SQUOZE 10,FSC + +SQUOZE 10,IBP +SQUOZE 10,ILDB +SQUOZE 10,LDB +SQUOZE 10,IDPB +SQUOZE 10,DPB + +SQUOZE 10,FAD +SQUOZE 10,FADL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FADM +SQUOZE 10,FADB +SQUOZE 10,FADR +SQUOZE 10,FADRI ;PDP10 INSTRUCTION +SQUOZE 10,FADRM +SQUOZE 10,FADRB +SQUOZE 10,FSB +SQUOZE 10,FSBL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FSBM +SQUOZE 10,FSBB +SQUOZE 10,FSBR +SQUOZE 10,FSBRI ;PDP10 INSTRUCTION +SQUOZE 10,FSBRM +SQUOZE 10,FSBRB +SQUOZE 10,FMP +SQUOZE 10,FMPL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FMPM +SQUOZE 10,FMPB +SQUOZE 10,FMPR +SQUOZE 10,FMPRI ;PDP10 INSTRUCTION +SQUOZE 10,FMPRM +SQUOZE 10,FMPRB +SQUOZE 10,FDV +SQUOZE 10,FDVL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FDVM +SQUOZE 10,FDVB +SQUOZE 10,FDVR +SQUOZE 10,FDVRI ;PDP10 INSTRUCTION +SQUOZE 10,FDVRM +SQUOZE 10,FDVRB + +; 200-277 (MOVE - SUBB) + +SQUOZE 10,MOVE +SQUOZE 10,MOVEI +SQUOZE 10,MOVEM +SQUOZE 10,MOVES +SQUOZE 10,MOVS +SQUOZE 10,MOVSI +SQUOZE 10,MOVSM +SQUOZE 10,MOVSS +SQUOZE 10,MOVN +SQUOZE 10,MOVNI +SQUOZE 10,MOVNM +SQUOZE 10,MOVNS +SQUOZE 10,MOVM +SQUOZE 10,MOVMI +SQUOZE 10,MOVMM +SQUOZE 10,MOVMS + +SQUOZE 10,IMUL +SQUOZE 10,IMULI +SQUOZE 10,IMULM +SQUOZE 10,IMULB +SQUOZE 10,MUL +SQUOZE 10,MULI +SQUOZE 10,MULM +SQUOZE 10,MULB +SQUOZE 10,IDIV +SQUOZE 10,IDIVI +SQUOZE 10,IDIVM +SQUOZE 10,IDIVB +SQUOZE 10,DIV +SQUOZE 10,DIVI +SQUOZE 10,DIVM +SQUOZE 10,DIVB + +SQUOZE 10,ASH +SQUOZE 10,ROT +SQUOZE 10,LSH +SQUOZE 10,JFFO ;PDP10 INSTRUCTION +SQUOZE 10,ASHC +SQUOZE 10,ROTC +SQUOZE 10,LSHC +SQUOZE 10,CIRC ;AI PDP10 INST. CIRCULATE: ROTC WITH AC+1 GOING THE WRONG WAY + +SQUOZE 10,EXCH +SQUOZE 10,BLT +SQUOZE 10,AOBJP +SQUOZE 10,AOBJN +SQUOZE 10,JRST +SQUOZE 10,JFCL +SQUOZE 10,XCT +SQUOZE 10,MAP ;KI10 INSTRUCTION + +SQUOZE 10,PUSHJ +SQUOZE 10,PUSH +SQUOZE 10,POP +SQUOZE 10,POPJ +SQUOZE 10,JSR +SQUOZE 10,JSP +SQUOZE 10,JSA +SQUOZE 10,JRA + +SQUOZE 10,ADD +SQUOZE 10,ADDI +SQUOZE 10,ADDM +SQUOZE 10,ADDB +SQUOZE 10,SUB +SQUOZE 10,SUBI +SQUOZE 10,SUBM +SQUOZE 10,SUBB + +; 300-377 (CAI - SOSG) + +SQUOZE 10,CAI +SQUOZE 10,CAIL +SQUOZE 10,CAIE +SQUOZE 10,CAILE +SQUOZE 10,CAIA +SQUOZE 10,CAIGE +SQUOZE 10,CAIN +SQUOZE 10,CAIG +SQUOZE 10,CAM +SQUOZE 10,CAML +SQUOZE 10,CAME +SQUOZE 10,CAMLE +SQUOZE 10,CAMA +SQUOZE 10,CAMGE +SQUOZE 10,CAMN +SQUOZE 10,CAMG + +SQUOZE 10,JUMP +SQUOZE 10,JUMPL +SQUOZE 10,JUMPE +SQUOZE 10,JUMPLE +SQUOZE 10,JUMPA +SQUOZE 10,JUMPGE +SQUOZE 10,JUMPN +SQUOZE 10,JUMPG +SQUOZE 10,SKIP +SQUOZE 10,SKIPL +SQUOZE 10,SKIPE +SQUOZE 10,SKIPLE +SQUOZE 10,SKIPA +SQUOZE 10,SKIPGE +SQUOZE 10,SKIPN +SQUOZE 10,SKIPG + +SQUOZE 10,AOJ +SQUOZE 10,AOJL +SQUOZE 10,AOJE +SQUOZE 10,AOJLE +SQUOZE 10,AOJA +SQUOZE 10,AOJGE +SQUOZE 10,AOJN +SQUOZE 10,AOJG +SQUOZE 10,AOS +SQUOZE 10,AOSL +SQUOZE 10,AOSE +SQUOZE 10,AOSLE +SQUOZE 10,AOSA +SQUOZE 10,AOSGE +SQUOZE 10,AOSN +SQUOZE 10,AOSG +SQUOZE 10,SOJ +SQUOZE 10,SOJL +SQUOZE 10,SOJE +SQUOZE 10,SOJLE +SQUOZE 10,SOJA +SQUOZE 10,SOJGE +SQUOZE 10,SOJN +SQUOZE 10,SOJG +SQUOZE 10,SOS +SQUOZE 10,SOSL +SQUOZE 10,SOSE +SQUOZE 10,SOSLE +SQUOZE 10,SOSA +SQUOZE 10,SOSGE +SQUOZE 10,SOSN +SQUOZE 10,SOSG + +; 400-477 (SETZ - SETOB) + +SQUOZE 10,SETZ +SQUOZE 10,SETZI +SQUOZE 10,SETZM +SQUOZE 10,SETZB +SQUOZE 10,AND +SQUOZE 10,ANDI +SQUOZE 10,ANDM +SQUOZE 10,ANDB +SQUOZE 10,ANDCA +SQUOZE 10,ANDCAI +SQUOZE 10,ANDCAM +SQUOZE 10,ANDCAB +SQUOZE 10,SETM +SQUOZE 10,SETMI +SQUOZE 10,SETMM +SQUOZE 10,SETMB +SQUOZE 10,ANDCM +SQUOZE 10,ANDCMI +SQUOZE 10,ANDCMM +SQUOZE 10,ANDCMB +SQUOZE 10,SETA +SQUOZE 10,SETAI +SQUOZE 10,SETAM +SQUOZE 10,SETAB +SQUOZE 10,XOR +SQUOZE 10,XORI +SQUOZE 10,XORM +SQUOZE 10,XORB +SQUOZE 10,IOR +SQUOZE 10,IORI +SQUOZE 10,IORM +SQUOZE 10,IORB +SQUOZE 10,ANDCB +SQUOZE 10,ANDCBI +SQUOZE 10,ANDCBM +SQUOZE 10,ANDCBB +SQUOZE 10,EQV +SQUOZE 10,EQVI +SQUOZE 10,EQVM +SQUOZE 10,EQVB +SQUOZE 10,SETCA +SQUOZE 10,SETCAI +SQUOZE 10,SETCAM +SQUOZE 10,SETCAB +SQUOZE 10,ORCA +SQUOZE 10,ORCAI +SQUOZE 10,ORCAM +SQUOZE 10,ORCAB +SQUOZE 10,SETCM +SQUOZE 10,SETCMI +SQUOZE 10,SETCMM +SQUOZE 10,SETCMB +SQUOZE 10,ORCM +SQUOZE 10,ORCMI +SQUOZE 10,ORCMM +SQUOZE 10,ORCMB +SQUOZE 10,ORCB +SQUOZE 10,ORCBI +SQUOZE 10,ORCBM +SQUOZE 10,ORCBB +SQUOZE 10,SETO +SQUOZE 10,SETOI +SQUOZE 10,SETOM +SQUOZE 10,SETOB + +; 500-577 (HLL - HLRES) + +SQUOZE 10,HLL +SQUOZE 10,HLLI +SQUOZE 10,HLLM +SQUOZE 10,HLLS +SQUOZE 10,HRL +SQUOZE 10,HRLI +SQUOZE 10,HRLM +SQUOZE 10,HRLS +SQUOZE 10,HLLZ +SQUOZE 10,HLLZI +SQUOZE 10,HLLZM +SQUOZE 10,HLLZS +SQUOZE 10,HRLZ +SQUOZE 10,HRLZI +SQUOZE 10,HRLZM +SQUOZE 10,HRLZS +SQUOZE 10,HLLO +SQUOZE 10,HLLOI +SQUOZE 10,HLLOM +SQUOZE 10,HLLOS +SQUOZE 10,HRLO +SQUOZE 10,HRLOI +SQUOZE 10,HRLOM +SQUOZE 10,HRLOS +SQUOZE 10,HLLE +SQUOZE 10,HLLEI +SQUOZE 10,HLLEM +SQUOZE 10,HLLES +SQUOZE 10,HRLE +SQUOZE 10,HRLEI +SQUOZE 10,HRLEM +SQUOZE 10,HRLES +SQUOZE 10,HRR +SQUOZE 10,HRRI +SQUOZE 10,HRRM +SQUOZE 10,HRRS +SQUOZE 10,HLR +SQUOZE 10,HLRI +SQUOZE 10,HLRM +SQUOZE 10,HLRS +SQUOZE 10,HRRZ +SQUOZE 10,HRRZI +SQUOZE 10,HRRZM +SQUOZE 10,HRRZS +SQUOZE 10,HLRZ +SQUOZE 10,HLRZI +SQUOZE 10,HLRZM +SQUOZE 10,HLRZS +SQUOZE 10,HRRO +SQUOZE 10,HRROI +SQUOZE 10,HRROM +SQUOZE 10,HRROS +SQUOZE 10,HLRO +SQUOZE 10,HLROI +SQUOZE 10,HLROM +SQUOZE 10,HLROS +SQUOZE 10,HRRE +SQUOZE 10,HRREI +SQUOZE 10,HRREM +SQUOZE 10,HRRES +SQUOZE 10,HLRE +SQUOZE 10,HLREI +SQUOZE 10,HLREM +SQUOZE 10,HLRES + +; 600-677 (TRN - TSON) + +SQUOZE 10,TRN +SQUOZE 10,TLN +SQUOZE 10,TRNE +SQUOZE 10,TLNE +SQUOZE 10,TRNA +SQUOZE 10,TLNA +SQUOZE 10,TRNN +SQUOZE 10,TLNN +SQUOZE 10,TDN +SQUOZE 10,TSN +SQUOZE 10,TDNE +SQUOZE 10,TSNE +SQUOZE 10,TDNA +SQUOZE 10,TSNA +SQUOZE 10,TDNN +SQUOZE 10,TSNN +SQUOZE 10,TRZ +SQUOZE 10,TLZ +SQUOZE 10,TRZE +SQUOZE 10,TLZE +SQUOZE 10,TRZA +SQUOZE 10,TLZA +SQUOZE 10,TRZN +SQUOZE 10,TLZN +SQUOZE 10,TDZ +SQUOZE 10,TSZ +SQUOZE 10,TDZE +SQUOZE 10,TSZE +SQUOZE 10,TDZA +SQUOZE 10,TSZA +SQUOZE 10,TDZN +SQUOZE 10,TSZN +SQUOZE 10,TRC +SQUOZE 10,TLC +SQUOZE 10,TRCE +SQUOZE 10,TLCE +SQUOZE 10,TRCA +SQUOZE 10,TLCA +SQUOZE 10,TRCN +SQUOZE 10,TLCN +SQUOZE 10,TDC +SQUOZE 10,TSC +SQUOZE 10,TDCE +SQUOZE 10,TSCE +SQUOZE 10,TDCA +SQUOZE 10,TSCA +SQUOZE 10,TDCN +SQUOZE 10,TSCN +SQUOZE 10,TRO +SQUOZE 10,TLO +SQUOZE 10,TROE +SQUOZE 10,TLOE +SQUOZE 10,TROA +SQUOZE 10,TLOA +SQUOZE 10,TRON +SQUOZE 10,TLON +SQUOZE 10,TDO +SQUOZE 10,TSO +SQUOZE 10,TDOE +SQUOZE 10,TSOE +SQUOZE 10,TDOA +SQUOZE 10,TSOA +SQUOZE 10,TDON +SQUOZE 10,TSON + +EISYM1: + +; I/O INSTRUCTIONS + +SQUOZE 4,BLKI +BLKI IOINST +SQUOZE 4,DATAI +DATAI IOINST +SQUOZE 4,BLKO +BLKO IOINST +SQUOZE 4,DATAO +DATAO IOINST +SQUOZE 4,CONO +CONO IOINST +SQUOZE 4,CONI +CONI IOINST +SQUOZE 4,CONSZ +CONSZ IOINST +SQUOZE 4,CONSO +CONSO IOINST + +;EXTEND MNEMONICS + +SQUOZE 10,CMPSL +001000,, +SQUOZE 10,CMPSE +002000,, +SQUOZE 10,CMPSLE +003000,, +SQUOZE 10,EDIT +004000,, +SQUOZE 10,CMPSGE +005000,, +SQUOZE 10,CMPSN +006000,, +SQUOZE 10,CMPSG +007000,, +SQUOZE 10,CVTDBO +010000,, +SQUOZE 10,CVTDBT +011000,, +SQUOZE 10,CVTBDO +012000,, +SQUOZE 10,CBTBDT +013000,, +SQUOZE 10,MOVSO +014000,, +SQUOZE 10,MOVST +015000,, +SQUOZE 10,MOVSLJ +016000,, +SQUOZE 10,MOVSRJ +017000,, +SQUOZE 10,XBLT +020000,, + +;OLD PROGRAMS USE THESE NAMES + +SQUOZE 10,CLEAR +SETZ +SQUOZE 10,CLEARI +SETZI +SQUOZE 10,CLEARM +SETZM +SQUOZE 10,CLEARB +SETZB + +;RANDOM ALIAS NAMES + +SQUOZE 10,ADJBP ;KL10 FORM OF IBP WITH VARIABLE NUMBER TO INCREMENT +IBP +SQUOZE 10,JFOV ;PDP10 INSTRUCTION (PC CHANGE ON PDP6) +JFCL 1, +SQUOZE 10,JCRY1 +JFCL 2, +SQUOZE 10,JCRY0 +JFCL 4, +SQUOZE 10,JCRY +JFCL 6, +SQUOZE 10,JOV +JFCL 10, +SQUOZE 10,PORTAL ;KI10 INSTRUCTION +JRST 1, +SQUOZE 10,JRSTF +JRST 2, +SQUOZE 10,HALT +JRST 4, +SQUOZE 10,XJRSTF ;KL10 INSTRUCTION +JRST 5, +SQUOZE 10,XJEN ;KL10 INSTRUCTION +JRST 6, +SQUOZE 10,XPCW ;KL10 INSTRUCTION +JRST 7, +SQUOZE 10,JEN +JRST 12, +SQUOZE 10,SFM ;KL10 INSTRUCTION +JRST 14, +SQUOZE 10,XMOVEI ;KL10 INSTRUCTION +SETMI +SQUOZE 10,XHLLI ;KL10 INSTRUCTION +HLLI + +;PDP6 HAS LONG FORM ROUNDED INSTEAD OF IMMEDIATES + +IRPS INST,,FAD FSB FMP FDV + SQUOZE 10,INST!RL + INST!RI +TERMIN + +DEFINE DEFSYM X/ + IRPS Z,,[X] + SQUOZE 10,Z + Z + .ISTOP + TERMIN +TERMIN + +IFN DECSW,[ +.DECDF DEFSYM + +IFN DECBSW,.INSRT DECBTS + +] ;IFN DECSW + +IFN TNXSW,[;; DEFINE JSYS'S ON TENEX VERSION +.TNXJS DEFSYM +.INSRT TWXBTS +] ;IFN TNXSW + +SQUOZE 10,.OSMID +OSMIDAS +SQUOZE 4,.SITE +A.SITE +SQUOZE 4,RIM10 +ARIM10,,SRIM +SQUOZE 4,SBLK +SBLKS,,SRIM +SQUOZE 4,RIM +ARIM,,SRIM +SQUOZE 4,SQUOZE +ASQOZ +SQUOZE 4,.RSQZ +-1,,ASQOZ +SQUOZE 4,XWD +AXWORD +SQUOZE 4,CONSTA +CNSTNT +SQUOZE 4,ASCIC +EOFCH,,AASCIZ +SQUOZE 4,RADIX +ARDIX + +SQUOZE 4,END +AEND +SQUOZE 4,TITLE +ATITLE +SQUOZE 4,.BEGIN +A.BEGIN +SQUOZE 4,.END +A.END +SQUOZE 4,VARIAB +AVARIAB +SQUOZE 4,SIXBIT +ASIXBIT +SQUOZE 4,ASCII +AASCII +SQUOZE 4,ASCIZ +AASCIZ +SQUOZE 4,.ASCII +A.ASCII +SQUOZE 4,.ASCVL +A.ASCV +SQUOZE 4,BLOCK +ABLOCK +SQUOZE 4,LOC +ALOC +SQUOZE 4,OFFSET +AOFFSET +SQUOZE 4,.SBLK +SIMBLK +SQUOZE 4,RELOCA +ARELOCA +SQUOZE 4,1PASS +A1PASS +SQUOZE 4,.DECSA +A.DECSA +SQUOZE 4,.DECRE +A.DECRE +SQUOZE 4,.DECTX +A.DCTX + +SQUOZE 4,.DECTW +A.DECTW +SQUOZE 4,NOSYMS +ANOSYMS +SQUOZE 4,EXPUNGE +AEXPUNGE +SQUOZE 4,EQUALS +AEQUALS +SQUOZE 4,NULL +ANULL +SQUOZE 4,SUBTTL +ANULL +SQUOZE 4,WORD +AWORD +SQUOZE 4,.SYMTAB +A.SYMTAB +SQUOZE 4,.SEE +A.SEE +SQUOZE 4,.AUXIL +MACCR +SQUOZE 4,.MRUNT +A.MRUNT +SQUOZE 4,.SYMCN +A.SYMC +SQUOZE 4,.TYPE +A.TYPE +SQUOZE 4,.FORMAT +A.FORMAT +SQUOZE 4,.OP +A.OP +SQUOZE 4,.AOP +A.AOP +SQUOZE 4,.RADIX +A.RADIX +SQUOZE 4,.FATAL +A.FATAL +SQUOZE 4,.BP +A.BP +SQUOZE 4,.BM +A.BM +SQUOZE 4,.LZ +A.LZ +SQUOZE 4,.TZ +A.TZ +SQUOZE 4,.DPB +A.DPB +SQUOZE 4,.LDB +A.LDB +SQUOZE 4,.1STWD +A.1STWD +SQUOZE 4,.NTHWD +A.NTHWD + +IRPS X,,[.BIND=0,.KILL=3KILL,.HKILL=3SKILL,.XCREF=3NCRF,.DOWN=3DOWN] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,A.KILL +TERMIN + +SQUOZE 4,.LSTON +A.LSTN +SQUOZE 4,.LSTOF +A.LSTF + +IRPS X,,[.MLLIT=CONSML,.PASS=A.PASS,.PPASS=A.PPASS,.SUCCESS=A.SUCCESS +.HKALL=HKALL,.STGSW=STGSW,.LITSW=LITSW,.AVAL1=AVAL1,.AVAL2=AVAL2,.ERRCNT=ERRCNT +.ASKIP=A.ASKIP,.CURLN=CLNN,.CURPG=CPGN,.QMTCH=QMTCH,.STPLN=A.STPLN,.STPPG=A.STPPG] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,INTSYM +TERMIN + +;CONDITIONALS (SEE ALSO IFSE, IFSN) + +SQUOZE 4,IFG +JUMPG A,COND +SQUOZE 4,IFGE +JUMPGE A,COND +SQUOZE 4,IFE +JUMPE A,COND +SQUOZE 4,IFLE +JUMPLE A,COND +SQUOZE 4,IFL +JUMPL A,COND +SQUOZE 4,IFN +JUMPN A,COND +SQUOZE 4,.ELSE +SKIPE A.ELSE +SQUOZE 4,.ALSO +SKIPN A.ELSE + +SQUOZE 4,IF1 +TRNE FF,COND1 +SQUOZE 4,IF2 +TRNN FF,COND1 +SQUOZE 4,IFDEF ;ASSEMBLE IF SYM DEFINED +JUMPG A,DEFCND +SQUOZE 4,IFNDEF ;ASSEMBLE IF SYM NOT DEFINED +JUMPE A,DEFCND +SQUOZE 4,IFB ;ASSEMBLE IF STRING BLANK (HAS NO SQUOZE CHARS) +JUMPLE C,SBCND +SQUOZE 4,IFNB ;ASSEMBLE IF STRING NOT BLANK +JUMPG C,SBCND +SQUOZE 4,IFSQ ;ASSEMBLE IF STRING ARG IS ALL SQUOZE +JUMPLE B,SBCND +SQUOZE 4,IFNSQ ;ASSEMBLE IF STRING ARG IS NOT ALL SQUOZE. +JUMPG B,SBCND + +SQUOZE 4,PRINTX +APRIN2,,APRINT +SQUOZE 4,PRINTC +APRIN3,,APRINT +SQUOZE 4,COMMEN +APRIN1,,APRINT +SQUOZE 4,.TYO +A.TYO +SQUOZE 4,.TYO6 +A.TYO6 +SQUOZE 4,.ERR +A.ERR + +SQUOZE 4,.RELP +A.RELP +SQUOZE 4,.ABSP +A.ABSP +SQUOZE 4,.RL1 +A.RL1 +SQUOZE 4,.LIBRA +LLIB,,A.LIB +SQUOZE 4,.LENGTH +A.LENGTH +SQUOZE 4,.LIFS +LTCP,,A.LIB +SQUOZE 4,.ELDC +A.ELDC +IRPS A,,E N G LE GE L +SQUOZE 4,.LIF!A +JUMP!A A.LDCV +TERMIN +SQUOZE 4,.SLDR +A.SLDR + +SQUOZE 4,. +GTVLP +SQUOZE 4,.LOP +A.LOP +SQUOZE 40,$. +0 +SQUOZE 44,$R. +0 +SQUOZE 40,$O. ;(OH) GLOBAL OFFSET +0 +SQUOZE 40,$L. ;REAL LOCATION (WITHOUT OFFSET) +0 +SQUOZE 40,.LVAL1 +0 +SQUOZE 40,.LVAL2 +0 +SQUOZE 4,.LNKOT +A.LNKOT +SQUOZE 4,.NSTGW +1,,STGWS +SQUOZE 4,.YSTGW +-1,,STGWS +SQUOZE 4,.LIBRQ +A.LIBRQ +SQUOZE 4,.GLOBAL +ILGLI,,A.GLOB +SQUOZE 4,.SCALAR +ILVAR,,A.GLOB +SQUOZE 4,.VECTOR +ILVAR\ILFLO,,A.GLOB + +SQUOZE 4,.BYTC +NBYTS,,INTSYM +SQUOZE 4,.BYTE +A.BYTE +SQUOZE 4,.WALGN +A.WALGN + +;CREF PSEUDO-OPS. +SQUOZE 4,.CRFON +A.CRFN ;START CREFFING. +SQUOZE 4,.CRFOFF +A.CRFFF ;STOP CREFFING. +SQUOZE 4,.CRFIL +CRFILE,,INTSYM + +IFE CREFSW,[ + A.CRFN==ASSEM1 ;THESE DO NOTHING IF CAN'T CREF. + A.CRFFF==ASSEM1 +] + +IFN MACSW,[ ;MACRO PROCESSOR PSEUDOS +;MACROS GET DEFINED AS +;SQUOZE 4, +;,, MACCL + +SQUOZE 4,REPEAT +AREPEAT +SQUOZE 4,DEFINE +ADEFINE +SQUOZE 4,IRP +NIRPO,,AIRP +SQUOZE 4,IRPC +NIRPC,,AIRP +SQUOZE 4,IRPS +NIRPS,,AIRP +SQUOZE 4,IRPW +NIRPW,,AIRP +SQUOZE 4,IRPNC +NIRPN,,AIRP +SQUOZE 4,TERMIN +ATERMIN +SQUOZE 4,.QUOTE +A.QOTE +SQUOZE 4,.STOP +(400000)A.STOP +SQUOZE 4,.ISTOP +A.STOP +SQUOZE 4,.RPCNT +CRPTCT,,INTSYM +SQUOZE 4,.GSSET +A.GSSET +SQUOZE 4,.GSCNT +GENSM,,INTSYM +SQUOZE 4,.GO +A.GO +SQUOZE 4,.TAG +A.TAG +SQUOZE 4,.IRPCNT +CIRPCT,,INTSYM +IFN RCHASW,[SQUOZE 4,.TTYMAC +A.TTYM +] +SQUOZE 4,IFSE +SKIPN SCOND +SQUOZE 4,IFSN +SKIPE SCOND +] + +IFN FASLP,[ +SQUOZE 4,.FASL +A.FASL +SQUOZE 4,.ARRAY ;3 INDEX TO AFDMY1 TBL +AFATOM(3) +SQUOZE 4,.ATOM +AFATOM(AFDMAI) ;2 INDEX TO AFDMY1 TBL +AFDMAI==2 ;INDEX OF ATOM IN AFDMY1 TBL +SQUOZE 4,.FUNCT +AFATOM(1) ;1 " " " " +SQUOZE 4,.SPECI +AFATOM(0) ;0 " " " " +SQUOZE 4,.SX +AFLIST(1) ;NORMAL LIST +SQUOZE 4,.SXEVA +AFLIST ;EVAL LIST AND THROW VALUE AWAY +SQUOZE 4,.SXE +AFLIST(2) ;EVAL LIST AND "RETURN" VALUE +SQUOZE 4,.ENTRY +AFENTY ;DECLARE LISP ENTRY POINT (SUBR ETC) +] + +IFN TS,[ +SQUOZE 4,.FNAM1 +RFNAM1,,INTSYM +SQUOZE 4,.FNAM2 +RFNAM2,,INTSYM +SQUOZE 4,.INSRT +A.INSRT +SQUOZE 4,.INEOF +A.INEO +IRPS X,,I O +IRPS Y,,1 2 +SQUOZE 4,.!X!FNM!Y +X!FNM!Y,,INTSYM +TERMIN TERMIN +SQUOZE 4,.TTYFLG +A.TTYFLG,,INTSYM +] +IFN .I.FSW,[ +SQUOZE 4,.F +A.F +SQUOZE 4,.I +A.I +] +IFN ITSSW,[ +IRPS X,,UAI UAO BAI BAO UII UIO BII BIO +SQUOZE 10,.!X +.IRPCN +TERMIN + +IRPS X,Y,START LFILE STP+SYM JCL PFILE STB CONV+XUNAME XJNAME LJB+ + SQUOZE 10,..R!X + .IRPCN+1 +IFSN Y,+,[ + SQUOZE 10,..S!X + 400000+.IRPCN+1 +] TERMIN +] + +EISYMT: PRINTA \.-MACTBA-1, words initialization coding. + VARIAB +IFN .-EISYMT,.ERR Non-empty variables area + +IFN DECSW,[ + IFGE .-MACTBA-MACL,[ +IFN MACL, PRINTA [MACL too small, set to ]\.-MACTBA + MACL==.-MACTBA +]] + +IFN ITSSW\TNXSW,[ +IFGE .+2400-MACTBA-MACL,.ERR MACL too small + LOC <.+1777>&-2000 +MXICLR==./2000 ;FIRST PAGE ABOVE INITIALIZING CODING + LOC &-2000 +MXIMAC==./2000 ;FIRST PAGE ABOVE INITIAL MACTBA +MAXMAC==/2000 + ;1ST PAGE MACRO TABLE CAN'T POSSIBLY USE. +IFLE MINPUR-MAXMAC,.ERR Pure too low. +PRINTA MINPUR-MAXMAC = ,\MINPUR-MAXMAC +] + +IFN TS,END BEG +END diff --git a/src/midas/midas.412 b/src/midas/midas.412 new file mode 100644 index 00000000..71be7655 --- /dev/null +++ b/src/midas/midas.412 @@ -0,0 +1,11917 @@ +; -*-MIDAS-*- +IFE .OSMIDAS-SIXBIT/DEC/,.SYMTAB 4003.,2000. ;THIS MANY ON DEC SYSTEM +.ELSE .SYMTAB 8003. ;ELSEWHERE ASSEMBLE FASTER. + +TITLE MIDAS +SUBTTL INITIAL DEFINITIONS + +; AC DEFINITIONS. FF AND P MUST BE 0 AND 17 RESPECTIVELY, OTHERWISE +; ONLY CONSTRAINTS ARE EXPRESSED AS SEQUENTIAL ORDERINGS, E.G. B+1 ETC. +; ALSO, +.SEE R1 + +FF=:0 ; FLAGS. MUST BE AC 0. +AA=:1 ; GENERAL PURPOSE REGS, MUST BE SEQUENTIAL. +A=:AA+1 ; 2 +B=:A+1 ; 3 +C=:B+1 ; 4 +D=:C+1 ; 5 +T=:6 ; NOT SO TEMP AS IN MOST PROGS W/ T +TT=:T+1 ; 7 +I=:10 ; INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF +SYM=:11 ; FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR +LINK=:SYM+1 +F=:13 +CH1=:14 ; MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH +CH2=:CH1+1 ;" " " +TM=:16 ; SUPER TEMPORARY +P=:17 ; PDL AC, MUST BE 17. AS WELL AS RANDOM CROCKS IN PROGRAM, 20X ERCAL + ; ASSUMES P=17. + + +IFDEF .XCREF, .XCREF FF,P,I,A,B,C,D,T + +;OPERATING SYSTEM CONDITIONAL FLAGS: +; ITSSW IS 1 IF TO RUN ON ITS. +; DECSW IS 1 IF TO RUN ON ANY SORT OF BOTTOMS-10 (INCL. SAIL AND CMU). +; TNXSW IS 1 IF TO RUN ON TENEX OR TWENEX. +; SAILSW IS 1 IF TO RUN ON SAIL, AS OPPOSED TO OTHER BOTS-10. +; CMUSW IS 1 IF TO RUN AT CMU, AS OPPOSED TO OTHER BOTS-10. +; DECDBG IS 1 (ONLY WHEN DECSW IS 1) TO LEAVE SPACE FOR SYMBOL TABLE +; TO BE MOVED TO AFTEREXECUTION IS STARTED. +; DECBSW IS 1 TO PUT DECBTS IN THE PREDEFINED SYMBOL TABLE (ONLY IF DECSW IS 1). +; SMALSW IS 1 TO OCCUPY AS LITTLE CORE AS POSSIBLE. +; TS IS 1 EXCEPT FOR NON-TIMESHARED VERSION (WHICH IS OBSOLETE). + +IF1,[ ;FOR PASS 1 TTY CONDITIONALS +IFDEF SAILSW,IFN SAILSW,DECSW==1 +IFDEF CMUSW,IFN CMUSW,DECSW==1 +IFDEF DECDBG,IFN DECDBG,DECSW==1 +IFDEF DECSW,IFN DECSW,DECSW==1 ? ITSSW==0 ? TNXSW==0 +IFDEF ITSSW,IFN ITSSW,ITSSW==1 ? DECSW==0 ? TNXSW==0 +IFDEF TNXSW,IFN TNXSW,TNXSW==1 ? DECSW==0 ? ITSSW==0 +] ; IF1 +IFNDEF ITSSW,ITSSW==IFDEF .IOT,[1] .ELSE 0 ;NON-ZERO => ITS VERSION +IFNDEF TNXSW,TNXSW==IFDEF GTJFN,[1] .ELSE 0 ;NON-ZERO => TENEX VERSION +IFNDEF DECSW,DECSW==IFDEF LOOKUP,[1-TNXSW] .ELSE 0 ;NON-ZERO => DEC VERSION + ; TNXSW SINCE OLD VERSIONS OF TENEX MIDAS HAD DEC + ; UUO'S DEFINED TOO ONCE UPON A TIME +IF1 IFN ITSSW+DECSW+TNXSW-1,.FATAL So what monitor is MIDAS supposed to run under? +IFNDEF DECDBG,DECDBG==0 ;NON-ZERO => DEC VERSION TO RUN WITH DEC DDT. +IFN DECSW,[ +IFNDEF SAILSW,SAILSW==IFDEF SPCWAR,[1] .ELSE 0 ;NON-ZERO => SAIL VERSION. +IFNDEF CMUSW,CMUSW==IFDEF CMUDEC,[1] .ELSE 0 ;NON-ZERO => CMU VERSION. +] +IFE DECSW,SAILSW==0 ? CMUSW==0 ;CAN'T BE SAIL OR CMU FOR ITS OR TENEX VERSION +IFNDEF SMALSW,SMALSW==DECSW- ;NON-ZERO => SMALL MIDAS (NORMALLY + ; FOR RANDOM DEC SITES ONLY) +IFNDEF DECBSW,DECBSW==DECSW*<1-SAILSW>*<1-SMALSW> + ;NON-ZERO => INCLUDE DECBTS +IFN ITSSW\DECSW\TNXSW,TS==1 +IFNDEF TS,TS==1 ;NON-ZERO => TIME-SHARING VERSION +IFE TS,1PASS +IFNDEF A1PSW, A1PSW==TS ;NON-ZERO => 1PASS END-OF-PROGRAM AUTO-REASSEMBLY +IFNDEF BRCFLG, BRCFLG==0 ;NON-ZERO => BRACES { AND } ARE SPECIAL IN MACRO + ; ARGS, ETC. JUST LIKE BRACKETS. BRACES ARE SPECIAL + ; IN CONDITIONALS REGARDLESS OF BRCFLG. +IFNDEF CREFSW, CREFSW==ITSSW ;NON-ZERO => ALLOW C SWITCH TO CAUSE CREF OUTPUT. +IFNDEF LISTSW, LISTSW==1 ;NON-ZERO => ALLOW L SWITCH TO CAUSE A LISTING. +IFNDEF RCHASW, RCHASW==TS ;NON-ZERO => INCLUDE TTY AS POSSIBLE INPUT DEVICE +IFNDEF PURESW, PURESW==TS-SAILSW ;NON-ZERO => SEPARATE PURE CODING FROM IMPURE AND + ; DO PAGE SKIPS. TWO SEGMENTS HURTS EFFICIENCY AT SAIL. +IFNDEF FASLP, FASLP==1-SMALSW ;NON-ZERO => INCLUDE FASL OUTPUT CAPABILITY + ; NOTE!! IF RUNNING UNDER 10/50 THIS MAKES THINGS + ; SEVERAL K BIGGER THAN OTHERWISE. +IFNDEF .I.FSW, .I.FSW==1-SMALSW;NON-ZERO => INCLUDE .I, .F +IFNDEF MACSW, MACSW==1 ;NON-ZERO => INCLUDE MACRO PROCESSOR (!) +IFNDEF RUNTSW, RUNTSW==1 ;NON-ZERO => TYPE OUT RUN TIME AT END OF ASSEMBLY +IFNDEF WRQTSW, WRQTSW==1 ;WRQOTE (MACRO DEFINITION READER) VERSION + ; ^ 0 => SLOW, 1 => FAST; MAYBE 2 WILL EVENTUALLY BE CREATED +IFE TS,IFNDEF MACL,MACL==6*2000 ;MACRO TABLE SIZE +IFN TS,[ +IFN ITSSW,IFNDEF MACL,MACL==6000;DEFAULT MACL SIZE FOR ITS. IF WE HAVE DECBTS OR +IFN TNXSW,IFNDEF MACL,MACL==12*2000 ; TWXBTS, THIS GETS INCREASED, CAUSE THEY ARE HUGE! +IFN DECSW,IFNDEF MACL,MACL==0 ;NON-ITS: WE WANT MACL TO JUST COVER THE INIT CODE. +IFNDEF MXMACL,MXMACL==32.*2000 ;MAXIMUM LENGTH MACTAB +] +IFNDEF MACRUM,MACRUM==4 ;# WORDS NOT USED AT END OF MACTAB +IFNDEF STRL,STRL==20 ;LENGTH OF STRING STORAGE (USED BY GSYL) +IFNDEF DMDEFL,DMDEFL==40 ;MAX NO OF DMY ARGS IN DEFINE +IFNDEF DMYAGL,DMYAGL==400 ;MAX NO COMBINED DMYARGS ALL MACROS CURRENTLY EXPANDING OR PUSHED +IFNDEF MPDLL,MPDLL==300 ;MACRO PDL LENGTH +IFNDEF DSSIZ,DSSIZ==40 ;MAX # ARGS MACRO WHOSE ARGS BEING SCANNED (SHOULD BE .GE. DMDEFL) +IFNDEF BKTABL,BKTABL==40 ;MAX NUM .BEGIN BLOCKS. +IFNDEF BKPDLS,BKPDLS==10 ;MAXIMUM .BEGIN BLOCK NESTING DEPTH. +IFNDEF BSIZE,BSIZE==37 ;PREFERRED SIZE BLOCK MAX SIZE-3 +IFN SMALSW,IFNDEF LPDL,LPDL==200. +IFNDEF LPDL,LPDL==500. ;LENGTH OF PDL +IFN SMALSW,IFNDEF CONMIN,CONMIN==1000 +IFNDEF CONMIN,CONMIN==3300 ;MINIMUM AMT OF SPACE FOR CONSTANTS TABLES. +IFNDEF CONMAX,CONMAX==20000 ;MAXIMUM SPACE USER CAN ASK FOR. +IFNDEF NCONS,NCONS==75. ;MAXIMUM NUMBER OF CONSTANTS AREAS +IFNDEF NVARS,NVARS==25. ;MAX. NUM. VARIABLES AREAS. +IFN SMALSW,IFNDEF SYMDSZ,SYMDSZ==2003. +IFN TNXSW, IFNDEF SYMDSZ,SYMDSZ==4003. ; MUST INCLUDE TONS OF SYSTEM DEFS +IFNDEF SYMDSZ,SYMDSZ==2707. ;DEFAULT # SYMS IN SYMTAB. +IFNDEF SYMMSZ,SYMMSZ==10177*2 ;# SYMS IF JNAME IS MMIDAS. +IFNDEF SYMMAX,SYMMAX==40000 ;MAX SYMTAB SIZE (# SYMS) +IFNDEF FASBL,FASBL==400 ;WORDS USED FOR FASL OUTPUT BUFFER + ; MUST HOLD STUFF ASSOC WITH ONE GROUP OF 9 CODE BYTES +IFNDEF FASATL,FASATL==2000 ;WORDS USED FOR FASL ATOM TABLE + ; HOLDS PNAMES ETC OF ALL ATOMS AS WILL BE IN FASLOAD'S + ; SYMTAB AT LOAD TIME +IFNDEF MINWPS,MINWPS==3 ;MIN # WORDS IN SYMTAB ENTRY +IFNDEF MAXWPS,MAXWPS==3 ;MAX # ALLOWED (WILL BE BIGGER SOME DAY) +IFNDEF NRMWPS,NRMWPS==3 ;DEFAULT #. 2 WDS FOR VALUE & FLAGS, 1 FOR NAME. + +; VERSION, FLAGS, ETC. + +IF1 [ + +IFNDEF MIDVRS,MIDVRS=.FNAM2 +IFE MIDVRS-SIXBIT/MID/,[ +PRINTX /What is MIDAS version number? / +.TTYMAC VRS +MIDVRS=SIXBIT/VRS/ +TERMIN +] + +;OSMIDAS GETS THE SIXBIT NAME OF THE TYPE OF OP. SYS. THE VERSION OF MIDAS +;IS BEING ASSEMBLED TO RUN UNDER. IT WILL BE THE VALUE OF ".OSMIDAS" WHEN PROGRAMS +;ARE ASSEMBLED WITH THIS MIDAS. NOTE THAT TNX VERSION ACTUALLY SETS IT +;AT RUNTIME STARTUP TO "TENEX" OR "TWENEX" AS APPROPRIATE. +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/ + +;FF FLAGS NOT PUSHED +;LEFT HALF +FL==1,,525252 +FLPPSS==400000 ;ONE IF PUNCHING PASS; MUST BE SIGN +FLHKIL==100000 ;ONE IF SYM TO BE SEMI KILLED IN DDT + +FLVOT== 40000 ;ALL RCH S MUST GO THRU RCH + ; IE TYPCTL .NE. POPJ P, (SET/CLEARED BY MDSSET, MDSCLR) +FLMAC== 20000 ;ONE IF CHARS COMING FROM MACRO PROCESSOR, DON'T HACK CPGN/CLNN +FLTTY== 10000 ;ONE IF CHARS FROM SOMEWHERE ELSE BUT NOT HACKING CPGN/CLNN +$FLOUT== 4000 ;ONE IF OUTPUT HAS OCCURED IN CURRENT MODE (USED BY TS NED LOGIC) +FLPTPF== 2000 ;SET IF (TIME SHARING) OUTPUT DEVICE IS PTP +FLUNRD== 1000 ;=> RE-INPUT LAST CHARACTER (SEE RCH) +FL20X==400 ; IN TENEX VERSION, 1= RUNNING ON TOPS-20, 0 = TENEX. + +;FF RIGHT HALF FLAGS + +FR==525252 +FRFIRWD==400000 ;ONE FOR FIRST WORD OF BLOCK +FRSYMS==200000 ;ONE IF SYM PUNCH DESIRED +FRLOC==100000 ;ONE BETWEEN ABS LOC ASSIGN AND + ;FIRST BLOCK OUTPUT THEREAFTER (EBLK TO OUTPUT NULL BLOCK SO LINKING LOADER KNOWS $.) + +FRNPSS==40000 ;ONE IF TWO PASS ASSEMBLY +FRPSS2==20000 ;ONE ON PASS 2 + +FRINVT==4000 ;USED BY PBITS AND OUTPUT TO OUTPUT WORDS OF CODE BITS IN CORRECT ORDER (STEAD LOGICAL) +FRNLIK==2000 ;TEMPORARILY SUPPRESS ADR LINKING +FRGLOL==1000 ;ONE IF LOCATION PLUS OFFSET IS GLOBAL + +FRBIT7==400 ;SET IF LAST TIPLE OF CODEBITS WAS 7. +FRMRGO==200 ;MACRO PROC TO RETURN TO .GO HACKER W/O READING NEXT CHAR (SEE RCHSAV) + +FRCMND==40 ;SET WHILE READING CMD, TELLS RFD TO NOTICE (, _, COMMA. +FRNNUL==20 ;SET ON RETURN FROM RFD IFF NONNULL SPEC. +FRARRO==10 ;TELLS RFD THAT 1ST NAME IS FN1, NOT FN2. +FRFN1==4 ; TELLS RFD THAT 1ST NAME WAS READ. + + + ; FLAGS TO ZERO AT BEGINNING OF PASS 1 ONLY, BY $INIT. +FFINIT==<-1-FLVOT-FLPTPF-FLTTY-FL20X,,-1> + +] ;END IF1 + +;INDICATOR REGISTER + +IF1 [ + +;LEFT HALF +IL==1,,525252 +ILGLI==1 ;SET ON " CLEARED EACH SYL +ILVAR==2 ;SET ON ' " " " +ILFLO==4 ;FLOATING NUM, SET ON DIGIT AFTER . +ILDECP==10 ;DECIMAL PREFER, SET WHEN . SEEN. +ILUARI==20 ;1 => RIGHT OPERAND TO UPARROW BEING READ +ILLSRT==40 ;RETURN FROM < +ILWORD==400 ;SET IF CURRENT WORD IS NOT NULL RETURNED BY GETWORD +ILNPRC==1000 ;ONE IF NUMBER ALREADY PROCESSED BY UPARROW +ILMWRD==4000 ;SET ON MULTIPLE WORD +ILPRN==10000 ;SET DURING MACCL IF MACRO NAME WAS FOLLOWED BY (. +ILMWR1==20000 ;SET BY LBRAK AS SIGNAL TO ITSELF THAT THIS NOT FIRST + ;WORD OF MULTI-WORD CONSTANT +ILNOPT==40000 ;CONSTANTS OPTIMIZATION SUPPRESSION FLAG; SHOULD BE SET BY + ;VALUE-RETURNING PSEUDO DURING NOT PUNCHING PASS TO KEEP ITSELF OUT OF + ;CONSTANTS OPTIMIZATION + +;RIGHT HALF + +IR==525252 +IRFLD==1 ;SET IF FLD NOT NULL +IRSYL==2 ;SET IF SYL NOT NULL +IRLET==4 ;SET IF SYL IS SYMBOL +IRDEF==10 ;SET IF CURRENT EXPR DEFINED +IRNOEQ==20 ;SET IF = ISN'T ALLOWED IN CURRENT CONTEXT. +IRCOM==40 ;SET IF CURRENT QUAN IS COMMON +IRPERI==100 ;SET IF PERIOD SEEN IN WHAT IS SO FAR (INCL .) A NUMBER +IREQL==200 ;ONE DURING READING WORD TO RIGHT OF = +IRIOINS==400 ;FIRST FIELD OF CURRENT WORD HAS IO INST +IRCONT==1000 ;SET IF NOT OK TO END BLOCK +IRPSUD==4000 ;SET IF ERROR COMMENTS WILL COME FROM PSEUDO +IRGMNS==20000 ;SET IF ILUARI OR BAKARI HAS GOBBLED MINUS +IROP==200000 ;SET IF OPERATOR SEEN IN CURRENT FIELD + +CALL==PUSHJ P, +RET==POPJ P, +;SAVE=PUSH P, ;DON'T USE SAVE! IT'S A JSYS ON TENEX AND TWENEX +REST==POP P, +PJRST==JRST ; FOR JRST'ING TO A POPJ'ING ROUTINE. + +ETSM=1000,, ;ERROR, TYPE SYM. +ETR=2000,, ;ERROR, ORDINARY MESSAGE. +ERJ=3000,, ;ERROR, NO MESSAGE, RETURN TO ADDR. +ETI=4000,, ;ERROR, IGNORE LINE, RET. TO ASSEM1. +ETA=5000,, ;ERROR, RET. TO ASSEM1. +ETASM=6000,, ;ERROR, TYPE SYM AND RETURN TO ASSEM1 +ETF=7000,, ;FATAL ERROR. +TYPR=(37000) ;UUO, TYPE OUT ASCIZ STRING +TYPCR=(36000) ; LIKE TYPR BUT ADDS CR AT END. +] ;END IF1 + +IF1 [ +;LINK TABLE (GLOTB), ACCUMULATES GLOBAL REFERENCES FOR CURRENT FROB (USUALLY WORD) TO OUTPUT +;GLSP2 POINTS TO (I.E. HAS ADR 1 LESS THAN) BOTTOM OF ACTIVE PART OF TABLE +;GLSP1 POINTS TO TOP (HAS ADR OF LAST ENTRY ACTIVE) + +;ACTUAL ENTRIES IN GLOTB: +;IF ENTIRE WORD ZERO, ENTRY IS NULL, WILL (OR SHOULD) BE IGNORED +;RH ADR OF SQUOZE WITH INTERNAL MIDAS FLAGS (USUALLY IN SYMBOL TABLE, BUT MAY BE ANYWHERE IN CORE) +;LH: RIGHT 10. BITS MULTIPLICATION FACTOR OR 0 => 1 + ;GLOBAL SHOULD BE MULTIPLIED BY IT +;REST OF LH FLAGS: + +;SIGN BIT => THIS NOT PART OF FIELD, DON'T PLAY WITH FLAGS AT GETFLD, INTFD +ACF==40000 ;AC LOW OR HIGH (SWAPF => HIGH) +HFWDF==100000 ;MASK GLOBAL TO HALFWORD +SWAPF==200000 ;SWAP +MINF==20000 ;NEGATIVE OF GLOBAL + +IFNDEF LBRKT,LBRKT=="[ ;LEFT DELIMITER FOR EXPLICITLY GROUPED CONDITIONALS, MACRO ARGS, REPEAT BODY, ETC. +IFNDEF RBRKT,RBRKT=="] ;RIGHT " +IFNDEF WPS, WPS==3 ;# CONTIG. WDS /STE. IFNDEF FOR DEBUGGING. +IFNDEF BKWPB,BKWPB==3 ;# WDS/BKTAB ENTRY. +IFNDEF EOFCH,EOFCH==3 ;EOF CHAR, BEWARE DISPATCH TABLE ENTRIES. +IFNDEF LBRACE,LBRACE==173 +IFNDEF RBRACE,RBRACE==175 + +;3RDWRD LH. SYM TAB BITS + +3REL==600000 ;RELOC BITS, DO NOT CHANGE, SOMETIMES REFERENCED BY NUMERIC BYTE POINTERS +3RLL==400000 ;R(LH) +3RLR==200000 ;R(RH) +3RLNK==100000 ;R(LINK) +3KILL==40000 ;FULLY-KILLED SYM (DON'T GIVE TO DDT). +3VP==20000 ;VALUE PUNCHED +3SKILL==10000 ;SEMI KILL IN DDT +3LLV==4000 ;LINKING LOADER MUST INSERT VAL +3VAS2==2000 ;VAR SEEN ON PASS TWO WITH ' +3VCNT==1000 ;USED IN CONSTANT +3MAS==400 ;THIS ISN'T THE LAST DEFINITION OF A SYM WITH THIS NAME + ;(SO ES MUST KEEP SEARCHING). +3NCRF==200 ;DON'T CREF THIS SYMBOL. +3MACOK==100 ;OK TO (RE)DEFINE THIS SYM AS MACRO. + ;(IE IS A MACRO OR SEEN ONLY IN .XCREF) +3LABEL==40 ;ILLEGAL TO REDEFINE THIS SYM TO DIFFERENT VALUE +3MULTI==20 ;THIS SYM IS MULTIPLY DEFINED, SO FLAG ALL DEFINITIONS. +3DOWN==10 ;THIS DEFINITION SHOULD BE SEEN BY SUBBLOCKS IN 1PASS MODE. + +3DFCLR==737110 ;BITS IN LH TO CLEAR ON REDEFINITION. + +; FLAGS IN "CONTROL" VARIABLE +.SEE CONTRL + ;LEFT HALF +TRIV==400000 ; 1 IF OUTPUT FORMAT IS FOR TRIVIAL LOADER (ABSOLUTE) + ; ELSE RELOCATABLE (NOTE THIS CROCKISHLY ONLY MEANS + ; STINK FORMAT, SINCE DEC RELOC FORMAT HAS THIS FLAG SET) + + ;RIGHT HALF +ARIM== 2 ; 1 => OUTPUT FORMAT IS RIM +SBLKS== 10 ; 1 => OUTPUT FORMAT IS SBLK (SIMPLE BLOCKS) +ARIM10== 20 ; 1 => OUTPUT FORMAT IS PDP-10 RIM +DECREL== 40 ; 1 => DEC RELOCATABLE FORMAT (CONSIDERED "ABSOLUTE" INSIDE MIDAS) +FASL== 100 ; 1 => LISP FASL COMPATIBLE RELOCATABLE FORMAT ( " " ") +DECSAV==200 ; 1 => DEC SAV FORMAT (ABSOLUTE) ALSO WINS ON 10X, 20X + +PTR==104 ;DEVICE CODE FOR PAPER TAPE READER. + +] ;END IF1 + +IF1 [ + +;SQUOZE FLAG DEFINITIONS IN MIDAS SYMBOL TABLE + +CMMN==0 ;COMMON (NOT USED) +PSUDO==40000 ;PSEUDO OR MACRO, VALUE RH ADDR OF RTN (MACCL FOR MACRO), + ; LH WILL BE IN LH OF B WHEN RTN CALLED. +SYMC==100000 ;SYM, VALUE IS VALUE OF SYM. +LCUDF==140000 ;LOCAL UNDEF +DEFLVR==200000 ;DEF LOC VAR, VALUE IS VALUE. +UDEFLV==240000 ;UNDEF LOC VAR, VALUE IS 1+ IDX IN VARIAB. AREA, BUT IGNORD IF VAR AREA GLOB. +LGBLCB==300000 ;CODE BITS EQUAL TO THIS OR HIGHER REPRESENT GLOBAL QUANTITIES +DEFGVR==300000 ;DEF GLO VAR, VALUE IS VALUE +UDEFGV==340000 ;UNDEF GLO VAR, VALUE LIKE UNDEF LOCAL VAR. +GLOETY==400000 ;GLO ENTRY +GLOEXT==440000 ;GLO EXIT +NCDBTS==GLOEXT_<-18.+4>+1 ;# CODE BIT TYPES + +DEFINE CDBCHK TBLNAM +IFN .--NCDBTS,.ERR TBLNAM LOSES +TERMIN + +;LOADER BLOCK TYPES LINK +LLDCM==1 ;LOADER COMMAND BLOCK +LABS==2 ;ABSOLUTE +LREL==3 ;RELOCATABLE +LPRGN==4 ;PROG NAME +LLIB==5 ;LIBRARY BLOCK +LCOMLOD==6 ;LOAD INTO COMMON +LGPA==7 ;GLOBAL PARAMETER ASSIGN +LDDSYM==10 ;LOCAL SYMS +LTCP==11 ;LOAD TIME COND ON PRESENCE +ELTCB==12 ;END LOAD TIME COND +LPLSH==22 ;POLISH FIXUP + +;LOADER COMMANDS +;IN ADR OF LDCMD BLK +LCJMP==1 ;JUMP +LCGLO==2 ;GLOBAL LOC ASSIGN +LCCMST==3 ;SET COMMON BENCHMARK +LCEGLO==4 ;END OF GLOBAL BLOCK +LDCV==5 ;LOAD TIME COND ON VALUE +LDOFS==6 ;LOADER SET GLOBAL OFFSET +LD.OP==7 ;LOADER .OP + +;LOADER CODEBITS SECOND SPEC AFTER 7 +CDEF==0 ;DEF +CCOMN==1 ;COMMON REL +CLGLO==2 ;LOC-GLO REC +CLIBQ==3 ;LIBREQ +CRDF==4 ;GLO REDEF +CRPT==5 ;REPEAT GLOBAL VALUE +CDEFPT==6 ;DEFINE SYM AS $. + +;DEC RELOCATABLE BLOCK TYPES. +DECWDS==1 ;STORAGE WORDS. +DECSYM==2 ;SYMBOL DEFS OR GLOBAL ADDITIVE RQS. +DECHSG==3 ;LOAD INTO HIGH SEG (FOR .DECTWO) +DECENT==4 ;ENTRY NAMES +DECEND==5 ;END BLOCK, HAS PROGRAM BREAK. +DECNAM==6 ;PROGRAM NAME. +DECSTA==7 ;STARTING ADDRESS BLOCK. +DECINT==10 ;INTERNAL REQUEST +DECRQF==16 ;REQUEST LOADING A FILE +DECRQL==17 ;REQUEST LOADING A LIBRARY +] ;END IF1 + +IF1 [ + +DEFINE TYPE &STR +TYPR [ASCIZ STR] +TERMIN + +DEFINE TYPECR &STR +TYPCR [ASCIZ STR] +TERMIN + +DEFINE PRINTA A,B,C,D,E,F +IF1,[PRINTC ~A!B!C!D!E!F +~] +TERMIN + +IF1 [DEFINE BNKBLK OP +OP +TERMIN ] + + ;ADD A LINE TO BNKBLK, ACCUMULATED CONTENT OF + ;WHICH IS DUMPED OUT AT END OF ASSEMBLY + ;ARG TO BLCODE SHOULD BE FREE OF STORAGE WORDS + +DEFINE BLCODE NEWCFT +IF1 [BNKBLK [DEFINE BNKBLK OP +OP]NEWCFT +TERMIN ] +IF2 [IRPW X,,[ +NEWCFT +] +IRPS Y,,X +Y=Y +.ISTOP TERMIN TERMIN ] TERMIN + + ;3RDWRD MANIPULATING MACROS + ;GET 3RDWRD INTO LH("A"), "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3GET A,B + MOVE A,ST+2(B) + TERMIN + + ;GET 3RDWRD INTO "A", "B" HAS ADR OF 1STWRD + +DEFINE 3GET1 A,B + MOVE A,2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3PUT A,B + MOVEM A,ST+2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS ADR OF 1STWRD + +DEFINE 3PUT1 A,B + MOVEM A,2(B) + TERMIN + +] ;END IF1 + +;RANDOM MACRO DEFINITIONS + +IF1 [ + + ;A HAS ADR OF SYM SQUOZE, SKIP IF IT'S IN SYMBOL TABLE + +DEFINE SKPST A + CAIL A,ST + CAML A,MACTAD +TERMIN + + ;EXECUTE AN INSTRUCTION WITH VARIOUS ADDRESSES (USUALLY PUSH OR POP) + +DEFINE INSIRP A,B + IRPS %ADR,,[B] + A,%ADR + TERMIN +TERMIN + +DEFINE NOVAL + TDNE I,[ILWORD,,IRNOEQ\IRFLD] + ETSM ERRNVL +TERMIN + +DEFINE NOABS + SKIPGE CONTRL + ETASM ERRABS +TERMIN + +] ;END IF1 + +ERRNVL==[ASCIZ /Returns no value/] +ERRABS==[ASCIZ /Allowed only for STINK relocatable format/] + +IF1 [ + +DEFINE MOVEIM B,C + MOVEI A,C + MOVEM A,B +TERMIN + +DEFINE MOVEMM B,C + MOVE A,C + MOVEM A,B +TERMIN +] ;END IF1 + +IF1 [ +IFN 0,[ +;THESE ARE SOME MACRO DEFINITIONS FOR THE UNFINISHED MULTI-WORD +;SYMBOL NAME FEATURE. FOR COMPATIBILITY, THEY ALL NOW HAVE DEFINITIONS +;THAT ONLY HANDLE ONE WORD. THOSE OTHER DEFINITIONS COME AFTER THESE. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +IFSN X,SYM,SKIPE A,X+1 +.ELSE SKIPE A,SYMX + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y + MOVE Z,X+1 + MOVEM Z,Y+1 +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y + MOVE Z,AC!X + MOVEM Z,Y+1 +TERMIN +] + +.ELSE [ +;THESE ARE THE DEFINITIONS OF THE MACROS THAT DO NOT IMPLEMENT +;MULTI-WORD SYMBOL NAMES. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y +TERMIN +] + +DEFINE USING X +X,TERMIN + +] ;END IF1 + +SUBTTL DEFINE SYS DEPENDENT SYMBOLS & SELECT OUTPUT FORMAT + +; THIS DEFSYM MACRO IS FOR COMPILING MIDAS ON ANOTHER OPERATING SYSTEM. THIS +; AVOIDS SAME-NAME SCREWS (IE, "LOCK" IS SOMETHING DIFFERENT ON TWENEX, SAIL, +; AND DEC). + +IF1 [ +DEFINE DEFSYM X/ + IRPS Z,,[X] + EXPUNGE Z + .ISTOP + TERMIN + X +TERMIN +]; IF1 + +IFN DECSW\TNXSW,[ +IF1 [ +; INSERT UUO DEFINITIONS FILES AS APPROPRIATE. +IFE CMUSW\SAILSW\TNXSW,.INSRT DECDFS +IFN SAILSW, .INSRT SAIDFS +IFN CMUSW, .INSRT CMUDFS +IFN TNXSW, .INSRT TNXDFS + +;ACTUALLY DEFINE THE UUOS USING THE MACROS READ FROM THE FILES. +IFN DECSW,.DECDF DEFSYM +IFN TNXSW,.TNXDF DEFSYM + +;INSERT THE BITS DEFINITION FILES AS APPROPRIATE. +;THESE MUST BE INSERTED EVEN IF THEY ARE PREDEFINED, BECAUSE +;THE MIDAS SYMBOL TABLE IS CONSTRUCTED FROM THE DEFINITIONS IN THIS ASSEMBLY +;OF THOSE SYMBOLS, AND THAT MEANS WE NEED THE LATEST VERSION ASSEMBLED IN. +IFN TNXSW,.INSRT TWXBTS +IFN DECBSW,.INSRT DECBTS + +IFN TNXSW,[ ; AC DEFS FOR DIRECT REFERENCE TO JSYS ARGS +R1==:1 ; SOMEDAY MAYBE THE SYMBOLS A,B ETC WILL CORRESPOND... +R2==:2 +R3==:3 +R4==:4 +R5==:5 +] + +EXPUNGE HALT +DEFINE HALT + JRST 4,. +TERMIN + +EXPUNGE .VALUE +EQUALS .VALUE HALT + +DEFINE .LOSE A + JRST 4,.-1 +TERMIN +] ;IF1 + +IFN DECSW,[ ; SELECT OUTPUT FORMAT FOR DEC VERSION +IFN PURESW,.DECTWO +IFE PURESW,.DECREL + RL0==. +] +IFN TNXSW,[ ; SELECT OUTPUT FORMAT FOR TNX VERSION +IFNDEF DECSVF,[ ; NORMALLY, USE .DECSAV IF AVAILABLE, ELSE .DECREL, + DECSVF==0 ; BUT USER CAN OVERRIDE THAT BY SPECIFYING DECSVF. + IFDEF .DECSAV,DECSVF==1 +] +IFN DECSVF,.DECSAV +.ELSE [ IFN PURESW,.DECTWO + .ELSE .DECREL + ] + RL0==0 +] +] ;IFN DECSW\TNXSW + +IFN ITSSW,[ +IF1 [IFNDEF .IOT,[.INSRT SYS:ITSDFS + .ITSDF DEFSYM + ] ;IFNDEF .IOT +IFNDEF %PIPDL,.INSRT SYS:ITSBTS + HALT==.VALUE + EXPUNG .JBTPC,.JBCNI + +DEFINE SYSCAL A,B + .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] +TERMIN +] ;IF1 + +IFDEF .SBLK,.SBLK ; SELECT OUTPUT FORMAT FOR ITS VERSION + RL0==0 +] ;IFN ITSSW + +IFE PURESW,[ ;FOLLOWING IF NOT ASSEMBLING PURE CODING + +DEFINE PBLK +TERMIN + +DEFINE VBLK +TERMIN +] + +IFN PURESW,[ ;FOLLOWING IF ASSEMBLING PURE CODING + +;MEMORY ORGANIZATION PURE CODING + +;MAXVAR BLOCKS OF IMPURE CODING, NO DYNAMIC ALLOCATION + ;BLCODE MACRO ACCUMULATES CODING TO BE PUT AT END OF + ;IMPURE CODING, NO STORAGE WORDS ALLOWED +;THEN SYM TAB, STARTING AT ST. +;THEN MACRO TABLE (WITH INIT. CODE IN IT) +;STARTING INITIALLY AT MACTBA, ACTUAL ADDR IN MACTAD. +;SYMTAB AND MACTAB DON'T NECESSARILY START ON PAGE BNDRYS. +;THEN GAP TO MINPUR*2000 (HEREAFTER KNOWN AS "THE GAP") + +IFN DECSW\TNXSW,MINPUR==200 +IFN ITSSW,MINPUR==160 ;BLOCK NUMBER BEGINNING OF PURE CODING + +;PURE CODING UNTIL MAXPUR*2000-SOMETHING +;THE FOLLOWING MACROS AND BLCODE MAKE IT NOT COMPLETELY NECESSARY +;TO SEPARATE PURE CODING FROM IMPURE + +CKPUR==0 ;0 => ASSEMBLING BELOW THE GAP, 1 ABOVE + + ; PBLK - SWITCH TO CODING ABOVE THE GAP +DEFINE PBLK +IFN CKPUR,.ERR PBLK +IFE CKPUR,[VAR.LC==. +LOC PUR.LC +]CKPUR==1 +TERMIN + + ; SET INITIAL LOCATION COUNTER FOR ASSEMBLING PURE CODE ABOVE GAP. +IFN ITSSW, PUR.LC==MINPUR*2000 +IFN DECSW, PUR.LC==MINPUR*2000+RL0 +IFN TNXSW,[ + IFN DECSVF,PUR.LC==MINPUR*2000 + .ELSE PUR.LC==MINPUR*2000+20 ;SKIP VESTIGIAL JOBDAT AREA. +] + + ; VBLK - SWITCH TO CODING BELOW THE GAP +DEFINE VBLK +IFE CKPUR,.ERR VBLK +IFN CKPUR,[PUR.LC==. +LOC VAR.LC +]CKPUR==0 +TERMIN + +IFN TNXSW,IFE DECSVF,LOC 200 + +PBLK ;PBLK NORMAL MODE, VARIABLE AREAS BRACKETED WITH VBLK AND PBLK + +] ;END PURESW CONDITIONAL + +.YSTGW ;SET UP NOW, STORAGE WORDS OK + +FOO==. +LOC 41 + JSR ERROR +IFN ITSSW,JSR TSINT +IFN DECSW,[ +LOC .JBAPR + TSINT1 +] +LOC FOO + + ;DISPATCH TABLE FOR NON-SQUOZE CHARACTERS + ;REFERENCED AS DTB-40(RH OF POPJ IN GDTAB) + ;DTB ENTRY OF SYL TERMINATOR PUT IN CDISP BY GETSYL + +DSYL==400000 ;SYL OPERATOR, DISPATCH INDEXED BY RH AT GETSYL (MUST BE SIGN) +DFLD==200000 ;FIELD OPERATOR, GETFD +DWRD==100000 ;WORD OP, GETWD +DSY1==1000 ;SET ONLY IF DSYL SET, + ;SET IF OP MIGHT BE 1ST CHAR OF NONNULL SYL. +DSYL1==DSYL+DSY1 +DSY2==400 ;SET FOR _ ONLY. + +;ALL CLEAR => WORD TERMINATOR, NO DISPATCH + +DTB: DWRD,,SPACE ;40 SP, TAB, RUBOUT + DSYL1,,RRL2 ;EXCLAIM AND OPEN-BRACE + DSYL1,,DQUOTE ;" + DFLD,,XORF ;NUM SIGN + DSYL,,RBRAK2 ;CLOSE-BRACE. + 0 ;(USED TO BE PERCENT SIGN) + DFLD,,ANDF ;AMPERSAND + DSYL1,,SQUOTE ;' + DFLD,,LEFTP ;( 50 + DSYL,,RPARN ;) + DFLD,,MULTP ; STAR TIMES + DFLD,,PLS ;+ PLUS + DWRD,,COMMA ; , + DFLD,,MINUS ;- + DSYL1,,CTLAT ;^@ (56) + DFLD,,DIVID ;/ + DSYL1,,COLON ;COLON 60 + DSYL,,SEMIC ;SEMI + DFLD,,LSSTH ;< + DSYL1,,EQUAL ;= + DSYL,,GRTHN ;> + 0 ;? + DSYL1,,ATSGN ;AT SIGN + DFLD,,LBRAK ;[ + DFLD,,IORF ;BACKSLASH 70 + DSYL,,RBRAK ;] + DSYL1,,UPARR ;^ + DSYL+DSY2,,BAKAR ;BACKARR + 0 ;CR + 0 ;(USED TO BE TAB) + 0 ;ALL OTHER + DSYL,,LINEF ;LF (DSYL TO HACK CLNN) + DSYL,,FORMF ;FORM FEED (") 100 + +;NOTE THAT POPJ P, IS VALID TEST FOR SQUOZENESS +;EXCEPT FOR EOFCH + +GDTAB: POPJ P,56 ; ^@ GETS IGNORED. + REPEAT 2,POPJ P,76 ;(GDTAB GLOBAL SO OUT OF TS, AIO CAN CLOBBER GDTAB+141 WITH JRST RREOF + ;ON OLD FILES) +IFN .-GDTAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH GDTAB. +IFE TS,[POPJ P,76] IFN TS,[JRST RREOF] + REPEAT 5,POPJ P,76 + POPJ P,40 ; TAB + POPJ P,77 ; LF + POPJ P,76 ; VERT TAB + POPJ P,100 ; FORM FEED + POPJ P,74 ; CR + REPEAT "!-16-1,POPJ P,76 + POPJ P,40 ; SPACE + POPJ P,41 ; ! + POPJ P,42 ; " + POPJ P,43 ; # + ADD SYM,%$SQ(D) ; $ + ADD SYM,%%SQ(D) ; % + POPJ P,46 ; & + POPJ P,47 ; ' + POPJ P,50 ; ( + POPJ P,51 ; ) + POPJ P,52 ; * + POPJ P,53 ; + + POPJ P,54 ; , + POPJ P,55 ; - + JSP CH1,POINT ; . + POPJ P,57 ; / + REPEAT 10.,JSP CH2,RR2 ; DIGITS + POPJ P,60 ; : + POPJ P,61 ; ; + POPJ P,62 ; < + POPJ P,63 ; = + POPJ P,64 ; > + POPJ P,65 ; ? + POPJ P,66 ; @ +IFDEF .CRFOFF,.CRFOFF +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN + POPJ P,67 ; [ + POPJ P,70 ; \ + POPJ P,71 ; ] + POPJ P,72 ; ^ + POPJ P,73 ; _ + POPJ P,76 ; NOW LOWER CASE GRAVE ACCENT + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN +IFDEF .CRFON,.CRFON + POPJ P,41 ;{ + POPJ P,76 ;| + POPJ P,44 ;} + POPJ P,76 ;~ + POPJ P,40 ; RUBOUT, LIKE SPACE + IFN .-GDTAB-200,.ERR GDTAB LOSES + +NSQTB: IFDEF .CRFOFF,.CRFOFF +IRPC Q,,0123456789 + ADD SYM,%!Q!SQ(D) +TERMIN + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890$%. +%!Q!SQ: 0 + SQUOZE 0,Q/50/50/50/50/50 + SQUOZE 0,Q/50/50/50/50 + SQUOZE 0,Q/50/50/50 + SQUOZE 0,Q/50/50 + SQUOZE 0,Q/50 + SQUOZE 0,Q +TERMIN +IFDEF .CRFON,.CRFON + +;FORMAT TABLE(S) +;4.9-4.4 ETC SPECIFY SHIFT +;4.4-3.6 ETC SPECIFY NUMBER BITS +;FIELD SPECS IN REVERSE ORDER + +IFORTB: 0 ;NCNSN 10 , + 0 ;NCNSF 11 IMPOS + 0 ;NCNCN 12 ,, + 2200,, ;NCNCF 13 ,,C + 2200000000 ;NCFSN 14 ,B + 0 ;NCFSF 15 ,B C + 0 ;NCFCN 16 ,B, + 0 ;NCFCF 17 ,B,C + 4400000000 ;FSNSN 20 A + 0 ;FSNSF 21 IMPOS + 0 ;FSNCN 22 IMPOS + 0 ;FSNCF 23 IMPOS + 2200440000 ;FSFSN 24 A B + 2200220044 ;FSFSF 25 A B C + 270400440000 ;FSFCN 26 A B, + 2227040044 ;FSFCF 27 A B,C + 4400000000 ;FCNSN 30 A, + 0 ;FCNSF 31 IMPOS + 22220000 ;FCNCN 32 A,, + 2200002222 ;FCNCF 33 A,,B + 2200440000 ;FCFSN 34 A,B + 0 ;FCFSF 35 A,B C + 0 ;FCFCN 36 A,B, + 0 ;FCFCF 37 A,B,C +FRTBL==.-IFORTB ;LENGTH OF FORMAT TABLE +VBLK +FORTAB: BLOCK FRTBL ;ACTUAL FORMAT TABLE +FRTBE=.-1 +PBLK + +;VARIABLE STORAGE + +VBLK + +RETURN: JRST . ;RH HAS RETURN ADR FOR END OF MAJOR ROUTINE (E.G PASS 2) +CDISP: 0 ;CURRENT DISPATCH CODE +PPRIME: 0 ;PUSH DOWN LIST MARKER (GETFLD) +SCNDEP: 0 ;DEPTH IN SUCCESSFUL BRACKET CONDITIONALS INSIDE INNERMOST LITERAL. +CONDLN: 0 ;LINE NUMBER AT WHICH LAST TOP LEVEL SUCCESSFUL CONDITIONAL ENCOUNTERED +CONDPN: 0 ;PAGE NUMBER-- PRINT THESE IF REACH END AND CONDITIONAL NOT TERMINATED +CONDFI: 0 ;SIXBIT FN1 OF FILE CONTAINING LAST TOP LEVEL SUCCESSFUL CONDITIONAL. +A.SUCC: 0 ;NONZERO IFF LAST CONDITIONAL SUCCEEDED. +ASMOUT: 0 ;0 NORMAL, 1 WITHIN <>, 2 IN (), 3 IN []. +ASMDSP: ASSEM3 ;PLACE TO JUMP TO FROM ASSEM1 LOOP. + ;ASSEM3 NORMAL. ASSEMC IF WITHIN <>, () OR [] + ;AND .MLLIT ISN'T POS. LSSTHA AFTER > OR ) SEEN. + ;[ ;CONND AFTER ] SEEN. +ASMDS1: 0 ;ASMDSP SAVED HERE DURING ASCII, SIXBIT PSEUDOS. +ASSEMP: 0 ;RESTORE P FROM HERE AT ASSEM1. SAVED OVER LITERAL. +ASMI: 0 ;REINIT I AT ASSEM2 FROM ASMI. +GLSPAS: 0 ;RESTORE GLSP1 AT ASSEM1. SAVED OVER LITERAL. +GLSP1: 0 ;POINTER TO BOT OF LINKAGE TABLE IN USE HIGH ADR +GLSP2: 0 ;POINTER TO TOP OF LINKAGE TABLE IN USE LOW ADR +FORMAT: 0 ;ACCUMULATES FORMAT WORD +FORPNR: 0 ;POINTER INTO FORMAT WORD, SHOULD BE FORMAT+1 SO CLOBBERABLE BY LAST IDPB +FLDCNT: 0 ;NUMBER OF FIELDS PUSHED DOWN IN CURRENT WORD +WRD: 0 ;ACCUMULATES VALUE OF WORD +WRDRLC: 0 ;RELOC OF WRD, MUST COME RIGHT AFTER WRD. +T1: 0 ;TEMP +T2: 0 ;TEMP +PBITS1: 0 ;CURRENT CODE BITS +PBITS2: 0 ;NO OF SPECS LEFT IN CURRENT WORD +PBITS4: 0 ;POINTER TO WHERE CURRENT CODE BITS WILL GO +OPT1: 0 ;POINTER FOR STORING IN BKBUF (OUTPUT BUFFER) +CONTRL: 0 ;FLAG REG FOR IO CONTROL ETC, .GE. 0 => RELOCATABLE/1PASS +CDATBC: 0 ;CURRENT DATA BLOCK CODE TYPE +SCKSUM: 0 ;CKSUM FOR SIMPLE BLOCK FORMAT +IFN A1PSW,[ +PRGC: -1 ;ONE LESS THAN # TIMES END HAS BEEN ENCOUNTERED +OUTN1: -1 ;.GE. 0 => OUTPUT HAS OCCURED IN OTHER THAN 1PASS MODE (NOT INITIALIZED) +OUTC: -1 ;.GE. 0 => OUTPUT HAS OCCURED DURING CURRENT ASSEMBLY +] +LINKL: 0 ;SAVE LIMIT OF GLOTB GETWRD +STRCNT: 0 ;COUNT OF CHARS READ (INCL. DELIM) BY GSYL +STRPNT: 0 ;TEMP AT GSYL, BYTE POINTER TO STRING STORAGE +ISYMF: -1 ;-1 IF ISYMS HAVE NOT BEEN SPREAD +SMSRTF: -1 ;-1 BEFORE SYMTAB IS COMPACTED AND SORTED. + ;AFTER COMPACTING, HOLDS NUMBER OF SYMS THAT WERE THERE BEFORE COMPACTING. +BITP: 0 ;BYTE PNTR TO CODE BITS IN CURRENT (RELOC) BLOCK +LDCCC: 0 ;DEPTH IN LOADTIME CONDS +PARBIT: 0 ;0 OR 4 FOR : OR = (IN GENERAL, TEMP AT P7X) +LABELF: 0 ;-1 IN COLON, SOMETIMES IN EQUAL. CAUSES 3LABEL TO BE SET. +STGSW: 0 ;NON ZERO GIVES ERROR PRINT ON STORAGE WORDS +HKALL: 0 ;NONZERO => HALF-KILL ALL LABELS (.HKALL'S VALUE) +LITSW: 0 ;-1 => USING A LITERAL GIVES AN ERROR +QMTCH: 0 ;-1 => ' AND " NEED MATCHING CLOSINGS (A LA FAIL, MACRO-10) +STARTA: 0 ;STARTING ADDRESS FOR SBLK, RIM, DECSAV +DECSYA: 0 ; ADDRESS TO LOAD SYMBOLS AT (FOR DECSAV FORMAT) +DECBRK: 0 ;LARGEST RELOC. ADDR. LOADED INTO. (USED FOR DEC FMT) +DECBRA: 0 ;LARGEST ABS. ADDR LOADED INTO. +DECBRH: 0 ;LIKE DECBRK BUT FOR ADDRS IN HI SEG. +DECTWO: MOVE ;NOT = MOVE => .DECTWO WAS DONE, AND THIS WD HAS + ;ADDR START OF HISEG. +ISAV: 0 ;I FROM FIELD AT AGETFLD +A.PASS: 0 ; .PASS INTSYM, # OF THIS PASS. +A.PPAS: 0 ;.PPASS INTSYM, # OF PASSES. +WPSTE: NRMWPS ;# WORDS PER SYMTAB ENTRY +WPSTE1: NRMWPS-1;ONE LESS THAN WPSTE - FOR SPEED. +WPSTEB: ,-NRMWPS(B) ;RH HAS - # WORDS PER SYMTAB ENTRY; LH HAS INDEX OF B. +SYMSIZ: 0 ;#WDS IN SYMTAB = WPS* +SYMLEN: SYMMSZ ;SYMTAB SIZE (# SYMS) + ;ASSEMBLED-IN VALUE USED AS DEFAULT, ONLY IF NON-TS. +SYMAOB: 0 ;-<# SYMS>,,0 +INICLB: 0 ;-1 IF INITIALIZATION CODE CLOBBERED. +TTYINS: 0 ;AT START OF ASSEMBLY, -1 => .INSRT TTY PASS1, -2 => PASS2 ALSO. +IFN FASLP,[ +FASBP: 0 ;PNTR TO FASL OUTPUT BUFFER +FASATP: 0 ;PNTR TO FASL ATOM TABLE +FASAT1: 0 ;PNTR TO FASL ATOM TABLE AFTER READING IN NEW ATOM + ; (MAYBE UPDATE FASATP TO THIS IF ATOM WAS UNIQUE9 +FASAT2: 0 ;BYTE PNTR USED TO STORE ATOM IN +FASIDX: 0 ;INDEX NEXT ATOM LOADED INTO FASAT WILL BE +FASPCH: 0 ;AMOUNT OF FASAT "PUNCHED" +FASCBP: 440400,,FASB ;BYTE PNTR TO FASL CODE BIT WORD +FASPWB: 0 ;FASL CODE AT PWRD +FASBLC: 0 ;LOSING BLOCK "COUNT" +FASBLS: 0 ;LOSING BLOCK "SYMBOL" +AFRLD: 0 ;LIST READ CURRENT DEPTH +AFRLEN: 0 ;LIST READ CURRENT LENGTH +AFRDTF: 0 ;LIST READ DOT CONTEXT FLAG (0 NORMAL, 1 SAW DOT, 2 SAW "FROB AFTER DOT" +AFRFTP: 0 ;LIST READ SAVED STATE OF FASATP +AFLTYP: 0 ;TYPE LIST OP IN- 0 EVAL AND THROW AWAY VALUE + ;1 "RETURN" LIST + ;2 "RETURN" VALUE OF LIST +] +PBLK + +;INFO CONVENIENT TO ANYONE GENERATING AN OUT OF TIME-SHARING MIDAS + +;MIDAS OUT OF TIME-SHARING ASSEMBLES INTO A COLLECTION OF SUBROUTINES +;IO IS EXPECTED TO BE HANDLED BY OTHER PROGRAMS. + +;EXITS FROM THE ASSEMBLER: +;TPPB OUTPUT BINARY WORD IN A +;TFEED IF OUTPUT DEVICE IS PTP, PUNCH OUT # FRAMES OF BLANK TAPE + ;SPECIFIED BY B, MAY CLOBBER A AND B +;GO9 RETURN POINT FROM FATAL ERRORS +;TYO TYPE OUT CHARACTER IN A +;TAB TYPE OUT A TAB (MAY CLOBBER A OF COURSE) +;RCHTBL SEE THE RCH ROUTINES + +;ENTRIES + +;PDL, LPDL MAY BE USED BY COMMAND PROCESSOR BUT WILL BE CLOBBERED BY MAIN ROUTINES +;MAIN ROUTINES, CALLED WITH JSP A, , CLOBBER THE WHOLE WORLD (INCLUDING P) +;INIT INITIALIZE +;PS1 PASS 1 +;PLOD IF APPROPRIATE, PUNCH OUT LOADER +;PS2 PASS 2 (DOES ITS OWN PARTIAL INITIALIZATION) +;PSYMS PUNCH OUT SYMBOL TABLE + +;OTHER ENTRIES + +;CONTRL AFTER ASSEMBLY, .GE. 0 => RELOCATABLE, .LT. 0 => ABSOLUTE +;ISYMF -1 IF SYMS HAVE NOT BEEN SPREAD, ELSE DON'T TRY TO ADD TO INITIAL SYMBOL TABLE +;SMSRTF -1 IF SYMTAB HASN'T BEEN SORTED, ELSE SYMTAB CLOBBERED, DON'T RE-ASSEMBLE +;MIDVRS .FNAM2 OF MIDAS ENGLISH + +;SOME FF FLAGS ARE GLOBAL SO COMMAND PROCESSOR CAN KNOW WHAT'S HAPPENED ON RETURN + +;COMMAND PROCESSOR MAY ADD TO INITIAL SYMBOL TABLE BEFORE CALLING INIT THE FIRST TIME +;EISYMT IS THE FIRST LOCATION OK TO DUMP INTO +;EISYMP RH SHOULD BE SET BY COMMAND PROCESSOR TO FIRST LOC NOT DUMPED INTO +;INTSYM RH OF SYMTAB VALUE TO RETURN VALUE ADDRESSED BY LH(SYMTAB ENTRY) + +;RCH HAS AN ELABORATE SET OF GLOBALS, WHICH I DON'T FEEL LIKE PUTTING DOWN NOW, BUT THEY INCLUDE +;RCH (GET CHAR) SEMIC, RRL1, RREOF, SEMICR, SEMIC, TYPCTL, GDTAB, CPGN, CLNN, +;RCHMOD, MDSCLR, MDSSET, RCHSET, POPLMB, PSHLMB +;ALSO RCHTBL ONLY EXIT + +;LISTING FEATURE GLOBALS: +;PILPT PRINT CHAR IN A +;LISTON LISTING ON/OFF FLAG, -1 => ON +;LISTP SAME WORD AS LISTON. +;LISTP1 POSITIVE => LIST EVEN ON NON-PUNCHING PASS. +;LPTCLS END OF LISTING, PRINT FORM FEED, IF TS THEN CLOSE LPT + +;CREF FEATURE GLOBALS: +;CRFOUT OUTPUT WORD IN A. +;CREFP -1 => REQUEST GENERATION OF CREF OUTPUT. +;THE RUBOUT-B-^W HEADER, THE SET-SOURCE-FILE BLOCK, AND THE EOF BLOCK +;ARE THE RESPONSIBILITY OF THE COMMAND PROCESSOR. + +;;RCH ;CHARACTER INPUT ROUTINES + +IFN RCHASW\MACSW,[ + ;SAVE LIMBO1 STATUS AND RH(B) + ;THEN SET UP FOR NEW INPUT MODE (DESCRIPTOR IN A) + ;CALLED BY PUSHEM AND PUSHTT + +PSHLMB: HRL B,LIMBO1 ;LAST CHARACTER INPUT + TLZE FF,FLUNRD ;RE-INPUT CHARACTER ON RETURN? + XCT LSTPLM ;SET B'S SIGN; IF LISTING, JRST PSHLML. +PSHLMN: EXCH A,RCHMOD ;GET OLD MODE IN A + DPB A,[360500,,B] ;STORE IN 5 OF HIGH 6 BITS IN B + PUSH F,B ;SAVE RESULTANT CRUD + CAMN A,RCHMOD ;COMPARE NEW WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + MOVE A,RCHMOD ;NOW GET NEW MODE + JRST PSHLM1 ;SET UP INSTRUCTIONS FOR NEW MODE + +IFN LISTSW,[ +;IF LISTING, LSTPLM HOLDS JRST PSHLML +PSHLML: AOSN PNTSW + JRST PSHLMM ;LAST WAS BREAK CHR + REPEAT 4,IBP PNTBP + SOSA PNTBP +PSHLMM: SETOM LISTBC + TLO B,400000 + JRST PSHLMN +] + + ;UNDO A PSHLMB (NOTE: IN COMMENTS BELOW, "NEW" MODE IS ON PDL, OLD IN RCHMOD) + +POPLMB: POP F,A ;GET WORD THAT PSHLMB PUSHED + HLRZS A ;JUST INTERESTED IN LEFT HALF + TRZE A,400000 ;SIGN BIT SET? + TLOA FF,FLUNRD ;YES, SET FLAG TO RE-INPUT LAST CHAR + TLZA FF,FLUNRD ;NO, CLEAR FLAG. + XCT POPLML ;JFCL\IDPB A,PNTBP ;THE LATTER IFF LISTING. + SETZM LIMBO1 ;INITIALIZE FOR DPB + DPB A,[700,,LIMBO1] ;RESTORE LIMBO1 + LSH A,-<18.-6> ;RIGHT JUSTIFY RCHMOD DESCRIPTOR + CAMN A,RCHMOD ;COMPARE NEW MODE WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + JRST RCHSET ;SET UP FOR NEW MODE AND RETURN +] + +FOO==0 ;INITIALIZE COUNTER FOR FOLLOWING + +DEFINE RCHBLT SIZE,ADR/ + MOVSI T,FOO(A) + HRRI T,ADR + BLT T,-1+ADR +FOO==FOO+ +TERMIN + +DEFINE RCHMOV ADR/ + MOVE T,FOO(A) + MOVEM T,ADR +FOO==FOO+1 +TERMIN + + ;SET UP FOR INPUT OF MODE TYPE SPECIFIED IN A, CLOBBER A ONLY + +RCHSET: MOVEM A,RCHMOD ;STORE NEW RCHMOD +PSHLM1: TLZ FF,FLMAC\FLTTY ;CLEAR FLAGS (MAYBE DEVICE ROUTINE SETS ONE) + XCT RCHTBL(A) ;GET IN A A POINTER TO A DESCRIPTOR TABLE (MAYBE ALSO SET FLAG) + PUSH P,T ;SAVE T, NEED IT FOR TEMP + RCHBLT 3,RCH2 ;FIRST 3 WORDS RCH2 + TLNE FF,FLVOT + JRST POPTJ ;ALL RCH'S TO GO THROUGH RCH, DON'T DO ANYTHING ELSE +MDSST1: RCHBLT 3,RR1 ;NEXT 3 RR1 + RCHMOV RRL1 ;NEXT WORD RRL1 +RCHPSN==FOO ;# WORDS IN ALL TABLES BUT LAST (NOT OF CONSTANT LENGTH) + RCHBLT 6,SEMIC ;LAST N SEMIC +POPTJ: POP P,T + POPJ P, + +IFN LISTSW,[ + ;SET UP TO "DISPLAY" (ALL RCH'S THROUGH RCH) + +MDSSET: TLO FF,FLVOT ;SET FLAG + MOVEI A,MDSSTB-3 ;SET UP AC + PUSH P,T ;SAVE T FOR RESTORATION + JRST MDSST1 ;NOW SET UP + +MDSSTB: JRST RRL1 ;RR1 + HALT + PUSHJ P,RCH ;RREOF + + PUSHJ P,RCH ;RRL1 +IFN .--RCHPSN,.ERR LOSSAGE AT MDSSTB. + PUSHJ P,RCH ;SEMIC + CAIE A,15 + JRST SEMIC + JRST SEMICR + + ;CLEAR OUT DISPLAY MODE + +MDSCLR: TLZ FF,FLVOT ;CLEAR FLAG + MOVE A,RCHMOD + JRST RCHSET ;NOW SET UP FOR REAL IN CURRENT MODE +] ;END IFN LISTSW, + +IFN TS,[ ;TABLE FOR RCHSET, INDEXED BY MODE + ;MAYBE THIS CONDITIONAL WANTS TO BE CHANGED TO SOMETHING ELSE + +RCHTBL: MOVEI A,RCHFIL ;0 => INPUT FROM FILE +IFN MACSW,PUSHJ P,RCHMAC ;1 => INPUT FROM MACRO (DO NOT CHANGE, USED BY MACRO PROCESSOR) +IFN RCHASW,[IFE MACSW,HALT + PUSHJ P,RCHTRC ;2 => TTY, QUIT ON CR + PUSHJ P,RCHARC ;3 => TTY, DON'T QUIT ON CR +] + ;TABLE FOR INPUTTING FROM FILE + ;MAYBE THIS CONDITIONAL ALSO WANTS TO BE CHANGED + +RCHFIL: ILDB A,UREDP ;GETCHR, GET CHARACTER + CAIG A,14 ;SKIP IF TOO BIG TO BE SPECIAL + XCT RPATAB(A) ;SPECIAL, DO THE APPROPRIATE THING + + JRST RRL1 ;RR1 + HALT + PUSHJ P,[ MOVEI A,0 ;^C IN SYMBOL TREATED LIKE A ^@, + JRST INCHR3] ;BUT ALSO SEE IF REALLY END OF BUFFER. THIS GOES IN RREOF. + + ILDB A,UREDP ;RRL1 +IFN .-RCHPSN-RCHFIL,.ERR RCHFIL LOSES. + LDB CH1,[360600,,UREDP] ;SEMIC; FIND WHERE IN ITS WORD UREDP POINTS + IDIVI CH1,7 + JRST @SEMIC3(CH1) ;AND ENTER THE CR-SCANNING LOOP AT THE APPROPRIATE + JFCL ;PLACE (IT IS A WORD-BY-WORD LOOP). + +;TABLE FOR ABOVE, EXECUTED INDEXED BY CHAR, 15 ONLY FROM SEMIC ELSE ANYTHING +;NOTE: MANY OF THESE ROUTINES SUBTRACT 3 FROM THE PC BEFORE RETURNING. +;THE CALLER MUST MAKE SURE THAT THE ILDB UREDP IS WHAT THEY RETURN TO THAT WAY. + +RPATAB: +IFN ITSSW, JFCL ;0, ON I.T.S. IS NORMAL CHARACTER +.ELSE CALL RPANUL ;0, ON DEC SYSTEM, IGNORE IT. + JFCL + JFCL +IFN .-RPATAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH ENTRY IN RPATAB. + PUSHJ P,INCHR3 ;3, EOFCH + REPEAT 6,JFCL + CALL RPALF ;LINE FEED + JFCL ;13 + PUSHJ P,RPAFF ;FORM FEED + JRST SEMICR ;FROM SEMIC ONLY, EXIT FROM LOOP + +RPAFF: SKIPE ASMOUT ;FORM FEED + ETR [ASCIZ/Formfeed within <>, () or []/] + AOS CH1,CPGN + SETOM CLNN +IFN ITSSW,[ + ADD CH1,[SIXBIT /P0/+1] + MOVE CH2,A.PASS + DPB CH2,[300200,,CH1] + .SUSET [.SWHO3,,CH1] ;PUT THE NEW PAGE # IN THE WHO-LINE. +] +RPALF: AOS CH2,CLNN + CAME CH2,A.STPLN + RET + MOVE CH1,CPGN + CAMN CH1,A.STPPG + SETOM TTYBRF + RET + +IFN DECSW\TNXSW,[ +RPANUL: MOVE CH1,@UREDP ;SAW A NULL - IN A LINE NUMBER? + TRNN CH1,1 + JRST RCHTRA ;NO, JUST IGNORE IT. + MOVEI CH1,010700 + HRLM CH1,UREDP ;YES, SKIP THIS WHOLE WORD, THEN + CALL RCH ;SKIP THE 1ST CHAR AFTER THE LINE NUMBER + JRST RCHTRA ;RETURN THE NEXT CHAR FROM THIS CALL TO RCH. +] +] ;END IFN TS, + +VBLK +LIMBO1: 0 ;LAST CHARACTER READ BY RCH +RCHMOD: 0 ;CURRENT INPUT MODE, 0 => INPUT FROM FILE, 1 => MACRO, ETC. +CLNN: 0 ;1 LESS THAN LINE # IN CURRENT INPUT FILE. +CPGN: 0 ;1 LESS THAN PAGE # IN CURRENT INPUT FILE +A.STPL: 0 ;1 LESS THAN LINE # TO STOP AT. +A.STPP: 0 ;1 LESS THAN PAGE # TO STOP AT. + ;(STOPPING MEANS INSERTING THE TTY) + +;READ CHARACTER INTO A FROM INPUT FILE, MACRO, OR WHATEVER (RCH) +;CLOBBERS A,CH1,CH2. + +RCH: TLZE FF,FLUNRD + JRST RCH1 ;RE-INPUT LAST ONE +RCH2: HALT ;ILDB A,UREDP ;ILDB A,CPTR ;GET CHAR + 0 ;CAIG A,14 ;TRZE A,200 ;CHECK FOR SPECIAL + 0 ;XCT RPATAB(A) ;PUSHJ P,MACTRM ;SPECIAL, PROCESS + MOVEM A,LIMBO1 ;GOT CHAR, SAVE AS LAST CHAR GOTTEN +IFE TS,RCHLS1==JRST TYPCTL +IFN TS,RCHLS1==RET ;DEFAULT CONTENTS OF RCHLST (IF NOT LISTING) +RCHLST: RCHLS1 ;AOSN PNTSW IF LISTING. +IFN LISTSW,[ + PUSHJ P,PNTR + CAIG A,15 + JRST RCHL1 +RCHL3: IDPB A,PNTBP +TYPCTL: POPJ P, ;OR JRST SOMEWHERE +PBLK + +RCHL1: CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + JRST RCHL3 +RCHL2: MOVEM A,LISTBC + SETOM PNTSW + JRST TYPCTL + +VBLK +RCH1: MOVE A,LIMBO1 +RCH1LS: RET ;OR CAILE A,15 IF LISTING. + RET ;NEEDED IN CASE LISTING. + CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + POPJ P, + JRST RCHL2 +PBLK +] ;END IFN LISTSW, + +IFE LISTSW,[ +PBLK +RCH1: MOVE A,LIMBO1 + RET +] ;END IFE LISTSW, + +;;GETSYL ;VARIOUS SYLLABLE READING ROUTINES (BUT NOT ALL OF THEM) + +GSYL: CLEARB SYM,STRCNT +GSYL1: MOVEI D,6 + MOVE T,[440700,,STRSTO] + MOVEM T,STRPNT +GSYL3: AOSG A,STRCNT + JRST (F) + PUSHJ P,RCH + IDPB A,STRPNT ;STORE CHAR IN STRING EVEN IF DELIMITER (MINIMUM STRCNT = 1) +A.GSY2: CAIN A,". + JRST GSYL1C + HLRZ CH1,GDTAB(A) + CAIN CH1,(JSP CH2,) + JRST GSYL1A ;NUMBER + PUSHJ P,GSYL1B ;RETURN ONLY ON SYL SEP + HRRZ A,GDTAB(A) + MOVE T,LIMBO1 +C%: POPJ P,"% + +GSYL1B: XCT GDTAB(A) ;POPJ FOR SYL SEPS + SUB P,[1,,1] +GSYL1D: SOJGE D,GSYL3 + AOJA D,GSYL3 + +GSYL1C: ADD SYM,%.SQ(D) + JRST GSYL1D + +GSYL1A: XCT NSQTB-60(A) + JRST GSYL1D + + ;VERSION OF GETSYL TO TRY UNTIL SYL OR WORD TERMINATOR FOUND + ;SKIPS IF NAME THERE (FOR .TYPE, SQUOZE) + +GTSLD2: TLNN C,DWRD\DFLD + JRST GTSLD3 ;DELIMITER IS WORD TERMINATOR, TOLERATE THE NULL SYLLABLE +GETSLD: PUSHJ P,GETSYL ;ENTRY, GET A SYL + MOVE C,CDISP ;GET CDISP + TRNN I,IRSYL + JRST GTSLD2 ;NO SYL + AOS (P) ;GOT SYL, CAUSE RETURN TO SKIP +GTSLD3: TLNN C,DWRD\DFLD + TLO FF,FLUNRD ;CAUSE DELIMITER TO BE RE-INPUT + POPJ P, + +PASSPS: SKIPA A,LIMBO1 +GPASST: CALL RCH + CAIE A,40 + CAIN A,^I + JRST GPASST + RET + +GETSYL: TLZ I,ILUARI+ILNPRC+ILLSRT +GTSL1: CLEARB SYM,NUMTAB ;RECUR HERE FOR RIGHT ARG TO ^ AND _. + MOVE AA,[NUMTAB,,NUMTAB+1] + AOSN NTCLF + BLT AA,NUMTAB+10 ;NUMTAB NOT CLEAR, HAVE TO CLEAR IT + MOVEI D,6 ;CHARACTER COUNTER FOR BUILDING UP SYM + SETOM ESBK ;NO SPECIFIC BLOCK DESIRED. + TDZ I,[ILDECP+ILFLO+ILVAR+ILGLI,,IRPERI+IRLET+IRSYL] +RRL2: PUSHJ P,RR ;CALL MAIN LOOP ROUTINE, READ UNTIL NON-SQUOZE CHAR +SEMICR: ;RETURN HERE FROM SEMIC WITH CR IN A + MOVEM A,LIMBO1 ;SYLLABLE OPERATOR OR TERMINATOR IN A, SAVE + HRRZ A,GDTAB(A) ;NOW GET RIGHT HALF OF POPJ, INDEX INTO DTB + MOVE C,DTB-40(A) ;GET DTB ENTRY (FLAGS,,JUMP ADR) + MOVEM C,CDISP ;STORE AS DISPATCH CODE FOR LAST CHAR (SORT OF AN INTERPRETED LIMBO1) +RR8: TLNE C,DSYL ;NOW SEE IF SYL OPERATOR FLAG SET + JRST (C) ;SET => INTRA-SYLLABLE OPERATOR +RR10: TRNE I,IRLET ;NOT SET => SYLLABLE TERMINATOR: SYL? + POPJ P, ;SYL HAS LETTERS + TRNN I,IRSYL + JRST CABPOP ;NO SYL + CAMN SYM,[SQUOZE 0,.] + JRST PT1 ;SYM IS . + ;NUMBER + +RR5: TLNN I,ILNPRC + PUSHJ P,NUMSL + TLNN I,ILFLO + JRST RR9 ;NOT FLOATING POINT + MOVE A,B ;FLOATING, HIGH IN AA,LOW IN A,EXP IN B + ADDI A,306 ;201+105 TO ROUND + ADDI AA,200 ;CAUSE EXPONENT TO BE ACCEPTABLE TO MACHINE + JUMPGE AA,.+3 ;NOW CHECK FOR OVERFLOW ON ROUNDING + LSH AA,-1 ;OVERFLOW, SHIFT BACK ONE + AOS A ;INCREMENT EXPONENT TO COMPENSATE FOR SHIFT + EXCH A,AA ;GET EXPONENT IN AA, REST IN A + ASHC AA,-10 ;SHIFT TO MACHINE FLOATING POINT FORMAT + SKIPE AA ;NOW CHECK HIGH ORDER BITS OF EXPONENT NOT SHIFTED INTO NUMBER + ETR [ASCIZ /Exponent overflow/] +RR9: TLZ I,ILGLI+ILVAR ;NOT TRYING TO DEFINE NUMBER AS VARIABLE OR GLOBAL +CLBPOP: TDZA B,B ;CLEAR OUT B (RELOCATION BITS OF VALUE) +CABPOP: SETZB A,B ;DO JRST CABPOP TO RETURN ZERO AS VALUE + POPJ P, + +RRU: MOVE A,LIMBO1 ;GET HERE WHEN FLUNRD SET AT RR, RETRIEVE CHARACTER FROM LIMBO1 + CAIG A,14 ;IF TOO BIG, + CAIGE A,12 ;OR IF TOO SMALL, + JRST RR1B ;THEN JUST FALL BACK IN + TLNN FF,FLVOT\FLMAC\FLTTY ;SKIP IF NOT HACKING CPGN/CLNN + XCT RRUTAB-12(A) ;HACKING, UNHACK FOR HACK COMING UP + JRST RR1B ;FALL BACK IN + +RRUTAB: SOS CLNN ;LINE FEED (TABLE FOR RRU) + JRST RR1B ;13 + SOS CPGN ;FORM FEED + + ;MAIN LOOP ROUTINE FOR GETSYL, READ SYM OR NUMBER +VBLK +RR: TLZE FF,FLUNRD ;RE-INPUT LAST CHARACTER? + JRST RRU ;YES +RR1: JRST RRL1 ;ILDB A,CPTR ;GET CHAR (" " ") + HALT ;TRZE A,200 ;CHECK FOR END OF STRING +RREOF: PUSHJ P,RCH ;PUSHJ P,MACTRM ;PROCESS CONDITION, GET NEXT CHAR OR JRST RR1 OR RRU + .SEE RCHTRA ;SPECIAL HANDLING OF UNRCHF IN RCHTRA IF CALLED FROM HERE. +RR1B: XCT GDTAB(A) ;GOT CHAR, DO SOMETHING APPROPRIATE (POPJ ON NOT SQUOZE) + TROA I,IRLET\IRSYL ;LETTERS RETURN, JUST UPDATED SYM, SET FLAGS + TRO I,IRSYL ;NUMBERS RETURN, SET FEWER FLAGS + SOJGE D,RR1 ;DECREMENT SYM COUNTER AND LOOP + AOJA D,RR1 ;COUNTER EXHAUSTED, INCREMENT BACK TO 0 AND LOOP + +RRL1: PUSHJ P,RCH ;ILDB A,UREDP ;GET CHAR + XCT GDTAB(A) ;NOW MAKE LIKE RR1B (EOFCH => JRST RREOF) + TROA I,IRLET\IRSYL + TRO I,IRSYL + SOJGE D,RRL1 + AOJA D,RRL1 + + ;SEMICOLON (GET HERE FROM RR8) + + JRST SEMICL ;RETURN HERE FROM SEMIC+2 WHEN FLUNRD SET +;NEXT 4 INSNS ALTERED IN DIFFERENT INPUT MODES. SEE RCHFIL, ETC. +SEMIC: PUSHJ P,RCH ;GET CHAR + CAIE A,15 ;SEE IF SPECIAL + JRST SEMIC ;SPECIAL => DO SOMETHING (JRST SEMICR ON CR) + JRST SEMICR ;IF NOT SPECIAL THEN GO BACK FOR NEXT CHAR + +LOC SEMIC+6 ;LEAVE A LITTLE EXTRA ROOM FOR BIG ROUTINES +PBLK + +SEMICL: MOVE A,LIMBO1 ;HERE FROM SEMIC-1, RETRIEVE CHARACTER FROM LIMBO1 + CAIE A,15 ;SKIP IF SHOULD TERMINATE SCAN + JRST SEMIC ;NOT CR, FALL BACK IN + JRST SEMICR ;DONE + +SEMIC2: +REPEAT 5,[ + ILDB A,UREDP + CAIG A,15 + XCT RPATAB(A) +] + MOVE A,[ASCII /@@@@@/] +SEMIC1: AOS CH1,UREDP + MOVE CH1,(CH1) ;ANY CONTROL CHARS IN THE WORD UREDP POINTS AT? + MOVE CH2,CH1 + AND CH1,A + AND CH2,[ASCII/ /] + LSH CH2,1 + IOR CH1,CH2 + CAMN CH1,A + JRST SEMIC1 ;NO, ADVANCE TO NEXT WORD AND TEST IT. + MOVEI A,440700 + HRLM A,UREDP + JRST SEMIC2 ;YES, LOOK AT EACH CHAR AND PROCESS IT. + +SEMIC3: REPEAT 6,JRST SEMIC2+3*<5-.RPCNT> + +;JSP CH2,RR2 => DIGIT (FROM GDTAB) +;THIS ROUTINE IS GROSSLY SLOW, AND SHOULD BE SPEEDED UP SOMETIME + +RR2: XCT NSQTB-"0(A) ;UPDATE SQUOZE. + TRNE I,IRLET + JRST 1(CH2) ;SYL IS SYM, DON'T WASTE TIME. + TRNE I,IRPERI + TLO I,ILFLO ;DIGIT AFTER . => FLOATING. +MAKNUM: SETOM NTCLF ;NUMTAB ABOUT TO NOT BE CLEAR, SET FLAG FOR GETSYL TO CLEAR IT OUT NEXT TIME + MOVEI AA,2 ;INDEX INTO NUMTAB ETC., SOJGE'D TO GET ALL RADICES +MAKNM1: MOVE T,ARADIX(AA) ;GET THIS RADIX, + CAMN T,ARADIX ;REDUNDANT => SKIP THIS PASS. + JUMPN AA,MAKNM4 + SKIPGE CH1,HIGHPT(AA) + JRST MAKNM3 + MUL T,LOWPT(AA) ;TT HAS OLD LOW TIMES RADIX, T HAS OVFLO TO HIGH. + ADDI TT,-"0(A) ;ADD DIGIT TO LOW PART + TLZE TT,400000 + AOJ T, ;OVERFLOW, INCREMENT SPILLOVER FROM MUL OF LOWPT + JUMPE CH1,MAKNM5 ;OLG HIGHPT WAS 0 => SAVE TIME. + JFCL 17,.+1 ;NOW CLEAR OV, ETC. + IMUL CH1,ARADIX(AA) ;MULTIPLY HIGHPT BY RADIX + ADD T,CH1 ;ADD HIGH PARTS + JFCL 10,MAKNM2 ;JUMP ON OVERFLOW FROM IMUL OR ADD +MAKNM5: TLNE I,ILFLO + SOS NUMTAB(AA) ;FLOATING, DECREMENT EXP TO COMPENSATE FOR MULT OF HIGHPT/LOWPT + MOVEM T,HIGHPT(AA) ;NOW STORE STUFF BACK + MOVEM TT,LOWPT(AA) +MAKNM4: SOJGE AA,MAKNM1 ;NOW DO ALL THIS FOR NEXT RADIX + JRST 1(CH2) + +MAKNM2: MOVSI B,400000 ;OVERFLOW FROM UPDATING HIGH PARTS + IORM B,HIGHPT(AA) ;SET SIGN BIT +MAKNM3: TLNN I,ILFLO + AOS NUMTAB(AA) ;NOT FLOATING, INCREMENT EXP, MAY NOT WANT TRAILING BITS + JRST MAKNM4 + +VBLK +NUMTAB: 0 ;EXPONENT + 0 + 0 +HIGHPT: 0 ;HIGH PART OF CURRENT NUMBER THIS RADIX + 0 ;4.9 => OVERFLOW, TRAILING DIGITS DROPPED + 0 +LOWPT: 0 ;LOW PART OF CURRENT NUMBER THIS RADIX + 0 ;HIGHPT/LOWPT TAKEN AS 70. BIT POSITIVE INTEGER EXCEPT 4.9(HIGHPT) IS FLAG INSTEAD OF + 0 ;EXPONENTIATE 70. BIT INTEGER BY NUMTAB (WHICH MAY BE NEGATIVE) TO GET ACTUAL VALUE +ARADIX: 10 ;CURRENT RADIX + 12 + 10 + +NTCLF: -1 ;-1 => NUMTAB NOT CLEAR (TO SAVE BLT AT GETSYL WHEN CLEAR) +PBLK + +;JRST POINT => . (FROM GDTAB) + +POINT: TLO I,ILDECP ;PREFER DECIMAL + TROE I,IRPERI ;SET PERIOD FLAG + TRO I,IRLET ;2 POINTS => NAME + ADD SYM,%.SQ(D) ;UPDATE SYM + JRST 1(CH1) ;RETURN + +RBRAK: SOSL SCNDEP ;IF A CONDITIONAL TO TERMINATE, + JRST RBRAK2 ;HAVE DONE SO, IGNORE CHAR. + SETZM SCNDEP +;CLOSES OF ALL KINDS COME HERE. +RPARN: +GRTHN: MOVE A,LIMBO1 + SKIPE CH1,ASMOUT ;WHAT KIND OF OPEN ARE WE IN? + CAIN CH1,4 ;WITHIN A .ASCII OR + JRST RBRAK1 ;NOT WITHIN GROUPING => THIS CLOSE IS STRAY. + CAME A,ASMOT1(CH1) ;RIGHT KIND OF CLOSE FOR THAT OPEN? + ERJ RBRAK3 +RBRAK4: MOVE CH1,ASMOT2(CH1) + MOVEM CH1,ASMDSP ;ARRANGE FOR THIS ASSEM1 LEVEL TO EXIT +RBRAK5: SETZM CDISP + JRST RR10 ;AND GO TERMINATE WORD. + +RBRAK3: CALL TYOERR ;COME HERE ON CLOSE WRONG FOR OPEN. + ;(EG, ")" MATCHING "<"). + TYPR [ASCIZ/ Seen when /] + MOVE A,ASMOT1(CH1) + CALL TYOERR + TYPR [ASCIZ/ expected +/] + JRST RBRAK4 + +RBRAK1: CAIN CH1,4 ;CLOSE INSIDE A .ASCII => + JRST RBRAK5 ;TERMINATE WORD BUT DON'T CLOSE ANYTHING. + SKIPN CONSML ;COME HERE FOR STRAY CLOSE. + JRST RRL2 + ERJ .+1 + TYPR [ASCIZ/Stray /] + MOVE A,LIMBO1 ;GET THE CLOSE WE SAW. + CALL TYOERR + CALL CRRERR + JRST RRL2 + +;COME HERE FOR CLOSE-BRACE, AND CERTAIN CLOSE-BRACKETS. +RBRAK2: SETOM A.SUCC ;HAVE JUST ENDED SUCCESSFUL BRACKETED CONDIT, + JRST RRL2 ;REMEMBER THAT MOST RECENT CONDITIONAL WAS TRUE. + +FORMF: TLNN FF,FLVOT\FLMAC\FLTTY ;FORM FEED SYLLABLE OPERATOR ROUTINE + PUSHJ P,RPAFF ;UNLESS ALREADY DONE, INCREMENT PAGE #. + JRST RR10 + +LINEF: TLNN FF,FLVOT\FLMAC\FLTTY ;LINE FEED SYLLABLE OPERATOR ROUTINE + CALL RPALF + JRST RR10 + +CTLAT: +IFN DECSW\TNXSW,[ + TLNN FF,FLVOT\FLMAC\FLTTY ;^@ SYLLABLE OPERATOR ROUTINE. + CALL RPANUL +] + JRST RRL2 + +;DECIPHER A VALUE FROM NUMTABS +;LEAVES HIGH PART IN AA, LOW PART IN A, BINARY EXPONENT IN B +;AND RADIX USED IN D. + +NUMSL: TLNN I,ILVAR\ILDECP\ILFLO + SKIPE B,HIGHPT + JRST NUMSLS + MOVE A,LOWPT ;BE VERY FAST IN CASE OF SMALL FIXNUM IN CURRENT RADIX. + MOVE D,ARADIX ;SAVE RADIX AND HIGH PART FOR ^. + SETZ AA, + RET + +NUMSLS: CLEARB TT,D ;TT BIT EXPONENT, D INDEX INTO NUMTAB, ETC. + TLNE I,ILDECP+ILVAR ;NEITHER . NOR ', CURRENT RADIX. + TLNE I,ILGLI ;" => CURRENT RADIX DESPITE . OR '. + JRST NUMSL0 + MOVEI D,1 ;DECIMAL UNLESS ' + TLNE I,ILVAR ;WHICH FORCES OCTAL. + MOVEI D,2 + MOVE A,ARADIX(D) + CAMN A,ARADIX ;IF REALLY SAME AS CURRENT RADIX, + MOVEI D,0 ;COMPUTATION WASN'T DONE FOR THIS VALUE OF D, + ;SO USE COMPUTATIONS DONE FOR CURRENT RADIX. +NUMSL0: MOVE AA,HIGHPT(D) ;AA := HIGH PART + MOVE B,LOWPT(D) ;B := LOW PART + MOVE T,NUMTAB(D) ;T := EXPONENT + MOVE D,ARADIX(D) ;NO LONGER NEED IDX, GET RADIX VALUE. + TLNN I,ILFLO + JRST FIXNUM ;NOT FLOATING + TLZ AA,400000 ;FLOATING, DON'T NEED DIGITS LOST ON OVERFLOW +NUMC1: JUMPN AA,.+2 ;ENTRY FROM UPARR + JUMPE B,FIX0 ;COMPLETELY ZERO => RETURN FIXED ZERO + JUMPL T,NUMSL1 ;JUMP IF EXPONENT NEGATIVE + JUMPE T,NUMSL2 ;JUMP (SKIP FOLLOWING) IF EXPONENT ZERO + ;EXPONENT POSITIVE, DO THE APPROPRIATE THING +NUMSL5: MULI B,(D) ;MULITIPLY LOW PART BY RADIX + MULI AA,(D) ;MULTIPLY HIGH PART BY RADIX + ADD A,B ;A := LOW PART OF HIGH + HIGH PART OF LOW + TLZE A,400000 + ADDI AA,1 ;OVERFLOW ON ADDITION, INCREMENT HIGH PART OF HIGH + MOVE B,C ;NO LONGER NEED HIGH OF LOW, GET LOW OF LOW IN B +NUMSL3: JUMPE AA,NUMSL4 ;NOW CHECK FOR OVERFLOW INTO HIGH OF HIGH, JUMP ON NONE + ASHC A,-1 ;NEXT THREE INSTRUCTIONS TO DO ASH3 AA,-1 + ASH A,1 + ASHC AA,-1 + AOJA TT,NUMSL3 ;INCREMENT BIT EXPONENT AND TRY AGAIN + +NUMSL4: MOVE AA,A ;FLUSHED OVERFLOW, NOW GET (LOW PART OF) HIGH PART IN AA + SOJG T,NUMSL5 ;COUNT DOWN + +NUMSL2: TLNN I,ILFLO + JRST NUMSL9 ;NOT FLOATING, DON'T WASTE TIME NORMALIZING. + SKIPA A,B ;EXPONENT NOW ZERO, GET LOW PART OF NUMBER IN A +NUMSL7: ASHC AA,1 ;NOW NORMALIZE + TLNN AA,200000 + SOJA TT,NUMSL7 + SKIPA B,TT ;DONE NORMALIZING, RETURN BINARY EXPONENT IN B +PT1: TRO I,IRLET + POPJ P, + +NUMSL9: MOVE A,B + MOVEI B,0 + ASHC AA,(TT) ;SHIFT 2-WD NUM. BY EXPONENT, + LSH A,1 ;PUT HIGH BIT IN WITH REST. + JRST FIX1 + +FIX0: TLZ I,ILFLO +FIXNUM: LSHC A,45 +FIX1: LSHC AA,-1 + JUMPE AA,.+2 + ETR [ASCIZ /FIXNUM too big for 36 bits/] + POPJ P, + +NUMSL1: SKIPA A,B ;EXPONENT NEGATIVE: NORMALIZE NOW +NUMSL8: ASHC AA,1 +NUMSL6: TLNN AA,200000 + SOJA TT,NUMSL8 ;NOT NORMALIZED YET + AOS T + MOVEI TM,(D) + TLNN TM,-1 ;GET CONVIENT POWER OF RADIX + JUMPL T,[ IMULI TM,(D) + AOJA T,.-1] + MOVE B,A ;GET NORMALIZED LOW PART IN B + IDIV AA,TM ;DIVIDE HIGH PART BY APPROPRIATE RADIX + DIV A,TM + JUMPL T,NUMSL6 + MOVE B,A + JRST NUMSL2 + +UPARR: TRON I,IRSYL + JRST UPCTRC ;"UNARY UPARROW" => GOBBLE CHARS + TRNE I,IRLET + ETR [ASCIZ /Symbolic 1st arg to "^"/] + PUSHJ P,NUMSL ;DECIPHER NUMTABS + PUSHJ P,UA3 ;GET RIGHT OPERAND IN T + MOVE TT,B ;EXPONENT + MOVE B,A ;LOW PART + PUSHJ P,NUMC1 ;T EXP HIGH IN AA LOW IN B TT BIN EXP + MOVE C,CDISP ;IF A _ WAS DEFERRED WHILE ILUARI WAS SET, + TLO I,ILNPRC + CAME C,[DSYL,,BAKAR] ;DO IT NOW. + JRST RR10 + +BAKAR: TLNE I,ILUARI + JRST RR5 ;RETURN TO UPARROW (WILL COME BACK HERE LATER) + TRNE I,IRSYL + TRNE I,IRLET + JRST BAK1 ;NO SYL, OR SYL IS NAME + CAMN SYM,[SQUOZE 0,.] + JRST BAK1 ;. ALSO NAME + TLZN I,ILNPRC + PUSHJ P,NUMSL + PUSHJ P,UA3 + ADD B,T + ASHC AA,(B) + LSH A,1 + LSHC AA,-1 + CLEARB B,AA + TLZ I,ILFLO + MOVE C,[DFLD,,CBAKAR] + EXCH C,CDISP ;IF 2ND ARG ENDED WITH A _, TURN INTO FIELD OP. + CAME C,[DSYL,,BAKAR] + EXCH C,CDISP + POPJ P, + +UPCTRC: SETZ T, +UPCTR1: JSP F,QOTCOM ;UP ARROW TO GOBBLE SYL AND RETURN MASKED ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + CAIL A,140 + SUBI A,40 + ANDI A,77 ;NOW MASK CHARACTER IN TO TO BOTTOM 6 BITS + ADD T,A ;ADD TO ACCUMULATED + POPJ P, + +BAK1: MOVE TT,[DFLD,,CBAKAR] + MOVEM TT,CDISP + JRST RR10 + +UA3: HRLM D,(P) ;SAVE RADIX (FOR UPARR) + JSP LINK,SGTSY ;PUSH I,AA,A,B + TLO I,ILUARI ;TELL _ TO WAIT TILL LATER (SEE UPARR, BAKARR) + PUSHJ P,RCH + CAIN A,"- + TROA I,IRGMNS + TLO FF,FLUNRD + PUSHJ P,RCH + CAIN A,"< + JRST UAR1 + TLO FF,FLUNRD +UA3L: PUSHJ P,GTSL1 ;GOBBLE SYL, LOOP POINT FOR PSEUDO OR MACRO RETURNED WITHOUT VALUE + TRNE I,IRLET + JRST UA3S ;NAME + TLNE I,ILFLO + ETR [ASCIZ /Floating point 2nd arg to "_"/] +UAR2: TRZN I,IRGMNS + SKIPA T,A + MOVN T,A + JSP LINK,SGTSY1 ;RESTORE GETSYL TEMPS. + HLRZ D,(P) + POPJ P, + +UA3S: PUSHJ P,GETVAL ;MAKE NUMBER_NAME WORK + JRST UA3SR ;GOT VALUE, PROCESS + JRST UA3L ;NO VALUE, TRY AGAIN + +UAR1: TLO I,ILLSRT + TRZ I,IRSYL ;(OR ELSE LSSTH GIVES NOS ERROR.) + SETZB A,B + PUSHJ P,LSSTH +UA3SR: JUMPN B,RLCERR ;RELOC ERR + JRST UAR2 + +ATSGN: MOVSI A,20 ;ATSIGN + IORM A,WRD + TRO I,IRFLD ;SET IRFLD FLAG EVEN THOUGH NOT DIRECTLY RETURNING VALUE + ; ^ CHANGED FROM SYL TO FIELD 9/6/70 + JRST RRL2 ;FALL BACK IN + +DQUOTE: TRON I,IRSYL + JRST DQUOT8 + TRNN I,IRLET ;AFTER NUMBER => CURRENT RADIX. + JRST DQUOT7 + PUSHJ P,RCH + TLO FF,FLUNRD ;NEXT CHAR. SQUOZE? + HLRZ A,GDTAB(A) + CAIN A,(POPJ P,) + JRST DQUOT7 ;NO => MAKE PREV. SYM. GLOBAL. + CAMN SYM,[SQUOZE 0,.M] ;SPECIAL BLOCK NAMES + JRST DQUOTM ;.M MEANS MAIN BLOCK, + CAMN SYM,[SQUOZE 0,.U] + JRST DQUOTU ;.U MEANS SUPERIOR. + CAMN SYM,[SQUOZE 0,.C] + JRST DQUOTC ;.C MEANS CURRENT BLOCK. + SKIPGE A,ESBK ;GET SPEC'D BLOCK OR CURRENT, + HRR A,BKCUR ;LOOK FOR SUBBLOCK OF THAT BLOCK. + HLL A,BKTAB+1(A) + ADD A,[1,,] ;LH HAS LEVEL SUBBLOCK OUGHT TO HAVE. + MOVEI T,0 + SETO D, ;NO POSSIBLE ALTERNATE CHOICE YET. +DQUOT0: CAME SYM,BKTAB(T) ;LOOK AT ALL BLOCKS SEEN. + JRST DQUOT1 ;HAS THE NAME WE'RE LOOKING FOR? + SKIPGE ESBK ;IF LOOKING FOR A SUBBLOCK OF A PARTICULAR BLOCK, + JRST DQUOT4 + CAMN A,BKTAB+1(T) + JRST DQUOT2 ;SUCH A BLOCK WINS; ALL OTHERS LOSE. + JRST DQUOT1 + +DQUOT4: SKIPN BKTAB+2(T) ;ELSE PREFER DEFINED BLOCKS TO UNDEFINED ONES. + JUMPGE D,DQUOT1 + SKIPE BKTAB+2(T) + JUMPL D,DQUOT5 + CAME D,[-1] ;THAT'S THE SAME EITHER WAY => PREFER AN INFERIOR + CAMN A,BKTAB+1(T) ;OF THE CURRENT BLOCK TO ONE THAT'S NOT. + JRST DQUOT5 + JRST DQUOT1 + +DQUOT5: HRROI D,(T) ;FOUND A BLOCK WE LIKE BEST SO FAR. + SKIPE BKTAB+2(T) + ANDI D,-1 ;LEAVE SIGN OF D SET UNLESS THE BLOCK IS DEFINED. +DQUOT1: ADDI T,BKWPB + CAMGE T,BKTABP + JRST DQUOT0 + HRRZI T,(D) ;NOW USE THE BEST BLOCK FOUND, IF THERE WAS ONE. + CAIE T,-1 + JRST DQUOT2 + MOVE T,BKTABP ;NOT FOUND, GET IDX OF 1ST UNUSED ENTRY. + CAIL T,BKTABS + ETF ERRTMB ;NO ROOM FOR MORE BLOCKS. + MOVEM SYM,BKTAB(T) + MOVEM A,BKTAB+1(T) ;ADD BLOCK AT END. + MOVEI A,BKWPB(T) + MOVEM A,BKTABP ;POINTS AFTER LAST USED ENTRY. +DQUOT2: MOVEM T,ESBK + SETZ SYM, +DQUOT3: MOVEI D,6 ;NEXT CHAR GOES IN 1ST SQUOZE POS. + JRST RRL2 + +DQUOTM: MOVEI T,BKWPB ;.M - MAIN BLOCK FOLLOWS INITIAL SYMS BLOCK. + JRST DQUOT2 + +DQUOTU: SKIPGE T,ESBK ;.U SPEC'D - GET SPEC'D OR CURRENT BLOCK, + MOVE T,BKCUR + HRRZ T,BKTAB+1(T) + JRST DQUOT2 ;SPEC. ITS SUPERIOR. + +DQUOTC: SKIPGE T,ESBK ;.C => SPEC THE CURRENT BLOCK. + MOVE T,BKCUR + JRST DQUOT2 + +SQUOT1: TLOA I,ILVAR +DQUOT7: TLO I,ILGLI + MOVE A,BKCUR ;IF NO SPEC'D BLOCK, + SKIPGE ESBK + MOVEM A,ESBK ;SPEC. CURRENT BLOCK. + JRST RRL2 + +DQUOT8: SETZ T, +DQUOT9: JSP F,QOTCON ;DOUBLE QUOTE TO GOBBLE SYL AND RETURN ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + ADD T,A ;ADD IN ASCII CHARACTER IN A + POPJ P, ;RETURN TO SOMETHING + +SQUOTE: TROE I,IRSYL + JRST SQUOT1 + SETZ T, +SQUOT9: JSP F,QOTCON ;SIXBIT SYL + CAIGE A,40 + ETR ERRN6B ;NOT SIXBIT + CAIL A,140 + SUBI A,40 ;CONVERT TO UPPER CASE + LSH T,6 ;SHIFT OVER ACCUMULATED VALUE + ADDI T,-40(A) ;ADD IN SIXBIT FOR CHARACTER IN A + POPJ P, + +;COMMON ROUTINE FOR RIGHT JUSTIFIED TEXT SYLS +;CALLED WITH JSP F,; ROUTINE PUSHJ'S BACK W/ CHAR IN T, ACCUM VALUE IN A +;SYL FLAG EXPECTED TO BE ALREADY SET +QOTCON: SKIPE QMTCH ;' AND " COME HERE, BUT NOT ^: IF IN QUOTES-MATCHING MODE, USE A + JRST QOTCO4 ;FAIL-LIKE ALGORITHM. HERE FOLLOWS THE OLD MIDAS WAY OF DOING IT +QOTCOM: CALL RCH ;USE AT LEAST 1 CHAR IN ANY CASE. + JRST QOTCO1 + +QOTCO2: CALL RCH ;USE SUCCEEDING CHARS IF SQUOZE CHARS. + HLRZ CH1,GDTAB(A) + CAIN CH1,(POPJ P,) + JRST QOTCO3 +QOTCO1: CALL (F) + JRST QOTCO2 + +QOTCO3: CAIN A,"" ;NONSQUOZE: IF IT IS A TEXT SYL INDICATOR, + JRST DQUOT9 ;CONTINUE WITH WHATEVER TYPE OF TEXT + CAIN A,"' + JRST SQUOT9 ;IT INDICATES. + CAIN A,"^ + JRST UPCTR1 +QOTCO6: TLO FF,FLUNRD + JRST TEXT5 + +QOTCO4: MOVE B,LIMBO1 ;GET ' OR ", WHICHEVER STARTED THIS SYL, AS THE DELIMITER. + MOVE SYM,[SQUOZE 0,TEXT] + JSP TM,ERMARK +QOTCO5: CALL RCH + CAMN A,B ;FOUND ANOTHER EXAMPLE OF THE DELIMITER? + JRST [ CALL RCH ;IF DUPLICATED, IT PUTS THE DELIMITER IN THE CONSTANT. + CAMN A,B + JRST .+1 + JRST QOTCO6] ;OTHERWISE UNREAD THE CHAR AFTER THE DELIMITER AND EXIT. + CALL (F) ;HAVE CHAR TO PUT IN STRING IN A; GO MERGE IT IN. + JRST QOTCO5 + +;RETURN A VALUE FROM A PSEUDO WHOSE ARGS CAN BE TERMINATED BY EITHER COMMA (GOBBLED) +;OR CR (NOT GOBBLED). +VALRET: MOVE T,A ;ROUTINE TO RETURN VALUE IN A AFTER LAST CHAR GOBBLED BY GETSYL + MOVE B,CDISP ;GET STORED DISPATCH CODE + TLNN B,DWRD\DFLD + JRST VALR1 ;WORD TERMINATOR +;COME HERE TO RETURN A VALUE, AND ALSO +;BARF IF THE NEXT CHARACTER ISN'T A SYLLABLE SEPARATOR +TEXT5: PUSH P,T ;ENTRY FROM TEXT ROUTINES (NLAST CHAR NOT GOBBLED BY GETSYL) TO RETURN VALUE IN T + PUSHJ P,GETSYL ;SEE IF IMMEDIATELY FOLLOWED BY SYL + TRNE I,IRSYL + ETR ERRNOS ;NO SEPARATOR BETWEEN TWO VALUES + POP P,A ;RESTORE VALUE TO RETURN +VALR1: TRO I,IRSYL + JRST CLBPOP + +;VARIOUS PUSH AND POP ROUTINES, ALL CALLED W/ JSP LINK, + +SGTSY: PUSH P,I + PUSH P,AA + PUSH P,A + PUSH P,B + JRST (LINK) + +SGTSY1: POP P,B + POP P,A + POP P,AA + POP P,I + JRST (LINK) + +;JSP LINK,SAVWD1 TO SAVE STUFF FOR < OR (, ETC. + +SAVWD1: PUSH P,A ;SYLL. BEFORE GROUPING NOW STARTING. + PUSH P,B ;AND ITS RELOC. + +SAVWLD: PUSH P,FORMAT + PUSH P,FORPNR + PUSH P,FLDCNT + PUSH P,GLSP2 + PUSH P,I + PUSH P,WRD + PUSH P,WRDRLC + PUSH P,SYM + PUSH P,PPRIME + PUSHJ P,(LINK) +SAVL1==. + +;POP OFF WHAT PUSHED BY SAVWLD. CLEARS FLUNRD, IN CASE THE > OR ) WAS UN-READ. + +USVWLD: POP P,SYM + HRRZS SYM + CAIE SYM,SAVL1 + HALT + TLZ FF,FLUNRD + POP P,PPRIME + POP P,SYM + POP P,WRDRLC + POP P,WRD + TDZ I,[-1-(ILWORD)] + IOR I,(P) + POP P,1(P) + POP P,GLSP2 + POP P,FLDCNT + POP P,FORPNR + POP P,FORMAT + JRST (LINK) + +;;GETFD ;GET FIELD (EXPRESSION); RETURN VALUE IN A, RELOC BITS IN B + + ;GET FIELD FOR PSEUDO + ;SYM SHOULD CONTAIN THE SQUOZE NAME OF THE PSEUDO + ;OR A POINTER TO AN INSN TO EXECUTE WHEN UNDEF + ;SYMBOL SEEN. SYM IS NOT CLOBBERED. + +AGETFD: PUSH P,I ;SAVE I + TRO I,IRPSUD+IRNOEQ ;SET FLAG TO GETVAL TO EXECUTE GTVER ON UNDEFINED SYM ON EITHER PASS + PUSH P,GTVER ;OLD VALUE OF GTVER + MOVEM SYM,GTVER ;ERROR MSG SHOULD GIVE NAME OF PSEUDO. + CALL YGETFD + MOVE SYM,GTVER + REST GTVER + MOVEM I,ISAV ;SAVE FLAGS FOR FIELD GOTTEN +POPIJ: POP P,I + POPJ P, + +;READ A FIELD, NOT PART OF THE CURRENT WORD. +YGETFD: PUSH P,WRD + SETZM WRD + CALL XGETFD + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + ADD A,WRD ;ADD IN INDEX, INDIRECT FIELDS + POP P,WRD + POPJ P, + +IFN FASLP,[ +FAGTFD: PUSHJ P,AGETFD ;DO AGETFD, COMPLAIN IF RELOCATABLE OR GLOBAL + MOVE TM,GLSP1 + CAMN TM,GLSP2 + SKIPE B + ETSM [ASCIZ /relocatable or external argument/] + POPJ P, +] +;READ A FIELD PART OF CURRENT WORD (FOR XWD, ETC). +XGETFD: PUSH P,PPRIME +AGTFD3: PUSHJ P,GETFLD + MOVE CH1,CDISP + TLNN CH1,DWRD + TLOA FF,FLUNRD ;DELIMITER IS WORD TERMINATOR => RE-READ IT. + TRNE I,IRFLD ;NON-NULL FIELD SUPPLIED => RETURN IT. + JRST AGTFD4 + HRRZ C,CDISP ;ELSE COMMA => RETURN NULL VALUE (0) + CAIN C,SPACE ;SPACE => TRY AGAIN TO READ A FIELD. + JRST AGTFD3 ;NO FIELD, TRY AGAIN +AGTFD4: REST PPRIME + POPJ P, + + ;IN RELOCATABLE FORMAT + ;READ FIELD AND COPY OUT AS WORD + +RGETFD: SETZM WRD ;FIRST INITIALIZE SOME STUFF AS THOUGH AT GETWD + SETZM WRDRLC + MOVE A,GLSPAS + MOVEM A,GLSP1 + MOVEM A,GLSP2 + CALL XGETFD + ADDM A,WRD + ADDM B,WRDRLC + PUSHJ P,PWRDA ;OUTPUT WORD + TLNE I,ILMWRD + JRST IGTXT ;SOAK UP MULTI-WORD FIELD + POPJ P, + +;READ IN A FIELD, RETURN IN A,B SETTING IRFLD IF FIELD NOT NULL. +GETFLD: PUSH P,GLSP1 ;REFERED TO AS GETFLB(P) WHEN ONLY 1 SYL PUSHED. + MOVEM P,PPRIME + TRZ I,IRFLD+IROP +GETFD1: TLNE I,ILMWRD + JRST GETFD9 ;MULTIPLE WORD, RE-CALL PSEUDO + PUSHJ P,GETSYL + TRNE I,IRLET +GETFD9: PUSHJ P,GETVAL ;GET OPERAND (MAYBE SKIPS) +GETFD6: SKIPA C,CDISP ;GET INFO ON SYLLABLE TERMINATOR + JRST GETFD1 ;GETVAL SKIPPED => PSEUDO/MACRO WITH NO VALUE, TRY AGAIN + TLNE C,DFLD + JRST (C) ;FIELD OPERATOR, GO PROCESS + TRNE I,IRSYL ;NO DISP MEANS FIELD TERMINATOR. + TRO I,IRFLD + CAME P,PPRIME ;IF ANY OPERATORS PUSHED, + JSP LINK,GETFD8 ;EVAL THEM. + SUB P,[1,,1] ;FLUSH GLSP1 SAVED AT GETFLD. + RET + +GETFD8: MOVEI TT, ;END OF FIELD HAS VERY LOW PRIORITY. + JRST GETFD7 + +;PUSH AN OPERATOR, MAYBE EVALLING STUFF TO LEFT. +;A HAS LEFT OPERAND (IF ANY), B RELOCATION BITS, +;C ADR OF ROUTINE TO PERFORM OPERATION, LH OF TT HAS PRECEDANCE OF OPERATOR + +GETFDL: MOVEI LINK,GETFD3 ;AFTER MAYBE EVALLING, GO PUSH OPERATOR. + TRO I,IRFLD+IROP + TRNN I,IRSYL + JRST GETFD5 ;UNARY, EVAL NOTHING, JUST PUSH WITH HIGH PRIO. +GETFD2: CAME P,PPRIME ;NO OPS TO LEFT => NOTHING TO EVAL. + CAMLE TT,GETFLP(P) ;COMPARE PRIO OF PREV. OP. AND CURRENT. + JRST (LINK) ;WAIT UNTIL LATER +GETFD7: HRRZ T,GETFLP(P) ;EVAL THE LAST OP ON STACK. + JRST (T) ;GO DO IT NOW (ROUTINE RETURNS TO GETFD4) +GETFD4: SUB P,[4,,4] + JRST GETFD2 + +GETFD5: MOVSI TT,200 ;GIVE UNARY OP HIGH PRIO. TO DO BEFORE NEXT BINARY. +GETFD3: PUSH P,B ;GETFLR(P) + PUSH P,A ;GETFLV(P) + HLL C,TT + PUSH P,C ;GETFLP(P) + PUSH P,GLSP1 ;GETFLG(P) + JRST GETFD1 + +GETFLB==,-4 ;PDL IDX OF GLSP1 BEFORE LEFT OPERAND. +GETFLR==,-3 ;PDL IDX OF RELOC OF LEFT OPERAND. +GETFLV==,-2 ;PDL IDX OF VALUE OF LEFT OPERAND. +GETFLP==,-1 ;PDL IDX OF PRIO,,DISPATCH +GETFLG==0 ;PDL IDX OF GLSP1 AFTER LEFT OPERAND (=BEFORE RIGHT) + +PLS: MOVEI C,PLS1 ;PLUS SIGN, PLS1 IS ROUTINE TO PERFORM OPERATION +MINUS2: MOVSI TT,10 ;SET UP PRECEDENCE OF 10 FOR +, - + JRST GETFDL + +MINUS: JSP C,MINUS2 ;MINUS SIGN + MOVNS A ;NEGATE VALUE OF RIGHT OPERAND + MOVNS B ;ALSO RELOCATION + JUMPGE FF,PLS1 + MOVE T,GETFLG(P) + PUSH P,B + HRLZI B,MINF + PUSH P,C + PUSHJ P,LNKTZ ;COMPLEMENT THE MINUS FLAG ON GLOBALS IN RIGHT OPERAND + POP P,C + POP P,B +PLS1: ADD A,GETFLV(P) ;ADD VALUES + ADD B,GETFLR(P) ;ADD RELOCATIONS + JRST GETFD4 + +LNKTZ: TDZA C,C +LNKTC1: MOVE T,GLSP2 +LINKTC: CAML T,GLSP1 + POPJ P, + SKIPL 1(T) + XORM B,1(T) + SKIPL 1(T) + IORM C,1(T) + AOJA T,LINKTC + +MULTP: MOVEI C,MULTP1 ;ASTERISK, MULTP1 ROUTINE TO PERFORM MULTIPLICATION +DIVID2: MOVSI TT,20 ;20 PRECEDENCE OF MULTIPLICATION, DIVISION + JRST GETFDL + +MULTP1: JUMPGE FF,MULTR ;ON P1, DON'T CHECK THIS, SINCE UNDEF SYMS ARE EXTERNALS + SKIPL CONTRL ;ELSE IN DECREL ASSEMBLY, TEST FOR EXTERNALS. + JRST MULTR + MOVE D,GETFLB(P) ;ACTUALLY, GET HERE FOR ABS ASSEMBLIES TOO, BUT SO WHAT? + CAME D,GLSP1 + ETR [ASCIZ /Externals multiplied/] +MULTR: JUMPE B,MULTP3 ;JUMP ON RIGHT OPERAND NOT RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;BOTH OPERANDS RELOCATED + MOVE T,GETFLV(P) ;GET VALUE OF LEFT OPERAND AND FALL IN + JRST MULTP5 + +MULTP3: MOVE T,A ;RIGHT OPERAND NOT RELOCATED, GET VALUE IN T + MOVE B,GETFLR(P) ;RELOCATION BITS OF LEFT OPERAND +MULTP5: MOVE D,GETFLG(P) ;GLOTB POINTER TO BETWEEN OPERANDS + CAME D,GETFLB(P) + JRST GMUL1 ;LEFT OPERAND HAS GLOBALS + CAME D,GLSP1 + JRST GMUL2 ;RIGHT OPERAND HAS GLOBALS + ;AT THIS POINT, T HAS VALUE OF ABS OPERAND, B RELOC BITS OF OTHER +GMUL4: IMUL A,GETFLV(P) ;MULTIPLY VALUES + IMULB B,T ;MULTIPLY RELOCATION OF ONE BY VALUE OF OTHER + TRZ T,1 + SKIPL CONTRL ;EXCEPT IN STINK ASSEMBLY, OBJECT TO RELOCATION + JRST GETFD4 ;OTHER THAN 0 OR 1 (ONLY AFFECTS DECREL, SINCE + JUMPE T,GETFD4 ;RELOCATION CAN'T BE NONZERO IN ABS ASSEMBLY). +MULTP4: ETR [ASCIZ+Relocatable arg to * or / or Boolean+] + JRST GETFD4 + +GMUL1: TLNE FF,FLPPSS ;LEFT OPERAND HAS GLOBALS, CHEK RIGHT OPERAND + CAMN D,GLSP1 + SKIPA CH1,A ;LOOKS OK, GET VALUE IN CH1 + ETR [ASCIZ /Multiplying two externals/] + SKIPA D,GETFLB(P) ;GET GLOTB POINTER TO BOTTOM OF LEFT OPERAND +GMUL2: MOVE CH1,GETFLV(P) ;GLOBALS IN RIGHT OPERAND ONLY, GET LEFT OPERAND +GMUL3: CAML D,GLSP1 + JRST GMUL4 ;TABLE COUNTED OUT + SKIPGE 1(D) + AOJA D,GMUL3 + JUMPE CH1,GMUL5 ;MULTIPLYING BY ZERO, CLEAR OUT GLOTB ENTRY AND LOOP BACK + LDB CH2,[221200,,1(D)] ;PICK UP MULTIPLICATION FIELD THIS GLOBAL + SKIPN CH2 + MOVEI CH2,1 ;0 => 1 + IMUL CH2,CH1 + CAIN CH2,1 + MOVEI CH2,0 ;IF ONE THEN USE ZERO + DPB CH2,[221200,,1(D)] + AOJA D,GMUL3 + + +GMUL5: CLEARM 1(D) + AOJA D,GMUL3 + +DIVID: JSP C,DIVID2 ;SLASH, PRECEDENCE = 20 +DIVID1: JUMPN B,MULTP4 ;JUMP IF RIGHT OPERAND RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;LEFT OPERAND RELOCATED + EXCH A,GETFLV(P) + IDIV A,GETFLV(P) + MOVEI B,0 + JUMPGE FF,GETFD4 + MOVE D,GETFLB(P) + CAME D,GLSP1 + ETR [ASCIZ /Division involving externals/] + JRST GETFD4 + + ;LOGIC OPERATORS & (PREC = 40), # (PREC = 34), \ (PREC = 30) + +ANDF: MOVSI TT,40 ;& + JSP C,GETFDL + JSP D,LOGIC1 ;GO DO IT + AND A,GETFLV(P) ;INSTRUCTION ARGUMENT TO LOGIC1 + +XORF: MOVSI TT,34 ;# + TRNN I,IRSYL ;IF ABOUT TO BE UNARY, + MOVNI A,1 ;THEN TURN LEFT OPERAND INTO -1 + JSP C,GETFDL + JSP D,LOGIC1 + XOR A,GETFLV(P) + +IORF: MOVSI TT,30 ;\ + JSP C,GETFDL + JSP D,LOGIC1 + IOR A,GETFLV(P) + + ;COMMON EXECUTION ROUTINE FOR LOGICAL OPERATORS + +LOGIC1: JUMPN B,MULTP4 ;NO RELOCATION ALLOWED + SKIPE GETFLR(P) ;NOW CHECK RELOCATION OF LEFT OPERAND + JRST MULTP4 + XCT (D) ;ALL TESTS PASSED, DO IT + JUMPGE FF,GETFD4 ;DON'T CHECK FOR GLOBALS EXCEPT DURING PUNCHING PASS + MOVE D,GETFLB(P) ;PICK UP POINTER TO LEFT OPERAND GLOTB ENTRIES + CAME D,GLSP1 + ETR [ASCIZ /External in arg to \, & or #/] + JRST GETFD4 + +CBAKAR: MOVSI TT,100 ;BACKARROW AS FIELD OPERATOR, PREC = 100 + JSP C,GETFDL ;RETURN TO GETFLD TO READ 2ND ARGUMENT. + JSP D,LOGIC1 ;FOR EVALUATION, CALL LOGIC1 + JSP D,.+1 ;WHICH EXECUTES THIS INSTRUCTION, + MOVE T,A ;TO CALL THIS SUBROUTINE. + MOVE A,GETFLV(P) + LSH A,(T) + JRST (D) + +;D SHOULD HAVE 1 FOR <, 2 FOR (, 3 FOR [ ;] +LSSTH9: JSP LINK,SAVAS1 ;SAVE ASSEM1 PDL LEVELS, .BYTE MODE, ETC. + MOVEM D,ASMOUT ;SAY WHAT KIND OF OPEN WE JUST DID + JRST ASSEM3 ;REENTER ASSEM1 LOOP AT INNER LEVEL. + +;COME HERE TO EXIT FROM AN ASSEM1 LEVEL THAT WAS ENTERED BY LSSTH9. +LSSTHA: SKIPE BYTM ;IN BYTE MODE, DO .WALGN. SINCE ASMDSP + JRST A.BY3 ;STILL POINTS HERE, WE'LL COME BACK. + MOVE P,CONSTP + JSP T,CONNDP ;POP STUFF SAVED BY SAVAS1 + MOVE A,WRD ;RETURN THE WORD IN THE GROUPING + MOVE B,WRDRLC ;(OUR CALLER WILL USVWLD, CLOBBERING WRD) + POPJ P, + +LSSTH: MOVEI D,1 ;1 FOR <. + JSP LINK,SAVWD1 + PUSHJ P,LSSTH9 +LSSTH3: JSP LINK,USVWLD ;POP OFF ALL BUTPREVIOUS SYLL. + +;GROUPINGS EXCEPT (PARENS THAT ADD TO WORD) +;SYLL IMMEDIATELY BEFORE OR AFTER IS ERROR. +LSSTH2: ADDM A,-1(P) ;SYLL BEFORE GROUPING, PUSHED BY SAVWD1. + ADDM B,(P) + TRNE I,IRSYL ;IF WAS SYLL BEFORE GROUPING, ERROR. + ETR ERRNOS +LSSTH5: MOVE A,LIMBO1 ;CHECK FOR FOLLOWING SYLL. + CAIE A,15 + CAIN A,12 + JRST LSSTH6 ;DELIMITER CR OR LF + PUSHJ P,RCH ;NOT CR OR LF, GET NEXT CHAR + CAIN A,"! ;IGNORE EXCLAMATION POINT + JRST .-2 + TLO FF,FLUNRD ;CAUSE IT TO BE RE-INPUT + HLRZ CH1,GDTAB(A) + CAIE CH1,(POPJ P,) + JRST LSSTH4 ;SQUOZE CHAR. MEANS FOLLOWING SYLL. + HRRZ CH1,GDTAB(A) + MOVE CH1,DTB-40(CH1) ;GET DISPATCH FOR CHAR. + TLNE CH1,DSY1 ;MIGHT START SYL => NOS ERROR. + JRST LSSTH4 +LSSTH7: PUSHJ P,GTSL1 +LSSTH6: TRO I,IRSYL + POP P,B + POP P,A ;VALUE OF GROUPING WAS ADDM'ED INTO THESE. + TLZE I,ILLSRT ?.SEE UA3 + RET ;IF CALLED BY ^ OR _ AS SYL OP, RETURN TO IT. + JRST GETFD6 + +LSSTH1: TLO I,ILWORD ;A NUMBER IN PARENS BY ITSELF IS A NONNULL WORD. + ADDM A,WRD + ADDM B,WRDRLC + TRNE I,IRSYL ;IF SYLL BEFORE, + JRST LSSTH5 ;ERROR IF SYL AFTER. + JRST LSSTH8 ;ELSE NO ERROR. + +LSSTH4: ETR ERRNOS ;FOLLOWING SYLL WHEN THAT IS ERROR. +LSSTH8: TLNE I,ILLSRT ?.SEE UA3 + JRST LSSTH6 + SUB P,[2,,2] + JRST GETFD1 + +ERRNOS: ASCIZ /Syllables not separated/ + +POP2J: SUB P,[2,,2] + POPJ P, + +LEFTP: MOVEI D,2 ;2 FOR ). + JSP LINK,SAVWD1 + MOVEI C,0 + TRNE I,IROP + TRNE I,IRSYL + TLO C,400000 ;CAUSE IT TO GET ADDED INTO WORD STEAD HAVE VALUE AS SYL + PUSH P,C + PUSHJ P,LSSTH9 + POP P,C + MOVSM A,T1 ;STORE SWAPPED VALUE + ADDI B,400000 ;NOW WANT TO SWAP RELOCATION, MAKE LH CORRECT + HLREM B,T2 ;STORE AS RH WITH SIGN EXTENDED + MOVSI B,400000(B) ;GET RIGHT HALF IN LEFT + ADDM B,T2 ;FINISH RELOCATION SWAP (THIS IS PAINLESS COMPARED TO THE HAIR EVERYWHERE + ;ELSE WHEN KEEPING THE HALFWORDS SEPARATE) + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + JSP LINK,USVWLD + MOVE A,T1 + MOVE B,T2 + JUMPL C,LSSTH1 ;ADD TO WHOLE WORD + JRST LSSTH2 + +;VERSION OF GETWRD FOR PSEUDO, +;PSEUDO MUST EITHER SAVE I, PPRIME AND GTVER OR RETURN TO ASSEM1. +;SYM SHOULD HOLD NAME OF PSUEUDO. + +AGETWD: MOVEM SYM,GTVER ;STORE NAME OF PSEUDO FOR UNDEF SYM MSGS. + TRO I,IRPSUD\IRDEF\IRNOEQ + PUSHJ P,GETWRD + MOVE SYM,GTVER ;RESTORE SYM. + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + RET + +;;GETWD ;READ A WORD, LEAVE VALUE IN A AND WRD, RELOC IN WRDRLC AND B + +GETWRD: MOVE T,GLSP1 + MOVEM T,GLSP2 + CLEARM FORMAT ;CLEAR FORMAT, WILL ACCUMULATE FORMAT NUMBER BY IDPB + CLEARM WRD ;CLEAR WRD, WILL ACCUMULATE ABSOLUTE PART OF WORD + CLEARM WRDRLC ; " RELOCATION BITS, " + TDZ I,[ILWORD,,IRIOINS] + CLEARM FLDCNT ;NO FIELDS YET + MOVE T,[50100,,FORMAT] ;SET UP BIT POINTER TO FORMAT + MOVEM T,FORPNR +GTWD1: PUSHJ P,GETFLD ;READ NEXT FIELD +SPACE6: MOVEI T,1 ;SET T TO 1, AC FOR IDPB ON ROUTINE DISPATCHED TO + SKIPA C,CDISP +SPACE5: REST A + TLNE C,DWRD + JRST (C) ;NO DISPATCH MEANS WD TERMINATOR + MOVE C,GLSP1 + MOVEM C,LINKL ;MARK END OF ACTIVE PART OF GLOTB + TRNN I,IRFLD + JRST GETWD2 ;LAST FIELD NULL, MAYBE HAVE TO POP STUFF OFF + IDPB T,FORPNR ;MARK NON-NULL FIELD IN FORMAT +GTWD4A: TLO I,ILWORD ;NON-NULL WORD + MOVE TT,FORMAT + SKIPN TT,FORTAB-10(TT) ;PICK UP BYTE POINTER POSITION/SIZE FIELDS FOR FIELDS IN WORD + ETR [ASCIZ /Undefined format/] + MOVEM TT,FORMAT ;STORE IN FORMAT + MOVE T,[301400,,FORMAT] + MOVEM T,FORPNR + ;AT THIS POINT, FLDCNT HAS 1 LESS THAN # FIELDS; PUT FIELDS TOGETHER TO FORM WORD +GTWD3: LDB T,FORPNR + MOVE D,FLDCNT + CAIG D,2 + IBP FORPNR ;HAVEN'T BACKED UP TO THIRD FIELD YET, INCREMENT TO DESC FOR PREV + TRNE I,IRIOINS + PUSHJ P,INTIOW + PUSHJ P,INTFLD ;PUT FIELD WHERE IT BELONGS + SOSGE FLDCNT + JRST GTWD5 ;THIS WAS LAST (FIRST) FIELD + POP P,GLSP2 ;NOT YET, POP OFF MORE + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD3 + +GTWD5: MOVE A,WRD + MOVE B,WRDRLC + MOVE C,LINKL + MOVEM C,GLSP1 + TRZ I,IRIOINS + POPJ P, + +COMMA: TRNN I,IRFLD ;FIELD DELIMITER WAS COMMA (T HAS 1) + JRST COMMA1 ;NO FIELD + IDPB T,FORPNR ;MARK NON-NULL FIELD +COMMA4: IDPB T,FORPNR ;MARK FIELD TERMINATOR WAS COMMA + MOVE TT,FLDCNT + CAIL TT,2 + ETR [ASCIZ /Comma past the 3rd field of a word/] +PUSHFD: PUSH P,A ;DONE WITH THIS FIELD, NOW TO GET NEXT + PUSH P,B + PUSH P,GLSP1 + PUSH P,GLSP2 + AOS FLDCNT ;ANOTHER FIELD + MOVE TT,GLSP1 + MOVEM TT,GLSP2 + HRRZ T,FORPNR + CAIE T,FORMAT + HRRZS FORPNR ;STABILIZE FORPNR + TLO I,ILWORD ;SAY WE HAVE A NON-NULL WORD IN PROGRESS (LOC, ETC. ILLEGAL). + JRST GTWD1 + +GETWD2: SKIPN FORMAT ;LAST FIELD OF WORD IS NULL + JRST GTWD5 ;ENTIRE WORD NULL, MAYBE WERE PARENS. + SOS FLDCNT + POP P,GLSP2 + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD4A + +COMMA1: LDB TT,FORPNR ;COMMA TERMINATED NULL FOELD. + SKIPE FORMAT + JUMPE TT,COMMA2 ;NOT 1ST FIELD, JMP IF PREV WAS TERM BY SPACE. + IBP FORPNR ;ELSE MARK NULL FIELD IN FORMAT. + JRST COMMA4 + +;FIELD SPACE COMMA, PATHOLOGICAL CASE +;(EG MACRO STARTED WITH A COMMA) +COMMA2: DPB T,FORPNR ;REPLACE SPACE WITH COMMA. + JRST GTWD1 + + ;FIELD TERMINATOR IS SPACE (T HAS 1) + +SPACE: MOVE TT,LIMBO1 + CAIE TT,^I ;HEURISTIC: REAL SPACES ARE LIKELY TO BE FOLLOWED BY SQUOZE, + JRST SPACE4 ;WHILE TABS ARE LIKELY TO BE FOLLOWED BY COMMENTS. + PUSH P,A + MOVE TT,GDTAB+40 + PUSHJ P,RCH + CAMN TT,GDTAB(A) + JRST .-2 ;FLUSH OTHER LOGICAL SPACES + CAIN A,"; ;TAB WAS FOLLOWED BY SEMICOLON: + JRST [ PUSH P,B + TRZ I,IRSYL + CALL SEMIC ;FLUSH THE COMMENT + MOVEI T,1 + REST B + JRST SPACE5] ;AND HANDLE THE C.R. +SPACE3: POP P,A + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-READ NEXT TIME +SPACE4: TRNN I,IRFLD + JRST GTWD1 ;NO FIELD + IDPB T,FORPNR ;T HAS 1, MARK NON-NULL FIELD IN FORMAT + IBP FORPNR ;MARK FIELD TERMINATOR WAS SPACE + JRST PUSHFD + +;T HAS DESC BYTE, PUT FIELD IN ITS PLACE +;ALSO CALLED FROM PBYTE, MUSTN'T CLOBBER AA. + +INTFLD: MOVE TT,GLSP2 + CAMN TT,GLSP1 + JUMPE B,INTFD1 ;NO GLOBALS, JUMP IF NO RELOCATION + CAIN T,2222 ;LH + JRST INTL + CAIN T,22 ;RH + JRST INTR + CAIN T,44 ;WHOLE WORD + JRST INTW + SKIPE B + ETR [ASCIZ/Relocation attempted in irrelocatable field/] + ;(ASSUME) NO RELOCATION, CHECK FOR GLOBAL AC FIELDS + CAIN T,2704 ;HIGH AC + JRST INTACH + CAIN T,504 ;AC LOW + JRST INTACL + JUMPGE FF,INTFD1 ;JUMP ON NOT PUNCHING PASS + CAME TT,GLSP1 + ETR [ASCIZ/Global symbol in illegal field/] +INTFD1: MOVEI TT,C_12. + ROTC T,-12. ;SHIFT BYTE POINTER INTO TT + MOVEI C,0 ;INITIALIZE C TO RECEIVE FIELD IN PROPER PLACE + DPB A,TT + CAMN TT,[2200,,C] + JRST INTFD2 ;RIGHT HALF, DON'T ALLOW CARRY INTO LH + ADDM C,WRD ;ALLOW CARRY +INTFD3: ADDM B,WRDRLC ;ADD RELOCATIONS, WILL BE BROKEN BACK INTO HALF-WORDS LATER + POPJ P, + +INTFD2: ADD C,WRD ;ADD RIGHT HALVES + HRRM C,WRD + JRST INTFD3 + +INTIOW: CAIE T,2704 + CAIN T,504 + TRZA A,3 ;IO DEVICE FIELD + POPJ P, ;NOT "AC" FIELD + ADDI T,611-504 + POPJ P, + +INTR: HRRE D,B ;RH + MOVEI B,0 + PUSH P,T + HRLZI C,HFWDF + PUSHJ P,LNKTC1 ;THIS IS A BUG WHICH SHOULD BE FIXED SOMETIME +PRTCL: MOVE B,D ;GET BACK MAPPED RELOCATION BITS +PRTCL2: POP P,T +INTW: MOVE D,GLSP2 ;WHOLE WORD + HRLOI LINK,377777 + CAML D,GLSP1 + JRST INTFD1 + ANDM LINK,1(D) + AOJA D,.-3 + +INTL: HRLZ D,B ;LH + MOVSI B,SWAPF + MOVSI C,HFWDF + PUSH P,T + MOVE T,GLSP2 +INTL2: CAML T,GLSP1 + JRST PRTCL + SKIPGE 1(T) + AOJA T,INTL2 ;INDEX FIELD, ETC => LEAVE ALONE + IORM C,1(T) ;SET HFWDF + XORM B,1(T) ;COMPLEMENT SWAP STATUS + TDNN B,1(T) + SETZM 1(T) ;SWAPPED TO RH, FLUSH IT + AOJA T,INTL2 + +INTACL: TDZA B,B ;AC LOW +INTACH: HRLZI B,SWAPF ;AC HIGH + HRLZI C,ACF + PUSH P,T + PUSHJ P,LNKTC1 + MOVEI B,0 + JRST PRTCL2 + +IOINST: HLLZ A,B ;IO INSTRUCTION, GET WHICH ONE INTO A + SKIPN FLDCNT ;THIS FIRST FIELD OF WORD? + TRO I,IRIOINS ;YES + JRST CLBPOP ;RETURN VALUE + +;TOP LEVEL LOOP, ASSEMBLE STORAGE WORDS +;LOTS OF PSEUDOS MEANINGLESS IN STORAGE WORDS +;(E.G. BLOCK, CONSTA) DO JRST ASSEM1 WHEN DONE +;THERE'S ALSO AN ERROR UUO WHICH RETURNS TO ASSEM1 + +ASSEM1: MOVE P,ASSEMP + JRST @ASMDSP + +;COME HERE TO START THE NEXT EXPRESSION OR WHATEVER. +ASSEM3: PUSHJ P,RCH + CAIN A,^I + JRST ASSEM2 ;PROBABLY NOT PROFITABLE TO SKIP AFTER SEE A TAB. + CAIG A,40 + JRST ASSEM3 ;FLUSH LEADING GARBAGE + TLO FF,FLUNRD ;CAUSE NON-GARBAGE CHAR FOUND TO BE RE-INPUT +;ASMDSP POINTS HERE WITHIN ASCII, SIXBIT ETC. +ASSEM2: TRZ I,IRFLD+IRSYL+IRLET+IRPSUD+IRCOM+IRCONT+IRGMNS+IROP+IRNOEQ+IREQL + TLZ I,ILGLI+ILVAR+ILFLO+ILDECP+ILUARI+ILWORD+ILNPRC + IOR I,ASMI ;SET DEF AND RESTORE PSEUDF. + MOVE A,GLSPAS + SKIPL BYTM + MOVEM A,GLSP1 + ;GETWRD WILL COPY GLSP1 INTO GLSP2 +IFN TS,[AOSN TTYBRF ;DO A ^H-BREAK IF REQUESTED. + CALL TTYBRK] + PUSHJ P,GETWRD + TLZN I,ILWORD + JRST @ASMDSP ;NO WORD ASSEMBLED,TRY AGAIN + SKIPGE BYTM + JRST PBYTE ;IN BYTE MODE, OUTPUT BYTE INSTEAD OF WORD, A,B MUST HAVE WRD,WRDRLC. + MOVE AA,ASMOUT ;OUTPUT WD AS APPRO. FOR GROUPING, IF ANY. + JRST @ASMOT0(AA) + +ASSEM6: SKIPE STGSW ;ASMOT0 POINS HERE. COME IF NOT IN GROUPING. + ETR ERRSWD ;STORAGE WORD ASSEMBLED + PUSHJ P,PWRD ;OUTPUT THE WORD. + AOS CLOC + HRRZS CLOC ;INCREM. POINT . + JRST @ASMDSP ;ASSEM3 OR ASSEM2 + +ERRSWD: ASCIZ /Storage word assembled/ + +ASSEM4: JSP T,PCONST ;ASMOT0+3 POINTS HERE. COME IF IN CONSTANT. + JRST @ASMDSP + +;ASMDSP POINTS HERE WITHIN GROUPING IF NOT IN MULTI-LINE MODE +;[ ;AND NO CLOSE (">)]") HAS BEEN SEEN. +ASSEMC: MOVE AA,ASMOUT + SKIPE CONSML ;IN ERROR MODE, GIVE APPROPRIATE ERROR MSG. + XCT ASMOT3(AA) + JRST @ASMOT2(AA) ;CLOSE WHATEVER TYPE GRPING WE'RE IN. + +;JUMP THRU THIS TABLE TO OUTPUT A WORD. +ASMOT0: ASSEM6? ASSEM1? ASSEM1? ASSEM4? [HALT ] + +;THIS TABLE GIVES APPRO. CLOSE FOR EACH TYPE OF GROUPING. ;[ +ASMOT1: "? ? "> ? ") ? "] ? "? + +;THIS TABLE SAYS WHERE TO GO TO END THE GROUPING. +ASMOT2: [HALT ]? LSSTHA? LSSTHA? CONND? [HALT ] + +;APPROPRIATE ERROR MESSAGE FOR MISSING CLOSE OF GROUPING. [ +ASMOT3: HALT + ETR [ASCIZ /Missing >/] + ETR [ASCIZ /Missing )/] + ETR [ASCIZ /Missing ]/] + HALT + +;THIS TABLE TELLS PBYTE HOW TO HANDLE BYTE MODE. +ASMOT4: PBY4 ? PBY5 ? PBY5 ? PBY3 ? [HALT ] + +;TABLE SAYING WHAT CHAR MUST HAVE OPENED THE GROUPING. +ASMOT5: "? ? "< ? "( ? "[ ? "? ;] + +;;GETVAL ;GET VALUE OF SYM + ;SKIPS ON PSEUDO NOT RETURNING VALUE (E.G. MACRO STARTING TO BE EXPANDED) + ;ELSE RETURNS VALUE IN A, RELOCATION BITS IN B + +VBLK +GTVER: 0 ;SQUOZE NAME OF CALLING PSEUDO, OR POINTER + ;TO INSN TO EXECUTE WHEN IF SYM IS UNDEF. +PBLK + +GETVAL: PUSHJ P,ES + JRST GVNF ;NO STE. +IFN CREFSW,XCT CRFINU ;JFCL OR CALL TO CREF RTN. + JRST @.+1(A) ;FOUND, DISPATCH ON SQUOZE FLAGS + +GVTAB: GVCOM ;COMMON (UNUSED) + GVPSEU ;PSEUDO OR MACRO. + GVSYM ;LOCAL SYMBOL. + GVUL ;LOCAL UNDEF (MAYBE STINK KNOWS VALUE) + GVDLV ;DEFINED LOCAL VAR. + GVULV ;UNDEF LOC VAR. + GVDGV ;DEF GLO VAR + GVUGV ;UNDEF GLO VAR + GVDG ;DEF GLOBAL + GVUG ;UNDEF GLOBAL + +;DEF LOCAL VAR. +GVDLV: PUSHJ P,GVDLGV ;IF PASS2 AND HAS ' THIS TIME, SET 3VAS2 FOR AVARIAB + TLZN I,ILGLI + JRST GVDLV2 + MOVSI T,DEFGVR ;NOW DEF GLO VAR. + PUSHJ P,VSM2 + JRST GVDG1 ;MAYBE OUTPUT GLOBAL DEF. TO STINK. + +GVDGV: PUSHJ P,GVDLGV ;DEF GLO VAR; IF PASS 2 AND ' THIS TIME, SET 3VAS2 + JRST GVDG2 ;MUSN'T PUNCH VALUE, AVARIAB WILL. + +GVDLGV: TRNE FF,FRPSS2 ;IF PASS 2 + TLNN I,ILVAR ;AND THIS TIME HAVE SINGLEQUOTE + POPJ P, + TLO C,3VAS2 ;TELL AVARIAB SEEN IN PASS 2 WITH '. + 3PUT C,D + POPJ P, + +GVULV: TLZN I,ILGLI ;UNDEF LOCAL VAR, MAYBE MAKE GLOBAL. + JRST GVUNDF + PUSHJ P,PLOGLO ;IF SO, TELL STINK SYM IS GLOBAL, + MOVSI T,UDEFGV ;SYM NOW UNDEF GLO VAR + PUSHJ P,VSM2 + JRST GVUNDF ;IN EITHER CASE, HANDLE UNDEF SYM. + +GVUL: TLZE C,3MACOK ;UNDEF LOCAL, PRESUMED NUMERIC + 3PUT C,D ;DON'T LET IT BECOME MACRO AND SCREW PASS2. + TLNE C,3LLV + JRST GVGLTB ;(REALLY DEFINED BUT ONLY STINK KNOWS HOW) + TLNE I,ILGLI ;IF MAKING GLOBAL, TELL STINK. + PUSHJ P,PLOGLO +GVNF1: TLZE I,ILVAR ;IF ', MAKE VAR (WILL CHECK ILGLI) + JRST GVUL1 + TLZN I,ILGLI ;NOT MAKING VAR, MAYBE GLOBAL? + JRST GVUNDF ;NO, MAYBE ERROR, MAKE GLOTB ENTRY. + MOVSI T,GLOEXT + PUSHJ P,VSM2 ;NOW GLOBAL UNDEF, + JRST GVGLTB ;NO ERROR, JUST GLOTB ENTRY. + +GVUL1: TLZN I,ILGLI ;UNDEF LOCAL BECOMES + SKIPA T,[UDEFLV,,] ;UNDEF LOC VAR OR +GVGVAR: MOVSI T,UDEFGV ;UNDEF GLO VAR. +GVVAR: CALL ESDEF ;DEFINING SYM AS A VAR => INSIST ON DEFINING LOCAL TO INNERMOST BLOCK. + JFCL + AOS VARCNT + HRR B,VARCNT + PUSHJ P,VSM2 ;MAKE IT A VAR, + JRST GVUNDF ;PRETEND HAD ALREADY BEEN A VAR. + +GVUG: TLZE I,ILVAR ;UNDEF GLOBAL: MAYBE MAKE UNDEF GLO VAR. + JRST GVGVAR +GVGLTB: SKIPGE CONTRL ;UNDEF GLO IN ABS ASSEM => + JRST GVUND1 ;MAYBE TREAT AS UNDEF. +GVGLT1: AOS GLSP1 ;DON'T KNOW SYM'S VALUE, MAKE GLOTB ENTRY. + MOVEI T,ST(D) + HRRZM T,@GLSP1 + JRST CABPOP ;RETURN 0 AS VALUE. + +GVNF: +IFN CREFSW,XCT CRFINU ;ONLY IF NOT FOUND WOULD NOT CREF AFTER ES. + TLNE I,ILVAR+ILGLI ;MAKING VAR OR GLOBAL FORCED CURRENTBLOCK ALREADY + JRST GVNF1 ;AND WILL STORE NAME IN STE ANYWAY. + SKIPGE ESBK ;ELSE IF NO SPEC'D BLOCK, + TRNN FF,FRNPSS ;FORCE .MAIN BLOCK SO DON'T GET LOTS OF UNDEF ENTRIES. + CAIA ;BUT CAN'T DO THAT FOR 1PASS OR WOULD MISS FWD REFS. + HRRI C,BKWPB + MOVSI T,LCUDF + PUSHJ P,VSM2 + JRST GVUNDF ;MAYBE ERROR, MAKE GLOTB ENTRY. + +GVCOM: TRO I,IRCOM ;COMMON: SAY THIS WAS ONE. + HRRZ A,B ;RETURN RH OF VALUE, ABSOLUTE. + JRST CLBPOP + +GVPSEU: TLNN I,ILVAR+ILGLI ;CAN'T MAKE PSEUD OR MACRO GLOBAL OR VAR. + JRST (B) ;OTHERWISE, DISPATCH TO IT. + TLZE I,ILVAR + ETSM ERRCBV + TLZE I,ILGLI + ETSM ERRCBG + JRST (B) ;DISPATCH TO PSEUDO (OR MACCL IF MACRO) + ;EXPECTS LH OF VALUE IN LH OF B. + +ERRCBV: ASCIZ /Can't be a variable/ +ERRCBG: ASCIZ /Can't be global/ + +GTVL7B: TLNE C,3RLL ;R(LH) + TLO SYM,200000 + TLNE C,3RLR ;R(RH) + TLO SYM,100000 + POPJ P, + +GVSYM: TLNN C,3REL + TLNE I,ILVAR\ILGLI + JRST GVSYM2 + MOVE A,B ;THIS CODE DOES WHAT GVSYM2 WOULD DO, BUT FASTER. + SETZ B, + RET + +GVSYM2: TLZE I,ILVAR ;LOCAL SYM: CAN'T MAKE VARIABLE. + ETSM ERRMDV + TLZN I,ILGLI + JRST GVSYM0 ;NOT MAKING GLOBAL, GET VALUE & RETURN. +GVSYM1: MOVSI T,GLOETY ;BECOMES DEF. GLOBAL. + PUSHJ P,VSM2 + JRST GVDG1 ;HANDLE AS IF WAS DEF GLOBAL. + +ERRMDV: ASCIZ /Multiply-defined variable/ + +GVDG: TLZE I,ILVAR ;GLOBAL ENTRY + ETSM ERRMDV +;COME HERE FOR DEF GLOBAL +GVDG1: SKIPGE CONTRL + JRST GVDLV2 ;DON'T PUNCH VALUE IF ABSOLUTE. + TLNE C,3VP + JRST GVDG2 ;VALUE PUNCHED ALREADY, NOT AGAIN. + JUMPGE FF,GVDG2 + TLNN C,3LLV + TRNE I,IRPSUD+IREQL + JRST GVDG2 + TLO SYM,40000 + PUSH P,WRD + PUSHJ P,OUTDE2 + POP P,WRD +GVDG2: TRNN I,IRPSUD\IREQL ;IF INSIDE AN ORDINARY STORAGE WORD, + TLNN C,3REL ;GENERATE A GLOBAL REF IF GLOBAL IS RELOCATABLE (HEURISTIC). +GVDLV2: TLNE C,3LLV ;IF VAL KNOWN ONLY BY STINK, MUST MAKE A GLOBAL REF. + JRST GVGLTB +GVSYM0: MOVE A,B ;USED IN LBRAK + LDB B,[.BP (3RLR),C] + TLNE C,3RLL + TLO B,1 + POPJ P, + +GVUND1: MOVE A,CONTRL + TRNE A,DECREL+FASL ;DEC FMT OR FASL => UNDEF GLOBALS OK. + JRST GVGLT1 +GVUGV: +GVUNDF: TRZ I,IRDEF ;UNDEFINED, MAYBE ERROR, MAKE GLOTB ENTRY. + TRNE I,IRPSUD\IREQL + JRST GVUND2 ;PSEUDO + TRNN FF,FRPSS2 + JRST GVGLT1 ;PASS 1 + SKIPN CONDEP + ETSM [ASCIZ/Undefined/] + SKIPE CONDEP + ETSM [ASCIZ/Undefined in literal/] + JRST CABPOP + +GVUND2: HLRZ A,GTVER ;DOES GTVER POINT TO AN INSN? + JUMPE A,[XCT @GTVER ? JRST CABPOP] + ERJ .+1 ;NO, IT IS NAME OF PSEUDO. + MOVE A,LINEL + CAIGE A,75. ;CR-LF-TAB NOW IF WHOLE MSG WON'T FIT ON A LINE. + CALL CRRTBX + TYPE2 SYM ;TYPE NAME OF UNDEF SYM. + TYPR [ASCIZ/ Undefined in /] + TYPE2 GTVER + CALL CRRERR + JRST CABPOP + +;EVALUATE SYMBOL, SQUOZE (FLAGS OFF) IN SYM +;IDX OF BLOCK TO DEFINE IN IN ESBK (OR -1 => ANY BLOCK NOW IN PROGRESS). +;DOESN'T CLOBBER F (FOR WRQOTE) +;RETURNS SKIPPING IF SYM FOUND, WITH SQUOZE FLAGS IN BOTTOM OF A, +;VALUE OF SYM IN B, STE IDX IN D, AND 3RDWD IN C. +;IF NOT FOUND, RETURNS IN D THE IDX OF A PLACE TO DEFINE SYM. +;CALL ESDCHK TO GET THE FOLLOWING EXTRA INFO (WHETHER SYM FOUND OR NOT): +;ESLAST -> LAST STE WITH DESIRED NAME SEEN, REGARDLESS OF WHAT BLOCK IT'S IN +;ESL1 HAS LEVEL OF BLOCK OF BEST STE SEEN, -1 IF NOT FOUND +;ESL2 HAS 3RDWRD OF BEST. +;ESXPUN HAS -1 OR IDX OF A STE WHICH MIGHT BE USED TO DEFINE THE SYM. +;RH(TM) GETS BLOCK IDX TO DEFINE IN IF DEFINE THE SYM. +;TT HAS -<# STE NOT LOOKED AT YET> +;THEN IF SYM IS FOUND IN A CONTAINING BLOCK AND YOU WANT TO DEFINE +;IT IN THE CURRENT BLOCK, YOU CAN CALL DEFCHK TO FIND AN STE TO DO IT IN. +;CALLING ESDEF IS AS GOOD AS CALLING ESDCHK AND DEFCHK, BUT DOESN'T +;LET YOU SEE WHAT YOU ARE GOING TO SHADOW. + +ESDEF: MOVE A,BKCUR ;EVAL SYM IN ORDER TO DEFINE IT: + SKIPGE ESBK ;IF NO SPEC'D BLOCK, SPEC THE CURRENT BLOCK, + MOVEM A,ESBK ;SO DEFS IN CONTAINING BLOCKS WON'T BE SEEN + +ESDCHK: SETOM ESLAST ;CALL HERE IF WE MIGHT END UP CALLING DEFCHK, + SETOM ESL1 ;SINCE IN THAT CASE WE'LL NEED THESE VARS EVEN IF SYM IS FOUND + SETOM ESXPUN ;RIGHT AWAY. + MOVN TT,SYMLEN +ES: MOVE C,SYM ;HASH AWAY + TSC C,SYM ;THIS MAKES SURE THAT THE FIRST FEW CHARS OF SYMBOL DON'T GIVE + ;A ZERO REMAINDER, IF SYMLEN IS A ROUND NUMBER. + MOVMS C ;THIS IS BECAUSE IDIV OF NEGATIVE NUMBER GIVES NEG. REMAINDER. + IDIV C,SYMLEN + IMUL D,WPSTE + SKIPGE TM,ESBK ;GET BKTAB IDX OF SPEC'D BLOCK + HRR TM,BKCUR ;OR -1,,BKTAB IDX OF CURRENT BLOCK. +;NOW CHECK FAST FOR AN IMMEDIATE MATCH - AVOID SETTING UP FLAGS NEEDED ONLY WHEN +;SYM APPEARS IN MULTIPLE BLOCKS OR ISN'T DEFINED. + SKIPN B,ST(D) + JRST ESEND0 ;SYM IS KNOWN NOT TO BE DEFINED. + TLZ B,740000 + CAME B,SYM + JRST ESBAD0 ;NOT FOUND IN 1ST ENTRY - MUST SET UP INFO AND LOOP + 3GET C,D + MOVEI A,(C) + CAIN A,(TM) + JRST ESGOOD ;IN THE DESIRED BLOCK => GOOD. + TDNN C,[3MAS,,-1] ;IN THE INITIAL SYMS BLOCK, NOT PRESENT IN ANY OTHER, + JUMPL TM,ESGOOD ;AND BLOCK WASN'T EXPLICITLY SPEC'D => GOOD. + MOVN TT,SYMLEN ;ELSE MUST KEEP LOOKING TO SEE IF THIS DEF IS REALLY ONE WE WANT. + SETOM ESLAST + SETOM ESL1 + SETOM ESXPUN + JUMPGE TM,ESIGN + JRST ESLP1 + +;LOOK AT THE NEXT STE, WHILE LOOPING. +ESLP: SKIPN B,ST(D) ;GET SQUOZE IN THIS ST SLOT + JRST ESEND ;NOTHING WHERE SYM BELONGS, END SEARCH + TLZ B,740000 ;CLEAR OUT FLAGS + CAME B,SYM ;COMPARE WITH WANTED + JRST ESBAD ;NO MATCH BUT MAYBE KEEP GOING + 3GET C,D ;FOUND SYM, GET 3RDWRD + MOVEI A,(C) + CAIN A,(TM) ;DEFINED IN DESIRED BLOCK + JRST ESGOOD ; => MUST BE GOOD. +ESLP0: JUMPGE TM,ESIGN ;BLOCK SPEC'D => ALLOW NO OTHERS. + TDNE C,[3MAS,,-1] ;IF IN INITIAL SYMS BLK, NO MORE DEFS, + JRST ESLP1 + SKIPGE ESL1 ;AND NO PREVIOUS DEFS, + JRST ESGOOD ;UNREDEFINED INITL SYM MUST BE GOOD. +ESLP1: HLRZ B,BKTAB+1(C) ;GET LEVEL OF BLOCK DEF. IS IN. + CAMN A,BKPDL(B) ;SAME AS BLOCK WE'RE IN AT THAT LEVEL? + CAMLE B,BKLVL ;AND NOT A BLOCK WE'VE EXITED + JRST ESIGN + CAMG B,ESL1 ;OR HIGHER LEVEL THAN PREVIOUS BEST + JRST ESIGN + MOVEM C,ESL2 ;REPLACE BEST'S 3RDWRD, LEVEL, ADDR. + MOVEM B,ESL1 + MOVEM D,SADR +ESIGN: HRRZM D,ESLAST ;THIS ENTRY LAST SEEN WITH THIS NAME. + TLNN C,3MAS ;MORE STE'S FOR THIS SYM => + JRST ESEND1 + JRST ESNXT ;KEEP LOOKING. + +;COME HERE IF 1ST SYM SEEN ISN'T THE SAME NAME. SET UP TO LOOP. +ESBAD0: MOVN TT,SYMLEN + SETOM ESLAST + SETOM ESL1 + SETOB C,ESXPUN +;HERE WHILE LOOPING WHEN SYM WITH WRONG NAME IS SEEN. +ESBAD: JUMPN B,ESNXT + SKIPGE A,ESXPUN ;IF THIS IS 1ST EXPUNGED ENTRY SEEN + MOVEM D,ESXPUN ;REMEMBER IT FOR DEFINITION. + SKIPGE A + HRROS ESLAST ;AND SET OLD ENTRY'S 3MAS. +ESNXT: ADD D,WPSTE + CAML D,SYMSIZ ;AT END => GO TO BEGINNING + MOVEI D,0 + AOJN TT,ESLP + JRST ESEND1 ;NOT FOUND. + +ESEND0: MOVEI C,(TM) ;COME HERE IF 1ST PLACE LOOKED AT SHOWS THE SYM ISN'T DEFINED + MOVEM D,ESXPUN + POPJ P, + +ESEND: SKIPGE A,ESXPUN ;FREE ENTRY CAN BE USED TO DEFINE. + MOVEM D,ESXPUN + SKIPGE A + HRROS ESLAST +ESEND1: SKIPGE ESL1 ;NOT FOUND => FIND PLACE TO DEFINE IT. + JRST DEFCH1 + MOVE D,SADR ;IDX OF BEST FOUND. + TRNN FF,FRNPSS + JRST ES1PS ;1-PASS, SPECIAL CHECK. + MOVE C,ESL2 ;GET BEST'S 3RDWRD. +ESGOOD: LDB A,[400400,,ST(D)] ;GET SQUOZE FLAGS IN A. +ES1POK: MOVE B,ST+1(D) ;VALUE OF SYM. IN B. + ;D HAS IDX OF 1STWRD IN SYM TAB. + ;C HAS 3RDWRD +POPJ1: AOS (P) +APOPJ: +CPOPJ: POPJ P, + +;ESDCHK THEN DEFCHK IS SAME AS CALLING ESDEF. +;WE ASSUME THAT D AND TT ARE STILL SET UP FROM A CALL TO ESDCHK. +DEFCHK: SKIPGE ESL1 ;IF WE DIDN'T TAKE TIME TO SET ESLAST BEFORE, + HRRZM D,ESLAST ;DO IT NOW. (SEE BEFORE ESLP1) + JRST DEFCH1 + +ES1PS: LDB A,[400400,,ST(D)] ;1PASS & FOUND IN CONTAINING BLOCK: + MOVE C,ESL2 + TRNN C,-1 ;INITIAL SYM, OK; + JRST ES1POK + CAIE A,1 ;PSEUDO OR MACRO + TLNE C,3DOWN ;OR .DOWN'D SYMBOL OK; + JRST ES1POK ;ELSE GET NEW STE TO DEF. +DEFCH1: MOVEI C,(TM) ;INITIALIZE NEW 3RDWRD WITH BLOCK TO DEF IN. + SKIPL D,ESXPUN ;IF FOUND EXPUNGED OR FREE ENTRY, USE IT. + JRST DEFCH2 + SKIPGE D,ESLAST ;ELSE LOOK FOR ONE. + ETF ERRSCE +DEFCH4: MOVE B,ST(D) + TLZ B,740000 + JUMPE B,DEFCH3 ;MUST RETURN 0 IN B IF DON'T SKIP. + ADD D,WPSTE + CAML D,SYMSIZ + MOVEI D,0 + AOJL TT,DEFCH4 ;ASSUME TT LEFT AROUND FROM ES. + ETF ERRSCE +ERRSCE: ASCIZ /Symbol table full/ + +;ESLAST HAS -1 IF NO ENTRY SEEN; ELSE +;RH HAS IDX OF LAST SEEN, SIGN SET IF SEEN BEFORE PLACE TO DEFINE. +DEFCH3: MOVEM D,ESXPUN ;REMEMBER ADDR WHERE CAN DEFINE + HRROS ESLAST ;LAST PLACE SEEN MUST BE EARLIER. +DEFCH2: SKIPL A,ESLAST + JRST DEFCH5 ;LAST PLACE SEEN WAS SEEN AFTER PLACE TO DEFINE. + CAMN A,[-1] + POPJ P, ;REALLY NEVER SEEN. + MOVSI TM,3MAS + IORM TM,ST+2(A) ;PLACE SEEN IS EARLIER, SET ITS 3MAS. + POPJ P, + +DEFCH5: TLO C,3MAS ;PLACE TO DEF BEFORE EXISTING STES. + POPJ P, + +;ENTER A SYM IN SYMBOL TABLE + ;B HAS VALUE + ;C HAS 3RDWRD + ;D HAS INDEX INTO ST (PROBABLY SET UP BY ES) + ;T HAS SQUOZE FLAGS (ONLY) IN PLACE FOR IOR OF SQUOZE + ;SYM HAS SQUOZE, FLAGS OF WHICH ARE IGNORED + +VSM2LV: TLOA C,3LLV ;ENTRY FOR LINKING LOADER MUST SUPPLY VALUE +VSM2W: MOVE B,WRD ;ENTRY TO ENTER VALUE OF WRD STEAD B +VSM2: MOVE CH1,SYM + TLZ CH1,740000 + IOR CH1,T ;CH1 := SQUOZE WITH FLAGS + MOVEM CH1,ST(D) ;STORE SQUOZE + MOVEM B,ST+1(D) ;STORE VALUE +VSM3A: 3PUT C,D ;STORE 3RDWRD + POPJ P, + +;RETURN THE NUMBER OF SYMTAB SLOTS IN USE. +A.SYMCN:SKIPL A,SMSRTF ;IF SYMTAB HAS BEEN COMPACTED, GET # OF SYMS THAT IT HAD + JRST CLBPOP ;BEFORE COMPACTION AND RETURN THAT. + MOVE D,SYMAOB + SETZ A, +A.SYC1: MOVE B,ST(D) + TLZ B,740000 + SKIPE B + AOS A + ADD D,WPSTE1 + AOBJN D,A.SYC1 + JRST CLBPOP + +;;EQUAL ;EQUAL SIGN ENCOUNTERED, DO PARAMETER ASSIGNMENT + +EQUAL: TLZ FF,FLHKIL + PUSHJ P,RCH + CAIE A,"= ;DECIDE WHETHER TO HALF-KILL THE SYM. + TLOA FF,FLUNRD + TLO FF,FLHKIL + SETZM LABELF + CALL RCH + CAIE A,": ;DECIDE WHETHER TO MARK SYM AS NOT REDEFINABLE. + TLOA FF,FLUNRD + SETOM LABELF + CAMN SYM,[SQUOZE 0,.] ;.=FOO, SAME AS LOC FOO + JRST PTEQ + TDNN I,[ILWORD,,IROP+IRNOEQ] + TRNN I,IRLET + ETR [ASCIZ/= With bad format or bad context/] + PUSH P,SYM + PUSH P,ESBK + PUSH P,I + MOVEI A,[ETSM [ASCIZ/Undefined in =/]] + MOVEM A,GTVER + TRO I,IRNOEQ+IRDEF+IREQL + PUSHJ P,GETWRD + TRNN I,IRDEF + JRST ASEM1A ;UNDEFINED SYMS IN VALUE, IGNORE +IFN LISTSW,[ + SKIPN LSTONP + JRST EQUAL1 ;NOT LISTING. + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE SYM,WRD + MOVEM SYM,LISTWD + MOVE SYM,WRDRLC + MOVEM SYM,LSTRLC + SETOM LISTAD + SETOM LISTPF +EQUAL1: +] ;END IFN LISTSW, + TDZ I,[-1-(ILMWRD)] + IOR I,(P) + TLZ FF,FLUNRD + POP P,(P) + POP P,ESBK + POP P,SYM + MOVE A,WRDRLC ;GET RELOCATION + TDNN A,[-2,,-2] ;SKIP ON NON-STANDARD RELOCATION BITS + SKIPE LDCCC + JRST EQG1 ;STRANGE RELOCATION OR IN LOAD TIME CONDITIONALS => HAND PROBLEM TO LOADER + MOVE A,GLSP1 + CAMN A,GLSP2 + JRST EQL1 ;NO GLOBALS IN DEFINITION +;FALLS THROUGH. + +;FALLS THROUGH. +;GLOBALS TO RIGHT OF = OR WITHIN LOADER CONDIT. +EQG1: IFN CREFSW, XCT CRFLBL ;CREF DEF. OF NORMAL SYM, + SKIPGE CONTRL + JUMPL FF,[ETASM [ASCIZ /Externals in =/]] + CALL ESDCHK ;SEARCH SYM TAB. + JRST EQL2 ;NOT FOUND IN CURRENT OR CONTAINING BLKS. + HRRZI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQG1A + XCT EQG1TB(A) ;FOUND IN DESIRED BLOCK. + JRST ASSEM1 + +EQG1A: JUMPN T,EQG2 + CAIN A,PSUDO_-16 ;FOUND AS INITIAL PSEUDO => ERROR. + ETSM ERRQPA +EQG2: CALL DEFCHK ;FIND FREE STE TO DEFINE IN DESIRED BLOCK. + JRST EQL2 ;PRETEND WASN'T FOUND. + +ERRQPA: ASCIZ /Shadowing a pseudo-op/ +ERRIPA: ASCIZ /Illegal =/ + +EQG1TB: ETSM ERRIPA ;COMMON + ETSM ERRIPA ;PSEUDO OR MACRO + JRST EQL2 ;SYM + JRST EQGUL ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL7 ;GLO ENTRY + JRST EQL8 ;GLO EXIT + +EQL8: PUSHJ P,GLKPNR + TLZ C,3LABEL\3MULTI +EQL7: MOVSI T,GLOETY ;GLOBAL PARA ASSIGN + MOVEI B,0 + TLO SYM,40000 +LOPRA1: PUSH P,CASM1A ;RETURN TO ASSEM1A AFTER FOLLOWING. + TLNE C,3MULTI + ETSM ERRMDT + SKIPE LABELF + TLO C,3LABEL + TLNE FF,FLHKIL + TLOA SYM,400000 ;SET FLAG TO HALF-KILL SYM + TLZA C,3SKILL + TLO C,3SKILL ;SET CORRESPONDING FLAG IN 3RDWRD + PUSHJ P,VSM2LV + JUMPGE FF,CPOPJ ;JUMP ON NOT PUNCHING PASS + TRNN I,IREQL ;IF CAME FROM COLON ROUTINE, + JRST PDEFPT ;PUNCH "DEFINE SYM AS $.". + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D ;STORE UPDATED 3RDWRD + PUSHJ P,EBLK + MOVEI TT,LGPA + DPB TT,[310700,,BKBUF] + PUSHJ P,OUTSM0 + PUSHJ P,PWRDA + JRST EBLK + +EQGUL: PUSHJ P,LKPNRO ;LOCAL UNDEF, OUTPUT LINK REQUEST. + TLZ C,3LABEL\3MULTI ;CAN'T DETECT MDT'S WHEN ONLY STINK KNOWS FOR SURE. +EQL2: TLNE I,ILGLI + JRST EQL7 ;MAKE IT GLOBAL + MOVSI T,LCUDF ;LOCAL UNDEFINED + JRST LOPRA1 + +CASM1A: JRST ASEM1A + +;MAYBE PUNCH OUT LINK REQUEST +;SYM HAS NAME OF SYM TO REQUEST, D STE IDX OF SYM, C 3RDWRD, B ADR OF REQUEST +;REQUEST WILL BE PUNCHED IF 3RLNK SET IN C OR IF ANYTHING SET IN LH(B) + +GLKPNR: TLO SYM,40000 ;GLO BIT +LKPNRO: TLNN C,3RLNK + TLNE B,-1 + TROA I,IRCONT + POPJ P, ;DON'T PUNCH REQUEST + MOVE A,CONTRL + TRNE A,DECREL + JRST LKPNDR ;DIFFERENT WAY TO OUTPUT THIS INFO IN DECREL FMT + MOVEI A,6 + PUSHJ P,PBITS + PUSHJ P,OUTSM0 ;PUNCH SYM + HLRZ A,B + TLZE C,3RLNK ;RELOC OF LINK PNR + TLO A,100000 + HRRZS B ;CLEAR OUT LH OF B + TRZ I,IRCONT ;OK TO END BLOCK NOW + JRST $OUTPT ;PUNCH OUT A AND RETURN + +LKPNDR: MOVSI A,DECINT ;WRITE AN "INTERNAL REQUEST" WITH ONE DATA WORD. + CALL DECBLK + SETZ TM, ;COMPUTE RELOC OF ADDRESS AND DATA IN TM. + TLNE C,3RLNK + TRO TM,2 + SKIPE WRDRLC + TRO TM,1 + MOVE A,WRD ;ADDRESS TO LINK,,DATA + HRL A,B + CALL DECWR1 + JRST EBLK + +;THESE ASSUME STE IDX IN D, SQUOZE W/ FLAGS IN SYM. +;C HAS 3RDWRD, B OR WRD HAS VALUE TO DEF. WITH. +;CALL ONLY IN RELOCATABLE ASSEMBLY. +OUTDE2: MOVEM B,WRD +OUTDE1: TLNE FF,FLPPSS + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D + SKIPGE CONTRL + RET + TRO I,IRCONT + SETZ A, + TLNN C,3LABEL ;WHAT KIND OF DEFINITION DEPENDS ON WHETHER SYM IS REDEFINABLE. + MOVEI A,CRDF + CALL P7X ;PUNCH OUT CODE BITS + PUSHJ P,GTVL7B ;SET RELOCATION BITS IN SQUOZE + PUSHJ P,OUTSM0 + TRZ I,IRCONT + JRST OUTWD ;OUTPUT VALUE + +;PUNCH OUT LOCAL-GLOBAL RECOVERY BITS AND SYM +;I.E. TELL LOADER THAT SQUOZE IN SYM, FORMERLY CONSIDERED LOCAL, IS REALLY GLOBAL +PLOGLO: SKIPGE CONTRL + RET + PUSH P,A + PUSHJ P,PBITS7 + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY THIS IS NEW STYLE RQ, + PUSHJ P,OUTSM0 ;PUNCH "OLD NAME" = SYMTAB IDX, + TLC SYM,440000 ;SAY MAKE GLOBAL, OUTPUT ACTUAL NAME OF SYM. + PUSHJ P,OUTSM + JRST POPAJ + +;NO GLOBALS TO RIGHT OF EQUAL SIGN + +EQL1: PUSHJ P,ESDCHK + JRST EQL1A ;NOT FOUND +IFN CREFSW,XCT CRFEQL ;DEF. OCCUR. OF NORMAL SYM. OR INTSYM. + MOVEI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQL1F + SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL + XCT EQL1TB(A) ;FOUND IN DESIRED BLOCK => NOW REDEFINE. + JRST ASSEM1 + +EQL1F: JUMPN T,EQL10 + CAIE A,PSUDO_-16 + JRST EQL10 + MOVEI T,(B) ;FOUND AS PSEUDO IN INITIAL SYMS BLOCK, + CAIN T,INTSYM ;SPECIAL WAY TO REDEFINE IF LIKE .MLLIT, ETC. + JRST EQLINT + ETSM ERRQPA ;SHADOWING AN INITIAL PSEUDO, TELL USER. +EQL10: CALL DEFCHK ;FOUND IN OUTER BLOCK, GET NEW STE, + JRST EQL1A ;DEFINE THERE AS IF NOT FOUND. + +EQL1TB: ETSM ERRIPA ;COMMON + JRST EQL1B2 ;PSEUDO OR MACRO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL1D ;GLO ENTRY + JRST EQL1E ;GLO EXIT + +EQL1E: PUSHJ P,GLKPNR ;DUMP LINKING POINTER + CAIA +EQL1D: CALL MDTCHK + PUSHJ P,RCHKT ;GLO ENTRY +EQLB2: PUSHJ P,RMOVET + TLNE FF,FLHKIL + TLOA SYM,400000 + TLZA C,3SKILL + TLO C,3SKILL + HRLZI T,GLOETY + SKIPE LDCCC ;IF IN LOADER CONDITIONAL, + TLO C,3LLV ;THEN LOADER MUST SUPPLY VALUE + PUSHJ P,VSM2W ;DEFINE SYM + TLO SYM,40000 ;SET GLOBAL BIT IN SQUOZE +EQL1CE: JUMPGE FF,ASEM1A + PUSHJ P,OUTDE1 +ASEM1A: TLNE I,ILMWRD + PUSHJ P,IGTXT + JRST ASSEM1 + +;CHECK WHETHER DEFINING AN MDT, OR REDEFINING A LABEL (=> THIS IS AN MDT) +MDTCHK: TLNN C,3LABEL + JRST MDTCH1 + CALL GVSYM0 ;MOVE VALUE OF SYM TO A, GET RELOC (WRDRLC STYLE) IN B + CAMN A,WRD + CAME B,WRDRLC ;IF WE'RE CHANGING THE VALUE, MARK SYM AS MDT +MDTCHL: TLO C,3MULTI +MDTCH1: TLNE C,3MULTI ;EVER ASSIGNING TO MDT, EVEN SAME VALUE, GIVES ERR MSG + ETSM ERRMDT + RET + +EQL1C: TLNE I,ILGLI + JRST EQL1CA ;MAKE GLOBAL + PUSH P,C + PUSHJ P,LKPNRO ;MAYBE OUTPUT LINK REQUEST + PUSHJ P,RCHKT + PUSHJ P,RMOVET ;INITIALIZE 3RDWRD + MOVSI T,SYMC ;SYM + PUSHJ P,EQA2A ;ENTER DEF IN SYMTAB + TLNE C,3SKILL + TLO SYM,400000 + POP P,AA + TLNE AA,3VCNT ;USED IN CONSTANT + PUSHJ P,CONBUG + JRST EQL1CE + + ;PUNCH OUT CODE BIT PAIR, FIRST OF WHICH IS 7 + +P7X: MOVEM A,PARBIT ;ENTRY FOR SECOND BYTE IN A +P70: PUSHJ P,PBITS7 ;ENTRY FOR SECOND BITE IN PARBIT, PUNCH OUT THE 7 + SKIPA A,PARBIT ;GET SECOND BYTE BACK +PBITS7: MOVEI A,7 ;ENTRY TO JUST PUNCH OUT 7 + JRST PBITS + +EQL1CA: PUSHJ P,PLOGLO + JRST EQL1E +EQA2: PUSH P,CASM1A +EQA2A: TLNE FF,FLHKIL + TLO C,3SKILL + JRST VSM2W + +EQL1B2: HRRZ A,B ;ATTEMPT TO ASSIGN PSEUDO-OP, IS IT AN INTSYM? + CAIN A,INTSYM + JRST EQLINT ;YES, GO SET WD IT POINTS TO. + ETSM [ASCIZ /Pseudo or macro ='D/] +EQL1B: CALL MDTCHK + PUSHJ P,RCHKT + TLNE I,ILGLI + JRST EQLB2 ;WAS LOCAL, MAKE IT GLOBAL + ;WAS LOCAL, LEAVE IT LOCAL + PUSHJ P,RMOVET ;PUT RELOCATION BITS IN BITS 0 AND 1 OF C (I.E. START SETTING UP 3RDWRD) + MOVSI T,SYMC ;SYM + JRST EQA2 + +EQL1A1: PUSHJ P,RCHKT + PUSHJ P,RMOVET + HRLZI T,SYMC + JRST EQA2 + +EQL1A: SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL +IFN CREFSW,XCT CRFLBL ;DEF. OCCUR. OF NORMAL SYM. + TLNN I,ILGLI + JRST EQL1A1 + JRST EQL1E + +EQLINT: HLRZS B ;GET ADDR OF WD HOLDING VALUE. + MOVEMM (B),WRD ;PUT NEW VALUE IN IT. + JRST ASEM1A + +;;. ;ROUTINES DEALING WITH THE CURRENT LOCATION AND OFFSET + +VBLK +CLOC: 0 ;PUNCHING LOC +CRLOC: 0 ;PUNCHING RELOC +OFLOC: 0 ;OFSET VAL +OFRLOC: 0 ;OFSET RELOC +;VAL OF PT=CLOC+OFLOC,CRLOC+OFLOC +SYLOC: 0 ;VAL OF LAST TAG +SYSYM: 0 ;LAST TAG +SYLOC1: 0 ;VALUE OF NEXT TO LAST TAG +SYSYM1: 0 ;NEXT TO LAST TAG +GLOCTP: 0 ;4.9 => CURRENT LOCATION GLOBAL, 2.9 => OFFSET GLOBAL + ;FRGLOL (FLAG IN FF) IS IOR OF BITS 4.9 AND 2.9 OF GLOCTP + ;EXCEPT AFTER .=NON-GLOBAL WITH GLOBAL OFFSET + ;OTHER BITS USED ONLY WHEN IN LINK (NEVER SET IN GLOCTP): + ;400 => ARG GLOBAL +PBLK + + + ;POINT (.) AS PSEUDO-OP + +GTVLP: TRNE FF,FRGLOL + JRST GTVLP2 ;LOCATION GLOBAL + MOVE B,OFRLOC ;GET RELOCATION OF OFFSET + ADD B,CRLOC ;ADD CURRENT RELOCATION + MOVE A,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 ;IF IN BYTE MODE, + HLL A,BYTWP ;SET LEFT HALF TO BYTE POINTER LEFT HALF FOR ILDB + ADD A,OFLOC ;NOW ADD OFFSET + TLZ I,ILFLO+ILDECP+IRPERI ;CLEAR OUT FLAGS SET WHEN LOOKED LIKE FLOATING POINT NUMBER + POPJ P, + + +GTVLP2: MOVEI T,$.H ;LOCATION GLOBAL + AOS GLSP1 + HRRZM T,@GLSP1 ;PUT $. ON GLOBAL LIST (INCLUDES OFFSET, WHETHER GLOBAL OR NOT) + SKIPL BYTM1 ;IN BYTE MODE? + TDZA A,A ;NO, CLEAR ABS PART OF VALUE + HLLZ A,BYTWP ;YES, USE LH(BP) AS ABS PART + JRST CLBPOP + +$.H: (GLOETY)+SQUOZE 0,$. ;CURRENT LOCATION + OFFSET IN LOADER +$L.H: (GLOETY)+SQUOZE 0,$L. ;LOCATION BEING LOADED INTO BY LOADER, USED BY ABLOCK +$O.H: (GLOETY)+SQUOZE 0,$O. ;LOADER OFFSET +$R.H: (GLOEXT)+SQUOZE 0,$R. ;RELOCATION AS GLOBAL + +COLON: TRNE I,IRLET + TRNN I,IRSYL + ETA [ASCIZ/Colon without preceding symbol/] + TLNN I,ILWORD + TRNE I,IROP+IRPSUD+IREQL+IRNOEQ + ETSM [ASCIZ/Label inside an expression/] + SKIPE ASMOUT + ETSM [ASCIZ /Label inside <>, () or []/] + TLZ FF,FLHKIL + PUSHJ P,RCH ;GET NEXT CHAR + CAIN A,": ;IF NEXT CHAR ANOTHER COLON, + TLOA FF,FLHKIL ;THEN SET FLAG TO HALF-KILL + TLO FF,FLUNRD ;NOT COLON, CAUSE IT TO BE RE-INPUT + SKIPE HKALL ;CHECK FOR HALF-KILL-ALL-LABELS MODE. + TLO FF,FLHKIL + MOVE T,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 + HLL T,BYTWP ;BYTE MODE, SET LEFT HALF OF VALUE TO LEFT HALF OF BYTE POINTER + ADD T,OFLOC ;ADD OFFSET + MOVEM T,WRD ;STORE RESULT AWAY FOR POSSIBLE PUNCHOUT + EXCH T,SYLOC ;NOW SET UP STUFF FOR ERROR PRINTOUT + MOVEM T,SYLOC1 + EXCH SYM,SYSYM + MOVEM SYM,SYSYM1 + MOVE SYM,SYSYM + MOVE A,CRLOC ;SET UP RELOCATION + ADD A,OFRLOC + MOVEM A,WRDRLC + SETOM LABELF ;SET FLAG CAUSING 3LABEL (DON'T REDEFINE) TO BE SET. + SKIPN LDCCC + TRNE FF,FRGLOL + JRST GCOL1 ;LOCATION VIRTUAL OR IN LOAD TIME CONDITIONAL + PUSHJ P,ESDCHK ;TRY FINDING CURRENT ENTRY IN ST + JRST EQL1A ;NOT ALREADY DEFINED +IFN CREFSW,XCT CRFLBL +COLON1: MOVEI T,(C) ;BKTAB IDX OF BLOCK FOUND IN, + CAIE T,(TM) ;FOUND IN DESIRED BLOCK => TRY REDEFINING. + JRST COLON3 + TLO C,3LABEL ;CAUSE REDEFINING SYMBOL TO BARF + XCT COLON2(A) ;BUT MAYBE PRINT ERR MSG FIRST. + JRST EQL1B + +CASSM1: JRST ASSEM1 + +COLON3: JUMPN T,EQL10 ;NOT INITIAL SYM => CAN SHADOW, + CAIN A,SYMC_-14. ;INITIAL SYM => CAN SHADOW IF IT'S AN ORDINARY LOCAL SYM + CAME B,WRD ;AND NEW VALUE SAME AS OLD VALUE. + CAIA + SKIPE WRDRLC + ETSM ERRRES ;ELSE GIVE ERROR MESSAGE BEFORE SHADOWING, TO WARN USER. + JRST EQL10 + +ERRRES: ASCIZ /Pseudo, macro or initial sym as label/ +ERRMDT: ASCIZ /Multiply defined/ + +COLON2: TLO C,3MULTI ;COMMON + ETSM ERRRES ;MACRO OR PSEUDO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI ;SETTING 3MULTI CAUSES EQL1B TO PRINT AN MDT ERROR. + JRST EQL1D ;GLOBAL ENTRY + JRST EQL1E ;GLO EXIT + +;COLON WHEN LOCATION VIRTUAL, OR IN LOAD TIME CONDITIONAL + +GCOL1: IFN CREFSW,XCT CRFLBL ;DEFINING ORDINARY SYM. + SKIPGE CONTRL + ETASM [ASCIZ /Virtual label in abs assembly/] + PUSHJ P,ESDCHK ;FIND ITS SLOT IN ST + JRST EQL2 ;JUST LIKE EQG1 EXCEPT FOR ERROR MESSAGES. + MOVEI T,(C) + CAIE T,(TM) + JRST COLON5 + XCT GCOL1T(A) ;FOUND IN DESIRED BLOCK, REDEFINING. + JRST EQL2 + +COLON5: JUMPN T,EQG2 ;SHADOWING, OK UNLESS INITIAL SYM. + ETSM ERRRES + JRST EQG2 + +GCOL1T: TLO C,3MULTI ;COMMON + ETSM ERRRES ;PSEUDO. + JRST EQL2 ;SYM. + JRST EQGUL ;LOCAL UNDEF. + TLO C,3MULTI ;VAR + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + JRST EQL7 ;DEF GLO + JRST EQL8 ;UNDEF GLO. + + + ;PUNCH OUT "DEFINE SYM AS $." + +PDEFPT: MOVEI A,CDEFPT + PUSHJ P,P7X ;OUTPUT 7 THEN PDEFPT + JRST OUTSM0 ;OUTPUT SYM, WITHOUT BITS + +;LOC, BLOCK, .= + +ALOC: PUSHJ P,ALOCRG ;LOC, GET ARG +ALOC1: SETZM SYLOC ;CLEAR OUT LOC OF LAST TAG + SETZM SYSYM ;CLEAR OUT LAST TAG SO ERROR MESSAGES DON'T PRINT OBSCENE INCREMENTS +IFN FASLP,[ + SKIPGE TM,CONTRL + TRNN TM,FASL + JRST .+2 + ETA [ASCIZ /LOC illegal in FASL assembly/] +] + TRZE LINK,400 ;GLOBALS IN ARG? + JRST ALOC2 ;YES + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF CURRENT LOCATION + CALL SLOCF ;RE-INIT NEXT OUTPUT BLOCK'S HEADER; SET LOCF. + MOVEI A,LCEGLO ;=> RESET GLOBAL RELOCATION (BACK TO ORIGINAL NON-GLOBAL RELOCATION) + TLZE LINK,400000 ;IS CURRENT LOCATION NOW GLOBAL? + PUSHJ P,PLDCM ;YES, RESET IT + MOVE B,WRDRLC ;GET BACK NEW RELOCATION +ALOC2B: TRZE B,-2 ;NO BITS ALLOWED EXCEPT LOW ORDER + ETR [ASCIZ *Illegal relocation in LOC/BLOCK/.=*] + HRRZM B,CRLOC ;STORE NEW RELOCATION + SKIPGE CONTRL + JRST ASSEM1 ;DON'T BOTHER WITH REST IF ABS. + MOVEI B,2(B) ;LABS OR LREL + DPB B,[310700,,BKBUF] ;STORE NEW BLOCK TYPE + MOVEM B,CDATBC ;ALSO STORE AS NORMAL BLOCK TYPE +AOFSTX: TDNN LINK,[SETZ(SETZ)] ;ENTRY FROM AOFFSET, SKIP IF FRGLOL SHOULD BE SET + TRZA FF,FRGLOL ;CURRENT LOCATION PLUS OFFSET NOT GLOBAL, CLEAR FLAG + TRO FF,FRGLOL ;GLOBAL, SET FLAG + TRZ LINK,600 ;CLEAR OUT TEMPORARY FLAGS SO WON'T GET STORED IN GLOCTP + MOVEM LINK,GLOCTP ;STORE BACK STATUS FLAGS + JRST ASSEM1 + +PTEQ: MOVE SYM,[SQUOZE 0,LOC] + PUSHJ P,ALOCRG ;.=, GET ARG + MOVE T,[MINF+HFWDF,,$O.H] ;GLOTB ENTRY IF .+1 DOESN'T SKIP + TRNE LINK,400000 ;OFFSET GLOBAL? + JRST PTEQ2 ;YES, WANT TO DO LOC ARG-$O." + PUSHJ P,SBWDOF ;OFFSET IS LOCAL, SUBTRACT FROM ARG + JRST ALOC1 + +ABLOCK: PUSHJ P,ABLKRG ;GET ARG TO "BLOCK" PSEUDOOP. + TRNE LINK,400 ;GLOBALS IN ARG? + JRST ABLKG ;GLOBALS IN ARG + TLNE LINK,400000 + JRST ABLKG ;JUMP IF LOSER CHANGING RELOCATION WHILE CLOC GLOBAL +IFN FASLP,[ + MOVE D,CONTRL + TRNN D,FASL ;IN FASL FORMAT, CAN'T SET LOC. CTR., + JRST ABLKF1 + SKIPE B + ETA [ASCIZ /BLOCK size relocatable/] + JUMPGE FF,ABLKF1 + CALL ABLKF ;SO ON PASS 2 OUTPUT A BUNCH OF ZEROS. + JRST ABLKF1 + +;OUTPUT C(A) ZEROS, IN FASL FORMAT. NO-OP ON PASS 1. DOESN'T SET THE LOCATION COUNTER. +ABLKF: JUMPE A,CPOPJ + JUMPGE FF,CPOPJ + SETZM WRD + SETZM WRDRLC + PUSH P,A + PUSH P,A +ABLKF2: CALL FASPW + MOVEMM GLSP2,GLSP1 + SOSE (P) + JRST ABLKF2 + JRST POPBAJ +] + +ABLKF1: JUMPL A,[ETA [ASCIZ /BLOCK size negative/]] + ADD A,CLOC ;ARG TO BLOCK IS LOCAL, ADD DIRECTLY TO CLOC + ADD B,CRLOC ;ALSO ADD RELOCATIONS + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF LOCATION + CALL SLOCF ;FALL INTO ALOC ROUTINE, MAKING SURE FRLOC GETS SET + JRST ALOC2B + + +SBWDOF: SUB A,OFLOC ;SUBTRACT OFFSET FROM WRD, ETC. IN A,B + HRRZM A,WRD ;MAKE SURE RESULT GETS STORED IN WRD, AS WELL AS AC'S + SUB B,OFRLOC ;NOW DO RELOCATIONS + HRRZM B,WRDRLC + POPJ P, + +ABLKG: TRNE LINK,400000 ;GLOBAL BLOCK, IS OFFSET GLOBAL? + JRST ABLKG2 ;YES, OK TO REFERENCE $L. + PUSHJ P,SBWDOF ;NO, FOR COMPATIBILITY, DON'T REFERENCE $L. + SKIPA T,[HFWDF,,$.H] +ABLKG2: MOVE T,[HFWDF,,$L.H] +PTEQ2: AOS GLSP1 ;STORE T IN GLOTB + MOVEM T,@GLSP1 +ALOC2: TLO LINK,400000 ;SET GLOBAL LOCATION FLAG + MOVEI A,LCGLO ;=> GLOBAL LOCATION ASSIGNMENT + PUSHJ P,PLDCM ;PUNCH OUT GLOBAL LOCATION ASSIGNMENT + SETZM CLOC ;CLEAR OUT CLOC, NEW RELOCATION NOW + SETZB B,BKBUF ;ALSO CLEAR OUT HEADER, JUST TO BE SURE + AOJA B,ALOC2B ;SET RELOCATION TO 1 AND FALL IN + +AOFFSET: PUSHJ P,AOFFS2 ;OFFSET, GET ARG + MOVE A,T + MOVEM A,WRD ;RESTORE UNTRUNCATED ARG. + TRZE LINK,400 ;GLOBALS IN ARG? + TROA LINK,400000 ;GLOBALS IN ARG, SET GLOBAL OFFSET FLAG + TRZ LINK,400000 ;NO GLOBALS IN ARG + MOVEM A,OFLOC ;STORE NEW OFFSET + MOVEM B,OFRLOC ;ALSO STORE RELOCATION BITS + SKIPGE CONTRL ;IN RELOCATABLE, + JRST AOFSTX + MOVEI A,LDOFS ;LOADER OFFSET LOADER COMMAND TYPE + PUSHJ P,PLDCM ;PUNCH OUT LOADER COMMAND + JRST AOFSTX + +;GET ARG TO LOC, BLOCK, .=, OFFSET + +ALOCRG: +ABLKRG: MOVE A,CLOC + SKIPN CRLOC + JRST [ CAML A,DECBRA ;IF ADDR BEFORE THE LOC WAS ABS, + MOVEM A,DECBRA ;UPDATE HIGHEST ABS ADDR IF NEC. + JRST ABLKR1] + CAML A,DECTWO ;IT WAS RELOCA; UPDATE HIGHEST + JRST [ CAML A,DECBRH ;ADDR OF APPROPRIATE SEG. + MOVEM A,DECBRH + JRST ABLKR1] + CAML A,DECBRK + MOVEM A,DECBRK +AOFFS2: +ABLKR1: PUSH P,SYM + PUSHJ P,CONBAD ;ERROR IF IN GROUPING + REST SYM + TRNE I,IRNOEQ\IRPSUD\IREQL + ETSM [ASCIZ /Inside pseudo or =/] + TDNE I,[ILWORD,,IRFLD] + ETSM ERRNVL + PUSHJ P,EBLK ;MAYBE END CURRENT OUTPUT BLOCK + PUSHJ P,AGETWD ;GET ARG + MOVE LINK,GLOCTP ;GET GLOCTP FLAGS IN LINK, STAYS THERE UNTIL ALMOST DONE + MOVE T,GLSP2 + CAME T,GLSP1 + TROA LINK,400 ;SIGNAL GLOBAL ARG + TRZ LINK,400 ;LOCAL + MOVE T,A ;SAVE UNTRUNCATED FOR AOFFSET, + HRRZS A,WRD ;TRUNCATE FOR LOC, BLOCK, .=. + TRNN I,IRDEF ;ALL DEFINED? + JRST ASSEM1 + SKIPGE CONTRL ;YES, RETURN SKIPPING OVER ARG + TRNN LINK,400 + RET + MOVE SYM,GTVER + ETASM [ASCIZ *Argument has externals*] + +;;CONSTANTS AND VARIABLES + ;VARIABLES AREA +VBLK + +LCNGLO==CONMIN/4 +LCONTB==CONMIN + +BLCODE [ +PCNTB: BLOCK NCONS*3 ;CONSTANTS AREAS TABLE +VARTAB: BLOCK NVARS +] +CONTBA: CONTAB ;ADDRESS OF BEGINNING OF CONSTANTS TABLE. +CONTBE: CONTAB+LCONTB ;ADDRESS OF WORD AFTER END OF CONSTANTS TABLE. +PLIM: 0 ;POINTER TO FIRST UNUSED WORD IN CONSTANTS TABLE. + +CONGLA: CONGLO ;ADDRESS OF BEGINNING OF CONSTANT-GLOBALS TABLE. +CONGLE: CONGLO+LCNGLO ;ADDRESS OF WORD AFTER END OF CONSTANT GLOBALS TABLE. +CONGOL: 0 ;HAS ADR OF FIRST WORD INACTIVE IN CONSTANT-GLOBALS TABLE. + +CONBIA: CONBIT ;ADDRESS OF BEGINNING OF CONSTANT-RELOCATION-BITS TABLE. + +CONLEN: CONMIN ;TOTAL SPACE ALLOCATED TO CONSTANTS TABLES. + ;ALL THE HOOKS ARE IN FOR DYNAMIC ALLOCATION OF THESE TABLES + ;(CONTAB, CONGLO, AND CONBIT). ALL THAT IS NEEDED IS TO GET + ;THE SPACE AND INITIALIZE CONTBA, CONTBE, CONGLA, CONGLE, CONBIA. + + ;PCNTB STUFF + + ;EACH ENTRY 3 WORDS; FIRST WORD SQUOZE, NAME OF AREA IF GLOBAL +CSQZ: 0 ;SQUOZE COUNTER + ;SECOND WORD RH LOC OF AREA (WITH OFFSET), LH LOC FIRST AFTER AREA (WITHOUT OFFSET) + ;THIRD WORD LH FLAGS + +CGBAL==100000 ;GLOBAL (INCLUDING OFFSET) +CTRL==200000 ;RELOCATED ( " ) +CTDEF==400000 ;DEFINED (MUST BE SIGN) + +PBCON: 0 ;POINTER INTO PCNTB, HAS ADR OF ENTRY FOR NEXT CONSTA +PBCONL: 0 ;POINTER TO ABSOLUTE TOP OF PCNTB +CONCNT: 0 ;NUMBER OF TIMES CONSTANTS CAN APPEAR (DECREMENTED BY CONSTA) +CONDEP: 0 ;DEPTH IN CONSTANTS (0 TOP LEVEL) +CONSAD: 0 ;ADDR IN CONSTANTS TABLE OF ENTRY FOR CURRENT CONST. +CONSML: 0 ;VALUE OF .MLLIT INTSYM. + ;NEGATIVE => ERROR MODE (DEFAULT) + ;ZERO => OLD MODE. + ;POSITIVE => NEW (MULTI-LINE) MODE. + +CONSTP: 0 ;PDL POINTER BELOW WDS FOR INNERMOST CONSTANT. +CONSP1: 0 + + ;VARIABLES FOR VARIABLES CODING + +VARCNT: 0 ;NO OF VAR IN CURRENT VAR AREA SO FAR +VARPNT: 0 ;POINTER TO CURRENT PLACE IN VARTAB +VARCNR: 0 ;NO OF TIMES VARIABLES MAY APPEAR +VCLOC: 0 ;TEM FOR VARIAB +VECSIZ: 0 ;DEFAULT SIZE FOR .VECTOR. + +PBLK + +;LEFT-BRACKET ENCOUNTERED; HERE ON DISPATCH FROM GETFD +;SAVE WORLD, BYTE MODE, ASSEM1 PDL LEVELS. +;THEN SET ASSEM1 PDL LEVELS TO CURRENT LEVELS +;SO ASSEM1 WON'T FLUSH PAST LEVEL OF CONSTANT. +;SET CONSTP _ CURRENT PDL LEVEL. PCONS WILL PUT WORDS +;OF CONSTANT ABOVE CONSTP, AND SET ASSEMP ABOVE THEM. + +LBRAK: SKIPE LITSW + ETR [ASCIZ /Literal/] + TRO I,IRFLD ;LEFT BRACKET + JSP LINK,SAVWD1 ;SAVE CRUFT + PUSH P,SCNDEP ;SO THE NEXT RBRKT WON'T TRY TO CLOSE CONDIT. + JSP LINK,SAVAS1 + MOVEIM ASMOUT,3 + SETZM SCNDEP ;NOT WITHIN CONDITIONALS IN THIS LITERAL. + AOS CONDEP ;ONE DEEPER IN LITERALS. + JRST ASSEM3 ;GO ASSEMBLE THE WORDS OF THE CONSTANT. + +;OUTPUT WORD TO CONSTANT. P MUST EQUAL ASSEMP HERE. +PCONS: SKIPL CONTRL ;IF RELOCATABLE, + PUSHJ P,$RSET ;HANDLE STRANGE RELOCATIONS. + MOVE B,GLSP1 + SUB B,GLSP2 ;NUM. GLOBAL ENTRIES FOR THIS WD. + HLRZ A,WRDRLC ;ONLY 1.1 AND 3.1 BITS MATTER. + LSH A,1 + IOR A,WRDRLC ;GET THEM INTO 1.1, 1.2 BITS. + TLNE I,ILNOPT ;REMEMBER ILNOPT ALSO. + IORI A,4 + DPB B,[032200,,A] ;AND # GLBLS. + PUSH P,A ;SAVE THEM ALL. + HRLI B,(B) ;GET # GLBLS,,# GLBLS . + JUMPE B,PCONS1 + MOVE A,GLSP2 + MOVSI A,1(A) + HRRI A,1(P) ;SAVE THE GLBLS, IF ANY. + ADD P,B + JUMPGE P,CONFLP + BLT A,(P) +PCONS1: PUSH P,WRD + MOVEM P,ASSEMP ;ASSEMP -> ABOVE WDS FOR LIT.; CONSTP, BELOW. + JRST (T) + +;JSP LINK,SAVAS1 TO PUSH DATA ON ASSEM1 LEVEL AND CALL ASSEM1 +;LOOP RECURSIVELY. +.SEE CONNDP ;WHICH IS WHERE THESE THINGS ARE POPPED. +SAVAS1: SKIPN BYTM ;IF IN BYTM NOW (WILL PUSH AND TURN OFF) + JRST LBRAK1 + MOVSI A,BYBYT ;SAVE ALL THE DETAILS. + HRRI A,1(P) + ADD P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] + JUMPGE P,CONFLP ;(SOFTWARE-DETECTED PDL-OV) + BLT A,-BYTMCL(P) + MOVSI A,BYTMC + HRRI A,1-BYTMCL(P) + BLT A,(P) +LBRAK1: PUSH P,BYTM + SETZM BYTM + PUSH P,ASMOUT + PUSH P,ASMDSP + PUSH P,ASMI + PUSH P,GLSPAS ;SAVE ASSEM1 PDL LEVELS. + PUSH P,ASSEMP + PUSH P,CONSTP + MOVE A,I + ANDI A,IRPSUD+IREQL + IORI A,IRDEF + MOVEM A,ASMI ;ASMI IOR'D INTO I AT ASSEM2 LOOP. + HRRZ A,CPGN + HRL A,CLNN ;REMEMBER WHERE THIS LITERAL STARTS. + INSIRP PUSH P,[A SYSYM SYLOC] + MOVEM P,ASSEMP ;SO ASSEM1 WON'T FLUSH WHAT WE PUSHED. + MOVEM P,CONSTP ;SO CONND CAN FIND 1ST WD OF CONSTANT. + MOVEMM GLSPAS,GLSP1 +SAVAS2: MOVEI A,ASSEM3 ;IF NOT MULTI-LINE MODE, ARRANGE TO + SKIPG CONSML ;END THE CONSTANT AFTER 1 WORD. + MOVEI A,ASSEMC + MOVEM A,ASMDSP + JRST (LINK) + +PCONST: MOVE CH1,ASMDSP ;OUTPUT TO CONST. FROM ASSEM1 + CAIN CH1,CONND ;LAST WD OF CONST? + CAME P,CONSTP ;1ST WD? + JRST PCONS ;NO, DO THE GENERAL THING. + SKIPL CONTRL ;THIS MUST BE ONLY WORD OF CONST, + PUSHJ P,$RSET ;DON'T BOTHER PUSHING, END CONST. NOW. + PUSH P,CONSTP + TLZ I,ILMWRD+ILMWR1 ;THIS IS 1ST WD, NO MORE WDS. + JRST CONND3 ;PRETEND JUST POPPED IT. + +;COME HERE FROM ASSEM1 TO END A CONSTANT. +CONND: SKIPE BYTM ;IF IN BYTE MODE, LEAVE IT AND DO .WALGN + JRST A.BY3 ;(WILL COME BACK SINCE ASMDSP STILL SET) +CONNDW: MOVEMM CONSP1,CONSTP + TLZ I,ILMWR1 ;THIS IS 1ST WORD COMING UP. +CONND0: TLZ I,ILMWRD+ILNOPT + SETZM WRDRLC + MOVE F,CONSP1 ;ADDR IN IN PDL OF NEXT WD. + CAMN F,ASSEMP + JRST CONND2 ;J IF NO WORDS. + MOVE A,1(F) ;GET SAVED NUM GLBLS,,NUM GLBLS + DPB A,[100,,WRDRLC] + LSH A,-1 ;RESTORE WRDRLC BITS 1.1, 3.1 + DPB A,[220100,,WRDRLC] + TRNE A,2 + TLO I,ILNOPT ;RESTORE NOOPTF. + LSH A,-2 ;GET # GLBLS. + HRLI A,(A) ;# GLBLS,,# GLBLS. + AOBJN F,.+1 + HRRZM F,GLSP2 ;ADDR BEFORE 1ST GLOBAL ENTRY. + ADD F,A + HRRZM F,GLSP1 ;ADDR OF LAST GLOBAL ENTRY. + MOVE A,1(F) + MOVEM A,WRD + AOBJN F,.+1 ;POINT TO NEXT CONST WD IF ANY, + MOVEM F,CONSP1 + CAME F,ASSEMP ;IF MORE WORDS SET ILMWRD + TLO I,ILMWRD + JRST CONND3 + +CONND2: INSIRP SETZM,[WRD,GLSP1,GLSP2] +CONND3: MOVE F,GLSP1 + SUB F,GLSP2 + JUMPE F,SCON ;JUMP IF NOTHING VIRTUAL + MOVEI B,-1(F) + MOVN TT,B + JUMPE B,SCON ;JUMP IF ONLY ONE GLOBAL + ;SORT GLOTB ENTRIES THIS CONSTANT +LSORT: HRL T,TT ;SET UP AOBJN POINTER TO GLOBALS REMAINING + HRR T,GLSP2 +LSORT2: MOVE A,1(T) + CAMLE A,2(T) + EXCH A,2(T) ;INTERCHANGE + MOVEM A,1(T) + AOBJN T,LSORT2 ;INNER LOOP POINT + SOJG B,LSORT ;OUTER LOOP + ;DROPS THROUGH + +;DROPS THROUGH +SCON: PUSHJ P,RCHKT + PUSHJ P,RMOVET ;SET UP RELOACTION BITS. + ROT T,2 ;ROTATE TO BOTTOM TWO BITS OF T + TLNE I,ILMWRD+ILMWR1+ILNOPT + JRST NOCON ;MULTIPLE WORD OR OPTIMIZATION SUPPRESSED, DON'T TRY TO FIND MATCH + MOVE A,CONTBA +SCON1: CAML A,PLIM ;SEARCH CONSTANTS TABLE TO SEE IF ALREADY THERE + JRST NOCON ;END OF TABLE, NO MATCH + MOVE B,WRD + CAME B,(A) +SCON2: AOJA A,SCON1 ;VAL DISAGREES + PUSHJ P,CPTMK ;GET BP TO CONSTANTS-BIT TABLE IN C + LDB F,C ;GET RELOCATION BITS THIS CONSTANT + CAME F,T + JRST SCON2 ;RLC DIFFRS + MOVE B,CONGLA ;VALUE AND RELOCATION AGREE, NOW TO CHECK GLOBALS + SKIPA C,GLSP2 +SCON2B: AOS B ;SEARCH FOR GLOBAL POINTING TO CONSTANT WHICH HAS MATCHED SO FAR + CAML B,CONGOL + JRST SCON3 ;GLOBALS MATCH SO FAR + CAME A,1(B) ;SKIP IF ONE FOUND +SCON7: AOJA B,SCON2B ;NOT YET + MOVE D,(B) ;FOUND ONE, GET GLOTB ENTRY + CAME D,1(C) ;COMPARE WITH THIS ENTRY IN GLOTB + JRST SCON2 ;NO MATCH, FLUSH THIS CONSTANT + AOJA C,SCON7 ;MATCH, TRY NEXT GLOBAL + +SCON3: CAME C,GLSP1 ;GLOBALS MATCH, BUT ARE WE EXACTLY AT END OF GLOTB? + JRST SCON2 ;NO, BACK TO SEARCH + JRST NOCON4 + +NOCON: AOS A,PLIM ;CONSTANT NOT ALREADY IN TABLE + CAMLE A,CONTBE + ETF [ASCIZ/Literal table full/] + MOVE AA,WRD + MOVEM AA,-1(A) + SOS A + PUSHJ P,CPTMK + TLNE I,ILNOPT + TRO T,4 ;1.3 OF RELOCATION BITS => DON'T OPTIMIZE ON TOP OF ME + DPB T,C + MOVE B,GLSP2 +NOCON3: CAML B,GLSP1 + JRST NOCON4 + SKIPN C,1(B) + AOJA B,NOCON3 ;THIS ENTRY NOT REALLY HERE + MOVEM C,@CONGOL + HRRZS C + PUSHJ P,NOCON5 + MOVEM A,@CONGOL + PUSHJ P,NOCON5 + SKPST C, ;SKIP IF IN SYMBOL TABLE + AOJA B,NOCON3 + 3GET1 D,C ;IN SYMBOL TABLE + TLO D,3VCNT ;THIS SYM USED IN CONSTANT + 3PUT1 D,C ;UPDATE 3RDWRD TABLE ENTRY + AOJA B,NOCON3 + +NOCON5: AOS AA,CONGOL + CAML AA,CONGLE + ETF [ASCIZ/Constants-global table full/] + POPJ P, + + ;SET UP BYTE POINTER TO CONSTANTS-BIT TABLE + ;A SHOULD HAVE ADR OF CONSTANTS TABLE ENTRY + ;LEAVES ANSWER IN C + ;BITS IN CONSTANTS-BIT TABLE PER ENTRY: + ;1.2, 1.1 RELOCATION BITS + ;1.3 ILNOPT BIT => DON'T OPTIMIZE ON TOP OF ME + +CPTMK: PUSH P,A + SUB A,CONTBA + PUSH P,B + IDIVI A,12. + MOVEI C,(A) + ADD C,CONBIA ;SET UP ADDRESS PART + IMULI B,3 + DPB B,[360600,,C] ;STORE POSITION FIELD FROM REMAINDER + TLO C,200 ;SET UP SIZE FIELD +POPBAJ: POP P,B + JRST POPAJ + +NOCON4: TLON I,ILMWR1 + MOVEM A,CONSAD ;IF 1ST WD SAVE ADDR. + TLNE I,ILMWRD ;IF MORE WORDS, HANDLE NEXT. + JRST CONND0 + MOVE P,CONSTP ;VALUE OF CONSTP AT CONND. + MOVE C,GLSPAS ;TO RESTORE GLSP1 + JSP T,CONNDP ;POP STUFF. + HRRZ A,CONSAD ;ADDR OF CONSTANTS TABLE ENTRY OF 1ST WD. + MOVE B,PBCON ;ADDR OF WDS DESCRIBING CONST. AREA. + SKIPL 2(B) ;CONST. AREA LOCATION DEFINITE? + AOJA C,CONND6 ;NO, USE GLOBAL. + MOVEM C,GLSP1 + HRRZ C,1(B) ;ADD ACTUAL ADDR OF CONST. AREA. + ADDI A,(C) ;GET C(CONTBA) + ADDR OF CONSTANT. + LDB B,[420100,,2(B)] + JRST CONND7 + +CONND6: MOVEM C,GLSP1 + MOVEM B,(C) + MOVEI B,0 +CONND7: SUB A,CONTBA + JRST LSSTH3 ;POP OUT INTO OUTER WORD. + +.SEE SAVAS1 ;WHICH IS WHAT PUSHES WHAT CONNDP POPS. +CONNDP: SUB P,[3,,3] ;FLUSH SAVED SYLOC AND SYSYM AND CLNN,,CPGN. +CONFL2: HRL T,ASMOUT ;REMEMBER IF POPPING A LITERAL OR NOT. + INSIRP POP P,[CONSTP,ASSEMP,GLSPAS,ASMI,ASMDSP,ASMOUT,BYTM] + SKIPN BYTM ;IF IN BYTE MODE, POP DETAILS. + JRST CONND5 + MOVSI A,1-BYTMCL(P) + HRRI A,BYTMC + BLT A,BYTMC+BYTMCL-1 + MOVSI A,1-BYTMCL-LBYBYT(P) + HRRI A,BYBYT + BLT A,BYBYT+LBYBYT-1 + SUB P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] +CONND5: HLRZ A,T + CAIE A,3 + JRST (T) + POP P,A + ADDM A,SCNDEP ;DON'T FORGET ABOUT ANY CONDITIONALS. + SOS CONDEP ;HAVE POPPED ONE CONSTANT. + JRST (T) + +CONFLS: MOVE P,ASSEMP ;FLUSH ALL CONSTANTS. + CAMN P,[-LPDL,,PDL] ;IF IN ANY, + JRST (LINK) + MOVE P,CONSTP ;POINT AFTER ITS PDL ENTRY, + JSP T,CONNDP ;POP IT, + JRST CONFLS ;TRY AGAIN. + +CONBAD: SKIPN ASMOUT ;IF IN GROUPING, ERROR. + POPJ P, + ETSM [ASCIZ/Within <>, () or []/] + JRST ASSEM1 + +;COME HERE FOR PDL-OV ON P. +;IF IN A CONSTANT, FLUSH ALL OF THEM, SAYING WHERE EACH STARTED. +;THEN TYPE A PDL ERROR MSG AND RETURN TO ASSEM1. +;OTHERWISE FATAL ERROR. +CONFLP: MOVEI LINK,ASSEM1 + MOVEI CH1,ERRPDL + SKIPE CONDEP + JRST CONFL3 ;IN A CONSTANT. + MOVEI P,PDL ;RE-INIT PDL SO NO MORE PDL-OV. + ETF ERRPDL +ERRPDL: ASCIZ /PDL overflow/ + +;JSP LINK,CONFLM TO FLUSH CONSTANTS, SAYING WHERE THEYY STARTED, +;AND GIVE ERROR MSG. +CONFLM: MOVE CH1,ASMOUT + SKIPA CH1,ASMOT3(CH1) +CONFLZ: SETZ CH1, ;LIKE CONFLM BUT NO ERR MSG AT END. +CONFL3: SETO C, +CONFL1: MOVE P,CONSTP ;GET STACK ABOVE INNERMOST LITERAL. + REST SYLOC + REST SYSYM + REST D ;GET INFO ON WHERE STARTED + AOSN C ;THE 1ST TIME ONLY, SAY WHAT'S GOING ON. + TYPR [ASCIZ/Within groupings: /] + SKIPE C + TYPR [ASCIZ/, /] + MOVE A,ASMOUT ;SAY WHAT KIND OF GROUPING IS BEING CLOSED + MOVE A,ASMOT5(A) + CALL TYOERR ;BY SAYING WHAT CHAR OPENED IT. + JSP T,CONFL2 ;POP REST OF WDS SAVED AT LBRAK. + TYPR [ASCIZ/ at /] + MOVEI A,1(D) ;PAGE # GROUPING STARTED ON. + CALL DPNT ;PRINT IN DECIMAL. + MOVEI A,"- + CALL TYOERR + HLRZ A,D ;LINE NUMBER IT STARTED ON. + ADDI A,1 + CALL D3PNT2 ;PRINT W/ AT LEAST 3 CHARS, NO ZERO SUPPR. + MOVE A,ASSEMP + CAME A,[-LPDL,,PDL] ;MORE GROUPINGS TO POP => DO. + JRST CONFL1 + CALL CRRERR + MOVE P,ASSEMP + JUMPE CH1,(LINK) ;IF CALLED CONFLZ, NO ERR MSG (CALLER WILL GIVE ONE) + ETR (CH1) ;[ NO] OR PDL. + CALL CRRERR + JRST (LINK) + +;CONSTA + +CNSTNT: NOVAL + SKIPE ASMOUT ;IF ANY GROUPNGS, + JSP LINK,CONFLM ;FLUSH THEM, GIVE ERROR. + PUSHJ P,CNSTN0 + JRST ASSEM1 + +CNSTN0: SOSGE CONCNT ;ENTRY FROM AEND + ETF [ASCIZ /Too many constants areas/] + MOVE B,CLOC + ADD B,OFLOC + HRRZ T,PBCON + TRNN FF,FRPSS2 + JRST CNST1 ;PASS 1 + + MOVSI A,CGBAL + TDZ A,2(T) + TRNE FF,FRGLOL + TLC A,CGBAL + SKIPN A + ETR [ASCIZ /Constants globality phase error/] + HRRZ B,1(T) + SUB B,OFLOC + HRRZS B + CAME B,CLOC + ETR [ASCIZ /Constants location phase error/] + MOVE B,2(T) + ROT B,2 + XOR B,CRLOC + XOR B,OFRLOC + TRNE B,1 + ETR [ASCIZ /Constants relocation phase error/] + ;DROPS THROUGH + +;DROPS THROUGH +CNST2: MOVEI D,(T) ;STE IDX IN D FOR OUTSM0 + MOVE SYM,(T) ;GET NAME OF AREA + TLC SYM,400000#LCUDF ;CLEAR LCUDF, SET HALF-KILL + TRNE FF,FRGLOL + PUSHJ P,PDEFPT ;DEFINE SYM FOR BEGINNING OF CONSTANTS AREA + MOVE A,CONTBA +CNSTH: CAML A,PLIM + JRST CNSTA ;THRU + MOVE TT,(A) + MOVEM TT,WRD + PUSHJ P,CPTMK + LDB F,C ;GET THIS CONSTANT'S RELOCATION BITS + TRZE F,2 + TLO F,1 ;RELOCATE LEFT HALF + MOVEM F,WRDRLC ;STORE RELOCATION + MOVEI D,GLOTB ;AND NOW TO SET UP GLOTB! + MOVEM D,GLSP2 + MOVE C,CONGLA +CNSTC: CAML C,CONGOL + JRST CNSTB ;END OF CONSTANT-GLOBAL TABLE + CAMN A,1(C) ;POINTS TO THIS CONSTANT? + PUSH D,(C) ;YES, STORE ENTRY IN GLOTB + AOS C + AOJA C,CNSTC + +CNSTB: HRRZM D,GLSP1 ;MARK END OF ACTIVE PART OF GLOTB + PUSH P,A + PUSHJ P,PWRD ;OUTPUT THIS CONSTANT + AOS CLOC ;INCREMENT CLOC TO NEXT + HRRZS CLOC ;MAKE SURE IT STAYS IN A HALF-WORD (IMPORTANT SINCE MAY BE LESS THAN RELOCATION) + POP P,A ;RESTORE POINTER INTO CONSTANTS TABLE + AOJA A,CNSTH + +CNST3: HLRZ A,1(T) ;GET POINTER TO TOP OF AREA STORED DURING PASS 1 + CAMN A,CLOC ;SAME AS CURRENT? + JRST CNSTE ;YES, NO HAIR + CAMGE A,CLOC ;DIFFERENT; LOWER? + ETR [ASCIZ /More constants on pass 2 than 1/] + ;INSUFFICIENT CONSTANT SPACE; CONSTANTS AREA TRYING TO BE BIGGER + ;IN PASS 2 THAN PASS 1; THE EXTRA CONSTANTS WERE BACKED OVER + MOVEM A,CLOC ;EITHER WAY, SET CLOC TO TOP OF AREA SO WON'T HAVE MDT TROUBLE + PUSHJ P,EBLK ;END CURRENT BLOCK + CALL SLOCF ;IF RELOCATABLE, MAKE SURE NEW VALUE OF $. GETS PUNCHED + JRST CNSTE + +;CALL SLOCF WHENEVER "." IS CHANGED WITHOUT THE OUTPUTTING OF A STORAGE WORD. +SLOCF: MOVE A,CLOC ;STORE NEW "." IN HEADER FOR NEXT BLOCK OF OUTPUT. + SKIPGE TM,CONTRL + TRNN TM,DECREL+FASL ;BUT NOT IN DEC OR FASL OUTPUT FORMATS. + HRRM A,BKBUF + IORI FF,FRLOC ;MAKE SURE NULL BLOCK IS OUTPUT IF NEC. TO TELL LOADER "." HAS CHANGED. + RET + +;CONSTA DURING PASS 1 + +CNST1: HRRM B,1(T) ;STORE LOCATION OF AREA + MOVEI D,0 + MOVE A,CRLOC + ADD A,OFRLOC + TRNE A,1 + TLO D,CTRL ;RELOCATED + TRNE FF,FRGLOL + TLO D,CGBAL ;GLOBAL + IORM D,2(T) ;STORE FLAGS DESCRIBING AREA + JUMPL FF,CNST2 ;JUMP ON PUNCHING PASS, PUNCH OUT AREA NOW + MOVE T,PLIM + SUB T,CONTBA + ADDM T,CLOC ;PASS 1, JUST UPDATE CLOC + HRRZS CLOC + +CNSTA: HRRZ T,PBCON + TRNE FF,FRGLOL + JRST CNSTD ;LOCATION GLOBAL + TRNN FF,FRNPSS + SKIPGE 2(T) + JRST CNSTDA ;2 PASS ASSEMBLY OR AREA DEFINED + TRO I,IRCONT ;1PASS AND NOT DEFINED + SETZM PARBIT + PUSHJ P,P70 ;DEFINE SYM + MOVE A,(T) + TLC A,400000#LCUDF + SKIPE CRLOC + TLO A,100000 ;RELOCATE + PUSHJ P,$OUTPT + HRRZ A,1(T) + PUSHJ P,$OUTPT ;OUTPUT VALUE, FIRST LOCATION IN AREA + TRZ I,IRCONT +CNSTDA: MOVSI A,CTDEF + IORM A,2(T) ;CALL IT DEFINED +CNSTD: TRNE FF,FRPSS2 + JRST CNST3 ;PASS 2 + MOVE A,CLOC + HRLM A,1(T) ;MARK END OF AREA + +CNSTE: MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + MOVEI T,3 + ADDB T,PBCON + CAML T,PBCONL + MOVEM T,PBCONL + AOS A,CSQZ + MOVEM A,(T) + POPJ P, + +;DEFINING SYM USED IN CONSTANT, DELETE REFERENCES FROM CONSTANT-GLOBAL TABLE + +CONBUG: MOVE A,CONGLA ;B VAL C FLAGS ST(D) SADR + PUSH P,T + PUSH P,C ;SAVE FLAGS +CONBG2: MOVE C,(P) ;GET FLAGS + CAML A,CONGOL ;DONE WITH SCAN? + JRST CONBG1 ;YES + HRRZ F,(A) ;NO, GET CONSTANT-GLOBAL TABLE ENTRY + CAIE F,ST(D) ;POINT TO THIS SYM? + AOJA A,CONBG6 + PUSH P,B ;YES, SAVE VALUE, ABOUT TO WORK WITH B + MOVE T,(A) ;GET ENTIRE CONSTANT-GLOBAL TABLE ENTRY + LDB CH2,[221200,,T] ;GET MULTIPLICATION FIELD + SKIPE CH2 + IMUL B,CH2 ;NON-ZERO => MULTIPLY VALUE OF SYM + TLNE T,MINF + MOVNS B ;NEGATE VALUE + TLNE T,HFWDF + HRRZS B ;TRUNCATE TO HALFWORD + TLNE T,ACF + ANDI B,17 ;AC, MASK TO FOUR BITS + TLNE T,SWAPF + MOVSS B ;SWAP VALUE + TLNE T,ACF + LSH B,5 ;AC, SHIFT FIVE + ADD B,@1(A) ;ADD ABS PART OF VALUE + TLNN T,SWAPF + HRRM B,@1(A) ;NOT SWAPPED, STORE LH + TLNE T,SWAPF + HLLM B,@1(A) ;SWAPPED, STORE LH + TLNN T,HFWDF + MOVEM B,@1(A) ;FULL WORD, STORE VALUE + LDB CH1,[420200+P,,-1] ;GET HIGH BITS OF 3RDWRD, RELOCATION BITS + TLNE T,HFWDF ;NOW TO MAP RELOCATION BITS + TRZ CH1,2 + TLNE T,SWAPF + LSH CH1,1 + TRZE CH1,4 + TRO CH1,1 + PUSH P,A + HRRZ A,1(A) ;GET POINTER INTO CONSTANTS TABLE + PUSHJ P,CPTMK + LDB B,C ;GET RELOCATION BITS + TLNE T,MINF + JRST CONBG8 ;NEGATE + TRNE B,(CH1) + ETA ERRCRI + ;ATTEMPTED MULTIPLE RELOCATION IN CONSTANT + ; ^ ABOVE SHOULD BE REPLACED WITH A $RSET LIKE ROUTINE + ;THAT ALSO SEARCHES CONSTANT-GLOBAL TABLE FOR $R. ALREADY THERE + IOR B,CH1 ;LOOKS OK, IOR IN BITS FOR GLOBAL +CONB8A: DPB B,C ;STORE BACK NEW RELOCATION BITS FOR CONSTANT + POP P,A + CLEARM (A) ;CLEAR OUT CONSTANT-GLOBAL TABLE ENTRY + CLEARM 1(A) + POP P,B + AOS A +CONBG6: AOJA A,CONBG2 ;BACK FOR NEXT CONSTANT, DON'T KNOW HOW MANY THIS SYM USED IN + +CONBG1: MOVE A,CONGLA + PUSH P,B + MOVE B,CONGLA +CONBG7: CAML A,CONGOL + JRST CONBG3 + SKIPN C,(A) +CONBG5: AOJA A,CONBG4 + MOVEM C,(B) + MOVE C,1(A) + MOVEM C,1(B) + AOS B + AOJA B,CONBG5 + +CONBG4: AOJA A,CONBG7 +CONBG3: MOVEM B,CONGOL + POP P,B + POP P,C + POP P,T + POPJ P, +CONBG8: XORI B,3 + TRNE B,(CH1) + ETA ERRCRI + ANDCB B,CH1 + JRST CONB8A + +ERRCRI: ASCIZ /Multiple relocation in constant/ + +;VARIAB + +AVARIAB: NOVAL + SKIPE ASMOUT ;FLUSH ANY GROUPINGS IN PROGRESS. + JSP LINK,CONFLM + PUSHJ P,AVARI0 + JRST ASSEM1 + +AVARI0: SOSG VARCNR ;ENTRY FROM AEND + ETF [ASCIZ /Too many variable areas/] + MOVE D,SYMAOB ;SET UP AOBJN POINTER TO ST + MOVE T,CLOC + MOVEM T,VCLOC ;STORE AS LOCATION OF VARIABLE AREA + ADD T,OFLOC + MOVE C,CRLOC + ADD C,OFRLOC + TRNE FF,FRPSS2 + JRST AVAR1 ;PASS 2 + HRL T,VARCNT ;SIZE OF AREA + TRNE C,1 + TLO T,400000 ;RELOCATED + MOVEM T,@VARPNT + JRST AVAR2E + +AVAR1: HRRZ A,@VARPNT ;VARIAB DURING PASS 2 + CAIE A,(T) + ETR [ASCIZ /Variables location phase error/] + HLRZ A,@VARPNT + TRZE A,400000 + XORI C,1 + TRNE C,1 + ETR [ASCIZ /Variables relocation phase error/] + SKIPE VARCNT + ETR [ASCIZ /Variables area size phase error/] + +AVAR2E: HLRZ T,@VARPNT + TRNN T,377777 + JRST AVAR2C ;IF THIS VAR AREA IS EMPTY, DON'T SCAN SYMTAB. +AVAR2: HLRZ LINK,ST(D) ;SCAN, CHECKING EACH SYM FOR WHETHER IT'S A VARIABLE + CAIL LINK,DEFLVR + JRST AVAR2B + ADD D,WPSTE1 + AOBJN D,AVAR2 + JRST AVAR2C ;ALL SCANNED. + +AVAR2B: 3GET C,D ;FOUND A VARIABLE; DECIDE WHAT TO DO WITH IT. + MOVE B,ST+1(D) + MOVE SYM,ST(D) + TLZ SYM,740000 + LDB LINK,[400400,,ST(D)] + CAIE LINK,UDEFLV_-14. + CAIN LINK,UDEFGV_-14. + JRST AVAR3 ;UNDEFINED VARIABLE + CAIE LINK,DEFGVR_-14. + CAIN LINK,DEFLVR_-14. + JRST AVAR4 ;DEFINED VARIABLE +AVAR2A: ADD D,WPSTE1 + AOBJN D,AVAR2 ;CHECK ENTIRE SYMTAB +AVAR2C: HLRZ A,@VARPNT ;NOW GET SIZE OF AREA + TRZ A,400000 ;CLEAR OUT RELOCATION CHECK BIT +IFN FASLP,[ + MOVE D,CONTRL + TRNE D,FASL ;IN FASL ASSEMBLY, CAN'T JUST SET LOC CTR; MUST OUTPUT 0'S. + CALL ABLKF +] + ADD A,VCLOC ;ADD LOCATION OF BEGINNING OF VARIABLE AREA + MOVEM A,CLOC ;STORE AS NEW CURRENT LOCATION + PUSHJ P,EBLK + CALL SLOCF + CLEARM VARCNT ;INITIALIZE COUNT OF VARIABLES IN NEXT AREA + AOS VARPNT ;INCREMENT POINTER TO POINT TO NEXT AREA + POPJ P, + +;UNDEFINED VARIABLE FOUND IN SYMTAB SCAN + +AVAR3: CAIN LINK,UDEFGV_-14. ;GLOBAL? + TLO SYM,40000 ;GLOBAL + PUSHJ P,LKPNRO + MOVSI T,DEFLVR + CAIN LINK,UDEFGV_-14. + MOVSI T,DEFGVR + TRNE FF,FRGLOL + JRST AVAR3A ;LOCATION GLOBAL + MOVEI B,-1(B) + ADD B,VCLOC + ADD B,OFLOC + MOVE TT,CRLOC + ADD TT,OFRLOC + SKIPE TT + TLO C,3RLR + CAIE LINK,UDEFGV_-14. + TLZN C,3VCNT + SKIPA + PUSHJ P,CONBUG +AVAR4B: PUSHJ P,VSM2 + JUMPGE FF,AVAR2A ;IF PUNCHING PASS, OUTPUT DEFINITION. + PUSHJ P,OUTDE2 + JRST AVAR2A + +AVAR4: TLNE C,3VAS2 ;DEFINED VARIABLE FOUND DURING SYMTAB SCAN + TLOE C,3VP + JRST AVAR2A + MOVSI T,(LINK) ;CAUSE AVAR4B TO REDEFINE AS SAME TYPE. + LSH T,14. + TRNN FF,FRGLOL + JRST AVAR4A +AVAR3A: PUSHJ P,VSM2LV + JUMPGE FF,AVAR2A + PUSHJ P,PDEFPT + MOVEI A,0 + PUSHJ P,PBITS + PUSHJ P,$OUTPT + AOS CLOC + JRST AVAR2A + +AVAR4A: CAIN LINK,DEFGVR_-14. ;DEF VAR, 3VAS2, POINT NOT GLOBAL. + JRST AVAR4B ;VAR GLOBAL, MUST PUNCH DEF SINCE DIDN'T ON PASS1. + 3PUT C,D ;LOCAL, JUST SET 3VP SO DON'T SEE IT NEXT VARIAB. + JRST AVAR2A ;NO NEED TO PUNCH DEF SINCE WAS DEF ON PASS1. + +;;MAIN ;"MAIN" MIDAS ROUTINES: INIT, PS1, PLOD, PS2, PSYMS + ;ALL CALLED WITH JSP A,; ALL GLOBAL + ;RETURN INSTRUCTION FROM JSP IN LOCATION RETURN +PS1: HRRM A,RETURN ;PASS 1, (PASS 1 INITIALIZATION ALREADY DONE), SAVE RETURN + PUSH P,[ASSEM1-1] ;SIMBLK WILL POPJ1. +IFN A1PSW,[SKIPL PRGC + JRST A1PAS1 ;THIS NOT FIRST PROGRAM THIS ASSEMBLY, SET MODE TO 1PASS +] + TRO FF,FRNPSS +IFN ITSSW,JRST SIMBLK ;SELECT SBLK AND ASSEMBLE +IFN DECSW\TNXSW,JRST A.DECRE ;SELECT .DECREL AND ASSEMBLE. + +PS2: HRRM A,RETURN ;PASS 2 (MAIN ROUTINE, PASS 2 INITIALIZATION NOT ALREADY DONE), SAVE RETURN + JUMPL FF,PA2A ;JUMP IF PASS 1 ENDED IN 1PASS MODE + TDO FF,[FLPPSS,,FRPSS2] ;SET PUNCHING PASS AND PASS 2 FLAGS + PUSHJ P,P2INI ;INITIALIZE + JRST ASSEM1 ;START ASSEMBLING + +PA2A: MOVE A,SYMAOB ;PASS 2 OF 1PASS ASSEMBLY, CHECK FOR UNDEFINED LOCALS +PA2C: MOVE SYM,ST(A) ;GET SQUOZE THIS SYMTAB ENTRY + LDB B,[400400,,SYM] ;GET FLAGS + CAIE B,LCUDF_-14. ;LOCAL UNDEFINED? + JRST PA2B ;NOT LOCAL UNDEFINED, DON'T COMPLAIN + 3GET C,A ;LOCAL UNDEFINED, GET 3RDWRD ST ENTRY + TLZ SYM,740000 ;CLEAR OUT FLAGS IN SYM IN ANTICIPATION OF TYPING OUT COMPLAINT + TLNN C,3LLV ;PROBLEM HANDED TO LINKING LOADER? + ETSM [ASCIZ /Undefined/] ;NO +PA2B: ADD A,WPSTE1 ;NOW GO FOR NEXT ST ENTRY + AOBJN A,PA2C + JRST RETURN + +$INIT: HRRM A,RETURN ;INITIALIZATION (BEFORE PASS 1 ONLY) ROUTINE, SAVE RETURN POINT +IFN CREFSW,PUSHJ P,CRFOFF ;DON'T CREF ON 1ST PASS. +IFN LISTSW,CALL LSTOFF ;DON'T LIST ON 1ST PASS. + SKIPGE ISYMF + JRST INIT1 ;SPREAD SYMS (RETURNS TO SP4) + MOVE A,SYMAOB ;ALREADY SPREAD, JUST FLUSH ALL BUT INITIAL SYMS +INIT4: SKIPN B,ST(A) + JRST INIT2 + 3GET C,A + TRNE C,-1 ;INITIAL SYM? + CLEARM ST(A) ;NO +INIT2: ADD A,WPSTE1 + AOBJN A,INIT4 + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1] + BLT A,EBKCOD ;CLEAR OUT BLANK CODE + +SP4: PUSH P,CRETN +P1INI: CLEARB I, LDCCC + INSIRP SETZM,BKBUF ISYMF A.PASS +IFN FASLP,[ + INSIRP SETZM,FASATP FASPCH + CLEARM FASIDX +] + MOVEMM DECTWO,[[MOVE]] + TDZ FF,[FFINIT] ;INITIALIZE MOST FF FLAGS + MOVEIM A.PPASS,2 ;DEFAULT IS 2-PASS. + PUSHJ P,MACINI ;INITIALIZE MACRO STATUS + MOVEI A,PCNTB + MOVEM A,PBCONL + MOVS A,[BKTAB,,P1INI1] + BLT A,BKTAB+4 + MOVEIM BKTABP,BKWPB*2 + +;DROPS IN. +P2INI: INSIRP SETZM,[CPGN,CLNN,GENSM,OFLOC,OFRLOC,CRLOC,BKPDL +SYLOC,SYSYM,BYTW,BYTRLC,STGSW,DECBRK,DEFNPS,BYTM,BYTM1,HKALL,QMTCH] + AOS B,A.PASS +IFN ITSSW,[ + CALL SETWH2 ;SET UP .WHO2, PREPARE .WHO3 IN A WITH PAGENUM=1. + .SUSET [.SWHO3,,A] ;'P1 ',,PAGENUM OR 'P2 ',,PAGENUM + .SUSET [.SWHO1,,[.BYTE 8 ? 166 ? 0 ? 165 ? 0]] +] + TDZ FF,[FLUNRD,,FRGLOL] +IRP X,,[BKWPB,BKCUR,,BKPDL+1,1,BKLVL,IRDEF,ASMI +NCONS,CONCNT,VARTAB,VARPNT,NVARS,VARCNR,1,VECSIZ] +IFE 1&.IRPCN,IFSN [X], MOVEI A,X +IFN 1&.IRPCN, MOVEM A,X +TERMIN + MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + CLEARM VARCNT + CLEARM PBITS2 + MOVE A,[440300,,PBITS1] + MOVEM A,BITP + MOVEI A,PBITS4 + HRRZM A,PBITS4 + CLEARB I,PBITS1 + MOVEI A,PCNTB + MOVEM A,PBCON + MOVE A,[(LCUDF)++1] ;< AND > FOR COMPATIBILITY WITH OLD + MOVEM A,PCNTB + MOVEM A,CSQZ + MOVEI A,8 + MOVEM A,ARADIX + +IFN ITSSW,[ + MOVEI A,100 + MOVEM A,CLOC +] +.ELSE [ + SETZ A, ; SET LOC COUNTERS APPROPRIATELY + SKIPGE B,CONTRL + TRNE B,DECREL+FASL + JRST [SETZM CLOC ; ASSUME RELOCATABLE + AOS CRLOC ; CRLOC GETS 1 + JRST P2INI5] + TRNE B,DECSAV ; ASSUME ABSOLUTE + MOVEI A,140 + TRNE B,SBLKS + MOVEI A,100 ; IF SBLK FORMAT ASSUME FOR ITS. + MOVEM A,CLOC +P2INI5: +] + SETZM GLOCTP + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,CONTRL ;IN DEC FORMAT, OUTPUT PROGRAM NAME. + TRNE A,DECREL + CALL DECPGN ;CLOBBERS A +IFN FASLP,[ + SETOM FASBLC ;LOSING BLOCK COUNT + MOVE A,CONTRL ;IN FASL FORMAT, OUTPUT FASL HEADER + TRNE A,FASL + CALL FASOIN ;INITIALIZE FASL OUTPUT +] + SETZM DECBRH + TRO FF,FRSYMS+FRFIRWD + MOVE A,[IFORTB,,FORTAB] ;INITIALIZE FORMAT TABLE ON EACH PASS + BLT A,FRTBE + MOVEIM GLSPAS,GLOTB ;INIT. ASSEM1 PDL LEVELS TO BOTTOM. + MOVEMM ASSEMP,[[-LPDL,,PDL]] + MOVEIM ASMDSP,ASSEM3 + SETZM ASMOUT + SETZM CONSTP + SETZM SCNDEP ;NOT IN CONDIT. OR CONSTANT. + SETZM CONDEP + HRRZM P,CONSML ;START OUT IN MULTI-LINE MODE. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + MOVEM A,PNTBP + CLEARM LISTPF + SETOM LISTBC + SKIPG LISTP1 ;IF LIST ON PASS 1 + JUMPGE FF,CRETN ;OR PUNCHING PASS, + SKIPE LISTP ;IF WANT LISTING, + CALL LSTON ;TURN ON OUTPUT OF LISTING. +] +IFN CREFSW,[ + JUMPGE FF,CRETN + SKIPE CREFP ;IF C SWITCH WAS SEEN, + PUSHJ P,CRFON ;TURN ON CREFFING, +] +CRETN: POPJ P,RETURN + +P1INI1: SQUOZE 0,.INIT ? 0 ? 3 + SQUOZE 0,.MAIN ? 1,, + +PLOD: HRRM A,RETURN ;MAIN ROUTINE TO PUNCH LOADER, CALLED BEFORE PASS 2 (PS2"), SAVE RETURN POINT + PUSHJ P,PLOD1 ;PUNCH LOADER + JRST RETURN ;RETURN + + ;PUNCH OUT THE LOADER + +PLOD1: PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE + MOVE B,CONTRL + TRNE B,ARIM10 + JRST PLOD2 ;RIM10 => PUNCH OUT SBLK LOADER FOR PDP10 READIN-MODE READIN + TRNN B,SBLKS + POPJ P, ;NOT SBLK => DON'T PUNCH LOADER +PLOD1A: MOVSI B,SLOAD-SLOADP ;PUNCH SBLK LOADER IN RIM FORMAT + MOVSI C,(DATAI PTR,) +PLOAD1: MOVE A,C + PUSHJ P,PPBA + CAMN C,[DATAI PTR,13] + HRRI C,27 + MOVE A,SLOAD(B) + PUSHJ P,PPBA + AOS C + AOBJN B,PLOAD1 + MOVE A,[JRST 1] + PUSHJ P, PPBA + JRST FEED1 + +PLOD2: MOVSI C,LDR10-ELDR10 ;PUNCH SBLK LOADER FOR PDP10 READIN +PLOD3: MOVE A,LDR10(C) + PUSHJ P,PPBA + AOBJN C,PLOD3 + JRST FEED1 + + ;SBLK LOADER NORMALLY PUNCHED OUT IN RIM FORMAT + +SLOAD: CONO PTR,60 ;0 RESTART POINT (NEW BLOCK) + JSP 14,30 ;1 START POINT, LOOP POINT FOR NEW BLOCK; WAIT FOR DATA WORD READY + DATAI PTR,16 ;GET HEADER + MOVE 15,16 ;INITIALIZE CHECKSUM + JUMPGE 16,16 ;HEADER .GE. 0 => STARTING INSTRUCTION + JSP 14,30 ;5 LOOP POINT FOR NEXT DATA WORD: WAIT FOR READY + DATAI PTR,(16) ;READ IN DATA WORD + ROT 15,1 ;NOW UPDATE CHECKSUM + ADD 15,(16) + AOBJN 16,5 ;LOOP FOR ALL DATA WORDS THIS BLOCK + MOVEI 14,33 ;30 TO RETURN TO 33 + JRST 30 ;WAIT FOR READY THEN GO TO 33 + ;14 JSP AC FOR ROUTINE AT 30 + ;15 CHECKSUM + ;16 AOBJN POINTER (UPDATED HEADER) + CONSO PTR,10 ;30 ROUTINE TO WAIT FOR DATA WORD READY FOR DATAI + JRST 30 + JRST (14) + DATAI PTR,16 ;33 GET CHECKSUM + CAMN 15,16 ;COMPARE WITH CALCULATED + JUMPA 1 ;OK, GO GET NEXT BLOCK (DON'T CHANGE TO JRST OR REAL LOADERS WILL GET CONFUSED) + JRST 4, ;CHECKSUM ERROR +SLOADP==. + +;PDP10 SBLK LOADER +;FOLLOWING CODING ACTUAL WORDS TO BE OUTPUT + ;BY ASSEMBLER, COMPILER, OR WHATEVER +;SHOULD BE EXECUTED BY PDP10 HARDWARE READIN FEATURE +;USES ONLY THE AC'S (BUT ALL OF THEM) + +LDR10: + -17,,0 ;BLKI POINTER FOR READ SWITCH + +LDRC=0 ;CHECKSUM (OK, SO YOU'RE NOT ALLOWED TO LOAD + ;INTO IT DURING HARDWARE READIN, BUT WHO SAYS + ;YOUR PROGRAM CAN'T USE IT?) +OFFSET -.+1 ;BEGIN LOADING INTO 1 AS PER HEADER +LDRGO==. + CONO PTR,60 ;START UP PTR (RESTART POINT) +LDRRD==. + HRRI LDRB,.+2 ;INITIALIZE INDEX +LDRW==. + CONSO PTR,10 ;WAIT FOR WORD TO BE AVAILABLE + JRST .-1 + ROT LDRC,-LDRRD(LDRB) ;BEFORE READING IN HEADER, ROTATE 2 BITS (THEN IGNORE) + ;BEFORE READING IN EACH DATA WORD, ROTATE 1 BIT (FOR UPDATING CHECKSUM) + ;BEFORE READING IN CHECKSUM, ROTATE NOT AT ALL (DON'T ROTATE CALCULATED CHECKSUM) + DATAI PTR,@LDRT1-LDRRD(LDRB) ;READ WORD INTO RIGHT PLACE + ;HEADER => READ INTO C + ;STORAGE WORD => READ INDEXED BY AOBJN POINTER IN A + ;CHECKSUM => READ INTO A FOR COMPARISON WITH C(C) + XCT LDRT1-LDRRD(LDRB) ;EXECUTE RELEVANT T1 ENTRY (MAYBE SKIPS) + XCT LDRT2-LDRRD(LDRB) ;EXECUTE RELEVANT T2 ENTRY (MAYBE JUMPS) +LDRB==. + SOJA ., ;-RD(B) IS 2, 1, AND 0 FOR SUCCESSIVE ENCOUNTERS OF THIS INSTRUCTION + ;USED AS INDEX INTO TABLES, ETC. + + ;TABLE 1 + ;INDIRECTED THROUGH FOR DATAI + ;THEN EXECUTED TO SEE WHAT TO DO WITH READ IN WORD + ;ENTRIES EXECUTED IN REVERSE ORDER + +LDRT1==. + CAME LDRC,LDRA ;COMPARE CHECKSUM WITH CALCULATED, SKIP TO B IF THEY AGREE + ADD LDRC,(LDRA) ;UPDATE CHECKSUM + SKIPL LDRA,LDRC ;INITIALIZE HEADER AND SKIP UNLESS JUMP BLOCK + + ;TABLE 2 + ;EXECUTED IF CORRESPONDING ENTRY IN TABLE 1 DIDN'T SKIP WHEN EXECUTED + +LDRT2==. + JRST 4,LDRGO ;CHECKSUM ERROR + AOBJN LDRA,LDRW ;UPDATE AOBJN POINTER AND GO BACK FOR NEXT STORAGE WORD IF NOT EXHAUSTED +LDRA==. + JRST LDRRD ;WHEN INITIALLY LOADED IS JUMP BLOCK TO THIS LOADER + ;DURING LOADING USED TO HOLD HEADER (AOBJN POINTER), WHICH MAY BE LOADED JUMP BLOCK + +OFFSET 0 +ELDR10==. + +;FLAGS IN SQUOZE OF SYMS TO OUTPUT + +ABSGLO==040000 ;SYM IS GLOBAL (IF RELOCA, SAYS THIS IS BLOCK NAME) +ABSLCL==100000 ;LOCAL +ABSDLI==200000 ;DELETE INPUT (DON'T RECOGNIZE IT IF TYPED IN) +ABSDLO==400000 ;DELETE OUTPUT (DON'T TYPE IT OUT) + +PSYMS: HRRM A,RETURN ;PUNCH OUT SYMBOL TABLE, CALLED AFTER EVERYTHING ELSE, SAVE RETURN POINT + PUSH P,PSYMS ;AT END, POPJ TO RETURN. + TRNE FF,FRSYMS + JRST SYMDMP ;PUNCH SYMS IF NEC. + SKIPL A,CONTRL + JRST SYMDA ;IF RELOCA, PUNCH PROGRAM NAME. + TRNN A,DECREL + POPJ P, + +PSYMSD: MOVSI A,DECEND + PUSHJ P,DECBLK ;START AN END-BLOCK. + MOVE A,DECTWO ;IN 2-SEG PROGRAMS, + CAME A,[MOVE] + JRST [ CAMG A,DECBRH ;OUTPUT HISEG BREAK + MOVE A,DECBRH + MOVEM A,WRD + MOVEIM WRDRLC,1 + CALL PWRD + MOVEMM WRD,DECBRK + CALL PWRD ;FOLLOWED BY LOSEG BREAK + JRST EBLK] + MOVEMM WRD,DECBRK ;OUTPUT THE PROGRAM BREAK. + MOVEIM WRDRLC,1 + PUSHJ P,PWRD + MOVE A,DECBRA ;OUTPUT HIGHEST ABS. ADDR + CAIG A,140 + SETZ A, ;IF IT'S ABOVE THE JOBDAT AREA. + PUSHJ P,DECWRD + JRST EBLK + +SYMDA: MOVEI A,LPRGN ;NOW PUNCH PROGRAM NAME + DPB A,[310700,,BKBUF] + MOVE A,PRGNM + TLO A,40000 + PUSHJ P,$OUTPT + PUSHJ P,EBLK + TLZ FF,$FLOUT + POPJ P, + + ;DUMP OUT THE SYMBOL TABLE + +SYMDMP: TRZ I,IRCONT ;OK TO END BLOCK + CLEARM GLSP1 + CLEARM GLSP2 + CLEARM WRDRLC + MOVE T,CONTRL + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + CLEARM CLOC + CLEARM BKBUF +IFN FASLP,[ + TRNE T,FASL + JRST SYMDM1 +] +IFN ITSSW,[ + TRNE T,SBLKS ; ON ITS, IF OUTPUTTING IN SBLK FMT + CALL SYMDDB ; THEN OUTPUT A DEBUGGING INFO BLOCK. +] + TRNE T,DECREL + JRST SYMDMD + JUMPL T,SSYMD ;JUMP IF NOT STINK + + MOVEI B,LDDSYM ;LOCAL SYMS BLOCK TYPE + DPB B,[310700,,BKBUF] ;SET BLOCK TYPE + MOVEM B,CDATBC + MOVE B,SYMAOB ;CAUSE SSYMD3 TO LOOK AT ENTIRE SYM TAB. + JRST SSYMDR + +SYMDMD: MOVSI A,DECSYM ;IN DEC FMT, START SYMBOLS BLOCK. + PUSHJ P,DECBLK +SYMDM1: MOVE B,SYMAOB + JRST SSYMDR + +IFN ITSSW,[ + + ; OUTPUT DEBUGGING INFO BLOCK (ITS SBLK ONLY) + +SYMDDB: MOVE A,[-7,,3] ;OUTPUT A "DEBUGGING INFORMATION" BLOCK + MOVE B,A ;UPDATING THE CHECKSUM IN B. + PUSHJ P,PPB + MOVE A,[-6,,1] ;THE BLOCK CONTAINS ONE SUBBLOCK - A "MIDAS INFO" SUBBLOCK. + PUSHJ P,PPBCK + .SUSET [.RXUNAME,,A] ;CONTAINING NAME OF USER, DATE IN DISK FORMAT, + PUSHJ P,PPBCK + SYSCAL RQDATE,[%CLOUT,,A] + .LOSE %LSSYS + PUSHJ P,PPBCK ;AND THE SOURCE FILE NAMES (DEV, FN1, FN2, SNAME). +REPEAT 4,[ + MOVE A,INFB+$F6DEV+.RPCNT + PUSHJ P,PPBCK +] + MOVE A,B + PJRST PPB ; PUNCH OUT CHECKSUM & RETURN +] ;IFN ITSSW, + +;AC ALLOCATIONS DURING PHASE 1 (COMPACTING THE SYMBOL TABLE): + ;AA INITIALLY HAS -SMK,,; INPUT INDEX INTO ST + ;A TEMP + ;B SQUOZE + ;D OUTPUT INDEX INTO SYMTAB + ;CH1 VALUE OF SYM + ;CH2 3RDWRD + +SSYMD: MOVEI D,ST-1 + SETZB C,SMSRTF ;SYMS SORTED => INITIAL SYMS CLOBBERED + MOVE AA,SYMAOB +SSYMD1: SKIPE B,ST(AA) ;GET SYM NAME FROM TABLE + TDNN B,[37777,,-1] ;MAKE SURE NOT EXPUNGED + JRST SSYMDL ;NOT (REALLY) THERE, TRY NEXT + AOS SMSRTF + MOVE CH1,ST+1(AA) ;GET VALUE OF SYM + 3GET CH2,AA ;GET 3RDWRD + TRNE CH2,-1 + TLNE CH2,3KILL+3LLV + JRST SSYMDL ;DON'T PUNCH INITIAL OR KILLED SYMS. + MOVEI A,0 ;INITIALIZE FOR SHIFTING IN FLAGS + LSHC A,4 ;SHIFT FLAGS INTO A + XCT SSYMDT(A) ;DO THE APPROPRIATE THING THIS KIND OF SYMTAB ENTRY + JRST SSYMDL +SSYMD2: LSH B,-4 ;SHIFT SQUOZE BACK TO WHERE IT BELONGS + TLO B,ABSLCL ;SET LOCAL BIT + TLNE CH2,3SKILL + TLO B,ABSDLO ;HALF-KILL SYM + CAIL A,DEFGVR_-16 + TLC B,ABSGLO\ABSLCL ;FOR GLOBAL SYM, SET GLOBAL BIT INSTEAD OF LOCAL BIT, + CAIGE A,DEFGVR_-16 ;AND PUT IT IN THE GLOBAL BLOCK IN THE SYMTAB. + SKIPN PRGNM+BKWPB ;IF ONLY ONE BLOCK IN PROGRAM, PUT ALL SYMS IN GLOBAL BLOCK. + HRRI CH2,0 + PUSH D,B ;STORE NAME OF SYM IN OUTPUT SLOT + PUSH D,CH1 ;STORE VALUE + PUSH D,CH2 ;STORE 3RDWRD +SSYMDL: ADD AA,WPSTE1 + AOBJN AA,SSYMD1 ;LOOP FOR ALL SYMS IN TABLE + MOVSI CH2,4^5 ;1ST BIT TO SORT ON IS TOP BIT, + MOVEI A,ST ;SORT FROM BOTTOM OF SYMTAB + MOVEI B,1(D) ;TO WHERE WE FILLED UP TO. + MOVE CH1,[TDNE CH2,1(A)] ;SORT ON 2ND WD, WDS WITH BIT ON COME FIRST. + MOVE C,[TDNN CH2,1(B)] + JSP AA,SSYMD9 + TLC C,(TDNE#TDNN) ;ON BITS AFTER 1ST, ENTRIES WITH BIT OFF COME FIRST. + TLC CH1,(TDNE#TDNN) + MOVEI AA,SSRTX ;NEED ONLY CHANGE C, CH1 THE FIRST TIME. + JRST SSRTX + +SSYMD9: PUSHJ P,SSRTX ;SORT SYMS ARITHMETICALLY BY VALUE. + MOVNI B,(B) + ADDI B,ST ;SIZE OF AREA OF SYMTAB STILL IN USE. + IDIV B,WPSTE + HRLZI B,(B) ;-<# SYMTAB ENTRIES>,, + MOVE T,CONTRL ; GET CONTRL FOR OUTPUT FMT CHECKS + MOVE A,[SQUOZE 0,GLOBAL] + MOVEM A,BKTAB ;CALL THE .INIT BLOCK "GLOBAL" WHICH IS WHAT DDT WANTS AS TOP BLOCK. + MOVE C,BKTABP + IDIVI C,BKWPB ;# BLOCKS (INCL. GLOBAL BLOCK). + CAIN C,2 ;IF ONLY GLOBAL AND MAIN, TELL BKSRT TO IGNORE MAIN. + SETZM PRGNM+1 + CAIN C,2 + MOVEI C,1 ;IF ONLY GLOBAL AND MAIN, FILE WILL HAVE ONLY 1 BLOCK (GLOBAL). + CAILE C,1 ;IF MORE THAN ONE BLOCK IN FILE, + TRNN T,DECSAV ;AND OUTPUT FORMAT IS DECSAV, + CAIA + ADDI C,1 ;THEN ALLOW FOR ONE MORE "BLOCK" (PGM NAME). + ;NOTE THAT DECSAV FMT REPLACES BLOCKNAME WITH PGM-NAME + ;FOR SINGLE-BLOCK CASE, SO COUNT OF 1 WORKS OK. + MOVSI A,(C) ; <# BLOCKS TO OUTPUT>,, + SUBM B,A ;-<# ENTRIES IN SYMTAB IN FILE>,, + LSH A,1 ;-<# WDS IN SYMTAB IN FILE>,, + TRNE T,DECSAV ; IF OUTPUT FORMAT IS DEC SAV, + JRST [ HRR A,DECSYA ; GET LOC TO STORE SYMS AT + MOVE C,A + MOVE A,[-1,,116-1] ; STORE IT AT .JBSYM + CALL PPB + MOVE A,C + CALL PPB + HRRI A,-1(A) ; SET -<# WDS IN SYMTAB>,, + JRST .+1] + MOVEM A,SCKSUM ;SAVE 1ST WD FOR CHECKSUM (DECSAV IGNORES IT) + PUSHJ P,PPB + PUSHJ P,BKCNT ;PUT -<# SYMS IN BLOCK> IN 3RD WD OF EACH BKTAB ENTRY. + +;DROPS THROUGH. + +;DROPS IN IF ABS, JUMPS HERE IF RELOC. +;NOTE THAT IN ABS ASSEMBLY, B WILL CONTAIN THE CHECKSUM AND +;SHOULD NOT BE CLOBBERED. +SSYMDR: PUSH P,B ;-<# SYMS>,,0 ;IT WILL BE -1(P) + PUSHJ P,BKSRT ;SORT BLOCKS INTO BKTAB1 + MOVE A,BKTAB + CAME A,[SQUOZE 0,GLOBAL] ;IF ABS, WE RENAMED .INIT TO GLOBAL, SO LEAVE IT IN BKTAB1 + SOS D ;ELSE FLUSH .INIT FROM THE END OF BKTAB1. + SETOM 1(D) ;PUT A -1 AT END OF BKTAB1. + MOVE B,SCKSUM ;GET CHKSUM AFTER 1ST WD. (PPBCK WILL UPDATE) + PUSH P,[-1] ;(P) WILL BE BKTAB1 IDX OF NEXT BLOCK TO OUTPUT. +SSYMD3: AOS F,(P) ;F HAS BKTAB1 IDX OF BLOCK. + SKIPGE C,BKTAB1(F) ;BKTAB1 ELT HAS BKTAB IDX OR + JRST SSYMDX ; -1 AFTER LAST BLOCK. + SKIPL LINK,CONTRL + JRST SSYMD7 ;DIFFERENT RTN TO OUTPUT BLOCK NAME IF RELOCA. + TRNE LINK,DECREL+FASL+DECSAV + JRST SSYMD6 ; ALL THESE SKIP OVER SBLK-TYPE BLOCKNAME OUTPUT + MOVE A,BKTAB(C) + PUSHJ P,PPBCK ;OUTPUT BLOCK NAME WITH NO FLAG BITS SET. + HLRZ A,BKTAB+1(C) + SKIPE A + ADDI A,1 ;A GETS 0 FOR GLOBAL BLOCK, ELSE DDT LEVEL (= 1 + MIDAS LEVEL). + HRL A,BKTAB+2(C) ;PUT IN -2* + ADD A,[-2,,] +SSYMG2: PUSHJ P,PPBCK ;OUTPUT -SIZE,,LEVEL WORD OF BLOCK NAME ENTRY. + JRST SSYMD6 + +SSYMD7: MOVE A,BKTAB(C) ;OUTPUT BLOCK NAME IN RELOCATABLE. + TLO A,ABSGLO ;TELL STINK IT'S BLOCK NAME. + PUSHJ P,$OUTPT + HLRZ A,BKTAB+1(C) + SUBI A,1 + PUSHJ P,$OUTPT +SSYMD6: SKIPL C,-1(P) ;AOBJN PTR TO SYMS. + JRST SSYMD8 ;IN CASE NO SYMS. +SSYMD4: HRRZ A,ST+2(C) ;OUPUT ONLY THE SYMS IN THE BLOCK + CAME A,BKTAB1(F) ;NOW BEING HANDLED. + JRST SSYMD5 + SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL + JRST SYMD2 ;SPECIAL IF RELOCA. + MOVE A,ST(C) + TRNE LINK,DECSAV + CALL RSQZA ; RIGHT-JUSTIFY THE SQUOZE (SIGH) + PUSHJ P,PPBCK ;1ST, SQUOZE WITH FLAGS. + MOVE A,ST+1(C) + PUSHJ P,PPBCK ;2ND, VALUE. +SSYMD5: ADD C,WPSTE1 + AOBJN C,SSYMD4 ;HANDLE NEXT SYM. +SSYMD8: TRNN LINK,DECSAV + JRST SSYMD3 ;ALL SYMS FOR THIS BLOCK DONE, DO NEXT BLOCK. + + ; DECSAV FMT HAS BLOCK NAMES OUTPUT LAST. + SKIPN PRGNM+BKWPB ;IF ONLY ONE BLOCK IN PGM, + JRST SSYMD3 ; FORGET IT; PGM-NAME SUBSTITUTES FOR BLKNAME. + MOVE C,BKTAB1(F) ; GET IDX FOR BLOCK + MOVE A,BKTAB(C) ; GET BLOCKNAME WITH FLAGS CLEAR + TLO A,140000 ; SET FLAGS TO SAY SYM IS BLOCKNAME + CALL RSQZA ; RIGHT-JUSTIFY SQUOZE FOR DEC (UGH BLETCH) + CALL PPB + HLRZ A,BKTAB+1(C) ; GET LEVEL OF BLOCK (NO WD COUNTS) + CALL PPB + JRST SSYMD3 + + ; RIGHT-JUSTIFY SQUOZE IN A, PRESERVING FLAGS. + ; (WHICH ASQOZR RTN DOESN'T) + ; CLOBBERS B. +RSQZA: PUSH P,A ; SAVE FLAGS + TLZA A,740000 ; ZAP +RSQZA2: DPB A,[004000,,(P)] ; UPDATE + IDIVI A,50 + JUMPE B,RSQZA2 + POP P,A + POPJ P, + +;PUNCH OUT LOCAL SYM (RELOCATABLE ASSEMBLY) +;NORMALLY OUTPUT SQUOZE W/ FLAGS ? VALUE, +;IF 3LLV SET OUTPUT PHONY NAME (= STE ADDR) ? SQUOZE W/ FLAGS, STINK FIXES IT UP. +SYMD2: LDB A,[400400,,ST(C)] + MOVE CH1,ST+1(C) ;SSYMDT MAY CHANGE CH1. + MOVE CH2,ST+2(C) + XCT SSYMDT(A) ;SKIPS IF SHOULD OUTPUT SYM. + JRST SSYMD5 + TLNE CH2,3KILL + JRST SSYMD5 + MOVE B,ST(C) + TLZ B,740000 + JUMPE B,SSYMD5 ;UNUSED ENTRY. + JUMPL LINK,SYMDEC ;J IF DEC OR FASL FMT + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LEFT HALF + TLNE CH2,3RLR + TLO B,100000 ;RELOCATE RIGHT HALF + TLNE CH2,3SKILL + TLO B,400000 ;HALF-KILL + MOVEI A,ST(C) + TLNE CH2,3LLV ;IF STINK HAS VALUE, + PUSHJ P,$OUTPT ;GIVE STINK NAME STINK KNOWS SYMBOL BY. + TLNE CH2,3LLV ;IF GIVING PHONY NAME, INSURE LOCAL FLAG SET + TLO B,ABSLCL ;(STINK WILL DO SO OTHERWISE) + MOVE A,B + PUSHJ P,$OUTPT ;OUTPUT SYM + MOVE A,CH1 + TLNN CH2,3LLV ;DON'T OUTPUT VALUE IF DON'T KNOW IT. + PUSHJ P,$OUTPT ;OUTPUT VALUE + JRST SSYMD5 + +SYMDEC: IFN FASLP,[ + TRNE LINK,FASL + JRST SYMFSL ;FASL ASSMBLY +] + PUSHJ P,ASQOZR ;RIGHT-JUSTIFY THE SQUOZE, + TLNE CH2,3SKILL + TLO B,ABSDLO ;MAYBE HALFKILL, + TLO B,ABSGLO + LDB A,[400400,,ST(C)] + CAIGE A,DEFGVR_-14. + TLC B,ABSGLO+ABSLCL ;LOCAL SYM, CHANGE GLO TO LCL. + MOVEM B,WRD + PUSH P,C + PUSHJ P,DECPW ;FIRST, THE NAME, + POP P,C + LDB TM,[420200,,ST+2(C)] + MOVE A,ST+1(C) ;THEN THE VALUE AND RELOCATION BITS. + PUSHJ P,DECWR1 + JRST SSYMD5 + +IFN FASLP,[ +SYMFSL: TLO B,400000 ;GET VALUE FROM SECOND WD + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LH + TLNE CH2,3RLR + TLO B,100000 + CAIL A,LGBLCB_<-18.+4> + TLO B,40000 ;GLOBAL FLAG + MOVE A,B + MOVEI B,15 ;PUTDDTSYM + PUSHJ P,FASO + MOVE A,CH1 + PUSHJ P,FASO1 + JRST SSYMD5 +] + +;XCT INDEXED ON SQUOZE FLAGS; SHOULDN'T PUNCH SYM IF DOESN'T SKIP. +SSYMDT: JFCL ;COM + JFCL ;PSEUDO OR MACRO + CAIA ;SYM, PUNCH OUT + TLNN CH2,3LLV ;LOCAL UNDEFINED, OUTPUT IF STINK HAS VALUE TO TELL STINK WHERE TO PUT IT. + TLZA CH1,-1 ;DEFINED LOCAL VARIABLE, CLEAR OUT LH(VALUE) + JFCL ;UNDEFINED LOCAL VARIABLE + SKIPL CONTRL ;DEFINED GLOBAL VARIABLE, PUNCH OUT IF ABS. + JFCL ;UNDEFINED GLOBAL VARIABLE + SKIPL CONTRL ;GLOBAL ENTRY, PUNCH OUT IF ABS ASSEM. + JFCL ;GLOBAL EXIT, DON'T PUNCH OUT +IFN .-SSYMDT-NCDBTS,.ERR SSYMDT LOSES. + +SSYMDX: SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL + JRST SSYMG3 + TRNE LINK,DECSAV ; IN DECSAV FORMAT, + JRST [ MOVE A,PRGNM ; PGM NAME IS LAST THING IN SYMTAB + CALL RSQZA + CALL PPB ; WITH FUNNY VALUE OF + SETZ A, ; -<# SYMTAB WDS USED BY PGM>,, + CALL PPB ; BUT LAST PGM IN SYMTAB MUST HAVE LH=0, SO... + JRST SSYMG3] + MOVE A,B ; SBLK OR RIM ASSEMBLY, OUTPUT CHKSUM. + PUSHJ P,PPB +SSYMG3: SUB P,[2,,2] + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK + SKIPL A,CONTRL ;RELOCATABLE => OUTPUT PROG NAME. + JRST SYMDA +IFN FASLP,[ + TRNE A,FASL + POPJ P, +] + TRNE A,DECREL ;DEC FMT => OUTPUT END BLOCK. + JRST PSYMSD + MOVE A,STARTA ;NOW GET STARTING INSTRUCTION + JRST PPB ;PUNCH IT OUT AND RETURN + +;PUT INTO BKTAB1 THE BKTAB IDXS OF ALL THE BLOCKS IN THE ORDER THEIR +;SYMS SHOULD BE PUNCHED (A BLOCK'S SUBBLOCKS PRECEDE IT) +;THE .INIT BLOCK (MAYBE BY NOW RENAMED "GLOBAL") GOES IN LAST. D POINTS AT WHERE IT WAS PUT. +; NOTE THAT FOR DECSAV FORMAT THE ORDERING IS REVERSED; A BLOCK'S SUBBLOCKS +; FOLLOW IT, AND THE .INIT BLOCK GOES IN FIRST. + +BKSRT: MOVEI D,BKTAB1-1 ;D IS FOR PUSHING INTO BKTAB1. + MOVSI A,1 ;START WITH BLOCK 0 (OUTERMOST, .INIT). + MOVE LINK,CONTRL + + ;HANDLE BLOCK IN A: LOOK FOR ITS SUBBLOCKS. +BKSR1: TRNE LINK,DECSAV + JRST [ MOVEI C,(A) ? PUSH D,C ? JRST .+1] + SETZ C, +BKSR2: CAME A,BKTAB+1(C) + JRST BKSR3 ;THIS BLOCK ISN'T A SUBBLOCK. + ADD A,[1,,] ;LH HAS SUBBLOCK'S LEVEL. + HRRI A,(C) ;RH HAS SUBBLOCK. + PUSHJ P,BKSR1 ;HANDLE THE SUBBLOCK + MOVE A,BKTAB+1(C) ; RESTORE A (C IS PRESERVED OVER CALL) +BKSR3: ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKSR2 + MOVEI C,(A) ; RESTORE C INDEX BKSR1 WAS ENTERED WITH + TRNE LINK,DECSAV + POPJ P, + PUSH D,C ;PUT THE BLOCK IN BKTAB1 (AFTER SUBBLOCKS) + POPJ P, + +PPBCK: ROT B,1 ;OUTPUT WD IN A, UPDATING CKSUM IN B. + ADD B,A + JRST PPB + +;THE THIRD WORD OF EACH BLOCK'S ENTRY IN BKTAB GETS THE NUMBER OF +;SYMBOLS IN THAT BLOCK (OF THE SYMBOLS THAT WE WILL PUT IN THE SYMTAB). + +BKCNT: PUSH P,B + MOVEI C,0 +BKCNT0: SETZM BKTAB+2(C) ;ZERO 3RD WD OF EACH BKTAB ENTRY. + ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKCNT0 +BKCNT1: MOVE C,ST+2(B) + SOS BKTAB+2(C) ;ADD -2 FOR EACH SYM IN THE BLOCK. + SOS BKTAB+2(C) + ADD B,WPSTE1 + AOBJN B,BKCNT1 +POPBJ: POP P,B + POPJ P, + +SSRTX: HRLM B,(P) ;DO ONE PASS OF RADIX-EXCHANGE. SAVE END. + CAIL A,@WPSTEB ;ONLY 1 ENTRY, NOTHING TO DO. + JRST SSRTX7 + PUSH P,A ;SAVE START. +SSRTX3: XCT CH1 + JRST SSRTX4 ;MOVE UP TO 1ST WITH BIT ON. + SUB B,WPSTE + XCT C ;MOVE DOWN TO LAST WITH BIT OFF. + JRST SSRTX5 + MOVE D,WPSTE + CAIE D,MAXWPS + JRST .+4 +REPEAT MAXWPS,[ + MOVE D,.RPCNT(A) ;EXCHANGE THEM, + EXCH D,.RPCNT(B) + MOVEM D,.RPCNT(A)] +SSRTX4: ADD A,WPSTE +SSRTX5: CAME A,B ;ALL DONE => DO NEXT BIT. + JRST SSRTX3 ;MORE IN THIS PASS. + ROT CH2,-1 ;NEXT BIT DOWN. + POP P,A ;A -> START, B -> END OF 1ST HALF. + JUMPL CH2,SSRTX6 ;ALL BITS IN WD DONE, STOP. + PUSHJ P,(AA) ;DO NEXT BIT ON 1ST HALF. + HLRZ B,(P) ;A -> END OF 1ST HALF, B -> END OF ALL. + PUSHJ P,(AA) ;DO SECOND HALF. +SSRTX6: ROT CH2,1 ;LEAVE CH2 AS FOUND IT. +SSRTX7: HLRZ A,(P) ;LEAVE A -> END OF AREA SORTED. + POPJ P, + +;ARITHMETIC CONDITIONALS (B HAS JUMP A,) + +COND: PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,AGETFD ;GET FIELD TO TEST VALUE OF +CONDPP: POP P,T ;RESTORE CONDITIONAL JUMP INSTRUCTION + HRRI T,COND2 ;HRRI IN JUMP ADDRESS, GO TO COND2 IF CONDITIONAL TRUE + XCT T ;JUMP IF COND T,ASSEMBLE STRING +COND4: SETZM A.SUCC ;MOST RECENT CONDIT. FAILED. +COND5: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WHAT PSEUDO WE'RE IN. + CALL RCH + JSP D,RARL4 ;INIT FOR THE CONDITIONALIZED STUFF. + CAIA + CALL RARFLS ;READ AND IGNORE THE ARG. + JRST MACCR + +ANULL: TLO FF,FLUNRD + JRST COND5 + +;.ELSE, .ALSO - B'S LH WILL HAVE SKIPE OR SKIPN. +A.ELSE: HRRI B,A.SUCC + XCT B + JRST COND4 ;CONDITION FALSE. + JRST COND2 ;TRUE. + +;IF1, IF2 - B'S LH WILL HAVE TRNE FF, OR TRNN FF, +COND1: HRRI B,FRPSS2 + XCT B + JRST COND4 ;NO + ;CONDITION TRUE, ASSEMBLE STRING +COND2: SETOM A.SUCC ;LAST CONDITIONAL SUCCEEDED. +COND6: PUSHJ P,RCH ;GET NEXT CHAR + CAIE A,LBRKT + JRST [ CAIE A,LBRACE + TLO FF,FLUNRD + JRST MACCR] + SKIPN SCNDEP ;BRACKET TYPE CONDITIONAL. + SKIPE CONDEP + JRST COND7 + MOVEMM CONDLN,CLNN ;AT TOP LEVEL, SAVE IN CASE THIS UNTERMINATED + MOVEMM CONDPN,CPGN +IFN TS, MOVEMM CONDFI,INFFN1 +COND7: AOS SCNDEP ;COUNT IT FOR RBRAK'S SAKE. + JRST MACCR + +;IFB, IFNB + +SBCND: PUSH P,B ;SAVE TEST JUMP + SETZB B,C ;C COUNTS SQUOZE CHARS FOR IFB/IFNB + ;B COUNTS NONSQUOZE FOR IFSQ/IFNSQ + JSP D,RARG ;INIT FOR READING OF ARG WHOSE BLANKNESS + JRST CONDPP ;IS TO BE TESTED. + JSP D,RARGCH(T) ;READ 1 CHAR, + JRST CONDPP ;(NO MORE CHARS) + HLRZ A,GDTAB(A) ;GET GDTAB ENTRY + CAIE A,(POPJ P,) ;POPJ => NOT SQUOZE + AOJA C,RARGCH(T) + AOJA B,RARGCH(T) + + ;IFDEF, IFNDEF + +DEFCND: PUSH P,SYM + PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + PUSHJ P,ES + MOVEI A,0 ;UNDEFINED +IFN CREFSW,XCT CRFINU + CAIN A,GLOEXT_-14. ;GLOBAL EXIT... + SKIPL CONTRL ;DURING ABSOLUTE ASSEMBLY? + CAIN A,3 ;NO, LOCAL UNDEF? + MOVEI A,0 ;ONE OF THESE => UNDEF + REST SYM + EXCH SYM,(P) ;POP SYM OUT FROM UNDER THE CONDITIONAL JUMP. + JRST CONDPP + +;;PWRD ;ROUTINES TO OUTPUT ASSEMBLES WORDS AND PORTIONS THEREOF + + ;HERE FROM PBITS TO OUTPUT WORD OF CODE BITS + +PBITS3: PUSH P,A + MOVEI A,14 + MOVEM A,PBITS2 ;INITIALIZE PBITS2 FOR COUNTING DOWN THROUGH NEXT SET OF CODE BITS + MOVE A,[440300,,PBITS1] + MOVEM A,BITP ;SET UP BITP FOR RELOADING PBITS1 WITH CODE BITS + MOVE A,PBITS1 ;NOW GET ACCUMULATED WORD OF BITS + MOVEM A,@PBITS4 ;STORE IN BKBUF + AOS A,OPT1 ;RESERVE SPACE FOR NEW WORD + ;IF FRBIT7 SET (LAST CALL TO PBITS HAD 7) THEN NEXT WORD OF CODE BITS GOES + ;AFTER NEXT WORD OUTPUT (REALLY!), OTHERWISE BEFORE + TRNN FF,FRBIT7 + SOSA A + TRO FF,FRINVT + HRRZM A,PBITS4 + POP P,A + CLEARM PBITS1 + ;DROPS THROUGH + ;OUTPUT RELOCATION CODE BITS IN A + +PBITS: SKIPGE CONTRL + POPJ P, ;NOT RELOCATABLE + SOSGE PBITS2 + JRST PBITS3 ;NO MORE ROOM IN WORD, OUTPUT IT AND TRY AGAIN + CAIN A,7 + TROA FF,FRBIT7 + TRZ FF,FRBIT7 + IDPB A,BITP + POPJ P, + + ;FOLLOWING ROUTINES SAVE AC'S EXCEPT FOR A + +OUTSM0: MOVE A,SYM ;OUTPUT NAME STINK KNOWS SYMBOL BY. + TLZ A,37777 ;FOR LOCALS, THAT'S THE STE ADDR, + HRRI A,ST(D) + TLNN SYM,40000 ;FOR GLOBALS, THAT'S THE SQUOZE. + JRST $OUTPT +OUTSM: SKIPA A,SYM +OUTWD: MOVE A,WRD +$OUTPT: SKIPGE CONTRL ;DIRECTLY PUNCH OUT WORD IN A IN RELOCATABLE ASSEMBLY ONLY + POPJ P, ;DO NOTHING IF ABSOLUTE ASSEMBLY + PUSH P,AA + MOVE AA,OPT1 + TRZN FF,FRINVT ;SKIP IF BEING HACKED FROM PBITS3, PUT WORD BEFORE WHERE IT NORMALLY BELONGS + AOS AA + MOVEM A,-1(AA) + MOVE A,CLOC + TRZE FF,FRFIRWD + HRRM A,BKBUF + POP P,AA + AOS A,OPT1 + CAIL A,BSIZE+BKBUF + TRNE I,IRCONT + POPJ P, + ;MAY DROP THROUGH + +;END CURRENT OUTPUT BLOCK + +EBLK: PUSH P,T + PUSH P,TT + PUSH P,A + PUSH P,B + MOVE T,CONTRL + JUMPGE T,EBLK3 ;JUMP IF RELOCATABLE ASSEMBLY + TRNE T,ARIM10\SBLKS + JRST ESBLK + TRNE T,DECSAV + JRST EDSBLK +IFN FASLP,[ + TRNE T,FASL + JRST FASLE ;FASL HAS NO BLOCKS TO END - IGNORE +] + TRNE T,DECREL + JRST DECEBL + JRST EBLK5 + +EBLK3: MOVE T,PBITS1 + MOVEM T,@PBITS4 + MOVEI T,PBITS4 + MOVEM T,PBITS4 + MOVE T,[440300,,PBITS1] + MOVEM T,BITP + CLEARB TT,PBITS2 + CLEARM PBITS1 + MOVEI T,BKBUF + MOVE B,OPT1 ;GET POINTER TO END OF BLOCK + SUBI B,BKBUF+1 ;CONVERT TO # WORDS IN BLOCK (EXCLUDING HEADER) + DPB B,[220700,,BKBUF] ;SET COUNT FIELD IN HEADER + TRZN FF,FRLOC + JUMPLE B,EBLK5 ;IGNORE NULL BLOCK UNLESS FRLOC SET + TLO FF,$FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) + PUSHJ P,FEED +EBK1: CAML T,OPT1 ;DONE WITH BLOCK? + JRST EBK2 ;YES + MOVE A,(T) ;NO, GET DATA WORD + JFCL 4,.+1 ;UPDATE CHECKSUM + ADD TT,A + JFCL 4,[AOJA TT,.+1] + PUSHJ P,PPB ;OUTPUT WORD + AOJA T,EBK1 +EBK2: SETCM A,TT ;DONE OUTPUTTING BLOCK, NOW GET CHECKSUM + PUSHJ P,PPB ;OUTPUT CHECKSUM + MOVE T,CDATBC ;GET BLOCK TYPE + DPB T,[310700,,BKBUF] ;SET NE T BLOCK TYPE TO STORAGE WORDS BLOCK TYPE + MOVEI T,BKBUF+1 + MOVEM T,OPT1 +EBLK4: TLO FF,$FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) +EBLK5: TRO FF,FRFIRWD +FASLE: POP P,B + POP P,A +PTT.TJ: POP P,TT + POP P,T + POPJ P, + +;PUNCH OUT WORD OF CODED DATA (E.G. STORAGE WORD); WRD, WRDRLC, GLOTB ENTRIES + +PWRDA: TROA FF,FRNLIK ;SUPPRESS ADR LINKING +PWRD: TRZ FF,FRNLIK ;PERMIT ADR LINKING + JUMPGE FF,CPOPJ ;IGNORE IF NOT PUNCHING PASS +IFN LISTSW,[ + SKIPN LSTONP + JRST PWRDL ;NOT MAKING LISTING NOW. + SKIPGE LISTPF + PUSHJ P,PNTR + SETOM LISTPF + MOVE LINK,WRD + MOVEM LINK,LISTWD + MOVE LINK,WRDRLC + MOVEM LINK,LSTRLC + MOVE LINK,CLOC + MOVEM LINK,LISTAD + MOVE LINK,CRLOC + DPB LINK,[220100,,LISTAD] +PWRDL: +] ;END IFN LISTSW, + SKIPGE LINK,CONTRL + JRST PWRD1 ;ABSOLUTE ASSEMBLY + ;RELOCATABLE ASSEMBLY + PUSHJ P,$RSET ;CHECK VALIDITY OF RELOCATION, STANDARDIZE IF NON-STANDARD + MOVE A,GLSP2 + CAMN A,GLSP1 + JRST PWRD2 ;NO GLOBALS + + ;NOW TO SEE IF IT'S POSSIBLE OR DESIRABLE TO ADDRESS LINK + + HRLZ B,WRD + HRR B,WRDRLC + JUMPN B,PWRD3 ;JUMP IF RH NON-ZERO + TRNN FF,FRNLIK + SKIPGE GLOCTP + JRST PWRD3 ;ADR LINKING SUPPRESSED OR CLOC GLOBAL + SKIPE LDCCC + JRST PWRD3 ;IN LOAD TIME CONDITIONALS + MOVNI T,1 ;INITIALIZE T FOR COUNTING +PWRD4: CAML A,GLSP1 + JRST PWRD5 ;DONE + HRRZ TT,1(A) ;GET GLOTB ENTRY + JUMPE TT,PWRD7A + LDB TT,[400400,,(TT)] ;GET SQUOZE FLAGS FROM SYM + CAIE TT,DEFGVR_-14. + CAIN TT,GLOETY_-14. + JRST PWRD3 ;DEFINED, BUT MUST BE HERE FOR A REASON (SEE $.H) + HLRZ TT,1(A) + TRNE TT,1777+MINF + JRST PWRD3 ;NEGATED OR MULTIPLIED + TRNE TT,HFWDF + JRST PWRD7 + TRNE TT,ACF + TRNN TT,SWAPF + JRST PWRD3 ;NOT HIGH AC +PWRD7A: AOJA A,PWRD4 +PWRD7: TRNE TT,SWAPF + AOJA A,PWRD4 ;LEFT HALF + AOJN T,PWRD3 ;JUMP IF THIS NOT FIRST GLOBAL IN RIGHT HALF + MOVEI D,1(A) ;FIRST GLOBAL, SET UP POINTER TO GLOTB ENTRY + AOJA A,PWRD4 + +PWRD5: AOJE T,PWRD3 ;NO GLOBALS LOOK BAD AND THERE AREN'T TOO MANY; JUMP IF NONE IN RH + HRRZ T,(D) ;GET ADR OF SQUOZE + SKPST T, ;SKIP IF IN SYMBOL TABLE + JRST PWRD3 ;BELOW SYMBOL TABLE, DON'T ADDRESS LINK AFTER ALL + PUSH P,T ;HOORAY, WE CAN ADDRESS LINK + SETZM (D) ;CLEAR OUT GLOTB ENTRY, DON'T NEED IT ANY MORE + PUSHJ P,PWRD31 ;DUMP OUT THE OTHER GLOBALS + POP P,D ;GET ST ADR OF THIS AGAIN + 3GET1 A,D + LDB A,[.BP (3RLNK),A] + MOVE B,WRDRLC + TLNE B,1 + TRO A,2 ;RELOCATE LEFT HALF + PUSHJ P,PBITS ;PUNCH OUT APPROPRIATE BITS FOR LINK LIST ENTRY + HLR A,1(D) ;GET ADR OF LAST + HLL A,WRD + PUSHJ P,$OUTPT ;OUTPUT WORD WITH RH = ADR OF LAST RQ FOR SYM TO PUT IN RH'S + MOVE A,CLOC ;NOW UPDATE ST ENTRY + HRLM A,1(D) + 3GET1 B,D + SKIPN CRLOC + TLZA B,3RLNK ;CLOC NOT RELOCATED LAST TIME THIS SYM USED + TLO B,3RLNK ;RELOCATED + 3PUT1 B,D + POPJ P, + +PWRD31: MOVE T,GLSP2 ;DUMP ALL GLO S IN GENERAL FORMAT +PWRD3A: CAML T,GLSP1 + POPJ P, + MOVE B,1(T) + TRNN B,-1 + AOJA T,PWRD3A + TLNE B,1777 + JRST RPWRD ;REPEAT +RPWRD1: LDB A,[.BP (MINF),B] + TRO A,4 + PUSHJ P,PBITS + MOVE A,(B) ;CODEBITS +SQUOZE FOR SYM + HLRZ C,A + TLZ A,740000 + CAIL C,DEFGVR + TLOA A,40000 ;SYM IS GLO + JRST [ MOVEI C,(B) ;IF WE ARE OUTPUTTING A REFERENCE TO THE + CAIL C,PCNTB ;"LABEL" AT THE BEGINNING OF A CONSTANTS AREA + CAIL C,PCNTB+NCONS*3 ;(BECAUSE THIS IS A 1PASS ASSEMBLY) USE THE + MOVEI A,(B) ;NAME, SINCE THE SYMBOL ISN'T IN THE + JRST .+1] ;SYMTAB + TLNE B,SWAPF + TLO A,400000 + TLNE B,ACF + JRST PWRD3E ;AC HIGH OR LOW + TLNN B,HFWDF + JRST PWRD3F ;ALL THROUGH + TLO A,100000 + TLNE B,SWAPF + TLC A,300000 +PWRD3F: PUSHJ P,$OUTPT + AOJA T,PWRD3A + + + +RPWRD: PUSHJ P,PBITS7 + MOVEI A,CRPT + PUSHJ P,PBITS + LDB A,[221200,,B] + PUSHJ P,$OUTPT + JRST RPWRD1 + +PWRD3E: TLO A,300000 + JRST PWRD3F + +PWRD3: PUSHJ P,PWRD31 +PWRD2: PUSHJ P,RCHKT + HRRZ A,B + DPB T,[10100,,A] + PUSHJ P,PBITS + JRST OUTWD + +;CHECK FOR VALIDITY OF RELOCATION BITS OF CURRENT WORD +;LEAVE RELOC (RH) IN B, RELOC (LH) IN T + +RCHKT: HRRZ B,WRDRLC ;CHECK FOR RELOC. OTHER THAN 0 OR 1. + HLRZ T,WRDRLC + TRZN B,-2 + TRZE T,-2 +RLCERR: ETSM [ASCIZ /Illegal relocation/] + POPJ P, + +RMOVET: ROT T,-1 + DPB B,[420100,,T] + TLZ C,3DFCLR ;SET RELOC BITS IN C + IOR C,T ;FROM B AND T. + POPJ P, + + ;CHECK WRDRLC FOR VALIDITY (CAPABILITY OF BEING PUNCHED OUT) + ;IF STANDARD THEN JUST RETURN + ;IF NON-STANDARD BUT OTHERWISE OK, PUT $R. ON GLOBAL LIST, RESET WRDRLC, AND RETURN + ;LEAVES B AND C SET UP WITH RH, LH OF WRDRLC. + +$RSET: MOVE C,WRDRLC ;GET RELOCATION + ADDI C,400000 ;WANT TO SEPARATE HALFWORDS + HLRE B,C ;GET LH IN B + HRREI C,400000(C) ;GET RH IN C (WILL EXCHANGE LATER) + MOVE A,[SWAPF+HFWDF,,$R.H] ;PUT THIS ON GLOBAL LIST IF LH NEEDS $R. + TRNE B,-2 ;CHECK LH + PUSHJ P,$RSET1 ;LH NEEDS GLOBAL REFERENCE + EXCH B,C + HRLI A,HFWDF + TRNE B,-2 ;CHECK RH + PUSHJ P,$RSET1 ;RH NEEDS GLOBAL REFERENCE + HRLZM C,WRDRLC ;RELOC OF LH + ADDM B,WRDRLC ;COMPLETE SETTING UP WRDRLC + POPJ P, + +$RSET1: JUMPGE B,$RSET2 ;STRANGE RELOCATION IN B, JUMP IF NON-NEGATIVE + MOVN T,B ;NEGATIVE, GET MAGNITUDE + TLOA A,MINF ;SET FLAG TO NEGATE GLOBAL +$RSET2: SOSA T,B ;POSITIVE, GET ONE LESS THAN IT IN T + TDZA B,B ;NEGATIVE, CLEAR B, RELOCATION LEFT OVER + MOVEI B,1 ;POSITIVE, SET RELOCATION LEFT OVER TO 1 + CAIN T,1 + MOVEI T,0 ;MULTIPLYING BY TWO OR SUBTRACTING TIMES 1 + TRNE T,-2000 + ETSM [ASCIZ /Relocation too large/] ;TOO BIG EVEN FOR $RSET + DPB T,[221200,,A] ;LOOKS OK, STORE TIMES FIELD IN $R. REFERENCE + AOS GLSP1 ;NOW PUT $R. ON GLOBAL LIST + MOVEM A,@GLSP1 + POPJ P, + +;PWRD DURING ABSOLUTE ASSEMBLY + +PWRD1: TRNE LINK,DECREL ; DEC REL FMT IS CONSIDERED ABSOLUTE. + JRST DECPW +IFN FASLP,[ + TRNE LINK,FASL + JRST FASPW ;SO IS FASL +] + MOVE A,GLSP1 + CAME A,GLSP2 + ETR ERRILG ;GLOBALS APPEARING ILLEGALLY + SKIPE WRDRLC + ETR ERRIRL ;RELOCATION APPEARING ILLEGALLY + TRNE LINK,ARIM + JRST PRIM ;RIM + TRNE LINK,DECSAV + JRST DSBLK1 +SBLKS1: MOVE A,WRD ;SBLK + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FRFIRWD + MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER + AOS A,OPT1 + CAIGE A,BKBUF+BSIZE + POPJ P, ;BKBUF NOT FULL YET + +SBLKS2: SUBI A,BKBUF+1 + JUMPE A,CPOPJ + MOVNS A + HRLM A,BKBUF + PUSHJ P,FEED + MOVEI T,BKBUF + CLEARM SCKSUM +SBLK1: CAML T,OPT1 + JRST SBLK2 + MOVE A,SCKSUM + ROT A,1 + ADD A,(T) + MOVEM A,SCKSUM + MOVE A,(T) + PUSHJ P,PPB + AOJA T,SBLK1 + +SBLK2: TRO FF,FRFIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,SCKSUM + JRST PPB + +ESBLK: MOVE A,OPT1 + CAIN A,BKBUF+1 + JRST EBLK5 ;AVOID SETTING $FLOUT IF NULL BLOCK. + PUSHJ P,SBLKS2 + JRST EBLK4 + +PRIM: MOVSI A,(DATAI PTR,) + HRR A,CLOC + PUSHJ P,PPB + MOVE A,WRD + JRST PPB + +; COME HERE TO OUTPUT WD IN ABSOLUTE DEC FMT (DECSAV) + +DSBLK1: MOVE A,WRD + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FRFIRWD + MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER + AOS A,OPT1 + CAIGE A,BKBUF+BSIZE + POPJ P, ;BKBUF NOT FULL YET, RETURN + +DSBLK2: SUBI A,BKBUF+1 + JUMPE A,CPOPJ + MOVNS A + SOS BKBUF ; DEC "IOWD" FMT, POINT AT LOC-1 + HRLM A,BKBUF + PUSHJ P,FEED + MOVEI T,BKBUF +DSBLK3: CAML T,OPT1 + JRST DSBLK4 + MOVE A,(T) + PUSHJ P,PPB + AOJA T,DSBLK3 + +DSBLK4: TRO FF,FRFIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + POPJ P, + +; END A BLOCK IN DEC SAV FMT, COME HERE FROM EBLK. + +EDSBLK: MOVE A,OPT1 + CAIN A,BKBUF+1 + JRST EBLK5 ;AVOID SETTING $FLOUT IF NULL BLOCK. + PUSHJ P,DSBLK2 + JRST EBLK4 + + +;END A BLOCK IN DEC FMT. COME FROM EBLK. +DECEBL: PUSH P,[EBLK5] +DECEB1: MOVSI A,DECWDS ;JUST INIT. AN ORDINARY BLOCK, + +;COME HERE TO OUTPUT PREVIOUS BLOCK AND START NEW BLOCK OF TYPE IN LH OF A. +DECBLK: PUSH P,A + HRRZ A,BKBUF ;GET DATA-WORD COUNT OF CURRENT BLOCK. + JUMPE A,DECB1 ;NO WORDS => CAN IGNORE. + MOVEI TT,BKBUF+1 +DECB0: MOVE A,-1(TT) ;GET AND PUNCH NEXT WD OF BLOCK. + PUSHJ P,PPB + CAME TT,OPT1 ;STOP WHEN NEXT WD ISN'T IN BLOCK. + AOJA TT,DECB0 +DECB1: POP P,A + HLLZM A,BKBUF ;PUT BLOCK TYPE IN LH OF HEADER, DATA WD COUNT IN RH IS 0. + MOVEI TT,BKBUF+2 ;ADDR OF PLACE FOR 1ST DATA WD + MOVEM TT,OPT1 ;(LEAVE SPACE FOR WD OF RELOC BITS) + MOVE TT,[440200,,BKBUF+1] + MOVEM TT,BITP ;BP FOR STORING PAIRS OF RELOC BITS. + SETZM BKBUF+1 ;CLEAR THE WD OF RELOC BITS. + TLO FF,$FLOUT + POPJ P, + +;COME HERE TO OUTPUT A WORD IN DEC FORMAT. +DECPW: MOVS A,BKBUF + CAIE A,DECWDS ;BEFORE THE 1ST STORAGE WD IN ORDINARY BLOCK, + JRST DECPW0 + MOVE A,CRLOC ;MUST GO THE LOCATION CTR. + IDPB A,BITP + MOVE A,CLOC + MOVEM A,@OPT1 + AOS OPT1 + AOS BKBUF ;IT COUNTS AS DATA WORD. +DECPW0: MOVE A,BITP + TLNE A,77^4 ;IF NO ROOM FOR MORE RELOC BITS, + JRST DECPW1 + HLLZ A,BKBUF ;START A NEW BLOCK. + PUSHJ P,DECBLK + JRST DECPW + +DECPW1: PUSHJ P,$RSET ;SET UP RELOC BITS OF HALVES IN B,C. + LSH C,1 + IORI B,(C) ;COMBINE THEM. + MOVE A,GLSP1 + CAME A,GLSP2 + JRST DECPG ;GO HANDLE GLOBALS. +DECPW3: IDPB B,BITP ;STORE THE RELOC BITS + MOVE A,WRD +DECPW2: MOVEM A,@OPT1 ;AND THE VALUE. + AOS OPT1 + AOS BKBUF + POPJ P, + +;PUT A WORD DIRECTLY INTO DEC FMT BLOCK. +DECWRD: SETZ TM, +DECWR1: IDPB TM,BITP ;SKIP A PAIR OF RELOC BITS, + JRST DECPW2 ;STORE THE WORD. + +;HANDLE GLOBAL REFS IN DEC FMT. +DECPG: PUSHJ P,DECPW3 ;FIRST, OUTPUT THE WORD, +DECPG0: MOVSI A,DECSYM + PUSHJ P,DECBLK ;THEN STRT A SYMBOLS BLOCK. + MOVE C,GLSP2 + PUSH P,SYM +DECPG1: CAMN C,GLSP1 ;ALL DONE => + JRST DECPG2 ;GO START AN ORDINARY BLOCK FOR NEXT WD. + MOVE A,BITP + TLNN A,77^4 ;BLOCK FULL => START ANOTHER. + JRST DECPG0 + AOS C,GLSP2 ;GET ADDR OF NEXT GLOBAL REF. + MOVE B,(C) + MOVE B,(B) ;GET NAME OF SYM. + TLZ B,740000 + CAMN B,[SQUOZE 0,$R.] + JRST DECPG3 ;(DEC'S LOADER HAS NO SUCH HACK.) + CALL ASQOZR ;RIGHT-JUSTIFY THE SQUOZE FOR DEC SYSTEM. + MOVE A,B + TLO A,600000 ;PUT IN FLAGS SAYING ADDITIVE GLOBAL RQ. + PUSHJ P,DECWRD ;OUTPUT NAME. + HRRZ A,CLOC ;GET ADDR OF RQ, + TLO A,400000 ;MACRO-10 SETS THIS BIT SO I WILL. + MOVE B,(C) + TLNE B,SWAPF ;SWAPPED => TELL LOADER.. + TLO A,200000 + TLNE B,ACF+MINF + ETSM ERRILG ;CAN'T NEGATE GLOBAL OR PUT IN AC. + MOVE TM,CRLOC + PUSHJ P,DECWR1 ;OUTPUT 2ND WD, + JRST DECPG1 ;GO BACK FOR MORE GLOBAL REFS. + +DECPG2: REST SYM + JRST DECEB1 + +DECPG3: ETR ERRIRL ;WE NEEDED $R. BUT DIDN'T HAVE IT. + JRST DECPG1 + +ERRILG: ASCIZ /Illegal use of external/ +ERRIRL: ASCIZ /Illegal use of relocatables/ + + +;OUTPUT PROGRAM NAME BLOCK (AT START OF PASS 2) +;IF 2-SEG PROGRAM, ALSO OUTPUT A TYPE-3 BLOCK (LOAD INTO HISEG) +DECPGN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2. + PUSH P,[EBLK] + MOVSI A,DECNAM + CALL DECBLK + MOVE B,PRGNM + CALL ASQOZR + MOVE A,B + CALL DECWRD + MOVSI A,14 ;IDENTIFY THIS REL FILE AS MADE BY MIDAS. + CALL DECWRD + MOVE A,DECTWO + CAMN A,[MOVE] + RET ;NOT A 2-SEG PROGRAM. +DECP2S: MOVSI A,DECHSG + CALL DECBLK ;START A LOAD-INTO-HISEG BLOCK. + MOVE A,DECTWO + HRL A,DECBRH ;HISEG BRK,,TWOSEG ORIGIN. + SKIPL A + HRLI A,(A) + MOVEI TM,1 ;RELOCATION IS 1. + JRST DECWR1 + +IFN FASLP,[ +;INITIALIZE OUTPUT FOR FASL ASSEMBLY +FASOIN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2 + MOVE A,[SIXBIT /*FASL*/] + PUSHJ P,PPB + MOVE A,[MIDVRS] + LSH A,-6 + TLO A,(SIXBIT /M/) + PUSHJ P,PPB ;"LISP" VERSION NUMBER (USE M AND MIDAS NUMBER) + MOVE A,[440400,,FASB] ;INITIALIZE FASL OUTPUT BUFFER + MOVEM A,FASCBP + MOVEI A,FASB+1 + MOVEM A,FASBP + POPJ P, + + +;COME HERE TO OUTPUT A WORD IN FASL FORMAT +FASPW: MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;"PUNCH" OUT ATOM TBL (IF MORE HAS APPEARED) + PUSHJ P,$RSET ;GET RELOC + PUSH P,C ;SAVE LH RELOC + MOVEM B,FASPWB ;B HAS RELOC, WHICH IS ALSO FASL CODE FOR RELOC =1 + MOVE A,GLSP2 +FASPW3: CAME A,GLSP1 + JRST FASPW1 ;LOOK TO SEE .. +FASPW2: MOVE A,WRD ;B HAS RELOC, WHICH ALSO HAPPENS TO BE FASL CODE TYPE + MOVE B,FASPWB + PUSHJ P,FASO ;OUTPUT WORD IN A WITH FASL CODE IN B + POP P,TM + JUMPE TM,FASPW5 ;NO LEFT HALF RELOC, OK + MOVNI A,1 ;ACTIVATE FASL HACK FOR LH RELOC + MOVEI B,7 ;WOULD OTHERWISE BE GETDDTSYM + PUSHJ P,FASO +FASPW5: MOVE C,GLSP2 +FASPW6: CAMN C,GLSP1 + POPJ P, + HRRZ TM,1(C) + JUMPE TM,[AOJA C,FASPW6] + MOVE SYM,(TM) ;GET SQUOZE OF SYM + TLZ SYM,740000 ;CLEAR CODE BITS + HLRZ D,1(C) + TRZ D,400000 ;DONT WORRY ABOUT THAT BIT + TRZE D,MINF + TLO SYM,400000 ;NEGATE + CAIN D,SWAPF + JRST FSPWSW + CAIN D,HFWDF + JRST FSPWRH + CAIN D,ACF+SWAPF + JRST FSPWAC + JUMPE D,FSPWWD + ETSM [ASCIZ /Global in illegal FASL context/] + +FSPWWD: TLOA SYM,140000 +FSPWAC: TLOA SYM,100000 +FSPWRH: TLO SYM,40000 +FSPWSW: MOVE A,SYM + MOVEI B,7 ;DDT SYM + PUSHJ P,FASO + AOJA C,FASPW6 + +FASPW1: HRRZ TM,1(A) ;GLOTB ENTRY + JUMPE TM,FASPW4 + CAIL TM,AFDMY1 + CAIL TM,AFDMY2 +FASPW4: AOJA A,FASPW3 + MOVE C,1(A) ;ITS A LIST STRUCTURE REF + TLNN C,-1-HFWDF + SKIPE FASPWB + ETA [ASCIZ /Illegal LISP structure reference/] + MOVE TM,AFDMY2-AFDMY1(TM) ;GET FASL BITS + MOVEM TM,FASPWB ;FASL BITS + CLEARM 1(A) ;FLUSH THAT GUY + AOJA A,FASPW3 + +FPATB: CAMN C,FASATP ;PUNCH OUT ATOM TBL, AMT ALREADY PUNCHED IN C + POPJ P, ;THRU + MOVEI B,12 ;ATOM TBL INFO + MOVE A,FASAT(C) + TRNN A,-1 + AOJA C,FPATB3 ;LIST WORD .. SHOULD HAVE PUNCHED ITSELF + PUSHJ P,FASO + HRRZ D,FASAT(C) ;ATOM "LENGTH" + AOS C +FPATB1: SOJL D,FPATB2 + MOVE A,FASAT(C) + PUSHJ P,FASO1 + AOJA C,FPATB1 + +FPATB3: ETR [ASCIZ /Internal loss at FPATB3/] +FPATB2: MOVEM C,FASPCH ;RECORD AMOUNT PUNCHED + JRST FPATB ;LOOP BACK IF MORE + + +FASO: PUSHJ P,FASBO ;WRITE BITS +FASO1: MOVEM A,@FASBP ;STORE A IN FASL OUTPUT BUFFER + AOS TM,FASBP + CAIL TM,FASB+FASBL + ETF [ASCIZ /.FASL output block too long/] + POPJ P, + +FASBO: MOVE TM,FASCBP ;OUTPUT FASL CODEBITS IN B, WRITE PREV BLOCK IF NECC + TLNN TM,770000 + PUSHJ P,FASBE ;WRITE PREV FASL BLOCK + IDPB B,FASCBP + POPJ P, + +FASBE: PUSH P,A + PUSH P,B + MOVEI TT,FASB +FASBO2: CAML TT,FASBP + JRST FASBO3 + MOVE A,(TT) + PUSHJ P,PPB + AOJA TT,FASBO2 + +FASBO3: POP P,B + POP P,A + CLEARM FASB ;NEW CODE WORD + MOVEI TM,FASB+1 + MOVEM TM,FASBP + SOS FASCBP + POPJ P, + +AFATOM: PUSH P,B ;SAVE CODEBITS + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ATOM illegal except in FASL assembly/] + PUSHJ P,AFRATM ;READ "ATOM", RETURN INDEX IN A + POP P,B + HLRZS B +AFLST1: AOS GLSP1 + MOVEI T,AFDMY1(B) ;DUMMY (STORE THIS INFO IN SYM SO CONSTANTS WILL WIN + HRRZM T,@GLSP1 + MOVEI B,0 ;NO RELOCATION + POPJ P, + +;GLOBALS IN THIS TABLE KEEP TRACK OF LIST REFS +;UNDEF GLOBAL GODEBITS +AFDMY1: SQUOZE 44,.%VCEL ;EVENTUALLY POINT TO VALUE CELL + SQUOZE 44,.%SCAL ;EVENTUALLY BECOME "SMASHABLE CALL" + SQUOZE 44,.%ATM ;EVENTUALLY POINT TO ATOM + SQUOZE 44,.%ARY ;EVENTUALLY POINT TO ARRAY +AFDMY2: 2 ;CODE BITS FOR VALUE CELL REF + 3 ;CODE BITS FOR SMASHABLE CALL + 4 ;CODE BITS FOR POINTER TO ATOM + 10 ;CODE BITS FOR POINTER TO ARRAY + +AFRATM: PUSHJ P,AFRTKN ;READ TOKEN, LEAVING IT AT END OF FASAT + PUSHJ P,AFRITN ;"INTERN" IT, SKIP IF NOT FOUND + POPJ P, ;IF FOUND, INDEX IN A + PUSHJ P,AFRENT ;ENTER IN FASAT + POPJ P, + +AFRENT: MOVE A,FASAT1 ;STORE FASAT1 IN FASATP + MOVEM A,FASATP + AOS A,FASIDX ;RETURN LOAD TIME ATOM INDEX + POPJ P, + +AFRTKN: MOVE A,FASATP + ADD A,[700,,FASAT] + MOVEM A,FASAT2 ;BYTE PNTR TO USE TO STORE ATOM + CLEARM (A) + CLEARM 1(A) ;MAKE SURE ALL LOW BITS CLEARED + PUSHJ P,RCH + CAIN A,"# + JRST AFRTK1 ;READ NUMBER INTO FIXNUM SPACE + CAIN A,"& + JRST AFRTK2 ;READ NUMBER INTO FLONUM SPACE +AFRTKL: IDPB A,FASAT2 ;STORE CHAR + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 +AFTERR: ETA [ASCIZ /LISP atom name table full/] + CLEARM 1(A) +AFRTL2: PUSHJ P,RCH + CAIN A,12 + JRST AFRTL2 ;IGNORE LF IN ATOM NAMES (PRIMARILY SO /CR WINS WITH ONE + CAIN A,"/ ;SLASH + JRST AFRQT ;QUOTE CHAR + CAIE A,40 + CAIN A,15 + JRST AFREND + CAIE A,"; + CAIN A,11 + JRST AFREND + CAIE A,"( + CAIN A,") + JRST AFREN2 + CAIL A,"A+40 + CAILE A,"Z+40 + JRST AFRTKL ;THAT CHAR WINS, SALT IT + SUBI A,40 + JRST AFRTKL ;MAYBE MUST CONVERT TO L.C. BEFORE SALTING IT. + +AFRQT: PUSHJ P,RCH ;TAKE NEXT CHR NO MATTER WHAT + JRST AFRTKL + +AFRTK1: SKIPA TM,[100000,,1] ;PUT VAL IN FIXNUM SPACE +AFRTK2: MOVE TM,[200000,,1] ;PUT IT IN FLONUM SPACE + PUSH P,TM + MOVE SYM,[SQUOZE 0,ATOM] + PUSHJ P,FAGTFD + POP P,TM + MOVE B,FASATP + ADDI B,2 + CAIL B,FASAT+FASATL + XCT AFTERR + MOVEM TM,FASAT-2(B) + MOVEM A,FASAT-1(B) + MOVEM B,FASAT1 + POPJ P, + +AFREN2: TLO FF,FLUNRD ;SAVE ( OR ) AS WELL AS FLUSHING +AFREND: MOVEI B,5 ;PAD END OF P.N. WITH 0 S + MOVEI TM,0 +AFREN1: IDPB TM,FASAT2 + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 + XCT AFTERR + CLEARM 1(A) + SOJG B,AFREN1 + SUBI A,FASAT + MOVEM A,FASAT1 ;STORE PNTR TO WORD BEYOND ATOM + ; MAYBE PUT THIS IN FASATP + MOVE B,FASATP ;ADR OF START OF ATOM READ + SUBI A,1(B) ;COMPUTE LENGTH OF FASAT + HRRZM A,FASAT(B) ;PN ATOM 4.8-4.7 =0 STORE LENGTH IN HEADER WD + + POPJ P, + +AFRITN: MOVEI B,0 ;"INTERN" LAST ATOM READ IN + MOVEI A,1 ;A CONTAINS RUNTIME ATOM TBL INDEX + ;B INDEX WITHIN FASAT +AFRIT1: CAML B,FASATP + JRST POPJ1 ;NOT FOUND + MOVE C,FASATP ;POINTS AT HEADER OF WORD OF NEW (?) ATOM + HRRZ D,FASAT(B) ;HEADER WD OF GUY IN TBL(RIGHT HALF HAS LENGTH) + JUMPE D,AFRIT4 ;JUMP ON RESERVED FOR LIST +AFRIT2: MOVE TM,FASAT(C) + CAME TM,FASAT(B) + AOJA B,AFRIT3 ;THIS ONE LOSES + SOJL D,CPOPJ ;THIS ONE WINS! + AOS B + AOJA C,AFRIT2 + +AFRIT3: SOJL D,[AOJA A,AFRIT1] ;FINISH SPACING OVER THIS GUY +AFRIT4: AOJA B,AFRIT3 + +AFENTY: SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ENTRY in NON-FASL/] + SKIPN CRLOC + ETI [ASCIZ /.ENTRY when . is absolute/] + PUSHJ P,AFRATM ;READ FUNCTION NAME + HRLZS A + PUSH P,A + PUSHJ P,AFRATM ;READ TYPE (SUBR, LSUBR, ETC) + HRRM A,(P) + MOVE SYM,[SQUOZE 0,.ENTRY] + PUSHJ P,FAGTFD ;READ ARGS PROP + JUMPGE FF,ASSEM1 ;NOT PUNCHING PASS + PUSH P,A + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ANY NEW ATOMS OUT + POP P,C + POP P,A + MOVEI B,13 + PUSHJ P,FASO + HRL A,C + HRR A,CLOC + PUSHJ P,FASO1 + JRST ASSEM1 + +AFLIST: HLRZM B,AFLTYP + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.LIST illegal except in FASL assembly/] + PUSHJ P,AFRLST ;READ LIST, RTN ATM TBL INDEX IN A + SKIPN AFLTYP + JRST ASSEM1 ;JUST EVAL IN LISP AND THROW AWAY VALUE + MOVEI B,AFDMAI ;"ATOM" INDEX IN AFDMY1 TBL + JRST AFLST1 ;TREAT AS ATOM + +AFRLST: CLEARM AFRLD ;"DEPTH" + CLEARM AFRLEN ;"LENGTH" OF LIST AT CURRENT LEVEL + CLEARM AFRDTF ;DOT CONTEXT FLAG + JUMPGE FF,AFRLI1 + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ALL ATOMS "PUNCHED" + MOVE A,FASATP + MOVEM A,AFRFTP ;SAVED STATE OF FASAT POINTER + MOVE C,AFLTYP + MOVEI B,16 ;EVAL TYPE HACK + CAIN C,1 + MOVEI B,5 ;LIST TYPE HACK + PUSHJ P,FASBO ;WRITE CODE BITS +AFRLI1: +AFRL1: PUSHJ P,RCH + CAIE A,40 ;PREV ATOM (OR WHATEVER) "DELIMITED", SO THESE MEANINGLESS + CAIN A,15 ;UNLESS AT TOP LEVEL AND HAVE READ SOMETHING + JRST AFRL1A + CAIE A,11 + CAIN A,12 + JRST AFRL1A + CAIN A,"( + JRST AFRLO + CAIN A,") + JRST AFRLC + CAIN A,". + JRST AFRDT ;DOT.. + TLO FF,FLUNRD + SKIPE AFRLD + JRST AFRNXT ;READ NEXT GUY THIS LVL + SKIPE AFRLEN +AFRLO2: ETI [ASCIZ /LISP read context error/] +AFRNXT: SKIPN TM,AFRDTF + JRST AFRNX2 ;NOT HACKING DOTS, OK + AOS TM,AFRDTF + CAIE TM,2 + JRST AFRLO2 ;DIDNT JUST SEE THE DOT +AFRNX2: PUSHJ P,AFRATM + JUMPGE FF,AFRNX1 ;XFER ON NOT PUNCHING PASS + PUSHJ P,FASO1 ;TELL LOADER TO PUSH THIS ON ITS STACK +AFRNX1: AOS AFRLEN ;LIST NOW ONE LONGER THIS LVL + JRST AFRL1 + +AFRLO: SKIPN TM,AFRDTF + JRST AFRLO3 ;NOT HACKING DOTS + SOJN TM,AFRLO2 + CLEARM AFRDTF + JRST AFRL1 ;IGNORE BOTH . AND ( +AFRLO3: SKIPE AFRLD ;( + JRST AFRLO1 + SKIPE AFRLEN + JRST AFRLO2 +AFRLO1: PUSH P,AFRLEN + CLEARM AFRLEN ;START NEW LVL + AOS AFRLD ;DEPTH NOW ONE GREATER + JRST AFRL1 + +AFRLC: SOSGE AFRLD ;) + JRST AFRLO2 ;AT TOP LEVEL, BARF + MOVE A,AFRLEN + SKIPN TM,AFRDTF + JRST AFRLC2 ;NOT HACKING DOTS + CAIE TM,2 + JRST AFRLO2 + SOS A ;MAIN LIST NOW ONE SHORTER + TLOA A,200000 ;DOT WITH LAST THING ON STACK +AFRLC2: TLO A,100000 ;TELL LOADER TO MAKE LIST THIS LONG + JUMPGE FF,AFRLC5 + PUSHJ P,FASO1 +AFRLC5: POP P,AFRLEN ;LENGTH AT PREV LVL + AOS AFRLEN ;NOW ONE MORE + CLEARM AFRDTF ;NOT HACKING DOTS NOW + SKIPE AFRLD ;RETURNING TO TOP LEVEL? + JRST AFRL1 + JRST AFRX1 ;YES THRU + +AFRDT: SKIPN AFRDTF + SKIPN AFRLEN + JRST AFRLO2 ;DOT IN FIRST POSITION OF LIST + AOS AFRDTF ;ENTER STATE 1 OF DOT HACKING + JRST AFRL1 + +AFRL1A: SKIPN AFRLD ;SPACER CHAR TERMINATES AT TOP LVL IF HAVE RD SOMETHING + SKIPN AFRLEN + JRST AFRL1 +AFRX1: JUMPGE FF,AFRX2 ;NOT PUNCHING PASS + MOVE A,AFRFTP + CAME A,FASATP + ETR [ASCIZ /Saw atoms in list on pass 2 for first time/] + SKIPN B,AFLTYP ;TYP LIST OP + SKIPA A,[-1,,] + MOVSI A,-2 ;PUT LIST OR VALUE OF LIST IN ATOM TBL + PUSHJ P,FASO1 ;TERM OP AND PUT IT IN ATOM TBL + MOVEI A,0 + MOVE B,AFLTYP + JUMPE B,CPOPJ ;JUST WANT VALUE OF LIST + CAIN B,1 ;ONLY WANT THIS FOR STRAIGHT LIST + PUSHJ P,FASO1 ;OUTPUT "SXHASH" WORD + AOS A,FASATP + CLEARM FASAT-1(A) ;RESERVE SLOT IN FASAT TBL + MOVEM A,FASPCH ;SAY ALREADY PUNCHED OUT + AOS A,FASIDX + POPJ P, + +AFRX2: TLO I,ILNOPT ;DONT TRY TO OPTIMIZE IF IN CONSTANT + CLEARB A,B + POPJ P, +] + +;.LIBRA, .LIFS, ETC. + +A.LIB: NOVAL ? NOABS + HLRZM B,LIBTYP' ;STORE BLOCK TYPE TO OUTPUT + CLEARM LIBOP ;INITIALIZE SQUOZE FLAGS + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK, MAKING SURE LOADER KNOWS $. +LIB1: PUSHJ P,GETSYL ;GET NAME + TRNN I,IRSYL + JRST LIB2 ;NO SYL, DON'T OUTPUT + IOR SYM,LIBOP + TLO SYM,40000 + PUSHJ P,OUTSM + MOVSI A,400000 + ANDCAM A,LIBOP +LIB2: MOVE B,CDISP ;GET CDISP + TLNN B,DWRD\DFLD ;CHECK FOR WORD TERMINATOR + JRST LIB3 ;WORD TERMINATOR => DONE + MOVE A,LIBOP + MOVE B,LIMBO1 ;RETRIEVE LAST CHAR READ + CAIN B,", + MOVSI A,400000 + CAIN B,"+ + TLZ A,200000 + CAIN B,"- + TLO A,200000 + MOVEM A,LIBOP' ;STORE SQUOZE FLAGS (LESS GLBL BIT) FOR NEXT SYM + JRST LIB1 + +LIB3: MOVE A,LIBTYP ;GET BLOCK TYPE TO OUTPUT + DPB A,[310700,,BKBUF] + PUSHJ P,EBLK + CAIN A,LLIB ;.LIBRA? + JRST ARELC1 ;.LIBRA, NOW PLAY LIKE RELOCA PSEUDO + JRST LIB5 ;SOMETHING ELSE (.LIFS), INCREMENT DEPTH IN LOAD TIME CONDITIONALS + +A.ELDC: NOVAL ? NOABS + PUSHJ P,EBLK + MOVEI A,ELTCB + DPB A,[310700,,BKBUF] + TRO FF,FRLOC ;MAKE EBLK OUTPUT NULL BLOCK + PUSHJ P,EBLK + SOSGE LDCCC + CLEARM LDCCC ;LOADER CONDITIONAL UNDERFLOW + JRST ASSEM1 + + ;LOADER CONDITIONAL ON VALUE + +A.LDCV: NOVAL ? NOABS + LSH B,-27. + PUSH P,B + PUSHJ P,AGETWD + POP P,B + DPB B,[400300,,BKBUF] + MOVEI A,LDCV + PUSHJ P,PLDCM + MOVEI A,0 + DPB A,[400300,,BKBUF] +LIB5: AOS LDCCC +CCASM1: JRST ASSEM1 + +;.GLOBAL, .SCALAR, .VECTOR +;LH(B) HAS ILGLI, ILVAR, ILVAR+ILFLO RESPECTIVELY. +; Note that use of ILFLO flag is a crock here. + +A.GLOB: NOVAL + HLLZ LINK,B ;REMEMBER WHICH OF THE THREE PSEUDO'S THIS IS. +A.GLO2: MOVE A,GLSPAS + MOVEM A,GLSP1 + SETOM FLDCNT + PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO NAME => DONE + CALL ES + JRST A.GLO1 + CAIE A,PSUDO_-14. + JRST A.GLO1 + JSP B,GVPSEU ;TRYING TO .GLOBAL A PSEUDO => TYPE APPRO. ERR MSG AND RETURN. + JRST A.GLO2 ;DON'T DO ANYTHING TO IT; MOVE ON TO NEXT ARG. + +A.GLO1: IOR I,LINK ;SET THE GLOBAL FLAG OR THE VARIABLE FLAG. + TLNE LINK,ILVAR ;FOR .VECTOR OR .SCALAR, SAVE # VARS CREATED BEFORE CREATING THIS ONE. + PUSH P,VARCNT ;SO WE CAN TELL IF THIS CALL TO GETVAL ACTUALY CREATES IT. + PUSHJ P,GETVAL ;NOW GET VALUE (CLOBBERS SQUOZE FLAGS) + CAIA + HALT + TLNN LINK,ILVAR ; THAT'S IT IF .GLOBAL, ELSE CONTINUE + JRST A.GLO2 + PUSH P,LINK ;.VECTOR OR .SCALAR, MUST READ THE SIZE. + TLO FF,FLUNRD ;RE-READ THE TERMINATOR AFTER THE SYM, SO "FOO(1)" AND "FOO," WIN + MOVE SYM,[SQUOZE 0,.SCALAR] + TLNE LINK,ILFLO ; USE RIGHT SYM + MOVE SYM,[SQUOZE 0,.VECTOR] + CALL AGETFD + REST LINK + REST B ;GET PREV. VARCNT, SO WE CAN SEE IF IT WAS INCREMENTED. + TRNN A,-1 ;MAKE (N) WORK AS SIZE BY USIN L.H. IF R.H. IS 0. + HLRZS A + JUMPN A,A.GLO3 ;JUMP IF NONZERO SIZE SPEC'D + TLNN LINK,ILFLO ; ZERO, USE DEFAULT + JRST A.GLO2 ; WHICH IS ALWAYS 1 FOR .SCALAR + SKIPA A,VECSIZ ; AND VECSIZ FOR .VECTOR. +A.GLO3: TLNE LINK,ILFLO ;NONZERO SIZE, SO + MOVEM A,VECSIZ ;DEFAULT MUST BE REMEMBERED FOR .VECTOR. + SUBI A,1 ;1 WORD WAS ALLOCATED BY GETVAL - HOW MANY MORE WANTED? + CAME B,VARCNT ;(MAYBE SYM ALREADY DEFINED, MAYBE PASS2, ...) + ADDM A,VARCNT ;IF GETVAL REALLY ALLOCATED THE SPACE THIS TIME, ALLOCATE THE + JRST A.GLO2 ;RIGHT AMOUNT. + + ;.LOP + +A.LOP: NOVAL ? NOABS + PUSHJ P,EBLK ;TERMINATE CURRENT BLOCK + REPEAT 3,PUSHJ P,RGETFD ;GET THE FIELDS + MOVEI A,LD.OP + PUSHJ P,PLDCN + JRST ASSEM1 + + ;.LIBRQ + +A.LIBRQ: NOVAL ? NOABS +A.LBR1: PUSHJ P,GETSLD + JRST MACCR + PUSHJ P,PBITS7 + MOVEI A,3 + PUSHJ P,PBITS + TLO SYM,40000 + PUSHJ P,OUTSM + JRST A.LBR1 + +A.LNKOT: AOS (P) ;THIS PSEUDO RETURNS NO VALUE. + NOVAL + +AEND5: JUMPGE FF,CPOPJ ;IGNORE FOLLOWING ON NOT PUNCHING PASS + MOVE D,SYMAOB +AEND5A: MOVE SYM,ST(D) + LDB T,[400400,,SYM] + CAIE T,DEFLVR_-14. + CAIN T,DEFGVR_-14. + JRST AEND5E + CAIE T,LCUDF_-14. + CAIN T,GLOEXT_-14. + JRST AEND5B +AEND5C: ADD D,WPSTE1 + AOBJN D,AEND5A + POPJ P, + +AEND5E: 3GET C,D + TLNN C,3LLV + JRST AEND5C +AEND5B: HLLZ B,ST+1(D) + 3GET C,D + TLNN C,3RLNK + JUMPE B,AEND5C + TLZ SYM,740000 + CAIE T,LCUDF_-14. + CAIN T,DEFLVR_-14. + SKIPA + TLO SYM,40000 + PUSHJ P,LKPNRO + HRRZS ST+1(D) ;CLEAR OUT LIST HEAD POINTER. + TLZ C,3RLNK ;INDICATE NO LIST. + 3PUT C,D + JRST AEND5C + + ;PUNCH OUT COMPLETE LOADER COMMAND, PUNCHING OUT WRD AS ONLY CONTENTS + +PLDCM: PUSH P,LINK ;SAVE LINK FOR ALOC AND FRIENDS (CLOBBERS OTHER AC'S) + PUSH P,A ;SAVE LOADER COMMAND TYPE + PUSHJ P,EBLK ;TERMINATE PREV BLOCK, MAKING SURE LOADER KNOWS $. + PUSHJ P,PWRDA ;PUNCH OUT THE WORD + POP P,A ;GET BACK LOADER COMMAND TYPE FOR PLDCN + PUSHJ P,PLDCN ;OUTPUT THE RESULTING BLOCK +PLINKJ: POP P,LINK ;RESTORE LINK + POPJ P, + +PLDCN: HRRM A,BKBUF ;STORE LOADER COMMAND TYPE IN BKBUF HEADER + MOVEI A,LLDCM ;LOADER COMMAND BLOCK TYPE + DPB A,[310700,,BKBUF] ;STORE BLOCK TYPE IN HEADER + TRO FF,FRLOC ;MAKE EBLK OUTPUT BLOCK EVEN IF EMPTY + JRST EBLK + +;.RELP RETURNS RELOCATION OF ARG +A.RELP: CALL AGETFD + MOVE A,B + JRST VALRET + +;.ABSP RETURNS ABSOLUTE PART OF ARG. +A.ABSP: CALL AGETFD + JRST VALRET + +;.RL1 IN RELOCATABLE ASSEMBLY RETURNS ZERO WITH RELOCATION FACTOR ONE. +;IN ABSOLUTE ASSEMBLY, IT RETURNS JUST ZERO. +;IFN <.RELP .RL1>, IS A TEST FOR A RELOCATABLE ASSEMBLY. +A.RL1: SKIPGE A,CONTRL + TRNE A,DECREL\FASL + SKIPA B,[1] + SETZ B, + SETZ A, + RET + +AEND: NOVAL + SKIPE ASMOUT ; ERROR IF IN GROUPING. + JSP LINK,CONFLM ;FLUSH CONSTANTS, GIVE ERROR MSG. + SKIPE SCNDEP ;IF THERE ARE UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS, MENTION THEM. + MOVE A,BKCUR + CAIE A,BKWPB ;NOT IN .MAIN BLOCK => ERROR. + ETR ERRUMB + MOVE A,CDISP + TLNN A,DWRD + TLO FF,FLUNRD ;IF LAST TERM. WAS WORD TERM., RE-READ. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + EXCH A,PNTBP + MOVEM A,LISTTM +] + PUSHJ P,AVARI0 + PUSHJ P,CNSTN0 + SKIPL A,CONTRL + JRST [ PUSHJ P,AEND5 ; STINK RELOCATABLE => .LNKOT + JRST AEND6] + TRNE A,DECSAV ; IF DECSAV FMT, + JRST [ MOVE A,CLOC ; USE LOC COUNTER AT END AS LOC OF SYMBOLS + SKIPN DECSYA ; UNLESS LOC ALREADY SPECIFIED. + MOVEM A,DECSYA + JRST AEND6] + TRNN A,DECREL + JRST AEND6 + MOVE A,CLOC ;IN DEC FMT, UPDATE HIGHEST ADDR SEEN, + SKIPN CRLOC ;UPDATE EITHER THE HIGHEST ABS ADDR + JRST [ CAML A,DECBRA + MOVEM A,DECBRA + JRST AEND6] + CAML A,DECTWO ;OR THE HIGHEST REL ADDR IN THE + JRST [ CAML A,DECBRH ;APPROPRIATE SEG. + MOVEM A,DECBRH + JRST AEND6] + CAML A,DECBRK + MOVEM A,DECBRK +AEND6: JUMPL FF,AEND1 ;ON PUNCHING PASS, SPECIAL STUFF + PUSHJ P,GETWRD ;OTHERWISE EAT UP WORD, + JRST RETURN ;AND RETURN + +AEND1: PUSHJ P,EBLK +IFN LISTSW,[ + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE A,LISTTM + MOVEM A,PNTBP +] + MOVE SYM,[SQUOZE 0,END] + TLZ I,ILWORD + PUSHJ P,AGETWD +IFN LISTSW,[ + MOVEM A,LISTWD + MOVEM B,LSTRLC + SETOM LISTAD + SETOM LISTPF + SKIPE LSTONP + PUSHJ P,PNTR + SKIPE LISTP + PUSHJ P,LPTCLS ;DONE LISTING + MOVE A,LISTWD +] ;END IFN LISTSW, + SKIPL B,CONTRL + JRST AEND3 ;RELOCATABLE +IFN FASLP,[ + TRNE B,FASL + JRST FASEN ;FASL FORM +] + TRNE B,DECSAV + JRST AEND4 + TRNN B,DECREL ;IF DEC FORMAT, + JRST AEND1A + TLNN I,ILWORD ;THEN IF THERE7S A STARTING ADDRESS, + JRST AEND2 + MOVSI A,DECSTA ;OUTPUT START-ADDRESS BLOCK. + PUSHJ P,DECBLK + PUSHJ P,PWRD + PUSHJ P,EBLK + JRST AEND2 + +IFN FASLP,[ +FASEN: JRST AEND2 +] + +AEND3: HRRZ A,CLOC + HRRM A,BKBUF ;SET UP PROGRAM BREAK JUST IN CASE OUTPUTTING MORE NULL DATA BLOCKS + MOVEI A,LCJMP + PUSHJ P,PLDCM + JRST AEND2 + + ; HERE FOR DECSAV FORMAT. +AEND4: TLNE A,-1 + JRST AEND1B ; IF SOMETHING IN LH, MAY BE ENTRY VECTOR. + MOVE B,A + MOVE A,[-1,,120-1] ; NOTHING, SO ASSUME SIMPLE JRST. MUST + PUSHJ P,PPB ; FIRST SAVE S.A. IN .JBSA CROCK. + MOVE A,B + PUSHJ P,PPB + TLO A,(JRST) ; FURNISH JRST FOR PUTTING AT END OF OUTPUT. + JRST AEND1B + +AEND1A: ; CHECK WORD AND MAYBE MAKE IT A JRST + TLNN A,777000 ; CHECK INSTRUCTION PART + TLO A,(JRST) ; WANTS JRST + PUSHJ P,PPB +AEND1B: JUMPG A,.+3 + ETR [ASCIZ /Start instruction negative/] + HRLI A,(JRST) ;END SYMTAB WITH POSITIVE WORD + MOVEM A,STARTA ;SAVE FOR PUNCHOUT AT END OF SYMTAB + PUSHJ P,FEED1 +AEND2: PUSH P,[RETURN] +CNARTP: +IFN DECSW\TNXSW,[ + PUSH P,TTYFLG + SKIPE CCLFLG ;IN DEC VERSION, IF RUN BY CCL, DON'T PRINT + AOS TTYFLG ;THIS STUFF ON THE TTY - ONLY IN ERROR FILE AND LISTING. + CALL CNTPD + REST TTYFLG + RET + +CNTPD: +] + MOVNI D,1 + MOVEI TT,PCNTB +CNTP1: CAML TT,PBCONL + RET + HRRZ B,1(TT) + HLRZ A,1(TT) + CAMN A,B + JRST CNTP2 + AOSN D + TYPR [ASCIZ /Constants area inclusive +From To +/] + LDB B,[.BP (CGBAL),2(TT)] + SKIPE B + TYPR [ASCIZ /Global+/] + HRRZ B,1(TT) + PUSHJ P,OCTPNT + PUSHJ P,TABERR + HLRZ B,1(TT) + SOS B + PUSHJ P,OCTPNT + PUSHJ P,CRRERR +CNTP2: ADDI TT,3 + JRST CNTP1 + +AENDM1: TYPR [ASCIZ /Unterminated successful bracketed conditionals +The first was at /] + AOS A,CONDPN + CALL DPNT + MOVEI A,"- + CALL TYOERR + AOS A,CONDLN + CALL D3PNT2 +IFN TS,[ + TYPR [ASCIZ/ of file /] + MOVE B,CONDFI + CALL SIXTYO +] + JRST CRRERR + +AXWORD: CALL XGETFD ;READ 1ST FIELD, + TLNE I,ILMWRD + CALL IGTXT ;SOAK UP REST OF TEXT PSEUDO. + HRLM A,WRD + HRLM B,WRDRLC + MOVSI C,HFWDF + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + PUSH P,GLSP1 + CALL XGETFD ;NOW THE SECOND FIELD + HRRM A,WRD + HRRES B + ADDM B,WRDRLC + MOVSI C,HFWDF + MOVEI B,0 + POP P,T + PUSHJ P,LINKTC + JRST CABPOP + +A.NTHWD:CALL AGETFD ;READ THE NUMBER OF THE WORD WE WANT. + SOJL A,CABPOP ;NEGATIVE OR 0 => RETURN 0. + SOJL A,A.1STWD ;1 => TURN INTO .1STWD. + ;ELSE SKIP APPRO. # OF WORDS, THEN DO .1STWD. + +A.NTH1: PUSH P,A + PUSH P,WRD + CALL XGETFD + TLZ FF,FLUNRD + REST WRD + REST A + TLNN I,ILMWRD + JRST CABPOP ;IF STRING ENDS BEFORE DESIRED WORD, RETURN 0. + SOJGE A,A.NTH1 + +A.1STWD: CALL XGETFD ;GET THE 1ST WD OF FOLLOWING TEXT PSEUDO, + CALL IGTXT ;THROW AWAY THE REST. + MOVE T,A ;RETURN THE VALUE + JRST TEXT5 ;COMPLAINING IF FOLLOWED IMMEDIATELY BY SYLLABLE. + +A.LENGTH: CALL PASSPS + PUSH P,[0] + PUSH P,A +A.LN1: PUSHJ P,RCH + AOS -1(P) + CAME A,(P) + JRST A.LN1 + SOS T,-1(P) + SUB P,[2,,2] + JRST TEXT5 ;RETURN VALUE IN T + +ARDIX: NOVAL + PUSHJ P,AGETFD ;GET FIELD ARG + MOVEM A,ARADIX + JRST MACCR ;RETURN WITHOUT CLOBBERING CURRENT VALUE + +A.RADIX: CALL AGETFD ;READ THE TEMP. RADIX. + PUSH P,ARADIX ;LAMBDABIND RADIX TO THAT VALUE. + MOVEM A,ARADIX + CALL XGETFD ;READ IN THE NEXT FIELD USING THAT RADIX. + REST ARADIX + JRST VALRET + +;READ A BIT-MASK AS ARG, RETURN THE LH OF BP. FOR THAT BYTE. +A.BP: CALL YGETFD + MOVEI C,SPACE + SKIPE CDISP ;IF ARG WAS ENDED BY A COMMA, TURN IT INTO A SPACE + HRRM C,CDISP ;SO THAT .BP FOO,BAR USES THE FLD SPACE FLD FORMAT. + JUMPE A,VALR1 + PUSH P,A + JFFO A,.+2 + MOVEI B,36. + EXCH B,(P) ;(P) HAS # LEADING ZEROS. + MOVN A,B + AND A,B ;A HAS ONLY THE LOW BIT OF THE BYTE. + JFFO A,.+2 + MOVNI B,1 ;B HAS 35.-<# TRAILING ZREROS.> + MOVEI A,1(B) + SUB A,(P) ;A HAS SIZE OF BYTE + LSH A,30 ;PUT IN S FIELD OF BP. + SUB P,[1,,1] + MOVNS B + ADDI B,35. ;B HAS # TRAILING ZEROS. + DPB B,[360600,,A] ;PUT THAT IN P FIELD OF BP. + JRST VALR1 + +;READ IN BP, RETURN BIT MASK TO SPEC'D BYTE. +;THE ARG SHOULD BE JUST THE LH OF A BP, WHICH MAY BE IN EITHER HALF OF THE ARG. +A.BM: CALL GETBPT ;READ IN A BYTE POINTER ARG, IN A, POINTING AT T. + SETZ T, + SETO C, +A.DPB1: DPB C,A ;PUT 1'S IN SPEC'D PART OF ACCUM T + MOVE A,T + JRST VALRET + +;READ IN A BYTE POINTER (REALLY JUST S AND P FIELDS) AND MAKE POINT AT AC T. +;RETURN IT IN AC A. +GETBPT: CALL YGETFD + TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH. + HRLI A,(A) + TLZ A,77 ;MAKE BP. -> AC T + HRRI A,T + RET + +;RETURN # TRAILING ZEROS IN ARGUMENT. +A.TZ: CALL YGETFD + MOVN B,A + AND A,B ;A HAS JUST LOW BIT OF ARG SET. + JFFO A,.+2 + MOVNI B,1 ;# OF ZEROS BEFORE LOW BIT = + MOVN A,B ;35. - <# TRAILING ZEROS> + ADDI A,35. + JRST VALRET + +;RETURN # LEADING ZEROS IN ARG. +A.LZ: CALL YGETFD + JFFO A,.+2 + MOVEI B,36. + MOVE A,B + JRST VALRET + +;.DPB STUFF,BP,WORD DOES A DPB OF STUFF INTO THE FIELD OF WORD SPEC'D BY BP, +;RETURNING THE RESULTING WORD. +A.DPB: CALL YGETFD ;READ STUFF. + PUSH P,A + CALL GETBPT ;READ BP AND TURN INTO ACTUAL BP POINTING AT T + PUSH P,A + CALL YGETFD ;READ IN WORD AND PUT IN T. + MOVE T,A + REST A ;A HAS BP + REST C ;C HAS STUFF + JRST A.DPB1 ;GO DO THE DEPOSIT AND RETURN THE ALTERED WORD. + +;.LDB BP,WORD RETURNS THE CONTENTS OF THE BYTE IN WORD SELECTED BY BP +A.LDB: CALL GETBPT + PUSH P,A + CALL YGETFD + MOVE T,A + REST A + LDB A,A + JRST VALRET + +;.IBP BP RETURNS AN INCREMENTED BP. +A.IBP: CALL YGETFD + TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH. + HRLZS A + IBP A + JRST VALRET + +AWORD: NOVAL + PUSHJ P,EBLK + PUSHJ P,GETWRD ;ON UNDEFINED SYM, WYB UNDEFINED SYM IN "WORD"? + PUSHJ P,PPB + JRST ASSEM1 + +;.BIND - MAKE SYMS BE DEFINED IN CURRENT (SPEC'D) BLOCK. LH(B) HAS 0. +;.KILL - FULLY KILL THE SYMS.LH(B) HAS 3KILL. +;.HKILL - HALFKILL THEM. LH(B) HAS 3SKILL. +;.XCREF - PREVENT CREFFING OF SYMS. LH(B) HAS 3NCRF. +;.DOWN - SET 3DOWN, MAKING SYM VISIBLE IN SUBBLOCKS IN 1 PASS ASSEMBLY. +A.KILL: NOVAL + HLLZ LINK,B ;REMEMBER BIT TO SET. +A.KIL1: CALL GETSLD ;READ NEXT SYMBOL NAME. + JRST MACCR ;NO MORE, EXIT. + SKIPE LINK ;EXCEPT FOR .BIND, DO NOTHING ON PASS 1. + JUMPGE FF,A.KIL1 + CALL ESDEF ;DEFINE THE SYMBOL, D HAS STE IDX. + JRST A.KIL2 ;SYMBOL NEVER SEEN. + IORM LINK,ST+2(D) ;SET THE BIT IN 3RDWRD.. + IOR C,LINK ;(IF .XCREF, PREVENT CREFFING THIS TIME) +IFN CREFSW,XCT CRFINU ;CREF THE SYMBOL + JRST A.KIL1 + +A.KIL2: MOVSI T,LCUDF ;SYMBOL UNDEFINED, MAKE UNDEF LOCAL. + IOR C,LINK ;WITH THE DESIRED BIT SET. + TLO C,3MACOK ;SHOULDN'T BE ERROR IF IT BECOMES MACRO. + CALL VSM2 +IFN CREFSW,XCT CRFINU + JRST A.KIL1 + +;EXPUNG SYM1,SYM2 ... ;UNDEFINE THOSE SYMS. +AEXPUNG: NOVAL +AEXPU2: PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO MORE NAMES + PUSH P,[AEXPU2] ;AFTER THIS SYM, POPJ TO READ ANOTHER. +;EXPUNGE 1 SYMBOL, SQUOZE IN SYM. +AEXPU1: PUSHJ P,ES + JFCL ;NOT FOUND, DON'T COMPLAIN, JUST CREF. +IFN CREFSW,XCT CRFDEF + HRLZI T,400000 ;EXPUNGED ZERO SYM + SKIPE ST(D) + MOVEM T,ST(D) + SKIPL CONTRL ;IF RELOCATABLE ANDLOCAL SYMBOL, + CAIL A,DEFGVR_-33. + RET + PUSHJ P,PBITS7 ;TELL STINK TO EXPUNGE SYM. + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY IS NEW TYPE RQ, + PUSHJ P,OUTSM0 + MOVSI A,400000 ;NEW NAME NULL => DELETE. + JRST $OUTPT + +;EQUAL SYM1,SYM2 ;DEFINE SYM1 SAME AS SYM2. +AEQUAL: NOVAL + PUSHJ P,GETSLD + ETR ERRTFA + PUSH P,SYM ;REMEMBER SYM NAME AND BLOCK TO DEF. IN. + PUSH P,ESBK + PUSHJ P,GETSLD + ETR ERRTFA +IFN CREFSW,XCT CRFINU ;CREF SYM DEFINED AS. + CALL ES ;LOOK UP SYM TO EQUATE TO. + JRST [ REST ESBK ;NOT FOUND => EXPUNGE THE 1ST SYM. + REST SYM + JRST AEXPU1] + REST ESBK + REST SYM +IFN CREFSW,XCT CRFDEF + PUSH P,A + PUSH P,B ;SAVE INFO ON VALUE OF SYM TO EQUATE TO. + PUSH P,C + CALL ESDEF + MOVEM SYM,ST(D) + REST B ;3RDWRD OF 2ND SYMBOL. + REST ST+1(D) ;(WHAT WAS PUSHED FROM B) + REST A + DPB A,[400400,,ST(D)] + TLZ C,3DFCLR ;SAVE OLD 3MAS, 3NCRF OF 1ST SYMBOL (AND ITS BLOCK #). + AND B,[3DFCLR,,] ;SET REST OF 3RDWRD BITS FROM 2ND SYMBOL. + IOR B,C + 3PUT B,D + JRST MACCR + +ERRTFA: ASCIZ /Too few args - EQUAL/ + +;.SEE SYM1,SYM2,... ;CREF THOSE SYMS. +A.SEE: CALL GETSLD ;READ 1 SYMBOL. + JRST MACCR ;NONE TO BE READ. +IFN CREFSW,[ + SKIPN CRFONP ;IF CREFFING, + JRST A.SEE + CALL ES + MOVEI A,SYMC_-33. + XCT CRFINU ;CREF THE SYMBOL. +] + JRST A.SEE + +;UUO HANDLING ROUTINE +;41 HAS JSR ERROR + +VBLK +ERRCNT: 0 ; NUMBER OF ERRORS HIT -- VALUE OF .ERRCNT +ERRCCT: 0 ;NUM CHARS OUTPUT ON LINE, FOR MAKING MSGS LINE UP. +ERRJPC: 0 ;JPC READ WHEN UUO. +ERROR: 0 +IFN ITSSW, .SUSET [.RJPC,,ERRJPC] + JRST ERRH ;GO HANDLE IT +PBLK +ERRH: PUSH P,T + PUSH P,B ;NOT TYPR => ERROR OF SOME KIND + PUSH P,A + PUSH P,C + LDB T,[331100,,40] ;PICK UP OP CODE + CAIN T,TYPCR_-33 ; TYPCR? + JRST TYPCR1 + CAIN T,TYPR_-33 ; OR TYPR? + JRST TYPR1 ; YES + ;ERROR OF SOME KIND + CAIE T,ETASM_-33 ;CHECK FOR SPECIAL LOSSAGES AT COLON + CAIN T,ETSM_-33 + CAME SYM,SYSYM ;ARE WE ABOUT TO MENTIO THIS LOSING LABEL AS THE LAST ONE? + JRST ERRH1 + MOVE T,SYSYM1 + + MOVEM T,SYSYM ;COLON LOSSAGE, DE-MUNG TAG WORDS FOR PRINTOUT + MOVE T,SYLOC1 + MOVEM T,SYLOC +ERRH1: +IFN TS,[ +IFN LISTSW,[ + CALL PNTR ;FORCE OUT BUFFERED LISTING OUTPUT + CALL PNTCRR ;AND CR, SO USER CAN SEE WHERE ERROR WAS. +] + PUSHJ P,ERRTFL ;IF NOT SAME FILE AS LAST, PRINT FILE NAME. +] + SETZM ERRCCT + AOS ERRCNT ; BUMP ERROR TOTAL +IFN DECSW,AOS .JBERR ; BUMP ERROR MESSAGE COUNTER FOR LOADER TO ABORT + MOVE A,SYSYM ;GET LAST TAG DEFINED + JUMPE A,ERR1 ;SKIP PRINTOUT IF NONE THERE + PUSHJ P,SYMTYP ;THERE, TYPE IT OUT + MOVE B,CLOC ;NOW GET CURRENT LOCATION + SUB B,SYLOC ;SUBTRACT VALUE OF LAST TAG + JUMPE B,ERR1 ;SKIP NUMERIC PRINTOUT IF RIGHT AT TAG + MOVEI A,"+ ;NOT AT TAG, + PUSHJ P,TYOERR ;TYPE OUT PLUS SIGN, + AOS ERRCCT ;(1 MORE CHAR TYPED) + PUSHJ P,OCTPNT ;THEN TYPE OUT DIFFERENCE IN OCTAL +ERR1: PUSHJ P,TABERR ;NOW SEPARATE WITH TAB + MOVE A,ERRCCT + CAIGE A,8 ;MAKE SURE MOVE TO COLUMN 16. + PUSHJ P,TABERR + MOVEI B,[ASCIZ/GL+/] + SKIPGE GLOCTP ;LOCATION GLOBAL? + PUSHJ P,TYPR3 ;YES, TYPE OUT THAT FACT. + MOVE B,CLOC ;GET CURRENT LOCATION + PUSHJ P,OCTPNT ;TYPE OUT IN OCTAL +;DROPS THROUGH + +;DROPS THROUGH. + PUSHJ P,TABERR + MOVE A,MDEPTH ;NOW DEPTH IN MACRO (NOT IRP, REPEAT, ETC.) EXPANSIONS + MOVSI T,-2 + CALL DPNT0 ;PRINT, IN 2-CHAR FIELD. + MOVEI A,". + CALL TYOERR ;(USED TO BE OCTAL) + MOVE A,CPGN ;CURRENT PAGE NUMBER (FIRST PAGE OF FILE => 0) + PUSHJ P,[AOJA A,D6PNT] ;TYPE IT OUT IN DECIMAL + MOVEI A,"- + CALL TYOERR + MOVE A,CLNN ;ALSO CURRENT LINE NUMBER + PUSHJ P,[AOJA A,D3PNT2] + PUSHJ P,TABERR + MOVEI A,48. ;ASSUME ALL THE STUFF WE'VE PRINTED TAKES 48. CHARS + MOVEM A,ERRCCT ;MAYBE SOMEDAY TABERR, ETC. WILL REALLY UPDATE ERRCCT PROPERLY. + LDB A,[331100,,40] ;PICK UP OP CODE AGAIN + CAIGE A,8 ;ERROR UUO MAX + JRST .+1(A) + JRST [HALT ? JRST .-1] ;OPCODE 0, OR TOO BIG. + JRST ERRSM ;ETSM => TYPE SYM AND MESSAGE. + JRST ERRR ;ETR => JUST PRINT MESSAGE + JRST ERRJ ;ERJ => RH(40) HAS JUMP ADR + JRST ERRI ;ETI => IGNORE LINE RET TO ASSEM1 + JRST ERRA ;ETA => RET TO ASSEM1 + JRST ERRASM ;ETASM => TYPE SYM AND GO TO ASSEM1 + JRST IAE ;ERF => FATAL. + +ERRJ: MOVE A,40 ;ERJ => RH(40) HAS JUMP ADR + HRRM A,ERROR + JRST ERRET1 + +ERRI: PUSHJ P,RCH ;ETI => IGNORE LINE, RETURN TO ASSEM1: EAT UP LINE + CAIE A,12 + JRST .-2 +ERRA: MOVEI A,ASSEM1 ;ETA => RETURN TO ASSEM1, DON'T TYPE SYM. + MOVEM A,ERROR + JRST ERRR + +ERRASM: MOVEI A,ASSEM1 ;ETASM => TYPE SYM AND RETURN TO ASSEM1 + MOVEM A,ERROR +ERRSM: MOVEI C,56. ;ETSM OR ETASM => TYPE OUT SYM THEN MESSAGE + CALL TYPE37 ;CR NOW IF WHOLE MSG WON'T FIT ON ONE LINE. + MOVE A,SYM + PUSHJ P,SYMTYP + PUSHJ P,TABERR +ERRR: CALL TYPE40 ;TYPE THE ERROR MESSAGE. +ERRET1: REST C + POP P,A ;COMMON RETURN POINT FROM UUOS + POP P,B + POP P,T + JRST 2,@ERROR + +;FINISH UP AN ERROR UUO'S ERROR MESSAGE. PRINT THE SPECIFIED STRING +;AND ALSO "IN DEFINE AT ..." IF NECESSARY, ALONG WITH APPROPRIATE CR'S. +TYPE40: MOVE C,ERRCCT + CALL TYPE37 + CALL TYPR4 ;PRINT THE ASCIZ STRING + CALL CRRERR + SKIPN A,DEFNPS ;IF INSIDE A LONG PSEUDO, + RET + MOVE A,DEFNLN + MOVE B,DEFNPN + CAMN A,CLNN ;WHICH DIDN'T START IN THIS VERY LINE, + CAME B,CPGN + JRST TYPE42 + MOVE A,DEFNFI + CAMN A,INFFN1 + JRST TYPE43 +TYPE42: MOVEI B,[ASCIZ/ in /] + CALL TYPR3 + MOVE A,DEFNPS + CALL SYMTYP ;SAY WHAT PSEUDO, AND WHERE IT STARTED. + MOVEI B,[ASCIZ/ Starting at /] + CALL TYPR3 + MOVE A,DEFNPN ;PAGE # -1. + CALL [AOJA A,DPNT] ;PRINT PAGE #. + MOVEI A,"- + CALL TYOERR + AOS A,DEFNLN + CALL D3PNT2 ;PRINT LINE #. +IFN TS,[ + MOVE B,DEFNFI ;PRINT FILE NAME IF IT ISN'T THE CURRENT FILE. + CAMN B,INFFN1 + JRST TYPE41 + MOVEI B,[ASCIZ/ of file /] + CALL TYPR3 + MOVE B,DEFNFI + CALL SIXTYO +] +TYPE41: CALL CRRERR ;AND CRLF. +TYPE43: MOVE A,ERROR + CAIN A,ASSEM1 ;IF THIS ERROR IS EXITING THE PSEUDO, + SETZM DEFNPS ;SAY WE'RE NOT IN IT ANY MORE. + RET + +;JSP TM,ERMARK IN A PSEUDO, TO ARRANGE FOR ERROR MESSAGES TO MENTION +;THAT PSEUDO. SYM SHOULD CONTAIN THE NAME OF THE PSEUDO. +;PUSHES A WORD ON THE STACK SO THAT WHEN THE PSEUDO RETURNS DEFNPS WILL BE CLEARED. +;IF DEFNPS IS SET UP ALREADY, DOES NOTHING (DOESN'T SET DEFNPS; DOESN'T PUSH THE WORD) +ERMARK: SKIPE DEFNPS + JRST (TM) + MOVEM SYM,DEFNPS + MOVE SYM,CLNN + MOVEM SYM,DEFNLN + MOVE SYM,CPGN + MOVEM SYM,DEFNPN + MOVE SYM,INFFN1 + MOVEM SYM,DEFNFI + MOVE SYM,DEFNPS + CALL (TM) + CAIA + AOS (P) + SETZM DEFNPS + RET + +;C SHOULD HAVE CURRENT HORIZ POS. IF TYPING THE STRING 40 POINTS AT +;WOULD OVERFLOW THE LINE, TYPE A CRLF AND TAB NOW ON THE TTY ONLY. +TYPE37: HRRZ B,40 + HRLI B,440700 ;FIRST, FIGURE OUT HOW FAR ON LINE WE'LL TYPE IF WE DON'T CR. + ILDB A,B + CAIE A, ;AND COUNT CHARS IN THE ERR MSG. + AOJA C,.-2 + CAMGE C,LINEL + RET +CRRTBX: MOVEI A,10 + MOVEM A,ERRCCT ;PREVENT THIS FROM BEING DONE TWICE. + SKIPE TTYFLG + RET + MOVEI A,^M ;IF THERE'S NO ROOM, CRLF ON THE TTY ONLY (NOT THE ERR FILE). + PUSHJ P,TYOX + MOVEI A,^J + PUSHJ P,TYOX + MOVEI A,^I + JRST TYOX + + ;TYPE OUT SQUOZE (FLAGS OFF) IN A + +SYMTYP: PUSHJ P,SQCCV ;GET NEXT CHAR IN ASCII. + AOS ERRCCT + PUSHJ P,TYOERR ;TYPE IT OUT. + JUMPE B,CPOPJ ;RETURN IF NOTHING LEFT (TYPED OUT AT LEAST ONE CHAR THOUGH) + IMULI B,50 ;LEFT-JUSTIFY REMAINDER + MOVE A,B ;GET LEFT-JUSTIFIED REMAINDER IN A + JRST SYMTYP ;TYPE OUT REMAINDER OF SYM + + ;TYPE OUT SQUOZE CHARACTER (IN A) + +SQCCV: IDIV A,[50*50*50*50*50] + CAIG A,10. + SOJA A,SQCDTO ;NUMBER (OR BLANK =>SLASH) + CAIL A,45 + SKIPA A,SYTB-45(A) ;SPECIAL + ADDI A,"A-13 ;LETTER + POPJ P, + +SQCDTO: ADDI A,"0 + POPJ P, + +SYTB: ". + "$ + "% + +D3PNT2: MOVE T,[-3,,400000] ;3 CHAR FIELD, NO ZERO SUPPRESSION. + JRST DPNT0 + +DPNT: TDZA T,T ;ORDINARY DECIMAL PRINT. +D6PNT: MOVSI T,-6 ;6 CHAR FIELD, ZERO SUPPRESSION. +DPNT0: IDIVI A,10. + HRLM B,(P) + TRNE T,377777 ;IF NOT LAST DIGIT, + TRNE T,400000 ;AND ZERO-SUPPR. WANTED, + JRST DPNT2 + JUMPN A,DPNT2 ;IF THIS IS A LEADING 0, + JUMPN B,DPNT2 + MOVEI B," -"0 + HRLM B,(P) ;REPLACE WITH A SPACE. +DPNT2: AOBJN T,.+2 ;J IF NOT ENOUGH CHARS YET. + JUMPE A,DPNT1 ;ENOUGH, DON'T MAKE MORE IF NOT NEEDED. + CALL DPNT0 + JRST DPNT1 + +;TYPE HALFWORD IN B IN OCTAL. +OCTPNT: HRRZ A,B + IDIVI A,10 + HRLM B,(P) + JUMPE A,.+2 + PUSHJ P,.-3 + AOS ERRCCT +DPNT1: HLRZ A,(P) +ADGTYO: ADDI A,"0 + JRST TYOERR + +;TYPE OUT THE SIXBIT WORD IN B + +SIXTYO: JUMPE B,CPOPJ + MOVEI A,0 + ROTC A,6 + ADDI A,40 + PUSHJ P,TYOERR + JRST SIXTYO + + ;TYPE CRLF + +CRR: MOVEI A,15 + PUSHJ P,TYO + MOVEI A,12 + JRST TYO + +;OP CODE 0 => NO RECOVERY RETURN TO GO9 +IAE: CALL TYPE40 ;PRINT THE ERROR MESSAGE. + SKIPE ASMOUT + JSP LINK,CONFLZ ;TELL USER ABOUT UNTERM. GROUPINGS. + SKIPE SCNDEP ;MENTION ANY UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS. + MOVEI B,[ASCIZ /Error is fatal. +/] + CALL TYPR3 +IFN ITSSW,[ + .SUSET [.RTTY,,A] + SKIPL A + .RESET TYIC, +] + JRST GO9 + + ;TYPR [ASCIZ /STRING/] ;TYPE OUT STRING + +TYPR1: PUSH P,[ERRET1] +TYPR4: HRRZ B,40 ;GET ADR OF BEGINNING OF STRING +TYPR3: HRLI B,440700 ;CONVERT TO BYTE POINTER +TYPR2: ILDB A,B ;GET NEXT CHAR + JUMPE A,CPOPJ ;JUMP IF ZERO, END OF STRING + PUSHJ P,TYOERR ;NON-ZERO, TYPE IT OUT + JRST TYPR2 + + ; TYPCR [ASCIZ /STRING/] ; Type out string, followed by CRLF + +TYPCR1: PUSH P,[ERRET1] + PUSHJ P,TYPR4 ; When done, fall thru. + +CRRERR: MOVEI A,^M ;CRLF IN ERROR MESSAGE. + CALL TYOERR + SKIPA A,[^J] +TABERR: MOVEI A,^I ;TAB INN ERROR MESSAGE. +TYOERR: +IFN LISTSW,[ + SKIPE LSTTTY ;OUTPUT TO LISTING UNLESS LSTTTY ZERO. + CALL PILPTX +] + SKIPG LSTTTY + JRST TYO ;TO TTY UNLESS LSTTTY POSITIVE. + RET + +;OUTPUT-FORMAT SELECTING PSEUDOS: + +;.SLDR -- ON PASS 2, PUNCH OUT SBLK LOADER AND SELECT SBLK FORMAT +A.SLDR: NOVAL + JUMPGE FF,MACCR ;DO NOTHING ON PASS 1. + PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE FIRST + PUSHJ P,PLOD1A ;PUNCH OUT LOADER +SIMBLK: MOVSI B,SBLKS ;ENTRY FROM PS1, A.SLDR SELECT SBLK + JRST SIMBL1 + +SRIM: MOVE A,SYM ;ENTRY FROM GETVAL, LH(B) HAS RH(CONTRL) + PUSH P,B + CALL SYMTYP + TYPR [ASCIZ/ Encountered +/] + REST B +SIMBL1: TRO FF,FRNPSS + HRRI B,TRIV ;SET UP TRIV FLAG FOR LH(CONTRL) + MOVSS B + CAME B,CONTRL ;IF CHANGING MODES, END THE BLOCK IN THE OLD MODE + CALL EBLK + MOVE A,CONTRL ;IF OLD MODE WAS RELOCATABLE OF SOME KIND, + TRNN A,DECREL\FASL + JUMPL A,SIMBL2 + SETZM CRLOC ;INITIALIZE LOCATION COUNTER. + MOVEI A,100 ; USE 100 ASSUMING ITS SBLK + TRNE B,DECSAV + MOVEI A,140 ; BUT USE 140 FOR DEC ABS. + MOVEM A,CLOC +SIMBL2: MOVEM B,CONTRL ;STORE NEW MODE. + TRNE B,ARIM\ARIM10 + TRZ F,FRSYMS ;RIM AND RIM10 MODES IMPLY NO SYMBOLS. + AOS (P) + + ;ROUTINE TO SET VARIABLES FOR BENEFIT OF NED LOGIC + ;CALLED BY OUTPUT SELECTING PSEUDOS +OUTUPD: NOVAL +IFN A1PSW,[ + TRNE FF,FRNPSS ;IF PASS 1, + TLNN FF,$FLOUT + JRST OUTCHK + AOS OUTN1 ;INDICATE "OUTPUT" HAS OCCURED OTHER THAN IN 1PASS MODE +OUTCHK: TLZE FF,$FLOUT + AOS OUTC ;INDICATE "OUTPUT" HAS OCCURED DURING CURRENT ASSEMBLY +] + RET + +ANOSYMS: NOVAL + TRZ FF,FRSYMS + JRST MACCR + +A1PASS: PUSHJ P,OUTUPD +A1PAS1: TLO FF,FLPPSS + MOVEIM A.PPASS,1 ;SET .PPASS TO 1. +IFN CREFSW,[ SKIPE CREFP ;THIS NOW PUNCHING PASS, + PUSHJ P,CRFON ;MAYBE TURN ON CREFFING. +] +IFN LISTSW,[ + SKIPE LISTP + CALL LSTON ;LIST NOW IF WANT LISTING AT ALL. +] + MOVE A,CONTRL + TRNE A,DECREL + CALL DECPGN + TRZA FF,FRNPSS +ARELOC: PUSHJ P,OUTUPD +ARELC1: PUSHJ P,EBLK ;FINISH CURRENT OUTPUT BLOCK + TRO FF,FRLOC ;DOING LOCATION ASSIGNMENT, MAKE SURE NEXT GETS OUTPUT + CLEARM CLOC + MOVEI A,1 + MOVEM A,CRLOC + CLEARM CONTRL + SETZM BKBUF + MOVEI A,LREL + DPB A,[310700,,BKBUF] + MOVEM A,CDATBC + JRST MACCR + + + ; .DECSAV - SELECT DEC ABSOLUTE ZERO-COMPRESSED (SAV) FORMAT +A.DECSAV: NOVAL + MOVSI B,DECSAV ; SET FLAG + JRST SIMBL1 ; THEN HANDLE ALMOST LIKE .SBLK + + +A.DECTWO: CALL AGETFD ;READ THE TWOSEG ORIGIN. + TRNN FF,FRNPSS + ETF [ASCIZ /.DECTWO follows 1PASS/] + MOVE C,ISAV + TRNN C,IRFLD ;NO ARG => DEFAULT IT TO 400000 + MOVEI A,400000 + MOVEM A,DECTWO + +A.DECREL: PUSHJ P,OUTUPD + TRZ FF,FRLOC + PUSHJ P,EBLK ;FORCE OUT BLOCK IN OTHER FMT. + MOVE A,[SETZ DECREL] + CAME A,CONTRL ;SWITCHING TO .DECREL MODE FOR 1ST TIME + TRNE FF,FRNPSS ;IN A 1PASS ASSEMBLY + JRST A.FAS1 + CALL A.FAS1 ;DO THE SWITCH + JFCL + CALL DECPGN ;THEN WRITE THE PROGRAM NAME + JRST MACCR + +A.FAS1: MOVEM A,CONTRL ;DEC FMT COUNTS AS ABS ASSEMBLY. + SETZM BKBUF ;(SO EBLK W0N'T OUTPUT ANYTHING) + SETZM CLOC ;START ASSEMBLING FROM RELOCATABLE 0. + MOVEI A,1 + MOVEM A,CRLOC + PUSHJ P,EBLK ;INITIALIZE AN ORDINARY (DECWDS) BLOCK. + JRST MACCR + +IFN FASLP,[ +A.FASL: PUSHJ P,OUTUPD + PUSHJ P,EBLK + MOVE A,[SETZ FASL] ;FASL ALSO COUNTS AS ABS + JRST A.FAS1 +] + +ATITLE: NOVAL + PUSH P,CASSM1 ;RETURN TO ASSEM1. + PUSHJ P,GSYL + SKIPE SYM + MOVEM SYM,PRGNM + MOVE T,[440700,,STRSTO] +ATIT2: ILDB A,T ;GET CHAR FROM TITLE STRING + SOSG STRCNT + JRST ATIT3 ;CHAR IS SYLLABLE TERMINATOR +IFE ITSSW,[ + SKIPE CCLFLG + TRNN FF,FRPSS2 +] + PUSHJ P,TYO ;NOT TERMINATOR, TYPE OUT AND LOOP BACK + JRST ATIT2 + +ATIT3: CALL ATIT1 ;PRINT THE REST OF THIS LINE. + MOVE A,CONTRL + TRNE A,DECREL + TRNE FF,FRNPSS + CAIA + ETF [ASCIZ /TITLE follows 1PASS/] + MOVE A,TTYINS + ADD A,A.PASS ;SHOULD WE .INSRT TTY: THIS PASS (T SWITCH) + JUMPG A,CPOPJ +IFDEF GTYIPA,JRST GTYIPA ;GO PUSH TO TTY IF CAN, +IFNDEF GTYIPA,HALT ;WHY DID YOU SET TTYINS IF CAN'T? + +ATIT1: CAIE A,15 ;CR? + CAIN A,12 ;LF? +IFN ITSSW,JRST CRR ;ONE OF THESE, FINISH TYPEOUT WITH CR +.ELSE [ JRST [ SKIPE CCLFLG + TRNN FF,FRPSS2 + JRST CRR + RET] + SKIPE CCLFLG ;NEITHER OF THESE, PRINT CHAR. + TRNN FF,FRPSS2 ;ON DEC SYS, DON'T PRINT THE TITLE ON P2, OR AT ALL IF RUN BY CCL. +] + PUSHJ P,TYO +A.ERR1: PUSHJ P,RCH ;GET NEXT CHAR IN TITLE + JRST ATIT1 + +;.ERR PSEUDO-OP -- FOLLOWED BY LINE WHICH IS ERROR MSG. +A.ERR: PUSH P,CASSM1 ;RETURN TO ASSEM1, + ERJ A.ERR1 ;AFTER NUMBERS AND USER'S STRING. + +A.FATAL:PUSH P,[GO9] ;.FATAL - CAUSE A FATAL ERROR. + ERJ A.ERR1 + +APRINT: NOVAL + HLRZS B ;B SAYS WHETHER PRINTX, PRINTC OR COMMENT. + JSP TM,ERMARK + CALL PASSPS + MOVE T,A +APRIN1: PUSHJ P,RCH + CAME A,T + JRST (B) ;GO TO APRIN1 FOR COMMENT, + JRST MACCR + +APRIN2: CAIE A,"! ;COME HERE FOR PRINTX +APRIN3: PUSHJ P,TYO ;HERE FOR PRINTC + JRST APRIN1 + +A.TYO: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A CHARACTER (AS NUMERIC ARG). + CALL TYOERR + JRST MACCR + +A.TYO6: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A WORD OF SIXBIT. + MOVE B,A + CALL SIXTYO + JRST MACCR + +;.BEGIN - START NEW BLOCK WITH NAME = ARG, OR LAST LABEL DEFINED. +A.BEGIN: NOVAL + SKIPE ASMOUT ;IF IN GROUPING, FLUSH IT & ERROR. + JSP LINK,CONFLM + PUSHJ P,GETSLD ;READ A NAME. + MOVE SYM,SYSYM ;NO ARG, USE NAME OF LAST LABEL. + MOVE A,SYM ;NAME TO USE FOR BLOCK. + MOVE B,BKLVL ;CURRENT LEVEL + 1 + HRLZI B,1(B) ;IS LEVEL OF NEW BLOCK. + HRR B,BKCUR ;ITS SUPERIOR IS CURRENT BLOCK. + MOVEI C,0 ;SEE IF AN ENTRY EXISTS FOR THIS BLOCK. + MOVE AA,A.PASS +A.BEG0: CAMN A,BKTAB(C) + CAME B,BKTAB+1(C) + JRST A.BEG1 ;THIS ENTRY ISN'T FOR BLOCK BEING ENTERED. + TDNE AA,BKTAB+2(C) ;FOUND: DEFINED IN THIS PASS? + ETSM [ASCIZ /Multiply defined BLOCK/] + JRST A.BEG2 ;NO, SAY IT'S DEFINED. + +A.BEG1: ADDI C,BKWPB ;LOOK THRU ALL ENTRIES. + CAMGE C,BKTABP + JRST A.BEG0 + CAIL C,BKTABS ;ALL ENTRIES USED => ERROR. + ETF ERRTMB + MOVEM A,BKTAB(C) ;ALLOCATE NEW ENTRY + MOVEM B,BKTAB+1(C) ;STORE NAME, LEVEL, SUPPRO. + MOVEI A,BKWPB(C) + MOVEM A,BKTABP ;POINTS TO 1ST UNUSED ENTRY. +A.BEG2: IORM AA,BKTAB+2(C) ;INDICATE BLOCK SEEN THIS PASS. + MOVEM C,BKCUR ;NEW BLOCK NOW CURRENT BLOCK, + AOS A,BKLVL ;ITS LEVEL NOW CURRENT LEVEL, + CAIL A,BKPDLS ;PUSH IT ON BLOCK PDL + ETF [ASCIZ /.BEGIN nesting too deep/] + MOVEM C,BKPDL(A) + JRST ASSEM1 + +ERRTMB: ASCIZ /Too many symbol blocks/ +ERRUMB: ASCIZ /Unmatched .BEGIN - .END/ + +;.END - POP CURRENT BLOCK. +A.END: NOVAL + SKIPE ASMOUT ;IN GROUPING => TERMINATE IT & ERROR. + JSP LINK,CONFLM + MOVE A,CDISP ;IF FOLLOWED BY WORD TERM, + TLNN A,DWRD ;CAUSE IT TO BE RE-READ + TLO FF,FLUNRD ;SO ARG WILL BE NULL. + PUSHJ P,GETSLD ;READ ARG. + JRST A.END0 ;NO ARG. + MOVE C,BKCUR ;ERROR UNLESS BLOCK BEING TERMINATED + MOVE A,BKTAB(C) ;HAS SAME NAME AS ARG. + EXCH A,SYM ;(MAKE SURE SYM NAME TYPED IS BLOCK'S NAME) + CAME A,SYM + ETSM ERRUMB ;ERROR, PRINT SYM (BLOCK'S NAME) +A.END0: MOVE C,BKCUR ;NOT OK TO END .MAIN BLOCK OR .INIT BLOCK. + CAIG C,BKWPB + ETA ERRUMB + HRRZ C,BKTAB+1(C) + MOVEM C,BKCUR ;POP INTO FATHER OF PREV. CURRENT BLOCK. + SOS BKLVL + JRST ASSEM1 + +;BKTAB: 3-WORD ENTRIES, 1 PER BLOCK, IN NO PARTICULAR ORDER. +;1ST WD HAS SQUOZE NAME OF BLOCK, FLAGS CLEAR. +;2ND WD HAS LEVEL,,BKTAB IDX OF CONTAINING BLOCK("FATHER", "SUPERIOR") +;3RD WD BIT 1.N ON => BLOCK ENTERED ON PASS N. +;SYMBOL TABLE OUTPUT RTN PUTS -2* IN 3RD WD. +;THE FIRST BKTAB ENTRY IS THAT OF THE OUTERMOST BLOCK (.INIT) +;IN WHICH INITIAL SYMS ARE DEFINED. +;THAT ENTRY'S 2ND AND 3RD WDS ARE 0. +;THE NEXT IS THAT OF THE MAIN BLOCK (.MAIN) IN WHICH +;ALL SYMBOLS ARE NORMALLY DEFINED (THAT IS, YOU ARE IN THAT BLOCK +;BEFORE YOU DO ANY .BEGIN'S). +;THAT ENTRY'S 2ND WD IS 1,, ; ITS 3RD, 0. + +;THE BKPDL IS A TABLE OF BLOCKS CURRENTLY ENTERED & NOT ENDED. +;BKPDL'S 1ST ENTRY IS FOR OUTERMOST BLOCK. +;LAST ENTRY IS BKPDL+@BKLVL, FOR CURRENT BLOCK. + +BKTABS==BKTABL*BKWPB + +VBLK +BLCODE [ +BKTAB: BLOCK 3 ;ENTRY FOR .INIT BLOCK. +PRGNM: BLOCK BKTABS-BKWPB ;PROGRAM NAME IS NAME OF MAIN BLOCK. +] +BKTABP: 0 ;IDX IN BKTAB OF 1ST UNUSED ENTRY. +BKPDL: BLOCK BKPDLS ;TABLE OF BLOCKS STARTED, NOT FINISHED. +BKLVL: 0 ;CURRENT BLOCK LEVEL, IDX OF LAST USED IN BKPDL. +BKCUR: 0 ;BKTAB IDX OF CURRENT BLOCK. +ESBK: 0 ;-1 OR BLOCK TO EVAL SYM. IN. +ESL1: 0 ;IN ES, LEVEL OF BLOCK OF BEST SYM SO FAR. +ESL2: 0 ;3RDWRD OF BEST SO FAR. +SADR: 0 ;SYM TAB IDX OF BEST SO FAR. +ESLAST: 0 ;RH IDX OF LAST DEF (EVEN IF NO GOOD) -1 IF NONE + ;SIGN NEG. IF LAST DEF SEEN BEFORE @ESXPUN +ESXPUN: -1 ;IF SEE EXPUNGED OR FREE ENTRY, PUT IDX HERE. +BKTAB1: BLOCK BKTABL ;USED BY SSYMD. +PBLK + +;.SYMTAB ARG ;SAY WANT AT LEAST ARG STE'S IN SYMTAB. +A.SYMTAB: NOVAL + PUSH P,[0] ;THIS WORD WILL BE SETOM'ED IF THERE IS REALLY ANY WORK NEEDED. + PUSHJ P,AGETFD ;GET DESIRED SYM TAB SIZE. + CAMG A,SYMLEN ;IF HAVE ENOGH ROOM ALREADY, + JRST A.SYM1 ;NO NEED TO RE-INIT. + CAILE A,SYMMAX ;IF WANTS MORE THAN MAXIMUM, ERROR. + ETF [ASCIZ/.SYMTAB 1st arg too big/] + MOVEM A,SYMLEN ;TELL INITS ABOUT NEW SIZE. + SETOM (P) +A.SYM1: CALL AGETFD ;READ DESIRED CONSTANTS TABLE SPACE ALLOCATION. + CAMG A,CONLEN ;IF TABLE ALREADY BUG ENOUGH, NOTHING TO DO. + JRST A.SYM2 + CAILE A,CONMAX + ETF [ASCIZ/.SYMTAB 2nd arg too big/] + MOVEM A,CONLEN ;ELSE REMEMBER IT AND SAY REALLOCATION NECESSARY. + SETOM (P) +A.SYM2: CALL AGETFD ;3RD ARG IS # WORDS PER SYMBOL - BUT ONLY 3 IS ALLOWED NOW. + JUMPE A,A.SYM3 ;EVENTUALLY 4 WILL GET 12-CHARACTER SYMBOLS. + CAIL A,MINWPS + CAILE A,MAXWPS + ETF [ASCIZ/.SYMTAB 3rd arg out of range/] + CAME A,WPSTE + SETOM (P) + MOVEM A,WPSTE +A.SYM3: REST A ;IS THERE ANYTHING THAT ACTUALLY NEEDS TO BE CHANGED? + JUMPE A,ASSEM1 ;IF NOT, NEVER GIVE ERROR - ELSE WOULD ALWAYS LOSE ON PASS 2. + MOVE B,PLIM + CAMN B,CONTBA ;IF THERE HAVE BEEN ANY LITERALS + SKIPE INICLB ;OR ANY MACROS, IRPS, REPEATS, ETC., THEN ... + ETF [ASCIZ/Too late to do .SYMTAB/] + MOVE CH1,MACTAD ;SET UP AC -> START OF INIT CODE + SUBI CH1,MACTBA ;SO IT CAN REFER TO ITSELF. + PUSHJ P,INITS(CH1) ;RE-INIT, SET SYMSIZ, SYMAOB, ETC. + PUSHJ P,MACINI ;INIT PTRS TO END OF MACTAB. + JRST ASSEM1 + +A.OP: PUSHJ P,A.OP1 ;.OP, + JRST VALRET ;RETURNS VALUE + +A.AOP: NOVAL + AOS (P) ;.AOP DOESN'T RETURN VALUE +A.OP1: PUSHJ P,AGETFD + PUSH P,A + PUSHJ P,AGETFD + PUSH P,A ;PDL NOW HAS FIELD 0 AND FIELD 1 + PUSHJ P,AGETFD + POP P,B ;B NOW HAS FIELD 1, A HAS FIELD 2, PDL HAS FIELD 0 + EXCH A,B + POP P,T ;T HAS FIELD 0, A HAS FIELD 1, B HAS FIELD 2 + TLNN T,(0 17,) ;IF AC FIELD NOT PRESENT IN INSN, SUPPLY ONE. + TLO T,(0 A,) + TDNN T,[0 -1(17)] ;IF NO ADDR OR IDX FIELD IN INSTRUCTION, + HRRI T,B ;SUPPLY ONE. + SETOM A.ASKIP' ;.ASKIP WILL BE -1 IFF INSN SKIPPED, ELSE 0. + TLNE T,74000 ;AVOID EXECUTING OPCODE ZERO. + XCT T + SETZM A.ASKIP + MOVEM A,AVAL1' ;STORE C(AC) AS .AVAL1 + MOVEM B,AVAL2' ;STORE C(E) FOR .AVAL2 + POPJ P, ;RETURN TO WHATEVER + +AASCIZ: TDZA T,T +A.ASCII: MOVEI T,1 + MOVEM T,AASCF1 ;STORE TYPE + MOVE D,[440700,,T] + SETZM AASCFT + JRST AASC1 + +AASCII: SKIPA D,[440700,,T] +ASIXBI: MOVE D,[440600,,T] + SETZM AASCFT ;INDICATE NOT .DECTXT + SETOM AASCF1 ;INDICATE REGULAR (NOT ASCIZ) + JRST AASC1 + +A.DCTX: NOVAL + MOVE A,CONTRL + TRNN A,DECREL + ETA [ASCIZ /.DECTXT in non-DECREL assembly/] + CALL EBLK + SETZ B, + SETOM AASCFT + SETOM AASCF1 ;INDICATE ASCIZ-STYLE PADDING + MOVE D,[440700,,T] +AASC1: TLZE I,ILMWRD + JRST TEXT2 ;MULTIPLE WORD, FALL IN FOR NEXT SET OF CHARS + MOVEMM ASMDS1,ASMDSP + MOVEM SYM,DEFNPS ;REMEMBER LOCATION IN FILE OF PSEUDO + MOVEMM DEFNLN,CLNN ;IN CASE THE DELIMITER IS MISSING. + MOVEMM DEFNPN,CPGN +IFN TS, MOVEMM DEFNFI,INFFN1 + HLRZ T,B ;GET FILL CHARACTER + IMUL T,[REPEAT 5,[1_<.RPCNT*7>+]0] ;CONVERT TO ASCII FILL WORD SHIFTED -1 (IMUL SCREW) + LSH T,1 ;SHIFT TO PROPER POSITION (EXTRA IN CASE WANT TO FILL W/ HIGH BIT SET) + MOVEM T,AASEFW ;STORE AS FILL WORD, T NOW SET UP TO ACCUMULATE VALUE + CALL PASSPS + MOVEM A,TEXT4 ;STORE TERMINATOR +TEXT7: PUSHJ P,RCH +AASC8: CAMN A,TEXT4 + JRST AASC1A ;TERMINATOR + TLNN D,760000 + JRST TEXT6 ;WORD FULL +TEXT9: TLNE D,100 ;CHECK BOTTOM BIT OF SIZE FIELD OF BP + JRST AASC2 ;SET => NOT SIXBIT + SUBI A,40 + CAILE A,77 + SUBI A,40 ;CONVERT LOWER CASE ASCII TO UPPER CASE + JUMPGE A,.+2 + ETR ERRN6B +AASC3: IDPB A,D + TRO I,IRSYL + JRST TEXT7 + +ERRN6B: ASCIZ /Character not SIXBIT/ + +;TERMINATOR + +AASC1A: TLNN D,760000 ;SKIP UNLESS END OF WORD + SKIPGE AASCF1 ;SKIP UNLESS REGULAR + JRST [ MOVE CH1,ASMDS1 ;REGULAR OR NOT END OF WORD + MOVEM CH1,ASMDSP ;RESTORE ASMDSP AS SAVED AT START OF PSEUDO. + JRST TEXTX] + MOVEI CH1,1 ;END OF WORD AND NOT REGULAR + JRST AASC1B ;EXTRA 0 NEED FOR Z FLAVOR + +AASC2: CAIN A,"! + SKIPG AASCF1 + JRST AASC3 ;NOT .ASCII OR NOT EXCL + PUSH P,T ;READ FIELD + PUSH P,D + PUSH P,SYM + PUSH P,ASMOUT ;PREVENT CLOSEBRACKETS FROM TRYING TO TAKE EFFECT. + MOVEIM ASMOUT,4 ;NOTE THIS LOSES IF CALL PSEUDO THAT RETURNS TO ASSEM1. + MOVEI SYM,[SETOM ASUDS1] ;NOW TO SET UP UNDEFINED SYM CONDITION + TLNE FF,FLPPSS + MOVE SYM,[SQUOZE 0,.ASCII] ;PUNCHING PASS, UNDEFINED => REAL ERROR + CLEARM ASUDS1 + PUSHJ P,AGETFD + ;"UNDEFINED IN .ASCII" ERROR INSTR, ERROR MESSAGE BUT ONLY ON PASS 2 + ;BUT NOTE THAT ON PASS 2 IT MIGHT ASSEMBLE DIFFERENT NUMBER OF WORDS, + ;CAUSING LOSSAGE IF NOT IN CONSTANT + REST ASMOUT + POP P,SYM + POP P,D + POP P,T + SKIPGE ASUDS1 + MOVNI A,1 ;HAD UNDEFINED SYMS SO ASSUME MAX + SKIPGE ASUDS1 + TLO I,ILNOPT ;ALSO DON'T OPTIMIZE OVER IN CONSTANT + MOVE CH1,[440700,,AASBF] + MOVEM CH1,ASBP1 + MOVEM CH1,ASBP2 + PUSH P,[AASC5] + MOVE CH1,A +AASC6: LSHC CH1,-35. + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,AASC6 + HLRZ A,(P) + ADDI A,"0 + IDPB A,ASBP1 + POPJ P, + +AASC5: MOVEI A,0 + IDPB A,ASBP1 ;END .ASCII NUMBER WITH ZERO +AASC8A: TLNN D,760000 + JRST AASC7 ;END OF WORD + ILDB A,ASBP2 + JUMPE A,AASC9 + IDPB A,D + JRST AASC8A + +AASC9: TLO FF,FLUNRD + JRST TEXT7 + +AASC7: TDZA CH1,CH1 +TEXT6: MOVNI CH1,1 ;WORD FULL +AASC1B: MOVEM CH1,AASCF2 + CLEARM CDISP + MOVEM A,TEXT8 + MOVE A,T + SKIPE AASCFT ;FOR .DECTXT, OUTPUT WORD INSTEAD OF RETURNING IT. + JRST [ CALL PPB + MOVE D,[440700,,T] + JRST TEXT2A] + TLO I,ILMWRD ;ELSE ARRANGE TO BE CALLED BACK TO RETURN NEXT WORD. + MOVEI T,ASSEM2 + MOVEM T,ASMDSP + SKIPLE CONSML ;IF NOT MULTI-LINE MODE, + JRST CLBPOP + MOVE T,ASMOUT ;IF THE TEXT IS IN <>'S OR ()'S, + HRRZ T,ASMOT2(T) + CAIE T,LSSTHA + JRST CLBPOP + CALL IGTXT ;USE ONLY THE FIRST WORD. + SKIPE CONSML ;AND ERROR IF IN ERROR MODE. + ETR [ASCIZ/Multi-word text pseudo in brackets/] + JRST CLBPOP + + ;GET NEXT WORD + +TEXT2: TRO I,IRFLD +TEXT2A: MOVE T,AASEFW ;INITIALIZE T TO FILL WORD + MOVE A,TEXT8 ;GET NEXT CHAR (ALREADY READ BY RCH) + SKIPGE B,AASCF2 + JRST TEXT9 ;REG OR HAVEN'T READ SECOND DELIMITER, FALL BACK IN + JUMPE B,AASC8A +TEXTX: SETZM DEFNPS + SKIPN AASCFT + JRST TEXT5 ;RETURNING FROM ASCIZ AFTER PUTTING THE TRAILING ZERO OUT. + MOVE A,T + CALL PPB ;FOR .DECTXT, OUTPUT THE FILL WORD INSTEAD. + JRST MACCR + +VBLK + +AASCF1: 0 ;-1 REG OR SIXBIT, 1 .ASCI 0 ASCIZ +AASCF2: 0 ;MULTIPLE WORD RETURN FLAG -1 REG 0 FINISH ! HACK 1 OUTPUT FILL WORD FOR Z +AASCFT: 0 ;0 REGULAR, -1 => .DECTXT (OUTPUT WORDS TO FILE INSTEAD OF RETURNING THEM) +TEXT4: 0 ;DELIMITER +TEXT8: 0 ;SAVED NEXT CHAR WHILE RETURNING BETWEEN WORDS +ASBP1: 0 ;IDPB TO AASBF ON .ASCII FIELD +ASBP2: 0 ;ILDB FROM AASBF " +AASBF: BLOCK 8 ;ACCUMULATED TYPEOUT OF NUMBER FOR .ASCII, EXTRA LONG FOR HACKERS TYPING OUT BINARY +ASUDS1: 0 ;UNDEFINED SYM FLAG FOR .ASCII DURING PASS 1 +AASEFW: 0 ;FILL WORD + +PBLK + +IGTXT: TLNN I,ILMWRD + RET + PUSH P,A ;ROUTINE TO EAT UP TEXT OF UNDESIRED MULTIPLE WORD + SKIPLE AASCF2 ;DETECT SCREW CASE: AFTER ASCIZ OF 5 CHARS, DELIMITER IS + JRST IGTXT1 ;ALREADY GOBBLED, BUT SOME OF THE ASCIZ REMAINS. + PUSHJ P,RCH + CAME A,TEXT4 + JRST .-2 +IGTXT1: TLZ I,ILMWRD + MOVEMM ASMDSP,ASMDS1 + SETZM DEFNPS + JRST POPAJ + +;".ASCVL /X" RETURNS THE ASCII VALUE OF "X". NOTE THE DELIMITER IS NOT REPEATED +;AND SERVES ONLY TO ALLOW SPACES TO BE IGNORED WHILE WINNING IF X IS A SPACE. +A.ASCV: CALL PASSPS ;SKIP SPACES TO REACH THE DELIMITER. + CALL RCH ;READ THE CHAR AFTER THE DELIMITER + MOVE T,A + JRST TEXT5 ;AND RETURN ITS ASCII VALUE. + +ASQOZ: HLLM B,(P) ;SAVE FLAG THAT'S 0 FOR SQUOZE, -1 FOR .RSQZ . + PUSH P,SYM + PUSHJ P,AGETFD + LSH A,36 + PUSH P,A + PUSHJ P,GETSLD ;GET SYM, SAVE DELIMITER FOR REINPUT + CALL NONAME + REST A + LDB B,[4000,,SYM] ;GET JUST THE SQUOZE. + SKIPGE -1(P) + PUSHJ P,ASQOZR ;FOR .RSQZ, RIGHT-JUSTIFY IT. + SUB P,[1,,1] + ADD A,B + JRST CLBPOP + +;RIGHT-JUSTIFY THE SQUOZE WORD IN B. +ASQOZR: MOVE SYM,B + IDIVI SYM,50 + JUMPN LINK,CPOPJ ;LAST ISN'T BLANK, DONE. + MOVE B,SYM ;ELSE REPLACE BY WHAT'S SHIFTED RIGHT 1 CHAR. + JRST ASQOZR + + ;COMMON PSEUDO ROUTINE TO RETURN MIDAS INTERNAL QUANTITY + ;ADR IN LH(B)) AS VALUE (EG. .RPCNT, .FNAM1, .AVAL2, ETC. + ;INTSYMS MAY APPEAR TO LEFT OF = + +INTSYM: MOVE A,B ;GET ADR IN LH(A) + JRA A,CLBPOP ;RETURN IT + + ;.YSTGW, .NSTGW ACCORDING TO WHAT'S IN LH(B) + +STGWS: HLRES B ;.NSTGW INCREMENTS STGSW, .YSTGW DECREMENTS. + ADDB B,STGSW + SKIPGE B ;BUT DON'T DECREMENT PAST 0. + SETZM STGSW + JRST MACCR ;STORAGE WORDS ARE ALLOWED IF STGSW IS ZERO. + + ;.TYPE + +A.TYPE: PUSH P,SYM + PUSH P,SYM + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + SUB P,[2,,2] + TRNN I,IRLET ;IF SYLLABLE IS A NUMBER, + JRST [ SETO A, ;RETURN -1. + JRST CLBPOP] + PUSHJ P,ES ;EVALUATE SYM, INTERESTED IN SQUOZE FLAGS RETURNED IN A + MOVEI A,17 ;DIDN'T SKIP, RETURN 17 => UNSEEN +IFN CREFSW,XCT CRFINU + JRST CLBPOP + +NONAME: MOVE SYM,-2(P) + ETSM [ASCIZ /No arg/] + SETZ SYM, + POPJ P, + + ;.FORMAT + +A.FORMAT: PUSHJ P,AGETFD ;GET FIRST FIELD (FORMAT #) + MOVE B,CDISP ;WORD TERMINATOR ENDED 1ST ARG => + TLNN B,DWRD + JRST A.FOR1 ;RETURN CURRENT SPEC FOR THAT FORMAT. + PUSH P,A + PUSHJ P,AGETFD ;GET SECOND FIELD (TABLE ENTRY FOR FORMAT NUMBER) + POP P,B + MOVEM A,FORTAB-10(B) + JRST ASSEM1 + +A.FOR1: MOVE A,FORTAB-10(A) + JRST CLBPOP + +A.BYTE: NOVAL + CLEARM NBYTS ;# BYTES ASSEMBLED + CLEARM BYTMT ;TOTAL ACTIVE BYTES IN TABLE + MOVE A,[440700,,BYBYT] ;POINTER TO NEW TABLE + MOVEM A,BYTMP +A.BY1: PUSHJ P,AGETFD ;GET FIELD, .GE. 0 => BYTE, .LT. 0 => HOLE + MOVE C,ISAV + TRNN C,IRFLD + JRST A.BY2 ;NO FIELD + MOVM B,A + SKIPGE A + TRO B,100 + IDPB B,BYTMP + AOS BYTMT +A.BY2: TLNE CH1,DWRD ;CDISP LEFT IN CH1 BY AGETFD + JRST A.BY1 ;NOT WORD TERMINATOR + SKIPN BYTMT ;WORD TERMINATOR, ANY FIELDS? + JRST A.BY3 ;NO, DO .WALGN AND RESET TO WORD MODE + SETOM BYTM ;ENTERING BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETOM BYTM1 + PUSHJ P,BYSET + MOVE A,GLSPAS + MOVEM A,GLSP1 + JRST ASSEM1 + + ;RESET THE BYTE DESCRIPTOR TABLE POINTERS TO POINT TO NEW WORD + +BYSET: CLEARM BYTMC ;COUNT OF BYTES PROCESSED THIS TABLE SCAN + MOVE A,[440700,,BYBYT] ;POINTER TO DESCRIPTOR TABLE + MOVEM A,BYTMP + ILDB A,BYTMP ;FIRST DESCRIPTOR BYTE + AOS BYTMC + DPB A,[300600,,BYTWP] ;DEPOSIT AS FIRST BYTE SIZE + POPJ P, + +A.BY3: CLEARM BYTM ;NO LONGER IN BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETZM BYTM1 + JRST A.WAL1 + +A.WALGN: NOVAL +A.WAL1: LDB A,[360600,,BYTWP] + CAIN A,44 + JRST ASSEM1 ;ALREADY AT BEGINNING OF WORD + MOVEI A,44 + DPB A,[360600,,BYTWP] ;MAKE IT POINT TO BEGINNING OF WORD + PUSHJ P,BYSET + CLEARM T1 + JRST PBY1 + +BYTIN1: CLEARM BYTMC + MOVE A,[440700,,BYBYT] + MOVEM A,BYTMP +BYTINC: AOS A,BYTMC + CAMLE A,BYTMT + JRST BYTIN1 + ILDB A,BYTMP + DPB A,[300600,,BYTWP] + MOVEM A,T1 + HLLZ A,BYTWP + IBP A + TRNN A,-1 + JRST BYTINR + ;NEXT BYTE GOES IN NEXT WORD +PBY1: MOVE P,ASSEMP ;PCONS NEEDS THIS. + MOVEI A,WRD-1 + PUSH A,BYTW ;INTO WRD, + PUSH A,BYTRLC ;INTO WRDRLC + CLEARM BYTW + SETZM BYTRLC + MOVEI A,44 + DPB A,[360600,,BYTWP] + MOVE AA,ASMOUT + JRST @ASMOT4(AA) ;TO PBY4 OR PBY5 OR PBY3 + +PBY4: SKIPE STGSW + ETR ERRSWD + PUSHJ P,PWRD ;NOT IN CONST., OUTPUT WORD. + AOSA CLOC +PBY3: JSP T,PCONS ;OUTPUT INTO CONST. +PBY5: MOVE A,GLSPAS + MOVEM A,GLSP1 +BYTINR: MOVE A,T1 ;CURRENT BYTE SIZE + TRNN A,100 + JRST @ASMDSP + SETZB A,B ;ASSEMBLE HOLE (BLANK BYTE) IMMEDIATELY AFTER PREVIOUS BYTE + JRST PBY2 + +PBYTE: AOS NBYTS +PBY2: MOVEI AA,WRD-1 + PUSH AA,BYTW ;INTO WRD + PUSH AA,BYTRLC ;INTO WRDRLC + IBP BYTWP + LDB T,[301400,,BYTWP] + PUSHJ P,INTFLD + POP AA,BYTRLC ;WRDRLC + POP AA,BYTW ;WRD + JRST BYTINC + + ;VARIABLES FOR .BYTE, .BYTC, .WALGN + +VBLK +BYTM: 0 ;-1 FOR IN BYTE MODE, LAMBDA BOUND BY <'S, ('S, AND ['S ;] +BYTMC: 0 ;COUNT CORRESP WITH BYTMP +BYTMP: 0 ;POINTER TO BYTE DESC TABLE +BYTMT: 0 ;TOTAL ACTIVE BYTES IN TABLE +BYTM1: 0 ;GLOBAL VALUE OF BYTM - WHAT IT WAS OUTSIDE THE OUTERMOST BRACKET + +;FORMAT OF BYTE DESC TABLE +;SEVEN BIT BYTES +;1.7=0 ASSEMBLE =1 BLANK +;1.1 - 1.6 NUMBER OF BITS + +IFNDEF LBYBYT,LBYBYT==5 ;LENGTH OF BYBYT +BLCODE [BYBYT: BLOCK LBYBYT] ;BYTE DESC TABLE, 7 BITS PER DESC + +BYTWP: 440000,,BYTW ;POINTER TO BYTW IDPB TO DEPOSIT CURRENT BYTE +BYTW: 0 ;WORD BEING ASSEMBLED IN BYTE MODE +BYTRLC: 0 ;RELOC OF BYTW. +NBYTS: 0 ;NUMBER BYTES ASSEMBLED (FOR .BYTC) +BYTMCL==.-BYTMC +PBLK + +;;MACRO PROCESSOR +IFN MACSW,[ + ;GET IN B THE CHAR WHOSE ADR IS IN A, INCREMENT A + +REDINC: MOVE CH1,A + IDIVI CH1,4 + LDB B,PTAB(CH2) + AOJA A,CPOPJ + +VBLK ;THIS STUFF ALL RELOCATED WHEN MACTAB ADDR CHANGED. +PTAB: (341000+CH1)MACTBA ;BYTE TABLE + (241000+CH1)MACTBA + (141000+CH1)MACTBA + (41000+CH1)MACTBA + (341000+CH1)MACTBA+1 + + ;IN FOLLOWING MACROS, B = -1, 0, OR +1 (+ SIGN MUST BE GIVEN) + ;0 => BP SAME AS CHAR ADR, -1 => BP FOR ILDB, 1 => BP ONE AHEAD + + ;CHAR ADR IN A, RETURNS BP IN A, CLOBBERS A+1 + +DEFINE BCOMP A,B/ + IDIVI ,4 + ADD ,(+1)BCOMPT!B +TERMIN + +STOPPT: 041000,,MACTBA-1 +BCOMPT: 341000,,MACTBA + 241000,,MACTBA +BCOMPU: 141000,,MACTBA + 041000,,MACTBA + 341000,,MACTBA+1 + +;BP IN A RETURN CHAR ADR IN A, CLOBBERS A-1 (YES, A MINUS 1) +;2ND ARG IS SUBTRACTED - -1 GIVES ADDR OF THE NEXT CHAR. +DEFINE CCOMP A,B/ + MOVEI -1,0 + ASHC -1,2 + SUB ,(-1)CCOMPT!B +TERMIN + + ;BP IN A RETURN CHAR ADR IN A+1, CLOBBERS A + +DEFINE CCOMP1 A,B/ + MULI ,4 + SUB +1,(A)CCOMPT!B +TERMIN + +;FROM HERE THRU CCOMPE SET BY MACINI. +CCOMPB: 0 ;4*<41000,,MACTBA>-4 +CCOMPT: REPEAT 5,0 ;4*<41000,,MACTBA>+.RPCNT-3 +CCOMPE::PBLK + + ;BP IN A, DECREMENT IT + +DEFINE DBPM A + ADD A,[100000,,] + SKIPGE A + SUB A,[400000,,1] +TERMIN + +;SET UP CPTR FROM CHAR ADR IN A + +ACPTRS: MOVEI CH1,(A) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE COMPUTED CPTR + POPJ P, + +AFCOMP: HRRZM A,FREEPT ;ENTRY TO STORE C(A) INTO FREEPT +FCOMP: MOVE CH1,FREEPT ;COMPUTE FREPTB FROM FREEPT + BCOMP CH1,-1 + MOVEM CH1,FREPTB ;STORE CALCULATED BYTE POINTER + POPJ P, + +STPWR: MOVEI A,375 + JRST PUTREL + +VBLK +PUT377: MOVEI A,377 +PUTREL: JRST PUTRE1 ;IDPB A,FREPTB;STORE CHAR INTO FREE CHARACTER STORAGE + AOS A,FREEPT ;CLOBBERS ONLY A. + AOS PUTCNT + CAMGE A,MACHI + POPJ P, + JRST GCA +PBLK +PUTRE1: PUSH P,[IDPB A,FREPTB] + POP P,PUTREL ;COME HERE ONLY ON 1ST CALL TO PUTREL. + SETOM INICLB ;HAVE WRITTEN IN MACRO TAB & CLOBBERED INIT. + JRST PUTREL ;NOW GO BACK AND REALLY WRITE CHAR. + +;200 BIT SET ON CHAR READ FROM MACTAB, PROCESS SPECIAL CONDITION +;CLOBBERS A,CH1,CH2. + +MACTRM: CAIN A,176 ;376? + JRST RCHTRA ;376 => IGNORE, CHARACTER USED TO CLOBBER UNDESIRED CHARACTERS IN MACRO STORAGE + PUSH P,B ;SAVE B + CAIE A,177 + CAIN A,175 + JRST MRCH1 ;377, 375 => STOP + ADD A,BBASE ;DUMMY, RELOCATE TO POINT TO DUMMY TABLE + MOVEI B,RCHSAV ;RETURN TO RCHSAV ON END OF DUMMY + PUSHJ P,PUSHEM ;SAVE CURRENT STATUS + HRRZ A,(A) ;GET CHAR ADR OF DUMMY + BCOMP A,-1 ;CONVERT TO BYTE POINTER + MOVEM A,CPTR ;STORE AS NEW CPTR + MOVE A,TOPP + MOVEM A,BBASE +RCHTRB: POP P,B +RCHTRA: POP P,A ;POP RETURN + TLZN FF,FLUNRD ;IF NO CHAR TO RE-READ, JUST RETURN BACK TO THE ILDB A,UREDP. + JRST -3(A) + ANDI A,-1 ;IF A CHAR TO RE-READ, IF CALLED FROM RREOF, WE CAN RETURN TO RRU + CAIN A,RREOF+1 + JRST RRU + PUSH P,A ;OTHERWISE, CALL RCH TO RE-READ THAT CHAR, AND RETURN IT FROM + JRST RCH1 ;THE CURRENT ATTEMPT TO READ A CHAR. + +MRCH1: MOVE B,MACP +BPOPJ: POPJ B, ;RETURN AT END OF STRING EXPANSION + +;RCHSET ROUTINE TO CAUSE INPUT FROM MACRO PROCESSOR + +RCHMAC: TLO FF,FLMAC ;SET FLAG + JSP A,CPOPJ +RCHMC0: REPEAT 2,[ ;GETCHR, RR1 + ILDB A,CPTR ;GET CHAR + TRZE A,200 ;200 BIT... + PUSHJ P,MACTRM ;=> SPECIAL, PROCESS +] + .VALUE +IFN .-RCHPSN-RCHMC0,.ERR RCHMC0 LOSES. + ILDB A,CPTR ;SEMIC + TRZE A,200 + PUSHJ P,MACTRM + CAIE A,15 + JRST SEMIC ;NOT YET + JRST SEMICR ;YET + + ;PUSH INPUT STATUS IN FAVOR OF MACRO + ;B HAS RETURN ADR FOR END OF MACRO (OR WHATEVER) + ;SEE ALSO PMACP + +PUSHEM: PUSH P,A + PUSH P,F + MOVE F,MACP ;GET MACRO PDL POINTER + MOVE CH1,CPTR + CCOMP1 CH1,-1 ;CONVERT TO CHARACTER ADDRESS + HRL CH2,BBASE + PUSH F,CH2 ;PUSH BBASE,,CPTR + MOVEI A,1 ;=> EXPAND MACRO + PUSHJ P,PSHLMB ;SAVE LIMBO1 STATUS AND RETURN + JRST PSHM1 + + ;UNDO A PUSHEM + ;RETURNS BBASE,,CPTR IN B (CPTR RE-INITIALIZED, BBASE NOT) + +POPEM: PUSH P,A + PUSH P,F + MOVE F,MACP + PUSHJ P,POPLMB ;RESTORE LIMBO1 STATUS + POP F,B ;BBASE,,CPTR + MOVEI CH1,(B) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE NEW CPTR +PSHM1: MOVEM F,MACP ;STORE BACK MACRO PDL POINTER +POPFAJ: POP P,F +POPAJ: POP P,A + POPJ P, + +PMACP: MOVE B,MACP ;POP MACRO PDL + HRRZ A,(B) + SUB B,[1,,1] +IFN RCHASW,CAIE A,A.TYM8 + CAIN A,AIRR + JRST A.GO6 ;IRP OR .TTYMAC + CAIN A,REPT1 + JRST A.GO4 ;REPEAT + CAIE A,RCHSV1 ;MACRO + CAIN A,RCHSAV ;ARG + JRST A.GO6 + .VALUE ;DON'T HAVE RETURN, + JRST A.GO6 ;BUT TRY A.GO6 LIKE EVERYTHING BUT REPEAT + +A.GO4: HLLZS -1(B) ;REPEAT, CLEAR OUT COUNT REMAINING +A.GO6: TRO FF,FRMRGO ;EVERYTHING ELSE, SET FLAG TO QUIT + JRST (A) + + ;4.9(B) => .STOP ELSE .ISTOP + +A.STOP: HRRZ A,MACP + JUMPL B,A.STP1 + HRRZ B,(A) ;.ISTOP + CAIN B,REPT1 + HLLZS -2(A) ;REPEAT, STOP ALL INTERATIONS + CAIN B,AIRR + HRRZS -1(A) ;IRP TYPE, CLEAR OUT # GROUPS, DON'T ALLOW RECYCLE +A.STP1: MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP + JRST POPJ1 + +A.QOTE: JFCL +ATERMI: ETSM [ASCIZ/Not in macro/] + JRST MACCR ;MAYBE FLUSH MESSAGE IF PEOPLE HAVE PROBLEMS + +;PDL STRUCTURE FOR REPEAT +;TWO TWO WORD ENTRIES +;BBASE,,CPTR +;LIMBO1 STATUS,,# TIMES LEFT +;OLD .RPCNT,,BEG OF BODY +;GARBAGE,,REPT1 + +AREPEAT: PUSHJ P,AGETFD + JUMPLE A,COND5 ;NO REPEAT PLAY LIKE STRING COND FALSE + PUSH P,A + MOVE A,FREEPT + MOVEM A,PRREPT ;CHAR ADR BEGINNING OF REPEAT + MOVEI A,373 ;CHECK CHAR FOR REPEAT + PUSHJ P,PUTREL ;STORE AS FIRST CHR OF BODY + JSP D,RARL1 + CAIA + CALL RARGCP ;READ THE ARG & COPY INTO MACRO STORAGE. + MOVEI A,^M ;IF THE ARG WASN'T BRACKETED, + TLNE FF,FLUNRD + CALL PUTREL ;INCLUDE THE TERMINATING CR. +SWRET1: PUSHJ P,STPWR ;ALSO RETURN FROM STRING WRITE (.F .I) + POP P,B ;# TIMES TO GO THROUGH + PUSHJ P,PUSHEM + MOVE B,MACP ;NOW GET MACRO PDL POINTER FOR PUSH OF SECOND ENTRY + MOVNI T,1 + EXCH T,CRPTCT ;GET OLD .RPCNT, INITIALIZE NEW ONE TO -1 +CREPT1: SETZI TT,REPT1 + EXCH TT,PRREPT ;GET LOC BEGINNING OF BODY, CLEAR OUT PRREPT, DON'T NEED IT ANYMORE + HRL TT,T + PUSH B,TT ;SAVE OLD .RPCNT,,ADDRESS OF BODY. + PUSH B,CREPT1 ;PUSH CRUD,,REPT1 FOR RETURN + MOVEM B,MACP ;STORE BACK UPDATED MACRO POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE IMMEDIATE CYCLE + JRST MACCR + +IFN .I.FSW,[ ;CODING FOR .I, .F + +SWINI: MOVE A,FREEPT ;INITIALIZE, WILL EVENTUALLY PLAY LIKE REPEAT 1 + MOVEM A,PRREPT + MOVEI A,373 + JRST PUTREL + +SWRET: PUSH P,[1] ;REPEAT COUNT + JRST SWRET1 + +SWFLS: MOVE A,PRREPT ;FLUSH RETURN + PUSHJ P,AFCOMP + JRST MACCR +] + +;RECYCLE AROUND REPEAT + +REPT1: PUSH P,A + PUSH P,C + HRRZ A,(B) ;CHAR ADR BEG BODY + PUSHJ P,REDINC + CAIE B,373 + HALT ;FIRST CHAR OF REPEAT BODY NOT 373 + HRRZ C,MACP + HRRZ B,-2(C) ;# TIMES LEFT + SOJL B,REPT2 ;JUMP IF LAST TIME THROUGH WAS LAST TIME TO GO THROUGH + AOS CRPTCT + PUSHJ P,ACPTRS ;SET UP CPTR (CHAR ADR IN A) + HRRM B,-2(C) ;STORE UPDATED COUNTDOWN +REPT3: POP P,C + POP P,A + JRST REPT6 + +REPT2: SOS A ;MOVE BACK TO BEG OF REPEAT + ;(IN CASE GETS STORED INTO FREEPT) + MOVE CH2,CPTR + CCOMP CH2,-1 ;CONVERT TO CHARACTER ADDRESS + CAMN CH2,FREEPT + PUSHJ P,AFCOMP + MOVE A,[-3,,-2] + ADDB A,MACP + HLRZ A,1(A) + MOVEM A,CRPTCT + PUSHJ P,POPEM + JRST REPT3 + +;STRING CONDITIONALS (IFSE, IFSN) + +SCOND: MOVE A,FREEPT + MOVEM A,PRSCND + MOVEM A,PRSCN1 + PUSH P,SYM + HRRI B,SCONDF + PUSH P,B ;REMEMBER TEST INSTRUCTION. + SETOB C,SCONDF + JSP D,RARG ;COPY THE 1ST OF THE 2 STRINGS + CAIA + CALL RARGCP ;INTO MACRO STORAGE, FOLLOWED BY 375. + CALL STPWR + JSP D,RARG ;THEN START READING THE 2ND ARG, + JRST SCOND3 ;GO TO SCOND3 WHEN REACH END OF 2ND ARG. + JSP D,RARGCH(T) ;READ NEXT CHAR OF 2ND ARG, + JRST SCOND3 + EXCH A,PRSCND + PUSHJ P,REDINC ;RE-FETCH NEXT CHAR OF 1ST ARG + EXCH A,PRSCND + CAMN B,A ;COMPARE CHARACTERS + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CAIL A,"A+40 + CAILE A,"Z+40 ;NOT EQUAL => CONVERT BOTH TO UPPER CASE. + CAIA + SUBI A,40 + CAIL B,"A+40 + CAILE B,"Z+40 + CAIA + SUBI B,40 + CAMN B,A ;ARE THEY SAME EXCEPT FOR CASE? + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CLEARM SCONDF ;STRINGS DIFFER + CALL RARFLS ;IGNORE REMAINDER OF 2ND ARG. +SCOND3: CLEARB A,C ;END OF (SECOND) STRING ARG ENCOUNTERED + EXCH C,PRSCN1 + MOVEM C,FREEPT + PUSHJ P,FCOMP + EXCH A,PRSCND + PUSHJ P,REDINC + CAIE B,375 + CLEARM SCONDF + REST B + REST SYM + XCT B ;DO THE TEST. + JRST COND4 + JRST COND2 + +VBLK +BLCODE [DMYDEF: BLOCK DMDEFL] ;TABLE OF DUMMY NAMES FOR THING BEING DEFINED +DMYTOP: DMYDEF ;POINTER INTO DMYDEF, POINTS TO AVAILABLE WORD + ;SINCE ONLY ONE THING CAN BE DEFINED AT ONCE, IT IS NOT NECESSARY TO SAVE AND RESTORE DMYTOP +DMYBOT: DMYDEF ;-> 1ST DMYDEF WD USED AT THIS LEVEL. + ;RIGHT NOW, ALWAYS -> DMYDEF SINCE CAN'T HAVE DEFINITION + ;WITHIN A DEFINITION YET. + +PBLK + +PDEF: PUSHJ P,GSYL ;READ IN SYL + CAIE T,", ;IF DELIMITING CHR NOT , + JUMPE SYM,CPOPJ ;AND SYM NULL, RETURN +PDEF1: MOVEM SYM,@DMYTOP ;STORE SYM + AOS D,DMYTOP ;INCR PNTR + CAIL D,DMYDEF+DMDEFL ;CHECK FOR TABLE SIZE EXCEEDED + ETF [ASCIZ/Too many dummies in DEFINE or IRP/] + POPJ P, + +VBLK +BLCODE [DSTG: BLOCK DSSIZ] ;TABLE OF CHAR ADRS OF DUMMIES BEING DEFINED PRIOR TO MACRO EXPANSION +RDWRDP: DSTG ;POINTER TO DSTG, POINTS TO FREE WORD + ;NOTE THAT RDWRDP MUST BE SAVED AND RESTORED SINCE MORE MACROS CAN + ;BE EXPANDED DURING FIELD READ FOR DUMMY +PBLK + +ADDTR1: CLEARM PUTCNT +ADDTRN: MOVE A,FREEPT +ADDTR2: MOVEM A,@RDWRDP + AOS A,RDWRDP + CAIL A,DSTG+DSSIZ + ETF [ASCIZ/Too many dummies in all macros & IRPs being expanded/] + RET + +VBLK +BLCODE [DMYAGT: BLOCK DMYAGL] ;TABLE OF CHAR ADRS OF DUMMYS OF MACROS BEING EXPANDED + ;DMYAGT TRACKS WITH THE MACRO PDL; + ;DMYAGT CAN'T BE COMBINED WITH DSTG SINCE DMYAGT CAN BE SHIFTING AROUND RANDOMLY DURING ARG SCAN +BBASE: DMYAGT ;POINTER TO BEGINNING OF ACTIVE DUMMY LIST (FOR DEEPEST-NESTED MACRO BEING EXPANDED) + ;ADD TO DUMMY # TO GET LOCATION CONTAINING CHAR ADR OF DUMMY +TOPP: DMYAGT ;POINTER TO TOP OF DMYAGT ACTIVE, POINTS TO FREE REGISTER +PBLK + + ;ACTIVATE DUMMYS ON TOP OF DSTG TABLE + ;A -> FIRST (LOWEST) DUMMY IN DSTG TO ACTIVATE + +DMYTRN: MOVE B,TOPP + MOVEM B,BBASE + PUSH P,A +DMYTR2: CAML A,RDWRDP + JRST DMYTR1 + MOVE B,(A) + MOVEM B,@TOPP + AOS B,TOPP + CAIL B,DMYAGT+DMYAGL + ETF [ASCIZ /Too many dummy args active/] + AOJA A,DMYTR2 +DMYTR1: POP P,RDWRDP + POPJ P, + +;THE MACRO TABLE IS FILLED MAINLY WITH 8-BIT BYTES. +;THE FIRST WORD'S ADDR IS IN MACTAD; THE LAST+1'S IN MACTND. +;THE CHARACTER NUMBER OF THE LAST+1ST CHAR IS IN MACHI. +;MACHIB IS BP. TO HIGHEST BYTE OK TO FILL (LAST IN C(MACTND)-1) + +;IF A BYTE IN THE TABLE HAS ITS HIGH BIT OFF, IT IS AN ASCII CHARACTER. +;OTHERWISE, IT IS SPECIAL. IF THE 100 BIT IS OFF IT MEANS +;SUBSTITUTE A MACRO DUMMY ARG WHEN READ; THE CHAR IS THE NUMBER OF THE ARG+200 . + +;377 AND 375 ARE STOP CODES, CAUSING A POP OUT OF THE CURRENT STRING. +;GC CONSIDERS THE CHAR. AFTER A 375 TO START A NEW STRING. + +;376 IS IGNORED WHEN READ; USED TO CLOBBER UNWANTED CHARACTERS IN STRINHGS. + +;374 STARTS EVERY MACRO-DEFINITION. +;373 STARTS THE BODY OF A REPEAT. + +;370 STARTS A WORD STRING: +;THE WORD AFTER THAT WHICH CONTAINS THE 370 +; HAS THE LENGTH IN WORDS OF THE STRING IN ITS LH, +; IN ITS RH, THE ADDRESS OF WD WHICH POINTS BACK TO THIS ONE. +; THEN FOLLOW RANDOM WDS HOLDING ANYTHING AT ALL. +; GC WILL MAKE SURE IT STAYS ON WD BOUNDARY. +; THE LENGTH INCLUDES THE WD HOLDING THE LENGTH. +; IF THE RH OF 1ST WD HAS 0, GC WILL FLUSH THE STRING + +STRTYP: PUSHJ P,REDINC ;DEBUGGING AID ONLY + EXCH A,B + TRZE A,200 + JRST STRTP1 +STRTP2: PUSHJ P,TYO ;NORMAL CHAR, JUST TYPE OUT + MOVE A,B + JRST STRTYP + +STRTP1: PUSH P,A + MOVEI A,"* ;SPECIAL CHAR, TYPE * + PUSHJ P,TYO + POP P,A + TRNE A,100 + JRST STRTP3 ;CONTROL CHAR + ADDI A,260 ;DUMMY, CONVERT TO # + JRST STRTP2 ;TYPE OUT (SINGLE DIGIT) NUMBER + +STRTP3: CAIN A,175 + SKIPA A,C% ;STOP, TYPE % + MOVEI A,"/ ;SOMETHING ELSE, TYPE / + JRST STRTP2 + + + ;.GSSET, SET GENERATED SYM COUNTER + +A.GSSET: CALL AGETFD + MOVEM A,GENSM + JRST ASSEM1 + +;GSYL-LIKE ROUTINE, READ A SYL FOR WRQOTE + +WRQRR: PUSHJ P,RCH ;GET CHAR (MAYBE WANT THIS TO BE FASTER YET) + IDPB A,FREPTB ;DEPOSIT IN MACRO TABLE + CAMN F,FREPTB ;WAS THIS LAST CHAR IN TABLE? + JRST WRQRGC ;YES, NEED GARBAGE COLLECTION +WRQRR2: XCT GDTAB(A) ;DISPATCH ON CHAR + JFCL ;(MAYBE SKIPS) + SOJGE D,WRQRR ;LOOP FOR FIRST SEVEN CHARS + HRRI D,0 + JRST WRQRR + + ;HERE FROM WRQRR WHEN NEED GARBAGE COLLECTION OF MACRO TABLE + +WRQRGC: MOVEM C,WRQTBP ;PUT POINTER TO BEGINNING OF SYL WHERE IT WILL BE GC'D + MOVE A,MACHI + PUSHJ P,GCA ;GARBAGE COLLECT + MOVE F,MACHIB ;RESET F TO POINT TO NEW LAST CHAR IN MACTAB + MOVEI C,0 + EXCH C,WRQTBP ;GET BACK POINTER TO CHAR BEFORE SYL + MOVE A,LIMBO1 ;RETRIEVE LAST CHAR READ + JRST WRQRR2 ;LOOP BACK, PROCESS CHAR + + ;HERE FROM WRQOTE IF .QUOTE SEEN + ;.QUOTE TAKES ARG LIKE ASCII, PRINTC, ETC. + +A.QOT1: MOVE A,WRQBEG(P) ;GET BACK BP TO CHAR BEFORE .QUOTE + PUSHJ P,A.QOTS ;SET UP FREEPT AND FREPTB PROPERLY + MOVE A,LIMBO1 ;NOW GET CHAR AFTER .QUOTE + CAIE A,^I + CAIN A,40 ;COMPARE WITH SPACE + PUSHJ P,RCH ;SPACE, GOBBLE NEXT CHAR FOR DELIMITER, ELSE THIS ONE + MOVEM A,A.QOT2 ;STORE AS TERMINATOR OF STRING +A.QOT3: PUSHJ P,RCH ;GET CHAR TO QUOTE + CAMN A,A.QOT2 ;TERMINATOR? + JRST WRQOT1 ;TERMINATOR, BACK FOR MORE DEFINITION + PUSHJ P,PUTREL ;DEPOSIT CHAR + JRST A.QOT3 + +;READ IN BODY OF MACRO, IRP, OR WHATEVER + +WRQOTE: PUSH P,[0] ;USED FOR LENGTH OF SYMBOL (REALLY 6 MINUS IT). +WRQLEN==,-2 + PUSH P,[0] ;THIS WD USED FOR DEFINE/TERMIN COUNT. +WRQLVL==,-1 + PUSH P,[0] ;USED TO REMEMBER BEGINNING OF SYMBOL. +WRQBEG==0 + SETOM INICLB ;CLOBBERED INITS, .SYMTAB NOW ILLEGAL. + PUSHJ P,RCH ;MAYBE POP UP A LEVEL IN EXPANSIONS, SAVE MACTAB SPACE + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-INPUT + MOVE F,MACHIB ;POINTER TO LAST CHAR OK TO PUT IN MACTAB, STAYS IN F + TRO I,IRSYL\IRLET ;MAKE SURE FLAGS SET SO WON'T WASTE TIME AT MAKNUM, POINT +WRQOT0: +WRQOT1: MOVEI D,6 ;SQUOZE COUNTER + MOVEI SYM,0 ;INITIALIZE SYM + MOVE C,FREPTB ;GET POINTER TO CHAR BEFORE SYL ABOUT TO READ + PUSHJ P,WRQRR ;READ SYL + JUMPE SYM,.-2 ;LOOP UNTIL NON-NULL + ;NOW SEE IF DUMMY; **NOTE**: C STILL HAS BYTE POINTER, A SYL TERMINATOR + MOVE B,DMYBOT + CAML B,DMYTOP + JRST WRQOT2 ;NOT DUMMY + CAME SYM,(B) ;COMPARE WITH DUMMY NAME + AOJA B,.-3 ;LOOP ON NO MATCH + SUB B,DMYBOT ;DUMMY, CONVERT TO NUMBER + 200 + SUBI B,200 + LDB T,C ;GET LAST CHAR BEFORE SYL + CAIE T,"! ; ^ NOTE THAT THIS CAN LOSE IF MACRO HAS 33. ARGS + IDPB B,C ;NOT EXCLAMATION POINT, LEAVE THERE, DEPOSITING DUMMY CHAR + CAIN T,"! + DPB B,C ;EXCL, WIPE IT OUT + MOVEM C,FREPTB ;RESET FREPTB + CAIE A,"! ;A HAS DUMMY TERMINATOR, COMPARE WITH EXCL + TLO FF,FLUNRD ;NOT EXCLAMATION POINT, CAUSE IT TO BE RE-INPUT + JRST WRQOT1 ;LOOP BACK FOR NEXT SYL + +;SYL ISN'T DUMMY, CHECK FOR PSEUDO +WRQOT2: MOVEM D,WRQLEN(P) ;REMEMBER START OF AND LENGHTH OF THE SYMBOL. + MOVEM C,WRQBEG(P) + SETOM ESBK ;EVAL IN CURRENT BLOCK. + PUSHJ P,ES ;EVALUATE SYM (DOESN'T CLOBBER F) + JRST WRQOT0 ;NOT SEEN + CAIE A,PSUDO/40000 + JRST WRQOT0 ;NOT PSEUDO + TLZ B,-1 ;CLEAR OUT LH OF VALUE, ONLY INTERESTED IN RH + CAIN B,A.QOTE + JRST A.QOT1 ;.QUOTE + CAIE B,ADEFINE + CAIN B,AIRP + AOS WRQLVL(P) ;DEFINE OR IRP +IFN RCHASW,[CAIN B,A.TTYM + AOS WRQLVL(P) ;.TTYMAC +] + CAIE B,ATERMIN + JRST WRQOT0 + SKIPGE WRQLEN(P) + ETR [ASCIZ /TERMIN longer than 6 chars/] + SOSL WRQLVL(P) ;TERMIN, SKIP IF THE TERMINATING ONE + JRST WRQOT0 ;NOT MATCHING TERMIN, BACK FOR NEXT SYL + POP P,A ;GET BACK BP TO LAST CHAR BEFORE TERMIN + SUB P,[2,,2] .SEE WRQLVL,WRQBEG + MOVE T,DMYBOT ;WE'RE NO LONGER USING SPACE IN DMYDEF. + MOVEM T,DMYTOP +A.QOTS: LDB T,A ;HERE ALSO FROM A.QOT1, GET CHAR BEFORE .QUOTE OR TERMIN + CAIE T,"! + JRST A.QTS2 ;NOT EXCLAMATION POINT => OK + DBPM A, ;EXCLAMATION POINT, DECREMENT POINTER +A.QTS2: MOVEM A,FREPTB ;STORE AS NEW FREPTB + CCOMP1 A,-1 ;CONVERT TO CHAR ADR + MOVEM B,FREEPT ;STORE CHAR ADR AS NEW FREEPT + POPJ P, + +;FORMAT OF A MACRO: +;IT STARTS WITH A 374. +;THEN COME ARGUMENT DESCRIPTORS, ONE PER ARGUMENT. +MCF==777650 ;BITS AND FIELDS ARE: +MCFDEF==200 ;ARG IS DEFAULTED. MCFDEF AND MCFGEN NEVER BOTH SET. +MCFGEN==100 ;ARG SHOULD BE GENSYMMED IF NOT GIVEN IN CALL. +MCFKWD==40 ;ARG IS A KEYWORD ARG, SELECTED BY = RATHER THAN POSITION. +MCFSYN==7 ;FIELD THAT SPECIFIES THE ARGUMENT'S SYNTAX. + MCFNRM==1 ;MCFSYN CONTAINS MCFNRM => NORMAL-SYNTAX ARG + MCFLIN==2 ;MCFSYN CONTAINS MCFLIN => WHOLE LINE ARG + MCFBAL==3 ;MCFSYN CONTAINS MCFBAL => BALANCED ARG + MCFSTR==4 ;MCFSYN CONTAINS MCFSTR => ARG IS A DELIMITED STRING, AS IN "ASCIZ". + MCFKST==5 ;MCFSYN CONTAINS MCFKST => JUST LIKE MCFSTR, BUT DELIMITERS ARE RETAINED. + MCFEVL==6 ;MCFSYN CONTAINS MCFEVL => ARG IS BY VALUE (PREEVALUATED). +;IF MCFKWD IS SET, THE DESCRIPTOR IS FOLLOWED BY THE NAME OF THE ARGUMENT, +;TERMINATED BY A 377. +;IF MCFDEF IS SET, THE DESCRIPTOR IS FOLLOWED BY THE DEFAULT VALUE OF THE ARG, +;TERMINATED BY A 377. +;IF MCFKWD AND MCFDEF ARE BOTH SET, THE ARG NAME COMES FIRST. +;A ZERO BYTE ENDS THE DESCRIPTOR LIST. +;THEN COMES THE BODY OF THE MACRO, FOLLOWED BY A 375. + +ADEFINE: NOVAL ;ERROR IF CONTEXT WANTS A VALUE. + PUSH P,CASSM1 ;RETURN TO ASSEM1 EVENTUALLY + JSP TM,ERMARK ;ERR MSGS SHOULD SAY WE'RE INSIDE A DEFINE. + PUSH P,SYM ;THESE 2 PUSHES ARE FOR NONAME'S SAKE. + PUSH P,SYM + CALL GETSLD + CALL NONAME + TLZ FF,FLUNRD + SUB P,[2,,2] + PUSH P,SYM + PUSH P,ESBK ;SAVE BLOCK TO DEFINE IN FOR ES'S SAKE. +IFN CREFSW,XCT CRFMCD + CALL A.TYM1 + POP P,ESBK + REST SYM + PUSHJ P,ESDEF ;FIND SLOT IN SYMBOL TABLE FOR IT + TLO C,3MACOK ;NEVER SEEN, OK TO MAKE MACRO. + TLON C,3MACOK ;ELSE ERROR IF NUMERIC OR ALREADY USED. + ETSM [ASCIZ/Non-macro made macro/] + MOVEI B,MACCL ;RH(VALUE) = MACCL + HRL B,PRDEF ;LH(VALUE) = CHAR ADR OF MACRO + CLEARM PRDEF ;NO LONGER NEED PRDEF + MOVSI T,PSUDO ;SYMBOL TABLE ENTRY LOOKS LIKE PSEUDO + JRST VSM2 + +IFN RCHASW,[ + ;.TTYMAC NAME + ;BODY + ;TERMIN + + ;NAME DUMMY, CAUSES READIN OF CRUD FROM TTY -> CR (NOT INCLUSIVE) + +A.TTYM: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WE'RE INSIDE A .TTYMAC + CALL A.TYM1 ;READ IN A MACRO-DEFINITION. + MOVEI A,40 ;DON'T LET THE CHAR ENDING THE TERMIN + MOVEM A,LIMBO1 ;MAKE MACCL THINK THERE ARE NO ARGS. + CALL GTYIP1 ;PUSH INTO TTY FOR INPUT + HRLZ B,PRDEF ;PHONY UP A MACRO WHOSE DEFN IS WHAT WE READ. + SETZM PRDEF + MOVEI A,A.TYM8 + JRST A.TYM2 ;CALL THE MACRO: + ;READ THE ARGS, POP OUT OF TTY, EXPAND THE MACRO + ;AND THEN EXIT TO A.TYM8 +] + +A.TYM1: MOVE A,FREEPT + MOVEM A,PRDEF + MOVEI LINK,MCFNRM ;INITIALLY, DUMMIES ARE NORMAL. + MOVEI A,374 + PUSHJ P,PUTREL ;MARK BEGINNING OF MACRO +DEFNI: MOVE T,LIMBO1 + MOVE A,LINK +DEFNC: CAIE T,12 + CAIN T,15 + JRST DEFNA ;NO MORE ARGS (DONE WITH LINE) + CAIE T,LBRACE + CAIN T,LBRKT + JRST DEFNB1 + CAIE T,RBRACE + CAIN T,RBRKT + JRST DEFNB2 + CAIE T,"< ;OPENS TURN ON BALANCEDNESS. + CAIN T,"( + JRST DEFNB1 + CAIE T,"> ;CLOSES TURN OFF BALANCEDNESS. + CAIN T,") + JRST DEFNB2 + CAIN T,"? ;? TURNS BALANCEDNESS ON OR OFF. + JRST DEFBAL + CAIN T,"+ ;+ COMPLEMENTS KEYWORDNESS + XORI LINK,MCFKWD + CAIN T,"\ ;\ COMPLEMENTS GENSYMMEDNESS + XORI LINK,MCFGEN + CAIN T,"- ;- TURNS WHOLELINENESS ON OR OFF. + JRST DEFWHL + CAIN T,"* ;* TURNS ASCIZ-STYLE-NESS ON OR OFF. + JRST DEFASC + CAIN T,"& ;& TURNS KEEP-STRUNGNESS ON OR OFF. + JRST DEFKST + CAIN T,"# ;# TURNS EVALUATEDNESS ON OR OFF. + JRST DEFEVL + CAIN T,": ;: MAKES FOLLOWING ARGS NORMAL + MOVEI LINK,MCFNRM ;IN ALL RESPECTS + CAIN T,"; + JRST DEFNSM ;ALLOW DEFINE LINE TO BE COMMENTED +DEFND: PUSH P,A + CALL GSYL ;READ IN SYMBOL AS SQUOZE IN SYM. + REST A + CAIN T,"/ ;/ MEANS PREVIOUS ARG IS WHOLE-LINE. + XORI LINK,MCFLIN#MCFNRM + JUMPE SYM,DEFNC ;JUMP IF SYMBOL NAME WAS NULL. + CALL PDEF1 ;ELSE PUSH IT ON LIST OF DUMMIES. + MOVE A,LINK + CAIE T,"= + JRST DEFNL + IORI A,MCFDEF ;ONE ARG, WITH DEFAULT VALUE. + ANDCMI A,MCFGEN ;NOT TO BE GENSYMMED. +DEFNL: CALL PUTREL ;OUTPUT A DESCRIPTOR FOR THIS ARG + TRNE LINK,MCFKWD + CALL DEFNM ;PUT OUT ARG NAME IF KWD ARG + CAIE T,"= ;THEN DEFAULT VALUE IF DEFAULTED. + JRST DEFNI + JSP D,RARG ;INIT. FOR READING THE DEFAULT VALUE. + CAIA + CALL RARGCP ;COPY THE ARG INTO MACRO SPACE, + CALL PUT377 ;TERMINATED BY A 377. + JRST DEFNI ;NOW FOR THE NEXT ARG. + +DEFNM: MOVE D,[440700,,STRSTO] +DEFNM1: ILDB A,D + CAMN D,STRPNT + JRST PUT377 + CALL PUTREL + JRST DEFNM1 + +DEFEVL: SKIPA A,[MCFEVL] ;TURN EVALUATEDNESS ON OR OFF. +DEFASC: MOVEI A,MCFSTR ;TURN ASCIINESS ON OR OFF. + JRST DEFN9 +DEFKST: MOVEI A,MCFKST ;TURN KEEP-STRUNGNESS ON OR OFF. + JRST DEFN9 +DEFBAL: SKIPA A,[MCFBAL] ;TURN ON BALANCEDNESS, BUT IF ALREADY ON TURN OFF. +DEFWHL: MOVEI A,MCFLIN ;SIMILAR FOR WHOLELINENESS. +DEFN9: LDB B,[.BP MCFSYN,LINK] + CAMN A,B ;IF CURRENT STATE IS SAME AS IN A, + MOVEI A,MCFNRM ;SWITCH TO NORMAL MODE INSTEAD. + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNB2: SKIPA A,[MCFNRM] ;TURN OFF BALANCEDNESS +DEFNB1: MOVEI A,MCFBAL ;TURN ON BALANCEDNESS + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNSM: PUSHJ P,RCH ;SEMICOLON IN DEFINE LINE + CAIE A,15 + CAIN A,12 +DEFNA: SKIPA A,LINK ;END OF DEFINE LINE, GET COUNT + JRST DEFNSM + MOVEI A,0 + PUSHJ P,PUTREL ;DEPOSIT END-OF-DESCRIPTORS MARK + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD ;CHAR AFTER CR NOT LF + PUSHJ P,WRQOTE ;READ IN BODY + JRST STPWR + +;COME HERE TO EXPAND MACRO; LH OF B POINTS TO STRING. +;SYM HOLDS NAME OF MACRO (USED BY CALL TO AGETFD IN MACEVL). +MACCL: JSP TM,ERMARK ;ERROR MESSAGE DURING ARG SCAN SHOULD SAY WE'RE IN IT. + MOVEI A,RCHSV1 +A.TYM2: PUSH P,I + AOS PRCALP + AOS MDEPTH + PUSH P,RDWRDP + PUSH P,A ;RCHSV1 FOR MACRO, A.TYM8 FOR .TTYMA + MOVEI LINK,0 + HLRZ A,B + PUSHJ P,REDINC + CAIE B,374 + HALT + MOVEM A,@PRCALP + PUSHJ P,REDINC + TLZ I,ILPRN + JUMPE B,MACCLE ;MACRO TAKES NO ARGS => UN-READ NEXT CHARACTER. + MOVE A,LIMBO1 + CAIE A,") ;MACRO NAME TERMINATED WITH A CLOSE-BRACKET OF SOME SORT + CAIN A,"> ;=> UN-READ THE FOLLOWING CHARACTER. + JRST MACCLE + CAIN A,RBRKT + JRST MACCLE + CAIE A,15 ;MACRO NAME ENDED BY A CR OR LF => + CAIN A,12 + JRST MACCLD ;NO ARGS IN THIS CALL; NULLIFY ALL ARGS. + CAIE A,"< + CAIN A,"( + TLO I,ILPRN ;BUT MAYBE THERE IS A (. IF SO, IT'S A PAREN'D CALL, + CAIN A,LBRKT ;AND WON'T END TILL THE MATCHING CLOSE. + TLO I,ILPRN + CAIE A,40 ;IF THE CHAR ENDING THE MACRO NAME ISN'T AN OPENPAREN, + CAIN A,^I ;EOL, OR SPACE, RE-READ IT AS PART OF 1ST MACRO ARG. + JRST MACNX0 + TLNN I,ILPRN + TLO FF,FLUNRD +MACNX0: TDZ LINK,LINK +MACNXD: CALL MACDES ;FETCH NEXT DESCRIPTOR + JRST MACPUS ;NO MORE => THIS IS END OF THE CALL + TRNE LINK,MCFKWD + JRST MACK ;KEYWORD PARAM => SPECIAL SCANNER +;READ IN THE VALUE OF THE NEXT ARG, WHICH IS NORMAL (NOT KEYWORD) +MACNRM: CALL ADDTRN ;PUSH WORD TO HOLD VALUE OF ARG ONTO DSTG, + ;INITIALIZED -> FREEPT, WHERE WE WILL NOW WRITE THE ARG. + SOS C,A ;TELL MACRED WHERE THAT WORD IS. + CALL MACRED ;READ IN THE ARGUMENT VALUE. + JRST MACNXD ;THEN HANDLE ANOTHER ARG + .VALUE + JRST MACCLD ;END OF ARG LIST => NULLIFY REMAINING ARGS. + +MACCLE: TLO FF,FLUNRD ;SAVE CHR FOLLOWING MACRO W/NO ARGUMENTS + ;AND IF THAT CHAR WAS A CLOSE-BRACKET, + SKIPE B,ASMOUT ;CLEAR OUT THE CHANGE IT MADE TO ASMDSP. + CAIN B,4 + CAIA + JSP LINK,SAVAS2 + SETZ LINK, + JRST MACCLD ;NOW GO NULLIFY ANY ARGS THE MACRO WANTED, AND EXIT. + +;READ IN THE NEXT MACRO ARGUMENT ACC TO SYNTAX FLAGS IN LINK. +;C HAS ADDRESS OF WORD ON THE RDWRDP STACK WHICH HOLDS THE POINTER TO THIS ARG +;IN CASE WE WISH TO SET THE ARG TO THE NULL STRING. B AND LINK NOT CLOBBERED. +;RETURNS SKIPPING TWICE IF NO ARG BECAUSE END OF MACRO CALL SEEN. +MACRED: MOVEI D,MACNXR ;RARL3, RARB, RARGBR RETURN TO MACNXR + CALL RCH + CAIE A,^M + CAIN A,^J + JRST MACEND ;MAYBE WE HAVE REACHED THE END OF THE MACRO CALL. + LDB B,[.BP MCFSYN,LINK] + CAIN B,MCFLIN + JRST RARL3 ;ELSE, IF WHOLELINE ARG, NOTHING ELSE TO CHECK, + ;SO INIT FOR READING IT IN. + CAIN A,", + JRST MACNUL ;NON-WHOLELINE ARG IS NULL IF NEXT CHAR IS COMMA + CAIN A,"; ;SEMICOLON ENDS ARG LIST UNLESS INSIDE WHOLELINE ARG + JRST MACEND + CAIN B,MCFBAL + JRST RARB ;FOR BALANCED ARG, NOTHING ELSE SPECIAL, SO INIT. + CAIE B,MCFSTR ;FOR BOTH FLAVORS OF STRUNGNESS, + CAIN B,MCFKST ;GO GOBBLE AN ASCIZ-STYLE ARGUMENT. + JRST MACSTR + CAIN B,MCFEVL ;FOR EVALUATED ARG, READ FIELD AND EXPRESS AS NUMERAL. + TLOA FF,FLUNRD ;AND THE CHAR WE JUST READ WAS THE 1ST CHAR OF THE FIELD. + CAIN A,"\ ;NORMAL ARG STARTING WITH "\" TREATED THE SAME WAY, BUT FIELD + JRST MACEVL ;STARTS WITH NEXT CHAR. + CAIN A,LBRKT + JRST RARGBR ;FOR ORDINARY ARG, OPEN-BRACKET MAKES IT SPECIAL +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + MOVEI T,RARGN ;OTHERWISE IT'S A NORMAL ARG + TLOA FF,FLUNRD ;AND THE CHAR WE RCH'ED IS THE 1ST CHAR OF IT +MACNXR: JRST MACEN1 ;NON-SKIP RETURN FROM RARB, RARL3 OR RARGBR => ARG NULL + CALL RARGCP ;ARG NON-NULL => COPY IT INTO STRING SPACE + CAIE A,"; +CSTPWR: JRST STPWR ;AND TERMINATE IT +MACSC: MOVE A,(C) ;EXCEPT THAT SEMICOLONS INVALIDATE ALL THE SPACES + CAME A,FREEPT ;AND TABS THAT PRECEDE THEM. + JRST STPWR ;IF, AS A RESULT OF THAT, THE ARG IS NULL, END THE ARGLIST. +;COME HERE WHEN THE END OF THE MACRO'S WHOLE ARGLIST IS SEEN. +MACEND: TLO FF,FLUNRD +MACEN1: AOS (P) ;2-SKIP RETURN FROM MACRED INDICATES END OF ARGLIST + AOS (P) ;END OF ARGLIST => THIS ARG IS NULL. +;COME HERE TO NULLIFY CURRENT ARG (WHERE C POINTS) +MACNUL: TRZE LINK,MCFDEF + JRST MACDEF ;MAYBE DEFAULT IT + TRNE LINK,MCFGEN + JRST MACGEN ;MAYBE GENSYM IT + SETZM (C) ;ELSE SET TO NULL STRING. + RET + +MACST1: CALL RCH + CAIN A,", + JRST MACNUL +MACSTR: CAIE A,40 ;HERE FOR ARG DELIMITED LIKE TEXT STRINGS: /TEXT/. + CAIN A,^I ;SKIP ALL SPACES AND TABS BEFORE THE ARG. + JRST MACST1 + JSP D,RARB ;FIND END OF LINE, COMMENT, OR CLOSEBRACKET => + JRST MACEND ;NULLIFY ARG AND END MACRO CALL. + MOVEI T,(A) ;ELSE SAVE THIS CHAR; IT'S THE DELIMITER. + TLZ FF,FLUNRD ;DON'T RE-READ DELIMITER, + CAIN B,MCFKST ;BUT IF ARG IS KEEP-STRUNG, DROP THRU TO STORE IT. +MACST2: CALL PUTREL + CALL RCH ;READ ANOTHER CHARACTER. IF IT ISN'T THE DELIMITER, + CAIE A,(T) + JRST MACST2 ;STORE IT AND READ ANOTHER. + CAIN B,MCFKST ;HIT DELIMITER, DONE. BUT IF ARG IS KEEP-STRUNG, + CALL PUTREL ;KEEP DELIMITER BY STORING IT TOO. + CALL STPWR +MACST3: CALL RCH ;PASS BY SPACES AFTER THE CLOSING DELIMITER + CAIE A,40 + CAIN A,^I + JRST MACST3 + CAIE A,", ;COMMA HERE ENDS THE ARG BUT NOT THE MACRO CALL. + JSP D,RARB ;ELSE CHECK FOR OTHER TERMINATORS. + RET ;WE FOUND AN ACCEPTABLE ARG TERMINATOR. + ETR [ASCIZ /Garbage in ASCIZ-style macro arg/] + JRST RARFLS ;IF THERE'S ANYTHING ELSE, COMPLAIN AND SKIP IT. + +;COME HERE TO GIVE AN ARG ITS DEFAULT VALUE. +;MCFDEF WAS CLEARED SO MACDES WILL KNOW THE DEFAULT VALUE HAS +;ALREADY BEEN PASSED OVER AND WON'T TRY TO SKIP OVER IT. +;IF MCFKWD IS SET, WE MUST SKIP OVER THE KWD ARG'S NAME FIRST. +MACDEF: MOVE A,@PRCALP ;COPY THE DEFAULT VALUE FROM THE MACRO BODY + TRZN LINK,MCFKWD + JRST MACDF1 +MACDF0: CALL REDINC + CAIE B,377 + JRST MACDF0 +MACDF1: CALL REDINC ;AS THE ARGUMENT STRING. + CAIN B,377 + JRST MACDF2 ;END OF THE DEFAULT VALUE. + EXCH A,B + CALL PUTREL + EXCH A,B + JRST MACDF1 + +MACDF2: MOVEM A,@PRCALP + JRST STPWR + +;COME HERE IF GENSYMMABLE ARG IS SPEC'D AS NULL. +MACGEN: MOVEI A,5 + MOVEM A,SCKSUM + MOVEI A,"G + PUSHJ P,PUTREL + PUSH P,CSTPWR + AOS A,GENSM + IDIVI A,10 + HRLM B,(P) + SOSLE SCKSUM + PUSHJ P,.-3 + JRST MACEV2 + +;PROCESS ARG THAT STARTS WITH \, OR #-TYPE ARG. +MACEVL: CALL RCH ;FIRST, CHECK FOR IMMEDIATE END OF MACRO CALL. + JSP D,RARB + JRST MACEN1 + PUSH P,C + PUSH P,LINK ;SAVE LINK, NEED FLAGS + PUSHJ P,AGETFD ;GET THE FIELD + SKIPE B + ETR [ASCIZ /Relocatable \'d macro arg/] + POP P,LINK + REST C ;IF AGETFD EXPANDED A MACRO, FREEPT HAS CHANGED, SO + MOVE CH1,FREEPT ;PUT NEW VALUE INTO THE POINTER TO THIS DUMMY. + MOVEM CH1,(C) + MOVE CH1,A ;SAVE VALUE OF FIELD FROM CLOBBERAGE + PUSH P,CSTPWR +MACEV1: LSHC CH1,-35. ;NOW "TYPE OUT" VALUE OF FIELD IN CURRENT RADIX + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,MACEV1 +MACEV2: HLRZ A,(P) + ADDI A,60 + JRST PUTREL ;OUTPUT TO MACTAB STRING BEING DEFINED + +;HANDLE KEYWORD PARAMETERS. COME HERE WHEN A DESCRIPTOR IS SEEN +;THAT SPECIFIES A KEYWORD PARAMETER. +MACK: PUSH P,RDWRDP + PUSH P,@PRCALP + PUSH P,LINK +;FIRST, PUSH A "NOT SET" MARKER FOR EACH OF THE KEYWORD PARAMS IN THIS RUN OF SUCH. +MACK2: SETO A, + CALL ADDTR2 + CALL MACDES ;NOTE THAT THERE IS ONLY ONE PARAM PER DESCRIPTOR + JRST MACK1 ;FOR KEYWORD PARAMS, SO NO NEED TO COUNT DOWN. + TRNE LINK,MCFKWD + JRST MACK2 +MACK1: REST LINK + REST @PRCALP ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM. +MACKLP: CALL GPASST ;NOW SEE IF THERE'S AN ARGUMENT TO BE FOUND + CAIE A,^M ;IF SO, IT SHOULD START WITH A KEYWORD. + CAIN A,^J + JRST MACKND ;CR OR LF => NO KEYWORD, AND END SCAN. + CAIN A,"; + JRST MACKND + CAIN A,", + JRST MACKN1 ;NULL ARG => NO KEYWORD, BUT DON'T END SCAN. + CAIE A,") + CAIN A,"> + JRST MACKND ;DETECT END OF PARENTHESIZED CALLS, ETC. + CAIE A,RBRKT + CAIN A,RBRACE + JRST MACKND + TLO FF,FLUNRD + CALL GSYL ;THERE SHOULD BE ANOTHER ARG, SO TRY READING KEYWORD NAME + CALL PASSPS + MOVE C,(P) ;NOW SCAN THROUGH THIS RUN OF KEYWORD PARAMS FOR THE + PUSH P,@PRCALP ;ONE WHOSE NAME MATCHES WHAT GSYL READ. + PUSH P,LINK + CAIE A,"= + JRST MACKL5 ;NOT FOLLOWED BY "="?? + DPB A,STRPNT +MACKL4: MOVE D,[440700,,STRSTO] + MOVE A,@PRCALP +MACKL1: CALL REDINC + ILDB AA,D + CAIN B,377 ;IF REACHED END OF KEYWORD'S NAME, AND EQUAL SO FAR + JRST MACKL2 ;SEE IF ARG'S NAME ALSO OVER. + CAMN B,AA + JRST MACKL1 ;ELSE KEEP COMPARING IF NAMES STILL SAME SO FAR. +MACKL6: MOVEM A,@PRCALP + CALL MACDES ;THIS KEYWORD DOESN'T MATCH SO FIND THE NEXT + JRST MACKL3 ;THERE ARE NO MORE; LOSE - ARG WITH BAD KEYWORD. + TRNN LINK,MCFKWD + JRST MACKL3 + AOJA C,MACKL4 + +MACKL5: ETR [ASCIZ /Bad format keyword argument/] + TLOA FF,FLUNRD ;INCLUDE THE BAD NON-"=" AS PART OF WHAT WE DISCARD +MACKL3: ETR [ASCIZ /Arg with undefined keyword/] + MOVEI T,RARGN + CALL RARFLS ;SKIP AN ORDINARY-SYNTAX MACRO ARG TO TRY TO RECOVER. + JRST MACK1 + +;COME HERE AFTER FINDING THE PARAM THAT MATCHES THIS ARG. +;C POINTS TO THE WORD IN DSTG FOR THAT ARG (DSTG IS WHAT ADDTRN PUSHES IN) +MACKL2: TRZ LINK,MCFKWD ;(IN CASE WE GO TO MACKL6, SINCE KWD NAME SKIPPED ALREADY) + CAIE AA,"= + JRST MACKL6 ;KWD NAME OVER BUT SPEC'D NAME NOT => MISMATCH + MOVEMM (C),FREEPT + CALL MACRED ;READ IN THE VALUE OF THE ARG, THUS SETTING THIS PARAM. + JRST MACK1 ;THERE ARE MORE ARGS => HANDLE THEM + .VALUE + REST LINK + REST @PRCALP +MACKND: TLO FF,FLUNRD ;MACRO CALL TERMINATOR SEEN. +;NULL ARG SEEN; ENDS THIS RUN OF KEYWORD ARGS BUT NOT THE CALL. +MACKN1: REST C ;GET PTR TO 1ST KWD ARG'S VALUE-WORD +MACKN2: MOVE A,(C) + AOJN A,MACKN4 ;IF THIS ARG WASN'T SPECIFIED, + MOVEMM (C),FREEPT + CALL MACNUL ;NULLIFY IT (MAYBE DEFAULT OR GENSYM) +MACKN4: CALL MACDES ;NOW SKIP OVER THE DESCRIPTORS OF THIS RUN OF KEYWORD PARAMS + JRST MACPUS ;EXHAUSTED ALL THE DESCR'S => END OF MACRO CALL. + TRNE LINK,MCFKWD ;SAME IF REACH A NON-KWD ARG. + AOJA C,MACKN2 + TLNN FF,FLUNRD ;REACHED A NON-KEYWORD PARAM: IF TERMINATOR WAS A NULL ARG, + JRST MACNRM ;GO ON TO READ THE VALUE OF THE NON-KEYWORD PARAM. + JRST MACCLS ;ELSE CALL WAS REALLY ENDED, SO NULLIFY REMAINING ARGS. + +;COME HERE TO FIND THE NEXT DESCRIPTOR. +;SKIPS OVER THE NAME AND DEFAULT VALUE OF THE PREVIOUS DESCRIPTOR, IF ANY. +;THE CONTENTS OF LINKK SAY WHETHER THEY EXIST TO BE SKIPPED OVER. +MACDES: MOVE A,@PRCALP + CALL REDINC ;READ NEXT CHAR OF MACRO + MOVEM A,@PRCALP + TRNE LINK,MCFKWD\MCFDEF + JRST [ CAIE B,377 ;IF THERE'S NAME OR DEFAULT TO SKIP, GO PAST TERMINATOR + JRST MACDES + TRZN LINK,MCFKWD ;AND SAY WE FOUND ONE + TRZ LINK,MCFDEF ;NOTE THERE MAY BE ANOTHER, IN WHICH CASE WE WILL + JRST MACDES] ;SKIP TILL ANOTHER 377 + JUMPE B,CPOPJ ;THIS DESC IS TERMINATOR => RETURN NO SKIP. + MOVEI LINK,(B) ;ELSE PUT FLAGS IN LINK. + JRST POPJ1 + +;COME HERE WHEN A MACRO CALL TERMINATOR IS ENCOUNTERED, TO NULLIFY ALL +;THE REMAINING PARAMS THAT THE MACRO WANTS, THEN ENTER THE MACRO. +;ENTER AT MACCLS IF HAVE JUST READ A DESCRIPTOR AND NOT NULLIFIED THE ARG, +;OR AT MACCLD IF HAVE JUST PROCESSED AN ARG, TO READ THE NEXT DESCRIPTOR. +MACCLS: TRNE LINK,MCFDEF\MCFGEN + JRST MACCL2 + SETZ A, ;NULLIFY NON-GENSYMMED, NON-DEFAULTED ARGS QUICKLY + CALL ADDTR2 +MACCLD: CALL MACDES ;THEN READ THE NEXT DESCRIPTOR. + JRST MACPUS ;IF NO MORE ARGS, ENTER THE MACRO. + JRST MACCLS + +MACCL2: CALL ADDTRN ;FOR GENSYMMED OR DEFAULTED ARG, PUSH PTR TO FREE STG + SOS C,A + CALL MACNUL ;THEN WRITE THE DESIRED VALUE THERE + JRST MACCLD ;THEN HANDLE NEXT DESCRIPTOR. + +;COME TO MACPUS WHEN ALL THE PARAMS HAVE HAD VALUES PUT IN DSTG (USING ADDTRN) +;TO ENTER THE MACRO. +MACPUS: TLZE I,ILPRN ;SPECIAL PARENTHESIZED CALL? + CALL MACPRN ;YES, SKIP PAST THE CLOSING PAREN. + MOVE B,(P) ;IS THIS A .TTYMAC? + CAIN B,A.TYM8 + CALL A.INEO ;YES, POP OUT OF TTY AFTER READING ARGS. + JFCL + REST B ;RCHSV1 OR A.TYM8 + PUSHJ P,PUSHEM + MOVE A,@PRCALP + PUSHJ P,ACPTRS ;SET UP CPTR + POP P,A + PUSHJ P,DMYTRN + SOS PRCALP + REST I +MACCR: AOS (P) ;COMMON RETURN FROM PSEUDOS TO RETURN FROM GETVAL WITHOUT VALUE +CMACCR: POPJ P,MACCR + +MACPRN: MOVEI TT,1 ;START PAREN-DEPTH AT 1 + JSP D,RARBC ;AND READ CHARS, UPDATING THE DEPTH, UNTIL + HALT + JUMPN TT,.-2 ;THE DEPTH GETS TO BE 0. + RET + +A.GOMC: ILDB B,A ;.GO ROUTINE TO SKIP PAST DESCRIPTORS + JUMPN B,A.GOMC ;IN HEADER OF MACRO DEFINITION. + JRST A.GORT + +RCHSV1: SOS MDEPTH ;END OF MACRO EXPANSION, DECREMENT DEPTH IN MACRO EXPANSIONS +A.TYM8: PUSH P,A ;ENTRY FROM .TTYMAC END OF EXPANSION + MOVE B,TOPP +RCHSV3: CAMG B,BBASE + JRST RCHSV2 + HLRZ A,-1(B) + ADD A,-1(B) + MOVEI A,1(A) + CAME A,FREEPT + JRST RCHSV2 + HRRZ A,-1(B) ;GET NEW FREEPT + SOJA B,RCHSV3 + +RCHSV2: POP P,A + ;RETURN ROUTINE FOR END OF DUMMY +RCHSAV: MOVE B,BBASE + MOVEM B,TOPP + PUSHJ P,POPEM + HLRM B,BBASE +REPT6: TRZE FF,FRMRGO + POPJ P, ;RETURN TO .GO + JRST RCHTRB + +;IRP, IRPS, IRPC, IRPW, IRPNC ALL CALL HERE. +;ALL USE 2 FRAMES ON THE MACRO PDL: +; ,, +; ,, +; \<# GROUPS>,, +; ,,AIRR +;THE 3RD WORD HAS IN BITS 4.1-4.3 THE IRP TYPE CODE +; (NIRPO, NIRPC, ETC) +;AND IN THE REST OF THE LH, THE NUMBER OF GROUPS +; (TRIPLES OF TWO DUMMIES AND A LIST) + +.SEE NIRPO ;FOR DEFINITIONS OF IRP TYPE CODES. + +AIRP: JSP TM,ERMARK ;ERROR MESSAGES SHOULD SAY WE'RE INSIDE IT. + PUSH P,I + PUSH P,RDWRDP + HLRZ LINK,B ;GET IRP TYPE CODE TO INDEX BY. + CAIE LINK,NIRPN + JRST AIRP0 + CALL AGETFD ;IRPNC, READ THE 3 NUMERIC ARGS. + PUSH P,A + CALL AGETFD + PUSH P,A + CALL AGETFD + MOVEM A,AIRPN2 ;THE LAST ARG, + REST AIRPN1 ;THE MIDDLE, + REST AIRPN0 ;THE FIRST. + MOVEI LINK,NIRPN +AIRP0: SETZM IRPCR ;NO GROUPS SEEN YET. + +;FALLS THROUGH. + +;FALLS THROUGH. + +;TRY TO READ IN ANOTHER GROUP. +AIRP1: CALL PDEF ;READ IN DUMMY NAME, PUSH ON DMYTOP. + CAIE T,", ;TERMINATOR WASN'T COMMA AND NAME WAS NULL + JUMPE SYM,AIRP2 ;=> NO MORE GROUPS. + CALL PDEF ;NONNULL GROUP, READ & PUSH 2ND NAME. + CAIN T,"[ ;] TRY TO DETECT "IRP X,[", ETC. ] + CALL [ETR [ASCIZ/Comma missing in IRP/] + TLO FF,FLUNRD ;GENERATE A COMMA. + RET] + CALL ADDTRN ;PUSH CHAR ADDR OF 1ST DUMMY, + CAIE LINK,NIRPS + CAIN LINK,NIRPC ;LEAVE SPACE FOR IRPC'S 1ST ARG, IRPS'S 2ND. + CALL PUT377 + MOVE A,RDWRDP + CAIN LINK,NIRPS + AOS -1(A) ;IRPS - 1ST ARG GOES AFTER NEXT 377. + CALL ADDTRN ;PUSH CHAR ADDR OF 2ND DUMMY. + CALL PUT377 + MOVE A,RDWRDP + XCT AIRP1T-1(LINK) ;MAYBE INCREMENT THAT ADDR. + AOS IRPCR ;ONE MORE GROUP SEEN. + JSP D,RARG ;INITIALIZE READING LIST. + JRST AIRP3 ;NO LIST. + JRST @.(LINK) + OFFSET 1-. +NIRPO:: AIRPO ;IRP +NIRPC:: AIRPC ;IRPC +NIRPS:: AIRPS ;IRPS +NIRPW:: AIRPW ;IRPW +NIRPN:: AIRPN ;IRPNC + OFFSET 0 + +AIRP1T: AOS -1(A) + AOS -1(A) ;INCR. THE 2ND DUMMY ADDR FOR IRP, IRPC. + SOS -1(A) + JFCL ;DECR. FOR IRPS, NOTHING FOR IRPW. + AOS -1(A) ;INCR. FOR IRPNC. + +;READ LIST FOR IRPC OR IRP AND STUFF INTO STRING. +AIRPC: +AIRPO: CALL RARGCP ;COPY UP TO END OF ARG INTO MACRO SPACE. + JRST AIRP3 + +AIRPW3: CALL PUT377 ;END A LINE, + CAIGE C, + CALL PUT377 ;IF NO ; YET, MAKE NULL 2ND ARG. +;COME HERE FOR IRPW, LOOP BACK FOR NEXT LINE. +AIRPW: SETO C, ;NO ; SEEN YET IN LINE. +AIRPW1: JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST, GO WRITE 375. + CAIE A,^M + CAIN A,^J + JRST AIRPW1 ;IGNORE NULL LINES. +AIRPW4: CAIN A,"; + AOJE C,AIRPW2 ;ON 1ST SEMI, SWITCH TO 2ND ARG. + CAIE A,^J + CAIN A,^M + JRST AIRPW3 ;END OF LINE => END BOTH ARGS, START OVER. +AIRPW5: CALL PUTREL + JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST. + JRST AIRPW4 + +AIRPW2: MOVEI A,377 + JRST AIRPW5 + +AIRPS: SETO C, ;NO SQUOZE CHAR SEEN YET. +AIRPS2: JSP D,RARGCH(T) + JRST AIRP3 + HLRZ CH1,GDTAB(A) + CAIN CH1,(RET) + CAIN A,"! + AOJA C,AIRPS0 ;A SQUOZE CHAR OR !. + JUMPL C,AIRPS2 ;NON SQUOZE FOLLOWING ANOTHER, FLUSH. + DPB A,AIRPSP ;NONSQUOZE ENDING NONNULL SYL, PUT BEFORE SYL. + SETZM AIRPSP + CALL PUT377 ;FOLLOW SYL WITH 377. + JRST AIRPS + +AIRPS0: JUMPN C,AIRPS3 ;NOT 1ST CHAR IN SYL? + PUSH P,A + CALL PUT377 ;1ST, LEAVE A SPACE FOR THE SYL'S TERMINATOR. + MOVE A,FREPTB + MOVEM A,AIRPSP ;REMEMBER WHERE THE SPACE IS. + REST A +AIRPS3: CALL PUTREL + JRST AIRPS2 + +AIRPN: SKIPG C,AIRPN0 ;ANY CHARS TO IGNORE? + JRST AIRPN4 + JSP D,RARGCH(T) + JRST AIRP3 + SOJG C,.-2 +AIRPN4: SKIPN C,AIRPN2 ;GET MAX # GRPS OF CHARS. + JRST AIRPN7 ;0 => IGNORE THE REST. +AIRPN5: MOVE B,AIRPN1 ;DO NEXT GRP, GET # CHARS/GRP. +AIRPN6: JSP D,RARGCH(T) + JRST AIRP3 + CALL PUTREL ;STORE THE NEXT CHAR. + SOJG B,RARGCH(T) ;COUNT CHARS IN GRP. + MOVEI A,376 + CALL PUTREL ;FOLLOW GRP BY 376. + SOJN C,AIRPN5 ;MAYBE CAN DO MORE GRPS. +AIRPN7: CALL RARFLS ;DID AS MANY GRPS AS CAN DO, + ;IGNORE REMAINDER OF LIST. + +;COME HERE WHEN EXHAUST THE LIST. +AIRP3: CALL STPWR + JRST AIRP1 ;READ ANOTHER GROUP. + +;ALL GROUPS READ IN; NOW READ IN BODY. +AIRP2: CAIE T,"; ;IF A SEMICOLON ENDED THE ARGS, SKIP THE COMMENT. + JRST AIRP4 +AIRP5: CALL RCH + CAIE A,^M + JRST AIRP5 +AIRP4: PUSH P,LINK + MOVE A,FREEPT ;SAVE CHAR ADDR START OF BODY + MOVEM A,PRIRP ;WHERE GC WILL RELOCATE IT. + PUSHJ P,RCH ;IF NEXT CHAR LF, THEN FLUSH IT + CAIE A,12 + TLO FF,FLUNRD + PUSHJ P,WRQOTE ;READ BODY OF IRP + PUSHJ P,STPWR ;WRITE STOP + PUSHJ P,PUSHEM ;SAVE WORLD + REST LINK + POP P,A ;RESTORE RDWRDP FROM LONG AGO + PUSH P,TOPP ;NOW SAVE TOPP + PUSHJ P,DMYTRN ;ACTIVATE DUMMYS + MOVE B,MACP ;NOW GET MACRO PDL POINTER + MOVE A,CIRPCT ;GET .IRPCNT + HRRM A,(B) ;CLOBBER "RETURN" ON PDL TO OLD IRPCNT + SETOM CIRPCT ;INITIALIZE IRPCNT + MOVS A,IRPCR ;GET # GROUPS + HRR A,PRIRP ;CHAR ADR OF BEGINNING OF BODY + SETZM PRIRP + DPB LINK,[410300,,A] ;PUT IN TYPE OF IRP. + PUSH B,A ;PUSH ,,CHAR ADR BEGINNING + POP P,A ;NOW GET OLD TOPP + HRLS A ;MOVE TO LEFT HALF + HRRI A,AIRR ;RETURN TO AIRR ON END OF BODY + PUSH B,A ;PUSH OLD TOPP,,AIRP4 + MOVEM B,MACP ;STORE BACK UPDATED MACRO PDL POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP RIGHT AWAY TO CAUSE CYCLING + REST I + JRST MACCR + +;RECYCLE THROUGH IRP + + ;AC ALLOCATIONS: +AIRR: PUSH P,A ;A GETS BP ILDBING THRU ARG LIST. + PUSH P,C ;C # GROUPS LEFT + PUSH P,T ;T ADR OF PAIR OF CHAR ADR'S OF DUMMYS + PUSH P,TT ;TT TYPE OF IRP (NIRPO, NIRPC, ETC) + AOS CIRPCT ;INCREMENT .IRPCNT + HRRZ A,(B) ;GET CHARACTER ADR BEG BODY FROM PDL + PUSHJ P,ACPTRS ;SET UP CPTR + SETOM AIRPT + TRNE FF,FRMRGO + JRST AIRR9 ;RETURN TO .GO + HLRZ T,1(B) ;DUMMY TAB ADR + LDB C,[220600,,(B)] ;# GROUPS + JUMPE C,AIRR9 ;JUMP IF NO GROUPS + LDB TT,[410300,,(B)] ;GET TYPE OF IRP (NIRPO, ETC) +AIRR6: JRST @.+1(TT) +AIRRER ? AIRRO ? AIRRC ? AIRRS ? AIRRW ? AIRRN ? AIRRER ? AIRRER +AIRRER: .VALUE + +;MOVE 1 ARG THRU 1 GROUP OF IRP. +AIRRO: HRRZ A,1(T) ;THE 1ST ARG WILL START THIS TIME + HRRZM A,(T) ;WHERE THE "REST OF STRING" STARTED LAST TIME. + BCOMP A,-1 ;GET BP THAT'LL ILDB THAT CHAR. + SETO CH1, ;COUNT [-] DEPTH. +AIRRO1: ILDB B,A + CAIN B,375 + JRST AIRRO4 ;END OF STRING IS END OF ARG. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIN B,"[ + AOJE CH1,AIRRO3 ;FLUSH OUTERMOST [-] PAIRS. + CAIN B,"] + SOJL CH1,AIRRO3 + JUMPGE CH1,AIRRO1 ;DON'T LOOK FOR , WITHIN [-]. + CAIE B,^J + CAIN B,", + JRST AIRRO2 ;END OF ARG. + CAIE B,^M ;^M IS IGNORED (FLUSHED.) + JRST AIRRO1 +AIRRO3: MOVEI B,376 ;FLUSH A CHAR BY REPLACING WITH 376 + DPB B,A + JRST AIRRO1 + +AIRRC4: SUB P,[1,,1] +AIRRC3: SETZM (T) ;NULLIFY BOTH ARGS PERMANENTLY. +AIRRO4: SETZM 1(T) ;NULLIFY 2ND ARG PERMANENTLY + JRST AIRR8 ;DONE WITH THIS GROUP. + +AIRRO2: MOVEI B,377 ;REPLACE CHAR THAT ENDED ARG WITH TERMINATOR. + DPB B,A +AIRRW3: CCOMP1 A,-1 ;GET ADDR OF CHAR AFTER. + HRRZM B,1(T) ;"REST OF STRING" STARTS THERE. + JRST AIRR8 + +AIRRN: MOVE A,1(T) ;NEW 1ST DUMMY STARTS AT OLD "REST OF STRING". + MOVEM A,(T) + BCOMP A,-1 ;NEW "REST OF STRING" STARTS AFTER 376, + JRST AIRRW2 ;WHICH WILL BECOME A 377. + +AIRRW: MOVE A,1(T) ;GET CHAR ADDR START OF 2ND HALF OF PREV LINE. + CALL AIRRM ;SET 1ST DUMMY -> AFTER NEXT 376 OR 377 . +AIRRW2: ILDB B,A ;MOVE UP TO NEXT 377 OR END OF STRING. + CAIN B,375 ;END OF STRING ENDS 1ST DUMMY'S ARG => + JRST AIRRO4 ;NULLIFY THE 2ND DUMMY. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIGE B,376 + JRST AIRRW2 + JRST AIRRO2 ;SET UP 2ND DUMMY -> NEXT CHAR. + + +;MOVE UP IN 1 GROUP OF IRPS. +AIRRS: MOVE A,(T) ;MOVE FROM 1ST DUMMY, + CALL AIRRM ;PUT 1ST DUMMY AFTER NEXT 377, + AOS (T) ;MOVE IT PAST THE SYL'S TERMINATING CHAR, + ILDB CH1,A ;GET THAT CHAR, + MOVE A,1(T) + JRST AIRRS2 ;STORE AS 2ND DUMMY. + +AIRRM: BCOMP A,-1 ;A HAS CHAR ADDR; WILL ILDB THAT CHAR. +AIRRM1: ILDB B,A + CAIN B,375 ;END OF STRING => NULLIFY BOTH ARGS + JRST AIRRC4 ;AND FINISHED WITH GROUP. + CAIE B,377 + JRST AIRRM1 + MOVE CH1,A + CCOMP1 CH1,-1 ;GET CHAR ADDR OF CHAR AFTER 377 + MOVEM CH2,(T) ;PUT 1ST DUMMY THERE. + RET ;NOTE A NOT CLOBBERED, CAN GO ON ILDB'ING. + +;MOVE UP IN ONE GROUP OF IRPC. +AIRRC: AOS A,1(T) ;DELETE 1ST CHAR FROM "REST OF STRING". + BCOMP A,-1 ;GET BP -> THAT CHAR. + LDB CH1,A ;GET THE CHAR. + MOVE A,(T) ;GET CHAR ADDR OF PLACE TO PUT IT. +AIRRS2: CAIN CH1,375 ;REACHED END OF STRING => + JRST AIRRC3 ;NULLIFY BOTH ARGS. + BCOMP A,0 + DPB CH1,A ;STORE IT IN THE 1-CHAR ARG. +AIRR7: SETZM AIRPT ;THIS GROUP NOT EXHAUSTED YET. +AIRR8: ADDI T,2 + SOJG C,AIRR6 ;MORE GROUPS => DO THE NEXT. +AIRR9: POP P,TT ;RETURN FROM AAIRPC + POP P,T + SKIPL AIRPT + JRST REPT3 + MOVN A,[2,,2] ;ARGS EXHAUSTED, RETURN + ADDB A,MACP + HRRZ A,(A) + MOVEM A,CIRPCT + POP P,C + POP P,A + JRST RCHSAV + +;IRP ARG-STRING READING COROUTINES: CALL WITH JSP D, +;INITIALIZE FOR READIN OF ARG BUT DON'T GET A CHAR. +;SKIPS IF NONNULL ARG AVAILABLE. +;COROUTINES REMEMBER INFO IN T AND TT BETWEEN CALLS. +;THE CALLER SHOULDN'T CLOBBER THEM. +RARG: CALL RCH ;DECIDE WHAT TYPE OF ARG FOLLOWS, IF ANY. + CAIN A,LBRKT ;RARG ALLOWS [-] AND MAYBE {-} ARGS AS WELL AS SIMPLE ONES. + JRST RARGBR +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + TLO FF,FLUNRD + JSP T,RARGXT ;CAUSE FAILURE RETURN ON SEMI, CR, LF. +RARGN: CALL RCH ;RARGCH RTN FOR NORMAL ARG. +RARGX1: CAIN A,", + JRST (D) ;COMMA ENDS ARG. +RARGXT: CAIN A,"; + JRST RARGSM ;SEMI ENDS SCAN. +RARGX2: CAIE A,^M + CAIN A,^J ;CR, LF END SCAN. +RARGSM: TLOA FF,FLUNRD + JRST 1(D) + JRST (D) + +RARGBR: SETZ TT, ;TT USED AS BRACKET COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR [-] TYPE ARGS. +RARGBC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRKT + AOJA TT,1(D) + CAIN A,RBRKT + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACKET. + +RARGRR: SETZ TT, ;TT USED AS BRACE COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR {-} TYPE ARGS. +RARGRC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRACE + AOJA TT,1(D) + CAIN A,RBRACE + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACE. + +;TO GET THE NEXT CHAR OF THE ARG IN A, DO JSP D,RARGCH(T). +;SKIPS UNLESS NO MORE CHARS TO GET. +;NO SKIP AND SET => SCAN SHOULD BE TERMINATED. +;RARG SHOULD NOT BE CALLED AGAIN IN THAT CASE. +RARGCH==0 ;THIS SYMBOL IS FOR CREF'S SAKE. + +;COPY THE ARG BEING READ INTO MACRO SPACE. +;ON RETURN, A WILL HOLD "; IF ARGUMENT WAS ENDED BY ";". +RARGCP: JSP D,RARGCH(T) + JRST RARGC1 + CALL PUTREL + JRST RARGCH(T) + +RARGC1: CAIE A,"; ;IF SEMI ENDED THE ARG, FLUSH THE + RET ;SPACES AND TABS BEFORE IT. +RARGC2: LDB A,FREPTB + CAIN A,^I + JRST RARGC3 + CAIE A,40 + JRST [ MOVEI A,"; ;LAST CHAR OF ARG ISN'T SP OR TAB. + RET] ;MAKE SURE A HAS ";" IF ARG WAS ENDED BY ";". +RARGC3: SOS FREEPT ;IT IS ONE; BACK OVER IT. + MOVE A,FREPTB + DBPM A + MOVEM A,FREPTB + JRST RARGC2 + +;IGNORE THE REST OF THE ARG NOW BEING READ. +RARFLS: JSP D,RARGCH(T) + RET + JRST RARGCH(T) + +;COME HERE TO SET UP TO READ A BALANCED ARG. +;IF THERE'S NO ARG, RETURNS WOTH JRST (D). +;ELSE RETURNS WITH JRST 1(D) SETTING UNRCHF. +RARB: TLO FF,FLUNRD + SETZ TT, ;TT USED AS BRACKET COUNTER. + CAIE A,RBRACE + CAIN A,") ;IF 1ST CHAR IS A CLOSE, + JRST RARB4 ;THERE'S NO ARG. + CAIE A,"> + CAIN A,RBRKT + JRST RARB4 + JSP T,RARGXT ;CHECK FOR CR, LF, SEMI, AND RETURN. +;1-CHAR RTN FOR READING BALANCED ARG. +RARBC: CALL RCH + CAIE A,RBRACE + CAIN A,"> ;FOR CLOSES, MAYBE END ARG. + JRST RARB2 + CAIE A,") + CAIN A,RBRKT + JRST RARB2 + CAIE A,LBRACE + CAIN A,"< ;FOR OPEN BRACKETS, INCR. THE COUNT. + AOJA TT,1(D) ;OPENS CAN'T END THE ARG. + CAIE A,"( + CAIN A,LBRKT + AOJA TT,1(D) + JUMPN TT,1(D) + JRST RARGX1 ;NOT WITHIN BRACKETS, TEST FOR COMMA, ETC. + +RARB2: SOJGE TT,1(D) ;COME HERE FOR CLOSEBRKTS. +RARB4: TLO FF,FLUNRD + JRST (D) + +;COME HERE TO INIT FOR AN ARG FOR REPEAT, ETC. +;THAT IS, EITHER A BRACKETED ARG OR A 1-LINE ARG. +RARL1: CALL RCH +RARL2: +IFN BRCFLG,[ +RARL4: CAIN A,LBRACE + JRST RARGRR ;1ST CHAR A BRACE => BRACED ARG. +] + CAIN A,LBRKT ;1ST CHAR A BRKT => BRKT ARG. + JRST RARGBR + TLO FF,FLUNRD + +;INIT FOR A 1-LINE ARG. +RARL: JSP T,1(D) +;1-CHAR RTN FOR 1-LINE ARGS. +RARLC: CALL RCH + JRST RARGX2 + +IFE BRCFLG,[ +;IF BRACES AREN'T USED BY MOST THINGS, THE NORMAL ROUTINE RARL1 DOESN'T +;CHECK FOR THEM, BUT RALR4 (CALLED BY CONDITIONALS) STILL MUST. +RARL4: CAIN A,LBRACE + JRST RARGRR + JRST RARL2 +] + +;1-LINE ARGS TO MACROS: DON'T TERMINATE THE SPEC, +;AND SKIP OVER THE CR AND LF. +RARL3: TLO FF,FLUNRD + JSP T,1(D) + CALL RCH + CAIN A,^J + JRST (D) ;LF IS THE END - SKIP IT. + CAIE A,^M + JRST 1(D) + CALL RCH ;CR => SKIP FOLLOWING LF, END ARG. + CAIE A,^J + TLO FF,FLUNRD + JRST (D) + +;PUSHJ P,A.GST SEARCH CURRENT MACRO STRING FOR TAG (IN A.GST4) +;SKIP IF FOUND, RETURN ON END OF STRING ANYWAY +;BYTE POINTER (ILDB TO GET FIRST CHARACTER) IN A + +A.GST: MOVEM A,A.GST3 ;SAVE BYTE POINTER +A.GST1: ILDB B,A.GST3 ;GET CHAR + CAIL B,300 + POPJ P, ;END OF STRING => STOP + CAIE B,". + JRST A.GST1 ;WAIT FOR POINT + PUSHJ P,A.GSYL ;FOUND POINT, GET REST OF NAME + JUMPL T,CPOPJ ;RETURN ON END OF STRING + CAME SYM,[SQUOZE 0,TAG] ;TAG? + JRST A.GST1 ;NO, KEEP GOING + PUSHJ P,A.GSYL ;GET THE TAG + JUMPL T,CPOPJ ;RETURN ON END OF STRING (THERE MUST BE BREAK CHAR AFTER TAG BEFORE STOP) + CAME SYM,A.GST4 + JRST A.GST1 ;NOT THE ONE BEING LOOKED FOR + MOVE A,A.GST3 + LDB B,A ;GET UELIMITER + CAIE B,15 ;CR? + JRST POPJ1 + ILDB B,A ;CR, GET NEXT CHAR + CAIE B,12 ;LINE FEED? + MOVE A,A.GST3 ;NO, DON'T FLUSH + JRST POPJ1 + + ;LOOK BACKWARD FOR BEGINNING OF STRING, BYTE POINTER AN A + ;LEAVES POINTER POINTING AT STOP CHAR (NOT BEFORE); ALSO LEAVES STOP CHAR IN B + +AG.SP: MOVE B,(A) ;GET WORD FROM MACTAB + XOR B,[300_28.+300_20.+300_12.+300_4] ;DO XOR TO ANITIALLY SET UP + LDB CH1,[400400,,A] ;PICK UP 4 HIGH ORDER BITS OF POSITION FIELD + JRST A.GSP2-1(CH1) ;DISPATCH ON POSITION FIELD (-1 SINCE BIT SET IN POSITION FIELD) + +AG.SP3: MOVE B,(A) + XOR B,[300_28.+300_20.+300_12.+300_4] + +A.GSP2: TRNN B,300_4 + JSP CH1,AG.SF + TLNN B,3 + JSP CH1,AG.SF + TLNN B,300_2 + JSP CH1,AG.SF + TLNN B,300_10. + JSP CH1,AG.SF + SOJA A,AG.SP3 + +AG.SF: SUBI CH1,A.GSP2-1 ;GET HERE WHEN STOP CHAR FOUND + DPB CH1,[400400,,A] ;CLOBBER POSITION FIELD OF BYTE POINTER AGAIN + ILDB B,A ;INCREMENT TO UNIVERSALLY ACCEPTABLE POINTER, GETTING STOP CHAR IN B AT SAME TIME + POPJ P, ;THAT'S ALL + +A.TAG: PUSHJ P,GSYL + CAIE T,15 + JRST MACCR + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD + JRST MACCR + +A.GO: PUSHJ P,GSYL ;DOESN'T WORK RELIABLY FROM DUMMY + MOVEM SYM,A.GST4 + +A.GO1: TLNN FF,FLMAC + JRST MACCR ;NOT GETTING CHARS FROM MACRO => STOP + MOVE A,CPTR + PUSHJ P,AG.SP ;BACK TO BEGINNING + CAIN B,374 + JRST A.GOMC ;MACRO, SKIP PAST HEADER +A.GORT: PUSHJ P,A.GST + JRST A.GO2 ;END OF STRING, TRY POPPING UP ONE + MOVEM A,CPTR + JRST MACCR + +A.GO2: PUSHJ P,PMACP + JRST A.GO1 + +A.GSYL: MOVNI D,100000 ;GET SYL FOR .GO WHILE LOOKING FOR TAG + MOVEM D,STRCNT ;STRCNT .LT. 0 SIGNAL FOR GSYL TO JRST (F) + MOVEI SYM,0 + JSP F,GSYL1 +A.GSY3: ILDB A,A.GST3 ;GET CHAR + TRZN A,200 ;CHECK FOR SPECIAL + JRST A.GSY2 ;NO, FALL BACK IN + CAIG A,100 ;BIG ENOUGH TO BE SPECIAL? + JRST A.GSY3 ;NO, MUST BE DUMMY, IGNORE + HRROI T,(A) ;SPECIAL => ASSUME STOP: T .LT. 0 SIGNAL TO CALLING ROUTINE + POPJ P, ;RETURN TO CALLING ROUTINE + +;INITIALIZE MACRO STATUS + +MACINI: MOVEI A,3 + MOVEM A,FREEPT ;FORGET ALL STRINGS IN MACTAB + PUSHJ P,FCOMP + MOVE A,MACTAD + HRLI A,41000 ;SET UP CCOMPB THRU CCOMPE + LSH A,2 ;(THEIR VALUES CAN'T BE ASSEMBLED IN BECAUSE + SUBI A,4 ;THEY ARE MUTLTIPLY RELOCATABLE, AND IN DEC + MOVSI AA,CCOMPB-CCOMPE ;VERSION THAT CAN'T BE DONE) +MACIN0: MOVEM A,CCOMPB(AA) + AOJ A, + AOBJN AA,MACIN0 + MOVE A,MACTAD + ADDI A,MACL+1777 + ANDI A,-2000 ;ADDR OF 1ST WD AFTER MACTAB. + CALL MACIN2 ;SET UP PTRS TO END OF MACTAB. + SETZM GCCNT ;CLEAR OUT GC COUNT SO WILL GET MORE CORE FIRST THREE +MACIN1: SETZM MDEPTH ;NOW INITIALIZE MACRO EXPANSION STATUS + SETZM PRSTG ;NOW TO CLEAR OUT BYTE POINTERS + MOVE A,[PRSTG,,PRSTG+1] + BLT A,EPRSTT-1 + MOVEI A,DSTG + MOVEM A,RDWRDP + MOVEI A,DMYAGT + MOVEM A,TOPP + MOVEM A,BBASE + MOVE A,[-MPDLL,,MACPDL] + MOVEM A,MACP + POPJ P, + +;A -> 1ST WD AFTER MACTAB, SET UP ALL POINTERS TO END OF MACTAB. +MACIN2: MOVEM A,MACTND + SUB A,MACTAD + LSH A,2 ;1ST BYTE MACTAB DOESN'T HAVE. + MOVEM A,MACHI + SUBI A,MACRUM*4 + MOVEM A,GCRDHI + MOVE A,STOPPT + HRR A,MACTND + SOS A ;LAST WD IN MACTAB. + MOVEM A,MACHIB ;INITIALIZE BYTE POINTER TO HIGHEST BYTE OK TO FILL + RET + + ;MACRO VARIABLE AREA (MOST THEREOF) + +VBLK +MACP: 0 ;MAC PDL POINTER +BLCODE [MACPDL: BLOCK MPDLL+1] ;MACRO PDL +FREEPT: 0 ;MACRO STG PNTR POINTS TO FREE CHAR +FREPTB: 0 ;FREEPT IN BYTE POINTER FORM +MACTAD: MACTBA ;ADDR OF START OF MACRO TABLE. +MACTND: 0 ;ADDR OF 1ST WD AFTER MACTAB. +MACHI: 0 ;CHAR ADR ONE ABOVE ACTIVE MACTAB +MACHIB: 0 ;POINTS TO LAST BYTE IN MACTAB + +SCONDF: 0 ;STRING CONDITIONAL FLAG, -1 => IDENTICAL, 0 DIFFERENT +GENSM: 0 ;GENERATED SYM COUNT +DEFNPS: 0 ;NONZERO => NAME OF PSEUDO NOW READING ITS ARG. + ;A FATAL ERROR WILL TYPE THE PSEUDO'S NAME. +DEFNPN: 0 ;PAGE # -1 OF THAT PSEUDO. ALSO TYPED BY FATAL ERRORS. +DEFNLN: 0 ;LINE # -1. +DEFNFI: 0 ;SIXBIT FN1 OF FILE CONTAINING PSEUDO THAT DEFNPS REFERS TO. +MDEPTH: 0 ;DEPTH IN MACRO (NOT IRP OR REPEAT) EXPANSIONS +PUTCNT: 0 ;AOS'D BY PUTREL, USED BY CALLING ROUTINE, USUALLY TO COUNT ACTIVE CHARS (DURING DEFINITION) +IRPCR: 0 ;COUNT OF A,B,[LIST] GROUPS IN IRP IRPC IRPS, " " " +AIRPT: 0 ;IRP EXPANSION TEMP, -1 => NO NON-NULL DUMMYS YET, ELSE 0 +AIRPN0: 0 ;1ST NUMERIC ARG TO IRPNC +AIRPN1: 0 ;2ND, +AIRPN2: 0 ;3RD. +A.QOT2: 0 ;DELIMITER FOR .QUOTE +CRPTCT: -1 ;COUNT THROUGH CURRENT REPEAT (FOR .RPCNT) +CIRPCT: -1 ;COUNT THOUGH CURRENT IRP (FOR .IRPCNT) +A.GST3: 0 ;ON .GO, NAME (IN SQUOZE) OF TAG BEING SEARCHED FOR +A.GST4: 0 ;BYTE POINTER FOR ILDB WHILE SEARCHING FOR TAG +PRCALP: PRCAL-1 ;POINTER INTO PRCALP, POINTS TO LAST ACTIVE ENTRY + +PRSTG: ;BEGIN WORDS GARBAGE COLLECTED: FIRST BYTE POINTERS ILDB'D + +CPTR: 0 ;ILDB TO GET NEXT CHAR FROM MACRO OR WHATEVER +IFE WRQTSW-1,WRQTBP: 0 ;POINTS TO LAST CHAR BEFORE CURRENT SYL AT WRQOTE +AIRPSP: 0 ;-> PLACE TO STORE SYL-TERMINATOR, IN IRPS READIN. +GCBPL==.-PRSTG ;END BYTE POINTERS, BEGIN CHARACTER ADDRESSES +PRSCND: 0 ;CHARACTER ADDRESS OF CURRENT LOCATION IN FIRST STRING OF IFSE,IFSN WHILE COMPARING WITH SECOND +PRSCN1: 0 ;CHAR ADR BEG OF FIRST STRING IFSE, IFSN +PRREPT: 0 ;CHAR ADR BEG OF BODY OF REPT +PRIRP: 0 ;CHAR ADR BEG OF IRP BODY +PRDEF: 0 ;CHAR ADR BEG OF MACRO BEING DEFINED +PRCAL: REPEAT 10,0 ;TEMP STORAGE FOR CHAR ADR BEG MACRO BODY, USED TO READ DUMMY SPECS +EPRSTT: ;END CHAR ADR WORDS GARBAGE COLLECTED + + ;BEGIN GARBAGE COLLECTOR VARIABLES + +GCCNT: 0 ;CNT OF GC'S +SYMSTR: 0 ;PNTR TO CHAIN OF MACRO PNTRS IN SYM TABLE (DURING GC), LINKED THROUGH RH'S OF "VALUE" +REDPT: 0 ;CHAR ADR READING FROM WHEN MOVING STRING DOWN +REDPTB: 0 ;REDPT IN BYTE POINTER FORM + ;GC WRITES WITH FREEPT/FREPTB +COFST: 0 ;AMOUNT CHARS MOVED DOWN BY, SUBTRACTED FROM CHAR ADR TO RELOCATE +SVF: 0 ;FLAG, .GE. 0 => NO POINTERS FOUND POINTING TO CURRENT STRING +FREPTS: 0 ;-> BEGINNING OF CURRENT STRING BEING COPIED DOWN +FRPTBS: 0 ;FREPTS IN BYTE POINTER FORM +GCENDF: 0 ;-1 => END OF LAST STRING FOUND, AFTER RELOCATING POINTERS, MSTG2 SHOULD EXIT +GCHI: 0 ;GC HIGH POINTER, CHAR ADR FIRST NOT TO GARBAGE COLLECT +GCRDHI: *4 ;GC DROPS DEAD (MACTAB FULL) IFWRITING INTO THIS CHAR ADR +BLCODE [GCSV: BLOCK 16] ;AC SAVE AREA FOR GC +PBLK + +;GARBAGE COLLECT THE MACRO TABLE + +GCA1: MOVE A,FREEPT ;GC ALL IN MACTAB. +GCA: MOVEM A,GCHI ;ENTRY TO STORE A IN GCHI -> FIRST CHAR NOT TO GARBAGE COLLECT +IFN 17-P+FF,.ERR GC ac saver wants FF=0, P=17! +GC: MOVEM 16,GCSV+15 ; Save all ACs except FF and P. + MOVE 16,[1,,GCSV] + BLT 16,GCSV+14 +IFN TS,[AOS A,GCCNT + CAIGE A,4 + PUSHJ P,GCCORQ ;EXPAND CORE ON FIRST THREE GC'S +] CLEARB T,GCENDF + MOVEI A,3 + MOVEM A,REDPT ;SET UP FOR READING + MOVEM A,FREEPT ;ALSO FOR WRITING + MOVE A,BCOMPU ;ALSO SET UP CORRESPINDING BYTE POINTERS + MOVEM A,FREPTB + MOVEM A,REDPTB + MOVE C,[-GCBPL,,PRSTG] +GCLP1: SKIPN B,(C) ;NOW CONVERT BYTE POINTERS... + JRST GCLP1B ;(INACTIVE) + CCOMP B,-1 ;TO CHARACTER ADDRESSES + MOVEM B,(C) ;STORE BACK CHARACTER ADDRESS +GCLP1B: AOBJN C,GCLP1 ;LOOP FOR ALL SUCH BYTE POINTERS + MOVE A,SYMAOB ;NOW SET UP MACRO LIST; T INITIALLY HAS 0 => END OF LIST DURING COMPUTATION +SYMMG: ;POINTS TO FIRST MACRO SYMTAB ENTRY ON LIST + LDB B,[400400,,ST(A)] ;GET SQUOZE FLAGS THIS SYM + CAIN B,PSUDO_-14. ;PSEUDO? (=> MAYBE MACRO) + JRST SYMMG1 ;YES, MAYBE PUT ON LIST (RETURNS TO SYMMG2) +SYMMG2: ADD A,WPSTE1 + AOBJN A,SYMMG ;LOOP FOR ENTIRE SYMTAB + MOVEM T,SYMSTR ;STORE INITIAL LIST ENTRY FOR MACROS + ;DROPS THROUGH + ;GC DEALS WITH "UNIT STRINGS", EACH STRING ENDS WITH 375 + ;GENERAL PROCEDURE IS TO COPY A STRING DOWN THEN SEARCH FOR POINTERS TO WHERE STRING USED TO BE + ;IF POINTERS FOUND THEY ARE RELOCATED TO POINT TO COPIED DOWN STRING + ;IF POINTERS ARE NOT FOUND THE STRING IS WIPED OUT + ;DROPS THROUGH + +MSTG: MOVE C,REDPT ;SET UP C TO POINT TO BEG OF STRING BEING READ + ;(FOR EVENTUALLY SEARCHING FOR POINTERS TO STRING, NOTE C STAYS AROUND FOR AWHILE) + MOVE TT,FREEPT + CAML TT,GCHI ;IF ALL OF ACTIVE PART OF MACTAB ALREAD GC'D, STOP NOW. + JRST GCEND + MOVEM TT,FREPTS ;-> BEGINNING OF WRITTEN STRING + MOVE TT,FREPTB + MOVEM TT,FRPTBS ;BYTE POINTER -> BEGINNING OF WRITTEN STRING + PUSHJ P,RDTRNS ;COPY CHARACTER + CAIN B,370 + JRST MSTGB ;THAT WAS NO STRING, THAT WAS MY IO-BUFFER! + MOVE TT,B ;SAVE CHARACTER JUST COPIED +MSTG1: CAML LINK,GCHI + JRST GCEND ;JUST READ LAST CHAR IN PART OF MACTAB TO GARBAGE COLLECT => DONE + CAIN B,375 + JRST MSTG2 ;END THIS STRING, NOW SEARCH FOR POINTERS, RETURNS TO MSTG + PUSHJ P,RDTRNS ;STRING NOT EXHAUSTED, COPY NEXT CHAR + JRST MSTG1 + +SYMMG1: HRRZ B,ST+1(A) ;PSEUDO FOUND IN SYMTAB, GET "VALUE" + CAIE B,MACCL ;MACCL? (=> MACRO, CHAR ADR OF BODY IN LH) + JRST SYMMG2 ;NO, JUST FALL BACK INTO LOOP + HRRM T,ST+1(A) ;MACRO, REPLACE MACCL PART OF VALUE WITH POINTER TO NEXT + MOVEI T,ST+1(A) ;UPDATE T (INITIAL LIST ENTRY) TO POINT TO WORD JUST CLOBBERED + PUSH P,A + HLRZ A,ST+1(A) + PUSHJ P,REDINC + CAIE B,374 + HALT + POP P,A + JRST SYMMG2 + + ;COPY CHARACTER DOWN (REDPTB -> FREPTB) + ;LEAVE INCREMENTED REDPT IN LINK, FREEPT IN A, CHAR IN B + +RDTRNS: ILDB B,REDPTB + IDPB B,FREPTB + AOS LINK,REDPT + AOS A,FREEPT + POPJ P, + +MSTGB: ADDI A,3 ;COPY AN IO-BUFFER: + TRZ A,3 + MOVEM A,FREEPT ;WRITE INTO WORD BOUNDARY. + ADDI LINK,3 + TRZ LINK,3 + MOVEM LINK,REDPT ;READ FROM WORD BOUNDARY. + MOVEI B,041000 + HRLM B,REDPTB + HRLM B,FREPTB + MOVE B,FREPTB + MOVE A,REDPTB + ADDI B,1 ;NEW ADDR OF 1ST WD. + HRRZ LINK,1(A) ;GET ADDR OF POINTER TO STRING. + MOVEM LINK,SVF ;REMEMBER WHETHER TO FLUSH STRING. + SKIPE LINK + HRRM B,(LINK) ;RELOCATE THAT POINTER (IF ANY) + HRLI B,1(A) ;SET UP AC FOR BLT. + HLRZ LINK,1(A) ;GET LENGTH OF STRING. + ADDM LINK,REDPTB + LSH LINK,2 + ADDM LINK,FREEPT + ADDM LINK,REDPT + LSH LINK,-2 + ADDB LINK,FREPTB + BLT B,(LINK) + MOVE LINK,REDPT + CAML LINK,GCHI ;IF THIS IO-BUFFER IS LAST THING IN MACRO SPACE, + SETOM GCENDF ;DON'T LOOK FOR ANYTHING FOLLOWING IT. + JRST MSTGB1 ;NOW MAYBE FLUSH THIS STRING, COPY NEXT. + +;GET HERE WHEN MSTG2 FINISHES WITH FLAG SET TO EXIT: UNDO INITIALIZATION AND RETURN + +GCEND1: IFN TS,[ + MOVE A,FREEPT + ADDI A,2000*4 + CAML A,MACHI + PUSHJ P,GCCORQ +] MOVE A,FREEPT + CAML A,GCRDHI + ETF [ASCIZ /Macro space full/] + SKIPN T,SYMSTR + JRST USYMG1 ;EMPTY LIST + MOVEI C,MACCL ;SET UP C FOR HRRM'ING +USYMG: HRRZ TT,(T) ;GET ADR ON LIST + HRRM C,(T) ;CLOBBER RH JUST GOT NEXT POINTER FROM TO MACCL + HLRZ A,(T) + PUSHJ P,REDINC + CAIE B,374 + HALT + SKIPE T,TT ;MAKE NEXT POINTER CURRENT, SKIP IF END OF LIST + JRST USYMG + +USYMG1: MOVE C,[-GCBPL,,PRSTG] +GCLP2: MOVE A,(C) ;NOW CONVERT CHARACTER ADDRESSES... + BCOMP A,-1 ;BACK TO BYTE POINTERS + MOVEM A,(C) + AOBJN C,GCLP2 +IFN 17-P+FF,.ERR GC AC restorer wants FF=0 and P=17! + MOVS 16,[1,,GCSV] ; Restore all ACs except FF and P. + BLT 16,16 + POPJ P, ;EXIT FROM GARBAGE COLLECTOR + + ;GC ROUTINE TO SCAN TABLE AREA FOR POINTERS TO CURRENT STRING + ;CH1 -> BEGINNING OF TABLE, 4.9 => LOOK AT PAIRS SKIPPING SECOND OF EACH PAIR + ;T POINTS TO LAST WORD IN TABLE + 1 + ;RELOCATE POINTERS IN TABLE POINTED TO + ;C POINTS TO BEGINNING OF STRING, B -> END + 1 + +MSCN: CAIG T,(CH1) + POPJ P, ;TABLE EXHAUSTED + HRRZ TT,-1(T) ;GET LAST ENTRY IN TABLE (UPPER POINTER UPDATED TO COUNT DOWN) + CAML TT,C + CAML TT,B + JRST MSCN1 ;DOESN'T POINT TO CURRENT STRING + SUB TT,COFST ;POINTS TO STRING, RELOCATE + HRRM TT,-1(T) ;STORE BACK RELOCATED POINTER + SETOM SVF ;SET FLAG TO SAVE STRING +MSCN1: SKIPGE CH1 + SOS T ;CH1 NEGATIVE => SKIP A WORD + SOJA T,MSCN + +GCEND: SETOM GCENDF ;DONE READING FROM MACTAB, BUT FIRST HAVE TO RELOCATE POINTERS TO LAST STRING +MSTG2: CLEARM SVF ;NO POINTERS FOUND TO STRING YET + MOVE D,REDPT + SUB D,FREEPT + MOVEM D,COFST ;STORE AMOUNT CHARS COPIED DOWN BY FOR CHAR ADR RELOCATION + MOVE B,REDPT + CAIE TT,374 + JRST MSTG3 ;NOT A MACRO + MOVE T,SYMSTR + JUMPE T,MSTG3 ;JUMP IF NO MACROS ON LIST +MSTG5: HLRZ TT,(T) ;GET CHAR ADR THIS MACRO + CAML TT,C ;SKIP IF POINTS BELOW BEGINNING THIS STRING + CAML TT,B ;SKIP UNLESS POINTS TO OR ABOVE FIRST CHAR NOT YET READ + JRST MSTG4 ;DOESN'T POINT TO THIS STRING + SETOM SVF ;POINTS TO THIS STRING, SET FLAG TO SAVE STRING + SUB TT,COFST ;RELOCATE + HRLM TT,(T) ;STORE BACK UPDATED CHAR ADR THIS MACRO +MSTG4: HRRZ T,(T) ;NOW GET POINTER TO NEXT MACRO + JUMPN T,MSTG5 ;LOOP FOR ALL MACROS ON LIST + +MSTG3: MOVE T,TOPP + MOVEI CH1,DMYAGT + PUSHJ P,MSCN ;RELOCATE POINTERS IN DUMMY ARG TABLE + HRRZ T,MACP + HRROI CH1,MACPDL + PUSHJ P,MSCN ;RELOCATE POINTERS IN MACRO PDL + HRRZ T,PRCALP + AOS T + MOVEI CH1,PRSTG + PUSHJ P,MSCN ;RELOCATE POINTERS IN PRSTG + HRRZ T,RDWRDP + MOVEI CH1,DSTG + PUSHJ P,MSCN ;RELOCATE DUMMY ARGS READ (OR BEING READ) IN BUT NOT YET ACTIVATED + SKIPGE GCENDF + JRST GCEND1 ;EXIT +MSTGB1: SKIPE SVF + JRST MSTGB2 ;FOUND POINTERS TO THIS STRING, DON'T FLUSH + MOVE TT,FREPTS ;NO POINTERS FOUND, FLUSH STRING + MOVEM TT,FREEPT + MOVE TT,FRPTBS + MOVEM TT,FREPTB +MSTGB2: SKIPGE GCENDF ;IF WE JUST HACKED AN I-O BUFFER, MAYBE IT'S THE LAST + JRST GCEND1 ;THING IN MACRO SPACE. + JRST MSTG + +] ;END MACSW CONDITIONAL (AND MACRO PROCESSOR ROUTINES) + +IFN .I.FSW,[ ;;.I.F ;ALGEBRAIC COMPILER ROUTINE +; 'ALGEBRAIC' CRUFT MARO DEFINITIONS + +DEFINE MOAN ARG/ + MOVEI D,[SIXBIT /ARG!!/] + JRST ERRCON +TERMIN + +DEFINE RETLIN + MOVEI A,15 ;CARRIAGE RETURN + PUSHJ P,PUTREL + MOVEI A,12 ;LINE FEED + PUSHJ P,PUTREL +TERMIN + +DEFINE NUMBER + MOVE A,BTPNT + ILDB I,A + CAIE I,"# + CAIGE I,"@ +TERMIN + +DEFINE RESTOR + MOVE D,BTPNT + SETZM STRING + SETZM STRING+1 + SETZM STRING+2 +TERMIN + + +DEFINE SPECN + POP P,RANDM + MOVE A,ENN + SUB A,RANDM + MOVEM A,ENN +TERMIN + +DEFINE $GET + EXCH I,ACSVI + PUSHJ P,RCH + EXCH I,ACSVI +TERMIN + +DEFINE GETT + EXCH I,ACSVI + PUSHJ P,RCH + EXCH I,ACSVI + IDPB A,TPN +TERMIN + +; START OF COMPILER PROPER + +OPDL: CH?CH?CH?CH?CH?CH?CH?CH ;COMMUTATOR + CH?SP?CH?CH?CH?CR?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + SP?CH?CH?CH?DL?CH?CH?CH + LP?RP?TX?PL?CM?MN?CH?DV + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?KL?LB?EQ?RB?CH + +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?UP?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH + +VBLK + +ENN: 60 ;ACCUMULATOR NUMBER - TROUBLE IF GOES PAST 9 + +BTPNT: 440700,,STRING ;D +STRING: BLOCK 10 ;CHARACTER ASSEMBLY (D) - TROUBLE IF OVERFLOWS + +TPN: 0 +DIRPNT: 440700,,DIROUT ;TPN +DIROUT: BLOCK 40 ;COPY OF LINE IN PROGRESS (TPN) - TROUBLE IF OVERFLOWS + +OPSTKL==40 + 0 +OPSTK: BLOCK OPSTKL ;OPERATOR STACK (R) - TROUBLE IF OVERFLOWS + 0 + + + +ENDSTT: 0 ;ON IF END OF STATEMENT ENCOUNTERED +CHARF: 0 ;LAST WAS NOT OPERATOR +NUMFL: 0 ;STRING IS NUMERIC CONSTANT (NEEDS [ AND ]) +R1SV: 0 ;SAVED A +R2SV: 0 ;SAVED I, CALLED V EARLIER ON + +INTEGR: 0 ;INTEGER ARITHMETIC +WARN: 0 ;ON AFTER ) TO STOP NON-OPERATOR +RANDM: 0 ;DUMP COMMA COUNT HERE +TEMP: 440600,,(D) ;INDIRECT VIA D +BYTPNT: 0 + ; Save 7 acs here, done by move(m)s for robustness +IRP AC,,[AA,A,B,C,D,I,P] +ACSV!AC: 0 +TERMIN +PBLK + +; ENTRANCE TO 'ALGEBRAIC' TRANSLATOR + +A.I: SETOM INTEGR + SKIPA +A.F: SETZM INTEGR + PUSHJ P,SWINI ;INITIALISE PASSAGE TO MIDAS ASSEMBLER +IRP AC,,[AA,A,B,C,D,I,P] + MOVEM AC,ACSV!AC +TERMIN + SETZM ENDSTT ;RESET END OF STMNT FLAG + SETZM EQHIT' ;RESET LAST CHAR WAS= FLAG + SETZM WARN ;SET OFF ERROR DETECTOR + MOVEI A,"0 ;INITIALISE POINTERS + MOVEM A,ENN + MOVE A,DIRPNT + MOVEM A,TPN ;POINTER TO SAVED INPUT + MOVE SYM,[-OPSTKL,,OPSTK] + PUSH SYM,[0,,ENDSAT] + PUSH P,[0] ;INITIALISE COMMA-COUNTER + SETZM CHARF +CLSTR: RESTOR +RDITTS: SKIPE ENDSTT + JRST BDEND +RDITA: GETT + CAIGE A,100 ;FOR ABBREVIATED DISPATCH TABLE + JRST @OPDL(A) + CAIN A,"\ + JRST AB + CAIN A,"^ + JRST UP + +CH: SETZM EQHIT + SKIPE WARN + JRST CHBRT +CHEY: IDPB A,D + SETOM CHARF ;NON UNARY FLAG + JRST RDITA + +GAMB: RESTOR +COMMT: MOVE I,R2SV + JRST GOPURT + +SHORT: ;DECIDES IF STRING CAN BE USED IN IMMEDIATE TYPE OPS + SETZM IMMED' + SKIPN STRING + POPJ P, ;NO STRING + MOVE A,BTPNT + ILDB I,A + CAIN I,"# + JRST APUPJ ;YEPE HE ASKED FOR IT + SKIPE STRING+1 + POPJ P, ;STRING IS LONG + SKIPA + +TSTSHL: ILDB I,A + JUMPE I,APUPJ ;ITS OK FOUND ONLY NUMBERS + CAILE I,"@ + POPJ P, ;NON-NUMBER IN STRING + CAIE I,". + JRST TSTSHL + ILDB I,A + SKIPN I ;ANYTHING FOLLOW '.' QST +APUPJ: SETOM IMMED' ;INDICATE IMMEDIATE USAGE IS POSSIBLE + POPJ P, + +SZPRT: SETZM CHARF +GOPRT: SETZM WARN +GOPART: MOVEM I,R2SV +GOPURT: HLRZ B,I + HLRZ C,(SYM) + CAMLE B,C + JRST PSOPR ;GO PUSH OPERATOR + SKIPN INTEGR + SETOM IMMED ;FOR ARITH OPS ONLY FIXED WILL DO IMMEDIATE + PUSHJ P,SHORT ;ESTABLISH IF STRING CAN BE IMMEDIFIED + POP SYM,A ;POP AN OPERATOR + JUMPN A,(A) + + MOAN OVERPOPPED OPERATOR STACK + +CHEX: MOVE A,R1SV + JRST CHEY + +RP: SKIPE EQHIT + AOS ENN ;TAKE CARE OF UNSATISFIED = AT END + SKIPN CHARF + JRST RTONOP + SETOM CHARF +BUDDY: SETOM WARN + MOVEI I,RPAR + JRST GOPART + +RTONOP: MOVE I,(SYM) + CAIN I,FUNCT + JRST BUDDY ;NO ARGUMENT FUNCTION + + MOAN ) FOLLOWS OPERATOR + +BDEND: MOAN TOO MANY ('S + +CHBRT: MOAN NON-OPERATOR FOLLOWS ) + +CR: SKIPE EQHIT + AOS ENN ;HANDLES UNSATISFIED = AT END + SETOM ENDSTT + MOVEI I,RCAR + JRST GOPRT + +LP: SETZM EQHIT + SKIPE WARN + JRST LFRHT + SETZM CHARF + SKIPE STRING + JRST INDX + PUSH P,[0] ;INITIALISE COMMA-COUNTER + PUSH SYM,[0,,LFTPR] + JRST RDITA + +INDX: NUMBER + JRST NUSTRB + GETT + CAIG A,"9 + JRST NMRINX + MOVEI I,"( + IDPB I,D +INDY: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDN + CAIN A,"- + JRST CMPNDN + CAIE A,") ;SEARCH FOR NEXT RP + JRST INDY + IDPB A,D +CMBAN: SETOM CHARF ;MAKE BELIEVE CHARATER LAST + SETOM WARN ;YET SET ) TRAP + JRST RDITA + +NMRINX: CAIN A,"- ;IS IT A MINUS + JRST INDZ + CAIN A,"+ + JRST INDZ + MOVEI I,"+ ;NUMERICAL SUBSCRIPT + IDPB I,D +INDZ: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDC + CAIE A,") + JRST INDZ + JRST CMBAN + +CMPNDN: MOVEI I,") + IDPB I,D + JRST INDZ + +CMPNDC: MOVEI I,"( + IDPB I,D + JRST INDY + +LFRHT: MOAN ( FOLLOWS DIRECTLY ON ) + +SP=RDITA ;USE FOR NON ARITH STATS + +CM: MOVE I,[1,,COMMX] + SKIPN CHARF + AOS ENN + JRST SZPRT + +EQ: SETOM EQHIT + SETZM WARN + SKIPN CHARF ;TEST FOR EXISTANCE OF L H S + JRST EQFLOP + NUMBER ;IS L H S A NUMBER + JRST EQNUMB + MOVEI I,EQAAL +EQVAL: SETZM CHARF + PUSH SYM,I + PUSH P,STRING + PUSH P,STRING+1 + PUSH P,STRING+2 + PUSH P,[0] + JRST CLSTR + +PL: MOVE I,[2,,PLUS] + SKIPN CHARF + JRST RDITA ;UNARY PLUS + JRST SZPRT + +MN: MOVE I,[2,,MINUX] + SKIPN CHARF + MOVE I,[5,,UMINU] + JRST SZPRT + +AB: SKIPE CHARF ;ABSOLUTE VALUE + JRST ABERR ;NOT UNARY + MOVE I,[5,,UABS] + JRST SZPRT + +LB: SKIPN CHARF + JRST LP ;TREAT LIKE ( + NUMBER + JRST NUBRST + MOVEI I,FUNCT + JRST EQVAL + +RB=RP + +NUBRST: MOAN '<' FOLLOWS NUMBER + +NUSTRB: MOAN '(' FOLLOWS NUMBER + +EQFLOP: MOAN '=' FOLLOWS OPERATOR + +EQNUMB: MOAN '=' FOLLOWS NUMBER + +ABERR: MOAN NON-UNARY ABS + +TX: MOVE I,[4,,TIMES] + SKIPN CHARF + JRST RDITA ;UNARY TIMES + JRST SZPRT + +DL: $GET ;CONTINUE STATEMENT RC + $GET ;LF + $GET ;. + CAIE A,". ;DOT + JRST BDCONT + $GET ;F OR I + $GET ;CONTROL I OR SPACE + MOVE A,DIRPNT + MOVEM A,TPN ;RESET SAVED INPUT POINTER TO AVOID FILLING ITS BUFFER + MOVEI A,"$ + IDPB A,TPN + MOVEI A,40 + IDPB A,TPN + JRST RDITA + +ERRCON: TRNE FF,FRPSS2 ;NO OUTPUT ON SECOND PASS + JRST CONRBT +;MAY ALSO WANT TO USE STATEMENT PLUS LINE NUMBER TYPE TACTIC + MOVE B,DIRPNT +OUTRR: ILDB A,B + PUSHJ P,TYO + CAME B,TPN + JRST OUTRR + SKIPE ENDSTT + JRST CONERT +DORSTL: MOVEI A,40 + PUSHJ P,TYO + MOVEI A,"? ;POINT AT ERROR + PUSHJ P,TYO + MOVEI A,40 + PUSHJ P,TYO +DORSAL: $GET ;COPY UP TO LINE FEED + PUSHJ P,TYO + CAIE A,12 ;LF + JRST DORSAL +CONERT: PUSHJ P,TIPIS + PUSHJ P,CRR +CONRAT: +IRP AC,,[AA,A,B,C,D,I,P] + MOVE AC,ACSV!AC +TERMIN + JRST SWFLS ;GO BACK AND FLUSH + + +CONRBT: $GET + CAIE A,12 ;LF + JRST CONRBT + JRST CONRAT + +UP: SKIPN WARN ;FOR (NUMBER)^N + SKIPN STRING + JRST ITSEX + MOVEM A,R1SV ;SAVE THE ARROW + NUMBER + JRST CHEX ;ITS PART OF A NUMBER +ITSEX: MOVE I,[6,,STRSTR] + SKIPN CHARF + JRST EXMB + JRST SZPRT + +EXMB: MOAN UNARY ^ + +BDCONT: MOAN BAD CONTINUATION + +KL=CR ;SEMICOLON ACTS LIKE CR IN TERMINATING + +STRSTR: SKIPN STRING + JRST EXLS + NUMBER + SKIPA + JRST EXLS + SUBI I,61 + TDNE I,[-1,,777774] + JRST EXLS + MOVE A,STRING + TDNE A,[3777,,-1] + JRST EXLS + ADDI I,POWR + JRST @(I) + +EXLS: PUSH P,[ASCII !EXPLO!] + PUSH P,[ASCII !G !] + PUSH P,[0] + PUSH P,[1] + SETOM EXRET' + JRST FUNET + +DV: MOVE I,[4,,DIVIX] + SKIPN CHARF + MOVE I,[5,,UDIVI] + JRST SZPRT + +PSOPR: PUSH SYM,I ;PUSH OPERATOR FOR LATER EXCECUTION + SKIPN STRING + JRST RDITTS + PUSHJ P,SHORT ;CAN WE IMMEDIFY + PUSHJ P,MVOI ;AND MOVE OPERAND INTO STACK + JRST CLSTR + +PRODB: NUMBER ;OUTPUT WHAT IS IN STRING + SKIPE IMMED ;NO [ & ] IF IMMEDIATE USE + JRST OVNM + PUSH P,A + MOVEI A,"[ ;[ FOR CONSTANT + PUSHJ P,PUTREL + POP P,A + SETOM NUMFL +OVNM: CAIN I,"# + JRST PRDOC + + EXCH A,I + PUSHJ P,PUTREL + MOVE A,I +PRDOC: ILDB I,A + JUMPN I,OVNM + SKIPN NUMFL + POPJ P, + MOVEI A,"] ;] FOR CONSTANT + PUSHJ P,PUTREL + SETZM NUMFL + POPJ P, + +PRODC: HRLI A,440700 ;MAKE BYTE POINTER + JRST PRDOC + +LFTPR: SPECN + JRST RDITTS ;IGNORE LP ON STACK + +RCAR: HALT ;IMPOSSIBLE FOR THESE TO BE ON STACK +RPAR: HALT + +EQAAL: SPECN + SKIPE STRING + PUSHJ P,MVOI + MOVEI A,[ASCIZ ! MOVEM A!] + PUSHJ P,PRODC + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +ENDSAT: SPECN + SKIPN ENDSTT + JRST TOEARL + SKIPE STRING + PUSHJ P,MVOI +GETLF: $GET + CAIE A,12 ;LF + JRST GETLF +IRP AC,,[AA,A,B,C,D,I,P] + MOVE AC,ACSV!AC +TERMIN + JRST SWRET ;GO BACK + +MVOI: MOVE A,BTPNT + ILDB I,A + CAIN I,"& + JRST MVOALR ;OPERAND ALREADY THERE + MOVEI A,[ASCIZ ! MOVE A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVEI A!] +MVOIK: PUSHJ P,PRODC + MOVE A,ENN + AOS ENN +FINOF: PUSHJ P,PUTREL + MOVEI A,", + PUSHJ P,PUTREL + PUSHJ P,PRODB + RETLIN + POPJ P, + +MVOALR: AOS ENN + POPJ P, + +TOEARL: MOAN TOO MANY )'S + +PLUS: MOVEI A,[ASCIZ ! FADR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! ADD A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! ADDI A!] +OPERT: PUSHJ P,PRODC + SKIPE STRING + JRST GAINS + SOS ENN +OPRTE: MOVE A,ENN + SOS A + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +COMMAA: MOVEI A,", + PUSHJ P,PUTREL + MOVEI A,"A + JRST PUTREL + +GAINS: MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +MINUX: MOVEI A,[ASCIZ ! FSBR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! SUB A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! SUBI A!] + JRST OPERT + +TIMES: PUSHJ P,TMSTR + SKIPE IMMED + MOVEI A,[ASCIZ ! IMULI A!] + JRST OPERT + +DIVIX: MOVEI A,[ASCIZ ! FDVR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IDIV A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! IDIVI A!] + JRST OPERT + +UMINU: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE STRING + JRST MOABC + MOVEI A,[ASCIZ ! MOVNS A!] +UMINUC: PUSHJ P,PRODC + MOVE A,ENN + SOS A + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +MOABC: MOVEI A,[ASCIZ ! MOVN A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVNI A!] + PUSHJ P,MVOIK + JRST GAMB + +UABS: CAMN B,C + JRST BAKWD + SKIPE STRING + JRST MOABS + MOVEI A,[ASCIZ ! MOVMS A!] + JRST UMINUC + +MOABS: MOVEI A,[ASCIZ ! MOVM A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVMI A!] + PUSHJ P,MVOIK + JRST GAMB + +MVONT: MOVEI A,[ASCIZ ! MOVE A!] + PUSHJ P,PRODC + MOVE A,ENN + JRST ONMVS + +TMSTR: MOVEI A,[ASCIZ ! FMPR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IMUL A!] + POPJ P, + +BAKWD: PUSH SYM,A + JRST PSOPR + +UDIVI: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE INTEGR + JRST UINDV + SKIPN STRING + PUSHJ P,MVONT + MOVEI A,[ASCIZ ! HRLZI A!] + PUSHJ P,PRODC + MOVE A,ENN + SKIPN STRING + SOS A + PUSHJ P,PUTREL + MOVEI A,[ASCIZ !,201400!] + PUSHJ P,PRODC + RETLIN + AOS ENN + JRST DIVIX + +ONTMS: PUSHJ P,TMSTR + PUSHJ P,PRODC + MOVE A,ENN + SOS A +ONMVS: PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A +LSTCHX: PUSHJ P,PUTREL + RETLIN + POPJ P, + +POWR: GAMB?POWR2?POWAA?POWR4 + +POWR4: PUSHJ P,ONTMS +POWR2: PUSHJ P,ONTMS + JRST GAMB + +POWAA: PUSHJ P,MVONT + AOS ENN + PUSHJ P,ONTMS + SOS ENN + PUSHJ P,TMSTR + PUSHJ P,PRODC + RESTOR + JRST OPRTE + +COMMX: AOS (P) + SKIPE STRING + PUSHJ P,MVOI + JRST GAMB + +UINDV: MOAN INTEGER UNARY DIVIDE + +FUNCT: SETZM EXRET +FUNET: SKIPE STRING + PUSHJ P,MVOI + SPECN + PUSHJ P,MORFMC + MOVEI A,[ASCIZ ! PUSHJ P,!] + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + PUSHJ P,PRODC + PUSHJ P,PRODB + RESTOR + RETLIN + PUSHJ P,MORFNC + SKIPN EXRET + JRST RDITTS ;AS USED FROM FUNCT + JRST COMMT ;AS USED FROM STRSTR + +MORFMC: MOVE A,RANDM + MOVEM A,RANSV' + SKIPN CHARF ;NO ARGUMENTS + AOS ENN + SETOM CHARF + MOVEI A,"1 + CAMN A,ENN ;ARE ARGUMENT ALREADY IN A0 AND UP + POPJ P, + SETZM CORDM +MORYLP: PUSHJ P,ZENBD + AOS CORDM + SOSL RANSV + JRST MORYLP + POPJ P, + +MORFNC: MOVEI A,"1 + CAMN A,ENN + POPJ P, + MOVE A,RANDM + MOVEM A,CORDM' +MORXLP: PUSHJ P,ZENBD + SOSL CORDM + JRST MORXLP + POPJ P, + +ZENBD: MOVEI A,[ASCIZ ! EXCH A!] + PUSHJ P,PRODC + MOVE A,CORDM + ADDI A,"0 + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A + ADD A,CORDM + JRST LSTCHX + +TIPIS: MOVE A,TEMP + MOVEM A,BYTPNT +MORTP: ILDB A,BYTPNT + CAIN A,1 ;EXCLAMATION + POPJ P, + ADDI A," ;SPACE + PUSHJ P,TYO + JRST MORTP + +] ;END .I.FSW CONDITIONAL + +IFN LISTSW,[ + +;LISTING ROUTINES. + +PNTR: MOVEM 17,PNTSA+17 + MOVEI 17,PNTSA + BLT 17,PNTSA+16 + MOVE P,PNTSA+P ; P = 17 so must restore. +IFN P-17, .ERR P=17 assumption at PNTR! + SKIPL LSTONP + JRST PNTR5 + AOSE LISTPF + JRST PNTR1 + SKIPGE T,LISTAD + JRST PNTR2 + PUSHJ P,P6OD + HLRZS T + PUSHJ P,PSOS ;PRINT SPACE OR ' + PUSHJ P,PILPTS +PNTR3: HLRZ T,LISTWD + PUSHJ P,P6OD + MOVS T,LSTRLC + TLNE T,400000 + AOJ T, + PUSHJ P,PSOS + HRRZ T,LISTWD + PUSHJ P,P6OD + HRRZ T,LSTRLC + PUSHJ P,PSOS + PUSHJ P,PILPTS + PUSHJ P,PILPTS +PNTR4: MOVE TT,[440700,,LISTBF] +PNTR6: CAMN TT,PNTBP + JRST PNTR5A + ILDB A,TT + PUSHJ P,PILPT + JRST PNTR6 + +PNTR5A: CALL PNTCR + MOVE A,LISTBC + CAIE A,14 + JRST PNTR7 +PNTR5C: CALL PILPT ;OUTPUT THE ^L, + CALL PNTHDR ;AND THE PAGE NUMBER. + JRST PNTR5D + +PNTR7: MOVEI A,12 + PUSHJ P,PILPT +PNTR5D: SETOM LISTBC +PNTR5: MOVNI A,LISTBS*5-1 + MOVEM A,PNTSW ;DETECT OVERFLOW OF LISTBF + MOVE TT,[440700,,LISTBF] + MOVEM TT,PNTBP + MOVSI 17,PNTSA + BLT 17,17 + POPJ P, + +PNTR5B: MOVE A,LISTBC + CAIN A,14 + JRST PNTR5C + JRST PNTR5D + +PNTR2: MOVEI T,8 + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR3 + +PNTR1: MOVE TT,[440700,,LISTBF] + CAMN TT,PNTBP + JRST PNTR5B + MOVEI T,25. + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR4 + +PSOS: MOVEI A,"' + TRNN T,-1 +PILPTS: MOVEI A,40 + JRST PILPT + +P6OD: MOVE TT,[220300,,T] +P6OD1: ILDB A,TT + ADDI A,"0 + PUSHJ P,PILPT + TLNE TT,770000 + JRST P6OD1 + POPJ P, + +PNTCR: MOVEI A,^M ;OUTPUT ^M TO LST IF OPEN. +PILPTX: SKIPE LSTONP;OUTPUT CHAR TO LST IF LSTING. + JRST PILPT + RET + +PNTHDR: MOVEI A,^I + MOVEI B,10. ;MOVE TO COLUMN 80., + CALL PILPT + SOJG B,.-1 + PUSH P,LSTTTY + HLLOM B,LSTTTY ;POSITIVE SO TYOERR GOES ONLY TO LST. + TYPR [ASCIZ/Page /] + MOVE A,CPGN + CALL [AOJA A,DPNT] + REST LSTTTY +PNTCRR: CALL PNTCR ;OUTPUT CRLF TO LST IF OPEN. +PNTLF: MOVEI A,^J + JRST PILPTX + +DEFINE LSTM %A,B,C +IF1 [ [B] ? [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+LSTM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-LSTM0 +] +TERMIN + +A.LSTFF: AOS (P) ;RETURN NO VALUE. +; ADDR, CONTENTS IF NOT LISTING, CONTENTS IF LISTING. +LSTOFF: LSTM LSTONP,0,-1 + LSTM LSTPLM,[TLO B,4^5][JRST PSHLML] + LSTM RCHLST,RCHLS1,AOSN PNTSW + LSTM RCH1LS,RET,[CAILE A,^M] + LSTM POPLML,JFCL,[IDPB A,PNTBP] + JRST MDSCLR +LSTM0==.-LSTOFF + +LSTON: BLOCK LSTM0-1 + JRST MDSSET + +A.LSTN: SKIPN LISTP1 ;IF SHOULD LIST THIS PASS + JUMPGE FF,MACCR + SKIPE LISTP ;AND WANT LISTING, + CALL LSTON ;TURN ON LISTING OUTPUT. + JRST MACCR + +IFNDEF LISTBS,LISTBS==50. ;LISTBF SIZE IN WORDS. + +VBLK ;LISTING FEATURE VARIABLES + +PNTBP: 0 ;POINTER TO LISTING LINE BUFFER +LSTONP: 0 ;NONZERO WHEN OUTPUTTING TO LISTING FILE. +LISTP: +LISTON: 0 ;-1 IF LISTING ON +PNTSW: 0 ;-1 IF LAST CHR CR OR LF, OR -<# CHARS SPACE LEFT IN LISTBF> +LISTBF: BLOCK LISTBS +LISTAD: 0 ;ADDRESS OR -1 NONE 3.1 RELOC +LISTWD: 0 ;WORD +LSTRLC: 0 ;RELOCATION +LISTPF: 0 ;-1 OTHERS CONTAIN SOMETHING +LISTBC: 0 ;BREAK CHR CR LF OR FF OR -1 IF NONE SINCE LAST PNTR +LISTTM: 0 ;TEMP AT AEND +PNTSA: BLOCK 20 ;AC SAVE AREA FOR LISTING FEATURE +LISTP1: 0 ;POSITIVE => WANT TO LIST EVEN ON PASS 1. +] ;END IFN LISTSW, + +IFE LISTSW,VBLK + +;THESE VARIABLES ARE REFERENCED EVEN IF LISTSW IS 0. +LSTTTY: 0 ;TYOERR TYPES ON TTY IFF LE 0, ON LST IF NOT 0. +LSTPLM: TLO B,4^5 ;OR JRST PSHLML ;XCT'D BY PSHLMB. +POPLML: JFCL ;OR IDPB A,PNTSW ;XCT'D IN POPLMB. + +PBLK +IFE LISTSW, A.LSTN: A.LSTF: RET + +VBLK +IFN CREFSW,[ +CREFP: 0 ;SET BY C SWITCH TO REQUEST CREFFING. +CRFONP: 0 ;SET WHILE CREFFING. +CRFLFL: 0 ;LAST PAGNUM,,LINENUM OUTPUT. +CRFINU: JFCL\PUSHJ P,CRFUSE ;XCT THIS TO CREF NON-DEF OCCUR. +CRFLBL: JFCL\PUSHJ P,CRFLB1 ;XCT FOR DEF. OF NORMAL SYM. +CRFEQL: JFCL\PUSHJ P,CRFEQ1 ; FOR DEF. OF NORMAL SYM. OR INTSYM. +CRFMCD: JFCL\PUSHJ P,CRFMC1 ; FOR DEF. OF MACRO. +CRFDEF: JFCL\PUSHJ P,CRFDF1 ; FOR RANDOM DEF, CHECK FLAGS. +] +CRFILE: 0 ;SET => SHOULDN'T OUTPUT PAGNUM,,LINENUM'S +;USED BY .CRFILE INTSYM SO CAN'T BE IN CONDIT. +PBLK +IFN CREFSW,[ +CRFEQ1: MOVEI T,(B) + CAIN A,1 ;IF NOT PSEUDO OR NOT INTSYM, + CAIE T,INTSYM + JRST CRFLB1 ;IS NORMAL SYM. +CRFOD1: MOVSI T,600000 ;ELSE DEFINING INSN. + JRST CRFEQ2 + +CRFDF2: MOVEI T,(B) ;DECIDE WHETHER DEFINING MACRO OR PSEUDO. + CAIE T,MACCL + JRST CRFOD1 +CRFMC1: SKIPA T,[500000,,] ;DEFINING MACRO. +CRFLB1: MOVSI T,440000 ;DEFINING NORMAL SYM. +CRFEQ2: PUSH P,A + MOVE A,T + JRST CRFMA1 + +;COME HERE FOR NON-DEF; MUST DECIDE WHAT TYPE SYM. +CRFUSE: TLNE C,3NCRF ;SYM MAY HAVE CREFFING SUPPRESSED. + POPJ P, + PUSH P,A + CAIN A,1 + JRST CRFMAC ;PSEUDOS, MACROS. + MOVSI A,40000 ;FLAG FOR NORMAL SYM. + TRNN C,-1 + MOVSI A,200000 ;FLAG FOR INSNS. +CRFMA1: PUSH P,A + MOVE A,CLNN + HRL A,CPGN + AOBJN A,.+1 ;A HAS PAGNUM,,LINENUM . + SKIPGE CRFILE ;IF SHOULD OUTPUT IT, + JRST CRFUS1 + CAME A,CRFLFL ;AND HAS CHANGED, DO SO. + PUSHJ P,CRFOUT + MOVEM A,CRFLFL +CRFUS1: POP P,A + IOR A,SYM ;COMBINE SYM AND CREF FLAG. + PUSHJ P,CRFOUT + JRST POPAJ + +CRFMAC: MOVEI A,(B) + CAIN A,MACCL + SKIPA A,[100000,,] ;MACRO + MOVSI A,200000 ;PSEUDO-OP. + JRST CRFMA1 + +;DEFINING OCCURRENCE, MIGHT BE ANY TYPE SYM. +CRFDF1: CAIN A,1 ;TYPE 1 => MACRO OR PSEUDO. + JRST CRFDF2 + TRNE C,-1 ;ELSE INSN OR NORMAL SYM. + JRST CRFLB1 + JRST CRFOD1 + +DEFINE CRFM %A,B,C +IF1 [ [B] + [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+CRFM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-CRFM0] +TERMIN + + +A.CRFFF: AOS (P) ;.CRFOFF - STOP CREFFING. NO VAUE. +; LOCATION, NORMAL VALUE, VALUE WHILE CREFFING +CRFOFF: CRFM CRFONP,0,-1 + CRFM CRFLBL,JFCL,[PUSHJ P,CRFLB1] + CRFM CRFEQL,JFCL,[PUSHJ P,CRFEQ1] + CRFM CRFMCD,JFCL,[PUSHJ P,CRFMC1] + CRFM CRFINU,JFCL,[PUSHJ P,CRFUSE] + CRFM CRFDEF,JFCL,[PUSHJ P,CRFDF1] + POPJ P, +CRFM0==.-CRFOFF + +CRFON: BLOCK CRFM0-1 + POPJ P, + +A.CRFN: JUMPGE FF,MACCR + SKIPE CREFP ;.CRFON, IF HAVE CREF FILE, START CREFFING. + PUSHJ P,CRFON + JRST MACCR +] ;END IFN CREFSW, + +SUBTTL TS Routines for I/O & overall control + +IFN TS,.INSRT TSRTNS + +FEED1: SKIPA B,[40] +FEED: MOVEI B,5 + JRST TFEED + +VBLK + +IFG PURESW-DECSW,[ ;PURIFICATION ROUTINE + +PURIFG: -1 ;-1 IF NOT (YET) PURIFIED +] + VARIAB +VPAT: +VPATCH: BLOCK 20 +VPATCE=.-1 + +PBLK + +CONSTANTS + +PAT: +PATCH: BLOCK 100 +PATCHE: -1 + +IFG PURESW-DECSW,[LOC <.+1777>&-2000 ;SKIP TO NEXT PAGE + MAXPUR==._-10. ;FIRST PAGE ABOVE PURE PAGES +PRINTA Pure pages = ,\MAXPUR-MINPUR +] + +VBLK +PDL: BLOCK LPDL+1 + +IFN DECDBG, DECDBB: BLOCK 8000. ;SPACE FOR DEC DDT'S SYMS. + +.NSTGW +BBKCOD==. ;BEGIN BLANK CODING, CLEARED OUT DURING INITIALIZATION +IFG PURESW-DECSW,MINBNK==<.+1777>_-10. ;FIRST PAGE OF BLANK CODE +BNKBLK ;DUMP OUT ACCUMULATED BLANK CODING + + ;NOW MORE BLANK CODING + +BKBUF: BLOCK BSIZE+5 ;CURRENT BLOCK TO OUTPUT +GLOTB: BLOCK 20 ;GLOBAL TABLE, EACH ENTRY FLAGS,,ADR OF SQUOZE (SEE COMMENTS NEAR BEGINNING) +STRSTO: BLOCK STRL ;STRING STORAGE FOR GSYL AND FRIENDS +IFN FASLP,[ +FASB: BLOCK FASBL ;OUTPUT BUFFER FOR FASL MODE + ;FIRST WD 9 FOUR BIT CODE GROUPS, REST ASSOC STUFF +FASAT: BLOCK FASATL ;ATOM TABLE FOR FASL MODE + ;EACH ENTRY CONSISTS OF ATOM IN FORMAT DESIRED BY FASLOAD, + ;NAMELY: + ; HEADER WD. RH LENGTH IN WDS + ; 4.8-4.7 TYPE 0-PN 1 FIX 2 FLO 3 BIG (NOT IMPLEMENTED) + ; FOLLOWED BY PN OR VALUE + ;-EXCEPT- IF RH OF HEADER =0, THIS SLOT RESERVED FOR LIST + +] + +EBKCOD==. ;END BLANK CODING +.YSTGW + +PRINTA ST = ,\.-RL0 + +ST: ;SYMBOL TABLE 3 WORDS/SYM FIRST SQUOZE, SECOND "VALUE", 3RD FLAGS,,BLOCK. + BLOCK NRMWPS*SYMDSZ + +;LITERALS TABLES - CAN MOVE AND GROW. THESE TAGS & LENGTHS ARE JUST THE DEFAULTS +.SEE CONTBA ;ETC, WHICH CONTAIN THE ACTUAL ADDRESSES. SO DON'T USE THEM! +CONTAB: BLOCK LCONTB ;CONSTANTS TABLE, VALUES OF CONSTANTS THIS CONSTANTS AREA +CONGLO: BLOCK LCNGLO ;CONSTANTS GLOBAL TABLE, EACH ENTRY TWO WORDS + ;FIRST WD GLOTB ENTRY. SECOND WD ADR IN CONTAB OF CONSTANT TO WHICH IT REFERS +CONBIT: BLOCK LCONTB/12.+1 ;RELOCATION BITS AND ILNOPT BIT(SEE CPTMK) + ;3 BITS FOR EACH WORD OF CONTAB. + +;;INIT ;INITIALIZATION ROUTINES (IN MACRO TABLE, GET WIPED OUT) +IFN ITSSW\TNXSW,MINMAC==./2000 ;# OF 1ST PAGE HOLDING PART OF MACTAB. + +;NOTE THAT THIS CODE IS COPIED UPWARD WHEN MACTAB IS MOVED +;DUE TO SYMTAB EXPANSION. THEREFOR IT MUST REFER TO ITSELF +;INDEXED BY THE OFFSET OF WHERE IT IS FROM WHERE IT WAS ASSEMBLED. +;THAT IS KEPT IN CH1. ALL LITERALS MUST BE USED INDEX OF CH1, TOO. + +;MAC PROC TABLES +MACTBA: 773767750000 ;MACRO CHARACTER STORAGE (FIRST WORD 3 375'S) +INIT1: MOVE CH1,MACTAD ;GET ADDR THIS CODE REALLY STARTS AT. + SUBI CH1,MACTBA ;GET OFFSET FROM WHERE ASSEMBLED. + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1](CH1) + BLT A,EBKCOD-1 ;CLEAR OUT BLANK CODING + PUSH P,[SP4](CH1) ;NOW INIT THE SYMTAB & FINISHED. + +;INITIALIZE THE SYMTAB, EXPECT SIZE IN SYMLEN. +INITS: MOVE AA,SYMLEN ;SET UP THE OTHER VARS + IMUL AA,WPSTE ;DEALING WITH SYMTAB SIZE. + MOVEM AA,SYMSIZ + ADDI AA,ST ;ADDR OF START OF CONTAB. + MOVEM AA,CONTBA + MOVEM AA,PLIM + ADD AA,CONLEN ;ADD LENGTH OF CONTAB TO GET ADDR OF CONGLO TAB. + MOVEM AA,CONTBE ;WHICH IS ALSO THE END OF CONTAB. + MOVEM AA,CONGLA + MOVEM AA,CONGOL + MOVE A,CONLEN ;ADD IN LENGTH OF CONGLO (1/4 OF CONLEN) + LSH A,-2 + ADD AA,A + MOVEM AA,CONGLE ;TO GET END OF CONGLO, AND START OF CONBIT TABLE. + MOVEM AA,CONBIA + MOVE A,CONLEN + ADDI A,11. + IDIVI A,12. + ADD AA,A ;ADD LENGTH OF CONBIT (1/12 OF CONLEN) GETTING ADDR OF MACTAB. +IFN DECSW,[ + PUSH P,AA + ADDI AA,MACL-1 + IORI AA,1777 ;FIX ALLOCATION PROBLEMS ON KI-10 + CORE AA, + ETF [ASCIZ /No core for symbols/](CH1) + REST AA +] + MOVN A,SYMLEN + HRLZM A,SYMAOB ;AOBJN -> SYMTAB. + MOVE A,WPSTE + SUBI A,1 + MOVEM A,WPSTE1 + MOVN A,WPSTE + HRRM A,WPSTEB + CAMG AA,MACTAD ;MOVED MACTAB UP? + JRST INITS1(CH1) +IFN ITSSW\TNXSW,[ ;YES, GET CORE FOR INCREASE. + PUSH P,AA + MOVEI AA,MACL+1777(AA) + LSH AA,-10. ;1ST PAGE NOT NEEDED BY MACTAB. + MOVEI A,MACL+1777+MACTBA(CH1) + LSH A,-10. ;1ST PAGE MACTAB DOESN'T YET HAVE. + SUBM A,AA ;# PAGES NEEDED. + HRLZI AA,(AA) + HRRI AA,(A) ;-<# PAGES>,,<1ST NEEDED> + JUMPGE AA,INITS3(CH1) ;DON'T CALL IF NEED 0 PAGES, WOULD GET ONE. +IFN TNXSW, PUSHJ P,TCORGT +IFN ITSSW, .CALL INITSB(CH1) ? .VALUE +INITS3: REST AA +] + SUBM AA,MACTAD ;MACTAD _ SHIFT IN START OF MACTAB. + EXCH AA,MACTAD ;MACTAD GETS NEW START, AA HAS SHIFT. + MOVSI A,PTAB-CCOMPB + ADDM AA,PTAB(A) ;RELOCATE BYTE-PTRS INTO MACTAB. + AOBJN A,.-1(CH1) + MOVNI B,INITS2(CH1) + HRROI A,@EISYMP(CH1) + ADDI B,1(A) ;GET # WDS IN SECOND HALF OF INIT CODE. + HRRM AA,.+1(CH1) ;COPY 2ND HALF UPWARD WITH POP-LOOP. + POP A,(A) ;THIS INSN IMPURE. + SOJG B,.-1(CH1) + ADDI CH1,(AA) ;CHANGE OFFSET TO PT. TO NEW LOCATIONN OF INIT CODE. + JRST INITS2(CH1) ;JUMP INTO 2ND HALF, WHERE IT'S BEEN COPIED TO. +INITS2: HRROI A,INITS2-1(CH1) ;THEN COPY 1ST HALF (WHICH ENNDS BEFORE INITS2) + SUBI A,(AA) ;GET WHERE NOW ENDS, NOT WHERE WILL END. + MOVEI B,INITS2-MACTBA ;UP UNDERNEATH THE 2ND HALF. + HRRM AA,.+1(CH1) ;(THIS TWO-STEP COPYING HANDLES ALL OVERLAPS) + POP A,(A) + SOJG B,.-1(CH1) +INITS1: MOVE AA,SYMSIZ + SETZM ST + MOVE A,[ST,,ST+1](CH1) + BLT A,ST-1(AA) ;CLEAR OUT SYMBOL TABLE + SETZM ESBK ;DEFINE THEM IN OUTER BLOCK. + MOVEI AA,ISYMTB(CH1) + MOVS F,ISMTBB(CH1) ;GET SWAPPED VALUE OF FIRST INSTRUCTION +SP3: CAIL AA,EISYM1(CH1) + JRST SP1(CH1) ;DONE WITH INSTRUCTIONS + MOVE SYM,(AA) + JUMPE SYM,SP2(CH1) + TLZ SYM,740000 + PUSHJ P,ES ;WON'T SKIP + CAIA + .VALUE ;INSTRUCTION PRESENT TWICE IN TABLE!!?!? + HRLZI T,SYMC + HRLZ B,F + MOVSI C,3KILL + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP2: ADDI F,1000 + AOJA AA,SP3(CH1) +;AFTER HACKING ALL THE INSTRUCTIONS, STORED AS JUST THE NAMES IN NUMERIC ORDER, +;HACK ALL THE OTHER PREDEFINED SYMS, STORED AS 2 WORDS (NAME ? VALUE). +EISYMP: ;MAY BE MUNGED IF MORE SYMBOLS ARE ADDED AFTER EISYMT. +SP1: CAIL AA,EISYMT(CH1) + POPJ P, + MOVE SYM,(AA) + LDB T,[400400,,SYM](CH1) + ROT T,-4 + TLZ SYM,740000 + PUSHJ P,ES + CAIA + JRST SP5(CH1) ;SYM ALREADY DEFINED? (MIGHT BE .UAI, IN ITS AND IN MIDAS). + MOVE B,1(AA) + MOVSI C,3KILL + CAME T,[GLOETY,,](CH1) ;GLOBAL ENTRIES REALLY EXITS, HACKED TO DEFEAT ADDRESS LINKING + CAMN T,[GLOEXT,,](CH1) + TLO C,3LLV + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP5: AOS AA + AOJA AA,SP1(CH1) + +IFN ITSSW,[ +INITSB: SETZ ? 'CORBLK + MOVEI %CBNDR+%CBNDW ;BOTH READ AND WRITE. + MOVEI %JSELF ? AA ;INTO SELF, AA IS AOBJN -> PAGES. + SETZI %JSNEW ;FRESH PAGES. + + ;GOBBLE SYMS FROM SYSTEM + ;TABLE AREA IN SYSTEM: + ;FIRST LOC SYSYMB + ;LAST (AS OPPOSED TO LAST + 1) SYSYME + +TSYMGT: MOVE AA,[MXICLR-MXIMAC,,MXICLR] + .CALL INITSB ;GET MACTAB PAGES NNOT LOADED INTO. + .VALUE +IFN PURESW,[ + MOVE AA,[MINBNK-MINMAC,,MINBNK] + .CALL INITSB ;GET PAGES FOR BLANK CODE & SYMTAB. + .VALUE + SKIPN PURIFG + JRST TSYMG3 + JSP F,FLSPGS ;NOT PURIFIED => FLUSH PAGES + ,,MXIMAC ;OF MACTAB CREATED BY LOADING BUT NOT NEEDED. + +TSYMG3: +] + MOVEI A,EISYMT ;EISYMT FIRST LOC FOR ITS SYMS + MOVE B,[SIXBIT /CALLS/] ;SYSTEM CALLS + .GETSYS A, ;READ IN SYSTEM CALLS (SHOULD SKIP) + .VALUE + SKIPGE A + .VALUE ;.GETSYS DIDN'T UPDATE AOBJN POINTER + HRRM A,SP1 ;MARK END OF SYMS + ANDI A,-1 + CAIL A,MACTBA+MACL + .VALUE ;MACL TOO SMALL! INITS MIGHT LOSE. + MOVEI B,EISYMT + MOVEI AA,SYMC_<-18.+4> ;SQUOZE FLAG FOR SYM +TSYMG2: DPB AA,[400400,,(B)] + ADDI B,2 + CAIE B,(A) + JRST TSYMG2 + POPJ P, +]; IFN ITSSW + +SUBTTL Purifier routines - PURIFY$G, GAPFLS$G, also DECDBM + +IFN ITSSW\TNXSW,[ +IFN PURESW,[ ;HERE ARE THE GUTS OF THE PURIFY ROUTINE + +PURIFY: SKIPL NVRRUN +IFN ITSSW,[ .VALUE [ASCIZ /:Already run +/]] +IFN TNXSW,[ + JRST [ HRROI 1,[ASCIZ /? Already run +/] + PSOUT + HALTF + JRST .+1] ; If continued, go ahead anyway. +] ;IFN TNXSW +PURIF1: MOVEI P,17 ; Start PDL at 20 + JSP F,FLSPGS ; First flush blank-code pages, + ,,MINBNK ; incl. symbol table. + JSP F,FLSPGS + ,,MXICLR ; Flush MACTAB pages created by load but not needed. + JSP F,PURIFD + ,,MINPUR ; Purify pure pages. + SETZM PURIFG ; Set "purified" flag + MOVE [1,,2] ; Now clear out remains of data of self + MOVEI 1,0 + BLT 40 +IFN ITSSW,.VALUE [ASCIZ /:Purifiedpdump SYS;TS MIDAS/] +IFN TNXSW,[ + HRROI 1,[ASCIZ / Purified, now SAVE +/] + PSOUT + HALTF +] ; IFN TNXSW + +GAPFLS: JSP F,FLSPGS ; Flush gap pages created on initial load. + ,,MXIMAC +IFN ITSSW, .BREAK 16,300000 +IFN TNXSW, HALTF + + ; JSP F,FLSPGS + ; -<# pgs>,, + ; Flush pages specified by page AOBJN + +FLSPGS: MOVE A,(F) ; Get the page AOBJN +IFN ITSSW,[ + SYSCAL CORBLK,[MOVEI 0 ? MOVEI %JSELF ? A] + .LOSE 1000 +] +IFN TNXSW,[ + ASH A,1 ; Multiply # pages, page # by 2. + HLRE B,A + HRLI A,.FHSLF + MOVNS B + TLO B,(PM%CNT) ; Say hacking repeat count +FLSPG2: SYSCAL PMAP,[[-1] ? A ? B] ; Flush these pages. + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI B,-1(B) ; Else, on 10X, must iterate manually. + TRNE B,400000 ; See if became "negative". + JRST .+1 ; Yep, done with manual iteration. + AOJA A,FLSPG2] ; Nope, bump page #. +] + JRST 1(F) + + ; JSP F,PURIFD - Just like FLSPGS, but purifies the pages instead. + +PURIFD: MOVE A,(F) ; Get page AOBJN +IFN ITSSW,[ + SYSCAL CORBLK,[MOVEI %CBNDR ; Read access only. + MOVEI %JSELF ? A] + .LOSE 1000 +] +IFN TNXSW,[ + ASH A,1 ; Double everything. + HLRE B,A + MOVNS B + HRLI A,.FHSLF +PURID1: SYSCAL SPACS,[A ? [PA%RD+PA%EX]] + ADDI A,1 + SOJG B,PURID1 +] + JRST 1(F) + +IFN TNXSW,[ + + ; PURSAV - More useful hack for 10X/20X since it preserves page access +PURSV0: PUSHJ P,RDJERR +PURSAV: MOVEI P,20 + HRROI R1,[ASCIZ /Pure-Save to file: /] + PSOUT + MOVSI R1,(GJ%NEW+GJ%FOU+GJ%SHT+GJ%FNS) + MOVE R2,[.PRIIN,,.PRIOU] + GTJFN ; Get JFN from TTY + JRST PURSV0 + SETZM PURIFG ; Claim purified... + SETOM MEMDBG ; and keeping watch on memory. + HRLI R1,.FHSLF + MOVEI R2,[ + 2*<0-MINBNK>,,0+SS%RD+SS%WR+SS%EXE ; Variables/buffers + 2*,,2*MINMAC+SS%RD+SS%WR+SS%EXE ; MACTAB init + 2*,,2*MINPUR+SS%RD+SS%EXE ; Purify pure pages. + 0 ] ; End of SSAVE table + SETZ R3, + SSAVE ; Do it! + HRROI R1,[ASCIZ /Saved./] + PSOUT + HALTF +] ; IFN TNXSW + +] ; IFN PURESW +] ; IFN ITSSW\TNXSW + +IFN DECDBG,[ +DECDBM: 0 + HRLZ A,.JBSYM ;GET ADDR OF START OF DDT SYMS, + HRRI A,DECDBB+200 ;LEAVE 200 WD SPACE BEFORE THEM. + HRRM A,.JBSYM ;MOVE THEM INTO SPACE PROVIDED + HLRE B,.JBSYM + MOVMS B + BLT A,DECDBB+177(B) ;SO THEY WON'T GET IN MACTAB'S WAY. + JRST @DECDBM +] + +CONSTANTS + +;;ISYMS ;INITIAL SYMBOL TABLE + +IFNDEF JSYS,JSYS=104_33 ;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE + +ISMTBB: JSYS ;FIRST OP. CODE IN ISYMTB + +ISYMTB: + +; 104-177 (JSYS - FDVRB) + +SQUOZE 10,JSYS ;BBN PAGER INSTRUCTION +SQUOZE 10,ADJSP ;KL10 INSTRUCTION + 0 + 0 + +SQUOZE 10,DFAD ;KI10 INSTRUCTION +SQUOZE 10,DFSB ;KI10 INSTRUCTION +SQUOZE 10,DFMP ;KI10 INSTRUCTION +SQUOZE 10,DFDV ;KI10 INSTRUCTION +SQUOZE 10,DADD ;KL10 INSTRUCTION +SQUOZE 10,DSUB ;KL10 INSTRUCTION +SQUOZE 10,DMUL ;KL10 INSTRUCTION +SQUOZE 10,DDIV ;KL10 INSTRUCTION +SQUOZE 10,DMOVE ;KI10 INSTRUCTION +SQUOZE 10,DMOVN ;KI10 INSTRUCTION + +SQUOZE 10,FIX ;KI10 INSTRUCTION +SQUOZE 10,EXTEND ;KL10 INSTRUCTION +SQUOZE 10,DMOVEM ;KI10 INSTRUCTION +SQUOZE 10,DMOVNM ;KI10 INSTRUCTION +SQUOZE 10,FIXR ;KI10 INSTRUCTION +SQUOZE 10,FLTR ;KI10 INSTRUCTION + +SQUOZE 10,UFA ;KA/KI10 INSTRUCTION +SQUOZE 10,DFN ;KA/KI10 INSTRUCTION +SQUOZE 10,FSC + +SQUOZE 10,IBP +SQUOZE 10,ILDB +SQUOZE 10,LDB +SQUOZE 10,IDPB +SQUOZE 10,DPB + +SQUOZE 10,FAD +SQUOZE 10,FADL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FADM +SQUOZE 10,FADB +SQUOZE 10,FADR +SQUOZE 10,FADRI ;PDP10 INSTRUCTION +SQUOZE 10,FADRM +SQUOZE 10,FADRB +SQUOZE 10,FSB +SQUOZE 10,FSBL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FSBM +SQUOZE 10,FSBB +SQUOZE 10,FSBR +SQUOZE 10,FSBRI ;PDP10 INSTRUCTION +SQUOZE 10,FSBRM +SQUOZE 10,FSBRB +SQUOZE 10,FMP +SQUOZE 10,FMPL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FMPM +SQUOZE 10,FMPB +SQUOZE 10,FMPR +SQUOZE 10,FMPRI ;PDP10 INSTRUCTION +SQUOZE 10,FMPRM +SQUOZE 10,FMPRB +SQUOZE 10,FDV +SQUOZE 10,FDVL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FDVM +SQUOZE 10,FDVB +SQUOZE 10,FDVR +SQUOZE 10,FDVRI ;PDP10 INSTRUCTION +SQUOZE 10,FDVRM +SQUOZE 10,FDVRB + +; 200-277 (MOVE - SUBB) + +SQUOZE 10,MOVE +SQUOZE 10,MOVEI +SQUOZE 10,MOVEM +SQUOZE 10,MOVES +SQUOZE 10,MOVS +SQUOZE 10,MOVSI +SQUOZE 10,MOVSM +SQUOZE 10,MOVSS +SQUOZE 10,MOVN +SQUOZE 10,MOVNI +SQUOZE 10,MOVNM +SQUOZE 10,MOVNS +SQUOZE 10,MOVM +SQUOZE 10,MOVMI +SQUOZE 10,MOVMM +SQUOZE 10,MOVMS + +SQUOZE 10,IMUL +SQUOZE 10,IMULI +SQUOZE 10,IMULM +SQUOZE 10,IMULB +SQUOZE 10,MUL +SQUOZE 10,MULI +SQUOZE 10,MULM +SQUOZE 10,MULB +SQUOZE 10,IDIV +SQUOZE 10,IDIVI +SQUOZE 10,IDIVM +SQUOZE 10,IDIVB +SQUOZE 10,DIV +SQUOZE 10,DIVI +SQUOZE 10,DIVM +SQUOZE 10,DIVB + +SQUOZE 10,ASH +SQUOZE 10,ROT +SQUOZE 10,LSH +SQUOZE 10,JFFO ;PDP10 INSTRUCTION +SQUOZE 10,ASHC +SQUOZE 10,ROTC +SQUOZE 10,LSHC +SQUOZE 10,CIRC ;AI PDP10 INST. CIRCULATE: ROTC WITH AC+1 GOING THE WRONG WAY + +SQUOZE 10,EXCH +SQUOZE 10,BLT +SQUOZE 10,AOBJP +SQUOZE 10,AOBJN +SQUOZE 10,JRST +SQUOZE 10,JFCL +SQUOZE 10,XCT +SQUOZE 10,MAP ;KI10 INSTRUCTION + +SQUOZE 10,PUSHJ +SQUOZE 10,PUSH +SQUOZE 10,POP +SQUOZE 10,POPJ +SQUOZE 10,JSR +SQUOZE 10,JSP +SQUOZE 10,JSA +SQUOZE 10,JRA + +SQUOZE 10,ADD +SQUOZE 10,ADDI +SQUOZE 10,ADDM +SQUOZE 10,ADDB +SQUOZE 10,SUB +SQUOZE 10,SUBI +SQUOZE 10,SUBM +SQUOZE 10,SUBB + +; 300-377 (CAI - SOSG) + +SQUOZE 10,CAI +SQUOZE 10,CAIL +SQUOZE 10,CAIE +SQUOZE 10,CAILE +SQUOZE 10,CAIA +SQUOZE 10,CAIGE +SQUOZE 10,CAIN +SQUOZE 10,CAIG +SQUOZE 10,CAM +SQUOZE 10,CAML +SQUOZE 10,CAME +SQUOZE 10,CAMLE +SQUOZE 10,CAMA +SQUOZE 10,CAMGE +SQUOZE 10,CAMN +SQUOZE 10,CAMG + +SQUOZE 10,JUMP +SQUOZE 10,JUMPL +SQUOZE 10,JUMPE +SQUOZE 10,JUMPLE +SQUOZE 10,JUMPA +SQUOZE 10,JUMPGE +SQUOZE 10,JUMPN +SQUOZE 10,JUMPG +SQUOZE 10,SKIP +SQUOZE 10,SKIPL +SQUOZE 10,SKIPE +SQUOZE 10,SKIPLE +SQUOZE 10,SKIPA +SQUOZE 10,SKIPGE +SQUOZE 10,SKIPN +SQUOZE 10,SKIPG + +SQUOZE 10,AOJ +SQUOZE 10,AOJL +SQUOZE 10,AOJE +SQUOZE 10,AOJLE +SQUOZE 10,AOJA +SQUOZE 10,AOJGE +SQUOZE 10,AOJN +SQUOZE 10,AOJG +SQUOZE 10,AOS +SQUOZE 10,AOSL +SQUOZE 10,AOSE +SQUOZE 10,AOSLE +SQUOZE 10,AOSA +SQUOZE 10,AOSGE +SQUOZE 10,AOSN +SQUOZE 10,AOSG +SQUOZE 10,SOJ +SQUOZE 10,SOJL +SQUOZE 10,SOJE +SQUOZE 10,SOJLE +SQUOZE 10,SOJA +SQUOZE 10,SOJGE +SQUOZE 10,SOJN +SQUOZE 10,SOJG +SQUOZE 10,SOS +SQUOZE 10,SOSL +SQUOZE 10,SOSE +SQUOZE 10,SOSLE +SQUOZE 10,SOSA +SQUOZE 10,SOSGE +SQUOZE 10,SOSN +SQUOZE 10,SOSG + +; 400-477 (SETZ - SETOB) + +SQUOZE 10,SETZ +SQUOZE 10,SETZI +SQUOZE 10,SETZM +SQUOZE 10,SETZB +SQUOZE 10,AND +SQUOZE 10,ANDI +SQUOZE 10,ANDM +SQUOZE 10,ANDB +SQUOZE 10,ANDCA +SQUOZE 10,ANDCAI +SQUOZE 10,ANDCAM +SQUOZE 10,ANDCAB +SQUOZE 10,SETM +SQUOZE 10,SETMI +SQUOZE 10,SETMM +SQUOZE 10,SETMB +SQUOZE 10,ANDCM +SQUOZE 10,ANDCMI +SQUOZE 10,ANDCMM +SQUOZE 10,ANDCMB +SQUOZE 10,SETA +SQUOZE 10,SETAI +SQUOZE 10,SETAM +SQUOZE 10,SETAB +SQUOZE 10,XOR +SQUOZE 10,XORI +SQUOZE 10,XORM +SQUOZE 10,XORB +SQUOZE 10,IOR +SQUOZE 10,IORI +SQUOZE 10,IORM +SQUOZE 10,IORB +SQUOZE 10,ANDCB +SQUOZE 10,ANDCBI +SQUOZE 10,ANDCBM +SQUOZE 10,ANDCBB +SQUOZE 10,EQV +SQUOZE 10,EQVI +SQUOZE 10,EQVM +SQUOZE 10,EQVB +SQUOZE 10,SETCA +SQUOZE 10,SETCAI +SQUOZE 10,SETCAM +SQUOZE 10,SETCAB +SQUOZE 10,ORCA +SQUOZE 10,ORCAI +SQUOZE 10,ORCAM +SQUOZE 10,ORCAB +SQUOZE 10,SETCM +SQUOZE 10,SETCMI +SQUOZE 10,SETCMM +SQUOZE 10,SETCMB +SQUOZE 10,ORCM +SQUOZE 10,ORCMI +SQUOZE 10,ORCMM +SQUOZE 10,ORCMB +SQUOZE 10,ORCB +SQUOZE 10,ORCBI +SQUOZE 10,ORCBM +SQUOZE 10,ORCBB +SQUOZE 10,SETO +SQUOZE 10,SETOI +SQUOZE 10,SETOM +SQUOZE 10,SETOB + +; 500-577 (HLL - HLRES) + +SQUOZE 10,HLL +SQUOZE 10,HLLI +SQUOZE 10,HLLM +SQUOZE 10,HLLS +SQUOZE 10,HRL +SQUOZE 10,HRLI +SQUOZE 10,HRLM +SQUOZE 10,HRLS +SQUOZE 10,HLLZ +SQUOZE 10,HLLZI +SQUOZE 10,HLLZM +SQUOZE 10,HLLZS +SQUOZE 10,HRLZ +SQUOZE 10,HRLZI +SQUOZE 10,HRLZM +SQUOZE 10,HRLZS +SQUOZE 10,HLLO +SQUOZE 10,HLLOI +SQUOZE 10,HLLOM +SQUOZE 10,HLLOS +SQUOZE 10,HRLO +SQUOZE 10,HRLOI +SQUOZE 10,HRLOM +SQUOZE 10,HRLOS +SQUOZE 10,HLLE +SQUOZE 10,HLLEI +SQUOZE 10,HLLEM +SQUOZE 10,HLLES +SQUOZE 10,HRLE +SQUOZE 10,HRLEI +SQUOZE 10,HRLEM +SQUOZE 10,HRLES +SQUOZE 10,HRR +SQUOZE 10,HRRI +SQUOZE 10,HRRM +SQUOZE 10,HRRS +SQUOZE 10,HLR +SQUOZE 10,HLRI +SQUOZE 10,HLRM +SQUOZE 10,HLRS +SQUOZE 10,HRRZ +SQUOZE 10,HRRZI +SQUOZE 10,HRRZM +SQUOZE 10,HRRZS +SQUOZE 10,HLRZ +SQUOZE 10,HLRZI +SQUOZE 10,HLRZM +SQUOZE 10,HLRZS +SQUOZE 10,HRRO +SQUOZE 10,HRROI +SQUOZE 10,HRROM +SQUOZE 10,HRROS +SQUOZE 10,HLRO +SQUOZE 10,HLROI +SQUOZE 10,HLROM +SQUOZE 10,HLROS +SQUOZE 10,HRRE +SQUOZE 10,HRREI +SQUOZE 10,HRREM +SQUOZE 10,HRRES +SQUOZE 10,HLRE +SQUOZE 10,HLREI +SQUOZE 10,HLREM +SQUOZE 10,HLRES + +; 600-677 (TRN - TSON) + +SQUOZE 10,TRN +SQUOZE 10,TLN +SQUOZE 10,TRNE +SQUOZE 10,TLNE +SQUOZE 10,TRNA +SQUOZE 10,TLNA +SQUOZE 10,TRNN +SQUOZE 10,TLNN +SQUOZE 10,TDN +SQUOZE 10,TSN +SQUOZE 10,TDNE +SQUOZE 10,TSNE +SQUOZE 10,TDNA +SQUOZE 10,TSNA +SQUOZE 10,TDNN +SQUOZE 10,TSNN +SQUOZE 10,TRZ +SQUOZE 10,TLZ +SQUOZE 10,TRZE +SQUOZE 10,TLZE +SQUOZE 10,TRZA +SQUOZE 10,TLZA +SQUOZE 10,TRZN +SQUOZE 10,TLZN +SQUOZE 10,TDZ +SQUOZE 10,TSZ +SQUOZE 10,TDZE +SQUOZE 10,TSZE +SQUOZE 10,TDZA +SQUOZE 10,TSZA +SQUOZE 10,TDZN +SQUOZE 10,TSZN +SQUOZE 10,TRC +SQUOZE 10,TLC +SQUOZE 10,TRCE +SQUOZE 10,TLCE +SQUOZE 10,TRCA +SQUOZE 10,TLCA +SQUOZE 10,TRCN +SQUOZE 10,TLCN +SQUOZE 10,TDC +SQUOZE 10,TSC +SQUOZE 10,TDCE +SQUOZE 10,TSCE +SQUOZE 10,TDCA +SQUOZE 10,TSCA +SQUOZE 10,TDCN +SQUOZE 10,TSCN +SQUOZE 10,TRO +SQUOZE 10,TLO +SQUOZE 10,TROE +SQUOZE 10,TLOE +SQUOZE 10,TROA +SQUOZE 10,TLOA +SQUOZE 10,TRON +SQUOZE 10,TLON +SQUOZE 10,TDO +SQUOZE 10,TSO +SQUOZE 10,TDOE +SQUOZE 10,TSOE +SQUOZE 10,TDOA +SQUOZE 10,TSOA +SQUOZE 10,TDON +SQUOZE 10,TSON + +EISYM1: + +; I/O INSTRUCTIONS + +SQUOZE 4,BLKI +BLKI IOINST +SQUOZE 4,DATAI +DATAI IOINST +SQUOZE 4,BLKO +BLKO IOINST +SQUOZE 4,DATAO +DATAO IOINST +SQUOZE 4,CONO +CONO IOINST +SQUOZE 4,CONI +CONI IOINST +SQUOZE 4,CONSZ +CONSZ IOINST +SQUOZE 4,CONSO +CONSO IOINST + +;EXTEND MNEMONICS + +SQUOZE 10,CMPSL +001000,, +SQUOZE 10,CMPSE +002000,, +SQUOZE 10,CMPSLE +003000,, +SQUOZE 10,EDIT +004000,, +SQUOZE 10,CMPSGE +005000,, +SQUOZE 10,CMPSN +006000,, +SQUOZE 10,CMPSG +007000,, +SQUOZE 10,CVTDBO +010000,, +SQUOZE 10,CVTDBT +011000,, +SQUOZE 10,CVTBDO +012000,, +SQUOZE 10,CBTBDT +013000,, +SQUOZE 10,MOVSO +014000,, +SQUOZE 10,MOVST +015000,, +SQUOZE 10,MOVSLJ +016000,, +SQUOZE 10,MOVSRJ +017000,, +SQUOZE 10,XBLT +020000,, + +;OLD PROGRAMS USE THESE NAMES + +SQUOZE 10,CLEAR +SETZ +SQUOZE 10,CLEARI +SETZI +SQUOZE 10,CLEARM +SETZM +SQUOZE 10,CLEARB +SETZB + +;RANDOM ALIAS NAMES + +SQUOZE 10,ADJBP ;KL10 FORM OF IBP WITH VARIABLE NUMBER TO INCREMENT +IBP +SQUOZE 10,JFOV ;PDP10 INSTRUCTION (PC CHANGE ON PDP6) +JFCL 1, +SQUOZE 10,JCRY1 +JFCL 2, +SQUOZE 10,JCRY0 +JFCL 4, +SQUOZE 10,JCRY +JFCL 6, +SQUOZE 10,JOV +JFCL 10, +SQUOZE 10,PORTAL ;KI10 INSTRUCTION +JRST 1, +SQUOZE 10,JRSTF +JRST 2, +SQUOZE 10,HALT +JRST 4, +SQUOZE 10,XJRSTF ;KL10 INSTRUCTION +JRST 5, +SQUOZE 10,XJEN ;KL10 INSTRUCTION +JRST 6, +SQUOZE 10,XPCW ;KL10 INSTRUCTION +JRST 7, +SQUOZE 10,JEN +JRST 12, +SQUOZE 10,SFM ;KL10 INSTRUCTION +JRST 14, +SQUOZE 10,XMOVEI ;KL10 INSTRUCTION +SETMI +SQUOZE 10,XHLLI ;KL10 INSTRUCTION +HLLI + +;PDP6 HAS LONG FORM ROUNDED INSTEAD OF IMMEDIATES + +IRPS INST,,FAD FSB FMP FDV + SQUOZE 10,INST!RL + INST!RI +TERMIN + +DEFINE DEFSYM X/ + IRPS Z,,[X] + SQUOZE 10,Z + Z + .ISTOP + TERMIN +TERMIN + +IFN DECSW,[ +.DECDF DEFSYM + +IFN DECBSW,.INSRT DECBTS + +] ;IFN DECSW + +IFN TNXSW,[;; DEFINE JSYS'S ON TENEX VERSION +.TNXJS DEFSYM +.INSRT TWXBTS +] ;IFN TNXSW + +SQUOZE 10,.OSMID ; Crock here - in TNX version, SITINI sets value at +OSMID: OSMIDAS ; runtime before syms spread. +SQUOZE 4,.SITE +A.SITE +SQUOZE 4,RIM10 +ARIM10,,SRIM +SQUOZE 4,SBLK +SBLKS,,SRIM +SQUOZE 4,RIM +ARIM,,SRIM +SQUOZE 4,SQUOZE +ASQOZ +SQUOZE 4,.RSQZ +-1,,ASQOZ +SQUOZE 4,XWD +AXWORD +SQUOZE 4,CONSTA +CNSTNT +SQUOZE 4,ASCIC +EOFCH,,AASCIZ +SQUOZE 4,RADIX +ARDIX + +SQUOZE 4,END +AEND +SQUOZE 4,TITLE +ATITLE +SQUOZE 4,.BEGIN +A.BEGIN +SQUOZE 4,.END +A.END +SQUOZE 4,VARIAB +AVARIAB +SQUOZE 4,SIXBIT +ASIXBIT +SQUOZE 4,ASCII +AASCII +SQUOZE 4,ASCIZ +AASCIZ +SQUOZE 4,.ASCII +A.ASCII +SQUOZE 4,.ASCVL +A.ASCV +SQUOZE 4,BLOCK +ABLOCK +SQUOZE 4,LOC +ALOC +SQUOZE 4,OFFSET +AOFFSET +SQUOZE 4,.SBLK +SIMBLK +SQUOZE 4,RELOCA +ARELOCA +SQUOZE 4,1PASS +A1PASS +SQUOZE 4,.DECSA +A.DECSA +SQUOZE 4,.DECRE +A.DECRE +SQUOZE 4,.DECTX +A.DCTX + +SQUOZE 4,.DECTW +A.DECTW +SQUOZE 4,NOSYMS +ANOSYMS +SQUOZE 4,EXPUNGE +AEXPUNGE +SQUOZE 4,EQUALS +AEQUALS +SQUOZE 4,NULL +ANULL +SQUOZE 4,SUBTTL +ANULL +SQUOZE 4,WORD +AWORD +SQUOZE 4,.SYMTAB +A.SYMTAB +SQUOZE 4,.SEE +A.SEE +SQUOZE 4,.AUXIL +MACCR +SQUOZE 4,.MRUNT +A.MRUNT +SQUOZE 4,.SYMCN +A.SYMC +SQUOZE 4,.TYPE +A.TYPE +SQUOZE 4,.FORMAT +A.FORMAT +SQUOZE 4,.OP +A.OP +SQUOZE 4,.AOP +A.AOP +SQUOZE 4,.RADIX +A.RADIX +SQUOZE 4,.FATAL +A.FATAL +SQUOZE 4,.BP +A.BP +SQUOZE 4,.BM +A.BM +SQUOZE 4,.LZ +A.LZ +SQUOZE 4,.TZ +A.TZ +SQUOZE 4,.DPB +A.DPB +SQUOZE 4,.LDB +A.LDB +SQUOZE 4,.IBP +A.IBP +SQUOZE 4,.1STWD +A.1STWD +SQUOZE 4,.NTHWD +A.NTHWD + +IRPS X,,[.BIND=0,.KILL=3KILL,.HKILL=3SKILL,.XCREF=3NCRF,.DOWN=3DOWN] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,A.KILL +TERMIN + +SQUOZE 4,.LSTON +A.LSTN +SQUOZE 4,.LSTOF +A.LSTF + +IRPS X,,[.MLLIT=CONSML,.PASS=A.PASS,.PPASS=A.PPASS,.SUCCESS=A.SUCCESS +.HKALL=HKALL,.STGSW=STGSW,.LITSW=LITSW,.AVAL1=AVAL1,.AVAL2=AVAL2,.ERRCNT=ERRCNT +.ASKIP=A.ASKIP,.CURLN=CLNN,.CURPG=CPGN,.QMTCH=QMTCH,.STPLN=A.STPLN,.STPPG=A.STPPG] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,INTSYM +TERMIN + +;CONDITIONALS (SEE ALSO IFSE, IFSN) + +SQUOZE 4,IFG +JUMPG A,COND +SQUOZE 4,IFGE +JUMPGE A,COND +SQUOZE 4,IFE +JUMPE A,COND +SQUOZE 4,IFLE +JUMPLE A,COND +SQUOZE 4,IFL +JUMPL A,COND +SQUOZE 4,IFN +JUMPN A,COND +SQUOZE 4,.ELSE +SKIPE A.ELSE +SQUOZE 4,.ALSO +SKIPN A.ELSE + +SQUOZE 4,IF1 +TRNE FF,COND1 +SQUOZE 4,IF2 +TRNN FF,COND1 +SQUOZE 4,IFDEF ;ASSEMBLE IF SYM DEFINED +JUMPG A,DEFCND +SQUOZE 4,IFNDEF ;ASSEMBLE IF SYM NOT DEFINED +JUMPE A,DEFCND +SQUOZE 4,IFB ;ASSEMBLE IF STRING BLANK (HAS NO SQUOZE CHARS) +JUMPLE C,SBCND +SQUOZE 4,IFNB ;ASSEMBLE IF STRING NOT BLANK +JUMPG C,SBCND +SQUOZE 4,IFSQ ;ASSEMBLE IF STRING ARG IS ALL SQUOZE +JUMPLE B,SBCND +SQUOZE 4,IFNSQ ;ASSEMBLE IF STRING ARG IS NOT ALL SQUOZE. +JUMPG B,SBCND + +SQUOZE 4,PRINTX +APRIN2,,APRINT +SQUOZE 4,PRINTC +APRIN3,,APRINT +SQUOZE 4,COMMEN +APRIN1,,APRINT +SQUOZE 4,.TYO +A.TYO +SQUOZE 4,.TYO6 +A.TYO6 +SQUOZE 4,.ERR +A.ERR + +SQUOZE 4,.RELP +A.RELP +SQUOZE 4,.ABSP +A.ABSP +SQUOZE 4,.RL1 +A.RL1 +SQUOZE 4,.LIBRA +LLIB,,A.LIB +SQUOZE 4,.LENGTH +A.LENGTH +SQUOZE 4,.LIFS +LTCP,,A.LIB +SQUOZE 4,.ELDC +A.ELDC +IRPS A,,E N G LE GE L +SQUOZE 4,.LIF!A +JUMP!A A.LDCV +TERMIN +SQUOZE 4,.SLDR +A.SLDR + +SQUOZE 4,. +GTVLP +SQUOZE 4,.LOP +A.LOP +SQUOZE 40,$. +0 +SQUOZE 44,$R. +0 +SQUOZE 40,$O. ;(OH) GLOBAL OFFSET +0 +SQUOZE 40,$L. ;REAL LOCATION (WITHOUT OFFSET) +0 +SQUOZE 40,.LVAL1 +0 +SQUOZE 40,.LVAL2 +0 +SQUOZE 4,.LNKOT +A.LNKOT +SQUOZE 4,.NSTGW +1,,STGWS +SQUOZE 4,.YSTGW +-1,,STGWS +SQUOZE 4,.LIBRQ +A.LIBRQ +SQUOZE 4,.GLOBAL +ILGLI,,A.GLOB +SQUOZE 4,.SCALAR +ILVAR,,A.GLOB +SQUOZE 4,.VECTOR +ILVAR\ILFLO,,A.GLOB + +SQUOZE 4,.BYTC +NBYTS,,INTSYM +SQUOZE 4,.BYTE +A.BYTE +SQUOZE 4,.WALGN +A.WALGN + +;CREF PSEUDO-OPS. +SQUOZE 4,.CRFON +A.CRFN ;START CREFFING. +SQUOZE 4,.CRFOFF +A.CRFFF ;STOP CREFFING. +SQUOZE 4,.CRFIL +CRFILE,,INTSYM + +IFE CREFSW,[ + A.CRFN==ASSEM1 ;THESE DO NOTHING IF CAN'T CREF. + A.CRFFF==ASSEM1 +] + +IFN MACSW,[ ;MACRO PROCESSOR PSEUDOS +;MACROS GET DEFINED AS +;SQUOZE 4, +;,, MACCL + +SQUOZE 4,REPEAT +AREPEAT +SQUOZE 4,DEFINE +ADEFINE +SQUOZE 4,IRP +NIRPO,,AIRP +SQUOZE 4,IRPC +NIRPC,,AIRP +SQUOZE 4,IRPS +NIRPS,,AIRP +SQUOZE 4,IRPW +NIRPW,,AIRP +SQUOZE 4,IRPNC +NIRPN,,AIRP +SQUOZE 4,TERMIN +ATERMIN +SQUOZE 4,.QUOTE +A.QOTE +SQUOZE 4,.STOP +(400000)A.STOP +SQUOZE 4,.ISTOP +A.STOP +SQUOZE 4,.RPCNT +CRPTCT,,INTSYM +SQUOZE 4,.GSSET +A.GSSET +SQUOZE 4,.GSCNT +GENSM,,INTSYM +SQUOZE 4,.GO +A.GO +SQUOZE 4,.TAG +A.TAG +SQUOZE 4,.IRPCNT +CIRPCT,,INTSYM +IFN RCHASW,[SQUOZE 4,.TTYMAC +A.TTYM +] +SQUOZE 4,IFSE +SKIPN SCOND +SQUOZE 4,IFSN +SKIPE SCOND +] + +IFN FASLP,[ +SQUOZE 4,.FASL +A.FASL +SQUOZE 4,.ARRAY ;3 INDEX TO AFDMY1 TBL +AFATOM(3) +SQUOZE 4,.ATOM +AFATOM(AFDMAI) ;2 INDEX TO AFDMY1 TBL +AFDMAI==2 ;INDEX OF ATOM IN AFDMY1 TBL +SQUOZE 4,.FUNCT +AFATOM(1) ;1 " " " " +SQUOZE 4,.SPECI +AFATOM(0) ;0 " " " " +SQUOZE 4,.SX +AFLIST(1) ;NORMAL LIST +SQUOZE 4,.SXEVA +AFLIST ;EVAL LIST AND THROW VALUE AWAY +SQUOZE 4,.SXE +AFLIST(2) ;EVAL LIST AND "RETURN" VALUE +SQUOZE 4,.ENTRY +AFENTY ;DECLARE LISP ENTRY POINT (SUBR ETC) +] + +IFN TS,[ +SQUOZE 4,.FNAM1 +RFNAM1,,INTSYM +SQUOZE 4,.FNAM2 +RFNAM2,,INTSYM +SQUOZE 4,.FVERS +RFVERS,,INTSYM +SQUOZE 4,.INSRT +A.INSRT +SQUOZE 4,.INEOF +A.INEO +IRPS X,,I O + IRPS Y,,1 2 + SQUOZE 4,.!X!FNM!Y + X!FNM!Y,,INTSYM +TERMIN TERMIN +SQUOZE 4,.IFVRS +IFVRS,,INTSYM +SQUOZE 4,.TTYFLG +A.TTYFLG,,INTSYM +] +IFN .I.FSW,[ +SQUOZE 4,.F +A.F +SQUOZE 4,.I +A.I +] +IFN ITSSW,[ +IRPS X,,UAI UAO BAI BAO UII UIO BII BIO +SQUOZE 10,.!X +.IRPCN +TERMIN + +IRPS X,Y,START LFILE STP+SYM JCL PFILE STB CONV+XUNAME XJNAME LJB+ + SQUOZE 10,..R!X + .IRPCN+1 +IFSN Y,+,[ + SQUOZE 10,..S!X + 400000+.IRPCN+1 +] TERMIN +] + +EISYMT: PRINTA \.-MACTBA-1, words initialization coding. + VARIAB +IFN .-EISYMT,.ERR Non-empty variables area + +IFN DECSW,[ + IFGE .-MACTBA-MACL,[ +IFN MACL, PRINTA [MACL too small, set to ]\.-MACTBA + MACL==.-MACTBA +]] + +IFN ITSSW\TNXSW,[ +IFGE .+2400-MACTBA-MACL,.ERR MACL too small + LOC <.+1777>&-2000 +MXICLR==./2000 ;FIRST PAGE ABOVE INITIALIZING CODING + LOC &-2000 +MXIMAC==./2000 ;FIRST PAGE ABOVE INITIAL MACTBA +MAXMAC==/2000 + ;1ST PAGE MACRO TABLE CAN'T POSSIBLY USE. +IFLE MINPUR-MAXMAC,.ERR Pure too low. +PRINTA MINPUR-MAXMAC = ,\MINPUR-MAXMAC +] + +IFN TS,END BEG +END diff --git a/src/midas/midas.421 b/src/midas/midas.421 new file mode 100644 index 00000000..7ec378be --- /dev/null +++ b/src/midas/midas.421 @@ -0,0 +1,11960 @@ +; -*-MIDAS-*- +IFE .OSMIDAS-SIXBIT/DEC/,.SYMTAB 4003.,2000. ;THIS MANY ON DEC SYSTEM +.ELSE .SYMTAB 8003. ;ELSEWHERE ASSEMBLE FASTER. + +TITLE MIDAS +SUBTTL INITIAL DEFINITIONS + +; AC DEFINITIONS. FF AND P MUST BE 0 AND 17 RESPECTIVELY, OTHERWISE +; ONLY CONSTRAINTS ARE EXPRESSED AS SEQUENTIAL ORDERINGS, E.G. B+1 ETC. +; ALSO, +.SEE R1 + +FF=:0 ; FLAGS. MUST BE AC 0. +AA=:1 ; GENERAL PURPOSE REGS, MUST BE SEQUENTIAL. +A=:AA+1 ; 2 +B=:A+1 ; 3 +C=:B+1 ; 4 +D=:C+1 ; 5 +T=:6 ; NOT SO TEMP AS IN MOST PROGS W/ T +TT=:T+1 ; 7 +I=:10 ; INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF +SYM=:11 ; FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR +LINK=:SYM+1 +F=:13 +CH1=:14 ; MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH +CH2=:CH1+1 ;" " " +TM=:16 ; SUPER TEMPORARY +P=:17 ; PDL AC, MUST BE 17. AS WELL AS RANDOM CROCKS IN PROGRAM, 20X ERCAL + ; ASSUMES P=17. + + +IFDEF .XCREF, .XCREF FF,P,I,A,B,C,D,T + +;OPERATING SYSTEM CONDITIONAL FLAGS: +; ITSSW IS 1 IF TO RUN ON ITS. +; DECSW IS 1 IF TO RUN ON ANY SORT OF BOTTOMS-10 (INCL. SAIL AND CMU). +; TNXSW IS 1 IF TO RUN ON TENEX OR TWENEX. +; SAILSW IS 1 IF TO RUN ON SAIL, AS OPPOSED TO OTHER BOTS-10. +; CMUSW IS 1 IF TO RUN AT CMU, AS OPPOSED TO OTHER BOTS-10. +; DECDBG IS 1 (ONLY WHEN DECSW IS 1) TO LEAVE SPACE FOR SYMBOL TABLE +; TO BE MOVED TO AFTEREXECUTION IS STARTED. +; DECBSW IS 1 TO PUT DECBTS IN THE PREDEFINED SYMBOL TABLE (ONLY IF DECSW IS 1). +; SMALSW IS 1 TO OCCUPY AS LITTLE CORE AS POSSIBLE. +; TS IS 1 EXCEPT FOR NON-TIMESHARED VERSION (WHICH IS OBSOLETE). +; CVTSW IS TO MAKE A MIDAS USING A DECDFS OR TNXDFS FILE GENERATED BY CVT. +; CVT READS A MONSYM FILE AND MAKES A TNXDFS.MID FILE, ALTHOUGH IT COULD +; BE HACKED TO READ UUOSYM AND MAKE DECDFS TOO. THERE IS NO SEPARATE +; DECBTS OR TWXBTS FILE WHEN USING CVT. + +IF1,[ ;FOR PASS 1 TTY CONDITIONALS +IFDEF SAILSW,IFN SAILSW,DECSW==1 +IFDEF CMUSW,IFN CMUSW,DECSW==1 +IFDEF DECDBG,IFN DECDBG,DECSW==1 +IFDEF DECSW,IFN DECSW,DECSW==1 ? ITSSW==0 ? TNXSW==0 +IFDEF ITSSW,IFN ITSSW,ITSSW==1 ? DECSW==0 ? TNXSW==0 +IFDEF TNXSW,IFN TNXSW,TNXSW==1 ? DECSW==0 ? ITSSW==0 +] ; IF1 +IFNDEF ITSSW,ITSSW==IFDEF .IOT,[1] .ELSE 0 ;NON-ZERO => ITS VERSION +IFNDEF TNXSW,TNXSW==IFDEF GTJFN,[1] .ELSE 0 ;NON-ZERO => TENEX VERSION +IFNDEF DECSW,DECSW==IFDEF LOOKUP,[1-TNXSW] .ELSE 0 ;NON-ZERO => DEC VERSION + ; TNXSW SINCE OLD VERSIONS OF TENEX MIDAS HAD DEC + ; UUO'S DEFINED TOO ONCE UPON A TIME +IF1 IFN ITSSW+DECSW+TNXSW-1,.FATAL So what monitor is MIDAS supposed to run under? +IFNDEF DECDBG,DECDBG==0 ;NON-ZERO => DEC VERSION TO RUN WITH DEC DDT. +IFN DECSW,[ +IFNDEF SAILSW,SAILSW==IFDEF SPCWAR,[1] .ELSE 0 ;NON-ZERO => SAIL VERSION. +IFNDEF CMUSW,CMUSW==IFDEF CMUDEC,[1] .ELSE 0 ;NON-ZERO => CMU VERSION. +] +IFE DECSW,SAILSW==0 ? CMUSW==0 ;CAN'T BE SAIL OR CMU FOR ITS OR TENEX VERSION +IFNDEF SMALSW,SMALSW==DECSW- ;NON-ZERO => SMALL MIDAS (NORMALLY + ; FOR RANDOM DEC SITES ONLY) +IFNDEF DECBSW,DECBSW==DECSW*<1-SAILSW>*<1-SMALSW> + ;NON-ZERO => INCLUDE DECBTS +IFNDEF CVTSW,CVTSW==0 ;NON-ZERO => BITS DEFINITIONS COME FROM FILES + ; MADE USING CVT +IFN ITSSW\DECSW\TNXSW,TS==1 +IFNDEF TS,TS==1 ;NON-ZERO => TIME-SHARING VERSION +IFE TS,1PASS +IFNDEF A1PSW, A1PSW==TS ;NON-ZERO => 1PASS END-OF-PROGRAM AUTO-REASSEMBLY +IFNDEF BRCFLG, BRCFLG==0 ;NON-ZERO => BRACES { AND ~ ARE SPECIAL IN MACRO + ; ARGS, ETC. JUST LIKE BRACKETS. BRACES ARE SPECIAL + ; IN CONDITIONALS REGARDLESS OF BRCFLG. +IFNDEF CREFSW, CREFSW==ITSSW ;NON-ZERO => ALLOW C SWITCH TO CAUSE CREF OUTPUT. +IFNDEF LISTSW, LISTSW==1 ;NON-ZERO => ALLOW L SWITCH TO CAUSE A LISTING. +IFNDEF RCHASW, RCHASW==TS ;NON-ZERO => INCLUDE TTY AS POSSIBLE INPUT DEVICE +IFNDEF PURESW, PURESW==TS-SAILSW ;NON-ZERO => SEPARATE PURE CODING FROM IMPURE AND + ; DO PAGE SKIPS. TWO SEGMENTS HURTS EFFICIENCY AT SAIL. +IFNDEF FASLP, FASLP==1-SMALSW ;NON-ZERO => INCLUDE FASL OUTPUT CAPABILITY + ; NOTE!! IF RUNNING UNDER 10/50 THIS MAKES THINGS + ; SEVERAL K BIGGER THAN OTHERWISE. +IFNDEF .I.FSW, .I.FSW==1-SMALSW;NON-ZERO => INCLUDE .I, .F +IFNDEF MACSW, MACSW==1 ;NON-ZERO => INCLUDE MACRO PROCESSOR (!) +IFNDEF RUNTSW, RUNTSW==1 ;NON-ZERO => TYPE OUT RUN TIME AT END OF ASSEMBLY +IFNDEF WRQTSW, WRQTSW==1 ;WRQOTE (MACRO DEFINITION READER) VERSION + ; ^ 0 => SLOW, 1 => FAST; MAYBE 2 WILL EVENTUALLY BE CREATED +IFE TS,IFNDEF MACL,MACL==6*2000 ;MACRO TABLE SIZE +IFN TS,[ +IFN ITSSW,IFNDEF MACL,MACL==6000;DEFAULT MACL SIZE FOR ITS. IF WE HAVE DECBTS OR +IFN TNXSW,IFNDEF MACL,MACL==12*2000 ; TWXBTS, THIS GETS INCREASED, CAUSE THEY ARE HUGE! +IFN DECSW,IFNDEF MACL,MACL==0 ;NON-ITS: WE WANT MACL TO JUST COVER THE INIT CODE. +IFNDEF MXMACL,MXMACL==32.*2000 ;MAXIMUM LENGTH MACTAB +] +IFNDEF MACRUM,MACRUM==4 ;# WORDS NOT USED AT END OF MACTAB +IFNDEF STRL,STRL==20 ;LENGTH OF STRING STORAGE (USED BY GSYL) +IFNDEF DMDEFL,DMDEFL==40 ;MAX NO OF DMY ARGS IN DEFINE +IFNDEF DMYAGL,DMYAGL==400 ;MAX NO COMBINED DMYARGS ALL MACROS CURRENTLY EXPANDING OR PUSHED +IFNDEF MPDLL,MPDLL==300 ;MACRO PDL LENGTH +IFNDEF DSSIZ,DSSIZ==40 ;MAX # ARGS MACRO WHOSE ARGS BEING SCANNED (SHOULD BE .GE. DMDEFL) +IFNDEF BKTABL,BKTABL==40 ;MAX NUM .BEGIN BLOCKS. +IFNDEF BKPDLS,BKPDLS==10 ;MAXIMUM .BEGIN BLOCK NESTING DEPTH. +IFNDEF BSIZE,BSIZE==37 ;PREFERRED SIZE BLOCK MAX SIZE-3 +IFN SMALSW,IFNDEF LPDL,LPDL==200. +IFNDEF LPDL,LPDL==500. ;LENGTH OF PDL +IFN SMALSW,IFNDEF CONMIN,CONMIN==1000 +IFNDEF CONMIN,CONMIN==3300 ;MINIMUM AMT OF SPACE FOR CONSTANTS TABLES. +IFNDEF CONMAX,CONMAX==20000 ;MAXIMUM SPACE USER CAN ASK FOR. +IFNDEF NCONS,NCONS==75. ;MAXIMUM NUMBER OF CONSTANTS AREAS +IFNDEF NVARS,NVARS==25. ;MAX. NUM. VARIABLES AREAS. +IFN DECBSW\TNXSW,IFNDEF SYMDSZ,SYMDSZ==4003. ; MUST INCLUDE TONS OF SYSTEM DEFS +IFN SMALSW,IFNDEF SYMDSZ,SYMDSZ==2003. +IFNDEF SYMDSZ,SYMDSZ==2707. ;DEFAULT # SYMS IN SYMTAB. +IFNDEF SYMMSZ,SYMMSZ==10177*2 ;# SYMS IF JNAME IS MMIDAS. +IFNDEF SYMMAX,SYMMAX==40000 ;MAX SYMTAB SIZE (# SYMS) +IFNDEF FASBL,FASBL==400 ;WORDS USED FOR FASL OUTPUT BUFFER + ; MUST HOLD STUFF ASSOC WITH ONE GROUP OF 9 CODE BYTES +IFNDEF FASATL,FASATL==2000 ;WORDS USED FOR FASL ATOM TABLE + ; HOLDS PNAMES ETC OF ALL ATOMS AS WILL BE IN FASLOAD'S + ; SYMTAB AT LOAD TIME +IFNDEF MINWPS,MINWPS==3 ;MIN # WORDS IN SYMTAB ENTRY +IFNDEF MAXWPS,MAXWPS==3 ;MAX # ALLOWED (WILL BE BIGGER SOME DAY) +IFNDEF NRMWPS,NRMWPS==3 ;DEFAULT #. 2 WDS FOR VALUE & FLAGS, 1 FOR NAME. + +; VERSION, FLAGS, ETC. + +IF1 [ + +IFNDEF MIDVRS,MIDVRS=.FNAM2 +IFE MIDVRS-SIXBIT/MID/,[ +PRINTX /What is MIDAS version number? / +.TTYMAC VRS +MIDVRS=SIXBIT/VRS/ +TERMIN +] + +;OSMIDAS GETS THE SIXBIT NAME OF THE TYPE OF OP. SYS. THE VERSION OF MIDAS +;IS BEING ASSEMBLED TO RUN UNDER. IT WILL BE THE VALUE OF ".OSMIDAS" WHEN PROGRAMS +;ARE ASSEMBLED WITH THIS MIDAS. NOTE THAT TNX VERSION ACTUALLY SETS IT +;AT RUNTIME STARTUP TO "TENEX" OR "TWENEX" AS APPROPRIATE. +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/ + +;FF FLAGS NOT PUSHED +;LEFT HALF +FL==1,,525252 +FLPPSS==400000 ;ONE IF PUNCHING PASS; MUST BE SIGN +FLHKIL==100000 ;ONE IF SYM TO BE SEMI KILLED IN DDT + +FLVOT== 40000 ;ALL RCH S MUST GO THRU RCH + ; IE TYPCTL .NE. POPJ P, (SET/CLEARED BY MDSSET, MDSCLR) +FLMAC== 20000 ;ONE IF CHARS COMING FROM MACRO PROCESSOR, DON'T HACK CPGN/CLNN +FLTTY== 10000 ;ONE IF CHARS FROM SOMEWHERE ELSE BUT NOT HACKING CPGN/CLNN +$FLOUT== 4000 ;ONE IF OUTPUT HAS OCCURED IN CURRENT MODE (USED BY TS NED LOGIC) +FLPTPF== 2000 ;SET IF (TIME SHARING) OUTPUT DEVICE IS PTP +FLUNRD== 1000 ;=> RE-INPUT LAST CHARACTER (SEE RCH) +FL20X==400 ; IN TENEX VERSION, 1= RUNNING ON TOPS-20, 0 = TENEX. + +;FF RIGHT HALF FLAGS + +FR==525252 +FRFIRWD==400000 ;ONE FOR FIRST WORD OF BLOCK +FRSYMS==200000 ;ONE IF SYM PUNCH DESIRED +FRLOC==100000 ;ONE BETWEEN ABS LOC ASSIGN AND + ;FIRST BLOCK OUTPUT THEREAFTER (EBLK TO OUTPUT NULL BLOCK SO LINKING LOADER KNOWS $.) + +FRNPSS==40000 ;ONE IF TWO PASS ASSEMBLY +FRPSS2==20000 ;ONE ON PASS 2 + +FRINVT==4000 ;USED BY PBITS AND OUTPUT TO OUTPUT WORDS OF CODE BITS IN CORRECT ORDER (STEAD LOGICAL) +FRNLIK==2000 ;TEMPORARILY SUPPRESS ADR LINKING +FRGLOL==1000 ;ONE IF LOCATION PLUS OFFSET IS GLOBAL + +FRBIT7==400 ;SET IF LAST TIPLE OF CODEBITS WAS 7. +FRMRGO==200 ;MACRO PROC TO RETURN TO .GO HACKER W/O READING NEXT CHAR (SEE RCHSAV) + +FRCMND==40 ;SET WHILE READING CMD, TELLS RFD TO NOTICE (, _, COMMA. +FRNNUL==20 ;SET ON RETURN FROM RFD IFF NONNULL SPEC. +FRARRO==10 ;TELLS RFD THAT 1ST NAME IS FN1, NOT FN2. +FRFN1==4 ; TELLS RFD THAT 1ST NAME WAS READ. + + + ; FLAGS TO ZERO AT BEGINNING OF PASS 1 ONLY, BY $INIT. +FFINIT==<-1-FLVOT-FLPTPF-FLTTY-FL20X,,-1> + +] ;END IF1 + +;INDICATOR REGISTER + +IF1 [ + +;LEFT HALF +IL==1,,525252 +ILGLI==1 ;SET ON " CLEARED EACH SYL +ILVAR==2 ;SET ON ' " " " +ILFLO==4 ;FLOATING NUM, SET ON DIGIT AFTER . +ILDECP==10 ;DECIMAL PREFER, SET WHEN . SEEN. +ILUARI==20 ;1 => RIGHT OPERAND TO UPARROW BEING READ +ILLSRT==40 ;RETURN FROM < +ILWORD==400 ;SET IF CURRENT WORD IS NOT NULL RETURNED BY GETWORD +ILNPRC==1000 ;ONE IF NUMBER ALREADY PROCESSED BY UPARROW +ILMWRD==4000 ;SET ON MULTIPLE WORD +ILPRN==10000 ;SET DURING MACCL IF MACRO NAME WAS FOLLOWED BY (. +ILMWR1==20000 ;SET BY LBRAK AS SIGNAL TO ITSELF THAT THIS NOT FIRST + ;WORD OF MULTI-WORD CONSTANT +ILNOPT==40000 ;CONSTANTS OPTIMIZATION SUPPRESSION FLAG; SHOULD BE SET BY + ;VALUE-RETURNING PSEUDO DURING NOT PUNCHING PASS TO KEEP ITSELF OUT OF + ;CONSTANTS OPTIMIZATION + +;RIGHT HALF + +IR==525252 +IRFLD==1 ;SET IF FLD NOT NULL +IRSYL==2 ;SET IF SYL NOT NULL +IRLET==4 ;SET IF SYL IS SYMBOL +IRDEF==10 ;SET IF CURRENT EXPR DEFINED +IRNOEQ==20 ;SET IF = ISN'T ALLOWED IN CURRENT CONTEXT. +IRCOM==40 ;SET IF CURRENT QUAN IS COMMON +IRPERI==100 ;SET IF PERIOD SEEN IN WHAT IS SO FAR (INCL .) A NUMBER +IREQL==200 ;ONE DURING READING WORD TO RIGHT OF = +IRIOINS==400 ;FIRST FIELD OF CURRENT WORD HAS IO INST +IRCONT==1000 ;SET IF NOT OK TO END BLOCK +IRPSUD==4000 ;SET IF ERROR COMMENTS WILL COME FROM PSEUDO +IRGMNS==20000 ;SET IF ILUARI OR BAKARI HAS GOBBLED MINUS +IROP==200000 ;SET IF OPERATOR SEEN IN CURRENT FIELD + +CALL==PUSHJ P, +RET==POPJ P, +;SAVE=PUSH P, ;DON'T USE SAVE! IT'S A JSYS ON TENEX AND TWENEX +REST==POP P, +PJRST==JRST ; FOR JRST'ING TO A POPJ'ING ROUTINE. + +ETSM=1000,, ;ERROR, TYPE SYM. +ETR=2000,, ;ERROR, ORDINARY MESSAGE. +ERJ=3000,, ;ERROR, NO MESSAGE, RETURN TO ADDR. +ETI=4000,, ;ERROR, IGNORE LINE, RET. TO ASSEM1. +ETA=5000,, ;ERROR, RET. TO ASSEM1. +ETASM=6000,, ;ERROR, TYPE SYM AND RETURN TO ASSEM1 +ETF=7000,, ;FATAL ERROR. +TYPR=(37000) ;UUO, TYPE OUT ASCIZ STRING +TYPCR=(36000) ; LIKE TYPR BUT ADDS CR AT END. +] ;END IF1 + +IF1 [ +;LINK TABLE (GLOTB), ACCUMULATES GLOBAL REFERENCES FOR CURRENT FROB (USUALLY WORD) TO OUTPUT +;GLSP2 POINTS TO (I.E. HAS ADR 1 LESS THAN) BOTTOM OF ACTIVE PART OF TABLE +;GLSP1 POINTS TO TOP (HAS ADR OF LAST ENTRY ACTIVE) + +;ACTUAL ENTRIES IN GLOTB: +;IF ENTIRE WORD ZERO, ENTRY IS NULL, WILL (OR SHOULD) BE IGNORED +;RH ADR OF SQUOZE WITH INTERNAL MIDAS FLAGS (USUALLY IN SYMBOL TABLE, BUT MAY BE ANYWHERE IN CORE) +;LH: RIGHT 10. BITS MULTIPLICATION FACTOR OR 0 => 1 + ;GLOBAL SHOULD BE MULTIPLIED BY IT +;REST OF LH FLAGS: + +;SIGN BIT => THIS NOT PART OF FIELD, DON'T PLAY WITH FLAGS AT GETFLD, INTFD +ACF==40000 ;AC LOW OR HIGH (SWAPF => HIGH) +HFWDF==100000 ;MASK GLOBAL TO HALFWORD +SWAPF==200000 ;SWAP +MINF==20000 ;NEGATIVE OF GLOBAL + +IFNDEF LBRKT,LBRKT=="[ ;LEFT DELIMITER FOR EXPLICITLY GROUPED CONDITIONALS, MACRO ARGS, REPEAT BODY, ETC. +IFNDEF RBRKT,RBRKT=="] ;RIGHT " +IFNDEF WPS, WPS==3 ;# CONTIG. WDS /STE. IFNDEF FOR DEBUGGING. +IFNDEF BKWPB,BKWPB==3 ;# WDS/BKTAB ENTRY. +IFNDEF EOFCH,EOFCH==3 ;EOF CHAR, BEWARE DISPATCH TABLE ENTRIES. +IFNDEF LBRACE,LBRACE==173 +IFNDEF RBRACE,RBRACE==175 + +;3RDWRD LH. SYM TAB BITS + +3REL==600000 ;RELOC BITS, DO NOT CHANGE, SOMETIMES REFERENCED BY NUMERIC BYTE POINTERS +3RLL==400000 ;R(LH) +3RLR==200000 ;R(RH) +3RLNK==100000 ;R(LINK) +3KILL==40000 ;FULLY-KILLED SYM (DON'T GIVE TO DDT). +3VP==20000 ;VALUE PUNCHED +3SKILL==10000 ;SEMI KILL IN DDT +3LLV==4000 ;LINKING LOADER MUST INSERT VAL +3VAS2==2000 ;VAR SEEN ON PASS TWO WITH ' +3VCNT==1000 ;USED IN CONSTANT +3MAS==400 ;THIS ISN'T THE LAST DEFINITION OF A SYM WITH THIS NAME + ;(SO ES MUST KEEP SEARCHING). +3NCRF==200 ;DON'T CREF THIS SYMBOL. +3MACOK==100 ;OK TO (RE)DEFINE THIS SYM AS MACRO. + ;(IE IS A MACRO OR SEEN ONLY IN .XCREF) +3LABEL==40 ;ILLEGAL TO REDEFINE THIS SYM TO DIFFERENT VALUE +3MULTI==20 ;THIS SYM IS MULTIPLY DEFINED, SO FLAG ALL DEFINITIONS. +3DOWN==10 ;THIS DEFINITION SHOULD BE SEEN BY SUBBLOCKS IN 1PASS MODE. + +3DFCLR==737110 ;BITS IN LH TO CLEAR ON REDEFINITION. + +; FLAGS IN "CONTROL" VARIABLE +.SEE CONTRL + ;LEFT HALF +TRIV==400000 ; 1 IF OUTPUT FORMAT IS FOR TRIVIAL LOADER (ABSOLUTE) + ; ELSE RELOCATABLE (NOTE THIS CROCKISHLY ONLY MEANS + ; STINK FORMAT, SINCE DEC RELOC FORMAT HAS THIS FLAG SET) + + ;RIGHT HALF +ARIM== 2 ; 1 => OUTPUT FORMAT IS RIM +SBLKS== 10 ; 1 => OUTPUT FORMAT IS SBLK (SIMPLE BLOCKS) +ARIM10== 20 ; 1 => OUTPUT FORMAT IS PDP-10 RIM +DECREL== 40 ; 1 => DEC RELOCATABLE FORMAT (CONSIDERED "ABSOLUTE" INSIDE MIDAS) +FASL== 100 ; 1 => LISP FASL COMPATIBLE RELOCATABLE FORMAT ( " " ") +DECSAV==200 ; 1 => DEC SAV FORMAT (ABSOLUTE) ALSO WINS ON 10X, 20X + +PTR==104 ;DEVICE CODE FOR PAPER TAPE READER. + +] ;END IF1 + +IF1 [ + +;SQUOZE FLAG DEFINITIONS IN MIDAS SYMBOL TABLE + +CMMN==0 ;COMMON (NOT USED) +PSUDO==40000 ;PSEUDO OR MACRO, VALUE RH ADDR OF RTN (MACCL FOR MACRO), + ; LH WILL BE IN LH OF B WHEN RTN CALLED. +SYMC==100000 ;SYM, VALUE IS VALUE OF SYM. +LCUDF==140000 ;LOCAL UNDEF +DEFLVR==200000 ;DEF LOC VAR, VALUE IS VALUE. +UDEFLV==240000 ;UNDEF LOC VAR, VALUE IS 1+ IDX IN VARIAB. AREA, BUT IGNORD IF VAR AREA GLOB. +LGBLCB==300000 ;CODE BITS EQUAL TO THIS OR HIGHER REPRESENT GLOBAL QUANTITIES +DEFGVR==300000 ;DEF GLO VAR, VALUE IS VALUE +UDEFGV==340000 ;UNDEF GLO VAR, VALUE LIKE UNDEF LOCAL VAR. +GLOETY==400000 ;GLO ENTRY +GLOEXT==440000 ;GLO EXIT +NCDBTS==GLOEXT_<-18.+4>+1 ;# CODE BIT TYPES + +DEFINE CDBCHK TBLNAM +IFN .--NCDBTS,.ERR TBLNAM LOSES +TERMIN + +;LOADER BLOCK TYPES LINK +LLDCM==1 ;LOADER COMMAND BLOCK +LABS==2 ;ABSOLUTE +LREL==3 ;RELOCATABLE +LPRGN==4 ;PROG NAME +LLIB==5 ;LIBRARY BLOCK +LCOMLOD==6 ;LOAD INTO COMMON +LGPA==7 ;GLOBAL PARAMETER ASSIGN +LDDSYM==10 ;LOCAL SYMS +LTCP==11 ;LOAD TIME COND ON PRESENCE +ELTCB==12 ;END LOAD TIME COND +LPLSH==22 ;POLISH FIXUP + +;LOADER COMMANDS +;IN ADR OF LDCMD BLK +LCJMP==1 ;JUMP +LCGLO==2 ;GLOBAL LOC ASSIGN +LCCMST==3 ;SET COMMON BENCHMARK +LCEGLO==4 ;END OF GLOBAL BLOCK +LDCV==5 ;LOAD TIME COND ON VALUE +LDOFS==6 ;LOADER SET GLOBAL OFFSET +LD.OP==7 ;LOADER .OP + +;LOADER CODEBITS SECOND SPEC AFTER 7 +CDEF==0 ;DEF +CCOMN==1 ;COMMON REL +CLGLO==2 ;LOC-GLO REC +CLIBQ==3 ;LIBREQ +CRDF==4 ;GLO REDEF +CRPT==5 ;REPEAT GLOBAL VALUE +CDEFPT==6 ;DEFINE SYM AS $. + +;DEC RELOCATABLE BLOCK TYPES. +DECWDS==1 ;STORAGE WORDS. +DECSYM==2 ;SYMBOL DEFS OR GLOBAL ADDITIVE RQS. +DECHSG==3 ;LOAD INTO HIGH SEG (FOR .DECTWO) +DECENT==4 ;ENTRY NAMES +DECEND==5 ;END BLOCK, HAS PROGRAM BREAK. +DECNAM==6 ;PROGRAM NAME. +DECSTA==7 ;STARTING ADDRESS BLOCK. +DECINT==10 ;INTERNAL REQUEST +DECRQF==16 ;REQUEST LOADING A FILE +DECRQL==17 ;REQUEST LOADING A LIBRARY +] ;END IF1 + +IF1 [ + +DEFINE TYPE &STR +TYPR [ASCIZ STR] +TERMIN + +DEFINE TYPECR &STR +TYPCR [ASCIZ STR] +TERMIN + +DEFINE PRINTA A,B,C,D,E,F +IF1,[PRINTC A!B!C!D!E!F +] +TERMIN + +IF1 [DEFINE BNKBLK OP +OP +TERMIN ] + + ;ADD A LINE TO BNKBLK, ACCUMULATED CONTENT OF + ;WHICH IS DUMPED OUT AT END OF ASSEMBLY + ;ARG TO BLCODE SHOULD BE FREE OF STORAGE WORDS + +DEFINE BLCODE NEWCFT +IF1 [BNKBLK [DEFINE BNKBLK OP +OP]NEWCFT +TERMIN ] +IF2 [IRPW X,,[ +NEWCFT +] +IRPS Y,,X +Y=Y +.ISTOP TERMIN TERMIN ] TERMIN + + ;3RDWRD MANIPULATING MACROS + ;GET 3RDWRD INTO LH("A"), "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3GET A,B + MOVE A,ST+2(B) + TERMIN + + ;GET 3RDWRD INTO "A", "B" HAS ADR OF 1STWRD + +DEFINE 3GET1 A,B + MOVE A,2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3PUT A,B + MOVEM A,ST+2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS ADR OF 1STWRD + +DEFINE 3PUT1 A,B + MOVEM A,2(B) + TERMIN + +] ;END IF1 + +;RANDOM MACRO DEFINITIONS + +IF1 [ + + ;A HAS ADR OF SYM SQUOZE, SKIP IF IT'S IN SYMBOL TABLE + +DEFINE SKPST A + CAIL A,ST + CAML A,MACTAD +TERMIN + + ;EXECUTE AN INSTRUCTION WITH VARIOUS ADDRESSES (USUALLY PUSH OR POP) + +DEFINE INSIRP A,B + IRPS %ADR,,[B] + A,%ADR + TERMIN +TERMIN + +DEFINE NOVAL + TDNE I,[ILWORD,,IRNOEQ\IRFLD] + ETSM ERRNVL +TERMIN + +DEFINE NOABS + SKIPGE CONTRL + ETASM ERRABS +TERMIN + +] ;END IF1 + +ERRNVL==[ASCIZ /Returns no value/] +ERRABS==[ASCIZ /Allowed only for STINK relocatable format/] + +IF1 [ + +DEFINE MOVEIM B,C + MOVEI A,C + MOVEM A,B +TERMIN + +DEFINE MOVEMM B,C + MOVE A,C + MOVEM A,B +TERMIN +] ;END IF1 + +IF1 [ +IFN 0,[ +;THESE ARE SOME MACRO DEFINITIONS FOR THE UNFINISHED MULTI-WORD +;SYMBOL NAME FEATURE. FOR COMPATIBILITY, THEY ALL NOW HAVE DEFINITIONS +;THAT ONLY HANDLE ONE WORD. THOSE OTHER DEFINITIONS COME AFTER THESE. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +IFSN X,SYM,SKIPE A,X+1 +.ELSE SKIPE A,SYMX + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y + MOVE Z,X+1 + MOVEM Z,Y+1 +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y + MOVE Z,AC!X + MOVEM Z,Y+1 +TERMIN +] + +.ELSE [ +;THESE ARE THE DEFINITIONS OF THE MACROS THAT DO NOT IMPLEMENT +;MULTI-WORD SYMBOL NAMES. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y +TERMIN +] + +DEFINE USING X +X,TERMIN + +] ;END IF1 + +SUBTTL DEFINE SYS DEPENDENT SYMBOLS & SELECT OUTPUT FORMAT + +; THIS DEFSYM MACRO IS FOR COMPILING MIDAS ON ANOTHER OPERATING SYSTEM. THIS +; AVOIDS SAME-NAME SCREWS (IE, "LOCK" IS SOMETHING DIFFERENT ON TWENEX, SAIL, +; AND DEC). + +IF1 [ +DEFINE DEFSYM X/ + IRPS Z,,[X] + EXPUNGE Z + .ISTOP + TERMIN + X +TERMIN +]; IF1 + +IFN DECSW\TNXSW,[ +IF1 [ +; INSERT UUO DEFINITIONS FILES AS APPROPRIATE. +IFE CMUSW\SAILSW\TNXSW,.INSRT DECDFS +IFN SAILSW, .INSRT SAIDFS +IFN CMUSW, .INSRT CMUDFS +IFN TNXSW, .INSRT TNXDFS + +;ACTUALLY DEFINE THE UUOS USING THE MACROS READ FROM THE FILES. +IFE CVTSW,[ +IFN DECSW,.DECDF DEFSYM +IFN TNXSW,.TNXDF DEFSYM + +;INSERT THE BITS DEFINITION FILES AS APPROPRIATE. +;THESE MUST BE INSERTED EVEN IF THEY ARE PREDEFINED, BECAUSE +;THE MIDAS SYMBOL TABLE IS CONSTRUCTED FROM THE DEFINITIONS IN THIS ASSEMBLY +;OF THOSE SYMBOLS, AND THAT MEANS WE NEED THE LATEST VERSION ASSEMBLED IN. +IFN TNXSW,[ +EQUALS TEM,.SYMTAB +.INSRT TWXBTS +EQUALS .SYMTAB,TEM +] +IFN DECBSW,.INSRT DECBTS +];IFE CVTSW + +IFN TNXSW,[ ; AC DEFS FOR DIRECT REFERENCE TO JSYS ARGS +R1==:1 ; SOMEDAY MAYBE THE SYMBOLS A,B ETC WILL CORRESPOND... +R2==:2 +R3==:3 +R4==:4 +R5==:5 +] + +EXPUNGE HALT +DEFINE HALT + JRST 4,. +TERMIN + +EXPUNGE .VALUE +EQUALS .VALUE HALT + +DEFINE .LOSE A + JRST 4,.-1 +TERMIN +] ;IF1 + +IFN DECSW,[ ; SELECT OUTPUT FORMAT FOR DEC VERSION +IFN PURESW,.DECTWO +IFE PURESW,.DECREL + RL0==. +] +IFN TNXSW,[ ; SELECT OUTPUT FORMAT FOR TNX VERSION +IFNDEF DECSVF,[ ; NORMALLY, USE .DECSAV IF AVAILABLE, ELSE .DECREL, + DECSVF==0 ; BUT USER CAN OVERRIDE THAT BY SPECIFYING DECSVF. + IFDEF .DECSAV,DECSVF==1 +] +IFN DECSVF,.DECSAV +.ELSE [ IFN PURESW,.DECTWO + .ELSE .DECREL + ] + RL0==0 +] +] ;IFN DECSW\TNXSW + +IFN ITSSW,[ +IF1 [IFNDEF .IOT,[.INSRT SYS:ITSDFS + .ITSDF DEFSYM + ] ;IFNDEF .IOT +IFNDEF %PIPDL,.INSRT SYS:ITSBTS + HALT==.VALUE + EXPUNG .JBTPC,.JBCNI + +DEFINE SYSCAL A,B + .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] +TERMIN +] ;IF1 + +IFDEF .SBLK,.SBLK ; SELECT OUTPUT FORMAT FOR ITS VERSION + RL0==0 +] ;IFN ITSSW + +IFE PURESW,[ ;FOLLOWING IF NOT ASSEMBLING PURE CODING + +DEFINE PBLK +TERMIN + +DEFINE VBLK +TERMIN +] + +IFN PURESW,[ ;FOLLOWING IF ASSEMBLING PURE CODING + +;MEMORY ORGANIZATION PURE CODING + +;MAXVAR BLOCKS OF IMPURE CODING, NO DYNAMIC ALLOCATION + ;BLCODE MACRO ACCUMULATES CODING TO BE PUT AT END OF + ;IMPURE CODING, NO STORAGE WORDS ALLOWED +;THEN SYM TAB, STARTING AT ST. +;THEN MACRO TABLE (WITH INIT. CODE IN IT) +;STARTING INITIALLY AT MACTBA, ACTUAL ADDR IN MACTAD. +;SYMTAB AND MACTAB DON'T NECESSARILY START ON PAGE BNDRYS. +;THEN GAP TO MINPUR*2000 (HEREAFTER KNOWN AS "THE GAP") + +IFN DECSW\TNXSW,MINPUR==200 +IFN ITSSW,MINPUR==160 ;BLOCK NUMBER BEGINNING OF PURE CODING + +;PURE CODING UNTIL MAXPUR*2000-SOMETHING +;THE FOLLOWING MACROS AND BLCODE MAKE IT NOT COMPLETELY NECESSARY +;TO SEPARATE PURE CODING FROM IMPURE + +CKPUR==0 ;0 => ASSEMBLING BELOW THE GAP, 1 ABOVE + + ; PBLK - SWITCH TO CODING ABOVE THE GAP +DEFINE PBLK +IFN CKPUR,.ERR PBLK +IFE CKPUR,[VAR.LC==. +LOC PUR.LC +]CKPUR==1 +TERMIN + + ; SET INITIAL LOCATION COUNTER FOR ASSEMBLING PURE CODE ABOVE GAP. +IFN ITSSW, PUR.LC==MINPUR*2000 +IFN DECSW, PUR.LC==MINPUR*2000+RL0 +IFN TNXSW,[ + IFN DECSVF,PUR.LC==MINPUR*2000 + .ELSE PUR.LC==MINPUR*2000+20 ;SKIP VESTIGIAL JOBDAT AREA. +] + + ; VBLK - SWITCH TO CODING BELOW THE GAP +DEFINE VBLK +IFE CKPUR,.ERR VBLK +IFN CKPUR,[PUR.LC==. +LOC VAR.LC +]CKPUR==0 +TERMIN + +IFN TNXSW,IFE DECSVF,LOC 200 + +PBLK ;PBLK NORMAL MODE, VARIABLE AREAS BRACKETED WITH VBLK AND PBLK + +] ;END PURESW CONDITIONAL + +.YSTGW ;SET UP NOW, STORAGE WORDS OK + +FOO==. +LOC 41 + JSR ERROR +IFN ITSSW,JSR TSINT +IFN DECSW,[ +LOC .JBAPR + TSINT1 +] +LOC FOO + + ;DISPATCH TABLE FOR NON-SQUOZE CHARACTERS + ;REFERENCED AS DTB-40(RH OF POPJ IN GDTAB) + ;DTB ENTRY OF SYL TERMINATOR PUT IN CDISP BY GETSYL + +DSYL==400000 ;SYL OPERATOR, DISPATCH INDEXED BY RH AT GETSYL (MUST BE SIGN) +DFLD==200000 ;FIELD OPERATOR, GETFD +DWRD==100000 ;WORD OP, GETWD +DSY1==1000 ;SET ONLY IF DSYL SET, + ;SET IF OP MIGHT BE 1ST CHAR OF NONNULL SYL. +DSYL1==DSYL+DSY1 +DSY2==400 ;SET FOR _ ONLY. + +;ALL CLEAR => WORD TERMINATOR, NO DISPATCH + +DTB: DWRD,,SPACE ;40 SP, TAB, RUBOUT + DSYL1,,RRL2 ;EXCLAIM AND OPEN-BRACE + DSYL1,,DQUOTE ;" + DFLD,,XORF ;NUM SIGN + DSYL,,RBRAK2 ;CLOSE-BRACE. + 0 ;(USED TO BE PERCENT SIGN) + DFLD,,ANDF ;AMPERSAND + DSYL1,,SQUOTE ;' + DFLD,,LEFTP ;( 50 + DSYL,,RPARN ;) + DFLD,,MULTP ; STAR TIMES + DFLD,,PLS ;+ PLUS + DWRD,,COMMA ; , + DFLD,,MINUS ;- + DSYL1,,CTLAT ;^@ (56) + DFLD,,DIVID ;/ + DSYL1,,COLON ;COLON 60 + DSYL,,SEMIC ;SEMI + DFLD,,LSSTH ;< + DSYL1,,EQUAL ;= + DSYL,,GRTHN ;> + 0 ;? + DSYL1,,ATSGN ;AT SIGN + DFLD,,LBRAK ;[ + DFLD,,IORF ;BACKSLASH 70 + DSYL,,RBRAK ;] + DSYL1,,UPARR ;^ + DSYL+DSY2,,BAKAR ;BACKARR + 0 ;CR + 0 ;(USED TO BE TAB) + 0 ;ALL OTHER + DSYL,,LINEF ;LF (DSYL TO HACK CLNN) + DSYL,,FORMF ;FORM FEED (") 100 + +;NOTE THAT POPJ P, IS VALID TEST FOR SQUOZENESS +;EXCEPT FOR EOFCH + +GDTAB: POPJ P,56 ; ^@ GETS IGNORED. + REPEAT 2,POPJ P,76 ;(GDTAB GLOBAL SO OUT OF TS, AIO CAN CLOBBER GDTAB+141 WITH JRST RREOF + ;ON OLD FILES) +IFN .-GDTAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH GDTAB. +IFE TS,[POPJ P,76] IFN TS,[JRST RREOF] + REPEAT 5,POPJ P,76 + POPJ P,40 ; TAB + POPJ P,77 ; LF + POPJ P,76 ; VERT TAB + POPJ P,100 ; FORM FEED + POPJ P,74 ; CR + REPEAT "!-16-1,POPJ P,76 + POPJ P,40 ; SPACE + POPJ P,41 ; ! + POPJ P,42 ; " + POPJ P,43 ; # + ADD SYM,%$SQ(D) ; $ + ADD SYM,%%SQ(D) ; % + POPJ P,46 ; & + POPJ P,47 ; ' + POPJ P,50 ; ( + POPJ P,51 ; ) + POPJ P,52 ; * + POPJ P,53 ; + + POPJ P,54 ; , + POPJ P,55 ; - + JSP CH1,POINT ; . + POPJ P,57 ; / + REPEAT 10.,JSP CH2,RR2 ; DIGITS + POPJ P,60 ; : + POPJ P,61 ; ; + POPJ P,62 ; < + POPJ P,63 ; = + POPJ P,64 ; > + POPJ P,65 ; ? + POPJ P,66 ; @ +IFDEF .CRFOFF,.CRFOFF +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN + POPJ P,67 ; [ + POPJ P,70 ; \ + POPJ P,71 ; ] + POPJ P,72 ; ^ + POPJ P,73 ; _ + POPJ P,76 ; NOW LOWER CASE GRAVE ACCENT + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN +IFDEF .CRFON,.CRFON + POPJ P,41 ;{ + POPJ P,76 ;| + POPJ P,44 ;~ + POPJ P,76 ; + POPJ P,40 ; RUBOUT, LIKE SPACE + IFN .-GDTAB-200,.ERR GDTAB LOSES + +NSQTB: IFDEF .CRFOFF,.CRFOFF +IRPC Q,,0123456789 + ADD SYM,%!Q!SQ(D) +TERMIN + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890$%. +%!Q!SQ: 0 + SQUOZE 0,Q/50/50/50/50/50 + SQUOZE 0,Q/50/50/50/50 + SQUOZE 0,Q/50/50/50 + SQUOZE 0,Q/50/50 + SQUOZE 0,Q/50 + SQUOZE 0,Q +TERMIN +IFDEF .CRFON,.CRFON + +;FORMAT TABLE(S) +;4.9-4.4 ETC SPECIFY SHIFT +;4.4-3.6 ETC SPECIFY NUMBER BITS +;FIELD SPECS IN REVERSE ORDER + +IFORTB: 0 ;NCNSN 10 , + 0 ;NCNSF 11 IMPOS + 0 ;NCNCN 12 ,, + 2200,, ;NCNCF 13 ,,C + 2200000000 ;NCFSN 14 ,B + 0 ;NCFSF 15 ,B C + 0 ;NCFCN 16 ,B, + 0 ;NCFCF 17 ,B,C + 4400000000 ;FSNSN 20 A + 0 ;FSNSF 21 IMPOS + 0 ;FSNCN 22 IMPOS + 0 ;FSNCF 23 IMPOS + 2200440000 ;FSFSN 24 A B + 2200220044 ;FSFSF 25 A B C + 270400440000 ;FSFCN 26 A B, + 2227040044 ;FSFCF 27 A B,C + 4400000000 ;FCNSN 30 A, + 0 ;FCNSF 31 IMPOS + 22220000 ;FCNCN 32 A,, + 2200002222 ;FCNCF 33 A,,B + 2200440000 ;FCFSN 34 A,B + 0 ;FCFSF 35 A,B C + 0 ;FCFCN 36 A,B, + 0 ;FCFCF 37 A,B,C +FRTBL==.-IFORTB ;LENGTH OF FORMAT TABLE +VBLK +FORTAB: BLOCK FRTBL ;ACTUAL FORMAT TABLE +FRTBE=.-1 +PBLK + +;VARIABLE STORAGE + +VBLK + +RETURN: JRST . ;RH HAS RETURN ADR FOR END OF MAJOR ROUTINE (E.G PASS 2) +CDISP: 0 ;CURRENT DISPATCH CODE +PPRIME: 0 ;PUSH DOWN LIST MARKER (GETFLD) +SCNDEP: 0 ;DEPTH IN SUCCESSFUL BRACKET CONDITIONALS INSIDE INNERMOST LITERAL. +CONDLN: 0 ;LINE NUMBER AT WHICH LAST TOP LEVEL SUCCESSFUL CONDITIONAL ENCOUNTERED +CONDPN: 0 ;PAGE NUMBER-- PRINT THESE IF REACH END AND CONDITIONAL NOT TERMINATED +CONDFI: 0 ;SIXBIT FN1 OF FILE CONTAINING LAST TOP LEVEL SUCCESSFUL CONDITIONAL. +A.SUCC: 0 ;NONZERO IFF LAST CONDITIONAL SUCCEEDED. +ASMOUT: 0 ;0 NORMAL, 1 WITHIN <>, 2 IN (), 3 IN []. +ASMDSP: ASSEM3 ;PLACE TO JUMP TO FROM ASSEM1 LOOP. + ;ASSEM3 NORMAL. ASSEMC IF WITHIN <>, () OR [] + ;AND .MLLIT ISN'T POS. LSSTHA AFTER > OR ) SEEN. + ;[ ;CONND AFTER ] SEEN. +ASMDS1: 0 ;ASMDSP SAVED HERE DURING ASCII, SIXBIT PSEUDOS. +ASSEMP: 0 ;RESTORE P FROM HERE AT ASSEM1. SAVED OVER LITERAL. +ASMI: 0 ;REINIT I AT ASSEM2 FROM ASMI. +GLSPAS: 0 ;RESTORE GLSP1 AT ASSEM1. SAVED OVER LITERAL. +GLSP1: 0 ;POINTER TO BOT OF LINKAGE TABLE IN USE HIGH ADR +GLSP2: 0 ;POINTER TO TOP OF LINKAGE TABLE IN USE LOW ADR +FORMAT: 0 ;ACCUMULATES FORMAT WORD +FORPNR: 0 ;POINTER INTO FORMAT WORD, SHOULD BE FORMAT+1 SO CLOBBERABLE BY LAST IDPB +FLDCNT: 0 ;NUMBER OF FIELDS PUSHED DOWN IN CURRENT WORD +WRD: 0 ;ACCUMULATES VALUE OF WORD +WRDRLC: 0 ;RELOC OF WRD, MUST COME RIGHT AFTER WRD. +T1: 0 ;TEMP +T2: 0 ;TEMP +PBITS1: 0 ;CURRENT CODE BITS +PBITS2: 0 ;NO OF SPECS LEFT IN CURRENT WORD +PBITS4: 0 ;POINTER TO WHERE CURRENT CODE BITS WILL GO +OPT1: 0 ;POINTER FOR STORING IN BKBUF (OUTPUT BUFFER) +CONTRL: 0 ;FLAG REG FOR IO CONTROL ETC, .GE. 0 => RELOCATABLE/1PASS +CDATBC: 0 ;CURRENT DATA BLOCK CODE TYPE +SCKSUM: 0 ;CKSUM FOR SIMPLE BLOCK FORMAT +IFN A1PSW,[ +PRGC: -1 ;ONE LESS THAN # TIMES END HAS BEEN ENCOUNTERED +OUTN1: -1 ;.GE. 0 => OUTPUT HAS OCCURED IN OTHER THAN 1PASS MODE (NOT INITIALIZED) +OUTC: -1 ;.GE. 0 => OUTPUT HAS OCCURED DURING CURRENT ASSEMBLY +] +LINKL: 0 ;SAVE LIMIT OF GLOTB GETWRD +STRCNT: 0 ;COUNT OF CHARS READ (INCL. DELIM) BY GSYL +STRPNT: 0 ;TEMP AT GSYL, BYTE POINTER TO STRING STORAGE +ISYMF: -1 ;-1 IF ISYMS HAVE NOT BEEN SPREAD +SMSRTF: -1 ;-1 BEFORE SYMTAB IS COMPACTED AND SORTED. + ;AFTER COMPACTING, HOLDS NUMBER OF SYMS THAT WERE THERE BEFORE COMPACTING. +BITP: 0 ;BYTE PNTR TO CODE BITS IN CURRENT (RELOC) BLOCK +LDCCC: 0 ;DEPTH IN LOADTIME CONDS +PARBIT: 0 ;0 OR 4 FOR : OR = (IN GENERAL, TEMP AT P7X) +LABELF: 0 ;-1 IN COLON, SOMETIMES IN EQUAL. CAUSES 3LABEL TO BE SET. +STGSW: 0 ;NON ZERO GIVES ERROR PRINT ON STORAGE WORDS +HKALL: 0 ;NONZERO => HALF-KILL ALL LABELS (.HKALL'S VALUE) +LITSW: 0 ;-1 => USING A LITERAL GIVES AN ERROR +QMTCH: 0 ;-1 => ' AND " NEED MATCHING CLOSINGS (A LA FAIL, MACRO-10) +STARTA: 0 ;STARTING ADDRESS FOR SBLK, RIM, DECSAV +DECSYA: 0 ; ADDRESS TO LOAD SYMBOLS AT (FOR DECSAV FORMAT) +DECBRK: 0 ;LARGEST RELOC. ADDR. LOADED INTO. (USED FOR DEC FMT) +DECBRA: 0 ;LARGEST ABS. ADDR LOADED INTO. +DECBRH: 0 ;LIKE DECBRK BUT FOR ADDRS IN HI SEG. +DECTWO: MOVE ;NOT = MOVE => .DECTWO WAS DONE, AND THIS WD HAS + ;ADDR START OF HISEG. +ISAV: 0 ;I FROM FIELD AT AGETFLD +A.PASS: 0 ; .PASS INTSYM, # OF THIS PASS. +A.PPAS: 0 ;.PPASS INTSYM, # OF PASSES. +WPSTE: NRMWPS ;# WORDS PER SYMTAB ENTRY +WPSTE1: NRMWPS-1;ONE LESS THAN WPSTE - FOR SPEED. +WPSTEB: ,-NRMWPS(B) ;RH HAS - # WORDS PER SYMTAB ENTRY; LH HAS INDEX OF B. +SYMSIZ: 0 ;#WDS IN SYMTAB = WPS* +SYMLEN: SYMMSZ ;SYMTAB SIZE (# SYMS) + ;ASSEMBLED-IN VALUE USED AS DEFAULT, ONLY IF NON-TS. +SYMAOB: 0 ;-<# SYMS>,,0 +INICLB: 0 ;-1 IF INITIALIZATION CODE CLOBBERED. +TTYINS: 0 ;AT START OF ASSEMBLY, -1 => .INSRT TTY PASS1, -2 => PASS2 ALSO. +IFN FASLP,[ +FASBP: 0 ;PNTR TO FASL OUTPUT BUFFER +FASATP: 0 ;PNTR TO FASL ATOM TABLE +FASAT1: 0 ;PNTR TO FASL ATOM TABLE AFTER READING IN NEW ATOM + ; (MAYBE UPDATE FASATP TO THIS IF ATOM WAS UNIQUE9 +FASAT2: 0 ;BYTE PNTR USED TO STORE ATOM IN +FASIDX: 0 ;INDEX NEXT ATOM LOADED INTO FASAT WILL BE +FASPCH: 0 ;AMOUNT OF FASAT "PUNCHED" +FASCBP: 440400,,FASB ;BYTE PNTR TO FASL CODE BIT WORD +FASPWB: 0 ;FASL CODE AT PWRD +FASBLC: 0 ;LOSING BLOCK "COUNT" +FASBLS: 0 ;LOSING BLOCK "SYMBOL" +AFRLD: 0 ;LIST READ CURRENT DEPTH +AFRLEN: 0 ;LIST READ CURRENT LENGTH +AFRDTF: 0 ;LIST READ DOT CONTEXT FLAG (0 NORMAL, 1 SAW DOT, 2 SAW "FROB AFTER DOT" +AFRFTP: 0 ;LIST READ SAVED STATE OF FASATP +AFLTYP: 0 ;TYPE LIST OP IN- 0 EVAL AND THROW AWAY VALUE + ;1 "RETURN" LIST + ;2 "RETURN" VALUE OF LIST +] +PBLK + +;INFO CONVENIENT TO ANYONE GENERATING AN OUT OF TIME-SHARING MIDAS + +;MIDAS OUT OF TIME-SHARING ASSEMBLES INTO A COLLECTION OF SUBROUTINES +;IO IS EXPECTED TO BE HANDLED BY OTHER PROGRAMS. + +;EXITS FROM THE ASSEMBLER: +;TPPB OUTPUT BINARY WORD IN A +;TFEED IF OUTPUT DEVICE IS PTP, PUNCH OUT # FRAMES OF BLANK TAPE + ;SPECIFIED BY B, MAY CLOBBER A AND B +;GO9 RETURN POINT FROM FATAL ERRORS +;TYO TYPE OUT CHARACTER IN A +;TAB TYPE OUT A TAB (MAY CLOBBER A OF COURSE) +;RCHTBL SEE THE RCH ROUTINES + +;ENTRIES + +;PDL, LPDL MAY BE USED BY COMMAND PROCESSOR BUT WILL BE CLOBBERED BY MAIN ROUTINES +;MAIN ROUTINES, CALLED WITH JSP A, , CLOBBER THE WHOLE WORLD (INCLUDING P) +;INIT INITIALIZE +;PS1 PASS 1 +;PLOD IF APPROPRIATE, PUNCH OUT LOADER +;PS2 PASS 2 (DOES ITS OWN PARTIAL INITIALIZATION) +;PSYMS PUNCH OUT SYMBOL TABLE + +;OTHER ENTRIES + +;CONTRL AFTER ASSEMBLY, .GE. 0 => RELOCATABLE, .LT. 0 => ABSOLUTE +;ISYMF -1 IF SYMS HAVE NOT BEEN SPREAD, ELSE DON'T TRY TO ADD TO INITIAL SYMBOL TABLE +;SMSRTF -1 IF SYMTAB HASN'T BEEN SORTED, ELSE SYMTAB CLOBBERED, DON'T RE-ASSEMBLE +;MIDVRS .FNAM2 OF MIDAS ENGLISH + +;SOME FF FLAGS ARE GLOBAL SO COMMAND PROCESSOR CAN KNOW WHAT'S HAPPENED ON RETURN + +;COMMAND PROCESSOR MAY ADD TO INITIAL SYMBOL TABLE BEFORE CALLING INIT THE FIRST TIME +;EISYMT IS THE FIRST LOCATION OK TO DUMP INTO +;EISYMP RH SHOULD BE SET BY COMMAND PROCESSOR TO FIRST LOC NOT DUMPED INTO +;INTSYM RH OF SYMTAB VALUE TO RETURN VALUE ADDRESSED BY LH(SYMTAB ENTRY) + +;RCH HAS AN ELABORATE SET OF GLOBALS, WHICH I DON'T FEEL LIKE PUTTING DOWN NOW, BUT THEY INCLUDE +;RCH (GET CHAR) SEMIC, RRL1, RREOF, SEMICR, SEMIC, TYPCTL, GDTAB, CPGN, CLNN, +;RCHMOD, MDSCLR, MDSSET, RCHSET, POPLMB, PSHLMB +;ALSO RCHTBL ONLY EXIT + +;LISTING FEATURE GLOBALS: +;PILPT PRINT CHAR IN A +;LISTON LISTING ON/OFF FLAG, -1 => ON +;LISTP SAME WORD AS LISTON. +;LISTP1 POSITIVE => LIST EVEN ON NON-PUNCHING PASS. +;LPTCLS END OF LISTING, PRINT FORM FEED, IF TS THEN CLOSE LPT + +;CREF FEATURE GLOBALS: +;CRFOUT OUTPUT WORD IN A. +;CREFP -1 => REQUEST GENERATION OF CREF OUTPUT. +;THE RUBOUT-B-^W HEADER, THE SET-SOURCE-FILE BLOCK, AND THE EOF BLOCK +;ARE THE RESPONSIBILITY OF THE COMMAND PROCESSOR. + +;;RCH ;CHARACTER INPUT ROUTINES + +IFN RCHASW\MACSW,[ + ;SAVE LIMBO1 STATUS AND RH(B) + ;THEN SET UP FOR NEW INPUT MODE (DESCRIPTOR IN A) + ;CALLED BY PUSHEM AND PUSHTT + +PSHLMB: HRL B,LIMBO1 ;LAST CHARACTER INPUT + TLZE FF,FLUNRD ;RE-INPUT CHARACTER ON RETURN? + XCT LSTPLM ;SET B'S SIGN; IF LISTING, JRST PSHLML. +PSHLMN: EXCH A,RCHMOD ;GET OLD MODE IN A + DPB A,[360500,,B] ;STORE IN 5 OF HIGH 6 BITS IN B + PUSH F,B ;SAVE RESULTANT CRUD + CAMN A,RCHMOD ;COMPARE NEW WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + MOVE A,RCHMOD ;NOW GET NEW MODE + JRST PSHLM1 ;SET UP INSTRUCTIONS FOR NEW MODE + +IFN LISTSW,[ +;IF LISTING, LSTPLM HOLDS JRST PSHLML +PSHLML: AOSN PNTSW + JRST PSHLMM ;LAST WAS BREAK CHR + REPEAT 4,IBP PNTBP + SOSA PNTBP +PSHLMM: SETOM LISTBC + TLO B,400000 + JRST PSHLMN +] + + ;UNDO A PSHLMB (NOTE: IN COMMENTS BELOW, "NEW" MODE IS ON PDL, OLD IN RCHMOD) + +POPLMB: POP F,A ;GET WORD THAT PSHLMB PUSHED + HLRZS A ;JUST INTERESTED IN LEFT HALF + TRZE A,400000 ;SIGN BIT SET? + TLOA FF,FLUNRD ;YES, SET FLAG TO RE-INPUT LAST CHAR + TLZA FF,FLUNRD ;NO, CLEAR FLAG. + XCT POPLML ;JFCL\IDPB A,PNTBP ;THE LATTER IFF LISTING. + SETZM LIMBO1 ;INITIALIZE FOR DPB + DPB A,[700,,LIMBO1] ;RESTORE LIMBO1 + LSH A,-<18.-6> ;RIGHT JUSTIFY RCHMOD DESCRIPTOR + CAMN A,RCHMOD ;COMPARE NEW MODE WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + JRST RCHSET ;SET UP FOR NEW MODE AND RETURN +] + +FOO==0 ;INITIALIZE COUNTER FOR FOLLOWING + +DEFINE RCHBLT SIZE,ADR/ + MOVSI T,FOO(A) + HRRI T,ADR + BLT T,-1+ADR +FOO==FOO+ +TERMIN + +DEFINE RCHMOV ADR/ + MOVE T,FOO(A) + MOVEM T,ADR +FOO==FOO+1 +TERMIN + + ;SET UP FOR INPUT OF MODE TYPE SPECIFIED IN A, CLOBBER A ONLY + +RCHSET: MOVEM A,RCHMOD ;STORE NEW RCHMOD +PSHLM1: TLZ FF,FLMAC\FLTTY ;CLEAR FLAGS (MAYBE DEVICE ROUTINE SETS ONE) + XCT RCHTBL(A) ;GET IN A A POINTER TO A DESCRIPTOR TABLE (MAYBE ALSO SET FLAG) + PUSH P,T ;SAVE T, NEED IT FOR TEMP + RCHBLT 3,RCH2 ;FIRST 3 WORDS RCH2 + TLNE FF,FLVOT + JRST POPTJ ;ALL RCH'S TO GO THROUGH RCH, DON'T DO ANYTHING ELSE +MDSST1: RCHBLT 3,RR1 ;NEXT 3 RR1 + RCHMOV RRL1 ;NEXT WORD RRL1 +RCHPSN==FOO ;# WORDS IN ALL TABLES BUT LAST (NOT OF CONSTANT LENGTH) + RCHBLT 6,SEMIC ;LAST N SEMIC +POPTJ: POP P,T + POPJ P, + +IFN LISTSW,[ + ;SET UP TO "DISPLAY" (ALL RCH'S THROUGH RCH) + +MDSSET: TLO FF,FLVOT ;SET FLAG + MOVEI A,MDSSTB-3 ;SET UP AC + PUSH P,T ;SAVE T FOR RESTORATION + JRST MDSST1 ;NOW SET UP + +MDSSTB: JRST RRL1 ;RR1 + HALT + PUSHJ P,RCH ;RREOF + + PUSHJ P,RCH ;RRL1 +IFN .--RCHPSN,.ERR LOSSAGE AT MDSSTB. + PUSHJ P,RCH ;SEMIC + CAIE A,15 + JRST SEMIC + JRST SEMICR + + ;CLEAR OUT DISPLAY MODE + +MDSCLR: TLZ FF,FLVOT ;CLEAR FLAG + MOVE A,RCHMOD + JRST RCHSET ;NOW SET UP FOR REAL IN CURRENT MODE +] ;END IFN LISTSW, + +IFN TS,[ ;TABLE FOR RCHSET, INDEXED BY MODE + ;MAYBE THIS CONDITIONAL WANTS TO BE CHANGED TO SOMETHING ELSE + +RCHTBL: MOVEI A,RCHFIL ;0 => INPUT FROM FILE +IFN MACSW,PUSHJ P,RCHMAC ;1 => INPUT FROM MACRO (DO NOT CHANGE, USED BY MACRO PROCESSOR) +IFN RCHASW,[IFE MACSW,HALT + PUSHJ P,RCHTRC ;2 => TTY, QUIT ON CR + PUSHJ P,RCHARC ;3 => TTY, DON'T QUIT ON CR +] + ;TABLE FOR INPUTTING FROM FILE + ;MAYBE THIS CONDITIONAL ALSO WANTS TO BE CHANGED + +RCHFIL: ILDB A,UREDP ;GETCHR, GET CHARACTER + CAIG A,14 ;SKIP IF TOO BIG TO BE SPECIAL + XCT RPATAB(A) ;SPECIAL, DO THE APPROPRIATE THING + + JRST RRL1 ;RR1 + HALT + PUSHJ P,[ MOVEI A,0 ;^C IN SYMBOL TREATED LIKE A ^@, + JRST INCHR3] ;BUT ALSO SEE IF REALLY END OF BUFFER. THIS GOES IN RREOF. + + ILDB A,UREDP ;RRL1 +IFN .-RCHPSN-RCHFIL,.ERR RCHFIL LOSES. + LDB CH1,[360600,,UREDP] ;SEMIC; FIND WHERE IN ITS WORD UREDP POINTS + IDIVI CH1,7 + JRST @SEMIC3(CH1) ;AND ENTER THE CR-SCANNING LOOP AT THE APPROPRIATE + JFCL ;PLACE (IT IS A WORD-BY-WORD LOOP). + +;TABLE FOR ABOVE, EXECUTED INDEXED BY CHAR, 15 ONLY FROM SEMIC ELSE ANYTHING +;NOTE: MANY OF THESE ROUTINES SUBTRACT 3 FROM THE PC BEFORE RETURNING. +;THE CALLER MUST MAKE SURE THAT THE ILDB UREDP IS WHAT THEY RETURN TO THAT WAY. + +RPATAB: +IFN ITSSW, JFCL ;0, ON I.T.S. IS NORMAL CHARACTER +.ELSE CALL RPANUL ;0, ON DEC SYSTEM, IGNORE IT. + JFCL + JFCL +IFN .-RPATAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH ENTRY IN RPATAB. + PUSHJ P,INCHR3 ;3, EOFCH + REPEAT 6,JFCL + CALL RPALF ;LINE FEED + JFCL ;13 + PUSHJ P,RPAFF ;FORM FEED + JRST SEMICR ;FROM SEMIC ONLY, EXIT FROM LOOP + +RPAFF: SKIPE ASMOUT ;FORM FEED + SKIPL TEXT4 ;ALLOW FORMFEED WITHIN GROUPING ONLY IF IN A TEXT PSEUDO. + CAIA + ETR [ASCIZ/Formfeed within <>, () or []/] + AOS CH1,CPGN + SETOM CLNN +IFN ITSSW,[ + ADD CH1,[SIXBIT /P0/+1] + MOVE CH2,A.PASS + DPB CH2,[300200,,CH1] + .SUSET [.SWHO3,,CH1] ;PUT THE NEW PAGE # IN THE WHO-LINE. +] +RPALF: AOS CH2,CLNN + CAME CH2,A.STPLN + RET + MOVE CH1,CPGN + CAMN CH1,A.STPPG + SETOM TTYBRF + RET + +IFN DECSW\TNXSW,[ +RPANUL: MOVE CH1,@UREDP ;SAW A NULL - IN A LINE NUMBER? + TRNN CH1,1 + JRST RCHTRA ;NO, JUST IGNORE IT. + MOVEI CH1,010700 + HRLM CH1,UREDP ;YES, SKIP THIS WHOLE WORD, THEN + CALL RCH ;SKIP THE 1ST CHAR AFTER THE LINE NUMBER + JRST RCHTRA ;RETURN THE NEXT CHAR FROM THIS CALL TO RCH. +] +] ;END IFN TS, + +VBLK +LIMBO1: 0 ;LAST CHARACTER READ BY RCH +RCHMOD: 0 ;CURRENT INPUT MODE, 0 => INPUT FROM FILE, 1 => MACRO, ETC. +CLNN: 0 ;1 LESS THAN LINE # IN CURRENT INPUT FILE. +CPGN: 0 ;1 LESS THAN PAGE # IN CURRENT INPUT FILE +A.STPL: 0 ;1 LESS THAN LINE # TO STOP AT. +A.STPP: 0 ;1 LESS THAN PAGE # TO STOP AT. + ;(STOPPING MEANS INSERTING THE TTY) + +;READ CHARACTER INTO A FROM INPUT FILE, MACRO, OR WHATEVER (RCH) +;CLOBBERS A,CH1,CH2. + +RCH: TLZE FF,FLUNRD + JRST RCH1 ;RE-INPUT LAST ONE +RCH2: HALT ;ILDB A,UREDP ;ILDB A,CPTR ;GET CHAR + 0 ;CAIG A,14 ;TRZE A,200 ;CHECK FOR SPECIAL + 0 ;XCT RPATAB(A) ;PUSHJ P,MACTRM ;SPECIAL, PROCESS + MOVEM A,LIMBO1 ;GOT CHAR, SAVE AS LAST CHAR GOTTEN +IFE TS,RCHLS1==JRST TYPCTL +IFN TS,RCHLS1==RET ;DEFAULT CONTENTS OF RCHLST (IF NOT LISTING) +RCHLST: RCHLS1 ;AOSN PNTSW IF LISTING. +IFN LISTSW,[ + PUSHJ P,PNTR + CAIG A,15 + JRST RCHL1 +RCHL3: IDPB A,PNTBP +TYPCTL: POPJ P, ;OR JRST SOMEWHERE +PBLK + +RCHL1: CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + JRST RCHL3 +RCHL2: MOVEM A,LISTBC + SETOM PNTSW + JRST TYPCTL + +VBLK +RCH1: MOVE A,LIMBO1 +RCH1LS: RET ;OR CAILE A,15 IF LISTING. + RET ;NEEDED IN CASE LISTING. + CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + POPJ P, + JRST RCHL2 +PBLK +] ;END IFN LISTSW, + +IFE LISTSW,[ +PBLK +RCH1: MOVE A,LIMBO1 + RET +] ;END IFE LISTSW, + +;;GETSYL ;VARIOUS SYLLABLE READING ROUTINES (BUT NOT ALL OF THEM) + +GSYL: CLEARB SYM,STRCNT +GSYL1: MOVEI D,6 + MOVE T,[440700,,STRSTO] + MOVEM T,STRPNT +GSYL3: AOSG A,STRCNT + JRST (F) + PUSHJ P,RCH + IDPB A,STRPNT ;STORE CHAR IN STRING EVEN IF DELIMITER (MINIMUM STRCNT = 1) +A.GSY2: CAIN A,". + JRST GSYL1C + HLRZ CH1,GDTAB(A) + CAIN CH1,(JSP CH2,) + JRST GSYL1A ;NUMBER + PUSHJ P,GSYL1B ;RETURN ONLY ON SYL SEP + HRRZ A,GDTAB(A) + MOVE T,LIMBO1 +C%: POPJ P,"% + +GSYL1B: XCT GDTAB(A) ;POPJ FOR SYL SEPS + SUB P,[1,,1] +GSYL1D: SOJGE D,GSYL3 + AOJA D,GSYL3 + +GSYL1C: ADD SYM,%.SQ(D) + JRST GSYL1D + +GSYL1A: XCT NSQTB-60(A) + JRST GSYL1D + + ;VERSION OF GETSYL TO TRY UNTIL SYL OR WORD TERMINATOR FOUND + ;SKIPS IF NAME THERE (FOR .TYPE, SQUOZE) + +GTSLD2: TLNN C,DWRD\DFLD + JRST GTSLD3 ;DELIMITER IS WORD TERMINATOR, TOLERATE THE NULL SYLLABLE +GETSLD: PUSHJ P,GETSYL ;ENTRY, GET A SYL + MOVE C,CDISP ;GET CDISP + TRNN I,IRSYL + JRST GTSLD2 ;NO SYL + AOS (P) ;GOT SYL, CAUSE RETURN TO SKIP +GTSLD3: TLNN C,DWRD\DFLD + TLO FF,FLUNRD ;CAUSE DELIMITER TO BE RE-INPUT + POPJ P, + +PASSPS: SKIPA A,LIMBO1 +GPASST: CALL RCH + CAIE A,40 + CAIN A,^I + JRST GPASST + RET + +GETSYL: TLZ I,ILUARI+ILNPRC+ILLSRT +GTSL1: CLEARB SYM,NUMTAB ;RECUR HERE FOR RIGHT ARG TO ^ AND _. + MOVE AA,[NUMTAB,,NUMTAB+1] + AOSN NTCLF + BLT AA,NUMTAB+10 ;NUMTAB NOT CLEAR, HAVE TO CLEAR IT + MOVEI D,6 ;CHARACTER COUNTER FOR BUILDING UP SYM + SETOM ESBK ;NO SPECIFIC BLOCK DESIRED. + TDZ I,[ILDECP+ILFLO+ILVAR+ILGLI,,IRPERI+IRLET+IRSYL] +RRL2: PUSHJ P,RR ;CALL MAIN LOOP ROUTINE, READ UNTIL NON-SQUOZE CHAR +SEMICR: ;RETURN HERE FROM SEMIC WITH CR IN A + MOVEM A,LIMBO1 ;SYLLABLE OPERATOR OR TERMINATOR IN A, SAVE + HRRZ A,GDTAB(A) ;NOW GET RIGHT HALF OF POPJ, INDEX INTO DTB + MOVE C,DTB-40(A) ;GET DTB ENTRY (FLAGS,,JUMP ADR) + MOVEM C,CDISP ;STORE AS DISPATCH CODE FOR LAST CHAR (SORT OF AN INTERPRETED LIMBO1) +RR8: TLNE C,DSYL ;NOW SEE IF SYL OPERATOR FLAG SET + JRST (C) ;SET => INTRA-SYLLABLE OPERATOR +RR10: TRNE I,IRLET ;NOT SET => SYLLABLE TERMINATOR: SYL? + POPJ P, ;SYL HAS LETTERS + TRNN I,IRSYL + JRST CABPOP ;NO SYL + CAMN SYM,[SQUOZE 0,.] + JRST PT1 ;SYM IS . + ;NUMBER + +RR5: TLNN I,ILNPRC + PUSHJ P,NUMSL + TLNN I,ILFLO + JRST RR9 ;NOT FLOATING POINT + MOVE A,B ;FLOATING, HIGH IN AA,LOW IN A,EXP IN B + ADDI A,306 ;201+105 TO ROUND + ADDI AA,200 ;CAUSE EXPONENT TO BE ACCEPTABLE TO MACHINE + JUMPGE AA,.+3 ;NOW CHECK FOR OVERFLOW ON ROUNDING + LSH AA,-1 ;OVERFLOW, SHIFT BACK ONE + AOS A ;INCREMENT EXPONENT TO COMPENSATE FOR SHIFT + EXCH A,AA ;GET EXPONENT IN AA, REST IN A + ASHC AA,-10 ;SHIFT TO MACHINE FLOATING POINT FORMAT + SKIPE AA ;NOW CHECK HIGH ORDER BITS OF EXPONENT NOT SHIFTED INTO NUMBER + ETR [ASCIZ /Exponent overflow/] +RR9: TLZ I,ILGLI+ILVAR ;NOT TRYING TO DEFINE NUMBER AS VARIABLE OR GLOBAL +CLBPOP: TDZA B,B ;CLEAR OUT B (RELOCATION BITS OF VALUE) +CABPOP: SETZB A,B ;DO JRST CABPOP TO RETURN ZERO AS VALUE + POPJ P, + +RRU: MOVE A,LIMBO1 ;GET HERE WHEN FLUNRD SET AT RR, RETRIEVE CHARACTER FROM LIMBO1 + CAIG A,14 ;IF TOO BIG, + CAIGE A,12 ;OR IF TOO SMALL, + JRST RR1B ;THEN JUST FALL BACK IN + TLNN FF,FLVOT\FLMAC\FLTTY ;SKIP IF NOT HACKING CPGN/CLNN + XCT RRUTAB-12(A) ;HACKING, UNHACK FOR HACK COMING UP + JRST RR1B ;FALL BACK IN + +RRUTAB: SOS CLNN ;LINE FEED (TABLE FOR RRU) + JRST RR1B ;13 + SOS CPGN ;FORM FEED + + ;MAIN LOOP ROUTINE FOR GETSYL, READ SYM OR NUMBER +VBLK +RR: TLZE FF,FLUNRD ;RE-INPUT LAST CHARACTER? + JRST RRU ;YES +RR1: JRST RRL1 ;ILDB A,CPTR ;GET CHAR (" " ") + HALT ;TRZE A,200 ;CHECK FOR END OF STRING +RREOF: PUSHJ P,RCH ;PUSHJ P,MACTRM ;PROCESS CONDITION, GET NEXT CHAR OR JRST RR1 OR RRU + .SEE RCHTRA ;SPECIAL HANDLING OF UNRCHF IN RCHTRA IF CALLED FROM HERE. +RR1B: XCT GDTAB(A) ;GOT CHAR, DO SOMETHING APPROPRIATE (POPJ ON NOT SQUOZE) + TROA I,IRLET\IRSYL ;LETTERS RETURN, JUST UPDATED SYM, SET FLAGS + TRO I,IRSYL ;NUMBERS RETURN, SET FEWER FLAGS + SOJGE D,RR1 ;DECREMENT SYM COUNTER AND LOOP + AOJA D,RR1 ;COUNTER EXHAUSTED, INCREMENT BACK TO 0 AND LOOP + +RRL1: PUSHJ P,RCH ;ILDB A,UREDP ;GET CHAR + XCT GDTAB(A) ;NOW MAKE LIKE RR1B (EOFCH => JRST RREOF) + TROA I,IRLET\IRSYL + TRO I,IRSYL + SOJGE D,RRL1 + AOJA D,RRL1 + + ;SEMICOLON (GET HERE FROM RR8) + + JRST SEMICL ;RETURN HERE FROM SEMIC+2 WHEN FLUNRD SET +;NEXT 4 INSNS ALTERED IN DIFFERENT INPUT MODES. SEE RCHFIL, ETC. +SEMIC: PUSHJ P,RCH ;GET CHAR + CAIE A,15 ;SEE IF SPECIAL + JRST SEMIC ;SPECIAL => DO SOMETHING (JRST SEMICR ON CR) + JRST SEMICR ;IF NOT SPECIAL THEN GO BACK FOR NEXT CHAR + +LOC SEMIC+6 ;LEAVE A LITTLE EXTRA ROOM FOR BIG ROUTINES +PBLK + +SEMICL: MOVE A,LIMBO1 ;HERE FROM SEMIC-1, RETRIEVE CHARACTER FROM LIMBO1 + CAIE A,15 ;SKIP IF SHOULD TERMINATE SCAN + JRST SEMIC ;NOT CR, FALL BACK IN + JRST SEMICR ;DONE + +SEMIC2: +REPEAT 5,[ + ILDB A,UREDP + CAIG A,15 + XCT RPATAB(A) +] + MOVE A,[ASCII /@@@@@/] +SEMIC1: AOS CH1,UREDP + MOVE CH1,(CH1) ;ANY CONTROL CHARS IN THE WORD UREDP POINTS AT? + MOVE CH2,CH1 + AND CH1,A + AND CH2,[ASCII/ /] + LSH CH2,1 + IOR CH1,CH2 + CAMN CH1,A + JRST SEMIC1 ;NO, ADVANCE TO NEXT WORD AND TEST IT. + MOVEI A,440700 + HRLM A,UREDP + JRST SEMIC2 ;YES, LOOK AT EACH CHAR AND PROCESS IT. + +SEMIC3: REPEAT 6,JRST SEMIC2+3*<5-.RPCNT> + +;JSP CH2,RR2 => DIGIT (FROM GDTAB) +;THIS ROUTINE IS GROSSLY SLOW, AND SHOULD BE SPEEDED UP SOMETIME + +RR2: XCT NSQTB-"0(A) ;UPDATE SQUOZE. + TRNE I,IRLET + JRST 1(CH2) ;SYL IS SYM, DON'T WASTE TIME. + TRNE I,IRPERI + TLO I,ILFLO ;DIGIT AFTER . => FLOATING. +MAKNUM: SETOM NTCLF ;NUMTAB ABOUT TO NOT BE CLEAR, SET FLAG FOR GETSYL TO CLEAR IT OUT NEXT TIME + MOVEI AA,2 ;INDEX INTO NUMTAB ETC., SOJGE'D TO GET ALL RADICES +MAKNM1: MOVE T,ARADIX(AA) ;GET THIS RADIX, + CAMN T,ARADIX ;REDUNDANT => SKIP THIS PASS. + JUMPN AA,MAKNM4 + SKIPGE CH1,HIGHPT(AA) + JRST MAKNM3 + MUL T,LOWPT(AA) ;TT HAS OLD LOW TIMES RADIX, T HAS OVFLO TO HIGH. + ADDI TT,-"0(A) ;ADD DIGIT TO LOW PART + TLZE TT,400000 + AOJ T, ;OVERFLOW, INCREMENT SPILLOVER FROM MUL OF LOWPT + JUMPE CH1,MAKNM5 ;OLG HIGHPT WAS 0 => SAVE TIME. + JFCL 17,.+1 ;NOW CLEAR OV, ETC. + IMUL CH1,ARADIX(AA) ;MULTIPLY HIGHPT BY RADIX + ADD T,CH1 ;ADD HIGH PARTS + JFCL 10,MAKNM2 ;JUMP ON OVERFLOW FROM IMUL OR ADD +MAKNM5: TLNE I,ILFLO + SOS NUMTAB(AA) ;FLOATING, DECREMENT EXP TO COMPENSATE FOR MULT OF HIGHPT/LOWPT + MOVEM T,HIGHPT(AA) ;NOW STORE STUFF BACK + MOVEM TT,LOWPT(AA) +MAKNM4: SOJGE AA,MAKNM1 ;NOW DO ALL THIS FOR NEXT RADIX + JRST 1(CH2) + +MAKNM2: MOVSI B,400000 ;OVERFLOW FROM UPDATING HIGH PARTS + IORM B,HIGHPT(AA) ;SET SIGN BIT +MAKNM3: TLNN I,ILFLO + AOS NUMTAB(AA) ;NOT FLOATING, INCREMENT EXP, MAY NOT WANT TRAILING BITS + JRST MAKNM4 + +VBLK +NUMTAB: 0 ;EXPONENT + 0 + 0 +HIGHPT: 0 ;HIGH PART OF CURRENT NUMBER THIS RADIX + 0 ;4.9 => OVERFLOW, TRAILING DIGITS DROPPED + 0 +LOWPT: 0 ;LOW PART OF CURRENT NUMBER THIS RADIX + 0 ;HIGHPT/LOWPT TAKEN AS 70. BIT POSITIVE INTEGER EXCEPT 4.9(HIGHPT) IS FLAG INSTEAD OF + 0 ;EXPONENTIATE 70. BIT INTEGER BY NUMTAB (WHICH MAY BE NEGATIVE) TO GET ACTUAL VALUE +ARADIX: 10 ;CURRENT RADIX + 12 + 10 + +NTCLF: -1 ;-1 => NUMTAB NOT CLEAR (TO SAVE BLT AT GETSYL WHEN CLEAR) +PBLK + +;JRST POINT => . (FROM GDTAB) + +POINT: TLO I,ILDECP ;PREFER DECIMAL + TROE I,IRPERI ;SET PERIOD FLAG + TRO I,IRLET ;2 POINTS => NAME + ADD SYM,%.SQ(D) ;UPDATE SYM + JRST 1(CH1) ;RETURN + +RBRAK: SOSL SCNDEP ;IF A CONDITIONAL TO TERMINATE, + JRST RBRAK2 ;HAVE DONE SO, IGNORE CHAR. + SETZM SCNDEP +;CLOSES OF ALL KINDS COME HERE. +RPARN: +GRTHN: MOVE A,LIMBO1 + SKIPE CH1,ASMOUT ;WHAT KIND OF OPEN ARE WE IN? + CAIN CH1,4 ;WITHIN A .ASCII OR + JRST RBRAK1 ;NOT WITHIN GROUPING => THIS CLOSE IS STRAY. + CAME A,ASMOT1(CH1) ;RIGHT KIND OF CLOSE FOR THAT OPEN? + ERJ RBRAK3 +RBRAK4: MOVE CH1,ASMOT2(CH1) + MOVEM CH1,ASMDSP ;ARRANGE FOR THIS ASSEM1 LEVEL TO EXIT +RBRAK5: SETZM CDISP + JRST RR10 ;AND GO TERMINATE WORD. + +RBRAK3: CALL TYOERR ;COME HERE ON CLOSE WRONG FOR OPEN. + ;(EG, ")" MATCHING "<"). + TYPR [ASCIZ/ Seen when /] + MOVE A,ASMOT1(CH1) + CALL TYOERR + TYPR [ASCIZ/ expected +/] + JRST RBRAK4 + +RBRAK1: CAIN CH1,4 ;CLOSE INSIDE A .ASCII => + JRST RBRAK5 ;TERMINATE WORD BUT DON'T CLOSE ANYTHING. + SKIPN CONSML ;COME HERE FOR STRAY CLOSE. + JRST RRL2 + ERJ .+1 + TYPR [ASCIZ/Stray /] + MOVE A,LIMBO1 ;GET THE CLOSE WE SAW. + CALL TYOERR + CALL CRRERR + JRST RRL2 + +;COME HERE FOR CLOSE-BRACE, AND CERTAIN CLOSE-BRACKETS. +RBRAK2: SETOM A.SUCC ;HAVE JUST ENDED SUCCESSFUL BRACKETED CONDIT, + JRST RRL2 ;REMEMBER THAT MOST RECENT CONDITIONAL WAS TRUE. + +FORMF: TLNN FF,FLVOT\FLMAC\FLTTY ;FORM FEED SYLLABLE OPERATOR ROUTINE + PUSHJ P,RPAFF ;UNLESS ALREADY DONE, INCREMENT PAGE #. + JRST RR10 + +LINEF: TLNN FF,FLVOT\FLMAC\FLTTY ;LINE FEED SYLLABLE OPERATOR ROUTINE + CALL RPALF + JRST RR10 + +CTLAT: +IFN DECSW\TNXSW,[ + TLNN FF,FLVOT\FLMAC\FLTTY ;^@ SYLLABLE OPERATOR ROUTINE. + CALL RPANUL +] + JRST RRL2 + +;DECIPHER A VALUE FROM NUMTABS +;LEAVES HIGH PART IN AA, LOW PART IN A, BINARY EXPONENT IN B +;AND RADIX USED IN D. + +NUMSL: TLNN I,ILVAR\ILDECP\ILFLO + SKIPE B,HIGHPT + JRST NUMSLS + MOVE A,LOWPT ;BE VERY FAST IN CASE OF SMALL FIXNUM IN CURRENT RADIX. + MOVE D,ARADIX ;SAVE RADIX AND HIGH PART FOR ^. + SETZ AA, + RET + +NUMSLS: CLEARB TT,D ;TT BIT EXPONENT, D INDEX INTO NUMTAB, ETC. + TLNE I,ILDECP+ILVAR ;NEITHER . NOR ', CURRENT RADIX. + TLNE I,ILGLI ;" => CURRENT RADIX DESPITE . OR '. + JRST NUMSL0 + MOVEI D,1 ;DECIMAL UNLESS ' + TLNE I,ILVAR ;WHICH FORCES OCTAL. + MOVEI D,2 + MOVE A,ARADIX(D) + CAMN A,ARADIX ;IF REALLY SAME AS CURRENT RADIX, + MOVEI D,0 ;COMPUTATION WASN'T DONE FOR THIS VALUE OF D, + ;SO USE COMPUTATIONS DONE FOR CURRENT RADIX. +NUMSL0: MOVE AA,HIGHPT(D) ;AA := HIGH PART + MOVE B,LOWPT(D) ;B := LOW PART + MOVE T,NUMTAB(D) ;T := EXPONENT + MOVE D,ARADIX(D) ;NO LONGER NEED IDX, GET RADIX VALUE. + TLNN I,ILFLO + JRST FIXNUM ;NOT FLOATING + TLZ AA,400000 ;FLOATING, DON'T NEED DIGITS LOST ON OVERFLOW +NUMC1: JUMPN AA,.+2 ;ENTRY FROM UPARR + JUMPE B,FIX0 ;COMPLETELY ZERO => RETURN FIXED ZERO + JUMPL T,NUMSL1 ;JUMP IF EXPONENT NEGATIVE + JUMPE T,NUMSL2 ;JUMP (SKIP FOLLOWING) IF EXPONENT ZERO + ;EXPONENT POSITIVE, DO THE APPROPRIATE THING +NUMSL5: MULI B,(D) ;MULITIPLY LOW PART BY RADIX + MULI AA,(D) ;MULTIPLY HIGH PART BY RADIX + ADD A,B ;A := LOW PART OF HIGH + HIGH PART OF LOW + TLZE A,400000 + ADDI AA,1 ;OVERFLOW ON ADDITION, INCREMENT HIGH PART OF HIGH + MOVE B,C ;NO LONGER NEED HIGH OF LOW, GET LOW OF LOW IN B +NUMSL3: JUMPE AA,NUMSL4 ;NOW CHECK FOR OVERFLOW INTO HIGH OF HIGH, JUMP ON NONE + ASHC A,-1 ;NEXT THREE INSTRUCTIONS TO DO ASH3 AA,-1 + ASH A,1 + ASHC AA,-1 + AOJA TT,NUMSL3 ;INCREMENT BIT EXPONENT AND TRY AGAIN + +NUMSL4: MOVE AA,A ;FLUSHED OVERFLOW, NOW GET (LOW PART OF) HIGH PART IN AA + SOJG T,NUMSL5 ;COUNT DOWN + +NUMSL2: TLNN I,ILFLO + JRST NUMSL9 ;NOT FLOATING, DON'T WASTE TIME NORMALIZING. + SKIPA A,B ;EXPONENT NOW ZERO, GET LOW PART OF NUMBER IN A +NUMSL7: ASHC AA,1 ;NOW NORMALIZE + TLNN AA,200000 + SOJA TT,NUMSL7 + SKIPA B,TT ;DONE NORMALIZING, RETURN BINARY EXPONENT IN B +PT1: TRO I,IRLET + POPJ P, + +NUMSL9: MOVE A,B + MOVEI B,0 + ASHC AA,(TT) ;SHIFT 2-WD NUM. BY EXPONENT, + LSH A,1 ;PUT HIGH BIT IN WITH REST. + JRST FIX1 + +FIX0: TLZ I,ILFLO +FIXNUM: LSHC A,45 +FIX1: LSHC AA,-1 + JUMPE AA,.+2 + ETR [ASCIZ /FIXNUM too big for 36 bits/] + POPJ P, + +NUMSL1: SKIPA A,B ;EXPONENT NEGATIVE: NORMALIZE NOW +NUMSL8: ASHC AA,1 +NUMSL6: TLNN AA,200000 + SOJA TT,NUMSL8 ;NOT NORMALIZED YET + AOS T + MOVEI TM,(D) + TLNN TM,-1 ;GET CONVIENT POWER OF RADIX + JUMPL T,[ IMULI TM,(D) + AOJA T,.-1] + MOVE B,A ;GET NORMALIZED LOW PART IN B + IDIV AA,TM ;DIVIDE HIGH PART BY APPROPRIATE RADIX + DIV A,TM + JUMPL T,NUMSL6 + MOVE B,A + JRST NUMSL2 + +UPARR: TRON I,IRSYL + JRST UPCTRC ;"UNARY UPARROW" => GOBBLE CHARS + TRNE I,IRLET + ETR [ASCIZ /Symbolic 1st arg to "^"/] + PUSHJ P,NUMSL ;DECIPHER NUMTABS + PUSHJ P,UA3 ;GET RIGHT OPERAND IN T + MOVE TT,B ;EXPONENT + MOVE B,A ;LOW PART + PUSHJ P,NUMC1 ;T EXP HIGH IN AA LOW IN B TT BIN EXP + MOVE C,CDISP ;IF A _ WAS DEFERRED WHILE ILUARI WAS SET, + TLO I,ILNPRC + CAME C,[DSYL,,BAKAR] ;DO IT NOW. + JRST RR10 + +BAKAR: TLNE I,ILUARI + JRST RR5 ;RETURN TO UPARROW (WILL COME BACK HERE LATER) + TRNE I,IRSYL + TRNE I,IRLET + JRST BAK1 ;NO SYL, OR SYL IS NAME + CAMN SYM,[SQUOZE 0,.] + JRST BAK1 ;. ALSO NAME + TLZN I,ILNPRC + PUSHJ P,NUMSL + PUSHJ P,UA3 + ADD B,T + ASHC AA,(B) + LSH A,1 + LSHC AA,-1 + CLEARB B,AA + TLZ I,ILFLO + MOVE C,[DFLD,,CBAKAR] + EXCH C,CDISP ;IF 2ND ARG ENDED WITH A _, TURN INTO FIELD OP. + CAME C,[DSYL,,BAKAR] + EXCH C,CDISP + POPJ P, + +UPCTRC: SETZ T, +UPCTR1: JSP F,QOTCOM ;UP ARROW TO GOBBLE SYL AND RETURN MASKED ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + CAIL A,140 + SUBI A,40 + ANDI A,77 ;NOW MASK CHARACTER IN TO TO BOTTOM 6 BITS + ADD T,A ;ADD TO ACCUMULATED + POPJ P, + +BAK1: MOVE TT,[DFLD,,CBAKAR] + MOVEM TT,CDISP + JRST RR10 + +UA3: HRLM D,(P) ;SAVE RADIX (FOR UPARR) + JSP LINK,SGTSY ;PUSH I,AA,A,B + TLO I,ILUARI ;TELL _ TO WAIT TILL LATER (SEE UPARR, BAKARR) + PUSHJ P,RCH + CAIN A,"- + TROA I,IRGMNS + TLO FF,FLUNRD + PUSHJ P,RCH + CAIN A,"< + JRST UAR1 + TLO FF,FLUNRD +UA3L: PUSHJ P,GTSL1 ;GOBBLE SYL, LOOP POINT FOR PSEUDO OR MACRO RETURNED WITHOUT VALUE + TRNE I,IRLET + JRST UA3S ;NAME + TLNE I,ILFLO + ETR [ASCIZ /Floating point 2nd arg to "_"/] +UAR2: TRZN I,IRGMNS + SKIPA T,A + MOVN T,A + JSP LINK,SGTSY1 ;RESTORE GETSYL TEMPS. + HLRZ D,(P) + POPJ P, + +UA3S: PUSHJ P,GETVAL ;MAKE NUMBER_NAME WORK + JRST UA3SR ;GOT VALUE, PROCESS + JRST UA3L ;NO VALUE, TRY AGAIN + +UAR1: TLO I,ILLSRT + TRZ I,IRSYL ;(OR ELSE LSSTH GIVES NOS ERROR.) + SETZB A,B + PUSHJ P,LSSTH +UA3SR: JUMPN B,RLCERR ;RELOC ERR + JRST UAR2 + +ATSGN: MOVSI A,20 ;ATSIGN + IORM A,WRD + TRO I,IRFLD ;SET IRFLD FLAG EVEN THOUGH NOT DIRECTLY RETURNING VALUE + ; ^ CHANGED FROM SYL TO FIELD 9/6/70 + JRST RRL2 ;FALL BACK IN + +DQUOTE: TRON I,IRSYL + JRST DQUOT8 + TRNN I,IRLET ;AFTER NUMBER => CURRENT RADIX. + JRST DQUOT7 + PUSHJ P,RCH + TLO FF,FLUNRD ;NEXT CHAR. SQUOZE? + HLRZ A,GDTAB(A) + CAIN A,(POPJ P,) + JRST DQUOT7 ;NO => MAKE PREV. SYM. GLOBAL. + CAMN SYM,[SQUOZE 0,.M] ;SPECIAL BLOCK NAMES + JRST DQUOTM ;.M MEANS MAIN BLOCK, + CAMN SYM,[SQUOZE 0,.U] + JRST DQUOTU ;.U MEANS SUPERIOR. + CAMN SYM,[SQUOZE 0,.C] + JRST DQUOTC ;.C MEANS CURRENT BLOCK. + SKIPGE A,ESBK ;GET SPEC'D BLOCK OR CURRENT, + HRR A,BKCUR ;LOOK FOR SUBBLOCK OF THAT BLOCK. + HLL A,BKTAB+1(A) + ADD A,[1,,] ;LH HAS LEVEL SUBBLOCK OUGHT TO HAVE. + MOVEI T,0 + SETO D, ;NO POSSIBLE ALTERNATE CHOICE YET. +DQUOT0: CAME SYM,BKTAB(T) ;LOOK AT ALL BLOCKS SEEN. + JRST DQUOT1 ;HAS THE NAME WE'RE LOOKING FOR? + SKIPGE ESBK ;IF LOOKING FOR A SUBBLOCK OF A PARTICULAR BLOCK, + JRST DQUOT4 + CAMN A,BKTAB+1(T) + JRST DQUOT2 ;SUCH A BLOCK WINS; ALL OTHERS LOSE. + JRST DQUOT1 + +DQUOT4: SKIPN BKTAB+2(T) ;ELSE PREFER DEFINED BLOCKS TO UNDEFINED ONES. + JUMPGE D,DQUOT1 + SKIPE BKTAB+2(T) + JUMPL D,DQUOT5 + CAME D,[-1] ;THAT'S THE SAME EITHER WAY => PREFER AN INFERIOR + CAMN A,BKTAB+1(T) ;OF THE CURRENT BLOCK TO ONE THAT'S NOT. + JRST DQUOT5 + JRST DQUOT1 + +DQUOT5: HRROI D,(T) ;FOUND A BLOCK WE LIKE BEST SO FAR. + SKIPE BKTAB+2(T) + ANDI D,-1 ;LEAVE SIGN OF D SET UNLESS THE BLOCK IS DEFINED. +DQUOT1: ADDI T,BKWPB + CAMGE T,BKTABP + JRST DQUOT0 + HRRZI T,(D) ;NOW USE THE BEST BLOCK FOUND, IF THERE WAS ONE. + CAIE T,-1 + JRST DQUOT2 + MOVE T,BKTABP ;NOT FOUND, GET IDX OF 1ST UNUSED ENTRY. + CAIL T,BKTABS + ETF ERRTMB ;NO ROOM FOR MORE BLOCKS. + MOVEM SYM,BKTAB(T) + MOVEM A,BKTAB+1(T) ;ADD BLOCK AT END. + MOVEI A,BKWPB(T) + MOVEM A,BKTABP ;POINTS AFTER LAST USED ENTRY. +DQUOT2: MOVEM T,ESBK + SETZ SYM, +DQUOT3: MOVEI D,6 ;NEXT CHAR GOES IN 1ST SQUOZE POS. + JRST RRL2 + +DQUOTM: MOVEI T,BKWPB ;.M - MAIN BLOCK FOLLOWS INITIAL SYMS BLOCK. + JRST DQUOT2 + +DQUOTU: SKIPGE T,ESBK ;.U SPEC'D - GET SPEC'D OR CURRENT BLOCK, + MOVE T,BKCUR + HRRZ T,BKTAB+1(T) + JRST DQUOT2 ;SPEC. ITS SUPERIOR. + +DQUOTC: SKIPGE T,ESBK ;.C => SPEC THE CURRENT BLOCK. + MOVE T,BKCUR + JRST DQUOT2 + +SQUOT1: TLOA I,ILVAR +DQUOT7: TLO I,ILGLI + MOVE A,BKCUR ;IF NO SPEC'D BLOCK, + SKIPGE ESBK + MOVEM A,ESBK ;SPEC. CURRENT BLOCK. + JRST RRL2 + +DQUOT8: SETZ T, +DQUOT9: JSP F,QOTCON ;DOUBLE QUOTE TO GOBBLE SYL AND RETURN ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + ADD T,A ;ADD IN ASCII CHARACTER IN A + POPJ P, ;RETURN TO SOMETHING + +SQUOTE: TROE I,IRSYL + JRST SQUOT1 + SETZ T, +SQUOT9: JSP F,QOTCON ;SIXBIT SYL + CAIGE A,40 + ETR ERRN6B ;NOT SIXBIT + CAIL A,140 + SUBI A,40 ;CONVERT TO UPPER CASE + LSH T,6 ;SHIFT OVER ACCUMULATED VALUE + ADDI T,-40(A) ;ADD IN SIXBIT FOR CHARACTER IN A + POPJ P, + +;COMMON ROUTINE FOR RIGHT JUSTIFIED TEXT SYLS +;CALLED WITH JSP F,; ROUTINE PUSHJ'S BACK W/ CHAR IN T, ACCUM VALUE IN A +;SYL FLAG EXPECTED TO BE ALREADY SET +QOTCON: SKIPE QMTCH ;' AND " COME HERE, BUT NOT ^: IF IN QUOTES-MATCHING MODE, USE A + JRST QOTCO4 ;FAIL-LIKE ALGORITHM. HERE FOLLOWS THE OLD MIDAS WAY OF DOING IT +QOTCOM: CALL RCH ;USE AT LEAST 1 CHAR IN ANY CASE. + JRST QOTCO1 + +QOTCO2: CALL RCH ;USE SUCCEEDING CHARS IF SQUOZE CHARS. + HLRZ CH1,GDTAB(A) + CAIN CH1,(POPJ P,) + JRST QOTCO3 +QOTCO1: CALL (F) + JRST QOTCO2 + +QOTCO3: CAIN A,"" ;NONSQUOZE: IF IT IS A TEXT SYL INDICATOR, + JRST DQUOT9 ;CONTINUE WITH WHATEVER TYPE OF TEXT + CAIN A,"' + JRST SQUOT9 ;IT INDICATES. + CAIN A,"^ + JRST UPCTR1 +QOTCO6: TLO FF,FLUNRD + JRST TEXT5 + +QOTCO4: MOVE B,LIMBO1 ;GET ' OR ", WHICHEVER STARTED THIS SYL, AS THE DELIMITER. + MOVE SYM,[SQUOZE 0,TEXT] + JSP TM,ERMARK +QOTCO5: CALL RCH + CAMN A,B ;FOUND ANOTHER EXAMPLE OF THE DELIMITER? + JRST [ CALL RCH ;IF DUPLICATED, IT PUTS THE DELIMITER IN THE CONSTANT. + CAMN A,B + JRST .+1 + JRST QOTCO6] ;OTHERWISE UNREAD THE CHAR AFTER THE DELIMITER AND EXIT. + CALL (F) ;HAVE CHAR TO PUT IN STRING IN A; GO MERGE IT IN. + JRST QOTCO5 + +;RETURN A VALUE FROM A PSEUDO WHOSE ARGS CAN BE TERMINATED BY EITHER COMMA (GOBBLED) +;OR CR (NOT GOBBLED). +VALRET: MOVE T,A ;ROUTINE TO RETURN VALUE IN A AFTER LAST CHAR GOBBLED BY GETSYL + MOVE B,CDISP ;GET STORED DISPATCH CODE + TLNN B,DWRD\DFLD + JRST VALR1 ;WORD TERMINATOR +;COME HERE TO RETURN A VALUE, AND ALSO +;BARF IF THE NEXT CHARACTER ISN'T A SYLLABLE SEPARATOR +TEXT5: PUSH P,T ;ENTRY FROM TEXT ROUTINES (NLAST CHAR NOT GOBBLED BY GETSYL) TO RETURN VALUE IN T + PUSHJ P,GETSYL ;SEE IF IMMEDIATELY FOLLOWED BY SYL + TRNE I,IRSYL + ETR ERRNOS ;NO SEPARATOR BETWEEN TWO VALUES + POP P,A ;RESTORE VALUE TO RETURN +VALR1: TRO I,IRSYL + JRST CLBPOP + +;VARIOUS PUSH AND POP ROUTINES, ALL CALLED W/ JSP LINK, + +SGTSY: PUSH P,I + PUSH P,AA + PUSH P,A + PUSH P,B + JRST (LINK) + +SGTSY1: POP P,B + POP P,A + POP P,AA + POP P,I + JRST (LINK) + +;JSP LINK,SAVWD1 TO SAVE STUFF FOR < OR (, ETC. + +SAVWD1: PUSH P,A ;SYLL. BEFORE GROUPING NOW STARTING. + PUSH P,B ;AND ITS RELOC. + +SAVWLD: PUSH P,FORMAT + PUSH P,FORPNR + PUSH P,FLDCNT + PUSH P,GLSP2 + PUSH P,I + PUSH P,WRD + PUSH P,WRDRLC + PUSH P,SYM + PUSH P,PPRIME + PUSHJ P,(LINK) +SAVL1==. + +;POP OFF WHAT PUSHED BY SAVWLD. CLEARS FLUNRD, IN CASE THE > OR ) WAS UN-READ. + +USVWLD: POP P,SYM + HRRZS SYM + CAIE SYM,SAVL1 + HALT + TLZ FF,FLUNRD + POP P,PPRIME + POP P,SYM + POP P,WRDRLC + POP P,WRD + TDZ I,[-1-(ILWORD)] + IOR I,(P) + POP P,1(P) + POP P,GLSP2 + POP P,FLDCNT + POP P,FORPNR + POP P,FORMAT + JRST (LINK) + +;;GETFD ;GET FIELD (EXPRESSION); RETURN VALUE IN A, RELOC BITS IN B + + ;GET FIELD FOR PSEUDO + ;SYM SHOULD CONTAIN THE SQUOZE NAME OF THE PSEUDO + ;OR A POINTER TO AN INSN TO EXECUTE WHEN UNDEF + ;SYMBOL SEEN. SYM IS NOT CLOBBERED. + +AGETFD: PUSH P,I ;SAVE I + TRO I,IRPSUD+IRNOEQ ;SET FLAG TO GETVAL TO EXECUTE GTVER ON UNDEFINED SYM ON EITHER PASS + PUSH P,GTVER ;OLD VALUE OF GTVER + MOVEM SYM,GTVER ;ERROR MSG SHOULD GIVE NAME OF PSEUDO. + CALL YGETFD + MOVE SYM,GTVER + REST GTVER + MOVEM I,ISAV ;SAVE FLAGS FOR FIELD GOTTEN +POPIJ: POP P,I + POPJ P, + +;READ A FIELD, NOT PART OF THE CURRENT WORD. +YGETFD: PUSH P,WRD + SETZM WRD + CALL XGETFD + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + ADD A,WRD ;ADD IN INDEX, INDIRECT FIELDS + POP P,WRD + POPJ P, + +IFN FASLP,[ +FAGTFD: PUSHJ P,AGETFD ;DO AGETFD, COMPLAIN IF RELOCATABLE OR GLOBAL + MOVE TM,GLSP1 + CAMN TM,GLSP2 + SKIPE B + ETSM [ASCIZ /relocatable or external argument/] + POPJ P, +] +;READ A FIELD PART OF CURRENT WORD (FOR XWD, ETC). +XGETFD: PUSH P,PPRIME +AGTFD3: PUSHJ P,GETFLD + MOVE CH1,CDISP + TLNN CH1,DWRD + TLOA FF,FLUNRD ;DELIMITER IS WORD TERMINATOR => RE-READ IT. + TRNE I,IRFLD ;NON-NULL FIELD SUPPLIED => RETURN IT. + JRST AGTFD4 + HRRZ C,CDISP ;ELSE COMMA => RETURN NULL VALUE (0) + CAIN C,SPACE ;SPACE => TRY AGAIN TO READ A FIELD. + JRST AGTFD3 ;NO FIELD, TRY AGAIN +AGTFD4: REST PPRIME + POPJ P, + + ;IN RELOCATABLE FORMAT + ;READ FIELD AND COPY OUT AS WORD + +RGETFD: SETZM WRD ;FIRST INITIALIZE SOME STUFF AS THOUGH AT GETWD + SETZM WRDRLC + MOVE A,GLSPAS + MOVEM A,GLSP1 + MOVEM A,GLSP2 + CALL XGETFD + ADDM A,WRD + ADDM B,WRDRLC + PUSHJ P,PWRDA ;OUTPUT WORD + TLNE I,ILMWRD + JRST IGTXT ;SOAK UP MULTI-WORD FIELD + POPJ P, + +;READ IN A FIELD, RETURN IN A,B SETTING IRFLD IF FIELD NOT NULL. +GETFLD: PUSH P,GLSP1 ;REFERED TO AS GETFLB(P) WHEN ONLY 1 SYL PUSHED. + MOVEM P,PPRIME + TRZ I,IRFLD+IROP +GETFD1: TLNE I,ILMWRD + JRST GETFD9 ;MULTIPLE WORD, RE-CALL PSEUDO + PUSHJ P,GETSYL + TRNE I,IRLET +GETFD9: PUSHJ P,GETVAL ;GET OPERAND (MAYBE SKIPS) +GETFD6: SKIPA C,CDISP ;GET INFO ON SYLLABLE TERMINATOR + JRST GETFD1 ;GETVAL SKIPPED => PSEUDO/MACRO WITH NO VALUE, TRY AGAIN + TLNE C,DFLD + JRST (C) ;FIELD OPERATOR, GO PROCESS + TRNE I,IRSYL ;NO DISP MEANS FIELD TERMINATOR. + TRO I,IRFLD + CAME P,PPRIME ;IF ANY OPERATORS PUSHED, + JSP LINK,GETFD8 ;EVAL THEM. + SUB P,[1,,1] ;FLUSH GLSP1 SAVED AT GETFLD. + RET + +GETFD8: MOVEI TT, ;END OF FIELD HAS VERY LOW PRIORITY. + JRST GETFD7 + +;PUSH AN OPERATOR, MAYBE EVALLING STUFF TO LEFT. +;A HAS LEFT OPERAND (IF ANY), B RELOCATION BITS, +;C ADR OF ROUTINE TO PERFORM OPERATION, LH OF TT HAS PRECEDANCE OF OPERATOR + +GETFDL: MOVEI LINK,GETFD3 ;AFTER MAYBE EVALLING, GO PUSH OPERATOR. + TRO I,IRFLD+IROP + TRNN I,IRSYL + JRST GETFD5 ;UNARY, EVAL NOTHING, JUST PUSH WITH HIGH PRIO. +GETFD2: CAME P,PPRIME ;NO OPS TO LEFT => NOTHING TO EVAL. + CAMLE TT,GETFLP(P) ;COMPARE PRIO OF PREV. OP. AND CURRENT. + JRST (LINK) ;WAIT UNTIL LATER +GETFD7: HRRZ T,GETFLP(P) ;EVAL THE LAST OP ON STACK. + JRST (T) ;GO DO IT NOW (ROUTINE RETURNS TO GETFD4) +GETFD4: SUB P,[4,,4] + JRST GETFD2 + +GETFD5: MOVSI TT,200 ;GIVE UNARY OP HIGH PRIO. TO DO BEFORE NEXT BINARY. +GETFD3: PUSH P,B ;GETFLR(P) + PUSH P,A ;GETFLV(P) + HLL C,TT + PUSH P,C ;GETFLP(P) + PUSH P,GLSP1 ;GETFLG(P) + JRST GETFD1 + +GETFLB==,-4 ;PDL IDX OF GLSP1 BEFORE LEFT OPERAND. +GETFLR==,-3 ;PDL IDX OF RELOC OF LEFT OPERAND. +GETFLV==,-2 ;PDL IDX OF VALUE OF LEFT OPERAND. +GETFLP==,-1 ;PDL IDX OF PRIO,,DISPATCH +GETFLG==0 ;PDL IDX OF GLSP1 AFTER LEFT OPERAND (=BEFORE RIGHT) + +PLS: MOVEI C,PLS1 ;PLUS SIGN, PLS1 IS ROUTINE TO PERFORM OPERATION +MINUS2: MOVSI TT,10 ;SET UP PRECEDENCE OF 10 FOR +, - + JRST GETFDL + +MINUS: JSP C,MINUS2 ;MINUS SIGN + MOVNS A ;NEGATE VALUE OF RIGHT OPERAND + MOVNS B ;ALSO RELOCATION + JUMPGE FF,PLS1 + MOVE T,GETFLG(P) + PUSH P,B + HRLZI B,MINF + PUSH P,C + PUSHJ P,LNKTZ ;COMPLEMENT THE MINUS FLAG ON GLOBALS IN RIGHT OPERAND + POP P,C + POP P,B +PLS1: ADD A,GETFLV(P) ;ADD VALUES + ADD B,GETFLR(P) ;ADD RELOCATIONS + JRST GETFD4 + +LNKTZ: TDZA C,C +LNKTC1: MOVE T,GLSP2 +LINKTC: CAML T,GLSP1 + POPJ P, + SKIPL 1(T) + XORM B,1(T) + SKIPL 1(T) + IORM C,1(T) + AOJA T,LINKTC + +MULTP: MOVEI C,MULTP1 ;ASTERISK, MULTP1 ROUTINE TO PERFORM MULTIPLICATION +DIVID2: MOVSI TT,20 ;20 PRECEDENCE OF MULTIPLICATION, DIVISION + JRST GETFDL + +MULTP1: SKIPL CONTRL ;ELSE IN DECREL ASSEMBLY, TEST FOR EXTERNALS. + JUMPGE FF,MULTR + MOVE D,GETFLB(P) ;ACTUALLY, GET HERE FOR ABS ASSEMBLIES TOO, BUT SO WHAT? + CAMN D,GLSP1 + JRST MULTR + SKIPGE FF + ETR [ASCIZ /Externals multiplied/] + TLO I,ILNOPT ;DON'T OPTIMIZE LITERALS CONTAINING UNDEFS ON PASS 1. +MULTR: JUMPE B,MULTP3 ;JUMP ON RIGHT OPERAND NOT RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;BOTH OPERANDS RELOCATED + MOVE T,GETFLV(P) ;GET VALUE OF LEFT OPERAND AND FALL IN + JRST MULTP5 + +MULTP3: MOVE T,A ;RIGHT OPERAND NOT RELOCATED, GET VALUE IN T + MOVE B,GETFLR(P) ;RELOCATION BITS OF LEFT OPERAND +MULTP5: MOVE D,GETFLG(P) ;GLOTB POINTER TO BETWEEN OPERANDS + CAME D,GETFLB(P) + JRST GMUL1 ;LEFT OPERAND HAS GLOBALS + CAME D,GLSP1 + JRST GMUL2 ;RIGHT OPERAND HAS GLOBALS + ;AT THIS POINT, T HAS VALUE OF ABS OPERAND, B RELOC BITS OF OTHER +GMUL4: IMUL A,GETFLV(P) ;MULTIPLY VALUES + IMULB B,T ;MULTIPLY RELOCATION OF ONE BY VALUE OF OTHER + TRZ T,1 + SKIPL CONTRL ;EXCEPT IN STINK ASSEMBLY, OBJECT TO RELOCATION + JRST GETFD4 ;OTHER THAN 0 OR 1 (ONLY AFFECTS DECREL, SINCE + JUMPE T,GETFD4 ;RELOCATION CAN'T BE NONZERO IN ABS ASSEMBLY). +MULTP4: ETR [ASCIZ+Relocatable arg to * or / or Boolean+] + JRST GETFD4 + +GMUL1: TLNE FF,FLPPSS ;LEFT OPERAND HAS GLOBALS, CHEK RIGHT OPERAND + CAMN D,GLSP1 + SKIPA CH1,A ;LOOKS OK, GET VALUE IN CH1 + ETR [ASCIZ /Multiplying two externals/] + SKIPA D,GETFLB(P) ;GET GLOTB POINTER TO BOTTOM OF LEFT OPERAND +GMUL2: MOVE CH1,GETFLV(P) ;GLOBALS IN RIGHT OPERAND ONLY, GET LEFT OPERAND +GMUL3: CAML D,GLSP1 + JRST GMUL4 ;TABLE COUNTED OUT + SKIPGE 1(D) + AOJA D,GMUL3 + JUMPE CH1,GMUL5 ;MULTIPLYING BY ZERO, CLEAR OUT GLOTB ENTRY AND LOOP BACK + LDB CH2,[221200,,1(D)] ;PICK UP MULTIPLICATION FIELD THIS GLOBAL + SKIPN CH2 + MOVEI CH2,1 ;0 => 1 + IMUL CH2,CH1 + CAIN CH2,1 + MOVEI CH2,0 ;IF ONE THEN USE ZERO + DPB CH2,[221200,,1(D)] + AOJA D,GMUL3 + + +GMUL5: CLEARM 1(D) + AOJA D,GMUL3 + +DIVID: JSP C,DIVID2 ;SLASH, PRECEDENCE = 20 +DIVID1: JUMPN B,MULTP4 ;JUMP IF RIGHT OPERAND RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;LEFT OPERAND RELOCATED + EXCH A,GETFLV(P) + IDIV A,GETFLV(P) + MOVEI B,0 + MOVE D,GETFLB(P) + CAMN D,GLSP1 ;IF THERE ARE EXTERNALS OR UNDEFINED SYMBOLS, + JRST GETFD4 + SKIPGE FF ;ON PUNCHING PASS IT'S AN ERROR. + ETR [ASCIZ /Division involving externals/] + TLO I,ILNOPT ;ON PASS 1, DON'T OPTIMIZE THIS IF IN A LITERAL. + JRST GETFD4 + + ;LOGIC OPERATORS & (PREC = 40), # (PREC = 34), \ (PREC = 30) + +ANDF: MOVSI TT,40 ;& + JSP C,GETFDL + JSP D,LOGIC1 ;GO DO IT + AND A,GETFLV(P) ;INSTRUCTION ARGUMENT TO LOGIC1 + +XORF: MOVSI TT,34 ;# + TRNN I,IRSYL ;IF ABOUT TO BE UNARY, + MOVNI A,1 ;THEN TURN LEFT OPERAND INTO -1 + JSP C,GETFDL + JSP D,LOGIC1 + XOR A,GETFLV(P) + +IORF: MOVSI TT,30 ;\ + JSP C,GETFDL + JSP D,LOGIC1 + IOR A,GETFLV(P) + + ;COMMON EXECUTION ROUTINE FOR LOGICAL OPERATORS + +LOGIC1: JUMPN B,MULTP4 ;NO RELOCATION ALLOWED + SKIPE GETFLR(P) ;NOW CHECK RELOCATION OF LEFT OPERAND + JRST MULTP4 + XCT (D) ;ALL TESTS PASSED, DO IT + MOVE D,GETFLB(P) ;ARE THERE ANY GLOBALS OR UNDEFINED SYMBOLS? + CAMN D,GLSP1 + JRST GETFD4 ;NO. + SKIPGE FF ;YES. ON THE PUNCHING PASS, THAT'S AN ERROR. + ETR [ASCIZ /External in arg to \, & or #/] + TLO I,ILNOPT ;ON PASS 1, JUST DON'T OPTIMIZE IF IN LITERAL. + JRST GETFD4 + +CBAKAR: MOVSI TT,100 ;BACKARROW AS FIELD OPERATOR, PREC = 100 + JSP C,GETFDL ;RETURN TO GETFLD TO READ 2ND ARGUMENT. + JSP D,LOGIC1 ;FOR EVALUATION, CALL LOGIC1 + JSP D,.+1 ;WHICH EXECUTES THIS INSTRUCTION, + MOVE T,A ;TO CALL THIS SUBROUTINE. + MOVE A,GETFLV(P) + LSH A,(T) + JRST (D) + +;D SHOULD HAVE 1 FOR <, 2 FOR (, 3 FOR [ ;] +LSSTH9: JSP LINK,SAVAS1 ;SAVE ASSEM1 PDL LEVELS, .BYTE MODE, ETC. + MOVEM D,ASMOUT ;SAY WHAT KIND OF OPEN WE JUST DID + JRST ASSEM3 ;REENTER ASSEM1 LOOP AT INNER LEVEL. + +;COME HERE TO EXIT FROM AN ASSEM1 LEVEL THAT WAS ENTERED BY LSSTH9. +LSSTHA: SKIPE BYTM ;IN BYTE MODE, DO .WALGN. SINCE ASMDSP + JRST A.BY3 ;STILL POINTS HERE, WE'LL COME BACK. + MOVE P,CONSTP + JSP T,CONNDP ;POP STUFF SAVED BY SAVAS1 + MOVE A,WRD ;RETURN THE WORD IN THE GROUPING + MOVE B,WRDRLC ;(OUR CALLER WILL USVWLD, CLOBBERING WRD) + POPJ P, + +LSSTH: MOVEI D,1 ;1 FOR <. + JSP LINK,SAVWD1 + PUSHJ P,LSSTH9 +LSSTH3: JSP LINK,USVWLD ;POP OFF ALL BUTPREVIOUS SYLL. + +;GROUPINGS EXCEPT (PARENS THAT ADD TO WORD) +;SYLL IMMEDIATELY BEFORE OR AFTER IS ERROR. +LSSTH2: ADDM A,-1(P) ;SYLL BEFORE GROUPING, PUSHED BY SAVWD1. + ADDM B,(P) + TRNE I,IRSYL ;IF WAS SYLL BEFORE GROUPING, ERROR. + ETR ERRNOS +LSSTH5: MOVE A,LIMBO1 ;CHECK FOR FOLLOWING SYLL. + CAIE A,15 + CAIN A,12 + JRST LSSTH6 ;DELIMITER CR OR LF + PUSHJ P,RCH ;NOT CR OR LF, GET NEXT CHAR + CAIN A,"! ;IGNORE EXCLAMATION POINT + JRST .-2 + TLO FF,FLUNRD ;CAUSE IT TO BE RE-INPUT + HLRZ CH1,GDTAB(A) + CAIE CH1,(POPJ P,) + JRST LSSTH4 ;SQUOZE CHAR. MEANS FOLLOWING SYLL. + HRRZ CH1,GDTAB(A) + MOVE CH1,DTB-40(CH1) ;GET DISPATCH FOR CHAR. + TLNE CH1,DSY1 ;MIGHT START SYL => NOS ERROR. + JRST LSSTH4 +LSSTH7: PUSHJ P,GTSL1 +LSSTH6: TRO I,IRSYL + POP P,B + POP P,A ;VALUE OF GROUPING WAS ADDM'ED INTO THESE. + TLZE I,ILLSRT ?.SEE UA3 + RET ;IF CALLED BY ^ OR _ AS SYL OP, RETURN TO IT. + JRST GETFD6 + +LSSTH1: TLO I,ILWORD ;A NUMBER IN PARENS BY ITSELF IS A NONNULL WORD. + ADDM A,WRD + ADDM B,WRDRLC + TRNE I,IRSYL ;IF SYLL BEFORE, + JRST LSSTH5 ;ERROR IF SYL AFTER. + JRST LSSTH8 ;ELSE NO ERROR. + +LSSTH4: ETR ERRNOS ;FOLLOWING SYLL WHEN THAT IS ERROR. +LSSTH8: TLNE I,ILLSRT ?.SEE UA3 + JRST LSSTH6 + SUB P,[2,,2] + JRST GETFD1 + +ERRNOS: ASCIZ /Syllables not separated/ + +POP2J: SUB P,[2,,2] + POPJ P, + +LEFTP: MOVEI D,2 ;2 FOR ). + JSP LINK,SAVWD1 + MOVEI C,0 + TRNE I,IROP + TRNE I,IRSYL + TLO C,400000 ;CAUSE IT TO GET ADDED INTO WORD STEAD HAVE VALUE AS SYL + PUSH P,C + PUSHJ P,LSSTH9 + POP P,C + MOVSM A,T1 ;STORE SWAPPED VALUE + ADDI B,400000 ;NOW WANT TO SWAP RELOCATION, MAKE LH CORRECT + HLREM B,T2 ;STORE AS RH WITH SIGN EXTENDED + MOVSI B,400000(B) ;GET RIGHT HALF IN LEFT + ADDM B,T2 ;FINISH RELOCATION SWAP (THIS IS PAINLESS COMPARED TO THE HAIR EVERYWHERE + ;ELSE WHEN KEEPING THE HALFWORDS SEPARATE) + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + JSP LINK,USVWLD + MOVE A,T1 + MOVE B,T2 + JUMPL C,LSSTH1 ;ADD TO WHOLE WORD + JRST LSSTH2 + +;VERSION OF GETWRD FOR PSEUDO, +;PSEUDO MUST EITHER SAVE I, PPRIME AND GTVER OR RETURN TO ASSEM1. +;SYM SHOULD HOLD NAME OF PSUEUDO. + +AGETWD: MOVEM SYM,GTVER ;STORE NAME OF PSEUDO FOR UNDEF SYM MSGS. + TRO I,IRPSUD\IRDEF\IRNOEQ + PUSHJ P,GETWRD + MOVE SYM,GTVER ;RESTORE SYM. + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + RET + +;;GETWD ;READ A WORD, LEAVE VALUE IN A AND WRD, RELOC IN WRDRLC AND B + +GETWRD: MOVE T,GLSP1 + MOVEM T,GLSP2 + CLEARM FORMAT ;CLEAR FORMAT, WILL ACCUMULATE FORMAT NUMBER BY IDPB + CLEARM WRD ;CLEAR WRD, WILL ACCUMULATE ABSOLUTE PART OF WORD + CLEARM WRDRLC ; " RELOCATION BITS, " + TDZ I,[ILWORD,,IRIOINS] + CLEARM FLDCNT ;NO FIELDS YET + MOVE T,[50100,,FORMAT] ;SET UP BIT POINTER TO FORMAT + MOVEM T,FORPNR +GTWD1: PUSHJ P,GETFLD ;READ NEXT FIELD +SPACE6: MOVEI T,1 ;SET T TO 1, AC FOR IDPB ON ROUTINE DISPATCHED TO + SKIPA C,CDISP +SPACE5: REST A + TLNE C,DWRD + JRST (C) ;NO DISPATCH MEANS WD TERMINATOR + MOVE C,GLSP1 + MOVEM C,LINKL ;MARK END OF ACTIVE PART OF GLOTB + TRNN I,IRFLD + JRST GETWD2 ;LAST FIELD NULL, MAYBE HAVE TO POP STUFF OFF + IDPB T,FORPNR ;MARK NON-NULL FIELD IN FORMAT +GTWD4A: TLO I,ILWORD ;NON-NULL WORD + MOVE TT,FORMAT + SKIPN TT,FORTAB-10(TT) ;PICK UP BYTE POINTER POSITION/SIZE FIELDS FOR FIELDS IN WORD + ETR [ASCIZ /Undefined format/] + MOVEM TT,FORMAT ;STORE IN FORMAT + MOVE T,[301400,,FORMAT] + MOVEM T,FORPNR + ;AT THIS POINT, FLDCNT HAS 1 LESS THAN # FIELDS; PUT FIELDS TOGETHER TO FORM WORD +GTWD3: LDB T,FORPNR + MOVE D,FLDCNT + CAIG D,2 + IBP FORPNR ;HAVEN'T BACKED UP TO THIRD FIELD YET, INCREMENT TO DESC FOR PREV + TRNE I,IRIOINS + PUSHJ P,INTIOW + PUSHJ P,INTFLD ;PUT FIELD WHERE IT BELONGS + SOSGE FLDCNT + JRST GTWD5 ;THIS WAS LAST (FIRST) FIELD + POP P,GLSP2 ;NOT YET, POP OFF MORE + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD3 + +GTWD5: MOVE A,WRD + MOVE B,WRDRLC + MOVE C,LINKL + MOVEM C,GLSP1 + TRZ I,IRIOINS + POPJ P, + +COMMA: TRNN I,IRFLD ;FIELD DELIMITER WAS COMMA (T HAS 1) + JRST COMMA1 ;NO FIELD + IDPB T,FORPNR ;MARK NON-NULL FIELD +COMMA4: IDPB T,FORPNR ;MARK FIELD TERMINATOR WAS COMMA + MOVE TT,FLDCNT + CAIL TT,2 + ETR [ASCIZ /Comma past the 3rd field of a word/] +PUSHFD: PUSH P,A ;DONE WITH THIS FIELD, NOW TO GET NEXT + PUSH P,B + PUSH P,GLSP1 + PUSH P,GLSP2 + AOS FLDCNT ;ANOTHER FIELD + MOVE TT,GLSP1 + MOVEM TT,GLSP2 + HRRZ T,FORPNR + CAIE T,FORMAT + HRRZS FORPNR ;STABILIZE FORPNR + TLO I,ILWORD ;SAY WE HAVE A NON-NULL WORD IN PROGRESS (LOC, ETC. ILLEGAL). + JRST GTWD1 + +GETWD2: SKIPN FORMAT ;LAST FIELD OF WORD IS NULL + JRST GTWD5 ;ENTIRE WORD NULL, MAYBE WERE PARENS. + SOS FLDCNT + POP P,GLSP2 + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD4A + +COMMA1: LDB TT,FORPNR ;COMMA TERMINATED NULL FOELD. + SKIPE FORMAT + JUMPE TT,COMMA2 ;NOT 1ST FIELD, JMP IF PREV WAS TERM BY SPACE. + IBP FORPNR ;ELSE MARK NULL FIELD IN FORMAT. + JRST COMMA4 + +;FIELD SPACE COMMA, PATHOLOGICAL CASE +;(EG MACRO STARTED WITH A COMMA) +COMMA2: DPB T,FORPNR ;REPLACE SPACE WITH COMMA. + JRST GTWD1 + + ;FIELD TERMINATOR IS SPACE (T HAS 1) + +SPACE: MOVE TT,LIMBO1 + CAIE TT,^I ;HEURISTIC: REAL SPACES ARE LIKELY TO BE FOLLOWED BY SQUOZE, + JRST SPACE4 ;WHILE TABS ARE LIKELY TO BE FOLLOWED BY COMMENTS. + PUSH P,A + MOVE TT,GDTAB+40 + PUSHJ P,RCH + CAMN TT,GDTAB(A) + JRST .-2 ;FLUSH OTHER LOGICAL SPACES + CAIN A,"; ;TAB WAS FOLLOWED BY SEMICOLON: + JRST [ PUSH P,B + TRZ I,IRSYL + CALL SEMIC ;FLUSH THE COMMENT + MOVEI T,1 + REST B + JRST SPACE5] ;AND HANDLE THE C.R. +SPACE3: POP P,A + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-READ NEXT TIME +SPACE4: TRNN I,IRFLD + JRST GTWD1 ;NO FIELD + IDPB T,FORPNR ;T HAS 1, MARK NON-NULL FIELD IN FORMAT + IBP FORPNR ;MARK FIELD TERMINATOR WAS SPACE + JRST PUSHFD + +;T HAS DESC BYTE, PUT FIELD IN ITS PLACE +;ALSO CALLED FROM PBYTE, MUSTN'T CLOBBER AA. + +INTFLD: MOVE TT,GLSP2 + CAMN TT,GLSP1 + JUMPE B,INTFD1 ;NO GLOBALS, JUMP IF NO RELOCATION + CAIN T,2222 ;LH + JRST INTL + CAIN T,22 ;RH + JRST INTR + CAIN T,44 ;WHOLE WORD + JRST INTW + SKIPE B + ETR [ASCIZ/Relocation attempted in irrelocatable field/] + ;(ASSUME) NO RELOCATION, CHECK FOR GLOBAL AC FIELDS + CAIN T,2704 ;HIGH AC + JRST INTACH + CAIN T,504 ;AC LOW + JRST INTACL + JUMPGE FF,INTFD1 ;JUMP ON NOT PUNCHING PASS + CAME TT,GLSP1 + ETR [ASCIZ/Global symbol in illegal field/] +INTFD1: MOVEI TT,C_12. + ROTC T,-12. ;SHIFT BYTE POINTER INTO TT + MOVEI C,0 ;INITIALIZE C TO RECEIVE FIELD IN PROPER PLACE + DPB A,TT + CAMN TT,[2200,,C] + JRST INTFD2 ;RIGHT HALF, DON'T ALLOW CARRY INTO LH + ADDM C,WRD ;ALLOW CARRY +INTFD3: ADDM B,WRDRLC ;ADD RELOCATIONS, WILL BE BROKEN BACK INTO HALF-WORDS LATER + POPJ P, + +INTFD2: ADD C,WRD ;ADD RIGHT HALVES + HRRM C,WRD + JRST INTFD3 + +INTIOW: CAIE T,2704 + CAIN T,504 + TRZA A,3 ;IO DEVICE FIELD + POPJ P, ;NOT "AC" FIELD + ADDI T,611-504 + POPJ P, + +INTR: HRRE D,B ;RH + MOVEI B,0 + PUSH P,T + HRLZI C,HFWDF + PUSHJ P,LNKTC1 ;THIS IS A BUG WHICH SHOULD BE FIXED SOMETIME +PRTCL: MOVE B,D ;GET BACK MAPPED RELOCATION BITS +PRTCL2: POP P,T +INTW: MOVE D,GLSP2 ;WHOLE WORD + HRLOI LINK,377777 + CAML D,GLSP1 + JRST INTFD1 + ANDM LINK,1(D) + AOJA D,.-3 + +INTL: HRLZ D,B ;LH + MOVSI B,SWAPF + MOVSI C,HFWDF + PUSH P,T + MOVE T,GLSP2 +INTL2: CAML T,GLSP1 + JRST PRTCL + SKIPGE 1(T) + AOJA T,INTL2 ;INDEX FIELD, ETC => LEAVE ALONE + IORM C,1(T) ;SET HFWDF + XORM B,1(T) ;COMPLEMENT SWAP STATUS + TDNN B,1(T) + SETZM 1(T) ;SWAPPED TO RH, FLUSH IT + AOJA T,INTL2 + +INTACL: TDZA B,B ;AC LOW +INTACH: HRLZI B,SWAPF ;AC HIGH + HRLZI C,ACF + PUSH P,T + PUSHJ P,LNKTC1 + MOVEI B,0 + JRST PRTCL2 + +IOINST: HLLZ A,B ;IO INSTRUCTION, GET WHICH ONE INTO A + SKIPN FLDCNT ;THIS FIRST FIELD OF WORD? + TRO I,IRIOINS ;YES + JRST CLBPOP ;RETURN VALUE + +;TOP LEVEL LOOP, ASSEMBLE STORAGE WORDS +;LOTS OF PSEUDOS MEANINGLESS IN STORAGE WORDS +;(E.G. BLOCK, CONSTA) DO JRST ASSEM1 WHEN DONE +;THERE'S ALSO AN ERROR UUO WHICH RETURNS TO ASSEM1 + +ASSEM1: MOVE P,ASSEMP + JRST @ASMDSP + +;COME HERE TO START THE NEXT EXPRESSION OR WHATEVER. +ASSEM3: PUSHJ P,RCH + CAIN A,^I + JRST ASSEM2 ;PROBABLY NOT PROFITABLE TO SKIP AFTER SEE A TAB. + CAIG A,40 + JRST ASSEM3 ;FLUSH LEADING GARBAGE + TLO FF,FLUNRD ;CAUSE NON-GARBAGE CHAR FOUND TO BE RE-INPUT +;ASMDSP POINTS HERE WITHIN ASCII, SIXBIT ETC. +ASSEM2: TRZ I,IRFLD+IRSYL+IRLET+IRPSUD+IRCOM+IRCONT+IRGMNS+IROP+IRNOEQ+IREQL + TLZ I,ILGLI+ILVAR+ILFLO+ILDECP+ILUARI+ILWORD+ILNPRC+ILNOPT + IOR I,ASMI ;SET DEF AND RESTORE PSEUDF. + MOVE A,GLSPAS + SKIPL BYTM + MOVEM A,GLSP1 + ;GETWRD WILL COPY GLSP1 INTO GLSP2 +IFN TS,[AOSN TTYBRF ;DO A ^H-BREAK IF REQUESTED. + CALL TTYBRK] + PUSHJ P,GETWRD + TLZN I,ILWORD + JRST @ASMDSP ;NO WORD ASSEMBLED,TRY AGAIN + SKIPGE BYTM + JRST PBYTE ;IN BYTE MODE, OUTPUT BYTE INSTEAD OF WORD, A,B MUST HAVE WRD,WRDRLC. + MOVE AA,ASMOUT ;OUTPUT WD AS APPRO. FOR GROUPING, IF ANY. + JRST @ASMOT0(AA) + +ASSEM6: SKIPE STGSW ;ASMOT0 POINS HERE. COME IF NOT IN GROUPING. + ETR ERRSWD ;STORAGE WORD ASSEMBLED + PUSHJ P,PWRD ;OUTPUT THE WORD. + AOS CLOC + HRRZS CLOC ;INCREM. POINT . + JRST @ASMDSP ;ASSEM3 OR ASSEM2 + +ERRSWD: ASCIZ /Storage word assembled/ + +ASSEM4: JSP T,PCONST ;ASMOT0+3 POINTS HERE. COME IF IN CONSTANT. + JRST @ASMDSP + +;ASMDSP POINTS HERE WITHIN GROUPING IF NOT IN MULTI-LINE MODE +;[ ;AND NO CLOSE (">)]") HAS BEEN SEEN. +ASSEMC: MOVE AA,ASMOUT + SKIPE CONSML ;IN ERROR MODE, GIVE APPROPRIATE ERROR MSG. + XCT ASMOT3(AA) + JRST @ASMOT2(AA) ;CLOSE WHATEVER TYPE GRPING WE'RE IN. + +;JUMP THRU THIS TABLE TO OUTPUT A WORD. +ASMOT0: ASSEM6? ASSEM1? ASSEM1? ASSEM4? [HALT ] + +;THIS TABLE GIVES APPRO. CLOSE FOR EACH TYPE OF GROUPING. ;[ +ASMOT1: "? ? "> ? ") ? "] ? "? + +;THIS TABLE SAYS WHERE TO GO TO END THE GROUPING. +ASMOT2: [HALT ]? LSSTHA? LSSTHA? CONND? [HALT ] + +;APPROPRIATE ERROR MESSAGE FOR MISSING CLOSE OF GROUPING. [ +ASMOT3: HALT + ETR [ASCIZ /Missing >/] + ETR [ASCIZ /Missing )/] + ETR [ASCIZ /Missing ]/] + HALT + +;THIS TABLE TELLS PBYTE HOW TO HANDLE BYTE MODE. +ASMOT4: PBY4 ? PBY5 ? PBY5 ? PBY3 ? [HALT ] + +;TABLE SAYING WHAT CHAR MUST HAVE OPENED THE GROUPING. +ASMOT5: "? ? "< ? "( ? "[ ? "? ;] + +;;GETVAL ;GET VALUE OF SYM + ;SKIPS ON PSEUDO NOT RETURNING VALUE (E.G. MACRO STARTING TO BE EXPANDED) + ;ELSE RETURNS VALUE IN A, RELOCATION BITS IN B + +VBLK +GTVER: 0 ;SQUOZE NAME OF CALLING PSEUDO, OR POINTER + ;TO INSN TO EXECUTE WHEN IF SYM IS UNDEF. +PBLK + +GETVAL: PUSHJ P,ES + JRST GVNF ;NO STE. +IFN CREFSW,XCT CRFINU ;JFCL OR CALL TO CREF RTN. + JRST @.+1(A) ;FOUND, DISPATCH ON SQUOZE FLAGS + +GVTAB: GVCOM ;COMMON (UNUSED) + GVPSEU ;PSEUDO OR MACRO. + GVSYM ;LOCAL SYMBOL. + GVUL ;LOCAL UNDEF (MAYBE STINK KNOWS VALUE) + GVDLV ;DEFINED LOCAL VAR. + GVULV ;UNDEF LOC VAR. + GVDGV ;DEF GLO VAR + GVUGV ;UNDEF GLO VAR + GVDG ;DEF GLOBAL + GVUG ;UNDEF GLOBAL + +;DEF LOCAL VAR. +GVDLV: PUSHJ P,GVDLGV ;IF PASS2 AND HAS ' THIS TIME, SET 3VAS2 FOR AVARIAB + TLZN I,ILGLI + JRST GVDLV2 + MOVSI T,DEFGVR ;NOW DEF GLO VAR. + PUSHJ P,VSM2 + JRST GVDG1 ;MAYBE OUTPUT GLOBAL DEF. TO STINK. + +GVDGV: PUSHJ P,GVDLGV ;DEF GLO VAR; IF PASS 2 AND ' THIS TIME, SET 3VAS2 + JRST GVDG2 ;MUSN'T PUNCH VALUE, AVARIAB WILL. + +GVDLGV: TRNE FF,FRPSS2 ;IF PASS 2 + TLNN I,ILVAR ;AND THIS TIME HAVE SINGLEQUOTE + POPJ P, + TLO C,3VAS2 ;TELL AVARIAB SEEN IN PASS 2 WITH '. + 3PUT C,D + POPJ P, + +GVULV: TLZN I,ILGLI ;UNDEF LOCAL VAR, MAYBE MAKE GLOBAL. + JRST GVUNDF + PUSHJ P,PLOGLO ;IF SO, TELL STINK SYM IS GLOBAL, + MOVSI T,UDEFGV ;SYM NOW UNDEF GLO VAR + PUSHJ P,VSM2 + JRST GVUNDF ;IN EITHER CASE, HANDLE UNDEF SYM. + +GVUL: TLZE C,3MACOK ;UNDEF LOCAL, PRESUMED NUMERIC + 3PUT C,D ;DON'T LET IT BECOME MACRO AND SCREW PASS2. + TLNE C,3LLV + JRST GVGLTB ;(REALLY DEFINED BUT ONLY STINK KNOWS HOW) + TLNE I,ILGLI ;IF MAKING GLOBAL, TELL STINK. + PUSHJ P,PLOGLO +GVNF1: TLZE I,ILVAR ;IF ', MAKE VAR (WILL CHECK ILGLI) + JRST GVUL1 + TLZN I,ILGLI ;NOT MAKING VAR, MAYBE GLOBAL? + JRST GVUNDF ;NO, MAYBE ERROR, MAKE GLOTB ENTRY. + MOVSI T,GLOEXT + PUSHJ P,VSM2 ;NOW GLOBAL UNDEF, + JRST GVGLTB ;NO ERROR, JUST GLOTB ENTRY. + +GVUL1: TLZN I,ILGLI ;UNDEF LOCAL BECOMES + SKIPA T,[UDEFLV,,] ;UNDEF LOC VAR OR +GVGVAR: MOVSI T,UDEFGV ;UNDEF GLO VAR. +GVVAR: CALL ESDEF ;DEFINING SYM AS A VAR => INSIST ON DEFINING LOCAL TO INNERMOST BLOCK. + JFCL + AOS VARCNT + HRR B,VARCNT + PUSHJ P,VSM2 ;MAKE IT A VAR, + JRST GVUNDF ;PRETEND HAD ALREADY BEEN A VAR. + +GVUG: TLZE I,ILVAR ;UNDEF GLOBAL: MAYBE MAKE UNDEF GLO VAR. + JRST GVGVAR +GVGLTB: SKIPGE CONTRL ;UNDEF GLO IN ABS ASSEM => + JRST GVUND1 ;MAYBE TREAT AS UNDEF. +GVGLT1: AOS GLSP1 ;DON'T KNOW SYM'S VALUE, MAKE GLOTB ENTRY. + MOVEI T,ST(D) + HRRZM T,@GLSP1 + JRST CABPOP ;RETURN 0 AS VALUE. + +GVNF: +IFN CREFSW,XCT CRFINU ;ONLY IF NOT FOUND WOULD NOT CREF AFTER ES. + TLNE I,ILVAR+ILGLI ;MAKING VAR OR GLOBAL FORCED CURRENTBLOCK ALREADY + JRST GVNF1 ;AND WILL STORE NAME IN STE ANYWAY. + SKIPGE ESBK ;ELSE IF NO SPEC'D BLOCK, + TRNN FF,FRNPSS ;FORCE .MAIN BLOCK SO DON'T GET LOTS OF UNDEF ENTRIES. + CAIA ;BUT CAN'T DO THAT FOR 1PASS OR WOULD MISS FWD REFS. + HRRI C,BKWPB + MOVSI T,LCUDF + PUSHJ P,VSM2 + JRST GVUNDF ;MAYBE ERROR, MAKE GLOTB ENTRY. + +GVCOM: TRO I,IRCOM ;COMMON: SAY THIS WAS ONE. + HRRZ A,B ;RETURN RH OF VALUE, ABSOLUTE. + JRST CLBPOP + +GVPSEU: TLNN I,ILVAR+ILGLI ;CAN'T MAKE PSEUD OR MACRO GLOBAL OR VAR. + JRST (B) ;OTHERWISE, DISPATCH TO IT. + TLZE I,ILVAR + ETSM ERRCBV + TLZE I,ILGLI + ETSM ERRCBG + JRST (B) ;DISPATCH TO PSEUDO (OR MACCL IF MACRO) + ;EXPECTS LH OF VALUE IN LH OF B. + +ERRCBV: ASCIZ /Can't be a variable/ +ERRCBG: ASCIZ /Can't be global/ + +GTVL7B: TLNE C,3RLL ;R(LH) + TLO SYM,200000 + TLNE C,3RLR ;R(RH) + TLO SYM,100000 + POPJ P, + +GVSYM: TLNN C,3REL + TLNE I,ILVAR\ILGLI + JRST GVSYM2 + MOVE A,B ;THIS CODE DOES WHAT GVSYM2 WOULD DO, BUT FASTER. + SETZ B, + RET + +GVSYM2: TLZE I,ILVAR ;LOCAL SYM: CAN'T MAKE VARIABLE. + ETSM ERRMDV + TLZN I,ILGLI + JRST GVSYM0 ;NOT MAKING GLOBAL, GET VALUE & RETURN. +GVSYM1: MOVSI T,GLOETY ;BECOMES DEF. GLOBAL. + PUSHJ P,VSM2 + JRST GVDG1 ;HANDLE AS IF WAS DEF GLOBAL. + +ERRMDV: ASCIZ /Multiply-defined variable/ + +GVDG: TLZE I,ILVAR ;GLOBAL ENTRY + ETSM ERRMDV +;COME HERE FOR DEF GLOBAL +GVDG1: SKIPGE CONTRL + JRST GVDLV2 ;DON'T PUNCH VALUE IF ABSOLUTE. + TLNE C,3VP + JRST GVDG2 ;VALUE PUNCHED ALREADY, NOT AGAIN. + JUMPGE FF,GVDG2 + TLNN C,3LLV + TRNE I,IRPSUD+IREQL + JRST GVDG2 + TLO SYM,40000 + PUSH P,WRD + PUSHJ P,OUTDE2 + POP P,WRD +GVDG2: TRNN I,IRPSUD\IREQL ;IF INSIDE AN ORDINARY STORAGE WORD, + TLNN C,3REL ;GENERATE A GLOBAL REF IF GLOBAL IS RELOCATABLE (HEURISTIC). +GVDLV2: TLNE C,3LLV ;IF VAL KNOWN ONLY BY STINK, MUST MAKE A GLOBAL REF. + JRST GVGLTB +GVSYM0: MOVE A,B ;USED IN LBRAK + LDB B,[.BP (3RLR),C] + TLNE C,3RLL + TLO B,1 + POPJ P, + +GVUND1: MOVE A,CONTRL + TRNE A,DECREL+FASL ;DEC FMT OR FASL => UNDEF GLOBALS OK. + JRST GVGLT1 +GVUGV: +GVUNDF: TRZ I,IRDEF ;UNDEFINED, MAYBE ERROR, MAKE GLOTB ENTRY. + TRNE I,IRPSUD\IREQL + JRST GVUND2 ;PSEUDO + TRNN FF,FRPSS2 + JRST GVGLT1 ;PASS 1 + SKIPN CONDEP + ETSM [ASCIZ/Undefined/] + SKIPE CONDEP + ETSM [ASCIZ/Undefined in literal/] + JRST CABPOP + +GVUND2: HLRZ A,GTVER ;DOES GTVER POINT TO AN INSN? + JUMPE A,[XCT @GTVER ? JRST CABPOP] + ERJ .+1 ;NO, IT IS NAME OF PSEUDO. + MOVE A,LINEL + CAIGE A,75. ;CR-LF-TAB NOW IF WHOLE MSG WON'T FIT ON A LINE. + CALL CRRTBX + TYPE2 SYM ;TYPE NAME OF UNDEF SYM. + TYPR [ASCIZ/ Undefined in /] + TYPE2 GTVER + CALL CRRERR + JRST CABPOP + +;EVALUATE SYMBOL, SQUOZE (FLAGS OFF) IN SYM +;IDX OF BLOCK TO DEFINE IN IN ESBK (OR -1 => ANY BLOCK NOW IN PROGRESS). +;DOESN'T CLOBBER F (FOR WRQOTE) +;RETURNS SKIPPING IF SYM FOUND, WITH SQUOZE FLAGS IN BOTTOM OF A, +;VALUE OF SYM IN B, STE IDX IN D, AND 3RDWD IN C. +;IF NOT FOUND, RETURNS IN D THE IDX OF A PLACE TO DEFINE SYM. +;CALL ESDCHK TO GET THE FOLLOWING EXTRA INFO (WHETHER SYM FOUND OR NOT): +;ESLAST -> LAST STE WITH DESIRED NAME SEEN, REGARDLESS OF WHAT BLOCK IT'S IN +;ESL1 HAS LEVEL OF BLOCK OF BEST STE SEEN, -1 IF NOT FOUND +;ESL2 HAS 3RDWRD OF BEST. +;ESXPUN HAS -1 OR IDX OF A STE WHICH MIGHT BE USED TO DEFINE THE SYM. +;RH(TM) GETS BLOCK IDX TO DEFINE IN IF DEFINE THE SYM. +;TT HAS -<# STE NOT LOOKED AT YET> +;THEN IF SYM IS FOUND IN A CONTAINING BLOCK AND YOU WANT TO DEFINE +;IT IN THE CURRENT BLOCK, YOU CAN CALL DEFCHK TO FIND AN STE TO DO IT IN. +;CALLING ESDEF IS AS GOOD AS CALLING ESDCHK AND DEFCHK, BUT DOESN'T +;LET YOU SEE WHAT YOU ARE GOING TO SHADOW. + +ESDEF: MOVE A,BKCUR ;EVAL SYM IN ORDER TO DEFINE IT: + SKIPGE ESBK ;IF NO SPEC'D BLOCK, SPEC THE CURRENT BLOCK, + MOVEM A,ESBK ;SO DEFS IN CONTAINING BLOCKS WON'T BE SEEN + +ESDCHK: SETOM ESLAST ;CALL HERE IF WE MIGHT END UP CALLING DEFCHK, + SETOM ESL1 ;SINCE IN THAT CASE WE'LL NEED THESE VARS EVEN IF SYM IS FOUND + SETOM ESXPUN ;RIGHT AWAY. + MOVN TT,SYMLEN +ES: MOVE C,SYM ;HASH AWAY + TSC C,SYM ;THIS MAKES SURE THAT THE FIRST FEW CHARS OF SYMBOL DON'T GIVE + ;A ZERO REMAINDER, IF SYMLEN IS A ROUND NUMBER. + MOVMS C ;THIS IS BECAUSE IDIV OF NEGATIVE NUMBER GIVES NEG. REMAINDER. + IDIV C,SYMLEN + IMUL D,WPSTE + SKIPGE TM,ESBK ;GET BKTAB IDX OF SPEC'D BLOCK + HRR TM,BKCUR ;OR -1,,BKTAB IDX OF CURRENT BLOCK. +;NOW CHECK FAST FOR AN IMMEDIATE MATCH - AVOID SETTING UP FLAGS NEEDED ONLY WHEN +;SYM APPEARS IN MULTIPLE BLOCKS OR ISN'T DEFINED. + SKIPN B,ST(D) + JRST ESEND0 ;SYM IS KNOWN NOT TO BE DEFINED. + TLZ B,740000 + CAME B,SYM + JRST ESBAD0 ;NOT FOUND IN 1ST ENTRY - MUST SET UP INFO AND LOOP + 3GET C,D + MOVEI A,(C) + CAIN A,(TM) + JRST ESGOOD ;IN THE DESIRED BLOCK => GOOD. + TDNN C,[3MAS,,-1] ;IN THE INITIAL SYMS BLOCK, NOT PRESENT IN ANY OTHER, + JUMPL TM,ESGOOD ;AND BLOCK WASN'T EXPLICITLY SPEC'D => GOOD. + MOVN TT,SYMLEN ;ELSE MUST KEEP LOOKING TO SEE IF THIS DEF IS REALLY ONE WE WANT. + SETOM ESLAST + SETOM ESL1 + SETOM ESXPUN + JUMPGE TM,ESIGN + JRST ESLP1 + +;LOOK AT THE NEXT STE, WHILE LOOPING. +ESLP: SKIPN B,ST(D) ;GET SQUOZE IN THIS ST SLOT + JRST ESEND ;NOTHING WHERE SYM BELONGS, END SEARCH + TLZ B,740000 ;CLEAR OUT FLAGS + CAME B,SYM ;COMPARE WITH WANTED + JRST ESBAD ;NO MATCH BUT MAYBE KEEP GOING + 3GET C,D ;FOUND SYM, GET 3RDWRD + MOVEI A,(C) + CAIN A,(TM) ;DEFINED IN DESIRED BLOCK + JRST ESGOOD ; => MUST BE GOOD. +ESLP0: JUMPGE TM,ESIGN ;BLOCK SPEC'D => ALLOW NO OTHERS. + TDNE C,[3MAS,,-1] ;IF IN INITIAL SYMS BLK, NO MORE DEFS, + JRST ESLP1 + SKIPGE ESL1 ;AND NO PREVIOUS DEFS, + JRST ESGOOD ;UNREDEFINED INITL SYM MUST BE GOOD. +ESLP1: HLRZ B,BKTAB+1(C) ;GET LEVEL OF BLOCK DEF. IS IN. + CAMN A,BKPDL(B) ;SAME AS BLOCK WE'RE IN AT THAT LEVEL? + CAMLE B,BKLVL ;AND NOT A BLOCK WE'VE EXITED + JRST ESIGN + CAMG B,ESL1 ;OR HIGHER LEVEL THAN PREVIOUS BEST + JRST ESIGN + MOVEM C,ESL2 ;REPLACE BEST'S 3RDWRD, LEVEL, ADDR. + MOVEM B,ESL1 + MOVEM D,SADR +ESIGN: HRRZM D,ESLAST ;THIS ENTRY LAST SEEN WITH THIS NAME. + TLNN C,3MAS ;MORE STE'S FOR THIS SYM => + JRST ESEND1 + JRST ESNXT ;KEEP LOOKING. + +;COME HERE IF 1ST SYM SEEN ISN'T THE SAME NAME. SET UP TO LOOP. +ESBAD0: MOVN TT,SYMLEN + SETOM ESLAST + SETOM ESL1 + SETOB C,ESXPUN +;HERE WHILE LOOPING WHEN SYM WITH WRONG NAME IS SEEN. +ESBAD: JUMPN B,ESNXT + SKIPGE A,ESXPUN ;IF THIS IS 1ST EXPUNGED ENTRY SEEN + MOVEM D,ESXPUN ;REMEMBER IT FOR DEFINITION. + SKIPGE A + HRROS ESLAST ;AND SET OLD ENTRY'S 3MAS. +ESNXT: ADD D,WPSTE + CAML D,SYMSIZ ;AT END => GO TO BEGINNING + MOVEI D,0 + AOJN TT,ESLP + JRST ESEND1 ;NOT FOUND. + +ESEND0: MOVEI C,(TM) ;COME HERE IF 1ST PLACE LOOKED AT SHOWS THE SYM ISN'T DEFINED + MOVEM D,ESXPUN + POPJ P, + +ESEND: SKIPGE A,ESXPUN ;FREE ENTRY CAN BE USED TO DEFINE. + MOVEM D,ESXPUN + SKIPGE A + HRROS ESLAST +ESEND1: SKIPGE ESL1 ;NOT FOUND => FIND PLACE TO DEFINE IT. + JRST DEFCH1 + MOVE D,SADR ;IDX OF BEST FOUND. + TRNN FF,FRNPSS + JRST ES1PS ;1-PASS, SPECIAL CHECK. + MOVE C,ESL2 ;GET BEST'S 3RDWRD. +ESGOOD: LDB A,[400400,,ST(D)] ;GET SQUOZE FLAGS IN A. +ES1POK: MOVE B,ST+1(D) ;VALUE OF SYM. IN B. + ;D HAS IDX OF 1STWRD IN SYM TAB. + ;C HAS 3RDWRD +POPJ1: AOS (P) +APOPJ: +CPOPJ: POPJ P, + +;ESDCHK THEN DEFCHK IS SAME AS CALLING ESDEF. +;WE ASSUME THAT D AND TT ARE STILL SET UP FROM A CALL TO ESDCHK. +DEFCHK: SKIPGE ESL1 ;IF WE DIDN'T TAKE TIME TO SET ESLAST BEFORE, + HRRZM D,ESLAST ;DO IT NOW. (SEE BEFORE ESLP1) + JRST DEFCH1 + +ES1PS: LDB A,[400400,,ST(D)] ;1PASS & FOUND IN CONTAINING BLOCK: + MOVE C,ESL2 + TRNN C,-1 ;INITIAL SYM, OK; + JRST ES1POK + CAIE A,1 ;PSEUDO OR MACRO + TLNE C,3DOWN ;OR .DOWN'D SYMBOL OK; + JRST ES1POK ;ELSE GET NEW STE TO DEF. +DEFCH1: MOVEI C,(TM) ;INITIALIZE NEW 3RDWRD WITH BLOCK TO DEF IN. + SKIPL D,ESXPUN ;IF FOUND EXPUNGED OR FREE ENTRY, USE IT. + JRST DEFCH2 + SKIPGE D,ESLAST ;ELSE LOOK FOR ONE. + ETF ERRSCE +DEFCH4: MOVE B,ST(D) + TLZ B,740000 + JUMPE B,DEFCH3 ;MUST RETURN 0 IN B IF DON'T SKIP. + ADD D,WPSTE + CAML D,SYMSIZ + MOVEI D,0 + AOJL TT,DEFCH4 ;ASSUME TT LEFT AROUND FROM ES. + ETF ERRSCE +ERRSCE: ASCIZ /Symbol table full/ + +;ESLAST HAS -1 IF NO ENTRY SEEN; ELSE +;RH HAS IDX OF LAST SEEN, SIGN SET IF SEEN BEFORE PLACE TO DEFINE. +DEFCH3: MOVEM D,ESXPUN ;REMEMBER ADDR WHERE CAN DEFINE + HRROS ESLAST ;LAST PLACE SEEN MUST BE EARLIER. +DEFCH2: SKIPL A,ESLAST + JRST DEFCH5 ;LAST PLACE SEEN WAS SEEN AFTER PLACE TO DEFINE. + CAMN A,[-1] + POPJ P, ;REALLY NEVER SEEN. + MOVSI TM,3MAS + IORM TM,ST+2(A) ;PLACE SEEN IS EARLIER, SET ITS 3MAS. + POPJ P, + +DEFCH5: TLO C,3MAS ;PLACE TO DEF BEFORE EXISTING STES. + POPJ P, + +;ENTER A SYM IN SYMBOL TABLE + ;B HAS VALUE + ;C HAS 3RDWRD + ;D HAS INDEX INTO ST (PROBABLY SET UP BY ES) + ;T HAS SQUOZE FLAGS (ONLY) IN PLACE FOR IOR OF SQUOZE + ;SYM HAS SQUOZE, FLAGS OF WHICH ARE IGNORED + +VSM2LV: TLOA C,3LLV ;ENTRY FOR LINKING LOADER MUST SUPPLY VALUE +VSM2W: MOVE B,WRD ;ENTRY TO ENTER VALUE OF WRD STEAD B +VSM2: MOVE CH1,SYM + TLZ CH1,740000 + IOR CH1,T ;CH1 := SQUOZE WITH FLAGS + MOVEM CH1,ST(D) ;STORE SQUOZE + MOVEM B,ST+1(D) ;STORE VALUE +VSM3A: 3PUT C,D ;STORE 3RDWRD + POPJ P, + +;RETURN THE NUMBER OF SYMTAB SLOTS IN USE. +A.SYMCN:SKIPL A,SMSRTF ;IF SYMTAB HAS BEEN COMPACTED, GET # OF SYMS THAT IT HAD + JRST CLBPOP ;BEFORE COMPACTION AND RETURN THAT. + MOVE D,SYMAOB + SETZ A, +A.SYC1: MOVE B,ST(D) + TLZ B,740000 + SKIPE B + AOS A + ADD D,WPSTE1 + AOBJN D,A.SYC1 + JRST CLBPOP + +;;EQUAL ;EQUAL SIGN ENCOUNTERED, DO PARAMETER ASSIGNMENT + +EQUAL: TLZ FF,FLHKIL + PUSHJ P,RCH + CAIE A,"= ;DECIDE WHETHER TO HALF-KILL THE SYM. + TLOA FF,FLUNRD + TLO FF,FLHKIL + SETZM LABELF + CALL RCH + CAIE A,": ;DECIDE WHETHER TO MARK SYM AS NOT REDEFINABLE. + TLOA FF,FLUNRD + SETOM LABELF + CAMN SYM,[SQUOZE 0,.] ;.=FOO, SAME AS LOC FOO + JRST PTEQ + TDNN I,[ILWORD,,IROP+IRNOEQ] + TRNN I,IRLET + ETR [ASCIZ/= With bad format or bad context/] + PUSH P,LABELF + PUSH P,SYM + PUSH P,ESBK + PUSH P,I + MOVEI A,[ETSM [ASCIZ/Undefined in =/]] + MOVEM A,GTVER + TRO I,IRNOEQ+IRDEF+IREQL + PUSHJ P,GETWRD + TRNN I,IRDEF + JRST ASEM1A ;UNDEFINED SYMS IN VALUE, IGNORE +IFN LISTSW,[ + SKIPN LSTONP + JRST EQUAL1 ;NOT LISTING. + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE SYM,WRD + MOVEM SYM,LISTWD + MOVE SYM,WRDRLC + MOVEM SYM,LSTRLC + SETOM LISTAD + SETOM LISTPF +EQUAL1: +] ;END IFN LISTSW, + TDZ I,[-1-(ILMWRD)] + IOR I,(P) + TLZ FF,FLUNRD + POP P,(P) + POP P,ESBK + POP P,SYM + POP P,LABELF + MOVE A,WRDRLC ;GET RELOCATION + TDNN A,[-2,,-2] ;SKIP ON NON-STANDARD RELOCATION BITS + SKIPE LDCCC + JRST EQG1 ;STRANGE RELOCATION OR IN LOAD TIME CONDITIONALS => HAND PROBLEM TO LOADER + MOVE A,GLSP1 + CAMN A,GLSP2 + JRST EQL1 ;NO GLOBALS IN DEFINITION +;FALLS THROUGH. + +;FALLS THROUGH. +;GLOBALS TO RIGHT OF = OR WITHIN LOADER CONDIT. +EQG1: IFN CREFSW, XCT CRFLBL ;CREF DEF. OF NORMAL SYM, + SKIPGE CONTRL + JUMPL FF,[ETASM [ASCIZ /Externals in =/]] + CALL ESDCHK ;SEARCH SYM TAB. + JRST EQL2 ;NOT FOUND IN CURRENT OR CONTAINING BLKS. + HRRZI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQG1A + XCT EQG1TB(A) ;FOUND IN DESIRED BLOCK. + JRST ASSEM1 + +EQG1A: JUMPN T,EQG2 + CAIN A,PSUDO_-16 ;FOUND AS INITIAL PSEUDO => ERROR. + ETSM ERRQPA +EQG2: CALL DEFCHK ;FIND FREE STE TO DEFINE IN DESIRED BLOCK. + JRST EQL2 ;PRETEND WASN'T FOUND. + +ERRQPA: ASCIZ /Shadowing a pseudo-op/ +ERRIPA: ASCIZ /Illegal =/ + +EQG1TB: ETSM ERRIPA ;COMMON + ETSM ERRIPA ;PSEUDO OR MACRO + JRST EQL2 ;SYM + JRST EQGUL ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL7 ;GLO ENTRY + JRST EQL8 ;GLO EXIT + +EQL8: PUSHJ P,GLKPNR + TLZ C,3LABEL\3MULTI +EQL7: MOVSI T,GLOETY ;GLOBAL PARA ASSIGN + MOVEI B,0 + TLO SYM,40000 +LOPRA1: PUSH P,CASM1A ;RETURN TO ASSEM1A AFTER FOLLOWING. + TLNE C,3MULTI + ETSM ERRMDT + SKIPE LABELF + TLO C,3LABEL + TLNE FF,FLHKIL + TLOA SYM,400000 ;SET FLAG TO HALF-KILL SYM + TLZA C,3SKILL + TLO C,3SKILL ;SET CORRESPONDING FLAG IN 3RDWRD + PUSHJ P,VSM2LV + JUMPGE FF,CPOPJ ;JUMP ON NOT PUNCHING PASS + TRNN I,IREQL ;IF CAME FROM COLON ROUTINE, + JRST PDEFPT ;PUNCH "DEFINE SYM AS $.". + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D ;STORE UPDATED 3RDWRD + PUSHJ P,EBLK + MOVEI TT,LGPA + DPB TT,[310700,,BKBUF] + PUSHJ P,OUTSM0 + PUSHJ P,PWRDA + JRST EBLK + +EQGUL: PUSHJ P,LKPNRO ;LOCAL UNDEF, OUTPUT LINK REQUEST. + TLZ C,3LABEL\3MULTI ;CAN'T DETECT MDT'S WHEN ONLY STINK KNOWS FOR SURE. +EQL2: TLNE I,ILGLI + JRST EQL7 ;MAKE IT GLOBAL + MOVSI T,LCUDF ;LOCAL UNDEFINED + JRST LOPRA1 + +CASM1A: JRST ASEM1A + +;MAYBE PUNCH OUT LINK REQUEST +;SYM HAS NAME OF SYM TO REQUEST, D STE IDX OF SYM, C 3RDWRD, B ADR OF REQUEST +;REQUEST WILL BE PUNCHED IF 3RLNK SET IN C OR IF ANYTHING SET IN LH(B) + +GLKPNR: TLO SYM,40000 ;GLO BIT +LKPNRO: TLNN C,3RLNK + TLNE B,-1 + TROA I,IRCONT + POPJ P, ;DON'T PUNCH REQUEST + MOVE A,CONTRL + TRNE A,DECREL + JRST LKPNDR ;DIFFERENT WAY TO OUTPUT THIS INFO IN DECREL FMT + MOVEI A,6 + PUSHJ P,PBITS + PUSHJ P,OUTSM0 ;PUNCH SYM + HLRZ A,B + TLZE C,3RLNK ;RELOC OF LINK PNR + TLO A,100000 + HRRZS B ;CLEAR OUT LH OF B + TRZ I,IRCONT ;OK TO END BLOCK NOW + JRST $OUTPT ;PUNCH OUT A AND RETURN + +LKPNDR: MOVSI A,DECINT ;WRITE AN "INTERNAL REQUEST" WITH ONE DATA WORD. + CALL DECBLK + SETZ TM, ;COMPUTE RELOC OF ADDRESS AND DATA IN TM. + TLNE C,3RLNK + TRO TM,2 + SKIPE WRDRLC + TRO TM,1 + MOVE A,WRD ;ADDRESS TO LINK,,DATA + HRL A,B + CALL DECWR1 + JRST EBLK + +;THESE ASSUME STE IDX IN D, SQUOZE W/ FLAGS IN SYM. +;C HAS 3RDWRD, B OR WRD HAS VALUE TO DEF. WITH. +;CALL ONLY IN RELOCATABLE ASSEMBLY. +OUTDE2: MOVEM B,WRD +OUTDE1: TLNE FF,FLPPSS + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D + SKIPGE CONTRL + RET + TRO I,IRCONT + SETZ A, + TLNN C,3LABEL ;WHAT KIND OF DEFINITION DEPENDS ON WHETHER SYM IS REDEFINABLE. + MOVEI A,CRDF + CALL P7X ;PUNCH OUT CODE BITS + PUSHJ P,GTVL7B ;SET RELOCATION BITS IN SQUOZE + PUSHJ P,OUTSM0 + TRZ I,IRCONT + JRST OUTWD ;OUTPUT VALUE + +;PUNCH OUT LOCAL-GLOBAL RECOVERY BITS AND SYM +;I.E. TELL LOADER THAT SQUOZE IN SYM, FORMERLY CONSIDERED LOCAL, IS REALLY GLOBAL +PLOGLO: SKIPGE CONTRL + RET + PUSH P,A + PUSHJ P,PBITS7 + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY THIS IS NEW STYLE RQ, + PUSHJ P,OUTSM0 ;PUNCH "OLD NAME" = SYMTAB IDX, + TLC SYM,440000 ;SAY MAKE GLOBAL, OUTPUT ACTUAL NAME OF SYM. + PUSHJ P,OUTSM + JRST POPAJ + +;NO GLOBALS TO RIGHT OF EQUAL SIGN + +EQL1: PUSHJ P,ESDCHK + JRST EQL1A ;NOT FOUND +IFN CREFSW,XCT CRFEQL ;DEF. OCCUR. OF NORMAL SYM. OR INTSYM. + MOVEI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQL1F + SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL + XCT EQL1TB(A) ;FOUND IN DESIRED BLOCK => NOW REDEFINE. + JRST ASSEM1 + +EQL1F: JUMPN T,EQL10 + CAIE A,PSUDO_-16 + JRST EQL10 + MOVEI T,(B) ;FOUND AS PSEUDO IN INITIAL SYMS BLOCK, + CAIN T,INTSYM ;SPECIAL WAY TO REDEFINE IF LIKE .MLLIT, ETC. + JRST EQLINT + ETSM ERRQPA ;SHADOWING AN INITIAL PSEUDO, TELL USER. +EQL10: CALL DEFCHK ;FOUND IN OUTER BLOCK, GET NEW STE, + JRST EQL1A ;DEFINE THERE AS IF NOT FOUND. + +EQL1TB: ETSM ERRIPA ;COMMON + JRST EQL1B2 ;PSEUDO OR MACRO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL1D ;GLO ENTRY + JRST EQL1E ;GLO EXIT + +EQL1E: PUSHJ P,GLKPNR ;DUMP LINKING POINTER + CAIA +EQL1D: CALL MDTCHK + PUSHJ P,RCHKT ;GLO ENTRY +EQLB2: PUSHJ P,RMOVET + TLNE FF,FLHKIL + TLOA SYM,400000 + TLZA C,3SKILL + TLO C,3SKILL + HRLZI T,GLOETY + SKIPE LDCCC ;IF IN LOADER CONDITIONAL, + TLO C,3LLV ;THEN LOADER MUST SUPPLY VALUE + PUSHJ P,VSM2W ;DEFINE SYM + TLO SYM,40000 ;SET GLOBAL BIT IN SQUOZE +EQL1CE: JUMPGE FF,ASEM1A + PUSHJ P,OUTDE1 +ASEM1A: TLNE I,ILMWRD + PUSHJ P,IGTXT + JRST ASSEM1 + +;CHECK WHETHER DEFINING AN MDT, OR REDEFINING A LABEL (=> THIS IS AN MDT) +MDTCHK: TLNN C,3LABEL + JRST MDTCH1 + CALL GVSYM0 ;MOVE VALUE OF SYM TO A, GET RELOC (WRDRLC STYLE) IN B + CAMN A,WRD + CAME B,WRDRLC ;IF WE'RE CHANGING THE VALUE, MARK SYM AS MDT +MDTCHL: TLO C,3MULTI +MDTCH1: TLNE C,3MULTI ;EVER ASSIGNING TO MDT, EVEN SAME VALUE, GIVES ERR MSG + ETSM ERRMDT + RET + +EQL1C: TLNE I,ILGLI + JRST EQL1CA ;MAKE GLOBAL + PUSH P,C + PUSHJ P,LKPNRO ;MAYBE OUTPUT LINK REQUEST + PUSHJ P,RCHKT + PUSHJ P,RMOVET ;INITIALIZE 3RDWRD + MOVSI T,SYMC ;SYM + PUSHJ P,EQA2A ;ENTER DEF IN SYMTAB + TLNE C,3SKILL + TLO SYM,400000 + POP P,AA + TLNE AA,3VCNT ;USED IN CONSTANT + PUSHJ P,CONBUG + JRST EQL1CE + + ;PUNCH OUT CODE BIT PAIR, FIRST OF WHICH IS 7 + +P7X: MOVEM A,PARBIT ;ENTRY FOR SECOND BYTE IN A +P70: PUSHJ P,PBITS7 ;ENTRY FOR SECOND BITE IN PARBIT, PUNCH OUT THE 7 + SKIPA A,PARBIT ;GET SECOND BYTE BACK +PBITS7: MOVEI A,7 ;ENTRY TO JUST PUNCH OUT 7 + JRST PBITS + +EQL1CA: PUSHJ P,PLOGLO + JRST EQL1E +EQA2: PUSH P,CASM1A +EQA2A: TLNE FF,FLHKIL + TLO C,3SKILL + JRST VSM2W + +EQL1B2: HRRZ A,B ;ATTEMPT TO ASSIGN PSEUDO-OP, IS IT AN INTSYM? + CAIN A,INTSYM + JRST EQLINT ;YES, GO SET WD IT POINTS TO. + ETSM [ASCIZ /Pseudo or macro ='D/] +EQL1B: CALL MDTCHK + PUSHJ P,RCHKT + TLNE I,ILGLI + JRST EQLB2 ;WAS LOCAL, MAKE IT GLOBAL + ;WAS LOCAL, LEAVE IT LOCAL + PUSHJ P,RMOVET ;PUT RELOCATION BITS IN BITS 0 AND 1 OF C (I.E. START SETTING UP 3RDWRD) + MOVSI T,SYMC ;SYM + JRST EQA2 + +EQL1A1: PUSHJ P,RCHKT + PUSHJ P,RMOVET + HRLZI T,SYMC + JRST EQA2 + +EQL1A: SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL +IFN CREFSW,XCT CRFLBL ;DEF. OCCUR. OF NORMAL SYM. + TLNN I,ILGLI + JRST EQL1A1 + JRST EQL1E + +EQLINT: HLRZS B ;GET ADDR OF WD HOLDING VALUE. + MOVEMM (B),WRD ;PUT NEW VALUE IN IT. + JRST ASEM1A + +;;. ;ROUTINES DEALING WITH THE CURRENT LOCATION AND OFFSET + +VBLK +CLOC: 0 ;PUNCHING LOC +CRLOC: 0 ;PUNCHING RELOC +OFLOC: 0 ;OFSET VAL +OFRLOC: 0 ;OFSET RELOC +;VAL OF PT=CLOC+OFLOC,CRLOC+OFLOC +SYLOC: 0 ;VAL OF LAST TAG +SYSYM: 0 ;LAST TAG +SYLOC1: 0 ;VALUE OF NEXT TO LAST TAG +SYSYM1: 0 ;NEXT TO LAST TAG +GLOCTP: 0 ;4.9 => CURRENT LOCATION GLOBAL, 2.9 => OFFSET GLOBAL + ;FRGLOL (FLAG IN FF) IS IOR OF BITS 4.9 AND 2.9 OF GLOCTP + ;EXCEPT AFTER .=NON-GLOBAL WITH GLOBAL OFFSET + ;OTHER BITS USED ONLY WHEN IN LINK (NEVER SET IN GLOCTP): + ;400 => ARG GLOBAL +PBLK + + + ;POINT (.) AS PSEUDO-OP + +GTVLP: TRNE FF,FRGLOL + JRST GTVLP2 ;LOCATION GLOBAL + MOVE B,OFRLOC ;GET RELOCATION OF OFFSET + ADD B,CRLOC ;ADD CURRENT RELOCATION + MOVE A,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 ;IF IN BYTE MODE, + HLL A,BYTWP ;SET LEFT HALF TO BYTE POINTER LEFT HALF FOR ILDB + ADD A,OFLOC ;NOW ADD OFFSET + TLZ I,ILFLO+ILDECP+IRPERI ;CLEAR OUT FLAGS SET WHEN LOOKED LIKE FLOATING POINT NUMBER + POPJ P, + + +GTVLP2: MOVEI T,$.H ;LOCATION GLOBAL + AOS GLSP1 + HRRZM T,@GLSP1 ;PUT $. ON GLOBAL LIST (INCLUDES OFFSET, WHETHER GLOBAL OR NOT) + SKIPL BYTM1 ;IN BYTE MODE? + TDZA A,A ;NO, CLEAR ABS PART OF VALUE + HLLZ A,BYTWP ;YES, USE LH(BP) AS ABS PART + JRST CLBPOP + +$.H: (GLOETY)+SQUOZE 0,$. ;CURRENT LOCATION + OFFSET IN LOADER +$L.H: (GLOETY)+SQUOZE 0,$L. ;LOCATION BEING LOADED INTO BY LOADER, USED BY ABLOCK +$O.H: (GLOETY)+SQUOZE 0,$O. ;LOADER OFFSET +$R.H: (GLOEXT)+SQUOZE 0,$R. ;RELOCATION AS GLOBAL + +COLON: TRNE I,IRLET + TRNN I,IRSYL + ETA [ASCIZ/Colon without preceding symbol/] + TLNN I,ILWORD + TRNE I,IROP+IRPSUD+IREQL+IRNOEQ + ETSM [ASCIZ/Label inside an expression/] + SKIPE ASMOUT + ETSM [ASCIZ /Label inside <>, () or []/] + TLZ FF,FLHKIL + PUSHJ P,RCH ;GET NEXT CHAR + CAIN A,": ;IF NEXT CHAR ANOTHER COLON, + TLOA FF,FLHKIL ;THEN SET FLAG TO HALF-KILL + TLO FF,FLUNRD ;NOT COLON, CAUSE IT TO BE RE-INPUT + SKIPE HKALL ;CHECK FOR HALF-KILL-ALL-LABELS MODE. + TLO FF,FLHKIL + MOVE T,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 + HLL T,BYTWP ;BYTE MODE, SET LEFT HALF OF VALUE TO LEFT HALF OF BYTE POINTER + ADD T,OFLOC ;ADD OFFSET + MOVEM T,WRD ;STORE RESULT AWAY FOR POSSIBLE PUNCHOUT + EXCH T,SYLOC ;NOW SET UP STUFF FOR ERROR PRINTOUT + MOVEM T,SYLOC1 + EXCH SYM,SYSYM + MOVEM SYM,SYSYM1 + MOVE SYM,SYSYM + MOVE A,CRLOC ;SET UP RELOCATION + ADD A,OFRLOC + MOVEM A,WRDRLC + SETOM LABELF ;SET FLAG CAUSING 3LABEL (DON'T REDEFINE) TO BE SET. + SKIPN LDCCC + TRNE FF,FRGLOL + JRST GCOL1 ;LOCATION VIRTUAL OR IN LOAD TIME CONDITIONAL + PUSHJ P,ESDCHK ;TRY FINDING CURRENT ENTRY IN ST + JRST EQL1A ;NOT ALREADY DEFINED +IFN CREFSW,XCT CRFLBL +COLON1: MOVEI T,(C) ;BKTAB IDX OF BLOCK FOUND IN, + CAIE T,(TM) ;FOUND IN DESIRED BLOCK => TRY REDEFINING. + JRST COLON3 + TLO C,3LABEL ;CAUSE REDEFINING SYMBOL TO BARF + XCT COLON2(A) ;BUT MAYBE PRINT ERR MSG FIRST. + JRST EQL1B + +CASSM1: JRST ASSEM1 + +COLON3: JUMPN T,EQL10 ;NOT INITIAL SYM => CAN SHADOW, + CAIN A,SYMC_-14. ;INITIAL SYM => CAN SHADOW IF IT'S AN ORDINARY LOCAL SYM + CAME B,WRD ;AND NEW VALUE SAME AS OLD VALUE. + CAIA + SKIPE WRDRLC + ETSM ERRRES ;ELSE GIVE ERROR MESSAGE BEFORE SHADOWING, TO WARN USER. + JRST EQL10 + +ERRRES: ASCIZ /Pseudo, macro or initial sym as label/ +ERRMDT: ASCIZ /Multiply defined/ + +COLON2: TLO C,3MULTI ;COMMON + ETSM ERRRES ;MACRO OR PSEUDO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI ;SETTING 3MULTI CAUSES EQL1B TO PRINT AN MDT ERROR. + JRST EQL1D ;GLOBAL ENTRY + JRST EQL1E ;GLO EXIT + +;COLON WHEN LOCATION VIRTUAL, OR IN LOAD TIME CONDITIONAL + +GCOL1: IFN CREFSW,XCT CRFLBL ;DEFINING ORDINARY SYM. + SKIPGE CONTRL + ETASM [ASCIZ /Virtual label in abs assembly/] + PUSHJ P,ESDCHK ;FIND ITS SLOT IN ST + JRST EQL2 ;JUST LIKE EQG1 EXCEPT FOR ERROR MESSAGES. + MOVEI T,(C) + CAIE T,(TM) + JRST COLON5 + XCT GCOL1T(A) ;FOUND IN DESIRED BLOCK, REDEFINING. + JRST EQL2 + +COLON5: JUMPN T,EQG2 ;SHADOWING, OK UNLESS INITIAL SYM. + ETSM ERRRES + JRST EQG2 + +GCOL1T: TLO C,3MULTI ;COMMON + ETSM ERRRES ;PSEUDO. + JRST EQL2 ;SYM. + JRST EQGUL ;LOCAL UNDEF. + TLO C,3MULTI ;VAR + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + JRST EQL7 ;DEF GLO + JRST EQL8 ;UNDEF GLO. + + + ;PUNCH OUT "DEFINE SYM AS $." + +PDEFPT: MOVEI A,CDEFPT + PUSHJ P,P7X ;OUTPUT 7 THEN PDEFPT + JRST OUTSM0 ;OUTPUT SYM, WITHOUT BITS + +;LOC, BLOCK, .= + +ALOC: PUSHJ P,ALOCRG ;LOC, GET ARG +ALOC1: SETZM SYLOC ;CLEAR OUT LOC OF LAST TAG + SETZM SYSYM ;CLEAR OUT LAST TAG SO ERROR MESSAGES DON'T PRINT OBSCENE INCREMENTS +IFN FASLP,[ + SKIPGE TM,CONTRL + TRNN TM,FASL + JRST .+2 + ETA [ASCIZ /LOC illegal in FASL assembly/] +] + TRZE LINK,400 ;GLOBALS IN ARG? + JRST ALOC2 ;YES + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF CURRENT LOCATION + CALL SLOCF ;RE-INIT NEXT OUTPUT BLOCK'S HEADER; SET LOCF. + MOVEI A,LCEGLO ;=> RESET GLOBAL RELOCATION (BACK TO ORIGINAL NON-GLOBAL RELOCATION) + TLZE LINK,400000 ;IS CURRENT LOCATION NOW GLOBAL? + PUSHJ P,PLDCM ;YES, RESET IT + MOVE B,WRDRLC ;GET BACK NEW RELOCATION +ALOC2B: TRZE B,-2 ;NO BITS ALLOWED EXCEPT LOW ORDER + ETR [ASCIZ *Illegal relocation in LOC/BLOCK/.=*] + HRRZM B,CRLOC ;STORE NEW RELOCATION + SKIPGE CONTRL + JRST ASSEM1 ;DON'T BOTHER WITH REST IF ABS. + MOVEI B,2(B) ;LABS OR LREL + DPB B,[310700,,BKBUF] ;STORE NEW BLOCK TYPE + MOVEM B,CDATBC ;ALSO STORE AS NORMAL BLOCK TYPE +AOFSTX: TDNN LINK,[SETZ(SETZ)] ;ENTRY FROM AOFFSET, SKIP IF FRGLOL SHOULD BE SET + TRZA FF,FRGLOL ;CURRENT LOCATION PLUS OFFSET NOT GLOBAL, CLEAR FLAG + TRO FF,FRGLOL ;GLOBAL, SET FLAG + TRZ LINK,600 ;CLEAR OUT TEMPORARY FLAGS SO WON'T GET STORED IN GLOCTP + MOVEM LINK,GLOCTP ;STORE BACK STATUS FLAGS + JRST ASSEM1 + +PTEQ: MOVE SYM,[SQUOZE 0,LOC] + PUSHJ P,ALOCRG ;.=, GET ARG + MOVE T,[MINF+HFWDF,,$O.H] ;GLOTB ENTRY IF .+1 DOESN'T SKIP + TRNE LINK,400000 ;OFFSET GLOBAL? + JRST PTEQ2 ;YES, WANT TO DO LOC ARG-$O." + PUSHJ P,SBWDOF ;OFFSET IS LOCAL, SUBTRACT FROM ARG + JRST ALOC1 + +ABLOCK: PUSHJ P,ABLKRG ;GET ARG TO "BLOCK" PSEUDOOP. + TRNE LINK,400 ;GLOBALS IN ARG? + JRST ABLKG ;GLOBALS IN ARG + TLNE LINK,400000 + JRST ABLKG ;JUMP IF LOSER CHANGING RELOCATION WHILE CLOC GLOBAL +IFN FASLP,[ + MOVE D,CONTRL + TRNN D,FASL ;IN FASL FORMAT, CAN'T SET LOC. CTR., + JRST ABLKF1 + SKIPE B + ETA [ASCIZ /BLOCK size relocatable/] + JUMPGE FF,ABLKF1 + CALL ABLKF ;SO ON PASS 2 OUTPUT A BUNCH OF ZEROS. + JRST ABLKF1 + +;OUTPUT C(A) ZEROS, IN FASL FORMAT. NO-OP ON PASS 1. DOESN'T SET THE LOCATION COUNTER. +ABLKF: JUMPE A,CPOPJ + JUMPGE FF,CPOPJ + SETZM WRD + SETZM WRDRLC + PUSH P,A + PUSH P,A +ABLKF2: CALL FASPW + MOVEMM GLSP2,GLSP1 + SOSE (P) + JRST ABLKF2 + JRST POPBAJ +] + +ABLKF1: JUMPL A,[ETA [ASCIZ /BLOCK size negative/]] + ADD A,CLOC ;ARG TO BLOCK IS LOCAL, ADD DIRECTLY TO CLOC + ADD B,CRLOC ;ALSO ADD RELOCATIONS + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF LOCATION + CALL SLOCF ;FALL INTO ALOC ROUTINE, MAKING SURE FRLOC GETS SET + JRST ALOC2B + + +SBWDOF: SUB A,OFLOC ;SUBTRACT OFFSET FROM WRD, ETC. IN A,B + HRRZM A,WRD ;MAKE SURE RESULT GETS STORED IN WRD, AS WELL AS AC'S + SUB B,OFRLOC ;NOW DO RELOCATIONS + HRRZM B,WRDRLC + POPJ P, + +ABLKG: TRNE LINK,400000 ;GLOBAL BLOCK, IS OFFSET GLOBAL? + JRST ABLKG2 ;YES, OK TO REFERENCE $L. + PUSHJ P,SBWDOF ;NO, FOR COMPATIBILITY, DON'T REFERENCE $L. + SKIPA T,[HFWDF,,$.H] +ABLKG2: MOVE T,[HFWDF,,$L.H] +PTEQ2: AOS GLSP1 ;STORE T IN GLOTB + MOVEM T,@GLSP1 +ALOC2: TLO LINK,400000 ;SET GLOBAL LOCATION FLAG + MOVEI A,LCGLO ;=> GLOBAL LOCATION ASSIGNMENT + PUSHJ P,PLDCM ;PUNCH OUT GLOBAL LOCATION ASSIGNMENT + SETZM CLOC ;CLEAR OUT CLOC, NEW RELOCATION NOW + SETZB B,BKBUF ;ALSO CLEAR OUT HEADER, JUST TO BE SURE + AOJA B,ALOC2B ;SET RELOCATION TO 1 AND FALL IN + +AOFFSET: PUSHJ P,AOFFS2 ;OFFSET, GET ARG + MOVE A,T + MOVEM A,WRD ;RESTORE UNTRUNCATED ARG. + TRZE LINK,400 ;GLOBALS IN ARG? + TROA LINK,400000 ;GLOBALS IN ARG, SET GLOBAL OFFSET FLAG + TRZ LINK,400000 ;NO GLOBALS IN ARG + MOVEM A,OFLOC ;STORE NEW OFFSET + MOVEM B,OFRLOC ;ALSO STORE RELOCATION BITS + SKIPGE CONTRL ;IN RELOCATABLE, + JRST AOFSTX + MOVEI A,LDOFS ;LOADER OFFSET LOADER COMMAND TYPE + PUSHJ P,PLDCM ;PUNCH OUT LOADER COMMAND + JRST AOFSTX + +;GET ARG TO LOC, BLOCK, .=, OFFSET + +ALOCRG: +ABLKRG: MOVE A,CLOC + SKIPN CRLOC + JRST [ CAML A,DECBRA ;IF ADDR BEFORE THE LOC WAS ABS, + MOVEM A,DECBRA ;UPDATE HIGHEST ABS ADDR IF NEC. + JRST ABLKR1] + CAML A,DECTWO ;IT WAS RELOCA; UPDATE HIGHEST + JRST [ CAML A,DECBRH ;ADDR OF APPROPRIATE SEG. + MOVEM A,DECBRH + JRST ABLKR1] + CAML A,DECBRK + MOVEM A,DECBRK +AOFFS2: +ABLKR1: PUSH P,SYM + PUSHJ P,CONBAD ;ERROR IF IN GROUPING + REST SYM + TRNE I,IRNOEQ\IRPSUD\IREQL + ETSM [ASCIZ /Inside pseudo or =/] + TDNE I,[ILWORD,,IRFLD] + ETSM ERRNVL + PUSHJ P,EBLK ;MAYBE END CURRENT OUTPUT BLOCK + PUSHJ P,AGETWD ;GET ARG + MOVE LINK,GLOCTP ;GET GLOCTP FLAGS IN LINK, STAYS THERE UNTIL ALMOST DONE + MOVE T,GLSP2 + CAME T,GLSP1 + TROA LINK,400 ;SIGNAL GLOBAL ARG + TRZ LINK,400 ;LOCAL + MOVE T,A ;SAVE UNTRUNCATED FOR AOFFSET, + HRRZS A,WRD ;TRUNCATE FOR LOC, BLOCK, .=. + TRNN I,IRDEF ;ALL DEFINED? + JRST ASSEM1 + SKIPGE CONTRL ;YES, RETURN SKIPPING OVER ARG + TRNN LINK,400 + RET + MOVE SYM,GTVER + ETASM [ASCIZ *Argument has externals*] + +;;CONSTANTS AND VARIABLES + ;VARIABLES AREA +VBLK + +LCNGLO==CONMIN/4 +LCONTB==CONMIN + +BLCODE [ +PCNTB: BLOCK NCONS*3 ;CONSTANTS AREAS TABLE +VARTAB: BLOCK NVARS +] +CONTBA: CONTAB ;ADDRESS OF BEGINNING OF CONSTANTS TABLE. +CONTBE: CONTAB+LCONTB ;ADDRESS OF WORD AFTER END OF CONSTANTS TABLE. +PLIM: 0 ;POINTER TO FIRST UNUSED WORD IN CONSTANTS TABLE. + +CONGLA: CONGLO ;ADDRESS OF BEGINNING OF CONSTANT-GLOBALS TABLE. +CONGLE: CONGLO+LCNGLO ;ADDRESS OF WORD AFTER END OF CONSTANT GLOBALS TABLE. +CONGOL: 0 ;HAS ADR OF FIRST WORD INACTIVE IN CONSTANT-GLOBALS TABLE. + +CONBIA: CONBIT ;ADDRESS OF BEGINNING OF CONSTANT-RELOCATION-BITS TABLE. + +CONLEN: CONMIN ;TOTAL SPACE ALLOCATED TO CONSTANTS TABLES. + ;ALL THE HOOKS ARE IN FOR DYNAMIC ALLOCATION OF THESE TABLES + ;(CONTAB, CONGLO, AND CONBIT). ALL THAT IS NEEDED IS TO GET + ;THE SPACE AND INITIALIZE CONTBA, CONTBE, CONGLA, CONGLE, CONBIA. + + ;PCNTB STUFF + + ;EACH ENTRY 3 WORDS; FIRST WORD SQUOZE, NAME OF AREA IF GLOBAL +CSQZ: 0 ;SQUOZE COUNTER + ;SECOND WORD RH LOC OF AREA (WITH OFFSET), LH LOC FIRST AFTER AREA (WITHOUT OFFSET) + ;THIRD WORD LH FLAGS + +CGBAL==100000 ;GLOBAL (INCLUDING OFFSET) +CTRL==200000 ;RELOCATED ( " ) +CTDEF==400000 ;DEFINED (MUST BE SIGN) + +PBCON: 0 ;POINTER INTO PCNTB, HAS ADR OF ENTRY FOR NEXT CONSTA +PBCONL: 0 ;POINTER TO ABSOLUTE TOP OF PCNTB +CONCNT: 0 ;NUMBER OF TIMES CONSTANTS CAN APPEAR (DECREMENTED BY CONSTA) +CONDEP: 0 ;DEPTH IN CONSTANTS (0 TOP LEVEL) +CONSAD: 0 ;ADDR IN CONSTANTS TABLE OF ENTRY FOR CURRENT CONST. +CONSML: 0 ;VALUE OF .MLLIT INTSYM. + ;NEGATIVE => ERROR MODE (DEFAULT) + ;ZERO => OLD MODE. + ;POSITIVE => NEW (MULTI-LINE) MODE. + +CONSTP: 0 ;PDL POINTER BELOW WDS FOR INNERMOST CONSTANT. +CONSP1: 0 + + ;VARIABLES FOR VARIABLES CODING + +VARCNT: 0 ;NO OF VAR IN CURRENT VAR AREA SO FAR +VARPNT: 0 ;POINTER TO CURRENT PLACE IN VARTAB +VARCNR: 0 ;NO OF TIMES VARIABLES MAY APPEAR +VCLOC: 0 ;TEM FOR VARIAB +VECSIZ: 0 ;DEFAULT SIZE FOR .VECTOR. + +PBLK + +;LEFT-BRACKET ENCOUNTERED; HERE ON DISPATCH FROM GETFD +;SAVE WORLD, BYTE MODE, ASSEM1 PDL LEVELS. +;THEN SET ASSEM1 PDL LEVELS TO CURRENT LEVELS +;SO ASSEM1 WON'T FLUSH PAST LEVEL OF CONSTANT. +;SET CONSTP _ CURRENT PDL LEVEL. PCONS WILL PUT WORDS +;OF CONSTANT ABOVE CONSTP, AND SET ASSEMP ABOVE THEM. + +LBRAK: SKIPE LITSW + ETR [ASCIZ /Literal/] + TRO I,IRFLD ;LEFT BRACKET + JSP LINK,SAVWD1 ;SAVE CRUFT + PUSH P,SCNDEP ;SO THE NEXT RBRKT WON'T TRY TO CLOSE CONDIT. + JSP LINK,SAVAS1 + MOVEIM ASMOUT,3 + SETZM SCNDEP ;NOT WITHIN CONDITIONALS IN THIS LITERAL. + AOS CONDEP ;ONE DEEPER IN LITERALS. + JRST ASSEM3 ;GO ASSEMBLE THE WORDS OF THE CONSTANT. + +;OUTPUT WORD TO CONSTANT. P MUST EQUAL ASSEMP HERE. +PCONS: SKIPL CONTRL ;IF RELOCATABLE, + PUSHJ P,$RSET ;HANDLE STRANGE RELOCATIONS. + MOVE B,GLSP1 + SUB B,GLSP2 ;NUM. GLOBAL ENTRIES FOR THIS WD. + HLRZ A,WRDRLC ;ONLY 1.1 AND 3.1 BITS MATTER. + LSH A,1 + IOR A,WRDRLC ;GET THEM INTO 1.1, 1.2 BITS. + TLNE I,ILNOPT ;REMEMBER ILNOPT ALSO. + IORI A,4 + DPB B,[032200,,A] ;AND # GLBLS. + PUSH P,A ;SAVE THEM ALL. + HRLI B,(B) ;GET # GLBLS,,# GLBLS . + JUMPE B,PCONS1 + MOVE A,GLSP2 + MOVSI A,1(A) + HRRI A,1(P) ;SAVE THE GLBLS, IF ANY. + ADD P,B + JUMPGE P,CONFLP + BLT A,(P) +PCONS1: PUSH P,WRD + MOVEM P,ASSEMP ;ASSEMP -> ABOVE WDS FOR LIT.; CONSTP, BELOW. + JRST (T) + +;JSP LINK,SAVAS1 TO PUSH DATA ON ASSEM1 LEVEL AND CALL ASSEM1 +;LOOP RECURSIVELY. +.SEE CONNDP ;WHICH IS WHERE THESE THINGS ARE POPPED. +SAVAS1: SKIPN BYTM ;IF IN BYTM NOW (WILL PUSH AND TURN OFF) + JRST LBRAK1 + MOVSI A,BYBYT ;SAVE ALL THE DETAILS. + HRRI A,1(P) + ADD P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] + JUMPGE P,CONFLP ;(SOFTWARE-DETECTED PDL-OV) + BLT A,-BYTMCL(P) + MOVSI A,BYTMC + HRRI A,1-BYTMCL(P) + BLT A,(P) +LBRAK1: PUSH P,BYTM + SETZM BYTM + PUSH P,ASMOUT + PUSH P,ASMDSP + PUSH P,ASMI + PUSH P,GLSPAS ;SAVE ASSEM1 PDL LEVELS. + PUSH P,ASSEMP + PUSH P,CONSTP + MOVE A,I + ANDI A,IRPSUD+IREQL + IORI A,IRDEF + MOVEM A,ASMI ;ASMI IOR'D INTO I AT ASSEM2 LOOP. + HRRZ A,CPGN + HRL A,CLNN ;REMEMBER WHERE THIS LITERAL STARTS. + INSIRP PUSH P,[A SYSYM SYLOC] + MOVEM P,ASSEMP ;SO ASSEM1 WON'T FLUSH WHAT WE PUSHED. + MOVEM P,CONSTP ;SO CONND CAN FIND 1ST WD OF CONSTANT. + MOVEMM GLSPAS,GLSP1 +SAVAS2: MOVEI A,ASSEM3 ;IF NOT MULTI-LINE MODE, ARRANGE TO + SKIPG CONSML ;END THE CONSTANT AFTER 1 WORD. + MOVEI A,ASSEMC + MOVEM A,ASMDSP + JRST (LINK) + +PCONST: MOVE CH1,ASMDSP ;OUTPUT TO CONST. FROM ASSEM1 + CAIN CH1,CONND ;LAST WD OF CONST? + CAME P,CONSTP ;1ST WD? + JRST PCONS ;NO, DO THE GENERAL THING. + SKIPL CONTRL ;THIS MUST BE ONLY WORD OF CONST, + PUSHJ P,$RSET ;DON'T BOTHER PUSHING, END CONST. NOW. + PUSH P,CONSTP + TLZ I,ILMWRD+ILMWR1 ;THIS IS 1ST WD, NO MORE WDS. + JRST CONND3 ;PRETEND JUST POPPED IT. + +;COME HERE FROM ASSEM1 TO END A CONSTANT. +CONND: SKIPE BYTM ;IF IN BYTE MODE, LEAVE IT AND DO .WALGN + JRST A.BY3 ;(WILL COME BACK SINCE ASMDSP STILL SET) +CONNDW: MOVEMM CONSP1,CONSTP + TLZ I,ILMWR1 ;THIS IS 1ST WORD COMING UP. +CONND0: TLZ I,ILMWRD+ILNOPT + SETZM WRDRLC + MOVE F,CONSP1 ;ADDR IN IN PDL OF NEXT WD. + CAMN F,ASSEMP + JRST CONND2 ;J IF NO WORDS. + MOVE A,1(F) ;GET SAVED NUM GLBLS,,NUM GLBLS + DPB A,[100,,WRDRLC] + LSH A,-1 ;RESTORE WRDRLC BITS 1.1, 3.1 + DPB A,[220100,,WRDRLC] + TRNE A,2 + TLO I,ILNOPT ;RESTORE NOOPTF. + LSH A,-2 ;GET # GLBLS. + HRLI A,(A) ;# GLBLS,,# GLBLS. + AOBJN F,.+1 + HRRZM F,GLSP2 ;ADDR BEFORE 1ST GLOBAL ENTRY. + ADD F,A + HRRZM F,GLSP1 ;ADDR OF LAST GLOBAL ENTRY. + MOVE A,1(F) + MOVEM A,WRD + AOBJN F,.+1 ;POINT TO NEXT CONST WD IF ANY, + MOVEM F,CONSP1 + CAME F,ASSEMP ;IF MORE WORDS SET ILMWRD + TLO I,ILMWRD + JRST CONND3 + +CONND2: INSIRP SETZM,[WRD,GLSP1,GLSP2] +CONND3: MOVE F,GLSP1 + SUB F,GLSP2 + JUMPE F,SCON ;JUMP IF NOTHING VIRTUAL + MOVEI B,-1(F) + MOVN TT,B + JUMPE B,SCON ;JUMP IF ONLY ONE GLOBAL + ;SORT GLOTB ENTRIES THIS CONSTANT +LSORT: HRL T,TT ;SET UP AOBJN POINTER TO GLOBALS REMAINING + HRR T,GLSP2 +LSORT2: MOVE A,1(T) + CAMLE A,2(T) + EXCH A,2(T) ;INTERCHANGE + MOVEM A,1(T) + AOBJN T,LSORT2 ;INNER LOOP POINT + SOJG B,LSORT ;OUTER LOOP + ;DROPS THROUGH + +;DROPS THROUGH +SCON: PUSHJ P,RCHKT + PUSHJ P,RMOVET ;SET UP RELOACTION BITS. + ROT T,2 ;ROTATE TO BOTTOM TWO BITS OF T + TLNE I,ILMWRD+ILMWR1+ILNOPT + JRST NOCON ;MULTIPLE WORD OR OPTIMIZATION SUPPRESSED, DON'T TRY TO FIND MATCH + MOVE A,CONTBA +SCON1: CAML A,PLIM ;SEARCH CONSTANTS TABLE TO SEE IF ALREADY THERE + JRST NOCON ;END OF TABLE, NO MATCH + MOVE B,WRD + CAME B,(A) +SCON2: AOJA A,SCON1 ;VAL DISAGREES + PUSHJ P,CPTMK ;GET BP TO CONSTANTS-BIT TABLE IN C + LDB F,C ;GET RELOCATION BITS THIS CONSTANT + CAME F,T + JRST SCON2 ;RLC DIFFRS + MOVE B,CONGLA ;VALUE AND RELOCATION AGREE, NOW TO CHECK GLOBALS + SKIPA C,GLSP2 +SCON2B: AOS B ;SEARCH FOR GLOBAL POINTING TO CONSTANT WHICH HAS MATCHED SO FAR + CAML B,CONGOL + JRST SCON3 ;GLOBALS MATCH SO FAR + CAME A,1(B) ;SKIP IF ONE FOUND +SCON7: AOJA B,SCON2B ;NOT YET + MOVE D,(B) ;FOUND ONE, GET GLOTB ENTRY + CAME D,1(C) ;COMPARE WITH THIS ENTRY IN GLOTB + JRST SCON2 ;NO MATCH, FLUSH THIS CONSTANT + AOJA C,SCON7 ;MATCH, TRY NEXT GLOBAL + +SCON3: CAME C,GLSP1 ;GLOBALS MATCH, BUT ARE WE EXACTLY AT END OF GLOTB? + JRST SCON2 ;NO, BACK TO SEARCH + JRST NOCON4 + +NOCON: AOS A,PLIM ;CONSTANT NOT ALREADY IN TABLE + CAMLE A,CONTBE + ETF [ASCIZ/Literal table full/] + MOVE AA,WRD + MOVEM AA,-1(A) + SOS A + PUSHJ P,CPTMK + TLNE I,ILNOPT + TRO T,4 ;1.3 OF RELOCATION BITS => DON'T OPTIMIZE ON TOP OF ME + DPB T,C + MOVE B,GLSP2 +NOCON3: CAML B,GLSP1 + JRST NOCON4 + SKIPN C,1(B) + AOJA B,NOCON3 ;THIS ENTRY NOT REALLY HERE + MOVEM C,@CONGOL + HRRZS C + PUSHJ P,NOCON5 + MOVEM A,@CONGOL + PUSHJ P,NOCON5 + SKPST C, ;SKIP IF IN SYMBOL TABLE + AOJA B,NOCON3 + 3GET1 D,C ;IN SYMBOL TABLE + TLO D,3VCNT ;THIS SYM USED IN CONSTANT + 3PUT1 D,C ;UPDATE 3RDWRD TABLE ENTRY + AOJA B,NOCON3 + +NOCON5: AOS AA,CONGOL + CAML AA,CONGLE + ETF [ASCIZ/Constants-global table full/] + POPJ P, + + ;SET UP BYTE POINTER TO CONSTANTS-BIT TABLE + ;A SHOULD HAVE ADR OF CONSTANTS TABLE ENTRY + ;LEAVES ANSWER IN C + ;BITS IN CONSTANTS-BIT TABLE PER ENTRY: + ;1.2, 1.1 RELOCATION BITS + ;1.3 ILNOPT BIT => DON'T OPTIMIZE ON TOP OF ME + +CPTMK: PUSH P,A + SUB A,CONTBA + PUSH P,B + IDIVI A,12. + MOVEI C,(A) + ADD C,CONBIA ;SET UP ADDRESS PART + IMULI B,3 + DPB B,[360600,,C] ;STORE POSITION FIELD FROM REMAINDER + TLO C,200 ;SET UP SIZE FIELD +POPBAJ: POP P,B + JRST POPAJ + +NOCON4: TLON I,ILMWR1 + MOVEM A,CONSAD ;IF 1ST WD SAVE ADDR. + TLNE I,ILMWRD ;IF MORE WORDS, HANDLE NEXT. + JRST CONND0 + MOVE P,CONSTP ;VALUE OF CONSTP AT CONND. + MOVE C,GLSPAS ;TO RESTORE GLSP1 + JSP T,CONNDP ;POP STUFF. + HRRZ A,CONSAD ;ADDR OF CONSTANTS TABLE ENTRY OF 1ST WD. + MOVE B,PBCON ;ADDR OF WDS DESCRIBING CONST. AREA. + SKIPL 2(B) ;CONST. AREA LOCATION DEFINITE? + AOJA C,CONND6 ;NO, USE GLOBAL. + MOVEM C,GLSP1 + HRRZ C,1(B) ;ADD ACTUAL ADDR OF CONST. AREA. + ADDI A,(C) ;GET C(CONTBA) + ADDR OF CONSTANT. + LDB B,[420100,,2(B)] + JRST CONND7 + +CONND6: MOVEM C,GLSP1 + MOVEM B,(C) + MOVEI B,0 +CONND7: SUB A,CONTBA + JRST LSSTH3 ;POP OUT INTO OUTER WORD. + +.SEE SAVAS1 ;WHICH IS WHAT PUSHES WHAT CONNDP POPS. +CONNDP: SUB P,[3,,3] ;FLUSH SAVED SYLOC AND SYSYM AND CLNN,,CPGN. +CONFL2: HRL T,ASMOUT ;REMEMBER IF POPPING A LITERAL OR NOT. + INSIRP POP P,[CONSTP,ASSEMP,GLSPAS,ASMI,ASMDSP,ASMOUT,BYTM] + SKIPN BYTM ;IF IN BYTE MODE, POP DETAILS. + JRST CONND5 + MOVSI A,1-BYTMCL(P) + HRRI A,BYTMC + BLT A,BYTMC+BYTMCL-1 + MOVSI A,1-BYTMCL-LBYBYT(P) + HRRI A,BYBYT + BLT A,BYBYT+LBYBYT-1 + SUB P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] +CONND5: HLRZ A,T + CAIE A,3 + JRST (T) + POP P,A + ADDM A,SCNDEP ;DON'T FORGET ABOUT ANY CONDITIONALS. + SOS CONDEP ;HAVE POPPED ONE CONSTANT. + JRST (T) + +CONFLS: MOVE P,ASSEMP ;FLUSH ALL CONSTANTS. + CAMN P,[-LPDL,,PDL] ;IF IN ANY, + JRST (LINK) + MOVE P,CONSTP ;POINT AFTER ITS PDL ENTRY, + JSP T,CONNDP ;POP IT, + JRST CONFLS ;TRY AGAIN. + +CONBAD: SKIPN ASMOUT ;IF IN GROUPING, ERROR. + POPJ P, + ETSM [ASCIZ/Within <>, () or []/] + JRST ASSEM1 + +;COME HERE FOR PDL-OV ON P. +;IF IN A CONSTANT, FLUSH ALL OF THEM, SAYING WHERE EACH STARTED. +;THEN TYPE A PDL ERROR MSG AND RETURN TO ASSEM1. +;OTHERWISE FATAL ERROR. +CONFLP: MOVEI LINK,ASSEM1 + MOVEI CH1,ERRPDL + SKIPE CONDEP + JRST CONFL3 ;IN A CONSTANT. + MOVEI P,PDL ;RE-INIT PDL SO NO MORE PDL-OV. + ETF ERRPDL +ERRPDL: ASCIZ /PDL overflow/ + +;JSP LINK,CONFLM TO FLUSH CONSTANTS, SAYING WHERE THEYY STARTED, +;AND GIVE ERROR MSG. +CONFLM: MOVE CH1,ASMOUT + SKIPA CH1,ASMOT3(CH1) +CONFLZ: SETZ CH1, ;LIKE CONFLM BUT NO ERR MSG AT END. +CONFL3: SETO C, +CONFL1: MOVE P,CONSTP ;GET STACK ABOVE INNERMOST LITERAL. + REST SYLOC + REST SYSYM + REST D ;GET INFO ON WHERE STARTED + AOSN C ;THE 1ST TIME ONLY, SAY WHAT'S GOING ON. + TYPR [ASCIZ/Within groupings: /] + SKIPE C + TYPR [ASCIZ/, /] + MOVE A,ASMOUT ;SAY WHAT KIND OF GROUPING IS BEING CLOSED + MOVE A,ASMOT5(A) + CALL TYOERR ;BY SAYING WHAT CHAR OPENED IT. + JSP T,CONFL2 ;POP REST OF WDS SAVED AT LBRAK. + TYPR [ASCIZ/ at /] + MOVEI A,1(D) ;PAGE # GROUPING STARTED ON. + CALL DPNT ;PRINT IN DECIMAL. + MOVEI A,"- + CALL TYOERR + HLRZ A,D ;LINE NUMBER IT STARTED ON. + ADDI A,1 + CALL D3PNT2 ;PRINT W/ AT LEAST 3 CHARS, NO ZERO SUPPR. + MOVE A,ASSEMP + CAME A,[-LPDL,,PDL] ;MORE GROUPINGS TO POP => DO. + JRST CONFL1 + CALL CRRERR + MOVE P,ASSEMP + JUMPE CH1,(LINK) ;IF CALLED CONFLZ, NO ERR MSG (CALLER WILL GIVE ONE) + ETR (CH1) ;[ NO] OR PDL. + CALL CRRERR + JRST (LINK) + +;CONSTA + +CNSTNT: NOVAL + SKIPE ASMOUT ;IF ANY GROUPNGS, + JSP LINK,CONFLM ;FLUSH THEM, GIVE ERROR. + PUSHJ P,CNSTN0 + JRST ASSEM1 + +CNSTN0: SOSGE CONCNT ;ENTRY FROM AEND + ETF [ASCIZ /Too many constants areas/] + MOVE B,CLOC + ADD B,OFLOC + HRRZ T,PBCON + TRNN FF,FRPSS2 + JRST CNST1 ;PASS 1 + + MOVSI A,CGBAL + TDZ A,2(T) + TRNE FF,FRGLOL + TLC A,CGBAL + SKIPN A + ETR [ASCIZ /Constants globality phase error/] + HRRZ B,1(T) + SUB B,OFLOC + HRRZS B + CAME B,CLOC + ETR [ASCIZ /Constants location phase error/] + MOVE B,2(T) + ROT B,2 + XOR B,CRLOC + XOR B,OFRLOC + TRNE B,1 + ETR [ASCIZ /Constants relocation phase error/] + ;DROPS THROUGH + +;DROPS THROUGH +CNST2: MOVEI D,(T) ;STE IDX IN D FOR OUTSM0 + MOVE SYM,(T) ;GET NAME OF AREA + TLC SYM,400000#LCUDF ;CLEAR LCUDF, SET HALF-KILL + TRNE FF,FRGLOL + PUSHJ P,PDEFPT ;DEFINE SYM FOR BEGINNING OF CONSTANTS AREA + MOVE A,CONTBA +CNSTH: CAML A,PLIM + JRST CNSTA ;THRU + MOVE TT,(A) + MOVEM TT,WRD + PUSHJ P,CPTMK + LDB F,C ;GET THIS CONSTANT'S RELOCATION BITS + TRZE F,2 + TLO F,1 ;RELOCATE LEFT HALF + MOVEM F,WRDRLC ;STORE RELOCATION + MOVEI D,GLOTB ;AND NOW TO SET UP GLOTB! + MOVEM D,GLSP2 + MOVE C,CONGLA +CNSTC: CAML C,CONGOL + JRST CNSTB ;END OF CONSTANT-GLOBAL TABLE + CAMN A,1(C) ;POINTS TO THIS CONSTANT? + PUSH D,(C) ;YES, STORE ENTRY IN GLOTB + AOS C + AOJA C,CNSTC + +CNSTB: HRRZM D,GLSP1 ;MARK END OF ACTIVE PART OF GLOTB + PUSH P,A + PUSHJ P,PWRD ;OUTPUT THIS CONSTANT + AOS CLOC ;INCREMENT CLOC TO NEXT + HRRZS CLOC ;MAKE SURE IT STAYS IN A HALF-WORD (IMPORTANT SINCE MAY BE LESS THAN RELOCATION) + POP P,A ;RESTORE POINTER INTO CONSTANTS TABLE + AOJA A,CNSTH + +CNST3: HLRZ A,1(T) ;GET POINTER TO TOP OF AREA STORED DURING PASS 1 + CAMN A,CLOC ;SAME AS CURRENT? + JRST CNSTE ;YES, NO HAIR + CAMGE A,CLOC ;DIFFERENT; LOWER? + ETR [ASCIZ /More constants on pass 2 than 1/] + ;INSUFFICIENT CONSTANT SPACE; CONSTANTS AREA TRYING TO BE BIGGER + ;IN PASS 2 THAN PASS 1; THE EXTRA CONSTANTS WERE BACKED OVER + MOVEM A,CLOC ;EITHER WAY, SET CLOC TO TOP OF AREA SO WON'T HAVE MDT TROUBLE + PUSHJ P,EBLK ;END CURRENT BLOCK + CALL SLOCF ;IF RELOCATABLE, MAKE SURE NEW VALUE OF $. GETS PUNCHED + JRST CNSTE + +;CALL SLOCF WHENEVER "." IS CHANGED WITHOUT THE OUTPUTTING OF A STORAGE WORD. +SLOCF: MOVE A,CLOC ;STORE NEW "." IN HEADER FOR NEXT BLOCK OF OUTPUT. + SKIPGE TM,CONTRL + TRNN TM,DECREL+FASL ;BUT NOT IN DEC OR FASL OUTPUT FORMATS. + HRRM A,BKBUF + IORI FF,FRLOC ;MAKE SURE NULL BLOCK IS OUTPUT IF NEC. TO TELL LOADER "." HAS CHANGED. + RET + +;CONSTA DURING PASS 1 + +CNST1: HRRM B,1(T) ;STORE LOCATION OF AREA + MOVEI D,0 + MOVE A,CRLOC + ADD A,OFRLOC + TRNE A,1 + TLO D,CTRL ;RELOCATED + TRNE FF,FRGLOL + TLO D,CGBAL ;GLOBAL + IORM D,2(T) ;STORE FLAGS DESCRIBING AREA + JUMPL FF,CNST2 ;JUMP ON PUNCHING PASS, PUNCH OUT AREA NOW + MOVE T,PLIM + SUB T,CONTBA + ADDM T,CLOC ;PASS 1, JUST UPDATE CLOC + HRRZS CLOC + +CNSTA: HRRZ T,PBCON + TRNE FF,FRGLOL + JRST CNSTD ;LOCATION GLOBAL + TRNN FF,FRNPSS + SKIPGE 2(T) + JRST CNSTDA ;2 PASS ASSEMBLY OR AREA DEFINED + TRO I,IRCONT ;1PASS AND NOT DEFINED + SETZM PARBIT + PUSHJ P,P70 ;DEFINE SYM + MOVE A,(T) + TLC A,400000#LCUDF + SKIPE CRLOC + TLO A,100000 ;RELOCATE + PUSHJ P,$OUTPT + HRRZ A,1(T) + PUSHJ P,$OUTPT ;OUTPUT VALUE, FIRST LOCATION IN AREA + TRZ I,IRCONT +CNSTDA: MOVSI A,CTDEF + IORM A,2(T) ;CALL IT DEFINED +CNSTD: TRNE FF,FRPSS2 + JRST CNST3 ;PASS 2 + MOVE A,CLOC + HRLM A,1(T) ;MARK END OF AREA + +CNSTE: MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + MOVEI T,3 + ADDB T,PBCON + CAML T,PBCONL + MOVEM T,PBCONL + AOS A,CSQZ + MOVEM A,(T) + POPJ P, + +;DEFINING SYM USED IN CONSTANT, DELETE REFERENCES FROM CONSTANT-GLOBAL TABLE + +CONBUG: MOVE A,CONGLA ;B VAL C FLAGS ST(D) SADR + PUSH P,T + PUSH P,C ;SAVE FLAGS +CONBG2: MOVE C,(P) ;GET FLAGS + CAML A,CONGOL ;DONE WITH SCAN? + JRST CONBG1 ;YES + HRRZ F,(A) ;NO, GET CONSTANT-GLOBAL TABLE ENTRY + CAIE F,ST(D) ;POINT TO THIS SYM? + AOJA A,CONBG6 + PUSH P,B ;YES, SAVE VALUE, ABOUT TO WORK WITH B + MOVE T,(A) ;GET ENTIRE CONSTANT-GLOBAL TABLE ENTRY + LDB CH2,[221200,,T] ;GET MULTIPLICATION FIELD + SKIPE CH2 + IMUL B,CH2 ;NON-ZERO => MULTIPLY VALUE OF SYM + TLNE T,MINF + MOVNS B ;NEGATE VALUE + TLNE T,HFWDF + HRRZS B ;TRUNCATE TO HALFWORD + TLNE T,ACF + ANDI B,17 ;AC, MASK TO FOUR BITS + TLNE T,SWAPF + MOVSS B ;SWAP VALUE + TLNE T,ACF + LSH B,5 ;AC, SHIFT FIVE + ADD B,@1(A) ;ADD ABS PART OF VALUE + TLNN T,SWAPF + HRRM B,@1(A) ;NOT SWAPPED, STORE LH + TLNE T,SWAPF + HLLM B,@1(A) ;SWAPPED, STORE LH + TLNN T,HFWDF + MOVEM B,@1(A) ;FULL WORD, STORE VALUE + LDB CH1,[420200+P,,-1] ;GET HIGH BITS OF 3RDWRD, RELOCATION BITS + TLNE T,HFWDF ;NOW TO MAP RELOCATION BITS + TRZ CH1,2 + TLNE T,SWAPF + LSH CH1,1 + TRZE CH1,4 + TRO CH1,1 + PUSH P,A + HRRZ A,1(A) ;GET POINTER INTO CONSTANTS TABLE + PUSHJ P,CPTMK + LDB B,C ;GET RELOCATION BITS + TLNE T,MINF + JRST CONBG8 ;NEGATE + TRNE B,(CH1) + ETA ERRCRI + ;ATTEMPTED MULTIPLE RELOCATION IN CONSTANT + ; ^ ABOVE SHOULD BE REPLACED WITH A $RSET LIKE ROUTINE + ;THAT ALSO SEARCHES CONSTANT-GLOBAL TABLE FOR $R. ALREADY THERE + IOR B,CH1 ;LOOKS OK, IOR IN BITS FOR GLOBAL +CONB8A: DPB B,C ;STORE BACK NEW RELOCATION BITS FOR CONSTANT + POP P,A + CLEARM (A) ;CLEAR OUT CONSTANT-GLOBAL TABLE ENTRY + CLEARM 1(A) + POP P,B + AOS A +CONBG6: AOJA A,CONBG2 ;BACK FOR NEXT CONSTANT, DON'T KNOW HOW MANY THIS SYM USED IN + +CONBG1: MOVE A,CONGLA + PUSH P,B + MOVE B,CONGLA +CONBG7: CAML A,CONGOL + JRST CONBG3 + SKIPN C,(A) +CONBG5: AOJA A,CONBG4 + MOVEM C,(B) + MOVE C,1(A) + MOVEM C,1(B) + AOS B + AOJA B,CONBG5 + +CONBG4: AOJA A,CONBG7 +CONBG3: MOVEM B,CONGOL + POP P,B + POP P,C + POP P,T + POPJ P, +CONBG8: XORI B,3 + TRNE B,(CH1) + ETA ERRCRI + ANDCB B,CH1 + JRST CONB8A + +ERRCRI: ASCIZ /Multiple relocation in constant/ + +;VARIAB + +AVARIAB: NOVAL + SKIPE ASMOUT ;FLUSH ANY GROUPINGS IN PROGRESS. + JSP LINK,CONFLM + PUSHJ P,AVARI0 + JRST ASSEM1 + +AVARI0: SOSG VARCNR ;ENTRY FROM AEND + ETF [ASCIZ /Too many variable areas/] + MOVE D,SYMAOB ;SET UP AOBJN POINTER TO ST + MOVE T,CLOC + MOVEM T,VCLOC ;STORE AS LOCATION OF VARIABLE AREA + ADD T,OFLOC + MOVE C,CRLOC + ADD C,OFRLOC + TRNE FF,FRPSS2 + JRST AVAR1 ;PASS 2 + HRL T,VARCNT ;SIZE OF AREA + TRNE C,1 + TLO T,400000 ;RELOCATED + MOVEM T,@VARPNT + JRST AVAR2E + +AVAR1: HRRZ A,@VARPNT ;VARIAB DURING PASS 2 + CAIE A,(T) + ETR [ASCIZ /Variables location phase error/] + HLRZ A,@VARPNT + TRZE A,400000 + XORI C,1 + TRNE C,1 + ETR [ASCIZ /Variables relocation phase error/] + SKIPE VARCNT + ETR [ASCIZ /Variables area size phase error/] + +AVAR2E: HLRZ T,@VARPNT + TRNN T,377777 + JRST AVAR2C ;IF THIS VAR AREA IS EMPTY, DON'T SCAN SYMTAB. +AVAR2: HLRZ LINK,ST(D) ;SCAN, CHECKING EACH SYM FOR WHETHER IT'S A VARIABLE + CAIL LINK,DEFLVR + JRST AVAR2B + ADD D,WPSTE1 + AOBJN D,AVAR2 + JRST AVAR2C ;ALL SCANNED. + +AVAR2B: 3GET C,D ;FOUND A VARIABLE; DECIDE WHAT TO DO WITH IT. + MOVE B,ST+1(D) + MOVE SYM,ST(D) + TLZ SYM,740000 + LDB LINK,[400400,,ST(D)] + CAIE LINK,UDEFLV_-14. + CAIN LINK,UDEFGV_-14. + JRST AVAR3 ;UNDEFINED VARIABLE + CAIE LINK,DEFGVR_-14. + CAIN LINK,DEFLVR_-14. + JRST AVAR4 ;DEFINED VARIABLE +AVAR2A: ADD D,WPSTE1 + AOBJN D,AVAR2 ;CHECK ENTIRE SYMTAB +AVAR2C: HLRZ A,@VARPNT ;NOW GET SIZE OF AREA + TRZ A,400000 ;CLEAR OUT RELOCATION CHECK BIT +IFN FASLP,[ + MOVE D,CONTRL + TRNE D,FASL ;IN FASL ASSEMBLY, CAN'T JUST SET LOC CTR; MUST OUTPUT 0'S. + CALL ABLKF +] + ADD A,VCLOC ;ADD LOCATION OF BEGINNING OF VARIABLE AREA + MOVEM A,CLOC ;STORE AS NEW CURRENT LOCATION + PUSHJ P,EBLK + CALL SLOCF + CLEARM VARCNT ;INITIALIZE COUNT OF VARIABLES IN NEXT AREA + AOS VARPNT ;INCREMENT POINTER TO POINT TO NEXT AREA + POPJ P, + +;UNDEFINED VARIABLE FOUND IN SYMTAB SCAN + +AVAR3: CAIN LINK,UDEFGV_-14. ;GLOBAL? + TLO SYM,40000 ;GLOBAL + PUSHJ P,LKPNRO + MOVSI T,DEFLVR + CAIN LINK,UDEFGV_-14. + MOVSI T,DEFGVR + TRNE FF,FRGLOL + JRST AVAR3A ;LOCATION GLOBAL + MOVEI B,-1(B) + ADD B,VCLOC + ADD B,OFLOC + MOVE TT,CRLOC + ADD TT,OFRLOC + SKIPE TT + TLO C,3RLR + CAIE LINK,UDEFGV_-14. + TLZN C,3VCNT + SKIPA + PUSHJ P,CONBUG +AVAR4B: PUSHJ P,VSM2 + JUMPGE FF,AVAR2A ;IF PUNCHING PASS, OUTPUT DEFINITION. + PUSHJ P,OUTDE2 + JRST AVAR2A + +AVAR4: TLNE C,3VAS2 ;DEFINED VARIABLE FOUND DURING SYMTAB SCAN + TLOE C,3VP + JRST AVAR2A + MOVSI T,(LINK) ;CAUSE AVAR4B TO REDEFINE AS SAME TYPE. + LSH T,14. + TRNN FF,FRGLOL + JRST AVAR4A +AVAR3A: PUSHJ P,VSM2LV + JUMPGE FF,AVAR2A + PUSHJ P,PDEFPT + MOVEI A,0 + PUSHJ P,PBITS + PUSHJ P,$OUTPT + AOS CLOC + JRST AVAR2A + +AVAR4A: CAIN LINK,DEFGVR_-14. ;DEF VAR, 3VAS2, POINT NOT GLOBAL. + JRST AVAR4B ;VAR GLOBAL, MUST PUNCH DEF SINCE DIDN'T ON PASS1. + 3PUT C,D ;LOCAL, JUST SET 3VP SO DON'T SEE IT NEXT VARIAB. + JRST AVAR2A ;NO NEED TO PUNCH DEF SINCE WAS DEF ON PASS1. + +;;MAIN ;"MAIN" MIDAS ROUTINES: INIT, PS1, PLOD, PS2, PSYMS + ;ALL CALLED WITH JSP A,; ALL GLOBAL + ;RETURN INSTRUCTION FROM JSP IN LOCATION RETURN +PS1: HRRM A,RETURN ;PASS 1, (PASS 1 INITIALIZATION ALREADY DONE), SAVE RETURN + PUSH P,[ASSEM1-1] ;SIMBLK WILL POPJ1. +IFN A1PSW,[SKIPL PRGC + JRST A1PAS1 ;THIS NOT FIRST PROGRAM THIS ASSEMBLY, SET MODE TO 1PASS +] + TRO FF,FRNPSS +IFN ITSSW,JRST SIMBLK ;SELECT SBLK AND ASSEMBLE +IFN DECSW\TNXSW,JRST A.DECRE ;SELECT .DECREL AND ASSEMBLE. + +PS2: HRRM A,RETURN ;PASS 2 (MAIN ROUTINE, PASS 2 INITIALIZATION NOT ALREADY DONE), SAVE RETURN + JUMPL FF,PA2A ;JUMP IF PASS 1 ENDED IN 1PASS MODE + TDO FF,[FLPPSS,,FRPSS2] ;SET PUNCHING PASS AND PASS 2 FLAGS + PUSHJ P,P2INI ;INITIALIZE + JRST ASSEM1 ;START ASSEMBLING + +PA2A: MOVE A,SYMAOB ;PASS 2 OF 1PASS ASSEMBLY, CHECK FOR UNDEFINED LOCALS +PA2C: MOVE SYM,ST(A) ;GET SQUOZE THIS SYMTAB ENTRY + LDB B,[400400,,SYM] ;GET FLAGS + CAIE B,LCUDF_-14. ;LOCAL UNDEFINED? + JRST PA2B ;NOT LOCAL UNDEFINED, DON'T COMPLAIN + 3GET C,A ;LOCAL UNDEFINED, GET 3RDWRD ST ENTRY + TLZ SYM,740000 ;CLEAR OUT FLAGS IN SYM IN ANTICIPATION OF TYPING OUT COMPLAINT + TLNN C,3LLV ;PROBLEM HANDED TO LINKING LOADER? + ETSM [ASCIZ /Undefined/] ;NO +PA2B: ADD A,WPSTE1 ;NOW GO FOR NEXT ST ENTRY + AOBJN A,PA2C + JRST RETURN + +$INIT: HRRM A,RETURN ;INITIALIZATION (BEFORE PASS 1 ONLY) ROUTINE, SAVE RETURN POINT +IFN CREFSW,PUSHJ P,CRFOFF ;DON'T CREF ON 1ST PASS. +IFN LISTSW,CALL LSTOFF ;DON'T LIST ON 1ST PASS. + SKIPGE ISYMF + JRST INIT1 ;SPREAD SYMS (RETURNS TO SP4) + MOVE A,SYMAOB ;ALREADY SPREAD, JUST FLUSH ALL BUT INITIAL SYMS +INIT4: SKIPN B,ST(A) + JRST INIT2 + 3GET C,A + TRNE C,-1 ;INITIAL SYM? + CLEARM ST(A) ;NO +INIT2: ADD A,WPSTE1 + AOBJN A,INIT4 + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1] + BLT A,EBKCOD ;CLEAR OUT BLANK CODE + +SP4: PUSH P,CRETN +P1INI: CLEARB I, LDCCC + INSIRP SETZM,BKBUF ISYMF A.PASS +IFN FASLP,[ + INSIRP SETZM,FASATP FASPCH + CLEARM FASIDX +] + MOVEMM DECTWO,[[MOVE]] + TDZ FF,[FFINIT] ;INITIALIZE MOST FF FLAGS + MOVEIM A.PPASS,2 ;DEFAULT IS 2-PASS. + PUSHJ P,MACINI ;INITIALIZE MACRO STATUS + MOVEI A,PCNTB + MOVEM A,PBCONL + MOVS A,[BKTAB,,P1INI1] + BLT A,BKTAB+4 + MOVEIM BKTABP,BKWPB*2 + +;DROPS IN. +P2INI: INSIRP SETZM,[CPGN,CLNN,GENSM,OFLOC,OFRLOC,CRLOC,BKPDL +SYLOC,SYSYM,BYTW,BYTRLC,STGSW,DECBRK,DEFNPS,BYTM,BYTM1,HKALL,QMTCH] + AOS B,A.PASS +IFN ITSSW,[ + CALL SETWH2 ;SET UP .WHO2, PREPARE .WHO3 IN A WITH PAGENUM=1. + .SUSET [.SWHO3,,A] ;'P1 ',,PAGENUM OR 'P2 ',,PAGENUM + .SUSET [.SWHO1,,[.BYTE 8 ? 166 ? 0 ? 165 ? 0]] +] + TDZ FF,[FLUNRD,,FRGLOL] +IRP X,,[BKWPB,BKCUR,,BKPDL+1,1,BKLVL,IRDEF,ASMI +NCONS,CONCNT,VARTAB,VARPNT,NVARS,VARCNR,1,VECSIZ] +IFE 1&.IRPCN,IFSN [X], MOVEI A,X +IFN 1&.IRPCN, MOVEM A,X +TERMIN + MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + CLEARM VARCNT + CLEARM PBITS2 + MOVE A,[440300,,PBITS1] + MOVEM A,BITP + MOVEI A,PBITS4 + HRRZM A,PBITS4 + CLEARB I,PBITS1 + MOVEI A,PCNTB + MOVEM A,PBCON + MOVE A,[(LCUDF)++1] ;< AND > FOR COMPATIBILITY WITH OLD + MOVEM A,PCNTB + MOVEM A,CSQZ + MOVEI A,8 + MOVEM A,ARADIX + +IFN ITSSW,[ + MOVEI A,100 + MOVEM A,CLOC +] +.ELSE [ + SETZ A, ; SET LOC COUNTERS APPROPRIATELY + SKIPGE B,CONTRL + TRNE B,DECREL+FASL + JRST [SETZM CLOC ; ASSUME RELOCATABLE + AOS CRLOC ; CRLOC GETS 1 + JRST P2INI5] + TRNE B,DECSAV ; ASSUME ABSOLUTE + MOVEI A,140 + TRNE B,SBLKS + MOVEI A,100 ; IF SBLK FORMAT ASSUME FOR ITS. + MOVEM A,CLOC +P2INI5: +] + SETZM GLOCTP + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,CONTRL ;IN DEC FORMAT, OUTPUT PROGRAM NAME. + TRNE A,DECREL + CALL DECPGN ;CLOBBERS A +IFN FASLP,[ + SETOM FASBLC ;LOSING BLOCK COUNT + MOVE A,CONTRL ;IN FASL FORMAT, OUTPUT FASL HEADER + TRNE A,FASL + CALL FASOIN ;INITIALIZE FASL OUTPUT +] + SETZM DECBRH + TRO FF,FRSYMS+FRFIRWD + MOVE A,[IFORTB,,FORTAB] ;INITIALIZE FORMAT TABLE ON EACH PASS + BLT A,FRTBE + MOVEIM GLSPAS,GLOTB ;INIT. ASSEM1 PDL LEVELS TO BOTTOM. + MOVEMM ASSEMP,[[-LPDL,,PDL]] + MOVEIM ASMDSP,ASSEM3 + SETZM ASMOUT + SETZM CONSTP + SETZM SCNDEP ;NOT IN CONDIT. OR CONSTANT. + SETZM CONDEP + HRRZM P,CONSML ;START OUT IN MULTI-LINE MODE. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + MOVEM A,PNTBP + CLEARM LISTPF + SETOM LISTBC + SKIPG LISTP1 ;IF LIST ON PASS 1 + JUMPGE FF,CRETN ;OR PUNCHING PASS, + SKIPE LISTP ;IF WANT LISTING, + CALL LSTON ;TURN ON OUTPUT OF LISTING. +] +IFN CREFSW,[ + JUMPGE FF,CRETN + SKIPE CREFP ;IF C SWITCH WAS SEEN, + PUSHJ P,CRFON ;TURN ON CREFFING, +] +CRETN: POPJ P,RETURN + +P1INI1: SQUOZE 0,.INIT ? 0 ? 3 + SQUOZE 0,.MAIN ? 1,, + +PLOD: HRRM A,RETURN ;MAIN ROUTINE TO PUNCH LOADER, CALLED BEFORE PASS 2 (PS2"), SAVE RETURN POINT + PUSHJ P,PLOD1 ;PUNCH LOADER + JRST RETURN ;RETURN + + ;PUNCH OUT THE LOADER + +PLOD1: PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE + MOVE B,CONTRL + TRNE B,ARIM10 + JRST PLOD2 ;RIM10 => PUNCH OUT SBLK LOADER FOR PDP10 READIN-MODE READIN + TRNN B,SBLKS + POPJ P, ;NOT SBLK => DON'T PUNCH LOADER +PLOD1A: MOVSI B,SLOAD-SLOADP ;PUNCH SBLK LOADER IN RIM FORMAT + MOVSI C,(DATAI PTR,) +PLOAD1: MOVE A,C + PUSHJ P,PPBA + CAMN C,[DATAI PTR,13] + HRRI C,27 + MOVE A,SLOAD(B) + PUSHJ P,PPBA + AOS C + AOBJN B,PLOAD1 + MOVE A,[JRST 1] + PUSHJ P, PPBA + JRST FEED1 + +PLOD2: MOVSI C,LDR10-ELDR10 ;PUNCH SBLK LOADER FOR PDP10 READIN +PLOD3: MOVE A,LDR10(C) + PUSHJ P,PPBA + AOBJN C,PLOD3 + JRST FEED1 + + ;SBLK LOADER NORMALLY PUNCHED OUT IN RIM FORMAT + +SLOAD: CONO PTR,60 ;0 RESTART POINT (NEW BLOCK) + JSP 14,30 ;1 START POINT, LOOP POINT FOR NEW BLOCK; WAIT FOR DATA WORD READY + DATAI PTR,16 ;GET HEADER + MOVE 15,16 ;INITIALIZE CHECKSUM + JUMPGE 16,16 ;HEADER .GE. 0 => STARTING INSTRUCTION + JSP 14,30 ;5 LOOP POINT FOR NEXT DATA WORD: WAIT FOR READY + DATAI PTR,(16) ;READ IN DATA WORD + ROT 15,1 ;NOW UPDATE CHECKSUM + ADD 15,(16) + AOBJN 16,5 ;LOOP FOR ALL DATA WORDS THIS BLOCK + MOVEI 14,33 ;30 TO RETURN TO 33 + JRST 30 ;WAIT FOR READY THEN GO TO 33 + ;14 JSP AC FOR ROUTINE AT 30 + ;15 CHECKSUM + ;16 AOBJN POINTER (UPDATED HEADER) + CONSO PTR,10 ;30 ROUTINE TO WAIT FOR DATA WORD READY FOR DATAI + JRST 30 + JRST (14) + DATAI PTR,16 ;33 GET CHECKSUM + CAMN 15,16 ;COMPARE WITH CALCULATED + JUMPA 1 ;OK, GO GET NEXT BLOCK (DON'T CHANGE TO JRST OR REAL LOADERS WILL GET CONFUSED) + JRST 4, ;CHECKSUM ERROR +SLOADP==. + +;PDP10 SBLK LOADER +;FOLLOWING CODING ACTUAL WORDS TO BE OUTPUT + ;BY ASSEMBLER, COMPILER, OR WHATEVER +;SHOULD BE EXECUTED BY PDP10 HARDWARE READIN FEATURE +;USES ONLY THE AC'S (BUT ALL OF THEM) + +LDR10: + -17,,0 ;BLKI POINTER FOR READ SWITCH + +LDRC=0 ;CHECKSUM (OK, SO YOU'RE NOT ALLOWED TO LOAD + ;INTO IT DURING HARDWARE READIN, BUT WHO SAYS + ;YOUR PROGRAM CAN'T USE IT?) +OFFSET -.+1 ;BEGIN LOADING INTO 1 AS PER HEADER +LDRGO==. + CONO PTR,60 ;START UP PTR (RESTART POINT) +LDRRD==. + HRRI LDRB,.+2 ;INITIALIZE INDEX +LDRW==. + CONSO PTR,10 ;WAIT FOR WORD TO BE AVAILABLE + JRST .-1 + ROT LDRC,-LDRRD(LDRB) ;BEFORE READING IN HEADER, ROTATE 2 BITS (THEN IGNORE) + ;BEFORE READING IN EACH DATA WORD, ROTATE 1 BIT (FOR UPDATING CHECKSUM) + ;BEFORE READING IN CHECKSUM, ROTATE NOT AT ALL (DON'T ROTATE CALCULATED CHECKSUM) + DATAI PTR,@LDRT1-LDRRD(LDRB) ;READ WORD INTO RIGHT PLACE + ;HEADER => READ INTO C + ;STORAGE WORD => READ INDEXED BY AOBJN POINTER IN A + ;CHECKSUM => READ INTO A FOR COMPARISON WITH C(C) + XCT LDRT1-LDRRD(LDRB) ;EXECUTE RELEVANT T1 ENTRY (MAYBE SKIPS) + XCT LDRT2-LDRRD(LDRB) ;EXECUTE RELEVANT T2 ENTRY (MAYBE JUMPS) +LDRB==. + SOJA ., ;-RD(B) IS 2, 1, AND 0 FOR SUCCESSIVE ENCOUNTERS OF THIS INSTRUCTION + ;USED AS INDEX INTO TABLES, ETC. + + ;TABLE 1 + ;INDIRECTED THROUGH FOR DATAI + ;THEN EXECUTED TO SEE WHAT TO DO WITH READ IN WORD + ;ENTRIES EXECUTED IN REVERSE ORDER + +LDRT1==. + CAME LDRC,LDRA ;COMPARE CHECKSUM WITH CALCULATED, SKIP TO B IF THEY AGREE + ADD LDRC,(LDRA) ;UPDATE CHECKSUM + SKIPL LDRA,LDRC ;INITIALIZE HEADER AND SKIP UNLESS JUMP BLOCK + + ;TABLE 2 + ;EXECUTED IF CORRESPONDING ENTRY IN TABLE 1 DIDN'T SKIP WHEN EXECUTED + +LDRT2==. + JRST 4,LDRGO ;CHECKSUM ERROR + AOBJN LDRA,LDRW ;UPDATE AOBJN POINTER AND GO BACK FOR NEXT STORAGE WORD IF NOT EXHAUSTED +LDRA==. + JRST LDRRD ;WHEN INITIALLY LOADED IS JUMP BLOCK TO THIS LOADER + ;DURING LOADING USED TO HOLD HEADER (AOBJN POINTER), WHICH MAY BE LOADED JUMP BLOCK + +OFFSET 0 +ELDR10==. + +;FLAGS IN SQUOZE OF SYMS TO OUTPUT + +ABSGLO==040000 ;SYM IS GLOBAL (IF RELOCA, SAYS THIS IS BLOCK NAME) +ABSLCL==100000 ;LOCAL +ABSDLI==200000 ;DELETE INPUT (DON'T RECOGNIZE IT IF TYPED IN) +ABSDLO==400000 ;DELETE OUTPUT (DON'T TYPE IT OUT) + +PSYMS: HRRM A,RETURN ;PUNCH OUT SYMBOL TABLE, CALLED AFTER EVERYTHING ELSE, SAVE RETURN POINT + PUSH P,PSYMS ;AT END, POPJ TO RETURN. + TRNE FF,FRSYMS + JRST SYMDMP ;PUNCH SYMS IF NEC. + SKIPL A,CONTRL + JRST SYMDA ;IF RELOCA, PUNCH PROGRAM NAME. + TRNE A,DECSAV ;IF DEC SAVE FORMAT WITHOUT SYMBOLS + JRST SYMDSA ;STILL DUMP START ADDRESS + TRNN A,DECREL + POPJ P, + +PSYMSD: MOVSI A,DECEND + PUSHJ P,DECBLK ;START AN END-BLOCK. + MOVE A,DECTWO ;IN 2-SEG PROGRAMS, + CAME A,[MOVE] + JRST [ CAMG A,DECBRH ;OUTPUT HISEG BREAK + MOVE A,DECBRH + MOVEM A,WRD + MOVEIM WRDRLC,1 + CALL PWRD + MOVEMM WRD,DECBRK + CALL PWRD ;FOLLOWED BY LOSEG BREAK + JRST EBLK] + MOVEMM WRD,DECBRK ;OUTPUT THE PROGRAM BREAK. + MOVEIM WRDRLC,1 + PUSHJ P,PWRD + MOVE A,DECBRA ;OUTPUT HIGHEST ABS. ADDR + CAIG A,140 + SETZ A, ;IF IT'S ABOVE THE JOBDAT AREA. + PUSHJ P,DECWRD + JRST EBLK + +SYMDA: MOVEI A,LPRGN ;NOW PUNCH PROGRAM NAME + DPB A,[310700,,BKBUF] + MOVE A,PRGNM + TLO A,40000 + PUSHJ P,$OUTPT + PUSHJ P,EBLK + TLZ FF,$FLOUT + POPJ P, + + ;DUMP OUT THE SYMBOL TABLE + +SYMDMP: TRZ I,IRCONT ;OK TO END BLOCK + CLEARM GLSP1 + CLEARM GLSP2 + CLEARM WRDRLC + MOVE T,CONTRL + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + CLEARM CLOC + CLEARM BKBUF +IFN FASLP,[ + TRNE T,FASL + JRST SYMDM1 +] +IFN ITSSW,[ + TRNE T,SBLKS ; ON ITS, IF OUTPUTTING IN SBLK FMT + CALL SYMDDB ; THEN OUTPUT A DEBUGGING INFO BLOCK. +] + TRNE T,DECREL + JRST SYMDMD + JUMPL T,SSYMD ;JUMP IF NOT STINK + + MOVEI B,LDDSYM ;LOCAL SYMS BLOCK TYPE + DPB B,[310700,,BKBUF] ;SET BLOCK TYPE + MOVEM B,CDATBC + MOVE B,SYMAOB ;CAUSE SSYMD3 TO LOOK AT ENTIRE SYM TAB. + JRST SSYMDR + +SYMDMD: MOVSI A,DECSYM ;IN DEC FMT, START SYMBOLS BLOCK. + PUSHJ P,DECBLK +SYMDM1: MOVE B,SYMAOB + JRST SSYMDR + +IFN ITSSW,[ + + ; OUTPUT DEBUGGING INFO BLOCK (ITS SBLK ONLY) + +SYMDDB: MOVE A,[-7,,3] ;OUTPUT A "DEBUGGING INFORMATION" BLOCK + MOVE B,A ;UPDATING THE CHECKSUM IN B. + PUSHJ P,PPB + MOVE A,[-6,,1] ;THE BLOCK CONTAINS ONE SUBBLOCK - A "MIDAS INFO" SUBBLOCK. + PUSHJ P,PPBCK + .SUSET [.RXUNAME,,A] ;CONTAINING NAME OF USER, DATE IN DISK FORMAT, + PUSHJ P,PPBCK + SYSCAL RQDATE,[%CLOUT,,A] + .LOSE %LSSYS + PUSHJ P,PPBCK ;AND THE SOURCE FILE NAMES (DEV, FN1, FN2, SNAME). +REPEAT 4,[ + MOVE A,INFB+$F6DEV+.RPCNT + PUSHJ P,PPBCK +] + MOVE A,B + PJRST PPB ; PUNCH OUT CHECKSUM & RETURN +] ;IFN ITSSW, + +;AC ALLOCATIONS DURING PHASE 1 (COMPACTING THE SYMBOL TABLE): + ;AA INITIALLY HAS -SMK,,; INPUT INDEX INTO ST + ;A TEMP + ;B SQUOZE + ;D OUTPUT INDEX INTO SYMTAB + ;CH1 VALUE OF SYM + ;CH2 3RDWRD + +SSYMD: MOVEI D,ST-1 + SETZB C,SMSRTF ;SYMS SORTED => INITIAL SYMS CLOBBERED + MOVE AA,SYMAOB +SSYMD1: SKIPE B,ST(AA) ;GET SYM NAME FROM TABLE + TDNN B,[37777,,-1] ;MAKE SURE NOT EXPUNGED + JRST SSYMDL ;NOT (REALLY) THERE, TRY NEXT + AOS SMSRTF + MOVE CH1,ST+1(AA) ;GET VALUE OF SYM + 3GET CH2,AA ;GET 3RDWRD + TRNE CH2,-1 + TLNE CH2,3KILL+3LLV + JRST SSYMDL ;DON'T PUNCH INITIAL OR KILLED SYMS. + MOVEI A,0 ;INITIALIZE FOR SHIFTING IN FLAGS + LSHC A,4 ;SHIFT FLAGS INTO A + XCT SSYMDT(A) ;DO THE APPROPRIATE THING THIS KIND OF SYMTAB ENTRY + JRST SSYMDL +SSYMD2: LSH B,-4 ;SHIFT SQUOZE BACK TO WHERE IT BELONGS + TLO B,ABSLCL ;SET LOCAL BIT + TLNE CH2,3SKILL + TLO B,ABSDLO ;HALF-KILL SYM + CAIL A,DEFGVR_-16 + TLC B,ABSGLO\ABSLCL ;FOR GLOBAL SYM, SET GLOBAL BIT INSTEAD OF LOCAL BIT, + CAIGE A,DEFGVR_-16 ;AND PUT IT IN THE GLOBAL BLOCK IN THE SYMTAB. + SKIPN PRGNM+BKWPB ;IF ONLY ONE BLOCK IN PROGRAM, PUT ALL SYMS IN GLOBAL BLOCK. + HRRI CH2,0 + PUSH D,B ;STORE NAME OF SYM IN OUTPUT SLOT + PUSH D,CH1 ;STORE VALUE + PUSH D,CH2 ;STORE 3RDWRD +SSYMDL: ADD AA,WPSTE1 + AOBJN AA,SSYMD1 ;LOOP FOR ALL SYMS IN TABLE + MOVSI CH2,4^5 ;1ST BIT TO SORT ON IS TOP BIT, + MOVEI A,ST ;SORT FROM BOTTOM OF SYMTAB + MOVEI B,1(D) ;TO WHERE WE FILLED UP TO. + MOVE CH1,[TDNE CH2,1(A)] ;SORT ON 2ND WD, WDS WITH BIT ON COME FIRST. + MOVE C,[TDNN CH2,1(B)] + JSP AA,SSYMD9 + TLC C,(TDNE#TDNN) ;ON BITS AFTER 1ST, ENTRIES WITH BIT OFF COME FIRST. + TLC CH1,(TDNE#TDNN) + MOVEI AA,SSRTX ;NEED ONLY CHANGE C, CH1 THE FIRST TIME. + JRST SSRTX + +SSYMD9: PUSHJ P,SSRTX ;SORT SYMS ARITHMETICALLY BY VALUE. + MOVNI B,(B) + ADDI B,ST ;SIZE OF AREA OF SYMTAB STILL IN USE. + IDIV B,WPSTE + HRLZI B,(B) ;-<# SYMTAB ENTRIES>,, + MOVE T,CONTRL ; GET CONTRL FOR OUTPUT FMT CHECKS + MOVE A,[SQUOZE 0,GLOBAL] + MOVEM A,BKTAB ;CALL THE .INIT BLOCK "GLOBAL" WHICH IS WHAT DDT WANTS AS TOP BLOCK. + MOVE C,BKTABP + IDIVI C,BKWPB ;# BLOCKS (INCL. GLOBAL BLOCK). + CAIN C,2 ;IF ONLY GLOBAL AND MAIN, TELL BKSRT TO IGNORE MAIN. + SETZM PRGNM+1 + CAIN C,2 + MOVEI C,1 ;IF ONLY GLOBAL AND MAIN, FILE WILL HAVE ONLY 1 BLOCK (GLOBAL). + CAILE C,1 ;IF MORE THAN ONE BLOCK IN FILE, + TRNN T,DECSAV ;AND OUTPUT FORMAT IS DECSAV, + CAIA + ADDI C,1 ;THEN ALLOW FOR ONE MORE "BLOCK" (PGM NAME). + ;NOTE THAT DECSAV FMT REPLACES BLOCKNAME WITH PGM-NAME + ;FOR SINGLE-BLOCK CASE, SO COUNT OF 1 WORKS OK. + MOVSI A,(C) ; <# BLOCKS TO OUTPUT>,, + SUBM B,A ;-<# ENTRIES IN SYMTAB IN FILE>,, + LSH A,1 ;-<# WDS IN SYMTAB IN FILE>,, + TRNE T,DECSAV ; IF OUTPUT FORMAT IS DEC SAV, + JRST [ HRR A,DECSYA ; GET LOC TO STORE SYMS AT + MOVE C,A + MOVE A,[-1,,116-1] ; STORE IT AT .JBSYM + CALL PPB + MOVE A,C + CALL PPB + HRRI A,-1(A) ; SET -<# WDS IN SYMTAB>,, + JRST .+1] + MOVEM A,SCKSUM ;SAVE 1ST WD FOR CHECKSUM (DECSAV IGNORES IT) + PUSHJ P,PPB + PUSHJ P,BKCNT ;PUT -<# SYMS IN BLOCK> IN 3RD WD OF EACH BKTAB ENTRY. + +;DROPS THROUGH. + +;DROPS IN IF ABS, JUMPS HERE IF RELOC. +;NOTE THAT IN ABS ASSEMBLY, B WILL CONTAIN THE CHECKSUM AND +;SHOULD NOT BE CLOBBERED. +SSYMDR: PUSH P,B ;-<# SYMS>,,0 ;IT WILL BE -1(P) + PUSHJ P,BKSRT ;SORT BLOCKS INTO BKTAB1 + MOVE A,BKTAB + CAME A,[SQUOZE 0,GLOBAL] ;IF ABS, WE RENAMED .INIT TO GLOBAL, SO LEAVE IT IN BKTAB1 + SOS D ;ELSE FLUSH .INIT FROM THE END OF BKTAB1. + SETOM 1(D) ;PUT A -1 AT END OF BKTAB1. + MOVE B,SCKSUM ;GET CHKSUM AFTER 1ST WD. (PPBCK WILL UPDATE) + PUSH P,[-1] ;(P) WILL BE BKTAB1 IDX OF NEXT BLOCK TO OUTPUT. +SSYMD3: AOS F,(P) ;F HAS BKTAB1 IDX OF BLOCK. + SKIPGE C,BKTAB1(F) ;BKTAB1 ELT HAS BKTAB IDX OR + JRST SSYMDX ; -1 AFTER LAST BLOCK. + SKIPL LINK,CONTRL + JRST SSYMD7 ;DIFFERENT RTN TO OUTPUT BLOCK NAME IF RELOCA. + TRNE LINK,DECREL+FASL+DECSAV + JRST SSYMD6 ; ALL THESE SKIP OVER SBLK-TYPE BLOCKNAME OUTPUT + MOVE A,BKTAB(C) + PUSHJ P,PPBCK ;OUTPUT BLOCK NAME WITH NO FLAG BITS SET. + HLRZ A,BKTAB+1(C) + SKIPE A + ADDI A,1 ;A GETS 0 FOR GLOBAL BLOCK, ELSE DDT LEVEL (= 1 + MIDAS LEVEL). + HRL A,BKTAB+2(C) ;PUT IN -2* + ADD A,[-2,,] +SSYMG2: PUSHJ P,PPBCK ;OUTPUT -SIZE,,LEVEL WORD OF BLOCK NAME ENTRY. + JRST SSYMD6 + +SSYMD7: MOVE A,BKTAB(C) ;OUTPUT BLOCK NAME IN RELOCATABLE. + TLO A,ABSGLO ;TELL STINK IT'S BLOCK NAME. + PUSHJ P,$OUTPT + HLRZ A,BKTAB+1(C) + SUBI A,1 + PUSHJ P,$OUTPT +SSYMD6: SKIPL C,-1(P) ;AOBJN PTR TO SYMS. + JRST SSYMD8 ;IN CASE NO SYMS. +SSYMD4: HRRZ A,ST+2(C) ;OUPUT ONLY THE SYMS IN THE BLOCK + CAME A,BKTAB1(F) ;NOW BEING HANDLED. + JRST SSYMD5 + SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL + JRST SYMD2 ;SPECIAL IF RELOCA. + MOVE A,ST(C) + TRNE LINK,DECSAV + CALL RSQZA ; RIGHT-JUSTIFY THE SQUOZE (SIGH) + PUSHJ P,PPBCK ;1ST, SQUOZE WITH FLAGS. + MOVE A,ST+1(C) + PUSHJ P,PPBCK ;2ND, VALUE. +SSYMD5: ADD C,WPSTE1 + AOBJN C,SSYMD4 ;HANDLE NEXT SYM. +SSYMD8: TRNN LINK,DECSAV + JRST SSYMD3 ;ALL SYMS FOR THIS BLOCK DONE, DO NEXT BLOCK. + + ; DECSAV FMT HAS BLOCK NAMES OUTPUT LAST. + SKIPN PRGNM+BKWPB ;IF ONLY ONE BLOCK IN PGM, + JRST SSYMD3 ; FORGET IT; PGM-NAME SUBSTITUTES FOR BLKNAME. + MOVE C,BKTAB1(F) ; GET IDX FOR BLOCK + MOVE A,BKTAB(C) ; GET BLOCKNAME WITH FLAGS CLEAR + TLO A,140000 ; SET FLAGS TO SAY SYM IS BLOCKNAME + CALL RSQZA ; RIGHT-JUSTIFY SQUOZE FOR DEC (UGH BLETCH) + CALL PPB + HLRZ A,BKTAB+1(C) ; GET LEVEL OF BLOCK (NO WD COUNTS) + CALL PPB + JRST SSYMD3 + + ; RIGHT-JUSTIFY SQUOZE IN A, PRESERVING FLAGS. + ; (WHICH ASQOZR RTN DOESN'T) + ; CLOBBERS B. +RSQZA: PUSH P,A ; SAVE FLAGS + TLZA A,740000 ; ZAP +RSQZA2: DPB A,[004000,,(P)] ; UPDATE + IDIVI A,50 + JUMPE B,RSQZA2 + POP P,A + POPJ P, + +;PUNCH OUT LOCAL SYM (RELOCATABLE ASSEMBLY) +;NORMALLY OUTPUT SQUOZE W/ FLAGS ? VALUE, +;IF 3LLV SET OUTPUT PHONY NAME (= STE ADDR) ? SQUOZE W/ FLAGS, STINK FIXES IT UP. +SYMD2: LDB A,[400400,,ST(C)] + MOVE CH1,ST+1(C) ;SSYMDT MAY CHANGE CH1. + MOVE CH2,ST+2(C) + XCT SSYMDT(A) ;SKIPS IF SHOULD OUTPUT SYM. + JRST SSYMD5 + TLNE CH2,3KILL + JRST SSYMD5 + MOVE B,ST(C) + TLZ B,740000 + JUMPE B,SSYMD5 ;UNUSED ENTRY. + JUMPL LINK,SYMDEC ;J IF DEC OR FASL FMT + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LEFT HALF + TLNE CH2,3RLR + TLO B,100000 ;RELOCATE RIGHT HALF + TLNE CH2,3SKILL + TLO B,400000 ;HALF-KILL + MOVEI A,ST(C) + TLNE CH2,3LLV ;IF STINK HAS VALUE, + PUSHJ P,$OUTPT ;GIVE STINK NAME STINK KNOWS SYMBOL BY. + TLNE CH2,3LLV ;IF GIVING PHONY NAME, INSURE LOCAL FLAG SET + TLO B,ABSLCL ;(STINK WILL DO SO OTHERWISE) + MOVE A,B + PUSHJ P,$OUTPT ;OUTPUT SYM + MOVE A,CH1 + TLNN CH2,3LLV ;DON'T OUTPUT VALUE IF DON'T KNOW IT. + PUSHJ P,$OUTPT ;OUTPUT VALUE + JRST SSYMD5 + +SYMDEC: IFN FASLP,[ + TRNE LINK,FASL + JRST SYMFSL ;FASL ASSMBLY +] + PUSHJ P,ASQOZR ;RIGHT-JUSTIFY THE SQUOZE, + TLNE CH2,3SKILL + TLO B,ABSDLO ;MAYBE HALFKILL, + TLO B,ABSGLO + LDB A,[400400,,ST(C)] + CAIGE A,DEFGVR_-14. + TLC B,ABSGLO+ABSLCL ;LOCAL SYM, CHANGE GLO TO LCL. + MOVEM B,WRD + PUSH P,C + PUSHJ P,DECPW ;FIRST, THE NAME, + POP P,C + LDB TM,[420200,,ST+2(C)] + MOVE A,ST+1(C) ;THEN THE VALUE AND RELOCATION BITS. + PUSHJ P,DECWR1 + JRST SSYMD5 + +IFN FASLP,[ +SYMFSL: TLO B,400000 ;GET VALUE FROM SECOND WD + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LH + TLNE CH2,3RLR + TLO B,100000 + CAIL A,LGBLCB_<-18.+4> + TLO B,40000 ;GLOBAL FLAG + MOVE A,B + MOVEI B,15 ;PUTDDTSYM + PUSHJ P,FASO + MOVE A,CH1 + PUSHJ P,FASO1 + JRST SSYMD5 +] + +;XCT INDEXED ON SQUOZE FLAGS; SHOULDN'T PUNCH SYM IF DOESN'T SKIP. +SSYMDT: JFCL ;COM + JFCL ;PSEUDO OR MACRO + CAIA ;SYM, PUNCH OUT + TLNN CH2,3LLV ;LOCAL UNDEFINED, OUTPUT IF STINK HAS VALUE TO TELL STINK WHERE TO PUT IT. + TLZA CH1,-1 ;DEFINED LOCAL VARIABLE, CLEAR OUT LH(VALUE) + JFCL ;UNDEFINED LOCAL VARIABLE + SKIPL CONTRL ;DEFINED GLOBAL VARIABLE, PUNCH OUT IF ABS. + JFCL ;UNDEFINED GLOBAL VARIABLE + SKIPL CONTRL ;GLOBAL ENTRY, PUNCH OUT IF ABS ASSEM. + JFCL ;GLOBAL EXIT, DON'T PUNCH OUT +IFN .-SSYMDT-NCDBTS,.ERR SSYMDT LOSES. + +SSYMDX: SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL + JRST SSYMG3 + TRNE LINK,DECSAV ; IN DECSAV FORMAT, + JRST [ MOVE A,PRGNM ; PGM NAME IS LAST THING IN SYMTAB + CALL RSQZA + CALL PPB ; WITH FUNNY VALUE OF + SETZ A, ; -<# SYMTAB WDS USED BY PGM>,, + CALL PPB ; BUT LAST PGM IN SYMTAB MUST HAVE LH=0, SO... + JRST SSYMG3] + MOVE A,B ; SBLK OR RIM ASSEMBLY, OUTPUT CHKSUM. + PUSHJ P,PPB +SSYMG3: SUB P,[2,,2] + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK + SKIPL A,CONTRL ;RELOCATABLE => OUTPUT PROG NAME. + JRST SYMDA +IFN FASLP,[ + TRNE A,FASL + POPJ P, +] + TRNE A,DECREL ;DEC FMT => OUTPUT END BLOCK. + JRST PSYMSD +SYMDSA: MOVE A,STARTA ;NOW GET STARTING INSTRUCTION + JRST PPB ;PUNCH IT OUT AND RETURN + +;PUT INTO BKTAB1 THE BKTAB IDXS OF ALL THE BLOCKS IN THE ORDER THEIR +;SYMS SHOULD BE PUNCHED (A BLOCK'S SUBBLOCKS PRECEDE IT) +;THE .INIT BLOCK (MAYBE BY NOW RENAMED "GLOBAL") GOES IN LAST. D POINTS AT WHERE IT WAS PUT. +; NOTE THAT FOR DECSAV FORMAT THE ORDERING IS REVERSED; A BLOCK'S SUBBLOCKS +; FOLLOW IT, AND THE .INIT BLOCK GOES IN FIRST. + +BKSRT: MOVEI D,BKTAB1-1 ;D IS FOR PUSHING INTO BKTAB1. + MOVSI A,1 ;START WITH BLOCK 0 (OUTERMOST, .INIT). + MOVE LINK,CONTRL + + ;HANDLE BLOCK IN A: LOOK FOR ITS SUBBLOCKS. +BKSR1: TRNE LINK,DECSAV + JRST [ MOVEI C,(A) ? PUSH D,C ? JRST .+1] + SETZ C, +BKSR2: CAME A,BKTAB+1(C) + JRST BKSR3 ;THIS BLOCK ISN'T A SUBBLOCK. + ADD A,[1,,] ;LH HAS SUBBLOCK'S LEVEL. + HRRI A,(C) ;RH HAS SUBBLOCK. + PUSHJ P,BKSR1 ;HANDLE THE SUBBLOCK + MOVE A,BKTAB+1(C) ; RESTORE A (C IS PRESERVED OVER CALL) +BKSR3: ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKSR2 + MOVEI C,(A) ; RESTORE C INDEX BKSR1 WAS ENTERED WITH + TRNE LINK,DECSAV + POPJ P, + PUSH D,C ;PUT THE BLOCK IN BKTAB1 (AFTER SUBBLOCKS) + POPJ P, + +PPBCK: ROT B,1 ;OUTPUT WD IN A, UPDATING CKSUM IN B. + ADD B,A + JRST PPB + +;THE THIRD WORD OF EACH BLOCK'S ENTRY IN BKTAB GETS THE NUMBER OF +;SYMBOLS IN THAT BLOCK (OF THE SYMBOLS THAT WE WILL PUT IN THE SYMTAB). + +BKCNT: PUSH P,B + MOVEI C,0 +BKCNT0: SETZM BKTAB+2(C) ;ZERO 3RD WD OF EACH BKTAB ENTRY. + ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKCNT0 +BKCNT1: MOVE C,ST+2(B) + SOS BKTAB+2(C) ;ADD -2 FOR EACH SYM IN THE BLOCK. + SOS BKTAB+2(C) + ADD B,WPSTE1 + AOBJN B,BKCNT1 +POPBJ: POP P,B + POPJ P, + +SSRTX: HRLM B,(P) ;DO ONE PASS OF RADIX-EXCHANGE. SAVE END. + CAIL A,@WPSTEB ;ONLY 1 ENTRY, NOTHING TO DO. + JRST SSRTX7 + PUSH P,A ;SAVE START. +SSRTX3: XCT CH1 + JRST SSRTX4 ;MOVE UP TO 1ST WITH BIT ON. + SUB B,WPSTE + XCT C ;MOVE DOWN TO LAST WITH BIT OFF. + JRST SSRTX5 + MOVE D,WPSTE + CAIE D,MAXWPS + JRST .+4 +REPEAT MAXWPS,[ + MOVE D,.RPCNT(A) ;EXCHANGE THEM, + EXCH D,.RPCNT(B) + MOVEM D,.RPCNT(A)] +SSRTX4: ADD A,WPSTE +SSRTX5: CAME A,B ;ALL DONE => DO NEXT BIT. + JRST SSRTX3 ;MORE IN THIS PASS. + ROT CH2,-1 ;NEXT BIT DOWN. + POP P,A ;A -> START, B -> END OF 1ST HALF. + JUMPL CH2,SSRTX6 ;ALL BITS IN WD DONE, STOP. + PUSHJ P,(AA) ;DO NEXT BIT ON 1ST HALF. + HLRZ B,(P) ;A -> END OF 1ST HALF, B -> END OF ALL. + PUSHJ P,(AA) ;DO SECOND HALF. +SSRTX6: ROT CH2,1 ;LEAVE CH2 AS FOUND IT. +SSRTX7: HLRZ A,(P) ;LEAVE A -> END OF AREA SORTED. + POPJ P, + +;ARITHMETIC CONDITIONALS (B HAS JUMP A,) + +COND: PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,AGETFD ;GET FIELD TO TEST VALUE OF +CONDPP: POP P,T ;RESTORE CONDITIONAL JUMP INSTRUCTION + HRRI T,COND2 ;HRRI IN JUMP ADDRESS, GO TO COND2 IF CONDITIONAL TRUE + XCT T ;JUMP IF COND T,ASSEMBLE STRING +COND4: SETZM A.SUCC ;MOST RECENT CONDIT. FAILED. +COND5: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WHAT PSEUDO WE'RE IN. + CALL RCH + JSP D,RARL4 ;INIT FOR THE CONDITIONALIZED STUFF. + CAIA + CALL RARFLS ;READ AND IGNORE THE ARG. + JRST MACCR + +ANULL: TLO FF,FLUNRD + JRST COND5 + +;.ELSE, .ALSO - B'S LH WILL HAVE SKIPE OR SKIPN. +A.ELSE: HRRI B,A.SUCC + XCT B + JRST COND4 ;CONDITION FALSE. + JRST COND2 ;TRUE. + +;IF1, IF2 - B'S LH WILL HAVE TRNE FF, OR TRNN FF, +COND1: HRRI B,FRPSS2 + XCT B + JRST COND4 ;NO + ;CONDITION TRUE, ASSEMBLE STRING +COND2: SETOM A.SUCC ;LAST CONDITIONAL SUCCEEDED. +COND6: PUSHJ P,RCH ;GET NEXT CHAR + CAIE A,LBRKT + JRST [ CAIE A,LBRACE + TLO FF,FLUNRD + JRST MACCR] + SKIPN SCNDEP ;BRACKET TYPE CONDITIONAL. + SKIPE CONDEP + JRST COND7 + MOVEMM CONDLN,CLNN ;AT TOP LEVEL, SAVE IN CASE THIS UNTERMINATED + MOVEMM CONDPN,CPGN +IFN TS, MOVEMM CONDFI,INFFN1 +COND7: AOS SCNDEP ;COUNT IT FOR RBRAK'S SAKE. + JRST MACCR + +;IFB, IFNB + +SBCND: PUSH P,B ;SAVE TEST JUMP + SETZB B,C ;C COUNTS SQUOZE CHARS FOR IFB/IFNB + ;B COUNTS NONSQUOZE FOR IFSQ/IFNSQ + JSP D,RARG ;INIT FOR READING OF ARG WHOSE BLANKNESS + JRST CONDPP ;IS TO BE TESTED. + JSP D,RARGCH(T) ;READ 1 CHAR, + JRST CONDPP ;(NO MORE CHARS) + HLRZ A,GDTAB(A) ;GET GDTAB ENTRY + CAIE A,(POPJ P,) ;POPJ => NOT SQUOZE + AOJA C,RARGCH(T) + AOJA B,RARGCH(T) + + ;IFDEF, IFNDEF + +DEFCND: PUSH P,SYM + PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + PUSHJ P,ES + MOVEI A,0 ;UNDEFINED +IFN CREFSW,XCT CRFINU + CAIN A,GLOEXT_-14. ;GLOBAL EXIT... + SKIPL CONTRL ;DURING ABSOLUTE ASSEMBLY? + CAIN A,3 ;NO, LOCAL UNDEF? + MOVEI A,0 ;ONE OF THESE => UNDEF + REST SYM + EXCH SYM,(P) ;POP SYM OUT FROM UNDER THE CONDITIONAL JUMP. + JRST CONDPP + +;;PWRD ;ROUTINES TO OUTPUT ASSEMBLES WORDS AND PORTIONS THEREOF + + ;HERE FROM PBITS TO OUTPUT WORD OF CODE BITS + +PBITS3: PUSH P,A + MOVEI A,14 + MOVEM A,PBITS2 ;INITIALIZE PBITS2 FOR COUNTING DOWN THROUGH NEXT SET OF CODE BITS + MOVE A,[440300,,PBITS1] + MOVEM A,BITP ;SET UP BITP FOR RELOADING PBITS1 WITH CODE BITS + MOVE A,PBITS1 ;NOW GET ACCUMULATED WORD OF BITS + MOVEM A,@PBITS4 ;STORE IN BKBUF + AOS A,OPT1 ;RESERVE SPACE FOR NEW WORD + ;IF FRBIT7 SET (LAST CALL TO PBITS HAD 7) THEN NEXT WORD OF CODE BITS GOES + ;AFTER NEXT WORD OUTPUT (REALLY!), OTHERWISE BEFORE + TRNN FF,FRBIT7 + SOSA A + TRO FF,FRINVT + HRRZM A,PBITS4 + POP P,A + CLEARM PBITS1 + ;DROPS THROUGH + ;OUTPUT RELOCATION CODE BITS IN A + +PBITS: SKIPGE CONTRL + POPJ P, ;NOT RELOCATABLE + SOSGE PBITS2 + JRST PBITS3 ;NO MORE ROOM IN WORD, OUTPUT IT AND TRY AGAIN + CAIN A,7 + TROA FF,FRBIT7 + TRZ FF,FRBIT7 + IDPB A,BITP + POPJ P, + + ;FOLLOWING ROUTINES SAVE AC'S EXCEPT FOR A + +OUTSM0: MOVE A,SYM ;OUTPUT NAME STINK KNOWS SYMBOL BY. + TLZ A,37777 ;FOR LOCALS, THAT'S THE STE ADDR, + HRRI A,ST(D) + TLNN SYM,40000 ;FOR GLOBALS, THAT'S THE SQUOZE. + JRST $OUTPT +OUTSM: SKIPA A,SYM +OUTWD: MOVE A,WRD +$OUTPT: SKIPGE CONTRL ;DIRECTLY PUNCH OUT WORD IN A IN RELOCATABLE ASSEMBLY ONLY + POPJ P, ;DO NOTHING IF ABSOLUTE ASSEMBLY + PUSH P,AA + MOVE AA,OPT1 + TRZN FF,FRINVT ;SKIP IF BEING HACKED FROM PBITS3, PUT WORD BEFORE WHERE IT NORMALLY BELONGS + AOS AA + MOVEM A,-1(AA) + MOVE A,CLOC + TRZE FF,FRFIRWD + HRRM A,BKBUF + POP P,AA + AOS A,OPT1 + CAIL A,BSIZE+BKBUF + TRNE I,IRCONT + POPJ P, + ;MAY DROP THROUGH + +;END CURRENT OUTPUT BLOCK + +EBLK: PUSH P,T + PUSH P,TT + PUSH P,A + PUSH P,B + MOVE T,CONTRL + JUMPGE T,EBLK3 ;JUMP IF RELOCATABLE ASSEMBLY + TRNE T,ARIM10\SBLKS + JRST ESBLK + TRNE T,DECSAV + JRST EDSBLK +IFN FASLP,[ + TRNE T,FASL + JRST FASLE ;FASL HAS NO BLOCKS TO END - IGNORE +] + TRNE T,DECREL + JRST DECEBL + JRST EBLK5 + +EBLK3: MOVE T,PBITS1 + MOVEM T,@PBITS4 + MOVEI T,PBITS4 + MOVEM T,PBITS4 + MOVE T,[440300,,PBITS1] + MOVEM T,BITP + CLEARB TT,PBITS2 + CLEARM PBITS1 + MOVEI T,BKBUF + MOVE B,OPT1 ;GET POINTER TO END OF BLOCK + SUBI B,BKBUF+1 ;CONVERT TO # WORDS IN BLOCK (EXCLUDING HEADER) + DPB B,[220700,,BKBUF] ;SET COUNT FIELD IN HEADER + TRZN FF,FRLOC + JUMPLE B,EBLK5 ;IGNORE NULL BLOCK UNLESS FRLOC SET + TLO FF,$FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) + PUSHJ P,FEED +EBK1: CAML T,OPT1 ;DONE WITH BLOCK? + JRST EBK2 ;YES + MOVE A,(T) ;NO, GET DATA WORD + JFCL 4,.+1 ;UPDATE CHECKSUM + ADD TT,A + JFCL 4,[AOJA TT,.+1] + PUSHJ P,PPB ;OUTPUT WORD + AOJA T,EBK1 +EBK2: SETCM A,TT ;DONE OUTPUTTING BLOCK, NOW GET CHECKSUM + PUSHJ P,PPB ;OUTPUT CHECKSUM + MOVE T,CDATBC ;GET BLOCK TYPE + DPB T,[310700,,BKBUF] ;SET NE T BLOCK TYPE TO STORAGE WORDS BLOCK TYPE + MOVEI T,BKBUF+1 + MOVEM T,OPT1 +EBLK4: TLO FF,$FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) +EBLK5: TRO FF,FRFIRWD +FASLE: POP P,B + POP P,A +PTT.TJ: POP P,TT + POP P,T + POPJ P, + +;PUNCH OUT WORD OF CODED DATA (E.G. STORAGE WORD); WRD, WRDRLC, GLOTB ENTRIES + +PWRDA: TROA FF,FRNLIK ;SUPPRESS ADR LINKING +PWRD: TRZ FF,FRNLIK ;PERMIT ADR LINKING +IFN LISTSW,[ + SKIPN LSTONP + JRST PWRDL ;NOT MAKING LISTING NOW. + SKIPGE LISTPF + PUSHJ P,PNTR + SETOM LISTPF + MOVE LINK,WRD + MOVEM LINK,LISTWD + MOVE LINK,WRDRLC + MOVEM LINK,LSTRLC + MOVE LINK,CLOC + MOVEM LINK,LISTAD + MOVE LINK,CRLOC + DPB LINK,[220100,,LISTAD] +PWRDL: +] ;END IFN LISTSW, + JUMPGE FF,CPOPJ ;IGNORE IF NOT PUNCHING PASS + SKIPGE LINK,CONTRL + JRST PWRD1 ;ABSOLUTE ASSEMBLY + ;RELOCATABLE ASSEMBLY + PUSHJ P,$RSET ;CHECK VALIDITY OF RELOCATION, STANDARDIZE IF NON-STANDARD + MOVE A,GLSP2 + CAMN A,GLSP1 + JRST PWRD2 ;NO GLOBALS + + ;NOW TO SEE IF IT'S POSSIBLE OR DESIRABLE TO ADDRESS LINK + + HRLZ B,WRD + HRR B,WRDRLC + JUMPN B,PWRD3 ;JUMP IF RH NON-ZERO + TRNN FF,FRNLIK + SKIPGE GLOCTP + JRST PWRD3 ;ADR LINKING SUPPRESSED OR CLOC GLOBAL + SKIPE LDCCC + JRST PWRD3 ;IN LOAD TIME CONDITIONALS + MOVNI T,1 ;INITIALIZE T FOR COUNTING +PWRD4: CAML A,GLSP1 + JRST PWRD5 ;DONE + HRRZ TT,1(A) ;GET GLOTB ENTRY + JUMPE TT,PWRD7A + LDB TT,[400400,,(TT)] ;GET SQUOZE FLAGS FROM SYM + CAIE TT,DEFGVR_-14. + CAIN TT,GLOETY_-14. + JRST PWRD3 ;DEFINED, BUT MUST BE HERE FOR A REASON (SEE $.H) + HLRZ TT,1(A) + TRNE TT,1777+MINF + JRST PWRD3 ;NEGATED OR MULTIPLIED + TRNE TT,HFWDF + JRST PWRD7 + TRNE TT,ACF + TRNN TT,SWAPF + JRST PWRD3 ;NOT HIGH AC +PWRD7A: AOJA A,PWRD4 +PWRD7: TRNE TT,SWAPF + AOJA A,PWRD4 ;LEFT HALF + AOJN T,PWRD3 ;JUMP IF THIS NOT FIRST GLOBAL IN RIGHT HALF + MOVEI D,1(A) ;FIRST GLOBAL, SET UP POINTER TO GLOTB ENTRY + AOJA A,PWRD4 + +PWRD5: AOJE T,PWRD3 ;NO GLOBALS LOOK BAD AND THERE AREN'T TOO MANY; JUMP IF NONE IN RH + HRRZ T,(D) ;GET ADR OF SQUOZE + SKPST T, ;SKIP IF IN SYMBOL TABLE + JRST PWRD3 ;BELOW SYMBOL TABLE, DON'T ADDRESS LINK AFTER ALL + PUSH P,T ;HOORAY, WE CAN ADDRESS LINK + SETZM (D) ;CLEAR OUT GLOTB ENTRY, DON'T NEED IT ANY MORE + PUSHJ P,PWRD31 ;DUMP OUT THE OTHER GLOBALS + POP P,D ;GET ST ADR OF THIS AGAIN + 3GET1 A,D + LDB A,[.BP (3RLNK),A] + MOVE B,WRDRLC + TLNE B,1 + TRO A,2 ;RELOCATE LEFT HALF + PUSHJ P,PBITS ;PUNCH OUT APPROPRIATE BITS FOR LINK LIST ENTRY + HLR A,1(D) ;GET ADR OF LAST + HLL A,WRD + PUSHJ P,$OUTPT ;OUTPUT WORD WITH RH = ADR OF LAST RQ FOR SYM TO PUT IN RH'S + MOVE A,CLOC ;NOW UPDATE ST ENTRY + HRLM A,1(D) + 3GET1 B,D + SKIPN CRLOC + TLZA B,3RLNK ;CLOC NOT RELOCATED LAST TIME THIS SYM USED + TLO B,3RLNK ;RELOCATED + 3PUT1 B,D + POPJ P, + +PWRD31: MOVE T,GLSP2 ;DUMP ALL GLO S IN GENERAL FORMAT +PWRD3A: CAML T,GLSP1 + POPJ P, + MOVE B,1(T) + TRNN B,-1 + AOJA T,PWRD3A + TLNE B,1777 + JRST RPWRD ;REPEAT +RPWRD1: LDB A,[.BP (MINF),B] + TRO A,4 + PUSHJ P,PBITS + MOVE A,(B) ;CODEBITS +SQUOZE FOR SYM + HLRZ C,A + TLZ A,740000 + CAIL C,DEFGVR + TLOA A,40000 ;SYM IS GLO + JRST [ + MOVEI C,(B) ;IF WE ARE OUTPUTTING A REFERENCE TO THE + CAIL C,PCNTB ;"LABEL" AT THE BEGINNING OF A CONSTANTS AREA + CAIL C,PCNTB+NCONS*3 ;(BECAUSE THIS IS A 1PASS ASSEMBLY) USE THE + MOVEI A,(B) ;NAME, SINCE THE SYMBOL ISN'T IN THE + JRST .+1] ;SYMTAB + TLNE B,SWAPF + TLO A,400000 + TLNE B,ACF + JRST PWRD3E ;AC HIGH OR LOW + TLNN B,HFWDF + JRST PWRD3F ;ALL THROUGH + TLO A,100000 + TLNE B,SWAPF + TLC A,300000 +PWRD3F: PUSHJ P,$OUTPT + AOJA T,PWRD3A + + + +RPWRD: PUSHJ P,PBITS7 + MOVEI A,CRPT + PUSHJ P,PBITS + LDB A,[221200,,B] + PUSHJ P,$OUTPT + JRST RPWRD1 + +PWRD3E: TLO A,300000 + JRST PWRD3F + +PWRD3: PUSHJ P,PWRD31 +PWRD2: PUSHJ P,RCHKT + HRRZ A,B + DPB T,[10100,,A] + PUSHJ P,PBITS + JRST OUTWD + +;CHECK FOR VALIDITY OF RELOCATION BITS OF CURRENT WORD +;LEAVE RELOC (RH) IN B, RELOC (LH) IN T + +RCHKT: HRRZ B,WRDRLC ;CHECK FOR RELOC. OTHER THAN 0 OR 1. + HLRZ T,WRDRLC + TRZN B,-2 + TRZE T,-2 +RLCERR: ETSM [ASCIZ /Illegal relocation/] + POPJ P, + +RMOVET: ROT T,-1 + DPB B,[420100,,T] + TLZ C,3DFCLR ;SET RELOC BITS IN C + IOR C,T ;FROM B AND T. + POPJ P, + + ;CHECK WRDRLC FOR VALIDITY (CAPABILITY OF BEING PUNCHED OUT) + ;IF STANDARD THEN JUST RETURN + ;IF NON-STANDARD BUT OTHERWISE OK, PUT $R. ON GLOBAL LIST, RESET WRDRLC, AND RETURN + ;LEAVES B AND C SET UP WITH RH, LH OF WRDRLC. + +$RSET: MOVE C,WRDRLC ;GET RELOCATION + ADDI C,400000 ;WANT TO SEPARATE HALFWORDS + HLRE B,C ;GET LH IN B + HRREI C,400000(C) ;GET RH IN C (WILL EXCHANGE LATER) + MOVE A,[SWAPF+HFWDF,,$R.H] ;PUT THIS ON GLOBAL LIST IF LH NEEDS $R. + TRNE B,-2 ;CHECK LH + PUSHJ P,$RSET1 ;LH NEEDS GLOBAL REFERENCE + EXCH B,C + HRLI A,HFWDF + TRNE B,-2 ;CHECK RH + PUSHJ P,$RSET1 ;RH NEEDS GLOBAL REFERENCE + HRLZM C,WRDRLC ;RELOC OF LH + ADDM B,WRDRLC ;COMPLETE SETTING UP WRDRLC + POPJ P, + +$RSET1: JUMPGE B,$RSET2 ;STRANGE RELOCATION IN B, JUMP IF NON-NEGATIVE + MOVN T,B ;NEGATIVE, GET MAGNITUDE + TLOA A,MINF ;SET FLAG TO NEGATE GLOBAL +$RSET2: SOSA T,B ;POSITIVE, GET ONE LESS THAN IT IN T + TDZA B,B ;NEGATIVE, CLEAR B, RELOCATION LEFT OVER + MOVEI B,1 ;POSITIVE, SET RELOCATION LEFT OVER TO 1 + CAIN T,1 + MOVEI T,0 ;MULTIPLYING BY TWO OR SUBTRACTING TIMES 1 + TRNE T,-2000 + ETSM [ASCIZ /Relocation too large/] ;TOO BIG EVEN FOR $RSET + DPB T,[221200,,A] ;LOOKS OK, STORE TIMES FIELD IN $R. REFERENCE + AOS GLSP1 ;NOW PUT $R. ON GLOBAL LIST + MOVEM A,@GLSP1 + POPJ P, + +;PWRD DURING ABSOLUTE ASSEMBLY + +PWRD1: TRNE LINK,DECREL ; DEC REL FMT IS CONSIDERED ABSOLUTE. + JRST DECPW +IFN FASLP,[ + TRNE LINK,FASL + JRST FASPW ;SO IS FASL +] + MOVE A,GLSP1 + CAME A,GLSP2 + ETR ERRILG ;GLOBALS APPEARING ILLEGALLY + SKIPE WRDRLC + ETR ERRIRL ;RELOCATION APPEARING ILLEGALLY + TRNE LINK,ARIM + JRST PRIM ;RIM + TRNE LINK,DECSAV + JRST DSBLK1 +SBLKS1: MOVE A,WRD ;SBLK + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FRFIRWD + MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER + AOS A,OPT1 + CAIGE A,BKBUF+BSIZE + POPJ P, ;BKBUF NOT FULL YET + +SBLKS2: SUBI A,BKBUF+1 + JUMPE A,CPOPJ + MOVNS A + HRLM A,BKBUF + PUSHJ P,FEED + MOVEI T,BKBUF + CLEARM SCKSUM +SBLK1: CAML T,OPT1 + JRST SBLK2 + MOVE A,SCKSUM + ROT A,1 + ADD A,(T) + MOVEM A,SCKSUM + MOVE A,(T) + PUSHJ P,PPB + AOJA T,SBLK1 + +SBLK2: TRO FF,FRFIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,SCKSUM + JRST PPB + +ESBLK: MOVE A,OPT1 + CAIN A,BKBUF+1 + JRST EBLK5 ;AVOID SETTING $FLOUT IF NULL BLOCK. + PUSHJ P,SBLKS2 + JRST EBLK4 + +PRIM: MOVSI A,(DATAI PTR,) + HRR A,CLOC + PUSHJ P,PPB + MOVE A,WRD + JRST PPB + +; COME HERE TO OUTPUT WD IN ABSOLUTE DEC FMT (DECSAV) + +DSBLK1: MOVE A,WRD + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FRFIRWD + MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER + AOS A,OPT1 + CAIGE A,BKBUF+BSIZE + POPJ P, ;BKBUF NOT FULL YET, RETURN + +DSBLK2: SUBI A,BKBUF+1 + JUMPE A,CPOPJ + MOVNS A + SOS BKBUF ; DEC "IOWD" FMT, POINT AT LOC-1 + HRLM A,BKBUF + PUSHJ P,FEED + MOVEI T,BKBUF +DSBLK3: CAML T,OPT1 + JRST DSBLK4 + MOVE A,(T) + PUSHJ P,PPB + AOJA T,DSBLK3 + +DSBLK4: TRO FF,FRFIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + POPJ P, + +; END A BLOCK IN DEC SAV FMT, COME HERE FROM EBLK. + +EDSBLK: MOVE A,OPT1 + CAIN A,BKBUF+1 + JRST EBLK5 ;AVOID SETTING $FLOUT IF NULL BLOCK. + PUSHJ P,DSBLK2 + JRST EBLK4 + + +;END A BLOCK IN DEC FMT. COME FROM EBLK. +DECEBL: PUSH P,[EBLK5] +DECEB1: MOVSI A,DECWDS ;JUST INIT. AN ORDINARY BLOCK, + +;COME HERE TO OUTPUT PREVIOUS BLOCK AND START NEW BLOCK OF TYPE IN LH OF A. +DECBLK: PUSH P,A + HRRZ A,BKBUF ;GET DATA-WORD COUNT OF CURRENT BLOCK. + JUMPE A,DECB1 ;NO WORDS => CAN IGNORE. + MOVEI TT,BKBUF+1 +DECB0: MOVE A,-1(TT) ;GET AND PUNCH NEXT WD OF BLOCK. + PUSHJ P,PPB + CAME TT,OPT1 ;STOP WHEN NEXT WD ISN'T IN BLOCK. + AOJA TT,DECB0 +DECB1: POP P,A + HLLZM A,BKBUF ;PUT BLOCK TYPE IN LH OF HEADER, DATA WD COUNT IN RH IS 0. + MOVEI TT,BKBUF+2 ;ADDR OF PLACE FOR 1ST DATA WD + MOVEM TT,OPT1 ;(LEAVE SPACE FOR WD OF RELOC BITS) + MOVE TT,[440200,,BKBUF+1] + MOVEM TT,BITP ;BP FOR STORING PAIRS OF RELOC BITS. + SETZM BKBUF+1 ;CLEAR THE WD OF RELOC BITS. + TLO FF,$FLOUT + POPJ P, + +;COME HERE TO OUTPUT A WORD IN DEC FORMAT. +DECPW: MOVS A,BKBUF + CAIE A,DECWDS ;BEFORE THE 1ST STORAGE WD IN ORDINARY BLOCK, + JRST DECPW0 + MOVE A,CRLOC ;MUST GO THE LOCATION CTR. + IDPB A,BITP + MOVE A,CLOC + MOVEM A,@OPT1 + AOS OPT1 + AOS BKBUF ;IT COUNTS AS DATA WORD. +DECPW0: MOVE A,BITP + TLNE A,77^4 ;IF NO ROOM FOR MORE RELOC BITS, + JRST DECPW1 + HLLZ A,BKBUF ;START A NEW BLOCK. + PUSHJ P,DECBLK + JRST DECPW + +DECPW1: PUSHJ P,$RSET ;SET UP RELOC BITS OF HALVES IN B,C. + LSH C,1 + IORI B,(C) ;COMBINE THEM. + MOVE A,GLSP1 + CAME A,GLSP2 + JRST DECPG ;GO HANDLE GLOBALS. +DECPW3: IDPB B,BITP ;STORE THE RELOC BITS + MOVE A,WRD +DECPW2: MOVEM A,@OPT1 ;AND THE VALUE. + AOS OPT1 + AOS BKBUF + POPJ P, + +;PUT A WORD DIRECTLY INTO DEC FMT BLOCK. +DECWRD: SETZ TM, +DECWR1: IDPB TM,BITP ;SKIP A PAIR OF RELOC BITS, + JRST DECPW2 ;STORE THE WORD. + +;HANDLE GLOBAL REFS IN DEC FMT. +DECPG: PUSHJ P,DECPW3 ;FIRST, OUTPUT THE WORD, +DECPG0: MOVSI A,DECSYM + PUSHJ P,DECBLK ;THEN STRT A SYMBOLS BLOCK. + MOVE C,GLSP2 + PUSH P,SYM +DECPG1: CAMN C,GLSP1 ;ALL DONE => + JRST DECPG2 ;GO START AN ORDINARY BLOCK FOR NEXT WD. + MOVE A,BITP + TLNN A,77^4 ;BLOCK FULL => START ANOTHER. + JRST DECPG0 + AOS C,GLSP2 ;GET ADDR OF NEXT GLOBAL REF. + MOVE B,(C) + MOVE B,(B) ;GET NAME OF SYM. + TLZ B,740000 + CAMN B,[SQUOZE 0,$R.] + JRST DECPG3 ;(DEC'S LOADER HAS NO SUCH HACK.) + CALL ASQOZR ;RIGHT-JUSTIFY THE SQUOZE FOR DEC SYSTEM. + MOVE A,B + TLO A,600000 ;PUT IN FLAGS SAYING ADDITIVE GLOBAL RQ. + PUSHJ P,DECWRD ;OUTPUT NAME. + HRRZ A,CLOC ;GET ADDR OF RQ, + TLO A,400000 ;MACRO-10 SETS THIS BIT SO I WILL. + MOVE B,(C) + TLNE B,SWAPF ;SWAPPED => TELL LOADER.. + TLO A,200000 + TLNE B,ACF+MINF + ETSM ERRILG ;CAN'T NEGATE GLOBAL OR PUT IN AC. + MOVE TM,CRLOC + PUSHJ P,DECWR1 ;OUTPUT 2ND WD, + JRST DECPG1 ;GO BACK FOR MORE GLOBAL REFS. + +DECPG2: REST SYM + JRST DECEB1 + +DECPG3: ETR ERRIRL ;WE NEEDED $R. BUT DIDN'T HAVE IT. + JRST DECPG1 + +ERRILG: ASCIZ /Illegal use of external/ +ERRIRL: ASCIZ /Illegal use of relocatables/ + + +;OUTPUT PROGRAM NAME BLOCK (AT START OF PASS 2) +;IF 2-SEG PROGRAM, ALSO OUTPUT A TYPE-3 BLOCK (LOAD INTO HISEG) +DECPGN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2. + PUSH P,[EBLK] + MOVSI A,DECNAM + CALL DECBLK + MOVE B,PRGNM + CALL ASQOZR + MOVE A,B + CALL DECWRD + MOVSI A,14 ;IDENTIFY THIS REL FILE AS MADE BY MIDAS. + CALL DECWRD + MOVE A,DECTWO + CAMN A,[MOVE] + RET ;NOT A 2-SEG PROGRAM. +DECP2S: MOVSI A,DECHSG + CALL DECBLK ;START A LOAD-INTO-HISEG BLOCK. + MOVE A,DECTWO + HRL A,DECBRH ;HISEG BRK,,TWOSEG ORIGIN. + SKIPL A + HRLI A,(A) + MOVEI TM,1 ;RELOCATION IS 1. + JRST DECWR1 + +IFN FASLP,[ +;INITIALIZE OUTPUT FOR FASL ASSEMBLY +FASOIN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2 + MOVE A,[SIXBIT /*FASL*/] + PUSHJ P,PPB + MOVE A,[MIDVRS] + LSH A,-6 + TLO A,(SIXBIT /M/) + PUSHJ P,PPB ;"LISP" VERSION NUMBER (USE M AND MIDAS NUMBER) + MOVE A,[440400,,FASB] ;INITIALIZE FASL OUTPUT BUFFER + MOVEM A,FASCBP + MOVEI A,FASB+1 + MOVEM A,FASBP + POPJ P, + + +;COME HERE TO OUTPUT A WORD IN FASL FORMAT +FASPW: MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;"PUNCH" OUT ATOM TBL (IF MORE HAS APPEARED) + PUSHJ P,$RSET ;GET RELOC + PUSH P,C ;SAVE LH RELOC + MOVEM B,FASPWB ;B HAS RELOC, WHICH IS ALSO FASL CODE FOR RELOC =1 + MOVE A,GLSP2 +FASPW3: CAME A,GLSP1 + JRST FASPW1 ;LOOK TO SEE .. +FASPW2: MOVE A,WRD ;B HAS RELOC, WHICH ALSO HAPPENS TO BE FASL CODE TYPE + MOVE B,FASPWB + PUSHJ P,FASO ;OUTPUT WORD IN A WITH FASL CODE IN B + POP P,TM + JUMPE TM,FASPW5 ;NO LEFT HALF RELOC, OK + MOVNI A,1 ;ACTIVATE FASL HACK FOR LH RELOC + MOVEI B,7 ;WOULD OTHERWISE BE GETDDTSYM + PUSHJ P,FASO +FASPW5: MOVE C,GLSP2 +FASPW6: CAMN C,GLSP1 + POPJ P, + HRRZ TM,1(C) + JUMPE TM,[AOJA C,FASPW6] + MOVE SYM,(TM) ;GET SQUOZE OF SYM + TLZ SYM,740000 ;CLEAR CODE BITS + HLRZ D,1(C) + TRZ D,400000 ;DONT WORRY ABOUT THAT BIT + TRZE D,MINF + TLO SYM,400000 ;NEGATE + CAIN D,SWAPF + JRST FSPWSW + CAIN D,HFWDF + JRST FSPWRH + CAIN D,ACF+SWAPF + JRST FSPWAC + JUMPE D,FSPWWD + ETSM [ASCIZ /Global in illegal FASL context/] + +FSPWWD: TLOA SYM,140000 +FSPWAC: TLOA SYM,100000 +FSPWRH: TLO SYM,40000 +FSPWSW: MOVE A,SYM + MOVEI B,7 ;DDT SYM + PUSHJ P,FASO + AOJA C,FASPW6 + +FASPW1: HRRZ TM,1(A) ;GLOTB ENTRY + JUMPE TM,FASPW4 + CAIL TM,AFDMY1 + CAIL TM,AFDMY2 +FASPW4: AOJA A,FASPW3 + MOVE C,1(A) ;ITS A LIST STRUCTURE REF + TLNN C,-1-HFWDF + SKIPE FASPWB + ETA [ASCIZ /Illegal LISP structure reference/] + MOVE TM,AFDMY2-AFDMY1(TM) ;GET FASL BITS + MOVEM TM,FASPWB ;FASL BITS + CLEARM 1(A) ;FLUSH THAT GUY + AOJA A,FASPW3 + +FPATB: CAMN C,FASATP ;PUNCH OUT ATOM TBL, AMT ALREADY PUNCHED IN C + POPJ P, ;THRU + MOVEI B,12 ;ATOM TBL INFO + MOVE A,FASAT(C) + TRNN A,-1 + AOJA C,FPATB3 ;LIST WORD .. SHOULD HAVE PUNCHED ITSELF + PUSHJ P,FASO + HRRZ D,FASAT(C) ;ATOM "LENGTH" + AOS C +FPATB1: SOJL D,FPATB2 + MOVE A,FASAT(C) + PUSHJ P,FASO1 + AOJA C,FPATB1 + +FPATB3: ETR [ASCIZ /Internal loss at FPATB3/] +FPATB2: MOVEM C,FASPCH ;RECORD AMOUNT PUNCHED + JRST FPATB ;LOOP BACK IF MORE + + +FASO: PUSHJ P,FASBO ;WRITE BITS +FASO1: MOVEM A,@FASBP ;STORE A IN FASL OUTPUT BUFFER + AOS TM,FASBP + CAIL TM,FASB+FASBL + ETF [ASCIZ /.FASL output block too long/] + POPJ P, + +FASBO: MOVE TM,FASCBP ;OUTPUT FASL CODEBITS IN B, WRITE PREV BLOCK IF NECC + TLNN TM,770000 + PUSHJ P,FASBE ;WRITE PREV FASL BLOCK + IDPB B,FASCBP + POPJ P, + +FASBE: PUSH P,A + PUSH P,B + MOVEI TT,FASB +FASBO2: CAML TT,FASBP + JRST FASBO3 + MOVE A,(TT) + PUSHJ P,PPB + AOJA TT,FASBO2 + +FASBO3: POP P,B + POP P,A + CLEARM FASB ;NEW CODE WORD + MOVEI TM,FASB+1 + MOVEM TM,FASBP + SOS FASCBP + POPJ P, + +AFATOM: PUSH P,B ;SAVE CODEBITS + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ATOM illegal except in FASL assembly/] + PUSHJ P,AFRATM ;READ "ATOM", RETURN INDEX IN A + POP P,B + HLRZS B +AFLST1: AOS GLSP1 + MOVEI T,AFDMY1(B) ;DUMMY (STORE THIS INFO IN SYM SO CONSTANTS WILL WIN + HRRZM T,@GLSP1 + MOVEI B,0 ;NO RELOCATION + POPJ P, + +;GLOBALS IN THIS TABLE KEEP TRACK OF LIST REFS +;UNDEF GLOBAL GODEBITS +AFDMY1: SQUOZE 44,.%VCEL ;EVENTUALLY POINT TO VALUE CELL + SQUOZE 44,.%SCAL ;EVENTUALLY BECOME "SMASHABLE CALL" + SQUOZE 44,.%ATM ;EVENTUALLY POINT TO ATOM + SQUOZE 44,.%ARY ;EVENTUALLY POINT TO ARRAY +AFDMY2: 2 ;CODE BITS FOR VALUE CELL REF + 3 ;CODE BITS FOR SMASHABLE CALL + 4 ;CODE BITS FOR POINTER TO ATOM + 10 ;CODE BITS FOR POINTER TO ARRAY + +AFRATM: PUSHJ P,AFRTKN ;READ TOKEN, LEAVING IT AT END OF FASAT + PUSHJ P,AFRITN ;"INTERN" IT, SKIP IF NOT FOUND + POPJ P, ;IF FOUND, INDEX IN A + PUSHJ P,AFRENT ;ENTER IN FASAT + POPJ P, + +AFRENT: MOVE A,FASAT1 ;STORE FASAT1 IN FASATP + MOVEM A,FASATP + AOS A,FASIDX ;RETURN LOAD TIME ATOM INDEX + POPJ P, + +AFRTKN: MOVE A,FASATP + ADD A,[700,,FASAT] + MOVEM A,FASAT2 ;BYTE PNTR TO USE TO STORE ATOM + CLEARM (A) + CLEARM 1(A) ;MAKE SURE ALL LOW BITS CLEARED + PUSHJ P,RCH + CAIN A,"# + JRST AFRTK1 ;READ NUMBER INTO FIXNUM SPACE + CAIN A,"& + JRST AFRTK2 ;READ NUMBER INTO FLONUM SPACE +AFRTKL: IDPB A,FASAT2 ;STORE CHAR + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 +AFTERR: ETA [ASCIZ /LISP atom name table full/] + CLEARM 1(A) +AFRTL2: PUSHJ P,RCH + CAIN A,12 + JRST AFRTL2 ;IGNORE LF IN ATOM NAMES (PRIMARILY SO /CR WINS WITH ONE + CAIN A,"/ ;SLASH + JRST AFRQT ;QUOTE CHAR + CAIE A,40 + CAIN A,15 + JRST AFREND + CAIE A,"; + CAIN A,11 + JRST AFREND + CAIE A,"( + CAIN A,") + JRST AFREN2 + CAIL A,"A+40 + CAILE A,"Z+40 + JRST AFRTKL ;THAT CHAR WINS, SALT IT + SUBI A,40 + JRST AFRTKL ;MAYBE MUST CONVERT TO L.C. BEFORE SALTING IT. + +AFRQT: PUSHJ P,RCH ;TAKE NEXT CHR NO MATTER WHAT + JRST AFRTKL + +AFRTK1: SKIPA TM,[100000,,1] ;PUT VAL IN FIXNUM SPACE +AFRTK2: MOVE TM,[200000,,1] ;PUT IT IN FLONUM SPACE + PUSH P,TM + MOVE SYM,[SQUOZE 0,ATOM] + PUSHJ P,FAGTFD + POP P,TM + MOVE B,FASATP + ADDI B,2 + CAIL B,FASAT+FASATL + XCT AFTERR + MOVEM TM,FASAT-2(B) + MOVEM A,FASAT-1(B) + MOVEM B,FASAT1 + POPJ P, + +AFREN2: TLO FF,FLUNRD ;SAVE ( OR ) AS WELL AS FLUSHING +AFREND: MOVEI B,5 ;PAD END OF P.N. WITH 0 S + MOVEI TM,0 +AFREN1: IDPB TM,FASAT2 + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 + XCT AFTERR + CLEARM 1(A) + SOJG B,AFREN1 + SUBI A,FASAT + MOVEM A,FASAT1 ;STORE PNTR TO WORD BEYOND ATOM + ; MAYBE PUT THIS IN FASATP + MOVE B,FASATP ;ADR OF START OF ATOM READ + SUBI A,1(B) ;COMPUTE LENGTH OF FASAT + HRRZM A,FASAT(B) ;PN ATOM 4.8-4.7 =0 STORE LENGTH IN HEADER WD + + POPJ P, + +AFRITN: MOVEI B,0 ;"INTERN" LAST ATOM READ IN + MOVEI A,1 ;A CONTAINS RUNTIME ATOM TBL INDEX + ;B INDEX WITHIN FASAT +AFRIT1: CAML B,FASATP + JRST POPJ1 ;NOT FOUND + MOVE C,FASATP ;POINTS AT HEADER OF WORD OF NEW (?) ATOM + HRRZ D,FASAT(B) ;HEADER WD OF GUY IN TBL(RIGHT HALF HAS LENGTH) + JUMPE D,AFRIT4 ;JUMP ON RESERVED FOR LIST +AFRIT2: MOVE TM,FASAT(C) + CAME TM,FASAT(B) + AOJA B,AFRIT3 ;THIS ONE LOSES + SOJL D,CPOPJ ;THIS ONE WINS! + AOS B + AOJA C,AFRIT2 + +AFRIT3: SOJL D,[AOJA A,AFRIT1] ;FINISH SPACING OVER THIS GUY +AFRIT4: AOJA B,AFRIT3 + +AFENTY: SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ENTRY in NON-FASL/] + SKIPN CRLOC + ETI [ASCIZ /.ENTRY when . is absolute/] + PUSHJ P,AFRATM ;READ FUNCTION NAME + HRLZS A + PUSH P,A + PUSHJ P,AFRATM ;READ TYPE (SUBR, LSUBR, ETC) + HRRM A,(P) + MOVE SYM,[SQUOZE 0,.ENTRY] + PUSHJ P,FAGTFD ;READ ARGS PROP + JUMPGE FF,ASSEM1 ;NOT PUNCHING PASS + PUSH P,A + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ANY NEW ATOMS OUT + POP P,C + POP P,A + MOVEI B,13 + PUSHJ P,FASO + HRL A,C + HRR A,CLOC + PUSHJ P,FASO1 + JRST ASSEM1 + +AFLIST: HLRZM B,AFLTYP + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.LIST illegal except in FASL assembly/] + PUSHJ P,AFRLST ;READ LIST, RTN ATM TBL INDEX IN A + SKIPN AFLTYP + JRST ASSEM1 ;JUST EVAL IN LISP AND THROW AWAY VALUE + MOVEI B,AFDMAI ;"ATOM" INDEX IN AFDMY1 TBL + JRST AFLST1 ;TREAT AS ATOM + +AFRLST: CLEARM AFRLD ;"DEPTH" + CLEARM AFRLEN ;"LENGTH" OF LIST AT CURRENT LEVEL + CLEARM AFRDTF ;DOT CONTEXT FLAG + JUMPGE FF,AFRLI1 + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ALL ATOMS "PUNCHED" + MOVE A,FASATP + MOVEM A,AFRFTP ;SAVED STATE OF FASAT POINTER + MOVE C,AFLTYP + MOVEI B,16 ;EVAL TYPE HACK + CAIN C,1 + MOVEI B,5 ;LIST TYPE HACK + PUSHJ P,FASBO ;WRITE CODE BITS +AFRLI1: +AFRL1: PUSHJ P,RCH + CAIE A,40 ;PREV ATOM (OR WHATEVER) "DELIMITED", SO THESE MEANINGLESS + CAIN A,15 ;UNLESS AT TOP LEVEL AND HAVE READ SOMETHING + JRST AFRL1A + CAIE A,11 + CAIN A,12 + JRST AFRL1A + CAIN A,"( + JRST AFRLO + CAIN A,") + JRST AFRLC + CAIN A,". + JRST AFRDT ;DOT.. + TLO FF,FLUNRD + SKIPE AFRLD + JRST AFRNXT ;READ NEXT GUY THIS LVL + SKIPE AFRLEN +AFRLO2: ETI [ASCIZ /LISP read context error/] +AFRNXT: SKIPN TM,AFRDTF + JRST AFRNX2 ;NOT HACKING DOTS, OK + AOS TM,AFRDTF + CAIE TM,2 + JRST AFRLO2 ;DIDNT JUST SEE THE DOT +AFRNX2: PUSHJ P,AFRATM + JUMPGE FF,AFRNX1 ;XFER ON NOT PUNCHING PASS + PUSHJ P,FASO1 ;TELL LOADER TO PUSH THIS ON ITS STACK +AFRNX1: AOS AFRLEN ;LIST NOW ONE LONGER THIS LVL + JRST AFRL1 + +AFRLO: SKIPN TM,AFRDTF + JRST AFRLO3 ;NOT HACKING DOTS + SOJN TM,AFRLO2 + CLEARM AFRDTF + JRST AFRL1 ;IGNORE BOTH . AND ( + +AFRLO3: SKIPE AFRLD ;( + JRST AFRLO1 + SKIPE AFRLEN + JRST AFRLO2 +AFRLO1: PUSH P,AFRLEN + CLEARM AFRLEN ;START NEW LVL + AOS AFRLD ;DEPTH NOW ONE GREATER + JRST AFRL1 + +AFRLC: SOSGE AFRLD ;) + JRST AFRLO2 ;AT TOP LEVEL, BARF + MOVE A,AFRLEN + SKIPN TM,AFRDTF + JRST AFRLC2 ;NOT HACKING DOTS + CAIE TM,2 + JRST AFRLO2 + SOS A ;MAIN LIST NOW ONE SHORTER + TLOA A,200000 ;DOT WITH LAST THING ON STACK +AFRLC2: TLO A,100000 ;TELL LOADER TO MAKE LIST THIS LONG + JUMPGE FF,AFRLC5 + PUSHJ P,FASO1 +AFRLC5: POP P,AFRLEN ;LENGTH AT PREV LVL + AOS AFRLEN ;NOW ONE MORE + CLEARM AFRDTF ;NOT HACKING DOTS NOW + SKIPE AFRLD ;RETURNING TO TOP LEVEL? + JRST AFRL1 + JRST AFRX1 ;YES THRU + +AFRDT: SKIPN AFRDTF + SKIPN AFRLEN + JRST AFRLO2 ;DOT IN FIRST POSITION OF LIST + AOS AFRDTF ;ENTER STATE 1 OF DOT HACKING + JRST AFRL1 + +AFRL1A: SKIPN AFRLD ;SPACER CHAR TERMINATES AT TOP LVL IF HAVE RD SOMETHING + SKIPN AFRLEN + JRST AFRL1 +AFRX1: JUMPGE FF,AFRX2 ;NOT PUNCHING PASS + MOVE A,AFRFTP + CAME A,FASATP + ETR [ASCIZ /Saw atoms in list on pass 2 for first time/] + SKIPN B,AFLTYP ;TYP LIST OP + SKIPA A,[-1,,] + MOVSI A,-2 ;PUT LIST OR VALUE OF LIST IN ATOM TBL + PUSHJ P,FASO1 ;TERM OP AND PUT IT IN ATOM TBL + MOVEI A,0 + MOVE B,AFLTYP + JUMPE B,CPOPJ ;JUST WANT VALUE OF LIST + CAIN B,1 ;ONLY WANT THIS FOR STRAIGHT LIST + PUSHJ P,FASO1 ;OUTPUT "SXHASH" WORD + AOS A,FASATP + CLEARM FASAT-1(A) ;RESERVE SLOT IN FASAT TBL + MOVEM A,FASPCH ;SAY ALREADY PUNCHED OUT + AOS A,FASIDX + POPJ P, + +AFRX2: TLO I,ILNOPT ;DONT TRY TO OPTIMIZE IF IN CONSTANT + CLEARB A,B + POPJ P, +] + +;.LIBRA, .LIFS, ETC. + +A.LIB: NOVAL ? NOABS + HLRZM B,LIBTYP' ;STORE BLOCK TYPE TO OUTPUT + CLEARM LIBOP ;INITIALIZE SQUOZE FLAGS + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK, MAKING SURE LOADER KNOWS $. +LIB1: PUSHJ P,GETSYL ;GET NAME + TRNN I,IRSYL + JRST LIB2 ;NO SYL, DON'T OUTPUT + IOR SYM,LIBOP + TLO SYM,40000 + PUSHJ P,OUTSM + MOVSI A,400000 + ANDCAM A,LIBOP +LIB2: MOVE B,CDISP ;GET CDISP + TLNN B,DWRD\DFLD ;CHECK FOR WORD TERMINATOR + JRST LIB3 ;WORD TERMINATOR => DONE + MOVE A,LIBOP + MOVE B,LIMBO1 ;RETRIEVE LAST CHAR READ + CAIN B,", + MOVSI A,400000 + CAIN B,"+ + TLZ A,200000 + CAIN B,"- + TLO A,200000 + MOVEM A,LIBOP' ;STORE SQUOZE FLAGS (LESS GLBL BIT) FOR NEXT SYM + JRST LIB1 + +LIB3: MOVE A,LIBTYP ;GET BLOCK TYPE TO OUTPUT + DPB A,[310700,,BKBUF] + PUSHJ P,EBLK + CAIN A,LLIB ;.LIBRA? + JRST ARELC1 ;.LIBRA, NOW PLAY LIKE RELOCA PSEUDO + JRST LIB5 ;SOMETHING ELSE (.LIFS), INCREMENT DEPTH IN LOAD TIME CONDITIONALS + +A.ELDC: NOVAL ? NOABS + PUSHJ P,EBLK + MOVEI A,ELTCB + DPB A,[310700,,BKBUF] + TRO FF,FRLOC ;MAKE EBLK OUTPUT NULL BLOCK + PUSHJ P,EBLK + SOSGE LDCCC + CLEARM LDCCC ;LOADER CONDITIONAL UNDERFLOW + JRST ASSEM1 + + ;LOADER CONDITIONAL ON VALUE + +A.LDCV: NOVAL ? NOABS + LSH B,-27. + PUSH P,B + PUSHJ P,AGETWD + POP P,B + DPB B,[400300,,BKBUF] + MOVEI A,LDCV + PUSHJ P,PLDCM + MOVEI A,0 + DPB A,[400300,,BKBUF] +LIB5: AOS LDCCC +CCASM1: JRST ASSEM1 + +;.GLOBAL, .SCALAR, .VECTOR +;LH(B) HAS ILGLI, ILVAR, ILVAR+ILFLO RESPECTIVELY. +; Note that use of ILFLO flag is a crock here. + +A.GLOB: NOVAL + HLLZ LINK,B ;REMEMBER WHICH OF THE THREE PSEUDO'S THIS IS. +A.GLO2: MOVE A,GLSPAS + MOVEM A,GLSP1 + SETOM FLDCNT + PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO NAME => DONE + CALL ES + JRST A.GLO1 + CAIE A,PSUDO_-14. + JRST A.GLO1 + JSP B,GVPSEU ;TRYING TO .GLOBAL A PSEUDO => TYPE APPRO. ERR MSG AND RETURN. + JRST A.GLO2 ;DON'T DO ANYTHING TO IT; MOVE ON TO NEXT ARG. + +A.GLO1: IOR I,LINK ;SET THE GLOBAL FLAG OR THE VARIABLE FLAG. + TLNE LINK,ILVAR ;FOR .VECTOR OR .SCALAR, SAVE # VARS CREATED BEFORE CREATING THIS ONE. + PUSH P,VARCNT ;SO WE CAN TELL IF THIS CALL TO GETVAL ACTUALY CREATES IT. + PUSHJ P,GETVAL ;NOW GET VALUE (CLOBBERS SQUOZE FLAGS) + CAIA + HALT + TLNN LINK,ILVAR ; THAT'S IT IF .GLOBAL, ELSE CONTINUE + JRST A.GLO2 + PUSH P,LINK ;.VECTOR OR .SCALAR, MUST READ THE SIZE. + TLO FF,FLUNRD ;RE-READ THE TERMINATOR AFTER THE SYM, SO "FOO(1)" AND "FOO," WIN + MOVE SYM,[SQUOZE 0,.SCALAR] + TLNE LINK,ILFLO ; USE RIGHT SYM + MOVE SYM,[SQUOZE 0,.VECTOR] + CALL AGETFD + REST LINK + REST B ;GET PREV. VARCNT, SO WE CAN SEE IF IT WAS INCREMENTED. + TRNN A,-1 ;MAKE (N) WORK AS SIZE BY USIN L.H. IF R.H. IS 0. + HLRZS A + JUMPN A,A.GLO3 ;JUMP IF NONZERO SIZE SPEC'D + TLNN LINK,ILFLO ; ZERO, USE DEFAULT + JRST A.GLO2 ; WHICH IS ALWAYS 1 FOR .SCALAR + SKIPA A,VECSIZ ; AND VECSIZ FOR .VECTOR. +A.GLO3: TLNE LINK,ILFLO ;NONZERO SIZE, SO + MOVEM A,VECSIZ ;DEFAULT MUST BE REMEMBERED FOR .VECTOR. + SUBI A,1 ;1 WORD WAS ALLOCATED BY GETVAL - HOW MANY MORE WANTED? + CAME B,VARCNT ;(MAYBE SYM ALREADY DEFINED, MAYBE PASS2, ...) + ADDM A,VARCNT ;IF GETVAL REALLY ALLOCATED THE SPACE THIS TIME, ALLOCATE THE + JRST A.GLO2 ;RIGHT AMOUNT. + + ;.LOP + +A.LOP: NOVAL ? NOABS + PUSHJ P,EBLK ;TERMINATE CURRENT BLOCK + REPEAT 3,PUSHJ P,RGETFD ;GET THE FIELDS + MOVEI A,LD.OP + PUSHJ P,PLDCN + JRST ASSEM1 + + ;.LIBRQ + +A.LIBRQ: NOVAL ? NOABS +A.LBR1: PUSHJ P,GETSLD + JRST MACCR + PUSHJ P,PBITS7 + MOVEI A,3 + PUSHJ P,PBITS + TLO SYM,40000 + PUSHJ P,OUTSM + JRST A.LBR1 + +A.LNKOT: AOS (P) ;THIS PSEUDO RETURNS NO VALUE. + NOVAL + +AEND5: JUMPGE FF,CPOPJ ;IGNORE FOLLOWING ON NOT PUNCHING PASS + MOVE D,SYMAOB +AEND5A: MOVE SYM,ST(D) + LDB T,[400400,,SYM] + CAIE T,DEFLVR_-14. + CAIN T,DEFGVR_-14. + JRST AEND5E + CAIE T,LCUDF_-14. + CAIN T,GLOEXT_-14. + JRST AEND5B +AEND5C: ADD D,WPSTE1 + AOBJN D,AEND5A + POPJ P, + +AEND5E: 3GET C,D + TLNN C,3LLV + JRST AEND5C +AEND5B: HLLZ B,ST+1(D) + 3GET C,D + TLNN C,3RLNK + JUMPE B,AEND5C + TLZ SYM,740000 + CAIE T,LCUDF_-14. + CAIN T,DEFLVR_-14. + SKIPA + TLO SYM,40000 + PUSHJ P,LKPNRO + HRRZS ST+1(D) ;CLEAR OUT LIST HEAD POINTER. + TLZ C,3RLNK ;INDICATE NO LIST. + 3PUT C,D + JRST AEND5C + + ;PUNCH OUT COMPLETE LOADER COMMAND, PUNCHING OUT WRD AS ONLY CONTENTS + +PLDCM: PUSH P,LINK ;SAVE LINK FOR ALOC AND FRIENDS (CLOBBERS OTHER AC'S) + PUSH P,A ;SAVE LOADER COMMAND TYPE + PUSHJ P,EBLK ;TERMINATE PREV BLOCK, MAKING SURE LOADER KNOWS $. + PUSHJ P,PWRDA ;PUNCH OUT THE WORD + POP P,A ;GET BACK LOADER COMMAND TYPE FOR PLDCN + PUSHJ P,PLDCN ;OUTPUT THE RESULTING BLOCK +PLINKJ: POP P,LINK ;RESTORE LINK + POPJ P, + +PLDCN: HRRM A,BKBUF ;STORE LOADER COMMAND TYPE IN BKBUF HEADER + MOVEI A,LLDCM ;LOADER COMMAND BLOCK TYPE + DPB A,[310700,,BKBUF] ;STORE BLOCK TYPE IN HEADER + TRO FF,FRLOC ;MAKE EBLK OUTPUT BLOCK EVEN IF EMPTY + JRST EBLK + +;.RELP RETURNS RELOCATION OF ARG +A.RELP: CALL AGETFD + MOVE A,B + JRST VALRET + +;.ABSP RETURNS ABSOLUTE PART OF ARG. +A.ABSP: CALL AGETFD + JRST VALRET + +;.RL1 IN RELOCATABLE ASSEMBLY RETURNS ZERO WITH RELOCATION FACTOR ONE. +;IN ABSOLUTE ASSEMBLY, IT RETURNS JUST ZERO. +;IFN <.RELP .RL1>, IS A TEST FOR A RELOCATABLE ASSEMBLY. +A.RL1: SKIPGE A,CONTRL + TRNE A,DECREL\FASL + SKIPA B,[1] + SETZ B, + SETZ A, + RET + +AEND: NOVAL + SKIPE ASMOUT ; ERROR IF IN GROUPING. + JSP LINK,CONFLM ;FLUSH CONSTANTS, GIVE ERROR MSG. + SKIPE SCNDEP ;IF THERE ARE UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS, MENTION THEM. + MOVE A,BKCUR + CAIE A,BKWPB ;NOT IN .MAIN BLOCK => ERROR. + ETR ERRUMB + MOVE A,CDISP + TLNN A,DWRD + TLO FF,FLUNRD ;IF LAST TERM. WAS WORD TERM., RE-READ. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + EXCH A,PNTBP + MOVEM A,LISTTM +] + PUSHJ P,AVARI0 + PUSHJ P,CNSTN0 + SKIPL A,CONTRL + JRST [ PUSHJ P,AEND5 ; STINK RELOCATABLE => .LNKOT + JRST AEND6] + TRNE A,DECSAV ; IF DECSAV FMT, + JRST [ MOVE A,CLOC ; USE LOC COUNTER AT END AS LOC OF SYMBOLS + SKIPN DECSYA ; UNLESS LOC ALREADY SPECIFIED. + MOVEM A,DECSYA + JRST AEND6] + TRNN A,DECREL + JRST AEND6 + MOVE A,CLOC ;IN DEC FMT, UPDATE HIGHEST ADDR SEEN, + SKIPN CRLOC ;UPDATE EITHER THE HIGHEST ABS ADDR + JRST [ CAML A,DECBRA + MOVEM A,DECBRA + JRST AEND6] + CAML A,DECTWO ;OR THE HIGHEST REL ADDR IN THE + JRST [ CAML A,DECBRH ;APPROPRIATE SEG. + MOVEM A,DECBRH + JRST AEND6] + CAML A,DECBRK + MOVEM A,DECBRK +AEND6: JUMPL FF,AEND1 ;ON PUNCHING PASS, SPECIAL STUFF + PUSHJ P,GETWRD ;OTHERWISE EAT UP WORD, + JRST RETURN ;AND RETURN + +AEND1: PUSHJ P,EBLK +IFN LISTSW,[ + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE A,LISTTM + MOVEM A,PNTBP +] + MOVE SYM,[SQUOZE 0,END] + TLZ I,ILWORD + PUSHJ P,AGETWD +IFN LISTSW,[ + MOVEM A,LISTWD + MOVEM B,LSTRLC + SETOM LISTAD + SETOM LISTPF + SKIPE LSTONP + PUSHJ P,PNTR + SKIPE LISTP + PUSHJ P,LPTCLS ;DONE LISTING + MOVE A,LISTWD +] ;END IFN LISTSW, + SKIPL B,CONTRL + JRST AEND3 ;RELOCATABLE +IFN FASLP,[ + TRNE B,FASL + JRST FASEN ;FASL FORM +] + TRNE B,DECSAV + JRST AEND4 + TRNN B,DECREL ;IF DEC FORMAT, + JRST AEND1A + TLNN I,ILWORD ;THEN IF THERE7S A STARTING ADDRESS, + JRST AEND2 + MOVSI A,DECSTA ;OUTPUT START-ADDRESS BLOCK. + PUSHJ P,DECBLK + PUSHJ P,PWRD + PUSHJ P,EBLK + JRST AEND2 + +IFN FASLP,[ +FASEN: JRST AEND2 +] + +AEND3: HRRZ A,CLOC + HRRM A,BKBUF ;SET UP PROGRAM BREAK JUST IN CASE OUTPUTTING MORE NULL DATA BLOCKS + MOVEI A,LCJMP + PUSHJ P,PLDCM + JRST AEND2 + + ; HERE FOR DECSAV FORMAT. +AEND4: TLNE A,-1 + JRST AEND1B ; IF SOMETHING IN LH, MAY BE ENTRY VECTOR. + MOVE B,A + MOVE A,[-1,,120-1] ; NOTHING, SO ASSUME SIMPLE JRST. MUST + PUSHJ P,PPB ; FIRST SAVE S.A. IN .JBSA CROCK. + MOVE A,B + PUSHJ P,PPB + TLO A,(JRST) ; FURNISH JRST FOR PUTTING AT END OF OUTPUT. + JRST AEND1B + +AEND1A: ; CHECK WORD AND MAYBE MAKE IT A JRST + TLNN A,777000 ; CHECK INSTRUCTION PART + TLO A,(JRST) ; WANTS JRST + PUSHJ P,PPB +AEND1B: JUMPG A,.+3 + ETR [ASCIZ /Start instruction negative/] + HRLI A,(JRST) ;END SYMTAB WITH POSITIVE WORD + MOVEM A,STARTA ;SAVE FOR PUNCHOUT AT END OF SYMTAB + PUSHJ P,FEED1 +AEND2: PUSH P,[RETURN] +CNARTP: +IFN DECSW\TNXSW,[ + PUSH P,TTYFLG + SKIPE CCLFLG ;IN DEC VERSION, IF RUN BY CCL, DON'T PRINT + AOS TTYFLG ;THIS STUFF ON THE TTY - ONLY IN ERROR FILE AND LISTING. + CALL CNTPD + REST TTYFLG + RET + +CNTPD: +] + MOVNI D,1 + MOVEI TT,PCNTB +CNTP1: CAML TT,PBCONL + RET + HRRZ B,1(TT) + HLRZ A,1(TT) + CAMN A,B + JRST CNTP2 + AOSN D + TYPR [ASCIZ /Constants area inclusive +From To +/] + LDB B,[.BP (CGBAL),2(TT)] + SKIPE B + TYPR [ASCIZ /Global+/] + HRRZ B,1(TT) + PUSHJ P,OCTPNT + PUSHJ P,TABERR + HLRZ B,1(TT) + SOS B + PUSHJ P,OCTPNT + PUSHJ P,CRRERR +CNTP2: ADDI TT,3 + JRST CNTP1 + +AENDM1: TYPR [ASCIZ /Unterminated successful bracketed conditionals +The first was at /] + AOS A,CONDPN + CALL DPNT + MOVEI A,"- + CALL TYOERR + AOS A,CONDLN + CALL D3PNT2 +IFN TS,[ + TYPR [ASCIZ/ of file /] + MOVE B,CONDFI + CALL SIXTYO +] + JRST CRRERR + +AXWORD: CALL XGETFD ;READ 1ST FIELD, + TLNE I,ILMWRD + CALL IGTXT ;SOAK UP REST OF TEXT PSEUDO. + HRLM A,WRD + HRLM B,WRDRLC + MOVSI C,HFWDF + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + PUSH P,GLSP1 + CALL XGETFD ;NOW THE SECOND FIELD + HRRM A,WRD + HRRES B + ADDM B,WRDRLC + MOVSI C,HFWDF + MOVEI B,0 + POP P,T + PUSHJ P,LINKTC + JRST CABPOP + +A.NTHWD:CALL AGETFD ;READ THE NUMBER OF THE WORD WE WANT. + SOJL A,CABPOP ;NEGATIVE OR 0 => RETURN 0. + SOJL A,A.1STWD ;1 => TURN INTO .1STWD. + ;ELSE SKIP APPRO. # OF WORDS, THEN DO .1STWD. + +A.NTH1: PUSH P,A + PUSH P,WRD + CALL XGETFD + TLZ FF,FLUNRD + REST WRD + REST A + TLNN I,ILMWRD + JRST CABPOP ;IF STRING ENDS BEFORE DESIRED WORD, RETURN 0. + SOJGE A,A.NTH1 + +A.1STWD: CALL XGETFD ;GET THE 1ST WD OF FOLLOWING TEXT PSEUDO, + CALL IGTXT ;THROW AWAY THE REST. + MOVE T,A ;RETURN THE VALUE + JRST TEXT5 ;COMPLAINING IF FOLLOWED IMMEDIATELY BY SYLLABLE. + +A.LENGTH: CALL PASSPS + PUSH P,[0] + PUSH P,A +A.LN1: PUSHJ P,RCH + AOS -1(P) + CAME A,(P) + JRST A.LN1 + SOS T,-1(P) + SUB P,[2,,2] + JRST TEXT5 ;RETURN VALUE IN T + +ARDIX: NOVAL + PUSHJ P,AGETFD ;GET FIELD ARG + MOVEM A,ARADIX + JRST MACCR ;RETURN WITHOUT CLOBBERING CURRENT VALUE + +A.RADIX: CALL AGETFD ;READ THE TEMP. RADIX. + PUSH P,ARADIX ;LAMBDABIND RADIX TO THAT VALUE. + MOVEM A,ARADIX + CALL XGETFD ;READ IN THE NEXT FIELD USING THAT RADIX. + REST ARADIX + JRST VALRET + +;READ A BIT-MASK AS ARG, RETURN THE LH OF BP. FOR THAT BYTE. +A.BP: CALL YGETFD + MOVEI C,SPACE + SKIPE CDISP ;IF ARG WAS ENDED BY A COMMA, TURN IT INTO A SPACE + HRRM C,CDISP ;SO THAT .BP FOO,BAR USES THE FLD SPACE FLD FORMAT. + JUMPE A,VALR1 + PUSH P,A + JFFO A,.+2 + MOVEI B,36. + EXCH B,(P) ;(P) HAS # LEADING ZEROS. + MOVN A,B + AND A,B ;A HAS ONLY THE LOW BIT OF THE BYTE. + JFFO A,.+2 + MOVNI B,1 ;B HAS 35.-<# TRAILING ZREROS.> + MOVEI A,1(B) + SUB A,(P) ;A HAS SIZE OF BYTE + LSH A,30 ;PUT IN S FIELD OF BP. + SUB P,[1,,1] + MOVNS B + ADDI B,35. ;B HAS # TRAILING ZEROS. + DPB B,[360600,,A] ;PUT THAT IN P FIELD OF BP. + JRST VALR1 + +;READ IN BP, RETURN BIT MASK TO SPEC'D BYTE. +;THE ARG SHOULD BE JUST THE LH OF A BP, WHICH MAY BE IN EITHER HALF OF THE ARG. +A.BM: CALL GETBPT ;READ IN A BYTE POINTER ARG, IN A, POINTING AT T. + SETZ T, + SETO C, +A.DPB1: DPB C,A ;PUT 1'S IN SPEC'D PART OF ACCUM T + MOVE A,T + JRST VALRET + +;READ IN A BYTE POINTER (REALLY JUST S AND P FIELDS) AND MAKE POINT AT AC T. +;RETURN IT IN AC A. +GETBPT: CALL YGETFD + TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH. + HRLI A,(A) + TLZ A,77 ;MAKE BP. -> AC T + HRRI A,T + RET + +;RETURN # TRAILING ZEROS IN ARGUMENT. +A.TZ: CALL YGETFD + MOVN B,A + AND A,B ;A HAS JUST LOW BIT OF ARG SET. + JFFO A,.+2 + MOVNI B,1 ;# OF ZEROS BEFORE LOW BIT = + MOVN A,B ;35. - <# TRAILING ZEROS> + ADDI A,35. + JRST VALRET + +;RETURN # LEADING ZEROS IN ARG. +A.LZ: CALL YGETFD + JFFO A,.+2 + MOVEI B,36. + MOVE A,B + JRST VALRET + +;.DPB STUFF,BP,WORD DOES A DPB OF STUFF INTO THE FIELD OF WORD SPEC'D BY BP, +;RETURNING THE RESULTING WORD. +A.DPB: CALL YGETFD ;READ STUFF. + PUSH P,A + CALL GETBPT ;READ BP AND TURN INTO ACTUAL BP POINTING AT T + PUSH P,A + CALL YGETFD ;READ IN WORD AND PUT IN T. + MOVE T,A + REST A ;A HAS BP + REST C ;C HAS STUFF + JRST A.DPB1 ;GO DO THE DEPOSIT AND RETURN THE ALTERED WORD. + +;.LDB BP,WORD RETURNS THE CONTENTS OF THE BYTE IN WORD SELECTED BY BP +A.LDB: CALL GETBPT + PUSH P,A + CALL YGETFD + MOVE T,A + REST A + LDB A,A + JRST VALRET + +;.IBP BP RETURNS AN INCREMENTED BP. +A.IBP: CALL YGETFD + TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH. + HRLZS A + IBP A + JRST VALRET + +AWORD: NOVAL + PUSHJ P,EBLK + PUSHJ P,GETWRD ;ON UNDEFINED SYM, WYB UNDEFINED SYM IN "WORD"? + PUSHJ P,PPB + JRST ASSEM1 + +;.BIND - MAKE SYMS BE DEFINED IN CURRENT (SPEC'D) BLOCK. LH(B) HAS 0. +;.KILL - FULLY KILL THE SYMS.LH(B) HAS 3KILL. +;.HKILL - HALFKILL THEM. LH(B) HAS 3SKILL. +;.XCREF - PREVENT CREFFING OF SYMS. LH(B) HAS 3NCRF. +;.DOWN - SET 3DOWN, MAKING SYM VISIBLE IN SUBBLOCKS IN 1 PASS ASSEMBLY. +A.KILL: NOVAL + HLLZ LINK,B ;REMEMBER BIT TO SET. +A.KIL1: CALL GETSLD ;READ NEXT SYMBOL NAME. + JRST MACCR ;NO MORE, EXIT. + SKIPE LINK ;EXCEPT FOR .BIND, DO NOTHING ON PASS 1. + JUMPGE FF,A.KIL1 + CALL ESDEF ;DEFINE THE SYMBOL, D HAS STE IDX. + JRST A.KIL2 ;SYMBOL NEVER SEEN. + IORM LINK,ST+2(D) ;SET THE BIT IN 3RDWRD.. + IOR C,LINK ;(IF .XCREF, PREVENT CREFFING THIS TIME) +IFN CREFSW,XCT CRFINU ;CREF THE SYMBOL + JRST A.KIL1 + +A.KIL2: MOVSI T,LCUDF ;SYMBOL UNDEFINED, MAKE UNDEF LOCAL. + IOR C,LINK ;WITH THE DESIRED BIT SET. + TLO C,3MACOK ;SHOULDN'T BE ERROR IF IT BECOMES MACRO. + CALL VSM2 +IFN CREFSW,XCT CRFINU + JRST A.KIL1 + +;EXPUNG SYM1,SYM2 ... ;UNDEFINE THOSE SYMS. +AEXPUNG: NOVAL +AEXPU2: PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO MORE NAMES + PUSH P,[AEXPU2] ;AFTER THIS SYM, POPJ TO READ ANOTHER. +;EXPUNGE 1 SYMBOL, SQUOZE IN SYM. +AEXPU1: PUSHJ P,ES + JFCL ;NOT FOUND, DON'T COMPLAIN, JUST CREF. +IFN CREFSW,XCT CRFDEF + HRLZI T,400000 ;EXPUNGED ZERO SYM + SKIPE ST(D) + MOVEM T,ST(D) + SKIPL CONTRL ;IF RELOCATABLE ANDLOCAL SYMBOL, + CAIL A,DEFGVR_-33. + RET + PUSHJ P,PBITS7 ;TELL STINK TO EXPUNGE SYM. + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY IS NEW TYPE RQ, + PUSHJ P,OUTSM0 + MOVSI A,400000 ;NEW NAME NULL => DELETE. + JRST $OUTPT + +;EQUAL SYM1,SYM2 ;DEFINE SYM1 SAME AS SYM2. +AEQUAL: NOVAL + PUSHJ P,GETSLD + ETR ERRTFA + PUSH P,SYM ;REMEMBER SYM NAME AND BLOCK TO DEF. IN. + PUSH P,ESBK + PUSHJ P,GETSLD + ETR ERRTFA +IFN CREFSW,XCT CRFINU ;CREF SYM DEFINED AS. + CALL ES ;LOOK UP SYM TO EQUATE TO. + JRST [ REST ESBK ;NOT FOUND => EXPUNGE THE 1ST SYM. + REST SYM + JRST AEXPU1] + REST ESBK + REST SYM +IFN CREFSW,XCT CRFDEF + PUSH P,A + PUSH P,B ;SAVE INFO ON VALUE OF SYM TO EQUATE TO. + PUSH P,C + CALL ESDEF + MOVEM SYM,ST(D) + REST B ;3RDWRD OF 2ND SYMBOL. + REST ST+1(D) ;(WHAT WAS PUSHED FROM B) + REST A + DPB A,[400400,,ST(D)] + TLZ C,3DFCLR ;SAVE OLD 3MAS, 3NCRF OF 1ST SYMBOL (AND ITS BLOCK #). + AND B,[3DFCLR,,] ;SET REST OF 3RDWRD BITS FROM 2ND SYMBOL. + IOR B,C + 3PUT B,D + JRST MACCR + +ERRTFA: ASCIZ /Too few args - EQUAL/ + +;.SEE SYM1,SYM2,... ;CREF THOSE SYMS. +A.SEE: CALL GETSLD ;READ 1 SYMBOL. + JRST MACCR ;NONE TO BE READ. +IFN CREFSW,[ + SKIPN CRFONP ;IF CREFFING, + JRST A.SEE + CALL ES + MOVEI A,SYMC_-33. + XCT CRFINU ;CREF THE SYMBOL. +] + JRST A.SEE + +;UUO HANDLING ROUTINE +;41 HAS JSR ERROR + +VBLK +ERRCNT: 0 ; NUMBER OF ERRORS HIT -- VALUE OF .ERRCNT +ERRCCT: 0 ;NUM CHARS OUTPUT ON LINE, FOR MAKING MSGS LINE UP. +ERRJPC: 0 ;JPC READ WHEN UUO. +ERROR: 0 +IFN ITSSW, .SUSET [.RJPC,,ERRJPC] + JRST ERRH ;GO HANDLE IT +PBLK +ERRH: PUSH P,T + PUSH P,B ;NOT TYPR => ERROR OF SOME KIND + PUSH P,A + PUSH P,C + LDB T,[331100,,40] ;PICK UP OP CODE + CAIN T,TYPCR_-33 ; TYPCR? + JRST TYPCR1 + CAIN T,TYPR_-33 ; OR TYPR? + JRST TYPR1 ; YES + ;ERROR OF SOME KIND + CAIE T,ETASM_-33 ;CHECK FOR SPECIAL LOSSAGES AT COLON + CAIN T,ETSM_-33 + CAME SYM,SYSYM ;ARE WE ABOUT TO MENTIO THIS LOSING LABEL AS THE LAST ONE? + JRST ERRH1 + MOVE T,SYSYM1 + + MOVEM T,SYSYM ;COLON LOSSAGE, DE-MUNG TAG WORDS FOR PRINTOUT + MOVE T,SYLOC1 + MOVEM T,SYLOC +ERRH1: +IFN TS,[ +IFN LISTSW,[ + CALL PNTR ;FORCE OUT BUFFERED LISTING OUTPUT + CALL PNTCRR ;AND CR, SO USER CAN SEE WHERE ERROR WAS. +] + PUSHJ P,ERRTFL ;IF NOT SAME FILE AS LAST, PRINT FILE NAME. +] + SETZM ERRCCT + AOS ERRCNT ; BUMP ERROR TOTAL +IFN DECSW,AOS .JBERR ; BUMP ERROR MESSAGE COUNTER FOR LOADER TO ABORT + MOVE A,SYSYM ;GET LAST TAG DEFINED + JUMPE A,ERR1 ;SKIP PRINTOUT IF NONE THERE + PUSHJ P,SYMTYP ;THERE, TYPE IT OUT + MOVE B,CLOC ;NOW GET CURRENT LOCATION + SUB B,SYLOC ;SUBTRACT VALUE OF LAST TAG + JUMPE B,ERR1 ;SKIP NUMERIC PRINTOUT IF RIGHT AT TAG + MOVEI A,"+ ;NOT AT TAG, + PUSHJ P,TYOERR ;TYPE OUT PLUS SIGN, + AOS ERRCCT ;(1 MORE CHAR TYPED) + PUSHJ P,OCTPNT ;THEN TYPE OUT DIFFERENCE IN OCTAL +ERR1: PUSHJ P,TABERR ;NOW SEPARATE WITH TAB + MOVE A,ERRCCT + CAIGE A,8 ;MAKE SURE MOVE TO COLUMN 16. + PUSHJ P,TABERR + MOVEI B,[ASCIZ/GL+/] + SKIPGE GLOCTP ;LOCATION GLOBAL? + PUSHJ P,TYPR3 ;YES, TYPE OUT THAT FACT. + MOVE B,CLOC ;GET CURRENT LOCATION + PUSHJ P,OCTPNT ;TYPE OUT IN OCTAL +;DROPS THROUGH + +;DROPS THROUGH. + PUSHJ P,TABERR + MOVE A,MDEPTH ;NOW DEPTH IN MACRO (NOT IRP, REPEAT, ETC.) EXPANSIONS + MOVSI T,-2 + CALL DPNT0 ;PRINT, IN 2-CHAR FIELD. + MOVEI A,". + CALL TYOERR ;(USED TO BE OCTAL) + MOVE A,CPGN ;CURRENT PAGE NUMBER (FIRST PAGE OF FILE => 0) + PUSHJ P,[AOJA A,D6PNT] ;TYPE IT OUT IN DECIMAL + MOVEI A,"- + CALL TYOERR + MOVE A,CLNN ;ALSO CURRENT LINE NUMBER + PUSHJ P,[AOJA A,D3PNT2] + PUSHJ P,TABERR + MOVEI A,48. ;ASSUME ALL THE STUFF WE'VE PRINTED TAKES 48. CHARS + MOVEM A,ERRCCT ;MAYBE SOMEDAY TABERR, ETC. WILL REALLY UPDATE ERRCCT PROPERLY. + LDB A,[331100,,40] ;PICK UP OP CODE AGAIN + CAIGE A,8 ;ERROR UUO MAX + JRST .+1(A) + JRST [HALT ? JRST .-1] ;OPCODE 0, OR TOO BIG. + JRST ERRSM ;ETSM => TYPE SYM AND MESSAGE. + JRST ERRR ;ETR => JUST PRINT MESSAGE + JRST ERRJ ;ERJ => RH(40) HAS JUMP ADR + JRST ERRI ;ETI => IGNORE LINE RET TO ASSEM1 + JRST ERRA ;ETA => RET TO ASSEM1 + JRST ERRASM ;ETASM => TYPE SYM AND GO TO ASSEM1 + JRST IAE ;ERF => FATAL. + +ERRJ: MOVE A,40 ;ERJ => RH(40) HAS JUMP ADR + HRRM A,ERROR + JRST ERRET1 + +ERRI: PUSHJ P,RCH ;ETI => IGNORE LINE, RETURN TO ASSEM1: EAT UP LINE + CAIE A,12 + JRST .-2 +ERRA: MOVEI A,ASSEM1 ;ETA => RETURN TO ASSEM1, DON'T TYPE SYM. + MOVEM A,ERROR + JRST ERRR + +ERRASM: MOVEI A,ASSEM1 ;ETASM => TYPE SYM AND RETURN TO ASSEM1 + MOVEM A,ERROR +ERRSM: MOVEI C,56. ;ETSM OR ETASM => TYPE OUT SYM THEN MESSAGE + CALL TYPE37 ;CR NOW IF WHOLE MSG WON'T FIT ON ONE LINE. + MOVE A,SYM + PUSHJ P,SYMTYP + PUSHJ P,TABERR +ERRR: CALL TYPE40 ;TYPE THE ERROR MESSAGE. +ERRET1: REST C + POP P,A ;COMMON RETURN POINT FROM UUOS + POP P,B + POP P,T + JRST 2,@ERROR + +;FINISH UP AN ERROR UUO'S ERROR MESSAGE. PRINT THE SPECIFIED STRING +;AND ALSO "IN DEFINE AT ..." IF NECESSARY, ALONG WITH APPROPRIATE CR'S. +TYPE40: MOVE C,ERRCCT + CALL TYPE37 + CALL TYPR4 ;PRINT THE ASCIZ STRING + CALL CRRERR + SKIPN A,DEFNPS ;IF INSIDE A LONG PSEUDO, + RET + MOVE A,DEFNLN + MOVE B,DEFNPN + CAMN A,CLNN ;WHICH DIDN'T START IN THIS VERY LINE, + CAME B,CPGN + JRST TYPE42 + MOVE A,DEFNFI + CAMN A,INFFN1 + JRST TYPE43 +TYPE42: MOVEI B,[ASCIZ/ in /] + CALL TYPR3 + MOVE A,DEFNPS + CALL SYMTYP ;SAY WHAT PSEUDO, AND WHERE IT STARTED. + MOVEI B,[ASCIZ/ Starting at /] + CALL TYPR3 + MOVE A,DEFNPN ;PAGE # -1. + CALL [AOJA A,DPNT] ;PRINT PAGE #. + MOVEI A,"- + CALL TYOERR + AOS A,DEFNLN + CALL D3PNT2 ;PRINT LINE #. +IFN TS,[ + MOVE B,DEFNFI ;PRINT FILE NAME IF IT ISN'T THE CURRENT FILE. + CAMN B,INFFN1 + JRST TYPE41 + MOVEI B,[ASCIZ/ of file /] + CALL TYPR3 + MOVE B,DEFNFI + CALL SIXTYO +] +TYPE41: CALL CRRERR ;AND CRLF. +TYPE43: MOVE A,ERROR + CAIE A,ASSEM1 ;IF THIS ERROR IS EXITING THE PSEUDO, + RET + SETZM DEFNPS ;SAY WE'RE NOT IN IT ANY MORE. + SETOM TEXT4 + RET + +;JSP TM,ERMARK IN A PSEUDO, TO ARRANGE FOR ERROR MESSAGES TO MENTION +;THAT PSEUDO. SYM SHOULD CONTAIN THE NAME OF THE PSEUDO. +;PUSHES A WORD ON THE STACK SO THAT WHEN THE PSEUDO RETURNS DEFNPS WILL BE CLEARED. +;IF DEFNPS IS SET UP ALREADY, DOES NOTHING (DOESN'T SET DEFNPS; DOESN'T PUSH THE WORD) +ERMARK: SKIPE DEFNPS + JRST (TM) + MOVEM SYM,DEFNPS + MOVE SYM,CLNN + MOVEM SYM,DEFNLN + MOVE SYM,CPGN + MOVEM SYM,DEFNPN + MOVE SYM,INFFN1 + MOVEM SYM,DEFNFI + MOVE SYM,DEFNPS + CALL (TM) + CAIA + AOS (P) + SETZM DEFNPS + RET + +;C SHOULD HAVE CURRENT HORIZ POS. IF TYPING THE STRING 40 POINTS AT +;WOULD OVERFLOW THE LINE, TYPE A CRLF AND TAB NOW ON THE TTY ONLY. +TYPE37: HRRZ B,40 + HRLI B,440700 ;FIRST, FIGURE OUT HOW FAR ON LINE WE'LL TYPE IF WE DON'T CR. + ILDB A,B + CAIE A, ;AND COUNT CHARS IN THE ERR MSG. + AOJA C,.-2 + CAMGE C,LINEL + RET +CRRTBX: MOVEI A,10 + MOVEM A,ERRCCT ;PREVENT THIS FROM BEING DONE TWICE. + SKIPE TTYFLG + RET + MOVEI A,^M ;IF THERE'S NO ROOM, CRLF ON THE TTY ONLY (NOT THE ERR FILE). + PUSHJ P,TYOX + MOVEI A,^J + PUSHJ P,TYOX + MOVEI A,^I + JRST TYOX + + ;TYPE OUT SQUOZE (FLAGS OFF) IN A + +SYMTYP: PUSHJ P,SQCCV ;GET NEXT CHAR IN ASCII. + AOS ERRCCT + PUSHJ P,TYOERR ;TYPE IT OUT. + JUMPE B,CPOPJ ;RETURN IF NOTHING LEFT (TYPED OUT AT LEAST ONE CHAR THOUGH) + IMULI B,50 ;LEFT-JUSTIFY REMAINDER + MOVE A,B ;GET LEFT-JUSTIFIED REMAINDER IN A + JRST SYMTYP ;TYPE OUT REMAINDER OF SYM + + ;TYPE OUT SQUOZE CHARACTER (IN A) + +SQCCV: IDIV A,[50*50*50*50*50] + CAIG A,10. + SOJA A,SQCDTO ;NUMBER (OR BLANK =>SLASH) + CAIL A,45 + SKIPA A,SYTB-45(A) ;SPECIAL + ADDI A,"A-13 ;LETTER + POPJ P, + +SQCDTO: ADDI A,"0 + POPJ P, + +SYTB: ". + "$ + "% + +D3PNT2: MOVE T,[-3,,400000] ;3 CHAR FIELD, NO ZERO SUPPRESSION. + JRST DPNT0 + +DPNT: TDZA T,T ;ORDINARY DECIMAL PRINT. +D6PNT: MOVSI T,-6 ;6 CHAR FIELD, ZERO SUPPRESSION. +DPNT0: IDIVI A,10. + HRLM B,(P) + TRNE T,377777 ;IF NOT LAST DIGIT, + TRNE T,400000 ;AND ZERO-SUPPR. WANTED, + JRST DPNT2 + JUMPN A,DPNT2 ;IF THIS IS A LEADING 0, + JUMPN B,DPNT2 + MOVEI B," -"0 + HRLM B,(P) ;REPLACE WITH A SPACE. +DPNT2: AOBJN T,.+2 ;J IF NOT ENOUGH CHARS YET. + JUMPE A,DPNT1 ;ENOUGH, DON'T MAKE MORE IF NOT NEEDED. + CALL DPNT0 + JRST DPNT1 + +;TYPE HALFWORD IN B IN OCTAL. +OCTPNT: HRRZ A,B + IDIVI A,10 + HRLM B,(P) + JUMPE A,.+2 + PUSHJ P,.-3 + AOS ERRCCT +DPNT1: HLRZ A,(P) +ADGTYO: ADDI A,"0 + JRST TYOERR + +;TYPE OUT THE SIXBIT WORD IN B + +SIXTYO: JUMPE B,CPOPJ + MOVEI A,0 + ROTC A,6 + ADDI A,40 + PUSHJ P,TYOERR + JRST SIXTYO + + ;TYPE CRLF + +CRR: MOVEI A,15 + PUSHJ P,TYO + MOVEI A,12 + JRST TYO + +;OP CODE 0 => NO RECOVERY RETURN TO GO9 +IAE: CALL TYPE40 ;PRINT THE ERROR MESSAGE. + SKIPE ASMOUT + JSP LINK,CONFLZ ;TELL USER ABOUT UNTERM. GROUPINGS. + SKIPE SCNDEP ;MENTION ANY UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS. + MOVEI B,[ASCIZ /Error is fatal. +/] + CALL TYPR3 +IFN ITSSW,[ + .SUSET [.RTTY,,A] + SKIPL A + .RESET TYIC, +] + JRST GO9 + + ;TYPR [ASCIZ /STRING/] ;TYPE OUT STRING + +TYPR1: PUSH P,[ERRET1] +TYPR4: HRRZ B,40 ;GET ADR OF BEGINNING OF STRING +TYPR3: HRLI B,440700 ;CONVERT TO BYTE POINTER +TYPR2: ILDB A,B ;GET NEXT CHAR + JUMPE A,CPOPJ ;JUMP IF ZERO, END OF STRING + PUSHJ P,TYOERR ;NON-ZERO, TYPE IT OUT + JRST TYPR2 + + ; TYPCR [ASCIZ /STRING/] ; Type out string, followed by CRLF + +TYPCR1: PUSH P,[ERRET1] + PUSHJ P,TYPR4 ; When done, fall thru. + +CRRERR: MOVEI A,^M ;CRLF IN ERROR MESSAGE. + CALL TYOERR + SKIPA A,[^J] +TABERR: MOVEI A,^I ;TAB INN ERROR MESSAGE. +TYOERR: +IFN LISTSW,[ + SKIPE LSTTTY ;OUTPUT TO LISTING UNLESS LSTTTY ZERO. + CALL PILPTX +] + SKIPG LSTTTY + JRST TYO ;TO TTY UNLESS LSTTTY POSITIVE. + RET + +;OUTPUT-FORMAT SELECTING PSEUDOS: + +;.SLDR -- ON PASS 2, PUNCH OUT SBLK LOADER AND SELECT SBLK FORMAT +A.SLDR: NOVAL + JUMPGE FF,MACCR ;DO NOTHING ON PASS 1. + PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE FIRST + PUSHJ P,PLOD1A ;PUNCH OUT LOADER +SIMBLK: MOVSI B,SBLKS ;ENTRY FROM PS1, A.SLDR SELECT SBLK + JRST SIMBL1 + +SRIM: MOVE A,SYM ;ENTRY FROM GETVAL, LH(B) HAS RH(CONTRL) + PUSH P,B + CALL SYMTYP + TYPR [ASCIZ/ Encountered +/] + REST B +SIMBL1: TRO FF,FRNPSS + HRRI B,TRIV ;SET UP TRIV FLAG FOR LH(CONTRL) + MOVSS B + CAME B,CONTRL ;IF CHANGING MODES, END THE BLOCK IN THE OLD MODE + CALL EBLK + MOVE A,CONTRL ;IF OLD MODE WAS RELOCATABLE OF SOME KIND, + TRNN A,DECREL\FASL + JUMPL A,SIMBL2 + SETZM CRLOC ;INITIALIZE LOCATION COUNTER. + MOVEI A,100 ; USE 100 ASSUMING ITS SBLK + TRNE B,DECSAV + MOVEI A,140 ; BUT USE 140 FOR DEC ABS. + MOVEM A,CLOC +SIMBL2: MOVEM B,CONTRL ;STORE NEW MODE. + TRNE B,ARIM\ARIM10 + TRZ F,FRSYMS ;RIM AND RIM10 MODES IMPLY NO SYMBOLS. + AOS (P) + + ;ROUTINE TO SET VARIABLES FOR BENEFIT OF NED LOGIC + ;CALLED BY OUTPUT SELECTING PSEUDOS +OUTUPD: NOVAL +IFN A1PSW,[ + TRNE FF,FRNPSS ;IF PASS 1, + TLNN FF,$FLOUT + JRST OUTCHK + AOS OUTN1 ;INDICATE "OUTPUT" HAS OCCURED OTHER THAN IN 1PASS MODE +OUTCHK: TLZE FF,$FLOUT + AOS OUTC ;INDICATE "OUTPUT" HAS OCCURED DURING CURRENT ASSEMBLY +] + RET + +ANOSYMS: NOVAL + TRZ FF,FRSYMS + JRST MACCR + +A1PASS: PUSHJ P,OUTUPD +A1PAS1: TLO FF,FLPPSS + MOVEIM A.PPASS,1 ;SET .PPASS TO 1. +IFN CREFSW,[ SKIPE CREFP ;THIS NOW PUNCHING PASS, + PUSHJ P,CRFON ;MAYBE TURN ON CREFFING. +] +IFN LISTSW,[ + SKIPE LISTP + CALL LSTON ;LIST NOW IF WANT LISTING AT ALL. +] + MOVE A,CONTRL + TRNE A,DECREL + CALL DECPGN + TRZA FF,FRNPSS +ARELOC: PUSHJ P,OUTUPD +ARELC1: PUSHJ P,EBLK ;FINISH CURRENT OUTPUT BLOCK + TRO FF,FRLOC ;DOING LOCATION ASSIGNMENT, MAKE SURE NEXT GETS OUTPUT + CLEARM CLOC + MOVEI A,1 + MOVEM A,CRLOC + CLEARM CONTRL + SETZM BKBUF + MOVEI A,LREL + DPB A,[310700,,BKBUF] + MOVEM A,CDATBC + JRST MACCR + + + ; .DECSAV - SELECT DEC ABSOLUTE ZERO-COMPRESSED (SAV) FORMAT +A.DECSAV: NOVAL + MOVSI B,DECSAV ; SET FLAG + JRST SIMBL1 ; THEN HANDLE ALMOST LIKE .SBLK + + +A.DECTWO: CALL AGETFD ;READ THE TWOSEG ORIGIN. + TRNN FF,FRNPSS + ETF [ASCIZ /.DECTWO follows 1PASS/] + MOVE C,ISAV + TRNN C,IRFLD ;NO ARG => DEFAULT IT TO 400000 + MOVEI A,400000 + MOVEM A,DECTWO + +A.DECREL: PUSHJ P,OUTUPD + TRZ FF,FRLOC + PUSHJ P,EBLK ;FORCE OUT BLOCK IN OTHER FMT. + MOVE A,[SETZ DECREL] + CAME A,CONTRL ;SWITCHING TO .DECREL MODE FOR 1ST TIME + TRNE FF,FRNPSS ;IN A 1PASS ASSEMBLY + JRST A.FAS1 + CALL A.FAS1 ;DO THE SWITCH + JFCL + CALL DECPGN ;THEN WRITE THE PROGRAM NAME + JRST MACCR + +A.FAS1: MOVEM A,CONTRL ;DEC FMT COUNTS AS ABS ASSEMBLY. + SETZM BKBUF ;(SO EBLK W0N'T OUTPUT ANYTHING) + SETZM CLOC ;START ASSEMBLING FROM RELOCATABLE 0. + MOVEI A,1 + MOVEM A,CRLOC + PUSHJ P,EBLK ;INITIALIZE AN ORDINARY (DECWDS) BLOCK. + JRST MACCR + +IFN FASLP,[ +A.FASL: PUSHJ P,OUTUPD + PUSHJ P,EBLK + MOVE A,[SETZ FASL] ;FASL ALSO COUNTS AS ABS + JRST A.FAS1 +] + +ATITLE: NOVAL + PUSH P,CASSM1 ;RETURN TO ASSEM1. + PUSHJ P,GSYL + SKIPE SYM + MOVEM SYM,PRGNM + MOVE T,[440700,,STRSTO] +ATIT2: ILDB A,T ;GET CHAR FROM TITLE STRING + SOSG STRCNT + JRST ATIT3 ;CHAR IS SYLLABLE TERMINATOR +IFE ITSSW,[ + SKIPE CCLFLG + TRNN FF,FRPSS2 +] + PUSHJ P,TYO ;NOT TERMINATOR, TYPE OUT AND LOOP BACK + JRST ATIT2 + +ATIT3: CALL ATIT1 ;PRINT THE REST OF THIS LINE. + MOVE A,CONTRL + TRNE A,DECREL + TRNE FF,FRNPSS + CAIA + ETF [ASCIZ /TITLE follows 1PASS/] + MOVE A,TTYINS + ADD A,A.PASS ;SHOULD WE .INSRT TTY: THIS PASS (T SWITCH) + JUMPG A,CPOPJ +IFDEF GTYIPA,JRST GTYIPA ;GO PUSH TO TTY IF CAN, +IFNDEF GTYIPA,HALT ;WHY DID YOU SET TTYINS IF CAN'T? + +ATIT1: CAIE A,15 ;CR? + CAIN A,12 ;LF? +IFN ITSSW,JRST CRR ;ONE OF THESE, FINISH TYPEOUT WITH CR +.ELSE [ JRST [ SKIPE CCLFLG + TRNN FF,FRPSS2 + JRST CRR + RET] + SKIPE CCLFLG ;NEITHER OF THESE, PRINT CHAR. + TRNN FF,FRPSS2 ;ON DEC SYS, DON'T PRINT THE TITLE ON P2, OR AT ALL IF RUN BY CCL. +] + PUSHJ P,TYO +A.ERR1: PUSHJ P,RCH ;GET NEXT CHAR IN TITLE + JRST ATIT1 + +;.ERR PSEUDO-OP -- FOLLOWED BY LINE WHICH IS ERROR MSG. +A.ERR: PUSH P,CASSM1 ;RETURN TO ASSEM1, + ERJ A.ERR1 ;AFTER NUMBERS AND USER'S STRING. + +A.FATAL:PUSH P,[GO9] ;.FATAL - CAUSE A FATAL ERROR. + ERJ A.ERR1 + +APRINT: NOVAL + HLRZS B ;B SAYS WHETHER PRINTX, PRINTC OR COMMENT. + JSP TM,ERMARK + CALL PASSPS + MOVE T,A +APRIN1: PUSHJ P,RCH + CAME A,T + JRST (B) ;GO TO APRIN1 FOR COMMENT, + JRST MACCR + +APRIN2: CAIE A,"! ;COME HERE FOR PRINTX +APRIN3: PUSHJ P,TYO ;HERE FOR PRINTC + JRST APRIN1 + +A.TYO: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A CHARACTER (AS NUMERIC ARG). + CALL TYOERR + JRST MACCR + +A.TYO6: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A WORD OF SIXBIT. + MOVE B,A + CALL SIXTYO + JRST MACCR + +;.BEGIN - START NEW BLOCK WITH NAME = ARG, OR LAST LABEL DEFINED. +A.BEGIN: NOVAL + SKIPE ASMOUT ;IF IN GROUPING, FLUSH IT & ERROR. + JSP LINK,CONFLM + PUSHJ P,GETSLD ;READ A NAME. + MOVE SYM,SYSYM ;NO ARG, USE NAME OF LAST LABEL. + MOVE A,SYM ;NAME TO USE FOR BLOCK. + MOVE B,BKLVL ;CURRENT LEVEL + 1 + HRLZI B,1(B) ;IS LEVEL OF NEW BLOCK. + HRR B,BKCUR ;ITS SUPERIOR IS CURRENT BLOCK. + MOVEI C,0 ;SEE IF AN ENTRY EXISTS FOR THIS BLOCK. + MOVE AA,A.PASS +A.BEG0: CAMN A,BKTAB(C) + CAME B,BKTAB+1(C) + JRST A.BEG1 ;THIS ENTRY ISN'T FOR BLOCK BEING ENTERED. + TDNE AA,BKTAB+2(C) ;FOUND: DEFINED IN THIS PASS? + ETSM [ASCIZ /Multiply defined BLOCK/] + JRST A.BEG2 ;NO, SAY IT'S DEFINED. + +A.BEG1: ADDI C,BKWPB ;LOOK THRU ALL ENTRIES. + CAMGE C,BKTABP + JRST A.BEG0 + CAIL C,BKTABS ;ALL ENTRIES USED => ERROR. + ETF ERRTMB + MOVEM A,BKTAB(C) ;ALLOCATE NEW ENTRY + MOVEM B,BKTAB+1(C) ;STORE NAME, LEVEL, SUPPRO. + MOVEI A,BKWPB(C) + MOVEM A,BKTABP ;POINTS TO 1ST UNUSED ENTRY. +A.BEG2: IORM AA,BKTAB+2(C) ;INDICATE BLOCK SEEN THIS PASS. + MOVEM C,BKCUR ;NEW BLOCK NOW CURRENT BLOCK, + AOS A,BKLVL ;ITS LEVEL NOW CURRENT LEVEL, + CAIL A,BKPDLS ;PUSH IT ON BLOCK PDL + ETF [ASCIZ /.BEGIN nesting too deep/] + MOVEM C,BKPDL(A) + JRST ASSEM1 + +ERRTMB: ASCIZ /Too many symbol blocks/ +ERRUMB: ASCIZ /Unmatched .BEGIN - .END/ + +;.END - POP CURRENT BLOCK. +A.END: NOVAL + SKIPE ASMOUT ;IN GROUPING => TERMINATE IT & ERROR. + JSP LINK,CONFLM + MOVE A,CDISP ;IF FOLLOWED BY WORD TERM, + TLNN A,DWRD ;CAUSE IT TO BE RE-READ + TLO FF,FLUNRD ;SO ARG WILL BE NULL. + PUSHJ P,GETSLD ;READ ARG. + JRST A.END0 ;NO ARG. + MOVE C,BKCUR ;ERROR UNLESS BLOCK BEING TERMINATED + MOVE A,BKTAB(C) ;HAS SAME NAME AS ARG. + EXCH A,SYM ;(MAKE SURE SYM NAME TYPED IS BLOCK'S NAME) + CAME A,SYM + ETSM ERRUMB ;ERROR, PRINT SYM (BLOCK'S NAME) +A.END0: MOVE C,BKCUR ;NOT OK TO END .MAIN BLOCK OR .INIT BLOCK. + CAIG C,BKWPB + ETA ERRUMB + HRRZ C,BKTAB+1(C) + MOVEM C,BKCUR ;POP INTO FATHER OF PREV. CURRENT BLOCK. + SOS BKLVL + JRST ASSEM1 + +;BKTAB: 3-WORD ENTRIES, 1 PER BLOCK, IN NO PARTICULAR ORDER. +;1ST WD HAS SQUOZE NAME OF BLOCK, FLAGS CLEAR. +;2ND WD HAS LEVEL,,BKTAB IDX OF CONTAINING BLOCK("FATHER", "SUPERIOR") +;3RD WD BIT 1.N ON => BLOCK ENTERED ON PASS N. +;SYMBOL TABLE OUTPUT RTN PUTS -2* IN 3RD WD. +;THE FIRST BKTAB ENTRY IS THAT OF THE OUTERMOST BLOCK (.INIT) +;IN WHICH INITIAL SYMS ARE DEFINED. +;THAT ENTRY'S 2ND AND 3RD WDS ARE 0. +;THE NEXT IS THAT OF THE MAIN BLOCK (.MAIN) IN WHICH +;ALL SYMBOLS ARE NORMALLY DEFINED (THAT IS, YOU ARE IN THAT BLOCK +;BEFORE YOU DO ANY .BEGIN'S). +;THAT ENTRY'S 2ND WD IS 1,, ; ITS 3RD, 0. + +;THE BKPDL IS A TABLE OF BLOCKS CURRENTLY ENTERED & NOT ENDED. +;BKPDL'S 1ST ENTRY IS FOR OUTERMOST BLOCK. +;LAST ENTRY IS BKPDL+@BKLVL, FOR CURRENT BLOCK. + +BKTABS==BKTABL*BKWPB + +VBLK +BLCODE [ +BKTAB: BLOCK 3 ;ENTRY FOR .INIT BLOCK. +PRGNM: BLOCK BKTABS-BKWPB ;PROGRAM NAME IS NAME OF MAIN BLOCK. +] +BKTABP: 0 ;IDX IN BKTAB OF 1ST UNUSED ENTRY. +BKPDL: BLOCK BKPDLS ;TABLE OF BLOCKS STARTED, NOT FINISHED. +BKLVL: 0 ;CURRENT BLOCK LEVEL, IDX OF LAST USED IN BKPDL. +BKCUR: 0 ;BKTAB IDX OF CURRENT BLOCK. +ESBK: 0 ;-1 OR BLOCK TO EVAL SYM. IN. +ESL1: 0 ;IN ES, LEVEL OF BLOCK OF BEST SYM SO FAR. +ESL2: 0 ;3RDWRD OF BEST SO FAR. +SADR: 0 ;SYM TAB IDX OF BEST SO FAR. +ESLAST: 0 ;RH IDX OF LAST DEF (EVEN IF NO GOOD) -1 IF NONE + ;SIGN NEG. IF LAST DEF SEEN BEFORE @ESXPUN +ESXPUN: -1 ;IF SEE EXPUNGED OR FREE ENTRY, PUT IDX HERE. +BKTAB1: BLOCK BKTABL ;USED BY SSYMD. +PBLK + +;.SYMTAB ARG ;SAY WANT AT LEAST ARG STE'S IN SYMTAB. +A.SYMTAB: NOVAL + PUSH P,[0] ;THIS WORD WILL BE SETOM'ED IF THERE IS REALLY ANY WORK NEEDED. + PUSHJ P,AGETFD ;GET DESIRED SYM TAB SIZE. + CAMG A,SYMLEN ;IF HAVE ENOGH ROOM ALREADY, + JRST A.SYM1 ;NO NEED TO RE-INIT. + CAILE A,SYMMAX ;IF WANTS MORE THAN MAXIMUM, ERROR. + ETF [ASCIZ/.SYMTAB 1st arg too big/] + MOVEM A,SYMLEN ;TELL INITS ABOUT NEW SIZE. + SETOM (P) +A.SYM1: CALL AGETFD ;READ DESIRED CONSTANTS TABLE SPACE ALLOCATION. + CAMG A,CONLEN ;IF TABLE ALREADY BUG ENOUGH, NOTHING TO DO. + JRST A.SYM2 + CAILE A,CONMAX + ETF [ASCIZ/.SYMTAB 2nd arg too big/] + MOVEM A,CONLEN ;ELSE REMEMBER IT AND SAY REALLOCATION NECESSARY. + SETOM (P) +A.SYM2: CALL AGETFD ;3RD ARG IS # WORDS PER SYMBOL - BUT ONLY 3 IS ALLOWED NOW. + JUMPE A,A.SYM3 ;EVENTUALLY 4 WILL GET 12-CHARACTER SYMBOLS. + CAIL A,MINWPS + CAILE A,MAXWPS + ETF [ASCIZ/.SYMTAB 3rd arg out of range/] + CAME A,WPSTE + SETOM (P) + MOVEM A,WPSTE +A.SYM3: REST A ;IS THERE ANYTHING THAT ACTUALLY NEEDS TO BE CHANGED? + JUMPE A,ASSEM1 ;IF NOT, NEVER GIVE ERROR - ELSE WOULD ALWAYS LOSE ON PASS 2. + MOVE B,PLIM + CAMN B,CONTBA ;IF THERE HAVE BEEN ANY LITERALS + SKIPE INICLB ;OR ANY MACROS, IRPS, REPEATS, ETC., THEN ... + ETF [ASCIZ/Too late to do .SYMTAB/] + MOVE CH1,MACTAD ;SET UP AC -> START OF INIT CODE + SUBI CH1,MACTBA ;SO IT CAN REFER TO ITSELF. + PUSHJ P,INITS(CH1) ;RE-INIT, SET SYMSIZ, SYMAOB, ETC. + PUSHJ P,MACINI ;INIT PTRS TO END OF MACTAB. + JRST ASSEM1 + +A.OP: PUSHJ P,A.OP1 ;.OP, + JRST VALRET ;RETURNS VALUE + +A.AOP: NOVAL + AOS (P) ;.AOP DOESN'T RETURN VALUE +A.OP1: PUSHJ P,AGETFD + PUSH P,A + PUSHJ P,AGETFD + PUSH P,A ;PDL NOW HAS FIELD 0 AND FIELD 1 + PUSHJ P,AGETFD + POP P,B ;B NOW HAS FIELD 1, A HAS FIELD 2, PDL HAS FIELD 0 + EXCH A,B + POP P,T ;T HAS FIELD 0, A HAS FIELD 1, B HAS FIELD 2 + TLNN T,(0 17,) ;IF AC FIELD NOT PRESENT IN INSN, SUPPLY ONE. + TLO T,(0 A,) + TDNN T,[0 -1(17)] ;IF NO ADDR OR IDX FIELD IN INSTRUCTION, + HRRI T,B ;SUPPLY ONE. + SETOM A.ASKIP' ;.ASKIP WILL BE -1 IFF INSN SKIPPED, ELSE 0. + TLNE T,74000 ;AVOID EXECUTING OPCODE ZERO. + XCT T + SETZM A.ASKIP + MOVEM A,AVAL1' ;STORE C(AC) AS .AVAL1 + MOVEM B,AVAL2' ;STORE C(E) FOR .AVAL2 + POPJ P, ;RETURN TO WHATEVER + +AASCIZ: TDZA T,T +A.ASCII: MOVEI T,1 + MOVEM T,AASCF1 ;STORE TYPE + MOVE D,[440700,,T] + SETZM AASCFT + JRST AASC1 + +AASCII: SKIPA D,[440700,,T] +ASIXBI: MOVE D,[440600,,T] + SETZM AASCFT ;INDICATE NOT .DECTXT + SETOM AASCF1 ;INDICATE REGULAR (NOT ASCIZ) + JRST AASC1 + +A.DCTX: NOVAL + MOVE A,CONTRL + TRNN A,DECREL + ETA [ASCIZ /.DECTXT in non-DECREL assembly/] + CALL EBLK + SETZ B, + SETOM AASCFT + SETOM AASCF1 ;INDICATE ASCIZ-STYLE PADDING + MOVE D,[440700,,T] +AASC1: TLZE I,ILMWRD + JRST TEXT2 ;MULTIPLE WORD, FALL IN FOR NEXT SET OF CHARS + MOVEMM ASMDS1,ASMDSP + MOVEM SYM,DEFNPS ;REMEMBER LOCATION IN FILE OF PSEUDO + MOVEMM DEFNLN,CLNN ;IN CASE THE DELIMITER IS MISSING. + MOVEMM DEFNPN,CPGN +IFN TS, MOVEMM DEFNFI,INFFN1 + HLRZ T,B ;GET FILL CHARACTER + IMUL T,[REPEAT 5,[1_<.RPCNT*7>+]0] ;CONVERT TO ASCII FILL WORD SHIFTED -1 (IMUL SCREW) + LSH T,1 ;SHIFT TO PROPER POSITION (EXTRA IN CASE WANT TO FILL W/ HIGH BIT SET) + MOVEM T,AASEFW ;STORE AS FILL WORD, T NOW SET UP TO ACCUMULATE VALUE + CALL PASSPS + MOVEM A,TEXT4 ;STORE TERMINATOR +TEXT7: PUSHJ P,RCH +AASC8: CAMN A,TEXT4 + JRST AASC1A ;TERMINATOR + TLNN D,760000 + JRST TEXT6 ;WORD FULL +TEXT9: TLNE D,100 ;CHECK BOTTOM BIT OF SIZE FIELD OF BP + JRST AASC2 ;SET => NOT SIXBIT + SUBI A,40 + CAILE A,77 + SUBI A,40 ;CONVERT LOWER CASE ASCII TO UPPER CASE + JUMPGE A,.+2 + ETR ERRN6B +AASC3: IDPB A,D + TRO I,IRSYL + JRST TEXT7 + +ERRN6B: ASCIZ /Character not SIXBIT/ + +;TERMINATOR + +AASC1A: TLNN D,760000 ;SKIP UNLESS END OF WORD + SKIPGE AASCF1 ;SKIP UNLESS REGULAR + JRST [ MOVE CH1,ASMDS1 ;REGULAR OR NOT END OF WORD + MOVEM CH1,ASMDSP ;RESTORE ASMDSP AS SAVED AT START OF PSEUDO. + JRST TEXTX] + MOVEI CH1,1 ;END OF WORD AND NOT REGULAR + JRST AASC1B ;EXTRA 0 NEED FOR Z FLAVOR + +AASC2: CAIN A,"! + SKIPG AASCF1 + JRST AASC3 ;NOT .ASCII OR NOT EXCL + PUSH P,T ;READ FIELD + PUSH P,TEXT4 + PUSH P,D + PUSH P,SYM + PUSH P,ASMOUT ;PREVENT CLOSEBRACKETS FROM TRYING TO TAKE EFFECT. + MOVEIM ASMOUT,4 ;NOTE THIS LOSES IF CALL PSEUDO THAT RETURNS TO ASSEM1. + MOVEI SYM,[SETOM ASUDS1] ;NOW TO SET UP UNDEFINED SYM CONDITION + TLNE FF,FLPPSS + MOVE SYM,[SQUOZE 0,.ASCII] ;PUNCHING PASS, UNDEFINED => REAL ERROR + CLEARM ASUDS1 + PUSHJ P,AGETFD + ;"UNDEFINED IN .ASCII" ERROR INSTR, ERROR MESSAGE BUT ONLY ON PASS 2 + ;BUT NOTE THAT ON PASS 2 IT MIGHT ASSEMBLE DIFFERENT NUMBER OF WORDS, + ;CAUSING LOSSAGE IF NOT IN CONSTANT + REST ASMOUT + POP P,SYM + POP P,D + POP P,TEXT4 + POP P,T + SKIPGE ASUDS1 + MOVNI A,1 ;HAD UNDEFINED SYMS SO ASSUME MAX + SKIPGE ASUDS1 + TLO I,ILNOPT ;ALSO DON'T OPTIMIZE OVER IN CONSTANT + MOVE CH1,[440700,,AASBF] + MOVEM CH1,ASBP1 + MOVEM CH1,ASBP2 + PUSH P,[AASC5] + MOVE CH1,A +AASC6: LSHC CH1,-35. + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,AASC6 + HLRZ A,(P) + ADDI A,"0 + IDPB A,ASBP1 + POPJ P, + +AASC5: MOVEI A,0 + IDPB A,ASBP1 ;END .ASCII NUMBER WITH ZERO +AASC8A: TLNN D,760000 + JRST AASC7 ;END OF WORD + ILDB A,ASBP2 + JUMPE A,AASC9 + IDPB A,D + JRST AASC8A + +AASC9: TLO FF,FLUNRD + JRST TEXT7 + +AASC7: TDZA CH1,CH1 +TEXT6: MOVNI CH1,1 ;WORD FULL +AASC1B: MOVEM CH1,AASCF2 + CLEARM CDISP + MOVEM A,TEXT8 + MOVE A,T + SKIPE AASCFT ;FOR .DECTXT, OUTPUT WORD INSTEAD OF RETURNING IT. + JRST [ CALL PPB + MOVE D,[440700,,T] + JRST TEXT2A] + TLO I,ILMWRD ;ELSE ARRANGE TO BE CALLED BACK TO RETURN NEXT WORD. + MOVEI T,ASSEM2 + MOVEM T,ASMDSP + SKIPLE CONSML ;IF NOT MULTI-LINE MODE, + JRST CLBPOP + MOVE T,ASMOUT ;IF THE TEXT IS IN <>'S OR ()'S, + HRRZ T,ASMOT2(T) + CAIE T,LSSTHA + JRST CLBPOP + CALL IGTXT ;USE ONLY THE FIRST WORD. + SKIPE CONSML ;AND ERROR IF IN ERROR MODE. + ETR [ASCIZ/Multi-word text pseudo in brackets/] + JRST CLBPOP + + ;GET NEXT WORD + +TEXT2: TRO I,IRFLD +TEXT2A: MOVE T,AASEFW ;INITIALIZE T TO FILL WORD + MOVE A,TEXT8 ;GET NEXT CHAR (ALREADY READ BY RCH) + SKIPGE B,AASCF2 + JRST TEXT9 ;REG OR HAVEN'T READ SECOND DELIMITER, FALL BACK IN + JUMPE B,AASC8A +TEXTX: SETZM DEFNPS + SETOM TEXT4 + SKIPN AASCFT + JRST TEXT5 ;RETURNING FROM ASCIZ AFTER PUTTING THE TRAILING ZERO OUT. + MOVE A,T + CALL PPB ;FOR .DECTXT, OUTPUT THE FILL WORD INSTEAD. + JRST MACCR + +VBLK + +AASCF1: 0 ;-1 REG OR SIXBIT, 1 .ASCI 0 ASCIZ +AASCF2: 0 ;MULTIPLE WORD RETURN FLAG -1 REG 0 FINISH ! HACK 1 OUTPUT FILL WORD FOR Z +AASCFT: 0 ;0 REGULAR, -1 => .DECTXT (OUTPUT WORDS TO FILE INSTEAD OF RETURNING THEM) +TEXT4: -1 ;DELIMITER, OR -1 IF NOT INSIDE A TEXT PSEUDO. +TEXT8: 0 ;SAVED NEXT CHAR WHILE RETURNING BETWEEN WORDS +ASBP1: 0 ;IDPB TO AASBF ON .ASCII FIELD +ASBP2: 0 ;ILDB FROM AASBF " +AASBF: BLOCK 8 ;ACCUMULATED TYPEOUT OF NUMBER FOR .ASCII, EXTRA LONG FOR HACKERS TYPING OUT BINARY +ASUDS1: 0 ;UNDEFINED SYM FLAG FOR .ASCII DURING PASS 1 +AASEFW: 0 ;FILL WORD + +PBLK + +IGTXT: TLNN I,ILMWRD + RET + PUSH P,A ;ROUTINE TO EAT UP TEXT OF UNDESIRED MULTIPLE WORD + SKIPLE AASCF2 ;DETECT SCREW CASE: AFTER ASCIZ OF 5 CHARS, DELIMITER IS + JRST IGTXT1 ;ALREADY GOBBLED, BUT SOME OF THE ASCIZ REMAINS. + PUSHJ P,RCH + CAME A,TEXT4 + JRST .-2 +IGTXT1: TLZ I,ILMWRD + MOVEMM ASMDSP,ASMDS1 + SETZM DEFNPS + SETOM TEXT4 + JRST POPAJ + +;".ASCVL /X" RETURNS THE ASCII VALUE OF "X". NOTE THE DELIMITER IS NOT REPEATED +;AND SERVES ONLY TO ALLOW SPACES TO BE IGNORED WHILE WINNING IF X IS A SPACE. +A.ASCV: CALL PASSPS ;SKIP SPACES TO REACH THE DELIMITER. + CALL RCH ;READ THE CHAR AFTER THE DELIMITER + MOVE T,A + JRST TEXT5 ;AND RETURN ITS ASCII VALUE. + +ASQOZ: HLLM B,(P) ;SAVE FLAG THAT'S 0 FOR SQUOZE, -1 FOR .RSQZ . + PUSH P,SYM + PUSHJ P,AGETFD + LSH A,36 + PUSH P,A + PUSHJ P,GETSLD ;GET SYM, SAVE DELIMITER FOR REINPUT + CALL NONAME + REST A + LDB B,[4000,,SYM] ;GET JUST THE SQUOZE. + SKIPGE -1(P) + PUSHJ P,ASQOZR ;FOR .RSQZ, RIGHT-JUSTIFY IT. + SUB P,[1,,1] + ADD A,B + JRST CLBPOP + +;RIGHT-JUSTIFY THE SQUOZE WORD IN B. +ASQOZR: MOVE SYM,B + IDIVI SYM,50 + JUMPN LINK,CPOPJ ;LAST ISN'T BLANK, DONE. + MOVE B,SYM ;ELSE REPLACE BY WHAT'S SHIFTED RIGHT 1 CHAR. + JRST ASQOZR + + ;COMMON PSEUDO ROUTINE TO RETURN MIDAS INTERNAL QUANTITY + ;ADR IN LH(B)) AS VALUE (EG. .RPCNT, .FNAM1, .AVAL2, ETC. + ;INTSYMS MAY APPEAR TO LEFT OF = + +INTSYM: MOVE A,B ;GET ADR IN LH(A) + JRA A,CLBPOP ;RETURN IT + + ;.YSTGW, .NSTGW ACCORDING TO WHAT'S IN LH(B) + +STGWS: HLRES B ;.NSTGW INCREMENTS STGSW, .YSTGW DECREMENTS. + ADDB B,STGSW + SKIPGE B ;BUT DON'T DECREMENT PAST 0. + SETZM STGSW + JRST MACCR ;STORAGE WORDS ARE ALLOWED IF STGSW IS ZERO. + + ;.TYPE + +A.TYPE: PUSH P,SYM + PUSH P,SYM + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + SUB P,[2,,2] + TRNN I,IRLET ;IF SYLLABLE IS A NUMBER, + JRST [ SETO A, ;RETURN -1. + JRST CLBPOP] + PUSHJ P,ES ;EVALUATE SYM, INTERESTED IN SQUOZE FLAGS RETURNED IN A + MOVEI A,17 ;DIDN'T SKIP, RETURN 17 => UNSEEN +IFN CREFSW,XCT CRFINU + JRST CLBPOP + +NONAME: MOVE SYM,-2(P) + ETSM [ASCIZ /No arg/] + SETZ SYM, + POPJ P, + + ;.FORMAT + +A.FORMAT: PUSHJ P,AGETFD ;GET FIRST FIELD (FORMAT #) + MOVE B,CDISP ;WORD TERMINATOR ENDED 1ST ARG => + TLNN B,DWRD + JRST A.FOR1 ;RETURN CURRENT SPEC FOR THAT FORMAT. + PUSH P,A + PUSHJ P,AGETFD ;GET SECOND FIELD (TABLE ENTRY FOR FORMAT NUMBER) + POP P,B + MOVEM A,FORTAB-10(B) + JRST ASSEM1 + +A.FOR1: MOVE A,FORTAB-10(A) + JRST CLBPOP + +A.BYTE: NOVAL + CLEARM NBYTS ;# BYTES ASSEMBLED + CLEARM BYTMT ;TOTAL ACTIVE BYTES IN TABLE + MOVE A,[440700,,BYBYT] ;POINTER TO NEW TABLE + MOVEM A,BYTMP +A.BY1: PUSHJ P,AGETFD ;GET FIELD, .GE. 0 => BYTE, .LT. 0 => HOLE + MOVE C,ISAV + TRNN C,IRFLD + JRST A.BY2 ;NO FIELD + MOVM B,A + SKIPGE A + TRO B,100 + IDPB B,BYTMP + AOS BYTMT +A.BY2: TLNE CH1,DWRD ;CDISP LEFT IN CH1 BY AGETFD + JRST A.BY1 ;NOT WORD TERMINATOR + SKIPN BYTMT ;WORD TERMINATOR, ANY FIELDS? + JRST A.BY3 ;NO, DO .WALGN AND RESET TO WORD MODE + SETOM BYTM ;ENTERING BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETOM BYTM1 + PUSHJ P,BYSET + MOVE A,GLSPAS + MOVEM A,GLSP1 + JRST ASSEM1 + + ;RESET THE BYTE DESCRIPTOR TABLE POINTERS TO POINT TO NEW WORD + +BYSET: CLEARM BYTMC ;COUNT OF BYTES PROCESSED THIS TABLE SCAN + MOVE A,[440700,,BYBYT] ;POINTER TO DESCRIPTOR TABLE + MOVEM A,BYTMP + ILDB A,BYTMP ;FIRST DESCRIPTOR BYTE + AOS BYTMC + DPB A,[300600,,BYTWP] ;DEPOSIT AS FIRST BYTE SIZE + POPJ P, + +A.BY3: CLEARM BYTM ;NO LONGER IN BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETZM BYTM1 + JRST A.WAL1 + +A.WALGN: NOVAL +A.WAL1: LDB A,[360600,,BYTWP] + CAIN A,44 + JRST ASSEM1 ;ALREADY AT BEGINNING OF WORD + MOVEI A,44 + DPB A,[360600,,BYTWP] ;MAKE IT POINT TO BEGINNING OF WORD + PUSHJ P,BYSET + CLEARM T1 + JRST PBY1 + +BYTIN1: CLEARM BYTMC + MOVE A,[440700,,BYBYT] + MOVEM A,BYTMP +BYTINC: AOS A,BYTMC + CAMLE A,BYTMT + JRST BYTIN1 + ILDB A,BYTMP + DPB A,[300600,,BYTWP] + MOVEM A,T1 + HLLZ A,BYTWP + IBP A + TRNN A,-1 + JRST BYTINR + ;NEXT BYTE GOES IN NEXT WORD +PBY1: MOVE P,ASSEMP ;PCONS NEEDS THIS. + MOVEI A,WRD-1 + PUSH A,BYTW ;INTO WRD, + PUSH A,BYTRLC ;INTO WRDRLC + CLEARM BYTW + SETZM BYTRLC + MOVEI A,44 + DPB A,[360600,,BYTWP] + MOVE AA,ASMOUT + JRST @ASMOT4(AA) ;TO PBY4 OR PBY5 OR PBY3 + +PBY4: SKIPE STGSW + ETR ERRSWD + PUSHJ P,PWRD ;NOT IN CONST., OUTPUT WORD. + AOSA CLOC +PBY3: JSP T,PCONS ;OUTPUT INTO CONST. +PBY5: MOVE A,GLSPAS + MOVEM A,GLSP1 +BYTINR: MOVE A,T1 ;CURRENT BYTE SIZE + TRNN A,100 + JRST @ASMDSP + SETZB A,B ;ASSEMBLE HOLE (BLANK BYTE) IMMEDIATELY AFTER PREVIOUS BYTE + JRST PBY2 + +PBYTE: AOS NBYTS +PBY2: MOVEI AA,WRD-1 + PUSH AA,BYTW ;INTO WRD + PUSH AA,BYTRLC ;INTO WRDRLC + IBP BYTWP + LDB T,[301400,,BYTWP] + PUSHJ P,INTFLD + POP AA,BYTRLC ;WRDRLC + POP AA,BYTW ;WRD + JRST BYTINC + + ;VARIABLES FOR .BYTE, .BYTC, .WALGN + +VBLK +BYTM: 0 ;-1 FOR IN BYTE MODE, LAMBDA BOUND BY <'S, ('S, AND ['S ;] +BYTMC: 0 ;COUNT CORRESP WITH BYTMP +BYTMP: 0 ;POINTER TO BYTE DESC TABLE +BYTMT: 0 ;TOTAL ACTIVE BYTES IN TABLE +BYTM1: 0 ;GLOBAL VALUE OF BYTM - WHAT IT WAS OUTSIDE THE OUTERMOST BRACKET + +;FORMAT OF BYTE DESC TABLE +;SEVEN BIT BYTES +;1.7=0 ASSEMBLE =1 BLANK +;1.1 - 1.6 NUMBER OF BITS + +IFNDEF LBYBYT,LBYBYT==5 ;LENGTH OF BYBYT +BLCODE [BYBYT: BLOCK LBYBYT] ;BYTE DESC TABLE, 7 BITS PER DESC + +BYTWP: 440000,,BYTW ;POINTER TO BYTW IDPB TO DEPOSIT CURRENT BYTE +BYTW: 0 ;WORD BEING ASSEMBLED IN BYTE MODE +BYTRLC: 0 ;RELOC OF BYTW. +NBYTS: 0 ;NUMBER BYTES ASSEMBLED (FOR .BYTC) +BYTMCL==.-BYTMC +PBLK + +;;MACRO PROCESSOR +IFN MACSW,[ + ;GET IN B THE CHAR WHOSE ADR IS IN A, INCREMENT A + +REDINC: MOVE CH1,A + IDIVI CH1,4 + LDB B,PTAB(CH2) + AOJA A,CPOPJ + +VBLK ;THIS STUFF ALL RELOCATED WHEN MACTAB ADDR CHANGED. +PTAB: (341000+CH1)MACTBA ;BYTE TABLE + (241000+CH1)MACTBA + (141000+CH1)MACTBA + (41000+CH1)MACTBA + (341000+CH1)MACTBA+1 + + ;IN FOLLOWING MACROS, B = -1, 0, OR +1 (+ SIGN MUST BE GIVEN) + ;0 => BP SAME AS CHAR ADR, -1 => BP FOR ILDB, 1 => BP ONE AHEAD + + ;CHAR ADR IN A, RETURNS BP IN A, CLOBBERS A+1 + +DEFINE BCOMP A,B/ + IDIVI ,4 + ADD ,(+1)BCOMPT!B +TERMIN + +STOPPT: 041000,,MACTBA-1 +BCOMPT: 341000,,MACTBA + 241000,,MACTBA +BCOMPU: 141000,,MACTBA + 041000,,MACTBA + 341000,,MACTBA+1 + +;BP IN A RETURN CHAR ADR IN A, CLOBBERS A-1 (YES, A MINUS 1) +;2ND ARG IS SUBTRACTED - -1 GIVES ADDR OF THE NEXT CHAR. +DEFINE CCOMP A,B/ + MOVEI -1,0 + ASHC -1,2 + SUB ,(-1)CCOMPT!B +TERMIN + + ;BP IN A RETURN CHAR ADR IN A+1, CLOBBERS A + +DEFINE CCOMP1 A,B/ + MULI ,4 + SUB +1,(A)CCOMPT!B +TERMIN + +;FROM HERE THRU CCOMPE SET BY MACINI. +CCOMPB: 0 ;4*<41000,,MACTBA>-4 +CCOMPT: REPEAT 5,0 ;4*<41000,,MACTBA>+.RPCNT-3 +CCOMPE::PBLK + + ;BP IN A, DECREMENT IT + +DEFINE DBPM A + ADD A,[100000,,] + SKIPGE A + SUB A,[400000,,1] +TERMIN + +;SET UP CPTR FROM CHAR ADR IN A + +ACPTRS: MOVEI CH1,(A) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE COMPUTED CPTR + POPJ P, + +AFCOMP: HRRZM A,FREEPT ;ENTRY TO STORE C(A) INTO FREEPT +FCOMP: MOVE CH1,FREEPT ;COMPUTE FREPTB FROM FREEPT + BCOMP CH1,-1 + MOVEM CH1,FREPTB ;STORE CALCULATED BYTE POINTER + POPJ P, + +STPWR: MOVEI A,375 + JRST PUTREL + +VBLK +PUT377: MOVEI A,377 +PUTREL: JRST PUTRE1 ;IDPB A,FREPTB;STORE CHAR INTO FREE CHARACTER STORAGE + AOS A,FREEPT ;CLOBBERS ONLY A. + AOS PUTCNT + CAMGE A,MACHI + POPJ P, + JRST GCA +PBLK +PUTRE1: PUSH P,[IDPB A,FREPTB] + POP P,PUTREL ;COME HERE ONLY ON 1ST CALL TO PUTREL. + SETOM INICLB ;HAVE WRITTEN IN MACRO TAB & CLOBBERED INIT. + JRST PUTREL ;NOW GO BACK AND REALLY WRITE CHAR. + +;200 BIT SET ON CHAR READ FROM MACTAB, PROCESS SPECIAL CONDITION +;CLOBBERS A,CH1,CH2. + +MACTRM: CAIN A,176 ;376? + JRST RCHTRA ;376 => IGNORE, CHARACTER USED TO CLOBBER UNDESIRED CHARACTERS IN MACRO STORAGE + PUSH P,B ;SAVE B + CAIE A,177 + CAIN A,175 + JRST MRCH1 ;377, 375 => STOP + ADD A,BBASE ;DUMMY, RELOCATE TO POINT TO DUMMY TABLE + MOVEI B,RCHSAV ;RETURN TO RCHSAV ON END OF DUMMY + PUSHJ P,PUSHEM ;SAVE CURRENT STATUS + HRRZ A,(A) ;GET CHAR ADR OF DUMMY + BCOMP A,-1 ;CONVERT TO BYTE POINTER + MOVEM A,CPTR ;STORE AS NEW CPTR + MOVE A,TOPP + MOVEM A,BBASE +RCHTRB: POP P,B +RCHTRA: POP P,A ;POP RETURN + TLZN FF,FLUNRD ;IF NO CHAR TO RE-READ, JUST RETURN BACK TO THE ILDB A,UREDP. + JRST -3(A) + ANDI A,-1 ;IF A CHAR TO RE-READ, IF CALLED FROM RREOF, WE CAN RETURN TO RRU + CAIN A,RREOF+1 + JRST RRU + PUSH P,A ;OTHERWISE, CALL RCH TO RE-READ THAT CHAR, AND RETURN IT FROM + JRST RCH1 ;THE CURRENT ATTEMPT TO READ A CHAR. + +MRCH1: MOVE B,MACP +BPOPJ: POPJ B, ;RETURN AT END OF STRING EXPANSION + +;RCHSET ROUTINE TO CAUSE INPUT FROM MACRO PROCESSOR + +RCHMAC: TLO FF,FLMAC ;SET FLAG + JSP A,CPOPJ +RCHMC0: REPEAT 2,[ ;GETCHR, RR1 + ILDB A,CPTR ;GET CHAR + TRZE A,200 ;200 BIT... + PUSHJ P,MACTRM ;=> SPECIAL, PROCESS +] + .VALUE +IFN .-RCHPSN-RCHMC0,.ERR RCHMC0 LOSES. + ILDB A,CPTR ;SEMIC + TRZE A,200 + PUSHJ P,MACTRM + CAIE A,15 + JRST SEMIC ;NOT YET + JRST SEMICR ;YET + + ;PUSH INPUT STATUS IN FAVOR OF MACRO + ;B HAS RETURN ADR FOR END OF MACRO (OR WHATEVER) + ;SEE ALSO PMACP + +PUSHEM: PUSH P,A + PUSH P,F + MOVE F,MACP ;GET MACRO PDL POINTER + MOVE CH1,CPTR + CCOMP1 CH1,-1 ;CONVERT TO CHARACTER ADDRESS + HRL CH2,BBASE + PUSH F,CH2 ;PUSH BBASE,,CPTR + MOVEI A,1 ;=> EXPAND MACRO + PUSHJ P,PSHLMB ;SAVE LIMBO1 STATUS AND RETURN + JRST PSHM1 + + ;UNDO A PUSHEM + ;RETURNS BBASE,,CPTR IN B (CPTR RE-INITIALIZED, BBASE NOT) + +POPEM: PUSH P,A + PUSH P,F + MOVE F,MACP + PUSHJ P,POPLMB ;RESTORE LIMBO1 STATUS + POP F,B ;BBASE,,CPTR + MOVEI CH1,(B) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE NEW CPTR +PSHM1: MOVEM F,MACP ;STORE BACK MACRO PDL POINTER +POPFAJ: POP P,F +POPAJ: POP P,A + POPJ P, + +PMACP: MOVE B,MACP ;POP MACRO PDL + HRRZ A,(B) + SUB B,[1,,1] +IFN RCHASW,CAIE A,A.TYM8 + CAIN A,AIRR + JRST A.GO6 ;IRP OR .TTYMAC + CAIN A,REPT1 + JRST A.GO4 ;REPEAT + CAIE A,RCHSV1 ;MACRO + CAIN A,RCHSAV ;ARG + JRST A.GO6 + .VALUE ;DON'T HAVE RETURN, + JRST A.GO6 ;BUT TRY A.GO6 LIKE EVERYTHING BUT REPEAT + +A.GO4: HLLZS -1(B) ;REPEAT, CLEAR OUT COUNT REMAINING +A.GO6: TRO FF,FRMRGO ;EVERYTHING ELSE, SET FLAG TO QUIT + JRST (A) + + ;4.9(B) => .STOP ELSE .ISTOP + +A.STOP: HRRZ A,MACP + JUMPL B,A.STP1 + HRRZ B,(A) ;.ISTOP + CAIN B,REPT1 + HLLZS -2(A) ;REPEAT, STOP ALL INTERATIONS + CAIN B,AIRR + HRRZS -1(A) ;IRP TYPE, CLEAR OUT # GROUPS, DON'T ALLOW RECYCLE +A.STP1: MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP + JRST POPJ1 + +A.QOTE: JFCL +ATERMI: ETSM [ASCIZ/Not in macro/] + JRST MACCR ;MAYBE FLUSH MESSAGE IF PEOPLE HAVE PROBLEMS + +;PDL STRUCTURE FOR REPEAT +;TWO TWO WORD ENTRIES +;BBASE,,CPTR +;LIMBO1 STATUS,,# TIMES LEFT +;OLD .RPCNT,,BEG OF BODY +;GARBAGE,,REPT1 + +AREPEAT: PUSHJ P,AGETFD + JUMPLE A,COND5 ;NO REPEAT PLAY LIKE STRING COND FALSE + PUSH P,A + MOVE A,FREEPT + MOVEM A,PRREPT ;CHAR ADR BEGINNING OF REPEAT + MOVEI A,373 ;CHECK CHAR FOR REPEAT + PUSHJ P,PUTREL ;STORE AS FIRST CHR OF BODY + JSP D,RARL1 + CAIA + CALL RARGCP ;READ THE ARG & COPY INTO MACRO STORAGE. + MOVEI A,^M ;IF THE ARG WASN'T BRACKETED, + TLNE FF,FLUNRD + CALL PUTREL ;INCLUDE THE TERMINATING CR. +SWRET1: PUSHJ P,STPWR ;ALSO RETURN FROM STRING WRITE (.F .I) + POP P,B ;# TIMES TO GO THROUGH + PUSHJ P,PUSHEM + MOVE B,MACP ;NOW GET MACRO PDL POINTER FOR PUSH OF SECOND ENTRY + MOVNI T,1 + EXCH T,CRPTCT ;GET OLD .RPCNT, INITIALIZE NEW ONE TO -1 +CREPT1: SETZI TT,REPT1 + EXCH TT,PRREPT ;GET LOC BEGINNING OF BODY, CLEAR OUT PRREPT, DON'T NEED IT ANYMORE + HRL TT,T + PUSH B,TT ;SAVE OLD .RPCNT,,ADDRESS OF BODY. + PUSH B,CREPT1 ;PUSH CRUD,,REPT1 FOR RETURN + MOVEM B,MACP ;STORE BACK UPDATED MACRO POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE IMMEDIATE CYCLE + JRST MACCR + +IFN .I.FSW,[ ;CODING FOR .I, .F + +SWINI: MOVE A,FREEPT ;INITIALIZE, WILL EVENTUALLY PLAY LIKE REPEAT 1 + MOVEM A,PRREPT + MOVEI A,373 + JRST PUTREL + +SWRET: PUSH P,[1] ;REPEAT COUNT + JRST SWRET1 + +SWFLS: MOVE A,PRREPT ;FLUSH RETURN + PUSHJ P,AFCOMP + JRST MACCR +] + +;RECYCLE AROUND REPEAT + +REPT1: PUSH P,A + PUSH P,C + HRRZ A,(B) ;CHAR ADR BEG BODY + PUSHJ P,REDINC + CAIE B,373 + HALT ;FIRST CHAR OF REPEAT BODY NOT 373 + HRRZ C,MACP + HRRZ B,-2(C) ;# TIMES LEFT + SOJL B,REPT2 ;JUMP IF LAST TIME THROUGH WAS LAST TIME TO GO THROUGH + AOS CRPTCT + PUSHJ P,ACPTRS ;SET UP CPTR (CHAR ADR IN A) + HRRM B,-2(C) ;STORE UPDATED COUNTDOWN +REPT3: POP P,C + POP P,A + JRST REPT6 + +REPT2: SOS A ;MOVE BACK TO BEG OF REPEAT + ;(IN CASE GETS STORED INTO FREEPT) + MOVE CH2,CPTR + CCOMP CH2,-1 ;CONVERT TO CHARACTER ADDRESS + CAMN CH2,FREEPT + PUSHJ P,AFCOMP + MOVE A,[-3,,-2] + ADDB A,MACP + HLRZ A,1(A) + MOVEM A,CRPTCT + PUSHJ P,POPEM + JRST REPT3 + +;STRING CONDITIONALS (IFSE, IFSN) + +SCOND: MOVE A,FREEPT + MOVEM A,PRSCND + MOVEM A,PRSCN1 + PUSH P,SYM + HRRI B,SCONDF + PUSH P,B ;REMEMBER TEST INSTRUCTION. + SETOB C,SCONDF + JSP D,RARG ;COPY THE 1ST OF THE 2 STRINGS + CAIA + CALL RARGCP ;INTO MACRO STORAGE, FOLLOWED BY 375. + CALL STPWR + JSP D,RARG ;THEN START READING THE 2ND ARG, + JRST SCOND3 ;GO TO SCOND3 WHEN REACH END OF 2ND ARG. + JSP D,RARGCH(T) ;READ NEXT CHAR OF 2ND ARG, + JRST SCOND3 + EXCH A,PRSCND + PUSHJ P,REDINC ;RE-FETCH NEXT CHAR OF 1ST ARG + EXCH A,PRSCND + CAMN B,A ;COMPARE CHARACTERS + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CAIL A,"A+40 + CAILE A,"Z+40 ;NOT EQUAL => CONVERT BOTH TO UPPER CASE. + CAIA + SUBI A,40 + CAIL B,"A+40 + CAILE B,"Z+40 + CAIA + SUBI B,40 + CAMN B,A ;ARE THEY SAME EXCEPT FOR CASE? + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CLEARM SCONDF ;STRINGS DIFFER + CALL RARFLS ;IGNORE REMAINDER OF 2ND ARG. +SCOND3: CLEARB A,C ;END OF (SECOND) STRING ARG ENCOUNTERED + EXCH C,PRSCN1 + MOVEM C,FREEPT + PUSHJ P,FCOMP + EXCH A,PRSCND + PUSHJ P,REDINC + CAIE B,375 + CLEARM SCONDF + REST B + REST SYM + XCT B ;DO THE TEST. + JRST COND4 + JRST COND2 + +VBLK +BLCODE [DMYDEF: BLOCK DMDEFL] ;TABLE OF DUMMY NAMES FOR THING BEING DEFINED +DMYTOP: DMYDEF ;POINTER INTO DMYDEF, POINTS TO AVAILABLE WORD + ;SINCE ONLY ONE THING CAN BE DEFINED AT ONCE, IT IS NOT NECESSARY TO SAVE AND RESTORE DMYTOP +DMYBOT: DMYDEF ;-> 1ST DMYDEF WD USED AT THIS LEVEL. + ;RIGHT NOW, ALWAYS -> DMYDEF SINCE CAN'T HAVE DEFINITION + ;WITHIN A DEFINITION YET. + +PBLK + +PDEF: PUSHJ P,GSYL ;READ IN SYL + CAIE T,", ;IF DELIMITING CHR NOT , + JUMPE SYM,CPOPJ ;AND SYM NULL, RETURN +PDEF1: MOVEM SYM,@DMYTOP ;STORE SYM + AOS D,DMYTOP ;INCR PNTR + CAIL D,DMYDEF+DMDEFL ;CHECK FOR TABLE SIZE EXCEEDED + ETF [ASCIZ/Too many dummies in DEFINE or IRP/] + POPJ P, + +VBLK +BLCODE [DSTG: BLOCK DSSIZ] ;TABLE OF CHAR ADRS OF DUMMIES BEING DEFINED PRIOR TO MACRO EXPANSION +RDWRDP: DSTG ;POINTER TO DSTG, POINTS TO FREE WORD + ;NOTE THAT RDWRDP MUST BE SAVED AND RESTORED SINCE MORE MACROS CAN + ;BE EXPANDED DURING FIELD READ FOR DUMMY +PBLK + +ADDTR1: CLEARM PUTCNT +ADDTRN: MOVE A,FREEPT +ADDTR2: MOVEM A,@RDWRDP + AOS A,RDWRDP + CAIL A,DSTG+DSSIZ + ETF [ASCIZ/Too many dummies in all macros & IRPs being expanded/] + RET + +VBLK +BLCODE [DMYAGT: BLOCK DMYAGL] ;TABLE OF CHAR ADRS OF DUMMYS OF MACROS BEING EXPANDED + ;DMYAGT TRACKS WITH THE MACRO PDL; + ;DMYAGT CAN'T BE COMBINED WITH DSTG SINCE DMYAGT CAN BE SHIFTING AROUND RANDOMLY DURING ARG SCAN +BBASE: DMYAGT ;POINTER TO BEGINNING OF ACTIVE DUMMY LIST (FOR DEEPEST-NESTED MACRO BEING EXPANDED) + ;ADD TO DUMMY # TO GET LOCATION CONTAINING CHAR ADR OF DUMMY +TOPP: DMYAGT ;POINTER TO TOP OF DMYAGT ACTIVE, POINTS TO FREE REGISTER +PBLK + + ;ACTIVATE DUMMYS ON TOP OF DSTG TABLE + ;A -> FIRST (LOWEST) DUMMY IN DSTG TO ACTIVATE + +DMYTRN: MOVE B,TOPP + MOVEM B,BBASE + PUSH P,A +DMYTR2: CAML A,RDWRDP + JRST DMYTR1 + MOVE B,(A) + MOVEM B,@TOPP + AOS B,TOPP + CAIL B,DMYAGT+DMYAGL + ETF [ASCIZ /Too many dummy args active/] + AOJA A,DMYTR2 +DMYTR1: POP P,RDWRDP + POPJ P, + +;THE MACRO TABLE IS FILLED MAINLY WITH 8-BIT BYTES. +;THE FIRST WORD'S ADDR IS IN MACTAD; THE LAST+1'S IN MACTND. +;THE CHARACTER NUMBER OF THE LAST+1ST CHAR IS IN MACHI. +;MACHIB IS BP. TO HIGHEST BYTE OK TO FILL (LAST IN C(MACTND)-1) + +;IF A BYTE IN THE TABLE HAS ITS HIGH BIT OFF, IT IS AN ASCII CHARACTER. +;OTHERWISE, IT IS SPECIAL. IF THE 100 BIT IS OFF IT MEANS +;SUBSTITUTE A MACRO DUMMY ARG WHEN READ; THE CHAR IS THE NUMBER OF THE ARG+200 . + +;377 AND 375 ARE STOP CODES, CAUSING A POP OUT OF THE CURRENT STRING. +;GC CONSIDERS THE CHAR. AFTER A 375 TO START A NEW STRING. + +;376 IS IGNORED WHEN READ; USED TO CLOBBER UNWANTED CHARACTERS IN STRINHGS. + +;374 STARTS EVERY MACRO-DEFINITION. +;373 STARTS THE BODY OF A REPEAT. + +;370 STARTS A WORD STRING: +;THE WORD AFTER THAT WHICH CONTAINS THE 370 +; HAS THE LENGTH IN WORDS OF THE STRING IN ITS LH, +; IN ITS RH, THE ADDRESS OF WD WHICH POINTS BACK TO THIS ONE. +; THEN FOLLOW RANDOM WDS HOLDING ANYTHING AT ALL. +; GC WILL MAKE SURE IT STAYS ON WD BOUNDARY. +; THE LENGTH INCLUDES THE WD HOLDING THE LENGTH. +; IF THE RH OF 1ST WD HAS 0, GC WILL FLUSH THE STRING + +STRTYP: PUSHJ P,REDINC ;DEBUGGING AID ONLY + EXCH A,B + TRZE A,200 + JRST STRTP1 +STRTP2: PUSHJ P,TYO ;NORMAL CHAR, JUST TYPE OUT + MOVE A,B + JRST STRTYP + +STRTP1: PUSH P,A + MOVEI A,"* ;SPECIAL CHAR, TYPE * + PUSHJ P,TYO + POP P,A + TRNE A,100 + JRST STRTP3 ;CONTROL CHAR + ADDI A,260 ;DUMMY, CONVERT TO # + JRST STRTP2 ;TYPE OUT (SINGLE DIGIT) NUMBER + +STRTP3: CAIN A,175 + SKIPA A,C% ;STOP, TYPE % + MOVEI A,"/ ;SOMETHING ELSE, TYPE / + JRST STRTP2 + + + ;.GSSET, SET GENERATED SYM COUNTER + +A.GSSET: CALL AGETFD + MOVEM A,GENSM + JRST ASSEM1 + +;GSYL-LIKE ROUTINE, READ A SYL FOR WRQOTE + +WRQRR: PUSHJ P,RCH ;GET CHAR (MAYBE WANT THIS TO BE FASTER YET) + IDPB A,FREPTB ;DEPOSIT IN MACRO TABLE + CAMN F,FREPTB ;WAS THIS LAST CHAR IN TABLE? + JRST WRQRGC ;YES, NEED GARBAGE COLLECTION +WRQRR2: XCT GDTAB(A) ;DISPATCH ON CHAR + JFCL ;(MAYBE SKIPS) + SOJGE D,WRQRR ;LOOP FOR FIRST SEVEN CHARS + HRRI D,0 + JRST WRQRR + + ;HERE FROM WRQRR WHEN NEED GARBAGE COLLECTION OF MACRO TABLE + +WRQRGC: MOVEM C,WRQTBP ;PUT POINTER TO BEGINNING OF SYL WHERE IT WILL BE GC'D + MOVE A,MACHI + PUSHJ P,GCA ;GARBAGE COLLECT + MOVE F,MACHIB ;RESET F TO POINT TO NEW LAST CHAR IN MACTAB + MOVEI C,0 + EXCH C,WRQTBP ;GET BACK POINTER TO CHAR BEFORE SYL + MOVE A,LIMBO1 ;RETRIEVE LAST CHAR READ + JRST WRQRR2 ;LOOP BACK, PROCESS CHAR + + ;HERE FROM WRQOTE IF .QUOTE SEEN + ;.QUOTE TAKES ARG LIKE ASCII, PRINTC, ETC. + +A.QOT1: MOVE A,WRQBEG(P) ;GET BACK BP TO CHAR BEFORE .QUOTE + PUSHJ P,A.QOTS ;SET UP FREEPT AND FREPTB PROPERLY + MOVE A,LIMBO1 ;NOW GET CHAR AFTER .QUOTE + CAIE A,^I + CAIN A,40 ;COMPARE WITH SPACE + PUSHJ P,RCH ;SPACE, GOBBLE NEXT CHAR FOR DELIMITER, ELSE THIS ONE + MOVEM A,A.QOT2 ;STORE AS TERMINATOR OF STRING +A.QOT3: PUSHJ P,RCH ;GET CHAR TO QUOTE + CAMN A,A.QOT2 ;TERMINATOR? + JRST WRQOT1 ;TERMINATOR, BACK FOR MORE DEFINITION + PUSHJ P,PUTREL ;DEPOSIT CHAR + JRST A.QOT3 + +;READ IN BODY OF MACRO, IRP, OR WHATEVER + +WRQOTE: PUSH P,[0] ;USED FOR LENGTH OF SYMBOL (REALLY 6 MINUS IT). +WRQLEN==,-2 + PUSH P,[0] ;THIS WD USED FOR DEFINE/TERMIN COUNT. +WRQLVL==,-1 + PUSH P,[0] ;USED TO REMEMBER BEGINNING OF SYMBOL. +WRQBEG==0 + SETOM INICLB ;CLOBBERED INITS, .SYMTAB NOW ILLEGAL. + PUSHJ P,RCH ;MAYBE POP UP A LEVEL IN EXPANSIONS, SAVE MACTAB SPACE + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-INPUT + MOVE F,MACHIB ;POINTER TO LAST CHAR OK TO PUT IN MACTAB, STAYS IN F + TRO I,IRSYL\IRLET ;MAKE SURE FLAGS SET SO WON'T WASTE TIME AT MAKNUM, POINT +WRQOT0: +WRQOT1: MOVEI D,6 ;SQUOZE COUNTER + MOVEI SYM,0 ;INITIALIZE SYM + MOVE C,FREPTB ;GET POINTER TO CHAR BEFORE SYL ABOUT TO READ + PUSHJ P,WRQRR ;READ SYL + JUMPE SYM,.-2 ;LOOP UNTIL NON-NULL + ;NOW SEE IF DUMMY; **NOTE**: C STILL HAS BYTE POINTER, A SYL TERMINATOR + MOVE B,DMYBOT + CAML B,DMYTOP + JRST WRQOT2 ;NOT DUMMY + CAME SYM,(B) ;COMPARE WITH DUMMY NAME + AOJA B,.-3 ;LOOP ON NO MATCH + SUB B,DMYBOT ;DUMMY, CONVERT TO NUMBER + 200 + SUBI B,200 + LDB T,C ;GET LAST CHAR BEFORE SYL + CAIE T,"! ; ^ NOTE THAT THIS CAN LOSE IF MACRO HAS 33. ARGS + IDPB B,C ;NOT EXCLAMATION POINT, LEAVE THERE, DEPOSITING DUMMY CHAR + CAIN T,"! + DPB B,C ;EXCL, WIPE IT OUT + MOVEM C,FREPTB ;RESET FREPTB + CAIE A,"! ;A HAS DUMMY TERMINATOR, COMPARE WITH EXCL + TLO FF,FLUNRD ;NOT EXCLAMATION POINT, CAUSE IT TO BE RE-INPUT + JRST WRQOT1 ;LOOP BACK FOR NEXT SYL + +;SYL ISN'T DUMMY, CHECK FOR PSEUDO +WRQOT2: MOVEM D,WRQLEN(P) ;REMEMBER START OF AND LENGHTH OF THE SYMBOL. + MOVEM C,WRQBEG(P) + SETOM ESBK ;EVAL IN CURRENT BLOCK. + PUSHJ P,ES ;EVALUATE SYM (DOESN'T CLOBBER F) + JRST WRQOT0 ;NOT SEEN + CAIE A,PSUDO/40000 + JRST WRQOT0 ;NOT PSEUDO + TLZ B,-1 ;CLEAR OUT LH OF VALUE, ONLY INTERESTED IN RH + CAIN B,A.QOTE + JRST A.QOT1 ;.QUOTE + CAIE B,ADEFINE + CAIN B,AIRP + AOS WRQLVL(P) ;DEFINE OR IRP +IFN RCHASW,[CAIN B,A.TTYM + AOS WRQLVL(P) ;.TTYMAC +] + CAIE B,ATERMIN + JRST WRQOT0 + SKIPGE WRQLEN(P) + ETR [ASCIZ /TERMIN longer than 6 chars/] + SOSL WRQLVL(P) ;TERMIN, SKIP IF THE TERMINATING ONE + JRST WRQOT0 ;NOT MATCHING TERMIN, BACK FOR NEXT SYL + POP P,A ;GET BACK BP TO LAST CHAR BEFORE TERMIN + SUB P,[2,,2] .SEE WRQLVL,WRQBEG + MOVE T,DMYBOT ;WE'RE NO LONGER USING SPACE IN DMYDEF. + MOVEM T,DMYTOP +A.QOTS: LDB T,A ;HERE ALSO FROM A.QOT1, GET CHAR BEFORE .QUOTE OR TERMIN + CAIE T,"! + JRST A.QTS2 ;NOT EXCLAMATION POINT => OK + DBPM A, ;EXCLAMATION POINT, DECREMENT POINTER +A.QTS2: MOVEM A,FREPTB ;STORE AS NEW FREPTB + CCOMP1 A,-1 ;CONVERT TO CHAR ADR + MOVEM B,FREEPT ;STORE CHAR ADR AS NEW FREEPT + POPJ P, + +;FORMAT OF A MACRO: +;IT STARTS WITH A 374. +;THEN COME ARGUMENT DESCRIPTORS, ONE PER ARGUMENT. +MCF==777650 ;BITS AND FIELDS ARE: +MCFDEF==200 ;ARG IS DEFAULTED. MCFDEF AND MCFGEN NEVER BOTH SET. +MCFGEN==100 ;ARG SHOULD BE GENSYMMED IF NOT GIVEN IN CALL. +MCFKWD==40 ;ARG IS A KEYWORD ARG, SELECTED BY = RATHER THAN POSITION. +MCFSYN==7 ;FIELD THAT SPECIFIES THE ARGUMENT'S SYNTAX. + MCFNRM==1 ;MCFSYN CONTAINS MCFNRM => NORMAL-SYNTAX ARG + MCFLIN==2 ;MCFSYN CONTAINS MCFLIN => WHOLE LINE ARG + MCFBAL==3 ;MCFSYN CONTAINS MCFBAL => BALANCED ARG + MCFSTR==4 ;MCFSYN CONTAINS MCFSTR => ARG IS A DELIMITED STRING, AS IN "ASCIZ". + MCFKST==5 ;MCFSYN CONTAINS MCFKST => JUST LIKE MCFSTR, BUT DELIMITERS ARE RETAINED. + MCFEVL==6 ;MCFSYN CONTAINS MCFEVL => ARG IS BY VALUE (PREEVALUATED). +;IF MCFKWD IS SET, THE DESCRIPTOR IS FOLLOWED BY THE NAME OF THE ARGUMENT, +;TERMINATED BY A 377. +;IF MCFDEF IS SET, THE DESCRIPTOR IS FOLLOWED BY THE DEFAULT VALUE OF THE ARG, +;TERMINATED BY A 377. +;IF MCFKWD AND MCFDEF ARE BOTH SET, THE ARG NAME COMES FIRST. +;A ZERO BYTE ENDS THE DESCRIPTOR LIST. +;THEN COMES THE BODY OF THE MACRO, FOLLOWED BY A 375. + +ADEFINE: NOVAL ;ERROR IF CONTEXT WANTS A VALUE. + PUSH P,CASSM1 ;RETURN TO ASSEM1 EVENTUALLY + JSP TM,ERMARK ;ERR MSGS SHOULD SAY WE'RE INSIDE A DEFINE. + PUSH P,SYM ;THESE 2 PUSHES ARE FOR NONAME'S SAKE. + PUSH P,SYM + CALL GETSLD + CALL NONAME + TLZ FF,FLUNRD + SUB P,[2,,2] + PUSH P,SYM + PUSH P,ESBK ;SAVE BLOCK TO DEFINE IN FOR ES'S SAKE. +IFN CREFSW,XCT CRFMCD + CALL A.TYM1 + POP P,ESBK + REST SYM + PUSHJ P,ESDEF ;FIND SLOT IN SYMBOL TABLE FOR IT + TLO C,3MACOK ;NEVER SEEN, OK TO MAKE MACRO. + TLON C,3MACOK ;ELSE ERROR IF NUMERIC OR ALREADY USED. + ETSM [ASCIZ/Non-macro made macro/] + MOVEI B,MACCL ;RH(VALUE) = MACCL + HRL B,PRDEF ;LH(VALUE) = CHAR ADR OF MACRO + CLEARM PRDEF ;NO LONGER NEED PRDEF + MOVSI T,PSUDO ;SYMBOL TABLE ENTRY LOOKS LIKE PSEUDO + JRST VSM2 + +IFN RCHASW,[ + ;.TTYMAC NAME + ;BODY + ;TERMIN + + ;NAME DUMMY, CAUSES READIN OF CRUD FROM TTY -> CR (NOT INCLUSIVE) + +A.TTYM: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WE'RE INSIDE A .TTYMAC + CALL A.TYM1 ;READ IN A MACRO-DEFINITION. + MOVEI A,40 ;DON'T LET THE CHAR ENDING THE TERMIN + MOVEM A,LIMBO1 ;MAKE MACCL THINK THERE ARE NO ARGS. + CALL GTYIP1 ;PUSH INTO TTY FOR INPUT + HRLZ B,PRDEF ;PHONY UP A MACRO WHOSE DEFN IS WHAT WE READ. + SETZM PRDEF + MOVEI A,A.TYM8 + JRST A.TYM2 ;CALL THE MACRO: + ;READ THE ARGS, POP OUT OF TTY, EXPAND THE MACRO + ;AND THEN EXIT TO A.TYM8 +] + +A.TYM1: MOVE A,FREEPT + MOVEM A,PRDEF + MOVEI LINK,MCFNRM ;INITIALLY, DUMMIES ARE NORMAL. + MOVEI A,374 + PUSHJ P,PUTREL ;MARK BEGINNING OF MACRO +DEFNI: MOVE T,LIMBO1 + MOVE A,LINK +DEFNC: CAIE T,12 + CAIN T,15 + JRST DEFNA ;NO MORE ARGS (DONE WITH LINE) + CAIE T,LBRACE + CAIN T,LBRKT + JRST DEFNB1 + CAIE T,RBRACE + CAIN T,RBRKT + JRST DEFNB2 + CAIE T,"< ;OPENS TURN ON BALANCEDNESS. + CAIN T,"( + JRST DEFNB1 + CAIE T,"> ;CLOSES TURN OFF BALANCEDNESS. + CAIN T,") + JRST DEFNB2 + CAIN T,"? ;? TURNS BALANCEDNESS ON OR OFF. + JRST DEFBAL + CAIN T,"+ ;+ COMPLEMENTS KEYWORDNESS + XORI LINK,MCFKWD + CAIN T,"\ ;\ COMPLEMENTS GENSYMMEDNESS + XORI LINK,MCFGEN + CAIN T,"- ;- TURNS WHOLELINENESS ON OR OFF. + JRST DEFWHL + CAIN T,"* ;* TURNS ASCIZ-STYLE-NESS ON OR OFF. + JRST DEFASC + CAIN T,"& ;& TURNS KEEP-STRUNGNESS ON OR OFF. + JRST DEFKST + CAIN T,"# ;# TURNS EVALUATEDNESS ON OR OFF. + JRST DEFEVL + CAIN T,": ;: MAKES FOLLOWING ARGS NORMAL + MOVEI LINK,MCFNRM ;IN ALL RESPECTS + CAIN T,"; + JRST DEFNSM ;ALLOW DEFINE LINE TO BE COMMENTED +DEFND: PUSH P,A + CALL GSYL ;READ IN SYMBOL AS SQUOZE IN SYM. + REST A + CAIN T,"/ ;/ MEANS PREVIOUS ARG IS WHOLE-LINE. + XORI LINK,MCFLIN#MCFNRM + JUMPE SYM,DEFNC ;JUMP IF SYMBOL NAME WAS NULL. + CALL PDEF1 ;ELSE PUSH IT ON LIST OF DUMMIES. + MOVE A,LINK + CAIE T,"= + JRST DEFNL + IORI A,MCFDEF ;ONE ARG, WITH DEFAULT VALUE. + ANDCMI A,MCFGEN ;NOT TO BE GENSYMMED. +DEFNL: CALL PUTREL ;OUTPUT A DESCRIPTOR FOR THIS ARG + TRNE LINK,MCFKWD + CALL DEFNM ;PUT OUT ARG NAME IF KWD ARG + CAIE T,"= ;THEN DEFAULT VALUE IF DEFAULTED. + JRST DEFNI + JSP D,RARG ;INIT. FOR READING THE DEFAULT VALUE. + CAIA + CALL RARGCP ;COPY THE ARG INTO MACRO SPACE, + CALL PUT377 ;TERMINATED BY A 377. + JRST DEFNI ;NOW FOR THE NEXT ARG. + +DEFNM: MOVE D,[440700,,STRSTO] +DEFNM1: ILDB A,D + CAMN D,STRPNT + JRST PUT377 + CALL PUTREL + JRST DEFNM1 + +DEFEVL: SKIPA A,[MCFEVL] ;TURN EVALUATEDNESS ON OR OFF. +DEFASC: MOVEI A,MCFSTR ;TURN ASCIINESS ON OR OFF. + JRST DEFN9 +DEFKST: MOVEI A,MCFKST ;TURN KEEP-STRUNGNESS ON OR OFF. + JRST DEFN9 +DEFBAL: SKIPA A,[MCFBAL] ;TURN ON BALANCEDNESS, BUT IF ALREADY ON TURN OFF. +DEFWHL: MOVEI A,MCFLIN ;SIMILAR FOR WHOLELINENESS. +DEFN9: LDB B,[.BP MCFSYN,LINK] + CAMN A,B ;IF CURRENT STATE IS SAME AS IN A, + MOVEI A,MCFNRM ;SWITCH TO NORMAL MODE INSTEAD. + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNB2: SKIPA A,[MCFNRM] ;TURN OFF BALANCEDNESS +DEFNB1: MOVEI A,MCFBAL ;TURN ON BALANCEDNESS + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNSM: PUSHJ P,RCH ;SEMICOLON IN DEFINE LINE + CAIE A,15 + CAIN A,12 +DEFNA: SKIPA A,LINK ;END OF DEFINE LINE, GET COUNT + JRST DEFNSM + MOVEI A,0 + PUSHJ P,PUTREL ;DEPOSIT END-OF-DESCRIPTORS MARK + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD ;CHAR AFTER CR NOT LF + PUSHJ P,WRQOTE ;READ IN BODY + JRST STPWR + +;COME HERE TO EXPAND MACRO; LH OF B POINTS TO STRING. +;SYM HOLDS NAME OF MACRO (USED BY CALL TO AGETFD IN MACEVL). +MACCL: JSP TM,ERMARK ;ERROR MESSAGE DURING ARG SCAN SHOULD SAY WE'RE IN IT. + MOVEI A,RCHSV1 +A.TYM2: PUSH P,I + AOS PRCALP + AOS MDEPTH + PUSH P,RDWRDP + PUSH P,A ;RCHSV1 FOR MACRO, A.TYM8 FOR .TTYMA + MOVEI LINK,0 + HLRZ A,B + PUSHJ P,REDINC + CAIE B,374 + HALT + MOVEM A,@PRCALP + PUSHJ P,REDINC + TLZ I,ILPRN + JUMPE B,MACCLE ;MACRO TAKES NO ARGS => UN-READ NEXT CHARACTER. + MOVE A,LIMBO1 + CAIE A,") ;MACRO NAME TERMINATED WITH A CLOSE-BRACKET OF SOME SORT + CAIN A,"> ;=> UN-READ THE FOLLOWING CHARACTER. + JRST MACCLE + CAIN A,RBRKT + JRST MACCLE + CAIE A,15 ;MACRO NAME ENDED BY A CR OR LF => + CAIN A,12 + JRST MACCLD ;NO ARGS IN THIS CALL; NULLIFY ALL ARGS. + CAIE A,"< + CAIN A,"( + TLO I,ILPRN ;BUT MAYBE THERE IS A (. IF SO, IT'S A PAREN'D CALL, + CAIN A,LBRKT ;AND WON'T END TILL THE MATCHING CLOSE. + TLO I,ILPRN + CAIE A,40 ;IF THE CHAR ENDING THE MACRO NAME ISN'T AN OPENPAREN, + CAIN A,^I ;EOL, OR SPACE, RE-READ IT AS PART OF 1ST MACRO ARG. + JRST MACNX0 + TLNN I,ILPRN + TLO FF,FLUNRD +MACNX0: TDZ LINK,LINK +MACNXD: CALL MACDES ;FETCH NEXT DESCRIPTOR + JRST MACPUS ;NO MORE => THIS IS END OF THE CALL + TRNE LINK,MCFKWD + JRST MACK ;KEYWORD PARAM => SPECIAL SCANNER +;READ IN THE VALUE OF THE NEXT ARG, WHICH IS NORMAL (NOT KEYWORD) +MACNRM: CALL ADDTRN ;PUSH WORD TO HOLD VALUE OF ARG ONTO DSTG, + ;INITIALIZED -> FREEPT, WHERE WE WILL NOW WRITE THE ARG. + SOS C,A ;TELL MACRED WHERE THAT WORD IS. + CALL MACRED ;READ IN THE ARGUMENT VALUE. + JRST MACNXD ;THEN HANDLE ANOTHER ARG + .VALUE + JRST MACCLD ;END OF ARG LIST => NULLIFY REMAINING ARGS. + +MACCLE: TLO FF,FLUNRD ;SAVE CHR FOLLOWING MACRO W/NO ARGUMENTS + ;AND IF THAT CHAR WAS A CLOSE-BRACKET, + SKIPE B,ASMOUT ;CLEAR OUT THE CHANGE IT MADE TO ASMDSP. + CAIN B,4 + CAIA + JSP LINK,SAVAS2 + SETZ LINK, + JRST MACCLD ;NOW GO NULLIFY ANY ARGS THE MACRO WANTED, AND EXIT. + +;READ IN THE NEXT MACRO ARGUMENT ACC TO SYNTAX FLAGS IN LINK. +;C HAS ADDRESS OF WORD ON THE RDWRDP STACK WHICH HOLDS THE POINTER TO THIS ARG +;IN CASE WE WISH TO SET THE ARG TO THE NULL STRING. B AND LINK NOT CLOBBERED. +;RETURNS SKIPPING TWICE IF NO ARG BECAUSE END OF MACRO CALL SEEN. +MACRED: MOVEI D,MACNXR ;RARL3, RARB, RARGBR RETURN TO MACNXR + CALL RCH + CAIE A,^M + CAIN A,^J + JRST MACEND ;MAYBE WE HAVE REACHED THE END OF THE MACRO CALL. + LDB B,[.BP MCFSYN,LINK] + CAIN B,MCFLIN + JRST RARL3 ;ELSE, IF WHOLELINE ARG, NOTHING ELSE TO CHECK, + ;SO INIT FOR READING IT IN. + CAIN A,", + JRST MACNUL ;NON-WHOLELINE ARG IS NULL IF NEXT CHAR IS COMMA + CAIN A,"; ;SEMICOLON ENDS ARG LIST UNLESS INSIDE WHOLELINE ARG + JRST MACEND + CAIN B,MCFBAL + JRST RARB ;FOR BALANCED ARG, NOTHING ELSE SPECIAL, SO INIT. + CAIE B,MCFSTR ;FOR BOTH FLAVORS OF STRUNGNESS, + CAIN B,MCFKST ;GO GOBBLE AN ASCIZ-STYLE ARGUMENT. + JRST MACSTR + CAIN B,MCFEVL ;FOR EVALUATED ARG, READ FIELD AND EXPRESS AS NUMERAL. + TLOA FF,FLUNRD ;AND THE CHAR WE JUST READ WAS THE 1ST CHAR OF THE FIELD. + CAIN A,"\ ;NORMAL ARG STARTING WITH "\" TREATED THE SAME WAY, BUT FIELD + JRST MACEVL ;STARTS WITH NEXT CHAR. + CAIN A,LBRKT + JRST RARGBR ;FOR ORDINARY ARG, OPEN-BRACKET MAKES IT SPECIAL +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + MOVEI T,RARGN ;OTHERWISE IT'S A NORMAL ARG + TLOA FF,FLUNRD ;AND THE CHAR WE RCH'ED IS THE 1ST CHAR OF IT +MACNXR: JRST MACEN1 ;NON-SKIP RETURN FROM RARB, RARL3 OR RARGBR => ARG NULL + CALL RARGCP ;ARG NON-NULL => COPY IT INTO STRING SPACE + CAIE A,"; +CSTPWR: JRST STPWR ;AND TERMINATE IT +MACSC: MOVE A,(C) ;EXCEPT THAT SEMICOLONS INVALIDATE ALL THE SPACES + CAME A,FREEPT ;AND TABS THAT PRECEDE THEM. + JRST STPWR ;IF, AS A RESULT OF THAT, THE ARG IS NULL, END THE ARGLIST. +;COME HERE WHEN THE END OF THE MACRO'S WHOLE ARGLIST IS SEEN. +MACEND: TLO FF,FLUNRD +MACEN1: AOS (P) ;2-SKIP RETURN FROM MACRED INDICATES END OF ARGLIST + AOS (P) ;END OF ARGLIST => THIS ARG IS NULL. +;COME HERE TO NULLIFY CURRENT ARG (WHERE C POINTS) +MACNUL: TRZE LINK,MCFDEF + JRST MACDEF ;MAYBE DEFAULT IT + TRNE LINK,MCFGEN + JRST MACGEN ;MAYBE GENSYM IT + SETZM (C) ;ELSE SET TO NULL STRING. + RET + +MACST1: CALL RCH + CAIN A,", + JRST MACNUL +MACSTR: CAIE A,40 ;HERE FOR ARG DELIMITED LIKE TEXT STRINGS: /TEXT/. + CAIN A,^I ;SKIP ALL SPACES AND TABS BEFORE THE ARG. + JRST MACST1 + JSP D,RARB ;FIND END OF LINE, COMMENT, OR CLOSEBRACKET => + JRST MACEND ;NULLIFY ARG AND END MACRO CALL. + MOVEI T,(A) ;ELSE SAVE THIS CHAR; IT'S THE DELIMITER. + TLZ FF,FLUNRD ;DON'T RE-READ DELIMITER, + CAIN B,MCFKST ;BUT IF ARG IS KEEP-STRUNG, DROP THRU TO STORE IT. +MACST2: CALL PUTREL + CALL RCH ;READ ANOTHER CHARACTER. IF IT ISN'T THE DELIMITER, + CAIE A,(T) + JRST MACST2 ;STORE IT AND READ ANOTHER. + CAIN B,MCFKST ;HIT DELIMITER, DONE. BUT IF ARG IS KEEP-STRUNG, + CALL PUTREL ;KEEP DELIMITER BY STORING IT TOO. + CALL STPWR +MACST3: CALL RCH ;PASS BY SPACES AFTER THE CLOSING DELIMITER + CAIE A,40 + CAIN A,^I + JRST MACST3 + CAIE A,", ;COMMA HERE ENDS THE ARG BUT NOT THE MACRO CALL. + JSP D,RARB ;ELSE CHECK FOR OTHER TERMINATORS. + RET ;WE FOUND AN ACCEPTABLE ARG TERMINATOR. + ETR [ASCIZ /Garbage in ASCIZ-style macro arg/] + JRST RARFLS ;IF THERE'S ANYTHING ELSE, COMPLAIN AND SKIP IT. + +;COME HERE TO GIVE AN ARG ITS DEFAULT VALUE. +;MCFDEF WAS CLEARED SO MACDES WILL KNOW THE DEFAULT VALUE HAS +;ALREADY BEEN PASSED OVER AND WON'T TRY TO SKIP OVER IT. +;IF MCFKWD IS SET, WE MUST SKIP OVER THE KWD ARG'S NAME FIRST. +MACDEF: TRZN LINK,MCFKWD + JRST MACDF1 + MOVE A,@PRCALP +MACDF0: CALL REDINC ;SKIP ARG NAME IF KEYWORD ARG. + CAIE B,377 + JRST MACDF0 + MOVEM A,@PRCALP +MACDF1: MOVE A,@PRCALP ;COPY THE DEFAULT VALUE AS THE ARGUMENT VALUE. + CALL REDINC ;AS THE ARGUMENT STRING. + MOVEM A,@PRCALP + CAIN B,377 + JRST STPWR ;END OF THE DEFAULT VALUE. + EXCH A,B + CALL PUTREL + EXCH A,B + JRST MACDF1 + +;COME HERE IF GENSYMMABLE ARG IS SPEC'D AS NULL. +MACGEN: MOVEI A,5 + MOVEM A,SCKSUM + MOVEI A,"G + PUSHJ P,PUTREL + PUSH P,CSTPWR + AOS A,GENSM + IDIVI A,10 + HRLM B,(P) + SOSLE SCKSUM + PUSHJ P,.-3 + JRST MACEV2 + +;PROCESS ARG THAT STARTS WITH \, OR #-TYPE ARG. +MACEVL: CALL RCH ;FIRST, CHECK FOR IMMEDIATE END OF MACRO CALL. + JSP D,RARB + JRST MACEN1 + PUSH P,C + PUSH P,LINK ;SAVE LINK, NEED FLAGS + PUSHJ P,AGETFD ;GET THE FIELD + SKIPE B + ETR [ASCIZ /Relocatable \'d macro arg/] + POP P,LINK + REST C ;IF AGETFD EXPANDED A MACRO, FREEPT HAS CHANGED, SO + MOVE CH1,FREEPT ;PUT NEW VALUE INTO THE POINTER TO THIS DUMMY. + MOVEM CH1,(C) + MOVE CH1,A ;SAVE VALUE OF FIELD FROM CLOBBERAGE + PUSH P,CSTPWR +MACEV1: LSHC CH1,-35. ;NOW "TYPE OUT" VALUE OF FIELD IN CURRENT RADIX + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,MACEV1 +MACEV2: HLRZ A,(P) + ADDI A,60 + JRST PUTREL ;OUTPUT TO MACTAB STRING BEING DEFINED + +;HANDLE KEYWORD PARAMETERS. COME HERE WHEN A DESCRIPTOR IS SEEN +;THAT SPECIFIES A KEYWORD PARAMETER. +MACK: PUSH P,RDWRDP + MOVE A,@PRCALP ;PUSH A COPY OF POINTER TO 1ST KWD ARG'S DESCRIPTOR + AOS PRCALP ;SO WE CAN ADVANCE THE COPY WHILE KEEPING ORIGINAL FIXED. + MOVEM A,@PRCALP + PUSH P,LINK +;FIRST, PUSH A "NOT SET" MARKER FOR EACH OF THE KEYWORD PARAMS IN THIS RUN OF SUCH. +MACK2: SETO A, + CALL ADDTR2 + CALL MACDES ;NOTE THAT THERE IS ONLY ONE PARAM PER DESCRIPTOR + JRST MACK1 ;FOR KEYWORD PARAMS, SO NO NEED TO COUNT DOWN. + TRNE LINK,MCFKWD + JRST MACK2 +MACK1: MOVE LINK,(P) ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM. + MOVE B,PRCALP + MOVE B,-1(B) + MOVEM B,@PRCALP +MACKLP: CALL GPASST ;NOW SEE IF THERE'S AN ARGUMENT TO BE FOUND + CAIE A,^M ;IF SO, IT SHOULD START WITH A KEYWORD. + CAIN A,^J + JRST MACKND ;CR OR LF => NO KEYWORD, AND END SCAN. + CAIN A,"; + JRST MACKND + CAIN A,", + JRST MACKN1 ;NULL ARG => NO KEYWORD, BUT DON'T END SCAN. + CAIE A,") + CAIN A,"> + JRST MACKND ;DETECT END OF PARENTHESIZED CALLS, ETC. + CAIE A,RBRKT + CAIN A,RBRACE + JRST MACKND + TLO FF,FLUNRD + CALL GSYL ;THERE SHOULD BE ANOTHER ARG, SO TRY READING KEYWORD NAME + CALL PASSPS + MOVE C,-1(P) ;NOW SCAN THROUGH THIS RUN OF KEYWORD PARAMS FOR THE ONE + CAIE A,"= ;WHOSE NAME MATCHES WHAT GSYL READ. + JRST MACKL5 ;NOT FOLLOWED BY "="?? + DPB A,STRPNT +MACKL4: MOVE D,[440700,,STRSTO] + MOVE A,@PRCALP +MACKL1: CALL REDINC + ILDB AA,D + CAIN B,377 ;IF REACHED END OF KEYWORD'S NAME, AND EQUAL SO FAR + JRST MACKL2 ;SEE IF ARG'S NAME ALSO OVER. + CAMN B,AA + JRST MACKL1 ;ELSE KEEP COMPARING IF NAMES STILL SAME SO FAR. +MACKL6: MOVEM A,@PRCALP + CALL MACDES ;THIS KEYWORD DOESN'T MATCH SO FIND THE NEXT + JRST MACKL3 ;THERE ARE NO MORE; LOSE - ARG WITH BAD KEYWORD. + TRNN LINK,MCFKWD + JRST MACKL3 + AOJA C,MACKL4 + +MACKL5: ETR [ASCIZ /Bad format keyword argument/] + TLOA FF,FLUNRD ;INCLUDE THE BAD NON-"=" AS PART OF WHAT WE DISCARD +MACKL3: ETR [ASCIZ /Arg with undefined keyword/] + MOVEI T,RARGN + CALL RARFLS ;SKIP AN ORDINARY-SYNTAX MACRO ARG TO TRY TO RECOVER. + JRST MACK1 + +;COME HERE AFTER FINDING THE PARAM THAT MATCHES THIS ARG. +;C POINTS TO THE WORD IN DSTG FOR THAT ARG (DSTG IS WHAT ADDTRN PUSHES IN) +MACKL2: TRZ LINK,MCFKWD ;(IN CASE WE GO TO MACKL6, SINCE KWD NAME SKIPPED ALREADY) + CAIE AA,"= + JRST MACKL6 ;KWD NAME OVER BUT SPEC'D NAME NOT => MISMATCH + MOVEMM (C),FREEPT + CALL MACRED ;READ IN THE VALUE OF THE ARG, THUS SETTING THIS PARAM. + JRST MACK1 ;THERE ARE MORE ARGS => HANDLE THEM + .VALUE +MACKND: TLO FF,FLUNRD ;MACRO CALL TERMINATOR SEEN. +;NULL ARG SEEN; ENDS THIS RUN OF KEYWORD ARGS BUT NOT THE CALL. +MACKN1: REST LINK ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM. + SOS PRCALP + REST C ;GET PTR TO 1ST KWD ARG'S VALUE-WORD +MACKN2: MOVE A,(C) + AOJN A,MACKN4 ;IF THIS ARG WASN'T SPECIFIED, + MOVEMM (C),FREEPT + CALL MACNUL ;NULLIFY IT (MAYBE DEFAULT OR GENSYM) +MACKN4: CALL MACDES ;NOW SKIP OVER THE DESCRIPTORS OF THIS RUN OF KEYWORD PARAMS + JRST MACPUS ;EXHAUSTED ALL THE DESCR'S => END OF MACRO CALL. + TRNE LINK,MCFKWD ;SAME IF REACH A NON-KWD ARG. + AOJA C,MACKN2 + TLNN FF,FLUNRD ;REACHED A NON-KEYWORD PARAM: IF TERMINATOR WAS A NULL ARG, + JRST MACNRM ;GO ON TO READ THE VALUE OF THE NON-KEYWORD PARAM. + JRST MACCLS ;ELSE CALL WAS REALLY ENDED, SO NULLIFY REMAINING ARGS. + +;COME HERE TO FIND THE NEXT DESCRIPTOR. +;SKIPS OVER THE NAME AND DEFAULT VALUE OF THE PREVIOUS DESCRIPTOR, IF ANY. +;THE CONTENTS OF LINKK SAY WHETHER THEY EXIST TO BE SKIPPED OVER. +MACDES: MOVE A,@PRCALP + CALL REDINC ;READ NEXT CHAR OF MACRO + MOVEM A,@PRCALP + TRNE LINK,MCFKWD\MCFDEF + JRST [ CAIE B,377 ;IF THERE'S NAME OR DEFAULT TO SKIP, GO PAST TERMINATOR + JRST MACDES + TRZN LINK,MCFKWD ;AND SAY WE FOUND ONE + TRZ LINK,MCFDEF ;NOTE THERE MAY BE ANOTHER, IN WHICH CASE WE WILL + JRST MACDES] ;SKIP TILL ANOTHER 377 + JUMPE B,CPOPJ ;THIS DESC IS TERMINATOR => RETURN NO SKIP. + MOVEI LINK,(B) ;ELSE PUT FLAGS IN LINK. + JRST POPJ1 + +;COME HERE WHEN A MACRO CALL TERMINATOR IS ENCOUNTERED, TO NULLIFY ALL +;THE REMAINING PARAMS THAT THE MACRO WANTS, THEN ENTER THE MACRO. +;ENTER AT MACCLS IF HAVE JUST READ A DESCRIPTOR AND NOT NULLIFIED THE ARG, +;OR AT MACCLD IF HAVE JUST PROCESSED AN ARG, TO READ THE NEXT DESCRIPTOR. +MACCLS: TRNE LINK,MCFDEF\MCFGEN + JRST MACCL2 + SETZ A, ;NULLIFY NON-GENSYMMED, NON-DEFAULTED ARGS QUICKLY + CALL ADDTR2 +MACCLD: CALL MACDES ;THEN READ THE NEXT DESCRIPTOR. + JRST MACPUS ;IF NO MORE ARGS, ENTER THE MACRO. + JRST MACCLS + +MACCL2: CALL ADDTRN ;FOR GENSYMMED OR DEFAULTED ARG, PUSH PTR TO FREE STG + SOS C,A + CALL MACNUL ;THEN WRITE THE DESIRED VALUE THERE + JRST MACCLD ;THEN HANDLE NEXT DESCRIPTOR. + +;COME TO MACPUS WHEN ALL THE PARAMS HAVE HAD VALUES PUT IN DSTG (USING ADDTRN) +;TO ENTER THE MACRO. +MACPUS: TLZE I,ILPRN ;SPECIAL PARENTHESIZED CALL? + CALL MACPRN ;YES, SKIP PAST THE CLOSING PAREN. + MOVE B,(P) ;IS THIS A .TTYMAC? + CAIN B,A.TYM8 + CALL A.INEO ;YES, POP OUT OF TTY AFTER READING ARGS. + JFCL + REST B ;RCHSV1 OR A.TYM8 + PUSHJ P,PUSHEM + MOVE A,@PRCALP + PUSHJ P,ACPTRS ;SET UP CPTR + POP P,A + PUSHJ P,DMYTRN + SOS PRCALP + REST I +MACCR: AOS (P) ;COMMON RETURN FROM PSEUDOS TO RETURN FROM GETVAL WITHOUT VALUE +CMACCR: POPJ P,MACCR + +MACPRN: MOVEI TT,1 ;START PAREN-DEPTH AT 1 + JSP D,RARBC ;AND READ CHARS, UPDATING THE DEPTH, UNTIL + HALT + JUMPN TT,.-2 ;THE DEPTH GETS TO BE 0. + RET + +A.GOMC: ILDB B,A ;.GO ROUTINE TO SKIP PAST DESCRIPTORS + JUMPN B,A.GOMC ;IN HEADER OF MACRO DEFINITION. + JRST A.GORT + +RCHSV1: SOS MDEPTH ;END OF MACRO EXPANSION, DECREMENT DEPTH IN MACRO EXPANSIONS +A.TYM8: PUSH P,A ;ENTRY FROM .TTYMAC END OF EXPANSION + MOVE B,TOPP +RCHSV3: CAMG B,BBASE + JRST RCHSV2 + HLRZ A,-1(B) + ADD A,-1(B) + MOVEI A,1(A) + CAME A,FREEPT + JRST RCHSV2 + HRRZ A,-1(B) ;GET NEW FREEPT + SOJA B,RCHSV3 + +RCHSV2: POP P,A + ;RETURN ROUTINE FOR END OF DUMMY +RCHSAV: MOVE B,BBASE + MOVEM B,TOPP + PUSHJ P,POPEM + HLRM B,BBASE +REPT6: TRZE FF,FRMRGO + POPJ P, ;RETURN TO .GO + JRST RCHTRB + +;IRP, IRPS, IRPC, IRPW, IRPNC ALL CALL HERE. +;ALL USE 2 FRAMES ON THE MACRO PDL: +; ,, +; ,, +; \<# GROUPS>,, +; ,,AIRR +;THE 3RD WORD HAS IN BITS 4.1-4.3 THE IRP TYPE CODE +; (NIRPO, NIRPC, ETC) +;AND IN THE REST OF THE LH, THE NUMBER OF GROUPS +; (TRIPLES OF TWO DUMMIES AND A LIST) + +.SEE NIRPO ;FOR DEFINITIONS OF IRP TYPE CODES. + +AIRP: JSP TM,ERMARK ;ERROR MESSAGES SHOULD SAY WE'RE INSIDE IT. + PUSH P,I + PUSH P,RDWRDP + HLRZ LINK,B ;GET IRP TYPE CODE TO INDEX BY. + CAIE LINK,NIRPN + JRST AIRP0 + CALL AGETFD ;IRPNC, READ THE 3 NUMERIC ARGS. + PUSH P,A + CALL AGETFD + PUSH P,A + CALL AGETFD + MOVEM A,AIRPN2 ;THE LAST ARG, + REST AIRPN1 ;THE MIDDLE, + REST AIRPN0 ;THE FIRST. + MOVEI LINK,NIRPN +AIRP0: SETZM IRPCR ;NO GROUPS SEEN YET. + +;FALLS THROUGH. + +;FALLS THROUGH. + +;TRY TO READ IN ANOTHER GROUP. +AIRP1: CALL PDEF ;READ IN DUMMY NAME, PUSH ON DMYTOP. + CAIE T,", ;TERMINATOR WASN'T COMMA AND NAME WAS NULL + JUMPE SYM,AIRP2 ;=> NO MORE GROUPS. + CALL PDEF ;NONNULL GROUP, READ & PUSH 2ND NAME. + CAIN T,"[ ;] TRY TO DETECT "IRP X,[", ETC. ] + CALL [ETR [ASCIZ/Comma missing in IRP/] + TLO FF,FLUNRD ;GENERATE A COMMA. + RET] + CALL ADDTRN ;PUSH CHAR ADDR OF 1ST DUMMY, + CAIE LINK,NIRPS + CAIN LINK,NIRPC ;LEAVE SPACE FOR IRPC'S 1ST ARG, IRPS'S 2ND. + CALL PUT377 + MOVE A,RDWRDP + CAIN LINK,NIRPS + AOS -1(A) ;IRPS - 1ST ARG GOES AFTER NEXT 377. + CALL ADDTRN ;PUSH CHAR ADDR OF 2ND DUMMY. + CALL PUT377 + MOVE A,RDWRDP + XCT AIRP1T-1(LINK) ;MAYBE INCREMENT THAT ADDR. + AOS IRPCR ;ONE MORE GROUP SEEN. + JSP D,RARG ;INITIALIZE READING LIST. + JRST AIRP3 ;NO LIST. + JRST @.(LINK) + OFFSET 1-. +NIRPO:: AIRPO ;IRP +NIRPC:: AIRPC ;IRPC +NIRPS:: AIRPS ;IRPS +NIRPW:: AIRPW ;IRPW +NIRPN:: AIRPN ;IRPNC + OFFSET 0 + +AIRP1T: AOS -1(A) + AOS -1(A) ;INCR. THE 2ND DUMMY ADDR FOR IRP, IRPC. + SOS -1(A) + JFCL ;DECR. FOR IRPS, NOTHING FOR IRPW. + AOS -1(A) ;INCR. FOR IRPNC. + +;READ LIST FOR IRPC OR IRP AND STUFF INTO STRING. +AIRPC: +AIRPO: CALL RARGCP ;COPY UP TO END OF ARG INTO MACRO SPACE. + JRST AIRP3 + +AIRPW3: CALL PUT377 ;END A LINE, + CAIGE C, + CALL PUT377 ;IF NO ; YET, MAKE NULL 2ND ARG. +;COME HERE FOR IRPW, LOOP BACK FOR NEXT LINE. +AIRPW: SETO C, ;NO ; SEEN YET IN LINE. +AIRPW1: JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST, GO WRITE 375. + CAIE A,^M + CAIN A,^J + JRST AIRPW1 ;IGNORE NULL LINES. +AIRPW4: CAIN A,"; + AOJE C,AIRPW2 ;ON 1ST SEMI, SWITCH TO 2ND ARG. + CAIE A,^J + CAIN A,^M + JRST AIRPW3 ;END OF LINE => END BOTH ARGS, START OVER. +AIRPW5: CALL PUTREL + JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST. + JRST AIRPW4 + +AIRPW2: MOVEI A,377 + JRST AIRPW5 + +AIRPS: SETO C, ;NO SQUOZE CHAR SEEN YET. +AIRPS2: JSP D,RARGCH(T) + JRST AIRP3 + HLRZ CH1,GDTAB(A) + CAIN CH1,(RET) + CAIN A,"! + AOJA C,AIRPS0 ;A SQUOZE CHAR OR !. + JUMPL C,AIRPS2 ;NON SQUOZE FOLLOWING ANOTHER, FLUSH. + DPB A,AIRPSP ;NONSQUOZE ENDING NONNULL SYL, PUT BEFORE SYL. + SETZM AIRPSP + CALL PUT377 ;FOLLOW SYL WITH 377. + JRST AIRPS + +AIRPS0: JUMPN C,AIRPS3 ;NOT 1ST CHAR IN SYL? + PUSH P,A + CALL PUT377 ;1ST, LEAVE A SPACE FOR THE SYL'S TERMINATOR. + MOVE A,FREPTB + MOVEM A,AIRPSP ;REMEMBER WHERE THE SPACE IS. + REST A +AIRPS3: CALL PUTREL + JRST AIRPS2 + +AIRPN: SKIPG C,AIRPN0 ;ANY CHARS TO IGNORE? + JRST AIRPN4 + JSP D,RARGCH(T) + JRST AIRP3 + SOJG C,.-2 +AIRPN4: SKIPN C,AIRPN2 ;GET MAX # GRPS OF CHARS. + JRST AIRPN7 ;0 => IGNORE THE REST. +AIRPN5: MOVE B,AIRPN1 ;DO NEXT GRP, GET # CHARS/GRP. +AIRPN6: JSP D,RARGCH(T) + JRST AIRP3 + CALL PUTREL ;STORE THE NEXT CHAR. + SOJG B,RARGCH(T) ;COUNT CHARS IN GRP. + MOVEI A,376 + CALL PUTREL ;FOLLOW GRP BY 376. + SOJN C,AIRPN5 ;MAYBE CAN DO MORE GRPS. +AIRPN7: CALL RARFLS ;DID AS MANY GRPS AS CAN DO, + ;IGNORE REMAINDER OF LIST. + +;COME HERE WHEN EXHAUST THE LIST. +AIRP3: CALL STPWR + JRST AIRP1 ;READ ANOTHER GROUP. + +;ALL GROUPS READ IN; NOW READ IN BODY. +AIRP2: CAIE T,"; ;IF A SEMICOLON ENDED THE ARGS, SKIP THE COMMENT. + JRST AIRP4 +AIRP5: CALL RCH + CAIE A,^M + JRST AIRP5 +AIRP4: PUSH P,LINK + MOVE A,FREEPT ;SAVE CHAR ADDR START OF BODY + MOVEM A,PRIRP ;WHERE GC WILL RELOCATE IT. + PUSHJ P,RCH ;IF NEXT CHAR LF, THEN FLUSH IT + CAIE A,12 + TLO FF,FLUNRD + PUSHJ P,WRQOTE ;READ BODY OF IRP + PUSHJ P,STPWR ;WRITE STOP + PUSHJ P,PUSHEM ;SAVE WORLD + REST LINK + POP P,A ;RESTORE RDWRDP FROM LONG AGO + PUSH P,TOPP ;NOW SAVE TOPP + PUSHJ P,DMYTRN ;ACTIVATE DUMMYS + MOVE B,MACP ;NOW GET MACRO PDL POINTER + MOVE A,CIRPCT ;GET .IRPCNT + HRRM A,(B) ;CLOBBER "RETURN" ON PDL TO OLD IRPCNT + SETOM CIRPCT ;INITIALIZE IRPCNT + MOVS A,IRPCR ;GET # GROUPS + HRR A,PRIRP ;CHAR ADR OF BEGINNING OF BODY + SETZM PRIRP + DPB LINK,[410300,,A] ;PUT IN TYPE OF IRP. + PUSH B,A ;PUSH ,,CHAR ADR BEGINNING + POP P,A ;NOW GET OLD TOPP + HRLS A ;MOVE TO LEFT HALF + HRRI A,AIRR ;RETURN TO AIRR ON END OF BODY + PUSH B,A ;PUSH OLD TOPP,,AIRP4 + MOVEM B,MACP ;STORE BACK UPDATED MACRO PDL POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP RIGHT AWAY TO CAUSE CYCLING + REST I + JRST MACCR + +;RECYCLE THROUGH IRP + + ;AC ALLOCATIONS: +AIRR: PUSH P,A ;A GETS BP ILDBING THRU ARG LIST. + PUSH P,C ;C # GROUPS LEFT + PUSH P,T ;T ADR OF PAIR OF CHAR ADR'S OF DUMMYS + PUSH P,TT ;TT TYPE OF IRP (NIRPO, NIRPC, ETC) + AOS CIRPCT ;INCREMENT .IRPCNT + HRRZ A,(B) ;GET CHARACTER ADR BEG BODY FROM PDL + PUSHJ P,ACPTRS ;SET UP CPTR + SETOM AIRPT + TRNE FF,FRMRGO + JRST AIRR9 ;RETURN TO .GO + HLRZ T,1(B) ;DUMMY TAB ADR + LDB C,[220600,,(B)] ;# GROUPS + JUMPE C,AIRR9 ;JUMP IF NO GROUPS + LDB TT,[410300,,(B)] ;GET TYPE OF IRP (NIRPO, ETC) +AIRR6: JRST @.+1(TT) +AIRRER ? AIRRO ? AIRRC ? AIRRS ? AIRRW ? AIRRN ? AIRRER ? AIRRER +AIRRER: .VALUE + +;MOVE 1 ARG THRU 1 GROUP OF IRP. +AIRRO: HRRZ A,1(T) ;THE 1ST ARG WILL START THIS TIME + HRRZM A,(T) ;WHERE THE "REST OF STRING" STARTED LAST TIME. + BCOMP A,-1 ;GET BP THAT'LL ILDB THAT CHAR. + SETO CH1, ;COUNT [-] DEPTH. +AIRRO1: ILDB B,A + CAIN B,375 + JRST AIRRO4 ;END OF STRING IS END OF ARG. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIN B,"[ + AOJE CH1,AIRRO3 ;FLUSH OUTERMOST [-] PAIRS. + CAIN B,"] + SOJL CH1,AIRRO3 + JUMPGE CH1,AIRRO1 ;DON'T LOOK FOR , WITHIN [-]. + CAIE B,^J + CAIN B,", + JRST AIRRO2 ;END OF ARG. + CAIE B,^M ;^M IS IGNORED (FLUSHED.) + JRST AIRRO1 +AIRRO3: MOVEI B,376 ;FLUSH A CHAR BY REPLACING WITH 376 + DPB B,A + JRST AIRRO1 + +AIRRC4: SUB P,[1,,1] +AIRRC3: SETZM (T) ;NULLIFY BOTH ARGS PERMANENTLY. +AIRRO4: SETZM 1(T) ;NULLIFY 2ND ARG PERMANENTLY + JRST AIRR8 ;DONE WITH THIS GROUP. + +AIRRO2: MOVEI B,377 ;REPLACE CHAR THAT ENDED ARG WITH TERMINATOR. + DPB B,A +AIRRW3: CCOMP1 A,-1 ;GET ADDR OF CHAR AFTER. + HRRZM B,1(T) ;"REST OF STRING" STARTS THERE. + JRST AIRR8 + +AIRRN: MOVE A,1(T) ;NEW 1ST DUMMY STARTS AT OLD "REST OF STRING". + MOVEM A,(T) + BCOMP A,-1 ;NEW "REST OF STRING" STARTS AFTER 376, + JRST AIRRW2 ;WHICH WILL BECOME A 377. + +AIRRW: MOVE A,1(T) ;GET CHAR ADDR START OF 2ND HALF OF PREV LINE. + CALL AIRRM ;SET 1ST DUMMY -> AFTER NEXT 376 OR 377 . +AIRRW2: ILDB B,A ;MOVE UP TO NEXT 377 OR END OF STRING. + CAIN B,375 ;END OF STRING ENDS 1ST DUMMY'S ARG => + JRST AIRRO4 ;NULLIFY THE 2ND DUMMY. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIGE B,376 + JRST AIRRW2 + JRST AIRRO2 ;SET UP 2ND DUMMY -> NEXT CHAR. + + +;MOVE UP IN 1 GROUP OF IRPS. +AIRRS: MOVE A,(T) ;MOVE FROM 1ST DUMMY, + CALL AIRRM ;PUT 1ST DUMMY AFTER NEXT 377, + AOS (T) ;MOVE IT PAST THE SYL'S TERMINATING CHAR, + ILDB CH1,A ;GET THAT CHAR, + MOVE A,1(T) + JRST AIRRS2 ;STORE AS 2ND DUMMY. + +AIRRM: BCOMP A,-1 ;A HAS CHAR ADDR; WILL ILDB THAT CHAR. +AIRRM1: ILDB B,A + CAIN B,375 ;END OF STRING => NULLIFY BOTH ARGS + JRST AIRRC4 ;AND FINISHED WITH GROUP. + CAIE B,377 + JRST AIRRM1 + MOVE CH1,A + CCOMP1 CH1,-1 ;GET CHAR ADDR OF CHAR AFTER 377 + MOVEM CH2,(T) ;PUT 1ST DUMMY THERE. + RET ;NOTE A NOT CLOBBERED, CAN GO ON ILDB'ING. + +;MOVE UP IN ONE GROUP OF IRPC. +AIRRC: AOS A,1(T) ;DELETE 1ST CHAR FROM "REST OF STRING". + BCOMP A,-1 ;GET BP -> THAT CHAR. + LDB CH1,A ;GET THE CHAR. + MOVE A,(T) ;GET CHAR ADDR OF PLACE TO PUT IT. +AIRRS2: CAIN CH1,375 ;REACHED END OF STRING => + JRST AIRRC3 ;NULLIFY BOTH ARGS. + BCOMP A,0 + DPB CH1,A ;STORE IT IN THE 1-CHAR ARG. +AIRR7: SETZM AIRPT ;THIS GROUP NOT EXHAUSTED YET. +AIRR8: ADDI T,2 + SOJG C,AIRR6 ;MORE GROUPS => DO THE NEXT. +AIRR9: POP P,TT ;RETURN FROM AAIRPC + POP P,T + SKIPL AIRPT + JRST REPT3 + MOVN A,[2,,2] ;ARGS EXHAUSTED, RETURN + ADDB A,MACP + HRRZ A,(A) + MOVEM A,CIRPCT + POP P,C + POP P,A + JRST RCHSAV + +;IRP ARG-STRING READING COROUTINES: CALL WITH JSP D, +;INITIALIZE FOR READIN OF ARG BUT DON'T GET A CHAR. +;SKIPS IF NONNULL ARG AVAILABLE. +;COROUTINES REMEMBER INFO IN T AND TT BETWEEN CALLS. +;THE CALLER SHOULDN'T CLOBBER THEM. +RARG: CALL RCH ;DECIDE WHAT TYPE OF ARG FOLLOWS, IF ANY. + CAIN A,LBRKT ;RARG ALLOWS [-] AND MAYBE {-~ ARGS AS WELL AS SIMPLE ONES. + JRST RARGBR +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + TLO FF,FLUNRD + JSP T,RARGXT ;CAUSE FAILURE RETURN ON SEMI, CR, LF. +RARGN: CALL RCH ;RARGCH RTN FOR NORMAL ARG. +RARGX1: CAIN A,", + JRST (D) ;COMMA ENDS ARG. +RARGXT: CAIN A,"; + JRST RARGSM ;SEMI ENDS SCAN. +RARGX2: CAIE A,^M + CAIN A,^J ;CR, LF END SCAN. +RARGSM: TLOA FF,FLUNRD + JRST 1(D) + JRST (D) + +RARGBR: SETZ TT, ;TT USED AS BRACKET COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR [-] TYPE ARGS. +RARGBC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRKT + AOJA TT,1(D) + CAIN A,RBRKT + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACKET. + +RARGRR: SETZ TT, ;TT USED AS BRACE COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR {-~ TYPE ARGS. +RARGRC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRACE + AOJA TT,1(D) + CAIN A,RBRACE + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACE. + +;TO GET THE NEXT CHAR OF THE ARG IN A, DO JSP D,RARGCH(T). +;SKIPS UNLESS NO MORE CHARS TO GET. +;NO SKIP AND SET => SCAN SHOULD BE TERMINATED. +;RARG SHOULD NOT BE CALLED AGAIN IN THAT CASE. +RARGCH==0 ;THIS SYMBOL IS FOR CREF'S SAKE. + +;COPY THE ARG BEING READ INTO MACRO SPACE. +;ON RETURN, A WILL HOLD "; IF ARGUMENT WAS ENDED BY ";". +RARGCP: JSP D,RARGCH(T) + JRST RARGC1 + CALL PUTREL + JRST RARGCH(T) + +RARGC1: CAIE A,"; ;IF SEMI ENDED THE ARG, FLUSH THE + RET ;SPACES AND TABS BEFORE IT. +RARGC2: LDB A,FREPTB + CAIN A,^I + JRST RARGC3 + CAIE A,40 + JRST [ MOVEI A,"; ;LAST CHAR OF ARG ISN'T SP OR TAB. + RET] ;MAKE SURE A HAS ";" IF ARG WAS ENDED BY ";". +RARGC3: SOS FREEPT ;IT IS ONE; BACK OVER IT. + MOVE A,FREPTB + DBPM A + MOVEM A,FREPTB + JRST RARGC2 + +;IGNORE THE REST OF THE ARG NOW BEING READ. +RARFLS: JSP D,RARGCH(T) + RET + JRST RARGCH(T) + +;COME HERE TO SET UP TO READ A BALANCED ARG. +;IF THERE'S NO ARG, RETURNS WOTH JRST (D). +;ELSE RETURNS WITH JRST 1(D) SETTING UNRCHF. +RARB: TLO FF,FLUNRD + SETZ TT, ;TT USED AS BRACKET COUNTER. + CAIE A,RBRACE + CAIN A,") ;IF 1ST CHAR IS A CLOSE, + JRST RARB4 ;THERE'S NO ARG. + CAIE A,"> + CAIN A,RBRKT + JRST RARB4 + JSP T,RARGXT ;CHECK FOR CR, LF, SEMI, AND RETURN. +;1-CHAR RTN FOR READING BALANCED ARG. +RARBC: CALL RCH + CAIE A,RBRACE + CAIN A,"> ;FOR CLOSES, MAYBE END ARG. + JRST RARB2 + CAIE A,") + CAIN A,RBRKT + JRST RARB2 + CAIE A,LBRACE + CAIN A,"< ;FOR OPEN BRACKETS, INCR. THE COUNT. + AOJA TT,1(D) ;OPENS CAN'T END THE ARG. + CAIE A,"( + CAIN A,LBRKT + AOJA TT,1(D) + JUMPN TT,1(D) + JRST RARGX1 ;NOT WITHIN BRACKETS, TEST FOR COMMA, ETC. + +RARB2: SOJGE TT,1(D) ;COME HERE FOR CLOSEBRKTS. +RARB4: TLO FF,FLUNRD + JRST (D) + +;COME HERE TO INIT FOR AN ARG FOR REPEAT, ETC. +;THAT IS, EITHER A BRACKETED ARG OR A 1-LINE ARG. +RARL1: CALL RCH +RARL2: +IFN BRCFLG,[ +RARL4: CAIN A,LBRACE + JRST RARGRR ;1ST CHAR A BRACE => BRACED ARG. +] + CAIN A,LBRKT ;1ST CHAR A BRKT => BRKT ARG. + JRST RARGBR + TLO FF,FLUNRD + +;INIT FOR A 1-LINE ARG. +RARL: JSP T,1(D) +;1-CHAR RTN FOR 1-LINE ARGS. +RARLC: CALL RCH + JRST RARGX2 + +IFE BRCFLG,[ +;IF BRACES AREN'T USED BY MOST THINGS, THE NORMAL ROUTINE RARL1 DOESN'T +;CHECK FOR THEM, BUT RALR4 (CALLED BY CONDITIONALS) STILL MUST. +RARL4: CAIN A,LBRACE + JRST RARGRR + JRST RARL2 +] + +;1-LINE ARGS TO MACROS: DON'T TERMINATE THE SPEC, +;AND SKIP OVER THE CR AND LF. +RARL3: TLO FF,FLUNRD + JSP T,1(D) + CALL RCH + CAIN A,^J + JRST (D) ;LF IS THE END - SKIP IT. + CAIE A,^M + JRST 1(D) + CALL RCH ;CR => SKIP FOLLOWING LF, END ARG. + CAIE A,^J + TLO FF,FLUNRD + JRST (D) + +;PUSHJ P,A.GST SEARCH CURRENT MACRO STRING FOR TAG (IN A.GST4) +;SKIP IF FOUND, RETURN ON END OF STRING ANYWAY +;BYTE POINTER (ILDB TO GET FIRST CHARACTER) IN A + +A.GST: MOVEM A,A.GST3 ;SAVE BYTE POINTER +A.GST1: ILDB B,A.GST3 ;GET CHAR + CAIL B,300 + POPJ P, ;END OF STRING => STOP + CAIE B,". + JRST A.GST1 ;WAIT FOR POINT + PUSHJ P,A.GSYL ;FOUND POINT, GET REST OF NAME + JUMPL T,CPOPJ ;RETURN ON END OF STRING + CAME SYM,[SQUOZE 0,TAG] ;TAG? + JRST A.GST1 ;NO, KEEP GOING + PUSHJ P,A.GSYL ;GET THE TAG + JUMPL T,CPOPJ ;RETURN ON END OF STRING (THERE MUST BE BREAK CHAR AFTER TAG BEFORE STOP) + CAME SYM,A.GST4 + JRST A.GST1 ;NOT THE ONE BEING LOOKED FOR + MOVE A,A.GST3 + LDB B,A ;GET DELIMITER + CAIE B,15 ;CR? + JRST POPJ1 + ILDB B,A ;CR, GET NEXT CHAR + CAIE B,12 ;LINE FEED? + MOVE A,A.GST3 ;NO, DON'T FLUSH + JRST POPJ1 + + ;LOOK BACKWARD FOR BEGINNING OF STRING, BYTE POINTER AN A + ;LEAVES POINTER POINTING AT STOP CHAR (NOT BEFORE); ALSO LEAVES STOP CHAR IN B + +AG.SP: MOVE B,(A) ;GET WORD FROM MACTAB + XOR B,[300_28.+300_20.+300_12.+300_4] ;DO XOR TO ANITIALLY SET UP + LDB CH1,[400400,,A] ;PICK UP 4 HIGH ORDER BITS OF POSITION FIELD + JRST A.GSP2-1(CH1) ;DISPATCH ON POSITION FIELD (-1 SINCE BIT SET IN POSITION FIELD) + +AG.SP3: MOVE B,(A) + XOR B,[300_28.+300_20.+300_12.+300_4] + +A.GSP2: TRNN B,300_4 + JSP CH1,AG.SF + TLNN B,3 + JSP CH1,AG.SF + TLNN B,300_2 + JSP CH1,AG.SF + TLNN B,300_10. + JSP CH1,AG.SF + SOJA A,AG.SP3 + +AG.SF: SUBI CH1,A.GSP2-1 ;GET HERE WHEN STOP CHAR FOUND + DPB CH1,[400400,,A] ;CLOBBER POSITION FIELD OF BYTE POINTER AGAIN + ILDB B,A ;INCREMENT TO UNIVERSALLY ACCEPTABLE POINTER, GETTING STOP CHAR IN B AT SAME TIME + POPJ P, ;THAT'S ALL + +A.TAG: PUSHJ P,GSYL + CAIE T,15 + JRST MACCR + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD + JRST MACCR + +A.GO: PUSHJ P,GSYL ;DOESN'T WORK RELIABLY FROM DUMMY + MOVEM SYM,A.GST4 + +A.GO1: TLNN FF,FLMAC + JRST MACCR ;NOT GETTING CHARS FROM MACRO => STOP + MOVE A,CPTR + PUSHJ P,AG.SP ;BACK TO BEGINNING + CAIN B,374 + JRST A.GOMC ;MACRO, SKIP PAST HEADER +A.GORT: PUSHJ P,A.GST + JRST A.GO2 ;END OF STRING, TRY POPPING UP ONE + MOVEM A,CPTR + JRST MACCR + +A.GO2: PUSHJ P,PMACP + JRST A.GO1 + +A.GSYL: MOVNI D,100000 ;GET SYL FOR .GO WHILE LOOKING FOR TAG + MOVEM D,STRCNT ;STRCNT .LT. 0 SIGNAL FOR GSYL TO JRST (F) + MOVEI SYM,0 + JSP F,GSYL1 +A.GSY3: ILDB A,A.GST3 ;GET CHAR + TRZN A,200 ;CHECK FOR SPECIAL + JRST A.GSY2 ;NO, FALL BACK IN + CAIG A,100 ;BIG ENOUGH TO BE SPECIAL? + JRST A.GSY3 ;NO, MUST BE DUMMY, IGNORE + HRROI T,(A) ;SPECIAL => ASSUME STOP: T .LT. 0 SIGNAL TO CALLING ROUTINE + POPJ P, ;RETURN TO CALLING ROUTINE + +;INITIALIZE MACRO STATUS + +MACINI: MOVEI A,3 + MOVEM A,FREEPT ;FORGET ALL STRINGS IN MACTAB + PUSHJ P,FCOMP + MOVE A,MACTAD + HRLI A,41000 ;SET UP CCOMPB THRU CCOMPE + LSH A,2 ;(THEIR VALUES CAN'T BE ASSEMBLED IN BECAUSE + SUBI A,4 ;THEY ARE MUTLTIPLY RELOCATABLE, AND IN DEC + MOVSI AA,CCOMPB-CCOMPE ;VERSION THAT CAN'T BE DONE) +MACIN0: MOVEM A,CCOMPB(AA) + AOJ A, + AOBJN AA,MACIN0 + MOVE A,MACTAD + ADDI A,MACL+1777 + ANDI A,-2000 ;ADDR OF 1ST WD AFTER MACTAB. + CALL MACIN2 ;SET UP PTRS TO END OF MACTAB. + SETZM GCCNT ;CLEAR OUT GC COUNT SO WILL GET MORE CORE FIRST THREE +MACIN1: SETZM MDEPTH ;NOW INITIALIZE MACRO EXPANSION STATUS + SETZM PRSTG ;NOW TO CLEAR OUT BYTE POINTERS + MOVE A,[PRSTG,,PRSTG+1] + BLT A,EPRSTT-1 + MOVEI A,DSTG + MOVEM A,RDWRDP + MOVEI A,DMYAGT + MOVEM A,TOPP + MOVEM A,BBASE + MOVE A,[-MPDLL,,MACPDL] + MOVEM A,MACP + POPJ P, + +;A -> 1ST WD AFTER MACTAB, SET UP ALL POINTERS TO END OF MACTAB. +MACIN2: MOVEM A,MACTND + SUB A,MACTAD + LSH A,2 ;1ST BYTE MACTAB DOESN'T HAVE. + MOVEM A,MACHI + SUBI A,MACRUM*4 + MOVEM A,GCRDHI + MOVE A,STOPPT + HRR A,MACTND + SOS A ;LAST WD IN MACTAB. + MOVEM A,MACHIB ;INITIALIZE BYTE POINTER TO HIGHEST BYTE OK TO FILL + RET + + ;MACRO VARIABLE AREA (MOST THEREOF) + +VBLK +MACP: 0 ;MAC PDL POINTER +BLCODE [MACPDL: BLOCK MPDLL+1] ;MACRO PDL +FREEPT: 0 ;MACRO STG PNTR POINTS TO FREE CHAR +FREPTB: 0 ;FREEPT IN BYTE POINTER FORM +MACTAD: MACTBA ;ADDR OF START OF MACRO TABLE. +MACTND: 0 ;ADDR OF 1ST WD AFTER MACTAB. +MACHI: 0 ;CHAR ADR ONE ABOVE ACTIVE MACTAB +MACHIB: 0 ;POINTS TO LAST BYTE IN MACTAB + +SCONDF: 0 ;STRING CONDITIONAL FLAG, -1 => IDENTICAL, 0 DIFFERENT +GENSM: 0 ;GENERATED SYM COUNT +DEFNPS: 0 ;NONZERO => NAME OF PSEUDO NOW READING ITS ARG. + ;A FATAL ERROR WILL TYPE THE PSEUDO'S NAME. +DEFNPN: 0 ;PAGE # -1 OF THAT PSEUDO. ALSO TYPED BY FATAL ERRORS. +DEFNLN: 0 ;LINE # -1. +DEFNFI: 0 ;SIXBIT FN1 OF FILE CONTAINING PSEUDO THAT DEFNPS REFERS TO. +MDEPTH: 0 ;DEPTH IN MACRO (NOT IRP OR REPEAT) EXPANSIONS +PUTCNT: 0 ;AOS'D BY PUTREL, USED BY CALLING ROUTINE, USUALLY TO COUNT ACTIVE CHARS (DURING DEFINITION) +IRPCR: 0 ;COUNT OF A,B,[LIST] GROUPS IN IRP IRPC IRPS, " " " +AIRPT: 0 ;IRP EXPANSION TEMP, -1 => NO NON-NULL DUMMYS YET, ELSE 0 +AIRPN0: 0 ;1ST NUMERIC ARG TO IRPNC +AIRPN1: 0 ;2ND, +AIRPN2: 0 ;3RD. +A.QOT2: 0 ;DELIMITER FOR .QUOTE +CRPTCT: -1 ;COUNT THROUGH CURRENT REPEAT (FOR .RPCNT) +CIRPCT: -1 ;COUNT THOUGH CURRENT IRP (FOR .IRPCNT) +A.GST3: 0 ;ON .GO, NAME (IN SQUOZE) OF TAG BEING SEARCHED FOR +A.GST4: 0 ;BYTE POINTER FOR ILDB WHILE SEARCHING FOR TAG +PRCALP: PRCAL-1 ;POINTER INTO PRCALP, POINTS TO LAST ACTIVE ENTRY + +PRSTG: ;BEGIN WORDS GARBAGE COLLECTED: FIRST BYTE POINTERS ILDB'D + +CPTR: 0 ;ILDB TO GET NEXT CHAR FROM MACRO OR WHATEVER +IFE WRQTSW-1,WRQTBP: 0 ;POINTS TO LAST CHAR BEFORE CURRENT SYL AT WRQOTE +AIRPSP: 0 ;-> PLACE TO STORE SYL-TERMINATOR, IN IRPS READIN. +GCBPL==.-PRSTG ;END BYTE POINTERS, BEGIN CHARACTER ADDRESSES +PRSCND: 0 ;CHARACTER ADDRESS OF CURRENT LOCATION IN FIRST STRING OF IFSE,IFSN WHILE COMPARING WITH SECOND +PRSCN1: 0 ;CHAR ADR BEG OF FIRST STRING IFSE, IFSN +PRREPT: 0 ;CHAR ADR BEG OF BODY OF REPT +PRIRP: 0 ;CHAR ADR BEG OF IRP BODY +PRDEF: 0 ;CHAR ADR BEG OF MACRO BEING DEFINED +PRCAL: REPEAT 10,0 ;TEMP STORAGE FOR CHAR ADR BEG MACRO BODY, USED TO READ DUMMY SPECS +EPRSTT: ;END CHAR ADR WORDS GARBAGE COLLECTED + + ;BEGIN GARBAGE COLLECTOR VARIABLES + +GCCNT: 0 ;CNT OF GC'S +SYMSTR: 0 ;PNTR TO CHAIN OF MACRO PNTRS IN SYM TABLE (DURING GC), LINKED THROUGH RH'S OF "VALUE" +REDPT: 0 ;CHAR ADR READING FROM WHEN MOVING STRING DOWN +REDPTB: 0 ;REDPT IN BYTE POINTER FORM + ;GC WRITES WITH FREEPT/FREPTB +COFST: 0 ;AMOUNT CHARS MOVED DOWN BY, SUBTRACTED FROM CHAR ADR TO RELOCATE +SVF: 0 ;FLAG, .GE. 0 => NO POINTERS FOUND POINTING TO CURRENT STRING +FREPTS: 0 ;-> BEGINNING OF CURRENT STRING BEING COPIED DOWN +FRPTBS: 0 ;FREPTS IN BYTE POINTER FORM +GCENDF: 0 ;-1 => END OF LAST STRING FOUND, AFTER RELOCATING POINTERS, MSTG2 SHOULD EXIT +GCHI: 0 ;GC HIGH POINTER, CHAR ADR FIRST NOT TO GARBAGE COLLECT +GCRDHI: *4 ;GC DROPS DEAD (MACTAB FULL) IFWRITING INTO THIS CHAR ADR +BLCODE [GCSV: BLOCK 16] ;AC SAVE AREA FOR GC +PBLK + +;GARBAGE COLLECT THE MACRO TABLE + +GCA1: MOVE A,FREEPT ;GC ALL IN MACTAB. +GCA: MOVEM A,GCHI ;ENTRY TO STORE A IN GCHI -> FIRST CHAR NOT TO GARBAGE COLLECT +IFN 17-P+FF,.ERR GC ac saver wants FF=0, P=17! +GC: MOVEM 16,GCSV+15 ; Save all ACs except FF and P. + MOVE 16,[1,,GCSV] + BLT 16,GCSV+14 +IFN TS,[AOS A,GCCNT + CAIGE A,4 + PUSHJ P,GCCORQ ;EXPAND CORE ON FIRST THREE GC'S +] CLEARB T,GCENDF + MOVEI A,3 + MOVEM A,REDPT ;SET UP FOR READING + MOVEM A,FREEPT ;ALSO FOR WRITING + MOVE A,BCOMPU ;ALSO SET UP CORRESPINDING BYTE POINTERS + MOVEM A,FREPTB + MOVEM A,REDPTB + MOVE C,[-GCBPL,,PRSTG] +GCLP1: SKIPN B,(C) ;NOW CONVERT BYTE POINTERS... + JRST GCLP1B ;(INACTIVE) + CCOMP B,-1 ;TO CHARACTER ADDRESSES + MOVEM B,(C) ;STORE BACK CHARACTER ADDRESS +GCLP1B: AOBJN C,GCLP1 ;LOOP FOR ALL SUCH BYTE POINTERS + MOVE A,SYMAOB ;NOW SET UP MACRO LIST; T INITIALLY HAS 0 => END OF LIST DURING COMPUTATION +SYMMG: ;POINTS TO FIRST MACRO SYMTAB ENTRY ON LIST + LDB B,[400400,,ST(A)] ;GET SQUOZE FLAGS THIS SYM + CAIN B,PSUDO_-14. ;PSEUDO? (=> MAYBE MACRO) + JRST SYMMG1 ;YES, MAYBE PUT ON LIST (RETURNS TO SYMMG2) +SYMMG2: ADD A,WPSTE1 + AOBJN A,SYMMG ;LOOP FOR ENTIRE SYMTAB + MOVEM T,SYMSTR ;STORE INITIAL LIST ENTRY FOR MACROS + ;DROPS THROUGH + ;GC DEALS WITH "UNIT STRINGS", EACH STRING ENDS WITH 375 + ;GENERAL PROCEDURE IS TO COPY A STRING DOWN THEN SEARCH FOR POINTERS TO WHERE STRING USED TO BE + ;IF POINTERS FOUND THEY ARE RELOCATED TO POINT TO COPIED DOWN STRING + ;IF POINTERS ARE NOT FOUND THE STRING IS WIPED OUT + ;DROPS THROUGH + +MSTG: MOVE C,REDPT ;SET UP C TO POINT TO BEG OF STRING BEING READ + ;(FOR EVENTUALLY SEARCHING FOR POINTERS TO STRING, NOTE C STAYS AROUND FOR AWHILE) + MOVE TT,FREEPT + CAML TT,GCHI ;IF ALL OF ACTIVE PART OF MACTAB ALREAD GC'D, STOP NOW. + JRST GCEND + MOVEM TT,FREPTS ;-> BEGINNING OF WRITTEN STRING + MOVE TT,FREPTB + MOVEM TT,FRPTBS ;BYTE POINTER -> BEGINNING OF WRITTEN STRING + PUSHJ P,RDTRNS ;COPY CHARACTER + CAIN B,370 + JRST MSTGB ;THAT WAS NO STRING, THAT WAS MY IO-BUFFER! + MOVE TT,B ;SAVE CHARACTER JUST COPIED +MSTG1: CAML LINK,GCHI + JRST GCEND ;JUST READ LAST CHAR IN PART OF MACTAB TO GARBAGE COLLECT => DONE + CAIN B,375 + JRST MSTG2 ;END THIS STRING, NOW SEARCH FOR POINTERS, RETURNS TO MSTG + PUSHJ P,RDTRNS ;STRING NOT EXHAUSTED, COPY NEXT CHAR + JRST MSTG1 + +SYMMG1: HRRZ B,ST+1(A) ;PSEUDO FOUND IN SYMTAB, GET "VALUE" + CAIE B,MACCL ;MACCL? (=> MACRO, CHAR ADR OF BODY IN LH) + JRST SYMMG2 ;NO, JUST FALL BACK INTO LOOP + HRRM T,ST+1(A) ;MACRO, REPLACE MACCL PART OF VALUE WITH POINTER TO NEXT + MOVEI T,ST+1(A) ;UPDATE T (INITIAL LIST ENTRY) TO POINT TO WORD JUST CLOBBERED + PUSH P,A + HLRZ A,ST+1(A) + PUSHJ P,REDINC + CAIE B,374 + HALT + POP P,A + JRST SYMMG2 + + ;COPY CHARACTER DOWN (REDPTB -> FREPTB) + ;LEAVE INCREMENTED REDPT IN LINK, FREEPT IN A, CHAR IN B + +RDTRNS: ILDB B,REDPTB + IDPB B,FREPTB + AOS LINK,REDPT + AOS A,FREEPT + POPJ P, + +MSTGB: ADDI A,3 ;COPY AN IO-BUFFER: + TRZ A,3 + MOVEM A,FREEPT ;WRITE INTO WORD BOUNDARY. + ADDI LINK,3 + TRZ LINK,3 + MOVEM LINK,REDPT ;READ FROM WORD BOUNDARY. + MOVEI B,041000 + HRLM B,REDPTB + HRLM B,FREPTB + MOVE B,FREPTB + MOVE A,REDPTB + ADDI B,1 ;NEW ADDR OF 1ST WD. + HRRZ LINK,1(A) ;GET ADDR OF POINTER TO STRING. + MOVEM LINK,SVF ;REMEMBER WHETHER TO FLUSH STRING. + SKIPE LINK + HRRM B,(LINK) ;RELOCATE THAT POINTER (IF ANY) + HRLI B,1(A) ;SET UP AC FOR BLT. + HLRZ LINK,1(A) ;GET LENGTH OF STRING. + ADDM LINK,REDPTB + LSH LINK,2 + ADDM LINK,FREEPT + ADDM LINK,REDPT + LSH LINK,-2 + ADDB LINK,FREPTB + BLT B,(LINK) + MOVE LINK,REDPT + CAML LINK,GCHI ;IF THIS IO-BUFFER IS LAST THING IN MACRO SPACE, + SETOM GCENDF ;DON'T LOOK FOR ANYTHING FOLLOWING IT. + JRST MSTGB1 ;NOW MAYBE FLUSH THIS STRING, COPY NEXT. + +;GET HERE WHEN MSTG2 FINISHES WITH FLAG SET TO EXIT: UNDO INITIALIZATION AND RETURN + +GCEND1: IFN TS,[ + MOVE A,FREEPT + ADDI A,2000*4 + CAML A,MACHI + PUSHJ P,GCCORQ +] MOVE A,FREEPT + CAML A,GCRDHI + ETF [ASCIZ /Macro space full/] + SKIPN T,SYMSTR + JRST USYMG1 ;EMPTY LIST + MOVEI C,MACCL ;SET UP C FOR HRRM'ING +USYMG: HRRZ TT,(T) ;GET ADR ON LIST + HRRM C,(T) ;CLOBBER RH JUST GOT NEXT POINTER FROM TO MACCL + HLRZ A,(T) + PUSHJ P,REDINC + CAIE B,374 + HALT + SKIPE T,TT ;MAKE NEXT POINTER CURRENT, SKIP IF END OF LIST + JRST USYMG + +USYMG1: MOVE C,[-GCBPL,,PRSTG] +GCLP2: MOVE A,(C) ;NOW CONVERT CHARACTER ADDRESSES... + BCOMP A,-1 ;BACK TO BYTE POINTERS + MOVEM A,(C) + AOBJN C,GCLP2 +IFN 17-P+FF,.ERR GC AC restorer wants FF=0 and P=17! + MOVS 16,[1,,GCSV] ; Restore all ACs except FF and P. + BLT 16,16 + POPJ P, ;EXIT FROM GARBAGE COLLECTOR + + ;GC ROUTINE TO SCAN TABLE AREA FOR POINTERS TO CURRENT STRING + ;CH1 -> BEGINNING OF TABLE, 4.9 => LOOK AT PAIRS SKIPPING SECOND OF EACH PAIR + ;T POINTS TO LAST WORD IN TABLE + 1 + ;RELOCATE POINTERS IN TABLE POINTED TO + ;C POINTS TO BEGINNING OF STRING, B -> END + 1 + +MSCN: CAIG T,(CH1) + POPJ P, ;TABLE EXHAUSTED + HRRZ TT,-1(T) ;GET LAST ENTRY IN TABLE (UPPER POINTER UPDATED TO COUNT DOWN) + CAML TT,C + CAML TT,B + JRST MSCN1 ;DOESN'T POINT TO CURRENT STRING + SUB TT,COFST ;POINTS TO STRING, RELOCATE + HRRM TT,-1(T) ;STORE BACK RELOCATED POINTER + SETOM SVF ;SET FLAG TO SAVE STRING +MSCN1: SKIPGE CH1 + SOS T ;CH1 NEGATIVE => SKIP A WORD + SOJA T,MSCN + +GCEND: SETOM GCENDF ;DONE READING FROM MACTAB, BUT FIRST HAVE TO RELOCATE POINTERS TO LAST STRING +MSTG2: CLEARM SVF ;NO POINTERS FOUND TO STRING YET + MOVE D,REDPT + SUB D,FREEPT + MOVEM D,COFST ;STORE AMOUNT CHARS COPIED DOWN BY FOR CHAR ADR RELOCATION + MOVE B,REDPT + CAIE TT,374 + JRST MSTG3 ;NOT A MACRO + MOVE T,SYMSTR + JUMPE T,MSTG3 ;JUMP IF NO MACROS ON LIST +MSTG5: HLRZ TT,(T) ;GET CHAR ADR THIS MACRO + CAML TT,C ;SKIP IF POINTS BELOW BEGINNING THIS STRING + CAML TT,B ;SKIP UNLESS POINTS TO OR ABOVE FIRST CHAR NOT YET READ + JRST MSTG4 ;DOESN'T POINT TO THIS STRING + SETOM SVF ;POINTS TO THIS STRING, SET FLAG TO SAVE STRING + SUB TT,COFST ;RELOCATE + HRLM TT,(T) ;STORE BACK UPDATED CHAR ADR THIS MACRO +MSTG4: HRRZ T,(T) ;NOW GET POINTER TO NEXT MACRO + JUMPN T,MSTG5 ;LOOP FOR ALL MACROS ON LIST + +MSTG3: MOVE T,TOPP + MOVEI CH1,DMYAGT + PUSHJ P,MSCN ;RELOCATE POINTERS IN DUMMY ARG TABLE + HRRZ T,MACP + HRROI CH1,MACPDL + PUSHJ P,MSCN ;RELOCATE POINTERS IN MACRO PDL + HRRZ T,PRCALP + AOS T + MOVEI CH1,PRSTG + PUSHJ P,MSCN ;RELOCATE POINTERS IN PRSTG + HRRZ T,RDWRDP + MOVEI CH1,DSTG + PUSHJ P,MSCN ;RELOCATE DUMMY ARGS READ (OR BEING READ) IN BUT NOT YET ACTIVATED + SKIPGE GCENDF + JRST GCEND1 ;EXIT +MSTGB1: SKIPE SVF + JRST MSTGB2 ;FOUND POINTERS TO THIS STRING, DON'T FLUSH + MOVE TT,FREPTS ;NO POINTERS FOUND, FLUSH STRING + MOVEM TT,FREEPT + MOVE TT,FRPTBS + MOVEM TT,FREPTB +MSTGB2: SKIPGE GCENDF ;IF WE JUST HACKED AN I-O BUFFER, MAYBE IT'S THE LAST + JRST GCEND1 ;THING IN MACRO SPACE. + JRST MSTG + +] ;END MACSW CONDITIONAL (AND MACRO PROCESSOR ROUTINES) + +IFN .I.FSW,[ ;;.I.F ;ALGEBRAIC COMPILER ROUTINE +; 'ALGEBRAIC' CRUFT MARO DEFINITIONS + +DEFINE MOAN ARG/ + MOVEI D,[SIXBIT /ARG!!/] + JRST ERRCON +TERMIN + +DEFINE RETLIN + MOVEI A,15 ;CARRIAGE RETURN + PUSHJ P,PUTREL + MOVEI A,12 ;LINE FEED + PUSHJ P,PUTREL +TERMIN + +DEFINE NUMBER + MOVE A,BTPNT + ILDB I,A + CAIE I,"# + CAIGE I,"@ +TERMIN + +DEFINE RESTOR + MOVE D,BTPNT + SETZM STRING + SETZM STRING+1 + SETZM STRING+2 +TERMIN + + +DEFINE SPECN + POP P,RANDM + MOVE A,ENN + SUB A,RANDM + MOVEM A,ENN +TERMIN + +DEFINE $GET + EXCH I,ACSVI + PUSHJ P,RCH + EXCH I,ACSVI +TERMIN + +DEFINE GETT + EXCH I,ACSVI + PUSHJ P,RCH + EXCH I,ACSVI + IDPB A,TPN +TERMIN + +; START OF COMPILER PROPER + +OPDL: CH?CH?CH?CH?CH?CH?CH?CH ;COMMUTATOR + CH?SP?CH?CH?CH?CR?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + SP?CH?CH?CH?DL?CH?CH?CH + LP?RP?TX?PL?CM?MN?CH?DV + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?KL?LB?EQ?RB?CH + +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?UP?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH + +VBLK + +ENN: 60 ;ACCUMULATOR NUMBER - TROUBLE IF GOES PAST 9 + +BTPNT: 440700,,STRING ;D +STRING: BLOCK 10 ;CHARACTER ASSEMBLY (D) - TROUBLE IF OVERFLOWS + +TPN: 0 +DIRPNT: 440700,,DIROUT ;TPN +DIROUT: BLOCK 40 ;COPY OF LINE IN PROGRESS (TPN) - TROUBLE IF OVERFLOWS + +OPSTKL==40 + 0 +OPSTK: BLOCK OPSTKL ;OPERATOR STACK (R) - TROUBLE IF OVERFLOWS + 0 + + + +ENDSTT: 0 ;ON IF END OF STATEMENT ENCOUNTERED +CHARF: 0 ;LAST WAS NOT OPERATOR +NUMFL: 0 ;STRING IS NUMERIC CONSTANT (NEEDS [ AND ]) +R1SV: 0 ;SAVED A +R2SV: 0 ;SAVED I, CALLED V EARLIER ON + +INTEGR: 0 ;INTEGER ARITHMETIC +WARN: 0 ;ON AFTER ) TO STOP NON-OPERATOR +RANDM: 0 ;DUMP COMMA COUNT HERE +TEMP: 440600,,(D) ;INDIRECT VIA D +BYTPNT: 0 + ; Save 7 acs here, done by move(m)s for robustness +IRP AC,,[AA,A,B,C,D,I,P] +ACSV!AC: 0 +TERMIN +PBLK + +; ENTRANCE TO 'ALGEBRAIC' TRANSLATOR + +A.I: SETOM INTEGR + SKIPA +A.F: SETZM INTEGR + PUSHJ P,SWINI ;INITIALISE PASSAGE TO MIDAS ASSEMBLER +IRP AC,,[AA,A,B,C,D,I,P] + MOVEM AC,ACSV!AC +TERMIN + SETZM ENDSTT ;RESET END OF STMNT FLAG + SETZM EQHIT' ;RESET LAST CHAR WAS= FLAG + SETZM WARN ;SET OFF ERROR DETECTOR + MOVEI A,"0 ;INITIALISE POINTERS + MOVEM A,ENN + MOVE A,DIRPNT + MOVEM A,TPN ;POINTER TO SAVED INPUT + MOVE SYM,[-OPSTKL,,OPSTK] + PUSH SYM,[0,,ENDSAT] + PUSH P,[0] ;INITIALISE COMMA-COUNTER + SETZM CHARF +CLSTR: RESTOR +RDITTS: SKIPE ENDSTT + JRST BDEND +RDITA: GETT + CAIGE A,100 ;FOR ABBREVIATED DISPATCH TABLE + JRST @OPDL(A) + CAIN A,"\ + JRST AB + CAIN A,"^ + JRST UP + +CH: SETZM EQHIT + SKIPE WARN + JRST CHBRT +CHEY: IDPB A,D + SETOM CHARF ;NON UNARY FLAG + JRST RDITA + +GAMB: RESTOR +COMMT: MOVE I,R2SV + JRST GOPURT + +SHORT: ;DECIDES IF STRING CAN BE USED IN IMMEDIATE TYPE OPS + SETZM IMMED' + SKIPN STRING + POPJ P, ;NO STRING + MOVE A,BTPNT + ILDB I,A + CAIN I,"# + JRST APUPJ ;YEPE HE ASKED FOR IT + SKIPE STRING+1 + POPJ P, ;STRING IS LONG + SKIPA + +TSTSHL: ILDB I,A + JUMPE I,APUPJ ;ITS OK FOUND ONLY NUMBERS + CAILE I,"@ + POPJ P, ;NON-NUMBER IN STRING + CAIE I,". + JRST TSTSHL + ILDB I,A + SKIPN I ;ANYTHING FOLLOW '.' QST +APUPJ: SETOM IMMED' ;INDICATE IMMEDIATE USAGE IS POSSIBLE + POPJ P, + +SZPRT: SETZM CHARF +GOPRT: SETZM WARN +GOPART: MOVEM I,R2SV +GOPURT: HLRZ B,I + HLRZ C,(SYM) + CAMLE B,C + JRST PSOPR ;GO PUSH OPERATOR + SKIPN INTEGR + SETOM IMMED ;FOR ARITH OPS ONLY FIXED WILL DO IMMEDIATE + PUSHJ P,SHORT ;ESTABLISH IF STRING CAN BE IMMEDIFIED + POP SYM,A ;POP AN OPERATOR + JUMPN A,(A) + + MOAN OVERPOPPED OPERATOR STACK + +CHEX: MOVE A,R1SV + JRST CHEY + +RP: SKIPE EQHIT + AOS ENN ;TAKE CARE OF UNSATISFIED = AT END + SKIPN CHARF + JRST RTONOP + SETOM CHARF +BUDDY: SETOM WARN + MOVEI I,RPAR + JRST GOPART + +RTONOP: MOVE I,(SYM) + CAIN I,FUNCT + JRST BUDDY ;NO ARGUMENT FUNCTION + + MOAN ) FOLLOWS OPERATOR + +BDEND: MOAN TOO MANY ('S + +CHBRT: MOAN NON-OPERATOR FOLLOWS ) + +CR: SKIPE EQHIT + AOS ENN ;HANDLES UNSATISFIED = AT END + SETOM ENDSTT + MOVEI I,RCAR + JRST GOPRT + +LP: SETZM EQHIT + SKIPE WARN + JRST LFRHT + SETZM CHARF + SKIPE STRING + JRST INDX + PUSH P,[0] ;INITIALISE COMMA-COUNTER + PUSH SYM,[0,,LFTPR] + JRST RDITA + +INDX: NUMBER + JRST NUSTRB + GETT + CAIG A,"9 + JRST NMRINX + MOVEI I,"( + IDPB I,D +INDY: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDN + CAIN A,"- + JRST CMPNDN + CAIE A,") ;SEARCH FOR NEXT RP + JRST INDY + IDPB A,D +CMBAN: SETOM CHARF ;MAKE BELIEVE CHARATER LAST + SETOM WARN ;YET SET ) TRAP + JRST RDITA + +NMRINX: CAIN A,"- ;IS IT A MINUS + JRST INDZ + CAIN A,"+ + JRST INDZ + MOVEI I,"+ ;NUMERICAL SUBSCRIPT + IDPB I,D +INDZ: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDC + CAIE A,") + JRST INDZ + JRST CMBAN + +CMPNDN: MOVEI I,") + IDPB I,D + JRST INDZ + +CMPNDC: MOVEI I,"( + IDPB I,D + JRST INDY + +LFRHT: MOAN ( FOLLOWS DIRECTLY ON ) + +SP=RDITA ;USE FOR NON ARITH STATS + +CM: MOVE I,[1,,COMMX] + SKIPN CHARF + AOS ENN + JRST SZPRT + +EQ: SETOM EQHIT + SETZM WARN + SKIPN CHARF ;TEST FOR EXISTANCE OF L H S + JRST EQFLOP + NUMBER ;IS L H S A NUMBER + JRST EQNUMB + MOVEI I,EQAAL +EQVAL: SETZM CHARF + PUSH SYM,I + PUSH P,STRING + PUSH P,STRING+1 + PUSH P,STRING+2 + PUSH P,[0] + JRST CLSTR + +PL: MOVE I,[2,,PLUS] + SKIPN CHARF + JRST RDITA ;UNARY PLUS + JRST SZPRT + +MN: MOVE I,[2,,MINUX] + SKIPN CHARF + MOVE I,[5,,UMINU] + JRST SZPRT + +AB: SKIPE CHARF ;ABSOLUTE VALUE + JRST ABERR ;NOT UNARY + MOVE I,[5,,UABS] + JRST SZPRT + +LB: SKIPN CHARF + JRST LP ;TREAT LIKE ( + NUMBER + JRST NUBRST + MOVEI I,FUNCT + JRST EQVAL + +RB=RP + +NUBRST: MOAN '<' FOLLOWS NUMBER + +NUSTRB: MOAN '(' FOLLOWS NUMBER + +EQFLOP: MOAN '=' FOLLOWS OPERATOR + +EQNUMB: MOAN '=' FOLLOWS NUMBER + +ABERR: MOAN NON-UNARY ABS + +TX: MOVE I,[4,,TIMES] + SKIPN CHARF + JRST RDITA ;UNARY TIMES + JRST SZPRT + +DL: $GET ;CONTINUE STATEMENT RC + $GET ;LF + $GET ;. + CAIE A,". ;DOT + JRST BDCONT + $GET ;F OR I + $GET ;CONTROL I OR SPACE + MOVE A,DIRPNT + MOVEM A,TPN ;RESET SAVED INPUT POINTER TO AVOID FILLING ITS BUFFER + MOVEI A,"$ + IDPB A,TPN + MOVEI A,40 + IDPB A,TPN + JRST RDITA + +ERRCON: TRNE FF,FRPSS2 ;NO OUTPUT ON SECOND PASS + JRST CONRBT +;MAY ALSO WANT TO USE STATEMENT PLUS LINE NUMBER TYPE TACTIC + MOVE B,DIRPNT +OUTRR: ILDB A,B + PUSHJ P,TYO + CAME B,TPN + JRST OUTRR + SKIPE ENDSTT + JRST CONERT +DORSTL: MOVEI A,40 + PUSHJ P,TYO + MOVEI A,"? ;POINT AT ERROR + PUSHJ P,TYO + MOVEI A,40 + PUSHJ P,TYO +DORSAL: $GET ;COPY UP TO LINE FEED + PUSHJ P,TYO + CAIE A,12 ;LF + JRST DORSAL +CONERT: PUSHJ P,TIPIS + PUSHJ P,CRR +CONRAT: +IRP AC,,[AA,A,B,C,D,I,P] + MOVE AC,ACSV!AC +TERMIN + JRST SWFLS ;GO BACK AND FLUSH + + +CONRBT: $GET + CAIE A,12 ;LF + JRST CONRBT + JRST CONRAT + +UP: SKIPN WARN ;FOR (NUMBER)^N + SKIPN STRING + JRST ITSEX + MOVEM A,R1SV ;SAVE THE ARROW + NUMBER + JRST CHEX ;ITS PART OF A NUMBER +ITSEX: MOVE I,[6,,STRSTR] + SKIPN CHARF + JRST EXMB + JRST SZPRT + +EXMB: MOAN UNARY ^ + +BDCONT: MOAN BAD CONTINUATION + +KL=CR ;SEMICOLON ACTS LIKE CR IN TERMINATING + +STRSTR: SKIPN STRING + JRST EXLS + NUMBER + SKIPA + JRST EXLS + SUBI I,61 + TDNE I,[-1,,777774] + JRST EXLS + MOVE A,STRING + TDNE A,[3777,,-1] + JRST EXLS + ADDI I,POWR + JRST @(I) + +EXLS: PUSH P,[ASCII !EXPLO!] + PUSH P,[ASCII !G !] + PUSH P,[0] + PUSH P,[1] + SETOM EXRET' + JRST FUNET + +DV: MOVE I,[4,,DIVIX] + SKIPN CHARF + MOVE I,[5,,UDIVI] + JRST SZPRT + +PSOPR: PUSH SYM,I ;PUSH OPERATOR FOR LATER EXCECUTION + SKIPN STRING + JRST RDITTS + PUSHJ P,SHORT ;CAN WE IMMEDIFY + PUSHJ P,MVOI ;AND MOVE OPERAND INTO STACK + JRST CLSTR + +PRODB: NUMBER ;OUTPUT WHAT IS IN STRING + SKIPE IMMED ;NO [ & ] IF IMMEDIATE USE + JRST OVNM + PUSH P,A + MOVEI A,"[ ;[ FOR CONSTANT + PUSHJ P,PUTREL + POP P,A + SETOM NUMFL +OVNM: CAIN I,"# + JRST PRDOC + + EXCH A,I + PUSHJ P,PUTREL + MOVE A,I +PRDOC: ILDB I,A + JUMPN I,OVNM + SKIPN NUMFL + POPJ P, + MOVEI A,"] ;] FOR CONSTANT + PUSHJ P,PUTREL + SETZM NUMFL + POPJ P, + +PRODC: HRLI A,440700 ;MAKE BYTE POINTER + JRST PRDOC + +LFTPR: SPECN + JRST RDITTS ;IGNORE LP ON STACK + +RCAR: HALT ;IMPOSSIBLE FOR THESE TO BE ON STACK +RPAR: HALT + +EQAAL: SPECN + SKIPE STRING + PUSHJ P,MVOI + MOVEI A,[ASCIZ ! MOVEM A!] + PUSHJ P,PRODC + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +ENDSAT: SPECN + SKIPN ENDSTT + JRST TOEARL + SKIPE STRING + PUSHJ P,MVOI +GETLF: $GET + CAIE A,12 ;LF + JRST GETLF +IRP AC,,[AA,A,B,C,D,I,P] + MOVE AC,ACSV!AC +TERMIN + JRST SWRET ;GO BACK + +MVOI: MOVE A,BTPNT + ILDB I,A + CAIN I,"& + JRST MVOALR ;OPERAND ALREADY THERE + MOVEI A,[ASCIZ ! MOVE A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVEI A!] +MVOIK: PUSHJ P,PRODC + MOVE A,ENN + AOS ENN +FINOF: PUSHJ P,PUTREL + MOVEI A,", + PUSHJ P,PUTREL + PUSHJ P,PRODB + RETLIN + POPJ P, + +MVOALR: AOS ENN + POPJ P, + +TOEARL: MOAN TOO MANY )'S + +PLUS: MOVEI A,[ASCIZ ! FADR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! ADD A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! ADDI A!] +OPERT: PUSHJ P,PRODC + SKIPE STRING + JRST GAINS + SOS ENN +OPRTE: MOVE A,ENN + SOS A + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +COMMAA: MOVEI A,", + PUSHJ P,PUTREL + MOVEI A,"A + JRST PUTREL + +GAINS: MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +MINUX: MOVEI A,[ASCIZ ! FSBR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! SUB A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! SUBI A!] + JRST OPERT + +TIMES: PUSHJ P,TMSTR + SKIPE IMMED + MOVEI A,[ASCIZ ! IMULI A!] + JRST OPERT + +DIVIX: MOVEI A,[ASCIZ ! FDVR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IDIV A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! IDIVI A!] + JRST OPERT + +UMINU: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE STRING + JRST MOABC + MOVEI A,[ASCIZ ! MOVNS A!] +UMINUC: PUSHJ P,PRODC + MOVE A,ENN + SOS A + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +MOABC: MOVEI A,[ASCIZ ! MOVN A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVNI A!] + PUSHJ P,MVOIK + JRST GAMB + +UABS: CAMN B,C + JRST BAKWD + SKIPE STRING + JRST MOABS + MOVEI A,[ASCIZ ! MOVMS A!] + JRST UMINUC + +MOABS: MOVEI A,[ASCIZ ! MOVM A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVMI A!] + PUSHJ P,MVOIK + JRST GAMB + +MVONT: MOVEI A,[ASCIZ ! MOVE A!] + PUSHJ P,PRODC + MOVE A,ENN + JRST ONMVS + +TMSTR: MOVEI A,[ASCIZ ! FMPR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IMUL A!] + POPJ P, + +BAKWD: PUSH SYM,A + JRST PSOPR + +UDIVI: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE INTEGR + JRST UINDV + SKIPN STRING + PUSHJ P,MVONT + MOVEI A,[ASCIZ ! HRLZI A!] + PUSHJ P,PRODC + MOVE A,ENN + SKIPN STRING + SOS A + PUSHJ P,PUTREL + MOVEI A,[ASCIZ !,201400!] + PUSHJ P,PRODC + RETLIN + AOS ENN + JRST DIVIX + +ONTMS: PUSHJ P,TMSTR + PUSHJ P,PRODC + MOVE A,ENN + SOS A +ONMVS: PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A +LSTCHX: PUSHJ P,PUTREL + RETLIN + POPJ P, + +POWR: GAMB?POWR2?POWAA?POWR4 + +POWR4: PUSHJ P,ONTMS +POWR2: PUSHJ P,ONTMS + JRST GAMB + +POWAA: PUSHJ P,MVONT + AOS ENN + PUSHJ P,ONTMS + SOS ENN + PUSHJ P,TMSTR + PUSHJ P,PRODC + RESTOR + JRST OPRTE + +COMMX: AOS (P) + SKIPE STRING + PUSHJ P,MVOI + JRST GAMB + +UINDV: MOAN INTEGER UNARY DIVIDE + +FUNCT: SETZM EXRET +FUNET: SKIPE STRING + PUSHJ P,MVOI + SPECN + PUSHJ P,MORFMC + MOVEI A,[ASCIZ ! PUSHJ P,!] + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + PUSHJ P,PRODC + PUSHJ P,PRODB + RESTOR + RETLIN + PUSHJ P,MORFNC + SKIPN EXRET + JRST RDITTS ;AS USED FROM FUNCT + JRST COMMT ;AS USED FROM STRSTR + +MORFMC: MOVE A,RANDM + MOVEM A,RANSV' + SKIPN CHARF ;NO ARGUMENTS + AOS ENN + SETOM CHARF + MOVEI A,"1 + CAMN A,ENN ;ARE ARGUMENT ALREADY IN A0 AND UP + POPJ P, + SETZM CORDM +MORYLP: PUSHJ P,ZENBD + AOS CORDM + SOSL RANSV + JRST MORYLP + POPJ P, + +MORFNC: MOVEI A,"1 + CAMN A,ENN + POPJ P, + MOVE A,RANDM + MOVEM A,CORDM' +MORXLP: PUSHJ P,ZENBD + SOSL CORDM + JRST MORXLP + POPJ P, + +ZENBD: MOVEI A,[ASCIZ ! EXCH A!] + PUSHJ P,PRODC + MOVE A,CORDM + ADDI A,"0 + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A + ADD A,CORDM + JRST LSTCHX + +TIPIS: MOVE A,TEMP + MOVEM A,BYTPNT +MORTP: ILDB A,BYTPNT + CAIN A,1 ;EXCLAMATION + POPJ P, + ADDI A," ;SPACE + PUSHJ P,TYO + JRST MORTP + +] ;END .I.FSW CONDITIONAL + +IFN LISTSW,[ + +;LISTING ROUTINES. + +PNTR: MOVEM 17,PNTSA+17 + MOVEI 17,PNTSA + BLT 17,PNTSA+16 + MOVE P,PNTSA+P ; P = 17 so must restore. +IFN P-17, .ERR P=17 assumption at PNTR! + SKIPL LSTONP + JRST PNTR5 + AOSE LISTPF + JRST PNTR1 + SKIPGE T,LISTAD + JRST PNTR2 + PUSHJ P,P6OD + HLRZS T + PUSHJ P,PSOS ;PRINT SPACE OR ' + PUSHJ P,PILPTS +PNTR3: HLRZ T,LISTWD + PUSHJ P,P6OD + MOVS T,LSTRLC + TLNE T,400000 + AOJ T, + PUSHJ P,PSOS + HRRZ T,LISTWD + PUSHJ P,P6OD + HRRZ T,LSTRLC + PUSHJ P,PSOS + PUSHJ P,PILPTS + PUSHJ P,PILPTS +PNTR4: MOVE TT,[440700,,LISTBF] +PNTR6: CAMN TT,PNTBP + JRST PNTR5A + ILDB A,TT + PUSHJ P,PILPT + JRST PNTR6 + +PNTR5A: CALL PNTCR + MOVE A,LISTBC + CAIE A,14 + JRST PNTR7 +PNTR5C: CALL PILPT ;OUTPUT THE ^L, + CALL PNTHDR ;AND THE PAGE NUMBER. + JRST PNTR5D + +PNTR7: MOVEI A,12 + PUSHJ P,PILPT +PNTR5D: SETOM LISTBC +PNTR5: MOVNI A,LISTBS*5-1 + MOVEM A,PNTSW ;DETECT OVERFLOW OF LISTBF + MOVE TT,[440700,,LISTBF] + MOVEM TT,PNTBP + MOVSI 17,PNTSA + BLT 17,17 + POPJ P, + +PNTR5B: MOVE A,LISTBC + CAIN A,14 + JRST PNTR5C + JRST PNTR5D + +PNTR2: MOVEI T,8 + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR3 + +PNTR1: MOVE TT,[440700,,LISTBF] + CAMN TT,PNTBP + JRST PNTR5B + MOVEI T,25. + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR4 + +PSOS: MOVEI A,"' + TRNN T,-1 +PILPTS: MOVEI A,40 + JRST PILPT + +P6OD: MOVE TT,[220300,,T] +P6OD1: ILDB A,TT + ADDI A,"0 + PUSHJ P,PILPT + TLNE TT,770000 + JRST P6OD1 + POPJ P, + +PNTCR: MOVEI A,^M ;OUTPUT ^M TO LST IF OPEN. +PILPTX: SKIPE LSTONP;OUTPUT CHAR TO LST IF LSTING. + JRST PILPT + RET + +PNTHDR: MOVEI A,^I + MOVEI B,10. ;MOVE TO COLUMN 80., + CALL PILPT + SOJG B,.-1 + PUSH P,LSTTTY + HLLOM B,LSTTTY ;POSITIVE SO TYOERR GOES ONLY TO LST. + TYPR [ASCIZ/Page /] + MOVE A,CPGN + CALL [AOJA A,DPNT] + REST LSTTTY +PNTCRR: CALL PNTCR ;OUTPUT CRLF TO LST IF OPEN. +PNTLF: MOVEI A,^J + JRST PILPTX + +DEFINE LSTM %A,B,C +IF1 [ [B] ? [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+LSTM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-LSTM0 +] +TERMIN + +A.LSTFF: AOS (P) ;RETURN NO VALUE. +; ADDR, CONTENTS IF NOT LISTING, CONTENTS IF LISTING. +LSTOFF: LSTM LSTONP,0,-1 + LSTM LSTPLM,[TLO B,4^5][JRST PSHLML] + LSTM RCHLST,RCHLS1,AOSN PNTSW + LSTM RCH1LS,RET,[CAILE A,^M] + LSTM POPLML,JFCL,[IDPB A,PNTBP] + JRST MDSCLR +LSTM0==.-LSTOFF + +LSTON: BLOCK LSTM0-1 + JRST MDSSET + +A.LSTN: SKIPN LISTP1 ;IF SHOULD LIST THIS PASS + JUMPGE FF,MACCR + SKIPE LISTP ;AND WANT LISTING, + CALL LSTON ;TURN ON LISTING OUTPUT. + JRST MACCR + +IFNDEF LISTBS,LISTBS==50. ;LISTBF SIZE IN WORDS. + +VBLK ;LISTING FEATURE VARIABLES + +PNTBP: 0 ;POINTER TO LISTING LINE BUFFER +LSTONP: 0 ;NONZERO WHEN OUTPUTTING TO LISTING FILE. +LISTP: +LISTON: 0 ;-1 IF LISTING ON +PNTSW: 0 ;-1 IF LAST CHR CR OR LF, OR -<# CHARS SPACE LEFT IN LISTBF> +LISTBF: BLOCK LISTBS +LISTAD: 0 ;ADDRESS OR -1 NONE 3.1 RELOC +LISTWD: 0 ;WORD +LSTRLC: 0 ;RELOCATION +LISTPF: 0 ;-1 OTHERS CONTAIN SOMETHING +LISTBC: 0 ;BREAK CHR CR LF OR FF OR -1 IF NONE SINCE LAST PNTR +LISTTM: 0 ;TEMP AT AEND +PNTSA: BLOCK 20 ;AC SAVE AREA FOR LISTING FEATURE +LISTP1: 0 ;POSITIVE => WANT TO LIST EVEN ON PASS 1. +] ;END IFN LISTSW, + +IFE LISTSW,VBLK + +;THESE VARIABLES ARE REFERENCED EVEN IF LISTSW IS 0. +LSTTTY: 0 ;TYOERR TYPES ON TTY IFF LE 0, ON LST IF NOT 0. +LSTPLM: TLO B,4^5 ;OR JRST PSHLML ;XCT'D BY PSHLMB. +POPLML: JFCL ;OR IDPB A,PNTSW ;XCT'D IN POPLMB. + +PBLK +IFE LISTSW, A.LSTN: A.LSTF: RET + +VBLK +IFN CREFSW,[ +CREFP: 0 ;SET BY C SWITCH TO REQUEST CREFFING. +CRFONP: 0 ;SET WHILE CREFFING. +CRFLFL: 0 ;LAST PAGNUM,,LINENUM OUTPUT. +CRFINU: JFCL\PUSHJ P,CRFUSE ;XCT THIS TO CREF NON-DEF OCCUR. +CRFLBL: JFCL\PUSHJ P,CRFLB1 ;XCT FOR DEF. OF NORMAL SYM. +CRFEQL: JFCL\PUSHJ P,CRFEQ1 ; FOR DEF. OF NORMAL SYM. OR INTSYM. +CRFMCD: JFCL\PUSHJ P,CRFMC1 ; FOR DEF. OF MACRO. +CRFDEF: JFCL\PUSHJ P,CRFDF1 ; FOR RANDOM DEF, CHECK FLAGS. +] +CRFILE: 0 ;SET => SHOULDN'T OUTPUT PAGNUM,,LINENUM'S +;USED BY .CRFILE INTSYM SO CAN'T BE IN CONDIT. +PBLK +IFN CREFSW,[ +CRFEQ1: MOVEI T,(B) + CAIN A,1 ;IF NOT PSEUDO OR NOT INTSYM, + CAIE T,INTSYM + JRST CRFLB1 ;IS NORMAL SYM. +CRFOD1: MOVSI T,600000 ;ELSE DEFINING INSN. + JRST CRFEQ2 + +CRFDF2: MOVEI T,(B) ;DECIDE WHETHER DEFINING MACRO OR PSEUDO. + CAIE T,MACCL + JRST CRFOD1 +CRFMC1: SKIPA T,[500000,,] ;DEFINING MACRO. +CRFLB1: MOVSI T,440000 ;DEFINING NORMAL SYM. +CRFEQ2: PUSH P,A + MOVE A,T + JRST CRFMA1 + +;COME HERE FOR NON-DEF; MUST DECIDE WHAT TYPE SYM. +CRFUSE: TLNE C,3NCRF ;SYM MAY HAVE CREFFING SUPPRESSED. + POPJ P, + PUSH P,A + CAIN A,1 + JRST CRFMAC ;PSEUDOS, MACROS. + MOVSI A,40000 ;FLAG FOR NORMAL SYM. + TRNN C,-1 + MOVSI A,200000 ;FLAG FOR INSNS. +CRFMA1: PUSH P,A + MOVE A,CLNN + HRL A,CPGN + AOBJN A,.+1 ;A HAS PAGNUM,,LINENUM . + SKIPGE CRFILE ;IF SHOULD OUTPUT IT, + JRST CRFUS1 + CAME A,CRFLFL ;AND HAS CHANGED, DO SO. + PUSHJ P,CRFOUT + MOVEM A,CRFLFL +CRFUS1: POP P,A + IOR A,SYM ;COMBINE SYM AND CREF FLAG. + PUSHJ P,CRFOUT + JRST POPAJ + +CRFMAC: MOVEI A,(B) + CAIN A,MACCL + SKIPA A,[100000,,] ;MACRO + MOVSI A,200000 ;PSEUDO-OP. + JRST CRFMA1 + +;DEFINING OCCURRENCE, MIGHT BE ANY TYPE SYM. +CRFDF1: CAIN A,1 ;TYPE 1 => MACRO OR PSEUDO. + JRST CRFDF2 + TRNE C,-1 ;ELSE INSN OR NORMAL SYM. + JRST CRFLB1 + JRST CRFOD1 + +DEFINE CRFM %A,B,C +IF1 [ [B] + [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+CRFM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-CRFM0] +TERMIN + + +A.CRFFF: AOS (P) ;.CRFOFF - STOP CREFFING. NO VAUE. +; LOCATION, NORMAL VALUE, VALUE WHILE CREFFING +CRFOFF: CRFM CRFONP,0,-1 + CRFM CRFLBL,JFCL,[PUSHJ P,CRFLB1] + CRFM CRFEQL,JFCL,[PUSHJ P,CRFEQ1] + CRFM CRFMCD,JFCL,[PUSHJ P,CRFMC1] + CRFM CRFINU,JFCL,[PUSHJ P,CRFUSE] + CRFM CRFDEF,JFCL,[PUSHJ P,CRFDF1] + POPJ P, +CRFM0==.-CRFOFF + +CRFON: BLOCK CRFM0-1 + POPJ P, + +A.CRFN: JUMPGE FF,MACCR + SKIPE CREFP ;.CRFON, IF HAVE CREF FILE, START CREFFING. + PUSHJ P,CRFON + JRST MACCR +] ;END IFN CREFSW, + +SUBTTL TS Routines for I/O & overall control + +IFN TS,.INSRT TSRTNS + +FEED1: SKIPA B,[40] +FEED: MOVEI B,5 + JRST TFEED + +VBLK + +IFG PURESW-DECSW,[ ;PURIFICATION ROUTINE + +PURIFG: -1 ;-1 IF NOT (YET) PURIFIED +] + VARIAB +VPAT: +VPATCH: BLOCK 20 +VPATCE=.-1 + +PBLK + +CONSTANTS + +PAT: +PATCH: BLOCK 100 +PATCHE: -1 + +IFG PURESW-DECSW,[LOC <.+1777>&-2000 ;SKIP TO NEXT PAGE + MAXPUR==._-10. ;FIRST PAGE ABOVE PURE PAGES +PRINTA Pure pages = ,\MAXPUR-MINPUR +] + +VBLK +PDL: BLOCK LPDL+1 + +IFN DECDBG, DECDBB: BLOCK 8000. ;SPACE FOR DEC DDT'S SYMS. + +.NSTGW +BBKCOD==. ;BEGIN BLANK CODING, CLEARED OUT DURING INITIALIZATION +IFG PURESW-DECSW,MINBNK==<.+1777>_-10. ;FIRST PAGE OF BLANK CODE +BNKBLK ;DUMP OUT ACCUMULATED BLANK CODING + + ;NOW MORE BLANK CODING + +BKBUF: BLOCK BSIZE+5 ;CURRENT BLOCK TO OUTPUT +GLOTB: BLOCK 20 ;GLOBAL TABLE, EACH ENTRY FLAGS,,ADR OF SQUOZE (SEE COMMENTS NEAR BEGINNING) +STRSTO: BLOCK STRL ;STRING STORAGE FOR GSYL AND FRIENDS +IFN FASLP,[ +FASB: BLOCK FASBL ;OUTPUT BUFFER FOR FASL MODE + ;FIRST WD 9 FOUR BIT CODE GROUPS, REST ASSOC STUFF +FASAT: BLOCK FASATL ;ATOM TABLE FOR FASL MODE + ;EACH ENTRY CONSISTS OF ATOM IN FORMAT DESIRED BY FASLOAD, + ;NAMELY: + ; HEADER WD. RH LENGTH IN WDS + ; 4.8-4.7 TYPE 0-PN 1 FIX 2 FLO 3 BIG (NOT IMPLEMENTED) + ; FOLLOWED BY PN OR VALUE + ;-EXCEPT- IF RH OF HEADER =0, THIS SLOT RESERVED FOR LIST + +] + +EBKCOD==. ;END BLANK CODING +.YSTGW + +PRINTA ST = ,\.-RL0 + +ST: ;SYMBOL TABLE 3 WORDS/SYM FIRST SQUOZE, SECOND "VALUE", 3RD FLAGS,,BLOCK. + BLOCK NRMWPS*SYMDSZ + +;LITERALS TABLES - CAN MOVE AND GROW. THESE TAGS & LENGTHS ARE JUST THE DEFAULTS +.SEE CONTBA ;ETC, WHICH CONTAIN THE ACTUAL ADDRESSES. SO DON'T USE THEM! +CONTAB: BLOCK LCONTB ;CONSTANTS TABLE, VALUES OF CONSTANTS THIS CONSTANTS AREA +CONGLO: BLOCK LCNGLO ;CONSTANTS GLOBAL TABLE, EACH ENTRY TWO WORDS + ;FIRST WD GLOTB ENTRY. SECOND WD ADR IN CONTAB OF CONSTANT TO WHICH IT REFERS +CONBIT: BLOCK LCONTB/12.+1 ;RELOCATION BITS AND ILNOPT BIT(SEE CPTMK) + ;3 BITS FOR EACH WORD OF CONTAB. + +;;INIT ;INITIALIZATION ROUTINES (IN MACRO TABLE, GET WIPED OUT) +IFN ITSSW\TNXSW,MINMAC==./2000 ;# OF 1ST PAGE HOLDING PART OF MACTAB. + +;NOTE THAT THIS CODE IS COPIED UPWARD WHEN MACTAB IS MOVED +;DUE TO SYMTAB EXPANSION. THEREFOR IT MUST REFER TO ITSELF +;INDEXED BY THE OFFSET OF WHERE IT IS FROM WHERE IT WAS ASSEMBLED. +;THAT IS KEPT IN CH1. ALL LITERALS MUST BE USED INDEX OF CH1, TOO. + +;MAC PROC TABLES +MACTBA: 773767750000 ;MACRO CHARACTER STORAGE (FIRST WORD 3 375'S) +INIT1: MOVE CH1,MACTAD ;GET ADDR THIS CODE REALLY STARTS AT. + SUBI CH1,MACTBA ;GET OFFSET FROM WHERE ASSEMBLED. + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1](CH1) + BLT A,EBKCOD-1 ;CLEAR OUT BLANK CODING + PUSH P,[SP4](CH1) ;NOW INIT THE SYMTAB & FINISHED. + +;INITIALIZE THE SYMTAB, EXPECT SIZE IN SYMLEN. +INITS: MOVE AA,SYMLEN ;SET UP THE OTHER VARS + IMUL AA,WPSTE ;DEALING WITH SYMTAB SIZE. + MOVEM AA,SYMSIZ + ADDI AA,ST ;ADDR OF START OF CONTAB. + MOVEM AA,CONTBA + MOVEM AA,PLIM + ADD AA,CONLEN ;ADD LENGTH OF CONTAB TO GET ADDR OF CONGLO TAB. + MOVEM AA,CONTBE ;WHICH IS ALSO THE END OF CONTAB. + MOVEM AA,CONGLA + MOVEM AA,CONGOL + MOVE A,CONLEN ;ADD IN LENGTH OF CONGLO (1/4 OF CONLEN) + LSH A,-2 + ADD AA,A + MOVEM AA,CONGLE ;TO GET END OF CONGLO, AND START OF CONBIT TABLE. + MOVEM AA,CONBIA + MOVE A,CONLEN + ADDI A,11. + IDIVI A,12. + ADD AA,A ;ADD LENGTH OF CONBIT (1/12 OF CONLEN) GETTING ADDR OF MACTAB. +IFN DECSW,[ + PUSH P,AA + ADDI AA,MACL-1 + IORI AA,1777 ;FIX ALLOCATION PROBLEMS ON KI-10 + CORE AA, + ETF [ASCIZ /No core for symbols/](CH1) + REST AA +] + MOVN A,SYMLEN + HRLZM A,SYMAOB ;AOBJN -> SYMTAB. + MOVE A,WPSTE + SUBI A,1 + MOVEM A,WPSTE1 + MOVN A,WPSTE + HRRM A,WPSTEB + CAMG AA,MACTAD ;MOVED MACTAB UP? + JRST INITS1(CH1) +IFN ITSSW\TNXSW,[ ;YES, GET CORE FOR INCREASE. + PUSH P,AA + MOVEI AA,MACL+1777(AA) + LSH AA,-10. ;1ST PAGE NOT NEEDED BY MACTAB. + MOVEI A,MACL+1777+MACTBA(CH1) + LSH A,-10. ;1ST PAGE MACTAB DOESN'T YET HAVE. + SUBM A,AA ;# PAGES NEEDED. + HRLZI AA,(AA) + HRRI AA,(A) ;-<# PAGES>,,<1ST NEEDED> + JUMPGE AA,INITS3(CH1) ;DON'T CALL IF NEED 0 PAGES, WOULD GET ONE. +IFN TNXSW, PUSHJ P,TCORGT +IFN ITSSW, .CALL INITSB(CH1) ? .VALUE +INITS3: REST AA +] + SUBM AA,MACTAD ;MACTAD _ SHIFT IN START OF MACTAB. + EXCH AA,MACTAD ;MACTAD GETS NEW START, AA HAS SHIFT. + MOVSI A,PTAB-CCOMPB + ADDM AA,PTAB(A) ;RELOCATE BYTE-PTRS INTO MACTAB. + AOBJN A,.-1(CH1) + MOVNI B,INITS2(CH1) + HRROI A,@EISYMP(CH1) + ADDI B,1(A) ;GET # WDS IN SECOND HALF OF INIT CODE. + HRRM AA,.+1(CH1) ;COPY 2ND HALF UPWARD WITH POP-LOOP. + POP A,(A) ;THIS INSN IMPURE. + SOJG B,.-1(CH1) + ADDI CH1,(AA) ;CHANGE OFFSET TO PT. TO NEW LOCATIONN OF INIT CODE. + JRST INITS2(CH1) ;JUMP INTO 2ND HALF, WHERE IT'S BEEN COPIED TO. +INITS2: HRROI A,INITS2-1(CH1) ;THEN COPY 1ST HALF (WHICH ENNDS BEFORE INITS2) + SUBI A,(AA) ;GET WHERE NOW ENDS, NOT WHERE WILL END. + MOVEI B,INITS2-MACTBA ;UP UNDERNEATH THE 2ND HALF. + HRRM AA,.+1(CH1) ;(THIS TWO-STEP COPYING HANDLES ALL OVERLAPS) + POP A,(A) + SOJG B,.-1(CH1) +INITS1: MOVE AA,SYMSIZ + SETZM ST + MOVE A,[ST,,ST+1](CH1) + BLT A,ST-1(AA) ;CLEAR OUT SYMBOL TABLE + SETZM ESBK ;DEFINE THEM IN OUTER BLOCK. + MOVEI AA,ISYMTB(CH1) + MOVS F,ISMTBB(CH1) ;GET SWAPPED VALUE OF FIRST INSTRUCTION +SP3: CAIL AA,EISYM1(CH1) + JRST SP1(CH1) ;DONE WITH INSTRUCTIONS + MOVE SYM,(AA) + JUMPE SYM,SP2(CH1) + TLZ SYM,740000 + PUSHJ P,ES ;WON'T SKIP + CAIA + .VALUE ;INSTRUCTION PRESENT TWICE IN TABLE!!?!? + HRLZI T,SYMC + HRLZ B,F + MOVSI C,3KILL + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP2: ADDI F,1000 + AOJA AA,SP3(CH1) +;AFTER HACKING ALL THE INSTRUCTIONS, STORED AS JUST THE NAMES IN NUMERIC ORDER, +;HACK ALL THE OTHER PREDEFINED SYMS, STORED AS 2 WORDS (NAME ? VALUE). +EISYMP: ;MAY BE MUNGED IF MORE SYMBOLS ARE ADDED AFTER EISYMT. +SP1: CAIL AA,EISYMT(CH1) + POPJ P, + MOVE SYM,(AA) + LDB T,[400400,,SYM](CH1) + ROT T,-4 + TLZ SYM,740000 + PUSHJ P,ES + CAIA + JRST SP5(CH1) ;SYM ALREADY DEFINED? (MIGHT BE .UAI, IN ITS AND IN MIDAS). + MOVE B,1(AA) + MOVSI C,3KILL + CAME T,[GLOETY,,](CH1) ;GLOBAL ENTRIES REALLY EXITS, HACKED TO DEFEAT ADDRESS LINKING + CAMN T,[GLOEXT,,](CH1) + TLO C,3LLV + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP5: AOS AA + AOJA AA,SP1(CH1) + +IFN ITSSW,[ +INITSB: SETZ ? 'CORBLK + MOVEI %CBNDR+%CBNDW ;BOTH READ AND WRITE. + MOVEI %JSELF ? AA ;INTO SELF, AA IS AOBJN -> PAGES. + SETZI %JSNEW ;FRESH PAGES. + + ;GOBBLE SYMS FROM SYSTEM + ;TABLE AREA IN SYSTEM: + ;FIRST LOC SYSYMB + ;LAST (AS OPPOSED TO LAST + 1) SYSYME + +TSYMGT: MOVE AA,[MXICLR-MXIMAC,,MXICLR] + .CALL INITSB ;GET MACTAB PAGES NNOT LOADED INTO. + .VALUE +IFN PURESW,[ + MOVE AA,[MINBNK-MINMAC,,MINBNK] + .CALL INITSB ;GET PAGES FOR BLANK CODE & SYMTAB. + .VALUE + SKIPN PURIFG + JRST TSYMG3 + JSP F,FLSPGS ;NOT PURIFIED => FLUSH PAGES + ,,MXIMAC ;OF MACTAB CREATED BY LOADING BUT NOT NEEDED. + +TSYMG3: +] + MOVEI A,EISYMT ;EISYMT FIRST LOC FOR ITS SYMS + MOVE B,[SIXBIT /CALLS/] ;SYSTEM CALLS + .GETSYS A, ;READ IN SYSTEM CALLS (SHOULD SKIP) + .VALUE + SKIPGE A + .VALUE ;.GETSYS DIDN'T UPDATE AOBJN POINTER + HRRM A,SP1 ;MARK END OF SYMS + ANDI A,-1 + CAIL A,MACTBA+MACL + .VALUE ;MACL TOO SMALL! INITS MIGHT LOSE. + MOVEI B,EISYMT + MOVEI AA,SYMC_<-18.+4> ;SQUOZE FLAG FOR SYM +TSYMG2: DPB AA,[400400,,(B)] + ADDI B,2 + CAIE B,(A) + JRST TSYMG2 + POPJ P, +]; IFN ITSSW + +SUBTTL Purifier routines - PURIFY$G, GAPFLS$G, also DECDBM + +IFN ITSSW\TNXSW,[ +IFN PURESW,[ ;HERE ARE THE GUTS OF THE PURIFY ROUTINE + +PURIFY: SKIPL NVRRUN +IFN ITSSW,[ .VALUE [ASCIZ /:Already run +/]] +IFN TNXSW,[ + JRST [ HRROI 1,[ASCIZ /? Already run +/] + PSOUT + HALTF + JRST .+1] ; If continued, go ahead anyway. +] ;IFN TNXSW +PURIF1: MOVEI P,17 ; Start PDL at 20 + JSP F,FLSPGS ; First flush blank-code pages, + ,,MINBNK ; incl. symbol table. + JSP F,FLSPGS + ,,MXICLR ; Flush MACTAB pages created by load but not needed. + JSP F,PURIFD + ,,MINPUR ; Purify pure pages. + SETZM PURIFG ; Set "purified" flag + MOVE [1,,2] ; Now clear out remains of data of self + MOVEI 1,0 + BLT 40 +IFN ITSSW,.VALUE [ASCIZ /:Purified~pdump SYS;TS MIDAS/] +IFN TNXSW,[ + HRROI 1,[ASCIZ / Purified, now SAVE +/] + PSOUT + HALTF +] ; IFN TNXSW + +GAPFLS: JSP F,FLSPGS ; Flush gap pages created on initial load. + ,,MXIMAC +IFN ITSSW, .BREAK 16,300000 +IFN TNXSW, HALTF + + ; JSP F,FLSPGS + ; -<# pgs>,, + ; Flush pages specified by page AOBJN + +FLSPGS: MOVE A,(F) ; Get the page AOBJN +IFN ITSSW,[ + SYSCAL CORBLK,[MOVEI 0 ? MOVEI %JSELF ? A] + .LOSE 1000 +] +IFN TNXSW,[ + ASH A,1 ; Multiply # pages, page # by 2. + HLRE B,A + HRLI A,.FHSLF + MOVNS B + TLO B,(PM%CNT) ; Say hacking repeat count +FLSPG2: SYSCAL PMAP,[[-1] ? A ? B] ; Flush these pages. + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI B,-1(B) ; Else, on 10X, must iterate manually. + TRNE B,400000 ; See if became "negative". + JRST .+1 ; Yep, done with manual iteration. + AOJA A,FLSPG2] ; Nope, bump page #. +] + JRST 1(F) + + ; JSP F,PURIFD - Just like FLSPGS, but purifies the pages instead. + +PURIFD: MOVE A,(F) ; Get page AOBJN +IFN ITSSW,[ + SYSCAL CORBLK,[MOVEI %CBNDR ; Read access only. + MOVEI %JSELF ? A] + .LOSE 1000 +] +IFN TNXSW,[ + ASH A,1 ; Double everything. + HLRE B,A + MOVNS B + HRLI A,.FHSLF +PURID1: SYSCAL SPACS,[A ? [PA%RD+PA%EX]] + ADDI A,1 + SOJG B,PURID1 +] + JRST 1(F) + +IFN TNXSW,[ + + ; PURSAV - More useful hack for 10X/20X since it preserves page access +PURSV0: PUSHJ P,RDJERR +PURSAV: MOVEI P,20 + HRROI R1,[ASCIZ /Pure-Save to file: /] + PSOUT + MOVSI R1,(GJ%NEW+GJ%FOU+GJ%SHT+GJ%FNS) + MOVE R2,[.PRIIN,,.PRIOU] + GTJFN ; Get JFN from TTY + JRST PURSV0 + SETZM PURIFG ; Claim purified... + SETOM MEMDBG ; and keeping watch on memory. + HRLI R1,.FHSLF + MOVEI R2,[ + 2*<0-MINBNK>,,0+SS%RD+SS%WR+SS%EXE ; Variables/buffers + 2*,,2*MINMAC+SS%RD+SS%WR+SS%EXE ; MACTAB init + 2*,,2*MINPUR+SS%RD+SS%EXE ; Purify pure pages. + 0 ] ; End of SSAVE table + SETZ R3, + SSAVE ; Do it! + HRROI R1,[ASCIZ /Saved./] + PSOUT + HALTF +] ; IFN TNXSW + +] ; IFN PURESW +] ; IFN ITSSW\TNXSW + +IFN DECDBG,[ +DECDBM: 0 + HRLZ A,.JBSYM ;GET ADDR OF START OF DDT SYMS, + HRRI A,DECDBB+200 ;LEAVE 200 WD SPACE BEFORE THEM. + HRRM A,.JBSYM ;MOVE THEM INTO SPACE PROVIDED + HLRE B,.JBSYM + MOVMS B + BLT A,DECDBB+177(B) ;SO THEY WON'T GET IN MACTAB'S WAY. + JRST @DECDBM +] + +CONSTANTS + +;;ISYMS ;INITIAL SYMBOL TABLE + +IFNDEF JSYS,JSYS=104_33 ;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE + +ISMTBB: JSYS ;FIRST OP. CODE IN ISYMTB + +ISYMTB: + +; 104-177 (JSYS - FDVRB) + +SQUOZE 10,JSYS ;BBN PAGER INSTRUCTION +SQUOZE 10,ADJSP ;KL10 INSTRUCTION + 0 + 0 + +SQUOZE 10,DFAD ;KI10 INSTRUCTION +SQUOZE 10,DFSB ;KI10 INSTRUCTION +SQUOZE 10,DFMP ;KI10 INSTRUCTION +SQUOZE 10,DFDV ;KI10 INSTRUCTION +SQUOZE 10,DADD ;KL10 INSTRUCTION +SQUOZE 10,DSUB ;KL10 INSTRUCTION +SQUOZE 10,DMUL ;KL10 INSTRUCTION +SQUOZE 10,DDIV ;KL10 INSTRUCTION +SQUOZE 10,DMOVE ;KI10 INSTRUCTION +SQUOZE 10,DMOVN ;KI10 INSTRUCTION + +SQUOZE 10,FIX ;KI10 INSTRUCTION +SQUOZE 10,EXTEND ;KL10 INSTRUCTION +SQUOZE 10,DMOVEM ;KI10 INSTRUCTION +SQUOZE 10,DMOVNM ;KI10 INSTRUCTION +SQUOZE 10,FIXR ;KI10 INSTRUCTION +SQUOZE 10,FLTR ;KI10 INSTRUCTION + +SQUOZE 10,UFA ;KA/KI10 INSTRUCTION +SQUOZE 10,DFN ;KA/KI10 INSTRUCTION +SQUOZE 10,FSC + +SQUOZE 10,IBP +SQUOZE 10,ILDB +SQUOZE 10,LDB +SQUOZE 10,IDPB +SQUOZE 10,DPB + +SQUOZE 10,FAD +SQUOZE 10,FADL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FADM +SQUOZE 10,FADB +SQUOZE 10,FADR +SQUOZE 10,FADRI ;PDP10 INSTRUCTION +SQUOZE 10,FADRM +SQUOZE 10,FADRB +SQUOZE 10,FSB +SQUOZE 10,FSBL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FSBM +SQUOZE 10,FSBB +SQUOZE 10,FSBR +SQUOZE 10,FSBRI ;PDP10 INSTRUCTION +SQUOZE 10,FSBRM +SQUOZE 10,FSBRB +SQUOZE 10,FMP +SQUOZE 10,FMPL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FMPM +SQUOZE 10,FMPB +SQUOZE 10,FMPR +SQUOZE 10,FMPRI ;PDP10 INSTRUCTION +SQUOZE 10,FMPRM +SQUOZE 10,FMPRB +SQUOZE 10,FDV +SQUOZE 10,FDVL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FDVM +SQUOZE 10,FDVB +SQUOZE 10,FDVR +SQUOZE 10,FDVRI ;PDP10 INSTRUCTION +SQUOZE 10,FDVRM +SQUOZE 10,FDVRB + +; 200-277 (MOVE - SUBB) + +SQUOZE 10,MOVE +SQUOZE 10,MOVEI +SQUOZE 10,MOVEM +SQUOZE 10,MOVES +SQUOZE 10,MOVS +SQUOZE 10,MOVSI +SQUOZE 10,MOVSM +SQUOZE 10,MOVSS +SQUOZE 10,MOVN +SQUOZE 10,MOVNI +SQUOZE 10,MOVNM +SQUOZE 10,MOVNS +SQUOZE 10,MOVM +SQUOZE 10,MOVMI +SQUOZE 10,MOVMM +SQUOZE 10,MOVMS + +SQUOZE 10,IMUL +SQUOZE 10,IMULI +SQUOZE 10,IMULM +SQUOZE 10,IMULB +SQUOZE 10,MUL +SQUOZE 10,MULI +SQUOZE 10,MULM +SQUOZE 10,MULB +SQUOZE 10,IDIV +SQUOZE 10,IDIVI +SQUOZE 10,IDIVM +SQUOZE 10,IDIVB +SQUOZE 10,DIV +SQUOZE 10,DIVI +SQUOZE 10,DIVM +SQUOZE 10,DIVB + +SQUOZE 10,ASH +SQUOZE 10,ROT +SQUOZE 10,LSH +SQUOZE 10,JFFO ;PDP10 INSTRUCTION +SQUOZE 10,ASHC +SQUOZE 10,ROTC +SQUOZE 10,LSHC +SQUOZE 10,CIRC ;AI PDP10 INST. CIRCULATE: ROTC WITH AC+1 GOING THE WRONG WAY + +SQUOZE 10,EXCH +SQUOZE 10,BLT +SQUOZE 10,AOBJP +SQUOZE 10,AOBJN +SQUOZE 10,JRST +SQUOZE 10,JFCL +SQUOZE 10,XCT +SQUOZE 10,MAP ;KI10 INSTRUCTION + +SQUOZE 10,PUSHJ +SQUOZE 10,PUSH +SQUOZE 10,POP +SQUOZE 10,POPJ +SQUOZE 10,JSR +SQUOZE 10,JSP +SQUOZE 10,JSA +SQUOZE 10,JRA + +SQUOZE 10,ADD +SQUOZE 10,ADDI +SQUOZE 10,ADDM +SQUOZE 10,ADDB +SQUOZE 10,SUB +SQUOZE 10,SUBI +SQUOZE 10,SUBM +SQUOZE 10,SUBB + +; 300-377 (CAI - SOSG) + +SQUOZE 10,CAI +SQUOZE 10,CAIL +SQUOZE 10,CAIE +SQUOZE 10,CAILE +SQUOZE 10,CAIA +SQUOZE 10,CAIGE +SQUOZE 10,CAIN +SQUOZE 10,CAIG +SQUOZE 10,CAM +SQUOZE 10,CAML +SQUOZE 10,CAME +SQUOZE 10,CAMLE +SQUOZE 10,CAMA +SQUOZE 10,CAMGE +SQUOZE 10,CAMN +SQUOZE 10,CAMG + +SQUOZE 10,JUMP +SQUOZE 10,JUMPL +SQUOZE 10,JUMPE +SQUOZE 10,JUMPLE +SQUOZE 10,JUMPA +SQUOZE 10,JUMPGE +SQUOZE 10,JUMPN +SQUOZE 10,JUMPG +SQUOZE 10,SKIP +SQUOZE 10,SKIPL +SQUOZE 10,SKIPE +SQUOZE 10,SKIPLE +SQUOZE 10,SKIPA +SQUOZE 10,SKIPGE +SQUOZE 10,SKIPN +SQUOZE 10,SKIPG + +SQUOZE 10,AOJ +SQUOZE 10,AOJL +SQUOZE 10,AOJE +SQUOZE 10,AOJLE +SQUOZE 10,AOJA +SQUOZE 10,AOJGE +SQUOZE 10,AOJN +SQUOZE 10,AOJG +SQUOZE 10,AOS +SQUOZE 10,AOSL +SQUOZE 10,AOSE +SQUOZE 10,AOSLE +SQUOZE 10,AOSA +SQUOZE 10,AOSGE +SQUOZE 10,AOSN +SQUOZE 10,AOSG +SQUOZE 10,SOJ +SQUOZE 10,SOJL +SQUOZE 10,SOJE +SQUOZE 10,SOJLE +SQUOZE 10,SOJA +SQUOZE 10,SOJGE +SQUOZE 10,SOJN +SQUOZE 10,SOJG +SQUOZE 10,SOS +SQUOZE 10,SOSL +SQUOZE 10,SOSE +SQUOZE 10,SOSLE +SQUOZE 10,SOSA +SQUOZE 10,SOSGE +SQUOZE 10,SOSN +SQUOZE 10,SOSG + +; 400-477 (SETZ - SETOB) + +SQUOZE 10,SETZ +SQUOZE 10,SETZI +SQUOZE 10,SETZM +SQUOZE 10,SETZB +SQUOZE 10,AND +SQUOZE 10,ANDI +SQUOZE 10,ANDM +SQUOZE 10,ANDB +SQUOZE 10,ANDCA +SQUOZE 10,ANDCAI +SQUOZE 10,ANDCAM +SQUOZE 10,ANDCAB +SQUOZE 10,SETM +SQUOZE 10,SETMI +SQUOZE 10,SETMM +SQUOZE 10,SETMB +SQUOZE 10,ANDCM +SQUOZE 10,ANDCMI +SQUOZE 10,ANDCMM +SQUOZE 10,ANDCMB +SQUOZE 10,SETA +SQUOZE 10,SETAI +SQUOZE 10,SETAM +SQUOZE 10,SETAB +SQUOZE 10,XOR +SQUOZE 10,XORI +SQUOZE 10,XORM +SQUOZE 10,XORB +SQUOZE 10,IOR +SQUOZE 10,IORI +SQUOZE 10,IORM +SQUOZE 10,IORB +SQUOZE 10,ANDCB +SQUOZE 10,ANDCBI +SQUOZE 10,ANDCBM +SQUOZE 10,ANDCBB +SQUOZE 10,EQV +SQUOZE 10,EQVI +SQUOZE 10,EQVM +SQUOZE 10,EQVB +SQUOZE 10,SETCA +SQUOZE 10,SETCAI +SQUOZE 10,SETCAM +SQUOZE 10,SETCAB +SQUOZE 10,ORCA +SQUOZE 10,ORCAI +SQUOZE 10,ORCAM +SQUOZE 10,ORCAB +SQUOZE 10,SETCM +SQUOZE 10,SETCMI +SQUOZE 10,SETCMM +SQUOZE 10,SETCMB +SQUOZE 10,ORCM +SQUOZE 10,ORCMI +SQUOZE 10,ORCMM +SQUOZE 10,ORCMB +SQUOZE 10,ORCB +SQUOZE 10,ORCBI +SQUOZE 10,ORCBM +SQUOZE 10,ORCBB +SQUOZE 10,SETO +SQUOZE 10,SETOI +SQUOZE 10,SETOM +SQUOZE 10,SETOB + +; 500-577 (HLL - HLRES) + +SQUOZE 10,HLL +SQUOZE 10,HLLI +SQUOZE 10,HLLM +SQUOZE 10,HLLS +SQUOZE 10,HRL +SQUOZE 10,HRLI +SQUOZE 10,HRLM +SQUOZE 10,HRLS +SQUOZE 10,HLLZ +SQUOZE 10,HLLZI +SQUOZE 10,HLLZM +SQUOZE 10,HLLZS +SQUOZE 10,HRLZ +SQUOZE 10,HRLZI +SQUOZE 10,HRLZM +SQUOZE 10,HRLZS +SQUOZE 10,HLLO +SQUOZE 10,HLLOI +SQUOZE 10,HLLOM +SQUOZE 10,HLLOS +SQUOZE 10,HRLO +SQUOZE 10,HRLOI +SQUOZE 10,HRLOM +SQUOZE 10,HRLOS +SQUOZE 10,HLLE +SQUOZE 10,HLLEI +SQUOZE 10,HLLEM +SQUOZE 10,HLLES +SQUOZE 10,HRLE +SQUOZE 10,HRLEI +SQUOZE 10,HRLEM +SQUOZE 10,HRLES +SQUOZE 10,HRR +SQUOZE 10,HRRI +SQUOZE 10,HRRM +SQUOZE 10,HRRS +SQUOZE 10,HLR +SQUOZE 10,HLRI +SQUOZE 10,HLRM +SQUOZE 10,HLRS +SQUOZE 10,HRRZ +SQUOZE 10,HRRZI +SQUOZE 10,HRRZM +SQUOZE 10,HRRZS +SQUOZE 10,HLRZ +SQUOZE 10,HLRZI +SQUOZE 10,HLRZM +SQUOZE 10,HLRZS +SQUOZE 10,HRRO +SQUOZE 10,HRROI +SQUOZE 10,HRROM +SQUOZE 10,HRROS +SQUOZE 10,HLRO +SQUOZE 10,HLROI +SQUOZE 10,HLROM +SQUOZE 10,HLROS +SQUOZE 10,HRRE +SQUOZE 10,HRREI +SQUOZE 10,HRREM +SQUOZE 10,HRRES +SQUOZE 10,HLRE +SQUOZE 10,HLREI +SQUOZE 10,HLREM +SQUOZE 10,HLRES + +; 600-677 (TRN - TSON) + +SQUOZE 10,TRN +SQUOZE 10,TLN +SQUOZE 10,TRNE +SQUOZE 10,TLNE +SQUOZE 10,TRNA +SQUOZE 10,TLNA +SQUOZE 10,TRNN +SQUOZE 10,TLNN +SQUOZE 10,TDN +SQUOZE 10,TSN +SQUOZE 10,TDNE +SQUOZE 10,TSNE +SQUOZE 10,TDNA +SQUOZE 10,TSNA +SQUOZE 10,TDNN +SQUOZE 10,TSNN +SQUOZE 10,TRZ +SQUOZE 10,TLZ +SQUOZE 10,TRZE +SQUOZE 10,TLZE +SQUOZE 10,TRZA +SQUOZE 10,TLZA +SQUOZE 10,TRZN +SQUOZE 10,TLZN +SQUOZE 10,TDZ +SQUOZE 10,TSZ +SQUOZE 10,TDZE +SQUOZE 10,TSZE +SQUOZE 10,TDZA +SQUOZE 10,TSZA +SQUOZE 10,TDZN +SQUOZE 10,TSZN +SQUOZE 10,TRC +SQUOZE 10,TLC +SQUOZE 10,TRCE +SQUOZE 10,TLCE +SQUOZE 10,TRCA +SQUOZE 10,TLCA +SQUOZE 10,TRCN +SQUOZE 10,TLCN +SQUOZE 10,TDC +SQUOZE 10,TSC +SQUOZE 10,TDCE +SQUOZE 10,TSCE +SQUOZE 10,TDCA +SQUOZE 10,TSCA +SQUOZE 10,TDCN +SQUOZE 10,TSCN +SQUOZE 10,TRO +SQUOZE 10,TLO +SQUOZE 10,TROE +SQUOZE 10,TLOE +SQUOZE 10,TROA +SQUOZE 10,TLOA +SQUOZE 10,TRON +SQUOZE 10,TLON +SQUOZE 10,TDO +SQUOZE 10,TSO +SQUOZE 10,TDOE +SQUOZE 10,TSOE +SQUOZE 10,TDOA +SQUOZE 10,TSOA +SQUOZE 10,TDON +SQUOZE 10,TSON + +EISYM1: + +; I/O INSTRUCTIONS + +SQUOZE 4,BLKI +BLKI IOINST +SQUOZE 4,DATAI +DATAI IOINST +SQUOZE 4,BLKO +BLKO IOINST +SQUOZE 4,DATAO +DATAO IOINST +SQUOZE 4,CONO +CONO IOINST +SQUOZE 4,CONI +CONI IOINST +SQUOZE 4,CONSZ +CONSZ IOINST +SQUOZE 4,CONSO +CONSO IOINST + +;EXTEND MNEMONICS + +SQUOZE 10,CMPSL +001000,, +SQUOZE 10,CMPSE +002000,, +SQUOZE 10,CMPSLE +003000,, +SQUOZE 10,EDIT +004000,, +SQUOZE 10,CMPSGE +005000,, +SQUOZE 10,CMPSN +006000,, +SQUOZE 10,CMPSG +007000,, +SQUOZE 10,CVTDBO +010000,, +SQUOZE 10,CVTDBT +011000,, +SQUOZE 10,CVTBDO +012000,, +SQUOZE 10,CBTBDT +013000,, +SQUOZE 10,MOVSO +014000,, +SQUOZE 10,MOVST +015000,, +SQUOZE 10,MOVSLJ +016000,, +SQUOZE 10,MOVSRJ +017000,, +SQUOZE 10,XBLT +020000,, + +;OLD PROGRAMS USE THESE NAMES + +SQUOZE 10,CLEAR +SETZ +SQUOZE 10,CLEARI +SETZI +SQUOZE 10,CLEARM +SETZM +SQUOZE 10,CLEARB +SETZB + +;RANDOM ALIAS NAMES + +SQUOZE 10,ADJBP ;KL10 FORM OF IBP WITH VARIABLE NUMBER TO INCREMENT +IBP +SQUOZE 10,JFOV ;PDP10 INSTRUCTION (PC CHANGE ON PDP6) +JFCL 1, +SQUOZE 10,JCRY1 +JFCL 2, +SQUOZE 10,JCRY0 +JFCL 4, +SQUOZE 10,JCRY +JFCL 6, +SQUOZE 10,JOV +JFCL 10, +SQUOZE 10,PORTAL ;KI10 INSTRUCTION +JRST 1, +SQUOZE 10,JRSTF +JRST 2, +SQUOZE 10,HALT +JRST 4, +SQUOZE 10,XJRSTF ;KL10 INSTRUCTION +JRST 5, +SQUOZE 10,XJEN ;KL10 INSTRUCTION +JRST 6, +SQUOZE 10,XPCW ;KL10 INSTRUCTION +JRST 7, +SQUOZE 10,JEN +JRST 12, +SQUOZE 10,SFM ;KL10 INSTRUCTION +JRST 14, +SQUOZE 10,XMOVEI ;KL10 INSTRUCTION +SETMI +SQUOZE 10,XHLLI ;KL10 INSTRUCTION +HLLI + +;PDP6 HAS LONG FORM ROUNDED INSTEAD OF IMMEDIATES + +IRPS INST,,FAD FSB FMP FDV + SQUOZE 10,INST!RL + INST!RI +TERMIN + +DEFINE DEFSYM X/ + IRPS Z,,[X] + SQUOZE 10,Z + Z + .ISTOP + TERMIN +TERMIN + +IFN DECSW,[ +IFE CVTSW,[ +.DECDF DEFSYM + +IFN DECBSW,.INSRT DECBTS +];IFE CVTSW +IFN CVTSW,[ +.INSRT DECDFS +];IFN CVTSW +] ;IFN DECSW + +IFN TNXSW,[;; DEFINE JSYS'S ON TENEX VERSION +IFE CVTSW,[ +.TNXJS DEFSYM +.INSRT TWXBTS +];IFE CVTSW +IFN CVTSW,[ +.INSRT TNXDFS +];IFN CVTSW +] ;IFN TNXSW + +SQUOZE 10,.OSMID ; Crock here - in TNX version, SITINI sets value at +OSMID: OSMIDAS ; runtime before syms spread. +SQUOZE 4,.SITE +A.SITE +SQUOZE 4,RIM10 +ARIM10,,SRIM +SQUOZE 4,SBLK +SBLKS,,SRIM +SQUOZE 4,RIM +ARIM,,SRIM +SQUOZE 4,SQUOZE +ASQOZ +SQUOZE 4,.RSQZ +-1,,ASQOZ +SQUOZE 4,XWD +AXWORD +SQUOZE 4,CONSTA +CNSTNT +SQUOZE 4,ASCIC +EOFCH,,AASCIZ +SQUOZE 4,RADIX +ARDIX + +SQUOZE 4,END +AEND +SQUOZE 4,TITLE +ATITLE +SQUOZE 4,.BEGIN +A.BEGIN +SQUOZE 4,.END +A.END +SQUOZE 4,VARIAB +AVARIAB +SQUOZE 4,SIXBIT +ASIXBIT +SQUOZE 4,ASCII +AASCII +SQUOZE 4,ASCIZ +AASCIZ +SQUOZE 4,.ASCII +A.ASCII +SQUOZE 4,.ASCVL +A.ASCV +SQUOZE 4,BLOCK +ABLOCK +SQUOZE 4,LOC +ALOC +SQUOZE 4,OFFSET +AOFFSET +SQUOZE 4,.SBLK +SIMBLK +SQUOZE 4,RELOCA +ARELOCA +SQUOZE 4,1PASS +A1PASS +SQUOZE 4,.DECSA +A.DECSA +SQUOZE 4,.DECRE +A.DECRE +SQUOZE 4,.DECTX +A.DCTX + +SQUOZE 4,.DECTW +A.DECTW +SQUOZE 4,NOSYMS +ANOSYMS +SQUOZE 4,EXPUNGE +AEXPUNGE +SQUOZE 4,EQUALS +AEQUALS +SQUOZE 4,NULL +ANULL +SQUOZE 4,SUBTTL +ANULL +SQUOZE 4,WORD +AWORD +SQUOZE 4,.SYMTAB +A.SYMTAB +SQUOZE 4,.SEE +A.SEE +SQUOZE 4,.AUXIL +MACCR +SQUOZE 4,.MRUNT +A.MRUNT +SQUOZE 4,.SYMCN +A.SYMC +SQUOZE 4,.TYPE +A.TYPE +SQUOZE 4,.FORMAT +A.FORMAT +SQUOZE 4,.OP +A.OP +SQUOZE 4,.AOP +A.AOP +SQUOZE 4,.RADIX +A.RADIX +SQUOZE 4,.FATAL +A.FATAL +SQUOZE 4,.BP +A.BP +SQUOZE 4,.BM +A.BM +SQUOZE 4,.LZ +A.LZ +SQUOZE 4,.TZ +A.TZ +SQUOZE 4,.DPB +A.DPB +SQUOZE 4,.LDB +A.LDB +SQUOZE 4,.IBP +A.IBP +SQUOZE 4,.1STWD +A.1STWD +SQUOZE 4,.NTHWD +A.NTHWD + +IRPS X,,[.BIND=0,.KILL=3KILL,.HKILL=3SKILL,.XCREF=3NCRF,.DOWN=3DOWN] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,A.KILL +TERMIN + +SQUOZE 4,.LSTON +A.LSTN +SQUOZE 4,.LSTOF +A.LSTF + +IRPS X,,[.MLLIT=CONSML,.PASS=A.PASS,.PPASS=A.PPASS,.SUCCESS=A.SUCCESS +.HKALL=HKALL,.STGSW=STGSW,.LITSW=LITSW,.AVAL1=AVAL1,.AVAL2=AVAL2,.ERRCNT=ERRCNT +.ASKIP=A.ASKIP,.CURLN=CLNN,.CURPG=CPGN,.QMTCH=QMTCH,.STPLN=A.STPLN,.STPPG=A.STPPG] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,INTSYM +TERMIN + +;CONDITIONALS (SEE ALSO IFSE, IFSN) + +SQUOZE 4,IFG +JUMPG A,COND +SQUOZE 4,IFGE +JUMPGE A,COND +SQUOZE 4,IFE +JUMPE A,COND +SQUOZE 4,IFLE +JUMPLE A,COND +SQUOZE 4,IFL +JUMPL A,COND +SQUOZE 4,IFN +JUMPN A,COND +SQUOZE 4,.ELSE +SKIPE A.ELSE +SQUOZE 4,.ALSO +SKIPN A.ELSE + +SQUOZE 4,IF1 +TRNE FF,COND1 +SQUOZE 4,IF2 +TRNN FF,COND1 +SQUOZE 4,IFDEF ;ASSEMBLE IF SYM DEFINED +JUMPG A,DEFCND +SQUOZE 4,IFNDEF ;ASSEMBLE IF SYM NOT DEFINED +JUMPE A,DEFCND +SQUOZE 4,IFB ;ASSEMBLE IF STRING BLANK (HAS NO SQUOZE CHARS) +JUMPLE C,SBCND +SQUOZE 4,IFNB ;ASSEMBLE IF STRING NOT BLANK +JUMPG C,SBCND +SQUOZE 4,IFSQ ;ASSEMBLE IF STRING ARG IS ALL SQUOZE +JUMPLE B,SBCND +SQUOZE 4,IFNSQ ;ASSEMBLE IF STRING ARG IS NOT ALL SQUOZE. +JUMPG B,SBCND + +SQUOZE 4,PRINTX +APRIN2,,APRINT +SQUOZE 4,PRINTC +APRIN3,,APRINT +SQUOZE 4,COMMEN +APRIN1,,APRINT +SQUOZE 4,.TYO +A.TYO +SQUOZE 4,.TYO6 +A.TYO6 +SQUOZE 4,.ERR +A.ERR + +SQUOZE 4,.RELP +A.RELP +SQUOZE 4,.ABSP +A.ABSP +SQUOZE 4,.RL1 +A.RL1 +SQUOZE 4,.LIBRA +LLIB,,A.LIB +SQUOZE 4,.LENGTH +A.LENGTH +SQUOZE 4,.LIFS +LTCP,,A.LIB +SQUOZE 4,.ELDC +A.ELDC +IRPS A,,E N G LE GE L +SQUOZE 4,.LIF!A +JUMP!A A.LDCV +TERMIN +SQUOZE 4,.SLDR +A.SLDR + +SQUOZE 4,. +GTVLP +SQUOZE 4,.LOP +A.LOP +SQUOZE 40,$. +0 +SQUOZE 44,$R. +0 +SQUOZE 40,$O. ;(OH) GLOBAL OFFSET +0 +SQUOZE 40,$L. ;REAL LOCATION (WITHOUT OFFSET) +0 +SQUOZE 40,.LVAL1 +0 +SQUOZE 40,.LVAL2 +0 +SQUOZE 4,.LNKOT +A.LNKOT +SQUOZE 4,.NSTGW +1,,STGWS +SQUOZE 4,.YSTGW +-1,,STGWS +SQUOZE 4,.LIBRQ +A.LIBRQ +SQUOZE 4,.GLOBAL +ILGLI,,A.GLOB +SQUOZE 4,.SCALAR +ILVAR,,A.GLOB +SQUOZE 4,.VECTOR +ILVAR\ILFLO,,A.GLOB + +SQUOZE 4,.BYTC +NBYTS,,INTSYM +SQUOZE 4,.BYTE +A.BYTE +SQUOZE 4,.WALGN +A.WALGN + +;CREF PSEUDO-OPS. +SQUOZE 4,.CRFON +A.CRFN ;START CREFFING. +SQUOZE 4,.CRFOFF +A.CRFFF ;STOP CREFFING. +SQUOZE 4,.CRFIL +CRFILE,,INTSYM + +IFE CREFSW,[ + A.CRFN==ASSEM1 ;THESE DO NOTHING IF CAN'T CREF. + A.CRFFF==ASSEM1 +] + +IFN MACSW,[ ;MACRO PROCESSOR PSEUDOS +;MACROS GET DEFINED AS +;SQUOZE 4, +;,, MACCL + +SQUOZE 4,REPEAT +AREPEAT +SQUOZE 4,DEFINE +ADEFINE +SQUOZE 4,IRP +NIRPO,,AIRP +SQUOZE 4,IRPC +NIRPC,,AIRP +SQUOZE 4,IRPS +NIRPS,,AIRP +SQUOZE 4,IRPW +NIRPW,,AIRP +SQUOZE 4,IRPNC +NIRPN,,AIRP +SQUOZE 4,TERMIN +ATERMIN +SQUOZE 4,.QUOTE +A.QOTE +SQUOZE 4,.STOP +(400000)A.STOP +SQUOZE 4,.ISTOP +A.STOP +SQUOZE 4,.RPCNT +CRPTCT,,INTSYM +SQUOZE 4,.GSSET +A.GSSET +SQUOZE 4,.GSCNT +GENSM,,INTSYM +SQUOZE 4,.GO +A.GO +SQUOZE 4,.TAG +A.TAG +SQUOZE 4,.IRPCNT +CIRPCT,,INTSYM +IFN RCHASW,[SQUOZE 4,.TTYMAC +A.TTYM +] +SQUOZE 4,IFSE +SKIPN SCOND +SQUOZE 4,IFSN +SKIPE SCOND +] + +IFN FASLP,[ +SQUOZE 4,.FASL +A.FASL +SQUOZE 4,.ARRAY ;3 INDEX TO AFDMY1 TBL +AFATOM(3) +SQUOZE 4,.ATOM +AFATOM(AFDMAI) ;2 INDEX TO AFDMY1 TBL +AFDMAI==2 ;INDEX OF ATOM IN AFDMY1 TBL +SQUOZE 4,.FUNCT +AFATOM(1) ;1 " " " " +SQUOZE 4,.SPECI +AFATOM(0) ;0 " " " " +SQUOZE 4,.SX +AFLIST(1) ;NORMAL LIST +SQUOZE 4,.SXEVA +AFLIST ;EVAL LIST AND THROW VALUE AWAY +SQUOZE 4,.SXE +AFLIST(2) ;EVAL LIST AND "RETURN" VALUE +SQUOZE 4,.ENTRY +AFENTY ;DECLARE LISP ENTRY POINT (SUBR ETC) +] + +IFN TS,[ +SQUOZE 4,.FNAM1 +RFNAM1,,INTSYM +SQUOZE 4,.FNAM2 +RFNAM2,,INTSYM +SQUOZE 4,.FVERS +RFVERS,,INTSYM +SQUOZE 4,.INSRT +A.INSRT +SQUOZE 4,.INEOF +A.INEO +IRPS X,,I O + IRPS Y,,1 2 + SQUOZE 4,.!X!FNM!Y + X!FNM!Y,,INTSYM +TERMIN TERMIN +SQUOZE 4,.IFVRS +IFVRS,,INTSYM +SQUOZE 4,.TTYFLG +A.TTYFLG,,INTSYM +] +IFN .I.FSW,[ +SQUOZE 4,.F +A.F +SQUOZE 4,.I +A.I +] +IFN ITSSW,[ +IRPS X,,UAI UAO BAI BAO UII UIO BII BIO +SQUOZE 10,.!X +.IRPCN +TERMIN + +IRPS X,Y,START LFILE STP+SYM JCL PFILE STB CONV+XUNAME XJNAME LJB+ + SQUOZE 10,..R!X + .IRPCN+1 +IFSN Y,+,[ + SQUOZE 10,..S!X + 400000+.IRPCN+1 +] TERMIN +] + +EISYMT: PRINTA \.-MACTBA-1, words initialization coding. + VARIAB +IFN .-EISYMT,.ERR Non-empty variables area + +IFN DECSW,[ + IFGE .-MACTBA-MACL,[ +IFN MACL, PRINTA [MACL too small, set to ]\.-MACTBA + MACL==.-MACTBA +]] + +IFN ITSSW\TNXSW,[ +IFGE .+2400-MACTBA-MACL,.ERR MACL too small + LOC <.+1777>&-2000 +MXICLR==./2000 ;FIRST PAGE ABOVE INITIALIZING CODING + LOC &-2000 +MXIMAC==./2000 ;FIRST PAGE ABOVE INITIAL MACTBA +MAXMAC==/2000 + ;1ST PAGE MACRO TABLE CAN'T POSSIBLY USE. +IFLE MINPUR-MAXMAC,.ERR Pure too low. +PRINTA MINPUR-MAXMAC = ,\MINPUR-MAXMAC +] + +IFN TS,END BEG +END diff --git a/src/midas/midas.433 b/src/midas/midas.433 new file mode 100755 index 00000000..e0ce7e5a --- /dev/null +++ b/src/midas/midas.433 @@ -0,0 +1,11985 @@ +; -*-MIDAS-*- +IFE .OSMIDAS-SIXBIT/DEC/,.SYMTAB 4973.,2000. ;THIS MANY ON DEC SYSTEM +.ELSE .SYMTAB 10007. ;Assemble faster elsewhere. + +TITLE MIDAS +SUBTTL INITIAL DEFINITIONS + +; AC DEFINITIONS. FF AND P MUST BE 0 AND 17 RESPECTIVELY, OTHERWISE +; ONLY CONSTRAINTS ARE EXPRESSED AS SEQUENTIAL ORDERINGS, E.G. B+1 ETC. +; ALSO, +.SEE R1 + +FF=:0 ; FLAGS. MUST BE AC 0. +AA=:1 ; GENERAL PURPOSE REGS, MUST BE SEQUENTIAL. +A=:AA+1 ; 2 +B=:A+1 ; 3 +C=:B+1 ; 4 +D=:C+1 ; 5 +T=:6 ; NOT SO TEMP AS IN MOST PROGS W/ T +TT=:T+1 ; 7 +I=:10 ; INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF +SYM=:11 ; FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR +LINK=:SYM+1 +F=:13 +CH1=:14 ; MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH +CH2=:CH1+1 ;" " " +TM=:16 ; SUPER TEMPORARY +P=:17 ; PDL AC, MUST BE 17. AS WELL AS RANDOM CROCKS IN PROGRAM, 20X ERCAL + ; ASSUMES P=17. + + +IFDEF .XCREF, .XCREF FF,P,I,A,B,C,D,T + +;OPERATING SYSTEM CONDITIONAL FLAGS: +; ITSSW IS 1 IF TO RUN ON ITS. +; DECSW IS 1 IF TO RUN ON ANY SORT OF BOTTOMS-10 (INCL. SAIL AND CMU). +; TNXSW IS 1 IF TO RUN ON TENEX OR TWENEX. +; SAILSW IS 1 IF TO RUN ON SAIL, AS OPPOSED TO OTHER BOTS-10. +; CMUSW IS 1 IF TO RUN AT CMU, AS OPPOSED TO OTHER BOTS-10. +; DECDBG IS 1 (ONLY WHEN DECSW IS 1) TO LEAVE SPACE FOR SYMBOL TABLE +; TO BE MOVED TO AFTEREXECUTION IS STARTED. +; DECBSW IS 1 TO PUT DECBTS IN THE PREDEFINED SYMBOL TABLE (ONLY IF DECSW IS 1). +; SMALSW IS 1 TO OCCUPY AS LITTLE CORE AS POSSIBLE. +; TS IS 1 EXCEPT FOR NON-TIMESHARED VERSION (WHICH IS OBSOLETE). +; CVTSW IS TO MAKE A MIDAS USING A DECDFS OR TNXDFS FILE GENERATED BY CVT. +; CVT READS A MONSYM FILE AND MAKES A TNXDFS.MID FILE, ALTHOUGH IT COULD +; BE HACKED TO READ UUOSYM AND MAKE DECDFS TOO. THERE IS NO SEPARATE +; DECBTS OR TWXBTS FILE WHEN USING CVT. + +IF1,[ ;FOR PASS 1 TTY CONDITIONALS +IFDEF SAILSW,IFN SAILSW,DECSW==1 +IFDEF CMUSW,IFN CMUSW,DECSW==1 +IFDEF DECDBG,IFN DECDBG,DECSW==1 +IFDEF DECSW,IFN DECSW,DECSW==1 ? ITSSW==0 ? TNXSW==0 +IFDEF ITSSW,IFN ITSSW,ITSSW==1 ? DECSW==0 ? TNXSW==0 +IFDEF TNXSW,IFN TNXSW,TNXSW==1 ? DECSW==0 ? ITSSW==0 +] ; IF1 +IFNDEF ITSSW,ITSSW==IFDEF .IOT,[1] .ELSE 0 ;NON-ZERO => ITS VERSION +IFNDEF TNXSW,TNXSW==IFDEF GTJFN,[1] .ELSE 0 ;NON-ZERO => TENEX VERSION +IFNDEF DECSW,DECSW==IFDEF LOOKUP,[1-TNXSW] .ELSE 0 ;NON-ZERO => DEC VERSION + ; TNXSW SINCE OLD VERSIONS OF TENEX MIDAS HAD DEC + ; UUO'S DEFINED TOO ONCE UPON A TIME +IF1 IFN ITSSW+DECSW+TNXSW-1,.FATAL So what monitor is MIDAS supposed to run under? +IFNDEF DECDBG,DECDBG==0 ;NON-ZERO => DEC VERSION TO RUN WITH DEC DDT. +IFN DECSW,[ +IFNDEF SAILSW,SAILSW==IFDEF SPCWAR,[1] .ELSE 0 ;NON-ZERO => SAIL VERSION. +IFNDEF CMUSW,CMUSW==IFDEF CMUDEC,[1] .ELSE 0 ;NON-ZERO => CMU VERSION. +] +IFE DECSW,SAILSW==0 ? CMUSW==0 ;CAN'T BE SAIL OR CMU FOR ITS OR TENEX VERSION +IFNDEF SMALSW,SMALSW==DECSW- ;NON-ZERO => SMALL MIDAS (NORMALLY + ; FOR RANDOM DEC SITES ONLY) +IFNDEF DECBSW,DECBSW==DECSW*<1-SAILSW>*<1-SMALSW> + ;NON-ZERO => INCLUDE DECBTS +IFNDEF CVTSW,CVTSW==0 ;NON-ZERO => BITS DEFINITIONS COME FROM FILES + ; MADE USING CVT +IFN ITSSW\DECSW\TNXSW,TS==1 +IFNDEF TS,TS==1 ;NON-ZERO => TIME-SHARING VERSION +IFE TS,1PASS +IFNDEF A1PSW, A1PSW==TS ;NON-ZERO => 1PASS END-OF-PROGRAM AUTO-REASSEMBLY +IFNDEF BRCFLG, BRCFLG==0 ;NON-ZERO => BRACES { AND } ARE SPECIAL IN MACRO + ; ARGS, ETC. JUST LIKE BRACKETS. BRACES ARE SPECIAL + ; IN CONDITIONALS REGARDLESS OF BRCFLG. +IFNDEF CREFSW, CREFSW==ITSSW ;NON-ZERO => ALLOW C SWITCH TO CAUSE CREF OUTPUT. +IFNDEF LISTSW, LISTSW==1 ;NON-ZERO => ALLOW L SWITCH TO CAUSE A LISTING. +IFNDEF RCHASW, RCHASW==TS ;NON-ZERO => INCLUDE TTY AS POSSIBLE INPUT DEVICE +IFNDEF PURESW, PURESW==TS-SAILSW ;NON-ZERO => SEPARATE PURE CODING FROM IMPURE AND + ; DO PAGE SKIPS. TWO SEGMENTS HURTS EFFICIENCY AT SAIL. +IFNDEF FASLP, FASLP==1-SMALSW ;NON-ZERO => INCLUDE FASL OUTPUT CAPABILITY + ; NOTE!! IF RUNNING UNDER 10/50 THIS MAKES THINGS + ; SEVERAL K BIGGER THAN OTHERWISE. +IFNDEF .I.FSW, .I.FSW==1-SMALSW;NON-ZERO => INCLUDE .I, .F +IFNDEF MACSW, MACSW==1 ;NON-ZERO => INCLUDE MACRO PROCESSOR (!) +IFNDEF RUNTSW, RUNTSW==1 ;NON-ZERO => TYPE OUT RUN TIME AT END OF ASSEMBLY +IFNDEF WRQTSW, WRQTSW==1 ;WRQOTE (MACRO DEFINITION READER) VERSION + ; ^ 0 => SLOW, 1 => FAST; MAYBE 2 WILL EVENTUALLY BE CREATED +IFE TS,IFNDEF MACL,MACL==6*2000 ;MACRO TABLE SIZE +IFN TS,[ +IFN ITSSW,IFNDEF MACL,MACL==6000;DEFAULT MACL SIZE FOR ITS. IF WE HAVE DECBTS OR +IFN TNXSW,IFNDEF MACL,MACL==12*2000 ; TWXBTS, THIS GETS INCREASED, CAUSE THEY ARE HUGE! +IFN DECSW,IFNDEF MACL,MACL==0 ;NON-ITS: WE WANT MACL TO JUST COVER THE INIT CODE. +IFNDEF MXMACL,MXMACL==32.*2000 ;MAXIMUM LENGTH MACTAB +] +IFNDEF MACRUM,MACRUM==4 ;# WORDS NOT USED AT END OF MACTAB +IFNDEF STRL,STRL==20 ;LENGTH OF STRING STORAGE (USED BY GSYL) +IFNDEF DMDEFL,DMDEFL==40 ;MAX NO OF DMY ARGS IN DEFINE +IFNDEF DMYAGL,DMYAGL==400 ;MAX NO COMBINED DMYARGS ALL MACROS CURRENTLY EXPANDING OR PUSHED +IFNDEF MPDLL,MPDLL==300 ;MACRO PDL LENGTH +IFNDEF DSSIZ,DSSIZ==40 ;MAX # ARGS MACRO WHOSE ARGS BEING SCANNED (SHOULD BE .GE. DMDEFL) +IFNDEF BKTABL,BKTABL==100 ;MAX NUM .BEGIN BLOCKS. +IFNDEF BKPDLS,BKPDLS==10 ;MAXIMUM .BEGIN BLOCK NESTING DEPTH. +IFNDEF BSIZE,BSIZE==37 ;PREFERRED SIZE BLOCK MAX SIZE-3 +IFN SMALSW,IFNDEF LPDL,LPDL==200. +IFNDEF LPDL,LPDL==1500. ;LENGTH OF PDL +IFN SMALSW,IFNDEF CONMIN,CONMIN==1000 +IFNDEF CONMIN,CONMIN==3300 ;MINIMUM AMT OF SPACE FOR CONSTANTS TABLES. +IFNDEF CONMAX,CONMAX==20000 ;MAXIMUM SPACE USER CAN ASK FOR. +IFNDEF NCONS,NCONS==100. ;MAXIMUM NUMBER OF CONSTANTS AREAS +IFNDEF NVARS,NVARS==25. ;MAX. NUM. VARIABLES AREAS. +;; MUST INCLUDE TONS OF SYSTEM DEFS + IFN DECBSW,IFNDEF SYMDSZ,SYMDSZ==4973. ;666.th prime + IFN TNXSW,IFNDEF SYMDSZ,SYMDSZ==7919. ;1000.th prime +IFN SMALSW,IFNDEF SYMDSZ,SYMDSZ==2003. +IFNDEF SYMDSZ,SYMDSZ==2707. ;DEFAULT # SYMS IN SYMTAB. +IFNDEF SYMMSZ,SYMMSZ==11657.*2 ;# SYMS IF JNAME IS MMIDAS. +IFNDEF SYMMAX,SYMMAX==60000 ;MAX SYMTAB SIZE (# SYMS) +IFNDEF FASBL,FASBL==400 ;WORDS USED FOR FASL OUTPUT BUFFER + ; MUST HOLD STUFF ASSOC WITH ONE GROUP OF 9 CODE BYTES +IFNDEF FASATL,FASATL==2000 ;WORDS USED FOR FASL ATOM TABLE + ; HOLDS PNAMES ETC OF ALL ATOMS AS WILL BE IN FASLOAD'S + ; SYMTAB AT LOAD TIME +IFNDEF MINWPS,MINWPS==3 ;MIN # WORDS IN SYMTAB ENTRY +IFNDEF MAXWPS,MAXWPS==3 ;MAX # ALLOWED (WILL BE BIGGER SOME DAY) +IFNDEF NRMWPS,NRMWPS==3 ;DEFAULT #. 2 WDS FOR VALUE & FLAGS, 1 FOR NAME. + +; VERSION, FLAGS, ETC. + +IF1 [ + +IFNDEF MIDVRS,[ +IFGE .FVERS,[ +DEFINE XXX VRS + MIDVRS=SIXBIT/VRS/ +TERMIN +RADIX 10. +XXX \.FVERS +RADIX 8 +EXPUNGE XXX +] +.ELSE [ +PRINTX /What is MIDAS version number? / +.TTYMAC VRS + MIDVRS=SIXBIT/VRS/ +TERMIN +] +] + +;OSMIDAS GETS THE SIXBIT NAME OF THE TYPE OF OP. SYS. THE VERSION OF MIDAS +;IS BEING ASSEMBLED TO RUN UNDER. IT WILL BE THE VALUE OF ".OSMIDAS" WHEN PROGRAMS +;ARE ASSEMBLED WITH THIS MIDAS. NOTE THAT TNX VERSION ACTUALLY SETS IT +;AT RUNTIME STARTUP TO "TENEX" OR "TWENEX" AS APPROPRIATE. +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/ + +;FF FLAGS NOT PUSHED +;LEFT HALF +FL==1,,525252 +FLPPSS==400000 ;ONE IF PUNCHING PASS; MUST BE SIGN +FLHKIL==100000 ;ONE IF SYM TO BE SEMI KILLED IN DDT + +FLVOT== 40000 ;ALL RCH S MUST GO THRU RCH + ; IE TYPCTL .NE. POPJ P, (SET/CLEARED BY MDSSET, MDSCLR) +FLMAC== 20000 ;ONE IF CHARS COMING FROM MACRO PROCESSOR, DON'T HACK CPGN/CLNN +FLTTY== 10000 ;ONE IF CHARS FROM SOMEWHERE ELSE BUT NOT HACKING CPGN/CLNN +$FLOUT== 4000 ;ONE IF OUTPUT HAS OCCURED IN CURRENT MODE (USED BY TS NED LOGIC) +FLPTPF== 2000 ;SET IF (TIME SHARING) OUTPUT DEVICE IS PTP +FLUNRD== 1000 ;=> RE-INPUT LAST CHARACTER (SEE RCH) +FL20X==400 ; IN TENEX VERSION, 1= RUNNING ON TOPS-20, 0 = TENEX. + +;FF RIGHT HALF FLAGS + +FR==525252 +FRFIRWD==400000 ;ONE FOR FIRST WORD OF BLOCK +FRSYMS==200000 ;ONE IF SYM PUNCH DESIRED +FRLOC==100000 ;ONE BETWEEN ABS LOC ASSIGN AND + ;FIRST BLOCK OUTPUT THEREAFTER (EBLK TO OUTPUT NULL BLOCK SO LINKING LOADER KNOWS $.) + +FRNPSS==40000 ;ONE IF TWO PASS ASSEMBLY +FRPSS2==20000 ;ONE ON PASS 2 + +FRINVT==4000 ;USED BY PBITS AND OUTPUT TO OUTPUT WORDS OF CODE BITS IN CORRECT ORDER (STEAD LOGICAL) +FRNLIK==2000 ;TEMPORARILY SUPPRESS ADR LINKING +FRGLOL==1000 ;ONE IF LOCATION PLUS OFFSET IS GLOBAL + +FRBIT7==400 ;SET IF LAST TIPLE OF CODEBITS WAS 7. +FRMRGO==200 ;MACRO PROC TO RETURN TO .GO HACKER W/O READING NEXT CHAR (SEE RCHSAV) + +FRCMND==40 ;SET WHILE READING CMD, TELLS RFD TO NOTICE (, _, COMMA. +FRNNUL==20 ;SET ON RETURN FROM RFD IFF NONNULL SPEC. +FRARRO==10 ;TELLS RFD THAT 1ST NAME IS FN1, NOT FN2. +FRFN1==4 ; TELLS RFD THAT 1ST NAME WAS READ. + + + ; FLAGS TO ZERO AT BEGINNING OF PASS 1 ONLY, BY $INIT. +FFINIT==<-1-FLVOT-FLPTPF-FLTTY-FL20X,,-1> + +] ;END IF1 + +;INDICATOR REGISTER + +IF1 [ + +;LEFT HALF +IL==1,,525252 +ILGLI==1 ;SET ON " CLEARED EACH SYL +ILVAR==2 ;SET ON ' " " " +ILFLO==4 ;FLOATING NUM, SET ON DIGIT AFTER . +ILDECP==10 ;DECIMAL PREFER, SET WHEN . SEEN. +ILUARI==20 ;1 => RIGHT OPERAND TO UPARROW BEING READ +ILLSRT==40 ;RETURN FROM < +ILWORD==400 ;SET IF CURRENT WORD IS NOT NULL RETURNED BY GETWORD +ILNPRC==1000 ;ONE IF NUMBER ALREADY PROCESSED BY UPARROW +ILMWRD==4000 ;SET ON MULTIPLE WORD +ILPRN==10000 ;SET DURING MACCL IF MACRO NAME WAS FOLLOWED BY (. +ILMWR1==20000 ;SET BY LBRAK AS SIGNAL TO ITSELF THAT THIS NOT FIRST + ;WORD OF MULTI-WORD CONSTANT +ILNOPT==40000 ;CONSTANTS OPTIMIZATION SUPPRESSION FLAG; SHOULD BE SET BY + ;VALUE-RETURNING PSEUDO DURING NOT PUNCHING PASS TO KEEP ITSELF OUT OF + ;CONSTANTS OPTIMIZATION + +;RIGHT HALF + +IR==525252 +IRFLD==1 ;SET IF FLD NOT NULL +IRSYL==2 ;SET IF SYL NOT NULL +IRLET==4 ;SET IF SYL IS SYMBOL +IRDEF==10 ;SET IF CURRENT EXPR DEFINED +IRNOEQ==20 ;SET IF = ISN'T ALLOWED IN CURRENT CONTEXT. +IRCOM==40 ;SET IF CURRENT QUAN IS COMMON +IRPERI==100 ;SET IF PERIOD SEEN IN WHAT IS SO FAR (INCL .) A NUMBER +IREQL==200 ;ONE DURING READING WORD TO RIGHT OF = +IRIOINS==400 ;FIRST FIELD OF CURRENT WORD HAS IO INST +IRCONT==1000 ;SET IF NOT OK TO END BLOCK +IRPSUD==4000 ;SET IF ERROR COMMENTS WILL COME FROM PSEUDO +IRGMNS==20000 ;SET IF ILUARI OR BAKARI HAS GOBBLED MINUS +IROP==200000 ;SET IF OPERATOR SEEN IN CURRENT FIELD + +CALL==PUSHJ P, +RET==POPJ P, +;SAVE=PUSH P, ;DON'T USE SAVE! IT'S A JSYS ON TENEX AND TWENEX +REST==POP P, +PJRST==JRST ; FOR JRST'ING TO A POPJ'ING ROUTINE. + +ETSM=1000,, ;ERROR, TYPE SYM. +ETR=2000,, ;ERROR, ORDINARY MESSAGE. +ERJ=3000,, ;ERROR, NO MESSAGE, RETURN TO ADDR. +ETI=4000,, ;ERROR, IGNORE LINE, RET. TO ASSEM1. +ETA=5000,, ;ERROR, RET. TO ASSEM1. +ETASM=6000,, ;ERROR, TYPE SYM AND RETURN TO ASSEM1 +ETF=7000,, ;FATAL ERROR. +TYPR=(37000) ;UUO, TYPE OUT ASCIZ STRING +TYPCR=(36000) ; LIKE TYPR BUT ADDS CR AT END. +] ;END IF1 + +IF1 [ +;LINK TABLE (GLOTB), ACCUMULATES GLOBAL REFERENCES FOR CURRENT FROB (USUALLY WORD) TO OUTPUT +;GLSP2 POINTS TO (I.E. HAS ADR 1 LESS THAN) BOTTOM OF ACTIVE PART OF TABLE +;GLSP1 POINTS TO TOP (HAS ADR OF LAST ENTRY ACTIVE) + +;ACTUAL ENTRIES IN GLOTB: +;IF ENTIRE WORD ZERO, ENTRY IS NULL, WILL (OR SHOULD) BE IGNORED +;RH ADR OF SQUOZE WITH INTERNAL MIDAS FLAGS (USUALLY IN SYMBOL TABLE, BUT MAY BE ANYWHERE IN CORE) +;LH: RIGHT 10. BITS MULTIPLICATION FACTOR OR 0 => 1 + ;GLOBAL SHOULD BE MULTIPLIED BY IT +;REST OF LH FLAGS: + +;SIGN BIT => THIS NOT PART OF FIELD, DON'T PLAY WITH FLAGS AT GETFLD, INTFD +ACF==40000 ;AC LOW OR HIGH (SWAPF => HIGH) +HFWDF==100000 ;MASK GLOBAL TO HALFWORD +SWAPF==200000 ;SWAP +MINF==20000 ;NEGATIVE OF GLOBAL + +IFNDEF LBRKT,LBRKT=="[ ;LEFT DELIMITER FOR EXPLICITLY GROUPED CONDITIONALS, MACRO ARGS, REPEAT BODY, ETC. +IFNDEF RBRKT,RBRKT=="] ;RIGHT " +IFNDEF WPS, WPS==3 ;# CONTIG. WDS /STE. IFNDEF FOR DEBUGGING. +IFNDEF BKWPB,BKWPB==3 ;# WDS/BKTAB ENTRY. +IFNDEF EOFCH,EOFCH==3 ;EOF CHAR, BEWARE DISPATCH TABLE ENTRIES. +IFNDEF LBRACE,LBRACE==173 +IFNDEF RBRACE,RBRACE==175 + +;3RDWRD LH. SYM TAB BITS + +3REL==600000 ;RELOC BITS, DO NOT CHANGE, SOMETIMES REFERENCED BY NUMERIC BYTE POINTERS +3RLL==400000 ;R(LH) +3RLR==200000 ;R(RH) +3RLNK==100000 ;R(LINK) +3KILL==40000 ;FULLY-KILLED SYM (DON'T GIVE TO DDT). +3VP==20000 ;VALUE PUNCHED +3SKILL==10000 ;SEMI KILL IN DDT +3LLV==4000 ;LINKING LOADER MUST INSERT VAL +3VAS2==2000 ;VAR SEEN ON PASS TWO WITH ' +3VCNT==1000 ;USED IN CONSTANT +3MAS==400 ;THIS ISN'T THE LAST DEFINITION OF A SYM WITH THIS NAME + ;(SO ES MUST KEEP SEARCHING). +3NCRF==200 ;DON'T CREF THIS SYMBOL. +3MACOK==100 ;OK TO (RE)DEFINE THIS SYM AS MACRO. + ;(IE IS A MACRO OR SEEN ONLY IN .XCREF) +3LABEL==40 ;ILLEGAL TO REDEFINE THIS SYM TO DIFFERENT VALUE +3MULTI==20 ;THIS SYM IS MULTIPLY DEFINED, SO FLAG ALL DEFINITIONS. +3DOWN==10 ;THIS DEFINITION SHOULD BE SEEN BY SUBBLOCKS IN 1PASS MODE. + +3DFCLR==737110 ;BITS IN LH TO CLEAR ON REDEFINITION. + +; FLAGS IN "CONTROL" VARIABLE +.SEE CONTRL + ;LEFT HALF +TRIV==400000 ; 1 IF OUTPUT FORMAT IS FOR TRIVIAL LOADER (ABSOLUTE) + ; ELSE RELOCATABLE (NOTE THIS CROCKISHLY ONLY MEANS + ; STINK FORMAT, SINCE DEC RELOC FORMAT HAS THIS FLAG SET) + + ;RIGHT HALF +ARIM== 2 ; 1 => OUTPUT FORMAT IS RIM +SBLKS== 10 ; 1 => OUTPUT FORMAT IS SBLK (SIMPLE BLOCKS) +ARIM10== 20 ; 1 => OUTPUT FORMAT IS PDP-10 RIM +DECREL== 40 ; 1 => DEC RELOCATABLE FORMAT (CONSIDERED "ABSOLUTE" INSIDE MIDAS) +FASL== 100 ; 1 => LISP FASL COMPATIBLE RELOCATABLE FORMAT ( " " ") +DECSAV==200 ; 1 => DEC SAV FORMAT (ABSOLUTE) ALSO WINS ON 10X, 20X + +PTR==104 ;DEVICE CODE FOR PAPER TAPE READER. + +] ;END IF1 + +IF1 [ + +;SQUOZE FLAG DEFINITIONS IN MIDAS SYMBOL TABLE + +CMMN==0 ;COMMON (NOT USED) +PSUDO==40000 ;PSEUDO OR MACRO, VALUE RH ADDR OF RTN (MACCL FOR MACRO), + ; LH WILL BE IN LH OF B WHEN RTN CALLED. +SYMC==100000 ;SYM, VALUE IS VALUE OF SYM. +LCUDF==140000 ;LOCAL UNDEF +DEFLVR==200000 ;DEF LOC VAR, VALUE IS VALUE. +UDEFLV==240000 ;UNDEF LOC VAR, VALUE IS 1+ IDX IN VARIAB. AREA, BUT IGNORD IF VAR AREA GLOB. +LGBLCB==300000 ;CODE BITS EQUAL TO THIS OR HIGHER REPRESENT GLOBAL QUANTITIES +DEFGVR==300000 ;DEF GLO VAR, VALUE IS VALUE +UDEFGV==340000 ;UNDEF GLO VAR, VALUE LIKE UNDEF LOCAL VAR. +GLOETY==400000 ;GLO ENTRY +GLOEXT==440000 ;GLO EXIT +NCDBTS==GLOEXT_<-18.+4>+1 ;# CODE BIT TYPES + +DEFINE CDBCHK TBLNAM +IFN .--NCDBTS,.ERR TBLNAM LOSES +TERMIN + +;LOADER BLOCK TYPES LINK +LLDCM==1 ;LOADER COMMAND BLOCK +LABS==2 ;ABSOLUTE +LREL==3 ;RELOCATABLE +LPRGN==4 ;PROG NAME +LLIB==5 ;LIBRARY BLOCK +LCOMLOD==6 ;LOAD INTO COMMON +LGPA==7 ;GLOBAL PARAMETER ASSIGN +LDDSYM==10 ;LOCAL SYMS +LTCP==11 ;LOAD TIME COND ON PRESENCE +ELTCB==12 ;END LOAD TIME COND +LPLSH==22 ;POLISH FIXUP + +;LOADER COMMANDS +;IN ADR OF LDCMD BLK +LCJMP==1 ;JUMP +LCGLO==2 ;GLOBAL LOC ASSIGN +LCCMST==3 ;SET COMMON BENCHMARK +LCEGLO==4 ;END OF GLOBAL BLOCK +LDCV==5 ;LOAD TIME COND ON VALUE +LDOFS==6 ;LOADER SET GLOBAL OFFSET +LD.OP==7 ;LOADER .OP + +;LOADER CODEBITS SECOND SPEC AFTER 7 +CDEF==0 ;DEF +CCOMN==1 ;COMMON REL +CLGLO==2 ;LOC-GLO REC +CLIBQ==3 ;LIBREQ +CRDF==4 ;GLO REDEF +CRPT==5 ;REPEAT GLOBAL VALUE +CDEFPT==6 ;DEFINE SYM AS $. + +;DEC RELOCATABLE BLOCK TYPES. +DECWDS==1 ;STORAGE WORDS. +DECSYM==2 ;SYMBOL DEFS OR GLOBAL ADDITIVE RQS. +DECHSG==3 ;LOAD INTO HIGH SEG (FOR .DECTWO) +DECENT==4 ;ENTRY NAMES +DECEND==5 ;END BLOCK, HAS PROGRAM BREAK. +DECNAM==6 ;PROGRAM NAME. +DECSTA==7 ;STARTING ADDRESS BLOCK. +DECINT==10 ;INTERNAL REQUEST +DECRQF==16 ;REQUEST LOADING A FILE +DECRQL==17 ;REQUEST LOADING A LIBRARY +] ;END IF1 + +IF1 [ + +DEFINE TYPE &STR +TYPR [ASCIZ STR] +TERMIN + +DEFINE TYPECR &STR +TYPCR [ASCIZ STR] +TERMIN + +DEFINE PRINTA A,B,C,D,E,F +IF1,[PRINTC ~A!B!C!D!E!F +~] +TERMIN + +IF1 [DEFINE BNKBLK OP +OP +TERMIN ] + + ;ADD A LINE TO BNKBLK, ACCUMULATED CONTENT OF + ;WHICH IS DUMPED OUT AT END OF ASSEMBLY + ;ARG TO BLCODE SHOULD BE FREE OF STORAGE WORDS + +DEFINE BLCODE NEWCFT +IF1 [BNKBLK [DEFINE BNKBLK OP +OP]NEWCFT +TERMIN ] +IF2 [IRPW X,,[ +NEWCFT +] +IRPS Y,,X +Y=Y +.ISTOP TERMIN TERMIN ] TERMIN + + ;3RDWRD MANIPULATING MACROS + ;GET 3RDWRD INTO LH("A"), "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3GET A,B + MOVE A,ST+2(B) + TERMIN + + ;GET 3RDWRD INTO "A", "B" HAS ADR OF 1STWRD + +DEFINE 3GET1 A,B + MOVE A,2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3PUT A,B + MOVEM A,ST+2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS ADR OF 1STWRD + +DEFINE 3PUT1 A,B + MOVEM A,2(B) + TERMIN + +] ;END IF1 + +;RANDOM MACRO DEFINITIONS + +IF1 [ + + ;A HAS ADR OF SYM SQUOZE, SKIP IF IT'S IN SYMBOL TABLE + +DEFINE SKPST A + CAIL A,ST + CAML A,MACTAD +TERMIN + + ;EXECUTE AN INSTRUCTION WITH VARIOUS ADDRESSES (USUALLY PUSH OR POP) + +DEFINE INSIRP A,B + IRPS %ADR,,[B] + A,%ADR + TERMIN +TERMIN + +DEFINE NOVAL + TDNE I,[ILWORD,,IRNOEQ\IRFLD] + ETSM ERRNVL +TERMIN + +DEFINE NOABS + SKIPGE CONTRL + ETASM ERRABS +TERMIN + +] ;END IF1 + +ERRNVL==[ASCIZ /Returns no value/] +ERRABS==[ASCIZ /Allowed only for STINK relocatable format/] + +IF1 [ + +DEFINE MOVEIM B,C + MOVEI A,C + MOVEM A,B +TERMIN + +DEFINE MOVEMM B,C + MOVE A,C + MOVEM A,B +TERMIN +] ;END IF1 + +IF1 [ +IFN 0,[ +;THESE ARE SOME MACRO DEFINITIONS FOR THE UNFINISHED MULTI-WORD +;SYMBOL NAME FEATURE. FOR COMPATIBILITY, THEY ALL NOW HAVE DEFINITIONS +;THAT ONLY HANDLE ONE WORD. THOSE OTHER DEFINITIONS COME AFTER THESE. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +IFSN X,SYM,SKIPE A,X+1 +.ELSE SKIPE A,SYMX + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y + MOVE Z,X+1 + MOVEM Z,Y+1 +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y + MOVE Z,AC!X + MOVEM Z,Y+1 +TERMIN +] + +.ELSE [ +;THESE ARE THE DEFINITIONS OF THE MACROS THAT DO NOT IMPLEMENT +;MULTI-WORD SYMBOL NAMES. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y +TERMIN +] + +DEFINE USING X +X,TERMIN + +] ;END IF1 + +SUBTTL DEFINE SYS DEPENDENT SYMBOLS & SELECT OUTPUT FORMAT + +; THIS DEFSYM MACRO IS FOR COMPILING MIDAS ON ANOTHER OPERATING SYSTEM. THIS +; AVOIDS SAME-NAME SCREWS (IE, "LOCK" IS SOMETHING DIFFERENT ON TWENEX, SAIL, +; AND DEC). + +IF1 [ + +DEFINE DEFSYM X/ + IRPS Z,,[X] + EXPUNGE Z + .ISTOP + TERMIN + X +TERMIN +]; IF1 + +IFN DECSW\TNXSW,[ +IF1 [ + +IFN TNXSW, EQUALS TEM,.SYMTAB + +; INSERT UUO DEFINITIONS FILES AS APPROPRIATE. +IFE CMUSW\SAILSW\TNXSW,.INSRT DECDFS +IFN SAILSW, .INSRT SAIDFS +IFN CMUSW, .INSRT CMUDFS +IFN TNXSW, .INSRT TNXDFS + +;ACTUALLY DEFINE THE UUOS USING THE MACROS READ FROM THE FILES. +IFE CVTSW,[ +IFN DECSW,.DECDF DEFSYM +IFN TNXSW,.TNXDF DEFSYM + +;INSERT THE BITS DEFINITION FILES AS APPROPRIATE. +;THESE MUST BE INSERTED EVEN IF THEY ARE PREDEFINED, BECAUSE +;THE MIDAS SYMBOL TABLE IS CONSTRUCTED FROM THE DEFINITIONS IN THIS ASSEMBLY +;OF THOSE SYMBOLS, AND THAT MEANS WE NEED THE LATEST VERSION ASSEMBLED IN. + +IFN TNXSW, .INSRT TWXBTS +IFN DECBSW,.INSRT DECBTS + +];IFE CVTSW + +IFN TNXSW,[ ; AC DEFS FOR DIRECT REFERENCE TO JSYS ARGS +R1==:1 ; SOMEDAY MAYBE THE SYMBOLS A,B ETC WILL CORRESPOND... +R2==:2 +R3==:3 +R4==:4 +R5==:5 +] + +EXPUNGE HALT +DEFINE HALT + JRST 4,. +TERMIN + +EXPUNGE .VALUE +EQUALS .VALUE HALT + +DEFINE .LOSE A + JRST 4,.-1 +TERMIN + +IFN TNXSW, EQUALS .SYMTAB,TEM + +] ;IF1 + +IFN DECSW,[ ; SELECT OUTPUT FORMAT FOR DEC VERSION +IFN PURESW,.DECTWO +IFE PURESW,.DECREL + RL0==. +] +IFN TNXSW,[ ; SELECT OUTPUT FORMAT FOR TNX VERSION +IFNDEF DECSVF,[ ; NORMALLY, USE .DECSAV IF AVAILABLE, ELSE .DECREL, + DECSVF==0 ; BUT USER CAN OVERRIDE THAT BY SPECIFYING DECSVF. + IFDEF .DECSAV,DECSVF==1 +] +IFN DECSVF,.DECSAV +.ELSE [ IFN PURESW,.DECTWO + .ELSE .DECREL + ] + RL0==0 +] +] ;IFN DECSW\TNXSW + +IFN ITSSW,[ +IF1 [IFNDEF .IOT,[.INSRT SYS:ITSDFS + .ITSDF DEFSYM + ] ;IFNDEF .IOT +IFNDEF %PIPDL,.INSRT SYS:ITSBTS + HALT==.VALUE + EXPUNG .JBTPC,.JBCNI + +DEFINE SYSCAL A,B + .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] +TERMIN +] ;IF1 + +IFDEF .SBLK,.SBLK ; SELECT OUTPUT FORMAT FOR ITS VERSION + RL0==0 +] ;IFN ITSSW + +IFE PURESW,[ ;FOLLOWING IF NOT ASSEMBLING PURE CODING + +DEFINE PBLK +TERMIN + +DEFINE VBLK +TERMIN +] + +IFN PURESW,[ ;FOLLOWING IF ASSEMBLING PURE CODING + +;MEMORY ORGANIZATION PURE CODING + +;MAXVAR BLOCKS OF IMPURE CODING, NO DYNAMIC ALLOCATION + ;BLCODE MACRO ACCUMULATES CODING TO BE PUT AT END OF + ;IMPURE CODING, NO STORAGE WORDS ALLOWED +;THEN SYM TAB, STARTING AT ST. +;THEN MACRO TABLE (WITH INIT. CODE IN IT) +;STARTING INITIALLY AT MACTBA, ACTUAL ADDR IN MACTAD. +;SYMTAB AND MACTAB DON'T NECESSARILY START ON PAGE BNDRYS. +;THEN GAP TO MINPUR*2000 (HEREAFTER KNOWN AS "THE GAP") + +IFN DECSW\TNXSW,MINPUR==200 +IFN ITSSW,MINPUR==200 ;BLOCK NUMBER BEGINNING OF PURE CODING + +;PURE CODING UNTIL MAXPUR*2000-SOMETHING +;THE FOLLOWING MACROS AND BLCODE MAKE IT NOT COMPLETELY NECESSARY +;TO SEPARATE PURE CODING FROM IMPURE + +CKPUR==0 ;0 => ASSEMBLING BELOW THE GAP, 1 ABOVE + + ; PBLK - SWITCH TO CODING ABOVE THE GAP +DEFINE PBLK +IFN CKPUR,.ERR PBLK +IFE CKPUR,[VAR.LC==. +LOC PUR.LC +]CKPUR==1 +TERMIN + + ; SET INITIAL LOCATION COUNTER FOR ASSEMBLING PURE CODE ABOVE GAP. +IFN ITSSW, PUR.LC==MINPUR*2000 +IFN DECSW, PUR.LC==MINPUR*2000+RL0 +IFN TNXSW,[ + IFN DECSVF,PUR.LC==MINPUR*2000 + .ELSE PUR.LC==MINPUR*2000+20 ;SKIP VESTIGIAL JOBDAT AREA. +] + + ; VBLK - SWITCH TO CODING BELOW THE GAP +DEFINE VBLK +IFE CKPUR,.ERR VBLK +IFN CKPUR,[PUR.LC==. +LOC VAR.LC +]CKPUR==0 +TERMIN + +IFN TNXSW,IFE DECSVF,LOC 200 + +PBLK ;PBLK NORMAL MODE, VARIABLE AREAS BRACKETED WITH VBLK AND PBLK + +] ;END PURESW CONDITIONAL + +.YSTGW ;SET UP NOW, STORAGE WORDS OK + +FOO==. +LOC 41 + JSR ERROR +IFN ITSSW,JSR TSINT +IFN DECSW,[ +LOC .JBAPR + TSINT1 +] +LOC FOO + + ;DISPATCH TABLE FOR NON-SQUOZE CHARACTERS + ;REFERENCED AS DTB-40(RH OF POPJ IN GDTAB) + ;DTB ENTRY OF SYL TERMINATOR PUT IN CDISP BY GETSYL + +DSYL==400000 ;SYL OPERATOR, DISPATCH INDEXED BY RH AT GETSYL (MUST BE SIGN) +DFLD==200000 ;FIELD OPERATOR, GETFD +DWRD==100000 ;WORD OP, GETWD +DSY1==1000 ;SET ONLY IF DSYL SET, + ;SET IF OP MIGHT BE 1ST CHAR OF NONNULL SYL. +DSYL1==DSYL+DSY1 +DSY2==400 ;SET FOR _ ONLY. + +;ALL CLEAR => WORD TERMINATOR, NO DISPATCH + +DTB: DWRD,,SPACE ;40 SP, TAB, RUBOUT + DSYL1,,RRL2 ;EXCLAIM AND OPEN-BRACE + DSYL1,,DQUOTE ;" + DFLD,,XORF ;NUM SIGN + DSYL,,RBRAK2 ;CLOSE-BRACE. + 0 ;(USED TO BE PERCENT SIGN) + DFLD,,ANDF ;AMPERSAND + DSYL1,,SQUOTE ;' + DFLD,,LEFTP ;( 50 + DSYL,,RPARN ;) + DFLD,,MULTP ; STAR TIMES + DFLD,,PLS ;+ PLUS + DWRD,,COMMA ; , + DFLD,,MINUS ;- + DSYL1,,CTLAT ;^@ (56) + DFLD,,DIVID ;/ + DSYL1,,COLON ;COLON 60 + DSYL,,SEMIC ;SEMI + DFLD,,LSSTH ;< + DSYL1,,EQUAL ;= + DSYL,,GRTHN ;> + 0 ;? + DSYL1,,ATSGN ;AT SIGN + DFLD,,LBRAK ;[ + DFLD,,IORF ;BACKSLASH 70 + DSYL,,RBRAK ;] + DSYL1,,UPARR ;^ + DSYL+DSY2,,BAKAR ;BACKARR + 0 ;CR + 0 ;(USED TO BE TAB) + 0 ;ALL OTHER + DSYL,,LINEF ;LF (DSYL TO HACK CLNN) + DSYL,,FORMF ;FORM FEED (") 100 + +;NOTE THAT POPJ P, IS VALID TEST FOR SQUOZENESS +;EXCEPT FOR EOFCH + +GDTAB: POPJ P,56 ; ^@ GETS IGNORED. + REPEAT 2,POPJ P,76 ;(GDTAB GLOBAL SO OUT OF TS, AIO CAN CLOBBER GDTAB+141 WITH JRST RREOF + ;ON OLD FILES) +IFN .-GDTAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH GDTAB. +IFE TS,[POPJ P,76] IFN TS,[JRST RREOF] + REPEAT 5,POPJ P,76 + POPJ P,40 ; TAB + POPJ P,77 ; LF + POPJ P,76 ; VERT TAB + POPJ P,100 ; FORM FEED + POPJ P,74 ; CR + REPEAT "!-16-1,POPJ P,76 + POPJ P,40 ; SPACE + POPJ P,41 ; ! + POPJ P,42 ; " + POPJ P,43 ; # + ADD SYM,%$SQ(D) ; $ + ADD SYM,%%SQ(D) ; % + POPJ P,46 ; & + POPJ P,47 ; ' + POPJ P,50 ; ( + POPJ P,51 ; ) + POPJ P,52 ; * + POPJ P,53 ; + + POPJ P,54 ; , + POPJ P,55 ; - + JSP CH1,POINT ; . + POPJ P,57 ; / + REPEAT 10.,JSP CH2,RR2 ; DIGITS + POPJ P,60 ; : + POPJ P,61 ; ; + POPJ P,62 ; < + POPJ P,63 ; = + POPJ P,64 ; > + POPJ P,65 ; ? + POPJ P,66 ; @ +IFDEF .CRFOFF,.CRFOFF +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN + POPJ P,67 ; [ + POPJ P,70 ; \ + POPJ P,71 ; ] + POPJ P,72 ; ^ + POPJ P,73 ; _ + POPJ P,76 ; NOW LOWER CASE GRAVE ACCENT + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN +IFDEF .CRFON,.CRFON + POPJ P,41 ;{ + POPJ P,76 ;| + POPJ P,44 ;} + POPJ P,76 ;~ + POPJ P,40 ; RUBOUT, LIKE SPACE + IFN .-GDTAB-200,.ERR GDTAB LOSES + +NSQTB: IFDEF .CRFOFF,.CRFOFF +IRPC Q,,0123456789 + ADD SYM,%!Q!SQ(D) +TERMIN + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890$%. +%!Q!SQ: 0 + SQUOZE 0,Q/50/50/50/50/50 + SQUOZE 0,Q/50/50/50/50 + SQUOZE 0,Q/50/50/50 + SQUOZE 0,Q/50/50 + SQUOZE 0,Q/50 + SQUOZE 0,Q +TERMIN +IFDEF .CRFON,.CRFON + +;FORMAT TABLE(S) +;4.9-4.4 ETC SPECIFY SHIFT +;4.4-3.6 ETC SPECIFY NUMBER BITS +;FIELD SPECS IN REVERSE ORDER + +IFORTB: 0 ;NCNSN 10 , + 0 ;NCNSF 11 IMPOS + 0 ;NCNCN 12 ,, + 2200,, ;NCNCF 13 ,,C + 2200000000 ;NCFSN 14 ,B + 0 ;NCFSF 15 ,B C + 0 ;NCFCN 16 ,B, + 0 ;NCFCF 17 ,B,C + 4400000000 ;FSNSN 20 A + 0 ;FSNSF 21 IMPOS + 0 ;FSNCN 22 IMPOS + 0 ;FSNCF 23 IMPOS + 2200440000 ;FSFSN 24 A B + 2200220044 ;FSFSF 25 A B C + 270400440000 ;FSFCN 26 A B, + 2227040044 ;FSFCF 27 A B,C + 4400000000 ;FCNSN 30 A, + 0 ;FCNSF 31 IMPOS + 22220000 ;FCNCN 32 A,, + 2200002222 ;FCNCF 33 A,,B + 2200440000 ;FCFSN 34 A,B + 0 ;FCFSF 35 A,B C + 0 ;FCFCN 36 A,B, + 0 ;FCFCF 37 A,B,C +FRTBL==.-IFORTB ;LENGTH OF FORMAT TABLE +VBLK +FORTAB: BLOCK FRTBL ;ACTUAL FORMAT TABLE +FRTBE=.-1 +PBLK + +;VARIABLE STORAGE + +VBLK + +RETURN: JRST . ;RH HAS RETURN ADR FOR END OF MAJOR ROUTINE (E.G PASS 2) +CDISP: 0 ;CURRENT DISPATCH CODE +PPRIME: 0 ;PUSH DOWN LIST MARKER (GETFLD) +SCNDEP: 0 ;DEPTH IN SUCCESSFUL BRACKET CONDITIONALS INSIDE INNERMOST LITERAL. +CONDLN: 0 ;LINE NUMBER AT WHICH LAST TOP LEVEL SUCCESSFUL CONDITIONAL ENCOUNTERED +CONDPN: 0 ;PAGE NUMBER-- PRINT THESE IF REACH END AND CONDITIONAL NOT TERMINATED +CONDFI: 0 ;SIXBIT FN1 OF FILE CONTAINING LAST TOP LEVEL SUCCESSFUL CONDITIONAL. +A.SUCC: 0 ;NONZERO IFF LAST CONDITIONAL SUCCEEDED. +ASMOUT: 0 ;0 NORMAL, 1 WITHIN <>, 2 IN (), 3 IN []. +ASMDSP: ASSEM3 ;PLACE TO JUMP TO FROM ASSEM1 LOOP. + ;ASSEM3 NORMAL. ASSEMC IF WITHIN <>, () OR [] + ;AND .MLLIT ISN'T POS. LSSTHA AFTER > OR ) SEEN. + ;[ ;CONND AFTER ] SEEN. +ASMDS1: 0 ;ASMDSP SAVED HERE DURING ASCII, SIXBIT PSEUDOS. +ASSEMP: 0 ;RESTORE P FROM HERE AT ASSEM1. SAVED OVER LITERAL. +ASMI: 0 ;REINIT I AT ASSEM2 FROM ASMI. +GLSPAS: 0 ;RESTORE GLSP1 AT ASSEM1. SAVED OVER LITERAL. +GLSP1: 0 ;POINTER TO BOT OF LINKAGE TABLE IN USE HIGH ADR +GLSP2: 0 ;POINTER TO TOP OF LINKAGE TABLE IN USE LOW ADR +FORMAT: 0 ;ACCUMULATES FORMAT WORD +FORPNR: 0 ;POINTER INTO FORMAT WORD, SHOULD BE FORMAT+1 SO CLOBBERABLE BY LAST IDPB +FLDCNT: 0 ;NUMBER OF FIELDS PUSHED DOWN IN CURRENT WORD +WRD: 0 ;ACCUMULATES VALUE OF WORD +WRDRLC: 0 ;RELOC OF WRD, MUST COME RIGHT AFTER WRD. +T1: 0 ;TEMP +T2: 0 ;TEMP +PBITS1: 0 ;CURRENT CODE BITS +PBITS2: 0 ;NO OF SPECS LEFT IN CURRENT WORD +PBITS4: 0 ;POINTER TO WHERE CURRENT CODE BITS WILL GO +OPT1: 0 ;POINTER FOR STORING IN BKBUF (OUTPUT BUFFER) +CONTRL: 0 ;FLAG REG FOR IO CONTROL ETC, .GE. 0 => RELOCATABLE/1PASS +CDATBC: 0 ;CURRENT DATA BLOCK CODE TYPE +SCKSUM: 0 ;CKSUM FOR SIMPLE BLOCK FORMAT +IFN A1PSW,[ +PRGC: -1 ;ONE LESS THAN # TIMES END HAS BEEN ENCOUNTERED +OUTN1: -1 ;.GE. 0 => OUTPUT HAS OCCURED IN OTHER THAN 1PASS MODE (NOT INITIALIZED) +OUTC: -1 ;.GE. 0 => OUTPUT HAS OCCURED DURING CURRENT ASSEMBLY +] +LINKL: 0 ;SAVE LIMIT OF GLOTB GETWRD +STRCNT: 0 ;COUNT OF CHARS READ (INCL. DELIM) BY GSYL +STRPNT: 0 ;TEMP AT GSYL, BYTE POINTER TO STRING STORAGE +ISYMF: -1 ;-1 IF ISYMS HAVE NOT BEEN SPREAD +SMSRTF: -1 ;-1 BEFORE SYMTAB IS COMPACTED AND SORTED. + ;AFTER COMPACTING, HOLDS NUMBER OF SYMS THAT WERE THERE BEFORE COMPACTING. +BITP: 0 ;BYTE PNTR TO CODE BITS IN CURRENT (RELOC) BLOCK +LDCCC: 0 ;DEPTH IN LOADTIME CONDS +PARBIT: 0 ;0 OR 4 FOR : OR = (IN GENERAL, TEMP AT P7X) +LABELF: 0 ;-1 IN COLON, SOMETIMES IN EQUAL. CAUSES 3LABEL TO BE SET. +STGSW: 0 ;NON ZERO GIVES ERROR PRINT ON STORAGE WORDS +HKALL: 0 ;NONZERO => HALF-KILL ALL LABELS (.HKALL'S VALUE) +LITSW: 0 ;-1 => USING A LITERAL GIVES AN ERROR +QMTCH: 0 ;-1 => ' AND " NEED MATCHING CLOSINGS (A LA FAIL, MACRO-10) +STARTA: 0 ;STARTING ADDRESS FOR SBLK, RIM, DECSAV +DECSYA: 0 ; ADDRESS TO LOAD SYMBOLS AT (FOR DECSAV FORMAT) +DECBRK: 0 ;LARGEST RELOC. ADDR. LOADED INTO. (USED FOR DEC FMT) +DECBRA: 0 ;LARGEST ABS. ADDR LOADED INTO. +DECBRH: 0 ;LIKE DECBRK BUT FOR ADDRS IN HI SEG. +DECTWO: MOVE ;NOT = MOVE => .DECTWO WAS DONE, AND THIS WD HAS + ;ADDR START OF HISEG. +ISAV: 0 ;I FROM FIELD AT AGETFLD +A.PASS: 0 ; .PASS INTSYM, # OF THIS PASS. +A.PPAS: 0 ;.PPASS INTSYM, # OF PASSES. +WPSTE: NRMWPS ;# WORDS PER SYMTAB ENTRY +WPSTE1: NRMWPS-1;ONE LESS THAN WPSTE - FOR SPEED. +WPSTEB: ,-NRMWPS(B) ;RH HAS - # WORDS PER SYMTAB ENTRY; LH HAS INDEX OF B. +SYMSIZ: 0 ;#WDS IN SYMTAB = WPS* +SYMLEN: SYMMSZ ;SYMTAB SIZE (# SYMS) + ;ASSEMBLED-IN VALUE USED AS DEFAULT, ONLY IF NON-TS. +SYMAOB: 0 ;-<# SYMS>,,0 +INICLB: 0 ;-1 IF INITIALIZATION CODE CLOBBERED. +TTYINS: 0 ;AT START OF ASSEMBLY, -1 => .INSRT TTY PASS1, -2 => PASS2 ALSO. +IFN FASLP,[ +FASBP: 0 ;PNTR TO FASL OUTPUT BUFFER +FASATP: 0 ;PNTR TO FASL ATOM TABLE +FASAT1: 0 ;PNTR TO FASL ATOM TABLE AFTER READING IN NEW ATOM + ; (MAYBE UPDATE FASATP TO THIS IF ATOM WAS UNIQUE9 +FASAT2: 0 ;BYTE PNTR USED TO STORE ATOM IN +FASIDX: 0 ;INDEX NEXT ATOM LOADED INTO FASAT WILL BE +FASPCH: 0 ;AMOUNT OF FASAT "PUNCHED" +FASCBP: 440400,,FASB ;BYTE PNTR TO FASL CODE BIT WORD +FASPWB: 0 ;FASL CODE AT PWRD +FASBLC: 0 ;LOSING BLOCK "COUNT" +FASBLS: 0 ;LOSING BLOCK "SYMBOL" +AFRLD: 0 ;LIST READ CURRENT DEPTH +AFRLEN: 0 ;LIST READ CURRENT LENGTH +AFRDTF: 0 ;LIST READ DOT CONTEXT FLAG (0 NORMAL, 1 SAW DOT, 2 SAW "FROB AFTER DOT" +AFRFTP: 0 ;LIST READ SAVED STATE OF FASATP +AFLTYP: 0 ;TYPE LIST OP IN- 0 EVAL AND THROW AWAY VALUE + ;1 "RETURN" LIST + ;2 "RETURN" VALUE OF LIST +] +PBLK + +;INFO CONVENIENT TO ANYONE GENERATING AN OUT OF TIME-SHARING MIDAS + +;MIDAS OUT OF TIME-SHARING ASSEMBLES INTO A COLLECTION OF SUBROUTINES +;IO IS EXPECTED TO BE HANDLED BY OTHER PROGRAMS. + +;EXITS FROM THE ASSEMBLER: +;TPPB OUTPUT BINARY WORD IN A +;TFEED IF OUTPUT DEVICE IS PTP, PUNCH OUT # FRAMES OF BLANK TAPE + ;SPECIFIED BY B, MAY CLOBBER A AND B +;GO9 RETURN POINT FROM FATAL ERRORS +;TYO TYPE OUT CHARACTER IN A +;TAB TYPE OUT A TAB (MAY CLOBBER A OF COURSE) +;RCHTBL SEE THE RCH ROUTINES + +;ENTRIES + +;PDL, LPDL MAY BE USED BY COMMAND PROCESSOR BUT WILL BE CLOBBERED BY MAIN ROUTINES +;MAIN ROUTINES, CALLED WITH JSP A, , CLOBBER THE WHOLE WORLD (INCLUDING P) +;INIT INITIALIZE +;PS1 PASS 1 +;PLOD IF APPROPRIATE, PUNCH OUT LOADER +;PS2 PASS 2 (DOES ITS OWN PARTIAL INITIALIZATION) +;PSYMS PUNCH OUT SYMBOL TABLE + +;OTHER ENTRIES + +;CONTRL AFTER ASSEMBLY, .GE. 0 => RELOCATABLE, .LT. 0 => ABSOLUTE +;ISYMF -1 IF SYMS HAVE NOT BEEN SPREAD, ELSE DON'T TRY TO ADD TO INITIAL SYMBOL TABLE +;SMSRTF -1 IF SYMTAB HASN'T BEEN SORTED, ELSE SYMTAB CLOBBERED, DON'T RE-ASSEMBLE +;MIDVRS .FNAM2 OF MIDAS ENGLISH + +;SOME FF FLAGS ARE GLOBAL SO COMMAND PROCESSOR CAN KNOW WHAT'S HAPPENED ON RETURN + +;COMMAND PROCESSOR MAY ADD TO INITIAL SYMBOL TABLE BEFORE CALLING INIT THE FIRST TIME +;EISYMT IS THE FIRST LOCATION OK TO DUMP INTO +;EISYMP RH SHOULD BE SET BY COMMAND PROCESSOR TO FIRST LOC NOT DUMPED INTO +;INTSYM RH OF SYMTAB VALUE TO RETURN VALUE ADDRESSED BY LH(SYMTAB ENTRY) + +;RCH HAS AN ELABORATE SET OF GLOBALS, WHICH I DON'T FEEL LIKE PUTTING DOWN NOW, BUT THEY INCLUDE +;RCH (GET CHAR) SEMIC, RRL1, RREOF, SEMICR, SEMIC, TYPCTL, GDTAB, CPGN, CLNN, +;RCHMOD, MDSCLR, MDSSET, RCHSET, POPLMB, PSHLMB +;ALSO RCHTBL ONLY EXIT + +;LISTING FEATURE GLOBALS: +;PILPT PRINT CHAR IN A +;LISTON LISTING ON/OFF FLAG, -1 => ON +;LISTP SAME WORD AS LISTON. +;LISTP1 POSITIVE => LIST EVEN ON NON-PUNCHING PASS. +;LPTCLS END OF LISTING, PRINT FORM FEED, IF TS THEN CLOSE LPT + +;CREF FEATURE GLOBALS: +;CRFOUT OUTPUT WORD IN A. +;CREFP -1 => REQUEST GENERATION OF CREF OUTPUT. +;THE RUBOUT-B-^W HEADER, THE SET-SOURCE-FILE BLOCK, AND THE EOF BLOCK +;ARE THE RESPONSIBILITY OF THE COMMAND PROCESSOR. + +;;RCH ;CHARACTER INPUT ROUTINES + +IFN RCHASW\MACSW,[ + ;SAVE LIMBO1 STATUS AND RH(B) + ;THEN SET UP FOR NEW INPUT MODE (DESCRIPTOR IN A) + ;CALLED BY PUSHEM AND PUSHTT + +PSHLMB: HRL B,LIMBO1 ;LAST CHARACTER INPUT + TLZE FF,FLUNRD ;RE-INPUT CHARACTER ON RETURN? + XCT LSTPLM ;SET B'S SIGN; IF LISTING, JRST PSHLML. +PSHLMN: EXCH A,RCHMOD ;GET OLD MODE IN A + DPB A,[360500,,B] ;STORE IN 5 OF HIGH 6 BITS IN B + PUSH F,B ;SAVE RESULTANT CRUD + CAMN A,RCHMOD ;COMPARE NEW WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + MOVE A,RCHMOD ;NOW GET NEW MODE + JRST PSHLM1 ;SET UP INSTRUCTIONS FOR NEW MODE + +IFN LISTSW,[ +;IF LISTING, LSTPLM HOLDS JRST PSHLML +PSHLML: AOSN PNTSW + JRST PSHLMM ;LAST WAS BREAK CHR + REPEAT 4,IBP PNTBP + SOSA PNTBP +PSHLMM: SETOM LISTBC + TLO B,400000 + JRST PSHLMN +] + + ;UNDO A PSHLMB (NOTE: IN COMMENTS BELOW, "NEW" MODE IS ON PDL, OLD IN RCHMOD) + +POPLMB: POP F,A ;GET WORD THAT PSHLMB PUSHED + HLRZS A ;JUST INTERESTED IN LEFT HALF + TRZE A,400000 ;SIGN BIT SET? + TLOA FF,FLUNRD ;YES, SET FLAG TO RE-INPUT LAST CHAR + TLZA FF,FLUNRD ;NO, CLEAR FLAG. + XCT POPLML ;JFCL\IDPB A,PNTBP ;THE LATTER IFF LISTING. + SETZM LIMBO1 ;INITIALIZE FOR DPB + DPB A,[700,,LIMBO1] ;RESTORE LIMBO1 + LSH A,-<18.-6> ;RIGHT JUSTIFY RCHMOD DESCRIPTOR + CAMN A,RCHMOD ;COMPARE NEW MODE WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + JRST RCHSET ;SET UP FOR NEW MODE AND RETURN +] + +FOO==0 ;INITIALIZE COUNTER FOR FOLLOWING + +DEFINE RCHBLT SIZE,ADR/ + MOVSI T,FOO(A) + HRRI T,ADR + BLT T,-1+ADR +FOO==FOO+ +TERMIN + +DEFINE RCHMOV ADR/ + MOVE T,FOO(A) + MOVEM T,ADR +FOO==FOO+1 +TERMIN + + ;SET UP FOR INPUT OF MODE TYPE SPECIFIED IN A, CLOBBER A ONLY + +RCHSET: MOVEM A,RCHMOD ;STORE NEW RCHMOD +PSHLM1: TLZ FF,FLMAC\FLTTY ;CLEAR FLAGS (MAYBE DEVICE ROUTINE SETS ONE) + XCT RCHTBL(A) ;GET IN A A POINTER TO A DESCRIPTOR TABLE (MAYBE ALSO SET FLAG) + PUSH P,T ;SAVE T, NEED IT FOR TEMP + RCHBLT 3,RCH2 ;FIRST 3 WORDS RCH2 + TLNE FF,FLVOT + JRST POPTJ ;ALL RCH'S TO GO THROUGH RCH, DON'T DO ANYTHING ELSE +MDSST1: RCHBLT 3,RR1 ;NEXT 3 RR1 + RCHMOV RRL1 ;NEXT WORD RRL1 +RCHPSN==FOO ;# WORDS IN ALL TABLES BUT LAST (NOT OF CONSTANT LENGTH) + RCHBLT 6,SEMIC ;LAST N SEMIC +POPTJ: POP P,T + POPJ P, + +IFN LISTSW,[ + ;SET UP TO "DISPLAY" (ALL RCH'S THROUGH RCH) + +MDSSET: TLO FF,FLVOT ;SET FLAG + MOVEI A,MDSSTB-3 ;SET UP AC + PUSH P,T ;SAVE T FOR RESTORATION + JRST MDSST1 ;NOW SET UP + +MDSSTB: JRST RRL1 ;RR1 + HALT + PUSHJ P,RCH ;RREOF + + PUSHJ P,RCH ;RRL1 +IFN .--RCHPSN,.ERR LOSSAGE AT MDSSTB. + PUSHJ P,RCH ;SEMIC + CAIE A,15 + JRST SEMIC + JRST SEMICR + + ;CLEAR OUT DISPLAY MODE + +MDSCLR: TLZ FF,FLVOT ;CLEAR FLAG + MOVE A,RCHMOD + JRST RCHSET ;NOW SET UP FOR REAL IN CURRENT MODE +] ;END IFN LISTSW, + +IFN TS,[ ;TABLE FOR RCHSET, INDEXED BY MODE + ;MAYBE THIS CONDITIONAL WANTS TO BE CHANGED TO SOMETHING ELSE + +RCHTBL: MOVEI A,RCHFIL ;0 => INPUT FROM FILE +IFN MACSW,PUSHJ P,RCHMAC ;1 => INPUT FROM MACRO (DO NOT CHANGE, USED BY MACRO PROCESSOR) +IFN RCHASW,[IFE MACSW,HALT + PUSHJ P,RCHTRC ;2 => TTY, QUIT ON CR + PUSHJ P,RCHARC ;3 => TTY, DON'T QUIT ON CR +] + ;TABLE FOR INPUTTING FROM FILE + ;MAYBE THIS CONDITIONAL ALSO WANTS TO BE CHANGED + +RCHFIL: ILDB A,UREDP ;GETCHR, GET CHARACTER + CAIG A,14 ;SKIP IF TOO BIG TO BE SPECIAL + XCT RPATAB(A) ;SPECIAL, DO THE APPROPRIATE THING + + JRST RRL1 ;RR1 + HALT + PUSHJ P,[ MOVEI A,0 ;^C IN SYMBOL TREATED LIKE A ^@, + JRST INCHR3] ;BUT ALSO SEE IF REALLY END OF BUFFER. THIS GOES IN RREOF. + + ILDB A,UREDP ;RRL1 +IFN .-RCHPSN-RCHFIL,.ERR RCHFIL LOSES. + LDB CH1,[360600,,UREDP] ;SEMIC; FIND WHERE IN ITS WORD UREDP POINTS + IDIVI CH1,7 + JRST @SEMIC3(CH1) ;AND ENTER THE CR-SCANNING LOOP AT THE APPROPRIATE + JFCL ;PLACE (IT IS A WORD-BY-WORD LOOP). + +;TABLE FOR ABOVE, EXECUTED INDEXED BY CHAR, 15 ONLY FROM SEMIC ELSE ANYTHING +;NOTE: MANY OF THESE ROUTINES SUBTRACT 3 FROM THE PC BEFORE RETURNING. +;THE CALLER MUST MAKE SURE THAT THE ILDB UREDP IS WHAT THEY RETURN TO THAT WAY. + +RPATAB: +IFN ITSSW, JFCL ;0, ON I.T.S. IS NORMAL CHARACTER +.ELSE CALL RPANUL ;0, ON DEC SYSTEM, IGNORE IT. + JFCL + JFCL +IFN .-RPATAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH ENTRY IN RPATAB. + PUSHJ P,INCHR3 ;3, EOFCH + REPEAT 6,JFCL + CALL RPALF ;LINE FEED + JFCL ;13 + PUSHJ P,RPAFF ;FORM FEED + JRST SEMICR ;FROM SEMIC ONLY, EXIT FROM LOOP + +RPAFF: SKIPE ASMOUT ;FORM FEED + SKIPL TEXT4 ;ALLOW FORMFEED WITHIN GROUPING ONLY IF IN A TEXT PSEUDO. + CAIA + ETR [ASCIZ/Formfeed within <>, () or []/] + AOS CH1,CPGN + SETOM CLNN +IFN ITSSW,[ + ADD CH1,[SIXBIT /P0/+1] + MOVE CH2,A.PASS + DPB CH2,[300200,,CH1] + .SUSET [.SWHO3,,CH1] ;PUT THE NEW PAGE # IN THE WHO-LINE. +] +RPALF: AOS CH2,CLNN + CAME CH2,A.STPLN + RET + MOVE CH1,CPGN + CAMN CH1,A.STPPG + SETOM TTYBRF + RET + +IFN DECSW\TNXSW,[ +RPANUL: MOVE CH1,@UREDP ;SAW A NULL - IN A LINE NUMBER? + TRNN CH1,1 + JRST RCHTRA ;NO, JUST IGNORE IT. + MOVEI CH1,010700 + HRLM CH1,UREDP ;YES, SKIP THIS WHOLE WORD, THEN + CALL RCH ;SKIP THE 1ST CHAR AFTER THE LINE NUMBER + JRST RCHTRA ;RETURN THE NEXT CHAR FROM THIS CALL TO RCH. +] +] ;END IFN TS, + +VBLK +LIMBO1: 0 ;LAST CHARACTER READ BY RCH +RCHMOD: 0 ;CURRENT INPUT MODE, 0 => INPUT FROM FILE, 1 => MACRO, ETC. +CLNN: 0 ;1 LESS THAN LINE # IN CURRENT INPUT FILE. +CPGN: 0 ;1 LESS THAN PAGE # IN CURRENT INPUT FILE +A.STPL: 0 ;1 LESS THAN LINE # TO STOP AT. +A.STPP: 0 ;1 LESS THAN PAGE # TO STOP AT. + ;(STOPPING MEANS INSERTING THE TTY) + +;READ CHARACTER INTO A FROM INPUT FILE, MACRO, OR WHATEVER (RCH) +;CLOBBERS A,CH1,CH2. + +RCH: TLZE FF,FLUNRD + JRST RCH1 ;RE-INPUT LAST ONE +RCH2: HALT ;ILDB A,UREDP ;ILDB A,CPTR ;GET CHAR + 0 ;CAIG A,14 ;TRZE A,200 ;CHECK FOR SPECIAL + 0 ;XCT RPATAB(A) ;PUSHJ P,MACTRM ;SPECIAL, PROCESS + MOVEM A,LIMBO1 ;GOT CHAR, SAVE AS LAST CHAR GOTTEN +IFE TS,RCHLS1==JRST TYPCTL +IFN TS,RCHLS1==RET ;DEFAULT CONTENTS OF RCHLST (IF NOT LISTING) +RCHLST: RCHLS1 ;AOSN PNTSW IF LISTING. +IFN LISTSW,[ + PUSHJ P,PNTR + CAIG A,15 + JRST RCHL1 +RCHL3: IDPB A,PNTBP +TYPCTL: POPJ P, ;OR JRST SOMEWHERE +PBLK + +RCHL1: CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + JRST RCHL3 +RCHL2: MOVEM A,LISTBC + SETOM PNTSW + JRST TYPCTL + +VBLK +RCH1: MOVE A,LIMBO1 +RCH1LS: RET ;OR CAILE A,15 IF LISTING. + RET ;NEEDED IN CASE LISTING. + CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + POPJ P, + JRST RCHL2 +PBLK +] ;END IFN LISTSW, + +IFE LISTSW,[ +PBLK +RCH1: MOVE A,LIMBO1 + RET +] ;END IFE LISTSW, + +;;GETSYL ;VARIOUS SYLLABLE READING ROUTINES (BUT NOT ALL OF THEM) + +GSYL: CLEARB SYM,STRCNT +GSYL1: MOVEI D,6 + MOVE T,[440700,,STRSTO] + MOVEM T,STRPNT +GSYL3: AOSG A,STRCNT + JRST (F) + PUSHJ P,RCH + IDPB A,STRPNT ;STORE CHAR IN STRING EVEN IF DELIMITER (MINIMUM STRCNT = 1) +A.GSY2: CAIN A,". + JRST GSYL1C + HLRZ CH1,GDTAB(A) + CAIN CH1,(JSP CH2,) + JRST GSYL1A ;NUMBER + PUSHJ P,GSYL1B ;RETURN ONLY ON SYL SEP + HRRZ A,GDTAB(A) + MOVE T,LIMBO1 +C%: POPJ P,"% + +GSYL1B: XCT GDTAB(A) ;POPJ FOR SYL SEPS + SUB P,[1,,1] +GSYL1D: SOJGE D,GSYL3 + AOJA D,GSYL3 + +GSYL1C: ADD SYM,%.SQ(D) + JRST GSYL1D + +GSYL1A: XCT NSQTB-60(A) + JRST GSYL1D + + ;VERSION OF GETSYL TO TRY UNTIL SYL OR WORD TERMINATOR FOUND + ;SKIPS IF NAME THERE (FOR .TYPE, SQUOZE) + +GTSLD2: TLNN C,DWRD\DFLD + JRST GTSLD3 ;DELIMITER IS WORD TERMINATOR, TOLERATE THE NULL SYLLABLE +GETSLD: PUSHJ P,GETSYL ;ENTRY, GET A SYL + MOVE C,CDISP ;GET CDISP + TRNN I,IRSYL + JRST GTSLD2 ;NO SYL + AOS (P) ;GOT SYL, CAUSE RETURN TO SKIP +GTSLD3: TLNN C,DWRD\DFLD + TLO FF,FLUNRD ;CAUSE DELIMITER TO BE RE-INPUT + POPJ P, + +PASSPS: SKIPA A,LIMBO1 +GPASST: CALL RCH + CAIE A,40 + CAIN A,^I + JRST GPASST + RET + +GETSYL: TLZ I,ILUARI+ILNPRC+ILLSRT +GTSL1: CLEARB SYM,NUMTAB ;RECUR HERE FOR RIGHT ARG TO ^ AND _. + MOVE AA,[NUMTAB,,NUMTAB+1] + AOSN NTCLF + BLT AA,NUMTAB+10 ;NUMTAB NOT CLEAR, HAVE TO CLEAR IT + MOVEI D,6 ;CHARACTER COUNTER FOR BUILDING UP SYM + SETOM ESBK ;NO SPECIFIC BLOCK DESIRED. + TDZ I,[ILDECP+ILFLO+ILVAR+ILGLI,,IRPERI+IRLET+IRSYL] +RRL2: PUSHJ P,RR ;CALL MAIN LOOP ROUTINE, READ UNTIL NON-SQUOZE CHAR +SEMICR: ;RETURN HERE FROM SEMIC WITH CR IN A + MOVEM A,LIMBO1 ;SYLLABLE OPERATOR OR TERMINATOR IN A, SAVE + HRRZ A,GDTAB(A) ;NOW GET RIGHT HALF OF POPJ, INDEX INTO DTB + MOVE C,DTB-40(A) ;GET DTB ENTRY (FLAGS,,JUMP ADR) + MOVEM C,CDISP ;STORE AS DISPATCH CODE FOR LAST CHAR (SORT OF AN INTERPRETED LIMBO1) +RR8: TLNE C,DSYL ;NOW SEE IF SYL OPERATOR FLAG SET + JRST (C) ;SET => INTRA-SYLLABLE OPERATOR +RR10: TRNE I,IRLET ;NOT SET => SYLLABLE TERMINATOR: SYL? + POPJ P, ;SYL HAS LETTERS + TRNN I,IRSYL + JRST CABPOP ;NO SYL + CAMN SYM,[SQUOZE 0,.] + JRST PT1 ;SYM IS . + ;NUMBER + +RR5: TLNN I,ILNPRC + PUSHJ P,NUMSL + TLNN I,ILFLO + JRST RR9 ;NOT FLOATING POINT + MOVE A,B ;FLOATING, HIGH IN AA,LOW IN A,EXP IN B + ADDI A,306 ;201+105 TO ROUND + ADDI AA,200 ;CAUSE EXPONENT TO BE ACCEPTABLE TO MACHINE + JUMPGE AA,.+3 ;NOW CHECK FOR OVERFLOW ON ROUNDING + LSH AA,-1 ;OVERFLOW, SHIFT BACK ONE + AOS A ;INCREMENT EXPONENT TO COMPENSATE FOR SHIFT + EXCH A,AA ;GET EXPONENT IN AA, REST IN A + ASHC AA,-10 ;SHIFT TO MACHINE FLOATING POINT FORMAT + SKIPE AA ;NOW CHECK HIGH ORDER BITS OF EXPONENT NOT SHIFTED INTO NUMBER + ETR [ASCIZ /Exponent overflow/] +RR9: TLZ I,ILGLI+ILVAR ;NOT TRYING TO DEFINE NUMBER AS VARIABLE OR GLOBAL +CLBPOP: TDZA B,B ;CLEAR OUT B (RELOCATION BITS OF VALUE) +CABPOP: SETZB A,B ;DO JRST CABPOP TO RETURN ZERO AS VALUE + POPJ P, + +RRU: MOVE A,LIMBO1 ;GET HERE WHEN FLUNRD SET AT RR, RETRIEVE CHARACTER FROM LIMBO1 + CAIG A,14 ;IF TOO BIG, + CAIGE A,12 ;OR IF TOO SMALL, + JRST RR1B ;THEN JUST FALL BACK IN + TLNN FF,FLVOT\FLMAC\FLTTY ;SKIP IF NOT HACKING CPGN/CLNN + XCT RRUTAB-12(A) ;HACKING, UNHACK FOR HACK COMING UP + JRST RR1B ;FALL BACK IN + +RRUTAB: SOS CLNN ;LINE FEED (TABLE FOR RRU) + JRST RR1B ;13 + SOS CPGN ;FORM FEED + + ;MAIN LOOP ROUTINE FOR GETSYL, READ SYM OR NUMBER +VBLK +RR: TLZE FF,FLUNRD ;RE-INPUT LAST CHARACTER? + JRST RRU ;YES +RR1: JRST RRL1 ;ILDB A,CPTR ;GET CHAR (" " ") + HALT ;TRZE A,200 ;CHECK FOR END OF STRING +RREOF: PUSHJ P,RCH ;PUSHJ P,MACTRM ;PROCESS CONDITION, GET NEXT CHAR OR JRST RR1 OR RRU + .SEE RCHTRA ;SPECIAL HANDLING OF UNRCHF IN RCHTRA IF CALLED FROM HERE. +RR1B: XCT GDTAB(A) ;GOT CHAR, DO SOMETHING APPROPRIATE (POPJ ON NOT SQUOZE) + TROA I,IRLET\IRSYL ;LETTERS RETURN, JUST UPDATED SYM, SET FLAGS + TRO I,IRSYL ;NUMBERS RETURN, SET FEWER FLAGS + SOJGE D,RR1 ;DECREMENT SYM COUNTER AND LOOP + AOJA D,RR1 ;COUNTER EXHAUSTED, INCREMENT BACK TO 0 AND LOOP + +RRL1: PUSHJ P,RCH ;ILDB A,UREDP ;GET CHAR + XCT GDTAB(A) ;NOW MAKE LIKE RR1B (EOFCH => JRST RREOF) + TROA I,IRLET\IRSYL + TRO I,IRSYL + SOJGE D,RRL1 + AOJA D,RRL1 + + ;SEMICOLON (GET HERE FROM RR8) + + JRST SEMICL ;RETURN HERE FROM SEMIC+2 WHEN FLUNRD SET +;NEXT 4 INSNS ALTERED IN DIFFERENT INPUT MODES. SEE RCHFIL, ETC. +SEMIC: PUSHJ P,RCH ;GET CHAR + CAIE A,15 ;SEE IF SPECIAL + JRST SEMIC ;SPECIAL => DO SOMETHING (JRST SEMICR ON CR) + JRST SEMICR ;IF NOT SPECIAL THEN GO BACK FOR NEXT CHAR + +LOC SEMIC+6 ;LEAVE A LITTLE EXTRA ROOM FOR BIG ROUTINES +PBLK + +SEMICL: MOVE A,LIMBO1 ;HERE FROM SEMIC-1, RETRIEVE CHARACTER FROM LIMBO1 + CAIE A,15 ;SKIP IF SHOULD TERMINATE SCAN + JRST SEMIC ;NOT CR, FALL BACK IN + JRST SEMICR ;DONE + +SEMIC2: +REPEAT 5,[ + ILDB A,UREDP + CAIG A,15 + XCT RPATAB(A) +] + MOVE A,[ASCII /@@@@@/] +SEMIC1: AOS CH1,UREDP + MOVE CH1,(CH1) ;ANY CONTROL CHARS IN THE WORD UREDP POINTS AT? + MOVE CH2,CH1 + AND CH1,A + AND CH2,[ASCII/ /] + LSH CH2,1 + IOR CH1,CH2 + CAMN CH1,A + JRST SEMIC1 ;NO, ADVANCE TO NEXT WORD AND TEST IT. + MOVEI A,440700 + HRLM A,UREDP + JRST SEMIC2 ;YES, LOOK AT EACH CHAR AND PROCESS IT. + +SEMIC3: REPEAT 6,JRST SEMIC2+3*<5-.RPCNT> + +;JSP CH2,RR2 => DIGIT (FROM GDTAB) +;THIS ROUTINE IS GROSSLY SLOW, AND SHOULD BE SPEEDED UP SOMETIME + +RR2: XCT NSQTB-"0(A) ;UPDATE SQUOZE. + TRNE I,IRLET + JRST 1(CH2) ;SYL IS SYM, DON'T WASTE TIME. + TRNE I,IRPERI + TLO I,ILFLO ;DIGIT AFTER . => FLOATING. +MAKNUM: SETOM NTCLF ;NUMTAB ABOUT TO NOT BE CLEAR, SET FLAG FOR GETSYL TO CLEAR IT OUT NEXT TIME + MOVEI AA,2 ;INDEX INTO NUMTAB ETC., SOJGE'D TO GET ALL RADICES +MAKNM1: MOVE T,ARADIX(AA) ;GET THIS RADIX, + CAMN T,ARADIX ;REDUNDANT => SKIP THIS PASS. + JUMPN AA,MAKNM4 + SKIPGE CH1,HIGHPT(AA) + JRST MAKNM3 + MUL T,LOWPT(AA) ;TT HAS OLD LOW TIMES RADIX, T HAS OVFLO TO HIGH. + ADDI TT,-"0(A) ;ADD DIGIT TO LOW PART + TLZE TT,400000 + AOJ T, ;OVERFLOW, INCREMENT SPILLOVER FROM MUL OF LOWPT + JUMPE CH1,MAKNM5 ;OLG HIGHPT WAS 0 => SAVE TIME. + JFCL 17,.+1 ;NOW CLEAR OV, ETC. + IMUL CH1,ARADIX(AA) ;MULTIPLY HIGHPT BY RADIX + ADD T,CH1 ;ADD HIGH PARTS + JFCL 10,MAKNM2 ;JUMP ON OVERFLOW FROM IMUL OR ADD +MAKNM5: TLNE I,ILFLO + SOS NUMTAB(AA) ;FLOATING, DECREMENT EXP TO COMPENSATE FOR MULT OF HIGHPT/LOWPT + MOVEM T,HIGHPT(AA) ;NOW STORE STUFF BACK + MOVEM TT,LOWPT(AA) +MAKNM4: SOJGE AA,MAKNM1 ;NOW DO ALL THIS FOR NEXT RADIX + JRST 1(CH2) + +MAKNM2: MOVSI B,400000 ;OVERFLOW FROM UPDATING HIGH PARTS + IORM B,HIGHPT(AA) ;SET SIGN BIT +MAKNM3: TLNN I,ILFLO + AOS NUMTAB(AA) ;NOT FLOATING, INCREMENT EXP, MAY NOT WANT TRAILING BITS + JRST MAKNM4 + +VBLK +NUMTAB: 0 ;EXPONENT + 0 + 0 +HIGHPT: 0 ;HIGH PART OF CURRENT NUMBER THIS RADIX + 0 ;4.9 => OVERFLOW, TRAILING DIGITS DROPPED + 0 +LOWPT: 0 ;LOW PART OF CURRENT NUMBER THIS RADIX + 0 ;HIGHPT/LOWPT TAKEN AS 70. BIT POSITIVE INTEGER EXCEPT 4.9(HIGHPT) IS FLAG INSTEAD OF + 0 ;EXPONENTIATE 70. BIT INTEGER BY NUMTAB (WHICH MAY BE NEGATIVE) TO GET ACTUAL VALUE +ARADIX: 10 ;CURRENT RADIX + 12 + 10 + +NTCLF: -1 ;-1 => NUMTAB NOT CLEAR (TO SAVE BLT AT GETSYL WHEN CLEAR) +PBLK + +;JRST POINT => . (FROM GDTAB) + +POINT: TLO I,ILDECP ;PREFER DECIMAL + TROE I,IRPERI ;SET PERIOD FLAG + TRO I,IRLET ;2 POINTS => NAME + ADD SYM,%.SQ(D) ;UPDATE SYM + JRST 1(CH1) ;RETURN + +RBRAK: SOSL SCNDEP ;IF A CONDITIONAL TO TERMINATE, + JRST RBRAK2 ;HAVE DONE SO, IGNORE CHAR. + SETZM SCNDEP +;CLOSES OF ALL KINDS COME HERE. +RPARN: +GRTHN: MOVE A,LIMBO1 + SKIPE CH1,ASMOUT ;WHAT KIND OF OPEN ARE WE IN? + CAIN CH1,4 ;WITHIN A .ASCII OR + JRST RBRAK1 ;NOT WITHIN GROUPING => THIS CLOSE IS STRAY. + CAME A,ASMOT1(CH1) ;RIGHT KIND OF CLOSE FOR THAT OPEN? + ERJ RBRAK3 +RBRAK4: MOVE CH1,ASMOT2(CH1) + MOVEM CH1,ASMDSP ;ARRANGE FOR THIS ASSEM1 LEVEL TO EXIT +RBRAK5: SETZM CDISP + JRST RR10 ;AND GO TERMINATE WORD. + +RBRAK3: CALL TYOERR ;COME HERE ON CLOSE WRONG FOR OPEN. + ;(EG, ")" MATCHING "<"). + TYPR [ASCIZ/ Seen when /] + MOVE A,ASMOT1(CH1) + CALL TYOERR + TYPR [ASCIZ/ expected +/] + JRST RBRAK4 + +RBRAK1: CAIN CH1,4 ;CLOSE INSIDE A .ASCII => + JRST RBRAK5 ;TERMINATE WORD BUT DON'T CLOSE ANYTHING. + SKIPN CONSML ;COME HERE FOR STRAY CLOSE. + JRST RRL2 + ERJ .+1 + TYPR [ASCIZ/Stray /] + MOVE A,LIMBO1 ;GET THE CLOSE WE SAW. + CALL TYOERR + CALL CRRERR + JRST RRL2 + +;COME HERE FOR CLOSE-BRACE, AND CERTAIN CLOSE-BRACKETS. +RBRAK2: SETOM A.SUCC ;HAVE JUST ENDED SUCCESSFUL BRACKETED CONDIT, + JRST RRL2 ;REMEMBER THAT MOST RECENT CONDITIONAL WAS TRUE. + +FORMF: TLNN FF,FLVOT\FLMAC\FLTTY ;FORM FEED SYLLABLE OPERATOR ROUTINE + PUSHJ P,RPAFF ;UNLESS ALREADY DONE, INCREMENT PAGE #. + JRST RR10 + +LINEF: TLNN FF,FLVOT\FLMAC\FLTTY ;LINE FEED SYLLABLE OPERATOR ROUTINE + CALL RPALF + JRST RR10 + +CTLAT: +IFN DECSW\TNXSW,[ + TLNN FF,FLVOT\FLMAC\FLTTY ;^@ SYLLABLE OPERATOR ROUTINE. + CALL RPANUL +] + JRST RRL2 + +;DECIPHER A VALUE FROM NUMTABS +;LEAVES HIGH PART IN AA, LOW PART IN A, BINARY EXPONENT IN B +;AND RADIX USED IN D. + +NUMSL: TLNN I,ILVAR\ILDECP\ILFLO + SKIPE B,HIGHPT + JRST NUMSLS + MOVE A,LOWPT ;BE VERY FAST IN CASE OF SMALL FIXNUM IN CURRENT RADIX. + MOVE D,ARADIX ;SAVE RADIX AND HIGH PART FOR ^. + SETZ AA, + RET + +NUMSLS: CLEARB TT,D ;TT BIT EXPONENT, D INDEX INTO NUMTAB, ETC. + TLNE I,ILDECP+ILVAR ;NEITHER . NOR ', CURRENT RADIX. + TLNE I,ILGLI ;" => CURRENT RADIX DESPITE . OR '. + JRST NUMSL0 + MOVEI D,1 ;DECIMAL UNLESS ' + TLNE I,ILVAR ;WHICH FORCES OCTAL. + MOVEI D,2 + MOVE A,ARADIX(D) + CAMN A,ARADIX ;IF REALLY SAME AS CURRENT RADIX, + MOVEI D,0 ;COMPUTATION WASN'T DONE FOR THIS VALUE OF D, + ;SO USE COMPUTATIONS DONE FOR CURRENT RADIX. +NUMSL0: MOVE AA,HIGHPT(D) ;AA := HIGH PART + MOVE B,LOWPT(D) ;B := LOW PART + MOVE T,NUMTAB(D) ;T := EXPONENT + MOVE D,ARADIX(D) ;NO LONGER NEED IDX, GET RADIX VALUE. + TLNN I,ILFLO + JRST FIXNUM ;NOT FLOATING + TLZ AA,400000 ;FLOATING, DON'T NEED DIGITS LOST ON OVERFLOW +NUMC1: JUMPN AA,.+2 ;ENTRY FROM UPARR + JUMPE B,FIX0 ;COMPLETELY ZERO => RETURN FIXED ZERO + JUMPL T,NUMSL1 ;JUMP IF EXPONENT NEGATIVE + JUMPE T,NUMSL2 ;JUMP (SKIP FOLLOWING) IF EXPONENT ZERO + ;EXPONENT POSITIVE, DO THE APPROPRIATE THING +NUMSL5: MULI B,(D) ;MULITIPLY LOW PART BY RADIX + MULI AA,(D) ;MULTIPLY HIGH PART BY RADIX + ADD A,B ;A := LOW PART OF HIGH + HIGH PART OF LOW + TLZE A,400000 + ADDI AA,1 ;OVERFLOW ON ADDITION, INCREMENT HIGH PART OF HIGH + MOVE B,C ;NO LONGER NEED HIGH OF LOW, GET LOW OF LOW IN B +NUMSL3: JUMPE AA,NUMSL4 ;NOW CHECK FOR OVERFLOW INTO HIGH OF HIGH, JUMP ON NONE + ASHC A,-1 ;NEXT THREE INSTRUCTIONS TO DO ASH3 AA,-1 + ASH A,1 + ASHC AA,-1 + AOJA TT,NUMSL3 ;INCREMENT BIT EXPONENT AND TRY AGAIN + +NUMSL4: MOVE AA,A ;FLUSHED OVERFLOW, NOW GET (LOW PART OF) HIGH PART IN AA + SOJG T,NUMSL5 ;COUNT DOWN + +NUMSL2: TLNN I,ILFLO + JRST NUMSL9 ;NOT FLOATING, DON'T WASTE TIME NORMALIZING. + SKIPA A,B ;EXPONENT NOW ZERO, GET LOW PART OF NUMBER IN A +NUMSL7: ASHC AA,1 ;NOW NORMALIZE + TLNN AA,200000 + SOJA TT,NUMSL7 + SKIPA B,TT ;DONE NORMALIZING, RETURN BINARY EXPONENT IN B +PT1: TRO I,IRLET + POPJ P, + +NUMSL9: MOVE A,B + MOVEI B,0 + ASHC AA,(TT) ;SHIFT 2-WD NUM. BY EXPONENT, + LSH A,1 ;PUT HIGH BIT IN WITH REST. + JRST FIX1 + +FIX0: TLZ I,ILFLO +FIXNUM: LSHC A,45 +FIX1: LSHC AA,-1 + JUMPE AA,.+2 + ETR [ASCIZ /FIXNUM too big for 36 bits/] + POPJ P, + +NUMSL1: SKIPA A,B ;EXPONENT NEGATIVE: NORMALIZE NOW +NUMSL8: ASHC AA,1 +NUMSL6: TLNN AA,200000 + SOJA TT,NUMSL8 ;NOT NORMALIZED YET + AOS T + MOVEI TM,(D) + TLNN TM,-1 ;GET CONVIENT POWER OF RADIX + JUMPL T,[ IMULI TM,(D) + AOJA T,.-1] + MOVE B,A ;GET NORMALIZED LOW PART IN B + IDIV AA,TM ;DIVIDE HIGH PART BY APPROPRIATE RADIX + DIV A,TM + JUMPL T,NUMSL6 + MOVE B,A + JRST NUMSL2 + +UPARR: TRON I,IRSYL + JRST UPCTRC ;"UNARY UPARROW" => GOBBLE CHARS + TRNE I,IRLET + ETR [ASCIZ /Symbolic 1st arg to "^"/] + PUSHJ P,NUMSL ;DECIPHER NUMTABS + PUSHJ P,UA3 ;GET RIGHT OPERAND IN T + MOVE TT,B ;EXPONENT + MOVE B,A ;LOW PART + PUSHJ P,NUMC1 ;T EXP HIGH IN AA LOW IN B TT BIN EXP + MOVE C,CDISP ;IF A _ WAS DEFERRED WHILE ILUARI WAS SET, + TLO I,ILNPRC + CAME C,[DSYL,,BAKAR] ;DO IT NOW. + JRST RR10 + +BAKAR: TLNE I,ILUARI + JRST RR5 ;RETURN TO UPARROW (WILL COME BACK HERE LATER) + TRNE I,IRSYL + TRNE I,IRLET + JRST BAK1 ;NO SYL, OR SYL IS NAME + CAMN SYM,[SQUOZE 0,.] + JRST BAK1 ;. ALSO NAME + TLZN I,ILNPRC + PUSHJ P,NUMSL + PUSHJ P,UA3 + ADD B,T + ASHC AA,(B) + LSH A,1 + LSHC AA,-1 + CLEARB B,AA + TLZ I,ILFLO + MOVE C,[DFLD,,CBAKAR] + EXCH C,CDISP ;IF 2ND ARG ENDED WITH A _, TURN INTO FIELD OP. + CAME C,[DSYL,,BAKAR] + EXCH C,CDISP + POPJ P, + +UPCTRC: SETZ T, +UPCTR1: JSP F,QOTCOM ;UP ARROW TO GOBBLE SYL AND RETURN MASKED ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + CAIL A,140 + SUBI A,40 + ANDI A,77 ;NOW MASK CHARACTER IN TO TO BOTTOM 6 BITS + ADD T,A ;ADD TO ACCUMULATED + POPJ P, + +BAK1: MOVE TT,[DFLD,,CBAKAR] + MOVEM TT,CDISP + JRST RR10 + +UA3: HRLM D,(P) ;SAVE RADIX (FOR UPARR) + JSP LINK,SGTSY ;PUSH I,AA,A,B + TLO I,ILUARI ;TELL _ TO WAIT TILL LATER (SEE UPARR, BAKARR) + PUSHJ P,RCH + CAIN A,"- + TROA I,IRGMNS + TLO FF,FLUNRD + PUSHJ P,RCH + CAIN A,"< + JRST UAR1 + TLO FF,FLUNRD +UA3L: PUSHJ P,GTSL1 ;GOBBLE SYL, LOOP POINT FOR PSEUDO OR MACRO RETURNED WITHOUT VALUE + TRNE I,IRLET + JRST UA3S ;NAME + TLNE I,ILFLO + ETR [ASCIZ /Floating point 2nd arg to "_"/] +UAR2: TRZN I,IRGMNS + SKIPA T,A + MOVN T,A + JSP LINK,SGTSY1 ;RESTORE GETSYL TEMPS. + HLRZ D,(P) + POPJ P, + +UA3S: PUSHJ P,GETVAL ;MAKE NUMBER_NAME WORK + JRST UA3SR ;GOT VALUE, PROCESS + JRST UA3L ;NO VALUE, TRY AGAIN + +UAR1: TLO I,ILLSRT + TRZ I,IRSYL ;(OR ELSE LSSTH GIVES NOS ERROR.) + SETZB A,B + PUSHJ P,LSSTH +UA3SR: JUMPN B,RLCERR ;RELOC ERR + JRST UAR2 + +ATSGN: MOVSI A,20 ;ATSIGN + IORM A,WRD + TRO I,IRFLD ;SET IRFLD FLAG EVEN THOUGH NOT DIRECTLY RETURNING VALUE + ; ^ CHANGED FROM SYL TO FIELD 9/6/70 + JRST RRL2 ;FALL BACK IN + +DQUOTE: TRON I,IRSYL + JRST DQUOT8 + TRNN I,IRLET ;AFTER NUMBER => CURRENT RADIX. + JRST DQUOT7 + PUSHJ P,RCH + TLO FF,FLUNRD ;NEXT CHAR. SQUOZE? + HLRZ A,GDTAB(A) + CAIN A,(POPJ P,) + JRST DQUOT7 ;NO => MAKE PREV. SYM. GLOBAL. + CAMN SYM,[SQUOZE 0,.M] ;SPECIAL BLOCK NAMES + JRST DQUOTM ;.M MEANS MAIN BLOCK, + CAMN SYM,[SQUOZE 0,.U] + JRST DQUOTU ;.U MEANS SUPERIOR. + CAMN SYM,[SQUOZE 0,.C] + JRST DQUOTC ;.C MEANS CURRENT BLOCK. + SKIPGE A,ESBK ;GET SPEC'D BLOCK OR CURRENT, + HRR A,BKCUR ;LOOK FOR SUBBLOCK OF THAT BLOCK. + HLL A,BKTAB+1(A) + ADD A,[1,,] ;LH HAS LEVEL SUBBLOCK OUGHT TO HAVE. + MOVEI T,0 + SETO D, ;NO POSSIBLE ALTERNATE CHOICE YET. +DQUOT0: CAME SYM,BKTAB(T) ;LOOK AT ALL BLOCKS SEEN. + JRST DQUOT1 ;HAS THE NAME WE'RE LOOKING FOR? + SKIPGE ESBK ;IF LOOKING FOR A SUBBLOCK OF A PARTICULAR BLOCK, + JRST DQUOT4 + CAMN A,BKTAB+1(T) + JRST DQUOT2 ;SUCH A BLOCK WINS; ALL OTHERS LOSE. + JRST DQUOT1 + +DQUOT4: SKIPN BKTAB+2(T) ;ELSE PREFER DEFINED BLOCKS TO UNDEFINED ONES. + JUMPGE D,DQUOT1 + SKIPE BKTAB+2(T) + JUMPL D,DQUOT5 + CAME D,[-1] ;THAT'S THE SAME EITHER WAY => PREFER AN INFERIOR + CAMN A,BKTAB+1(T) ;OF THE CURRENT BLOCK TO ONE THAT'S NOT. + JRST DQUOT5 + JRST DQUOT1 + +DQUOT5: HRROI D,(T) ;FOUND A BLOCK WE LIKE BEST SO FAR. + SKIPE BKTAB+2(T) + ANDI D,-1 ;LEAVE SIGN OF D SET UNLESS THE BLOCK IS DEFINED. +DQUOT1: ADDI T,BKWPB + CAMGE T,BKTABP + JRST DQUOT0 + HRRZI T,(D) ;NOW USE THE BEST BLOCK FOUND, IF THERE WAS ONE. + CAIE T,-1 + JRST DQUOT2 + MOVE T,BKTABP ;NOT FOUND, GET IDX OF 1ST UNUSED ENTRY. + CAIL T,BKTABS + ETF ERRTMB ;NO ROOM FOR MORE BLOCKS. + MOVEM SYM,BKTAB(T) + MOVEM A,BKTAB+1(T) ;ADD BLOCK AT END. + MOVEI A,BKWPB(T) + MOVEM A,BKTABP ;POINTS AFTER LAST USED ENTRY. +DQUOT2: MOVEM T,ESBK + SETZ SYM, +DQUOT3: MOVEI D,6 ;NEXT CHAR GOES IN 1ST SQUOZE POS. + JRST RRL2 + +DQUOTM: MOVEI T,BKWPB ;.M - MAIN BLOCK FOLLOWS INITIAL SYMS BLOCK. + JRST DQUOT2 + +DQUOTU: SKIPGE T,ESBK ;.U SPEC'D - GET SPEC'D OR CURRENT BLOCK, + MOVE T,BKCUR + HRRZ T,BKTAB+1(T) + JRST DQUOT2 ;SPEC. ITS SUPERIOR. + +DQUOTC: SKIPGE T,ESBK ;.C => SPEC THE CURRENT BLOCK. + MOVE T,BKCUR + JRST DQUOT2 + +SQUOT1: TLOA I,ILVAR +DQUOT7: TLO I,ILGLI + MOVE A,BKCUR ;IF NO SPEC'D BLOCK, + SKIPGE ESBK + MOVEM A,ESBK ;SPEC. CURRENT BLOCK. + JRST RRL2 + +DQUOT8: SETZ T, +DQUOT9: JSP F,QOTCON ;DOUBLE QUOTE TO GOBBLE SYL AND RETURN ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + ADD T,A ;ADD IN ASCII CHARACTER IN A + POPJ P, ;RETURN TO SOMETHING + +SQUOTE: TROE I,IRSYL + JRST SQUOT1 + SETZ T, +SQUOT9: JSP F,QOTCON ;SIXBIT SYL + CAIGE A,40 + ETR ERRN6B ;NOT SIXBIT + CAIL A,140 + SUBI A,40 ;CONVERT TO UPPER CASE + LSH T,6 ;SHIFT OVER ACCUMULATED VALUE + ADDI T,-40(A) ;ADD IN SIXBIT FOR CHARACTER IN A + POPJ P, + +;COMMON ROUTINE FOR RIGHT JUSTIFIED TEXT SYLS +;CALLED WITH JSP F,; ROUTINE PUSHJ'S BACK W/ CHAR IN T, ACCUM VALUE IN A +;SYL FLAG EXPECTED TO BE ALREADY SET +QOTCON: SKIPE QMTCH ;' AND " COME HERE, BUT NOT ^: IF IN QUOTES-MATCHING MODE, USE A + JRST QOTCO4 ;FAIL-LIKE ALGORITHM. HERE FOLLOWS THE OLD MIDAS WAY OF DOING IT +QOTCOM: CALL RCH ;USE AT LEAST 1 CHAR IN ANY CASE. + JRST QOTCO1 + +QOTCO2: CALL RCH ;USE SUCCEEDING CHARS IF SQUOZE CHARS. + HLRZ CH1,GDTAB(A) + CAIN CH1,(POPJ P,) + JRST QOTCO3 +QOTCO1: CALL (F) + JRST QOTCO2 + +QOTCO3: CAIN A,"" ;NONSQUOZE: IF IT IS A TEXT SYL INDICATOR, + JRST DQUOT9 ;CONTINUE WITH WHATEVER TYPE OF TEXT + CAIN A,"' + JRST SQUOT9 ;IT INDICATES. + CAIN A,"^ + JRST UPCTR1 +QOTCO6: TLO FF,FLUNRD + JRST TEXT5 + +QOTCO4: MOVE B,LIMBO1 ;GET ' OR ", WHICHEVER STARTED THIS SYL, AS THE DELIMITER. + MOVE SYM,[SQUOZE 0,TEXT] + JSP TM,ERMARK +QOTCO5: CALL RCH + CAMN A,B ;FOUND ANOTHER EXAMPLE OF THE DELIMITER? + JRST [ CALL RCH ;IF DUPLICATED, IT PUTS THE DELIMITER IN THE CONSTANT. + CAMN A,B + JRST .+1 + JRST QOTCO6] ;OTHERWISE UNREAD THE CHAR AFTER THE DELIMITER AND EXIT. + CALL (F) ;HAVE CHAR TO PUT IN STRING IN A; GO MERGE IT IN. + JRST QOTCO5 + +;RETURN A VALUE FROM A PSEUDO WHOSE ARGS CAN BE TERMINATED BY EITHER COMMA (GOBBLED) +;OR CR (NOT GOBBLED). +VALRET: MOVE T,A ;ROUTINE TO RETURN VALUE IN A AFTER LAST CHAR GOBBLED BY GETSYL + MOVE B,CDISP ;GET STORED DISPATCH CODE + TLNN B,DWRD\DFLD + JRST VALR1 ;WORD TERMINATOR +;COME HERE TO RETURN A VALUE, AND ALSO +;BARF IF THE NEXT CHARACTER ISN'T A SYLLABLE SEPARATOR +TEXT5: PUSH P,T ;ENTRY FROM TEXT ROUTINES (NLAST CHAR NOT GOBBLED BY GETSYL) TO RETURN VALUE IN T + PUSHJ P,GETSYL ;SEE IF IMMEDIATELY FOLLOWED BY SYL + TRNE I,IRSYL + ETR ERRNOS ;NO SEPARATOR BETWEEN TWO VALUES + POP P,A ;RESTORE VALUE TO RETURN +VALR1: TRO I,IRSYL + JRST CLBPOP + +;VARIOUS PUSH AND POP ROUTINES, ALL CALLED W/ JSP LINK, + +SGTSY: PUSH P,I + PUSH P,AA + PUSH P,A + PUSH P,B + JRST (LINK) + +SGTSY1: POP P,B + POP P,A + POP P,AA + POP P,I + JRST (LINK) + +;JSP LINK,SAVWD1 TO SAVE STUFF FOR < OR (, ETC. + +SAVWD1: PUSH P,A ;SYLL. BEFORE GROUPING NOW STARTING. + PUSH P,B ;AND ITS RELOC. + +SAVWLD: PUSH P,FORMAT + PUSH P,FORPNR + PUSH P,FLDCNT + PUSH P,GLSP2 + PUSH P,I + PUSH P,WRD + PUSH P,WRDRLC + PUSH P,SYM + PUSH P,PPRIME + PUSHJ P,(LINK) +SAVL1==. + +;POP OFF WHAT PUSHED BY SAVWLD. CLEARS FLUNRD, IN CASE THE > OR ) WAS UN-READ. + +USVWLD: POP P,SYM + HRRZS SYM + CAIE SYM,SAVL1 + HALT + TLZ FF,FLUNRD + POP P,PPRIME + POP P,SYM + POP P,WRDRLC + POP P,WRD + TDZ I,[-1-(ILWORD)] + IOR I,(P) + POP P,1(P) + POP P,GLSP2 + POP P,FLDCNT + POP P,FORPNR + POP P,FORMAT + JRST (LINK) + +;;GETFD ;GET FIELD (EXPRESSION); RETURN VALUE IN A, RELOC BITS IN B + + ;GET FIELD FOR PSEUDO + ;SYM SHOULD CONTAIN THE SQUOZE NAME OF THE PSEUDO + ;OR A POINTER TO AN INSN TO EXECUTE WHEN UNDEF + ;SYMBOL SEEN. SYM IS NOT CLOBBERED. + +AGETFD: PUSH P,I ;SAVE I + TRO I,IRPSUD+IRNOEQ ;SET FLAG TO GETVAL TO EXECUTE GTVER ON UNDEFINED SYM ON EITHER PASS + PUSH P,GTVER ;OLD VALUE OF GTVER + MOVEM SYM,GTVER ;ERROR MSG SHOULD GIVE NAME OF PSEUDO. + CALL YGETFD + MOVE SYM,GTVER + REST GTVER + MOVEM I,ISAV ;SAVE FLAGS FOR FIELD GOTTEN +POPIJ: POP P,I + POPJ P, + +;READ A FIELD, NOT PART OF THE CURRENT WORD. +YGETFD: PUSH P,WRD + SETZM WRD + CALL XGETFD + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + ADD A,WRD ;ADD IN INDEX, INDIRECT FIELDS + POP P,WRD + POPJ P, + +IFN FASLP,[ +FAGTFD: PUSHJ P,AGETFD ;DO AGETFD, COMPLAIN IF RELOCATABLE OR GLOBAL + MOVE TM,GLSP1 + CAMN TM,GLSP2 + SKIPE B + ETSM [ASCIZ /relocatable or external argument/] + POPJ P, +] +;READ A FIELD PART OF CURRENT WORD (FOR XWD, ETC). +XGETFD: PUSH P,PPRIME +AGTFD3: PUSHJ P,GETFLD + MOVE CH1,CDISP + TLNN CH1,DWRD + TLOA FF,FLUNRD ;DELIMITER IS WORD TERMINATOR => RE-READ IT. + TRNE I,IRFLD ;NON-NULL FIELD SUPPLIED => RETURN IT. + JRST AGTFD4 + HRRZ C,CDISP ;ELSE COMMA => RETURN NULL VALUE (0) + CAIN C,SPACE ;SPACE => TRY AGAIN TO READ A FIELD. + JRST AGTFD3 ;NO FIELD, TRY AGAIN +AGTFD4: REST PPRIME + POPJ P, + + ;IN RELOCATABLE FORMAT + ;READ FIELD AND COPY OUT AS WORD + +RGETFD: SETZM WRD ;FIRST INITIALIZE SOME STUFF AS THOUGH AT GETWD + SETZM WRDRLC + MOVE A,GLSPAS + MOVEM A,GLSP1 + MOVEM A,GLSP2 + CALL XGETFD + ADDM A,WRD + ADDM B,WRDRLC + PUSHJ P,PWRDA ;OUTPUT WORD + TLNE I,ILMWRD + JRST IGTXT ;SOAK UP MULTI-WORD FIELD + POPJ P, + +;READ IN A FIELD, RETURN IN A,B SETTING IRFLD IF FIELD NOT NULL. +GETFLD: PUSH P,GLSP1 ;REFERED TO AS GETFLB(P) WHEN ONLY 1 SYL PUSHED. + MOVEM P,PPRIME + TRZ I,IRFLD+IROP +GETFD1: TLNE I,ILMWRD + JRST GETFD9 ;MULTIPLE WORD, RE-CALL PSEUDO + PUSHJ P,GETSYL + TRNE I,IRLET +GETFD9: PUSHJ P,GETVAL ;GET OPERAND (MAYBE SKIPS) +GETFD6: SKIPA C,CDISP ;GET INFO ON SYLLABLE TERMINATOR + JRST GETFD1 ;GETVAL SKIPPED => PSEUDO/MACRO WITH NO VALUE, TRY AGAIN + TLNE C,DFLD + JRST (C) ;FIELD OPERATOR, GO PROCESS + TRNE I,IRSYL ;NO DISP MEANS FIELD TERMINATOR. + TRO I,IRFLD + CAME P,PPRIME ;IF ANY OPERATORS PUSHED, + JSP LINK,GETFD8 ;EVAL THEM. + SUB P,[1,,1] ;FLUSH GLSP1 SAVED AT GETFLD. + RET + +GETFD8: MOVEI TT, ;END OF FIELD HAS VERY LOW PRIORITY. + JRST GETFD7 + +;PUSH AN OPERATOR, MAYBE EVALLING STUFF TO LEFT. +;A HAS LEFT OPERAND (IF ANY), B RELOCATION BITS, +;C ADR OF ROUTINE TO PERFORM OPERATION, LH OF TT HAS PRECEDANCE OF OPERATOR + +GETFDL: MOVEI LINK,GETFD3 ;AFTER MAYBE EVALLING, GO PUSH OPERATOR. + TRO I,IRFLD+IROP + TRNN I,IRSYL + JRST GETFD5 ;UNARY, EVAL NOTHING, JUST PUSH WITH HIGH PRIO. +GETFD2: CAME P,PPRIME ;NO OPS TO LEFT => NOTHING TO EVAL. + CAMLE TT,GETFLP(P) ;COMPARE PRIO OF PREV. OP. AND CURRENT. + JRST (LINK) ;WAIT UNTIL LATER +GETFD7: HRRZ T,GETFLP(P) ;EVAL THE LAST OP ON STACK. + JRST (T) ;GO DO IT NOW (ROUTINE RETURNS TO GETFD4) +GETFD4: SUB P,[4,,4] + JRST GETFD2 + +GETFD5: MOVSI TT,200 ;GIVE UNARY OP HIGH PRIO. TO DO BEFORE NEXT BINARY. +GETFD3: PUSH P,B ;GETFLR(P) + PUSH P,A ;GETFLV(P) + HLL C,TT + PUSH P,C ;GETFLP(P) + PUSH P,GLSP1 ;GETFLG(P) + JRST GETFD1 + +GETFLB==,-4 ;PDL IDX OF GLSP1 BEFORE LEFT OPERAND. +GETFLR==,-3 ;PDL IDX OF RELOC OF LEFT OPERAND. +GETFLV==,-2 ;PDL IDX OF VALUE OF LEFT OPERAND. +GETFLP==,-1 ;PDL IDX OF PRIO,,DISPATCH +GETFLG==0 ;PDL IDX OF GLSP1 AFTER LEFT OPERAND (=BEFORE RIGHT) + +PLS: MOVEI C,PLS1 ;PLUS SIGN, PLS1 IS ROUTINE TO PERFORM OPERATION +MINUS2: MOVSI TT,10 ;SET UP PRECEDENCE OF 10 FOR +, - + JRST GETFDL + +MINUS: JSP C,MINUS2 ;MINUS SIGN + MOVNS A ;NEGATE VALUE OF RIGHT OPERAND + MOVNS B ;ALSO RELOCATION +;433 This instr was causing [foo] and [-foo] to be mistakenly +; constants-optimized to the same thing during pass1, resulting in a +; "more constants on pass2 than pass1" error. +; JUMPGE FF,PLS1 + MOVE T,GETFLG(P) + PUSH P,B + HRLZI B,MINF + PUSH P,C + PUSHJ P,LNKTZ ;COMPLEMENT THE MINUS FLAG ON GLOBALS IN RIGHT OPERAND + POP P,C + POP P,B +PLS1: ADD A,GETFLV(P) ;ADD VALUES + ADD B,GETFLR(P) ;ADD RELOCATIONS + JRST GETFD4 + +LNKTZ: TDZA C,C +LNKTC1: MOVE T,GLSP2 +LINKTC: CAML T,GLSP1 + POPJ P, + SKIPL 1(T) + XORM B,1(T) + SKIPL 1(T) + IORM C,1(T) + AOJA T,LINKTC + +MULTP: MOVEI C,MULTP1 ;ASTERISK, MULTP1 ROUTINE TO PERFORM MULTIPLICATION +DIVID2: MOVSI TT,20 ;20 PRECEDENCE OF MULTIPLICATION, DIVISION + JRST GETFDL + +MULTP1: SKIPL CONTRL ;ELSE IN DECREL ASSEMBLY, TEST FOR EXTERNALS. + JUMPGE FF,MULTR + MOVE D,GETFLB(P) ;ACTUALLY, GET HERE FOR ABS ASSEMBLIES TOO, BUT SO WHAT? + CAMN D,GLSP1 + JRST MULTR + SKIPGE FF + ETR [ASCIZ /Externals multiplied/] + TLO I,ILNOPT ;DON'T OPTIMIZE LITERALS CONTAINING UNDEFS ON PASS 1. +MULTR: JUMPE B,MULTP3 ;JUMP ON RIGHT OPERAND NOT RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;BOTH OPERANDS RELOCATED + MOVE T,GETFLV(P) ;GET VALUE OF LEFT OPERAND AND FALL IN + JRST MULTP5 + +MULTP3: MOVE T,A ;RIGHT OPERAND NOT RELOCATED, GET VALUE IN T + MOVE B,GETFLR(P) ;RELOCATION BITS OF LEFT OPERAND +MULTP5: MOVE D,GETFLG(P) ;GLOTB POINTER TO BETWEEN OPERANDS + CAME D,GETFLB(P) + JRST GMUL1 ;LEFT OPERAND HAS GLOBALS + CAME D,GLSP1 + JRST GMUL2 ;RIGHT OPERAND HAS GLOBALS + ;AT THIS POINT, T HAS VALUE OF ABS OPERAND, B RELOC BITS OF OTHER +GMUL4: IMUL A,GETFLV(P) ;MULTIPLY VALUES + IMULB B,T ;MULTIPLY RELOCATION OF ONE BY VALUE OF OTHER + TRZ T,1 + SKIPL CONTRL ;EXCEPT IN STINK ASSEMBLY, OBJECT TO RELOCATION + JRST GETFD4 ;OTHER THAN 0 OR 1 (ONLY AFFECTS DECREL, SINCE + JUMPE T,GETFD4 ;RELOCATION CAN'T BE NONZERO IN ABS ASSEMBLY). +MULTP4: ETR [ASCIZ+Relocatable arg to * or / or Boolean+] + JRST GETFD4 + +GMUL1: TLNE FF,FLPPSS ;LEFT OPERAND HAS GLOBALS, CHEK RIGHT OPERAND + CAMN D,GLSP1 + SKIPA CH1,A ;LOOKS OK, GET VALUE IN CH1 + ETR [ASCIZ /Multiplying two externals/] + SKIPA D,GETFLB(P) ;GET GLOTB POINTER TO BOTTOM OF LEFT OPERAND +GMUL2: MOVE CH1,GETFLV(P) ;GLOBALS IN RIGHT OPERAND ONLY, GET LEFT OPERAND +GMUL3: CAML D,GLSP1 + JRST GMUL4 ;TABLE COUNTED OUT + SKIPGE 1(D) + AOJA D,GMUL3 + JUMPE CH1,GMUL5 ;MULTIPLYING BY ZERO, CLEAR OUT GLOTB ENTRY AND LOOP BACK + LDB CH2,[221200,,1(D)] ;PICK UP MULTIPLICATION FIELD THIS GLOBAL + SKIPN CH2 + MOVEI CH2,1 ;0 => 1 + IMUL CH2,CH1 + CAIN CH2,1 + MOVEI CH2,0 ;IF ONE THEN USE ZERO + DPB CH2,[221200,,1(D)] + AOJA D,GMUL3 + + +GMUL5: CLEARM 1(D) + AOJA D,GMUL3 + +DIVID: JSP C,DIVID2 ;SLASH, PRECEDENCE = 20 +DIVID1: JUMPN B,MULTP4 ;JUMP IF RIGHT OPERAND RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;LEFT OPERAND RELOCATED + EXCH A,GETFLV(P) + IDIV A,GETFLV(P) + MOVEI B,0 + MOVE D,GETFLB(P) + CAMN D,GLSP1 ;IF THERE ARE EXTERNALS OR UNDEFINED SYMBOLS, + JRST GETFD4 + SKIPGE FF ;ON PUNCHING PASS IT'S AN ERROR. + ETR [ASCIZ /Division involving externals/] + TLO I,ILNOPT ;ON PASS 1, DON'T OPTIMIZE THIS IF IN A LITERAL. + JRST GETFD4 + + ;LOGIC OPERATORS & (PREC = 40), # (PREC = 34), \ (PREC = 30) + +ANDF: MOVSI TT,40 ;& + JSP C,GETFDL + JSP D,LOGIC1 ;GO DO IT + AND A,GETFLV(P) ;INSTRUCTION ARGUMENT TO LOGIC1 + +XORF: MOVSI TT,34 ;# + TRNN I,IRSYL ;IF ABOUT TO BE UNARY, + MOVNI A,1 ;THEN TURN LEFT OPERAND INTO -1 + JSP C,GETFDL + JSP D,LOGIC1 + XOR A,GETFLV(P) + +IORF: MOVSI TT,30 ;\ + JSP C,GETFDL + JSP D,LOGIC1 + IOR A,GETFLV(P) + + ;COMMON EXECUTION ROUTINE FOR LOGICAL OPERATORS + +LOGIC1: JUMPN B,MULTP4 ;NO RELOCATION ALLOWED + SKIPE GETFLR(P) ;NOW CHECK RELOCATION OF LEFT OPERAND + JRST MULTP4 + XCT (D) ;ALL TESTS PASSED, DO IT + MOVE D,GETFLB(P) ;ARE THERE ANY GLOBALS OR UNDEFINED SYMBOLS? + CAMN D,GLSP1 + JRST GETFD4 ;NO. + SKIPGE FF ;YES. ON THE PUNCHING PASS, THAT'S AN ERROR. + ETR [ASCIZ /External in arg to \, & or #/] + TLO I,ILNOPT ;ON PASS 1, JUST DON'T OPTIMIZE IF IN LITERAL. + JRST GETFD4 + +CBAKAR: MOVSI TT,100 ;BACKARROW AS FIELD OPERATOR, PREC = 100 + JSP C,GETFDL ;RETURN TO GETFLD TO READ 2ND ARGUMENT. + JSP D,LOGIC1 ;FOR EVALUATION, CALL LOGIC1 + JSP D,.+1 ;WHICH EXECUTES THIS INSTRUCTION, + MOVE T,A ;TO CALL THIS SUBROUTINE. + MOVE A,GETFLV(P) + LSH A,(T) + JRST (D) + +;D SHOULD HAVE 1 FOR <, 2 FOR (, 3 FOR [ ;] +LSSTH9: JSP LINK,SAVAS1 ;SAVE ASSEM1 PDL LEVELS, .BYTE MODE, ETC. + MOVEM D,ASMOUT ;SAY WHAT KIND OF OPEN WE JUST DID + JRST ASSEM3 ;REENTER ASSEM1 LOOP AT INNER LEVEL. + +;COME HERE TO EXIT FROM AN ASSEM1 LEVEL THAT WAS ENTERED BY LSSTH9. +LSSTHA: SKIPE BYTM ;IN BYTE MODE, DO .WALGN. SINCE ASMDSP + JRST A.BY3 ;STILL POINTS HERE, WE'LL COME BACK. + MOVE P,CONSTP + JSP T,CONNDP ;POP STUFF SAVED BY SAVAS1 + MOVE A,WRD ;RETURN THE WORD IN THE GROUPING + MOVE B,WRDRLC ;(OUR CALLER WILL USVWLD, CLOBBERING WRD) + POPJ P, + +LSSTH: MOVEI D,1 ;1 FOR <. + JSP LINK,SAVWD1 + PUSHJ P,LSSTH9 +LSSTH3: JSP LINK,USVWLD ;POP OFF ALL BUTPREVIOUS SYLL. + +;GROUPINGS EXCEPT (PARENS THAT ADD TO WORD) +;SYLL IMMEDIATELY BEFORE OR AFTER IS ERROR. +LSSTH2: ADDM A,-1(P) ;SYLL BEFORE GROUPING, PUSHED BY SAVWD1. + ADDM B,(P) + TRNE I,IRSYL ;IF WAS SYLL BEFORE GROUPING, ERROR. + ETR ERRNOS +LSSTH5: MOVE A,LIMBO1 ;CHECK FOR FOLLOWING SYLL. + CAIE A,15 + CAIN A,12 + JRST LSSTH6 ;DELIMITER CR OR LF + PUSHJ P,RCH ;NOT CR OR LF, GET NEXT CHAR + CAIN A,"! ;IGNORE EXCLAMATION POINT + JRST .-2 + TLO FF,FLUNRD ;CAUSE IT TO BE RE-INPUT + HLRZ CH1,GDTAB(A) + CAIE CH1,(POPJ P,) + JRST LSSTH4 ;SQUOZE CHAR. MEANS FOLLOWING SYLL. + HRRZ CH1,GDTAB(A) + MOVE CH1,DTB-40(CH1) ;GET DISPATCH FOR CHAR. + TLNE CH1,DSY1 ;MIGHT START SYL => NOS ERROR. + JRST LSSTH4 +LSSTH7: PUSHJ P,GTSL1 +LSSTH6: TRO I,IRSYL + POP P,B + POP P,A ;VALUE OF GROUPING WAS ADDM'ED INTO THESE. + TLZE I,ILLSRT ?.SEE UA3 + RET ;IF CALLED BY ^ OR _ AS SYL OP, RETURN TO IT. + JRST GETFD6 + +LSSTH1: TLO I,ILWORD ;A NUMBER IN PARENS BY ITSELF IS A NONNULL WORD. + ADDM A,WRD + ADDM B,WRDRLC + TRNE I,IRSYL ;IF SYLL BEFORE, + JRST LSSTH5 ;ERROR IF SYL AFTER. + JRST LSSTH8 ;ELSE NO ERROR. + +LSSTH4: ETR ERRNOS ;FOLLOWING SYLL WHEN THAT IS ERROR. +LSSTH8: TLNE I,ILLSRT ?.SEE UA3 + JRST LSSTH6 + SUB P,[2,,2] + JRST GETFD1 + +ERRNOS: ASCIZ /Syllables not separated/ + +POP2J: SUB P,[2,,2] + POPJ P, + +LEFTP: MOVEI D,2 ;2 FOR ). + JSP LINK,SAVWD1 + MOVEI C,0 + TRNE I,IROP + TRNE I,IRSYL + TLO C,400000 ;CAUSE IT TO GET ADDED INTO WORD STEAD HAVE VALUE AS SYL + PUSH P,C + PUSHJ P,LSSTH9 + POP P,C + MOVSM A,T1 ;STORE SWAPPED VALUE + ADDI B,400000 ;NOW WANT TO SWAP RELOCATION, MAKE LH CORRECT + HLREM B,T2 ;STORE AS RH WITH SIGN EXTENDED + MOVSI B,400000(B) ;GET RIGHT HALF IN LEFT + ADDM B,T2 ;FINISH RELOCATION SWAP (THIS IS PAINLESS COMPARED TO THE HAIR EVERYWHERE + ;ELSE WHEN KEEPING THE HALFWORDS SEPARATE) + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + JSP LINK,USVWLD + MOVE A,T1 + MOVE B,T2 + JUMPL C,LSSTH1 ;ADD TO WHOLE WORD + JRST LSSTH2 + +;VERSION OF GETWRD FOR PSEUDO, +;PSEUDO MUST EITHER SAVE I, PPRIME AND GTVER OR RETURN TO ASSEM1. +;SYM SHOULD HOLD NAME OF PSUEUDO. + +AGETWD: MOVEM SYM,GTVER ;STORE NAME OF PSEUDO FOR UNDEF SYM MSGS. + TRO I,IRPSUD\IRDEF\IRNOEQ + PUSHJ P,GETWRD + MOVE SYM,GTVER ;RESTORE SYM. + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + RET + +;;GETWD ;READ A WORD, LEAVE VALUE IN A AND WRD, RELOC IN WRDRLC AND B + +GETWRD: MOVE T,GLSP1 + MOVEM T,GLSP2 + CLEARM FORMAT ;CLEAR FORMAT, WILL ACCUMULATE FORMAT NUMBER BY IDPB + CLEARM WRD ;CLEAR WRD, WILL ACCUMULATE ABSOLUTE PART OF WORD + CLEARM WRDRLC ; " RELOCATION BITS, " + TDZ I,[ILWORD,,IRIOINS] + CLEARM FLDCNT ;NO FIELDS YET + MOVE T,[50100,,FORMAT] ;SET UP BIT POINTER TO FORMAT + MOVEM T,FORPNR +GTWD1: PUSHJ P,GETFLD ;READ NEXT FIELD +SPACE6: MOVEI T,1 ;SET T TO 1, AC FOR IDPB ON ROUTINE DISPATCHED TO + SKIPA C,CDISP +SPACE5: REST A + TLNE C,DWRD + JRST (C) ;NO DISPATCH MEANS WD TERMINATOR + MOVE C,GLSP1 + MOVEM C,LINKL ;MARK END OF ACTIVE PART OF GLOTB + TRNN I,IRFLD + JRST GETWD2 ;LAST FIELD NULL, MAYBE HAVE TO POP STUFF OFF + IDPB T,FORPNR ;MARK NON-NULL FIELD IN FORMAT +GTWD4A: TLO I,ILWORD ;NON-NULL WORD + MOVE TT,FORMAT + SKIPN TT,FORTAB-10(TT) ;PICK UP BYTE POINTER POSITION/SIZE FIELDS FOR FIELDS IN WORD + ETR [ASCIZ /Undefined format/] + MOVEM TT,FORMAT ;STORE IN FORMAT + MOVE T,[301400,,FORMAT] + MOVEM T,FORPNR + ;AT THIS POINT, FLDCNT HAS 1 LESS THAN # FIELDS; PUT FIELDS TOGETHER TO FORM WORD +GTWD3: LDB T,FORPNR + MOVE D,FLDCNT + CAIG D,2 + IBP FORPNR ;HAVEN'T BACKED UP TO THIRD FIELD YET, INCREMENT TO DESC FOR PREV + TRNE I,IRIOINS + PUSHJ P,INTIOW + PUSHJ P,INTFLD ;PUT FIELD WHERE IT BELONGS + SOSGE FLDCNT + JRST GTWD5 ;THIS WAS LAST (FIRST) FIELD + POP P,GLSP2 ;NOT YET, POP OFF MORE + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD3 + +GTWD5: MOVE A,WRD + MOVE B,WRDRLC + MOVE C,LINKL + MOVEM C,GLSP1 + TRZ I,IRIOINS + POPJ P, + +COMMA: TRNN I,IRFLD ;FIELD DELIMITER WAS COMMA (T HAS 1) + JRST COMMA1 ;NO FIELD + IDPB T,FORPNR ;MARK NON-NULL FIELD +COMMA4: IDPB T,FORPNR ;MARK FIELD TERMINATOR WAS COMMA + MOVE TT,FLDCNT + CAIL TT,2 + ETR [ASCIZ /Comma past the 3rd field of a word/] +PUSHFD: PUSH P,A ;DONE WITH THIS FIELD, NOW TO GET NEXT + PUSH P,B + PUSH P,GLSP1 + PUSH P,GLSP2 + AOS FLDCNT ;ANOTHER FIELD + MOVE TT,GLSP1 + MOVEM TT,GLSP2 + HRRZ T,FORPNR + CAIE T,FORMAT + HRRZS FORPNR ;STABILIZE FORPNR + TLO I,ILWORD ;SAY WE HAVE A NON-NULL WORD IN PROGRESS (LOC, ETC. ILLEGAL). + JRST GTWD1 + +GETWD2: SKIPN FORMAT ;LAST FIELD OF WORD IS NULL + JRST GTWD5 ;ENTIRE WORD NULL, MAYBE WERE PARENS. + SOS FLDCNT + POP P,GLSP2 + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD4A + +COMMA1: LDB TT,FORPNR ;COMMA TERMINATED NULL FOELD. + SKIPE FORMAT + JUMPE TT,COMMA2 ;NOT 1ST FIELD, JMP IF PREV WAS TERM BY SPACE. + IBP FORPNR ;ELSE MARK NULL FIELD IN FORMAT. + JRST COMMA4 + +;FIELD SPACE COMMA, PATHOLOGICAL CASE +;(EG MACRO STARTED WITH A COMMA) +COMMA2: DPB T,FORPNR ;REPLACE SPACE WITH COMMA. + JRST GTWD1 + + ;FIELD TERMINATOR IS SPACE (T HAS 1) + +SPACE: MOVE TT,LIMBO1 + CAIE TT,^I ;HEURISTIC: REAL SPACES ARE LIKELY TO BE FOLLOWED BY SQUOZE, + JRST SPACE4 ;WHILE TABS ARE LIKELY TO BE FOLLOWED BY COMMENTS. + PUSH P,A + MOVE TT,GDTAB+40 + PUSHJ P,RCH + CAMN TT,GDTAB(A) + JRST .-2 ;FLUSH OTHER LOGICAL SPACES + CAIN A,"; ;TAB WAS FOLLOWED BY SEMICOLON: + JRST [ PUSH P,B + TRZ I,IRSYL + CALL SEMIC ;FLUSH THE COMMENT + MOVEI T,1 + REST B + JRST SPACE5] ;AND HANDLE THE C.R. +SPACE3: POP P,A + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-READ NEXT TIME +SPACE4: TRNN I,IRFLD + JRST GTWD1 ;NO FIELD + IDPB T,FORPNR ;T HAS 1, MARK NON-NULL FIELD IN FORMAT + IBP FORPNR ;MARK FIELD TERMINATOR WAS SPACE + JRST PUSHFD + +;T HAS DESC BYTE, PUT FIELD IN ITS PLACE +;ALSO CALLED FROM PBYTE, MUSTN'T CLOBBER AA. + +INTFLD: MOVE TT,GLSP2 + CAMN TT,GLSP1 + JUMPE B,INTFD1 ;NO GLOBALS, JUMP IF NO RELOCATION + CAIN T,2222 ;LH + JRST INTL + CAIN T,22 ;RH + JRST INTR + CAIN T,44 ;WHOLE WORD + JRST INTW + SKIPE B + ETR [ASCIZ/Relocation attempted in irrelocatable field/] + ;(ASSUME) NO RELOCATION, CHECK FOR GLOBAL AC FIELDS + CAIN T,2704 ;HIGH AC + JRST INTACH + CAIN T,504 ;AC LOW + JRST INTACL + JUMPGE FF,INTFD1 ;JUMP ON NOT PUNCHING PASS + CAME TT,GLSP1 + ETR [ASCIZ/Global symbol in illegal field/] +INTFD1: MOVEI TT,C_12. + ROTC T,-12. ;SHIFT BYTE POINTER INTO TT + MOVEI C,0 ;INITIALIZE C TO RECEIVE FIELD IN PROPER PLACE + DPB A,TT + CAMN TT,[2200,,C] + JRST INTFD2 ;RIGHT HALF, DON'T ALLOW CARRY INTO LH + ADDM C,WRD ;ALLOW CARRY +INTFD3: ADDM B,WRDRLC ;ADD RELOCATIONS, WILL BE BROKEN BACK INTO HALF-WORDS LATER + POPJ P, + +INTFD2: ADD C,WRD ;ADD RIGHT HALVES + HRRM C,WRD + JRST INTFD3 + +INTIOW: CAIE T,2704 + CAIN T,504 + TRZA A,3 ;IO DEVICE FIELD + POPJ P, ;NOT "AC" FIELD + ADDI T,611-504 + POPJ P, + +INTR: HRRE D,B ;RH + MOVEI B,0 + PUSH P,T + HRLZI C,HFWDF + PUSHJ P,LNKTC1 ;THIS IS A BUG WHICH SHOULD BE FIXED SOMETIME +PRTCL: MOVE B,D ;GET BACK MAPPED RELOCATION BITS +PRTCL2: POP P,T +INTW: MOVE D,GLSP2 ;WHOLE WORD + HRLOI LINK,377777 + CAML D,GLSP1 + JRST INTFD1 + ANDM LINK,1(D) + AOJA D,.-3 + +INTL: HRLZ D,B ;LH + MOVSI B,SWAPF + MOVSI C,HFWDF + PUSH P,T + MOVE T,GLSP2 +INTL2: CAML T,GLSP1 + JRST PRTCL + SKIPGE 1(T) + AOJA T,INTL2 ;INDEX FIELD, ETC => LEAVE ALONE + IORM C,1(T) ;SET HFWDF + XORM B,1(T) ;COMPLEMENT SWAP STATUS + TDNN B,1(T) + SETZM 1(T) ;SWAPPED TO RH, FLUSH IT + AOJA T,INTL2 + +INTACL: TDZA B,B ;AC LOW +INTACH: HRLZI B,SWAPF ;AC HIGH + HRLZI C,ACF + PUSH P,T + PUSHJ P,LNKTC1 + MOVEI B,0 + JRST PRTCL2 + +IOINST: HLLZ A,B ;IO INSTRUCTION, GET WHICH ONE INTO A + SKIPN FLDCNT ;THIS FIRST FIELD OF WORD? + TRO I,IRIOINS ;YES + JRST CLBPOP ;RETURN VALUE + +;TOP LEVEL LOOP, ASSEMBLE STORAGE WORDS +;LOTS OF PSEUDOS MEANINGLESS IN STORAGE WORDS +;(E.G. BLOCK, CONSTA) DO JRST ASSEM1 WHEN DONE +;THERE'S ALSO AN ERROR UUO WHICH RETURNS TO ASSEM1 + +ASSEM1: MOVE P,ASSEMP + JRST @ASMDSP + +;COME HERE TO START THE NEXT EXPRESSION OR WHATEVER. +ASSEM3: PUSHJ P,RCH + CAIN A,^I + JRST ASSEM2 ;PROBABLY NOT PROFITABLE TO SKIP AFTER SEE A TAB. + CAIG A,40 + JRST ASSEM3 ;FLUSH LEADING GARBAGE + TLO FF,FLUNRD ;CAUSE NON-GARBAGE CHAR FOUND TO BE RE-INPUT +;ASMDSP POINTS HERE WITHIN ASCII, SIXBIT ETC. +ASSEM2: TRZ I,IRFLD+IRSYL+IRLET+IRPSUD+IRCOM+IRCONT+IRGMNS+IROP+IRNOEQ+IREQL + TLZ I,ILGLI+ILVAR+ILFLO+ILDECP+ILUARI+ILWORD+ILNPRC+ILNOPT + IOR I,ASMI ;SET DEF AND RESTORE PSEUDF. + MOVE A,GLSPAS + SKIPL BYTM + MOVEM A,GLSP1 + ;GETWRD WILL COPY GLSP1 INTO GLSP2 +IFN TS,[AOSN TTYBRF ;DO A ^H-BREAK IF REQUESTED. + CALL TTYBRK] + PUSHJ P,GETWRD + TLZN I,ILWORD + JRST @ASMDSP ;NO WORD ASSEMBLED,TRY AGAIN + SKIPGE BYTM + JRST PBYTE ;IN BYTE MODE, OUTPUT BYTE INSTEAD OF WORD, A,B MUST HAVE WRD,WRDRLC. + MOVE AA,ASMOUT ;OUTPUT WD AS APPRO. FOR GROUPING, IF ANY. + JRST @ASMOT0(AA) + +ASSEM6: SKIPE STGSW ;ASMOT0 POINS HERE. COME IF NOT IN GROUPING. + ETR ERRSWD ;STORAGE WORD ASSEMBLED + PUSHJ P,PWRD ;OUTPUT THE WORD. + AOS CLOC + HRRZS CLOC ;INCREM. POINT . + JRST @ASMDSP ;ASSEM3 OR ASSEM2 + +ERRSWD: ASCIZ /Storage word assembled/ + +ASSEM4: JSP T,PCONST ;ASMOT0+3 POINTS HERE. COME IF IN CONSTANT. + JRST @ASMDSP + +;ASMDSP POINTS HERE WITHIN GROUPING IF NOT IN MULTI-LINE MODE +;[ ;AND NO CLOSE (">)]") HAS BEEN SEEN. +ASSEMC: MOVE AA,ASMOUT + SKIPE CONSML ;IN ERROR MODE, GIVE APPROPRIATE ERROR MSG. + XCT ASMOT3(AA) + JRST @ASMOT2(AA) ;CLOSE WHATEVER TYPE GRPING WE'RE IN. + +;JUMP THRU THIS TABLE TO OUTPUT A WORD. +ASMOT0: ASSEM6? ASSEM1? ASSEM1? ASSEM4? [HALT ] + +;THIS TABLE GIVES APPRO. CLOSE FOR EACH TYPE OF GROUPING. ;[ +ASMOT1: "? ? "> ? ") ? "] ? "? + +;THIS TABLE SAYS WHERE TO GO TO END THE GROUPING. +ASMOT2: [HALT ]? LSSTHA? LSSTHA? CONND? [HALT ] + +;APPROPRIATE ERROR MESSAGE FOR MISSING CLOSE OF GROUPING. [ +ASMOT3: HALT + ETR [ASCIZ /Missing >/] + ETR [ASCIZ /Missing )/] + ETR [ASCIZ /Missing ]/] + HALT + +;THIS TABLE TELLS PBYTE HOW TO HANDLE BYTE MODE. +ASMOT4: PBY4 ? PBY5 ? PBY5 ? PBY3 ? [HALT ] + +;TABLE SAYING WHAT CHAR MUST HAVE OPENED THE GROUPING. +ASMOT5: "? ? "< ? "( ? "[ ? "? ;] + +;;GETVAL ;GET VALUE OF SYM + ;SKIPS ON PSEUDO NOT RETURNING VALUE (E.G. MACRO STARTING TO BE EXPANDED) + ;ELSE RETURNS VALUE IN A, RELOCATION BITS IN B + +VBLK +GTVER: 0 ;SQUOZE NAME OF CALLING PSEUDO, OR POINTER + ;TO INSN TO EXECUTE WHEN IF SYM IS UNDEF. +PBLK + +GETVAL: PUSHJ P,ES + JRST GVNF ;NO STE. +IFN CREFSW,XCT CRFINU ;JFCL OR CALL TO CREF RTN. + JRST @.+1(A) ;FOUND, DISPATCH ON SQUOZE FLAGS + +GVTAB: GVCOM ;COMMON (UNUSED) + GVPSEU ;PSEUDO OR MACRO. + GVSYM ;LOCAL SYMBOL. + GVUL ;LOCAL UNDEF (MAYBE STINK KNOWS VALUE) + GVDLV ;DEFINED LOCAL VAR. + GVULV ;UNDEF LOC VAR. + GVDGV ;DEF GLO VAR + GVUGV ;UNDEF GLO VAR + GVDG ;DEF GLOBAL + GVUG ;UNDEF GLOBAL + +;DEF LOCAL VAR. +GVDLV: PUSHJ P,GVDLGV ;IF PASS2 AND HAS ' THIS TIME, SET 3VAS2 FOR AVARIAB + TLZN I,ILGLI + JRST GVDLV2 + MOVSI T,DEFGVR ;NOW DEF GLO VAR. + PUSHJ P,VSM2 + JRST GVDG1 ;MAYBE OUTPUT GLOBAL DEF. TO STINK. + +GVDGV: PUSHJ P,GVDLGV ;DEF GLO VAR; IF PASS 2 AND ' THIS TIME, SET 3VAS2 + JRST GVDG2 ;MUSN'T PUNCH VALUE, AVARIAB WILL. + +GVDLGV: TRNE FF,FRPSS2 ;IF PASS 2 + TLNN I,ILVAR ;AND THIS TIME HAVE SINGLEQUOTE + POPJ P, + TLO C,3VAS2 ;TELL AVARIAB SEEN IN PASS 2 WITH '. + 3PUT C,D + POPJ P, + +GVULV: TLZN I,ILGLI ;UNDEF LOCAL VAR, MAYBE MAKE GLOBAL. + JRST GVUNDF + PUSHJ P,PLOGLO ;IF SO, TELL STINK SYM IS GLOBAL, + MOVSI T,UDEFGV ;SYM NOW UNDEF GLO VAR + PUSHJ P,VSM2 + JRST GVUNDF ;IN EITHER CASE, HANDLE UNDEF SYM. + +GVUL: TLZE C,3MACOK ;UNDEF LOCAL, PRESUMED NUMERIC + 3PUT C,D ;DON'T LET IT BECOME MACRO AND SCREW PASS2. + TLNE C,3LLV + JRST GVGLTB ;(REALLY DEFINED BUT ONLY STINK KNOWS HOW) + TLNE I,ILGLI ;IF MAKING GLOBAL, TELL STINK. + PUSHJ P,PLOGLO +GVNF1: TLZE I,ILVAR ;IF ', MAKE VAR (WILL CHECK ILGLI) + JRST GVUL1 + TLZN I,ILGLI ;NOT MAKING VAR, MAYBE GLOBAL? + JRST GVUNDF ;NO, MAYBE ERROR, MAKE GLOTB ENTRY. + MOVSI T,GLOEXT + PUSHJ P,VSM2 ;NOW GLOBAL UNDEF, + JRST GVGLTB ;NO ERROR, JUST GLOTB ENTRY. + +GVUL1: TLZN I,ILGLI ;UNDEF LOCAL BECOMES + SKIPA T,[UDEFLV,,] ;UNDEF LOC VAR OR +GVGVAR: MOVSI T,UDEFGV ;UNDEF GLO VAR. +GVVAR: CALL ESDEF ;DEFINING SYM AS A VAR => INSIST ON DEFINING LOCAL TO INNERMOST BLOCK. + JFCL + AOS VARCNT + HRR B,VARCNT + PUSHJ P,VSM2 ;MAKE IT A VAR, + JRST GVUNDF ;PRETEND HAD ALREADY BEEN A VAR. + +GVUG: TLZE I,ILVAR ;UNDEF GLOBAL: MAYBE MAKE UNDEF GLO VAR. + JRST GVGVAR +GVGLTB: SKIPGE CONTRL ;UNDEF GLO IN ABS ASSEM => + JRST GVUND1 ;MAYBE TREAT AS UNDEF. +GVGLT1: AOS GLSP1 ;DON'T KNOW SYM'S VALUE, MAKE GLOTB ENTRY. + MOVEI T,ST(D) + HRRZM T,@GLSP1 + JRST CABPOP ;RETURN 0 AS VALUE. + +GVNF: +IFN CREFSW,XCT CRFINU ;ONLY IF NOT FOUND WOULD NOT CREF AFTER ES. + TLNE I,ILVAR+ILGLI ;MAKING VAR OR GLOBAL FORCED CURRENTBLOCK ALREADY + JRST GVNF1 ;AND WILL STORE NAME IN STE ANYWAY. + SKIPGE ESBK ;ELSE IF NO SPEC'D BLOCK, + TRNN FF,FRNPSS ;FORCE .MAIN BLOCK SO DON'T GET LOTS OF UNDEF ENTRIES. + CAIA ;BUT CAN'T DO THAT FOR 1PASS OR WOULD MISS FWD REFS. + HRRI C,BKWPB + MOVSI T,LCUDF + PUSHJ P,VSM2 + JRST GVUNDF ;MAYBE ERROR, MAKE GLOTB ENTRY. + +GVCOM: TRO I,IRCOM ;COMMON: SAY THIS WAS ONE. + HRRZ A,B ;RETURN RH OF VALUE, ABSOLUTE. + JRST CLBPOP + +GVPSEU: TLNN I,ILVAR+ILGLI ;CAN'T MAKE PSEUD OR MACRO GLOBAL OR VAR. + JRST (B) ;OTHERWISE, DISPATCH TO IT. + TLZE I,ILVAR + ETSM ERRCBV + TLZE I,ILGLI + ETSM ERRCBG + JRST (B) ;DISPATCH TO PSEUDO (OR MACCL IF MACRO) + ;EXPECTS LH OF VALUE IN LH OF B. + +ERRCBV: ASCIZ /Can't be a variable/ +ERRCBG: ASCIZ /Can't be global/ + +GTVL7B: TLNE C,3RLL ;R(LH) + TLO SYM,200000 + TLNE C,3RLR ;R(RH) + TLO SYM,100000 + POPJ P, + +GVSYM: TLNN C,3REL + TLNE I,ILVAR\ILGLI + JRST GVSYM2 + MOVE A,B ;THIS CODE DOES WHAT GVSYM2 WOULD DO, BUT FASTER. + SETZ B, + RET + +GVSYM2: TLZE I,ILVAR ;LOCAL SYM: CAN'T MAKE VARIABLE. + ETSM ERRMDV + TLZN I,ILGLI + JRST GVSYM0 ;NOT MAKING GLOBAL, GET VALUE & RETURN. +GVSYM1: MOVSI T,GLOETY ;BECOMES DEF. GLOBAL. + PUSHJ P,VSM2 + JRST GVDG1 ;HANDLE AS IF WAS DEF GLOBAL. + +ERRMDV: ASCIZ /Multiply-defined variable/ + +GVDG: TLZE I,ILVAR ;GLOBAL ENTRY + ETSM ERRMDV +;COME HERE FOR DEF GLOBAL +GVDG1: SKIPGE CONTRL + JRST GVDLV2 ;DON'T PUNCH VALUE IF ABSOLUTE. + TLNE C,3VP + JRST GVDG2 ;VALUE PUNCHED ALREADY, NOT AGAIN. + JUMPGE FF,GVDG2 + TLNN C,3LLV + TRNE I,IRPSUD+IREQL + JRST GVDG2 + TLO SYM,40000 + PUSH P,WRD + PUSHJ P,OUTDE2 + POP P,WRD +GVDG2: TRNN I,IRPSUD\IREQL ;IF INSIDE AN ORDINARY STORAGE WORD, + TLNN C,3REL ;GENERATE A GLOBAL REF IF GLOBAL IS RELOCATABLE (HEURISTIC). +GVDLV2: TLNE C,3LLV ;IF VAL KNOWN ONLY BY STINK, MUST MAKE A GLOBAL REF. + JRST GVGLTB +GVSYM0: MOVE A,B ;USED IN LBRAK + LDB B,[.BP (3RLR),C] + TLNE C,3RLL + TLO B,1 + POPJ P, + +GVUND1: MOVE A,CONTRL + TRNE A,DECREL+FASL ;DEC FMT OR FASL => UNDEF GLOBALS OK. + JRST GVGLT1 +GVUGV: +GVUNDF: TRZ I,IRDEF ;UNDEFINED, MAYBE ERROR, MAKE GLOTB ENTRY. + TRNE I,IRPSUD\IREQL + JRST GVUND2 ;PSEUDO + TRNN FF,FRPSS2 + JRST GVGLT1 ;PASS 1 + SKIPN CONDEP + ETSM [ASCIZ/Undefined/] + SKIPE CONDEP + ETSM [ASCIZ/Undefined in literal/] + JRST CABPOP + +GVUND2: HLRZ A,GTVER ;DOES GTVER POINT TO AN INSN? + JUMPE A,[XCT @GTVER ? JRST CABPOP] + ERJ .+1 ;NO, IT IS NAME OF PSEUDO. + MOVE A,LINEL + CAIGE A,75. ;CR-LF-TAB NOW IF WHOLE MSG WON'T FIT ON A LINE. + CALL CRRTBX + TYPE2 SYM ;TYPE NAME OF UNDEF SYM. + TYPR [ASCIZ/ Undefined in /] + TYPE2 GTVER + CALL CRRERR + JRST CABPOP + +;EVALUATE SYMBOL, SQUOZE (FLAGS OFF) IN SYM +;IDX OF BLOCK TO DEFINE IN IN ESBK (OR -1 => ANY BLOCK NOW IN PROGRESS). +;DOESN'T CLOBBER F (FOR WRQOTE) +;RETURNS SKIPPING IF SYM FOUND, WITH SQUOZE FLAGS IN BOTTOM OF A, +;VALUE OF SYM IN B, STE IDX IN D, AND 3RDWD IN C. +;IF NOT FOUND, RETURNS IN D THE IDX OF A PLACE TO DEFINE SYM. +;CALL ESDCHK TO GET THE FOLLOWING EXTRA INFO (WHETHER SYM FOUND OR NOT): +;ESLAST -> LAST STE WITH DESIRED NAME SEEN, REGARDLESS OF WHAT BLOCK IT'S IN +;ESL1 HAS LEVEL OF BLOCK OF BEST STE SEEN, -1 IF NOT FOUND +;ESL2 HAS 3RDWRD OF BEST. +;ESXPUN HAS -1 OR IDX OF A STE WHICH MIGHT BE USED TO DEFINE THE SYM. +;RH(TM) GETS BLOCK IDX TO DEFINE IN IF DEFINE THE SYM. +;TT HAS -<# STE NOT LOOKED AT YET> +;THEN IF SYM IS FOUND IN A CONTAINING BLOCK AND YOU WANT TO DEFINE +;IT IN THE CURRENT BLOCK, YOU CAN CALL DEFCHK TO FIND AN STE TO DO IT IN. +;CALLING ESDEF IS AS GOOD AS CALLING ESDCHK AND DEFCHK, BUT DOESN'T +;LET YOU SEE WHAT YOU ARE GOING TO SHADOW. + +ESDEF: MOVE A,BKCUR ;EVAL SYM IN ORDER TO DEFINE IT: + SKIPGE ESBK ;IF NO SPEC'D BLOCK, SPEC THE CURRENT BLOCK, + MOVEM A,ESBK ;SO DEFS IN CONTAINING BLOCKS WON'T BE SEEN + +ESDCHK: SETOM ESLAST ;CALL HERE IF WE MIGHT END UP CALLING DEFCHK, + SETOM ESL1 ;SINCE IN THAT CASE WE'LL NEED THESE VARS EVEN IF SYM IS FOUND + SETOM ESXPUN ;RIGHT AWAY. + MOVN TT,SYMLEN +ES: MOVE C,SYM ;HASH AWAY + TSC C,SYM ;THIS MAKES SURE THAT THE FIRST FEW CHARS OF SYMBOL DON'T GIVE + ;A ZERO REMAINDER, IF SYMLEN IS A ROUND NUMBER. + MOVMS C ;THIS IS BECAUSE IDIV OF NEGATIVE NUMBER GIVES NEG. REMAINDER. + IDIV C,SYMLEN + IMUL D,WPSTE + SKIPGE TM,ESBK ;GET BKTAB IDX OF SPEC'D BLOCK + HRR TM,BKCUR ;OR -1,,BKTAB IDX OF CURRENT BLOCK. +;NOW CHECK FAST FOR AN IMMEDIATE MATCH - AVOID SETTING UP FLAGS NEEDED ONLY WHEN +;SYM APPEARS IN MULTIPLE BLOCKS OR ISN'T DEFINED. + SKIPN B,ST(D) + JRST ESEND0 ;SYM IS KNOWN NOT TO BE DEFINED. + TLZ B,740000 + CAME B,SYM + JRST ESBAD0 ;NOT FOUND IN 1ST ENTRY - MUST SET UP INFO AND LOOP + 3GET C,D + MOVEI A,(C) + CAIN A,(TM) + JRST ESGOOD ;IN THE DESIRED BLOCK => GOOD. + TDNN C,[3MAS,,-1] ;IN THE INITIAL SYMS BLOCK, NOT PRESENT IN ANY OTHER, + JUMPL TM,ESGOOD ;AND BLOCK WASN'T EXPLICITLY SPEC'D => GOOD. + MOVN TT,SYMLEN ;ELSE MUST KEEP LOOKING TO SEE IF THIS DEF IS REALLY ONE WE WANT. + SETOM ESLAST + SETOM ESL1 + SETOM ESXPUN + JUMPGE TM,ESIGN + JRST ESLP1 + +;LOOK AT THE NEXT STE, WHILE LOOPING. +ESLP: SKIPN B,ST(D) ;GET SQUOZE IN THIS ST SLOT + JRST ESEND ;NOTHING WHERE SYM BELONGS, END SEARCH + TLZ B,740000 ;CLEAR OUT FLAGS + CAME B,SYM ;COMPARE WITH WANTED + JRST ESBAD ;NO MATCH BUT MAYBE KEEP GOING + 3GET C,D ;FOUND SYM, GET 3RDWRD + MOVEI A,(C) + CAIN A,(TM) ;DEFINED IN DESIRED BLOCK + JRST ESGOOD ; => MUST BE GOOD. +ESLP0: JUMPGE TM,ESIGN ;BLOCK SPEC'D => ALLOW NO OTHERS. + TDNE C,[3MAS,,-1] ;IF IN INITIAL SYMS BLK, NO MORE DEFS, + JRST ESLP1 + SKIPGE ESL1 ;AND NO PREVIOUS DEFS, + JRST ESGOOD ;UNREDEFINED INITL SYM MUST BE GOOD. +ESLP1: HLRZ B,BKTAB+1(C) ;GET LEVEL OF BLOCK DEF. IS IN. + CAMN A,BKPDL(B) ;SAME AS BLOCK WE'RE IN AT THAT LEVEL? + CAMLE B,BKLVL ;AND NOT A BLOCK WE'VE EXITED + JRST ESIGN + CAMG B,ESL1 ;OR HIGHER LEVEL THAN PREVIOUS BEST + JRST ESIGN + MOVEM C,ESL2 ;REPLACE BEST'S 3RDWRD, LEVEL, ADDR. + MOVEM B,ESL1 + MOVEM D,SADR +ESIGN: HRRZM D,ESLAST ;THIS ENTRY LAST SEEN WITH THIS NAME. + TLNN C,3MAS ;MORE STE'S FOR THIS SYM => + JRST ESEND1 + JRST ESNXT ;KEEP LOOKING. + +;COME HERE IF 1ST SYM SEEN ISN'T THE SAME NAME. SET UP TO LOOP. +ESBAD0: MOVN TT,SYMLEN + SETOM ESLAST + SETOM ESL1 + SETOB C,ESXPUN +;HERE WHILE LOOPING WHEN SYM WITH WRONG NAME IS SEEN. +ESBAD: JUMPN B,ESNXT + SKIPGE A,ESXPUN ;IF THIS IS 1ST EXPUNGED ENTRY SEEN + MOVEM D,ESXPUN ;REMEMBER IT FOR DEFINITION. + SKIPGE A + HRROS ESLAST ;AND SET OLD ENTRY'S 3MAS. +ESNXT: ADD D,WPSTE + CAML D,SYMSIZ ;AT END => GO TO BEGINNING + MOVEI D,0 + AOJN TT,ESLP + JRST ESEND1 ;NOT FOUND. + +ESEND0: MOVEI C,(TM) ;COME HERE IF 1ST PLACE LOOKED AT SHOWS THE SYM ISN'T DEFINED + MOVEM D,ESXPUN + POPJ P, + +ESEND: SKIPGE A,ESXPUN ;FREE ENTRY CAN BE USED TO DEFINE. + MOVEM D,ESXPUN + SKIPGE A + HRROS ESLAST +ESEND1: SKIPGE ESL1 ;NOT FOUND => FIND PLACE TO DEFINE IT. + JRST DEFCH1 + MOVE D,SADR ;IDX OF BEST FOUND. + TRNN FF,FRNPSS + JRST ES1PS ;1-PASS, SPECIAL CHECK. + MOVE C,ESL2 ;GET BEST'S 3RDWRD. +ESGOOD: LDB A,[400400,,ST(D)] ;GET SQUOZE FLAGS IN A. +ES1POK: MOVE B,ST+1(D) ;VALUE OF SYM. IN B. + ;D HAS IDX OF 1STWRD IN SYM TAB. + ;C HAS 3RDWRD +POPJ1: AOS (P) +APOPJ: +CPOPJ: POPJ P, + +;ESDCHK THEN DEFCHK IS SAME AS CALLING ESDEF. +;WE ASSUME THAT D AND TT ARE STILL SET UP FROM A CALL TO ESDCHK. +DEFCHK: SKIPGE ESL1 ;IF WE DIDN'T TAKE TIME TO SET ESLAST BEFORE, + HRRZM D,ESLAST ;DO IT NOW. (SEE BEFORE ESLP1) + JRST DEFCH1 + +ES1PS: LDB A,[400400,,ST(D)] ;1PASS & FOUND IN CONTAINING BLOCK: + MOVE C,ESL2 + TRNN C,-1 ;INITIAL SYM, OK; + JRST ES1POK + CAIE A,1 ;PSEUDO OR MACRO + TLNE C,3DOWN ;OR .DOWN'D SYMBOL OK; + JRST ES1POK ;ELSE GET NEW STE TO DEF. +DEFCH1: MOVEI C,(TM) ;INITIALIZE NEW 3RDWRD WITH BLOCK TO DEF IN. + SKIPL D,ESXPUN ;IF FOUND EXPUNGED OR FREE ENTRY, USE IT. + JRST DEFCH2 + SKIPGE D,ESLAST ;ELSE LOOK FOR ONE. + ETF ERRSCE +DEFCH4: MOVE B,ST(D) + TLZ B,740000 + JUMPE B,DEFCH3 ;MUST RETURN 0 IN B IF DON'T SKIP. + ADD D,WPSTE + CAML D,SYMSIZ + MOVEI D,0 + AOJL TT,DEFCH4 ;ASSUME TT LEFT AROUND FROM ES. + ETF ERRSCE +ERRSCE: ASCIZ /Symbol table full/ + +;ESLAST HAS -1 IF NO ENTRY SEEN; ELSE +;RH HAS IDX OF LAST SEEN, SIGN SET IF SEEN BEFORE PLACE TO DEFINE. +DEFCH3: MOVEM D,ESXPUN ;REMEMBER ADDR WHERE CAN DEFINE + HRROS ESLAST ;LAST PLACE SEEN MUST BE EARLIER. +DEFCH2: SKIPL A,ESLAST + JRST DEFCH5 ;LAST PLACE SEEN WAS SEEN AFTER PLACE TO DEFINE. + CAMN A,[-1] + POPJ P, ;REALLY NEVER SEEN. + MOVSI TM,3MAS + IORM TM,ST+2(A) ;PLACE SEEN IS EARLIER, SET ITS 3MAS. + POPJ P, + +DEFCH5: TLO C,3MAS ;PLACE TO DEF BEFORE EXISTING STES. + POPJ P, + +;ENTER A SYM IN SYMBOL TABLE + ;B HAS VALUE + ;C HAS 3RDWRD + ;D HAS INDEX INTO ST (PROBABLY SET UP BY ES) + ;T HAS SQUOZE FLAGS (ONLY) IN PLACE FOR IOR OF SQUOZE + ;SYM HAS SQUOZE, FLAGS OF WHICH ARE IGNORED + +VSM2LV: TLOA C,3LLV ;ENTRY FOR LINKING LOADER MUST SUPPLY VALUE +VSM2W: MOVE B,WRD ;ENTRY TO ENTER VALUE OF WRD STEAD B +VSM2: MOVE CH1,SYM + TLZ CH1,740000 + IOR CH1,T ;CH1 := SQUOZE WITH FLAGS + MOVEM CH1,ST(D) ;STORE SQUOZE + MOVEM B,ST+1(D) ;STORE VALUE +VSM3A: 3PUT C,D ;STORE 3RDWRD + POPJ P, + +;RETURN THE NUMBER OF SYMTAB SLOTS IN USE. +A.SYMCN:SKIPL A,SMSRTF ;IF SYMTAB HAS BEEN COMPACTED, GET # OF SYMS THAT IT HAD + JRST CLBPOP ;BEFORE COMPACTION AND RETURN THAT. + MOVE D,SYMAOB + SETZ A, +A.SYC1: MOVE B,ST(D) + TLZ B,740000 + SKIPE B + AOS A + ADD D,WPSTE1 + AOBJN D,A.SYC1 + JRST CLBPOP + +;;EQUAL ;EQUAL SIGN ENCOUNTERED, DO PARAMETER ASSIGNMENT + +EQUAL: TLZ FF,FLHKIL + PUSHJ P,RCH + CAIE A,"= ;DECIDE WHETHER TO HALF-KILL THE SYM. + TLOA FF,FLUNRD + TLO FF,FLHKIL + SETZM LABELF + CALL RCH + CAIE A,": ;DECIDE WHETHER TO MARK SYM AS NOT REDEFINABLE. + TLOA FF,FLUNRD + SETOM LABELF + CAMN SYM,[SQUOZE 0,.] ;.=FOO, SAME AS LOC FOO + JRST PTEQ + TDNN I,[ILWORD,,IROP+IRNOEQ] + TRNN I,IRLET + ETR [ASCIZ/= With bad format or bad context/] + PUSH P,LABELF + PUSH P,SYM + PUSH P,ESBK + PUSH P,I + MOVEI A,[ETSM [ASCIZ/Undefined in =/]] + MOVEM A,GTVER + TRO I,IRNOEQ+IRDEF+IREQL + PUSHJ P,GETWRD + TRNN I,IRDEF + JRST ASEM1A ;UNDEFINED SYMS IN VALUE, IGNORE +IFN LISTSW,[ + SKIPN LSTONP + JRST EQUAL1 ;NOT LISTING. + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE SYM,WRD + MOVEM SYM,LISTWD + MOVE SYM,WRDRLC + MOVEM SYM,LSTRLC + SETOM LISTAD + SETOM LISTPF +EQUAL1: +] ;END IFN LISTSW, + TDZ I,[-1-(ILMWRD)] + IOR I,(P) + TLZ FF,FLUNRD + POP P,(P) + POP P,ESBK + POP P,SYM + POP P,LABELF + MOVE A,WRDRLC ;GET RELOCATION + TDNN A,[-2,,-2] ;SKIP ON NON-STANDARD RELOCATION BITS + SKIPE LDCCC + JRST EQG1 ;STRANGE RELOCATION OR IN LOAD TIME CONDITIONALS => HAND PROBLEM TO LOADER + MOVE A,GLSP1 + CAMN A,GLSP2 + JRST EQL1 ;NO GLOBALS IN DEFINITION +;FALLS THROUGH. + +;FALLS THROUGH. +;GLOBALS TO RIGHT OF = OR WITHIN LOADER CONDIT. +EQG1: IFN CREFSW, XCT CRFLBL ;CREF DEF. OF NORMAL SYM, + SKIPGE CONTRL + JUMPL FF,[ETASM [ASCIZ /Externals in =/]] + CALL ESDCHK ;SEARCH SYM TAB. + JRST EQL2 ;NOT FOUND IN CURRENT OR CONTAINING BLKS. + HRRZI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQG1A + XCT EQG1TB(A) ;FOUND IN DESIRED BLOCK. + JRST ASSEM1 + +EQG1A: JUMPN T,EQG2 + CAIN A,PSUDO_-16 ;FOUND AS INITIAL PSEUDO => ERROR. + ETSM ERRQPA +EQG2: CALL DEFCHK ;FIND FREE STE TO DEFINE IN DESIRED BLOCK. + JRST EQL2 ;PRETEND WASN'T FOUND. + +ERRQPA: ASCIZ /Shadowing a pseudo-op/ +ERRIPA: ASCIZ /Illegal =/ + +EQG1TB: ETSM ERRIPA ;COMMON + ETSM ERRIPA ;PSEUDO OR MACRO + JRST EQL2 ;SYM + JRST EQGUL ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL7 ;GLO ENTRY + JRST EQL8 ;GLO EXIT + +EQL8: PUSHJ P,GLKPNR + TLZ C,3LABEL\3MULTI +EQL7: MOVSI T,GLOETY ;GLOBAL PARA ASSIGN + MOVEI B,0 + TLO SYM,40000 +LOPRA1: PUSH P,CASM1A ;RETURN TO ASSEM1A AFTER FOLLOWING. + TLNE C,3MULTI + ETSM ERRMDT + SKIPE LABELF + TLO C,3LABEL + TLNE FF,FLHKIL + TLOA SYM,400000 ;SET FLAG TO HALF-KILL SYM + TLZA C,3SKILL + TLO C,3SKILL ;SET CORRESPONDING FLAG IN 3RDWRD + PUSHJ P,VSM2LV + JUMPGE FF,CPOPJ ;JUMP ON NOT PUNCHING PASS + TRNN I,IREQL ;IF CAME FROM COLON ROUTINE, + JRST PDEFPT ;PUNCH "DEFINE SYM AS $.". + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D ;STORE UPDATED 3RDWRD + PUSHJ P,EBLK + MOVEI TT,LGPA + DPB TT,[310700,,BKBUF] + PUSHJ P,OUTSM0 + PUSHJ P,PWRDA + JRST EBLK + +EQGUL: PUSHJ P,LKPNRO ;LOCAL UNDEF, OUTPUT LINK REQUEST. + TLZ C,3LABEL\3MULTI ;CAN'T DETECT MDT'S WHEN ONLY STINK KNOWS FOR SURE. +EQL2: TLNE I,ILGLI + JRST EQL7 ;MAKE IT GLOBAL + MOVSI T,LCUDF ;LOCAL UNDEFINED + JRST LOPRA1 + +CASM1A: JRST ASEM1A + +;MAYBE PUNCH OUT LINK REQUEST +;SYM HAS NAME OF SYM TO REQUEST, D STE IDX OF SYM, C 3RDWRD, B ADR OF REQUEST +;REQUEST WILL BE PUNCHED IF 3RLNK SET IN C OR IF ANYTHING SET IN LH(B) + +GLKPNR: TLO SYM,40000 ;GLO BIT +LKPNRO: TLNN C,3RLNK + TLNE B,-1 + TROA I,IRCONT + POPJ P, ;DON'T PUNCH REQUEST + MOVE A,CONTRL + TRNE A,DECREL + JRST LKPNDR ;DIFFERENT WAY TO OUTPUT THIS INFO IN DECREL FMT + MOVEI A,6 + PUSHJ P,PBITS + PUSHJ P,OUTSM0 ;PUNCH SYM + HLRZ A,B + TLZE C,3RLNK ;RELOC OF LINK PNR + TLO A,100000 + HRRZS B ;CLEAR OUT LH OF B + TRZ I,IRCONT ;OK TO END BLOCK NOW + JRST $OUTPT ;PUNCH OUT A AND RETURN + +LKPNDR: MOVSI A,DECINT ;WRITE AN "INTERNAL REQUEST" WITH ONE DATA WORD. + CALL DECBLK + SETZ TM, ;COMPUTE RELOC OF ADDRESS AND DATA IN TM. + TLNE C,3RLNK + TRO TM,2 + SKIPE WRDRLC + TRO TM,1 + MOVE A,WRD ;ADDRESS TO LINK,,DATA + HRL A,B + CALL DECWR1 + JRST EBLK + +;THESE ASSUME STE IDX IN D, SQUOZE W/ FLAGS IN SYM. +;C HAS 3RDWRD, B OR WRD HAS VALUE TO DEF. WITH. +;CALL ONLY IN RELOCATABLE ASSEMBLY. +OUTDE2: MOVEM B,WRD +OUTDE1: TLNE FF,FLPPSS + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D + SKIPGE CONTRL + RET + TRO I,IRCONT + SETZ A, + TLNN C,3LABEL ;WHAT KIND OF DEFINITION DEPENDS ON WHETHER SYM IS REDEFINABLE. + MOVEI A,CRDF + CALL P7X ;PUNCH OUT CODE BITS + PUSHJ P,GTVL7B ;SET RELOCATION BITS IN SQUOZE + PUSHJ P,OUTSM0 + TRZ I,IRCONT + JRST OUTWD ;OUTPUT VALUE + +;PUNCH OUT LOCAL-GLOBAL RECOVERY BITS AND SYM +;I.E. TELL LOADER THAT SQUOZE IN SYM, FORMERLY CONSIDERED LOCAL, IS REALLY GLOBAL +PLOGLO: SKIPGE CONTRL + RET + PUSH P,A + PUSHJ P,PBITS7 + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY THIS IS NEW STYLE RQ, + PUSHJ P,OUTSM0 ;PUNCH "OLD NAME" = SYMTAB IDX, + TLC SYM,440000 ;SAY MAKE GLOBAL, OUTPUT ACTUAL NAME OF SYM. + PUSHJ P,OUTSM + JRST POPAJ + +;NO GLOBALS TO RIGHT OF EQUAL SIGN + +EQL1: PUSHJ P,ESDCHK + JRST EQL1A ;NOT FOUND +IFN CREFSW,XCT CRFEQL ;DEF. OCCUR. OF NORMAL SYM. OR INTSYM. + MOVEI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQL1F + SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL + XCT EQL1TB(A) ;FOUND IN DESIRED BLOCK => NOW REDEFINE. + JRST ASSEM1 + +EQL1F: JUMPN T,EQL10 + CAIE A,PSUDO_-16 + JRST EQL10 + MOVEI T,(B) ;FOUND AS PSEUDO IN INITIAL SYMS BLOCK, + CAIN T,INTSYM ;SPECIAL WAY TO REDEFINE IF LIKE .MLLIT, ETC. + JRST EQLINT + ETSM ERRQPA ;SHADOWING AN INITIAL PSEUDO, TELL USER. +EQL10: CALL DEFCHK ;FOUND IN OUTER BLOCK, GET NEW STE, + JRST EQL1A ;DEFINE THERE AS IF NOT FOUND. + +EQL1TB: ETSM ERRIPA ;COMMON + JRST EQL1B2 ;PSEUDO OR MACRO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL1D ;GLO ENTRY + JRST EQL1E ;GLO EXIT + +EQL1E: PUSHJ P,GLKPNR ;DUMP LINKING POINTER + CAIA +EQL1D: CALL MDTCHK + PUSHJ P,RCHKT ;GLO ENTRY +EQLB2: PUSHJ P,RMOVET + TLNE FF,FLHKIL + TLOA SYM,400000 + TLZA C,3SKILL + TLO C,3SKILL + HRLZI T,GLOETY + SKIPE LDCCC ;IF IN LOADER CONDITIONAL, + TLO C,3LLV ;THEN LOADER MUST SUPPLY VALUE + PUSHJ P,VSM2W ;DEFINE SYM + TLO SYM,40000 ;SET GLOBAL BIT IN SQUOZE +EQL1CE: JUMPGE FF,ASEM1A + PUSHJ P,OUTDE1 +ASEM1A: TLNE I,ILMWRD + PUSHJ P,IGTXT + JRST ASSEM1 + +;CHECK WHETHER DEFINING AN MDT, OR REDEFINING A LABEL (=> THIS IS AN MDT) +MDTCHK: TLNN C,3LABEL + JRST MDTCH1 + CALL GVSYM0 ;MOVE VALUE OF SYM TO A, GET RELOC (WRDRLC STYLE) IN B + CAMN A,WRD + CAME B,WRDRLC ;IF WE'RE CHANGING THE VALUE, MARK SYM AS MDT +MDTCHL: TLO C,3MULTI +MDTCH1: TLNE C,3MULTI ;EVER ASSIGNING TO MDT, EVEN SAME VALUE, GIVES ERR MSG + ETSM ERRMDT + RET + +EQL1C: TLNE I,ILGLI + JRST EQL1CA ;MAKE GLOBAL + PUSH P,C + PUSHJ P,LKPNRO ;MAYBE OUTPUT LINK REQUEST + PUSHJ P,RCHKT + PUSHJ P,RMOVET ;INITIALIZE 3RDWRD + MOVSI T,SYMC ;SYM + PUSHJ P,EQA2A ;ENTER DEF IN SYMTAB + TLNE C,3SKILL + TLO SYM,400000 + POP P,AA + TLNE AA,3VCNT ;USED IN CONSTANT + PUSHJ P,CONBUG + JRST EQL1CE + + ;PUNCH OUT CODE BIT PAIR, FIRST OF WHICH IS 7 + +P7X: MOVEM A,PARBIT ;ENTRY FOR SECOND BYTE IN A +P70: PUSHJ P,PBITS7 ;ENTRY FOR SECOND BITE IN PARBIT, PUNCH OUT THE 7 + SKIPA A,PARBIT ;GET SECOND BYTE BACK +PBITS7: MOVEI A,7 ;ENTRY TO JUST PUNCH OUT 7 + JRST PBITS + +EQL1CA: PUSHJ P,PLOGLO + JRST EQL1E +EQA2: PUSH P,CASM1A +EQA2A: TLNE FF,FLHKIL + TLO C,3SKILL + JRST VSM2W + +EQL1B2: HRRZ A,B ;ATTEMPT TO ASSIGN PSEUDO-OP, IS IT AN INTSYM? + CAIN A,INTSYM + JRST EQLINT ;YES, GO SET WD IT POINTS TO. + ETSM [ASCIZ /Pseudo or macro ='D/] +EQL1B: CALL MDTCHK + PUSHJ P,RCHKT + TLNE I,ILGLI + JRST EQLB2 ;WAS LOCAL, MAKE IT GLOBAL + ;WAS LOCAL, LEAVE IT LOCAL + PUSHJ P,RMOVET ;PUT RELOCATION BITS IN BITS 0 AND 1 OF C (I.E. START SETTING UP 3RDWRD) + MOVSI T,SYMC ;SYM + JRST EQA2 + +EQL1A1: PUSHJ P,RCHKT + PUSHJ P,RMOVET + HRLZI T,SYMC + JRST EQA2 + +EQL1A: SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL +IFN CREFSW,XCT CRFLBL ;DEF. OCCUR. OF NORMAL SYM. + TLNN I,ILGLI + JRST EQL1A1 + JRST EQL1E + +EQLINT: HLRZS B ;GET ADDR OF WD HOLDING VALUE. + MOVEMM (B),WRD ;PUT NEW VALUE IN IT. + JRST ASEM1A + +;;. ;ROUTINES DEALING WITH THE CURRENT LOCATION AND OFFSET + +VBLK +CLOC: 0 ;PUNCHING LOC +CRLOC: 0 ;PUNCHING RELOC +OFLOC: 0 ;OFSET VAL +OFRLOC: 0 ;OFSET RELOC +;VAL OF PT=CLOC+OFLOC,CRLOC+OFLOC +SYLOC: 0 ;VAL OF LAST TAG +SYSYM: 0 ;LAST TAG +SYLOC1: 0 ;VALUE OF NEXT TO LAST TAG +SYSYM1: 0 ;NEXT TO LAST TAG +GLOCTP: 0 ;4.9 => CURRENT LOCATION GLOBAL, 2.9 => OFFSET GLOBAL + ;FRGLOL (FLAG IN FF) IS IOR OF BITS 4.9 AND 2.9 OF GLOCTP + ;EXCEPT AFTER .=NON-GLOBAL WITH GLOBAL OFFSET + ;OTHER BITS USED ONLY WHEN IN LINK (NEVER SET IN GLOCTP): + ;400 => ARG GLOBAL +PBLK + + + ;POINT (.) AS PSEUDO-OP + +GTVLP: TRNE FF,FRGLOL + JRST GTVLP2 ;LOCATION GLOBAL + MOVE B,OFRLOC ;GET RELOCATION OF OFFSET + ADD B,CRLOC ;ADD CURRENT RELOCATION + MOVE A,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 ;IF IN BYTE MODE, + HLL A,BYTWP ;SET LEFT HALF TO BYTE POINTER LEFT HALF FOR ILDB + ADD A,OFLOC ;NOW ADD OFFSET + TLZ I,ILFLO+ILDECP+IRPERI ;CLEAR OUT FLAGS SET WHEN LOOKED LIKE FLOATING POINT NUMBER + POPJ P, + + +GTVLP2: MOVEI T,$.H ;LOCATION GLOBAL + AOS GLSP1 + HRRZM T,@GLSP1 ;PUT $. ON GLOBAL LIST (INCLUDES OFFSET, WHETHER GLOBAL OR NOT) + SKIPL BYTM1 ;IN BYTE MODE? + TDZA A,A ;NO, CLEAR ABS PART OF VALUE + HLLZ A,BYTWP ;YES, USE LH(BP) AS ABS PART + JRST CLBPOP + +$.H: (GLOETY)+SQUOZE 0,$. ;CURRENT LOCATION + OFFSET IN LOADER +$L.H: (GLOETY)+SQUOZE 0,$L. ;LOCATION BEING LOADED INTO BY LOADER, USED BY ABLOCK +$O.H: (GLOETY)+SQUOZE 0,$O. ;LOADER OFFSET +$R.H: (GLOEXT)+SQUOZE 0,$R. ;RELOCATION AS GLOBAL + +COLON: TRNE I,IRLET + TRNN I,IRSYL + ETA [ASCIZ/Colon without preceding symbol/] + TLNN I,ILWORD + TRNE I,IROP+IRPSUD+IREQL+IRNOEQ + ETSM [ASCIZ/Label inside an expression/] + SKIPE ASMOUT + ETSM [ASCIZ /Label inside <>, () or []/] + TLZ FF,FLHKIL + PUSHJ P,RCH ;GET NEXT CHAR + CAIN A,": ;IF NEXT CHAR ANOTHER COLON, + TLOA FF,FLHKIL ;THEN SET FLAG TO HALF-KILL + TLO FF,FLUNRD ;NOT COLON, CAUSE IT TO BE RE-INPUT + SKIPE HKALL ;CHECK FOR HALF-KILL-ALL-LABELS MODE. + TLO FF,FLHKIL + MOVE T,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 + HLL T,BYTWP ;BYTE MODE, SET LEFT HALF OF VALUE TO LEFT HALF OF BYTE POINTER + ADD T,OFLOC ;ADD OFFSET + MOVEM T,WRD ;STORE RESULT AWAY FOR POSSIBLE PUNCHOUT + EXCH T,SYLOC ;NOW SET UP STUFF FOR ERROR PRINTOUT + MOVEM T,SYLOC1 + EXCH SYM,SYSYM + MOVEM SYM,SYSYM1 + MOVE SYM,SYSYM + MOVE A,CRLOC ;SET UP RELOCATION + ADD A,OFRLOC + MOVEM A,WRDRLC + SETOM LABELF ;SET FLAG CAUSING 3LABEL (DON'T REDEFINE) TO BE SET. + SKIPN LDCCC + TRNE FF,FRGLOL + JRST GCOL1 ;LOCATION VIRTUAL OR IN LOAD TIME CONDITIONAL + PUSHJ P,ESDCHK ;TRY FINDING CURRENT ENTRY IN ST + JRST EQL1A ;NOT ALREADY DEFINED +IFN CREFSW,XCT CRFLBL +COLON1: MOVEI T,(C) ;BKTAB IDX OF BLOCK FOUND IN, + CAIE T,(TM) ;FOUND IN DESIRED BLOCK => TRY REDEFINING. + JRST COLON3 + TLO C,3LABEL ;CAUSE REDEFINING SYMBOL TO BARF + XCT COLON2(A) ;BUT MAYBE PRINT ERR MSG FIRST. + JRST EQL1B + +CASSM1: JRST ASSEM1 + +COLON3: JUMPN T,EQL10 ;NOT INITIAL SYM => CAN SHADOW, + CAIN A,SYMC_-14. ;INITIAL SYM => CAN SHADOW IF IT'S AN ORDINARY LOCAL SYM + CAME B,WRD ;AND NEW VALUE SAME AS OLD VALUE. + CAIA + SKIPE WRDRLC + ETSM ERRRES ;ELSE GIVE ERROR MESSAGE BEFORE SHADOWING, TO WARN USER. + JRST EQL10 + +ERRRES: ASCIZ /Pseudo, macro or initial sym as label/ +ERRMDT: ASCIZ /Multiply defined/ + +COLON2: TLO C,3MULTI ;COMMON + ETSM ERRRES ;MACRO OR PSEUDO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI ;SETTING 3MULTI CAUSES EQL1B TO PRINT AN MDT ERROR. + JRST EQL1D ;GLOBAL ENTRY + JRST EQL1E ;GLO EXIT + +;COLON WHEN LOCATION VIRTUAL, OR IN LOAD TIME CONDITIONAL + +GCOL1: IFN CREFSW,XCT CRFLBL ;DEFINING ORDINARY SYM. + SKIPGE CONTRL + ETASM [ASCIZ /Virtual label in abs assembly/] + PUSHJ P,ESDCHK ;FIND ITS SLOT IN ST + JRST EQL2 ;JUST LIKE EQG1 EXCEPT FOR ERROR MESSAGES. + MOVEI T,(C) + CAIE T,(TM) + JRST COLON5 + XCT GCOL1T(A) ;FOUND IN DESIRED BLOCK, REDEFINING. + JRST EQL2 + +COLON5: JUMPN T,EQG2 ;SHADOWING, OK UNLESS INITIAL SYM. + ETSM ERRRES + JRST EQG2 + +GCOL1T: TLO C,3MULTI ;COMMON + ETSM ERRRES ;PSEUDO. + JRST EQL2 ;SYM. + JRST EQGUL ;LOCAL UNDEF. + TLO C,3MULTI ;VAR + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + JRST EQL7 ;DEF GLO + JRST EQL8 ;UNDEF GLO. + + + ;PUNCH OUT "DEFINE SYM AS $." + +PDEFPT: MOVEI A,CDEFPT + PUSHJ P,P7X ;OUTPUT 7 THEN PDEFPT + JRST OUTSM0 ;OUTPUT SYM, WITHOUT BITS + +;LOC, BLOCK, .= + +ALOC: PUSHJ P,ALOCRG ;LOC, GET ARG +ALOC1: SETZM SYLOC ;CLEAR OUT LOC OF LAST TAG + SETZM SYSYM ;CLEAR OUT LAST TAG SO ERROR MESSAGES DON'T PRINT OBSCENE INCREMENTS +IFN FASLP,[ + SKIPGE TM,CONTRL + TRNN TM,FASL + JRST .+2 + ETA [ASCIZ /LOC illegal in FASL assembly/] +] + TRZE LINK,400 ;GLOBALS IN ARG? + JRST ALOC2 ;YES + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF CURRENT LOCATION + CALL SLOCF ;RE-INIT NEXT OUTPUT BLOCK'S HEADER; SET LOCF. + MOVEI A,LCEGLO ;=> RESET GLOBAL RELOCATION (BACK TO ORIGINAL NON-GLOBAL RELOCATION) + TLZE LINK,400000 ;IS CURRENT LOCATION NOW GLOBAL? + PUSHJ P,PLDCM ;YES, RESET IT + MOVE B,WRDRLC ;GET BACK NEW RELOCATION +ALOC2B: TRZE B,-2 ;NO BITS ALLOWED EXCEPT LOW ORDER + ETR [ASCIZ *Illegal relocation in LOC/BLOCK/.=*] + HRRZM B,CRLOC ;STORE NEW RELOCATION + SKIPGE CONTRL + JRST ASSEM1 ;DON'T BOTHER WITH REST IF ABS. + MOVEI B,2(B) ;LABS OR LREL + DPB B,[310700,,BKBUF] ;STORE NEW BLOCK TYPE + MOVEM B,CDATBC ;ALSO STORE AS NORMAL BLOCK TYPE +AOFSTX: TDNN LINK,[SETZ(SETZ)] ;ENTRY FROM AOFFSET, SKIP IF FRGLOL SHOULD BE SET + TRZA FF,FRGLOL ;CURRENT LOCATION PLUS OFFSET NOT GLOBAL, CLEAR FLAG + TRO FF,FRGLOL ;GLOBAL, SET FLAG + TRZ LINK,600 ;CLEAR OUT TEMPORARY FLAGS SO WON'T GET STORED IN GLOCTP + MOVEM LINK,GLOCTP ;STORE BACK STATUS FLAGS + JRST ASSEM1 + +PTEQ: MOVE SYM,[SQUOZE 0,LOC] + PUSHJ P,ALOCRG ;.=, GET ARG + MOVE T,[MINF+HFWDF,,$O.H] ;GLOTB ENTRY IF .+1 DOESN'T SKIP + TRNE LINK,400000 ;OFFSET GLOBAL? + JRST PTEQ2 ;YES, WANT TO DO LOC ARG-$O." + PUSHJ P,SBWDOF ;OFFSET IS LOCAL, SUBTRACT FROM ARG + JRST ALOC1 + +ABLOCK: PUSHJ P,ABLKRG ;GET ARG TO "BLOCK" PSEUDOOP. + TRNE LINK,400 ;GLOBALS IN ARG? + JRST ABLKG ;GLOBALS IN ARG + TLNE LINK,400000 + JRST ABLKG ;JUMP IF LOSER CHANGING RELOCATION WHILE CLOC GLOBAL +IFN FASLP,[ + MOVE D,CONTRL + TRNN D,FASL ;IN FASL FORMAT, CAN'T SET LOC. CTR., + JRST ABLKF1 + SKIPE B + ETA [ASCIZ /BLOCK size relocatable/] + JUMPGE FF,ABLKF1 + CALL ABLKF ;SO ON PASS 2 OUTPUT A BUNCH OF ZEROS. + JRST ABLKF1 + +;OUTPUT C(A) ZEROS, IN FASL FORMAT. NO-OP ON PASS 1. DOESN'T SET THE LOCATION COUNTER. +ABLKF: JUMPE A,CPOPJ + JUMPGE FF,CPOPJ + SETZM WRD + SETZM WRDRLC + PUSH P,A + PUSH P,A +ABLKF2: CALL FASPW + MOVEMM GLSP2,GLSP1 + SOSE (P) + JRST ABLKF2 + JRST POPBAJ +] + +ABLKF1: JUMPL A,[ETA [ASCIZ /BLOCK size negative/]] + ADD A,CLOC ;ARG TO BLOCK IS LOCAL, ADD DIRECTLY TO CLOC + ADD B,CRLOC ;ALSO ADD RELOCATIONS + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF LOCATION + CALL SLOCF ;FALL INTO ALOC ROUTINE, MAKING SURE FRLOC GETS SET + JRST ALOC2B + + +SBWDOF: SUB A,OFLOC ;SUBTRACT OFFSET FROM WRD, ETC. IN A,B + HRRZM A,WRD ;MAKE SURE RESULT GETS STORED IN WRD, AS WELL AS AC'S + SUB B,OFRLOC ;NOW DO RELOCATIONS + HRRZM B,WRDRLC + POPJ P, + +ABLKG: TRNE LINK,400000 ;GLOBAL BLOCK, IS OFFSET GLOBAL? + JRST ABLKG2 ;YES, OK TO REFERENCE $L. + PUSHJ P,SBWDOF ;NO, FOR COMPATIBILITY, DON'T REFERENCE $L. + SKIPA T,[HFWDF,,$.H] +ABLKG2: MOVE T,[HFWDF,,$L.H] +PTEQ2: AOS GLSP1 ;STORE T IN GLOTB + MOVEM T,@GLSP1 +ALOC2: TLO LINK,400000 ;SET GLOBAL LOCATION FLAG + MOVEI A,LCGLO ;=> GLOBAL LOCATION ASSIGNMENT + PUSHJ P,PLDCM ;PUNCH OUT GLOBAL LOCATION ASSIGNMENT + SETZM CLOC ;CLEAR OUT CLOC, NEW RELOCATION NOW + SETZB B,BKBUF ;ALSO CLEAR OUT HEADER, JUST TO BE SURE + AOJA B,ALOC2B ;SET RELOCATION TO 1 AND FALL IN + +AOFFSET: PUSHJ P,AOFFS2 ;OFFSET, GET ARG + MOVE A,T + MOVEM A,WRD ;RESTORE UNTRUNCATED ARG. + TRZE LINK,400 ;GLOBALS IN ARG? + TROA LINK,400000 ;GLOBALS IN ARG, SET GLOBAL OFFSET FLAG + TRZ LINK,400000 ;NO GLOBALS IN ARG + MOVEM A,OFLOC ;STORE NEW OFFSET + MOVEM B,OFRLOC ;ALSO STORE RELOCATION BITS + SKIPGE CONTRL ;IN RELOCATABLE, + JRST AOFSTX + MOVEI A,LDOFS ;LOADER OFFSET LOADER COMMAND TYPE + PUSHJ P,PLDCM ;PUNCH OUT LOADER COMMAND + JRST AOFSTX + +;GET ARG TO LOC, BLOCK, .=, OFFSET + +ALOCRG: +ABLKRG: MOVE A,CLOC + SKIPN CRLOC + JRST [ CAML A,DECBRA ;IF ADDR BEFORE THE LOC WAS ABS, + MOVEM A,DECBRA ;UPDATE HIGHEST ABS ADDR IF NEC. + JRST ABLKR1] + CAML A,DECTWO ;IT WAS RELOCA; UPDATE HIGHEST + JRST [ CAML A,DECBRH ;ADDR OF APPROPRIATE SEG. + MOVEM A,DECBRH + JRST ABLKR1] + CAML A,DECBRK + MOVEM A,DECBRK +AOFFS2: +ABLKR1: PUSH P,SYM + PUSHJ P,CONBAD ;ERROR IF IN GROUPING + REST SYM + TRNE I,IRNOEQ\IRPSUD\IREQL + ETSM [ASCIZ /Inside pseudo or =/] + TDNE I,[ILWORD,,IRFLD] + ETSM ERRNVL + PUSHJ P,EBLK ;MAYBE END CURRENT OUTPUT BLOCK + PUSHJ P,AGETWD ;GET ARG + MOVE LINK,GLOCTP ;GET GLOCTP FLAGS IN LINK, STAYS THERE UNTIL ALMOST DONE + MOVE T,GLSP2 + CAME T,GLSP1 + TROA LINK,400 ;SIGNAL GLOBAL ARG + TRZ LINK,400 ;LOCAL + MOVE T,A ;SAVE UNTRUNCATED FOR AOFFSET, + HRRZS A,WRD ;TRUNCATE FOR LOC, BLOCK, .=. + TRNN I,IRDEF ;ALL DEFINED? + JRST ASSEM1 + SKIPGE CONTRL ;YES, RETURN SKIPPING OVER ARG + TRNN LINK,400 + RET + MOVE SYM,GTVER + ETASM [ASCIZ *Argument has externals*] + +;;CONSTANTS AND VARIABLES + ;VARIABLES AREA +VBLK + +LCNGLO==CONMIN/4 +LCONTB==CONMIN + +BLCODE [ +PCNTB: BLOCK NCONS*3 ;CONSTANTS AREAS TABLE +VARTAB: BLOCK NVARS +] +CONTBA: CONTAB ;ADDRESS OF BEGINNING OF CONSTANTS TABLE. +CONTBE: CONTAB+LCONTB ;ADDRESS OF WORD AFTER END OF CONSTANTS TABLE. +PLIM: 0 ;POINTER TO FIRST UNUSED WORD IN CONSTANTS TABLE. + +CONGLA: CONGLO ;ADDRESS OF BEGINNING OF CONSTANT-GLOBALS TABLE. +CONGLE: CONGLO+LCNGLO ;ADDRESS OF WORD AFTER END OF CONSTANT GLOBALS TABLE. +CONGOL: 0 ;HAS ADR OF FIRST WORD INACTIVE IN CONSTANT-GLOBALS TABLE. + +CONBIA: CONBIT ;ADDRESS OF BEGINNING OF CONSTANT-RELOCATION-BITS TABLE. + +CONLEN: CONMIN ;TOTAL SPACE ALLOCATED TO CONSTANTS TABLES. + ;ALL THE HOOKS ARE IN FOR DYNAMIC ALLOCATION OF THESE TABLES + ;(CONTAB, CONGLO, AND CONBIT). ALL THAT IS NEEDED IS TO GET + ;THE SPACE AND INITIALIZE CONTBA, CONTBE, CONGLA, CONGLE, CONBIA. + + ;PCNTB STUFF + + ;EACH ENTRY 3 WORDS; FIRST WORD SQUOZE, NAME OF AREA IF GLOBAL +CSQZ: 0 ;SQUOZE COUNTER + ;SECOND WORD RH LOC OF AREA (WITH OFFSET), LH LOC FIRST AFTER AREA (WITHOUT OFFSET) + ;THIRD WORD LH FLAGS + +CGBAL==100000 ;GLOBAL (INCLUDING OFFSET) +CTRL==200000 ;RELOCATED ( " ) +CTDEF==400000 ;DEFINED (MUST BE SIGN) + +PBCON: 0 ;POINTER INTO PCNTB, HAS ADR OF ENTRY FOR NEXT CONSTA +PBCONL: 0 ;POINTER TO ABSOLUTE TOP OF PCNTB +CONCNT: 0 ;NUMBER OF TIMES CONSTANTS CAN APPEAR (DECREMENTED BY CONSTA) +CONDEP: 0 ;DEPTH IN CONSTANTS (0 TOP LEVEL) +CONSAD: 0 ;ADDR IN CONSTANTS TABLE OF ENTRY FOR CURRENT CONST. +CONSML: 0 ;VALUE OF .MLLIT INTSYM. + ;NEGATIVE => ERROR MODE (DEFAULT) + ;ZERO => OLD MODE. + ;POSITIVE => NEW (MULTI-LINE) MODE. + +CONSTP: 0 ;PDL POINTER BELOW WDS FOR INNERMOST CONSTANT. +CONSP1: 0 + + ;VARIABLES FOR VARIABLES CODING + +VARCNT: 0 ;NO OF VAR IN CURRENT VAR AREA SO FAR +VARPNT: 0 ;POINTER TO CURRENT PLACE IN VARTAB +VARCNR: 0 ;NO OF TIMES VARIABLES MAY APPEAR +VCLOC: 0 ;TEM FOR VARIAB +VECSIZ: 0 ;DEFAULT SIZE FOR .VECTOR. + +PBLK + +;LEFT-BRACKET ENCOUNTERED; HERE ON DISPATCH FROM GETFD +;SAVE WORLD, BYTE MODE, ASSEM1 PDL LEVELS. +;THEN SET ASSEM1 PDL LEVELS TO CURRENT LEVELS +;SO ASSEM1 WON'T FLUSH PAST LEVEL OF CONSTANT. +;SET CONSTP _ CURRENT PDL LEVEL. PCONS WILL PUT WORDS +;OF CONSTANT ABOVE CONSTP, AND SET ASSEMP ABOVE THEM. + +LBRAK: SKIPE LITSW + ETR [ASCIZ /Literal/] + TRO I,IRFLD ;LEFT BRACKET + JSP LINK,SAVWD1 ;SAVE CRUFT + PUSH P,SCNDEP ;SO THE NEXT RBRKT WON'T TRY TO CLOSE CONDIT. + JSP LINK,SAVAS1 + MOVEIM ASMOUT,3 + SETZM SCNDEP ;NOT WITHIN CONDITIONALS IN THIS LITERAL. + AOS CONDEP ;ONE DEEPER IN LITERALS. + MOVEI A,IRPSUD\IREQL + ANDCAM A,ASMI + JRST ASSEM3 ;GO ASSEMBLE THE WORDS OF THE CONSTANT. + +;OUTPUT WORD TO CONSTANT. P MUST EQUAL ASSEMP HERE. +PCONS: SKIPL CONTRL ;IF RELOCATABLE, + PUSHJ P,$RSET ;HANDLE STRANGE RELOCATIONS. + MOVE B,GLSP1 + SUB B,GLSP2 ;NUM. GLOBAL ENTRIES FOR THIS WD. + HLRZ A,WRDRLC ;ONLY 1.1 AND 3.1 BITS MATTER. + LSH A,1 + IOR A,WRDRLC ;GET THEM INTO 1.1, 1.2 BITS. + TLNE I,ILNOPT ;REMEMBER ILNOPT ALSO. + IORI A,4 + DPB B,[032200,,A] ;AND # GLBLS. + PUSH P,A ;SAVE THEM ALL. + HRLI B,(B) ;GET # GLBLS,,# GLBLS . + JUMPE B,PCONS1 + MOVE A,GLSP2 + MOVSI A,1(A) + HRRI A,1(P) ;SAVE THE GLBLS, IF ANY. + ADD P,B + JUMPGE P,CONFLP + BLT A,(P) +PCONS1: PUSH P,WRD + MOVEM P,ASSEMP ;ASSEMP -> ABOVE WDS FOR LIT.; CONSTP, BELOW. + JRST (T) + +;JSP LINK,SAVAS1 TO PUSH DATA ON ASSEM1 LEVEL AND CALL ASSEM1 +;LOOP RECURSIVELY. +.SEE CONNDP ;WHICH IS WHERE THESE THINGS ARE POPPED. +SAVAS1: SKIPN BYTM ;IF IN BYTM NOW (WILL PUSH AND TURN OFF) + JRST LBRAK1 + MOVSI A,BYBYT ;SAVE ALL THE DETAILS. + HRRI A,1(P) + ADD P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] + JUMPGE P,CONFLP ;(SOFTWARE-DETECTED PDL-OV) + BLT A,-BYTMCL(P) + MOVSI A,BYTMC + HRRI A,1-BYTMCL(P) + BLT A,(P) +LBRAK1: PUSH P,BYTM + SETZM BYTM + PUSH P,ASMOUT + PUSH P,ASMDSP + PUSH P,ASMI + PUSH P,GLSPAS ;SAVE ASSEM1 PDL LEVELS. + PUSH P,ASSEMP + PUSH P,CONSTP + MOVE A,I + ANDI A,IRPSUD+IREQL + IORI A,IRDEF + MOVEM A,ASMI ;ASMI IOR'D INTO I AT ASSEM2 LOOP. + HRRZ A,CPGN + HRL A,CLNN ;REMEMBER WHERE THIS LITERAL STARTS. + INSIRP PUSH P,[A SYSYM SYLOC] + MOVEM P,ASSEMP ;SO ASSEM1 WON'T FLUSH WHAT WE PUSHED. + MOVEM P,CONSTP ;SO CONND CAN FIND 1ST WD OF CONSTANT. + MOVEMM GLSPAS,GLSP1 +SAVAS2: MOVEI A,ASSEM3 ;IF NOT MULTI-LINE MODE, ARRANGE TO + SKIPG CONSML ;END THE CONSTANT AFTER 1 WORD. + MOVEI A,ASSEMC + MOVEM A,ASMDSP + JRST (LINK) + +PCONST: MOVE CH1,ASMDSP ;OUTPUT TO CONST. FROM ASSEM1 + CAIN CH1,CONND ;LAST WD OF CONST? + CAME P,CONSTP ;1ST WD? + JRST PCONS ;NO, DO THE GENERAL THING. + SKIPL CONTRL ;THIS MUST BE ONLY WORD OF CONST, + PUSHJ P,$RSET ;DON'T BOTHER PUSHING, END CONST. NOW. + PUSH P,CONSTP + TLZ I,ILMWRD+ILMWR1 ;THIS IS 1ST WD, NO MORE WDS. + JRST CONND3 ;PRETEND JUST POPPED IT. + +;COME HERE FROM ASSEM1 TO END A CONSTANT. +CONND: SKIPE BYTM ;IF IN BYTE MODE, LEAVE IT AND DO .WALGN + JRST A.BY3 ;(WILL COME BACK SINCE ASMDSP STILL SET) +CONNDW: MOVEMM CONSP1,CONSTP + TLZ I,ILMWR1 ;THIS IS 1ST WORD COMING UP. +CONND0: TLZ I,ILMWRD+ILNOPT + SETZM WRDRLC + MOVE F,CONSP1 ;ADDR IN IN PDL OF NEXT WD. + CAMN F,ASSEMP + JRST CONND2 ;J IF NO WORDS. + MOVE A,1(F) ;GET SAVED NUM GLBLS,,NUM GLBLS + DPB A,[100,,WRDRLC] + LSH A,-1 ;RESTORE WRDRLC BITS 1.1, 3.1 + DPB A,[220100,,WRDRLC] + TRNE A,2 + TLO I,ILNOPT ;RESTORE NOOPTF. + LSH A,-2 ;GET # GLBLS. + HRLI A,(A) ;# GLBLS,,# GLBLS. + AOBJN F,.+1 + HRRZM F,GLSP2 ;ADDR BEFORE 1ST GLOBAL ENTRY. + ADD F,A + HRRZM F,GLSP1 ;ADDR OF LAST GLOBAL ENTRY. + MOVE A,1(F) + MOVEM A,WRD + AOBJN F,.+1 ;POINT TO NEXT CONST WD IF ANY, + MOVEM F,CONSP1 + CAME F,ASSEMP ;IF MORE WORDS SET ILMWRD + TLO I,ILMWRD + JRST CONND3 + +CONND2: INSIRP SETZM,[WRD,GLSP1,GLSP2] +CONND3: MOVE F,GLSP1 + SUB F,GLSP2 + JUMPE F,SCON ;JUMP IF NOTHING VIRTUAL + MOVEI B,-1(F) + MOVN TT,B + JUMPE B,SCON ;JUMP IF ONLY ONE GLOBAL + ;SORT GLOTB ENTRIES THIS CONSTANT +LSORT: HRL T,TT ;SET UP AOBJN POINTER TO GLOBALS REMAINING + HRR T,GLSP2 +LSORT2: MOVE A,1(T) + CAMLE A,2(T) + EXCH A,2(T) ;INTERCHANGE + MOVEM A,1(T) + AOBJN T,LSORT2 ;INNER LOOP POINT + SOJG B,LSORT ;OUTER LOOP + ;DROPS THROUGH + +;DROPS THROUGH +SCON: PUSHJ P,RCHKT + PUSHJ P,RMOVET ;SET UP RELOACTION BITS. + ROT T,2 ;ROTATE TO BOTTOM TWO BITS OF T + TLNE I,ILMWRD+ILMWR1+ILNOPT + JRST NOCON ;MULTIPLE WORD OR OPTIMIZATION SUPPRESSED, DON'T TRY TO FIND MATCH + MOVE A,CONTBA +SCON1: CAML A,PLIM ;SEARCH CONSTANTS TABLE TO SEE IF ALREADY THERE + JRST NOCON ;END OF TABLE, NO MATCH + MOVE B,WRD + CAME B,(A) +SCON2: AOJA A,SCON1 ;VAL DISAGREES + PUSHJ P,CPTMK ;GET BP TO CONSTANTS-BIT TABLE IN C + LDB F,C ;GET RELOCATION BITS THIS CONSTANT + CAME F,T + JRST SCON2 ;RLC DIFFRS + MOVE B,CONGLA ;VALUE AND RELOCATION AGREE, NOW TO CHECK GLOBALS + SKIPA C,GLSP2 +SCON2B: AOS B ;SEARCH FOR GLOBAL POINTING TO CONSTANT WHICH HAS MATCHED SO FAR + CAML B,CONGOL + JRST SCON3 ;GLOBALS MATCH SO FAR + CAME A,1(B) ;SKIP IF ONE FOUND +SCON7: AOJA B,SCON2B ;NOT YET + MOVE D,(B) ;FOUND ONE, GET GLOTB ENTRY + CAME D,1(C) ;COMPARE WITH THIS ENTRY IN GLOTB + JRST SCON2 ;NO MATCH, FLUSH THIS CONSTANT + AOJA C,SCON7 ;MATCH, TRY NEXT GLOBAL + +SCON3: CAME C,GLSP1 ;GLOBALS MATCH, BUT ARE WE EXACTLY AT END OF GLOTB? + JRST SCON2 ;NO, BACK TO SEARCH + JRST NOCON4 + +NOCON: AOS A,PLIM ;CONSTANT NOT ALREADY IN TABLE + CAMLE A,CONTBE + ETF [ASCIZ/Literal table full/] + MOVE AA,WRD + MOVEM AA,-1(A) + SOS A + PUSHJ P,CPTMK + TLNE I,ILNOPT + TRO T,4 ;1.3 OF RELOCATION BITS => DON'T OPTIMIZE ON TOP OF ME + DPB T,C + MOVE B,GLSP2 +NOCON3: CAML B,GLSP1 + JRST NOCON4 + SKIPN C,1(B) + AOJA B,NOCON3 ;THIS ENTRY NOT REALLY HERE + MOVEM C,@CONGOL + HRRZS C + PUSHJ P,NOCON5 + MOVEM A,@CONGOL + PUSHJ P,NOCON5 + SKPST C, ;SKIP IF IN SYMBOL TABLE + AOJA B,NOCON3 + 3GET1 D,C ;IN SYMBOL TABLE + TLO D,3VCNT ;THIS SYM USED IN CONSTANT + 3PUT1 D,C ;UPDATE 3RDWRD TABLE ENTRY + AOJA B,NOCON3 + +NOCON5: AOS AA,CONGOL + CAML AA,CONGLE + ETF [ASCIZ/Constants-global table full/] + POPJ P, + + ;SET UP BYTE POINTER TO CONSTANTS-BIT TABLE + ;A SHOULD HAVE ADR OF CONSTANTS TABLE ENTRY + ;LEAVES ANSWER IN C + ;BITS IN CONSTANTS-BIT TABLE PER ENTRY: + ;1.2, 1.1 RELOCATION BITS + ;1.3 ILNOPT BIT => DON'T OPTIMIZE ON TOP OF ME + +CPTMK: PUSH P,A + SUB A,CONTBA + PUSH P,B + IDIVI A,12. + MOVEI C,(A) + ADD C,CONBIA ;SET UP ADDRESS PART + IMULI B,3 + DPB B,[360600,,C] ;STORE POSITION FIELD FROM REMAINDER + TLO C,200 ;SET UP SIZE FIELD +POPBAJ: POP P,B + JRST POPAJ + +NOCON4: TLON I,ILMWR1 + MOVEM A,CONSAD ;IF 1ST WD SAVE ADDR. + TLNE I,ILMWRD ;IF MORE WORDS, HANDLE NEXT. + JRST CONND0 + MOVE P,CONSTP ;VALUE OF CONSTP AT CONND. + MOVE C,GLSPAS ;TO RESTORE GLSP1 + JSP T,CONNDP ;POP STUFF. + HRRZ A,CONSAD ;ADDR OF CONSTANTS TABLE ENTRY OF 1ST WD. + MOVE B,PBCON ;ADDR OF WDS DESCRIBING CONST. AREA. + SKIPL 2(B) ;CONST. AREA LOCATION DEFINITE? + AOJA C,CONND6 ;NO, USE GLOBAL. + MOVEM C,GLSP1 + HRRZ C,1(B) ;ADD ACTUAL ADDR OF CONST. AREA. + ADDI A,(C) ;GET C(CONTBA) + ADDR OF CONSTANT. + LDB B,[420100,,2(B)] + JRST CONND7 + +CONND6: MOVEM C,GLSP1 + MOVEM B,(C) + MOVEI B,0 +CONND7: SUB A,CONTBA + JRST LSSTH3 ;POP OUT INTO OUTER WORD. + +.SEE SAVAS1 ;WHICH IS WHAT PUSHES WHAT CONNDP POPS. +CONNDP: SUB P,[3,,3] ;FLUSH SAVED SYLOC AND SYSYM AND CLNN,,CPGN. +CONFL2: HRL T,ASMOUT ;REMEMBER IF POPPING A LITERAL OR NOT. + INSIRP POP P,[CONSTP,ASSEMP,GLSPAS,ASMI,ASMDSP,ASMOUT,BYTM] + SKIPN BYTM ;IF IN BYTE MODE, POP DETAILS. + JRST CONND5 + MOVSI A,1-BYTMCL(P) + HRRI A,BYTMC + BLT A,BYTMC+BYTMCL-1 + MOVSI A,1-BYTMCL-LBYBYT(P) + HRRI A,BYBYT + BLT A,BYBYT+LBYBYT-1 + SUB P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] +CONND5: HLRZ A,T + CAIE A,3 + JRST (T) + POP P,A + ADDM A,SCNDEP ;DON'T FORGET ABOUT ANY CONDITIONALS. + SOS CONDEP ;HAVE POPPED ONE CONSTANT. + JRST (T) + +CONFLS: MOVE P,ASSEMP ;FLUSH ALL CONSTANTS. + CAMN P,[-LPDL,,PDL] ;IF IN ANY, + JRST (LINK) + MOVE P,CONSTP ;POINT AFTER ITS PDL ENTRY, + JSP T,CONNDP ;POP IT, + JRST CONFLS ;TRY AGAIN. + +CONBAD: SKIPN ASMOUT ;IF IN GROUPING, ERROR. + POPJ P, + ETSM [ASCIZ/Within <>, () or []/] + JRST ASSEM1 + +;COME HERE FOR PDL-OV ON P. +;IF IN A CONSTANT, FLUSH ALL OF THEM, SAYING WHERE EACH STARTED. +;THEN TYPE A PDL ERROR MSG AND RETURN TO ASSEM1. +;OTHERWISE FATAL ERROR. +CONFLP: MOVEI LINK,ASSEM1 + MOVEI CH1,ERRPDL + SKIPE CONDEP + JRST CONFL3 ;IN A CONSTANT. + MOVEI P,PDL ;RE-INIT PDL SO NO MORE PDL-OV. + ETF ERRPDL +ERRPDL: ASCIZ /PDL overflow/ + +;JSP LINK,CONFLM TO FLUSH CONSTANTS, SAYING WHERE THEYY STARTED, +;AND GIVE ERROR MSG. +CONFLM: MOVE CH1,ASMOUT + SKIPA CH1,ASMOT3(CH1) +CONFLZ: SETZ CH1, ;LIKE CONFLM BUT NO ERR MSG AT END. +CONFL3: SETO C, +CONFL1: MOVE P,CONSTP ;GET STACK ABOVE INNERMOST LITERAL. + REST SYLOC + REST SYSYM + REST D ;GET INFO ON WHERE STARTED + AOSN C ;THE 1ST TIME ONLY, SAY WHAT'S GOING ON. + TYPR [ASCIZ/Within groupings: /] + SKIPE C + TYPR [ASCIZ/, /] + MOVE A,ASMOUT ;SAY WHAT KIND OF GROUPING IS BEING CLOSED + MOVE A,ASMOT5(A) + CALL TYOERR ;BY SAYING WHAT CHAR OPENED IT. + JSP T,CONFL2 ;POP REST OF WDS SAVED AT LBRAK. + TYPR [ASCIZ/ at /] + MOVEI A,1(D) ;PAGE # GROUPING STARTED ON. + CALL DPNT ;PRINT IN DECIMAL. + MOVEI A,"- + CALL TYOERR + HLRZ A,D ;LINE NUMBER IT STARTED ON. + ADDI A,1 + CALL D3PNT2 ;PRINT W/ AT LEAST 3 CHARS, NO ZERO SUPPR. + MOVE A,ASSEMP + CAME A,[-LPDL,,PDL] ;MORE GROUPINGS TO POP => DO. + JRST CONFL1 + CALL CRRERR + MOVE P,ASSEMP + JUMPE CH1,(LINK) ;IF CALLED CONFLZ, NO ERR MSG (CALLER WILL GIVE ONE) + ETR (CH1) ;[ NO] OR PDL. + CALL CRRERR + JRST (LINK) + +;CONSTA + +CNSTNT: NOVAL + SKIPE ASMOUT ;IF ANY GROUPNGS, + JSP LINK,CONFLM ;FLUSH THEM, GIVE ERROR. + PUSHJ P,CNSTN0 + JRST ASSEM1 + +CNSTN0: SOSGE CONCNT ;ENTRY FROM AEND + ETF [ASCIZ /Too many constants areas/] + MOVE B,CLOC + ADD B,OFLOC + HRRZ T,PBCON + TRNN FF,FRPSS2 + JRST CNST1 ;PASS 1 + + MOVSI A,CGBAL + TDZ A,2(T) + TRNE FF,FRGLOL + TLC A,CGBAL + SKIPN A + ETR [ASCIZ /Constants globality phase error/] + HRRZ B,1(T) + SUB B,OFLOC + HRRZS B + CAME B,CLOC + ETR [ASCIZ /Constants location phase error/] + MOVE B,2(T) + ROT B,2 + XOR B,CRLOC + XOR B,OFRLOC + TRNE B,1 + ETR [ASCIZ /Constants relocation phase error/] + ;DROPS THROUGH + +;DROPS THROUGH +CNST2: MOVEI D,(T) ;STE IDX IN D FOR OUTSM0 + MOVE SYM,(T) ;GET NAME OF AREA + TLC SYM,400000#LCUDF ;CLEAR LCUDF, SET HALF-KILL + TRNE FF,FRGLOL + PUSHJ P,PDEFPT ;DEFINE SYM FOR BEGINNING OF CONSTANTS AREA + MOVE A,CONTBA +CNSTH: CAML A,PLIM + JRST CNSTA ;THRU + MOVE TT,(A) + MOVEM TT,WRD + PUSHJ P,CPTMK + LDB F,C ;GET THIS CONSTANT'S RELOCATION BITS + TRZE F,2 + TLO F,1 ;RELOCATE LEFT HALF + MOVEM F,WRDRLC ;STORE RELOCATION + MOVEI D,GLOTB ;AND NOW TO SET UP GLOTB! + MOVEM D,GLSP2 + MOVE C,CONGLA +CNSTC: CAML C,CONGOL + JRST CNSTB ;END OF CONSTANT-GLOBAL TABLE + CAMN A,1(C) ;POINTS TO THIS CONSTANT? + PUSH D,(C) ;YES, STORE ENTRY IN GLOTB + AOS C + AOJA C,CNSTC + +CNSTB: HRRZM D,GLSP1 ;MARK END OF ACTIVE PART OF GLOTB + PUSH P,A + PUSHJ P,PWRD ;OUTPUT THIS CONSTANT + AOS CLOC ;INCREMENT CLOC TO NEXT + HRRZS CLOC ;MAKE SURE IT STAYS IN A HALF-WORD (IMPORTANT SINCE MAY BE LESS THAN RELOCATION) + POP P,A ;RESTORE POINTER INTO CONSTANTS TABLE + AOJA A,CNSTH + +CNST3: HLRZ A,1(T) ;GET POINTER TO TOP OF AREA STORED DURING PASS 1 + CAMN A,CLOC ;SAME AS CURRENT? + JRST CNSTE ;YES, NO HAIR + CAMGE A,CLOC ;DIFFERENT; LOWER? + ETR [ASCIZ /More constants on pass 2 than 1/] + ;INSUFFICIENT CONSTANT SPACE; CONSTANTS AREA TRYING TO BE BIGGER + ;IN PASS 2 THAN PASS 1; THE EXTRA CONSTANTS WERE BACKED OVER + MOVEM A,CLOC ;EITHER WAY, SET CLOC TO TOP OF AREA SO WON'T HAVE MDT TROUBLE + PUSHJ P,EBLK ;END CURRENT BLOCK + CALL SLOCF ;IF RELOCATABLE, MAKE SURE NEW VALUE OF $. GETS PUNCHED + JRST CNSTE + +;CALL SLOCF WHENEVER "." IS CHANGED WITHOUT THE OUTPUTTING OF A STORAGE WORD. +SLOCF: MOVE A,CLOC ;STORE NEW "." IN HEADER FOR NEXT BLOCK OF OUTPUT. + SKIPGE TM,CONTRL + TRNN TM,DECREL+FASL ;BUT NOT IN DEC OR FASL OUTPUT FORMATS. + HRRM A,BKBUF + IORI FF,FRLOC ;MAKE SURE NULL BLOCK IS OUTPUT IF NEC. TO TELL LOADER "." HAS CHANGED. + RET + +;CONSTA DURING PASS 1 + +CNST1: HRRM B,1(T) ;STORE LOCATION OF AREA + MOVEI D,0 + MOVE A,CRLOC + ADD A,OFRLOC + TRNE A,1 + TLO D,CTRL ;RELOCATED + TRNE FF,FRGLOL + TLO D,CGBAL ;GLOBAL + IORM D,2(T) ;STORE FLAGS DESCRIBING AREA + JUMPL FF,CNST2 ;JUMP ON PUNCHING PASS, PUNCH OUT AREA NOW + MOVE T,PLIM + SUB T,CONTBA + ADDM T,CLOC ;PASS 1, JUST UPDATE CLOC + HRRZS CLOC + +CNSTA: HRRZ T,PBCON + TRNE FF,FRGLOL + JRST CNSTD ;LOCATION GLOBAL + TRNN FF,FRNPSS + SKIPGE 2(T) + JRST CNSTDA ;2 PASS ASSEMBLY OR AREA DEFINED + TRO I,IRCONT ;1PASS AND NOT DEFINED + SETZM PARBIT + PUSHJ P,P70 ;DEFINE SYM + MOVE A,(T) + TLC A,400000#LCUDF + SKIPE CRLOC + TLO A,100000 ;RELOCATE + PUSHJ P,$OUTPT + HRRZ A,1(T) + PUSHJ P,$OUTPT ;OUTPUT VALUE, FIRST LOCATION IN AREA + TRZ I,IRCONT +CNSTDA: MOVSI A,CTDEF + IORM A,2(T) ;CALL IT DEFINED +CNSTD: TRNE FF,FRPSS2 + JRST CNST3 ;PASS 2 + MOVE A,CLOC + HRLM A,1(T) ;MARK END OF AREA + +CNSTE: MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + MOVEI T,3 + ADDB T,PBCON + CAML T,PBCONL + MOVEM T,PBCONL + AOS A,CSQZ + MOVEM A,(T) + POPJ P, + +;DEFINING SYM USED IN CONSTANT, DELETE REFERENCES FROM CONSTANT-GLOBAL TABLE + +CONBUG: MOVE A,CONGLA ;B VAL C FLAGS ST(D) SADR + PUSH P,T + PUSH P,C ;SAVE FLAGS +CONBG2: MOVE C,(P) ;GET FLAGS + CAML A,CONGOL ;DONE WITH SCAN? + JRST CONBG1 ;YES + HRRZ F,(A) ;NO, GET CONSTANT-GLOBAL TABLE ENTRY + CAIE F,ST(D) ;POINT TO THIS SYM? + AOJA A,CONBG6 + PUSH P,B ;YES, SAVE VALUE, ABOUT TO WORK WITH B + MOVE T,(A) ;GET ENTIRE CONSTANT-GLOBAL TABLE ENTRY + LDB CH2,[221200,,T] ;GET MULTIPLICATION FIELD + SKIPE CH2 + IMUL B,CH2 ;NON-ZERO => MULTIPLY VALUE OF SYM + TLNE T,MINF + MOVNS B ;NEGATE VALUE + TLNE T,HFWDF + HRRZS B ;TRUNCATE TO HALFWORD + TLNE T,ACF + ANDI B,17 ;AC, MASK TO FOUR BITS + TLNE T,SWAPF + MOVSS B ;SWAP VALUE + TLNE T,ACF + LSH B,5 ;AC, SHIFT FIVE + ADD B,@1(A) ;ADD ABS PART OF VALUE + TLNN T,SWAPF + HRRM B,@1(A) ;NOT SWAPPED, STORE LH + TLNE T,SWAPF + HLLM B,@1(A) ;SWAPPED, STORE LH + TLNN T,HFWDF + MOVEM B,@1(A) ;FULL WORD, STORE VALUE + LDB CH1,[420200+P,,-1] ;GET HIGH BITS OF 3RDWRD, RELOCATION BITS + TLNE T,HFWDF ;NOW TO MAP RELOCATION BITS + TRZ CH1,2 + TLNE T,SWAPF + LSH CH1,1 + TRZE CH1,4 + TRO CH1,1 + PUSH P,A + HRRZ A,1(A) ;GET POINTER INTO CONSTANTS TABLE + PUSHJ P,CPTMK + LDB B,C ;GET RELOCATION BITS + TLNE T,MINF + JRST CONBG8 ;NEGATE + TRNE B,(CH1) + ETA ERRCRI + ;ATTEMPTED MULTIPLE RELOCATION IN CONSTANT + ; ^ ABOVE SHOULD BE REPLACED WITH A $RSET LIKE ROUTINE + ;THAT ALSO SEARCHES CONSTANT-GLOBAL TABLE FOR $R. ALREADY THERE + IOR B,CH1 ;LOOKS OK, IOR IN BITS FOR GLOBAL +CONB8A: DPB B,C ;STORE BACK NEW RELOCATION BITS FOR CONSTANT + POP P,A + CLEARM (A) ;CLEAR OUT CONSTANT-GLOBAL TABLE ENTRY + CLEARM 1(A) + POP P,B + AOS A +CONBG6: AOJA A,CONBG2 ;BACK FOR NEXT CONSTANT, DON'T KNOW HOW MANY THIS SYM USED IN + +CONBG1: MOVE A,CONGLA + PUSH P,B + MOVE B,CONGLA +CONBG7: CAML A,CONGOL + JRST CONBG3 + SKIPN C,(A) +CONBG5: AOJA A,CONBG4 + MOVEM C,(B) + MOVE C,1(A) + MOVEM C,1(B) + AOS B + AOJA B,CONBG5 + +CONBG4: AOJA A,CONBG7 +CONBG3: MOVEM B,CONGOL + POP P,B + POP P,C + POP P,T + POPJ P, +CONBG8: XORI B,3 + TRNE B,(CH1) + ETA ERRCRI + ANDCB B,CH1 + JRST CONB8A + +ERRCRI: ASCIZ /Multiple relocation in constant/ + +;VARIAB + +AVARIAB: NOVAL + SKIPE ASMOUT ;FLUSH ANY GROUPINGS IN PROGRESS. + JSP LINK,CONFLM + PUSHJ P,AVARI0 + JRST ASSEM1 + +AVARI0: SOSG VARCNR ;ENTRY FROM AEND + ETF [ASCIZ /Too many variable areas/] + MOVE D,SYMAOB ;SET UP AOBJN POINTER TO ST + MOVE T,CLOC + MOVEM T,VCLOC ;STORE AS LOCATION OF VARIABLE AREA + ADD T,OFLOC + MOVE C,CRLOC + ADD C,OFRLOC + TRNE FF,FRPSS2 + JRST AVAR1 ;PASS 2 + HRL T,VARCNT ;SIZE OF AREA + TRNE C,1 + TLO T,400000 ;RELOCATED + MOVEM T,@VARPNT + JRST AVAR2E + +AVAR1: HRRZ A,@VARPNT ;VARIAB DURING PASS 2 + CAIE A,(T) + ETR [ASCIZ /Variables location phase error/] + HLRZ A,@VARPNT + TRZE A,400000 + XORI C,1 + TRNE C,1 + ETR [ASCIZ /Variables relocation phase error/] + SKIPE VARCNT + ETR [ASCIZ /Variables area size phase error/] + +AVAR2E: HLRZ T,@VARPNT + TRNN T,377777 + JRST AVAR2C ;IF THIS VAR AREA IS EMPTY, DON'T SCAN SYMTAB. +AVAR2: HLRZ LINK,ST(D) ;SCAN, CHECKING EACH SYM FOR WHETHER IT'S A VARIABLE + CAIL LINK,DEFLVR + JRST AVAR2B + ADD D,WPSTE1 + AOBJN D,AVAR2 + JRST AVAR2C ;ALL SCANNED. + +AVAR2B: 3GET C,D ;FOUND A VARIABLE; DECIDE WHAT TO DO WITH IT. + MOVE B,ST+1(D) + MOVE SYM,ST(D) + TLZ SYM,740000 + LDB LINK,[400400,,ST(D)] + CAIE LINK,UDEFLV_-14. + CAIN LINK,UDEFGV_-14. + JRST AVAR3 ;UNDEFINED VARIABLE + CAIE LINK,DEFGVR_-14. + CAIN LINK,DEFLVR_-14. + JRST AVAR4 ;DEFINED VARIABLE +AVAR2A: ADD D,WPSTE1 + AOBJN D,AVAR2 ;CHECK ENTIRE SYMTAB +AVAR2C: HLRZ A,@VARPNT ;NOW GET SIZE OF AREA + TRZ A,400000 ;CLEAR OUT RELOCATION CHECK BIT +IFN FASLP,[ + MOVE D,CONTRL + TRNE D,FASL ;IN FASL ASSEMBLY, CAN'T JUST SET LOC CTR; MUST OUTPUT 0'S. + CALL ABLKF +] + ADD A,VCLOC ;ADD LOCATION OF BEGINNING OF VARIABLE AREA + MOVEM A,CLOC ;STORE AS NEW CURRENT LOCATION + PUSHJ P,EBLK + CALL SLOCF + CLEARM VARCNT ;INITIALIZE COUNT OF VARIABLES IN NEXT AREA + AOS VARPNT ;INCREMENT POINTER TO POINT TO NEXT AREA + POPJ P, + +;UNDEFINED VARIABLE FOUND IN SYMTAB SCAN + +AVAR3: CAIN LINK,UDEFGV_-14. ;GLOBAL? + TLO SYM,40000 ;GLOBAL + PUSHJ P,LKPNRO + MOVSI T,DEFLVR + CAIN LINK,UDEFGV_-14. + MOVSI T,DEFGVR + TRNE FF,FRGLOL + JRST AVAR3A ;LOCATION GLOBAL + MOVEI B,-1(B) + ADD B,VCLOC + ADD B,OFLOC + MOVE TT,CRLOC + ADD TT,OFRLOC + SKIPE TT + TLO C,3RLR + CAIE LINK,UDEFGV_-14. + TLZN C,3VCNT + SKIPA + PUSHJ P,CONBUG +AVAR4B: PUSHJ P,VSM2 + JUMPGE FF,AVAR2A ;IF PUNCHING PASS, OUTPUT DEFINITION. + PUSHJ P,OUTDE2 + JRST AVAR2A + +AVAR4: TLNE C,3VAS2 ;DEFINED VARIABLE FOUND DURING SYMTAB SCAN + TLOE C,3VP + JRST AVAR2A + MOVSI T,(LINK) ;CAUSE AVAR4B TO REDEFINE AS SAME TYPE. + LSH T,14. + TRNN FF,FRGLOL + JRST AVAR4A +AVAR3A: PUSHJ P,VSM2LV + JUMPGE FF,AVAR2A + PUSHJ P,PDEFPT + MOVEI A,0 + PUSHJ P,PBITS + PUSHJ P,$OUTPT + AOS CLOC + JRST AVAR2A + +AVAR4A: CAIN LINK,DEFGVR_-14. ;DEF VAR, 3VAS2, POINT NOT GLOBAL. + JRST AVAR4B ;VAR GLOBAL, MUST PUNCH DEF SINCE DIDN'T ON PASS1. + 3PUT C,D ;LOCAL, JUST SET 3VP SO DON'T SEE IT NEXT VARIAB. + JRST AVAR2A ;NO NEED TO PUNCH DEF SINCE WAS DEF ON PASS1. + +;;MAIN ;"MAIN" MIDAS ROUTINES: INIT, PS1, PLOD, PS2, PSYMS + ;ALL CALLED WITH JSP A,; ALL GLOBAL + ;RETURN INSTRUCTION FROM JSP IN LOCATION RETURN +PS1: HRRM A,RETURN ;PASS 1, (PASS 1 INITIALIZATION ALREADY DONE), SAVE RETURN + PUSH P,[ASSEM1-1] ;SIMBLK WILL POPJ1. +IFN A1PSW,[SKIPL PRGC + JRST A1PAS1 ;THIS NOT FIRST PROGRAM THIS ASSEMBLY, SET MODE TO 1PASS +] + TRO FF,FRNPSS +IFN ITSSW,JRST SIMBLK ;SELECT SBLK AND ASSEMBLE +IFN DECSW\TNXSW,JRST A.DECRE ;SELECT .DECREL AND ASSEMBLE. + +PS2: HRRM A,RETURN ;PASS 2 (MAIN ROUTINE, PASS 2 INITIALIZATION NOT ALREADY DONE), SAVE RETURN + JUMPL FF,PA2A ;JUMP IF PASS 1 ENDED IN 1PASS MODE + TDO FF,[FLPPSS,,FRPSS2] ;SET PUNCHING PASS AND PASS 2 FLAGS + PUSHJ P,P2INI ;INITIALIZE + JRST ASSEM1 ;START ASSEMBLING + +PA2A: MOVE A,SYMAOB ;PASS 2 OF 1PASS ASSEMBLY, CHECK FOR UNDEFINED LOCALS +PA2C: MOVE SYM,ST(A) ;GET SQUOZE THIS SYMTAB ENTRY + LDB B,[400400,,SYM] ;GET FLAGS + CAIE B,LCUDF_-14. ;LOCAL UNDEFINED? + JRST PA2B ;NOT LOCAL UNDEFINED, DON'T COMPLAIN + 3GET C,A ;LOCAL UNDEFINED, GET 3RDWRD ST ENTRY + TLZ SYM,740000 ;CLEAR OUT FLAGS IN SYM IN ANTICIPATION OF TYPING OUT COMPLAINT + TLNN C,3LLV ;PROBLEM HANDED TO LINKING LOADER? + ETSM [ASCIZ /Undefined/] ;NO +PA2B: ADD A,WPSTE1 ;NOW GO FOR NEXT ST ENTRY + AOBJN A,PA2C + JRST RETURN + +$INIT: HRRM A,RETURN ;INITIALIZATION (BEFORE PASS 1 ONLY) ROUTINE, SAVE RETURN POINT +IFN CREFSW,PUSHJ P,CRFOFF ;DON'T CREF ON 1ST PASS. +IFN LISTSW,CALL LSTOFF ;DON'T LIST ON 1ST PASS. + SKIPGE ISYMF + JRST INIT1 ;SPREAD SYMS (RETURNS TO SP4) + MOVE A,SYMAOB ;ALREADY SPREAD, JUST FLUSH ALL BUT INITIAL SYMS +INIT4: SKIPN B,ST(A) + JRST INIT2 + 3GET C,A + TRNE C,-1 ;INITIAL SYM? + CLEARM ST(A) ;NO +INIT2: ADD A,WPSTE1 + AOBJN A,INIT4 + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1] + BLT A,EBKCOD ;CLEAR OUT BLANK CODE + +SP4: PUSH P,CRETN +P1INI: CLEARB I, LDCCC + INSIRP SETZM,BKBUF ISYMF A.PASS +IFN FASLP,[ + INSIRP SETZM,FASATP FASPCH + CLEARM FASIDX +] + MOVEMM DECTWO,[[MOVE]] + TDZ FF,[FFINIT] ;INITIALIZE MOST FF FLAGS + MOVEIM A.PPASS,2 ;DEFAULT IS 2-PASS. + PUSHJ P,MACINI ;INITIALIZE MACRO STATUS + MOVEI A,PCNTB + MOVEM A,PBCONL + MOVS A,[BKTAB,,P1INI1] + BLT A,BKTAB+4 + MOVEIM BKTABP,BKWPB*2 + +;DROPS IN. +P2INI: INSIRP SETZM,[CPGN,CLNN,GENSM,OFLOC,OFRLOC,CRLOC,BKPDL +SYLOC,SYSYM,BYTW,BYTRLC,STGSW,DECBRK,DEFNPS,BYTM,BYTM1,HKALL,QMTCH] + AOS B,A.PASS +IFN ITSSW,[ + CALL SETWH2 ;SET UP .WHO2, PREPARE .WHO3 IN A WITH PAGENUM=1. + .SUSET [.SWHO3,,A] ;'P1 ',,PAGENUM OR 'P2 ',,PAGENUM + .SUSET [.SWHO1,,[.BYTE 8 ? 166 ? 0 ? 165 ? 0]] +] + TDZ FF,[FLUNRD,,FRGLOL] +IRP X,,[BKWPB,BKCUR,,BKPDL+1,1,BKLVL,IRDEF,ASMI +NCONS,CONCNT,VARTAB,VARPNT,NVARS,VARCNR,1,VECSIZ] +IFE 1&.IRPCN,IFSN [X], MOVEI A,X +IFN 1&.IRPCN, MOVEM A,X +TERMIN + MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + CLEARM VARCNT + CLEARM PBITS2 + MOVE A,[440300,,PBITS1] + MOVEM A,BITP + MOVEI A,PBITS4 + HRRZM A,PBITS4 + CLEARB I,PBITS1 + MOVEI A,PCNTB + MOVEM A,PBCON + MOVE A,[(LCUDF)++1] ;< AND > FOR COMPATIBILITY WITH OLD + MOVEM A,PCNTB + MOVEM A,CSQZ + MOVEI A,8 + MOVEM A,ARADIX + +IFN ITSSW,[ + MOVEI A,100 + MOVEM A,CLOC +] +.ELSE [ + SETZ A, ; SET LOC COUNTERS APPROPRIATELY + SKIPGE B,CONTRL + TRNE B,DECREL+FASL + JRST [SETZM CLOC ; ASSUME RELOCATABLE + AOS CRLOC ; CRLOC GETS 1 + JRST P2INI5] + TRNE B,DECSAV ; ASSUME ABSOLUTE + MOVEI A,140 + TRNE B,SBLKS + MOVEI A,100 ; IF SBLK FORMAT ASSUME FOR ITS. + MOVEM A,CLOC +P2INI5: +] + SETZM GLOCTP + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,CONTRL ;IN DEC FORMAT, OUTPUT PROGRAM NAME. + TRNE A,DECREL + CALL DECPGN ;CLOBBERS A +IFN FASLP,[ + SETOM FASBLC ;LOSING BLOCK COUNT + MOVE A,CONTRL ;IN FASL FORMAT, OUTPUT FASL HEADER + TRNE A,FASL + CALL FASOIN ;INITIALIZE FASL OUTPUT +] + SETZM DECBRH + TRO FF,FRSYMS+FRFIRWD + MOVE A,[IFORTB,,FORTAB] ;INITIALIZE FORMAT TABLE ON EACH PASS + BLT A,FRTBE + MOVEIM GLSPAS,GLOTB ;INIT. ASSEM1 PDL LEVELS TO BOTTOM. + MOVEMM ASSEMP,[[-LPDL,,PDL]] + MOVEIM ASMDSP,ASSEM3 + SETZM ASMOUT + SETZM CONSTP + SETZM SCNDEP ;NOT IN CONDIT. OR CONSTANT. + SETZM CONDEP + HRRZM P,CONSML ;START OUT IN MULTI-LINE MODE. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + MOVEM A,PNTBP + CLEARM LISTPF + SETOM LISTBC + SKIPG LISTP1 ;IF LIST ON PASS 1 + JUMPGE FF,CRETN ;OR PUNCHING PASS, + SKIPE LISTP ;IF WANT LISTING, + CALL LSTON ;TURN ON OUTPUT OF LISTING. +] +IFN CREFSW,[ + JUMPGE FF,CRETN + SKIPE CREFP ;IF C SWITCH WAS SEEN, + PUSHJ P,CRFON ;TURN ON CREFFING, +] +CRETN: POPJ P,RETURN + +P1INI1: SQUOZE 0,.INIT ? 0 ? 3 + SQUOZE 0,.MAIN ? 1,, + +PLOD: HRRM A,RETURN ;MAIN ROUTINE TO PUNCH LOADER, CALLED BEFORE PASS 2 (PS2"), SAVE RETURN POINT + PUSHJ P,PLOD1 ;PUNCH LOADER + JRST RETURN ;RETURN + + ;PUNCH OUT THE LOADER + +PLOD1: PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE + MOVE B,CONTRL + TRNE B,ARIM10 + JRST PLOD2 ;RIM10 => PUNCH OUT SBLK LOADER FOR PDP10 READIN-MODE READIN + TRNN B,SBLKS + POPJ P, ;NOT SBLK => DON'T PUNCH LOADER +PLOD1A: MOVSI B,SLOAD-SLOADP ;PUNCH SBLK LOADER IN RIM FORMAT + MOVSI C,(DATAI PTR,) +PLOAD1: MOVE A,C + PUSHJ P,PPBA + CAMN C,[DATAI PTR,13] + HRRI C,27 + MOVE A,SLOAD(B) + PUSHJ P,PPBA + AOS C + AOBJN B,PLOAD1 + MOVE A,[JRST 1] + PUSHJ P, PPBA + JRST FEED1 + +PLOD2: MOVSI C,LDR10-ELDR10 ;PUNCH SBLK LOADER FOR PDP10 READIN +PLOD3: MOVE A,LDR10(C) + PUSHJ P,PPBA + AOBJN C,PLOD3 + JRST FEED1 + + ;SBLK LOADER NORMALLY PUNCHED OUT IN RIM FORMAT + +SLOAD: CONO PTR,60 ;0 RESTART POINT (NEW BLOCK) + JSP 14,30 ;1 START POINT, LOOP POINT FOR NEW BLOCK; WAIT FOR DATA WORD READY + DATAI PTR,16 ;GET HEADER + MOVE 15,16 ;INITIALIZE CHECKSUM + JUMPGE 16,16 ;HEADER .GE. 0 => STARTING INSTRUCTION + JSP 14,30 ;5 LOOP POINT FOR NEXT DATA WORD: WAIT FOR READY + DATAI PTR,(16) ;READ IN DATA WORD + ROT 15,1 ;NOW UPDATE CHECKSUM + ADD 15,(16) + AOBJN 16,5 ;LOOP FOR ALL DATA WORDS THIS BLOCK + MOVEI 14,33 ;30 TO RETURN TO 33 + JRST 30 ;WAIT FOR READY THEN GO TO 33 + ;14 JSP AC FOR ROUTINE AT 30 + ;15 CHECKSUM + ;16 AOBJN POINTER (UPDATED HEADER) + CONSO PTR,10 ;30 ROUTINE TO WAIT FOR DATA WORD READY FOR DATAI + JRST 30 + JRST (14) + DATAI PTR,16 ;33 GET CHECKSUM + CAMN 15,16 ;COMPARE WITH CALCULATED + JUMPA 1 ;OK, GO GET NEXT BLOCK (DON'T CHANGE TO JRST OR REAL LOADERS WILL GET CONFUSED) + JRST 4, ;CHECKSUM ERROR +SLOADP==. + +;PDP10 SBLK LOADER +;FOLLOWING CODING ACTUAL WORDS TO BE OUTPUT + ;BY ASSEMBLER, COMPILER, OR WHATEVER +;SHOULD BE EXECUTED BY PDP10 HARDWARE READIN FEATURE +;USES ONLY THE AC'S (BUT ALL OF THEM) + +LDR10: + -17,,0 ;BLKI POINTER FOR READ SWITCH + +LDRC=0 ;CHECKSUM (OK, SO YOU'RE NOT ALLOWED TO LOAD + ;INTO IT DURING HARDWARE READIN, BUT WHO SAYS + ;YOUR PROGRAM CAN'T USE IT?) +OFFSET -.+1 ;BEGIN LOADING INTO 1 AS PER HEADER +LDRGO==. + CONO PTR,60 ;START UP PTR (RESTART POINT) +LDRRD==. + HRRI LDRB,.+2 ;INITIALIZE INDEX +LDRW==. + CONSO PTR,10 ;WAIT FOR WORD TO BE AVAILABLE + JRST .-1 + ROT LDRC,-LDRRD(LDRB) ;BEFORE READING IN HEADER, ROTATE 2 BITS (THEN IGNORE) + ;BEFORE READING IN EACH DATA WORD, ROTATE 1 BIT (FOR UPDATING CHECKSUM) + ;BEFORE READING IN CHECKSUM, ROTATE NOT AT ALL (DON'T ROTATE CALCULATED CHECKSUM) + DATAI PTR,@LDRT1-LDRRD(LDRB) ;READ WORD INTO RIGHT PLACE + ;HEADER => READ INTO C + ;STORAGE WORD => READ INDEXED BY AOBJN POINTER IN A + ;CHECKSUM => READ INTO A FOR COMPARISON WITH C(C) + XCT LDRT1-LDRRD(LDRB) ;EXECUTE RELEVANT T1 ENTRY (MAYBE SKIPS) + XCT LDRT2-LDRRD(LDRB) ;EXECUTE RELEVANT T2 ENTRY (MAYBE JUMPS) +LDRB==. + SOJA ., ;-RD(B) IS 2, 1, AND 0 FOR SUCCESSIVE ENCOUNTERS OF THIS INSTRUCTION + ;USED AS INDEX INTO TABLES, ETC. + + ;TABLE 1 + ;INDIRECTED THROUGH FOR DATAI + ;THEN EXECUTED TO SEE WHAT TO DO WITH READ IN WORD + ;ENTRIES EXECUTED IN REVERSE ORDER + +LDRT1==. + CAME LDRC,LDRA ;COMPARE CHECKSUM WITH CALCULATED, SKIP TO B IF THEY AGREE + ADD LDRC,(LDRA) ;UPDATE CHECKSUM + SKIPL LDRA,LDRC ;INITIALIZE HEADER AND SKIP UNLESS JUMP BLOCK + + ;TABLE 2 + ;EXECUTED IF CORRESPONDING ENTRY IN TABLE 1 DIDN'T SKIP WHEN EXECUTED + +LDRT2==. + JRST 4,LDRGO ;CHECKSUM ERROR + AOBJN LDRA,LDRW ;UPDATE AOBJN POINTER AND GO BACK FOR NEXT STORAGE WORD IF NOT EXHAUSTED +LDRA==. + JRST LDRRD ;WHEN INITIALLY LOADED IS JUMP BLOCK TO THIS LOADER + ;DURING LOADING USED TO HOLD HEADER (AOBJN POINTER), WHICH MAY BE LOADED JUMP BLOCK + +OFFSET 0 +ELDR10==. + +;FLAGS IN SQUOZE OF SYMS TO OUTPUT + +ABSGLO==040000 ;SYM IS GLOBAL (IF RELOCA, SAYS THIS IS BLOCK NAME) +ABSLCL==100000 ;LOCAL +ABSDLI==200000 ;DELETE INPUT (DON'T RECOGNIZE IT IF TYPED IN) +ABSDLO==400000 ;DELETE OUTPUT (DON'T TYPE IT OUT) + +PSYMS: HRRM A,RETURN ;PUNCH OUT SYMBOL TABLE, CALLED AFTER EVERYTHING ELSE, SAVE RETURN POINT + PUSH P,PSYMS ;AT END, POPJ TO RETURN. + TRNE FF,FRSYMS + JRST SYMDMP ;PUNCH SYMS IF NEC. + SKIPL A,CONTRL + JRST SYMDA ;IF RELOCA, PUNCH PROGRAM NAME. + TRNE A,DECSAV ;IF DEC SAVE FORMAT WITHOUT SYMBOLS + JRST SYMDSA ;STILL DUMP START ADDRESS + TRNN A,DECREL + POPJ P, + +PSYMSD: MOVSI A,DECEND + PUSHJ P,DECBLK ;START AN END-BLOCK. + MOVE A,DECTWO ;IN 2-SEG PROGRAMS, + CAME A,[MOVE] + JRST [ CAMG A,DECBRH ;OUTPUT HISEG BREAK + MOVE A,DECBRH + MOVEM A,WRD + MOVEIM WRDRLC,1 + CALL PWRD + MOVEMM WRD,DECBRK + CALL PWRD ;FOLLOWED BY LOSEG BREAK + JRST EBLK] + MOVEMM WRD,DECBRK ;OUTPUT THE PROGRAM BREAK. + MOVEIM WRDRLC,1 + PUSHJ P,PWRD + MOVE A,DECBRA ;OUTPUT HIGHEST ABS. ADDR + CAIG A,140 + SETZ A, ;IF IT'S ABOVE THE JOBDAT AREA. + PUSHJ P,DECWRD + JRST EBLK + +SYMDA: MOVEI A,LPRGN ;NOW PUNCH PROGRAM NAME + DPB A,[310700,,BKBUF] + MOVE A,PRGNM + TLO A,40000 + PUSHJ P,$OUTPT + PUSHJ P,EBLK + TLZ FF,$FLOUT + POPJ P, + + ;DUMP OUT THE SYMBOL TABLE + +SYMDMP: TRZ I,IRCONT ;OK TO END BLOCK + CLEARM GLSP1 + CLEARM GLSP2 + CLEARM WRDRLC + MOVE T,CONTRL + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + CLEARM CLOC + CLEARM BKBUF +IFN FASLP,[ + TRNE T,FASL + JRST SYMDM1 +] +IFN ITSSW,[ + TRNE T,SBLKS ; ON ITS, IF OUTPUTTING IN SBLK FMT + CALL SYMDDB ; THEN OUTPUT A DEBUGGING INFO BLOCK. +] + TRNE T,DECREL + JRST SYMDMD + JUMPL T,SSYMD ;JUMP IF NOT STINK + + MOVEI B,LDDSYM ;LOCAL SYMS BLOCK TYPE + DPB B,[310700,,BKBUF] ;SET BLOCK TYPE + MOVEM B,CDATBC + MOVE B,SYMAOB ;CAUSE SSYMD3 TO LOOK AT ENTIRE SYM TAB. + JRST SSYMDR + +SYMDMD: MOVSI A,DECSYM ;IN DEC FMT, START SYMBOLS BLOCK. + PUSHJ P,DECBLK +SYMDM1: MOVE B,SYMAOB + JRST SSYMDR + +IFN ITSSW,[ + + ; OUTPUT DEBUGGING INFO BLOCK (ITS SBLK ONLY) + +SYMDDB: MOVE A,[-7,,3] ;OUTPUT A "DEBUGGING INFORMATION" BLOCK + MOVE B,A ;UPDATING THE CHECKSUM IN B. + PUSHJ P,PPB + MOVE A,[-6,,1] ;THE BLOCK CONTAINS ONE SUBBLOCK - A "MIDAS INFO" SUBBLOCK. + PUSHJ P,PPBCK + .SUSET [.RXUNAME,,A] ;CONTAINING NAME OF USER, DATE IN DISK FORMAT, + PUSHJ P,PPBCK + SYSCAL RQDATE,[%CLOUT,,A] + .LOSE %LSSYS + PUSHJ P,PPBCK ;AND THE SOURCE FILE NAMES (DEV, FN1, FN2, SNAME). +REPEAT 4,[ + MOVE A,INFB+$F6DEV+.RPCNT + PUSHJ P,PPBCK +] + MOVE A,B + PJRST PPB ; PUNCH OUT CHECKSUM & RETURN +] ;IFN ITSSW, + +;AC ALLOCATIONS DURING PHASE 1 (COMPACTING THE SYMBOL TABLE): + ;AA INITIALLY HAS -SMK,,; INPUT INDEX INTO ST + ;A TEMP + ;B SQUOZE + ;D OUTPUT INDEX INTO SYMTAB + ;CH1 VALUE OF SYM + ;CH2 3RDWRD + +SSYMD: MOVEI D,ST-1 + SETZB C,SMSRTF ;SYMS SORTED => INITIAL SYMS CLOBBERED + MOVE AA,SYMAOB +SSYMD1: SKIPE B,ST(AA) ;GET SYM NAME FROM TABLE + TDNN B,[37777,,-1] ;MAKE SURE NOT EXPUNGED + JRST SSYMDL ;NOT (REALLY) THERE, TRY NEXT + AOS SMSRTF + MOVE CH1,ST+1(AA) ;GET VALUE OF SYM + 3GET CH2,AA ;GET 3RDWRD + TRNE CH2,-1 + TLNE CH2,3KILL+3LLV + JRST SSYMDL ;DON'T PUNCH INITIAL OR KILLED SYMS. + MOVEI A,0 ;INITIALIZE FOR SHIFTING IN FLAGS + LSHC A,4 ;SHIFT FLAGS INTO A + XCT SSYMDT(A) ;DO THE APPROPRIATE THING THIS KIND OF SYMTAB ENTRY + JRST SSYMDL +SSYMD2: LSH B,-4 ;SHIFT SQUOZE BACK TO WHERE IT BELONGS + TLO B,ABSLCL ;SET LOCAL BIT + TLNE CH2,3SKILL + TLO B,ABSDLO ;HALF-KILL SYM + CAIL A,DEFGVR_-16 + TLC B,ABSGLO\ABSLCL ;FOR GLOBAL SYM, SET GLOBAL BIT INSTEAD OF LOCAL BIT, + CAIGE A,DEFGVR_-16 ;AND PUT IT IN THE GLOBAL BLOCK IN THE SYMTAB. + SKIPN PRGNM+BKWPB ;IF ONLY ONE BLOCK IN PROGRAM, PUT ALL SYMS IN GLOBAL BLOCK. + HRRI CH2,0 + PUSH D,B ;STORE NAME OF SYM IN OUTPUT SLOT + PUSH D,CH1 ;STORE VALUE + PUSH D,CH2 ;STORE 3RDWRD +SSYMDL: ADD AA,WPSTE1 + AOBJN AA,SSYMD1 ;LOOP FOR ALL SYMS IN TABLE + MOVSI CH2,4^5 ;1ST BIT TO SORT ON IS TOP BIT, + MOVEI A,ST ;SORT FROM BOTTOM OF SYMTAB + MOVEI B,1(D) ;TO WHERE WE FILLED UP TO. + MOVE CH1,[TDNE CH2,1(A)] ;SORT ON 2ND WD, WDS WITH BIT ON COME FIRST. + MOVE C,[TDNN CH2,1(B)] + JSP AA,SSYMD9 + TLC C,(TDNE#TDNN) ;ON BITS AFTER 1ST, ENTRIES WITH BIT OFF COME FIRST. + TLC CH1,(TDNE#TDNN) + MOVEI AA,SSRTX ;NEED ONLY CHANGE C, CH1 THE FIRST TIME. + JRST SSRTX + +SSYMD9: PUSHJ P,SSRTX ;SORT SYMS ARITHMETICALLY BY VALUE. + MOVNI B,(B) + ADDI B,ST ;SIZE OF AREA OF SYMTAB STILL IN USE. + IDIV B,WPSTE + HRLZI B,(B) ;-<# SYMTAB ENTRIES>,, + MOVE T,CONTRL ; GET CONTRL FOR OUTPUT FMT CHECKS + MOVE A,[SQUOZE 0,GLOBAL] + MOVEM A,BKTAB ;CALL THE .INIT BLOCK "GLOBAL" WHICH IS WHAT DDT WANTS AS TOP BLOCK. + MOVE C,BKTABP + IDIVI C,BKWPB ;# BLOCKS (INCL. GLOBAL BLOCK). + CAIN C,2 ;IF ONLY GLOBAL AND MAIN, TELL BKSRT TO IGNORE MAIN. + SETZM PRGNM+1 + CAIN C,2 + MOVEI C,1 ;IF ONLY GLOBAL AND MAIN, FILE WILL HAVE ONLY 1 BLOCK (GLOBAL). + CAILE C,1 ;IF MORE THAN ONE BLOCK IN FILE, + TRNN T,DECSAV ;AND OUTPUT FORMAT IS DECSAV, + CAIA + ADDI C,1 ;THEN ALLOW FOR ONE MORE "BLOCK" (PGM NAME). + ;NOTE THAT DECSAV FMT REPLACES BLOCKNAME WITH PGM-NAME + ;FOR SINGLE-BLOCK CASE, SO COUNT OF 1 WORKS OK. + MOVSI A,(C) ; <# BLOCKS TO OUTPUT>,, + SUBM B,A ;-<# ENTRIES IN SYMTAB IN FILE>,, + LSH A,1 ;-<# WDS IN SYMTAB IN FILE>,, + TRNE T,DECSAV ; IF OUTPUT FORMAT IS DEC SAV, + JRST [ HRR A,DECSYA ; GET LOC TO STORE SYMS AT + MOVE C,A + MOVE A,[-1,,116-1] ; STORE IT AT .JBSYM + CALL PPB + MOVE A,C + CALL PPB + HRRI A,-1(A) ; SET -<# WDS IN SYMTAB>,, + JRST .+1] + MOVEM A,SCKSUM ;SAVE 1ST WD FOR CHECKSUM (DECSAV IGNORES IT) + PUSHJ P,PPB + PUSHJ P,BKCNT ;PUT -<# SYMS IN BLOCK> IN 3RD WD OF EACH BKTAB ENTRY. + +;DROPS THROUGH. + +;DROPS IN IF ABS, JUMPS HERE IF RELOC. +;NOTE THAT IN ABS ASSEMBLY, B WILL CONTAIN THE CHECKSUM AND +;SHOULD NOT BE CLOBBERED. +SSYMDR: PUSH P,B ;-<# SYMS>,,0 ;IT WILL BE -1(P) + PUSHJ P,BKSRT ;SORT BLOCKS INTO BKTAB1 + MOVE A,BKTAB + CAME A,[SQUOZE 0,GLOBAL] ;IF ABS, WE RENAMED .INIT TO GLOBAL, SO LEAVE IT IN BKTAB1 + SOS D ;ELSE FLUSH .INIT FROM THE END OF BKTAB1. + SETOM 1(D) ;PUT A -1 AT END OF BKTAB1. + MOVE B,SCKSUM ;GET CHKSUM AFTER 1ST WD. (PPBCK WILL UPDATE) + PUSH P,[-1] ;(P) WILL BE BKTAB1 IDX OF NEXT BLOCK TO OUTPUT. +SSYMD3: AOS F,(P) ;F HAS BKTAB1 IDX OF BLOCK. + SKIPGE C,BKTAB1(F) ;BKTAB1 ELT HAS BKTAB IDX OR + JRST SSYMDX ; -1 AFTER LAST BLOCK. + SKIPL LINK,CONTRL + JRST SSYMD7 ;DIFFERENT RTN TO OUTPUT BLOCK NAME IF RELOCA. + TRNE LINK,DECREL+FASL+DECSAV + JRST SSYMD6 ; ALL THESE SKIP OVER SBLK-TYPE BLOCKNAME OUTPUT + MOVE A,BKTAB(C) + PUSHJ P,PPBCK ;OUTPUT BLOCK NAME WITH NO FLAG BITS SET. + HLRZ A,BKTAB+1(C) + SKIPE A + ADDI A,1 ;A GETS 0 FOR GLOBAL BLOCK, ELSE DDT LEVEL (= 1 + MIDAS LEVEL). + HRL A,BKTAB+2(C) ;PUT IN -2* + ADD A,[-2,,] +SSYMG2: PUSHJ P,PPBCK ;OUTPUT -SIZE,,LEVEL WORD OF BLOCK NAME ENTRY. + JRST SSYMD6 + +SSYMD7: MOVE A,BKTAB(C) ;OUTPUT BLOCK NAME IN RELOCATABLE. + TLO A,ABSGLO ;TELL STINK IT'S BLOCK NAME. + PUSHJ P,$OUTPT + HLRZ A,BKTAB+1(C) + SUBI A,1 + PUSHJ P,$OUTPT +SSYMD6: SKIPL C,-1(P) ;AOBJN PTR TO SYMS. + JRST SSYMD8 ;IN CASE NO SYMS. +SSYMD4: HRRZ A,ST+2(C) ;OUPUT ONLY THE SYMS IN THE BLOCK + CAME A,BKTAB1(F) ;NOW BEING HANDLED. + JRST SSYMD5 + SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL + JRST SYMD2 ;SPECIAL IF RELOCA. + MOVE A,ST(C) + TRNE LINK,DECSAV + CALL RSQZA ; RIGHT-JUSTIFY THE SQUOZE (SIGH) + PUSHJ P,PPBCK ;1ST, SQUOZE WITH FLAGS. + MOVE A,ST+1(C) + PUSHJ P,PPBCK ;2ND, VALUE. +SSYMD5: ADD C,WPSTE1 + AOBJN C,SSYMD4 ;HANDLE NEXT SYM. +SSYMD8: TRNN LINK,DECSAV + JRST SSYMD3 ;ALL SYMS FOR THIS BLOCK DONE, DO NEXT BLOCK. + + ; DECSAV FMT HAS BLOCK NAMES OUTPUT LAST. + SKIPN PRGNM+BKWPB ;IF ONLY ONE BLOCK IN PGM, + JRST SSYMD3 ; FORGET IT; PGM-NAME SUBSTITUTES FOR BLKNAME. + MOVE C,BKTAB1(F) ; GET IDX FOR BLOCK + MOVE A,BKTAB(C) ; GET BLOCKNAME WITH FLAGS CLEAR + TLO A,140000 ; SET FLAGS TO SAY SYM IS BLOCKNAME + CALL RSQZA ; RIGHT-JUSTIFY SQUOZE FOR DEC (UGH BLETCH) + CALL PPB + HLRZ A,BKTAB+1(C) ; GET LEVEL OF BLOCK (NO WD COUNTS) + CALL PPB + JRST SSYMD3 + + ; RIGHT-JUSTIFY SQUOZE IN A, PRESERVING FLAGS. + ; (WHICH ASQOZR RTN DOESN'T) + ; CLOBBERS B. +RSQZA: PUSH P,A ; SAVE FLAGS + TLZA A,740000 ; ZAP +RSQZA2: DPB A,[004000,,(P)] ; UPDATE + IDIVI A,50 + JUMPE B,RSQZA2 + POP P,A + POPJ P, + +;PUNCH OUT LOCAL SYM (RELOCATABLE ASSEMBLY) +;NORMALLY OUTPUT SQUOZE W/ FLAGS ? VALUE, +;IF 3LLV SET OUTPUT PHONY NAME (= STE ADDR) ? SQUOZE W/ FLAGS, STINK FIXES IT UP. +SYMD2: LDB A,[400400,,ST(C)] + MOVE CH1,ST+1(C) ;SSYMDT MAY CHANGE CH1. + MOVE CH2,ST+2(C) + XCT SSYMDT(A) ;SKIPS IF SHOULD OUTPUT SYM. + JRST SSYMD5 + TLNE CH2,3KILL + JRST SSYMD5 + MOVE B,ST(C) + TLZ B,740000 + JUMPE B,SSYMD5 ;UNUSED ENTRY. + JUMPL LINK,SYMDEC ;J IF DEC OR FASL FMT + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LEFT HALF + TLNE CH2,3RLR + TLO B,100000 ;RELOCATE RIGHT HALF + TLNE CH2,3SKILL + TLO B,400000 ;HALF-KILL + MOVEI A,ST(C) + TLNE CH2,3LLV ;IF STINK HAS VALUE, + PUSHJ P,$OUTPT ;GIVE STINK NAME STINK KNOWS SYMBOL BY. + TLNE CH2,3LLV ;IF GIVING PHONY NAME, INSURE LOCAL FLAG SET + TLO B,ABSLCL ;(STINK WILL DO SO OTHERWISE) + MOVE A,B + PUSHJ P,$OUTPT ;OUTPUT SYM + MOVE A,CH1 + TLNN CH2,3LLV ;DON'T OUTPUT VALUE IF DON'T KNOW IT. + PUSHJ P,$OUTPT ;OUTPUT VALUE + JRST SSYMD5 + +SYMDEC: IFN FASLP,[ + TRNE LINK,FASL + JRST SYMFSL ;FASL ASSMBLY +] + PUSHJ P,ASQOZR ;RIGHT-JUSTIFY THE SQUOZE, + TLNE CH2,3SKILL + TLO B,ABSDLO ;MAYBE HALFKILL, + TLO B,ABSGLO + LDB A,[400400,,ST(C)] + CAIGE A,DEFGVR_-14. + TLC B,ABSGLO+ABSLCL ;LOCAL SYM, CHANGE GLO TO LCL. + MOVEM B,WRD + PUSH P,C + PUSHJ P,DECPW ;FIRST, THE NAME, + POP P,C + LDB TM,[420200,,ST+2(C)] + MOVE A,ST+1(C) ;THEN THE VALUE AND RELOCATION BITS. + PUSHJ P,DECWR1 + JRST SSYMD5 + +IFN FASLP,[ +SYMFSL: TLO B,400000 ;GET VALUE FROM SECOND WD + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LH + TLNE CH2,3RLR + TLO B,100000 + CAIL A,LGBLCB_<-18.+4> + TLO B,40000 ;GLOBAL FLAG + MOVE A,B + MOVEI B,15 ;PUTDDTSYM + PUSHJ P,FASO + MOVE A,CH1 + PUSHJ P,FASO1 + JRST SSYMD5 +] + +;XCT INDEXED ON SQUOZE FLAGS; SHOULDN'T PUNCH SYM IF DOESN'T SKIP. +SSYMDT: JFCL ;COM + JFCL ;PSEUDO OR MACRO + CAIA ;SYM, PUNCH OUT + TLNN CH2,3LLV ;LOCAL UNDEFINED, OUTPUT IF STINK HAS VALUE TO TELL STINK WHERE TO PUT IT. + TLZA CH1,-1 ;DEFINED LOCAL VARIABLE, CLEAR OUT LH(VALUE) + JFCL ;UNDEFINED LOCAL VARIABLE + SKIPL CONTRL ;DEFINED GLOBAL VARIABLE, PUNCH OUT IF ABS. + JFCL ;UNDEFINED GLOBAL VARIABLE + SKIPL CONTRL ;GLOBAL ENTRY, PUNCH OUT IF ABS ASSEM. + JFCL ;GLOBAL EXIT, DON'T PUNCH OUT +IFN .-SSYMDT-NCDBTS,.ERR SSYMDT LOSES. + +SSYMDX: SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL + JRST SSYMG3 + TRNE LINK,DECSAV ; IN DECSAV FORMAT, + JRST [ MOVE A,PRGNM ; PGM NAME IS LAST THING IN SYMTAB + CALL RSQZA + CALL PPB ; WITH FUNNY VALUE OF + SETZ A, ; -<# SYMTAB WDS USED BY PGM>,, + CALL PPB ; BUT LAST PGM IN SYMTAB MUST HAVE LH=0, SO... + JRST SSYMG3] + MOVE A,B ; SBLK OR RIM ASSEMBLY, OUTPUT CHKSUM. + PUSHJ P,PPB +SSYMG3: SUB P,[2,,2] + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK + SKIPL A,CONTRL ;RELOCATABLE => OUTPUT PROG NAME. + JRST SYMDA +IFN FASLP,[ + TRNE A,FASL + POPJ P, +] + TRNE A,DECREL ;DEC FMT => OUTPUT END BLOCK. + JRST PSYMSD +SYMDSA: MOVE A,STARTA ;NOW GET STARTING INSTRUCTION + JRST PPB ;PUNCH IT OUT AND RETURN + +;PUT INTO BKTAB1 THE BKTAB IDXS OF ALL THE BLOCKS IN THE ORDER THEIR +;SYMS SHOULD BE PUNCHED (A BLOCK'S SUBBLOCKS PRECEDE IT) +;THE .INIT BLOCK (MAYBE BY NOW RENAMED "GLOBAL") GOES IN LAST. D POINTS AT WHERE IT WAS PUT. +; NOTE THAT FOR DECSAV FORMAT THE ORDERING IS REVERSED; A BLOCK'S SUBBLOCKS +; FOLLOW IT, AND THE .INIT BLOCK GOES IN FIRST. + +BKSRT: MOVEI D,BKTAB1-1 ;D IS FOR PUSHING INTO BKTAB1. + MOVSI A,1 ;START WITH BLOCK 0 (OUTERMOST, .INIT). + MOVE LINK,CONTRL + + ;HANDLE BLOCK IN A: LOOK FOR ITS SUBBLOCKS. +BKSR1: TRNE LINK,DECSAV + JRST [ MOVEI C,(A) ? PUSH D,C ? JRST .+1] + SETZ C, +BKSR2: CAME A,BKTAB+1(C) + JRST BKSR3 ;THIS BLOCK ISN'T A SUBBLOCK. + ADD A,[1,,] ;LH HAS SUBBLOCK'S LEVEL. + HRRI A,(C) ;RH HAS SUBBLOCK. + PUSHJ P,BKSR1 ;HANDLE THE SUBBLOCK + MOVE A,BKTAB+1(C) ; RESTORE A (C IS PRESERVED OVER CALL) +BKSR3: ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKSR2 + MOVEI C,(A) ; RESTORE C INDEX BKSR1 WAS ENTERED WITH + TRNE LINK,DECSAV + POPJ P, + PUSH D,C ;PUT THE BLOCK IN BKTAB1 (AFTER SUBBLOCKS) + POPJ P, + +PPBCK: ROT B,1 ;OUTPUT WD IN A, UPDATING CKSUM IN B. + ADD B,A + JRST PPB + +;THE THIRD WORD OF EACH BLOCK'S ENTRY IN BKTAB GETS THE NUMBER OF +;SYMBOLS IN THAT BLOCK (OF THE SYMBOLS THAT WE WILL PUT IN THE SYMTAB). + +BKCNT: PUSH P,B + MOVEI C,0 +BKCNT0: SETZM BKTAB+2(C) ;ZERO 3RD WD OF EACH BKTAB ENTRY. + ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKCNT0 +BKCNT1: MOVE C,ST+2(B) + SOS BKTAB+2(C) ;ADD -2 FOR EACH SYM IN THE BLOCK. + SOS BKTAB+2(C) + ADD B,WPSTE1 + AOBJN B,BKCNT1 +POPBJ: POP P,B + POPJ P, + +SSRTX: HRLM B,(P) ;DO ONE PASS OF RADIX-EXCHANGE. SAVE END. + CAIL A,@WPSTEB ;ONLY 1 ENTRY, NOTHING TO DO. + JRST SSRTX7 + PUSH P,A ;SAVE START. +SSRTX3: XCT CH1 + JRST SSRTX4 ;MOVE UP TO 1ST WITH BIT ON. + SUB B,WPSTE + XCT C ;MOVE DOWN TO LAST WITH BIT OFF. + JRST SSRTX5 + MOVE D,WPSTE + CAIE D,MAXWPS + JRST .+4 +REPEAT MAXWPS,[ + MOVE D,.RPCNT(A) ;EXCHANGE THEM, + EXCH D,.RPCNT(B) + MOVEM D,.RPCNT(A)] +SSRTX4: ADD A,WPSTE +SSRTX5: CAME A,B ;ALL DONE => DO NEXT BIT. + JRST SSRTX3 ;MORE IN THIS PASS. + ROT CH2,-1 ;NEXT BIT DOWN. + POP P,A ;A -> START, B -> END OF 1ST HALF. + JUMPL CH2,SSRTX6 ;ALL BITS IN WD DONE, STOP. + PUSHJ P,(AA) ;DO NEXT BIT ON 1ST HALF. + HLRZ B,(P) ;A -> END OF 1ST HALF, B -> END OF ALL. + PUSHJ P,(AA) ;DO SECOND HALF. +SSRTX6: ROT CH2,1 ;LEAVE CH2 AS FOUND IT. +SSRTX7: HLRZ A,(P) ;LEAVE A -> END OF AREA SORTED. + POPJ P, + +;ARITHMETIC CONDITIONALS (B HAS JUMP A,) + +COND: PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,AGETFD ;GET FIELD TO TEST VALUE OF +CONDPP: POP P,T ;RESTORE CONDITIONAL JUMP INSTRUCTION + HRRI T,COND2 ;HRRI IN JUMP ADDRESS, GO TO COND2 IF CONDITIONAL TRUE + XCT T ;JUMP IF COND T,ASSEMBLE STRING +COND4: SETZM A.SUCC ;MOST RECENT CONDIT. FAILED. +COND5: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WHAT PSEUDO WE'RE IN. + CALL RCH + JSP D,RARL4 ;INIT FOR THE CONDITIONALIZED STUFF. + CAIA + CALL RARFLS ;READ AND IGNORE THE ARG. + JRST MACCR + +ANULL: TLO FF,FLUNRD + JRST COND5 + +;.ELSE, .ALSO - B'S LH WILL HAVE SKIPE OR SKIPN. +A.ELSE: HRRI B,A.SUCC + XCT B + JRST COND4 ;CONDITION FALSE. + JRST COND2 ;TRUE. + +;IF1, IF2 - B'S LH WILL HAVE TRNE FF, OR TRNN FF, +COND1: HRRI B,FRPSS2 + XCT B + JRST COND4 ;NO + ;CONDITION TRUE, ASSEMBLE STRING +COND2: SETOM A.SUCC ;LAST CONDITIONAL SUCCEEDED. +COND6: PUSHJ P,RCH ;GET NEXT CHAR + CAIE A,LBRKT + JRST [ CAIE A,LBRACE + TLO FF,FLUNRD + JRST MACCR] + SKIPN SCNDEP ;BRACKET TYPE CONDITIONAL. + SKIPE CONDEP + JRST COND7 + MOVEMM CONDLN,CLNN ;AT TOP LEVEL, SAVE IN CASE THIS UNTERMINATED + MOVEMM CONDPN,CPGN +IFN TS, MOVEMM CONDFI,INFFN1 +COND7: AOS SCNDEP ;COUNT IT FOR RBRAK'S SAKE. + JRST MACCR + +;IFB, IFNB + +SBCND: PUSH P,B ;SAVE TEST JUMP + SETZB B,C ;C COUNTS SQUOZE CHARS FOR IFB/IFNB + ;B COUNTS NONSQUOZE FOR IFSQ/IFNSQ + JSP D,RARG ;INIT FOR READING OF ARG WHOSE BLANKNESS + JRST CONDPP ;IS TO BE TESTED. + JSP D,RARGCH(T) ;READ 1 CHAR, + JRST CONDPP ;(NO MORE CHARS) + HLRZ A,GDTAB(A) ;GET GDTAB ENTRY + CAIE A,(POPJ P,) ;POPJ => NOT SQUOZE + AOJA C,RARGCH(T) + AOJA B,RARGCH(T) + + ;IFDEF, IFNDEF + +DEFCND: PUSH P,SYM + PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + PUSHJ P,ES + MOVEI A,0 ;UNDEFINED +IFN CREFSW,XCT CRFINU + CAIN A,GLOEXT_-14. ;GLOBAL EXIT... + SKIPL CONTRL ;DURING ABSOLUTE ASSEMBLY? + CAIN A,3 ;NO, LOCAL UNDEF? + MOVEI A,0 ;ONE OF THESE => UNDEF + REST SYM + EXCH SYM,(P) ;POP SYM OUT FROM UNDER THE CONDITIONAL JUMP. + JRST CONDPP + +;;PWRD ;ROUTINES TO OUTPUT ASSEMBLES WORDS AND PORTIONS THEREOF + + ;HERE FROM PBITS TO OUTPUT WORD OF CODE BITS + +PBITS3: PUSH P,A + MOVEI A,14 + MOVEM A,PBITS2 ;INITIALIZE PBITS2 FOR COUNTING DOWN THROUGH NEXT SET OF CODE BITS + MOVE A,[440300,,PBITS1] + MOVEM A,BITP ;SET UP BITP FOR RELOADING PBITS1 WITH CODE BITS + MOVE A,PBITS1 ;NOW GET ACCUMULATED WORD OF BITS + MOVEM A,@PBITS4 ;STORE IN BKBUF + AOS A,OPT1 ;RESERVE SPACE FOR NEW WORD + ;IF FRBIT7 SET (LAST CALL TO PBITS HAD 7) THEN NEXT WORD OF CODE BITS GOES + ;AFTER NEXT WORD OUTPUT (REALLY!), OTHERWISE BEFORE + TRNN FF,FRBIT7 + SOSA A + TRO FF,FRINVT + HRRZM A,PBITS4 + POP P,A + CLEARM PBITS1 + ;DROPS THROUGH + ;OUTPUT RELOCATION CODE BITS IN A + +PBITS: SKIPGE CONTRL + POPJ P, ;NOT RELOCATABLE + SOSGE PBITS2 + JRST PBITS3 ;NO MORE ROOM IN WORD, OUTPUT IT AND TRY AGAIN + CAIN A,7 + TROA FF,FRBIT7 + TRZ FF,FRBIT7 + IDPB A,BITP + POPJ P, + + ;FOLLOWING ROUTINES SAVE AC'S EXCEPT FOR A + +OUTSM0: MOVE A,SYM ;OUTPUT NAME STINK KNOWS SYMBOL BY. + TLZ A,37777 ;FOR LOCALS, THAT'S THE STE ADDR, + HRRI A,ST(D) + TLNN SYM,40000 ;FOR GLOBALS, THAT'S THE SQUOZE. + JRST $OUTPT +OUTSM: SKIPA A,SYM +OUTWD: MOVE A,WRD +$OUTPT: SKIPGE CONTRL ;DIRECTLY PUNCH OUT WORD IN A IN RELOCATABLE ASSEMBLY ONLY + POPJ P, ;DO NOTHING IF ABSOLUTE ASSEMBLY + PUSH P,AA + MOVE AA,OPT1 + TRZN FF,FRINVT ;SKIP IF BEING HACKED FROM PBITS3, PUT WORD BEFORE WHERE IT NORMALLY BELONGS + AOS AA + MOVEM A,-1(AA) + MOVE A,CLOC + TRZE FF,FRFIRWD + HRRM A,BKBUF + POP P,AA + AOS A,OPT1 + CAIL A,BSIZE+BKBUF + TRNE I,IRCONT + POPJ P, + ;MAY DROP THROUGH + +;END CURRENT OUTPUT BLOCK + +EBLK: PUSH P,T + PUSH P,TT + PUSH P,A + PUSH P,B + MOVE T,CONTRL + JUMPGE T,EBLK3 ;JUMP IF RELOCATABLE ASSEMBLY + TRNE T,ARIM10\SBLKS + JRST ESBLK + TRNE T,DECSAV + JRST EDSBLK +IFN FASLP,[ + TRNE T,FASL + JRST FASLE ;FASL HAS NO BLOCKS TO END - IGNORE +] + TRNE T,DECREL + JRST DECEBL + JRST EBLK5 + +EBLK3: MOVE T,PBITS1 + MOVEM T,@PBITS4 + MOVEI T,PBITS4 + MOVEM T,PBITS4 + MOVE T,[440300,,PBITS1] + MOVEM T,BITP + CLEARB TT,PBITS2 + CLEARM PBITS1 + MOVEI T,BKBUF + MOVE B,OPT1 ;GET POINTER TO END OF BLOCK + SUBI B,BKBUF+1 ;CONVERT TO # WORDS IN BLOCK (EXCLUDING HEADER) + DPB B,[220700,,BKBUF] ;SET COUNT FIELD IN HEADER + TRZN FF,FRLOC + JUMPLE B,EBLK5 ;IGNORE NULL BLOCK UNLESS FRLOC SET + TLO FF,$FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) + PUSHJ P,FEED +EBK1: CAML T,OPT1 ;DONE WITH BLOCK? + JRST EBK2 ;YES + MOVE A,(T) ;NO, GET DATA WORD + JFCL 4,.+1 ;UPDATE CHECKSUM + ADD TT,A + JFCL 4,[AOJA TT,.+1] + PUSHJ P,PPB ;OUTPUT WORD + AOJA T,EBK1 +EBK2: SETCM A,TT ;DONE OUTPUTTING BLOCK, NOW GET CHECKSUM + PUSHJ P,PPB ;OUTPUT CHECKSUM + MOVE T,CDATBC ;GET BLOCK TYPE + DPB T,[310700,,BKBUF] ;SET NE T BLOCK TYPE TO STORAGE WORDS BLOCK TYPE + MOVEI T,BKBUF+1 + MOVEM T,OPT1 +EBLK4: TLO FF,$FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) +EBLK5: TRO FF,FRFIRWD +FASLE: POP P,B + POP P,A +PTT.TJ: POP P,TT + POP P,T + POPJ P, + +;PUNCH OUT WORD OF CODED DATA (E.G. STORAGE WORD); WRD, WRDRLC, GLOTB ENTRIES + +PWRDA: TROA FF,FRNLIK ;SUPPRESS ADR LINKING +PWRD: TRZ FF,FRNLIK ;PERMIT ADR LINKING +IFN LISTSW,[ + SKIPN LSTONP + JRST PWRDL ;NOT MAKING LISTING NOW. + SKIPGE LISTPF + PUSHJ P,PNTR + SETOM LISTPF + MOVE LINK,WRD + MOVEM LINK,LISTWD + MOVE LINK,WRDRLC + MOVEM LINK,LSTRLC + MOVE LINK,CLOC + MOVEM LINK,LISTAD + MOVE LINK,CRLOC + DPB LINK,[220100,,LISTAD] +PWRDL: +] ;END IFN LISTSW, + JUMPGE FF,CPOPJ ;IGNORE IF NOT PUNCHING PASS + SKIPGE LINK,CONTRL + JRST PWRD1 ;ABSOLUTE ASSEMBLY + ;RELOCATABLE ASSEMBLY + PUSHJ P,$RSET ;CHECK VALIDITY OF RELOCATION, STANDARDIZE IF NON-STANDARD + MOVE A,GLSP2 + CAMN A,GLSP1 + JRST PWRD2 ;NO GLOBALS + + ;NOW TO SEE IF IT'S POSSIBLE OR DESIRABLE TO ADDRESS LINK + + HRLZ B,WRD + HRR B,WRDRLC + JUMPN B,PWRD3 ;JUMP IF RH NON-ZERO + TRNN FF,FRNLIK + SKIPGE GLOCTP + JRST PWRD3 ;ADR LINKING SUPPRESSED OR CLOC GLOBAL + SKIPE LDCCC + JRST PWRD3 ;IN LOAD TIME CONDITIONALS + MOVNI T,1 ;INITIALIZE T FOR COUNTING +PWRD4: CAML A,GLSP1 + JRST PWRD5 ;DONE + HRRZ TT,1(A) ;GET GLOTB ENTRY + JUMPE TT,PWRD7A + LDB TT,[400400,,(TT)] ;GET SQUOZE FLAGS FROM SYM + CAIE TT,DEFGVR_-14. + CAIN TT,GLOETY_-14. + JRST PWRD3 ;DEFINED, BUT MUST BE HERE FOR A REASON (SEE $.H) + HLRZ TT,1(A) + TRNE TT,1777+MINF + JRST PWRD3 ;NEGATED OR MULTIPLIED + TRNE TT,HFWDF + JRST PWRD7 + TRNE TT,ACF + TRNN TT,SWAPF + JRST PWRD3 ;NOT HIGH AC +PWRD7A: AOJA A,PWRD4 +PWRD7: TRNE TT,SWAPF + AOJA A,PWRD4 ;LEFT HALF + AOJN T,PWRD3 ;JUMP IF THIS NOT FIRST GLOBAL IN RIGHT HALF + MOVEI D,1(A) ;FIRST GLOBAL, SET UP POINTER TO GLOTB ENTRY + AOJA A,PWRD4 + +PWRD5: AOJE T,PWRD3 ;NO GLOBALS LOOK BAD AND THERE AREN'T TOO MANY; JUMP IF NONE IN RH + HRRZ T,(D) ;GET ADR OF SQUOZE + SKPST T, ;SKIP IF IN SYMBOL TABLE + JRST PWRD3 ;BELOW SYMBOL TABLE, DON'T ADDRESS LINK AFTER ALL + PUSH P,T ;HOORAY, WE CAN ADDRESS LINK + SETZM (D) ;CLEAR OUT GLOTB ENTRY, DON'T NEED IT ANY MORE + PUSHJ P,PWRD31 ;DUMP OUT THE OTHER GLOBALS + POP P,D ;GET ST ADR OF THIS AGAIN + 3GET1 A,D + LDB A,[.BP (3RLNK),A] + MOVE B,WRDRLC + TLNE B,1 + TRO A,2 ;RELOCATE LEFT HALF + PUSHJ P,PBITS ;PUNCH OUT APPROPRIATE BITS FOR LINK LIST ENTRY + HLR A,1(D) ;GET ADR OF LAST + HLL A,WRD + PUSHJ P,$OUTPT ;OUTPUT WORD WITH RH = ADR OF LAST RQ FOR SYM TO PUT IN RH'S + MOVE A,CLOC ;NOW UPDATE ST ENTRY + HRLM A,1(D) + 3GET1 B,D + SKIPN CRLOC + TLZA B,3RLNK ;CLOC NOT RELOCATED LAST TIME THIS SYM USED + TLO B,3RLNK ;RELOCATED + 3PUT1 B,D + POPJ P, + +PWRD31: MOVE T,GLSP2 ;DUMP ALL GLO S IN GENERAL FORMAT +PWRD3A: CAML T,GLSP1 + POPJ P, + MOVE B,1(T) + TRNN B,-1 + AOJA T,PWRD3A + TLNE B,1777 + JRST RPWRD ;REPEAT +RPWRD1: LDB A,[.BP (MINF),B] + TRO A,4 + PUSHJ P,PBITS + MOVE A,(B) ;CODEBITS +SQUOZE FOR SYM + HLRZ C,A + TLZ A,740000 + CAIL C,DEFGVR + TLOA A,40000 ;SYM IS GLO + JRST [ + MOVEI C,(B) ;IF WE ARE OUTPUTTING A REFERENCE TO THE + CAIL C,PCNTB ;"LABEL" AT THE BEGINNING OF A CONSTANTS AREA + CAIL C,PCNTB+NCONS*3 ;(BECAUSE THIS IS A 1PASS ASSEMBLY) USE THE + MOVEI A,(B) ;NAME, SINCE THE SYMBOL ISN'T IN THE + JRST .+1] ;SYMTAB + TLNE B,SWAPF + TLO A,400000 + TLNE B,ACF + JRST PWRD3E ;AC HIGH OR LOW + TLNN B,HFWDF + JRST PWRD3F ;ALL THROUGH + TLO A,100000 + TLNE B,SWAPF + TLC A,300000 +PWRD3F: PUSHJ P,$OUTPT + AOJA T,PWRD3A + + + +RPWRD: PUSHJ P,PBITS7 + MOVEI A,CRPT + PUSHJ P,PBITS + LDB A,[221200,,B] + PUSHJ P,$OUTPT + JRST RPWRD1 + +PWRD3E: TLO A,300000 + JRST PWRD3F + +PWRD3: PUSHJ P,PWRD31 +PWRD2: PUSHJ P,RCHKT + HRRZ A,B + DPB T,[10100,,A] + PUSHJ P,PBITS + JRST OUTWD + +;CHECK FOR VALIDITY OF RELOCATION BITS OF CURRENT WORD +;LEAVE RELOC (RH) IN B, RELOC (LH) IN T + +RCHKT: HRRZ B,WRDRLC ;CHECK FOR RELOC. OTHER THAN 0 OR 1. + HLRZ T,WRDRLC + TRZN B,-2 + TRZE T,-2 +RLCERR: ETSM [ASCIZ /Illegal relocation/] + POPJ P, + +RMOVET: ROT T,-1 + DPB B,[420100,,T] + TLZ C,3DFCLR ;SET RELOC BITS IN C + IOR C,T ;FROM B AND T. + POPJ P, + + ;CHECK WRDRLC FOR VALIDITY (CAPABILITY OF BEING PUNCHED OUT) + ;IF STANDARD THEN JUST RETURN + ;IF NON-STANDARD BUT OTHERWISE OK, PUT $R. ON GLOBAL LIST, RESET WRDRLC, AND RETURN + ;LEAVES B AND C SET UP WITH RH, LH OF WRDRLC. + +$RSET: MOVE C,WRDRLC ;GET RELOCATION + ADDI C,400000 ;WANT TO SEPARATE HALFWORDS + HLRE B,C ;GET LH IN B + HRREI C,400000(C) ;GET RH IN C (WILL EXCHANGE LATER) + MOVE A,[SWAPF+HFWDF,,$R.H] ;PUT THIS ON GLOBAL LIST IF LH NEEDS $R. + TRNE B,-2 ;CHECK LH + PUSHJ P,$RSET1 ;LH NEEDS GLOBAL REFERENCE + EXCH B,C + HRLI A,HFWDF + TRNE B,-2 ;CHECK RH + PUSHJ P,$RSET1 ;RH NEEDS GLOBAL REFERENCE + HRLZM C,WRDRLC ;RELOC OF LH + ADDM B,WRDRLC ;COMPLETE SETTING UP WRDRLC + POPJ P, + +$RSET1: JUMPGE B,$RSET2 ;STRANGE RELOCATION IN B, JUMP IF NON-NEGATIVE + MOVN T,B ;NEGATIVE, GET MAGNITUDE + TLOA A,MINF ;SET FLAG TO NEGATE GLOBAL +$RSET2: SOSA T,B ;POSITIVE, GET ONE LESS THAN IT IN T + TDZA B,B ;NEGATIVE, CLEAR B, RELOCATION LEFT OVER + MOVEI B,1 ;POSITIVE, SET RELOCATION LEFT OVER TO 1 + CAIN T,1 + MOVEI T,0 ;MULTIPLYING BY TWO OR SUBTRACTING TIMES 1 + TRNE T,-2000 + ETSM [ASCIZ /Relocation too large/] ;TOO BIG EVEN FOR $RSET + DPB T,[221200,,A] ;LOOKS OK, STORE TIMES FIELD IN $R. REFERENCE + AOS GLSP1 ;NOW PUT $R. ON GLOBAL LIST + MOVEM A,@GLSP1 + POPJ P, + +;PWRD DURING ABSOLUTE ASSEMBLY + +PWRD1: TRNE LINK,DECREL ; DEC REL FMT IS CONSIDERED ABSOLUTE. + JRST DECPW +IFN FASLP,[ + TRNE LINK,FASL + JRST FASPW ;SO IS FASL +] + MOVE A,GLSP1 + CAME A,GLSP2 + ETR ERRILG ;GLOBALS APPEARING ILLEGALLY + SKIPE WRDRLC + ETR ERRIRL ;RELOCATION APPEARING ILLEGALLY + TRNE LINK,ARIM + JRST PRIM ;RIM + TRNE LINK,DECSAV + JRST DSBLK1 +SBLKS1: MOVE A,WRD ;SBLK + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FRFIRWD + MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER + AOS A,OPT1 + CAIGE A,BKBUF+BSIZE + POPJ P, ;BKBUF NOT FULL YET + +SBLKS2: SUBI A,BKBUF+1 + JUMPE A,CPOPJ + MOVNS A + HRLM A,BKBUF + PUSHJ P,FEED + MOVEI T,BKBUF + CLEARM SCKSUM +SBLK1: CAML T,OPT1 + JRST SBLK2 + MOVE A,SCKSUM + ROT A,1 + ADD A,(T) + MOVEM A,SCKSUM + MOVE A,(T) + PUSHJ P,PPB + AOJA T,SBLK1 + +SBLK2: TRO FF,FRFIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,SCKSUM + JRST PPB + +ESBLK: MOVE A,OPT1 + CAIN A,BKBUF+1 + JRST EBLK5 ;AVOID SETTING $FLOUT IF NULL BLOCK. + PUSHJ P,SBLKS2 + JRST EBLK4 + +PRIM: MOVSI A,(DATAI PTR,) + HRR A,CLOC + PUSHJ P,PPB + MOVE A,WRD + JRST PPB + +; COME HERE TO OUTPUT WD IN ABSOLUTE DEC FMT (DECSAV) + +DSBLK1: MOVE A,WRD + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FRFIRWD + MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER + AOS A,OPT1 + CAIGE A,BKBUF+BSIZE + POPJ P, ;BKBUF NOT FULL YET, RETURN + +DSBLK2: SUBI A,BKBUF+1 + JUMPE A,CPOPJ + MOVNS A + SOS BKBUF ; DEC "IOWD" FMT, POINT AT LOC-1 + HRLM A,BKBUF + PUSHJ P,FEED + MOVEI T,BKBUF +DSBLK3: CAML T,OPT1 + JRST DSBLK4 + MOVE A,(T) + PUSHJ P,PPB + AOJA T,DSBLK3 + +DSBLK4: TRO FF,FRFIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + POPJ P, + +; END A BLOCK IN DEC SAV FMT, COME HERE FROM EBLK. + +EDSBLK: MOVE A,OPT1 + CAIN A,BKBUF+1 + JRST EBLK5 ;AVOID SETTING $FLOUT IF NULL BLOCK. + PUSHJ P,DSBLK2 + JRST EBLK4 + + +;END A BLOCK IN DEC FMT. COME FROM EBLK. +DECEBL: PUSH P,[EBLK5] +DECEB1: MOVSI A,DECWDS ;JUST INIT. AN ORDINARY BLOCK, + +;COME HERE TO OUTPUT PREVIOUS BLOCK AND START NEW BLOCK OF TYPE IN LH OF A. +DECBLK: PUSH P,A + HRRZ A,BKBUF ;GET DATA-WORD COUNT OF CURRENT BLOCK. + JUMPE A,DECB1 ;NO WORDS => CAN IGNORE. + MOVEI TT,BKBUF+1 +DECB0: MOVE A,-1(TT) ;GET AND PUNCH NEXT WD OF BLOCK. + PUSHJ P,PPB + CAME TT,OPT1 ;STOP WHEN NEXT WD ISN'T IN BLOCK. + AOJA TT,DECB0 +DECB1: POP P,A + HLLZM A,BKBUF ;PUT BLOCK TYPE IN LH OF HEADER, DATA WD COUNT IN RH IS 0. + MOVEI TT,BKBUF+2 ;ADDR OF PLACE FOR 1ST DATA WD + MOVEM TT,OPT1 ;(LEAVE SPACE FOR WD OF RELOC BITS) + MOVE TT,[440200,,BKBUF+1] + MOVEM TT,BITP ;BP FOR STORING PAIRS OF RELOC BITS. + SETZM BKBUF+1 ;CLEAR THE WD OF RELOC BITS. + TLO FF,$FLOUT + POPJ P, + +;COME HERE TO OUTPUT A WORD IN DEC FORMAT. +DECPW: MOVS A,BKBUF + CAIE A,DECWDS ;BEFORE THE 1ST STORAGE WD IN ORDINARY BLOCK, + JRST DECPW0 + MOVE A,CRLOC ;MUST GO THE LOCATION CTR. + IDPB A,BITP + MOVE A,CLOC + MOVEM A,@OPT1 + AOS OPT1 + AOS BKBUF ;IT COUNTS AS DATA WORD. +DECPW0: MOVE A,BITP + TLNE A,77^4 ;IF NO ROOM FOR MORE RELOC BITS, + JRST DECPW1 + HLLZ A,BKBUF ;START A NEW BLOCK. + PUSHJ P,DECBLK + JRST DECPW + +DECPW1: PUSHJ P,$RSET ;SET UP RELOC BITS OF HALVES IN B,C. + LSH C,1 + IORI B,(C) ;COMBINE THEM. + MOVE A,GLSP1 + CAME A,GLSP2 + JRST DECPG ;GO HANDLE GLOBALS. +DECPW3: IDPB B,BITP ;STORE THE RELOC BITS + MOVE A,WRD +DECPW2: MOVEM A,@OPT1 ;AND THE VALUE. + AOS OPT1 + AOS BKBUF + POPJ P, + +;PUT A WORD DIRECTLY INTO DEC FMT BLOCK. +DECWRD: SETZ TM, +DECWR1: IDPB TM,BITP ;SKIP A PAIR OF RELOC BITS, + JRST DECPW2 ;STORE THE WORD. + +;HANDLE GLOBAL REFS IN DEC FMT. +DECPG: PUSHJ P,DECPW3 ;FIRST, OUTPUT THE WORD, +DECPG0: MOVSI A,DECSYM + PUSHJ P,DECBLK ;THEN STRT A SYMBOLS BLOCK. + MOVE C,GLSP2 + PUSH P,SYM +DECPG1: CAMN C,GLSP1 ;ALL DONE => + JRST DECPG2 ;GO START AN ORDINARY BLOCK FOR NEXT WD. + MOVE A,BITP + TLNN A,77^4 ;BLOCK FULL => START ANOTHER. + JRST DECPG0 + AOS C,GLSP2 ;GET ADDR OF NEXT GLOBAL REF. + MOVE B,(C) + MOVE B,(B) ;GET NAME OF SYM. + TLZ B,740000 + CAMN B,[SQUOZE 0,$R.] + JRST DECPG3 ;(DEC'S LOADER HAS NO SUCH HACK.) + CALL ASQOZR ;RIGHT-JUSTIFY THE SQUOZE FOR DEC SYSTEM. + MOVE A,B + TLO A,600000 ;PUT IN FLAGS SAYING ADDITIVE GLOBAL RQ. + PUSHJ P,DECWRD ;OUTPUT NAME. + HRRZ A,CLOC ;GET ADDR OF RQ, + TLO A,400000 ;MACRO-10 SETS THIS BIT SO I WILL. + MOVE B,(C) + TLNE B,SWAPF ;SWAPPED => TELL LOADER.. + TLO A,200000 + TLNE B,ACF+MINF + ETSM ERRILG ;CAN'T NEGATE GLOBAL OR PUT IN AC. + MOVE TM,CRLOC + PUSHJ P,DECWR1 ;OUTPUT 2ND WD, + JRST DECPG1 ;GO BACK FOR MORE GLOBAL REFS. + +DECPG2: REST SYM + JRST DECEB1 + +DECPG3: ETR ERRIRL ;WE NEEDED $R. BUT DIDN'T HAVE IT. + JRST DECPG1 + +ERRILG: ASCIZ /Illegal use of external/ +ERRIRL: ASCIZ /Illegal use of relocatables/ + + +;OUTPUT PROGRAM NAME BLOCK (AT START OF PASS 2) +;IF 2-SEG PROGRAM, ALSO OUTPUT A TYPE-3 BLOCK (LOAD INTO HISEG) +DECPGN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2. + PUSH P,[EBLK] + MOVSI A,DECNAM + CALL DECBLK + MOVE B,PRGNM + CALL ASQOZR + MOVE A,B + CALL DECWRD + MOVSI A,14 ;IDENTIFY THIS REL FILE AS MADE BY MIDAS. + CALL DECWRD + MOVE A,DECTWO + CAMN A,[MOVE] + RET ;NOT A 2-SEG PROGRAM. +DECP2S: MOVSI A,DECHSG + CALL DECBLK ;START A LOAD-INTO-HISEG BLOCK. + MOVE A,DECTWO + HRL A,DECBRH ;HISEG BRK,,TWOSEG ORIGIN. + SKIPL A + HRLI A,(A) + MOVEI TM,1 ;RELOCATION IS 1. + JRST DECWR1 + +IFN FASLP,[ +;INITIALIZE OUTPUT FOR FASL ASSEMBLY +FASOIN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2 + MOVE A,[SIXBIT /*FASL*/] + PUSHJ P,PPB + MOVE A,[MIDVRS] + LSH A,-6 + TLO A,(SIXBIT /M/) + PUSHJ P,PPB ;"LISP" VERSION NUMBER (USE M AND MIDAS NUMBER) + MOVE A,[440400,,FASB] ;INITIALIZE FASL OUTPUT BUFFER + MOVEM A,FASCBP + MOVEI A,FASB+1 + MOVEM A,FASBP + POPJ P, + + +;COME HERE TO OUTPUT A WORD IN FASL FORMAT +FASPW: MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;"PUNCH" OUT ATOM TBL (IF MORE HAS APPEARED) + PUSHJ P,$RSET ;GET RELOC + PUSH P,C ;SAVE LH RELOC + MOVEM B,FASPWB ;B HAS RELOC, WHICH IS ALSO FASL CODE FOR RELOC =1 + MOVE A,GLSP2 +FASPW3: CAME A,GLSP1 + JRST FASPW1 ;LOOK TO SEE .. +FASPW2: MOVE A,WRD ;B HAS RELOC, WHICH ALSO HAPPENS TO BE FASL CODE TYPE + MOVE B,FASPWB + PUSHJ P,FASO ;OUTPUT WORD IN A WITH FASL CODE IN B + POP P,TM + JUMPE TM,FASPW5 ;NO LEFT HALF RELOC, OK + MOVNI A,1 ;ACTIVATE FASL HACK FOR LH RELOC + MOVEI B,7 ;WOULD OTHERWISE BE GETDDTSYM + PUSHJ P,FASO +FASPW5: MOVE C,GLSP2 +FASPW6: CAMN C,GLSP1 + POPJ P, + HRRZ TM,1(C) + JUMPE TM,[AOJA C,FASPW6] + MOVE SYM,(TM) ;GET SQUOZE OF SYM + TLZ SYM,740000 ;CLEAR CODE BITS + HLRZ D,1(C) + TRZ D,400000 ;DONT WORRY ABOUT THAT BIT + TRZE D,MINF + TLO SYM,400000 ;NEGATE + CAIN D,SWAPF + JRST FSPWSW + CAIN D,HFWDF + JRST FSPWRH + CAIN D,ACF+SWAPF + JRST FSPWAC + JUMPE D,FSPWWD + ETSM [ASCIZ /Global in illegal FASL context/] + +FSPWWD: TLOA SYM,140000 +FSPWAC: TLOA SYM,100000 +FSPWRH: TLO SYM,40000 +FSPWSW: MOVE A,SYM + MOVEI B,7 ;DDT SYM + PUSHJ P,FASO + AOJA C,FASPW6 + +FASPW1: HRRZ TM,1(A) ;GLOTB ENTRY + JUMPE TM,FASPW4 + CAIL TM,AFDMY1 + CAIL TM,AFDMY2 +FASPW4: AOJA A,FASPW3 + MOVE C,1(A) ;ITS A LIST STRUCTURE REF + TLNN C,-1-HFWDF + SKIPE FASPWB + ETA [ASCIZ /Illegal LISP structure reference/] + MOVE TM,AFDMY2-AFDMY1(TM) ;GET FASL BITS + MOVEM TM,FASPWB ;FASL BITS + CLEARM 1(A) ;FLUSH THAT GUY + AOJA A,FASPW3 + +FPATB: CAMN C,FASATP ;PUNCH OUT ATOM TBL, AMT ALREADY PUNCHED IN C + POPJ P, ;THRU + MOVEI B,12 ;ATOM TBL INFO + MOVE A,FASAT(C) + TRNN A,-1 + AOJA C,FPATB3 ;LIST WORD .. SHOULD HAVE PUNCHED ITSELF + PUSHJ P,FASO + HRRZ D,FASAT(C) ;ATOM "LENGTH" + AOS C +FPATB1: SOJL D,FPATB2 + MOVE A,FASAT(C) + PUSHJ P,FASO1 + AOJA C,FPATB1 + +FPATB3: ETR [ASCIZ /Internal loss at FPATB3/] +FPATB2: MOVEM C,FASPCH ;RECORD AMOUNT PUNCHED + JRST FPATB ;LOOP BACK IF MORE + + +FASO: PUSHJ P,FASBO ;WRITE BITS +FASO1: MOVEM A,@FASBP ;STORE A IN FASL OUTPUT BUFFER + AOS TM,FASBP + CAIL TM,FASB+FASBL + ETF [ASCIZ /.FASL output block too long/] + POPJ P, + +FASBO: MOVE TM,FASCBP ;OUTPUT FASL CODEBITS IN B, WRITE PREV BLOCK IF NECC + TLNN TM,770000 + PUSHJ P,FASBE ;WRITE PREV FASL BLOCK + IDPB B,FASCBP + POPJ P, + +FASBE: PUSH P,A + PUSH P,B + MOVEI TT,FASB +FASBO2: CAML TT,FASBP + JRST FASBO3 + MOVE A,(TT) + PUSHJ P,PPB + AOJA TT,FASBO2 + +FASBO3: POP P,B + POP P,A + CLEARM FASB ;NEW CODE WORD + MOVEI TM,FASB+1 + MOVEM TM,FASBP + SOS FASCBP + POPJ P, + +AFATOM: PUSH P,B ;SAVE CODEBITS + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ATOM illegal except in FASL assembly/] + PUSHJ P,AFRATM ;READ "ATOM", RETURN INDEX IN A + POP P,B + HLRZS B +AFLST1: AOS GLSP1 + MOVEI T,AFDMY1(B) ;DUMMY (STORE THIS INFO IN SYM SO CONSTANTS WILL WIN + HRRZM T,@GLSP1 + MOVEI B,0 ;NO RELOCATION + POPJ P, + +;GLOBALS IN THIS TABLE KEEP TRACK OF LIST REFS +;UNDEF GLOBAL GODEBITS +AFDMY1: SQUOZE 44,.%VCEL ;EVENTUALLY POINT TO VALUE CELL + SQUOZE 44,.%SCAL ;EVENTUALLY BECOME "SMASHABLE CALL" + SQUOZE 44,.%ATM ;EVENTUALLY POINT TO ATOM + SQUOZE 44,.%ARY ;EVENTUALLY POINT TO ARRAY +AFDMY2: 2 ;CODE BITS FOR VALUE CELL REF + 3 ;CODE BITS FOR SMASHABLE CALL + 4 ;CODE BITS FOR POINTER TO ATOM + 10 ;CODE BITS FOR POINTER TO ARRAY + +AFRATM: PUSHJ P,AFRTKN ;READ TOKEN, LEAVING IT AT END OF FASAT + PUSHJ P,AFRITN ;"INTERN" IT, SKIP IF NOT FOUND + POPJ P, ;IF FOUND, INDEX IN A + PUSHJ P,AFRENT ;ENTER IN FASAT + POPJ P, + +AFRENT: MOVE A,FASAT1 ;STORE FASAT1 IN FASATP + MOVEM A,FASATP + AOS A,FASIDX ;RETURN LOAD TIME ATOM INDEX + POPJ P, + +AFRTKN: MOVE A,FASATP + ADD A,[700,,FASAT] + MOVEM A,FASAT2 ;BYTE PNTR TO USE TO STORE ATOM + CLEARM (A) + CLEARM 1(A) ;MAKE SURE ALL LOW BITS CLEARED + PUSHJ P,RCH + CAIN A,"# + JRST AFRTK1 ;READ NUMBER INTO FIXNUM SPACE + CAIN A,"& + JRST AFRTK2 ;READ NUMBER INTO FLONUM SPACE +AFRTKL: IDPB A,FASAT2 ;STORE CHAR + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 +AFTERR: ETA [ASCIZ /LISP atom name table full/] + CLEARM 1(A) +AFRTL2: PUSHJ P,RCH + CAIN A,12 + JRST AFRTL2 ;IGNORE LF IN ATOM NAMES (PRIMARILY SO /CR WINS WITH ONE + CAIN A,"/ ;SLASH + JRST AFRQT ;QUOTE CHAR + CAIE A,40 + CAIN A,15 + JRST AFREND + CAIE A,"; + CAIN A,11 + JRST AFREND + CAIE A,"( + CAIN A,") + JRST AFREN2 + CAIL A,"A+40 + CAILE A,"Z+40 + JRST AFRTKL ;THAT CHAR WINS, SALT IT + SUBI A,40 + JRST AFRTKL ;MAYBE MUST CONVERT TO L.C. BEFORE SALTING IT. + +AFRQT: PUSHJ P,RCH ;TAKE NEXT CHR NO MATTER WHAT + JRST AFRTKL + +AFRTK1: SKIPA TM,[100000,,1] ;PUT VAL IN FIXNUM SPACE +AFRTK2: MOVE TM,[200000,,1] ;PUT IT IN FLONUM SPACE + PUSH P,TM + MOVE SYM,[SQUOZE 0,ATOM] + PUSHJ P,FAGTFD + POP P,TM + MOVE B,FASATP + ADDI B,2 + CAIL B,FASAT+FASATL + XCT AFTERR + MOVEM TM,FASAT-2(B) + MOVEM A,FASAT-1(B) + MOVEM B,FASAT1 + POPJ P, + +AFREN2: TLO FF,FLUNRD ;SAVE ( OR ) AS WELL AS FLUSHING +AFREND: MOVEI B,5 ;PAD END OF P.N. WITH 0 S + MOVEI TM,0 +AFREN1: IDPB TM,FASAT2 + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 + XCT AFTERR + CLEARM 1(A) + SOJG B,AFREN1 + SUBI A,FASAT + MOVEM A,FASAT1 ;STORE PNTR TO WORD BEYOND ATOM + ; MAYBE PUT THIS IN FASATP + MOVE B,FASATP ;ADR OF START OF ATOM READ + SUBI A,1(B) ;COMPUTE LENGTH OF FASAT + HRRZM A,FASAT(B) ;PN ATOM 4.8-4.7 =0 STORE LENGTH IN HEADER WD + + POPJ P, + +AFRITN: MOVEI B,0 ;"INTERN" LAST ATOM READ IN + MOVEI A,1 ;A CONTAINS RUNTIME ATOM TBL INDEX + ;B INDEX WITHIN FASAT +AFRIT1: CAML B,FASATP + JRST POPJ1 ;NOT FOUND + MOVE C,FASATP ;POINTS AT HEADER OF WORD OF NEW (?) ATOM + HRRZ D,FASAT(B) ;HEADER WD OF GUY IN TBL(RIGHT HALF HAS LENGTH) + JUMPE D,AFRIT4 ;JUMP ON RESERVED FOR LIST +AFRIT2: MOVE TM,FASAT(C) + CAME TM,FASAT(B) + AOJA B,AFRIT3 ;THIS ONE LOSES + SOJL D,CPOPJ ;THIS ONE WINS! + AOS B + AOJA C,AFRIT2 + +AFRIT3: SOJL D,[AOJA A,AFRIT1] ;FINISH SPACING OVER THIS GUY +AFRIT4: AOJA B,AFRIT3 + +AFENTY: SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ENTRY in NON-FASL/] + SKIPN CRLOC + ETI [ASCIZ /.ENTRY when . is absolute/] + PUSHJ P,AFRATM ;READ FUNCTION NAME + HRLZS A + PUSH P,A + PUSHJ P,AFRATM ;READ TYPE (SUBR, LSUBR, ETC) + HRRM A,(P) + MOVE SYM,[SQUOZE 0,.ENTRY] + PUSHJ P,FAGTFD ;READ ARGS PROP + JUMPGE FF,ASSEM1 ;NOT PUNCHING PASS + PUSH P,A + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ANY NEW ATOMS OUT + POP P,C + POP P,A + MOVEI B,13 + PUSHJ P,FASO + HRL A,C + HRR A,CLOC + PUSHJ P,FASO1 + JRST ASSEM1 + +AFLIST: HLRZM B,AFLTYP + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.LIST illegal except in FASL assembly/] + PUSHJ P,AFRLST ;READ LIST, RTN ATM TBL INDEX IN A + SKIPN AFLTYP + JRST ASSEM1 ;JUST EVAL IN LISP AND THROW AWAY VALUE + MOVEI B,AFDMAI ;"ATOM" INDEX IN AFDMY1 TBL + JRST AFLST1 ;TREAT AS ATOM + +AFRLST: CLEARM AFRLD ;"DEPTH" + CLEARM AFRLEN ;"LENGTH" OF LIST AT CURRENT LEVEL + CLEARM AFRDTF ;DOT CONTEXT FLAG + JUMPGE FF,AFRLI1 + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ALL ATOMS "PUNCHED" + MOVE A,FASATP + MOVEM A,AFRFTP ;SAVED STATE OF FASAT POINTER + MOVE C,AFLTYP + MOVEI B,16 ;EVAL TYPE HACK + CAIN C,1 + MOVEI B,5 ;LIST TYPE HACK + PUSHJ P,FASBO ;WRITE CODE BITS +AFRLI1: +AFRL1: PUSHJ P,RCH + CAIE A,40 ;PREV ATOM (OR WHATEVER) "DELIMITED", SO THESE MEANINGLESS + CAIN A,15 ;UNLESS AT TOP LEVEL AND HAVE READ SOMETHING + JRST AFRL1A + CAIE A,11 + CAIN A,12 + JRST AFRL1A + CAIN A,"( + JRST AFRLO + CAIN A,") + JRST AFRLC + CAIN A,". + JRST AFRDT ;DOT.. + TLO FF,FLUNRD + SKIPE AFRLD + JRST AFRNXT ;READ NEXT GUY THIS LVL + SKIPE AFRLEN +AFRLO2: ETI [ASCIZ /LISP read context error/] +AFRNXT: SKIPN TM,AFRDTF + JRST AFRNX2 ;NOT HACKING DOTS, OK + AOS TM,AFRDTF + CAIE TM,2 + JRST AFRLO2 ;DIDNT JUST SEE THE DOT +AFRNX2: PUSHJ P,AFRATM + JUMPGE FF,AFRNX1 ;XFER ON NOT PUNCHING PASS + PUSHJ P,FASO1 ;TELL LOADER TO PUSH THIS ON ITS STACK +AFRNX1: AOS AFRLEN ;LIST NOW ONE LONGER THIS LVL + JRST AFRL1 + +AFRLO: SKIPN TM,AFRDTF + JRST AFRLO3 ;NOT HACKING DOTS + SOJN TM,AFRLO2 + CLEARM AFRDTF + JRST AFRL1 ;IGNORE BOTH . AND ( + +AFRLO3: SKIPE AFRLD ;( + JRST AFRLO1 + SKIPE AFRLEN + JRST AFRLO2 +AFRLO1: PUSH P,AFRLEN + CLEARM AFRLEN ;START NEW LVL + AOS AFRLD ;DEPTH NOW ONE GREATER + JRST AFRL1 + +AFRLC: SOSGE AFRLD ;) + JRST AFRLO2 ;AT TOP LEVEL, BARF + MOVE A,AFRLEN + SKIPN TM,AFRDTF + JRST AFRLC2 ;NOT HACKING DOTS + CAIE TM,2 + JRST AFRLO2 + SOS A ;MAIN LIST NOW ONE SHORTER + TLOA A,200000 ;DOT WITH LAST THING ON STACK +AFRLC2: TLO A,100000 ;TELL LOADER TO MAKE LIST THIS LONG + JUMPGE FF,AFRLC5 + PUSHJ P,FASO1 +AFRLC5: POP P,AFRLEN ;LENGTH AT PREV LVL + AOS AFRLEN ;NOW ONE MORE + CLEARM AFRDTF ;NOT HACKING DOTS NOW + SKIPE AFRLD ;RETURNING TO TOP LEVEL? + JRST AFRL1 + JRST AFRX1 ;YES THRU + +AFRDT: SKIPN AFRDTF + SKIPN AFRLEN + JRST AFRLO2 ;DOT IN FIRST POSITION OF LIST + AOS AFRDTF ;ENTER STATE 1 OF DOT HACKING + JRST AFRL1 + +AFRL1A: SKIPN AFRLD ;SPACER CHAR TERMINATES AT TOP LVL IF HAVE RD SOMETHING + SKIPN AFRLEN + JRST AFRL1 +AFRX1: JUMPGE FF,AFRX2 ;NOT PUNCHING PASS + MOVE A,AFRFTP + CAME A,FASATP + ETR [ASCIZ /Saw atoms in list on pass 2 for first time/] + SKIPN B,AFLTYP ;TYP LIST OP + SKIPA A,[-1,,] + MOVSI A,-2 ;PUT LIST OR VALUE OF LIST IN ATOM TBL + PUSHJ P,FASO1 ;TERM OP AND PUT IT IN ATOM TBL + MOVEI A,0 + MOVE B,AFLTYP + JUMPE B,CPOPJ ;JUST WANT VALUE OF LIST + CAIN B,1 ;ONLY WANT THIS FOR STRAIGHT LIST + PUSHJ P,FASO1 ;OUTPUT "SXHASH" WORD + AOS A,FASATP + CLEARM FASAT-1(A) ;RESERVE SLOT IN FASAT TBL + MOVEM A,FASPCH ;SAY ALREADY PUNCHED OUT + AOS A,FASIDX + POPJ P, + +AFRX2: TLO I,ILNOPT ;DONT TRY TO OPTIMIZE IF IN CONSTANT + CLEARB A,B + POPJ P, +] + +;.LIBRA, .LIFS, ETC. + +A.LIB: NOVAL ? NOABS + HLRZM B,LIBTYP' ;STORE BLOCK TYPE TO OUTPUT + CLEARM LIBOP ;INITIALIZE SQUOZE FLAGS + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK, MAKING SURE LOADER KNOWS $. +LIB1: PUSHJ P,GETSYL ;GET NAME + TRNN I,IRSYL + JRST LIB2 ;NO SYL, DON'T OUTPUT + IOR SYM,LIBOP + TLO SYM,40000 + PUSHJ P,OUTSM + MOVSI A,400000 + ANDCAM A,LIBOP +LIB2: MOVE B,CDISP ;GET CDISP + TLNN B,DWRD\DFLD ;CHECK FOR WORD TERMINATOR + JRST LIB3 ;WORD TERMINATOR => DONE + MOVE A,LIBOP + MOVE B,LIMBO1 ;RETRIEVE LAST CHAR READ + CAIN B,", + MOVSI A,400000 + CAIN B,"+ + TLZ A,200000 + CAIN B,"- + TLO A,200000 + MOVEM A,LIBOP' ;STORE SQUOZE FLAGS (LESS GLBL BIT) FOR NEXT SYM + JRST LIB1 + +LIB3: MOVE A,LIBTYP ;GET BLOCK TYPE TO OUTPUT + DPB A,[310700,,BKBUF] + PUSHJ P,EBLK + CAIN A,LLIB ;.LIBRA? + JRST ARELC1 ;.LIBRA, NOW PLAY LIKE RELOCA PSEUDO + JRST LIB5 ;SOMETHING ELSE (.LIFS), INCREMENT DEPTH IN LOAD TIME CONDITIONALS + +A.ELDC: NOVAL ? NOABS + PUSHJ P,EBLK + MOVEI A,ELTCB + DPB A,[310700,,BKBUF] + TRO FF,FRLOC ;MAKE EBLK OUTPUT NULL BLOCK + PUSHJ P,EBLK + SOSGE LDCCC + CLEARM LDCCC ;LOADER CONDITIONAL UNDERFLOW + JRST ASSEM1 + + ;LOADER CONDITIONAL ON VALUE + +A.LDCV: NOVAL ? NOABS + LSH B,-27. + PUSH P,B + PUSHJ P,AGETWD + POP P,B + DPB B,[400300,,BKBUF] + MOVEI A,LDCV + PUSHJ P,PLDCM + MOVEI A,0 + DPB A,[400300,,BKBUF] +LIB5: AOS LDCCC +CCASM1: JRST ASSEM1 + +;.GLOBAL, .SCALAR, .VECTOR +;LH(B) HAS ILGLI, ILVAR, ILVAR+ILFLO RESPECTIVELY. +; Note that use of ILFLO flag is a crock here. + +A.GLOB: NOVAL + HLLZ LINK,B ;REMEMBER WHICH OF THE THREE PSEUDO'S THIS IS. +A.GLO2: MOVE A,GLSPAS + MOVEM A,GLSP1 + SETOM FLDCNT + PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO NAME => DONE + CALL ES + JRST A.GLO1 + CAIE A,PSUDO_-14. + JRST A.GLO1 + JSP B,GVPSEU ;TRYING TO .GLOBAL A PSEUDO => TYPE APPRO. ERR MSG AND RETURN. + JRST A.GLO2 ;DON'T DO ANYTHING TO IT; MOVE ON TO NEXT ARG. + +A.GLO1: IOR I,LINK ;SET THE GLOBAL FLAG OR THE VARIABLE FLAG. + TLNE LINK,ILVAR ;FOR .VECTOR OR .SCALAR, SAVE # VARS CREATED BEFORE CREATING THIS ONE. + PUSH P,VARCNT ;SO WE CAN TELL IF THIS CALL TO GETVAL ACTUALY CREATES IT. + PUSHJ P,GETVAL ;NOW GET VALUE (CLOBBERS SQUOZE FLAGS) + CAIA + HALT + TLNN LINK,ILVAR ; THAT'S IT IF .GLOBAL, ELSE CONTINUE + JRST A.GLO2 + PUSH P,LINK ;.VECTOR OR .SCALAR, MUST READ THE SIZE. + TLO FF,FLUNRD ;RE-READ THE TERMINATOR AFTER THE SYM, SO "FOO(1)" AND "FOO," WIN + MOVE SYM,[SQUOZE 0,.SCALAR] + TLNE LINK,ILFLO ; USE RIGHT SYM + MOVE SYM,[SQUOZE 0,.VECTOR] + CALL AGETFD + REST LINK + REST B ;GET PREV. VARCNT, SO WE CAN SEE IF IT WAS INCREMENTED. + TRNN A,-1 ;MAKE (N) WORK AS SIZE BY USIN L.H. IF R.H. IS 0. + HLRZS A + JUMPN A,A.GLO3 ;JUMP IF NONZERO SIZE SPEC'D + TLNN LINK,ILFLO ; ZERO, USE DEFAULT + JRST A.GLO2 ; WHICH IS ALWAYS 1 FOR .SCALAR + SKIPA A,VECSIZ ; AND VECSIZ FOR .VECTOR. +A.GLO3: TLNE LINK,ILFLO ;NONZERO SIZE, SO + MOVEM A,VECSIZ ;DEFAULT MUST BE REMEMBERED FOR .VECTOR. + SUBI A,1 ;1 WORD WAS ALLOCATED BY GETVAL - HOW MANY MORE WANTED? + CAME B,VARCNT ;(MAYBE SYM ALREADY DEFINED, MAYBE PASS2, ...) + ADDM A,VARCNT ;IF GETVAL REALLY ALLOCATED THE SPACE THIS TIME, ALLOCATE THE + JRST A.GLO2 ;RIGHT AMOUNT. + + ;.LOP + +A.LOP: NOVAL ? NOABS + PUSHJ P,EBLK ;TERMINATE CURRENT BLOCK + REPEAT 3,PUSHJ P,RGETFD ;GET THE FIELDS + MOVEI A,LD.OP + PUSHJ P,PLDCN + JRST ASSEM1 + + ;.LIBRQ + +A.LIBRQ: NOVAL ? NOABS +A.LBR1: PUSHJ P,GETSLD + JRST MACCR + PUSHJ P,PBITS7 + MOVEI A,3 + PUSHJ P,PBITS + TLO SYM,40000 + PUSHJ P,OUTSM + JRST A.LBR1 + +A.LNKOT: AOS (P) ;THIS PSEUDO RETURNS NO VALUE. + NOVAL + +AEND5: JUMPGE FF,CPOPJ ;IGNORE FOLLOWING ON NOT PUNCHING PASS + MOVE D,SYMAOB +AEND5A: MOVE SYM,ST(D) + LDB T,[400400,,SYM] + CAIE T,DEFLVR_-14. + CAIN T,DEFGVR_-14. + JRST AEND5E + CAIE T,LCUDF_-14. + CAIN T,GLOEXT_-14. + JRST AEND5B +AEND5C: ADD D,WPSTE1 + AOBJN D,AEND5A + POPJ P, + +AEND5E: 3GET C,D + TLNN C,3LLV + JRST AEND5C +AEND5B: HLLZ B,ST+1(D) + 3GET C,D + TLNN C,3RLNK + JUMPE B,AEND5C + TLZ SYM,740000 + CAIE T,LCUDF_-14. + CAIN T,DEFLVR_-14. + SKIPA + TLO SYM,40000 + PUSHJ P,LKPNRO + HRRZS ST+1(D) ;CLEAR OUT LIST HEAD POINTER. + TLZ C,3RLNK ;INDICATE NO LIST. + 3PUT C,D + JRST AEND5C + + ;PUNCH OUT COMPLETE LOADER COMMAND, PUNCHING OUT WRD AS ONLY CONTENTS + +PLDCM: PUSH P,LINK ;SAVE LINK FOR ALOC AND FRIENDS (CLOBBERS OTHER AC'S) + PUSH P,A ;SAVE LOADER COMMAND TYPE + PUSHJ P,EBLK ;TERMINATE PREV BLOCK, MAKING SURE LOADER KNOWS $. + PUSHJ P,PWRDA ;PUNCH OUT THE WORD + POP P,A ;GET BACK LOADER COMMAND TYPE FOR PLDCN + PUSHJ P,PLDCN ;OUTPUT THE RESULTING BLOCK +PLINKJ: POP P,LINK ;RESTORE LINK + POPJ P, + +PLDCN: HRRM A,BKBUF ;STORE LOADER COMMAND TYPE IN BKBUF HEADER + MOVEI A,LLDCM ;LOADER COMMAND BLOCK TYPE + DPB A,[310700,,BKBUF] ;STORE BLOCK TYPE IN HEADER + TRO FF,FRLOC ;MAKE EBLK OUTPUT BLOCK EVEN IF EMPTY + JRST EBLK + +;.RELP RETURNS RELOCATION OF ARG +A.RELP: CALL AGETFD + MOVE A,B + JRST VALRET + +;.ABSP RETURNS ABSOLUTE PART OF ARG. +A.ABSP: CALL AGETFD + JRST VALRET + +;.RL1 IN RELOCATABLE ASSEMBLY RETURNS ZERO WITH RELOCATION FACTOR ONE. +;IN ABSOLUTE ASSEMBLY, IT RETURNS JUST ZERO. +;IFN <.RELP .RL1>, IS A TEST FOR A RELOCATABLE ASSEMBLY. +A.RL1: SKIPGE A,CONTRL + TRNE A,DECREL\FASL + SKIPA B,[1] + SETZ B, + SETZ A, + RET + +AEND: NOVAL + SKIPE ASMOUT ; ERROR IF IN GROUPING. + JSP LINK,CONFLM ;FLUSH CONSTANTS, GIVE ERROR MSG. + SKIPE SCNDEP ;IF THERE ARE UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS, MENTION THEM. + MOVE A,BKCUR + CAIE A,BKWPB ;NOT IN .MAIN BLOCK => ERROR. + ETR ERRUMB + MOVE A,CDISP + TLNN A,DWRD + TLO FF,FLUNRD ;IF LAST TERM. WAS WORD TERM., RE-READ. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + EXCH A,PNTBP + MOVEM A,LISTTM +] + PUSHJ P,AVARI0 + PUSHJ P,CNSTN0 + SKIPL A,CONTRL + JRST [ PUSHJ P,AEND5 ; STINK RELOCATABLE => .LNKOT + JRST AEND6] + TRNE A,DECSAV ; IF DECSAV FMT, + JRST [ MOVE A,CLOC ; USE LOC COUNTER AT END AS LOC OF SYMBOLS + SKIPN DECSYA ; UNLESS LOC ALREADY SPECIFIED. + MOVEM A,DECSYA + JRST AEND6] + TRNN A,DECREL + JRST AEND6 + MOVE A,CLOC ;IN DEC FMT, UPDATE HIGHEST ADDR SEEN, + SKIPN CRLOC ;UPDATE EITHER THE HIGHEST ABS ADDR + JRST [ CAML A,DECBRA + MOVEM A,DECBRA + JRST AEND6] + CAML A,DECTWO ;OR THE HIGHEST REL ADDR IN THE + JRST [ CAML A,DECBRH ;APPROPRIATE SEG. + MOVEM A,DECBRH + JRST AEND6] + CAML A,DECBRK + MOVEM A,DECBRK +AEND6: JUMPL FF,AEND1 ;ON PUNCHING PASS, SPECIAL STUFF + PUSHJ P,GETWRD ;OTHERWISE EAT UP WORD, + JRST RETURN ;AND RETURN + +AEND1: PUSHJ P,EBLK +IFN LISTSW,[ + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE A,LISTTM + MOVEM A,PNTBP +] + MOVE SYM,[SQUOZE 0,END] + TLZ I,ILWORD + PUSHJ P,AGETWD +IFN LISTSW,[ + MOVEM A,LISTWD + MOVEM B,LSTRLC + SETOM LISTAD + SETOM LISTPF + SKIPE LSTONP + PUSHJ P,PNTR + SKIPE LISTP + PUSHJ P,LPTCLS ;DONE LISTING + MOVE A,LISTWD +] ;END IFN LISTSW, + SKIPL B,CONTRL + JRST AEND3 ;RELOCATABLE +IFN FASLP,[ + TRNE B,FASL + JRST FASEN ;FASL FORM +] + TRNE B,DECSAV + JRST AEND4 + TRNN B,DECREL ;IF DEC FORMAT, + JRST AEND1A + TLNN I,ILWORD ;THEN IF THERE7S A STARTING ADDRESS, + JRST AEND2 + MOVSI A,DECSTA ;OUTPUT START-ADDRESS BLOCK. + PUSHJ P,DECBLK + PUSHJ P,PWRD + PUSHJ P,EBLK + JRST AEND2 + +IFN FASLP,[ +FASEN: JRST AEND2 +] + +AEND3: HRRZ A,CLOC + HRRM A,BKBUF ;SET UP PROGRAM BREAK JUST IN CASE OUTPUTTING MORE NULL DATA BLOCKS + MOVEI A,LCJMP + PUSHJ P,PLDCM + JRST AEND2 + + ; HERE FOR DECSAV FORMAT. +AEND4: TLNE A,-1 + JRST AEND1B ; IF SOMETHING IN LH, MAY BE ENTRY VECTOR. + MOVE B,A + MOVE A,[-1,,120-1] ; NOTHING, SO ASSUME SIMPLE JRST. MUST + PUSHJ P,PPB ; FIRST SAVE S.A. IN .JBSA CROCK. + MOVE A,B + PUSHJ P,PPB + TLO A,(JRST) ; FURNISH JRST FOR PUTTING AT END OF OUTPUT. + JRST AEND1B + +AEND1A: ; CHECK WORD AND MAYBE MAKE IT A JRST + TLNN A,777000 ; CHECK INSTRUCTION PART + TLO A,(JRST) ; WANTS JRST + PUSHJ P,PPB +AEND1B: JUMPG A,.+3 + ETR [ASCIZ /Start instruction negative/] + HRLI A,(JRST) ;END SYMTAB WITH POSITIVE WORD + MOVEM A,STARTA ;SAVE FOR PUNCHOUT AT END OF SYMTAB + PUSHJ P,FEED1 +AEND2: PUSH P,[RETURN] +CNARTP: +IFN DECSW\TNXSW,[ + PUSH P,TTYFLG + SKIPE CCLFLG ;IN DEC VERSION, IF RUN BY CCL, DON'T PRINT + AOS TTYFLG ;THIS STUFF ON THE TTY - ONLY IN ERROR FILE AND LISTING. + CALL CNTPD + REST TTYFLG + RET + +CNTPD: +] + MOVNI D,1 + MOVEI TT,PCNTB +CNTP1: CAML TT,PBCONL + RET + HRRZ B,1(TT) + HLRZ A,1(TT) + CAMN A,B + JRST CNTP2 + AOSN D + TYPR [ASCIZ /Constants area inclusive +From To +/] + LDB B,[.BP (CGBAL),2(TT)] + SKIPE B + TYPR [ASCIZ /Global+/] + HRRZ B,1(TT) + PUSHJ P,OCTPNT + PUSHJ P,TABERR + HLRZ B,1(TT) + SOS B + PUSHJ P,OCTPNT + PUSHJ P,CRRERR +CNTP2: ADDI TT,3 + JRST CNTP1 + +AENDM1: TYPR [ASCIZ /Unterminated successful bracketed conditionals +The first was at /] + AOS A,CONDPN + CALL DPNT + MOVEI A,"- + CALL TYOERR + AOS A,CONDLN + CALL D3PNT2 +IFN TS,[ + TYPR [ASCIZ/ of file /] + MOVE B,CONDFI + CALL SIXTYO +] + JRST CRRERR + +AXWORD: CALL XGETFD ;READ 1ST FIELD, + TLNE I,ILMWRD + CALL IGTXT ;SOAK UP REST OF TEXT PSEUDO. + HRLM A,WRD + HRLM B,WRDRLC + MOVSI C,HFWDF + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + PUSH P,GLSP1 + CALL XGETFD ;NOW THE SECOND FIELD + HRRM A,WRD + HRRES B + ADDM B,WRDRLC + MOVSI C,HFWDF + MOVEI B,0 + POP P,T + PUSHJ P,LINKTC + JRST CABPOP + +A.NTHWD:CALL AGETFD ;READ THE NUMBER OF THE WORD WE WANT. + SOJL A,CABPOP ;NEGATIVE OR 0 => RETURN 0. + SOJL A,A.1STWD ;1 => TURN INTO .1STWD. + ;ELSE SKIP APPRO. # OF WORDS, THEN DO .1STWD. + +A.NTH1: PUSH P,A + PUSH P,WRD + CALL XGETFD + TLZ FF,FLUNRD + REST WRD + REST A + TLNN I,ILMWRD + JRST CABPOP ;IF STRING ENDS BEFORE DESIRED WORD, RETURN 0. + SOJGE A,A.NTH1 + +A.1STWD: CALL XGETFD ;GET THE 1ST WD OF FOLLOWING TEXT PSEUDO, + CALL IGTXT ;THROW AWAY THE REST. + MOVE T,A ;RETURN THE VALUE + JRST TEXT5 ;COMPLAINING IF FOLLOWED IMMEDIATELY BY SYLLABLE. + +A.LENGTH: CALL PASSPS + PUSH P,[0] + PUSH P,A +A.LN1: PUSHJ P,RCH + AOS -1(P) + CAME A,(P) + JRST A.LN1 + SOS T,-1(P) + SUB P,[2,,2] + JRST TEXT5 ;RETURN VALUE IN T + +ARDIX: NOVAL + PUSHJ P,AGETFD ;GET FIELD ARG + MOVEM A,ARADIX + JRST MACCR ;RETURN WITHOUT CLOBBERING CURRENT VALUE + +A.RADIX: CALL AGETFD ;READ THE TEMP. RADIX. + PUSH P,ARADIX ;LAMBDABIND RADIX TO THAT VALUE. + MOVEM A,ARADIX + CALL XGETFD ;READ IN THE NEXT FIELD USING THAT RADIX. + REST ARADIX + JRST VALRET + +;READ A BIT-MASK AS ARG, RETURN THE LH OF BP. FOR THAT BYTE. +A.BP: CALL YGETFD + MOVEI C,SPACE + SKIPE CDISP ;IF ARG WAS ENDED BY A COMMA, TURN IT INTO A SPACE + HRRM C,CDISP ;SO THAT .BP FOO,BAR USES THE FLD SPACE FLD FORMAT. + JUMPE A,VALR1 + PUSH P,A + JFFO A,.+2 + MOVEI B,36. + EXCH B,(P) ;(P) HAS # LEADING ZEROS. + MOVN A,B + AND A,B ;A HAS ONLY THE LOW BIT OF THE BYTE. + JFFO A,.+2 + MOVNI B,1 ;B HAS 35.-<# TRAILING ZREROS.> + MOVEI A,1(B) + SUB A,(P) ;A HAS SIZE OF BYTE + LSH A,30 ;PUT IN S FIELD OF BP. + SUB P,[1,,1] + MOVNS B + ADDI B,35. ;B HAS # TRAILING ZEROS. + DPB B,[360600,,A] ;PUT THAT IN P FIELD OF BP. + JRST VALR1 + +;READ IN BP, RETURN BIT MASK TO SPEC'D BYTE. +;THE ARG SHOULD BE JUST THE LH OF A BP, WHICH MAY BE IN EITHER HALF OF THE ARG. +A.BM: CALL GETBPT ;READ IN A BYTE POINTER ARG, IN A, POINTING AT T. + SETZ T, + SETO C, +A.DPB1: DPB C,A ;PUT 1'S IN SPEC'D PART OF ACCUM T + MOVE A,T + JRST VALRET + +;READ IN A BYTE POINTER (REALLY JUST S AND P FIELDS) AND MAKE POINT AT AC T. +;RETURN IT IN AC A. +GETBPT: CALL YGETFD + TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH. + HRLI A,(A) + TLZ A,77 ;MAKE BP. -> AC T + HRRI A,T + RET + +;RETURN # TRAILING ZEROS IN ARGUMENT. +A.TZ: CALL YGETFD + MOVN B,A + AND A,B ;A HAS JUST LOW BIT OF ARG SET. + JFFO A,.+2 + MOVNI B,1 ;# OF ZEROS BEFORE LOW BIT = + MOVN A,B ;35. - <# TRAILING ZEROS> + ADDI A,35. + JRST VALRET + +;RETURN # LEADING ZEROS IN ARG. +A.LZ: CALL YGETFD + JFFO A,.+2 + MOVEI B,36. + MOVE A,B + JRST VALRET + +;.DPB STUFF,BP,WORD DOES A DPB OF STUFF INTO THE FIELD OF WORD SPEC'D BY BP, +;RETURNING THE RESULTING WORD. +A.DPB: CALL YGETFD ;READ STUFF. + PUSH P,A + CALL GETBPT ;READ BP AND TURN INTO ACTUAL BP POINTING AT T + PUSH P,A + CALL YGETFD ;READ IN WORD AND PUT IN T. + MOVE T,A + REST A ;A HAS BP + REST C ;C HAS STUFF + JRST A.DPB1 ;GO DO THE DEPOSIT AND RETURN THE ALTERED WORD. + +;.LDB BP,WORD RETURNS THE CONTENTS OF THE BYTE IN WORD SELECTED BY BP +A.LDB: CALL GETBPT + PUSH P,A + CALL YGETFD + MOVE T,A + REST A + LDB A,A + JRST VALRET + +;.IBP BP RETURNS AN INCREMENTED BP. +A.IBP: CALL YGETFD + TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH. + HRLZS A + IBP A + JRST VALRET + +AWORD: NOVAL + PUSHJ P,EBLK + PUSHJ P,GETWRD ;ON UNDEFINED SYM, WYB UNDEFINED SYM IN "WORD"? + PUSHJ P,PPB + JRST ASSEM1 + +;.BIND - MAKE SYMS BE DEFINED IN CURRENT (SPEC'D) BLOCK. LH(B) HAS 0. +;.KILL - FULLY KILL THE SYMS.LH(B) HAS 3KILL. +;.HKILL - HALFKILL THEM. LH(B) HAS 3SKILL. +;.XCREF - PREVENT CREFFING OF SYMS. LH(B) HAS 3NCRF. +;.DOWN - SET 3DOWN, MAKING SYM VISIBLE IN SUBBLOCKS IN 1 PASS ASSEMBLY. +A.KILL: NOVAL + HLLZ LINK,B ;REMEMBER BIT TO SET. +A.KIL1: CALL GETSLD ;READ NEXT SYMBOL NAME. + JRST MACCR ;NO MORE, EXIT. + SKIPE LINK ;EXCEPT FOR .BIND, DO NOTHING ON PASS 1. + JUMPGE FF,A.KIL1 + CALL ESDEF ;DEFINE THE SYMBOL, D HAS STE IDX. + JRST A.KIL2 ;SYMBOL NEVER SEEN. + IORM LINK,ST+2(D) ;SET THE BIT IN 3RDWRD.. + IOR C,LINK ;(IF .XCREF, PREVENT CREFFING THIS TIME) +IFN CREFSW,XCT CRFINU ;CREF THE SYMBOL + JRST A.KIL1 + +A.KIL2: MOVSI T,LCUDF ;SYMBOL UNDEFINED, MAKE UNDEF LOCAL. + IOR C,LINK ;WITH THE DESIRED BIT SET. + TLO C,3MACOK ;SHOULDN'T BE ERROR IF IT BECOMES MACRO. + CALL VSM2 +IFN CREFSW,XCT CRFINU + JRST A.KIL1 + +;EXPUNG SYM1,SYM2 ... ;UNDEFINE THOSE SYMS. +AEXPUNG: NOVAL +AEXPU2: PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO MORE NAMES + PUSH P,[AEXPU2] ;AFTER THIS SYM, POPJ TO READ ANOTHER. +;EXPUNGE 1 SYMBOL, SQUOZE IN SYM. +AEXPU1: PUSHJ P,ES + JFCL ;NOT FOUND, DON'T COMPLAIN, JUST CREF. +IFN CREFSW,XCT CRFDEF + HRLZI T,400000 ;EXPUNGED ZERO SYM + SKIPE ST(D) + MOVEM T,ST(D) + SKIPL CONTRL ;IF RELOCATABLE ANDLOCAL SYMBOL, + CAIL A,DEFGVR_-33. + RET + PUSHJ P,PBITS7 ;TELL STINK TO EXPUNGE SYM. + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY IS NEW TYPE RQ, + PUSHJ P,OUTSM0 + MOVSI A,400000 ;NEW NAME NULL => DELETE. + JRST $OUTPT + +;EQUAL SYM1,SYM2 ;DEFINE SYM1 SAME AS SYM2. +AEQUAL: NOVAL + PUSHJ P,GETSLD + ETR ERRTFA + PUSH P,SYM ;REMEMBER SYM NAME AND BLOCK TO DEF. IN. + PUSH P,ESBK + PUSHJ P,GETSLD + ETR ERRTFA +IFN CREFSW,XCT CRFINU ;CREF SYM DEFINED AS. + CALL ES ;LOOK UP SYM TO EQUATE TO. + JRST [ REST ESBK ;NOT FOUND => EXPUNGE THE 1ST SYM. + REST SYM + JRST AEXPU1] + REST ESBK + REST SYM +IFN CREFSW,XCT CRFDEF + PUSH P,A + PUSH P,B ;SAVE INFO ON VALUE OF SYM TO EQUATE TO. + PUSH P,C + CALL ESDEF + MOVEM SYM,ST(D) + REST B ;3RDWRD OF 2ND SYMBOL. + REST ST+1(D) ;(WHAT WAS PUSHED FROM B) + REST A + DPB A,[400400,,ST(D)] + TLZ C,3DFCLR ;SAVE OLD 3MAS, 3NCRF OF 1ST SYMBOL (AND ITS BLOCK #). + AND B,[3DFCLR,,] ;SET REST OF 3RDWRD BITS FROM 2ND SYMBOL. + IOR B,C + 3PUT B,D + JRST MACCR + +ERRTFA: ASCIZ /Too few args - EQUAL/ + +;.SEE SYM1,SYM2,... ;CREF THOSE SYMS. +A.SEE: CALL GETSLD ;READ 1 SYMBOL. + JRST MACCR ;NONE TO BE READ. +IFN CREFSW,[ + SKIPN CRFONP ;IF CREFFING, + JRST A.SEE + CALL ES + MOVEI A,SYMC_-33. + XCT CRFINU ;CREF THE SYMBOL. +] + JRST A.SEE + +;UUO HANDLING ROUTINE +;41 HAS JSR ERROR + +VBLK +ERRCNT: 0 ; NUMBER OF ERRORS HIT -- VALUE OF .ERRCNT +ERRCCT: 0 ;NUM CHARS OUTPUT ON LINE, FOR MAKING MSGS LINE UP. +ERRJPC: 0 ;JPC READ WHEN UUO. +ERROR: 0 +IFN ITSSW, .SUSET [.RJPC,,ERRJPC] + JRST ERRH ;GO HANDLE IT +PBLK +ERRH: PUSH P,T + PUSH P,B ;NOT TYPR => ERROR OF SOME KIND + PUSH P,A + PUSH P,C + LDB T,[331100,,40] ;PICK UP OP CODE + CAIN T,TYPCR_-33 ; TYPCR? + JRST TYPCR1 + CAIN T,TYPR_-33 ; OR TYPR? + JRST TYPR1 ; YES + ;ERROR OF SOME KIND + CAIE T,ETASM_-33 ;CHECK FOR SPECIAL LOSSAGES AT COLON + CAIN T,ETSM_-33 + CAME SYM,SYSYM ;ARE WE ABOUT TO MENTIO THIS LOSING LABEL AS THE LAST ONE? + JRST ERRH1 + MOVE T,SYSYM1 + + MOVEM T,SYSYM ;COLON LOSSAGE, DE-MUNG TAG WORDS FOR PRINTOUT + MOVE T,SYLOC1 + MOVEM T,SYLOC +ERRH1: +IFN TS,[ +IFN LISTSW,[ + CALL PNTR ;FORCE OUT BUFFERED LISTING OUTPUT + CALL PNTCRR ;AND CR, SO USER CAN SEE WHERE ERROR WAS. +] + PUSHJ P,ERRTFL ;IF NOT SAME FILE AS LAST, PRINT FILE NAME. +] + SETZM ERRCCT + AOS ERRCNT ; BUMP ERROR TOTAL +IFN DECSW,AOS .JBERR ; BUMP ERROR MESSAGE COUNTER FOR LOADER TO ABORT + MOVE A,SYSYM ;GET LAST TAG DEFINED + JUMPE A,ERR1 ;SKIP PRINTOUT IF NONE THERE + PUSHJ P,SYMTYP ;THERE, TYPE IT OUT + MOVE B,CLOC ;NOW GET CURRENT LOCATION + SUB B,SYLOC ;SUBTRACT VALUE OF LAST TAG + JUMPE B,ERR1 ;SKIP NUMERIC PRINTOUT IF RIGHT AT TAG + MOVEI A,"+ ;NOT AT TAG, + PUSHJ P,TYOERR ;TYPE OUT PLUS SIGN, + AOS ERRCCT ;(1 MORE CHAR TYPED) + PUSHJ P,OCTPNT ;THEN TYPE OUT DIFFERENCE IN OCTAL +ERR1: PUSHJ P,TABERR ;NOW SEPARATE WITH TAB + MOVE A,ERRCCT + CAIGE A,8 ;MAKE SURE MOVE TO COLUMN 16. + PUSHJ P,TABERR + MOVEI B,[ASCIZ/GL+/] + SKIPGE GLOCTP ;LOCATION GLOBAL? + PUSHJ P,TYPR3 ;YES, TYPE OUT THAT FACT. + MOVE B,CLOC ;GET CURRENT LOCATION + PUSHJ P,OCTPNT ;TYPE OUT IN OCTAL +;DROPS THROUGH + +;DROPS THROUGH. + PUSHJ P,TABERR + MOVE A,MDEPTH ;NOW DEPTH IN MACRO (NOT IRP, REPEAT, ETC.) EXPANSIONS + MOVSI T,-2 + CALL DPNT0 ;PRINT, IN 2-CHAR FIELD. + MOVEI A,". + CALL TYOERR ;(USED TO BE OCTAL) + MOVE A,CPGN ;CURRENT PAGE NUMBER (FIRST PAGE OF FILE => 0) + PUSHJ P,[AOJA A,D6PNT] ;TYPE IT OUT IN DECIMAL + MOVEI A,"- + CALL TYOERR + MOVE A,CLNN ;ALSO CURRENT LINE NUMBER + PUSHJ P,[AOJA A,D3PNT2] + PUSHJ P,TABERR + MOVEI A,48. ;ASSUME ALL THE STUFF WE'VE PRINTED TAKES 48. CHARS + MOVEM A,ERRCCT ;MAYBE SOMEDAY TABERR, ETC. WILL REALLY UPDATE ERRCCT PROPERLY. + LDB A,[331100,,40] ;PICK UP OP CODE AGAIN + CAIGE A,8 ;ERROR UUO MAX + JRST .+1(A) + JRST [HALT ? JRST .-1] ;OPCODE 0, OR TOO BIG. + JRST ERRSM ;ETSM => TYPE SYM AND MESSAGE. + JRST ERRR ;ETR => JUST PRINT MESSAGE + JRST ERRJ ;ERJ => RH(40) HAS JUMP ADR + JRST ERRI ;ETI => IGNORE LINE RET TO ASSEM1 + JRST ERRA ;ETA => RET TO ASSEM1 + JRST ERRASM ;ETASM => TYPE SYM AND GO TO ASSEM1 + JRST IAE ;ERF => FATAL. + +ERRJ: MOVE A,40 ;ERJ => RH(40) HAS JUMP ADR + HRRM A,ERROR + JRST ERRET1 + +ERRI: PUSHJ P,RCH ;ETI => IGNORE LINE, RETURN TO ASSEM1: EAT UP LINE + CAIE A,12 + JRST .-2 +ERRA: MOVEI A,ASSEM1 ;ETA => RETURN TO ASSEM1, DON'T TYPE SYM. + MOVEM A,ERROR + JRST ERRR + +ERRASM: MOVEI A,ASSEM1 ;ETASM => TYPE SYM AND RETURN TO ASSEM1 + MOVEM A,ERROR +ERRSM: MOVEI C,56. ;ETSM OR ETASM => TYPE OUT SYM THEN MESSAGE + CALL TYPE37 ;CR NOW IF WHOLE MSG WON'T FIT ON ONE LINE. + MOVE A,SYM + PUSHJ P,SYMTYP + PUSHJ P,TABERR +ERRR: CALL TYPE40 ;TYPE THE ERROR MESSAGE. +ERRET1: REST C + POP P,A ;COMMON RETURN POINT FROM UUOS + POP P,B + POP P,T + JRST 2,@ERROR + +;FINISH UP AN ERROR UUO'S ERROR MESSAGE. PRINT THE SPECIFIED STRING +;AND ALSO "IN DEFINE AT ..." IF NECESSARY, ALONG WITH APPROPRIATE CR'S. +TYPE40: MOVE C,ERRCCT + CALL TYPE37 + CALL TYPR4 ;PRINT THE ASCIZ STRING + CALL CRRERR + SKIPN A,DEFNPS ;IF INSIDE A LONG PSEUDO, + RET + MOVE A,DEFNLN + MOVE B,DEFNPN + CAMN A,CLNN ;WHICH DIDN'T START IN THIS VERY LINE, + CAME B,CPGN + JRST TYPE42 + MOVE A,DEFNFI + CAMN A,INFFN1 + JRST TYPE43 +TYPE42: MOVEI B,[ASCIZ/ in /] + CALL TYPR3 + MOVE A,DEFNPS + CALL SYMTYP ;SAY WHAT PSEUDO, AND WHERE IT STARTED. + MOVEI B,[ASCIZ/ Starting at /] + CALL TYPR3 + MOVE A,DEFNPN ;PAGE # -1. + CALL [AOJA A,DPNT] ;PRINT PAGE #. + MOVEI A,"- + CALL TYOERR + AOS A,DEFNLN + CALL D3PNT2 ;PRINT LINE #. +IFN TS,[ + MOVE B,DEFNFI ;PRINT FILE NAME IF IT ISN'T THE CURRENT FILE. + CAMN B,INFFN1 + JRST TYPE41 + MOVEI B,[ASCIZ/ of file /] + CALL TYPR3 + MOVE B,DEFNFI + CALL SIXTYO +] +TYPE41: CALL CRRERR ;AND CRLF. +TYPE43: MOVE A,ERROR + CAIE A,ASSEM1 ;IF THIS ERROR IS EXITING THE PSEUDO, + RET + SETZM DEFNPS ;SAY WE'RE NOT IN IT ANY MORE. + SETOM TEXT4 + RET + +;JSP TM,ERMARK IN A PSEUDO, TO ARRANGE FOR ERROR MESSAGES TO MENTION +;THAT PSEUDO. SYM SHOULD CONTAIN THE NAME OF THE PSEUDO. +;PUSHES A WORD ON THE STACK SO THAT WHEN THE PSEUDO RETURNS DEFNPS WILL BE CLEARED. +;IF DEFNPS IS SET UP ALREADY, DOES NOTHING (DOESN'T SET DEFNPS; DOESN'T PUSH THE WORD) +ERMARK: SKIPE DEFNPS + JRST (TM) + MOVEM SYM,DEFNPS + MOVE SYM,CLNN + MOVEM SYM,DEFNLN + MOVE SYM,CPGN + MOVEM SYM,DEFNPN + MOVE SYM,INFFN1 + MOVEM SYM,DEFNFI + MOVE SYM,DEFNPS + CALL (TM) + CAIA + AOS (P) + SETZM DEFNPS + RET + +;C SHOULD HAVE CURRENT HORIZ POS. IF TYPING THE STRING 40 POINTS AT +;WOULD OVERFLOW THE LINE, TYPE A CRLF AND TAB NOW ON THE TTY ONLY. +TYPE37: HRRZ B,40 + HRLI B,440700 ;FIRST, FIGURE OUT HOW FAR ON LINE WE'LL TYPE IF WE DON'T CR. + ILDB A,B + CAIE A, ;AND COUNT CHARS IN THE ERR MSG. + AOJA C,.-2 + CAMGE C,LINEL + RET +CRRTBX: MOVEI A,10 + MOVEM A,ERRCCT ;PREVENT THIS FROM BEING DONE TWICE. + SKIPE TTYFLG + RET + MOVEI A,^M ;IF THERE'S NO ROOM, CRLF ON THE TTY ONLY (NOT THE ERR FILE). + PUSHJ P,TYOX + MOVEI A,^J + PUSHJ P,TYOX + MOVEI A,^I + JRST TYOX + + ;TYPE OUT SQUOZE (FLAGS OFF) IN A + +SYMTYP: PUSHJ P,SQCCV ;GET NEXT CHAR IN ASCII. + AOS ERRCCT + PUSHJ P,TYOERR ;TYPE IT OUT. + JUMPE B,CPOPJ ;RETURN IF NOTHING LEFT (TYPED OUT AT LEAST ONE CHAR THOUGH) + IMULI B,50 ;LEFT-JUSTIFY REMAINDER + MOVE A,B ;GET LEFT-JUSTIFIED REMAINDER IN A + JRST SYMTYP ;TYPE OUT REMAINDER OF SYM + + ;TYPE OUT SQUOZE CHARACTER (IN A) + +SQCCV: IDIV A,[50*50*50*50*50] + CAIG A,10. + SOJA A,SQCDTO ;NUMBER (OR BLANK =>SLASH) + CAIL A,45 + SKIPA A,SYTB-45(A) ;SPECIAL + ADDI A,"A-13 ;LETTER + POPJ P, + +SQCDTO: ADDI A,"0 + POPJ P, + +SYTB: ". + "$ + "% + +D3PNT2: MOVE T,[-3,,400000] ;3 CHAR FIELD, NO ZERO SUPPRESSION. + JRST DPNT0 + +DPNT: TDZA T,T ;ORDINARY DECIMAL PRINT. +D6PNT: MOVSI T,-6 ;6 CHAR FIELD, ZERO SUPPRESSION. +DPNT0: IDIVI A,10. + HRLM B,(P) + TRNE T,377777 ;IF NOT LAST DIGIT, + TRNE T,400000 ;AND ZERO-SUPPR. WANTED, + JRST DPNT2 + JUMPN A,DPNT2 ;IF THIS IS A LEADING 0, + JUMPN B,DPNT2 + MOVEI B," -"0 + HRLM B,(P) ;REPLACE WITH A SPACE. +DPNT2: AOBJN T,.+2 ;J IF NOT ENOUGH CHARS YET. + JUMPE A,DPNT1 ;ENOUGH, DON'T MAKE MORE IF NOT NEEDED. + CALL DPNT0 + JRST DPNT1 + +;TYPE HALFWORD IN B IN OCTAL. +OCTPNT: HRRZ A,B + IDIVI A,10 + HRLM B,(P) + JUMPE A,.+2 + PUSHJ P,.-3 + AOS ERRCCT +DPNT1: HLRZ A,(P) +ADGTYO: ADDI A,"0 + JRST TYOERR + +;TYPE OUT THE SIXBIT WORD IN B + +SIXTYO: JUMPE B,CPOPJ + MOVEI A,0 + ROTC A,6 + ADDI A,40 + PUSHJ P,TYOERR + JRST SIXTYO + + ;TYPE CRLF + +CRR: MOVEI A,15 + PUSHJ P,TYO + MOVEI A,12 + JRST TYO + +;OP CODE 0 => NO RECOVERY RETURN TO GO9 +IAE: CALL TYPE40 ;PRINT THE ERROR MESSAGE. + SKIPE ASMOUT + JSP LINK,CONFLZ ;TELL USER ABOUT UNTERM. GROUPINGS. + SKIPE SCNDEP ;MENTION ANY UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS. + MOVEI B,[ASCIZ /Error is fatal. +/] + CALL TYPR3 +IFN ITSSW,[ + .SUSET [.RTTY,,A] + SKIPL A + .RESET TYIC, +] + JRST GO9 + + ;TYPR [ASCIZ /STRING/] ;TYPE OUT STRING + +TYPR1: PUSH P,[ERRET1] +TYPR4: HRRZ B,40 ;GET ADR OF BEGINNING OF STRING +TYPR3: HRLI B,440700 ;CONVERT TO BYTE POINTER +TYPR2: ILDB A,B ;GET NEXT CHAR + JUMPE A,CPOPJ ;JUMP IF ZERO, END OF STRING + PUSHJ P,TYOERR ;NON-ZERO, TYPE IT OUT + JRST TYPR2 + + ; TYPCR [ASCIZ /STRING/] ; Type out string, followed by CRLF + +TYPCR1: PUSH P,[ERRET1] + PUSHJ P,TYPR4 ; When done, fall thru. + +CRRERR: MOVEI A,^M ;CRLF IN ERROR MESSAGE. + CALL TYOERR + SKIPA A,[^J] +TABERR: MOVEI A,^I ;TAB INN ERROR MESSAGE. +TYOERR: +IFN LISTSW,[ + SKIPE LSTTTY ;OUTPUT TO LISTING UNLESS LSTTTY ZERO. + CALL PILPTX +] + SKIPG LSTTTY + JRST TYO ;TO TTY UNLESS LSTTTY POSITIVE. + RET + +;OUTPUT-FORMAT SELECTING PSEUDOS: + +;.SLDR -- ON PASS 2, PUNCH OUT SBLK LOADER AND SELECT SBLK FORMAT +A.SLDR: NOVAL + JUMPGE FF,MACCR ;DO NOTHING ON PASS 1. + PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE FIRST + PUSHJ P,PLOD1A ;PUNCH OUT LOADER +SIMBLK: MOVSI B,SBLKS ;ENTRY FROM PS1, A.SLDR SELECT SBLK + JRST SIMBL1 + +SRIM: MOVE A,SYM ;ENTRY FROM GETVAL, LH(B) HAS RH(CONTRL) + PUSH P,B + CALL SYMTYP + TYPR [ASCIZ/ Encountered +/] + REST B +SIMBL1: TRO FF,FRNPSS + HRRI B,TRIV ;SET UP TRIV FLAG FOR LH(CONTRL) + MOVSS B + CAME B,CONTRL ;IF CHANGING MODES, END THE BLOCK IN THE OLD MODE + CALL EBLK + MOVE A,CONTRL ;IF OLD MODE WAS RELOCATABLE OF SOME KIND, + TRNN A,DECREL\FASL + JUMPL A,SIMBL2 + SETZM CRLOC ;INITIALIZE LOCATION COUNTER. + MOVEI A,100 ; USE 100 ASSUMING ITS SBLK + TRNE B,DECSAV + MOVEI A,140 ; BUT USE 140 FOR DEC ABS. + MOVEM A,CLOC +SIMBL2: MOVEM B,CONTRL ;STORE NEW MODE. + TRNE B,ARIM\ARIM10 + TRZ F,FRSYMS ;RIM AND RIM10 MODES IMPLY NO SYMBOLS. + AOS (P) + + ;ROUTINE TO SET VARIABLES FOR BENEFIT OF NED LOGIC + ;CALLED BY OUTPUT SELECTING PSEUDOS +OUTUPD: NOVAL +IFN A1PSW,[ + TRNE FF,FRNPSS ;IF PASS 1, + TLNN FF,$FLOUT + JRST OUTCHK + AOS OUTN1 ;INDICATE "OUTPUT" HAS OCCURED OTHER THAN IN 1PASS MODE +OUTCHK: TLZE FF,$FLOUT + AOS OUTC ;INDICATE "OUTPUT" HAS OCCURED DURING CURRENT ASSEMBLY +] + RET + +ANOSYMS: NOVAL + TRZ FF,FRSYMS + JRST MACCR + +A1PASS: PUSHJ P,OUTUPD +A1PAS1: TLO FF,FLPPSS + MOVEIM A.PPASS,1 ;SET .PPASS TO 1. +IFN CREFSW,[ SKIPE CREFP ;THIS NOW PUNCHING PASS, + PUSHJ P,CRFON ;MAYBE TURN ON CREFFING. +] +IFN LISTSW,[ + SKIPE LISTP + CALL LSTON ;LIST NOW IF WANT LISTING AT ALL. +] + MOVE A,CONTRL + TRNE A,DECREL + CALL DECPGN + TRZA FF,FRNPSS +ARELOC: PUSHJ P,OUTUPD +ARELC1: PUSHJ P,EBLK ;FINISH CURRENT OUTPUT BLOCK + TRO FF,FRLOC ;DOING LOCATION ASSIGNMENT, MAKE SURE NEXT GETS OUTPUT + CLEARM CLOC + MOVEI A,1 + MOVEM A,CRLOC + CLEARM CONTRL + SETZM BKBUF + MOVEI A,LREL + DPB A,[310700,,BKBUF] + MOVEM A,CDATBC + JRST MACCR + + + ; .DECSAV - SELECT DEC ABSOLUTE ZERO-COMPRESSED (SAV) FORMAT +A.DECSAV: NOVAL + MOVSI B,DECSAV ; SET FLAG + JRST SIMBL1 ; THEN HANDLE ALMOST LIKE .SBLK + + +A.DECTWO: CALL AGETFD ;READ THE TWOSEG ORIGIN. + TRNN FF,FRNPSS + ETF [ASCIZ /.DECTWO follows 1PASS/] + MOVE C,ISAV + TRNN C,IRFLD ;NO ARG => DEFAULT IT TO 400000 + MOVEI A,400000 + MOVEM A,DECTWO + +A.DECREL: PUSHJ P,OUTUPD + TRZ FF,FRLOC + PUSHJ P,EBLK ;FORCE OUT BLOCK IN OTHER FMT. + MOVE A,[SETZ DECREL] + CAME A,CONTRL ;SWITCHING TO .DECREL MODE FOR 1ST TIME + TRNE FF,FRNPSS ;IN A 1PASS ASSEMBLY + JRST A.FAS1 + CALL A.FAS1 ;DO THE SWITCH + JFCL + CALL DECPGN ;THEN WRITE THE PROGRAM NAME + JRST MACCR + +A.FAS1: MOVEM A,CONTRL ;DEC FMT COUNTS AS ABS ASSEMBLY. + SETZM BKBUF ;(SO EBLK W0N'T OUTPUT ANYTHING) + SETZM CLOC ;START ASSEMBLING FROM RELOCATABLE 0. + MOVEI A,1 + MOVEM A,CRLOC + PUSHJ P,EBLK ;INITIALIZE AN ORDINARY (DECWDS) BLOCK. + JRST MACCR + +IFN FASLP,[ +A.FASL: PUSHJ P,OUTUPD + PUSHJ P,EBLK + MOVE A,[SETZ FASL] ;FASL ALSO COUNTS AS ABS + JRST A.FAS1 +] + +ATITLE: NOVAL + PUSH P,CASSM1 ;RETURN TO ASSEM1. + PUSHJ P,GSYL + SKIPE SYM + MOVEM SYM,PRGNM + MOVE T,[440700,,STRSTO] +ATIT2: ILDB A,T ;GET CHAR FROM TITLE STRING + SOSG STRCNT + JRST ATIT3 ;CHAR IS SYLLABLE TERMINATOR +IFE ITSSW,[ + SKIPE CCLFLG + TRNN FF,FRPSS2 +] + PUSHJ P,TYO ;NOT TERMINATOR, TYPE OUT AND LOOP BACK + JRST ATIT2 + +ATIT3: CALL ATIT1 ;PRINT THE REST OF THIS LINE. + MOVE A,CONTRL + TRNE A,DECREL + TRNE FF,FRNPSS + CAIA + ETF [ASCIZ /TITLE follows 1PASS/] + MOVE A,TTYINS + ADD A,A.PASS ;SHOULD WE .INSRT TTY: THIS PASS (T SWITCH) + JUMPG A,CPOPJ +IFDEF GTYIPA,JRST GTYIPA ;GO PUSH TO TTY IF CAN, +IFNDEF GTYIPA,HALT ;WHY DID YOU SET TTYINS IF CAN'T? + +ATIT1: CAIE A,15 ;CR? + CAIN A,12 ;LF? +IFN ITSSW,JRST CRR ;ONE OF THESE, FINISH TYPEOUT WITH CR +.ELSE [ JRST [ SKIPE CCLFLG + TRNN FF,FRPSS2 + JRST CRR + RET] + SKIPE CCLFLG ;NEITHER OF THESE, PRINT CHAR. + TRNN FF,FRPSS2 ;ON DEC SYS, DON'T PRINT THE TITLE ON P2, OR AT ALL IF RUN BY CCL. +] + PUSHJ P,TYO +A.ERR1: PUSHJ P,RCH ;GET NEXT CHAR IN TITLE + JRST ATIT1 + +;.ERR PSEUDO-OP -- FOLLOWED BY LINE WHICH IS ERROR MSG. +A.ERR: PUSH P,CASSM1 ;RETURN TO ASSEM1, + ERJ A.ERR1 ;AFTER NUMBERS AND USER'S STRING. + +A.FATAL:PUSH P,[GO9] ;.FATAL - CAUSE A FATAL ERROR. + ERJ A.ERR1 + +APRINT: NOVAL + HLRZS B ;B SAYS WHETHER PRINTX, PRINTC OR COMMENT. + JSP TM,ERMARK + CALL PASSPS + MOVE T,A +APRIN1: PUSHJ P,RCH + CAME A,T + JRST (B) ;GO TO APRIN1 FOR COMMENT, + JRST MACCR + +APRIN2: CAIE A,"! ;COME HERE FOR PRINTX +APRIN3: PUSHJ P,TYO ;HERE FOR PRINTC + JRST APRIN1 + +A.TYO: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A CHARACTER (AS NUMERIC ARG). + CALL TYOERR + JRST MACCR + +A.TYO6: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A WORD OF SIXBIT. + MOVE B,A + CALL SIXTYO + JRST MACCR + +;.BEGIN - START NEW BLOCK WITH NAME = ARG, OR LAST LABEL DEFINED. +A.BEGIN: NOVAL + SKIPE ASMOUT ;IF IN GROUPING, FLUSH IT & ERROR. + JSP LINK,CONFLM + PUSHJ P,GETSLD ;READ A NAME. + MOVE SYM,SYSYM ;NO ARG, USE NAME OF LAST LABEL. + MOVE A,SYM ;NAME TO USE FOR BLOCK. + MOVE B,BKLVL ;CURRENT LEVEL + 1 + HRLZI B,1(B) ;IS LEVEL OF NEW BLOCK. + HRR B,BKCUR ;ITS SUPERIOR IS CURRENT BLOCK. + MOVEI C,0 ;SEE IF AN ENTRY EXISTS FOR THIS BLOCK. + MOVE AA,A.PASS +A.BEG0: CAMN A,BKTAB(C) + CAME B,BKTAB+1(C) + JRST A.BEG1 ;THIS ENTRY ISN'T FOR BLOCK BEING ENTERED. + TDNE AA,BKTAB+2(C) ;FOUND: DEFINED IN THIS PASS? + ETSM [ASCIZ /Multiply defined BLOCK/] + JRST A.BEG2 ;NO, SAY IT'S DEFINED. + +A.BEG1: ADDI C,BKWPB ;LOOK THRU ALL ENTRIES. + CAMGE C,BKTABP + JRST A.BEG0 + CAIL C,BKTABS ;ALL ENTRIES USED => ERROR. + ETF ERRTMB + MOVEM A,BKTAB(C) ;ALLOCATE NEW ENTRY + MOVEM B,BKTAB+1(C) ;STORE NAME, LEVEL, SUPPRO. + MOVEI A,BKWPB(C) + MOVEM A,BKTABP ;POINTS TO 1ST UNUSED ENTRY. +A.BEG2: IORM AA,BKTAB+2(C) ;INDICATE BLOCK SEEN THIS PASS. + MOVEM C,BKCUR ;NEW BLOCK NOW CURRENT BLOCK, + AOS A,BKLVL ;ITS LEVEL NOW CURRENT LEVEL, + CAIL A,BKPDLS ;PUSH IT ON BLOCK PDL + ETF [ASCIZ /.BEGIN nesting too deep/] + MOVEM C,BKPDL(A) + JRST ASSEM1 + +ERRTMB: ASCIZ /Too many symbol blocks/ +ERRUMB: ASCIZ /Unmatched .BEGIN - .END/ + +;.END - POP CURRENT BLOCK. +A.END: NOVAL + SKIPE ASMOUT ;IN GROUPING => TERMINATE IT & ERROR. + JSP LINK,CONFLM + MOVE A,CDISP ;IF FOLLOWED BY WORD TERM, + TLNN A,DWRD ;CAUSE IT TO BE RE-READ + TLO FF,FLUNRD ;SO ARG WILL BE NULL. + PUSHJ P,GETSLD ;READ ARG. + JRST A.END0 ;NO ARG. + MOVE C,BKCUR ;ERROR UNLESS BLOCK BEING TERMINATED + MOVE A,BKTAB(C) ;HAS SAME NAME AS ARG. + EXCH A,SYM ;(MAKE SURE SYM NAME TYPED IS BLOCK'S NAME) + CAME A,SYM + ETSM ERRUMB ;ERROR, PRINT SYM (BLOCK'S NAME) +A.END0: MOVE C,BKCUR ;NOT OK TO END .MAIN BLOCK OR .INIT BLOCK. + CAIG C,BKWPB + ETA ERRUMB + HRRZ C,BKTAB+1(C) + MOVEM C,BKCUR ;POP INTO FATHER OF PREV. CURRENT BLOCK. + SOS BKLVL + JRST ASSEM1 + +;BKTAB: 3-WORD ENTRIES, 1 PER BLOCK, IN NO PARTICULAR ORDER. +;1ST WD HAS SQUOZE NAME OF BLOCK, FLAGS CLEAR. +;2ND WD HAS LEVEL,,BKTAB IDX OF CONTAINING BLOCK("FATHER", "SUPERIOR") +;3RD WD BIT 1.N ON => BLOCK ENTERED ON PASS N. +;SYMBOL TABLE OUTPUT RTN PUTS -2* IN 3RD WD. +;THE FIRST BKTAB ENTRY IS THAT OF THE OUTERMOST BLOCK (.INIT) +;IN WHICH INITIAL SYMS ARE DEFINED. +;THAT ENTRY'S 2ND AND 3RD WDS ARE 0. +;THE NEXT IS THAT OF THE MAIN BLOCK (.MAIN) IN WHICH +;ALL SYMBOLS ARE NORMALLY DEFINED (THAT IS, YOU ARE IN THAT BLOCK +;BEFORE YOU DO ANY .BEGIN'S). +;THAT ENTRY'S 2ND WD IS 1,, ; ITS 3RD, 0. + +;THE BKPDL IS A TABLE OF BLOCKS CURRENTLY ENTERED & NOT ENDED. +;BKPDL'S 1ST ENTRY IS FOR OUTERMOST BLOCK. +;LAST ENTRY IS BKPDL+@BKLVL, FOR CURRENT BLOCK. + +BKTABS==BKTABL*BKWPB + +VBLK +BLCODE [ +BKTAB: BLOCK 3 ;ENTRY FOR .INIT BLOCK. +PRGNM: BLOCK BKTABS-BKWPB ;PROGRAM NAME IS NAME OF MAIN BLOCK. +] +BKTABP: 0 ;IDX IN BKTAB OF 1ST UNUSED ENTRY. +BKPDL: BLOCK BKPDLS ;TABLE OF BLOCKS STARTED, NOT FINISHED. +BKLVL: 0 ;CURRENT BLOCK LEVEL, IDX OF LAST USED IN BKPDL. +BKCUR: 0 ;BKTAB IDX OF CURRENT BLOCK. +ESBK: 0 ;-1 OR BLOCK TO EVAL SYM. IN. +ESL1: 0 ;IN ES, LEVEL OF BLOCK OF BEST SYM SO FAR. +ESL2: 0 ;3RDWRD OF BEST SO FAR. +SADR: 0 ;SYM TAB IDX OF BEST SO FAR. +ESLAST: 0 ;RH IDX OF LAST DEF (EVEN IF NO GOOD) -1 IF NONE + ;SIGN NEG. IF LAST DEF SEEN BEFORE @ESXPUN +ESXPUN: -1 ;IF SEE EXPUNGED OR FREE ENTRY, PUT IDX HERE. +BKTAB1: BLOCK BKTABL ;USED BY SSYMD. +PBLK + +;.SYMTAB ARG ;SAY WANT AT LEAST ARG STE'S IN SYMTAB. +A.SYMTAB: NOVAL + PUSH P,[0] ;THIS WORD WILL BE SETOM'ED IF THERE IS REALLY ANY WORK NEEDED. + PUSHJ P,AGETFD ;GET DESIRED SYM TAB SIZE. + CAMG A,SYMLEN ;IF HAVE ENOGH ROOM ALREADY, + JRST A.SYM1 ;NO NEED TO RE-INIT. + CAILE A,SYMMAX ;IF WANTS MORE THAN MAXIMUM, ERROR. + ETF [ASCIZ/.SYMTAB 1st arg too big/] + MOVEM A,SYMLEN ;TELL INITS ABOUT NEW SIZE. + SETOM (P) +A.SYM1: CALL AGETFD ;READ DESIRED CONSTANTS TABLE SPACE ALLOCATION. + CAMG A,CONLEN ;IF TABLE ALREADY BUG ENOUGH, NOTHING TO DO. + JRST A.SYM2 + CAILE A,CONMAX + ETF [ASCIZ/.SYMTAB 2nd arg too big/] + MOVEM A,CONLEN ;ELSE REMEMBER IT AND SAY REALLOCATION NECESSARY. + SETOM (P) +A.SYM2: CALL AGETFD ;3RD ARG IS # WORDS PER SYMBOL - BUT ONLY 3 IS ALLOWED NOW. + JUMPE A,A.SYM3 ;EVENTUALLY 4 WILL GET 12-CHARACTER SYMBOLS. + CAIL A,MINWPS + CAILE A,MAXWPS + ETF [ASCIZ/.SYMTAB 3rd arg out of range/] + CAME A,WPSTE + SETOM (P) + MOVEM A,WPSTE +A.SYM3: REST A ;IS THERE ANYTHING THAT ACTUALLY NEEDS TO BE CHANGED? + JUMPE A,ASSEM1 ;IF NOT, NEVER GIVE ERROR - ELSE WOULD ALWAYS LOSE ON PASS 2. + MOVE B,PLIM + CAMN B,CONTBA ;IF THERE HAVE BEEN ANY LITERALS + SKIPE INICLB ;OR ANY MACROS, IRPS, REPEATS, ETC., THEN ... + ETF [ASCIZ/Too late to do .SYMTAB/] + MOVE CH1,MACTAD ;SET UP AC -> START OF INIT CODE + SUBI CH1,MACTBA ;SO IT CAN REFER TO ITSELF. + PUSHJ P,INITS(CH1) ;RE-INIT, SET SYMSIZ, SYMAOB, ETC. + PUSHJ P,MACINI ;INIT PTRS TO END OF MACTAB. + JRST ASSEM1 + +A.OP: PUSHJ P,A.OP1 ;.OP, + JRST VALRET ;RETURNS VALUE + +A.AOP: NOVAL + AOS (P) ;.AOP DOESN'T RETURN VALUE +A.OP1: PUSHJ P,AGETFD + PUSH P,A + PUSHJ P,AGETFD + PUSH P,A ;PDL NOW HAS FIELD 0 AND FIELD 1 + PUSHJ P,AGETFD + POP P,B ;B NOW HAS FIELD 1, A HAS FIELD 2, PDL HAS FIELD 0 + EXCH A,B + POP P,T ;T HAS FIELD 0, A HAS FIELD 1, B HAS FIELD 2 + TLNN T,(0 17,) ;IF AC FIELD NOT PRESENT IN INSN, SUPPLY ONE. + TLO T,(0 A,) + TDNN T,[0 -1(17)] ;IF NO ADDR OR IDX FIELD IN INSTRUCTION, + HRRI T,B ;SUPPLY ONE. + SETOM A.ASKIP' ;.ASKIP WILL BE -1 IFF INSN SKIPPED, ELSE 0. + TLNE T,74000 ;AVOID EXECUTING OPCODE ZERO. + XCT T + SETZM A.ASKIP + MOVEM A,AVAL1' ;STORE C(AC) AS .AVAL1 + MOVEM B,AVAL2' ;STORE C(E) FOR .AVAL2 + POPJ P, ;RETURN TO WHATEVER + +AASCIZ: TDZA T,T +A.ASCII: MOVEI T,1 + MOVEM T,AASCF1 ;STORE TYPE + MOVE D,[440700,,T] + SETZM AASCFT + JRST AASC1 + +AASCII: SKIPA D,[440700,,T] +ASIXBI: MOVE D,[440600,,T] + SETZM AASCFT ;INDICATE NOT .DECTXT + SETOM AASCF1 ;INDICATE REGULAR (NOT ASCIZ) + JRST AASC1 + +A.DCTX: NOVAL + MOVE A,CONTRL + TRNN A,DECREL + ETA [ASCIZ /.DECTXT in non-DECREL assembly/] + CALL EBLK + SETZ B, + SETOM AASCFT + SETOM AASCF1 ;INDICATE ASCIZ-STYLE PADDING + MOVE D,[440700,,T] +AASC1: TLZE I,ILMWRD + JRST TEXT2 ;MULTIPLE WORD, FALL IN FOR NEXT SET OF CHARS + MOVEMM ASMDS1,ASMDSP + MOVEM SYM,DEFNPS ;REMEMBER LOCATION IN FILE OF PSEUDO + MOVEMM DEFNLN,CLNN ;IN CASE THE DELIMITER IS MISSING. + MOVEMM DEFNPN,CPGN +IFN TS, MOVEMM DEFNFI,INFFN1 + HLRZ T,B ;GET FILL CHARACTER + IMUL T,[REPEAT 5,[1_<.RPCNT*7>+]0] ;CONVERT TO ASCII FILL WORD SHIFTED -1 (IMUL SCREW) + LSH T,1 ;SHIFT TO PROPER POSITION (EXTRA IN CASE WANT TO FILL W/ HIGH BIT SET) + MOVEM T,AASEFW ;STORE AS FILL WORD, T NOW SET UP TO ACCUMULATE VALUE + CALL PASSPS + MOVEM A,TEXT4 ;STORE TERMINATOR +TEXT7: PUSHJ P,RCH +AASC8: CAMN A,TEXT4 + JRST AASC1A ;TERMINATOR + TLNN D,760000 + JRST TEXT6 ;WORD FULL +TEXT9: TLNE D,100 ;CHECK BOTTOM BIT OF SIZE FIELD OF BP + JRST AASC2 ;SET => NOT SIXBIT + SUBI A,40 + CAILE A,77 + SUBI A,40 ;CONVERT LOWER CASE ASCII TO UPPER CASE + JUMPGE A,.+2 + ETR ERRN6B +AASC3: IDPB A,D + TRO I,IRSYL + JRST TEXT7 + +ERRN6B: ASCIZ /Character not SIXBIT/ + +;TERMINATOR + +AASC1A: TLNN D,760000 ;SKIP UNLESS END OF WORD + SKIPGE AASCF1 ;SKIP UNLESS REGULAR + JRST [ MOVE CH1,ASMDS1 ;REGULAR OR NOT END OF WORD + MOVEM CH1,ASMDSP ;RESTORE ASMDSP AS SAVED AT START OF PSEUDO. + JRST TEXTX] + MOVEI CH1,1 ;END OF WORD AND NOT REGULAR + JRST AASC1B ;EXTRA 0 NEED FOR Z FLAVOR + +AASC2: CAIN A,"! + SKIPG AASCF1 + JRST AASC3 ;NOT .ASCII OR NOT EXCL + PUSH P,T ;READ FIELD + PUSH P,TEXT4 + PUSH P,D + PUSH P,SYM + PUSH P,ASMOUT ;PREVENT CLOSEBRACKETS FROM TRYING TO TAKE EFFECT. + MOVEIM ASMOUT,4 ;NOTE THIS LOSES IF CALL PSEUDO THAT RETURNS TO ASSEM1. + MOVEI SYM,[SETOM ASUDS1] ;NOW TO SET UP UNDEFINED SYM CONDITION + TLNE FF,FLPPSS + MOVE SYM,[SQUOZE 0,.ASCII] ;PUNCHING PASS, UNDEFINED => REAL ERROR + CLEARM ASUDS1 + PUSHJ P,AGETFD + ;"UNDEFINED IN .ASCII" ERROR INSTR, ERROR MESSAGE BUT ONLY ON PASS 2 + ;BUT NOTE THAT ON PASS 2 IT MIGHT ASSEMBLE DIFFERENT NUMBER OF WORDS, + ;CAUSING LOSSAGE IF NOT IN CONSTANT + REST ASMOUT + POP P,SYM + POP P,D + POP P,TEXT4 + POP P,T + SKIPGE ASUDS1 + MOVNI A,1 ;HAD UNDEFINED SYMS SO ASSUME MAX + SKIPGE ASUDS1 + TLO I,ILNOPT ;ALSO DON'T OPTIMIZE OVER IN CONSTANT + MOVE CH1,[440700,,AASBF] + MOVEM CH1,ASBP1 + MOVEM CH1,ASBP2 + PUSH P,[AASC5] + MOVE CH1,A +AASC6: LSHC CH1,-35. + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,AASC6 + HLRZ A,(P) + ADDI A,"0 + IDPB A,ASBP1 + POPJ P, + +AASC5: MOVEI A,0 + IDPB A,ASBP1 ;END .ASCII NUMBER WITH ZERO +AASC8A: TLNN D,760000 + JRST AASC7 ;END OF WORD + ILDB A,ASBP2 + JUMPE A,AASC9 + IDPB A,D + JRST AASC8A + +AASC9: TLO FF,FLUNRD + JRST TEXT7 + +AASC7: TDZA CH1,CH1 +TEXT6: MOVNI CH1,1 ;WORD FULL +AASC1B: MOVEM CH1,AASCF2 + CLEARM CDISP + MOVEM A,TEXT8 + MOVE A,T + SKIPE AASCFT ;FOR .DECTXT, OUTPUT WORD INSTEAD OF RETURNING IT. + JRST [ CALL PPB + MOVE D,[440700,,T] + JRST TEXT2A] + TLO I,ILMWRD ;ELSE ARRANGE TO BE CALLED BACK TO RETURN NEXT WORD. + MOVEI T,ASSEM2 + MOVEM T,ASMDSP + SKIPLE CONSML ;IF NOT MULTI-LINE MODE, + JRST CLBPOP + MOVE T,ASMOUT ;IF THE TEXT IS IN <>'S OR ()'S, + HRRZ T,ASMOT2(T) + CAIE T,LSSTHA + JRST CLBPOP + CALL IGTXT ;USE ONLY THE FIRST WORD. + SKIPE CONSML ;AND ERROR IF IN ERROR MODE. + ETR [ASCIZ/Multi-word text pseudo in brackets/] + JRST CLBPOP + + ;GET NEXT WORD + +TEXT2: TRO I,IRFLD +TEXT2A: MOVE T,AASEFW ;INITIALIZE T TO FILL WORD + MOVE A,TEXT8 ;GET NEXT CHAR (ALREADY READ BY RCH) + SKIPGE B,AASCF2 + JRST TEXT9 ;REG OR HAVEN'T READ SECOND DELIMITER, FALL BACK IN + JUMPE B,AASC8A +TEXTX: SETZM DEFNPS + SETOM TEXT4 + SKIPN AASCFT + JRST TEXT5 ;RETURNING FROM ASCIZ AFTER PUTTING THE TRAILING ZERO OUT. + MOVE A,T + CALL PPB ;FOR .DECTXT, OUTPUT THE FILL WORD INSTEAD. + JRST MACCR + +VBLK + +AASCF1: 0 ;-1 REG OR SIXBIT, 1 .ASCI 0 ASCIZ +AASCF2: 0 ;MULTIPLE WORD RETURN FLAG -1 REG 0 FINISH ! HACK 1 OUTPUT FILL WORD FOR Z +AASCFT: 0 ;0 REGULAR, -1 => .DECTXT (OUTPUT WORDS TO FILE INSTEAD OF RETURNING THEM) +TEXT4: -1 ;DELIMITER, OR -1 IF NOT INSIDE A TEXT PSEUDO. +TEXT8: 0 ;SAVED NEXT CHAR WHILE RETURNING BETWEEN WORDS +ASBP1: 0 ;IDPB TO AASBF ON .ASCII FIELD +ASBP2: 0 ;ILDB FROM AASBF " +AASBF: BLOCK 8 ;ACCUMULATED TYPEOUT OF NUMBER FOR .ASCII, EXTRA LONG FOR HACKERS TYPING OUT BINARY +ASUDS1: 0 ;UNDEFINED SYM FLAG FOR .ASCII DURING PASS 1 +AASEFW: 0 ;FILL WORD + +PBLK + +IGTXT: TLNN I,ILMWRD + RET + PUSH P,A ;ROUTINE TO EAT UP TEXT OF UNDESIRED MULTIPLE WORD + SKIPLE AASCF2 ;DETECT SCREW CASE: AFTER ASCIZ OF 5 CHARS, DELIMITER IS + JRST IGTXT1 ;ALREADY GOBBLED, BUT SOME OF THE ASCIZ REMAINS. + PUSHJ P,RCH + CAME A,TEXT4 + JRST .-2 +IGTXT1: TLZ I,ILMWRD + MOVEMM ASMDSP,ASMDS1 + SETZM DEFNPS + SETOM TEXT4 + JRST POPAJ + +;".ASCVL /X" RETURNS THE ASCII VALUE OF "X". NOTE THE DELIMITER IS NOT REPEATED +;AND SERVES ONLY TO ALLOW SPACES TO BE IGNORED WHILE WINNING IF X IS A SPACE. +A.ASCV: CALL PASSPS ;SKIP SPACES TO REACH THE DELIMITER. + CALL RCH ;READ THE CHAR AFTER THE DELIMITER + MOVE T,A + JRST TEXT5 ;AND RETURN ITS ASCII VALUE. + +ASQOZ: HLLM B,(P) ;SAVE FLAG THAT'S 0 FOR SQUOZE, -1 FOR .RSQZ . + PUSH P,SYM + PUSHJ P,AGETFD + LSH A,36 + PUSH P,A + PUSHJ P,GETSLD ;GET SYM, SAVE DELIMITER FOR REINPUT + CALL NONAME + REST A + LDB B,[4000,,SYM] ;GET JUST THE SQUOZE. + SKIPGE -1(P) + PUSHJ P,ASQOZR ;FOR .RSQZ, RIGHT-JUSTIFY IT. + SUB P,[1,,1] + ADD A,B + JRST CLBPOP + +;RIGHT-JUSTIFY THE SQUOZE WORD IN B. +ASQOZR: MOVE SYM,B + IDIVI SYM,50 + JUMPN LINK,CPOPJ ;LAST ISN'T BLANK, DONE. + MOVE B,SYM ;ELSE REPLACE BY WHAT'S SHIFTED RIGHT 1 CHAR. + JRST ASQOZR + + ;COMMON PSEUDO ROUTINE TO RETURN MIDAS INTERNAL QUANTITY + ;ADR IN LH(B)) AS VALUE (EG. .RPCNT, .FNAM1, .AVAL2, ETC. + ;INTSYMS MAY APPEAR TO LEFT OF = + +INTSYM: MOVE A,B ;GET ADR IN LH(A) + JRA A,CLBPOP ;RETURN IT + + ;.YSTGW, .NSTGW ACCORDING TO WHAT'S IN LH(B) + +STGWS: HLRES B ;.NSTGW INCREMENTS STGSW, .YSTGW DECREMENTS. + ADDB B,STGSW + SKIPGE B ;BUT DON'T DECREMENT PAST 0. + SETZM STGSW + JRST MACCR ;STORAGE WORDS ARE ALLOWED IF STGSW IS ZERO. + + ;.TYPE + +A.TYPE: PUSH P,SYM + PUSH P,SYM + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + SUB P,[2,,2] + TRNN I,IRLET ;IF SYLLABLE IS A NUMBER, + JRST [ SETO A, ;RETURN -1. + JRST CLBPOP] + PUSHJ P,ES ;EVALUATE SYM, INTERESTED IN SQUOZE FLAGS RETURNED IN A + MOVEI A,17 ;DIDN'T SKIP, RETURN 17 => UNSEEN +IFN CREFSW,XCT CRFINU + JRST CLBPOP + +NONAME: MOVE SYM,-2(P) + ETSM [ASCIZ /No arg/] + SETZ SYM, + POPJ P, + + ;.FORMAT + +A.FORMAT: PUSHJ P,AGETFD ;GET FIRST FIELD (FORMAT #) + MOVE B,CDISP ;WORD TERMINATOR ENDED 1ST ARG => + TLNN B,DWRD + JRST A.FOR1 ;RETURN CURRENT SPEC FOR THAT FORMAT. + PUSH P,A + PUSHJ P,AGETFD ;GET SECOND FIELD (TABLE ENTRY FOR FORMAT NUMBER) + POP P,B + MOVEM A,FORTAB-10(B) + JRST ASSEM1 + +A.FOR1: MOVE A,FORTAB-10(A) + JRST CLBPOP + +A.BYTE: NOVAL + CLEARM NBYTS ;# BYTES ASSEMBLED + CLEARM BYTMT ;TOTAL ACTIVE BYTES IN TABLE + MOVE A,[440700,,BYBYT] ;POINTER TO NEW TABLE + MOVEM A,BYTMP +A.BY1: PUSHJ P,AGETFD ;GET FIELD, .GE. 0 => BYTE, .LT. 0 => HOLE + MOVE C,ISAV + TRNN C,IRFLD + JRST A.BY2 ;NO FIELD + MOVM B,A + SKIPGE A + TRO B,100 + IDPB B,BYTMP + AOS BYTMT +A.BY2: TLNE CH1,DWRD ;CDISP LEFT IN CH1 BY AGETFD + JRST A.BY1 ;NOT WORD TERMINATOR + SKIPN BYTMT ;WORD TERMINATOR, ANY FIELDS? + JRST A.BY3 ;NO, DO .WALGN AND RESET TO WORD MODE + SETOM BYTM ;ENTERING BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETOM BYTM1 + PUSHJ P,BYSET + MOVE A,GLSPAS + MOVEM A,GLSP1 + JRST ASSEM1 + + ;RESET THE BYTE DESCRIPTOR TABLE POINTERS TO POINT TO NEW WORD + +BYSET: CLEARM BYTMC ;COUNT OF BYTES PROCESSED THIS TABLE SCAN + MOVE A,[440700,,BYBYT] ;POINTER TO DESCRIPTOR TABLE + MOVEM A,BYTMP + ILDB A,BYTMP ;FIRST DESCRIPTOR BYTE + AOS BYTMC + DPB A,[300600,,BYTWP] ;DEPOSIT AS FIRST BYTE SIZE + POPJ P, + +A.BY3: CLEARM BYTM ;NO LONGER IN BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETZM BYTM1 + JRST A.WAL1 + +A.WALGN: NOVAL +A.WAL1: LDB A,[360600,,BYTWP] + CAIN A,44 + JRST ASSEM1 ;ALREADY AT BEGINNING OF WORD + MOVEI A,44 + DPB A,[360600,,BYTWP] ;MAKE IT POINT TO BEGINNING OF WORD + PUSHJ P,BYSET + CLEARM T1 + JRST PBY1 + +BYTIN1: CLEARM BYTMC + MOVE A,[440700,,BYBYT] + MOVEM A,BYTMP +BYTINC: AOS A,BYTMC + CAMLE A,BYTMT + JRST BYTIN1 + ILDB A,BYTMP + DPB A,[300600,,BYTWP] + MOVEM A,T1 + HLLZ A,BYTWP + IBP A + TRNN A,-1 + JRST BYTINR + ;NEXT BYTE GOES IN NEXT WORD +PBY1: MOVE P,ASSEMP ;PCONS NEEDS THIS. + MOVEI A,WRD-1 + PUSH A,BYTW ;INTO WRD, + PUSH A,BYTRLC ;INTO WRDRLC + CLEARM BYTW + SETZM BYTRLC + MOVEI A,44 + DPB A,[360600,,BYTWP] + MOVE AA,ASMOUT + JRST @ASMOT4(AA) ;TO PBY4 OR PBY5 OR PBY3 + +PBY4: SKIPE STGSW + ETR ERRSWD + PUSHJ P,PWRD ;NOT IN CONST., OUTPUT WORD. + AOSA CLOC +PBY3: JSP T,PCONS ;OUTPUT INTO CONST. +PBY5: MOVE A,GLSPAS + MOVEM A,GLSP1 +BYTINR: MOVE A,T1 ;CURRENT BYTE SIZE + TRNN A,100 + JRST @ASMDSP + SETZB A,B ;ASSEMBLE HOLE (BLANK BYTE) IMMEDIATELY AFTER PREVIOUS BYTE + JRST PBY2 + +PBYTE: AOS NBYTS +PBY2: MOVEI AA,WRD-1 + PUSH AA,BYTW ;INTO WRD + PUSH AA,BYTRLC ;INTO WRDRLC + IBP BYTWP + LDB T,[301400,,BYTWP] + PUSHJ P,INTFLD + POP AA,BYTRLC ;WRDRLC + POP AA,BYTW ;WRD + JRST BYTINC + + ;VARIABLES FOR .BYTE, .BYTC, .WALGN + +VBLK +BYTM: 0 ;-1 FOR IN BYTE MODE, LAMBDA BOUND BY <'S, ('S, AND ['S ;] +BYTMC: 0 ;COUNT CORRESP WITH BYTMP +BYTMP: 0 ;POINTER TO BYTE DESC TABLE +BYTMT: 0 ;TOTAL ACTIVE BYTES IN TABLE +BYTM1: 0 ;GLOBAL VALUE OF BYTM - WHAT IT WAS OUTSIDE THE OUTERMOST BRACKET + +;FORMAT OF BYTE DESC TABLE +;SEVEN BIT BYTES +;1.7=0 ASSEMBLE =1 BLANK +;1.1 - 1.6 NUMBER OF BITS + +IFNDEF LBYBYT,LBYBYT==5 ;LENGTH OF BYBYT +BLCODE [BYBYT: BLOCK LBYBYT] ;BYTE DESC TABLE, 7 BITS PER DESC + +BYTWP: 440000,,BYTW ;POINTER TO BYTW IDPB TO DEPOSIT CURRENT BYTE +BYTW: 0 ;WORD BEING ASSEMBLED IN BYTE MODE +BYTRLC: 0 ;RELOC OF BYTW. +NBYTS: 0 ;NUMBER BYTES ASSEMBLED (FOR .BYTC) +BYTMCL==.-BYTMC +PBLK + +;;MACRO PROCESSOR +IFN MACSW,[ + ;GET IN B THE CHAR WHOSE ADR IS IN A, INCREMENT A + +REDINC: MOVE CH1,A + IDIVI CH1,4 + LDB B,PTAB(CH2) + AOJA A,CPOPJ + +VBLK ;THIS STUFF ALL RELOCATED WHEN MACTAB ADDR CHANGED. +PTAB: (341000+CH1)MACTBA ;BYTE TABLE + (241000+CH1)MACTBA + (141000+CH1)MACTBA + (41000+CH1)MACTBA + (341000+CH1)MACTBA+1 + + ;IN FOLLOWING MACROS, B = -1, 0, OR +1 (+ SIGN MUST BE GIVEN) + ;0 => BP SAME AS CHAR ADR, -1 => BP FOR ILDB, 1 => BP ONE AHEAD + + ;CHAR ADR IN A, RETURNS BP IN A, CLOBBERS A+1 + +DEFINE BCOMP A,B/ + IDIVI ,4 + ADD ,(+1)BCOMPT!B +TERMIN + +STOPPT: 041000,,MACTBA-1 +BCOMPT: 341000,,MACTBA + 241000,,MACTBA +BCOMPU: 141000,,MACTBA + 041000,,MACTBA + 341000,,MACTBA+1 + +;BP IN A RETURN CHAR ADR IN A, CLOBBERS A-1 (YES, A MINUS 1) +;2ND ARG IS SUBTRACTED - -1 GIVES ADDR OF THE NEXT CHAR. +DEFINE CCOMP A,B/ + MOVEI -1,0 + ASHC -1,2 + SUB ,(-1)CCOMPT!B +TERMIN + + ;BP IN A RETURN CHAR ADR IN A+1, CLOBBERS A + +DEFINE CCOMP1 A,B/ + MULI ,4 + SUB +1,(A)CCOMPT!B +TERMIN + +;FROM HERE THRU CCOMPE SET BY MACINI. +CCOMPB: 0 ;4*<41000,,MACTBA>-4 +CCOMPT: REPEAT 5,0 ;4*<41000,,MACTBA>+.RPCNT-3 +CCOMPE::PBLK + + ;BP IN A, DECREMENT IT + +DEFINE DBPM A + ADD A,[100000,,] + SKIPGE A + SUB A,[400000,,1] +TERMIN + +;SET UP CPTR FROM CHAR ADR IN A + +ACPTRS: MOVEI CH1,(A) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE COMPUTED CPTR + POPJ P, + +AFCOMP: HRRZM A,FREEPT ;ENTRY TO STORE C(A) INTO FREEPT +FCOMP: MOVE CH1,FREEPT ;COMPUTE FREPTB FROM FREEPT + BCOMP CH1,-1 + MOVEM CH1,FREPTB ;STORE CALCULATED BYTE POINTER + POPJ P, + +STPWR: MOVEI A,375 + JRST PUTREL + +VBLK +PUT377: MOVEI A,377 +PUTREL: JRST PUTRE1 ;IDPB A,FREPTB;STORE CHAR INTO FREE CHARACTER STORAGE + AOS A,FREEPT ;CLOBBERS ONLY A. + AOS PUTCNT + CAMGE A,MACHI + POPJ P, + JRST GCA +PBLK +PUTRE1: PUSH P,[IDPB A,FREPTB] + POP P,PUTREL ;COME HERE ONLY ON 1ST CALL TO PUTREL. + SETOM INICLB ;HAVE WRITTEN IN MACRO TAB & CLOBBERED INIT. + JRST PUTREL ;NOW GO BACK AND REALLY WRITE CHAR. + +;200 BIT SET ON CHAR READ FROM MACTAB, PROCESS SPECIAL CONDITION +;CLOBBERS A,CH1,CH2. + +MACTRM: CAIN A,176 ;376? + JRST RCHTRA ;376 => IGNORE, CHARACTER USED TO CLOBBER UNDESIRED CHARACTERS IN MACRO STORAGE + PUSH P,B ;SAVE B + CAIE A,177 + CAIN A,175 + JRST MRCH1 ;377, 375 => STOP + ADD A,BBASE ;DUMMY, RELOCATE TO POINT TO DUMMY TABLE + MOVEI B,RCHSAV ;RETURN TO RCHSAV ON END OF DUMMY + PUSHJ P,PUSHEM ;SAVE CURRENT STATUS + HRRZ A,(A) ;GET CHAR ADR OF DUMMY + BCOMP A,-1 ;CONVERT TO BYTE POINTER + MOVEM A,CPTR ;STORE AS NEW CPTR + MOVE A,TOPP + MOVEM A,BBASE +RCHTRB: POP P,B +RCHTRA: POP P,A ;POP RETURN + TLZN FF,FLUNRD ;IF NO CHAR TO RE-READ, JUST RETURN BACK TO THE ILDB A,UREDP. + JRST -3(A) + ANDI A,-1 ;IF A CHAR TO RE-READ, IF CALLED FROM RREOF, WE CAN RETURN TO RRU + CAIN A,RREOF+1 + JRST RRU + PUSH P,A ;OTHERWISE, CALL RCH TO RE-READ THAT CHAR, AND RETURN IT FROM + JRST RCH1 ;THE CURRENT ATTEMPT TO READ A CHAR. + +MRCH1: MOVE B,MACP +BPOPJ: POPJ B, ;RETURN AT END OF STRING EXPANSION + +;RCHSET ROUTINE TO CAUSE INPUT FROM MACRO PROCESSOR + +RCHMAC: TLO FF,FLMAC ;SET FLAG + JSP A,CPOPJ +RCHMC0: REPEAT 2,[ ;GETCHR, RR1 + ILDB A,CPTR ;GET CHAR + TRZE A,200 ;200 BIT... + PUSHJ P,MACTRM ;=> SPECIAL, PROCESS +] + .VALUE +IFN .-RCHPSN-RCHMC0,.ERR RCHMC0 LOSES. + ILDB A,CPTR ;SEMIC + TRZE A,200 + PUSHJ P,MACTRM + CAIE A,15 + JRST SEMIC ;NOT YET + JRST SEMICR ;YET + + ;PUSH INPUT STATUS IN FAVOR OF MACRO + ;B HAS RETURN ADR FOR END OF MACRO (OR WHATEVER) + ;SEE ALSO PMACP + +PUSHEM: PUSH P,A + PUSH P,F + MOVE F,MACP ;GET MACRO PDL POINTER + MOVE CH1,CPTR + CCOMP1 CH1,-1 ;CONVERT TO CHARACTER ADDRESS + HRL CH2,BBASE + PUSH F,CH2 ;PUSH BBASE,,CPTR + MOVEI A,1 ;=> EXPAND MACRO + PUSHJ P,PSHLMB ;SAVE LIMBO1 STATUS AND RETURN + JRST PSHM1 + + ;UNDO A PUSHEM + ;RETURNS BBASE,,CPTR IN B (CPTR RE-INITIALIZED, BBASE NOT) + +POPEM: PUSH P,A + PUSH P,F + MOVE F,MACP + PUSHJ P,POPLMB ;RESTORE LIMBO1 STATUS + POP F,B ;BBASE,,CPTR + MOVEI CH1,(B) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE NEW CPTR +PSHM1: MOVEM F,MACP ;STORE BACK MACRO PDL POINTER +POPFAJ: POP P,F +POPAJ: POP P,A + POPJ P, + +PMACP: MOVE B,MACP ;POP MACRO PDL + HRRZ A,(B) + SUB B,[1,,1] +IFN RCHASW,CAIE A,A.TYM8 + CAIN A,AIRR + JRST A.GO6 ;IRP OR .TTYMAC + CAIN A,REPT1 + JRST A.GO4 ;REPEAT + CAIE A,RCHSV1 ;MACRO + CAIN A,RCHSAV ;ARG + JRST A.GO6 + .VALUE ;DON'T HAVE RETURN, + JRST A.GO6 ;BUT TRY A.GO6 LIKE EVERYTHING BUT REPEAT + +A.GO4: HLLZS -1(B) ;REPEAT, CLEAR OUT COUNT REMAINING +A.GO6: TRO FF,FRMRGO ;EVERYTHING ELSE, SET FLAG TO QUIT + JRST (A) + + ;4.9(B) => .STOP ELSE .ISTOP + +A.STOP: HRRZ A,MACP + JUMPL B,A.STP1 + HRRZ B,(A) ;.ISTOP + CAIN B,REPT1 + HLLZS -2(A) ;REPEAT, STOP ALL INTERATIONS + CAIN B,AIRR + HRRZS -1(A) ;IRP TYPE, CLEAR OUT # GROUPS, DON'T ALLOW RECYCLE +A.STP1: MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP + JRST POPJ1 + +A.QOTE: JFCL +ATERMI: ETSM [ASCIZ/Not in macro/] + JRST MACCR ;MAYBE FLUSH MESSAGE IF PEOPLE HAVE PROBLEMS + +;PDL STRUCTURE FOR REPEAT +;TWO TWO WORD ENTRIES +;BBASE,,CPTR +;LIMBO1 STATUS,,# TIMES LEFT +;OLD .RPCNT,,BEG OF BODY +;GARBAGE,,REPT1 + +AREPEAT: PUSHJ P,AGETFD + JUMPLE A,COND5 ;NO REPEAT PLAY LIKE STRING COND FALSE + PUSH P,A + MOVE A,FREEPT + MOVEM A,PRREPT ;CHAR ADR BEGINNING OF REPEAT + MOVEI A,373 ;CHECK CHAR FOR REPEAT + PUSHJ P,PUTREL ;STORE AS FIRST CHR OF BODY + JSP D,RARL1 + CAIA + CALL RARGCP ;READ THE ARG & COPY INTO MACRO STORAGE. + MOVEI A,^M ;IF THE ARG WASN'T BRACKETED, + TLNE FF,FLUNRD + CALL PUTREL ;INCLUDE THE TERMINATING CR. +SWRET1: PUSHJ P,STPWR ;ALSO RETURN FROM STRING WRITE (.F .I) + POP P,B ;# TIMES TO GO THROUGH + PUSHJ P,PUSHEM + MOVE B,MACP ;NOW GET MACRO PDL POINTER FOR PUSH OF SECOND ENTRY + MOVNI T,1 + EXCH T,CRPTCT ;GET OLD .RPCNT, INITIALIZE NEW ONE TO -1 +CREPT1: SETZI TT,REPT1 + EXCH TT,PRREPT ;GET LOC BEGINNING OF BODY, CLEAR OUT PRREPT, DON'T NEED IT ANYMORE + HRL TT,T + PUSH B,TT ;SAVE OLD .RPCNT,,ADDRESS OF BODY. + PUSH B,CREPT1 ;PUSH CRUD,,REPT1 FOR RETURN + MOVEM B,MACP ;STORE BACK UPDATED MACRO POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE IMMEDIATE CYCLE + JRST MACCR + +IFN .I.FSW,[ ;CODING FOR .I, .F + +SWINI: MOVE A,FREEPT ;INITIALIZE, WILL EVENTUALLY PLAY LIKE REPEAT 1 + MOVEM A,PRREPT + MOVEI A,373 + JRST PUTREL + +SWRET: PUSH P,[1] ;REPEAT COUNT + JRST SWRET1 + +SWFLS: MOVE A,PRREPT ;FLUSH RETURN + PUSHJ P,AFCOMP + JRST MACCR +] + +;RECYCLE AROUND REPEAT + +REPT1: PUSH P,A + PUSH P,C + HRRZ A,(B) ;CHAR ADR BEG BODY + PUSHJ P,REDINC + CAIE B,373 + HALT ;FIRST CHAR OF REPEAT BODY NOT 373 + HRRZ C,MACP + HRRZ B,-2(C) ;# TIMES LEFT + SOJL B,REPT2 ;JUMP IF LAST TIME THROUGH WAS LAST TIME TO GO THROUGH + AOS CRPTCT + PUSHJ P,ACPTRS ;SET UP CPTR (CHAR ADR IN A) + HRRM B,-2(C) ;STORE UPDATED COUNTDOWN +REPT3: POP P,C + POP P,A + JRST REPT6 + +REPT2: SOS A ;MOVE BACK TO BEG OF REPEAT + ;(IN CASE GETS STORED INTO FREEPT) + MOVE CH2,CPTR + CCOMP CH2,-1 ;CONVERT TO CHARACTER ADDRESS + CAMN CH2,FREEPT + PUSHJ P,AFCOMP + MOVE A,[-3,,-2] + ADDB A,MACP + HLRZ A,1(A) + MOVEM A,CRPTCT + PUSHJ P,POPEM + JRST REPT3 + +;STRING CONDITIONALS (IFSE, IFSN) + +SCOND: MOVE A,FREEPT + MOVEM A,PRSCND + MOVEM A,PRSCN1 + PUSH P,SYM + HRRI B,SCONDF + PUSH P,B ;REMEMBER TEST INSTRUCTION. + SETOB C,SCONDF + JSP D,RARG ;COPY THE 1ST OF THE 2 STRINGS + CAIA + CALL RARGCP ;INTO MACRO STORAGE, FOLLOWED BY 375. + CALL STPWR + JSP D,RARG ;THEN START READING THE 2ND ARG, + JRST SCOND3 ;GO TO SCOND3 WHEN REACH END OF 2ND ARG. + JSP D,RARGCH(T) ;READ NEXT CHAR OF 2ND ARG, + JRST SCOND3 + EXCH A,PRSCND + PUSHJ P,REDINC ;RE-FETCH NEXT CHAR OF 1ST ARG + EXCH A,PRSCND + CAMN B,A ;COMPARE CHARACTERS + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CAIL A,"A+40 + CAILE A,"Z+40 ;NOT EQUAL => CONVERT BOTH TO UPPER CASE. + CAIA + SUBI A,40 + CAIL B,"A+40 + CAILE B,"Z+40 + CAIA + SUBI B,40 + CAMN B,A ;ARE THEY SAME EXCEPT FOR CASE? + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CLEARM SCONDF ;STRINGS DIFFER + CALL RARFLS ;IGNORE REMAINDER OF 2ND ARG. +SCOND3: CLEARB A,C ;END OF (SECOND) STRING ARG ENCOUNTERED + EXCH C,PRSCN1 + MOVEM C,FREEPT + PUSHJ P,FCOMP + EXCH A,PRSCND + PUSHJ P,REDINC + CAIE B,375 + CLEARM SCONDF + REST B + REST SYM + XCT B ;DO THE TEST. + JRST COND4 + JRST COND2 + +VBLK +BLCODE [DMYDEF: BLOCK DMDEFL] ;TABLE OF DUMMY NAMES FOR THING BEING DEFINED +DMYTOP: DMYDEF ;POINTER INTO DMYDEF, POINTS TO AVAILABLE WORD + ;SINCE ONLY ONE THING CAN BE DEFINED AT ONCE, IT IS NOT NECESSARY TO SAVE AND RESTORE DMYTOP +DMYBOT: DMYDEF ;-> 1ST DMYDEF WD USED AT THIS LEVEL. + ;RIGHT NOW, ALWAYS -> DMYDEF SINCE CAN'T HAVE DEFINITION + ;WITHIN A DEFINITION YET. + +PBLK + +PDEF: PUSHJ P,GSYL ;READ IN SYL + CAIE T,", ;IF DELIMITING CHR NOT , + JUMPE SYM,CPOPJ ;AND SYM NULL, RETURN +PDEF1: MOVEM SYM,@DMYTOP ;STORE SYM + AOS D,DMYTOP ;INCR PNTR + CAIL D,DMYDEF+DMDEFL ;CHECK FOR TABLE SIZE EXCEEDED + ETF [ASCIZ/Too many dummies in DEFINE or IRP/] + POPJ P, + +VBLK +BLCODE [DSTG: BLOCK DSSIZ] ;TABLE OF CHAR ADRS OF DUMMIES BEING DEFINED PRIOR TO MACRO EXPANSION +RDWRDP: DSTG ;POINTER TO DSTG, POINTS TO FREE WORD + ;NOTE THAT RDWRDP MUST BE SAVED AND RESTORED SINCE MORE MACROS CAN + ;BE EXPANDED DURING FIELD READ FOR DUMMY +PBLK + +ADDTR1: CLEARM PUTCNT +ADDTRN: MOVE A,FREEPT +ADDTR2: MOVEM A,@RDWRDP + AOS A,RDWRDP + CAIL A,DSTG+DSSIZ + ETF [ASCIZ/Too many dummies in all macros & IRPs being expanded/] + RET + +VBLK +BLCODE [DMYAGT: BLOCK DMYAGL] ;TABLE OF CHAR ADRS OF DUMMYS OF MACROS BEING EXPANDED + ;DMYAGT TRACKS WITH THE MACRO PDL; + ;DMYAGT CAN'T BE COMBINED WITH DSTG SINCE DMYAGT CAN BE SHIFTING AROUND RANDOMLY DURING ARG SCAN +BBASE: DMYAGT ;POINTER TO BEGINNING OF ACTIVE DUMMY LIST (FOR DEEPEST-NESTED MACRO BEING EXPANDED) + ;ADD TO DUMMY # TO GET LOCATION CONTAINING CHAR ADR OF DUMMY +TOPP: DMYAGT ;POINTER TO TOP OF DMYAGT ACTIVE, POINTS TO FREE REGISTER +PBLK + + ;ACTIVATE DUMMYS ON TOP OF DSTG TABLE + ;A -> FIRST (LOWEST) DUMMY IN DSTG TO ACTIVATE + +DMYTRN: MOVE B,TOPP + MOVEM B,BBASE + PUSH P,A +DMYTR2: CAML A,RDWRDP + JRST DMYTR1 + MOVE B,(A) + MOVEM B,@TOPP + AOS B,TOPP + CAIL B,DMYAGT+DMYAGL + ETF [ASCIZ /Too many dummy args active/] + AOJA A,DMYTR2 +DMYTR1: POP P,RDWRDP + POPJ P, + +;THE MACRO TABLE IS FILLED MAINLY WITH 8-BIT BYTES. +;THE FIRST WORD'S ADDR IS IN MACTAD; THE LAST+1'S IN MACTND. +;THE CHARACTER NUMBER OF THE LAST+1ST CHAR IS IN MACHI. +;MACHIB IS BP. TO HIGHEST BYTE OK TO FILL (LAST IN C(MACTND)-1) + +;IF A BYTE IN THE TABLE HAS ITS HIGH BIT OFF, IT IS AN ASCII CHARACTER. +;OTHERWISE, IT IS SPECIAL. IF THE 100 BIT IS OFF IT MEANS +;SUBSTITUTE A MACRO DUMMY ARG WHEN READ; THE CHAR IS THE NUMBER OF THE ARG+200 . + +;377 AND 375 ARE STOP CODES, CAUSING A POP OUT OF THE CURRENT STRING. +;GC CONSIDERS THE CHAR. AFTER A 375 TO START A NEW STRING. + +;376 IS IGNORED WHEN READ; USED TO CLOBBER UNWANTED CHARACTERS IN STRINHGS. + +;374 STARTS EVERY MACRO-DEFINITION. +;373 STARTS THE BODY OF A REPEAT. + +;370 STARTS A WORD STRING: +;THE WORD AFTER THAT WHICH CONTAINS THE 370 +; HAS THE LENGTH IN WORDS OF THE STRING IN ITS LH, +; IN ITS RH, THE ADDRESS OF WD WHICH POINTS BACK TO THIS ONE. +; THEN FOLLOW RANDOM WDS HOLDING ANYTHING AT ALL. +; GC WILL MAKE SURE IT STAYS ON WD BOUNDARY. +; THE LENGTH INCLUDES THE WD HOLDING THE LENGTH. +; IF THE RH OF 1ST WD HAS 0, GC WILL FLUSH THE STRING + +STRTYP: PUSHJ P,REDINC ;DEBUGGING AID ONLY + EXCH A,B + TRZE A,200 + JRST STRTP1 +STRTP2: PUSHJ P,TYO ;NORMAL CHAR, JUST TYPE OUT + MOVE A,B + JRST STRTYP + +STRTP1: PUSH P,A + MOVEI A,"* ;SPECIAL CHAR, TYPE * + PUSHJ P,TYO + POP P,A + TRNE A,100 + JRST STRTP3 ;CONTROL CHAR + ADDI A,260 ;DUMMY, CONVERT TO # + JRST STRTP2 ;TYPE OUT (SINGLE DIGIT) NUMBER + +STRTP3: CAIN A,175 + SKIPA A,C% ;STOP, TYPE % + MOVEI A,"/ ;SOMETHING ELSE, TYPE / + JRST STRTP2 + + + ;.GSSET, SET GENERATED SYM COUNTER + +A.GSSET: CALL AGETFD + MOVEM A,GENSM + JRST ASSEM1 + +;GSYL-LIKE ROUTINE, READ A SYL FOR WRQOTE + +WRQRR: PUSHJ P,RCH ;GET CHAR (MAYBE WANT THIS TO BE FASTER YET) + IDPB A,FREPTB ;DEPOSIT IN MACRO TABLE + CAMN F,FREPTB ;WAS THIS LAST CHAR IN TABLE? + JRST WRQRGC ;YES, NEED GARBAGE COLLECTION +WRQRR2: XCT GDTAB(A) ;DISPATCH ON CHAR + JFCL ;(MAYBE SKIPS) + SOJGE D,WRQRR ;LOOP FOR FIRST SEVEN CHARS + HRRI D,0 + JRST WRQRR + + ;HERE FROM WRQRR WHEN NEED GARBAGE COLLECTION OF MACRO TABLE + +WRQRGC: MOVEM C,WRQTBP ;PUT POINTER TO BEGINNING OF SYL WHERE IT WILL BE GC'D + MOVE A,MACHI + PUSHJ P,GCA ;GARBAGE COLLECT + MOVE F,MACHIB ;RESET F TO POINT TO NEW LAST CHAR IN MACTAB + MOVEI C,0 + EXCH C,WRQTBP ;GET BACK POINTER TO CHAR BEFORE SYL + MOVE A,LIMBO1 ;RETRIEVE LAST CHAR READ + JRST WRQRR2 ;LOOP BACK, PROCESS CHAR + + ;HERE FROM WRQOTE IF .QUOTE SEEN + ;.QUOTE TAKES ARG LIKE ASCII, PRINTC, ETC. + +A.QOT1: MOVE A,WRQBEG(P) ;GET BACK BP TO CHAR BEFORE .QUOTE + PUSHJ P,A.QOTS ;SET UP FREEPT AND FREPTB PROPERLY + MOVE A,LIMBO1 ;NOW GET CHAR AFTER .QUOTE + CAIE A,^I + CAIN A,40 ;COMPARE WITH SPACE + PUSHJ P,RCH ;SPACE, GOBBLE NEXT CHAR FOR DELIMITER, ELSE THIS ONE + MOVEM A,A.QOT2 ;STORE AS TERMINATOR OF STRING +A.QOT3: PUSHJ P,RCH ;GET CHAR TO QUOTE + CAMN A,A.QOT2 ;TERMINATOR? + JRST WRQOT1 ;TERMINATOR, BACK FOR MORE DEFINITION + PUSHJ P,PUTREL ;DEPOSIT CHAR + JRST A.QOT3 + +;READ IN BODY OF MACRO, IRP, OR WHATEVER + +WRQOTE: PUSH P,[0] ;USED FOR LENGTH OF SYMBOL (REALLY 6 MINUS IT). +WRQLEN==,-2 + PUSH P,[0] ;THIS WD USED FOR DEFINE/TERMIN COUNT. +WRQLVL==,-1 + PUSH P,[0] ;USED TO REMEMBER BEGINNING OF SYMBOL. +WRQBEG==0 + SETOM INICLB ;CLOBBERED INITS, .SYMTAB NOW ILLEGAL. + PUSHJ P,RCH ;MAYBE POP UP A LEVEL IN EXPANSIONS, SAVE MACTAB SPACE + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-INPUT + MOVE F,MACHIB ;POINTER TO LAST CHAR OK TO PUT IN MACTAB, STAYS IN F + TRO I,IRSYL\IRLET ;MAKE SURE FLAGS SET SO WON'T WASTE TIME AT MAKNUM, POINT +WRQOT0: +WRQOT1: MOVEI D,6 ;SQUOZE COUNTER + MOVEI SYM,0 ;INITIALIZE SYM + MOVE C,FREPTB ;GET POINTER TO CHAR BEFORE SYL ABOUT TO READ + PUSHJ P,WRQRR ;READ SYL + JUMPE SYM,.-2 ;LOOP UNTIL NON-NULL + ;NOW SEE IF DUMMY; **NOTE**: C STILL HAS BYTE POINTER, A SYL TERMINATOR + MOVE B,DMYBOT + CAML B,DMYTOP + JRST WRQOT2 ;NOT DUMMY + CAME SYM,(B) ;COMPARE WITH DUMMY NAME + AOJA B,.-3 ;LOOP ON NO MATCH + SUB B,DMYBOT ;DUMMY, CONVERT TO NUMBER + 200 + SUBI B,200 + LDB T,C ;GET LAST CHAR BEFORE SYL + CAIE T,"! ; ^ NOTE THAT THIS CAN LOSE IF MACRO HAS 33. ARGS + IDPB B,C ;NOT EXCLAMATION POINT, LEAVE THERE, DEPOSITING DUMMY CHAR + CAIN T,"! + DPB B,C ;EXCL, WIPE IT OUT + MOVEM C,FREPTB ;RESET FREPTB + CAIE A,"! ;A HAS DUMMY TERMINATOR, COMPARE WITH EXCL + TLO FF,FLUNRD ;NOT EXCLAMATION POINT, CAUSE IT TO BE RE-INPUT + JRST WRQOT1 ;LOOP BACK FOR NEXT SYL + +;SYL ISN'T DUMMY, CHECK FOR PSEUDO +WRQOT2: MOVEM D,WRQLEN(P) ;REMEMBER START OF AND LENGHTH OF THE SYMBOL. + MOVEM C,WRQBEG(P) + SETOM ESBK ;EVAL IN CURRENT BLOCK. + PUSHJ P,ES ;EVALUATE SYM (DOESN'T CLOBBER F) + JRST WRQOT0 ;NOT SEEN + CAIE A,PSUDO/40000 + JRST WRQOT0 ;NOT PSEUDO + TLZ B,-1 ;CLEAR OUT LH OF VALUE, ONLY INTERESTED IN RH + CAIN B,A.QOTE + JRST A.QOT1 ;.QUOTE + CAIE B,ADEFINE + CAIN B,AIRP + AOS WRQLVL(P) ;DEFINE OR IRP +IFN RCHASW,[CAIN B,A.TTYM + AOS WRQLVL(P) ;.TTYMAC +] + CAIE B,ATERMIN + JRST WRQOT0 + SKIPGE WRQLEN(P) + ETR [ASCIZ /TERMIN longer than 6 chars/] + SOSL WRQLVL(P) ;TERMIN, SKIP IF THE TERMINATING ONE + JRST WRQOT0 ;NOT MATCHING TERMIN, BACK FOR NEXT SYL + POP P,A ;GET BACK BP TO LAST CHAR BEFORE TERMIN + SUB P,[2,,2] .SEE WRQLVL,WRQBEG + MOVE T,DMYBOT ;WE'RE NO LONGER USING SPACE IN DMYDEF. + MOVEM T,DMYTOP +A.QOTS: LDB T,A ;HERE ALSO FROM A.QOT1, GET CHAR BEFORE .QUOTE OR TERMIN + CAIE T,"! + JRST A.QTS2 ;NOT EXCLAMATION POINT => OK + DBPM A, ;EXCLAMATION POINT, DECREMENT POINTER +A.QTS2: MOVEM A,FREPTB ;STORE AS NEW FREPTB + CCOMP1 A,-1 ;CONVERT TO CHAR ADR + MOVEM B,FREEPT ;STORE CHAR ADR AS NEW FREEPT + POPJ P, + +;FORMAT OF A MACRO: +;IT STARTS WITH A 374. +;THEN COME ARGUMENT DESCRIPTORS, ONE PER ARGUMENT. +MCF==777650 ;BITS AND FIELDS ARE: +MCFDEF==200 ;ARG IS DEFAULTED. MCFDEF AND MCFGEN NEVER BOTH SET. +MCFGEN==100 ;ARG SHOULD BE GENSYMMED IF NOT GIVEN IN CALL. +MCFKWD==40 ;ARG IS A KEYWORD ARG, SELECTED BY = RATHER THAN POSITION. +MCFSYN==7 ;FIELD THAT SPECIFIES THE ARGUMENT'S SYNTAX. + MCFNRM==1 ;MCFSYN CONTAINS MCFNRM => NORMAL-SYNTAX ARG + MCFLIN==2 ;MCFSYN CONTAINS MCFLIN => WHOLE LINE ARG + MCFBAL==3 ;MCFSYN CONTAINS MCFBAL => BALANCED ARG + MCFSTR==4 ;MCFSYN CONTAINS MCFSTR => ARG IS A DELIMITED STRING, AS IN "ASCIZ". + MCFKST==5 ;MCFSYN CONTAINS MCFKST => JUST LIKE MCFSTR, BUT DELIMITERS ARE RETAINED. + MCFEVL==6 ;MCFSYN CONTAINS MCFEVL => ARG IS BY VALUE (PREEVALUATED). +;IF MCFKWD IS SET, THE DESCRIPTOR IS FOLLOWED BY THE NAME OF THE ARGUMENT, +;TERMINATED BY A 377. +;IF MCFDEF IS SET, THE DESCRIPTOR IS FOLLOWED BY THE DEFAULT VALUE OF THE ARG, +;TERMINATED BY A 377. +;IF MCFKWD AND MCFDEF ARE BOTH SET, THE ARG NAME COMES FIRST. +;A ZERO BYTE ENDS THE DESCRIPTOR LIST. +;THEN COMES THE BODY OF THE MACRO, FOLLOWED BY A 375. + +ADEFINE: NOVAL ;ERROR IF CONTEXT WANTS A VALUE. + PUSH P,CASSM1 ;RETURN TO ASSEM1 EVENTUALLY + JSP TM,ERMARK ;ERR MSGS SHOULD SAY WE'RE INSIDE A DEFINE. + PUSH P,SYM ;THESE 2 PUSHES ARE FOR NONAME'S SAKE. + PUSH P,SYM + CALL GETSLD + CALL NONAME + TLZ FF,FLUNRD + SUB P,[2,,2] + PUSH P,SYM + PUSH P,ESBK ;SAVE BLOCK TO DEFINE IN FOR ES'S SAKE. +IFN CREFSW,XCT CRFMCD + CALL A.TYM1 + POP P,ESBK + REST SYM + PUSHJ P,ESDEF ;FIND SLOT IN SYMBOL TABLE FOR IT + TLO C,3MACOK ;NEVER SEEN, OK TO MAKE MACRO. + TLON C,3MACOK ;ELSE ERROR IF NUMERIC OR ALREADY USED. + ETSM [ASCIZ/Non-macro made macro/] + MOVEI B,MACCL ;RH(VALUE) = MACCL + HRL B,PRDEF ;LH(VALUE) = CHAR ADR OF MACRO + CLEARM PRDEF ;NO LONGER NEED PRDEF + MOVSI T,PSUDO ;SYMBOL TABLE ENTRY LOOKS LIKE PSEUDO + JRST VSM2 + +IFN RCHASW,[ + ;.TTYMAC NAME + ;BODY + ;TERMIN + + ;NAME DUMMY, CAUSES READIN OF CRUD FROM TTY -> CR (NOT INCLUSIVE) + +A.TTYM: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WE'RE INSIDE A .TTYMAC + CALL A.TYM1 ;READ IN A MACRO-DEFINITION. + MOVEI A,40 ;DON'T LET THE CHAR ENDING THE TERMIN + MOVEM A,LIMBO1 ;MAKE MACCL THINK THERE ARE NO ARGS. + CALL GTYIP1 ;PUSH INTO TTY FOR INPUT + HRLZ B,PRDEF ;PHONY UP A MACRO WHOSE DEFN IS WHAT WE READ. + SETZM PRDEF + MOVEI A,A.TYM8 + JRST A.TYM2 ;CALL THE MACRO: + ;READ THE ARGS, POP OUT OF TTY, EXPAND THE MACRO + ;AND THEN EXIT TO A.TYM8 +] + +A.TYM1: MOVE A,FREEPT + MOVEM A,PRDEF + MOVEI LINK,MCFNRM ;INITIALLY, DUMMIES ARE NORMAL. + MOVEI A,374 + PUSHJ P,PUTREL ;MARK BEGINNING OF MACRO +DEFNI: MOVE T,LIMBO1 + MOVE A,LINK +DEFNC: CAIE T,12 + CAIN T,15 + JRST DEFNA ;NO MORE ARGS (DONE WITH LINE) + CAIE T,LBRACE + CAIN T,LBRKT + JRST DEFNB1 + CAIE T,RBRACE + CAIN T,RBRKT + JRST DEFNB2 + CAIE T,"< ;OPENS TURN ON BALANCEDNESS. + CAIN T,"( + JRST DEFNB1 + CAIE T,"> ;CLOSES TURN OFF BALANCEDNESS. + CAIN T,") + JRST DEFNB2 + CAIN T,"? ;? TURNS BALANCEDNESS ON OR OFF. + JRST DEFBAL + CAIN T,"+ ;+ COMPLEMENTS KEYWORDNESS + XORI LINK,MCFKWD + CAIN T,"\ ;\ COMPLEMENTS GENSYMMEDNESS + XORI LINK,MCFGEN + CAIN T,"- ;- TURNS WHOLELINENESS ON OR OFF. + JRST DEFWHL + CAIN T,"* ;* TURNS ASCIZ-STYLE-NESS ON OR OFF. + JRST DEFASC + CAIN T,"& ;& TURNS KEEP-STRUNGNESS ON OR OFF. + JRST DEFKST + CAIN T,"# ;# TURNS EVALUATEDNESS ON OR OFF. + JRST DEFEVL + CAIN T,": ;: MAKES FOLLOWING ARGS NORMAL + MOVEI LINK,MCFNRM ;IN ALL RESPECTS + CAIN T,"; + JRST DEFNSM ;ALLOW DEFINE LINE TO BE COMMENTED +DEFND: PUSH P,A + CALL GSYL ;READ IN SYMBOL AS SQUOZE IN SYM. + REST A + CAIN T,"/ ;/ MEANS PREVIOUS ARG IS WHOLE-LINE. + XORI LINK,MCFLIN#MCFNRM + JUMPE SYM,DEFNC ;JUMP IF SYMBOL NAME WAS NULL. + CALL PDEF1 ;ELSE PUSH IT ON LIST OF DUMMIES. + MOVE A,LINK + CAIE T,"= + JRST DEFNL + IORI A,MCFDEF ;ONE ARG, WITH DEFAULT VALUE. + ANDCMI A,MCFGEN ;NOT TO BE GENSYMMED. +DEFNL: CALL PUTREL ;OUTPUT A DESCRIPTOR FOR THIS ARG + TRNE LINK,MCFKWD + CALL DEFNM ;PUT OUT ARG NAME IF KWD ARG + CAIE T,"= ;THEN DEFAULT VALUE IF DEFAULTED. + JRST DEFNI + JSP D,RARG ;INIT. FOR READING THE DEFAULT VALUE. + CAIA + CALL RARGCP ;COPY THE ARG INTO MACRO SPACE, + CALL PUT377 ;TERMINATED BY A 377. + JRST DEFNI ;NOW FOR THE NEXT ARG. + +DEFNM: MOVE D,[440700,,STRSTO] +DEFNM1: ILDB A,D + CAMN D,STRPNT + JRST PUT377 + CALL PUTREL + JRST DEFNM1 + +DEFEVL: SKIPA A,[MCFEVL] ;TURN EVALUATEDNESS ON OR OFF. +DEFASC: MOVEI A,MCFSTR ;TURN ASCIINESS ON OR OFF. + JRST DEFN9 +DEFKST: MOVEI A,MCFKST ;TURN KEEP-STRUNGNESS ON OR OFF. + JRST DEFN9 +DEFBAL: SKIPA A,[MCFBAL] ;TURN ON BALANCEDNESS, BUT IF ALREADY ON TURN OFF. +DEFWHL: MOVEI A,MCFLIN ;SIMILAR FOR WHOLELINENESS. +DEFN9: LDB B,[.BP MCFSYN,LINK] + CAMN A,B ;IF CURRENT STATE IS SAME AS IN A, + MOVEI A,MCFNRM ;SWITCH TO NORMAL MODE INSTEAD. + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNB2: SKIPA A,[MCFNRM] ;TURN OFF BALANCEDNESS +DEFNB1: MOVEI A,MCFBAL ;TURN ON BALANCEDNESS + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNSM: PUSHJ P,RCH ;SEMICOLON IN DEFINE LINE + CAIE A,15 + CAIN A,12 +DEFNA: SKIPA A,LINK ;END OF DEFINE LINE, GET COUNT + JRST DEFNSM + MOVEI A,0 + PUSHJ P,PUTREL ;DEPOSIT END-OF-DESCRIPTORS MARK + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD ;CHAR AFTER CR NOT LF + PUSHJ P,WRQOTE ;READ IN BODY + JRST STPWR + +;COME HERE TO EXPAND MACRO; LH OF B POINTS TO STRING. +;SYM HOLDS NAME OF MACRO (USED BY CALL TO AGETFD IN MACEVL). +MACCL: JSP TM,ERMARK ;ERROR MESSAGE DURING ARG SCAN SHOULD SAY WE'RE IN IT. + MOVEI A,RCHSV1 +A.TYM2: PUSH P,I + AOS PRCALP + AOS MDEPTH + PUSH P,RDWRDP + PUSH P,A ;RCHSV1 FOR MACRO, A.TYM8 FOR .TTYMA + MOVEI LINK,0 + HLRZ A,B + PUSHJ P,REDINC + CAIE B,374 + HALT + MOVEM A,@PRCALP + PUSHJ P,REDINC + TLZ I,ILPRN + JUMPE B,MACCLE ;MACRO TAKES NO ARGS => UN-READ NEXT CHARACTER. + MOVE A,LIMBO1 + CAIE A,") ;MACRO NAME TERMINATED WITH A CLOSE-BRACKET OF SOME SORT + CAIN A,"> ;=> UN-READ THE FOLLOWING CHARACTER. + JRST MACCLE + CAIN A,RBRKT + JRST MACCLE + CAIE A,15 ;MACRO NAME ENDED BY A CR OR LF => + CAIN A,12 + JRST MACCLD ;NO ARGS IN THIS CALL; NULLIFY ALL ARGS. + CAIE A,"< + CAIN A,"( + TLO I,ILPRN ;BUT MAYBE THERE IS A (. IF SO, IT'S A PAREN'D CALL, + CAIN A,LBRKT ;AND WON'T END TILL THE MATCHING CLOSE. + TLO I,ILPRN + CAIE A,40 ;IF THE CHAR ENDING THE MACRO NAME ISN'T AN OPENPAREN, + CAIN A,^I ;EOL, OR SPACE, RE-READ IT AS PART OF 1ST MACRO ARG. + JRST MACNX0 + TLNN I,ILPRN + TLO FF,FLUNRD +MACNX0: TDZ LINK,LINK +MACNXD: CALL MACDES ;FETCH NEXT DESCRIPTOR + JRST MACPUS ;NO MORE => THIS IS END OF THE CALL + TRNE LINK,MCFKWD + JRST MACK ;KEYWORD PARAM => SPECIAL SCANNER +;READ IN THE VALUE OF THE NEXT ARG, WHICH IS NORMAL (NOT KEYWORD) +MACNRM: CALL ADDTRN ;PUSH WORD TO HOLD VALUE OF ARG ONTO DSTG, + ;INITIALIZED -> FREEPT, WHERE WE WILL NOW WRITE THE ARG. + SOS C,A ;TELL MACRED WHERE THAT WORD IS. + CALL MACRED ;READ IN THE ARGUMENT VALUE. + JRST MACNXD ;THEN HANDLE ANOTHER ARG + .VALUE + JRST MACCLD ;END OF ARG LIST => NULLIFY REMAINING ARGS. + +MACCLE: TLO FF,FLUNRD ;SAVE CHR FOLLOWING MACRO W/NO ARGUMENTS + ;AND IF THAT CHAR WAS A CLOSE-BRACKET, + SKIPE B,ASMOUT ;CLEAR OUT THE CHANGE IT MADE TO ASMDSP. + CAIN B,4 + CAIA + JSP LINK,SAVAS2 + SETZ LINK, + JRST MACCLD ;NOW GO NULLIFY ANY ARGS THE MACRO WANTED, AND EXIT. + +;READ IN THE NEXT MACRO ARGUMENT ACC TO SYNTAX FLAGS IN LINK. +;C HAS ADDRESS OF WORD ON THE RDWRDP STACK WHICH HOLDS THE POINTER TO THIS ARG +;IN CASE WE WISH TO SET THE ARG TO THE NULL STRING. B AND LINK NOT CLOBBERED. +;RETURNS SKIPPING TWICE IF NO ARG BECAUSE END OF MACRO CALL SEEN. +MACRED: MOVEI D,MACNXR ;RARL3, RARB, RARGBR RETURN TO MACNXR + CALL RCH + CAIE A,^M + CAIN A,^J + JRST MACEND ;MAYBE WE HAVE REACHED THE END OF THE MACRO CALL. + LDB B,[.BP MCFSYN,LINK] + CAIN B,MCFLIN + JRST RARL3 ;ELSE, IF WHOLELINE ARG, NOTHING ELSE TO CHECK, + ;SO INIT FOR READING IT IN. + CAIN A,", + JRST MACNUL ;NON-WHOLELINE ARG IS NULL IF NEXT CHAR IS COMMA + CAIN A,"; ;SEMICOLON ENDS ARG LIST UNLESS INSIDE WHOLELINE ARG + JRST MACEND + CAIN B,MCFBAL + JRST RARB ;FOR BALANCED ARG, NOTHING ELSE SPECIAL, SO INIT. + CAIE B,MCFSTR ;FOR BOTH FLAVORS OF STRUNGNESS, + CAIN B,MCFKST ;GO GOBBLE AN ASCIZ-STYLE ARGUMENT. + JRST MACSTR + CAIN B,MCFEVL ;FOR EVALUATED ARG, READ FIELD AND EXPRESS AS NUMERAL. + TLOA FF,FLUNRD ;AND THE CHAR WE JUST READ WAS THE 1ST CHAR OF THE FIELD. + CAIN A,"\ ;NORMAL ARG STARTING WITH "\" TREATED THE SAME WAY, BUT FIELD + JRST MACEVL ;STARTS WITH NEXT CHAR. + CAIN A,LBRKT + JRST RARGBR ;FOR ORDINARY ARG, OPEN-BRACKET MAKES IT SPECIAL +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + MOVEI T,RARGN ;OTHERWISE IT'S A NORMAL ARG + TLOA FF,FLUNRD ;AND THE CHAR WE RCH'ED IS THE 1ST CHAR OF IT +MACNXR: JRST MACEN1 ;NON-SKIP RETURN FROM RARB, RARL3 OR RARGBR => ARG NULL + CALL RARGCP ;ARG NON-NULL => COPY IT INTO STRING SPACE + CAIE A,"; +CSTPWR: JRST STPWR ;AND TERMINATE IT +MACSC: MOVE A,(C) ;EXCEPT THAT SEMICOLONS INVALIDATE ALL THE SPACES + CAME A,FREEPT ;AND TABS THAT PRECEDE THEM. + JRST STPWR ;IF, AS A RESULT OF THAT, THE ARG IS NULL, END THE ARGLIST. +;COME HERE WHEN THE END OF THE MACRO'S WHOLE ARGLIST IS SEEN. +MACEND: TLO FF,FLUNRD +MACEN1: AOS (P) ;2-SKIP RETURN FROM MACRED INDICATES END OF ARGLIST + AOS (P) ;END OF ARGLIST => THIS ARG IS NULL. +;COME HERE TO NULLIFY CURRENT ARG (WHERE C POINTS) +MACNUL: TRZE LINK,MCFDEF + JRST MACDEF ;MAYBE DEFAULT IT + TRNE LINK,MCFGEN + JRST MACGEN ;MAYBE GENSYM IT + SETZM (C) ;ELSE SET TO NULL STRING. + RET + +MACST1: CALL RCH + CAIN A,", + JRST MACNUL +MACSTR: CAIE A,40 ;HERE FOR ARG DELIMITED LIKE TEXT STRINGS: /TEXT/. + CAIN A,^I ;SKIP ALL SPACES AND TABS BEFORE THE ARG. + JRST MACST1 + JSP D,RARB ;FIND END OF LINE, COMMENT, OR CLOSEBRACKET => + JRST MACEND ;NULLIFY ARG AND END MACRO CALL. + MOVEI T,(A) ;ELSE SAVE THIS CHAR; IT'S THE DELIMITER. + TLZ FF,FLUNRD ;DON'T RE-READ DELIMITER, + CAIN B,MCFKST ;BUT IF ARG IS KEEP-STRUNG, DROP THRU TO STORE IT. +MACST2: CALL PUTREL + CALL RCH ;READ ANOTHER CHARACTER. IF IT ISN'T THE DELIMITER, + CAIE A,(T) + JRST MACST2 ;STORE IT AND READ ANOTHER. + CAIN B,MCFKST ;HIT DELIMITER, DONE. BUT IF ARG IS KEEP-STRUNG, + CALL PUTREL ;KEEP DELIMITER BY STORING IT TOO. + CALL STPWR +MACST3: CALL RCH ;PASS BY SPACES AFTER THE CLOSING DELIMITER + CAIE A,40 + CAIN A,^I + JRST MACST3 + CAIE A,", ;COMMA HERE ENDS THE ARG BUT NOT THE MACRO CALL. + JSP D,RARB ;ELSE CHECK FOR OTHER TERMINATORS. + RET ;WE FOUND AN ACCEPTABLE ARG TERMINATOR. + ETR [ASCIZ /Garbage in ASCIZ-style macro arg/] + JRST RARFLS ;IF THERE'S ANYTHING ELSE, COMPLAIN AND SKIP IT. + +;COME HERE TO GIVE AN ARG ITS DEFAULT VALUE. +;MCFDEF WAS CLEARED SO MACDES WILL KNOW THE DEFAULT VALUE HAS +;ALREADY BEEN PASSED OVER AND WON'T TRY TO SKIP OVER IT. +;IF MCFKWD IS SET, WE MUST SKIP OVER THE KWD ARG'S NAME FIRST. +MACDEF: TRZN LINK,MCFKWD + JRST MACDF1 + MOVE A,@PRCALP +MACDF0: CALL REDINC ;SKIP ARG NAME IF KEYWORD ARG. + CAIE B,377 + JRST MACDF0 + MOVEM A,@PRCALP +MACDF1: MOVE A,@PRCALP ;COPY THE DEFAULT VALUE AS THE ARGUMENT VALUE. + CALL REDINC ;AS THE ARGUMENT STRING. + MOVEM A,@PRCALP + CAIN B,377 + JRST STPWR ;END OF THE DEFAULT VALUE. + EXCH A,B + CALL PUTREL + EXCH A,B + JRST MACDF1 + +;COME HERE IF GENSYMMABLE ARG IS SPEC'D AS NULL. +MACGEN: MOVEI A,5 + MOVEM A,SCKSUM + MOVEI A,"G + PUSHJ P,PUTREL + PUSH P,CSTPWR + AOS A,GENSM + IDIVI A,10 + HRLM B,(P) + SOSLE SCKSUM + PUSHJ P,.-3 + JRST MACEV2 + +;PROCESS ARG THAT STARTS WITH \, OR #-TYPE ARG. +MACEVL: CALL RCH ;FIRST, CHECK FOR IMMEDIATE END OF MACRO CALL. + JSP D,RARB + JRST MACEN1 + PUSH P,C + PUSH P,LINK ;SAVE LINK, NEED FLAGS + PUSHJ P,AGETFD ;GET THE FIELD + SKIPE B + ETR [ASCIZ /Relocatable \'d macro arg/] + POP P,LINK + REST C ;IF AGETFD EXPANDED A MACRO, FREEPT HAS CHANGED, SO + MOVE CH1,FREEPT ;PUT NEW VALUE INTO THE POINTER TO THIS DUMMY. + MOVEM CH1,(C) + MOVE CH1,A ;SAVE VALUE OF FIELD FROM CLOBBERAGE + PUSH P,CSTPWR +MACEV1: LSHC CH1,-35. ;NOW "TYPE OUT" VALUE OF FIELD IN CURRENT RADIX + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,MACEV1 +MACEV2: HLRZ A,(P) + ADDI A,60 + JRST PUTREL ;OUTPUT TO MACTAB STRING BEING DEFINED + +;HANDLE KEYWORD PARAMETERS. COME HERE WHEN A DESCRIPTOR IS SEEN +;THAT SPECIFIES A KEYWORD PARAMETER. +MACK: PUSH P,RDWRDP + MOVE A,@PRCALP ;PUSH A COPY OF POINTER TO 1ST KWD ARG'S DESCRIPTOR + AOS PRCALP ;SO WE CAN ADVANCE THE COPY WHILE KEEPING ORIGINAL FIXED. + MOVEM A,@PRCALP + PUSH P,LINK +;FIRST, PUSH A "NOT SET" MARKER FOR EACH OF THE KEYWORD PARAMS IN THIS RUN OF SUCH. +MACK2: SETO A, + CALL ADDTR2 + CALL MACDES ;NOTE THAT THERE IS ONLY ONE PARAM PER DESCRIPTOR + JRST MACK1 ;FOR KEYWORD PARAMS, SO NO NEED TO COUNT DOWN. + TRNE LINK,MCFKWD + JRST MACK2 +MACK1: MOVE LINK,(P) ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM. + MOVE B,PRCALP + MOVE B,-1(B) + MOVEM B,@PRCALP +MACKLP: CALL GPASST ;NOW SEE IF THERE'S AN ARGUMENT TO BE FOUND + CAIE A,^M ;IF SO, IT SHOULD START WITH A KEYWORD. + CAIN A,^J + JRST MACKND ;CR OR LF => NO KEYWORD, AND END SCAN. + CAIN A,"; + JRST MACKND + CAIN A,", + JRST MACKN1 ;NULL ARG => NO KEYWORD, BUT DON'T END SCAN. + CAIE A,") + CAIN A,"> + JRST MACKND ;DETECT END OF PARENTHESIZED CALLS, ETC. + CAIE A,RBRKT + CAIN A,RBRACE + JRST MACKND + TLO FF,FLUNRD + CALL GSYL ;THERE SHOULD BE ANOTHER ARG, SO TRY READING KEYWORD NAME + CALL PASSPS + MOVE C,-1(P) ;NOW SCAN THROUGH THIS RUN OF KEYWORD PARAMS FOR THE ONE + CAIE A,"= ;WHOSE NAME MATCHES WHAT GSYL READ. + JRST MACKL5 ;NOT FOLLOWED BY "="?? + DPB A,STRPNT +MACKL4: MOVE D,[440700,,STRSTO] + MOVE A,@PRCALP +MACKL1: CALL REDINC + ILDB AA,D + CAIN B,377 ;IF REACHED END OF KEYWORD'S NAME, AND EQUAL SO FAR + JRST MACKL2 ;SEE IF ARG'S NAME ALSO OVER. + CAMN B,AA + JRST MACKL1 ;ELSE KEEP COMPARING IF NAMES STILL SAME SO FAR. +MACKL6: MOVEM A,@PRCALP + CALL MACDES ;THIS KEYWORD DOESN'T MATCH SO FIND THE NEXT + JRST MACKL3 ;THERE ARE NO MORE; LOSE - ARG WITH BAD KEYWORD. + TRNN LINK,MCFKWD + JRST MACKL3 + AOJA C,MACKL4 + +MACKL5: ETR [ASCIZ /Bad format keyword argument/] + TLOA FF,FLUNRD ;INCLUDE THE BAD NON-"=" AS PART OF WHAT WE DISCARD +MACKL3: ETR [ASCIZ /Arg with undefined keyword/] + MOVEI T,RARGN + CALL RARFLS ;SKIP AN ORDINARY-SYNTAX MACRO ARG TO TRY TO RECOVER. + JRST MACK1 + +;COME HERE AFTER FINDING THE PARAM THAT MATCHES THIS ARG. +;C POINTS TO THE WORD IN DSTG FOR THAT ARG (DSTG IS WHAT ADDTRN PUSHES IN) +MACKL2: TRZ LINK,MCFKWD ;(IN CASE WE GO TO MACKL6, SINCE KWD NAME SKIPPED ALREADY) + CAIE AA,"= + JRST MACKL6 ;KWD NAME OVER BUT SPEC'D NAME NOT => MISMATCH + MOVEMM (C),FREEPT + CALL MACRED ;READ IN THE VALUE OF THE ARG, THUS SETTING THIS PARAM. + JRST MACK1 ;THERE ARE MORE ARGS => HANDLE THEM + .VALUE +MACKND: TLO FF,FLUNRD ;MACRO CALL TERMINATOR SEEN. +;NULL ARG SEEN; ENDS THIS RUN OF KEYWORD ARGS BUT NOT THE CALL. +MACKN1: REST LINK ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM. + SOS PRCALP + REST C ;GET PTR TO 1ST KWD ARG'S VALUE-WORD +MACKN2: MOVE A,(C) + AOJN A,MACKN4 ;IF THIS ARG WASN'T SPECIFIED, + MOVEMM (C),FREEPT + CALL MACNUL ;NULLIFY IT (MAYBE DEFAULT OR GENSYM) +MACKN4: CALL MACDES ;NOW SKIP OVER THE DESCRIPTORS OF THIS RUN OF KEYWORD PARAMS + JRST MACPUS ;EXHAUSTED ALL THE DESCR'S => END OF MACRO CALL. + TRNE LINK,MCFKWD ;SAME IF REACH A NON-KWD ARG. + AOJA C,MACKN2 + TLNN FF,FLUNRD ;REACHED A NON-KEYWORD PARAM: IF TERMINATOR WAS A NULL ARG, + JRST MACNRM ;GO ON TO READ THE VALUE OF THE NON-KEYWORD PARAM. + JRST MACCLS ;ELSE CALL WAS REALLY ENDED, SO NULLIFY REMAINING ARGS. + +;COME HERE TO FIND THE NEXT DESCRIPTOR. +;SKIPS OVER THE NAME AND DEFAULT VALUE OF THE PREVIOUS DESCRIPTOR, IF ANY. +;THE CONTENTS OF LINKK SAY WHETHER THEY EXIST TO BE SKIPPED OVER. +MACDES: MOVE A,@PRCALP + CALL REDINC ;READ NEXT CHAR OF MACRO + MOVEM A,@PRCALP + TRNE LINK,MCFKWD\MCFDEF + JRST [ CAIE B,377 ;IF THERE'S NAME OR DEFAULT TO SKIP, GO PAST TERMINATOR + JRST MACDES + TRZN LINK,MCFKWD ;AND SAY WE FOUND ONE + TRZ LINK,MCFDEF ;NOTE THERE MAY BE ANOTHER, IN WHICH CASE WE WILL + JRST MACDES] ;SKIP TILL ANOTHER 377 + JUMPE B,CPOPJ ;THIS DESC IS TERMINATOR => RETURN NO SKIP. + MOVEI LINK,(B) ;ELSE PUT FLAGS IN LINK. + JRST POPJ1 + +;COME HERE WHEN A MACRO CALL TERMINATOR IS ENCOUNTERED, TO NULLIFY ALL +;THE REMAINING PARAMS THAT THE MACRO WANTS, THEN ENTER THE MACRO. +;ENTER AT MACCLS IF HAVE JUST READ A DESCRIPTOR AND NOT NULLIFIED THE ARG, +;OR AT MACCLD IF HAVE JUST PROCESSED AN ARG, TO READ THE NEXT DESCRIPTOR. +MACCLS: TRNE LINK,MCFDEF\MCFGEN + JRST MACCL2 + SETZ A, ;NULLIFY NON-GENSYMMED, NON-DEFAULTED ARGS QUICKLY + CALL ADDTR2 +MACCLD: CALL MACDES ;THEN READ THE NEXT DESCRIPTOR. + JRST MACPUS ;IF NO MORE ARGS, ENTER THE MACRO. + JRST MACCLS + +MACCL2: CALL ADDTRN ;FOR GENSYMMED OR DEFAULTED ARG, PUSH PTR TO FREE STG + SOS C,A + CALL MACNUL ;THEN WRITE THE DESIRED VALUE THERE + JRST MACCLD ;THEN HANDLE NEXT DESCRIPTOR. + +;COME TO MACPUS WHEN ALL THE PARAMS HAVE HAD VALUES PUT IN DSTG (USING ADDTRN) +;TO ENTER THE MACRO. +MACPUS: TLZE I,ILPRN ;SPECIAL PARENTHESIZED CALL? + CALL MACPRN ;YES, SKIP PAST THE CLOSING PAREN. + MOVE B,(P) ;IS THIS A .TTYMAC? + CAIN B,A.TYM8 + CALL A.INEO ;YES, POP OUT OF TTY AFTER READING ARGS. + JFCL + REST B ;RCHSV1 OR A.TYM8 + PUSHJ P,PUSHEM + MOVE A,@PRCALP + PUSHJ P,ACPTRS ;SET UP CPTR + POP P,A + PUSHJ P,DMYTRN + SOS PRCALP + REST I +MACCR: AOS (P) ;COMMON RETURN FROM PSEUDOS TO RETURN FROM GETVAL WITHOUT VALUE +CMACCR: POPJ P,MACCR + +MACPRN: MOVEI TT,1 ;START PAREN-DEPTH AT 1 + JSP D,RARBC ;AND READ CHARS, UPDATING THE DEPTH, UNTIL + HALT + JUMPN TT,.-2 ;THE DEPTH GETS TO BE 0. + RET + +A.GOMC: ILDB B,A ;.GO ROUTINE TO SKIP PAST DESCRIPTORS + JUMPN B,A.GOMC ;IN HEADER OF MACRO DEFINITION. + JRST A.GORT + +RCHSV1: SOS MDEPTH ;END OF MACRO EXPANSION, DECREMENT DEPTH IN MACRO EXPANSIONS +A.TYM8: PUSH P,A ;ENTRY FROM .TTYMAC END OF EXPANSION + MOVE B,TOPP +RCHSV3: CAMG B,BBASE + JRST RCHSV2 + HLRZ A,-1(B) + ADD A,-1(B) + MOVEI A,1(A) + CAME A,FREEPT + JRST RCHSV2 + HRRZ A,-1(B) ;GET NEW FREEPT + SOJA B,RCHSV3 + +RCHSV2: POP P,A + ;RETURN ROUTINE FOR END OF DUMMY +RCHSAV: MOVE B,BBASE + MOVEM B,TOPP + PUSHJ P,POPEM + HLRM B,BBASE +REPT6: TRZE FF,FRMRGO + POPJ P, ;RETURN TO .GO + JRST RCHTRB + +;IRP, IRPS, IRPC, IRPW, IRPNC ALL CALL HERE. +;ALL USE 2 FRAMES ON THE MACRO PDL: +; ,, +; ,, +; \<# GROUPS>,, +; ,,AIRR +;THE 3RD WORD HAS IN BITS 4.1-4.3 THE IRP TYPE CODE +; (NIRPO, NIRPC, ETC) +;AND IN THE REST OF THE LH, THE NUMBER OF GROUPS +; (TRIPLES OF TWO DUMMIES AND A LIST) + +.SEE NIRPO ;FOR DEFINITIONS OF IRP TYPE CODES. + +AIRP: JSP TM,ERMARK ;ERROR MESSAGES SHOULD SAY WE'RE INSIDE IT. + PUSH P,I + PUSH P,RDWRDP + HLRZ LINK,B ;GET IRP TYPE CODE TO INDEX BY. + CAIE LINK,NIRPN + JRST AIRP0 + CALL AGETFD ;IRPNC, READ THE 3 NUMERIC ARGS. + PUSH P,A + CALL AGETFD + PUSH P,A + CALL AGETFD + MOVEM A,AIRPN2 ;THE LAST ARG, + REST AIRPN1 ;THE MIDDLE, + REST AIRPN0 ;THE FIRST. + MOVEI LINK,NIRPN +AIRP0: SETZM IRPCR ;NO GROUPS SEEN YET. + +;FALLS THROUGH. + +;FALLS THROUGH. + +;TRY TO READ IN ANOTHER GROUP. +AIRP1: CALL PDEF ;READ IN DUMMY NAME, PUSH ON DMYTOP. + CAIE T,", ;TERMINATOR WASN'T COMMA AND NAME WAS NULL + JUMPE SYM,AIRP2 ;=> NO MORE GROUPS. + CALL PDEF ;NONNULL GROUP, READ & PUSH 2ND NAME. + CAIN T,"[ ;] TRY TO DETECT "IRP X,[", ETC. ] + CALL [ETR [ASCIZ/Comma missing in IRP/] + TLO FF,FLUNRD ;GENERATE A COMMA. + RET] + CALL ADDTRN ;PUSH CHAR ADDR OF 1ST DUMMY, + CAIE LINK,NIRPS + CAIN LINK,NIRPC ;LEAVE SPACE FOR IRPC'S 1ST ARG, IRPS'S 2ND. + CALL PUT377 + MOVE A,RDWRDP + CAIN LINK,NIRPS + AOS -1(A) ;IRPS - 1ST ARG GOES AFTER NEXT 377. + CALL ADDTRN ;PUSH CHAR ADDR OF 2ND DUMMY. + CALL PUT377 + MOVE A,RDWRDP + XCT AIRP1T-1(LINK) ;MAYBE INCREMENT THAT ADDR. + AOS IRPCR ;ONE MORE GROUP SEEN. + JSP D,RARG ;INITIALIZE READING LIST. + JRST AIRP3 ;NO LIST. + JRST @.(LINK) + OFFSET 1-. +NIRPO:: AIRPO ;IRP +NIRPC:: AIRPC ;IRPC +NIRPS:: AIRPS ;IRPS +NIRPW:: AIRPW ;IRPW +NIRPN:: AIRPN ;IRPNC + OFFSET 0 + +AIRP1T: AOS -1(A) + AOS -1(A) ;INCR. THE 2ND DUMMY ADDR FOR IRP, IRPC. + SOS -1(A) + JFCL ;DECR. FOR IRPS, NOTHING FOR IRPW. + AOS -1(A) ;INCR. FOR IRPNC. + +;READ LIST FOR IRPC OR IRP AND STUFF INTO STRING. +AIRPC: +AIRPO: CALL RARGCP ;COPY UP TO END OF ARG INTO MACRO SPACE. + JRST AIRP3 + +AIRPW3: CALL PUT377 ;END A LINE, + CAIGE C, + CALL PUT377 ;IF NO ; YET, MAKE NULL 2ND ARG. +;COME HERE FOR IRPW, LOOP BACK FOR NEXT LINE. +AIRPW: SETO C, ;NO ; SEEN YET IN LINE. +AIRPW1: JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST, GO WRITE 375. + CAIE A,^M + CAIN A,^J + JRST AIRPW1 ;IGNORE NULL LINES. +AIRPW4: CAIN A,"; + AOJE C,AIRPW2 ;ON 1ST SEMI, SWITCH TO 2ND ARG. + CAIE A,^J + CAIN A,^M + JRST AIRPW3 ;END OF LINE => END BOTH ARGS, START OVER. +AIRPW5: CALL PUTREL + JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST. + JRST AIRPW4 + +AIRPW2: MOVEI A,377 + JRST AIRPW5 + +AIRPS: SETO C, ;NO SQUOZE CHAR SEEN YET. +AIRPS2: JSP D,RARGCH(T) + JRST AIRP3 + HLRZ CH1,GDTAB(A) + CAIN CH1,(RET) + CAIN A,"! + AOJA C,AIRPS0 ;A SQUOZE CHAR OR !. + JUMPL C,AIRPS2 ;NON SQUOZE FOLLOWING ANOTHER, FLUSH. + DPB A,AIRPSP ;NONSQUOZE ENDING NONNULL SYL, PUT BEFORE SYL. + SETZM AIRPSP + CALL PUT377 ;FOLLOW SYL WITH 377. + JRST AIRPS + +AIRPS0: JUMPN C,AIRPS3 ;NOT 1ST CHAR IN SYL? + PUSH P,A + CALL PUT377 ;1ST, LEAVE A SPACE FOR THE SYL'S TERMINATOR. + MOVE A,FREPTB + MOVEM A,AIRPSP ;REMEMBER WHERE THE SPACE IS. + REST A +AIRPS3: CALL PUTREL + JRST AIRPS2 + +AIRPN: SKIPG C,AIRPN0 ;ANY CHARS TO IGNORE? + JRST AIRPN4 + JSP D,RARGCH(T) + JRST AIRP3 + SOJG C,.-2 +AIRPN4: SKIPN C,AIRPN2 ;GET MAX # GRPS OF CHARS. + JRST AIRPN7 ;0 => IGNORE THE REST. +AIRPN5: MOVE B,AIRPN1 ;DO NEXT GRP, GET # CHARS/GRP. +AIRPN6: JSP D,RARGCH(T) + JRST AIRP3 + CALL PUTREL ;STORE THE NEXT CHAR. + SOJG B,RARGCH(T) ;COUNT CHARS IN GRP. + MOVEI A,376 + CALL PUTREL ;FOLLOW GRP BY 376. + SOJN C,AIRPN5 ;MAYBE CAN DO MORE GRPS. +AIRPN7: CALL RARFLS ;DID AS MANY GRPS AS CAN DO, + ;IGNORE REMAINDER OF LIST. + +;COME HERE WHEN EXHAUST THE LIST. +AIRP3: CALL STPWR + JRST AIRP1 ;READ ANOTHER GROUP. + +;ALL GROUPS READ IN; NOW READ IN BODY. +AIRP2: CAIE T,"; ;IF A SEMICOLON ENDED THE ARGS, SKIP THE COMMENT. + JRST AIRP4 +AIRP5: CALL RCH + CAIE A,^M + JRST AIRP5 +AIRP4: PUSH P,LINK + MOVE A,FREEPT ;SAVE CHAR ADDR START OF BODY + MOVEM A,PRIRP ;WHERE GC WILL RELOCATE IT. + PUSHJ P,RCH ;IF NEXT CHAR LF, THEN FLUSH IT + CAIE A,12 + TLO FF,FLUNRD + PUSHJ P,WRQOTE ;READ BODY OF IRP + PUSHJ P,STPWR ;WRITE STOP + PUSHJ P,PUSHEM ;SAVE WORLD + REST LINK + POP P,A ;RESTORE RDWRDP FROM LONG AGO + PUSH P,TOPP ;NOW SAVE TOPP + PUSHJ P,DMYTRN ;ACTIVATE DUMMYS + MOVE B,MACP ;NOW GET MACRO PDL POINTER + MOVE A,CIRPCT ;GET .IRPCNT + HRRM A,(B) ;CLOBBER "RETURN" ON PDL TO OLD IRPCNT + SETOM CIRPCT ;INITIALIZE IRPCNT + MOVS A,IRPCR ;GET # GROUPS + HRR A,PRIRP ;CHAR ADR OF BEGINNING OF BODY + SETZM PRIRP + DPB LINK,[410300,,A] ;PUT IN TYPE OF IRP. + PUSH B,A ;PUSH ,,CHAR ADR BEGINNING + POP P,A ;NOW GET OLD TOPP + HRLS A ;MOVE TO LEFT HALF + HRRI A,AIRR ;RETURN TO AIRR ON END OF BODY + PUSH B,A ;PUSH OLD TOPP,,AIRP4 + MOVEM B,MACP ;STORE BACK UPDATED MACRO PDL POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP RIGHT AWAY TO CAUSE CYCLING + REST I + JRST MACCR + +;RECYCLE THROUGH IRP + + ;AC ALLOCATIONS: +AIRR: PUSH P,A ;A GETS BP ILDBING THRU ARG LIST. + PUSH P,C ;C # GROUPS LEFT + PUSH P,T ;T ADR OF PAIR OF CHAR ADR'S OF DUMMYS + PUSH P,TT ;TT TYPE OF IRP (NIRPO, NIRPC, ETC) + AOS CIRPCT ;INCREMENT .IRPCNT + HRRZ A,(B) ;GET CHARACTER ADR BEG BODY FROM PDL + PUSHJ P,ACPTRS ;SET UP CPTR + SETOM AIRPT + TRNE FF,FRMRGO + JRST AIRR9 ;RETURN TO .GO + HLRZ T,1(B) ;DUMMY TAB ADR + LDB C,[220600,,(B)] ;# GROUPS + JUMPE C,AIRR9 ;JUMP IF NO GROUPS + LDB TT,[410300,,(B)] ;GET TYPE OF IRP (NIRPO, ETC) +AIRR6: JRST @.+1(TT) +AIRRER ? AIRRO ? AIRRC ? AIRRS ? AIRRW ? AIRRN ? AIRRER ? AIRRER +AIRRER: .VALUE + +;MOVE 1 ARG THRU 1 GROUP OF IRP. +AIRRO: HRRZ A,1(T) ;THE 1ST ARG WILL START THIS TIME + HRRZM A,(T) ;WHERE THE "REST OF STRING" STARTED LAST TIME. + BCOMP A,-1 ;GET BP THAT'LL ILDB THAT CHAR. + SETO CH1, ;COUNT [-] DEPTH. +AIRRO1: ILDB B,A + CAIN B,375 + JRST AIRRO4 ;END OF STRING IS END OF ARG. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIN B,"[ + AOJE CH1,AIRRO3 ;FLUSH OUTERMOST [-] PAIRS. + CAIN B,"] + SOJL CH1,AIRRO3 + JUMPGE CH1,AIRRO1 ;DON'T LOOK FOR , WITHIN [-]. + CAIE B,^J + CAIN B,", + JRST AIRRO2 ;END OF ARG. + CAIE B,^M ;^M IS IGNORED (FLUSHED.) + JRST AIRRO1 +AIRRO3: MOVEI B,376 ;FLUSH A CHAR BY REPLACING WITH 376 + DPB B,A + JRST AIRRO1 + +AIRRC4: SUB P,[1,,1] +AIRRC3: SETZM (T) ;NULLIFY BOTH ARGS PERMANENTLY. +AIRRO4: SETZM 1(T) ;NULLIFY 2ND ARG PERMANENTLY + JRST AIRR8 ;DONE WITH THIS GROUP. + +AIRRO2: MOVEI B,377 ;REPLACE CHAR THAT ENDED ARG WITH TERMINATOR. + DPB B,A +AIRRW3: CCOMP1 A,-1 ;GET ADDR OF CHAR AFTER. + HRRZM B,1(T) ;"REST OF STRING" STARTS THERE. + JRST AIRR8 + +AIRRN: MOVE A,1(T) ;NEW 1ST DUMMY STARTS AT OLD "REST OF STRING". + MOVEM A,(T) + BCOMP A,-1 ;NEW "REST OF STRING" STARTS AFTER 376, + JRST AIRRW2 ;WHICH WILL BECOME A 377. + +AIRRW: MOVE A,1(T) ;GET CHAR ADDR START OF 2ND HALF OF PREV LINE. + CALL AIRRM ;SET 1ST DUMMY -> AFTER NEXT 376 OR 377 . +AIRRW2: ILDB B,A ;MOVE UP TO NEXT 377 OR END OF STRING. + CAIN B,375 ;END OF STRING ENDS 1ST DUMMY'S ARG => + JRST AIRRO4 ;NULLIFY THE 2ND DUMMY. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIGE B,376 + JRST AIRRW2 + JRST AIRRO2 ;SET UP 2ND DUMMY -> NEXT CHAR. + + +;MOVE UP IN 1 GROUP OF IRPS. +AIRRS: MOVE A,(T) ;MOVE FROM 1ST DUMMY, + CALL AIRRM ;PUT 1ST DUMMY AFTER NEXT 377, + AOS (T) ;MOVE IT PAST THE SYL'S TERMINATING CHAR, + ILDB CH1,A ;GET THAT CHAR, + MOVE A,1(T) + JRST AIRRS2 ;STORE AS 2ND DUMMY. + +AIRRM: BCOMP A,-1 ;A HAS CHAR ADDR; WILL ILDB THAT CHAR. +AIRRM1: ILDB B,A + CAIN B,375 ;END OF STRING => NULLIFY BOTH ARGS + JRST AIRRC4 ;AND FINISHED WITH GROUP. + CAIE B,377 + JRST AIRRM1 + MOVE CH1,A + CCOMP1 CH1,-1 ;GET CHAR ADDR OF CHAR AFTER 377 + MOVEM CH2,(T) ;PUT 1ST DUMMY THERE. + RET ;NOTE A NOT CLOBBERED, CAN GO ON ILDB'ING. + +;MOVE UP IN ONE GROUP OF IRPC. +AIRRC: AOS A,1(T) ;DELETE 1ST CHAR FROM "REST OF STRING". + BCOMP A,-1 ;GET BP -> THAT CHAR. + LDB CH1,A ;GET THE CHAR. + MOVE A,(T) ;GET CHAR ADDR OF PLACE TO PUT IT. +AIRRS2: CAIN CH1,375 ;REACHED END OF STRING => + JRST AIRRC3 ;NULLIFY BOTH ARGS. + BCOMP A,0 + DPB CH1,A ;STORE IT IN THE 1-CHAR ARG. +AIRR7: SETZM AIRPT ;THIS GROUP NOT EXHAUSTED YET. +AIRR8: ADDI T,2 + SOJG C,AIRR6 ;MORE GROUPS => DO THE NEXT. +AIRR9: POP P,TT ;RETURN FROM AAIRPC + POP P,T + SKIPL AIRPT + JRST REPT3 + MOVN A,[2,,2] ;ARGS EXHAUSTED, RETURN + ADDB A,MACP + HRRZ A,(A) + MOVEM A,CIRPCT + POP P,C + POP P,A + JRST RCHSAV + +;IRP ARG-STRING READING COROUTINES: CALL WITH JSP D, +;INITIALIZE FOR READIN OF ARG BUT DON'T GET A CHAR. +;SKIPS IF NONNULL ARG AVAILABLE. +;COROUTINES REMEMBER INFO IN T AND TT BETWEEN CALLS. +;THE CALLER SHOULDN'T CLOBBER THEM. +RARG: CALL RCH ;DECIDE WHAT TYPE OF ARG FOLLOWS, IF ANY. + CAIN A,LBRKT ;RARG ALLOWS [-] AND MAYBE {-} ARGS AS WELL AS SIMPLE ONES. + JRST RARGBR +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + TLO FF,FLUNRD + JSP T,RARGXT ;CAUSE FAILURE RETURN ON SEMI, CR, LF. +RARGN: CALL RCH ;RARGCH RTN FOR NORMAL ARG. +RARGX1: CAIN A,", + JRST (D) ;COMMA ENDS ARG. +RARGXT: CAIN A,"; + JRST RARGSM ;SEMI ENDS SCAN. +RARGX2: CAIE A,^M + CAIN A,^J ;CR, LF END SCAN. +RARGSM: TLOA FF,FLUNRD + JRST 1(D) + JRST (D) + +RARGBR: SETZ TT, ;TT USED AS BRACKET COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR [-] TYPE ARGS. +RARGBC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRKT + AOJA TT,1(D) + CAIN A,RBRKT + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACKET. + +RARGRR: SETZ TT, ;TT USED AS BRACE COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR {-} TYPE ARGS. +RARGRC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRACE + AOJA TT,1(D) + CAIN A,RBRACE + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACE. + +;TO GET THE NEXT CHAR OF THE ARG IN A, DO JSP D,RARGCH(T). +;SKIPS UNLESS NO MORE CHARS TO GET. +;NO SKIP AND SET => SCAN SHOULD BE TERMINATED. +;RARG SHOULD NOT BE CALLED AGAIN IN THAT CASE. +RARGCH==0 ;THIS SYMBOL IS FOR CREF'S SAKE. + +;COPY THE ARG BEING READ INTO MACRO SPACE. +;ON RETURN, A WILL HOLD "; IF ARGUMENT WAS ENDED BY ";". +RARGCP: JSP D,RARGCH(T) + JRST RARGC1 + CALL PUTREL + JRST RARGCH(T) + +RARGC1: CAIE A,"; ;IF SEMI ENDED THE ARG, FLUSH THE + RET ;SPACES AND TABS BEFORE IT. +RARGC2: LDB A,FREPTB + CAIN A,^I + JRST RARGC3 + CAIE A,40 + JRST [ MOVEI A,"; ;LAST CHAR OF ARG ISN'T SP OR TAB. + RET] ;MAKE SURE A HAS ";" IF ARG WAS ENDED BY ";". +RARGC3: SOS FREEPT ;IT IS ONE; BACK OVER IT. + MOVE A,FREPTB + DBPM A + MOVEM A,FREPTB + JRST RARGC2 + +;IGNORE THE REST OF THE ARG NOW BEING READ. +RARFLS: JSP D,RARGCH(T) + RET + JRST RARGCH(T) + +;COME HERE TO SET UP TO READ A BALANCED ARG. +;IF THERE'S NO ARG, RETURNS WOTH JRST (D). +;ELSE RETURNS WITH JRST 1(D) SETTING UNRCHF. +RARB: TLO FF,FLUNRD + SETZ TT, ;TT USED AS BRACKET COUNTER. + CAIE A,RBRACE + CAIN A,") ;IF 1ST CHAR IS A CLOSE, + JRST RARB4 ;THERE'S NO ARG. + CAIE A,"> + CAIN A,RBRKT + JRST RARB4 + JSP T,RARGXT ;CHECK FOR CR, LF, SEMI, AND RETURN. +;1-CHAR RTN FOR READING BALANCED ARG. +RARBC: CALL RCH + CAIE A,RBRACE + CAIN A,"> ;FOR CLOSES, MAYBE END ARG. + JRST RARB2 + CAIE A,") + CAIN A,RBRKT + JRST RARB2 + CAIE A,LBRACE + CAIN A,"< ;FOR OPEN BRACKETS, INCR. THE COUNT. + AOJA TT,1(D) ;OPENS CAN'T END THE ARG. + CAIE A,"( + CAIN A,LBRKT + AOJA TT,1(D) + JUMPN TT,1(D) + JRST RARGX1 ;NOT WITHIN BRACKETS, TEST FOR COMMA, ETC. + +RARB2: SOJGE TT,1(D) ;COME HERE FOR CLOSEBRKTS. +RARB4: TLO FF,FLUNRD + JRST (D) + +;COME HERE TO INIT FOR AN ARG FOR REPEAT, ETC. +;THAT IS, EITHER A BRACKETED ARG OR A 1-LINE ARG. +RARL1: CALL RCH +RARL2: +IFN BRCFLG,[ +RARL4: CAIN A,LBRACE + JRST RARGRR ;1ST CHAR A BRACE => BRACED ARG. +] + CAIN A,LBRKT ;1ST CHAR A BRKT => BRKT ARG. + JRST RARGBR + TLO FF,FLUNRD + +;INIT FOR A 1-LINE ARG. +RARL: JSP T,1(D) +;1-CHAR RTN FOR 1-LINE ARGS. +RARLC: CALL RCH + JRST RARGX2 + +IFE BRCFLG,[ +;IF BRACES AREN'T USED BY MOST THINGS, THE NORMAL ROUTINE RARL1 DOESN'T +;CHECK FOR THEM, BUT RALR4 (CALLED BY CONDITIONALS) STILL MUST. +RARL4: CAIN A,LBRACE + JRST RARGRR + JRST RARL2 +] + +;1-LINE ARGS TO MACROS: DON'T TERMINATE THE SPEC, +;AND SKIP OVER THE CR AND LF. +RARL3: TLO FF,FLUNRD + JSP T,1(D) + CALL RCH + CAIN A,^J + JRST (D) ;LF IS THE END - SKIP IT. + CAIE A,^M + JRST 1(D) + CALL RCH ;CR => SKIP FOLLOWING LF, END ARG. + CAIE A,^J + TLO FF,FLUNRD + JRST (D) + +;PUSHJ P,A.GST SEARCH CURRENT MACRO STRING FOR TAG (IN A.GST4) +;SKIP IF FOUND, RETURN ON END OF STRING ANYWAY +;BYTE POINTER (ILDB TO GET FIRST CHARACTER) IN A + +A.GST: MOVEM A,A.GST3 ;SAVE BYTE POINTER +A.GST1: ILDB B,A.GST3 ;GET CHAR + CAIL B,300 + POPJ P, ;END OF STRING => STOP + CAIE B,". + JRST A.GST1 ;WAIT FOR POINT + PUSHJ P,A.GSYL ;FOUND POINT, GET REST OF NAME + JUMPL T,CPOPJ ;RETURN ON END OF STRING + CAME SYM,[SQUOZE 0,TAG] ;TAG? + JRST A.GST1 ;NO, KEEP GOING + PUSHJ P,A.GSYL ;GET THE TAG + JUMPL T,CPOPJ ;RETURN ON END OF STRING (THERE MUST BE BREAK CHAR AFTER TAG BEFORE STOP) + CAME SYM,A.GST4 + JRST A.GST1 ;NOT THE ONE BEING LOOKED FOR + MOVE A,A.GST3 + LDB B,A ;GET DELIMITER + CAIE B,15 ;CR? + JRST POPJ1 + ILDB B,A ;CR, GET NEXT CHAR + CAIE B,12 ;LINE FEED? + MOVE A,A.GST3 ;NO, DON'T FLUSH + JRST POPJ1 + + ;LOOK BACKWARD FOR BEGINNING OF STRING, BYTE POINTER AN A + ;LEAVES POINTER POINTING AT STOP CHAR (NOT BEFORE); ALSO LEAVES STOP CHAR IN B + +AG.SP: MOVE B,(A) ;GET WORD FROM MACTAB + XOR B,[300_28.+300_20.+300_12.+300_4] ;DO XOR TO ANITIALLY SET UP + LDB CH1,[400400,,A] ;PICK UP 4 HIGH ORDER BITS OF POSITION FIELD + JRST A.GSP2-1(CH1) ;DISPATCH ON POSITION FIELD (-1 SINCE BIT SET IN POSITION FIELD) + +AG.SP3: MOVE B,(A) + XOR B,[300_28.+300_20.+300_12.+300_4] + +A.GSP2: TRNN B,300_4 + JSP CH1,AG.SF + TLNN B,3 + JSP CH1,AG.SF + TLNN B,300_2 + JSP CH1,AG.SF + TLNN B,300_10. + JSP CH1,AG.SF + SOJA A,AG.SP3 + +AG.SF: SUBI CH1,A.GSP2-1 ;GET HERE WHEN STOP CHAR FOUND + DPB CH1,[400400,,A] ;CLOBBER POSITION FIELD OF BYTE POINTER AGAIN + ILDB B,A ;INCREMENT TO UNIVERSALLY ACCEPTABLE POINTER, GETTING STOP CHAR IN B AT SAME TIME + POPJ P, ;THAT'S ALL + +A.TAG: PUSHJ P,GSYL + CAIE T,15 + JRST MACCR + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD + JRST MACCR + +A.GO: PUSHJ P,GSYL ;DOESN'T WORK RELIABLY FROM DUMMY + MOVEM SYM,A.GST4 + +A.GO1: TLNN FF,FLMAC + JRST MACCR ;NOT GETTING CHARS FROM MACRO => STOP + MOVE A,CPTR + PUSHJ P,AG.SP ;BACK TO BEGINNING + CAIN B,374 + JRST A.GOMC ;MACRO, SKIP PAST HEADER +A.GORT: PUSHJ P,A.GST + JRST A.GO2 ;END OF STRING, TRY POPPING UP ONE + MOVEM A,CPTR + JRST MACCR + +A.GO2: PUSHJ P,PMACP + JRST A.GO1 + +A.GSYL: MOVNI D,100000 ;GET SYL FOR .GO WHILE LOOKING FOR TAG + MOVEM D,STRCNT ;STRCNT .LT. 0 SIGNAL FOR GSYL TO JRST (F) + MOVEI SYM,0 + JSP F,GSYL1 +A.GSY3: ILDB A,A.GST3 ;GET CHAR + TRZN A,200 ;CHECK FOR SPECIAL + JRST A.GSY2 ;NO, FALL BACK IN + CAIG A,100 ;BIG ENOUGH TO BE SPECIAL? + JRST A.GSY3 ;NO, MUST BE DUMMY, IGNORE + HRROI T,(A) ;SPECIAL => ASSUME STOP: T .LT. 0 SIGNAL TO CALLING ROUTINE + POPJ P, ;RETURN TO CALLING ROUTINE + +;INITIALIZE MACRO STATUS + +MACINI: MOVEI A,3 + MOVEM A,FREEPT ;FORGET ALL STRINGS IN MACTAB + PUSHJ P,FCOMP + MOVE A,MACTAD + HRLI A,41000 ;SET UP CCOMPB THRU CCOMPE + LSH A,2 ;(THEIR VALUES CAN'T BE ASSEMBLED IN BECAUSE + SUBI A,4 ;THEY ARE MUTLTIPLY RELOCATABLE, AND IN DEC + MOVSI AA,CCOMPB-CCOMPE ;VERSION THAT CAN'T BE DONE) +MACIN0: MOVEM A,CCOMPB(AA) + AOJ A, + AOBJN AA,MACIN0 + MOVE A,MACTAD + ADDI A,MACL+1777 + ANDI A,-2000 ;ADDR OF 1ST WD AFTER MACTAB. + CALL MACIN2 ;SET UP PTRS TO END OF MACTAB. + SETZM GCCNT ;CLEAR OUT GC COUNT SO WILL GET MORE CORE FIRST THREE +MACIN1: SETZM MDEPTH ;NOW INITIALIZE MACRO EXPANSION STATUS + SETZM PRSTG ;NOW TO CLEAR OUT BYTE POINTERS + MOVE A,[PRSTG,,PRSTG+1] + BLT A,EPRSTT-1 + MOVEI A,DSTG + MOVEM A,RDWRDP + MOVEI A,DMYAGT + MOVEM A,TOPP + MOVEM A,BBASE + MOVE A,[-MPDLL,,MACPDL] + MOVEM A,MACP + POPJ P, + +;A -> 1ST WD AFTER MACTAB, SET UP ALL POINTERS TO END OF MACTAB. +MACIN2: MOVEM A,MACTND + SUB A,MACTAD + LSH A,2 ;1ST BYTE MACTAB DOESN'T HAVE. + MOVEM A,MACHI + SUBI A,MACRUM*4 + MOVEM A,GCRDHI + MOVE A,STOPPT + HRR A,MACTND + SOS A ;LAST WD IN MACTAB. + MOVEM A,MACHIB ;INITIALIZE BYTE POINTER TO HIGHEST BYTE OK TO FILL + RET + + ;MACRO VARIABLE AREA (MOST THEREOF) + +VBLK +MACP: 0 ;MAC PDL POINTER +BLCODE [MACPDL: BLOCK MPDLL+1] ;MACRO PDL +FREEPT: 0 ;MACRO STG PNTR POINTS TO FREE CHAR +FREPTB: 0 ;FREEPT IN BYTE POINTER FORM +MACTAD: MACTBA ;ADDR OF START OF MACRO TABLE. +MACTND: 0 ;ADDR OF 1ST WD AFTER MACTAB. +MACHI: 0 ;CHAR ADR ONE ABOVE ACTIVE MACTAB +MACHIB: 0 ;POINTS TO LAST BYTE IN MACTAB + +SCONDF: 0 ;STRING CONDITIONAL FLAG, -1 => IDENTICAL, 0 DIFFERENT +GENSM: 0 ;GENERATED SYM COUNT +DEFNPS: 0 ;NONZERO => NAME OF PSEUDO NOW READING ITS ARG. + ;A FATAL ERROR WILL TYPE THE PSEUDO'S NAME. +DEFNPN: 0 ;PAGE # -1 OF THAT PSEUDO. ALSO TYPED BY FATAL ERRORS. +DEFNLN: 0 ;LINE # -1. +DEFNFI: 0 ;SIXBIT FN1 OF FILE CONTAINING PSEUDO THAT DEFNPS REFERS TO. +MDEPTH: 0 ;DEPTH IN MACRO (NOT IRP OR REPEAT) EXPANSIONS +PUTCNT: 0 ;AOS'D BY PUTREL, USED BY CALLING ROUTINE, USUALLY TO COUNT ACTIVE CHARS (DURING DEFINITION) +IRPCR: 0 ;COUNT OF A,B,[LIST] GROUPS IN IRP IRPC IRPS, " " " +AIRPT: 0 ;IRP EXPANSION TEMP, -1 => NO NON-NULL DUMMYS YET, ELSE 0 +AIRPN0: 0 ;1ST NUMERIC ARG TO IRPNC +AIRPN1: 0 ;2ND, +AIRPN2: 0 ;3RD. +A.QOT2: 0 ;DELIMITER FOR .QUOTE +CRPTCT: -1 ;COUNT THROUGH CURRENT REPEAT (FOR .RPCNT) +CIRPCT: -1 ;COUNT THOUGH CURRENT IRP (FOR .IRPCNT) +A.GST3: 0 ;ON .GO, NAME (IN SQUOZE) OF TAG BEING SEARCHED FOR +A.GST4: 0 ;BYTE POINTER FOR ILDB WHILE SEARCHING FOR TAG +PRCALP: PRCAL-1 ;POINTER INTO PRCALP, POINTS TO LAST ACTIVE ENTRY + +PRSTG: ;BEGIN WORDS GARBAGE COLLECTED: FIRST BYTE POINTERS ILDB'D + +CPTR: 0 ;ILDB TO GET NEXT CHAR FROM MACRO OR WHATEVER +IFE WRQTSW-1,WRQTBP: 0 ;POINTS TO LAST CHAR BEFORE CURRENT SYL AT WRQOTE +AIRPSP: 0 ;-> PLACE TO STORE SYL-TERMINATOR, IN IRPS READIN. +GCBPL==.-PRSTG ;END BYTE POINTERS, BEGIN CHARACTER ADDRESSES +PRSCND: 0 ;CHARACTER ADDRESS OF CURRENT LOCATION IN FIRST STRING OF IFSE,IFSN WHILE COMPARING WITH SECOND +PRSCN1: 0 ;CHAR ADR BEG OF FIRST STRING IFSE, IFSN +PRREPT: 0 ;CHAR ADR BEG OF BODY OF REPT +PRIRP: 0 ;CHAR ADR BEG OF IRP BODY +PRDEF: 0 ;CHAR ADR BEG OF MACRO BEING DEFINED +PRCAL: REPEAT 10,0 ;TEMP STORAGE FOR CHAR ADR BEG MACRO BODY, USED TO READ DUMMY SPECS +EPRSTT: ;END CHAR ADR WORDS GARBAGE COLLECTED + + ;BEGIN GARBAGE COLLECTOR VARIABLES + +GCCNT: 0 ;CNT OF GC'S +SYMSTR: 0 ;PNTR TO CHAIN OF MACRO PNTRS IN SYM TABLE (DURING GC), LINKED THROUGH RH'S OF "VALUE" +REDPT: 0 ;CHAR ADR READING FROM WHEN MOVING STRING DOWN +REDPTB: 0 ;REDPT IN BYTE POINTER FORM + ;GC WRITES WITH FREEPT/FREPTB +COFST: 0 ;AMOUNT CHARS MOVED DOWN BY, SUBTRACTED FROM CHAR ADR TO RELOCATE +SVF: 0 ;FLAG, .GE. 0 => NO POINTERS FOUND POINTING TO CURRENT STRING +FREPTS: 0 ;-> BEGINNING OF CURRENT STRING BEING COPIED DOWN +FRPTBS: 0 ;FREPTS IN BYTE POINTER FORM +GCENDF: 0 ;-1 => END OF LAST STRING FOUND, AFTER RELOCATING POINTERS, MSTG2 SHOULD EXIT +GCHI: 0 ;GC HIGH POINTER, CHAR ADR FIRST NOT TO GARBAGE COLLECT +GCRDHI: *4 ;GC DROPS DEAD (MACTAB FULL) IFWRITING INTO THIS CHAR ADR +BLCODE [GCSV: BLOCK 16] ;AC SAVE AREA FOR GC +PBLK + +;GARBAGE COLLECT THE MACRO TABLE + +GCA1: MOVE A,FREEPT ;GC ALL IN MACTAB. +GCA: MOVEM A,GCHI ;ENTRY TO STORE A IN GCHI -> FIRST CHAR NOT TO GARBAGE COLLECT +IFN 17-P+FF,.ERR GC ac saver wants FF=0, P=17! +GC: MOVEM 16,GCSV+15 ; Save all ACs except FF and P. + MOVE 16,[1,,GCSV] + BLT 16,GCSV+14 +IFN TS,[AOS A,GCCNT + CAIGE A,4 + PUSHJ P,GCCORQ ;EXPAND CORE ON FIRST THREE GC'S +] CLEARB T,GCENDF + MOVEI A,3 + MOVEM A,REDPT ;SET UP FOR READING + MOVEM A,FREEPT ;ALSO FOR WRITING + MOVE A,BCOMPU ;ALSO SET UP CORRESPINDING BYTE POINTERS + MOVEM A,FREPTB + MOVEM A,REDPTB + MOVE C,[-GCBPL,,PRSTG] +GCLP1: SKIPN B,(C) ;NOW CONVERT BYTE POINTERS... + JRST GCLP1B ;(INACTIVE) + CCOMP B,-1 ;TO CHARACTER ADDRESSES + MOVEM B,(C) ;STORE BACK CHARACTER ADDRESS +GCLP1B: AOBJN C,GCLP1 ;LOOP FOR ALL SUCH BYTE POINTERS + MOVE A,SYMAOB ;NOW SET UP MACRO LIST; T INITIALLY HAS 0 => END OF LIST DURING COMPUTATION +SYMMG: ;POINTS TO FIRST MACRO SYMTAB ENTRY ON LIST + LDB B,[400400,,ST(A)] ;GET SQUOZE FLAGS THIS SYM + CAIN B,PSUDO_-14. ;PSEUDO? (=> MAYBE MACRO) + JRST SYMMG1 ;YES, MAYBE PUT ON LIST (RETURNS TO SYMMG2) +SYMMG2: ADD A,WPSTE1 + AOBJN A,SYMMG ;LOOP FOR ENTIRE SYMTAB + MOVEM T,SYMSTR ;STORE INITIAL LIST ENTRY FOR MACROS + ;DROPS THROUGH + ;GC DEALS WITH "UNIT STRINGS", EACH STRING ENDS WITH 375 + ;GENERAL PROCEDURE IS TO COPY A STRING DOWN THEN SEARCH FOR POINTERS TO WHERE STRING USED TO BE + ;IF POINTERS FOUND THEY ARE RELOCATED TO POINT TO COPIED DOWN STRING + ;IF POINTERS ARE NOT FOUND THE STRING IS WIPED OUT + ;DROPS THROUGH + +MSTG: MOVE C,REDPT ;SET UP C TO POINT TO BEG OF STRING BEING READ + ;(FOR EVENTUALLY SEARCHING FOR POINTERS TO STRING, NOTE C STAYS AROUND FOR AWHILE) + MOVE TT,FREEPT + CAML TT,GCHI ;IF ALL OF ACTIVE PART OF MACTAB ALREAD GC'D, STOP NOW. + JRST GCEND + MOVEM TT,FREPTS ;-> BEGINNING OF WRITTEN STRING + MOVE TT,FREPTB + MOVEM TT,FRPTBS ;BYTE POINTER -> BEGINNING OF WRITTEN STRING + PUSHJ P,RDTRNS ;COPY CHARACTER + CAIN B,370 + JRST MSTGB ;THAT WAS NO STRING, THAT WAS MY IO-BUFFER! + MOVE TT,B ;SAVE CHARACTER JUST COPIED +MSTG1: CAML LINK,GCHI + JRST GCEND ;JUST READ LAST CHAR IN PART OF MACTAB TO GARBAGE COLLECT => DONE + CAIN B,375 + JRST MSTG2 ;END THIS STRING, NOW SEARCH FOR POINTERS, RETURNS TO MSTG + PUSHJ P,RDTRNS ;STRING NOT EXHAUSTED, COPY NEXT CHAR + JRST MSTG1 + +SYMMG1: HRRZ B,ST+1(A) ;PSEUDO FOUND IN SYMTAB, GET "VALUE" + CAIE B,MACCL ;MACCL? (=> MACRO, CHAR ADR OF BODY IN LH) + JRST SYMMG2 ;NO, JUST FALL BACK INTO LOOP + HRRM T,ST+1(A) ;MACRO, REPLACE MACCL PART OF VALUE WITH POINTER TO NEXT + MOVEI T,ST+1(A) ;UPDATE T (INITIAL LIST ENTRY) TO POINT TO WORD JUST CLOBBERED + PUSH P,A + HLRZ A,ST+1(A) + PUSHJ P,REDINC + CAIE B,374 + HALT + POP P,A + JRST SYMMG2 + + ;COPY CHARACTER DOWN (REDPTB -> FREPTB) + ;LEAVE INCREMENTED REDPT IN LINK, FREEPT IN A, CHAR IN B + +RDTRNS: ILDB B,REDPTB + IDPB B,FREPTB + AOS LINK,REDPT + AOS A,FREEPT + POPJ P, + +MSTGB: ADDI A,3 ;COPY AN IO-BUFFER: + TRZ A,3 + MOVEM A,FREEPT ;WRITE INTO WORD BOUNDARY. + ADDI LINK,3 + TRZ LINK,3 + MOVEM LINK,REDPT ;READ FROM WORD BOUNDARY. + MOVEI B,041000 + HRLM B,REDPTB + HRLM B,FREPTB + MOVE B,FREPTB + MOVE A,REDPTB + ADDI B,1 ;NEW ADDR OF 1ST WD. + HRRZ LINK,1(A) ;GET ADDR OF POINTER TO STRING. + MOVEM LINK,SVF ;REMEMBER WHETHER TO FLUSH STRING. + SKIPE LINK + HRRM B,(LINK) ;RELOCATE THAT POINTER (IF ANY) + HRLI B,1(A) ;SET UP AC FOR BLT. + HLRZ LINK,1(A) ;GET LENGTH OF STRING. + ADDM LINK,REDPTB + LSH LINK,2 + ADDM LINK,FREEPT + ADDM LINK,REDPT + LSH LINK,-2 + ADDB LINK,FREPTB + BLT B,(LINK) + MOVE LINK,REDPT + CAML LINK,GCHI ;IF THIS IO-BUFFER IS LAST THING IN MACRO SPACE, + SETOM GCENDF ;DON'T LOOK FOR ANYTHING FOLLOWING IT. + JRST MSTGB1 ;NOW MAYBE FLUSH THIS STRING, COPY NEXT. + +;GET HERE WHEN MSTG2 FINISHES WITH FLAG SET TO EXIT: UNDO INITIALIZATION AND RETURN + +GCEND1: IFN TS,[ + MOVE A,FREEPT + ADDI A,2000*4 + CAML A,MACHI + PUSHJ P,GCCORQ +] MOVE A,FREEPT + CAML A,GCRDHI + ETF [ASCIZ /Macro space full/] + SKIPN T,SYMSTR + JRST USYMG1 ;EMPTY LIST + MOVEI C,MACCL ;SET UP C FOR HRRM'ING +USYMG: HRRZ TT,(T) ;GET ADR ON LIST + HRRM C,(T) ;CLOBBER RH JUST GOT NEXT POINTER FROM TO MACCL + HLRZ A,(T) + PUSHJ P,REDINC + CAIE B,374 + HALT + SKIPE T,TT ;MAKE NEXT POINTER CURRENT, SKIP IF END OF LIST + JRST USYMG + +USYMG1: MOVE C,[-GCBPL,,PRSTG] +GCLP2: MOVE A,(C) ;NOW CONVERT CHARACTER ADDRESSES... + BCOMP A,-1 ;BACK TO BYTE POINTERS + MOVEM A,(C) + AOBJN C,GCLP2 +IFN 17-P+FF,.ERR GC AC restorer wants FF=0 and P=17! + MOVS 16,[1,,GCSV] ; Restore all ACs except FF and P. + BLT 16,16 + POPJ P, ;EXIT FROM GARBAGE COLLECTOR + + ;GC ROUTINE TO SCAN TABLE AREA FOR POINTERS TO CURRENT STRING + ;CH1 -> BEGINNING OF TABLE, 4.9 => LOOK AT PAIRS SKIPPING SECOND OF EACH PAIR + ;T POINTS TO LAST WORD IN TABLE + 1 + ;RELOCATE POINTERS IN TABLE POINTED TO + ;C POINTS TO BEGINNING OF STRING, B -> END + 1 + +MSCN: CAIG T,(CH1) + POPJ P, ;TABLE EXHAUSTED + HRRZ TT,-1(T) ;GET LAST ENTRY IN TABLE (UPPER POINTER UPDATED TO COUNT DOWN) + CAML TT,C + CAML TT,B + JRST MSCN1 ;DOESN'T POINT TO CURRENT STRING + SUB TT,COFST ;POINTS TO STRING, RELOCATE + HRRM TT,-1(T) ;STORE BACK RELOCATED POINTER + SETOM SVF ;SET FLAG TO SAVE STRING +MSCN1: SKIPGE CH1 + SOS T ;CH1 NEGATIVE => SKIP A WORD + SOJA T,MSCN + +GCEND: SETOM GCENDF ;DONE READING FROM MACTAB, BUT FIRST HAVE TO RELOCATE POINTERS TO LAST STRING +MSTG2: CLEARM SVF ;NO POINTERS FOUND TO STRING YET + MOVE D,REDPT + SUB D,FREEPT + MOVEM D,COFST ;STORE AMOUNT CHARS COPIED DOWN BY FOR CHAR ADR RELOCATION + MOVE B,REDPT + CAIE TT,374 + JRST MSTG3 ;NOT A MACRO + MOVE T,SYMSTR + JUMPE T,MSTG3 ;JUMP IF NO MACROS ON LIST +MSTG5: HLRZ TT,(T) ;GET CHAR ADR THIS MACRO + CAML TT,C ;SKIP IF POINTS BELOW BEGINNING THIS STRING + CAML TT,B ;SKIP UNLESS POINTS TO OR ABOVE FIRST CHAR NOT YET READ + JRST MSTG4 ;DOESN'T POINT TO THIS STRING + SETOM SVF ;POINTS TO THIS STRING, SET FLAG TO SAVE STRING + SUB TT,COFST ;RELOCATE + HRLM TT,(T) ;STORE BACK UPDATED CHAR ADR THIS MACRO +MSTG4: HRRZ T,(T) ;NOW GET POINTER TO NEXT MACRO + JUMPN T,MSTG5 ;LOOP FOR ALL MACROS ON LIST + +MSTG3: MOVE T,TOPP + MOVEI CH1,DMYAGT + PUSHJ P,MSCN ;RELOCATE POINTERS IN DUMMY ARG TABLE + HRRZ T,MACP + HRROI CH1,MACPDL + PUSHJ P,MSCN ;RELOCATE POINTERS IN MACRO PDL + HRRZ T,PRCALP + AOS T + MOVEI CH1,PRSTG + PUSHJ P,MSCN ;RELOCATE POINTERS IN PRSTG + HRRZ T,RDWRDP + MOVEI CH1,DSTG + PUSHJ P,MSCN ;RELOCATE DUMMY ARGS READ (OR BEING READ) IN BUT NOT YET ACTIVATED + SKIPGE GCENDF + JRST GCEND1 ;EXIT +MSTGB1: SKIPE SVF + JRST MSTGB2 ;FOUND POINTERS TO THIS STRING, DON'T FLUSH + MOVE TT,FREPTS ;NO POINTERS FOUND, FLUSH STRING + MOVEM TT,FREEPT + MOVE TT,FRPTBS + MOVEM TT,FREPTB +MSTGB2: SKIPGE GCENDF ;IF WE JUST HACKED AN I-O BUFFER, MAYBE IT'S THE LAST + JRST GCEND1 ;THING IN MACRO SPACE. + JRST MSTG + +] ;END MACSW CONDITIONAL (AND MACRO PROCESSOR ROUTINES) + +IFN .I.FSW,[ ;;.I.F ;ALGEBRAIC COMPILER ROUTINE +; 'ALGEBRAIC' CRUFT MARO DEFINITIONS + +DEFINE MOAN ARG/ + MOVEI D,[SIXBIT /ARG!!/] + JRST ERRCON +TERMIN + +DEFINE RETLIN + MOVEI A,15 ;CARRIAGE RETURN + PUSHJ P,PUTREL + MOVEI A,12 ;LINE FEED + PUSHJ P,PUTREL +TERMIN + +DEFINE NUMBER + MOVE A,BTPNT + ILDB I,A + CAIE I,"# + CAIGE I,"@ +TERMIN + +DEFINE RESTOR + MOVE D,BTPNT + SETZM STRING + SETZM STRING+1 + SETZM STRING+2 +TERMIN + + +DEFINE SPECN + POP P,RANDM + MOVE A,ENN + SUB A,RANDM + MOVEM A,ENN +TERMIN + +DEFINE $GET + EXCH I,ACSVI + PUSHJ P,RCH + EXCH I,ACSVI +TERMIN + +DEFINE GETT + EXCH I,ACSVI + PUSHJ P,RCH + EXCH I,ACSVI + IDPB A,TPN +TERMIN + +; START OF COMPILER PROPER + +OPDL: CH?CH?CH?CH?CH?CH?CH?CH ;COMMUTATOR + CH?SP?CH?CH?CH?CR?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + SP?CH?CH?CH?DL?CH?CH?CH + LP?RP?TX?PL?CM?MN?CH?DV + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?KL?LB?EQ?RB?CH + +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?UP?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH + +VBLK + +ENN: 60 ;ACCUMULATOR NUMBER - TROUBLE IF GOES PAST 9 + +BTPNT: 440700,,STRING ;D +STRING: BLOCK 10 ;CHARACTER ASSEMBLY (D) - TROUBLE IF OVERFLOWS + +TPN: 0 +DIRPNT: 440700,,DIROUT ;TPN +DIROUT: BLOCK 40 ;COPY OF LINE IN PROGRESS (TPN) - TROUBLE IF OVERFLOWS + +OPSTKL==40 + 0 +OPSTK: BLOCK OPSTKL ;OPERATOR STACK (R) - TROUBLE IF OVERFLOWS + 0 + + + +ENDSTT: 0 ;ON IF END OF STATEMENT ENCOUNTERED +CHARF: 0 ;LAST WAS NOT OPERATOR +NUMFL: 0 ;STRING IS NUMERIC CONSTANT (NEEDS [ AND ]) +R1SV: 0 ;SAVED A +R2SV: 0 ;SAVED I, CALLED V EARLIER ON + +INTEGR: 0 ;INTEGER ARITHMETIC +WARN: 0 ;ON AFTER ) TO STOP NON-OPERATOR +RANDM: 0 ;DUMP COMMA COUNT HERE +TEMP: 440600,,(D) ;INDIRECT VIA D +BYTPNT: 0 + ; Save 7 acs here, done by move(m)s for robustness +IRP AC,,[AA,A,B,C,D,I,P] +ACSV!AC: 0 +TERMIN +PBLK + +; ENTRANCE TO 'ALGEBRAIC' TRANSLATOR + +A.I: SETOM INTEGR + SKIPA +A.F: SETZM INTEGR + PUSHJ P,SWINI ;INITIALISE PASSAGE TO MIDAS ASSEMBLER +IRP AC,,[AA,A,B,C,D,I,P] + MOVEM AC,ACSV!AC +TERMIN + SETZM ENDSTT ;RESET END OF STMNT FLAG + SETZM EQHIT' ;RESET LAST CHAR WAS= FLAG + SETZM WARN ;SET OFF ERROR DETECTOR + MOVEI A,"0 ;INITIALISE POINTERS + MOVEM A,ENN + MOVE A,DIRPNT + MOVEM A,TPN ;POINTER TO SAVED INPUT + MOVE SYM,[-OPSTKL,,OPSTK] + PUSH SYM,[0,,ENDSAT] + PUSH P,[0] ;INITIALISE COMMA-COUNTER + SETZM CHARF +CLSTR: RESTOR +RDITTS: SKIPE ENDSTT + JRST BDEND +RDITA: GETT + CAIGE A,100 ;FOR ABBREVIATED DISPATCH TABLE + JRST @OPDL(A) + CAIN A,"\ + JRST AB + CAIN A,"^ + JRST UP + +CH: SETZM EQHIT + SKIPE WARN + JRST CHBRT +CHEY: IDPB A,D + SETOM CHARF ;NON UNARY FLAG + JRST RDITA + +GAMB: RESTOR +COMMT: MOVE I,R2SV + JRST GOPURT + +SHORT: ;DECIDES IF STRING CAN BE USED IN IMMEDIATE TYPE OPS + SETZM IMMED' + SKIPN STRING + POPJ P, ;NO STRING + MOVE A,BTPNT + ILDB I,A + CAIN I,"# + JRST APUPJ ;YEPE HE ASKED FOR IT + SKIPE STRING+1 + POPJ P, ;STRING IS LONG + SKIPA + +TSTSHL: ILDB I,A + JUMPE I,APUPJ ;ITS OK FOUND ONLY NUMBERS + CAILE I,"@ + POPJ P, ;NON-NUMBER IN STRING + CAIE I,". + JRST TSTSHL + ILDB I,A + SKIPN I ;ANYTHING FOLLOW '.' QST +APUPJ: SETOM IMMED' ;INDICATE IMMEDIATE USAGE IS POSSIBLE + POPJ P, + +SZPRT: SETZM CHARF +GOPRT: SETZM WARN +GOPART: MOVEM I,R2SV +GOPURT: HLRZ B,I + HLRZ C,(SYM) + CAMLE B,C + JRST PSOPR ;GO PUSH OPERATOR + SKIPN INTEGR + SETOM IMMED ;FOR ARITH OPS ONLY FIXED WILL DO IMMEDIATE + PUSHJ P,SHORT ;ESTABLISH IF STRING CAN BE IMMEDIFIED + POP SYM,A ;POP AN OPERATOR + JUMPN A,(A) + + MOAN OVERPOPPED OPERATOR STACK + +CHEX: MOVE A,R1SV + JRST CHEY + +RP: SKIPE EQHIT + AOS ENN ;TAKE CARE OF UNSATISFIED = AT END + SKIPN CHARF + JRST RTONOP + SETOM CHARF +BUDDY: SETOM WARN + MOVEI I,RPAR + JRST GOPART + +RTONOP: MOVE I,(SYM) + CAIN I,FUNCT + JRST BUDDY ;NO ARGUMENT FUNCTION + + MOAN ) FOLLOWS OPERATOR + +BDEND: MOAN TOO MANY ('S + +CHBRT: MOAN NON-OPERATOR FOLLOWS ) + +CR: SKIPE EQHIT + AOS ENN ;HANDLES UNSATISFIED = AT END + SETOM ENDSTT + MOVEI I,RCAR + JRST GOPRT + +LP: SETZM EQHIT + SKIPE WARN + JRST LFRHT + SETZM CHARF + SKIPE STRING + JRST INDX + PUSH P,[0] ;INITIALISE COMMA-COUNTER + PUSH SYM,[0,,LFTPR] + JRST RDITA + +INDX: NUMBER + JRST NUSTRB + GETT + CAIG A,"9 + JRST NMRINX + MOVEI I,"( + IDPB I,D +INDY: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDN + CAIN A,"- + JRST CMPNDN + CAIE A,") ;SEARCH FOR NEXT RP + JRST INDY + IDPB A,D +CMBAN: SETOM CHARF ;MAKE BELIEVE CHARATER LAST + SETOM WARN ;YET SET ) TRAP + JRST RDITA + +NMRINX: CAIN A,"- ;IS IT A MINUS + JRST INDZ + CAIN A,"+ + JRST INDZ + MOVEI I,"+ ;NUMERICAL SUBSCRIPT + IDPB I,D +INDZ: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDC + CAIE A,") + JRST INDZ + JRST CMBAN + +CMPNDN: MOVEI I,") + IDPB I,D + JRST INDZ + +CMPNDC: MOVEI I,"( + IDPB I,D + JRST INDY + +LFRHT: MOAN ( FOLLOWS DIRECTLY ON ) + +SP=RDITA ;USE FOR NON ARITH STATS + +CM: MOVE I,[1,,COMMX] + SKIPN CHARF + AOS ENN + JRST SZPRT + +EQ: SETOM EQHIT + SETZM WARN + SKIPN CHARF ;TEST FOR EXISTANCE OF L H S + JRST EQFLOP + NUMBER ;IS L H S A NUMBER + JRST EQNUMB + MOVEI I,EQAAL +EQVAL: SETZM CHARF + PUSH SYM,I + PUSH P,STRING + PUSH P,STRING+1 + PUSH P,STRING+2 + PUSH P,[0] + JRST CLSTR + +PL: MOVE I,[2,,PLUS] + SKIPN CHARF + JRST RDITA ;UNARY PLUS + JRST SZPRT + +MN: MOVE I,[2,,MINUX] + SKIPN CHARF + MOVE I,[5,,UMINU] + JRST SZPRT + +AB: SKIPE CHARF ;ABSOLUTE VALUE + JRST ABERR ;NOT UNARY + MOVE I,[5,,UABS] + JRST SZPRT + +LB: SKIPN CHARF + JRST LP ;TREAT LIKE ( + NUMBER + JRST NUBRST + MOVEI I,FUNCT + JRST EQVAL + +RB=RP + +NUBRST: MOAN '<' FOLLOWS NUMBER + +NUSTRB: MOAN '(' FOLLOWS NUMBER + +EQFLOP: MOAN '=' FOLLOWS OPERATOR + +EQNUMB: MOAN '=' FOLLOWS NUMBER + +ABERR: MOAN NON-UNARY ABS + +TX: MOVE I,[4,,TIMES] + SKIPN CHARF + JRST RDITA ;UNARY TIMES + JRST SZPRT + +DL: $GET ;CONTINUE STATEMENT RC + $GET ;LF + $GET ;. + CAIE A,". ;DOT + JRST BDCONT + $GET ;F OR I + $GET ;CONTROL I OR SPACE + MOVE A,DIRPNT + MOVEM A,TPN ;RESET SAVED INPUT POINTER TO AVOID FILLING ITS BUFFER + MOVEI A,"$ + IDPB A,TPN + MOVEI A,40 + IDPB A,TPN + JRST RDITA + +ERRCON: TRNE FF,FRPSS2 ;NO OUTPUT ON SECOND PASS + JRST CONRBT +;MAY ALSO WANT TO USE STATEMENT PLUS LINE NUMBER TYPE TACTIC + MOVE B,DIRPNT +OUTRR: ILDB A,B + PUSHJ P,TYO + CAME B,TPN + JRST OUTRR + SKIPE ENDSTT + JRST CONERT +DORSTL: MOVEI A,40 + PUSHJ P,TYO + MOVEI A,"? ;POINT AT ERROR + PUSHJ P,TYO + MOVEI A,40 + PUSHJ P,TYO +DORSAL: $GET ;COPY UP TO LINE FEED + PUSHJ P,TYO + CAIE A,12 ;LF + JRST DORSAL +CONERT: PUSHJ P,TIPIS + PUSHJ P,CRR +CONRAT: +IRP AC,,[AA,A,B,C,D,I,P] + MOVE AC,ACSV!AC +TERMIN + JRST SWFLS ;GO BACK AND FLUSH + + +CONRBT: $GET + CAIE A,12 ;LF + JRST CONRBT + JRST CONRAT + +UP: SKIPN WARN ;FOR (NUMBER)^N + SKIPN STRING + JRST ITSEX + MOVEM A,R1SV ;SAVE THE ARROW + NUMBER + JRST CHEX ;ITS PART OF A NUMBER +ITSEX: MOVE I,[6,,STRSTR] + SKIPN CHARF + JRST EXMB + JRST SZPRT + +EXMB: MOAN UNARY ^ + +BDCONT: MOAN BAD CONTINUATION + +KL=CR ;SEMICOLON ACTS LIKE CR IN TERMINATING + +STRSTR: SKIPN STRING + JRST EXLS + NUMBER + SKIPA + JRST EXLS + SUBI I,61 + TDNE I,[-1,,777774] + JRST EXLS + MOVE A,STRING + TDNE A,[3777,,-1] + JRST EXLS + ADDI I,POWR + JRST @(I) + +EXLS: PUSH P,[ASCII !EXPLO!] + PUSH P,[ASCII !G !] + PUSH P,[0] + PUSH P,[1] + SETOM EXRET' + JRST FUNET + +DV: MOVE I,[4,,DIVIX] + SKIPN CHARF + MOVE I,[5,,UDIVI] + JRST SZPRT + +PSOPR: PUSH SYM,I ;PUSH OPERATOR FOR LATER EXCECUTION + SKIPN STRING + JRST RDITTS + PUSHJ P,SHORT ;CAN WE IMMEDIFY + PUSHJ P,MVOI ;AND MOVE OPERAND INTO STACK + JRST CLSTR + +PRODB: NUMBER ;OUTPUT WHAT IS IN STRING + SKIPE IMMED ;NO [ & ] IF IMMEDIATE USE + JRST OVNM + PUSH P,A + MOVEI A,"[ ;[ FOR CONSTANT + PUSHJ P,PUTREL + POP P,A + SETOM NUMFL +OVNM: CAIN I,"# + JRST PRDOC + + EXCH A,I + PUSHJ P,PUTREL + MOVE A,I +PRDOC: ILDB I,A + JUMPN I,OVNM + SKIPN NUMFL + POPJ P, + MOVEI A,"] ;] FOR CONSTANT + PUSHJ P,PUTREL + SETZM NUMFL + POPJ P, + +PRODC: HRLI A,440700 ;MAKE BYTE POINTER + JRST PRDOC + +LFTPR: SPECN + JRST RDITTS ;IGNORE LP ON STACK + +RCAR: HALT ;IMPOSSIBLE FOR THESE TO BE ON STACK +RPAR: HALT + +EQAAL: SPECN + SKIPE STRING + PUSHJ P,MVOI + MOVEI A,[ASCIZ ! MOVEM A!] + PUSHJ P,PRODC + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +ENDSAT: SPECN + SKIPN ENDSTT + JRST TOEARL + SKIPE STRING + PUSHJ P,MVOI +GETLF: $GET + CAIE A,12 ;LF + JRST GETLF +IRP AC,,[AA,A,B,C,D,I,P] + MOVE AC,ACSV!AC +TERMIN + JRST SWRET ;GO BACK + +MVOI: MOVE A,BTPNT + ILDB I,A + CAIN I,"& + JRST MVOALR ;OPERAND ALREADY THERE + MOVEI A,[ASCIZ ! MOVE A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVEI A!] +MVOIK: PUSHJ P,PRODC + MOVE A,ENN + AOS ENN +FINOF: PUSHJ P,PUTREL + MOVEI A,", + PUSHJ P,PUTREL + PUSHJ P,PRODB + RETLIN + POPJ P, + +MVOALR: AOS ENN + POPJ P, + +TOEARL: MOAN TOO MANY )'S + +PLUS: MOVEI A,[ASCIZ ! FADR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! ADD A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! ADDI A!] +OPERT: PUSHJ P,PRODC + SKIPE STRING + JRST GAINS + SOS ENN +OPRTE: MOVE A,ENN + SOS A + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +COMMAA: MOVEI A,", + PUSHJ P,PUTREL + MOVEI A,"A + JRST PUTREL + +GAINS: MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +MINUX: MOVEI A,[ASCIZ ! FSBR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! SUB A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! SUBI A!] + JRST OPERT + +TIMES: PUSHJ P,TMSTR + SKIPE IMMED + MOVEI A,[ASCIZ ! IMULI A!] + JRST OPERT + +DIVIX: MOVEI A,[ASCIZ ! FDVR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IDIV A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! IDIVI A!] + JRST OPERT + +UMINU: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE STRING + JRST MOABC + MOVEI A,[ASCIZ ! MOVNS A!] +UMINUC: PUSHJ P,PRODC + MOVE A,ENN + SOS A + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +MOABC: MOVEI A,[ASCIZ ! MOVN A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVNI A!] + PUSHJ P,MVOIK + JRST GAMB + +UABS: CAMN B,C + JRST BAKWD + SKIPE STRING + JRST MOABS + MOVEI A,[ASCIZ ! MOVMS A!] + JRST UMINUC + +MOABS: MOVEI A,[ASCIZ ! MOVM A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVMI A!] + PUSHJ P,MVOIK + JRST GAMB + +MVONT: MOVEI A,[ASCIZ ! MOVE A!] + PUSHJ P,PRODC + MOVE A,ENN + JRST ONMVS + +TMSTR: MOVEI A,[ASCIZ ! FMPR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IMUL A!] + POPJ P, + +BAKWD: PUSH SYM,A + JRST PSOPR + +UDIVI: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE INTEGR + JRST UINDV + SKIPN STRING + PUSHJ P,MVONT + MOVEI A,[ASCIZ ! HRLZI A!] + PUSHJ P,PRODC + MOVE A,ENN + SKIPN STRING + SOS A + PUSHJ P,PUTREL + MOVEI A,[ASCIZ !,201400!] + PUSHJ P,PRODC + RETLIN + AOS ENN + JRST DIVIX + +ONTMS: PUSHJ P,TMSTR + PUSHJ P,PRODC + MOVE A,ENN + SOS A +ONMVS: PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A +LSTCHX: PUSHJ P,PUTREL + RETLIN + POPJ P, + +POWR: GAMB?POWR2?POWAA?POWR4 + +POWR4: PUSHJ P,ONTMS +POWR2: PUSHJ P,ONTMS + JRST GAMB + +POWAA: PUSHJ P,MVONT + AOS ENN + PUSHJ P,ONTMS + SOS ENN + PUSHJ P,TMSTR + PUSHJ P,PRODC + RESTOR + JRST OPRTE + +COMMX: AOS (P) + SKIPE STRING + PUSHJ P,MVOI + JRST GAMB + +UINDV: MOAN INTEGER UNARY DIVIDE + +FUNCT: SETZM EXRET +FUNET: SKIPE STRING + PUSHJ P,MVOI + SPECN + PUSHJ P,MORFMC + MOVEI A,[ASCIZ ! PUSHJ P,!] + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + PUSHJ P,PRODC + PUSHJ P,PRODB + RESTOR + RETLIN + PUSHJ P,MORFNC + SKIPN EXRET + JRST RDITTS ;AS USED FROM FUNCT + JRST COMMT ;AS USED FROM STRSTR + +MORFMC: MOVE A,RANDM + MOVEM A,RANSV' + SKIPN CHARF ;NO ARGUMENTS + AOS ENN + SETOM CHARF + MOVEI A,"1 + CAMN A,ENN ;ARE ARGUMENT ALREADY IN A0 AND UP + POPJ P, + SETZM CORDM +MORYLP: PUSHJ P,ZENBD + AOS CORDM + SOSL RANSV + JRST MORYLP + POPJ P, + +MORFNC: MOVEI A,"1 + CAMN A,ENN + POPJ P, + MOVE A,RANDM + MOVEM A,CORDM' +MORXLP: PUSHJ P,ZENBD + SOSL CORDM + JRST MORXLP + POPJ P, + +ZENBD: MOVEI A,[ASCIZ ! EXCH A!] + PUSHJ P,PRODC + MOVE A,CORDM + ADDI A,"0 + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A + ADD A,CORDM + JRST LSTCHX + +TIPIS: MOVE A,TEMP + MOVEM A,BYTPNT +MORTP: ILDB A,BYTPNT + CAIN A,1 ;EXCLAMATION + POPJ P, + ADDI A," ;SPACE + PUSHJ P,TYO + JRST MORTP + +] ;END .I.FSW CONDITIONAL + +IFN LISTSW,[ + +;LISTING ROUTINES. + +PNTR: MOVEM 17,PNTSA+17 + MOVEI 17,PNTSA + BLT 17,PNTSA+16 + MOVE P,PNTSA+P ; P = 17 so must restore. +IFN P-17, .ERR P=17 assumption at PNTR! + SKIPL LSTONP + JRST PNTR5 + AOSE LISTPF + JRST PNTR1 + SKIPGE T,LISTAD + JRST PNTR2 + PUSHJ P,P6OD + HLRZS T + PUSHJ P,PSOS ;PRINT SPACE OR ' + PUSHJ P,PILPTS +PNTR3: HLRZ T,LISTWD + PUSHJ P,P6OD + MOVS T,LSTRLC + TLNE T,400000 + AOJ T, + PUSHJ P,PSOS + HRRZ T,LISTWD + PUSHJ P,P6OD + HRRZ T,LSTRLC + PUSHJ P,PSOS + PUSHJ P,PILPTS + PUSHJ P,PILPTS +PNTR4: MOVE TT,[440700,,LISTBF] +PNTR6: CAMN TT,PNTBP + JRST PNTR5A + ILDB A,TT + PUSHJ P,PILPT + JRST PNTR6 + +PNTR5A: CALL PNTCR + MOVE A,LISTBC + CAIE A,14 + JRST PNTR7 +PNTR5C: CALL PILPT ;OUTPUT THE ^L, + CALL PNTHDR ;AND THE PAGE NUMBER. + JRST PNTR5D + +PNTR7: MOVEI A,12 + PUSHJ P,PILPT +PNTR5D: SETOM LISTBC +PNTR5: MOVNI A,LISTBS*5-1 + MOVEM A,PNTSW ;DETECT OVERFLOW OF LISTBF + MOVE TT,[440700,,LISTBF] + MOVEM TT,PNTBP + MOVSI 17,PNTSA + BLT 17,17 + POPJ P, + +PNTR5B: MOVE A,LISTBC + CAIN A,14 + JRST PNTR5C + JRST PNTR5D + +PNTR2: MOVEI T,8 + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR3 + +PNTR1: MOVE TT,[440700,,LISTBF] + CAMN TT,PNTBP + JRST PNTR5B + MOVEI T,25. + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR4 + +PSOS: MOVEI A,"' + TRNN T,-1 +PILPTS: MOVEI A,40 + JRST PILPT + +P6OD: MOVE TT,[220300,,T] +P6OD1: ILDB A,TT + ADDI A,"0 + PUSHJ P,PILPT + TLNE TT,770000 + JRST P6OD1 + POPJ P, + +PNTCR: MOVEI A,^M ;OUTPUT ^M TO LST IF OPEN. +PILPTX: SKIPE LSTONP;OUTPUT CHAR TO LST IF LSTING. + JRST PILPT + RET + +PNTHDR: MOVEI A,^I + MOVEI B,10. ;MOVE TO COLUMN 80., + CALL PILPT + SOJG B,.-1 + PUSH P,LSTTTY + HLLOM B,LSTTTY ;POSITIVE SO TYOERR GOES ONLY TO LST. + TYPR [ASCIZ/Page /] + MOVE A,CPGN + CALL [AOJA A,DPNT] + REST LSTTTY +PNTCRR: CALL PNTCR ;OUTPUT CRLF TO LST IF OPEN. +PNTLF: MOVEI A,^J + JRST PILPTX + +DEFINE LSTM %A,B,C +IF1 [ [B] ? [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+LSTM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-LSTM0 +] +TERMIN + +A.LSTFF: AOS (P) ;RETURN NO VALUE. +; ADDR, CONTENTS IF NOT LISTING, CONTENTS IF LISTING. +LSTOFF: LSTM LSTONP,0,-1 + LSTM LSTPLM,[TLO B,4^5][JRST PSHLML] + LSTM RCHLST,RCHLS1,AOSN PNTSW + LSTM RCH1LS,RET,[CAILE A,^M] + LSTM POPLML,JFCL,[IDPB A,PNTBP] + JRST MDSCLR +LSTM0==.-LSTOFF + +LSTON: BLOCK LSTM0-1 + JRST MDSSET + +A.LSTN: SKIPN LISTP1 ;IF SHOULD LIST THIS PASS + JUMPGE FF,MACCR + SKIPE LISTP ;AND WANT LISTING, + CALL LSTON ;TURN ON LISTING OUTPUT. + JRST MACCR + +IFNDEF LISTBS,LISTBS==50. ;LISTBF SIZE IN WORDS. + +VBLK ;LISTING FEATURE VARIABLES + +PNTBP: 0 ;POINTER TO LISTING LINE BUFFER +LSTONP: 0 ;NONZERO WHEN OUTPUTTING TO LISTING FILE. +LISTP: +LISTON: 0 ;-1 IF LISTING ON +PNTSW: 0 ;-1 IF LAST CHR CR OR LF, OR -<# CHARS SPACE LEFT IN LISTBF> +LISTBF: BLOCK LISTBS +LISTAD: 0 ;ADDRESS OR -1 NONE 3.1 RELOC +LISTWD: 0 ;WORD +LSTRLC: 0 ;RELOCATION +LISTPF: 0 ;-1 OTHERS CONTAIN SOMETHING +LISTBC: 0 ;BREAK CHR CR LF OR FF OR -1 IF NONE SINCE LAST PNTR +LISTTM: 0 ;TEMP AT AEND +PNTSA: BLOCK 20 ;AC SAVE AREA FOR LISTING FEATURE +LISTP1: 0 ;POSITIVE => WANT TO LIST EVEN ON PASS 1. +] ;END IFN LISTSW, + +IFE LISTSW,VBLK + +;THESE VARIABLES ARE REFERENCED EVEN IF LISTSW IS 0. +LSTTTY: 0 ;TYOERR TYPES ON TTY IFF LE 0, ON LST IF NOT 0. +LSTPLM: TLO B,4^5 ;OR JRST PSHLML ;XCT'D BY PSHLMB. +POPLML: JFCL ;OR IDPB A,PNTSW ;XCT'D IN POPLMB. + +PBLK +IFE LISTSW, A.LSTN: A.LSTF: RET + +VBLK +IFN CREFSW,[ +CREFP: 0 ;SET BY C SWITCH TO REQUEST CREFFING. +CRFONP: 0 ;SET WHILE CREFFING. +CRFLFL: 0 ;LAST PAGNUM,,LINENUM OUTPUT. +CRFINU: JFCL\PUSHJ P,CRFUSE ;XCT THIS TO CREF NON-DEF OCCUR. +CRFLBL: JFCL\PUSHJ P,CRFLB1 ;XCT FOR DEF. OF NORMAL SYM. +CRFEQL: JFCL\PUSHJ P,CRFEQ1 ; FOR DEF. OF NORMAL SYM. OR INTSYM. +CRFMCD: JFCL\PUSHJ P,CRFMC1 ; FOR DEF. OF MACRO. +CRFDEF: JFCL\PUSHJ P,CRFDF1 ; FOR RANDOM DEF, CHECK FLAGS. +] +CRFILE: 0 ;SET => SHOULDN'T OUTPUT PAGNUM,,LINENUM'S +;USED BY .CRFILE INTSYM SO CAN'T BE IN CONDIT. +PBLK +IFN CREFSW,[ +CRFEQ1: MOVEI T,(B) + CAIN A,1 ;IF NOT PSEUDO OR NOT INTSYM, + CAIE T,INTSYM + JRST CRFLB1 ;IS NORMAL SYM. +CRFOD1: MOVSI T,600000 ;ELSE DEFINING INSN. + JRST CRFEQ2 + +CRFDF2: MOVEI T,(B) ;DECIDE WHETHER DEFINING MACRO OR PSEUDO. + CAIE T,MACCL + JRST CRFOD1 +CRFMC1: SKIPA T,[500000,,] ;DEFINING MACRO. +CRFLB1: MOVSI T,440000 ;DEFINING NORMAL SYM. +CRFEQ2: PUSH P,A + MOVE A,T + JRST CRFMA1 + +;COME HERE FOR NON-DEF; MUST DECIDE WHAT TYPE SYM. +CRFUSE: TLNE C,3NCRF ;SYM MAY HAVE CREFFING SUPPRESSED. + POPJ P, + PUSH P,A + CAIN A,1 + JRST CRFMAC ;PSEUDOS, MACROS. + MOVSI A,40000 ;FLAG FOR NORMAL SYM. + TRNN C,-1 + MOVSI A,200000 ;FLAG FOR INSNS. +CRFMA1: PUSH P,A + MOVE A,CLNN + HRL A,CPGN + AOBJN A,.+1 ;A HAS PAGNUM,,LINENUM . + SKIPGE CRFILE ;IF SHOULD OUTPUT IT, + JRST CRFUS1 + CAME A,CRFLFL ;AND HAS CHANGED, DO SO. + PUSHJ P,CRFOUT + MOVEM A,CRFLFL +CRFUS1: POP P,A + IOR A,SYM ;COMBINE SYM AND CREF FLAG. + PUSHJ P,CRFOUT + JRST POPAJ + +CRFMAC: MOVEI A,(B) + CAIN A,MACCL + SKIPA A,[100000,,] ;MACRO + MOVSI A,200000 ;PSEUDO-OP. + JRST CRFMA1 + +;DEFINING OCCURRENCE, MIGHT BE ANY TYPE SYM. +CRFDF1: CAIN A,1 ;TYPE 1 => MACRO OR PSEUDO. + JRST CRFDF2 + TRNE C,-1 ;ELSE INSN OR NORMAL SYM. + JRST CRFLB1 + JRST CRFOD1 + +DEFINE CRFM %A,B,C +IF1 [ [B] + [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+CRFM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-CRFM0] +TERMIN + + +A.CRFFF: AOS (P) ;.CRFOFF - STOP CREFFING. NO VAUE. +; LOCATION, NORMAL VALUE, VALUE WHILE CREFFING +CRFOFF: CRFM CRFONP,0,-1 + CRFM CRFLBL,JFCL,[PUSHJ P,CRFLB1] + CRFM CRFEQL,JFCL,[PUSHJ P,CRFEQ1] + CRFM CRFMCD,JFCL,[PUSHJ P,CRFMC1] + CRFM CRFINU,JFCL,[PUSHJ P,CRFUSE] + CRFM CRFDEF,JFCL,[PUSHJ P,CRFDF1] + POPJ P, +CRFM0==.-CRFOFF + +CRFON: BLOCK CRFM0-1 + POPJ P, + +A.CRFN: JUMPGE FF,MACCR + SKIPE CREFP ;.CRFON, IF HAVE CREF FILE, START CREFFING. + PUSHJ P,CRFON + JRST MACCR +] ;END IFN CREFSW, + +SUBTTL TS Routines for I/O & overall control + +IFN TS,.INSRT TSRTNS + +FEED1: SKIPA B,[40] +FEED: MOVEI B,5 + JRST TFEED + +VBLK + +IFG PURESW-DECSW,[ ;PURIFICATION ROUTINE + +PURIFG: -1 ;-1 IF NOT (YET) PURIFIED +] + VARIAB +VPAT: +VPATCH: BLOCK 20 +VPATCE=.-1 + +PBLK + +CONSTANTS + +PAT: +PATCH: BLOCK 100 +PATCHE: -1 + +IFG PURESW-DECSW,[LOC <.+1777>&-2000 ;SKIP TO NEXT PAGE + MAXPUR==._-10. ;FIRST PAGE ABOVE PURE PAGES +PRINTA Pure pages = ,\MAXPUR-MINPUR +] + +VBLK +PDL: BLOCK LPDL+1 + +IFN DECDBG, DECDBB: BLOCK 8000. ;SPACE FOR DEC DDT'S SYMS. + +.NSTGW +BBKCOD==. ;BEGIN BLANK CODING, CLEARED OUT DURING INITIALIZATION +IFG PURESW-DECSW,MINBNK==<.+1777>_-10. ;FIRST PAGE OF BLANK CODE +BNKBLK ;DUMP OUT ACCUMULATED BLANK CODING + + ;NOW MORE BLANK CODING + +BKBUF: BLOCK BSIZE+5 ;CURRENT BLOCK TO OUTPUT +GLOTB: BLOCK 20 ;GLOBAL TABLE, EACH ENTRY FLAGS,,ADR OF SQUOZE (SEE COMMENTS NEAR BEGINNING) +STRSTO: BLOCK STRL ;STRING STORAGE FOR GSYL AND FRIENDS +IFN FASLP,[ +FASB: BLOCK FASBL ;OUTPUT BUFFER FOR FASL MODE + ;FIRST WD 9 FOUR BIT CODE GROUPS, REST ASSOC STUFF +FASAT: BLOCK FASATL ;ATOM TABLE FOR FASL MODE + ;EACH ENTRY CONSISTS OF ATOM IN FORMAT DESIRED BY FASLOAD, + ;NAMELY: + ; HEADER WD. RH LENGTH IN WDS + ; 4.8-4.7 TYPE 0-PN 1 FIX 2 FLO 3 BIG (NOT IMPLEMENTED) + ; FOLLOWED BY PN OR VALUE + ;-EXCEPT- IF RH OF HEADER =0, THIS SLOT RESERVED FOR LIST + +] + +EBKCOD==. ;END BLANK CODING +.YSTGW + +PRINTA ST = ,\.-RL0 + +ST: ;SYMBOL TABLE 3 WORDS/SYM FIRST SQUOZE, SECOND "VALUE", 3RD FLAGS,,BLOCK. + BLOCK NRMWPS*SYMDSZ + +;LITERALS TABLES - CAN MOVE AND GROW. THESE TAGS & LENGTHS ARE JUST THE DEFAULTS +.SEE CONTBA ;ETC, WHICH CONTAIN THE ACTUAL ADDRESSES. SO DON'T USE THEM! +CONTAB: BLOCK LCONTB ;CONSTANTS TABLE, VALUES OF CONSTANTS THIS CONSTANTS AREA +CONGLO: BLOCK LCNGLO ;CONSTANTS GLOBAL TABLE, EACH ENTRY TWO WORDS + ;FIRST WD GLOTB ENTRY. SECOND WD ADR IN CONTAB OF CONSTANT TO WHICH IT REFERS +CONBIT: BLOCK LCONTB/12.+1 ;RELOCATION BITS AND ILNOPT BIT(SEE CPTMK) + ;3 BITS FOR EACH WORD OF CONTAB. + +;;INIT ;INITIALIZATION ROUTINES (IN MACRO TABLE, GET WIPED OUT) +IFN ITSSW\TNXSW,MINMAC==./2000 ;# OF 1ST PAGE HOLDING PART OF MACTAB. + +;NOTE THAT THIS CODE IS COPIED UPWARD WHEN MACTAB IS MOVED +;DUE TO SYMTAB EXPANSION. THEREFOR IT MUST REFER TO ITSELF +;INDEXED BY THE OFFSET OF WHERE IT IS FROM WHERE IT WAS ASSEMBLED. +;THAT IS KEPT IN CH1. ALL LITERALS MUST BE USED INDEX OF CH1, TOO. + +;MAC PROC TABLES +MACTBA: 773767750000 ;MACRO CHARACTER STORAGE (FIRST WORD 3 375'S) +INIT1: MOVE CH1,MACTAD ;GET ADDR THIS CODE REALLY STARTS AT. + SUBI CH1,MACTBA ;GET OFFSET FROM WHERE ASSEMBLED. + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1](CH1) + BLT A,EBKCOD-1 ;CLEAR OUT BLANK CODING + PUSH P,[SP4](CH1) ;NOW INIT THE SYMTAB & FINISHED. + +;INITIALIZE THE SYMTAB, EXPECT SIZE IN SYMLEN. +INITS: MOVE AA,SYMLEN ;SET UP THE OTHER VARS + IMUL AA,WPSTE ;DEALING WITH SYMTAB SIZE. + MOVEM AA,SYMSIZ + ADDI AA,ST ;ADDR OF START OF CONTAB. + MOVEM AA,CONTBA + MOVEM AA,PLIM + ADD AA,CONLEN ;ADD LENGTH OF CONTAB TO GET ADDR OF CONGLO TAB. + MOVEM AA,CONTBE ;WHICH IS ALSO THE END OF CONTAB. + MOVEM AA,CONGLA + MOVEM AA,CONGOL + MOVE A,CONLEN ;ADD IN LENGTH OF CONGLO (1/4 OF CONLEN) + LSH A,-2 + ADD AA,A + MOVEM AA,CONGLE ;TO GET END OF CONGLO, AND START OF CONBIT TABLE. + MOVEM AA,CONBIA + MOVE A,CONLEN + ADDI A,11. + IDIVI A,12. + ADD AA,A ;ADD LENGTH OF CONBIT (1/12 OF CONLEN) GETTING ADDR OF MACTAB. +IFN DECSW,[ + PUSH P,AA + ADDI AA,MACL-1 + IORI AA,1777 ;FIX ALLOCATION PROBLEMS ON KI-10 + CORE AA, + ETF [ASCIZ /No core for symbols/](CH1) + REST AA +] + MOVN A,SYMLEN + HRLZM A,SYMAOB ;AOBJN -> SYMTAB. + MOVE A,WPSTE + SUBI A,1 + MOVEM A,WPSTE1 + MOVN A,WPSTE + HRRM A,WPSTEB + CAMG AA,MACTAD ;MOVED MACTAB UP? + JRST INITS1(CH1) +IFN ITSSW\TNXSW,[ ;YES, GET CORE FOR INCREASE. + PUSH P,AA + MOVEI AA,MACL+1777(AA) + LSH AA,-10. ;1ST PAGE NOT NEEDED BY MACTAB. + MOVEI A,MACL+1777+MACTBA(CH1) + LSH A,-10. ;1ST PAGE MACTAB DOESN'T YET HAVE. + SUBM A,AA ;# PAGES NEEDED. + HRLZI AA,(AA) + HRRI AA,(A) ;-<# PAGES>,,<1ST NEEDED> + JUMPGE AA,INITS3(CH1) ;DON'T CALL IF NEED 0 PAGES, WOULD GET ONE. +IFN TNXSW, PUSHJ P,TCORGT +IFN ITSSW, .CALL INITSB(CH1) ? .VALUE +INITS3: REST AA +] + SUBM AA,MACTAD ;MACTAD _ SHIFT IN START OF MACTAB. + EXCH AA,MACTAD ;MACTAD GETS NEW START, AA HAS SHIFT. + MOVSI A,PTAB-CCOMPB + ADDM AA,PTAB(A) ;RELOCATE BYTE-PTRS INTO MACTAB. + AOBJN A,.-1(CH1) + MOVNI B,INITS2(CH1) + HRROI A,@EISYMP(CH1) + ADDI B,1(A) ;GET # WDS IN SECOND HALF OF INIT CODE. + HRRM AA,.+1(CH1) ;COPY 2ND HALF UPWARD WITH POP-LOOP. + POP A,(A) ;THIS INSN IMPURE. + SOJG B,.-1(CH1) + ADDI CH1,(AA) ;CHANGE OFFSET TO PT. TO NEW LOCATIONN OF INIT CODE. + JRST INITS2(CH1) ;JUMP INTO 2ND HALF, WHERE IT'S BEEN COPIED TO. +INITS2: HRROI A,INITS2-1(CH1) ;THEN COPY 1ST HALF (WHICH ENNDS BEFORE INITS2) + SUBI A,(AA) ;GET WHERE NOW ENDS, NOT WHERE WILL END. + MOVEI B,INITS2-MACTBA ;UP UNDERNEATH THE 2ND HALF. + HRRM AA,.+1(CH1) ;(THIS TWO-STEP COPYING HANDLES ALL OVERLAPS) + POP A,(A) + SOJG B,.-1(CH1) +INITS1: MOVE AA,SYMSIZ + SETZM ST + MOVE A,[ST,,ST+1](CH1) + BLT A,ST-1(AA) ;CLEAR OUT SYMBOL TABLE + SETZM ESBK ;DEFINE THEM IN OUTER BLOCK. + MOVEI AA,ISYMTB(CH1) + MOVS F,ISMTBB(CH1) ;GET SWAPPED VALUE OF FIRST INSTRUCTION +SP3: CAIL AA,EISYM1(CH1) + JRST SP1(CH1) ;DONE WITH INSTRUCTIONS + MOVE SYM,(AA) + JUMPE SYM,SP2(CH1) + TLZ SYM,740000 + PUSHJ P,ES ;WON'T SKIP + CAIA + .VALUE ;INSTRUCTION PRESENT TWICE IN TABLE!!?!? + HRLZI T,SYMC + HRLZ B,F + MOVSI C,3KILL + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP2: ADDI F,1000 + AOJA AA,SP3(CH1) +;AFTER HACKING ALL THE INSTRUCTIONS, STORED AS JUST THE NAMES IN NUMERIC ORDER, +;HACK ALL THE OTHER PREDEFINED SYMS, STORED AS 2 WORDS (NAME ? VALUE). +EISYMP: ;MAY BE MUNGED IF MORE SYMBOLS ARE ADDED AFTER EISYMT. +SP1: CAIL AA,EISYMT(CH1) + POPJ P, + MOVE SYM,(AA) + LDB T,[400400,,SYM](CH1) + ROT T,-4 + TLZ SYM,740000 + PUSHJ P,ES + CAIA + JRST SP5(CH1) ;SYM ALREADY DEFINED? (MIGHT BE .UAI, IN ITS AND IN MIDAS). + MOVE B,1(AA) + MOVSI C,3KILL + CAME T,[GLOETY,,](CH1) ;GLOBAL ENTRIES REALLY EXITS, HACKED TO DEFEAT ADDRESS LINKING + CAMN T,[GLOEXT,,](CH1) + TLO C,3LLV + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP5: AOS AA + AOJA AA,SP1(CH1) + +IFN ITSSW,[ +INITSB: SETZ ? 'CORBLK + MOVEI %CBNDR+%CBNDW ;BOTH READ AND WRITE. + MOVEI %JSELF ? AA ;INTO SELF, AA IS AOBJN -> PAGES. + SETZI %JSNEW ;FRESH PAGES. + + ;GOBBLE SYMS FROM SYSTEM + ;TABLE AREA IN SYSTEM: + ;FIRST LOC SYSYMB + ;LAST (AS OPPOSED TO LAST + 1) SYSYME + +TSYMGT: MOVE AA,[MXICLR-MXIMAC,,MXICLR] + .CALL INITSB ;GET MACTAB PAGES NNOT LOADED INTO. + .LOSE %LSSYS +IFN PURESW,[ + MOVE AA,[MINBNK-MINMAC,,MINBNK] + .CALL INITSB ;GET PAGES FOR BLANK CODE & SYMTAB. + .LOSE %LSSYS + SKIPN PURIFG + JRST TSYMG3 + JSP F,FLSPGS ;NOT PURIFIED => FLUSH PAGES + ,,MXIMAC ;OF MACTAB CREATED BY LOADING BUT NOT NEEDED. + +TSYMG3: +] + MOVEI A,EISYMT ;EISYMT FIRST LOC FOR ITS SYMS + MOVE B,[SIXBIT /CALLS/] ;SYSTEM CALLS + .GETSYS A, ;READ IN SYSTEM CALLS (SHOULD SKIP) + .VALUE + SKIPGE A + .VALUE ;.GETSYS DIDN'T UPDATE AOBJN POINTER + HRRM A,SP1 ;MARK END OF SYMS + ANDI A,-1 + CAIL A,MACTBA+MACL + .VALUE ;MACL TOO SMALL! INITS MIGHT LOSE. + MOVEI B,EISYMT + MOVEI AA,SYMC_<-18.+4> ;SQUOZE FLAG FOR SYM +TSYMG2: DPB AA,[400400,,(B)] + ADDI B,2 + CAIE B,(A) + JRST TSYMG2 + POPJ P, +]; IFN ITSSW + +SUBTTL Purifier routines - PURIFY$G, GAPFLS$G, also DECDBM + +IFN ITSSW\TNXSW,[ +IFN PURESW,[ ;HERE ARE THE GUTS OF THE PURIFY ROUTINE + +PURIFY: SKIPL NVRRUN +IFN ITSSW,[ .VALUE [ASCIZ /:Already run +/]] +IFN TNXSW,[ + JRST [ HRROI 1,[ASCIZ /? Already run +/] + PSOUT + HALTF + JRST .+1] ; If continued, go ahead anyway. +] ;IFN TNXSW +PURIF1: MOVEI P,17 ; Start PDL at 20 + JSP F,FLSPGS ; First flush blank-code pages, + ,,MINBNK ; incl. symbol table. + JSP F,FLSPGS + ,,MXICLR ; Flush MACTAB pages created by load but not needed. + JSP F,PURIFD + ,,MINPUR ; Purify pure pages. + SETZM PURIFG ; Set "purified" flag + MOVE [1,,2] ; Now clear out remains of data of self + MOVEI 1,0 + BLT 40 +IFN ITSSW,.VALUE [ASCIZ /:Purifiedpdump SYS;TS MIDAS/] +IFN TNXSW,[ + HRROI 1,[ASCIZ / Purified, now SAVE +/] + PSOUT + HALTF +] ; IFN TNXSW + +GAPFLS: JSP F,FLSPGS ; Flush gap pages created on initial load. + ,,MXIMAC +IFN ITSSW, .BREAK 16,300000 +IFN TNXSW, HALTF + + ; JSP F,FLSPGS + ; -<# pgs>,, + ; Flush pages specified by page AOBJN + +FLSPGS: MOVE A,(F) ; Get the page AOBJN +IFN ITSSW,[ + SYSCAL CORBLK,[MOVEI 0 ? MOVEI %JSELF ? A] + .LOSE 1000 +] +IFN TNXSW,[ + ASH A,1 ; Multiply # pages, page # by 2. + HLRE B,A + HRLI A,.FHSLF + MOVNS B + TLO B,(PM%CNT) ; Say hacking repeat count +FLSPG2: SYSCAL PMAP,[[-1] ? A ? B] ; Flush these pages. + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI B,-1(B) ; Else, on 10X, must iterate manually. + TRNE B,400000 ; See if became "negative". + JRST .+1 ; Yep, done with manual iteration. + AOJA A,FLSPG2] ; Nope, bump page #. +] + JRST 1(F) + + ; JSP F,PURIFD - Just like FLSPGS, but purifies the pages instead. + +PURIFD: MOVE A,(F) ; Get page AOBJN +IFN ITSSW,[ + SYSCAL CORBLK,[MOVEI %CBNDR ; Read access only. + MOVEI %JSELF ? A] + .LOSE 1000 +] +IFN TNXSW,[ + ASH A,1 ; Double everything. + HLRE B,A + MOVNS B + HRLI A,.FHSLF +PURID1: SYSCAL SPACS,[A ? [PA%RD+PA%EX]] + ADDI A,1 + SOJG B,PURID1 +] + JRST 1(F) + +IFN TNXSW,[ + + ; PURSAV - More useful hack for 10X/20X since it preserves page access +PURSV0: PUSHJ P,RDJERR +PURSAV: MOVEI P,20 + HRROI R1,[ASCIZ /Pure-Save to file: /] + PSOUT + MOVSI R1,(GJ%NEW+GJ%FOU+GJ%SHT+GJ%FNS) + MOVE R2,[.PRIIN,,.PRIOU] + GTJFN ; Get JFN from TTY + JRST PURSV0 + SETZM PURIFG ; Claim purified... + SETOM MEMDBG ; and keeping watch on memory. + HRLI R1,.FHSLF + MOVEI R2,[ + 2*<0-MINBNK>,,0+SS%RD+SS%WR+SS%EXE ; Variables/buffers + 2*,,2*MINMAC+SS%RD+SS%WR+SS%EXE ; MACTAB init + 2*,,2*MINPUR+SS%RD+SS%EXE ; Purify pure pages. + 0 ] ; End of SSAVE table + SETZ R3, + SSAVE ; Do it! + HRROI R1,[ASCIZ /Saved./] + PSOUT + HALTF +] ; IFN TNXSW + +] ; IFN PURESW +] ; IFN ITSSW\TNXSW + +IFN DECDBG,[ +DECDBM: 0 + HRLZ A,.JBSYM ;GET ADDR OF START OF DDT SYMS, + HRRI A,DECDBB+200 ;LEAVE 200 WD SPACE BEFORE THEM. + HRRM A,.JBSYM ;MOVE THEM INTO SPACE PROVIDED + HLRE B,.JBSYM + MOVMS B + BLT A,DECDBB+177(B) ;SO THEY WON'T GET IN MACTAB'S WAY. + JRST @DECDBM +] + +CONSTANTS + +;;ISYMS ;INITIAL SYMBOL TABLE + +IFNDEF JSYS,JSYS=104_33 ;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE + +ISMTBB: JSYS ;FIRST OP. CODE IN ISYMTB + +ISYMTB: + +; 104-177 (JSYS - FDVRB) + +SQUOZE 10,JSYS ;BBN PAGER INSTRUCTION +SQUOZE 10,ADJSP ;KL10 INSTRUCTION + 0 + 0 + +SQUOZE 10,DFAD ;KI10 INSTRUCTION +SQUOZE 10,DFSB ;KI10 INSTRUCTION +SQUOZE 10,DFMP ;KI10 INSTRUCTION +SQUOZE 10,DFDV ;KI10 INSTRUCTION +SQUOZE 10,DADD ;KL10 INSTRUCTION +SQUOZE 10,DSUB ;KL10 INSTRUCTION +SQUOZE 10,DMUL ;KL10 INSTRUCTION +SQUOZE 10,DDIV ;KL10 INSTRUCTION +SQUOZE 10,DMOVE ;KI10 INSTRUCTION +SQUOZE 10,DMOVN ;KI10 INSTRUCTION + +SQUOZE 10,FIX ;KI10 INSTRUCTION +SQUOZE 10,EXTEND ;KL10 INSTRUCTION +SQUOZE 10,DMOVEM ;KI10 INSTRUCTION +SQUOZE 10,DMOVNM ;KI10 INSTRUCTION +SQUOZE 10,FIXR ;KI10 INSTRUCTION +SQUOZE 10,FLTR ;KI10 INSTRUCTION + +SQUOZE 10,UFA ;KA/KI10 INSTRUCTION +SQUOZE 10,DFN ;KA/KI10 INSTRUCTION +SQUOZE 10,FSC + +SQUOZE 10,IBP +SQUOZE 10,ILDB +SQUOZE 10,LDB +SQUOZE 10,IDPB +SQUOZE 10,DPB + +SQUOZE 10,FAD +SQUOZE 10,FADL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FADM +SQUOZE 10,FADB +SQUOZE 10,FADR +SQUOZE 10,FADRI ;PDP10 INSTRUCTION +SQUOZE 10,FADRM +SQUOZE 10,FADRB +SQUOZE 10,FSB +SQUOZE 10,FSBL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FSBM +SQUOZE 10,FSBB +SQUOZE 10,FSBR +SQUOZE 10,FSBRI ;PDP10 INSTRUCTION +SQUOZE 10,FSBRM +SQUOZE 10,FSBRB +SQUOZE 10,FMP +SQUOZE 10,FMPL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FMPM +SQUOZE 10,FMPB +SQUOZE 10,FMPR +SQUOZE 10,FMPRI ;PDP10 INSTRUCTION +SQUOZE 10,FMPRM +SQUOZE 10,FMPRB +SQUOZE 10,FDV +SQUOZE 10,FDVL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FDVM +SQUOZE 10,FDVB +SQUOZE 10,FDVR +SQUOZE 10,FDVRI ;PDP10 INSTRUCTION +SQUOZE 10,FDVRM +SQUOZE 10,FDVRB + +; 200-277 (MOVE - SUBB) + +SQUOZE 10,MOVE +SQUOZE 10,MOVEI +SQUOZE 10,MOVEM +SQUOZE 10,MOVES +SQUOZE 10,MOVS +SQUOZE 10,MOVSI +SQUOZE 10,MOVSM +SQUOZE 10,MOVSS +SQUOZE 10,MOVN +SQUOZE 10,MOVNI +SQUOZE 10,MOVNM +SQUOZE 10,MOVNS +SQUOZE 10,MOVM +SQUOZE 10,MOVMI +SQUOZE 10,MOVMM +SQUOZE 10,MOVMS + +SQUOZE 10,IMUL +SQUOZE 10,IMULI +SQUOZE 10,IMULM +SQUOZE 10,IMULB +SQUOZE 10,MUL +SQUOZE 10,MULI +SQUOZE 10,MULM +SQUOZE 10,MULB +SQUOZE 10,IDIV +SQUOZE 10,IDIVI +SQUOZE 10,IDIVM +SQUOZE 10,IDIVB +SQUOZE 10,DIV +SQUOZE 10,DIVI +SQUOZE 10,DIVM +SQUOZE 10,DIVB + +SQUOZE 10,ASH +SQUOZE 10,ROT +SQUOZE 10,LSH +SQUOZE 10,JFFO ;PDP10 INSTRUCTION +SQUOZE 10,ASHC +SQUOZE 10,ROTC +SQUOZE 10,LSHC +SQUOZE 10,CIRC ;AI PDP10 INST. CIRCULATE: ROTC WITH AC+1 GOING THE WRONG WAY + +SQUOZE 10,EXCH +SQUOZE 10,BLT +SQUOZE 10,AOBJP +SQUOZE 10,AOBJN +SQUOZE 10,JRST +SQUOZE 10,JFCL +SQUOZE 10,XCT +SQUOZE 10,MAP ;KI10 INSTRUCTION + +SQUOZE 10,PUSHJ +SQUOZE 10,PUSH +SQUOZE 10,POP +SQUOZE 10,POPJ +SQUOZE 10,JSR +SQUOZE 10,JSP +SQUOZE 10,JSA +SQUOZE 10,JRA + +SQUOZE 10,ADD +SQUOZE 10,ADDI +SQUOZE 10,ADDM +SQUOZE 10,ADDB +SQUOZE 10,SUB +SQUOZE 10,SUBI +SQUOZE 10,SUBM +SQUOZE 10,SUBB + +; 300-377 (CAI - SOSG) + +SQUOZE 10,CAI +SQUOZE 10,CAIL +SQUOZE 10,CAIE +SQUOZE 10,CAILE +SQUOZE 10,CAIA +SQUOZE 10,CAIGE +SQUOZE 10,CAIN +SQUOZE 10,CAIG +SQUOZE 10,CAM +SQUOZE 10,CAML +SQUOZE 10,CAME +SQUOZE 10,CAMLE +SQUOZE 10,CAMA +SQUOZE 10,CAMGE +SQUOZE 10,CAMN +SQUOZE 10,CAMG + +SQUOZE 10,JUMP +SQUOZE 10,JUMPL +SQUOZE 10,JUMPE +SQUOZE 10,JUMPLE +SQUOZE 10,JUMPA +SQUOZE 10,JUMPGE +SQUOZE 10,JUMPN +SQUOZE 10,JUMPG +SQUOZE 10,SKIP +SQUOZE 10,SKIPL +SQUOZE 10,SKIPE +SQUOZE 10,SKIPLE +SQUOZE 10,SKIPA +SQUOZE 10,SKIPGE +SQUOZE 10,SKIPN +SQUOZE 10,SKIPG + +SQUOZE 10,AOJ +SQUOZE 10,AOJL +SQUOZE 10,AOJE +SQUOZE 10,AOJLE +SQUOZE 10,AOJA +SQUOZE 10,AOJGE +SQUOZE 10,AOJN +SQUOZE 10,AOJG +SQUOZE 10,AOS +SQUOZE 10,AOSL +SQUOZE 10,AOSE +SQUOZE 10,AOSLE +SQUOZE 10,AOSA +SQUOZE 10,AOSGE +SQUOZE 10,AOSN +SQUOZE 10,AOSG +SQUOZE 10,SOJ +SQUOZE 10,SOJL +SQUOZE 10,SOJE +SQUOZE 10,SOJLE +SQUOZE 10,SOJA +SQUOZE 10,SOJGE +SQUOZE 10,SOJN +SQUOZE 10,SOJG +SQUOZE 10,SOS +SQUOZE 10,SOSL +SQUOZE 10,SOSE +SQUOZE 10,SOSLE +SQUOZE 10,SOSA +SQUOZE 10,SOSGE +SQUOZE 10,SOSN +SQUOZE 10,SOSG + +; 400-477 (SETZ - SETOB) + +SQUOZE 10,SETZ +SQUOZE 10,SETZI +SQUOZE 10,SETZM +SQUOZE 10,SETZB +SQUOZE 10,AND +SQUOZE 10,ANDI +SQUOZE 10,ANDM +SQUOZE 10,ANDB +SQUOZE 10,ANDCA +SQUOZE 10,ANDCAI +SQUOZE 10,ANDCAM +SQUOZE 10,ANDCAB +SQUOZE 10,SETM +SQUOZE 10,SETMI +SQUOZE 10,SETMM +SQUOZE 10,SETMB +SQUOZE 10,ANDCM +SQUOZE 10,ANDCMI +SQUOZE 10,ANDCMM +SQUOZE 10,ANDCMB +SQUOZE 10,SETA +SQUOZE 10,SETAI +SQUOZE 10,SETAM +SQUOZE 10,SETAB +SQUOZE 10,XOR +SQUOZE 10,XORI +SQUOZE 10,XORM +SQUOZE 10,XORB +SQUOZE 10,IOR +SQUOZE 10,IORI +SQUOZE 10,IORM +SQUOZE 10,IORB +SQUOZE 10,ANDCB +SQUOZE 10,ANDCBI +SQUOZE 10,ANDCBM +SQUOZE 10,ANDCBB +SQUOZE 10,EQV +SQUOZE 10,EQVI +SQUOZE 10,EQVM +SQUOZE 10,EQVB +SQUOZE 10,SETCA +SQUOZE 10,SETCAI +SQUOZE 10,SETCAM +SQUOZE 10,SETCAB +SQUOZE 10,ORCA +SQUOZE 10,ORCAI +SQUOZE 10,ORCAM +SQUOZE 10,ORCAB +SQUOZE 10,SETCM +SQUOZE 10,SETCMI +SQUOZE 10,SETCMM +SQUOZE 10,SETCMB +SQUOZE 10,ORCM +SQUOZE 10,ORCMI +SQUOZE 10,ORCMM +SQUOZE 10,ORCMB +SQUOZE 10,ORCB +SQUOZE 10,ORCBI +SQUOZE 10,ORCBM +SQUOZE 10,ORCBB +SQUOZE 10,SETO +SQUOZE 10,SETOI +SQUOZE 10,SETOM +SQUOZE 10,SETOB + +; 500-577 (HLL - HLRES) + +SQUOZE 10,HLL +SQUOZE 10,HLLI +SQUOZE 10,HLLM +SQUOZE 10,HLLS +SQUOZE 10,HRL +SQUOZE 10,HRLI +SQUOZE 10,HRLM +SQUOZE 10,HRLS +SQUOZE 10,HLLZ +SQUOZE 10,HLLZI +SQUOZE 10,HLLZM +SQUOZE 10,HLLZS +SQUOZE 10,HRLZ +SQUOZE 10,HRLZI +SQUOZE 10,HRLZM +SQUOZE 10,HRLZS +SQUOZE 10,HLLO +SQUOZE 10,HLLOI +SQUOZE 10,HLLOM +SQUOZE 10,HLLOS +SQUOZE 10,HRLO +SQUOZE 10,HRLOI +SQUOZE 10,HRLOM +SQUOZE 10,HRLOS +SQUOZE 10,HLLE +SQUOZE 10,HLLEI +SQUOZE 10,HLLEM +SQUOZE 10,HLLES +SQUOZE 10,HRLE +SQUOZE 10,HRLEI +SQUOZE 10,HRLEM +SQUOZE 10,HRLES +SQUOZE 10,HRR +SQUOZE 10,HRRI +SQUOZE 10,HRRM +SQUOZE 10,HRRS +SQUOZE 10,HLR +SQUOZE 10,HLRI +SQUOZE 10,HLRM +SQUOZE 10,HLRS +SQUOZE 10,HRRZ +SQUOZE 10,HRRZI +SQUOZE 10,HRRZM +SQUOZE 10,HRRZS +SQUOZE 10,HLRZ +SQUOZE 10,HLRZI +SQUOZE 10,HLRZM +SQUOZE 10,HLRZS +SQUOZE 10,HRRO +SQUOZE 10,HRROI +SQUOZE 10,HRROM +SQUOZE 10,HRROS +SQUOZE 10,HLRO +SQUOZE 10,HLROI +SQUOZE 10,HLROM +SQUOZE 10,HLROS +SQUOZE 10,HRRE +SQUOZE 10,HRREI +SQUOZE 10,HRREM +SQUOZE 10,HRRES +SQUOZE 10,HLRE +SQUOZE 10,HLREI +SQUOZE 10,HLREM +SQUOZE 10,HLRES + +; 600-677 (TRN - TSON) + +SQUOZE 10,TRN +SQUOZE 10,TLN +SQUOZE 10,TRNE +SQUOZE 10,TLNE +SQUOZE 10,TRNA +SQUOZE 10,TLNA +SQUOZE 10,TRNN +SQUOZE 10,TLNN +SQUOZE 10,TDN +SQUOZE 10,TSN +SQUOZE 10,TDNE +SQUOZE 10,TSNE +SQUOZE 10,TDNA +SQUOZE 10,TSNA +SQUOZE 10,TDNN +SQUOZE 10,TSNN +SQUOZE 10,TRZ +SQUOZE 10,TLZ +SQUOZE 10,TRZE +SQUOZE 10,TLZE +SQUOZE 10,TRZA +SQUOZE 10,TLZA +SQUOZE 10,TRZN +SQUOZE 10,TLZN +SQUOZE 10,TDZ +SQUOZE 10,TSZ +SQUOZE 10,TDZE +SQUOZE 10,TSZE +SQUOZE 10,TDZA +SQUOZE 10,TSZA +SQUOZE 10,TDZN +SQUOZE 10,TSZN +SQUOZE 10,TRC +SQUOZE 10,TLC +SQUOZE 10,TRCE +SQUOZE 10,TLCE +SQUOZE 10,TRCA +SQUOZE 10,TLCA +SQUOZE 10,TRCN +SQUOZE 10,TLCN +SQUOZE 10,TDC +SQUOZE 10,TSC +SQUOZE 10,TDCE +SQUOZE 10,TSCE +SQUOZE 10,TDCA +SQUOZE 10,TSCA +SQUOZE 10,TDCN +SQUOZE 10,TSCN +SQUOZE 10,TRO +SQUOZE 10,TLO +SQUOZE 10,TROE +SQUOZE 10,TLOE +SQUOZE 10,TROA +SQUOZE 10,TLOA +SQUOZE 10,TRON +SQUOZE 10,TLON +SQUOZE 10,TDO +SQUOZE 10,TSO +SQUOZE 10,TDOE +SQUOZE 10,TSOE +SQUOZE 10,TDOA +SQUOZE 10,TSOA +SQUOZE 10,TDON +SQUOZE 10,TSON + +EISYM1: + +; I/O INSTRUCTIONS + +SQUOZE 4,BLKI +BLKI IOINST +SQUOZE 4,DATAI +DATAI IOINST +SQUOZE 4,BLKO +BLKO IOINST +SQUOZE 4,DATAO +DATAO IOINST +SQUOZE 4,CONO +CONO IOINST +SQUOZE 4,CONI +CONI IOINST +SQUOZE 4,CONSZ +CONSZ IOINST +SQUOZE 4,CONSO +CONSO IOINST + +;EXTEND MNEMONICS + +SQUOZE 10,CMPSL +001000,, +SQUOZE 10,CMPSE +002000,, +SQUOZE 10,CMPSLE +003000,, +SQUOZE 10,EDIT +004000,, +SQUOZE 10,CMPSGE +005000,, +SQUOZE 10,CMPSN +006000,, +SQUOZE 10,CMPSG +007000,, +SQUOZE 10,CVTDBO +010000,, +SQUOZE 10,CVTDBT +011000,, +SQUOZE 10,CVTBDO +012000,, +SQUOZE 10,CBTBDT +013000,, +SQUOZE 10,MOVSO +014000,, +SQUOZE 10,MOVST +015000,, +SQUOZE 10,MOVSLJ +016000,, +SQUOZE 10,MOVSRJ +017000,, +SQUOZE 10,XBLT +020000,, + +;OLD PROGRAMS USE THESE NAMES + +SQUOZE 10,CLEAR +SETZ +SQUOZE 10,CLEARI +SETZI +SQUOZE 10,CLEARM +SETZM +SQUOZE 10,CLEARB +SETZB + +;RANDOM ALIAS NAMES + +SQUOZE 10,ADJBP ;KL10 FORM OF IBP WITH VARIABLE NUMBER TO INCREMENT +IBP +SQUOZE 10,JFOV ;PDP10 INSTRUCTION (PC CHANGE ON PDP6) +JFCL 1, +SQUOZE 10,JCRY1 +JFCL 2, +SQUOZE 10,JCRY0 +JFCL 4, +SQUOZE 10,JCRY +JFCL 6, +SQUOZE 10,JOV +JFCL 10, +SQUOZE 10,PORTAL ;KI10 INSTRUCTION +JRST 1, +SQUOZE 10,JRSTF +JRST 2, +SQUOZE 10,HALT +JRST 4, +SQUOZE 10,XJRSTF ;KL10 INSTRUCTION +JRST 5, +SQUOZE 10,XJEN ;KL10 INSTRUCTION +JRST 6, +SQUOZE 10,XPCW ;KL10 INSTRUCTION +JRST 7, +SQUOZE 10,JEN +JRST 12, +SQUOZE 10,SFM ;KL10 INSTRUCTION +JRST 14, +SQUOZE 10,XMOVEI ;KL10 INSTRUCTION +SETMI +SQUOZE 10,XHLLI ;KL10 INSTRUCTION +HLLI + +;PDP6 HAS LONG FORM ROUNDED INSTEAD OF IMMEDIATES + +IRPS INST,,FAD FSB FMP FDV + SQUOZE 10,INST!RL + INST!RI +TERMIN + +;; redefines DEFSYM so as to make entry into initial symbol table + +DEFINE DEFSYM X/ + IRPS Z,,[X] + SQUOZE 8.,Z + Z + .ISTOP + TERMIN +TERMIN + +IFN DECSW,[ +IFE CVTSW,[ +.DECDF DEFSYM + +IFN DECBSW,.INSRT DECBTS +];IFE CVTSW +IFN CVTSW,[ +.INSRT DECDFS +];IFN CVTSW +] ;IFN DECSW + +IFN TNXSW,[;; DEFINE JSYS'S ON TENEX VERSION +IFE CVTSW,[ +.TNXJS DEFSYM +.INSRT TWXBTS +];IFE CVTSW +IFN CVTSW,[ +.INSRT TNXDFS +];IFN CVTSW +] ;IFN TNXSW + + +SQUOZE 10,.OSMID ; Crock here - in TNX version, SITINI sets value at +OSMID: OSMIDAS ; runtime before syms spread. +SQUOZE 4,.SITE +A.SITE +SQUOZE 4,RIM10 +ARIM10,,SRIM +SQUOZE 4,SBLK +SBLKS,,SRIM +SQUOZE 4,RIM +ARIM,,SRIM +SQUOZE 4,SQUOZE +ASQOZ +SQUOZE 4,.RSQZ +-1,,ASQOZ +SQUOZE 4,XWD +AXWORD +SQUOZE 4,CONSTA +CNSTNT +SQUOZE 4,ASCIC +EOFCH,,AASCIZ +SQUOZE 4,RADIX +ARDIX + +SQUOZE 4,END +AEND +SQUOZE 4,TITLE +ATITLE +SQUOZE 4,.BEGIN +A.BEGIN +SQUOZE 4,.END +A.END +SQUOZE 4,VARIAB +AVARIAB +SQUOZE 4,SIXBIT +ASIXBIT +SQUOZE 4,ASCII +AASCII +SQUOZE 4,ASCIZ +AASCIZ +SQUOZE 4,.ASCII +A.ASCII +SQUOZE 4,.ASCVL +A.ASCV +SQUOZE 4,BLOCK +ABLOCK +SQUOZE 4,LOC +ALOC +SQUOZE 4,OFFSET +AOFFSET +SQUOZE 4,.SBLK +SIMBLK +SQUOZE 4,RELOCA +ARELOCA +SQUOZE 4,1PASS +A1PASS +SQUOZE 4,.DECSA +A.DECSA +SQUOZE 4,.DECRE +A.DECRE +SQUOZE 4,.DECTX +A.DCTX + +SQUOZE 4,.DECTW +A.DECTW +SQUOZE 4,NOSYMS +ANOSYMS +SQUOZE 4,EXPUNGE +AEXPUNGE +SQUOZE 4,EQUALS +AEQUALS +SQUOZE 4,NULL +ANULL +SQUOZE 4,SUBTTL +ANULL +SQUOZE 4,WORD +AWORD +SQUOZE 4,.SYMTAB +A.SYMTAB +SQUOZE 4,.SEE +A.SEE +SQUOZE 4,.AUXIL +MACCR +SQUOZE 4,.MRUNT +A.MRUNT +SQUOZE 4,.SYMCN +A.SYMC +SQUOZE 4,.TYPE +A.TYPE +SQUOZE 4,.FORMAT +A.FORMAT +SQUOZE 4,.OP +A.OP +SQUOZE 4,.AOP +A.AOP +SQUOZE 4,.RADIX +A.RADIX +SQUOZE 4,.FATAL +A.FATAL +SQUOZE 4,.BP +A.BP +SQUOZE 4,.BM +A.BM +SQUOZE 4,.LZ +A.LZ +SQUOZE 4,.TZ +A.TZ +SQUOZE 4,.DPB +A.DPB +SQUOZE 4,.LDB +A.LDB +SQUOZE 4,.IBP +A.IBP +SQUOZE 4,.1STWD +A.1STWD +SQUOZE 4,.NTHWD +A.NTHWD + +IRPS X,,[.BIND=0,.KILL=3KILL,.HKILL=3SKILL,.XCREF=3NCRF,.DOWN=3DOWN] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,A.KILL +TERMIN + +SQUOZE 4,.LSTON +A.LSTN +SQUOZE 4,.LSTOF +A.LSTF + +IRPS X,,[.MLLIT=CONSML,.PASS=A.PASS,.PPASS=A.PPASS,.SUCCESS=A.SUCCESS +.HKALL=HKALL,.STGSW=STGSW,.LITSW=LITSW,.AVAL1=AVAL1,.AVAL2=AVAL2,.ERRCNT=ERRCNT +.ASKIP=A.ASKIP,.CURLN=CLNN,.CURPG=CPGN,.QMTCH=QMTCH,.STPLN=A.STPLN,.STPPG=A.STPPG] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,INTSYM +TERMIN + +;CONDITIONALS (SEE ALSO IFSE, IFSN) + +SQUOZE 4,IFG +JUMPG A,COND +SQUOZE 4,IFGE +JUMPGE A,COND +SQUOZE 4,IFE +JUMPE A,COND +SQUOZE 4,IFLE +JUMPLE A,COND +SQUOZE 4,IFL +JUMPL A,COND +SQUOZE 4,IFN +JUMPN A,COND +SQUOZE 4,.ELSE +SKIPE A.ELSE +SQUOZE 4,.ALSO +SKIPN A.ELSE + +SQUOZE 4,IF1 +TRNE FF,COND1 +SQUOZE 4,IF2 +TRNN FF,COND1 +SQUOZE 4,IFDEF ;ASSEMBLE IF SYM DEFINED +JUMPG A,DEFCND +SQUOZE 4,IFNDEF ;ASSEMBLE IF SYM NOT DEFINED +JUMPE A,DEFCND +SQUOZE 4,IFB ;ASSEMBLE IF STRING BLANK (HAS NO SQUOZE CHARS) +JUMPLE C,SBCND +SQUOZE 4,IFNB ;ASSEMBLE IF STRING NOT BLANK +JUMPG C,SBCND +SQUOZE 4,IFSQ ;ASSEMBLE IF STRING ARG IS ALL SQUOZE +JUMPLE B,SBCND +SQUOZE 4,IFNSQ ;ASSEMBLE IF STRING ARG IS NOT ALL SQUOZE. +JUMPG B,SBCND + +SQUOZE 4,PRINTX +APRIN2,,APRINT +SQUOZE 4,PRINTC +APRIN3,,APRINT +SQUOZE 4,COMMEN +APRIN1,,APRINT +SQUOZE 4,.TYO +A.TYO +SQUOZE 4,.TYO6 +A.TYO6 +SQUOZE 4,.ERR +A.ERR + +SQUOZE 4,.RELP +A.RELP +SQUOZE 4,.ABSP +A.ABSP +SQUOZE 4,.RL1 +A.RL1 +SQUOZE 4,.LIBRA +LLIB,,A.LIB +SQUOZE 4,.LENGTH +A.LENGTH +SQUOZE 4,.LIFS +LTCP,,A.LIB +SQUOZE 4,.ELDC +A.ELDC +IRPS A,,E N G LE GE L +SQUOZE 4,.LIF!A +JUMP!A A.LDCV +TERMIN +SQUOZE 4,.SLDR +A.SLDR + +SQUOZE 4,. +GTVLP +SQUOZE 4,.LOP +A.LOP +SQUOZE 40,$. +0 +SQUOZE 44,$R. +0 +SQUOZE 40,$O. ;(OH) GLOBAL OFFSET +0 +SQUOZE 40,$L. ;REAL LOCATION (WITHOUT OFFSET) +0 +SQUOZE 40,.LVAL1 +0 +SQUOZE 40,.LVAL2 +0 +SQUOZE 4,.LNKOT +A.LNKOT +SQUOZE 4,.NSTGW +1,,STGWS +SQUOZE 4,.YSTGW +-1,,STGWS +SQUOZE 4,.LIBRQ +A.LIBRQ +SQUOZE 4,.GLOBAL +ILGLI,,A.GLOB +SQUOZE 4,.SCALAR +ILVAR,,A.GLOB +SQUOZE 4,.VECTOR +ILVAR\ILFLO,,A.GLOB + +SQUOZE 4,.BYTC +NBYTS,,INTSYM +SQUOZE 4,.BYTE +A.BYTE +SQUOZE 4,.WALGN +A.WALGN + +;CREF PSEUDO-OPS. +SQUOZE 4,.CRFON +A.CRFN ;START CREFFING. +SQUOZE 4,.CRFOFF +A.CRFFF ;STOP CREFFING. +SQUOZE 4,.CRFIL +CRFILE,,INTSYM + +IFE CREFSW,[ + A.CRFN==ASSEM1 ;THESE DO NOTHING IF CAN'T CREF. + A.CRFFF==ASSEM1 +] + +IFN MACSW,[ ;MACRO PROCESSOR PSEUDOS +;MACROS GET DEFINED AS +;SQUOZE 4, +;,, MACCL + +SQUOZE 4,REPEAT +AREPEAT +SQUOZE 4,DEFINE +ADEFINE +SQUOZE 4,IRP +NIRPO,,AIRP +SQUOZE 4,IRPC +NIRPC,,AIRP +SQUOZE 4,IRPS +NIRPS,,AIRP +SQUOZE 4,IRPW +NIRPW,,AIRP +SQUOZE 4,IRPNC +NIRPN,,AIRP +SQUOZE 4,TERMIN +ATERMIN +SQUOZE 4,.QUOTE +A.QOTE +SQUOZE 4,.STOP +(400000)A.STOP +SQUOZE 4,.ISTOP +A.STOP +SQUOZE 4,.RPCNT +CRPTCT,,INTSYM +SQUOZE 4,.GSSET +A.GSSET +SQUOZE 4,.GSCNT +GENSM,,INTSYM +SQUOZE 4,.GO +A.GO +SQUOZE 4,.TAG +A.TAG +SQUOZE 4,.IRPCNT +CIRPCT,,INTSYM +IFN RCHASW,[SQUOZE 4,.TTYMAC +A.TTYM +] +SQUOZE 4,IFSE +SKIPN SCOND +SQUOZE 4,IFSN +SKIPE SCOND +] + +IFN FASLP,[ +SQUOZE 4,.FASL +A.FASL +SQUOZE 4,.ARRAY ;3 INDEX TO AFDMY1 TBL +AFATOM(3) +SQUOZE 4,.ATOM +AFATOM(AFDMAI) ;2 INDEX TO AFDMY1 TBL +AFDMAI==2 ;INDEX OF ATOM IN AFDMY1 TBL +SQUOZE 4,.FUNCT +AFATOM(1) ;1 " " " " +SQUOZE 4,.SPECI +AFATOM(0) ;0 " " " " +SQUOZE 4,.SX +AFLIST(1) ;NORMAL LIST +SQUOZE 4,.SXEVA +AFLIST ;EVAL LIST AND THROW VALUE AWAY +SQUOZE 4,.SXE +AFLIST(2) ;EVAL LIST AND "RETURN" VALUE +SQUOZE 4,.ENTRY +AFENTY ;DECLARE LISP ENTRY POINT (SUBR ETC) +] + +IFN TS,[ +SQUOZE 4,.FNAM1 +RFNAM1,,INTSYM +SQUOZE 4,.FNAM2 +RFNAM2,,INTSYM +SQUOZE 4,.FVERS +RFVERS,,INTSYM +SQUOZE 4,.INSRT +A.INSRT +SQUOZE 4,.INEOF +A.INEO +IRPS X,,I O + IRPS Y,,1 2 + SQUOZE 4,.!X!FNM!Y + X!FNM!Y,,INTSYM +TERMIN TERMIN +SQUOZE 4,.IFVRS +IFVRS,,INTSYM +SQUOZE 4,.TTYFLG +A.TTYFLG,,INTSYM +] +IFN .I.FSW,[ +SQUOZE 4,.F +A.F +SQUOZE 4,.I +A.I +] +IFN ITSSW,[ +IRPS X,,UAI UAO BAI BAO UII UIO BII BIO +SQUOZE 10,.!X +.IRPCN +TERMIN + +IRPS X,Y,START LFILE STP+SYM JCL PFILE STB CONV+XUNAME XJNAME LJB+ + SQUOZE 10,..R!X + .IRPCN+1 +IFSN Y,+,[ + SQUOZE 10,..S!X + 400000+.IRPCN+1 +] TERMIN +] + +EISYMT: PRINTA \.-MACTBA-1, words initialization coding. + VARIAB +IFN .-EISYMT,.ERR Non-empty variables area + +IFN DECSW,[ + IFGE .-MACTBA-MACL,[ +IFN MACL, PRINTA [MACL too small, set to ]\.-MACTBA + MACL==.-MACTBA +]] + +IFN ITSSW\TNXSW,[ +IFGE .+2400-MACTBA-MACL,.ERR MACL too small + LOC <.+1777>&-2000 +MXICLR==./2000 ;FIRST PAGE ABOVE INITIALIZING CODING + LOC &-2000 +MXIMAC==./2000 ;FIRST PAGE ABOVE INITIAL MACTBA +MAXMAC==/2000 + ;1ST PAGE MACRO TABLE CAN'T POSSIBLY USE. +IFLE MINPUR-MAXMAC,.ERR Pure too low. +PRINTA MINPUR-MAXMAC = ,\MINPUR-MAXMAC +] + +IFN TS,END BEG +END diff --git a/src/midas/midas.455 b/src/midas/midas.455 new file mode 100755 index 00000000..9ce832a7 --- /dev/null +++ b/src/midas/midas.455 @@ -0,0 +1,11953 @@ +; -*-MIDAS-*- +; The canonical source for MIDAS (and directory of supporting files) is +; [MIT-MC] MIDAS;MIDAS > + +IFE .OSMIDAS-SIXBIT/DEC/,.SYMTAB 4973.,2000. ;THIS MANY ON DEC SYSTEM +.ELSE .SYMTAB 10007. ;Assemble faster elsewhere. + +TITLE MIDAS +SUBTTL Instructions and assembly conditionals + +COMMENT | HOW TO ASSEMBLE MIDAS + +The procedure for assembling MIDAS depends primarily on whether you are +building a new MIDAS for your own system, or for a different system. If +it is your own system, you can normally just assemble it, following the +directions below. Building MIDAS for a different system is more +complicated and you will have to read farther. + + ITS + :MIDAS MIDAS;_MIDAS ; Assemble MIDAS + :JOB MIDAS + :LOAD MIDAS;MIDAS BIN + PURIFY$G ; This will dump to SYS;TS MIDAS + ; if you confirm with CR. + + TNX (TENEX, T20) ; This example is for TOPS-20 + [@]CD ; Connect to source file directory + [@]CVTUNV ; Run CVTUNV to generate TNXDFU.MID + [@]MIDAS MIDAS ; Assemble MIDAS + [@]GET MIDAS + [@]START PURIFY ; Optional - Start it at "PURIFY" + [@]SAVE MIDAS ; Then save as sharable file + + DEC (SAIL, CMU, T10) + ; This will have to be provided by those who do it. + + + HOW TO ASSEMBLE MIDAS FOR A DIFFERENT SYSTEM + +To build MIDAS for a different system (not your own), you will need +to do two things. First, symbol definition files for the target system +must be provided; second, when assembling MIDAS the /T switch must be +given to enable initial input from the TTY, and the appropriate +conditional flag then defined. The allowed flags are listed below, along +with the files needed for each. + +Target Flags Files needed Files needed + Op-System (set ==1) (if CVTSW==0) (if CVTSW==1) +ITS ITSSW ITSDFS,ITSBTS - +TENEX/TOPS-20 TNXSW TNXDFS,TWXBTS TNXDFU +TOPS-10 DECSW DECDFS,DECBTS DECDFU + SAIL " + SAILSW " , " ,SAIDFS " + CMU " + CMUSW " , " ,CMUDFS " + + +Other miscellaneous flags (all 1 to enable described action) + CVTSW makes a MIDAS using a DECDFU or TNXDFU file generated by the + CVTUNV program, which reads a MONSYM.UNV file and makes a TNXDFU.MID + file. There is no separate DECBTS or TWXBTS file when using CVTUNV. + NOTE: this should be hacked to read UUOSYM and make DECDFU too; + currently it does not, so CVTSW==1 will not yet work for TOPS-10!! + Normally on for TNX. + + DECDBG (TOPS-10 only) leaves space for the assembler's symbol table + to be moved to after execution is started. This is useful when + debugging MIDAS with DEC DDT. Normally off. + + DECBSW (TOPS-10 only) puts the DECBTS definitions in the predefined + symbol table. Normally on except for SAIL. + + SMALSW builds a "small" MIDAS. This is normally only for random + TOPS-10 DEC sites which have severe core usage restrictions. + + +Some words about SYMBOLS and SYMBOL TABLES + + When talking about "symbols" or "symbol tables", remember that +there can be several different contexts. Normally the reference is to +"THE" symbol table that MIDAS builds while assembling a program, which +contains all the symbols available to or defined by the program being +assembled. References to the "initial symbol table" also mean this +table; when starting to assemble a program, MIDAS has an unhashed table of +"initial symbols" which it uses to create an initial symtab for the +program. + However, MIDAS is itself a program and has its own symbol +table, which can be used by DDT to debug MIDAS. When talking about +this table the words "MSYMTAB" or "M symbol table" will be used, to +differentiate it from the symtab that MIDAS maintains for the program +it is assembling. + Remember that on ITS, a program's symbol table is (quite +rightly) NOT part of the program core image, although it is written +out in the same output file. On TNX and DEC however, the symbol table +must unfortunately be stored somewhere in the program's address space +and is pointed to by an AOBJN pointer at location 116 (.JBSYM). Generally +this area is set up by the linking loader, but MIDAS .DECSAV output can +force this to be wherever the location counter is when the "END" is seen. +| + +IF1,[ ; Clean up initial flags defined from the TTY, if any +IFDEF SAILSW,IFN SAILSW,DECSW==1 +IFDEF CMUSW,IFN CMUSW,DECSW==1 +IFDEF DECDBG,IFN DECDBG,DECSW==1 +IFDEF DECSW,IFN DECSW,DECSW==1 ? ITSSW==0 ? TNXSW==0 +IFDEF ITSSW,IFN ITSSW,ITSSW==1 ? DECSW==0 ? TNXSW==0 +IFDEF TNXSW,IFN TNXSW,TNXSW==1 ? DECSW==0 ? ITSSW==0 +] ; IF1 + + ; Select system to assemble for +IFNDEF ITSSW,ITSSW==IFDEF .IOT,[1] .ELSE 0 ;NON-ZERO => ITS VERSION +IFNDEF TNXSW,TNXSW==IFDEF GTJFN,[1] .ELSE 0 ;NON-ZERO => TENEX VERSION +IFNDEF DECSW,DECSW==IFDEF LOOKUP,[1-TNXSW] .ELSE 0 ;NON-ZERO => DEC VERSION + ; COND. ON TNXSW SINCE OLD VERSIONS OF TENEX MIDAS HAD + ; DEC UUOS DEFINED TOO ONCE UPON A TIME +IF1 IFN ITSSW+DECSW+TNXSW-1,.FATAL So what monitor is MIDAS supposed to run under? +IFN DECSW,[ +IFNDEF SAILSW,SAILSW==IFDEF SPCWAR,[1] .ELSE 0 ;NON-ZERO => SAIL VERSION. +IFNDEF CMUSW,CMUSW==IFDEF CMUDEC,[1] .ELSE 0 ;NON-ZERO => CMU VERSION. +] +IFE DECSW,SAILSW==0 ? CMUSW==0 ;CAN'T BE SAIL OR CMU FOR ITS OR TENEX VERSION + + +IFNDEF CVTSW,CVTSW==TNXSW ;NON-ZERO => BITS DEFINITIONS COME FROM FILES + ; MADE USING CVTUNV +IFNDEF SMALSW,SMALSW==DECSW- ;NON-ZERO => SMALL MIDAS + ; (NORMALLY FOR RANDOM DEC SITES ONLY) +IFNDEF DECBSW,DECBSW==DECSW*<1-SAILSW>*<1-SMALSW> + ;NON-ZERO => INCLUDE DECBTS +IFNDEF DECDBG,DECDBG==0 ;NON-ZERO => DEC VERSION TO RUN WITH DEC DDT. + +IFN ITSSW\DECSW\TNXSW,TS==1 +IFNDEF TS,TS==1 ;NON-ZERO => TIME-SHARING VERSION +IFE TS,1PASS +IFNDEF A1PSW, A1PSW==TS ;NON-ZERO => 1PASS END-OF-PROGRAM AUTO-REASSEMBLY +IFNDEF BRCFLG, BRCFLG==0 ;NON-ZERO => BRACES { AND } ARE SPECIAL IN MACRO + ; ARGS, ETC. JUST LIKE BRACKETS. BRACES ARE SPECIAL + ; IN CONDITIONALS REGARDLESS OF BRCFLG. +IFNDEF CREFSW, CREFSW==ITSSW ;NON-ZERO => ALLOW C SWITCH TO CAUSE CREF OUTPUT. +IFNDEF LISTSW, LISTSW==1 ;NON-ZERO => ALLOW L SWITCH TO CAUSE A LISTING. +IFNDEF RCHASW, RCHASW==TS ;NON-ZERO => INCLUDE TTY AS POSSIBLE INPUT DEVICE +IFNDEF PURESW, PURESW==TS-SAILSW ;NON-ZERO => SEPARATE PURE CODING FROM IMPURE AND + ; DO PAGE SKIPS. TWO SEGMENTS HURTS EFFICIENCY AT SAIL. +IFNDEF FASLP, FASLP==1-SMALSW ;NON-ZERO => INCLUDE FASL OUTPUT CAPABILITY + ; NOTE!! IF RUNNING UNDER 10/50 THIS MAKES THINGS + ; SEVERAL K BIGGER THAN OTHERWISE. +IFNDEF .I.FSW, .I.FSW==1-SMALSW;NON-ZERO => INCLUDE .I, .F +IFNDEF MACSW, MACSW==1 ;NON-ZERO => INCLUDE MACRO PROCESSOR (!) +IFNDEF RUNTSW, RUNTSW==1 ;NON-ZERO => TYPE OUT RUN TIME AT END OF ASSEMBLY +IFNDEF WRQTSW, WRQTSW==1 ;WRQOTE (MACRO DEFINITION READER) VERSION + ; ^ 0 => SLOW, 1 => FAST; MAYBE 2 WILL EVENTUALLY BE CREATED +IFE TS,IFNDEF MACL,MACL==6*2000 ;MACRO TABLE SIZE +IFN TS,[ +IFN ITSSW,IFNDEF MACL,MACL==6000;DEFAULT MACL SIZE FOR ITS. IF WE HAVE DECBTS OR +IFN TNXSW,IFNDEF MACL,MACL==16*2000 ; TWXBTS, THIS GETS INCREASED, CAUSE THEY ARE HUGE! +IFN DECSW,IFNDEF MACL,MACL==0 ;NON-ITS: WE WANT MACL TO JUST COVER THE INIT CODE. +IFNDEF MXMACL,MXMACL==32.*2000 ;MAXIMUM LENGTH MACTAB +] +IFNDEF MACRUM,MACRUM==4 ;# WORDS NOT USED AT END OF MACTAB +IFNDEF STRL,STRL==20 ;LENGTH OF STRING STORAGE (USED BY GSYL) +IFNDEF DMDEFL,DMDEFL==40 ;MAX NO OF DMY ARGS IN DEFINE +IFNDEF DMYAGL,DMYAGL==400 ;MAX NO COMBINED DMYARGS ALL MACROS CURRENTLY EXPANDING OR PUSHED +IFNDEF MPDLL,MPDLL==300 ;MACRO PDL LENGTH +IFNDEF DSSIZ,DSSIZ==40 ;MAX # ARGS MACRO WHOSE ARGS BEING SCANNED (SHOULD BE .GE. DMDEFL) +IFNDEF BKTABL,BKTABL==100 ;MAX NUM .BEGIN BLOCKS. +IFNDEF BKPDLS,BKPDLS==10 ;MAXIMUM .BEGIN BLOCK NESTING DEPTH. +IFNDEF BSIZE,BSIZE==37 ;PREFERRED SIZE BLOCK MAX SIZE-3 +IFN SMALSW,IFNDEF LPDL,LPDL==200. +IFNDEF LPDL,LPDL==1500. ;LENGTH OF PDL +IFN SMALSW,IFNDEF CONMIN,CONMIN==1000 +IFNDEF CONMIN,CONMIN==3300 ;MINIMUM AMT OF SPACE FOR CONSTANTS TABLES. +IFNDEF CONMAX,CONMAX==20000 ;MAXIMUM SPACE USER CAN ASK FOR. +IFNDEF NCONS,NCONS==100. ;MAXIMUM NUMBER OF CONSTANTS AREAS +IFNDEF NVARS,NVARS==25. ;MAX. NUM. VARIABLES AREAS. +;; MUST INCLUDE TONS OF SYSTEM DEFS + IFN DECBSW,IFNDEF SYMDSZ,SYMDSZ==4973. ;666.th prime + IFN TNXSW,IFNDEF SYMDSZ,SYMDSZ==7919. ;1000.th prime +IFN SMALSW,IFNDEF SYMDSZ,SYMDSZ==2003. +IFNDEF SYMDSZ,SYMDSZ==2707. ;DEFAULT # SYMS IN SYMTAB. +IFNDEF SYMMSZ,SYMMSZ==11657.*2 ;# SYMS IF JNAME IS MMIDAS. +IFNDEF SYMMAX,SYMMAX==60000 ;MAX SYMTAB SIZE (# SYMS) +IFNDEF FASBL,FASBL==400 ;WORDS USED FOR FASL OUTPUT BUFFER + ; MUST HOLD STUFF ASSOC WITH ONE GROUP OF 9 CODE BYTES +IFNDEF FASATL,FASATL==2000 ;WORDS USED FOR FASL ATOM TABLE + ; HOLDS PNAMES ETC OF ALL ATOMS AS WILL BE IN FASLOAD'S + ; SYMTAB AT LOAD TIME +IFNDEF MINWPS,MINWPS==3 ;MIN # WORDS IN SYMTAB ENTRY +IFNDEF MAXWPS,MAXWPS==3 ;MAX # ALLOWED (WILL BE BIGGER SOME DAY) +IFNDEF NRMWPS,NRMWPS==3 ;DEFAULT #. 2 WDS FOR VALUE & FLAGS, 1 FOR NAME. + +SUBTTL INITIAL DEFINITIONS + +; AC definitions. FF and P must be 0 and 17 respectively, otherwise the +; only constraints are those expressed as sequential orderings, e.g. B+1 etc. +; Also, +.SEE R1 + +FF=:0 ; FLAGS. MUST BE AC 0. +AA=:1 ; GENERAL PURPOSE REGS, MUST BE SEQUENTIAL. +A=:AA+1 ; 2 +B=:A+1 ; 3 +C=:B+1 ; 4 +D=:C+1 ; 5 +T=:6 ; NOT SO TEMP AS IN MOST PROGS W/ T +TT=:T+1 ; 7 +I=:10 ; INDICATOR FLAGS, CONTAIN INFO ON CURRENT SYL, FIELD, WORD; ALSO SEE UNRCHF +SYM=:11 ; FREQUENTLY CONTAINS SQUOZE SYM W/ FLAGS CLEAR +LINK=:SYM+1 +F=:13 +CH1=:14 ; MACRO PROCESSOR TEMP, CLOBBERED BY CALLS TO RCH +CH2=:CH1+1 ;" " " +TM=:16 ; SUPER TEMPORARY +P=:17 ; PDL AC, MUST BE 17. AS WELL AS RANDOM CROCKS IN PROGRAM, 20X ERCAL + ; ASSUMES P=17. + + +IFDEF .XCREF, .XCREF FF,P,I,A,B,C,D,T + +; VERSION, FLAGS, ETC. + +IF1 [ + +IFNDEF MIDVRS,[ +IFGE .FVERS,[ +DEFINE XXX VRS + MIDVRS=SIXBIT/VRS/ +TERMIN +RADIX 10. +XXX \.FVERS +RADIX 8 +EXPUNGE XXX +] +.ELSE [ +PRINTX /What is MIDAS version number? / +.TTYMAC VRS + MIDVRS=SIXBIT/VRS/ +TERMIN +] +] + +; OSMIDAS gets the sixbit name of the type of op. sys. this version of MIDAS +; is being assembled to run under. It will be the value of .OSMIDAS when +; programs are assembled with this MIDAS. Note that the TNX version actually +; sets it at runtime startup to "TENEX" or "TWENEX" as appropriate. + +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/ + +;FF FLAGS NOT PUSHED +;LEFT HALF +FL==1,,525252 +FLPPSS==400000 ;ONE IF PUNCHING PASS; MUST BE SIGN +FLHKIL==100000 ;ONE IF SYM TO BE SEMI KILLED IN DDT + +FLVOT== 40000 ;ALL RCH S MUST GO THRU RCH + ; IE TYPCTL .NE. POPJ P, (SET/CLEARED BY MDSSET, MDSCLR) +FLMAC== 20000 ;ONE IF CHARS COMING FROM MACRO PROCESSOR, DON'T HACK CPGN/CLNN +FLTTY== 10000 ;ONE IF CHARS FROM SOMEWHERE ELSE BUT NOT HACKING CPGN/CLNN +$FLOUT== 4000 ;ONE IF OUTPUT HAS OCCURED IN CURRENT MODE (USED BY TS NED LOGIC) +FLPTPF== 2000 ;SET IF (TIME SHARING) OUTPUT DEVICE IS PTP +FLUNRD== 1000 ;=> RE-INPUT LAST CHARACTER (SEE RCH) +FL20X==400 ; IN TENEX VERSION, 1= RUNNING ON TOPS-20, 0 = TENEX. + +;FF RIGHT HALF FLAGS + +FR==525252 +FRFIRWD==400000 ;ONE FOR FIRST WORD OF BLOCK +FRSYMS==200000 ;ONE IF SYM PUNCH DESIRED +FRLOC==100000 ;ONE BETWEEN ABS LOC ASSIGN AND + ;FIRST BLOCK OUTPUT THEREAFTER (EBLK TO OUTPUT NULL BLOCK SO LINKING LOADER KNOWS $.) + +FRNPSS==40000 ;ONE IF TWO PASS ASSEMBLY +FRPSS2==20000 ;ONE ON PASS 2 + +FRINVT==4000 ;USED BY PBITS AND OUTPUT TO OUTPUT WORDS OF CODE BITS IN CORRECT ORDER (STEAD LOGICAL) +FRNLIK==2000 ;TEMPORARILY SUPPRESS ADR LINKING +FRGLOL==1000 ;ONE IF LOCATION PLUS OFFSET IS GLOBAL + +FRBIT7==400 ;SET IF LAST TIPLE OF CODEBITS WAS 7. +FRMRGO==200 ;MACRO PROC TO RETURN TO .GO HACKER W/O READING NEXT CHAR (SEE RCHSAV) + +FRCMND==40 ;SET WHILE READING CMD, TELLS RFD TO NOTICE (, _, COMMA. +FRNNUL==20 ;SET ON RETURN FROM RFD IFF NONNULL SPEC. +FRARRO==10 ;TELLS RFD THAT 1ST NAME IS FN1, NOT FN2. +FRFN1==4 ; TELLS RFD THAT 1ST NAME WAS READ. + + + ; FLAGS TO ZERO AT BEGINNING OF PASS 1 ONLY, BY $INIT. +FFINIT==<-1-FLVOT-FLPTPF-FLTTY-FL20X,,-1> + +] ;END IF1 + +;INDICATOR REGISTER + +IF1 [ + +;LEFT HALF +IL==1,,525252 +ILGLI==1 ;SET ON " CLEARED EACH SYL +ILVAR==2 ;SET ON ' " " " +ILFLO==4 ;FLOATING NUM, SET ON DIGIT AFTER . +ILDECP==10 ;DECIMAL PREFER, SET WHEN . SEEN. +ILUARI==20 ;1 => RIGHT OPERAND TO UPARROW BEING READ +ILLSRT==40 ;RETURN FROM < +ILWORD==400 ;SET IF CURRENT WORD IS NOT NULL RETURNED BY GETWORD +ILNPRC==1000 ;ONE IF NUMBER ALREADY PROCESSED BY UPARROW +ILMWRD==4000 ;SET ON MULTIPLE WORD +ILPRN==10000 ;SET DURING MACCL IF MACRO NAME WAS FOLLOWED BY (. +ILMWR1==20000 ;SET BY LBRAK AS SIGNAL TO ITSELF THAT THIS NOT FIRST + ;WORD OF MULTI-WORD CONSTANT +ILNOPT==40000 ;CONSTANTS OPTIMIZATION SUPPRESSION FLAG; SHOULD BE SET BY + ;VALUE-RETURNING PSEUDO DURING NOT PUNCHING PASS TO KEEP ITSELF OUT OF + ;CONSTANTS OPTIMIZATION + +;RIGHT HALF + +IR==525252 +IRFLD==1 ;SET IF FLD NOT NULL +IRSYL==2 ;SET IF SYL NOT NULL +IRLET==4 ;SET IF SYL IS SYMBOL +IRDEF==10 ;SET IF CURRENT EXPR DEFINED +IRNOEQ==20 ;SET IF = ISN'T ALLOWED IN CURRENT CONTEXT. +IRCOM==40 ;SET IF CURRENT QUAN IS COMMON +IRPERI==100 ;SET IF PERIOD SEEN IN WHAT IS SO FAR (INCL .) A NUMBER +IREQL==200 ;ONE DURING READING WORD TO RIGHT OF = +IRIOINS==400 ;FIRST FIELD OF CURRENT WORD HAS IO INST +IRCONT==1000 ;SET IF NOT OK TO END BLOCK +IRPSUD==4000 ;SET IF ERROR COMMENTS WILL COME FROM PSEUDO +IRGMNS==20000 ;SET IF ILUARI OR BAKARI HAS GOBBLED MINUS +IROP==200000 ;SET IF OPERATOR SEEN IN CURRENT FIELD + +CALL==PUSHJ P, +RET==POPJ P, +;SAVE=PUSH P, ;DON'T USE SAVE! IT'S A JSYS ON TENEX AND TWENEX +REST==POP P, +PJRST==JRST ; FOR JRST'ING TO A POPJ'ING ROUTINE. + +ETSM=1000,, ;ERROR, TYPE SYM. +ETR=2000,, ;ERROR, ORDINARY MESSAGE. +ERJ=3000,, ;ERROR, NO MESSAGE, RETURN TO ADDR. +ETI=4000,, ;ERROR, IGNORE LINE, RET. TO ASSEM1. +ETA=5000,, ;ERROR, RET. TO ASSEM1. +ETASM=6000,, ;ERROR, TYPE SYM AND RETURN TO ASSEM1 +ETF=7000,, ;FATAL ERROR. +TYPR=(37000) ;UUO, TYPE OUT ASCIZ STRING +TYPCR=(36000) ; LIKE TYPR BUT ADDS CR AT END. +] ;END IF1 + +IF1 [ +;LINK TABLE (GLOTB), ACCUMULATES GLOBAL REFERENCES FOR CURRENT FROB (USUALLY WORD) TO OUTPUT +;GLSP2 POINTS TO (I.E. HAS ADR 1 LESS THAN) BOTTOM OF ACTIVE PART OF TABLE +;GLSP1 POINTS TO TOP (HAS ADR OF LAST ENTRY ACTIVE) + +;ACTUAL ENTRIES IN GLOTB: +;IF ENTIRE WORD ZERO, ENTRY IS NULL, WILL (OR SHOULD) BE IGNORED +;RH ADR OF SQUOZE WITH INTERNAL MIDAS FLAGS (USUALLY IN SYMBOL TABLE, BUT MAY BE ANYWHERE IN CORE) +;LH: RIGHT 10. BITS MULTIPLICATION FACTOR OR 0 => 1 + ;GLOBAL SHOULD BE MULTIPLIED BY IT +;REST OF LH FLAGS: + +;SIGN BIT => THIS NOT PART OF FIELD, DON'T PLAY WITH FLAGS AT GETFLD, INTFD +ACF==40000 ;AC LOW OR HIGH (SWAPF => HIGH) +HFWDF==100000 ;MASK GLOBAL TO HALFWORD +SWAPF==200000 ;SWAP +MINF==20000 ;NEGATIVE OF GLOBAL + +IFNDEF LBRKT,LBRKT=="[ ;LEFT DELIMITER FOR EXPLICITLY GROUPED CONDITIONALS, MACRO ARGS, REPEAT BODY, ETC. +IFNDEF RBRKT,RBRKT=="] ;RIGHT " +IFNDEF WPS, WPS==3 ;# CONTIG. WDS /STE. IFNDEF FOR DEBUGGING. +IFNDEF BKWPB,BKWPB==3 ;# WDS/BKTAB ENTRY. +IFNDEF EOFCH,EOFCH==3 ;EOF CHAR, BEWARE DISPATCH TABLE ENTRIES. +IFNDEF LBRACE,LBRACE==173 +IFNDEF RBRACE,RBRACE==175 + +;3RDWRD LH. SYM TAB BITS + +3REL==600000 ;RELOC BITS, DO NOT CHANGE, SOMETIMES REFERENCED BY NUMERIC BYTE POINTERS +3RLL==400000 ;R(LH) +3RLR==200000 ;R(RH) +3RLNK==100000 ;R(LINK) +3KILL==40000 ;FULLY-KILLED SYM (DON'T GIVE TO DDT). +3VP==20000 ;VALUE PUNCHED +3SKILL==10000 ;SEMI KILL IN DDT +3LLV==4000 ;LINKING LOADER MUST INSERT VAL +3VAS2==2000 ;VAR SEEN ON PASS TWO WITH ' +3VCNT==1000 ;USED IN CONSTANT +3MAS==400 ;THIS ISN'T THE LAST DEFINITION OF A SYM WITH THIS NAME + ;(SO ES MUST KEEP SEARCHING). +3NCRF==200 ;DON'T CREF THIS SYMBOL. +3MACOK==100 ;OK TO (RE)DEFINE THIS SYM AS MACRO. + ;(IE IS A MACRO OR SEEN ONLY IN .XCREF) +3LABEL==40 ;ILLEGAL TO REDEFINE THIS SYM TO DIFFERENT VALUE +3MULTI==20 ;THIS SYM IS MULTIPLY DEFINED, SO FLAG ALL DEFINITIONS. +3DOWN==10 ;THIS DEFINITION SHOULD BE SEEN BY SUBBLOCKS IN 1PASS MODE. + +3DFCLR==737110 ;BITS IN LH TO CLEAR ON REDEFINITION. + +; FLAGS IN "CONTROL" VARIABLE +.SEE CONTRL + ;LEFT HALF +TRIV==400000 ; 1 IF OUTPUT FORMAT IS FOR TRIVIAL LOADER (ABSOLUTE) + ; ELSE RELOCATABLE (NOTE THIS CROCKISHLY ONLY MEANS + ; STINK FORMAT, SINCE DEC RELOC FORMAT HAS THIS FLAG SET) + + ;RIGHT HALF +ARIM== 2 ; 1 => OUTPUT FORMAT IS RIM +SBLKS== 10 ; 1 => OUTPUT FORMAT IS SBLK (SIMPLE BLOCKS) +ARIM10== 20 ; 1 => OUTPUT FORMAT IS PDP-10 RIM +DECREL== 40 ; 1 => DEC RELOCATABLE FORMAT (CONSIDERED "ABSOLUTE" INSIDE MIDAS) +FASL== 100 ; 1 => LISP FASL COMPATIBLE RELOCATABLE FORMAT ( " " ") +DECSAV==200 ; 1 => DEC SAV FORMAT (ABSOLUTE) ALSO WINS ON 10X, 20X + +PTR==104 ;DEVICE CODE FOR PAPER TAPE READER. + +] ;END IF1 + +IF1 [ + +;SQUOZE FLAG DEFINITIONS IN MIDAS SYMBOL TABLE + +CMMN==0 ;COMMON (NOT USED) +PSUDO==40000 ;PSEUDO OR MACRO, VALUE RH ADDR OF RTN (MACCL FOR MACRO), + ; LH WILL BE IN LH OF B WHEN RTN CALLED. +SYMC==100000 ;SYM, VALUE IS VALUE OF SYM. +LCUDF==140000 ;LOCAL UNDEF +DEFLVR==200000 ;DEF LOC VAR, VALUE IS VALUE. +UDEFLV==240000 ;UNDEF LOC VAR, VALUE IS 1+ IDX IN VARIAB. AREA, BUT IGNORD IF VAR AREA GLOB. +LGBLCB==300000 ;CODE BITS EQUAL TO THIS OR HIGHER REPRESENT GLOBAL QUANTITIES +DEFGVR==300000 ;DEF GLO VAR, VALUE IS VALUE +UDEFGV==340000 ;UNDEF GLO VAR, VALUE LIKE UNDEF LOCAL VAR. +GLOETY==400000 ;GLO ENTRY +GLOEXT==440000 ;GLO EXIT +NCDBTS==GLOEXT_<-18.+4>+1 ;# CODE BIT TYPES + +DEFINE CDBCHK TBLNAM +IFN .--NCDBTS,.ERR TBLNAM LOSES +TERMIN + +;LOADER BLOCK TYPES LINK +LLDCM==1 ;LOADER COMMAND BLOCK +LABS==2 ;ABSOLUTE +LREL==3 ;RELOCATABLE +LPRGN==4 ;PROG NAME +LLIB==5 ;LIBRARY BLOCK +LCOMLOD==6 ;LOAD INTO COMMON +LGPA==7 ;GLOBAL PARAMETER ASSIGN +LDDSYM==10 ;LOCAL SYMS +LTCP==11 ;LOAD TIME COND ON PRESENCE +ELTCB==12 ;END LOAD TIME COND +LPLSH==22 ;POLISH FIXUP + +;LOADER COMMANDS +;IN ADR OF LDCMD BLK +LCJMP==1 ;JUMP +LCGLO==2 ;GLOBAL LOC ASSIGN +LCCMST==3 ;SET COMMON BENCHMARK +LCEGLO==4 ;END OF GLOBAL BLOCK +LDCV==5 ;LOAD TIME COND ON VALUE +LDOFS==6 ;LOADER SET GLOBAL OFFSET +LD.OP==7 ;LOADER .OP + +;LOADER CODEBITS SECOND SPEC AFTER 7 +CDEF==0 ;DEF +CCOMN==1 ;COMMON REL +CLGLO==2 ;LOC-GLO REC +CLIBQ==3 ;LIBREQ +CRDF==4 ;GLO REDEF +CRPT==5 ;REPEAT GLOBAL VALUE +CDEFPT==6 ;DEFINE SYM AS $. + +;DEC RELOCATABLE BLOCK TYPES. +DECWDS==1 ;STORAGE WORDS. +DECSYM==2 ;SYMBOL DEFS OR GLOBAL ADDITIVE RQS. +DECHSG==3 ;LOAD INTO HIGH SEG (FOR .DECTWO) +DECENT==4 ;ENTRY NAMES +DECEND==5 ;END BLOCK, HAS PROGRAM BREAK. +DECNAM==6 ;PROGRAM NAME. +DECSTA==7 ;STARTING ADDRESS BLOCK. +DECINT==10 ;INTERNAL REQUEST +DECRQF==16 ;REQUEST LOADING A FILE +DECRQL==17 ;REQUEST LOADING A LIBRARY +] ;END IF1 + +IF1 [ + +DEFINE GOHALT ; Instruction invoked for MIDAS internal error (fatal) + JSR HALTER +TERMIN + +DEFINE TYPE &STR +TYPR [ASCIZ STR] +TERMIN + +DEFINE TYPECR &STR +TYPCR [ASCIZ STR] +TERMIN + +DEFINE PRINTA A,B,C,D,E,F +IF1,[PRINTC ~A!B!C!D!E!F +~] +TERMIN + +IF1 [DEFINE BNKBLK OP +OP +TERMIN ] + + ;ADD A LINE TO BNKBLK, ACCUMULATED CONTENT OF + ;WHICH IS DUMPED OUT AT END OF ASSEMBLY + ;ARG TO BLCODE SHOULD BE FREE OF STORAGE WORDS + +DEFINE BLCODE NEWCFT +IF1 [BNKBLK [DEFINE BNKBLK OP +OP]NEWCFT +TERMIN ] +IF2 [IRPW X,,[ +NEWCFT +] +IRPS Y,,X +Y=Y +.ISTOP TERMIN TERMIN ] TERMIN + + ;3RDWRD MANIPULATING MACROS + ;GET 3RDWRD INTO LH("A"), "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3GET A,B + MOVE A,ST+2(B) + TERMIN + + ;GET 3RDWRD INTO "A", "B" HAS ADR OF 1STWRD + +DEFINE 3GET1 A,B + MOVE A,2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS INDEX OF 1STWRD INTO SYMBOL TABLE + +DEFINE 3PUT A,B + MOVEM A,ST+2(B) + TERMIN + + ;PUT "A" INTO 3RDWRD, "B" HAS ADR OF 1STWRD + +DEFINE 3PUT1 A,B + MOVEM A,2(B) + TERMIN + +] ;END IF1 + +;RANDOM MACRO DEFINITIONS + +IF1 [ + + ;A HAS ADR OF SYM SQUOZE, SKIP IF IT'S IN SYMBOL TABLE + +DEFINE SKPST A + CAIL A,ST + CAML A,MACTAD +TERMIN + + ;EXECUTE AN INSTRUCTION WITH VARIOUS ADDRESSES (USUALLY PUSH OR POP) + +DEFINE INSIRP A,B + IRPS %ADR,,[B] + A,%ADR + TERMIN +TERMIN + +DEFINE NOVAL + TDNE I,[ILWORD,,IRNOEQ\IRFLD] + ETSM ERRNVL +TERMIN + +DEFINE NOABS + SKIPGE CONTRL + ETASM ERRABS +TERMIN + +] ;END IF1 + +ERRNVL==[ASCIZ /Returns no value/] +ERRABS==[ASCIZ /Allowed only for STINK relocatable format/] + +IF1 [ + +DEFINE MOVEIM B,C + MOVEI A,C + MOVEM A,B +TERMIN + +DEFINE MOVEMM B,C + MOVE A,C + MOVEM A,B +TERMIN +] ;END IF1 + +IF1 [ +IFN 0,[ +;THESE ARE SOME MACRO DEFINITIONS FOR THE UNFINISHED MULTI-WORD +;SYMBOL NAME FEATURE. FOR COMPATIBILITY, THEY ALL NOW HAVE DEFINITIONS +;THAT ONLY HANDLE ONE WORD. THOSE OTHER DEFINITIONS COME AFTER THESE. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +IFSN X,SYM,SKIPE A,X+1 +.ELSE SKIPE A,SYMX + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y + MOVE Z,X+1 + MOVEM Z,Y+1 +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y + MOVE Z,AC!X + MOVEM Z,Y+1 +TERMIN +] + +.ELSE [ +;THESE ARE THE DEFINITIONS OF THE MACROS THAT DO NOT IMPLEMENT +;MULTI-WORD SYMBOL NAMES. + +DEFINE TYPE2 X=SYM + MOVE A,X + CALL SYMTYP +TERMIN + +DEFINE COPY2 X,Y,Z=USING A + MOVE Z,X + MOVEM Z,Y +TERMIN + +DEFINE STORE2 AC,Y,Z=USING A + MOVEM AC,Y +TERMIN +] + +DEFINE USING X +X,TERMIN + +] ;END IF1 + +SUBTTL DEFINE SYS DEPENDENT SYMBOLS & SELECT OUTPUT FORMAT + +; THIS DEFSYM MACRO IS FOR COMPILING MIDAS ON ANOTHER OPERATING SYSTEM. THIS +; AVOIDS SAME-NAME SCREWS (IE, "LOCK" IS SOMETHING DIFFERENT ON TWENEX, SAIL, +; AND DEC). + +IF1 [ +; Expunge symbol unless it's a pseudo or macro, in which case the redefinition +; will complain about it. +DEFINE DEFSYM X/ + IRPS Z,,[X] + IFN <1-.TYPE Z,>, EXPUNGE Z + .ISTOP + TERMIN + X +TERMIN +]; IF1 + +IFN DECSW\TNXSW,[ +IF1 [ + +IFN TNXSW, EQUALS TEM,.SYMTAB ; Preserve definition in case def files lose + ; This is currently the only symbol conflict + ; between MIDAS and TOPS-20. +IFE CVTSW,[ + +; INSERT UUO DEFINITIONS FILES AS APPROPRIATE. +IFE CMUSW\SAILSW\TNXSW,.INSRT DECDFS +IFN SAILSW, .INSRT SAIDFS +IFN CMUSW, .INSRT CMUDFS +IFN TNXSW, .INSRT TNXDFS + +;ACTUALLY DEFINE THE UUOS USING THE MACROS READ FROM THE FILES. +IFN DECSW,.DECDF DEFSYM +IFN TNXSW,.TNXDF DEFSYM + +;INSERT THE BITS DEFINITION FILES AS APPROPRIATE. +;THESE MUST BE INSERTED EVEN IF THEY ARE PREDEFINED, BECAUSE +;THE MIDAS SYMBOL TABLE IS CONSTRUCTED FROM THE DEFINITIONS IN THIS ASSEMBLY +;OF THOSE SYMBOLS, AND THAT MEANS WE NEED THE LATEST VERSION ASSEMBLED IN. + +IFN TNXSW, .INSRT TWXBTS +IFN DECBSW,.INSRT DECBTS + +];IFE CVTSW + +; If using CVTUNV then there is just one file which is the converted +; contents of the MONSYM.UNV file for the system; the xxxDFS and xxxBTS files +; are not needed. There are no special SAIL or CMU versions. +IFN CVTSW,[ + IFN DECSW, .INSRT DECDFU + IFN TNXSW, .INSRT TNXDFU +] ;IFN CVTSW + +IFN TNXSW,[ ; AC DEFS FOR DIRECT REFERENCE TO JSYS ARGS +R1==:1 ; SOMEDAY MAYBE THE SYMBOLS A,B ETC WILL CORRESPOND... +R2==:2 +R3==:3 +R4==:4 +R5==:5 +] + +IFN TNXSW, EQUALS .SYMTAB,TEM + +] ;IF1 + +IFN DECSW,[ ; SELECT OUTPUT FORMAT FOR DEC VERSION +IFN PURESW,.DECTWO +IFE PURESW,.DECREL + RL0==. +] +IFN TNXSW,[ ; SELECT OUTPUT FORMAT FOR TNX VERSION +IFNDEF DECSVF,[ ; NORMALLY, USE .DECSAV IF AVAILABLE, ELSE .DECREL, + DECSVF==0 ; BUT USER CAN OVERRIDE THAT BY SPECIFYING DECSVF. + IFDEF .DECSAV,DECSVF==1 +] +IFN DECSVF,.DECSAV +.ELSE [ IFN PURESW,.DECTWO + .ELSE .DECREL + ] + RL0==0 +] +] ;IFN DECSW\TNXSW + +IFN ITSSW,[ +IF1 [IFNDEF .IOT,[.INSRT SYS:ITSDFS + .ITSDF DEFSYM + ] ;IFNDEF .IOT +IFNDEF %PIPDL,.INSRT SYS:ITSBTS + EXPUNG .JBTPC,.JBCNI + +DEFINE SYSCAL A,B + .CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))] +TERMIN +] ;IF1 + +IFDEF .SBLK,.SBLK ; SELECT OUTPUT FORMAT FOR ITS VERSION + RL0==0 +] ;IFN ITSSW + +IFE PURESW,[ ;FOLLOWING IF NOT ASSEMBLING PURE CODING + +DEFINE PBLK +TERMIN + +DEFINE VBLK +TERMIN +] + +IFN PURESW,[ ;FOLLOWING IF ASSEMBLING PURE CODING + +; MIDAS MEMORY ORGANIZATION + +; General +; First come several pages of impure coding (no dynamic allocation). +; The BLCODE macro accumulates "blank" (zero wd) coding to be put at end of +; impure coding; no non-zero storage words allowed. +; Then comes the symbol table at ST, followed by the literals tables, followed +; by the macro table. The latter two are peculiar because they can both +; be shifted upwards if the symbol table size is increased at the start of +; assembly. +; The macro table initially starts at MACTBA (actual addr in MACTAD) +; and is even more peculiar because there is a lot of symbol initialization +; coding there, including a unhashed table of "initial symbols", which is +; wiped out by the first macro definition. +; Finally there is a "gap" of unused pages, followed by the pure +; code of MIDAS at location MINPUR*2000. + +; Page(addr) End+1 + +; 0 (BBKCOD) Impure coding (VBLK) +; MINBNK 1st completely blank page (above BBKCOD) +; (BBKCOD) (EBKCOD) Blank code (BLCODE) all zeros +; (ST) varies Symbol table starts here +; *(CONTAB) Literal table +; MINMAC Page # that MACTBA starts in +; *(MACTBA) Start of initialization coding + initial syms +; MXICLR MXIMAC Empty pages above initial coding reserved +; for initial macro table. +; MXIMAC MAXMAC Unused pages but can expand into. +; MAXMAC 1st page macro table prevented from using +; "gap" Never-used pages between impure and pure +; MINPUR MAXPUR Pure code (PBLK) +; - +; 1STBFP/2 varies TNX only, input file page buffers + +; * - the literal and macro tables are subject to being shifted by symtab +; expansion. The macro table can dynamically expand up to MAXMAC. + + +IFN DECSW\TNXSW,MINPUR==200 +IFN ITSSW,MINPUR==200 ; Page number beginning pure coding + +;PURE CODING UNTIL MAXPUR*2000-SOMETHING +;THE FOLLOWING MACROS AND BLCODE MAKE IT NOT COMPLETELY NECESSARY +;TO SEPARATE PURE CODING FROM IMPURE + +CKPUR==0 ;0 => ASSEMBLING BELOW THE GAP, 1 ABOVE + + ; PBLK - SWITCH TO CODING ABOVE THE GAP +DEFINE PBLK +IFN CKPUR,.ERR PBLK +IFE CKPUR,[VAR.LC==. +LOC PUR.LC +]CKPUR==1 +TERMIN + + ; SET INITIAL LOCATION COUNTER FOR ASSEMBLING PURE CODE ABOVE GAP. +IFN ITSSW, PUR.LC==MINPUR*2000 +IFN DECSW, PUR.LC==MINPUR*2000+RL0 +IFN TNXSW,[ + IFN DECSVF,PUR.LC==MINPUR*2000 + .ELSE PUR.LC==MINPUR*2000+20 ;SKIP VESTIGIAL JOBDAT AREA. +] + + ; VBLK - SWITCH TO CODING BELOW THE GAP +DEFINE VBLK +IFE CKPUR,.ERR VBLK +IFN CKPUR,[PUR.LC==. +LOC VAR.LC +]CKPUR==0 +TERMIN + +IFN TNXSW,IFE DECSVF,LOC 200 + +PBLK ;PBLK NORMAL MODE, VARIABLE AREAS BRACKETED WITH VBLK AND PBLK + +] ;END PURESW CONDITIONAL + +.YSTGW ;SET UP NOW, STORAGE WORDS OK + +FOO==. +LOC 41 + JSR ERROR +IFN ITSSW,JSR TSINT +IFN DECSW,[ +LOC .JBAPR + TSINT1 +] +LOC FOO + + ;DISPATCH TABLE FOR NON-SQUOZE CHARACTERS + ;REFERENCED AS DTB-40(RH OF POPJ IN GDTAB) + ;DTB ENTRY OF SYL TERMINATOR PUT IN CDISP BY GETSYL + +DSYL==400000 ;SYL OPERATOR, DISPATCH INDEXED BY RH AT GETSYL (MUST BE SIGN) +DFLD==200000 ;FIELD OPERATOR, GETFD +DWRD==100000 ;WORD OP, GETWD +DSY1==1000 ;SET ONLY IF DSYL SET, + ;SET IF OP MIGHT BE 1ST CHAR OF NONNULL SYL. +DSYL1==DSYL+DSY1 +DSY2==400 ;SET FOR _ ONLY. + +;ALL CLEAR => WORD TERMINATOR, NO DISPATCH + +DTB: DWRD,,SPACE ;40 SP, TAB, RUBOUT + DSYL1,,RRL2 ;EXCLAIM AND OPEN-BRACE + DSYL1,,DQUOTE ;" + DFLD,,XORF ;NUM SIGN + DSYL,,RBRAK2 ;CLOSE-BRACE. + 0 ;(USED TO BE PERCENT SIGN) + DFLD,,ANDF ;AMPERSAND + DSYL1,,SQUOTE ;' + DFLD,,LEFTP ;( 50 + DSYL,,RPARN ;) + DFLD,,MULTP ; STAR TIMES + DFLD,,PLS ;+ PLUS + DWRD,,COMMA ; , + DFLD,,MINUS ;- + DSYL1,,CTLAT ;^@ (56) + DFLD,,DIVID ;/ + DSYL1,,COLON ;COLON 60 + DSYL,,SEMIC ;SEMI + DFLD,,LSSTH ;< + DSYL1,,EQUAL ;= + DSYL,,GRTHN ;> + 0 ;? + DSYL1,,ATSGN ;AT SIGN + DFLD,,LBRAK ;[ + DFLD,,IORF ;BACKSLASH 70 + DSYL,,RBRAK ;] + DSYL1,,UPARR ;^ + DSYL+DSY2,,BAKAR ;BACKARR + 0 ;CR + 0 ;(USED TO BE TAB) + 0 ;ALL OTHER + DSYL,,LINEF ;LF (DSYL TO HACK CLNN) + DSYL,,FORMF ;FORM FEED (") 100 + +;NOTE THAT POPJ P, IS VALID TEST FOR SQUOZENESS +;EXCEPT FOR EOFCH + +GDTAB: POPJ P,56 ; ^@ GETS IGNORED. + REPEAT 2,POPJ P,76 ;(GDTAB GLOBAL SO OUT OF TS, AIO CAN CLOBBER GDTAB+141 WITH JRST RREOF + ;ON OLD FILES) +IFN .-GDTAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH GDTAB. +IFE TS,[POPJ P,76] IFN TS,[JRST RREOF] + REPEAT 5,POPJ P,76 + POPJ P,40 ; TAB + POPJ P,77 ; LF + POPJ P,76 ; VERT TAB + POPJ P,100 ; FORM FEED + POPJ P,74 ; CR + REPEAT "!-16-1,POPJ P,76 + POPJ P,40 ; SPACE + POPJ P,41 ; ! + POPJ P,42 ; " + POPJ P,43 ; # + ADD SYM,%$SQ(D) ; $ + ADD SYM,%%SQ(D) ; % + POPJ P,46 ; & + POPJ P,47 ; ' + POPJ P,50 ; ( + POPJ P,51 ; ) + POPJ P,52 ; * + POPJ P,53 ; + + POPJ P,54 ; , + POPJ P,55 ; - + JSP CH1,POINT ; . + POPJ P,57 ; / + REPEAT 10.,JSP CH2,RR2 ; DIGITS + POPJ P,60 ; : + POPJ P,61 ; ; + POPJ P,62 ; < + POPJ P,63 ; = + POPJ P,64 ; > + POPJ P,65 ; ? + POPJ P,66 ; @ +IFDEF .CRFOFF,.CRFOFF +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN + POPJ P,67 ; [ + POPJ P,70 ; \ + POPJ P,71 ; ] + POPJ P,72 ; ^ + POPJ P,73 ; _ + POPJ P,76 ; NOW LOWER CASE GRAVE ACCENT + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ + ADD SYM,%!Q!SQ(D) +TERMIN +IFDEF .CRFON,.CRFON + POPJ P,41 ;{ + POPJ P,76 ;| + POPJ P,44 ;} + POPJ P,76 ;~ + POPJ P,40 ; RUBOUT, LIKE SPACE + IFN .-GDTAB-200,.ERR GDTAB LOSES + +NSQTB: IFDEF .CRFOFF,.CRFOFF +IRPC Q,,0123456789 + ADD SYM,%!Q!SQ(D) +TERMIN + +IRPC Q,,ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890$%. +%!Q!SQ: 0 + SQUOZE 0,Q/50/50/50/50/50 + SQUOZE 0,Q/50/50/50/50 + SQUOZE 0,Q/50/50/50 + SQUOZE 0,Q/50/50 + SQUOZE 0,Q/50 + SQUOZE 0,Q +TERMIN +IFDEF .CRFON,.CRFON + +;FORMAT TABLE(S) +;4.9-4.4 ETC SPECIFY SHIFT +;4.4-3.6 ETC SPECIFY NUMBER BITS +;FIELD SPECS IN REVERSE ORDER + +IFORTB: 0 ;NCNSN 10 , + 0 ;NCNSF 11 IMPOS + 0 ;NCNCN 12 ,, + 2200,, ;NCNCF 13 ,,C + 2200000000 ;NCFSN 14 ,B + 0 ;NCFSF 15 ,B C + 0 ;NCFCN 16 ,B, + 0 ;NCFCF 17 ,B,C + 4400000000 ;FSNSN 20 A + 0 ;FSNSF 21 IMPOS + 0 ;FSNCN 22 IMPOS + 0 ;FSNCF 23 IMPOS + 2200440000 ;FSFSN 24 A B + 2200220044 ;FSFSF 25 A B C + 270400440000 ;FSFCN 26 A B, + 2227040044 ;FSFCF 27 A B,C + 4400000000 ;FCNSN 30 A, + 0 ;FCNSF 31 IMPOS + 22220000 ;FCNCN 32 A,, + 2200002222 ;FCNCF 33 A,,B + 2200440000 ;FCFSN 34 A,B + 0 ;FCFSF 35 A,B C + 0 ;FCFCN 36 A,B, + 0 ;FCFCF 37 A,B,C +FRTBL==.-IFORTB ;LENGTH OF FORMAT TABLE +VBLK +FORTAB: BLOCK FRTBL ;ACTUAL FORMAT TABLE +FRTBE=.-1 +PBLK + +;VARIABLE STORAGE + +VBLK + +RETURN: JRST . ;RH HAS RETURN ADR FOR END OF MAJOR ROUTINE (E.G PASS 2) +CDISP: 0 ;CURRENT DISPATCH CODE +PPRIME: 0 ;PUSH DOWN LIST MARKER (GETFLD) +SCNDEP: 0 ;DEPTH IN SUCCESSFUL BRACKET CONDITIONALS INSIDE INNERMOST LITERAL. +CONDLN: 0 ;LINE NUMBER AT WHICH LAST TOP LEVEL SUCCESSFUL CONDITIONAL ENCOUNTERED +CONDPN: 0 ;PAGE NUMBER-- PRINT THESE IF REACH END AND CONDITIONAL NOT TERMINATED +CONDFI: 0 ;SIXBIT FN1 OF FILE CONTAINING LAST TOP LEVEL SUCCESSFUL CONDITIONAL. +A.SUCC: 0 ;NONZERO IFF LAST CONDITIONAL SUCCEEDED. +ASMOUT: 0 ;0 NORMAL, 1 WITHIN <>, 2 IN (), 3 IN []. +ASMDSP: ASSEM3 ;PLACE TO JUMP TO FROM ASSEM1 LOOP. + ;ASSEM3 NORMAL. ASSEMC IF WITHIN <>, () OR [] + ;AND .MLLIT ISN'T POS. LSSTHA AFTER > OR ) SEEN. + ;[ ;CONND AFTER ] SEEN. +ASMDS1: 0 ;ASMDSP SAVED HERE DURING ASCII, SIXBIT PSEUDOS. +ASSEMP: 0 ;RESTORE P FROM HERE AT ASSEM1. SAVED OVER LITERAL. +ASMI: 0 ;REINIT I AT ASSEM2 FROM ASMI. +GLSPAS: 0 ;RESTORE GLSP1 AT ASSEM1. SAVED OVER LITERAL. +GLSP1: 0 ;POINTER TO BOT OF LINKAGE TABLE IN USE HIGH ADR +GLSP2: 0 ;POINTER TO TOP OF LINKAGE TABLE IN USE LOW ADR +FORMAT: 0 ;ACCUMULATES FORMAT WORD +FORPNR: 0 ;POINTER INTO FORMAT WORD, SHOULD BE FORMAT+1 SO CLOBBERABLE BY LAST IDPB +FLDCNT: 0 ;NUMBER OF FIELDS PUSHED DOWN IN CURRENT WORD +WRD: 0 ;ACCUMULATES VALUE OF WORD +WRDRLC: 0 ;RELOC OF WRD, MUST COME RIGHT AFTER WRD. +T1: 0 ;TEMP +T2: 0 ;TEMP +PBITS1: 0 ;CURRENT CODE BITS +PBITS2: 0 ;NO OF SPECS LEFT IN CURRENT WORD +PBITS4: 0 ;POINTER TO WHERE CURRENT CODE BITS WILL GO +OPT1: 0 ;POINTER FOR STORING IN BKBUF (OUTPUT BUFFER) +CONTRL: 0 ;FLAG REG FOR IO CONTROL ETC, .GE. 0 => RELOCATABLE/1PASS +CDATBC: 0 ;CURRENT DATA BLOCK CODE TYPE +SCKSUM: 0 ;CKSUM FOR SIMPLE BLOCK FORMAT +IFN A1PSW,[ +PRGC: -1 ;ONE LESS THAN # TIMES END HAS BEEN ENCOUNTERED +OUTN1: -1 ;.GE. 0 => OUTPUT HAS OCCURED IN OTHER THAN 1PASS MODE (NOT INITIALIZED) +OUTC: -1 ;.GE. 0 => OUTPUT HAS OCCURED DURING CURRENT ASSEMBLY +] +LINKL: 0 ;SAVE LIMIT OF GLOTB GETWRD +STRCNT: 0 ;COUNT OF CHARS READ (INCL. DELIM) BY GSYL +STRPNT: 0 ;TEMP AT GSYL, BYTE POINTER TO STRING STORAGE +ISYMF: -1 ;-1 IF ISYMS HAVE NOT BEEN SPREAD +SMSRTF: -1 ;-1 BEFORE SYMTAB IS COMPACTED AND SORTED. + ;AFTER COMPACTING, HOLDS NUMBER OF SYMS THAT WERE THERE BEFORE COMPACTING. +BITP: 0 ;BYTE PNTR TO CODE BITS IN CURRENT (RELOC) BLOCK +LDCCC: 0 ;DEPTH IN LOADTIME CONDS +PARBIT: 0 ;0 OR 4 FOR : OR = (IN GENERAL, TEMP AT P7X) +LABELF: 0 ;-1 IN COLON, SOMETIMES IN EQUAL. CAUSES 3LABEL TO BE SET. +STGSW: 0 ;NON ZERO GIVES ERROR PRINT ON STORAGE WORDS +HKALL: 0 ;NONZERO => HALF-KILL ALL LABELS (.HKALL'S VALUE) +LITSW: 0 ;-1 => USING A LITERAL GIVES AN ERROR +QMTCH: 0 ;-1 => ' AND " NEED MATCHING CLOSINGS (A LA FAIL, MACRO-10) +STARTA: 0 ;STARTING ADDRESS FOR SBLK, RIM, DECSAV +DECSYA: 0 ; ADDRESS TO LOAD SYMBOLS AT (FOR DECSAV FORMAT) +DECBRK: 0 ;LARGEST RELOC. ADDR. LOADED INTO. (USED FOR DEC FMT) +DECBRA: 0 ;LARGEST ABS. ADDR LOADED INTO. +DECBRH: 0 ;LIKE DECBRK BUT FOR ADDRS IN HI SEG. +DECTWO: MOVE ;NOT = MOVE => .DECTWO WAS DONE, AND THIS WD HAS + ;ADDR START OF HISEG. +ISAV: 0 ;I FROM FIELD AT AGETFLD +A.PASS: 0 ; .PASS INTSYM, # OF THIS PASS. +A.PPAS: 0 ;.PPASS INTSYM, # OF PASSES. +WPSTE: NRMWPS ;# WORDS PER SYMTAB ENTRY +WPSTE1: NRMWPS-1;ONE LESS THAN WPSTE - FOR SPEED. +WPSTEB: ,-NRMWPS(B) ;RH HAS - # WORDS PER SYMTAB ENTRY; LH HAS INDEX OF B. +SYMSIZ: 0 ;#WDS IN SYMTAB = WPS* +SYMLEN: SYMMSZ ;SYMTAB SIZE (# SYMS) + ;ASSEMBLED-IN VALUE USED AS DEFAULT, ONLY IF NON-TS. +SYMAOB: 0 ;-<# SYMS>,,0 +INICLB: 0 ;-1 IF INITIALIZATION CODE CLOBBERED. +TTYINS: 0 ;AT START OF ASSEMBLY, -1 => .INSRT TTY PASS1, -2 => PASS2 ALSO. +IFN FASLP,[ +FASBP: 0 ;PNTR TO FASL OUTPUT BUFFER +FASATP: 0 ;PNTR TO FASL ATOM TABLE +FASAT1: 0 ;PNTR TO FASL ATOM TABLE AFTER READING IN NEW ATOM + ; (MAYBE UPDATE FASATP TO THIS IF ATOM WAS UNIQUE9 +FASAT2: 0 ;BYTE PNTR USED TO STORE ATOM IN +FASIDX: 0 ;INDEX NEXT ATOM LOADED INTO FASAT WILL BE +FASPCH: 0 ;AMOUNT OF FASAT "PUNCHED" +FASCBP: 440400,,FASB ;BYTE PNTR TO FASL CODE BIT WORD +FASPWB: 0 ;FASL CODE AT PWRD +FASBLC: 0 ;LOSING BLOCK "COUNT" +FASBLS: 0 ;LOSING BLOCK "SYMBOL" +AFRLD: 0 ;LIST READ CURRENT DEPTH +AFRLEN: 0 ;LIST READ CURRENT LENGTH +AFRDTF: 0 ;LIST READ DOT CONTEXT FLAG (0 NORMAL, 1 SAW DOT, 2 SAW "FROB AFTER DOT" +AFRFTP: 0 ;LIST READ SAVED STATE OF FASATP +AFLTYP: 0 ;TYPE LIST OP IN- 0 EVAL AND THROW AWAY VALUE + ;1 "RETURN" LIST + ;2 "RETURN" VALUE OF LIST +] +PBLK + +;INFO CONVENIENT TO ANYONE GENERATING AN OUT OF TIME-SHARING MIDAS + +;MIDAS OUT OF TIME-SHARING ASSEMBLES INTO A COLLECTION OF SUBROUTINES +;IO IS EXPECTED TO BE HANDLED BY OTHER PROGRAMS. + +;EXITS FROM THE ASSEMBLER: +;TPPB OUTPUT BINARY WORD IN A +;TFEED IF OUTPUT DEVICE IS PTP, PUNCH OUT # FRAMES OF BLANK TAPE + ;SPECIFIED BY B, MAY CLOBBER A AND B +;GO9 RETURN POINT FROM FATAL ERRORS +;TYO TYPE OUT CHARACTER IN A +;TAB TYPE OUT A TAB (MAY CLOBBER A OF COURSE) +;RCHTBL SEE THE RCH ROUTINES + +;ENTRIES + +;PDL, LPDL MAY BE USED BY COMMAND PROCESSOR BUT WILL BE CLOBBERED BY MAIN ROUTINES +;MAIN ROUTINES, CALLED WITH JSP A, , CLOBBER THE WHOLE WORLD (INCLUDING P) +;INIT INITIALIZE +;PS1 PASS 1 +;PLOD IF APPROPRIATE, PUNCH OUT LOADER +;PS2 PASS 2 (DOES ITS OWN PARTIAL INITIALIZATION) +;PSYMS PUNCH OUT SYMBOL TABLE + +;OTHER ENTRIES + +;CONTRL AFTER ASSEMBLY, .GE. 0 => RELOCATABLE, .LT. 0 => ABSOLUTE +;ISYMF -1 IF SYMS HAVE NOT BEEN SPREAD, ELSE DON'T TRY TO ADD TO INITIAL SYMBOL TABLE +;SMSRTF -1 IF SYMTAB HASN'T BEEN SORTED, ELSE SYMTAB CLOBBERED, DON'T RE-ASSEMBLE +;MIDVRS .FNAM2 OF MIDAS ENGLISH + +;SOME FF FLAGS ARE GLOBAL SO COMMAND PROCESSOR CAN KNOW WHAT'S HAPPENED ON RETURN + +;COMMAND PROCESSOR MAY ADD TO INITIAL SYMBOL TABLE BEFORE CALLING INIT THE FIRST TIME +;EISYMT IS THE FIRST LOCATION OK TO DUMP INTO +;EISYMP RH SHOULD BE SET BY COMMAND PROCESSOR TO FIRST LOC NOT DUMPED INTO +;INTSYM RH OF SYMTAB VALUE TO RETURN VALUE ADDRESSED BY LH(SYMTAB ENTRY) + +;RCH HAS AN ELABORATE SET OF GLOBALS, WHICH I DON'T FEEL LIKE PUTTING DOWN NOW, BUT THEY INCLUDE +;RCH (GET CHAR) SEMIC, RRL1, RREOF, SEMICR, SEMIC, TYPCTL, GDTAB, CPGN, CLNN, +;RCHMOD, MDSCLR, MDSSET, RCHSET, POPLMB, PSHLMB +;ALSO RCHTBL ONLY EXIT + +;LISTING FEATURE GLOBALS: +;PILPT PRINT CHAR IN A +;LISTON LISTING ON/OFF FLAG, -1 => ON +;LISTP SAME WORD AS LISTON. +;LISTP1 POSITIVE => LIST EVEN ON NON-PUNCHING PASS. +;LPTCLS END OF LISTING, PRINT FORM FEED, IF TS THEN CLOSE LPT + +;CREF FEATURE GLOBALS: +;CRFOUT OUTPUT WORD IN A. +;CREFP -1 => REQUEST GENERATION OF CREF OUTPUT. +;THE RUBOUT-B-^W HEADER, THE SET-SOURCE-FILE BLOCK, AND THE EOF BLOCK +;ARE THE RESPONSIBILITY OF THE COMMAND PROCESSOR. + +;;RCH ;CHARACTER INPUT ROUTINES + +IFN RCHASW\MACSW,[ + ;SAVE LIMBO1 STATUS AND RH(B) + ;THEN SET UP FOR NEW INPUT MODE (DESCRIPTOR IN A) + ;CALLED BY PUSHEM AND PUSHTT + +PSHLMB: HRL B,LIMBO1 ;LAST CHARACTER INPUT + TLZE FF,FLUNRD ;RE-INPUT CHARACTER ON RETURN? + XCT LSTPLM ;SET B'S SIGN; IF LISTING, JRST PSHLML. +PSHLMN: EXCH A,RCHMOD ;GET OLD MODE IN A + DPB A,[360500,,B] ;STORE IN 5 OF HIGH 6 BITS IN B + PUSH F,B ;SAVE RESULTANT CRUD + CAMN A,RCHMOD ;COMPARE NEW WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + MOVE A,RCHMOD ;NOW GET NEW MODE + JRST PSHLM1 ;SET UP INSTRUCTIONS FOR NEW MODE + +IFN LISTSW,[ +;IF LISTING, LSTPLM HOLDS JRST PSHLML +PSHLML: AOSN PNTSW + JRST PSHLMM ;LAST WAS BREAK CHR + REPEAT 4,IBP PNTBP + SOSA PNTBP +PSHLMM: SETOM LISTBC + TLO B,400000 + JRST PSHLMN +] + + ;UNDO A PSHLMB (NOTE: IN COMMENTS BELOW, "NEW" MODE IS ON PDL, OLD IN RCHMOD) + +POPLMB: POP F,A ;GET WORD THAT PSHLMB PUSHED + HLRZS A ;JUST INTERESTED IN LEFT HALF + TRZE A,400000 ;SIGN BIT SET? + TLOA FF,FLUNRD ;YES, SET FLAG TO RE-INPUT LAST CHAR + TLZA FF,FLUNRD ;NO, CLEAR FLAG. + XCT POPLML ;JFCL\IDPB A,PNTBP ;THE LATTER IFF LISTING. + SETZM LIMBO1 ;INITIALIZE FOR DPB + DPB A,[700,,LIMBO1] ;RESTORE LIMBO1 + LSH A,-<18.-6> ;RIGHT JUSTIFY RCHMOD DESCRIPTOR + CAMN A,RCHMOD ;COMPARE NEW MODE WITH OLD + POPJ P, ;SAME => SKIP OVERHEAD OF SETTING NEW MODE + JRST RCHSET ;SET UP FOR NEW MODE AND RETURN +] + +FOO==0 ;INITIALIZE COUNTER FOR FOLLOWING + +DEFINE RCHBLT SIZE,ADR/ + MOVSI T,FOO(A) + HRRI T,ADR + BLT T,-1+ADR +FOO==FOO+ +TERMIN + +DEFINE RCHMOV ADR/ + MOVE T,FOO(A) + MOVEM T,ADR +FOO==FOO+1 +TERMIN + + ;SET UP FOR INPUT OF MODE TYPE SPECIFIED IN A, CLOBBER A ONLY + +RCHSET: MOVEM A,RCHMOD ;STORE NEW RCHMOD +PSHLM1: TLZ FF,FLMAC\FLTTY ;CLEAR FLAGS (MAYBE DEVICE ROUTINE SETS ONE) + XCT RCHTBL(A) ;GET IN A A POINTER TO A DESCRIPTOR TABLE (MAYBE ALSO SET FLAG) + PUSH P,T ;SAVE T, NEED IT FOR TEMP + RCHBLT 3,RCH2 ;FIRST 3 WORDS RCH2 + TLNE FF,FLVOT + JRST POPTJ ;ALL RCH'S TO GO THROUGH RCH, DON'T DO ANYTHING ELSE +MDSST1: RCHBLT 3,RR1 ;NEXT 3 RR1 + RCHMOV RRL1 ;NEXT WORD RRL1 +RCHPSN==FOO ;# WORDS IN ALL TABLES BUT LAST (NOT OF CONSTANT LENGTH) + RCHBLT 6,SEMIC ;LAST N SEMIC +POPTJ: POP P,T + POPJ P, + +IFN LISTSW,[ + ;SET UP TO "DISPLAY" (ALL RCH'S THROUGH RCH) + +MDSSET: TLO FF,FLVOT ;SET FLAG + MOVEI A,MDSSTB-3 ;SET UP AC + PUSH P,T ;SAVE T FOR RESTORATION + JRST MDSST1 ;NOW SET UP + +MDSSTB: JRST RRL1 ;RR1 + GOHALT + PUSHJ P,RCH ;RREOF + + PUSHJ P,RCH ;RRL1 +IFN .--RCHPSN,.ERR LOSSAGE AT MDSSTB. + PUSHJ P,RCH ;SEMIC + CAIE A,15 + JRST SEMIC + JRST SEMICR + + ;CLEAR OUT DISPLAY MODE + +MDSCLR: TLZ FF,FLVOT ;CLEAR FLAG + MOVE A,RCHMOD + JRST RCHSET ;NOW SET UP FOR REAL IN CURRENT MODE +] ;END IFN LISTSW, + +IFN TS,[ ;TABLE FOR RCHSET, INDEXED BY MODE + ;MAYBE THIS CONDITIONAL WANTS TO BE CHANGED TO SOMETHING ELSE + +RCHTBL: MOVEI A,RCHFIL ;0 => INPUT FROM FILE +IFN MACSW,PUSHJ P,RCHMAC ;1 => INPUT FROM MACRO (DO NOT CHANGE, USED BY MACRO PROCESSOR) +IFN RCHASW,[IFE MACSW,GOHALT + PUSHJ P,RCHTRC ;2 => TTY, QUIT ON CR + PUSHJ P,RCHARC ;3 => TTY, DON'T QUIT ON CR +] + ;TABLE FOR INPUTTING FROM FILE + ;MAYBE THIS CONDITIONAL ALSO WANTS TO BE CHANGED + +RCHFIL: ILDB A,UREDP ;GETCHR, GET CHARACTER + CAIG A,14 ;SKIP IF TOO BIG TO BE SPECIAL + XCT RPATAB(A) ;SPECIAL, DO THE APPROPRIATE THING + + JRST RRL1 ;RR1 + GOHALT + PUSHJ P,[ MOVEI A,0 ;^C IN SYMBOL TREATED LIKE A ^@, + JRST INCHR3] ;BUT ALSO SEE IF REALLY END OF BUFFER. THIS GOES IN RREOF. + + ILDB A,UREDP ;RRL1 +IFN .-RCHPSN-RCHFIL,.ERR RCHFIL LOSES. + LDB CH1,[360600,,UREDP] ;SEMIC; FIND WHERE IN ITS WORD UREDP POINTS + IDIVI CH1,7 + JRST @SEMIC3(CH1) ;AND ENTER THE CR-SCANNING LOOP AT THE APPROPRIATE + JFCL ;PLACE (IT IS A WORD-BY-WORD LOOP). + +;TABLE FOR ABOVE, EXECUTED INDEXED BY CHAR, 15 ONLY FROM SEMIC ELSE ANYTHING +;NOTE: MANY OF THESE ROUTINES SUBTRACT 3 FROM THE PC BEFORE RETURNING. +;THE CALLER MUST MAKE SURE THAT THE ILDB UREDP IS WHAT THEY RETURN TO THAT WAY. + +RPATAB: +IFN ITSSW, JFCL ;0, ON I.T.S. IS NORMAL CHARACTER +.ELSE CALL RPANUL ;0, ON DEC SYSTEM, IGNORE IT. + JFCL + JFCL +IFN .-RPATAB-EOFCH,.ERR EOFCH DOESN'T AGREE WITH ENTRY IN RPATAB. + PUSHJ P,INCHR3 ;3, EOFCH + REPEAT 6,JFCL + CALL RPALF ;LINE FEED + JFCL ;13 + PUSHJ P,RPAFF ;FORM FEED + JRST SEMICR ;FROM SEMIC ONLY, EXIT FROM LOOP + +RPAFF: SKIPE ASMOUT ;FORM FEED + SKIPL TEXT4 ;ALLOW FORMFEED WITHIN GROUPING ONLY IF IN A TEXT PSEUDO. + CAIA + ETR [ASCIZ/Formfeed within <>, () or []/] + AOS CH1,CPGN + SETOM CLNN +IFN ITSSW,[ + ADD CH1,[SIXBIT /P0/+1] + MOVE CH2,A.PASS + DPB CH2,[300200,,CH1] + .SUSET [.SWHO3,,CH1] ;PUT THE NEW PAGE # IN THE WHO-LINE. +] +RPALF: AOS CH2,CLNN + CAME CH2,A.STPLN + RET + MOVE CH1,CPGN + CAMN CH1,A.STPPG + SETOM TTYBRF + RET + +IFN DECSW\TNXSW,[ +RPANUL: MOVE CH1,@UREDP ;SAW A NULL - IN A LINE NUMBER? + TRNN CH1,1 + JRST RCHTRA ;NO, JUST IGNORE IT. + MOVEI CH1,010700 + HRLM CH1,UREDP ;YES, SKIP THIS WHOLE WORD, THEN + CALL RCH ;SKIP THE 1ST CHAR AFTER THE LINE NUMBER + JRST RCHTRA ;RETURN THE NEXT CHAR FROM THIS CALL TO RCH. +] +] ;END IFN TS, + +VBLK +LIMBO1: 0 ;LAST CHARACTER READ BY RCH +RCHMOD: 0 ;CURRENT INPUT MODE, 0 => INPUT FROM FILE, 1 => MACRO, ETC. +CLNN: 0 ;1 LESS THAN LINE # IN CURRENT INPUT FILE. +CPGN: 0 ;1 LESS THAN PAGE # IN CURRENT INPUT FILE +A.STPL: 0 ;1 LESS THAN LINE # TO STOP AT. +A.STPP: 0 ;1 LESS THAN PAGE # TO STOP AT. + ;(STOPPING MEANS INSERTING THE TTY) + +;READ CHARACTER INTO A FROM INPUT FILE, MACRO, OR WHATEVER (RCH) +;CLOBBERS A,CH1,CH2. + +RCH: TLZE FF,FLUNRD + JRST RCH1 ;RE-INPUT LAST ONE +RCH2: GOHALT ;ILDB A,UREDP ;ILDB A,CPTR ;GET CHAR + 0 ;CAIG A,14 ;TRZE A,200 ;CHECK FOR SPECIAL + 0 ;XCT RPATAB(A) ;PUSHJ P,MACTRM ;SPECIAL, PROCESS + MOVEM A,LIMBO1 ;GOT CHAR, SAVE AS LAST CHAR GOTTEN +IFE TS,RCHLS1==JRST TYPCTL +IFN TS,RCHLS1==RET ;DEFAULT CONTENTS OF RCHLST (IF NOT LISTING) +RCHLST: RCHLS1 ;AOSN PNTSW IF LISTING. +IFN LISTSW,[ + PUSHJ P,PNTR + CAIG A,15 + JRST RCHL1 +RCHL3: IDPB A,PNTBP +TYPCTL: POPJ P, ;OR JRST SOMEWHERE +PBLK + +RCHL1: CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + JRST RCHL3 +RCHL2: MOVEM A,LISTBC + SETOM PNTSW + JRST TYPCTL + +VBLK +RCH1: MOVE A,LIMBO1 +RCH1LS: RET ;OR CAILE A,15 IF LISTING. + RET ;NEEDED IN CASE LISTING. + CAIE A,15 + CAIN A,12 + JRST RCHL2 + CAIE A,14 + POPJ P, + JRST RCHL2 +PBLK +] ;END IFN LISTSW, + +IFE LISTSW,[ +PBLK +RCH1: MOVE A,LIMBO1 + RET +] ;END IFE LISTSW, + +;;GETSYL ;VARIOUS SYLLABLE READING ROUTINES (BUT NOT ALL OF THEM) + +GSYL: CLEARB SYM,STRCNT +GSYL1: MOVEI D,6 + MOVE T,[440700,,STRSTO] + MOVEM T,STRPNT +GSYL3: AOSG A,STRCNT + JRST (F) + PUSHJ P,RCH + IDPB A,STRPNT ;STORE CHAR IN STRING EVEN IF DELIMITER (MINIMUM STRCNT = 1) +A.GSY2: CAIN A,". + JRST GSYL1C + HLRZ CH1,GDTAB(A) + CAIN CH1,(JSP CH2,) + JRST GSYL1A ;NUMBER + PUSHJ P,GSYL1B ;RETURN ONLY ON SYL SEP + HRRZ A,GDTAB(A) + MOVE T,LIMBO1 +C%: POPJ P,"% + +GSYL1B: XCT GDTAB(A) ;POPJ FOR SYL SEPS + SUB P,[1,,1] +GSYL1D: SOJGE D,GSYL3 + AOJA D,GSYL3 + +GSYL1C: ADD SYM,%.SQ(D) + JRST GSYL1D + +GSYL1A: XCT NSQTB-60(A) + JRST GSYL1D + + ;VERSION OF GETSYL TO TRY UNTIL SYL OR WORD TERMINATOR FOUND + ;SKIPS IF NAME THERE (FOR .TYPE, SQUOZE) + +GTSLD2: TLNN C,DWRD\DFLD + JRST GTSLD3 ;DELIMITER IS WORD TERMINATOR, TOLERATE THE NULL SYLLABLE +GETSLD: PUSHJ P,GETSYL ;ENTRY, GET A SYL + MOVE C,CDISP ;GET CDISP + TRNN I,IRSYL + JRST GTSLD2 ;NO SYL + AOS (P) ;GOT SYL, CAUSE RETURN TO SKIP +GTSLD3: TLNN C,DWRD\DFLD + TLO FF,FLUNRD ;CAUSE DELIMITER TO BE RE-INPUT + POPJ P, + +PASSPS: SKIPA A,LIMBO1 +GPASST: CALL RCH + CAIE A,40 + CAIN A,^I + JRST GPASST + RET + +GETSYL: TLZ I,ILUARI+ILNPRC+ILLSRT +GTSL1: CLEARB SYM,NUMTAB ;RECUR HERE FOR RIGHT ARG TO ^ AND _. + MOVE AA,[NUMTAB,,NUMTAB+1] + AOSN NTCLF + BLT AA,NUMTAB+10 ;NUMTAB NOT CLEAR, HAVE TO CLEAR IT + MOVEI D,6 ;CHARACTER COUNTER FOR BUILDING UP SYM + SETOM ESBK ;NO SPECIFIC BLOCK DESIRED. + TDZ I,[ILDECP+ILFLO+ILVAR+ILGLI,,IRPERI+IRLET+IRSYL] +RRL2: PUSHJ P,RR ;CALL MAIN LOOP ROUTINE, READ UNTIL NON-SQUOZE CHAR +SEMICR: ;RETURN HERE FROM SEMIC WITH CR IN A + MOVEM A,LIMBO1 ;SYLLABLE OPERATOR OR TERMINATOR IN A, SAVE + HRRZ A,GDTAB(A) ;NOW GET RIGHT HALF OF POPJ, INDEX INTO DTB + MOVE C,DTB-40(A) ;GET DTB ENTRY (FLAGS,,JUMP ADR) + MOVEM C,CDISP ;STORE AS DISPATCH CODE FOR LAST CHAR (SORT OF AN INTERPRETED LIMBO1) +RR8: TLNE C,DSYL ;NOW SEE IF SYL OPERATOR FLAG SET + JRST (C) ;SET => INTRA-SYLLABLE OPERATOR +RR10: TRNE I,IRLET ;NOT SET => SYLLABLE TERMINATOR: SYL? + POPJ P, ;SYL HAS LETTERS + TRNN I,IRSYL + JRST CABPOP ;NO SYL + CAMN SYM,[SQUOZE 0,.] + JRST PT1 ;SYM IS . + ;NUMBER + +RR5: TLNN I,ILNPRC + PUSHJ P,NUMSL + TLNN I,ILFLO + JRST RR9 ;NOT FLOATING POINT + MOVE A,B ;FLOATING, HIGH IN AA,LOW IN A,EXP IN B + ADDI A,306 ;201+105 TO ROUND + ADDI AA,200 ;CAUSE EXPONENT TO BE ACCEPTABLE TO MACHINE + JUMPGE AA,.+3 ;NOW CHECK FOR OVERFLOW ON ROUNDING + LSH AA,-1 ;OVERFLOW, SHIFT BACK ONE + AOS A ;INCREMENT EXPONENT TO COMPENSATE FOR SHIFT + EXCH A,AA ;GET EXPONENT IN AA, REST IN A + ASHC AA,-10 ;SHIFT TO MACHINE FLOATING POINT FORMAT + SKIPE AA ;NOW CHECK HIGH ORDER BITS OF EXPONENT NOT SHIFTED INTO NUMBER + ETR [ASCIZ /Exponent overflow/] +RR9: TLZ I,ILGLI+ILVAR ;NOT TRYING TO DEFINE NUMBER AS VARIABLE OR GLOBAL +CLBPOP: TDZA B,B ;CLEAR OUT B (RELOCATION BITS OF VALUE) +CABPOP: SETZB A,B ;DO JRST CABPOP TO RETURN ZERO AS VALUE + POPJ P, + +RRU: MOVE A,LIMBO1 ;GET HERE WHEN FLUNRD SET AT RR, RETRIEVE CHARACTER FROM LIMBO1 + CAIG A,14 ;IF TOO BIG, + CAIGE A,12 ;OR IF TOO SMALL, + JRST RR1B ;THEN JUST FALL BACK IN + TLNN FF,FLVOT\FLMAC\FLTTY ;SKIP IF NOT HACKING CPGN/CLNN + XCT RRUTAB-12(A) ;HACKING, UNHACK FOR HACK COMING UP + JRST RR1B ;FALL BACK IN + +RRUTAB: SOS CLNN ;LINE FEED (TABLE FOR RRU) + JRST RR1B ;13 + SOS CPGN ;FORM FEED + + ;MAIN LOOP ROUTINE FOR GETSYL, READ SYM OR NUMBER +VBLK +RR: TLZE FF,FLUNRD ;RE-INPUT LAST CHARACTER? + JRST RRU ;YES +RR1: JRST RRL1 ;ILDB A,CPTR ;GET CHAR (" " ") + GOHALT ;TRZE A,200 ;CHECK FOR END OF STRING +RREOF: PUSHJ P,RCH ;PUSHJ P,MACTRM ;PROCESS CONDITION, GET NEXT CHAR OR JRST RR1 OR RRU + .SEE RCHTRA ;SPECIAL HANDLING OF UNRCHF IN RCHTRA IF CALLED FROM HERE. +RR1B: XCT GDTAB(A) ;GOT CHAR, DO SOMETHING APPROPRIATE (POPJ ON NOT SQUOZE) + TROA I,IRLET\IRSYL ;LETTERS RETURN, JUST UPDATED SYM, SET FLAGS + TRO I,IRSYL ;NUMBERS RETURN, SET FEWER FLAGS + SOJGE D,RR1 ;DECREMENT SYM COUNTER AND LOOP + AOJA D,RR1 ;COUNTER EXHAUSTED, INCREMENT BACK TO 0 AND LOOP + +RRL1: PUSHJ P,RCH ;ILDB A,UREDP ;GET CHAR + XCT GDTAB(A) ;NOW MAKE LIKE RR1B (EOFCH => JRST RREOF) + TROA I,IRLET\IRSYL + TRO I,IRSYL + SOJGE D,RRL1 + AOJA D,RRL1 + + ;SEMICOLON (GET HERE FROM RR8) + + JRST SEMICL ;RETURN HERE FROM SEMIC+2 WHEN FLUNRD SET +;NEXT 4 INSNS ALTERED IN DIFFERENT INPUT MODES. SEE RCHFIL, ETC. +SEMIC: PUSHJ P,RCH ;GET CHAR + CAIE A,15 ;SEE IF SPECIAL + JRST SEMIC ;SPECIAL => DO SOMETHING (JRST SEMICR ON CR) + JRST SEMICR ;IF NOT SPECIAL THEN GO BACK FOR NEXT CHAR + +LOC SEMIC+6 ;LEAVE A LITTLE EXTRA ROOM FOR BIG ROUTINES +PBLK + +SEMICL: MOVE A,LIMBO1 ;HERE FROM SEMIC-1, RETRIEVE CHARACTER FROM LIMBO1 + CAIE A,15 ;SKIP IF SHOULD TERMINATE SCAN + JRST SEMIC ;NOT CR, FALL BACK IN + JRST SEMICR ;DONE + +SEMIC2: +REPEAT 5,[ + ILDB A,UREDP + CAIG A,15 + XCT RPATAB(A) +] + MOVE A,[ASCII /@@@@@/] +SEMIC1: AOS CH1,UREDP + MOVE CH1,(CH1) ;ANY CONTROL CHARS IN THE WORD UREDP POINTS AT? + MOVE CH2,CH1 + AND CH1,A + AND CH2,[ASCII/ /] + LSH CH2,1 + IOR CH1,CH2 + CAMN CH1,A + JRST SEMIC1 ;NO, ADVANCE TO NEXT WORD AND TEST IT. + MOVEI A,440700 + HRLM A,UREDP + JRST SEMIC2 ;YES, LOOK AT EACH CHAR AND PROCESS IT. + +SEMIC3: REPEAT 6,JRST SEMIC2+3*<5-.RPCNT> + +;JSP CH2,RR2 => DIGIT (FROM GDTAB) +;THIS ROUTINE IS GROSSLY SLOW, AND SHOULD BE SPEEDED UP SOMETIME + +RR2: XCT NSQTB-"0(A) ;UPDATE SQUOZE. + TRNE I,IRLET + JRST 1(CH2) ;SYL IS SYM, DON'T WASTE TIME. + TRNE I,IRPERI + TLO I,ILFLO ;DIGIT AFTER . => FLOATING. +MAKNUM: SETOM NTCLF ;NUMTAB ABOUT TO NOT BE CLEAR, SET FLAG FOR GETSYL TO CLEAR IT OUT NEXT TIME + MOVEI AA,2 ;INDEX INTO NUMTAB ETC., SOJGE'D TO GET ALL RADICES +MAKNM1: MOVE T,ARADIX(AA) ;GET THIS RADIX, + CAMN T,ARADIX ;REDUNDANT => SKIP THIS PASS. + JUMPN AA,MAKNM4 + SKIPGE CH1,HIGHPT(AA) + JRST MAKNM3 + MUL T,LOWPT(AA) ;TT HAS OLD LOW TIMES RADIX, T HAS OVFLO TO HIGH. + ADDI TT,-"0(A) ;ADD DIGIT TO LOW PART + TLZE TT,400000 + AOJ T, ;OVERFLOW, INCREMENT SPILLOVER FROM MUL OF LOWPT + JUMPE CH1,MAKNM5 ;OLG HIGHPT WAS 0 => SAVE TIME. + JFCL 17,.+1 ;NOW CLEAR OV, ETC. + IMUL CH1,ARADIX(AA) ;MULTIPLY HIGHPT BY RADIX + ADD T,CH1 ;ADD HIGH PARTS + JFCL 10,MAKNM2 ;JUMP ON OVERFLOW FROM IMUL OR ADD +MAKNM5: TLNE I,ILFLO + SOS NUMTAB(AA) ;FLOATING, DECREMENT EXP TO COMPENSATE FOR MULT OF HIGHPT/LOWPT + MOVEM T,HIGHPT(AA) ;NOW STORE STUFF BACK + MOVEM TT,LOWPT(AA) +MAKNM4: SOJGE AA,MAKNM1 ;NOW DO ALL THIS FOR NEXT RADIX + JRST 1(CH2) + +MAKNM2: MOVSI B,400000 ;OVERFLOW FROM UPDATING HIGH PARTS + IORM B,HIGHPT(AA) ;SET SIGN BIT +MAKNM3: TLNN I,ILFLO + AOS NUMTAB(AA) ;NOT FLOATING, INCREMENT EXP, MAY NOT WANT TRAILING BITS + JRST MAKNM4 + +VBLK +NUMTAB: 0 ;EXPONENT + 0 + 0 +HIGHPT: 0 ;HIGH PART OF CURRENT NUMBER THIS RADIX + 0 ;4.9 => OVERFLOW, TRAILING DIGITS DROPPED + 0 +LOWPT: 0 ;LOW PART OF CURRENT NUMBER THIS RADIX + 0 ;HIGHPT/LOWPT TAKEN AS 70. BIT POSITIVE INTEGER EXCEPT 4.9(HIGHPT) IS FLAG INSTEAD OF + 0 ;EXPONENTIATE 70. BIT INTEGER BY NUMTAB (WHICH MAY BE NEGATIVE) TO GET ACTUAL VALUE +ARADIX: 10 ;CURRENT RADIX + 12 + 10 + +NTCLF: -1 ;-1 => NUMTAB NOT CLEAR (TO SAVE BLT AT GETSYL WHEN CLEAR) +PBLK + +;JRST POINT => . (FROM GDTAB) + +POINT: TLO I,ILDECP ;PREFER DECIMAL + TROE I,IRPERI ;SET PERIOD FLAG + TRO I,IRLET ;2 POINTS => NAME + ADD SYM,%.SQ(D) ;UPDATE SYM + JRST 1(CH1) ;RETURN + +RBRAK: SOSL SCNDEP ;IF A CONDITIONAL TO TERMINATE, + JRST RBRAK2 ;HAVE DONE SO, IGNORE CHAR. + SETZM SCNDEP +;CLOSES OF ALL KINDS COME HERE. +RPARN: +GRTHN: MOVE A,LIMBO1 + SKIPE CH1,ASMOUT ;WHAT KIND OF OPEN ARE WE IN? + CAIN CH1,4 ;WITHIN A .ASCII OR + JRST RBRAK1 ;NOT WITHIN GROUPING => THIS CLOSE IS STRAY. + CAME A,ASMOT1(CH1) ;RIGHT KIND OF CLOSE FOR THAT OPEN? + ERJ RBRAK3 +RBRAK4: MOVE CH1,ASMOT2(CH1) + MOVEM CH1,ASMDSP ;ARRANGE FOR THIS ASSEM1 LEVEL TO EXIT +RBRAK5: SETZM CDISP + JRST RR10 ;AND GO TERMINATE WORD. + +RBRAK3: CALL TYOERR ;COME HERE ON CLOSE WRONG FOR OPEN. + ;(EG, ")" MATCHING "<"). + TYPR [ASCIZ/ Seen when /] + MOVE A,ASMOT1(CH1) + CALL TYOERR + TYPR [ASCIZ/ expected +/] + JRST RBRAK4 + +RBRAK1: CAIN CH1,4 ;CLOSE INSIDE A .ASCII => + JRST RBRAK5 ;TERMINATE WORD BUT DON'T CLOSE ANYTHING. + SKIPN CONSML ;COME HERE FOR STRAY CLOSE. + JRST RRL2 + ERJ .+1 + TYPR [ASCIZ/Stray /] + MOVE A,LIMBO1 ;GET THE CLOSE WE SAW. + CALL TYOERR + CALL CRRERR + JRST RRL2 + +;COME HERE FOR CLOSE-BRACE, AND CERTAIN CLOSE-BRACKETS. +RBRAK2: SETOM A.SUCC ;HAVE JUST ENDED SUCCESSFUL BRACKETED CONDIT, + JRST RRL2 ;REMEMBER THAT MOST RECENT CONDITIONAL WAS TRUE. + +FORMF: TLNN FF,FLVOT\FLMAC\FLTTY ;FORM FEED SYLLABLE OPERATOR ROUTINE + PUSHJ P,RPAFF ;UNLESS ALREADY DONE, INCREMENT PAGE #. + JRST RR10 + +LINEF: TLNN FF,FLVOT\FLMAC\FLTTY ;LINE FEED SYLLABLE OPERATOR ROUTINE + CALL RPALF + JRST RR10 + +CTLAT: +IFN DECSW\TNXSW,[ + TLNN FF,FLVOT\FLMAC\FLTTY ;^@ SYLLABLE OPERATOR ROUTINE. + CALL RPANUL +] + JRST RRL2 + +;DECIPHER A VALUE FROM NUMTABS +;LEAVES HIGH PART IN AA, LOW PART IN A, BINARY EXPONENT IN B +;AND RADIX USED IN D. + +NUMSL: TLNN I,ILVAR\ILDECP\ILFLO + SKIPE B,HIGHPT + JRST NUMSLS + MOVE A,LOWPT ;BE VERY FAST IN CASE OF SMALL FIXNUM IN CURRENT RADIX. + MOVE D,ARADIX ;SAVE RADIX AND HIGH PART FOR ^. + SETZ AA, + RET + +NUMSLS: CLEARB TT,D ;TT BIT EXPONENT, D INDEX INTO NUMTAB, ETC. + TLNE I,ILDECP+ILVAR ;NEITHER . NOR ', CURRENT RADIX. + TLNE I,ILGLI ;" => CURRENT RADIX DESPITE . OR '. + JRST NUMSL0 + MOVEI D,1 ;DECIMAL UNLESS ' + TLNE I,ILVAR ;WHICH FORCES OCTAL. + MOVEI D,2 + MOVE A,ARADIX(D) + CAMN A,ARADIX ;IF REALLY SAME AS CURRENT RADIX, + MOVEI D,0 ;COMPUTATION WASN'T DONE FOR THIS VALUE OF D, + ;SO USE COMPUTATIONS DONE FOR CURRENT RADIX. +NUMSL0: MOVE AA,HIGHPT(D) ;AA := HIGH PART + MOVE B,LOWPT(D) ;B := LOW PART + MOVE T,NUMTAB(D) ;T := EXPONENT + MOVE D,ARADIX(D) ;NO LONGER NEED IDX, GET RADIX VALUE. + TLNN I,ILFLO + JRST FIXNUM ;NOT FLOATING + TLZ AA,400000 ;FLOATING, DON'T NEED DIGITS LOST ON OVERFLOW +NUMC1: JUMPN AA,.+2 ;ENTRY FROM UPARR + JUMPE B,FIX0 ;COMPLETELY ZERO => RETURN FIXED ZERO + JUMPL T,NUMSL1 ;JUMP IF EXPONENT NEGATIVE + JUMPE T,NUMSL2 ;JUMP (SKIP FOLLOWING) IF EXPONENT ZERO + ;EXPONENT POSITIVE, DO THE APPROPRIATE THING +NUMSL5: MULI B,(D) ;MULITIPLY LOW PART BY RADIX + MULI AA,(D) ;MULTIPLY HIGH PART BY RADIX + ADD A,B ;A := LOW PART OF HIGH + HIGH PART OF LOW + TLZE A,400000 + ADDI AA,1 ;OVERFLOW ON ADDITION, INCREMENT HIGH PART OF HIGH + MOVE B,C ;NO LONGER NEED HIGH OF LOW, GET LOW OF LOW IN B +NUMSL3: JUMPE AA,NUMSL4 ;NOW CHECK FOR OVERFLOW INTO HIGH OF HIGH, JUMP ON NONE + ASHC A,-1 ;NEXT THREE INSTRUCTIONS TO DO ASH3 AA,-1 + ASH A,1 + ASHC AA,-1 + AOJA TT,NUMSL3 ;INCREMENT BIT EXPONENT AND TRY AGAIN + +NUMSL4: MOVE AA,A ;FLUSHED OVERFLOW, NOW GET (LOW PART OF) HIGH PART IN AA + SOJG T,NUMSL5 ;COUNT DOWN + +NUMSL2: TLNN I,ILFLO + JRST NUMSL9 ;NOT FLOATING, DON'T WASTE TIME NORMALIZING. + SKIPA A,B ;EXPONENT NOW ZERO, GET LOW PART OF NUMBER IN A +NUMSL7: ASHC AA,1 ;NOW NORMALIZE + TLNN AA,200000 + SOJA TT,NUMSL7 + SKIPA B,TT ;DONE NORMALIZING, RETURN BINARY EXPONENT IN B +PT1: TRO I,IRLET + POPJ P, + +NUMSL9: MOVE A,B + MOVEI B,0 + ASHC AA,(TT) ;SHIFT 2-WD NUM. BY EXPONENT, + LSH A,1 ;PUT HIGH BIT IN WITH REST. + JRST FIX1 + +FIX0: TLZ I,ILFLO +FIXNUM: LSHC A,45 +FIX1: LSHC AA,-1 + JUMPE AA,.+2 + ETR [ASCIZ /FIXNUM too big for 36 bits/] + POPJ P, + +NUMSL1: SKIPA A,B ;EXPONENT NEGATIVE: NORMALIZE NOW +NUMSL8: ASHC AA,1 +NUMSL6: TLNN AA,200000 + SOJA TT,NUMSL8 ;NOT NORMALIZED YET + AOS T + MOVEI TM,(D) + TLNN TM,-1 ;GET CONVIENT POWER OF RADIX + JUMPL T,[ IMULI TM,(D) + AOJA T,.-1] + MOVE B,A ;GET NORMALIZED LOW PART IN B + IDIV AA,TM ;DIVIDE HIGH PART BY APPROPRIATE RADIX + DIV A,TM + JUMPL T,NUMSL6 + MOVE B,A + JRST NUMSL2 + +UPARR: TRON I,IRSYL + JRST UPCTRC ;"UNARY UPARROW" => GOBBLE CHARS + TRNE I,IRLET + ETR [ASCIZ /Symbolic 1st arg to "^"/] + PUSHJ P,NUMSL ;DECIPHER NUMTABS + PUSHJ P,UA3 ;GET RIGHT OPERAND IN T + MOVE TT,B ;EXPONENT + MOVE B,A ;LOW PART + PUSHJ P,NUMC1 ;T EXP HIGH IN AA LOW IN B TT BIN EXP + MOVE C,CDISP ;IF A _ WAS DEFERRED WHILE ILUARI WAS SET, + TLO I,ILNPRC + CAME C,[DSYL,,BAKAR] ;DO IT NOW. + JRST RR10 + +BAKAR: TLNE I,ILUARI + JRST RR5 ;RETURN TO UPARROW (WILL COME BACK HERE LATER) + TRNE I,IRSYL + TRNE I,IRLET + JRST BAK1 ;NO SYL, OR SYL IS NAME + CAMN SYM,[SQUOZE 0,.] + JRST BAK1 ;. ALSO NAME + TLZN I,ILNPRC + PUSHJ P,NUMSL + PUSHJ P,UA3 + ADD B,T + ASHC AA,(B) + LSH A,1 + LSHC AA,-1 + CLEARB B,AA + TLZ I,ILFLO + MOVE C,[DFLD,,CBAKAR] + EXCH C,CDISP ;IF 2ND ARG ENDED WITH A _, TURN INTO FIELD OP. + CAME C,[DSYL,,BAKAR] + EXCH C,CDISP + POPJ P, + +UPCTRC: SETZ T, +UPCTR1: JSP F,QOTCOM ;UP ARROW TO GOBBLE SYL AND RETURN MASKED ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + CAIL A,140 + SUBI A,40 + ANDI A,77 ;NOW MASK CHARACTER IN TO TO BOTTOM 6 BITS + ADD T,A ;ADD TO ACCUMULATED + POPJ P, + +BAK1: MOVE TT,[DFLD,,CBAKAR] + MOVEM TT,CDISP + JRST RR10 + +UA3: HRLM D,(P) ;SAVE RADIX (FOR UPARR) + JSP LINK,SGTSY ;PUSH I,AA,A,B + TLO I,ILUARI ;TELL _ TO WAIT TILL LATER (SEE UPARR, BAKARR) + PUSHJ P,RCH + CAIN A,"- + TROA I,IRGMNS + TLO FF,FLUNRD + PUSHJ P,RCH + CAIN A,"< + JRST UAR1 + TLO FF,FLUNRD +UA3L: PUSHJ P,GTSL1 ;GOBBLE SYL, LOOP POINT FOR PSEUDO OR MACRO RETURNED WITHOUT VALUE + TRNE I,IRLET + JRST UA3S ;NAME + TLNE I,ILFLO + ETR [ASCIZ /Floating point 2nd arg to "_"/] +UAR2: TRZN I,IRGMNS + SKIPA T,A + MOVN T,A + JSP LINK,SGTSY1 ;RESTORE GETSYL TEMPS. + HLRZ D,(P) + POPJ P, + +UA3S: PUSHJ P,GETVAL ;MAKE NUMBER_NAME WORK + JRST UA3SR ;GOT VALUE, PROCESS + JRST UA3L ;NO VALUE, TRY AGAIN + +UAR1: TLO I,ILLSRT + TRZ I,IRSYL ;(OR ELSE LSSTH GIVES NOS ERROR.) + SETZB A,B + PUSHJ P,LSSTH +UA3SR: JUMPN B,RLCERR ;RELOC ERR + JRST UAR2 + +ATSGN: MOVSI A,20 ;ATSIGN + IORM A,WRD + TRO I,IRFLD ;SET IRFLD FLAG EVEN THOUGH NOT DIRECTLY RETURNING VALUE + ; ^ CHANGED FROM SYL TO FIELD 9/6/70 + JRST RRL2 ;FALL BACK IN + +DQUOTE: TRON I,IRSYL + JRST DQUOT8 + TRNN I,IRLET ;AFTER NUMBER => CURRENT RADIX. + JRST DQUOT7 + PUSHJ P,RCH + TLO FF,FLUNRD ;NEXT CHAR. SQUOZE? + HLRZ A,GDTAB(A) + CAIN A,(POPJ P,) + JRST DQUOT7 ;NO => MAKE PREV. SYM. GLOBAL. + CAMN SYM,[SQUOZE 0,.M] ;SPECIAL BLOCK NAMES + JRST DQUOTM ;.M MEANS MAIN BLOCK, + CAMN SYM,[SQUOZE 0,.U] + JRST DQUOTU ;.U MEANS SUPERIOR. + CAMN SYM,[SQUOZE 0,.C] + JRST DQUOTC ;.C MEANS CURRENT BLOCK. + SKIPGE A,ESBK ;GET SPEC'D BLOCK OR CURRENT, + HRR A,BKCUR ;LOOK FOR SUBBLOCK OF THAT BLOCK. + HLL A,BKTAB+1(A) + ADD A,[1,,] ;LH HAS LEVEL SUBBLOCK OUGHT TO HAVE. + MOVEI T,0 + SETO D, ;NO POSSIBLE ALTERNATE CHOICE YET. +DQUOT0: CAME SYM,BKTAB(T) ;LOOK AT ALL BLOCKS SEEN. + JRST DQUOT1 ;HAS THE NAME WE'RE LOOKING FOR? + SKIPGE ESBK ;IF LOOKING FOR A SUBBLOCK OF A PARTICULAR BLOCK, + JRST DQUOT4 + CAMN A,BKTAB+1(T) + JRST DQUOT2 ;SUCH A BLOCK WINS; ALL OTHERS LOSE. + JRST DQUOT1 + +DQUOT4: SKIPN BKTAB+2(T) ;ELSE PREFER DEFINED BLOCKS TO UNDEFINED ONES. + JUMPGE D,DQUOT1 + SKIPE BKTAB+2(T) + JUMPL D,DQUOT5 + CAME D,[-1] ;THAT'S THE SAME EITHER WAY => PREFER AN INFERIOR + CAMN A,BKTAB+1(T) ;OF THE CURRENT BLOCK TO ONE THAT'S NOT. + JRST DQUOT5 + JRST DQUOT1 + +DQUOT5: HRROI D,(T) ;FOUND A BLOCK WE LIKE BEST SO FAR. + SKIPE BKTAB+2(T) + ANDI D,-1 ;LEAVE SIGN OF D SET UNLESS THE BLOCK IS DEFINED. +DQUOT1: ADDI T,BKWPB + CAMGE T,BKTABP + JRST DQUOT0 + HRRZI T,(D) ;NOW USE THE BEST BLOCK FOUND, IF THERE WAS ONE. + CAIE T,-1 + JRST DQUOT2 + MOVE T,BKTABP ;NOT FOUND, GET IDX OF 1ST UNUSED ENTRY. + CAIL T,BKTABS + ETF ERRTMB ;NO ROOM FOR MORE BLOCKS. + MOVEM SYM,BKTAB(T) + MOVEM A,BKTAB+1(T) ;ADD BLOCK AT END. + MOVEI A,BKWPB(T) + MOVEM A,BKTABP ;POINTS AFTER LAST USED ENTRY. +DQUOT2: MOVEM T,ESBK + SETZ SYM, +DQUOT3: MOVEI D,6 ;NEXT CHAR GOES IN 1ST SQUOZE POS. + JRST RRL2 + +DQUOTM: MOVEI T,BKWPB ;.M - MAIN BLOCK FOLLOWS INITIAL SYMS BLOCK. + JRST DQUOT2 + +DQUOTU: SKIPGE T,ESBK ;.U SPEC'D - GET SPEC'D OR CURRENT BLOCK, + MOVE T,BKCUR + HRRZ T,BKTAB+1(T) + JRST DQUOT2 ;SPEC. ITS SUPERIOR. + +DQUOTC: SKIPGE T,ESBK ;.C => SPEC THE CURRENT BLOCK. + MOVE T,BKCUR + JRST DQUOT2 + +SQUOT1: TLOA I,ILVAR +DQUOT7: TLO I,ILGLI + MOVE A,BKCUR ;IF NO SPEC'D BLOCK, + SKIPGE ESBK + MOVEM A,ESBK ;SPEC. CURRENT BLOCK. + JRST RRL2 + +DQUOT8: SETZ T, +DQUOT9: JSP F,QOTCON ;DOUBLE QUOTE TO GOBBLE SYL AND RETURN ASCII VALUE + LSH T,7 ;SHIFT ACCUMULATED VALUE OVER 7 + ADD T,A ;ADD IN ASCII CHARACTER IN A + POPJ P, ;RETURN TO SOMETHING + +SQUOTE: TROE I,IRSYL + JRST SQUOT1 + SETZ T, +SQUOT9: JSP F,QOTCON ;SIXBIT SYL + CAIGE A,40 + ETR ERRN6B ;NOT SIXBIT + CAIL A,140 + SUBI A,40 ;CONVERT TO UPPER CASE + LSH T,6 ;SHIFT OVER ACCUMULATED VALUE + ADDI T,-40(A) ;ADD IN SIXBIT FOR CHARACTER IN A + POPJ P, + +;COMMON ROUTINE FOR RIGHT JUSTIFIED TEXT SYLS +;CALLED WITH JSP F,; ROUTINE PUSHJ'S BACK W/ CHAR IN T, ACCUM VALUE IN A +;SYL FLAG EXPECTED TO BE ALREADY SET +QOTCON: SKIPE QMTCH ;' AND " COME HERE, BUT NOT ^: IF IN QUOTES-MATCHING MODE, USE A + JRST QOTCO4 ;FAIL-LIKE ALGORITHM. HERE FOLLOWS THE OLD MIDAS WAY OF DOING IT +QOTCOM: CALL RCH ;USE AT LEAST 1 CHAR IN ANY CASE. + JRST QOTCO1 + +QOTCO2: CALL RCH ;USE SUCCEEDING CHARS IF SQUOZE CHARS. + HLRZ CH1,GDTAB(A) + CAIN CH1,(POPJ P,) + JRST QOTCO3 +QOTCO1: CALL (F) + JRST QOTCO2 + +QOTCO3: CAIN A,"" ;NONSQUOZE: IF IT IS A TEXT SYL INDICATOR, + JRST DQUOT9 ;CONTINUE WITH WHATEVER TYPE OF TEXT + CAIN A,"' + JRST SQUOT9 ;IT INDICATES. + CAIN A,"^ + JRST UPCTR1 +QOTCO6: TLO FF,FLUNRD + JRST TEXT5 + +QOTCO4: MOVE B,LIMBO1 ;GET ' OR ", WHICHEVER STARTED THIS SYL, AS THE DELIMITER. + MOVE SYM,[SQUOZE 0,TEXT] + JSP TM,ERMARK +QOTCO5: CALL RCH + CAMN A,B ;FOUND ANOTHER EXAMPLE OF THE DELIMITER? + JRST [ CALL RCH ;IF DUPLICATED, IT PUTS THE DELIMITER IN THE CONSTANT. + CAMN A,B + JRST .+1 + JRST QOTCO6] ;OTHERWISE UNREAD THE CHAR AFTER THE DELIMITER AND EXIT. + CALL (F) ;HAVE CHAR TO PUT IN STRING IN A; GO MERGE IT IN. + JRST QOTCO5 + +;RETURN A VALUE FROM A PSEUDO WHOSE ARGS CAN BE TERMINATED BY EITHER COMMA (GOBBLED) +;OR CR (NOT GOBBLED). +VALRET: MOVE T,A ;ROUTINE TO RETURN VALUE IN A AFTER LAST CHAR GOBBLED BY GETSYL + MOVE B,CDISP ;GET STORED DISPATCH CODE + TLNN B,DWRD\DFLD + JRST VALR1 ;WORD TERMINATOR +;COME HERE TO RETURN A VALUE, AND ALSO +;BARF IF THE NEXT CHARACTER ISN'T A SYLLABLE SEPARATOR +TEXT5: PUSH P,T ;ENTRY FROM TEXT ROUTINES (NLAST CHAR NOT GOBBLED BY GETSYL) TO RETURN VALUE IN T + PUSHJ P,GETSYL ;SEE IF IMMEDIATELY FOLLOWED BY SYL + TRNE I,IRSYL + ETR ERRNOS ;NO SEPARATOR BETWEEN TWO VALUES + POP P,A ;RESTORE VALUE TO RETURN +VALR1: TRO I,IRSYL + JRST CLBPOP + +;VARIOUS PUSH AND POP ROUTINES, ALL CALLED W/ JSP LINK, + +SGTSY: PUSH P,I + PUSH P,AA + PUSH P,A + PUSH P,B + JRST (LINK) + +SGTSY1: POP P,B + POP P,A + POP P,AA + POP P,I + JRST (LINK) + +;JSP LINK,SAVWD1 TO SAVE STUFF FOR < OR (, ETC. + +SAVWD1: PUSH P,A ;SYLL. BEFORE GROUPING NOW STARTING. + PUSH P,B ;AND ITS RELOC. + +SAVWLD: PUSH P,FORMAT + PUSH P,FORPNR + PUSH P,FLDCNT + PUSH P,GLSP2 + PUSH P,I + PUSH P,WRD + PUSH P,WRDRLC + PUSH P,SYM + PUSH P,PPRIME + PUSHJ P,(LINK) +SAVL1==. + +;POP OFF WHAT PUSHED BY SAVWLD. CLEARS FLUNRD, IN CASE THE > OR ) WAS UN-READ. + +USVWLD: POP P,SYM + HRRZS SYM + CAIE SYM,SAVL1 + GOHALT + TLZ FF,FLUNRD + POP P,PPRIME + POP P,SYM + POP P,WRDRLC + POP P,WRD + TDZ I,[-1-(ILWORD)] + IOR I,(P) + POP P,1(P) + POP P,GLSP2 + POP P,FLDCNT + POP P,FORPNR + POP P,FORMAT + JRST (LINK) + +;;GETFD ;GET FIELD (EXPRESSION); RETURN VALUE IN A, RELOC BITS IN B + + ;GET FIELD FOR PSEUDO + ;SYM SHOULD CONTAIN THE SQUOZE NAME OF THE PSEUDO + ;OR A POINTER TO AN INSN TO EXECUTE WHEN UNDEF + ;SYMBOL SEEN. SYM IS NOT CLOBBERED. + +AGETFD: PUSH P,I ;SAVE I + TRO I,IRPSUD+IRNOEQ ;SET FLAG TO GETVAL TO EXECUTE GTVER ON UNDEFINED SYM ON EITHER PASS + PUSH P,GTVER ;OLD VALUE OF GTVER + MOVEM SYM,GTVER ;ERROR MSG SHOULD GIVE NAME OF PSEUDO. + CALL YGETFD + MOVE SYM,GTVER + REST GTVER + MOVEM I,ISAV ;SAVE FLAGS FOR FIELD GOTTEN +POPIJ: POP P,I + POPJ P, + +;READ A FIELD, NOT PART OF THE CURRENT WORD. +YGETFD: PUSH P,WRD + SETZM WRD + CALL XGETFD + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + ADD A,WRD ;ADD IN INDEX, INDIRECT FIELDS + POP P,WRD + POPJ P, + +IFN FASLP,[ +FAGTFD: PUSHJ P,AGETFD ;DO AGETFD, COMPLAIN IF RELOCATABLE OR GLOBAL + MOVE TM,GLSP1 + CAMN TM,GLSP2 + SKIPE B + ETSM [ASCIZ /relocatable or external argument/] + POPJ P, +] +;READ A FIELD PART OF CURRENT WORD (FOR XWD, ETC). +XGETFD: PUSH P,PPRIME +AGTFD3: PUSHJ P,GETFLD + MOVE CH1,CDISP + TLNN CH1,DWRD + TLOA FF,FLUNRD ;DELIMITER IS WORD TERMINATOR => RE-READ IT. + TRNE I,IRFLD ;NON-NULL FIELD SUPPLIED => RETURN IT. + JRST AGTFD4 + HRRZ C,CDISP ;ELSE COMMA => RETURN NULL VALUE (0) + CAIN C,SPACE ;SPACE => TRY AGAIN TO READ A FIELD. + JRST AGTFD3 ;NO FIELD, TRY AGAIN +AGTFD4: REST PPRIME + POPJ P, + + ;IN RELOCATABLE FORMAT + ;READ FIELD AND COPY OUT AS WORD + +RGETFD: SETZM WRD ;FIRST INITIALIZE SOME STUFF AS THOUGH AT GETWD + SETZM WRDRLC + MOVE A,GLSPAS + MOVEM A,GLSP1 + MOVEM A,GLSP2 + CALL XGETFD + ADDM A,WRD + ADDM B,WRDRLC + PUSHJ P,PWRDA ;OUTPUT WORD + TLNE I,ILMWRD + JRST IGTXT ;SOAK UP MULTI-WORD FIELD + POPJ P, + +;READ IN A FIELD, RETURN IN A,B SETTING IRFLD IF FIELD NOT NULL. +GETFLD: PUSH P,GLSP1 ;REFERED TO AS GETFLB(P) WHEN ONLY 1 SYL PUSHED. + MOVEM P,PPRIME + TRZ I,IRFLD+IROP +GETFD1: TLNE I,ILMWRD + JRST GETFD9 ;MULTIPLE WORD, RE-CALL PSEUDO + PUSHJ P,GETSYL + TRNE I,IRLET +GETFD9: PUSHJ P,GETVAL ;GET OPERAND (MAYBE SKIPS) +GETFD6: SKIPA C,CDISP ;GET INFO ON SYLLABLE TERMINATOR + JRST GETFD1 ;GETVAL SKIPPED => PSEUDO/MACRO WITH NO VALUE, TRY AGAIN + TLNE C,DFLD + JRST (C) ;FIELD OPERATOR, GO PROCESS + TRNE I,IRSYL ;NO DISP MEANS FIELD TERMINATOR. + TRO I,IRFLD + CAME P,PPRIME ;IF ANY OPERATORS PUSHED, + JSP LINK,GETFD8 ;EVAL THEM. + SUB P,[1,,1] ;FLUSH GLSP1 SAVED AT GETFLD. + RET + +GETFD8: MOVEI TT, ;END OF FIELD HAS VERY LOW PRIORITY. + JRST GETFD7 + +;PUSH AN OPERATOR, MAYBE EVALLING STUFF TO LEFT. +;A HAS LEFT OPERAND (IF ANY), B RELOCATION BITS, +;C ADR OF ROUTINE TO PERFORM OPERATION, LH OF TT HAS PRECEDANCE OF OPERATOR + +GETFDL: MOVEI LINK,GETFD3 ;AFTER MAYBE EVALLING, GO PUSH OPERATOR. + TRO I,IRFLD+IROP + TRNN I,IRSYL + JRST GETFD5 ;UNARY, EVAL NOTHING, JUST PUSH WITH HIGH PRIO. +GETFD2: CAME P,PPRIME ;NO OPS TO LEFT => NOTHING TO EVAL. + CAMLE TT,GETFLP(P) ;COMPARE PRIO OF PREV. OP. AND CURRENT. + JRST (LINK) ;WAIT UNTIL LATER +GETFD7: HRRZ T,GETFLP(P) ;EVAL THE LAST OP ON STACK. + JRST (T) ;GO DO IT NOW (ROUTINE RETURNS TO GETFD4) +GETFD4: SUB P,[4,,4] + JRST GETFD2 + +GETFD5: MOVSI TT,200 ;GIVE UNARY OP HIGH PRIO. TO DO BEFORE NEXT BINARY. +GETFD3: PUSH P,B ;GETFLR(P) + PUSH P,A ;GETFLV(P) + HLL C,TT + PUSH P,C ;GETFLP(P) + PUSH P,GLSP1 ;GETFLG(P) + JRST GETFD1 + +GETFLB==,-4 ;PDL IDX OF GLSP1 BEFORE LEFT OPERAND. +GETFLR==,-3 ;PDL IDX OF RELOC OF LEFT OPERAND. +GETFLV==,-2 ;PDL IDX OF VALUE OF LEFT OPERAND. +GETFLP==,-1 ;PDL IDX OF PRIO,,DISPATCH +GETFLG==0 ;PDL IDX OF GLSP1 AFTER LEFT OPERAND (=BEFORE RIGHT) + +PLS: MOVEI C,PLS1 ;PLUS SIGN, PLS1 IS ROUTINE TO PERFORM OPERATION +MINUS2: MOVSI TT,10 ;SET UP PRECEDENCE OF 10 FOR +, - + JRST GETFDL + +MINUS: JSP C,MINUS2 ;MINUS SIGN + MOVNS A ;NEGATE VALUE OF RIGHT OPERAND + MOVNS B ;ALSO RELOCATION +;433 This instr was causing [foo] and [-foo] to be mistakenly +; constants-optimized to the same thing during pass1, resulting in a +; "more constants on pass2 than pass1" error. +; JUMPGE FF,PLS1 + MOVE T,GETFLG(P) + PUSH P,B + HRLZI B,MINF + PUSH P,C + PUSHJ P,LNKTZ ;COMPLEMENT THE MINUS FLAG ON GLOBALS IN RIGHT OPERAND + POP P,C + POP P,B +PLS1: ADD A,GETFLV(P) ;ADD VALUES + ADD B,GETFLR(P) ;ADD RELOCATIONS + JRST GETFD4 + +LNKTZ: TDZA C,C +LNKTC1: MOVE T,GLSP2 +LINKTC: CAML T,GLSP1 + POPJ P, + SKIPL 1(T) + XORM B,1(T) + SKIPL 1(T) + IORM C,1(T) + AOJA T,LINKTC + +MULTP: MOVEI C,MULTP1 ;ASTERISK, MULTP1 ROUTINE TO PERFORM MULTIPLICATION +DIVID2: MOVSI TT,20 ;20 PRECEDENCE OF MULTIPLICATION, DIVISION + JRST GETFDL + +MULTP1: SKIPL CONTRL ;ELSE IN DECREL ASSEMBLY, TEST FOR EXTERNALS. + JUMPGE FF,MULTR + MOVE D,GETFLB(P) ;ACTUALLY, GET HERE FOR ABS ASSEMBLIES TOO, BUT SO WHAT? + CAMN D,GLSP1 + JRST MULTR + SKIPGE FF + ETR [ASCIZ /Externals multiplied/] + TLO I,ILNOPT ;DON'T OPTIMIZE LITERALS CONTAINING UNDEFS ON PASS 1. +MULTR: JUMPE B,MULTP3 ;JUMP ON RIGHT OPERAND NOT RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;BOTH OPERANDS RELOCATED + MOVE T,GETFLV(P) ;GET VALUE OF LEFT OPERAND AND FALL IN + JRST MULTP5 + +MULTP3: MOVE T,A ;RIGHT OPERAND NOT RELOCATED, GET VALUE IN T + MOVE B,GETFLR(P) ;RELOCATION BITS OF LEFT OPERAND +MULTP5: MOVE D,GETFLG(P) ;GLOTB POINTER TO BETWEEN OPERANDS + CAME D,GETFLB(P) + JRST GMUL1 ;LEFT OPERAND HAS GLOBALS + CAME D,GLSP1 + JRST GMUL2 ;RIGHT OPERAND HAS GLOBALS + ;AT THIS POINT, T HAS VALUE OF ABS OPERAND, B RELOC BITS OF OTHER +GMUL4: IMUL A,GETFLV(P) ;MULTIPLY VALUES + IMULB B,T ;MULTIPLY RELOCATION OF ONE BY VALUE OF OTHER + TRZ T,1 + SKIPL CONTRL ;EXCEPT IN STINK ASSEMBLY, OBJECT TO RELOCATION + JRST GETFD4 ;OTHER THAN 0 OR 1 (ONLY AFFECTS DECREL, SINCE + JUMPE T,GETFD4 ;RELOCATION CAN'T BE NONZERO IN ABS ASSEMBLY). +MULTP4: ETR [ASCIZ+Relocatable arg to * or / or Boolean+] + JRST GETFD4 + +GMUL1: TLNE FF,FLPPSS ;LEFT OPERAND HAS GLOBALS, CHEK RIGHT OPERAND + CAMN D,GLSP1 + SKIPA CH1,A ;LOOKS OK, GET VALUE IN CH1 + ETR [ASCIZ /Multiplying two externals/] + SKIPA D,GETFLB(P) ;GET GLOTB POINTER TO BOTTOM OF LEFT OPERAND +GMUL2: MOVE CH1,GETFLV(P) ;GLOBALS IN RIGHT OPERAND ONLY, GET LEFT OPERAND +GMUL3: CAML D,GLSP1 + JRST GMUL4 ;TABLE COUNTED OUT + SKIPGE 1(D) + AOJA D,GMUL3 + JUMPE CH1,GMUL5 ;MULTIPLYING BY ZERO, CLEAR OUT GLOTB ENTRY AND LOOP BACK + LDB CH2,[221200,,1(D)] ;PICK UP MULTIPLICATION FIELD THIS GLOBAL + SKIPN CH2 + MOVEI CH2,1 ;0 => 1 + IMUL CH2,CH1 + CAIN CH2,1 + MOVEI CH2,0 ;IF ONE THEN USE ZERO + DPB CH2,[221200,,1(D)] + AOJA D,GMUL3 + + +GMUL5: CLEARM 1(D) + AOJA D,GMUL3 + +DIVID: JSP C,DIVID2 ;SLASH, PRECEDENCE = 20 +DIVID1: JUMPN B,MULTP4 ;JUMP IF RIGHT OPERAND RELOCATED + SKIPE GETFLR(P) + JRST MULTP4 ;LEFT OPERAND RELOCATED + EXCH A,GETFLV(P) + IDIV A,GETFLV(P) + MOVEI B,0 + MOVE D,GETFLB(P) + CAMN D,GLSP1 ;IF THERE ARE EXTERNALS OR UNDEFINED SYMBOLS, + JRST GETFD4 + SKIPGE FF ;ON PUNCHING PASS IT'S AN ERROR. + ETR [ASCIZ /Division involving externals/] + TLO I,ILNOPT ;ON PASS 1, DON'T OPTIMIZE THIS IF IN A LITERAL. + JRST GETFD4 + + ;LOGIC OPERATORS & (PREC = 40), # (PREC = 34), \ (PREC = 30) + +ANDF: MOVSI TT,40 ;& + JSP C,GETFDL + JSP D,LOGIC1 ;GO DO IT + AND A,GETFLV(P) ;INSTRUCTION ARGUMENT TO LOGIC1 + +XORF: MOVSI TT,34 ;# + TRNN I,IRSYL ;IF ABOUT TO BE UNARY, + MOVNI A,1 ;THEN TURN LEFT OPERAND INTO -1 + JSP C,GETFDL + JSP D,LOGIC1 + XOR A,GETFLV(P) + +IORF: MOVSI TT,30 ;\ + JSP C,GETFDL + JSP D,LOGIC1 + IOR A,GETFLV(P) + + ;COMMON EXECUTION ROUTINE FOR LOGICAL OPERATORS + +LOGIC1: JUMPN B,MULTP4 ;NO RELOCATION ALLOWED + SKIPE GETFLR(P) ;NOW CHECK RELOCATION OF LEFT OPERAND + JRST MULTP4 + XCT (D) ;ALL TESTS PASSED, DO IT + MOVE D,GETFLB(P) ;ARE THERE ANY GLOBALS OR UNDEFINED SYMBOLS? + CAMN D,GLSP1 + JRST GETFD4 ;NO. + SKIPGE FF ;YES. ON THE PUNCHING PASS, THAT'S AN ERROR. + ETR [ASCIZ /External in arg to \, & or #/] + TLO I,ILNOPT ;ON PASS 1, JUST DON'T OPTIMIZE IF IN LITERAL. + JRST GETFD4 + +CBAKAR: MOVSI TT,100 ;BACKARROW AS FIELD OPERATOR, PREC = 100 + JSP C,GETFDL ;RETURN TO GETFLD TO READ 2ND ARGUMENT. + JSP D,LOGIC1 ;FOR EVALUATION, CALL LOGIC1 + JSP D,.+1 ;WHICH EXECUTES THIS INSTRUCTION, + MOVE T,A ;TO CALL THIS SUBROUTINE. + MOVE A,GETFLV(P) + LSH A,(T) + JRST (D) + +;D SHOULD HAVE 1 FOR <, 2 FOR (, 3 FOR [ ;] +LSSTH9: JSP LINK,SAVAS1 ;SAVE ASSEM1 PDL LEVELS, .BYTE MODE, ETC. + MOVEM D,ASMOUT ;SAY WHAT KIND OF OPEN WE JUST DID + JRST ASSEM3 ;REENTER ASSEM1 LOOP AT INNER LEVEL. + +;COME HERE TO EXIT FROM AN ASSEM1 LEVEL THAT WAS ENTERED BY LSSTH9. +LSSTHA: SKIPE BYTM ;IN BYTE MODE, DO .WALGN. SINCE ASMDSP + JRST A.BY3 ;STILL POINTS HERE, WE'LL COME BACK. + MOVE P,CONSTP + JSP T,CONNDP ;POP STUFF SAVED BY SAVAS1 + MOVE A,WRD ;RETURN THE WORD IN THE GROUPING + MOVE B,WRDRLC ;(OUR CALLER WILL USVWLD, CLOBBERING WRD) + POPJ P, + +LSSTH: MOVEI D,1 ;1 FOR <. + JSP LINK,SAVWD1 + PUSHJ P,LSSTH9 +LSSTH3: JSP LINK,USVWLD ;POP OFF ALL BUTPREVIOUS SYLL. + +;GROUPINGS EXCEPT (PARENS THAT ADD TO WORD) +;SYLL IMMEDIATELY BEFORE OR AFTER IS ERROR. +LSSTH2: ADDM A,-1(P) ;SYLL BEFORE GROUPING, PUSHED BY SAVWD1. + ADDM B,(P) + TRNE I,IRSYL ;IF WAS SYLL BEFORE GROUPING, ERROR. + ETR ERRNOS +LSSTH5: MOVE A,LIMBO1 ;CHECK FOR FOLLOWING SYLL. + CAIE A,15 + CAIN A,12 + JRST LSSTH6 ;DELIMITER CR OR LF + PUSHJ P,RCH ;NOT CR OR LF, GET NEXT CHAR + CAIN A,"! ;IGNORE EXCLAMATION POINT + JRST .-2 + TLO FF,FLUNRD ;CAUSE IT TO BE RE-INPUT + HLRZ CH1,GDTAB(A) + CAIE CH1,(POPJ P,) + JRST LSSTH4 ;SQUOZE CHAR. MEANS FOLLOWING SYLL. + HRRZ CH1,GDTAB(A) + MOVE CH1,DTB-40(CH1) ;GET DISPATCH FOR CHAR. + TLNE CH1,DSY1 ;MIGHT START SYL => NOS ERROR. + JRST LSSTH4 +LSSTH7: PUSHJ P,GTSL1 +LSSTH6: TRO I,IRSYL + POP P,B + POP P,A ;VALUE OF GROUPING WAS ADDM'ED INTO THESE. + TLZE I,ILLSRT ?.SEE UA3 + RET ;IF CALLED BY ^ OR _ AS SYL OP, RETURN TO IT. + JRST GETFD6 + +LSSTH1: TLO I,ILWORD ;A NUMBER IN PARENS BY ITSELF IS A NONNULL WORD. + ADDM A,WRD + ADDM B,WRDRLC + TRNE I,IRSYL ;IF SYLL BEFORE, + JRST LSSTH5 ;ERROR IF SYL AFTER. + JRST LSSTH8 ;ELSE NO ERROR. + +LSSTH4: ETR ERRNOS ;FOLLOWING SYLL WHEN THAT IS ERROR. +LSSTH8: TLNE I,ILLSRT ?.SEE UA3 + JRST LSSTH6 + SUB P,[2,,2] + JRST GETFD1 + +ERRNOS: ASCIZ /Syllables not separated/ + +POP2J: SUB P,[2,,2] + POPJ P, + +LEFTP: MOVEI D,2 ;2 FOR ). + JSP LINK,SAVWD1 + MOVEI C,0 + TRNE I,IROP + TRNE I,IRSYL + TLO C,400000 ;CAUSE IT TO GET ADDED INTO WORD STEAD HAVE VALUE AS SYL + PUSH P,C + PUSHJ P,LSSTH9 + POP P,C + MOVSM A,T1 ;STORE SWAPPED VALUE + ADDI B,400000 ;NOW WANT TO SWAP RELOCATION, MAKE LH CORRECT + HLREM B,T2 ;STORE AS RH WITH SIGN EXTENDED + MOVSI B,400000(B) ;GET RIGHT HALF IN LEFT + ADDM B,T2 ;FINISH RELOCATION SWAP (THIS IS PAINLESS COMPARED TO THE HAIR EVERYWHERE + ;ELSE WHEN KEEPING THE HALFWORDS SEPARATE) + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + JSP LINK,USVWLD + MOVE A,T1 + MOVE B,T2 + JUMPL C,LSSTH1 ;ADD TO WHOLE WORD + JRST LSSTH2 + +;VERSION OF GETWRD FOR PSEUDO, +;PSEUDO MUST EITHER SAVE I, PPRIME AND GTVER OR RETURN TO ASSEM1. +;SYM SHOULD HOLD NAME OF PSUEUDO. + +AGETWD: MOVEM SYM,GTVER ;STORE NAME OF PSEUDO FOR UNDEF SYM MSGS. + TRO I,IRPSUD\IRDEF\IRNOEQ + PUSHJ P,GETWRD + MOVE SYM,GTVER ;RESTORE SYM. + TLNE I,ILMWRD + PUSHJ P,IGTXT ;SOAK UP MULTIPLE WORD + RET + +;;GETWD ;READ A WORD, LEAVE VALUE IN A AND WRD, RELOC IN WRDRLC AND B + +GETWRD: MOVE T,GLSP1 + MOVEM T,GLSP2 + CLEARM FORMAT ;CLEAR FORMAT, WILL ACCUMULATE FORMAT NUMBER BY IDPB + CLEARM WRD ;CLEAR WRD, WILL ACCUMULATE ABSOLUTE PART OF WORD + CLEARM WRDRLC ; " RELOCATION BITS, " + TDZ I,[ILWORD,,IRIOINS] + CLEARM FLDCNT ;NO FIELDS YET + MOVE T,[50100,,FORMAT] ;SET UP BIT POINTER TO FORMAT + MOVEM T,FORPNR +GTWD1: PUSHJ P,GETFLD ;READ NEXT FIELD +SPACE6: MOVEI T,1 ;SET T TO 1, AC FOR IDPB ON ROUTINE DISPATCHED TO + SKIPA C,CDISP +SPACE5: REST A + TLNE C,DWRD + JRST (C) ;NO DISPATCH MEANS WD TERMINATOR + MOVE C,GLSP1 + MOVEM C,LINKL ;MARK END OF ACTIVE PART OF GLOTB + TRNN I,IRFLD + JRST GETWD2 ;LAST FIELD NULL, MAYBE HAVE TO POP STUFF OFF + IDPB T,FORPNR ;MARK NON-NULL FIELD IN FORMAT +GTWD4A: TLO I,ILWORD ;NON-NULL WORD + MOVE TT,FORMAT + SKIPN TT,FORTAB-10(TT) ;PICK UP BYTE POINTER POSITION/SIZE FIELDS FOR FIELDS IN WORD + ETR [ASCIZ /Undefined format/] + MOVEM TT,FORMAT ;STORE IN FORMAT + MOVE T,[301400,,FORMAT] + MOVEM T,FORPNR + ;AT THIS POINT, FLDCNT HAS 1 LESS THAN # FIELDS; PUT FIELDS TOGETHER TO FORM WORD +GTWD3: LDB T,FORPNR + MOVE D,FLDCNT + CAIG D,2 + IBP FORPNR ;HAVEN'T BACKED UP TO THIRD FIELD YET, INCREMENT TO DESC FOR PREV + TRNE I,IRIOINS + PUSHJ P,INTIOW + PUSHJ P,INTFLD ;PUT FIELD WHERE IT BELONGS + SOSGE FLDCNT + JRST GTWD5 ;THIS WAS LAST (FIRST) FIELD + POP P,GLSP2 ;NOT YET, POP OFF MORE + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD3 + +GTWD5: MOVE A,WRD + MOVE B,WRDRLC + MOVE C,LINKL + MOVEM C,GLSP1 + TRZ I,IRIOINS + POPJ P, + +COMMA: TRNN I,IRFLD ;FIELD DELIMITER WAS COMMA (T HAS 1) + JRST COMMA1 ;NO FIELD + IDPB T,FORPNR ;MARK NON-NULL FIELD +COMMA4: IDPB T,FORPNR ;MARK FIELD TERMINATOR WAS COMMA + MOVE TT,FLDCNT + CAIL TT,2 + ETR [ASCIZ /Comma past the 3rd field of a word/] +PUSHFD: PUSH P,A ;DONE WITH THIS FIELD, NOW TO GET NEXT + PUSH P,B + PUSH P,GLSP1 + PUSH P,GLSP2 + AOS FLDCNT ;ANOTHER FIELD + MOVE TT,GLSP1 + MOVEM TT,GLSP2 + HRRZ T,FORPNR + CAIE T,FORMAT + HRRZS FORPNR ;STABILIZE FORPNR + TLO I,ILWORD ;SAY WE HAVE A NON-NULL WORD IN PROGRESS (LOC, ETC. ILLEGAL). + JRST GTWD1 + +GETWD2: SKIPN FORMAT ;LAST FIELD OF WORD IS NULL + JRST GTWD5 ;ENTIRE WORD NULL, MAYBE WERE PARENS. + SOS FLDCNT + POP P,GLSP2 + POP P,GLSP1 + POP P,B + POP P,A + JRST GTWD4A + +COMMA1: LDB TT,FORPNR ;COMMA TERMINATED NULL FOELD. + SKIPE FORMAT + JUMPE TT,COMMA2 ;NOT 1ST FIELD, JMP IF PREV WAS TERM BY SPACE. + IBP FORPNR ;ELSE MARK NULL FIELD IN FORMAT. + JRST COMMA4 + +;FIELD SPACE COMMA, PATHOLOGICAL CASE +;(EG MACRO STARTED WITH A COMMA) +COMMA2: DPB T,FORPNR ;REPLACE SPACE WITH COMMA. + JRST GTWD1 + + ;FIELD TERMINATOR IS SPACE (T HAS 1) + +SPACE: MOVE TT,LIMBO1 + CAIE TT,^I ;HEURISTIC: REAL SPACES ARE LIKELY TO BE FOLLOWED BY SQUOZE, + JRST SPACE4 ;WHILE TABS ARE LIKELY TO BE FOLLOWED BY COMMENTS. + PUSH P,A + MOVE TT,GDTAB+40 + PUSHJ P,RCH + CAMN TT,GDTAB(A) + JRST .-2 ;FLUSH OTHER LOGICAL SPACES + CAIN A,"; ;TAB WAS FOLLOWED BY SEMICOLON: + JRST [ PUSH P,B + TRZ I,IRSYL + CALL SEMIC ;FLUSH THE COMMENT + MOVEI T,1 + REST B + JRST SPACE5] ;AND HANDLE THE C.R. +SPACE3: POP P,A + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-READ NEXT TIME +SPACE4: TRNN I,IRFLD + JRST GTWD1 ;NO FIELD + IDPB T,FORPNR ;T HAS 1, MARK NON-NULL FIELD IN FORMAT + IBP FORPNR ;MARK FIELD TERMINATOR WAS SPACE + JRST PUSHFD + +;T HAS DESC BYTE, PUT FIELD IN ITS PLACE +;ALSO CALLED FROM PBYTE, MUSTN'T CLOBBER AA. + +INTFLD: MOVE TT,GLSP2 + CAMN TT,GLSP1 + JUMPE B,INTFD1 ;NO GLOBALS, JUMP IF NO RELOCATION + CAIN T,2222 ;LH + JRST INTL + CAIN T,22 ;RH + JRST INTR + CAIN T,44 ;WHOLE WORD + JRST INTW + SKIPE B + ETR [ASCIZ/Relocation attempted in irrelocatable field/] + ;(ASSUME) NO RELOCATION, CHECK FOR GLOBAL AC FIELDS + CAIN T,2704 ;HIGH AC + JRST INTACH + CAIN T,504 ;AC LOW + JRST INTACL + JUMPGE FF,INTFD1 ;JUMP ON NOT PUNCHING PASS + CAME TT,GLSP1 + ETR [ASCIZ/Global symbol in illegal field/] +INTFD1: MOVEI TT,C_12. + ROTC T,-12. ;SHIFT BYTE POINTER INTO TT + MOVEI C,0 ;INITIALIZE C TO RECEIVE FIELD IN PROPER PLACE + DPB A,TT + CAMN TT,[2200,,C] + JRST INTFD2 ;RIGHT HALF, DON'T ALLOW CARRY INTO LH + ADDM C,WRD ;ALLOW CARRY +INTFD3: ADDM B,WRDRLC ;ADD RELOCATIONS, WILL BE BROKEN BACK INTO HALF-WORDS LATER + POPJ P, + +INTFD2: ADD C,WRD ;ADD RIGHT HALVES + HRRM C,WRD + JRST INTFD3 + +INTIOW: CAIE T,2704 + CAIN T,504 + TRZA A,3 ;IO DEVICE FIELD + POPJ P, ;NOT "AC" FIELD + ADDI T,611-504 + POPJ P, + +INTR: HRRE D,B ;RH + MOVEI B,0 + PUSH P,T + HRLZI C,HFWDF + PUSHJ P,LNKTC1 ;THIS IS A BUG WHICH SHOULD BE FIXED SOMETIME +PRTCL: MOVE B,D ;GET BACK MAPPED RELOCATION BITS +PRTCL2: POP P,T +INTW: MOVE D,GLSP2 ;WHOLE WORD + HRLOI LINK,377777 + CAML D,GLSP1 + JRST INTFD1 + ANDM LINK,1(D) + AOJA D,.-3 + +INTL: HRLZ D,B ;LH + MOVSI B,SWAPF + MOVSI C,HFWDF + PUSH P,T + MOVE T,GLSP2 +INTL2: CAML T,GLSP1 + JRST PRTCL + SKIPGE 1(T) + AOJA T,INTL2 ;INDEX FIELD, ETC => LEAVE ALONE + IORM C,1(T) ;SET HFWDF + XORM B,1(T) ;COMPLEMENT SWAP STATUS + TDNN B,1(T) + SETZM 1(T) ;SWAPPED TO RH, FLUSH IT + AOJA T,INTL2 + +INTACL: TDZA B,B ;AC LOW +INTACH: HRLZI B,SWAPF ;AC HIGH + HRLZI C,ACF + PUSH P,T + PUSHJ P,LNKTC1 + MOVEI B,0 + JRST PRTCL2 + +IOINST: HLLZ A,B ;IO INSTRUCTION, GET WHICH ONE INTO A + SKIPN FLDCNT ;THIS FIRST FIELD OF WORD? + TRO I,IRIOINS ;YES + JRST CLBPOP ;RETURN VALUE + +;TOP LEVEL LOOP, ASSEMBLE STORAGE WORDS +;LOTS OF PSEUDOS MEANINGLESS IN STORAGE WORDS +;(E.G. BLOCK, CONSTA) DO JRST ASSEM1 WHEN DONE +;THERE'S ALSO AN ERROR UUO WHICH RETURNS TO ASSEM1 + +ASSEM1: MOVE P,ASSEMP + JRST @ASMDSP + +;COME HERE TO START THE NEXT EXPRESSION OR WHATEVER. +ASSEM3: PUSHJ P,RCH + CAIN A,^I + JRST ASSEM2 ;PROBABLY NOT PROFITABLE TO SKIP AFTER SEE A TAB. + CAIG A,40 + JRST ASSEM3 ;FLUSH LEADING GARBAGE + TLO FF,FLUNRD ;CAUSE NON-GARBAGE CHAR FOUND TO BE RE-INPUT +;ASMDSP POINTS HERE WITHIN ASCII, SIXBIT ETC. +ASSEM2: TRZ I,IRFLD+IRSYL+IRLET+IRPSUD+IRCOM+IRCONT+IRGMNS+IROP+IRNOEQ+IREQL + TLZ I,ILGLI+ILVAR+ILFLO+ILDECP+ILUARI+ILWORD+ILNPRC+ILNOPT + IOR I,ASMI ;SET DEF AND RESTORE PSEUDF. + MOVE A,GLSPAS + SKIPL BYTM + MOVEM A,GLSP1 + ;GETWRD WILL COPY GLSP1 INTO GLSP2 +IFN TS,[AOSN TTYBRF ;DO A ^H-BREAK IF REQUESTED. + CALL TTYBRK] + PUSHJ P,GETWRD + TLZN I,ILWORD + JRST @ASMDSP ;NO WORD ASSEMBLED,TRY AGAIN + SKIPGE BYTM + JRST PBYTE ;IN BYTE MODE, OUTPUT BYTE INSTEAD OF WORD, A,B MUST HAVE WRD,WRDRLC. + MOVE AA,ASMOUT ;OUTPUT WD AS APPRO. FOR GROUPING, IF ANY. + JRST @ASMOT0(AA) + +ASSEM6: SKIPE STGSW ;ASMOT0 POINS HERE. COME IF NOT IN GROUPING. + ETR ERRSWD ;STORAGE WORD ASSEMBLED + PUSHJ P,PWRD ;OUTPUT THE WORD. + AOS CLOC + HRRZS CLOC ;INCREM. POINT . + JRST @ASMDSP ;ASSEM3 OR ASSEM2 + +ERRSWD: ASCIZ /Storage word assembled/ + +ASSEM4: JSP T,PCONST ;ASMOT0+3 POINTS HERE. COME IF IN CONSTANT. + JRST @ASMDSP + +;ASMDSP POINTS HERE WITHIN GROUPING IF NOT IN MULTI-LINE MODE +;[ ;AND NO CLOSE (">)]") HAS BEEN SEEN. +ASSEMC: MOVE AA,ASMOUT + SKIPE CONSML ;IN ERROR MODE, GIVE APPROPRIATE ERROR MSG. + XCT ASMOT3(AA) + JRST @ASMOT2(AA) ;CLOSE WHATEVER TYPE GRPING WE'RE IN. + +;JUMP THRU THIS TABLE TO OUTPUT A WORD. +ASMOT0: ASSEM6? ASSEM1? ASSEM1? ASSEM4? [GOHALT ] + +;THIS TABLE GIVES APPRO. CLOSE FOR EACH TYPE OF GROUPING. ;[ +ASMOT1: "? ? "> ? ") ? "] ? "? + +;THIS TABLE SAYS WHERE TO GO TO END THE GROUPING. +ASMOT2: [GOHALT ]? LSSTHA? LSSTHA? CONND? [HALT ] + +;APPROPRIATE ERROR MESSAGE FOR MISSING CLOSE OF GROUPING. [ +ASMOT3: GOHALT + ETR [ASCIZ /Missing >/] + ETR [ASCIZ /Missing )/] + ETR [ASCIZ /Missing ]/] + GOHALT + +;THIS TABLE TELLS PBYTE HOW TO HANDLE BYTE MODE. +ASMOT4: PBY4 ? PBY5 ? PBY5 ? PBY3 ? [GOHALT ] + +;TABLE SAYING WHAT CHAR MUST HAVE OPENED THE GROUPING. +ASMOT5: "? ? "< ? "( ? "[ ? "? ;] + +;;GETVAL ;GET VALUE OF SYM + ;SKIPS ON PSEUDO NOT RETURNING VALUE (E.G. MACRO STARTING TO BE EXPANDED) + ;ELSE RETURNS VALUE IN A, RELOCATION BITS IN B + +VBLK +GTVER: 0 ;SQUOZE NAME OF CALLING PSEUDO, OR POINTER + ;TO INSN TO EXECUTE WHEN IF SYM IS UNDEF. +PBLK + +GETVAL: PUSHJ P,ES + JRST GVNF ;NO STE. +IFN CREFSW,XCT CRFINU ;JFCL OR CALL TO CREF RTN. + JRST @.+1(A) ;FOUND, DISPATCH ON SQUOZE FLAGS + +GVTAB: GVCOM ;COMMON (UNUSED) + GVPSEU ;PSEUDO OR MACRO. + GVSYM ;LOCAL SYMBOL. + GVUL ;LOCAL UNDEF (MAYBE STINK KNOWS VALUE) + GVDLV ;DEFINED LOCAL VAR. + GVULV ;UNDEF LOC VAR. + GVDGV ;DEF GLO VAR + GVUGV ;UNDEF GLO VAR + GVDG ;DEF GLOBAL + GVUG ;UNDEF GLOBAL + +;DEF LOCAL VAR. +GVDLV: PUSHJ P,GVDLGV ;IF PASS2 AND HAS ' THIS TIME, SET 3VAS2 FOR AVARIAB + TLZN I,ILGLI + JRST GVDLV2 + MOVSI T,DEFGVR ;NOW DEF GLO VAR. + PUSHJ P,VSM2 + JRST GVDG1 ;MAYBE OUTPUT GLOBAL DEF. TO STINK. + +GVDGV: PUSHJ P,GVDLGV ;DEF GLO VAR; IF PASS 2 AND ' THIS TIME, SET 3VAS2 + JRST GVDG2 ;MUSN'T PUNCH VALUE, AVARIAB WILL. + +GVDLGV: TRNE FF,FRPSS2 ;IF PASS 2 + TLNN I,ILVAR ;AND THIS TIME HAVE SINGLEQUOTE + POPJ P, + TLO C,3VAS2 ;TELL AVARIAB SEEN IN PASS 2 WITH '. + 3PUT C,D + POPJ P, + +GVULV: TLZN I,ILGLI ;UNDEF LOCAL VAR, MAYBE MAKE GLOBAL. + JRST GVUNDF + PUSHJ P,PLOGLO ;IF SO, TELL STINK SYM IS GLOBAL, + MOVSI T,UDEFGV ;SYM NOW UNDEF GLO VAR + PUSHJ P,VSM2 + JRST GVUNDF ;IN EITHER CASE, HANDLE UNDEF SYM. + +GVUL: TLZE C,3MACOK ;UNDEF LOCAL, PRESUMED NUMERIC + 3PUT C,D ;DON'T LET IT BECOME MACRO AND SCREW PASS2. + TLNE C,3LLV + JRST GVGLTB ;(REALLY DEFINED BUT ONLY STINK KNOWS HOW) + TLNE I,ILGLI ;IF MAKING GLOBAL, TELL STINK. + PUSHJ P,PLOGLO +GVNF1: TLZE I,ILVAR ;IF ', MAKE VAR (WILL CHECK ILGLI) + JRST GVUL1 + TLZN I,ILGLI ;NOT MAKING VAR, MAYBE GLOBAL? + JRST GVUNDF ;NO, MAYBE ERROR, MAKE GLOTB ENTRY. + MOVSI T,GLOEXT + PUSHJ P,VSM2 ;NOW GLOBAL UNDEF, + JRST GVGLTB ;NO ERROR, JUST GLOTB ENTRY. + +GVUL1: TLZN I,ILGLI ;UNDEF LOCAL BECOMES + SKIPA T,[UDEFLV,,] ;UNDEF LOC VAR OR +GVGVAR: MOVSI T,UDEFGV ;UNDEF GLO VAR. +GVVAR: CALL ESDEF ;DEFINING SYM AS A VAR => INSIST ON DEFINING LOCAL TO INNERMOST BLOCK. + JFCL + AOS VARCNT + HRR B,VARCNT + PUSHJ P,VSM2 ;MAKE IT A VAR, + JRST GVUNDF ;PRETEND HAD ALREADY BEEN A VAR. + +GVUG: TLZE I,ILVAR ;UNDEF GLOBAL: MAYBE MAKE UNDEF GLO VAR. + JRST GVGVAR +GVGLTB: SKIPGE CONTRL ;UNDEF GLO IN ABS ASSEM => + JRST GVUND1 ;MAYBE TREAT AS UNDEF. +GVGLT1: AOS GLSP1 ;DON'T KNOW SYM'S VALUE, MAKE GLOTB ENTRY. + MOVEI T,ST(D) + HRRZM T,@GLSP1 + JRST CABPOP ;RETURN 0 AS VALUE. + +GVNF: +IFN CREFSW,XCT CRFINU ;ONLY IF NOT FOUND WOULD NOT CREF AFTER ES. + TLNE I,ILVAR+ILGLI ;MAKING VAR OR GLOBAL FORCED CURRENTBLOCK ALREADY + JRST GVNF1 ;AND WILL STORE NAME IN STE ANYWAY. + SKIPGE ESBK ;ELSE IF NO SPEC'D BLOCK, + TRNN FF,FRNPSS ;FORCE .MAIN BLOCK SO DON'T GET LOTS OF UNDEF ENTRIES. + CAIA ;BUT CAN'T DO THAT FOR 1PASS OR WOULD MISS FWD REFS. + HRRI C,BKWPB + MOVSI T,LCUDF + PUSHJ P,VSM2 + JRST GVUNDF ;MAYBE ERROR, MAKE GLOTB ENTRY. + +GVCOM: TRO I,IRCOM ;COMMON: SAY THIS WAS ONE. + HRRZ A,B ;RETURN RH OF VALUE, ABSOLUTE. + JRST CLBPOP + +GVPSEU: TLNN I,ILVAR+ILGLI ;CAN'T MAKE PSEUD OR MACRO GLOBAL OR VAR. + JRST (B) ;OTHERWISE, DISPATCH TO IT. + TLZE I,ILVAR + ETSM ERRCBV + TLZE I,ILGLI + ETSM ERRCBG + JRST (B) ;DISPATCH TO PSEUDO (OR MACCL IF MACRO) + ;EXPECTS LH OF VALUE IN LH OF B. + +ERRCBV: ASCIZ /Can't be a variable/ +ERRCBG: ASCIZ /Can't be global/ + +GTVL7B: TLNE C,3RLL ;R(LH) + TLO SYM,200000 + TLNE C,3RLR ;R(RH) + TLO SYM,100000 + POPJ P, + +GVSYM: TLNN C,3REL + TLNE I,ILVAR\ILGLI + JRST GVSYM2 + MOVE A,B ;THIS CODE DOES WHAT GVSYM2 WOULD DO, BUT FASTER. + SETZ B, + RET + +GVSYM2: TLZE I,ILVAR ;LOCAL SYM: CAN'T MAKE VARIABLE. + ETSM ERRMDV + TLZN I,ILGLI + JRST GVSYM0 ;NOT MAKING GLOBAL, GET VALUE & RETURN. +GVSYM1: MOVSI T,GLOETY ;BECOMES DEF. GLOBAL. + PUSHJ P,VSM2 + JRST GVDG1 ;HANDLE AS IF WAS DEF GLOBAL. + +ERRMDV: ASCIZ /Multiply-defined variable/ + +GVDG: TLZE I,ILVAR ;GLOBAL ENTRY + ETSM ERRMDV +;COME HERE FOR DEF GLOBAL +GVDG1: SKIPGE CONTRL + JRST GVDLV2 ;DON'T PUNCH VALUE IF ABSOLUTE. + TLNE C,3VP + JRST GVDG2 ;VALUE PUNCHED ALREADY, NOT AGAIN. + JUMPGE FF,GVDG2 + TLNN C,3LLV + TRNE I,IRPSUD+IREQL + JRST GVDG2 + TLO SYM,40000 + PUSH P,WRD + PUSHJ P,OUTDE2 + POP P,WRD +GVDG2: TRNN I,IRPSUD\IREQL ;IF INSIDE AN ORDINARY STORAGE WORD, + TLNN C,3REL ;GENERATE A GLOBAL REF IF GLOBAL IS RELOCATABLE (HEURISTIC). +GVDLV2: TLNE C,3LLV ;IF VAL KNOWN ONLY BY STINK, MUST MAKE A GLOBAL REF. + JRST GVGLTB +GVSYM0: MOVE A,B ;USED IN LBRAK + LDB B,[.BP (3RLR),C] + TLNE C,3RLL + TLO B,1 + POPJ P, + +GVUND1: MOVE A,CONTRL + TRNE A,DECREL+FASL ;DEC FMT OR FASL => UNDEF GLOBALS OK. + JRST GVGLT1 +GVUGV: +GVUNDF: TRZ I,IRDEF ;UNDEFINED, MAYBE ERROR, MAKE GLOTB ENTRY. + TRNE I,IRPSUD\IREQL + JRST GVUND2 ;PSEUDO + TRNN FF,FRPSS2 + JRST GVGLT1 ;PASS 1 + SKIPN CONDEP + ETSM [ASCIZ/Undefined/] + SKIPE CONDEP + ETSM [ASCIZ/Undefined in literal/] + JRST CABPOP + +GVUND2: HLRZ A,GTVER ;DOES GTVER POINT TO AN INSN? + JUMPE A,[XCT @GTVER ? JRST CABPOP] + ERJ .+1 ;NO, IT IS NAME OF PSEUDO. + MOVE A,LINEL + CAIGE A,75. ;CR-LF-TAB NOW IF WHOLE MSG WON'T FIT ON A LINE. + CALL CRRTBX + TYPE2 SYM ;TYPE NAME OF UNDEF SYM. + TYPR [ASCIZ/ Undefined in /] + TYPE2 GTVER + CALL CRRERR + JRST CABPOP + +;EVALUATE SYMBOL, SQUOZE (FLAGS OFF) IN SYM +;IDX OF BLOCK TO DEFINE IN IN ESBK (OR -1 => ANY BLOCK NOW IN PROGRESS). +;DOESN'T CLOBBER F (FOR WRQOTE) +;RETURNS SKIPPING IF SYM FOUND, WITH SQUOZE FLAGS IN BOTTOM OF A, +;VALUE OF SYM IN B, STE IDX IN D, AND 3RDWD IN C. +;IF NOT FOUND, RETURNS IN D THE IDX OF A PLACE TO DEFINE SYM. +;CALL ESDCHK TO GET THE FOLLOWING EXTRA INFO (WHETHER SYM FOUND OR NOT): +;ESLAST -> LAST STE WITH DESIRED NAME SEEN, REGARDLESS OF WHAT BLOCK IT'S IN +;ESL1 HAS LEVEL OF BLOCK OF BEST STE SEEN, -1 IF NOT FOUND +;ESL2 HAS 3RDWRD OF BEST. +;ESXPUN HAS -1 OR IDX OF A STE WHICH MIGHT BE USED TO DEFINE THE SYM. +;RH(TM) GETS BLOCK IDX TO DEFINE IN IF DEFINE THE SYM. +;TT HAS -<# STE NOT LOOKED AT YET> +;THEN IF SYM IS FOUND IN A CONTAINING BLOCK AND YOU WANT TO DEFINE +;IT IN THE CURRENT BLOCK, YOU CAN CALL DEFCHK TO FIND AN STE TO DO IT IN. +;CALLING ESDEF IS AS GOOD AS CALLING ESDCHK AND DEFCHK, BUT DOESN'T +;LET YOU SEE WHAT YOU ARE GOING TO SHADOW. + +ESDEF: MOVE A,BKCUR ;EVAL SYM IN ORDER TO DEFINE IT: + SKIPGE ESBK ;IF NO SPEC'D BLOCK, SPEC THE CURRENT BLOCK, + MOVEM A,ESBK ;SO DEFS IN CONTAINING BLOCKS WON'T BE SEEN + +ESDCHK: SETOM ESLAST ;CALL HERE IF WE MIGHT END UP CALLING DEFCHK, + SETOM ESL1 ;SINCE IN THAT CASE WE'LL NEED THESE VARS EVEN IF SYM IS FOUND + SETOM ESXPUN ;RIGHT AWAY. + MOVN TT,SYMLEN +ES: MOVE C,SYM ;HASH AWAY + TSC C,SYM ;THIS MAKES SURE THAT THE FIRST FEW CHARS OF SYMBOL DON'T GIVE + ;A ZERO REMAINDER, IF SYMLEN IS A ROUND NUMBER. + MOVMS C ;THIS IS BECAUSE IDIV OF NEGATIVE NUMBER GIVES NEG. REMAINDER. + IDIV C,SYMLEN + IMUL D,WPSTE + SKIPGE TM,ESBK ;GET BKTAB IDX OF SPEC'D BLOCK + HRR TM,BKCUR ;OR -1,,BKTAB IDX OF CURRENT BLOCK. +;NOW CHECK FAST FOR AN IMMEDIATE MATCH - AVOID SETTING UP FLAGS NEEDED ONLY WHEN +;SYM APPEARS IN MULTIPLE BLOCKS OR ISN'T DEFINED. + SKIPN B,ST(D) + JRST ESEND0 ;SYM IS KNOWN NOT TO BE DEFINED. + TLZ B,740000 + CAME B,SYM + JRST ESBAD0 ;NOT FOUND IN 1ST ENTRY - MUST SET UP INFO AND LOOP + 3GET C,D + MOVEI A,(C) + CAIN A,(TM) + JRST ESGOOD ;IN THE DESIRED BLOCK => GOOD. + TDNN C,[3MAS,,-1] ;IN THE INITIAL SYMS BLOCK, NOT PRESENT IN ANY OTHER, + JUMPL TM,ESGOOD ;AND BLOCK WASN'T EXPLICITLY SPEC'D => GOOD. + MOVN TT,SYMLEN ;ELSE MUST KEEP LOOKING TO SEE IF THIS DEF IS REALLY ONE WE WANT. + SETOM ESLAST + SETOM ESL1 + SETOM ESXPUN + JUMPGE TM,ESIGN + JRST ESLP1 + +;LOOK AT THE NEXT STE, WHILE LOOPING. +ESLP: SKIPN B,ST(D) ;GET SQUOZE IN THIS ST SLOT + JRST ESEND ;NOTHING WHERE SYM BELONGS, END SEARCH + TLZ B,740000 ;CLEAR OUT FLAGS + CAME B,SYM ;COMPARE WITH WANTED + JRST ESBAD ;NO MATCH BUT MAYBE KEEP GOING + 3GET C,D ;FOUND SYM, GET 3RDWRD + MOVEI A,(C) + CAIN A,(TM) ;DEFINED IN DESIRED BLOCK + JRST ESGOOD ; => MUST BE GOOD. +ESLP0: JUMPGE TM,ESIGN ;BLOCK SPEC'D => ALLOW NO OTHERS. + TDNE C,[3MAS,,-1] ;IF IN INITIAL SYMS BLK, NO MORE DEFS, + JRST ESLP1 + SKIPGE ESL1 ;AND NO PREVIOUS DEFS, + JRST ESGOOD ;UNREDEFINED INITL SYM MUST BE GOOD. +ESLP1: HLRZ B,BKTAB+1(C) ;GET LEVEL OF BLOCK DEF. IS IN. + CAMN A,BKPDL(B) ;SAME AS BLOCK WE'RE IN AT THAT LEVEL? + CAMLE B,BKLVL ;AND NOT A BLOCK WE'VE EXITED + JRST ESIGN + CAMG B,ESL1 ;OR HIGHER LEVEL THAN PREVIOUS BEST + JRST ESIGN + MOVEM C,ESL2 ;REPLACE BEST'S 3RDWRD, LEVEL, ADDR. + MOVEM B,ESL1 + MOVEM D,SADR +ESIGN: HRRZM D,ESLAST ;THIS ENTRY LAST SEEN WITH THIS NAME. + TLNN C,3MAS ;MORE STE'S FOR THIS SYM => + JRST ESEND1 + JRST ESNXT ;KEEP LOOKING. + +;COME HERE IF 1ST SYM SEEN ISN'T THE SAME NAME. SET UP TO LOOP. +ESBAD0: MOVN TT,SYMLEN + SETOM ESLAST + SETOM ESL1 + SETOB C,ESXPUN +;HERE WHILE LOOPING WHEN SYM WITH WRONG NAME IS SEEN. +ESBAD: JUMPN B,ESNXT + SKIPGE A,ESXPUN ;IF THIS IS 1ST EXPUNGED ENTRY SEEN + MOVEM D,ESXPUN ;REMEMBER IT FOR DEFINITION. + SKIPGE A + HRROS ESLAST ;AND SET OLD ENTRY'S 3MAS. +ESNXT: ADD D,WPSTE + CAML D,SYMSIZ ;AT END => GO TO BEGINNING + MOVEI D,0 + AOJN TT,ESLP + JRST ESEND1 ;NOT FOUND. + +ESEND0: MOVEI C,(TM) ;COME HERE IF 1ST PLACE LOOKED AT SHOWS THE SYM ISN'T DEFINED + MOVEM D,ESXPUN + POPJ P, + +ESEND: SKIPGE A,ESXPUN ;FREE ENTRY CAN BE USED TO DEFINE. + MOVEM D,ESXPUN + SKIPGE A + HRROS ESLAST +ESEND1: SKIPGE ESL1 ;NOT FOUND => FIND PLACE TO DEFINE IT. + JRST DEFCH1 + MOVE D,SADR ;IDX OF BEST FOUND. + TRNN FF,FRNPSS + JRST ES1PS ;1-PASS, SPECIAL CHECK. + MOVE C,ESL2 ;GET BEST'S 3RDWRD. +ESGOOD: LDB A,[400400,,ST(D)] ;GET SQUOZE FLAGS IN A. +ES1POK: MOVE B,ST+1(D) ;VALUE OF SYM. IN B. + ;D HAS IDX OF 1STWRD IN SYM TAB. + ;C HAS 3RDWRD +POPJ1: AOS (P) +APOPJ: +CPOPJ: POPJ P, + +;ESDCHK THEN DEFCHK IS SAME AS CALLING ESDEF. +;WE ASSUME THAT D AND TT ARE STILL SET UP FROM A CALL TO ESDCHK. +DEFCHK: SKIPGE ESL1 ;IF WE DIDN'T TAKE TIME TO SET ESLAST BEFORE, + HRRZM D,ESLAST ;DO IT NOW. (SEE BEFORE ESLP1) + JRST DEFCH1 + +ES1PS: LDB A,[400400,,ST(D)] ;1PASS & FOUND IN CONTAINING BLOCK: + MOVE C,ESL2 + TRNN C,-1 ;INITIAL SYM, OK; + JRST ES1POK + CAIE A,1 ;PSEUDO OR MACRO + TLNE C,3DOWN ;OR .DOWN'D SYMBOL OK; + JRST ES1POK ;ELSE GET NEW STE TO DEF. +DEFCH1: MOVEI C,(TM) ;INITIALIZE NEW 3RDWRD WITH BLOCK TO DEF IN. + SKIPL D,ESXPUN ;IF FOUND EXPUNGED OR FREE ENTRY, USE IT. + JRST DEFCH2 + SKIPGE D,ESLAST ;ELSE LOOK FOR ONE. + ETF ERRSCE +DEFCH4: MOVE B,ST(D) + TLZ B,740000 + JUMPE B,DEFCH3 ;MUST RETURN 0 IN B IF DON'T SKIP. + ADD D,WPSTE + CAML D,SYMSIZ + MOVEI D,0 + AOJL TT,DEFCH4 ;ASSUME TT LEFT AROUND FROM ES. + ETF ERRSCE +ERRSCE: ASCIZ /Symbol table full/ + +;ESLAST HAS -1 IF NO ENTRY SEEN; ELSE +;RH HAS IDX OF LAST SEEN, SIGN SET IF SEEN BEFORE PLACE TO DEFINE. +DEFCH3: MOVEM D,ESXPUN ;REMEMBER ADDR WHERE CAN DEFINE + HRROS ESLAST ;LAST PLACE SEEN MUST BE EARLIER. +DEFCH2: SKIPL A,ESLAST + JRST DEFCH5 ;LAST PLACE SEEN WAS SEEN AFTER PLACE TO DEFINE. + CAMN A,[-1] + POPJ P, ;REALLY NEVER SEEN. + MOVSI TM,3MAS + IORM TM,ST+2(A) ;PLACE SEEN IS EARLIER, SET ITS 3MAS. + POPJ P, + +DEFCH5: TLO C,3MAS ;PLACE TO DEF BEFORE EXISTING STES. + POPJ P, + +;ENTER A SYM IN SYMBOL TABLE + ;B HAS VALUE + ;C HAS 3RDWRD + ;D HAS INDEX INTO ST (PROBABLY SET UP BY ES) + ;T HAS SQUOZE FLAGS (ONLY) IN PLACE FOR IOR OF SQUOZE + ;SYM HAS SQUOZE, FLAGS OF WHICH ARE IGNORED + +VSM2LV: TLOA C,3LLV ;ENTRY FOR LINKING LOADER MUST SUPPLY VALUE +VSM2W: MOVE B,WRD ;ENTRY TO ENTER VALUE OF WRD STEAD B +VSM2: MOVE CH1,SYM + TLZ CH1,740000 + IOR CH1,T ;CH1 := SQUOZE WITH FLAGS + MOVEM CH1,ST(D) ;STORE SQUOZE + MOVEM B,ST+1(D) ;STORE VALUE +VSM3A: 3PUT C,D ;STORE 3RDWRD + POPJ P, + +;RETURN THE NUMBER OF SYMTAB SLOTS IN USE. +A.SYMCN:SKIPL A,SMSRTF ;IF SYMTAB HAS BEEN COMPACTED, GET # OF SYMS THAT IT HAD + JRST CLBPOP ;BEFORE COMPACTION AND RETURN THAT. + MOVE D,SYMAOB + SETZ A, +A.SYC1: MOVE B,ST(D) + TLZ B,740000 + SKIPE B + AOS A + ADD D,WPSTE1 + AOBJN D,A.SYC1 + JRST CLBPOP + +;;EQUAL ;EQUAL SIGN ENCOUNTERED, DO PARAMETER ASSIGNMENT + +EQUAL: TLZ FF,FLHKIL + PUSHJ P,RCH + CAIE A,"= ;DECIDE WHETHER TO HALF-KILL THE SYM. + TLOA FF,FLUNRD + TLO FF,FLHKIL + SETZM LABELF + CALL RCH + CAIE A,": ;DECIDE WHETHER TO MARK SYM AS NOT REDEFINABLE. + TLOA FF,FLUNRD + SETOM LABELF + CAMN SYM,[SQUOZE 0,.] ;.=FOO, SAME AS LOC FOO + JRST PTEQ + TDNN I,[ILWORD,,IROP+IRNOEQ] + TRNN I,IRLET + ETR [ASCIZ/= With bad format or bad context/] + PUSH P,LABELF + PUSH P,SYM + PUSH P,ESBK + PUSH P,I + MOVEI A,[ETSM [ASCIZ/Undefined in =/]] + MOVEM A,GTVER + TRO I,IRNOEQ+IRDEF+IREQL + PUSHJ P,GETWRD + TRNN I,IRDEF + JRST ASEM1A ;UNDEFINED SYMS IN VALUE, IGNORE +IFN LISTSW,[ + SKIPN LSTONP + JRST EQUAL1 ;NOT LISTING. + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE SYM,WRD + MOVEM SYM,LISTWD + MOVE SYM,WRDRLC + MOVEM SYM,LSTRLC + SETOM LISTAD + SETOM LISTPF +EQUAL1: +] ;END IFN LISTSW, + TDZ I,[-1-(ILMWRD)] + IOR I,(P) + TLZ FF,FLUNRD + POP P,(P) + POP P,ESBK + POP P,SYM + POP P,LABELF + MOVE A,WRDRLC ;GET RELOCATION + TDNN A,[-2,,-2] ;SKIP ON NON-STANDARD RELOCATION BITS + SKIPE LDCCC + JRST EQG1 ;STRANGE RELOCATION OR IN LOAD TIME CONDITIONALS => HAND PROBLEM TO LOADER + MOVE A,GLSP1 + CAMN A,GLSP2 + JRST EQL1 ;NO GLOBALS IN DEFINITION +;FALLS THROUGH. + +;FALLS THROUGH. +;GLOBALS TO RIGHT OF = OR WITHIN LOADER CONDIT. +EQG1: IFN CREFSW, XCT CRFLBL ;CREF DEF. OF NORMAL SYM, + SKIPGE CONTRL + JUMPL FF,[ETASM [ASCIZ /Externals in =/]] + CALL ESDCHK ;SEARCH SYM TAB. + JRST EQL2 ;NOT FOUND IN CURRENT OR CONTAINING BLKS. + HRRZI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQG1A + XCT EQG1TB(A) ;FOUND IN DESIRED BLOCK. + JRST ASSEM1 + +EQG1A: JUMPN T,EQG2 + CAIN A,PSUDO_-16 ;FOUND AS INITIAL PSEUDO => ERROR. + ETSM ERRQPA +EQG2: CALL DEFCHK ;FIND FREE STE TO DEFINE IN DESIRED BLOCK. + JRST EQL2 ;PRETEND WASN'T FOUND. + +ERRQPA: ASCIZ /Shadowing a pseudo-op/ +ERRIPA: ASCIZ /Illegal =/ + +EQG1TB: ETSM ERRIPA ;COMMON + ETSM ERRIPA ;PSEUDO OR MACRO + JRST EQL2 ;SYM + JRST EQGUL ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL7 ;GLO ENTRY + JRST EQL8 ;GLO EXIT + +EQL8: PUSHJ P,GLKPNR + TLZ C,3LABEL\3MULTI +EQL7: MOVSI T,GLOETY ;GLOBAL PARA ASSIGN + MOVEI B,0 + TLO SYM,40000 +LOPRA1: PUSH P,CASM1A ;RETURN TO ASSEM1A AFTER FOLLOWING. + TLNE C,3MULTI + ETSM ERRMDT + SKIPE LABELF + TLO C,3LABEL + TLNE FF,FLHKIL + TLOA SYM,400000 ;SET FLAG TO HALF-KILL SYM + TLZA C,3SKILL + TLO C,3SKILL ;SET CORRESPONDING FLAG IN 3RDWRD + PUSHJ P,VSM2LV + JUMPGE FF,CPOPJ ;JUMP ON NOT PUNCHING PASS + TRNN I,IREQL ;IF CAME FROM COLON ROUTINE, + JRST PDEFPT ;PUNCH "DEFINE SYM AS $.". + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D ;STORE UPDATED 3RDWRD + PUSHJ P,EBLK + MOVEI TT,LGPA + DPB TT,[310700,,BKBUF] + PUSHJ P,OUTSM0 + PUSHJ P,PWRDA + JRST EBLK + +EQGUL: PUSHJ P,LKPNRO ;LOCAL UNDEF, OUTPUT LINK REQUEST. + TLZ C,3LABEL\3MULTI ;CAN'T DETECT MDT'S WHEN ONLY STINK KNOWS FOR SURE. +EQL2: TLNE I,ILGLI + JRST EQL7 ;MAKE IT GLOBAL + MOVSI T,LCUDF ;LOCAL UNDEFINED + JRST LOPRA1 + +CASM1A: JRST ASEM1A + +;MAYBE PUNCH OUT LINK REQUEST +;SYM HAS NAME OF SYM TO REQUEST, D STE IDX OF SYM, C 3RDWRD, B ADR OF REQUEST +;REQUEST WILL BE PUNCHED IF 3RLNK SET IN C OR IF ANYTHING SET IN LH(B) + +GLKPNR: TLO SYM,40000 ;GLO BIT +LKPNRO: TLNN C,3RLNK + TLNE B,-1 + TROA I,IRCONT + POPJ P, ;DON'T PUNCH REQUEST + MOVE A,CONTRL + TRNE A,DECREL + JRST LKPNDR ;DIFFERENT WAY TO OUTPUT THIS INFO IN DECREL FMT + MOVEI A,6 + PUSHJ P,PBITS + PUSHJ P,OUTSM0 ;PUNCH SYM + HLRZ A,B + TLZE C,3RLNK ;RELOC OF LINK PNR + TLO A,100000 + HRRZS B ;CLEAR OUT LH OF B + TRZ I,IRCONT ;OK TO END BLOCK NOW + JRST $OUTPT ;PUNCH OUT A AND RETURN + +LKPNDR: MOVSI A,DECINT ;WRITE AN "INTERNAL REQUEST" WITH ONE DATA WORD. + CALL DECBLK + SETZ TM, ;COMPUTE RELOC OF ADDRESS AND DATA IN TM. + TLNE C,3RLNK + TRO TM,2 + SKIPE WRDRLC + TRO TM,1 + MOVE A,WRD ;ADDRESS TO LINK,,DATA + HRL A,B + CALL DECWR1 + JRST EBLK + +;THESE ASSUME STE IDX IN D, SQUOZE W/ FLAGS IN SYM. +;C HAS 3RDWRD, B OR WRD HAS VALUE TO DEF. WITH. +;CALL ONLY IN RELOCATABLE ASSEMBLY. +OUTDE2: MOVEM B,WRD +OUTDE1: TLNE FF,FLPPSS + TLO C,3VP ;VALUE PUNCHED + 3PUT C,D + SKIPGE CONTRL + RET + TRO I,IRCONT + SETZ A, + TLNN C,3LABEL ;WHAT KIND OF DEFINITION DEPENDS ON WHETHER SYM IS REDEFINABLE. + MOVEI A,CRDF + CALL P7X ;PUNCH OUT CODE BITS + PUSHJ P,GTVL7B ;SET RELOCATION BITS IN SQUOZE + PUSHJ P,OUTSM0 + TRZ I,IRCONT + JRST OUTWD ;OUTPUT VALUE + +;PUNCH OUT LOCAL-GLOBAL RECOVERY BITS AND SYM +;I.E. TELL LOADER THAT SQUOZE IN SYM, FORMERLY CONSIDERED LOCAL, IS REALLY GLOBAL +PLOGLO: SKIPGE CONTRL + RET + PUSH P,A + PUSHJ P,PBITS7 + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY THIS IS NEW STYLE RQ, + PUSHJ P,OUTSM0 ;PUNCH "OLD NAME" = SYMTAB IDX, + TLC SYM,440000 ;SAY MAKE GLOBAL, OUTPUT ACTUAL NAME OF SYM. + PUSHJ P,OUTSM + JRST POPAJ + +;NO GLOBALS TO RIGHT OF EQUAL SIGN + +EQL1: PUSHJ P,ESDCHK + JRST EQL1A ;NOT FOUND +IFN CREFSW,XCT CRFEQL ;DEF. OCCUR. OF NORMAL SYM. OR INTSYM. + MOVEI T,(C) ;GET BKTAB IDX OF BLOCK FOUND IN. + CAIE T,(TM) + JRST EQL1F + SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL + XCT EQL1TB(A) ;FOUND IN DESIRED BLOCK => NOW REDEFINE. + JRST ASSEM1 + +EQL1F: JUMPN T,EQL10 + CAIE A,PSUDO_-16 + JRST EQL10 + MOVEI T,(B) ;FOUND AS PSEUDO IN INITIAL SYMS BLOCK, + CAIN T,INTSYM ;SPECIAL WAY TO REDEFINE IF LIKE .MLLIT, ETC. + JRST EQLINT + ETSM ERRQPA ;SHADOWING AN INITIAL PSEUDO, TELL USER. +EQL10: CALL DEFCHK ;FOUND IN OUTER BLOCK, GET NEW STE, + JRST EQL1A ;DEFINE THERE AS IF NOT FOUND. + +EQL1TB: ETSM ERRIPA ;COMMON + JRST EQL1B2 ;PSEUDO OR MACRO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + ETSM ERRIPA ;DEF LOC VAR + ETSM ERRIPA ;UNDEF LOC VAR + ETSM ERRIPA ;DEF GLO VAR + ETSM ERRIPA ;UNDEF GLO VAR + JRST EQL1D ;GLO ENTRY + JRST EQL1E ;GLO EXIT + +EQL1E: PUSHJ P,GLKPNR ;DUMP LINKING POINTER + CAIA +EQL1D: CALL MDTCHK + PUSHJ P,RCHKT ;GLO ENTRY +EQLB2: PUSHJ P,RMOVET + TLNE FF,FLHKIL + TLOA SYM,400000 + TLZA C,3SKILL + TLO C,3SKILL + HRLZI T,GLOETY + SKIPE LDCCC ;IF IN LOADER CONDITIONAL, + TLO C,3LLV ;THEN LOADER MUST SUPPLY VALUE + PUSHJ P,VSM2W ;DEFINE SYM + TLO SYM,40000 ;SET GLOBAL BIT IN SQUOZE +EQL1CE: JUMPGE FF,ASEM1A + PUSHJ P,OUTDE1 +ASEM1A: TLNE I,ILMWRD + PUSHJ P,IGTXT + JRST ASSEM1 + +;CHECK WHETHER DEFINING AN MDT, OR REDEFINING A LABEL (=> THIS IS AN MDT) +MDTCHK: TLNN C,3LABEL + JRST MDTCH1 + CALL GVSYM0 ;MOVE VALUE OF SYM TO A, GET RELOC (WRDRLC STYLE) IN B + CAMN A,WRD + CAME B,WRDRLC ;IF WE'RE CHANGING THE VALUE, MARK SYM AS MDT +MDTCHL: TLO C,3MULTI +MDTCH1: TLNE C,3MULTI ;EVER ASSIGNING TO MDT, EVEN SAME VALUE, GIVES ERR MSG + ETSM ERRMDT + RET + +EQL1C: TLNE I,ILGLI + JRST EQL1CA ;MAKE GLOBAL + PUSH P,C + PUSHJ P,LKPNRO ;MAYBE OUTPUT LINK REQUEST + PUSHJ P,RCHKT + PUSHJ P,RMOVET ;INITIALIZE 3RDWRD + MOVSI T,SYMC ;SYM + PUSHJ P,EQA2A ;ENTER DEF IN SYMTAB + TLNE C,3SKILL + TLO SYM,400000 + POP P,AA + TLNE AA,3VCNT ;USED IN CONSTANT + PUSHJ P,CONBUG + JRST EQL1CE + + ;PUNCH OUT CODE BIT PAIR, FIRST OF WHICH IS 7 + +P7X: MOVEM A,PARBIT ;ENTRY FOR SECOND BYTE IN A +P70: PUSHJ P,PBITS7 ;ENTRY FOR SECOND BITE IN PARBIT, PUNCH OUT THE 7 + SKIPA A,PARBIT ;GET SECOND BYTE BACK +PBITS7: MOVEI A,7 ;ENTRY TO JUST PUNCH OUT 7 + JRST PBITS + +EQL1CA: PUSHJ P,PLOGLO + JRST EQL1E +EQA2: PUSH P,CASM1A +EQA2A: TLNE FF,FLHKIL + TLO C,3SKILL + JRST VSM2W + +EQL1B2: HRRZ A,B ;ATTEMPT TO ASSIGN PSEUDO-OP, IS IT AN INTSYM? + CAIN A,INTSYM + JRST EQLINT ;YES, GO SET WD IT POINTS TO. + ETSM [ASCIZ /Pseudo or macro ='D/] +EQL1B: CALL MDTCHK + PUSHJ P,RCHKT + TLNE I,ILGLI + JRST EQLB2 ;WAS LOCAL, MAKE IT GLOBAL + ;WAS LOCAL, LEAVE IT LOCAL + PUSHJ P,RMOVET ;PUT RELOCATION BITS IN BITS 0 AND 1 OF C (I.E. START SETTING UP 3RDWRD) + MOVSI T,SYMC ;SYM + JRST EQA2 + +EQL1A1: PUSHJ P,RCHKT + PUSHJ P,RMOVET + HRLZI T,SYMC + JRST EQA2 + +EQL1A: SKIPE LABELF ;"=:" MEANS "SYM'S VALUE SHOULDN'T BE CHANGED". + TLO C,3LABEL +IFN CREFSW,XCT CRFLBL ;DEF. OCCUR. OF NORMAL SYM. + TLNN I,ILGLI + JRST EQL1A1 + JRST EQL1E + +EQLINT: HLRZS B ;GET ADDR OF WD HOLDING VALUE. + MOVEMM (B),WRD ;PUT NEW VALUE IN IT. + JRST ASEM1A + +;;. ;ROUTINES DEALING WITH THE CURRENT LOCATION AND OFFSET + +VBLK +CLOC: 0 ;PUNCHING LOC +CRLOC: 0 ;PUNCHING RELOC +OFLOC: 0 ;OFSET VAL +OFRLOC: 0 ;OFSET RELOC +;VAL OF PT=CLOC+OFLOC,CRLOC+OFLOC +SYLOC: 0 ;VAL OF LAST TAG +SYSYM: 0 ;LAST TAG +SYLOC1: 0 ;VALUE OF NEXT TO LAST TAG +SYSYM1: 0 ;NEXT TO LAST TAG +GLOCTP: 0 ;4.9 => CURRENT LOCATION GLOBAL, 2.9 => OFFSET GLOBAL + ;FRGLOL (FLAG IN FF) IS IOR OF BITS 4.9 AND 2.9 OF GLOCTP + ;EXCEPT AFTER .=NON-GLOBAL WITH GLOBAL OFFSET + ;OTHER BITS USED ONLY WHEN IN LINK (NEVER SET IN GLOCTP): + ;400 => ARG GLOBAL +PBLK + + + ;POINT (.) AS PSEUDO-OP + +GTVLP: TRNE FF,FRGLOL + JRST GTVLP2 ;LOCATION GLOBAL + MOVE B,OFRLOC ;GET RELOCATION OF OFFSET + ADD B,CRLOC ;ADD CURRENT RELOCATION + MOVE A,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 ;IF IN BYTE MODE, + HLL A,BYTWP ;SET LEFT HALF TO BYTE POINTER LEFT HALF FOR ILDB + ADD A,OFLOC ;NOW ADD OFFSET + TLZ I,ILFLO+ILDECP+IRPERI ;CLEAR OUT FLAGS SET WHEN LOOKED LIKE FLOATING POINT NUMBER + POPJ P, + + +GTVLP2: MOVEI T,$.H ;LOCATION GLOBAL + AOS GLSP1 + HRRZM T,@GLSP1 ;PUT $. ON GLOBAL LIST (INCLUDES OFFSET, WHETHER GLOBAL OR NOT) + SKIPL BYTM1 ;IN BYTE MODE? + TDZA A,A ;NO, CLEAR ABS PART OF VALUE + HLLZ A,BYTWP ;YES, USE LH(BP) AS ABS PART + JRST CLBPOP + +$.H: (GLOETY)+SQUOZE 0,$. ;CURRENT LOCATION + OFFSET IN LOADER +$L.H: (GLOETY)+SQUOZE 0,$L. ;LOCATION BEING LOADED INTO BY LOADER, USED BY ABLOCK +$O.H: (GLOETY)+SQUOZE 0,$O. ;LOADER OFFSET +$R.H: (GLOEXT)+SQUOZE 0,$R. ;RELOCATION AS GLOBAL + +COLON: TRNE I,IRLET + TRNN I,IRSYL + ETA [ASCIZ/Colon without preceding symbol/] + TLNN I,ILWORD + TRNE I,IROP+IRPSUD+IREQL+IRNOEQ + ETSM [ASCIZ/Label inside an expression/] + SKIPE ASMOUT + ETSM [ASCIZ /Label inside <>, () or []/] + TLZ FF,FLHKIL + PUSHJ P,RCH ;GET NEXT CHAR + CAIN A,": ;IF NEXT CHAR ANOTHER COLON, + TLOA FF,FLHKIL ;THEN SET FLAG TO HALF-KILL + TLO FF,FLUNRD ;NOT COLON, CAUSE IT TO BE RE-INPUT + SKIPE HKALL ;CHECK FOR HALF-KILL-ALL-LABELS MODE. + TLO FF,FLHKIL + MOVE T,CLOC ;GET CURRENT LOCATION + SKIPGE BYTM1 + HLL T,BYTWP ;BYTE MODE, SET LEFT HALF OF VALUE TO LEFT HALF OF BYTE POINTER + ADD T,OFLOC ;ADD OFFSET + MOVEM T,WRD ;STORE RESULT AWAY FOR POSSIBLE PUNCHOUT + EXCH T,SYLOC ;NOW SET UP STUFF FOR ERROR PRINTOUT + MOVEM T,SYLOC1 + EXCH SYM,SYSYM + MOVEM SYM,SYSYM1 + MOVE SYM,SYSYM + MOVE A,CRLOC ;SET UP RELOCATION + ADD A,OFRLOC + MOVEM A,WRDRLC + SETOM LABELF ;SET FLAG CAUSING 3LABEL (DON'T REDEFINE) TO BE SET. + SKIPN LDCCC + TRNE FF,FRGLOL + JRST GCOL1 ;LOCATION VIRTUAL OR IN LOAD TIME CONDITIONAL + PUSHJ P,ESDCHK ;TRY FINDING CURRENT ENTRY IN ST + JRST EQL1A ;NOT ALREADY DEFINED +IFN CREFSW,XCT CRFLBL +COLON1: MOVEI T,(C) ;BKTAB IDX OF BLOCK FOUND IN, + CAIE T,(TM) ;FOUND IN DESIRED BLOCK => TRY REDEFINING. + JRST COLON3 + TLO C,3LABEL ;CAUSE REDEFINING SYMBOL TO BARF + XCT COLON2(A) ;BUT MAYBE PRINT ERR MSG FIRST. + JRST EQL1B + +CASSM1: JRST ASSEM1 + +COLON3: JUMPN T,EQL10 ;NOT INITIAL SYM => CAN SHADOW, + CAIN A,SYMC_-14. ;INITIAL SYM => CAN SHADOW IF IT'S AN ORDINARY LOCAL SYM + CAME B,WRD ;AND NEW VALUE SAME AS OLD VALUE. + CAIA + SKIPE WRDRLC + ETSM ERRRES ;ELSE GIVE ERROR MESSAGE BEFORE SHADOWING, TO WARN USER. + JRST EQL10 + +ERRRES: ASCIZ /Pseudo, macro or initial sym as label/ +ERRMDT: ASCIZ /Multiply defined/ + +COLON2: TLO C,3MULTI ;COMMON + ETSM ERRRES ;MACRO OR PSEUDO + JRST EQL1B ;SYM + JRST EQL1C ;LOCAL UNDEF + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI ;SETTING 3MULTI CAUSES EQL1B TO PRINT AN MDT ERROR. + JRST EQL1D ;GLOBAL ENTRY + JRST EQL1E ;GLO EXIT + +;COLON WHEN LOCATION VIRTUAL, OR IN LOAD TIME CONDITIONAL + +GCOL1: IFN CREFSW,XCT CRFLBL ;DEFINING ORDINARY SYM. + SKIPGE CONTRL + ETASM [ASCIZ /Virtual label in abs assembly/] + PUSHJ P,ESDCHK ;FIND ITS SLOT IN ST + JRST EQL2 ;JUST LIKE EQG1 EXCEPT FOR ERROR MESSAGES. + MOVEI T,(C) + CAIE T,(TM) + JRST COLON5 + XCT GCOL1T(A) ;FOUND IN DESIRED BLOCK, REDEFINING. + JRST EQL2 + +COLON5: JUMPN T,EQG2 ;SHADOWING, OK UNLESS INITIAL SYM. + ETSM ERRRES + JRST EQG2 + +GCOL1T: TLO C,3MULTI ;COMMON + ETSM ERRRES ;PSEUDO. + JRST EQL2 ;SYM. + JRST EQGUL ;LOCAL UNDEF. + TLO C,3MULTI ;VAR + TLO C,3MULTI + TLO C,3MULTI + TLO C,3MULTI + JRST EQL7 ;DEF GLO + JRST EQL8 ;UNDEF GLO. + + + ;PUNCH OUT "DEFINE SYM AS $." + +PDEFPT: MOVEI A,CDEFPT + PUSHJ P,P7X ;OUTPUT 7 THEN PDEFPT + JRST OUTSM0 ;OUTPUT SYM, WITHOUT BITS + +;LOC, BLOCK, .= + +ALOC: PUSHJ P,ALOCRG ;LOC, GET ARG +ALOC1: SETZM SYLOC ;CLEAR OUT LOC OF LAST TAG + SETZM SYSYM ;CLEAR OUT LAST TAG SO ERROR MESSAGES DON'T PRINT OBSCENE INCREMENTS +IFN FASLP,[ + SKIPGE TM,CONTRL + TRNN TM,FASL + JRST .+2 + ETA [ASCIZ /LOC illegal in FASL assembly/] +] + TRZE LINK,400 ;GLOBALS IN ARG? + JRST ALOC2 ;YES + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF CURRENT LOCATION + CALL SLOCF ;RE-INIT NEXT OUTPUT BLOCK'S HEADER; SET LOCF. + MOVEI A,LCEGLO ;=> RESET GLOBAL RELOCATION (BACK TO ORIGINAL NON-GLOBAL RELOCATION) + TLZE LINK,400000 ;IS CURRENT LOCATION NOW GLOBAL? + PUSHJ P,PLDCM ;YES, RESET IT + MOVE B,WRDRLC ;GET BACK NEW RELOCATION +ALOC2B: TRZE B,-2 ;NO BITS ALLOWED EXCEPT LOW ORDER + ETR [ASCIZ *Illegal relocation in LOC/BLOCK/.=*] + HRRZM B,CRLOC ;STORE NEW RELOCATION + SKIPGE CONTRL + JRST ASSEM1 ;DON'T BOTHER WITH REST IF ABS. + MOVEI B,2(B) ;LABS OR LREL + DPB B,[310700,,BKBUF] ;STORE NEW BLOCK TYPE + MOVEM B,CDATBC ;ALSO STORE AS NORMAL BLOCK TYPE +AOFSTX: TDNN LINK,[SETZ(SETZ)] ;ENTRY FROM AOFFSET, SKIP IF FRGLOL SHOULD BE SET + TRZA FF,FRGLOL ;CURRENT LOCATION PLUS OFFSET NOT GLOBAL, CLEAR FLAG + TRO FF,FRGLOL ;GLOBAL, SET FLAG + TRZ LINK,600 ;CLEAR OUT TEMPORARY FLAGS SO WON'T GET STORED IN GLOCTP + MOVEM LINK,GLOCTP ;STORE BACK STATUS FLAGS + JRST ASSEM1 + +PTEQ: MOVE SYM,[SQUOZE 0,LOC] + PUSHJ P,ALOCRG ;.=, GET ARG + MOVE T,[MINF+HFWDF,,$O.H] ;GLOTB ENTRY IF .+1 DOESN'T SKIP + TRNE LINK,400000 ;OFFSET GLOBAL? + JRST PTEQ2 ;YES, WANT TO DO LOC ARG-$O." + PUSHJ P,SBWDOF ;OFFSET IS LOCAL, SUBTRACT FROM ARG + JRST ALOC1 + +ABLOCK: PUSHJ P,ABLKRG ;GET ARG TO "BLOCK" PSEUDOOP. + TRNE LINK,400 ;GLOBALS IN ARG? + JRST ABLKG ;GLOBALS IN ARG + TLNE LINK,400000 + JRST ABLKG ;JUMP IF LOSER CHANGING RELOCATION WHILE CLOC GLOBAL +IFN FASLP,[ + MOVE D,CONTRL + TRNN D,FASL ;IN FASL FORMAT, CAN'T SET LOC. CTR., + JRST ABLKF1 + SKIPE B + ETA [ASCIZ /BLOCK size relocatable/] + JUMPGE FF,ABLKF1 + CALL ABLKF ;SO ON PASS 2 OUTPUT A BUNCH OF ZEROS. + JRST ABLKF1 + +;OUTPUT C(A) ZEROS, IN FASL FORMAT. NO-OP ON PASS 1. DOESN'T SET THE LOCATION COUNTER. +ABLKF: JUMPE A,CPOPJ + JUMPGE FF,CPOPJ + SETZM WRD + SETZM WRDRLC + PUSH P,A + PUSH P,A +ABLKF2: CALL FASPW + MOVEMM GLSP2,GLSP1 + SOSE (P) + JRST ABLKF2 + JRST POPBAJ +] + +ABLKF1: JUMPL A,[ETA [ASCIZ /BLOCK size negative/]] + ADD A,CLOC ;ARG TO BLOCK IS LOCAL, ADD DIRECTLY TO CLOC + ADD B,CRLOC ;ALSO ADD RELOCATIONS + HRRZM A,CLOC ;STORE NEW ABSOLUTE PART OF LOCATION + CALL SLOCF ;FALL INTO ALOC ROUTINE, MAKING SURE FRLOC GETS SET + JRST ALOC2B + + +SBWDOF: SUB A,OFLOC ;SUBTRACT OFFSET FROM WRD, ETC. IN A,B + HRRZM A,WRD ;MAKE SURE RESULT GETS STORED IN WRD, AS WELL AS AC'S + SUB B,OFRLOC ;NOW DO RELOCATIONS + HRRZM B,WRDRLC + POPJ P, + +ABLKG: TRNE LINK,400000 ;GLOBAL BLOCK, IS OFFSET GLOBAL? + JRST ABLKG2 ;YES, OK TO REFERENCE $L. + PUSHJ P,SBWDOF ;NO, FOR COMPATIBILITY, DON'T REFERENCE $L. + SKIPA T,[HFWDF,,$.H] +ABLKG2: MOVE T,[HFWDF,,$L.H] +PTEQ2: AOS GLSP1 ;STORE T IN GLOTB + MOVEM T,@GLSP1 +ALOC2: TLO LINK,400000 ;SET GLOBAL LOCATION FLAG + MOVEI A,LCGLO ;=> GLOBAL LOCATION ASSIGNMENT + PUSHJ P,PLDCM ;PUNCH OUT GLOBAL LOCATION ASSIGNMENT + SETZM CLOC ;CLEAR OUT CLOC, NEW RELOCATION NOW + SETZB B,BKBUF ;ALSO CLEAR OUT HEADER, JUST TO BE SURE + AOJA B,ALOC2B ;SET RELOCATION TO 1 AND FALL IN + +AOFFSET: PUSHJ P,AOFFS2 ;OFFSET, GET ARG + MOVE A,T + MOVEM A,WRD ;RESTORE UNTRUNCATED ARG. + TRZE LINK,400 ;GLOBALS IN ARG? + TROA LINK,400000 ;GLOBALS IN ARG, SET GLOBAL OFFSET FLAG + TRZ LINK,400000 ;NO GLOBALS IN ARG + MOVEM A,OFLOC ;STORE NEW OFFSET + MOVEM B,OFRLOC ;ALSO STORE RELOCATION BITS + SKIPGE CONTRL ;IN RELOCATABLE, + JRST AOFSTX + MOVEI A,LDOFS ;LOADER OFFSET LOADER COMMAND TYPE + PUSHJ P,PLDCM ;PUNCH OUT LOADER COMMAND + JRST AOFSTX + +;GET ARG TO LOC, BLOCK, .=, OFFSET + +ALOCRG: +ABLKRG: MOVE A,CLOC + SKIPN CRLOC + JRST [ CAML A,DECBRA ;IF ADDR BEFORE THE LOC WAS ABS, + MOVEM A,DECBRA ;UPDATE HIGHEST ABS ADDR IF NEC. + JRST ABLKR1] + CAML A,DECTWO ;IT WAS RELOCA; UPDATE HIGHEST + JRST [ CAML A,DECBRH ;ADDR OF APPROPRIATE SEG. + MOVEM A,DECBRH + JRST ABLKR1] + CAML A,DECBRK + MOVEM A,DECBRK +AOFFS2: +ABLKR1: PUSH P,SYM + PUSHJ P,CONBAD ;ERROR IF IN GROUPING + REST SYM + TRNE I,IRNOEQ\IRPSUD\IREQL + ETSM [ASCIZ /Inside pseudo or =/] + TDNE I,[ILWORD,,IRFLD] + ETSM ERRNVL + PUSHJ P,EBLK ;MAYBE END CURRENT OUTPUT BLOCK + PUSHJ P,AGETWD ;GET ARG + MOVE LINK,GLOCTP ;GET GLOCTP FLAGS IN LINK, STAYS THERE UNTIL ALMOST DONE + MOVE T,GLSP2 + CAME T,GLSP1 + TROA LINK,400 ;SIGNAL GLOBAL ARG + TRZ LINK,400 ;LOCAL + MOVE T,A ;SAVE UNTRUNCATED FOR AOFFSET, + HRRZS A,WRD ;TRUNCATE FOR LOC, BLOCK, .=. + TRNN I,IRDEF ;ALL DEFINED? + JRST ASSEM1 + SKIPGE CONTRL ;YES, RETURN SKIPPING OVER ARG + TRNN LINK,400 + RET + MOVE SYM,GTVER + ETASM [ASCIZ *Argument has externals*] + +;;CONSTANTS AND VARIABLES + ;VARIABLES AREA +VBLK + +LCNGLO==CONMIN/4 +LCONTB==CONMIN + +BLCODE [ +PCNTB: BLOCK NCONS*3 ;CONSTANTS AREAS TABLE +VARTAB: BLOCK NVARS +] +CONTBA: CONTAB ;ADDRESS OF BEGINNING OF CONSTANTS TABLE. +CONTBE: CONTAB+LCONTB ;ADDRESS OF WORD AFTER END OF CONSTANTS TABLE. +PLIM: 0 ;POINTER TO FIRST UNUSED WORD IN CONSTANTS TABLE. + +CONGLA: CONGLO ;ADDRESS OF BEGINNING OF CONSTANT-GLOBALS TABLE. +CONGLE: CONGLO+LCNGLO ;ADDRESS OF WORD AFTER END OF CONSTANT GLOBALS TABLE. +CONGOL: 0 ;HAS ADR OF FIRST WORD INACTIVE IN CONSTANT-GLOBALS TABLE. + +CONBIA: CONBIT ;ADDRESS OF BEGINNING OF CONSTANT-RELOCATION-BITS TABLE. + +CONLEN: CONMIN ;TOTAL SPACE ALLOCATED TO CONSTANTS TABLES. + ;ALL THE HOOKS ARE IN FOR DYNAMIC ALLOCATION OF THESE TABLES + ;(CONTAB, CONGLO, AND CONBIT). ALL THAT IS NEEDED IS TO GET + ;THE SPACE AND INITIALIZE CONTBA, CONTBE, CONGLA, CONGLE, CONBIA. + + ;PCNTB STUFF + + ;EACH ENTRY 3 WORDS; FIRST WORD SQUOZE, NAME OF AREA IF GLOBAL +CSQZ: 0 ;SQUOZE COUNTER + ;SECOND WORD RH LOC OF AREA (WITH OFFSET), LH LOC FIRST AFTER AREA (WITHOUT OFFSET) + ;THIRD WORD LH FLAGS + +CGBAL==100000 ;GLOBAL (INCLUDING OFFSET) +CTRL==200000 ;RELOCATED ( " ) +CTDEF==400000 ;DEFINED (MUST BE SIGN) + +PBCON: 0 ;POINTER INTO PCNTB, HAS ADR OF ENTRY FOR NEXT CONSTA +PBCONL: 0 ;POINTER TO ABSOLUTE TOP OF PCNTB +CONCNT: 0 ;NUMBER OF TIMES CONSTANTS CAN APPEAR (DECREMENTED BY CONSTA) +CONDEP: 0 ;DEPTH IN CONSTANTS (0 TOP LEVEL) +CONSAD: 0 ;ADDR IN CONSTANTS TABLE OF ENTRY FOR CURRENT CONST. +CONSML: 0 ;VALUE OF .MLLIT INTSYM. + ;NEGATIVE => ERROR MODE (DEFAULT) + ;ZERO => OLD MODE. + ;POSITIVE => NEW (MULTI-LINE) MODE. + +CONSTP: 0 ;PDL POINTER BELOW WDS FOR INNERMOST CONSTANT. +CONSP1: 0 + + ;VARIABLES FOR VARIABLES CODING + +VARCNT: 0 ;NO OF VAR IN CURRENT VAR AREA SO FAR +VARPNT: 0 ;POINTER TO CURRENT PLACE IN VARTAB +VARCNR: 0 ;NO OF TIMES VARIABLES MAY APPEAR +VCLOC: 0 ;TEM FOR VARIAB +VECSIZ: 0 ;DEFAULT SIZE FOR .VECTOR. + +PBLK + +;LEFT-BRACKET ENCOUNTERED; HERE ON DISPATCH FROM GETFD +;SAVE WORLD, BYTE MODE, ASSEM1 PDL LEVELS. +;THEN SET ASSEM1 PDL LEVELS TO CURRENT LEVELS +;SO ASSEM1 WON'T FLUSH PAST LEVEL OF CONSTANT. +;SET CONSTP _ CURRENT PDL LEVEL. PCONS WILL PUT WORDS +;OF CONSTANT ABOVE CONSTP, AND SET ASSEMP ABOVE THEM. + +LBRAK: SKIPE LITSW + ETR [ASCIZ /Literal/] + TRO I,IRFLD ;LEFT BRACKET + JSP LINK,SAVWD1 ;SAVE CRUFT + PUSH P,SCNDEP ;SO THE NEXT RBRKT WON'T TRY TO CLOSE CONDIT. + JSP LINK,SAVAS1 + MOVEIM ASMOUT,3 + SETZM SCNDEP ;NOT WITHIN CONDITIONALS IN THIS LITERAL. + AOS CONDEP ;ONE DEEPER IN LITERALS. + MOVEI A,IRPSUD\IREQL + ANDCAM A,ASMI + JRST ASSEM3 ;GO ASSEMBLE THE WORDS OF THE CONSTANT. + +;OUTPUT WORD TO CONSTANT. P MUST EQUAL ASSEMP HERE. +PCONS: SKIPL CONTRL ;IF RELOCATABLE, + PUSHJ P,$RSET ;HANDLE STRANGE RELOCATIONS. + MOVE B,GLSP1 + SUB B,GLSP2 ;NUM. GLOBAL ENTRIES FOR THIS WD. + HLRZ A,WRDRLC ;ONLY 1.1 AND 3.1 BITS MATTER. + LSH A,1 + IOR A,WRDRLC ;GET THEM INTO 1.1, 1.2 BITS. + TLNE I,ILNOPT ;REMEMBER ILNOPT ALSO. + IORI A,4 + DPB B,[032200,,A] ;AND # GLBLS. + PUSH P,A ;SAVE THEM ALL. + HRLI B,(B) ;GET # GLBLS,,# GLBLS . + JUMPE B,PCONS1 + MOVE A,GLSP2 + MOVSI A,1(A) + HRRI A,1(P) ;SAVE THE GLBLS, IF ANY. + ADD P,B + JUMPGE P,CONFLP + BLT A,(P) +PCONS1: PUSH P,WRD + MOVEM P,ASSEMP ;ASSEMP -> ABOVE WDS FOR LIT.; CONSTP, BELOW. + JRST (T) + +;JSP LINK,SAVAS1 TO PUSH DATA ON ASSEM1 LEVEL AND CALL ASSEM1 +;LOOP RECURSIVELY. +.SEE CONNDP ;WHICH IS WHERE THESE THINGS ARE POPPED. +SAVAS1: SKIPN BYTM ;IF IN BYTM NOW (WILL PUSH AND TURN OFF) + JRST LBRAK1 + MOVSI A,BYBYT ;SAVE ALL THE DETAILS. + HRRI A,1(P) + ADD P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] + JUMPGE P,CONFLP ;(SOFTWARE-DETECTED PDL-OV) + BLT A,-BYTMCL(P) + MOVSI A,BYTMC + HRRI A,1-BYTMCL(P) + BLT A,(P) +LBRAK1: PUSH P,BYTM + SETZM BYTM + PUSH P,ASMOUT + PUSH P,ASMDSP + PUSH P,ASMI + PUSH P,GLSPAS ;SAVE ASSEM1 PDL LEVELS. + PUSH P,ASSEMP + PUSH P,CONSTP + MOVE A,I + ANDI A,IRPSUD+IREQL + IORI A,IRDEF + MOVEM A,ASMI ;ASMI IOR'D INTO I AT ASSEM2 LOOP. + HRRZ A,CPGN + HRL A,CLNN ;REMEMBER WHERE THIS LITERAL STARTS. + INSIRP PUSH P,[A SYSYM SYLOC] + MOVEM P,ASSEMP ;SO ASSEM1 WON'T FLUSH WHAT WE PUSHED. + MOVEM P,CONSTP ;SO CONND CAN FIND 1ST WD OF CONSTANT. + MOVEMM GLSPAS,GLSP1 +SAVAS2: MOVEI A,ASSEM3 ;IF NOT MULTI-LINE MODE, ARRANGE TO + SKIPG CONSML ;END THE CONSTANT AFTER 1 WORD. + MOVEI A,ASSEMC + MOVEM A,ASMDSP + JRST (LINK) + +PCONST: MOVE CH1,ASMDSP ;OUTPUT TO CONST. FROM ASSEM1 + CAIN CH1,CONND ;LAST WD OF CONST? + CAME P,CONSTP ;1ST WD? + JRST PCONS ;NO, DO THE GENERAL THING. + SKIPL CONTRL ;THIS MUST BE ONLY WORD OF CONST, + PUSHJ P,$RSET ;DON'T BOTHER PUSHING, END CONST. NOW. + PUSH P,CONSTP + TLZ I,ILMWRD+ILMWR1 ;THIS IS 1ST WD, NO MORE WDS. + JRST CONND3 ;PRETEND JUST POPPED IT. + +;COME HERE FROM ASSEM1 TO END A CONSTANT. +CONND: SKIPE BYTM ;IF IN BYTE MODE, LEAVE IT AND DO .WALGN + JRST A.BY3 ;(WILL COME BACK SINCE ASMDSP STILL SET) +CONNDW: MOVEMM CONSP1,CONSTP + TLZ I,ILMWR1 ;THIS IS 1ST WORD COMING UP. +CONND0: TLZ I,ILMWRD+ILNOPT + SETZM WRDRLC + MOVE F,CONSP1 ;ADDR IN IN PDL OF NEXT WD. + CAMN F,ASSEMP + JRST CONND2 ;J IF NO WORDS. + MOVE A,1(F) ;GET SAVED NUM GLBLS,,NUM GLBLS + DPB A,[100,,WRDRLC] + LSH A,-1 ;RESTORE WRDRLC BITS 1.1, 3.1 + DPB A,[220100,,WRDRLC] + TRNE A,2 + TLO I,ILNOPT ;RESTORE NOOPTF. + LSH A,-2 ;GET # GLBLS. + HRLI A,(A) ;# GLBLS,,# GLBLS. + AOBJN F,.+1 + HRRZM F,GLSP2 ;ADDR BEFORE 1ST GLOBAL ENTRY. + ADD F,A + HRRZM F,GLSP1 ;ADDR OF LAST GLOBAL ENTRY. + MOVE A,1(F) + MOVEM A,WRD + AOBJN F,.+1 ;POINT TO NEXT CONST WD IF ANY, + MOVEM F,CONSP1 + CAME F,ASSEMP ;IF MORE WORDS SET ILMWRD + TLO I,ILMWRD + JRST CONND3 + +CONND2: INSIRP SETZM,[WRD,GLSP1,GLSP2] +CONND3: MOVE F,GLSP1 + SUB F,GLSP2 + JUMPE F,SCON ;JUMP IF NOTHING VIRTUAL + MOVEI B,-1(F) + MOVN TT,B + JUMPE B,SCON ;JUMP IF ONLY ONE GLOBAL + ;SORT GLOTB ENTRIES THIS CONSTANT +LSORT: HRL T,TT ;SET UP AOBJN POINTER TO GLOBALS REMAINING + HRR T,GLSP2 +LSORT2: MOVE A,1(T) + CAMLE A,2(T) + EXCH A,2(T) ;INTERCHANGE + MOVEM A,1(T) + AOBJN T,LSORT2 ;INNER LOOP POINT + SOJG B,LSORT ;OUTER LOOP + ;DROPS THROUGH + +;DROPS THROUGH +SCON: PUSHJ P,RCHKT + PUSHJ P,RMOVET ;SET UP RELOACTION BITS. + ROT T,2 ;ROTATE TO BOTTOM TWO BITS OF T + TLNE I,ILMWRD+ILMWR1+ILNOPT + JRST NOCON ;MULTIPLE WORD OR OPTIMIZATION SUPPRESSED, DON'T TRY TO FIND MATCH + MOVE A,CONTBA +SCON1: CAML A,PLIM ;SEARCH CONSTANTS TABLE TO SEE IF ALREADY THERE + JRST NOCON ;END OF TABLE, NO MATCH + MOVE B,WRD + CAME B,(A) +SCON2: AOJA A,SCON1 ;VAL DISAGREES + PUSHJ P,CPTMK ;GET BP TO CONSTANTS-BIT TABLE IN C + LDB F,C ;GET RELOCATION BITS THIS CONSTANT + CAME F,T + JRST SCON2 ;RLC DIFFRS + MOVE B,CONGLA ;VALUE AND RELOCATION AGREE, NOW TO CHECK GLOBALS + SKIPA C,GLSP2 +SCON2B: AOS B ;SEARCH FOR GLOBAL POINTING TO CONSTANT WHICH HAS MATCHED SO FAR + CAML B,CONGOL + JRST SCON3 ;GLOBALS MATCH SO FAR + CAME A,1(B) ;SKIP IF ONE FOUND +SCON7: AOJA B,SCON2B ;NOT YET + MOVE D,(B) ;FOUND ONE, GET GLOTB ENTRY + CAME D,1(C) ;COMPARE WITH THIS ENTRY IN GLOTB + JRST SCON2 ;NO MATCH, FLUSH THIS CONSTANT + AOJA C,SCON7 ;MATCH, TRY NEXT GLOBAL + +SCON3: CAME C,GLSP1 ;GLOBALS MATCH, BUT ARE WE EXACTLY AT END OF GLOTB? + JRST SCON2 ;NO, BACK TO SEARCH + JRST NOCON4 + +NOCON: AOS A,PLIM ;CONSTANT NOT ALREADY IN TABLE + CAMLE A,CONTBE + ETF [ASCIZ/Literal table full/] + MOVE AA,WRD + MOVEM AA,-1(A) + SOS A + PUSHJ P,CPTMK + TLNE I,ILNOPT + TRO T,4 ;1.3 OF RELOCATION BITS => DON'T OPTIMIZE ON TOP OF ME + DPB T,C + MOVE B,GLSP2 +NOCON3: CAML B,GLSP1 + JRST NOCON4 + SKIPN C,1(B) + AOJA B,NOCON3 ;THIS ENTRY NOT REALLY HERE + MOVEM C,@CONGOL + HRRZS C + PUSHJ P,NOCON5 + MOVEM A,@CONGOL + PUSHJ P,NOCON5 + SKPST C, ;SKIP IF IN SYMBOL TABLE + AOJA B,NOCON3 + 3GET1 D,C ;IN SYMBOL TABLE + TLO D,3VCNT ;THIS SYM USED IN CONSTANT + 3PUT1 D,C ;UPDATE 3RDWRD TABLE ENTRY + AOJA B,NOCON3 + +NOCON5: AOS AA,CONGOL + CAML AA,CONGLE + ETF [ASCIZ/Constants-global table full/] + POPJ P, + + ;SET UP BYTE POINTER TO CONSTANTS-BIT TABLE + ;A SHOULD HAVE ADR OF CONSTANTS TABLE ENTRY + ;LEAVES ANSWER IN C + ;BITS IN CONSTANTS-BIT TABLE PER ENTRY: + ;1.2, 1.1 RELOCATION BITS + ;1.3 ILNOPT BIT => DON'T OPTIMIZE ON TOP OF ME + +CPTMK: PUSH P,A + SUB A,CONTBA + PUSH P,B + IDIVI A,12. + MOVEI C,(A) + ADD C,CONBIA ;SET UP ADDRESS PART + IMULI B,3 + DPB B,[360600,,C] ;STORE POSITION FIELD FROM REMAINDER + TLO C,200 ;SET UP SIZE FIELD +POPBAJ: POP P,B + JRST POPAJ + +NOCON4: TLON I,ILMWR1 + MOVEM A,CONSAD ;IF 1ST WD SAVE ADDR. + TLNE I,ILMWRD ;IF MORE WORDS, HANDLE NEXT. + JRST CONND0 + MOVE P,CONSTP ;VALUE OF CONSTP AT CONND. + MOVE C,GLSPAS ;TO RESTORE GLSP1 + JSP T,CONNDP ;POP STUFF. + HRRZ A,CONSAD ;ADDR OF CONSTANTS TABLE ENTRY OF 1ST WD. + MOVE B,PBCON ;ADDR OF WDS DESCRIBING CONST. AREA. + SKIPL 2(B) ;CONST. AREA LOCATION DEFINITE? + AOJA C,CONND6 ;NO, USE GLOBAL. + MOVEM C,GLSP1 + HRRZ C,1(B) ;ADD ACTUAL ADDR OF CONST. AREA. + ADDI A,(C) ;GET C(CONTBA) + ADDR OF CONSTANT. + LDB B,[420100,,2(B)] + JRST CONND7 + +CONND6: MOVEM C,GLSP1 + MOVEM B,(C) + MOVEI B,0 +CONND7: SUB A,CONTBA + JRST LSSTH3 ;POP OUT INTO OUTER WORD. + +.SEE SAVAS1 ;WHICH IS WHAT PUSHES WHAT CONNDP POPS. +CONNDP: SUB P,[3,,3] ;FLUSH SAVED SYLOC AND SYSYM AND CLNN,,CPGN. +CONFL2: HRL T,ASMOUT ;REMEMBER IF POPPING A LITERAL OR NOT. + INSIRP POP P,[CONSTP,ASSEMP,GLSPAS,ASMI,ASMDSP,ASMOUT,BYTM] + SKIPN BYTM ;IF IN BYTE MODE, POP DETAILS. + JRST CONND5 + MOVSI A,1-BYTMCL(P) + HRRI A,BYTMC + BLT A,BYTMC+BYTMCL-1 + MOVSI A,1-BYTMCL-LBYBYT(P) + HRRI A,BYBYT + BLT A,BYBYT+LBYBYT-1 + SUB P,[LBYBYT+BYTMCL,,LBYBYT+BYTMCL] +CONND5: HLRZ A,T + CAIE A,3 + JRST (T) + POP P,A + ADDM A,SCNDEP ;DON'T FORGET ABOUT ANY CONDITIONALS. + SOS CONDEP ;HAVE POPPED ONE CONSTANT. + JRST (T) + +CONFLS: MOVE P,ASSEMP ;FLUSH ALL CONSTANTS. + CAMN P,[-LPDL,,PDL] ;IF IN ANY, + JRST (LINK) + MOVE P,CONSTP ;POINT AFTER ITS PDL ENTRY, + JSP T,CONNDP ;POP IT, + JRST CONFLS ;TRY AGAIN. + +CONBAD: SKIPN ASMOUT ;IF IN GROUPING, ERROR. + POPJ P, + ETSM [ASCIZ/Within <>, () or []/] + JRST ASSEM1 + +;COME HERE FOR PDL-OV ON P. +;IF IN A CONSTANT, FLUSH ALL OF THEM, SAYING WHERE EACH STARTED. +;THEN TYPE A PDL ERROR MSG AND RETURN TO ASSEM1. +;OTHERWISE FATAL ERROR. +CONFLP: MOVEI LINK,ASSEM1 + MOVEI CH1,ERRPDL + SKIPE CONDEP + JRST CONFL3 ;IN A CONSTANT. + MOVEI P,PDL ;RE-INIT PDL SO NO MORE PDL-OV. + ETF ERRPDL +ERRPDL: ASCIZ /PDL overflow/ + +;JSP LINK,CONFLM TO FLUSH CONSTANTS, SAYING WHERE THEYY STARTED, +;AND GIVE ERROR MSG. +CONFLM: MOVE CH1,ASMOUT + SKIPA CH1,ASMOT3(CH1) +CONFLZ: SETZ CH1, ;LIKE CONFLM BUT NO ERR MSG AT END. +CONFL3: SETO C, +CONFL1: MOVE P,CONSTP ;GET STACK ABOVE INNERMOST LITERAL. + REST SYLOC + REST SYSYM + REST D ;GET INFO ON WHERE STARTED + AOSN C ;THE 1ST TIME ONLY, SAY WHAT'S GOING ON. + TYPR [ASCIZ/Within groupings: /] + SKIPE C + TYPR [ASCIZ/, /] + MOVE A,ASMOUT ;SAY WHAT KIND OF GROUPING IS BEING CLOSED + MOVE A,ASMOT5(A) + CALL TYOERR ;BY SAYING WHAT CHAR OPENED IT. + JSP T,CONFL2 ;POP REST OF WDS SAVED AT LBRAK. + TYPR [ASCIZ/ at /] + MOVEI A,1(D) ;PAGE # GROUPING STARTED ON. + CALL DPNT ;PRINT IN DECIMAL. + MOVEI A,"- + CALL TYOERR + HLRZ A,D ;LINE NUMBER IT STARTED ON. + ADDI A,1 + CALL D3PNT2 ;PRINT W/ AT LEAST 3 CHARS, NO ZERO SUPPR. + MOVE A,ASSEMP + CAME A,[-LPDL,,PDL] ;MORE GROUPINGS TO POP => DO. + JRST CONFL1 + CALL CRRERR + MOVE P,ASSEMP + JUMPE CH1,(LINK) ;IF CALLED CONFLZ, NO ERR MSG (CALLER WILL GIVE ONE) + ETR (CH1) ;[ NO] OR PDL. + CALL CRRERR + JRST (LINK) + +;CONSTA + +CNSTNT: NOVAL + SKIPE ASMOUT ;IF ANY GROUPNGS, + JSP LINK,CONFLM ;FLUSH THEM, GIVE ERROR. + PUSHJ P,CNSTN0 + JRST ASSEM1 + +CNSTN0: SOSGE CONCNT ;ENTRY FROM AEND + ETF [ASCIZ /Too many constants areas/] + MOVE B,CLOC + ADD B,OFLOC + HRRZ T,PBCON + TRNN FF,FRPSS2 + JRST CNST1 ;PASS 1 + + MOVSI A,CGBAL + TDZ A,2(T) + TRNE FF,FRGLOL + TLC A,CGBAL + SKIPN A + ETR [ASCIZ /Constants globality phase error/] + HRRZ B,1(T) + SUB B,OFLOC + HRRZS B + CAME B,CLOC + ETR [ASCIZ /Constants location phase error/] + MOVE B,2(T) + ROT B,2 + XOR B,CRLOC + XOR B,OFRLOC + TRNE B,1 + ETR [ASCIZ /Constants relocation phase error/] + ;DROPS THROUGH + +;DROPS THROUGH +CNST2: MOVEI D,(T) ;STE IDX IN D FOR OUTSM0 + MOVE SYM,(T) ;GET NAME OF AREA + TLC SYM,400000#LCUDF ;CLEAR LCUDF, SET HALF-KILL + TRNE FF,FRGLOL + PUSHJ P,PDEFPT ;DEFINE SYM FOR BEGINNING OF CONSTANTS AREA + MOVE A,CONTBA +CNSTH: CAML A,PLIM + JRST CNSTA ;THRU + MOVE TT,(A) + MOVEM TT,WRD + PUSHJ P,CPTMK + LDB F,C ;GET THIS CONSTANT'S RELOCATION BITS + TRZE F,2 + TLO F,1 ;RELOCATE LEFT HALF + MOVEM F,WRDRLC ;STORE RELOCATION + MOVEI D,GLOTB ;AND NOW TO SET UP GLOTB! + MOVEM D,GLSP2 + MOVE C,CONGLA +CNSTC: CAML C,CONGOL + JRST CNSTB ;END OF CONSTANT-GLOBAL TABLE + CAMN A,1(C) ;POINTS TO THIS CONSTANT? + PUSH D,(C) ;YES, STORE ENTRY IN GLOTB + AOS C + AOJA C,CNSTC + +CNSTB: HRRZM D,GLSP1 ;MARK END OF ACTIVE PART OF GLOTB + PUSH P,A + PUSHJ P,PWRD ;OUTPUT THIS CONSTANT + AOS CLOC ;INCREMENT CLOC TO NEXT + HRRZS CLOC ;MAKE SURE IT STAYS IN A HALF-WORD (IMPORTANT SINCE MAY BE LESS THAN RELOCATION) + POP P,A ;RESTORE POINTER INTO CONSTANTS TABLE + AOJA A,CNSTH + +CNST3: HLRZ A,1(T) ;GET POINTER TO TOP OF AREA STORED DURING PASS 1 + CAMN A,CLOC ;SAME AS CURRENT? + JRST CNSTE ;YES, NO HAIR + CAMGE A,CLOC ;DIFFERENT; LOWER? + ETR [ASCIZ /More constants on pass 2 than 1/] + ;INSUFFICIENT CONSTANT SPACE; CONSTANTS AREA TRYING TO BE BIGGER + ;IN PASS 2 THAN PASS 1; THE EXTRA CONSTANTS WERE BACKED OVER + MOVEM A,CLOC ;EITHER WAY, SET CLOC TO TOP OF AREA SO WON'T HAVE MDT TROUBLE + PUSHJ P,EBLK ;END CURRENT BLOCK + CALL SLOCF ;IF RELOCATABLE, MAKE SURE NEW VALUE OF $. GETS PUNCHED + JRST CNSTE + +;CALL SLOCF WHENEVER "." IS CHANGED WITHOUT THE OUTPUTTING OF A STORAGE WORD. +SLOCF: MOVE A,CLOC ;STORE NEW "." IN HEADER FOR NEXT BLOCK OF OUTPUT. + SKIPGE TM,CONTRL + TRNN TM,DECREL+FASL ;BUT NOT IN DEC OR FASL OUTPUT FORMATS. + HRRM A,BKBUF + IORI FF,FRLOC ;MAKE SURE NULL BLOCK IS OUTPUT IF NEC. TO TELL LOADER "." HAS CHANGED. + RET + +;CONSTA DURING PASS 1 + +CNST1: HRRM B,1(T) ;STORE LOCATION OF AREA + MOVEI D,0 + MOVE A,CRLOC + ADD A,OFRLOC + TRNE A,1 + TLO D,CTRL ;RELOCATED + TRNE FF,FRGLOL + TLO D,CGBAL ;GLOBAL + IORM D,2(T) ;STORE FLAGS DESCRIBING AREA + JUMPL FF,CNST2 ;JUMP ON PUNCHING PASS, PUNCH OUT AREA NOW + MOVE T,PLIM + SUB T,CONTBA + ADDM T,CLOC ;PASS 1, JUST UPDATE CLOC + HRRZS CLOC + +CNSTA: HRRZ T,PBCON + TRNE FF,FRGLOL + JRST CNSTD ;LOCATION GLOBAL + TRNN FF,FRNPSS + SKIPGE 2(T) + JRST CNSTDA ;2 PASS ASSEMBLY OR AREA DEFINED + TRO I,IRCONT ;1PASS AND NOT DEFINED + SETZM PARBIT + PUSHJ P,P70 ;DEFINE SYM + MOVE A,(T) + TLC A,400000#LCUDF + SKIPE CRLOC + TLO A,100000 ;RELOCATE + PUSHJ P,$OUTPT + HRRZ A,1(T) + PUSHJ P,$OUTPT ;OUTPUT VALUE, FIRST LOCATION IN AREA + TRZ I,IRCONT +CNSTDA: MOVSI A,CTDEF + IORM A,2(T) ;CALL IT DEFINED +CNSTD: TRNE FF,FRPSS2 + JRST CNST3 ;PASS 2 + MOVE A,CLOC + HRLM A,1(T) ;MARK END OF AREA + +CNSTE: MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + MOVEI T,3 + ADDB T,PBCON + CAML T,PBCONL + MOVEM T,PBCONL + AOS A,CSQZ + MOVEM A,(T) + POPJ P, + +;DEFINING SYM USED IN CONSTANT, DELETE REFERENCES FROM CONSTANT-GLOBAL TABLE + +CONBUG: MOVE A,CONGLA ;B VAL C FLAGS ST(D) SADR + PUSH P,T + PUSH P,C ;SAVE FLAGS +CONBG2: MOVE C,(P) ;GET FLAGS + CAML A,CONGOL ;DONE WITH SCAN? + JRST CONBG1 ;YES + HRRZ F,(A) ;NO, GET CONSTANT-GLOBAL TABLE ENTRY + CAIE F,ST(D) ;POINT TO THIS SYM? + AOJA A,CONBG6 + PUSH P,B ;YES, SAVE VALUE, ABOUT TO WORK WITH B + MOVE T,(A) ;GET ENTIRE CONSTANT-GLOBAL TABLE ENTRY + LDB CH2,[221200,,T] ;GET MULTIPLICATION FIELD + SKIPE CH2 + IMUL B,CH2 ;NON-ZERO => MULTIPLY VALUE OF SYM + TLNE T,MINF + MOVNS B ;NEGATE VALUE + TLNE T,HFWDF + HRRZS B ;TRUNCATE TO HALFWORD + TLNE T,ACF + ANDI B,17 ;AC, MASK TO FOUR BITS + TLNE T,SWAPF + MOVSS B ;SWAP VALUE + TLNE T,ACF + LSH B,5 ;AC, SHIFT FIVE + ADD B,@1(A) ;ADD ABS PART OF VALUE + TLNN T,SWAPF + HRRM B,@1(A) ;NOT SWAPPED, STORE LH + TLNE T,SWAPF + HLLM B,@1(A) ;SWAPPED, STORE LH + TLNN T,HFWDF + MOVEM B,@1(A) ;FULL WORD, STORE VALUE + LDB CH1,[420200+P,,-1] ;GET HIGH BITS OF 3RDWRD, RELOCATION BITS + TLNE T,HFWDF ;NOW TO MAP RELOCATION BITS + TRZ CH1,2 + TLNE T,SWAPF + LSH CH1,1 + TRZE CH1,4 + TRO CH1,1 + PUSH P,A + HRRZ A,1(A) ;GET POINTER INTO CONSTANTS TABLE + PUSHJ P,CPTMK + LDB B,C ;GET RELOCATION BITS + TLNE T,MINF + JRST CONBG8 ;NEGATE + TRNE B,(CH1) + ETA ERRCRI + ;ATTEMPTED MULTIPLE RELOCATION IN CONSTANT + ; ^ ABOVE SHOULD BE REPLACED WITH A $RSET LIKE ROUTINE + ;THAT ALSO SEARCHES CONSTANT-GLOBAL TABLE FOR $R. ALREADY THERE + IOR B,CH1 ;LOOKS OK, IOR IN BITS FOR GLOBAL +CONB8A: DPB B,C ;STORE BACK NEW RELOCATION BITS FOR CONSTANT + POP P,A + CLEARM (A) ;CLEAR OUT CONSTANT-GLOBAL TABLE ENTRY + CLEARM 1(A) + POP P,B + AOS A +CONBG6: AOJA A,CONBG2 ;BACK FOR NEXT CONSTANT, DON'T KNOW HOW MANY THIS SYM USED IN + +CONBG1: MOVE A,CONGLA + PUSH P,B + MOVE B,CONGLA +CONBG7: CAML A,CONGOL + JRST CONBG3 + SKIPN C,(A) +CONBG5: AOJA A,CONBG4 + MOVEM C,(B) + MOVE C,1(A) + MOVEM C,1(B) + AOS B + AOJA B,CONBG5 + +CONBG4: AOJA A,CONBG7 +CONBG3: MOVEM B,CONGOL + POP P,B + POP P,C + POP P,T + POPJ P, +CONBG8: XORI B,3 + TRNE B,(CH1) + ETA ERRCRI + ANDCB B,CH1 + JRST CONB8A + +ERRCRI: ASCIZ /Multiple relocation in constant/ + +;VARIAB + +AVARIAB: NOVAL + SKIPE ASMOUT ;FLUSH ANY GROUPINGS IN PROGRESS. + JSP LINK,CONFLM + PUSHJ P,AVARI0 + JRST ASSEM1 + +AVARI0: SOSG VARCNR ;ENTRY FROM AEND + ETF [ASCIZ /Too many variable areas/] + MOVE D,SYMAOB ;SET UP AOBJN POINTER TO ST + MOVE T,CLOC + MOVEM T,VCLOC ;STORE AS LOCATION OF VARIABLE AREA + ADD T,OFLOC + MOVE C,CRLOC + ADD C,OFRLOC + TRNE FF,FRPSS2 + JRST AVAR1 ;PASS 2 + HRL T,VARCNT ;SIZE OF AREA + TRNE C,1 + TLO T,400000 ;RELOCATED + MOVEM T,@VARPNT + JRST AVAR2E + +AVAR1: HRRZ A,@VARPNT ;VARIAB DURING PASS 2 + CAIE A,(T) + ETR [ASCIZ /Variables location phase error/] + HLRZ A,@VARPNT + TRZE A,400000 + XORI C,1 + TRNE C,1 + ETR [ASCIZ /Variables relocation phase error/] + SKIPE VARCNT + ETR [ASCIZ /Variables area size phase error/] + +AVAR2E: HLRZ T,@VARPNT + TRNN T,377777 + JRST AVAR2C ;IF THIS VAR AREA IS EMPTY, DON'T SCAN SYMTAB. +AVAR2: HLRZ LINK,ST(D) ;SCAN, CHECKING EACH SYM FOR WHETHER IT'S A VARIABLE + CAIL LINK,DEFLVR + JRST AVAR2B + ADD D,WPSTE1 + AOBJN D,AVAR2 + JRST AVAR2C ;ALL SCANNED. + +AVAR2B: 3GET C,D ;FOUND A VARIABLE; DECIDE WHAT TO DO WITH IT. + MOVE B,ST+1(D) + MOVE SYM,ST(D) + TLZ SYM,740000 + LDB LINK,[400400,,ST(D)] + CAIE LINK,UDEFLV_-14. + CAIN LINK,UDEFGV_-14. + JRST AVAR3 ;UNDEFINED VARIABLE + CAIE LINK,DEFGVR_-14. + CAIN LINK,DEFLVR_-14. + JRST AVAR4 ;DEFINED VARIABLE +AVAR2A: ADD D,WPSTE1 + AOBJN D,AVAR2 ;CHECK ENTIRE SYMTAB +AVAR2C: HLRZ A,@VARPNT ;NOW GET SIZE OF AREA + TRZ A,400000 ;CLEAR OUT RELOCATION CHECK BIT +IFN FASLP,[ + MOVE D,CONTRL + TRNE D,FASL ;IN FASL ASSEMBLY, CAN'T JUST SET LOC CTR; MUST OUTPUT 0'S. + CALL ABLKF +] + ADD A,VCLOC ;ADD LOCATION OF BEGINNING OF VARIABLE AREA + MOVEM A,CLOC ;STORE AS NEW CURRENT LOCATION + PUSHJ P,EBLK + CALL SLOCF + CLEARM VARCNT ;INITIALIZE COUNT OF VARIABLES IN NEXT AREA + AOS VARPNT ;INCREMENT POINTER TO POINT TO NEXT AREA + POPJ P, + +;UNDEFINED VARIABLE FOUND IN SYMTAB SCAN + +AVAR3: CAIN LINK,UDEFGV_-14. ;GLOBAL? + TLO SYM,40000 ;GLOBAL + PUSHJ P,LKPNRO + MOVSI T,DEFLVR + CAIN LINK,UDEFGV_-14. + MOVSI T,DEFGVR + TRNE FF,FRGLOL + JRST AVAR3A ;LOCATION GLOBAL + MOVEI B,-1(B) + ADD B,VCLOC + ADD B,OFLOC + MOVE TT,CRLOC + ADD TT,OFRLOC + SKIPE TT + TLO C,3RLR + CAIE LINK,UDEFGV_-14. + TLZN C,3VCNT + SKIPA + PUSHJ P,CONBUG +AVAR4B: PUSHJ P,VSM2 + JUMPGE FF,AVAR2A ;IF PUNCHING PASS, OUTPUT DEFINITION. + PUSHJ P,OUTDE2 + JRST AVAR2A + +AVAR4: TLNE C,3VAS2 ;DEFINED VARIABLE FOUND DURING SYMTAB SCAN + TLOE C,3VP + JRST AVAR2A + MOVSI T,(LINK) ;CAUSE AVAR4B TO REDEFINE AS SAME TYPE. + LSH T,14. + TRNN FF,FRGLOL + JRST AVAR4A +AVAR3A: PUSHJ P,VSM2LV + JUMPGE FF,AVAR2A + PUSHJ P,PDEFPT + MOVEI A,0 + PUSHJ P,PBITS + PUSHJ P,$OUTPT + AOS CLOC + JRST AVAR2A + +AVAR4A: CAIN LINK,DEFGVR_-14. ;DEF VAR, 3VAS2, POINT NOT GLOBAL. + JRST AVAR4B ;VAR GLOBAL, MUST PUNCH DEF SINCE DIDN'T ON PASS1. + 3PUT C,D ;LOCAL, JUST SET 3VP SO DON'T SEE IT NEXT VARIAB. + JRST AVAR2A ;NO NEED TO PUNCH DEF SINCE WAS DEF ON PASS1. + +;;MAIN ;"MAIN" MIDAS ROUTINES: INIT, PS1, PLOD, PS2, PSYMS + ;ALL CALLED WITH JSP A,; ALL GLOBAL + ;RETURN INSTRUCTION FROM JSP IN LOCATION RETURN +PS1: HRRM A,RETURN ;PASS 1, (PASS 1 INITIALIZATION ALREADY DONE), SAVE RETURN + PUSH P,[ASSEM1-1] ;SIMBLK WILL POPJ1. +IFN A1PSW,[SKIPL PRGC + JRST A1PAS1 ;THIS NOT FIRST PROGRAM THIS ASSEMBLY, SET MODE TO 1PASS +] + TRO FF,FRNPSS +IFN ITSSW,JRST SIMBLK ;SELECT SBLK AND ASSEMBLE +IFN DECSW\TNXSW,JRST A.DECRE ;SELECT .DECREL AND ASSEMBLE. + +PS2: HRRM A,RETURN ;PASS 2 (MAIN ROUTINE, PASS 2 INITIALIZATION NOT ALREADY DONE), SAVE RETURN + JUMPL FF,PA2A ;JUMP IF PASS 1 ENDED IN 1PASS MODE + TDO FF,[FLPPSS,,FRPSS2] ;SET PUNCHING PASS AND PASS 2 FLAGS + PUSHJ P,P2INI ;INITIALIZE + JRST ASSEM1 ;START ASSEMBLING + +PA2A: MOVE A,SYMAOB ;PASS 2 OF 1PASS ASSEMBLY, CHECK FOR UNDEFINED LOCALS +PA2C: MOVE SYM,ST(A) ;GET SQUOZE THIS SYMTAB ENTRY + LDB B,[400400,,SYM] ;GET FLAGS + CAIE B,LCUDF_-14. ;LOCAL UNDEFINED? + JRST PA2B ;NOT LOCAL UNDEFINED, DON'T COMPLAIN + 3GET C,A ;LOCAL UNDEFINED, GET 3RDWRD ST ENTRY + TLZ SYM,740000 ;CLEAR OUT FLAGS IN SYM IN ANTICIPATION OF TYPING OUT COMPLAINT + TLNN C,3LLV ;PROBLEM HANDED TO LINKING LOADER? + ETSM [ASCIZ /Undefined/] ;NO +PA2B: ADD A,WPSTE1 ;NOW GO FOR NEXT ST ENTRY + AOBJN A,PA2C + JRST RETURN + +$INIT: HRRM A,RETURN ;INITIALIZATION (BEFORE PASS 1 ONLY) ROUTINE, SAVE RETURN POINT +IFN CREFSW,PUSHJ P,CRFOFF ;DON'T CREF ON 1ST PASS. +IFN LISTSW,CALL LSTOFF ;DON'T LIST ON 1ST PASS. + SKIPGE ISYMF + JRST INIT1 ;SPREAD SYMS (RETURNS TO SP4) + MOVE A,SYMAOB ;ALREADY SPREAD, JUST FLUSH ALL BUT INITIAL SYMS +INIT4: SKIPN B,ST(A) + JRST INIT2 + 3GET C,A + TRNE C,-1 ;INITIAL SYM? + CLEARM ST(A) ;NO +INIT2: ADD A,WPSTE1 + AOBJN A,INIT4 + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1] + BLT A,EBKCOD ;CLEAR OUT BLANK CODE + +SP4: PUSH P,CRETN +P1INI: CLEARB I, LDCCC + INSIRP SETZM,BKBUF ISYMF A.PASS +IFN FASLP,[ + INSIRP SETZM,FASATP FASPCH + CLEARM FASIDX +] + MOVEMM DECTWO,[[MOVE]] + TDZ FF,[FFINIT] ;INITIALIZE MOST FF FLAGS + MOVEIM A.PPASS,2 ;DEFAULT IS 2-PASS. + PUSHJ P,MACINI ;INITIALIZE MACRO STATUS + MOVEI A,PCNTB + MOVEM A,PBCONL + MOVS A,[BKTAB,,P1INI1] + BLT A,BKTAB+4 + MOVEIM BKTABP,BKWPB*2 + +;DROPS IN. +P2INI: INSIRP SETZM,[CPGN,CLNN,GENSM,OFLOC,OFRLOC,CRLOC,BKPDL +SYLOC,SYSYM,BYTW,BYTRLC,STGSW,DECBRK,DEFNPS,BYTM,BYTM1,HKALL,QMTCH] + AOS B,A.PASS +IFN ITSSW,[ + CALL SETWH2 ;SET UP .WHO2, PREPARE .WHO3 IN A WITH PAGENUM=1. + .SUSET [.SWHO3,,A] ;'P1 ',,PAGENUM OR 'P2 ',,PAGENUM + .SUSET [.SWHO1,,[.BYTE 8 ? 166 ? 0 ? 165 ? 0]] +] + TDZ FF,[FLUNRD,,FRGLOL] +IRP X,,[BKWPB,BKCUR,,BKPDL+1,1,BKLVL,IRDEF,ASMI +NCONS,CONCNT,VARTAB,VARPNT,NVARS,VARCNR,1,VECSIZ] +IFE 1&.IRPCN,IFSN [X], MOVEI A,X +IFN 1&.IRPCN, MOVEM A,X +TERMIN + MOVE A,CONTBA + MOVEM A,PLIM + MOVE A,CONGLA + MOVEM A,CONGOL + CLEARM VARCNT + CLEARM PBITS2 + MOVE A,[440300,,PBITS1] + MOVEM A,BITP + MOVEI A,PBITS4 + HRRZM A,PBITS4 + CLEARB I,PBITS1 + MOVEI A,PCNTB + MOVEM A,PBCON + MOVE A,[(LCUDF)++1] ;< AND > FOR COMPATIBILITY WITH OLD + MOVEM A,PCNTB + MOVEM A,CSQZ + MOVEI A,8 + MOVEM A,ARADIX + +IFN ITSSW,[ + MOVEI A,100 + MOVEM A,CLOC +] +.ELSE [ + SETZ A, ; SET LOC COUNTERS APPROPRIATELY + SKIPGE B,CONTRL + TRNE B,DECREL+FASL + JRST [SETZM CLOC ; ASSUME RELOCATABLE + AOS CRLOC ; CRLOC GETS 1 + JRST P2INI5] + TRNE B,DECSAV ; ASSUME ABSOLUTE + MOVEI A,140 + TRNE B,SBLKS + MOVEI A,100 ; IF SBLK FORMAT ASSUME FOR ITS. + MOVEM A,CLOC +P2INI5: +] + SETZM GLOCTP + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,CONTRL ;IN DEC FORMAT, OUTPUT PROGRAM NAME. + TRNE A,DECREL + CALL DECPGN ;CLOBBERS A +IFN FASLP,[ + SETOM FASBLC ;LOSING BLOCK COUNT + MOVE A,CONTRL ;IN FASL FORMAT, OUTPUT FASL HEADER + TRNE A,FASL + CALL FASOIN ;INITIALIZE FASL OUTPUT +] + SETZM DECBRH + TRO FF,FRSYMS+FRFIRWD + MOVE A,[IFORTB,,FORTAB] ;INITIALIZE FORMAT TABLE ON EACH PASS + BLT A,FRTBE + MOVEIM GLSPAS,GLOTB ;INIT. ASSEM1 PDL LEVELS TO BOTTOM. + MOVEMM ASSEMP,[[-LPDL,,PDL]] + MOVEIM ASMDSP,ASSEM3 + SETZM ASMOUT + SETZM CONSTP + SETZM SCNDEP ;NOT IN CONDIT. OR CONSTANT. + SETZM CONDEP + HRRZM P,CONSML ;START OUT IN MULTI-LINE MODE. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + MOVEM A,PNTBP + CLEARM LISTPF + SETOM LISTBC + SKIPG LISTP1 ;IF LIST ON PASS 1 + JUMPGE FF,CRETN ;OR PUNCHING PASS, + SKIPE LISTP ;IF WANT LISTING, + CALL LSTON ;TURN ON OUTPUT OF LISTING. +] +IFN CREFSW,[ + JUMPGE FF,CRETN + SKIPE CREFP ;IF C SWITCH WAS SEEN, + PUSHJ P,CRFON ;TURN ON CREFFING, +] +CRETN: POPJ P,RETURN + +P1INI1: SQUOZE 0,.INIT ? 0 ? 3 + SQUOZE 0,.MAIN ? 1,, + +PLOD: HRRM A,RETURN ;MAIN ROUTINE TO PUNCH LOADER, CALLED BEFORE PASS 2 (PS2"), SAVE RETURN POINT + PUSHJ P,PLOD1 ;PUNCH LOADER + JRST RETURN ;RETURN + + ;PUNCH OUT THE LOADER + +PLOD1: PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE + MOVE B,CONTRL + TRNE B,ARIM10 + JRST PLOD2 ;RIM10 => PUNCH OUT SBLK LOADER FOR PDP10 READIN-MODE READIN + TRNN B,SBLKS + POPJ P, ;NOT SBLK => DON'T PUNCH LOADER +PLOD1A: MOVSI B,SLOAD-SLOADP ;PUNCH SBLK LOADER IN RIM FORMAT + MOVSI C,(DATAI PTR,) +PLOAD1: MOVE A,C + PUSHJ P,PPBA + CAMN C,[DATAI PTR,13] + HRRI C,27 + MOVE A,SLOAD(B) + PUSHJ P,PPBA + AOS C + AOBJN B,PLOAD1 + MOVE A,[JRST 1] + PUSHJ P, PPBA + JRST FEED1 + +PLOD2: MOVSI C,LDR10-ELDR10 ;PUNCH SBLK LOADER FOR PDP10 READIN +PLOD3: MOVE A,LDR10(C) + PUSHJ P,PPBA + AOBJN C,PLOD3 + JRST FEED1 + + ;SBLK LOADER NORMALLY PUNCHED OUT IN RIM FORMAT + +SLOAD: CONO PTR,60 ;0 RESTART POINT (NEW BLOCK) + JSP 14,30 ;1 START POINT, LOOP POINT FOR NEW BLOCK; WAIT FOR DATA WORD READY + DATAI PTR,16 ;GET HEADER + MOVE 15,16 ;INITIALIZE CHECKSUM + JUMPGE 16,16 ;HEADER .GE. 0 => STARTING INSTRUCTION + JSP 14,30 ;5 LOOP POINT FOR NEXT DATA WORD: WAIT FOR READY + DATAI PTR,(16) ;READ IN DATA WORD + ROT 15,1 ;NOW UPDATE CHECKSUM + ADD 15,(16) + AOBJN 16,5 ;LOOP FOR ALL DATA WORDS THIS BLOCK + MOVEI 14,33 ;30 TO RETURN TO 33 + JRST 30 ;WAIT FOR READY THEN GO TO 33 + ;14 JSP AC FOR ROUTINE AT 30 + ;15 CHECKSUM + ;16 AOBJN POINTER (UPDATED HEADER) + CONSO PTR,10 ;30 ROUTINE TO WAIT FOR DATA WORD READY FOR DATAI + JRST 30 + JRST (14) + DATAI PTR,16 ;33 GET CHECKSUM + CAMN 15,16 ;COMPARE WITH CALCULATED + JUMPA 1 ;OK, GO GET NEXT BLOCK (DON'T CHANGE TO JRST OR REAL LOADERS WILL GET CONFUSED) + JRST 4, ;CHECKSUM ERROR +SLOADP==. + +;PDP10 SBLK LOADER +;FOLLOWING CODING ACTUAL WORDS TO BE OUTPUT + ;BY ASSEMBLER, COMPILER, OR WHATEVER +;SHOULD BE EXECUTED BY PDP10 HARDWARE READIN FEATURE +;USES ONLY THE AC'S (BUT ALL OF THEM) + +LDR10: + -17,,0 ;BLKI POINTER FOR READ SWITCH + +LDRC=0 ;CHECKSUM (OK, SO YOU'RE NOT ALLOWED TO LOAD + ;INTO IT DURING HARDWARE READIN, BUT WHO SAYS + ;YOUR PROGRAM CAN'T USE IT?) +OFFSET -.+1 ;BEGIN LOADING INTO 1 AS PER HEADER +LDRGO==. + CONO PTR,60 ;START UP PTR (RESTART POINT) +LDRRD==. + HRRI LDRB,.+2 ;INITIALIZE INDEX +LDRW==. + CONSO PTR,10 ;WAIT FOR WORD TO BE AVAILABLE + JRST .-1 + ROT LDRC,-LDRRD(LDRB) ;BEFORE READING IN HEADER, ROTATE 2 BITS (THEN IGNORE) + ;BEFORE READING IN EACH DATA WORD, ROTATE 1 BIT (FOR UPDATING CHECKSUM) + ;BEFORE READING IN CHECKSUM, ROTATE NOT AT ALL (DON'T ROTATE CALCULATED CHECKSUM) + DATAI PTR,@LDRT1-LDRRD(LDRB) ;READ WORD INTO RIGHT PLACE + ;HEADER => READ INTO C + ;STORAGE WORD => READ INDEXED BY AOBJN POINTER IN A + ;CHECKSUM => READ INTO A FOR COMPARISON WITH C(C) + XCT LDRT1-LDRRD(LDRB) ;EXECUTE RELEVANT T1 ENTRY (MAYBE SKIPS) + XCT LDRT2-LDRRD(LDRB) ;EXECUTE RELEVANT T2 ENTRY (MAYBE JUMPS) +LDRB==. + SOJA ., ;-RD(B) IS 2, 1, AND 0 FOR SUCCESSIVE ENCOUNTERS OF THIS INSTRUCTION + ;USED AS INDEX INTO TABLES, ETC. + + ;TABLE 1 + ;INDIRECTED THROUGH FOR DATAI + ;THEN EXECUTED TO SEE WHAT TO DO WITH READ IN WORD + ;ENTRIES EXECUTED IN REVERSE ORDER + +LDRT1==. + CAME LDRC,LDRA ;COMPARE CHECKSUM WITH CALCULATED, SKIP TO B IF THEY AGREE + ADD LDRC,(LDRA) ;UPDATE CHECKSUM + SKIPL LDRA,LDRC ;INITIALIZE HEADER AND SKIP UNLESS JUMP BLOCK + + ;TABLE 2 + ;EXECUTED IF CORRESPONDING ENTRY IN TABLE 1 DIDN'T SKIP WHEN EXECUTED + +LDRT2==. + JRST 4,LDRGO ;CHECKSUM ERROR + AOBJN LDRA,LDRW ;UPDATE AOBJN POINTER AND GO BACK FOR NEXT STORAGE WORD IF NOT EXHAUSTED +LDRA==. + JRST LDRRD ;WHEN INITIALLY LOADED IS JUMP BLOCK TO THIS LOADER + ;DURING LOADING USED TO HOLD HEADER (AOBJN POINTER), WHICH MAY BE LOADED JUMP BLOCK + +OFFSET 0 +ELDR10==. + +;FLAGS IN SQUOZE OF SYMS TO OUTPUT + +ABSGLO==040000 ;SYM IS GLOBAL (IF RELOCA, SAYS THIS IS BLOCK NAME) +ABSLCL==100000 ;LOCAL +ABSDLI==200000 ;DELETE INPUT (DON'T RECOGNIZE IT IF TYPED IN) +ABSDLO==400000 ;DELETE OUTPUT (DON'T TYPE IT OUT) + +PSYMS: HRRM A,RETURN ;PUNCH OUT SYMBOL TABLE, CALLED AFTER EVERYTHING ELSE, SAVE RETURN POINT + PUSH P,PSYMS ;AT END, POPJ TO RETURN. + TRNE FF,FRSYMS + JRST SYMDMP ;PUNCH SYMS IF NEC. + SKIPL A,CONTRL + JRST SYMDA ;IF RELOCA, PUNCH PROGRAM NAME. + TRNE A,DECSAV ;IF DEC SAVE FORMAT WITHOUT SYMBOLS + JRST SYMDSA ;STILL DUMP START ADDRESS + TRNN A,DECREL + POPJ P, + +PSYMSD: MOVSI A,DECEND + PUSHJ P,DECBLK ;START AN END-BLOCK. + MOVE A,DECTWO ;IN 2-SEG PROGRAMS, + CAME A,[MOVE] + JRST [ CAMG A,DECBRH ;OUTPUT HISEG BREAK + MOVE A,DECBRH + MOVEM A,WRD + MOVEIM WRDRLC,1 + CALL PWRD + MOVEMM WRD,DECBRK + CALL PWRD ;FOLLOWED BY LOSEG BREAK + JRST EBLK] + MOVEMM WRD,DECBRK ;OUTPUT THE PROGRAM BREAK. + MOVEIM WRDRLC,1 + PUSHJ P,PWRD + MOVE A,DECBRA ;OUTPUT HIGHEST ABS. ADDR + CAIG A,140 + SETZ A, ;IF IT'S ABOVE THE JOBDAT AREA. + PUSHJ P,DECWRD + JRST EBLK + +SYMDA: MOVEI A,LPRGN ;NOW PUNCH PROGRAM NAME + DPB A,[310700,,BKBUF] + MOVE A,PRGNM + TLO A,40000 + PUSHJ P,$OUTPT + PUSHJ P,EBLK + TLZ FF,$FLOUT + POPJ P, + + ;DUMP OUT THE SYMBOL TABLE + +SYMDMP: TRZ I,IRCONT ;OK TO END BLOCK + CLEARM GLSP1 + CLEARM GLSP2 + CLEARM WRDRLC + MOVE T,CONTRL + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + CLEARM CLOC + CLEARM BKBUF +IFN FASLP,[ + TRNE T,FASL + JRST SYMDM1 +] +IFN ITSSW,[ + TRNE T,SBLKS ; ON ITS, IF OUTPUTTING IN SBLK FMT + CALL SYMDDB ; THEN OUTPUT A DEBUGGING INFO BLOCK. +] + TRNE T,DECREL + JRST SYMDMD + JUMPL T,SSYMD ;JUMP IF NOT STINK + + MOVEI B,LDDSYM ;LOCAL SYMS BLOCK TYPE + DPB B,[310700,,BKBUF] ;SET BLOCK TYPE + MOVEM B,CDATBC + MOVE B,SYMAOB ;CAUSE SSYMD3 TO LOOK AT ENTIRE SYM TAB. + JRST SSYMDR + +SYMDMD: MOVSI A,DECSYM ;IN DEC FMT, START SYMBOLS BLOCK. + PUSHJ P,DECBLK +SYMDM1: MOVE B,SYMAOB + JRST SSYMDR + +IFN ITSSW,[ + + ; OUTPUT DEBUGGING INFO BLOCK (ITS SBLK ONLY) + +SYMDDB: MOVE A,[-7,,3] ;OUTPUT A "DEBUGGING INFORMATION" BLOCK + MOVE B,A ;UPDATING THE CHECKSUM IN B. + PUSHJ P,PPB + MOVE A,[-6,,1] ;THE BLOCK CONTAINS ONE SUBBLOCK - A "MIDAS INFO" SUBBLOCK. + PUSHJ P,PPBCK + .SUSET [.RXUNAME,,A] ;CONTAINING NAME OF USER, DATE IN DISK FORMAT, + PUSHJ P,PPBCK + SYSCAL RQDATE,[%CLOUT,,A] + .LOSE %LSSYS + PUSHJ P,PPBCK ;AND THE SOURCE FILE NAMES (DEV, FN1, FN2, SNAME). +REPEAT 4,[ + MOVE A,INFB+$F6DEV+.RPCNT + PUSHJ P,PPBCK +] + MOVE A,B + PJRST PPB ; PUNCH OUT CHECKSUM & RETURN +] ;IFN ITSSW, + +;AC ALLOCATIONS DURING PHASE 1 (COMPACTING THE SYMBOL TABLE): + ;AA INITIALLY HAS -SMK,,; INPUT INDEX INTO ST + ;A TEMP + ;B SQUOZE + ;D OUTPUT INDEX INTO SYMTAB + ;CH1 VALUE OF SYM + ;CH2 3RDWRD + +SSYMD: MOVEI D,ST-1 + SETZB C,SMSRTF ;SYMS SORTED => INITIAL SYMS CLOBBERED + MOVE AA,SYMAOB +SSYMD1: SKIPE B,ST(AA) ;GET SYM NAME FROM TABLE + TDNN B,[37777,,-1] ;MAKE SURE NOT EXPUNGED + JRST SSYMDL ;NOT (REALLY) THERE, TRY NEXT + AOS SMSRTF + MOVE CH1,ST+1(AA) ;GET VALUE OF SYM + 3GET CH2,AA ;GET 3RDWRD + TRNE CH2,-1 + TLNE CH2,3KILL+3LLV + JRST SSYMDL ;DON'T PUNCH INITIAL OR KILLED SYMS. + MOVEI A,0 ;INITIALIZE FOR SHIFTING IN FLAGS + LSHC A,4 ;SHIFT FLAGS INTO A + XCT SSYMDT(A) ;DO THE APPROPRIATE THING THIS KIND OF SYMTAB ENTRY + JRST SSYMDL +SSYMD2: LSH B,-4 ;SHIFT SQUOZE BACK TO WHERE IT BELONGS + TLO B,ABSLCL ;SET LOCAL BIT + TLNE CH2,3SKILL + TLO B,ABSDLO ;HALF-KILL SYM + CAIL A,DEFGVR_-16 + TLC B,ABSGLO\ABSLCL ;FOR GLOBAL SYM, SET GLOBAL BIT INSTEAD OF LOCAL BIT, + CAIGE A,DEFGVR_-16 ;AND PUT IT IN THE GLOBAL BLOCK IN THE SYMTAB. + SKIPN PRGNM+BKWPB ;IF ONLY ONE BLOCK IN PROGRAM, PUT ALL SYMS IN GLOBAL BLOCK. + HRRI CH2,0 + PUSH D,B ;STORE NAME OF SYM IN OUTPUT SLOT + PUSH D,CH1 ;STORE VALUE + PUSH D,CH2 ;STORE 3RDWRD +SSYMDL: ADD AA,WPSTE1 + AOBJN AA,SSYMD1 ;LOOP FOR ALL SYMS IN TABLE + MOVSI CH2,4^5 ;1ST BIT TO SORT ON IS TOP BIT, + MOVEI A,ST ;SORT FROM BOTTOM OF SYMTAB + MOVEI B,1(D) ;TO WHERE WE FILLED UP TO. + MOVE CH1,[TDNE CH2,1(A)] ;SORT ON 2ND WD, WDS WITH BIT ON COME FIRST. + MOVE C,[TDNN CH2,1(B)] + JSP AA,SSYMD9 + TLC C,(TDNE#TDNN) ;ON BITS AFTER 1ST, ENTRIES WITH BIT OFF COME FIRST. + TLC CH1,(TDNE#TDNN) + MOVEI AA,SSRTX ;NEED ONLY CHANGE C, CH1 THE FIRST TIME. + JRST SSRTX + +SSYMD9: PUSHJ P,SSRTX ;SORT SYMS ARITHMETICALLY BY VALUE. + MOVNI B,(B) + ADDI B,ST ;SIZE OF AREA OF SYMTAB STILL IN USE. + IDIV B,WPSTE + HRLZI B,(B) ;-<# SYMTAB ENTRIES>,, + MOVE T,CONTRL ; GET CONTRL FOR OUTPUT FMT CHECKS + MOVE A,[SQUOZE 0,GLOBAL] + MOVEM A,BKTAB ;CALL THE .INIT BLOCK "GLOBAL" WHICH IS WHAT DDT WANTS AS TOP BLOCK. + MOVE C,BKTABP + IDIVI C,BKWPB ;# BLOCKS (INCL. GLOBAL BLOCK). + CAIN C,2 ;IF ONLY GLOBAL AND MAIN, TELL BKSRT TO IGNORE MAIN. + SETZM PRGNM+1 + CAIN C,2 + MOVEI C,1 ;IF ONLY GLOBAL AND MAIN, FILE WILL HAVE ONLY 1 BLOCK (GLOBAL). + CAILE C,1 ;IF MORE THAN ONE BLOCK IN FILE, + TRNN T,DECSAV ;AND OUTPUT FORMAT IS DECSAV, + CAIA + ADDI C,1 ;THEN ALLOW FOR ONE MORE "BLOCK" (PGM NAME). + ;NOTE THAT DECSAV FMT REPLACES BLOCKNAME WITH PGM-NAME + ;FOR SINGLE-BLOCK CASE, SO COUNT OF 1 WORKS OK. + MOVSI A,(C) ; <# BLOCKS TO OUTPUT>,, + SUBM B,A ;-<# ENTRIES IN SYMTAB IN FILE>,, + LSH A,1 ;-<# WDS IN SYMTAB IN FILE>,, + TRNE T,DECSAV ; IF OUTPUT FORMAT IS DEC SAV, + JRST [ HRR A,DECSYA ; GET LOC TO STORE SYMS AT + MOVE C,A + MOVE A,[-1,,116-1] ; STORE IT AT .JBSYM + CALL PPB + MOVE A,C + CALL PPB + HRRI A,-1(A) ; SET -<# WDS IN SYMTAB>,, + JRST .+1] + MOVEM A,SCKSUM ;SAVE 1ST WD FOR CHECKSUM (DECSAV IGNORES IT) + PUSHJ P,PPB + PUSHJ P,BKCNT ;PUT -<# SYMS IN BLOCK> IN 3RD WD OF EACH BKTAB ENTRY. + +;DROPS THROUGH. + +;DROPS IN IF ABS, JUMPS HERE IF RELOC. +;NOTE THAT IN ABS ASSEMBLY, B WILL CONTAIN THE CHECKSUM AND +;SHOULD NOT BE CLOBBERED. +SSYMDR: PUSH P,B ;-<# SYMS>,,0 ;IT WILL BE -1(P) + PUSHJ P,BKSRT ;SORT BLOCKS INTO BKTAB1 + MOVE A,BKTAB + CAME A,[SQUOZE 0,GLOBAL] ;IF ABS, WE RENAMED .INIT TO GLOBAL, SO LEAVE IT IN BKTAB1 + SOS D ;ELSE FLUSH .INIT FROM THE END OF BKTAB1. + SETOM 1(D) ;PUT A -1 AT END OF BKTAB1. + MOVE B,SCKSUM ;GET CHKSUM AFTER 1ST WD. (PPBCK WILL UPDATE) + PUSH P,[-1] ;(P) WILL BE BKTAB1 IDX OF NEXT BLOCK TO OUTPUT. +SSYMD3: AOS F,(P) ;F HAS BKTAB1 IDX OF BLOCK. + SKIPGE C,BKTAB1(F) ;BKTAB1 ELT HAS BKTAB IDX OR + JRST SSYMDX ; -1 AFTER LAST BLOCK. + SKIPL LINK,CONTRL + JRST SSYMD7 ;DIFFERENT RTN TO OUTPUT BLOCK NAME IF RELOCA. + TRNE LINK,DECREL+FASL+DECSAV + JRST SSYMD6 ; ALL THESE SKIP OVER SBLK-TYPE BLOCKNAME OUTPUT + MOVE A,BKTAB(C) + PUSHJ P,PPBCK ;OUTPUT BLOCK NAME WITH NO FLAG BITS SET. + HLRZ A,BKTAB+1(C) + SKIPE A + ADDI A,1 ;A GETS 0 FOR GLOBAL BLOCK, ELSE DDT LEVEL (= 1 + MIDAS LEVEL). + HRL A,BKTAB+2(C) ;PUT IN -2* + ADD A,[-2,,] +SSYMG2: PUSHJ P,PPBCK ;OUTPUT -SIZE,,LEVEL WORD OF BLOCK NAME ENTRY. + JRST SSYMD6 + +SSYMD7: MOVE A,BKTAB(C) ;OUTPUT BLOCK NAME IN RELOCATABLE. + TLO A,ABSGLO ;TELL STINK IT'S BLOCK NAME. + PUSHJ P,$OUTPT + HLRZ A,BKTAB+1(C) + SUBI A,1 + PUSHJ P,$OUTPT +SSYMD6: SKIPL C,-1(P) ;AOBJN PTR TO SYMS. + JRST SSYMD8 ;IN CASE NO SYMS. +SSYMD4: HRRZ A,ST+2(C) ;OUPUT ONLY THE SYMS IN THE BLOCK + CAME A,BKTAB1(F) ;NOW BEING HANDLED. + JRST SSYMD5 + SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL + JRST SYMD2 ;SPECIAL IF RELOCA. + MOVE A,ST(C) + TRNE LINK,DECSAV + CALL RSQZA ; RIGHT-JUSTIFY THE SQUOZE (SIGH) + PUSHJ P,PPBCK ;1ST, SQUOZE WITH FLAGS. + MOVE A,ST+1(C) + PUSHJ P,PPBCK ;2ND, VALUE. +SSYMD5: ADD C,WPSTE1 + AOBJN C,SSYMD4 ;HANDLE NEXT SYM. +SSYMD8: TRNN LINK,DECSAV + JRST SSYMD3 ;ALL SYMS FOR THIS BLOCK DONE, DO NEXT BLOCK. + + ; DECSAV FMT HAS BLOCK NAMES OUTPUT LAST. + SKIPN PRGNM+BKWPB ;IF ONLY ONE BLOCK IN PGM, + JRST SSYMD3 ; FORGET IT; PGM-NAME SUBSTITUTES FOR BLKNAME. + MOVE C,BKTAB1(F) ; GET IDX FOR BLOCK + MOVE A,BKTAB(C) ; GET BLOCKNAME WITH FLAGS CLEAR + TLO A,140000 ; SET FLAGS TO SAY SYM IS BLOCKNAME + CALL RSQZA ; RIGHT-JUSTIFY SQUOZE FOR DEC (UGH BLETCH) + CALL PPB + HLRZ A,BKTAB+1(C) ; GET LEVEL OF BLOCK (NO WD COUNTS) + CALL PPB + JRST SSYMD3 + + ; RIGHT-JUSTIFY SQUOZE IN A, PRESERVING FLAGS. + ; (WHICH ASQOZR RTN DOESN'T) + ; CLOBBERS B. +RSQZA: PUSH P,A ; SAVE FLAGS + TLZA A,740000 ; ZAP +RSQZA2: DPB A,[004000,,(P)] ; UPDATE + IDIVI A,50 + JUMPE B,RSQZA2 + POP P,A + POPJ P, + +;PUNCH OUT LOCAL SYM (RELOCATABLE ASSEMBLY) +;NORMALLY OUTPUT SQUOZE W/ FLAGS ? VALUE, +;IF 3LLV SET OUTPUT PHONY NAME (= STE ADDR) ? SQUOZE W/ FLAGS, STINK FIXES IT UP. +SYMD2: LDB A,[400400,,ST(C)] + MOVE CH1,ST+1(C) ;SSYMDT MAY CHANGE CH1. + MOVE CH2,ST+2(C) + XCT SSYMDT(A) ;SKIPS IF SHOULD OUTPUT SYM. + JRST SSYMD5 + TLNE CH2,3KILL + JRST SSYMD5 + MOVE B,ST(C) + TLZ B,740000 + JUMPE B,SSYMD5 ;UNUSED ENTRY. + JUMPL LINK,SYMDEC ;J IF DEC OR FASL FMT + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LEFT HALF + TLNE CH2,3RLR + TLO B,100000 ;RELOCATE RIGHT HALF + TLNE CH2,3SKILL + TLO B,400000 ;HALF-KILL + MOVEI A,ST(C) + TLNE CH2,3LLV ;IF STINK HAS VALUE, + PUSHJ P,$OUTPT ;GIVE STINK NAME STINK KNOWS SYMBOL BY. + TLNE CH2,3LLV ;IF GIVING PHONY NAME, INSURE LOCAL FLAG SET + TLO B,ABSLCL ;(STINK WILL DO SO OTHERWISE) + MOVE A,B + PUSHJ P,$OUTPT ;OUTPUT SYM + MOVE A,CH1 + TLNN CH2,3LLV ;DON'T OUTPUT VALUE IF DON'T KNOW IT. + PUSHJ P,$OUTPT ;OUTPUT VALUE + JRST SSYMD5 + +SYMDEC: IFN FASLP,[ + TRNE LINK,FASL + JRST SYMFSL ;FASL ASSMBLY +] + PUSHJ P,ASQOZR ;RIGHT-JUSTIFY THE SQUOZE, + TLNE CH2,3SKILL + TLO B,ABSDLO ;MAYBE HALFKILL, + TLO B,ABSGLO + LDB A,[400400,,ST(C)] + CAIGE A,DEFGVR_-14. + TLC B,ABSGLO+ABSLCL ;LOCAL SYM, CHANGE GLO TO LCL. + MOVEM B,WRD + PUSH P,C + PUSHJ P,DECPW ;FIRST, THE NAME, + POP P,C + LDB TM,[420200,,ST+2(C)] + MOVE A,ST+1(C) ;THEN THE VALUE AND RELOCATION BITS. + PUSHJ P,DECWR1 + JRST SSYMD5 + +IFN FASLP,[ +SYMFSL: TLO B,400000 ;GET VALUE FROM SECOND WD + TLNE CH2,3RLL + TLO B,200000 ;RELOCATE LH + TLNE CH2,3RLR + TLO B,100000 + CAIL A,LGBLCB_<-18.+4> + TLO B,40000 ;GLOBAL FLAG + MOVE A,B + MOVEI B,15 ;PUTDDTSYM + PUSHJ P,FASO + MOVE A,CH1 + PUSHJ P,FASO1 + JRST SSYMD5 +] + +;XCT INDEXED ON SQUOZE FLAGS; SHOULDN'T PUNCH SYM IF DOESN'T SKIP. +SSYMDT: JFCL ;COM + JFCL ;PSEUDO OR MACRO + CAIA ;SYM, PUNCH OUT + TLNN CH2,3LLV ;LOCAL UNDEFINED, OUTPUT IF STINK HAS VALUE TO TELL STINK WHERE TO PUT IT. + TLZA CH1,-1 ;DEFINED LOCAL VARIABLE, CLEAR OUT LH(VALUE) + JFCL ;UNDEFINED LOCAL VARIABLE + SKIPL CONTRL ;DEFINED GLOBAL VARIABLE, PUNCH OUT IF ABS. + JFCL ;UNDEFINED GLOBAL VARIABLE + SKIPL CONTRL ;GLOBAL ENTRY, PUNCH OUT IF ABS ASSEM. + JFCL ;GLOBAL EXIT, DON'T PUNCH OUT +IFN .-SSYMDT-NCDBTS,.ERR SSYMDT LOSES. + +SSYMDX: SKIPGE LINK,CONTRL + TRNE LINK,DECREL+FASL + JRST SSYMG3 + TRNE LINK,DECSAV ; IN DECSAV FORMAT, + JRST [ MOVE A,PRGNM ; PGM NAME IS LAST THING IN SYMTAB + CALL RSQZA + CALL PPB ; WITH FUNNY VALUE OF + SETZ A, ; -<# SYMTAB WDS USED BY PGM>,, + CALL PPB ; BUT LAST PGM IN SYMTAB MUST HAVE LH=0, SO... + JRST SSYMG3] + MOVE A,B ; SBLK OR RIM ASSEMBLY, OUTPUT CHKSUM. + PUSHJ P,PPB +SSYMG3: SUB P,[2,,2] + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK + SKIPL A,CONTRL ;RELOCATABLE => OUTPUT PROG NAME. + JRST SYMDA +IFN FASLP,[ + TRNE A,FASL + POPJ P, +] + TRNE A,DECREL ;DEC FMT => OUTPUT END BLOCK. + JRST PSYMSD +SYMDSA: MOVE A,STARTA ;NOW GET STARTING INSTRUCTION + JRST PPB ;PUNCH IT OUT AND RETURN + +;PUT INTO BKTAB1 THE BKTAB IDXS OF ALL THE BLOCKS IN THE ORDER THEIR +;SYMS SHOULD BE PUNCHED (A BLOCK'S SUBBLOCKS PRECEDE IT) +;THE .INIT BLOCK (MAYBE BY NOW RENAMED "GLOBAL") GOES IN LAST. D POINTS AT WHERE IT WAS PUT. +; NOTE THAT FOR DECSAV FORMAT THE ORDERING IS REVERSED; A BLOCK'S SUBBLOCKS +; FOLLOW IT, AND THE .INIT BLOCK GOES IN FIRST. + +BKSRT: MOVEI D,BKTAB1-1 ;D IS FOR PUSHING INTO BKTAB1. + MOVSI A,1 ;START WITH BLOCK 0 (OUTERMOST, .INIT). + MOVE LINK,CONTRL + + ;HANDLE BLOCK IN A: LOOK FOR ITS SUBBLOCKS. +BKSR1: TRNE LINK,DECSAV + JRST [ MOVEI C,(A) ? PUSH D,C ? JRST .+1] + SETZ C, +BKSR2: CAME A,BKTAB+1(C) + JRST BKSR3 ;THIS BLOCK ISN'T A SUBBLOCK. + ADD A,[1,,] ;LH HAS SUBBLOCK'S LEVEL. + HRRI A,(C) ;RH HAS SUBBLOCK. + PUSHJ P,BKSR1 ;HANDLE THE SUBBLOCK + MOVE A,BKTAB+1(C) ; RESTORE A (C IS PRESERVED OVER CALL) +BKSR3: ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKSR2 + MOVEI C,(A) ; RESTORE C INDEX BKSR1 WAS ENTERED WITH + TRNE LINK,DECSAV + POPJ P, + PUSH D,C ;PUT THE BLOCK IN BKTAB1 (AFTER SUBBLOCKS) + POPJ P, + +PPBCK: ROT B,1 ;OUTPUT WD IN A, UPDATING CKSUM IN B. + ADD B,A + JRST PPB + +;THE THIRD WORD OF EACH BLOCK'S ENTRY IN BKTAB GETS THE NUMBER OF +;SYMBOLS IN THAT BLOCK (OF THE SYMBOLS THAT WE WILL PUT IN THE SYMTAB). + +BKCNT: PUSH P,B + MOVEI C,0 +BKCNT0: SETZM BKTAB+2(C) ;ZERO 3RD WD OF EACH BKTAB ENTRY. + ADDI C,BKWPB + CAMGE C,BKTABP + JRST BKCNT0 +BKCNT1: MOVE C,ST+2(B) + SOS BKTAB+2(C) ;ADD -2 FOR EACH SYM IN THE BLOCK. + SOS BKTAB+2(C) + ADD B,WPSTE1 + AOBJN B,BKCNT1 +POPBJ: POP P,B + POPJ P, + +SSRTX: HRLM B,(P) ;DO ONE PASS OF RADIX-EXCHANGE. SAVE END. + CAIL A,@WPSTEB ;ONLY 1 ENTRY, NOTHING TO DO. + JRST SSRTX7 + PUSH P,A ;SAVE START. +SSRTX3: XCT CH1 + JRST SSRTX4 ;MOVE UP TO 1ST WITH BIT ON. + SUB B,WPSTE + XCT C ;MOVE DOWN TO LAST WITH BIT OFF. + JRST SSRTX5 + MOVE D,WPSTE + CAIE D,MAXWPS + JRST .+4 +REPEAT MAXWPS,[ + MOVE D,.RPCNT(A) ;EXCHANGE THEM, + EXCH D,.RPCNT(B) + MOVEM D,.RPCNT(A)] +SSRTX4: ADD A,WPSTE +SSRTX5: CAME A,B ;ALL DONE => DO NEXT BIT. + JRST SSRTX3 ;MORE IN THIS PASS. + ROT CH2,-1 ;NEXT BIT DOWN. + POP P,A ;A -> START, B -> END OF 1ST HALF. + JUMPL CH2,SSRTX6 ;ALL BITS IN WD DONE, STOP. + PUSHJ P,(AA) ;DO NEXT BIT ON 1ST HALF. + HLRZ B,(P) ;A -> END OF 1ST HALF, B -> END OF ALL. + PUSHJ P,(AA) ;DO SECOND HALF. +SSRTX6: ROT CH2,1 ;LEAVE CH2 AS FOUND IT. +SSRTX7: HLRZ A,(P) ;LEAVE A -> END OF AREA SORTED. + POPJ P, + +;ARITHMETIC CONDITIONALS (B HAS JUMP A,) + +COND: PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,AGETFD ;GET FIELD TO TEST VALUE OF +CONDPP: POP P,T ;RESTORE CONDITIONAL JUMP INSTRUCTION + HRRI T,COND2 ;HRRI IN JUMP ADDRESS, GO TO COND2 IF CONDITIONAL TRUE + XCT T ;JUMP IF COND T,ASSEMBLE STRING +COND4: SETZM A.SUCC ;MOST RECENT CONDIT. FAILED. +COND5: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WHAT PSEUDO WE'RE IN. + CALL RCH + JSP D,RARL4 ;INIT FOR THE CONDITIONALIZED STUFF. + CAIA + CALL RARFLS ;READ AND IGNORE THE ARG. + JRST MACCR + +ANULL: TLO FF,FLUNRD + JRST COND5 + +;.ELSE, .ALSO - B'S LH WILL HAVE SKIPE OR SKIPN. +A.ELSE: HRRI B,A.SUCC + XCT B + JRST COND4 ;CONDITION FALSE. + JRST COND2 ;TRUE. + +;IF1, IF2 - B'S LH WILL HAVE TRNE FF, OR TRNN FF, +COND1: HRRI B,FRPSS2 + XCT B + JRST COND4 ;NO + ;CONDITION TRUE, ASSEMBLE STRING +COND2: SETOM A.SUCC ;LAST CONDITIONAL SUCCEEDED. +COND6: PUSHJ P,RCH ;GET NEXT CHAR + CAIE A,LBRKT + JRST [ CAIE A,LBRACE + TLO FF,FLUNRD + JRST MACCR] + SKIPN SCNDEP ;BRACKET TYPE CONDITIONAL. + SKIPE CONDEP + JRST COND7 + MOVEMM CONDLN,CLNN ;AT TOP LEVEL, SAVE IN CASE THIS UNTERMINATED + MOVEMM CONDPN,CPGN +IFN TS, MOVEMM CONDFI,INFFN1 +COND7: AOS SCNDEP ;COUNT IT FOR RBRAK'S SAKE. + JRST MACCR + +;IFB, IFNB + +SBCND: PUSH P,B ;SAVE TEST JUMP + SETZB B,C ;C COUNTS SQUOZE CHARS FOR IFB/IFNB + ;B COUNTS NONSQUOZE FOR IFSQ/IFNSQ + JSP D,RARG ;INIT FOR READING OF ARG WHOSE BLANKNESS + JRST CONDPP ;IS TO BE TESTED. + JSP D,RARGCH(T) ;READ 1 CHAR, + JRST CONDPP ;(NO MORE CHARS) + HLRZ A,GDTAB(A) ;GET GDTAB ENTRY + CAIE A,(POPJ P,) ;POPJ => NOT SQUOZE + AOJA C,RARGCH(T) + AOJA B,RARGCH(T) + + ;IFDEF, IFNDEF + +DEFCND: PUSH P,SYM + PUSH P,B ;SAVE CONDITIONAL JUMP + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + PUSHJ P,ES + MOVEI A,0 ;UNDEFINED +IFN CREFSW,XCT CRFINU + CAIN A,GLOEXT_-14. ;GLOBAL EXIT... + SKIPL CONTRL ;DURING ABSOLUTE ASSEMBLY? + CAIN A,3 ;NO, LOCAL UNDEF? + MOVEI A,0 ;ONE OF THESE => UNDEF + REST SYM + EXCH SYM,(P) ;POP SYM OUT FROM UNDER THE CONDITIONAL JUMP. + JRST CONDPP + +;;PWRD ;ROUTINES TO OUTPUT ASSEMBLES WORDS AND PORTIONS THEREOF + + ;HERE FROM PBITS TO OUTPUT WORD OF CODE BITS + +PBITS3: PUSH P,A + MOVEI A,14 + MOVEM A,PBITS2 ;INITIALIZE PBITS2 FOR COUNTING DOWN THROUGH NEXT SET OF CODE BITS + MOVE A,[440300,,PBITS1] + MOVEM A,BITP ;SET UP BITP FOR RELOADING PBITS1 WITH CODE BITS + MOVE A,PBITS1 ;NOW GET ACCUMULATED WORD OF BITS + MOVEM A,@PBITS4 ;STORE IN BKBUF + AOS A,OPT1 ;RESERVE SPACE FOR NEW WORD + ;IF FRBIT7 SET (LAST CALL TO PBITS HAD 7) THEN NEXT WORD OF CODE BITS GOES + ;AFTER NEXT WORD OUTPUT (REALLY!), OTHERWISE BEFORE + TRNN FF,FRBIT7 + SOSA A + TRO FF,FRINVT + HRRZM A,PBITS4 + POP P,A + CLEARM PBITS1 + ;DROPS THROUGH + ;OUTPUT RELOCATION CODE BITS IN A + +PBITS: SKIPGE CONTRL + POPJ P, ;NOT RELOCATABLE + SOSGE PBITS2 + JRST PBITS3 ;NO MORE ROOM IN WORD, OUTPUT IT AND TRY AGAIN + CAIN A,7 + TROA FF,FRBIT7 + TRZ FF,FRBIT7 + IDPB A,BITP + POPJ P, + + ;FOLLOWING ROUTINES SAVE AC'S EXCEPT FOR A + +OUTSM0: MOVE A,SYM ;OUTPUT NAME STINK KNOWS SYMBOL BY. + TLZ A,37777 ;FOR LOCALS, THAT'S THE STE ADDR, + HRRI A,ST(D) + TLNN SYM,40000 ;FOR GLOBALS, THAT'S THE SQUOZE. + JRST $OUTPT +OUTSM: SKIPA A,SYM +OUTWD: MOVE A,WRD +$OUTPT: SKIPGE CONTRL ;DIRECTLY PUNCH OUT WORD IN A IN RELOCATABLE ASSEMBLY ONLY + POPJ P, ;DO NOTHING IF ABSOLUTE ASSEMBLY + PUSH P,AA + MOVE AA,OPT1 + TRZN FF,FRINVT ;SKIP IF BEING HACKED FROM PBITS3, PUT WORD BEFORE WHERE IT NORMALLY BELONGS + AOS AA + MOVEM A,-1(AA) + MOVE A,CLOC + TRZE FF,FRFIRWD + HRRM A,BKBUF + POP P,AA + AOS A,OPT1 + CAIL A,BSIZE+BKBUF + TRNE I,IRCONT + POPJ P, + ;MAY DROP THROUGH + +;END CURRENT OUTPUT BLOCK + +EBLK: PUSH P,T + PUSH P,TT + PUSH P,A + PUSH P,B + MOVE T,CONTRL + JUMPGE T,EBLK3 ;JUMP IF RELOCATABLE ASSEMBLY + TRNE T,ARIM10\SBLKS + JRST ESBLK + TRNE T,DECSAV + JRST EDSBLK +IFN FASLP,[ + TRNE T,FASL + JRST FASLE ;FASL HAS NO BLOCKS TO END - IGNORE +] + TRNE T,DECREL + JRST DECEBL + JRST EBLK5 + +EBLK3: MOVE T,PBITS1 + MOVEM T,@PBITS4 + MOVEI T,PBITS4 + MOVEM T,PBITS4 + MOVE T,[440300,,PBITS1] + MOVEM T,BITP + CLEARB TT,PBITS2 + CLEARM PBITS1 + MOVEI T,BKBUF + MOVE B,OPT1 ;GET POINTER TO END OF BLOCK + SUBI B,BKBUF+1 ;CONVERT TO # WORDS IN BLOCK (EXCLUDING HEADER) + DPB B,[220700,,BKBUF] ;SET COUNT FIELD IN HEADER + TRZN FF,FRLOC + JUMPLE B,EBLK5 ;IGNORE NULL BLOCK UNLESS FRLOC SET + TLO FF,$FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) + PUSHJ P,FEED +EBK1: CAML T,OPT1 ;DONE WITH BLOCK? + JRST EBK2 ;YES + MOVE A,(T) ;NO, GET DATA WORD + JFCL 4,.+1 ;UPDATE CHECKSUM + ADD TT,A + JFCL 4,[AOJA TT,.+1] + PUSHJ P,PPB ;OUTPUT WORD + AOJA T,EBK1 +EBK2: SETCM A,TT ;DONE OUTPUTTING BLOCK, NOW GET CHECKSUM + PUSHJ P,PPB ;OUTPUT CHECKSUM + MOVE T,CDATBC ;GET BLOCK TYPE + DPB T,[310700,,BKBUF] ;SET NE T BLOCK TYPE TO STORAGE WORDS BLOCK TYPE + MOVEI T,BKBUF+1 + MOVEM T,OPT1 +EBLK4: TLO FF,$FLOUT ;INDICATE THAT OUTPUT HAS OCCURED (FOR 1PASS MULTIPLE-ASSEMBLY HACKING) +EBLK5: TRO FF,FRFIRWD +FASLE: POP P,B + POP P,A +PTT.TJ: POP P,TT + POP P,T + POPJ P, + +;PUNCH OUT WORD OF CODED DATA (E.G. STORAGE WORD); WRD, WRDRLC, GLOTB ENTRIES + +PWRDA: TROA FF,FRNLIK ;SUPPRESS ADR LINKING +PWRD: TRZ FF,FRNLIK ;PERMIT ADR LINKING +IFN LISTSW,[ + SKIPN LSTONP + JRST PWRDL ;NOT MAKING LISTING NOW. + SKIPGE LISTPF + PUSHJ P,PNTR + SETOM LISTPF + MOVE LINK,WRD + MOVEM LINK,LISTWD + MOVE LINK,WRDRLC + MOVEM LINK,LSTRLC + MOVE LINK,CLOC + MOVEM LINK,LISTAD + MOVE LINK,CRLOC + DPB LINK,[220100,,LISTAD] +PWRDL: +] ;END IFN LISTSW, + JUMPGE FF,CPOPJ ;IGNORE IF NOT PUNCHING PASS + SKIPGE LINK,CONTRL + JRST PWRD1 ;ABSOLUTE ASSEMBLY + ;RELOCATABLE ASSEMBLY + PUSHJ P,$RSET ;CHECK VALIDITY OF RELOCATION, STANDARDIZE IF NON-STANDARD + MOVE A,GLSP2 + CAMN A,GLSP1 + JRST PWRD2 ;NO GLOBALS + + ;NOW TO SEE IF IT'S POSSIBLE OR DESIRABLE TO ADDRESS LINK + + HRLZ B,WRD + HRR B,WRDRLC + JUMPN B,PWRD3 ;JUMP IF RH NON-ZERO + TRNN FF,FRNLIK + SKIPGE GLOCTP + JRST PWRD3 ;ADR LINKING SUPPRESSED OR CLOC GLOBAL + SKIPE LDCCC + JRST PWRD3 ;IN LOAD TIME CONDITIONALS + MOVNI T,1 ;INITIALIZE T FOR COUNTING +PWRD4: CAML A,GLSP1 + JRST PWRD5 ;DONE + HRRZ TT,1(A) ;GET GLOTB ENTRY + JUMPE TT,PWRD7A + LDB TT,[400400,,(TT)] ;GET SQUOZE FLAGS FROM SYM + CAIE TT,DEFGVR_-14. + CAIN TT,GLOETY_-14. + JRST PWRD3 ;DEFINED, BUT MUST BE HERE FOR A REASON (SEE $.H) + HLRZ TT,1(A) + TRNE TT,1777+MINF + JRST PWRD3 ;NEGATED OR MULTIPLIED + TRNE TT,HFWDF + JRST PWRD7 + TRNE TT,ACF + TRNN TT,SWAPF + JRST PWRD3 ;NOT HIGH AC +PWRD7A: AOJA A,PWRD4 +PWRD7: TRNE TT,SWAPF + AOJA A,PWRD4 ;LEFT HALF + AOJN T,PWRD3 ;JUMP IF THIS NOT FIRST GLOBAL IN RIGHT HALF + MOVEI D,1(A) ;FIRST GLOBAL, SET UP POINTER TO GLOTB ENTRY + AOJA A,PWRD4 + +PWRD5: AOJE T,PWRD3 ;NO GLOBALS LOOK BAD AND THERE AREN'T TOO MANY; JUMP IF NONE IN RH + HRRZ T,(D) ;GET ADR OF SQUOZE + SKPST T, ;SKIP IF IN SYMBOL TABLE + JRST PWRD3 ;BELOW SYMBOL TABLE, DON'T ADDRESS LINK AFTER ALL + PUSH P,T ;HOORAY, WE CAN ADDRESS LINK + SETZM (D) ;CLEAR OUT GLOTB ENTRY, DON'T NEED IT ANY MORE + PUSHJ P,PWRD31 ;DUMP OUT THE OTHER GLOBALS + POP P,D ;GET ST ADR OF THIS AGAIN + 3GET1 A,D + LDB A,[.BP (3RLNK),A] + MOVE B,WRDRLC + TLNE B,1 + TRO A,2 ;RELOCATE LEFT HALF + PUSHJ P,PBITS ;PUNCH OUT APPROPRIATE BITS FOR LINK LIST ENTRY + HLR A,1(D) ;GET ADR OF LAST + HLL A,WRD + PUSHJ P,$OUTPT ;OUTPUT WORD WITH RH = ADR OF LAST RQ FOR SYM TO PUT IN RH'S + MOVE A,CLOC ;NOW UPDATE ST ENTRY + HRLM A,1(D) + 3GET1 B,D + SKIPN CRLOC + TLZA B,3RLNK ;CLOC NOT RELOCATED LAST TIME THIS SYM USED + TLO B,3RLNK ;RELOCATED + 3PUT1 B,D + POPJ P, + +PWRD31: MOVE T,GLSP2 ;DUMP ALL GLO S IN GENERAL FORMAT +PWRD3A: CAML T,GLSP1 + POPJ P, + MOVE B,1(T) + TRNN B,-1 + AOJA T,PWRD3A + TLNE B,1777 + JRST RPWRD ;REPEAT +RPWRD1: LDB A,[.BP (MINF),B] + TRO A,4 + PUSHJ P,PBITS + MOVE A,(B) ;CODEBITS +SQUOZE FOR SYM + HLRZ C,A + TLZ A,740000 + CAIL C,DEFGVR + TLOA A,40000 ;SYM IS GLO + JRST [ + MOVEI C,(B) ;IF WE ARE OUTPUTTING A REFERENCE TO THE + CAIL C,PCNTB ;"LABEL" AT THE BEGINNING OF A CONSTANTS AREA + CAIL C,PCNTB+NCONS*3 ;(BECAUSE THIS IS A 1PASS ASSEMBLY) USE THE + MOVEI A,(B) ;NAME, SINCE THE SYMBOL ISN'T IN THE + JRST .+1] ;SYMTAB + TLNE B,SWAPF + TLO A,400000 + TLNE B,ACF + JRST PWRD3E ;AC HIGH OR LOW + TLNN B,HFWDF + JRST PWRD3F ;ALL THROUGH + TLO A,100000 + TLNE B,SWAPF + TLC A,300000 +PWRD3F: PUSHJ P,$OUTPT + AOJA T,PWRD3A + + + +RPWRD: PUSHJ P,PBITS7 + MOVEI A,CRPT + PUSHJ P,PBITS + LDB A,[221200,,B] + PUSHJ P,$OUTPT + JRST RPWRD1 + +PWRD3E: TLO A,300000 + JRST PWRD3F + +PWRD3: PUSHJ P,PWRD31 +PWRD2: PUSHJ P,RCHKT + HRRZ A,B + DPB T,[10100,,A] + PUSHJ P,PBITS + JRST OUTWD + +;CHECK FOR VALIDITY OF RELOCATION BITS OF CURRENT WORD +;LEAVE RELOC (RH) IN B, RELOC (LH) IN T + +RCHKT: HRRZ B,WRDRLC ;CHECK FOR RELOC. OTHER THAN 0 OR 1. + HLRZ T,WRDRLC + TRZN B,-2 + TRZE T,-2 +RLCERR: ETSM [ASCIZ /Illegal relocation/] + POPJ P, + +RMOVET: ROT T,-1 + DPB B,[420100,,T] + TLZ C,3DFCLR ;SET RELOC BITS IN C + IOR C,T ;FROM B AND T. + POPJ P, + + ;CHECK WRDRLC FOR VALIDITY (CAPABILITY OF BEING PUNCHED OUT) + ;IF STANDARD THEN JUST RETURN + ;IF NON-STANDARD BUT OTHERWISE OK, PUT $R. ON GLOBAL LIST, RESET WRDRLC, AND RETURN + ;LEAVES B AND C SET UP WITH RH, LH OF WRDRLC. + +$RSET: MOVE C,WRDRLC ;GET RELOCATION + ADDI C,400000 ;WANT TO SEPARATE HALFWORDS + HLRE B,C ;GET LH IN B + HRREI C,400000(C) ;GET RH IN C (WILL EXCHANGE LATER) + MOVE A,[SWAPF+HFWDF,,$R.H] ;PUT THIS ON GLOBAL LIST IF LH NEEDS $R. + TRNE B,-2 ;CHECK LH + PUSHJ P,$RSET1 ;LH NEEDS GLOBAL REFERENCE + EXCH B,C + HRLI A,HFWDF + TRNE B,-2 ;CHECK RH + PUSHJ P,$RSET1 ;RH NEEDS GLOBAL REFERENCE + HRLZM C,WRDRLC ;RELOC OF LH + ADDM B,WRDRLC ;COMPLETE SETTING UP WRDRLC + POPJ P, + +$RSET1: JUMPGE B,$RSET2 ;STRANGE RELOCATION IN B, JUMP IF NON-NEGATIVE + MOVN T,B ;NEGATIVE, GET MAGNITUDE + TLOA A,MINF ;SET FLAG TO NEGATE GLOBAL +$RSET2: SOSA T,B ;POSITIVE, GET ONE LESS THAN IT IN T + TDZA B,B ;NEGATIVE, CLEAR B, RELOCATION LEFT OVER + MOVEI B,1 ;POSITIVE, SET RELOCATION LEFT OVER TO 1 + CAIN T,1 + MOVEI T,0 ;MULTIPLYING BY TWO OR SUBTRACTING TIMES 1 + TRNE T,-2000 + ETSM [ASCIZ /Relocation too large/] ;TOO BIG EVEN FOR $RSET + DPB T,[221200,,A] ;LOOKS OK, STORE TIMES FIELD IN $R. REFERENCE + AOS GLSP1 ;NOW PUT $R. ON GLOBAL LIST + MOVEM A,@GLSP1 + POPJ P, + +;PWRD DURING ABSOLUTE ASSEMBLY + +PWRD1: TRNE LINK,DECREL ; DEC REL FMT IS CONSIDERED ABSOLUTE. + JRST DECPW +IFN FASLP,[ + TRNE LINK,FASL + JRST FASPW ;SO IS FASL +] + MOVE A,GLSP1 + CAME A,GLSP2 + ETR ERRILG ;GLOBALS APPEARING ILLEGALLY + SKIPE WRDRLC + ETR ERRIRL ;RELOCATION APPEARING ILLEGALLY + TRNE LINK,ARIM + JRST PRIM ;RIM + TRNE LINK,DECSAV + JRST DSBLK1 +SBLKS1: MOVE A,WRD ;SBLK + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FRFIRWD + MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER + AOS A,OPT1 + CAIGE A,BKBUF+BSIZE + POPJ P, ;BKBUF NOT FULL YET + +SBLKS2: SUBI A,BKBUF+1 + JUMPE A,CPOPJ + MOVNS A + HRLM A,BKBUF + PUSHJ P,FEED + MOVEI T,BKBUF + CLEARM SCKSUM +SBLK1: CAML T,OPT1 + JRST SBLK2 + MOVE A,SCKSUM + ROT A,1 + ADD A,(T) + MOVEM A,SCKSUM + MOVE A,(T) + PUSHJ P,PPB + AOJA T,SBLK1 + +SBLK2: TRO FF,FRFIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + MOVE A,SCKSUM + JRST PPB + +ESBLK: MOVE A,OPT1 + CAIN A,BKBUF+1 + JRST EBLK5 ;AVOID SETTING $FLOUT IF NULL BLOCK. + PUSHJ P,SBLKS2 + JRST EBLK4 + +PRIM: MOVSI A,(DATAI PTR,) + HRR A,CLOC + PUSHJ P,PPB + MOVE A,WRD + JRST PPB + +; COME HERE TO OUTPUT WD IN ABSOLUTE DEC FMT (DECSAV) + +DSBLK1: MOVE A,WRD + MOVEM A,@OPT1 ;STORE WRD IN BKBUF + MOVE A,CLOC + TRZE FF,FRFIRWD + MOVEM A,BKBUF ;FIRST WORD OF BLOCK, SET UP HEADER + AOS A,OPT1 + CAIGE A,BKBUF+BSIZE + POPJ P, ;BKBUF NOT FULL YET, RETURN + +DSBLK2: SUBI A,BKBUF+1 + JUMPE A,CPOPJ + MOVNS A + SOS BKBUF ; DEC "IOWD" FMT, POINT AT LOC-1 + HRLM A,BKBUF + PUSHJ P,FEED + MOVEI T,BKBUF +DSBLK3: CAML T,OPT1 + JRST DSBLK4 + MOVE A,(T) + PUSHJ P,PPB + AOJA T,DSBLK3 + +DSBLK4: TRO FF,FRFIRWD + MOVEI A,BKBUF+1 + MOVEM A,OPT1 + POPJ P, + +; END A BLOCK IN DEC SAV FMT, COME HERE FROM EBLK. + +EDSBLK: MOVE A,OPT1 + CAIN A,BKBUF+1 + JRST EBLK5 ;AVOID SETTING $FLOUT IF NULL BLOCK. + PUSHJ P,DSBLK2 + JRST EBLK4 + + +;END A BLOCK IN DEC FMT. COME FROM EBLK. +DECEBL: PUSH P,[EBLK5] +DECEB1: MOVSI A,DECWDS ;JUST INIT. AN ORDINARY BLOCK, + +;COME HERE TO OUTPUT PREVIOUS BLOCK AND START NEW BLOCK OF TYPE IN LH OF A. +DECBLK: PUSH P,A + HRRZ A,BKBUF ;GET DATA-WORD COUNT OF CURRENT BLOCK. + JUMPE A,DECB1 ;NO WORDS => CAN IGNORE. + MOVEI TT,BKBUF+1 +DECB0: MOVE A,-1(TT) ;GET AND PUNCH NEXT WD OF BLOCK. + PUSHJ P,PPB + CAME TT,OPT1 ;STOP WHEN NEXT WD ISN'T IN BLOCK. + AOJA TT,DECB0 +DECB1: POP P,A + HLLZM A,BKBUF ;PUT BLOCK TYPE IN LH OF HEADER, DATA WD COUNT IN RH IS 0. + MOVEI TT,BKBUF+2 ;ADDR OF PLACE FOR 1ST DATA WD + MOVEM TT,OPT1 ;(LEAVE SPACE FOR WD OF RELOC BITS) + MOVE TT,[440200,,BKBUF+1] + MOVEM TT,BITP ;BP FOR STORING PAIRS OF RELOC BITS. + SETZM BKBUF+1 ;CLEAR THE WD OF RELOC BITS. + TLO FF,$FLOUT + POPJ P, + +;COME HERE TO OUTPUT A WORD IN DEC FORMAT. +DECPW: MOVS A,BKBUF + CAIE A,DECWDS ;BEFORE THE 1ST STORAGE WD IN ORDINARY BLOCK, + JRST DECPW0 + MOVE A,CRLOC ;MUST GO THE LOCATION CTR. + IDPB A,BITP + MOVE A,CLOC + MOVEM A,@OPT1 + AOS OPT1 + AOS BKBUF ;IT COUNTS AS DATA WORD. +DECPW0: MOVE A,BITP + TLNE A,77^4 ;IF NO ROOM FOR MORE RELOC BITS, + JRST DECPW1 + HLLZ A,BKBUF ;START A NEW BLOCK. + PUSHJ P,DECBLK + JRST DECPW + +DECPW1: PUSHJ P,$RSET ;SET UP RELOC BITS OF HALVES IN B,C. + LSH C,1 + IORI B,(C) ;COMBINE THEM. + MOVE A,GLSP1 + CAME A,GLSP2 + JRST DECPG ;GO HANDLE GLOBALS. +DECPW3: IDPB B,BITP ;STORE THE RELOC BITS + MOVE A,WRD +DECPW2: MOVEM A,@OPT1 ;AND THE VALUE. + AOS OPT1 + AOS BKBUF + POPJ P, + +;PUT A WORD DIRECTLY INTO DEC FMT BLOCK. +DECWRD: SETZ TM, +DECWR1: IDPB TM,BITP ;SKIP A PAIR OF RELOC BITS, + JRST DECPW2 ;STORE THE WORD. + +;HANDLE GLOBAL REFS IN DEC FMT. +DECPG: PUSHJ P,DECPW3 ;FIRST, OUTPUT THE WORD, +DECPG0: MOVSI A,DECSYM + PUSHJ P,DECBLK ;THEN STRT A SYMBOLS BLOCK. + MOVE C,GLSP2 + PUSH P,SYM +DECPG1: CAMN C,GLSP1 ;ALL DONE => + JRST DECPG2 ;GO START AN ORDINARY BLOCK FOR NEXT WD. + MOVE A,BITP + TLNN A,77^4 ;BLOCK FULL => START ANOTHER. + JRST DECPG0 + AOS C,GLSP2 ;GET ADDR OF NEXT GLOBAL REF. + MOVE B,(C) + MOVE B,(B) ;GET NAME OF SYM. + TLZ B,740000 + CAMN B,[SQUOZE 0,$R.] + JRST DECPG3 ;(DEC'S LOADER HAS NO SUCH HACK.) + CALL ASQOZR ;RIGHT-JUSTIFY THE SQUOZE FOR DEC SYSTEM. + MOVE A,B + TLO A,600000 ;PUT IN FLAGS SAYING ADDITIVE GLOBAL RQ. + PUSHJ P,DECWRD ;OUTPUT NAME. + HRRZ A,CLOC ;GET ADDR OF RQ, + TLO A,400000 ;MACRO-10 SETS THIS BIT SO I WILL. + MOVE B,(C) + TLNE B,SWAPF ;SWAPPED => TELL LOADER.. + TLO A,200000 + TLNE B,ACF+MINF + ETSM ERRILG ;CAN'T NEGATE GLOBAL OR PUT IN AC. + MOVE TM,CRLOC + PUSHJ P,DECWR1 ;OUTPUT 2ND WD, + JRST DECPG1 ;GO BACK FOR MORE GLOBAL REFS. + +DECPG2: REST SYM + JRST DECEB1 + +DECPG3: ETR ERRIRL ;WE NEEDED $R. BUT DIDN'T HAVE IT. + JRST DECPG1 + +ERRILG: ASCIZ /Illegal use of external/ +ERRIRL: ASCIZ /Illegal use of relocatables/ + + +;OUTPUT PROGRAM NAME BLOCK (AT START OF PASS 2) +;IF 2-SEG PROGRAM, ALSO OUTPUT A TYPE-3 BLOCK (LOAD INTO HISEG) +DECPGN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2. + PUSH P,[EBLK] + MOVSI A,DECNAM + CALL DECBLK + MOVE B,PRGNM + CALL ASQOZR + MOVE A,B + CALL DECWRD + MOVSI A,14 ;IDENTIFY THIS REL FILE AS MADE BY MIDAS. + CALL DECWRD + MOVE A,DECTWO + CAMN A,[MOVE] + RET ;NOT A 2-SEG PROGRAM. +DECP2S: MOVSI A,DECHSG + CALL DECBLK ;START A LOAD-INTO-HISEG BLOCK. + MOVE A,DECTWO + HRL A,DECBRH ;HISEG BRK,,TWOSEG ORIGIN. + SKIPL A + HRLI A,(A) + MOVEI TM,1 ;RELOCATION IS 1. + JRST DECWR1 + +IFN FASLP,[ +;INITIALIZE OUTPUT FOR FASL ASSEMBLY +FASOIN: JUMPGE FF,CPOPJ ;ONLY ON PASS 2 + MOVE A,[SIXBIT /*FASL*/] + PUSHJ P,PPB + MOVE A,[MIDVRS] + LSH A,-6 + TLO A,(SIXBIT /M/) + PUSHJ P,PPB ;"LISP" VERSION NUMBER (USE M AND MIDAS NUMBER) + MOVE A,[440400,,FASB] ;INITIALIZE FASL OUTPUT BUFFER + MOVEM A,FASCBP + MOVEI A,FASB+1 + MOVEM A,FASBP + POPJ P, + + +;COME HERE TO OUTPUT A WORD IN FASL FORMAT +FASPW: MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;"PUNCH" OUT ATOM TBL (IF MORE HAS APPEARED) + PUSHJ P,$RSET ;GET RELOC + PUSH P,C ;SAVE LH RELOC + MOVEM B,FASPWB ;B HAS RELOC, WHICH IS ALSO FASL CODE FOR RELOC =1 + MOVE A,GLSP2 +FASPW3: CAME A,GLSP1 + JRST FASPW1 ;LOOK TO SEE .. +FASPW2: MOVE A,WRD ;B HAS RELOC, WHICH ALSO HAPPENS TO BE FASL CODE TYPE + MOVE B,FASPWB + PUSHJ P,FASO ;OUTPUT WORD IN A WITH FASL CODE IN B + POP P,TM + JUMPE TM,FASPW5 ;NO LEFT HALF RELOC, OK + MOVNI A,1 ;ACTIVATE FASL HACK FOR LH RELOC + MOVEI B,7 ;WOULD OTHERWISE BE GETDDTSYM + PUSHJ P,FASO +FASPW5: MOVE C,GLSP2 +FASPW6: CAMN C,GLSP1 + POPJ P, + HRRZ TM,1(C) + JUMPE TM,[AOJA C,FASPW6] + MOVE SYM,(TM) ;GET SQUOZE OF SYM + TLZ SYM,740000 ;CLEAR CODE BITS + HLRZ D,1(C) + TRZ D,400000 ;DONT WORRY ABOUT THAT BIT + TRZE D,MINF + TLO SYM,400000 ;NEGATE + CAIN D,SWAPF + JRST FSPWSW + CAIN D,HFWDF + JRST FSPWRH + CAIN D,ACF+SWAPF + JRST FSPWAC + JUMPE D,FSPWWD + ETSM [ASCIZ /Global in illegal FASL context/] + +FSPWWD: TLOA SYM,140000 +FSPWAC: TLOA SYM,100000 +FSPWRH: TLO SYM,40000 +FSPWSW: MOVE A,SYM + MOVEI B,7 ;DDT SYM + PUSHJ P,FASO + AOJA C,FASPW6 + +FASPW1: HRRZ TM,1(A) ;GLOTB ENTRY + JUMPE TM,FASPW4 + CAIL TM,AFDMY1 + CAIL TM,AFDMY2 +FASPW4: AOJA A,FASPW3 + MOVE C,1(A) ;ITS A LIST STRUCTURE REF + TLNN C,-1-HFWDF + SKIPE FASPWB + ETA [ASCIZ /Illegal LISP structure reference/] + MOVE TM,AFDMY2-AFDMY1(TM) ;GET FASL BITS + MOVEM TM,FASPWB ;FASL BITS + CLEARM 1(A) ;FLUSH THAT GUY + AOJA A,FASPW3 + +FPATB: CAMN C,FASATP ;PUNCH OUT ATOM TBL, AMT ALREADY PUNCHED IN C + POPJ P, ;THRU + MOVEI B,12 ;ATOM TBL INFO + MOVE A,FASAT(C) + TRNN A,-1 + AOJA C,FPATB3 ;LIST WORD .. SHOULD HAVE PUNCHED ITSELF + PUSHJ P,FASO + HRRZ D,FASAT(C) ;ATOM "LENGTH" + AOS C +FPATB1: SOJL D,FPATB2 + MOVE A,FASAT(C) + PUSHJ P,FASO1 + AOJA C,FPATB1 + +FPATB3: ETR [ASCIZ /Internal loss at FPATB3/] +FPATB2: MOVEM C,FASPCH ;RECORD AMOUNT PUNCHED + JRST FPATB ;LOOP BACK IF MORE + + +FASO: PUSHJ P,FASBO ;WRITE BITS +FASO1: MOVEM A,@FASBP ;STORE A IN FASL OUTPUT BUFFER + AOS TM,FASBP + CAIL TM,FASB+FASBL + ETF [ASCIZ /.FASL output block too long/] + POPJ P, + +FASBO: MOVE TM,FASCBP ;OUTPUT FASL CODEBITS IN B, WRITE PREV BLOCK IF NECC + TLNN TM,770000 + PUSHJ P,FASBE ;WRITE PREV FASL BLOCK + IDPB B,FASCBP + POPJ P, + +FASBE: PUSH P,A + PUSH P,B + MOVEI TT,FASB +FASBO2: CAML TT,FASBP + JRST FASBO3 + MOVE A,(TT) + PUSHJ P,PPB + AOJA TT,FASBO2 + +FASBO3: POP P,B + POP P,A + CLEARM FASB ;NEW CODE WORD + MOVEI TM,FASB+1 + MOVEM TM,FASBP + SOS FASCBP + POPJ P, + +AFATOM: PUSH P,B ;SAVE CODEBITS + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ATOM illegal except in FASL assembly/] + PUSHJ P,AFRATM ;READ "ATOM", RETURN INDEX IN A + POP P,B + HLRZS B +AFLST1: AOS GLSP1 + MOVEI T,AFDMY1(B) ;DUMMY (STORE THIS INFO IN SYM SO CONSTANTS WILL WIN + HRRZM T,@GLSP1 + MOVEI B,0 ;NO RELOCATION + POPJ P, + +;GLOBALS IN THIS TABLE KEEP TRACK OF LIST REFS +;UNDEF GLOBAL GODEBITS +AFDMY1: SQUOZE 44,.%VCEL ;EVENTUALLY POINT TO VALUE CELL + SQUOZE 44,.%SCAL ;EVENTUALLY BECOME "SMASHABLE CALL" + SQUOZE 44,.%ATM ;EVENTUALLY POINT TO ATOM + SQUOZE 44,.%ARY ;EVENTUALLY POINT TO ARRAY +AFDMY2: 2 ;CODE BITS FOR VALUE CELL REF + 3 ;CODE BITS FOR SMASHABLE CALL + 4 ;CODE BITS FOR POINTER TO ATOM + 10 ;CODE BITS FOR POINTER TO ARRAY + +AFRATM: PUSHJ P,AFRTKN ;READ TOKEN, LEAVING IT AT END OF FASAT + PUSHJ P,AFRITN ;"INTERN" IT, SKIP IF NOT FOUND + POPJ P, ;IF FOUND, INDEX IN A + PUSHJ P,AFRENT ;ENTER IN FASAT + POPJ P, + +AFRENT: MOVE A,FASAT1 ;STORE FASAT1 IN FASATP + MOVEM A,FASATP + AOS A,FASIDX ;RETURN LOAD TIME ATOM INDEX + POPJ P, + +AFRTKN: MOVE A,FASATP + ADD A,[700,,FASAT] + MOVEM A,FASAT2 ;BYTE PNTR TO USE TO STORE ATOM + CLEARM (A) + CLEARM 1(A) ;MAKE SURE ALL LOW BITS CLEARED + PUSHJ P,RCH + CAIN A,"# + JRST AFRTK1 ;READ NUMBER INTO FIXNUM SPACE + CAIN A,"& + JRST AFRTK2 ;READ NUMBER INTO FLONUM SPACE +AFRTKL: IDPB A,FASAT2 ;STORE CHAR + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 +AFTERR: ETA [ASCIZ /LISP atom name table full/] + CLEARM 1(A) +AFRTL2: PUSHJ P,RCH + CAIN A,12 + JRST AFRTL2 ;IGNORE LF IN ATOM NAMES (PRIMARILY SO /CR WINS WITH ONE + CAIN A,"/ ;SLASH + JRST AFRQT ;QUOTE CHAR + CAIE A,40 + CAIN A,15 + JRST AFREND + CAIE A,"; + CAIN A,11 + JRST AFREND + CAIE A,"( + CAIN A,") + JRST AFREN2 + CAIL A,"A+40 + CAILE A,"Z+40 + JRST AFRTKL ;THAT CHAR WINS, SALT IT + SUBI A,40 + JRST AFRTKL ;MAYBE MUST CONVERT TO L.C. BEFORE SALTING IT. + +AFRQT: PUSHJ P,RCH ;TAKE NEXT CHR NO MATTER WHAT + JRST AFRTKL + +AFRTK1: SKIPA TM,[100000,,1] ;PUT VAL IN FIXNUM SPACE +AFRTK2: MOVE TM,[200000,,1] ;PUT IT IN FLONUM SPACE + PUSH P,TM + MOVE SYM,[SQUOZE 0,ATOM] + PUSHJ P,FAGTFD + POP P,TM + MOVE B,FASATP + ADDI B,2 + CAIL B,FASAT+FASATL + XCT AFTERR + MOVEM TM,FASAT-2(B) + MOVEM A,FASAT-1(B) + MOVEM B,FASAT1 + POPJ P, + +AFREN2: TLO FF,FLUNRD ;SAVE ( OR ) AS WELL AS FLUSHING +AFREND: MOVEI B,5 ;PAD END OF P.N. WITH 0 S + MOVEI TM,0 +AFREN1: IDPB TM,FASAT2 + HRRZ A,FASAT2 + CAIL A,FASAT+FASATL-1 + XCT AFTERR + CLEARM 1(A) + SOJG B,AFREN1 + SUBI A,FASAT + MOVEM A,FASAT1 ;STORE PNTR TO WORD BEYOND ATOM + ; MAYBE PUT THIS IN FASATP + MOVE B,FASATP ;ADR OF START OF ATOM READ + SUBI A,1(B) ;COMPUTE LENGTH OF FASAT + HRRZM A,FASAT(B) ;PN ATOM 4.8-4.7 =0 STORE LENGTH IN HEADER WD + + POPJ P, + +AFRITN: MOVEI B,0 ;"INTERN" LAST ATOM READ IN + MOVEI A,1 ;A CONTAINS RUNTIME ATOM TBL INDEX + ;B INDEX WITHIN FASAT +AFRIT1: CAML B,FASATP + JRST POPJ1 ;NOT FOUND + MOVE C,FASATP ;POINTS AT HEADER OF WORD OF NEW (?) ATOM + HRRZ D,FASAT(B) ;HEADER WD OF GUY IN TBL(RIGHT HALF HAS LENGTH) + JUMPE D,AFRIT4 ;JUMP ON RESERVED FOR LIST +AFRIT2: MOVE TM,FASAT(C) + CAME TM,FASAT(B) + AOJA B,AFRIT3 ;THIS ONE LOSES + SOJL D,CPOPJ ;THIS ONE WINS! + AOS B + AOJA C,AFRIT2 + +AFRIT3: SOJL D,[AOJA A,AFRIT1] ;FINISH SPACING OVER THIS GUY +AFRIT4: AOJA B,AFRIT3 + +AFENTY: SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.ENTRY in NON-FASL/] + SKIPN CRLOC + ETI [ASCIZ /.ENTRY when . is absolute/] + PUSHJ P,AFRATM ;READ FUNCTION NAME + HRLZS A + PUSH P,A + PUSHJ P,AFRATM ;READ TYPE (SUBR, LSUBR, ETC) + HRRM A,(P) + MOVE SYM,[SQUOZE 0,.ENTRY] + PUSHJ P,FAGTFD ;READ ARGS PROP + JUMPGE FF,ASSEM1 ;NOT PUNCHING PASS + PUSH P,A + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ANY NEW ATOMS OUT + POP P,C + POP P,A + MOVEI B,13 + PUSHJ P,FASO + HRL A,C + HRR A,CLOC + PUSHJ P,FASO1 + JRST ASSEM1 + +AFLIST: HLRZM B,AFLTYP + SKIPGE B,CONTRL + TRNN B,FASL + ETI [ASCIZ /.LIST illegal except in FASL assembly/] + PUSHJ P,AFRLST ;READ LIST, RTN ATM TBL INDEX IN A + SKIPN AFLTYP + JRST ASSEM1 ;JUST EVAL IN LISP AND THROW AWAY VALUE + MOVEI B,AFDMAI ;"ATOM" INDEX IN AFDMY1 TBL + JRST AFLST1 ;TREAT AS ATOM + +AFRLST: CLEARM AFRLD ;"DEPTH" + CLEARM AFRLEN ;"LENGTH" OF LIST AT CURRENT LEVEL + CLEARM AFRDTF ;DOT CONTEXT FLAG + JUMPGE FF,AFRLI1 + MOVE C,FASPCH + CAME C,FASATP + PUSHJ P,FPATB ;MAKE SURE ALL ATOMS "PUNCHED" + MOVE A,FASATP + MOVEM A,AFRFTP ;SAVED STATE OF FASAT POINTER + MOVE C,AFLTYP + MOVEI B,16 ;EVAL TYPE HACK + CAIN C,1 + MOVEI B,5 ;LIST TYPE HACK + PUSHJ P,FASBO ;WRITE CODE BITS +AFRLI1: +AFRL1: PUSHJ P,RCH + CAIE A,40 ;PREV ATOM (OR WHATEVER) "DELIMITED", SO THESE MEANINGLESS + CAIN A,15 ;UNLESS AT TOP LEVEL AND HAVE READ SOMETHING + JRST AFRL1A + CAIE A,11 + CAIN A,12 + JRST AFRL1A + CAIN A,"( + JRST AFRLO + CAIN A,") + JRST AFRLC + CAIN A,". + JRST AFRDT ;DOT.. + TLO FF,FLUNRD + SKIPE AFRLD + JRST AFRNXT ;READ NEXT GUY THIS LVL + SKIPE AFRLEN +AFRLO2: ETI [ASCIZ /LISP read context error/] +AFRNXT: SKIPN TM,AFRDTF + JRST AFRNX2 ;NOT HACKING DOTS, OK + AOS TM,AFRDTF + CAIE TM,2 + JRST AFRLO2 ;DIDNT JUST SEE THE DOT +AFRNX2: PUSHJ P,AFRATM + JUMPGE FF,AFRNX1 ;XFER ON NOT PUNCHING PASS + PUSHJ P,FASO1 ;TELL LOADER TO PUSH THIS ON ITS STACK +AFRNX1: AOS AFRLEN ;LIST NOW ONE LONGER THIS LVL + JRST AFRL1 + +AFRLO: SKIPN TM,AFRDTF + JRST AFRLO3 ;NOT HACKING DOTS + SOJN TM,AFRLO2 + CLEARM AFRDTF + JRST AFRL1 ;IGNORE BOTH . AND ( + +AFRLO3: SKIPE AFRLD ;( + JRST AFRLO1 + SKIPE AFRLEN + JRST AFRLO2 +AFRLO1: PUSH P,AFRLEN + CLEARM AFRLEN ;START NEW LVL + AOS AFRLD ;DEPTH NOW ONE GREATER + JRST AFRL1 + +AFRLC: SOSGE AFRLD ;) + JRST AFRLO2 ;AT TOP LEVEL, BARF + MOVE A,AFRLEN + SKIPN TM,AFRDTF + JRST AFRLC2 ;NOT HACKING DOTS + CAIE TM,2 + JRST AFRLO2 + SOS A ;MAIN LIST NOW ONE SHORTER + TLOA A,200000 ;DOT WITH LAST THING ON STACK +AFRLC2: TLO A,100000 ;TELL LOADER TO MAKE LIST THIS LONG + JUMPGE FF,AFRLC5 + PUSHJ P,FASO1 +AFRLC5: POP P,AFRLEN ;LENGTH AT PREV LVL + AOS AFRLEN ;NOW ONE MORE + CLEARM AFRDTF ;NOT HACKING DOTS NOW + SKIPE AFRLD ;RETURNING TO TOP LEVEL? + JRST AFRL1 + JRST AFRX1 ;YES THRU + +AFRDT: SKIPN AFRDTF + SKIPN AFRLEN + JRST AFRLO2 ;DOT IN FIRST POSITION OF LIST + AOS AFRDTF ;ENTER STATE 1 OF DOT HACKING + JRST AFRL1 + +AFRL1A: SKIPN AFRLD ;SPACER CHAR TERMINATES AT TOP LVL IF HAVE RD SOMETHING + SKIPN AFRLEN + JRST AFRL1 +AFRX1: JUMPGE FF,AFRX2 ;NOT PUNCHING PASS + MOVE A,AFRFTP + CAME A,FASATP + ETR [ASCIZ /Saw atoms in list on pass 2 for first time/] + SKIPN B,AFLTYP ;TYP LIST OP + SKIPA A,[-1,,] + MOVSI A,-2 ;PUT LIST OR VALUE OF LIST IN ATOM TBL + PUSHJ P,FASO1 ;TERM OP AND PUT IT IN ATOM TBL + MOVEI A,0 + MOVE B,AFLTYP + JUMPE B,CPOPJ ;JUST WANT VALUE OF LIST + CAIN B,1 ;ONLY WANT THIS FOR STRAIGHT LIST + PUSHJ P,FASO1 ;OUTPUT "SXHASH" WORD + AOS A,FASATP + CLEARM FASAT-1(A) ;RESERVE SLOT IN FASAT TBL + MOVEM A,FASPCH ;SAY ALREADY PUNCHED OUT + AOS A,FASIDX + POPJ P, + +AFRX2: TLO I,ILNOPT ;DONT TRY TO OPTIMIZE IF IN CONSTANT + CLEARB A,B + POPJ P, +] + +;.LIBRA, .LIFS, ETC. + +A.LIB: NOVAL ? NOABS + HLRZM B,LIBTYP' ;STORE BLOCK TYPE TO OUTPUT + CLEARM LIBOP ;INITIALIZE SQUOZE FLAGS + PUSHJ P,EBLK ;END CURRENT OUTPUT BLOCK, MAKING SURE LOADER KNOWS $. +LIB1: PUSHJ P,GETSYL ;GET NAME + TRNN I,IRSYL + JRST LIB2 ;NO SYL, DON'T OUTPUT + IOR SYM,LIBOP + TLO SYM,40000 + PUSHJ P,OUTSM + MOVSI A,400000 + ANDCAM A,LIBOP +LIB2: MOVE B,CDISP ;GET CDISP + TLNN B,DWRD\DFLD ;CHECK FOR WORD TERMINATOR + JRST LIB3 ;WORD TERMINATOR => DONE + MOVE A,LIBOP + MOVE B,LIMBO1 ;RETRIEVE LAST CHAR READ + CAIN B,", + MOVSI A,400000 + CAIN B,"+ + TLZ A,200000 + CAIN B,"- + TLO A,200000 + MOVEM A,LIBOP' ;STORE SQUOZE FLAGS (LESS GLBL BIT) FOR NEXT SYM + JRST LIB1 + +LIB3: MOVE A,LIBTYP ;GET BLOCK TYPE TO OUTPUT + DPB A,[310700,,BKBUF] + PUSHJ P,EBLK + CAIN A,LLIB ;.LIBRA? + JRST ARELC1 ;.LIBRA, NOW PLAY LIKE RELOCA PSEUDO + JRST LIB5 ;SOMETHING ELSE (.LIFS), INCREMENT DEPTH IN LOAD TIME CONDITIONALS + +A.ELDC: NOVAL ? NOABS + PUSHJ P,EBLK + MOVEI A,ELTCB + DPB A,[310700,,BKBUF] + TRO FF,FRLOC ;MAKE EBLK OUTPUT NULL BLOCK + PUSHJ P,EBLK + SOSGE LDCCC + CLEARM LDCCC ;LOADER CONDITIONAL UNDERFLOW + JRST ASSEM1 + + ;LOADER CONDITIONAL ON VALUE + +A.LDCV: NOVAL ? NOABS + LSH B,-27. + PUSH P,B + PUSHJ P,AGETWD + POP P,B + DPB B,[400300,,BKBUF] + MOVEI A,LDCV + PUSHJ P,PLDCM + MOVEI A,0 + DPB A,[400300,,BKBUF] +LIB5: AOS LDCCC +CCASM1: JRST ASSEM1 + +;.GLOBAL, .SCALAR, .VECTOR +;LH(B) HAS ILGLI, ILVAR, ILVAR+ILFLO RESPECTIVELY. +; Note that use of ILFLO flag is a crock here. + +A.GLOB: NOVAL + HLLZ LINK,B ;REMEMBER WHICH OF THE THREE PSEUDO'S THIS IS. +A.GLO2: MOVE A,GLSPAS + MOVEM A,GLSP1 + SETOM FLDCNT + PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO NAME => DONE + CALL ES + JRST A.GLO1 + CAIE A,PSUDO_-14. + JRST A.GLO1 + JSP B,GVPSEU ;TRYING TO .GLOBAL A PSEUDO => TYPE APPRO. ERR MSG AND RETURN. + JRST A.GLO2 ;DON'T DO ANYTHING TO IT; MOVE ON TO NEXT ARG. + +A.GLO1: IOR I,LINK ;SET THE GLOBAL FLAG OR THE VARIABLE FLAG. + TLNE LINK,ILVAR ;FOR .VECTOR OR .SCALAR, SAVE # VARS CREATED BEFORE CREATING THIS ONE. + PUSH P,VARCNT ;SO WE CAN TELL IF THIS CALL TO GETVAL ACTUALY CREATES IT. + PUSHJ P,GETVAL ;NOW GET VALUE (CLOBBERS SQUOZE FLAGS) + CAIA + GOHALT + TLNN LINK,ILVAR ; THAT'S IT IF .GLOBAL, ELSE CONTINUE + JRST A.GLO2 + PUSH P,LINK ;.VECTOR OR .SCALAR, MUST READ THE SIZE. + TLO FF,FLUNRD ;RE-READ THE TERMINATOR AFTER THE SYM, SO "FOO(1)" AND "FOO," WIN + MOVE SYM,[SQUOZE 0,.SCALAR] + TLNE LINK,ILFLO ; USE RIGHT SYM + MOVE SYM,[SQUOZE 0,.VECTOR] + CALL AGETFD + REST LINK + REST B ;GET PREV. VARCNT, SO WE CAN SEE IF IT WAS INCREMENTED. + TRNN A,-1 ;MAKE (N) WORK AS SIZE BY USIN L.H. IF R.H. IS 0. + HLRZS A + JUMPN A,A.GLO3 ;JUMP IF NONZERO SIZE SPEC'D + TLNN LINK,ILFLO ; ZERO, USE DEFAULT + JRST A.GLO2 ; WHICH IS ALWAYS 1 FOR .SCALAR + SKIPA A,VECSIZ ; AND VECSIZ FOR .VECTOR. +A.GLO3: TLNE LINK,ILFLO ;NONZERO SIZE, SO + MOVEM A,VECSIZ ;DEFAULT MUST BE REMEMBERED FOR .VECTOR. + SUBI A,1 ;1 WORD WAS ALLOCATED BY GETVAL - HOW MANY MORE WANTED? + CAME B,VARCNT ;(MAYBE SYM ALREADY DEFINED, MAYBE PASS2, ...) + ADDM A,VARCNT ;IF GETVAL REALLY ALLOCATED THE SPACE THIS TIME, ALLOCATE THE + JRST A.GLO2 ;RIGHT AMOUNT. + + ;.LOP + +A.LOP: NOVAL ? NOABS + PUSHJ P,EBLK ;TERMINATE CURRENT BLOCK + REPEAT 3,PUSHJ P,RGETFD ;GET THE FIELDS + MOVEI A,LD.OP + PUSHJ P,PLDCN + JRST ASSEM1 + + ;.LIBRQ + +A.LIBRQ: NOVAL ? NOABS +A.LBR1: PUSHJ P,GETSLD + JRST MACCR + PUSHJ P,PBITS7 + MOVEI A,3 + PUSHJ P,PBITS + TLO SYM,40000 + PUSHJ P,OUTSM + JRST A.LBR1 + +A.LNKOT: AOS (P) ;THIS PSEUDO RETURNS NO VALUE. + NOVAL + +AEND5: JUMPGE FF,CPOPJ ;IGNORE FOLLOWING ON NOT PUNCHING PASS + MOVE D,SYMAOB +AEND5A: MOVE SYM,ST(D) + LDB T,[400400,,SYM] + CAIE T,DEFLVR_-14. + CAIN T,DEFGVR_-14. + JRST AEND5E + CAIE T,LCUDF_-14. + CAIN T,GLOEXT_-14. + JRST AEND5B +AEND5C: ADD D,WPSTE1 + AOBJN D,AEND5A + POPJ P, + +AEND5E: 3GET C,D + TLNN C,3LLV + JRST AEND5C +AEND5B: HLLZ B,ST+1(D) + 3GET C,D + TLNN C,3RLNK + JUMPE B,AEND5C + TLZ SYM,740000 + CAIE T,LCUDF_-14. + CAIN T,DEFLVR_-14. + SKIPA + TLO SYM,40000 + PUSHJ P,LKPNRO + HRRZS ST+1(D) ;CLEAR OUT LIST HEAD POINTER. + TLZ C,3RLNK ;INDICATE NO LIST. + 3PUT C,D + JRST AEND5C + + ;PUNCH OUT COMPLETE LOADER COMMAND, PUNCHING OUT WRD AS ONLY CONTENTS + +PLDCM: PUSH P,LINK ;SAVE LINK FOR ALOC AND FRIENDS (CLOBBERS OTHER AC'S) + PUSH P,A ;SAVE LOADER COMMAND TYPE + PUSHJ P,EBLK ;TERMINATE PREV BLOCK, MAKING SURE LOADER KNOWS $. + PUSHJ P,PWRDA ;PUNCH OUT THE WORD + POP P,A ;GET BACK LOADER COMMAND TYPE FOR PLDCN + PUSHJ P,PLDCN ;OUTPUT THE RESULTING BLOCK +PLINKJ: POP P,LINK ;RESTORE LINK + POPJ P, + +PLDCN: HRRM A,BKBUF ;STORE LOADER COMMAND TYPE IN BKBUF HEADER + MOVEI A,LLDCM ;LOADER COMMAND BLOCK TYPE + DPB A,[310700,,BKBUF] ;STORE BLOCK TYPE IN HEADER + TRO FF,FRLOC ;MAKE EBLK OUTPUT BLOCK EVEN IF EMPTY + JRST EBLK + +;.RELP RETURNS RELOCATION OF ARG +A.RELP: CALL AGETFD + MOVE A,B + JRST VALRET + +;.ABSP RETURNS ABSOLUTE PART OF ARG. +A.ABSP: CALL AGETFD + JRST VALRET + +;.RL1 IN RELOCATABLE ASSEMBLY RETURNS ZERO WITH RELOCATION FACTOR ONE. +;IN ABSOLUTE ASSEMBLY, IT RETURNS JUST ZERO. +;IFN <.RELP .RL1>, IS A TEST FOR A RELOCATABLE ASSEMBLY. +A.RL1: SKIPGE A,CONTRL + TRNE A,DECREL\FASL + SKIPA B,[1] + SETZ B, + SETZ A, + RET + +AEND: NOVAL + SKIPE ASMOUT ; ERROR IF IN GROUPING. + JSP LINK,CONFLM ;FLUSH CONSTANTS, GIVE ERROR MSG. + SKIPE SCNDEP ;IF THERE ARE UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS, MENTION THEM. + MOVE A,BKCUR + CAIE A,BKWPB ;NOT IN .MAIN BLOCK => ERROR. + ETR ERRUMB + MOVE A,CDISP + TLNN A,DWRD + TLO FF,FLUNRD ;IF LAST TERM. WAS WORD TERM., RE-READ. +IFN LISTSW,[ + MOVE A,[440700,,LISTBF] + EXCH A,PNTBP + MOVEM A,LISTTM +] + PUSHJ P,AVARI0 + PUSHJ P,CNSTN0 + SKIPL A,CONTRL + JRST [ PUSHJ P,AEND5 ; STINK RELOCATABLE => .LNKOT + JRST AEND6] + TRNE A,DECSAV ; IF DECSAV FMT, + JRST [ MOVE A,CLOC ; USE LOC COUNTER AT END AS LOC OF SYMBOLS + SKIPN DECSYA ; UNLESS LOC ALREADY SPECIFIED. + MOVEM A,DECSYA + JRST AEND6] + TRNN A,DECREL + JRST AEND6 + MOVE A,CLOC ;IN DEC FMT, UPDATE HIGHEST ADDR SEEN, + SKIPN CRLOC ;UPDATE EITHER THE HIGHEST ABS ADDR + JRST [ CAML A,DECBRA + MOVEM A,DECBRA + JRST AEND6] + CAML A,DECTWO ;OR THE HIGHEST REL ADDR IN THE + JRST [ CAML A,DECBRH ;APPROPRIATE SEG. + MOVEM A,DECBRH + JRST AEND6] + CAML A,DECBRK + MOVEM A,DECBRK +AEND6: JUMPL FF,AEND1 ;ON PUNCHING PASS, SPECIAL STUFF + PUSHJ P,GETWRD ;OTHERWISE EAT UP WORD, + JRST RETURN ;AND RETURN + +AEND1: PUSHJ P,EBLK +IFN LISTSW,[ + SKIPGE LISTPF + PUSHJ P,PNTR + MOVE A,LISTTM + MOVEM A,PNTBP +] + MOVE SYM,[SQUOZE 0,END] + TLZ I,ILWORD + PUSHJ P,AGETWD +IFN LISTSW,[ + MOVEM A,LISTWD + MOVEM B,LSTRLC + SETOM LISTAD + SETOM LISTPF + SKIPE LSTONP + PUSHJ P,PNTR + SKIPE LISTP + PUSHJ P,LPTCLS ;DONE LISTING + MOVE A,LISTWD +] ;END IFN LISTSW, + SKIPL B,CONTRL + JRST AEND3 ;RELOCATABLE +IFN FASLP,[ + TRNE B,FASL + JRST FASEN ;FASL FORM +] + TRNE B,DECSAV + JRST AEND4 + TRNN B,DECREL ;IF DEC FORMAT, + JRST AEND1A + TLNN I,ILWORD ;THEN IF THERE7S A STARTING ADDRESS, + JRST AEND2 + MOVSI A,DECSTA ;OUTPUT START-ADDRESS BLOCK. + PUSHJ P,DECBLK + PUSHJ P,PWRD + PUSHJ P,EBLK + JRST AEND2 + +IFN FASLP,[ +FASEN: JRST AEND2 +] + +AEND3: HRRZ A,CLOC + HRRM A,BKBUF ;SET UP PROGRAM BREAK JUST IN CASE OUTPUTTING MORE NULL DATA BLOCKS + MOVEI A,LCJMP + PUSHJ P,PLDCM + JRST AEND2 + + ; HERE FOR DECSAV FORMAT. +AEND4: TLNE A,-1 + JRST AEND1B ; IF SOMETHING IN LH, MAY BE ENTRY VECTOR. + MOVE B,A + MOVE A,[-1,,120-1] ; NOTHING, SO ASSUME SIMPLE JRST. MUST + PUSHJ P,PPB ; FIRST SAVE S.A. IN .JBSA CROCK. + MOVE A,B + PUSHJ P,PPB + TLO A,(JRST) ; FURNISH JRST FOR PUTTING AT END OF OUTPUT. + JRST AEND1B + +AEND1A: ; CHECK WORD AND MAYBE MAKE IT A JRST + TLNN A,777000 ; CHECK INSTRUCTION PART + TLO A,(JRST) ; WANTS JRST + PUSHJ P,PPB +AEND1B: JUMPG A,.+3 + ETR [ASCIZ /Start instruction negative/] + HRLI A,(JRST) ;END SYMTAB WITH POSITIVE WORD + MOVEM A,STARTA ;SAVE FOR PUNCHOUT AT END OF SYMTAB + PUSHJ P,FEED1 +AEND2: PUSH P,[RETURN] +CNARTP: +IFN DECSW\TNXSW,[ + PUSH P,TTYFLG + SKIPE CCLFLG ;IN DEC VERSION, IF RUN BY CCL, DON'T PRINT + AOS TTYFLG ;THIS STUFF ON THE TTY - ONLY IN ERROR FILE AND LISTING. + CALL CNTPD + REST TTYFLG + RET + +CNTPD: +] + MOVNI D,1 + MOVEI TT,PCNTB +CNTP1: CAML TT,PBCONL + RET + HRRZ B,1(TT) + HLRZ A,1(TT) + CAMN A,B + JRST CNTP2 + AOSN D + TYPR [ASCIZ /Constants area inclusive +From To +/] + LDB B,[.BP (CGBAL),2(TT)] + SKIPE B + TYPR [ASCIZ /Global+/] + HRRZ B,1(TT) + PUSHJ P,OCTPNT + PUSHJ P,TABERR + HLRZ B,1(TT) + SOS B + PUSHJ P,OCTPNT + PUSHJ P,CRRERR +CNTP2: ADDI TT,3 + JRST CNTP1 + +AENDM1: TYPR [ASCIZ /Unterminated successful bracketed conditionals +The first was at /] + AOS A,CONDPN + CALL DPNT + MOVEI A,"- + CALL TYOERR + AOS A,CONDLN + CALL D3PNT2 +IFN TS,[ + TYPR [ASCIZ/ of file /] + MOVE B,CONDFI + CALL SIXTYO +] + JRST CRRERR + +AXWORD: CALL XGETFD ;READ 1ST FIELD, + TLNE I,ILMWRD + CALL IGTXT ;SOAK UP REST OF TEXT PSEUDO. + HRLM A,WRD + HRLM B,WRDRLC + MOVSI C,HFWDF + MOVSI B,SWAPF + PUSHJ P,LNKTC1 + PUSH P,GLSP1 + CALL XGETFD ;NOW THE SECOND FIELD + HRRM A,WRD + HRRES B + ADDM B,WRDRLC + MOVSI C,HFWDF + MOVEI B,0 + POP P,T + PUSHJ P,LINKTC + JRST CABPOP + +A.NTHWD:CALL AGETFD ;READ THE NUMBER OF THE WORD WE WANT. + SOJL A,CABPOP ;NEGATIVE OR 0 => RETURN 0. + SOJL A,A.1STWD ;1 => TURN INTO .1STWD. + ;ELSE SKIP APPRO. # OF WORDS, THEN DO .1STWD. + +A.NTH1: PUSH P,A + PUSH P,WRD + CALL XGETFD + TLZ FF,FLUNRD + REST WRD + REST A + TLNN I,ILMWRD + JRST CABPOP ;IF STRING ENDS BEFORE DESIRED WORD, RETURN 0. + SOJGE A,A.NTH1 + +A.1STWD: CALL XGETFD ;GET THE 1ST WD OF FOLLOWING TEXT PSEUDO, + CALL IGTXT ;THROW AWAY THE REST. + MOVE T,A ;RETURN THE VALUE + JRST TEXT5 ;COMPLAINING IF FOLLOWED IMMEDIATELY BY SYLLABLE. + +A.LENGTH: CALL PASSPS + PUSH P,[0] + PUSH P,A +A.LN1: PUSHJ P,RCH + AOS -1(P) + CAME A,(P) + JRST A.LN1 + SOS T,-1(P) + SUB P,[2,,2] + JRST TEXT5 ;RETURN VALUE IN T + +ARDIX: NOVAL + PUSHJ P,AGETFD ;GET FIELD ARG + MOVEM A,ARADIX + JRST MACCR ;RETURN WITHOUT CLOBBERING CURRENT VALUE + +A.RADIX: CALL AGETFD ;READ THE TEMP. RADIX. + PUSH P,ARADIX ;LAMBDABIND RADIX TO THAT VALUE. + MOVEM A,ARADIX + CALL XGETFD ;READ IN THE NEXT FIELD USING THAT RADIX. + REST ARADIX + JRST VALRET + +;READ A BIT-MASK AS ARG, RETURN THE LH OF BP. FOR THAT BYTE. +A.BP: CALL YGETFD + MOVEI C,SPACE + SKIPE CDISP ;IF ARG WAS ENDED BY A COMMA, TURN IT INTO A SPACE + HRRM C,CDISP ;SO THAT .BP FOO,BAR USES THE FLD SPACE FLD FORMAT. + JUMPE A,VALR1 + PUSH P,A + JFFO A,.+2 + MOVEI B,36. + EXCH B,(P) ;(P) HAS # LEADING ZEROS. + MOVN A,B + AND A,B ;A HAS ONLY THE LOW BIT OF THE BYTE. + JFFO A,.+2 + MOVNI B,1 ;B HAS 35.-<# TRAILING ZREROS.> + MOVEI A,1(B) + SUB A,(P) ;A HAS SIZE OF BYTE + LSH A,30 ;PUT IN S FIELD OF BP. + SUB P,[1,,1] + MOVNS B + ADDI B,35. ;B HAS # TRAILING ZEROS. + DPB B,[360600,,A] ;PUT THAT IN P FIELD OF BP. + JRST VALR1 + +;READ IN BP, RETURN BIT MASK TO SPEC'D BYTE. +;THE ARG SHOULD BE JUST THE LH OF A BP, WHICH MAY BE IN EITHER HALF OF THE ARG. +A.BM: CALL GETBPT ;READ IN A BYTE POINTER ARG, IN A, POINTING AT T. + SETZ T, + SETO C, +A.DPB1: DPB C,A ;PUT 1'S IN SPEC'D PART OF ACCUM T + MOVE A,T + JRST VALRET + +;READ IN A BYTE POINTER (REALLY JUST S AND P FIELDS) AND MAKE POINT AT AC T. +;RETURN IT IN AC A. +GETBPT: CALL YGETFD + TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH. + HRLI A,(A) + TLZ A,77 ;MAKE BP. -> AC T + HRRI A,T + RET + +;RETURN # TRAILING ZEROS IN ARGUMENT. +A.TZ: CALL YGETFD + MOVN B,A + AND A,B ;A HAS JUST LOW BIT OF ARG SET. + JFFO A,.+2 + MOVNI B,1 ;# OF ZEROS BEFORE LOW BIT = + MOVN A,B ;35. - <# TRAILING ZEROS> + ADDI A,35. + JRST VALRET + +;RETURN # LEADING ZEROS IN ARG. +A.LZ: CALL YGETFD + JFFO A,.+2 + MOVEI B,36. + MOVE A,B + JRST VALRET + +;.DPB STUFF,BP,WORD DOES A DPB OF STUFF INTO THE FIELD OF WORD SPEC'D BY BP, +;RETURNING THE RESULTING WORD. +A.DPB: CALL YGETFD ;READ STUFF. + PUSH P,A + CALL GETBPT ;READ BP AND TURN INTO ACTUAL BP POINTING AT T + PUSH P,A + CALL YGETFD ;READ IN WORD AND PUT IN T. + MOVE T,A + REST A ;A HAS BP + REST C ;C HAS STUFF + JRST A.DPB1 ;GO DO THE DEPOSIT AND RETURN THE ALTERED WORD. + +;.LDB BP,WORD RETURNS THE CONTENTS OF THE BYTE IN WORD SELECTED BY BP +A.LDB: CALL GETBPT + PUSH P,A + CALL YGETFD + MOVE T,A + REST A + LDB A,A + JRST VALRET + +;.IBP BP RETURNS AN INCREMENTED BP. +A.IBP: CALL YGETFD + TLNN A,-1 ;IF ARG ISN'T IN LH, USE RH. + HRLZS A + IBP A + JRST VALRET + +AWORD: NOVAL + PUSHJ P,EBLK + PUSHJ P,GETWRD ;ON UNDEFINED SYM, WYB UNDEFINED SYM IN "WORD"? + PUSHJ P,PPB + JRST ASSEM1 + +;.BIND - MAKE SYMS BE DEFINED IN CURRENT (SPEC'D) BLOCK. LH(B) HAS 0. +;.KILL - FULLY KILL THE SYMS.LH(B) HAS 3KILL. +;.HKILL - HALFKILL THEM. LH(B) HAS 3SKILL. +;.XCREF - PREVENT CREFFING OF SYMS. LH(B) HAS 3NCRF. +;.DOWN - SET 3DOWN, MAKING SYM VISIBLE IN SUBBLOCKS IN 1 PASS ASSEMBLY. +A.KILL: NOVAL + HLLZ LINK,B ;REMEMBER BIT TO SET. +A.KIL1: CALL GETSLD ;READ NEXT SYMBOL NAME. + JRST MACCR ;NO MORE, EXIT. + SKIPE LINK ;EXCEPT FOR .BIND, DO NOTHING ON PASS 1. + JUMPGE FF,A.KIL1 + CALL ESDEF ;DEFINE THE SYMBOL, D HAS STE IDX. + JRST A.KIL2 ;SYMBOL NEVER SEEN. + IORM LINK,ST+2(D) ;SET THE BIT IN 3RDWRD.. + IOR C,LINK ;(IF .XCREF, PREVENT CREFFING THIS TIME) +IFN CREFSW,XCT CRFINU ;CREF THE SYMBOL + JRST A.KIL1 + +A.KIL2: MOVSI T,LCUDF ;SYMBOL UNDEFINED, MAKE UNDEF LOCAL. + IOR C,LINK ;WITH THE DESIRED BIT SET. + TLO C,3MACOK ;SHOULDN'T BE ERROR IF IT BECOMES MACRO. + CALL VSM2 +IFN CREFSW,XCT CRFINU + JRST A.KIL1 + +;EXPUNG SYM1,SYM2 ... ;UNDEFINE THOSE SYMS. +AEXPUNG: NOVAL +AEXPU2: PUSHJ P,GETSLD ;GET NAME + JRST MACCR ;NO MORE NAMES + PUSH P,[AEXPU2] ;AFTER THIS SYM, POPJ TO READ ANOTHER. +;EXPUNGE 1 SYMBOL, SQUOZE IN SYM. +AEXPU1: PUSHJ P,ES + JFCL ;NOT FOUND, DON'T COMPLAIN, JUST CREF. +IFN CREFSW,XCT CRFDEF + HRLZI T,400000 ;EXPUNGED ZERO SYM + SKIPE ST(D) + MOVEM T,ST(D) + SKIPL CONTRL ;IF RELOCATABLE ANDLOCAL SYMBOL, + CAIL A,DEFGVR_-33. + RET + PUSHJ P,PBITS7 ;TELL STINK TO EXPUNGE SYM. + MOVEI A,CLGLO + PUSHJ P,PBITS + TLO SYM,400000 ;SAY IS NEW TYPE RQ, + PUSHJ P,OUTSM0 + MOVSI A,400000 ;NEW NAME NULL => DELETE. + JRST $OUTPT + +;EQUAL SYM1,SYM2 ;DEFINE SYM1 SAME AS SYM2. +AEQUAL: NOVAL + PUSHJ P,GETSLD + ETR ERRTFA + PUSH P,SYM ;REMEMBER SYM NAME AND BLOCK TO DEF. IN. + PUSH P,ESBK + PUSHJ P,GETSLD + ETR ERRTFA +IFN CREFSW,XCT CRFINU ;CREF SYM DEFINED AS. + CALL ES ;LOOK UP SYM TO EQUATE TO. + JRST [ REST ESBK ;NOT FOUND => EXPUNGE THE 1ST SYM. + REST SYM + JRST AEXPU1] + REST ESBK + REST SYM +IFN CREFSW,XCT CRFDEF + PUSH P,A + PUSH P,B ;SAVE INFO ON VALUE OF SYM TO EQUATE TO. + PUSH P,C + CALL ESDEF + MOVEM SYM,ST(D) + REST B ;3RDWRD OF 2ND SYMBOL. + REST ST+1(D) ;(WHAT WAS PUSHED FROM B) + REST A + DPB A,[400400,,ST(D)] + TLZ C,3DFCLR ;SAVE OLD 3MAS, 3NCRF OF 1ST SYMBOL (AND ITS BLOCK #). + AND B,[3DFCLR,,] ;SET REST OF 3RDWRD BITS FROM 2ND SYMBOL. + IOR B,C + 3PUT B,D + JRST MACCR + +ERRTFA: ASCIZ /Too few args - EQUAL/ + +;.SEE SYM1,SYM2,... ;CREF THOSE SYMS. +A.SEE: CALL GETSLD ;READ 1 SYMBOL. + JRST MACCR ;NONE TO BE READ. +IFN CREFSW,[ + SKIPN CRFONP ;IF CREFFING, + JRST A.SEE + CALL ES + MOVEI A,SYMC_-33. + XCT CRFINU ;CREF THE SYMBOL. +] + JRST A.SEE + +;UUO HANDLING ROUTINE +;41 HAS JSR ERROR + +VBLK +ERRCNT: 0 ; NUMBER OF ERRORS HIT -- VALUE OF .ERRCNT +ERRCCT: 0 ;NUM CHARS OUTPUT ON LINE, FOR MAKING MSGS LINE UP. +ERRJPC: 0 ;JPC READ WHEN UUO. +ERROR: 0 +IFN ITSSW, .SUSET [.RJPC,,ERRJPC] + JRST ERRH ;GO HANDLE IT +PBLK +ERRH: PUSH P,T + PUSH P,B ;NOT TYPR => ERROR OF SOME KIND + PUSH P,A + PUSH P,C + LDB T,[331100,,40] ;PICK UP OP CODE + CAIN T,TYPCR_-33 ; TYPCR? + JRST TYPCR1 + CAIN T,TYPR_-33 ; OR TYPR? + JRST TYPR1 ; YES + ;ERROR OF SOME KIND + CAIE T,ETASM_-33 ;CHECK FOR SPECIAL LOSSAGES AT COLON + CAIN T,ETSM_-33 + CAME SYM,SYSYM ;ARE WE ABOUT TO MENTIO THIS LOSING LABEL AS THE LAST ONE? + JRST ERRH1 + MOVE T,SYSYM1 + + MOVEM T,SYSYM ;COLON LOSSAGE, DE-MUNG TAG WORDS FOR PRINTOUT + MOVE T,SYLOC1 + MOVEM T,SYLOC +ERRH1: +IFN TS,[ +IFN LISTSW,[ + CALL PNTR ;FORCE OUT BUFFERED LISTING OUTPUT + CALL PNTCRR ;AND CR, SO USER CAN SEE WHERE ERROR WAS. +] + PUSHJ P,ERRTFL ;IF NOT SAME FILE AS LAST, PRINT FILE NAME. +] + SETZM ERRCCT + AOS ERRCNT ; BUMP ERROR TOTAL +IFN DECSW,AOS .JBERR ; BUMP ERROR MESSAGE COUNTER FOR LOADER TO ABORT + MOVE A,SYSYM ;GET LAST TAG DEFINED + JUMPE A,ERR1 ;SKIP PRINTOUT IF NONE THERE + PUSHJ P,SYMTYP ;THERE, TYPE IT OUT + MOVE B,CLOC ;NOW GET CURRENT LOCATION + SUB B,SYLOC ;SUBTRACT VALUE OF LAST TAG + JUMPE B,ERR1 ;SKIP NUMERIC PRINTOUT IF RIGHT AT TAG + MOVEI A,"+ ;NOT AT TAG, + PUSHJ P,TYOERR ;TYPE OUT PLUS SIGN, + AOS ERRCCT ;(1 MORE CHAR TYPED) + PUSHJ P,OCTPNT ;THEN TYPE OUT DIFFERENCE IN OCTAL +ERR1: PUSHJ P,TABERR ;NOW SEPARATE WITH TAB + MOVE A,ERRCCT + CAIGE A,8 ;MAKE SURE MOVE TO COLUMN 16. + PUSHJ P,TABERR + MOVEI B,[ASCIZ/GL+/] + SKIPGE GLOCTP ;LOCATION GLOBAL? + PUSHJ P,TYPR3 ;YES, TYPE OUT THAT FACT. + MOVE B,CLOC ;GET CURRENT LOCATION + PUSHJ P,OCTPNT ;TYPE OUT IN OCTAL +;DROPS THROUGH + +;DROPS THROUGH. + PUSHJ P,TABERR + MOVE A,MDEPTH ;NOW DEPTH IN MACRO (NOT IRP, REPEAT, ETC.) EXPANSIONS + MOVSI T,-2 + CALL DPNT0 ;PRINT, IN 2-CHAR FIELD. + MOVEI A,". + CALL TYOERR ;(USED TO BE OCTAL) + MOVE A,CPGN ;CURRENT PAGE NUMBER (FIRST PAGE OF FILE => 0) + PUSHJ P,[AOJA A,D6PNT] ;TYPE IT OUT IN DECIMAL + MOVEI A,"- + CALL TYOERR + MOVE A,CLNN ;ALSO CURRENT LINE NUMBER + PUSHJ P,[AOJA A,D3PNT2] + PUSHJ P,TABERR + MOVEI A,48. ;ASSUME ALL THE STUFF WE'VE PRINTED TAKES 48. CHARS + MOVEM A,ERRCCT ;MAYBE SOMEDAY TABERR, ETC. WILL REALLY UPDATE ERRCCT PROPERLY. + LDB A,[331100,,40] ;PICK UP OP CODE AGAIN + CAIGE A,8 ;ERROR UUO MAX + JRST .+1(A) + JRST [GOHALT ? JRST .-1] ;OPCODE 0, OR TOO BIG. + JRST ERRSM ;ETSM => TYPE SYM AND MESSAGE. + JRST ERRR ;ETR => JUST PRINT MESSAGE + JRST ERRJ ;ERJ => RH(40) HAS JUMP ADR + JRST ERRI ;ETI => IGNORE LINE RET TO ASSEM1 + JRST ERRA ;ETA => RET TO ASSEM1 + JRST ERRASM ;ETASM => TYPE SYM AND GO TO ASSEM1 + JRST IAE ;ERF => FATAL. + +ERRJ: MOVE A,40 ;ERJ => RH(40) HAS JUMP ADR + HRRM A,ERROR + JRST ERRET1 + +ERRI: PUSHJ P,RCH ;ETI => IGNORE LINE, RETURN TO ASSEM1: EAT UP LINE + CAIE A,12 + JRST .-2 +ERRA: MOVEI A,ASSEM1 ;ETA => RETURN TO ASSEM1, DON'T TYPE SYM. + MOVEM A,ERROR + JRST ERRR + +ERRASM: MOVEI A,ASSEM1 ;ETASM => TYPE SYM AND RETURN TO ASSEM1 + MOVEM A,ERROR +ERRSM: MOVEI C,56. ;ETSM OR ETASM => TYPE OUT SYM THEN MESSAGE + CALL TYPE37 ;CR NOW IF WHOLE MSG WON'T FIT ON ONE LINE. + MOVE A,SYM + PUSHJ P,SYMTYP + PUSHJ P,TABERR +ERRR: CALL TYPE40 ;TYPE THE ERROR MESSAGE. +ERRET1: REST C + POP P,A ;COMMON RETURN POINT FROM UUOS + POP P,B + POP P,T + JRST 2,@ERROR + +;FINISH UP AN ERROR UUO'S ERROR MESSAGE. PRINT THE SPECIFIED STRING +;AND ALSO "IN DEFINE AT ..." IF NECESSARY, ALONG WITH APPROPRIATE CR'S. +TYPE40: MOVE C,ERRCCT + CALL TYPE37 + CALL TYPR4 ;PRINT THE ASCIZ STRING + CALL CRRERR + SKIPN A,DEFNPS ;IF INSIDE A LONG PSEUDO, + RET + MOVE A,DEFNLN + MOVE B,DEFNPN + CAMN A,CLNN ;WHICH DIDN'T START IN THIS VERY LINE, + CAME B,CPGN + JRST TYPE42 + MOVE A,DEFNFI + CAMN A,INFFN1 + JRST TYPE43 +TYPE42: MOVEI B,[ASCIZ/ in /] + CALL TYPR3 + MOVE A,DEFNPS + CALL SYMTYP ;SAY WHAT PSEUDO, AND WHERE IT STARTED. + MOVEI B,[ASCIZ/ Starting at /] + CALL TYPR3 + MOVE A,DEFNPN ;PAGE # -1. + CALL [AOJA A,DPNT] ;PRINT PAGE #. + MOVEI A,"- + CALL TYOERR + AOS A,DEFNLN + CALL D3PNT2 ;PRINT LINE #. +IFN TS,[ + MOVE B,DEFNFI ;PRINT FILE NAME IF IT ISN'T THE CURRENT FILE. + CAMN B,INFFN1 + JRST TYPE41 + MOVEI B,[ASCIZ/ of file /] + CALL TYPR3 + MOVE B,DEFNFI + CALL SIXTYO +] +TYPE41: CALL CRRERR ;AND CRLF. +TYPE43: MOVE A,ERROR + CAIE A,ASSEM1 ;IF THIS ERROR IS EXITING THE PSEUDO, + RET + SETZM DEFNPS ;SAY WE'RE NOT IN IT ANY MORE. + SETOM TEXT4 + RET + +;JSP TM,ERMARK IN A PSEUDO, TO ARRANGE FOR ERROR MESSAGES TO MENTION +;THAT PSEUDO. SYM SHOULD CONTAIN THE NAME OF THE PSEUDO. +;PUSHES A WORD ON THE STACK SO THAT WHEN THE PSEUDO RETURNS DEFNPS WILL BE CLEARED. +;IF DEFNPS IS SET UP ALREADY, DOES NOTHING (DOESN'T SET DEFNPS; DOESN'T PUSH THE WORD) +ERMARK: SKIPE DEFNPS + JRST (TM) + MOVEM SYM,DEFNPS + MOVE SYM,CLNN + MOVEM SYM,DEFNLN + MOVE SYM,CPGN + MOVEM SYM,DEFNPN + MOVE SYM,INFFN1 + MOVEM SYM,DEFNFI + MOVE SYM,DEFNPS + CALL (TM) + CAIA + AOS (P) + SETZM DEFNPS + RET + +;C SHOULD HAVE CURRENT HORIZ POS. IF TYPING THE STRING 40 POINTS AT +;WOULD OVERFLOW THE LINE, TYPE A CRLF AND TAB NOW ON THE TTY ONLY. +TYPE37: HRRZ B,40 + HRLI B,440700 ;FIRST, FIGURE OUT HOW FAR ON LINE WE'LL TYPE IF WE DON'T CR. + ILDB A,B + CAIE A, ;AND COUNT CHARS IN THE ERR MSG. + AOJA C,.-2 + CAMGE C,LINEL + RET +CRRTBX: MOVEI A,10 + MOVEM A,ERRCCT ;PREVENT THIS FROM BEING DONE TWICE. + SKIPE TTYFLG + RET + MOVEI A,^M ;IF THERE'S NO ROOM, CRLF ON THE TTY ONLY (NOT THE ERR FILE). + PUSHJ P,TYOX + MOVEI A,^J + PUSHJ P,TYOX + MOVEI A,^I + JRST TYOX + + ;TYPE OUT SQUOZE (FLAGS OFF) IN A + +SYMTYP: PUSHJ P,SQCCV ;GET NEXT CHAR IN ASCII. + AOS ERRCCT + PUSHJ P,TYOERR ;TYPE IT OUT. + JUMPE B,CPOPJ ;RETURN IF NOTHING LEFT (TYPED OUT AT LEAST ONE CHAR THOUGH) + IMULI B,50 ;LEFT-JUSTIFY REMAINDER + MOVE A,B ;GET LEFT-JUSTIFIED REMAINDER IN A + JRST SYMTYP ;TYPE OUT REMAINDER OF SYM + + ;TYPE OUT SQUOZE CHARACTER (IN A) + +SQCCV: IDIV A,[50*50*50*50*50] + CAIG A,10. + SOJA A,SQCDTO ;NUMBER (OR BLANK =>SLASH) + CAIL A,45 + SKIPA A,SYTB-45(A) ;SPECIAL + ADDI A,"A-13 ;LETTER + POPJ P, + +SQCDTO: ADDI A,"0 + POPJ P, + +SYTB: ". + "$ + "% + +D3PNT2: MOVE T,[-3,,400000] ;3 CHAR FIELD, NO ZERO SUPPRESSION. + JRST DPNT0 + +DPNT: TDZA T,T ;ORDINARY DECIMAL PRINT. +D6PNT: MOVSI T,-6 ;6 CHAR FIELD, ZERO SUPPRESSION. +DPNT0: IDIVI A,10. + HRLM B,(P) + TRNE T,377777 ;IF NOT LAST DIGIT, + TRNE T,400000 ;AND ZERO-SUPPR. WANTED, + JRST DPNT2 + JUMPN A,DPNT2 ;IF THIS IS A LEADING 0, + JUMPN B,DPNT2 + MOVEI B," -"0 + HRLM B,(P) ;REPLACE WITH A SPACE. +DPNT2: AOBJN T,.+2 ;J IF NOT ENOUGH CHARS YET. + JUMPE A,DPNT1 ;ENOUGH, DON'T MAKE MORE IF NOT NEEDED. + CALL DPNT0 + JRST DPNT1 + +;TYPE HALFWORD IN B IN OCTAL. +OCTPNT: HRRZ A,B + IDIVI A,10 + HRLM B,(P) + JUMPE A,.+2 + PUSHJ P,.-3 + AOS ERRCCT +DPNT1: HLRZ A,(P) +ADGTYO: ADDI A,"0 + JRST TYOERR + +;TYPE OUT THE SIXBIT WORD IN B + +SIXTYO: JUMPE B,CPOPJ + MOVEI A,0 + ROTC A,6 + ADDI A,40 + PUSHJ P,TYOERR + JRST SIXTYO + + ;TYPE CRLF + +CRR: MOVEI A,15 + PUSHJ P,TYO + MOVEI A,12 + JRST TYO + +;OP CODE 0 => NO RECOVERY RETURN TO GO9 +IAE: CALL TYPE40 ;PRINT THE ERROR MESSAGE. + SKIPE ASMOUT + JSP LINK,CONFLZ ;TELL USER ABOUT UNTERM. GROUPINGS. + SKIPE SCNDEP ;MENTION ANY UNTERMINATED SUCCESSFUL + CALL AENDM1 ;CONDITIONALS. + MOVEI B,[ASCIZ /Error is fatal. +/] + CALL TYPR3 +IFN ITSSW,[ + .SUSET [.RTTY,,A] + SKIPL A + .RESET TYIC, +] + JRST GO9 + + ;TYPR [ASCIZ /STRING/] ;TYPE OUT STRING + +TYPR1: PUSH P,[ERRET1] +TYPR4: HRRZ B,40 ;GET ADR OF BEGINNING OF STRING +TYPR3: HRLI B,440700 ;CONVERT TO BYTE POINTER +TYPR2: ILDB A,B ;GET NEXT CHAR + JUMPE A,CPOPJ ;JUMP IF ZERO, END OF STRING + PUSHJ P,TYOERR ;NON-ZERO, TYPE IT OUT + JRST TYPR2 + + ; TYPCR [ASCIZ /STRING/] ; Type out string, followed by CRLF + +TYPCR1: PUSH P,[ERRET1] + PUSHJ P,TYPR4 ; When done, fall thru. + +CRRERR: MOVEI A,^M ;CRLF IN ERROR MESSAGE. + CALL TYOERR + SKIPA A,[^J] +TABERR: MOVEI A,^I ;TAB INN ERROR MESSAGE. +TYOERR: +IFN LISTSW,[ + SKIPE LSTTTY ;OUTPUT TO LISTING UNLESS LSTTTY ZERO. + CALL PILPTX +] + SKIPG LSTTTY + JRST TYO ;TO TTY UNLESS LSTTTY POSITIVE. + RET + +;OUTPUT-FORMAT SELECTING PSEUDOS: + +;.SLDR -- ON PASS 2, PUNCH OUT SBLK LOADER AND SELECT SBLK FORMAT +A.SLDR: NOVAL + JUMPGE FF,MACCR ;DO NOTHING ON PASS 1. + PUSHJ P,FEED1 ;LEAVE LOTS OF BLANK PAPER TAPE FIRST + PUSHJ P,PLOD1A ;PUNCH OUT LOADER +SIMBLK: MOVSI B,SBLKS ;ENTRY FROM PS1, A.SLDR SELECT SBLK + JRST SIMBL1 + +SRIM: MOVE A,SYM ;ENTRY FROM GETVAL, LH(B) HAS RH(CONTRL) + PUSH P,B + CALL SYMTYP + TYPR [ASCIZ/ Encountered +/] + REST B +SIMBL1: TRO FF,FRNPSS + HRRI B,TRIV ;SET UP TRIV FLAG FOR LH(CONTRL) + MOVSS B + CAME B,CONTRL ;IF CHANGING MODES, END THE BLOCK IN THE OLD MODE + CALL EBLK + MOVE A,CONTRL ;IF OLD MODE WAS RELOCATABLE OF SOME KIND, + TRNN A,DECREL\FASL + JUMPL A,SIMBL2 + SETZM CRLOC ;INITIALIZE LOCATION COUNTER. + MOVEI A,100 ; USE 100 ASSUMING ITS SBLK + TRNE B,DECSAV + MOVEI A,140 ; BUT USE 140 FOR DEC ABS. + MOVEM A,CLOC +SIMBL2: MOVEM B,CONTRL ;STORE NEW MODE. + TRNE B,ARIM\ARIM10 + TRZ F,FRSYMS ;RIM AND RIM10 MODES IMPLY NO SYMBOLS. + AOS (P) + + ;ROUTINE TO SET VARIABLES FOR BENEFIT OF NED LOGIC + ;CALLED BY OUTPUT SELECTING PSEUDOS +OUTUPD: NOVAL +IFN A1PSW,[ + TRNE FF,FRNPSS ;IF PASS 1, + TLNN FF,$FLOUT + JRST OUTCHK + AOS OUTN1 ;INDICATE "OUTPUT" HAS OCCURED OTHER THAN IN 1PASS MODE +OUTCHK: TLZE FF,$FLOUT + AOS OUTC ;INDICATE "OUTPUT" HAS OCCURED DURING CURRENT ASSEMBLY +] + RET + +ANOSYMS: NOVAL + TRZ FF,FRSYMS + JRST MACCR + +A1PASS: PUSHJ P,OUTUPD +A1PAS1: TLO FF,FLPPSS + MOVEIM A.PPASS,1 ;SET .PPASS TO 1. +IFN CREFSW,[ SKIPE CREFP ;THIS NOW PUNCHING PASS, + PUSHJ P,CRFON ;MAYBE TURN ON CREFFING. +] +IFN LISTSW,[ + SKIPE LISTP + CALL LSTON ;LIST NOW IF WANT LISTING AT ALL. +] + MOVE A,CONTRL + TRNE A,DECREL + CALL DECPGN + TRZA FF,FRNPSS +ARELOC: PUSHJ P,OUTUPD +ARELC1: PUSHJ P,EBLK ;FINISH CURRENT OUTPUT BLOCK + TRO FF,FRLOC ;DOING LOCATION ASSIGNMENT, MAKE SURE NEXT GETS OUTPUT + CLEARM CLOC + MOVEI A,1 + MOVEM A,CRLOC + CLEARM CONTRL + SETZM BKBUF + MOVEI A,LREL + DPB A,[310700,,BKBUF] + MOVEM A,CDATBC + JRST MACCR + + + ; .DECSAV - SELECT DEC ABSOLUTE ZERO-COMPRESSED (SAV) FORMAT +A.DECSAV: NOVAL + MOVSI B,DECSAV ; SET FLAG + JRST SIMBL1 ; THEN HANDLE ALMOST LIKE .SBLK + + +A.DECTWO: CALL AGETFD ;READ THE TWOSEG ORIGIN. + TRNN FF,FRNPSS + ETF [ASCIZ /.DECTWO follows 1PASS/] + MOVE C,ISAV + TRNN C,IRFLD ;NO ARG => DEFAULT IT TO 400000 + MOVEI A,400000 + MOVEM A,DECTWO + +A.DECREL: PUSHJ P,OUTUPD + TRZ FF,FRLOC + PUSHJ P,EBLK ;FORCE OUT BLOCK IN OTHER FMT. + MOVE A,[SETZ DECREL] + CAME A,CONTRL ;SWITCHING TO .DECREL MODE FOR 1ST TIME + TRNE FF,FRNPSS ;IN A 1PASS ASSEMBLY + JRST A.FAS1 + CALL A.FAS1 ;DO THE SWITCH + JFCL + CALL DECPGN ;THEN WRITE THE PROGRAM NAME + JRST MACCR + +A.FAS1: MOVEM A,CONTRL ;DEC FMT COUNTS AS ABS ASSEMBLY. + SETZM BKBUF ;(SO EBLK W0N'T OUTPUT ANYTHING) + SETZM CLOC ;START ASSEMBLING FROM RELOCATABLE 0. + MOVEI A,1 + MOVEM A,CRLOC + PUSHJ P,EBLK ;INITIALIZE AN ORDINARY (DECWDS) BLOCK. + JRST MACCR + +IFN FASLP,[ +A.FASL: PUSHJ P,OUTUPD + PUSHJ P,EBLK + MOVE A,[SETZ FASL] ;FASL ALSO COUNTS AS ABS + JRST A.FAS1 +] + +ATITLE: NOVAL + PUSH P,CASSM1 ;RETURN TO ASSEM1. + PUSHJ P,GSYL + SKIPE SYM + MOVEM SYM,PRGNM + MOVE T,[440700,,STRSTO] +ATIT2: ILDB A,T ;GET CHAR FROM TITLE STRING + SOSG STRCNT + JRST ATIT3 ;CHAR IS SYLLABLE TERMINATOR +IFE ITSSW,[ + SKIPE CCLFLG + TRNN FF,FRPSS2 +] + PUSHJ P,TYO ;NOT TERMINATOR, TYPE OUT AND LOOP BACK + JRST ATIT2 + +ATIT3: CALL ATIT1 ;PRINT THE REST OF THIS LINE. + MOVE A,CONTRL + TRNE A,DECREL + TRNE FF,FRNPSS + CAIA + ETF [ASCIZ /TITLE follows 1PASS/] + MOVE A,TTYINS + ADD A,A.PASS ;SHOULD WE .INSRT TTY: THIS PASS (T SWITCH) + JUMPG A,CPOPJ +IFDEF GTYIPA,JRST GTYIPA ;GO PUSH TO TTY IF CAN, +IFNDEF GTYIPA,GOHALT ;WHY DID YOU SET TTYINS IF CAN'T? + +ATIT1: CAIE A,15 ;CR? + CAIN A,12 ;LF? +IFN ITSSW,JRST CRR ;ONE OF THESE, FINISH TYPEOUT WITH CR +.ELSE [ JRST [ SKIPE CCLFLG + TRNN FF,FRPSS2 + JRST CRR + RET] + SKIPE CCLFLG ;NEITHER OF THESE, PRINT CHAR. + TRNN FF,FRPSS2 ;ON DEC SYS, DON'T PRINT THE TITLE ON P2, OR AT ALL IF RUN BY CCL. +] + PUSHJ P,TYO +A.ERR1: PUSHJ P,RCH ;GET NEXT CHAR IN TITLE + JRST ATIT1 + +;.ERR PSEUDO-OP -- FOLLOWED BY LINE WHICH IS ERROR MSG. +A.ERR: PUSH P,CASSM1 ;RETURN TO ASSEM1, + ERJ A.ERR1 ;AFTER NUMBERS AND USER'S STRING. + +A.FATAL:PUSH P,[GO9] ;.FATAL - CAUSE A FATAL ERROR. + ERJ A.ERR1 + +APRINT: NOVAL + HLRZS B ;B SAYS WHETHER PRINTX, PRINTC OR COMMENT. + JSP TM,ERMARK + CALL PASSPS + MOVE T,A +APRIN1: PUSHJ P,RCH + CAME A,T + JRST (B) ;GO TO APRIN1 FOR COMMENT, + JRST MACCR + +APRIN2: CAIE A,"! ;COME HERE FOR PRINTX +APRIN3: PUSHJ P,TYO ;HERE FOR PRINTC + JRST APRIN1 + +A.TYO: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A CHARACTER (AS NUMERIC ARG). + CALL TYOERR + JRST MACCR + +A.TYO6: NOVAL + CALL AGETFD ;PSEUDO TO TYPE A WORD OF SIXBIT. + MOVE B,A + CALL SIXTYO + JRST MACCR + +;.BEGIN - START NEW BLOCK WITH NAME = ARG, OR LAST LABEL DEFINED. +A.BEGIN: NOVAL + SKIPE ASMOUT ;IF IN GROUPING, FLUSH IT & ERROR. + JSP LINK,CONFLM + PUSHJ P,GETSLD ;READ A NAME. + MOVE SYM,SYSYM ;NO ARG, USE NAME OF LAST LABEL. + MOVE A,SYM ;NAME TO USE FOR BLOCK. + MOVE B,BKLVL ;CURRENT LEVEL + 1 + HRLZI B,1(B) ;IS LEVEL OF NEW BLOCK. + HRR B,BKCUR ;ITS SUPERIOR IS CURRENT BLOCK. + MOVEI C,0 ;SEE IF AN ENTRY EXISTS FOR THIS BLOCK. + MOVE AA,A.PASS +A.BEG0: CAMN A,BKTAB(C) + CAME B,BKTAB+1(C) + JRST A.BEG1 ;THIS ENTRY ISN'T FOR BLOCK BEING ENTERED. + TDNE AA,BKTAB+2(C) ;FOUND: DEFINED IN THIS PASS? + ETSM [ASCIZ /Multiply defined BLOCK/] + JRST A.BEG2 ;NO, SAY IT'S DEFINED. + +A.BEG1: ADDI C,BKWPB ;LOOK THRU ALL ENTRIES. + CAMGE C,BKTABP + JRST A.BEG0 + CAIL C,BKTABS ;ALL ENTRIES USED => ERROR. + ETF ERRTMB + MOVEM A,BKTAB(C) ;ALLOCATE NEW ENTRY + MOVEM B,BKTAB+1(C) ;STORE NAME, LEVEL, SUPPRO. + MOVEI A,BKWPB(C) + MOVEM A,BKTABP ;POINTS TO 1ST UNUSED ENTRY. +A.BEG2: IORM AA,BKTAB+2(C) ;INDICATE BLOCK SEEN THIS PASS. + MOVEM C,BKCUR ;NEW BLOCK NOW CURRENT BLOCK, + AOS A,BKLVL ;ITS LEVEL NOW CURRENT LEVEL, + CAIL A,BKPDLS ;PUSH IT ON BLOCK PDL + ETF [ASCIZ /.BEGIN nesting too deep/] + MOVEM C,BKPDL(A) + JRST ASSEM1 + +ERRTMB: ASCIZ /Too many symbol blocks/ +ERRUMB: ASCIZ /Unmatched .BEGIN - .END/ + +;.END - POP CURRENT BLOCK. +A.END: NOVAL + SKIPE ASMOUT ;IN GROUPING => TERMINATE IT & ERROR. + JSP LINK,CONFLM + MOVE A,CDISP ;IF FOLLOWED BY WORD TERM, + TLNN A,DWRD ;CAUSE IT TO BE RE-READ + TLO FF,FLUNRD ;SO ARG WILL BE NULL. + PUSHJ P,GETSLD ;READ ARG. + JRST A.END0 ;NO ARG. + MOVE C,BKCUR ;ERROR UNLESS BLOCK BEING TERMINATED + MOVE A,BKTAB(C) ;HAS SAME NAME AS ARG. + EXCH A,SYM ;(MAKE SURE SYM NAME TYPED IS BLOCK'S NAME) + CAME A,SYM + ETSM ERRUMB ;ERROR, PRINT SYM (BLOCK'S NAME) +A.END0: MOVE C,BKCUR ;NOT OK TO END .MAIN BLOCK OR .INIT BLOCK. + CAIG C,BKWPB + ETA ERRUMB + HRRZ C,BKTAB+1(C) + MOVEM C,BKCUR ;POP INTO FATHER OF PREV. CURRENT BLOCK. + SOS BKLVL + JRST ASSEM1 + +;BKTAB: 3-WORD ENTRIES, 1 PER BLOCK, IN NO PARTICULAR ORDER. +;1ST WD HAS SQUOZE NAME OF BLOCK, FLAGS CLEAR. +;2ND WD HAS LEVEL,,BKTAB IDX OF CONTAINING BLOCK("FATHER", "SUPERIOR") +;3RD WD BIT 1.N ON => BLOCK ENTERED ON PASS N. +;SYMBOL TABLE OUTPUT RTN PUTS -2* IN 3RD WD. +;THE FIRST BKTAB ENTRY IS THAT OF THE OUTERMOST BLOCK (.INIT) +;IN WHICH INITIAL SYMS ARE DEFINED. +;THAT ENTRY'S 2ND AND 3RD WDS ARE 0. +;THE NEXT IS THAT OF THE MAIN BLOCK (.MAIN) IN WHICH +;ALL SYMBOLS ARE NORMALLY DEFINED (THAT IS, YOU ARE IN THAT BLOCK +;BEFORE YOU DO ANY .BEGIN'S). +;THAT ENTRY'S 2ND WD IS 1,, ; ITS 3RD, 0. + +;THE BKPDL IS A TABLE OF BLOCKS CURRENTLY ENTERED & NOT ENDED. +;BKPDL'S 1ST ENTRY IS FOR OUTERMOST BLOCK. +;LAST ENTRY IS BKPDL+@BKLVL, FOR CURRENT BLOCK. + +BKTABS==BKTABL*BKWPB + +VBLK +BLCODE [ +BKTAB: BLOCK 3 ;ENTRY FOR .INIT BLOCK. +PRGNM: BLOCK BKTABS-BKWPB ;PROGRAM NAME IS NAME OF MAIN BLOCK. +] +BKTABP: 0 ;IDX IN BKTAB OF 1ST UNUSED ENTRY. +BKPDL: BLOCK BKPDLS ;TABLE OF BLOCKS STARTED, NOT FINISHED. +BKLVL: 0 ;CURRENT BLOCK LEVEL, IDX OF LAST USED IN BKPDL. +BKCUR: 0 ;BKTAB IDX OF CURRENT BLOCK. +ESBK: 0 ;-1 OR BLOCK TO EVAL SYM. IN. +ESL1: 0 ;IN ES, LEVEL OF BLOCK OF BEST SYM SO FAR. +ESL2: 0 ;3RDWRD OF BEST SO FAR. +SADR: 0 ;SYM TAB IDX OF BEST SO FAR. +ESLAST: 0 ;RH IDX OF LAST DEF (EVEN IF NO GOOD) -1 IF NONE + ;SIGN NEG. IF LAST DEF SEEN BEFORE @ESXPUN +ESXPUN: -1 ;IF SEE EXPUNGED OR FREE ENTRY, PUT IDX HERE. +BKTAB1: BLOCK BKTABL ;USED BY SSYMD. +PBLK + +;.SYMTAB ARG ;SAY WANT AT LEAST ARG STE'S IN SYMTAB. +A.SYMTAB: NOVAL + PUSH P,[0] ;THIS WORD WILL BE SETOM'ED IF THERE IS REALLY ANY WORK NEEDED. + PUSHJ P,AGETFD ;GET DESIRED SYM TAB SIZE. + CAMG A,SYMLEN ;IF HAVE ENOGH ROOM ALREADY, + JRST A.SYM1 ;NO NEED TO RE-INIT. + CAILE A,SYMMAX ;IF WANTS MORE THAN MAXIMUM, ERROR. + ETF [ASCIZ/.SYMTAB 1st arg too big/] + MOVEM A,SYMLEN ;TELL INITS ABOUT NEW SIZE. + SETOM (P) +A.SYM1: CALL AGETFD ;READ DESIRED CONSTANTS TABLE SPACE ALLOCATION. + CAMG A,CONLEN ;IF TABLE ALREADY BUG ENOUGH, NOTHING TO DO. + JRST A.SYM2 + CAILE A,CONMAX + ETF [ASCIZ/.SYMTAB 2nd arg too big/] + MOVEM A,CONLEN ;ELSE REMEMBER IT AND SAY REALLOCATION NECESSARY. + SETOM (P) +A.SYM2: CALL AGETFD ;3RD ARG IS # WORDS PER SYMBOL - BUT ONLY 3 IS ALLOWED NOW. + JUMPE A,A.SYM3 ;EVENTUALLY 4 WILL GET 12-CHARACTER SYMBOLS. + CAIL A,MINWPS + CAILE A,MAXWPS + ETF [ASCIZ/.SYMTAB 3rd arg out of range/] + CAME A,WPSTE + SETOM (P) + MOVEM A,WPSTE +A.SYM3: REST A ;IS THERE ANYTHING THAT ACTUALLY NEEDS TO BE CHANGED? + JUMPE A,ASSEM1 ;IF NOT, NEVER GIVE ERROR - ELSE WOULD ALWAYS LOSE ON PASS 2. + MOVE B,PLIM + CAMN B,CONTBA ;IF THERE HAVE BEEN ANY LITERALS + SKIPE INICLB ;OR ANY MACROS, IRPS, REPEATS, ETC., THEN ... + ETF [ASCIZ/Too late to do .SYMTAB/] + MOVE CH1,MACTAD ;SET UP AC -> START OF INIT CODE + SUBI CH1,MACTBA ;SO IT CAN REFER TO ITSELF. + PUSHJ P,INITS(CH1) ;RE-INIT, SET SYMSIZ, SYMAOB, ETC. + PUSHJ P,MACINI ;INIT PTRS TO END OF MACTAB. + JRST ASSEM1 + +A.OP: PUSHJ P,A.OP1 ;.OP, + JRST VALRET ;RETURNS VALUE + +A.AOP: NOVAL + AOS (P) ;.AOP DOESN'T RETURN VALUE +A.OP1: PUSHJ P,AGETFD + PUSH P,A + PUSHJ P,AGETFD + PUSH P,A ;PDL NOW HAS FIELD 0 AND FIELD 1 + PUSHJ P,AGETFD + POP P,B ;B NOW HAS FIELD 1, A HAS FIELD 2, PDL HAS FIELD 0 + EXCH A,B + POP P,T ;T HAS FIELD 0, A HAS FIELD 1, B HAS FIELD 2 + TLNN T,(0 17,) ;IF AC FIELD NOT PRESENT IN INSN, SUPPLY ONE. + TLO T,(0 A,) + TDNN T,[0 -1(17)] ;IF NO ADDR OR IDX FIELD IN INSTRUCTION, + HRRI T,B ;SUPPLY ONE. + SETOM A.ASKIP' ;.ASKIP WILL BE -1 IFF INSN SKIPPED, ELSE 0. + TLNE T,74000 ;AVOID EXECUTING OPCODE ZERO. + XCT T + SETZM A.ASKIP + MOVEM A,AVAL1' ;STORE C(AC) AS .AVAL1 + MOVEM B,AVAL2' ;STORE C(E) FOR .AVAL2 + POPJ P, ;RETURN TO WHATEVER + +AASCIZ: TDZA T,T +A.ASCII: MOVEI T,1 + MOVEM T,AASCF1 ;STORE TYPE + MOVE D,[440700,,T] + SETZM AASCFT + JRST AASC1 + +AASCII: SKIPA D,[440700,,T] +ASIXBI: MOVE D,[440600,,T] + SETZM AASCFT ;INDICATE NOT .DECTXT + SETOM AASCF1 ;INDICATE REGULAR (NOT ASCIZ) + JRST AASC1 + +A.DCTX: NOVAL + MOVE A,CONTRL + TRNN A,DECREL + ETA [ASCIZ /.DECTXT in non-DECREL assembly/] + CALL EBLK + SETZ B, + SETOM AASCFT + SETOM AASCF1 ;INDICATE ASCIZ-STYLE PADDING + MOVE D,[440700,,T] +AASC1: TLZE I,ILMWRD + JRST TEXT2 ;MULTIPLE WORD, FALL IN FOR NEXT SET OF CHARS + MOVEMM ASMDS1,ASMDSP + MOVEM SYM,DEFNPS ;REMEMBER LOCATION IN FILE OF PSEUDO + MOVEMM DEFNLN,CLNN ;IN CASE THE DELIMITER IS MISSING. + MOVEMM DEFNPN,CPGN +IFN TS, MOVEMM DEFNFI,INFFN1 + HLRZ T,B ;GET FILL CHARACTER + IMUL T,[REPEAT 5,[1_<.RPCNT*7>+]0] ;CONVERT TO ASCII FILL WORD SHIFTED -1 (IMUL SCREW) + LSH T,1 ;SHIFT TO PROPER POSITION (EXTRA IN CASE WANT TO FILL W/ HIGH BIT SET) + MOVEM T,AASEFW ;STORE AS FILL WORD, T NOW SET UP TO ACCUMULATE VALUE + CALL PASSPS + MOVEM A,TEXT4 ;STORE TERMINATOR +TEXT7: PUSHJ P,RCH +AASC8: CAMN A,TEXT4 + JRST AASC1A ;TERMINATOR + TLNN D,760000 + JRST TEXT6 ;WORD FULL +TEXT9: TLNE D,100 ;CHECK BOTTOM BIT OF SIZE FIELD OF BP + JRST AASC2 ;SET => NOT SIXBIT + SUBI A,40 + CAILE A,77 + SUBI A,40 ;CONVERT LOWER CASE ASCII TO UPPER CASE + JUMPGE A,.+2 + ETR ERRN6B +AASC3: IDPB A,D + TRO I,IRSYL + JRST TEXT7 + +ERRN6B: ASCIZ /Character not SIXBIT/ + +;TERMINATOR + +AASC1A: TLNN D,760000 ;SKIP UNLESS END OF WORD + SKIPGE AASCF1 ;SKIP UNLESS REGULAR + JRST [ MOVE CH1,ASMDS1 ;REGULAR OR NOT END OF WORD + MOVEM CH1,ASMDSP ;RESTORE ASMDSP AS SAVED AT START OF PSEUDO. + JRST TEXTX] + MOVEI CH1,1 ;END OF WORD AND NOT REGULAR + JRST AASC1B ;EXTRA 0 NEED FOR Z FLAVOR + +AASC2: CAIN A,"! + SKIPG AASCF1 + JRST AASC3 ;NOT .ASCII OR NOT EXCL + PUSH P,T ;READ FIELD + PUSH P,TEXT4 + PUSH P,D + PUSH P,SYM + PUSH P,ASMOUT ;PREVENT CLOSEBRACKETS FROM TRYING TO TAKE EFFECT. + MOVEIM ASMOUT,4 ;NOTE THIS LOSES IF CALL PSEUDO THAT RETURNS TO ASSEM1. + MOVEI SYM,[SETOM ASUDS1] ;NOW TO SET UP UNDEFINED SYM CONDITION + TLNE FF,FLPPSS + MOVE SYM,[SQUOZE 0,.ASCII] ;PUNCHING PASS, UNDEFINED => REAL ERROR + CLEARM ASUDS1 + PUSHJ P,AGETFD + ;"UNDEFINED IN .ASCII" ERROR INSTR, ERROR MESSAGE BUT ONLY ON PASS 2 + ;BUT NOTE THAT ON PASS 2 IT MIGHT ASSEMBLE DIFFERENT NUMBER OF WORDS, + ;CAUSING LOSSAGE IF NOT IN CONSTANT + REST ASMOUT + POP P,SYM + POP P,D + POP P,TEXT4 + POP P,T + SKIPGE ASUDS1 + MOVNI A,1 ;HAD UNDEFINED SYMS SO ASSUME MAX + SKIPGE ASUDS1 + TLO I,ILNOPT ;ALSO DON'T OPTIMIZE OVER IN CONSTANT + MOVE CH1,[440700,,AASBF] + MOVEM CH1,ASBP1 + MOVEM CH1,ASBP2 + PUSH P,[AASC5] + MOVE CH1,A +AASC6: LSHC CH1,-35. + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,AASC6 + HLRZ A,(P) + ADDI A,"0 + IDPB A,ASBP1 + POPJ P, + +AASC5: MOVEI A,0 + IDPB A,ASBP1 ;END .ASCII NUMBER WITH ZERO +AASC8A: TLNN D,760000 + JRST AASC7 ;END OF WORD + ILDB A,ASBP2 + JUMPE A,AASC9 + IDPB A,D + JRST AASC8A + +AASC9: TLO FF,FLUNRD + JRST TEXT7 + +AASC7: TDZA CH1,CH1 +TEXT6: MOVNI CH1,1 ;WORD FULL +AASC1B: MOVEM CH1,AASCF2 + CLEARM CDISP + MOVEM A,TEXT8 + MOVE A,T + SKIPE AASCFT ;FOR .DECTXT, OUTPUT WORD INSTEAD OF RETURNING IT. + JRST [ CALL PPB + MOVE D,[440700,,T] + JRST TEXT2A] + TLO I,ILMWRD ;ELSE ARRANGE TO BE CALLED BACK TO RETURN NEXT WORD. + MOVEI T,ASSEM2 + MOVEM T,ASMDSP + SKIPLE CONSML ;IF NOT MULTI-LINE MODE, + JRST CLBPOP + MOVE T,ASMOUT ;IF THE TEXT IS IN <>'S OR ()'S, + HRRZ T,ASMOT2(T) + CAIE T,LSSTHA + JRST CLBPOP + CALL IGTXT ;USE ONLY THE FIRST WORD. + SKIPE CONSML ;AND ERROR IF IN ERROR MODE. + ETR [ASCIZ/Multi-word text pseudo in brackets/] + JRST CLBPOP + + ;GET NEXT WORD + +TEXT2: TRO I,IRFLD +TEXT2A: MOVE T,AASEFW ;INITIALIZE T TO FILL WORD + MOVE A,TEXT8 ;GET NEXT CHAR (ALREADY READ BY RCH) + SKIPGE B,AASCF2 + JRST TEXT9 ;REG OR HAVEN'T READ SECOND DELIMITER, FALL BACK IN + JUMPE B,AASC8A +TEXTX: SETZM DEFNPS + SETOM TEXT4 + SKIPN AASCFT + JRST TEXT5 ;RETURNING FROM ASCIZ AFTER PUTTING THE TRAILING ZERO OUT. + MOVE A,T + CALL PPB ;FOR .DECTXT, OUTPUT THE FILL WORD INSTEAD. + JRST MACCR + +VBLK + +AASCF1: 0 ;-1 REG OR SIXBIT, 1 .ASCI 0 ASCIZ +AASCF2: 0 ;MULTIPLE WORD RETURN FLAG -1 REG 0 FINISH ! HACK 1 OUTPUT FILL WORD FOR Z +AASCFT: 0 ;0 REGULAR, -1 => .DECTXT (OUTPUT WORDS TO FILE INSTEAD OF RETURNING THEM) +TEXT4: -1 ;DELIMITER, OR -1 IF NOT INSIDE A TEXT PSEUDO. +TEXT8: 0 ;SAVED NEXT CHAR WHILE RETURNING BETWEEN WORDS +ASBP1: 0 ;IDPB TO AASBF ON .ASCII FIELD +ASBP2: 0 ;ILDB FROM AASBF " +AASBF: BLOCK 8 ;ACCUMULATED TYPEOUT OF NUMBER FOR .ASCII, EXTRA LONG FOR HACKERS TYPING OUT BINARY +ASUDS1: 0 ;UNDEFINED SYM FLAG FOR .ASCII DURING PASS 1 +AASEFW: 0 ;FILL WORD + +PBLK + +IGTXT: TLNN I,ILMWRD + RET + PUSH P,A ;ROUTINE TO EAT UP TEXT OF UNDESIRED MULTIPLE WORD + SKIPLE AASCF2 ;DETECT SCREW CASE: AFTER ASCIZ OF 5 CHARS, DELIMITER IS + JRST IGTXT1 ;ALREADY GOBBLED, BUT SOME OF THE ASCIZ REMAINS. + PUSHJ P,RCH + CAME A,TEXT4 + JRST .-2 +IGTXT1: TLZ I,ILMWRD + MOVEMM ASMDSP,ASMDS1 + SETZM DEFNPS + SETOM TEXT4 + JRST POPAJ + +;".ASCVL /X" RETURNS THE ASCII VALUE OF "X". NOTE THE DELIMITER IS NOT REPEATED +;AND SERVES ONLY TO ALLOW SPACES TO BE IGNORED WHILE WINNING IF X IS A SPACE. +A.ASCV: CALL PASSPS ;SKIP SPACES TO REACH THE DELIMITER. + CALL RCH ;READ THE CHAR AFTER THE DELIMITER + MOVE T,A + JRST TEXT5 ;AND RETURN ITS ASCII VALUE. + +ASQOZ: HLLM B,(P) ;SAVE FLAG THAT'S 0 FOR SQUOZE, -1 FOR .RSQZ . + PUSH P,SYM + PUSHJ P,AGETFD + LSH A,36 + PUSH P,A + PUSHJ P,GETSLD ;GET SYM, SAVE DELIMITER FOR REINPUT + CALL NONAME + REST A + LDB B,[4000,,SYM] ;GET JUST THE SQUOZE. + SKIPGE -1(P) + PUSHJ P,ASQOZR ;FOR .RSQZ, RIGHT-JUSTIFY IT. + SUB P,[1,,1] + ADD A,B + JRST CLBPOP + +;RIGHT-JUSTIFY THE SQUOZE WORD IN B. +ASQOZR: MOVE SYM,B + IDIVI SYM,50 + JUMPN LINK,CPOPJ ;LAST ISN'T BLANK, DONE. + MOVE B,SYM ;ELSE REPLACE BY WHAT'S SHIFTED RIGHT 1 CHAR. + JRST ASQOZR + + ;COMMON PSEUDO ROUTINE TO RETURN MIDAS INTERNAL QUANTITY + ;ADR IN LH(B)) AS VALUE (EG. .RPCNT, .FNAM1, .AVAL2, ETC. + ;INTSYMS MAY APPEAR TO LEFT OF = + +INTSYM: MOVE A,B ;GET ADR IN LH(A) + JRA A,CLBPOP ;RETURN IT + + ;.YSTGW, .NSTGW ACCORDING TO WHAT'S IN LH(B) + +STGWS: HLRES B ;.NSTGW INCREMENTS STGSW, .YSTGW DECREMENTS. + ADDB B,STGSW + SKIPGE B ;BUT DON'T DECREMENT PAST 0. + SETZM STGSW + JRST MACCR ;STORAGE WORDS ARE ALLOWED IF STGSW IS ZERO. + + ;.TYPE + +A.TYPE: PUSH P,SYM + PUSH P,SYM + PUSHJ P,GETSLD ;GET NAME + CALL NONAME + SUB P,[2,,2] + TRNN I,IRLET ;IF SYLLABLE IS A NUMBER, + JRST [ SETO A, ;RETURN -1. + JRST CLBPOP] + PUSHJ P,ES ;EVALUATE SYM, INTERESTED IN SQUOZE FLAGS RETURNED IN A + MOVEI A,17 ;DIDN'T SKIP, RETURN 17 => UNSEEN +IFN CREFSW,XCT CRFINU + JRST CLBPOP + +NONAME: MOVE SYM,-2(P) + ETSM [ASCIZ /No arg/] + SETZ SYM, + POPJ P, + + ;.FORMAT + +A.FORMAT: PUSHJ P,AGETFD ;GET FIRST FIELD (FORMAT #) + MOVE B,CDISP ;WORD TERMINATOR ENDED 1ST ARG => + TLNN B,DWRD + JRST A.FOR1 ;RETURN CURRENT SPEC FOR THAT FORMAT. + PUSH P,A + PUSHJ P,AGETFD ;GET SECOND FIELD (TABLE ENTRY FOR FORMAT NUMBER) + POP P,B + MOVEM A,FORTAB-10(B) + JRST ASSEM1 + +A.FOR1: MOVE A,FORTAB-10(A) + JRST CLBPOP + +A.BYTE: NOVAL + CLEARM NBYTS ;# BYTES ASSEMBLED + CLEARM BYTMT ;TOTAL ACTIVE BYTES IN TABLE + MOVE A,[440700,,BYBYT] ;POINTER TO NEW TABLE + MOVEM A,BYTMP +A.BY1: PUSHJ P,AGETFD ;GET FIELD, .GE. 0 => BYTE, .LT. 0 => HOLE + MOVE C,ISAV + TRNN C,IRFLD + JRST A.BY2 ;NO FIELD + MOVM B,A + SKIPGE A + TRO B,100 + IDPB B,BYTMP + AOS BYTMT +A.BY2: TLNE CH1,DWRD ;CDISP LEFT IN CH1 BY AGETFD + JRST A.BY1 ;NOT WORD TERMINATOR + SKIPN BYTMT ;WORD TERMINATOR, ANY FIELDS? + JRST A.BY3 ;NO, DO .WALGN AND RESET TO WORD MODE + SETOM BYTM ;ENTERING BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETOM BYTM1 + PUSHJ P,BYSET + MOVE A,GLSPAS + MOVEM A,GLSP1 + JRST ASSEM1 + + ;RESET THE BYTE DESCRIPTOR TABLE POINTERS TO POINT TO NEW WORD + +BYSET: CLEARM BYTMC ;COUNT OF BYTES PROCESSED THIS TABLE SCAN + MOVE A,[440700,,BYBYT] ;POINTER TO DESCRIPTOR TABLE + MOVEM A,BYTMP + ILDB A,BYTMP ;FIRST DESCRIPTOR BYTE + AOS BYTMC + DPB A,[300600,,BYTWP] ;DEPOSIT AS FIRST BYTE SIZE + POPJ P, + +A.BY3: CLEARM BYTM ;NO LONGER IN BYTE MODE + MOVE A,[-LPDL,,PDL] + CAMN A,ASSEMP + SETZM BYTM1 + JRST A.WAL1 + +A.WALGN: NOVAL +A.WAL1: LDB A,[360600,,BYTWP] + CAIN A,44 + JRST ASSEM1 ;ALREADY AT BEGINNING OF WORD + MOVEI A,44 + DPB A,[360600,,BYTWP] ;MAKE IT POINT TO BEGINNING OF WORD + PUSHJ P,BYSET + CLEARM T1 + JRST PBY1 + +BYTIN1: CLEARM BYTMC + MOVE A,[440700,,BYBYT] + MOVEM A,BYTMP +BYTINC: AOS A,BYTMC + CAMLE A,BYTMT + JRST BYTIN1 + ILDB A,BYTMP + DPB A,[300600,,BYTWP] + MOVEM A,T1 + HLLZ A,BYTWP + IBP A + TRNN A,-1 + JRST BYTINR + ;NEXT BYTE GOES IN NEXT WORD +PBY1: MOVE P,ASSEMP ;PCONS NEEDS THIS. + MOVEI A,WRD-1 + PUSH A,BYTW ;INTO WRD, + PUSH A,BYTRLC ;INTO WRDRLC + CLEARM BYTW + SETZM BYTRLC + MOVEI A,44 + DPB A,[360600,,BYTWP] + MOVE AA,ASMOUT + JRST @ASMOT4(AA) ;TO PBY4 OR PBY5 OR PBY3 + +PBY4: SKIPE STGSW + ETR ERRSWD + PUSHJ P,PWRD ;NOT IN CONST., OUTPUT WORD. + AOSA CLOC +PBY3: JSP T,PCONS ;OUTPUT INTO CONST. +PBY5: MOVE A,GLSPAS + MOVEM A,GLSP1 +BYTINR: MOVE A,T1 ;CURRENT BYTE SIZE + TRNN A,100 + JRST @ASMDSP + SETZB A,B ;ASSEMBLE HOLE (BLANK BYTE) IMMEDIATELY AFTER PREVIOUS BYTE + JRST PBY2 + +PBYTE: AOS NBYTS +PBY2: MOVEI AA,WRD-1 + PUSH AA,BYTW ;INTO WRD + PUSH AA,BYTRLC ;INTO WRDRLC + IBP BYTWP + LDB T,[301400,,BYTWP] + PUSHJ P,INTFLD + POP AA,BYTRLC ;WRDRLC + POP AA,BYTW ;WRD + JRST BYTINC + + ;VARIABLES FOR .BYTE, .BYTC, .WALGN + +VBLK +BYTM: 0 ;-1 FOR IN BYTE MODE, LAMBDA BOUND BY <'S, ('S, AND ['S ;] +BYTMC: 0 ;COUNT CORRESP WITH BYTMP +BYTMP: 0 ;POINTER TO BYTE DESC TABLE +BYTMT: 0 ;TOTAL ACTIVE BYTES IN TABLE +BYTM1: 0 ;GLOBAL VALUE OF BYTM - WHAT IT WAS OUTSIDE THE OUTERMOST BRACKET + +;FORMAT OF BYTE DESC TABLE +;SEVEN BIT BYTES +;1.7=0 ASSEMBLE =1 BLANK +;1.1 - 1.6 NUMBER OF BITS + +IFNDEF LBYBYT,LBYBYT==5 ;LENGTH OF BYBYT +BLCODE [BYBYT: BLOCK LBYBYT] ;BYTE DESC TABLE, 7 BITS PER DESC + +BYTWP: 440000,,BYTW ;POINTER TO BYTW IDPB TO DEPOSIT CURRENT BYTE +BYTW: 0 ;WORD BEING ASSEMBLED IN BYTE MODE +BYTRLC: 0 ;RELOC OF BYTW. +NBYTS: 0 ;NUMBER BYTES ASSEMBLED (FOR .BYTC) +BYTMCL==.-BYTMC +PBLK + +;;MACRO PROCESSOR +IFN MACSW,[ + ;GET IN B THE CHAR WHOSE ADR IS IN A, INCREMENT A + +REDINC: MOVE CH1,A + IDIVI CH1,4 + LDB B,PTAB(CH2) + AOJA A,CPOPJ + +VBLK ;THIS STUFF ALL RELOCATED WHEN MACTAB ADDR CHANGED. +PTAB: (341000+CH1)MACTBA ;BYTE TABLE + (241000+CH1)MACTBA + (141000+CH1)MACTBA + (41000+CH1)MACTBA + (341000+CH1)MACTBA+1 + + ;IN FOLLOWING MACROS, B = -1, 0, OR +1 (+ SIGN MUST BE GIVEN) + ;0 => BP SAME AS CHAR ADR, -1 => BP FOR ILDB, 1 => BP ONE AHEAD + + ;CHAR ADR IN A, RETURNS BP IN A, CLOBBERS A+1 + +DEFINE BCOMP A,B/ + IDIVI ,4 + ADD ,(+1)BCOMPT!B +TERMIN + +STOPPT: 041000,,MACTBA-1 +BCOMPT: 341000,,MACTBA + 241000,,MACTBA +BCOMPU: 141000,,MACTBA + 041000,,MACTBA + 341000,,MACTBA+1 + +;BP IN A RETURN CHAR ADR IN A, CLOBBERS A-1 (YES, A MINUS 1) +;2ND ARG IS SUBTRACTED - -1 GIVES ADDR OF THE NEXT CHAR. +DEFINE CCOMP A,B/ + MOVEI -1,0 + ASHC -1,2 + SUB ,(-1)CCOMPT!B +TERMIN + + ;BP IN A RETURN CHAR ADR IN A+1, CLOBBERS A + +DEFINE CCOMP1 A,B/ + MULI ,4 + SUB +1,(A)CCOMPT!B +TERMIN + +;FROM HERE THRU CCOMPE SET BY MACINI. +CCOMPB: 0 ;4*<41000,,MACTBA>-4 +CCOMPT: REPEAT 5,0 ;4*<41000,,MACTBA>+.RPCNT-3 +CCOMPE::PBLK + + ;BP IN A, DECREMENT IT + +DEFINE DBPM A + ADD A,[100000,,] + SKIPGE A + SUB A,[400000,,1] +TERMIN + +;SET UP CPTR FROM CHAR ADR IN A + +ACPTRS: MOVEI CH1,(A) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE COMPUTED CPTR + POPJ P, + +AFCOMP: HRRZM A,FREEPT ;ENTRY TO STORE C(A) INTO FREEPT +FCOMP: MOVE CH1,FREEPT ;COMPUTE FREPTB FROM FREEPT + BCOMP CH1,-1 + MOVEM CH1,FREPTB ;STORE CALCULATED BYTE POINTER + POPJ P, + +STPWR: MOVEI A,375 + JRST PUTREL + +VBLK +PUT377: MOVEI A,377 +PUTREL: JRST PUTRE1 ;IDPB A,FREPTB;STORE CHAR INTO FREE CHARACTER STORAGE + AOS A,FREEPT ;CLOBBERS ONLY A. + AOS PUTCNT + CAMGE A,MACHI + POPJ P, + JRST GCA +PBLK +PUTRE1: PUSH P,[IDPB A,FREPTB] + POP P,PUTREL ;COME HERE ONLY ON 1ST CALL TO PUTREL. + SETOM INICLB ;HAVE WRITTEN IN MACRO TAB & CLOBBERED INIT. + JRST PUTREL ;NOW GO BACK AND REALLY WRITE CHAR. + +;200 BIT SET ON CHAR READ FROM MACTAB, PROCESS SPECIAL CONDITION +;CLOBBERS A,CH1,CH2. + +MACTRM: CAIN A,176 ;376? + JRST RCHTRA ;376 => IGNORE, CHARACTER USED TO CLOBBER UNDESIRED CHARACTERS IN MACRO STORAGE + PUSH P,B ;SAVE B + CAIE A,177 + CAIN A,175 + JRST MRCH1 ;377, 375 => STOP + ADD A,BBASE ;DUMMY, RELOCATE TO POINT TO DUMMY TABLE + MOVEI B,RCHSAV ;RETURN TO RCHSAV ON END OF DUMMY + PUSHJ P,PUSHEM ;SAVE CURRENT STATUS + HRRZ A,(A) ;GET CHAR ADR OF DUMMY + BCOMP A,-1 ;CONVERT TO BYTE POINTER + MOVEM A,CPTR ;STORE AS NEW CPTR + MOVE A,TOPP + MOVEM A,BBASE +RCHTRB: POP P,B +RCHTRA: POP P,A ;POP RETURN + TLZN FF,FLUNRD ;IF NO CHAR TO RE-READ, JUST RETURN BACK TO THE ILDB A,UREDP. + JRST -3(A) + ANDI A,-1 ;IF A CHAR TO RE-READ, IF CALLED FROM RREOF, WE CAN RETURN TO RRU + CAIN A,RREOF+1 + JRST RRU + PUSH P,A ;OTHERWISE, CALL RCH TO RE-READ THAT CHAR, AND RETURN IT FROM + JRST RCH1 ;THE CURRENT ATTEMPT TO READ A CHAR. + +MRCH1: MOVE B,MACP +BPOPJ: POPJ B, ;RETURN AT END OF STRING EXPANSION + +;RCHSET ROUTINE TO CAUSE INPUT FROM MACRO PROCESSOR + +RCHMAC: TLO FF,FLMAC ;SET FLAG + JSP A,CPOPJ +RCHMC0: REPEAT 2,[ ;GETCHR, RR1 + ILDB A,CPTR ;GET CHAR + TRZE A,200 ;200 BIT... + PUSHJ P,MACTRM ;=> SPECIAL, PROCESS +] + GOHALT +IFN .-RCHPSN-RCHMC0,.ERR RCHMC0 LOSES. + ILDB A,CPTR ;SEMIC + TRZE A,200 + PUSHJ P,MACTRM + CAIE A,15 + JRST SEMIC ;NOT YET + JRST SEMICR ;YET + + ;PUSH INPUT STATUS IN FAVOR OF MACRO + ;B HAS RETURN ADR FOR END OF MACRO (OR WHATEVER) + ;SEE ALSO PMACP + +PUSHEM: PUSH P,A + PUSH P,F + MOVE F,MACP ;GET MACRO PDL POINTER + MOVE CH1,CPTR + CCOMP1 CH1,-1 ;CONVERT TO CHARACTER ADDRESS + HRL CH2,BBASE + PUSH F,CH2 ;PUSH BBASE,,CPTR + MOVEI A,1 ;=> EXPAND MACRO + PUSHJ P,PSHLMB ;SAVE LIMBO1 STATUS AND RETURN + JRST PSHM1 + + ;UNDO A PUSHEM + ;RETURNS BBASE,,CPTR IN B (CPTR RE-INITIALIZED, BBASE NOT) + +POPEM: PUSH P,A + PUSH P,F + MOVE F,MACP + PUSHJ P,POPLMB ;RESTORE LIMBO1 STATUS + POP F,B ;BBASE,,CPTR + MOVEI CH1,(B) ;GET CHAR ADR IN CH1 + BCOMP CH1,-1 ;CONVERT TO BYTE POINTER + MOVEM CH1,CPTR ;STORE NEW CPTR +PSHM1: MOVEM F,MACP ;STORE BACK MACRO PDL POINTER +POPFAJ: POP P,F +POPAJ: POP P,A + POPJ P, + +PMACP: MOVE B,MACP ;POP MACRO PDL + HRRZ A,(B) + SUB B,[1,,1] +IFN RCHASW,CAIE A,A.TYM8 + CAIN A,AIRR + JRST A.GO6 ;IRP OR .TTYMAC + CAIN A,REPT1 + JRST A.GO4 ;REPEAT + CAIE A,RCHSV1 ;MACRO + CAIN A,RCHSAV ;ARG + JRST A.GO6 + GOHALT ;DON'T HAVE RETURN, + JRST A.GO6 ;BUT TRY A.GO6 LIKE EVERYTHING BUT REPEAT + +A.GO4: HLLZS -1(B) ;REPEAT, CLEAR OUT COUNT REMAINING +A.GO6: TRO FF,FRMRGO ;EVERYTHING ELSE, SET FLAG TO QUIT + JRST (A) + + ;4.9(B) => .STOP ELSE .ISTOP + +A.STOP: HRRZ A,MACP + JUMPL B,A.STP1 + HRRZ B,(A) ;.ISTOP + CAIN B,REPT1 + HLLZS -2(A) ;REPEAT, STOP ALL INTERATIONS + CAIN B,AIRR + HRRZS -1(A) ;IRP TYPE, CLEAR OUT # GROUPS, DON'T ALLOW RECYCLE +A.STP1: MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP + JRST POPJ1 + +A.QOTE: JFCL +ATERMI: ETSM [ASCIZ/Not in macro/] + JRST MACCR ;MAYBE FLUSH MESSAGE IF PEOPLE HAVE PROBLEMS + +;PDL STRUCTURE FOR REPEAT +;TWO TWO WORD ENTRIES +;BBASE,,CPTR +;LIMBO1 STATUS,,# TIMES LEFT +;OLD .RPCNT,,BEG OF BODY +;GARBAGE,,REPT1 + +AREPEAT: PUSHJ P,AGETFD + JUMPLE A,COND5 ;NO REPEAT PLAY LIKE STRING COND FALSE + PUSH P,A + MOVE A,FREEPT + MOVEM A,PRREPT ;CHAR ADR BEGINNING OF REPEAT + MOVEI A,373 ;CHECK CHAR FOR REPEAT + PUSHJ P,PUTREL ;STORE AS FIRST CHR OF BODY + JSP D,RARL1 + CAIA + CALL RARGCP ;READ THE ARG & COPY INTO MACRO STORAGE. + MOVEI A,^M ;IF THE ARG WASN'T BRACKETED, + TLNE FF,FLUNRD + CALL PUTREL ;INCLUDE THE TERMINATING CR. +SWRET1: PUSHJ P,STPWR ;ALSO RETURN FROM STRING WRITE (.F .I) + POP P,B ;# TIMES TO GO THROUGH + PUSHJ P,PUSHEM + MOVE B,MACP ;NOW GET MACRO PDL POINTER FOR PUSH OF SECOND ENTRY + MOVNI T,1 + EXCH T,CRPTCT ;GET OLD .RPCNT, INITIALIZE NEW ONE TO -1 +CREPT1: SETZI TT,REPT1 + EXCH TT,PRREPT ;GET LOC BEGINNING OF BODY, CLEAR OUT PRREPT, DON'T NEED IT ANYMORE + HRL TT,T + PUSH B,TT ;SAVE OLD .RPCNT,,ADDRESS OF BODY. + PUSH B,CREPT1 ;PUSH CRUD,,REPT1 FOR RETURN + MOVEM B,MACP ;STORE BACK UPDATED MACRO POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE IMMEDIATE CYCLE + JRST MACCR + +IFN .I.FSW,[ ;CODING FOR .I, .F + +SWINI: MOVE A,FREEPT ;INITIALIZE, WILL EVENTUALLY PLAY LIKE REPEAT 1 + MOVEM A,PRREPT + MOVEI A,373 + JRST PUTREL + +SWRET: PUSH P,[1] ;REPEAT COUNT + JRST SWRET1 + +SWFLS: MOVE A,PRREPT ;FLUSH RETURN + PUSHJ P,AFCOMP + JRST MACCR +] + +;RECYCLE AROUND REPEAT + +REPT1: PUSH P,A + PUSH P,C + HRRZ A,(B) ;CHAR ADR BEG BODY + PUSHJ P,REDINC + CAIE B,373 + GOHALT ;FIRST CHAR OF REPEAT BODY NOT 373 + HRRZ C,MACP + HRRZ B,-2(C) ;# TIMES LEFT + SOJL B,REPT2 ;JUMP IF LAST TIME THROUGH WAS LAST TIME TO GO THROUGH + AOS CRPTCT + PUSHJ P,ACPTRS ;SET UP CPTR (CHAR ADR IN A) + HRRM B,-2(C) ;STORE UPDATED COUNTDOWN +REPT3: POP P,C + POP P,A + JRST REPT6 + +REPT2: SOS A ;MOVE BACK TO BEG OF REPEAT + ;(IN CASE GETS STORED INTO FREEPT) + MOVE CH2,CPTR + CCOMP CH2,-1 ;CONVERT TO CHARACTER ADDRESS + CAMN CH2,FREEPT + PUSHJ P,AFCOMP + MOVE A,[-3,,-2] + ADDB A,MACP + HLRZ A,1(A) + MOVEM A,CRPTCT + PUSHJ P,POPEM + JRST REPT3 + +;STRING CONDITIONALS (IFSE, IFSN) + +SCOND: MOVE A,FREEPT + MOVEM A,PRSCND + MOVEM A,PRSCN1 + PUSH P,SYM + HRRI B,SCONDF + PUSH P,B ;REMEMBER TEST INSTRUCTION. + SETOB C,SCONDF + JSP D,RARG ;COPY THE 1ST OF THE 2 STRINGS + CAIA + CALL RARGCP ;INTO MACRO STORAGE, FOLLOWED BY 375. + CALL STPWR + JSP D,RARG ;THEN START READING THE 2ND ARG, + JRST SCOND3 ;GO TO SCOND3 WHEN REACH END OF 2ND ARG. + JSP D,RARGCH(T) ;READ NEXT CHAR OF 2ND ARG, + JRST SCOND3 + EXCH A,PRSCND + PUSHJ P,REDINC ;RE-FETCH NEXT CHAR OF 1ST ARG + EXCH A,PRSCND + CAMN B,A ;COMPARE CHARACTERS + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CAIL A,"A+40 + CAILE A,"Z+40 ;NOT EQUAL => CONVERT BOTH TO UPPER CASE. + CAIA + SUBI A,40 + CAIL B,"A+40 + CAILE B,"Z+40 + CAIA + SUBI B,40 + CAMN B,A ;ARE THEY SAME EXCEPT FOR CASE? + JRST RARGCH(T) ;CHARS EQUAL, KEEP COMPARING. + CLEARM SCONDF ;STRINGS DIFFER + CALL RARFLS ;IGNORE REMAINDER OF 2ND ARG. +SCOND3: CLEARB A,C ;END OF (SECOND) STRING ARG ENCOUNTERED + EXCH C,PRSCN1 + MOVEM C,FREEPT + PUSHJ P,FCOMP + EXCH A,PRSCND + PUSHJ P,REDINC + CAIE B,375 + CLEARM SCONDF + REST B + REST SYM + XCT B ;DO THE TEST. + JRST COND4 + JRST COND2 + +VBLK +BLCODE [DMYDEF: BLOCK DMDEFL] ;TABLE OF DUMMY NAMES FOR THING BEING DEFINED +DMYTOP: DMYDEF ;POINTER INTO DMYDEF, POINTS TO AVAILABLE WORD + ;SINCE ONLY ONE THING CAN BE DEFINED AT ONCE, IT IS NOT NECESSARY TO SAVE AND RESTORE DMYTOP +DMYBOT: DMYDEF ;-> 1ST DMYDEF WD USED AT THIS LEVEL. + ;RIGHT NOW, ALWAYS -> DMYDEF SINCE CAN'T HAVE DEFINITION + ;WITHIN A DEFINITION YET. + +PBLK + +PDEF: PUSHJ P,GSYL ;READ IN SYL + CAIE T,", ;IF DELIMITING CHR NOT , + JUMPE SYM,CPOPJ ;AND SYM NULL, RETURN +PDEF1: MOVEM SYM,@DMYTOP ;STORE SYM + AOS D,DMYTOP ;INCR PNTR + CAIL D,DMYDEF+DMDEFL ;CHECK FOR TABLE SIZE EXCEEDED + ETF [ASCIZ/Too many dummies in DEFINE or IRP/] + POPJ P, + +VBLK +BLCODE [DSTG: BLOCK DSSIZ] ;TABLE OF CHAR ADRS OF DUMMIES BEING DEFINED PRIOR TO MACRO EXPANSION +RDWRDP: DSTG ;POINTER TO DSTG, POINTS TO FREE WORD + ;NOTE THAT RDWRDP MUST BE SAVED AND RESTORED SINCE MORE MACROS CAN + ;BE EXPANDED DURING FIELD READ FOR DUMMY +PBLK + +ADDTR1: CLEARM PUTCNT +ADDTRN: MOVE A,FREEPT +ADDTR2: MOVEM A,@RDWRDP + AOS A,RDWRDP + CAIL A,DSTG+DSSIZ + ETF [ASCIZ/Too many dummies in all macros & IRPs being expanded/] + RET + +VBLK +BLCODE [DMYAGT: BLOCK DMYAGL] ;TABLE OF CHAR ADRS OF DUMMYS OF MACROS BEING EXPANDED + ;DMYAGT TRACKS WITH THE MACRO PDL; + ;DMYAGT CAN'T BE COMBINED WITH DSTG SINCE DMYAGT CAN BE SHIFTING AROUND RANDOMLY DURING ARG SCAN +BBASE: DMYAGT ;POINTER TO BEGINNING OF ACTIVE DUMMY LIST (FOR DEEPEST-NESTED MACRO BEING EXPANDED) + ;ADD TO DUMMY # TO GET LOCATION CONTAINING CHAR ADR OF DUMMY +TOPP: DMYAGT ;POINTER TO TOP OF DMYAGT ACTIVE, POINTS TO FREE REGISTER +PBLK + + ;ACTIVATE DUMMYS ON TOP OF DSTG TABLE + ;A -> FIRST (LOWEST) DUMMY IN DSTG TO ACTIVATE + +DMYTRN: MOVE B,TOPP + MOVEM B,BBASE + PUSH P,A +DMYTR2: CAML A,RDWRDP + JRST DMYTR1 + MOVE B,(A) + MOVEM B,@TOPP + AOS B,TOPP + CAIL B,DMYAGT+DMYAGL + ETF [ASCIZ /Too many dummy args active/] + AOJA A,DMYTR2 +DMYTR1: POP P,RDWRDP + POPJ P, + +;THE MACRO TABLE IS FILLED MAINLY WITH 8-BIT BYTES. +;THE FIRST WORD'S ADDR IS IN MACTAD; THE LAST+1'S IN MACTND. +;THE CHARACTER NUMBER OF THE LAST+1ST CHAR IS IN MACHI. +;MACHIB IS BP. TO HIGHEST BYTE OK TO FILL (LAST IN C(MACTND)-1) + +;IF A BYTE IN THE TABLE HAS ITS HIGH BIT OFF, IT IS AN ASCII CHARACTER. +;OTHERWISE, IT IS SPECIAL. IF THE 100 BIT IS OFF IT MEANS +;SUBSTITUTE A MACRO DUMMY ARG WHEN READ; THE CHAR IS THE NUMBER OF THE ARG+200 . + +;377 AND 375 ARE STOP CODES, CAUSING A POP OUT OF THE CURRENT STRING. +;GC CONSIDERS THE CHAR. AFTER A 375 TO START A NEW STRING. + +;376 IS IGNORED WHEN READ; USED TO CLOBBER UNWANTED CHARACTERS IN STRINHGS. + +;374 STARTS EVERY MACRO-DEFINITION. +;373 STARTS THE BODY OF A REPEAT. + +;370 STARTS A WORD STRING: +;THE WORD AFTER THAT WHICH CONTAINS THE 370 +; HAS THE LENGTH IN WORDS OF THE STRING IN ITS LH, +; IN ITS RH, THE ADDRESS OF WD WHICH POINTS BACK TO THIS ONE. +; THEN FOLLOW RANDOM WDS HOLDING ANYTHING AT ALL. +; GC WILL MAKE SURE IT STAYS ON WD BOUNDARY. +; THE LENGTH INCLUDES THE WD HOLDING THE LENGTH. +; IF THE RH OF 1ST WD HAS 0, GC WILL FLUSH THE STRING + +STRTYP: PUSHJ P,REDINC ;DEBUGGING AID ONLY + EXCH A,B + TRZE A,200 + JRST STRTP1 +STRTP2: PUSHJ P,TYO ;NORMAL CHAR, JUST TYPE OUT + MOVE A,B + JRST STRTYP + +STRTP1: PUSH P,A + MOVEI A,"* ;SPECIAL CHAR, TYPE * + PUSHJ P,TYO + POP P,A + TRNE A,100 + JRST STRTP3 ;CONTROL CHAR + ADDI A,260 ;DUMMY, CONVERT TO # + JRST STRTP2 ;TYPE OUT (SINGLE DIGIT) NUMBER + +STRTP3: CAIN A,175 + SKIPA A,C% ;STOP, TYPE % + MOVEI A,"/ ;SOMETHING ELSE, TYPE / + JRST STRTP2 + + + ;.GSSET, SET GENERATED SYM COUNTER + +A.GSSET: CALL AGETFD + MOVEM A,GENSM + JRST ASSEM1 + +;GSYL-LIKE ROUTINE, READ A SYL FOR WRQOTE + +WRQRR: PUSHJ P,RCH ;GET CHAR (MAYBE WANT THIS TO BE FASTER YET) + IDPB A,FREPTB ;DEPOSIT IN MACRO TABLE + CAMN F,FREPTB ;WAS THIS LAST CHAR IN TABLE? + JRST WRQRGC ;YES, NEED GARBAGE COLLECTION +WRQRR2: XCT GDTAB(A) ;DISPATCH ON CHAR + JFCL ;(MAYBE SKIPS) + SOJGE D,WRQRR ;LOOP FOR FIRST SEVEN CHARS + HRRI D,0 + JRST WRQRR + + ;HERE FROM WRQRR WHEN NEED GARBAGE COLLECTION OF MACRO TABLE + +WRQRGC: MOVEM C,WRQTBP ;PUT POINTER TO BEGINNING OF SYL WHERE IT WILL BE GC'D + MOVE A,MACHI + PUSHJ P,GCA ;GARBAGE COLLECT + MOVE F,MACHIB ;RESET F TO POINT TO NEW LAST CHAR IN MACTAB + MOVEI C,0 + EXCH C,WRQTBP ;GET BACK POINTER TO CHAR BEFORE SYL + MOVE A,LIMBO1 ;RETRIEVE LAST CHAR READ + JRST WRQRR2 ;LOOP BACK, PROCESS CHAR + + ;HERE FROM WRQOTE IF .QUOTE SEEN + ;.QUOTE TAKES ARG LIKE ASCII, PRINTC, ETC. + +A.QOT1: MOVE A,WRQBEG(P) ;GET BACK BP TO CHAR BEFORE .QUOTE + PUSHJ P,A.QOTS ;SET UP FREEPT AND FREPTB PROPERLY + MOVE A,LIMBO1 ;NOW GET CHAR AFTER .QUOTE + CAIE A,^I + CAIN A,40 ;COMPARE WITH SPACE + PUSHJ P,RCH ;SPACE, GOBBLE NEXT CHAR FOR DELIMITER, ELSE THIS ONE + MOVEM A,A.QOT2 ;STORE AS TERMINATOR OF STRING +A.QOT3: PUSHJ P,RCH ;GET CHAR TO QUOTE + CAMN A,A.QOT2 ;TERMINATOR? + JRST WRQOT1 ;TERMINATOR, BACK FOR MORE DEFINITION + PUSHJ P,PUTREL ;DEPOSIT CHAR + JRST A.QOT3 + +;READ IN BODY OF MACRO, IRP, OR WHATEVER + +WRQOTE: PUSH P,[0] ;USED FOR LENGTH OF SYMBOL (REALLY 6 MINUS IT). +WRQLEN==,-2 + PUSH P,[0] ;THIS WD USED FOR DEFINE/TERMIN COUNT. +WRQLVL==,-1 + PUSH P,[0] ;USED TO REMEMBER BEGINNING OF SYMBOL. +WRQBEG==0 + SETOM INICLB ;CLOBBERED INITS, .SYMTAB NOW ILLEGAL. + PUSHJ P,RCH ;MAYBE POP UP A LEVEL IN EXPANSIONS, SAVE MACTAB SPACE + TLO FF,FLUNRD ;CAUSE CHAR TO BE RE-INPUT + MOVE F,MACHIB ;POINTER TO LAST CHAR OK TO PUT IN MACTAB, STAYS IN F + TRO I,IRSYL\IRLET ;MAKE SURE FLAGS SET SO WON'T WASTE TIME AT MAKNUM, POINT +WRQOT0: +WRQOT1: MOVEI D,6 ;SQUOZE COUNTER + MOVEI SYM,0 ;INITIALIZE SYM + MOVE C,FREPTB ;GET POINTER TO CHAR BEFORE SYL ABOUT TO READ + PUSHJ P,WRQRR ;READ SYL + JUMPE SYM,.-2 ;LOOP UNTIL NON-NULL + ;NOW SEE IF DUMMY; **NOTE**: C STILL HAS BYTE POINTER, A SYL TERMINATOR + MOVE B,DMYBOT + CAML B,DMYTOP + JRST WRQOT2 ;NOT DUMMY + CAME SYM,(B) ;COMPARE WITH DUMMY NAME + AOJA B,.-3 ;LOOP ON NO MATCH + SUB B,DMYBOT ;DUMMY, CONVERT TO NUMBER + 200 + SUBI B,200 + LDB T,C ;GET LAST CHAR BEFORE SYL + CAIE T,"! ; ^ NOTE THAT THIS CAN LOSE IF MACRO HAS 33. ARGS + IDPB B,C ;NOT EXCLAMATION POINT, LEAVE THERE, DEPOSITING DUMMY CHAR + CAIN T,"! + DPB B,C ;EXCL, WIPE IT OUT + MOVEM C,FREPTB ;RESET FREPTB + CAIE A,"! ;A HAS DUMMY TERMINATOR, COMPARE WITH EXCL + TLO FF,FLUNRD ;NOT EXCLAMATION POINT, CAUSE IT TO BE RE-INPUT + JRST WRQOT1 ;LOOP BACK FOR NEXT SYL + +;SYL ISN'T DUMMY, CHECK FOR PSEUDO +WRQOT2: MOVEM D,WRQLEN(P) ;REMEMBER START OF AND LENGHTH OF THE SYMBOL. + MOVEM C,WRQBEG(P) + SETOM ESBK ;EVAL IN CURRENT BLOCK. + PUSHJ P,ES ;EVALUATE SYM (DOESN'T CLOBBER F) + JRST WRQOT0 ;NOT SEEN + CAIE A,PSUDO/40000 + JRST WRQOT0 ;NOT PSEUDO + TLZ B,-1 ;CLEAR OUT LH OF VALUE, ONLY INTERESTED IN RH + CAIN B,A.QOTE + JRST A.QOT1 ;.QUOTE + CAIE B,ADEFINE + CAIN B,AIRP + AOS WRQLVL(P) ;DEFINE OR IRP +IFN RCHASW,[CAIN B,A.TTYM + AOS WRQLVL(P) ;.TTYMAC +] + CAIE B,ATERMIN + JRST WRQOT0 + SKIPGE WRQLEN(P) + ETR [ASCIZ /TERMIN longer than 6 chars/] + SOSL WRQLVL(P) ;TERMIN, SKIP IF THE TERMINATING ONE + JRST WRQOT0 ;NOT MATCHING TERMIN, BACK FOR NEXT SYL + POP P,A ;GET BACK BP TO LAST CHAR BEFORE TERMIN + SUB P,[2,,2] .SEE WRQLVL,WRQBEG + MOVE T,DMYBOT ;WE'RE NO LONGER USING SPACE IN DMYDEF. + MOVEM T,DMYTOP +A.QOTS: LDB T,A ;HERE ALSO FROM A.QOT1, GET CHAR BEFORE .QUOTE OR TERMIN + CAIE T,"! + JRST A.QTS2 ;NOT EXCLAMATION POINT => OK + DBPM A, ;EXCLAMATION POINT, DECREMENT POINTER +A.QTS2: MOVEM A,FREPTB ;STORE AS NEW FREPTB + CCOMP1 A,-1 ;CONVERT TO CHAR ADR + MOVEM B,FREEPT ;STORE CHAR ADR AS NEW FREEPT + POPJ P, + +;FORMAT OF A MACRO: +;IT STARTS WITH A 374. +;THEN COME ARGUMENT DESCRIPTORS, ONE PER ARGUMENT. +MCF==777650 ;BITS AND FIELDS ARE: +MCFDEF==200 ;ARG IS DEFAULTED. MCFDEF AND MCFGEN NEVER BOTH SET. +MCFGEN==100 ;ARG SHOULD BE GENSYMMED IF NOT GIVEN IN CALL. +MCFKWD==40 ;ARG IS A KEYWORD ARG, SELECTED BY = RATHER THAN POSITION. +MCFSYN==7 ;FIELD THAT SPECIFIES THE ARGUMENT'S SYNTAX. + MCFNRM==1 ;MCFSYN CONTAINS MCFNRM => NORMAL-SYNTAX ARG + MCFLIN==2 ;MCFSYN CONTAINS MCFLIN => WHOLE LINE ARG + MCFBAL==3 ;MCFSYN CONTAINS MCFBAL => BALANCED ARG + MCFSTR==4 ;MCFSYN CONTAINS MCFSTR => ARG IS A DELIMITED STRING, AS IN "ASCIZ". + MCFKST==5 ;MCFSYN CONTAINS MCFKST => JUST LIKE MCFSTR, BUT DELIMITERS ARE RETAINED. + MCFEVL==6 ;MCFSYN CONTAINS MCFEVL => ARG IS BY VALUE (PREEVALUATED). +;IF MCFKWD IS SET, THE DESCRIPTOR IS FOLLOWED BY THE NAME OF THE ARGUMENT, +;TERMINATED BY A 377. +;IF MCFDEF IS SET, THE DESCRIPTOR IS FOLLOWED BY THE DEFAULT VALUE OF THE ARG, +;TERMINATED BY A 377. +;IF MCFKWD AND MCFDEF ARE BOTH SET, THE ARG NAME COMES FIRST. +;A ZERO BYTE ENDS THE DESCRIPTOR LIST. +;THEN COMES THE BODY OF THE MACRO, FOLLOWED BY A 375. + +ADEFINE: NOVAL ;ERROR IF CONTEXT WANTS A VALUE. + PUSH P,CASSM1 ;RETURN TO ASSEM1 EVENTUALLY + JSP TM,ERMARK ;ERR MSGS SHOULD SAY WE'RE INSIDE A DEFINE. + PUSH P,SYM ;THESE 2 PUSHES ARE FOR NONAME'S SAKE. + PUSH P,SYM + CALL GETSLD + CALL NONAME + TLZ FF,FLUNRD + SUB P,[2,,2] + PUSH P,SYM + PUSH P,ESBK ;SAVE BLOCK TO DEFINE IN FOR ES'S SAKE. +IFN CREFSW,XCT CRFMCD + CALL A.TYM1 + POP P,ESBK + REST SYM + PUSHJ P,ESDEF ;FIND SLOT IN SYMBOL TABLE FOR IT + TLO C,3MACOK ;NEVER SEEN, OK TO MAKE MACRO. + TLON C,3MACOK ;ELSE ERROR IF NUMERIC OR ALREADY USED. + ETSM [ASCIZ/Non-macro made macro/] + MOVEI B,MACCL ;RH(VALUE) = MACCL + HRL B,PRDEF ;LH(VALUE) = CHAR ADR OF MACRO + CLEARM PRDEF ;NO LONGER NEED PRDEF + MOVSI T,PSUDO ;SYMBOL TABLE ENTRY LOOKS LIKE PSEUDO + JRST VSM2 + +IFN RCHASW,[ + ;.TTYMAC NAME + ;BODY + ;TERMIN + + ;NAME DUMMY, CAUSES READIN OF CRUD FROM TTY -> CR (NOT INCLUSIVE) + +A.TTYM: JSP TM,ERMARK ;ERROR MSGS SHOULD SAY WE'RE INSIDE A .TTYMAC + CALL A.TYM1 ;READ IN A MACRO-DEFINITION. + MOVEI A,40 ;DON'T LET THE CHAR ENDING THE TERMIN + MOVEM A,LIMBO1 ;MAKE MACCL THINK THERE ARE NO ARGS. + CALL GTYIP1 ;PUSH INTO TTY FOR INPUT + HRLZ B,PRDEF ;PHONY UP A MACRO WHOSE DEFN IS WHAT WE READ. + SETZM PRDEF + MOVEI A,A.TYM8 + JRST A.TYM2 ;CALL THE MACRO: + ;READ THE ARGS, POP OUT OF TTY, EXPAND THE MACRO + ;AND THEN EXIT TO A.TYM8 +] + +A.TYM1: MOVE A,FREEPT + MOVEM A,PRDEF + MOVEI LINK,MCFNRM ;INITIALLY, DUMMIES ARE NORMAL. + MOVEI A,374 + PUSHJ P,PUTREL ;MARK BEGINNING OF MACRO +DEFNI: MOVE T,LIMBO1 + MOVE A,LINK +DEFNC: CAIE T,12 + CAIN T,15 + JRST DEFNA ;NO MORE ARGS (DONE WITH LINE) + CAIE T,LBRACE + CAIN T,LBRKT + JRST DEFNB1 + CAIE T,RBRACE + CAIN T,RBRKT + JRST DEFNB2 + CAIE T,"< ;OPENS TURN ON BALANCEDNESS. + CAIN T,"( + JRST DEFNB1 + CAIE T,"> ;CLOSES TURN OFF BALANCEDNESS. + CAIN T,") + JRST DEFNB2 + CAIN T,"? ;? TURNS BALANCEDNESS ON OR OFF. + JRST DEFBAL + CAIN T,"+ ;+ COMPLEMENTS KEYWORDNESS + XORI LINK,MCFKWD + CAIN T,"\ ;\ COMPLEMENTS GENSYMMEDNESS + XORI LINK,MCFGEN + CAIN T,"- ;- TURNS WHOLELINENESS ON OR OFF. + JRST DEFWHL + CAIN T,"* ;* TURNS ASCIZ-STYLE-NESS ON OR OFF. + JRST DEFASC + CAIN T,"& ;& TURNS KEEP-STRUNGNESS ON OR OFF. + JRST DEFKST + CAIN T,"# ;# TURNS EVALUATEDNESS ON OR OFF. + JRST DEFEVL + CAIN T,": ;: MAKES FOLLOWING ARGS NORMAL + MOVEI LINK,MCFNRM ;IN ALL RESPECTS + CAIN T,"; + JRST DEFNSM ;ALLOW DEFINE LINE TO BE COMMENTED +DEFND: PUSH P,A + CALL GSYL ;READ IN SYMBOL AS SQUOZE IN SYM. + REST A + CAIN T,"/ ;/ MEANS PREVIOUS ARG IS WHOLE-LINE. + XORI LINK,MCFLIN#MCFNRM + JUMPE SYM,DEFNC ;JUMP IF SYMBOL NAME WAS NULL. + CALL PDEF1 ;ELSE PUSH IT ON LIST OF DUMMIES. + MOVE A,LINK + CAIE T,"= + JRST DEFNL + IORI A,MCFDEF ;ONE ARG, WITH DEFAULT VALUE. + ANDCMI A,MCFGEN ;NOT TO BE GENSYMMED. +DEFNL: CALL PUTREL ;OUTPUT A DESCRIPTOR FOR THIS ARG + TRNE LINK,MCFKWD + CALL DEFNM ;PUT OUT ARG NAME IF KWD ARG + CAIE T,"= ;THEN DEFAULT VALUE IF DEFAULTED. + JRST DEFNI + JSP D,RARG ;INIT. FOR READING THE DEFAULT VALUE. + CAIA + CALL RARGCP ;COPY THE ARG INTO MACRO SPACE, + CALL PUT377 ;TERMINATED BY A 377. + JRST DEFNI ;NOW FOR THE NEXT ARG. + +DEFNM: MOVE D,[440700,,STRSTO] +DEFNM1: ILDB A,D + CAMN D,STRPNT + JRST PUT377 + CALL PUTREL + JRST DEFNM1 + +DEFEVL: SKIPA A,[MCFEVL] ;TURN EVALUATEDNESS ON OR OFF. +DEFASC: MOVEI A,MCFSTR ;TURN ASCIINESS ON OR OFF. + JRST DEFN9 +DEFKST: MOVEI A,MCFKST ;TURN KEEP-STRUNGNESS ON OR OFF. + JRST DEFN9 +DEFBAL: SKIPA A,[MCFBAL] ;TURN ON BALANCEDNESS, BUT IF ALREADY ON TURN OFF. +DEFWHL: MOVEI A,MCFLIN ;SIMILAR FOR WHOLELINENESS. +DEFN9: LDB B,[.BP MCFSYN,LINK] + CAMN A,B ;IF CURRENT STATE IS SAME AS IN A, + MOVEI A,MCFNRM ;SWITCH TO NORMAL MODE INSTEAD. + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNB2: SKIPA A,[MCFNRM] ;TURN OFF BALANCEDNESS +DEFNB1: MOVEI A,MCFBAL ;TURN ON BALANCEDNESS + DPB A,[.BP MCFSYN,LINK] + JRST DEFND + +DEFNSM: PUSHJ P,RCH ;SEMICOLON IN DEFINE LINE + CAIE A,15 + CAIN A,12 +DEFNA: SKIPA A,LINK ;END OF DEFINE LINE, GET COUNT + JRST DEFNSM + MOVEI A,0 + PUSHJ P,PUTREL ;DEPOSIT END-OF-DESCRIPTORS MARK + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD ;CHAR AFTER CR NOT LF + PUSHJ P,WRQOTE ;READ IN BODY + JRST STPWR + +;COME HERE TO EXPAND MACRO; LH OF B POINTS TO STRING. +;SYM HOLDS NAME OF MACRO (USED BY CALL TO AGETFD IN MACEVL). +MACCL: JSP TM,ERMARK ;ERROR MESSAGE DURING ARG SCAN SHOULD SAY WE'RE IN IT. + MOVEI A,RCHSV1 +A.TYM2: PUSH P,I + AOS PRCALP + AOS MDEPTH + PUSH P,RDWRDP + PUSH P,A ;RCHSV1 FOR MACRO, A.TYM8 FOR .TTYMA + MOVEI LINK,0 + HLRZ A,B + PUSHJ P,REDINC + CAIE B,374 + GOHALT + MOVEM A,@PRCALP + PUSHJ P,REDINC + TLZ I,ILPRN + JUMPE B,MACCLE ;MACRO TAKES NO ARGS => UN-READ NEXT CHARACTER. + MOVE A,LIMBO1 + CAIE A,") ;MACRO NAME TERMINATED WITH A CLOSE-BRACKET OF SOME SORT + CAIN A,"> ;=> UN-READ THE FOLLOWING CHARACTER. + JRST MACCLE + CAIN A,RBRKT + JRST MACCLE + CAIE A,15 ;MACRO NAME ENDED BY A CR OR LF => + CAIN A,12 + JRST MACCLD ;NO ARGS IN THIS CALL; NULLIFY ALL ARGS. + CAIE A,"< + CAIN A,"( + TLO I,ILPRN ;BUT MAYBE THERE IS A (. IF SO, IT'S A PAREN'D CALL, + CAIN A,LBRKT ;AND WON'T END TILL THE MATCHING CLOSE. + TLO I,ILPRN + CAIE A,40 ;IF THE CHAR ENDING THE MACRO NAME ISN'T AN OPENPAREN, + CAIN A,^I ;EOL, OR SPACE, RE-READ IT AS PART OF 1ST MACRO ARG. + JRST MACNX0 + TLNN I,ILPRN + TLO FF,FLUNRD +MACNX0: TDZ LINK,LINK +MACNXD: CALL MACDES ;FETCH NEXT DESCRIPTOR + JRST MACPUS ;NO MORE => THIS IS END OF THE CALL + TRNE LINK,MCFKWD + JRST MACK ;KEYWORD PARAM => SPECIAL SCANNER +;READ IN THE VALUE OF THE NEXT ARG, WHICH IS NORMAL (NOT KEYWORD) +MACNRM: CALL ADDTRN ;PUSH WORD TO HOLD VALUE OF ARG ONTO DSTG, + ;INITIALIZED -> FREEPT, WHERE WE WILL NOW WRITE THE ARG. + SOS C,A ;TELL MACRED WHERE THAT WORD IS. + CALL MACRED ;READ IN THE ARGUMENT VALUE. + JRST MACNXD ;THEN HANDLE ANOTHER ARG + GOHALT + JRST MACCLD ;END OF ARG LIST => NULLIFY REMAINING ARGS. + +MACCLE: TLO FF,FLUNRD ;SAVE CHR FOLLOWING MACRO W/NO ARGUMENTS + ;AND IF THAT CHAR WAS A CLOSE-BRACKET, + SKIPE B,ASMOUT ;CLEAR OUT THE CHANGE IT MADE TO ASMDSP. + CAIN B,4 + CAIA + JSP LINK,SAVAS2 + SETZ LINK, + JRST MACCLD ;NOW GO NULLIFY ANY ARGS THE MACRO WANTED, AND EXIT. + +;READ IN THE NEXT MACRO ARGUMENT ACC TO SYNTAX FLAGS IN LINK. +;C HAS ADDRESS OF WORD ON THE RDWRDP STACK WHICH HOLDS THE POINTER TO THIS ARG +;IN CASE WE WISH TO SET THE ARG TO THE NULL STRING. B AND LINK NOT CLOBBERED. +;RETURNS SKIPPING TWICE IF NO ARG BECAUSE END OF MACRO CALL SEEN. +MACRED: MOVEI D,MACNXR ;RARL3, RARB, RARGBR RETURN TO MACNXR + CALL RCH + CAIE A,^M + CAIN A,^J + JRST MACEND ;MAYBE WE HAVE REACHED THE END OF THE MACRO CALL. + LDB B,[.BP MCFSYN,LINK] + CAIN B,MCFLIN + JRST RARL3 ;ELSE, IF WHOLELINE ARG, NOTHING ELSE TO CHECK, + ;SO INIT FOR READING IT IN. + CAIN A,", + JRST MACNUL ;NON-WHOLELINE ARG IS NULL IF NEXT CHAR IS COMMA + CAIN A,"; ;SEMICOLON ENDS ARG LIST UNLESS INSIDE WHOLELINE ARG + JRST MACEND + CAIN B,MCFBAL + JRST RARB ;FOR BALANCED ARG, NOTHING ELSE SPECIAL, SO INIT. + CAIE B,MCFSTR ;FOR BOTH FLAVORS OF STRUNGNESS, + CAIN B,MCFKST ;GO GOBBLE AN ASCIZ-STYLE ARGUMENT. + JRST MACSTR + CAIN B,MCFEVL ;FOR EVALUATED ARG, READ FIELD AND EXPRESS AS NUMERAL. + TLOA FF,FLUNRD ;AND THE CHAR WE JUST READ WAS THE 1ST CHAR OF THE FIELD. + CAIN A,"\ ;NORMAL ARG STARTING WITH "\" TREATED THE SAME WAY, BUT FIELD + JRST MACEVL ;STARTS WITH NEXT CHAR. + CAIN A,LBRKT + JRST RARGBR ;FOR ORDINARY ARG, OPEN-BRACKET MAKES IT SPECIAL +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + MOVEI T,RARGN ;OTHERWISE IT'S A NORMAL ARG + TLOA FF,FLUNRD ;AND THE CHAR WE RCH'ED IS THE 1ST CHAR OF IT +MACNXR: JRST MACEN1 ;NON-SKIP RETURN FROM RARB, RARL3 OR RARGBR => ARG NULL + CALL RARGCP ;ARG NON-NULL => COPY IT INTO STRING SPACE + CAIE A,"; +CSTPWR: JRST STPWR ;AND TERMINATE IT +MACSC: MOVE A,(C) ;EXCEPT THAT SEMICOLONS INVALIDATE ALL THE SPACES + CAME A,FREEPT ;AND TABS THAT PRECEDE THEM. + JRST STPWR ;IF, AS A RESULT OF THAT, THE ARG IS NULL, END THE ARGLIST. +;COME HERE WHEN THE END OF THE MACRO'S WHOLE ARGLIST IS SEEN. +MACEND: TLO FF,FLUNRD +MACEN1: AOS (P) ;2-SKIP RETURN FROM MACRED INDICATES END OF ARGLIST + AOS (P) ;END OF ARGLIST => THIS ARG IS NULL. +;COME HERE TO NULLIFY CURRENT ARG (WHERE C POINTS) +MACNUL: TRZE LINK,MCFDEF + JRST MACDEF ;MAYBE DEFAULT IT + TRNE LINK,MCFGEN + JRST MACGEN ;MAYBE GENSYM IT + SETZM (C) ;ELSE SET TO NULL STRING. + RET + +MACST1: CALL RCH + CAIN A,", + JRST MACNUL +MACSTR: CAIE A,40 ;HERE FOR ARG DELIMITED LIKE TEXT STRINGS: /TEXT/. + CAIN A,^I ;SKIP ALL SPACES AND TABS BEFORE THE ARG. + JRST MACST1 + JSP D,RARB ;FIND END OF LINE, COMMENT, OR CLOSEBRACKET => + JRST MACEND ;NULLIFY ARG AND END MACRO CALL. + MOVEI T,(A) ;ELSE SAVE THIS CHAR; IT'S THE DELIMITER. + TLZ FF,FLUNRD ;DON'T RE-READ DELIMITER, + CAIN B,MCFKST ;BUT IF ARG IS KEEP-STRUNG, DROP THRU TO STORE IT. +MACST2: CALL PUTREL + CALL RCH ;READ ANOTHER CHARACTER. IF IT ISN'T THE DELIMITER, + CAIE A,(T) + JRST MACST2 ;STORE IT AND READ ANOTHER. + CAIN B,MCFKST ;HIT DELIMITER, DONE. BUT IF ARG IS KEEP-STRUNG, + CALL PUTREL ;KEEP DELIMITER BY STORING IT TOO. + CALL STPWR +MACST3: CALL RCH ;PASS BY SPACES AFTER THE CLOSING DELIMITER + CAIE A,40 + CAIN A,^I + JRST MACST3 + CAIE A,", ;COMMA HERE ENDS THE ARG BUT NOT THE MACRO CALL. + JSP D,RARB ;ELSE CHECK FOR OTHER TERMINATORS. + RET ;WE FOUND AN ACCEPTABLE ARG TERMINATOR. + ETR [ASCIZ /Garbage in ASCIZ-style macro arg/] + JRST RARFLS ;IF THERE'S ANYTHING ELSE, COMPLAIN AND SKIP IT. + +;COME HERE TO GIVE AN ARG ITS DEFAULT VALUE. +;MCFDEF WAS CLEARED SO MACDES WILL KNOW THE DEFAULT VALUE HAS +;ALREADY BEEN PASSED OVER AND WON'T TRY TO SKIP OVER IT. +;IF MCFKWD IS SET, WE MUST SKIP OVER THE KWD ARG'S NAME FIRST. +MACDEF: TRZN LINK,MCFKWD + JRST MACDF1 + MOVE A,@PRCALP +MACDF0: CALL REDINC ;SKIP ARG NAME IF KEYWORD ARG. + CAIE B,377 + JRST MACDF0 + MOVEM A,@PRCALP +MACDF1: MOVE A,@PRCALP ;COPY THE DEFAULT VALUE AS THE ARGUMENT VALUE. + CALL REDINC ;AS THE ARGUMENT STRING. + MOVEM A,@PRCALP + CAIN B,377 + JRST STPWR ;END OF THE DEFAULT VALUE. + EXCH A,B + CALL PUTREL + EXCH A,B + JRST MACDF1 + +;COME HERE IF GENSYMMABLE ARG IS SPEC'D AS NULL. +MACGEN: MOVEI A,5 + MOVEM A,SCKSUM + MOVEI A,"G + PUSHJ P,PUTREL + PUSH P,CSTPWR + AOS A,GENSM + IDIVI A,10 + HRLM B,(P) + SOSLE SCKSUM + PUSHJ P,.-3 + JRST MACEV2 + +;PROCESS ARG THAT STARTS WITH \, OR #-TYPE ARG. +MACEVL: CALL RCH ;FIRST, CHECK FOR IMMEDIATE END OF MACRO CALL. + JSP D,RARB + JRST MACEN1 + PUSH P,C + PUSH P,LINK ;SAVE LINK, NEED FLAGS + PUSHJ P,AGETFD ;GET THE FIELD + SKIPE B + ETR [ASCIZ /Relocatable \'d macro arg/] + POP P,LINK + REST C ;IF AGETFD EXPANDED A MACRO, FREEPT HAS CHANGED, SO + MOVE CH1,FREEPT ;PUT NEW VALUE INTO THE POINTER TO THIS DUMMY. + MOVEM CH1,(C) + MOVE CH1,A ;SAVE VALUE OF FIELD FROM CLOBBERAGE + PUSH P,CSTPWR +MACEV1: LSHC CH1,-35. ;NOW "TYPE OUT" VALUE OF FIELD IN CURRENT RADIX + LSH CH2,-1 + DIV CH1,ARADIX + HRLM CH2,(P) + JUMPE CH1,.+2 + PUSHJ P,MACEV1 +MACEV2: HLRZ A,(P) + ADDI A,60 + JRST PUTREL ;OUTPUT TO MACTAB STRING BEING DEFINED + +;HANDLE KEYWORD PARAMETERS. COME HERE WHEN A DESCRIPTOR IS SEEN +;THAT SPECIFIES A KEYWORD PARAMETER. +MACK: PUSH P,RDWRDP + MOVE A,@PRCALP ;PUSH A COPY OF POINTER TO 1ST KWD ARG'S DESCRIPTOR + AOS PRCALP ;SO WE CAN ADVANCE THE COPY WHILE KEEPING ORIGINAL FIXED. + MOVEM A,@PRCALP + PUSH P,LINK +;FIRST, PUSH A "NOT SET" MARKER FOR EACH OF THE KEYWORD PARAMS IN THIS RUN OF SUCH. +MACK2: SETO A, + CALL ADDTR2 + CALL MACDES ;NOTE THAT THERE IS ONLY ONE PARAM PER DESCRIPTOR + JRST MACK1 ;FOR KEYWORD PARAMS, SO NO NEED TO COUNT DOWN. + TRNE LINK,MCFKWD + JRST MACK2 +MACK1: MOVE LINK,(P) ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM. + MOVE B,PRCALP + MOVE B,-1(B) + MOVEM B,@PRCALP +MACKLP: CALL GPASST ;NOW SEE IF THERE'S AN ARGUMENT TO BE FOUND + CAIE A,^M ;IF SO, IT SHOULD START WITH A KEYWORD. + CAIN A,^J + JRST MACKND ;CR OR LF => NO KEYWORD, AND END SCAN. + CAIN A,"; + JRST MACKND + CAIN A,", + JRST MACKN1 ;NULL ARG => NO KEYWORD, BUT DON'T END SCAN. + CAIE A,") + CAIN A,"> + JRST MACKND ;DETECT END OF PARENTHESIZED CALLS, ETC. + CAIE A,RBRKT + CAIN A,RBRACE + JRST MACKND + TLO FF,FLUNRD + CALL GSYL ;THERE SHOULD BE ANOTHER ARG, SO TRY READING KEYWORD NAME + CALL PASSPS + MOVE C,-1(P) ;NOW SCAN THROUGH THIS RUN OF KEYWORD PARAMS FOR THE ONE + CAIE A,"= ;WHOSE NAME MATCHES WHAT GSYL READ. + JRST MACKL5 ;NOT FOLLOWED BY "="?? + DPB A,STRPNT +MACKL4: MOVE D,[440700,,STRSTO] + MOVE A,@PRCALP +MACKL1: CALL REDINC + ILDB AA,D + CAIN B,377 ;IF REACHED END OF KEYWORD'S NAME, AND EQUAL SO FAR + JRST MACKL2 ;SEE IF ARG'S NAME ALSO OVER. + CAMN B,AA + JRST MACKL1 ;ELSE KEEP COMPARING IF NAMES STILL SAME SO FAR. +MACKL6: MOVEM A,@PRCALP + CALL MACDES ;THIS KEYWORD DOESN'T MATCH SO FIND THE NEXT + JRST MACKL3 ;THERE ARE NO MORE; LOSE - ARG WITH BAD KEYWORD. + TRNN LINK,MCFKWD + JRST MACKL3 + AOJA C,MACKL4 + +MACKL5: ETR [ASCIZ /Bad format keyword argument/] + TLOA FF,FLUNRD ;INCLUDE THE BAD NON-"=" AS PART OF WHAT WE DISCARD +MACKL3: ETR [ASCIZ /Arg with undefined keyword/] + MOVEI T,RARGN + CALL RARFLS ;SKIP AN ORDINARY-SYNTAX MACRO ARG TO TRY TO RECOVER. + JRST MACK1 + +;COME HERE AFTER FINDING THE PARAM THAT MATCHES THIS ARG. +;C POINTS TO THE WORD IN DSTG FOR THAT ARG (DSTG IS WHAT ADDTRN PUSHES IN) +MACKL2: TRZ LINK,MCFKWD ;(IN CASE WE GO TO MACKL6, SINCE KWD NAME SKIPPED ALREADY) + CAIE AA,"= + JRST MACKL6 ;KWD NAME OVER BUT SPEC'D NAME NOT => MISMATCH + MOVEMM (C),FREEPT + CALL MACRED ;READ IN THE VALUE OF THE ARG, THUS SETTING THIS PARAM. + JRST MACK1 ;THERE ARE MORE ARGS => HANDLE THEM + GOHALT +MACKND: TLO FF,FLUNRD ;MACRO CALL TERMINATOR SEEN. +;NULL ARG SEEN; ENDS THIS RUN OF KEYWORD ARGS BUT NOT THE CALL. +MACKN1: REST LINK ;NOW GO BACK TO THE DESCRIPTOR OF THE FIRST KEYWORD PARAM. + SOS PRCALP + REST C ;GET PTR TO 1ST KWD ARG'S VALUE-WORD +MACKN2: MOVE A,(C) + AOJN A,MACKN4 ;IF THIS ARG WASN'T SPECIFIED, + MOVEMM (C),FREEPT + CALL MACNUL ;NULLIFY IT (MAYBE DEFAULT OR GENSYM) +MACKN4: CALL MACDES ;NOW SKIP OVER THE DESCRIPTORS OF THIS RUN OF KEYWORD PARAMS + JRST MACPUS ;EXHAUSTED ALL THE DESCR'S => END OF MACRO CALL. + TRNE LINK,MCFKWD ;SAME IF REACH A NON-KWD ARG. + AOJA C,MACKN2 + TLNN FF,FLUNRD ;REACHED A NON-KEYWORD PARAM: IF TERMINATOR WAS A NULL ARG, + JRST MACNRM ;GO ON TO READ THE VALUE OF THE NON-KEYWORD PARAM. + JRST MACCLS ;ELSE CALL WAS REALLY ENDED, SO NULLIFY REMAINING ARGS. + +;COME HERE TO FIND THE NEXT DESCRIPTOR. +;SKIPS OVER THE NAME AND DEFAULT VALUE OF THE PREVIOUS DESCRIPTOR, IF ANY. +;THE CONTENTS OF LINKK SAY WHETHER THEY EXIST TO BE SKIPPED OVER. +MACDES: MOVE A,@PRCALP + CALL REDINC ;READ NEXT CHAR OF MACRO + MOVEM A,@PRCALP + TRNE LINK,MCFKWD\MCFDEF + JRST [ CAIE B,377 ;IF THERE'S NAME OR DEFAULT TO SKIP, GO PAST TERMINATOR + JRST MACDES + TRZN LINK,MCFKWD ;AND SAY WE FOUND ONE + TRZ LINK,MCFDEF ;NOTE THERE MAY BE ANOTHER, IN WHICH CASE WE WILL + JRST MACDES] ;SKIP TILL ANOTHER 377 + JUMPE B,CPOPJ ;THIS DESC IS TERMINATOR => RETURN NO SKIP. + MOVEI LINK,(B) ;ELSE PUT FLAGS IN LINK. + JRST POPJ1 + +;COME HERE WHEN A MACRO CALL TERMINATOR IS ENCOUNTERED, TO NULLIFY ALL +;THE REMAINING PARAMS THAT THE MACRO WANTS, THEN ENTER THE MACRO. +;ENTER AT MACCLS IF HAVE JUST READ A DESCRIPTOR AND NOT NULLIFIED THE ARG, +;OR AT MACCLD IF HAVE JUST PROCESSED AN ARG, TO READ THE NEXT DESCRIPTOR. +MACCLS: TRNE LINK,MCFDEF\MCFGEN + JRST MACCL2 + SETZ A, ;NULLIFY NON-GENSYMMED, NON-DEFAULTED ARGS QUICKLY + CALL ADDTR2 +MACCLD: CALL MACDES ;THEN READ THE NEXT DESCRIPTOR. + JRST MACPUS ;IF NO MORE ARGS, ENTER THE MACRO. + JRST MACCLS + +MACCL2: CALL ADDTRN ;FOR GENSYMMED OR DEFAULTED ARG, PUSH PTR TO FREE STG + SOS C,A + CALL MACNUL ;THEN WRITE THE DESIRED VALUE THERE + JRST MACCLD ;THEN HANDLE NEXT DESCRIPTOR. + +;COME TO MACPUS WHEN ALL THE PARAMS HAVE HAD VALUES PUT IN DSTG (USING ADDTRN) +;TO ENTER THE MACRO. +MACPUS: TLZE I,ILPRN ;SPECIAL PARENTHESIZED CALL? + CALL MACPRN ;YES, SKIP PAST THE CLOSING PAREN. + MOVE B,(P) ;IS THIS A .TTYMAC? + CAIN B,A.TYM8 + CALL A.INEO ;YES, POP OUT OF TTY AFTER READING ARGS. + JFCL + REST B ;RCHSV1 OR A.TYM8 + PUSHJ P,PUSHEM + MOVE A,@PRCALP + PUSHJ P,ACPTRS ;SET UP CPTR + POP P,A + PUSHJ P,DMYTRN + SOS PRCALP + REST I +MACCR: AOS (P) ;COMMON RETURN FROM PSEUDOS TO RETURN FROM GETVAL WITHOUT VALUE +CMACCR: POPJ P,MACCR + +MACPRN: MOVEI TT,1 ;START PAREN-DEPTH AT 1 + JSP D,RARBC ;AND READ CHARS, UPDATING THE DEPTH, UNTIL + GOHALT + JUMPN TT,.-2 ;THE DEPTH GETS TO BE 0. + RET + +A.GOMC: ILDB B,A ;.GO ROUTINE TO SKIP PAST DESCRIPTORS + JUMPN B,A.GOMC ;IN HEADER OF MACRO DEFINITION. + JRST A.GORT + +RCHSV1: SOS MDEPTH ;END OF MACRO EXPANSION, DECREMENT DEPTH IN MACRO EXPANSIONS +A.TYM8: PUSH P,A ;ENTRY FROM .TTYMAC END OF EXPANSION + MOVE B,TOPP +RCHSV3: CAMG B,BBASE + JRST RCHSV2 + HLRZ A,-1(B) + ADD A,-1(B) + MOVEI A,1(A) + CAME A,FREEPT + JRST RCHSV2 + HRRZ A,-1(B) ;GET NEW FREEPT + SOJA B,RCHSV3 + +RCHSV2: POP P,A + ;RETURN ROUTINE FOR END OF DUMMY +RCHSAV: MOVE B,BBASE + MOVEM B,TOPP + PUSHJ P,POPEM + HLRM B,BBASE +REPT6: TRZE FF,FRMRGO + POPJ P, ;RETURN TO .GO + JRST RCHTRB + +;IRP, IRPS, IRPC, IRPW, IRPNC ALL CALL HERE. +;ALL USE 2 FRAMES ON THE MACRO PDL: +; ,, +; ,, +; \<# GROUPS>,, +; ,,AIRR +;THE 3RD WORD HAS IN BITS 4.1-4.3 THE IRP TYPE CODE +; (NIRPO, NIRPC, ETC) +;AND IN THE REST OF THE LH, THE NUMBER OF GROUPS +; (TRIPLES OF TWO DUMMIES AND A LIST) + +.SEE NIRPO ;FOR DEFINITIONS OF IRP TYPE CODES. + +AIRP: JSP TM,ERMARK ;ERROR MESSAGES SHOULD SAY WE'RE INSIDE IT. + PUSH P,I + PUSH P,RDWRDP + HLRZ LINK,B ;GET IRP TYPE CODE TO INDEX BY. + CAIE LINK,NIRPN + JRST AIRP0 + CALL AGETFD ;IRPNC, READ THE 3 NUMERIC ARGS. + PUSH P,A + CALL AGETFD + PUSH P,A + CALL AGETFD + MOVEM A,AIRPN2 ;THE LAST ARG, + REST AIRPN1 ;THE MIDDLE, + REST AIRPN0 ;THE FIRST. + MOVEI LINK,NIRPN +AIRP0: SETZM IRPCR ;NO GROUPS SEEN YET. + +;FALLS THROUGH. + +;FALLS THROUGH. + +;TRY TO READ IN ANOTHER GROUP. +AIRP1: CALL PDEF ;READ IN DUMMY NAME, PUSH ON DMYTOP. + CAIE T,", ;TERMINATOR WASN'T COMMA AND NAME WAS NULL + JUMPE SYM,AIRP2 ;=> NO MORE GROUPS. + CALL PDEF ;NONNULL GROUP, READ & PUSH 2ND NAME. + CAIN T,"[ ;] TRY TO DETECT "IRP X,[", ETC. ] + CALL [ETR [ASCIZ/Comma missing in IRP/] + TLO FF,FLUNRD ;GENERATE A COMMA. + RET] + CALL ADDTRN ;PUSH CHAR ADDR OF 1ST DUMMY, + CAIE LINK,NIRPS + CAIN LINK,NIRPC ;LEAVE SPACE FOR IRPC'S 1ST ARG, IRPS'S 2ND. + CALL PUT377 + MOVE A,RDWRDP + CAIN LINK,NIRPS + AOS -1(A) ;IRPS - 1ST ARG GOES AFTER NEXT 377. + CALL ADDTRN ;PUSH CHAR ADDR OF 2ND DUMMY. + CALL PUT377 + MOVE A,RDWRDP + XCT AIRP1T-1(LINK) ;MAYBE INCREMENT THAT ADDR. + AOS IRPCR ;ONE MORE GROUP SEEN. + JSP D,RARG ;INITIALIZE READING LIST. + JRST AIRP3 ;NO LIST. + JRST @.(LINK) + OFFSET 1-. +NIRPO:: AIRPO ;IRP +NIRPC:: AIRPC ;IRPC +NIRPS:: AIRPS ;IRPS +NIRPW:: AIRPW ;IRPW +NIRPN:: AIRPN ;IRPNC + OFFSET 0 + +AIRP1T: AOS -1(A) + AOS -1(A) ;INCR. THE 2ND DUMMY ADDR FOR IRP, IRPC. + SOS -1(A) + JFCL ;DECR. FOR IRPS, NOTHING FOR IRPW. + AOS -1(A) ;INCR. FOR IRPNC. + +;READ LIST FOR IRPC OR IRP AND STUFF INTO STRING. +AIRPC: +AIRPO: CALL RARGCP ;COPY UP TO END OF ARG INTO MACRO SPACE. + JRST AIRP3 + +AIRPW3: CALL PUT377 ;END A LINE, + CAIGE C, + CALL PUT377 ;IF NO ; YET, MAKE NULL 2ND ARG. +;COME HERE FOR IRPW, LOOP BACK FOR NEXT LINE. +AIRPW: SETO C, ;NO ; SEEN YET IN LINE. +AIRPW1: JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST, GO WRITE 375. + CAIE A,^M + CAIN A,^J + JRST AIRPW1 ;IGNORE NULL LINES. +AIRPW4: CAIN A,"; + AOJE C,AIRPW2 ;ON 1ST SEMI, SWITCH TO 2ND ARG. + CAIE A,^J + CAIN A,^M + JRST AIRPW3 ;END OF LINE => END BOTH ARGS, START OVER. +AIRPW5: CALL PUTREL + JSP D,RARGCH(T) + JRST AIRP3 ;END OF LIST. + JRST AIRPW4 + +AIRPW2: MOVEI A,377 + JRST AIRPW5 + +AIRPS: SETO C, ;NO SQUOZE CHAR SEEN YET. +AIRPS2: JSP D,RARGCH(T) + JRST AIRP3 + HLRZ CH1,GDTAB(A) + CAIN CH1,(RET) + CAIN A,"! + AOJA C,AIRPS0 ;A SQUOZE CHAR OR !. + JUMPL C,AIRPS2 ;NON SQUOZE FOLLOWING ANOTHER, FLUSH. + DPB A,AIRPSP ;NONSQUOZE ENDING NONNULL SYL, PUT BEFORE SYL. + SETZM AIRPSP + CALL PUT377 ;FOLLOW SYL WITH 377. + JRST AIRPS + +AIRPS0: JUMPN C,AIRPS3 ;NOT 1ST CHAR IN SYL? + PUSH P,A + CALL PUT377 ;1ST, LEAVE A SPACE FOR THE SYL'S TERMINATOR. + MOVE A,FREPTB + MOVEM A,AIRPSP ;REMEMBER WHERE THE SPACE IS. + REST A +AIRPS3: CALL PUTREL + JRST AIRPS2 + +AIRPN: SKIPG C,AIRPN0 ;ANY CHARS TO IGNORE? + JRST AIRPN4 + JSP D,RARGCH(T) + JRST AIRP3 + SOJG C,.-2 +AIRPN4: SKIPN C,AIRPN2 ;GET MAX # GRPS OF CHARS. + JRST AIRPN7 ;0 => IGNORE THE REST. +AIRPN5: MOVE B,AIRPN1 ;DO NEXT GRP, GET # CHARS/GRP. +AIRPN6: JSP D,RARGCH(T) + JRST AIRP3 + CALL PUTREL ;STORE THE NEXT CHAR. + SOJG B,RARGCH(T) ;COUNT CHARS IN GRP. + MOVEI A,376 + CALL PUTREL ;FOLLOW GRP BY 376. + SOJN C,AIRPN5 ;MAYBE CAN DO MORE GRPS. +AIRPN7: CALL RARFLS ;DID AS MANY GRPS AS CAN DO, + ;IGNORE REMAINDER OF LIST. + +;COME HERE WHEN EXHAUST THE LIST. +AIRP3: CALL STPWR + JRST AIRP1 ;READ ANOTHER GROUP. + +;ALL GROUPS READ IN; NOW READ IN BODY. +AIRP2: CAIE T,"; ;IF A SEMICOLON ENDED THE ARGS, SKIP THE COMMENT. + JRST AIRP4 +AIRP5: CALL RCH + CAIE A,^M + JRST AIRP5 +AIRP4: PUSH P,LINK + MOVE A,FREEPT ;SAVE CHAR ADDR START OF BODY + MOVEM A,PRIRP ;WHERE GC WILL RELOCATE IT. + PUSHJ P,RCH ;IF NEXT CHAR LF, THEN FLUSH IT + CAIE A,12 + TLO FF,FLUNRD + PUSHJ P,WRQOTE ;READ BODY OF IRP + PUSHJ P,STPWR ;WRITE STOP + PUSHJ P,PUSHEM ;SAVE WORLD + REST LINK + POP P,A ;RESTORE RDWRDP FROM LONG AGO + PUSH P,TOPP ;NOW SAVE TOPP + PUSHJ P,DMYTRN ;ACTIVATE DUMMYS + MOVE B,MACP ;NOW GET MACRO PDL POINTER + MOVE A,CIRPCT ;GET .IRPCNT + HRRM A,(B) ;CLOBBER "RETURN" ON PDL TO OLD IRPCNT + SETOM CIRPCT ;INITIALIZE IRPCNT + MOVS A,IRPCR ;GET # GROUPS + HRR A,PRIRP ;CHAR ADR OF BEGINNING OF BODY + SETZM PRIRP + DPB LINK,[410300,,A] ;PUT IN TYPE OF IRP. + PUSH B,A ;PUSH ,,CHAR ADR BEGINNING + POP P,A ;NOW GET OLD TOPP + HRLS A ;MOVE TO LEFT HALF + HRRI A,AIRR ;RETURN TO AIRR ON END OF BODY + PUSH B,A ;PUSH OLD TOPP,,AIRP4 + MOVEM B,MACP ;STORE BACK UPDATED MACRO PDL POINTER + MOVE A,STOPPT + MOVEM A,CPTR ;CAUSE STOP RIGHT AWAY TO CAUSE CYCLING + REST I + JRST MACCR + +;RECYCLE THROUGH IRP + + ;AC ALLOCATIONS: +AIRR: PUSH P,A ;A GETS BP ILDBING THRU ARG LIST. + PUSH P,C ;C # GROUPS LEFT + PUSH P,T ;T ADR OF PAIR OF CHAR ADR'S OF DUMMYS + PUSH P,TT ;TT TYPE OF IRP (NIRPO, NIRPC, ETC) + AOS CIRPCT ;INCREMENT .IRPCNT + HRRZ A,(B) ;GET CHARACTER ADR BEG BODY FROM PDL + PUSHJ P,ACPTRS ;SET UP CPTR + SETOM AIRPT + TRNE FF,FRMRGO + JRST AIRR9 ;RETURN TO .GO + HLRZ T,1(B) ;DUMMY TAB ADR + LDB C,[220600,,(B)] ;# GROUPS + JUMPE C,AIRR9 ;JUMP IF NO GROUPS + LDB TT,[410300,,(B)] ;GET TYPE OF IRP (NIRPO, ETC) +AIRR6: JRST @.+1(TT) +AIRRER ? AIRRO ? AIRRC ? AIRRS ? AIRRW ? AIRRN ? AIRRER ? AIRRER +AIRRER: GOHALT + +;MOVE 1 ARG THRU 1 GROUP OF IRP. +AIRRO: HRRZ A,1(T) ;THE 1ST ARG WILL START THIS TIME + HRRZM A,(T) ;WHERE THE "REST OF STRING" STARTED LAST TIME. + BCOMP A,-1 ;GET BP THAT'LL ILDB THAT CHAR. + SETO CH1, ;COUNT [-] DEPTH. +AIRRO1: ILDB B,A + CAIN B,375 + JRST AIRRO4 ;END OF STRING IS END OF ARG. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIN B,"[ + AOJE CH1,AIRRO3 ;FLUSH OUTERMOST [-] PAIRS. + CAIN B,"] + SOJL CH1,AIRRO3 + JUMPGE CH1,AIRRO1 ;DON'T LOOK FOR , WITHIN [-]. + CAIE B,^J + CAIN B,", + JRST AIRRO2 ;END OF ARG. + CAIE B,^M ;^M IS IGNORED (FLUSHED.) + JRST AIRRO1 +AIRRO3: MOVEI B,376 ;FLUSH A CHAR BY REPLACING WITH 376 + DPB B,A + JRST AIRRO1 + +AIRRC4: SUB P,[1,,1] +AIRRC3: SETZM (T) ;NULLIFY BOTH ARGS PERMANENTLY. +AIRRO4: SETZM 1(T) ;NULLIFY 2ND ARG PERMANENTLY + JRST AIRR8 ;DONE WITH THIS GROUP. + +AIRRO2: MOVEI B,377 ;REPLACE CHAR THAT ENDED ARG WITH TERMINATOR. + DPB B,A +AIRRW3: CCOMP1 A,-1 ;GET ADDR OF CHAR AFTER. + HRRZM B,1(T) ;"REST OF STRING" STARTS THERE. + JRST AIRR8 + +AIRRN: MOVE A,1(T) ;NEW 1ST DUMMY STARTS AT OLD "REST OF STRING". + MOVEM A,(T) + BCOMP A,-1 ;NEW "REST OF STRING" STARTS AFTER 376, + JRST AIRRW2 ;WHICH WILL BECOME A 377. + +AIRRW: MOVE A,1(T) ;GET CHAR ADDR START OF 2ND HALF OF PREV LINE. + CALL AIRRM ;SET 1ST DUMMY -> AFTER NEXT 376 OR 377 . +AIRRW2: ILDB B,A ;MOVE UP TO NEXT 377 OR END OF STRING. + CAIN B,375 ;END OF STRING ENDS 1ST DUMMY'S ARG => + JRST AIRRO4 ;NULLIFY THE 2ND DUMMY. + SETZM AIRPT ;THIS GROUP NOT NULL. + CAIGE B,376 + JRST AIRRW2 + JRST AIRRO2 ;SET UP 2ND DUMMY -> NEXT CHAR. + + +;MOVE UP IN 1 GROUP OF IRPS. +AIRRS: MOVE A,(T) ;MOVE FROM 1ST DUMMY, + CALL AIRRM ;PUT 1ST DUMMY AFTER NEXT 377, + AOS (T) ;MOVE IT PAST THE SYL'S TERMINATING CHAR, + ILDB CH1,A ;GET THAT CHAR, + MOVE A,1(T) + JRST AIRRS2 ;STORE AS 2ND DUMMY. + +AIRRM: BCOMP A,-1 ;A HAS CHAR ADDR; WILL ILDB THAT CHAR. +AIRRM1: ILDB B,A + CAIN B,375 ;END OF STRING => NULLIFY BOTH ARGS + JRST AIRRC4 ;AND FINISHED WITH GROUP. + CAIE B,377 + JRST AIRRM1 + MOVE CH1,A + CCOMP1 CH1,-1 ;GET CHAR ADDR OF CHAR AFTER 377 + MOVEM CH2,(T) ;PUT 1ST DUMMY THERE. + RET ;NOTE A NOT CLOBBERED, CAN GO ON ILDB'ING. + +;MOVE UP IN ONE GROUP OF IRPC. +AIRRC: AOS A,1(T) ;DELETE 1ST CHAR FROM "REST OF STRING". + BCOMP A,-1 ;GET BP -> THAT CHAR. + LDB CH1,A ;GET THE CHAR. + MOVE A,(T) ;GET CHAR ADDR OF PLACE TO PUT IT. +AIRRS2: CAIN CH1,375 ;REACHED END OF STRING => + JRST AIRRC3 ;NULLIFY BOTH ARGS. + BCOMP A,0 + DPB CH1,A ;STORE IT IN THE 1-CHAR ARG. +AIRR7: SETZM AIRPT ;THIS GROUP NOT EXHAUSTED YET. +AIRR8: ADDI T,2 + SOJG C,AIRR6 ;MORE GROUPS => DO THE NEXT. +AIRR9: POP P,TT ;RETURN FROM AAIRPC + POP P,T + SKIPL AIRPT + JRST REPT3 + MOVN A,[2,,2] ;ARGS EXHAUSTED, RETURN + ADDB A,MACP + HRRZ A,(A) + MOVEM A,CIRPCT + POP P,C + POP P,A + JRST RCHSAV + +;IRP ARG-STRING READING COROUTINES: CALL WITH JSP D, +;INITIALIZE FOR READIN OF ARG BUT DON'T GET A CHAR. +;SKIPS IF NONNULL ARG AVAILABLE. +;COROUTINES REMEMBER INFO IN T AND TT BETWEEN CALLS. +;THE CALLER SHOULDN'T CLOBBER THEM. +RARG: CALL RCH ;DECIDE WHAT TYPE OF ARG FOLLOWS, IF ANY. + CAIN A,LBRKT ;RARG ALLOWS [-] AND MAYBE {-} ARGS AS WELL AS SIMPLE ONES. + JRST RARGBR +IFN BRCFLG,[ + CAIN A,LBRACE + JRST RARGRR +] + TLO FF,FLUNRD + JSP T,RARGXT ;CAUSE FAILURE RETURN ON SEMI, CR, LF. +RARGN: CALL RCH ;RARGCH RTN FOR NORMAL ARG. +RARGX1: CAIN A,", + JRST (D) ;COMMA ENDS ARG. +RARGXT: CAIN A,"; + JRST RARGSM ;SEMI ENDS SCAN. +RARGX2: CAIE A,^M + CAIN A,^J ;CR, LF END SCAN. +RARGSM: TLOA FF,FLUNRD + JRST 1(D) + JRST (D) + +RARGBR: SETZ TT, ;TT USED AS BRACKET COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR [-] TYPE ARGS. +RARGBC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRKT + AOJA TT,1(D) + CAIN A,RBRKT + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACKET. + +RARGRR: SETZ TT, ;TT USED AS BRACE COUNTER. + JSP T,1(D) ;RETURN, WITH RARGCH RTN IN T. +;READ-CHAR RTN FOR {-} TYPE ARGS. +RARGRC: CALL RCH ;READ NEXT CHAR OF ARG. + CAIN A,LBRACE + AOJA TT,1(D) + CAIN A,RBRACE + SOJL TT,(D) + JRST 1(D) ;SKIP-RETURN UNLESS JUST READ THE FINAL CLOSEBRACE. + +;TO GET THE NEXT CHAR OF THE ARG IN A, DO JSP D,RARGCH(T). +;SKIPS UNLESS NO MORE CHARS TO GET. +;NO SKIP AND SET => SCAN SHOULD BE TERMINATED. +;RARG SHOULD NOT BE CALLED AGAIN IN THAT CASE. +RARGCH==0 ;THIS SYMBOL IS FOR CREF'S SAKE. + +;COPY THE ARG BEING READ INTO MACRO SPACE. +;ON RETURN, A WILL HOLD "; IF ARGUMENT WAS ENDED BY ";". +RARGCP: JSP D,RARGCH(T) + JRST RARGC1 + CALL PUTREL + JRST RARGCH(T) + +RARGC1: CAIE A,"; ;IF SEMI ENDED THE ARG, FLUSH THE + RET ;SPACES AND TABS BEFORE IT. +RARGC2: LDB A,FREPTB + CAIN A,^I + JRST RARGC3 + CAIE A,40 + JRST [ MOVEI A,"; ;LAST CHAR OF ARG ISN'T SP OR TAB. + RET] ;MAKE SURE A HAS ";" IF ARG WAS ENDED BY ";". +RARGC3: SOS FREEPT ;IT IS ONE; BACK OVER IT. + MOVE A,FREPTB + DBPM A + MOVEM A,FREPTB + JRST RARGC2 + +;IGNORE THE REST OF THE ARG NOW BEING READ. +RARFLS: JSP D,RARGCH(T) + RET + JRST RARGCH(T) + +;COME HERE TO SET UP TO READ A BALANCED ARG. +;IF THERE'S NO ARG, RETURNS WOTH JRST (D). +;ELSE RETURNS WITH JRST 1(D) SETTING UNRCHF. +RARB: TLO FF,FLUNRD + SETZ TT, ;TT USED AS BRACKET COUNTER. + CAIE A,RBRACE + CAIN A,") ;IF 1ST CHAR IS A CLOSE, + JRST RARB4 ;THERE'S NO ARG. + CAIE A,"> + CAIN A,RBRKT + JRST RARB4 + JSP T,RARGXT ;CHECK FOR CR, LF, SEMI, AND RETURN. +;1-CHAR RTN FOR READING BALANCED ARG. +RARBC: CALL RCH + CAIE A,RBRACE + CAIN A,"> ;FOR CLOSES, MAYBE END ARG. + JRST RARB2 + CAIE A,") + CAIN A,RBRKT + JRST RARB2 + CAIE A,LBRACE + CAIN A,"< ;FOR OPEN BRACKETS, INCR. THE COUNT. + AOJA TT,1(D) ;OPENS CAN'T END THE ARG. + CAIE A,"( + CAIN A,LBRKT + AOJA TT,1(D) + JUMPN TT,1(D) + JRST RARGX1 ;NOT WITHIN BRACKETS, TEST FOR COMMA, ETC. + +RARB2: SOJGE TT,1(D) ;COME HERE FOR CLOSEBRKTS. +RARB4: TLO FF,FLUNRD + JRST (D) + +;COME HERE TO INIT FOR AN ARG FOR REPEAT, ETC. +;THAT IS, EITHER A BRACKETED ARG OR A 1-LINE ARG. +RARL1: CALL RCH +RARL2: +IFN BRCFLG,[ +RARL4: CAIN A,LBRACE + JRST RARGRR ;1ST CHAR A BRACE => BRACED ARG. +] + CAIN A,LBRKT ;1ST CHAR A BRKT => BRKT ARG. + JRST RARGBR + TLO FF,FLUNRD + +;INIT FOR A 1-LINE ARG. +RARL: JSP T,1(D) +;1-CHAR RTN FOR 1-LINE ARGS. +RARLC: CALL RCH + JRST RARGX2 + +IFE BRCFLG,[ +;IF BRACES AREN'T USED BY MOST THINGS, THE NORMAL ROUTINE RARL1 DOESN'T +;CHECK FOR THEM, BUT RALR4 (CALLED BY CONDITIONALS) STILL MUST. +RARL4: CAIN A,LBRACE + JRST RARGRR + JRST RARL2 +] + +;1-LINE ARGS TO MACROS: DON'T TERMINATE THE SPEC, +;AND SKIP OVER THE CR AND LF. +RARL3: TLO FF,FLUNRD + JSP T,1(D) + CALL RCH + CAIN A,^J + JRST (D) ;LF IS THE END - SKIP IT. + CAIE A,^M + JRST 1(D) + CALL RCH ;CR => SKIP FOLLOWING LF, END ARG. + CAIE A,^J + TLO FF,FLUNRD + JRST (D) + +;PUSHJ P,A.GST SEARCH CURRENT MACRO STRING FOR TAG (IN A.GST4) +;SKIP IF FOUND, RETURN ON END OF STRING ANYWAY +;BYTE POINTER (ILDB TO GET FIRST CHARACTER) IN A + +A.GST: MOVEM A,A.GST3 ;SAVE BYTE POINTER +A.GST1: ILDB B,A.GST3 ;GET CHAR + CAIL B,300 + POPJ P, ;END OF STRING => STOP + CAIE B,". + JRST A.GST1 ;WAIT FOR POINT + PUSHJ P,A.GSYL ;FOUND POINT, GET REST OF NAME + JUMPL T,CPOPJ ;RETURN ON END OF STRING + CAME SYM,[SQUOZE 0,TAG] ;TAG? + JRST A.GST1 ;NO, KEEP GOING + PUSHJ P,A.GSYL ;GET THE TAG + JUMPL T,CPOPJ ;RETURN ON END OF STRING (THERE MUST BE BREAK CHAR AFTER TAG BEFORE STOP) + CAME SYM,A.GST4 + JRST A.GST1 ;NOT THE ONE BEING LOOKED FOR + MOVE A,A.GST3 + LDB B,A ;GET DELIMITER + CAIE B,15 ;CR? + JRST POPJ1 + ILDB B,A ;CR, GET NEXT CHAR + CAIE B,12 ;LINE FEED? + MOVE A,A.GST3 ;NO, DON'T FLUSH + JRST POPJ1 + + ;LOOK BACKWARD FOR BEGINNING OF STRING, BYTE POINTER AN A + ;LEAVES POINTER POINTING AT STOP CHAR (NOT BEFORE); ALSO LEAVES STOP CHAR IN B + +AG.SP: MOVE B,(A) ;GET WORD FROM MACTAB + XOR B,[300_28.+300_20.+300_12.+300_4] ;DO XOR TO ANITIALLY SET UP + LDB CH1,[400400,,A] ;PICK UP 4 HIGH ORDER BITS OF POSITION FIELD + JRST A.GSP2-1(CH1) ;DISPATCH ON POSITION FIELD (-1 SINCE BIT SET IN POSITION FIELD) + +AG.SP3: MOVE B,(A) + XOR B,[300_28.+300_20.+300_12.+300_4] + +A.GSP2: TRNN B,300_4 + JSP CH1,AG.SF + TLNN B,3 + JSP CH1,AG.SF + TLNN B,300_2 + JSP CH1,AG.SF + TLNN B,300_10. + JSP CH1,AG.SF + SOJA A,AG.SP3 + +AG.SF: SUBI CH1,A.GSP2-1 ;GET HERE WHEN STOP CHAR FOUND + DPB CH1,[400400,,A] ;CLOBBER POSITION FIELD OF BYTE POINTER AGAIN + ILDB B,A ;INCREMENT TO UNIVERSALLY ACCEPTABLE POINTER, GETTING STOP CHAR IN B AT SAME TIME + POPJ P, ;THAT'S ALL + +A.TAG: PUSHJ P,GSYL + CAIE T,15 + JRST MACCR + PUSHJ P,RCH + CAIE A,12 + TLO FF,FLUNRD + JRST MACCR + +A.GO: PUSHJ P,GSYL ;DOESN'T WORK RELIABLY FROM DUMMY + MOVEM SYM,A.GST4 + +A.GO1: TLNN FF,FLMAC + JRST MACCR ;NOT GETTING CHARS FROM MACRO => STOP + MOVE A,CPTR + PUSHJ P,AG.SP ;BACK TO BEGINNING + CAIN B,374 + JRST A.GOMC ;MACRO, SKIP PAST HEADER +A.GORT: PUSHJ P,A.GST + JRST A.GO2 ;END OF STRING, TRY POPPING UP ONE + MOVEM A,CPTR + JRST MACCR + +A.GO2: PUSHJ P,PMACP + JRST A.GO1 + +A.GSYL: MOVNI D,100000 ;GET SYL FOR .GO WHILE LOOKING FOR TAG + MOVEM D,STRCNT ;STRCNT .LT. 0 SIGNAL FOR GSYL TO JRST (F) + MOVEI SYM,0 + JSP F,GSYL1 +A.GSY3: ILDB A,A.GST3 ;GET CHAR + TRZN A,200 ;CHECK FOR SPECIAL + JRST A.GSY2 ;NO, FALL BACK IN + CAIG A,100 ;BIG ENOUGH TO BE SPECIAL? + JRST A.GSY3 ;NO, MUST BE DUMMY, IGNORE + HRROI T,(A) ;SPECIAL => ASSUME STOP: T .LT. 0 SIGNAL TO CALLING ROUTINE + POPJ P, ;RETURN TO CALLING ROUTINE + +;INITIALIZE MACRO STATUS + +MACINI: MOVEI A,3 + MOVEM A,FREEPT ;FORGET ALL STRINGS IN MACTAB + PUSHJ P,FCOMP + MOVE A,MACTAD + HRLI A,41000 ;SET UP CCOMPB THRU CCOMPE + LSH A,2 ;(THEIR VALUES CAN'T BE ASSEMBLED IN BECAUSE + SUBI A,4 ;THEY ARE MUTLTIPLY RELOCATABLE, AND IN DEC + MOVSI AA,CCOMPB-CCOMPE ;VERSION THAT CAN'T BE DONE) +MACIN0: MOVEM A,CCOMPB(AA) + AOJ A, + AOBJN AA,MACIN0 + MOVE A,MACTAD + ADDI A,MACL+1777 + ANDI A,-2000 ;ADDR OF 1ST WD AFTER MACTAB. + CALL MACIN2 ;SET UP PTRS TO END OF MACTAB. + SETZM GCCNT ;CLEAR OUT GC COUNT SO WILL GET MORE CORE FIRST THREE +MACIN1: SETZM MDEPTH ;NOW INITIALIZE MACRO EXPANSION STATUS + SETZM PRSTG ;NOW TO CLEAR OUT BYTE POINTERS + MOVE A,[PRSTG,,PRSTG+1] + BLT A,EPRSTT-1 + MOVEI A,DSTG + MOVEM A,RDWRDP + MOVEI A,DMYAGT + MOVEM A,TOPP + MOVEM A,BBASE + MOVE A,[-MPDLL,,MACPDL] + MOVEM A,MACP + POPJ P, + +;A -> 1ST WD AFTER MACTAB, SET UP ALL POINTERS TO END OF MACTAB. +MACIN2: MOVEM A,MACTND + SUB A,MACTAD + LSH A,2 ;1ST BYTE MACTAB DOESN'T HAVE. + MOVEM A,MACHI + SUBI A,MACRUM*4 + MOVEM A,GCRDHI + MOVE A,STOPPT + HRR A,MACTND + SOS A ;LAST WD IN MACTAB. + MOVEM A,MACHIB ;INITIALIZE BYTE POINTER TO HIGHEST BYTE OK TO FILL + RET + + ;MACRO VARIABLE AREA (MOST THEREOF) + +VBLK +MACP: 0 ;MAC PDL POINTER +BLCODE [MACPDL: BLOCK MPDLL+1] ;MACRO PDL +FREEPT: 0 ;MACRO STG PNTR POINTS TO FREE CHAR +FREPTB: 0 ;FREEPT IN BYTE POINTER FORM +MACTAD: MACTBA ;ADDR OF START OF MACRO TABLE. +MACTND: 0 ;ADDR OF 1ST WD AFTER MACTAB. +MACHI: 0 ;CHAR ADR ONE ABOVE ACTIVE MACTAB +MACHIB: 0 ;POINTS TO LAST BYTE IN MACTAB + +SCONDF: 0 ;STRING CONDITIONAL FLAG, -1 => IDENTICAL, 0 DIFFERENT +GENSM: 0 ;GENERATED SYM COUNT +DEFNPS: 0 ;NONZERO => NAME OF PSEUDO NOW READING ITS ARG. + ;A FATAL ERROR WILL TYPE THE PSEUDO'S NAME. +DEFNPN: 0 ;PAGE # -1 OF THAT PSEUDO. ALSO TYPED BY FATAL ERRORS. +DEFNLN: 0 ;LINE # -1. +DEFNFI: 0 ;SIXBIT FN1 OF FILE CONTAINING PSEUDO THAT DEFNPS REFERS TO. +MDEPTH: 0 ;DEPTH IN MACRO (NOT IRP OR REPEAT) EXPANSIONS +PUTCNT: 0 ;AOS'D BY PUTREL, USED BY CALLING ROUTINE, USUALLY TO COUNT ACTIVE CHARS (DURING DEFINITION) +IRPCR: 0 ;COUNT OF A,B,[LIST] GROUPS IN IRP IRPC IRPS, " " " +AIRPT: 0 ;IRP EXPANSION TEMP, -1 => NO NON-NULL DUMMYS YET, ELSE 0 +AIRPN0: 0 ;1ST NUMERIC ARG TO IRPNC +AIRPN1: 0 ;2ND, +AIRPN2: 0 ;3RD. +A.QOT2: 0 ;DELIMITER FOR .QUOTE +CRPTCT: -1 ;COUNT THROUGH CURRENT REPEAT (FOR .RPCNT) +CIRPCT: -1 ;COUNT THOUGH CURRENT IRP (FOR .IRPCNT) +A.GST3: 0 ;ON .GO, NAME (IN SQUOZE) OF TAG BEING SEARCHED FOR +A.GST4: 0 ;BYTE POINTER FOR ILDB WHILE SEARCHING FOR TAG +PRCALP: PRCAL-1 ;POINTER INTO PRCALP, POINTS TO LAST ACTIVE ENTRY + +PRSTG: ;BEGIN WORDS GARBAGE COLLECTED: FIRST BYTE POINTERS ILDB'D + +CPTR: 0 ;ILDB TO GET NEXT CHAR FROM MACRO OR WHATEVER +IFE WRQTSW-1,WRQTBP: 0 ;POINTS TO LAST CHAR BEFORE CURRENT SYL AT WRQOTE +AIRPSP: 0 ;-> PLACE TO STORE SYL-TERMINATOR, IN IRPS READIN. +GCBPL==.-PRSTG ;END BYTE POINTERS, BEGIN CHARACTER ADDRESSES +PRSCND: 0 ;CHARACTER ADDRESS OF CURRENT LOCATION IN FIRST STRING OF IFSE,IFSN WHILE COMPARING WITH SECOND +PRSCN1: 0 ;CHAR ADR BEG OF FIRST STRING IFSE, IFSN +PRREPT: 0 ;CHAR ADR BEG OF BODY OF REPT +PRIRP: 0 ;CHAR ADR BEG OF IRP BODY +PRDEF: 0 ;CHAR ADR BEG OF MACRO BEING DEFINED +PRCAL: REPEAT 10,0 ;TEMP STORAGE FOR CHAR ADR BEG MACRO BODY, USED TO READ DUMMY SPECS +EPRSTT: ;END CHAR ADR WORDS GARBAGE COLLECTED + + ;BEGIN GARBAGE COLLECTOR VARIABLES + +GCCNT: 0 ;CNT OF GC'S +SYMSTR: 0 ;PNTR TO CHAIN OF MACRO PNTRS IN SYM TABLE (DURING GC), LINKED THROUGH RH'S OF "VALUE" +REDPT: 0 ;CHAR ADR READING FROM WHEN MOVING STRING DOWN +REDPTB: 0 ;REDPT IN BYTE POINTER FORM + ;GC WRITES WITH FREEPT/FREPTB +COFST: 0 ;AMOUNT CHARS MOVED DOWN BY, SUBTRACTED FROM CHAR ADR TO RELOCATE +SVF: 0 ;FLAG, .GE. 0 => NO POINTERS FOUND POINTING TO CURRENT STRING +FREPTS: 0 ;-> BEGINNING OF CURRENT STRING BEING COPIED DOWN +FRPTBS: 0 ;FREPTS IN BYTE POINTER FORM +GCENDF: 0 ;-1 => END OF LAST STRING FOUND, AFTER RELOCATING POINTERS, MSTG2 SHOULD EXIT +GCHI: 0 ;GC HIGH POINTER, CHAR ADR FIRST NOT TO GARBAGE COLLECT +GCRDHI: *4 ;GC DROPS DEAD (MACTAB FULL) IFWRITING INTO THIS CHAR ADR +BLCODE [GCSV: BLOCK 16] ;AC SAVE AREA FOR GC +PBLK + +;GARBAGE COLLECT THE MACRO TABLE + +GCA1: MOVE A,FREEPT ;GC ALL IN MACTAB. +GCA: MOVEM A,GCHI ;ENTRY TO STORE A IN GCHI -> FIRST CHAR NOT TO GARBAGE COLLECT +IFN 17-P+FF,.ERR GC ac saver wants FF=0, P=17! +GC: MOVEM 16,GCSV+15 ; Save all ACs except FF and P. + MOVE 16,[1,,GCSV] + BLT 16,GCSV+14 +IFN TS,[AOS A,GCCNT + CAIGE A,4 + PUSHJ P,GCCORQ ;EXPAND CORE ON FIRST THREE GC'S +] CLEARB T,GCENDF + MOVEI A,3 + MOVEM A,REDPT ;SET UP FOR READING + MOVEM A,FREEPT ;ALSO FOR WRITING + MOVE A,BCOMPU ;ALSO SET UP CORRESPINDING BYTE POINTERS + MOVEM A,FREPTB + MOVEM A,REDPTB + MOVE C,[-GCBPL,,PRSTG] +GCLP1: SKIPN B,(C) ;NOW CONVERT BYTE POINTERS... + JRST GCLP1B ;(INACTIVE) + CCOMP B,-1 ;TO CHARACTER ADDRESSES + MOVEM B,(C) ;STORE BACK CHARACTER ADDRESS +GCLP1B: AOBJN C,GCLP1 ;LOOP FOR ALL SUCH BYTE POINTERS + MOVE A,SYMAOB ;NOW SET UP MACRO LIST; T INITIALLY HAS 0 => END OF LIST DURING COMPUTATION +SYMMG: ;POINTS TO FIRST MACRO SYMTAB ENTRY ON LIST + LDB B,[400400,,ST(A)] ;GET SQUOZE FLAGS THIS SYM + CAIN B,PSUDO_-14. ;PSEUDO? (=> MAYBE MACRO) + JRST SYMMG1 ;YES, MAYBE PUT ON LIST (RETURNS TO SYMMG2) +SYMMG2: ADD A,WPSTE1 + AOBJN A,SYMMG ;LOOP FOR ENTIRE SYMTAB + MOVEM T,SYMSTR ;STORE INITIAL LIST ENTRY FOR MACROS + ;DROPS THROUGH + ;GC DEALS WITH "UNIT STRINGS", EACH STRING ENDS WITH 375 + ;GENERAL PROCEDURE IS TO COPY A STRING DOWN THEN SEARCH FOR POINTERS TO WHERE STRING USED TO BE + ;IF POINTERS FOUND THEY ARE RELOCATED TO POINT TO COPIED DOWN STRING + ;IF POINTERS ARE NOT FOUND THE STRING IS WIPED OUT + ;DROPS THROUGH + +MSTG: MOVE C,REDPT ;SET UP C TO POINT TO BEG OF STRING BEING READ + ;(FOR EVENTUALLY SEARCHING FOR POINTERS TO STRING, NOTE C STAYS AROUND FOR AWHILE) + MOVE TT,FREEPT + CAML TT,GCHI ;IF ALL OF ACTIVE PART OF MACTAB ALREAD GC'D, STOP NOW. + JRST GCEND + MOVEM TT,FREPTS ;-> BEGINNING OF WRITTEN STRING + MOVE TT,FREPTB + MOVEM TT,FRPTBS ;BYTE POINTER -> BEGINNING OF WRITTEN STRING + PUSHJ P,RDTRNS ;COPY CHARACTER + CAIN B,370 + JRST MSTGB ;THAT WAS NO STRING, THAT WAS MY IO-BUFFER! + MOVE TT,B ;SAVE CHARACTER JUST COPIED +MSTG1: CAML LINK,GCHI + JRST GCEND ;JUST READ LAST CHAR IN PART OF MACTAB TO GARBAGE COLLECT => DONE + CAIN B,375 + JRST MSTG2 ;END THIS STRING, NOW SEARCH FOR POINTERS, RETURNS TO MSTG + PUSHJ P,RDTRNS ;STRING NOT EXHAUSTED, COPY NEXT CHAR + JRST MSTG1 + +SYMMG1: HRRZ B,ST+1(A) ;PSEUDO FOUND IN SYMTAB, GET "VALUE" + CAIE B,MACCL ;MACCL? (=> MACRO, CHAR ADR OF BODY IN LH) + JRST SYMMG2 ;NO, JUST FALL BACK INTO LOOP + HRRM T,ST+1(A) ;MACRO, REPLACE MACCL PART OF VALUE WITH POINTER TO NEXT + MOVEI T,ST+1(A) ;UPDATE T (INITIAL LIST ENTRY) TO POINT TO WORD JUST CLOBBERED + PUSH P,A + HLRZ A,ST+1(A) + PUSHJ P,REDINC + CAIE B,374 + GOHALT + POP P,A + JRST SYMMG2 + + ;COPY CHARACTER DOWN (REDPTB -> FREPTB) + ;LEAVE INCREMENTED REDPT IN LINK, FREEPT IN A, CHAR IN B + +RDTRNS: ILDB B,REDPTB + IDPB B,FREPTB + AOS LINK,REDPT + AOS A,FREEPT + POPJ P, + +MSTGB: ADDI A,3 ;COPY AN IO-BUFFER: + TRZ A,3 + MOVEM A,FREEPT ;WRITE INTO WORD BOUNDARY. + ADDI LINK,3 + TRZ LINK,3 + MOVEM LINK,REDPT ;READ FROM WORD BOUNDARY. + MOVEI B,041000 + HRLM B,REDPTB + HRLM B,FREPTB + MOVE B,FREPTB + MOVE A,REDPTB + ADDI B,1 ;NEW ADDR OF 1ST WD. + HRRZ LINK,1(A) ;GET ADDR OF POINTER TO STRING. + MOVEM LINK,SVF ;REMEMBER WHETHER TO FLUSH STRING. + SKIPE LINK + HRRM B,(LINK) ;RELOCATE THAT POINTER (IF ANY) + HRLI B,1(A) ;SET UP AC FOR BLT. + HLRZ LINK,1(A) ;GET LENGTH OF STRING. + ADDM LINK,REDPTB + LSH LINK,2 + ADDM LINK,FREEPT + ADDM LINK,REDPT + LSH LINK,-2 + ADDB LINK,FREPTB + BLT B,(LINK) + MOVE LINK,REDPT + CAML LINK,GCHI ;IF THIS IO-BUFFER IS LAST THING IN MACRO SPACE, + SETOM GCENDF ;DON'T LOOK FOR ANYTHING FOLLOWING IT. + JRST MSTGB1 ;NOW MAYBE FLUSH THIS STRING, COPY NEXT. + +;GET HERE WHEN MSTG2 FINISHES WITH FLAG SET TO EXIT: UNDO INITIALIZATION AND RETURN + +GCEND1: IFN TS,[ + MOVE A,FREEPT + ADDI A,2000*4 + CAML A,MACHI + PUSHJ P,GCCORQ +] MOVE A,FREEPT + CAML A,GCRDHI + ETF [ASCIZ /Macro space full/] + SKIPN T,SYMSTR + JRST USYMG1 ;EMPTY LIST + MOVEI C,MACCL ;SET UP C FOR HRRM'ING +USYMG: HRRZ TT,(T) ;GET ADR ON LIST + HRRM C,(T) ;CLOBBER RH JUST GOT NEXT POINTER FROM TO MACCL + HLRZ A,(T) + PUSHJ P,REDINC + CAIE B,374 + GOHALT + SKIPE T,TT ;MAKE NEXT POINTER CURRENT, SKIP IF END OF LIST + JRST USYMG + +USYMG1: MOVE C,[-GCBPL,,PRSTG] +GCLP2: MOVE A,(C) ;NOW CONVERT CHARACTER ADDRESSES... + BCOMP A,-1 ;BACK TO BYTE POINTERS + MOVEM A,(C) + AOBJN C,GCLP2 +IFN 17-P+FF,.ERR GC AC restorer wants FF=0 and P=17! + MOVS 16,[1,,GCSV] ; Restore all ACs except FF and P. + BLT 16,16 + POPJ P, ;EXIT FROM GARBAGE COLLECTOR + + ;GC ROUTINE TO SCAN TABLE AREA FOR POINTERS TO CURRENT STRING + ;CH1 -> BEGINNING OF TABLE, 4.9 => LOOK AT PAIRS SKIPPING SECOND OF EACH PAIR + ;T POINTS TO LAST WORD IN TABLE + 1 + ;RELOCATE POINTERS IN TABLE POINTED TO + ;C POINTS TO BEGINNING OF STRING, B -> END + 1 + +MSCN: CAIG T,(CH1) + POPJ P, ;TABLE EXHAUSTED + HRRZ TT,-1(T) ;GET LAST ENTRY IN TABLE (UPPER POINTER UPDATED TO COUNT DOWN) + CAML TT,C + CAML TT,B + JRST MSCN1 ;DOESN'T POINT TO CURRENT STRING + SUB TT,COFST ;POINTS TO STRING, RELOCATE + HRRM TT,-1(T) ;STORE BACK RELOCATED POINTER + SETOM SVF ;SET FLAG TO SAVE STRING +MSCN1: SKIPGE CH1 + SOS T ;CH1 NEGATIVE => SKIP A WORD + SOJA T,MSCN + +GCEND: SETOM GCENDF ;DONE READING FROM MACTAB, BUT FIRST HAVE TO RELOCATE POINTERS TO LAST STRING +MSTG2: CLEARM SVF ;NO POINTERS FOUND TO STRING YET + MOVE D,REDPT + SUB D,FREEPT + MOVEM D,COFST ;STORE AMOUNT CHARS COPIED DOWN BY FOR CHAR ADR RELOCATION + MOVE B,REDPT + CAIE TT,374 + JRST MSTG3 ;NOT A MACRO + MOVE T,SYMSTR + JUMPE T,MSTG3 ;JUMP IF NO MACROS ON LIST +MSTG5: HLRZ TT,(T) ;GET CHAR ADR THIS MACRO + CAML TT,C ;SKIP IF POINTS BELOW BEGINNING THIS STRING + CAML TT,B ;SKIP UNLESS POINTS TO OR ABOVE FIRST CHAR NOT YET READ + JRST MSTG4 ;DOESN'T POINT TO THIS STRING + SETOM SVF ;POINTS TO THIS STRING, SET FLAG TO SAVE STRING + SUB TT,COFST ;RELOCATE + HRLM TT,(T) ;STORE BACK UPDATED CHAR ADR THIS MACRO +MSTG4: HRRZ T,(T) ;NOW GET POINTER TO NEXT MACRO + JUMPN T,MSTG5 ;LOOP FOR ALL MACROS ON LIST + +MSTG3: MOVE T,TOPP + MOVEI CH1,DMYAGT + PUSHJ P,MSCN ;RELOCATE POINTERS IN DUMMY ARG TABLE + HRRZ T,MACP + HRROI CH1,MACPDL + PUSHJ P,MSCN ;RELOCATE POINTERS IN MACRO PDL + HRRZ T,PRCALP + AOS T + MOVEI CH1,PRSTG + PUSHJ P,MSCN ;RELOCATE POINTERS IN PRSTG + HRRZ T,RDWRDP + MOVEI CH1,DSTG + PUSHJ P,MSCN ;RELOCATE DUMMY ARGS READ (OR BEING READ) IN BUT NOT YET ACTIVATED + SKIPGE GCENDF + JRST GCEND1 ;EXIT +MSTGB1: SKIPE SVF + JRST MSTGB2 ;FOUND POINTERS TO THIS STRING, DON'T FLUSH + MOVE TT,FREPTS ;NO POINTERS FOUND, FLUSH STRING + MOVEM TT,FREEPT + MOVE TT,FRPTBS + MOVEM TT,FREPTB +MSTGB2: SKIPGE GCENDF ;IF WE JUST HACKED AN I-O BUFFER, MAYBE IT'S THE LAST + JRST GCEND1 ;THING IN MACRO SPACE. + JRST MSTG + +] ;END MACSW CONDITIONAL (AND MACRO PROCESSOR ROUTINES) + +IFN .I.FSW,[ ;;.I.F ;ALGEBRAIC COMPILER ROUTINE +; 'ALGEBRAIC' CRUFT MARO DEFINITIONS + +DEFINE MOAN ARG/ + MOVEI D,[SIXBIT /ARG!!/] + JRST ERRCON +TERMIN + +DEFINE RETLIN + MOVEI A,15 ;CARRIAGE RETURN + PUSHJ P,PUTREL + MOVEI A,12 ;LINE FEED + PUSHJ P,PUTREL +TERMIN + +DEFINE NUMBER + MOVE A,BTPNT + ILDB I,A + CAIE I,"# + CAIGE I,"@ +TERMIN + +DEFINE RESTOR + MOVE D,BTPNT + SETZM STRING + SETZM STRING+1 + SETZM STRING+2 +TERMIN + + +DEFINE SPECN + POP P,RANDM + MOVE A,ENN + SUB A,RANDM + MOVEM A,ENN +TERMIN + +DEFINE $GET + EXCH I,ACSVI + PUSHJ P,RCH + EXCH I,ACSVI +TERMIN + +DEFINE GETT + EXCH I,ACSVI + PUSHJ P,RCH + EXCH I,ACSVI + IDPB A,TPN +TERMIN + +; START OF COMPILER PROPER + +OPDL: CH?CH?CH?CH?CH?CH?CH?CH ;COMMUTATOR + CH?SP?CH?CH?CH?CR?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?CH?CH?CH?CH?CH + SP?CH?CH?CH?DL?CH?CH?CH + LP?RP?TX?PL?CM?MN?CH?DV + CH?CH?CH?CH?CH?CH?CH?CH + CH?CH?CH?KL?LB?EQ?RB?CH + +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?UP?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH +; CH?CH?CH?CH?CH?CH?CH?CH + +VBLK + +ENN: 60 ;ACCUMULATOR NUMBER - TROUBLE IF GOES PAST 9 + +BTPNT: 440700,,STRING ;D +STRING: BLOCK 10 ;CHARACTER ASSEMBLY (D) - TROUBLE IF OVERFLOWS + +TPN: 0 +DIRPNT: 440700,,DIROUT ;TPN +DIROUT: BLOCK 40 ;COPY OF LINE IN PROGRESS (TPN) - TROUBLE IF OVERFLOWS + +OPSTKL==40 + 0 +OPSTK: BLOCK OPSTKL ;OPERATOR STACK (R) - TROUBLE IF OVERFLOWS + 0 + + + +ENDSTT: 0 ;ON IF END OF STATEMENT ENCOUNTERED +CHARF: 0 ;LAST WAS NOT OPERATOR +NUMFL: 0 ;STRING IS NUMERIC CONSTANT (NEEDS [ AND ]) +R1SV: 0 ;SAVED A +R2SV: 0 ;SAVED I, CALLED V EARLIER ON + +INTEGR: 0 ;INTEGER ARITHMETIC +WARN: 0 ;ON AFTER ) TO STOP NON-OPERATOR +RANDM: 0 ;DUMP COMMA COUNT HERE +TEMP: 440600,,(D) ;INDIRECT VIA D +BYTPNT: 0 + ; Save 7 acs here, done by move(m)s for robustness +IRP AC,,[AA,A,B,C,D,I,P] +ACSV!AC: 0 +TERMIN +PBLK + +; ENTRANCE TO 'ALGEBRAIC' TRANSLATOR + +A.I: SETOM INTEGR + SKIPA +A.F: SETZM INTEGR + PUSHJ P,SWINI ;INITIALISE PASSAGE TO MIDAS ASSEMBLER +IRP AC,,[AA,A,B,C,D,I,P] + MOVEM AC,ACSV!AC +TERMIN + SETZM ENDSTT ;RESET END OF STMNT FLAG + SETZM EQHIT' ;RESET LAST CHAR WAS= FLAG + SETZM WARN ;SET OFF ERROR DETECTOR + MOVEI A,"0 ;INITIALISE POINTERS + MOVEM A,ENN + MOVE A,DIRPNT + MOVEM A,TPN ;POINTER TO SAVED INPUT + MOVE SYM,[-OPSTKL,,OPSTK] + PUSH SYM,[0,,ENDSAT] + PUSH P,[0] ;INITIALISE COMMA-COUNTER + SETZM CHARF +CLSTR: RESTOR +RDITTS: SKIPE ENDSTT + JRST BDEND +RDITA: GETT + CAIGE A,100 ;FOR ABBREVIATED DISPATCH TABLE + JRST @OPDL(A) + CAIN A,"\ + JRST AB + CAIN A,"^ + JRST UP + +CH: SETZM EQHIT + SKIPE WARN + JRST CHBRT +CHEY: IDPB A,D + SETOM CHARF ;NON UNARY FLAG + JRST RDITA + +GAMB: RESTOR +COMMT: MOVE I,R2SV + JRST GOPURT + +SHORT: ;DECIDES IF STRING CAN BE USED IN IMMEDIATE TYPE OPS + SETZM IMMED' + SKIPN STRING + POPJ P, ;NO STRING + MOVE A,BTPNT + ILDB I,A + CAIN I,"# + JRST APUPJ ;YEPE HE ASKED FOR IT + SKIPE STRING+1 + POPJ P, ;STRING IS LONG + SKIPA + +TSTSHL: ILDB I,A + JUMPE I,APUPJ ;ITS OK FOUND ONLY NUMBERS + CAILE I,"@ + POPJ P, ;NON-NUMBER IN STRING + CAIE I,". + JRST TSTSHL + ILDB I,A + SKIPN I ;ANYTHING FOLLOW '.' QST +APUPJ: SETOM IMMED' ;INDICATE IMMEDIATE USAGE IS POSSIBLE + POPJ P, + +SZPRT: SETZM CHARF +GOPRT: SETZM WARN +GOPART: MOVEM I,R2SV +GOPURT: HLRZ B,I + HLRZ C,(SYM) + CAMLE B,C + JRST PSOPR ;GO PUSH OPERATOR + SKIPN INTEGR + SETOM IMMED ;FOR ARITH OPS ONLY FIXED WILL DO IMMEDIATE + PUSHJ P,SHORT ;ESTABLISH IF STRING CAN BE IMMEDIFIED + POP SYM,A ;POP AN OPERATOR + JUMPN A,(A) + + MOAN OVERPOPPED OPERATOR STACK + +CHEX: MOVE A,R1SV + JRST CHEY + +RP: SKIPE EQHIT + AOS ENN ;TAKE CARE OF UNSATISFIED = AT END + SKIPN CHARF + JRST RTONOP + SETOM CHARF +BUDDY: SETOM WARN + MOVEI I,RPAR + JRST GOPART + +RTONOP: MOVE I,(SYM) + CAIN I,FUNCT + JRST BUDDY ;NO ARGUMENT FUNCTION + + MOAN ) FOLLOWS OPERATOR + +BDEND: MOAN TOO MANY ('S + +CHBRT: MOAN NON-OPERATOR FOLLOWS ) + +CR: SKIPE EQHIT + AOS ENN ;HANDLES UNSATISFIED = AT END + SETOM ENDSTT + MOVEI I,RCAR + JRST GOPRT + +LP: SETZM EQHIT + SKIPE WARN + JRST LFRHT + SETZM CHARF + SKIPE STRING + JRST INDX + PUSH P,[0] ;INITIALISE COMMA-COUNTER + PUSH SYM,[0,,LFTPR] + JRST RDITA + +INDX: NUMBER + JRST NUSTRB + GETT + CAIG A,"9 + JRST NMRINX + MOVEI I,"( + IDPB I,D +INDY: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDN + CAIN A,"- + JRST CMPNDN + CAIE A,") ;SEARCH FOR NEXT RP + JRST INDY + IDPB A,D +CMBAN: SETOM CHARF ;MAKE BELIEVE CHARATER LAST + SETOM WARN ;YET SET ) TRAP + JRST RDITA + +NMRINX: CAIN A,"- ;IS IT A MINUS + JRST INDZ + CAIN A,"+ + JRST INDZ + MOVEI I,"+ ;NUMERICAL SUBSCRIPT + IDPB I,D +INDZ: IDPB A,D + GETT + CAIN A,"+ ;IS IT COMPOUND SUBSCRIPT + JRST CMPNDC + CAIE A,") + JRST INDZ + JRST CMBAN + +CMPNDN: MOVEI I,") + IDPB I,D + JRST INDZ + +CMPNDC: MOVEI I,"( + IDPB I,D + JRST INDY + +LFRHT: MOAN ( FOLLOWS DIRECTLY ON ) + +SP=RDITA ;USE FOR NON ARITH STATS + +CM: MOVE I,[1,,COMMX] + SKIPN CHARF + AOS ENN + JRST SZPRT + +EQ: SETOM EQHIT + SETZM WARN + SKIPN CHARF ;TEST FOR EXISTANCE OF L H S + JRST EQFLOP + NUMBER ;IS L H S A NUMBER + JRST EQNUMB + MOVEI I,EQAAL +EQVAL: SETZM CHARF + PUSH SYM,I + PUSH P,STRING + PUSH P,STRING+1 + PUSH P,STRING+2 + PUSH P,[0] + JRST CLSTR + +PL: MOVE I,[2,,PLUS] + SKIPN CHARF + JRST RDITA ;UNARY PLUS + JRST SZPRT + +MN: MOVE I,[2,,MINUX] + SKIPN CHARF + MOVE I,[5,,UMINU] + JRST SZPRT + +AB: SKIPE CHARF ;ABSOLUTE VALUE + JRST ABERR ;NOT UNARY + MOVE I,[5,,UABS] + JRST SZPRT + +LB: SKIPN CHARF + JRST LP ;TREAT LIKE ( + NUMBER + JRST NUBRST + MOVEI I,FUNCT + JRST EQVAL + +RB=RP + +NUBRST: MOAN '<' FOLLOWS NUMBER + +NUSTRB: MOAN '(' FOLLOWS NUMBER + +EQFLOP: MOAN '=' FOLLOWS OPERATOR + +EQNUMB: MOAN '=' FOLLOWS NUMBER + +ABERR: MOAN NON-UNARY ABS + +TX: MOVE I,[4,,TIMES] + SKIPN CHARF + JRST RDITA ;UNARY TIMES + JRST SZPRT + +DL: $GET ;CONTINUE STATEMENT RC + $GET ;LF + $GET ;. + CAIE A,". ;DOT + JRST BDCONT + $GET ;F OR I + $GET ;CONTROL I OR SPACE + MOVE A,DIRPNT + MOVEM A,TPN ;RESET SAVED INPUT POINTER TO AVOID FILLING ITS BUFFER + MOVEI A,"$ + IDPB A,TPN + MOVEI A,40 + IDPB A,TPN + JRST RDITA + +ERRCON: TRNE FF,FRPSS2 ;NO OUTPUT ON SECOND PASS + JRST CONRBT +;MAY ALSO WANT TO USE STATEMENT PLUS LINE NUMBER TYPE TACTIC + MOVE B,DIRPNT +OUTRR: ILDB A,B + PUSHJ P,TYO + CAME B,TPN + JRST OUTRR + SKIPE ENDSTT + JRST CONERT +DORSTL: MOVEI A,40 + PUSHJ P,TYO + MOVEI A,"? ;POINT AT ERROR + PUSHJ P,TYO + MOVEI A,40 + PUSHJ P,TYO +DORSAL: $GET ;COPY UP TO LINE FEED + PUSHJ P,TYO + CAIE A,12 ;LF + JRST DORSAL +CONERT: PUSHJ P,TIPIS + PUSHJ P,CRR +CONRAT: +IRP AC,,[AA,A,B,C,D,I,P] + MOVE AC,ACSV!AC +TERMIN + JRST SWFLS ;GO BACK AND FLUSH + + +CONRBT: $GET + CAIE A,12 ;LF + JRST CONRBT + JRST CONRAT + +UP: SKIPN WARN ;FOR (NUMBER)^N + SKIPN STRING + JRST ITSEX + MOVEM A,R1SV ;SAVE THE ARROW + NUMBER + JRST CHEX ;ITS PART OF A NUMBER +ITSEX: MOVE I,[6,,STRSTR] + SKIPN CHARF + JRST EXMB + JRST SZPRT + +EXMB: MOAN UNARY ^ + +BDCONT: MOAN BAD CONTINUATION + +KL=CR ;SEMICOLON ACTS LIKE CR IN TERMINATING + +STRSTR: SKIPN STRING + JRST EXLS + NUMBER + SKIPA + JRST EXLS + SUBI I,61 + TDNE I,[-1,,777774] + JRST EXLS + MOVE A,STRING + TDNE A,[3777,,-1] + JRST EXLS + ADDI I,POWR + JRST @(I) + +EXLS: PUSH P,[ASCII !EXPLO!] + PUSH P,[ASCII !G !] + PUSH P,[0] + PUSH P,[1] + SETOM EXRET' + JRST FUNET + +DV: MOVE I,[4,,DIVIX] + SKIPN CHARF + MOVE I,[5,,UDIVI] + JRST SZPRT + +PSOPR: PUSH SYM,I ;PUSH OPERATOR FOR LATER EXCECUTION + SKIPN STRING + JRST RDITTS + PUSHJ P,SHORT ;CAN WE IMMEDIFY + PUSHJ P,MVOI ;AND MOVE OPERAND INTO STACK + JRST CLSTR + +PRODB: NUMBER ;OUTPUT WHAT IS IN STRING + SKIPE IMMED ;NO [ & ] IF IMMEDIATE USE + JRST OVNM + PUSH P,A + MOVEI A,"[ ;[ FOR CONSTANT + PUSHJ P,PUTREL + POP P,A + SETOM NUMFL +OVNM: CAIN I,"# + JRST PRDOC + + EXCH A,I + PUSHJ P,PUTREL + MOVE A,I +PRDOC: ILDB I,A + JUMPN I,OVNM + SKIPN NUMFL + POPJ P, + MOVEI A,"] ;] FOR CONSTANT + PUSHJ P,PUTREL + SETZM NUMFL + POPJ P, + +PRODC: HRLI A,440700 ;MAKE BYTE POINTER + JRST PRDOC + +LFTPR: SPECN + JRST RDITTS ;IGNORE LP ON STACK + +RCAR: GOHALT ;IMPOSSIBLE FOR THESE TO BE ON STACK +RPAR: GOHALT + +EQAAL: SPECN + SKIPE STRING + PUSHJ P,MVOI + MOVEI A,[ASCIZ ! MOVEM A!] + PUSHJ P,PRODC + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +ENDSAT: SPECN + SKIPN ENDSTT + JRST TOEARL + SKIPE STRING + PUSHJ P,MVOI +GETLF: $GET + CAIE A,12 ;LF + JRST GETLF +IRP AC,,[AA,A,B,C,D,I,P] + MOVE AC,ACSV!AC +TERMIN + JRST SWRET ;GO BACK + +MVOI: MOVE A,BTPNT + ILDB I,A + CAIN I,"& + JRST MVOALR ;OPERAND ALREADY THERE + MOVEI A,[ASCIZ ! MOVE A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVEI A!] +MVOIK: PUSHJ P,PRODC + MOVE A,ENN + AOS ENN +FINOF: PUSHJ P,PUTREL + MOVEI A,", + PUSHJ P,PUTREL + PUSHJ P,PRODB + RETLIN + POPJ P, + +MVOALR: AOS ENN + POPJ P, + +TOEARL: MOAN TOO MANY )'S + +PLUS: MOVEI A,[ASCIZ ! FADR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! ADD A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! ADDI A!] +OPERT: PUSHJ P,PRODC + SKIPE STRING + JRST GAINS + SOS ENN +OPRTE: MOVE A,ENN + SOS A + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +COMMAA: MOVEI A,", + PUSHJ P,PUTREL + MOVEI A,"A + JRST PUTREL + +GAINS: MOVE A,ENN + SOS A + PUSHJ P,FINOF + JRST GAMB + +MINUX: MOVEI A,[ASCIZ ! FSBR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! SUB A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! SUBI A!] + JRST OPERT + +TIMES: PUSHJ P,TMSTR + SKIPE IMMED + MOVEI A,[ASCIZ ! IMULI A!] + JRST OPERT + +DIVIX: MOVEI A,[ASCIZ ! FDVR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IDIV A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! IDIVI A!] + JRST OPERT + +UMINU: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE STRING + JRST MOABC + MOVEI A,[ASCIZ ! MOVNS A!] +UMINUC: PUSHJ P,PRODC + MOVE A,ENN + SOS A + PUSHJ P,PUTREL + RETLIN + JRST COMMT + +MOABC: MOVEI A,[ASCIZ ! MOVN A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVNI A!] + PUSHJ P,MVOIK + JRST GAMB + +UABS: CAMN B,C + JRST BAKWD + SKIPE STRING + JRST MOABS + MOVEI A,[ASCIZ ! MOVMS A!] + JRST UMINUC + +MOABS: MOVEI A,[ASCIZ ! MOVM A!] + SKIPE IMMED + MOVEI A,[ASCIZ ! MOVMI A!] + PUSHJ P,MVOIK + JRST GAMB + +MVONT: MOVEI A,[ASCIZ ! MOVE A!] + PUSHJ P,PRODC + MOVE A,ENN + JRST ONMVS + +TMSTR: MOVEI A,[ASCIZ ! FMPR A!] + SKIPE INTEGR + MOVEI A,[ASCIZ ! IMUL A!] + POPJ P, + +BAKWD: PUSH SYM,A + JRST PSOPR + +UDIVI: CAMN B,C + JRST BAKWD ;THESE HAVE TO BE STACKED REVERSE + SKIPE INTEGR + JRST UINDV + SKIPN STRING + PUSHJ P,MVONT + MOVEI A,[ASCIZ ! HRLZI A!] + PUSHJ P,PRODC + MOVE A,ENN + SKIPN STRING + SOS A + PUSHJ P,PUTREL + MOVEI A,[ASCIZ !,201400!] + PUSHJ P,PRODC + RETLIN + AOS ENN + JRST DIVIX + +ONTMS: PUSHJ P,TMSTR + PUSHJ P,PRODC + MOVE A,ENN + SOS A +ONMVS: PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A +LSTCHX: PUSHJ P,PUTREL + RETLIN + POPJ P, + +POWR: GAMB?POWR2?POWAA?POWR4 + +POWR4: PUSHJ P,ONTMS +POWR2: PUSHJ P,ONTMS + JRST GAMB + +POWAA: PUSHJ P,MVONT + AOS ENN + PUSHJ P,ONTMS + SOS ENN + PUSHJ P,TMSTR + PUSHJ P,PRODC + RESTOR + JRST OPRTE + +COMMX: AOS (P) + SKIPE STRING + PUSHJ P,MVOI + JRST GAMB + +UINDV: MOAN INTEGER UNARY DIVIDE + +FUNCT: SETZM EXRET +FUNET: SKIPE STRING + PUSHJ P,MVOI + SPECN + PUSHJ P,MORFMC + MOVEI A,[ASCIZ ! PUSHJ P,!] + POP P,STRING+2 + POP P,STRING+1 + POP P,STRING + PUSHJ P,PRODC + PUSHJ P,PRODB + RESTOR + RETLIN + PUSHJ P,MORFNC + SKIPN EXRET + JRST RDITTS ;AS USED FROM FUNCT + JRST COMMT ;AS USED FROM STRSTR + +MORFMC: MOVE A,RANDM + MOVEM A,RANSV' + SKIPN CHARF ;NO ARGUMENTS + AOS ENN + SETOM CHARF + MOVEI A,"1 + CAMN A,ENN ;ARE ARGUMENT ALREADY IN A0 AND UP + POPJ P, + SETZM CORDM +MORYLP: PUSHJ P,ZENBD + AOS CORDM + SOSL RANSV + JRST MORYLP + POPJ P, + +MORFNC: MOVEI A,"1 + CAMN A,ENN + POPJ P, + MOVE A,RANDM + MOVEM A,CORDM' +MORXLP: PUSHJ P,ZENBD + SOSL CORDM + JRST MORXLP + POPJ P, + +ZENBD: MOVEI A,[ASCIZ ! EXCH A!] + PUSHJ P,PRODC + MOVE A,CORDM + ADDI A,"0 + PUSHJ P,PUTREL + PUSHJ P,COMMAA + MOVE A,ENN + SOS A + ADD A,CORDM + JRST LSTCHX + +TIPIS: MOVE A,TEMP + MOVEM A,BYTPNT +MORTP: ILDB A,BYTPNT + CAIN A,1 ;EXCLAMATION + POPJ P, + ADDI A," ;SPACE + PUSHJ P,TYO + JRST MORTP + +] ;END .I.FSW CONDITIONAL + +IFN LISTSW,[ + +;LISTING ROUTINES. + +PNTR: MOVEM 17,PNTSA+17 + MOVEI 17,PNTSA + BLT 17,PNTSA+16 + MOVE P,PNTSA+P ; P = 17 so must restore. +IFN P-17, .ERR P=17 assumption at PNTR! + SKIPL LSTONP + JRST PNTR5 + AOSE LISTPF + JRST PNTR1 + SKIPGE T,LISTAD + JRST PNTR2 + PUSHJ P,P6OD + HLRZS T + PUSHJ P,PSOS ;PRINT SPACE OR ' + PUSHJ P,PILPTS +PNTR3: HLRZ T,LISTWD + PUSHJ P,P6OD + MOVS T,LSTRLC + TLNE T,400000 + AOJ T, + PUSHJ P,PSOS + HRRZ T,LISTWD + PUSHJ P,P6OD + HRRZ T,LSTRLC + PUSHJ P,PSOS + PUSHJ P,PILPTS + PUSHJ P,PILPTS +PNTR4: MOVE TT,[440700,,LISTBF] +PNTR6: CAMN TT,PNTBP + JRST PNTR5A + ILDB A,TT + PUSHJ P,PILPT + JRST PNTR6 + +PNTR5A: CALL PNTCR + MOVE A,LISTBC + CAIE A,14 + JRST PNTR7 +PNTR5C: CALL PILPT ;OUTPUT THE ^L, + CALL PNTHDR ;AND THE PAGE NUMBER. + JRST PNTR5D + +PNTR7: MOVEI A,12 + PUSHJ P,PILPT +PNTR5D: SETOM LISTBC +PNTR5: MOVNI A,LISTBS*5-1 + MOVEM A,PNTSW ;DETECT OVERFLOW OF LISTBF + MOVE TT,[440700,,LISTBF] + MOVEM TT,PNTBP + MOVSI 17,PNTSA + BLT 17,17 + POPJ P, + +PNTR5B: MOVE A,LISTBC + CAIN A,14 + JRST PNTR5C + JRST PNTR5D + +PNTR2: MOVEI T,8 + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR3 + +PNTR1: MOVE TT,[440700,,LISTBF] + CAMN TT,PNTBP + JRST PNTR5B + MOVEI T,25. + MOVEI A,40 + PUSHJ P,PILPT + SOJG T,.-1 + JRST PNTR4 + +PSOS: MOVEI A,"' + TRNN T,-1 +PILPTS: MOVEI A,40 + JRST PILPT + +P6OD: MOVE TT,[220300,,T] +P6OD1: ILDB A,TT + ADDI A,"0 + PUSHJ P,PILPT + TLNE TT,770000 + JRST P6OD1 + POPJ P, + +PNTCR: MOVEI A,^M ;OUTPUT ^M TO LST IF OPEN. +PILPTX: SKIPE LSTONP;OUTPUT CHAR TO LST IF LSTING. + JRST PILPT + RET + +PNTHDR: MOVEI A,^I + MOVEI B,10. ;MOVE TO COLUMN 80., + CALL PILPT + SOJG B,.-1 + PUSH P,LSTTTY + HLLOM B,LSTTTY ;POSITIVE SO TYOERR GOES ONLY TO LST. + TYPR [ASCIZ/Page /] + MOVE A,CPGN + CALL [AOJA A,DPNT] + REST LSTTTY +PNTCRR: CALL PNTCR ;OUTPUT CRLF TO LST IF OPEN. +PNTLF: MOVEI A,^J + JRST PILPTX + +DEFINE LSTM %A,B,C +IF1 [ [B] ? [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+LSTM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-LSTM0 +] +TERMIN + +A.LSTFF: AOS (P) ;RETURN NO VALUE. +; ADDR, CONTENTS IF NOT LISTING, CONTENTS IF LISTING. +LSTOFF: LSTM LSTONP,0,-1 + LSTM LSTPLM,[TLO B,4^5][JRST PSHLML] + LSTM RCHLST,RCHLS1,AOSN PNTSW + LSTM RCH1LS,RET,[CAILE A,^M] + LSTM POPLML,JFCL,[IDPB A,PNTBP] + JRST MDSCLR +LSTM0==.-LSTOFF + +LSTON: BLOCK LSTM0-1 + JRST MDSSET + +A.LSTN: SKIPN LISTP1 ;IF SHOULD LIST THIS PASS + JUMPGE FF,MACCR + SKIPE LISTP ;AND WANT LISTING, + CALL LSTON ;TURN ON LISTING OUTPUT. + JRST MACCR + +IFNDEF LISTBS,LISTBS==50. ;LISTBF SIZE IN WORDS. + +VBLK ;LISTING FEATURE VARIABLES + +PNTBP: 0 ;POINTER TO LISTING LINE BUFFER +LSTONP: 0 ;NONZERO WHEN OUTPUTTING TO LISTING FILE. +LISTP: +LISTON: 0 ;-1 IF LISTING ON +PNTSW: 0 ;-1 IF LAST CHR CR OR LF, OR -<# CHARS SPACE LEFT IN LISTBF> +LISTBF: BLOCK LISTBS +LISTAD: 0 ;ADDRESS OR -1 NONE 3.1 RELOC +LISTWD: 0 ;WORD +LSTRLC: 0 ;RELOCATION +LISTPF: 0 ;-1 OTHERS CONTAIN SOMETHING +LISTBC: 0 ;BREAK CHR CR LF OR FF OR -1 IF NONE SINCE LAST PNTR +LISTTM: 0 ;TEMP AT AEND +PNTSA: BLOCK 20 ;AC SAVE AREA FOR LISTING FEATURE +LISTP1: 0 ;POSITIVE => WANT TO LIST EVEN ON PASS 1. +] ;END IFN LISTSW, + +IFE LISTSW,VBLK + +;THESE VARIABLES ARE REFERENCED EVEN IF LISTSW IS 0. +LSTTTY: 0 ;TYOERR TYPES ON TTY IFF LE 0, ON LST IF NOT 0. +LSTPLM: TLO B,4^5 ;OR JRST PSHLML ;XCT'D BY PSHLMB. +POPLML: JFCL ;OR IDPB A,PNTSW ;XCT'D IN POPLMB. + +PBLK +IFE LISTSW, A.LSTN: A.LSTF: RET + +VBLK +IFN CREFSW,[ +CREFP: 0 ;SET BY C SWITCH TO REQUEST CREFFING. +CRFONP: 0 ;SET WHILE CREFFING. +CRFLFL: 0 ;LAST PAGNUM,,LINENUM OUTPUT. +CRFINU: JFCL\PUSHJ P,CRFUSE ;XCT THIS TO CREF NON-DEF OCCUR. +CRFLBL: JFCL\PUSHJ P,CRFLB1 ;XCT FOR DEF. OF NORMAL SYM. +CRFEQL: JFCL\PUSHJ P,CRFEQ1 ; FOR DEF. OF NORMAL SYM. OR INTSYM. +CRFMCD: JFCL\PUSHJ P,CRFMC1 ; FOR DEF. OF MACRO. +CRFDEF: JFCL\PUSHJ P,CRFDF1 ; FOR RANDOM DEF, CHECK FLAGS. +] +CRFILE: 0 ;SET => SHOULDN'T OUTPUT PAGNUM,,LINENUM'S +;USED BY .CRFILE INTSYM SO CAN'T BE IN CONDIT. +PBLK +IFN CREFSW,[ +CRFEQ1: MOVEI T,(B) + CAIN A,1 ;IF NOT PSEUDO OR NOT INTSYM, + CAIE T,INTSYM + JRST CRFLB1 ;IS NORMAL SYM. +CRFOD1: MOVSI T,600000 ;ELSE DEFINING INSN. + JRST CRFEQ2 + +CRFDF2: MOVEI T,(B) ;DECIDE WHETHER DEFINING MACRO OR PSEUDO. + CAIE T,MACCL + JRST CRFOD1 +CRFMC1: SKIPA T,[500000,,] ;DEFINING MACRO. +CRFLB1: MOVSI T,440000 ;DEFINING NORMAL SYM. +CRFEQ2: PUSH P,A + MOVE A,T + JRST CRFMA1 + +;COME HERE FOR NON-DEF; MUST DECIDE WHAT TYPE SYM. +CRFUSE: TLNE C,3NCRF ;SYM MAY HAVE CREFFING SUPPRESSED. + POPJ P, + PUSH P,A + CAIN A,1 + JRST CRFMAC ;PSEUDOS, MACROS. + MOVSI A,40000 ;FLAG FOR NORMAL SYM. + TRNN C,-1 + MOVSI A,200000 ;FLAG FOR INSNS. +CRFMA1: PUSH P,A + MOVE A,CLNN + HRL A,CPGN + AOBJN A,.+1 ;A HAS PAGNUM,,LINENUM . + SKIPGE CRFILE ;IF SHOULD OUTPUT IT, + JRST CRFUS1 + CAME A,CRFLFL ;AND HAS CHANGED, DO SO. + PUSHJ P,CRFOUT + MOVEM A,CRFLFL +CRFUS1: POP P,A + IOR A,SYM ;COMBINE SYM AND CREF FLAG. + PUSHJ P,CRFOUT + JRST POPAJ + +CRFMAC: MOVEI A,(B) + CAIN A,MACCL + SKIPA A,[100000,,] ;MACRO + MOVSI A,200000 ;PSEUDO-OP. + JRST CRFMA1 + +;DEFINING OCCURRENCE, MIGHT BE ANY TYPE SYM. +CRFDF1: CAIN A,1 ;TYPE 1 => MACRO OR PSEUDO. + JRST CRFDF2 + TRNE C,-1 ;ELSE INSN OR NORMAL SYM. + JRST CRFLB1 + JRST CRFOD1 + +DEFINE CRFM %A,B,C +IF1 [ [B] + [C] ] +IF2 [ MOVE A,[B] + MOVEM A,%A +.=.+CRFM0-2 + MOVE A,[C] + MOVEM A,%A +.=.-CRFM0] +TERMIN + + +A.CRFFF: AOS (P) ;.CRFOFF - STOP CREFFING. NO VAUE. +; LOCATION, NORMAL VALUE, VALUE WHILE CREFFING +CRFOFF: CRFM CRFONP,0,-1 + CRFM CRFLBL,JFCL,[PUSHJ P,CRFLB1] + CRFM CRFEQL,JFCL,[PUSHJ P,CRFEQ1] + CRFM CRFMCD,JFCL,[PUSHJ P,CRFMC1] + CRFM CRFINU,JFCL,[PUSHJ P,CRFUSE] + CRFM CRFDEF,JFCL,[PUSHJ P,CRFDF1] + POPJ P, +CRFM0==.-CRFOFF + +CRFON: BLOCK CRFM0-1 + POPJ P, + +A.CRFN: JUMPGE FF,MACCR + SKIPE CREFP ;.CRFON, IF HAVE CREF FILE, START CREFFING. + PUSHJ P,CRFON + JRST MACCR +] ;END IFN CREFSW, + +SUBTTL TS Routines for I/O & overall control + +IFN TS,.INSRT TSRTNS + +FEED1: SKIPA B,[40] +FEED: MOVEI B,5 + JRST TFEED + +VBLK + +IFG PURESW-DECSW,[ ;PURIFICATION ROUTINE + +PURIFG: -1 ;-1 IF NOT (YET) PURIFIED +] + VARIAB +VPAT: +VPATCH: BLOCK 20 +VPATCE=.-1 + +PBLK + +CONSTANTS + +PAT: +PATCH: BLOCK 100 +PATCHE: -1 + +IFG PURESW-DECSW,[LOC <.+1777>&-2000 ;SKIP TO NEXT PAGE + MAXPUR==._-10. ;FIRST PAGE ABOVE PURE PAGES +PRINTA Pure pages = ,\MAXPUR-MINPUR +] + +VBLK +PDL: BLOCK LPDL+1 + +IFN DECDBG, DECDBB: BLOCK 8000. ;SPACE FOR DEC DDT'S SYMS. + +.NSTGW +BBKCOD==. ;BEGIN BLANK CODING, CLEARED OUT DURING INITIALIZATION +IFG PURESW-DECSW,MINBNK==<.+1777>_-10. ;FIRST PAGE OF BLANK CODE +BNKBLK ;DUMP OUT ACCUMULATED BLANK CODING + + ;NOW MORE BLANK CODING + +BKBUF: BLOCK BSIZE+5 ;CURRENT BLOCK TO OUTPUT +GLOTB: BLOCK 20 ;GLOBAL TABLE, EACH ENTRY FLAGS,,ADR OF SQUOZE (SEE COMMENTS NEAR BEGINNING) +STRSTO: BLOCK STRL ;STRING STORAGE FOR GSYL AND FRIENDS +IFN FASLP,[ +FASB: BLOCK FASBL ;OUTPUT BUFFER FOR FASL MODE + ;FIRST WD 9 FOUR BIT CODE GROUPS, REST ASSOC STUFF +FASAT: BLOCK FASATL ;ATOM TABLE FOR FASL MODE + ;EACH ENTRY CONSISTS OF ATOM IN FORMAT DESIRED BY FASLOAD, + ;NAMELY: + ; HEADER WD. RH LENGTH IN WDS + ; 4.8-4.7 TYPE 0-PN 1 FIX 2 FLO 3 BIG (NOT IMPLEMENTED) + ; FOLLOWED BY PN OR VALUE + ;-EXCEPT- IF RH OF HEADER =0, THIS SLOT RESERVED FOR LIST + +] + +EBKCOD==. ;END BLANK CODING +.YSTGW + +PRINTA ST = ,\.-RL0 + +ST: ;SYMBOL TABLE 3 WORDS/SYM FIRST SQUOZE, SECOND "VALUE", 3RD FLAGS,,BLOCK. + BLOCK NRMWPS*SYMDSZ + +;LITERALS TABLES - CAN MOVE AND GROW. THESE TAGS & LENGTHS ARE JUST THE DEFAULTS +.SEE CONTBA ;ETC, WHICH CONTAIN THE ACTUAL ADDRESSES. SO DON'T USE THEM! +CONTAB: BLOCK LCONTB ;CONSTANTS TABLE, VALUES OF CONSTANTS THIS CONSTANTS AREA +CONGLO: BLOCK LCNGLO ;CONSTANTS GLOBAL TABLE, EACH ENTRY TWO WORDS + ;FIRST WD GLOTB ENTRY. SECOND WD ADR IN CONTAB OF CONSTANT TO WHICH IT REFERS +CONBIT: BLOCK LCONTB/12.+1 ;RELOCATION BITS AND ILNOPT BIT(SEE CPTMK) + ;3 BITS FOR EACH WORD OF CONTAB. + +;;INIT ;INITIALIZATION ROUTINES (IN MACRO TABLE, GET WIPED OUT) +IFN ITSSW\TNXSW,MINMAC==./2000 ;# OF 1ST PAGE HOLDING PART OF MACTAB. + +;NOTE THAT THIS CODE IS COPIED UPWARD WHEN MACTAB IS MOVED +;DUE TO SYMTAB EXPANSION. THEREFOR IT MUST REFER TO ITSELF +;INDEXED BY THE OFFSET OF WHERE IT IS FROM WHERE IT WAS ASSEMBLED. +;THAT IS KEPT IN CH1. ALL LITERALS MUST BE USED INDEX OF CH1, TOO. + +;MAC PROC TABLES +MACTBA: 773767750000 ;MACRO CHARACTER STORAGE (FIRST WORD 3 375'S) +INIT1: MOVE CH1,MACTAD ;GET ADDR THIS CODE REALLY STARTS AT. + SUBI CH1,MACTBA ;GET OFFSET FROM WHERE ASSEMBLED. + SETZM BBKCOD + MOVE A,[BBKCOD,,BBKCOD+1](CH1) + BLT A,EBKCOD-1 ;CLEAR OUT BLANK CODING + PUSH P,[SP4](CH1) ;NOW INIT THE SYMTAB & FINISHED. + +;INITIALIZE THE SYMTAB, EXPECT SIZE IN SYMLEN. +INITS: MOVE AA,SYMLEN ;SET UP THE OTHER VARS + IMUL AA,WPSTE ;DEALING WITH SYMTAB SIZE. + MOVEM AA,SYMSIZ + ADDI AA,ST ;ADDR OF START OF CONTAB. + MOVEM AA,CONTBA + MOVEM AA,PLIM + ADD AA,CONLEN ;ADD LENGTH OF CONTAB TO GET ADDR OF CONGLO TAB. + MOVEM AA,CONTBE ;WHICH IS ALSO THE END OF CONTAB. + MOVEM AA,CONGLA + MOVEM AA,CONGOL + MOVE A,CONLEN ;ADD IN LENGTH OF CONGLO (1/4 OF CONLEN) + LSH A,-2 + ADD AA,A + MOVEM AA,CONGLE ;TO GET END OF CONGLO, AND START OF CONBIT TABLE. + MOVEM AA,CONBIA + MOVE A,CONLEN + ADDI A,11. + IDIVI A,12. + ADD AA,A ;ADD LENGTH OF CONBIT (1/12 OF CONLEN) GETTING ADDR OF MACTAB. +IFN DECSW,[ + PUSH P,AA + ADDI AA,MACL-1 + IORI AA,1777 ;FIX ALLOCATION PROBLEMS ON KI-10 + CORE AA, + ETF [ASCIZ /No core for symbols/](CH1) + REST AA +] + MOVN A,SYMLEN + HRLZM A,SYMAOB ;AOBJN -> SYMTAB. + MOVE A,WPSTE + SUBI A,1 + MOVEM A,WPSTE1 + MOVN A,WPSTE + HRRM A,WPSTEB + CAMG AA,MACTAD ;MOVED MACTAB UP? + JRST INITS1(CH1) +IFN ITSSW\TNXSW,[ ;YES, GET CORE FOR INCREASE. + PUSH P,AA + MOVEI AA,MACL+1777(AA) + LSH AA,-10. ;1ST PAGE NOT NEEDED BY MACTAB. + MOVEI A,MACL+1777+MACTBA(CH1) + LSH A,-10. ;1ST PAGE MACTAB DOESN'T YET HAVE. + SUBM A,AA ;# PAGES NEEDED. + HRLZI AA,(AA) + HRRI AA,(A) ;-<# PAGES>,,<1ST NEEDED> + CAIGE AA, ; Don't call if don't need any pages. + CALL CORGET ; Get the pages + REST AA +] + SUBM AA,MACTAD ;MACTAD _ SHIFT IN START OF MACTAB. + EXCH AA,MACTAD ;MACTAD GETS NEW START, AA HAS SHIFT. + MOVSI A,PTAB-CCOMPB + ADDM AA,PTAB(A) ;RELOCATE BYTE-PTRS INTO MACTAB. + AOBJN A,.-1(CH1) + MOVNI B,INITS2(CH1) + HRROI A,@EISYMP(CH1) + ADDI B,1(A) ;GET # WDS IN SECOND HALF OF INIT CODE. + HRRM AA,.+1(CH1) ;COPY 2ND HALF UPWARD WITH POP-LOOP. + POP A,(A) ;THIS INSN IMPURE. + SOJG B,.-1(CH1) + ADDI CH1,(AA) ;CHANGE OFFSET TO PT. TO NEW LOCATIONN OF INIT CODE. + JRST INITS2(CH1) ;JUMP INTO 2ND HALF, WHERE IT'S BEEN COPIED TO. +INITS2: HRROI A,INITS2-1(CH1) ;THEN COPY 1ST HALF (WHICH ENNDS BEFORE INITS2) + SUBI A,(AA) ;GET WHERE NOW ENDS, NOT WHERE WILL END. + MOVEI B,INITS2-MACTBA ;UP UNDERNEATH THE 2ND HALF. + HRRM AA,.+1(CH1) ;(THIS TWO-STEP COPYING HANDLES ALL OVERLAPS) + POP A,(A) + SOJG B,.-1(CH1) +INITS1: MOVE AA,SYMSIZ + SETZM ST + MOVE A,[ST,,ST+1](CH1) + BLT A,ST-1(AA) ;CLEAR OUT SYMBOL TABLE + SETZM ESBK ;DEFINE THEM IN OUTER BLOCK. + MOVEI AA,ISYMTB(CH1) + MOVS F,ISMTBB(CH1) ;GET SWAPPED VALUE OF FIRST INSTRUCTION +SP3: CAIL AA,EISYM1(CH1) + JRST SP1(CH1) ;DONE WITH INSTRUCTIONS + MOVE SYM,(AA) + JUMPE SYM,SP2(CH1) + TLZ SYM,740000 + PUSHJ P,ES ;WON'T SKIP + CAIA + GOHALT ;INSTRUCTION PRESENT TWICE IN TABLE!!?!? + HRLZI T,SYMC + HRLZ B,F + MOVSI C,3KILL + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP2: ADDI F,1000 + AOJA AA,SP3(CH1) +;AFTER HACKING ALL THE INSTRUCTIONS, STORED AS JUST THE NAMES IN NUMERIC ORDER, +;HACK ALL THE OTHER PREDEFINED SYMS, STORED AS 2 WORDS (NAME ? VALUE). +EISYMP: ;MAY BE MUNGED IF MORE SYMBOLS ARE ADDED AFTER EISYMT. +SP1: CAIL AA,EISYMT(CH1) + POPJ P, + MOVE SYM,(AA) + LDB T,[400400,,SYM](CH1) + ROT T,-4 + TLZ SYM,740000 + PUSHJ P,ES + CAIA + JRST SP5(CH1) ;SYM ALREADY DEFINED? (MIGHT BE .UAI, IN ITS AND IN MIDAS). + MOVE B,1(AA) + MOVSI C,3KILL + CAME T,[GLOETY,,](CH1) ;GLOBAL ENTRIES REALLY EXITS, HACKED TO DEFEAT ADDRESS LINKING + CAMN T,[GLOEXT,,](CH1) + TLO C,3LLV + PUSH P,CH1 + PUSHJ P,VSM2 + POP P,CH1 +SP5: AOS AA + AOJA AA,SP1(CH1) + +CONSTANTS ; Constants for init code above + +;;ISYMS ;INITIAL SYMBOL TABLE - NOT HASHED + +IFNDEF JSYS,JSYS=104_33 ;ALLOW FOR BOOTSTRAP, EVENTUALLY FLUSH, MAYBE + +ISMTBB: JSYS ;FIRST OP. CODE IN ISYMTB + +ISYMTB: + +; 104-177 (JSYS - FDVRB) + +SQUOZE 10,JSYS ;BBN PAGER INSTRUCTION +SQUOZE 10,ADJSP ;KL10 INSTRUCTION + 0 + 0 + +SQUOZE 10,DFAD ;KI10 INSTRUCTION +SQUOZE 10,DFSB ;KI10 INSTRUCTION +SQUOZE 10,DFMP ;KI10 INSTRUCTION +SQUOZE 10,DFDV ;KI10 INSTRUCTION +SQUOZE 10,DADD ;KL10 INSTRUCTION +SQUOZE 10,DSUB ;KL10 INSTRUCTION +SQUOZE 10,DMUL ;KL10 INSTRUCTION +SQUOZE 10,DDIV ;KL10 INSTRUCTION +SQUOZE 10,DMOVE ;KI10 INSTRUCTION +SQUOZE 10,DMOVN ;KI10 INSTRUCTION + +SQUOZE 10,FIX ;KI10 INSTRUCTION +SQUOZE 10,EXTEND ;KL10 INSTRUCTION +SQUOZE 10,DMOVEM ;KI10 INSTRUCTION +SQUOZE 10,DMOVNM ;KI10 INSTRUCTION +SQUOZE 10,FIXR ;KI10 INSTRUCTION +SQUOZE 10,FLTR ;KI10 INSTRUCTION + +SQUOZE 10,UFA ;KA/KI10 INSTRUCTION +SQUOZE 10,DFN ;KA/KI10 INSTRUCTION +SQUOZE 10,FSC + +SQUOZE 10,IBP +SQUOZE 10,ILDB +SQUOZE 10,LDB +SQUOZE 10,IDPB +SQUOZE 10,DPB + +SQUOZE 10,FAD +SQUOZE 10,FADL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FADM +SQUOZE 10,FADB +SQUOZE 10,FADR +SQUOZE 10,FADRI ;PDP10 INSTRUCTION +SQUOZE 10,FADRM +SQUOZE 10,FADRB +SQUOZE 10,FSB +SQUOZE 10,FSBL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FSBM +SQUOZE 10,FSBB +SQUOZE 10,FSBR +SQUOZE 10,FSBRI ;PDP10 INSTRUCTION +SQUOZE 10,FSBRM +SQUOZE 10,FSBRB +SQUOZE 10,FMP +SQUOZE 10,FMPL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FMPM +SQUOZE 10,FMPB +SQUOZE 10,FMPR +SQUOZE 10,FMPRI ;PDP10 INSTRUCTION +SQUOZE 10,FMPRM +SQUOZE 10,FMPRB +SQUOZE 10,FDV +SQUOZE 10,FDVL ;PDP6/KA/KI INSTRUCTION +SQUOZE 10,FDVM +SQUOZE 10,FDVB +SQUOZE 10,FDVR +SQUOZE 10,FDVRI ;PDP10 INSTRUCTION +SQUOZE 10,FDVRM +SQUOZE 10,FDVRB + +; 200-277 (MOVE - SUBB) + +SQUOZE 10,MOVE +SQUOZE 10,MOVEI +SQUOZE 10,MOVEM +SQUOZE 10,MOVES +SQUOZE 10,MOVS +SQUOZE 10,MOVSI +SQUOZE 10,MOVSM +SQUOZE 10,MOVSS +SQUOZE 10,MOVN +SQUOZE 10,MOVNI +SQUOZE 10,MOVNM +SQUOZE 10,MOVNS +SQUOZE 10,MOVM +SQUOZE 10,MOVMI +SQUOZE 10,MOVMM +SQUOZE 10,MOVMS + +SQUOZE 10,IMUL +SQUOZE 10,IMULI +SQUOZE 10,IMULM +SQUOZE 10,IMULB +SQUOZE 10,MUL +SQUOZE 10,MULI +SQUOZE 10,MULM +SQUOZE 10,MULB +SQUOZE 10,IDIV +SQUOZE 10,IDIVI +SQUOZE 10,IDIVM +SQUOZE 10,IDIVB +SQUOZE 10,DIV +SQUOZE 10,DIVI +SQUOZE 10,DIVM +SQUOZE 10,DIVB + +SQUOZE 10,ASH +SQUOZE 10,ROT +SQUOZE 10,LSH +SQUOZE 10,JFFO ;PDP10 INSTRUCTION +SQUOZE 10,ASHC +SQUOZE 10,ROTC +SQUOZE 10,LSHC +SQUOZE 10,CIRC ;AI PDP10 INST. CIRCULATE: ROTC WITH AC+1 GOING THE WRONG WAY + +SQUOZE 10,EXCH +SQUOZE 10,BLT +SQUOZE 10,AOBJP +SQUOZE 10,AOBJN +SQUOZE 10,JRST +SQUOZE 10,JFCL +SQUOZE 10,XCT +SQUOZE 10,MAP ;KI10 INSTRUCTION + +SQUOZE 10,PUSHJ +SQUOZE 10,PUSH +SQUOZE 10,POP +SQUOZE 10,POPJ +SQUOZE 10,JSR +SQUOZE 10,JSP +SQUOZE 10,JSA +SQUOZE 10,JRA + +SQUOZE 10,ADD +SQUOZE 10,ADDI +SQUOZE 10,ADDM +SQUOZE 10,ADDB +SQUOZE 10,SUB +SQUOZE 10,SUBI +SQUOZE 10,SUBM +SQUOZE 10,SUBB + +; 300-377 (CAI - SOSG) + +SQUOZE 10,CAI +SQUOZE 10,CAIL +SQUOZE 10,CAIE +SQUOZE 10,CAILE +SQUOZE 10,CAIA +SQUOZE 10,CAIGE +SQUOZE 10,CAIN +SQUOZE 10,CAIG +SQUOZE 10,CAM +SQUOZE 10,CAML +SQUOZE 10,CAME +SQUOZE 10,CAMLE +SQUOZE 10,CAMA +SQUOZE 10,CAMGE +SQUOZE 10,CAMN +SQUOZE 10,CAMG + +SQUOZE 10,JUMP +SQUOZE 10,JUMPL +SQUOZE 10,JUMPE +SQUOZE 10,JUMPLE +SQUOZE 10,JUMPA +SQUOZE 10,JUMPGE +SQUOZE 10,JUMPN +SQUOZE 10,JUMPG +SQUOZE 10,SKIP +SQUOZE 10,SKIPL +SQUOZE 10,SKIPE +SQUOZE 10,SKIPLE +SQUOZE 10,SKIPA +SQUOZE 10,SKIPGE +SQUOZE 10,SKIPN +SQUOZE 10,SKIPG + +SQUOZE 10,AOJ +SQUOZE 10,AOJL +SQUOZE 10,AOJE +SQUOZE 10,AOJLE +SQUOZE 10,AOJA +SQUOZE 10,AOJGE +SQUOZE 10,AOJN +SQUOZE 10,AOJG +SQUOZE 10,AOS +SQUOZE 10,AOSL +SQUOZE 10,AOSE +SQUOZE 10,AOSLE +SQUOZE 10,AOSA +SQUOZE 10,AOSGE +SQUOZE 10,AOSN +SQUOZE 10,AOSG +SQUOZE 10,SOJ +SQUOZE 10,SOJL +SQUOZE 10,SOJE +SQUOZE 10,SOJLE +SQUOZE 10,SOJA +SQUOZE 10,SOJGE +SQUOZE 10,SOJN +SQUOZE 10,SOJG +SQUOZE 10,SOS +SQUOZE 10,SOSL +SQUOZE 10,SOSE +SQUOZE 10,SOSLE +SQUOZE 10,SOSA +SQUOZE 10,SOSGE +SQUOZE 10,SOSN +SQUOZE 10,SOSG + +; 400-477 (SETZ - SETOB) + +SQUOZE 10,SETZ +SQUOZE 10,SETZI +SQUOZE 10,SETZM +SQUOZE 10,SETZB +SQUOZE 10,AND +SQUOZE 10,ANDI +SQUOZE 10,ANDM +SQUOZE 10,ANDB +SQUOZE 10,ANDCA +SQUOZE 10,ANDCAI +SQUOZE 10,ANDCAM +SQUOZE 10,ANDCAB +SQUOZE 10,SETM +SQUOZE 10,SETMI +SQUOZE 10,SETMM +SQUOZE 10,SETMB +SQUOZE 10,ANDCM +SQUOZE 10,ANDCMI +SQUOZE 10,ANDCMM +SQUOZE 10,ANDCMB +SQUOZE 10,SETA +SQUOZE 10,SETAI +SQUOZE 10,SETAM +SQUOZE 10,SETAB +SQUOZE 10,XOR +SQUOZE 10,XORI +SQUOZE 10,XORM +SQUOZE 10,XORB +SQUOZE 10,IOR +SQUOZE 10,IORI +SQUOZE 10,IORM +SQUOZE 10,IORB +SQUOZE 10,ANDCB +SQUOZE 10,ANDCBI +SQUOZE 10,ANDCBM +SQUOZE 10,ANDCBB +SQUOZE 10,EQV +SQUOZE 10,EQVI +SQUOZE 10,EQVM +SQUOZE 10,EQVB +SQUOZE 10,SETCA +SQUOZE 10,SETCAI +SQUOZE 10,SETCAM +SQUOZE 10,SETCAB +SQUOZE 10,ORCA +SQUOZE 10,ORCAI +SQUOZE 10,ORCAM +SQUOZE 10,ORCAB +SQUOZE 10,SETCM +SQUOZE 10,SETCMI +SQUOZE 10,SETCMM +SQUOZE 10,SETCMB +SQUOZE 10,ORCM +SQUOZE 10,ORCMI +SQUOZE 10,ORCMM +SQUOZE 10,ORCMB +SQUOZE 10,ORCB +SQUOZE 10,ORCBI +SQUOZE 10,ORCBM +SQUOZE 10,ORCBB +SQUOZE 10,SETO +SQUOZE 10,SETOI +SQUOZE 10,SETOM +SQUOZE 10,SETOB + +; 500-577 (HLL - HLRES) + +SQUOZE 10,HLL +SQUOZE 10,HLLI +SQUOZE 10,HLLM +SQUOZE 10,HLLS +SQUOZE 10,HRL +SQUOZE 10,HRLI +SQUOZE 10,HRLM +SQUOZE 10,HRLS +SQUOZE 10,HLLZ +SQUOZE 10,HLLZI +SQUOZE 10,HLLZM +SQUOZE 10,HLLZS +SQUOZE 10,HRLZ +SQUOZE 10,HRLZI +SQUOZE 10,HRLZM +SQUOZE 10,HRLZS +SQUOZE 10,HLLO +SQUOZE 10,HLLOI +SQUOZE 10,HLLOM +SQUOZE 10,HLLOS +SQUOZE 10,HRLO +SQUOZE 10,HRLOI +SQUOZE 10,HRLOM +SQUOZE 10,HRLOS +SQUOZE 10,HLLE +SQUOZE 10,HLLEI +SQUOZE 10,HLLEM +SQUOZE 10,HLLES +SQUOZE 10,HRLE +SQUOZE 10,HRLEI +SQUOZE 10,HRLEM +SQUOZE 10,HRLES +SQUOZE 10,HRR +SQUOZE 10,HRRI +SQUOZE 10,HRRM +SQUOZE 10,HRRS +SQUOZE 10,HLR +SQUOZE 10,HLRI +SQUOZE 10,HLRM +SQUOZE 10,HLRS +SQUOZE 10,HRRZ +SQUOZE 10,HRRZI +SQUOZE 10,HRRZM +SQUOZE 10,HRRZS +SQUOZE 10,HLRZ +SQUOZE 10,HLRZI +SQUOZE 10,HLRZM +SQUOZE 10,HLRZS +SQUOZE 10,HRRO +SQUOZE 10,HRROI +SQUOZE 10,HRROM +SQUOZE 10,HRROS +SQUOZE 10,HLRO +SQUOZE 10,HLROI +SQUOZE 10,HLROM +SQUOZE 10,HLROS +SQUOZE 10,HRRE +SQUOZE 10,HRREI +SQUOZE 10,HRREM +SQUOZE 10,HRRES +SQUOZE 10,HLRE +SQUOZE 10,HLREI +SQUOZE 10,HLREM +SQUOZE 10,HLRES + +; 600-677 (TRN - TSON) + +SQUOZE 10,TRN +SQUOZE 10,TLN +SQUOZE 10,TRNE +SQUOZE 10,TLNE +SQUOZE 10,TRNA +SQUOZE 10,TLNA +SQUOZE 10,TRNN +SQUOZE 10,TLNN +SQUOZE 10,TDN +SQUOZE 10,TSN +SQUOZE 10,TDNE +SQUOZE 10,TSNE +SQUOZE 10,TDNA +SQUOZE 10,TSNA +SQUOZE 10,TDNN +SQUOZE 10,TSNN +SQUOZE 10,TRZ +SQUOZE 10,TLZ +SQUOZE 10,TRZE +SQUOZE 10,TLZE +SQUOZE 10,TRZA +SQUOZE 10,TLZA +SQUOZE 10,TRZN +SQUOZE 10,TLZN +SQUOZE 10,TDZ +SQUOZE 10,TSZ +SQUOZE 10,TDZE +SQUOZE 10,TSZE +SQUOZE 10,TDZA +SQUOZE 10,TSZA +SQUOZE 10,TDZN +SQUOZE 10,TSZN +SQUOZE 10,TRC +SQUOZE 10,TLC +SQUOZE 10,TRCE +SQUOZE 10,TLCE +SQUOZE 10,TRCA +SQUOZE 10,TLCA +SQUOZE 10,TRCN +SQUOZE 10,TLCN +SQUOZE 10,TDC +SQUOZE 10,TSC +SQUOZE 10,TDCE +SQUOZE 10,TSCE +SQUOZE 10,TDCA +SQUOZE 10,TSCA +SQUOZE 10,TDCN +SQUOZE 10,TSCN +SQUOZE 10,TRO +SQUOZE 10,TLO +SQUOZE 10,TROE +SQUOZE 10,TLOE +SQUOZE 10,TROA +SQUOZE 10,TLOA +SQUOZE 10,TRON +SQUOZE 10,TLON +SQUOZE 10,TDO +SQUOZE 10,TSO +SQUOZE 10,TDOE +SQUOZE 10,TSOE +SQUOZE 10,TDOA +SQUOZE 10,TSOA +SQUOZE 10,TDON +SQUOZE 10,TSON + +EISYM1: + +; I/O INSTRUCTIONS + +SQUOZE 4,BLKI +BLKI IOINST +SQUOZE 4,DATAI +DATAI IOINST +SQUOZE 4,BLKO +BLKO IOINST +SQUOZE 4,DATAO +DATAO IOINST +SQUOZE 4,CONO +CONO IOINST +SQUOZE 4,CONI +CONI IOINST +SQUOZE 4,CONSZ +CONSZ IOINST +SQUOZE 4,CONSO +CONSO IOINST + +;EXTEND MNEMONICS + +SQUOZE 10,CMPSL +001000,, +SQUOZE 10,CMPSE +002000,, +SQUOZE 10,CMPSLE +003000,, +SQUOZE 10,EDIT +004000,, +SQUOZE 10,CMPSGE +005000,, +SQUOZE 10,CMPSN +006000,, +SQUOZE 10,CMPSG +007000,, +SQUOZE 10,CVTDBO +010000,, +SQUOZE 10,CVTDBT +011000,, +SQUOZE 10,CVTBDO +012000,, +SQUOZE 10,CBTBDT +013000,, +SQUOZE 10,MOVSO +014000,, +SQUOZE 10,MOVST +015000,, +SQUOZE 10,MOVSLJ +016000,, +SQUOZE 10,MOVSRJ +017000,, +SQUOZE 10,XBLT +020000,, + +;OLD PROGRAMS USE THESE NAMES + +SQUOZE 10,CLEAR +SETZ +SQUOZE 10,CLEARI +SETZI +SQUOZE 10,CLEARM +SETZM +SQUOZE 10,CLEARB +SETZB + +;RANDOM ALIAS NAMES + +SQUOZE 10,ERJMP ; TOPS-20 JSYS-error dispatch (becomes JRST) +JUMP 16, +SQUOZE 10,ERCAL ; TOPS-20 JSYS-error call (becomes PUSHJ 17,) +JUMP 17, +SQUOZE 10,ADJBP ;KL10 FORM OF IBP WITH VARIABLE NUMBER TO INCREMENT +IBP +SQUOZE 10,JFOV ;PDP10 INSTRUCTION (PC CHANGE ON PDP6) +JFCL 1, +SQUOZE 10,JCRY1 +JFCL 2, +SQUOZE 10,JCRY0 +JFCL 4, +SQUOZE 10,JCRY +JFCL 6, +SQUOZE 10,JOV +JFCL 10, +SQUOZE 10,PORTAL ;KI10 INSTRUCTION +JRST 1, +SQUOZE 10,JRSTF +JRST 2, +SQUOZE 10,HALT +JRST 4, +SQUOZE 10,XJRSTF ;KL10 INSTRUCTION +JRST 5, +SQUOZE 10,XJEN ;KL10 INSTRUCTION +JRST 6, +SQUOZE 10,XPCW ;KL10 INSTRUCTION +JRST 7, +SQUOZE 10,JEN +JRST 12, +SQUOZE 10,SFM ;KL10 INSTRUCTION +JRST 14, +SQUOZE 10,XMOVEI ;KL10 INSTRUCTION +SETMI +SQUOZE 10,XHLLI ;KL10 INSTRUCTION +HLLI + +;PDP6 HAS LONG FORM ROUNDED INSTEAD OF IMMEDIATES + +IRPS INST,,FAD FSB FMP FDV + SQUOZE 10,INST!RL + INST!RI +TERMIN + +; MIDAS pseudo definitions + +SQUOZE 10,.OSMID ; Crock here - in TNX version, SITINI sets value at +OSMID: OSMIDAS ; runtime before syms spread. +SQUOZE 4,.SITE +A.SITE +SQUOZE 4,RIM10 +ARIM10,,SRIM +SQUOZE 4,SBLK +SBLKS,,SRIM +SQUOZE 4,RIM +ARIM,,SRIM +SQUOZE 4,SQUOZE +ASQOZ +SQUOZE 4,.RSQZ +-1,,ASQOZ +SQUOZE 4,XWD +AXWORD +SQUOZE 4,CONSTA +CNSTNT +SQUOZE 4,ASCIC +EOFCH,,AASCIZ +SQUOZE 4,RADIX +ARDIX + +SQUOZE 4,END +AEND +SQUOZE 4,TITLE +ATITLE +SQUOZE 4,.BEGIN +A.BEGIN +SQUOZE 4,.END +A.END +SQUOZE 4,VARIAB +AVARIAB +SQUOZE 4,SIXBIT +ASIXBIT +SQUOZE 4,ASCII +AASCII +SQUOZE 4,ASCIZ +AASCIZ +SQUOZE 4,.ASCII +A.ASCII +SQUOZE 4,.ASCVL +A.ASCV +SQUOZE 4,BLOCK +ABLOCK +SQUOZE 4,LOC +ALOC +SQUOZE 4,OFFSET +AOFFSET +SQUOZE 4,.SBLK +SIMBLK +SQUOZE 4,RELOCA +ARELOCA +SQUOZE 4,1PASS +A1PASS +SQUOZE 4,.DECSA +A.DECSA +SQUOZE 4,.DECRE +A.DECRE +SQUOZE 4,.DECTX +A.DCTX + +SQUOZE 4,.DECTW +A.DECTW +SQUOZE 4,NOSYMS +ANOSYMS +SQUOZE 4,EXPUNGE +AEXPUNGE +SQUOZE 4,EQUALS +AEQUALS +SQUOZE 4,NULL +ANULL +SQUOZE 4,SUBTTL +ANULL +SQUOZE 4,WORD +AWORD +SQUOZE 4,.SYMTAB +A.SYMTAB +SQUOZE 4,.SEE +A.SEE +SQUOZE 4,.AUXIL +MACCR +SQUOZE 4,.MRUNT +A.MRUNT +SQUOZE 4,.SYMCN +A.SYMC +SQUOZE 4,.TYPE +A.TYPE +SQUOZE 4,.FORMAT +A.FORMAT +SQUOZE 4,.OP +A.OP +SQUOZE 4,.AOP +A.AOP +SQUOZE 4,.RADIX +A.RADIX +SQUOZE 4,.FATAL +A.FATAL +SQUOZE 4,.BP +A.BP +SQUOZE 4,.BM +A.BM +SQUOZE 4,.LZ +A.LZ +SQUOZE 4,.TZ +A.TZ +SQUOZE 4,.DPB +A.DPB +SQUOZE 4,.LDB +A.LDB +SQUOZE 4,.IBP +A.IBP +SQUOZE 4,.1STWD +A.1STWD +SQUOZE 4,.NTHWD +A.NTHWD + +IRPS X,,[.BIND=0,.KILL=3KILL,.HKILL=3SKILL,.XCREF=3NCRF,.DOWN=3DOWN] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,A.KILL +TERMIN + +SQUOZE 4,.LSTON +A.LSTN +SQUOZE 4,.LSTOF +A.LSTF + +IRPS X,,[.MLLIT=CONSML,.PASS=A.PASS,.PPASS=A.PPASS,.SUCCESS=A.SUCCESS +.HKALL=HKALL,.STGSW=STGSW,.LITSW=LITSW,.AVAL1=AVAL1,.AVAL2=AVAL2,.ERRCNT=ERRCNT +.ASKIP=A.ASKIP,.CURLN=CLNN,.CURPG=CPGN,.QMTCH=QMTCH,.STPLN=A.STPLN,.STPPG=A.STPPG] +IFE 1&.IRPCN, SQUOZE 4,X +IFN 1&.IRPCN, X,,INTSYM +TERMIN + +;CONDITIONALS (SEE ALSO IFSE, IFSN) + +SQUOZE 4,IFG +JUMPG A,COND +SQUOZE 4,IFGE +JUMPGE A,COND +SQUOZE 4,IFE +JUMPE A,COND +SQUOZE 4,IFLE +JUMPLE A,COND +SQUOZE 4,IFL +JUMPL A,COND +SQUOZE 4,IFN +JUMPN A,COND +SQUOZE 4,.ELSE +SKIPE A.ELSE +SQUOZE 4,.ALSO +SKIPN A.ELSE + +SQUOZE 4,IF1 +TRNE FF,COND1 +SQUOZE 4,IF2 +TRNN FF,COND1 +SQUOZE 4,IFDEF ;ASSEMBLE IF SYM DEFINED +JUMPG A,DEFCND +SQUOZE 4,IFNDEF ;ASSEMBLE IF SYM NOT DEFINED +JUMPE A,DEFCND +SQUOZE 4,IFB ;ASSEMBLE IF STRING BLANK (HAS NO SQUOZE CHARS) +JUMPLE C,SBCND +SQUOZE 4,IFNB ;ASSEMBLE IF STRING NOT BLANK +JUMPG C,SBCND +SQUOZE 4,IFSQ ;ASSEMBLE IF STRING ARG IS ALL SQUOZE +JUMPLE B,SBCND +SQUOZE 4,IFNSQ ;ASSEMBLE IF STRING ARG IS NOT ALL SQUOZE. +JUMPG B,SBCND + +SQUOZE 4,PRINTX +APRIN2,,APRINT +SQUOZE 4,PRINTC +APRIN3,,APRINT +SQUOZE 4,COMMEN +APRIN1,,APRINT +SQUOZE 4,.TYO +A.TYO +SQUOZE 4,.TYO6 +A.TYO6 +SQUOZE 4,.ERR +A.ERR + +SQUOZE 4,.RELP +A.RELP +SQUOZE 4,.ABSP +A.ABSP +SQUOZE 4,.RL1 +A.RL1 +SQUOZE 4,.LIBRA +LLIB,,A.LIB +SQUOZE 4,.LENGTH +A.LENGTH +SQUOZE 4,.LIFS +LTCP,,A.LIB +SQUOZE 4,.ELDC +A.ELDC +IRPS A,,E N G LE GE L +SQUOZE 4,.LIF!A +JUMP!A A.LDCV +TERMIN +SQUOZE 4,.SLDR +A.SLDR + +SQUOZE 4,. +GTVLP +SQUOZE 4,.LOP +A.LOP +SQUOZE 40,$. +0 +SQUOZE 44,$R. +0 +SQUOZE 40,$O. ;(OH) GLOBAL OFFSET +0 +SQUOZE 40,$L. ;REAL LOCATION (WITHOUT OFFSET) +0 +SQUOZE 40,.LVAL1 +0 +SQUOZE 40,.LVAL2 +0 +SQUOZE 4,.LNKOT +A.LNKOT +SQUOZE 4,.NSTGW +1,,STGWS +SQUOZE 4,.YSTGW +-1,,STGWS +SQUOZE 4,.LIBRQ +A.LIBRQ +SQUOZE 4,.GLOBAL +ILGLI,,A.GLOB +SQUOZE 4,.SCALAR +ILVAR,,A.GLOB +SQUOZE 4,.VECTOR +ILVAR\ILFLO,,A.GLOB + +SQUOZE 4,.BYTC +NBYTS,,INTSYM +SQUOZE 4,.BYTE +A.BYTE +SQUOZE 4,.WALGN +A.WALGN + +;CREF PSEUDO-OPS. +SQUOZE 4,.CRFON +A.CRFN ;START CREFFING. +SQUOZE 4,.CRFOFF +A.CRFFF ;STOP CREFFING. +SQUOZE 4,.CRFIL +CRFILE,,INTSYM + +IFE CREFSW,[ + A.CRFN==ASSEM1 ;THESE DO NOTHING IF CAN'T CREF. + A.CRFFF==ASSEM1 +] + +IFN MACSW,[ ;MACRO PROCESSOR PSEUDOS +;MACROS GET DEFINED AS +;SQUOZE 4, +;,, MACCL + +SQUOZE 4,REPEAT +AREPEAT +SQUOZE 4,DEFINE +ADEFINE +SQUOZE 4,IRP +NIRPO,,AIRP +SQUOZE 4,IRPC +NIRPC,,AIRP +SQUOZE 4,IRPS +NIRPS,,AIRP +SQUOZE 4,IRPW +NIRPW,,AIRP +SQUOZE 4,IRPNC +NIRPN,,AIRP +SQUOZE 4,TERMIN +ATERMIN +SQUOZE 4,.QUOTE +A.QOTE +SQUOZE 4,.STOP +(400000)A.STOP +SQUOZE 4,.ISTOP +A.STOP +SQUOZE 4,.RPCNT +CRPTCT,,INTSYM +SQUOZE 4,.GSSET +A.GSSET +SQUOZE 4,.GSCNT +GENSM,,INTSYM +SQUOZE 4,.GO +A.GO +SQUOZE 4,.TAG +A.TAG +SQUOZE 4,.IRPCNT +CIRPCT,,INTSYM +IFN RCHASW,[SQUOZE 4,.TTYMAC +A.TTYM +] +SQUOZE 4,IFSE +SKIPN SCOND +SQUOZE 4,IFSN +SKIPE SCOND +] + +IFN FASLP,[ +SQUOZE 4,.FASL +A.FASL +SQUOZE 4,.ARRAY ;3 INDEX TO AFDMY1 TBL +AFATOM(3) +SQUOZE 4,.ATOM +AFATOM(AFDMAI) ;2 INDEX TO AFDMY1 TBL +AFDMAI==2 ;INDEX OF ATOM IN AFDMY1 TBL +SQUOZE 4,.FUNCT +AFATOM(1) ;1 " " " " +SQUOZE 4,.SPECI +AFATOM(0) ;0 " " " " +SQUOZE 4,.SX +AFLIST(1) ;NORMAL LIST +SQUOZE 4,.SXEVA +AFLIST ;EVAL LIST AND THROW VALUE AWAY +SQUOZE 4,.SXE +AFLIST(2) ;EVAL LIST AND "RETURN" VALUE +SQUOZE 4,.ENTRY +AFENTY ;DECLARE LISP ENTRY POINT (SUBR ETC) +] + +IFN TS,[ +SQUOZE 4,.FNAM1 +RFNAM1,,INTSYM +SQUOZE 4,.FNAM2 +RFNAM2,,INTSYM +SQUOZE 4,.FVERS +RFVERS,,INTSYM +SQUOZE 4,.INSRT +A.INSRT +SQUOZE 4,.INEOF +A.INEO +IRPS X,,I O + IRPS Y,,1 2 + SQUOZE 4,.!X!FNM!Y + X!FNM!Y,,INTSYM +TERMIN TERMIN +SQUOZE 4,.IFVRS +IFVRS,,INTSYM +SQUOZE 4,.TTYFLG +A.TTYFLG,,INTSYM +] ;IFN TS + +IFN .I.FSW,[ +SQUOZE 4,.F +A.F +SQUOZE 4,.I +A.I +] + +; Finally insert system-dependent initial symbols and wrap everything up. + +IFN ITSSW,[ +IRPS X,,UAI UAO BAI BAO UII UIO BII BIO +SQUOZE 10,.!X +.IRPCN +TERMIN + +IRPS X,Y,START LFILE STP+SYM JCL PFILE STB CONV+XUNAME XJNAME LJB+ + SQUOZE 10,..R!X + .IRPCN+1 +IFSN Y,+,[ + SQUOZE 10,..S!X + 400000+.IRPCN+1 +] TERMIN + +] ;IFN ITSSW + + +; Now re-insert system-dependent symbol definition files so that they +; become part of the initial symtab that MIDAS knows about. This does +; not need to be done for ITS since those symbols are acquired from the +; system at run time (and thus are always current). + +ISYSYM: ; Remember start of system symbols + +; Redefine DEFSYM so as to make entry into initial symbol table. +; Note that this will lose if the code for MIDAS has re-defined any +; of the symbols inserted from these files at the beginning of MIDAS. +; Everything in these files should use =: or ==: to catch redefinitions! + +DEFINE DEFSYM X/ + IRPS Z,,[X] + SQUOZE 8.,Z + Z + .ISTOP + TERMIN +TERMIN + +IFN DECSW,[ ; Define UUOs for DEC version +IFE CVTSW,[ + .DECDF DEFSYM + IFN DECBSW,.INSRT DECBTS +];IFE CVTSW +IFN CVTSW, .INSRT DECDFU +] ;IFN DECSW + +IFN TNXSW,[ ; Define JSYSes for TENEX/TOPS-20 version +IFE CVTSW,[ + .TNXJS DEFSYM + .INSRT TWXBTS +];IFE CVTSW +IFN CVTSW, .INSRT TNXDFU +] ;IFN TNXSW + +; Simple check to help verify that all system symbol entries were 2 wds long. +IFN <.-ISYSYM>&1,.ERR System symbol def error + +EISYMT: PRINTA \.-MACTBA-1, words initialization coding. + VARIAB +IFN .-EISYMT,.ERR Non-empty variables area + +IFN DECSW,[ + IFGE .-MACTBA-MACL,[ +IFN MACL, PRINTA [MACL too small, set to ]\.-MACTBA + MACL==.-MACTBA +]] + +IFN ITSSW\TNXSW,[ +IFGE .+2400-MACTBA-MACL,.ERR MACL too small + LOC <.+1777>&-2000 +MXICLR==./2000 ;FIRST PAGE ABOVE INITIALIZING CODING + LOC &-2000 +MXIMAC==./2000 ;FIRST PAGE ABOVE INITIAL MACTBA +MAXMAC==/2000 + ;1ST PAGE MACRO TABLE CAN'T POSSIBLY USE. +IFLE MINPUR-MAXMAC,.ERR Pure too low. +PRINTA Wasted gap pages (MINPUR-MAXMAC) = ,\MINPUR-MAXMAC + +PBLK ; Must end assembly at end of pure, so that when doing .DECSAV type + ; assembly the msymtab for MIDAS itself will be in high core. +] + +IFN TS,END BEG +END diff --git a/src/midas/tsrtns.171 b/src/midas/tsrtns.171 new file mode 100644 index 00000000..b56f0f68 --- /dev/null +++ b/src/midas/tsrtns.171 @@ -0,0 +1,4149 @@ +;-*-MIDAS-*- + +SUBTTL TS Definitions, parameters + + ; For convenience in defining isolated variables/tables, + ; especially when have to know on pass1 where the + ; table is going to be (.VECTOR etc don't know until end of pass) +DEFINE LVAR -LINE +VBLK +LINE +PBLK +TERMIN + +DEFINE TMPLOC AT,STUFF +%%%TLC==. ? LOC AT + STUFF +LOC %%%TLC +TERMIN + + ; Nice macro for minimizing coding. Doesn't hack indirection tho. + ; Could conceivably optimize to do MOVE AC,[FROM,,TO] but that + ; would be overly hairy for something you can do just by writing + ; 2 instructions. +DEFINE BLTMAC AC,LEN,FROM,TO + MOVSI AC,FROM + HRRI AC,TO + BLT AC,TO+LEN-1 +TERMIN + + ; Also handy for standard zaps (and nice mnemonic) + ; won't work for indirection either. +DEFINE BLTZAC AC,LEN,FROM + SETZM FROM + MOVEI AC,FROM+1 + HRLI AC,-1(AC) + BLT AC,FROM+LEN-1 +TERMIN + + ; More convenient when A is clobberable... +DEFINE BLTM LEN,FROM,TO +BLTMAC A,LEN,FROM,TO +TERMIN + +DEFINE BLTZ LEN,FROM +BLTZAC A,LEN,FROM +TERMIN + + ; Following inserts a SYSCAL for JSYS's. Be warned that it + ; clobbers T when used!! +IFN TNXSW,.INSRT XJSYS + +IFNDEF PMAPSW,PMAPSW==TNXSW ; 1 to assemble PMAP input, 0 for SIN input. +IFNDEF ERRSW,ERRSW==1 ; 1 for error file output capability. + +IFNDEF TYPDLC,TYPDLC==7 ; Maximum total depth of .insrt (including tty) +IFNDEF MX.INS,MX.INS==5 ; Maximum depth .insrt files only +IFNDEF MAXIND,MAXIND==6 ; Maximum # @: table entries for .insrt + + ; Define sizes of various I/O buffers +IFN DECSW,[ +IFNDEF DECBFL,DECBFL==203 ; Standard DEC buffer size for DSK (200 wds data) +IFN SAILSW,IFNDEF NINBFS,NINBFS==19. ; For SAIL, hack full disk track of input. +IFNDEF NINBFS,NINBFS==2 ; # standard-size buffers to use for input. +IFNDEF UTIBFL,UTIBFL==*NINBFS ; Input buffs need 1 wd for EOB hacking +IFNDEF UTOBFL,UTOBFL==DECBFL ; All output chans have just 1 buffer. +IFNDEF CRFBSZ,CRFBSZ==DECBFL +IFNDEF LSTBSZ,LSTBSZ==DECBFL +IFNDEF ERRBSZ,ERRBSZ==DECBFL +] ;DECSW +IFNDEF CMBFL,CMBFL==50 ; Length of command buffer. +IFNDEF UTIBFL,UTIBFL==400 ; " Input buffer. +IFNDEF UTOBFL,UTOBFL==200 ; " BIN output buffer. +IFNDEF CRFBSZ,CRFBSZ==200 ; " CREF output buffer. +IFNDEF LSTBSZ,LSTBSZ==200 ; " LIST output buffer. +IFNDEF ERRBSZ,ERRBSZ==1 ; " ERR output buffer. Very small to avoid + ; losing much data if things crash. + + +ERRC==0 ; Err device input channel +TYIC==1 ; TTY input channel +TYOC==2 ; TTY output channel +CREFC==3 ; CREF output +UTYOC==4 ; BIN output +LPTC==5 ; LIST output (LPT) +ERRFC==6 ; ERR Assembly error output file. +UTYIC==7 ; 1st input channel, UTYIC+n used for nth .INSRT level in dec version. + +SUBTTL File Description Storage (FILBLK's) + +VBLK + ; Definitions for indices into a FILBLK. + + ; Scratch block FB is formed while defining indices... +FB: OFFSET -. + ; Lots of crocks depend on the exact order of these 4 items. +$F6DEV:: 0 ; SIXBIT Device name +$F6FNM:: $F6FN1:: 0 ; SIXBIT Filename (on ITS, FN1) +$F6TYP:: $F6FN2:: $F6EXT:: 0 ; SIXBIT Extension (on ITS, FN2) +$F6DIR:: 0 ; SIXBIT Directory (may be numerical PPN) + L$F6BLK==. +IFN TNXSW,[ ; Almost all entries here are BP's to ASCIZ strings. +$FDEV:: 0 ; Device name +$FDIR:: 0 ; Directory name +$FNAME:: 0 ; File name (i.e. main name) +$FTYPE:: $FEXT:: 0 ; File type (or extension) +$FVERS:: $FGEN:: 0 ; File version (or generation). NUMBER, not string. +$FTEMP:: 0 ; -1 => File is a temporary file. +$FACCT:: 0 ; Account string +$FPROT:: 0 ; Protection string +$FJFN:: 0 ; JFN for file (may be ,,) +] +IFN ITSSW\DECSW,[ +$FDEV==:$F6DEV ; These definitions made so some common code can do +$FDIR==:$F6DIR ; the right things. +$FNAME==:$F6FNM +$FTYPE==:$F6TYP +$FEXT==:$F6TYP +] + L$FBLK==. ; Length of a FILBLK. + OFFSET 0 ; End of index definitions. + + + ; FILBLK's for various files + +ISFB: BLOCK L$FBLK ; Input file specification as given in command line. +INFB: BLOCK L$FBLK ; Actual current input file. +OUTFB: BLOCK L$FBLK ; Output file + +IFN CREFSW, CRFFB: BLOCK L$FBLK ; CREF output file +IFN LISTSW, LSTFB: BLOCK L$FBLK ; Listing output file +IFN ERRSW, ERRFB: BLOCK L$FBLK ; Error output file + +INFCNT: 0 ; AOS'd each time an input file is opened. +INFCUR: 0 ; What INFCNT was when current file opened. +INFERR: 0 ; What INFCUR held at last err msg. + +INDDP: MAXIND,,TBLOFS ; Pointer into tables below +TBLOFS: BLOCK MAXIND*L$FBLK ; Actual filenames corresponding to those in TBLSFS, for opening. +TBLSFS: BLOCK MAXIND*L$FBLK ; Source-specified filenames for @: files + + +RFNAM1: 0 ; .FNAM1 +RFNAM2: 0 +IFNM1: 0 ; .IFNM1 +IFNM2: 0 +INFFN1==:INFB+$F6FN1 ; Some crocks seem to reference this. +OFNM1==:OUTFB+$F6FN1 ; Pseudo .OFNM1 needs this. +OFNM2==:OUTFB+$F6FN2 ; ditto, .OFNM2 +RSYSNM: 0 ; Initial system name +PBLK + +SUBTTL I/O Buffers + +VBLK ; Input buffer and variables + +UTIBUF: BLOCK UTIBFL +UTIHDR: 0 ; Input buffer header (dec version) +UREDP: 440700,,UTIBUF ; Input byte pointer +UTICNT: 0 ; Input byte count (dec version) +IUREDP: 440700,,UTIBUF ; Initial UREDP, used for re-initializing. +UTIBED: UTIBUF ; EOF comparison with RH(UREDP), 4.9 => EOF on .IOT + +IFN DECSW,UTICHN: UTYIC + + ; BIN Output buffer + +UTOBUF: BLOCK UTOBFL ; Output buffer +UTOHDR: UTOBFL,,UTOBUF-1 +UTYOP: 444400,, ; Output (36. bit) byte pointer +UTYOCT: 0 ; # words left in utobuf +IFN ITSSW,OCLOSP: @1(C) ; Turned into bp to unused part of last bffer wd used. + + ; CREF output buffer +IFN CREFSW,[ +CRFBUF: BLOCK CRFBSZ +CRFHDR: CRFBSZ,,CRFBUF-1 ; Header, assembled value used only ifn itssw +CRFPTR: 444400,, ; Bp for filling buffer (full words) +CRFCNT: 0 ; Num. wds. empty in buffer +] + + ; LISTing output buffer +IFN LISTSW,[ +LSTBUF: BLOCK LSTBSZ +LSTHDR: 5*LSTBSZ,,LSTBUF-1 +LSTPTR: 440700,, +LSTCNT: 0 +] + + ; ERRor output buffer +IFN ERRSW,[ +ERRBUF: BLOCK ERRBSZ +ERRHDR: 5*ERRBSZ,,ERRBUF-1 +ERRPTR: 440700,, +ERRFCT: 0 ; Can't call this ERRCNT since that's used for # errors. +ERRFP: 0 ; Non-0 if want error output file. +ERRFOP: 0 ; Non-0 if error file open (ie try outputting to it) +] +PBLK + +SUBTTL Interrupt Handling + +; Note that only PDL OV is now enabled in general. +; TTY input interrupts are also handled when possible for +; ^H, ^W, and ^V. + +.SCALAR INTSVP ; Saves P on interrupt for debugging + +IFN ITSSW,[ + TMPLOC 42, JSR TSINT ; Interrupt vector for ITS +VBLK +.JBCNI: +TSINT: 0 ; 1st wd interrupts currently considered fatal errors. +.JBTPC: 0 ; Error processor re-enables interrupts + .SUSET [.RJPC,,INTJPC] + SKIPGE TSINT + JRST TTYINT ; Second-word ints. + JRST TSINT1 ; Jump into pure coding and process interrupt +INTJPC: 0 ; Saves .JPC at interrupt. +PBLK + ; Jrst here from TSINT for 2nd wd interrupts. +TTYINT: PUSH P,A + MOVEI A,TYIC ; The tty chnl is the only one enabled. + .ITYIC A, + JRST TTYINX ; No int. char. + CAIN A,^W + AOS TTYFLG ; ^W silences, + CAIN A,^V + SOS TTYFLG ; ^V unsilences, + CAIN A,^H + SETOM TTYBRF ; ^H says break next time thru ASSEM1 loop. +TTYINX: REST A + .DISMIS .JBTPC +] ; IFN ITSSW + +IFN DECSW, TMPLOC .JBAPR, TSINT1 ; Interrupt vector for DEC + +IFN ITSSW\DECSW,[ + ; Amazing but can use almost same basic rtn for both! + +TSINT1: MOVEM P,INTSVP ; Save P for possible debugging +IFN ITSSW,.SUSET [.SPICL,,[-1]] ; For ITS, re-enable ints. + MOVE A,.JBCNI ; Get interrupt request word + TRNE A,200000 ; PDL overflow? + JRST CONFLP + MOVE B,[TYPE "Unknown interrupt - Fatal"] ; anything else. + MOVEM B,40 + MOVE A,.JBTPC ; So error routine will print out properly + JSA A,ERROR +] + +IFN TNXSW,[ + ; TENEX Interrupt handler +; Note that NXP (non-ex page) is enabled, but no provision is +; currently made for handling it. This causes process termination and +; EXEC will print error message. If NXP wasn't enabled, a page would +; simply be created without fuss (page is always created, incidentally, +; whether or not interrupt happens) + +LVAR MEMDBG: 0 ; For nonce, this gets set when PURIFG does. + +LEVTAB: INTPC1 ; Where to store PC for level 1 interrupt. + 0 ? 0 ; Levels 2 and 3 unused. +CHNTAB: BLOCK 36. ; Where to go for indicated condition. Most zero. + +.IC.CV==1 ; Define user channel 1 for ^V interrupt +.IC.CW==2 ; " 2 for ^W +.IC.CH==3 ; " 3 for ^H +%%LSV==. +LOC CHNTAB+.ICPOV ? 1,,TSINT1 ; Put right word in CHNTAB for PDL OV dispatch. +LOC CHNTAB+.IC.CV ? 1,,INT.CV ; Ditto for ^V dispatch +LOC CHNTAB+.IC.CW ? 1,,INT.CW ; " ^W +LOC CHNTAB+.IC.CH ? 1,,INT.CH ; " ^H +LOC %%LSV + +.SCALAR INTPC1 ; Level 1 interrupt PC stored here. + + ; Handle PDL OV interrupt +TSINT1: MOVEM P,INTSVP ; Save PDL ptr. + MOVEI A,CONFLP ; OK to clobber A in PDLOV. + MOVEM A,INTPC1 ; Dismiss to CONFLP. + DEBRK ; Off we go. + + ; Handle ^V interrupt +INT.CV: SOS TTYFLG ; Unsilence typeout + DEBRK + + ; Handle ^W +INT.CW: AOS TTYFLG ; Silence typeout + DEBRK + + ; Handle ^H +INT.CH: SETOM TTYBRF ; Set flag to check at main level ASSEM1 loop. + DEBRK +] + +SUBTTL MIDAS BEGINS HERE - Program Startup + +VBLK +NVRRUN: -1 ; 0 => MIDAS was run; error to start or purify. +FATAL: 0 ; At end of assembly, not 0 iff fatal error occurred. +PBLK + +BEG: ; Start address! +IFN DECSW\TNXSW,[ + TDZA A,A + SETO A, + MOVEM A,CCLFLG ; Remember type of start-up +] + SETZ FF, ; Initialize flags + MOVE P,[-LPDL,,PDL-1] ; Initialize P + +IFN DECSW,[ + RESET + MOVEI A,600000 + APRENB A, +] + ; For TENEX, must determine right away which system we're on. +IFN TNXSW,[ + RESET +; TLZ FF,FL20X ; Assume 10X until proven otherwise. (done by SETZ above) + +IFN 0,[ ; One way of determining OS which doesn't work on some places. + MOVE A,[112,,11] ; Magic word that will win on 10X,T20 (and maybe T10) +GETTAB=<047000,,41> ; CALLI 41 + GETTAB A, ; Returns 10000 T10, 20000 ITS, 30000 10X, 40000 T20 + MOVEI A,30000 ; Shouldn't ever fail, but if it does, assume 10X. + LDB A,[140300,,A] ; Flush other fields too + CAIN A,4 ; = Tops-20? + TLO FF,FL20X ; Yes, set flag. +]; IFN 0 +IFN 0,[ ; This is a loser too, since there ARE KL Tenices! + SETZ A, ; In lieu of above, use hardware hack... + BLT A, ; test for KL-ness. + CAIE A, + TLO FF,FL20X ; KL will fail to skip, assume that means 20X OS. +];IFN 0 +IFN 1,[ ; Boy I hope DEC never defines LOADTB! -- MRC + SYSCAL SYSGT,[['LOADTB]][A ? D] + SKIPN D ; If LOADTB is not defined + TLO FF,FL20X ; it must be a Twenex +]; IFN 1 + + SYSCAL SCVEC,[[.FHSLF] ? [-1]] ; and flush compat package, + ; disabling UUO's 40-77; this is good for debugging. + + ; Set up stuff for interrupts + SYSCAL SIR,[[.FHSLF] + [LEVTAB,,CHNTAB]] ; Specify tables + SYSCAL EIR,[[.FHSLF]] ; Enable interrupts + SYSCAL AIC,[[.FHSLF] ; Activate PDL OV and ^V, ^W, ^H +[IRP BIT,,[.ICPOV,.IC.CV,.IC.CW,.IC.CH] +<1_<35.-BIT>>+!TERMIN ]] + SYSCAL ATI,[[.TICCV,,.IC.CV]] ; Make various mappings from + SYSCAL ATI,[[.TICCW,,.IC.CW]] ; terminal bits to int. channels. + SYSCAL ATI,[[.TICCH,,.IC.CH]] ; What a losing interrupt sys 10X has! + SKIPN MEMDBG ; Hacking memory? + JRST BEG20 + MOVSI A,-2*MINMAC ; If so, must create pages for initially-zero + MOVE B,(A) ; core, by referencing them all. + ADDI A,777 + AOBJN A,.-2 + SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Then enable ints +BEG20: ; for Non-eXistent Pages. +] + +IFN ITSSW,[ + MOVE A,[-5,,[ ; Set and read various vars in a chunk. + .SMASK,,[%PIPDL] ; 1st-wd Interrupt only on PDL ovfl. + .SMSK2,,[1_TYIC] ; 2nd-wd on TTY input channel. + .SPICL,,[-1] ; and enable interrupt system. + .RSNAM,,RSYSNM ; Get system name (default dir to use) + .RXJNAM,,B ]] ; and XJNAME for temp. hacking below. + .SUSET A + SYSCAL TTYSET,[1000,,TYIC ; Set TTYST wds - PI echo, no act/int + [232020,,202020] ; except ctls activate & interrupt + [232020,,220220]] ; CR, DEL activate but don't int; + ; DEL doesn't echo. +] + + AOSE NVRRUN ; Test for this job's already being run... + JRST [ TYPE "Can't restart MIDAS" + JRST TSRETN] + + MOVEI D,SYMDSZ ; Get default symtab size +IFN ITSSW,[ ; Remember that B set to XJNAME above. + CAME B,['MMIDAS] ; Set symtab size larger for MMIDAS + CAMN B,[SIXBIT/MM/] ; (random sort of hack now that .SYMTAB exists) + MOVEI D,SYMMSZ +] + SKIPGE ISYMF ; The first time through, + MOVEM D,SYMLEN ; Make that the size to use. + CALL SITINI ; Initialize stuff for .SITE. + CALL JCLINI ; Now try to fetch JCL; set CMPTR accordingly. +IFN ITSSW,[ + SKIPGE ISYMF ; Skip if syms spread; if not, + CALL TSYMGT ; get TS syms from system. +] + SKIPE CMPTR ; If have JCL, + JRST GO2AA ; skip announcing midas's name and version. + +IFG PURESW-DECSW,[ ; If meaningful, + SKIPGE PURIFG ; Check for purity + TYPE "NOTPUR " ; and type little warning if unpurified. + ] + TYPE "MIDAS." ; and announce self. + MOVE B,[MIDVRS] + PUSHJ P,SIXTYO + JRST GO2AA + +SUBTTL MIDAS Top-level control path + +GO2A: SETZM CMPTR ; Recycles here, so JCL only hacked once. +GO2AA: SETOM FATAL ; Assume fatal errors, unless cleared at GO8 when done. + SETZM TTYFLG ; Allow TTY typeout. + SETZM ERRCNT ; Initialize error counter (total errors) +IFN RUNTSW,[ PUSHJ P,RNTTMA ; Get initial run time. + MOVEM A,IRUNTM] + SETZM LSTTTY ; Tell TYOERR not to try output to LST file (none yet!) + PUSHJ P,CMD ; Get typed in command (or scan cmd line if CMPTR ne 0) + + SKIPGE SMSRTF ; What's this for, I wonder? + JRST GO21 + TYPECR "SYMTAB clobbered" + JRST GO2A + + ; Filenames and switches all specified, now see if files can be set up. +GO21: PUSHJ P,OPNRD ; Open input file + JRST GO2A ; Error, msg was typed, go try again with new cmd line. + PUSHJ P,WINIT ; Open output file, cref file. +IFN DECSW\TNXSW,[ + SKIPGE CCLFLG + TYPE "MIDAS: " +] +IFN A1PSW,[ + SETOM PRGC + SETOM OUTC +GO3: ] + MOVE A,WSWCNT + MOVEM A,TTYFLG ; Turn off typeout if there were (W) switches. + SETOM LSTTTY ; Allow TYOERR to output to both TTY and LST. + JSP A,$INIT ; Initialize for assembly + JSP A,PS1 ; Do pass 1 + TRNN FF,FRNPSS ; If 2 pass assembly, + JRST GO4 + PUSHJ P,OPNRD ; Then re-open input file + JRST GO2A ; Couldn't re-open???? Do something better here. +GO4: JSP A,PLOD ; Maybe punch out SBLK loader in some format + JSP A,PS2 ; Do pass 2 + JSP A,PSYMS ; Maybe punch out symbol table +IFN A1PSW,[ + TLZ FF,$FLOUT + AOS PRGC ; Indicate end statement encountered + SETOM OUTC ; " " " + TRNN FF,FRNPSS ; If 1 pass assembly, + SKIPGE CONTRL + CAIA + JRST GO3 ; Then try to assemble another program +] +IFN FASLP,[ + SKIPGE A,CONTRL + TRNN A,FASL + JRST GO8 + MOVE A,[SIXBIT /*FASL*/] ; "finish" FASL file + MOVEI B,17 + PUSHJ P,FASO ; Ignore end frob, but output FASL end code + MOVE A,[ASCIC//] ; pad with ^C's. + PUSHJ P,FASO1 ; Randomness + PUSHJ P,FASBE ; Write out last block +] + ; Jump directly here for certain main-input EOF conditions. +GO8: SETZM FATAL ; There was no fatal error: output files get renamed. + + ; Jump directly here if hit fatal error (incl .FATAL, illegal UUO, etc) +GO9: PUSHJ P,.FILE ; Close (and rename if FATAL = 0) output files. + SETZM LSTTTY +IFN RUNTSW, PUSHJ P,RNTTYO ; Type out run time used since GO2A + CALL ERRCLS ; File away error file - only thing not closed by .FILE + JRST TSRETN ; and die according to system's wishes. + +SUBTTL MIDAS Death (TSRETN) - system dependent exit routines + +IFN ITSSW,[ +TSRETN: +IFN PURESW,[ + SKIPGE PURIFG ; If not yet purified, assume being debugged. + .VALUE +] + .LOGOUT ; Come here to commit suicide. + .BREAK 16,160000 +] ;IFN ITSSW + +IFN DECSW,[ + +TSRETN: SKIPLE A,ERRCNT ; If had any errors, + ADDM A,.JBERR ; let loader know about them. (???) Well, + .SEE ERR1 ; for strange comment. + SKIPN CCLMOR ; Any more CCL commands? + EXIT ; Nope, all done. + JRST RERUN ; More CCL to hack, start up a new MIDAS. +] ; IFN DECSW + + +IFN TNXSW,[ +TSRETN: SKIPE CCLMOR ; Need to hack any more CCL? + JRST RERUN ; Yeah. +TSRET1: HALTF + HRROI 1,[ASCIZ/Can't continue/] + PSOUT ; Better than dying randomly + JRST TSRET1 +] ; IFN TNXSW + +SUBTTL .SITE pseudo & initialization (SITINI) + +IFN ITSSW, LVSITE==1 ; ITS only uses 1 word of mach name. +IFN DECSW\TNXSW,LVSITE==5 ; whereas others need 5 words (25 chars max) + +LVAR V.SITE: BLOCK LVSITE ; .SITE string stored here. + + ; .SITE N, returns nth word of sixbit machine name. + +A.SITE: CALL AGETFD ; Get field as argument. + JUMPL A,CABPOP ; Ignore negative indices. + CAIL A,LVSITE ; Make sure index is within bounds of string. + JRST CABPOP + MOVE A,V.SITE(A) ; Win, get indexed word. + JRST CLBPOP + + +; SITINI - Initialization routine called only at MIDAS startup, for +; setting up .SITE and maybe other things. + +SITINI: +IFN ITSSW,[ ; For ITS, use up just 1 word and need 1 call to set V.SITE + SYSCAL SSTATU,[REPEAT 5,[ ? MOVEM A] ? MOVEM V.SITE] + .LOSE 1000 + POPJ P, ] + +IFN SAILSW,[ ; SAIL needs special kludge, since it doesn't have the + MOVE A,[SIXBIT /SAIL/] ; right GETTAB used. + MOVEM A,V.SITE + POPJ P, ] + + ; For TENEX and DEC in general, very similar. +IFN DECSW\TNXSW,[ + BLTZ LVSITE,V.SITE ; Clear out string location +IFN TNXSW,[ ; Best to get table index dynamically, + SYSCAL SYSGT,[['SYSVER]][A ? D] + JUMPE D,GINIT5 + ] +IFN DECSW,MOVEI D,11 ; 11 = .GTCNF But on T10 we can assume this. + + MOVE AA,[440600,,V.SITE] + MOVSI C,-5 ; Process 5 words of .GTCNF (max possible) +GINIT1: HRLZ A,C ; Get subindex we want, + HRR A,D ; and produce ,, +IFN DECSW, GETTAB B, ; Get 1 word of table, using appropriate call. +IFN TNXSW, SYSCAL GETAB,[B][B] + JRST GINIT5 ; If call fails, exit loop. +GINIT2: LSHC A,7 ; Extract the ascii chars and store them. + TRCE A,140 ; Swap bit 40 with bit 100, thus turning + TRCE A,140 ; "A to 'A, "a to 'A, "1 to '1, etc, and ^@ to ' . + TRCE A,140 + IDPB A,AA ; Store the sixbit into V.SITE + JUMPN B,GINIT2 ; When nothing left of this word of .GTCNF, get next. + AOBJN C,GINIT1 +GINIT5: POPJ P, +] ;DECSW\TNXSW + +SUBTTL RunTime - .MRUNT and end-of-assembly typeout +IFN RUNTSW,[ + +.SCALAR IRUNTM ; Holds initial run time (set at start of assembly) + + ; .MRUNT - Returns runtime since start of assembly. + +A.MRUN: PUSHJ P,RNTTMA ; Get current run time + SUB A,IRUNTM ; Subtract initial run time +IFN ITSSW,[MULI A,4069. ; ITS - Convert to nanoseconds, + DIV A,[1.^6] ; then to milliseconds. +] + PJRST CLBPOP + + ; RNTTMA - internal routine to return in A the current runtime, + ; in whatever units the OS furnishes. +RNTTMA: +IFN ITSSW, .SUSET [.RRUNT,,A] ; Gets runtime in 4.096 usec units. +IFN DECSW, SETZ A, ? RUNTIM A, ; Runtime in msec +IFN TNXSW,[ + IFN A-1, EXCH R1,A + MOVEI R1,.FHSLF + RUNTM ; Runtime in msec for self. + IFN A-1, EXCH R1,A + ] + POPJ P, + +; RNTTYO - Called at end of assembly to type out runtime, +; # of errors, and # symbols used. + +RNTTYO: +IFN DECSW,[ ; Nobody wants this on ITS, but other people do...sigh... + SKIPE A,ERRCNT ; Any assembly errors? + JRST [ TYPE "? " ; Yes, error message for batch controllers + CALL DPNT + TYPECR " error(s) detected" + JRST .+1] + SKIPE CCLFLG ; Called via CCL? + RET +] + TYPE "Run time = " + CALL A.MRUN ; Get runtime in millisec. in A. + IDIVI A,10. + IDIVI A,100. ; Get secs and hundredths. + HRLM B,(P) ; Save remainder + PUSHJ P,HMSTYO ; Type out secs + MOVEI A,". + CALL TYO + HLRZ A,(P) + CALL HMSTY3 ; Type out hundredths + CALL CRR + CALL A.SYMC + CALL DPNT + TYPE " Symbols including initial ones (" + CALL A.SYMC + IMULI A,100. + IDIV A,SYMLEN ; Get % symtab used + CALL DPNT + TYPECR "% used)" + RET + +; HMSTYO - Type out H:MM:SS time in A +; Doesn't work for times .ge. 60. hours + +HMSTYO: IDIVI A,60. + JUMPE A,[MOVE A,B ? PJRST DPNT] + HRLM B,(P) + PUSHJ P,HMSTYO + MOVEI A,": + PUSHJ P,TYO ; Type delimiting char + HLRZ A,(P) +HMSTY3: IDIVI A,10. + PUSHJ P,ADGTYO ; Type out digit in A + MOVEI A,"0(B) + PJRST TYO + +] ; IFN RUNTSW + +SUBTTL COMMON Output Routine WINIT - Open all output files. + +; WINIT - Called from top-level control to open all necessary output files. +; + +WINIT: +IFN ERRSW,[ + SKIPN ERRFP ; If want error output file, + JRST WINIT2 + CALL OINIT ; Open it, first of all. + 0 ERRFC,ERRFB + SIXBIT/ERROUT/ + ERRHDR,,ERRBUF + SETOM ERRFOP ; Error file now open. +WINIT2: ] + PUSHJ P,OINIT ; Open main output file. + 13^9 UTYOC,OUTFB ; chnl,name-block. + SIXBIT/OUTPUT/ + UTOHDR,,UTOBUF +IFN ITSSW,[ + TLZ FF,FLPTPF ; Initially assume device not paper tape punch + .STATUS UTYOC,A ; Get status of output channel + ANDI A,77 ; Mask to device code + CAIN A,7 ; If paper tape punch, + TLO FF,FLPTPF ; Then set FLPTPF. +] +IFN LISTSW,[ + SKIPN LISTP + JRST WINIT1 + CALL OINIT ; Open listing file if desired. + 0 LPTC,LSTFB + SIXBIT/LSTOUT/ + LSTHDR,,LSTBUF +WINIT1: +] +IFN CREFSW,[ + SKIPN CREFP ; If cref requested, + RET + PUSHJ P,OINIT ; Open cref file, FN2 = CRFOUT + 13^9 CREFC,CRFFB + SIXBIT/CRFOUT/ + CRFHDR,,CRFBUF + MOVE A,[.BYTE 7 ? 177 ? "B ? ^W] + PUSHJ P,CRFOUT ; Output header to indicate image input. + PUSHJ P,CRFSSF ; Output set-source-file block. +] + RET + +SUBTTL COMMON Output Routines - Output Chars/Words to BIN, TTY, ERR, CREF, LIST + + ; PPB - Punch Binary word. + +PPB: JUMPGE FF,CPOPJ ; Don't punch if not punching pass. +PPBA: ; This entry pt "Always" punches. +TPPB: SOSGE UTYOCT ; If no more room in buffer, + JRST [ CALL TPPBF ; Output & re-init buffer. + JRST TPPB] + IDPB A,UTYOP + RET + +TPPBF: PUSH P,[0 UTYOC,UTOHDR] ; Drop thru to COBUFO. + + ; Common OBUFO. Takes ,
on stack, clobbers no ACs. + ; See rtns below for usual calling sequence. +COBUFO: EXCH C,(P) ; Get arg off stack, save C. + CALL OBUFO ; Output & re-init buffer. + REST C + RET + + ; TYO - Output char in A, outputting also to ERR file if possible. +TAB: MOVEI A,^I +TYO: SKIPG A.TTYF + CALL TYOX ; Actually output to TTY with OS-dependent routine. + ; Then fall through for ERR output. +ERRCHR: +IFE ERRSW,RET +IFN ERRSW,[ + SKIPN ERRFOP ; Output char in A to error file if one is open. + RET + SOSGE ERRFCT + JRST [ PUSH P,[ERRCHR] + PUSH P,[0 ERRFC,ERRHDR] + PJRST COBUFO] + IDPB A,ERRPTR + RET +] ;IFN ERRSW + + ; CRFOUT - Output word in A to CREF file. + +IFN CREFSW,[ +CRFOUT: SOSGE CRFCNT + JRST [ PUSH P,[CRFOUT] ; Buffer full, go output it. + PUSH P,[0 CREFC,CRFHDR] + PJRST COBUFO] + IDPB A,CRFPTR + POPJ P, + +CRFSSF: SKIPA A,[1] ; Output set-source-file block. +CRFPSH: MOVEI A,3 ; Output push-source-file block. +REPEAT L$F6BL,[ + CALL CRFOUT + MOVE A,INFB+$F6DEV+.RPCNT + ] + JRST CRFOUT +] ; IFN CREFSW + + + ; PILPT - Output character in A to listing file. + +IFN LISTSW,[ +PILPT: SOSGE LSTCNT + JRST [ PUSH P,[PILPT] ; When buffer full, output it. + PUSH P,[0 LPTC,LSTHDR] + PJRST COBUFO] + IDPB A,LSTPTR + RET + +LPTCLS=:CPOPJ ; Hmmm, random noop-ness ref'd by AEND. + +] ;END IFN LISTSW, + +SUBTTL COMMON Output Routine .FILE - Close all output files. + +; .FILE - Counterpart to WINIT. +; Close input, bin, cref and list files. + +.FILE: ; Closing input file is simple enough... +IFN DECSW, RELEAS UTYIC, +IFN ITSSW, .CLOSE UTYIC, +IFN TNXSW,[ +IFN PMAPSW, MOVE A,[NIBFPS,,1STBFP] ? CALL DELPGS ; flush buffer pages + MOVE R1,INFB+$FJFN + CLOSF + JFCL + SETZM INFB+$FJFN + SETZM JFNCHS+UTYIC +] + MOVNI A,1 + SKIPL B,CONTRL ; If relocatable, + PUSHJ P,TPPB ; Output a -1 so stink will see EOF + SETZ A, ; In dec fmt, output a 0 at end. + TRNE B,DECREL + CALL TPPB + SKIPE OUTFB+$FEXT ; Check general name. + JRST .FILE2 ; Output fnam2 was explicitly specified + + ; Output extension (fn2) wasn't specified, default depends + ; on the output type - absolute or relocatable. +IFN ITSSW, MOVSI A,'BIN ; None specified, get default extension for absolute +IFN DECSW, MOVSI A,'SAV +IFN TNXSW,[ + MOVSI A,'SAV ; On Tenex use .SAV, + TLNE FF,FL20X ; but on 20X + MOVSI A,'EXE ; use this. + ] + + SKIPL B,CONTRL ; and use that unless really relocatable, +IFN ITSSW, MOVSI A,'STK ; in which case use appropriate thing for site. +IFE ITSSW, MOVSI A,'REL + TRNE B,DECREL ; Another thing to check for + MOVSI A,'REL +IFN FASLP,[ + TRNE B,FASL ; If output is FASL format, +IFN ITSSW, MOVE A,[SIXBIT /FASL/] ; obviously smash again. +IFE ITSSW, MOVSI A,'FAS +] +IFE TNXSW, MOVEM A,OUTFB+$F6EXT ; For 6bit systems, store final selection. +IFN TNXSW, PUSHJ P,TNXODF ; If Tenex, call output default hackery, since + ; changing stuff is a bit hairier. + +.FILE2: JSP A,OCLOSE + 0 UTYOC,UTOHDR ; Write out buffer, rename and close output file. + OUTFB +IFN LISTSW,[ + SKIPN LISTP ; Listing file open => + JRST .FILE3 + CALL PNTCR ; End with cr and ff. + MOVEI A,^L + CALL PILPT + JSP A,OCLOSE + 0 LPTC,LSTHDR ; Output buffer, rename & close it. + LSTFB +.FILE3: +] ;IFN LISTSW +IFN CREFSW,[ + SKIPN CREFP ; If cref file open, + POPJ P, + MOVEI A,0 + PUSHJ P,CRFOUT ; Output eof block, + JSP A,OCLOSE ; Write buffer, close. + 0 CREFC,CRFHDR ; 0 chnl,header + CRFFB +] + RET + + ; File out error output file. This isn't done in .FILE so that + ; error file can include a few more goodies and be closed separately + ; later on. +ERRCLS: SETZM FATAL ; Err file renamed even after fatal error. +IFN ERRSW,[ + SKIPN ERRFOP + RET ; There is none. + MOVEI A,^M + CALL ERRCHR ; Put crlf at ennd. + MOVEI A,^J + CALL ERRCHR + JSP A,OCLOSE ; Rename and close. + 0 ERRFC,ERRHDR + ERRFB + SETZM ERRFOP +] + RET + +SUBTTL ITS - Output file Open, Output, Close/Rename. +IFN ITSSW,[ + +; PUSHJ P,OINIT ; Open output file +; Mode chnl,name-block-addr +; Sixbit/desired-temporary-fn2/ +; Header,,buffer space ;used only in dec version. +; The mode should be 13^9 for binary, 0 for ascii. + +OINIT: MOVE A,(P) + HLRZ B,2(A) ; Get addr of header, + SETOM 2(B) ; Set buffer byte count to -1 => not initted. + MOVE AA,1(A) ; Get 2nd arg, temp FN2 to use. + MOVE F,(A) ; Get 1st arg - , + SYSCAL TRANS,[5000,,.UAO ; For output mode, + REPEAT 4,[? .RPCNT(F) ] ; translate from given names + REPEAT 4,[? MOVEM .RPCNT+FB+$F6DEV ]] ; into actual names, in scratch blk. + JRST OINITL ; (too many translations) + + SYSCAL DELETE,[FB+$F6DEV ; Delete old temp name file. + TMPFN1 ? AA ? FB+$F6DIR] + JFCL ; If none, it's ok. + LDB A,[270400,,F] ; Get channel num. + HRLI A,.BAO ; Open mode (default ascii) + TLNN F,777000 ; But maybe want image mode. + HRLI A,.BIO ; Yep, use that instead, to get ,, + SYSCAL OPEN,[A ? FB+$F6DEV ; Open file, + TMPFN1 ? AA ; using these temp filenames. + FB+$F6DIR] + JRST OINITL + BLTM L$F6BL,FB+$F6DEV,$F6DEV(F) ; Copy translated names into + ; name-block for file, for eventual rename. + +POPJ3: AOS (P) ; Skip over 3 args. +POPJ2: AOS (P) + JRST POPJ1 + +TMPFN1: SIXBIT /_MIDAS/ ; FN1 to use for temp filenames. + + + +; OINITL - jumped to from OINIT if some lossage +; encountered when opening output files. + + +OINITL: HLLZ A,@(P) ; Get chnl num, + TLZ A,777037 ; Mask to just ac field (chnl num) + IOR A,[.STATUS A] + XCT A ; Read its status, + PUSHJ P,OPNER ; Type out reason for open failure, and ask + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Get typein, one line. + MOVE F,@(P) ; Get + PUSHJ P,RFD ; Get new file description into filblk spec'd by F + JRST OINIT ; and jump back to try again. + +VBLK +ERRDNM: .UAI,,'ERR ? 3 +ERRCOD: 0 +IFSTS: 0 ; .STATUS word stored by OPNRD1 when .OPEN loses +PBLK + + ; Openloss documentation routine + +IOPNER: MOVE A,IFSTS ; Input +OPNER: MOVEM A,ERRCOD ; Save .status word + PUSHJ P,TYPFB ; Type out file description + PUSHJ P,CRRERR ; Now crlf to ensure room for following + .OPEN ERRC,ERRDNM ; Now get the system to say what's wrong + .LOSE 1000 ; Can't open err device? +IOPNR2: .IOT ERRC,A ; Get character from system + CAIGE A,40 ; Ends with ^L or ^C or other cruft. + PJRST CRRERR ; Return, typing out CRLF. + PUSHJ P,TYOERR ; Type out character + JRST IOPNR2 ; Loop back for next + + +; JSP A,OCLOSE +; 0 chnl,header +; Nameblockaddr +; Write out last buffer, rename to names in nameblock and close. + +OCLOSE: MOVE C,(A) ; 1st wd of args is what OBUFO wants. + LDB B,[360600,,1(C)] ; Just in case this is ascii file, + DPB B,[300600,,OCLOSP] ; Get bp to unused part of last wd of buffer, + MOVE B,[ASCIC//] + DPB B,OCLOSP ; And pad with ^c's. + SOS 2(C) ; Obufo assumes byte count was sos'd. + CALL OBUFO ; Write out last partial buffer + MOVE F,1(A) ; Get + LDB C,[270400,,(A)] ; Get chnl num. + SKIPE FATAL + JRST OCLOS1 ; After fatal error, don't rename outputfiles. + SYSCAL RENMWO,[C ; Rename (F has nameblock addr) + $F6FN1(F) ? $F6FN2(F)] + HALT +OCLOS1: SYSCAL CLOSE,[C] ; Close channel. + HALT + JRST 2(A) ; Skip over args on return. + + +; OBUFO - Write out and reinitialize buffer for file. +; Assumes byte count (header 3rd wd) was sos'd. +; C has <0 chnl,header> +; In ITS version, header 1st wd has ,,-1 + +OBUFO: PUSH P,A + PUSH P,AA + AOSGE 2(C) ; Was count sos'd from -1? + JRST OBUFO1 ; Yes, buffer hadn't been initted, don't write it. + MOVN A,1(C) + ADD A,(C) ; RH(A) has -<# wds used in buffer>. + MOVSI A,(A) + HRR A,(C) + AOS A ; A has aobjn -> used part of buffer. + HLLZ AA,C + IOR AA,[.IOT A] + CAIGE A, + XCT AA ; Write it in file. +OBUFO1: MOVE A,1(C) + HRR A,(C) ; Position the b.p. before start of buffer, + TLZ A,770000 ; After last byte in wd (idpb will use 1st buffer wd) + MOVEM A,1(C) + HLRE A,(C) + MOVEM A,2(C) ; Set up byte count. + REST AA + JRST POPAJ + +TFEED: TLNN FF,FLPTPF ; If output device not PTP, + POPJ P, ; Then do nothing + PUSHJ P,TPPBF ; Otherwise output the buffer, +TFEED1: .FEED UTYOC, ; Feed a line, + TLZA FF,FLPTPF ; If this is executed, utyoc doesn't have ptp after all + SOJG B,TFEED1 ; Feed the specified number of lines, + POPJ P, ; And return + +] ; IFN ITSSW + +SUBTTL DEC - Output file Open, Output, Close/Rename + +IFN DECSW,[ + +OINIT: MOVE AA,(P) + MOVE F,(AA) ; Get , + HLLZ TT,F + TLZ TT,#(0 17,) ; Mask off AC field in TT + HRRZ D,2(AA) ; Get buffer space addr. + HLLZ C,2(AA) ; Get header addr. + HLRZ A,C + SETZM (A) ; Clear out its-version contents of 1st header wd. + LDB A,[331100,,F] ; Get mode to open in (will be ascii or image binary) + IOR TT,[OPEN A] ; Cons up OPEN instruction for chan, + MOVE B,$F6DEV(F) ; and bring in last arg. + XCT TT ; Open channel,a + JRST OINITL ; Lost? + + PUSH P,.JBFF ; Now to fake out DEC system into consing up buffer + MOVEM D,.JBFF ; at this location. T10 uses .JBFF as pointer. + XOR TT,[#] ; Request buffer setup (one of) + XCT TT + REST .JBFF + MOVE A,[SIXBIT /000MD /] + PJOB B, ; Get job number, to make sixbit /md/ + IDIVI B,10. + DPB C,[220400,,A] + IDIVI B,10. + DPB C,[300400,,A] ; Put the digits of the job number into the sixbit word. + DPB B,[360400,,A] + MOVE AA,(P) + LDB B,[360600,,1(AA)] ; Get 1st char of 'output, 'lstout, 'crfout, 'errout. + IOR A,B ; Use it as last char of temp file name. + MOVSI B,'TMP ; Set up ext (fn2), + SETZ C, ; zap prot/date/time etc to default, + MOVE D,$F6DIR(F) ; and PPN. + XOR TT,[#] + XCT TT ; Do ENTER UTYOC,A + JRST OINITL +POPJ3: AOS (P) +POPJ2: AOS (P) + JRST POPJ1 + +; OINITL - jumped to from OINIT if some lossage +; encountered when opening output files. Jumps back to OINIT +; directly. + +OINITL: PUSHJ P,OPNER ; Type out reason for open failure, and ask: + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Get typein, one line. + PUSHJ P,RFD ; Get new file description into filblk spec'd by F + JRST OINIT ; and jump back to try again. + + ; Openloss documentation routine - not much to say. + +IOPNER: ; Input +OPNER: PUSHJ P,TYPFB ; Type out file description + PUSHJ P,CRRERR ; Now crlf to ensure room for following + TYPE "OPEN failed" + PJRST CRRERR ; Return, typing out another CRLF. + +;CLOSE AN OUTPUT FILE, SEE NON-DEC VERSION FOR ARGS. + +OCLOSE: PUSH P,A ; Save return addr + MOVE F,1(A) ; Get + SKIPGE FATAL ; If fatal error happened, + JRST OCLOS2 ; don't rename, just close. + MOVE C,$F6DEV(F) ; Delete any file with names + SETZB B,D ; we want to rename to. + OPEN ERRC,B ; Use ERRC as temporary channel. + JRST OCLOS1 + MOVE A,$F6FN1(F) + HLLZ B,$F6EXT(F) + SETZ C, + MOVE D,$F6DIR(F) + LOOKUP ERRC,A + JRST OCLOS1 ; There is none, just rename. + SETZ A, ; Say to delete this file + MOVE D,$F6DIR(F) ; From right UFD + RENAME ERRC,A + JFCL + RELEAS ERRC, +OCLOS1: MOVE A,$F6FN1(F) ; Desired fn1. + HLLZ B,$F6EXT(F) ; Desired fn2. + SETZ C, ; Bottoms-10 DATE75 lossage must never be forgotten! + MOVE D,$F6DIR(F) ; Sname (that is, ppn) + HLLZ AA,@(P) ; Get just chnl num. + IOR AA,[CLOSE] ; Close it & finalize, + XCT AA + XOR AA,[CLOSE#] + XCT AA ; Then rename to desired names. + JFCL ; at this point, ignore any lossage, sigh. +OCLOS2: HLLZ B,@(P) ; Get chnl in ac field. + IOR B,[RELEAS] + XCT B ; Finally, release channel. + JRST POPJ2 ; and skip over args on return. + + ; Write out buffer of output file, C has <0 chnl,header> +OBUFO: AND C,[0 17,] ; Get just chnl num. (sys remembers where header is for ch) + TLO C,(OUT) ; Output current buffer. + XCT C + RET ; Normal return! + PUSH P,A ; Error return from out uuo. + XOR C,[OUT#] + XCT C ; Read file status. + TRZ A,74^4 ; Clear error bits. + ETR [ASCIZ /Output data error/] + XOR C,[#] + XCT C + JRST POPAJ + + ; Paper tape stuff, do nothing. +TFEED: RET + +] ;END IFN DECSW, + +SUBTTL TNX - Output file Open, Output, Close/Rename + +IFN TNXSW,[ + +TFEED: RET ; Again, null out paper-tape hack. + +; OINIT - Open Output file. +; P points to first word of args which follow the call: +; 1: , ; is 0 for ascii, 13^9 for bin. +; 2: sixbit // +; 3:
,, +; +; Clobbers A,B,C + +; For Tenex, it is necessary to fudge the fileblock consistency slightly; +; $FJFN has in RH the actual JFN used to write to the temporary-name +; file, and in LH the JFN for the final desired filename. Note that if +; the $FEXT is null for main output file, it will be defaulted by TNXODF +; at close time, (to SAV, EXE, or REL) and the +; "final desired" JFN won't actually be used. +; Both JFNS are "active" rather than just a file spec. + +OINIT: MOVE C,(P) ; Get addr of arg block + HLRZ A,2(C) ; Get
, + SETOM 2(A) ; and set buffer byte cnt to -1 to mark for init. + MOVE F,(C) ; Get , + PUSHJ P,GETJFO ; Get output JFN for filblk. + JRST OINIT5 ; Lost? +OINIT2: HRLZS $FJFN(F) ; Won, move JFN over into LH. + + ; Aha, successfully grabbed a JFN for desired output filename. + ; Now must get another one for the temporary filename... + MOVSI A,(GJ%FOU+GJ%NEW) + PUSHJ P,TFMAP ; Must set up block again, may have changed due to RDJFNO. + MOVE A,1(C) ; Get sixbit/tmpfn2/ + PUSHJ P,CV6STR ; Convert to ASCIZ and return BP to string. + MOVEM A,GTJBLK+.GJEXT ; Store in long-form call blk. + SYSCAL GTJFN,[[GTJBLK] ? [0]][A] ; Repeat the GTJFN call. + JRST [ MOVEM A,ERRCOD ; Ugh???? + JRST OINIT5] + HRRM A,$FJFN(F) ; Good, got it... + + ; Now have both JFN's packed away, can finally open the + ; temporary filename. + HRRZ B,A ; Need JFN in RH with LH clear... + LDB A,[331100,,F] ; Get + CAIN A, + MOVSI A,070000 ; If 0, use ASCII (7-bit bytes) + TRNE A,-1 + MOVSI A,440000 ; If not 0, use WORD (36-bit bytes) + TRO A,OF%WR ; Get write access. + SYSCAL OPENF,[B ? A][A] ; Open up the temp file (JFN in RH) + JRST [ MOVEM A,ERRCOD ? JRST OINIT6] ; damn + + ; Won, successfully opened output file stuff etc, now wrap up. + HRRZ A,$FJFN(F) ; Get JFN used, + LDB C,[270400,,F] ; and channel number argument, + MOVEM A,JFNCHS(C) ; and store JFN away in channel slot. + PUSHJ P,CVFSIX ; Now put right things in $F6 entries. + MOVEI A,3 + ADDM A,(P) + POPJ P, + +.SCALAR ERRCOD + + ; Come here when GTJFN fails trying to get a JFN for GTJBLK long + ; form argument block. Must print out bad filename. + ; OINIT5 should really use names in GTJBLK, and + ; OINIT6 should really hack GJFNS call to get names, but for now... + +OINIT5: SKIPA A,[[ASCIZ /GTJFN failed for /]] +OINIT6: MOVEI A,[ASCIZ /OPENF failed for /] + PUSHJ P,CRRERR + TYPR (A) + PUSHJ P,OPNER1 ; Type out filename and error message. + PUSHJ P,RDJFNO ; Read new JFN + JRST OINIT2 ; try to open it. + +IOPNER: PUSH P,[CRRERR] ; Do following and add CRLF. +OPNER1: PUSHJ P,TYPFB + TYPE " +Error - " ; Drop thru to TERSTR. + + +TERSTR: MOVE A,ERRCOD + HRLI A,.FHSLF + SYSCAL ERSTR,[[-1,,ERSTRB] ? A ? [-LERSTR,,]][A ? A ? B] + JRST TERST7 ; undefined err #? + HALT ; destination bad? + TYPR ERSTRB + POPJ P, +TERST7: TYPE "Unknown error" + POPJ P, + + LERSTR==80. +.VECTOR ERSTRB(/5) + +; RDJFNO - Hack to get a new JFN by reading from TTY, using recognition. +; RDJFNI - Same but for input. Uses current FB for defaults. +; Stashes JFN away in RH of $FJFN(F). + +RDJFNO: SKIPA A,[GJ%FOU+GJ%NEW+GJ%CFM] ; For output +RDJFNI: MOVSI A,(GJ%OLD+GJ%CFM) ; for input + PUSHJ P,TFMAP + MOVE A,[.PRIIN,,.PRIOU] ; Use primary JFNs (TTY) for I/O + MOVEM A,GTJBLK+.GJSRC + PUSH P,R1 + PUSH P,R2 + PUSH P,R3 + CAIA +RDJFN2: PUSHJ P,RDJERI ; Come here when get error in GTJFN. + MOVEI R1,.PRIIN ; Make sure that + CFIBF ; TTY input is reset. + HRROI R1,[ASCIZ / +Use what filename instead? /] + PSOUT + MOVEI R1, + MOVEI R1,GTJBLK + SETZ R2, + GTJFN + JRST RDJFN2 ; Error, report it. + POP P,R3 + POP P,R2 + HRRM R1,$FJFN(F) + POP P,R1 + PJRST JFNSTB ; Smash FB with names of the JFN we got, and return. + +; RDJERR - Report last error message directly to TTY (primary output). +; Useful when doing quick direct user interaction. + +RDJERR: TROA R2,-1 ; Here to get last error, whatever it was. +RDJERI: MOVE R2,R1 ; Here to use err code in R1. + HRLI R2,.FHSLF + HRROI R1,ERSTRB + MOVSI R3,-LERSTR + ERSTR ; Get error string + JRST RDJER6 + HALT + SKIPA R1,[-1,,ERSTRB] +RDJER6: HRROI R1,[ASCIZ /Unknown error/] + ESOUT ; Output to TTY amid other hackery. + POPJ P, + + +; TNXODF - Hack to get yet another "desired" JFN so that when no +; extension was specified for binary output file, one appropriate to +; the type can be selected. +; Basically do a GTJFN again for binary output filenames, furnishing +; the default extension selected, and use that to replace the one +; already in LH of $FJFN. + +TNXODF: PUSHJ P,CV6STR ; Convert sixbit word in A to string, get BP in A + MOVEI F,OUTFB ; Point at right filblk, + MOVEM A,$FEXT(F) ; Store, and now + PUSH P,$FJFN(F) ; Save current set of JFNs before + PUSHJ P,GETJFO ; getting another one + JRST POPAJ ; If lossage, stick to old JFN. + POP P,A + HRLZS $FJFN(F) ; GETJFO puts JFN into RH, we want it in LH. + HRRM A,$FJFN(F) ; now restore previous RH. + HLRZS A ; and get old "desired" JFN in position for + SYSCAL RLJFN,[A] ; releasing. + JFCL + POPJ P, + +; OCLOSE - Close output file, writing out remainder of buffer and renaming +; from temporary to desired filename. +; JSP A,OCLOSE +; 1: 0 ,,
+; 2: +; Clobbers F,C (and obviously A) + +; 10x must do CLOSF, not releasing the JFN, and then a RNAMF from temp +; JFN to desired JFN, after which both can be released. The desired and +; used JFNs are in LH and RH respectively of $FJFN in . +; is ignored except to wipe out its JFNCHS entry. + +OCLOSE: PUSH P,A + MOVE C,(A) ; Get ,,
+ SOS 2(C) ; OBUFO assumes count was SOS'd before each call + PUSHJ P,OBUFO ; Write out anything remaining in buffer. + LDB C,[270400,,(A)] ; Get channel number + MOVE F,1(A) ; Get + HRRZ A,$FJFN(F) ; Find JFN being used... + CAME A,JFNCHS(C) ; Should be same as JFN for channel. + HALT ; Synch error or something. + TLO A,(CO%NRJ) ; Say don't release JFN + SYSCAL CLOSF,[A] ; Close file... + HALT ; ?!?! + HRRZS A ; Get back 0,,jfn + SETZM JFNCHS(C) ; Indicate "channel" closed... + SKIPE FATAL ; If fatal error happened in assembly, + JRST OCLOS5 ; don't rename from temp filenames. + HLRZ C,$FJFN(F) ; Now see what if anything to rename it to. + JUMPE C,OCLOS5 ; If no renaming needed, skip hair. + SYSCAL RNAMF,[A ? C] ; Rename file from JFN in A to JFN in C. + HALT ; WTF? + SYSCAL RLJFN,[C] + HALT +OCLOS5: SYSCAL RLJFN,[A] + HALT + SETZM $FJFN(F) + POP P,A + JRST 2(A) + +; OBUFO - Output Buffer and reinitialize. +; C/ 0 ,
+; Clobbers no ACs. + +; 10X is pretty much like ITS, JFN is kept in JFNCHS table indexed by . + +OBUFO: PUSH P,A + PUSH P,B + MOVE A,1(C) ; Get write BP, + HRR A,(C) ; and reset it... + TLZ A,770000 ; to point at start of buffer, + MOVEM A,1(C) ; and store it back, which is OK since we have byte cnt + AOSGE 2(C) ; Was buffer marked for initialization (cnt -1)? + JRST OBUFO1 ; Yes, don't write anything, just go init rest of it. + HLRZ A,(C) ; Get buffer size in wds, + MOVNI A,(A) ; make negative, + ADD A,2(C) ; and add count of bytes left to get -<# bytes used>. + LDB B,[270400,,C] ; Get channel # as index to JFN + PUSH P,T + SYSCAL SOUT,[JFNCHS(B) ? 1(C) ? A] + POP P,T +OBUFO1: HLRZ A,(C) ; Get buffer size again, + MOVEM A,2(C) ; and reset count with it. + POP P,B + POP P,A + POPJ P, + +] ;END IFN TNXSW + +SUBTTL COMMON Input Routines - Main File Open, EOF handling + +; Open main input file for reading (filespec in ISFB) + +OPNRD: +IFN ITSSW, .IOPDL ; Re-initialize IO pdl +IFN DECSW\TNXSW, CALL IOPDLC ; Non-ITS systems must simulate. + INSIRP SETZM,INFCNT INFCUR INFERR + MOVE A,[-TYPDLS-1,,TTYPDL] + MOVEM A,ITTYP ; Initialize "tty pdl" + PUSHJ P,MACIN1 ; Clobber macro expansion status + MOVE A,ISFB+$FDEV ; Get device name + CAMN A,FSTTY ; TTY? + JRST [ MOVE A,[ISFB+$F6FN1,,IFNM1] ; TTY specified, treat special + BLT A,IFNM2 ; Clobber .IFNM1, .IFNM2 to specified + TYPECR "Reading from TTY:" + MOVEI A,3 ; => input from tty, don't quit on cr + JRST OPNRT2] +IFN TNXSW, PUSH P,INFB+$FJFN + MOVE A,[ISFB,,INFB] ; Copy ISFB specs to INFB (which will hold + BLT A,INFB+L$FBLK-1 ; actual names of current input file) +IFN TNXSW, POP P,INFB+$FJFN ; Preserving JFN if on TNX, to avoid re-GTJFN. + MOVEI F,INFB ; Point things at INFB. + PUSHJ P,OPNRD1 ; Try opening file + JRST [ PUSHJ P,IOPNER ; Open lost, type out message + POPJ P,] ; Read new command (this may screw on pass2?) + MOVEM A,INFERR ; Err msg in main file shouldn't type names. + MOVEI A,0 ; => input from file +OPNRT2: MOVE T,[IFNM1,,RFNAM1] + BLT T,RFNAM2 ; Set up .FNAM1, .FNAM2 + SETOM NEDCRL + AOS (P) ; Won, skip on return. + JRST RCHSET ; Set up to read from file or tty. (arg in A) + + + ; Common stuff for OPNRD1 in all (DEC/ITS/TENEX) versions. +OPNRD3: HRRZM A,UTIBED ; Say buffer empty, + MOVSI A,EOFCH_13 + MOVEM A,@UTIBED ; Cause immediate reload. +OPNRD4: BLTM 2,$F6FN1(F),IFNM1 ; Set up .IFNM1, .IFNM2 from filblk F points at + AOS A,INFCNT ; Assign this file a number. + MOVEM A,INFCUR ; OPNRD expects this left in A. + JRST POPJ1 + + ; EOF while trying to read character + +RPAEOF: PUSH P,B ; Save B +RPAEO1: MOVE B,ITTYP ; Get pdl pointer + PUSHJ P,BPOPJ ; Call pop routine (maybe NED's out) + JRST RCHTRB ; Return to get character + + ; EOF from main file + +NEDCHK: TRNE FF,FRCMND ; ^C read in commannd, :KILL self. + JRST TSRETN + SKIPE RCHMOD + JRST NEDCH1 + AOSN NEDCRL ; Invent one crlf after end of main file. + JRST [ MOVE B,[440700,,[.BYTE 7 ? ^M ? ^J ? EOFCH]] + MOVEM B,UREDP + HRRZM B,UTIBED + RET] +NEDCH1: +IFN A1PSW,[ + PUSHJ P,OUTCHK + MOVSI A,-LNEDT + XCT NEDT(A) ; Skips if NED condition to be complained about + AOBJN A,.-1 + JUMPGE A,GO8 +] + ETF [ASCIZ /No END statement/] + +.SCALAR NEDCRL ; -1 => haven't yet supplied a CRLF at EOF of main file. + +IFN A1PSW,[ ; Holler "NED" if any of the following: +NEDT: SKIPL PRGC ; No end statements have been encountered + SKIPGE OUTC ; Output has occured not matched by an end statement + SKIPGE OUTN1 ; Output has occured other than in 1pass mode + TRNN FF,FRPSS2 ; Currently in pass 2 +LNEDT==.-NEDT ; Length of table +] + +SUBTTL ITS - Input file Open, buffer input +IFN ITSSW,[ + + ; Try .OPENing input file pointed to by F. Skips if successful. + ; Sets filenames to actual names. + +OPNRD1: SYSCAL OPEN,[[.BAI,,UTYIC] + $F6DEV(F) ? $F6FN1(F) ? $F6EXT(F) ? $F6DIR(F)] + JRST [ .STATUS UTYIC,IFSTS ; Lost, save status now before possible + POPJ P,] ; .IOPOP, and make failure return. + SYSCAL RFNAME,[1000,,UTYIC ; Now find true filenames. + MOVEM $F6DEV(F) ; Store dev,dir directly + MOVEM C ; But need to check FN1, FN2 so + MOVEM D ; put them in ACs instead. + MOVEM $F6DIR(F)] + .LOSE 1000 + CAIE C, ; If FN1 meaningless for device, skip to use + MOVEM C,$F6FN1(F) ; spec'd FN1 anyway, but else store actual FN1. + CAIE D, + MOVEM D,$F6FN2(F) ; Ditto for FN2. + MOVE A,IUREDP ; Set up reading ptr, + MOVEM A,UREDP + JRST OPNRD3 ; Set up ^C after buffer, infcur, etc. + + + ; EOFCH encountered on read, reload and jump back for next char + +INCHR3: HRRZ CH1,UREDP ; Get byte pointer + CAME CH1,UTIBED ; End of block? + RET ; No, ^C in file. + MOVE A,IUREDP + MOVEM A,UREDP + MOVE A,[-UTIBFL,,UTIBUF] + .IOT UTYIC,A ; Read in block + ANDI A,-1 + CAIN A,UTIBUF ; If the iot didn't give us anything, we are at EOF. + JRST RPAEOF + HRRZM A,UTIBED ; Store RH (updated pointer) for EOF check at INCHR3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ; Store a ^C after the data we read, so at EOB we come to INCHR3. + JRST RCHTRA ; Now try next char +] ;END IFN ITSSW + +SUBTTL DEC - Input file Open, buffer input + +IFN DECSW,[ + +OPNRD1: MOVEI C,UTIHDR ; Open the input file w/ names in dnam ... snam. + SETZ A, ; Mode ascii. + MOVEI D,UTIBUF + MOVE TT,UTICHN ; Get channel num. to use. + LSH TT,27 ; Put in ac field. + IOR TT,[OPEN A] + MOVE B,$F6DEV(F) + XCT TT ; Open channel,a + RET + CALL BUFINI ; Initialize the input buffers and header. + MOVE D,$F6DIR(F) + MOVE A,$F6FNM(F) + HLLZ B,$F6EXT(F) + TLC TT,(OPEN#LOOKUP) + XCT TT ; Lookup channel,a + RET ; Failed. +IFE SAILSW,[ + MOVE A,$F6DEV(F) + DEVNAM A, ; Get real name of device. + CAIA + MOVEM A,$F6DEV(F) +] + MOVE A,UREDP + JRST OPNRD3 + + + ; Reload buffer, DEC style. +INCHR3: HRRZ CH1,UREDP ; Is this ^C at end of buffer? + CAME CH1,UTIBED + RET ; No, ^C in file. + PUSH P,B + MOVE A,UTICHN + LSH A,27 ; Channel num. in ac fld. + TLO A,(IN) + XCT A ; Get next bufferfull. + CAIA ; Succeed. + JRST INCHR4 ; Error. +INCHR5: MOVE A,UTICNT + ADDI A,9 + IDIVI A,5 + ADD A,UREDP ; -> 1st wd not read into. + HRRZM A,UTIBED + HRRZ A,UREDP + AOS A + MOVEI B,1 ; Scan the file and replace all line numbers with nulls. +INCHR6: CAMN A,UTIBED + JRST INCHR7 + TDNE B,(A) + MOVEM B,(A) + AOJA A,INCHR6 + +INCHR7: MOVSI B,EOFCH_13 + MOVEM B,(A) ; Put EOF char after buffer, in extra word. + JRST RCHTRB ; Retry RCH. + +INCHR4: XOR A,[#IN] + XCT A + TRZE B,74^4 + ETR [ASCIZ /Input data error/] + XOR A,[#] + XCT A ; Clear error bits in status. + TRNN B,2^4 + JRST INCHR5 + JRST RPAEO1 ; EOF. + +; BUFINI - Create DEC-style buffer ring, with 1 extra word following +; each buffer... +; A/ +; B/ +; C/
+; D/ +; Note that this extra-word crock is necessary just so it can be filled +; with ^C's to stop read loop and switch to next buffer. + +BUFINI: MOVEI AA,A +IFE SAILSW,DEVSIZ AA, + SKIPA AA,[DECBFL+1] ; Default buffer size is that for dsk. + AOJLE AA,.-1 ; Get size including extra wd. + MOVEI T,1(D) ; Addr of wd 2 of 1st buffer. + HRLI AA,T ; @AA is addr of 2nd wd of next buffer. + SUBI D,(AA) ; Facilitate test for end of buffer space. + HRLI T,400000 + MOVEM T,(C) ; Header -> a buffer, sign set. + HRRM T,1(C) ; Make rh of bp -> buffer 1st wd. + MOVSI T,440000 ; Set up p-field of b.p. + IORM T,1(C) + HRRZ T,1(C) + AOS 1(C) + HRLI T,-3(AA) ; Data-area-size +1,,addr-of-2nd-wd +BUFIN1: CAIGE D,-UTIBFL(T) ; Room for another after this buffer? + JRST BUFIN2 ; No, wrap up. + MOVEM T,@AA ; Yes, make next buffer -> this one, + HRRI T,@AA ; Point to next one. + JRST BUFIN1 + +BUFIN2: ADDI D,1(AA) ; -> 2nd wd of 1st buffer. + MOVEM T,(D) ; 1st buffer -> last, making ring. + RET + +] ;END IFN DECSW, + +SUBTTL TNX - Input file Open, buffer input + +IFN TNXSW,[ + +; OPNRD1 - Open File for Reading. Old stuff assumed fnm in DNAM +; using UTYIC channel, but new should furnish arguments: +; F/ to open + +; Essentially just GTJFN and OPENF like OINIT does, with same +; sort of error handling, except that when reading from cmd line +; as opposed to .INSRT, just go back to get completely new command. +; (perhaps if typein is just CRLF, go to special TNX style cmd input?) + +OPNRD1: CAIN F,INFB ; Horrible kludge necessary because MIDAS main + ; level doesn't bother to explicitly close main + ; input file when pass 1 is done, and TNX barfs if + ; you try to re-open a JFN... sigh. + JRST [ SKIPN $FJFN(F) ; Main file. Already opened it? + JRST .+1 ; nope, get JFN & open normally. + IFE PMAPSW,[ ; Already open. If not mapping, reset read ptr. + SYSCAL SFPTR,[$FJFN(F) ? [0]][ERRCOD] + POPJ P,] + JRST OPNRD2] ; and avoid attempt to re-open the JFN. + SKIPN $FJFN(F) + JRST [ PUSHJ P,GETJFI ; No JFN, get one for input. + POPJ P, ; Could fail. + JRST .+1] + PUSH P,T ; Read access, full word input. + SYSCAL OPENF,[$FJFN(F) ? [440000,,OF%RD]][ERRCOD] + JRST [POP P,T ? POPJ P,] ; Failure + POP P,T +OPNRD2: HRRZ A,$FJFN(F) + MOVEM A,JFNCHS+UTYIC ; Indicate "channel" open with this JFN. + PUSHJ P,JFNSTB ; Get actual names/version #. + PUSHJ P,CVFSIX ; Put right stuff in $F6 entries. + MOVE A,IUREDP ; Opened, set up buffer. + MOVEM A,UREDP ; Initialize BP into buffer. +IFE PMAPSW, JRST OPNRD3 +IFN PMAPSW, JRST OPNR50 ; for PMAP hacking, lots of stuff to do. + + ; Get a JFN for current FILBLK (in F) and stick it into $FJFN(F). + ; A should hold flags in LH to use in 1st wd of block. + ; GETJFI - sets usual flags for input + ; GETJFO - sets " " output + ; GETJFN - takes whatever A holds. + +GETJFO: SKIPA A,[GJ%FOU+GJ%NEW] ; If hacking output, ask for new version. +GETJFI: MOVSI A,(GJ%OLD) ; If hacking input, file must exist. +GETJFN: PUSHJ P,TFMAP ; Stick filblk stuff into GTJFN scratch block. + PUSH P,R1 + PUSH P,R2 + MOVEI R1,GTJBLK + SETZ R2, + GTJFN + JRST [ MOVEM R1,ERRCOD ; failure, save error code. + JRST GETJF5] + HRRM R1,$FJFN(F) ; Win, save JFN. + AOS -2(P) +GETJF5: POP P,R2 ; Can't return in ACs cuz don't know what R1 etc are, + POP P,R1 ; and might clobber them here. + POPJ P, + +; TFMAP - Map Tenex filenames from filblk pointed to by F into +; standard scratch block for long-form GTJFN. +; A/ ,,0 ; flags will go into LH of .GJGEN. +; Clobbers only A. + +TFMAP: HRR A,$FVERS(F) ; Put version # in RH + MOVEM A,GTJBLK+.GJGEN +IRP FROM,,[$FDEV,$FDIR,$FNAME,$FTYPE,$FPROT,$FACCT,$FJFN]TO,,[.GJDEV,.GJDIR,.GJNAM,.GJEXT,.GJPRO,.GJACT,.GJJFN] + MOVE A,FROM(F) + MOVEM A,GTJBLK+TO +TERMIN + MOVE A,[.NULIO,,.NULIO] + MOVEM A,GTJBLK+.GJSRC ; Don't hack I/O in gtjfn. + POPJ P, + +.VECTOR GTJBLK(10.) ; Need exactly this many wds for non-extended long call + +IFE PMAPSW,[ + ; EOFCH seen in input, check it here. + +INCHR3: HRRZ CH1,UREDP ; Get byte pointer + CAME CH1,UTIBED ; End of block? + RET ; No, ^C in file. + MOVE A,IUREDP + MOVEM A,UREDP + PUSH P,T + SYSCAL SIN,[JFNCHS+UTYIC ? [444400,,UTIBUF] ? [-UTIBFL]][A ? A ? A] + POP P,T + ADDI A,UTIBUF+UTIBFL ; Get UTIBUF + <# bytes stored> + CAIG A,UTIBUF ; If the sin didn't give us anything, we are at eof. + JRST RPAEOF + HRRZM A,UTIBED ; Store rh (updated pointer) for eof check at inchr3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ; Store a ^c after the data we read + JRST RCHTRA ; Now try next character + +] ; IFE PMAPSW + +IFN PMAPSW,[ ; New stuff for PMAP'ing input etc. + +VBLK +IFNDEF NIBFPS,NIBFPS==10 ; # of pages per buffer +PGBFL==NIBFPS*1000 ; Length of a buffer in wds. +IFNDEF 1STBFP,1STBFP==500 ; # of first page to start buffers at. + +INBFPG: 1STBFP ; # of 1st buffer page (in our address space) +INFPAG: 0 ; # of page in file corresponding to 1st page in buffer. +INPGCT: 0 ; -# times to refill buffer with new pages. +INLPGS: 0 ; # pages to slurp on last refill (instead of NIBFPS) +UTIBPE: 0 ; BP to last byte of data in buffer (holding ^C) +UTIBPL: 0 ; BP to last byte position in buffer area (constant) +UTIBPX: 0 ; BP to last byte of data when last pages have been mapped. +INLCHR: 0 ; Place to save char that ^C replaces. If -1, no char. +;SOSSW: 0 ; non-Z if hacking SOS line-number type file. +FBBYV: 0 ; GTFDB dumps cruft in these two locs. +FBSIZ: 0 ; e.g. this gets size of file in bytes. +PBLK + + ; Wrap up open of an input file, by initializing all the cruft + ; above. +OPNR50: SYSCAL GTFDB,[$FJFN(F) ? [2,,.FBBYV] ? MOVEI FBBYV] + LDB C,[300600,,FBBYV] ; Get byte size of file + CAIN C, + MOVEI C,36. ; If 0 use 36-bit bytes (full wds) + MOVEI A,36. + IDIVI A,(C) ; Get bytes per wd, ignore remainder. + MOVE B,FBSIZ ; Now, with # bytes in file, + EXCH A,B + IDIVI A,(B) ; find <# in fil>/<# per wd> = # wds in file + CAIE B, ; Also hack + ADDI A,1 ; rounding up (gasp, wheeze, finally done.) + IDIVI A,PGBFL ; Now get # times buffer will need slurping... + CAIE B, + ADDI A,1 ; Also round up. B has # "live" words in last slurp. + MOVNM A,INPGCT ; Store -# slurps. + MOVEI A,1777(B) + LSH A,-9. ; Find # pages last slurp really needs. + MOVEM A,INLPGS ; and store away. + HRLI B,010700 + MOVEM B,UTIBPX ; Store relative BP to last ch (when last pages mapped) + HRRI B,PGBFL-1 ; And relative BP to last char in whole buffer + MOVEM B,UTIBPL + MOVE A,INBFPG ; Find page # buffer starts at in core, + LSH A,9. ; Get address, and + ADDM A,UTIBPX ; add into the BP's to make them absolute. + ADDM A,UTIBPL + HRLI A,010700 ; also get initial read pointer from that. + SUBI A,1 ; MUST be "canonical form", so that SEMIC hackery + MOVEM A,IUREDP ; will work with weird way INCHR3 returns here. + MOVNI A,NIBFPS ; Use this as initial file page #, so the ADDB in + MOVEM A,INFPAG ; INCHR3 will do right thing to it. + MOVE A,[440700,,[EOFCH_35]] + MOVEM A,UREDP ; set up things so first RCH will instantly cause reload. + ILDB B,A + MOVEM A,UTIBPE + SETOM INLCHR ; Mustn't forget that we don't have a stored char yet. + JRST OPNRD4 ; Finally done with PMAP init stuff. + + ; Come here when hit ^C +INCHR3: MOVE CH1,UREDP ; Get current read ptr + CAME CH1,UTIBPE ; At end of buffer? + POPJ P, ; Nope, ^C in file, actual input. + AOSLE CH1,INPGCT ; Aha, end of buffer. Bump times refilled... + JRST [ SKIPGE A,INLCHR ; and if no more refills, see if last char left + JRST RPAEOF ; No? All done, true EOF. + SETOM INLCHR ; Almost, one last char. + MOVE CH1,UREDP ; Must bump ptr back one char, so next read + ADD CH1,[070000,,] ; will also stop. + CAIG CH1, + SUB CH1,[430000,,1] + MOVEM CH1,UREDP + JRST INCHR7] ; Return char in A. + MOVE A,IUREDP + MOVEM A,UREDP +IFN A-1,PUSH P,R1 +IFN A-2,PUSH P,R2 +IFN A-3,PUSH P,R3 + MOVEI R1,NIBFPS ; Get # of input buffer pages + ADDB R1,INFPAG ; and find current page in file to get + HRL R1,$FJFN+INFB ; current input file's JFN + MOVE R2,INBFPG ; and usual pointer to destination buffer page + HRLI R2,.FHSLF ; Why the fuck doesn't 10X default this?!?! + MOVEI R3,NIBFPS ; Set # pages to slurp up + CAIN CH1, ; But if this is last slurp, + MOVE R3,INLPGS ; use pre-calculated # to avoid non-ex pages. + TLO R3,(PM%CNT+PM%RD+PM%CPY) ; Read access, copy-on-write. +INCH50: PMAP ; Gobble gobble + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI R3,-1(R3) ; Else, on 10X, must iterate manually. + TRNE R3,400000 ; See if became "negative". + JRST .+1 ; Yep, done with manual iteration. + ADDI R2,1 ; Nope, bump page #'s. + AOJA R1,INCH50] +IFN A-3,POP P,R3 +IFN A-2,POP P,R2 +IFN A-1,POP P,R1 + CAIE CH1, ; Was this the last slurp? + SKIPA CH1,UTIBPL ; no, use BP to Last char at end of buffer. + MOVE CH1,UTIBPX ; yes, need BP to last char in last page. +IFN 0,[ SKIPE SOSSW ; If hacking line number lossage, + JRST [ MOVE A,(CH1) ; must beware of getting wiped, so have to + TRNE A,1 ; check here, and if depositing EOFCH in #, + HRLI CH1,350700 ; then move the EOFCH to beg of word! + JRST .+1] +] + LDB A,CH1 ; Replace last char of buffer's data + MOVEI CH2,EOFCH + DPB CH2,CH1 ; with the EOF char. + MOVEM CH1,UTIBPE ; Remember ptr to end of data, + EXCH A,INLCHR ; and save char for then, returning whatever + JUMPL A,RCHTRA ; was the last char of last bufferfull. + ; (may be -1, in which case RCHTRA tries again) + + ; Jump here to return a new char in A, something like + ; RCHTRA without all the fuss. +INCHR7: POP P,CH1 ; Get return addr + ANDI CH1,-1 + CAIE CH1,RREOF+1 + JRST -2(CH1) ; Note -2 not -3 as in RCHTRA! + JRST (CH1) ; Special hack since -2 loses for RREOF. + ; Perhaps someday it will win. +] ; IFN PMAPSW + +] ;END IFN TNXSW + +ifn 0,[ ; turn off but keep around for a while. +SUBTTL old .INSRT Processing + +; .INSRT ; Insert file here +; TTY: => ok, reads line at a time, rubout allowed within line +; Pushes macro expansion, other .INSRT's +; In filedescription, ^R => reset file name counter [?!? - KLH] +; If device is "@:", always ask for translation. + +A.INSR: NOVAL + MOVE A,[ISFB,,FB] ; Default names are those of spec'd input file + BLT A,FB+L$FBLK-1 ; Zap them into scratch filblk. + MOVEI F,FB ; And point at it. + MOVE A,FSDSK + MOVE B,FSTTY ; Compare "TTY" with + CAMN B,$FDEV(F) ; device name, and if identical, + MOVEM A,$FDEV(F) ; default to DSK. +IFE ITSSW,MOVE A,FSMID ; Always set default extension to "MID" or ">" +IFN ITSSW,MOVE A,FSGRTN + MOVEM A,$FEXT(F) + + TLO FF,FLUNRD +A.IN1: PUSHJ P,RFD ; Read file description + MOVE A,$FDEV(F) ; Get specified device name + CAME A,FSATSN ; Atsign? + PUSHJ P,A.ITRY ; No, try opening file + + ; If return, open failed. + MOVE A,$F6DEV(F) + AOJE A,A.INT1 ; Already trying to set up table entry + SKIPA F,[MAXIND,,TBLOFS] ; Atsign, or fnf, search table + +A.IN2: SUBI F,-L$FBLK ; Loop point searching table, increment to next entry, count down LH + CAMN F,INDDP ; Compare with pointer to top of table + JRST A.IN3 ; Agree => this file not in table + +; MOVEI A,-TBLOFS(F) ; Get index relative to table base. +; MIDAS complains "illegal use of relocation" when try to use above addr, so must use next 2 instructions instead - barf barf + MOVEI A,(F) + SUBI A,TBLOFS + + MOVSI B,-L$FBLK ; And index into FB. + MOVE T,TBLSFS(A) ; Get specification name this entry +A.IN25: CAMN T,FB(B) ; Compare with that just specified + AOBJN B,[AOJA A,.-2] ; Check all names this entry +IFE TNXSW, JUMPL B,A.IN2 +IFN TNXSW,[JUMPL B,[ MOVEI C,(B) + CAIN C,$FJFN ; One item of entry didn7t match, was it JFN? + JRST A.IN25 ; Yes, ignore it and continue. + JRST A.IN2] ; Sigh, was something else, entry doesn't match. + ] + + ; File is in table + MOVSI A,(F) ; Move description from TBLOFS to FB. + HRRI A,FB + BLT A,FB+L$FBLK-1 +IFN TNXSW, SETZM FB+$FJFN ; Since re-opening, must zap previous JFN. + PUSHJ P,A.ITRY ; Try opening file + + ; If return, open failed. + MOVSI A,TBLSFS-TBLOFS(F) ; Set up LH(BLT pointer), + HRRI A,FB + BLT A,FB+L$FBLK-1 ; Unmap to original names(TBLSFS to FB) + PUSHJ P,TYPFB ; Type out specified names + TYPE " -> " ; Type out pointer + MOVSI A,(F) ; Copy translation (TBLOFS entry) back to FB. + HRRI A,FB + BLT A,FB+L$FBLK-1 + SETOM $F6DEV(F) ; "half-kill" entry in TBLOFS + +A.INT1: PUSH P,F + MOVEI F,FB + PUSHJ P,IOPNER ; Open lost, type out cruft + POP P,F + TYPE "Use what filename instead? " +A.INT2: PUSHJ P,GTYIP ; Prepare to read one line from tty + JRST A.IN1 ; Try again with what he types in + + ; File not in table, try to add a translation for it. + +A.IN3: TLNN F,-1 ; More room for another entry in table? + ETF [ASCIZ /Too many @: files/] + MOVEI A,TBLSFS-TBLOFS(F) ; Copy FB into TBLSFS (specified name) + HRLI A,FB + BLT A,TBLSFS-TBLOFS+L$FBLK-1(F) + SETOM $F6DEV(F) ; Document fact that entry has only key, not translation + MOVNI A,-L$FBLK + ADDM A,INDDP ; Update pointer into table + MOVE A,FB+$FDEV ; Get specified device name + CAME A,FSATSN ; Atsign? + JRST A.INT1 ; No, type out garbage and try again, reading from tty + MOVE A,ISFB+$FDEV ; Yes, clobber from input device name + MOVEM A,FB+$FDEV + JRST A.INT2 + +;TRY OPENING INPUT FILE FOR .INSRT, RETURN IF UNSUCCESSFUL + +A.ITRY: MOVE A,FB+$FDEV ; Get specified device name + CAMN A,FSTTY ; TTY? + JRST A.ITRT ; Yes, treat special + TLO FF,FLUNRD + PUSHJ P,IPUSH ; Save current status + PUSH P,F ; save what F points at + MOVEI F,FB + PUSHJ P,OPNRD1 + JRST [POP P,F ? JRST IPOPL] ; Lose, pop and return + POP P,F + MOVE B,[FB,,INFB] ; Kludge for time being - if win, + BLT B,INFB+L$FBLK-1 ; Copy all stuff into INFB. +IFN ITSSW,CALL SETWH2 + MOVE B,ITTYP + MOVEI A,-1-TYPDEL(B) ; + HRLI A,IFNM1 + BLT A,-TYPDEL(B) ; Introduce hysteresis so .INSRT'ing file can reference .IFNM1, .IFNM2 +IFN CREFSW,[ + SKIPE CRFONP ; If creffing, output push-file block. + PUSHJ P,CRFPSH ; (pop-file block output at ipop) +] +A.ITR2: + MOVE A,$F6DEV(F) ; Push successful, now check to see if table entry should be finished + AOJN A,ASSEM1 + MOVEI A,(F) ; Move FB into TBLOFS as translation entry. + HRLI A,FB + BLT A,L$FBLK-1(F) + JRST ASSEM1 ; Now assemble from file (ASSEM1 clobbers pdl) + + ; .INSRT TTY: + +A.ITRT: PUSHJ P,GTYIPA ; Read from tty, don't quit until .INEOF + JRST A.ITR2 ; Fall back in (doesn't touch .IFNM1, .IFNM2) +] ; end IFN 0 + +SUBTTL .INSRT Processing + +; .INSRT ; Insert file here +; TTY: => ok, reads line at a time, rubout allowed within line +; Pushes macro expansion, other .INSRT's +; If device is "@:", always ask for translation. + +A.INSR: NOVAL + + ; First set up defaults for parsing filename. + BLTM L$FBLK,ISFB,FB ; Default names are those of spec'd input file, + MOVEI F,FB ; stuffed into scratch FB. + MOVE A,FSDSK + MOVE B,FSTTY ; Compare "TTY" with + CAMN B,$FDEV(F) ; device name, and if identical, + MOVEM A,$FDEV(F) ; default to DSK. +IFE ITSSW,MOVE A,FSMID ; Always set default extension to "MID" or ">" +IFN ITSSW,MOVE A,FSGRTN + MOVEM A,$FEXT(F) + + TLO FF,FLUNRD + PUSHJ P,RFD ; Read file description from current input. + MOVE A,$FDEV(F) ; Get specified device name + CAMN A,FSATSN ; Atsign? + JRST A.IN50 ; If so, check out translation right away. + +A.IN2: CAMN A,FSTTY ; TTY? Must handle specially. + JRST [ PUSHJ P,GTYIPA ; Set up to read until .INEOF or EOF char. + JRST ASSEM1] ; And don't do anything to .IFNM1/2, etc. + PUSHJ P,IPUSH ; File, push the world. + PUSHJ P,OPNRD1 ; Try opening file. + JRST [ PUSHJ P,IPOPL ; Sigh, failed, pop world back and go + JRST A.IN50] ; try translation entries or TTY input. + ; Always jumps back to A.IN2. + + ; Come here when input file successfully opened. Clean up etc. +IFN ITSSW,CALL SETWH2 + MOVE B,ITTYP + BLTM 2,IFNM1,-1-TYPDEL(B) ; Copy new .IFNM1, .IFNM2 onto stack, + ; to clobber .IFNM1/2 for previous file, so + ; that .IFNM1/2 etc refers to last file .INSRT'd by + ; current file (or current file if none .INSRT'd yet) +IFN CREFSW,[ + SKIPE CRFONP ; If creffing, output a push-file block. + PUSHJ P,CRFPSH ; (pop-file block is output at IPOP) + ] + + BLTM L$FBLK,(F),INFB ; Move current filespec to INFB, + JRST ASSEM1 ; and jump off to smash things to toplevel. + + ; Come here when open attempt fails or @: device specified. +A.IN50: CAIE F,FB ; Tried translations yet? + JRST A.IN60 ; Yes, skip table hacking and go get fnm from TTY. + + ; First open attempt, so OK to search translation table. + SKIPA D,[MAXIND,,TBLOFS] ; Load up aobjn-style index to transl table +A.IN52: SUBI D,-L$FBLK ; Loop point for searching table - increment to next entry, count down LH + CAMN D,INDDP ; Compare with pointer to top of table + JRST A.IN60 ; Agree => this file not in table, get from TTY. + + MOVEI A,(D) ; Get scratch index into tables, + HRLI A,-L$FBLK ; making AOBJN of it, + MOVEI B,(F) ; and get index into current FB. +A.IN54: MOVE C,TBLSFS-TBLOFS(A) ; Get a specification name for this entry +IFN TNXSW,CAIE B,$FJFN(F) ; (ignoring the JFN item, for TENEX) + CAMN C,(B) ; Compare name with that of failed filblk. + AOBJN A,[AOJA B,A.IN54] ; Check all names this entry + JUMPL A,A.IN52 ; If not found, try next entry. + + ; File is in table, try opening it using TBLOFS description. + MOVE F,D ; Replace old F by ptr to winning TBLOFS entry. +IFN TNXSW, SETZM $FJFN(F) ; Since re-opening, must zap any previous JFN. + JRST A.IN2 ; Jump off to try opening. + + ; Come here when open failed and no matching transl entry. + ; Must set up to gobble down a translation from TTY... +A.IN60: TYPE "Error in .INSRT; " + CAIE F,FB ; Were we trying to open a translated entry? + JRST [ PUSHJ P,TYPFB ; Yes, so print out appropriate info + TYPE " -> " ; to show translated stuff. + JRST A.IN70] + + ; First time, no translation entry exists, make one. + MOVE A,INDDP ; Get current pointer to top of tables + TLNN A,-1 ; Room for more? + JRST A.IN70 ; Nope, can't remember transl, but get right fnm anyway. + MOVE F,A ; Yep, use it as pointer to table entry to use. + SUBI A,-L$FBLK ; and get new table-top pointer with clever + MOVEM A,INDDP ; SOS of LH and ADDI to RH. + BLTM L$FBLK,FB,(F) ; Move FB contents to both TBLOFS, + BLTM L$FBLK,FB,TBLSFS-TBLOFS(F) ; and TBLSFS. + +A.IN70: ; Print out filename F points to, & err msg. +IFN TNXSW,[ + PUSHJ P,OPNER1 + PUSHJ P,RDJFNI ; On 10X, get new filename this way. + ] +IFN ITSSW\DECSW,[ ; Elsewhere do it painful way. + PUSHJ P,IOPNER + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Setup to read 1 line from TTY, + PUSHJ P,RFD ; and do it, parsing filename. +] + JRST A.IN2 ; now go try opening it. + +SUBTTL Misc. .INSRT-related things + + ; .INEOF - EOF pseudo + +A.IEF2: PUSHJ P,PMACP ; Loop point, pop entry off macro pdl +A.INEO: TLNE FF,FLMAC ; Inputting from macro? + JRST A.IEF2 ; Yes, pop it off + PUSH P,CMACCR ; Back to inputting from file or tty, cause return to maccr + MOVE B,ITTYP ; Get pdl pointer + POPJ B, ; Return to pop routine + + + ; Call from ERRH; type input file's names if changed since last err msg. +ERRTFL: MOVE C,INFCUR + EXCH C,INFERR ; Say last error msg in this file. + CAMN C,INFERR ; If prev. msg was in other file, + POPJ P, + PUSH P,F + MOVEI F,INFB ; Point to current input file, + PUSHJ P,TYPFB ; and type out its filename. + POP P,F + PJRST CRRERR + +SUBTTL COMMON IO PDL routines for input. (.INSRT support) + +;IO PDL ROUTINES FOR INPUT FILE +; Push the input file + +IPUSH: AOSN CMEOF ; Want to pop out of tty? (^C typed in) + CALL POPTT ; Yes, do now before forget. + +IFE PMAPSW,[ + MOVE D,UREDP ; Get input byte pointer +IFN ITSSW\TNXSW,[ +IFN ITSSW, .IOPUS UTYIC, +IFN TNXSW, MOVEI A,UTYIC ? PUSHJ P,$IOPUSH + TLNN D,760000 ; At end of word? + ADD D,[430000,,1] ; Yes, make it point to beginning of next word + MOVEM D,UREDP + MOVNI A,-2(D) + ADD A,UTIBED ; Get # wds we'll need in MACTAB. + HLR D,UTIBED ; Remember whether EOF on last .IOT. + HRRZS UTIBED ; Now clear out left half for following +] +IFN DECSW,[ + AOS A,UTICHN ; Do ".IOPUSH" - use next channel. + LSH A,27 + ADD A,[WAIT-<0 1,>] ; Construct a WAIT uuo for the current input channel. + MOVE C,RCHMOD ; We mustn't copy the buffers while I/O is going on. + CAMN A,[WAIT UTYIC,] ; But: if we are currently in the top-level input file + CAIE C,3 ; And it is device TTY:, this channel was never opened. + XCT A ; Don't move buffers while io going on! + MOVEI A,UTIBFL+2 ; Assume must save all buffer space. +] + PUSH P,A + ADD A,FREPTB + ANDI A,-1 + PUSH P,A + CAML A,MACTND ; No room in MACTAB => gc it. + CALL GCA1 + REST A + CAML A,MACTND ; Did the GC win? + PUSHJ P,GCCORQ ; NO!! Try to win somehow + MOVEI A,370 + CALL PUTREL ; Indicate start of saved buffer. + REST A + AOS B,FREPTB + SUBI A,1 + MOVE C,ITTYP ; Get addr of tty pdl wd that'll point to saved buffer. + ADDI C,1 + HRRZM C,(B) ; Store in rh of 1st wd, + MOVEI C,(B) ; Remember addr of saved buffer to push on ttypdl. + HRLM A,(B) ; Put length in lh. + AOS B +IFN ITSSW\TNXSW,HRL B,UREDP ; LH <- addr of 1st wd to save. +IFN DECSW,HRLI B,UTIBUF + ADDI A,-2(B) ; Addr of last wd to blt into. + BLT B,(A) + HRLI A,041000 + MOVEM A,FREPTB ; Make free bp -> last byte just used. + SUB A,MACTAD + ANDI A,-1 + LSH A,2 + ADDI A,4 ; Get char addr of next free byte. + MOVEM A,FREEPT +] +IFN PMAPSW, CALL IOBPUS + + MOVE B,ITTYP ; Get local version of iopdl +IPSHP: +IFE PMAPSW, PUSH B,C ; Push -> saved buffer (GC will relocate) +IFN DECSW,PUSH B,UTIBED ? PUSH B,UTIHDR +REPEAT L$FBLK, PUSH B,INFB+.RPCNT ; Save names of input file. + PUSH B,INFCUR ; Save number of input file. +IFE PMAPSW, PUSH B,D ; Lh=lh(old uredp), rh=lh(old utibed) (or just UREDP) +IFN PMAPSW, INSIRP PUSH B,[INFPAG INPGCT INLPGS UTIBPE UTIBPL UTIBPX INLCHR UREDP IUREDP ] + + ; Following two must be last pushed + INSIRP PUSH B,[IFNM1 IFNM2] ; Clobbered on pdl if .open successful +INPDEL==.-IPSHP ; Length of each entry on pdl + + MOVE A,FREEPT ; W must use same gc convention as putrel; + CAML A,MACHI ; Namely, gc after using up the last byte. + CALL GCA1 + MOVEI A,0 ; => input from file + MOVEM B,ITTYP ; Store back updated pointer + JSP B,PUSHTT ; Save stuff, address modify and return + + + ; Pop into the input file +IPOP: +IFN CREFSW,[ MOVEI A,2 ; If creffing, output pop-file block. + SKIPE CRFONP + PUSHJ P,CRFOUT] +IPOPL: PUSHJ P,POPTT ; Come here if .INSRT's open failed. + PUSH P,C + MOVE B,ITTYP ; Get pointer + INSIRP POP B,[IFNM2 IFNM1] ; Pop stuff +IFE PMAPSW, POP B,A ; Pop off UREDP (or halves thereof) +IFN PMAPSW, INSIRP POP B,[ IUREDP UREDP INLCHR UTIBPX UTIBPL UTIBPE INLPGS INPGCT INFPAG] + POP B,INFCUR +REPEAT L$FBLK,POP B,INFB+L$FBLK-1-.RPCNT +IFN DECSW,[ + POP B,C + PUSH P,C ; Old UTIHDR + POP B,UTIBED +] +IFE PMAPSW, POP B,C + MOVEM B,ITTYP ; Save updated pdl pointer. +IFE PMAPSW,[ + HLRZ B,(C) ; Get length of saved buffer, +IFN ITSSW\TNXSW,[ + PUSH P,A +IFN ITSSW, CALL SETWH2 ? .IOPOP UTYIC, +IFN TNXSW, MOVEI A,UTYIC ? CALL $IOPOP + REST A + MOVEI AA,UTIBUF-1(B) ; Get addr of 1st wd won't blt into in utibuf, + HRLI AA,(A) ; Get saved lh of utibed, + MOVEM AA,UTIBED + HRRI A,UTIBUF ; Make A -> 1st wd in buffer, +] +IFN DECSW,[ + MOVE AA,UTICHN + LSH AA,27 + IOR AA,[RELEAS] + XCT AA ; This code equivalent to .IOPOP. + SOS UTICHN + REST UTIHDR +] + MOVEM A,UREDP + MOVSI A,EOFCH_13 + MOVEM A,@UTIBED ; Put EOF char after buffer. + MOVSI A,1(C) ; Get addr of 1st data wd of saved buffer, + HRRI A,UTIBUF + CAIE B,1 + BLT A,UTIBUF-2(B) + HLLZS (C) ; Tell GC to reclaim saved buffer. +] ;IFE PMAPSW + +IFN PMAPSW, CALL IOBPOP + +POPCJ: REST C + RET + +;SAVE INTERNAL POINTERS CONCERNING INPUT MODE + +TYPDEL==2 ; Number of words in relevant pdl entry + +PUSHTT: PUSH P,A + PUSH P,F + AOSN CMEOF ; If supposed to pop out of tty soon, + CALL POPTT ; Do it now before cmeof clobbered. + MOVE F,ITTYP ; Get relevant pdl pointer + MOVEI A,0 + EXCH A,CLNN ; Set up new line number + HRL A,CPGN ; Save current page number + SETZM CPGN ; Now re-initialize + SKIPGE CRFILE ; Save cref-all-on-one-line flag. + TLO A,400000 + PUSH F,A ; Save cpgn,,clnn + MOVE A,-1(P) ; Retrieve new mode + PUSHJ P,PSHLMB ; Save limbo1 and set up instructions for new mode +IFN ITSSW,[ + CALL SETWH2 + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ; Store back updated pointer + JRST POPFAJ + + ; Restore internal pointers concerning input mode + +POPTT: PUSH P,A + PUSH P,F + MOVE F,ITTYP ; Get pdl pointer + PUSHJ P,POPLMB ; Pop into limbo1, set up new mode + POP F,A ; Get cpgn,,clnn + SETZM CRFILE ; Restore all-on-one-line flag. + TLZE A,400000 + SETOM CRFILE + HLRZM A,CPGN + HRRZM A,CLNN +IFN ITSSW,[ + CALL SETWH2 + ADD A,CPGN + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ; Store back updated pointer + JRST POPFAJ + +IFN ITSSW,[ +SETWH2: MOVE A,RCHMOD + CAIL A,2 + SKIPA A,[SIXBIT /TTY:/] + MOVE A,INFB+$F6FN1 + .SUSET [.SWHO2,,A] + MOVE A,A.PASS + LSH A,30 + ADD A,[SIXBIT /P0/+1] + RET +] + +SUBTTL Storage for IO PDL stuff + + ; IO PDL storage stuff + +VBLK +TYPDLS==TYPDLC*TYPDEL+INPDEL*MX.INS + ; "tty pdl", stores information about current input mode + ; (similar to macro pdl but not garbage collected) + +ITTYP: -TYPDLS-1,,TTYPDL ; Pdl pointer (typdel=length of each entry) +TTYPDL: NEDCHK ; Actual pdl: initial entry to overpop routine + BLOCK TYPDLS ; Pdl proper +PBLK + +SUBTTL TNX - IO PDL Routines (IOPDLC, $IOPUSH, $IOPOP) + +IFN TNXSW,[ + +IFN PMAPSW,[ + ; Push IO buffer & channel... +IOBPUS: PUSH P,A + MOVEI A,UTYIC + CALL $IOPUSH + MOVEI A,NIBFPS ; Point at next set of buffer pages. + ADDM A,INBFPG + POP P,A + POPJ P, + + ; Pop IO buffer & channel... +IOBPOP: PUSH P,A + MOVE A,INBFPG + HRLI A,NIBFPS + CALL DELPGS ; flush buffer pages. + MOVNI A,NIBFPS + ADDM A,INBFPG ; point down at previous set of buffer pages... + MOVEI A,UTYIC + CALL $IOPOP + POP P,A + POPJ P, + +; DELPGS - Take arg in A as <# pgs>,, and flush these pages. + +DELPGS: PUSH P,A + PUSH P,B + HLRZ B,A + HRLI A,.FHSLF ; ,, + TLO B,(PM%CNT) + PUSH P,T +DELPG2: SYSCAL PMAP,[[-1] ? A ? B][A ? A ? B] ; Free up buffer pages. + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI B,-1(B) ; Else, on 10X, must iterate manually. + TRNE B,400000 ; See if became "negative". + JRST .+1 ; Yep, done with manual iteration. + AOJA A,DELPG2] ; Nope, bump page #'s. + POP P,T + POP P,B + POP P,A + POPJ P, +] ;IFN PMAPSW + +; IOPDLC - Clear IOPDL stack, close all channels on it. +; Clobbers no ACs + +; for 10x, need to CLOSF and release each JFN on IOPDL stack. + +IOPDLC: PUSH P,T +IFN PMAPSW,[ + MOVEI T,1STBFP ; Reset to point at 1st page of buffer space. + MOVEM T,INBFPG +] + EXCH A,IOPDLP + JRST IOPDC3 +IOPDC2: SYSCAL CLOSF,[(A)] + JFCL + SUB A,[1,,1] +IOPDC3: CAMLE A,[-LIOPDL,,$IOPDL-1] + JRST IOPDC2 + EXCH A,IOPDLP + POP P,T + POPJ P, + +; $IOPUSH - Push I/O channel in A onto $IOPDL stack. +; Clobbers no ACs +; for 10X this means storing JFN on stack and clearing JFNCHS table entry. + +$IOPUSH:EXCH B,IOPDLP ; Get stack pointer + PUSH B,JFNCHS(A) ; save JFN for channel + EXCH B,IOPDLP + SETZM JFNCHS(A) ; Zap entry in channel table to make it look gone + POPJ P, + +; $IOPOP - Pops channel off $IOPDL into channel # in A. +; Clobbers no ACs + +; for 10X just pop $IOPDL into JFNCHS, must close and release old JFN tho. + +$IOPOP: PUSH P,T + SYSCAL CLOSF,[JFNCHS(A)] + JFCL + POP P,T + EXCH B,IOPDLP ; Get stack ptr + POP B,JFNCHS(A) + EXCH B,IOPDLP + POPJ P, + +VBLK +JFNCHS: BLOCK 20 ; Channel table index, JFNCHS(ch) gets JFN for chan. + ; (zero if none) +LIOPDL==8. ; Length of IO PDL +IOPDLP: -LIOPDL,,$IOPDL-1 +$IOPDL: BLOCK LIOPDL +PBLK +] ; IFN TNXSW + +SUBTTL DEC - IO PDL Routines (IOPDLC) + +IFN DECSW,[ + +; IOPDLC - Simulate ITS .IOPDL call. Flushes all channels from +; UTICHN downwards to UTYIC. Actually not a simulation but something +; that works in the particular situation for which MIDAS uses .IOPDL. + +IOPDLC: MOVEI A,UTYIC + EXCH A,UTICHN ; Set input chnl num. to lowest. + LSH A,27 + IOR A,[RELEAS] ; Set up to releas the highest in use first. +IOPDL1: XCT A ; Releas one input channel, + CAMN A,[RELEAS UTYIC,] + RET ; All done. + SUB A,[0 1,] + JRST IOPDL1 ; Releas the next one down. +] ;IFN DECSW + +SUBTTL COMMON TTY input routines & variables + +VBLK +CMBUF: BLOCK CMBFL ; Typein buffer (also used as JCL buffer) +CMPTR: 0 ; Byte pointer to CMBUF. +CMEOF: 0 ; -1 => POPTT instead of reloading after this bufferfull. +TTYOP: 0 ; -1 => the TTY is already open. +LINEL: 0 ; Width of TTY (may be 1,, meaning assume infinite). +A.TTYFLG: ; Value of .TTYFLG pseudo - another label for TTYFLG. +TTYFLG: 0 ; TTY typeout permitted iff >= 0. +WSWCNT: 0 ; The number of W-switches in the last cmd string. +TTYBRF: 0 ; -1 => ^H break has been requested but not yet done. +PBLK + ; Cause input from tty (main routines) + +GTYIPA: SETZM A.TTYF ; Push to tty, don't stop at cr. + +IFN ITSSW, TYPECR "TTY: .INSRTed, end input with ^C" +IFN DECSW\TNXSW,[ + IFE SAILSW,TYPECR "TTY: .INSRTed, end input with ^Z" + IFN SAILSW,TYPECR "TTY: .INSRTed, end input with CTL-META-LF" + ] + +GTYIP1: SKIPA A,[3] +GTYIP: MOVEI A,2 ; Input from tty, stop after 1 line. + SETZM CMPTR ; Force reload on 1st read. + JSP B,PUSHTT ; Set up variables and return +GTYIPR: SETZM CMPTR ; Return on .ineof or cr + JRST POPTT + + ; Call here from ASSEM1 loop when a ^H interrupt is detected. +TTYBRK: SETZM A.TTYF + ETR [ASCIZ/^H - break /] ; Type filename, page and line #. + SKIPE ASMOUT + TYPECR "within a <>, () or []" + JRST GTYIPA + + ; RCHSET routines for reading from TTY + ; RCHMOD=3 => don't quit on CR + ; 2 => quit on CR. +RCHTRC: +RCHARC: TLO FF,FLTTY ; Set flag + JSP A,CPOPJ +RCHAC1: REPEAT 2,[ ; RCH2, RR1 + ILDB A,CMPTR ; Get char + CAIN A,0 ; End of string marked with 0 + PUSHJ P,TYRLDR ; Reload, jump back for next char +] + HALT ; RRL1 +IFN .-RCHAC1-RCHPSN,.ERR RCHAC1 LOSES. + ILDB A,CMPTR ; SEMIC + CAIN A,15 + JRST SEMICR + JUMPN A,SEMIC + PUSHJ P,TYRLD + JRST SEMIC + +TYRLD: MOVEI A,3 ; Return after the call, not before. + ADDM A,(P) + + ; TYRLDR - Read in string. + ; Reload buffer if ran out in call to RCH. + +TYRLDR: AOSN CMEOF ; EOF detected after last reload => + JRST RPAEOF ; Pop out of tty. + PUSH P,A + PUSH P,B + MOVE B,RCHMOD + PUSH P,F + PUSH P,A.TTYF ; If chars rubbed out they should be printed. + SETZM A.TTYF + MOVE F,[10700,,CMBUF-1] ; Initial byte pointer to buffer + MOVEM F,CMPTR ; Store as byte pointer for read +TYRLD2: PUSHJ P,TYI ; Get character +IFN TNXSW,[ + CAMN F,CMPTR ; at beg of line? + CAIE A,^J ; and char is LF? + CAIA + JRST TYRLD2 ; If so then ignore it completely. +] + CAIN A,177 ; Rubout? + JRST TYRLD3 ; Yes + CAIE A,^C + CAIN A,^Z + JRST TYRLD7 ; ^C, ^Z => EOF. Ought to be EOFCH for consistency? + CAIN A,^U + JRST TYRLD5 ; Rub out all + CAIE B,2 ; For .TTYMAC handling, convert lower case to upper. + JRST TYRLD6 + CAIL A,"A+40 + CAILE A,"Z+40 + CAIA + SUBI A,40 +TYRLD6: CAME F,[010700,,CMBUF+CMBFL-2] + IDPB A,F ; Store character in buffer unless buffer nearly full. + CAIE A,^M ; CR? + JRST TYRLD2 ; No, go back for next + CAIN B,2 ; .TTYMAC (mode 2) => CR ends input, so fake EOF. + SETOM CMEOF + MOVEI A,^J ; Follow the CR with a LF. + IDPB A,F + PUSH P,F ; Output the entire line to the error file + MOVE F,[10700,,CMBUF-1] +TYRLD8: CAMN F,(P) + JRST TYRLD9 + ILDB A,F + CAIN A,^M ; If line was ended by a ^C or ^Z, put that in error + SKIPL CMEOF ; file, which needs hair since that char is not + JRST TYRLD0 ; In the string we stored. + MOVEI A,"^ + CALL ERRCHR +IFN ITSSW,MOVEI A,"C +IFN DECSW\TNXSW,MOVEI A,"Z + CALL ERRCHR + LDB A,F +TYRLD0: CALL ERRCHR + JRST TYRLD8 + +TYRLD9: REST F + MOVEI A,0 + IDPB A,F ; Mark end of string + IDPB A,F + REST A.TTYF + REST F + REST B + REST A + JRST RCHTRA + +TYRLD7: SETOM CMEOF ; ^C, ^Z force EOF, + CALL TYRLCR ; After turning into ^M. + MOVEI A,^M + JRST TYRLD6 + +TYRLCR: MOVEI A,^M + CALL TYOX + MOVEI A,^J + JRST TYOX + +TYRLD3: CAMN F,[10700,,CMBUF-1] ; Rubout, beginning of buffer? + JRST TYRLD4 ; Yes + LDB A,F ; Get last character in buffer + CALL TYOX ; Type it out, don't write in error file. + ADD F,[70000,,] ; Decrement pointer + JUMPGE F,TYRLD2 ; Jump if valid + SUB F,[430000,,1] ; Was 440700,,something, back it up + JRST TYRLD2 + +TYRLD5: MOVE F,[10700,,CMBUF-1] ; ^U, back to beginning of line +TYRLD4: PUSHJ P,TYRLCR ; Rubout when at beginning of buffer, type CR + JRST TYRLD2 + +SUBTTL ITS - TTY routines (TYOX, TYI, TTYINI) and JCLINI. + +IFN ITSSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOP + CALL TTYINI + .IOT TYOC,A + POPJ P, + + ; TYI - Get (just typed in) char in A +TYI: SKIPN TTYOP + CALL TTYINI ; Open the tty if not already done. + .IOT TYIC,A + ANDI A,-1 ; Non-tty devices can return -1,,3. + JUMPE A,TYI + CAIN A,^L ; This must be assuming that ^L clears screen? + JRST TYI + POPJ P, + + ; Initialize tty +TTYINI: PUSH P,A + .OPEN TYIC,[.UAI,,'TTY] ; Input + .LOSE + .OPEN TYOC,[%TJDIS+.UAO,,'TTY] ; Display mode output + .LOSE + SYSCAL CNSGET,[1000,,TYOC ? 2000,,A ? 2000,,A] + MOVSI A,1 ; TTY: is translated to something else => assume infinite linel + MOVEM A,LINEL ; Else linel gets width of tty. + SETOM TTYOP ; Say the tty is now open. + JRST POPAJ + +JCLINI: SETZM CMPTR + .SUSET [.ROPTIO,,A] + TLNN A,%OPCMD ; Has our superior said it has a cmd? + RET ; No. + BLTZ CMBFL-1,CMBUF ; Zero all but last word, + SETOM CMBUF+CMBFL-1 ; and ensure last word non-zero. + .BREAK 12,[5,,CMBUF] ; Try to read command string. + MOVE A,[440700,,CMBUF] + SKIPE CMBUF ; If read a cmd-string, + MOVEM A,CMPTR ; Tell TYRLD, GO2A it's there. + POPJ P, + +]; END IFN ITSSW + +SUBTTL TNX - TTY routines (TYOX, TYI, TTYINI) and JCLINI + +IFN TNXSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOP + CALL TTYINI +IFN A-1,EXCH A,R1 + PBOUT +IFN A-1,EXCH A,R1 + POPJ P, + + ; TYI - Get (just typed in) char in A + ; There is a screw for 20X in that it's not really possible + ; to know if the system is going to feed you a CR-LF + ; or just a CR; TYRLD2 checks for that, by flushing LF's, but + ; this would be the place to check if it were easy to do. +TYI: SKIPN TTYOP + CALL TTYINI ; Open the tty if not already done. +IFN A-1,EXCH R1,A + PBIN ; Get char into AC 1 + JUMPE R1,.-1 ; Ignore nulls. + TLNE FF,FL20X ; Cretinous differences between 10X/20X + JRST TYI2 ; 20X, skip EOL check. + CAIN R1,^_ ; On 10X, CR turned into ^_ (EOL); change it back. + MOVEI R1,^M +TYI2: +IFN A-1,EXCH R1,A ; Restore everything to right place if necessary. + POPJ P, + + ; TTYINI - Initialize tty + +TTYINI: PUSH P,A + PUSH P,T + SYSCAL RFMOD,[[.PRIIN]][A ? A] + POP P,T + HLRZS A + ANDI A,177 ; Terminal width + CAIGE A,30. ; If too low, + ADDI A,128. ; Assume twenex crockishness + MOVEM A,LINEL ; Linel gets width of tty. + SETOM TTYOP ; Say the tty is now open. + POP P,A + POPJ P, + + ; Read "JCL" - RSCAN buffer or nnnMID.TMP file (from CCL) + +JCLINI: SETZM CMPTR + SKIPE CCLFLG ; Started at CCL location? + JRST JCLIN5 ; Yep, go snarf stuff specially. + TLNN FF,FL20X ; Is this Tenex? + JRST [ MOVEI R1,.PRIIN + BKJFN ; see what previous character was + POPJ P,; *Gasp* + PBIN + CAIE R1,^_ ; Tenex newline? + SETOM CMPTR ; No, set flag saying "TTY but no prompt" + POPJ P,]; and skip the Twenex hackery below + SETZ R1, ; If not, check RSCAN. + RSCAN ; See if have anything in RSCAN buffer. + POPJ P, ; Huh? Shouldn't happen, but ignore it. + JUMPLE R1,APOPJ ; Also return if char cnt says nothing there. + MOVNI R3,(R1) ; Aha, set up cnt for SIN + HRROI R2,CMBUF + MOVEI R1,.PRIIN ; Now ready for business... + SIN + LDB R1,R2 ; Now examine wages thereof + CAIE R1,^M ; Last char CR? + JRST [ MOVEI R1,^M + IDPB R1,R2 ; If not, make it so. + JRST .+1] + SETZ R1, + IDPB R1,R2 ; Must also ensure ASCIZ. + MOVE B,[440700,,CMBUF] ; Now must flush cruft that crufty EXEC + ILDB A,B ; sticks in crufty front of crufty line! + CAILE A,40 + JRST .-2 ; Flush until random ctl seen (space, ^M) + CAIE A,40 ; If it wasn't a space, + POPJ P, ; then forget about the whole thing. +JCLIN3: MOVE C,B ; Now flush spaces. Save last ptr for chars. + ILDB A,B + CAIN A,40 + JRST JCLIN3 + CAIN A,^M ; And is first non-space something besides CR? + POPJ P, ; Bah, there wasn't anything in the JCL!! + MOVEM C,CMPTR ; Else save ptr to start of real goods. + POPJ P, + + ; TNX snarf of CCL file. No such thing as tmpcor, so just + ; look for real file with appropriate name. +JCLIN5: SETZM CCLFLG ; Want 0 in case abort out, will reset if win. + GJINF ; Get job # in R3 + HRROI R1,CMBUF ; Use CMBUF to form filename string. + MOVEI R2,(R3) + MOVE R3,[NO%LFL+NO%ZRO+<3_18.>+10.] + NOUT ; ship out job num in 3 digits, radix 10. + HALT + HRROI R2,[ASCIZ /MID.TMP/] + SETZ R3, + SOUT ; Flesh out rest of filename string. + SETZ R2, ; Make sure it's ASCIZ. + BOUT + MOVE R1,[GJ%OLD+GJ%SHT] ; Use short-form GTJFN + HRROI R2,CMBUF ; and gobble name from CMBUF. + GTJFN + POPJ P, ; If failed, forget it. + MOVE R2,[070000,,OF%RD] ; Read 7-bit bytes + OPENF + POPJ P, ; Bah + HRROI R2,CMBUF ; Gobble stuff up. + MOVEI R3,CMBFL*5 ; Read until buffer full, + MOVEI R4,^J ; or LF seen. + SIN + JUMPLE R3,APOPJ ; Forget it if too big for buffer!! + + MOVE R2,[440700,,CMBUF] ; Aha, we've got something, so set + MOVEM R2,CMPTR ; pointer to slurped stuff. + SETOM CCLFLG + HRROI R2,UTIBUF ; Slurp rest into larger buffer, + MOVNI R3,UTIBFL*5 ; using count only. + SIN + JUMPGE R3,APOPJ ; Refuse to hack grossly large file. + ADDI R3,UTIBFL*5 + JUMPLE R3,APOPJ ; if nothing read, need write nothing out. + HRLI R1,(CO%NRJ) ; Don't release JFN, + CLOSF ; but stop reading from file. + POPJ P, + MOVE R2,[070000,,OF%WR] ; Now try to hack write access. + OPENF + POPJ P, + MOVE R2,R1 ; Source becomes destination... + HRROI R1,UTIBUF ; and UTIBUF becomes source, + MOVNS R3 ; for just as many bytes as were read. + SOUT + MOVEI R1,(R2) ; done, now just close file. + CLOSF ; (this time, release JFN). + POPJ P, + SETOM CCLMOR ; say that more CCL remains. + POPJ P, +] ; END IFN TNXSW + +SUBTTL DEC - TTY routines (TYOX, TYI, TTYINI) + +IFN DECSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOP + CALL TTYINI + OUTCHR A + POPJ P, + + ; TYI - Get a typed-in char in A + +TYI: SKIPN TTYOP ; Open the tty, if not already done. + CALL TTYINI + INCHWL A +IFN SAILSW,[ + CAIN A,612 ; On SAIL, EOF is 612, + MOVEI A,^Z ; so turn into normal EOF if found. +] + CAIE A,^M ; Throw away the LF after a CR. + RET + INCHWL A + MOVEI A,^M ; Note that TYRLDR will put it back in. + RET + +TTYINI: INSIRP PUSH P,AA A B +IFE SAILSW,[ + PJOB A, + TRMNO. A, + JRST TTYIN1 + MOVEI AA,1012 ; .TOWID + MOVE B,[2,,AA] + TRMOP. B, ; Read width of tty line into B. +] +TTYIN1: MOVEI B,80. ; TRMOP. failed or not tried => assume width is 80. + MOVEM B,LINEL + INSIRP POP P,B A AA + SETOM TTYOP + RET + + TMPLOC .JBREN, TTYREN +TTYREN: SETOM TTYBRF ; "REENTER" command comes here +R: G: JRST @.JBOPC ; To request a ^H-break. Note crufty labels pointing here. + +];IFN DECSW + +SUBTTL DEC Hackery for JCLINI - Read CCL commands. + +IFN DECSW\TNXSW,[ +VBLK +CCLFLG: 0 ; Flag to indicate CCL entry from COMPIL, SNAIL, CCL, or EXEC +CCLMOR: 0 ; -1 => There are more lines of CCL commands, + ; so do a RUN SYS:MIDAS when finished. +PBLK +] + +IFN DECSW,[ ; DEC only hacks CCL as "JCL". + +.SCALAR CCLFIL ; Saves FN1 for tmp file hacking. + +; Read MID temp core file, if that loses, try nnnMID.TMP file. +; Clobbers A,B,C,D. + +JCLINI: SETZM CMPTR + SKIPN CCLFLG ; Was midas called from CCL level? + RET ; No, do not snarf tempcore + SETZM CCLFIL ; No CCL file yet + SETZM CCLFLG ; If tmpcor loses want this 0 (will re-setom below) + BLTZ CMBFL,CMBUF ; Zero cmd buffer. + MOVE A,[2,,['MID,, ? -,,CMBUF-1]] ; read (leave last wd 0) + TMPCOR A, ; Read compil-generated command + JRST [ OPEN [17 ? 'DSK,, ? 0] ; No tempcore, maybe try dump mode. + RET ; Argh but let something else die + PJOB A, ; Get job # + IDIVI A,100. ; Want decimal job number in sixbit + ADDI A,'0 + LSH A,6 + IDIVI B,10. + ADDI A,'0(B) + LSH A,6 + ADDI A,'0(C) + LSH A,18. + HRRI A,'MID ; Form file name as nnnMID.TMP + MOVEM A,CCLFIL ; Save for writing below + MOVSI B,'TMP + SETZB C,D ; No protect or ppn trash + LOOKUP A ; Try to get file + RET ; Give up + MOVE A,[-,,CMBUF-1] + SETZ B, + INPUT A ; Try to read command + SETZB A,B + RENAME A ; Try to delete it now + JFCL ; Ignore failure + CLOSE ; Happy sail + JRST .+1] + SKIPN CMBUF ; One last check for it to be there + RET ; Alas, there is none + MOVE A,[440700,,CMBUF] ; Load a byte pointer to the command + SETOM CCLFLG + MOVEM A,CMPTR ; There is, set command pointer +JCLIN1: ILDB B,A + CAIE B,^J ; See if our command file has anything after 1st line. + JRST JCLIN1 + ILDB B,A + JUMPE B,JCLIN3 + SETOM CCLMOR ; It does; set flag so after handling 1st line we'll + MOVE C,[440700,,UTIBUF+2] +JCLIN2: IDPB B,C + ILDB B,A + JUMPN B,JCLIN2 + SUBI C,UTIBUF+1 ; Get # words written in utibuf. operand is relocatable! + HRLOI C,-1(C) ; These 2 insns turn size into -size,,utibuf+1 + EQVI C,UTIBUF+1 + MOVEM C,UTIBUF+1 + SKIPE A,CCLFIL ; Was this called with a temp file? + JRST [ MOVSI B,'TMP + SETZB C,D + ENTER A ; Try to re-write file + RET ; Sigh + MOVE A,UTIBUF+1 + SETZ B, + OUTPUT A + RELEASE + RET] + MOVSI C,'MID + MOVEM C,UTIBUF + MOVE C,[3,,UTIBUF] + TMPCOR C, + JFCL ; [KLH - there used to be some random cruft here.] +JCLIN3: RET + +] ;END IFN DECSW + +SUBTTL Old Command Line Reader (CMD) +ifn 0,[ + ; Read command & filenames & hack defaulting. + +CMD: SKIPE CMPTR ; Unless have DDT or RSCAN cmd string, + JRST CMD06 ; (we don't) + CALL CRR ; type a CRLF, prompt etc. +CMD05: SETZM CMPTR + TYPE "*" +CMD06: MOVEI A,3 ; Read from TTY (or string <- cmptr) + CALL RCHSET + MOVEI F,FB ; Point to scratch filblk. + BLTZ L$FBLK,FB ; and clear the whole thing. + TRO FF,FRCMND ; Tell RFD it's scanning a command line. + CALL RFD ; Now see if command null, and whether has _. +IFN DECSW\TNXSW,[ + CAIN A,"! ; If terminator was "!", go run program. + JRST RFDRUN +] + TRNN FF,FRNNUL ; If no filespec was seen, + CAIE A,^M ; and terminator is EOL, + CAIA + JRST CMD05 ; then prompt again and get another string. + TRZ FF,FRARRO ; Got something, clear saw-"_" flag. +CMD07: CAIN A,"_ + TRO FF,FRARRO ; FRARRO will be on if there's a "_" in string. + CAIN A,^M + JRST CMD1 ; Read thru the whole command. + CALL RFD + JRST CMD07 + + ; Now re-read the string, for real this time. Previous scan was + ; mainly just to see if "_" existed. If not, then first filename + ; must be input file, and output filenames are all defaulted. +CMD1: MOVE T,[440700,,CMBUF] ; Restore original ptr to + MOVEM T,CMPTR ; beginning of string. +IFN CREFSW,SETZM CREFP ; Clear all switches before decoding them. +INSIRP SETZM 0,ERRFP TTYINS WSWCNT +IFN LISTSW,[ + SETZM LISTP + SETOM LISTP1 ; Will be AOSed by each (L) switch. +] + + MOVE T,FSDSK + MOVEM T,$FDEV(F) +IFE TNXSW,[MOVE T,RSYSNM ? MOVEM T,$FDIR(F)] +IFN TNXSW, SETZM $FDIR(F) + SETZM $FNAME(F) + SETZM $FEXT(F) + + TRZ FF,FRNNUL + TRNE FF,FRARRO ; Don't gobble input spec as output! + CALL RFD ; Read bin file spec. + MOVE TT,FF ; Remember whether null + BLTMAC T,L$FBLK,(F),OUTFB ; Copy from scratch to OUTFB. + + MOVE T,$FDEV(F) + CAMN T,FSNUL + MOVE T,FSDSK + MOVEM T,$FDEV(F) +IFE ITSSW, MOVE T,FSCRF +IFN ITSSW, MOVE T,FSCREF + MOVEM T,$FEXT(F) + + TRNN FF,FRARRO ; If "_" doesn't exist in cmd line, + MOVEI A,"_ ; then only filespec is for input, kludge to get it. + CAIN A,"_ ; If "_" exists in cmd line, did we hit it? + JRST CMD2 ; Ran out of output specs => just use defaults. + CALL RFD ; Read cref file spec. +IFN CREFSW,[ + TRNN FF,FRNNUL ; If spec not null or ended by _, + CAIN A,"_ + SETOM CREFP ; We must want to cref. +CMD2: BLTMAC T,L$FBLK,(F),CRFFB ; Copy specs from FB to CREF FB. +] +IFE CREFSW,CMD2: + MOVE T,FSERR + MOVEM T,$FEXT(F) + CAIN A,"_ + JRST CMD6 ; No more output specs. + CALL RFD ; Read error file sppec. +IFN ERRSW,[ + TRNN FF,FRNNUL ; Nonnull spec or last spec => + CAIN A,"_ + SETOM ERRFP ; Must want an error file. +CMD6: BLTMAC T,L$FBLK,(F),ERRFB ; Copy specs from FB to ERR filblk. +] +IFE ERRSW,CMD6: +IFN LISTSW,[ +IFE ITSSW, MOVE T,FSLST +IFN ITSSW, MOVE T,FSLIST + MOVEM T,$FEXT(F) + CAIN A,"_ ; Any output spec remaining? + JRST CMD3 + CALL RFD ; Yes, read one. + SETOM LISTP ; List spec given implies want listing. +CMD3: BLTMAC T,L$FBLK,(F),LSTFB ; Copy specs from FB to LST filblk. +] + +CMD5: CAIN A,"_ + JRST CMD4 + CALL RFD ; Ignore any output specs not needed. + JRST CMD5 + +CMD4: MOVE T,FSDSK ; Default the input names. + MOVE A,$FDEV(F) + CAME A,FSPTP ; Don't leave dev name set to common out-only devs. + CAMN A,FSNUL + MOVEM T,$FDEV(F) +IFE ITSSW, MOVE T,FSMID +IFN ITSSW, MOVE T,FSGRTN ; > on ITS. + MOVEM T,$FEXT(F) + MOVE T,FSPROG + SKIPN $FNAME(F) ; The fn1 alone is sticky across the _. + MOVEM T,$FNAME(F) + + TRZ FF,FRARRO ; If only 1 name it should be FNAM1. + CALL RFD ; Read input spec. + BLTMAC T,L$FBLK,(F),ISFB ; Copy into specified-input filblk. + MOVE T,$FNAME(F) ; Default output FN1's to input. + SKIPN OUTFB+$FNAME + MOVEM T,OUTFB+$FNAME +IFN CREFSW,[ + SKIPN CRFFB+$FNAME + MOVEM T,CRFFB+$FNAME +] +IFN LISTSW,[ + SKIPN LSTFB+$FNAME + MOVEM T,LSTFB+$FNAME +] +IFN ERRSW,[ + SKIPN ERRFB+$FNAME + MOVEM T,ERRFB+$FNAME +] + MOVE A,FSNUL ; The output dev defaults to NUL: + MOVE T,$FDEV(F) ; If the input is from TTY: + CAMN T,FSTTY + TRNE FF,FRNNUL ; And the bin spec was null. + CAIA + MOVEM A,OUTFB+$FDEV + TRZ FF,FRARRO ; Don't louse up .INSRT's reading. + RET +] ;ifn 0 + +SUBTTL Command Line Reader (CMD) + + ; CMD - Read command & filenames & hack defaulting. + +.SCALAR CMDPSV ; Saves read ptr into CMBUF, for re-scanning. + +CMD: SKIPE T,CMPTR ; If we have DDT or RSCAN or CCL string, + JRST CMD06 ; go hack it without typing anything out. + CAMN T,[-1] ; If Tenex-type "JCL", normal TTY input 'cept no prompt + JRST CMD06X + CALL CRR ; Nope, must type a CRLF, prompt etc. +CMD05: TYPE "*" +CMD06X: SETZB T,CMPTR +CMD06: MOVEM T,CMDPSV ; Save pointer for later restoration + MOVEI A,3 ; Read from TTY (or string <- cmptr) + CALL RCHSET + + MOVEI F,ISFB ; Point to input-spec filblk. + BLTZ L$FBLK,(F) ; Zap it through and through. + TRO FF,FRCMND ; Tell RFD it's scanning a command line. + CALL RFD ; Now see if command null, and whether has _. +IFN DECSW\TNXSW,[ + CAIN A,"! ; If terminator was "!", go run program. + JRST RFDRUN +] + TRNN FF,FRNNUL ; If no filespec was seen, + CAIE A,^M ; and terminator is EOL, + CAIA + JRST CMD05 ; then prompt again and get another string. + TRZA FF,FRARRO ; Got something, clear saw-"_" flag. +CMD07: CALL RFD + CAIN A,"_ + JRST [ TRO FF,FRARRO ; FRARRO will be on if there's a "_" in string. + CALL RFD ; Gobble next filename, input filespec. + JRST CMD1] + CAIE A,^M + JRST CMD07 ; Read thru the whole command until read input filespec + + + ; Now re-read the string, for real this time. Previous scan was + ; mainly to latch onto input filespec and see if "_" existed. + +CMD1: SKIPN T,CMDPSV ; Restore original ptr if there's one, + MOVE T,[440700,,CMBUF] ; else point at beg of buffer. + MOVEM T,CMPTR + SETZM TTYINS ? SETZM WSWCNT ; Clear all switches. +IFN CREFSW,SETZM CREFP +IFN ERRSW, SETZM ERRFP +IFN LISTSW,SETZM LISTP ? SETOM LISTP1 ; Will be AOSed by each (L) switch. + SETZ A, + TRNN FF,FRARRO ; If "_" doesn't exist in cmd line, + MOVEI A,"_ ; then only filespec is for input, kludge to get it. + + MOVEI F,OUTFB + BLTZAC T,L$FBLK,(F) ; Clear output filblk. + MOVE T,FSDSK ; Default dev to DSK. + MOVEM T,$FDEV(F) + SKIPN T,$FNAME+ISFB ; Now default FN1 from input filespec + MOVE T,FSPROG ; (use "PROG" if none) + MOVEM T,$FNAME(F) +IFE TNXSW,[MOVE T,RSYSNM ; Now default directory if need to + MOVEM T,$FDIR(F)] + + TRZ FF,FRNNUL + CAIE A,"_ ; If it exists, + CALL RFD ; Read bin file spec. + TRNN FF,FRNNUL ; If spec was null, + JRST [ MOVE T,FSTTY ; and input spec was TTY:, + CAME T,$FDEV+ISFB + JRST .+1 + MOVE T,FSNUL ; then set device to NUL:. + MOVEM T,$FDEV(F) + JRST .+1] + +DEFINE CFMAC SWIT,PTR,INSTR,DEXT +IFN SWIT,[ + MOVE T,DEXT + MOVE TT,[[INSTR],,PTR] +] .ELSE SETZB T,TT + PUSHJ P,CMDFGT +TERMIN + + CFMAC CREFSW,CRFFB,[SETOM CREFP][IFN ITSSW,[FSCREF] .ELSE FSCRF] + + CFMAC ERRSW, ERRFB,[SETOM ERRFP] FSERR + + CFMAC LISTSW,LSTFB,[SETOM LISTP][IFN ITSSW,[FSLIST] .ELSE FSLST] + +CMD50: CAIE A,"_ + JRST [ SETZB T,TT ; Point to scratch FB etc. + CALL CMDFGT ; Ignore any output specs not needed. + JRST CMD50] ; Must do this way to retain default stuffs. + + ; Finally read input file. + BLTMAC T,L$FBLK,(F),ISFB ; Copy last stuff to input spec + MOVEI F,ISFB ; and point at it. + PUSHJ P,CMDDVX ; Hack device-name default. +IFE ITSSW, MOVE T,FSMID +IFN ITSSW, MOVE T,FSGRTN ; > on ITS. + MOVEM T,$FEXT(F) + CALL RFD ; Read input spec. + RET ; Yep, that's really all! + + ; TT has ,, + ; T has default $FEXT. + ; Takes defaults from current F, sets F to new filblk. +CMDFGT: JUMPE TT,[SETZ T, ; If 0, do usual but into oblivion (scratch FB) + MOVE TT,[[JFCL],,FB] + JRST .+1] + BLTMAC B,L$FBLK,(F),(TT) ; Copy from current filblk to new. + MOVE F,TT ; set new F. + MOVEM T,$FEXT(F) ; Set default $FEXT + PUSHJ P,CMDDVX ; Set up device, defaulting to DSK. + CAIN A,"_ ; If last delimiter was start of input spec, + POPJ P, ; don't read anything - just use defaults. + PUSHJ P,RFD + TRNN FF,FRNNUL ; If spec non-null or + CAIN A,"_ ; ended by _, then + CAIA ; hack specified instr. + POPJ P, + HLRZ T,F + XCT (T) + POPJ P, + +CMDDVX: SKIPN T,$FDEV(F) + MOVE T,FSDSK + CAME T,FSPTP + CAMN T,FSNUL + MOVE T,FSDSK + MOVEM T,$FDEV(F) + POPJ P, + +SUBTTL ITS/DEC Filename Reader/printer (RFD, TYPFB) + +IFN DECSW\ITSSW,[ ; Begin moby conditional for sixbit reader. + +; RFD - Reads a single file description from .INSRT or command line, +; using RCH, into specified FILBLK. +; F points at FILBLK to store description in. +; Implements crufty ^R hack (if see ^R, act as if just starting to +; read filename, so effect is stuff before ^R has set defaults.) +; If FRCMND set, recognize -, comma, / and ( as special characters, +; and hack switches. +; Sets FRNNUL if spec was nonnull. +; Clobbers A,B,C only. + +RFD: TRZ FF,FRNNUL +RFD01: SETZM RFDCNT ; Zero cnt of "normal" filenames. Jump here if see ^R. + +RFD10: PUSHJ P,GPASST ; Flush out spaces/tabs + TRNN FF,FRCMND ; If parsing command line, + CAIE A,"; ; or if char isn't semi-colon, + JRST RFD22 ; just handle normally. +RFD15: PUSHJ P,RCH ; Semi-colon and not command line!! Flush rest + CAIE A,^M ; of line, assuming it's a comment! + JRST RFD15 + POPJ P, + +RFD2: PUSHJ P,RCH ; Get character in A +RFD20: CAIE A,40 ; Space (Come here to scan already-read char.) + CAIN A,^I ; or tab? + JRST RFD10 ; Ach, go into flush-whitespace loop. +RFD22: CAIN A,^M ; End of line? + POPJ P, ; If so, obviously done. + CAIN A,^R ; Crufty ^R hack? + JRST RFD01 ; Sigh, pretend just starting to read filename. + TRNN FF,FRCMND ; Reading command line? + JRST RFD40 ; Nope, skip over cmnd-line frobs. + + ; Reading cmd line, test special chars. +IFN ITSSW\SAILSW, CAIN A," ; SAIL underscore, ITS backarrow like _. + .ELSE CAIN A,"= ; Either gets munged, + MOVEI A,"_ ; into canonical "_". + CAIE A,"_ ; Backarrow is output_input marker. + CAIN A,", ; Comma is also a terminator... + POPJ P, +IFN DECSW\TNXSW,[ ; I'm not sure if this belongs here, but + CAIN A,"! .SEE RFDRUN + POPJ P, +] + PUSHJ P,CMDSW ; Check for switches... + JRST RFD20 ; Got some, scan next char (returned by CMDSW) + ; Got none, drop thru. + + + ; No special delimiters, + ; Check for chars which signal what following word is. +RFD40: +IFN DECSW,[ + CAIN A,"[ ;] Left bracket signals start of PPN. + JRST [ PUSHJ P,RFDPPN ; Slurp it up, + MOVEM C,$F6DIR(F) ; store it, + TRO FF,FRNNUL ; saying spec not null. + JRST RFD20] ; and go process leftover delimiter. + + CAIN A,". ; Period signals start of extension. + JRST [ PUSHJ P,RCH ; Get the next character + PUSHJ P,RFDW ; Read in a word. + MOVEM C,$F6EXT(F) ; Store it... + TRO FF,FRNNUL ; and say spec non-null (even if C/ 0) + JRST RFD20] ; and process delimiting char. +] + + ; Here, char doesn't signal the start of anything, so we'll assume + ; it's the start of a name. + PUSHJ P,RFDW ; Gobble up a word. + JUMPE C,RFD2 ; If nothing was read, must ignore char; get another. + + ; Aha, name was read, now examine delimiter to see if it specifies + ; anything we know about. + TRO FF,FRNNUL ; Set flag saying spec non-null. + CAIN A,": ; If colon... + JRST [ MOVEM C,$F6DEV(F) ; Then store name as device. + JRST RFD2] ; and flush delimiter. +IFN ITSSW,[ + CAIN A,"; ; If semicolon... + JRST [ MOVEM C,$F6DIR(F) ; Then store name as directory (sname) + JRST RFD2] ; and flush delimiter. +] + ; Whatever it is, at this point delimiter doesn't signify anything + ; special in terms of what the name is. So we just store it, using + ; the usual FN1 FN2 DEV DIR sequence, and hand delimiter off to + ; the prefix scanning stuff. + MOVE B,RFDCNT ; Get current count for random names. + XCT RFDTAB(B) ; Either MOVEM C, to right place, or ignore + AOS RFDCNT ; by skipping over this instr. + JRST RFD20 ; and go examine delimiter. + + +.SCALAR RFDCNT ; Count to index RFDTAB by. + +RFDTAB: MOVEM C,$F6FNM(F) ; 1st name. + MOVEM C,$F6EXT(F) ; 2nd name. + MOVEM C,$F6DEV(F) ; 3rd name is dev. + MOVEM C,$F6DIR(F) ; 4th is sname. + CAIA ; 5th and on ignored, don't incr. cnt. + +; RFDW - Reads a "word" - any string of contiguous SIXBIT chars, +; barring certain delimiters, and leaves SIXBIT result in C. +; Begins reading with char currently in A. Returns with delimiter +; char in A (it's possible this can be the same char!) +; Clobbers B. + +RFDW: SETZ C, ; First things first, zap result. + SKIPA B,[440600,,C] +RFDW2: PUSHJ P,RCH + CAIN A,^Q ; Is char the quoter char? + JRST [ PUSHJ P,RCH ; Yup, gobble next... + CAIN A,^M ; and accept anything but CR + POPJ P, ; since that terminates the whole line. + JRST RFDW7] ; OK, go stuff the char into C. + CAIE A,40 ; Space + CAIN A,^I ; or tab + POPJ P, ; is always a break. + CAIN A,^M ; As is CR. + POPJ P, + TRNN FF,FRCMND ; And certain chars are bummers when reading cmd. + JRST RFDW4 + CAIE A,"/ + CAIN A,"( + POPJ P, +IFN DECSW\TNXSW, CAIE A,"= + CAIN A,"_ + POPJ P, +IFN ITSSW\SAILSW, CAIE A," + CAIN A,", + POPJ P, +IFN DECSW\TNXSW,[ + CAIN A,"! + POPJ P, +] + ; Not reading cmd line, or no cmd-line type chars seen. +RFDW4: +IFN ITSSW,[ + CAIE A,": ; For ITS filenames, these chars are special. + CAIN A,"; + POPJ P, +] +IFN DECSW,[ + CAIL A,140 ; For DEC, allow only alphanumeric. + SUBI A,40 ; cvt to uppercase, then + CAIL A,"A ; see if alpha. + CAILE A,"Z + JRST [CAIL A,"0 ; Nope, see if numeric. + CAILE A,"9 + POPJ P, ; Not alphanumeric, assume delimiter. + JRST .+1] +] +RFDW7: TLNN B,770000 ; Enough room in C for another char? + JRST RFDW2 ; Nope, ignore it and get next. + CAIL A,140 ; Enuf room, cvt lower to uppercase + SUBI A,40 + SUBI A,40 ; and cvt to sixbit, + IDPB A,B ; and deposit. + JRST RFDW2 ; Get another. + +] ; END IFN DECSW\ITSSW + +IFN DECSW,[ ; PPN Reader + +RFDPPN: PUSHJ P,RFDOCT ; Read project num, +IFN CMUSW, JUMPE C,RCMUPP ; At CMU watch for our funny ppns + HRLM C,(P) + PUSHJ P,RFDOCT ; Read programmer num. + HLL C,(P) + POPJ P, + +IFE SAILSW,RFDOCL=="0 ? RFDOCH=="8 ; Read octal numbers. +IFN SAILSW,RFDOCL==40 ? RFDOCH==140 ; Read sixbit (right-justified). + +RFDOCT: SETZ C, ; Read octal num, return in C. +RFDOC1: PUSHJ P,RCH + CAIL A,140 + SUBI A,40 +IFN SAILSW,[ ;[ ; Even if reading sixbit names (for SAIL), + CAIE A,", ; Comma and closebracket are still special. + CAIN A,"] + POPJ P, +] + CAIL A,RFDOCL + CAIL A,RFDOCH + POPJ P, ; Not octal or not 6bit, return. + IMULI C,RFDOCH-RFDOCL + ADDI C,-RFDOCL(A) + JRST RFDOC1 + +IFN CMUSW,[ ; [ +RCMUPP: CAIN A,"] ; Watch out for [] + POPJ P, +REPEAT 4, SETZM PPNBUF+.RPCNT + MOVE C,[440700,,PPNBUF] +RCMUPL: CAIE A,^M ; Don't look too far + SKIPE PPNBUF+3 + JRST RCMUPD + IDPB A,C + PUSHJ P,RCH ; [ + CAIE A,"] + JRST RCMUPL +RCMUPD: MOVE A,[C,,PPNBUF] + CMUDEC A, + SETZ C, + POPJ P, + +.VECTOR PPNBUF(4) ; Storage to buffer up a string for CMUDEC uuo to scan. + +] ;IFN CMUSW +] ;IFN DECSW + +IFN DECSW\ITSSW,[ + +; TYPFB - Type out current filblk (what F points at) as file specification +; Clobbers A,B,C + +TYPFB: MOVSI C,-3-ITSSW + HRR C,F +TYPF1: MOVE B,$F6DEV(C) ; Get next name + PUSHJ P,SIXTYO ; Type out name + HLRZ A,C + MOVE A,FILSPC+3+ITSSW(A) ; Now get delimiting character + PUSHJ P,TYOERR ; Type out + AOBJN C,TYPF1 ; Loop for all names +IFN ITSSW, POPJ P, +IFN DECSW,[ + SKIPN B,$F6DEV(C) ; On DEC system PPN is a special case + POPJ P, + MOVEI A,"[ ;] + CALL TYOERR +IFN CMUSW,[ + MOVE A,[B,,PPNBUF] + DECCMU A, + JRST OCTPPN + TYPR PPNBUF + JRST PPNRB + ] +IFE SAILSW,[ +OCTPPN: HLRZ B,$F6DEV(C) ; LH is proj, + CALL OCTPNT + ] +.ELSE [ HLLZ B,$F6DEV(C) + CALL SIXTYO +] + MOVEI A,", + CALL TYOERR +IFE SAILSW,[ + HRRZ B,$F6DEV(C) + CALL OCTPNT ; RH is prog. +] +.ELSE [ HRLZ B,$F6DEV(C) + CALL SIXTYO + ] +PPNRB: ; [ + MOVEI A,"] + JRST TYOERR +];IFN DECSW + +FILSPC: ": +IFN ITSSW, 40 ? 40 ? "; +IFN DECSW, ". ? 0 + +] ; END IFN DECSW\ITSSW + +SUBTTL Command switches + +; CMDSW - Hacks either a single switch or switch list; A should +; contain "/ for the former, "( for the latter. +; Returns in A next char after switch hackery done. This may be ^M. +; Skip returns if neither "/ nor "( was furnished to it. + +CMDSW: CAIN A,"/ ; Single switch? + JRST [ PUSHJ P,RCH ; Get next char + CAIN A,^M + POPJ P, + PUSHJ P,CMDSW1 + PJRST RCH] + CAIE A,"( ; Switch list? + JRST POPJ1 ; Neither slash nor paren, make skip return. +CMDSWL: PUSHJ P,RCH + CAIN A,^M + POPJ P, + CAIN A,") + PJRST RCH + PUSHJ P,CMDSW1 + JRST CMDSWL + + ; Command switch processing. CMDSW1 processes the switch char + ; in A. +CMDSW1: CAIL A,140 ; Lower case to upper. + SUBI A,40 + CAIN A,"T + SOS TTYINS ; Count # T-switches. + + CAIN A,"W ; W - prevent tty messages, and +IFE ERRSW,AOS WSWCNT ; request error output file if possible. +.ELSE [ + AOSA WSWCNT + CAIN A,"E ; E - request error log file. + SETOM ERRFP + ] + +IFN CREFSW,[ + CAIN A,"C ; C - request CREF output. + SETOM CREFP + ] + +IFN LISTSW,[ + CAIE A,"L ; L - request listing + POPJ P, + SETOM LISTP ; Say want listing. + AOS LISTP1 ; (starts as -1, will be positive after 2nd (L)) + ] + + POPJ P, + +SUBTTL TENEX Filename Reader/printer (RFD, TYPFB) + +IFN TNXSW,[ ; Moby conditional for Tenex reader. + +; TNXRFD - TENEX-style Filename Reader. +; Takes input from RCH, +; Deposits name strings into filblk F points to. +; Clobbers A,B,C,D, (and AA,T,TT due to FNCHK) +; Uses FRFEXT flag to see if already read extension (type) or not. +; Refuses to accept existing defaults for version, ;T, account, +; protection, or JFN. It will also zap an existing directory +; default if a device is specified, and vice versa. This is so that +; logical names will win a little better. +; Implements crufty ^R hack (if see ^R, act as if just starting to +; read filename, so effect is stuff before ^R has set defaults.) + +IFNDEF FRFDEV,FRFDEV==2 ; Set if read device. +IFNDEF FRFDIR,FRFDIR==1 ; Set if read directory. +IFNDEF FRFEXT,FRFEXT==FRFN1 ; Borrow this bit. Set if read extension. + +RFD: TRZ FF,FRNNUL + SETZM $FJFN(F) ; Zap JFN since the filename we'll read won't match it. + SETZM $FACCT(F) ; Also zap other things that we don't want defaulted. + SETZM $FPROT(F) + SETZM $FTEMP(F) + SETZM $FVERS(F) +TRFD01: TRZ FF,FRFEXT+FRFDEV+FRFDIR ; Jump here if ^R seen. +TRFD10: PUSHJ P,GPASST ; remove tabs, spaces and get first non-tab/space + TRNN FF,FRCMND ; If parsing command line, + CAIE A,"; ; or if char isn't semicolon, + JRST TRFD21 ; just handle normally. +TRFD15: PUSHJ P,RCH ; Semi-colon and not command line, it's a comment! + CAIE A,^M ; So flush rest, up to EOL. + JRST TRFD15 + POPJ P, + +TRFD1: TLO FF,FLUNRD ; come here to re-read last char +TRFD2: PUSHJ P,RCH ; Get char +TRFD21: CAIE A,40 ; Space? (come here to scan already-read char) + CAIN A,^I ; or tab? + JRST [TRNE FF,FRCMND ; Space/tab, if reading command line + JRST TRFD2 ; then ignore and continue scanning (for switches), but + JRST TRFD15] ; if not in cmd line, go flush entire rest of line! + CAIN A,^M ; End of line? + POPJ P, ; If so, obviously done. + CAIN A,^R ; Crufty ^R hack? + JRST TRFD01 ; Sigh, pretend starting over. + TRNN FF,FRCMND ; Must we check for cmd line frobs? + JRST TRFD22 ; Nope, skip them. + + ; Must check for chars special only in command line. + CAIN A,"= + MOVEI A,"_ + CAIE A,"_ ; backarrow is filename terminator... + CAIN A,", ; as is comma. + POPJ P, + CAIN A,"! ; For CCL hacking... + POPJ P, .SEE RFDRUN + PUSHJ P,CMDSW ; Check for switches... + JRST TRFD21 ; got some, process next char (returned by CMDSW) + ; Skips if none, drop thru. + + ; Now see if char signifies start of anything in particular. +TRFD22: CAIN A,"< ; Start of directory name? + JRST [ PUSHJ P,RCH + PUSHJ P,TRFDW ; Read word, starting with next char + MOVEI D,$FDIR ; Set up index. + CAIN A,"> ; Terminator should be end of dir name... + PUSHJ P,RCH ; If so, get next to avoid scan of ">". + ; else bleah, but aren't supposed to fail... + TRNN FF,FRFDEV ; Unless a device has been explicitly given, + SETZM $FDEV(F) ; zap any furnished default. 0 means DSK. + TRO FF,FRFDIR ; Now say dir was explicitly given. + JRST TRFD6] ; Go store it. + + CAIN A,". ; Start of $FTYPE or $FVERS (20x)? + JRST [ MOVEI D,$FTYPE ; Assume reading $FTYPE field, + TLNE FF,FL20X ; always if 10X, but if really on 20X, then + TRON FF,FRFEXT ; use $FTYPE only if not already seen. + JRST TRFD4 ; $FTYPE - jump to get word & store. + PUSHJ P,TRFDNM ; $FVERS - 20X and $FTYPE already seen. Get #. + MOVEM B,$FVERS(F) ; Store it away if successful. + JRST TRFD1] ; and go re-read delimiting char. + + CAIN A,"; ; Start of $FVERS (10x) or attribute? + JRST [ PUSHJ P,RCH ; Find what next char is. + CAIL A,"a ; Must uppercasify. + CAILE A,"z + CAIA + SUBI A,40 + CAIN A,"T ; Temporary file? + JRST [ SETOM $FTEMP(C) + JRST TRFD2] + CAIN A,"A ; Account? + JRST [ MOVEI D,$FACCT ; Set index, and + JRST TRFD4] ; go gobble following word. + CAIN A,"P ; Protection? + JRST [ MOVEI D,$FPROT ; Set index, and + JRST TRFD4] ; go gobble following word. + TLO FF,FLUNRD ; Not alpha, try numeric. Re-read char, + PUSHJ P,TRFDNM ; trying to parse as number. + MOVEM B,$FVERS(F) ; Win, parsed as number! Store it. + JRST TRFD1] ; If none of above, ignore ";" entirely. + + PUSHJ P,TRFDW ; Let's try reading it as word, + JUMPLE C,APOPJ ; If nothing read, assume it's some terminating delimiter. + CAIN A,": ; Else have something, check trailing delim for special cases + JRST [ MOVEI D,$FDEV ; Aha, a device. + PUSHJ P,RCH ; Flush the terminator & get next char. + TRNN FF,FRFDIR ; Unless dir was explicitly given, + SETZM $FDIR(F) ; zap furnished default. 0 uses connected dir. + TRO FF,FRFDEV ; Say device was explicitly given, and + JRST TRFD6] ; store name away. + MOVEI D,$FNAME ; Else assume it's the filename. + JRST TRFD6 + + +TRFD4: PUSHJ P,RCH ; Here when must gobble next char, +TRFD5: PUSHJ P,TRFDW ; here when first char of wd already read. +TRFD6: PUSHJ P,FNCHKZ ; Note this can return and store a null string! + ADDI D,(F) ; Get address (filblk+index), and + MOVEM A,(D) ; store string pointer in the appropriate place. + TRO FF,FRNNUL ; Say non-null spec seen, + JRST TRFD1 ; and go re-read the delimiter, to process it. + +; TRFDW - Read a word (string), for use by TNXRFD. Copies sequence of +; acceptable filename chars into FNBUF, until non-valid char seen. +; A/ First char of word, +; Returns A/ delimiting char, C/ count of chars in string, +; clobbers nothing else. + +TRFDW4: SUBI A,40 ; Make lowercase +TRFDW5: IDPB A,FNBWP ; Deposit into FNBUF, + PUSHJ P,RCH ; get next char, + AOSA C ; and bump count, skipping over zap instruction. +TRFDW: SETZ C, ; When called, zero cnt of chars in string. + CAIL A,"A ; See if char is uppercase alpha, + CAILE A,"Z + CAIA + JRST TRFDW5 + CAIL A,"a ; or lowercase alpha, + CAILE A,"z + CAIA + JRST TRFDW4 + CAIL A,"0 ; or numeric, + CAILE A,"9 + CAIA + JRST TRFDW5 + CAIE A,"$ ; or dollarsign + CAIN A,"- ; or hyphen + JRST TRFDW5 + CAIN A,"_ ; Backarrow is special case, because + JRST [ TRNN FF,FRCMND ; if reading command, + TLNN FF,FL20X ; or running on 10X, + POPJ P, ; must treat as delimiter. + JRST TRFDW5] + CAIN A,^V ; ^V is quote char... + JRST [ PUSHJ P,RCH ; Quote, get next. + CAIE A,^M ; Quote anything but this. + CAIN A,0 ; or this. + POPJ P, ; time to exit. + PUSH P,A ; Quote it! Save char, + MOVEI A,^V ; so that a quoter can precede it. + IDPB A,FNBWP ; Fortunately this hair + POP P,A ; only needs care + IDPB A,FNBWP ; for quoted chars, which are + JRST TRFDW5] ; rare. + TLNE FF,FL20X ; Are we on a 10X? + POPJ P, ; If not, anything at this point is delimiter. + CAIL A,41 ; Check general bounds + CAIL A,137 ; Range from space to _ exclusive. + POPJ P, ; If outside that, delimiter. + CAIL A,72 ; This range includes :, ;, <, =, > + CAILE A,76 + CAIA + POPJ P, ; delimiter. + CAIE A,". + CAIN A,", + POPJ P, + CAIE A,"* + CAIN A,"@ + POPJ P, + ; Finally, check out chars which are acceptable to 10X but which + ; might be delimiter in cmd line... + TRNN FF,FRCMND + JRST TRFDW5 ; Not hacking cmd line, it's an OK char. + CAIE A,"/ + CAIN A,"( + POPJ P, + CAIN A,"! + POPJ P, + JRST TRFDW5 ; at long last done. + + +; TRFDNM - Read numerical string, halt when non-digit +; seen, leaves result (decimal) in B, with delimiting char in A. +; One peculiarity is skip return if no numerical char is seen at all; +; else doesn't skip and B has a valid number. + +TRFDNM: PUSHJ P,RCH ; First char needs special check. + CAIL A,"0 + CAILE A,"9 + JRST POPJ1 ; Not a number at all? + TDZA B,B +TRFDN2: IMULI B,10. + ADDI B,-"0(A) ; Convert to number + PUSHJ P,RCH ; Get following chars. + CAIL A,"0 + CAILE A,"9 + POPJ P, ; Nope, not digit so treat as delimiter. + JRST TRFDN2 ; Yep, a number + +] ;IFN TNXSW + +IFN TNXSW,[ + +; TYPFB - Type out FB pointed to by F + +TYPFB: SKIPE B,$FDEV(F) ; First, device name? + JRST [ PUSHJ P,TYPZ + MOVEI A,": + PUSHJ P,TYOERR + JRST .+1] + SKIPE B,$FDIR(F) ; Directory? + JRST [ MOVEI A,"< + PUSHJ P,TYOERR + PUSHJ P,TYPZ + MOVEI A,"> + PUSHJ P,TYOERR + JRST .+1] + SKIPE B,$FNAME(F) + PUSHJ P,TYPZ + MOVEI A,". + PUSHJ P,TYOERR + SKIPE B,$FEXT(F) + PUSHJ P,TYPZ + MOVEI A,". ; 20X uses "." to set off version, + TLNN FF,FL20X ; but 10X uses ";". + MOVEI A,"; + PUSHJ P,TYOERR + HRRE A,$FVERS(F) + JUMPL A,[MOVM B,A ; Is possible to have -1, -2, etc. + MOVEI A,"- + PUSHJ P,TYOERR + MOVE A,B + JRST .+1] + PUSHJ P,DPNT ; Version # output in decimal. + SKIPE $FTEMP(F) + TYPE ";T" ; May be temporary. + SKIPE B,$FPROT(F) + JRST [ TYPE ";P" + PUSHJ P,TYPZ + JRST .+1] + SKIPE B,$FACCT(F) + JRST [ TYPE ";A" + PUSHJ P,TYPZ + JRST .+1] + POPJ P, + + ; Takes BP in B, outputs to TYOERR until zero byte seen. +TYPZ: CAIA + PUSHJ P,TYOERR + ILDB A,B + JUMPN A,TYPZ+1 + POPJ P, +] ; IFN TNXSW + +SUBTTL TENEX misc. Filename Routines, FS string storage + +IFN TNXSW,[ .SEE FSDSK ; Part of this page is NOT conditionalized!! + +; To handle filenames of ASCIZ strings instead of SIXBIT words, each +; word has instead a byte pointer to an ASCIZ string. For purposes of +; easy comparison, all of these bp's point into FNBUF, and a routine +; (FNCHK) is provided which checks a just-stored string and returns a bp +; to either this string, if unique, or to a previously stored string if +; it is the same as the one just stored (which is then flushed). Thus +; strings can be compared for equality simply by a comparison of their +; byte pointers. While not necessary, strings are stored beginning on +; word boundaries for easier hacking. + + ; <# files>**+<# wds for constants> +LFNBUF==*5*3+20 ; Enough to hold strings for all output files, + ; all translated files, and all .insrt files encountered. + ; Later a GC'er can be hacked up so that of the latter only + ; enough for the max .insrt level need be allocated. + +LVAR FNBUF: BLOCK LFNBUF + + ; Macro to easily define constant strings for comparison purposes +DEFINE DEFSTR *STR* +440700,,%%FNLC +%%LSAV==. +LOC %%FNLC +ASCIZ STR +%%FNLC==. +LOC %%LSAV +TERMIN + %%FNLC==FNBUF +] ; IFN TNXSW!!! + + ; If not assembling for TENEX, the following strings become + ; simple SIXBIT values. This makes it possible to write simple + ; code to work for both TENEX and non-TENEX without messy conditionals. + +IFE TNXSW,[EQUALS DEFSTR,SIXBIT] + +FSDSK: DEFSTR /DSK/ ; This stuff defines various BP's into FNBUF to +FSSYS: DEFSTR /SYS/ ; use for comparison purposes later. +FSTTY: DEFSTR /TTY/ +FSNUL: DEFSTR /NUL/ +FSPTP: DEFSTR /PTP/ +FSATSN: DEFSTR /@/ +FSSBSY: DEFSTR /SUBSYS/ +FSPROG: DEFSTR /PROG/ +FSMID: DEFSTR /MID/ +FSMDAS: DEFSTR /MIDAS/ +FSGRTN: DEFSTR />/ +FSCRF: DEFSTR /CRF/ +FSCREF: DEFSTR /CREF/ +FSERR: DEFSTR /ERR/ +FSLST: DEFSTR /LST/ +FSLIST: DEFSTR /LIST/ +FSSAV: DEFSTR /SAV/ +FSEXE: DEFSTR /EXE/ + +IFN TNXSW,[ +VBLK +FNBBP: 440700,,FNBUF ; Points to beg of FNBUF (hook for dynamic alloc) +FNBEP: FNBUF+LFNBUF-1 ; Points to last wd in FNBUF (address, not BP) +FNBWP: 440700,,%%FNLC ; Write Pointer into FNBUF. +FNBLWP: 440700,,%%FNLC ; Last Write Pointer, points to beg of string being stored +PBLK +EXPUNG %%FNLC + +; NOTE - provided MIDAS never restarts, no initialization is necessary to +; start using FNCHK. (Unless of course FNBUF is dynamically allocated someday) + +; FNCHK - Check out just-stored filename. Returns BP in A to ASCIZ string, +; which will be "canonical" for comparison purposes. +; Clobbers A,B,T,TT,AA +; FNCHKZ - Makes sure just-writ string is ASCIZ'd out before FNCHK'ing. + +FNCHKZ: MOVE B,FNBWP ; Get write ptr, + LDB A,B ; see if last char was 0, + JUMPE A,FNCHK0 ; if so can skip one clobberage. + SETZ A, + IDPB A,B ; zero out bytes, +FNCHK0: TLNE B,760000 ; until at end of word. + JRST .-2 + ADD B,[<440700,,1>-<010700,,>] ; bump BP to point canonically at next. + MOVEM B,FNBWP + +FNCHK: HRRZ B,FNBWP ; See if write ptr + CAML B,FNBEP ; has hit end of FNBUF, and + ETF [ASCIZ /Filename buffer overflow/] ; barf horribly if so. + MOVE A,FNBBP ; A - bp to start of existing string + MOVE AA,FNBLWP ; AA - bp to start of new string to store +FNCHK2: MOVEI T,(A) ; T - current addr being checked, existing str + MOVEI TT,(AA) ; TT - current addr, new str + CAIL T,(TT) ; If addrs are same, or overran somehow, + JRST [ MOVE A,AA ; didn't find any match, accept new string. + MOVE B,FNBWP + MOVEM B,FNBLWP ; Set up new last-write-ptr + POPJ P,] +FNCHK3: MOVE B,(T) + CAMN B,(TT) ; Compare strings, full word swoops. + JRST [ TRNE B,377 ; equal, last char zero? + AOJA T,[AOJA TT,FNCHK3] ; no, continue for whole string + ; Found it! Flush just-stored string, don't want duplicate. + MOVEM AA,FNBWP ; Clobber write ptr to previous value. + POPJ P,] + ; Not equal, move to next string to compare + MOVEI B,377 ; Check for ASCIZ, + TDNE B,(T) ; moving to end of current string + AOJA T,.-1 + HRRI A,1(T) ; and updating BP to point at new string. + JRST FNCHK2 ; (T gets pointed there too at FNCHK2). + +; JFNSTR - Get filename strings for active JFN. +; A/ active JFN +; F/ addr of filename block to clobber. +; JFNSTB - Same, but ignores A and assumes JFN is already stored in block. +; Clobbers A,C + +JFNSTB: SKIPA A,$FJFN(F) ; JFNSTB gets the JFN from block itself. +JFNSTR: MOVEM A,$FJFN(F) ; whereas JFNSTR stores it there... + MOVSI D,-NJSTRF ; Set up aobjn thru table. +JFNST2: PUSH P,T + SYSCAL JFNS,[FNBWP ? $FJFN(F) ? JSTRFX+1(D)][FNBWP] + POP P,T + MOVE C,JSTRFX(D) ; Now get index to place it belongs in file block, + CAIN C,$FVERS ; and check for this, because + JRST [ MOVE A,FNBLWP ; it wants to be a number, not a string. + MOVEM A,FNBWP ; Zap write pointer back to forget string, + PUSHJ P,CVSDEC ; and quickly convert before anything clobbers it. + JRST .+2] ; Skip over the FNCHKZ call. + PUSHJ P,FNCHKZ ; Fix it up, and get BP to it. + ADDI C,(F) ; make it an addr, and + MOVEM A,(C) ; store BP. (or value, for $FVERS) + ADDI D,1 + AOBJN D,JFNST2 + POPJ P, + + ; Filblk idx, output format wd for JFNS call +JSTRFX: $FDEV ? 100000,, + $FDIR ? 010000,, + $FNAME ? 001000,, + $FTYPE ? 000100,, + $FVERS ? 000010,, +NJSTRF==<.-JSTRFX>/2 + +; CVSDEC - Converts ASCIZ string to decimal, assumes only digits seen. +; A/ BP to ASCIZ +; Returns value in A, clobbers nothing else. + +CVSDEC: PUSH P,B + PUSH P,C + MOVE C,A + SETZ A, + JRST CVSDC3 +CVSDC2: IMULI A,10. + ADDI A,-"0(B) +CVSDC3: ILDB B,C + JUMPN B,CVSDC2 + POP P,C + POP P,B + POPJ P, + +; CVSSIX - Converts ASCIZ string to SIXBIT word. +; A/ BP to ASCIZ string, +; Returns SIXBIT word in A. Clobbers nothing else. + +CVSSIX: PUSH P,B + PUSH P,C + PUSH P,D + MOVE D,A + SETZ A, + MOVE B,[440600,,A] + JRST CVSSX3 +CVSSX2: CAIL C,140 + SUBI C,40 ; Uppercase force + SUBI C,40 ; cvt to 6bit + IDPB C,B ; deposit + TLNN B,770000 ; If BP at end of word, + JRST CVSSX5 ; leave loop. +CVSSX3: ILDB C,D + JUMPN C,CVSSX2 +CVSSX5: POP P,D + POP P,C + POP P,B + POPJ P, + +; CV6STR - Takes 6bit word in A, writes into FNBUF and makes a string of +; it, returning BP in A. +; Clobbers A,B,T,TT,AA (due to FHCHKZ) + +CV6STR: MOVE B,A +CV6ST2: SETZ A, + LSHC A,6 ; Get a 6bit char + ADDI A,40 ; Make ASCII + IDPB A,FNBWP ; deposit + JUMPN B,CV6ST2 ; Continue until nothing left + PJRST FNCHKZ ; Make output thus far a string. + + +; CVFSIX - Takes current filblk (pointed to by F) and puts the +; right stuff in $F6 entries. + +CVFSIX: PUSH P,A + PUSH P,B + MOVSI B,-L$F6BL +CVFSX2: MOVE A,@CVFTAB(B) ; Get BP to string + PUSHJ P,CVSSIX ; Convert to 6bit + ADDI B,$F6DEV(F) ; Get index to right place to store. + MOVEM A,(B) + SUBI B,$F6DEV(F) ; restore aobjn pointer... + AOBJN B,CVFSX2 + POP P,B + POP P,A + POPJ P, + +CVFTAB: $FDEV(F) + $FNAME(F) + $FEXT(F) + $FDIR(F) +IFN <.-CVFTAB>-L$F6BL, .ERR CVFTAB loses. + +] ; IFN TNXSW + +SUBTTL DEC/TENEX - RUN hacking. (Process FOO! in CCL) +IFN DECSW,[ + +; Process "FOO!", which means "run SYS:FOO with an offset of 1". +; Note that the RUN call needs a block of 6 ACs, but at this point +; it doesn't matter what gets clobbered. + + + ; Entry point for restart, from TSRETN. +RERUN: MOVE B,FSMDAS ; Get name - using SYS:MIDAS + SETZB C,D+1 ; (no ext or ppn) + JRST RFDRU1 + +VBLK + +RFDRUN: MOVE A,$F6DEV(F) ; Load up the 4 filenames to use. + MOVE B,$F6FNM(F) + MOVE C,$F6EXT(F) + MOVE D+1,$F6DIR(F) + JUMPN A,RFDRU3 ; If device specified, use that, + MOVSI A,'DSK ; else default to DSK + CAIN D+1, ; if a PPN was given, and +RFDRU1: MOVSI A,'SYS ; to SYS: otherwise. +RFDRU3: SETZB D,D+2 ; These acs must always be zero... + MOVEI D+3,177 ; Flush all core above this address. +IFN SAILSW,[ + SETZ D+4, + CORE2 D+4, ; Flush hiseg by hand on SAIL. + HALT + ] +.ELSE HRLI D+3,1 ; Elsewhere, just set LH to this to flush hiseg. + + MOVE D+4,[RUNCOD,,D+5] ; Move core-less code into position in ACs. + BLT D+4,+LRUNCD-1 + MOVE D+4,[1,,A] ; ,,
+ JRST D+5 ; Go flush core and run program. + +RUNCOD: CORE D+3, ; Flush as much core as possible; RUN uuo can lose + HALT ; Because of how much we have. + RUN D+4, + HALT +LRUNCD==.-RUNCOD + ; Make sure symbols A-D leave enuf room. +IFL 17-, .ERR RFDRUN ACs lose. +PBLK +] ;END IFN DECSW + +IFN TNXSW,[ + ; On TENEX, we'll do things without compat package (boo hiss) + + ; Entry point for starting new MIDAS, come here from TSRETN. +RERUN: MOVEI F,FB + BLTZ L$FBLK,FB ; Clear out scratch filblk, point at it. + MOVE A,FSMDAS ; Get BP to "MIDAS", store in + MOVEM A,$FNAME(F) ; filblk, and drop thru for defaults. + + ; Here to start up specified program, for CCL hacking. +RFDRUN: TLNN FF,FL20X ; 20X or Tenex? + JRST [ MOVE A,FSSBSY ; Tenex, get BP to SUBSYS string + SKIPN $FDIR(F) ; Unless directory specified, + MOVEM A,$FDIR(F) ; default dir to . + MOVE A,FSSAV ; And do similar thing for ext (.SAV) + JRST RFDRN2] + MOVE A,FSSYS ; 20X, get BP to SYS string + SKIPN $FDEV(F) ; Unless device specified, + MOVEM A,$FDEV(F) ; default dev to SYS:. + MOVE A,FSEXE ; And ditto for ext (.EXE) + +RFDRN2: SKIPN $FEXT(F) ; If extension not specified, + MOVEM A,$FEXT(F) ; Store appropriate one. + PUSHJ P,GETJFI ; Get JFN for input... + HALT ; Ugh, bletch, etc. + + ; OK, all ready to smash ACs with loader, etc. + MOVE R1,$FJFN(F) ; Put JFN into RH + HRLI R1,.FHSLF ; and fork handle (self) in LH. + MOVE R2,[RUNCOD,,R3] ; Load into ACs beginning at AC 3 + BLT R2,R3+LRUNCD-1 + JRST R3 ; Off we go, never to return... + + ; Following code is executed in AC's, position independent. +RUNCOD: GET ; Load up the file. + MOVEI R1,.FHSLF + GEVEC ; Find entry vector word for it, returned in AC 2. + JRST R1(R2) ; and go execute instruction in reenter slot. +LRUNCD==.-RUNCOD ; Pretty small loader, huh? +] ; IFN TNXSW + +SUBTTL Core Allocation routine - GCCORQ gets another K for MACTAB + +; Get another K of MACTAB space. + +GCCORQ: MOVE A,MACHI + LSH A,-2 ; Convert to word # + CAIL A,MXMACL ; Want more than allowed? + POPJ P, + MOVE A,MACTND ; No, get addr of block we want to get. + PUSH P,A ; Entry, save A in case have to try again +CORRQ1: +IFN ITSSW,[ + LSH A,-10. + SYSCAL CORBLK,[MOVEI %CBNDR+%CBNDW + MOVEI %JSELF ? A ? MOVEI %JSNEW] + JRST CORRQL ; Lose +] +IFN DECSW,[ + IORI A,1777 + CORE A, + JRST CORRQL ; Lose +] +IFN TNXSW,[ + SKIPN MEMDBG ; Only need to hack if want. + JRST CORRQ3 + ; Super kludge. No way to ask 10X for a "new page"; must + ; get it via default create-on-reference. Hence to get page + ; without bombing, must be sure .ICNXP interrupt deactivated! + PUSH P,T + SYSCAL DIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Deactivate. + SETZM (A) ; Reference 1st page + SETZM 1000(A) ; Reference 2nd page. + SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Re-activate. + POP P,T +CORRQ3: +] + + REST A + ADDI A,2000 + JRST MACIN2 ; Update pointers to end of MACTAB. + +IFN ITSSW\DECSW,[ + ; Lossage handler for GCCORQ. Only ITS or DEC can fail. +CORRQL: PUSH P,C + PUSH P,D + TLOE AA,400000 + JRST CORQL1 + TYPE " +No core for macro table." +CORQL1: TYPE " +Try again? " +CORQL2: PUSHJ P,TYI ; Get char + CAIL A,140 ; Cheap uppercase force + SUBI A,40 + CAIN A,"Y ; Y, + JRST CORRQA ; => try again + CAIN A,"N ; N, + JRST CORRQB ; => back to DDT then try again + CAIN A,"? ; ?, + ERJ CORQL1 ; => type out error-type blurb + TYPE "? " ; something else + JRST CORQL2 + +CORRQB: +IFN ITSSW,.VALUE ; Loop point for don't-proceed +IFN DECSW,EXIT 1, + TLZ AA,400000 +CORRQA: POP P,D + POP P,C + MOVE A,(P) ; Restore A from PDL + JRST CORRQ1 +] ; IFN ITSSW\DECSW + +SUBTTL Core allocation - TENEX routine to get pages (TCORGT) + +IFN TNXSW,[ + +; TCORGT - Takes arg in AA, an ITS page AOBJN to pages to grab. +; Clobbers no ACs but AA. + +TCORGT: JUMPGE AA,APOPJ ; Ignore arg if nothing to do about it. + SKIPN MEMDBG ; Ignore anyway if not hacking memory + POPJ P, + PUSH P,R1 + PUSH P,R2 + PUSH P,R3 + MOVE R3,AA + ASH R3,1 ; Get Tenex page AOBJN + MOVEI R1,(R3) + LSH R1,9. ; Get word address of first page. + HRR R3,R1 ; Stick back in AOBJN. + + ; Super kludge. No way to ask 10X for a "new page"; must + ; get it via default create-on-reference. Hence to get page + ; without bombing, must be sure .ICNXP interrupt deactivated! + MOVEI R1,.FHSLF + MOVE R2,[1_<35.-.ICNXP>] + DIC ; Deactivate. +TCORG3: SETZM (R3) ; Get the page. + ADDI R3,777 ; Bump word address, + AOBJN R3,TCORG3 ; and get next page (note adds 1 more to RH) + AIC ; Now re-activate... + POP P,R3 + POP P,R2 + POP P,R1 + POPJ P, +] ;IFN TNXSW diff --git a/src/midas/tsrtns.181 b/src/midas/tsrtns.181 new file mode 100644 index 00000000..c69532ff --- /dev/null +++ b/src/midas/tsrtns.181 @@ -0,0 +1,4189 @@ +;-*-MIDAS-*- + +SUBTTL TS Definitions, parameters + + ; For convenience in defining isolated variables/tables, + ; especially when have to know on pass1 where the + ; table is going to be (.VECTOR etc don't know until end of pass) +DEFINE LVAR -LINE +VBLK +LINE +PBLK +TERMIN + +DEFINE TMPLOC AT,STUFF +%%%TLC==. ? LOC AT + STUFF +LOC %%%TLC +TERMIN + + ; Nice macro for minimizing coding. Doesn't hack indirection tho. + ; Could conceivably optimize to do MOVE AC,[FROM,,TO] but that + ; would be overly hairy for something you can do just by writing + ; 2 instructions. +DEFINE BLTMAC AC,LEN,FROM,TO + MOVSI AC,FROM + HRRI AC,TO + BLT AC,TO+LEN-1 +TERMIN + + ; Also handy for standard zaps (and nice mnemonic) + ; won't work for indirection either. +DEFINE BLTZAC AC,LEN,FROM + SETZM FROM + MOVEI AC,FROM+1 + HRLI AC,-1(AC) + BLT AC,FROM+LEN-1 +TERMIN + + ; More convenient when A is clobberable... +DEFINE BLTM LEN,FROM,TO +BLTMAC A,LEN,FROM,TO +TERMIN + +DEFINE BLTZ LEN,FROM +BLTZAC A,LEN,FROM +TERMIN + + ; Following inserts a SYSCAL for JSYS's. Be warned that it + ; clobbers T when used!! +IFN TNXSW,.INSRT XJSYS + +IFNDEF PMAPSW,PMAPSW==TNXSW ; 1 to assemble PMAP input, 0 for SIN input. +IFNDEF ERRSW,ERRSW==1 ; 1 for error file output capability. + +IFNDEF TYPDLC,TYPDLC==7 ; Maximum total depth of .insrt (including tty) +IFNDEF MX.INS,MX.INS==5 ; Maximum depth .insrt files only +IFNDEF MAXIND,MAXIND==6 ; Maximum # @: table entries for .insrt + + ; Define sizes of various I/O buffers +IFN DECSW,[ +IFNDEF DECBFL,DECBFL==203 ; Standard DEC buffer size for DSK (200 wds data) +IFN SAILSW,IFNDEF NINBFS,NINBFS==19. ; For SAIL, hack full disk track of input. +IFNDEF NINBFS,NINBFS==2 ; # standard-size buffers to use for input. +IFNDEF UTIBFL,UTIBFL==*NINBFS ; Input buffs need 1 wd for EOB hacking +IFNDEF UTOBFL,UTOBFL==DECBFL ; All output chans have just 1 buffer. +IFNDEF CRFBSZ,CRFBSZ==DECBFL +IFNDEF LSTBSZ,LSTBSZ==DECBFL +IFNDEF ERRBSZ,ERRBSZ==DECBFL +] ;DECSW +IFNDEF CMBFL,CMBFL==50 ; Length of command buffer. +IFNDEF UTIBFL,UTIBFL==400 ; " Input buffer. +IFNDEF UTOBFL,UTOBFL==200 ; " BIN output buffer. +IFNDEF CRFBSZ,CRFBSZ==200 ; " CREF output buffer. +IFNDEF LSTBSZ,LSTBSZ==200 ; " LIST output buffer. +IFNDEF ERRBSZ,ERRBSZ==1 ; " ERR output buffer. Very small to avoid + ; losing much data if things crash. + + +ERRC==0 ; Err device input channel +TYIC==1 ; TTY input channel +TYOC==2 ; TTY output channel +CREFC==3 ; CREF output +UTYOC==4 ; BIN output +LPTC==5 ; LIST output (LPT) +ERRFC==6 ; ERR Assembly error output file. +UTYIC==7 ; 1st input channel, UTYIC+n used for nth .INSRT level in dec version. + +SUBTTL File Description Storage (FILBLK's) + +VBLK + ; Definitions for indices into a FILBLK. + + ; Scratch block FB is formed while defining indices... +FB: OFFSET -. + ; Lots of crocks depend on the exact order of these 4 items. +$F6DEV:: 0 ; SIXBIT Device name +$F6FNM:: $F6FN1:: 0 ; SIXBIT Filename (on ITS, FN1) +$F6TYP:: $F6FN2:: $F6EXT:: 0 ; SIXBIT Extension (on ITS, FN2) +$F6DIR:: 0 ; SIXBIT Directory (may be numerical PPN) + L$F6BLK==. +IFN TNXSW,[ ; Almost all entries here are BP's to ASCIZ strings. +$FDEV:: 0 ; Device name +$FDIR:: 0 ; Directory name +$FNAME:: 0 ; File name (i.e. main name) +$FTYPE:: $FEXT:: 0 ; File type (or extension) +$FVERS:: $FGEN:: 0 ; File version (or generation). NUMBER, not string. +$FTEMP:: 0 ; -1 => File is a temporary file. +$FACCT:: 0 ; Account string +$FPROT:: 0 ; Protection string +$FJFN:: 0 ; JFN for file (may be ,,) +] +IFN ITSSW\DECSW,[ +$FDEV==:$F6DEV ; These definitions made so some common code can do +$FDIR==:$F6DIR ; the right things. +$FNAME==:$F6FNM +$FTYPE==:$F6TYP +$FEXT==:$F6TYP +] + L$FBLK==. ; Length of a FILBLK. + OFFSET 0 ; End of index definitions. + + + ; FILBLK's for various files + +ISFB: BLOCK L$FBLK ; Input file specification as given in command line. +INFB: BLOCK L$FBLK ; Actual current input file. +OUTFB: BLOCK L$FBLK ; Output file + +IFN CREFSW, CRFFB: BLOCK L$FBLK ; CREF output file +IFN LISTSW, LSTFB: BLOCK L$FBLK ; Listing output file +IFN ERRSW, ERRFB: BLOCK L$FBLK ; Error output file + +INFCNT: 0 ; AOS'd each time an input file is opened. +INFCUR: 0 ; What INFCNT was when current file opened. +INFERR: 0 ; What INFCUR held at last err msg. + +INDDP: MAXIND,,TBLOFS ; Pointer into tables below +TBLOFS: BLOCK MAXIND*L$FBLK ; Actual filenames corresponding to those in TBLSFS, for opening. +TBLSFS: BLOCK MAXIND*L$FBLK ; Source-specified filenames for @: files + + +RFNAM1: 0 ; .FNAM1 +RFNAM2: 0 +IFNM1: 0 ; .IFNM1 +IFNM2: 0 +INFFN1==:INFB+$F6FN1 ; Some crocks seem to reference this. +OFNM1==:OUTFB+$F6FN1 ; Pseudo .OFNM1 needs this. +OFNM2==:OUTFB+$F6FN2 ; ditto, .OFNM2 +RSYSNM: 0 ; Initial system name +PBLK + +SUBTTL I/O Buffers + +VBLK ; Input buffer and variables + +UTIBUF: BLOCK UTIBFL +UTIHDR: 0 ; Input buffer header (dec version) +UREDP: 440700,,UTIBUF ; Input byte pointer +UTICNT: 0 ; Input byte count (dec version) +IUREDP: 440700,,UTIBUF ; Initial UREDP, used for re-initializing. +UTIBED: UTIBUF ; EOF comparison with RH(UREDP), 4.9 => EOF on .IOT + +IFN DECSW,UTICHN: UTYIC + + ; BIN Output buffer + +UTOBUF: BLOCK UTOBFL ; Output buffer +UTOHDR: UTOBFL,,UTOBUF-1 +UTYOP: 444400,, ; Output (36. bit) byte pointer +UTYOCT: 0 ; # words left in utobuf +IFN ITSSW,OCLOSP: @1(C) ; Turned into bp to unused part of last bffer wd used. + + ; CREF output buffer +IFN CREFSW,[ +CRFBUF: BLOCK CRFBSZ +CRFHDR: CRFBSZ,,CRFBUF-1 ; Header, assembled value used only ifn itssw +CRFPTR: 444400,, ; Bp for filling buffer (full words) +CRFCNT: 0 ; Num. wds. empty in buffer +] + + ; LISTing output buffer +IFN LISTSW,[ +LSTBUF: BLOCK LSTBSZ +LSTHDR: 5*LSTBSZ,,LSTBUF-1 +LSTPTR: 440700,, +LSTCNT: 0 +] + + ; ERRor output buffer +IFN ERRSW,[ +ERRBUF: BLOCK ERRBSZ +ERRHDR: 5*ERRBSZ,,ERRBUF-1 +ERRPTR: 440700,, +ERRFCT: 0 ; Can't call this ERRCNT since that's used for # errors. +ERRFP: 0 ; Non-0 if want error output file. +ERRFOP: 0 ; Non-0 if error file open (ie try outputting to it) +] +PBLK + +SUBTTL Interrupt Handling + +; Note that only PDL OV is now enabled in general. +; TTY input interrupts are also handled when possible for +; ^H, ^W, and ^V. + +.SCALAR INTSVP ; Saves P on interrupt for debugging + +IFN ITSSW,[ + TMPLOC 42, JSR TSINT ; Interrupt vector for ITS +VBLK +.JBCNI: +TSINT: 0 ; 1st wd interrupts currently considered fatal errors. +.JBTPC: 0 ; Error processor re-enables interrupts + .SUSET [.RJPC,,INTJPC] + SKIPGE TSINT + JRST TTYINT ; Second-word ints. + JRST TSINT1 ; Jump into pure coding and process interrupt +INTJPC: 0 ; Saves .JPC at interrupt. +PBLK + ; Jrst here from TSINT for 2nd wd interrupts. +TTYINT: PUSH P,A + MOVEI A,TYIC ; The tty chnl is the only one enabled. + .ITYIC A, + JRST TTYINX ; No int. char. + CAIN A,^W + AOS TTYFLG ; ^W silences, + CAIN A,^V + SOS TTYFLG ; ^V unsilences, + CAIN A,^H + SETOM TTYBRF ; ^H says break next time thru ASSEM1 loop. +TTYINX: REST A + .DISMIS .JBTPC +] ; IFN ITSSW + +IFN DECSW, TMPLOC .JBAPR, TSINT1 ; Interrupt vector for DEC + +IFN ITSSW\DECSW,[ + ; Amazing but can use almost same basic rtn for both! + +TSINT1: MOVEM P,INTSVP ; Save P for possible debugging +IFN ITSSW,.SUSET [.SPICL,,[-1]] ; For ITS, re-enable ints. + MOVE A,.JBCNI ; Get interrupt request word + TRNE A,200000 ; PDL overflow? + JRST CONFLP + MOVE B,[TYPE "Unknown interrupt - Fatal"] ; anything else. + MOVEM B,40 + MOVE A,.JBTPC ; So error routine will print out properly + JSA A,ERROR +] + +IFN TNXSW,[ + ; TENEX Interrupt handler +; Note that NXP (non-ex page) is enabled, but no provision is +; currently made for handling it. This causes process termination and +; EXEC will print error message. If NXP wasn't enabled, a page would +; simply be created without fuss (page is always created, incidentally, +; whether or not interrupt happens) + +LVAR MEMDBG: 0 ; For nonce, this gets set when PURIFG does. + +LEVTAB: INTPC1 ; Where to store PC for level 1 interrupt. + 0 ? 0 ; Levels 2 and 3 unused. +CHNTAB: BLOCK 36. ; Where to go for indicated condition. Most zero. + +.IC.CV==1 ; Define user channel 1 for ^V interrupt +.IC.CW==2 ; " 2 for ^W +.IC.CH==3 ; " 3 for ^H +%%LSV==. +LOC CHNTAB+.ICPOV ? 1,,TSINT1 ; Put right word in CHNTAB for PDL OV dispatch. +LOC CHNTAB+.IC.CV ? 1,,INT.CV ; Ditto for ^V dispatch +LOC CHNTAB+.IC.CW ? 1,,INT.CW ; " ^W +LOC CHNTAB+.IC.CH ? 1,,INT.CH ; " ^H +LOC %%LSV + +.SCALAR INTPC1 ; Level 1 interrupt PC stored here. + + ; Handle PDL OV interrupt +TSINT1: MOVEM P,INTSVP ; Save PDL ptr. + MOVEI A,CONFLP ; OK to clobber A in PDLOV. + MOVEM A,INTPC1 ; Dismiss to CONFLP. + DEBRK ; Off we go. + + ; Handle ^V interrupt +INT.CV: SOS TTYFLG ; Unsilence typeout + DEBRK + + ; Handle ^W +INT.CW: AOS TTYFLG ; Silence typeout + DEBRK + + ; Handle ^H +INT.CH: SETOM TTYBRF ; Set flag to check at main level ASSEM1 loop. + DEBRK +] + +SUBTTL MIDAS BEGINS HERE - Program Startup + +VBLK +NVRRUN: -1 ; 0 => MIDAS was run; error to start or purify. +FATAL: 0 ; At end of assembly, not 0 iff fatal error occurred. +PBLK + +BEG: ; Start address! +IFN DECSW\TNXSW,[ + TDZA A,A + SETO A, + MOVEM A,CCLFLG ; Remember type of start-up +] + SETZ FF, ; Initialize flags + MOVE P,[-LPDL,,PDL-1] ; Initialize P + +IFN DECSW,[ + RESET + MOVEI A,600000 + APRENB A, +] + ; For TENEX, must determine right away which system we're on. +IFN TNXSW,[ + RESET +; TLZ FF,FL20X ; Assume 10X until proven otherwise. (done by SETZ above) + +IFN 0,[ ; One way of determining OS which doesn't work on some places. + MOVE A,[112,,11] ; Magic word that will win on 10X,T20 (and maybe T10) +GETTAB=<047000,,41> ; CALLI 41 + GETTAB A, ; Returns 10000 T10, 20000 ITS, 30000 10X, 40000 T20 + MOVEI A,30000 ; Shouldn't ever fail, but if it does, assume 10X. + LDB A,[140300,,A] ; Flush other fields too + CAIN A,4 ; = Tops-20? + TLO FF,FL20X ; Yes, set flag. +]; IFN 0 +IFN 0,[ ; This is a loser too, since there ARE KL Tenices! + SETZ A, ; In lieu of above, use hardware hack... + BLT A, ; test for KL-ness. + CAIE A, + TLO FF,FL20X ; KL will fail to skip, assume that means 20X OS. +];IFN 0 +IFN 1,[ ; Boy I hope DEC never defines LOADTB! -- MRC + SYSCAL SYSGT,[['LOADTB]][A ? D] + SKIPN D ; If LOADTB is not defined + TLO FF,FL20X ; it must be a Twenex +]; IFN 1 + + SYSCAL SCVEC,[[.FHSLF] ? [-1]] ; and flush compat package, + ; disabling UUO's 40-77; this is good for debugging. + + ; Set up stuff for interrupts + SYSCAL SIR,[[.FHSLF] + [LEVTAB,,CHNTAB]] ; Specify tables + SYSCAL EIR,[[.FHSLF]] ; Enable interrupts + SYSCAL AIC,[[.FHSLF] ; Activate PDL OV and ^V, ^W, ^H +[IRP BIT,,[.ICPOV,.IC.CV,.IC.CW,.IC.CH] +<1_<35.-BIT>>+!TERMIN ]] + SYSCAL ATI,[[.TICCV,,.IC.CV]] ; Make various mappings from + SYSCAL ATI,[[.TICCW,,.IC.CW]] ; terminal bits to int. channels. + SYSCAL ATI,[[.TICCH,,.IC.CH]] ; What a losing interrupt sys 10X has! + SKIPN MEMDBG ; Hacking memory? + JRST BEG20 + MOVSI A,-2*MINMAC ; If so, must create pages for initially-zero + MOVE B,(A) ; core, by referencing them all. + ADDI A,777 + AOBJN A,.-2 + SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Then enable ints +BEG20: ; for Non-eXistent Pages. +] + +IFN ITSSW,[ + MOVE A,[-5,,[ ; Set and read various vars in a chunk. + .SMASK,,[%PIPDL] ; 1st-wd Interrupt only on PDL ovfl. + .SMSK2,,[1_TYIC] ; 2nd-wd on TTY input channel. + .SPICL,,[-1] ; and enable interrupt system. + .RSNAM,,RSYSNM ; Get system name (default dir to use) + .RXJNAM,,B ]] ; and XJNAME for temp. hacking below. + .SUSET A + SYSCAL TTYSET,[1000,,TYIC ; Set TTYST wds - PI echo, no act/int + [232020,,202020] ; except ctls activate & interrupt + [232020,,220220]] ; CR, DEL activate but don't int; + ; DEL doesn't echo. +] + + AOSE NVRRUN ; Test for this job's already being run... + JRST [ TYPE "Can't restart MIDAS" + JRST TSRETN] + + MOVEI D,SYMDSZ ; Get default symtab size +IFN ITSSW,[ ; Remember that B set to XJNAME above. + CAME B,['MMIDAS] ; Set symtab size larger for MMIDAS + CAMN B,[SIXBIT/MM/] ; (random sort of hack now that .SYMTAB exists) + MOVEI D,SYMMSZ +] + SKIPGE ISYMF ; The first time through, + MOVEM D,SYMLEN ; Make that the size to use. + CALL SITINI ; Initialize stuff for .SITE. + CALL JCLINI ; Now try to fetch JCL; set CMPTR accordingly. +IFN ITSSW,[ + SKIPGE ISYMF ; Skip if syms spread; if not, + CALL TSYMGT ; get TS syms from system. +] + SKIPE CMPTR ; If have JCL, + JRST GO2AA ; skip announcing midas's name and version. + +IFG PURESW-DECSW,[ ; If meaningful, + SKIPGE PURIFG ; Check for purity + TYPE "NOTPUR " ; and type little warning if unpurified. + ] + TYPE "MIDAS." ; and announce self. + MOVE B,[MIDVRS] + PUSHJ P,SIXTYO + JRST GO2AA + +SUBTTL MIDAS Top-level control path + +GO2A: SETZM CMPTR ; Recycles here, so JCL only hacked once. +GO2AA: SETOM FATAL ; Assume fatal errors, unless cleared at GO8 when done. + SETZM TTYFLG ; Allow TTY typeout. + SETZM ERRCNT ; Initialize error counter (total errors) +IFN RUNTSW,[ PUSHJ P,RNTTMA ; Get initial run time. + MOVEM A,IRUNTM] + SETZM LSTTTY ; Tell TYOERR not to try output to LST file (none yet!) + PUSHJ P,CMD ; Get typed in command (or scan cmd line if CMPTR ne 0) + + SKIPGE SMSRTF ; What's this for, I wonder? + JRST GO21 + TYPECR "SYMTAB clobbered" + JRST GO2A + + ; Filenames and switches all specified, now see if files can be set up. +GO21: PUSHJ P,OPNRD ; Open input file + JRST GO2A ; Error, msg was typed, go try again with new cmd line. + PUSHJ P,WINIT ; Open output file, cref file. +IFN DECSW\TNXSW,[ + SKIPGE CCLFLG + TYPE "MIDAS: " +] +IFN A1PSW,[ + SETOM PRGC + SETOM OUTC +GO3: ] + MOVE A,WSWCNT + MOVEM A,TTYFLG ; Turn off typeout if there were (W) switches. + SETOM LSTTTY ; Allow TYOERR to output to both TTY and LST. + JSP A,$INIT ; Initialize for assembly + JSP A,PS1 ; Do pass 1 + TRNN FF,FRNPSS ; If 2 pass assembly, + JRST GO4 + PUSHJ P,OPNRD ; Then re-open input file + JRST GO2A ; Couldn't re-open???? Do something better here. +GO4: JSP A,PLOD ; Maybe punch out SBLK loader in some format + JSP A,PS2 ; Do pass 2 + JSP A,PSYMS ; Maybe punch out symbol table +IFN A1PSW,[ + TLZ FF,$FLOUT + AOS PRGC ; Indicate end statement encountered + SETOM OUTC ; " " " + TRNN FF,FRNPSS ; If 1 pass assembly, + SKIPGE CONTRL + CAIA + JRST GO3 ; Then try to assemble another program +] +IFN FASLP,[ + SKIPGE A,CONTRL + TRNN A,FASL + JRST GO8 + MOVE A,[SIXBIT /*FASL*/] ; "finish" FASL file + MOVEI B,17 + PUSHJ P,FASO ; Ignore end frob, but output FASL end code + MOVE A,[ASCIC//] ; pad with ^C's. + PUSHJ P,FASO1 ; Randomness + PUSHJ P,FASBE ; Write out last block +] + ; Jump directly here for certain main-input EOF conditions. +GO8: SETZM FATAL ; There was no fatal error: output files get renamed. + + ; Jump directly here if hit fatal error (incl .FATAL, illegal UUO, etc) +GO9: PUSHJ P,.FILE ; Close (and rename if FATAL = 0) output files. + SETZM LSTTTY +IFN RUNTSW, PUSHJ P,RNTTYO ; Type out run time used since GO2A + CALL ERRCLS ; File away error file - only thing not closed by .FILE + JRST TSRETN ; and die according to system's wishes. + +SUBTTL MIDAS Death (TSRETN) - system dependent exit routines + +IFN ITSSW,[ +TSRETN: +IFN PURESW,[ + SKIPGE PURIFG ; If not yet purified, assume being debugged. + .VALUE +] + .LOGOUT ; Come here to commit suicide. + .BREAK 16,160000 +] ;IFN ITSSW + +IFN DECSW,[ + +TSRETN: SKIPLE A,ERRCNT ; If had any errors, + ADDM A,.JBERR ; let loader know about them. (???) Well, + .SEE ERR1 ; for strange comment. + SKIPN CCLMOR ; Any more CCL commands? + EXIT ; Nope, all done. + JRST RERUN ; More CCL to hack, start up a new MIDAS. +] ; IFN DECSW + + +IFN TNXSW,[ +TSRETN: SKIPE CCLMOR ; Need to hack any more CCL? + JRST RERUN ; Yeah. +TSRET1: HALTF + HRROI 1,[ASCIZ/Can't continue/] + PSOUT ; Better than dying randomly + JRST TSRET1 +] ; IFN TNXSW + +SUBTTL .SITE pseudo & initialization (SITINI) + +IFN ITSSW, LVSITE==1 ; ITS only uses 1 word of mach name. +IFN DECSW\TNXSW,LVSITE==5 ; whereas others need 5 words (25 chars max) + +LVAR V.SITE: BLOCK LVSITE ; .SITE string stored here. + + ; .SITE N, returns nth word of sixbit machine name. + +A.SITE: CALL AGETFD ; Get field as argument. + JUMPL A,CABPOP ; Ignore negative indices. + CAIL A,LVSITE ; Make sure index is within bounds of string. + JRST CABPOP + MOVE A,V.SITE(A) ; Win, get indexed word. + JRST CLBPOP + + +; SITINI - Initialization routine called only at MIDAS startup, for +; setting up .SITE and maybe other things. + +SITINI: BLTZ LVSITE,V.SITE ; Clear out string location + +IFN ITSSW,[ ; For ITS, use up just 1 word and need 1 call to set V.SITE + SYSCAL SSTATU,[REPEAT 5,[ ? MOVEM A] ? MOVEM V.SITE] + .LOSE 1000 + POPJ P, ] + +IFN SAILSW,[ ; SAIL needs special kludge, since it doesn't have the + MOVE A,[SIXBIT /SAIL/] ; right GETTAB used. + MOVEM A,V.SITE + POPJ P, ] + + ; This code sets TNX .OSMIDAS at runtime as appropriate. +IFN TNXSW,[ + MOVE A,[SIXBIT /TENEX/] ; Assume running on 10X + TLNE FF,FL20X ; unless proved otherwise + MOVE A,[SIXBIT /TWENEX/] + MOVEM A,OSMID ; Store directly as symtab value! +] + ; If TNX and on ARPA network, get Arpanet host name for .SITE +IFN TNXSW,[ + SYSCAL SYSGT,[['LHOSTN]][A ? B] ; Get local host # + JUMPL A,SITIN3 ; Tops-20 release 3 has a LHOSTN table + JUMPE B,SITIN3 ; Jump if none, not on net. + SYSCAL CVHST,[FNBWP ? A][A] ; Write string into FNBUF. + JRST SITIN3 ; No string for that host #?? + SETZ B, + IDPB B,A ; Make sure string is ASCIZ'd. + MOVE B,FNBWP ; Note that FNBWP isn't altered by the syscal! + MOVE C,[440600,,V.SITE] +SITIN2: ILDB A,B + JUMPE A,APOPJ ; return when string ended. + TRCE A,140 ; Convert char to sixbit. + TRCE A,140 + TRCE A,140 + IDPB A,C + JRST SITIN2 +] + + ; For non-network TENEX and DEC in general, very similar. +IFN DECSW\TNXSW,[ +IFN TNXSW,[ +SITIN3: SYSCAL SYSGT,[['SYSVER]][A ? D] ; Best to get table index dynamically, + JUMPE D,APOPJ ; If can't, lose. + ] +IFN DECSW,MOVEI D,11 ; 11 = .GTCNF But on T10 we can assume this. + + MOVE AA,[440600,,V.SITE] + MOVSI C,-5 ; Process 5 words of .GTCNF (max possible) +SITIN4: HRLZ B,C ; Get subindex we want, + HRRI B,(D) ; and produce ,,
+IFN DECSW, GETTAB B, ; Get 1 word of table, using appropriate call. +IFN TNXSW, SYSCAL GETAB,[B][B] + POPJ P, ; If call fails, exit. +SITIN5: SETZ A, + LSHC A,7 ; Extract an ascii char + CAIE A,", ; If it's a comma, + CAIG A,40 ; or ctl or space, + POPJ P, ; then let's stop. + TRCE A,140 ; Swap bit 40 with bit 100, thus turning + TRCE A,140 ; "A to 'A, "a to 'A, "1 to '1, etc, and ^@ to ' . + TRCE A,140 + IDPB A,AA ; Store the sixbit into V.SITE + JUMPN B,SITIN5 ; When nothing left of this word of .GTCNF, get next. + AOBJN C,SITIN4 + POPJ P, +] ;DECSW\TNXSW + +SUBTTL RunTime - .MRUNT and end-of-assembly typeout +IFN RUNTSW,[ + +.SCALAR IRUNTM ; Holds initial run time (set at start of assembly) + + ; .MRUNT - Returns runtime since start of assembly. + +A.MRUN: PUSHJ P,RNTTMA ; Get current run time + SUB A,IRUNTM ; Subtract initial run time +IFN ITSSW,[MULI A,4069. ; ITS - Convert to nanoseconds, + DIV A,[1.^6] ; then to milliseconds. +] + PJRST CLBPOP + + ; RNTTMA - internal routine to return in A the current runtime, + ; in whatever units the OS furnishes. +RNTTMA: +IFN ITSSW, .SUSET [.RRUNT,,A] ; Gets runtime in 4.096 usec units. +IFN DECSW, SETZ A, ? RUNTIM A, ; Runtime in msec +IFN TNXSW,[ + IFN A-1, EXCH R1,A + MOVEI R1,.FHSLF + RUNTM ; Runtime in msec for self. + IFN A-1, EXCH R1,A + ] + POPJ P, + +; RNTTYO - Called at end of assembly to type out runtime, +; # of errors, and # symbols used. + +RNTTYO: +IFN DECSW,[ ; Nobody wants this on ITS, but other people do...sigh... + SKIPE A,ERRCNT ; Any assembly errors? + JRST [ TYPE "? " ; Yes, error message for batch controllers + CALL DPNT + TYPECR " error(s) detected" + JRST .+1] + SKIPE CCLFLG ; Called via CCL? + RET +] + TYPE "Run time = " + CALL A.MRUN ; Get runtime in millisec. in A. + IDIVI A,10. + IDIVI A,100. ; Get secs and hundredths. + HRLM B,(P) ; Save remainder + PUSHJ P,HMSTYO ; Type out secs + MOVEI A,". + CALL TYO + HLRZ A,(P) + CALL HMSTY3 ; Type out hundredths + CALL CRR + CALL A.SYMC + CALL DPNT + TYPE " Symbols including initial ones (" + CALL A.SYMC + IMULI A,100. + IDIV A,SYMLEN ; Get % symtab used + CALL DPNT + TYPECR "% used)" + RET + +; HMSTYO - Type out H:MM:SS time in A +; Doesn't work for times .ge. 60. hours + +HMSTYO: IDIVI A,60. + JUMPE A,[MOVE A,B ? PJRST DPNT] + HRLM B,(P) + PUSHJ P,HMSTYO + MOVEI A,": + PUSHJ P,TYO ; Type delimiting char + HLRZ A,(P) +HMSTY3: IDIVI A,10. + PUSHJ P,ADGTYO ; Type out digit in A + MOVEI A,"0(B) + PJRST TYO + +] ; IFN RUNTSW + +SUBTTL COMMON Output Routine WINIT - Open all output files. + +; WINIT - Called from top-level control to open all necessary output files. +; + +WINIT: +IFN ERRSW,[ + SKIPN ERRFP ; If want error output file, + JRST WINIT2 + CALL OINIT ; Open it, first of all. + 0 ERRFC,ERRFB + SIXBIT/ERROUT/ + ERRHDR,,ERRBUF + SETOM ERRFOP ; Error file now open. +WINIT2: ] + PUSHJ P,OINIT ; Open main output file. + 13^9 UTYOC,OUTFB ; chnl,name-block. + SIXBIT/OUTPUT/ + UTOHDR,,UTOBUF +IFN ITSSW,[ + TLZ FF,FLPTPF ; Initially assume device not paper tape punch + .STATUS UTYOC,A ; Get status of output channel + ANDI A,77 ; Mask to device code + CAIN A,7 ; If paper tape punch, + TLO FF,FLPTPF ; Then set FLPTPF. +] +IFN LISTSW,[ + SKIPN LISTP + JRST WINIT1 + CALL OINIT ; Open listing file if desired. + 0 LPTC,LSTFB + SIXBIT/LSTOUT/ + LSTHDR,,LSTBUF +WINIT1: +] +IFN CREFSW,[ + SKIPN CREFP ; If cref requested, + RET + PUSHJ P,OINIT ; Open cref file, FN2 = CRFOUT + 13^9 CREFC,CRFFB + SIXBIT/CRFOUT/ + CRFHDR,,CRFBUF + MOVE A,[.BYTE 7 ? 177 ? "B ? ^W] + PUSHJ P,CRFOUT ; Output header to indicate image input. + PUSHJ P,CRFSSF ; Output set-source-file block. +] + RET + +SUBTTL COMMON Output Routines - Output Chars/Words to BIN, TTY, ERR, CREF, LIST + + ; PPB - Punch Binary word. + +PPB: JUMPGE FF,CPOPJ ; Don't punch if not punching pass. +PPBA: ; This entry pt "Always" punches. +TPPB: SOSGE UTYOCT ; If no more room in buffer, + JRST [ CALL TPPBF ; Output & re-init buffer. + JRST TPPB] + IDPB A,UTYOP + RET + +TPPBF: PUSH P,[0 UTYOC,UTOHDR] ; Drop thru to COBUFO. + + ; Common OBUFO. Takes ,
on stack, clobbers no ACs. + ; See rtns below for usual calling sequence. +COBUFO: EXCH C,(P) ; Get arg off stack, save C. + CALL OBUFO ; Output & re-init buffer. + REST C + RET + + ; TYO - Output char in A, outputting also to ERR file if possible. +TAB: MOVEI A,^I +TYO: SKIPG A.TTYF + CALL TYOX ; Actually output to TTY with OS-dependent routine. + ; Then fall through for ERR output. +ERRCHR: +IFE ERRSW,RET +IFN ERRSW,[ + SKIPN ERRFOP ; Output char in A to error file if one is open. + RET + SOSGE ERRFCT + JRST [ PUSH P,[ERRCHR] + PUSH P,[0 ERRFC,ERRHDR] + PJRST COBUFO] + IDPB A,ERRPTR + RET +] ;IFN ERRSW + + ; CRFOUT - Output word in A to CREF file. + +IFN CREFSW,[ +CRFOUT: SOSGE CRFCNT + JRST [ PUSH P,[CRFOUT] ; Buffer full, go output it. + PUSH P,[0 CREFC,CRFHDR] + PJRST COBUFO] + IDPB A,CRFPTR + POPJ P, + +CRFSSF: SKIPA A,[1] ; Output set-source-file block. +CRFPSH: MOVEI A,3 ; Output push-source-file block. +REPEAT L$F6BL,[ + CALL CRFOUT + MOVE A,INFB+$F6DEV+.RPCNT + ] + JRST CRFOUT +] ; IFN CREFSW + + + ; PILPT - Output character in A to listing file. + +IFN LISTSW,[ +PILPT: SOSGE LSTCNT + JRST [ PUSH P,[PILPT] ; When buffer full, output it. + PUSH P,[0 LPTC,LSTHDR] + PJRST COBUFO] + IDPB A,LSTPTR + RET + +LPTCLS=:CPOPJ ; Hmmm, random noop-ness ref'd by AEND. + +] ;END IFN LISTSW, + +SUBTTL COMMON Output Routine .FILE - Close all output files. + +; .FILE - Counterpart to WINIT. +; Close input, bin, cref and list files. + +.FILE: ; Closing input file is simple enough... +IFN DECSW, RELEAS UTYIC, +IFN ITSSW, .CLOSE UTYIC, +IFN TNXSW,[ +IFN PMAPSW, MOVE A,[NIBFPS,,1STBFP] ? CALL DELPGS ; flush buffer pages + MOVE R1,INFB+$FJFN + CLOSF + JFCL + SETZM INFB+$FJFN + SETZM JFNCHS+UTYIC +] + MOVNI A,1 + SKIPL B,CONTRL ; If relocatable, + PUSHJ P,TPPB ; Output a -1 so stink will see EOF + SETZ A, ; In dec fmt, output a 0 at end. + TRNE B,DECREL + CALL TPPB + SKIPE OUTFB+$FEXT ; Check general name. + JRST .FILE2 ; Output fnam2 was explicitly specified + + ; Output extension (fn2) wasn't specified, default depends + ; on system and output type. +IFN ITSSW, MOVSI A,'BIN ; Default to SBLK output format; note that +IFE ITSSW, MOVSI A,'SBK ; this will include RIM, RIM10. + SKIPL B,CONTRL ; Using STINK output format? +IFN ITSSW, MOVSI A,'REL ; Yes, use appropriate thing for site. +IFE ITSSW, MOVSI A,'STK + TRNE B,DECSAV ; Using DECSAV output format? + MOVSI A,'SAV +IFN TNXSW,[ + TRNE B,DECSAV ; If using DECSAV format and + TLNN FF,FL20X ; on a 20X, then + CAIA + MOVSI A,'EXE ; use this extension instead. +] + TRNE B,DECREL ; Using DECREL output format? + MOVSI A,'REL +IFN FASLP,[ + TRNE B,FASL ; Using FASL output format? +IFN ITSSW, MOVE A,[SIXBIT /FASL/] ; yes, smash as appropriate. +IFE ITSSW, MOVSI A,'FAS +] +IFE TNXSW, MOVEM A,OUTFB+$F6EXT ; For 6bit systems, store final selection. +IFN TNXSW, PUSHJ P,TNXODF ; If Tenex, call output default hackery, since + ; changing stuff is a bit hairier. + +.FILE2: JSP A,OCLOSE + 0 UTYOC,UTOHDR ; Write out buffer, rename and close output file. + OUTFB +IFN LISTSW,[ + SKIPN LISTP ; Listing file open => + JRST .FILE3 + CALL PNTCR ; End with cr and ff. + MOVEI A,^L + CALL PILPT + JSP A,OCLOSE + 0 LPTC,LSTHDR ; Output buffer, rename & close it. + LSTFB +.FILE3: +] ;IFN LISTSW +IFN CREFSW,[ + SKIPN CREFP ; If cref file open, + POPJ P, + MOVEI A,0 + PUSHJ P,CRFOUT ; Output eof block, + JSP A,OCLOSE ; Write buffer, close. + 0 CREFC,CRFHDR ; 0 chnl,header + CRFFB +] + RET + + ; File out error output file. This isn't done in .FILE so that + ; error file can include a few more goodies and be closed separately + ; later on. +ERRCLS: SETZM FATAL ; Err file renamed even after fatal error. +IFN ERRSW,[ + SKIPN ERRFOP + RET ; There is none. + MOVEI A,^M + CALL ERRCHR ; Put crlf at ennd. + MOVEI A,^J + CALL ERRCHR + JSP A,OCLOSE ; Rename and close. + 0 ERRFC,ERRHDR + ERRFB + SETZM ERRFOP +] + RET + +SUBTTL ITS - Output file Open, Output, Close/Rename. +IFN ITSSW,[ + +; PUSHJ P,OINIT ; Open output file +; Mode chnl,name-block-addr +; Sixbit/desired-temporary-fn2/ +; Header,,buffer space ;used only in dec version. +; The mode should be 13^9 for binary, 0 for ascii. + +OINIT: MOVE A,(P) + HLRZ B,2(A) ; Get addr of header, + SETOM 2(B) ; Set buffer byte count to -1 => not initted. + MOVE AA,1(A) ; Get 2nd arg, temp FN2 to use. + MOVE F,(A) ; Get 1st arg - , + SYSCAL TRANS,[5000,,.UAO ; For output mode, + REPEAT 4,[? .RPCNT(F) ] ; translate from given names + REPEAT 4,[? MOVEM .RPCNT+FB+$F6DEV ]] ; into actual names, in scratch blk. + JRST OINITL ; (too many translations) + + SYSCAL DELETE,[FB+$F6DEV ; Delete old temp name file. + TMPFN1 ? AA ? FB+$F6DIR] + JFCL ; If none, it's ok. + LDB A,[270400,,F] ; Get channel num. + HRLI A,.BAO ; Open mode (default ascii) + TLNE F,777000 ; But maybe want image mode. + HRLI A,.BIO ; Yep, use that instead, to get ,, + SYSCAL OPEN,[A ? FB+$F6DEV ; Open file, + TMPFN1 ? AA ; using these temp filenames. + FB+$F6DIR] + JRST OINITL + BLTM L$F6BL,FB+$F6DEV,$F6DEV(F) ; Copy translated names into + ; name-block for file, for eventual rename. + +POPJ3: AOS (P) ; Skip over 3 args. +POPJ2: AOS (P) + JRST POPJ1 + +TMPFN1: SIXBIT /_MIDAS/ ; FN1 to use for temp filenames. + + + +; OINITL - jumped to from OINIT if some lossage +; encountered when opening output files. + + +OINITL: HLLZ A,@(P) ; Get chnl num, + TLZ A,777037 ; Mask to just ac field (chnl num) + IOR A,[.STATUS A] + XCT A ; Read its status, + PUSHJ P,OPNER ; Type out reason for open failure, and ask + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Get typein, one line. + MOVE F,@(P) ; Get + PUSHJ P,RFD ; Get new file description into filblk spec'd by F + JRST OINIT ; and jump back to try again. + +VBLK +ERRDNM: .UAI,,'ERR ? 3 +ERRCOD: 0 +IFSTS: 0 ; .STATUS word stored by OPNRD1 when .OPEN loses +PBLK + + ; Openloss documentation routine + +IOPNER: MOVE A,IFSTS ; Input +OPNER: MOVEM A,ERRCOD ; Save .status word + PUSHJ P,TYPFB ; Type out file description + PUSHJ P,CRRERR ; Now crlf to ensure room for following + .OPEN ERRC,ERRDNM ; Now get the system to say what's wrong + .LOSE 1000 ; Can't open err device? +IOPNR2: .IOT ERRC,A ; Get character from system + CAIGE A,40 ; Ends with ^L or ^C or other cruft. + PJRST CRRERR ; Return, typing out CRLF. + PUSHJ P,TYOERR ; Type out character + JRST IOPNR2 ; Loop back for next + + +; JSP A,OCLOSE +; 0 chnl,header +; Nameblockaddr +; Write out last buffer, rename to names in nameblock and close. + +OCLOSE: MOVE C,(A) ; 1st wd of args is what OBUFO wants. + LDB B,[360600,,1(C)] ; Just in case this is ascii file, + DPB B,[300600,,OCLOSP] ; Get bp to unused part of last wd of buffer, + MOVE B,[ASCIC//] + DPB B,OCLOSP ; And pad with ^c's. + SOS 2(C) ; Obufo assumes byte count was sos'd. + CALL OBUFO ; Write out last partial buffer + MOVE F,1(A) ; Get + LDB C,[270400,,(A)] ; Get chnl num. + SKIPE FATAL + JRST OCLOS1 ; After fatal error, don't rename outputfiles. + SYSCAL RENMWO,[C ; Rename (F has nameblock addr) + $F6FN1(F) ? $F6FN2(F)] + HALT +OCLOS1: SYSCAL CLOSE,[C] ; Close channel. + HALT + JRST 2(A) ; Skip over args on return. + + +; OBUFO - Write out and reinitialize buffer for file. +; Assumes byte count (header 3rd wd) was sos'd. +; C has <0 chnl,header> +; In ITS version, header 1st wd has ,,-1 + +OBUFO: PUSH P,A + PUSH P,AA + AOSGE 2(C) ; Was count sos'd from -1? + JRST OBUFO1 ; Yes, buffer hadn't been initted, don't write it. + MOVN A,1(C) + ADD A,(C) ; RH(A) has -<# wds used in buffer>. + MOVSI A,(A) + HRR A,(C) + AOS A ; A has aobjn -> used part of buffer. + HLLZ AA,C + IOR AA,[.IOT A] + CAIGE A, + XCT AA ; Write it in file. +OBUFO1: MOVE A,1(C) + HRR A,(C) ; Position the b.p. before start of buffer, + TLZ A,770000 ; After last byte in wd (idpb will use 1st buffer wd) + MOVEM A,1(C) + HLRE A,(C) + MOVEM A,2(C) ; Set up byte count. + REST AA + JRST POPAJ + +TFEED: TLNN FF,FLPTPF ; If output device not PTP, + POPJ P, ; Then do nothing + PUSHJ P,TPPBF ; Otherwise output the buffer, +TFEED1: .FEED UTYOC, ; Feed a line, + TLZA FF,FLPTPF ; If this is executed, utyoc doesn't have ptp after all + SOJG B,TFEED1 ; Feed the specified number of lines, + POPJ P, ; And return + +] ; IFN ITSSW + +SUBTTL DEC - Output file Open, Output, Close/Rename + +IFN DECSW,[ + +OINIT: MOVE AA,(P) + MOVE F,(AA) ; Get , + HLLZ TT,F + TLZ TT,#(0 17,) ; Mask off AC field in TT + HRRZ D,2(AA) ; Get buffer space addr. + HLLZ C,2(AA) ; Get header addr. + HLRZ A,C + SETZM (A) ; Clear out its-version contents of 1st header wd. + LDB A,[331100,,F] ; Get mode to open in (will be ascii or image binary) + IOR TT,[OPEN A] ; Cons up OPEN instruction for chan, + MOVE B,$F6DEV(F) ; and bring in last arg. + XCT TT ; Open channel,a + JRST OINITL ; Lost? + + PUSH P,.JBFF ; Now to fake out DEC system into consing up buffer + MOVEM D,.JBFF ; at this location. T10 uses .JBFF as pointer. + XOR TT,[#] ; Request buffer setup (one of) + XCT TT + REST .JBFF + MOVE A,[SIXBIT /000MD /] + PJOB B, ; Get job number, to make sixbit /md/ + IDIVI B,10. + DPB C,[220400,,A] + IDIVI B,10. + DPB C,[300400,,A] ; Put the digits of the job number into the sixbit word. + DPB B,[360400,,A] + MOVE AA,(P) + LDB B,[360600,,1(AA)] ; Get 1st char of 'output, 'lstout, 'crfout, 'errout. + IOR A,B ; Use it as last char of temp file name. + MOVSI B,'TMP ; Set up ext (fn2), + SETZ C, ; zap prot/date/time etc to default, + MOVE D,$F6DIR(F) ; and PPN. + XOR TT,[#] + XCT TT ; Do ENTER UTYOC,A + JRST OINITL +POPJ3: AOS (P) +POPJ2: AOS (P) + JRST POPJ1 + +; OINITL - jumped to from OINIT if some lossage +; encountered when opening output files. Jumps back to OINIT +; directly. + +OINITL: PUSHJ P,OPNER ; Type out reason for open failure, and ask: + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Get typein, one line. + PUSHJ P,RFD ; Get new file description into filblk spec'd by F + JRST OINIT ; and jump back to try again. + + ; Openloss documentation routine - not much to say. + +IOPNER: ; Input +OPNER: PUSHJ P,TYPFB ; Type out file description + PUSHJ P,CRRERR ; Now crlf to ensure room for following + TYPE "OPEN failed" + PJRST CRRERR ; Return, typing out another CRLF. + +;CLOSE AN OUTPUT FILE, SEE NON-DEC VERSION FOR ARGS. + +OCLOSE: PUSH P,A ; Save return addr + MOVE F,1(A) ; Get + SKIPGE FATAL ; If fatal error happened, + JRST OCLOS2 ; don't rename, just close. + MOVE C,$F6DEV(F) ; Delete any file with names + SETZB B,D ; we want to rename to. + OPEN ERRC,B ; Use ERRC as temporary channel. + JRST OCLOS1 + MOVE A,$F6FN1(F) + HLLZ B,$F6EXT(F) + SETZ C, + MOVE D,$F6DIR(F) + LOOKUP ERRC,A + JRST OCLOS1 ; There is none, just rename. + SETZ A, ; Say to delete this file + MOVE D,$F6DIR(F) ; From right UFD + RENAME ERRC,A + JFCL + RELEAS ERRC, +OCLOS1: MOVE A,$F6FN1(F) ; Desired fn1. + HLLZ B,$F6EXT(F) ; Desired fn2. + SETZ C, ; Bottoms-10 DATE75 lossage must never be forgotten! + MOVE D,$F6DIR(F) ; Sname (that is, ppn) + HLLZ AA,@(P) ; Get just chnl num. + IOR AA,[CLOSE] ; Close it & finalize, + XCT AA + XOR AA,[CLOSE#] + XCT AA ; Then rename to desired names. + JFCL ; at this point, ignore any lossage, sigh. +OCLOS2: HLLZ B,@(P) ; Get chnl in ac field. + IOR B,[RELEAS] + XCT B ; Finally, release channel. + JRST POPJ2 ; and skip over args on return. + + ; Write out buffer of output file, C has <0 chnl,header> +OBUFO: AND C,[0 17,] ; Get just chnl num. (sys remembers where header is for ch) + TLO C,(OUT) ; Output current buffer. + XCT C + RET ; Normal return! + PUSH P,A ; Error return from out uuo. + XOR C,[OUT#] + XCT C ; Read file status. + TRZ A,74^4 ; Clear error bits. + ETR [ASCIZ /Output data error/] + XOR C,[#] + XCT C + JRST POPAJ + + ; Paper tape stuff, do nothing. +TFEED: RET + +] ;END IFN DECSW, + +SUBTTL TNX - Output file Open, Output, Close/Rename + +IFN TNXSW,[ + +TFEED: RET ; Again, null out paper-tape hack. + +; OINIT - Open Output file. +; P points to first word of args which follow the call: +; 1: , ; is 0 for ascii, 13^9 for bin. +; 2: sixbit // +; 3:
,, +; +; Clobbers A,B,C + +; For Tenex, it is necessary to fudge the fileblock consistency slightly; +; $FJFN has in RH the actual JFN used to write to the temporary-name +; file, and in LH the JFN for the final desired filename. Note that if +; the $FEXT is null for main output file, it will be defaulted by TNXODF +; at close time, (to SAV, EXE, or REL) and the +; "final desired" JFN won't actually be used. +; Both JFNS are "active" rather than just a file spec. + +OINIT: MOVE C,(P) ; Get addr of arg block + HLRZ A,2(C) ; Get
, + SETOM 2(A) ; and set buffer byte cnt to -1 to mark for init. + MOVE F,(C) ; Get , + PUSHJ P,GETJFO ; Get output JFN for filblk. + JRST OINIT5 ; Lost? +OINIT2: HRLZS $FJFN(F) ; Won, move JFN over into LH. + + ; Aha, successfully grabbed a JFN for desired output filename. + ; Now must get another one for the temporary filename... + MOVSI A,(GJ%FOU+GJ%NEW) + PUSHJ P,TFMAP ; Must set up block again, may have changed due to RDJFNO. + MOVE A,1(C) ; Get sixbit/tmpfn2/ + PUSHJ P,CV6STR ; Convert to ASCIZ and return BP to string. + MOVEM A,GTJBLK+.GJEXT ; Store in long-form call blk. + SYSCAL GTJFN,[[GTJBLK] ? [0]][A] ; Repeat the GTJFN call. + JRST [ MOVEM A,ERRCOD ; Ugh???? + JRST OINIT5] + HRRM A,$FJFN(F) ; Good, got it... + + ; Now have both JFN's packed away, can finally open the + ; temporary filename. + HRRZ B,A ; Need JFN in RH with LH clear... + LDB A,[331100,,F] ; Get + CAIN A, + MOVSI A,070000 ; If 0, use ASCII (7-bit bytes) + TRNE A,-1 + MOVSI A,440000 ; If not 0, use WORD (36-bit bytes) + TRO A,OF%WR ; Get write access. + SYSCAL OPENF,[B ? A][A] ; Open up the temp file (JFN in RH) + JRST [ MOVEM A,ERRCOD ? JRST OINIT6] ; damn + + ; Won, successfully opened output file stuff etc, now wrap up. + HRRZ A,$FJFN(F) ; Get JFN used, + LDB C,[270400,,F] ; and channel number argument, + MOVEM A,JFNCHS(C) ; and store JFN away in channel slot. + PUSHJ P,CVFSIX ; Now put right things in $F6 entries. + MOVEI A,3 + ADDM A,(P) + POPJ P, + +.SCALAR ERRCOD + + ; Come here when GTJFN fails trying to get a JFN for GTJBLK long + ; form argument block. Must print out bad filename. + ; OINIT5 should really use names in GTJBLK, and + ; OINIT6 should really hack GJFNS call to get names, but for now... + +OINIT5: SKIPA A,[[ASCIZ /GTJFN failed for /]] +OINIT6: MOVEI A,[ASCIZ /OPENF failed for /] + PUSHJ P,CRRERR + TYPR (A) + PUSHJ P,OPNER1 ; Type out filename and error message. + PUSHJ P,RDJFNO ; Read new JFN + JRST OINIT2 ; try to open it. + +IOPNER: PUSH P,[CRRERR] ; Do following and add CRLF. +OPNER1: PUSHJ P,TYPFB + TYPE " +Error - " ; Drop thru to TERSTR. + + +TERSTR: MOVE A,ERRCOD + HRLI A,.FHSLF + SYSCAL ERSTR,[[-1,,ERSTRB] ? A ? [-LERSTR,,]][A ? A ? B] + JRST TERST7 ; undefined err #? + HALT ; destination bad? + TYPR ERSTRB + POPJ P, +TERST7: TYPE "Unknown error" + POPJ P, + + LERSTR==80. +.VECTOR ERSTRB(/5) + +; RDJFNO - Hack to get a new JFN by reading from TTY, using recognition. +; RDJFNI - Same but for input. Uses current FB for defaults. +; Stashes JFN away in RH of $FJFN(F). + +RDJFNO: SKIPA A,[GJ%FOU+GJ%NEW+GJ%CFM] ; For output +RDJFNI: MOVSI A,(GJ%OLD+GJ%CFM) ; for input + PUSHJ P,TFMAP + MOVE A,[.PRIIN,,.PRIOU] ; Use primary JFNs (TTY) for I/O + MOVEM A,GTJBLK+.GJSRC + PUSH P,R1 + PUSH P,R2 + PUSH P,R3 + CAIA +RDJFN2: PUSHJ P,RDJERI ; Come here when get error in GTJFN. + MOVEI R1,.PRIIN ; Make sure that + CFIBF ; TTY input is reset. + HRROI R1,[ASCIZ / +Use what filename instead? /] + PSOUT + MOVEI R1, + MOVEI R1,GTJBLK + SETZ R2, + GTJFN + JRST RDJFN2 ; Error, report it. + POP P,R3 + POP P,R2 + HRRM R1,$FJFN(F) + POP P,R1 + PJRST JFNSTB ; Smash FB with names of the JFN we got, and return. + +; RDJERR - Report last error message directly to TTY (primary output). +; Useful when doing quick direct user interaction. + +RDJERR: TROA R2,-1 ; Here to get last error, whatever it was. +RDJERI: MOVE R2,R1 ; Here to use err code in R1. + HRLI R2,.FHSLF + HRROI R1,ERSTRB + MOVSI R3,-LERSTR + ERSTR ; Get error string + JRST RDJER6 + HALT + SKIPA R1,[-1,,ERSTRB] +RDJER6: HRROI R1,[ASCIZ /Unknown error/] + ESOUT ; Output to TTY amid other hackery. + POPJ P, + + +; TNXODF - Hack to get yet another "desired" JFN so that when no +; extension was specified for binary output file, one appropriate to +; the type can be selected. +; Basically do a GTJFN again for binary output filenames, furnishing +; the default extension selected, and use that to replace the one +; already in LH of $FJFN. + +TNXODF: PUSHJ P,CV6STR ; Convert sixbit word in A to string, get BP in A + MOVEI F,OUTFB ; Point at right filblk, + MOVEM A,$FEXT(F) ; Store, and now + PUSH P,$FJFN(F) ; Save current set of JFNs before + PUSHJ P,GETJFO ; getting another one + JRST POPAJ ; If lossage, stick to old JFN. + POP P,A + HRLZS $FJFN(F) ; GETJFO puts JFN into RH, we want it in LH. + HRRM A,$FJFN(F) ; now restore previous RH. + HLRZS A ; and get old "desired" JFN in position for + SYSCAL RLJFN,[A] ; releasing. + JFCL + POPJ P, + +; OCLOSE - Close output file, writing out remainder of buffer and renaming +; from temporary to desired filename. +; JSP A,OCLOSE +; 1: 0 ,,
+; 2: +; Clobbers F,C (and obviously A) + +; 10x must do CLOSF, not releasing the JFN, and then a RNAMF from temp +; JFN to desired JFN, after which both can be released. The desired and +; used JFNs are in LH and RH respectively of $FJFN in . +; is ignored except to wipe out its JFNCHS entry. + +OCLOSE: PUSH P,A + MOVE C,(A) ; Get ,,
+ SOS 2(C) ; OBUFO assumes count was SOS'd before each call + PUSHJ P,OBUFO ; Write out anything remaining in buffer. + LDB C,[270400,,(A)] ; Get channel number + MOVE F,1(A) ; Get + HRRZ A,$FJFN(F) ; Find JFN being used... + CAME A,JFNCHS(C) ; Should be same as JFN for channel. + HALT ; Synch error or something. + TLO A,(CO%NRJ) ; Say don't release JFN + SYSCAL CLOSF,[A] ; Close file... + HALT ; ?!?! + HRRZS A ; Get back 0,,jfn + SETZM JFNCHS(C) ; Indicate "channel" closed... + SKIPE FATAL ; If fatal error happened in assembly, + JRST OCLOS5 ; don't rename from temp filenames. + HLRZ C,$FJFN(F) ; Now see what if anything to rename it to. + JUMPE C,OCLOS5 ; If no renaming needed, skip hair. + SYSCAL RNAMF,[A ? C] ; Rename file from JFN in A to JFN in C. + HALT ; WTF? + SYSCAL RLJFN,[C] + HALT +OCLOS5: SYSCAL RLJFN,[A] + HALT + SETZM $FJFN(F) + POP P,A + JRST 2(A) + +; OBUFO - Output Buffer and reinitialize. +; C/ 0 ,
+; Clobbers no ACs. + +; 10X is pretty much like ITS, JFN is kept in JFNCHS table indexed by . + +OBUFO: PUSH P,A + PUSH P,B + MOVE A,1(C) ; Get write BP, + HRR A,(C) ; and reset it... + TLZ A,770000 ; to point at start of buffer, + MOVEM A,1(C) ; and store it back, which is OK since we have byte cnt + AOSGE 2(C) ; Was buffer marked for initialization (cnt -1)? + JRST OBUFO1 ; Yes, don't write anything, just go init rest of it. + HLRZ A,(C) ; Get buffer size in wds, + MOVNI A,(A) ; make negative, + ADD A,2(C) ; and add count of bytes left to get -<# bytes used>. + LDB B,[270400,,C] ; Get channel # as index to JFN + PUSH P,T + SYSCAL SOUT,[JFNCHS(B) ? 1(C) ? A] + POP P,T +OBUFO1: HLRZ A,(C) ; Get buffer size again, + MOVEM A,2(C) ; and reset count with it. + POP P,B + POP P,A + POPJ P, + +] ;END IFN TNXSW + +SUBTTL COMMON Input Routines - Main File Open, EOF handling + +; Open main input file for reading (filespec in ISFB) + +OPNRD: +IFN ITSSW, .IOPDL ; Re-initialize IO pdl +IFN DECSW\TNXSW, CALL IOPDLC ; Non-ITS systems must simulate. + INSIRP SETZM,INFCNT INFCUR INFERR + MOVE A,[-TYPDLS-1,,TTYPDL] + MOVEM A,ITTYP ; Initialize "tty pdl" + PUSHJ P,MACIN1 ; Clobber macro expansion status + MOVE A,ISFB+$FDEV ; Get device name + CAMN A,FSTTY ; TTY? + JRST [ MOVE A,[ISFB+$F6FN1,,IFNM1] ; TTY specified, treat special + BLT A,IFNM2 ; Clobber .IFNM1, .IFNM2 to specified + TYPECR "Reading from TTY:" + MOVEI A,3 ; => input from tty, don't quit on cr + JRST OPNRT2] + MOVE A,[ISFB,,INFB] ; Copy ISFB specs to INFB (which will hold + BLT A,INFB+L$FBLK-1 ; actual names of current input file) + MOVEI F,INFB ; Point things at INFB. + PUSHJ P,OPNRD1 ; Try opening file + JRST [ PUSHJ P,IOPNER ; Open lost, type out message + POPJ P,] ; Read new command (this may screw on pass2?) + MOVEM A,INFERR ; Err msg in main file shouldn't type names. + MOVEI A,0 ; => input from file +IFN TNXSW,[ + MOVE T,INFB+$FJFN ; Copy actual jfn to avoid re-GTJFN + MOVEM T,ISFB+$FJFN +] +OPNRT2: MOVE T,[IFNM1,,RFNAM1] + BLT T,RFNAM2 ; Set up .FNAM1, .FNAM2 + SETOM NEDCRL + AOS (P) ; Won, skip on return. + JRST RCHSET ; Set up to read from file or tty. (arg in A) + + + ; Common stuff for OPNRD1 in all (DEC/ITS/TENEX) versions. +OPNRD3: HRRZM A,UTIBED ; Say buffer empty, + MOVSI A,EOFCH_13 + MOVEM A,@UTIBED ; Cause immediate reload. +OPNRD4: BLTM 2,$F6FN1(F),IFNM1 ; Set up .IFNM1, .IFNM2 from filblk F points at + AOS A,INFCNT ; Assign this file a number. + MOVEM A,INFCUR ; OPNRD expects this left in A. + JRST POPJ1 + + ; EOF while trying to read character + +RPAEOF: PUSH P,B ; Save B +RPAEO1: MOVE B,ITTYP ; Get pdl pointer + PUSHJ P,BPOPJ ; Call pop routine (maybe NED's out) + JRST RCHTRB ; Return to get character + + ; EOF from main file + +NEDCHK: TRNE FF,FRCMND ; ^C read in commannd, :KILL self. + JRST TSRETN + SKIPE RCHMOD + JRST NEDCH1 + AOSN NEDCRL ; Invent one crlf after end of main file. + JRST [ MOVE B,[440700,,[.BYTE 7 ? ^M ? ^J ? EOFCH]] + MOVEM B,UREDP + HRRZM B,UTIBED + RET] +NEDCH1: +IFN A1PSW,[ + PUSHJ P,OUTCHK + MOVSI A,-LNEDT + XCT NEDT(A) ; Skips if NED condition to be complained about + AOBJN A,.-1 + JUMPGE A,GO8 +] + ETF [ASCIZ /No END statement/] + +.SCALAR NEDCRL ; -1 => haven't yet supplied a CRLF at EOF of main file. + +IFN A1PSW,[ ; Holler "NED" if any of the following: +NEDT: SKIPL PRGC ; No end statements have been encountered + SKIPGE OUTC ; Output has occured not matched by an end statement + SKIPGE OUTN1 ; Output has occured other than in 1pass mode + TRNN FF,FRPSS2 ; Currently in pass 2 +LNEDT==.-NEDT ; Length of table +] + +SUBTTL ITS - Input file Open, buffer input +IFN ITSSW,[ + + ; Try .OPENing input file pointed to by F. Skips if successful. + ; Sets filenames to actual names. + +OPNRD1: SYSCAL OPEN,[[.BAI,,UTYIC] + $F6DEV(F) ? $F6FN1(F) ? $F6EXT(F) ? $F6DIR(F)] + JRST [ .STATUS UTYIC,IFSTS ; Lost, save status now before possible + POPJ P,] ; .IOPOP, and make failure return. + SYSCAL RFNAME,[1000,,UTYIC ; Now find true filenames. + MOVEM $F6DEV(F) ; Store dev,dir directly + MOVEM C ; But need to check FN1, FN2 so + MOVEM D ; put them in ACs instead. + MOVEM $F6DIR(F)] + .LOSE 1000 + CAIE C, ; If FN1 meaningless for device, skip to use + MOVEM C,$F6FN1(F) ; spec'd FN1 anyway, but else store actual FN1. + CAIE D, + MOVEM D,$F6FN2(F) ; Ditto for FN2. + MOVE A,IUREDP ; Set up reading ptr, + MOVEM A,UREDP + JRST OPNRD3 ; Set up ^C after buffer, infcur, etc. + + + ; EOFCH encountered on read, reload and jump back for next char + +INCHR3: HRRZ CH1,UREDP ; Get byte pointer + CAME CH1,UTIBED ; End of block? + RET ; No, ^C in file. + MOVE A,IUREDP + MOVEM A,UREDP + MOVE A,[-UTIBFL,,UTIBUF] + .IOT UTYIC,A ; Read in block + ANDI A,-1 + CAIN A,UTIBUF ; If the iot didn't give us anything, we are at EOF. + JRST RPAEOF + HRRZM A,UTIBED ; Store RH (updated pointer) for EOF check at INCHR3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ; Store a ^C after the data we read, so at EOB we come to INCHR3. + JRST RCHTRA ; Now try next char +] ;END IFN ITSSW + +SUBTTL DEC - Input file Open, buffer input + +IFN DECSW,[ + +OPNRD1: MOVEI C,UTIHDR ; Open the input file w/ names in dnam ... snam. + SETZ A, ; Mode ascii. + MOVEI D,UTIBUF + MOVE TT,UTICHN ; Get channel num. to use. + LSH TT,27 ; Put in ac field. + IOR TT,[OPEN A] + MOVE B,$F6DEV(F) + XCT TT ; Open channel,a + RET + CALL BUFINI ; Initialize the input buffers and header. + MOVE D,$F6DIR(F) + MOVE A,$F6FNM(F) + HLLZ B,$F6EXT(F) + TLC TT,(OPEN#LOOKUP) + XCT TT ; Lookup channel,a + RET ; Failed. +IFE SAILSW,[ + MOVE A,$F6DEV(F) + DEVNAM A, ; Get real name of device. + CAIA + MOVEM A,$F6DEV(F) +] + MOVE A,UREDP + JRST OPNRD3 + + + ; Reload buffer, DEC style. +INCHR3: HRRZ CH1,UREDP ; Is this ^C at end of buffer? + CAME CH1,UTIBED + RET ; No, ^C in file. + PUSH P,B + MOVE A,UTICHN + LSH A,27 ; Channel num. in ac fld. + TLO A,(IN) + XCT A ; Get next bufferfull. + CAIA ; Succeed. + JRST INCHR4 ; Error. +INCHR5: MOVE A,UTICNT + ADDI A,9 + IDIVI A,5 + ADD A,UREDP ; -> 1st wd not read into. + HRRZM A,UTIBED + HRRZ A,UREDP + AOS A + MOVEI B,1 ; Scan the file and replace all line numbers with nulls. +INCHR6: CAMN A,UTIBED + JRST INCHR7 + TDNE B,(A) + MOVEM B,(A) + AOJA A,INCHR6 + +INCHR7: MOVSI B,EOFCH_13 + MOVEM B,(A) ; Put EOF char after buffer, in extra word. + JRST RCHTRB ; Retry RCH. + +INCHR4: XOR A,[#IN] + XCT A + TRZE B,74^4 + ETR [ASCIZ /Input data error/] + XOR A,[#] + XCT A ; Clear error bits in status. + TRNN B,2^4 + JRST INCHR5 + JRST RPAEO1 ; EOF. + +; BUFINI - Create DEC-style buffer ring, with 1 extra word following +; each buffer... +; A/ +; B/ +; C/
+; D/ +; Note that this extra-word crock is necessary just so it can be filled +; with ^C's to stop read loop and switch to next buffer. + +BUFINI: MOVEI AA,A +IFE SAILSW,DEVSIZ AA, + SKIPA AA,[DECBFL+1] ; Default buffer size is that for dsk. + AOJLE AA,.-1 ; Get size including extra wd. + MOVEI T,1(D) ; Addr of wd 2 of 1st buffer. + HRLI AA,T ; @AA is addr of 2nd wd of next buffer. + SUBI D,(AA) ; Facilitate test for end of buffer space. + HRLI T,400000 + MOVEM T,(C) ; Header -> a buffer, sign set. + HRRM T,1(C) ; Make rh of bp -> buffer 1st wd. + MOVSI T,440000 ; Set up p-field of b.p. + IORM T,1(C) + HRRZ T,1(C) + AOS 1(C) + HRLI T,-3(AA) ; Data-area-size +1,,addr-of-2nd-wd +BUFIN1: CAIGE D,-UTIBFL(T) ; Room for another after this buffer? + JRST BUFIN2 ; No, wrap up. + MOVEM T,@AA ; Yes, make next buffer -> this one, + HRRI T,@AA ; Point to next one. + JRST BUFIN1 + +BUFIN2: ADDI D,1(AA) ; -> 2nd wd of 1st buffer. + MOVEM T,(D) ; 1st buffer -> last, making ring. + RET + +] ;END IFN DECSW, + +SUBTTL TNX - Input file Open, buffer input + +IFN TNXSW,[ + +; OPNRD1 - Open File for Reading. Old stuff assumed fnm in DNAM +; using UTYIC channel, but new should furnish arguments: +; F/ to open + +; Essentially just GTJFN and OPENF like OINIT does, with same +; sort of error handling, except that when reading from cmd line +; as opposed to .INSRT, just go back to get completely new command. +; (perhaps if typein is just CRLF, go to special TNX style cmd input?) + +OPNRD1: CAIN F,INFB ; Horrible kludge necessary because MIDAS main + ; level doesn't bother to explicitly close main + ; input file when pass 1 is done, and TNX barfs if + ; you try to re-open a JFN... sigh. + JRST [ SKIPN $FJFN(F) ; Main file. Already opened it? + JRST .+1 ; nope, get JFN & open normally. + IFE PMAPSW,[ ; Already open. If not mapping, reset read ptr. + SYSCAL SFPTR,[$FJFN(F) ? [0]][ERRCOD] + POPJ P,] + JRST OPNRD2] ; and avoid attempt to re-open the JFN. + SKIPN $FJFN(F) + JRST [ PUSHJ P,GETJFI ; No JFN, get one for input. + POPJ P, ; Could fail. + JRST .+1] + PUSH P,T ; Read access, full word input. + SYSCAL OPENF,[$FJFN(F) ? [440000,,OF%RD]][ERRCOD] + JRST [POP P,T ? POPJ P,] ; Failure + POP P,T +OPNRD2: HRRZ A,$FJFN(F) + MOVEM A,JFNCHS+UTYIC ; Indicate "channel" open with this JFN. + PUSHJ P,JFNSTB ; Get actual names/version #. + PUSHJ P,CVFSIX ; Put right stuff in $F6 entries. + MOVE A,IUREDP ; Opened, set up buffer. + MOVEM A,UREDP ; Initialize BP into buffer. +IFE PMAPSW, JRST OPNRD3 +IFN PMAPSW, JRST OPNR50 ; for PMAP hacking, lots of stuff to do. + + ; Get a JFN for current FILBLK (in F) and stick it into $FJFN(F). + ; A should hold flags in LH to use in 1st wd of block. + ; GETJFI - sets usual flags for input + ; GETJFO - sets " " output + ; GETJFN - takes whatever A holds. + +GETJFO: SKIPA A,[GJ%FOU+GJ%NEW] ; If hacking output, ask for new version. +GETJFI: MOVSI A,(GJ%OLD) ; If hacking input, file must exist. +GETJFN: PUSHJ P,TFMAP ; Stick filblk stuff into GTJFN scratch block. + PUSH P,R1 + PUSH P,R2 + MOVEI R1,GTJBLK + SETZ R2, + GTJFN + JRST [ MOVEM R1,ERRCOD ; failure, save error code. + JRST GETJF5] + HRRM R1,$FJFN(F) ; Win, save JFN. + AOS -2(P) +GETJF5: POP P,R2 ; Can't return in ACs cuz don't know what R1 etc are, + POP P,R1 ; and might clobber them here. + POPJ P, + +; TFMAP - Map Tenex filenames from filblk pointed to by F into +; standard scratch block for long-form GTJFN. +; A/ ,,0 ; flags will go into LH of .GJGEN. +; Clobbers only A. + +TFMAP: HRR A,$FVERS(F) ; Put version # in RH + SKIPE $FTEMP(F) ; If asking for temp file, + TLO A,(GJ%TMP) ; set appropriate flag. + MOVEM A,GTJBLK+.GJGEN +IRP FROM,,[$FDEV,$FDIR,$FNAME,$FTYPE,$FPROT,$FACCT,$FJFN]TO,,[.GJDEV,.GJDIR,.GJNAM,.GJEXT,.GJPRO,.GJACT,.GJJFN] + MOVE A,FROM(F) + MOVEM A,GTJBLK+TO +TERMIN + MOVE A,[.NULIO,,.NULIO] + MOVEM A,GTJBLK+.GJSRC ; Don't hack I/O in gtjfn. + POPJ P, + +.VECTOR GTJBLK(10.) ; Need exactly this many wds for non-extended long call + +IFE PMAPSW,[ + ; EOFCH seen in input, check it here. + +INCHR3: HRRZ CH1,UREDP ; Get byte pointer + CAME CH1,UTIBED ; End of block? + RET ; No, ^C in file. + MOVE A,IUREDP + MOVEM A,UREDP + PUSH P,T + SYSCAL SIN,[JFNCHS+UTYIC ? [444400,,UTIBUF] ? [-UTIBFL]][A ? A ? A] + POP P,T + ADDI A,UTIBUF+UTIBFL ; Get UTIBUF + <# bytes stored> + CAIG A,UTIBUF ; If the sin didn't give us anything, we are at eof. + JRST RPAEOF + HRRZM A,UTIBED ; Store rh (updated pointer) for eof check at inchr3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ; Store a ^c after the data we read + JRST RCHTRA ; Now try next character + +] ; IFE PMAPSW + +IFN PMAPSW,[ ; New stuff for PMAP'ing input etc. + +VBLK +IFNDEF NIBFPS,NIBFPS==10 ; # of pages per buffer +PGBFL==NIBFPS*1000 ; Length of a buffer in wds. +IFNDEF 1STBFP,1STBFP==500 ; # of first page to start buffers at. + +INBFPG: 1STBFP ; # of 1st buffer page (in our address space) +INFPAG: 0 ; # of page in file corresponding to 1st page in buffer. +INPGCT: 0 ; -# times to refill buffer with new pages. +INLPGS: 0 ; # pages to slurp on last refill (instead of NIBFPS) +UTIBPE: 0 ; BP to last byte of data in buffer (holding ^C) +UTIBPL: 0 ; BP to last byte position in buffer area (constant) +UTIBPX: 0 ; BP to last byte of data when last pages have been mapped. +INLCHR: 0 ; Place to save char that ^C replaces. If -1, no char. +;SOSSW: 0 ; non-Z if hacking SOS line-number type file. +FBBYV: 0 ; GTFDB dumps cruft in these two locs. +FBSIZ: 0 ; e.g. this gets size of file in bytes. +PBLK + + ; Wrap up open of an input file, by initializing all the cruft + ; above. +OPNR50: SYSCAL GTFDB,[$FJFN(F) ? [2,,.FBBYV] ? MOVEI FBBYV] + LDB C,[300600,,FBBYV] ; Get byte size of file + CAIN C, + MOVEI C,36. ; If 0 use 36-bit bytes (full wds) + MOVEI A,36. + IDIVI A,(C) ; Get bytes per wd, ignore remainder. + MOVE B,FBSIZ ; Now, with # bytes in file, + EXCH A,B + IDIVI A,(B) ; find <# in fil>/<# per wd> = # wds in file + CAIE B, ; Also hack + ADDI A,1 ; rounding up (gasp, wheeze, finally done.) + IDIVI A,PGBFL ; Now get # times buffer will need slurping... + CAIE B, + ADDI A,1 ; Also round up. B has # "live" words in last slurp. + MOVNM A,INPGCT ; Store -# slurps. + MOVEI A,1777(B) + LSH A,-9. ; Find # pages last slurp really needs. + MOVEM A,INLPGS ; and store away. + HRLI B,010700 + MOVEM B,UTIBPX ; Store relative BP to last ch (when last pages mapped) + HRRI B,PGBFL-1 ; And relative BP to last char in whole buffer + MOVEM B,UTIBPL + MOVE A,INBFPG ; Find page # buffer starts at in core, + LSH A,9. ; Get address, and + ADDM A,UTIBPX ; add into the BP's to make them absolute. + ADDM A,UTIBPL + HRLI A,010700 ; also get initial read pointer from that. + SUBI A,1 ; MUST be "canonical form", so that SEMIC hackery + MOVEM A,IUREDP ; will work with weird way INCHR3 returns here. + MOVNI A,NIBFPS ; Use this as initial file page #, so the ADDB in + MOVEM A,INFPAG ; INCHR3 will do right thing to it. + MOVE A,[440700,,[EOFCH_35]] + MOVEM A,UREDP ; set up things so first RCH will instantly cause reload. + ILDB B,A + MOVEM A,UTIBPE + SETOM INLCHR ; Mustn't forget that we don't have a stored char yet. + JRST OPNRD4 ; Finally done with PMAP init stuff. + + ; Come here when hit ^C +INCHR3: MOVE CH1,UREDP ; Get current read ptr + CAME CH1,UTIBPE ; At end of buffer? + POPJ P, ; Nope, ^C in file, actual input. + AOSLE CH1,INPGCT ; Aha, end of buffer. Bump times refilled... + JRST [ SKIPGE A,INLCHR ; and if no more refills, see if last char left + JRST RPAEOF ; No? All done, true EOF. + SETOM INLCHR ; Almost, one last char. + MOVE CH1,UREDP ; Must bump ptr back one char, so next read + ADD CH1,[070000,,] ; will also stop. + CAIG CH1, + SUB CH1,[430000,,1] + MOVEM CH1,UREDP + JRST INCHR7] ; Return char in A. + MOVE A,IUREDP + MOVEM A,UREDP +IFN A-1,PUSH P,R1 +IFN A-2,PUSH P,R2 +IFN A-3,PUSH P,R3 + MOVEI R1,NIBFPS ; Get # of input buffer pages + ADDB R1,INFPAG ; and find current page in file to get + HRL R1,$FJFN+INFB ; current input file's JFN + MOVE R2,INBFPG ; and usual pointer to destination buffer page + HRLI R2,.FHSLF ; Why the fuck doesn't 10X default this?!?! + MOVEI R3,NIBFPS ; Set # pages to slurp up + CAIN CH1, ; But if this is last slurp, + MOVE R3,INLPGS ; use pre-calculated # to avoid non-ex pages. + TLO R3,(PM%CNT+PM%RD+PM%CPY) ; Read access, copy-on-write. +INCH50: PMAP ; Gobble gobble + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI R3,-1(R3) ; Else, on 10X, must iterate manually. + TRNE R3,400000 ; See if became "negative". + JRST .+1 ; Yep, done with manual iteration. + ADDI R2,1 ; Nope, bump page #'s. + AOJA R1,INCH50] +IFN A-3,POP P,R3 +IFN A-2,POP P,R2 +IFN A-1,POP P,R1 + CAIE CH1, ; Was this the last slurp? + SKIPA CH1,UTIBPL ; no, use BP to Last char at end of buffer. + MOVE CH1,UTIBPX ; yes, need BP to last char in last page. +IFN 0,[ SKIPE SOSSW ; If hacking line number lossage, + JRST [ MOVE A,(CH1) ; must beware of getting wiped, so have to + TRNE A,1 ; check here, and if depositing EOFCH in #, + HRLI CH1,350700 ; then move the EOFCH to beg of word! + JRST .+1] +] + LDB A,CH1 ; Replace last char of buffer's data + MOVEI CH2,EOFCH + DPB CH2,CH1 ; with the EOF char. + MOVEM CH1,UTIBPE ; Remember ptr to end of data, + EXCH A,INLCHR ; and save char for then, returning whatever + JUMPL A,RCHTRA ; was the last char of last bufferfull. + ; (may be -1, in which case RCHTRA tries again) + + ; Jump here to return a new char in A, something like + ; RCHTRA without all the fuss. +INCHR7: POP P,CH1 ; Get return addr + ANDI CH1,-1 + CAIE CH1,RREOF+1 + JRST -2(CH1) ; Note -2 not -3 as in RCHTRA! + JRST (CH1) ; Special hack since -2 loses for RREOF. + ; Perhaps someday it will win. +] ; IFN PMAPSW + +] ;END IFN TNXSW + +ifn 0,[ ; turn off but keep around for a while. +SUBTTL old .INSRT Processing + +; .INSRT ; Insert file here +; TTY: => ok, reads line at a time, rubout allowed within line +; Pushes macro expansion, other .INSRT's +; In filedescription, ^R => reset file name counter [?!? - KLH] +; If device is "@:", always ask for translation. + +A.INSR: NOVAL + MOVE A,[ISFB,,FB] ; Default names are those of spec'd input file + BLT A,FB+L$FBLK-1 ; Zap them into scratch filblk. + MOVEI F,FB ; And point at it. + MOVE A,FSDSK + MOVE B,FSTTY ; Compare "TTY" with + CAMN B,$FDEV(F) ; device name, and if identical, + MOVEM A,$FDEV(F) ; default to DSK. +IFE ITSSW,MOVE A,FSMID ; Always set default extension to "MID" or ">" +IFN ITSSW,MOVE A,FSGRTN + MOVEM A,$FEXT(F) + + TLO FF,FLUNRD +A.IN1: PUSHJ P,RFD ; Read file description + MOVE A,$FDEV(F) ; Get specified device name + CAME A,FSATSN ; Atsign? + PUSHJ P,A.ITRY ; No, try opening file + + ; If return, open failed. + MOVE A,$F6DEV(F) + AOJE A,A.INT1 ; Already trying to set up table entry + SKIPA F,[MAXIND,,TBLOFS] ; Atsign, or fnf, search table + +A.IN2: SUBI F,-L$FBLK ; Loop point searching table, increment to next entry, count down LH + CAMN F,INDDP ; Compare with pointer to top of table + JRST A.IN3 ; Agree => this file not in table + +; MOVEI A,-TBLOFS(F) ; Get index relative to table base. +; MIDAS complains "illegal use of relocation" when try to use above addr, so must use next 2 instructions instead - barf barf + MOVEI A,(F) + SUBI A,TBLOFS + + MOVSI B,-L$FBLK ; And index into FB. + MOVE T,TBLSFS(A) ; Get specification name this entry +A.IN25: CAMN T,FB(B) ; Compare with that just specified + AOBJN B,[AOJA A,.-2] ; Check all names this entry +IFE TNXSW, JUMPL B,A.IN2 +IFN TNXSW,[JUMPL B,[ MOVEI C,(B) + CAIN C,$FJFN ; One item of entry didn7t match, was it JFN? + JRST A.IN25 ; Yes, ignore it and continue. + JRST A.IN2] ; Sigh, was something else, entry doesn't match. + ] + + ; File is in table + MOVSI A,(F) ; Move description from TBLOFS to FB. + HRRI A,FB + BLT A,FB+L$FBLK-1 +IFN TNXSW, SETZM FB+$FJFN ; Since re-opening, must zap previous JFN. + PUSHJ P,A.ITRY ; Try opening file + + ; If return, open failed. + MOVSI A,TBLSFS-TBLOFS(F) ; Set up LH(BLT pointer), + HRRI A,FB + BLT A,FB+L$FBLK-1 ; Unmap to original names(TBLSFS to FB) + PUSHJ P,TYPFB ; Type out specified names + TYPE " -> " ; Type out pointer + MOVSI A,(F) ; Copy translation (TBLOFS entry) back to FB. + HRRI A,FB + BLT A,FB+L$FBLK-1 + SETOM $F6DEV(F) ; "half-kill" entry in TBLOFS + +A.INT1: PUSH P,F + MOVEI F,FB + PUSHJ P,IOPNER ; Open lost, type out cruft + POP P,F + TYPE "Use what filename instead? " +A.INT2: PUSHJ P,GTYIP ; Prepare to read one line from tty + JRST A.IN1 ; Try again with what he types in + + ; File not in table, try to add a translation for it. + +A.IN3: TLNN F,-1 ; More room for another entry in table? + ETF [ASCIZ /Too many @: files/] + MOVEI A,TBLSFS-TBLOFS(F) ; Copy FB into TBLSFS (specified name) + HRLI A,FB + BLT A,TBLSFS-TBLOFS+L$FBLK-1(F) + SETOM $F6DEV(F) ; Document fact that entry has only key, not translation + MOVNI A,-L$FBLK + ADDM A,INDDP ; Update pointer into table + MOVE A,FB+$FDEV ; Get specified device name + CAME A,FSATSN ; Atsign? + JRST A.INT1 ; No, type out garbage and try again, reading from tty + MOVE A,ISFB+$FDEV ; Yes, clobber from input device name + MOVEM A,FB+$FDEV + JRST A.INT2 + +;TRY OPENING INPUT FILE FOR .INSRT, RETURN IF UNSUCCESSFUL + +A.ITRY: MOVE A,FB+$FDEV ; Get specified device name + CAMN A,FSTTY ; TTY? + JRST A.ITRT ; Yes, treat special + TLO FF,FLUNRD + PUSHJ P,IPUSH ; Save current status + PUSH P,F ; save what F points at + MOVEI F,FB + PUSHJ P,OPNRD1 + JRST [POP P,F ? JRST IPOPL] ; Lose, pop and return + POP P,F + MOVE B,[FB,,INFB] ; Kludge for time being - if win, + BLT B,INFB+L$FBLK-1 ; Copy all stuff into INFB. +IFN ITSSW,CALL SETWH2 + MOVE B,ITTYP + MOVEI A,-1-TYPDEL(B) ; + HRLI A,IFNM1 + BLT A,-TYPDEL(B) ; Introduce hysteresis so .INSRT'ing file can reference .IFNM1, .IFNM2 +IFN CREFSW,[ + SKIPE CRFONP ; If creffing, output push-file block. + PUSHJ P,CRFPSH ; (pop-file block output at ipop) +] +A.ITR2: + MOVE A,$F6DEV(F) ; Push successful, now check to see if table entry should be finished + AOJN A,ASSEM1 + MOVEI A,(F) ; Move FB into TBLOFS as translation entry. + HRLI A,FB + BLT A,L$FBLK-1(F) + JRST ASSEM1 ; Now assemble from file (ASSEM1 clobbers pdl) + + ; .INSRT TTY: + +A.ITRT: PUSHJ P,GTYIPA ; Read from tty, don't quit until .INEOF + JRST A.ITR2 ; Fall back in (doesn't touch .IFNM1, .IFNM2) +] ; end IFN 0 + +SUBTTL .INSRT Processing + +; .INSRT ; Insert file here +; TTY: => ok, reads line at a time, rubout allowed within line +; Pushes macro expansion, other .INSRT's +; If device is "@:", always ask for translation. + +A.INSR: NOVAL + + ; First set up defaults for parsing filename. + BLTM L$FBLK,ISFB,FB ; Default names are those of spec'd input file, + MOVEI F,FB ; stuffed into scratch FB. + MOVE A,FSDSK + MOVE B,FSTTY ; Compare "TTY" with + CAMN B,$FDEV(F) ; device name, and if identical, + MOVEM A,$FDEV(F) ; default to DSK. +IFE ITSSW,MOVE A,FSMID ; Always set default extension to "MID" or ">" +IFN ITSSW,MOVE A,FSGRTN + MOVEM A,$FEXT(F) + + TLO FF,FLUNRD + PUSHJ P,RFD ; Read file description from current input. + MOVE A,$FDEV(F) ; Get specified device name + CAMN A,FSATSN ; Atsign? + JRST A.IN50 ; If so, check out translation right away. + +A.IN2: CAMN A,FSTTY ; TTY? Must handle specially. + JRST [ PUSHJ P,GTYIPA ; Set up to read until .INEOF or EOF char. + JRST ASSEM1] ; And don't do anything to .IFNM1/2, etc. + PUSHJ P,IPUSH ; File, push the world. + PUSHJ P,OPNRD1 ; Try opening file. + JRST [ PUSHJ P,IPOPL ; Sigh, failed, pop world back and go + JRST A.IN50] ; try translation entries or TTY input. + ; Always jumps back to A.IN2. + + ; Come here when input file successfully opened. Clean up etc. +IFN ITSSW,CALL SETWH2 + MOVE B,ITTYP + BLTM 2,IFNM1,-1-TYPDEL(B) ; Copy new .IFNM1, .IFNM2 onto stack, + ; to clobber .IFNM1/2 for previous file, so + ; that .IFNM1/2 etc refers to last file .INSRT'd by + ; current file (or current file if none .INSRT'd yet) +IFN CREFSW,[ + SKIPE CRFONP ; If creffing, output a push-file block. + PUSHJ P,CRFPSH ; (pop-file block is output at IPOP) + ] + + BLTM L$FBLK,(F),INFB ; Move current filespec to INFB, + JRST ASSEM1 ; and jump off to smash things to toplevel. + + ; Come here when open attempt fails or @: device specified. +A.IN50: CAIE F,FB ; Tried translations yet? + JRST A.IN60 ; Yes, skip table hacking and go get fnm from TTY. + + ; First open attempt, so OK to search translation table. + SKIPA D,[MAXIND,,TBLOFS] ; Load up aobjn-style index to transl table +A.IN52: SUBI D,-L$FBLK ; Loop point for searching table - increment to next entry, count down LH + CAMN D,INDDP ; Compare with pointer to top of table + JRST A.IN60 ; Agree => this file not in table, get from TTY. + + MOVEI A,(D) ; Get scratch index into tables, + HRLI A,-L$FBLK ; making AOBJN of it, + MOVEI B,(F) ; and get index into current FB. +A.IN54: MOVE C,TBLSFS-TBLOFS(A) ; Get a specification name for this entry +IFN TNXSW,CAIE B,$FJFN(F) ; (ignoring the JFN item, for TENEX) + CAMN C,(B) ; Compare name with that of failed filblk. + AOBJN A,[AOJA B,A.IN54] ; Check all names this entry + JUMPL A,A.IN52 ; If not found, try next entry. + + ; File is in table, try opening it using TBLOFS description. + MOVE F,D ; Replace old F by ptr to winning TBLOFS entry. +IFN TNXSW, SETZM $FJFN(F) ; Since re-opening, must zap any previous JFN. + JRST A.IN2 ; Jump off to try opening. + + ; Come here when open failed and no matching transl entry. + ; Must set up to gobble down a translation from TTY... +A.IN60: TYPE "Error in .INSRT; " + CAIE F,FB ; Were we trying to open a translated entry? + JRST [ PUSHJ P,TYPFB ; Yes, so print out appropriate info + TYPE " -> " ; to show translated stuff. + JRST A.IN70] + + ; First time, no translation entry exists, make one. + MOVE A,INDDP ; Get current pointer to top of tables + TLNN A,-1 ; Room for more? + JRST A.IN70 ; Nope, can't remember transl, but get right fnm anyway. + MOVE F,A ; Yep, use it as pointer to table entry to use. + SUBI A,-L$FBLK ; and get new table-top pointer with clever + MOVEM A,INDDP ; SOS of LH and ADDI to RH. + BLTM L$FBLK,FB,(F) ; Move FB contents to both TBLOFS, + BLTM L$FBLK,FB,TBLSFS-TBLOFS(F) ; and TBLSFS. + +A.IN70: ; Print out filename F points to, & err msg. +IFN TNXSW,[ + PUSHJ P,OPNER1 + PUSHJ P,RDJFNI ; On 10X, get new filename this way. + ] +IFN ITSSW\DECSW,[ ; Elsewhere do it painful way. + PUSHJ P,IOPNER + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Setup to read 1 line from TTY, + PUSHJ P,RFD ; and do it, parsing filename. +] + JRST A.IN2 ; now go try opening it. + +SUBTTL Misc. .INSRT-related things + + ; .INEOF - EOF pseudo + +A.IEF2: PUSHJ P,PMACP ; Loop point, pop entry off macro pdl +A.INEO: TLNE FF,FLMAC ; Inputting from macro? + JRST A.IEF2 ; Yes, pop it off + PUSH P,CMACCR ; Back to inputting from file or tty, cause return to maccr + MOVE B,ITTYP ; Get pdl pointer + POPJ B, ; Return to pop routine + + + ; Call from ERRH; type input file's names if changed since last err msg. +ERRTFL: MOVE C,INFCUR + EXCH C,INFERR ; Say last error msg in this file. + CAMN C,INFERR ; If prev. msg was in other file, + POPJ P, + PUSH P,F + MOVEI F,INFB ; Point to current input file, + PUSHJ P,TYPFB ; and type out its filename. + POP P,F + PJRST CRRERR + +SUBTTL COMMON IO PDL routines for input. (.INSRT support) + +;IO PDL ROUTINES FOR INPUT FILE +; Push the input file + +IPUSH: AOSN CMEOF ; Want to pop out of tty? (^C typed in) + CALL POPTT ; Yes, do now before forget. + +IFE PMAPSW,[ + MOVE D,UREDP ; Get input byte pointer +IFN ITSSW\TNXSW,[ +IFN ITSSW, .IOPUS UTYIC, +IFN TNXSW, MOVEI A,UTYIC ? PUSHJ P,$IOPUSH + TLNN D,760000 ; At end of word? + ADD D,[430000,,1] ; Yes, make it point to beginning of next word + MOVEM D,UREDP + MOVNI A,-2(D) + ADD A,UTIBED ; Get # wds we'll need in MACTAB. + HLR D,UTIBED ; Remember whether EOF on last .IOT. + HRRZS UTIBED ; Now clear out left half for following +] +IFN DECSW,[ + AOS A,UTICHN ; Do ".IOPUSH" - use next channel. + LSH A,27 + ADD A,[WAIT-<0 1,>] ; Construct a WAIT uuo for the current input channel. + MOVE C,RCHMOD ; We mustn't copy the buffers while I/O is going on. + CAMN A,[WAIT UTYIC,] ; But: if we are currently in the top-level input file + CAIE C,3 ; And it is device TTY:, this channel was never opened. + XCT A ; Don't move buffers while io going on! + MOVEI A,UTIBFL+2 ; Assume must save all buffer space. +] + PUSH P,A + ADD A,FREPTB + ANDI A,-1 + PUSH P,A + CAML A,MACTND ; No room in MACTAB => gc it. + CALL GCA1 + REST A + CAML A,MACTND ; Did the GC win? + PUSHJ P,GCCORQ ; NO!! Try to win somehow + MOVEI A,370 + CALL PUTREL ; Indicate start of saved buffer. + REST A + AOS B,FREPTB + SUBI A,1 + MOVE C,ITTYP ; Get addr of tty pdl wd that'll point to saved buffer. + ADDI C,1 + HRRZM C,(B) ; Store in rh of 1st wd, + MOVEI C,(B) ; Remember addr of saved buffer to push on ttypdl. + HRLM A,(B) ; Put length in lh. + AOS B +IFN ITSSW\TNXSW,HRL B,UREDP ; LH <- addr of 1st wd to save. +IFN DECSW,HRLI B,UTIBUF + ADDI A,-2(B) ; Addr of last wd to blt into. + BLT B,(A) + HRLI A,041000 + MOVEM A,FREPTB ; Make free bp -> last byte just used. + SUB A,MACTAD + ANDI A,-1 + LSH A,2 + ADDI A,4 ; Get char addr of next free byte. + MOVEM A,FREEPT +] +IFN PMAPSW, CALL IOBPUS + + MOVE B,ITTYP ; Get local version of iopdl +IPSHP: +IFE PMAPSW, PUSH B,C ; Push -> saved buffer (GC will relocate) +IFN DECSW,PUSH B,UTIBED ? PUSH B,UTIHDR +REPEAT L$FBLK, PUSH B,INFB+.RPCNT ; Save names of input file. + PUSH B,INFCUR ; Save number of input file. +IFE PMAPSW, PUSH B,D ; Lh=lh(old uredp), rh=lh(old utibed) (or just UREDP) +IFN PMAPSW, INSIRP PUSH B,[INFPAG INPGCT INLPGS UTIBPE UTIBPL UTIBPX INLCHR UREDP IUREDP ] + + ; Following two must be last pushed + INSIRP PUSH B,[IFNM1 IFNM2] ; Clobbered on pdl if .open successful +INPDEL==.-IPSHP ; Length of each entry on pdl + + MOVE A,FREEPT ; W must use same gc convention as putrel; + CAML A,MACHI ; Namely, gc after using up the last byte. + CALL GCA1 + MOVEI A,0 ; => input from file + MOVEM B,ITTYP ; Store back updated pointer + JSP B,PUSHTT ; Save stuff, address modify and return + + + ; Pop into the input file +IPOP: +IFN CREFSW,[ MOVEI A,2 ; If creffing, output pop-file block. + SKIPE CRFONP + PUSHJ P,CRFOUT] +IPOPL: PUSHJ P,POPTT ; Come here if .INSRT's open failed. + PUSH P,C + MOVE B,ITTYP ; Get pointer + INSIRP POP B,[IFNM2 IFNM1] ; Pop stuff +IFE PMAPSW, POP B,A ; Pop off UREDP (or halves thereof) +IFN PMAPSW, INSIRP POP B,[ IUREDP UREDP INLCHR UTIBPX UTIBPL UTIBPE INLPGS INPGCT INFPAG] + POP B,INFCUR +REPEAT L$FBLK,POP B,INFB+L$FBLK-1-.RPCNT +IFN DECSW,[ + POP B,C + PUSH P,C ; Old UTIHDR + POP B,UTIBED +] +IFE PMAPSW, POP B,C + MOVEM B,ITTYP ; Save updated pdl pointer. +IFE PMAPSW,[ + HLRZ B,(C) ; Get length of saved buffer, +IFN ITSSW\TNXSW,[ + PUSH P,A +IFN ITSSW, CALL SETWH2 ? .IOPOP UTYIC, +IFN TNXSW, MOVEI A,UTYIC ? CALL $IOPOP + REST A + MOVEI AA,UTIBUF-1(B) ; Get addr of 1st wd won't blt into in utibuf, + HRLI AA,(A) ; Get saved lh of utibed, + MOVEM AA,UTIBED + HRRI A,UTIBUF ; Make A -> 1st wd in buffer, +] +IFN DECSW,[ + MOVE AA,UTICHN + LSH AA,27 + IOR AA,[RELEAS] + XCT AA ; This code equivalent to .IOPOP. + SOS UTICHN + REST UTIHDR +] + MOVEM A,UREDP + MOVSI A,EOFCH_13 + MOVEM A,@UTIBED ; Put EOF char after buffer. + MOVSI A,1(C) ; Get addr of 1st data wd of saved buffer, + HRRI A,UTIBUF + CAIE B,1 + BLT A,UTIBUF-2(B) + HLLZS (C) ; Tell GC to reclaim saved buffer. +] ;IFE PMAPSW + +IFN PMAPSW, CALL IOBPOP + +POPCJ: REST C + RET + +;SAVE INTERNAL POINTERS CONCERNING INPUT MODE + +TYPDEL==2 ; Number of words in relevant pdl entry + +PUSHTT: PUSH P,A + PUSH P,F + AOSN CMEOF ; If supposed to pop out of tty soon, + CALL POPTT ; Do it now before cmeof clobbered. + MOVE F,ITTYP ; Get relevant pdl pointer + MOVEI A,0 + EXCH A,CLNN ; Set up new line number + HRL A,CPGN ; Save current page number + SETZM CPGN ; Now re-initialize + SKIPGE CRFILE ; Save cref-all-on-one-line flag. + TLO A,400000 + PUSH F,A ; Save cpgn,,clnn + MOVE A,-1(P) ; Retrieve new mode + PUSHJ P,PSHLMB ; Save limbo1 and set up instructions for new mode +IFN ITSSW,[ + CALL SETWH2 + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ; Store back updated pointer + JRST POPFAJ + + ; Restore internal pointers concerning input mode + +POPTT: PUSH P,A + PUSH P,F + MOVE F,ITTYP ; Get pdl pointer + PUSHJ P,POPLMB ; Pop into limbo1, set up new mode + POP F,A ; Get cpgn,,clnn + SETZM CRFILE ; Restore all-on-one-line flag. + TLZE A,400000 + SETOM CRFILE + HLRZM A,CPGN + HRRZM A,CLNN +IFN ITSSW,[ + CALL SETWH2 + ADD A,CPGN + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ; Store back updated pointer + JRST POPFAJ + +IFN ITSSW,[ +SETWH2: MOVE A,RCHMOD + CAIL A,2 + SKIPA A,[SIXBIT /TTY:/] + MOVE A,INFB+$F6FN1 + .SUSET [.SWHO2,,A] + MOVE A,A.PASS + LSH A,30 + ADD A,[SIXBIT /P0/+1] + RET +] + +SUBTTL Storage for IO PDL stuff + + ; IO PDL storage stuff + +VBLK +TYPDLS==TYPDLC*TYPDEL+INPDEL*MX.INS + ; "tty pdl", stores information about current input mode + ; (similar to macro pdl but not garbage collected) + +ITTYP: -TYPDLS-1,,TTYPDL ; Pdl pointer (typdel=length of each entry) +TTYPDL: NEDCHK ; Actual pdl: initial entry to overpop routine + BLOCK TYPDLS ; Pdl proper +PBLK + +SUBTTL TNX - IO PDL Routines (IOPDLC, $IOPUSH, $IOPOP) + +IFN TNXSW,[ + +IFN PMAPSW,[ + ; Push IO buffer & channel... +IOBPUS: PUSH P,A + MOVEI A,UTYIC + CALL $IOPUSH + MOVEI A,NIBFPS ; Point at next set of buffer pages. + ADDM A,INBFPG + POP P,A + POPJ P, + + ; Pop IO buffer & channel... +IOBPOP: PUSH P,A + MOVE A,INBFPG + HRLI A,NIBFPS + CALL DELPGS ; flush buffer pages. + MOVNI A,NIBFPS + ADDM A,INBFPG ; point down at previous set of buffer pages... + MOVEI A,UTYIC + CALL $IOPOP + POP P,A + POPJ P, + +; DELPGS - Take arg in A as <# pgs>,, and flush these pages. + +DELPGS: PUSH P,A + PUSH P,B + HLRZ B,A + HRLI A,.FHSLF ; ,, + TLO B,(PM%CNT) + PUSH P,T +DELPG2: SYSCAL PMAP,[[-1] ? A ? B][A ? A ? B] ; Free up buffer pages. + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI B,-1(B) ; Else, on 10X, must iterate manually. + TRNE B,400000 ; See if became "negative". + JRST .+1 ; Yep, done with manual iteration. + AOJA A,DELPG2] ; Nope, bump page #'s. + POP P,T + POP P,B + POP P,A + POPJ P, +] ;IFN PMAPSW + +; IOPDLC - Clear IOPDL stack, close all channels on it. +; Clobbers no ACs + +; for 10x, need to CLOSF and release each JFN on IOPDL stack. + +IOPDLC: PUSH P,T +IFN PMAPSW,[ + MOVEI T,1STBFP ; Reset to point at 1st page of buffer space. + MOVEM T,INBFPG +] + EXCH A,IOPDLP + JRST IOPDC3 +IOPDC2: SYSCAL CLOSF,[(A)] + JFCL + SUB A,[1,,1] +IOPDC3: CAMLE A,[-LIOPDL,,$IOPDL-1] + JRST IOPDC2 + EXCH A,IOPDLP + POP P,T + POPJ P, + +; $IOPUSH - Push I/O channel in A onto $IOPDL stack. +; Clobbers no ACs +; for 10X this means storing JFN on stack and clearing JFNCHS table entry. + +$IOPUSH:EXCH B,IOPDLP ; Get stack pointer + PUSH B,JFNCHS(A) ; save JFN for channel + EXCH B,IOPDLP + SETZM JFNCHS(A) ; Zap entry in channel table to make it look gone + POPJ P, + +; $IOPOP - Pops channel off $IOPDL into channel # in A. +; Clobbers no ACs + +; for 10X just pop $IOPDL into JFNCHS, must close and release old JFN tho. + +$IOPOP: PUSH P,T + SYSCAL CLOSF,[JFNCHS(A)] + JFCL + POP P,T + EXCH B,IOPDLP ; Get stack ptr + POP B,JFNCHS(A) + EXCH B,IOPDLP + POPJ P, + +VBLK +JFNCHS: BLOCK 20 ; Channel table index, JFNCHS(ch) gets JFN for chan. + ; (zero if none) +LIOPDL==8. ; Length of IO PDL +IOPDLP: -LIOPDL,,$IOPDL-1 +$IOPDL: BLOCK LIOPDL +PBLK +] ; IFN TNXSW + +SUBTTL DEC - IO PDL Routines (IOPDLC) + +IFN DECSW,[ + +; IOPDLC - Simulate ITS .IOPDL call. Flushes all channels from +; UTICHN downwards to UTYIC. Actually not a simulation but something +; that works in the particular situation for which MIDAS uses .IOPDL. + +IOPDLC: MOVEI A,UTYIC + EXCH A,UTICHN ; Set input chnl num. to lowest. + LSH A,27 + IOR A,[RELEAS] ; Set up to releas the highest in use first. +IOPDL1: XCT A ; Releas one input channel, + CAMN A,[RELEAS UTYIC,] + RET ; All done. + SUB A,[0 1,] + JRST IOPDL1 ; Releas the next one down. +] ;IFN DECSW + +SUBTTL COMMON TTY input routines & variables + +VBLK +CMBUF: BLOCK CMBFL ; Typein buffer (also used as JCL buffer) +CMPTR: 0 ; Byte pointer to CMBUF. +CMEOF: 0 ; -1 => POPTT instead of reloading after this bufferfull. +TTYOP: 0 ; -1 => the TTY is already open. +LINEL: 0 ; Width of TTY (may be 1,, meaning assume infinite). +A.TTYFLG: ; Value of .TTYFLG pseudo - another label for TTYFLG. +TTYFLG: 0 ; TTY typeout permitted iff >= 0. +WSWCNT: 0 ; The number of W-switches in the last cmd string. +TTYBRF: 0 ; -1 => ^H break has been requested but not yet done. +PBLK + ; Cause input from tty (main routines) + +GTYIPA: SETZM A.TTYF ; Push to tty, don't stop at cr. + +IFN ITSSW, TYPECR "TTY: .INSRTed, end input with ^C" +IFN DECSW\TNXSW,[ + IFE SAILSW,TYPECR "TTY: .INSRTed, end input with ^Z" + IFN SAILSW,TYPECR "TTY: .INSRTed, end input with CTL-META-LF" + ] + +GTYIP1: SKIPA A,[3] +GTYIP: MOVEI A,2 ; Input from tty, stop after 1 line. + SETZM CMPTR ; Force reload on 1st read. + JSP B,PUSHTT ; Set up variables and return +GTYIPR: SETZM CMPTR ; Return on .ineof or cr + JRST POPTT + + ; Call here from ASSEM1 loop when a ^H interrupt is detected. +TTYBRK: SETZM A.TTYF + ETR [ASCIZ/^H - break /] ; Type filename, page and line #. + SKIPE ASMOUT + TYPECR "within a <>, () or []" + JRST GTYIPA + + ; RCHSET routines for reading from TTY + ; RCHMOD=3 => don't quit on CR + ; 2 => quit on CR. +RCHTRC: +RCHARC: TLO FF,FLTTY ; Set flag + JSP A,CPOPJ +RCHAC1: REPEAT 2,[ ; RCH2, RR1 + ILDB A,CMPTR ; Get char + CAIN A,0 ; End of string marked with 0 + PUSHJ P,TYRLDR ; Reload, jump back for next char +] + HALT ; RRL1 +IFN .-RCHAC1-RCHPSN,.ERR RCHAC1 LOSES. + ILDB A,CMPTR ; SEMIC + CAIN A,15 + JRST SEMICR + JUMPN A,SEMIC + PUSHJ P,TYRLD + JRST SEMIC + +TYRLD: MOVEI A,3 ; Return after the call, not before. + ADDM A,(P) + + ; TYRLDR - Read in string. + ; Reload buffer if ran out in call to RCH. + +TYRLDR: AOSN CMEOF ; EOF detected after last reload => + JRST RPAEOF ; Pop out of tty. + PUSH P,A + PUSH P,B + MOVE B,RCHMOD + PUSH P,F + PUSH P,A.TTYF ; If chars rubbed out they should be printed. + SETZM A.TTYF + MOVE F,[10700,,CMBUF-1] ; Initial byte pointer to buffer + MOVEM F,CMPTR ; Store as byte pointer for read +TYRLD2: PUSHJ P,TYI ; Get character +IFN TNXSW,[ + CAMN F,CMPTR ; at beg of line? + CAIE A,^J ; and char is LF? + CAIA + JRST TYRLD2 ; If so then ignore it completely. +] + CAIN A,177 ; Rubout? + JRST TYRLD3 ; Yes + CAIE A,^C + CAIN A,^Z + JRST TYRLD7 ; ^C, ^Z => EOF. Ought to be EOFCH for consistency? + CAIN A,^U + JRST TYRLD5 ; Rub out all + CAIE B,2 ; For .TTYMAC handling, convert lower case to upper. + JRST TYRLD6 + CAIL A,"A+40 + CAILE A,"Z+40 + CAIA + SUBI A,40 +TYRLD6: CAME F,[010700,,CMBUF+CMBFL-2] + IDPB A,F ; Store character in buffer unless buffer nearly full. + CAIE A,^M ; CR? + JRST TYRLD2 ; No, go back for next + CAIN B,2 ; .TTYMAC (mode 2) => CR ends input, so fake EOF. + SETOM CMEOF + MOVEI A,^J ; Follow the CR with a LF. + IDPB A,F + PUSH P,F ; Output the entire line to the error file + MOVE F,[10700,,CMBUF-1] +TYRLD8: CAMN F,(P) + JRST TYRLD9 + ILDB A,F + CAIN A,^M ; If line was ended by a ^C or ^Z, put that in error + SKIPL CMEOF ; file, which needs hair since that char is not + JRST TYRLD0 ; In the string we stored. + MOVEI A,"^ + CALL ERRCHR +IFN ITSSW,MOVEI A,"C +IFN DECSW\TNXSW,MOVEI A,"Z + CALL ERRCHR + LDB A,F +TYRLD0: CALL ERRCHR + JRST TYRLD8 + +TYRLD9: REST F + MOVEI A,0 + IDPB A,F ; Mark end of string + IDPB A,F + REST A.TTYF + REST F + REST B + REST A + JRST RCHTRA + +TYRLD7: SETOM CMEOF ; ^C, ^Z force EOF, + CALL TYRLCR ; After turning into ^M. + MOVEI A,^M + JRST TYRLD6 + +TYRLCR: MOVEI A,^M + CALL TYOX + MOVEI A,^J + JRST TYOX + +TYRLD3: CAMN F,[10700,,CMBUF-1] ; Rubout, beginning of buffer? + JRST TYRLD4 ; Yes + LDB A,F ; Get last character in buffer + CALL TYOX ; Type it out, don't write in error file. + ADD F,[70000,,] ; Decrement pointer + JUMPGE F,TYRLD2 ; Jump if valid + SUB F,[430000,,1] ; Was 440700,,something, back it up + JRST TYRLD2 + +TYRLD5: MOVE F,[10700,,CMBUF-1] ; ^U, back to beginning of line +TYRLD4: PUSHJ P,TYRLCR ; Rubout when at beginning of buffer, type CR + JRST TYRLD2 + +SUBTTL ITS - TTY routines (TYOX, TYI, TTYINI) and JCLINI. + +IFN ITSSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOP + CALL TTYINI + .IOT TYOC,A + POPJ P, + + ; TYI - Get (just typed in) char in A +TYI: SKIPN TTYOP + CALL TTYINI ; Open the tty if not already done. + .IOT TYIC,A + ANDI A,-1 ; Non-tty devices can return -1,,3. + JUMPE A,TYI + CAIN A,^L ; This must be assuming that ^L clears screen? + JRST TYI + POPJ P, + + ; Initialize tty +TTYINI: PUSH P,A + .OPEN TYIC,[.UAI,,'TTY] ; Input + .LOSE + .OPEN TYOC,[%TJDIS+.UAO,,'TTY] ; Display mode output + .LOSE + SYSCAL CNSGET,[1000,,TYOC ? 2000,,A ? 2000,,A] + MOVSI A,1 ; TTY: is translated to something else => assume infinite linel + MOVEM A,LINEL ; Else linel gets width of tty. + SETOM TTYOP ; Say the tty is now open. + JRST POPAJ + +JCLINI: SETZM CMPTR + .SUSET [.ROPTIO,,A] + TLNN A,%OPCMD ; Has our superior said it has a cmd? + RET ; No. + BLTZ CMBFL-1,CMBUF ; Zero all but last word, + SETOM CMBUF+CMBFL-1 ; and ensure last word non-zero. + .BREAK 12,[5,,CMBUF] ; Try to read command string. + MOVE A,[440700,,CMBUF] + SKIPE CMBUF ; If read a cmd-string, + MOVEM A,CMPTR ; Tell TYRLD, GO2A it's there. + POPJ P, + +]; END IFN ITSSW + +SUBTTL TNX - TTY routines (TYOX, TYI, TTYINI) and JCLINI + +IFN TNXSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOP + CALL TTYINI +IFN A-1,EXCH A,R1 + PBOUT +IFN A-1,EXCH A,R1 + POPJ P, + + ; TYI - Get (just typed in) char in A + ; There is a screw for 20X in that it's not really possible + ; to know if the system is going to feed you a CR-LF + ; or just a CR; TYRLD2 checks for that, by flushing LF's, but + ; this would be the place to check if it were easy to do. +TYI: SKIPN TTYOP + CALL TTYINI ; Open the tty if not already done. +IFN A-1,EXCH R1,A + PBIN ; Get char into AC 1 + JUMPE R1,.-1 ; Ignore nulls. + TLNE FF,FL20X ; Cretinous differences between 10X/20X + JRST TYI2 ; 20X, skip EOL check. + CAIN R1,^_ ; On 10X, CR turned into ^_ (EOL); change it back. + MOVEI R1,^M +TYI2: +IFN A-1,EXCH R1,A ; Restore everything to right place if necessary. + POPJ P, + + ; TTYINI - Initialize tty + +TTYINI: PUSH P,A + PUSH P,T + SYSCAL RFMOD,[[.PRIIN]][A ? A] + POP P,T + HLRZS A + ANDI A,177 ; Terminal width + CAIGE A,30. ; If too low, + ADDI A,128. ; Assume twenex crockishness + MOVEM A,LINEL ; Linel gets width of tty. + SETOM TTYOP ; Say the tty is now open. + POP P,A + POPJ P, + + ; Read "JCL" - RSCAN buffer or nnnMID.TMP file (from CCL) + +JCLINI: SETZM CMPTR + SKIPE CCLFLG ; Started at CCL location? + JRST JCLIN5 ; Yep, go snarf stuff specially. + TLNN FF,FL20X ; Is this Tenex? + JRST [ MOVEI R1,.PRIIN + BKJFN ; see what previous character was + POPJ P,; *Gasp* + PBIN + CAIE R1,^_ ; Tenex newline? + SETOM CMPTR ; No, set flag saying "TTY but no prompt" + POPJ P,]; and skip the Twenex hackery below + SETZ R1, ; If not, check RSCAN. + RSCAN ; See if have anything in RSCAN buffer. + POPJ P, ; Huh? Shouldn't happen, but ignore it. + JUMPLE R1,APOPJ ; Also return if char cnt says nothing there. + MOVNI R3,(R1) ; Aha, set up cnt for SIN + HRROI R2,CMBUF + MOVEI R1,.PRIIN ; Now ready for business... + SIN + LDB R1,R2 ; Now examine wages thereof + CAIE R1,^M ; Last char CR? + JRST [ MOVEI R1,^M + IDPB R1,R2 ; If not, make it so. + JRST .+1] + SETZ R1, + IDPB R1,R2 ; Must also ensure ASCIZ. + MOVE B,[440700,,CMBUF] ; Now must flush cruft that crufty EXEC + ILDB A,B ; sticks in crufty front of crufty line! + CAILE A,40 + JRST .-2 ; Flush until random ctl seen (space, ^M) + CAIE A,40 ; If it wasn't a space, + POPJ P, ; then forget about the whole thing. +JCLIN3: MOVE C,B ; Now flush spaces. Save last ptr for chars. + ILDB A,B + CAIN A,40 + JRST JCLIN3 + CAIN A,^M ; And is first non-space something besides CR? + POPJ P, ; Bah, there wasn't anything in the JCL!! + MOVEM C,CMPTR ; Else save ptr to start of real goods. + POPJ P, + + ; TNX snarf of CCL file. No such thing as tmpcor, so just + ; look for real file with appropriate name. +JCLIN5: SETZM CCLFLG ; Want 0 in case abort out, will reset if win. + GJINF ; Get job # in R3 + HRROI R1,CMBUF ; Use CMBUF to form filename string. + MOVEI R2,(R3) + MOVE R3,[NO%LFL+NO%ZRO+<3_18.>+10.] + NOUT ; ship out job num in 3 digits, radix 10. + HALT + HRROI R2,[ASCIZ /MID.TMP/] + SETZ R3, + SOUT ; Flesh out rest of filename string. + SETZ R2, ; Make sure it's ASCIZ. + BOUT + MOVE R1,[GJ%OLD+GJ%SHT] ; Use short-form GTJFN + HRROI R2,CMBUF ; and gobble name from CMBUF. + GTJFN + POPJ P, ; If failed, forget it. + MOVE R2,[070000,,OF%RD] ; Read 7-bit bytes + OPENF + POPJ P, ; Bah + HRROI R2,CMBUF ; Gobble stuff up. + MOVEI R3,CMBFL*5 ; Read until buffer full, + MOVEI R4,^J ; or LF seen. + SIN + JUMPLE R3,APOPJ ; Forget it if too big for buffer!! + + MOVE R2,[440700,,CMBUF] ; Aha, we've got something, so set + MOVEM R2,CMPTR ; pointer to slurped stuff. + SETOM CCLFLG + HRROI R2,UTIBUF ; Slurp rest into larger buffer, + MOVNI R3,UTIBFL*5 ; using count only. + SIN + JUMPGE R3,APOPJ ; Refuse to hack grossly large file. + ADDI R3,UTIBFL*5 + JUMPLE R3,APOPJ ; if nothing read, need write nothing out. + HRLI R1,(CO%NRJ) ; Don't release JFN, + CLOSF ; but stop reading from file. + POPJ P, + MOVE R2,[070000,,OF%WR] ; Now try to hack write access. + OPENF + POPJ P, + MOVE R2,R1 ; Source becomes destination... + HRROI R1,UTIBUF ; and UTIBUF becomes source, + MOVNS R3 ; for just as many bytes as were read. + SOUT + MOVEI R1,(R2) ; done, now just close file. + CLOSF ; (this time, release JFN). + POPJ P, + SETOM CCLMOR ; say that more CCL remains. + POPJ P, +] ; END IFN TNXSW + +SUBTTL DEC - TTY routines (TYOX, TYI, TTYINI) + +IFN DECSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOP + CALL TTYINI + OUTCHR A + POPJ P, + + ; TYI - Get a typed-in char in A + +TYI: SKIPN TTYOP ; Open the tty, if not already done. + CALL TTYINI + INCHWL A +IFN SAILSW,[ + CAIN A,612 ; On SAIL, EOF is 612, + MOVEI A,^Z ; so turn into normal EOF if found. +] + CAIE A,^M ; Throw away the LF after a CR. + RET + INCHWL A + MOVEI A,^M ; Note that TYRLDR will put it back in. + RET + +TTYINI: INSIRP PUSH P,AA A B +IFE SAILSW,[ + PJOB A, + TRMNO. A, + JRST TTYIN1 + MOVEI AA,1012 ; .TOWID + MOVE B,[2,,AA] + TRMOP. B, ; Read width of tty line into B. +] +TTYIN1: MOVEI B,80. ; TRMOP. failed or not tried => assume width is 80. + MOVEM B,LINEL + INSIRP POP P,B A AA + SETOM TTYOP + RET + + TMPLOC .JBREN, TTYREN +TTYREN: SETOM TTYBRF ; "REENTER" command comes here +R: G: JRST @.JBOPC ; To request a ^H-break. Note crufty labels pointing here. + +];IFN DECSW + +SUBTTL DEC Hackery for JCLINI - Read CCL commands. + +IFN DECSW\TNXSW,[ +VBLK +CCLFLG: 0 ; Flag to indicate CCL entry from COMPIL, SNAIL, CCL, or EXEC +CCLMOR: 0 ; -1 => There are more lines of CCL commands, + ; so do a RUN SYS:MIDAS when finished. +PBLK +] + +IFN DECSW,[ ; DEC only hacks CCL as "JCL". + +.SCALAR CCLFIL ; Saves FN1 for tmp file hacking. + +; Read MID temp core file, if that loses, try nnnMID.TMP file. +; Clobbers A,B,C,D. + +JCLINI: SETZM CMPTR + SKIPN CCLFLG ; Was midas called from CCL level? + RET ; No, do not snarf tempcore + SETZM CCLFIL ; No CCL file yet + SETZM CCLFLG ; If tmpcor loses want this 0 (will re-setom below) + BLTZ CMBFL,CMBUF ; Zero cmd buffer. + MOVE A,[2,,['MID,, ? -,,CMBUF-1]] ; read (leave last wd 0) + TMPCOR A, ; Read compil-generated command + JRST [ OPEN [17 ? 'DSK,, ? 0] ; No tempcore, maybe try dump mode. + RET ; Argh but let something else die + PJOB A, ; Get job # + IDIVI A,100. ; Want decimal job number in sixbit + ADDI A,'0 + LSH A,6 + IDIVI B,10. + ADDI A,'0(B) + LSH A,6 + ADDI A,'0(C) + LSH A,18. + HRRI A,'MID ; Form file name as nnnMID.TMP + MOVEM A,CCLFIL ; Save for writing below + MOVSI B,'TMP + SETZB C,D ; No protect or ppn trash + LOOKUP A ; Try to get file + RET ; Give up + MOVE A,[-,,CMBUF-1] + SETZ B, + INPUT A ; Try to read command + SETZB A,B + RENAME A ; Try to delete it now + JFCL ; Ignore failure + CLOSE ; Happy sail + JRST .+1] + SKIPN CMBUF ; One last check for it to be there + RET ; Alas, there is none + MOVE A,[440700,,CMBUF] ; Load a byte pointer to the command + SETOM CCLFLG + MOVEM A,CMPTR ; There is, set command pointer +JCLIN1: ILDB B,A + CAIE B,^J ; See if our command file has anything after 1st line. + JRST JCLIN1 + ILDB B,A + JUMPE B,JCLIN3 + SETOM CCLMOR ; It does; set flag so after handling 1st line we'll + MOVE C,[440700,,UTIBUF+2] +JCLIN2: IDPB B,C + ILDB B,A + JUMPN B,JCLIN2 + SUBI C,UTIBUF+1 ; Get # words written in utibuf. operand is relocatable! + HRLOI C,-1(C) ; These 2 insns turn size into -size,,utibuf+1 + EQVI C,UTIBUF+1 + MOVEM C,UTIBUF+1 + SKIPE A,CCLFIL ; Was this called with a temp file? + JRST [ MOVSI B,'TMP + SETZB C,D + ENTER A ; Try to re-write file + RET ; Sigh + MOVE A,UTIBUF+1 + SETZ B, + OUTPUT A + RELEASE + RET] + MOVSI C,'MID + MOVEM C,UTIBUF + MOVE C,[3,,UTIBUF] + TMPCOR C, + JFCL ; [KLH - there used to be some random cruft here.] +JCLIN3: RET + +] ;END IFN DECSW + +SUBTTL Old Command Line Reader (CMD) +ifn 0,[ + ; Read command & filenames & hack defaulting. + +CMD: SKIPE CMPTR ; Unless have DDT or RSCAN cmd string, + JRST CMD06 ; (we don't) + CALL CRR ; type a CRLF, prompt etc. +CMD05: SETZM CMPTR + TYPE "*" +CMD06: MOVEI A,3 ; Read from TTY (or string <- cmptr) + CALL RCHSET + MOVEI F,FB ; Point to scratch filblk. + BLTZ L$FBLK,FB ; and clear the whole thing. + TRO FF,FRCMND ; Tell RFD it's scanning a command line. + CALL RFD ; Now see if command null, and whether has _. +IFN DECSW\TNXSW,[ + CAIN A,"! ; If terminator was "!", go run program. + JRST RFDRUN +] + TRNN FF,FRNNUL ; If no filespec was seen, + CAIE A,^M ; and terminator is EOL, + CAIA + JRST CMD05 ; then prompt again and get another string. + TRZ FF,FRARRO ; Got something, clear saw-"_" flag. +CMD07: CAIN A,"_ + TRO FF,FRARRO ; FRARRO will be on if there's a "_" in string. + CAIN A,^M + JRST CMD1 ; Read thru the whole command. + CALL RFD + JRST CMD07 + + ; Now re-read the string, for real this time. Previous scan was + ; mainly just to see if "_" existed. If not, then first filename + ; must be input file, and output filenames are all defaulted. +CMD1: MOVE T,[440700,,CMBUF] ; Restore original ptr to + MOVEM T,CMPTR ; beginning of string. +IFN CREFSW,SETZM CREFP ; Clear all switches before decoding them. +INSIRP SETZM 0,ERRFP TTYINS WSWCNT +IFN LISTSW,[ + SETZM LISTP + SETOM LISTP1 ; Will be AOSed by each (L) switch. +] + + MOVE T,FSDSK + MOVEM T,$FDEV(F) +IFE TNXSW,[MOVE T,RSYSNM ? MOVEM T,$FDIR(F)] +IFN TNXSW, SETZM $FDIR(F) + SETZM $FNAME(F) + SETZM $FEXT(F) + + TRZ FF,FRNNUL + TRNE FF,FRARRO ; Don't gobble input spec as output! + CALL RFD ; Read bin file spec. + MOVE TT,FF ; Remember whether null + BLTMAC T,L$FBLK,(F),OUTFB ; Copy from scratch to OUTFB. + + MOVE T,$FDEV(F) + CAMN T,FSNUL + MOVE T,FSDSK + MOVEM T,$FDEV(F) +IFE ITSSW, MOVE T,FSCRF +IFN ITSSW, MOVE T,FSCREF + MOVEM T,$FEXT(F) + + TRNN FF,FRARRO ; If "_" doesn't exist in cmd line, + MOVEI A,"_ ; then only filespec is for input, kludge to get it. + CAIN A,"_ ; If "_" exists in cmd line, did we hit it? + JRST CMD2 ; Ran out of output specs => just use defaults. + CALL RFD ; Read cref file spec. +IFN CREFSW,[ + TRNN FF,FRNNUL ; If spec not null or ended by _, + CAIN A,"_ + SETOM CREFP ; We must want to cref. +CMD2: BLTMAC T,L$FBLK,(F),CRFFB ; Copy specs from FB to CREF FB. +] +IFE CREFSW,CMD2: + MOVE T,FSERR + MOVEM T,$FEXT(F) + CAIN A,"_ + JRST CMD6 ; No more output specs. + CALL RFD ; Read error file sppec. +IFN ERRSW,[ + TRNN FF,FRNNUL ; Nonnull spec or last spec => + CAIN A,"_ + SETOM ERRFP ; Must want an error file. +CMD6: BLTMAC T,L$FBLK,(F),ERRFB ; Copy specs from FB to ERR filblk. +] +IFE ERRSW,CMD6: +IFN LISTSW,[ +IFE ITSSW, MOVE T,FSLST +IFN ITSSW, MOVE T,FSLIST + MOVEM T,$FEXT(F) + CAIN A,"_ ; Any output spec remaining? + JRST CMD3 + CALL RFD ; Yes, read one. + SETOM LISTP ; List spec given implies want listing. +CMD3: BLTMAC T,L$FBLK,(F),LSTFB ; Copy specs from FB to LST filblk. +] + +CMD5: CAIN A,"_ + JRST CMD4 + CALL RFD ; Ignore any output specs not needed. + JRST CMD5 + +CMD4: MOVE T,FSDSK ; Default the input names. + MOVE A,$FDEV(F) + CAME A,FSPTP ; Don't leave dev name set to common out-only devs. + CAMN A,FSNUL + MOVEM T,$FDEV(F) +IFE ITSSW, MOVE T,FSMID +IFN ITSSW, MOVE T,FSGRTN ; > on ITS. + MOVEM T,$FEXT(F) + MOVE T,FSPROG + SKIPN $FNAME(F) ; The fn1 alone is sticky across the _. + MOVEM T,$FNAME(F) + + TRZ FF,FRARRO ; If only 1 name it should be FNAM1. + CALL RFD ; Read input spec. + BLTMAC T,L$FBLK,(F),ISFB ; Copy into specified-input filblk. + MOVE T,$FNAME(F) ; Default output FN1's to input. + SKIPN OUTFB+$FNAME + MOVEM T,OUTFB+$FNAME +IFN CREFSW,[ + SKIPN CRFFB+$FNAME + MOVEM T,CRFFB+$FNAME +] +IFN LISTSW,[ + SKIPN LSTFB+$FNAME + MOVEM T,LSTFB+$FNAME +] +IFN ERRSW,[ + SKIPN ERRFB+$FNAME + MOVEM T,ERRFB+$FNAME +] + MOVE A,FSNUL ; The output dev defaults to NUL: + MOVE T,$FDEV(F) ; If the input is from TTY: + CAMN T,FSTTY + TRNE FF,FRNNUL ; And the bin spec was null. + CAIA + MOVEM A,OUTFB+$FDEV + TRZ FF,FRARRO ; Don't louse up .INSRT's reading. + RET +] ;ifn 0 + +SUBTTL Command Line Reader (CMD) + + ; CMD - Read command & filenames & hack defaulting. + +.SCALAR CMDPSV ; Saves read ptr into CMBUF, for re-scanning. + +CMD: SKIPE T,CMPTR ; If we have DDT or RSCAN or CCL string, + JRST CMD06 ; go hack it without typing anything out. + CAMN T,[-1] ; If Tenex-type "JCL", normal TTY input 'cept no prompt + JRST CMD06X + CALL CRR ; Nope, must type a CRLF, prompt etc. +CMD05: TYPE "*" +CMD06X: SETZB T,CMPTR +CMD06: MOVEM T,CMDPSV ; Save pointer for later restoration + MOVEI A,3 ; Read from TTY (or string <- cmptr) + CALL RCHSET + + MOVEI F,ISFB ; Point to input-spec filblk. + BLTZ L$FBLK,(F) ; Zap it through and through. + TRO FF,FRCMND ; Tell RFD it's scanning a command line. + CALL RFD ; Now see if command null, and whether has _. +IFN DECSW\TNXSW,[ + CAIN A,"! ; If terminator was "!", go run program. + JRST RFDRUN +] + TRNN FF,FRNNUL ; If no filespec was seen, + CAIE A,^M ; and terminator is EOL, + CAIA + JRST CMD05 ; then prompt again and get another string. + TRZA FF,FRARRO ; Got something, clear saw-"_" flag. +CMD07: CALL RFD + CAIN A,"_ + JRST [ TRO FF,FRARRO ; FRARRO will be on if there's a "_" in string. + CALL RFD ; Gobble next filename, input filespec. + JRST CMD1] + CAIE A,^M + JRST CMD07 ; Read thru the whole command until read input filespec + + + ; Now re-read the string, for real this time. Previous scan was + ; mainly to latch onto input filespec and see if "_" existed. + +CMD1: SKIPN T,CMDPSV ; Restore original ptr if there's one, + MOVE T,[440700,,CMBUF] ; else point at beg of buffer. + MOVEM T,CMPTR + SETZM TTYINS ? SETZM WSWCNT ; Clear all switches. +IFN CREFSW,SETZM CREFP +IFN ERRSW, SETZM ERRFP +IFN LISTSW,SETZM LISTP ? SETOM LISTP1 ; Will be AOSed by each (L) switch. + SETZ A, + TRNN FF,FRARRO ; If "_" doesn't exist in cmd line, + MOVEI A,"_ ; then only filespec is for input, kludge to get it. + + MOVEI F,OUTFB + BLTZAC T,L$FBLK,(F) ; Clear output filblk. + MOVE T,FSDSK ; Default dev to DSK. + MOVEM T,$FDEV(F) + SKIPN T,$FNAME+ISFB ; Now default FN1 from input filespec + MOVE T,FSPROG ; (use "PROG" if none) + MOVEM T,$FNAME(F) +IFE TNXSW,[MOVE T,RSYSNM ; Now default directory if need to + MOVEM T,$FDIR(F)] + + TRZ FF,FRNNUL + CAIE A,"_ ; If it exists, + CALL RFD ; Read bin file spec. + TRNN FF,FRNNUL ; If spec was null, + JRST [ MOVE T,FSTTY ; and input spec was TTY:, + CAME T,$FDEV+ISFB + JRST .+1 + MOVE T,FSNUL ; then set device to NUL:. + MOVEM T,$FDEV(F) + JRST .+1] + +DEFINE CFMAC SWIT,PTR,INSTR,DEXT +IFN SWIT,[ + MOVE T,DEXT + MOVE TT,[[INSTR],,PTR] +] .ELSE SETZB T,TT + PUSHJ P,CMDFGT +TERMIN + + CFMAC CREFSW,CRFFB,[SETOM CREFP][IFN ITSSW,[FSCREF] .ELSE FSCRF] + + CFMAC ERRSW, ERRFB,[SETOM ERRFP] FSERR + + CFMAC LISTSW,LSTFB,[SETOM LISTP][IFN ITSSW,[FSLIST] .ELSE FSLST] + +CMD50: CAIE A,"_ + JRST [ SETZB T,TT ; Point to scratch FB etc. + CALL CMDFGT ; Ignore any output specs not needed. + JRST CMD50] ; Must do this way to retain default stuffs. + + ; Finally read input file. + BLTMAC T,L$FBLK,(F),ISFB ; Copy last stuff to input spec + MOVEI F,ISFB ; and point at it. + PUSHJ P,CMDDVX ; Hack device-name default. +IFE ITSSW, MOVE T,FSMID +IFN ITSSW, MOVE T,FSGRTN ; > on ITS. + MOVEM T,$FEXT(F) + CALL RFD ; Read input spec. + RET ; Yep, that's really all! + + ; TT has ,, + ; T has default $FEXT. + ; Takes defaults from current F, sets F to new filblk. +CMDFGT: JUMPE TT,[SETZ T, ; If 0, do usual but into oblivion (scratch FB) + MOVE TT,[[JFCL],,FB] + JRST .+1] + BLTMAC B,L$FBLK,(F),(TT) ; Copy from current filblk to new. + MOVE F,TT ; set new F. + MOVEM T,$FEXT(F) ; Set default $FEXT + PUSHJ P,CMDDVX ; Set up device, defaulting to DSK. + CAIN A,"_ ; If last delimiter was start of input spec, + POPJ P, ; don't read anything - just use defaults. + PUSHJ P,RFD + TRNN FF,FRNNUL ; If spec non-null or + CAIN A,"_ ; ended by _, then + CAIA ; hack specified instr. + POPJ P, + HLRZ T,F + XCT (T) + POPJ P, + +CMDDVX: SKIPN T,$FDEV(F) + MOVE T,FSDSK + CAME T,FSPTP + CAMN T,FSNUL + MOVE T,FSDSK + MOVEM T,$FDEV(F) + POPJ P, + +SUBTTL ITS/DEC Filename Reader/printer (RFD, TYPFB) + +IFN DECSW\ITSSW,[ ; Begin moby conditional for sixbit reader. + +; RFD - Reads a single file description from .INSRT or command line, +; using RCH, into specified FILBLK. +; F points at FILBLK to store description in. +; Implements crufty ^R hack (if see ^R, act as if just starting to +; read filename, so effect is stuff before ^R has set defaults.) +; If FRCMND set, recognize -, comma, / and ( as special characters, +; and hack switches. +; Sets FRNNUL if spec was nonnull. +; Clobbers A,B,C only. + +RFD: TRZ FF,FRNNUL +RFD01: SETZM RFDCNT ; Zero cnt of "normal" filenames. Jump here if see ^R. + +RFD10: PUSHJ P,GPASST ; Flush out spaces/tabs + TRNN FF,FRCMND ; If parsing command line, + CAIE A,"; ; or if char isn't semi-colon, + JRST RFD22 ; just handle normally. +RFD15: PUSHJ P,RCH ; Semi-colon and not command line!! Flush rest + CAIE A,^M ; of line, assuming it's a comment! + JRST RFD15 + POPJ P, + +RFD2: PUSHJ P,RCH ; Get character in A +RFD20: CAIE A,40 ; Space (Come here to scan already-read char.) + CAIN A,^I ; or tab? + JRST RFD10 ; Ach, go into flush-whitespace loop. +RFD22: CAIN A,^M ; End of line? + POPJ P, ; If so, obviously done. + CAIN A,^R ; Crufty ^R hack? + JRST RFD01 ; Sigh, pretend just starting to read filename. + TRNN FF,FRCMND ; Reading command line? + JRST RFD40 ; Nope, skip over cmnd-line frobs. + + ; Reading cmd line, test special chars. +IFN ITSSW\SAILSW, CAIN A," ; SAIL underscore, ITS backarrow like _. + .ELSE CAIN A,"= ; Either gets munged, + MOVEI A,"_ ; into canonical "_". + CAIE A,"_ ; Backarrow is output_input marker. + CAIN A,", ; Comma is also a terminator... + POPJ P, +IFN DECSW\TNXSW,[ ; I'm not sure if this belongs here, but + CAIN A,"! .SEE RFDRUN + POPJ P, +] + PUSHJ P,CMDSW ; Check for switches... + JRST RFD20 ; Got some, scan next char (returned by CMDSW) + ; Got none, drop thru. + + + ; No special delimiters, + ; Check for chars which signal what following word is. +RFD40: +IFN DECSW,[ + CAIN A,"[ ;] Left bracket signals start of PPN. + JRST [ PUSHJ P,RFDPPN ; Slurp it up, + MOVEM C,$F6DIR(F) ; store it, + TRO FF,FRNNUL ; saying spec not null. + JRST RFD20] ; and go process leftover delimiter. + + CAIN A,". ; Period signals start of extension. + JRST [ PUSHJ P,RCH ; Get the next character + PUSHJ P,RFDW ; Read in a word. + MOVEM C,$F6EXT(F) ; Store it... + TRO FF,FRNNUL ; and say spec non-null (even if C/ 0) + JRST RFD20] ; and process delimiting char. +] + + ; Here, char doesn't signal the start of anything, so we'll assume + ; it's the start of a name. + PUSHJ P,RFDW ; Gobble up a word. + JUMPE C,RFD2 ; If nothing was read, must ignore char; get another. + + ; Aha, name was read, now examine delimiter to see if it specifies + ; anything we know about. + TRO FF,FRNNUL ; Set flag saying spec non-null. + CAIN A,": ; If colon... + JRST [ MOVEM C,$F6DEV(F) ; Then store name as device. + JRST RFD2] ; and flush delimiter. +IFN ITSSW,[ + CAIN A,"; ; If semicolon... + JRST [ MOVEM C,$F6DIR(F) ; Then store name as directory (sname) + JRST RFD2] ; and flush delimiter. +] + ; Whatever it is, at this point delimiter doesn't signify anything + ; special in terms of what the name is. So we just store it, using + ; the usual FN1 FN2 DEV DIR sequence, and hand delimiter off to + ; the prefix scanning stuff. + MOVE B,RFDCNT ; Get current count for random names. + XCT RFDTAB(B) ; Either MOVEM C, to right place, or ignore + AOS RFDCNT ; by skipping over this instr. + JRST RFD20 ; and go examine delimiter. + + +.SCALAR RFDCNT ; Count to index RFDTAB by. + +RFDTAB: MOVEM C,$F6FNM(F) ; 1st name. + MOVEM C,$F6EXT(F) ; 2nd name. + MOVEM C,$F6DEV(F) ; 3rd name is dev. + MOVEM C,$F6DIR(F) ; 4th is sname. + CAIA ; 5th and on ignored, don't incr. cnt. + +; RFDW - Reads a "word" - any string of contiguous SIXBIT chars, +; barring certain delimiters, and leaves SIXBIT result in C. +; Begins reading with char currently in A. Returns with delimiter +; char in A (it's possible this can be the same char!) +; Clobbers B. + +RFDW: SETZ C, ; First things first, zap result. + SKIPA B,[440600,,C] +RFDW2: PUSHJ P,RCH + CAIN A,^Q ; Is char the quoter char? + JRST [ PUSHJ P,RCH ; Yup, gobble next... + CAIN A,^M ; and accept anything but CR + POPJ P, ; since that terminates the whole line. + JRST RFDW7] ; OK, go stuff the char into C. + CAIE A,40 ; Space + CAIN A,^I ; or tab + POPJ P, ; is always a break. + CAIN A,^M ; As is CR. + POPJ P, + TRNN FF,FRCMND ; And certain chars are bummers when reading cmd. + JRST RFDW4 + CAIE A,"/ + CAIN A,"( + POPJ P, +IFN DECSW\TNXSW, CAIE A,"= + CAIN A,"_ + POPJ P, +IFN ITSSW\SAILSW, CAIE A," + CAIN A,", + POPJ P, +IFN DECSW\TNXSW,[ + CAIN A,"! + POPJ P, +] + ; Not reading cmd line, or no cmd-line type chars seen. +RFDW4: +IFN ITSSW,[ + CAIE A,": ; For ITS filenames, these chars are special. + CAIN A,"; + POPJ P, +] +IFN DECSW,[ + CAIL A,140 ; For DEC, allow only alphanumeric. + SUBI A,40 ; cvt to uppercase, then + CAIL A,"A ; see if alpha. + CAILE A,"Z + JRST [CAIL A,"0 ; Nope, see if numeric. + CAILE A,"9 + POPJ P, ; Not alphanumeric, assume delimiter. + JRST .+1] +] +RFDW7: TLNN B,770000 ; Enough room in C for another char? + JRST RFDW2 ; Nope, ignore it and get next. + CAIL A,140 ; Enuf room, cvt lower to uppercase + SUBI A,40 + SUBI A,40 ; and cvt to sixbit, + IDPB A,B ; and deposit. + JRST RFDW2 ; Get another. + +] ; END IFN DECSW\ITSSW + +IFN DECSW,[ ; PPN Reader + +RFDPPN: PUSHJ P,RFDOCT ; Read project num, +IFN CMUSW, JUMPE C,RCMUPP ; At CMU watch for our funny ppns + HRLM C,(P) + PUSHJ P,RFDOCT ; Read programmer num. + HLL C,(P) + POPJ P, + +IFE SAILSW,RFDOCL=="0 ? RFDOCH=="8 ; Read octal numbers. +IFN SAILSW,RFDOCL==40 ? RFDOCH==140 ; Read sixbit (right-justified). + +RFDOCT: SETZ C, ; Read octal num, return in C. +RFDOC1: PUSHJ P,RCH + CAIL A,140 + SUBI A,40 +IFN SAILSW,[ ;[ ; Even if reading sixbit names (for SAIL), + CAIE A,", ; Comma and closebracket are still special. + CAIN A,"] + POPJ P, +] + CAIL A,RFDOCL + CAIL A,RFDOCH + POPJ P, ; Not octal or not 6bit, return. + IMULI C,RFDOCH-RFDOCL + ADDI C,-RFDOCL(A) + JRST RFDOC1 + +IFN CMUSW,[ ; [ +RCMUPP: CAIN A,"] ; Watch out for [] + POPJ P, +REPEAT 4, SETZM PPNBUF+.RPCNT + MOVE C,[440700,,PPNBUF] +RCMUPL: CAIE A,^M ; Don't look too far + SKIPE PPNBUF+3 + JRST RCMUPD + IDPB A,C + PUSHJ P,RCH ; [ + CAIE A,"] + JRST RCMUPL +RCMUPD: MOVE A,[C,,PPNBUF] + CMUDEC A, + SETZ C, + POPJ P, + +.VECTOR PPNBUF(4) ; Storage to buffer up a string for CMUDEC uuo to scan. + +] ;IFN CMUSW +] ;IFN DECSW + +IFN DECSW\ITSSW,[ + +; TYPFB - Type out current filblk (what F points at) as file specification +; Clobbers A,B,C + +TYPFB: MOVSI C,-3-ITSSW + HRR C,F +TYPF1: MOVE B,$F6DEV(C) ; Get next name + PUSHJ P,SIXTYO ; Type out name + HLRZ A,C + MOVE A,FILSPC+3+ITSSW(A) ; Now get delimiting character + PUSHJ P,TYOERR ; Type out + AOBJN C,TYPF1 ; Loop for all names +IFN ITSSW, POPJ P, +IFN DECSW,[ + SKIPN B,$F6DEV(C) ; On DEC system PPN is a special case + POPJ P, + MOVEI A,"[ ;] + CALL TYOERR +IFN CMUSW,[ + MOVE A,[B,,PPNBUF] + DECCMU A, + JRST OCTPPN + TYPR PPNBUF + JRST PPNRB + ] +IFE SAILSW,[ +OCTPPN: HLRZ B,$F6DEV(C) ; LH is proj, + CALL OCTPNT + ] +.ELSE [ HLLZ B,$F6DEV(C) + CALL SIXTYO +] + MOVEI A,", + CALL TYOERR +IFE SAILSW,[ + HRRZ B,$F6DEV(C) + CALL OCTPNT ; RH is prog. +] +.ELSE [ HRLZ B,$F6DEV(C) + CALL SIXTYO + ] +PPNRB: ; [ + MOVEI A,"] + JRST TYOERR +];IFN DECSW + +FILSPC: ": +IFN ITSSW, 40 ? 40 ? "; +IFN DECSW, ". ? 0 + +] ; END IFN DECSW\ITSSW + +SUBTTL Command switches + +; CMDSW - Hacks either a single switch or switch list; A should +; contain "/ for the former, "( for the latter. +; Returns in A next char after switch hackery done. This may be ^M. +; Skip returns if neither "/ nor "( was furnished to it. + +CMDSW: CAIN A,"/ ; Single switch? + JRST [ PUSHJ P,RCH ; Get next char + CAIN A,^M + POPJ P, + PUSHJ P,CMDSW1 + PJRST RCH] + CAIE A,"( ; Switch list? + JRST POPJ1 ; Neither slash nor paren, make skip return. +CMDSWL: PUSHJ P,RCH + CAIN A,^M + POPJ P, + CAIN A,") + PJRST RCH + PUSHJ P,CMDSW1 + JRST CMDSWL + + ; Command switch processing. CMDSW1 processes the switch char + ; in A. +CMDSW1: CAIL A,140 ; Lower case to upper. + SUBI A,40 + CAIN A,"T + SOS TTYINS ; Count # T-switches. + + CAIN A,"W ; W - prevent tty messages, and +IFE ERRSW,AOS WSWCNT ; request error output file if possible. +.ELSE [ + AOSA WSWCNT + CAIN A,"E ; E - request error log file. + SETOM ERRFP + ] + +IFN CREFSW,[ + CAIN A,"C ; C - request CREF output. + SETOM CREFP + ] + +IFN LISTSW,[ + CAIE A,"L ; L - request listing + POPJ P, + SETOM LISTP ; Say want listing. + AOS LISTP1 ; (starts as -1, will be positive after 2nd (L)) + ] + + POPJ P, + +SUBTTL TENEX Filename Reader/printer (RFD, TYPFB) + +IFN TNXSW,[ ; Moby conditional for Tenex reader. + +; TNXRFD - TENEX-style Filename Reader. +; Takes input from RCH, +; Deposits name strings into filblk F points to. +; Clobbers A,B,C,D, (and AA,T,TT due to FNCHK) +; Uses FRFEXT flag to see if already read extension (type) or not. +; Refuses to accept existing defaults for version, ;T, account, +; protection, or JFN. It will also zap an existing directory +; default if a device is specified, and vice versa. This is so that +; logical names will win a little better. +; Implements crufty ^R hack (if see ^R, act as if just starting to +; read filename, so effect is stuff before ^R has set defaults.) + +IFNDEF FRFDEV,FRFDEV==2 ; Set if read device. +IFNDEF FRFDIR,FRFDIR==1 ; Set if read directory. +IFNDEF FRFEXT,FRFEXT==FRFN1 ; Borrow this bit. Set if read extension. + +RFD: TRZ FF,FRNNUL + SETZM $FJFN(F) ; Zap JFN since the filename we'll read won't match it. + SETZM $FACCT(F) ; Also zap other things that we don't want defaulted. + SETZM $FPROT(F) + SETZM $FTEMP(F) + SETZM $FVERS(F) +TRFD01: TRZ FF,FRFEXT+FRFDEV+FRFDIR ; Jump here if ^R seen. +TRFD10: PUSHJ P,GPASST ; remove tabs, spaces and get first non-tab/space + TRNN FF,FRCMND ; If parsing command line, + CAIE A,"; ; or if char isn't semicolon, + JRST TRFD21 ; just handle normally. +TRFD15: PUSHJ P,RCH ; Semi-colon and not command line, it's a comment! + CAIE A,^M ; So flush rest, up to EOL. + JRST TRFD15 + POPJ P, + +TRFD1: TLO FF,FLUNRD ; come here to re-read last char +TRFD2: PUSHJ P,RCH ; Get char +TRFD21: CAIE A,40 ; Space? (come here to scan already-read char) + CAIN A,^I ; or tab? + JRST [TRNE FF,FRCMND ; Space/tab, if reading command line + JRST TRFD2 ; then ignore and continue scanning (for switches), but + JRST TRFD15] ; if not in cmd line, go flush entire rest of line! + CAIN A,^M ; End of line? + POPJ P, ; If so, obviously done. + CAIN A,^R ; Crufty ^R hack? + JRST TRFD01 ; Sigh, pretend starting over. + TRNN FF,FRCMND ; Must we check for cmd line frobs? + JRST TRFD22 ; Nope, skip them. + + ; Must check for chars special only in command line. + CAIN A,"= + MOVEI A,"_ + CAIE A,"_ ; backarrow is filename terminator... + CAIN A,", ; as is comma. + POPJ P, + CAIN A,"! ; For CCL hacking... + POPJ P, .SEE RFDRUN + PUSHJ P,CMDSW ; Check for switches... + JRST TRFD21 ; got some, process next char (returned by CMDSW) + ; Skips if none, drop thru. + + ; Now see if char signifies start of anything in particular. +TRFD22: CAIE A,"< ; Start of directory name? + JRST TRFD24 ; No + PUSHJ P,RCH + PUSHJ P,TRFDW ; Read word, starting with next char +TRFD23: CAIN A,". ; Allow . as part of directory name + JRST [ PUSHJ P,TRFDW5 ; Read a continuation to this word + JRST TRFD23] ; And try again + MOVEI D,$FDIR ; Set up index. + CAIN A,"> ; Terminator should be end of dir name... + PUSHJ P,RCH ; If so, get next to avoid scan of ">". + ; else bleah, but aren't supposed to fail... + TRNN FF,FRFDEV ; Unless a device has been explicitly given, + SETZM $FDEV(F) ; zap any furnished default. 0 means DSK. + TRO FF,FRFDIR ; Now say dir was explicitly given. + JRST TRFD6 ; Go store it. +TRFD24: CAIN A,". ; Start of $FTYPE or $FVERS (20x)? + JRST [ MOVEI D,$FTYPE ; Assume reading $FTYPE field, + TLNE FF,FL20X ; always if 10X, but if really on 20X, then + TRON FF,FRFEXT ; use $FTYPE only if not already seen. + JRST TRFD4 ; $FTYPE - jump to get word & store. + PUSHJ P,TRFDNM ; $FVERS - 20X and $FTYPE already seen. Get #. + MOVEM B,$FVERS(F) ; Store it away if successful. + JRST TRFD1] ; and go re-read delimiting char. + + CAIN A,"; ; Start of $FVERS (10x) or attribute? + JRST [ PUSHJ P,RCH ; Find what next char is. + CAIL A,"a ; Must uppercasify. + CAILE A,"z + CAIA + SUBI A,40 + CAIN A,"T ; Temporary file? + JRST [ SETOM $FTEMP(C) + JRST TRFD2] + CAIN A,"A ; Account? + JRST [ MOVEI D,$FACCT ; Set index, and + JRST TRFD4] ; go gobble following word. + CAIN A,"P ; Protection? + JRST [ MOVEI D,$FPROT ; Set index, and + JRST TRFD4] ; go gobble following word. + TLO FF,FLUNRD ; Not alpha, try numeric. Re-read char, + PUSHJ P,TRFDNM ; trying to parse as number. + MOVEM B,$FVERS(F) ; Win, parsed as number! Store it. + JRST TRFD1] ; If none of above, ignore ";" entirely. + + PUSHJ P,TRFDW ; Let's try reading it as word, + JUMPLE C,APOPJ ; If nothing read, assume it's some terminating delimiter. + CAIN A,": ; Else have something, check trailing delim for special cases + JRST [ MOVEI D,$FDEV ; Aha, a device. + PUSHJ P,RCH ; Flush the terminator & get next char. + TRNN FF,FRFDIR ; Unless dir was explicitly given, + SETZM $FDIR(F) ; zap furnished default. 0 uses connected dir. + TRO FF,FRFDEV ; Say device was explicitly given, and + JRST TRFD6] ; store name away. + MOVEI D,$FNAME ; Else assume it's the filename. + JRST TRFD6 + + +TRFD4: PUSHJ P,RCH ; Here when must gobble next char, +TRFD5: PUSHJ P,TRFDW ; here when first char of wd already read. +TRFD6: PUSHJ P,FNCHKZ ; Note this can return and store a null string! + ADDI D,(F) ; Get address (filblk+index), and + MOVEM A,(D) ; store string pointer in the appropriate place. + TRO FF,FRNNUL ; Say non-null spec seen, + JRST TRFD1 ; and go re-read the delimiter, to process it. + +; TRFDW - Read a word (string), for use by TNXRFD. Copies sequence of +; acceptable filename chars into FNBUF, until non-valid char seen. +; A/ First char of word, +; Returns A/ delimiting char, C/ count of chars in string, +; clobbers nothing else. + +TRFDW4: SUBI A,40 ; Make lowercase +TRFDW5: IDPB A,FNBWP ; Deposit into FNBUF, + PUSHJ P,RCH ; get next char, + AOSA C ; and bump count, skipping over zap instruction. +TRFDW: SETZ C, ; When called, zero cnt of chars in string. + CAIL A,"A ; See if char is uppercase alpha, + CAILE A,"Z + CAIA + JRST TRFDW5 + CAIL A,"a ; or lowercase alpha, + CAILE A,"z + CAIA + JRST TRFDW4 + CAIL A,"0 ; or numeric, + CAILE A,"9 + CAIA + JRST TRFDW5 + CAIE A,"$ ; or dollarsign + CAIN A,"- ; or hyphen + JRST TRFDW5 + CAIN A,"_ ; Backarrow is special case, because + JRST [ TRNN FF,FRCMND ; if reading command, + TLNN FF,FL20X ; or running on 10X, + POPJ P, ; must treat as delimiter. + JRST TRFDW5] + CAIN A,^V ; ^V is quote char... + JRST [ PUSHJ P,RCH ; Quote, get next. + CAIE A,^M ; Quote anything but this. + CAIN A,0 ; or this. + POPJ P, ; time to exit. + PUSH P,A ; Quote it! Save char, + MOVEI A,^V ; so that a quoter can precede it. + IDPB A,FNBWP ; Fortunately this hair + POP P,A ; only needs care + IDPB A,FNBWP ; for quoted chars, which are + JRST TRFDW5] ; rare. + TLNE FF,FL20X ; Are we on a 10X? + POPJ P, ; If not, anything at this point is delimiter. + CAIL A,41 ; Check general bounds + CAIL A,137 ; Range from space to _ exclusive. + POPJ P, ; If outside that, delimiter. + CAIL A,72 ; This range includes :, ;, <, =, > + CAILE A,76 + CAIA + POPJ P, ; delimiter. + CAIE A,". + CAIN A,", + POPJ P, + CAIE A,"* + CAIN A,"@ + POPJ P, + ; Finally, check out chars which are acceptable to 10X but which + ; might be delimiter in cmd line... + TRNN FF,FRCMND + JRST TRFDW5 ; Not hacking cmd line, it's an OK char. + CAIE A,"/ + CAIN A,"( + POPJ P, + CAIN A,"! + POPJ P, + JRST TRFDW5 ; at long last done. + + +; TRFDNM - Read numerical string, halt when non-digit +; seen, leaves result (decimal) in B, with delimiting char in A. +; One peculiarity is skip return if no numerical char is seen at all; +; else doesn't skip and B has a valid number. + +TRFDNM: PUSHJ P,RCH ; First char needs special check. + CAIL A,"0 + CAILE A,"9 + JRST POPJ1 ; Not a number at all? + TDZA B,B +TRFDN2: IMULI B,10. + ADDI B,-"0(A) ; Convert to number + PUSHJ P,RCH ; Get following chars. + CAIL A,"0 + CAILE A,"9 + POPJ P, ; Nope, not digit so treat as delimiter. + JRST TRFDN2 ; Yep, a number + +] ;IFN TNXSW + +IFN TNXSW,[ + +; TYPFB - Type out FB pointed to by F + +TYPFB: SKIPE B,$FDEV(F) ; First, device name? + JRST [ PUSHJ P,TYPZ + MOVEI A,": + PUSHJ P,TYOERR + JRST .+1] + SKIPE B,$FDIR(F) ; Directory? + JRST [ MOVEI A,"< + PUSHJ P,TYOERR + PUSHJ P,TYPZ + MOVEI A,"> + PUSHJ P,TYOERR + JRST .+1] + SKIPE B,$FNAME(F) + PUSHJ P,TYPZ + MOVEI A,". + PUSHJ P,TYOERR + SKIPE B,$FEXT(F) + PUSHJ P,TYPZ + MOVEI A,". ; 20X uses "." to set off version, + TLNN FF,FL20X ; but 10X uses ";". + MOVEI A,"; + PUSHJ P,TYOERR + HRRE A,$FVERS(F) + JUMPL A,[MOVM B,A ; Is possible to have -1, -2, etc. + MOVEI A,"- + PUSHJ P,TYOERR + MOVE A,B + JRST .+1] + PUSHJ P,DPNT ; Version # output in decimal. + SKIPE $FTEMP(F) + TYPE ";T" ; May be temporary. + SKIPE B,$FPROT(F) + JRST [ TYPE ";P" + PUSHJ P,TYPZ + JRST .+1] + SKIPE B,$FACCT(F) + JRST [ TYPE ";A" + PUSHJ P,TYPZ + JRST .+1] + POPJ P, + + ; Takes BP in B, outputs to TYOERR until zero byte seen. +TYPZ: CAIA + PUSHJ P,TYOERR + ILDB A,B + JUMPN A,TYPZ+1 + POPJ P, +] ; IFN TNXSW + +SUBTTL TENEX misc. Filename Routines, FS string storage + +IFN TNXSW,[ .SEE FSDSK ; Part of this page is NOT conditionalized!! + +; To handle filenames of ASCIZ strings instead of SIXBIT words, each +; word has instead a byte pointer to an ASCIZ string. For purposes of +; easy comparison, all of these bp's point into FNBUF, and a routine +; (FNCHK) is provided which checks a just-stored string and returns a bp +; to either this string, if unique, or to a previously stored string if +; it is the same as the one just stored (which is then flushed). Thus +; strings can be compared for equality simply by a comparison of their +; byte pointers. While not necessary, strings are stored beginning on +; word boundaries for easier hacking. + + ; <# files>**+<# wds for constants> +LFNBUF==*5*3+20 ; Enough to hold strings for all output files, + ; all translated files, and all .insrt files encountered. + ; Later a GC'er can be hacked up so that of the latter only + ; enough for the max .insrt level need be allocated. + +LVAR FNBUF: BLOCK LFNBUF + + ; Macro to easily define constant strings for comparison purposes +DEFINE DEFSTR *STR* +440700,,%%FNLC +%%LSAV==. +LOC %%FNLC +ASCIZ STR +%%FNLC==. +LOC %%LSAV +TERMIN + %%FNLC==FNBUF +] ; IFN TNXSW!!! + + ; If not assembling for TENEX, the following strings become + ; simple SIXBIT values. This makes it possible to write simple + ; code to work for both TENEX and non-TENEX without messy conditionals. + +IFE TNXSW,[EQUALS DEFSTR,SIXBIT] + +FSDSK: DEFSTR /DSK/ ; This stuff defines various BP's into FNBUF to +FSSYS: DEFSTR /SYS/ ; use for comparison purposes later. +FSTTY: DEFSTR /TTY/ +FSNUL: DEFSTR /NUL/ +FSPTP: DEFSTR /PTP/ +FSATSN: DEFSTR /@/ +FSSBSY: DEFSTR /SUBSYS/ +FSPROG: DEFSTR /PROG/ +FSMID: DEFSTR /MID/ +FSMDAS: DEFSTR /MIDAS/ +FSGRTN: DEFSTR />/ +FSCRF: DEFSTR /CRF/ +FSCREF: DEFSTR /CREF/ +FSERR: DEFSTR /ERR/ +FSLST: DEFSTR /LST/ +FSLIST: DEFSTR /LIST/ +FSSAV: DEFSTR /SAV/ +FSEXE: DEFSTR /EXE/ + +IFN TNXSW,[ +VBLK +FNBBP: 440700,,FNBUF ; Points to beg of FNBUF (hook for dynamic alloc) +FNBEP: FNBUF+LFNBUF-1 ; Points to last wd in FNBUF (address, not BP) +FNBWP: 440700,,%%FNLC ; Write Pointer into FNBUF. +FNBLWP: 440700,,%%FNLC ; Last Write Pointer, points to beg of string being stored +PBLK +EXPUNG %%FNLC + +; NOTE - provided MIDAS never restarts, no initialization is necessary to +; start using FNCHK. (Unless of course FNBUF is dynamically allocated someday) + +; FNCHK - Check out just-stored filename. Returns BP in A to ASCIZ string, +; which will be "canonical" for comparison purposes. +; Clobbers A,B,T,TT,AA +; FNCHKZ - Makes sure just-writ string is ASCIZ'd out before FNCHK'ing. + +FNCHKZ: MOVE B,FNBWP ; Get write ptr, + LDB A,B ; see if last char was 0, + JUMPE A,FNCHK0 ; if so can skip one clobberage. + SETZ A, + IDPB A,B ; zero out bytes, +FNCHK0: TLNE B,760000 ; until at end of word. + JRST .-2 + ADD B,[<440700,,1>-<010700,,>] ; bump BP to point canonically at next. + MOVEM B,FNBWP + +FNCHK: HRRZ B,FNBWP ; See if write ptr + CAML B,FNBEP ; has hit end of FNBUF, and + ETF [ASCIZ /Filename buffer overflow/] ; barf horribly if so. + MOVE A,FNBBP ; A - bp to start of existing string + MOVE AA,FNBLWP ; AA - bp to start of new string to store +FNCHK2: MOVEI T,(A) ; T - current addr being checked, existing str + MOVEI TT,(AA) ; TT - current addr, new str + CAIL T,(TT) ; If addrs are same, or overran somehow, + JRST [ MOVE A,AA ; didn't find any match, accept new string. + MOVE B,FNBWP + MOVEM B,FNBLWP ; Set up new last-write-ptr + POPJ P,] +FNCHK3: MOVE B,(T) + CAMN B,(TT) ; Compare strings, full word swoops. + JRST [ TRNE B,377 ; equal, last char zero? + AOJA T,[AOJA TT,FNCHK3] ; no, continue for whole string + ; Found it! Flush just-stored string, don't want duplicate. + MOVEM AA,FNBWP ; Clobber write ptr to previous value. + POPJ P,] + ; Not equal, move to next string to compare + MOVEI B,377 ; Check for ASCIZ, + TDNE B,(T) ; moving to end of current string + AOJA T,.-1 + HRRI A,1(T) ; and updating BP to point at new string. + JRST FNCHK2 ; (T gets pointed there too at FNCHK2). + +; JFNSTR - Get filename strings for active JFN. +; A/ active JFN +; F/ addr of filename block to clobber. +; JFNSTB - Same, but ignores A and assumes JFN is already stored in block. +; Clobbers A,C + +JFNSTB: SKIPA A,$FJFN(F) ; JFNSTB gets the JFN from block itself. +JFNSTR: MOVEM A,$FJFN(F) ; whereas JFNSTR stores it there... + MOVSI D,-NJSTRF ; Set up aobjn thru table. +JFNST2: PUSH P,T + SYSCAL JFNS,[FNBWP ? $FJFN(F) ? JSTRFX+1(D)][FNBWP] + POP P,T + MOVE C,JSTRFX(D) ; Now get index to place it belongs in file block, + CAIN C,$FVERS ; and check for this, because + JRST [ MOVE A,FNBLWP ; it wants to be a number, not a string. + MOVEM A,FNBWP ; Zap write pointer back to forget string, + PUSHJ P,CVSDEC ; and quickly convert before anything clobbers it. + JRST .+2] ; Skip over the FNCHKZ call. + PUSHJ P,FNCHKZ ; Fix it up, and get BP to it. + ADDI C,(F) ; make it an addr, and + MOVEM A,(C) ; store BP. (or value, for $FVERS) + ADDI D,1 + AOBJN D,JFNST2 + POPJ P, + + ; Filblk idx, output format wd for JFNS call +JSTRFX: $FDEV ? 100000,, + $FDIR ? 010000,, + $FNAME ? 001000,, + $FTYPE ? 000100,, + $FVERS ? 000010,, +NJSTRF==<.-JSTRFX>/2 + +; CVSDEC - Converts ASCIZ string to decimal, assumes only digits seen. +; A/ BP to ASCIZ +; Returns value in A, clobbers nothing else. + +CVSDEC: PUSH P,B + PUSH P,C + MOVE C,A + SETZ A, + JRST CVSDC3 +CVSDC2: IMULI A,10. + ADDI A,-"0(B) +CVSDC3: ILDB B,C + JUMPN B,CVSDC2 + POP P,C + POP P,B + POPJ P, + +; CVSSIX - Converts ASCIZ string to SIXBIT word. +; A/ BP to ASCIZ string, +; Returns SIXBIT word in A. Clobbers nothing else. + +CVSSIX: PUSH P,B + PUSH P,C + PUSH P,D + MOVE D,A + SETZ A, + MOVE B,[440600,,A] + JRST CVSSX3 +CVSSX2: CAIL C,140 + SUBI C,40 ; Uppercase force + SUBI C,40 ; cvt to 6bit + IDPB C,B ; deposit + TLNN B,770000 ; If BP at end of word, + JRST CVSSX5 ; leave loop. +CVSSX3: ILDB C,D + JUMPN C,CVSSX2 +CVSSX5: POP P,D + POP P,C + POP P,B + POPJ P, + +; CV6STR - Takes 6bit word in A, writes into FNBUF and makes a string of +; it, returning BP in A. +; Clobbers A,B,T,TT,AA (due to FHCHKZ) + +CV6STR: MOVE B,A +CV6ST2: SETZ A, + LSHC A,6 ; Get a 6bit char + ADDI A,40 ; Make ASCII + IDPB A,FNBWP ; deposit + JUMPN B,CV6ST2 ; Continue until nothing left + PJRST FNCHKZ ; Make output thus far a string. + + +; CVFSIX - Takes current filblk (pointed to by F) and puts the +; right stuff in $F6 entries. + +CVFSIX: PUSH P,A + PUSH P,B + MOVSI B,-L$F6BL +CVFSX2: MOVE A,@CVFTAB(B) ; Get BP to string + PUSHJ P,CVSSIX ; Convert to 6bit + ADDI B,$F6DEV(F) ; Get index to right place to store. + MOVEM A,(B) + SUBI B,$F6DEV(F) ; restore aobjn pointer... + AOBJN B,CVFSX2 + POP P,B + POP P,A + POPJ P, + +CVFTAB: $FDEV(F) + $FNAME(F) + $FEXT(F) + $FDIR(F) +IFN <.-CVFTAB>-L$F6BL, .ERR CVFTAB loses. + +] ; IFN TNXSW + +SUBTTL DEC/TENEX - RUN hacking. (Process FOO! in CCL) +IFN DECSW,[ + +; Process "FOO!", which means "run SYS:FOO with an offset of 1". +; Note that the RUN call needs a block of 6 ACs, but at this point +; it doesn't matter what gets clobbered. + + + ; Entry point for restart, from TSRETN. +RERUN: MOVE B,FSMDAS ; Get name - using SYS:MIDAS + SETZB C,D+1 ; (no ext or ppn) + JRST RFDRU1 + +VBLK + +RFDRUN: MOVE A,$F6DEV(F) ; Load up the 4 filenames to use. + MOVE B,$F6FNM(F) + MOVE C,$F6EXT(F) + MOVE D+1,$F6DIR(F) + JUMPN A,RFDRU3 ; If device specified, use that, + MOVSI A,'DSK ; else default to DSK + CAIN D+1, ; if a PPN was given, and +RFDRU1: MOVSI A,'SYS ; to SYS: otherwise. +RFDRU3: SETZB D,D+2 ; These acs must always be zero... + MOVEI D+3,177 ; Flush all core above this address. +IFN SAILSW,[ + SETZ D+4, + CORE2 D+4, ; Flush hiseg by hand on SAIL. + HALT + ] +.ELSE HRLI D+3,1 ; Elsewhere, just set LH to this to flush hiseg. + + MOVE D+4,[RUNCOD,,D+5] ; Move core-less code into position in ACs. + BLT D+4,+LRUNCD-1 + MOVE D+4,[1,,A] ; ,,
+ JRST D+5 ; Go flush core and run program. + +RUNCOD: CORE D+3, ; Flush as much core as possible; RUN uuo can lose + HALT ; Because of how much we have. + RUN D+4, + HALT +LRUNCD==.-RUNCOD + ; Make sure symbols A-D leave enuf room. +IFL 17-, .ERR RFDRUN ACs lose. +PBLK +] ;END IFN DECSW + +IFN TNXSW,[ + ; On TENEX, we'll do things without compat package (boo hiss) + + ; Entry point for starting new MIDAS, come here from TSRETN. +RERUN: MOVEI F,FB + BLTZ L$FBLK,FB ; Clear out scratch filblk, point at it. + MOVE A,FSMDAS ; Get BP to "MIDAS", store in + MOVEM A,$FNAME(F) ; filblk, and drop thru for defaults. + + ; Here to start up specified program, for CCL hacking. +RFDRUN: TLNN FF,FL20X ; 20X or Tenex? + JRST [ MOVE A,FSSBSY ; Tenex, get BP to SUBSYS string + SKIPN $FDIR(F) ; Unless directory specified, + MOVEM A,$FDIR(F) ; default dir to . + MOVE A,FSSAV ; And do similar thing for ext (.SAV) + JRST RFDRN2] + MOVE A,FSSYS ; 20X, get BP to SYS string + SKIPN $FDEV(F) ; Unless device specified, + MOVEM A,$FDEV(F) ; default dev to SYS:. + MOVE A,FSEXE ; And ditto for ext (.EXE) + +RFDRN2: SKIPN $FEXT(F) ; If extension not specified, + MOVEM A,$FEXT(F) ; Store appropriate one. + PUSHJ P,GETJFI ; Get JFN for input... + HALT ; Ugh, bletch, etc. + + ; OK, all ready to smash ACs with loader, etc. + MOVE R1,$FJFN(F) ; Put JFN into RH + HRLI R1,.FHSLF ; and fork handle (self) in LH. + MOVE R2,[RUNCOD,,R3] ; Load into ACs beginning at AC 3 + BLT R2,R3+LRUNCD-1 + JRST R3 ; Off we go, never to return... + + ; Following code is executed in AC's, position independent. +RUNCOD: GET ; Load up the file. + MOVEI R1,.FHSLF + GEVEC ; Find entry vector word for it, returned in AC 2. + JRST R1(R2) ; and go execute instruction in reenter slot. +LRUNCD==.-RUNCOD ; Pretty small loader, huh? +] ; IFN TNXSW + +SUBTTL Core Allocation routine - GCCORQ gets another K for MACTAB + +; Get another K of MACTAB space. + +GCCORQ: MOVE A,MACHI + LSH A,-2 ; Convert to word # + CAIL A,MXMACL ; Want more than allowed? + POPJ P, + MOVE A,MACTND ; No, get addr of block we want to get. + PUSH P,A ; Entry, save A in case have to try again +CORRQ1: +IFN ITSSW,[ + LSH A,-10. + SYSCAL CORBLK,[MOVEI %CBNDR+%CBNDW + MOVEI %JSELF ? A ? MOVEI %JSNEW] + JRST CORRQL ; Lose +] +IFN DECSW,[ + IORI A,1777 + CORE A, + JRST CORRQL ; Lose +] +IFN TNXSW,[ + SKIPN MEMDBG ; Only need to hack if want. + JRST CORRQ3 + ; Super kludge. No way to ask 10X for a "new page"; must + ; get it via default create-on-reference. Hence to get page + ; without bombing, must be sure .ICNXP interrupt deactivated! + PUSH P,T + SYSCAL DIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Deactivate. + SETZM (A) ; Reference 1st page + SETZM 1000(A) ; Reference 2nd page. + SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Re-activate. + POP P,T +CORRQ3: +] + + REST A + ADDI A,2000 + JRST MACIN2 ; Update pointers to end of MACTAB. + +IFN ITSSW\DECSW,[ + ; Lossage handler for GCCORQ. Only ITS or DEC can fail. +CORRQL: PUSH P,C + PUSH P,D + TLOE AA,400000 + JRST CORQL1 + TYPE " +No core for macro table." +CORQL1: TYPE " +Try again? " +CORQL2: PUSHJ P,TYI ; Get char + CAIL A,140 ; Cheap uppercase force + SUBI A,40 + CAIN A,"Y ; Y, + JRST CORRQA ; => try again + CAIN A,"N ; N, + JRST CORRQB ; => back to DDT then try again + CAIN A,"? ; ?, + ERJ CORQL1 ; => type out error-type blurb + TYPE "? " ; something else + JRST CORQL2 + +CORRQB: +IFN ITSSW,.VALUE ; Loop point for don't-proceed +IFN DECSW,EXIT 1, + TLZ AA,400000 +CORRQA: POP P,D + POP P,C + MOVE A,(P) ; Restore A from PDL + JRST CORRQ1 +] ; IFN ITSSW\DECSW + +SUBTTL Core allocation - TENEX routine to get pages (TCORGT) + +IFN TNXSW,[ + +; TCORGT - Takes arg in AA, an ITS page AOBJN to pages to grab. +; Clobbers no ACs but AA. + +TCORGT: JUMPGE AA,APOPJ ; Ignore arg if nothing to do about it. + SKIPN MEMDBG ; Ignore anyway if not hacking memory + POPJ P, + PUSH P,R1 + PUSH P,R2 + PUSH P,R3 + MOVE R3,AA + ASH R3,1 ; Get Tenex page AOBJN + MOVEI R1,(R3) + LSH R1,9. ; Get word address of first page. + HRR R3,R1 ; Stick back in AOBJN. + + ; Super kludge. No way to ask 10X for a "new page"; must + ; get it via default create-on-reference. Hence to get page + ; without bombing, must be sure .ICNXP interrupt deactivated! + MOVEI R1,.FHSLF + MOVE R2,[1_<35.-.ICNXP>] + DIC ; Deactivate. +TCORG3: SETZM (R3) ; Get the page. + ADDI R3,777 ; Bump word address, + AOBJN R3,TCORG3 ; and get next page (note adds 1 more to RH) + AIC ; Now re-activate... + POP P,R3 + POP P,R2 + POP P,R1 + POPJ P, +] ;IFN TNXSW diff --git a/src/midas/tsrtns.188 b/src/midas/tsrtns.188 new file mode 100644 index 00000000..d9bcb85f --- /dev/null +++ b/src/midas/tsrtns.188 @@ -0,0 +1,4231 @@ +;-*-MIDAS-*- + +SUBTTL TS Definitions, parameters + + ; For convenience in defining isolated variables/tables, + ; especially when have to know on pass1 where the + ; table is going to be (.VECTOR etc don't know until end of pass) +DEFINE LVAR -LINE +VBLK +LINE +PBLK +TERMIN + +DEFINE TMPLOC AT,STUFF +%%%TLC==. ? LOC AT + STUFF +LOC %%%TLC +TERMIN + + ; Nice macro for minimizing coding. Doesn't hack indirection tho. + ; Could conceivably optimize to do MOVE AC,[FROM,,TO] but that + ; would be overly hairy for something you can do just by writing + ; 2 instructions. +DEFINE BLTMAC AC,LEN,FROM,TO + MOVSI AC,FROM + HRRI AC,TO + BLT AC,TO+LEN-1 +TERMIN + + ; Also handy for standard zaps (and nice mnemonic) + ; won't work for indirection either. +DEFINE BLTZAC AC,LEN,FROM + SETZM FROM +IFG LEN-1,[ + MOVEI AC,FROM+1 + HRLI AC,-1(AC) + BLT AC,FROM+LEN-1 +] +TERMIN + + ; More convenient when A is clobberable... +DEFINE BLTM LEN,FROM,TO +BLTMAC A,LEN,FROM,TO +TERMIN + +DEFINE BLTZ LEN,FROM +BLTZAC A,LEN,FROM +TERMIN + + ; Following inserts a SYSCAL for JSYS's. Be warned that it + ; clobbers T when used!! +IFN TNXSW,.INSRT XJSYS + +IFNDEF PMAPSW,PMAPSW==TNXSW ; 1 to assemble PMAP input, 0 for SIN input. +IFNDEF ERRSW,ERRSW==1 ; 1 for error file output capability. + +IFNDEF TYPDLC,TYPDLC==7 ; Maximum total depth of .insrt (including tty) +IFNDEF MX.INS,MX.INS==5 ; Maximum depth .insrt files only +IFNDEF MAXIND,MAXIND==6 ; Maximum # @: table entries for .insrt + + ; Define sizes of various I/O buffers +IFN DECSW,[ +IFNDEF DECBFL,DECBFL==203 ; Standard DEC buffer size for DSK (200 wds data) +IFN SAILSW,IFNDEF NINBFS,NINBFS==19. ; For SAIL, hack full disk track of input. +IFNDEF NINBFS,NINBFS==2 ; # standard-size buffers to use for input. +IFNDEF UTIBFL,UTIBFL==*NINBFS ; Input buffs need 1 wd for EOB hacking +IFNDEF UTOBFL,UTOBFL==DECBFL ; All output chans have just 1 buffer. +IFNDEF CRFBSZ,CRFBSZ==DECBFL +IFNDEF LSTBSZ,LSTBSZ==DECBFL +IFNDEF ERRBSZ,ERRBSZ==DECBFL +] ;DECSW +IFNDEF CMBFL,CMBFL==50 ; Length of command buffer. +IFNDEF UTIBFL,UTIBFL==400 ; " Input buffer. +IFNDEF UTOBFL,UTOBFL==200 ; " BIN output buffer. +IFNDEF CRFBSZ,CRFBSZ==200 ; " CREF output buffer. +IFNDEF LSTBSZ,LSTBSZ==200 ; " LIST output buffer. +IFNDEF ERRBSZ,ERRBSZ==1 ; " ERR output buffer. Very small to avoid + ; losing much data if things crash. + + +ERRC==0 ; Err device input channel +TYIC==1 ; TTY input channel +TYOC==2 ; TTY output channel +CREFC==3 ; CREF output +UTYOC==4 ; BIN output +LPTC==5 ; LIST output (LPT) +ERRFC==6 ; ERR Assembly error output file. +UTYIC==7 ; 1st input channel, UTYIC+n used for nth .INSRT level in dec version. + +SUBTTL File Description Storage (FILBLK's) + +VBLK + ; Definitions for indices into a FILBLK. + + ; Scratch block FB is formed while defining indices... +FB: OFFSET -. + ; Lots of crocks depend on the exact order of these 4 items. +$F6DEV:: 0 ; SIXBIT Device name +$F6FNM:: $F6FN1:: 0 ; SIXBIT Filename (on ITS, FN1) +$F6TYP:: $F6FN2:: $F6EXT:: 0 ; SIXBIT Extension (on ITS, FN2) +$F6DIR:: 0 ; SIXBIT Directory (may be numerical PPN) + L$F6BLK==. +$FVERS:: $FGEN:: 0 ; File version (or generation). NUMBER, not string. +IFN TNXSW,[ ; Almost all entries here are BP's to ASCIZ strings. +$FDEV:: 0 ; Device name +$FDIR:: 0 ; Directory name +$FNAME:: 0 ; File name (i.e. main name) +$FTYPE:: $FEXT:: 0 ; File type (or extension) +$FTEMP:: 0 ; -1 => File is a temporary file. +$FACCT:: 0 ; Account string +$FPROT:: 0 ; Protection string +$FJFN:: 0 ; JFN for file (may be ,,) +] +IFN ITSSW\DECSW,[ +$FDEV==:$F6DEV ; These definitions made so some common code can do +$FDIR==:$F6DIR ; the right things. +$FNAME==:$F6FNM +$FTYPE==:$F6TYP +$FEXT==:$F6TYP +] + L$FBLK==. ; Length of a FILBLK. + OFFSET 0 ; End of index definitions. + + + ; FILBLK's for various files + +ISFB: BLOCK L$FBLK ; Input file specification as given in command line. +INFB: BLOCK L$FBLK ; Actual current input file. +OUTFB: BLOCK L$FBLK ; Output file + +IFN CREFSW, CRFFB: BLOCK L$FBLK ; CREF output file +IFN LISTSW, LSTFB: BLOCK L$FBLK ; Listing output file +IFN ERRSW, ERRFB: BLOCK L$FBLK ; Error output file + +INFCNT: 0 ; AOS'd each time an input file is opened. +INFCUR: 0 ; What INFCNT was when current file opened. +INFERR: 0 ; What INFCUR held at last err msg. + +INDDP: MAXIND,,TBLOFS ; Pointer into tables below +TBLOFS: BLOCK MAXIND*L$FBLK ; Actual filenames corresponding to those in TBLSFS, for opening. +TBLSFS: BLOCK MAXIND*L$FBLK ; Source-specified filenames for @: files + + +RFNAM1: 0 ; .FNAM1, .FNAM2, .FVERS +RFNAM2: 0 +RFVERS: 0 +IFNM1: 0 ; .IFNM1, .IFNM2, .IFVRS +IFNM2: 0 +IFVRS: 0 +INFFN1==:INFB+$F6FN1 ; Some crocks seem to reference this. +OFNM1==:OUTFB+$F6FN1 ; Pseudo .OFNM1 needs this. +OFNM2==:OUTFB+$F6FN2 ; ditto, .OFNM2 +RSYSNM: 0 ; Initial system name +PBLK + +SUBTTL I/O Buffers + +VBLK ; Input buffer and variables + +UTIBUF: BLOCK UTIBFL +UTIHDR: 0 ; Input buffer header (dec version) +UREDP: 440700,,UTIBUF ; Input byte pointer +UTICNT: 0 ; Input byte count (dec version) +IUREDP: 440700,,UTIBUF ; Initial UREDP, used for re-initializing. +UTIBED: UTIBUF ; EOF comparison with RH(UREDP), 4.9 => EOF on .IOT + +IFN DECSW,UTICHN: UTYIC + + ; BIN Output buffer + +UTOBUF: BLOCK UTOBFL ; Output buffer +UTOHDR: UTOBFL,,UTOBUF-1 +UTYOP: 444400,, ; Output (36. bit) byte pointer +UTYOCT: 0 ; # words left in utobuf +IFN ITSSW,OCLOSP: @1(C) ; Turned into bp to unused part of last bffer wd used. + + ; CREF output buffer +IFN CREFSW,[ +CRFBUF: BLOCK CRFBSZ +CRFHDR: CRFBSZ,,CRFBUF-1 ; Header, assembled value used only ifn itssw +CRFPTR: 444400,, ; Bp for filling buffer (full words) +CRFCNT: 0 ; Num. wds. empty in buffer +] + + ; LISTing output buffer +IFN LISTSW,[ +LSTBUF: BLOCK LSTBSZ +LSTHDR: 5*LSTBSZ,,LSTBUF-1 +LSTPTR: 440700,, +LSTCNT: 0 +] + + ; ERRor output buffer +IFN ERRSW,[ +ERRBUF: BLOCK ERRBSZ +ERRHDR: 5*ERRBSZ,,ERRBUF-1 +ERRPTR: 440700,, +ERRFCT: 0 ; Can't call this ERRCNT since that's used for # errors. +ERRFP: 0 ; Non-0 if want error output file. +ERRFOP: 0 ; Non-0 if error file open (ie try outputting to it) +] +PBLK + +SUBTTL Interrupt Handling + +; Note that only PDL OV is now enabled in general. +; TTY input interrupts are also handled when possible for +; ^H, ^W, and ^V. + +.SCALAR INTSVP ; Saves P on interrupt for debugging + +IFN ITSSW,[ + TMPLOC 42, JSR TSINT ; Interrupt vector for ITS +VBLK +.JBCNI: +TSINT: 0 ; 1st wd interrupts currently considered fatal errors. +.JBTPC: 0 ; Error processor re-enables interrupts + .SUSET [.RJPC,,INTJPC] + SKIPGE TSINT + JRST TTYINT ; Second-word ints. + JRST TSINT1 ; Jump into pure coding and process interrupt +INTJPC: 0 ; Saves .JPC at interrupt. +PBLK + ; Jrst here from TSINT for 2nd wd interrupts. +TTYINT: PUSH P,A + MOVEI A,TYIC ; The tty chnl is the only one enabled. + .ITYIC A, + JRST TTYINX ; No int. char. + CAIN A,^W + AOS TTYFLG ; ^W silences, + CAIN A,^V + SOS TTYFLG ; ^V unsilences, + CAIN A,^H + SETOM TTYBRF ; ^H says break next time thru ASSEM1 loop. +TTYINX: REST A + .DISMIS .JBTPC +] ; IFN ITSSW + +IFN DECSW, TMPLOC .JBAPR, TSINT1 ; Interrupt vector for DEC + +IFN ITSSW\DECSW,[ + ; Amazing but can use almost same basic rtn for both! + +TSINT1: MOVEM P,INTSVP ; Save P for possible debugging +IFN ITSSW,.SUSET [.SPICL,,[-1]] ; For ITS, re-enable ints. + MOVE A,.JBCNI ; Get interrupt request word + TRNE A,200000 ; PDL overflow? + JRST CONFLP + MOVE B,[TYPE "Unknown interrupt - Fatal"] ; anything else. + MOVEM B,40 + MOVE A,.JBTPC ; So error routine will print out properly + JSA A,ERROR +] + +IFN TNXSW,[ + ; TENEX Interrupt handler +; Note that NXP (non-ex page) is enabled, but no provision is +; currently made for handling it. This causes process termination and +; EXEC will print error message. If NXP wasn't enabled, a page would +; simply be created without fuss (page is always created, incidentally, +; whether or not interrupt happens) + +LVAR MEMDBG: 0 ; For nonce, this gets set when PURIFG does. + +LEVTAB: INTPC1 ; Where to store PC for level 1 interrupt. + 0 ? 0 ; Levels 2 and 3 unused. +CHNTAB: BLOCK 36. ; Where to go for indicated condition. Most zero. + +.IC.CV==1 ; Define user channel 1 for ^V interrupt +.IC.CW==2 ; " 2 for ^W +.IC.CH==3 ; " 3 for ^H +%%LSV==. +LOC CHNTAB+.ICPOV ? 1,,TSINT1 ; Put right word in CHNTAB for PDL OV dispatch. +LOC CHNTAB+.IC.CV ? 1,,INT.CV ; Ditto for ^V dispatch +LOC CHNTAB+.IC.CW ? 1,,INT.CW ; " ^W +LOC CHNTAB+.IC.CH ? 1,,INT.CH ; " ^H +LOC %%LSV + +.SCALAR INTPC1 ; Level 1 interrupt PC stored here. + + ; Handle PDL OV interrupt +TSINT1: MOVEM P,INTSVP ; Save PDL ptr. + MOVEI A,CONFLP ; OK to clobber A in PDLOV. + MOVEM A,INTPC1 ; Dismiss to CONFLP. + DEBRK ; Off we go. + + ; Handle ^V interrupt +INT.CV: SOS TTYFLG ; Unsilence typeout + DEBRK + + ; Handle ^W +INT.CW: AOS TTYFLG ; Silence typeout + DEBRK + + ; Handle ^H +INT.CH: SETOM TTYBRF ; Set flag to check at main level ASSEM1 loop. + DEBRK +] + +SUBTTL MIDAS BEGINS HERE - Program Startup + +VBLK +NVRRUN: -1 ; 0 => MIDAS was run; error to start or purify. +FATAL: 0 ; At end of assembly, not 0 iff fatal error occurred. +PBLK + +BEG: ; Start address! +IFN DECSW\TNXSW,[ + TDZA A,A + SETO A, + MOVEM A,CCLFLG ; Remember type of start-up +] + SETZ FF, ; Initialize flags + MOVE P,[-LPDL,,PDL-1] ; Initialize P + +IFN DECSW,[ + RESET + MOVEI A,600000 + APRENB A, +] + ; For TENEX, must determine right away which system we're on. +IFN TNXSW,[ + RESET +; TLZ FF,FL20X ; Assume 10X until proven otherwise. (done by SETZ above) + +IFN 0,[ ; One way of determining OS which doesn't work on some places. + MOVE A,[112,,11] ; Magic word that will win on 10X,T20 (and maybe T10) +GETTAB=<047000,,41> ; CALLI 41 + GETTAB A, ; Returns 10000 T10, 20000 ITS, 30000 10X, 40000 T20 + MOVEI A,30000 ; Shouldn't ever fail, but if it does, assume 10X. + LDB A,[140300,,A] ; Flush other fields too + CAIN A,4 ; = Tops-20? + TLO FF,FL20X ; Yes, set flag. +]; IFN 0 +IFN 0,[ ; This is a loser too, since there ARE KL Tenices! + SETZ A, ; In lieu of above, use hardware hack... + BLT A, ; test for KL-ness. + CAIE A, + TLO FF,FL20X ; KL will fail to skip, assume that means 20X OS. +];IFN 0 +IFN 1,[ ; Boy I hope DEC never defines LOADTB! -- MRC + SYSCAL SYSGT,[['LOADTB]][A ? D] + SKIPN D ; If LOADTB is not defined + TLO FF,FL20X ; it must be a Twenex +]; IFN 1 + + SYSCAL SCVEC,[[.FHSLF] ? [-1]] ; and flush compat package, + ; disabling UUO's 40-77; this is good for debugging. + + ; Set up stuff for interrupts + SYSCAL SIR,[[.FHSLF] + [LEVTAB,,CHNTAB]] ; Specify tables + SYSCAL EIR,[[.FHSLF]] ; Enable interrupts + SYSCAL AIC,[[.FHSLF] ; Activate PDL OV and ^V, ^W, ^H +[IRP BIT,,[.ICPOV,.IC.CV,.IC.CW,.IC.CH] +<1_<35.-BIT>>+!TERMIN ]] + SYSCAL ATI,[[.TICCV,,.IC.CV]] ; Make various mappings from + SYSCAL ATI,[[.TICCW,,.IC.CW]] ; terminal bits to int. channels. + SYSCAL ATI,[[.TICCH,,.IC.CH]] ; What a losing interrupt sys 10X has! + SKIPN MEMDBG ; Hacking memory? + JRST BEG20 + MOVSI A,-2*MINMAC ; If so, must create pages for initially-zero + MOVE B,(A) ; core, by referencing them all. + ADDI A,777 + AOBJN A,.-2 + SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Then enable ints +BEG20: ; for Non-eXistent Pages. +] + +IFN ITSSW,[ + MOVE A,[-5,,[ ; Set and read various vars in a chunk. + .SMASK,,[%PIPDL] ; 1st-wd Interrupt only on PDL ovfl. + .SMSK2,,[1_TYIC] ; 2nd-wd on TTY input channel. + .SPICL,,[-1] ; and enable interrupt system. + .RSNAM,,RSYSNM ; Get system name (default dir to use) + .RXJNAM,,B ]] ; and XJNAME for temp. hacking below. + .SUSET A + SYSCAL TTYSET,[1000,,TYIC ; Set TTYST wds - PI echo, no act/int + [232020,,202020] ; except ctls activate & interrupt + [232020,,220220]] ; CR, DEL activate but don't int; + ; DEL doesn't echo. +] + + AOSE NVRRUN ; Test for this job's already being run... + JRST [ TYPE "Can't restart MIDAS" + JRST TSRETN] + + MOVEI D,SYMDSZ ; Get default symtab size +IFN ITSSW,[ ; Remember that B set to XJNAME above. + CAME B,['MMIDAS] ; Set symtab size larger for MMIDAS + CAMN B,[SIXBIT/MM/] ; (random sort of hack now that .SYMTAB exists) + MOVEI D,SYMMSZ +] + SKIPGE ISYMF ; The first time through, + MOVEM D,SYMLEN ; Make that the size to use. + CALL SITINI ; Initialize stuff for .SITE. + CALL JCLINI ; Now try to fetch JCL; set CMPTR accordingly. +IFN ITSSW,[ + SKIPGE ISYMF ; Skip if syms spread; if not, + CALL TSYMGT ; get TS syms from system. +] + SKIPE CMPTR ; If have JCL, + JRST GO2AA ; skip announcing midas's name and version. + +IFG PURESW-DECSW,[ ; If meaningful, + SKIPGE PURIFG ; Check for purity + TYPE "NOTPUR " ; and type little warning if unpurified. + ] + TYPE "MIDAS." ; and announce self. + MOVE B,[MIDVRS] + PUSHJ P,SIXTYO + JRST GO2AA + +SUBTTL MIDAS Top-level control path + +GO2A: SETZM CMPTR ; Recycles here, so JCL only hacked once. +GO2AA: SETOM FATAL ; Assume fatal errors, unless cleared at GO8 when done. + SETZM TTYFLG ; Allow TTY typeout. + SETZM ERRCNT ; Initialize error counter (total errors) +IFN RUNTSW,[ PUSHJ P,RNTTMA ; Get initial run time. + MOVEM A,IRUNTM] + SETZM LSTTTY ; Tell TYOERR not to try output to LST file (none yet!) + PUSHJ P,CMD ; Get typed in command (or scan cmd line if CMPTR ne 0) + + SKIPGE SMSRTF ; What's this for, I wonder? + JRST GO21 + TYPECR "SYMTAB clobbered" + JRST GO2A + + ; Filenames and switches all specified, now see if files can be set up. +GO21: PUSHJ P,OPNRD ; Open input file + JRST GO2A ; Error, msg was typed, go try again with new cmd line. + PUSHJ P,WINIT ; Open output file, cref file. +IFN DECSW\TNXSW,[ + SKIPGE CCLFLG + TYPE "MIDAS: " +] +IFN A1PSW,[ + SETOM PRGC + SETOM OUTC +GO3: ] + MOVE A,WSWCNT + MOVEM A,TTYFLG ; Turn off typeout if there were (W) switches. + SETOM LSTTTY ; Allow TYOERR to output to both TTY and LST. + JSP A,$INIT ; Initialize for assembly + JSP A,PS1 ; Do pass 1 + TRNN FF,FRNPSS ; If 2 pass assembly, + JRST GO4 + PUSHJ P,OPNRD ; Then re-open input file + JRST GO2A ; Couldn't re-open???? Do something better here. +GO4: JSP A,PLOD ; Maybe punch out SBLK loader in some format + JSP A,PS2 ; Do pass 2 + JSP A,PSYMS ; Maybe punch out symbol table +IFN A1PSW,[ + TLZ FF,$FLOUT + AOS PRGC ; Indicate end statement encountered + SETOM OUTC ; " " " + TRNN FF,FRNPSS ; If 1 pass assembly, + SKIPGE CONTRL + CAIA + JRST GO3 ; Then try to assemble another program +] +IFN FASLP,[ + SKIPGE A,CONTRL + TRNN A,FASL + JRST GO8 + MOVE A,[SIXBIT /*FASL*/] ; "finish" FASL file + MOVEI B,17 + PUSHJ P,FASO ; Ignore end frob, but output FASL end code + MOVE A,[ASCIC//] ; pad with ^C's. + PUSHJ P,FASO1 ; Randomness + PUSHJ P,FASBE ; Write out last block +] + ; Jump directly here for certain main-input EOF conditions. +GO8: SETZM FATAL ; There was no fatal error: output files get renamed. + + ; Jump directly here if hit fatal error (incl .FATAL, illegal UUO, etc) +GO9: PUSHJ P,.FILE ; Close (and rename if FATAL = 0) output files. + SETZM LSTTTY +IFN RUNTSW, PUSHJ P,RNTTYO ; Type out run time used since GO2A + CALL ERRCLS ; File away error file - only thing not closed by .FILE + JRST TSRETN ; and die according to system's wishes. + +SUBTTL MIDAS Death (TSRETN) - system dependent exit routines + +IFN ITSSW,[ +TSRETN: +IFN PURESW,[ + SKIPGE PURIFG ; If not yet purified, assume being debugged. + .VALUE +] + .LOGOUT ; Come here to commit suicide. + .BREAK 16,160000 +] ;IFN ITSSW + +IFN DECSW,[ + +TSRETN: SKIPLE A,ERRCNT ; If had any errors, + ADDM A,.JBERR ; let loader know about them. (???) Well, + .SEE ERR1 ; for strange comment. + SKIPN CCLMOR ; Any more CCL commands? + EXIT ; Nope, all done. + JRST RERUN ; More CCL to hack, start up a new MIDAS. +] ; IFN DECSW + + +IFN TNXSW,[ +TSRETN: SKIPE CCLMOR ; Need to hack any more CCL? + JRST RERUN ; Yeah. +TSRET1: HALTF + HRROI 1,[ASCIZ/Can't continue/] + PSOUT ; Better than dying randomly + JRST TSRET1 +] ; IFN TNXSW + +SUBTTL .SITE pseudo & initialization (SITINI) + +IFN ITSSW, LVSITE==1 ; ITS only uses 1 word of mach name. +IFN DECSW\TNXSW,LVSITE==5 ; whereas others need 5 words (25 chars max) + +LVAR V.SITE: BLOCK LVSITE ; .SITE string stored here. + + ; .SITE N, returns nth word of sixbit machine name. + +A.SITE: CALL AGETFD ; Get field as argument. + JUMPL A,CABPOP ; Ignore negative indices. + CAIL A,LVSITE ; Make sure index is within bounds of string. + JRST CABPOP + MOVE A,V.SITE(A) ; Win, get indexed word. + JRST CLBPOP + + +; SITINI - Initialization routine called only at MIDAS startup, for +; setting up .SITE and maybe other things. + +SITINI: BLTZ LVSITE,V.SITE ; Clear out string location + +IFN ITSSW,[ ; For ITS, use up just 1 word and need 1 call to set V.SITE + SYSCAL SSTATU,[REPEAT 5,[ ? MOVEM A] ? MOVEM V.SITE] + .LOSE %LSSYS + POPJ P, ] + +IFN SAILSW,[ ; SAIL needs special kludge, since it doesn't have the + MOVE A,[SIXBIT /SAIL/] ; right GETTAB used. + MOVEM A,V.SITE + POPJ P, ] + + ; This code sets TNX .OSMIDAS at runtime as appropriate. +IFN TNXSW,[ + MOVE A,[SIXBIT /TENEX/] ; Assume running on 10X + TLNE FF,FL20X ; unless proved otherwise + MOVE A,[SIXBIT /TWENEX/] + MOVEM A,OSMID ; Store directly as symtab value! +] + ; If TNX and on ARPA network, get Arpanet host name for .SITE +IFN TNXSW,[ + SYSCAL SYSGT,[['LHOSTN]][A ? B] ; Get local host # + JUMPL A,SITIN3 ; Tops-20 release 3 has a LHOSTN table + JUMPE B,SITIN3 ; Jump if none, not on net. + SYSCAL CVHST,[FNBWP ? A][A] ; Write string into FNBUF. + JRST SITIN3 ; No string for that host #?? + SETZ B, + IDPB B,A ; Make sure string is ASCIZ'd. + MOVE B,FNBWP ; Note that FNBWP isn't altered by the syscal! + MOVE C,[440600,,V.SITE] +SITIN2: ILDB A,B + JUMPE A,APOPJ ; return when string ended. + TRCE A,140 ; Convert char to sixbit. + TRCE A,140 + TRCE A,140 + IDPB A,C + JRST SITIN2 +] + + ; For non-network TENEX and DEC in general, very similar. +IFN DECSW\TNXSW,[ +IFN TNXSW,[ +SITIN3: SYSCAL SYSGT,[['SYSVER]][A ? D] ; Best to get table index dynamically, + JUMPE D,APOPJ ; If can't, lose. + ] +IFN DECSW,MOVEI D,11 ; 11 = .GTCNF But on T10 we can assume this. + + MOVE AA,[440600,,V.SITE] + MOVSI C,-5 ; Process 5 words of .GTCNF (max possible) +SITIN4: HRLZ B,C ; Get subindex we want, + HRRI B,(D) ; and produce ,,
+IFN DECSW, GETTAB B, ; Get 1 word of table, using appropriate call. +IFN TNXSW, SYSCAL GETAB,[B][B] + POPJ P, ; If call fails, exit. +SITIN5: SETZ A, + LSHC A,7 ; Extract an ascii char + CAIE A,", ; If it's a comma, + CAIG A,40 ; or ctl or space, + POPJ P, ; then let's stop. + TRCE A,140 ; Swap bit 40 with bit 100, thus turning + TRCE A,140 ; "A to 'A, "a to 'A, "1 to '1, etc, and ^@ to ' . + TRCE A,140 + IDPB A,AA ; Store the sixbit into V.SITE + JUMPN B,SITIN5 ; When nothing left of this word of .GTCNF, get next. + AOBJN C,SITIN4 + POPJ P, +] ;DECSW\TNXSW + +SUBTTL RunTime - .MRUNT and end-of-assembly typeout +IFN RUNTSW,[ + +.SCALAR IRUNTM ; Holds initial run time (set at start of assembly) + + ; .MRUNT - Returns runtime since start of assembly. + +A.MRUN: PUSHJ P,RNTTMA ; Get current run time + SUB A,IRUNTM ; Subtract initial run time +IFN ITSSW,[MULI A,4069. ; ITS - Convert to nanoseconds, + DIV A,[1.^6] ; then to milliseconds. +] + PJRST CLBPOP + + ; RNTTMA - internal routine to return in A the current runtime, + ; in whatever units the OS furnishes. +RNTTMA: +IFN ITSSW, .SUSET [.RRUNT,,A] ; Gets runtime in 4.096 usec units. +IFN DECSW, SETZ A, ? RUNTIM A, ; Runtime in msec +IFN TNXSW,[ + IFN A-1, EXCH R1,A + MOVEI R1,.FHSLF + RUNTM ; Runtime in msec for self. + IFN A-1, EXCH R1,A + ] + POPJ P, + +; RNTTYO - Called at end of assembly to type out runtime, +; # of errors, and # symbols used. + +RNTTYO: +IFN DECSW,[ ; Nobody wants this on ITS, but other people do...sigh... + SKIPE A,ERRCNT ; Any assembly errors? + JRST [ TYPE "? " ; Yes, error message for batch controllers + CALL DPNT + TYPECR " error(s) detected" + JRST .+1] + SKIPE CCLFLG ; Called via CCL? + RET +] + TYPE "Run time = " + CALL A.MRUN ; Get runtime in millisec. in A. + IDIVI A,10. + IDIVI A,100. ; Get secs and hundredths. + HRLM B,(P) ; Save remainder + PUSHJ P,HMSTYO ; Type out secs + MOVEI A,". + CALL TYO + HLRZ A,(P) + CALL HMSTY3 ; Type out hundredths + CALL CRR + CALL A.SYMC + CALL DPNT + TYPE " Symbols including initial ones (" + CALL A.SYMC + IMULI A,100. + IDIV A,SYMLEN ; Get % symtab used + CALL DPNT + TYPECR "% used)" + RET + +; HMSTYO - Type out H:MM:SS time in A +; Doesn't work for times .ge. 60. hours + +HMSTYO: IDIVI A,60. + JUMPE A,[MOVE A,B ? PJRST DPNT] + HRLM B,(P) + PUSHJ P,HMSTYO + MOVEI A,": + PUSHJ P,TYO ; Type delimiting char + HLRZ A,(P) +HMSTY3: IDIVI A,10. + PUSHJ P,ADGTYO ; Type out digit in A + MOVEI A,"0(B) + PJRST TYO + +] ; IFN RUNTSW + +SUBTTL COMMON Output Routine WINIT - Open all output files. + +; WINIT - Called from top-level control to open all necessary output files. +; + +WINIT: +IFN ERRSW,[ + SKIPN ERRFP ; If want error output file, + JRST WINIT2 + CALL OINIT ; Open it, first of all. + 0 ERRFC,ERRFB + SIXBIT/ERROUT/ + ERRHDR,,ERRBUF + SETOM ERRFOP ; Error file now open. +WINIT2: ] + PUSHJ P,OINIT ; Open main output file. + 13^9 UTYOC,OUTFB ; chnl,name-block. + SIXBIT/OUTPUT/ + UTOHDR,,UTOBUF +IFN ITSSW,[ + TLZ FF,FLPTPF ; Initially assume device not paper tape punch + .STATUS UTYOC,A ; Get status of output channel + ANDI A,77 ; Mask to device code + CAIN A,7 ; If paper tape punch, + TLO FF,FLPTPF ; Then set FLPTPF. +] +IFN LISTSW,[ + SKIPN LISTP + JRST WINIT1 + CALL OINIT ; Open listing file if desired. + 0 LPTC,LSTFB + SIXBIT/LSTOUT/ + LSTHDR,,LSTBUF +WINIT1: +] +IFN CREFSW,[ + SKIPN CREFP ; If cref requested, + RET + PUSHJ P,OINIT ; Open cref file, FN2 = CRFOUT + 13^9 CREFC,CRFFB + SIXBIT/CRFOUT/ + CRFHDR,,CRFBUF + MOVE A,[.BYTE 7 ? 177 ? "B ? ^W] + PUSHJ P,CRFOUT ; Output header to indicate image input. + PUSHJ P,CRFSSF ; Output set-source-file block. +] + RET + +SUBTTL COMMON Output Routines - Output Chars/Words to BIN, TTY, ERR, CREF, LIST + + ; PPB - Punch Binary word. + +PPB: JUMPGE FF,CPOPJ ; Don't punch if not punching pass. +PPBA: ; This entry pt "Always" punches. +TPPB: SOSGE UTYOCT ; If no more room in buffer, + JRST [ CALL TPPBF ; Output & re-init buffer. + JRST TPPB] + IDPB A,UTYOP + RET + +TPPBF: PUSH P,[0 UTYOC,UTOHDR] ; Drop thru to COBUFO. + + ; Common OBUFO. Takes ,
on stack, clobbers no ACs. + ; See rtns below for usual calling sequence. +COBUFO: EXCH C,(P) ; Get arg off stack, save C. + CALL OBUFO ; Output & re-init buffer. + REST C + RET + + ; TYO - Output char in A, outputting also to ERR file if possible. +TAB: MOVEI A,^I +TYO: SKIPG A.TTYF + CALL TYOX ; Actually output to TTY with OS-dependent routine. + ; Then fall through for ERR output. +ERRCHR: +IFE ERRSW,RET +IFN ERRSW,[ + SKIPN ERRFOP ; Output char in A to error file if one is open. + RET + SOSGE ERRFCT + JRST [ PUSH P,[ERRCHR] + PUSH P,[0 ERRFC,ERRHDR] + PJRST COBUFO] + IDPB A,ERRPTR + RET +] ;IFN ERRSW + + ; CRFOUT - Output word in A to CREF file. + +IFN CREFSW,[ +CRFOUT: SOSGE CRFCNT + JRST [ PUSH P,[CRFOUT] ; Buffer full, go output it. + PUSH P,[0 CREFC,CRFHDR] + PJRST COBUFO] + IDPB A,CRFPTR + POPJ P, + +CRFSSF: SKIPA A,[1] ; Output set-source-file block. +CRFPSH: MOVEI A,3 ; Output push-source-file block. +REPEAT L$F6BL,[ + CALL CRFOUT + MOVE A,INFB+$F6DEV+.RPCNT + ] + JRST CRFOUT +] ; IFN CREFSW + + + ; PILPT - Output character in A to listing file. + +IFN LISTSW,[ +PILPT: SOSGE LSTCNT + JRST [ PUSH P,[PILPT] ; When buffer full, output it. + PUSH P,[0 LPTC,LSTHDR] + PJRST COBUFO] + IDPB A,LSTPTR + RET + +LPTCLS=:CPOPJ ; Hmmm, random noop-ness ref'd by AEND. + +] ;END IFN LISTSW, + +SUBTTL COMMON Output Routine .FILE - Close all output files. + +; .FILE - Counterpart to WINIT. +; Close input, bin, cref and list files. + +.FILE: ; Closing input file is simple enough... +IFN DECSW, RELEAS UTYIC, +IFN ITSSW, .CLOSE UTYIC, +IFN TNXSW,[ +IFN PMAPSW, MOVE A,[NIBFPS,,1STBFP] ? CALL DELPGS ; flush buffer pages + MOVE R1,INFB+$FJFN + CLOSF + JFCL + SETZM INFB+$FJFN + SETZM JFNCHS+UTYIC +] + MOVNI A,1 + SKIPL B,CONTRL ; If relocatable, + PUSHJ P,TPPB ; Output a -1 so stink will see EOF + SETZ A, ; In dec fmt, output a 0 at end. + TRNE B,DECREL + CALL TPPB + SKIPE OUTFB+$FEXT ; Check general name. + JRST .FILE2 ; Output fnam2 was explicitly specified + + ; Output extension (fn2) wasn't specified, default depends + ; on system and output type. +IFN ITSSW, MOVSI A,'BIN ; Default to SBLK output format; note that +IFE ITSSW, MOVSI A,'SBK ; this will include RIM, RIM10. + SKIPL B,CONTRL ; Using STINK output format? +IFN ITSSW, MOVSI A,'REL ; Yes, use appropriate thing for site. +IFE ITSSW, MOVSI A,'STK + TRNE B,DECSAV ; Using DECSAV output format? + MOVSI A,'SAV +IFN TNXSW,[ + TRNE B,DECSAV ; If using DECSAV format and + TLNN FF,FL20X ; on a 20X, then + CAIA + MOVSI A,'EXE ; use this extension instead. +] + TRNE B,DECREL ; Using DECREL output format? + MOVSI A,'REL +IFN FASLP,[ + TRNE B,FASL ; Using FASL output format? +IFN ITSSW, MOVE A,[SIXBIT /FASL/] ; yes, smash as appropriate. +IFE ITSSW, MOVSI A,'FAS +] +IFE TNXSW, MOVEM A,OUTFB+$F6EXT ; For 6bit systems, store final selection. +IFN TNXSW, PUSHJ P,TNXODF ; If Tenex, call output default hackery, since + ; changing stuff is a bit hairier. + +.FILE2: JSP A,OCLOSE + 0 UTYOC,UTOHDR ; Write out buffer, rename and close output file. + OUTFB +IFN LISTSW,[ + SKIPN LISTP ; Listing file open => + JRST .FILE3 + CALL PNTCR ; End with cr and ff. + MOVEI A,^L + CALL PILPT + PUSH P,FATAL ; Rename listing file even if fatal error. + SETZM FATAL + JSP A,OCLOSE + 0 LPTC,LSTHDR ; Output buffer, rename & close it. + LSTFB + POP P,FATAL +.FILE3: +] ;IFN LISTSW +IFN CREFSW,[ + SKIPN CREFP ; If cref file open, + POPJ P, + MOVEI A,0 + PUSHJ P,CRFOUT ; Output eof block, + JSP A,OCLOSE ; Write buffer, close. + 0 CREFC,CRFHDR ; 0 chnl,header + CRFFB +] + RET + + ; File out error output file. This isn't done in .FILE so that + ; error file can include a few more goodies and be closed separately + ; later on. +ERRCLS: SETZM FATAL ; Err file renamed even after fatal error. +IFN ERRSW,[ + SKIPN ERRFOP + RET ; There is none. + MOVEI A,^M + CALL ERRCHR ; Put crlf at ennd. + MOVEI A,^J + CALL ERRCHR + JSP A,OCLOSE ; Rename and close. + 0 ERRFC,ERRHDR + ERRFB + SETZM ERRFOP +] + RET + +SUBTTL ITS - Output file Open, Output, Close/Rename. +IFN ITSSW,[ + +; PUSHJ P,OINIT ; Open output file +; Mode chnl,name-block-addr +; Sixbit/desired-temporary-fn2/ +; Header,,buffer space ;used only in dec version. +; The mode should be 13^9 for binary, 0 for ascii. + +OINIT: MOVE A,(P) + HLRZ B,2(A) ; Get addr of header, + SETOM 2(B) ; Set buffer byte count to -1 => not initted. + MOVE AA,1(A) ; Get 2nd arg, temp FN2 to use. + MOVE F,(A) ; Get 1st arg - , + SYSCAL TRANS,[5000,,.UAO ; For output mode, + REPEAT 4,[? .RPCNT(F) ] ; translate from given names + REPEAT 4,[? MOVEM .RPCNT+FB+$F6DEV ]] ; into actual names, in scratch blk. + JRST OINITL ; (too many translations) + + SYSCAL DELETE,[FB+$F6DEV ; Delete old temp name file. + TMPFN1 ? AA ? FB+$F6DIR] + JFCL ; If none, it's ok. + LDB A,[270400,,F] ; Get channel num. + HRLI A,.BAO ; Open mode (default ascii) + TLNE F,777000 ; But maybe want image mode. + HRLI A,.BIO ; Yep, use that instead, to get ,, + SYSCAL OPEN,[A ? FB+$F6DEV ; Open file, + TMPFN1 ? AA ; using these temp filenames. + FB+$F6DIR] + JRST OINITL + BLTM L$F6BL,FB+$F6DEV,$F6DEV(F) ; Copy translated names into + ; name-block for file, for eventual rename. + +POPJ3: AOS (P) ; Skip over 3 args. +POPJ2: AOS (P) + JRST POPJ1 + +TMPFN1: SIXBIT /_MIDAS/ ; FN1 to use for temp filenames. + + + +; OINITL - jumped to from OINIT if some lossage +; encountered when opening output files. + + +OINITL: HLLZ A,@(P) ; Get chnl num, + TLZ A,777037 ; Mask to just ac field (chnl num) + IOR A,[.STATUS A] + XCT A ; Read its status, + PUSHJ P,OPNER ; Type out reason for open failure, and ask + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Get typein, one line. + MOVE F,@(P) ; Get + PUSHJ P,RFD ; Get new file description into filblk spec'd by F + JRST OINIT ; and jump back to try again. + +VBLK +ERRDNM: .UAI,,'ERR ? 3 +ERRCOD: 0 +IFSTS: 0 ; .STATUS word stored by OPNRD1 when .OPEN loses +PBLK + + ; Openloss documentation routine + +IOPNER: MOVE A,IFSTS ; Input +OPNER: MOVEM A,ERRCOD ; Save .status word + PUSHJ P,TYPFB ; Type out file description + PUSHJ P,CRRERR ; Now crlf to ensure room for following + .OPEN ERRC,ERRDNM ; Now get the system to say what's wrong + .LOSE %LSSYS ; Can't open err device? +IOPNR2: .IOT ERRC,A ; Get character from system + CAIGE A,40 ; Ends with ^L or ^C or other cruft. + PJRST CRRERR ; Return, typing out CRLF. + PUSHJ P,TYOERR ; Type out character + JRST IOPNR2 ; Loop back for next + + +; JSP A,OCLOSE +; 0 chnl,header +; Nameblockaddr +; Write out last buffer, rename to names in nameblock and close. + +OCLOSE: MOVE C,(A) ; 1st wd of args is what OBUFO wants. + LDB B,[360600,,1(C)] ; Just in case this is ascii file, + DPB B,[300600,,OCLOSP] ; Get bp to unused part of last wd of buffer, + MOVE B,[ASCIC//] + DPB B,OCLOSP ; And pad with ^c's. + SOS 2(C) ; Obufo assumes byte count was sos'd. + CALL OBUFO ; Write out last partial buffer + MOVE F,1(A) ; Get + LDB C,[270400,,(A)] ; Get chnl num. + SKIPE FATAL + JRST OCLOS1 ; After fatal error, don't rename outputfiles. + SYSCAL RENMWO,[C ; Rename (F has nameblock addr) + $F6FN1(F) ? $F6FN2(F)] + HALT +OCLOS1: SYSCAL CLOSE,[C] ; Close channel. + HALT + JRST 2(A) ; Skip over args on return. + + +; OBUFO - Write out and reinitialize buffer for file. +; Assumes byte count (header 3rd wd) was sos'd. +; C has <0 chnl,header> +; In ITS version, header 1st wd has ,,-1 + +OBUFO: PUSH P,A + PUSH P,AA + AOSGE 2(C) ; Was count sos'd from -1? + JRST OBUFO1 ; Yes, buffer hadn't been initted, don't write it. + MOVN A,1(C) + ADD A,(C) ; RH(A) has -<# wds used in buffer>. + MOVSI A,(A) + HRR A,(C) + AOS A ; A has aobjn -> used part of buffer. + HLLZ AA,C + IOR AA,[.IOT A] + CAIGE A, + XCT AA ; Write it in file. +OBUFO1: MOVE A,1(C) + HRR A,(C) ; Position the b.p. before start of buffer, + TLZ A,770000 ; After last byte in wd (idpb will use 1st buffer wd) + MOVEM A,1(C) + HLRE A,(C) + MOVEM A,2(C) ; Set up byte count. + REST AA + JRST POPAJ + +TFEED: TLNN FF,FLPTPF ; If output device not PTP, + POPJ P, ; Then do nothing + PUSHJ P,TPPBF ; Otherwise output the buffer, +TFEED1: .FEED UTYOC, ; Feed a line, + TLZA FF,FLPTPF ; If this is executed, utyoc doesn't have ptp after all + SOJG B,TFEED1 ; Feed the specified number of lines, + POPJ P, ; And return + +] ; IFN ITSSW + +SUBTTL DEC - Output file Open, Output, Close/Rename + +IFN DECSW,[ + +OINIT: MOVE AA,(P) + MOVE F,(AA) ; Get , + HLLZ TT,F + TLZ TT,#(0 17,) ; Mask off AC field in TT + HRRZ D,2(AA) ; Get buffer space addr. + HLLZ C,2(AA) ; Get header addr. + HLRZ A,C + SETZM (A) ; Clear out its-version contents of 1st header wd. + LDB A,[331100,,F] ; Get mode to open in (will be ascii or image binary) + IOR TT,[OPEN A] ; Cons up OPEN instruction for chan, + MOVE B,$F6DEV(F) ; and bring in last arg. + XCT TT ; Open channel,a + JRST OINITL ; Lost? + + PUSH P,.JBFF ; Now to fake out DEC system into consing up buffer + MOVEM D,.JBFF ; at this location. T10 uses .JBFF as pointer. + XOR TT,[#] ; Request buffer setup (one of) + XCT TT + REST .JBFF + MOVE A,[SIXBIT /000MD /] + PJOB B, ; Get job number, to make sixbit /md/ + IDIVI B,10. + DPB C,[220400,,A] + IDIVI B,10. + DPB C,[300400,,A] ; Put the digits of the job number into the sixbit word. + DPB B,[360400,,A] + MOVE AA,(P) + LDB B,[360600,,1(AA)] ; Get 1st char of 'output, 'lstout, 'crfout, 'errout. + IOR A,B ; Use it as last char of temp file name. + MOVSI B,'TMP ; Set up ext (fn2), + SETZ C, ; zap prot/date/time etc to default, + MOVE D,$F6DIR(F) ; and PPN. + XOR TT,[#] + XCT TT ; Do ENTER UTYOC,A + JRST OINITL +POPJ3: AOS (P) +POPJ2: AOS (P) + JRST POPJ1 + +; OINITL - jumped to from OINIT if some lossage +; encountered when opening output files. Jumps back to OINIT +; directly. + +OINITL: PUSHJ P,OPNER ; Type out reason for open failure, and ask: + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Get typein, one line. + PUSHJ P,RFD ; Get new file description into filblk spec'd by F + JRST OINIT ; and jump back to try again. + + ; Openloss documentation routine - not much to say. + +IOPNER: ; Input +OPNER: PUSHJ P,TYPFB ; Type out file description + PUSHJ P,CRRERR ; Now crlf to ensure room for following + TYPE "OPEN failed" + PJRST CRRERR ; Return, typing out another CRLF. + +;CLOSE AN OUTPUT FILE, SEE NON-DEC VERSION FOR ARGS. + +OCLOSE: PUSH P,A ; Save return addr + MOVE F,1(A) ; Get + SKIPGE FATAL ; If fatal error happened, + JRST OCLOS2 ; don't rename, just close. + MOVE C,$F6DEV(F) ; Delete any file with names + SETZB B,D ; we want to rename to. + OPEN ERRC,B ; Use ERRC as temporary channel. + JRST OCLOS1 + MOVE A,$F6FN1(F) + HLLZ B,$F6EXT(F) + SETZ C, + MOVE D,$F6DIR(F) + LOOKUP ERRC,A + JRST OCLOS1 ; There is none, just rename. + SETZ A, ; Say to delete this file + MOVE D,$F6DIR(F) ; From right UFD + RENAME ERRC,A + JFCL + RELEAS ERRC, +OCLOS1: MOVE A,$F6FN1(F) ; Desired fn1. + HLLZ B,$F6EXT(F) ; Desired fn2. + SETZ C, ; Bottoms-10 DATE75 lossage must never be forgotten! + MOVE D,$F6DIR(F) ; Sname (that is, ppn) + HLLZ AA,@(P) ; Get just chnl num. + IOR AA,[CLOSE] ; Close it & finalize, + XCT AA + XOR AA,[CLOSE#] + XCT AA ; Then rename to desired names. + JFCL ; at this point, ignore any lossage, sigh. +OCLOS2: HLLZ B,@(P) ; Get chnl in ac field. + IOR B,[RELEAS] + XCT B ; Finally, release channel. + JRST POPJ2 ; and skip over args on return. + + ; Write out buffer of output file, C has <0 chnl,header> +OBUFO: AND C,[0 17,] ; Get just chnl num. (sys remembers where header is for ch) + TLO C,(OUT) ; Output current buffer. + XCT C + RET ; Normal return! + PUSH P,A ; Error return from out uuo. + XOR C,[OUT#] + XCT C ; Read file status. + TRZ A,74^4 ; Clear error bits. + ETR [ASCIZ /Output data error/] + XOR C,[#] + XCT C + JRST POPAJ + + ; Paper tape stuff, do nothing. +TFEED: RET + +] ;END IFN DECSW, + +SUBTTL TNX - Output file Open, Output, Close/Rename + +IFN TNXSW,[ + +TFEED: RET ; Again, null out paper-tape hack. + +; OINIT - Open Output file. +; P points to first word of args which follow the call: +; 1: , ; is 0 for ascii, 13^9 for bin. +; 2: sixbit // +; 3:
,, +; +; Clobbers A,B,C + +; For Tenex, it is necessary to fudge the fileblock consistency slightly; +; $FJFN has in RH the actual JFN used to write to the temporary-name +; file, and in LH the JFN for the final desired filename. Note that if +; the $FEXT is null for main output file, it will be defaulted by TNXODF +; at close time, (to SAV, EXE, or REL) and the +; "final desired" JFN won't actually be used. +; Both JFNS are "active" rather than just a file spec. + +OINIT: MOVE C,(P) ; Get addr of arg block + HLRZ A,2(C) ; Get
, + SETOM 2(A) ; and set buffer byte cnt to -1 to mark for init. + MOVE F,(C) ; Get , + PUSHJ P,GETJFO ; Get output JFN for filblk. + JRST OINIT5 ; Lost? +OINIT2: HRLZS $FJFN(F) ; Won, move JFN over into LH. + + ; Aha, successfully grabbed a JFN for desired output filename. + ; Now must get another one for the temporary filename... + MOVSI A,(GJ%FOU+GJ%NEW) + PUSHJ P,TFMAP ; Must set up block again, may have changed due to RDJFNO. + MOVE A,1(C) ; Get sixbit/tmpfn2/ + PUSHJ P,CV6STR ; Convert to ASCIZ and return BP to string. + MOVEM A,GTJBLK+.GJEXT ; Store in long-form call blk. + SYSCAL GTJFN,[[GTJBLK] ? [0]][A] ; Repeat the GTJFN call. + JRST [ MOVEM A,ERRCOD ; Ugh???? + JRST OINIT5] + HRRM A,$FJFN(F) ; Good, got it... + + ; Now have both JFN's packed away, can finally open the + ; temporary filename. + HRRZ B,A ; Need JFN in RH with LH clear... + LDB A,[331100,,F] ; Get + CAIN A, + MOVSI A,070000 ; If 0, use ASCII (7-bit bytes) + TRNE A,-1 + MOVSI A,440000 ; If not 0, use WORD (36-bit bytes) + TRO A,OF%WR ; Get write access. + SYSCAL OPENF,[B ? A][A] ; Open up the temp file (JFN in RH) + JRST [ MOVEM A,ERRCOD ? JRST OINIT6] ; damn + + ; Won, successfully opened output file stuff etc, now wrap up. + HRRZ A,$FJFN(F) ; Get JFN used, + LDB C,[270400,,F] ; and channel number argument, + MOVEM A,JFNCHS(C) ; and store JFN away in channel slot. + PUSHJ P,CVFSIX ; Now put right things in $F6 entries. + MOVEI A,3 + ADDM A,(P) + POPJ P, + +.SCALAR ERRCOD + + ; Come here when GTJFN fails trying to get a JFN for GTJBLK long + ; form argument block. Must print out bad filename. + ; OINIT5 should really use names in GTJBLK, and + ; OINIT6 should really hack GJFNS call to get names, but for now... + +OINIT5: SKIPA A,[[ASCIZ /GTJFN failed for /]] +OINIT6: MOVEI A,[ASCIZ /OPENF failed for /] + PUSHJ P,CRRERR + TYPR (A) + PUSHJ P,OPNER1 ; Type out filename and error message. + PUSHJ P,RDJFNO ; Read new JFN + JRST OINIT2 ; try to open it. + +IOPNER: PUSH P,[CRRERR] ; Do following and add CRLF. +OPNER1: PUSHJ P,TYPFB + TYPE " +Error - " ; Drop thru to TERSTR. + + +TERSTR: MOVE A,ERRCOD + HRLI A,.FHSLF + SYSCAL ERSTR,[[-1,,ERSTRB] ? A ? [-LERSTR,,]][A ? A ? B] + JRST TERST7 ; undefined err #? + HALT ; destination bad? + TYPR ERSTRB + POPJ P, +TERST7: TYPE "Unknown error" + POPJ P, + + LERSTR==80. +.VECTOR ERSTRB(/5) + +; RDJFNO - Hack to get a new JFN by reading from TTY, using recognition. +; RDJFNI - Same but for input. Uses current FB for defaults. +; Stashes JFN away in RH of $FJFN(F). + +RDJFNO: SKIPA A,[GJ%FOU+GJ%NEW+GJ%CFM] ; For output +RDJFNI: MOVSI A,(GJ%OLD+GJ%CFM) ; for input + PUSHJ P,TFMAP + MOVE A,[.PRIIN,,.PRIOU] ; Use primary JFNs (TTY) for I/O + MOVEM A,GTJBLK+.GJSRC + PUSH P,R1 + PUSH P,R2 + PUSH P,R3 + CAIA +RDJFN2: PUSHJ P,RDJERI ; Come here when get error in GTJFN. + MOVEI R1,.PRIIN ; Make sure that + CFIBF ; TTY input is reset. + HRROI R1,[ASCIZ / +Use what filename instead? /] + PSOUT + MOVEI R1, + MOVEI R1,GTJBLK + SETZ R2, + GTJFN + JRST RDJFN2 ; Error, report it. + POP P,R3 + POP P,R2 + HRRM R1,$FJFN(F) + POP P,R1 + PJRST JFNSTB ; Smash FB with names of the JFN we got, and return. + +; RDJERR - Report last error message directly to TTY (primary output). +; Useful when doing quick direct user interaction. + +RDJERR: TROA R2,-1 ; Here to get last error, whatever it was. +RDJERI: MOVE R2,R1 ; Here to use err code in R1. + HRLI R2,.FHSLF + HRROI R1,ERSTRB + MOVSI R3,-LERSTR + ERSTR ; Get error string + JRST RDJER6 + HALT + SKIPA R1,[-1,,ERSTRB] +RDJER6: HRROI R1,[ASCIZ /Unknown error/] + ESOUT ; Output to TTY amid other hackery. + POPJ P, + + +; TNXODF - Hack to get yet another "desired" JFN so that when no +; extension was specified for binary output file, one appropriate to +; the type can be selected. +; Basically do a GTJFN again for binary output filenames, furnishing +; the default extension selected, and use that to replace the one +; already in LH of $FJFN. + +TNXODF: PUSHJ P,CV6STR ; Convert sixbit word in A to string, get BP in A + MOVEI F,OUTFB ; Point at right filblk, + MOVEM A,$FEXT(F) ; Store, and now + PUSH P,$FJFN(F) ; Save current set of JFNs before + PUSHJ P,GETJFO ; getting another one + JRST POPAJ ; If lossage, stick to old JFN. + POP P,A + HRLZS $FJFN(F) ; GETJFO puts JFN into RH, we want it in LH. + HRRM A,$FJFN(F) ; now restore previous RH. + HLRZS A ; and get old "desired" JFN in position for + SYSCAL RLJFN,[A] ; releasing. + JFCL + POPJ P, + +; OCLOSE - Close output file, writing out remainder of buffer and renaming +; from temporary to desired filename. +; JSP A,OCLOSE +; 1: 0 ,,
+; 2: +; Clobbers F,C (and obviously A) + +; 10x must do CLOSF, not releasing the JFN, and then a RNAMF from temp +; JFN to desired JFN, after which both can be released. The desired and +; used JFNs are in LH and RH respectively of $FJFN in . +; is ignored except to wipe out its JFNCHS entry. + +OCLOSE: PUSH P,A + MOVE C,(A) ; Get ,,
+ SOS 2(C) ; OBUFO assumes count was SOS'd before each call + PUSHJ P,OBUFO ; Write out anything remaining in buffer. + LDB C,[270400,,(A)] ; Get channel number + MOVE F,1(A) ; Get + HRRZ A,$FJFN(F) ; Find JFN being used... + CAME A,JFNCHS(C) ; Should be same as JFN for channel. + HALT ; Synch error or something. + TLO A,(CO%NRJ) ; Say don't release JFN + SYSCAL CLOSF,[A] ; Close file... + HALT ; ?!?! + HRRZS A ; Get back 0,,jfn + SETZM JFNCHS(C) ; Indicate "channel" closed... + SKIPE FATAL ; If fatal error happened in assembly, + JRST OCLOS5 ; don't rename from temp filenames. + HLRZ C,$FJFN(F) ; Now see what if anything to rename it to. + JUMPE C,OCLOS5 ; If no renaming needed, skip hair. + SYSCAL RNAMF,[A ? C] ; Rename file from JFN in A to JFN in C. + HALT ; WTF? + SYSCAL RLJFN,[C] + HALT +OCLOS5: SYSCAL RLJFN,[A] + HALT + SETZM $FJFN(F) + POP P,A + JRST 2(A) + +; OBUFO - Output Buffer and reinitialize. +; C/ 0 ,
+; Clobbers no ACs. + +; 10X is pretty much like ITS, JFN is kept in JFNCHS table indexed by . + +OBUFO: PUSH P,A + PUSH P,B + MOVE A,1(C) ; Get write BP, + HRR A,(C) ; and reset it... + TLZ A,770000 ; to point at start of buffer, + MOVEM A,1(C) ; and store it back, which is OK since we have byte cnt + AOSGE 2(C) ; Was buffer marked for initialization (cnt -1)? + JRST OBUFO1 ; Yes, don't write anything, just go init rest of it. + HLRZ A,(C) ; Get buffer size in wds, + MOVNI A,(A) ; make negative, + ADD A,2(C) ; and add count of bytes left to get -<# bytes used>. + LDB B,[270400,,C] ; Get channel # as index to JFN + PUSH P,T + SYSCAL SOUT,[JFNCHS(B) ? 1(C) ? A] + POP P,T +OBUFO1: HLRZ A,(C) ; Get buffer size again, + MOVEM A,2(C) ; and reset count with it. + POP P,B + POP P,A + POPJ P, + +] ;END IFN TNXSW + +SUBTTL COMMON Input Routines - Main File Open, EOF handling + +; Open main input file for reading (filespec in ISFB) + +OPNRD: +IFN ITSSW, .IOPDL ; Re-initialize IO pdl +IFN DECSW\TNXSW, CALL IOPDLC ; Non-ITS systems must simulate. + INSIRP SETZM,INFCNT INFCUR INFERR + MOVE A,[-TYPDLS-1,,TTYPDL] + MOVEM A,ITTYP ; Initialize "tty pdl" + PUSHJ P,MACIN1 ; Clobber macro expansion status + MOVE A,[ISFB,,INFB] ; Copy ISFB specs to INFB (which will hold + BLT A,INFB+L$FBLK-1 ; actual names of current input file) + MOVE A,ISFB+$FDEV ; Get device name + CAMN A,FSTTY ; TTY? + JRST [ MOVE A,[ISFB+$F6FN1,,IFNM1] ; TTY specified, treat special + BLT A,IFNM2 ; Clobber .IFNM1, .IFNM2 to specified + MOVE A,ISFB+$FVERS + MOVEM A,IFVRS + TYPECR "Reading from TTY:" + MOVEI A,3 ; => input from tty, don't quit on cr + JRST OPNRT2] + MOVEI F,INFB ; Point things at INFB. + PUSHJ P,OPNRD1 ; Try opening file + JRST [ PUSHJ P,IOPNER ; Open lost, type out message + POPJ P,] ; Read new command (this may screw on pass2?) + MOVEM A,INFERR ; Err msg in main file shouldn't type names. + MOVEI A,0 ; => input from file +IFN TNXSW,[ + MOVE T,INFB+$FJFN ; Copy actual jfn to avoid re-GTJFN + MOVEM T,ISFB+$FJFN +] +OPNRT2: MOVE T,[IFNM1,,RFNAM1] + BLT T,RFVERS ; Set up .FNAM1, .FNAM2 + SETOM NEDCRL + AOS (P) ; Won, skip on return. + JRST RCHSET ; Set up to read from file or tty. (arg in A) + + + ; Common stuff for OPNRD1 in all (DEC/ITS/TENEX) versions. +OPNRD3: HRRZM A,UTIBED ; Say buffer empty, + MOVSI A,EOFCH_13 + MOVEM A,@UTIBED ; Cause immediate reload. +OPNRD4: BLTM 2,$F6FN1(F),IFNM1 ; Set up .IFNM1, .IFNM2 from filblk F points at + MOVE A,$FVERS(F) + MOVEM A,IFVRS + AOS A,INFCNT ; Assign this file a number. + MOVEM A,INFCUR ; OPNRD expects this left in A. + JRST POPJ1 + + ; EOF while trying to read character + +RPAEOF: PUSH P,B ; Save B +RPAEO1: MOVE B,ITTYP ; Get pdl pointer + PUSHJ P,BPOPJ ; Call pop routine (maybe NED's out) + JRST RCHTRB ; Return to get character + + ; EOF from main file + +NEDCHK: TRNE FF,FRCMND ; ^C read in command, :KILL self. + JRST TSRETN + SKIPN RCHMOD + AOSE NEDCRL + JRST NEDCH1 + + ; Invent one crlf after end of main file. + MOVE B,[440700,,[.BYTE 7 ? ^M ? ^J ? EOFCH]] + MOVEM B,UREDP + HRRZM B,UTIBED +IFN PMAPSW,[ + HRLI B,170700 ; Make BP pointing at last (3rd) char + MOVEM B,UTIBPE ; Set EOF BP properly. +] + RET +NEDCH1: +IFN A1PSW,[ + PUSHJ P,OUTCHK + MOVSI A,-LNEDT + XCT NEDT(A) ; Skips if NED condition to be complained about + AOBJN A,.-1 + JUMPGE A,GO8 +] + ETF [ASCIZ /No END statement/] + +.SCALAR NEDCRL ; -1 => haven't yet supplied a CRLF at EOF of main file. + +IFN A1PSW,[ ; Holler "NED" if any of the following: +NEDT: SKIPL PRGC ; No end statements have been encountered + SKIPGE OUTC ; Output has occured not matched by an end statement + SKIPGE OUTN1 ; Output has occured other than in 1pass mode + TRNN FF,FRPSS2 ; Currently in pass 2 +LNEDT==.-NEDT ; Length of table +] + +SUBTTL ITS - Input file Open, buffer input +IFN ITSSW,[ + + ; Try .OPENing input file pointed to by F. Skips if successful. + ; Sets filenames to actual names. + +OPNRD1: SYSCAL OPEN,[[.BAI,,UTYIC] + $F6DEV(F) ? $F6FN1(F) ? $F6EXT(F) ? $F6DIR(F)] + JRST [ .STATUS UTYIC,IFSTS ; Lost, save status now before possible + POPJ P,] ; .IOPOP, and make failure return. + SYSCAL RFNAME,[%CLIMM,,UTYIC ; Now find true filenames. + MOVEM A + MOVEM C ; But need to check FN1, FN2 so + MOVEM D ; put them in ACs instead. + MOVEM $F6DIR(F)] + .LOSE %LSFIL + CAMN A,[SIXBIT/DSK/] + MOVE A,V.SITE ; Use machine name instead of DSK. + MOVEM A,$F6DEV(F) + CAIE C, ; If FN1 meaningless for device, skip to use + MOVEM C,$F6FN1(F) ; spec'd FN1 anyway, but else store actual FN1. + CAIE D, + MOVEM D,$F6FN2(F) ; Ditto for FN2. + MOVE D,[440600,,$F6FN2(F)] + SETZ A, +OPNRD7: TLNN D,770000 + JRST OPNRD6 + ILDB C,D ; Calculate version number as number from fn2. + CAIL C,'0 ; Ignore non-digits. + CAILE C,'9 + JRST OPNRD7 + IMULI A,10. + ADDI A,-'0(C) + JRST OPNRD7 + +OPNRD6: SKIPN A ; No digits in FN2 => use -1 as version. + SETO A, + MOVEM A,$FVERS(F) + MOVE A,IUREDP ; Set up reading ptr, + MOVEM A,UREDP + JRST OPNRD3 ; Set up ^C after buffer, infcur, etc. + + + ; EOFCH encountered on read, reload and jump back for next char + +INCHR3: HRRZ CH1,UREDP ; Get byte pointer + CAME CH1,UTIBED ; End of block? + RET ; No, ^C in file. + MOVE A,IUREDP + MOVEM A,UREDP + MOVE A,[-UTIBFL,,UTIBUF] + .IOT UTYIC,A ; Read in block + ANDI A,-1 + CAIN A,UTIBUF ; If the iot didn't give us anything, we are at EOF. + JRST RPAEOF + HRRZM A,UTIBED ; Store RH (updated pointer) for EOF check at INCHR3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ; Store a ^C after the data we read, so at EOB we come to INCHR3. + JRST RCHTRA ; Now try next char +] ;END IFN ITSSW + +SUBTTL DEC - Input file Open, buffer input + +IFN DECSW,[ + +OPNRD1: MOVEI C,UTIHDR ; Open the input file w/ names in dnam ... snam. + SETZ A, ; Mode ascii. + MOVEI D,UTIBUF + MOVE TT,UTICHN ; Get channel num. to use. + LSH TT,27 ; Put in ac field. + IOR TT,[OPEN A] + MOVE B,$F6DEV(F) + XCT TT ; Open channel,a + RET + CALL BUFINI ; Initialize the input buffers and header. + MOVE D,$F6DIR(F) + MOVE A,$F6FNM(F) + HLLZ B,$F6EXT(F) + TLC TT,(OPEN#LOOKUP) + XCT TT ; Lookup channel,a + RET ; Failed. +IFE SAILSW,[ + MOVE A,$F6DEV(F) + DEVNAM A, ; Get real name of device. + CAIA + MOVEM A,$F6DEV(F) +] + MOVE A,UREDP + JRST OPNRD3 + + + ; Reload buffer, DEC style. +INCHR3: HRRZ CH1,UREDP ; Is this ^C at end of buffer? + CAME CH1,UTIBED + RET ; No, ^C in file. + PUSH P,B + MOVE A,UTICHN + LSH A,27 ; Channel num. in ac fld. + TLO A,(IN) + XCT A ; Get next bufferfull. + CAIA ; Succeed. + JRST INCHR4 ; Error. +INCHR5: MOVE A,UTICNT + ADDI A,9 + IDIVI A,5 + ADD A,UREDP ; -> 1st wd not read into. + HRRZM A,UTIBED + HRRZ A,UREDP + AOS A + MOVEI B,1 ; Scan the file and replace all line numbers with nulls. +INCHR6: CAMN A,UTIBED + JRST INCHR7 + TDNE B,(A) + MOVEM B,(A) + AOJA A,INCHR6 + +INCHR7: MOVSI B,EOFCH_13 + MOVEM B,(A) ; Put EOF char after buffer, in extra word. + JRST RCHTRB ; Retry RCH. + +INCHR4: XOR A,[#IN] + XCT A + TRZE B,74^4 + ETR [ASCIZ /Input data error/] + XOR A,[#] + XCT A ; Clear error bits in status. + TRNN B,2^4 + JRST INCHR5 + JRST RPAEO1 ; EOF. + +; BUFINI - Create DEC-style buffer ring, with 1 extra word following +; each buffer... +; A/ +; B/ +; C/
+; D/ +; Note that this extra-word crock is necessary just so it can be filled +; with ^C's to stop read loop and switch to next buffer. + +BUFINI: MOVEI AA,A +IFE SAILSW,DEVSIZ AA, + SKIPA AA,[DECBFL+1] ; Default buffer size is that for dsk. + AOJLE AA,.-1 ; Get size including extra wd. + MOVEI T,1(D) ; Addr of wd 2 of 1st buffer. + HRLI AA,T ; @AA is addr of 2nd wd of next buffer. + SUBI D,(AA) ; Facilitate test for end of buffer space. + HRLI T,400000 + MOVEM T,(C) ; Header -> a buffer, sign set. + HRRM T,1(C) ; Make rh of bp -> buffer 1st wd. + MOVSI T,440000 ; Set up p-field of b.p. + IORM T,1(C) + HRRZ T,1(C) + AOS 1(C) + HRLI T,-3(AA) ; Data-area-size +1,,addr-of-2nd-wd +BUFIN1: CAIGE D,-UTIBFL(T) ; Room for another after this buffer? + JRST BUFIN2 ; No, wrap up. + MOVEM T,@AA ; Yes, make next buffer -> this one, + HRRI T,@AA ; Point to next one. + JRST BUFIN1 + +BUFIN2: ADDI D,1(AA) ; -> 2nd wd of 1st buffer. + MOVEM T,(D) ; 1st buffer -> last, making ring. + RET + +] ;END IFN DECSW, + +SUBTTL TNX - Input file Open, buffer input + +IFN TNXSW,[ + +; OPNRD1 - Open File for Reading. Old stuff assumed fnm in DNAM +; using UTYIC channel, but new should furnish arguments: +; F/ to open + +; Essentially just GTJFN and OPENF like OINIT does, with same +; sort of error handling, except that when reading from cmd line +; as opposed to .INSRT, just go back to get completely new command. +; (perhaps if typein is just CRLF, go to special TNX style cmd input?) + +OPNRD1: CAIN F,INFB ; Horrible kludge necessary because MIDAS main + ; level doesn't bother to explicitly close main + ; input file when pass 1 is done, and TNX barfs if + ; you try to re-open a JFN... sigh. + JRST [ SKIPN $FJFN(F) ; Main file. Already opened it? + JRST .+1 ; nope, get JFN & open normally. + IFE PMAPSW,[ ; Already open. If not mapping, reset read ptr. + SYSCAL SFPTR,[$FJFN(F) ? [0]][ERRCOD] + POPJ P,] + JRST OPNRD2] ; and avoid attempt to re-open the JFN. + SKIPN $FJFN(F) + JRST [ PUSHJ P,GETJFI ; No JFN, get one for input. + POPJ P, ; Could fail. + JRST .+1] + PUSH P,T ; Read access, full word input. + SYSCAL OPENF,[$FJFN(F) ? [440000,,OF%RD]][ERRCOD] + JRST [POP P,T ? POPJ P,] ; Failure + POP P,T +OPNRD2: HRRZ A,$FJFN(F) + MOVEM A,JFNCHS+UTYIC ; Indicate "channel" open with this JFN. + PUSHJ P,JFNSTB ; Get actual names/version #. + PUSHJ P,CVFSIX ; Put right stuff in $F6 entries. + MOVE A,IUREDP ; Opened, set up buffer. + MOVEM A,UREDP ; Initialize BP into buffer. +IFE PMAPSW, JRST OPNRD3 +IFN PMAPSW, JRST OPNR50 ; for PMAP hacking, lots of stuff to do. + + ; Get a JFN for current FILBLK (in F) and stick it into $FJFN(F). + ; A should hold flags in LH to use in 1st wd of block. + ; GETJFI - sets usual flags for input + ; GETJFO - sets " " output + ; GETJFN - takes whatever A holds. + +GETJFO: SKIPA A,[GJ%FOU+GJ%NEW] ; If hacking output, ask for new version. +GETJFI: MOVSI A,(GJ%OLD) ; If hacking input, file must exist. +GETJFN: PUSHJ P,TFMAP ; Stick filblk stuff into GTJFN scratch block. + PUSH P,R1 + PUSH P,R2 + MOVEI R1,GTJBLK + SETZ R2, + GTJFN + JRST [ MOVEM R1,ERRCOD ; failure, save error code. + JRST GETJF5] + HRRM R1,$FJFN(F) ; Win, save JFN. + AOS -2(P) +GETJF5: POP P,R2 ; Can't return in ACs cuz don't know what R1 etc are, + POP P,R1 ; and might clobber them here. + POPJ P, + +; TFMAP - Map Tenex filenames from filblk pointed to by F into +; standard scratch block for long-form GTJFN. +; A/ ,,0 ; flags will go into LH of .GJGEN. +; Clobbers only A. + +TFMAP: HRR A,$FVERS(F) ; Put version # in RH + SKIPE $FTEMP(F) ; If asking for temp file, + TLO A,(GJ%TMP) ; set appropriate flag. + MOVEM A,GTJBLK+.GJGEN +IRP FROM,,[$FDEV,$FDIR,$FNAME,$FTYPE,$FPROT,$FACCT,$FJFN]TO,,[.GJDEV,.GJDIR,.GJNAM,.GJEXT,.GJPRO,.GJACT,.GJJFN] + MOVE A,FROM(F) + MOVEM A,GTJBLK+TO +TERMIN + MOVE A,[.NULIO,,.NULIO] + MOVEM A,GTJBLK+.GJSRC ; Don't hack I/O in gtjfn. + POPJ P, + +.VECTOR GTJBLK(10.) ; Need exactly this many wds for non-extended long call + +IFE PMAPSW,[ + ; EOFCH seen in input, check it here. + +INCHR3: HRRZ CH1,UREDP ; Get byte pointer + CAME CH1,UTIBED ; End of block? + RET ; No, ^C in file. + MOVE A,IUREDP + MOVEM A,UREDP + PUSH P,T + SYSCAL SIN,[JFNCHS+UTYIC ? [444400,,UTIBUF] ? [-UTIBFL]][A ? A ? A] + POP P,T + ADDI A,UTIBUF+UTIBFL ; Get UTIBUF + <# bytes stored> + CAIG A,UTIBUF ; If the sin didn't give us anything, we are at eof. + JRST RPAEOF + HRRZM A,UTIBED ; Store rh (updated pointer) for eof check at inchr3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ; Store a ^c after the data we read + JRST RCHTRA ; Now try next character + +] ; IFE PMAPSW + +IFN PMAPSW,[ ; New stuff for PMAP'ing input etc. + +VBLK +IFNDEF NIBFPS,NIBFPS==10 ; # of pages per buffer +PGBFL==NIBFPS*1000 ; Length of a buffer in wds. +IFNDEF 1STBFP,1STBFP==500 ; # of first page to start buffers at. + +INBFPG: 1STBFP ; # of 1st buffer page (in our address space) +INFPAG: 0 ; # of page in file corresponding to 1st page in buffer. +INPGCT: 0 ; -# times to refill buffer with new pages. +INLPGS: 0 ; # pages to slurp on last refill (instead of NIBFPS) +UTIBPE: 0 ; BP to last byte of data in buffer (holding ^C) +UTIBPL: 0 ; BP to last byte position in buffer area (constant) +UTIBPX: 0 ; BP to last byte of data when last pages have been mapped. +INLCHR: 0 ; Place to save char that ^C replaces. If -1, no char. +;SOSSW: 0 ; non-Z if hacking SOS line-number type file. +FBBYV: 0 ; GTFDB dumps cruft in these two locs. +FBSIZ: 0 ; e.g. this gets size of file in bytes. +PBLK + + ; Wrap up open of an input file, by initializing all the cruft + ; above. +OPNR50: SYSCAL GTFDB,[$FJFN(F) ? [2,,.FBBYV] ? MOVEI FBBYV] + LDB C,[300600,,FBBYV] ; Get byte size of file + CAIN C, + MOVEI C,36. ; If 0 use 36-bit bytes (full wds) + MOVEI A,36. + IDIVI A,(C) ; Get bytes per wd, ignore remainder. + MOVE B,FBSIZ ; Now, with # bytes in file, + EXCH A,B + IDIVI A,(B) ; find <# in fil>/<# per wd> = # wds in file + CAIE B, ; Also hack + ADDI A,1 ; rounding up (gasp, wheeze, finally done.) + IDIVI A,PGBFL ; Now get # times buffer will need slurping... + CAIE B, + ADDI A,1 ; Also round up. B has # "live" words in last slurp. + MOVNM A,INPGCT ; Store -# slurps. + MOVEI A,1777(B) + LSH A,-9. ; Find # pages last slurp really needs. + MOVEM A,INLPGS ; and store away. + HRLI B,010700 + MOVEM B,UTIBPX ; Store relative BP to last ch (when last pages mapped) + HRRI B,PGBFL-1 ; And relative BP to last char in whole buffer + MOVEM B,UTIBPL + MOVE A,INBFPG ; Find page # buffer starts at in core, + LSH A,9. ; Get address, and + ADDM A,UTIBPX ; add into the BP's to make them absolute. + ADDM A,UTIBPL + HRLI A,010700 ; also get initial read pointer from that. + SUBI A,1 ; MUST be "canonical form", so that SEMIC hackery + MOVEM A,IUREDP ; will work with weird way INCHR3 returns here. + MOVNI A,NIBFPS ; Use this as initial file page #, so the ADDB in + MOVEM A,INFPAG ; INCHR3 will do right thing to it. + MOVE A,[440700,,[EOFCH_35]] + MOVEM A,UREDP ; set up things so first RCH will instantly cause reload. + ILDB B,A + MOVEM A,UTIBPE + SETOM INLCHR ; Mustn't forget that we don't have a stored char yet. + JRST OPNRD4 ; Finally done with PMAP init stuff. + + ; Come here when hit ^C +INCHR3: MOVE CH1,UREDP ; Get current read ptr + CAME CH1,UTIBPE ; At end of buffer? + POPJ P, ; Nope, ^C in file, actual input. + AOSLE CH1,INPGCT ; Aha, end of buffer. Bump times refilled... + JRST [ SKIPGE A,INLCHR ; and if no more refills, see if last char left + JRST RPAEOF ; No? All done, true EOF. + SETOM INLCHR ; Almost, one last char. + MOVE CH1,UREDP ; Must bump ptr back one char, so next read + ADD CH1,[070000,,] ; will also stop. + CAIG CH1, + SUB CH1,[430000,,1] + MOVEM CH1,UREDP + JRST INCHR7] ; Return char in A. + MOVE A,IUREDP + MOVEM A,UREDP +IFN A-1,PUSH P,R1 +IFN A-2,PUSH P,R2 +IFN A-3,PUSH P,R3 + MOVEI R1,NIBFPS ; Get # of input buffer pages + ADDB R1,INFPAG ; and find current page in file to get + HRL R1,$FJFN+INFB ; current input file's JFN + MOVE R2,INBFPG ; and usual pointer to destination buffer page + HRLI R2,.FHSLF ; Why the fuck doesn't 10X default this?!?! + MOVEI R3,NIBFPS ; Set # pages to slurp up + CAIN CH1, ; But if this is last slurp, + MOVE R3,INLPGS ; use pre-calculated # to avoid non-ex pages. + TLO R3,(PM%CNT+PM%RD+PM%CPY) ; Read access, copy-on-write. +INCH50: PMAP ; Gobble gobble + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI R3,-1(R3) ; Else, on 10X, must iterate manually. + TRNE R3,400000 ; See if became "negative". + JRST .+1 ; Yep, done with manual iteration. + ADDI R2,1 ; Nope, bump page #'s. + AOJA R1,INCH50] +IFN A-3,POP P,R3 +IFN A-2,POP P,R2 +IFN A-1,POP P,R1 + CAIE CH1, ; Was this the last slurp? + SKIPA CH1,UTIBPL ; no, use BP to Last char at end of buffer. + MOVE CH1,UTIBPX ; yes, need BP to last char in last page. +IFN 0,[ SKIPE SOSSW ; If hacking line number lossage, + JRST [ MOVE A,(CH1) ; must beware of getting wiped, so have to + TRNE A,1 ; check here, and if depositing EOFCH in #, + HRLI CH1,350700 ; then move the EOFCH to beg of word! + JRST .+1] +] + LDB A,CH1 ; Replace last char of buffer's data + MOVEI CH2,EOFCH + DPB CH2,CH1 ; with the EOF char. + MOVEM CH1,UTIBPE ; Remember ptr to end of data, + EXCH A,INLCHR ; and save char for then, returning whatever + JUMPL A,RCHTRA ; was the last char of last bufferfull. + ; (may be -1, in which case RCHTRA tries again) + + ; Jump here to return a new char in A, something like + ; RCHTRA without all the fuss. +INCHR7: POP P,CH1 ; Get return addr + ANDI CH1,-1 + CAIE CH1,RREOF+1 + JRST -2(CH1) ; Note -2 not -3 as in RCHTRA! + JRST (CH1) ; Special hack since -2 loses for RREOF. + ; Perhaps someday it will win. +] ; IFN PMAPSW + +] ;END IFN TNXSW + +ifn 0,[ ; turn off but keep around for a while. +SUBTTL old .INSRT Processing + +; .INSRT ; Insert file here +; TTY: => ok, reads line at a time, rubout allowed within line +; Pushes macro expansion, other .INSRT's +; In filedescription, ^R => reset file name counter [?!? - KLH] +; If device is "@:", always ask for translation. + +A.INSR: NOVAL + MOVE A,[ISFB,,FB] ; Default names are those of spec'd input file + BLT A,FB+L$FBLK-1 ; Zap them into scratch filblk. + MOVEI F,FB ; And point at it. + MOVE A,FSDSK + MOVE B,FSTTY ; Compare "TTY" with + CAMN B,$FDEV(F) ; device name, and if identical, + MOVEM A,$FDEV(F) ; default to DSK. +IFE ITSSW,MOVE A,FSMID ; Always set default extension to "MID" or ">" +IFN ITSSW,MOVE A,FSGRTN + MOVEM A,$FEXT(F) + + TLO FF,FLUNRD +A.IN1: PUSHJ P,RFD ; Read file description + MOVE A,$FDEV(F) ; Get specified device name + CAME A,FSATSN ; Atsign? + PUSHJ P,A.ITRY ; No, try opening file + + ; If return, open failed. + MOVE A,$F6DEV(F) + AOJE A,A.INT1 ; Already trying to set up table entry + SKIPA F,[MAXIND,,TBLOFS] ; Atsign, or fnf, search table + +A.IN2: SUBI F,-L$FBLK ; Loop point searching table, increment to next entry, count down LH + CAMN F,INDDP ; Compare with pointer to top of table + JRST A.IN3 ; Agree => this file not in table + +; MOVEI A,-TBLOFS(F) ; Get index relative to table base. +; MIDAS complains "illegal use of relocation" when try to use above addr, so must use next 2 instructions instead - barf barf + MOVEI A,(F) + SUBI A,TBLOFS + + MOVSI B,-L$FBLK ; And index into FB. + MOVE T,TBLSFS(A) ; Get specification name this entry +A.IN25: CAMN T,FB(B) ; Compare with that just specified + AOBJN B,[AOJA A,.-2] ; Check all names this entry +IFE TNXSW, JUMPL B,A.IN2 +IFN TNXSW,[JUMPL B,[ MOVEI C,(B) + CAIN C,$FJFN ; One item of entry didn7t match, was it JFN? + JRST A.IN25 ; Yes, ignore it and continue. + JRST A.IN2] ; Sigh, was something else, entry doesn't match. + ] + + ; File is in table + MOVSI A,(F) ; Move description from TBLOFS to FB. + HRRI A,FB + BLT A,FB+L$FBLK-1 +IFN TNXSW, SETZM FB+$FJFN ; Since re-opening, must zap previous JFN. + PUSHJ P,A.ITRY ; Try opening file + + ; If return, open failed. + MOVSI A,TBLSFS-TBLOFS(F) ; Set up LH(BLT pointer), + HRRI A,FB + BLT A,FB+L$FBLK-1 ; Unmap to original names(TBLSFS to FB) + PUSHJ P,TYPFB ; Type out specified names + TYPE " -> " ; Type out pointer + MOVSI A,(F) ; Copy translation (TBLOFS entry) back to FB. + HRRI A,FB + BLT A,FB+L$FBLK-1 + SETOM $F6DEV(F) ; "half-kill" entry in TBLOFS + +A.INT1: PUSH P,F + MOVEI F,FB + PUSHJ P,IOPNER ; Open lost, type out cruft + POP P,F + TYPE "Use what filename instead? " +A.INT2: PUSHJ P,GTYIP ; Prepare to read one line from tty + JRST A.IN1 ; Try again with what he types in + + ; File not in table, try to add a translation for it. + +A.IN3: TLNN F,-1 ; More room for another entry in table? + ETF [ASCIZ /Too many @: files/] + MOVEI A,TBLSFS-TBLOFS(F) ; Copy FB into TBLSFS (specified name) + HRLI A,FB + BLT A,TBLSFS-TBLOFS+L$FBLK-1(F) + SETOM $F6DEV(F) ; Document fact that entry has only key, not translation + MOVNI A,-L$FBLK + ADDM A,INDDP ; Update pointer into table + MOVE A,FB+$FDEV ; Get specified device name + CAME A,FSATSN ; Atsign? + JRST A.INT1 ; No, type out garbage and try again, reading from tty + MOVE A,ISFB+$FDEV ; Yes, clobber from input device name + MOVEM A,FB+$FDEV + JRST A.INT2 + +;TRY OPENING INPUT FILE FOR .INSRT, RETURN IF UNSUCCESSFUL + +A.ITRY: MOVE A,FB+$FDEV ; Get specified device name + CAMN A,FSTTY ; TTY? + JRST A.ITRT ; Yes, treat special + TLO FF,FLUNRD + PUSHJ P,IPUSH ; Save current status + PUSH P,F ; save what F points at + MOVEI F,FB + PUSHJ P,OPNRD1 + JRST [POP P,F ? JRST IPOPL] ; Lose, pop and return + POP P,F + MOVE B,[FB,,INFB] ; Kludge for time being - if win, + BLT B,INFB+L$FBLK-1 ; Copy all stuff into INFB. +IFN ITSSW,CALL SETWH2 + MOVE B,ITTYP + MOVEI A,-2-TYPDEL(B) ; + HRLI A,IFNM1 + BLT A,-TYPDEL(B) ; Introduce hysteresis so .INSRT'ing file can reference .IFNM1, .IFNM2 +IFN CREFSW,[ + SKIPE CRFONP ; If creffing, output push-file block. + PUSHJ P,CRFPSH ; (pop-file block output at ipop) +] +A.ITR2: + MOVE A,$F6DEV(F) ; Push successful, now check to see if table entry should be finished + AOJN A,ASSEM1 + MOVEI A,(F) ; Move FB into TBLOFS as translation entry. + HRLI A,FB + BLT A,L$FBLK-1(F) + JRST ASSEM1 ; Now assemble from file (ASSEM1 clobbers pdl) + + ; .INSRT TTY: + +A.ITRT: PUSHJ P,GTYIPA ; Read from tty, don't quit until .INEOF + JRST A.ITR2 ; Fall back in (doesn't touch .IFNM1, .IFNM2) +] ; end IFN 0 + +SUBTTL .INSRT Processing + +; .INSRT ; Insert file here +; TTY: => ok, reads line at a time, rubout allowed within line +; Pushes macro expansion, other .INSRT's +; If device is "@:", always ask for translation. + +A.INSR: NOVAL + + ; First set up defaults for parsing filename. + BLTM L$FBLK,ISFB,FB ; Default names are those of spec'd input file, + MOVEI F,FB ; stuffed into scratch FB. + MOVE A,FSDSK + MOVE B,FSTTY ; Compare "TTY" with + CAMN B,$FDEV(F) ; device name, and if identical, + MOVEM A,$FDEV(F) ; default to DSK. +IFE ITSSW,MOVE A,FSMID ; Always set default extension to "MID" or ">" +IFN ITSSW,MOVE A,FSGRTN + MOVEM A,$FEXT(F) + + TLO FF,FLUNRD + PUSHJ P,RFD ; Read file description from current input. + MOVE A,$FDEV(F) ; Get specified device name + CAMN A,FSATSN ; Atsign? + JRST A.IN50 ; If so, check out translation right away. + +A.IN2: CAMN A,FSTTY ; TTY? Must handle specially. + JRST [ PUSHJ P,GTYIPA ; Set up to read until .INEOF or EOF char. + JRST ASSEM1] ; And don't do anything to .IFNM1/2, etc. + PUSHJ P,IPUSH ; File, push the world. + PUSHJ P,OPNRD1 ; Try opening file. + JRST [ PUSHJ P,IPOPL ; Sigh, failed, pop world back and go + JRST A.IN50] ; try translation entries or TTY input. + ; Always jumps back to A.IN2. + + ; Come here when input file successfully opened. Clean up etc. + BLTM L$FBLK,(F),INFB ; Move current filespec to INFB, +IFN ITSSW,CALL SETWH2 + MOVE B,ITTYP + BLTM 3,IFNM1,-2-TYPDEL(B) ; Copy new .IFNM1, .IFNM2 onto stack, + ; to clobber .IFNM1/2 for previous file, so + ; that .IFNM1/2 etc refers to last file .INSRT'd by + ; current file (or current file if none .INSRT'd yet) +IFN CREFSW,[ + SKIPE CRFONP ; If creffing, output a push-file block. + PUSHJ P,CRFPSH ; (pop-file block is output at IPOP) + ] + + JRST ASSEM1 ; and jump off to smash things to toplevel. + + ; Come here when open attempt fails or @: device specified. +A.IN50: CAIE F,FB ; Tried translations yet? + JRST A.IN60 ; Yes, skip table hacking and go get fnm from TTY. + + ; First open attempt, so OK to search translation table. + SKIPA D,[MAXIND,,TBLOFS] ; Load up aobjn-style index to transl table +A.IN52: SUBI D,-L$FBLK ; Loop point for searching table - increment to next entry, count down LH + CAMN D,INDDP ; Compare with pointer to top of table + JRST A.IN60 ; Agree => this file not in table, get from TTY. + + MOVEI A,(D) ; Get scratch index into tables, + HRLI A,-L$FBLK ; making AOBJN of it, + MOVEI B,(F) ; and get index into current FB. +A.IN54: MOVE C,TBLSFS-TBLOFS(A) ; Get a specification name for this entry +IFN TNXSW,CAIE B,$FJFN(F) ; (ignoring the JFN item, for TENEX) + CAMN C,(B) ; Compare name with that of failed filblk. + AOBJN A,[AOJA B,A.IN54] ; Check all names this entry + JUMPL A,A.IN52 ; If not found, try next entry. + + ; File is in table, try opening it using TBLOFS description. + MOVE F,D ; Replace old F by ptr to winning TBLOFS entry. +IFN TNXSW, SETZM $FJFN(F) ; Since re-opening, must zap any previous JFN. + JRST A.IN2 ; Jump off to try opening. + + ; Come here when open failed and no matching transl entry. + ; Must set up to gobble down a translation from TTY... +A.IN60: TYPE "Error in .INSRT; " + CAIE F,FB ; Were we trying to open a translated entry? + JRST [ PUSHJ P,TYPFB ; Yes, so print out appropriate info + TYPE " -> " ; to show translated stuff. + JRST A.IN70] + + ; First time, no translation entry exists, make one. + MOVE A,INDDP ; Get current pointer to top of tables + TLNN A,-1 ; Room for more? + JRST A.IN70 ; Nope, can't remember transl, but get right fnm anyway. + MOVE F,A ; Yep, use it as pointer to table entry to use. + SUBI A,-L$FBLK ; and get new table-top pointer with clever + MOVEM A,INDDP ; SOS of LH and ADDI to RH. + BLTM L$FBLK,FB,(F) ; Move FB contents to both TBLOFS, + BLTM L$FBLK,FB,TBLSFS-TBLOFS(F) ; and TBLSFS. + +A.IN70: ; Print out filename F points to, & err msg. +IFN TNXSW,[ + PUSHJ P,OPNER1 + PUSHJ P,RDJFNI ; On 10X, get new filename this way. + ] +IFN ITSSW\DECSW,[ ; Elsewhere do it painful way. + PUSHJ P,IOPNER + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Setup to read 1 line from TTY, + PUSHJ P,RFD ; and do it, parsing filename. +] + JRST A.IN2 ; now go try opening it. + +SUBTTL Misc. .INSRT-related things + + ; .INEOF - EOF pseudo + +A.IEF2: PUSHJ P,PMACP ; Loop point, pop entry off macro pdl +A.INEO: TLNE FF,FLMAC ; Inputting from macro? + JRST A.IEF2 ; Yes, pop it off + PUSH P,CMACCR ; Back to inputting from file or tty, cause return to maccr + MOVE B,ITTYP ; Get pdl pointer + POPJ B, ; Return to pop routine + + + ; Call from ERRH; type input file's names if changed since last err msg. +ERRTFL: MOVE C,INFCUR + EXCH C,INFERR ; Say last error msg in this file. + CAMN C,INFERR ; If prev. msg was in other file, + POPJ P, + PUSH P,F + MOVEI F,INFB ; Point to current input file, + PUSHJ P,TYPFB ; and type out its filename. + POP P,F + PJRST CRRERR + +SUBTTL COMMON IO PDL routines for input. (.INSRT support) + +;IO PDL ROUTINES FOR INPUT FILE +; Push the input file + +IPUSH: AOSN CMEOF ; Want to pop out of tty? (^C typed in) + CALL POPTT ; Yes, do now before forget. + +IFE PMAPSW,[ + MOVE D,UREDP ; Get input byte pointer +IFN ITSSW\TNXSW,[ +IFN ITSSW, .IOPUS UTYIC, +IFN TNXSW, MOVEI A,UTYIC ? PUSHJ P,$IOPUSH + TLNN D,760000 ; At end of word? + ADD D,[430000,,1] ; Yes, make it point to beginning of next word + MOVEM D,UREDP + MOVNI A,-2(D) + ADD A,UTIBED ; Get # wds we'll need in MACTAB. + HLR D,UTIBED ; Remember whether EOF on last .IOT. + HRRZS UTIBED ; Now clear out left half for following +] +IFN DECSW,[ + AOS A,UTICHN ; Do ".IOPUSH" - use next channel. + LSH A,27 + ADD A,[WAIT-<0 1,>] ; Construct a WAIT uuo for the current input channel. + MOVE C,RCHMOD ; We mustn't copy the buffers while I/O is going on. + CAMN A,[WAIT UTYIC,] ; But: if we are currently in the top-level input file + CAIE C,3 ; And it is device TTY:, this channel was never opened. + XCT A ; Don't move buffers while io going on! + MOVEI A,UTIBFL+2 ; Assume must save all buffer space. +] + PUSH P,A + ADD A,FREPTB + ANDI A,-1 + PUSH P,A + CAML A,MACTND ; No room in MACTAB => gc it. + CALL GCA1 + REST A + CAML A,MACTND ; Did the GC win? + PUSHJ P,GCCORQ ; NO!! Try to win somehow + MOVEI A,370 + CALL PUTREL ; Indicate start of saved buffer. + REST A + AOS B,FREPTB + SUBI A,1 + MOVE C,ITTYP ; Get addr of tty pdl wd that'll point to saved buffer. + ADDI C,1 + HRRZM C,(B) ; Store in rh of 1st wd, + MOVEI C,(B) ; Remember addr of saved buffer to push on ttypdl. + HRLM A,(B) ; Put length in lh. + AOS B +IFN ITSSW\TNXSW,HRL B,UREDP ; LH <- addr of 1st wd to save. +IFN DECSW,HRLI B,UTIBUF + ADDI A,-2(B) ; Addr of last wd to blt into. + BLT B,(A) + HRLI A,041000 + MOVEM A,FREPTB ; Make free bp -> last byte just used. + SUB A,MACTAD + ANDI A,-1 + LSH A,2 + ADDI A,4 ; Get char addr of next free byte. + MOVEM A,FREEPT +] +IFN PMAPSW, CALL IOBPUS + + MOVE B,ITTYP ; Get local version of iopdl +IPSHP: +IFE PMAPSW, PUSH B,C ; Push -> saved buffer (GC will relocate) +IFN DECSW,PUSH B,UTIBED ? PUSH B,UTIHDR +REPEAT L$FBLK, PUSH B,INFB+.RPCNT ; Save names of input file. + PUSH B,INFCUR ; Save number of input file. +IFE PMAPSW, PUSH B,D ; Lh=lh(old uredp), rh=lh(old utibed) (or just UREDP) +IFN PMAPSW, INSIRP PUSH B,[INFPAG INPGCT INLPGS UTIBPE UTIBPL UTIBPX INLCHR UREDP IUREDP ] + + ; Following three must be last pushed + INSIRP PUSH B,[IFNM1 IFNM2 IFVRS] ; Clobbered on pdl if .open successful +INPDEL==.-IPSHP ; Length of each entry on pdl + + MOVE A,FREEPT ; W must use same gc convention as putrel; + CAML A,MACHI ; Namely, gc after using up the last byte. + CALL GCA1 + MOVEI A,0 ; => input from file + MOVEM B,ITTYP ; Store back updated pointer + JSP B,PUSHTT ; Save stuff, address modify and return + + + ; Pop into the input file +IPOP: +IFN CREFSW,[ MOVEI A,2 ; If creffing, output pop-file block. + SKIPE CRFONP + PUSHJ P,CRFOUT] +IPOPL: PUSHJ P,POPTT ; Come here if .INSRT's open failed. + PUSH P,C + MOVE B,ITTYP ; Get pointer + INSIRP POP B,[IFVRS IFNM2 IFNM1] ; Pop stuff +IFE PMAPSW, POP B,A ; Pop off UREDP (or halves thereof) +IFN PMAPSW, INSIRP POP B,[ IUREDP UREDP INLCHR UTIBPX UTIBPL UTIBPE INLPGS INPGCT INFPAG] + POP B,INFCUR +REPEAT L$FBLK,POP B,INFB+L$FBLK-1-.RPCNT +IFN DECSW,[ + POP B,C + PUSH P,C ; Old UTIHDR + POP B,UTIBED +] +IFE PMAPSW, POP B,C + MOVEM B,ITTYP ; Save updated pdl pointer. +IFE PMAPSW,[ + HLRZ B,(C) ; Get length of saved buffer, +IFN ITSSW\TNXSW,[ + PUSH P,A +IFN ITSSW, CALL SETWH2 ? .IOPOP UTYIC, +IFN TNXSW, MOVEI A,UTYIC ? CALL $IOPOP + REST A + MOVEI AA,UTIBUF-1(B) ; Get addr of 1st wd won't blt into in utibuf, + HRLI AA,(A) ; Get saved lh of utibed, + MOVEM AA,UTIBED + HRRI A,UTIBUF ; Make A -> 1st wd in buffer, +] +IFN DECSW,[ + MOVE AA,UTICHN + LSH AA,27 + IOR AA,[RELEAS] + XCT AA ; This code equivalent to .IOPOP. + SOS UTICHN + REST UTIHDR +] + MOVEM A,UREDP + MOVSI A,EOFCH_13 + MOVEM A,@UTIBED ; Put EOF char after buffer. + MOVSI A,1(C) ; Get addr of 1st data wd of saved buffer, + HRRI A,UTIBUF + CAIE B,1 + BLT A,UTIBUF-2(B) + HLLZS (C) ; Tell GC to reclaim saved buffer. +] ;IFE PMAPSW + +IFN PMAPSW, CALL IOBPOP + +POPCJ: REST C + RET + +;SAVE INTERNAL POINTERS CONCERNING INPUT MODE + +TYPDEL==2 ; Number of words in relevant pdl entry + +PUSHTT: PUSH P,A + PUSH P,F + AOSN CMEOF ; If supposed to pop out of tty soon, + CALL POPTT ; Do it now before cmeof clobbered. + MOVE F,ITTYP ; Get relevant pdl pointer + MOVEI A,0 + EXCH A,CLNN ; Set up new line number + HRL A,CPGN ; Save current page number + SETZM CPGN ; Now re-initialize + SKIPGE CRFILE ; Save cref-all-on-one-line flag. + TLO A,400000 + PUSH F,A ; Save cpgn,,clnn + MOVE A,-1(P) ; Retrieve new mode + PUSHJ P,PSHLMB ; Save limbo1 and set up instructions for new mode +IFN ITSSW,[ + CALL SETWH2 + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ; Store back updated pointer + JRST POPFAJ + + ; Restore internal pointers concerning input mode + +POPTT: PUSH P,A + PUSH P,F + MOVE F,ITTYP ; Get pdl pointer + PUSHJ P,POPLMB ; Pop into limbo1, set up new mode + POP F,A ; Get cpgn,,clnn + SETZM CRFILE ; Restore all-on-one-line flag. + TLZE A,400000 + SETOM CRFILE + HLRZM A,CPGN + HRRZM A,CLNN +IFN ITSSW,[ + CALL SETWH2 + ADD A,CPGN + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ; Store back updated pointer + JRST POPFAJ + +IFN ITSSW,[ +SETWH2: MOVE A,RCHMOD + CAIL A,2 + SKIPA A,[SIXBIT /TTY:/] + MOVE A,INFB+$F6FN1 + .SUSET [.SWHO2,,A] + MOVE A,A.PASS + LSH A,30 + ADD A,[SIXBIT /P0/+1] + RET +] + +SUBTTL Storage for IO PDL stuff + + ; IO PDL storage stuff + +VBLK +TYPDLS==TYPDLC*TYPDEL+INPDEL*MX.INS + ; "tty pdl", stores information about current input mode + ; (similar to macro pdl but not garbage collected) + +ITTYP: -TYPDLS-1,,TTYPDL ; Pdl pointer (typdel=length of each entry) +TTYPDL: NEDCHK ; Actual pdl: initial entry to overpop routine + BLOCK TYPDLS ; Pdl proper +PBLK + +SUBTTL TNX - IO PDL Routines (IOPDLC, $IOPUSH, $IOPOP) + +IFN TNXSW,[ + +IFN PMAPSW,[ + ; Push IO buffer & channel... +IOBPUS: PUSH P,A + MOVEI A,UTYIC + CALL $IOPUSH + MOVEI A,NIBFPS ; Point at next set of buffer pages. + ADDM A,INBFPG + POP P,A + POPJ P, + + ; Pop IO buffer & channel... +IOBPOP: PUSH P,A + MOVE A,INBFPG + HRLI A,NIBFPS + CALL DELPGS ; flush buffer pages. + MOVNI A,NIBFPS + ADDM A,INBFPG ; point down at previous set of buffer pages... + MOVEI A,UTYIC + CALL $IOPOP + POP P,A + POPJ P, + +; DELPGS - Take arg in A as <# pgs>,, and flush these pages. + +DELPGS: PUSH P,A + PUSH P,B + HLRZ B,A + HRLI A,.FHSLF ; ,, + TLO B,(PM%CNT) + PUSH P,T +DELPG2: SYSCAL PMAP,[[-1] ? A ? B][A ? A ? B] ; Free up buffer pages. + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI B,-1(B) ; Else, on 10X, must iterate manually. + TRNE B,400000 ; See if became "negative". + JRST .+1 ; Yep, done with manual iteration. + AOJA A,DELPG2] ; Nope, bump page #'s. + POP P,T + POP P,B + POP P,A + POPJ P, +] ;IFN PMAPSW + +; IOPDLC - Clear IOPDL stack, close all channels on it. +; Clobbers no ACs + +; for 10x, need to CLOSF and release each JFN on IOPDL stack. + +IOPDLC: PUSH P,T +IFN PMAPSW,[ + MOVEI T,1STBFP ; Reset to point at 1st page of buffer space. + MOVEM T,INBFPG +] + EXCH A,IOPDLP + JRST IOPDC3 +IOPDC2: SYSCAL CLOSF,[(A)] + JFCL + SUB A,[1,,1] +IOPDC3: CAMLE A,[-LIOPDL,,$IOPDL-1] + JRST IOPDC2 + EXCH A,IOPDLP + POP P,T + POPJ P, + +; $IOPUSH - Push I/O channel in A onto $IOPDL stack. +; Clobbers no ACs +; for 10X this means storing JFN on stack and clearing JFNCHS table entry. + +$IOPUSH:EXCH B,IOPDLP ; Get stack pointer + PUSH B,JFNCHS(A) ; save JFN for channel + EXCH B,IOPDLP + SETZM JFNCHS(A) ; Zap entry in channel table to make it look gone + POPJ P, + +; $IOPOP - Pops channel off $IOPDL into channel # in A. +; Clobbers no ACs + +; for 10X just pop $IOPDL into JFNCHS, must close and release old JFN tho. + +$IOPOP: PUSH P,T + SYSCAL CLOSF,[JFNCHS(A)] + JFCL + POP P,T + EXCH B,IOPDLP ; Get stack ptr + POP B,JFNCHS(A) + EXCH B,IOPDLP + POPJ P, + +VBLK +JFNCHS: BLOCK 20 ; Channel table index, JFNCHS(ch) gets JFN for chan. + ; (zero if none) +LIOPDL==8. ; Length of IO PDL +IOPDLP: -LIOPDL,,$IOPDL-1 +$IOPDL: BLOCK LIOPDL +PBLK +] ; IFN TNXSW + +SUBTTL DEC - IO PDL Routines (IOPDLC) + +IFN DECSW,[ + +; IOPDLC - Simulate ITS .IOPDL call. Flushes all channels from +; UTICHN downwards to UTYIC. Actually not a simulation but something +; that works in the particular situation for which MIDAS uses .IOPDL. + +IOPDLC: MOVEI A,UTYIC + EXCH A,UTICHN ; Set input chnl num. to lowest. + LSH A,27 + IOR A,[RELEAS] ; Set up to releas the highest in use first. +IOPDL1: XCT A ; Releas one input channel, + CAMN A,[RELEAS UTYIC,] + RET ; All done. + SUB A,[0 1,] + JRST IOPDL1 ; Releas the next one down. +] ;IFN DECSW + +SUBTTL COMMON TTY input routines & variables + +VBLK +CMBUF: BLOCK CMBFL ; Typein buffer (also used as JCL buffer) +CMPTR: 0 ; Byte pointer to CMBUF. +CMEOF: 0 ; -1 => POPTT instead of reloading after this bufferfull. +TTYOP: 0 ; -1 => the TTY is already open. +LINEL: 0 ; Width of TTY (may be 1,, meaning assume infinite). +A.TTYFLG: ; Value of .TTYFLG pseudo - another label for TTYFLG. +TTYFLG: 0 ; TTY typeout permitted iff >= 0. +WSWCNT: 0 ; The number of W-switches in the last cmd string. +TTYBRF: 0 ; -1 => ^H break has been requested but not yet done. +PBLK + ; Cause input from tty (main routines) + +GTYIPA: SETZM A.TTYF ; Push to tty, don't stop at cr. + +IFN ITSSW, TYPECR "TTY: .INSRTed, end input with ^C" +IFN DECSW\TNXSW,[ + IFE SAILSW,TYPECR "TTY: .INSRTed, end input with ^Z" + IFN SAILSW,TYPECR "TTY: .INSRTed, end input with CTL-META-LF" + ] + +GTYIP1: SKIPA A,[3] +GTYIP: MOVEI A,2 ; Input from tty, stop after 1 line. + SETZM CMPTR ; Force reload on 1st read. + JSP B,PUSHTT ; Set up variables and return +GTYIPR: SETZM CMPTR ; Return on .ineof or cr + JRST POPTT + + ; Call here from ASSEM1 loop when a ^H interrupt is detected. +TTYBRK: SETZM A.TTYF + ETR [ASCIZ/^H - break /] ; Type filename, page and line #. + SKIPE ASMOUT + TYPECR "within a <>, () or []" + JRST GTYIPA + + ; RCHSET routines for reading from TTY + ; RCHMOD=3 => don't quit on CR + ; 2 => quit on CR. +RCHTRC: +RCHARC: TLO FF,FLTTY ; Set flag + JSP A,CPOPJ +RCHAC1: REPEAT 2,[ ; RCH2, RR1 + ILDB A,CMPTR ; Get char + CAIN A,0 ; End of string marked with 0 + PUSHJ P,TYRLDR ; Reload, jump back for next char +] + HALT ; RRL1 +IFN .-RCHAC1-RCHPSN,.ERR RCHAC1 LOSES. + ILDB A,CMPTR ; SEMIC + CAIN A,15 + JRST SEMICR + JUMPN A,SEMIC + PUSHJ P,TYRLD + JRST SEMIC + +TYRLD: MOVEI A,3 ; Return after the call, not before. + ADDM A,(P) + + ; TYRLDR - Read in string. + ; Reload buffer if ran out in call to RCH. + +TYRLDR: AOSN CMEOF ; EOF detected after last reload => + JRST RPAEOF ; Pop out of tty. + PUSH P,A + PUSH P,B + MOVE B,RCHMOD + PUSH P,F + PUSH P,A.TTYF ; If chars rubbed out they should be printed. + SETZM A.TTYF + MOVE F,[10700,,CMBUF-1] ; Initial byte pointer to buffer + MOVEM F,CMPTR ; Store as byte pointer for read +TYRLD2: PUSHJ P,TYI ; Get character +IFN TNXSW,[ + CAMN F,CMPTR ; at beg of line? + CAIE A,^J ; and char is LF? + CAIA + JRST TYRLD2 ; If so then ignore it completely. +] + CAIN A,177 ; Rubout? + JRST TYRLD3 ; Yes + CAIE A,^C + CAIN A,^Z + JRST TYRLD7 ; ^C, ^Z => EOF. Ought to be EOFCH for consistency? + CAIN A,^U + JRST TYRLD5 ; Rub out all + CAIE B,2 ; For .TTYMAC handling, convert lower case to upper. + JRST TYRLD6 + CAIL A,"A+40 + CAILE A,"Z+40 + CAIA + SUBI A,40 +TYRLD6: CAME F,[010700,,CMBUF+CMBFL-2] + IDPB A,F ; Store character in buffer unless buffer nearly full. + CAIE A,^M ; CR? + JRST TYRLD2 ; No, go back for next + CAIN B,2 ; .TTYMAC (mode 2) => CR ends input, so fake EOF. + SETOM CMEOF + MOVEI A,^J ; Follow the CR with a LF. + IDPB A,F + PUSH P,F ; Output the entire line to the error file + MOVE F,[10700,,CMBUF-1] +TYRLD8: CAMN F,(P) + JRST TYRLD9 + ILDB A,F + CAIN A,^M ; If line was ended by a ^C or ^Z, put that in error + SKIPL CMEOF ; file, which needs hair since that char is not + JRST TYRLD0 ; In the string we stored. + MOVEI A,"^ + CALL ERRCHR +IFN ITSSW,MOVEI A,"C +IFN DECSW\TNXSW,MOVEI A,"Z + CALL ERRCHR + LDB A,F +TYRLD0: CALL ERRCHR + JRST TYRLD8 + +TYRLD9: REST F + MOVEI A,0 + IDPB A,F ; Mark end of string + IDPB A,F + REST A.TTYF + REST F + REST B + REST A + JRST RCHTRA + +TYRLD7: SETOM CMEOF ; ^C, ^Z force EOF, + CALL TYRLCR ; After turning into ^M. + MOVEI A,^M + JRST TYRLD6 + +TYRLCR: MOVEI A,^M + CALL TYOX + MOVEI A,^J + JRST TYOX + +TYRLD3: CAMN F,[10700,,CMBUF-1] ; Rubout, beginning of buffer? + JRST TYRLD4 ; Yes + LDB A,F ; Get last character in buffer + CALL TYOX ; Type it out, don't write in error file. + ADD F,[70000,,] ; Decrement pointer + JUMPGE F,TYRLD2 ; Jump if valid + SUB F,[430000,,1] ; Was 440700,,something, back it up + JRST TYRLD2 + +TYRLD5: MOVE F,[10700,,CMBUF-1] ; ^U, back to beginning of line +TYRLD4: PUSHJ P,TYRLCR ; Rubout when at beginning of buffer, type CR + JRST TYRLD2 + +SUBTTL ITS - TTY routines (TYOX, TYI, TTYINI) and JCLINI. + +IFN ITSSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOP + CALL TTYINI + .IOT TYOC,A + POPJ P, + + ; TYI - Get (just typed in) char in A +TYI: SKIPN TTYOP + CALL TTYINI ; Open the tty if not already done. + .IOT TYIC,A + ANDI A,-1 ; Non-tty devices can return -1,,3. + JUMPE A,TYI + CAIN A,^L ; This must be assuming that ^L clears screen? + JRST TYI + POPJ P, + + ; Initialize tty +TTYINI: PUSH P,A + .OPEN TYIC,[.UAI,,'TTY] ; Input + .LOSE + .OPEN TYOC,[%TJDIS+.UAO,,'TTY] ; Display mode output + .LOSE + SYSCAL CNSGET,[1000,,TYOC ? 2000,,A ? 2000,,A] + MOVSI A,1 ; TTY: is translated to something else => assume infinite linel + MOVEM A,LINEL ; Else linel gets width of tty. + SETOM TTYOP ; Say the tty is now open. + JRST POPAJ + +JCLINI: SETZM CMPTR + .SUSET [.ROPTIO,,A] + TLNN A,%OPCMD ; Has our superior said it has a cmd? + RET ; No. + BLTZ CMBFL-1,CMBUF ; Zero all but last word, + SETOM CMBUF+CMBFL-1 ; and ensure last word non-zero. + .BREAK 12,[5,,CMBUF] ; Try to read command string. + MOVE A,[440700,,CMBUF] + SKIPE CMBUF ; If read a cmd-string, + MOVEM A,CMPTR ; Tell TYRLD, GO2A it's there. + POPJ P, + +]; END IFN ITSSW + +SUBTTL TNX - TTY routines (TYOX, TYI, TTYINI) and JCLINI + +IFN TNXSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOP + CALL TTYINI +IFN A-1,EXCH A,R1 + PBOUT +IFN A-1,EXCH A,R1 + POPJ P, + + ; TYI - Get (just typed in) char in A + ; There is a screw for 20X in that it's not really possible + ; to know if the system is going to feed you a CR-LF + ; or just a CR; TYRLD2 checks for that, by flushing LF's, but + ; this would be the place to check if it were easy to do. +TYI: SKIPN TTYOP + CALL TTYINI ; Open the tty if not already done. +IFN A-1,EXCH R1,A + PBIN ; Get char into AC 1 + JUMPE R1,.-1 ; Ignore nulls. + TLNE FF,FL20X ; Cretinous differences between 10X/20X + JRST TYI2 ; 20X, skip EOL check. + CAIN R1,^_ ; On 10X, CR turned into ^_ (EOL); change it back. + MOVEI R1,^M +TYI2: +IFN A-1,EXCH R1,A ; Restore everything to right place if necessary. + POPJ P, + + ; TTYINI - Initialize tty + +TTYINI: PUSH P,A + PUSH P,T + SYSCAL RFMOD,[[.PRIIN]][A ? A] + POP P,T + HLRZS A + ANDI A,177 ; Terminal width + CAIGE A,30. ; If too low, + ADDI A,128. ; Assume twenex crockishness + MOVEM A,LINEL ; Linel gets width of tty. + SETOM TTYOP ; Say the tty is now open. + POP P,A + POPJ P, + + ; Read "JCL" - RSCAN buffer or nnnMID.TMP file (from CCL) + +JCLINI: SETZM CMPTR + SKIPE CCLFLG ; Started at CCL location? + JRST JCLIN5 ; Yep, go snarf stuff specially. + TLNN FF,FL20X ; Is this Tenex? + JRST [ MOVEI R1,.PRIIN + BKJFN ; see what previous character was + POPJ P,; *Gasp* + PBIN + CAIE R1,^_ ; Tenex newline? + SETOM CMPTR ; No, set flag saying "TTY but no prompt" + POPJ P,]; and skip the Twenex hackery below + SETZ R1, ; If not, check RSCAN. + RSCAN ; See if have anything in RSCAN buffer. + POPJ P, ; Huh? Shouldn't happen, but ignore it. + JUMPLE R1,APOPJ ; Also return if char cnt says nothing there. + MOVNI R3,(R1) ; Aha, set up cnt for SIN + HRROI R2,CMBUF + MOVEI R1,.CTTRM ; Now ready for business... + SIN + LDB R1,R2 ; Now examine wages thereof + CAIE R1,^M ; Last char CR? + JRST [ MOVEI R1,^M + IDPB R1,R2 ; If not, make it so. + JRST .+1] + SETZ R1, + IDPB R1,R2 ; Must also ensure ASCIZ. + MOVE B,[440700,,CMBUF] ; If the rescan line starts with "RUN ", skip that. +IRPC X,,[RUN ] + ILDB A,B + CAIE A,"X + JRST JCLIN4 +TERMIN + CAIA +JCLIN4: MOVE B,[440700,,CMBUF] ; Now flush the name of the file MIDAS was run from. + ILDB A,B + CAILE A,40 + JRST .-2 ; Flush until random ctl seen (space, ^M) + CAIE A,40 ; If it wasn't a space, + POPJ P, ; then forget about the whole thing. +JCLIN3: MOVE C,B ; Now flush spaces. Save last ptr for chars. + ILDB A,B + CAIN A,40 + JRST JCLIN3 + CAIN A,^M ; And is first non-space something besides CR? + POPJ P, ; Bah, there wasn't anything in the JCL!! + MOVEM C,CMPTR ; Else save ptr to start of real goods. + POPJ P, + + ; TNX snarf of CCL file. No such thing as tmpcor, so just + ; look for real file with appropriate name. +JCLIN5: SETZM CCLFLG ; Want 0 in case abort out, will reset if win. + GJINF ; Get job # in R3 + HRROI R1,CMBUF ; Use CMBUF to form filename string. + MOVEI R2,(R3) + MOVE R3,[NO%LFL+NO%ZRO+<3_18.>+10.] + NOUT ; ship out job num in 3 digits, radix 10. + HALT + HRROI R2,[ASCIZ /MID.TMP/] + SETZ R3, + SOUT ; Flesh out rest of filename string. + SETZ R2, ; Make sure it's ASCIZ. + BOUT + MOVE R1,[GJ%OLD+GJ%SHT] ; Use short-form GTJFN + HRROI R2,CMBUF ; and gobble name from CMBUF. + GTJFN + POPJ P, ; If failed, forget it. + MOVE R2,[070000,,OF%RD] ; Read 7-bit bytes + OPENF + POPJ P, ; Bah + HRROI R2,CMBUF ; Gobble stuff up. + MOVEI R3,CMBFL*5 ; Read until buffer full, + MOVEI R4,^J ; or LF seen. + SIN + JUMPLE R3,APOPJ ; Forget it if too big for buffer!! + + MOVE R2,[440700,,CMBUF] ; Aha, we've got something, so set + MOVEM R2,CMPTR ; pointer to slurped stuff. + SETOM CCLFLG + HRROI R2,UTIBUF ; Slurp rest into larger buffer, + MOVNI R3,UTIBFL*5 ; using count only. + SIN + JUMPGE R3,APOPJ ; Refuse to hack grossly large file. + ADDI R3,UTIBFL*5 + JUMPLE R3,APOPJ ; if nothing read, need write nothing out. + HRLI R1,(CO%NRJ) ; Don't release JFN, + CLOSF ; but stop reading from file. + POPJ P, + MOVE R2,[070000,,OF%WR] ; Now try to hack write access. + OPENF + POPJ P, + MOVE R2,R1 ; Source becomes destination... + HRROI R1,UTIBUF ; and UTIBUF becomes source, + MOVNS R3 ; for just as many bytes as were read. + SOUT + MOVEI R1,(R2) ; done, now just close file. + CLOSF ; (this time, release JFN). + POPJ P, + SETOM CCLMOR ; say that more CCL remains. + POPJ P, +] ; END IFN TNXSW + +SUBTTL DEC - TTY routines (TYOX, TYI, TTYINI) + +IFN DECSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOP + CALL TTYINI + OUTCHR A + POPJ P, + + ; TYI - Get a typed-in char in A + +TYI: SKIPN TTYOP ; Open the tty, if not already done. + CALL TTYINI + INCHWL A +IFN SAILSW,[ + CAIN A,612 ; On SAIL, EOF is 612, + MOVEI A,^Z ; so turn into normal EOF if found. +] + CAIE A,^M ; Throw away the LF after a CR. + RET + INCHWL A + MOVEI A,^M ; Note that TYRLDR will put it back in. + RET + +TTYINI: INSIRP PUSH P,AA A B +IFE SAILSW,[ + PJOB A, + TRMNO. A, + JRST TTYIN1 + MOVEI AA,1012 ; .TOWID + MOVE B,[2,,AA] + TRMOP. B, ; Read width of tty line into B. +] +TTYIN1: MOVEI B,80. ; TRMOP. failed or not tried => assume width is 80. + MOVEM B,LINEL + INSIRP POP P,B A AA + SETOM TTYOP + RET + + TMPLOC .JBREN, TTYREN +TTYREN: SETOM TTYBRF ; "REENTER" command comes here +R: G: JRST @.JBOPC ; To request a ^H-break. Note crufty labels pointing here. + +];IFN DECSW + +SUBTTL DEC Hackery for JCLINI - Read CCL commands. + +IFN DECSW\TNXSW,[ +VBLK +CCLFLG: 0 ; Flag to indicate CCL entry from COMPIL, SNAIL, CCL, or EXEC +CCLMOR: 0 ; -1 => There are more lines of CCL commands, + ; so do a RUN SYS:MIDAS when finished. +PBLK +] + +IFN DECSW,[ ; DEC only hacks CCL as "JCL". + +.SCALAR CCLFIL ; Saves FN1 for tmp file hacking. + +; Read MID temp core file, if that loses, try nnnMID.TMP file. +; Clobbers A,B,C,D. + +JCLINI: SETZM CMPTR + SKIPN CCLFLG ; Was midas called from CCL level? + RET ; No, do not snarf tempcore + SETZM CCLFIL ; No CCL file yet + SETZM CCLFLG ; If tmpcor loses want this 0 (will re-setom below) + BLTZ CMBFL,CMBUF ; Zero cmd buffer. + MOVE A,[2,,['MID,, ? -,,CMBUF-1]] ; read (leave last wd 0) + TMPCOR A, ; Read compil-generated command + JRST [ OPEN [17 ? 'DSK,, ? 0] ; No tempcore, maybe try dump mode. + RET ; Argh but let something else die + PJOB A, ; Get job # + IDIVI A,100. ; Want decimal job number in sixbit + ADDI A,'0 + LSH A,6 + IDIVI B,10. + ADDI A,'0(B) + LSH A,6 + ADDI A,'0(C) + LSH A,18. + HRRI A,'MID ; Form file name as nnnMID.TMP + MOVEM A,CCLFIL ; Save for writing below + MOVSI B,'TMP + SETZB C,D ; No protect or ppn trash + LOOKUP A ; Try to get file + RET ; Give up + MOVE A,[-,,CMBUF-1] + SETZ B, + INPUT A ; Try to read command + SETZB A,B + RENAME A ; Try to delete it now + JFCL ; Ignore failure + CLOSE ; Happy sail + JRST .+1] + SKIPN CMBUF ; One last check for it to be there + RET ; Alas, there is none + MOVE A,[440700,,CMBUF] ; Load a byte pointer to the command + SETOM CCLFLG + MOVEM A,CMPTR ; There is, set command pointer +JCLIN1: ILDB B,A + CAIE B,^J ; See if our command file has anything after 1st line. + JRST JCLIN1 + ILDB B,A + JUMPE B,JCLIN3 + SETOM CCLMOR ; It does; set flag so after handling 1st line we'll + MOVE C,[440700,,UTIBUF+2] +JCLIN2: IDPB B,C + ILDB B,A + JUMPN B,JCLIN2 + SUBI C,UTIBUF+1 ; Get # words written in utibuf. operand is relocatable! + HRLOI C,-1(C) ; These 2 insns turn size into -size,,utibuf+1 + EQVI C,UTIBUF+1 + MOVEM C,UTIBUF+1 + SKIPE A,CCLFIL ; Was this called with a temp file? + JRST [ MOVSI B,'TMP + SETZB C,D + ENTER A ; Try to re-write file + RET ; Sigh + MOVE A,UTIBUF+1 + SETZ B, + OUTPUT A + RELEASE + RET] + MOVSI C,'MID + MOVEM C,UTIBUF + MOVE C,[3,,UTIBUF] + TMPCOR C, + JFCL ; [KLH - there used to be some random cruft here.] +JCLIN3: RET + +] ;END IFN DECSW + +SUBTTL Old Command Line Reader (CMD) +ifn 0,[ + ; Read command & filenames & hack defaulting. + +CMD: SKIPE CMPTR ; Unless have DDT or RSCAN cmd string, + JRST CMD06 ; (we don't) + CALL CRR ; type a CRLF, prompt etc. +CMD05: SETZM CMPTR + TYPE "*" +CMD06: MOVEI A,3 ; Read from TTY (or string <- cmptr) + CALL RCHSET + MOVEI F,FB ; Point to scratch filblk. + BLTZ L$FBLK,FB ; and clear the whole thing. + TRO FF,FRCMND ; Tell RFD it's scanning a command line. + CALL RFD ; Now see if command null, and whether has _. +IFN DECSW\TNXSW,[ + CAIN A,"! ; If terminator was "!", go run program. + JRST RFDRUN +] + TRNN FF,FRNNUL ; If no filespec was seen, + CAIE A,^M ; and terminator is EOL, + CAIA + JRST CMD05 ; then prompt again and get another string. + TRZ FF,FRARRO ; Got something, clear saw-"_" flag. +CMD07: CAIN A,"_ + TRO FF,FRARRO ; FRARRO will be on if there's a "_" in string. + CAIN A,^M + JRST CMD1 ; Read thru the whole command. + CALL RFD + JRST CMD07 + + ; Now re-read the string, for real this time. Previous scan was + ; mainly just to see if "_" existed. If not, then first filename + ; must be input file, and output filenames are all defaulted. +CMD1: MOVE T,[440700,,CMBUF] ; Restore original ptr to + MOVEM T,CMPTR ; beginning of string. +IFN CREFSW,SETZM CREFP ; Clear all switches before decoding them. +INSIRP SETZM 0,ERRFP TTYINS WSWCNT +IFN LISTSW,[ + SETZM LISTP + SETOM LISTP1 ; Will be AOSed by each (L) switch. +] + + MOVE T,FSDSK + MOVEM T,$FDEV(F) +IFE TNXSW,[MOVE T,RSYSNM ? MOVEM T,$FDIR(F)] +IFN TNXSW, SETZM $FDIR(F) + SETZM $FNAME(F) + SETZM $FEXT(F) + + TRZ FF,FRNNUL + TRNE FF,FRARRO ; Don't gobble input spec as output! + CALL RFD ; Read bin file spec. + MOVE TT,FF ; Remember whether null + BLTMAC T,L$FBLK,(F),OUTFB ; Copy from scratch to OUTFB. + + MOVE T,$FDEV(F) + CAMN T,FSNUL + MOVE T,FSDSK + MOVEM T,$FDEV(F) +IFE ITSSW, MOVE T,FSCRF +IFN ITSSW, MOVE T,FSCREF + MOVEM T,$FEXT(F) + + TRNN FF,FRARRO ; If "_" doesn't exist in cmd line, + MOVEI A,"_ ; then only filespec is for input, kludge to get it. + CAIN A,"_ ; If "_" exists in cmd line, did we hit it? + JRST CMD2 ; Ran out of output specs => just use defaults. + CALL RFD ; Read cref file spec. +IFN CREFSW,[ + TRNN FF,FRNNUL ; If spec not null or ended by _, + CAIN A,"_ + SETOM CREFP ; We must want to cref. +CMD2: BLTMAC T,L$FBLK,(F),CRFFB ; Copy specs from FB to CREF FB. +] +IFE CREFSW,CMD2: + MOVE T,FSERR + MOVEM T,$FEXT(F) + CAIN A,"_ + JRST CMD6 ; No more output specs. + CALL RFD ; Read error file sppec. +IFN ERRSW,[ + TRNN FF,FRNNUL ; Nonnull spec or last spec => + CAIN A,"_ + SETOM ERRFP ; Must want an error file. +CMD6: BLTMAC T,L$FBLK,(F),ERRFB ; Copy specs from FB to ERR filblk. +] +IFE ERRSW,CMD6: +IFN LISTSW,[ +IFE ITSSW, MOVE T,FSLST +IFN ITSSW, MOVE T,FSLIST + MOVEM T,$FEXT(F) + CAIN A,"_ ; Any output spec remaining? + JRST CMD3 + CALL RFD ; Yes, read one. + SETOM LISTP ; List spec given implies want listing. +CMD3: BLTMAC T,L$FBLK,(F),LSTFB ; Copy specs from FB to LST filblk. +] + +CMD5: CAIN A,"_ + JRST CMD4 + CALL RFD ; Ignore any output specs not needed. + JRST CMD5 + +CMD4: MOVE T,FSDSK ; Default the input names. + MOVE A,$FDEV(F) + CAME A,FSPTP ; Don't leave dev name set to common out-only devs. + CAMN A,FSNUL + MOVEM T,$FDEV(F) +IFE ITSSW, MOVE T,FSMID +IFN ITSSW, MOVE T,FSGRTN ; > on ITS. + MOVEM T,$FEXT(F) + MOVE T,FSPROG + SKIPN $FNAME(F) ; The fn1 alone is sticky across the _. + MOVEM T,$FNAME(F) + + TRZ FF,FRARRO ; If only 1 name it should be FNAM1. + CALL RFD ; Read input spec. + BLTMAC T,L$FBLK,(F),ISFB ; Copy into specified-input filblk. + MOVE T,$FNAME(F) ; Default output FN1's to input. + SKIPN OUTFB+$FNAME + MOVEM T,OUTFB+$FNAME +IFN CREFSW,[ + SKIPN CRFFB+$FNAME + MOVEM T,CRFFB+$FNAME +] +IFN LISTSW,[ + SKIPN LSTFB+$FNAME + MOVEM T,LSTFB+$FNAME +] +IFN ERRSW,[ + SKIPN ERRFB+$FNAME + MOVEM T,ERRFB+$FNAME +] + MOVE A,FSNUL ; The output dev defaults to NUL: + MOVE T,$FDEV(F) ; If the input is from TTY: + CAMN T,FSTTY + TRNE FF,FRNNUL ; And the bin spec was null. + CAIA + MOVEM A,OUTFB+$FDEV + TRZ FF,FRARRO ; Don't louse up .INSRT's reading. + RET +] ;ifn 0 + +SUBTTL Command Line Reader (CMD) + + ; CMD - Read command & filenames & hack defaulting. + +.SCALAR CMDPSV ; Saves read ptr into CMBUF, for re-scanning. + +CMD: SKIPE T,CMPTR ; If we have DDT or RSCAN or CCL string, + JRST CMD06 ; go hack it without typing anything out. + CAMN T,[-1] ; If Tenex-type "JCL", normal TTY input 'cept no prompt + JRST CMD06X + CALL CRR ; Nope, must type a CRLF, prompt etc. +CMD05: TYPE "*" +CMD06X: SETZB T,CMPTR +CMD06: MOVEM T,CMDPSV ; Save pointer for later restoration + MOVEI A,3 ; Read from TTY (or string <- cmptr) + CALL RCHSET + + MOVEI F,ISFB ; Point to input-spec filblk. + BLTZ L$FBLK,(F) ; Zap it through and through. + TRO FF,FRCMND ; Tell RFD it's scanning a command line. + CALL RFD ; Now see if command null, and whether has _. +IFN DECSW\TNXSW,[ + CAIN A,"! ; If terminator was "!", go run program. + JRST RFDRUN +] + TRNN FF,FRNNUL ; If no filespec was seen, + CAIE A,^M ; and terminator is EOL, + CAIA + JRST CMD05 ; then prompt again and get another string. + TRZA FF,FRARRO ; Got something, clear saw-"_" flag. +CMD07: CALL RFD + CAIN A,"_ + JRST [ TRO FF,FRARRO ; FRARRO will be on if there's a "_" in string. + CALL RFD ; Gobble next filename, input filespec. + JRST CMD1] + CAIE A,^M + JRST CMD07 ; Read thru the whole command until read input filespec + + + ; Now re-read the string, for real this time. Previous scan was + ; mainly to latch onto input filespec and see if "_" existed. + +CMD1: SKIPN T,CMDPSV ; Restore original ptr if there's one, + MOVE T,[440700,,CMBUF] ; else point at beg of buffer. + MOVEM T,CMPTR + SETZM TTYINS ? SETZM WSWCNT ; Clear all switches. +IFN CREFSW,SETZM CREFP +IFN ERRSW, SETZM ERRFP +IFN LISTSW,SETZM LISTP ? SETOM LISTP1 ; Will be AOSed by each (L) switch. + SETZ A, + TRNN FF,FRARRO ; If "_" doesn't exist in cmd line, + MOVEI A,"_ ; then only filespec is for input, kludge to get it. + + MOVEI F,OUTFB + BLTZAC T,L$FBLK,(F) ; Clear output filblk. + MOVE T,FSDSK ; Default dev to DSK. + MOVEM T,$FDEV(F) + SKIPN T,$FNAME+ISFB ; Now default FN1 from input filespec + MOVE T,FSPROG ; (use "PROG" if none) + MOVEM T,$FNAME(F) +IFE TNXSW,[MOVE T,RSYSNM ; Now default directory if need to + MOVEM T,$FDIR(F)] + + TRZ FF,FRNNUL + CAIE A,"_ ; If it exists, + CALL RFD ; Read bin file spec. + TRNN FF,FRNNUL ; If spec was null, + JRST [ MOVE T,FSTTY ; and input spec was TTY:, + CAME T,$FDEV+ISFB + JRST .+1 + MOVE T,FSNUL ; then set device to NUL:. + MOVEM T,$FDEV(F) + JRST .+1] + +DEFINE CFMAC SWIT,PTR,INSTR,DEXT +IFN SWIT,[ + MOVE T,DEXT + MOVE TT,[[INSTR],,PTR] +] .ELSE SETZB T,TT + PUSHJ P,CMDFGT +TERMIN + + CFMAC CREFSW,CRFFB,[SETOM CREFP][IFN ITSSW,[FSCREF] .ELSE FSCRF] + + CFMAC ERRSW, ERRFB,[SETOM ERRFP] FSERR + + CFMAC LISTSW,LSTFB,[SETOM LISTP][IFN ITSSW,[FSLIST] .ELSE FSLST] + +CMD50: CAIE A,"_ + JRST [ SETZB T,TT ; Point to scratch FB etc. + CALL CMDFGT ; Ignore any output specs not needed. + JRST CMD50] ; Must do this way to retain default stuffs. + + ; Finally read input file. + BLTMAC T,L$FBLK,(F),ISFB ; Copy last stuff to input spec + MOVEI F,ISFB ; and point at it. + PUSHJ P,CMDDVX ; Hack device-name default. +IFE ITSSW, MOVE T,FSMID +IFN ITSSW, MOVE T,FSGRTN ; > on ITS. + MOVEM T,$FEXT(F) + CALL RFD ; Read input spec. + RET ; Yep, that's really all! + + ; TT has ,, + ; T has default $FEXT. + ; Takes defaults from current F, sets F to new filblk. +CMDFGT: JUMPE TT,[SETZ T, ; If 0, do usual but into oblivion (scratch FB) + MOVE TT,[[JFCL],,FB] + JRST .+1] + BLTMAC B,L$FBLK,(F),(TT) ; Copy from current filblk to new. + MOVE F,TT ; set new F. + MOVEM T,$FEXT(F) ; Set default $FEXT + PUSHJ P,CMDDVX ; Set up device, defaulting to DSK. + CAIN A,"_ ; If last delimiter was start of input spec, + POPJ P, ; don't read anything - just use defaults. + PUSHJ P,RFD + TRNN FF,FRNNUL ; If spec non-null or + CAIN A,"_ ; ended by _, then + CAIA ; hack specified instr. + POPJ P, + HLRZ T,F + XCT (T) + POPJ P, + +CMDDVX: SKIPN T,$FDEV(F) + MOVE T,FSDSK + CAME T,FSPTP + CAMN T,FSNUL + MOVE T,FSDSK + MOVEM T,$FDEV(F) + POPJ P, + +SUBTTL ITS/DEC Filename Reader/printer (RFD, TYPFB) + +IFN DECSW\ITSSW,[ ; Begin moby conditional for sixbit reader. + +; RFD - Reads a single file description from .INSRT or command line, +; using RCH, into specified FILBLK. +; F points at FILBLK to store description in. +; Implements crufty ^R hack (if see ^R, act as if just starting to +; read filename, so effect is stuff before ^R has set defaults.) +; If FRCMND set, recognize -, comma, / and ( as special characters, +; and hack switches. +; Sets FRNNUL if spec was nonnull. +; Clobbers A,B,C only. + +RFD: TRZ FF,FRNNUL +RFD01: SETZM RFDCNT ; Zero cnt of "normal" filenames. Jump here if see ^R. + +RFD10: PUSHJ P,GPASST ; Flush out spaces/tabs + TRNN FF,FRCMND ; If parsing command line, + CAIE A,"; ; or if char isn't semi-colon, + JRST RFD22 ; just handle normally. +RFD15: PUSHJ P,RCH ; Semi-colon and not command line!! Flush rest + CAIE A,^M ; of line, assuming it's a comment! + JRST RFD15 + POPJ P, + +RFD2: PUSHJ P,RCH ; Get character in A +RFD20: CAIE A,40 ; Space (Come here to scan already-read char.) + CAIN A,^I ; or tab? + JRST RFD10 ; Ach, go into flush-whitespace loop. +RFD22: CAIN A,^M ; End of line? + POPJ P, ; If so, obviously done. + CAIN A,^R ; Crufty ^R hack? + JRST RFD01 ; Sigh, pretend just starting to read filename. + TRNN FF,FRCMND ; Reading command line? + JRST RFD40 ; Nope, skip over cmnd-line frobs. + + ; Reading cmd line, test special chars. +IFN ITSSW\SAILSW, CAIN A," ; SAIL underscore, ITS backarrow like _. + .ELSE CAIN A,"= ; Either gets munged, + MOVEI A,"_ ; into canonical "_". + CAIE A,"_ ; Backarrow is output_input marker. + CAIN A,", ; Comma is also a terminator... + POPJ P, +IFN DECSW\TNXSW,[ ; I'm not sure if this belongs here, but + CAIN A,"! .SEE RFDRUN + POPJ P, +] + PUSHJ P,CMDSW ; Check for switches... + JRST RFD20 ; Got some, scan next char (returned by CMDSW) + ; Got none, drop thru. + + + ; No special delimiters, + ; Check for chars which signal what following word is. +RFD40: +IFN DECSW,[ + CAIN A,"[ ;] Left bracket signals start of PPN. + JRST [ PUSHJ P,RFDPPN ; Slurp it up, + MOVEM C,$F6DIR(F) ; store it, + TRO FF,FRNNUL ; saying spec not null. + JRST RFD20] ; and go process leftover delimiter. + + CAIN A,". ; Period signals start of extension. + JRST [ PUSHJ P,RCH ; Get the next character + PUSHJ P,RFDW ; Read in a word. + MOVEM C,$F6EXT(F) ; Store it... + TRO FF,FRNNUL ; and say spec non-null (even if C/ 0) + JRST RFD20] ; and process delimiting char. +] + + ; Here, char doesn't signal the start of anything, so we'll assume + ; it's the start of a name. + PUSHJ P,RFDW ; Gobble up a word. + JUMPE C,RFD2 ; If nothing was read, must ignore char; get another. + + ; Aha, name was read, now examine delimiter to see if it specifies + ; anything we know about. + TRO FF,FRNNUL ; Set flag saying spec non-null. + CAIN A,": ; If colon... + JRST [ MOVEM C,$F6DEV(F) ; Then store name as device. + JRST RFD2] ; and flush delimiter. +IFN ITSSW,[ + CAIN A,"; ; If semicolon... + JRST [ MOVEM C,$F6DIR(F) ; Then store name as directory (sname) + JRST RFD2] ; and flush delimiter. +] + ; Whatever it is, at this point delimiter doesn't signify anything + ; special in terms of what the name is. So we just store it, using + ; the usual FN1 FN2 DEV DIR sequence, and hand delimiter off to + ; the prefix scanning stuff. + MOVE B,RFDCNT ; Get current count for random names. + XCT RFDTAB(B) ; Either MOVEM C, to right place, or ignore + AOS RFDCNT ; by skipping over this instr. + JRST RFD20 ; and go examine delimiter. + + +.SCALAR RFDCNT ; Count to index RFDTAB by. + +RFDTAB: MOVEM C,$F6FNM(F) ; 1st name. + MOVEM C,$F6EXT(F) ; 2nd name. + MOVEM C,$F6DEV(F) ; 3rd name is dev. + MOVEM C,$F6DIR(F) ; 4th is sname. + CAIA ; 5th and on ignored, don't incr. cnt. + +; RFDW - Reads a "word" - any string of contiguous SIXBIT chars, +; barring certain delimiters, and leaves SIXBIT result in C. +; Begins reading with char currently in A. Returns with delimiter +; char in A (it's possible this can be the same char!) +; Clobbers B. + +RFDW: SETZ C, ; First things first, zap result. + SKIPA B,[440600,,C] +RFDW2: PUSHJ P,RCH + CAIN A,^Q ; Is char the quoter char? + JRST [ PUSHJ P,RCH ; Yup, gobble next... + CAIN A,^M ; and accept anything but CR + POPJ P, ; since that terminates the whole line. + JRST RFDW7] ; OK, go stuff the char into C. + CAIE A,40 ; Space + CAIN A,^I ; or tab + POPJ P, ; is always a break. + CAIN A,^M ; As is CR. + POPJ P, + TRNN FF,FRCMND ; And certain chars are bummers when reading cmd. + JRST RFDW4 + CAIE A,"/ + CAIN A,"( + POPJ P, +IFN DECSW\TNXSW, CAIE A,"= + CAIN A,"_ + POPJ P, +IFN ITSSW\SAILSW, CAIE A," + CAIN A,", + POPJ P, +IFN DECSW\TNXSW,[ + CAIN A,"! + POPJ P, +] + ; Not reading cmd line, or no cmd-line type chars seen. +RFDW4: +IFN ITSSW,[ + CAIE A,": ; For ITS filenames, these chars are special. + CAIN A,"; + POPJ P, +] +IFN DECSW,[ + CAIL A,140 ; For DEC, allow only alphanumeric. + SUBI A,40 ; cvt to uppercase, then + CAIL A,"A ; see if alpha. + CAILE A,"Z + JRST [CAIL A,"0 ; Nope, see if numeric. + CAILE A,"9 + POPJ P, ; Not alphanumeric, assume delimiter. + JRST .+1] +] +RFDW7: TLNN B,770000 ; Enough room in C for another char? + JRST RFDW2 ; Nope, ignore it and get next. + CAIL A,140 ; Enuf room, cvt lower to uppercase + SUBI A,40 + SUBI A,40 ; and cvt to sixbit, + IDPB A,B ; and deposit. + JRST RFDW2 ; Get another. + +] ; END IFN DECSW\ITSSW + +IFN DECSW,[ ; PPN Reader + +RFDPPN: PUSHJ P,RFDOCT ; Read project num, +IFN CMUSW, JUMPE C,RCMUPP ; At CMU watch for our funny ppns + HRLM C,(P) + PUSHJ P,RFDOCT ; Read programmer num. + HLL C,(P) + POPJ P, + +IFE SAILSW,RFDOCL=="0 ? RFDOCH=="8 ; Read octal numbers. +IFN SAILSW,RFDOCL==40 ? RFDOCH==140 ; Read sixbit (right-justified). + +RFDOCT: SETZ C, ; Read octal num, return in C. +RFDOC1: PUSHJ P,RCH + CAIL A,140 + SUBI A,40 +IFN SAILSW,[ ;[ ; Even if reading sixbit names (for SAIL), + CAIE A,", ; Comma and closebracket are still special. + CAIN A,"] + POPJ P, +] + CAIL A,RFDOCL + CAIL A,RFDOCH + POPJ P, ; Not octal or not 6bit, return. + IMULI C,RFDOCH-RFDOCL + ADDI C,-RFDOCL(A) + JRST RFDOC1 + +IFN CMUSW,[ ; [ +RCMUPP: CAIN A,"] ; Watch out for [] + POPJ P, +REPEAT 4, SETZM PPNBUF+.RPCNT + MOVE C,[440700,,PPNBUF] +RCMUPL: CAIE A,^M ; Don't look too far + SKIPE PPNBUF+3 + JRST RCMUPD + IDPB A,C + PUSHJ P,RCH ; [ + CAIE A,"] + JRST RCMUPL +RCMUPD: MOVE A,[C,,PPNBUF] + CMUDEC A, + SETZ C, + POPJ P, + +.VECTOR PPNBUF(4) ; Storage to buffer up a string for CMUDEC uuo to scan. + +] ;IFN CMUSW +] ;IFN DECSW + +IFN DECSW\ITSSW,[ + +; TYPFB - Type out current filblk (what F points at) as file specification +; Clobbers A,B,C + +TYPFB: MOVSI C,-3-ITSSW + HRR C,F +TYPF1: MOVE B,$F6DEV(C) ; Get next name + PUSHJ P,SIXTYO ; Type out name + HLRZ A,C + MOVE A,FILSPC+3+ITSSW(A) ; Now get delimiting character + PUSHJ P,TYOERR ; Type out + AOBJN C,TYPF1 ; Loop for all names +IFN ITSSW, POPJ P, +IFN DECSW,[ + SKIPN B,$F6DEV(C) ; On DEC system PPN is a special case + POPJ P, + MOVEI A,"[ ;] + CALL TYOERR +IFN CMUSW,[ + MOVE A,[B,,PPNBUF] + DECCMU A, + JRST OCTPPN + TYPR PPNBUF + JRST PPNRB + ] +IFE SAILSW,[ +OCTPPN: HLRZ B,$F6DEV(C) ; LH is proj, + CALL OCTPNT + ] +.ELSE [ HLLZ B,$F6DEV(C) + CALL SIXTYO +] + MOVEI A,", + CALL TYOERR +IFE SAILSW,[ + HRRZ B,$F6DEV(C) + CALL OCTPNT ; RH is prog. +] +.ELSE [ HRLZ B,$F6DEV(C) + CALL SIXTYO + ] +PPNRB: ; [ + MOVEI A,"] + JRST TYOERR +];IFN DECSW + +FILSPC: ": +IFN ITSSW, 40 ? 40 ? "; +IFN DECSW, ". ? 0 + +] ; END IFN DECSW\ITSSW + +SUBTTL Command switches + +; CMDSW - Hacks either a single switch or switch list; A should +; contain "/ for the former, "( for the latter. +; Returns in A next char after switch hackery done. This may be ^M. +; Skip returns if neither "/ nor "( was furnished to it. + +CMDSW: CAIN A,"/ ; Single switch? + JRST [ PUSHJ P,RCH ; Get next char + CAIN A,^M + POPJ P, + PUSHJ P,CMDSW1 + PJRST RCH] + CAIE A,"( ; Switch list? + JRST POPJ1 ; Neither slash nor paren, make skip return. +CMDSWL: PUSHJ P,RCH + CAIN A,^M + POPJ P, + CAIN A,") + PJRST RCH + PUSHJ P,CMDSW1 + JRST CMDSWL + + ; Command switch processing. CMDSW1 processes the switch char + ; in A. +CMDSW1: CAIL A,140 ; Lower case to upper. + SUBI A,40 + CAIN A,"T + SOS TTYINS ; Count # T-switches. + + CAIN A,"W ; W - prevent tty messages, and +IFE ERRSW,AOS WSWCNT ; request error output file if possible. +.ELSE [ + AOSA WSWCNT + CAIN A,"E ; E - request error log file. + SETOM ERRFP + ] + +IFN CREFSW,[ + CAIN A,"C ; C - request CREF output. + SETOM CREFP + ] + +IFN LISTSW,[ + CAIE A,"L ; L - request listing + POPJ P, + SETOM LISTP ; Say want listing. + AOS LISTP1 ; (starts as -1, will be positive after 2nd (L)) + ] + + POPJ P, + +SUBTTL TENEX Filename Reader/printer (RFD, TYPFB) + +IFN TNXSW,[ ; Moby conditional for Tenex reader. + +; TNXRFD - TENEX-style Filename Reader. +; Takes input from RCH, +; Deposits name strings into filblk F points to. +; Clobbers A,B,C,D, (and AA,T,TT due to FNCHK) +; Uses FRFEXT flag to see if already read extension (type) or not. +; Refuses to accept existing defaults for version, ;T, account, +; protection, or JFN. It will also zap an existing directory +; default if a device is specified, and vice versa. This is so that +; logical names will win a little better. +; Implements crufty ^R hack (if see ^R, act as if just starting to +; read filename, so effect is stuff before ^R has set defaults.) + +IFNDEF FRFDEV,FRFDEV==2 ; Set if read device. +IFNDEF FRFDIR,FRFDIR==1 ; Set if read directory. +IFNDEF FRFEXT,FRFEXT==FRFN1 ; Borrow this bit. Set if read extension. + +RFD: TRZ FF,FRNNUL + SETZM $FJFN(F) ; Zap JFN since the filename we'll read won't match it. + SETZM $FACCT(F) ; Also zap other things that we don't want defaulted. + SETZM $FPROT(F) + SETZM $FTEMP(F) + SETZM $FVERS(F) +TRFD01: TRZ FF,FRFEXT+FRFDEV+FRFDIR ; Jump here if ^R seen. +TRFD10: PUSHJ P,GPASST ; remove tabs, spaces and get first non-tab/space + TRNN FF,FRCMND ; If parsing command line, + CAIE A,"; ; or if char isn't semicolon, + JRST TRFD21 ; just handle normally. +TRFD15: PUSHJ P,RCH ; Semi-colon and not command line, it's a comment! + CAIE A,^M ; So flush rest, up to EOL. + JRST TRFD15 + POPJ P, + +TRFD1: TLO FF,FLUNRD ; come here to re-read last char +TRFD2: PUSHJ P,RCH ; Get char +TRFD21: CAIE A,40 ; Space? (come here to scan already-read char) + CAIN A,^I ; or tab? + JRST [TRNE FF,FRCMND ; Space/tab, if reading command line + JRST TRFD2 ; then ignore and continue scanning (for switches), but + JRST TRFD15] ; if not in cmd line, go flush entire rest of line! + CAIN A,^M ; End of line? + POPJ P, ; If so, obviously done. + CAIN A,^R ; Crufty ^R hack? + JRST TRFD01 ; Sigh, pretend starting over. + TRNN FF,FRCMND ; Must we check for cmd line frobs? + JRST TRFD22 ; Nope, skip them. + + ; Must check for chars special only in command line. + CAIN A,"= + MOVEI A,"_ + CAIE A,"_ ; backarrow is filename terminator... + CAIN A,", ; as is comma. + POPJ P, + CAIN A,"! ; For CCL hacking... + POPJ P, .SEE RFDRUN + PUSHJ P,CMDSW ; Check for switches... + JRST TRFD21 ; got some, process next char (returned by CMDSW) + ; Skips if none, drop thru. + + ; Now see if char signifies start of anything in particular. +TRFD22: CAIE A,"< ; Start of directory name? + JRST TRFD24 ; No + PUSHJ P,RCH + PUSHJ P,TRFDW ; Read word, starting with next char +TRFD23: CAIN A,". ; Allow . as part of directory name + JRST [ PUSHJ P,TRFDW5 ; Read a continuation to this word + JRST TRFD23] ; And try again + MOVEI D,$FDIR ; Set up index. + CAIN A,"> ; Terminator should be end of dir name... + PUSHJ P,RCH ; If so, get next to avoid scan of ">". + ; else bleah, but aren't supposed to fail... + TRNN FF,FRFDEV ; Unless a device has been explicitly given, + SETZM $FDEV(F) ; zap any furnished default. 0 means DSK. + TRO FF,FRFDIR ; Now say dir was explicitly given. + JRST TRFD6 ; Go store it. +TRFD24: CAIN A,". ; Start of $FTYPE or $FVERS (20x)? + JRST [ MOVEI D,$FTYPE ; Assume reading $FTYPE field, + TLNE FF,FL20X ; always if 10X, but if really on 20X, then + TRON FF,FRFEXT ; use $FTYPE only if not already seen. + JRST TRFD4 ; $FTYPE - jump to get word & store. + PUSHJ P,TRFDNM ; $FVERS - 20X and $FTYPE already seen. Get #. + MOVEM B,$FVERS(F) ; Store it away if successful. + JRST TRFD1] ; and go re-read delimiting char. + + CAIN A,"; ; Start of $FVERS (10x) or attribute? + JRST [ PUSHJ P,RCH ; Find what next char is. + CAIL A,"a ; Must uppercasify. + CAILE A,"z + CAIA + SUBI A,40 + CAIN A,"T ; Temporary file? + JRST [ SETOM $FTEMP(C) + JRST TRFD2] + CAIN A,"A ; Account? + JRST [ MOVEI D,$FACCT ; Set index, and + JRST TRFD4] ; go gobble following word. + CAIN A,"P ; Protection? + JRST [ MOVEI D,$FPROT ; Set index, and + JRST TRFD4] ; go gobble following word. + TLO FF,FLUNRD ; Not alpha, try numeric. Re-read char, + PUSHJ P,TRFDNM ; trying to parse as number. + MOVEM B,$FVERS(F) ; Win, parsed as number! Store it. + JRST TRFD1] ; If none of above, ignore ";" entirely. + + PUSHJ P,TRFDW ; Let's try reading it as word, + JUMPLE C,APOPJ ; If nothing read, assume it's some terminating delimiter. + CAIN A,": ; Else have something, check trailing delim for special cases + JRST [ MOVEI D,$FDEV ; Aha, a device. + PUSHJ P,RCH ; Flush the terminator & get next char. + TRNN FF,FRFDIR ; Unless dir was explicitly given, + SETZM $FDIR(F) ; zap furnished default. 0 uses connected dir. + TRO FF,FRFDEV ; Say device was explicitly given, and + JRST TRFD6] ; store name away. + MOVEI D,$FNAME ; Else assume it's the filename. + JRST TRFD6 + + +TRFD4: PUSHJ P,RCH ; Here when must gobble next char, +TRFD5: PUSHJ P,TRFDW ; here when first char of wd already read. +TRFD6: PUSHJ P,FNCHKZ ; Note this can return and store a null string! + ADDI D,(F) ; Get address (filblk+index), and + MOVEM A,(D) ; store string pointer in the appropriate place. + TRO FF,FRNNUL ; Say non-null spec seen, + JRST TRFD1 ; and go re-read the delimiter, to process it. + +; TRFDW - Read a word (string), for use by TNXRFD. Copies sequence of +; acceptable filename chars into FNBUF, until non-valid char seen. +; A/ First char of word, +; Returns A/ delimiting char, C/ count of chars in string, +; clobbers nothing else. + +TRFDW4: SUBI A,40 ; Make lowercase +TRFDW5: IDPB A,FNBWP ; Deposit into FNBUF, + PUSHJ P,RCH ; get next char, + AOSA C ; and bump count, skipping over zap instruction. +TRFDW: SETZ C, ; When called, zero cnt of chars in string. + CAIL A,"A ; See if char is uppercase alpha, + CAILE A,"Z + CAIA + JRST TRFDW5 + CAIL A,"a ; or lowercase alpha, + CAILE A,"z + CAIA + JRST TRFDW4 + CAIL A,"0 ; or numeric, + CAILE A,"9 + CAIA + JRST TRFDW5 + CAIE A,"$ ; or dollarsign + CAIN A,"- ; or hyphen + JRST TRFDW5 + CAIN A,"_ ; Backarrow is special case, because + JRST [ TRNN FF,FRCMND ; if reading command, + TLNN FF,FL20X ; or running on 10X, + POPJ P, ; must treat as delimiter. + JRST TRFDW5] + CAIN A,^V ; ^V is quote char... + JRST [ PUSHJ P,RCH ; Quote, get next. + CAIE A,^M ; Quote anything but this. + CAIN A,0 ; or this. + POPJ P, ; time to exit. + PUSH P,A ; Quote it! Save char, + MOVEI A,^V ; so that a quoter can precede it. + IDPB A,FNBWP ; Fortunately this hair + POP P,A ; only needs care + IDPB A,FNBWP ; for quoted chars, which are + JRST TRFDW5] ; rare. + TLNE FF,FL20X ; Are we on a 10X? + POPJ P, ; If not, anything at this point is delimiter. + CAIL A,41 ; Check general bounds + CAIL A,137 ; Range from space to _ exclusive. + POPJ P, ; If outside that, delimiter. + CAIL A,72 ; This range includes :, ;, <, =, > + CAILE A,76 + CAIA + POPJ P, ; delimiter. + CAIE A,". + CAIN A,", + POPJ P, + CAIE A,"* + CAIN A,"@ + POPJ P, + ; Finally, check out chars which are acceptable to 10X but which + ; might be delimiter in cmd line... + TRNN FF,FRCMND + JRST TRFDW5 ; Not hacking cmd line, it's an OK char. + CAIE A,"/ + CAIN A,"( + POPJ P, + CAIN A,"! + POPJ P, + JRST TRFDW5 ; at long last done. + + +; TRFDNM - Read numerical string, halt when non-digit +; seen, leaves result (decimal) in B, with delimiting char in A. +; One peculiarity is skip return if no numerical char is seen at all; +; else doesn't skip and B has a valid number. + +TRFDNM: PUSHJ P,RCH ; First char needs special check. + CAIL A,"0 + CAILE A,"9 + JRST POPJ1 ; Not a number at all? + TDZA B,B +TRFDN2: IMULI B,10. + ADDI B,-"0(A) ; Convert to number + PUSHJ P,RCH ; Get following chars. + CAIL A,"0 + CAILE A,"9 + POPJ P, ; Nope, not digit so treat as delimiter. + JRST TRFDN2 ; Yep, a number + +] ;IFN TNXSW + +IFN TNXSW,[ + +; TYPFB - Type out FB pointed to by F + +TYPFB: SKIPE B,$FDEV(F) ; First, device name? + JRST [ PUSHJ P,TYPZ + MOVEI A,": + PUSHJ P,TYOERR + JRST .+1] + SKIPE B,$FDIR(F) ; Directory? + JRST [ MOVEI A,"< + PUSHJ P,TYOERR + PUSHJ P,TYPZ + MOVEI A,"> + PUSHJ P,TYOERR + JRST .+1] + SKIPE B,$FNAME(F) + PUSHJ P,TYPZ + MOVEI A,". + PUSHJ P,TYOERR + SKIPE B,$FEXT(F) + PUSHJ P,TYPZ + MOVEI A,". ; 20X uses "." to set off version, + TLNN FF,FL20X ; but 10X uses ";". + MOVEI A,"; + PUSHJ P,TYOERR + HRRE A,$FVERS(F) + JUMPL A,[MOVM B,A ; Is possible to have -1, -2, etc. + MOVEI A,"- + PUSHJ P,TYOERR + MOVE A,B + JRST .+1] + PUSHJ P,DPNT ; Version # output in decimal. + SKIPE $FTEMP(F) + TYPE ";T" ; May be temporary. + SKIPE B,$FPROT(F) + JRST [ TYPE ";P" + PUSHJ P,TYPZ + JRST .+1] + SKIPE B,$FACCT(F) + JRST [ TYPE ";A" + PUSHJ P,TYPZ + JRST .+1] + POPJ P, + + ; Takes BP in B, outputs to TYOERR until zero byte seen. +TYPZ: CAIA + PUSHJ P,TYOERR + ILDB A,B + JUMPN A,TYPZ+1 + POPJ P, +] ; IFN TNXSW + +SUBTTL TENEX misc. Filename Routines, FS string storage + +IFN TNXSW,[ .SEE FSDSK ; Part of this page is NOT conditionalized!! + +; To handle filenames of ASCIZ strings instead of SIXBIT words, each +; word has instead a byte pointer to an ASCIZ string. For purposes of +; easy comparison, all of these bp's point into FNBUF, and a routine +; (FNCHK) is provided which checks a just-stored string and returns a bp +; to either this string, if unique, or to a previously stored string if +; it is the same as the one just stored (which is then flushed). Thus +; strings can be compared for equality simply by a comparison of their +; byte pointers. While not necessary, strings are stored beginning on +; word boundaries for easier hacking. + + ; <# files>**+<# wds for constants> +LFNBUF==*5*3+20 ; Enough to hold strings for all output files, + ; all translated files, and all .insrt files encountered. + ; Later a GC'er can be hacked up so that of the latter only + ; enough for the max .insrt level need be allocated. + +LVAR FNBUF: BLOCK LFNBUF + + ; Macro to easily define constant strings for comparison purposes +DEFINE DEFSTR *STR* +440700,,%%FNLC +%%LSAV==. +LOC %%FNLC +ASCIZ STR +%%FNLC==. +LOC %%LSAV +TERMIN + %%FNLC==FNBUF +] ; IFN TNXSW!!! + + ; If not assembling for TENEX, the following strings become + ; simple SIXBIT values. This makes it possible to write simple + ; code to work for both TENEX and non-TENEX without messy conditionals. + +IFE TNXSW,[EQUALS DEFSTR,SIXBIT] + +FSDSK: DEFSTR /DSK/ ; This stuff defines various BP's into FNBUF to +FSSYS: DEFSTR /SYS/ ; use for comparison purposes later. +FSTTY: DEFSTR /TTY/ +FSNUL: DEFSTR /NUL/ +FSPTP: DEFSTR /PTP/ +FSATSN: DEFSTR /@/ +FSSBSY: DEFSTR /SUBSYS/ +FSPROG: DEFSTR /PROG/ +FSMID: DEFSTR /MID/ +FSMDAS: DEFSTR /MIDAS/ +FSGRTN: DEFSTR />/ +FSCRF: DEFSTR /CRF/ +FSCREF: DEFSTR /CREF/ +FSERR: DEFSTR /ERR/ +FSLST: DEFSTR /LST/ +FSLIST: DEFSTR /LIST/ +FSSAV: DEFSTR /SAV/ +FSEXE: DEFSTR /EXE/ + +IFN TNXSW,[ +VBLK +FNBBP: 440700,,FNBUF ; Points to beg of FNBUF (hook for dynamic alloc) +FNBEP: FNBUF+LFNBUF-1 ; Points to last wd in FNBUF (address, not BP) +FNBWP: 440700,,%%FNLC ; Write Pointer into FNBUF. +FNBLWP: 440700,,%%FNLC ; Last Write Pointer, points to beg of string being stored +PBLK +EXPUNG %%FNLC + +; NOTE - provided MIDAS never restarts, no initialization is necessary to +; start using FNCHK. (Unless of course FNBUF is dynamically allocated someday) + +; FNCHK - Check out just-stored filename. Returns BP in A to ASCIZ string, +; which will be "canonical" for comparison purposes. +; Clobbers A,B,T,TT,AA +; FNCHKZ - Makes sure just-writ string is ASCIZ'd out before FNCHK'ing. + +FNCHKZ: MOVE B,FNBWP ; Get write ptr, + LDB A,B ; see if last char was 0, + JUMPE A,FNCHK0 ; if so can skip one clobberage. + SETZ A, + IDPB A,B ; zero out bytes, +FNCHK0: TLNE B,760000 ; until at end of word. + JRST .-2 + ADD B,[<440700,,1>-<010700,,>] ; bump BP to point canonically at next. + MOVEM B,FNBWP + +FNCHK: HRRZ B,FNBWP ; See if write ptr + CAML B,FNBEP ; has hit end of FNBUF, and + ETF [ASCIZ /Filename buffer overflow/] ; barf horribly if so. + MOVE A,FNBBP ; A - bp to start of existing string + MOVE AA,FNBLWP ; AA - bp to start of new string to store +FNCHK2: MOVEI T,(A) ; T - current addr being checked, existing str + MOVEI TT,(AA) ; TT - current addr, new str + CAIL T,(TT) ; If addrs are same, or overran somehow, + JRST [ MOVE A,AA ; didn't find any match, accept new string. + MOVE B,FNBWP + MOVEM B,FNBLWP ; Set up new last-write-ptr + POPJ P,] +FNCHK3: MOVE B,(T) + CAMN B,(TT) ; Compare strings, full word swoops. + JRST [ TRNE B,377 ; equal, last char zero? + AOJA T,[AOJA TT,FNCHK3] ; no, continue for whole string + ; Found it! Flush just-stored string, don't want duplicate. + MOVEM AA,FNBWP ; Clobber write ptr to previous value. + POPJ P,] + ; Not equal, move to next string to compare + MOVEI B,377 ; Check for ASCIZ, + TDNE B,(T) ; moving to end of current string + AOJA T,.-1 + HRRI A,1(T) ; and updating BP to point at new string. + JRST FNCHK2 ; (T gets pointed there too at FNCHK2). + +; JFNSTR - Get filename strings for active JFN. +; A/ active JFN +; F/ addr of filename block to clobber. +; JFNSTB - Same, but ignores A and assumes JFN is already stored in block. +; Clobbers A,C + +JFNSTB: SKIPA A,$FJFN(F) ; JFNSTB gets the JFN from block itself. +JFNSTR: MOVEM A,$FJFN(F) ; whereas JFNSTR stores it there... + MOVSI D,-NJSTRF ; Set up aobjn thru table. +JFNST2: PUSH P,T + SYSCAL JFNS,[FNBWP ? $FJFN(F) ? JSTRFX+1(D)][FNBWP] + POP P,T + MOVE C,JSTRFX(D) ; Now get index to place it belongs in file block, + CAIN C,$FVERS ; and check for this, because + JRST [ MOVE A,FNBLWP ; it wants to be a number, not a string. + MOVEM A,FNBWP ; Zap write pointer back to forget string, + PUSHJ P,CVSDEC ; and quickly convert before anything clobbers it. + JRST .+2] ; Skip over the FNCHKZ call. + PUSHJ P,FNCHKZ ; Fix it up, and get BP to it. + ADDI C,(F) ; make it an addr, and + MOVEM A,(C) ; store BP. (or value, for $FVERS) + ADDI D,1 + AOBJN D,JFNST2 + POPJ P, + + ; Filblk idx, output format wd for JFNS call +JSTRFX: $FDEV ? 100000,, + $FDIR ? 010000,, + $FNAME ? 001000,, + $FTYPE ? 000100,, + $FVERS ? 000010,, +NJSTRF==<.-JSTRFX>/2 + +; CVSDEC - Converts ASCIZ string to decimal, assumes only digits seen. +; A/ BP to ASCIZ +; Returns value in A, clobbers nothing else. + +CVSDEC: PUSH P,B + PUSH P,C + MOVE C,A + SETZ A, + JRST CVSDC3 +CVSDC2: IMULI A,10. + ADDI A,-"0(B) +CVSDC3: ILDB B,C + JUMPN B,CVSDC2 + POP P,C + POP P,B + POPJ P, + +; CVSSIX - Converts ASCIZ string to SIXBIT word. +; A/ BP to ASCIZ string, +; Returns SIXBIT word in A. Clobbers nothing else. + +CVSSIX: PUSH P,B + PUSH P,C + PUSH P,D + MOVE D,A + SETZ A, + MOVE B,[440600,,A] + JRST CVSSX3 +CVSSX2: CAIL C,140 + SUBI C,40 ; Uppercase force + SUBI C,40 ; cvt to 6bit + IDPB C,B ; deposit + TLNN B,770000 ; If BP at end of word, + JRST CVSSX5 ; leave loop. +CVSSX3: ILDB C,D + JUMPN C,CVSSX2 +CVSSX5: POP P,D + POP P,C + POP P,B + POPJ P, + +; CV6STR - Takes 6bit word in A, writes into FNBUF and makes a string of +; it, returning BP in A. +; Clobbers A,B,T,TT,AA (due to FHCHKZ) + +CV6STR: MOVE B,A +CV6ST2: SETZ A, + LSHC A,6 ; Get a 6bit char + ADDI A,40 ; Make ASCII + IDPB A,FNBWP ; deposit + JUMPN B,CV6ST2 ; Continue until nothing left + PJRST FNCHKZ ; Make output thus far a string. + + +; CVFSIX - Takes current filblk (pointed to by F) and puts the +; right stuff in $F6 entries. + +CVFSIX: PUSH P,A + PUSH P,B + MOVSI B,-L$F6BL +CVFSX2: MOVE A,@CVFTAB(B) ; Get BP to string + PUSHJ P,CVSSIX ; Convert to 6bit + ADDI B,$F6DEV(F) ; Get index to right place to store. + MOVEM A,(B) + SUBI B,$F6DEV(F) ; restore aobjn pointer... + AOBJN B,CVFSX2 + POP P,B + POP P,A + POPJ P, + +CVFTAB: $FDEV(F) + $FNAME(F) + $FEXT(F) + $FDIR(F) +IFN <.-CVFTAB>-L$F6BL, .ERR CVFTAB loses. + +] ; IFN TNXSW + +SUBTTL DEC/TENEX - RUN hacking. (Process FOO! in CCL) +IFN DECSW,[ + +; Process "FOO!", which means "run SYS:FOO with an offset of 1". +; Note that the RUN call needs a block of 6 ACs, but at this point +; it doesn't matter what gets clobbered. + + + ; Entry point for restart, from TSRETN. +RERUN: MOVE B,FSMDAS ; Get name - using SYS:MIDAS + SETZB C,D+1 ; (no ext or ppn) + JRST RFDRU1 + +VBLK + +RFDRUN: MOVE A,$F6DEV(F) ; Load up the 4 filenames to use. + MOVE B,$F6FNM(F) + MOVE C,$F6EXT(F) + MOVE D+1,$F6DIR(F) + JUMPN A,RFDRU3 ; If device specified, use that, + MOVSI A,'DSK ; else default to DSK + CAIN D+1, ; if a PPN was given, and +RFDRU1: MOVSI A,'SYS ; to SYS: otherwise. +RFDRU3: SETZB D,D+2 ; These acs must always be zero... + MOVEI D+3,177 ; Flush all core above this address. +IFN SAILSW,[ + SETZ D+4, + CORE2 D+4, ; Flush hiseg by hand on SAIL. + HALT + ] +.ELSE HRLI D+3,1 ; Elsewhere, just set LH to this to flush hiseg. + + MOVE D+4,[RUNCOD,,D+5] ; Move core-less code into position in ACs. + BLT D+4,+LRUNCD-1 + MOVE D+4,[1,,A] ; ,,
+ JRST D+5 ; Go flush core and run program. + +RUNCOD: CORE D+3, ; Flush as much core as possible; RUN uuo can lose + HALT ; Because of how much we have. + RUN D+4, + HALT +LRUNCD==.-RUNCOD + ; Make sure symbols A-D leave enuf room. +IFL 17-, .ERR RFDRUN ACs lose. +PBLK +] ;END IFN DECSW + +IFN TNXSW,[ + ; On TENEX, we'll do things without compat package (boo hiss) + + ; Entry point for starting new MIDAS, come here from TSRETN. +RERUN: MOVEI F,FB + BLTZ L$FBLK,FB ; Clear out scratch filblk, point at it. + MOVE A,FSMDAS ; Get BP to "MIDAS", store in + MOVEM A,$FNAME(F) ; filblk, and drop thru for defaults. + + ; Here to start up specified program, for CCL hacking. +RFDRUN: TLNN FF,FL20X ; 20X or Tenex? + JRST [ MOVE A,FSSBSY ; Tenex, get BP to SUBSYS string + SKIPN $FDIR(F) ; Unless directory specified, + MOVEM A,$FDIR(F) ; default dir to . + MOVE A,FSSAV ; And do similar thing for ext (.SAV) + JRST RFDRN2] + MOVE A,FSSYS ; 20X, get BP to SYS string + SKIPN $FDEV(F) ; Unless device specified, + MOVEM A,$FDEV(F) ; default dev to SYS:. + MOVE A,FSEXE ; And ditto for ext (.EXE) + +RFDRN2: SKIPN $FEXT(F) ; If extension not specified, + MOVEM A,$FEXT(F) ; Store appropriate one. + PUSHJ P,GETJFI ; Get JFN for input... + HALT ; Ugh, bletch, etc. + + ; OK, all ready to smash ACs with loader, etc. + MOVE R1,$FJFN(F) ; Put JFN into RH + HRLI R1,.FHSLF ; and fork handle (self) in LH. + MOVE R2,[RUNCOD,,R3] ; Load into ACs beginning at AC 3 + BLT R2,R3+LRUNCD-1 + JRST R3 ; Off we go, never to return... + + ; Following code is executed in AC's, position independent. +RUNCOD: GET ; Load up the file. + MOVEI R1,.FHSLF + GEVEC ; Find entry vector word for it, returned in AC 2. + JRST R1(R2) ; and go execute instruction in reenter slot. +LRUNCD==.-RUNCOD ; Pretty small loader, huh? +] ; IFN TNXSW + +SUBTTL Core Allocation routine - GCCORQ gets another K for MACTAB + +; Get another K of MACTAB space. + +GCCORQ: MOVE A,MACHI + LSH A,-2 ; Convert to word # + CAIL A,MXMACL ; Want more than allowed? + POPJ P, + MOVE A,MACTND ; No, get addr of block we want to get. + PUSH P,A ; Entry, save A in case have to try again +CORRQ1: +IFN ITSSW,[ + LSH A,-10. + SYSCAL CORBLK,[MOVEI %CBNDR+%CBNDW + MOVEI %JSELF ? A ? MOVEI %JSNEW] + JRST CORRQL ; Lose +] +IFN DECSW,[ + IORI A,1777 + CORE A, + JRST CORRQL ; Lose +] +IFN TNXSW,[ + SKIPN MEMDBG ; Only need to hack if want. + JRST CORRQ3 + ; Super kludge. No way to ask 10X for a "new page"; must + ; get it via default create-on-reference. Hence to get page + ; without bombing, must be sure .ICNXP interrupt deactivated! + PUSH P,T + SYSCAL DIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Deactivate. + SETZM (A) ; Reference 1st page + SETZM 1000(A) ; Reference 2nd page. + SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Re-activate. + POP P,T +CORRQ3: +] + + REST A + ADDI A,2000 + JRST MACIN2 ; Update pointers to end of MACTAB. + +IFN ITSSW\DECSW,[ + ; Lossage handler for GCCORQ. Only ITS or DEC can fail. +CORRQL: PUSH P,C + PUSH P,D + TLOE AA,400000 + JRST CORQL1 + TYPE " +No core for macro table." +CORQL1: TYPE " +Try again? " +CORQL2: PUSHJ P,TYI ; Get char + CAIL A,140 ; Cheap uppercase force + SUBI A,40 + CAIN A,"Y ; Y, + JRST CORRQA ; => try again + CAIN A,"N ; N, + JRST CORRQB ; => back to DDT then try again + CAIN A,"? ; ?, + ERJ CORQL1 ; => type out error-type blurb + TYPE "? " ; something else + JRST CORQL2 + +CORRQB: +IFN ITSSW,.VALUE ; Loop point for don't-proceed +IFN DECSW,EXIT 1, + TLZ AA,400000 +CORRQA: POP P,D + POP P,C + MOVE A,(P) ; Restore A from PDL + JRST CORRQ1 +] ; IFN ITSSW\DECSW + +SUBTTL Core allocation - TENEX routine to get pages (TCORGT) + +IFN TNXSW,[ + +; TCORGT - Takes arg in AA, an ITS page AOBJN to pages to grab. +; Clobbers no ACs but AA. + +TCORGT: JUMPGE AA,APOPJ ; Ignore arg if nothing to do about it. + SKIPN MEMDBG ; Ignore anyway if not hacking memory + POPJ P, + PUSH P,R1 + PUSH P,R2 + PUSH P,R3 + MOVE R3,AA + ASH R3,1 ; Get Tenex page AOBJN + MOVEI R1,(R3) + LSH R1,9. ; Get word address of first page. + HRR R3,R1 ; Stick back in AOBJN. + + ; Super kludge. No way to ask 10X for a "new page"; must + ; get it via default create-on-reference. Hence to get page + ; without bombing, must be sure .ICNXP interrupt deactivated! + MOVEI R1,.FHSLF + MOVE R2,[1_<35.-.ICNXP>] + DIC ; Deactivate. +TCORG3: SETZM (R3) ; Get the page. + ADDI R3,777 ; Bump word address, + AOBJN R3,TCORG3 ; and get next page (note adds 1 more to RH) + AIC ; Now re-activate... + POP P,R3 + POP P,R2 + POP P,R1 + POPJ P, +] ;IFN TNXSW diff --git a/src/midas/tsrtns.194 b/src/midas/tsrtns.194 new file mode 100755 index 00000000..0ae99466 --- /dev/null +++ b/src/midas/tsrtns.194 @@ -0,0 +1,4252 @@ +;-*-MIDAS-*- + +SUBTTL TS Definitions, parameters + + ; For convenience in defining isolated variables/tables, + ; especially when have to know on pass1 where the + ; table is going to be (.VECTOR etc don't know until end of pass) +DEFINE LVAR -LINE +VBLK +LINE +PBLK +TERMIN + +DEFINE TMPLOC AT,STUFF +%%%TLC==. ? LOC AT + STUFF +LOC %%%TLC +TERMIN + + ; Nice macro for minimizing coding. Doesn't hack indirection tho. + ; Could conceivably optimize to do MOVE AC,[FROM,,TO] but that + ; would be overly hairy for something you can do just by writing + ; 2 instructions. +DEFINE BLTMAC AC,LEN,FROM,TO + MOVSI AC,FROM + HRRI AC,TO + BLT AC,TO+LEN-1 +TERMIN + + ; Also handy for standard zaps (and nice mnemonic) + ; won't work for indirection either. +DEFINE BLTZAC AC,LEN,FROM + SETZM FROM +IFG LEN-1,[ + MOVEI AC,FROM+1 + HRLI AC,-1(AC) + BLT AC,FROM+LEN-1 +] +TERMIN + + ; More convenient when A is clobberable... +DEFINE BLTM LEN,FROM,TO +BLTMAC A,LEN,FROM,TO +TERMIN + +DEFINE BLTZ LEN,FROM +BLTZAC A,LEN,FROM +TERMIN + + ; Following inserts a SYSCAL for JSYS's. Be warned that it + ; clobbers T when used!! +IFN TNXSW,.INSRT XJSYS + +IFNDEF PMAPSW,PMAPSW==TNXSW ; 1 to assemble PMAP input, 0 for SIN input. +IFNDEF ERRSW,ERRSW==1 ; 1 for error file output capability. + +IFNDEF TYPDLC,TYPDLC==7 ; Maximum total depth of .insrt (including tty) +IFNDEF MX.INS,MX.INS==5 ; Maximum depth .insrt files only +IFNDEF MAXIND,MAXIND==6 ; Maximum # @: table entries for .insrt + + ; Define sizes of various I/O buffers +IFN DECSW,[ +IFNDEF DECBFL,DECBFL==203 ; Standard DEC buffer size for DSK (200 wds data) +IFN SAILSW,IFNDEF NINBFS,NINBFS==19. ; For SAIL, hack full disk track of input. +IFNDEF NINBFS,NINBFS==2 ; # standard-size buffers to use for input. +IFNDEF UTIBFL,UTIBFL==*NINBFS ; Input buffs need 1 wd for EOB hacking +IFNDEF UTOBFL,UTOBFL==DECBFL ; All output chans have just 1 buffer. +IFNDEF CRFBSZ,CRFBSZ==DECBFL +IFNDEF LSTBSZ,LSTBSZ==DECBFL +IFNDEF ERRBSZ,ERRBSZ==DECBFL +] ;DECSW +IFNDEF CMBFL,CMBFL==50 ; Length of command buffer. +IFNDEF UTIBFL,UTIBFL==400 ; " Input buffer. +IFNDEF UTOBFL,UTOBFL==200 ; " BIN output buffer. +IFNDEF CRFBSZ,CRFBSZ==200 ; " CREF output buffer. +IFNDEF LSTBSZ,LSTBSZ==200 ; " LIST output buffer. +IFNDEF ERRBSZ,ERRBSZ==1 ; " ERR output buffer. Very small to avoid + ; losing much data if things crash. + + +ERRC==0 ; Err device input channel +TYIC==1 ; TTY input channel +TYOC==2 ; TTY output channel +CREFC==3 ; CREF output +UTYOC==4 ; BIN output +LPTC==5 ; LIST output (LPT) +ERRFC==6 ; ERR Assembly error output file. +UTYIC==7 ; 1st input channel, UTYIC+n used for nth .INSRT level in dec version. + +SUBTTL File Description Storage (FILBLK's) + +VBLK + ; Definitions for indices into a FILBLK. + + ; Scratch block FB is formed while defining indices... +FB: OFFSET -. + ; Lots of crocks depend on the exact order of these 4 items. +$F6DEV:: 0 ; SIXBIT Device name +$F6FNM:: $F6FN1:: 0 ; SIXBIT Filename (on ITS, FN1) +$F6TYP:: $F6FN2:: $F6EXT:: 0 ; SIXBIT Extension (on ITS, FN2) +$F6DIR:: 0 ; SIXBIT Directory (may be numerical PPN) + L$F6BLK==. +$FVERS:: $FGEN:: 0 ; File version (or generation). NUMBER, not string. +IFN TNXSW,[ ; Almost all entries here are BP's to ASCIZ strings. +$FDEV:: 0 ; Device name +$FDIR:: 0 ; Directory name +$FNAME:: 0 ; File name (i.e. main name) +$FTYPE:: $FEXT:: 0 ; File type (or extension) +$FTEMP:: 0 ; -1 => File is a temporary file. +$FACCT:: 0 ; Account string +$FPROT:: 0 ; Protection string +$FJFN:: 0 ; JFN for file (may be ,,) +] +IFN ITSSW\DECSW,[ +$FDEV==:$F6DEV ; These definitions made so some common code can do +$FDIR==:$F6DIR ; the right things. +$FNAME==:$F6FNM +$FTYPE==:$F6TYP +$FEXT==:$F6TYP +] + L$FBLK==. ; Length of a FILBLK. + OFFSET 0 ; End of index definitions. + + + ; FILBLK's for various files + +ISFB: BLOCK L$FBLK ; Input file specification as given in command line. +INFB: BLOCK L$FBLK ; Actual current input file. +OUTFB: BLOCK L$FBLK ; Output file + +IFN CREFSW, CRFFB: BLOCK L$FBLK ; CREF output file +IFN LISTSW, LSTFB: BLOCK L$FBLK ; Listing output file +IFN ERRSW, ERRFB: BLOCK L$FBLK ; Error output file + +INFCNT: 0 ; AOS'd each time an input file is opened. +INFCUR: 0 ; What INFCNT was when current file opened. +INFERR: 0 ; What INFCUR held at last err msg. + +INDDP: MAXIND,,TBLOFS ; Pointer into tables below +TBLOFS: BLOCK MAXIND*L$FBLK ; Actual filenames corresponding to those in TBLSFS, for opening. +TBLSFS: BLOCK MAXIND*L$FBLK ; Source-specified filenames for @: files + + +RFNAM1: 0 ; .FNAM1, .FNAM2, .FVERS +RFNAM2: 0 +RFVERS: 0 +IFNM1: 0 ; .IFNM1, .IFNM2, .IFVRS +IFNM2: 0 +IFVRS: 0 +INFFN1==:INFB+$F6FN1 ; Some crocks seem to reference this. +OFNM1==:OUTFB+$F6FN1 ; Pseudo .OFNM1 needs this. +OFNM2==:OUTFB+$F6FN2 ; ditto, .OFNM2 +RSYSNM: 0 ; Initial system name +PBLK + +SUBTTL I/O Buffers + +VBLK ; Input buffer and variables + +UTIBUF: BLOCK UTIBFL +UTIHDR: 0 ; Input buffer header (dec version) +UREDP: 440700,,UTIBUF ; Input byte pointer +UTICNT: 0 ; Input byte count (dec version) +IUREDP: 440700,,UTIBUF ; Initial UREDP, used for re-initializing. +UTIBED: UTIBUF ; EOF comparison with RH(UREDP), 4.9 => EOF on .IOT + +IFN DECSW,UTICHN: UTYIC + + ; BIN Output buffer + +UTOBUF: BLOCK UTOBFL ; Output buffer +UTOHDR: UTOBFL,,UTOBUF-1 +UTYOP: 444400,, ; Output (36. bit) byte pointer +UTYOCT: 0 ; # words left in utobuf +IFN ITSSW,OCLOSP: @1(C) ; Turned into bp to unused part of last bffer wd used. + + ; CREF output buffer +IFN CREFSW,[ +CRFBUF: BLOCK CRFBSZ +CRFHDR: CRFBSZ,,CRFBUF-1 ; Header, assembled value used only ifn itssw +CRFPTR: 444400,, ; Bp for filling buffer (full words) +CRFCNT: 0 ; Num. wds. empty in buffer +] + + ; LISTing output buffer +IFN LISTSW,[ +LSTBUF: BLOCK LSTBSZ +LSTHDR: 5*LSTBSZ,,LSTBUF-1 +LSTPTR: 440700,, +LSTCNT: 0 +] + + ; ERRor output buffer +IFN ERRSW,[ +ERRBUF: BLOCK ERRBSZ +ERRHDR: 5*ERRBSZ,,ERRBUF-1 +ERRPTR: 440700,, +ERRFCT: 0 ; Can't call this ERRCNT since that's used for # errors. +ERRFP: 0 ; Non-0 if want error output file. +ERRFOP: 0 ; Non-0 if error file open (ie try outputting to it) +] +PBLK + +SUBTTL Interrupt Handling + +; Note that only PDL OV is now enabled in general. +; TTY input interrupts are also handled when possible for +; ^H, ^W, and ^V. + +.SCALAR INTSVP ; Saves P on interrupt for debugging + +IFN ITSSW,[ + TMPLOC 42, JSR TSINT ; Interrupt vector for ITS +VBLK +.JBCNI: +TSINT: 0 ; 1st wd interrupts currently considered fatal errors. +.JBTPC: 0 ; Error processor re-enables interrupts + .SUSET [.RJPC,,INTJPC] + SKIPGE TSINT + JRST TTYINT ; Second-word ints. + JRST TSINT1 ; Jump into pure coding and process interrupt +INTJPC: 0 ; Saves .JPC at interrupt. +PBLK + ; Jrst here from TSINT for 2nd wd interrupts. +TTYINT: PUSH P,A + MOVEI A,TYIC ; The tty chnl is the only one enabled. + .ITYIC A, + JRST TTYINX ; No int. char. + CAIN A,^W + AOS TTYFLG ; ^W silences, + CAIN A,^V + SOS TTYFLG ; ^V unsilences, + CAIN A,^H + SETOM TTYBRF ; ^H says break next time thru ASSEM1 loop. +TTYINX: REST A + .DISMIS .JBTPC +] ; IFN ITSSW + +IFN DECSW, TMPLOC .JBAPR, TSINT1 ; Interrupt vector for DEC + +IFN ITSSW\DECSW,[ + ; Amazing but can use almost same basic rtn for both! + +TSINT1: MOVEM P,INTSVP ; Save P for possible debugging +IFN ITSSW,.SUSET [.SPICL,,[-1]] ; For ITS, re-enable ints. + MOVE A,.JBCNI ; Get interrupt request word + TRNE A,200000 ; PDL overflow? + JRST CONFLP + MOVE B,[TYPE "Unknown interrupt - Fatal"] ; anything else. + MOVEM B,40 + MOVE A,.JBTPC ; So error routine will print out properly + JSA A,ERROR +] + +IFN TNXSW,[ + ; TENEX Interrupt handler +; Note that NXP (non-ex page) is enabled, but no provision is +; currently made for handling it. This causes process termination and +; EXEC will print error message. If NXP wasn't enabled, a page would +; simply be created without fuss (page is always created, incidentally, +; whether or not interrupt happens) + +LVAR MEMDBG: 0 ; For nonce, this gets set when PURIFG does. + +LEVTAB: INTPC1 ; Where to store PC for level 1 interrupt. + 0 ? 0 ; Levels 2 and 3 unused. +CHNTAB: BLOCK 36. ; Where to go for indicated condition. Most zero. + +.IC.CV==1 ; Define user channel 1 for ^V interrupt +.IC.CW==2 ; " 2 for ^W +.IC.CH==3 ; " 3 for ^H +%%LSV==. +LOC CHNTAB+.ICPOV ? 1,,TSINT1 ; Put right word in CHNTAB for PDL OV dispatch. +LOC CHNTAB+.IC.CV ? 1,,INT.CV ; Ditto for ^V dispatch +LOC CHNTAB+.IC.CW ? 1,,INT.CW ; " ^W +LOC CHNTAB+.IC.CH ? 1,,INT.CH ; " ^H +LOC %%LSV + +.SCALAR INTPC1 ; Level 1 interrupt PC stored here. + + ; Handle PDL OV interrupt +TSINT1: MOVEM P,INTSVP ; Save PDL ptr. + MOVEI A,CONFLP ; OK to clobber A in PDLOV. + MOVEM A,INTPC1 ; Dismiss to CONFLP. + DEBRK ; Off we go. + + ; Handle ^V interrupt +INT.CV: SOS TTYFLG ; Unsilence typeout + DEBRK + + ; Handle ^W +INT.CW: AOS TTYFLG ; Silence typeout + DEBRK + + ; Handle ^H +INT.CH: SETOM TTYBRF ; Set flag to check at main level ASSEM1 loop. + DEBRK +] + +SUBTTL MIDAS BEGINS HERE - Program Startup + +VBLK +NVRRUN: -1 ; 0 => MIDAS was run; error to start or purify. +FATAL: 0 ; At end of assembly, not 0 iff fatal error occurred. +PBLK + +BEG: ; Start address! +IFN DECSW\TNXSW,[ + TDZA A,A + SETO A, + MOVEM A,CCLFLG ; Remember type of start-up +] + SETZ FF, ; Initialize flags + MOVE P,[-LPDL,,PDL-1] ; Initialize P + +IFN DECSW,[ + RESET + MOVEI A,600000 + APRENB A, +] + ; For TENEX, must determine right away which system we're on. +IFN TNXSW,[ + RESET +; TLZ FF,FL20X ; Assume 10X until proven otherwise. (done by SETZ above) + +IFN 0,[ ; One way of determining OS which doesn't work on some places. + MOVE A,[112,,11] ; Magic word that will win on 10X,T20 (and maybe T10) +GETTAB=<047000,,41> ; CALLI 41 + GETTAB A, ; Returns 10000 T10, 20000 ITS, 30000 10X, 40000 T20 + MOVEI A,30000 ; Shouldn't ever fail, but if it does, assume 10X. + LDB A,[140300,,A] ; Flush other fields too + CAIN A,4 ; = Tops-20? + TLO FF,FL20X ; Yes, set flag. +]; IFN 0 +IFN 0,[ ; This is a loser too, since there ARE KL Tenices! + SETZ A, ; In lieu of above, use hardware hack... + BLT A, ; test for KL-ness. + CAIE A, + TLO FF,FL20X ; KL will fail to skip, assume that means 20X OS. +];IFN 0 +IFN 1,[ ; Boy I hope DEC never defines LOADTB! -- MRC + SYSCAL SYSGT,[['LOADTB]][A ? D] + SKIPN D ; If LOADTB is not defined + TLO FF,FL20X ; it must be a Twenex +]; IFN 1 + + SYSCAL SCVEC,[[.FHSLF] ? [-1]] ; and flush compat package, + ; disabling UUO's 40-77; this is good for debugging. + + ; Set up stuff for interrupts + SYSCAL SIR,[[.FHSLF] + [LEVTAB,,CHNTAB]] ; Specify tables + SYSCAL EIR,[[.FHSLF]] ; Enable interrupts + SYSCAL AIC,[[.FHSLF] ; Activate PDL OV and ^V, ^W, ^H +[IRP BIT,,[.ICPOV,.IC.CV,.IC.CW,.IC.CH] +<1_<35.-BIT>>+!TERMIN ]] + SYSCAL ATI,[[.TICCV,,.IC.CV]] ; Make various mappings from + SYSCAL ATI,[[.TICCW,,.IC.CW]] ; terminal bits to int. channels. + SYSCAL ATI,[[.TICCH,,.IC.CH]] ; What a losing interrupt sys 10X has! + SKIPN MEMDBG ; Hacking memory? + JRST BEG20 + MOVSI A,-2*MINMAC ; If so, must create pages for initially-zero + MOVE B,(A) ; core, by referencing them all. + ADDI A,777 + AOBJN A,.-2 + SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Then enable ints +BEG20: ; for Non-eXistent Pages. +] + +IFN ITSSW,[ + MOVE A,[-5,,[ ; Set and read various vars in a chunk. + .SMASK,,[%PIPDL] ; 1st-wd Interrupt only on PDL ovfl. + .SMSK2,,[1_TYIC] ; 2nd-wd on TTY input channel. + .SPICL,,[-1] ; and enable interrupt system. + .RSNAM,,RSYSNM ; Get system name (default dir to use) + .RXJNAM,,B ]] ; and XJNAME for temp. hacking below. + .SUSET A + SYSCAL TTYSET,[1000,,TYIC ; Set TTYST wds - PI echo, no act/int + [232020,,202020] ; except ctls activate & interrupt + [232020,,220220]] ; CR, DEL activate but don't int; + ; DEL doesn't echo. +] + + AOSE NVRRUN ; Test for this job's already being run... + JRST [ TYPE "Can't restart MIDAS" + JRST TSRETN] + + MOVEI D,SYMDSZ ; Get default symtab size +IFN ITSSW,[ ; Remember that B set to XJNAME above. + CAME B,['MMIDAS] ; Set symtab size larger for MMIDAS + CAMN B,[SIXBIT/MM/] ; (random sort of hack now that .SYMTAB exists) + MOVEI D,SYMMSZ +] + SKIPGE ISYMF ; The first time through, + MOVEM D,SYMLEN ; Make that the size to use. + CALL SITINI ; Initialize stuff for .SITE. + CALL JCLINI ; Now try to fetch JCL; set CMPTR accordingly. +IFN ITSSW,[ + SKIPGE ISYMF ; Skip if syms spread; if not, + CALL TSYMGT ; get TS syms from system. +] + SKIPE CMPTR ; If have JCL, + JRST GO2AA ; skip announcing midas's name and version. + +IFG PURESW-DECSW,[ ; If meaningful, + SKIPGE PURIFG ; Check for purity + TYPE "NOTPUR " ; and type little warning if unpurified. + ] + TYPE "MIDAS." ; and announce self. + MOVE B,[MIDVRS] + PUSHJ P,SIXTYO + JRST GO2AA + +SUBTTL MIDAS Top-level control path + +GO2A: SETZM CMPTR ; Recycles here, so JCL only hacked once. +GO2AA: SETOM FATAL ; Assume fatal errors, unless cleared at GO8 when done. + SETZM TTYFLG ; Allow TTY typeout. + SETZM ERRCNT ; Initialize error counter (total errors) +IFN RUNTSW,[ PUSHJ P,RNTTMA ; Get initial run time. + MOVEM A,IRUNTM] + SETZM LSTTTY ; Tell TYOERR not to try output to LST file (none yet!) + PUSHJ P,CMD ; Get typed in command (or scan cmd line if CMPTR ne 0) + + SKIPGE SMSRTF ; What's this for, I wonder? + JRST GO21 + TYPECR "SYMTAB clobbered" + JRST GO2A + + ; Filenames and switches all specified, now see if files can be set up. +GO21: PUSHJ P,OPNRD ; Open input file + JRST GO2A ; Error, msg was typed, go try again with new cmd line. + PUSHJ P,WINIT ; Open output file, cref file. +IFN DECSW\TNXSW,[ + SKIPGE CCLFLG + TYPE "MIDAS: " +] +IFN A1PSW,[ + SETOM PRGC + SETOM OUTC +GO3: ] + MOVE A,WSWCNT + MOVEM A,TTYFLG ; Turn off typeout if there were (W) switches. + SETOM LSTTTY ; Allow TYOERR to output to both TTY and LST. + JSP A,$INIT ; Initialize for assembly + JSP A,PS1 ; Do pass 1 + TRNN FF,FRNPSS ; If 2 pass assembly, + JRST GO4 + PUSHJ P,OPNRD ; Then re-open input file + JRST GO2A ; Couldn't re-open???? Do something better here. +GO4: JSP A,PLOD ; Maybe punch out SBLK loader in some format + JSP A,PS2 ; Do pass 2 + JSP A,PSYMS ; Maybe punch out symbol table +IFN A1PSW,[ + TLZ FF,$FLOUT + AOS PRGC ; Indicate end statement encountered + SETOM OUTC ; " " " + TRNN FF,FRNPSS ; If 1 pass assembly, + SKIPGE CONTRL + CAIA + JRST GO3 ; Then try to assemble another program +] +IFN FASLP,[ + SKIPGE A,CONTRL + TRNN A,FASL + JRST GO8 + MOVE A,[SIXBIT /*FASL*/] ; "finish" FASL file + MOVEI B,17 + PUSHJ P,FASO ; Ignore end frob, but output FASL end code + MOVE A,[ASCIC//] ; pad with ^C's. + PUSHJ P,FASO1 ; Randomness + PUSHJ P,FASBE ; Write out last block +] + ; Jump directly here for certain main-input EOF conditions. +GO8: SETZM FATAL ; There was no fatal error: output files get renamed. + + ; Jump directly here if hit fatal error (incl .FATAL, illegal UUO, etc) +GO9: PUSHJ P,.FILE ; Close (and rename if FATAL = 0) output files. + SETZM LSTTTY +IFN RUNTSW, PUSHJ P,RNTTYO ; Type out run time used since GO2A + CALL ERRCLS ; File away error file - only thing not closed by .FILE + JRST TSRETN ; and die according to system's wishes. + +SUBTTL MIDAS Death (TSRETN) - system dependent exit routines + +IFN ITSSW,[ +TSRETN: +IFN PURESW,[ + SKIPGE PURIFG ; If not yet purified, assume being debugged. + .VALUE +] + .LOGOUT ; Come here to commit suicide. + .BREAK 16,160000 +] ;IFN ITSSW + +IFN DECSW,[ + +TSRETN: SKIPLE A,ERRCNT ; If had any errors, + ADDM A,.JBERR ; let loader know about them. (???) Well, + .SEE ERR1 ; for strange comment. + SKIPN CCLMOR ; Any more CCL commands? + EXIT ; Nope, all done. + JRST RERUN ; More CCL to hack, start up a new MIDAS. +] ; IFN DECSW + + +IFN TNXSW,[ +TSRETN: SKIPE CCLMOR ; Need to hack any more CCL? + JRST RERUN ; Yeah. +TSRET1: HALTF + HRROI 1,[ASCIZ/Can't continue/] + PSOUT ; Better than dying randomly + JRST TSRET1 +] ; IFN TNXSW + +SUBTTL .SITE pseudo & initialization (SITINI) + +IFN ITSSW, LVSITE==1 ; ITS only uses 1 word of mach name. +IFN DECSW\TNXSW,LVSITE==5 ; whereas others need 5 words (25 chars max) + +LVAR V.SITE: BLOCK LVSITE ; .SITE string stored here. + + ; .SITE N, returns nth word of sixbit machine name. + +A.SITE: CALL AGETFD ; Get field as argument. + JUMPL A,CABPOP ; Ignore negative indices. + CAIL A,LVSITE ; Make sure index is within bounds of string. + JRST CABPOP + MOVE A,V.SITE(A) ; Win, get indexed word. + JRST CLBPOP + + +; SITINI - Initialization routine called only at MIDAS startup, for +; setting up .SITE and maybe other things. + +SITINI: BLTZ LVSITE,V.SITE ; Clear out string location + +IFN ITSSW,[ ; For ITS, use up just 1 word and need 1 call to set V.SITE + SYSCAL SSTATU,[REPEAT 5,[ ? MOVEM A] ? MOVEM V.SITE] + .LOSE %LSSYS + POPJ P, ] + +IFN SAILSW,[ ; SAIL needs special kludge, since it doesn't have the + MOVE A,[SIXBIT /SAIL/] ; right GETTAB used. + MOVEM A,V.SITE + POPJ P, ] + + ; This code sets TNX .OSMIDAS at runtime as appropriate. +IFN TNXSW,[ + MOVE A,[SIXBIT /TENEX/] ; Assume running on 10X + TLNE FF,FL20X ; unless proved otherwise + MOVE A,[SIXBIT /TWENEX/] + MOVEM A,OSMID ; Store directly as symtab value! +] + ; If TNX and on ARPA network, get Arpanet host name for .SITE +IFN TNXSW,[ + SYSCAL SYSGT,[['LHOSTN]][A ? B] ; Get local host # + JUMPL A,SITIN3 ; Tops-20 release 3 has a LHOSTN table + JUMPE B,SITIN3 ; Jump if none, not on net. + SYSCAL CVHST,[FNBWP ? A][A] ; Write string into FNBUF. + JRST SITIN3 ; No string for that host #?? + SETZ B, + IDPB B,A ; Make sure string is ASCIZ'd. + MOVE B,FNBWP ; Note that FNBWP isn't altered by the syscal! + MOVE C,[440600,,V.SITE] +SITIN2: ILDB A,B + JUMPE A,APOPJ ; return when string ended. + TRCE A,140 ; Convert char to sixbit. + TRCE A,140 + TRCE A,140 + IDPB A,C + JRST SITIN2 +] + + ; For non-network TENEX and DEC in general, very similar. +IFN DECSW\TNXSW,[ +IFN TNXSW,[ +SITIN3: SYSCAL SYSGT,[['SYSVER]][A ? D] ; Best to get table index dynamically, + JUMPE D,APOPJ ; If can't, lose. + ] +IFN DECSW,MOVEI D,11 ; 11 = .GTCNF But on T10 we can assume this. + + MOVE AA,[440600,,V.SITE] + MOVSI C,-5 ; Process 5 words of .GTCNF (max possible) +SITIN4: HRLZ B,C ; Get subindex we want, + HRRI B,(D) ; and produce ,,
+IFN DECSW, GETTAB B, ; Get 1 word of table, using appropriate call. +IFN TNXSW, SYSCAL GETAB,[B][B] + POPJ P, ; If call fails, exit. +SITIN5: SETZ A, + LSHC A,7 ; Extract an ascii char + CAIE A,", ; If it's a comma, + CAIG A,40 ; or ctl or space, + POPJ P, ; then let's stop. + TRCE A,140 ; Swap bit 40 with bit 100, thus turning + TRCE A,140 ; "A to 'A, "a to 'A, "1 to '1, etc, and ^@ to ' . + TRCE A,140 + IDPB A,AA ; Store the sixbit into V.SITE + JUMPN B,SITIN5 ; When nothing left of this word of .GTCNF, get next. + AOBJN C,SITIN4 + POPJ P, +] ;DECSW\TNXSW + +SUBTTL RunTime - .MRUNT and end-of-assembly typeout +IFN RUNTSW,[ + +.SCALAR IRUNTM ; Holds initial run time (set at start of assembly) + + ; .MRUNT - Returns runtime since start of assembly. + +A.MRUN: PUSHJ P,RNTTMA ; Get current run time + SUB A,IRUNTM ; Subtract initial run time +IFN ITSSW,[MULI A,4069. ; ITS - Convert to nanoseconds, + DIV A,[1.^6] ; then to milliseconds. +] + PJRST CLBPOP + + ; RNTTMA - internal routine to return in A the current runtime, + ; in whatever units the OS furnishes. +RNTTMA: +IFN ITSSW, .SUSET [.RRUNT,,A] ; Gets runtime in 4.096 usec units. +IFN DECSW, SETZ A, ? RUNTIM A, ; Runtime in msec +IFN TNXSW,[ + IFN A-1, EXCH R1,A + MOVEI R1,.FHSLF + RUNTM ; Runtime in msec for self. + IFN A-1, EXCH R1,A + ] + POPJ P, + +; RNTTYO - Called at end of assembly to type out runtime, +; # of errors, and # symbols used. + +RNTTYO: +IFN DECSW,[ ; Nobody wants this on ITS, but other people do...sigh... + SKIPE A,ERRCNT ; Any assembly errors? + JRST [ TYPE "? " ; Yes, error message for batch controllers + CALL DPNT + TYPECR " error(s) detected" + JRST .+1] + SKIPE CCLFLG ; Called via CCL? + RET +] + TYPE "Run time = " + CALL A.MRUN ; Get runtime in millisec. in A. + IDIVI A,10. + IDIVI A,100. ; Get secs and hundredths. + HRLM B,(P) ; Save remainder + PUSHJ P,HMSTYO ; Type out secs + MOVEI A,". + CALL TYO + HLRZ A,(P) + CALL HMSTY3 ; Type out hundredths + CALL CRR + CALL A.SYMC + CALL DPNT + TYPE " Symbols including initial ones (" + CALL A.SYMC + IMULI A,100. + IDIV A,SYMLEN ; Get % symtab used + CALL DPNT + TYPECR "% used)" + RET + +; HMSTYO - Type out H:MM:SS time in A +; Doesn't work for times .ge. 60. hours + +HMSTYO: IDIVI A,60. + JUMPE A,[MOVE A,B ? PJRST DPNT] + HRLM B,(P) + PUSHJ P,HMSTYO + MOVEI A,": + PUSHJ P,TYO ; Type delimiting char + HLRZ A,(P) +HMSTY3: IDIVI A,10. + PUSHJ P,ADGTYO ; Type out digit in A + MOVEI A,"0(B) + PJRST TYO + +] ; IFN RUNTSW + +SUBTTL COMMON Output Routine WINIT - Open all output files. + +; WINIT - Called from top-level control to open all necessary output files. +; + +WINIT: +IFN ERRSW,[ + SKIPN ERRFP ; If want error output file, + JRST WINIT2 + CALL OINIT ; Open it, first of all. + 0 ERRFC,ERRFB + SIXBIT/ERROUT/ + ERRHDR,,ERRBUF + SETOM ERRFOP ; Error file now open. +WINIT2: ] + PUSHJ P,OINIT ; Open main output file. + 13^9 UTYOC,OUTFB ; chnl,name-block. + SIXBIT/OUTPUT/ + UTOHDR,,UTOBUF +IFN ITSSW,[ + TLZ FF,FLPTPF ; Initially assume device not paper tape punch + .STATUS UTYOC,A ; Get status of output channel + ANDI A,77 ; Mask to device code + CAIN A,7 ; If paper tape punch, + TLO FF,FLPTPF ; Then set FLPTPF. +] +IFN LISTSW,[ + SKIPN LISTP + JRST WINIT1 + CALL OINIT ; Open listing file if desired. + 0 LPTC,LSTFB + SIXBIT/LSTOUT/ + LSTHDR,,LSTBUF +WINIT1: +] +IFN CREFSW,[ + SKIPN CREFP ; If cref requested, + RET + PUSHJ P,OINIT ; Open cref file, FN2 = CRFOUT + 13^9 CREFC,CRFFB + SIXBIT/CRFOUT/ + CRFHDR,,CRFBUF + MOVE A,[.BYTE 7 ? 177 ? "B ? ^W] + PUSHJ P,CRFOUT ; Output header to indicate image input. + PUSHJ P,CRFSSF ; Output set-source-file block. +] + RET + +SUBTTL COMMON Output Routines - Output Chars/Words to BIN, TTY, ERR, CREF, LIST + + ; PPB - Punch Binary word. + +PPB: JUMPGE FF,CPOPJ ; Don't punch if not punching pass. +PPBA: ; This entry pt "Always" punches. +TPPB: SOSGE UTYOCT ; If no more room in buffer, + JRST [ CALL TPPBF ; Output & re-init buffer. + JRST TPPB] + IDPB A,UTYOP + RET + +TPPBF: PUSH P,[0 UTYOC,UTOHDR] ; Drop thru to COBUFO. + + ; Common OBUFO. Takes ,
on stack, clobbers no ACs. + ; See rtns below for usual calling sequence. +COBUFO: EXCH C,(P) ; Get arg off stack, save C. + CALL OBUFO ; Output & re-init buffer. + REST C + RET + + ; TYO - Output char in A, outputting also to ERR file if possible. +TAB: MOVEI A,^I +TYO: SKIPG A.TTYF + CALL TYOX ; Actually output to TTY with OS-dependent routine. + ; Then fall through for ERR output. +ERRCHR: +IFE ERRSW,RET +IFN ERRSW,[ + SKIPN ERRFOP ; Output char in A to error file if one is open. + RET + SOSGE ERRFCT + JRST [ PUSH P,[ERRCHR] + PUSH P,[0 ERRFC,ERRHDR] + PJRST COBUFO] + IDPB A,ERRPTR + RET +] ;IFN ERRSW + + ; CRFOUT - Output word in A to CREF file. + +IFN CREFSW,[ +CRFOUT: SOSGE CRFCNT + JRST [ PUSH P,[CRFOUT] ; Buffer full, go output it. + PUSH P,[0 CREFC,CRFHDR] + PJRST COBUFO] + IDPB A,CRFPTR + POPJ P, + +CRFSSF: SKIPA A,[1] ; Output set-source-file block. +CRFPSH: MOVEI A,3 ; Output push-source-file block. +REPEAT L$F6BL,[ + CALL CRFOUT + MOVE A,INFB+$F6DEV+.RPCNT + ] + JRST CRFOUT +] ; IFN CREFSW + + + ; PILPT - Output character in A to listing file. + +IFN LISTSW,[ +PILPT: SOSGE LSTCNT + JRST [ PUSH P,[PILPT] ; When buffer full, output it. + PUSH P,[0 LPTC,LSTHDR] + PJRST COBUFO] + IDPB A,LSTPTR + RET + +LPTCLS=:CPOPJ ; Hmmm, random noop-ness ref'd by AEND. + +] ;END IFN LISTSW, + +SUBTTL COMMON Output Routine .FILE - Close all output files. + +; .FILE - Counterpart to WINIT. +; Close input, bin, cref and list files. + +.FILE: ; Closing input file is simple enough... +IFN DECSW, RELEAS UTYIC, +IFN ITSSW, .CLOSE UTYIC, +IFN TNXSW,[ +IFN PMAPSW, MOVE A,[NIBFPS,,1STBFP] ? CALL DELPGS ; flush buffer pages + MOVE R1,INFB+$FJFN + CLOSF + JFCL + SETZM INFB+$FJFN + SETZM JFNCHS+UTYIC +] + MOVNI A,1 + SKIPL B,CONTRL ; If relocatable, + PUSHJ P,TPPB ; Output a -1 so stink will see EOF + SETZ A, ; In dec fmt, output a 0 at end. + TRNE B,DECREL + CALL TPPB + SKIPE OUTFB+$FEXT ; Check general name. + JRST .FILE2 ; Output fnam2 was explicitly specified + + ; Output extension (fn2) wasn't specified, default depends + ; on system and output type. +IFN ITSSW, MOVSI A,'BIN ; Default to SBLK output format; note that +IFE ITSSW, MOVSI A,'SBK ; this will include RIM, RIM10. + SKIPL B,CONTRL ; Using STINK output format? +IFN ITSSW, MOVSI A,'REL ; Yes, use appropriate thing for site. +IFE ITSSW, MOVSI A,'STK + TRNE B,DECSAV ; Using DECSAV output format? + MOVSI A,'SAV +IFN TNXSW,[ + TRNE B,DECSAV ; If using DECSAV format and + TLNN FF,FL20X ; on a 20X, then + CAIA + MOVSI A,'EXE ; use this extension instead. +] + TRNE B,DECREL ; Using DECREL output format? + MOVSI A,'REL +IFN FASLP,[ + TRNE B,FASL ; Using FASL output format? +IFN ITSSW, MOVE A,[SIXBIT /FASL/] ; yes, smash as appropriate. +IFE ITSSW, MOVSI A,'FAS +] +IFE TNXSW, MOVEM A,OUTFB+$F6EXT ; For 6bit systems, store final selection. +IFN TNXSW, PUSHJ P,TNXODF ; If Tenex, call output default hackery, since + ; changing stuff is a bit hairier. + +.FILE2: JSP A,OCLOSE + 0 UTYOC,UTOHDR ; Write out buffer, rename and close output file. + OUTFB +IFN LISTSW,[ + SKIPN LISTP ; Listing file open => + JRST .FILE3 + CALL PNTCR ; End with cr and ff. + MOVEI A,^L + CALL PILPT + PUSH P,FATAL ; Rename listing file even if fatal error. + SETZM FATAL + JSP A,OCLOSE + 0 LPTC,LSTHDR ; Output buffer, rename & close it. + LSTFB + POP P,FATAL +.FILE3: +] ;IFN LISTSW +IFN CREFSW,[ + SKIPN CREFP ; If cref file open, + POPJ P, + MOVEI A,0 + PUSHJ P,CRFOUT ; Output eof block, + JSP A,OCLOSE ; Write buffer, close. + 0 CREFC,CRFHDR ; 0 chnl,header + CRFFB +] + RET + + ; File out error output file. This isn't done in .FILE so that + ; error file can include a few more goodies and be closed separately + ; later on. +ERRCLS: SETZM FATAL ; Err file renamed even after fatal error. +IFN ERRSW,[ + SKIPN ERRFOP + RET ; There is none. + MOVEI A,^M + CALL ERRCHR ; Put crlf at ennd. + MOVEI A,^J + CALL ERRCHR + JSP A,OCLOSE ; Rename and close. + 0 ERRFC,ERRHDR + ERRFB + SETZM ERRFOP +] + RET + +SUBTTL ITS - Output file Open, Output, Close/Rename. +IFN ITSSW,[ + +; PUSHJ P,OINIT ; Open output file +; Mode chnl,name-block-addr +; Sixbit/desired-temporary-fn2/ +; Header,,buffer space ;used only in dec version. +; The mode should be 13^9 for binary, 0 for ascii. + +OINIT: MOVE A,(P) + HLRZ B,2(A) ; Get addr of header, + SETOM 2(B) ; Set buffer byte count to -1 => not initted. + MOVE AA,1(A) ; Get 2nd arg, temp FN2 to use. + MOVE F,(A) ; Get 1st arg - , + SYSCAL TRANS,[5000,,.UAO ; For output mode, + REPEAT 4,[? .RPCNT(F) ] ; translate from given names + REPEAT 4,[? MOVEM .RPCNT+FB+$F6DEV ]] ; into actual names, in scratch blk. + JRST OINITL ; (too many translations) + + SYSCAL DELETE,[FB+$F6DEV ; Delete old temp name file. + TMPFN1 ? AA ? FB+$F6DIR] + JFCL ; If none, it's ok. + LDB A,[270400,,F] ; Get channel num. + HRLI A,.BAO ; Open mode (default ascii) + TLNE F,777000 ; But maybe want image mode. + HRLI A,.BIO ; Yep, use that instead, to get ,, + SYSCAL OPEN,[A ? FB+$F6DEV ; Open file, + TMPFN1 ? AA ; using these temp filenames. + FB+$F6DIR] + JRST OINITL + BLTM L$F6BL,FB+$F6DEV,$F6DEV(F) ; Copy translated names into + ; name-block for file, for eventual rename. + +POPJ3: AOS (P) ; Skip over 3 args. +POPJ2: AOS (P) + JRST POPJ1 + +TMPFN1: SIXBIT /_MIDAS/ ; FN1 to use for temp filenames. + + + +; OINITL - jumped to from OINIT if some lossage +; encountered when opening output files. + + +OINITL: HLLZ A,@(P) ; Get chnl num, + TLZ A,777037 ; Mask to just ac field (chnl num) + IOR A,[.STATUS A] + XCT A ; Read its status, + PUSHJ P,OPNER ; Type out reason for open failure, and ask + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Get typein, one line. + MOVE F,@(P) ; Get + PUSHJ P,RFD ; Get new file description into filblk spec'd by F + JRST OINIT ; and jump back to try again. + +VBLK +ERRDNM: .UAI,,'ERR ? 3 +ERRCOD: 0 +IFSTS: 0 ; .STATUS word stored by OPNRD1 when .OPEN loses +PBLK + + ; Openloss documentation routine + +IOPNER: MOVE A,IFSTS ; Input +OPNER: MOVEM A,ERRCOD ; Save .status word + PUSHJ P,TYPFB ; Type out file description + PUSHJ P,CRRERR ; Now crlf to ensure room for following + .OPEN ERRC,ERRDNM ; Now get the system to say what's wrong + .LOSE %LSSYS ; Can't open err device? +IOPNR2: .IOT ERRC,A ; Get character from system + CAIGE A,40 ; Ends with ^L or ^C or other cruft. + PJRST CRRERR ; Return, typing out CRLF. + PUSHJ P,TYOERR ; Type out character + JRST IOPNR2 ; Loop back for next + + +; JSP A,OCLOSE +; 0 chnl,header +; Nameblockaddr +; Write out last buffer, rename to names in nameblock and close. + +OCLOSE: MOVE C,(A) ; 1st wd of args is what OBUFO wants. + LDB B,[360600,,1(C)] ; Just in case this is ascii file, + DPB B,[300600,,OCLOSP] ; Get bp to unused part of last wd of buffer, + MOVE B,[ASCIC//] + DPB B,OCLOSP ; And pad with ^c's. + SOS 2(C) ; Obufo assumes byte count was sos'd. + CALL OBUFO ; Write out last partial buffer + MOVE F,1(A) ; Get + LDB C,[270400,,(A)] ; Get chnl num. + SKIPE FATAL + JRST OCLOS1 ; After fatal error, don't rename outputfiles. + SYSCAL RENMWO,[C ; Rename (F has nameblock addr) + $F6FN1(F) ? $F6FN2(F)] + HALT +OCLOS1: SYSCAL CLOSE,[C] ; Close channel. + HALT + JRST 2(A) ; Skip over args on return. + + +; OBUFO - Write out and reinitialize buffer for file. +; Assumes byte count (header 3rd wd) was sos'd. +; C has <0 chnl,header> +; In ITS version, header 1st wd has ,,-1 + +OBUFO: PUSH P,A + PUSH P,AA + AOSGE 2(C) ; Was count sos'd from -1? + JRST OBUFO1 ; Yes, buffer hadn't been initted, don't write it. + MOVN A,1(C) + ADD A,(C) ; RH(A) has -<# wds used in buffer>. + MOVSI A,(A) + HRR A,(C) + AOS A ; A has aobjn -> used part of buffer. + HLLZ AA,C + IOR AA,[.IOT A] + CAIGE A, + XCT AA ; Write it in file. +OBUFO1: MOVE A,1(C) + HRR A,(C) ; Position the b.p. before start of buffer, + TLZ A,770000 ; After last byte in wd (idpb will use 1st buffer wd) + MOVEM A,1(C) + HLRE A,(C) + MOVEM A,2(C) ; Set up byte count. + REST AA + JRST POPAJ + +TFEED: TLNN FF,FLPTPF ; If output device not PTP, + POPJ P, ; Then do nothing + PUSHJ P,TPPBF ; Otherwise output the buffer, +TFEED1: .FEED UTYOC, ; Feed a line, + TLZA FF,FLPTPF ; If this is executed, utyoc doesn't have ptp after all + SOJG B,TFEED1 ; Feed the specified number of lines, + POPJ P, ; And return + +] ; IFN ITSSW + +SUBTTL DEC - Output file Open, Output, Close/Rename + +IFN DECSW,[ + +OINIT: MOVE AA,(P) + MOVE F,(AA) ; Get , + HLLZ TT,F + TLZ TT,#(0 17,) ; Mask off AC field in TT + HRRZ D,2(AA) ; Get buffer space addr. + HLLZ C,2(AA) ; Get header addr. + HLRZ A,C + SETZM (A) ; Clear out its-version contents of 1st header wd. + LDB A,[331100,,F] ; Get mode to open in (will be ascii or image binary) + IOR TT,[OPEN A] ; Cons up OPEN instruction for chan, + MOVE B,$F6DEV(F) ; and bring in last arg. + XCT TT ; Open channel,a + JRST OINITL ; Lost? + + PUSH P,.JBFF ; Now to fake out DEC system into consing up buffer + MOVEM D,.JBFF ; at this location. T10 uses .JBFF as pointer. + XOR TT,[#] ; Request buffer setup (one of) + XCT TT + REST .JBFF + MOVE A,[SIXBIT /000MD /] + PJOB B, ; Get job number, to make sixbit /md/ + IDIVI B,10. + DPB C,[220400,,A] + IDIVI B,10. + DPB C,[300400,,A] ; Put the digits of the job number into the sixbit word. + DPB B,[360400,,A] + MOVE AA,(P) + LDB B,[360600,,1(AA)] ; Get 1st char of 'output, 'lstout, 'crfout, 'errout. + IOR A,B ; Use it as last char of temp file name. + MOVSI B,'TMP ; Set up ext (fn2), + SETZ C, ; zap prot/date/time etc to default, + MOVE D,$F6DIR(F) ; and PPN. + XOR TT,[#] + XCT TT ; Do ENTER UTYOC,A + JRST OINITL +POPJ3: AOS (P) +POPJ2: AOS (P) + JRST POPJ1 + +; OINITL - jumped to from OINIT if some lossage +; encountered when opening output files. Jumps back to OINIT +; directly. + +OINITL: PUSHJ P,OPNER ; Type out reason for open failure, and ask: + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Get typein, one line. + PUSHJ P,RFD ; Get new file description into filblk spec'd by F + JRST OINIT ; and jump back to try again. + + ; Openloss documentation routine - not much to say. + +IOPNER: ; Input +OPNER: PUSHJ P,TYPFB ; Type out file description + PUSHJ P,CRRERR ; Now crlf to ensure room for following + TYPE "OPEN failed" + PJRST CRRERR ; Return, typing out another CRLF. + +;CLOSE AN OUTPUT FILE, SEE NON-DEC VERSION FOR ARGS. + +OCLOSE: PUSH P,A ; Save return addr + MOVE F,1(A) ; Get + SKIPGE FATAL ; If fatal error happened, + JRST OCLOS2 ; don't rename, just close. + MOVE C,$F6DEV(F) ; Delete any file with names + SETZB B,D ; we want to rename to. + OPEN ERRC,B ; Use ERRC as temporary channel. + JRST OCLOS1 + MOVE A,$F6FN1(F) + HLLZ B,$F6EXT(F) + SETZ C, + MOVE D,$F6DIR(F) + LOOKUP ERRC,A + JRST OCLOS1 ; There is none, just rename. + SETZ A, ; Say to delete this file + MOVE D,$F6DIR(F) ; From right UFD + RENAME ERRC,A + JFCL + RELEAS ERRC, +OCLOS1: MOVE A,$F6FN1(F) ; Desired fn1. + HLLZ B,$F6EXT(F) ; Desired fn2. + SETZ C, ; Bottoms-10 DATE75 lossage must never be forgotten! + MOVE D,$F6DIR(F) ; Sname (that is, ppn) + HLLZ AA,@(P) ; Get just chnl num. + IOR AA,[CLOSE] ; Close it & finalize, + XCT AA + XOR AA,[CLOSE#] + XCT AA ; Then rename to desired names. + JFCL ; at this point, ignore any lossage, sigh. +OCLOS2: HLLZ B,@(P) ; Get chnl in ac field. + IOR B,[RELEAS] + XCT B ; Finally, release channel. + JRST POPJ2 ; and skip over args on return. + + ; Write out buffer of output file, C has <0 chnl,header> +OBUFO: AND C,[0 17,] ; Get just chnl num. (sys remembers where header is for ch) + TLO C,(OUT) ; Output current buffer. + XCT C + RET ; Normal return! + PUSH P,A ; Error return from out uuo. + XOR C,[OUT#] + XCT C ; Read file status. + TRZ A,74^4 ; Clear error bits. + ETR [ASCIZ /Output data error/] + XOR C,[#] + XCT C + JRST POPAJ + + ; Paper tape stuff, do nothing. +TFEED: RET + +] ;END IFN DECSW, + +SUBTTL TNX - Output file Open, Output, Close/Rename + +IFN TNXSW,[ + +TFEED: RET ; Again, null out paper-tape hack. + +; OINIT - Open Output file. +; P points to first word of args which follow the call: +; 1: , ; is 0 for ascii, 13^9 for bin. +; 2: sixbit // +; 3:
,, +; +; Clobbers A,B,C + +; For Tenex, it is necessary to fudge the fileblock consistency slightly; +; $FJFN has in RH the actual JFN used to write to the temporary-name +; file, and in LH the JFN for the final desired filename. Note that if +; the $FEXT is null for main output file, it will be defaulted by TNXODF +; at close time, (to SAV, EXE, or REL) and the +; "final desired" JFN won't actually be used. +; Both JFNS are "active" rather than just a file spec. + +OINIT: MOVE C,(P) ; Get addr of arg block + HLRZ A,2(C) ; Get
, + SETOM 2(A) ; and set buffer byte cnt to -1 to mark for init. + MOVE F,(C) ; Get , + PUSHJ P,GETJFO ; Get output JFN for filblk. + JRST OINIT5 ; Lost? +OINIT2: HRLZS $FJFN(F) ; Won, move JFN over into LH. + + ; Aha, successfully grabbed a JFN for desired output filename. + ; Now must get another one for the temporary filename... + MOVSI A,(GJ%FOU+GJ%NEW) + PUSHJ P,TFMAP ; Must set up block again, may have changed due to RDJFNO. + MOVE A,1(C) ; Get sixbit/tmpfn2/ + PUSHJ P,CV6STR ; Convert to ASCIZ and return BP to string. + MOVEM A,GTJBLK+.GJEXT ; Store in long-form call blk. + SYSCAL GTJFN,[[GTJBLK] ? [0]][A] ; Repeat the GTJFN call. + JRST [ MOVEM A,ERRCOD ; Ugh???? + JRST OINIT5] + HRRM A,$FJFN(F) ; Good, got it... + + ; Now have both JFN's packed away, can finally open the + ; temporary filename. + HRRZ B,A ; Need JFN in RH with LH clear... + LDB A,[331100,,F] ; Get + CAIN A, + MOVSI A,070000 ; If 0, use ASCII (7-bit bytes) + TRNE A,-1 + MOVSI A,440000 ; If not 0, use WORD (36-bit bytes) + TRO A,OF%WR ; Get write access. + SYSCAL OPENF,[B ? A][A] ; Open up the temp file (JFN in RH) + JRST [ MOVEM A,ERRCOD ? JRST OINIT6] ; damn + + ; Won, successfully opened output file stuff etc, now wrap up. + HRRZ A,$FJFN(F) ; Get JFN used, + LDB C,[270400,,F] ; and channel number argument, + MOVEM A,JFNCHS(C) ; and store JFN away in channel slot. + PUSHJ P,CVFSIX ; Now put right things in $F6 entries. + MOVEI A,3 + ADDM A,(P) + POPJ P, + +.SCALAR ERRCOD + + ; Come here when GTJFN fails trying to get a JFN for GTJBLK long + ; form argument block. Must print out bad filename. + ; OINIT5 should really use names in GTJBLK, and + ; OINIT6 should really hack GJFNS call to get names, but for now... + +OINIT5: SKIPA A,[[ASCIZ /GTJFN failed for /]] +OINIT6: MOVEI A,[ASCIZ /OPENF failed for /] + PUSHJ P,CRRERR + TYPR (A) + PUSHJ P,OPNER1 ; Type out filename and error message. + PUSHJ P,RDJFNO ; Read new JFN + JRST OINIT2 ; try to open it. + +IOPNER: PUSH P,[CRRERR] ; Do following and add CRLF. +OPNER1: PUSHJ P,TYPFB + TYPE " +Error - " ; Drop thru to TERSTR. + + +TERSTR: MOVE A,ERRCOD + HRLI A,.FHSLF + SYSCAL ERSTR,[[-1,,ERSTRB] ? A ? [-LERSTR,,]][A ? A ? B] + JRST TERST7 ; undefined err #? + HALT ; destination bad? + TYPR ERSTRB + POPJ P, +TERST7: TYPE "Unknown error" + POPJ P, + + LERSTR==80. +.VECTOR ERSTRB(/5) + +; RDJFNO - Hack to get a new JFN by reading from TTY, using recognition. +; RDJFNI - Same but for input. Uses current FB for defaults. +; Stashes JFN away in RH of $FJFN(F). + +RDJFNO: SKIPA A,[GJ%FOU+GJ%NEW+GJ%CFM] ; For output +RDJFNI: MOVSI A,(GJ%OLD+GJ%CFM) ; for input + PUSHJ P,TFMAP + MOVE A,[.PRIIN,,.PRIOU] ; Use primary JFNs (TTY) for I/O + MOVEM A,GTJBLK+.GJSRC + PUSH P,R1 + PUSH P,R2 + PUSH P,R3 + CAIA +RDJFN2: PUSHJ P,RDJERI ; Come here when get error in GTJFN. + MOVEI R1,.PRIIN ; Make sure that + CFIBF ; TTY input is reset. + HRROI R1,[ASCIZ / +Use what filename instead? /] + PSOUT + MOVEI R1, + MOVEI R1,GTJBLK + SETZ R2, + GTJFN + JRST RDJFN2 ; Error, report it. + POP P,R3 + POP P,R2 + HRRM R1,$FJFN(F) + POP P,R1 + PJRST JFNSTB ; Smash FB with names of the JFN we got, and return. + +; RDJERR - Report last error message directly to TTY (primary output). +; Useful when doing quick direct user interaction. + +RDJERR: TROA R2,-1 ; Here to get last error, whatever it was. +RDJERI: MOVE R2,R1 ; Here to use err code in R1. + HRLI R2,.FHSLF + HRROI R1,ERSTRB + MOVSI R3,-LERSTR + ERSTR ; Get error string + JRST RDJER6 + HALT + SKIPA R1,[-1,,ERSTRB] +RDJER6: HRROI R1,[ASCIZ /Unknown error/] + ESOUT ; Output to TTY amid other hackery. + POPJ P, + + +; TNXODF - Hack to get yet another "desired" JFN so that when no +; extension was specified for binary output file, one appropriate to +; the type can be selected. +; Basically do a GTJFN again for binary output filenames, furnishing +; the default extension selected, and use that to replace the one +; already in LH of $FJFN. + +TNXODF: PUSHJ P,CV6STR ; Convert sixbit word in A to string, get BP in A + MOVEI F,OUTFB ; Point at right filblk, + MOVEM A,$FEXT(F) ; Store, and now + PUSH P,$FJFN(F) ; Save current set of JFNs before + PUSHJ P,GETJFO ; getting another one + JRST POPAJ ; If lossage, stick to old JFN. + POP P,A + HRLZS $FJFN(F) ; GETJFO puts JFN into RH, we want it in LH. + HRRM A,$FJFN(F) ; now restore previous RH. + HLRZS A ; and get old "desired" JFN in position for + SYSCAL RLJFN,[A] ; releasing. + JFCL + POPJ P, + +; OCLOSE - Close output file, writing out remainder of buffer and renaming +; from temporary to desired filename. +; JSP A,OCLOSE +; 1: 0 ,,
+; 2: +; Clobbers F,C (and obviously A) + +; 10x must do CLOSF, not releasing the JFN, and then a RNAMF from temp +; JFN to desired JFN, after which both can be released. The desired and +; used JFNs are in LH and RH respectively of $FJFN in . +; is ignored except to wipe out its JFNCHS entry. + +OCLOSE: PUSH P,A + MOVE C,(A) ; Get ,,
+ SOS 2(C) ; OBUFO assumes count was SOS'd before each call + PUSHJ P,OBUFO ; Write out anything remaining in buffer. + LDB C,[270400,,(A)] ; Get channel number + MOVE F,1(A) ; Get + HRRZ A,$FJFN(F) ; Find JFN being used... + CAME A,JFNCHS(C) ; Should be same as JFN for channel. + HALT ; Synch error or something. + TLO A,(CO%NRJ) ; Say don't release JFN + SYSCAL CLOSF,[A] ; Close file... + HALT ; ?!?! + HRRZS A ; Get back 0,,jfn + SETZM JFNCHS(C) ; Indicate "channel" closed... + SKIPE FATAL ; If fatal error happened in assembly, + JRST OCLOS5 ; don't rename from temp filenames. + HLRZ C,$FJFN(F) ; Now see what if anything to rename it to. + JUMPE C,OCLOS5 ; If no renaming needed, skip hair. + SYSCAL RNAMF,[A ? C] ; Rename file from JFN in A to JFN in C. + HALT ; WTF? + SYSCAL RLJFN,[C] + HALT + JRST OCLOS6 ; JFN in A released by RNAMF. + +OCLOS5: SYSCAL RLJFN,[A] + HALT +OCLOS6: SETZM $FJFN(F) + POP P,A + JRST 2(A) + +; OBUFO - Output Buffer and reinitialize. +; C/ 0 ,
+; Clobbers no ACs. + +; 10X is pretty much like ITS, JFN is kept in JFNCHS table indexed by . + +OBUFO: PUSH P,A + PUSH P,B + MOVE A,1(C) ; Get write BP, + HRR A,(C) ; and reset it... + TLZ A,770000 ; to point at start of buffer, + MOVEM A,1(C) ; and store it back, which is OK since we have byte cnt + AOSGE 2(C) ; Was buffer marked for initialization (cnt -1)? + JRST OBUFO1 ; Yes, don't write anything, just go init rest of it. + HLRZ A,(C) ; Get buffer size in wds, + MOVNI A,(A) ; make negative, + ADD A,2(C) ; and add count of bytes left to get -<# bytes used>. + LDB B,[270400,,C] ; Get channel # as index to JFN + PUSH P,T + SYSCAL SOUT,[JFNCHS(B) ? 1(C) ? A] + POP P,T +OBUFO1: HLRZ A,(C) ; Get buffer size again, + MOVEM A,2(C) ; and reset count with it. + POP P,B + POP P,A + POPJ P, + +] ;END IFN TNXSW + +SUBTTL COMMON Input Routines - Main File Open, EOF handling + +; Open main input file for reading (filespec in ISFB) + +OPNRD: +IFN ITSSW, .IOPDL ; Re-initialize IO pdl +IFN DECSW\TNXSW, CALL IOPDLC ; Non-ITS systems must simulate. + INSIRP SETZM,INFCNT INFCUR INFERR + MOVE A,[-TYPDLS-1,,TTYPDL] + MOVEM A,ITTYP ; Initialize "tty pdl" + PUSHJ P,MACIN1 ; Clobber macro expansion status + MOVE A,[ISFB,,INFB] ; Copy ISFB specs to INFB (which will hold + BLT A,INFB+L$FBLK-1 ; actual names of current input file) + MOVE A,ISFB+$FDEV ; Get device name + CAMN A,FSTTY ; TTY? + JRST [ MOVE A,[ISFB+$F6FN1,,IFNM1] ; TTY specified, treat special + BLT A,IFNM2 ; Clobber .IFNM1, .IFNM2 to specified + MOVE A,ISFB+$FVERS + MOVEM A,IFVRS + TYPECR "Reading from TTY:" + MOVEI A,3 ; => input from tty, don't quit on cr + JRST OPNRT2] + MOVEI F,INFB ; Point things at INFB. + PUSHJ P,OPNRD1 ; Try opening file + JRST [ PUSHJ P,IOPNER ; Open lost, type out message + POPJ P,] ; Read new command (this may screw on pass2?) + MOVEM A,INFERR ; Err msg in main file shouldn't type names. + MOVEI A,0 ; => input from file +IFN TNXSW,[ + MOVE T,INFB+$FJFN ; Copy actual jfn to avoid re-GTJFN + MOVEM T,ISFB+$FJFN +] +OPNRT2: MOVE T,[IFNM1,,RFNAM1] + BLT T,RFVERS ; Set up .FNAM1, .FNAM2 + SETOM NEDCRL + AOS (P) ; Won, skip on return. + JRST RCHSET ; Set up to read from file or tty. (arg in A) + + + ; Common stuff for OPNRD1 in all (DEC/ITS/TENEX) versions. +OPNRD3: HRRZM A,UTIBED ; Say buffer empty, + MOVSI A,EOFCH_13 + MOVEM A,@UTIBED ; Cause immediate reload. +OPNRD4: BLTM 2,$F6FN1(F),IFNM1 ; Set up .IFNM1, .IFNM2 from filblk F points at + MOVE A,$FVERS(F) + MOVEM A,IFVRS + AOS A,INFCNT ; Assign this file a number. + MOVEM A,INFCUR ; OPNRD expects this left in A. + JRST POPJ1 + + ; EOF while trying to read character + +RPAEOF: PUSH P,B ; Save B +RPAEO1: MOVE B,ITTYP ; Get pdl pointer + PUSHJ P,BPOPJ ; Call pop routine (maybe NED's out) + JRST RCHTRB ; Return to get character + + ; EOF from main file + +NEDCHK: TRNE FF,FRCMND ; ^C read in command, :KILL self. + JRST TSRETN + SKIPN RCHMOD + AOSE NEDCRL + JRST NEDCH1 + + ; Invent one crlf after end of main file. + MOVE B,[440700,,[.BYTE 7 ? ^M ? ^J ? EOFCH]] + MOVEM B,UREDP + HRRZM B,UTIBED +IFN PMAPSW,[ + HRLI B,170700 ; Make BP pointing at last (3rd) char + MOVEM B,UTIBPE ; Set EOF BP properly. +] + RET +NEDCH1: +IFN A1PSW,[ + PUSHJ P,OUTCHK + MOVSI A,-LNEDT + XCT NEDT(A) ; Skips if NED condition to be complained about + AOBJN A,.-1 + JUMPGE A,GO8 +] + ETF [ASCIZ /No END statement/] + +.SCALAR NEDCRL ; -1 => haven't yet supplied a CRLF at EOF of main file. + +IFN A1PSW,[ ; Holler "NED" if any of the following: +NEDT: SKIPL PRGC ; No end statements have been encountered + SKIPGE OUTC ; Output has occured not matched by an end statement + SKIPGE OUTN1 ; Output has occured other than in 1pass mode + TRNN FF,FRPSS2 ; Currently in pass 2 +LNEDT==.-NEDT ; Length of table +] + +SUBTTL ITS - Input file Open, buffer input +IFN ITSSW,[ + + ; Try .OPENing input file pointed to by F. Skips if successful. + ; Sets filenames to actual names. + +OPNRD1: SYSCAL OPEN,[[.BAI,,UTYIC] + $F6DEV(F) ? $F6FN1(F) ? $F6EXT(F) ? $F6DIR(F)] + JRST [ .STATUS UTYIC,IFSTS ; Lost, save status now before possible + POPJ P,] ; .IOPOP, and make failure return. + SYSCAL RFNAME,[%CLIMM,,UTYIC ; Now find true filenames. + MOVEM A + MOVEM C ; But need to check FN1, FN2 so + MOVEM D ; put them in ACs instead. + MOVEM $F6DIR(F)] + .LOSE %LSFIL + CAMN A,[SIXBIT/DSK/] + MOVE A,V.SITE ; Use machine name instead of DSK. + MOVEM A,$F6DEV(F) + CAIE C, ; If FN1 meaningless for device, skip to use + MOVEM C,$F6FN1(F) ; spec'd FN1 anyway, but else store actual FN1. + CAIE D, + MOVEM D,$F6FN2(F) ; Ditto for FN2. + MOVE D,[440600,,$F6FN2(F)] + SETZ A, +OPNRD7: TLNN D,770000 + JRST OPNRD6 + ILDB C,D ; Calculate version number as number from fn2. + CAIL C,'0 ; Ignore non-digits. + CAILE C,'9 + JRST OPNRD7 + IMULI A,10. + ADDI A,-'0(C) + JRST OPNRD7 + +OPNRD6: SKIPN A ; No digits in FN2 => use -1 as version. + SETO A, + MOVEM A,$FVERS(F) + MOVE A,IUREDP ; Set up reading ptr, + MOVEM A,UREDP + JRST OPNRD3 ; Set up ^C after buffer, infcur, etc. + + + ; EOFCH encountered on read, reload and jump back for next char + +INCHR3: HRRZ CH1,UREDP ; Get byte pointer + CAME CH1,UTIBED ; End of block? + RET ; No, ^C in file. + MOVE A,IUREDP + MOVEM A,UREDP + MOVE A,[-UTIBFL,,UTIBUF] + .IOT UTYIC,A ; Read in block + ANDI A,-1 + CAIN A,UTIBUF ; If the iot didn't give us anything, we are at EOF. + JRST RPAEOF + HRRZM A,UTIBED ; Store RH (updated pointer) for EOF check at INCHR3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ; Store a ^C after the data we read, so at EOB we come to INCHR3. + JRST RCHTRA ; Now try next char +] ;END IFN ITSSW + +SUBTTL DEC - Input file Open, buffer input + +IFN DECSW,[ + +OPNRD1: MOVEI C,UTIHDR ; Open the input file w/ names in dnam ... snam. + SETZ A, ; Mode ascii. + MOVEI D,UTIBUF + MOVE TT,UTICHN ; Get channel num. to use. + LSH TT,27 ; Put in ac field. + IOR TT,[OPEN A] + MOVE B,$F6DEV(F) + XCT TT ; Open channel,a + RET + CALL BUFINI ; Initialize the input buffers and header. + MOVE D,$F6DIR(F) + MOVE A,$F6FNM(F) + HLLZ B,$F6EXT(F) + TLC TT,(OPEN#LOOKUP) + XCT TT ; Lookup channel,a + RET ; Failed. +IFE SAILSW,[ + MOVE A,$F6DEV(F) + DEVNAM A, ; Get real name of device. + CAIA + MOVEM A,$F6DEV(F) +] + MOVE D,[440600,,$F6FN2(F)] + SETZ A, +OPNRD7: TLNN D,770000 + JRST OPNRD6 + ILDB C,D ; Calculate version number as number from fn2. + CAIL C,'0 ; Ignore non-digits. + CAILE C,'9 + JRST OPNRD7 + IMULI A,10. + ADDI A,-'0(C) + JRST OPNRD7 + +OPNRD6: SKIPN A ; No digits in FN2 => use -1 as version. + SETO A, + MOVEM A,$FVERS(F) + MOVE A,UREDP + JRST OPNRD3 + + + ; Reload buffer, DEC style. +INCHR3: HRRZ CH1,UREDP ; Is this ^C at end of buffer? + CAME CH1,UTIBED + RET ; No, ^C in file. + PUSH P,B + MOVE A,UTICHN + LSH A,27 ; Channel num. in ac fld. + TLO A,(IN) + XCT A ; Get next bufferfull. + CAIA ; Succeed. + JRST INCHR4 ; Error. +INCHR5: MOVE A,UTICNT + ADDI A,9 + IDIVI A,5 + ADD A,UREDP ; -> 1st wd not read into. + HRRZM A,UTIBED + HRRZ A,UREDP + AOS A + MOVEI B,1 ; Scan the file and replace all line numbers with nulls. +INCHR6: CAMN A,UTIBED + JRST INCHR7 + TDNE B,(A) + MOVEM B,(A) + AOJA A,INCHR6 + +INCHR7: MOVSI B,EOFCH_13 + MOVEM B,(A) ; Put EOF char after buffer, in extra word. + JRST RCHTRB ; Retry RCH. + +INCHR4: XOR A,[#IN] + XCT A + TRZE B,74^4 + ETR [ASCIZ /Input data error/] + XOR A,[#] + XCT A ; Clear error bits in status. + TRNN B,2^4 + JRST INCHR5 + JRST RPAEO1 ; EOF. + +; BUFINI - Create DEC-style buffer ring, with 1 extra word following +; each buffer... +; A/ +; B/ +; C/
+; D/ +; Note that this extra-word crock is necessary just so it can be filled +; with ^C's to stop read loop and switch to next buffer. + +BUFINI: MOVEI AA,A +IFE SAILSW,DEVSIZ AA, + SKIPA AA,[DECBFL+1] ; Default buffer size is that for dsk. + AOJLE AA,.-1 ; Get size including extra wd. + MOVEI T,1(D) ; Addr of wd 2 of 1st buffer. + HRLI AA,T ; @AA is addr of 2nd wd of next buffer. + SUBI D,(AA) ; Facilitate test for end of buffer space. + HRLI T,400000 + MOVEM T,(C) ; Header -> a buffer, sign set. + HRRM T,1(C) ; Make rh of bp -> buffer 1st wd. + MOVSI T,440000 ; Set up p-field of b.p. + IORM T,1(C) + HRRZ T,1(C) + AOS 1(C) + HRLI T,-3(AA) ; Data-area-size +1,,addr-of-2nd-wd +BUFIN1: CAIGE D,-UTIBFL(T) ; Room for another after this buffer? + JRST BUFIN2 ; No, wrap up. + MOVEM T,@AA ; Yes, make next buffer -> this one, + HRRI T,@AA ; Point to next one. + JRST BUFIN1 + +BUFIN2: ADDI D,1(AA) ; -> 2nd wd of 1st buffer. + MOVEM T,(D) ; 1st buffer -> last, making ring. + RET + +] ;END IFN DECSW, + +SUBTTL TNX - Input file Open, buffer input + +IFN TNXSW,[ + +; OPNRD1 - Open File for Reading. Old stuff assumed fnm in DNAM +; using UTYIC channel, but new should furnish arguments: +; F/ to open + +; Essentially just GTJFN and OPENF like OINIT does, with same +; sort of error handling, except that when reading from cmd line +; as opposed to .INSRT, just go back to get completely new command. +; (perhaps if typein is just CRLF, go to special TNX style cmd input?) + +OPNRD1: CAIN F,INFB ; Horrible kludge necessary because MIDAS main + ; level doesn't bother to explicitly close main + ; input file when pass 1 is done, and TNX barfs if + ; you try to re-open a JFN... sigh. + JRST [ SKIPN $FJFN(F) ; Main file. Already opened it? + JRST .+1 ; nope, get JFN & open normally. + IFE PMAPSW,[ ; Already open. If not mapping, reset read ptr. + SYSCAL SFPTR,[$FJFN(F) ? [0]][ERRCOD] + POPJ P,] + JRST OPNRD2] ; and avoid attempt to re-open the JFN. + SKIPN $FJFN(F) + JRST [ PUSHJ P,GETJFI ; No JFN, get one for input. + POPJ P, ; Could fail. + JRST .+1] + PUSH P,T ; Read access, full word input. + SYSCAL OPENF,[$FJFN(F) ? [440000,,OF%RD]][ERRCOD] + JRST [POP P,T ? POPJ P,] ; Failure + POP P,T +OPNRD2: HRRZ A,$FJFN(F) + MOVEM A,JFNCHS+UTYIC ; Indicate "channel" open with this JFN. + PUSHJ P,JFNSTB ; Get actual names/version #. + PUSHJ P,CVFSIX ; Put right stuff in $F6 entries. + MOVE A,IUREDP ; Opened, set up buffer. + MOVEM A,UREDP ; Initialize BP into buffer. +IFE PMAPSW, JRST OPNRD3 +IFN PMAPSW, JRST OPNR50 ; for PMAP hacking, lots of stuff to do. + + ; Get a JFN for current FILBLK (in F) and stick it into $FJFN(F). + ; A should hold flags in LH to use in 1st wd of block. + ; GETJFI - sets usual flags for input + ; GETJFO - sets " " output + ; GETJFN - takes whatever A holds. + +GETJFO: SKIPA A,[GJ%FOU+GJ%NEW] ; If hacking output, ask for new version. +GETJFI: MOVSI A,(GJ%OLD) ; If hacking input, file must exist. +GETJFN: PUSHJ P,TFMAP ; Stick filblk stuff into GTJFN scratch block. + PUSH P,R1 + PUSH P,R2 + MOVEI R1,GTJBLK + SETZ R2, + GTJFN + JRST [ MOVEM R1,ERRCOD ; failure, save error code. + JRST GETJF5] + HRRM R1,$FJFN(F) ; Win, save JFN. + AOS -2(P) +GETJF5: POP P,R2 ; Can't return in ACs cuz don't know what R1 etc are, + POP P,R1 ; and might clobber them here. + POPJ P, + +; TFMAP - Map Tenex filenames from filblk pointed to by F into +; standard scratch block for long-form GTJFN. +; A/ ,,0 ; flags will go into LH of .GJGEN. +; Clobbers only A. + +TFMAP: HRR A,$FVERS(F) ; Put version # in RH + SKIPE $FTEMP(F) ; If asking for temp file, + TLO A,(GJ%TMP) ; set appropriate flag. + MOVEM A,GTJBLK+.GJGEN +IRP FROM,,[$FDEV,$FDIR,$FNAME,$FTYPE,$FPROT,$FACCT,$FJFN]TO,,[.GJDEV,.GJDIR,.GJNAM,.GJEXT,.GJPRO,.GJACT,.GJJFN] + MOVE A,FROM(F) + MOVEM A,GTJBLK+TO +TERMIN + MOVE A,[.NULIO,,.NULIO] + MOVEM A,GTJBLK+.GJSRC ; Don't hack I/O in gtjfn. + POPJ P, + +.VECTOR GTJBLK(10.) ; Need exactly this many wds for non-extended long call + +IFE PMAPSW,[ + ; EOFCH seen in input, check it here. + +INCHR3: HRRZ CH1,UREDP ; Get byte pointer + CAME CH1,UTIBED ; End of block? + RET ; No, ^C in file. + MOVE A,IUREDP + MOVEM A,UREDP + PUSH P,T + SYSCAL SIN,[JFNCHS+UTYIC ? [444400,,UTIBUF] ? [-UTIBFL]][A ? A ? A] + POP P,T + ADDI A,UTIBUF+UTIBFL ; Get UTIBUF + <# bytes stored> + CAIG A,UTIBUF ; If the sin didn't give us anything, we are at eof. + JRST RPAEOF + HRRZM A,UTIBED ; Store rh (updated pointer) for eof check at inchr3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ; Store a ^c after the data we read + JRST RCHTRA ; Now try next character + +] ; IFE PMAPSW + +IFN PMAPSW,[ ; New stuff for PMAP'ing input etc. + +VBLK +IFNDEF NIBFPS,NIBFPS==10 ; # of pages per buffer +PGBFL==NIBFPS*1000 ; Length of a buffer in wds. +IFNDEF 1STBFP,1STBFP==500 ; # of first page to start buffers at. + +INBFPG: 1STBFP ; # of 1st buffer page (in our address space) +INFPAG: 0 ; # of page in file corresponding to 1st page in buffer. +INPGCT: 0 ; -# times to refill buffer with new pages. +INLPGS: 0 ; # pages to slurp on last refill (instead of NIBFPS) +UTIBPE: 0 ; BP to last byte of data in buffer (holding ^C) +UTIBPL: 0 ; BP to last byte position in buffer area (constant) +UTIBPX: 0 ; BP to last byte of data when last pages have been mapped. +INLCHR: 0 ; Place to save char that ^C replaces. If -1, no char. +;SOSSW: 0 ; non-Z if hacking SOS line-number type file. +FBBYV: 0 ; GTFDB dumps cruft in these two locs. +FBSIZ: 0 ; e.g. this gets size of file in bytes. +PBLK + + ; Wrap up open of an input file, by initializing all the cruft + ; above. +OPNR50: SYSCAL GTFDB,[$FJFN(F) ? [2,,.FBBYV] ? MOVEI FBBYV] + LDB C,[300600,,FBBYV] ; Get byte size of file + CAIN C, + MOVEI C,36. ; If 0 use 36-bit bytes (full wds) + MOVEI A,36. + IDIVI A,(C) ; Get bytes per wd, ignore remainder. + MOVE B,FBSIZ ; Now, with # bytes in file, + EXCH A,B + IDIVI A,(B) ; find <# in fil>/<# per wd> = # wds in file + CAIE B, ; Also hack + ADDI A,1 ; rounding up (gasp, wheeze, finally done.) + IDIVI A,PGBFL ; Now get # times buffer will need slurping... + ADDI A,1 ; And another for the final slurp (even if it will be empty) + MOVNM A,INPGCT ; Store -# slurps. + MOVEI A,777(B) + LSH A,-9. ; Find # pages last slurp really needs. + MOVEM A,INLPGS ; and store away. + HRLI B,010700 + MOVEM B,UTIBPX ; Store relative BP to last ch (when last pages mapped) + HRRI B,PGBFL-1 ; And relative BP to last char in whole buffer + MOVEM B,UTIBPL + MOVE A,INBFPG ; Find page # buffer starts at in core, + LSH A,9. ; Get address, and + ADDM A,UTIBPX ; add into the BP's to make them absolute. + ADDM A,UTIBPL + HRLI A,010700 ; also get initial read pointer from that. + SUBI A,1 ; MUST be "canonical form", so that SEMIC hackery + MOVEM A,IUREDP ; will work with weird way INCHR3 returns here. + MOVNI A,NIBFPS ; Use this as initial file page #, so the ADDB in + MOVEM A,INFPAG ; INCHR3 will do right thing to it. + MOVE A,[440700,,[EOFCH_35]] + MOVEM A,UREDP ; set up things so first RCH will instantly cause reload. + ILDB B,A + MOVEM A,UTIBPE + SETOM INLCHR ; Mustn't forget that we don't have a stored char yet. + JRST OPNRD4 ; Finally done with PMAP init stuff. + + ; Come here when hit ^C +INCHR3: MOVE CH1,UREDP ; Get current read ptr + CAME CH1,UTIBPE ; At end of buffer? + POPJ P, ; Nope, ^C in file, actual input. + AOSLE CH1,INPGCT ; Aha, end of buffer. Bump times refilled... + JRST [ SKIPGE A,INLCHR ; and if no more refills, see if last char left + JRST RPAEOF ; No? All done, true EOF. + SETOM INLCHR ; Almost, one last char. + MOVE CH1,UREDP ; Must bump ptr back one char, so next read + ADD CH1,[070000,,] ; will also stop. + CAIG CH1, + SUB CH1,[430000,,1] + MOVEM CH1,UREDP + JRST INCHR7] ; Return char in A. + MOVE A,IUREDP + MOVEM A,UREDP +IFN A-1,PUSH P,R1 +IFN A-2,PUSH P,R2 +IFN A-3,PUSH P,R3 + MOVEI R1,NIBFPS ; Get # of input buffer pages + ADDB R1,INFPAG ; and find current page in file to get + HRL R1,$FJFN+INFB ; current input file's JFN + MOVE R2,INBFPG ; and usual pointer to destination buffer page + HRLI R2,.FHSLF ; Why the fuck doesn't 10X default this?!?! + MOVEI R3,NIBFPS ; Set # pages to slurp up + CAIN CH1, ; But if this is last slurp, + MOVE R3,INLPGS ; use pre-calculated # to avoid non-ex pages. + JUMPE R3,INCH51 ; if an exact number of pages before, no new mapping + TLO R3,(PM%CNT+PM%RD+PM%CPY) ; Read access, copy-on-write. +INCH50: PMAP ; Gobble gobble + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI R3,-1(R3) ; Else, on 10X, must iterate manually. + TRNE R3,400000 ; See if became "negative". + JRST INCH51 ; Yep, done with manual iteration. + ADDI R2,1 ; Nope, bump page #'s. + AOJA R1,INCH50] +INCH51: +IFN A-3,POP P,R3 +IFN A-2,POP P,R2 +IFN A-1,POP P,R1 + CAIE CH1, ; Was this the last slurp? + SKIPA CH1,UTIBPL ; no, use BP to Last char at end of buffer. + MOVE CH1,UTIBPX ; yes, need BP to last char in last page. +IFN 0,[ SKIPE SOSSW ; If hacking line number lossage, + JRST [ MOVE A,(CH1) ; must beware of getting wiped, so have to + TRNE A,1 ; check here, and if depositing EOFCH in #, + HRLI CH1,350700 ; then move the EOFCH to beg of word! + JRST .+1] +] + LDB A,CH1 ; Replace last char of buffer's data + MOVEI CH2,EOFCH + DPB CH2,CH1 ; with the EOF char. + MOVEM CH1,UTIBPE ; Remember ptr to end of data, + EXCH A,INLCHR ; and save char for then, returning whatever + JUMPL A,RCHTRA ; was the last char of last bufferfull. + ; (may be -1, in which case RCHTRA tries again) + + ; Jump here to return a new char in A, something like + ; RCHTRA without all the fuss. +INCHR7: POP P,CH1 ; Get return addr + ANDI CH1,-1 + CAIE CH1,RREOF+1 + JRST -2(CH1) ; Note -2 not -3 as in RCHTRA! + JRST (CH1) ; Special hack since -2 loses for RREOF. + ; Perhaps someday it will win. +] ; IFN PMAPSW + +] ;END IFN TNXSW + +ifn 0,[ ; turn off but keep around for a while. +SUBTTL old .INSRT Processing + +; .INSRT ; Insert file here +; TTY: => ok, reads line at a time, rubout allowed within line +; Pushes macro expansion, other .INSRT's +; In filedescription, ^R => reset file name counter [?!? - KLH] +; If device is "@:", always ask for translation. + +A.INSR: NOVAL + MOVE A,[ISFB,,FB] ; Default names are those of spec'd input file + BLT A,FB+L$FBLK-1 ; Zap them into scratch filblk. + MOVEI F,FB ; And point at it. + MOVE A,FSDSK + MOVE B,FSTTY ; Compare "TTY" with + CAMN B,$FDEV(F) ; device name, and if identical, + MOVEM A,$FDEV(F) ; default to DSK. +IFE ITSSW,MOVE A,FSMID ; Always set default extension to "MID" or ">" +IFN ITSSW,MOVE A,FSGRTN + MOVEM A,$FEXT(F) + + TLO FF,FLUNRD +A.IN1: PUSHJ P,RFD ; Read file description + MOVE A,$FDEV(F) ; Get specified device name + CAME A,FSATSN ; Atsign? + PUSHJ P,A.ITRY ; No, try opening file + + ; If return, open failed. + MOVE A,$F6DEV(F) + AOJE A,A.INT1 ; Already trying to set up table entry + SKIPA F,[MAXIND,,TBLOFS] ; Atsign, or fnf, search table + +A.IN2: SUBI F,-L$FBLK ; Loop point searching table, increment to next entry, count down LH + CAMN F,INDDP ; Compare with pointer to top of table + JRST A.IN3 ; Agree => this file not in table + +; MOVEI A,-TBLOFS(F) ; Get index relative to table base. +; MIDAS complains "illegal use of relocation" when try to use above addr, so must use next 2 instructions instead - barf barf + MOVEI A,(F) + SUBI A,TBLOFS + + MOVSI B,-L$FBLK ; And index into FB. + MOVE T,TBLSFS(A) ; Get specification name this entry +A.IN25: CAMN T,FB(B) ; Compare with that just specified + AOBJN B,[AOJA A,.-2] ; Check all names this entry +IFE TNXSW, JUMPL B,A.IN2 +IFN TNXSW,[JUMPL B,[ MOVEI C,(B) + CAIN C,$FJFN ; One item of entry didn7t match, was it JFN? + JRST A.IN25 ; Yes, ignore it and continue. + JRST A.IN2] ; Sigh, was something else, entry doesn't match. + ] + + ; File is in table + MOVSI A,(F) ; Move description from TBLOFS to FB. + HRRI A,FB + BLT A,FB+L$FBLK-1 +IFN TNXSW, SETZM FB+$FJFN ; Since re-opening, must zap previous JFN. + PUSHJ P,A.ITRY ; Try opening file + + ; If return, open failed. + MOVSI A,TBLSFS-TBLOFS(F) ; Set up LH(BLT pointer), + HRRI A,FB + BLT A,FB+L$FBLK-1 ; Unmap to original names(TBLSFS to FB) + PUSHJ P,TYPFB ; Type out specified names + TYPE " -> " ; Type out pointer + MOVSI A,(F) ; Copy translation (TBLOFS entry) back to FB. + HRRI A,FB + BLT A,FB+L$FBLK-1 + SETOM $F6DEV(F) ; "half-kill" entry in TBLOFS + +A.INT1: PUSH P,F + MOVEI F,FB + PUSHJ P,IOPNER ; Open lost, type out cruft + POP P,F + TYPE "Use what filename instead? " +A.INT2: PUSHJ P,GTYIP ; Prepare to read one line from tty + JRST A.IN1 ; Try again with what he types in + + ; File not in table, try to add a translation for it. + +A.IN3: TLNN F,-1 ; More room for another entry in table? + ETF [ASCIZ /Too many @: files/] + MOVEI A,TBLSFS-TBLOFS(F) ; Copy FB into TBLSFS (specified name) + HRLI A,FB + BLT A,TBLSFS-TBLOFS+L$FBLK-1(F) + SETOM $F6DEV(F) ; Document fact that entry has only key, not translation + MOVNI A,-L$FBLK + ADDM A,INDDP ; Update pointer into table + MOVE A,FB+$FDEV ; Get specified device name + CAME A,FSATSN ; Atsign? + JRST A.INT1 ; No, type out garbage and try again, reading from tty + MOVE A,ISFB+$FDEV ; Yes, clobber from input device name + MOVEM A,FB+$FDEV + JRST A.INT2 + +;TRY OPENING INPUT FILE FOR .INSRT, RETURN IF UNSUCCESSFUL + +A.ITRY: MOVE A,FB+$FDEV ; Get specified device name + CAMN A,FSTTY ; TTY? + JRST A.ITRT ; Yes, treat special + TLO FF,FLUNRD + PUSHJ P,IPUSH ; Save current status + PUSH P,F ; save what F points at + MOVEI F,FB + PUSHJ P,OPNRD1 + JRST [POP P,F ? JRST IPOPL] ; Lose, pop and return + POP P,F + MOVE B,[FB,,INFB] ; Kludge for time being - if win, + BLT B,INFB+L$FBLK-1 ; Copy all stuff into INFB. +IFN ITSSW,CALL SETWH2 + MOVE B,ITTYP + MOVEI A,-2-TYPDEL(B) ; + HRLI A,IFNM1 + BLT A,-TYPDEL(B) ; Introduce hysteresis so .INSRT'ing file can reference .IFNM1, .IFNM2 +IFN CREFSW,[ + SKIPE CRFONP ; If creffing, output push-file block. + PUSHJ P,CRFPSH ; (pop-file block output at ipop) +] +A.ITR2: + MOVE A,$F6DEV(F) ; Push successful, now check to see if table entry should be finished + AOJN A,ASSEM1 + MOVEI A,(F) ; Move FB into TBLOFS as translation entry. + HRLI A,FB + BLT A,L$FBLK-1(F) + JRST ASSEM1 ; Now assemble from file (ASSEM1 clobbers pdl) + + ; .INSRT TTY: + +A.ITRT: PUSHJ P,GTYIPA ; Read from tty, don't quit until .INEOF + JRST A.ITR2 ; Fall back in (doesn't touch .IFNM1, .IFNM2) +] ; end IFN 0 + +SUBTTL .INSRT Processing + +; .INSRT ; Insert file here +; TTY: => ok, reads line at a time, rubout allowed within line +; Pushes macro expansion, other .INSRT's +; If device is "@:", always ask for translation. + +A.INSR: NOVAL + + ; First set up defaults for parsing filename. + BLTM L$FBLK,ISFB,FB ; Default names are those of spec'd input file, + MOVEI F,FB ; stuffed into scratch FB. + MOVE A,FSDSK + MOVE B,FSTTY ; Compare "TTY" with + CAMN B,$FDEV(F) ; device name, and if identical, + MOVEM A,$FDEV(F) ; default to DSK. +IFE ITSSW,MOVE A,FSMID ; Always set default extension to "MID" or ">" +IFN ITSSW,MOVE A,FSGRTN + MOVEM A,$FEXT(F) + + TLO FF,FLUNRD + PUSHJ P,RFD ; Read file description from current input. + MOVE A,$FDEV(F) ; Get specified device name + CAMN A,FSATSN ; Atsign? + JRST A.IN50 ; If so, check out translation right away. + +A.IN2: CAMN A,FSTTY ; TTY? Must handle specially. + JRST [ PUSHJ P,GTYIPA ; Set up to read until .INEOF or EOF char. + JRST ASSEM1] ; And don't do anything to .IFNM1/2, etc. + PUSHJ P,IPUSH ; File, push the world. + PUSHJ P,OPNRD1 ; Try opening file. + JRST [ PUSHJ P,IPOPL ; Sigh, failed, pop world back and go + JRST A.IN50] ; try translation entries or TTY input. + ; Always jumps back to A.IN2. + + ; Come here when input file successfully opened. Clean up etc. + BLTM L$FBLK,(F),INFB ; Move current filespec to INFB, +IFN ITSSW,CALL SETWH2 + MOVE B,ITTYP + BLTM 3,IFNM1,-2-TYPDEL(B) ; Copy new .IFNM1, .IFNM2 onto stack, + ; to clobber .IFNM1/2 for previous file, so + ; that .IFNM1/2 etc refers to last file .INSRT'd by + ; current file (or current file if none .INSRT'd yet) +IFN CREFSW,[ + SKIPE CRFONP ; If creffing, output a push-file block. + PUSHJ P,CRFPSH ; (pop-file block is output at IPOP) + ] + + JRST ASSEM1 ; and jump off to smash things to toplevel. + + ; Come here when open attempt fails or @: device specified. +A.IN50: CAIE F,FB ; Tried translations yet? + JRST A.IN60 ; Yes, skip table hacking and go get fnm from TTY. + + ; First open attempt, so OK to search translation table. + SKIPA D,[MAXIND,,TBLOFS] ; Load up aobjn-style index to transl table +A.IN52: SUBI D,-L$FBLK ; Loop point for searching table - increment to next entry, count down LH + CAMN D,INDDP ; Compare with pointer to top of table + JRST A.IN60 ; Agree => this file not in table, get from TTY. + + MOVEI A,(D) ; Get scratch index into tables, + HRLI A,-L$FBLK ; making AOBJN of it, + MOVEI B,(F) ; and get index into current FB. +A.IN54: MOVE C,TBLSFS-TBLOFS(A) ; Get a specification name for this entry +IFN TNXSW,CAIE B,$FJFN(F) ; (ignoring the JFN item, for TENEX) + CAMN C,(B) ; Compare name with that of failed filblk. + AOBJN A,[AOJA B,A.IN54] ; Check all names this entry + JUMPL A,A.IN52 ; If not found, try next entry. + + ; File is in table, try opening it using TBLOFS description. + MOVE F,D ; Replace old F by ptr to winning TBLOFS entry. +IFN TNXSW, SETZM $FJFN(F) ; Since re-opening, must zap any previous JFN. + JRST A.IN2 ; Jump off to try opening. + + ; Come here when open failed and no matching transl entry. + ; Must set up to gobble down a translation from TTY... +A.IN60: TYPE "Error in .INSRT; " + CAIE F,FB ; Were we trying to open a translated entry? + JRST [ PUSHJ P,TYPFB ; Yes, so print out appropriate info + TYPE " -> " ; to show translated stuff. + JRST A.IN70] + + ; First time, no translation entry exists, make one. + MOVE A,INDDP ; Get current pointer to top of tables + TLNN A,-1 ; Room for more? + JRST A.IN70 ; Nope, can't remember transl, but get right fnm anyway. + MOVE F,A ; Yep, use it as pointer to table entry to use. + SUBI A,-L$FBLK ; and get new table-top pointer with clever + MOVEM A,INDDP ; SOS of LH and ADDI to RH. + BLTM L$FBLK,FB,(F) ; Move FB contents to both TBLOFS, + BLTM L$FBLK,FB,TBLSFS-TBLOFS(F) ; and TBLSFS. + +A.IN70: ; Print out filename F points to, & err msg. +IFN TNXSW,[ + PUSHJ P,OPNER1 + PUSHJ P,RDJFNI ; On 10X, get new filename this way. + ] +IFN ITSSW\DECSW,[ ; Elsewhere do it painful way. + PUSHJ P,IOPNER + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Setup to read 1 line from TTY, + PUSHJ P,RFD ; and do it, parsing filename. +] + JRST A.IN2 ; now go try opening it. + +SUBTTL Misc. .INSRT-related things + + ; .INEOF - EOF pseudo + +A.IEF2: PUSHJ P,PMACP ; Loop point, pop entry off macro pdl +A.INEO: TLNE FF,FLMAC ; Inputting from macro? + JRST A.IEF2 ; Yes, pop it off + PUSH P,CMACCR ; Back to inputting from file or tty, cause return to maccr + MOVE B,ITTYP ; Get pdl pointer + POPJ B, ; Return to pop routine + + + ; Call from ERRH; type input file's names if changed since last err msg. +ERRTFL: MOVE C,INFCUR + EXCH C,INFERR ; Say last error msg in this file. + CAMN C,INFERR ; If prev. msg was in other file, + POPJ P, + PUSH P,F + MOVEI F,INFB ; Point to current input file, + PUSHJ P,TYPFB ; and type out its filename. + POP P,F + PJRST CRRERR + +SUBTTL COMMON IO PDL routines for input. (.INSRT support) + +;IO PDL ROUTINES FOR INPUT FILE +; Push the input file + +IPUSH: AOSN CMEOF ; Want to pop out of tty? (^C typed in) + CALL POPTT ; Yes, do now before forget. + +IFE PMAPSW,[ + MOVE D,UREDP ; Get input byte pointer +IFN ITSSW\TNXSW,[ +IFN ITSSW, .IOPUS UTYIC, +IFN TNXSW, MOVEI A,UTYIC ? PUSHJ P,$IOPUSH + TLNN D,760000 ; At end of word? + ADD D,[430000,,1] ; Yes, make it point to beginning of next word + MOVEM D,UREDP + MOVNI A,-2(D) + ADD A,UTIBED ; Get # wds we'll need in MACTAB. + HLR D,UTIBED ; Remember whether EOF on last .IOT. + HRRZS UTIBED ; Now clear out left half for following +] +IFN DECSW,[ + AOS A,UTICHN ; Do ".IOPUSH" - use next channel. + LSH A,27 + ADD A,[WAIT-<0 1,>] ; Construct a WAIT uuo for the current input channel. + MOVE C,RCHMOD ; We mustn't copy the buffers while I/O is going on. + CAMN A,[WAIT UTYIC,] ; But: if we are currently in the top-level input file + CAIE C,3 ; And it is device TTY:, this channel was never opened. + XCT A ; Don't move buffers while io going on! + MOVEI A,UTIBFL+2 ; Assume must save all buffer space. +] + PUSH P,A + ADD A,FREPTB + ANDI A,-1 + PUSH P,A + CAML A,MACTND ; No room in MACTAB => gc it. + CALL GCA1 + REST A + CAML A,MACTND ; Did the GC win? + PUSHJ P,GCCORQ ; NO!! Try to win somehow + MOVEI A,370 + CALL PUTREL ; Indicate start of saved buffer. + REST A + AOS B,FREPTB + SUBI A,1 + MOVE C,ITTYP ; Get addr of tty pdl wd that'll point to saved buffer. + ADDI C,1 + HRRZM C,(B) ; Store in rh of 1st wd, + MOVEI C,(B) ; Remember addr of saved buffer to push on ttypdl. + HRLM A,(B) ; Put length in lh. + AOS B +IFN ITSSW\TNXSW,HRL B,UREDP ; LH <- addr of 1st wd to save. +IFN DECSW,HRLI B,UTIBUF + ADDI A,-2(B) ; Addr of last wd to blt into. + BLT B,(A) + HRLI A,041000 + MOVEM A,FREPTB ; Make free bp -> last byte just used. + SUB A,MACTAD + ANDI A,-1 + LSH A,2 + ADDI A,4 ; Get char addr of next free byte. + MOVEM A,FREEPT +] +IFN PMAPSW, CALL IOBPUS + + MOVE B,ITTYP ; Get local version of iopdl +IPSHP: +IFE PMAPSW, PUSH B,C ; Push -> saved buffer (GC will relocate) +IFN DECSW,PUSH B,UTIBED ? PUSH B,UTIHDR +REPEAT L$FBLK, PUSH B,INFB+.RPCNT ; Save names of input file. + PUSH B,INFCUR ; Save number of input file. +IFE PMAPSW, PUSH B,D ; Lh=lh(old uredp), rh=lh(old utibed) (or just UREDP) +IFN PMAPSW, INSIRP PUSH B,[INFPAG INPGCT INLPGS UTIBPE UTIBPL UTIBPX INLCHR UREDP IUREDP ] + + ; Following three must be last pushed + INSIRP PUSH B,[IFNM1 IFNM2 IFVRS] ; Clobbered on pdl if .open successful +INPDEL==.-IPSHP ; Length of each entry on pdl + + MOVE A,FREEPT ; W must use same gc convention as putrel; + CAML A,MACHI ; Namely, gc after using up the last byte. + CALL GCA1 + MOVEI A,0 ; => input from file + MOVEM B,ITTYP ; Store back updated pointer + JSP B,PUSHTT ; Save stuff, address modify and return + + + ; Pop into the input file +IPOP: +IFN CREFSW,[ MOVEI A,2 ; If creffing, output pop-file block. + SKIPE CRFONP + PUSHJ P,CRFOUT] +IPOPL: PUSHJ P,POPTT ; Come here if .INSRT's open failed. + PUSH P,C + MOVE B,ITTYP ; Get pointer + INSIRP POP B,[IFVRS IFNM2 IFNM1] ; Pop stuff +IFE PMAPSW, POP B,A ; Pop off UREDP (or halves thereof) +IFN PMAPSW, INSIRP POP B,[ IUREDP UREDP INLCHR UTIBPX UTIBPL UTIBPE INLPGS INPGCT INFPAG] + POP B,INFCUR +REPEAT L$FBLK,POP B,INFB+L$FBLK-1-.RPCNT +IFN DECSW,[ + POP B,C + PUSH P,C ; Old UTIHDR + POP B,UTIBED +] +IFE PMAPSW, POP B,C + MOVEM B,ITTYP ; Save updated pdl pointer. +IFE PMAPSW,[ + HLRZ B,(C) ; Get length of saved buffer, +IFN ITSSW\TNXSW,[ + PUSH P,A +IFN ITSSW, CALL SETWH2 ? .IOPOP UTYIC, +IFN TNXSW, MOVEI A,UTYIC ? CALL $IOPOP + REST A + MOVEI AA,UTIBUF-1(B) ; Get addr of 1st wd won't blt into in utibuf, + HRLI AA,(A) ; Get saved lh of utibed, + MOVEM AA,UTIBED + HRRI A,UTIBUF ; Make A -> 1st wd in buffer, +] +IFN DECSW,[ + MOVE AA,UTICHN + LSH AA,27 + IOR AA,[RELEAS] + XCT AA ; This code equivalent to .IOPOP. + SOS UTICHN + REST UTIHDR +] + MOVEM A,UREDP + MOVSI A,EOFCH_13 + MOVEM A,@UTIBED ; Put EOF char after buffer. + MOVSI A,1(C) ; Get addr of 1st data wd of saved buffer, + HRRI A,UTIBUF + CAIE B,1 + BLT A,UTIBUF-2(B) + HLLZS (C) ; Tell GC to reclaim saved buffer. +] ;IFE PMAPSW + +IFN PMAPSW, CALL IOBPOP + +POPCJ: REST C + RET + +;SAVE INTERNAL POINTERS CONCERNING INPUT MODE + +TYPDEL==2 ; Number of words in relevant pdl entry + +PUSHTT: PUSH P,A + PUSH P,F + AOSN CMEOF ; If supposed to pop out of tty soon, + CALL POPTT ; Do it now before cmeof clobbered. + MOVE F,ITTYP ; Get relevant pdl pointer + MOVEI A,0 + EXCH A,CLNN ; Set up new line number + HRL A,CPGN ; Save current page number + SETZM CPGN ; Now re-initialize + SKIPGE CRFILE ; Save cref-all-on-one-line flag. + TLO A,400000 + PUSH F,A ; Save cpgn,,clnn + MOVE A,-1(P) ; Retrieve new mode + PUSHJ P,PSHLMB ; Save limbo1 and set up instructions for new mode +IFN ITSSW,[ + CALL SETWH2 + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ; Store back updated pointer + JRST POPFAJ + + ; Restore internal pointers concerning input mode + +POPTT: PUSH P,A + PUSH P,F + MOVE F,ITTYP ; Get pdl pointer + PUSHJ P,POPLMB ; Pop into limbo1, set up new mode + POP F,A ; Get cpgn,,clnn + SETZM CRFILE ; Restore all-on-one-line flag. + TLZE A,400000 + SETOM CRFILE + HLRZM A,CPGN + HRRZM A,CLNN +IFN ITSSW,[ + CALL SETWH2 + ADD A,CPGN + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ; Store back updated pointer + JRST POPFAJ + +IFN ITSSW,[ +SETWH2: MOVE A,RCHMOD + CAIL A,2 + SKIPA A,[SIXBIT /TTY:/] + MOVE A,INFB+$F6FN1 + .SUSET [.SWHO2,,A] + MOVE A,A.PASS + LSH A,30 + ADD A,[SIXBIT /P0/+1] + RET +] + +SUBTTL Storage for IO PDL stuff + + ; IO PDL storage stuff + +VBLK +TYPDLS==TYPDLC*TYPDEL+INPDEL*MX.INS + ; "tty pdl", stores information about current input mode + ; (similar to macro pdl but not garbage collected) + +ITTYP: -TYPDLS-1,,TTYPDL ; Pdl pointer (typdel=length of each entry) +TTYPDL: NEDCHK ; Actual pdl: initial entry to overpop routine + BLOCK TYPDLS ; Pdl proper +PBLK + +SUBTTL TNX - IO PDL Routines (IOPDLC, $IOPUSH, $IOPOP) + +IFN TNXSW,[ + +IFN PMAPSW,[ + ; Push IO buffer & channel... +IOBPUS: PUSH P,A + MOVEI A,UTYIC + CALL $IOPUSH + MOVEI A,NIBFPS ; Point at next set of buffer pages. + ADDM A,INBFPG + POP P,A + POPJ P, + + ; Pop IO buffer & channel... +IOBPOP: PUSH P,A + MOVE A,INBFPG + HRLI A,NIBFPS + CALL DELPGS ; flush buffer pages. + MOVNI A,NIBFPS + ADDM A,INBFPG ; point down at previous set of buffer pages... + MOVEI A,UTYIC + CALL $IOPOP + POP P,A + POPJ P, + +; DELPGS - Take arg in A as <# pgs>,, and flush these pages. + +DELPGS: PUSH P,A + PUSH P,B + HLRZ B,A + HRLI A,.FHSLF ; ,, + TLO B,(PM%CNT) + PUSH P,T +DELPG2: SYSCAL PMAP,[[-1] ? A ? B][A ? A ? B] ; Free up buffer pages. + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI B,-1(B) ; Else, on 10X, must iterate manually. + TRNE B,400000 ; See if became "negative". + JRST .+1 ; Yep, done with manual iteration. + AOJA A,DELPG2] ; Nope, bump page #'s. + POP P,T + POP P,B + POP P,A + POPJ P, +] ;IFN PMAPSW + +; IOPDLC - Clear IOPDL stack, close all channels on it. +; Clobbers no ACs + +; for 10x, need to CLOSF and release each JFN on IOPDL stack. + +IOPDLC: PUSH P,R1 +IFE R1-A,.ERR IOPDLC WONT WORK WITH A=1 +IFN PMAPSW,[ + MOVEI R1,1STBFP ; Reset to point at 1st page of buffer space. + MOVEM R1,INBFPG +] + EXCH A,IOPDLP + JRST IOPDC3 +IOPDC2: MOVE R1,(A) + CAME R1,ISFB+$FJFN ; Dont close main input file + CLOSF + JFCL + SUB A,[1,,1] +IOPDC3: CAMLE A,[-LIOPDL,,$IOPDL-1] + JRST IOPDC2 + EXCH A,IOPDLP + POP P,R1 + POPJ P, + +; $IOPUSH - Push I/O channel in A onto $IOPDL stack. +; Clobbers no ACs +; for 10X this means storing JFN on stack and clearing JFNCHS table entry. + +$IOPUSH:EXCH B,IOPDLP ; Get stack pointer + PUSH B,JFNCHS(A) ; save JFN for channel + EXCH B,IOPDLP + SETZM JFNCHS(A) ; Zap entry in channel table to make it look gone + POPJ P, + +; $IOPOP - Pops channel off $IOPDL into channel # in A. +; Clobbers no ACs + +; for 10X just pop $IOPDL into JFNCHS, must close and release old JFN tho. + +$IOPOP: PUSH P,T + SYSCAL CLOSF,[JFNCHS(A)] + JFCL + POP P,T + EXCH B,IOPDLP ; Get stack ptr + POP B,JFNCHS(A) + EXCH B,IOPDLP + POPJ P, + +VBLK +JFNCHS: BLOCK 20 ; Channel table index, JFNCHS(ch) gets JFN for chan. + ; (zero if none) +LIOPDL==8. ; Length of IO PDL +IOPDLP: -LIOPDL,,$IOPDL-1 +$IOPDL: BLOCK LIOPDL +PBLK +] ; IFN TNXSW + +SUBTTL DEC - IO PDL Routines (IOPDLC) + +IFN DECSW,[ + +; IOPDLC - Simulate ITS .IOPDL call. Flushes all channels from +; UTICHN downwards to UTYIC. Actually not a simulation but something +; that works in the particular situation for which MIDAS uses .IOPDL. + +IOPDLC: MOVEI A,UTYIC + EXCH A,UTICHN ; Set input chnl num. to lowest. + LSH A,27 + IOR A,[RELEAS] ; Set up to releas the highest in use first. +IOPDL1: XCT A ; Releas one input channel, + CAMN A,[RELEAS UTYIC,] + RET ; All done. + SUB A,[0 1,] + JRST IOPDL1 ; Releas the next one down. +] ;IFN DECSW + +SUBTTL COMMON TTY input routines & variables + +VBLK +CMBUF: BLOCK CMBFL ; Typein buffer (also used as JCL buffer) +CMPTR: 0 ; Byte pointer to CMBUF. +CMEOF: 0 ; -1 => POPTT instead of reloading after this bufferfull. +TTYOPF: 0 ; -1 => the TTY is already open. +LINEL: 0 ; Width of TTY (may be 1,, meaning assume infinite). +A.TTYFLG: ; Value of .TTYFLG pseudo - another label for TTYFLG. +TTYFLG: 0 ; TTY typeout permitted iff >= 0. +WSWCNT: 0 ; The number of W-switches in the last cmd string. +TTYBRF: 0 ; -1 => ^H break has been requested but not yet done. +PBLK + ; Cause input from tty (main routines) + +GTYIPA: SETZM A.TTYF ; Push to tty, don't stop at cr. + +IFN ITSSW, TYPECR "TTY: .INSRTed, end input with ^C" +IFN DECSW\TNXSW,[ + IFE SAILSW,TYPECR "TTY: .INSRTed, end input with ^Z" + IFN SAILSW,TYPECR "TTY: .INSRTed, end input with CTL-META-LF" + ] + +GTYIP1: SKIPA A,[3] +GTYIP: MOVEI A,2 ; Input from tty, stop after 1 line. + SETZM CMPTR ; Force reload on 1st read. + JSP B,PUSHTT ; Set up variables and return +GTYIPR: SETZM CMPTR ; Return on .ineof or cr + JRST POPTT + + ; Call here from ASSEM1 loop when a ^H interrupt is detected. +TTYBRK: SETZM A.TTYF + ETR [ASCIZ/^H - break /] ; Type filename, page and line #. + SKIPE ASMOUT + TYPECR "within a <>, () or []" + JRST GTYIPA + + ; RCHSET routines for reading from TTY + ; RCHMOD=3 => don't quit on CR + ; 2 => quit on CR. +RCHTRC: +RCHARC: TLO FF,FLTTY ; Set flag + JSP A,CPOPJ +RCHAC1: REPEAT 2,[ ; RCH2, RR1 + ILDB A,CMPTR ; Get char + CAIN A,0 ; End of string marked with 0 + PUSHJ P,TYRLDR ; Reload, jump back for next char +] + HALT ; RRL1 +IFN .-RCHAC1-RCHPSN,.ERR RCHAC1 LOSES. + ILDB A,CMPTR ; SEMIC + CAIN A,15 + JRST SEMICR + JUMPN A,SEMIC + PUSHJ P,TYRLD + JRST SEMIC + +TYRLD: MOVEI A,3 ; Return after the call, not before. + ADDM A,(P) + + ; TYRLDR - Read in string. + ; Reload buffer if ran out in call to RCH. + +TYRLDR: AOSN CMEOF ; EOF detected after last reload => + JRST RPAEOF ; Pop out of tty. + PUSH P,A + PUSH P,B + MOVE B,RCHMOD + PUSH P,F + PUSH P,A.TTYF ; If chars rubbed out they should be printed. + SETZM A.TTYF + MOVE F,[10700,,CMBUF-1] ; Initial byte pointer to buffer + MOVEM F,CMPTR ; Store as byte pointer for read +TYRLD2: PUSHJ P,TYI ; Get character +IFN TNXSW,[ + CAMN F,CMPTR ; at beg of line? + CAIE A,^J ; and char is LF? + CAIA + JRST TYRLD2 ; If so then ignore it completely. +] + CAIN A,177 ; Rubout? + JRST TYRLD3 ; Yes + CAIE A,^C + CAIN A,^Z + JRST TYRLD7 ; ^C, ^Z => EOF. Ought to be EOFCH for consistency? + CAIN A,^U + JRST TYRLD5 ; Rub out all + CAIE B,2 ; For .TTYMAC handling, convert lower case to upper. + JRST TYRLD6 + CAIL A,"A+40 + CAILE A,"Z+40 + CAIA + SUBI A,40 +TYRLD6: CAME F,[010700,,CMBUF+CMBFL-2] + IDPB A,F ; Store character in buffer unless buffer nearly full. + CAIE A,^M ; CR? + JRST TYRLD2 ; No, go back for next + CAIN B,2 ; .TTYMAC (mode 2) => CR ends input, so fake EOF. + SETOM CMEOF + MOVEI A,^J ; Follow the CR with a LF. + IDPB A,F + PUSH P,F ; Output the entire line to the error file + MOVE F,[10700,,CMBUF-1] +TYRLD8: CAMN F,(P) + JRST TYRLD9 + ILDB A,F + CAIN A,^M ; If line was ended by a ^C or ^Z, put that in error + SKIPL CMEOF ; file, which needs hair since that char is not + JRST TYRLD0 ; In the string we stored. + MOVEI A,"^ + CALL ERRCHR +IFN ITSSW,MOVEI A,"C +IFN DECSW\TNXSW,MOVEI A,"Z + CALL ERRCHR + LDB A,F +TYRLD0: CALL ERRCHR + JRST TYRLD8 + +TYRLD9: REST F + MOVEI A,0 + IDPB A,F ; Mark end of string + IDPB A,F + REST A.TTYF + REST F + REST B + REST A + JRST RCHTRA + +TYRLD7: SETOM CMEOF ; ^C, ^Z force EOF, + CALL TYRLCR ; After turning into ^M. + MOVEI A,^M + JRST TYRLD6 + +TYRLCR: MOVEI A,^M + CALL TYOX + MOVEI A,^J + JRST TYOX + +TYRLD3: CAMN F,[10700,,CMBUF-1] ; Rubout, beginning of buffer? + JRST TYRLD4 ; Yes + LDB A,F ; Get last character in buffer + CALL TYOX ; Type it out, don't write in error file. + ADD F,[70000,,] ; Decrement pointer + JUMPGE F,TYRLD2 ; Jump if valid + SUB F,[430000,,1] ; Was 440700,,something, back it up + JRST TYRLD2 + +TYRLD5: MOVE F,[10700,,CMBUF-1] ; ^U, back to beginning of line +TYRLD4: PUSHJ P,TYRLCR ; Rubout when at beginning of buffer, type CR + JRST TYRLD2 + +SUBTTL ITS - TTY routines (TYOX, TYI, TTYINI) and JCLINI. + +IFN ITSSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOPF + CALL TTYINI + .IOT TYOC,A + POPJ P, + + ; TYI - Get (just typed in) char in A +TYI: SKIPN TTYOPF + CALL TTYINI ; Open the tty if not already done. + .IOT TYIC,A + ANDI A,-1 ; Non-tty devices can return -1,,3. + JUMPE A,TYI + CAIN A,^L ; This must be assuming that ^L clears screen? + JRST TYI + POPJ P, + + ; Initialize tty +TTYINI: PUSH P,A + .OPEN TYIC,[.UAI,,'TTY] ; Input + .LOSE + .OPEN TYOC,[%TJDIS+.UAO,,'TTY] ; Display mode output + .LOSE + SYSCAL CNSGET,[1000,,TYOC ? 2000,,A ? 2000,,A] + MOVSI A,1 ; TTY: is translated to something else => assume infinite linel + MOVEM A,LINEL ; Else linel gets width of tty. + SETOM TTYOPF ; Say the tty is now open. + JRST POPAJ + +JCLINI: SETZM CMPTR + .SUSET [.ROPTIO,,A] + TLNN A,%OPCMD ; Has our superior said it has a cmd? + RET ; No. + BLTZ CMBFL-1,CMBUF ; Zero all but last word, + SETOM CMBUF+CMBFL-1 ; and ensure last word non-zero. + .BREAK 12,[5,,CMBUF] ; Try to read command string. + MOVE A,[440700,,CMBUF] + SKIPE CMBUF ; If read a cmd-string, + MOVEM A,CMPTR ; Tell TYRLD, GO2A it's there. + POPJ P, + +]; END IFN ITSSW + +SUBTTL TNX - TTY routines (TYOX, TYI, TTYINI) and JCLINI + +IFN TNXSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOPF + CALL TTYINI +IFN A-1,EXCH A,R1 + PBOUT +IFN A-1,EXCH A,R1 + POPJ P, + + ; TYI - Get (just typed in) char in A + ; There is a screw for 20X in that it's not really possible + ; to know if the system is going to feed you a CR-LF + ; or just a CR; TYRLD2 checks for that, by flushing LF's, but + ; this would be the place to check if it were easy to do. +TYI: SKIPN TTYOPF + CALL TTYINI ; Open the tty if not already done. +IFN A-1,EXCH R1,A + PBIN ; Get char into AC 1 + JUMPE R1,.-1 ; Ignore nulls. + TLNE FF,FL20X ; Cretinous differences between 10X/20X + JRST TYI2 ; 20X, skip EOL check. + CAIN R1,^_ ; On 10X, CR turned into ^_ (EOL); change it back. + MOVEI R1,^M +TYI2: +IFN A-1,EXCH R1,A ; Restore everything to right place if necessary. + POPJ P, + + ; TTYINI - Initialize tty + +TTYINI: PUSH P,A + PUSH P,T + SYSCAL RFMOD,[[.PRIIN]][A ? A] + POP P,T + HLRZS A + ANDI A,177 ; Terminal width + CAIGE A,30. ; If too low, + ADDI A,128. ; Assume twenex crockishness + MOVEM A,LINEL ; Linel gets width of tty. + SETOM TTYOPF ; Say the tty is now open. + POP P,A + POPJ P, + + ; Read "JCL" - RSCAN buffer or nnnMID.TMP file (from CCL) + +JCLINI: SETZM CMPTR + SKIPE CCLFLG ; Started at CCL location? + JRST JCLIN5 ; Yep, go snarf stuff specially. + TLNN FF,FL20X ; Is this Tenex? + JRST [ MOVEI R1,.PRIIN + BKJFN ; see what previous character was + POPJ P,; *Gasp* + PBIN + CAIE R1,^_ ; Tenex newline? + SETOM CMPTR ; No, set flag saying "TTY but no prompt" + POPJ P,]; and skip the Twenex hackery below + SETZ R1, ; If not, check RSCAN. + RSCAN ; See if have anything in RSCAN buffer. + POPJ P, ; Huh? Shouldn't happen, but ignore it. + JUMPLE R1,APOPJ ; Also return if char cnt says nothing there. + MOVNI R3,(R1) ; Aha, set up cnt for SIN + HRROI R2,CMBUF + MOVEI R1,.CTTRM ; Now ready for business... + SIN + LDB R1,R2 ; Now examine wages thereof + CAIE R1,^M ; Last char CR? + JRST [ MOVEI R1,^M + IDPB R1,R2 ; If not, make it so. + JRST .+1] + SETZ R1, + IDPB R1,R2 ; Must also ensure ASCIZ. + MOVE B,[440700,,CMBUF] ; If the rescan line starts with "RUN ", skip that. +IRPC X,,[RUN ] + ILDB A,B + CAIE A,"X + JRST JCLIN4 +TERMIN + CAIA +JCLIN4: MOVE B,[440700,,CMBUF] ; Now flush the name of the file MIDAS was run from. + ILDB A,B + CAILE A,40 + JRST .-2 ; Flush until random ctl seen (space, ^M) + CAIE A,40 ; If it wasn't a space, + POPJ P, ; then forget about the whole thing. +JCLIN3: MOVE C,B ; Now flush spaces. Save last ptr for chars. + ILDB A,B + CAIN A,40 + JRST JCLIN3 + CAIN A,^M ; And is first non-space something besides CR? + POPJ P, ; Bah, there wasn't anything in the JCL!! + MOVEM C,CMPTR ; Else save ptr to start of real goods. + POPJ P, + + ; TNX snarf of CCL file. No such thing as tmpcor, so just + ; look for real file with appropriate name. +JCLIN5: SETZM CCLFLG ; Want 0 in case abort out, will reset if win. + GJINF ; Get job # in R3 + HRROI R1,CMBUF ; Use CMBUF to form filename string. + MOVEI R2,(R3) + MOVE R3,[NO%LFL+NO%ZRO+<3_18.>+10.] + NOUT ; ship out job num in 3 digits, radix 10. + HALT + HRROI R2,[ASCIZ /MID.TMP/] + SETZ R3, + SOUT ; Flesh out rest of filename string. + SETZ R2, ; Make sure it's ASCIZ. + BOUT + MOVE R1,[GJ%OLD+GJ%SHT] ; Use short-form GTJFN + HRROI R2,CMBUF ; and gobble name from CMBUF. + GTJFN + POPJ P, ; If failed, forget it. + MOVE R2,[070000,,OF%RD] ; Read 7-bit bytes + OPENF + POPJ P, ; Bah + HRROI R2,CMBUF ; Gobble stuff up. + MOVEI R3,CMBFL*5 ; Read until buffer full, + MOVEI R4,^J ; or LF seen. + SIN + JUMPLE R3,APOPJ ; Forget it if too big for buffer!! + + MOVE R2,[440700,,CMBUF] ; Aha, we've got something, so set + MOVEM R2,CMPTR ; pointer to slurped stuff. + SETOM CCLFLG + HRROI R2,UTIBUF ; Slurp rest into larger buffer, + MOVNI R3,UTIBFL*5 ; using count only. + SIN + JUMPGE R3,APOPJ ; Refuse to hack grossly large file. + ADDI R3,UTIBFL*5 + JUMPLE R3,APOPJ ; if nothing read, need write nothing out. + HRLI R1,(CO%NRJ) ; Don't release JFN, + CLOSF ; but stop reading from file. + POPJ P, + MOVE R2,[070000,,OF%WR] ; Now try to hack write access. + OPENF + POPJ P, + MOVE R2,R1 ; Source becomes destination... + HRROI R1,UTIBUF ; and UTIBUF becomes source, + MOVNS R3 ; for just as many bytes as were read. + SOUT + MOVEI R1,(R2) ; done, now just close file. + CLOSF ; (this time, release JFN). + POPJ P, + SETOM CCLMOR ; say that more CCL remains. + POPJ P, +] ; END IFN TNXSW + +SUBTTL DEC - TTY routines (TYOX, TYI, TTYINI) + +IFN DECSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOPF + CALL TTYINI + OUTCHR A + POPJ P, + + ; TYI - Get a typed-in char in A + +TYI: SKIPN TTYOPF ; Open the tty, if not already done. + CALL TTYINI + INCHWL A +IFN SAILSW,[ + CAIN A,612 ; On SAIL, EOF is 612, + MOVEI A,^Z ; so turn into normal EOF if found. +] + CAIE A,^M ; Throw away the LF after a CR. + RET + INCHWL A + MOVEI A,^M ; Note that TYRLDR will put it back in. + RET + +TTYINI: INSIRP PUSH P,AA A B +IFE SAILSW,[ + PJOB A, + TRMNO. A, + JRST TTYIN1 + MOVEI AA,1012 ; .TOWID + MOVE B,[2,,AA] + TRMOP. B, ; Read width of tty line into B. +] +TTYIN1: MOVEI B,80. ; TRMOP. failed or not tried => assume width is 80. + MOVEM B,LINEL + INSIRP POP P,B A AA + SETOM TTYOPF + RET + + TMPLOC .JBREN, TTYREN +TTYREN: SETOM TTYBRF ; "REENTER" command comes here +R: G: JRST @.JBOPC ; To request a ^H-break. Note crufty labels pointing here. + +];IFN DECSW + +SUBTTL DEC Hackery for JCLINI - Read CCL commands. + +IFN DECSW\TNXSW,[ +VBLK +CCLFLG: 0 ; Flag to indicate CCL entry from COMPIL, SNAIL, CCL, or EXEC +CCLMOR: 0 ; -1 => There are more lines of CCL commands, + ; so do a RUN SYS:MIDAS when finished. +PBLK +] + +IFN DECSW,[ ; DEC only hacks CCL as "JCL". + +.SCALAR CCLFIL ; Saves FN1 for tmp file hacking. + +; Read MID temp core file, if that loses, try nnnMID.TMP file. +; Clobbers A,B,C,D. + +JCLINI: SETZM CMPTR + SKIPN CCLFLG ; Was midas called from CCL level? + RET ; No, do not snarf tempcore + SETZM CCLFIL ; No CCL file yet + SETZM CCLFLG ; If tmpcor loses want this 0 (will re-setom below) + BLTZ CMBFL,CMBUF ; Zero cmd buffer. + MOVE A,[2,,['MID,, ? -,,CMBUF-1]] ; read (leave last wd 0) + TMPCOR A, ; Read compil-generated command + JRST [ OPEN [17 ? 'DSK,, ? 0] ; No tempcore, maybe try dump mode. + RET ; Argh but let something else die + PJOB A, ; Get job # + IDIVI A,100. ; Want decimal job number in sixbit + ADDI A,'0 + LSH A,6 + IDIVI B,10. + ADDI A,'0(B) + LSH A,6 + ADDI A,'0(C) + LSH A,18. + HRRI A,'MID ; Form file name as nnnMID.TMP + MOVEM A,CCLFIL ; Save for writing below + MOVSI B,'TMP + SETZB C,D ; No protect or ppn trash + LOOKUP A ; Try to get file + RET ; Give up + MOVE A,[-,,CMBUF-1] + SETZ B, + INPUT A ; Try to read command + SETZB A,B + RENAME A ; Try to delete it now + JFCL ; Ignore failure + CLOSE ; Happy sail + JRST .+1] + SKIPN CMBUF ; One last check for it to be there + RET ; Alas, there is none + MOVE A,[440700,,CMBUF] ; Load a byte pointer to the command + SETOM CCLFLG + MOVEM A,CMPTR ; There is, set command pointer +JCLIN1: ILDB B,A + CAIE B,^J ; See if our command file has anything after 1st line. + JRST JCLIN1 + ILDB B,A + JUMPE B,JCLIN3 + SETOM CCLMOR ; It does; set flag so after handling 1st line we'll + MOVE C,[440700,,UTIBUF+2] +JCLIN2: IDPB B,C + ILDB B,A + JUMPN B,JCLIN2 + SUBI C,UTIBUF+1 ; Get # words written in utibuf. operand is relocatable! + HRLOI C,-1(C) ; These 2 insns turn size into -size,,utibuf+1 + EQVI C,UTIBUF+1 + MOVEM C,UTIBUF+1 + SKIPE A,CCLFIL ; Was this called with a temp file? + JRST [ MOVSI B,'TMP + SETZB C,D + ENTER A ; Try to re-write file + RET ; Sigh + MOVE A,UTIBUF+1 + SETZ B, + OUTPUT A + RELEASE + RET] + MOVSI C,'MID + MOVEM C,UTIBUF + MOVE C,[3,,UTIBUF] + TMPCOR C, + JFCL ; [KLH - there used to be some random cruft here.] +JCLIN3: RET + +] ;END IFN DECSW + +SUBTTL Old Command Line Reader (CMD) +ifn 0,[ + ; Read command & filenames & hack defaulting. + +CMD: SKIPE CMPTR ; Unless have DDT or RSCAN cmd string, + JRST CMD06 ; (we don't) + CALL CRR ; type a CRLF, prompt etc. +CMD05: SETZM CMPTR + TYPE "*" +CMD06: MOVEI A,3 ; Read from TTY (or string <- cmptr) + CALL RCHSET + MOVEI F,FB ; Point to scratch filblk. + BLTZ L$FBLK,FB ; and clear the whole thing. + TRO FF,FRCMND ; Tell RFD it's scanning a command line. + CALL RFD ; Now see if command null, and whether has _. +IFN DECSW\TNXSW,[ + CAIN A,"! ; If terminator was "!", go run program. + JRST RFDRUN +] + TRNN FF,FRNNUL ; If no filespec was seen, + CAIE A,^M ; and terminator is EOL, + CAIA + JRST CMD05 ; then prompt again and get another string. + TRZ FF,FRARRO ; Got something, clear saw-"_" flag. +CMD07: CAIN A,"_ + TRO FF,FRARRO ; FRARRO will be on if there's a "_" in string. + CAIN A,^M + JRST CMD1 ; Read thru the whole command. + CALL RFD + JRST CMD07 + + ; Now re-read the string, for real this time. Previous scan was + ; mainly just to see if "_" existed. If not, then first filename + ; must be input file, and output filenames are all defaulted. +CMD1: MOVE T,[440700,,CMBUF] ; Restore original ptr to + MOVEM T,CMPTR ; beginning of string. +IFN CREFSW,SETZM CREFP ; Clear all switches before decoding them. +INSIRP SETZM 0,ERRFP TTYINS WSWCNT +IFN LISTSW,[ + SETZM LISTP + SETOM LISTP1 ; Will be AOSed by each (L) switch. +] + + MOVE T,FSDSK + MOVEM T,$FDEV(F) +IFE TNXSW,[MOVE T,RSYSNM ? MOVEM T,$FDIR(F)] +IFN TNXSW, SETZM $FDIR(F) + SETZM $FNAME(F) + SETZM $FEXT(F) + + TRZ FF,FRNNUL + TRNE FF,FRARRO ; Don't gobble input spec as output! + CALL RFD ; Read bin file spec. + MOVE TT,FF ; Remember whether null + BLTMAC T,L$FBLK,(F),OUTFB ; Copy from scratch to OUTFB. + + MOVE T,$FDEV(F) + CAMN T,FSNUL + MOVE T,FSDSK + MOVEM T,$FDEV(F) +IFE ITSSW, MOVE T,FSCRF +IFN ITSSW, MOVE T,FSCREF + MOVEM T,$FEXT(F) + + TRNN FF,FRARRO ; If "_" doesn't exist in cmd line, + MOVEI A,"_ ; then only filespec is for input, kludge to get it. + CAIN A,"_ ; If "_" exists in cmd line, did we hit it? + JRST CMD2 ; Ran out of output specs => just use defaults. + CALL RFD ; Read cref file spec. +IFN CREFSW,[ + TRNN FF,FRNNUL ; If spec not null or ended by _, + CAIN A,"_ + SETOM CREFP ; We must want to cref. +CMD2: BLTMAC T,L$FBLK,(F),CRFFB ; Copy specs from FB to CREF FB. +] +IFE CREFSW,CMD2: + MOVE T,FSERR + MOVEM T,$FEXT(F) + CAIN A,"_ + JRST CMD6 ; No more output specs. + CALL RFD ; Read error file sppec. +IFN ERRSW,[ + TRNN FF,FRNNUL ; Nonnull spec or last spec => + CAIN A,"_ + SETOM ERRFP ; Must want an error file. +CMD6: BLTMAC T,L$FBLK,(F),ERRFB ; Copy specs from FB to ERR filblk. +] +IFE ERRSW,CMD6: +IFN LISTSW,[ +IFE ITSSW, MOVE T,FSLST +IFN ITSSW, MOVE T,FSLIST + MOVEM T,$FEXT(F) + CAIN A,"_ ; Any output spec remaining? + JRST CMD3 + CALL RFD ; Yes, read one. + SETOM LISTP ; List spec given implies want listing. +CMD3: BLTMAC T,L$FBLK,(F),LSTFB ; Copy specs from FB to LST filblk. +] + +CMD5: CAIN A,"_ + JRST CMD4 + CALL RFD ; Ignore any output specs not needed. + JRST CMD5 + +CMD4: MOVE T,FSDSK ; Default the input names. + MOVE A,$FDEV(F) + CAME A,FSPTP ; Don't leave dev name set to common out-only devs. + CAMN A,FSNUL + MOVEM T,$FDEV(F) +IFE ITSSW, MOVE T,FSMID +IFN ITSSW, MOVE T,FSGRTN ; > on ITS. + MOVEM T,$FEXT(F) + MOVE T,FSPROG + SKIPN $FNAME(F) ; The fn1 alone is sticky across the _. + MOVEM T,$FNAME(F) + + TRZ FF,FRARRO ; If only 1 name it should be FNAM1. + CALL RFD ; Read input spec. + BLTMAC T,L$FBLK,(F),ISFB ; Copy into specified-input filblk. + MOVE T,$FNAME(F) ; Default output FN1's to input. + SKIPN OUTFB+$FNAME + MOVEM T,OUTFB+$FNAME +IFN CREFSW,[ + SKIPN CRFFB+$FNAME + MOVEM T,CRFFB+$FNAME +] +IFN LISTSW,[ + SKIPN LSTFB+$FNAME + MOVEM T,LSTFB+$FNAME +] +IFN ERRSW,[ + SKIPN ERRFB+$FNAME + MOVEM T,ERRFB+$FNAME +] + MOVE A,FSNUL ; The output dev defaults to NUL: + MOVE T,$FDEV(F) ; If the input is from TTY: + CAMN T,FSTTY + TRNE FF,FRNNUL ; And the bin spec was null. + CAIA + MOVEM A,OUTFB+$FDEV + TRZ FF,FRARRO ; Don't louse up .INSRT's reading. + RET +] ;ifn 0 + +SUBTTL Command Line Reader (CMD) + + ; CMD - Read command & filenames & hack defaulting. + +.SCALAR CMDPSV ; Saves read ptr into CMBUF, for re-scanning. + +CMD: SKIPE T,CMPTR ; If we have DDT or RSCAN or CCL string, + JRST CMD06 ; go hack it without typing anything out. + CAMN T,[-1] ; If Tenex-type "JCL", normal TTY input 'cept no prompt + JRST CMD06X + CALL CRR ; Nope, must type a CRLF, prompt etc. +CMD05: TYPE "*" +CMD06X: SETZB T,CMPTR +CMD06: MOVEM T,CMDPSV ; Save pointer for later restoration + MOVEI A,3 ; Read from TTY (or string <- cmptr) + CALL RCHSET + + MOVEI F,ISFB ; Point to input-spec filblk. + BLTZ L$FBLK,(F) ; Zap it through and through. + TRO FF,FRCMND ; Tell RFD it's scanning a command line. + CALL RFD ; Now see if command null, and whether has _. +IFN DECSW\TNXSW,[ + CAIN A,"! ; If terminator was "!", go run program. + JRST RFDRUN +] + TRNN FF,FRNNUL ; If no filespec was seen, + CAIE A,^M ; and terminator is EOL, + CAIA + JRST CMD05 ; then prompt again and get another string. + TRZA FF,FRARRO ; Got something, clear saw-"_" flag. +CMD07: CALL RFD + CAIN A,"_ + JRST [ TRO FF,FRARRO ; FRARRO will be on if there's a "_" in string. + CALL RFD ; Gobble next filename, input filespec. + JRST CMD1] + CAIE A,^M + JRST CMD07 ; Read thru the whole command until read input filespec + + + ; Now re-read the string, for real this time. Previous scan was + ; mainly to latch onto input filespec and see if "_" existed. + +CMD1: SKIPN T,CMDPSV ; Restore original ptr if there's one, + MOVE T,[440700,,CMBUF] ; else point at beg of buffer. + MOVEM T,CMPTR + SETZM TTYINS ? SETZM WSWCNT ; Clear all switches. +IFN CREFSW,SETZM CREFP +IFN ERRSW, SETZM ERRFP +IFN LISTSW,SETZM LISTP ? SETOM LISTP1 ; Will be AOSed by each (L) switch. + SETZ A, + TRNN FF,FRARRO ; If "_" doesn't exist in cmd line, + MOVEI A,"_ ; then only filespec is for input, kludge to get it. + + MOVEI F,OUTFB + BLTZAC T,L$FBLK,(F) ; Clear output filblk. + MOVE T,FSDSK ; Default dev to DSK. + MOVEM T,$FDEV(F) + SKIPN T,$FNAME+ISFB ; Now default FN1 from input filespec + MOVE T,FSPROG ; (use "PROG" if none) + MOVEM T,$FNAME(F) +IFE TNXSW,[MOVE T,RSYSNM ; Now default directory if need to + MOVEM T,$FDIR(F)] + + TRZ FF,FRNNUL + CAIE A,"_ ; If it exists, + CALL RFD ; Read bin file spec. + TRNN FF,FRNNUL ; If spec was null, + JRST [ MOVE T,FSTTY ; and input spec was TTY:, + CAME T,$FDEV+ISFB + JRST .+1 + MOVE T,FSNUL ; then set device to NUL:. + MOVEM T,$FDEV(F) + JRST .+1] + +DEFINE CFMAC SWIT,PTR,INSTR,DEXT +IFN SWIT,[ + MOVE T,DEXT + MOVE TT,[[INSTR],,PTR] +] .ELSE SETZB T,TT + PUSHJ P,CMDFGT +TERMIN + + CFMAC CREFSW,CRFFB,[SETOM CREFP][IFN ITSSW,[FSCREF] .ELSE FSCRF] + + CFMAC ERRSW, ERRFB,[SETOM ERRFP] FSERR + + CFMAC LISTSW,LSTFB,[SETOM LISTP][IFN ITSSW,[FSLIST] .ELSE FSLST] + +CMD50: CAIE A,"_ + JRST [ SETZB T,TT ; Point to scratch FB etc. + CALL CMDFGT ; Ignore any output specs not needed. + JRST CMD50] ; Must do this way to retain default stuffs. + + ; Finally read input file. + BLTMAC T,L$FBLK,(F),ISFB ; Copy last stuff to input spec + MOVEI F,ISFB ; and point at it. + PUSHJ P,CMDDVX ; Hack device-name default. +IFE ITSSW, MOVE T,FSMID +IFN ITSSW, MOVE T,FSGRTN ; > on ITS. + MOVEM T,$FEXT(F) + CALL RFD ; Read input spec. + RET ; Yep, that's really all! + + ; TT has ,, + ; T has default $FEXT. + ; Takes defaults from current F, sets F to new filblk. +CMDFGT: JUMPE TT,[SETZ T, ; If 0, do usual but into oblivion (scratch FB) + MOVE TT,[[JFCL],,FB] + JRST .+1] + BLTMAC B,L$FBLK,(F),(TT) ; Copy from current filblk to new. + MOVE F,TT ; set new F. + MOVEM T,$FEXT(F) ; Set default $FEXT + PUSHJ P,CMDDVX ; Set up device, defaulting to DSK. + CAIN A,"_ ; If last delimiter was start of input spec, + POPJ P, ; don't read anything - just use defaults. + PUSHJ P,RFD + TRNN FF,FRNNUL ; If spec non-null or + CAIN A,"_ ; ended by _, then + CAIA ; hack specified instr. + POPJ P, + HLRZ T,F + XCT (T) + POPJ P, + +CMDDVX: SKIPN T,$FDEV(F) + MOVE T,FSDSK + CAME T,FSPTP + CAMN T,FSNUL + MOVE T,FSDSK + MOVEM T,$FDEV(F) + POPJ P, + +SUBTTL ITS/DEC Filename Reader/printer (RFD, TYPFB) + +IFN DECSW\ITSSW,[ ; Begin moby conditional for sixbit reader. + +; RFD - Reads a single file description from .INSRT or command line, +; using RCH, into specified FILBLK. +; F points at FILBLK to store description in. +; Implements crufty ^R hack (if see ^R, act as if just starting to +; read filename, so effect is stuff before ^R has set defaults.) +; If FRCMND set, recognize -, comma, / and ( as special characters, +; and hack switches. +; Sets FRNNUL if spec was nonnull. +; Clobbers A,B,C only. + +RFD: TRZ FF,FRNNUL +RFD01: SETZM RFDCNT ; Zero cnt of "normal" filenames. Jump here if see ^R. + +RFD10: PUSHJ P,GPASST ; Flush out spaces/tabs + TRNN FF,FRCMND ; If parsing command line, + CAIE A,"; ; or if char isn't semi-colon, + JRST RFD22 ; just handle normally. +RFD15: PUSHJ P,RCH ; Semi-colon and not command line!! Flush rest + CAIE A,^M ; of line, assuming it's a comment! + JRST RFD15 + POPJ P, + +RFD2: PUSHJ P,RCH ; Get character in A +RFD20: CAIE A,40 ; Space (Come here to scan already-read char.) + CAIN A,^I ; or tab? + JRST RFD10 ; Ach, go into flush-whitespace loop. +RFD22: CAIN A,^M ; End of line? + POPJ P, ; If so, obviously done. + CAIN A,^R ; Crufty ^R hack? + JRST RFD01 ; Sigh, pretend just starting to read filename. + TRNN FF,FRCMND ; Reading command line? + JRST RFD40 ; Nope, skip over cmnd-line frobs. + + ; Reading cmd line, test special chars. +IFN ITSSW\SAILSW, CAIN A," ; SAIL underscore, ITS backarrow like _. + .ELSE CAIN A,"= ; Either gets munged, + MOVEI A,"_ ; into canonical "_". + CAIE A,"_ ; Backarrow is output_input marker. + CAIN A,", ; Comma is also a terminator... + POPJ P, +IFN DECSW\TNXSW,[ ; I'm not sure if this belongs here, but + CAIN A,"! .SEE RFDRUN + POPJ P, +] + PUSHJ P,CMDSW ; Check for switches... + JRST RFD20 ; Got some, scan next char (returned by CMDSW) + ; Got none, drop thru. + + + ; No special delimiters, + ; Check for chars which signal what following word is. +RFD40: +IFN DECSW,[ + CAIN A,"[ ;] Left bracket signals start of PPN. + JRST [ PUSHJ P,RFDPPN ; Slurp it up, + MOVEM C,$F6DIR(F) ; store it, + TRO FF,FRNNUL ; saying spec not null. + JRST RFD20] ; and go process leftover delimiter. + + CAIN A,". ; Period signals start of extension. + JRST [ PUSHJ P,RCH ; Get the next character + PUSHJ P,RFDW ; Read in a word. + MOVEM C,$F6EXT(F) ; Store it... + TRO FF,FRNNUL ; and say spec non-null (even if C/ 0) + JRST RFD20] ; and process delimiting char. +] + + ; Here, char doesn't signal the start of anything, so we'll assume + ; it's the start of a name. + PUSHJ P,RFDW ; Gobble up a word. + JUMPE C,RFD2 ; If nothing was read, must ignore char; get another. + + ; Aha, name was read, now examine delimiter to see if it specifies + ; anything we know about. + TRO FF,FRNNUL ; Set flag saying spec non-null. + CAIN A,": ; If colon... + JRST [ MOVEM C,$F6DEV(F) ; Then store name as device. + JRST RFD2] ; and flush delimiter. +IFN ITSSW,[ + CAIN A,"; ; If semicolon... + JRST [ MOVEM C,$F6DIR(F) ; Then store name as directory (sname) + JRST RFD2] ; and flush delimiter. +] + ; Whatever it is, at this point delimiter doesn't signify anything + ; special in terms of what the name is. So we just store it, using + ; the usual FN1 FN2 DEV DIR sequence, and hand delimiter off to + ; the prefix scanning stuff. + MOVE B,RFDCNT ; Get current count for random names. + XCT RFDTAB(B) ; Either MOVEM C, to right place, or ignore + AOS RFDCNT ; by skipping over this instr. + JRST RFD20 ; and go examine delimiter. + + +.SCALAR RFDCNT ; Count to index RFDTAB by. + +RFDTAB: MOVEM C,$F6FNM(F) ; 1st name. + MOVEM C,$F6EXT(F) ; 2nd name. + MOVEM C,$F6DEV(F) ; 3rd name is dev. + MOVEM C,$F6DIR(F) ; 4th is sname. + CAIA ; 5th and on ignored, don't incr. cnt. + +; RFDW - Reads a "word" - any string of contiguous SIXBIT chars, +; barring certain delimiters, and leaves SIXBIT result in C. +; Begins reading with char currently in A. Returns with delimiter +; char in A (it's possible this can be the same char!) +; Clobbers B. + +RFDW: SETZ C, ; First things first, zap result. + SKIPA B,[440600,,C] +RFDW2: PUSHJ P,RCH + CAIN A,^Q ; Is char the quoter char? + JRST [ PUSHJ P,RCH ; Yup, gobble next... + CAIN A,^M ; and accept anything but CR + POPJ P, ; since that terminates the whole line. + JRST RFDW7] ; OK, go stuff the char into C. + CAIE A,40 ; Space + CAIN A,^I ; or tab + POPJ P, ; is always a break. + CAIN A,^M ; As is CR. + POPJ P, + TRNN FF,FRCMND ; And certain chars are bummers when reading cmd. + JRST RFDW4 + CAIE A,"/ + CAIN A,"( + POPJ P, +IFN DECSW\TNXSW, CAIE A,"= + CAIN A,"_ + POPJ P, +IFN ITSSW\SAILSW, CAIE A," + CAIN A,", + POPJ P, +IFN DECSW\TNXSW,[ + CAIN A,"! + POPJ P, +] + ; Not reading cmd line, or no cmd-line type chars seen. +RFDW4: +IFN ITSSW,[ + CAIE A,": ; For ITS filenames, these chars are special. + CAIN A,"; + POPJ P, +] +IFN DECSW,[ + CAIL A,140 ; For DEC, allow only alphanumeric. + SUBI A,40 ; cvt to uppercase, then + CAIL A,"A ; see if alpha. + CAILE A,"Z + JRST [CAIL A,"0 ; Nope, see if numeric. + CAILE A,"9 + POPJ P, ; Not alphanumeric, assume delimiter. + JRST .+1] +] +RFDW7: TLNN B,770000 ; Enough room in C for another char? + JRST RFDW2 ; Nope, ignore it and get next. + CAIL A,140 ; Enuf room, cvt lower to uppercase + SUBI A,40 + SUBI A,40 ; and cvt to sixbit, + IDPB A,B ; and deposit. + JRST RFDW2 ; Get another. + +] ; END IFN DECSW\ITSSW + +IFN DECSW,[ ; PPN Reader + +RFDPPN: PUSHJ P,RFDOCT ; Read project num, +IFN CMUSW, JUMPE C,RCMUPP ; At CMU watch for our funny ppns + HRLM C,(P) + PUSHJ P,RFDOCT ; Read programmer num. + HLL C,(P) + POPJ P, + +IFE SAILSW,RFDOCL=="0 ? RFDOCH=="8 ; Read octal numbers. +IFN SAILSW,RFDOCL==40 ? RFDOCH==140 ; Read sixbit (right-justified). + +RFDOCT: SETZ C, ; Read octal num, return in C. +RFDOC1: PUSHJ P,RCH + CAIL A,140 + SUBI A,40 +IFN SAILSW,[ ;[ ; Even if reading sixbit names (for SAIL), + CAIE A,", ; Comma and closebracket are still special. + CAIN A,"] + POPJ P, +] + CAIL A,RFDOCL + CAIL A,RFDOCH + POPJ P, ; Not octal or not 6bit, return. + IMULI C,RFDOCH-RFDOCL + ADDI C,-RFDOCL(A) + JRST RFDOC1 + +IFN CMUSW,[ ; [ +RCMUPP: CAIN A,"] ; Watch out for [] + POPJ P, +REPEAT 4, SETZM PPNBUF+.RPCNT + MOVE C,[440700,,PPNBUF] +RCMUPL: CAIE A,^M ; Don't look too far + SKIPE PPNBUF+3 + JRST RCMUPD + IDPB A,C + PUSHJ P,RCH ; [ + CAIE A,"] + JRST RCMUPL +RCMUPD: MOVE A,[C,,PPNBUF] + CMUDEC A, + SETZ C, + POPJ P, + +.VECTOR PPNBUF(4) ; Storage to buffer up a string for CMUDEC uuo to scan. + +] ;IFN CMUSW +] ;IFN DECSW + +IFN DECSW\ITSSW,[ + +; TYPFB - Type out current filblk (what F points at) as file specification +; Clobbers A,B,C + +TYPFB: MOVSI C,-3-ITSSW + HRR C,F +TYPF1: MOVE B,$F6DEV(C) ; Get next name + PUSHJ P,SIXTYO ; Type out name + HLRZ A,C + MOVE A,FILSPC+3+ITSSW(A) ; Now get delimiting character + PUSHJ P,TYOERR ; Type out + AOBJN C,TYPF1 ; Loop for all names +IFN ITSSW, POPJ P, +IFN DECSW,[ + SKIPN B,$F6DEV(C) ; On DEC system PPN is a special case + POPJ P, + MOVEI A,"[ ;] + CALL TYOERR +IFN CMUSW,[ + MOVE A,[B,,PPNBUF] + DECCMU A, + JRST OCTPPN + TYPR PPNBUF + JRST PPNRB + ] +IFE SAILSW,[ +OCTPPN: HLRZ B,$F6DEV(C) ; LH is proj, + CALL OCTPNT + ] +.ELSE [ HLLZ B,$F6DEV(C) + CALL SIXTYO +] + MOVEI A,", + CALL TYOERR +IFE SAILSW,[ + HRRZ B,$F6DEV(C) + CALL OCTPNT ; RH is prog. +] +.ELSE [ HRLZ B,$F6DEV(C) + CALL SIXTYO + ] +PPNRB: ; [ + MOVEI A,"] + JRST TYOERR +];IFN DECSW + +FILSPC: ": +IFN ITSSW, 40 ? 40 ? "; +IFN DECSW, ". ? 0 + +] ; END IFN DECSW\ITSSW + +SUBTTL Command switches + +; CMDSW - Hacks either a single switch or switch list; A should +; contain "/ for the former, "( for the latter. +; Returns in A next char after switch hackery done. This may be ^M. +; Skip returns if neither "/ nor "( was furnished to it. + +CMDSW: CAIN A,"/ ; Single switch? + JRST [ PUSHJ P,RCH ; Get next char + CAIN A,^M + POPJ P, + PUSHJ P,CMDSW1 + PJRST RCH] + CAIE A,"( ; Switch list? + JRST POPJ1 ; Neither slash nor paren, make skip return. +CMDSWL: PUSHJ P,RCH + CAIN A,^M + POPJ P, + CAIN A,") + PJRST RCH + PUSHJ P,CMDSW1 + JRST CMDSWL + + ; Command switch processing. CMDSW1 processes the switch char + ; in A. +CMDSW1: CAIL A,140 ; Lower case to upper. + SUBI A,40 + CAIN A,"T + SOS TTYINS ; Count # T-switches. + + CAIN A,"W ; W - prevent tty messages, and +IFE ERRSW,AOS WSWCNT ; request error output file if possible. +.ELSE [ + AOSA WSWCNT + CAIN A,"E ; E - request error log file. + SETOM ERRFP + ] + +IFN CREFSW,[ + CAIN A,"C ; C - request CREF output. + SETOM CREFP + ] + +IFN LISTSW,[ + CAIE A,"L ; L - request listing + POPJ P, + SETOM LISTP ; Say want listing. + AOS LISTP1 ; (starts as -1, will be positive after 2nd (L)) + ] + + POPJ P, + +SUBTTL TENEX Filename Reader/printer (RFD, TYPFB) + +IFN TNXSW,[ ; Moby conditional for Tenex reader. + +; TNXRFD - TENEX-style Filename Reader. +; Takes input from RCH, +; Deposits name strings into filblk F points to. +; Clobbers A,B,C,D, (and AA,T,TT due to FNCHK) +; Uses FRFEXT flag to see if already read extension (type) or not. +; Refuses to accept existing defaults for version, ;T, account, +; protection, or JFN. It will also zap an existing directory +; default if a device is specified, and vice versa. This is so that +; logical names will win a little better. +; Implements crufty ^R hack (if see ^R, act as if just starting to +; read filename, so effect is stuff before ^R has set defaults.) + +IFNDEF FRFDEV,FRFDEV==2 ; Set if read device. +IFNDEF FRFDIR,FRFDIR==1 ; Set if read directory. +IFNDEF FRFEXT,FRFEXT==FRFN1 ; Borrow this bit. Set if read extension. + +RFD: TRZ FF,FRNNUL + SETZM $FJFN(F) ; Zap JFN since the filename we'll read won't match it. + SETZM $FACCT(F) ; Also zap other things that we don't want defaulted. + SETZM $FPROT(F) + SETZM $FTEMP(F) + SETZM $FVERS(F) +TRFD01: TRZ FF,FRFEXT+FRFDEV+FRFDIR ; Jump here if ^R seen. +TRFD10: PUSHJ P,GPASST ; remove tabs, spaces and get first non-tab/space + TRNN FF,FRCMND ; If parsing command line, + CAIE A,"; ; or if char isn't semicolon, + JRST TRFD21 ; just handle normally. +TRFD15: PUSHJ P,RCH ; Semi-colon and not command line, it's a comment! + CAIE A,^M ; So flush rest, up to EOL. + JRST TRFD15 + POPJ P, + +TRFD1: TLO FF,FLUNRD ; come here to re-read last char +TRFD2: PUSHJ P,RCH ; Get char +TRFD21: CAIE A,40 ; Space? (come here to scan already-read char) + CAIN A,^I ; or tab? + JRST [TRNE FF,FRCMND ; Space/tab, if reading command line + JRST TRFD2 ; then ignore and continue scanning (for switches), but + JRST TRFD15] ; if not in cmd line, go flush entire rest of line! + CAIN A,^M ; End of line? + POPJ P, ; If so, obviously done. + CAIN A,^R ; Crufty ^R hack? + JRST TRFD01 ; Sigh, pretend starting over. + TRNN FF,FRCMND ; Must we check for cmd line frobs? + JRST TRFD22 ; Nope, skip them. + + ; Must check for chars special only in command line. + CAIN A,"= + MOVEI A,"_ + CAIE A,"_ ; backarrow is filename terminator... + CAIN A,", ; as is comma. + POPJ P, + CAIN A,"! ; For CCL hacking... + POPJ P, .SEE RFDRUN + PUSHJ P,CMDSW ; Check for switches... + JRST TRFD21 ; got some, process next char (returned by CMDSW) + ; Skips if none, drop thru. + + ; Now see if char signifies start of anything in particular. +TRFD22: CAIE A,"< ; Start of directory name? + JRST TRFD24 ; No + PUSHJ P,RCH + PUSHJ P,TRFDW ; Read word, starting with next char +TRFD23: CAIN A,". ; Allow . as part of directory name + JRST [ PUSHJ P,TRFDW5 ; Read a continuation to this word + JRST TRFD23] ; And try again + MOVEI D,$FDIR ; Set up index. + CAIN A,"> ; Terminator should be end of dir name... + PUSHJ P,RCH ; If so, get next to avoid scan of ">". + ; else bleah, but aren't supposed to fail... + TRNN FF,FRFDEV ; Unless a device has been explicitly given, + SETZM $FDEV(F) ; zap any furnished default. 0 means DSK. + TRO FF,FRFDIR ; Now say dir was explicitly given. + JRST TRFD6 ; Go store it. +TRFD24: CAIN A,". ; Start of $FTYPE or $FVERS (20x)? + JRST [ MOVEI D,$FTYPE ; Assume reading $FTYPE field, + TLNE FF,FL20X ; always if 10X, but if really on 20X, then + TRON FF,FRFEXT ; use $FTYPE only if not already seen. + JRST TRFD4 ; $FTYPE - jump to get word & store. + PUSHJ P,TRFDNM ; $FVERS - 20X and $FTYPE already seen. Get #. + MOVEM B,$FVERS(F) ; Store it away if successful. + JRST TRFD1] ; and go re-read delimiting char. + + CAIN A,"; ; Start of $FVERS (10x) or attribute? + JRST [ PUSHJ P,RCH ; Find what next char is. + CAIL A,"a ; Must uppercasify. + CAILE A,"z + CAIA + SUBI A,40 + CAIN A,"T ; Temporary file? + JRST [ SETOM $FTEMP(C) + JRST TRFD2] + CAIN A,"A ; Account? + JRST [ MOVEI D,$FACCT ; Set index, and + JRST TRFD4] ; go gobble following word. + CAIN A,"P ; Protection? + JRST [ MOVEI D,$FPROT ; Set index, and + JRST TRFD4] ; go gobble following word. + TLO FF,FLUNRD ; Not alpha, try numeric. Re-read char, + PUSHJ P,TRFDNM ; trying to parse as number. + MOVEM B,$FVERS(F) ; Win, parsed as number! Store it. + JRST TRFD1] ; If none of above, ignore ";" entirely. + + PUSHJ P,TRFDW ; Let's try reading it as word, + JUMPLE C,APOPJ ; If nothing read, assume it's some terminating delimiter. + CAIN A,": ; Else have something, check trailing delim for special cases + JRST [ MOVEI D,$FDEV ; Aha, a device. + PUSHJ P,RCH ; Flush the terminator & get next char. + TRNN FF,FRFDIR ; Unless dir was explicitly given, + SETZM $FDIR(F) ; zap furnished default. 0 uses connected dir. + TRO FF,FRFDEV ; Say device was explicitly given, and + JRST TRFD6] ; store name away. + MOVEI D,$FNAME ; Else assume it's the filename. + JRST TRFD6 + + +TRFD4: PUSHJ P,RCH ; Here when must gobble next char, +TRFD5: PUSHJ P,TRFDW ; here when first char of wd already read. +TRFD6: PUSHJ P,FNCHKZ ; Note this can return and store a null string! + ADDI D,(F) ; Get address (filblk+index), and + MOVEM A,(D) ; store string pointer in the appropriate place. + TRO FF,FRNNUL ; Say non-null spec seen, + JRST TRFD1 ; and go re-read the delimiter, to process it. + +; TRFDW - Read a word (string), for use by TNXRFD. Copies sequence of +; acceptable filename chars into FNBUF, until non-valid char seen. +; A/ First char of word, +; Returns A/ delimiting char, C/ count of chars in string, +; clobbers nothing else. + +TRFDW4: SUBI A,40 ; Make lowercase +TRFDW5: IDPB A,FNBWP ; Deposit into FNBUF, + PUSHJ P,RCH ; get next char, + AOSA C ; and bump count, skipping over zap instruction. +TRFDW: SETZ C, ; When called, zero cnt of chars in string. + CAIL A,"A ; See if char is uppercase alpha, + CAILE A,"Z + CAIA + JRST TRFDW5 + CAIL A,"a ; or lowercase alpha, + CAILE A,"z + CAIA + JRST TRFDW4 + CAIL A,"0 ; or numeric, + CAILE A,"9 + CAIA + JRST TRFDW5 + CAIE A,"$ ; or dollarsign + CAIN A,"- ; or hyphen + JRST TRFDW5 + CAIN A,"_ ; Backarrow is special case, because + JRST [ TRNN FF,FRCMND ; if reading command, + TLNN FF,FL20X ; or running on 10X, + POPJ P, ; must treat as delimiter. + JRST TRFDW5] + CAIN A,^V ; ^V is quote char... + JRST [ PUSHJ P,RCH ; Quote, get next. + CAIE A,^M ; Quote anything but this. + CAIN A,0 ; or this. + POPJ P, ; time to exit. + PUSH P,A ; Quote it! Save char, + MOVEI A,^V ; so that a quoter can precede it. + IDPB A,FNBWP ; Fortunately this hair + POP P,A ; only needs care + IDPB A,FNBWP ; for quoted chars, which are + JRST TRFDW5] ; rare. + TLNE FF,FL20X ; Are we on a 10X? + POPJ P, ; If not, anything at this point is delimiter. + CAIL A,41 ; Check general bounds + CAIL A,137 ; Range from space to _ exclusive. + POPJ P, ; If outside that, delimiter. + CAIL A,72 ; This range includes :, ;, <, =, > + CAILE A,76 + CAIA + POPJ P, ; delimiter. + CAIE A,". + CAIN A,", + POPJ P, + CAIE A,"* + CAIN A,"@ + POPJ P, + ; Finally, check out chars which are acceptable to 10X but which + ; might be delimiter in cmd line... + TRNN FF,FRCMND + JRST TRFDW5 ; Not hacking cmd line, it's an OK char. + CAIE A,"/ + CAIN A,"( + POPJ P, + CAIN A,"! + POPJ P, + JRST TRFDW5 ; at long last done. + + +; TRFDNM - Read numerical string, halt when non-digit +; seen, leaves result (decimal) in B, with delimiting char in A. +; One peculiarity is skip return if no numerical char is seen at all; +; else doesn't skip and B has a valid number. + +TRFDNM: PUSHJ P,RCH ; First char needs special check. + CAIL A,"0 + CAILE A,"9 + JRST POPJ1 ; Not a number at all? + TDZA B,B +TRFDN2: IMULI B,10. + ADDI B,-"0(A) ; Convert to number + PUSHJ P,RCH ; Get following chars. + CAIL A,"0 + CAILE A,"9 + POPJ P, ; Nope, not digit so treat as delimiter. + JRST TRFDN2 ; Yep, a number + +] ;IFN TNXSW + +IFN TNXSW,[ + +; TYPFB - Type out FB pointed to by F + +TYPFB: SKIPE B,$FDEV(F) ; First, device name? + JRST [ PUSHJ P,TYPZ + MOVEI A,": + PUSHJ P,TYOERR + JRST .+1] + SKIPE B,$FDIR(F) ; Directory? + JRST [ MOVEI A,"< + PUSHJ P,TYOERR + PUSHJ P,TYPZ + MOVEI A,"> + PUSHJ P,TYOERR + JRST .+1] + SKIPE B,$FNAME(F) + PUSHJ P,TYPZ + MOVEI A,". + PUSHJ P,TYOERR + SKIPE B,$FEXT(F) + PUSHJ P,TYPZ + MOVEI A,". ; 20X uses "." to set off version, + TLNN FF,FL20X ; but 10X uses ";". + MOVEI A,"; + PUSHJ P,TYOERR + HRRE A,$FVERS(F) + JUMPL A,[MOVM B,A ; Is possible to have -1, -2, etc. + MOVEI A,"- + PUSHJ P,TYOERR + MOVE A,B + JRST .+1] + PUSHJ P,DPNT ; Version # output in decimal. + SKIPE $FTEMP(F) + TYPE ";T" ; May be temporary. + SKIPE B,$FPROT(F) + JRST [ TYPE ";P" + PUSHJ P,TYPZ + JRST .+1] + SKIPE B,$FACCT(F) + JRST [ TYPE ";A" + PUSHJ P,TYPZ + JRST .+1] + POPJ P, + + ; Takes BP in B, outputs to TYOERR until zero byte seen. +TYPZ: CAIA + PUSHJ P,TYOERR + ILDB A,B + JUMPN A,TYPZ+1 + POPJ P, +] ; IFN TNXSW + +SUBTTL TENEX misc. Filename Routines, FS string storage + +IFN TNXSW,[ .SEE FSDSK ; Part of this page is NOT conditionalized!! + +; To handle filenames of ASCIZ strings instead of SIXBIT words, each +; word has instead a byte pointer to an ASCIZ string. For purposes of +; easy comparison, all of these bp's point into FNBUF, and a routine +; (FNCHK) is provided which checks a just-stored string and returns a bp +; to either this string, if unique, or to a previously stored string if +; it is the same as the one just stored (which is then flushed). Thus +; strings can be compared for equality simply by a comparison of their +; byte pointers. While not necessary, strings are stored beginning on +; word boundaries for easier hacking. + + ; <# files>**+<# wds for constants> +LFNBUF==*5*3+20 ; Enough to hold strings for all output files, + ; all translated files, and all .insrt files encountered. + ; Later a GC'er can be hacked up so that of the latter only + ; enough for the max .insrt level need be allocated. + +LVAR FNBUF: BLOCK LFNBUF + + ; Macro to easily define constant strings for comparison purposes +DEFINE DEFSTR *STR* +440700,,%%FNLC +%%LSAV==. +LOC %%FNLC +ASCIZ STR +%%FNLC==. +LOC %%LSAV +TERMIN + %%FNLC==FNBUF +] ; IFN TNXSW!!! + + ; If not assembling for TENEX, the following strings become + ; simple SIXBIT values. This makes it possible to write simple + ; code to work for both TENEX and non-TENEX without messy conditionals. + +IFE TNXSW,[EQUALS DEFSTR,SIXBIT] + +FSDSK: DEFSTR /DSK/ ; This stuff defines various BP's into FNBUF to +FSSYS: DEFSTR /SYS/ ; use for comparison purposes later. +FSTTY: DEFSTR /TTY/ +FSNUL: DEFSTR /NUL/ +FSPTP: DEFSTR /PTP/ +FSATSN: DEFSTR /@/ +FSSBSY: DEFSTR /SUBSYS/ +FSPROG: DEFSTR /PROG/ +FSMID: DEFSTR /MID/ +FSMDAS: DEFSTR /MIDAS/ +FSGRTN: DEFSTR />/ +FSCRF: DEFSTR /CRF/ +FSCREF: DEFSTR /CREF/ +FSERR: DEFSTR /ERR/ +FSLST: DEFSTR /LST/ +FSLIST: DEFSTR /LIST/ +FSSAV: DEFSTR /SAV/ +FSEXE: DEFSTR /EXE/ + +IFN TNXSW,[ +VBLK +FNBBP: 440700,,FNBUF ; Points to beg of FNBUF (hook for dynamic alloc) +FNBEP: FNBUF+LFNBUF-1 ; Points to last wd in FNBUF (address, not BP) +FNBWP: 440700,,%%FNLC ; Write Pointer into FNBUF. +FNBLWP: 440700,,%%FNLC ; Last Write Pointer, points to beg of string being stored +PBLK +EXPUNG %%FNLC + +; NOTE - provided MIDAS never restarts, no initialization is necessary to +; start using FNCHK. (Unless of course FNBUF is dynamically allocated someday) + +; FNCHK - Check out just-stored filename. Returns BP in A to ASCIZ string, +; which will be "canonical" for comparison purposes. +; Clobbers A,B,T,TT,AA +; FNCHKZ - Makes sure just-writ string is ASCIZ'd out before FNCHK'ing. + +FNCHKZ: MOVE B,FNBWP ; Get write ptr, + LDB A,B ; see if last char was 0, + JUMPE A,FNCHK0 ; if so can skip one clobberage. + SETZ A, + IDPB A,B ; zero out bytes, +FNCHK0: TLNE B,760000 ; until at end of word. + JRST .-2 + ADD B,[<440700,,1>-<010700,,>] ; bump BP to point canonically at next. + MOVEM B,FNBWP + +FNCHK: HRRZ B,FNBWP ; See if write ptr + CAML B,FNBEP ; has hit end of FNBUF, and + ETF [ASCIZ /Filename buffer overflow/] ; barf horribly if so. + MOVE A,FNBBP ; A - bp to start of existing string + MOVE AA,FNBLWP ; AA - bp to start of new string to store +FNCHK2: MOVEI T,(A) ; T - current addr being checked, existing str + MOVEI TT,(AA) ; TT - current addr, new str + CAIL T,(TT) ; If addrs are same, or overran somehow, + JRST [ MOVE A,AA ; didn't find any match, accept new string. + MOVE B,FNBWP + MOVEM B,FNBLWP ; Set up new last-write-ptr + POPJ P,] +FNCHK3: MOVE B,(T) + CAMN B,(TT) ; Compare strings, full word swoops. + JRST [ TRNE B,377 ; equal, last char zero? + AOJA T,[AOJA TT,FNCHK3] ; no, continue for whole string + ; Found it! Flush just-stored string, don't want duplicate. + MOVEM AA,FNBWP ; Clobber write ptr to previous value. + POPJ P,] + ; Not equal, move to next string to compare + MOVEI B,377 ; Check for ASCIZ, + TDNE B,(T) ; moving to end of current string + AOJA T,.-1 + HRRI A,1(T) ; and updating BP to point at new string. + JRST FNCHK2 ; (T gets pointed there too at FNCHK2). + +; JFNSTR - Get filename strings for active JFN. +; A/ active JFN +; F/ addr of filename block to clobber. +; JFNSTB - Same, but ignores A and assumes JFN is already stored in block. +; Clobbers A,C + +JFNSTB: SKIPA A,$FJFN(F) ; JFNSTB gets the JFN from block itself. +JFNSTR: MOVEM A,$FJFN(F) ; whereas JFNSTR stores it there... + MOVSI D,-NJSTRF ; Set up aobjn thru table. +JFNST2: PUSH P,T + SYSCAL JFNS,[FNBWP ? $FJFN(F) ? JSTRFX+1(D)][FNBWP] + POP P,T + MOVE C,JSTRFX(D) ; Now get index to place it belongs in file block, + CAIN C,$FVERS ; and check for this, because + JRST [ MOVE A,FNBLWP ; it wants to be a number, not a string. + MOVEM A,FNBWP ; Zap write pointer back to forget string, + PUSHJ P,CVSDEC ; and quickly convert before anything clobbers it. + JRST .+2] ; Skip over the FNCHKZ call. + PUSHJ P,FNCHKZ ; Fix it up, and get BP to it. + ADDI C,(F) ; make it an addr, and + MOVEM A,(C) ; store BP. (or value, for $FVERS) + ADDI D,1 + AOBJN D,JFNST2 + POPJ P, + + ; Filblk idx, output format wd for JFNS call +JSTRFX: $FDEV ? 100000,, + $FDIR ? 010000,, + $FNAME ? 001000,, + $FTYPE ? 000100,, + $FVERS ? 000010,, +NJSTRF==<.-JSTRFX>/2 + +; CVSDEC - Converts ASCIZ string to decimal, assumes only digits seen. +; A/ BP to ASCIZ +; Returns value in A, clobbers nothing else. + +CVSDEC: PUSH P,B + PUSH P,C + MOVE C,A + SETZ A, + JRST CVSDC3 +CVSDC2: IMULI A,10. + ADDI A,-"0(B) +CVSDC3: ILDB B,C + JUMPN B,CVSDC2 + POP P,C + POP P,B + POPJ P, + +; CVSSIX - Converts ASCIZ string to SIXBIT word. +; A/ BP to ASCIZ string, +; Returns SIXBIT word in A. Clobbers nothing else. + +CVSSIX: PUSH P,B + PUSH P,C + PUSH P,D + MOVE D,A + SETZ A, + MOVE B,[440600,,A] + JRST CVSSX3 +CVSSX2: CAIL C,140 + SUBI C,40 ; Uppercase force + SUBI C,40 ; cvt to 6bit + IDPB C,B ; deposit + TLNN B,770000 ; If BP at end of word, + JRST CVSSX5 ; leave loop. +CVSSX3: ILDB C,D + JUMPN C,CVSSX2 +CVSSX5: POP P,D + POP P,C + POP P,B + POPJ P, + +; CV6STR - Takes 6bit word in A, writes into FNBUF and makes a string of +; it, returning BP in A. +; Clobbers A,B,T,TT,AA (due to FHCHKZ) + +CV6STR: MOVE B,A +CV6ST2: SETZ A, + LSHC A,6 ; Get a 6bit char + ADDI A,40 ; Make ASCII + IDPB A,FNBWP ; deposit + JUMPN B,CV6ST2 ; Continue until nothing left + PJRST FNCHKZ ; Make output thus far a string. + + +; CVFSIX - Takes current filblk (pointed to by F) and puts the +; right stuff in $F6 entries. + +CVFSIX: PUSH P,A + PUSH P,B + MOVSI B,-L$F6BL +CVFSX2: MOVE A,@CVFTAB(B) ; Get BP to string + PUSHJ P,CVSSIX ; Convert to 6bit + ADDI B,$F6DEV(F) ; Get index to right place to store. + MOVEM A,(B) + SUBI B,$F6DEV(F) ; restore aobjn pointer... + AOBJN B,CVFSX2 + POP P,B + POP P,A + POPJ P, + +CVFTAB: $FDEV(F) + $FNAME(F) + $FEXT(F) + $FDIR(F) +IFN <.-CVFTAB>-L$F6BL, .ERR CVFTAB loses. + +] ; IFN TNXSW + +SUBTTL DEC/TENEX - RUN hacking. (Process FOO! in CCL) +IFN DECSW,[ + +; Process "FOO!", which means "run SYS:FOO with an offset of 1". +; Note that the RUN call needs a block of 6 ACs, but at this point +; it doesn't matter what gets clobbered. + + + ; Entry point for restart, from TSRETN. +RERUN: MOVE B,FSMDAS ; Get name - using SYS:MIDAS + SETZB C,D+1 ; (no ext or ppn) + JRST RFDRU1 + +VBLK + +RFDRUN: MOVE A,$F6DEV(F) ; Load up the 4 filenames to use. + MOVE B,$F6FNM(F) + MOVE C,$F6EXT(F) + MOVE D+1,$F6DIR(F) + JUMPN A,RFDRU3 ; If device specified, use that, + MOVSI A,'DSK ; else default to DSK + CAIN D+1, ; if a PPN was given, and +RFDRU1: MOVSI A,'SYS ; to SYS: otherwise. +RFDRU3: SETZB D,D+2 ; These acs must always be zero... + MOVEI D+3,177 ; Flush all core above this address. +IFN SAILSW,[ + SETZ D+4, + CORE2 D+4, ; Flush hiseg by hand on SAIL. + HALT + ] +.ELSE HRLI D+3,1 ; Elsewhere, just set LH to this to flush hiseg. + + MOVE D+4,[RUNCOD,,D+5] ; Move core-less code into position in ACs. + BLT D+4,+LRUNCD-1 + MOVE D+4,[1,,A] ; ,,
+ JRST D+5 ; Go flush core and run program. + +RUNCOD: CORE D+3, ; Flush as much core as possible; RUN uuo can lose + HALT ; Because of how much we have. + RUN D+4, + HALT +LRUNCD==.-RUNCOD + ; Make sure symbols A-D leave enuf room. +IFL 17-, .ERR RFDRUN ACs lose. +PBLK +] ;END IFN DECSW + +IFN TNXSW,[ + ; On TENEX, we'll do things without compat package (boo hiss) + + ; Entry point for starting new MIDAS, come here from TSRETN. +RERUN: MOVEI F,FB + BLTZ L$FBLK,FB ; Clear out scratch filblk, point at it. + MOVE A,FSMDAS ; Get BP to "MIDAS", store in + MOVEM A,$FNAME(F) ; filblk, and drop thru for defaults. + + ; Here to start up specified program, for CCL hacking. +RFDRUN: TLNN FF,FL20X ; 20X or Tenex? + JRST [ MOVE A,FSSBSY ; Tenex, get BP to SUBSYS string + SKIPN $FDIR(F) ; Unless directory specified, + MOVEM A,$FDIR(F) ; default dir to . + MOVE A,FSSAV ; And do similar thing for ext (.SAV) + JRST RFDRN2] + MOVE A,FSSYS ; 20X, get BP to SYS string + SKIPN $FDEV(F) ; Unless device specified, + MOVEM A,$FDEV(F) ; default dev to SYS:. + MOVE A,FSEXE ; And ditto for ext (.EXE) + +RFDRN2: SKIPN $FEXT(F) ; If extension not specified, + MOVEM A,$FEXT(F) ; Store appropriate one. + PUSHJ P,GETJFI ; Get JFN for input... + HALT ; Ugh, bletch, etc. + + ; OK, all ready to smash ACs with loader, etc. + MOVE R1,$FJFN(F) ; Put JFN into RH + HRLI R1,.FHSLF ; and fork handle (self) in LH. + MOVE R2,[RUNCOD,,R3] ; Load into ACs beginning at AC 3 + BLT R2,R3+LRUNCD-1 + JRST R3 ; Off we go, never to return... + + ; Following code is executed in AC's, position independent. +RUNCOD: GET ; Load up the file. + MOVEI R1,.FHSLF + GEVEC ; Find entry vector word for it, returned in AC 2. + JRST R1(R2) ; and go execute instruction in reenter slot. +LRUNCD==.-RUNCOD ; Pretty small loader, huh? +] ; IFN TNXSW + +SUBTTL Core Allocation routine - GCCORQ gets another K for MACTAB + +; Get another K of MACTAB space. + +GCCORQ: MOVE A,MACHI + LSH A,-2 ; Convert to word # + CAIL A,MXMACL ; Want more than allowed? + POPJ P, + MOVE A,MACTND ; No, get addr of block we want to get. + PUSH P,A ; Entry, save A in case have to try again +CORRQ1: +IFN ITSSW,[ + LSH A,-10. + SYSCAL CORBLK,[MOVEI %CBNDR+%CBNDW + MOVEI %JSELF ? A ? MOVEI %JSNEW] + JRST CORRQL ; Lose +] +IFN DECSW,[ + IORI A,1777 + CORE A, + JRST CORRQL ; Lose +] +IFN TNXSW,[ + SKIPN MEMDBG ; Only need to hack if want. + JRST CORRQ3 + ; Super kludge. No way to ask 10X for a "new page"; must + ; get it via default create-on-reference. Hence to get page + ; without bombing, must be sure .ICNXP interrupt deactivated! + PUSH P,T + SYSCAL DIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Deactivate. + SETZM (A) ; Reference 1st page + SETZM 1000(A) ; Reference 2nd page. + SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Re-activate. + POP P,T +CORRQ3: +] + + REST A + ADDI A,2000 + JRST MACIN2 ; Update pointers to end of MACTAB. + +IFN ITSSW\DECSW,[ + ; Lossage handler for GCCORQ. Only ITS or DEC can fail. +CORRQL: PUSH P,C + PUSH P,D + TLOE AA,400000 + JRST CORQL1 + TYPE " +No core for macro table." +CORQL1: TYPE " +Try again? " +CORQL2: PUSHJ P,TYI ; Get char + CAIL A,140 ; Cheap uppercase force + SUBI A,40 + CAIN A,"Y ; Y, + JRST CORRQA ; => try again + CAIN A,"N ; N, + JRST CORRQB ; => back to DDT then try again + CAIN A,"? ; ?, + ERJ CORQL1 ; => type out error-type blurb + TYPE "? " ; something else + JRST CORQL2 + +CORRQB: +IFN ITSSW,.VALUE ; Loop point for don't-proceed +IFN DECSW,EXIT 1, + TLZ AA,400000 +CORRQA: POP P,D + POP P,C + MOVE A,(P) ; Restore A from PDL + JRST CORRQ1 +] ; IFN ITSSW\DECSW + +SUBTTL Core allocation - TENEX routine to get pages (TCORGT) + +IFN TNXSW,[ + +; TCORGT - Takes arg in AA, an ITS page AOBJN to pages to grab. +; Clobbers no ACs but AA. + +TCORGT: JUMPGE AA,APOPJ ; Ignore arg if nothing to do about it. + SKIPN MEMDBG ; Ignore anyway if not hacking memory + POPJ P, + PUSH P,R1 + PUSH P,R2 + PUSH P,R3 + MOVE R3,AA + ASH R3,1 ; Get Tenex page AOBJN + MOVEI R1,(R3) + LSH R1,9. ; Get word address of first page. + HRR R3,R1 ; Stick back in AOBJN. + + ; Super kludge. No way to ask 10X for a "new page"; must + ; get it via default create-on-reference. Hence to get page + ; without bombing, must be sure .ICNXP interrupt deactivated! + MOVEI R1,.FHSLF + MOVE R2,[1_<35.-.ICNXP>] + DIC ; Deactivate. +TCORG3: SETZM (R3) ; Get the page. + ADDI R3,777 ; Bump word address, + AOBJN R3,TCORG3 ; and get next page (note adds 1 more to RH) + AIC ; Now re-activate... + POP P,R3 + POP P,R2 + POP P,R1 + POPJ P, +] ;IFN TNXSW diff --git a/src/midas/tsrtns.229 b/src/midas/tsrtns.229 new file mode 100755 index 00000000..e45352f2 --- /dev/null +++ b/src/midas/tsrtns.229 @@ -0,0 +1,4587 @@ +;-*-MIDAS-*- + +SUBTTL TS Definitions, parameters + + ; For convenience in defining isolated variables/tables, + ; especially when have to know on pass1 where the + ; table is going to be (.VECTOR etc don't know until end of pass) +DEFINE LVAR -LINE +VBLK +LINE +PBLK +TERMIN + +DEFINE TMPLOC AT,STUFF +%%%TLC==. ? LOC AT + STUFF +LOC %%%TLC +TERMIN + + ; Nice macro for minimizing coding. Doesn't hack indirection tho. + ; Could conceivably optimize to do MOVE AC,[FROM,,TO] but that + ; would be overly hairy for something you can do just by writing + ; 2 instructions. +DEFINE BLTMAC AC,LEN,FROM,TO + MOVSI AC,FROM + HRRI AC,TO + BLT AC,TO+LEN-1 +TERMIN + + ; Also handy for standard zaps (and nice mnemonic) + ; won't work for indirection either. +DEFINE BLTZAC AC,LEN,FROM + SETZM FROM +IFG LEN-1,[ + MOVEI AC,FROM+1 + HRLI AC,-1(AC) + BLT AC,FROM+LEN-1 +] +TERMIN + + ; More convenient when A is clobberable... +DEFINE BLTM LEN,FROM,TO +BLTMAC A,LEN,FROM,TO +TERMIN + +DEFINE BLTZ LEN,FROM +BLTZAC A,LEN,FROM +TERMIN + + ; Following inserts a SYSCAL for JSYS's. Be warned that it + ; clobbers T when used!! +IFN TNXSW,.INSRT XJSYS + +IFNDEF PMAPSW,PMAPSW==TNXSW ; 1 to assemble PMAP input, 0 for SIN input. +IFNDEF ERRSW,ERRSW==1 ; 1 for error file output capability. + +IFNDEF TYPDLC,TYPDLC==7 ; Maximum total depth of .insrt (including tty) +IFNDEF MX.INS,MX.INS==5 ; Maximum depth .insrt files only +IFNDEF MAXIND,MAXIND==6 ; Maximum # @: table entries for .insrt + + ; Define sizes of various I/O buffers +IFN DECSW,[ +IFNDEF DECBFL,DECBFL==203 ; Standard DEC buffer size for DSK (200 wds data) +IFN SAILSW,IFNDEF NINBFS,NINBFS==19. ; For SAIL, hack full disk track of input. +IFNDEF NINBFS,NINBFS==2 ; # standard-size buffers to use for input. +IFNDEF UTIBFL,UTIBFL==*NINBFS ; Input buffs need 1 wd for EOB hacking +IFNDEF UTOBFL,UTOBFL==DECBFL ; All output chans have just 1 buffer. +IFNDEF CRFBSZ,CRFBSZ==DECBFL +IFNDEF LSTBSZ,LSTBSZ==DECBFL +IFNDEF ERRBSZ,ERRBSZ==DECBFL +] ;DECSW +IFNDEF CMBFL,CMBFL==50 ; Length of command buffer. +IFNDEF UTIBFL,UTIBFL==400 ; " Input buffer. +IFNDEF UTOBFL,UTOBFL==200 ; " BIN output buffer. +IFNDEF CRFBSZ,CRFBSZ==200 ; " CREF output buffer. +IFNDEF LSTBSZ,LSTBSZ==200 ; " LIST output buffer. +IFNDEF ERRBSZ,ERRBSZ==1 ; " ERR output buffer. Very small to avoid + ; losing much data if things crash. + + +ERRC==0 ; Err device input channel +TYIC==1 ; TTY input channel +TYOC==2 ; TTY output channel +CREFC==3 ; CREF output +UTYOC==4 ; BIN output +LPTC==5 ; LIST output (LPT) +ERRFC==6 ; ERR Assembly error output file. +UTYIC==7 ; 1st input channel, UTYIC+n used for nth .INSRT level in dec version. + +SUBTTL File Description Storage (FILBLK's) + +VBLK + ; Definitions for indices into a FILBLK. + + ; Scratch block FB is formed while defining indices... +FB: OFFSET -. + ; Lots of crocks depend on the exact order of these 4 items. +$F6DEV:: 0 ; SIXBIT Device name +$F6FNM:: $F6FN1:: 0 ; SIXBIT Filename (on ITS, FN1) +$F6TYP:: $F6FN2:: $F6EXT:: 0 ; SIXBIT Extension (on ITS, FN2) +$F6DIR:: 0 ; SIXBIT Directory (may be numerical PPN) + L$F6BLK==. +$FVERS:: $FGEN:: 0 ; File version (or generation). NUMBER, not string. +IFN TNXSW,[ ; Almost all entries here are BP's to ASCIZ strings. +$FDEV:: 0 ; Device name +$FDIR:: 0 ; Directory name +$FNAME:: 0 ; File name (i.e. main name) +$FTYPE:: $FEXT:: 0 ; File type (or extension) +$FTEMP:: 0 ; -1 => File is a temporary file. +$FACCT:: 0 ; Account string +$FPROT:: 0 ; Protection string +$FJFN:: 0 ; JFN for file (may be ,,) +] +IFN ITSSW\DECSW,[ +$FDEV==:$F6DEV ; These definitions made so some common code can do +$FDIR==:$F6DIR ; the right things. +$FNAME==:$F6FNM +$FTYPE==:$F6TYP +$FEXT==:$F6TYP +] + L$FBLK==. ; Length of a FILBLK. + OFFSET 0 ; End of index definitions. + + + ; FILBLK's for various files + +ISFB: BLOCK L$FBLK ; Input file specification as given in command line. +INFB: BLOCK L$FBLK ; Actual current input file. +OUTFB: BLOCK L$FBLK ; Output file + +IFN CREFSW, CRFFB: BLOCK L$FBLK ; CREF output file +IFN LISTSW, LSTFB: BLOCK L$FBLK ; Listing output file +IFN ERRSW, ERRFB: BLOCK L$FBLK ; Error output file + +INFCNT: 0 ; AOS'd each time an input file is opened. +INFCUR: 0 ; What INFCNT was when current file opened. +INFERR: 0 ; What INFCUR held at last err msg. + +INDDP: MAXIND,,TBLOFS ; Pointer into tables below +TBLOFS: BLOCK MAXIND*L$FBLK ; Actual filenames corresponding to those in TBLSFS, for opening. +TBLSFS: BLOCK MAXIND*L$FBLK ; Source-specified filenames for @: files + + +RFNAM1: 0 ; .FNAM1, .FNAM2, .FVERS +RFNAM2: 0 +RFVERS: 0 +IFNM1: 0 ; .IFNM1, .IFNM2, .IFVRS +IFNM2: 0 +IFVRS: 0 +INFFN1==:INFB+$F6FN1 ; Some crocks seem to reference this. +OFNM1==:OUTFB+$F6FN1 ; Pseudo .OFNM1 needs this. +OFNM2==:OUTFB+$F6FN2 ; ditto, .OFNM2 +RSYSNM: 0 ; Initial system name + +IFN TNXSW,[ +USRNUM: 0 ;User# of person running program +UNAMLN: 0 ;# of words in his username. +USRNAM: BLOCK 40./5 ;Max username is 39. characters +FNAMLN: 0 +FILNAM: BLOCK 200./5 ;Max filename is around 170. characters. +];TNXSW +PBLK + +SUBTTL I/O Buffers + +VBLK ; Input buffer and variables + +UTIBUF: BLOCK UTIBFL +UTIHDR: 0 ; Input buffer header (dec version) +UREDP: 440700,,UTIBUF ; Input byte pointer +UTICNT: 0 ; Input byte count (dec version) +IUREDP: 440700,,UTIBUF ; Initial UREDP, used for re-initializing. +UTIBED: UTIBUF ; EOF comparison with RH(UREDP), 4.9 => EOF on .IOT + +IFN DECSW,UTICHN: UTYIC + + ; BIN Output buffer + +UTOBUF: BLOCK UTOBFL ; Output buffer +UTOHDR: UTOBFL,,UTOBUF-1 +UTYOP: 444400,, ; Output (36. bit) byte pointer +UTYOCT: 0 ; # words left in utobuf +IFN ITSSW,OCLOSP: @1(C) ; Turned into bp to unused part of last bffer wd used. + + ; CREF output buffer +IFN CREFSW,[ +CRFBUF: BLOCK CRFBSZ +CRFHDR: CRFBSZ,,CRFBUF-1 ; Header, assembled value used only ifn itssw +CRFPTR: 444400,, ; Bp for filling buffer (full words) +CRFCNT: 0 ; Num. wds. empty in buffer +] + + ; LISTing output buffer +IFN LISTSW,[ +LSTBUF: BLOCK LSTBSZ +LSTHDR: 5*LSTBSZ,,LSTBUF-1 +LSTPTR: 440700,, +LSTCNT: 0 +] + + ; ERRor output buffer +IFN ERRSW,[ +ERRBUF: BLOCK ERRBSZ +ERRHDR: 5*ERRBSZ,,ERRBUF-1 +ERRPTR: 440700,, +ERRFCT: 0 ; Can't call this ERRCNT since that's used for # errors. +ERRFP: 0 ; Non-0 if want error output file. +ERRFOP: 0 ; Non-0 if error file open (ie try outputting to it) +] +PBLK + +SUBTTL Interrupt Handling + +; Note that only PDL OV is now enabled in general. +; TTY input interrupts are also handled when possible for +; ^H, ^W, and ^V. + +.SCALAR INTSVP ; Saves P on interrupt for debugging + +IFN ITSSW,[ + TMPLOC 42, JSR TSINT ; Interrupt vector for ITS +VBLK +.JBCNI: +TSINT: 0 ; 1st wd interrupts currently considered fatal errors. +.JBTPC: 0 ; Error processor re-enables interrupts + .SUSET [.RJPC,,INTJPC] + SKIPGE TSINT + JRST TTYINT ; Second-word ints. + JRST TSINT1 ; Jump into pure coding and process interrupt +INTJPC: 0 ; Saves .JPC at interrupt. +PBLK + ; Jrst here from TSINT for 2nd wd interrupts. +TTYINT: PUSH P,A + MOVEI A,TYIC ; The tty chnl is the only one enabled. + .ITYIC A, + JRST TTYINX ; No int. char. + CAIN A,^W + AOS TTYFLG ; ^W silences, + CAIN A,^V + SOS TTYFLG ; ^V unsilences, + CAIN A,^H + SETOM TTYBRF ; ^H says break next time thru ASSEM1 loop. +TTYINX: REST A + .DISMIS .JBTPC +] ; IFN ITSSW + +IFN DECSW, TMPLOC .JBAPR, TSINT1 ; Interrupt vector for DEC + +IFN ITSSW\DECSW,[ + ; Amazing but can use almost same basic rtn for both! + +TSINT1: MOVEM P,INTSVP ; Save P for possible debugging +IFN ITSSW,.SUSET [.SPICL,,[-1]] ; For ITS, re-enable ints. + MOVE A,.JBCNI ; Get interrupt request word + TRNE A,200000 ; PDL overflow? + JRST CONFLP + MOVE B,[TYPE "Unknown interrupt - Fatal"] ; anything else. + MOVEM B,40 + MOVE A,.JBTPC ; So error routine will print out properly + JSA A,ERROR +] + +IFN TNXSW,[ + ; TENEX Interrupt handler +; Note that NXP (non-ex page) is enabled, but no provision is +; currently made for handling it. This causes process termination and +; EXEC will print error message. If NXP wasn't enabled, a page would +; simply be created without fuss (page is always created, incidentally, +; whether or not interrupt happens) + +LVAR MEMDBG: 0 ; For nonce, this gets set when PURIFG does. + +LEVTAB: INTPC1 ; Where to store PC for level 1 interrupt. + 0 ? 0 ; Levels 2 and 3 unused. +CHNTAB: BLOCK 36. ; Where to go for indicated condition. Most zero. + +.IC.CV==1 ; Define user channel 1 for ^V interrupt +.IC.CW==2 ; " 2 for ^W +.IC.CH==3 ; " 3 for ^H +%%LSV==. +LOC CHNTAB+.ICPOV ? 1,,TSINT1 ; Put right word in CHNTAB for PDL OV dispatch. +LOC CHNTAB+.IC.CV ? 1,,INT.CV ; Ditto for ^V dispatch +LOC CHNTAB+.IC.CW ? 1,,INT.CW ; " ^W +LOC CHNTAB+.IC.CH ? 1,,INT.CH ; " ^H + ; The next 3 are to handle all reasonable interrupts resulting from + ; a failing JSYS. +LOC CHNTAB+.ICILI ? 1,,INT.IL ; Illegal instruction (normally a failing JSYS) +LOC CHNTAB+.ICEOF ? 1,,INT.IL ; EOF encountered +LOC CHNTAB+.ICDAE ? 1,,INT.IL ; Data error encountered +LOC %%LSV + +.SCALAR INTPC1 ; Level 1 interrupt PC stored here. + + ; Handle PDL OV interrupt +TSINT1: MOVEM P,INTSVP ; Save PDL ptr. + MOVEI A,CONFLP ; OK to clobber A in PDLOV. + MOVEM A,INTPC1 ; Dismiss to CONFLP. + DEBRK ; Off we go. + + ; Handle ^V interrupt +INT.CV: SOS TTYFLG ; Unsilence typeout + DEBRK + + ; Handle ^W +INT.CW: AOS TTYFLG ; Silence typeout + DEBRK + + ; Handle ^H +INT.CH: SETOM TTYBRF ; Set flag to check at main level ASSEM1 loop. + DEBRK + + ; Handle Illegal Instruction (normally a failing JSYS, bletch!) + ; 10X ERJMP-handling interrupt routine. +ERJMPA==: ; For use instead of ERJMP where JSYS normally skips. +IFNDEF ERJMP,ERJMP==: +IFNDEF ERCAL,ERCAL==: + +ERXJMP==: ; For easier code writing +ERXCAL==: +ERXJPA==: + +INT.IL: PUSH P,A + PUSH P,B + MOVE A,INTPC1 ; Get PC we got interrupted from + LDB B,[271500,,(A)] ; Get op-code and AC field of instr + CAIN B,ERXJPA + JRST ERJFAK + CAIE B,ERXJMP ; Is it a magic cookie? + CAIN B,ERXCAL + JRST ERJFAK + AOJ A, + LDB B,[271500,,(A)] ; Try next instr + CAIE B,ERXJMP ; Any better luck? + CAIN B,ERXCAL + JRST ERJFAK + ETF [ASCIZ "Fatal interrupt encountered"] + +ERJFAK: CAIN B,ERXCAL ; See which action to hack + JRST ERJFK2 ; Go handle ERCAL, messy. + MOVEI A,@(A) ; ERJMP, get the jump address desired + MOVEM A,INTPC1 ; Make it the new PC + POP P,B + POP P,A + DEBRK +ERJFK2: MOVEI B,@(A) ; Get jump address + MOVEM B,INTPC1 ; Make it the new PC + POP P,B + AOJ A, ; old PC needs to be bumped for return + EXCH A,(P) ; Restore old A, and save PC+1 on stack + DEBRK + +; (Actually, since ERCAL is not special except after a JSYS, it would +; still work if the ERCAL-simulation didn't bump the PC; control would +; just drop through to the next instruction on return. Might confuse +; people looking through the stack frames, though.) +] ;IFN TNXSW + +SUBTTL MIDAS BEGINS HERE - Program Startup + +VBLK +NVRRUN: -1 ; 0 => MIDAS was run; error to start or purify. +FATAL: 0 ; At end of assembly, not 0 iff fatal error occurred. +PBLK + +BEG: ; Start address! +IFN DECSW\TNXSW,[ + TDZA A,A + SETO A, + MOVEM A,CCLFLG ; Remember type of start-up +] + SETZ FF, ; Initialize flags + MOVE P,[-LPDL,,PDL-1] ; Initialize P + +IFN DECSW,[ + RESET + MOVEI A,600000 + APRENB A, +] + ; For TENEX, must determine right away which system we're on. +IFN TNXSW,[ + RESET +; TLZ FF,FL20X ; Assume 10X until proven otherwise. (done by SETZ above) + +IFN 0,[ ; One way of determining OS which doesn't work on some places. + MOVE A,[112,,11] ; Magic word that will win on 10X,T20 (and maybe T10) +GETTAB=<047000,,41> ; CALLI 41 + GETTAB A, ; Returns 10000 T10, 20000 ITS, 30000 10X, 40000 T20 + MOVEI A,30000 ; Shouldn't ever fail, but if it does, assume 10X. + LDB A,[140300,,A] ; Flush other fields too + CAIN A,4 ; = Tops-20? + TLO FF,FL20X ; Yes, set flag. +]; IFN 0 +IFN 0,[ ; This is a loser too, since there ARE KL Tenices! + SETZ A, ; In lieu of above, use hardware hack... + BLT A, ; test for KL-ness. + CAIE A, + TLO FF,FL20X ; KL will fail to skip, assume that means 20X OS. +];IFN 0 +IFN 1,[ ; Boy I hope DEC never defines LOADTB! -- MRC + SYSCAL SYSGT,[['LOADTB]][A ? D] + SKIPN D ; If LOADTB is not defined + TLO FF,FL20X ; it must be a Twenex +]; IFN 1 + + SYSCAL SCVEC,[[.FHSLF] ? [-1]] ; and flush compat package, + ; disabling UUO's 40-77; this is good for debugging. + + ; Set up stuff for interrupts + SYSCAL SIR,[[.FHSLF] + [LEVTAB,,CHNTAB]] ; Specify tables + SYSCAL EIR,[[.FHSLF]] ; Enable interrupts + SYSCAL AIC,[[.FHSLF] ; Activate PDL OV and ^V, ^W, ^H +[IRP BIT,,[.ICPOV,.IC.CV,.IC.CW,.IC.CH] +<1_<35.-BIT>>+!TERMIN ]] + SYSCAL ATI,[[.TICCV,,.IC.CV]] ; Make various mappings from + SYSCAL ATI,[[.TICCW,,.IC.CW]] ; terminal bits to int. channels. + SYSCAL ATI,[[.TICCH,,.IC.CH]] ; What a losing interrupt sys 10X has! + SKIPN MEMDBG ; Hacking memory ref debugging? + JRST BEG20 + ; Make sure that all low impure pages exist + ; whether or not they consist of all zeros. Problem is that EXEC SAVE + ; command ignores pages that are all zero, so they won't exist on + ; startup and we have to re-create them or risk getting a NXP int. + MOVSI A,-2*MINBNK + MOVE B,(A) ; Reference them all to create them if nec. + ADDI A,777 + AOBJN A,.-2 + MOVE B,-1 ; Ditto last TNX page of initial MACTAB + ; Now enable interrupts for Non-eXistent Pages. + SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] + +BEG20: SYSCAL GJINF,[][USRNUM] ;Get your user# into USRNUM + SYSCAL DIRST,[[-1,,USRNAM] ? USRNUM] ;And then make username string + JFCL + MOVEI A,1 ;# words in username string. + MOVE B,USRNAM-1(A) + TRNE B,376 ;check last position in this word + AOJA A,.-2 ; filled, so check next word. + MOVEM A,UNAMLN ;Save # words. + +] ;TNXSW + +IFN ITSSW,[ + MOVE A,[-5,,[ ; Set and read various vars in a chunk. + .SMASK,,[%PIPDL] ; 1st-wd Interrupt only on PDL ovfl. + .SMSK2,,[1_TYIC] ; 2nd-wd on TTY input channel. + .SPICL,,[-1] ; and enable interrupt system. + .RSNAM,,RSYSNM ; Get system name (default dir to use) + .RXJNAM,,B ]] ; and XJNAME for temp. hacking below. + .SUSET A + SYSCAL TTYSET,[1000,,TYIC ; Set TTYST wds - PI echo, no act/int + [232020,,202020] ; except ctls activate & interrupt + [232020,,220220]] ; CR, DEL activate but don't int; + ; DEL doesn't echo. +] + + AOSE NVRRUN ; Test for this job's already being run... + JRST [ TYPE "Can't restart MIDAS" + JRST TSRETN] + + ; Initialize impure memory for paged systems +IFN ITSSW\TNXSW,[ + MOVE AA,[MXICLR-MXIMAC,,MXICLR] + CALL CORGET ; Get MACTAB pages not loaded into. +IFN PURESW,[ + MOVE AA,[MINBNK-MINMAC,,MINBNK] + CALL CORGET ; Get pages for blank code & symtab. + SKIPN PURIFG + JRST .+3 ; If purified, skip cleanup + JSP F,FLSPGS ; If not purified => flush pages of + ,,MXIMAC ; MACTAB created by loading but not needed. +] ;PURESW +] ;IFN ITSSW\TNXSW + + MOVEI D,SYMDSZ ; Get default symtab size +IFN ITSSW,[ ; Remember that B set to XJNAME above. + CAME B,['MMIDAS] ; Set symtab size larger for MMIDAS + CAMN B,[SIXBIT/MM/] ; (random sort of hack now that .SYMTAB exists) + MOVEI D,SYMMSZ +] + SKIPGE ISYMF ; The first time through, + MOVEM D,SYMLEN ; Make that the size to use. + CALL SITINI ; Initialize stuff for .SITE. + CALL JCLINI ; Now try to fetch JCL; set CMPTR accordingly. +IFN ITSSW,[ + SKIPGE ISYMF ; Skip if syms spread; if not, + CALL TSYMGT ; get TS syms from system. +] + SKIPE CMPTR ; If have JCL, + JRST GO2AA ; skip announcing midas's name and version. + +IFG PURESW-DECSW,[ ; If meaningful, + SKIPGE PURIFG ; Check for purity + TYPE "NOTPUR " ; and type little warning if unpurified. + ] + TYPE "MIDAS." ; and announce self. + MOVE B,[MIDVRS] + PUSHJ P,SIXTYO + JRST GO2AA + +SUBTTL MIDAS Top-level control path + +GO2A: SETZM CMPTR ; Recycles here, so JCL only hacked once. +GO2AA: SETOM FATAL ; Assume fatal errors, unless cleared at GO8 when done. + SETZM TTYFLG ; Allow TTY typeout. + SETZM ERRCNT ; Initialize error counter (total errors) +IFN RUNTSW,[ PUSHJ P,RNTTMA ; Get initial run time. + MOVEM A,IRUNTM] + SETZM LSTTTY ; Tell TYOERR not to try output to LST file (none yet!) + PUSHJ P,CMD ; Get typed in command (or scan cmd line if CMPTR ne 0) + + SKIPGE SMSRTF ; What's this for, I wonder? + JRST GO21 + TYPECR "SYMTAB clobbered" + JRST GO2A + + ; Filenames and switches all specified, now see if files can be set up. +GO21: PUSHJ P,OPNRD ; Open input file + JRST GO2A ; Error, msg was typed, go try again with new cmd line. + PUSHJ P,WINIT ; Open output file, cref file. +IFN DECSW\TNXSW,[ + SKIPGE CCLFLG + TYPE "MIDAS: " +] +IFN A1PSW,[ + SETOM PRGC + SETOM OUTC +GO3: ] + MOVE A,WSWCNT + MOVEM A,TTYFLG ; Turn off typeout if there were (W) switches. + SETOM LSTTTY ; Allow TYOERR to output to both TTY and LST. + JSP A,$INIT ; Initialize for assembly + JSP A,PS1 ; Do pass 1 + TRNN FF,FRNPSS ; If 2 pass assembly, + JRST GO4 + PUSHJ P,OPNRD ; Then re-open input file + JRST GO2A ; Couldn't re-open???? Do something better here. +GO4: JSP A,PLOD ; Maybe punch out SBLK loader in some format + JSP A,PS2 ; Do pass 2 + JSP A,PSYMS ; Maybe punch out symbol table +IFN A1PSW,[ + TLZ FF,$FLOUT + AOS PRGC ; Indicate end statement encountered + SETOM OUTC ; " " " + TRNN FF,FRNPSS ; If 1 pass assembly, + SKIPGE CONTRL + CAIA + JRST GO3 ; Then try to assemble another program +] +IFN FASLP,[ + SKIPGE A,CONTRL + TRNN A,FASL + JRST GO8 + MOVE A,[SIXBIT /*FASL*/] ; "finish" FASL file + MOVEI B,17 + PUSHJ P,FASO ; Ignore end frob, but output FASL end code + MOVE A,[ASCIC//] ; pad with ^C's. + PUSHJ P,FASO1 ; Randomness + PUSHJ P,FASBE ; Write out last block +] + ; Jump directly here for certain main-input EOF conditions. +GO8: SETZM FATAL ; There was no fatal error: output files get renamed. + + ; Jump directly here if hit fatal error (incl .FATAL, illegal UUO, etc) +GO9: PUSHJ P,.FILE ; Close (and rename if FATAL = 0) output files. + SETZM LSTTTY +IFN RUNTSW, PUSHJ P,RNTTYO ; Type out run time used since GO2A + CALL ERRCLS ; File away error file - only thing not closed by .FILE + JRST TSRETN ; and die according to system's wishes. + +SUBTTL MIDAS Death (TSRETN) - system dependent exit routines + +IFN ITSSW,[ +TSRETN: +IFN PURESW,[ + SKIPGE PURIFG ; If not yet purified, assume being debugged. + .VALUE +] + .LOGOUT ; Come here to commit suicide. + .BREAK 16,160000 +] ;IFN ITSSW + +IFN DECSW,[ + +TSRETN: SKIPLE A,ERRCNT ; If had any errors, + ADDM A,.JBERR ; let loader know about them. (???) Well, + .SEE ERR1 ; for strange comment. + SKIPN CCLMOR ; Any more CCL commands? + EXIT ; Nope, all done. + JRST RERUN ; More CCL to hack, start up a new MIDAS. +] ; IFN DECSW + + +IFN TNXSW,[ +TSRETN: SKIPE CCLMOR ; Need to hack any more CCL? + JRST RERUN ; Yeah. +TSRET1: HALTF + HRROI 1,[ASCIZ/Can't continue/] + PSOUT ; Better than dying randomly + JRST TSRET1 +] ; IFN TNXSW + +SUBTTL MIDAS Murder - fatal internal error handling (GOHALT) + +VBLK +HALTER: 0 ; JSR'd here when fatal internal error seen. + JRST HALTEP ; Jump to pure-code handling +PBLK +HALTEP: +IFN ITSSW,[ + .VALUE [ASCIZ |: ===== Fatal MIDAS internal error! ===== +Please send a message to BUG-MIDAS describing circumstances. +Error was at location:  +HALTER/ +|] +] ;IFN ITSSW + +IFN TNXSW,[ +.SCALAR HALTR1,HALTR2,HALTR3 + MOVEM R1,HALTR1 ; Save R1 etc. for later examination + MOVEM R2,HALTR2 + MOVEM R3,HALTR3 + HRROI R1,[ASCIZ | ===== Fatal MIDAS internal error! ===== +Please send a message to BUG-MIDAS @ MIT-MC describing circumstances. +Error was at location: |] + PSOUT + MOVEI R1,.PRIOU + HRRZ B,HALTER + MOVEI C,8. + NOUT + ERJMP .+1 + HRROI R1,[ASCIZ / +/] + PSOUT + MOVE R1,HALTR1 ; Restore R1 etc. for later examination + MOVE R2,HALTR2 + MOVE R3,HALTR3 + HALTF +] ;IFN TNXSW + +IFN DECSW,[ + OUTSTR [ASCIZ | ===== Fatal MIDAS internal error! ===== +Please send a message to BUG-MIDAS @ MIT-MC describing circumstances. +Error location can be found in HALTER/ (please look at it with DDT to +find out where the error came from). +|] + EXIT +] ;IFN DECSW + + JRST .-1 ; Just in case + +SUBTTL MIDAS Purification - PURIFY startup, also DECDBM + +IFN ITSSW\TNXSW,[ +IFN PURESW,[ + +PURIFY: SKIPL NVRRUN +IFN ITSSW,[ .VALUE [ASCIZ /: Already run, can't purify  +/]] +IFN TNXSW,[ + JRST [ HRROI 1,[ASCIZ /? Already run, can't purify +/] + PSOUT + HALTF + JRST .+1] ; If continued, go ahead anyway. +] ;IFN TNXSW +PURIF1: MOVEI P,17 ; Start PDL at 20 + JSP F,FLSPGS ; First flush blank-code pages, + ,,MINBNK ; incl. symbol table area. + JSP F,FLSPGS ; Flush MACTAB pages created by load + ,,MXICLR ; but not needed. + JSP F,PURIFD ; Purify pure pages. + ,,MINPUR + SETZM PURIFG ; Set "purified" flag +IFN TNXSW,SETOM MEMDBG ; For TNX, ask for mem checking. + MOVE [1,,2] ; Now clear out remains of data of self + MOVEI 1,0 + BLT 40 +IFN ITSSW,[ + .VALUE [ASCIZ /: Purified, type CR to dump  +:PDUMP SYS;TS MIDAS/] +] ;IFN ITSSW + +IFN TNXSW,[ + HRROI 1,[ASCIZ / Purified, now SAVE +/] + PSOUT + HALTF +] ; IFN TNXSW + JRST BEG + + ; JSP F,FLSPGS + ; -<# pgs>,, + ; Flush pages specified by page AOBJN + +FLSPGS: MOVE A,(F) ; Get the page AOBJN +IFN ITSSW,[ + SYSCAL CORBLK,[MOVEI 0 ? MOVEI %JSELF ? A] + .LOSE 1000 +] +IFN TNXSW,[ + ASH A,1 ; Multiply # pages, page # by 2. + HLRE B,A + HRLI A,.FHSLF + MOVNS B + TLO B,(PM%CNT) ; Say hacking repeat count +FLSPG2: SYSCAL PMAP,[[-1] ? A ? B] ; Flush these pages. + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI B,-1(B) ; Else, on 10X, must iterate manually. + TRNE B,400000 ; See if became "negative". + JRST .+1 ; Yep, done with manual iteration. + AOJA A,FLSPG2] ; Nope, bump page #. +] + JRST 1(F) + + ; JSP F,PURIFD - Just like FLSPGS, but purifies the pages instead. + +PURIFD: MOVE A,(F) ; Get page AOBJN +IFN ITSSW,[ + SYSCAL CORBLK,[MOVEI %CBNDR ; Read access only. + MOVEI %JSELF ? A] + .LOSE 1000 +] +IFN TNXSW,[ + ASH A,1 ; Double everything to get in terms of TNX pages. + HLRE B,A + MOVNS B ; Get # pages in B + MOVEI C,(A) + ADDI C,-1(B) ; Find # of last page to purify + LSH C,9. ; Get addr of 1st wd of last page + MOVES (C) ; Touch it so that it is guaranteed to exist! + ; This is necessary since last ITS page may only + ; include one TNX page instead of two. + HRLI A,.FHSLF +PURID1: SYSCAL SPACS,[A ? [PA%RD+PA%EX]] + ADDI A,1 + SOJG B,PURID1 +] + JRST 1(F) + +IFN TNXSW,[ + +; PURSAV - A startup routine like PURIFY, for possible use on TNX if +; the EXEC "SAVE" command does not preserve page access bits. +; Current T20 EXEC seems to do OK though. This is only useful +; when trying to catch illegal writes to "read-only" code. + +PURSV0: PUSHJ P,RDJERR +PURSAV: MOVEI P,20 + HRROI R1,[ASCIZ /Pure-Save to file: /] + PSOUT + MOVSI R1,(GJ%NEW+GJ%FOU+GJ%SHT+GJ%FNS) + MOVE R2,[.PRIIN,,.PRIOU] + GTJFN ; Get JFN from TTY + JRST PURSV0 + SETZM PURIFG ; Claim purified... + SETOM MEMDBG ; and keeping watch on memory. + HRLI R1,.FHSLF + MOVEI R2,[ + 2*<0-MINBNK>,,0+SS%RD+SS%WR+SS%EXE ; Variables/buffers + 2*,,2*MINMAC+SS%RD+SS%WR+SS%EXE ; MACTAB init + 2*,,2*MINPUR+SS%RD+SS%EXE ; Purify pure pages. + 0 ] ; End of SSAVE table + SETZ R3, + SSAVE ; Do it! + HRROI R1,[ASCIZ /Saved./] + PSOUT + HALTF +] ; IFN TNXSW + +] ; IFN PURESW +] ; IFN ITSSW\TNXSW + +IFN DECDBG,[ +DECDBM: 0 + HRLZ A,.JBSYM ;GET ADDR OF START OF DDT SYMS, + HRRI A,DECDBB+200 ;LEAVE 200 WD SPACE BEFORE THEM. + HRRM A,.JBSYM ;MOVE THEM INTO SPACE PROVIDED + HLRE B,.JBSYM + MOVMS B + BLT A,DECDBB+177(B) ;SO THEY WON'T GET IN MACTAB'S WAY. + JRST @DECDBM +] + +SUBTTL System-dependent Symbol Table stuff. + +IFN ITSSW,[ + +; TSYMGT - Gobble syms from system (ITS feature!) +; TABLE AREA IN SYSTEM: +; FIRST LOC SYSYMB +; LAST (AS OPPOSED TO LAST + 1) SYSYME + +TSYMGT: MOVEI A,EISYMT ;EISYMT FIRST LOC FOR ITS SYMS + MOVE B,[SIXBIT /CALLS/] ;SYSTEM CALLS + .GETSYS A, ;READ IN SYSTEM CALLS (SHOULD SKIP) + .LOSE %LSSYS + SKIPGE A + .LOSE ;.GETSYS DIDN'T UPDATE AOBJN POINTER + HRRM A,SP1 ;MARK END OF SYMS + ANDI A,-1 + CAIL A,MACTBA+MACL + .LOSE ;MACL TOO SMALL! INITS MIGHT LOSE. + MOVEI B,EISYMT + MOVEI AA,SYMC_<-18.+4> ;SQUOZE FLAG FOR SYM +TSYMG2: DPB AA,[400400,,(B)] + ADDI B,2 + CAIE B,(A) + JRST TSYMG2 + POPJ P, +]; IFN ITSSW + +SUBTTL .SITE pseudo & initialization (SITINI) + +IFN ITSSW, LVSITE==1 ; ITS only uses 1 word of mach name. +IFN DECSW\TNXSW,LVSITE==5 ; whereas others need 5 words (25 chars max) + +LVAR V.SITE: BLOCK LVSITE ; .SITE string stored here. + + ; .SITE N, returns nth word of sixbit machine name. + +A.SITE: CALL AGETFD ; Get field as argument. + JUMPL A,CABPOP ; Ignore negative indices. + CAIL A,LVSITE ; Make sure index is within bounds of string. + JRST CABPOP + MOVE A,V.SITE(A) ; Win, get indexed word. + JRST CLBPOP + + +; SITINI - Initialization routine called only at MIDAS startup, for +; setting up .SITE and maybe other things. + +SITINI: BLTZ LVSITE,V.SITE ; Clear out string location + +IFN ITSSW,[ ; For ITS, use up just 1 word and need 1 call to set V.SITE + SYSCAL SSTATU,[REPEAT 5,[ ? MOVEM A] ? MOVEM V.SITE] + .LOSE %LSSYS + POPJ P, ] + +IFN SAILSW,[ ; SAIL needs special kludge, since it doesn't have the + MOVE A,[SIXBIT /SAIL/] ; right GETTAB used. + MOVEM A,V.SITE + POPJ P, ] + + ; This code sets TNX .OSMIDAS at runtime as appropriate. +IFN TNXSW,[ + MOVE A,[SIXBIT /TENEX/] ; Assume running on 10X + TLNE FF,FL20X ; unless proved otherwise + MOVE A,[SIXBIT /TWENEX/] + MOVEM A,OSMID ; Store directly as symtab value! +] + ; If TNX and on ARPA network, get Arpanet host name for .SITE +IFN TNXSW,[ + SYSCAL SYSGT,[['LHOSTN]][A ? B] ; Get local host # + JUMPL A,SITIN3 ; Tops-20 release 3 has a LHOSTN table + JUMPE B,SITIN3 ; Jump if none, not on net. + SYSCAL CVHST,[FNBWP ? A][A] ; Write string into FNBUF. + JRST SITIN3 ; No string for that host #?? + SETZ B, + IDPB B,A ; Make sure string is ASCIZ'd. + MOVE B,FNBWP ; Note that FNBWP isn't altered by the syscal! + MOVE C,[440600,,V.SITE] +SITIN2: ILDB A,B + JUMPE A,APOPJ ; return when string ended. + TRCE A,140 ; Convert char to sixbit. + TRCE A,140 + TRCE A,140 + IDPB A,C + JRST SITIN2 +] + + ; For non-network TENEX and DEC in general, very similar. +IFN DECSW\TNXSW,[ +IFN TNXSW,[ +SITIN3: SYSCAL SYSGT,[['SYSVER]][A ? D] ; Best to get table index dynamically, + JUMPE D,APOPJ ; If can't, lose. + ] +IFN DECSW,MOVEI D,11 ; 11 = .GTCNF But on T10 we can assume this. + + MOVE AA,[440600,,V.SITE] + MOVSI C,-5 ; Process 5 words of .GTCNF (max possible) +SITIN4: HRLZ B,C ; Get subindex we want, + HRRI B,(D) ; and produce ,,
+IFN DECSW, GETTAB B, ; Get 1 word of table, using appropriate call. +IFN TNXSW, SYSCAL GETAB,[B][B] + POPJ P, ; If call fails, exit. +SITIN5: SETZ A, + LSHC A,7 ; Extract an ascii char + CAIE A,", ; If it's a comma, + CAIG A,40 ; or ctl or space, + POPJ P, ; then let's stop. + TRCE A,140 ; Swap bit 40 with bit 100, thus turning + TRCE A,140 ; "A to 'A, "a to 'A, "1 to '1, etc, and ^@ to ' . + TRCE A,140 + IDPB A,AA ; Store the sixbit into V.SITE + JUMPN B,SITIN5 ; When nothing left of this word of .GTCNF, get next. + AOBJN C,SITIN4 + POPJ P, +] ;DECSW\TNXSW + +SUBTTL RunTime - .MRUNT and end-of-assembly typeout +IFN RUNTSW,[ + +.SCALAR IRUNTM ; Holds initial run time (set at start of assembly) + + ; .MRUNT - Returns runtime since start of assembly. + +A.MRUN: PUSHJ P,RNTTMA ; Get current run time + SUB A,IRUNTM ; Subtract initial run time +IFN ITSSW,[MULI A,4069. ; ITS - Convert to nanoseconds, + DIV A,[1.^6] ; then to milliseconds. +] + PJRST CLBPOP + + ; RNTTMA - internal routine to return in A the current runtime, + ; in whatever units the OS furnishes. +RNTTMA: +IFN ITSSW, .SUSET [.RRUNT,,A] ; Gets runtime in 4.096 usec units. +IFN DECSW, SETZ A, ? RUNTIM A, ; Runtime in msec +IFN TNXSW,[ + IFN A-1, EXCH R1,A + MOVEI R1,.FHSLF + RUNTM ; Runtime in msec for self. + IFN A-1, EXCH R1,A + ] + POPJ P, + +; RNTTYO - Called at end of assembly to type out runtime, +; # of errors, and # symbols used. + +RNTTYO: +IFN DECSW,[ ; Nobody wants this on ITS, but other people do...sigh... + SKIPE A,ERRCNT ; Any assembly errors? + JRST [ TYPE "? " ; Yes, error message for batch controllers + CALL DPNT + TYPECR " error(s) detected" + JRST .+1] + SKIPE CCLFLG ; Called via CCL? + RET +] + TYPE "Run time = " + CALL A.MRUN ; Get runtime in millisec. in A. + IDIVI A,10. + IDIVI A,100. ; Get secs and hundredths. + HRLM B,(P) ; Save remainder + PUSHJ P,HMSTYO ; Type out secs + MOVEI A,". + CALL TYO + HLRZ A,(P) + CALL HMSTY3 ; Type out hundredths + CALL CRR + CALL A.SYMC + CALL DPNT + TYPE " Symbols including initial ones (" + CALL A.SYMC + IMULI A,100. + IDIV A,SYMLEN ; Get % symtab used + CALL DPNT + TYPECR "% used)" + RET + +; HMSTYO - Type out H:MM:SS time in A +; Doesn't work for times .ge. 60. hours + +HMSTYO: IDIVI A,60. + JUMPE A,[MOVE A,B ? PJRST DPNT] + HRLM B,(P) + PUSHJ P,HMSTYO + MOVEI A,": + PUSHJ P,TYO ; Type delimiting char + HLRZ A,(P) +HMSTY3: IDIVI A,10. + PUSHJ P,ADGTYO ; Type out digit in A + MOVEI A,"0(B) + PJRST TYO + +] ; IFN RUNTSW + +SUBTTL COMMON Output Routine WINIT - Open all output files. + +; WINIT - Called from top-level control to open all necessary output files. +; + +WINIT: +IFN ERRSW,[ + SKIPN ERRFP ; If want error output file, + JRST WINIT2 + CALL OINIT ; Open it, first of all. + 0 ERRFC,ERRFB + SIXBIT/ERROUT/ + ERRHDR,,ERRBUF + SETOM ERRFOP ; Error file now open. +WINIT2: ] + PUSHJ P,OINIT ; Open main output file. + 13^9 UTYOC,OUTFB ; chnl,name-block. + SIXBIT/OUTPUT/ + UTOHDR,,UTOBUF +IFN ITSSW,[ + TLZ FF,FLPTPF ; Initially assume device not paper tape punch + .STATUS UTYOC,A ; Get status of output channel + ANDI A,77 ; Mask to device code + CAIN A,7 ; If paper tape punch, + TLO FF,FLPTPF ; Then set FLPTPF. +] +IFN LISTSW,[ + SKIPN LISTP + JRST WINIT1 + CALL OINIT ; Open listing file if desired. + 0 LPTC,LSTFB + SIXBIT/LSTOUT/ + LSTHDR,,LSTBUF +WINIT1: +] +IFN CREFSW,[ + SKIPN CREFP ; If cref requested, + RET + PUSHJ P,OINIT ; Open cref file, FN2 = CRFOUT + 13^9 CREFC,CRFFB + SIXBIT/CRFOUT/ + CRFHDR,,CRFBUF + MOVE A,[.BYTE 7 ? 177 ? "B ? ^W] + PUSHJ P,CRFOUT ; Output header to indicate image input. + PUSHJ P,CRFSSF ; Output set-source-file block. +] + RET + +SUBTTL COMMON Output Routines - Output Chars/Words to BIN, TTY, ERR, CREF, LIST + + ; PPB - Punch Binary word. + +PPB: JUMPGE FF,CPOPJ ; Don't punch if not punching pass. +PPBA: ; This entry pt "Always" punches. +TPPB: SOSGE UTYOCT ; If no more room in buffer, + JRST [ CALL TPPBF ; Output & re-init buffer. + JRST TPPB] + IDPB A,UTYOP + RET + +TPPBF: PUSH P,[0 UTYOC,UTOHDR] ; Drop thru to COBUFO. + + ; Common OBUFO. Takes ,
on stack, clobbers no ACs. + ; See rtns below for usual calling sequence. +COBUFO: EXCH C,(P) ; Get arg off stack, save C. + CALL OBUFO ; Output & re-init buffer. + REST C + RET + + ; TYO - Output char in A, outputting also to ERR file if possible. +TAB: MOVEI A,^I +TYO: SKIPG A.TTYF + CALL TYOX ; Actually output to TTY with OS-dependent routine. + ; Then fall through for ERR output. +ERRCHR: +IFE ERRSW,RET +IFN ERRSW,[ + SKIPN ERRFOP ; Output char in A to error file if one is open. + RET + SOSGE ERRFCT + JRST [ PUSH P,[ERRCHR] + PUSH P,[0 ERRFC,ERRHDR] + PJRST COBUFO] + IDPB A,ERRPTR + RET +] ;IFN ERRSW + + ; CRFOUT - Output word in A to CREF file. + +IFN CREFSW,[ +CRFOUT: SOSGE CRFCNT + JRST [ PUSH P,[CRFOUT] ; Buffer full, go output it. + PUSH P,[0 CREFC,CRFHDR] + PJRST COBUFO] + IDPB A,CRFPTR + POPJ P, + +CRFSSF: SKIPA A,[1] ; Output set-source-file block. +CRFPSH: MOVEI A,3 ; Output push-source-file block. +REPEAT L$F6BL,[ + CALL CRFOUT + MOVE A,INFB+$F6DEV+.RPCNT + ] + JRST CRFOUT +] ; IFN CREFSW + + + ; PILPT - Output character in A to listing file. + +IFN LISTSW,[ +PILPT: SOSGE LSTCNT + JRST [ PUSH P,[PILPT] ; When buffer full, output it. + PUSH P,[0 LPTC,LSTHDR] + PJRST COBUFO] + IDPB A,LSTPTR + RET + +LPTCLS=:CPOPJ ; Hmmm, random noop-ness ref'd by AEND. + +] ;END IFN LISTSW, + +SUBTTL COMMON Output Routine .FILE - Close all output files. + +; .FILE - Counterpart to WINIT. +; Close input, bin, cref and list files. + +.FILE: ; Closing input file is simple enough... +IFN DECSW, RELEAS UTYIC, +IFN ITSSW, .CLOSE UTYIC, +IFN TNXSW,[ +IFN PMAPSW, MOVE A,[NIBFPS,,1STBFP] ? CALL DELPGS ; flush buffer pages + MOVE R1,INFB+$FJFN + CLOSF + JFCL + SETZM INFB+$FJFN + SETZM JFNCHS+UTYIC +] + MOVNI A,1 + SKIPL B,CONTRL ; If relocatable, + PUSHJ P,TPPB ; Output a -1 so stink will see EOF + SETZ A, ; In dec fmt, output a 0 at end. + TRNE B,DECREL + CALL TPPB + SKIPE OUTFB+$FEXT ; Check general name. + JRST .FILE2 ; Output fnam2 was explicitly specified + + ; Output extension (fn2) wasn't specified, default depends + ; on system and output type. +IFN ITSSW, MOVSI A,'BIN ; Default to SBLK output format; note that +IFE ITSSW, MOVSI A,'SBK ; this will include RIM, RIM10. + SKIPL B,CONTRL ; Using STINK output format? +IFN ITSSW, MOVSI A,'REL ; Yes, use appropriate thing for site. +IFE ITSSW, MOVSI A,'STK + TRNE B,DECSAV ; Using DECSAV output format? + MOVSI A,'SAV +IFN TNXSW,[ + TRNE B,DECSAV ; If using DECSAV format and + TLNN FF,FL20X ; on a 20X, then + CAIA + MOVSI A,'EXE ; use this extension instead. +] + TRNE B,DECREL ; Using DECREL output format? + MOVSI A,'REL +IFN FASLP,[ + TRNE B,FASL ; Using FASL output format? +IFE DECSW, MOVE A,[SIXBIT /FASL/] ; yes, smash as appropriate. +IFN DECSW, MOVSI A,'FAS +] +IFE TNXSW, MOVEM A,OUTFB+$F6EXT ; For 6bit systems, store final selection. +IFN TNXSW, PUSHJ P,TNXODF ; If Tenex, call output default hackery, since + ; changing stuff is a bit hairier. + +.FILE2: JSP A,OCLOSE + 0 UTYOC,UTOHDR ; Write out buffer, rename and close output file. + OUTFB +IFN LISTSW,[ + SKIPN LISTP ; Listing file open => + JRST .FILE3 + CALL PNTCR ; End with cr and ff. + MOVEI A,^L + CALL PILPT + PUSH P,FATAL ; Rename listing file even if fatal error. + SETZM FATAL + JSP A,OCLOSE + 0 LPTC,LSTHDR ; Output buffer, rename & close it. + LSTFB + POP P,FATAL +.FILE3: +] ;IFN LISTSW +IFN CREFSW,[ + SKIPN CREFP ; If cref file open, + POPJ P, + MOVEI A,0 + PUSHJ P,CRFOUT ; Output eof block, + JSP A,OCLOSE ; Write buffer, close. + 0 CREFC,CRFHDR ; 0 chnl,header + CRFFB +] + RET + + ; File out error output file. This isn't done in .FILE so that + ; error file can include a few more goodies and be closed separately + ; later on. +ERRCLS: SETZM FATAL ; Err file renamed even after fatal error. +IFN ERRSW,[ + SKIPN ERRFOP + RET ; There is none. + MOVEI A,^M + CALL ERRCHR ; Put crlf at ennd. + MOVEI A,^J + CALL ERRCHR + JSP A,OCLOSE ; Rename and close. + 0 ERRFC,ERRHDR + ERRFB + SETZM ERRFOP +] + RET + +SUBTTL ITS - Output file Open, Output, Close/Rename. +IFN ITSSW,[ + +; PUSHJ P,OINIT ; Open output file +; Mode chnl,name-block-addr +; Sixbit/desired-temporary-fn2/ +; Header,,buffer space ;used only in dec version. +; The mode should be 13^9 for binary, 0 for ascii. + +OINIT: MOVE A,(P) + HLRZ B,2(A) ; Get addr of header, + SETOM 2(B) ; Set buffer byte count to -1 => not initted. + MOVE AA,1(A) ; Get 2nd arg, temp FN2 to use. + MOVE F,(A) ; Get 1st arg - , + SYSCAL TRANS,[5000,,.UAO ; For output mode, + REPEAT 4,[? .RPCNT(F) ] ; translate from given names + REPEAT 4,[? MOVEM .RPCNT+FB+$F6DEV ]] ; into actual names, in scratch blk. + JRST OINITL ; (too many translations) + + SYSCAL DELETE,[FB+$F6DEV ; Delete old temp name file. + TMPFN1 ? AA ? FB+$F6DIR] + JFCL ; If none, it's ok. + LDB A,[270400,,F] ; Get channel num. + HRLI A,.BAO ; Open mode (default ascii) + TLNE F,777000 ; But maybe want image mode. + HRLI A,.BIO ; Yep, use that instead, to get ,, + SYSCAL OPEN,[A ? FB+$F6DEV ; Open file, + TMPFN1 ? AA ; using these temp filenames. + FB+$F6DIR] + JRST OINITL + BLTM L$F6BL,FB+$F6DEV,$F6DEV(F) ; Copy translated names into + ; name-block for file, for eventual rename. + +POPJ3: AOS (P) ; Skip over 3 args. +POPJ2: AOS (P) + JRST POPJ1 + +TMPFN1: SIXBIT /_MIDAS/ ; FN1 to use for temp filenames. + + + +; OINITL - jumped to from OINIT if some lossage +; encountered when opening output files. + + +OINITL: HLLZ A,@(P) ; Get chnl num, + TLZ A,777037 ; Mask to just ac field (chnl num) + IOR A,[.STATUS A] + XCT A ; Read its status, + PUSHJ P,OPNER ; Type out reason for open failure, and ask + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Get typein, one line. + MOVE F,@(P) ; Get + PUSHJ P,RFD ; Get new file description into filblk spec'd by F + JRST OINIT ; and jump back to try again. + +VBLK +ERRDNM: .UAI,,'ERR ? 3 +ERRCOD: 0 +IFSTS: 0 ; .STATUS word stored by OPNRD1 when .OPEN loses +PBLK + + ; Openloss documentation routine + +IOPNER: MOVE A,IFSTS ; Input +OPNER: MOVEM A,ERRCOD ; Save .status word + PUSHJ P,TYPFB ; Type out file description + PUSHJ P,CRRERR ; Now crlf to ensure room for following + .OPEN ERRC,ERRDNM ; Now get the system to say what's wrong + .LOSE %LSSYS ; Can't open err device? +IOPNR2: .IOT ERRC,A ; Get character from system + CAIGE A,40 ; Ends with ^L or ^C or other cruft. + PJRST CRRERR ; Return, typing out CRLF. + PUSHJ P,TYOERR ; Type out character + JRST IOPNR2 ; Loop back for next + + +; JSP A,OCLOSE +; 0 chnl,header +; Nameblockaddr +; Write out last buffer, rename to names in nameblock and close. + +OCLOSE: MOVE C,(A) ; 1st wd of args is what OBUFO wants. + LDB B,[360600,,1(C)] ; Just in case this is ascii file, + DPB B,[300600,,OCLOSP] ; Get bp to unused part of last wd of buffer, + MOVE B,[ASCIC//] + DPB B,OCLOSP ; And pad with ^c's. + SOS 2(C) ; Obufo assumes byte count was sos'd. + CALL OBUFO ; Write out last partial buffer + MOVE F,1(A) ; Get + LDB C,[270400,,(A)] ; Get chnl num. + SKIPE FATAL + JRST OCLOS1 ; After fatal error, don't rename outputfiles. + SYSCAL RENMWO,[C ; Rename (F has nameblock addr) + $F6FN1(F) ? $F6FN2(F)] + .LOSE %LSSYS +OCLOS1: SYSCAL CLOSE,[C] ; Close channel. + .LOSE %LSSYS + JRST 2(A) ; Skip over args on return. + + +; OBUFO - Write out and reinitialize buffer for file. +; Assumes byte count (header 3rd wd) was sos'd. +; C has <0 chnl,header> +; In ITS version, header 1st wd has ,,-1 + +OBUFO: PUSH P,A + PUSH P,AA + AOSGE 2(C) ; Was count sos'd from -1? + JRST OBUFO1 ; Yes, buffer hadn't been initted, don't write it. + MOVN A,1(C) + ADD A,(C) ; RH(A) has -<# wds used in buffer>. + MOVSI A,(A) + HRR A,(C) + AOS A ; A has aobjn -> used part of buffer. + HLLZ AA,C + IOR AA,[.IOT A] + CAIGE A, + XCT AA ; Write it in file. +OBUFO1: MOVE A,1(C) + HRR A,(C) ; Position the b.p. before start of buffer, + TLZ A,770000 ; After last byte in wd (idpb will use 1st buffer wd) + MOVEM A,1(C) + HLRE A,(C) + MOVEM A,2(C) ; Set up byte count. + REST AA + JRST POPAJ + +TFEED: TLNN FF,FLPTPF ; If output device not PTP, + POPJ P, ; Then do nothing + PUSHJ P,TPPBF ; Otherwise output the buffer, +TFEED1: .FEED UTYOC, ; Feed a line, + TLZA FF,FLPTPF ; If this is executed, utyoc doesn't have ptp after all + SOJG B,TFEED1 ; Feed the specified number of lines, + POPJ P, ; And return + +] ; IFN ITSSW + +SUBTTL DEC - Output file Open, Output, Close/Rename + +IFN DECSW,[ + +OINIT: MOVE AA,(P) + MOVE F,(AA) ; Get , + HLLZ TT,F + TLZ TT,#(0 17,) ; Mask off AC field in TT + HRRZ D,2(AA) ; Get buffer space addr. + HLLZ C,2(AA) ; Get header addr. + HLRZ A,C + SETZM (A) ; Clear out its-version contents of 1st header wd. + LDB A,[331100,,F] ; Get mode to open in (will be ascii or image binary) + IOR TT,[OPEN A] ; Cons up OPEN instruction for chan, + MOVE B,$F6DEV(F) ; and bring in last arg. + XCT TT ; Open channel,a + JRST OINITL ; Lost? + + PUSH P,.JBFF ; Now to fake out DEC system into consing up buffer + MOVEM D,.JBFF ; at this location. T10 uses .JBFF as pointer. + XOR TT,[#] ; Request buffer setup (one of) + XCT TT + REST .JBFF + MOVE A,[SIXBIT /000MD /] + PJOB B, ; Get job number, to make sixbit /md/ + IDIVI B,10. + DPB C,[220400,,A] + IDIVI B,10. + DPB C,[300400,,A] ; Put the digits of the job number into the sixbit word. + DPB B,[360400,,A] + MOVE AA,(P) + LDB B,[360600,,1(AA)] ; Get 1st char of 'output, 'lstout, 'crfout, 'errout. + IOR A,B ; Use it as last char of temp file name. + MOVSI B,'TMP ; Set up ext (fn2), + SETZ C, ; zap prot/date/time etc to default, + MOVE D,$F6DIR(F) ; and PPN. + XOR TT,[#] + XCT TT ; Do ENTER UTYOC,A + JRST OINITL +POPJ3: AOS (P) +POPJ2: AOS (P) + JRST POPJ1 + +; OINITL - jumped to from OINIT if some lossage +; encountered when opening output files. Jumps back to OINIT +; directly. + +OINITL: PUSHJ P,OPNER ; Type out reason for open failure, and ask: + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Get typein, one line. + PUSHJ P,RFD ; Get new file description into filblk spec'd by F + JRST OINIT ; and jump back to try again. + + ; Openloss documentation routine - not much to say. + +IOPNER: ; Input +OPNER: PUSHJ P,TYPFB ; Type out file description + PUSHJ P,CRRERR ; Now crlf to ensure room for following + TYPE "OPEN failed" + PJRST CRRERR ; Return, typing out another CRLF. + +;CLOSE AN OUTPUT FILE, SEE NON-DEC VERSION FOR ARGS. + +OCLOSE: PUSH P,A ; Save return addr + MOVE F,1(A) ; Get + SKIPGE FATAL ; If fatal error happened, + JRST OCLOS2 ; don't rename, just close. + MOVE C,$F6DEV(F) ; Delete any file with names + SETZB B,D ; we want to rename to. + OPEN ERRC,B ; Use ERRC as temporary channel. + JRST OCLOS1 + MOVE A,$F6FN1(F) + HLLZ B,$F6EXT(F) + SETZ C, + MOVE D,$F6DIR(F) + LOOKUP ERRC,A + JRST OCLOS1 ; There is none, just rename. + SETZ A, ; Say to delete this file + MOVE D,$F6DIR(F) ; From right UFD + RENAME ERRC,A + JFCL + RELEAS ERRC, +OCLOS1: MOVE A,$F6FN1(F) ; Desired fn1. + HLLZ B,$F6EXT(F) ; Desired fn2. + SETZ C, ; Bottoms-10 DATE75 lossage must never be forgotten! + MOVE D,$F6DIR(F) ; Sname (that is, ppn) + HLLZ AA,@(P) ; Get just chnl num. + IOR AA,[CLOSE] ; Close it & finalize, + XCT AA + XOR AA,[CLOSE#] + XCT AA ; Then rename to desired names. + JFCL ; at this point, ignore any lossage, sigh. +OCLOS2: HLLZ B,@(P) ; Get chnl in ac field. + IOR B,[RELEAS] + XCT B ; Finally, release channel. + JRST POPJ2 ; and skip over args on return. + + ; Write out buffer of output file, C has <0 chnl,header> +OBUFO: AND C,[0 17,] ; Get just chnl num. (sys remembers where header is for ch) + TLO C,(OUT) ; Output current buffer. + XCT C + RET ; Normal return! + PUSH P,A ; Error return from out uuo. + XOR C,[OUT#] + XCT C ; Read file status. + TRZ A,74^4 ; Clear error bits. + ETR [ASCIZ /Output data error/] + XOR C,[#] + XCT C + JRST POPAJ + + ; Paper tape stuff, do nothing. +TFEED: RET + +] ;END IFN DECSW, + +SUBTTL TNX - Output file Open, Output, Close/Rename + +IFN TNXSW,[ + +TFEED: RET ; Again, null out paper-tape hack. + +; OINIT - Open Output file. +; P points to first word of args which follow the call: +; 1: , ; is 0 for ascii, 13^9 for bin. +; 2: sixbit // +; 3:
,, +; +; Clobbers A,B,C + +; For Tenex, it is necessary to fudge the fileblock consistency slightly; +; $FJFN has in RH the actual JFN used to write to the temporary-name +; file, and in LH the JFN for the final desired filename. Note that if +; the $FEXT is null for main output file, it will be defaulted by TNXODF +; at close time, (to SAV, EXE, or REL) and the +; "final desired" JFN won't actually be used. +; Both JFNS are "active" rather than just a file spec. + +OINIT: MOVE C,(P) ; Get addr of arg block + HLRZ A,2(C) ; Get
, + SETOM 2(A) ; and set buffer byte cnt to -1 to mark for init. + MOVE F,(C) ; Get , + PUSHJ P,GETJFO ; Get output JFN for filblk. + JRST OINIT5 ; Lost? +OINIT2: HRLZS $FJFN(F) ; Won, move JFN over into LH. + + ; Aha, successfully grabbed a JFN for desired output filename. + ; Now must get another one for the temporary filename... + MOVSI A,(GJ%FOU+GJ%NEW) + PUSHJ P,TFMAP ; Must set up block again, may have changed due to RDJFNO. + MOVE A,1(C) ; Get sixbit/tmpfn2/ + PUSHJ P,CV6STR ; Convert to ASCIZ and return BP to string. + MOVEM A,GTJBLK+.GJEXT ; Store in long-form call blk. + SYSCAL GTJFN,[[GTJBLK] ? [0]][A] ; Repeat the GTJFN call. + JRST [ MOVEM A,ERRCOD ; Ugh???? + JRST OINIT5] + HRRM A,$FJFN(F) ; Good, got it... + + ; Now have both JFN's packed away, can finally open the + ; temporary filename. + HRRZ B,A ; Need JFN in RH with LH clear... + LDB A,[331100,,F] ; Get + CAIN A, + MOVSI A,070000 ; If 0, use ASCII (7-bit bytes) + TRNE A,-1 + MOVSI A,440000 ; If not 0, use WORD (36-bit bytes) + TRO A,OF%WR ; Get write access. + SYSCAL OPENF,[B ? A][A] ; Open up the temp file (JFN in RH) + JRST [ MOVEM A,ERRCOD ? JRST OINIT6] ; damn + + ; Won, successfully opened output file stuff etc, now wrap up. + HRRZ A,$FJFN(F) ; Get JFN used, + LDB C,[270400,,F] ; and channel number argument, + MOVEM A,JFNCHS(C) ; and store JFN away in channel slot. + PUSHJ P,CVFSIX ; Now put right things in $F6 entries. + MOVEI A,3 + ADDM A,(P) + POPJ P, + +.SCALAR ERRCOD + + ; Come here when GTJFN fails trying to get a JFN for GTJBLK long + ; form argument block. Must print out bad filename. + ; OINIT5 should really use names in GTJBLK, and + ; OINIT6 should really hack GJFNS call to get names, but for now... + +OINIT5: SKIPA A,[[ASCIZ /GTJFN failed for /]] +OINIT6: MOVEI A,[ASCIZ /OPENF failed for /] + PUSHJ P,CRRERR + TYPR (A) + PUSHJ P,OPNER1 ; Type out filename and error message. + PUSHJ P,RDJFNO ; Read new JFN + JRST OINIT2 ; try to open it. + +IOPNER: PUSH P,[CRRERR] ; Do following and add CRLF. +OPNER1: PUSHJ P,TYPFB + TYPE " +Error - " ; Drop thru to TERSTR. + + +TERSTR: MOVE A,ERRCOD + HRLI A,.FHSLF + SYSCAL ERSTR,[[-1,,ERSTRB] ? A ? [-LERSTR,,]][A ? A ? B] + JRST TERST7 ; undefined err #? + GOHALT ; destination bad? + TYPR ERSTRB + POPJ P, +TERST7: TYPE "Unknown error" + POPJ P, + + LERSTR==80. +.VECTOR ERSTRB(/5) + +; RDJFNO - Hack to get a new JFN by reading from TTY, using recognition. +; RDJFNI - Same but for input. Uses current FB for defaults. +; Stashes JFN away in RH of $FJFN(F). + +RDJFNO: SKIPA A,[GJ%FOU+GJ%NEW+GJ%CFM] ; For output +RDJFNI: MOVSI A,(GJ%OLD+GJ%CFM) ; for input + PUSHJ P,TFMAP + MOVE A,[.PRIIN,,.PRIOU] ; Use primary JFNs (TTY) for I/O + MOVEM A,GTJBLK+.GJSRC + PUSH P,R1 + PUSH P,R2 + PUSH P,R3 + SYSCAL DTI,[[.TICCV]] ; Disable ^V as an interrupt character + CAIA +RDJFN2: PUSHJ P,RDJERI ; Come here when get error in GTJFN. + MOVEI R1,.PRIIN ; Make sure that + CFIBF ; TTY input is reset. + HRROI R1,[ASCIZ / +Use what filename instead? /] + PSOUT + MOVEI R1, + MOVEI R1,GTJBLK + SETZ R2, + GTJFN + JRST RDJFN2 ; Error, report it. + SYSCAL ATI,[[.TICCV,,.IC.CV]] ; Turn back on ^V + POP P,R3 + POP P,R2 + HRRM R1,$FJFN(F) + POP P,R1 + PJRST JFNSTB ; Smash FB with names of the JFN we got, and return. + +; RDJERR - Report last error message directly to TTY (primary output). +; Useful when doing quick direct user interaction. + +RDJERR: TROA R2,-1 ; Here to get last error, whatever it was. +RDJERI: MOVE R2,R1 ; Here to use err code in R1. + HRLI R2,.FHSLF + HRROI R1,ERSTRB + MOVSI R3,-LERSTR + ERSTR ; Get error string + JRST RDJER6 + GOHALT + SKIPA R1,[-1,,ERSTRB] +RDJER6: HRROI R1,[ASCIZ /Unknown error/] + ESOUT ; Output to TTY amid other hackery. + POPJ P, + + +; TNXODF - Hack to get yet another "desired" JFN so that when no +; extension was specified for binary output file, one appropriate to +; the type can be selected. +; Basically do a GTJFN again for binary output filenames, furnishing +; the default extension selected, and use that to replace the one +; already in LH of $FJFN. + +TNXODF: PUSHJ P,CV6STR ; Convert sixbit word in A to string, get BP in A + MOVEI F,OUTFB ; Point at right filblk, + MOVEM A,$FEXT(F) ; Store, and now + PUSH P,$FJFN(F) ; Save current set of JFNs before + PUSHJ P,GETJFO ; getting another one + JRST POPAJ ; If lossage, stick to old JFN. + POP P,A + HRLZS $FJFN(F) ; GETJFO puts JFN into RH, we want it in LH. + HRRM A,$FJFN(F) ; now restore previous RH. + HLRZS A ; and get old "desired" JFN in position for + SYSCAL RLJFN,[A] ; releasing. + JFCL + POPJ P, + +; OCLOSE - Close output file, writing out remainder of buffer and renaming +; from temporary to desired filename. +; JSP A,OCLOSE +; 1: 0 ,,
+; 2: +; Clobbers F,C (and obviously A) + +; 10x must do CLOSF, not releasing the JFN, and then a RNAMF from temp +; JFN to desired JFN, after which both can be released. The desired and +; used JFNs are in LH and RH respectively of $FJFN in . +; is ignored except to wipe out its JFNCHS entry. + +OCLOSE: PUSH P,A + MOVE C,(A) ; Get ,,
+ SOS 2(C) ; OBUFO assumes count was SOS'd before each call + PUSHJ P,OBUFO ; Write out anything remaining in buffer. + LDB C,[270400,,(A)] ; Get channel number + MOVE F,1(A) ; Get + HRRZ A,$FJFN(F) ; Find JFN being used... + CAME A,JFNCHS(C) ; Should be same as JFN for channel. + GOHALT ; Synch error or something. + TLO A,(CO%NRJ) ; Say don't release JFN + SYSCAL CLOSF,[A] ; Close file... + GOHALT ; ?!?! + HRRZS A ; Get back 0,,jfn + SETZM JFNCHS(C) ; Indicate "channel" closed... + SKIPE FATAL ; If fatal error happened in assembly, + JRST OCLOS5 ; don't rename from temp filenames. + HLRZ C,$FJFN(F) ; Now see what if anything to rename it to. + JUMPE C,OCLOS5 ; If no renaming needed, skip hair. + SYSCAL RNAMF,[A ? C] ; Rename file from JFN in A to JFN in C. + GOHALT ; WTF? + SYSCAL RLJFN,[C] + GOHALT + JRST OCLOS6 ; JFN in A released by RNAMF. + +OCLOS5: SYSCAL RLJFN,[A] + GOHALT +OCLOS6: SETZM $FJFN(F) + POP P,A + JRST 2(A) + +; OBUFO - Output Buffer and reinitialize. +; C/ 0 ,
+; Clobbers no ACs. + +; 10X is pretty much like ITS, JFN is kept in JFNCHS table indexed by . + +OBUFO: PUSH P,A + PUSH P,B + MOVE A,1(C) ; Get write BP, + HRR A,(C) ; and reset it... + TLZ A,770000 ; to point at start of buffer, + MOVEM A,1(C) ; and store it back, which is OK since we have byte cnt + AOSGE 2(C) ; Was buffer marked for initialization (cnt -1)? + JRST OBUFO1 ; Yes, don't write anything, just go init rest of it. + HLRZ A,(C) ; Get buffer size in wds, + MOVNI A,(A) ; make negative, + ADD A,2(C) ; and add count of bytes left to get -<# bytes used>. + LDB B,[270400,,C] ; Get channel # as index to JFN + PUSH P,T + SYSCAL SOUT,[JFNCHS(B) ? 1(C) ? A] + POP P,T +OBUFO1: HLRZ A,(C) ; Get buffer size again, + MOVEM A,2(C) ; and reset count with it. + POP P,B + POP P,A + POPJ P, + +] ;END IFN TNXSW + +SUBTTL COMMON Input Routines - Main File Open, EOF handling + +; Open main input file for reading (filespec in ISFB) + +OPNRD: +IFN ITSSW, .IOPDL ; Re-initialize IO pdl +IFN DECSW\TNXSW, CALL IOPDLC ; Non-ITS systems must simulate. + INSIRP SETZM,INFCNT INFCUR INFERR + MOVE A,[-TYPDLS-1,,TTYPDL] + MOVEM A,ITTYP ; Initialize "tty pdl" + PUSHJ P,MACIN1 ; Clobber macro expansion status + MOVE A,[ISFB,,INFB] ; Copy ISFB specs to INFB (which will hold + BLT A,INFB+L$FBLK-1 ; actual names of current input file) + MOVE A,ISFB+$FDEV ; Get device name + CAMN A,FSTTY ; TTY? + JRST [ MOVE A,[ISFB+$F6FN1,,IFNM1] ; TTY specified, treat special + BLT A,IFNM2 ; Clobber .IFNM1, .IFNM2 to specified + MOVE A,ISFB+$FVERS + MOVEM A,IFVRS + TYPECR "Reading from TTY:" + MOVEI A,3 ; => input from tty, don't quit on cr + JRST OPNRT2] + MOVEI F,INFB ; Point things at INFB. + PUSHJ P,OPNRD1 ; Try opening file + JRST [ PUSHJ P,IOPNER ; Open lost, type out message + POPJ P,] ; Read new command (this may screw on pass2?) + MOVEM A,INFERR ; Err msg in main file shouldn't type names. + MOVEI A,0 ; => input from file +IFN TNXSW,[ + MOVE T,INFB+$FJFN ; Copy actual jfn to avoid re-GTJFN + MOVEM T,ISFB+$FJFN +] +OPNRT2: MOVE T,[IFNM1,,RFNAM1] + BLT T,RFVERS ; Set up .FNAM1, .FNAM2 + SETOM NEDCRL + AOS (P) ; Won, skip on return. + JRST RCHSET ; Set up to read from file or tty. (arg in A) + + + ; Common stuff for OPNRD1 in all (DEC/ITS/TENEX) versions. +OPNRD3: HRRZM A,UTIBED ; Say buffer empty, + MOVSI A,EOFCH_13 + MOVEM A,@UTIBED ; Cause immediate reload. +OPNRD4: BLTM 2,$F6FN1(F),IFNM1 ; Set up .IFNM1, .IFNM2 from filblk F points at + MOVE A,$FVERS(F) + MOVEM A,IFVRS + AOS A,INFCNT ; Assign this file a number. + MOVEM A,INFCUR ; OPNRD expects this left in A. + JRST POPJ1 + + ; EOF while trying to read character + +RPAEOF: PUSH P,B ; Save B +RPAEO1: MOVE B,ITTYP ; Get pdl pointer + PUSHJ P,BPOPJ ; Call pop routine (maybe NED's out) + JRST RCHTRB ; Return to get character + + ; EOF from main file + +NEDCHK: TRNE FF,FRCMND ; ^C read in command, :KILL self. + JRST TSRETN + SKIPN RCHMOD + AOSE NEDCRL + JRST NEDCH1 + + ; Invent one crlf after end of main file. + MOVE B,[440700,,[.BYTE 7 ? ^M ? ^J ? EOFCH]] + MOVEM B,UREDP + HRRZM B,UTIBED +IFN PMAPSW,[ + HRLI B,170700 ; Make BP pointing at last (3rd) char + MOVEM B,UTIBPE ; Set EOF BP properly. +] + RET +NEDCH1: +IFN A1PSW,[ + PUSHJ P,OUTCHK + MOVSI A,-LNEDT + XCT NEDT(A) ; Skips if NED condition to be complained about + AOBJN A,.-1 + JUMPGE A,GO8 +] + ETF [ASCIZ /No END statement/] + +.SCALAR NEDCRL ; -1 => haven't yet supplied a CRLF at EOF of main file. + +IFN A1PSW,[ ; Holler "NED" if any of the following: +NEDT: SKIPL PRGC ; No end statements have been encountered + SKIPGE OUTC ; Output has occured not matched by an end statement + SKIPGE OUTN1 ; Output has occured other than in 1pass mode + TRNN FF,FRPSS2 ; Currently in pass 2 +LNEDT==.-NEDT ; Length of table +] + +SUBTTL ITS - Input file Open, buffer input +IFN ITSSW,[ + + ; Try .OPENing input file pointed to by F. Skips if successful. + ; Sets filenames to actual names. + +OPNRD1: SYSCAL OPEN,[[.BAI,,UTYIC] + $F6DEV(F) ? $F6FN1(F) ? $F6EXT(F) ? $F6DIR(F)] + JRST [ .STATUS UTYIC,IFSTS ; Lost, save status now before possible + POPJ P,] ; .IOPOP, and make failure return. + SYSCAL RFNAME,[%CLIMM,,UTYIC ; Now find true filenames. + MOVEM A + MOVEM C ; But need to check FN1, FN2 so + MOVEM D ; put them in ACs instead. + MOVEM $F6DIR(F)] + .LOSE %LSFIL + CAMN A,[SIXBIT/DSK/] + MOVE A,V.SITE ; Use machine name instead of DSK. + MOVEM A,$F6DEV(F) + CAIE C, ; If FN1 meaningless for device, skip to use + MOVEM C,$F6FN1(F) ; spec'd FN1 anyway, but else store actual FN1. + CAIE D, + MOVEM D,$F6FN2(F) ; Ditto for FN2. + MOVE D,[440600,,$F6FN2(F)] + SETZ A, +OPNRD7: TLNN D,770000 + JRST OPNRD6 + ILDB C,D ; Calculate version number as number from fn2. + CAIL C,'0 ; Ignore non-digits. + CAILE C,'9 + JRST OPNRD7 + IMULI A,10. + ADDI A,-'0(C) + JRST OPNRD7 + +OPNRD6: SKIPN A ; No digits in FN2 => use -1 as version. + SETO A, + MOVEM A,$FVERS(F) + MOVE A,IUREDP ; Set up reading ptr, + MOVEM A,UREDP + JRST OPNRD3 ; Set up ^C after buffer, infcur, etc. + + + ; EOFCH encountered on read, reload and jump back for next char + +INCHR3: HRRZ CH1,UREDP ; Get byte pointer + CAME CH1,UTIBED ; End of block? + RET ; No, ^C in file. + MOVE A,IUREDP + MOVEM A,UREDP + MOVE A,[-UTIBFL,,UTIBUF] + .IOT UTYIC,A ; Read in block + ANDI A,-1 + CAIN A,UTIBUF ; If the iot didn't give us anything, we are at EOF. + JRST RPAEOF + HRRZM A,UTIBED ; Store RH (updated pointer) for EOF check at INCHR3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ; Store a ^C after the data we read, so at EOB we come to INCHR3. + JRST RCHTRA ; Now try next char +] ;END IFN ITSSW + +SUBTTL DEC - Input file Open, buffer input + +IFN DECSW,[ + +OPNRD1: MOVEI C,UTIHDR ; Open the input file w/ names in dnam ... snam. + SETZ A, ; Mode ascii. + MOVEI D,UTIBUF + MOVE TT,UTICHN ; Get channel num. to use. + LSH TT,27 ; Put in ac field. + IOR TT,[OPEN A] + MOVE B,$F6DEV(F) + XCT TT ; Open channel,a + RET + CALL BUFINI ; Initialize the input buffers and header. + MOVE D,$F6DIR(F) + MOVE A,$F6FNM(F) + HLLZ B,$F6EXT(F) + TLC TT,(OPEN#LOOKUP) + XCT TT ; Lookup channel,a + RET ; Failed. +IFE SAILSW,[ + MOVE A,$F6DEV(F) + DEVNAM A, ; Get real name of device. + CAIA + MOVEM A,$F6DEV(F) +] + MOVE D,[440600,,$F6FN2(F)] + SETZ A, +OPNRD7: TLNN D,770000 + JRST OPNRD6 + ILDB C,D ; Calculate version number as number from fn2. + CAIL C,'0 ; Ignore non-digits. + CAILE C,'9 + JRST OPNRD7 + IMULI A,10. + ADDI A,-'0(C) + JRST OPNRD7 + +OPNRD6: SKIPN A ; No digits in FN2 => use -1 as version. + SETO A, + MOVEM A,$FVERS(F) + MOVE A,UREDP + JRST OPNRD3 + + + ; Reload buffer, DEC style. +INCHR3: HRRZ CH1,UREDP ; Is this ^C at end of buffer? + CAME CH1,UTIBED + RET ; No, ^C in file. + PUSH P,B + MOVE A,UTICHN + LSH A,27 ; Channel num. in ac fld. + TLO A,(IN) + XCT A ; Get next bufferfull. + CAIA ; Succeed. + JRST INCHR4 ; Error. +INCHR5: MOVE A,UTICNT + ADDI A,9 + IDIVI A,5 + ADD A,UREDP ; -> 1st wd not read into. + HRRZM A,UTIBED + HRRZ A,UREDP + AOS A + MOVEI B,1 ; Scan the file and replace all line numbers with nulls. +INCHR6: CAMN A,UTIBED + JRST INCHR7 + TDNE B,(A) + MOVEM B,(A) + AOJA A,INCHR6 + +INCHR7: MOVSI B,EOFCH_13 + MOVEM B,(A) ; Put EOF char after buffer, in extra word. + JRST RCHTRB ; Retry RCH. + +INCHR4: XOR A,[#IN] + XCT A + TRZE B,74^4 + ETR [ASCIZ /Input data error/] + XOR A,[#] + XCT A ; Clear error bits in status. + TRNN B,2^4 + JRST INCHR5 + JRST RPAEO1 ; EOF. + +; BUFINI - Create DEC-style buffer ring, with 1 extra word following +; each buffer... +; A/ +; B/ +; C/
+; D/ +; Note that this extra-word crock is necessary just so it can be filled +; with ^C's to stop read loop and switch to next buffer. + +BUFINI: MOVEI AA,A +IFE SAILSW,DEVSIZ AA, + SKIPA AA,[DECBFL+1] ; Default buffer size is that for dsk. + AOJLE AA,.-1 ; Get size including extra wd. + MOVEI T,1(D) ; Addr of wd 2 of 1st buffer. + HRLI AA,T ; @AA is addr of 2nd wd of next buffer. + SUBI D,(AA) ; Facilitate test for end of buffer space. + HRLI T,400000 + MOVEM T,(C) ; Header -> a buffer, sign set. + HRRM T,1(C) ; Make rh of bp -> buffer 1st wd. + MOVSI T,440000 ; Set up p-field of b.p. + IORM T,1(C) + HRRZ T,1(C) + AOS 1(C) + HRLI T,-3(AA) ; Data-area-size +1,,addr-of-2nd-wd +BUFIN1: CAIGE D,-UTIBFL(T) ; Room for another after this buffer? + JRST BUFIN2 ; No, wrap up. + MOVEM T,@AA ; Yes, make next buffer -> this one, + HRRI T,@AA ; Point to next one. + JRST BUFIN1 + +BUFIN2: ADDI D,1(AA) ; -> 2nd wd of 1st buffer. + MOVEM T,(D) ; 1st buffer -> last, making ring. + RET + +] ;END IFN DECSW, + +SUBTTL TNX - Input file Open, buffer input + +IFN TNXSW,[ + +; OPNRD1 - Open File for Reading. Old stuff assumed fnm in DNAM +; using UTYIC channel, but new should furnish arguments: +; F/ to open + +; Essentially just GTJFN and OPENF like OINIT does, with same +; sort of error handling, except that when reading from cmd line +; as opposed to .INSRT, just go back to get completely new command. +; (perhaps if typein is just CRLF, go to special TNX style cmd input?) + +OPNRD1: CAIN F,INFB ; Horrible kludge necessary because MIDAS main + ; level doesn't bother to explicitly close main + ; input file when pass 1 is done, and TNX barfs if + ; you try to re-open a JFN... sigh. + JRST [ SKIPN $FJFN(F) ; Main file. Already opened it? + JRST .+1 ; nope, get JFN & open normally. + IFE PMAPSW,[ ; Already open. If not mapping, reset read ptr. + SYSCAL SFPTR,[$FJFN(F) ? [0]][ERRCOD] + POPJ P,] + JRST OPNRD2] ; and avoid attempt to re-open the JFN. + SKIPN $FJFN(F) + JRST [ PUSHJ P,GETJFI ; No JFN, get one for input. + POPJ P, ; Could fail. + JRST .+1] + PUSH P,T ; Read access, full word input. + SYSCAL OPENF,[$FJFN(F) ? [440000,,OF%RD]][ERRCOD] + JRST [POP P,T ? POPJ P,] ; Failure + POP P,T +OPNRD2: HRRZ A,$FJFN(F) + MOVEM A,JFNCHS+UTYIC ; Indicate "channel" open with this JFN. + PUSHJ P,JFNSTB ; Get actual names/version #. + PUSHJ P,CVFSIX ; Put right stuff in $F6 entries. + MOVE A,IUREDP ; Opened, set up buffer. + MOVEM A,UREDP ; Initialize BP into buffer. +IFE PMAPSW, JRST OPNRD3 +IFN PMAPSW, JRST OPNR50 ; for PMAP hacking, lots of stuff to do. + + ; Get a JFN for current FILBLK (in F) and stick it into $FJFN(F). + ; A should hold flags in LH to use in 1st wd of block. + ; GETJFI - sets usual flags for input + ; GETJFO - sets " " output + ; GETJFN - takes whatever A holds. + +GETJFO: SKIPA A,[GJ%FOU+GJ%NEW] ; If hacking output, ask for new version. +GETJFI: MOVSI A,(GJ%OLD) ; If hacking input, file must exist. +GETJFN: PUSHJ P,TFMAP ; Stick filblk stuff into GTJFN scratch block. + PUSH P,R1 + PUSH P,R2 + MOVEI R1,GTJBLK + SETZ R2, + GTJFN + JRST [ MOVEM R1,ERRCOD ; failure, save error code. + JRST GETJF5] + HRRM R1,$FJFN(F) ; Win, save JFN. + AOS -2(P) +GETJF5: POP P,R2 ; Can't return in ACs cuz don't know what R1 etc are, + POP P,R1 ; and might clobber them here. + POPJ P, + +; TFMAP - Map Tenex filenames from filblk pointed to by F into +; standard scratch block for long-form GTJFN. +; A/ ,,0 ; flags will go into LH of .GJGEN. +; Clobbers only A. + +TFMAP: HRR A,$FVERS(F) ; Put version # in RH + SKIPE $FTEMP(F) ; If asking for temp file, + TLO A,(GJ%TMP) ; set appropriate flag. + MOVEM A,GTJBLK+.GJGEN +IRP FROM,,[$FDEV,$FDIR,$FNAME,$FTYPE,$FPROT,$FACCT,$FJFN]TO,,[.GJDEV,.GJDIR,.GJNAM,.GJEXT,.GJPRO,.GJACT,.GJJFN] + MOVE A,FROM(F) + MOVEM A,GTJBLK+TO +TERMIN + MOVE A,[.NULIO,,.NULIO] + MOVEM A,GTJBLK+.GJSRC ; Don't hack I/O in gtjfn. + POPJ P, + +.VECTOR GTJBLK(10.) ; Need exactly this many wds for non-extended long call + +IFE PMAPSW,[ + ; EOFCH seen in input, check it here. + +INCHR3: HRRZ CH1,UREDP ; Get byte pointer + CAME CH1,UTIBED ; End of block? + RET ; No, ^C in file. + MOVE A,IUREDP + MOVEM A,UREDP + PUSH P,T + SYSCAL SIN,[JFNCHS+UTYIC ? [444400,,UTIBUF] ? [-UTIBFL]][A ? A ? A] + POP P,T + ADDI A,UTIBUF+UTIBFL ; Get UTIBUF + <# bytes stored> + CAIG A,UTIBUF ; If the sin didn't give us anything, we are at eof. + JRST RPAEOF + HRRZM A,UTIBED ; Store rh (updated pointer) for eof check at inchr3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ; Store a ^c after the data we read + JRST RCHTRA ; Now try next character + +] ; IFE PMAPSW + +IFN PMAPSW,[ ; New stuff for PMAP'ing input etc. + +VBLK +IFNDEF NIBFPS,NIBFPS==10 ; # of pages per buffer +PGBFL==NIBFPS*1000 ; Length of a buffer in wds. +IFNDEF 1STBFP,1STBFP==500 ; # of first page to start buffers at. + +INBFPG: 1STBFP ; # of 1st buffer page (in our address space) +INFPAG: 0 ; # of page in file corresponding to 1st page in buffer. +INPGCT: 0 ; -# times to refill buffer with new pages. +INLPGS: 0 ; # pages to slurp on last refill (instead of NIBFPS) +UTIBPE: 0 ; BP to last byte of data in buffer (holding ^C) +UTIBPL: 0 ; BP to last byte position in buffer area (constant) +UTIBPX: 0 ; BP to last byte of data when last pages have been mapped. +INLCHR: 0 ; Place to save char that ^C replaces. If -1, no char. +;SOSSW: 0 ; non-Z if hacking SOS line-number type file. +FBBYV: 0 ; GTFDB dumps cruft in these two locs. +FBSIZ: 0 ; e.g. this gets size of file in bytes. +PBLK + + ; Wrap up open of an input file, by initializing all the cruft + ; above. +OPNR50: SYSCAL GTFDB,[$FJFN(F) ? [2,,.FBBYV] ? MOVEI FBBYV] + LDB C,[300600,,FBBYV] ; Get byte size of file + CAIN C, + MOVEI C,36. ; If 0 use 36-bit bytes (full wds) + MOVEI A,36. + IDIVI A,(C) ; Get bytes per wd, ignore remainder. + MOVE B,FBSIZ ; Now, with # bytes in file, + EXCH A,B + IDIVI A,(B) ; find <# in fil>/<# per wd> = # wds in file + CAIE B, ; Also hack + ADDI A,1 ; rounding up (gasp, wheeze, finally done.) + IDIVI A,PGBFL ; Now get # times buffer will need slurping... + ADDI A,1 ; And another for the final slurp (even if it will be empty) + MOVNM A,INPGCT ; Store -# slurps. + MOVEI A,777(B) + LSH A,-9. ; Find # pages last slurp really needs. + MOVEM A,INLPGS ; and store away. + HRLI B,010700 + MOVEM B,UTIBPX ; Store relative BP to last ch (when last pages mapped) + HRRI B,PGBFL ; And relative BP to last char in whole buffer + MOVEM B,UTIBPL ; Note UTIBPX and UTIBPL actually point to next wd + ; but this is fixed when abs addr is added in. + + MOVE A,INBFPG ; Find page # buffer starts at in core, + LSH A,9. ; Get address, and + SUBI A,1 ; Subtract one, to fix UTIBPX, UTIBPL, and IUREDP. + ADDM A,UTIBPX ; add into the BP's to make them absolute. + ADDM A,UTIBPL + HRLI A,010700 ; And use for initial read pointer - + ; MUST be "canonical form", so that SEMIC hackery + MOVEM A,IUREDP ; will work with weird way INCHR3 returns here. + MOVNI A,NIBFPS ; Use this as initial file page #, so the ADDB in + MOVEM A,INFPAG ; INCHR3 will do right thing to it. + MOVE A,[440700,,[EOFCH_35]] + MOVEM A,UREDP ; set up things so first RCH will instantly cause reload. + ILDB B,A + MOVEM A,UTIBPE + SETOM INLCHR ; Mustn't forget that we don't have a stored char yet. + JRST OPNRD4 ; Finally done with PMAP init stuff. + + ; Come here when hit ^C +INCHR3: MOVE CH1,UREDP ; Get current read ptr + CAME CH1,UTIBPE ; At end of buffer? + POPJ P, ; Nope, ^C in file, actual input. + AOSLE CH1,INPGCT ; Aha, end of buffer. Bump times refilled... + JRST INCH56 ; and if no more refills, go handle EOF. + MOVE A,IUREDP + MOVEM A,UREDP +IFN A-1,PUSH P,R1 +IFN A-2,PUSH P,R2 +IFN A-3,PUSH P,R3 + MOVEI R1,NIBFPS ; Get # of input buffer pages + ADDB R1,INFPAG ; and find current page in file to get + HRL R1,$FJFN+INFB ; current input file's JFN + MOVE R2,INBFPG ; and usual pointer to destination buffer page + HRLI R2,.FHSLF ; Why the fuck doesn't 10X default this?!?! + MOVEI R3,NIBFPS ; Set # pages to slurp up + JUMPN CH1,INCH51 ; But if this is last slurp, + SKIPG R3,INLPGS ; Use pre-calculated # to avoid non-ex pages. + JRST INCH55 ; No pages in last slurp! Avoid new PMAP. + +INCH51: TLO R3,(PM%CNT+PM%RD+PM%CPY) ; Read access, copy-on-write. +INCH52: PMAP ; Gobble gobble + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI R3,-1(R3) ; Else, on 10X, must iterate manually. + TRNE R3,400000 ; See if became "negative". + JRST INCH53 ; Yep, done with manual iteration. + ADDI R2,1 ; Nope, bump page #'s. + AOJA R1,INCH52] +INCH53: +IFN A-3,POP P,R3 +IFN A-2,POP P,R2 +IFN A-1,POP P,R1 + CAIE CH1, ; Was this the last slurp? + SKIPA CH1,UTIBPL ; no, use BP to Last char at end of buffer. + MOVE CH1,UTIBPX ; yes, need BP to last char in last page. +IFN 0,[ SKIPE SOSSW ; If hacking line number lossage, + JRST [ MOVE A,(CH1) ; must beware of getting wiped, so have to + TRNE A,1 ; check here, and if depositing EOFCH in #, + HRLI CH1,350700 ; then move the EOFCH to beg of word! + JRST .+1] +] + LDB A,CH1 ; Replace last char of buffer's data + MOVEI CH2,EOFCH + DPB CH2,CH1 ; with the EOF char. + MOVEM CH1,UTIBPE ; Remember ptr to end of data, + EXCH A,INLCHR ; and save char for then, returning whatever + JUMPL A,RCHTRA ; was the last char of last bufferfull. + ; (may be -1, in which case RCHTRA tries again) + + ; Jump here to return a new char in A, something like + ; RCHTRA without all the fuss. +INCHR7: POP P,CH1 ; Get return addr + ANDI CH1,-1 + CAIE CH1,RREOF+1 + JRST -2(CH1) ; Note -2 not -3 as in RCHTRA! + JRST (CH1) ; Special hack since -2 loses for RREOF. + ; Perhaps someday it will win. + +INCH55: ; Here when doing last slurp and no pages to slurp. +IFN A-3,POP P,R3 +IFN A-2,POP P,R2 +IFN A-1,POP P,R1 +INCH56: SKIPGE A,INLCHR ; No more refills, see if last char left + JRST RPAEOF ; No? All done, true EOF. + SETOM INLCHR ; Almost, one last char. + MOVE CH1,UREDP ; Must bump ptr back one char, so next read + ADD CH1,[070000,,] ; will also stop. + CAIG CH1, + SUB CH1,[430000,,1] + MOVEM CH1,UREDP + JRST INCHR7 ; Return very last char in A. + +] ; IFN PMAPSW + +] ;END IFN TNXSW + +ifn 0,[ ; turn off but keep around for a while. +SUBTTL old .INSRT Processing + +; .INSRT ; Insert file here +; TTY: => ok, reads line at a time, rubout allowed within line +; Pushes macro expansion, other .INSRT's +; In filedescription, ^R => reset file name counter [?!? - KLH] +; If device is "@:", always ask for translation. + +A.INSR: NOVAL + MOVE A,[ISFB,,FB] ; Default names are those of spec'd input file + BLT A,FB+L$FBLK-1 ; Zap them into scratch filblk. + MOVEI F,FB ; And point at it. + MOVE A,FSDSK + MOVE B,FSTTY ; Compare "TTY" with + CAMN B,$FDEV(F) ; device name, and if identical, + MOVEM A,$FDEV(F) ; default to DSK. +IFE ITSSW,MOVE A,FSMID ; Always set default extension to "MID" or ">" +IFN ITSSW,MOVE A,FSGRTN + MOVEM A,$FEXT(F) + + TLO FF,FLUNRD +A.IN1: PUSHJ P,RFD ; Read file description + MOVE A,$FDEV(F) ; Get specified device name + CAME A,FSATSN ; Atsign? + PUSHJ P,A.ITRY ; No, try opening file + + ; If return, open failed. + MOVE A,$F6DEV(F) + AOJE A,A.INT1 ; Already trying to set up table entry + SKIPA F,[MAXIND,,TBLOFS] ; Atsign, or fnf, search table + +A.IN2: SUBI F,-L$FBLK ; Loop point searching table, increment to next entry, count down LH + CAMN F,INDDP ; Compare with pointer to top of table + JRST A.IN3 ; Agree => this file not in table + +; MOVEI A,-TBLOFS(F) ; Get index relative to table base. +; MIDAS complains "illegal use of relocation" when try to use above addr, so must use next 2 instructions instead - barf barf + MOVEI A,(F) + SUBI A,TBLOFS + + MOVSI B,-L$FBLK ; And index into FB. + MOVE T,TBLSFS(A) ; Get specification name this entry +A.IN25: CAMN T,FB(B) ; Compare with that just specified + AOBJN B,[AOJA A,.-2] ; Check all names this entry +IFE TNXSW, JUMPL B,A.IN2 +IFN TNXSW,[JUMPL B,[ MOVEI C,(B) + CAIN C,$FJFN ; One item of entry didn7t match, was it JFN? + JRST A.IN25 ; Yes, ignore it and continue. + JRST A.IN2] ; Sigh, was something else, entry doesn't match. + ] + + ; File is in table + MOVSI A,(F) ; Move description from TBLOFS to FB. + HRRI A,FB + BLT A,FB+L$FBLK-1 +IFN TNXSW, SETZM FB+$FJFN ; Since re-opening, must zap previous JFN. + PUSHJ P,A.ITRY ; Try opening file + + ; If return, open failed. + MOVSI A,TBLSFS-TBLOFS(F) ; Set up LH(BLT pointer), + HRRI A,FB + BLT A,FB+L$FBLK-1 ; Unmap to original names(TBLSFS to FB) + PUSHJ P,TYPFB ; Type out specified names + TYPE " -> " ; Type out pointer + MOVSI A,(F) ; Copy translation (TBLOFS entry) back to FB. + HRRI A,FB + BLT A,FB+L$FBLK-1 + SETOM $F6DEV(F) ; "half-kill" entry in TBLOFS + +A.INT1: PUSH P,F + MOVEI F,FB + PUSHJ P,IOPNER ; Open lost, type out cruft + POP P,F + TYPE "Use what filename instead? " +A.INT2: PUSHJ P,GTYIP ; Prepare to read one line from tty + JRST A.IN1 ; Try again with what he types in + + ; File not in table, try to add a translation for it. + +A.IN3: TLNN F,-1 ; More room for another entry in table? + ETF [ASCIZ /Too many @: files/] + MOVEI A,TBLSFS-TBLOFS(F) ; Copy FB into TBLSFS (specified name) + HRLI A,FB + BLT A,TBLSFS-TBLOFS+L$FBLK-1(F) + SETOM $F6DEV(F) ; Document fact that entry has only key, not translation + MOVNI A,-L$FBLK + ADDM A,INDDP ; Update pointer into table + MOVE A,FB+$FDEV ; Get specified device name + CAME A,FSATSN ; Atsign? + JRST A.INT1 ; No, type out garbage and try again, reading from tty + MOVE A,ISFB+$FDEV ; Yes, clobber from input device name + MOVEM A,FB+$FDEV + JRST A.INT2 + +;TRY OPENING INPUT FILE FOR .INSRT, RETURN IF UNSUCCESSFUL + +A.ITRY: MOVE A,FB+$FDEV ; Get specified device name + CAMN A,FSTTY ; TTY? + JRST A.ITRT ; Yes, treat special + TLO FF,FLUNRD + PUSHJ P,IPUSH ; Save current status + PUSH P,F ; save what F points at + MOVEI F,FB + PUSHJ P,OPNRD1 + JRST [POP P,F ? JRST IPOPL] ; Lose, pop and return + POP P,F + MOVE B,[FB,,INFB] ; Kludge for time being - if win, + BLT B,INFB+L$FBLK-1 ; Copy all stuff into INFB. +IFN ITSSW,CALL SETWH2 + MOVE B,ITTYP + MOVEI A,-2-TYPDEL(B) ; + HRLI A,IFNM1 + BLT A,-TYPDEL(B) ; Introduce hysteresis so .INSRT'ing file can reference .IFNM1, .IFNM2 +IFN CREFSW,[ + SKIPE CRFONP ; If creffing, output push-file block. + PUSHJ P,CRFPSH ; (pop-file block output at ipop) +] +A.ITR2: + MOVE A,$F6DEV(F) ; Push successful, now check to see if table entry should be finished + AOJN A,ASSEM1 + MOVEI A,(F) ; Move FB into TBLOFS as translation entry. + HRLI A,FB + BLT A,L$FBLK-1(F) + JRST ASSEM1 ; Now assemble from file (ASSEM1 clobbers pdl) + + ; .INSRT TTY: + +A.ITRT: PUSHJ P,GTYIPA ; Read from tty, don't quit until .INEOF + JRST A.ITR2 ; Fall back in (doesn't touch .IFNM1, .IFNM2) +] ; end IFN 0 + +SUBTTL .INSRT Processing + +; .INSRT ; Insert file here +; TTY: => ok, reads line at a time, rubout allowed within line +; Pushes macro expansion, other .INSRT's +; If device is "@:", always ask for translation. + +A.INSR: NOVAL + + ; First set up defaults for parsing filename. + BLTM L$FBLK,ISFB,FB ; Default names are those of spec'd input file, + MOVEI F,FB ; stuffed into scratch FB. + MOVE A,FSDSK + MOVE B,FSTTY ; Compare "TTY" with + CAMN B,$FDEV(F) ; device name, and if identical, + MOVEM A,$FDEV(F) ; default to DSK. +IFE ITSSW,MOVE A,FSMID ; Always set default extension to "MID" or ">" +IFN ITSSW,MOVE A,FSGRTN + MOVEM A,$FEXT(F) + + TLO FF,FLUNRD + PUSHJ P,RFD ; Read file description from current input. + MOVE A,$FDEV(F) ; Get specified device name + CAMN A,FSATSN ; Atsign? + JRST A.IN50 ; If so, check out translation right away. + +A.IN2: CAMN A,FSTTY ; TTY? Must handle specially. + JRST [ PUSHJ P,GTYIPA ; Set up to read until .INEOF or EOF char. + JRST ASSEM1] ; And don't do anything to .IFNM1/2, etc. + PUSHJ P,IPUSH ; File, push the world. + PUSHJ P,OPNRD1 ; Try opening file. + JRST [ PUSHJ P,IPOPL ; Sigh, failed, pop world back and go + JRST A.IN50] ; try translation entries or TTY input. + ; Always jumps back to A.IN2. + + ; Come here when input file successfully opened. Clean up etc. + BLTM L$FBLK,(F),INFB ; Move current filespec to INFB, +IFN ITSSW,CALL SETWH2 + MOVE B,ITTYP + BLTM 3,IFNM1,-2-TYPDEL(B) ; Copy new .IFNM1, .IFNM2 onto stack, + ; to clobber .IFNM1/2 for previous file, so + ; that .IFNM1/2 etc refers to last file .INSRT'd by + ; current file (or current file if none .INSRT'd yet) +IFN CREFSW,[ + SKIPE CRFONP ; If creffing, output a push-file block. + PUSHJ P,CRFPSH ; (pop-file block is output at IPOP) + ] + + JRST ASSEM1 ; and jump off to smash things to toplevel. + + ; Come here when open attempt fails or @: device specified. +A.IN50: CAIE F,FB ; Tried translations yet? + JRST A.IN60 ; Yes, skip table hacking and go get fnm from TTY. + + ; First open attempt, so OK to search translation table. + SKIPA D,[MAXIND,,TBLOFS] ; Load up aobjn-style index to transl table +A.IN52: SUBI D,-L$FBLK ; Loop point for searching table - increment to next entry, count down LH + CAMN D,INDDP ; Compare with pointer to top of table + JRST A.IN60 ; Agree => this file not in table, get from TTY. + + MOVEI A,(D) ; Get scratch index into tables, + HRLI A,-L$FBLK ; making AOBJN of it, + MOVEI B,(F) ; and get index into current FB. +A.IN54: MOVE C,TBLSFS-TBLOFS(A) ; Get a specification name for this entry +IFN TNXSW,CAIE B,$FJFN(F) ; (ignoring the JFN item, for TENEX) + CAMN C,(B) ; Compare name with that of failed filblk. + AOBJN A,[AOJA B,A.IN54] ; Check all names this entry + JUMPL A,A.IN52 ; If not found, try next entry. + + ; File is in table, try opening it using TBLOFS description. + MOVE F,D ; Replace old F by ptr to winning TBLOFS entry. +IFN TNXSW, SETZM $FJFN(F) ; Since re-opening, must zap any previous JFN. + JRST A.IN2 ; Jump off to try opening. + + ; Come here when open failed and no matching transl entry. + ; Must set up to gobble down a translation from TTY... +A.IN60: TYPE "Error in .INSRT; " + CAIE F,FB ; Were we trying to open a translated entry? + JRST [ PUSHJ P,TYPFB ; Yes, so print out appropriate info + TYPE " -> " ; to show translated stuff. + JRST A.IN70] + + ; First time, no translation entry exists, make one. + MOVE A,INDDP ; Get current pointer to top of tables + TLNN A,-1 ; Room for more? + JRST A.IN70 ; Nope, can't remember transl, but get right fnm anyway. + MOVE F,A ; Yep, use it as pointer to table entry to use. + SUBI A,-L$FBLK ; and get new table-top pointer with clever + MOVEM A,INDDP ; SOS of LH and ADDI to RH. + BLTM L$FBLK,FB,(F) ; Move FB contents to both TBLOFS, + BLTM L$FBLK,FB,TBLSFS-TBLOFS(F) ; and TBLSFS. + +A.IN70: ; Print out filename F points to, & err msg. +IFN TNXSW,[ + PUSHJ P,OPNER1 + PUSHJ P,RDJFNI ; On 10X, get new filename this way. + ] +IFN ITSSW\DECSW,[ ; Elsewhere do it painful way. + PUSHJ P,IOPNER + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Setup to read 1 line from TTY, + PUSHJ P,RFD ; and do it, parsing filename. +] + JRST A.IN2 ; now go try opening it. + +SUBTTL Misc. .INSRT-related things + + ; .INEOF - EOF pseudo + +A.IEF2: PUSHJ P,PMACP ; Loop point, pop entry off macro pdl +A.INEO: TLNE FF,FLMAC ; Inputting from macro? + JRST A.IEF2 ; Yes, pop it off + PUSH P,CMACCR ; Back to inputting from file or tty, cause return to maccr + MOVE B,ITTYP ; Get pdl pointer + POPJ B, ; Return to pop routine + + + ; Call from ERRH; type input file's names if changed since last err msg. +ERRTFL: MOVE C,INFCUR + EXCH C,INFERR ; Say last error msg in this file. + CAMN C,INFERR ; If prev. msg was in other file, + POPJ P, + PUSH P,F + MOVEI F,INFB ; Point to current input file, + PUSHJ P,TYPFB ; and type out its filename. + POP P,F + PJRST CRRERR + +SUBTTL COMMON IO PDL routines for input. (.INSRT support) + +;IO PDL ROUTINES FOR INPUT FILE +; Push the input file + +IPUSH: AOSN CMEOF ; Want to pop out of tty? (^C typed in) + CALL POPTT ; Yes, do now before forget. + +IFE PMAPSW,[ + MOVE D,UREDP ; Get input byte pointer +IFN ITSSW\TNXSW,[ +IFN ITSSW, .IOPUS UTYIC, +IFN TNXSW, MOVEI A,UTYIC ? PUSHJ P,$IOPUSH + TLNN D,760000 ; At end of word? + ADD D,[430000,,1] ; Yes, make it point to beginning of next word + MOVEM D,UREDP + MOVNI A,-2(D) + ADD A,UTIBED ; Get # wds we'll need in MACTAB. + HLR D,UTIBED ; Remember whether EOF on last .IOT. + HRRZS UTIBED ; Now clear out left half for following +] +IFN DECSW,[ + AOS A,UTICHN ; Do ".IOPUSH" - use next channel. + LSH A,27 + ADD A,[WAIT-<0 1,>] ; Construct a WAIT uuo for the current input channel. + MOVE C,RCHMOD ; We mustn't copy the buffers while I/O is going on. + CAMN A,[WAIT UTYIC,] ; But: if we are currently in the top-level input file + CAIE C,3 ; And it is device TTY:, this channel was never opened. + XCT A ; Don't move buffers while io going on! + MOVEI A,UTIBFL+2 ; Assume must save all buffer space. +] + PUSH P,A + ADD A,FREPTB + ANDI A,-1 + PUSH P,A + CAML A,MACTND ; No room in MACTAB => gc it. + CALL GCA1 + REST A + CAML A,MACTND ; Did the GC win? + PUSHJ P,GCCORQ ; NO!! Try to win somehow + MOVEI A,370 + CALL PUTREL ; Indicate start of saved buffer. + REST A + AOS B,FREPTB + SUBI A,1 + MOVE C,ITTYP ; Get addr of tty pdl wd that'll point to saved buffer. + ADDI C,1 + HRRZM C,(B) ; Store in rh of 1st wd, + MOVEI C,(B) ; Remember addr of saved buffer to push on ttypdl. + HRLM A,(B) ; Put length in lh. + AOS B +IFN ITSSW\TNXSW,HRL B,UREDP ; LH <- addr of 1st wd to save. +IFN DECSW,HRLI B,UTIBUF + ADDI A,-2(B) ; Addr of last wd to blt into. + BLT B,(A) + HRLI A,041000 + MOVEM A,FREPTB ; Make free bp -> last byte just used. + SUB A,MACTAD + ANDI A,-1 + LSH A,2 + ADDI A,4 ; Get char addr of next free byte. + MOVEM A,FREEPT +] +IFN PMAPSW, CALL IOBPUS + + MOVE B,ITTYP ; Get local version of iopdl +IPSHP: +IFE PMAPSW, PUSH B,C ; Push -> saved buffer (GC will relocate) +IFN DECSW,PUSH B,UTIBED ? PUSH B,UTIHDR +REPEAT L$FBLK, PUSH B,INFB+.RPCNT ; Save names of input file. + PUSH B,INFCUR ; Save number of input file. +IFE PMAPSW, PUSH B,D ; Lh=lh(old uredp), rh=lh(old utibed) (or just UREDP) +IFN PMAPSW, INSIRP PUSH B,[INFPAG INPGCT INLPGS UTIBPE UTIBPL UTIBPX INLCHR UREDP IUREDP ] + + ; Following three must be last pushed + INSIRP PUSH B,[IFNM1 IFNM2 IFVRS] ; Clobbered on pdl if .open successful +INPDEL==.-IPSHP ; Length of each entry on pdl + + MOVE A,FREEPT ; W must use same gc convention as putrel; + CAML A,MACHI ; Namely, gc after using up the last byte. + CALL GCA1 + MOVEI A,0 ; => input from file + MOVEM B,ITTYP ; Store back updated pointer + JSP B,PUSHTT ; Save stuff, address modify and return + + + ; Pop into the input file +IPOP: +IFN CREFSW,[ MOVEI A,2 ; If creffing, output pop-file block. + SKIPE CRFONP + PUSHJ P,CRFOUT] +IPOPL: PUSHJ P,POPTT ; Come here if .INSRT's open failed. + PUSH P,C + MOVE B,ITTYP ; Get pointer + INSIRP POP B,[IFVRS IFNM2 IFNM1] ; Pop stuff +IFE PMAPSW, POP B,A ; Pop off UREDP (or halves thereof) +IFN PMAPSW, INSIRP POP B,[ IUREDP UREDP INLCHR UTIBPX UTIBPL UTIBPE INLPGS INPGCT INFPAG] + POP B,INFCUR +REPEAT L$FBLK,POP B,INFB+L$FBLK-1-.RPCNT +IFN DECSW,[ + POP B,C + PUSH P,C ; Old UTIHDR + POP B,UTIBED +] +IFE PMAPSW, POP B,C + MOVEM B,ITTYP ; Save updated pdl pointer. +IFE PMAPSW,[ + HLRZ B,(C) ; Get length of saved buffer, +IFN ITSSW\TNXSW,[ + PUSH P,A +IFN ITSSW, CALL SETWH2 ? .IOPOP UTYIC, +IFN TNXSW, MOVEI A,UTYIC ? CALL $IOPOP + REST A + MOVEI AA,UTIBUF-1(B) ; Get addr of 1st wd won't blt into in utibuf, + HRLI AA,(A) ; Get saved lh of utibed, + MOVEM AA,UTIBED + HRRI A,UTIBUF ; Make A -> 1st wd in buffer, +] +IFN DECSW,[ + MOVE AA,UTICHN + LSH AA,27 + IOR AA,[RELEAS] + XCT AA ; This code equivalent to .IOPOP. + SOS UTICHN + REST UTIHDR +] + MOVEM A,UREDP + MOVSI A,EOFCH_13 + MOVEM A,@UTIBED ; Put EOF char after buffer. + MOVSI A,1(C) ; Get addr of 1st data wd of saved buffer, + HRRI A,UTIBUF + CAIE B,1 + BLT A,UTIBUF-2(B) + HLLZS (C) ; Tell GC to reclaim saved buffer. +] ;IFE PMAPSW + +IFN PMAPSW, CALL IOBPOP + +POPCJ: REST C + RET + +;SAVE INTERNAL POINTERS CONCERNING INPUT MODE + +TYPDEL==2 ; Number of words in relevant pdl entry + +PUSHTT: PUSH P,A + PUSH P,F + AOSN CMEOF ; If supposed to pop out of tty soon, + CALL POPTT ; Do it now before cmeof clobbered. + MOVE F,ITTYP ; Get relevant pdl pointer + MOVEI A,0 + EXCH A,CLNN ; Set up new line number + HRL A,CPGN ; Save current page number + SETZM CPGN ; Now re-initialize + SKIPGE CRFILE ; Save cref-all-on-one-line flag. + TLO A,400000 + PUSH F,A ; Save cpgn,,clnn + MOVE A,-1(P) ; Retrieve new mode + PUSHJ P,PSHLMB ; Save limbo1 and set up instructions for new mode +IFN ITSSW,[ + CALL SETWH2 + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ; Store back updated pointer + JRST POPFAJ + + ; Restore internal pointers concerning input mode + +POPTT: PUSH P,A + PUSH P,F + MOVE F,ITTYP ; Get pdl pointer + PUSHJ P,POPLMB ; Pop into limbo1, set up new mode + POP F,A ; Get cpgn,,clnn + SETZM CRFILE ; Restore all-on-one-line flag. + TLZE A,400000 + SETOM CRFILE + HLRZM A,CPGN + HRRZM A,CLNN +IFN ITSSW,[ + CALL SETWH2 + ADD A,CPGN + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ; Store back updated pointer + JRST POPFAJ + +IFN ITSSW,[ +SETWH2: MOVE A,RCHMOD + CAIL A,2 + SKIPA A,[SIXBIT /TTY:/] + MOVE A,INFB+$F6FN1 + .SUSET [.SWHO2,,A] + MOVE A,A.PASS + LSH A,30 + ADD A,[SIXBIT /P0/+1] + RET +] + +SUBTTL Storage for IO PDL stuff + + ; IO PDL storage stuff + +VBLK +TYPDLS==TYPDLC*TYPDEL+INPDEL*MX.INS + ; "tty pdl", stores information about current input mode + ; (similar to macro pdl but not garbage collected) + +ITTYP: -TYPDLS-1,,TTYPDL ; Pdl pointer (typdel=length of each entry) +TTYPDL: NEDCHK ; Actual pdl: initial entry to overpop routine + BLOCK TYPDLS ; Pdl proper +PBLK + +SUBTTL TNX - IO PDL Routines (IOPDLC, $IOPUSH, $IOPOP) + +IFN TNXSW,[ + +IFN PMAPSW,[ + ; Push IO buffer & channel... +IOBPUS: PUSH P,A + MOVEI A,UTYIC + CALL $IOPUSH + MOVEI A,NIBFPS ; Point at next set of buffer pages. + ADDM A,INBFPG + POP P,A + POPJ P, + + ; Pop IO buffer & channel... +IOBPOP: PUSH P,A + MOVE A,INBFPG + HRLI A,NIBFPS + CALL DELPGS ; flush buffer pages. + MOVNI A,NIBFPS + ADDM A,INBFPG ; point down at previous set of buffer pages... + MOVEI A,UTYIC + CALL $IOPOP + POP P,A + POPJ P, + +; DELPGS - Take arg in A as <# pgs>,, and flush these pages. + +DELPGS: PUSH P,A + PUSH P,B + HLRZ B,A + HRLI A,.FHSLF ; ,, + TLO B,(PM%CNT) + PUSH P,T +DELPG2: SYSCAL PMAP,[[-1] ? A ? B][A ? A ? B] ; Free up buffer pages. + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI B,-1(B) ; Else, on 10X, must iterate manually. + TRNE B,400000 ; See if became "negative". + JRST .+1 ; Yep, done with manual iteration. + AOJA A,DELPG2] ; Nope, bump page #'s. + POP P,T + POP P,B + POP P,A + POPJ P, +] ;IFN PMAPSW + +; IOPDLC - Clear IOPDL stack, close all channels on it. +; Clobbers no ACs + +; for 10x, need to CLOSF and release each JFN on IOPDL stack. + +IOPDLC: PUSH P,R1 +IFE R1-A,.ERR IOPDLC WONT WORK WITH A=1 +IFN PMAPSW,[ + MOVEI R1,1STBFP ; Reset to point at 1st page of buffer space. + MOVEM R1,INBFPG +] + EXCH A,IOPDLP + JRST IOPDC3 +IOPDC2: MOVE R1,(A) + CAME R1,ISFB+$FJFN ; Dont close main input file + CLOSF + JFCL + SUB A,[1,,1] +IOPDC3: CAMLE A,[-LIOPDL,,$IOPDL-1] + JRST IOPDC2 + EXCH A,IOPDLP + POP P,R1 + POPJ P, + +; $IOPUSH - Push I/O channel in A onto $IOPDL stack. +; Clobbers no ACs +; for 10X this means storing JFN on stack and clearing JFNCHS table entry. + +$IOPUSH:EXCH B,IOPDLP ; Get stack pointer + PUSH B,JFNCHS(A) ; save JFN for channel + EXCH B,IOPDLP + SETZM JFNCHS(A) ; Zap entry in channel table to make it look gone + POPJ P, + +; $IOPOP - Pops channel off $IOPDL into channel # in A. +; Clobbers no ACs + +; for 10X just pop $IOPDL into JFNCHS, must close and release old JFN tho. + +$IOPOP: PUSH P,T + SYSCAL CLOSF,[JFNCHS(A)] + JFCL + POP P,T + EXCH B,IOPDLP ; Get stack ptr + POP B,JFNCHS(A) + EXCH B,IOPDLP + POPJ P, + +VBLK +JFNCHS: BLOCK 20 ; Channel table index, JFNCHS(ch) gets JFN for chan. + ; (zero if none) +LIOPDL==8. ; Length of IO PDL +IOPDLP: -LIOPDL,,$IOPDL-1 +$IOPDL: BLOCK LIOPDL +PBLK +] ; IFN TNXSW + +SUBTTL DEC - IO PDL Routines (IOPDLC) + +IFN DECSW,[ + +; IOPDLC - Simulate ITS .IOPDL call. Flushes all channels from +; UTICHN downwards to UTYIC. Actually not a simulation but something +; that works in the particular situation for which MIDAS uses .IOPDL. + +IOPDLC: MOVEI A,UTYIC + EXCH A,UTICHN ; Set input chnl num. to lowest. + LSH A,27 + IOR A,[RELEAS] ; Set up to releas the highest in use first. +IOPDL1: XCT A ; Releas one input channel, + CAMN A,[RELEAS UTYIC,] + RET ; All done. + SUB A,[0 1,] + JRST IOPDL1 ; Releas the next one down. +] ;IFN DECSW + +SUBTTL COMMON TTY input routines & variables + +VBLK +CMBUF: BLOCK CMBFL ; Typein buffer (also used as JCL buffer) +CMPTR: 0 ; Byte pointer to CMBUF. +CMEOF: 0 ; -1 => POPTT instead of reloading after this bufferfull. +TTYOPF: 0 ; -1 => the TTY is already open. +LINEL: 0 ; Width of TTY (may be 1,, meaning assume infinite). +A.TTYFLG: ; Value of .TTYFLG pseudo - another label for TTYFLG. +TTYFLG: 0 ; TTY typeout permitted iff >= 0. +WSWCNT: 0 ; The number of W-switches in the last cmd string. +TTYBRF: 0 ; -1 => ^H break has been requested but not yet done. +PBLK + ; Cause input from tty (main routines) + +GTYIPA: SETZM A.TTYF ; Push to tty, don't stop at cr. + +IFN ITSSW, TYPECR "TTY: .INSRTed, end input with ^C" +IFN DECSW\TNXSW,[ + IFE SAILSW,TYPECR "TTY: .INSRTed, end input with ^Z" + IFN SAILSW,TYPECR "TTY: .INSRTed, end input with CTL-META-LF" + ] + +GTYIP1: SKIPA A,[3] +GTYIP: MOVEI A,2 ; Input from tty, stop after 1 line. + SETZM CMPTR ; Force reload on 1st read. + JSP B,PUSHTT ; Set up variables and return +GTYIPR: SETZM CMPTR ; Return on .ineof or cr + JRST POPTT + + ; Call here from ASSEM1 loop when a ^H interrupt is detected. +TTYBRK: SETZM A.TTYF + ETR [ASCIZ/^H - break /] ; Type filename, page and line #. + SKIPE ASMOUT + TYPECR "within a <>, () or []" + JRST GTYIPA + + ; RCHSET routines for reading from TTY + ; RCHMOD=3 => don't quit on CR + ; 2 => quit on CR. +RCHTRC: +RCHARC: TLO FF,FLTTY ; Set flag + JSP A,CPOPJ +RCHAC1: REPEAT 2,[ ; RCH2, RR1 + ILDB A,CMPTR ; Get char + CAIN A,0 ; End of string marked with 0 + PUSHJ P,TYRLDR ; Reload, jump back for next char +] + GOHALT ; RRL1 +IFN .-RCHAC1-RCHPSN,.ERR RCHAC1 LOSES. + ILDB A,CMPTR ; SEMIC + CAIN A,15 + JRST SEMICR + JUMPN A,SEMIC + PUSHJ P,TYRLD + JRST SEMIC + +TYRLD: MOVEI A,3 ; Return after the call, not before. + ADDM A,(P) + + ; TYRLDR - Read in string. + ; Reload buffer if ran out in call to RCH. + +TYRLDR: AOSN CMEOF ; EOF detected after last reload => + JRST RPAEOF ; Pop out of tty. + PUSH P,A + PUSH P,B + MOVE B,RCHMOD + PUSH P,F + PUSH P,A.TTYF ; If chars rubbed out they should be printed. + SETZM A.TTYF +IFN TNXSW,SYSCAL DTI,[[.TICCV]] ; Disable ^V as an interrupt character + MOVE F,[10700,,CMBUF-1] ; Initial byte pointer to buffer + MOVEM F,CMPTR ; Store as byte pointer for read +TYRLD2: PUSHJ P,TYI ; Get character +IFN TNXSW,[ + CAMN F,CMPTR ; at beg of line? + CAIE A,^J ; and char is LF? + CAIA + JRST TYRLD2 ; If so then ignore it completely. +] + CAIN A,177 ; Rubout? + JRST TYRLD3 ; Yes + CAIE A,^C + CAIN A,^Z + JRST TYRLD7 ; ^C, ^Z => EOF. Ought to be EOFCH for consistency? + CAIN A,^U + JRST TYRLD5 ; Rub out all + CAIE B,2 ; For .TTYMAC handling, convert lower case to upper. + JRST TYRLD6 + CAIL A,"A+40 + CAILE A,"Z+40 + CAIA + SUBI A,40 +TYRLD6: CAME F,[010700,,CMBUF+CMBFL-2] + IDPB A,F ; Store character in buffer unless buffer nearly full. + CAIE A,^M ; CR? + JRST TYRLD2 ; No, go back for next + CAIN B,2 ; .TTYMAC (mode 2) => CR ends input, so fake EOF. + SETOM CMEOF + MOVEI A,^J ; Follow the CR with a LF. + IDPB A,F + PUSH P,F ; Output the entire line to the error file + MOVE F,[10700,,CMBUF-1] +TYRLD8: CAMN F,(P) + JRST TYRLD9 + ILDB A,F + CAIN A,^M ; If line was ended by a ^C or ^Z, put that in error + SKIPL CMEOF ; file, which needs hair since that char is not + JRST TYRLD0 ; In the string we stored. + MOVEI A,"^ + CALL ERRCHR +IFN ITSSW,MOVEI A,"C +IFN DECSW\TNXSW,MOVEI A,"Z + CALL ERRCHR + LDB A,F +TYRLD0: CALL ERRCHR + JRST TYRLD8 + +TYRLD9: REST F + MOVEI A,0 + IDPB A,F ; Mark end of string + IDPB A,F +IFN TNXSW,SYSCAL ATI,[[.TICCV,,.IC.CV]] ; Turn back on ^V + REST A.TTYF + REST F + REST B + REST A + JRST RCHTRA + +TYRLD7: SETOM CMEOF ; ^C, ^Z force EOF, + CALL TYRLCR ; After turning into ^M. + MOVEI A,^M + JRST TYRLD6 + +TYRLCR: MOVEI A,^M + CALL TYOX + MOVEI A,^J + JRST TYOX + +TYRLD3: CAMN F,[10700,,CMBUF-1] ; Rubout, beginning of buffer? + JRST TYRLD4 ; Yes + LDB A,F ; Get last character in buffer + CALL TYOX ; Type it out, don't write in error file. + ADD F,[70000,,] ; Decrement pointer + JUMPGE F,TYRLD2 ; Jump if valid + SUB F,[430000,,1] ; Was 440700,,something, back it up + JRST TYRLD2 + +TYRLD5: MOVE F,[10700,,CMBUF-1] ; ^U, back to beginning of line +TYRLD4: PUSHJ P,TYRLCR ; Rubout when at beginning of buffer, type CR + JRST TYRLD2 + +SUBTTL ITS - TTY routines (TYOX, TYI, TTYINI) and JCLINI. + +IFN ITSSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOPF + CALL TTYINI + .IOT TYOC,A + POPJ P, + + ; TYI - Get (just typed in) char in A +TYI: SKIPN TTYOPF + CALL TTYINI ; Open the tty if not already done. + .IOT TYIC,A + ANDI A,-1 ; Non-tty devices can return -1,,3. + JUMPE A,TYI + CAIN A,^L ; This must be assuming that ^L clears screen? + JRST TYI + POPJ P, + + ; Initialize tty +TTYINI: PUSH P,A + .OPEN TYIC,[.UAI,,'TTY] ; Input + .LOSE + .OPEN TYOC,[%TJDIS+.UAO,,'TTY] ; Display mode output + .LOSE + SYSCAL CNSGET,[1000,,TYOC ? 2000,,A ? 2000,,A] + MOVSI A,1 ; TTY: is translated to something else => assume infinite linel + MOVEM A,LINEL ; Else linel gets width of tty. + SETOM TTYOPF ; Say the tty is now open. + JRST POPAJ + +JCLINI: SETZM CMPTR + .SUSET [.ROPTIO,,A] + TLNN A,%OPCMD ; Has our superior said it has a cmd? + RET ; No. + BLTZ CMBFL-1,CMBUF ; Zero all but last word, + SETOM CMBUF+CMBFL-1 ; and ensure last word non-zero. + .BREAK 12,[5,,CMBUF] ; Try to read command string. + MOVE A,[440700,,CMBUF] + SKIPE CMBUF ; If read a cmd-string, + MOVEM A,CMPTR ; Tell TYRLD, GO2A it's there. + POPJ P, + +]; END IFN ITSSW + +SUBTTL TNX - TTY routines (TYOX, TYI, TTYINI) and JCLINI + +IFN TNXSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOPF + CALL TTYINI +IFN A-1,EXCH A,R1 + PBOUT +IFN A-1,EXCH A,R1 + POPJ P, + + ; TYI - Get (just typed in) char in A + ; There is a screw for 20X in that it's not really possible + ; to know if the system is going to feed you a CR-LF + ; or just a CR; TYRLD2 checks for that, by flushing LF's, but + ; this would be the place to check if it were easy to do. +TYI: SKIPN TTYOPF + CALL TTYINI ; Open the tty if not already done. +IFN A-1,EXCH R1,A + PBIN ; Get char into AC 1 + JUMPE R1,.-1 ; Ignore nulls. + TLNE FF,FL20X ; Cretinous differences between 10X/20X + JRST TYI2 ; 20X, skip EOL check. + CAIN R1,^_ ; On 10X, CR turned into ^_ (EOL); change it back. + MOVEI R1,^M +TYI2: +IFN A-1,EXCH R1,A ; Restore everything to right place if necessary. + POPJ P, + + ; TTYINI - Initialize tty + +TTYINI: PUSH P,A + PUSH P,T + SYSCAL RFMOD,[[.PRIIN]][A ? A] + POP P,T + HLRZS A + ANDI A,177 ; Terminal width + CAIGE A,30. ; If too low, + ADDI A,128. ; Assume twenex crockishness + MOVEM A,LINEL ; Linel gets width of tty. + SETOM TTYOPF ; Say the tty is now open. + POP P,A + POPJ P, + + ; Read "JCL" - RSCAN buffer or nnnMID.TMP file (from CCL) + +JCLINI: SETZM CMPTR + SKIPE CCLFLG ; Started at CCL location? + JRST JCLIN5 ; Yep, go snarf stuff specially. + TLNN FF,FL20X ; Is this Tenex? + JRST [ MOVEI R1,.PRIIN + BKJFN ; see what previous character was + POPJ P,; *Gasp* + PBIN + CAIE R1,^_ ; Tenex newline? + SETOM CMPTR ; No, set flag saying "TTY but no prompt" + POPJ P,]; and skip the Twenex hackery below + SETZ R1, ; If not, check RSCAN. + RSCAN ; See if have anything in RSCAN buffer. + POPJ P, ; Huh? Shouldn't happen, but ignore it. + JUMPLE R1,APOPJ ; Also return if char cnt says nothing there. + MOVNI R3,(R1) ; Aha, set up cnt for SIN + HRROI R2,CMBUF + MOVEI R1,.CTTRM ; Now ready for business... + SIN + LDB R1,R2 ; Now examine wages thereof + CAIE R1,^M ; Last char CR? + JRST [ MOVEI R1,^M + IDPB R1,R2 ; If not, make it so. + JRST .+1] + SETZ R1, + IDPB R1,R2 ; Must also ensure ASCIZ. + + MOVE B,[440700,,CMBUF] ; Flush any spaces in front + ILDB A,B + CAIN A,40 + JRST .-2 + + ; If the rescan line starts with "RUN", skip that. + MOVE C,B ; Save backup pos +IRPC X,,[RUN] + CAIE A,"X+40 ; Allow lowercase + CAIN A,"X + CAIA + JRST JCLIN2 ; Jump as soon as no match + ILDB A,B ; Matched, get next char. +TERMIN + +JCLIN2: CAIE A,40 ; Is next char a space? + JRST [ MOVE B,C ; When non-space seen, back up to saved pos + LDB A,B + JRST JCLIN4] + ILDB A,B ; Saw space so we won. Get next char + MOVE C,B ; Say backup should start here + JRST JCLIN2 ; and flush all spaces. + + ILDB A,B +JCLIN4: CAILE A,40 ; Now skip the filename used to invoke MIDAS. + JRST .-2 ; Flush until random ctl seen (space, ^M) + CAIE A,40 ; If it wasn't a space, + POPJ P, ; then forget about the whole thing. +JCLIN3: MOVE C,B ; Now flush spaces. Save last ptr for chars. + ILDB A,B + CAIN A,40 + JRST JCLIN3 + CAIN A,^M ; And is first non-space something besides CR? + POPJ P, ; Bah, there wasn't anything in the JCL!! + MOVEM C,CMPTR ; Else save ptr to start of real goods. + POPJ P, + + ; TNX snarf of CCL file. No such thing as tmpcor, so just + ; look for real file with appropriate name. +JCLIN5: SETZM CCLFLG ; Want 0 in case abort out, will reset if win. + GJINF ; Get job # in R3 + HRROI R1,CMBUF ; Use CMBUF to form filename string. + MOVEI R2,(R3) + MOVE R3,[NO%LFL+NO%ZRO+<3_18.>+10.] + NOUT ; ship out job num in 3 digits, radix 10. + GOHALT + HRROI R2,[ASCIZ /MID.TMP/] + SETZ R3, + SOUT ; Flesh out rest of filename string. + SETZ R2, ; Make sure it's ASCIZ. + BOUT + MOVE R1,[GJ%OLD+GJ%SHT] ; Use short-form GTJFN + HRROI R2,CMBUF ; and gobble name from CMBUF. + GTJFN + POPJ P, ; If failed, forget it. + MOVE R2,[070000,,OF%RD] ; Read 7-bit bytes + OPENF + POPJ P, ; Bah + HRROI R2,CMBUF ; Gobble stuff up. + MOVEI R3,CMBFL*5 ; Read until buffer full, + MOVEI R4,^J ; or LF seen. + SIN + JUMPLE R3,APOPJ ; Forget it if too big for buffer!! + + MOVE R2,[440700,,CMBUF] ; Aha, we've got something, so set + MOVEM R2,CMPTR ; pointer to slurped stuff. + SETOM CCLFLG + HRROI R2,UTIBUF ; Slurp rest into larger buffer, + MOVNI R3,UTIBFL*5 ; using count only. + SIN + JUMPGE R3,APOPJ ; Refuse to hack grossly large file. + ADDI R3,UTIBFL*5 + JUMPLE R3,APOPJ ; if nothing read, need write nothing out. + HRLI R1,(CO%NRJ) ; Don't release JFN, + CLOSF ; but stop reading from file. + POPJ P, + MOVE R2,[070000,,OF%WR] ; Now try to hack write access. + OPENF + POPJ P, + MOVE R2,R1 ; Source becomes destination... + HRROI R1,UTIBUF ; and UTIBUF becomes source, + MOVNS R3 ; for just as many bytes as were read. + SOUT + MOVEI R1,(R2) ; done, now just close file. + CLOSF ; (this time, release JFN). + POPJ P, + SETOM CCLMOR ; say that more CCL remains. + POPJ P, +] ; END IFN TNXSW + +SUBTTL DEC - TTY routines (TYOX, TYI, TTYINI) + +IFN DECSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOPF + CALL TTYINI + OUTCHR A + POPJ P, + + ; TYI - Get a typed-in char in A + +TYI: SKIPN TTYOPF ; Open the tty, if not already done. + CALL TTYINI + INCHWL A +IFN SAILSW,[ + CAIN A,612 ; On SAIL, EOF is 612, + MOVEI A,^Z ; so turn into normal EOF if found. +] + CAIE A,^M ; Throw away the LF after a CR. + RET + INCHWL A + MOVEI A,^M ; Note that TYRLDR will put it back in. + RET + +TTYINI: INSIRP PUSH P,AA A B +IFE SAILSW,[ + PJOB A, + TRMNO. A, + JRST TTYIN1 + MOVEI AA,1012 ; .TOWID + MOVE B,[2,,AA] + TRMOP. B, ; Read width of tty line into B. +] +TTYIN1: MOVEI B,80. ; TRMOP. failed or not tried => assume width is 80. + MOVEM B,LINEL + INSIRP POP P,B A AA + SETOM TTYOPF + RET + + TMPLOC .JBREN, TTYREN +TTYREN: SETOM TTYBRF ; "REENTER" command comes here +R: G: JRST @.JBOPC ; To request a ^H-break. Note crufty labels pointing here. + +];IFN DECSW + +SUBTTL DEC Hackery for JCLINI - Read CCL commands. + +IFN DECSW\TNXSW,[ +VBLK +CCLFLG: 0 ; Flag to indicate CCL entry from COMPIL, SNAIL, CCL, or EXEC +CCLMOR: 0 ; -1 => There are more lines of CCL commands, + ; so do a RUN SYS:MIDAS when finished. +PBLK +] + +IFN DECSW,[ ; DEC only hacks CCL as "JCL". + +.SCALAR CCLFIL ; Saves FN1 for tmp file hacking. + +; Read MID temp core file, if that loses, try nnnMID.TMP file. +; Clobbers A,B,C,D. + +JCLINI: SETZM CMPTR + SKIPN CCLFLG ; Was midas called from CCL level? + RET ; No, do not snarf tempcore + SETZM CCLFIL ; No CCL file yet + SETZM CCLFLG ; If tmpcor loses want this 0 (will re-setom below) + BLTZ CMBFL,CMBUF ; Zero cmd buffer. + MOVE A,[2,,['MID,, ? -,,CMBUF-1]] ; read (leave last wd 0) + TMPCOR A, ; Read compil-generated command + JRST [ OPEN [17 ? 'DSK,, ? 0] ; No tempcore, maybe try dump mode. + RET ; Argh but let something else die + PJOB A, ; Get job # + IDIVI A,100. ; Want decimal job number in sixbit + ADDI A,'0 + LSH A,6 + IDIVI B,10. + ADDI A,'0(B) + LSH A,6 + ADDI A,'0(C) + LSH A,18. + HRRI A,'MID ; Form file name as nnnMID.TMP + MOVEM A,CCLFIL ; Save for writing below + MOVSI B,'TMP + SETZB C,D ; No protect or ppn trash + LOOKUP A ; Try to get file + RET ; Give up + MOVE A,[-,,CMBUF-1] + SETZ B, + INPUT A ; Try to read command + SETZB A,B + RENAME A ; Try to delete it now + JFCL ; Ignore failure + CLOSE ; Happy sail + JRST .+1] + SKIPN CMBUF ; One last check for it to be there + RET ; Alas, there is none + MOVE A,[440700,,CMBUF] ; Load a byte pointer to the command + SETOM CCLFLG + MOVEM A,CMPTR ; There is, set command pointer +JCLIN1: ILDB B,A + CAIE B,^J ; See if our command file has anything after 1st line. + JRST JCLIN1 + ILDB B,A + JUMPE B,JCLIN3 + SETOM CCLMOR ; It does; set flag so after handling 1st line we'll + MOVE C,[440700,,UTIBUF+2] +JCLIN2: IDPB B,C + ILDB B,A + JUMPN B,JCLIN2 + SUBI C,UTIBUF+1 ; Get # words written in utibuf. operand is relocatable! + HRLOI C,-1(C) ; These 2 insns turn size into -size,,utibuf+1 + EQVI C,UTIBUF+1 + MOVEM C,UTIBUF+1 + SKIPE A,CCLFIL ; Was this called with a temp file? + JRST [ MOVSI B,'TMP + SETZB C,D + ENTER A ; Try to re-write file + RET ; Sigh + MOVE A,UTIBUF+1 + SETZ B, + OUTPUT A + RELEASE + RET] + MOVSI C,'MID + MOVEM C,UTIBUF + MOVE C,[3,,UTIBUF] + TMPCOR C, + JFCL ; [KLH - there used to be some random cruft here.] +JCLIN3: RET + +] ;END IFN DECSW + +SUBTTL Old Command Line Reader (CMD) +ifn 0,[ + ; Read command & filenames & hack defaulting. + +CMD: SKIPE CMPTR ; Unless have DDT or RSCAN cmd string, + JRST CMD06 ; (we don't) + CALL CRR ; type a CRLF, prompt etc. +CMD05: SETZM CMPTR + TYPE "*" +CMD06: MOVEI A,3 ; Read from TTY (or string <- cmptr) + CALL RCHSET + MOVEI F,FB ; Point to scratch filblk. + BLTZ L$FBLK,FB ; and clear the whole thing. + TRO FF,FRCMND ; Tell RFD it's scanning a command line. + CALL RFD ; Now see if command null, and whether has _. +IFN DECSW\TNXSW,[ + CAIN A,"! ; If terminator was "!", go run program. + JRST RFDRUN +] + TRNN FF,FRNNUL ; If no filespec was seen, + CAIE A,^M ; and terminator is EOL, + CAIA + JRST CMD05 ; then prompt again and get another string. + TRZ FF,FRARRO ; Got something, clear saw-"_" flag. +CMD07: CAIN A,"_ + TRO FF,FRARRO ; FRARRO will be on if there's a "_" in string. + CAIN A,^M + JRST CMD1 ; Read thru the whole command. + CALL RFD + JRST CMD07 + + ; Now re-read the string, for real this time. Previous scan was + ; mainly just to see if "_" existed. If not, then first filename + ; must be input file, and output filenames are all defaulted. +CMD1: MOVE T,[440700,,CMBUF] ; Restore original ptr to + MOVEM T,CMPTR ; beginning of string. +IFN CREFSW,SETZM CREFP ; Clear all switches before decoding them. +INSIRP SETZM 0,ERRFP TTYINS WSWCNT +IFN LISTSW,[ + SETZM LISTP + SETOM LISTP1 ; Will be AOSed by each (L) switch. +] + + MOVE T,FSDSK + MOVEM T,$FDEV(F) +IFE TNXSW,[MOVE T,RSYSNM ? MOVEM T,$FDIR(F)] +IFN TNXSW, SETZM $FDIR(F) + SETZM $FNAME(F) + SETZM $FEXT(F) + + TRZ FF,FRNNUL + TRNE FF,FRARRO ; Don't gobble input spec as output! + CALL RFD ; Read bin file spec. + MOVE TT,FF ; Remember whether null + BLTMAC T,L$FBLK,(F),OUTFB ; Copy from scratch to OUTFB. + + MOVE T,$FDEV(F) + CAMN T,FSNUL + MOVE T,FSDSK + MOVEM T,$FDEV(F) +IFE ITSSW, MOVE T,FSCRF +IFN ITSSW, MOVE T,FSCREF + MOVEM T,$FEXT(F) + + TRNN FF,FRARRO ; If "_" doesn't exist in cmd line, + MOVEI A,"_ ; then only filespec is for input, kludge to get it. + CAIN A,"_ ; If "_" exists in cmd line, did we hit it? + JRST CMD2 ; Ran out of output specs => just use defaults. + CALL RFD ; Read cref file spec. +IFN CREFSW,[ + TRNN FF,FRNNUL ; If spec not null or ended by _, + CAIN A,"_ + SETOM CREFP ; We must want to cref. +CMD2: BLTMAC T,L$FBLK,(F),CRFFB ; Copy specs from FB to CREF FB. +] +IFE CREFSW,CMD2: + MOVE T,FSERR + MOVEM T,$FEXT(F) + CAIN A,"_ + JRST CMD6 ; No more output specs. + CALL RFD ; Read error file sppec. +IFN ERRSW,[ + TRNN FF,FRNNUL ; Nonnull spec or last spec => + CAIN A,"_ + SETOM ERRFP ; Must want an error file. +CMD6: BLTMAC T,L$FBLK,(F),ERRFB ; Copy specs from FB to ERR filblk. +] +IFE ERRSW,CMD6: +IFN LISTSW,[ +IFE ITSSW, MOVE T,FSLST +IFN ITSSW, MOVE T,FSLIST + MOVEM T,$FEXT(F) + CAIN A,"_ ; Any output spec remaining? + JRST CMD3 + CALL RFD ; Yes, read one. + SETOM LISTP ; List spec given implies want listing. +CMD3: BLTMAC T,L$FBLK,(F),LSTFB ; Copy specs from FB to LST filblk. +] + +CMD5: CAIN A,"_ + JRST CMD4 + CALL RFD ; Ignore any output specs not needed. + JRST CMD5 + +CMD4: MOVE T,FSDSK ; Default the input names. + MOVE A,$FDEV(F) + CAME A,FSPTP ; Don't leave dev name set to common out-only devs. + CAMN A,FSNUL + MOVEM T,$FDEV(F) +IFE ITSSW, MOVE T,FSMID +IFN ITSSW, MOVE T,FSGRTN ; > on ITS. + MOVEM T,$FEXT(F) + MOVE T,FSPROG + SKIPN $FNAME(F) ; The fn1 alone is sticky across the _. + MOVEM T,$FNAME(F) + + TRZ FF,FRARRO ; If only 1 name it should be FNAM1. + CALL RFD ; Read input spec. + BLTMAC T,L$FBLK,(F),ISFB ; Copy into specified-input filblk. + MOVE T,$FNAME(F) ; Default output FN1's to input. + SKIPN OUTFB+$FNAME + MOVEM T,OUTFB+$FNAME +IFN CREFSW,[ + SKIPN CRFFB+$FNAME + MOVEM T,CRFFB+$FNAME +] +IFN LISTSW,[ + SKIPN LSTFB+$FNAME + MOVEM T,LSTFB+$FNAME +] +IFN ERRSW,[ + SKIPN ERRFB+$FNAME + MOVEM T,ERRFB+$FNAME +] + MOVE A,FSNUL ; The output dev defaults to NUL: + MOVE T,$FDEV(F) ; If the input is from TTY: + CAMN T,FSTTY + TRNE FF,FRNNUL ; And the bin spec was null. + CAIA + MOVEM A,OUTFB+$FDEV + TRZ FF,FRARRO ; Don't louse up .INSRT's reading. + RET +] ;ifn 0 + +SUBTTL Command Line Reader (CMD) + + ; CMD - Read command & filenames & hack defaulting. + +.SCALAR CMDPSV ; Saves read ptr into CMBUF, for re-scanning. + +CMD: SKIPLE T,CMPTR ; If we have DDT or RSCAN or CCL string, + JRST CMD06 ; go hack it without typing anything out. + CAMN T,[-1] ; If Tenex-type "JCL", normal TTY input 'cept no prompt + JRST CMD06X + CALL CRR ; Nope, must type a CRLF, prompt etc. +CMD05: TYPE "*" +CMD06X: SETZB T,CMPTR +CMD06: MOVEM T,CMDPSV ; Save pointer for later restoration + MOVEI A,3 ; Read from TTY (or string <- cmptr) + CALL RCHSET + + MOVEI F,ISFB ; Point to input-spec filblk. + BLTZ L$FBLK,(F) ; Zap it through and through. + TRO FF,FRCMND ; Tell RFD it's scanning a command line. + CALL RFD ; Now see if command null, and whether has _. +IFN DECSW\TNXSW,[ + CAIN A,"! ; If terminator was "!", go run program. + JRST RFDRUN +] + TRNN FF,FRNNUL ; If no filespec was seen, + CAIE A,^M ; and terminator is EOL, + CAIA + JRST CMD05 ; then prompt again and get another string. + TRZA FF,FRARRO ; Got something, clear saw-"_" flag. +CMD07: CALL RFD + CAIN A,"_ + JRST [ TRO FF,FRARRO ; FRARRO will be on if there's a "_" in string. + CALL RFD ; Gobble next filename, input filespec. + JRST CMD1] + CAIE A,^M + JRST CMD07 ; Read thru the whole command until read input filespec + + + ; Now re-read the string, for real this time. Previous scan was + ; mainly to latch onto input filespec and see if "_" existed. + +CMD1: SKIPN T,CMDPSV ; Restore original ptr if there's one, + MOVE T,[440700,,CMBUF] ; else point at beg of buffer. + MOVEM T,CMPTR + SETZM TTYINS ? SETZM WSWCNT ; Clear all switches. +IFN CREFSW,SETZM CREFP +IFN ERRSW, SETZM ERRFP +IFN LISTSW,SETZM LISTP ? SETOM LISTP1 ; Will be AOSed by each (L) switch. + SETZ A, + TRNN FF,FRARRO ; If "_" doesn't exist in cmd line, + MOVEI A,"_ ; then only filespec is for input, kludge to get it. + + MOVEI F,OUTFB + BLTZAC T,L$FBLK,(F) ; Clear output filblk. + MOVE T,FSDSK ; Default dev to DSK. + MOVEM T,$FDEV(F) + SKIPN T,$FNAME+ISFB ; Now default FN1 from input filespec + MOVE T,FSPROG ; (use "PROG" if none) + MOVEM T,$FNAME(F) +IFE TNXSW,[MOVE T,RSYSNM ; Now default directory if need to + MOVEM T,$FDIR(F)] + + TRZ FF,FRNNUL + CAIE A,"_ ; If it exists, + CALL RFD ; Read bin file spec. + TRNN FF,FRNNUL ; If spec was null, + JRST [ MOVE T,FSTTY ; and input spec was TTY:, + CAME T,$FDEV+ISFB + JRST .+1 + MOVE T,FSNUL ; then set device to NUL:. + MOVEM T,$FDEV(F) + JRST .+1] + +DEFINE CFMAC SWIT,PTR,INSTR,DEXT +IFN SWIT,[ + MOVE T,DEXT + MOVE TT,[[INSTR],,PTR] +] .ELSE SETZB T,TT + PUSHJ P,CMDFGT +TERMIN + + CFMAC CREFSW,CRFFB,[SETOM CREFP][IFN ITSSW,[FSCREF] .ELSE FSCRF] + + CFMAC ERRSW, ERRFB,[SETOM ERRFP] FSERR + + CFMAC LISTSW,LSTFB,[SETOM LISTP][IFN ITSSW,[FSLIST] .ELSE FSLST] + +CMD50: CAIE A,"_ + JRST [ SETZB T,TT ; Point to scratch FB etc. + CALL CMDFGT ; Ignore any output specs not needed. + JRST CMD50] ; Must do this way to retain default stuffs. + + ; Finally read input file. + BLTMAC T,L$FBLK,(F),ISFB ; Copy last stuff to input spec + MOVEI F,ISFB ; and point at it. + PUSHJ P,CMDDVX ; Hack device-name default. +IFE ITSSW, MOVE T,FSMID +IFN ITSSW, MOVE T,FSGRTN ; > on ITS. + MOVEM T,$FEXT(F) + CALL RFD ; Read input spec. + RET ; Yep, that's really all! + + ; TT has ,, + ; T has default $FEXT. + ; Takes defaults from current F, sets F to new filblk. +CMDFGT: JUMPE TT,[SETZ T, ; If 0, do usual but into oblivion (scratch FB) + MOVE TT,[[JFCL],,FB] + JRST .+1] + BLTMAC B,L$FBLK,(F),(TT) ; Copy from current filblk to new. + MOVE F,TT ; set new F. + MOVEM T,$FEXT(F) ; Set default $FEXT + PUSHJ P,CMDDVX ; Set up device, defaulting to DSK. + CAIN A,"_ ; If last delimiter was start of input spec, + POPJ P, ; don't read anything - just use defaults. + PUSHJ P,RFD + TRNN FF,FRNNUL ; If spec non-null or + CAIN A,"_ ; ended by _, then + CAIA ; hack specified instr. + POPJ P, + HLRZ T,F + XCT (T) + POPJ P, + +CMDDVX: SKIPN T,$FDEV(F) + MOVE T,FSDSK + CAME T,FSPTP + CAMN T,FSNUL + MOVE T,FSDSK + MOVEM T,$FDEV(F) + POPJ P, + +SUBTTL ITS/DEC Filename Reader/printer (RFD, TYPFB) + +IFN DECSW\ITSSW,[ ; Begin moby conditional for sixbit reader. + +; RFD - Reads a single file description from .INSRT or command line, +; using RCH, into specified FILBLK. +; F points at FILBLK to store description in. +; Implements crufty ^R hack (if see ^R, act as if just starting to +; read filename, so effect is stuff before ^R has set defaults.) +; If FRCMND set, recognize -, comma, / and ( as special characters, +; and hack switches. +; Sets FRNNUL if spec was nonnull. +; Clobbers A,B,C only. + +RFD: TRZ FF,FRNNUL +RFD01: SETZM RFDCNT ; Zero cnt of "normal" filenames. Jump here if see ^R. + +RFD10: PUSHJ P,GPASST ; Flush out spaces/tabs + TRNN FF,FRCMND ; If parsing command line, + CAIE A,"; ; or if char isn't semi-colon, + JRST RFD22 ; just handle normally. +RFD15: PUSHJ P,RCH ; Semi-colon and not command line!! Flush rest + CAIE A,^M ; of line, assuming it's a comment! + JRST RFD15 + POPJ P, + +RFD2: PUSHJ P,RCH ; Get character in A +RFD20: CAIE A,40 ; Space (Come here to scan already-read char.) + CAIN A,^I ; or tab? + JRST RFD10 ; Ach, go into flush-whitespace loop. +RFD22: CAIN A,^M ; End of line? + POPJ P, ; If so, obviously done. + CAIN A,^R ; Crufty ^R hack? + JRST RFD01 ; Sigh, pretend just starting to read filename. + TRNN FF,FRCMND ; Reading command line? + JRST RFD40 ; Nope, skip over cmnd-line frobs. + + ; Reading cmd line, test special chars. +IFN ITSSW\SAILSW, CAIN A," ; SAIL underscore, ITS backarrow like _. + .ELSE CAIN A,"= ; Either gets munged, + MOVEI A,"_ ; into canonical "_". + CAIE A,"_ ; Backarrow is output_input marker. + CAIN A,", ; Comma is also a terminator... + POPJ P, +IFN DECSW\TNXSW,[ ; I'm not sure if this belongs here, but + CAIN A,"! .SEE RFDRUN + POPJ P, +] + PUSHJ P,CMDSW ; Check for switches... + JRST RFD20 ; Got some, scan next char (returned by CMDSW) + ; Got none, drop thru. + + + ; No special delimiters, + ; Check for chars which signal what following word is. +RFD40: +IFN DECSW,[ + CAIN A,"[ ;] Left bracket signals start of PPN. + JRST [ PUSHJ P,RFDPPN ; Slurp it up, + MOVEM C,$F6DIR(F) ; store it, + TRO FF,FRNNUL ; saying spec not null. + JRST RFD20] ; and go process leftover delimiter. + + CAIN A,". ; Period signals start of extension. + JRST [ PUSHJ P,RCH ; Get the next character + PUSHJ P,RFDW ; Read in a word. + MOVEM C,$F6EXT(F) ; Store it... + TRO FF,FRNNUL ; and say spec non-null (even if C/ 0) + JRST RFD20] ; and process delimiting char. +] + + ; Here, char doesn't signal the start of anything, so we'll assume + ; it's the start of a name. + PUSHJ P,RFDW ; Gobble up a word. + JUMPE C,RFD2 ; If nothing was read, must ignore char; get another. + + ; Aha, name was read, now examine delimiter to see if it specifies + ; anything we know about. + TRO FF,FRNNUL ; Set flag saying spec non-null. + CAIN A,": ; If colon... + JRST [ MOVEM C,$F6DEV(F) ; Then store name as device. + JRST RFD2] ; and flush delimiter. +IFN ITSSW,[ + CAIN A,"; ; If semicolon... + JRST [ MOVEM C,$F6DIR(F) ; Then store name as directory (sname) + JRST RFD2] ; and flush delimiter. +] + ; Whatever it is, at this point delimiter doesn't signify anything + ; special in terms of what the name is. So we just store it, using + ; the usual FN1 FN2 DEV DIR sequence, and hand delimiter off to + ; the prefix scanning stuff. + MOVE B,RFDCNT ; Get current count for random names. + XCT RFDTAB(B) ; Either MOVEM C, to right place, or ignore + AOS RFDCNT ; by skipping over this instr. + JRST RFD20 ; and go examine delimiter. + + +.SCALAR RFDCNT ; Count to index RFDTAB by. + +RFDTAB: MOVEM C,$F6FNM(F) ; 1st name. + MOVEM C,$F6EXT(F) ; 2nd name. + MOVEM C,$F6DEV(F) ; 3rd name is dev. + MOVEM C,$F6DIR(F) ; 4th is sname. + CAIA ; 5th and on ignored, don't incr. cnt. + +; RFDW - Reads a "word" - any string of contiguous SIXBIT chars, +; barring certain delimiters, and leaves SIXBIT result in C. +; Begins reading with char currently in A. Returns with delimiter +; char in A (it's possible this can be the same char!) +; Clobbers B. + +RFDW: SETZ C, ; First things first, zap result. + SKIPA B,[440600,,C] +RFDW2: PUSHJ P,RCH + CAIN A,^Q ; Is char the quoter char? + JRST [ PUSHJ P,RCH ; Yup, gobble next... + CAIN A,^M ; and accept anything but CR + POPJ P, ; since that terminates the whole line. + JRST RFDW7] ; OK, go stuff the char into C. + CAIE A,40 ; Space + CAIN A,^I ; or tab + POPJ P, ; is always a break. + CAIN A,^M ; As is CR. + POPJ P, + TRNN FF,FRCMND ; And certain chars are bummers when reading cmd. + JRST RFDW4 + CAIE A,"/ + CAIN A,"( + POPJ P, +IFN DECSW\TNXSW, CAIE A,"= + CAIN A,"_ + POPJ P, +IFN ITSSW\SAILSW, CAIE A," + CAIN A,", + POPJ P, +IFN DECSW\TNXSW,[ + CAIN A,"! + POPJ P, +] + ; Not reading cmd line, or no cmd-line type chars seen. +RFDW4: +IFN ITSSW,[ + CAIE A,": ; For ITS filenames, these chars are special. + CAIN A,"; + POPJ P, +] +IFN DECSW,[ + CAIL A,140 ; For DEC, allow only alphanumeric. + SUBI A,40 ; cvt to uppercase, then + CAIL A,"A ; see if alpha. + CAILE A,"Z + JRST [CAIL A,"0 ; Nope, see if numeric. + CAILE A,"9 + POPJ P, ; Not alphanumeric, assume delimiter. + JRST .+1] +] +RFDW7: TLNN B,770000 ; Enough room in C for another char? + JRST RFDW2 ; Nope, ignore it and get next. + CAIL A,140 ; Enuf room, cvt lower to uppercase + SUBI A,40 + SUBI A,40 ; and cvt to sixbit, + IDPB A,B ; and deposit. + JRST RFDW2 ; Get another. + +] ; END IFN DECSW\ITSSW + +IFN DECSW,[ ; PPN Reader + +RFDPPN: PUSHJ P,RFDOCT ; Read project num, +IFN CMUSW, JUMPE C,RCMUPP ; At CMU watch for our funny ppns + HRLM C,(P) + PUSHJ P,RFDOCT ; Read programmer num. + HLL C,(P) + POPJ P, + +IFE SAILSW,RFDOCL=="0 ? RFDOCH=="8 ; Read octal numbers. +IFN SAILSW,RFDOCL==40 ? RFDOCH==140 ; Read sixbit (right-justified). + +RFDOCT: SETZ C, ; Read octal num, return in C. +RFDOC1: PUSHJ P,RCH + CAIL A,140 + SUBI A,40 +IFN SAILSW,[ ;[ ; Even if reading sixbit names (for SAIL), + CAIE A,", ; Comma and closebracket are still special. + CAIN A,"] + POPJ P, +] + CAIL A,RFDOCL + CAIL A,RFDOCH + POPJ P, ; Not octal or not 6bit, return. + IMULI C,RFDOCH-RFDOCL + ADDI C,-RFDOCL(A) + JRST RFDOC1 + +IFN CMUSW,[ ; [ +RCMUPP: CAIN A,"] ; Watch out for [] + POPJ P, +REPEAT 4, SETZM PPNBUF+.RPCNT + MOVE C,[440700,,PPNBUF] +RCMUPL: CAIE A,^M ; Don't look too far + SKIPE PPNBUF+3 + JRST RCMUPD + IDPB A,C + PUSHJ P,RCH ; [ + CAIE A,"] + JRST RCMUPL +RCMUPD: MOVE A,[C,,PPNBUF] + CMUDEC A, + SETZ C, + POPJ P, + +.VECTOR PPNBUF(4) ; Storage to buffer up a string for CMUDEC uuo to scan. + +] ;IFN CMUSW +] ;IFN DECSW + +IFN DECSW\ITSSW,[ + +; TYPFB - Type out current filblk (what F points at) as file specification +; Clobbers A,B,C + +TYPFB: MOVSI C,-3-ITSSW + HRR C,F +TYPF1: MOVE B,$F6DEV(C) ; Get next name + PUSHJ P,SIXTYO ; Type out name + HLRZ A,C + MOVE A,FILSPC+3+ITSSW(A) ; Now get delimiting character + PUSHJ P,TYOERR ; Type out + AOBJN C,TYPF1 ; Loop for all names +IFN ITSSW, POPJ P, +IFN DECSW,[ + SKIPN B,$F6DEV(C) ; On DEC system PPN is a special case + POPJ P, + MOVEI A,"[ ;] + CALL TYOERR +IFN CMUSW,[ + MOVE A,[B,,PPNBUF] + DECCMU A, + JRST OCTPPN + TYPR PPNBUF + JRST PPNRB + ] +IFE SAILSW,[ +OCTPPN: HLRZ B,$F6DEV(C) ; LH is proj, + CALL OCTPNT + ] +.ELSE [ HLLZ B,$F6DEV(C) + CALL SIXTYO +] + MOVEI A,", + CALL TYOERR +IFE SAILSW,[ + HRRZ B,$F6DEV(C) + CALL OCTPNT ; RH is prog. +] +.ELSE [ HRLZ B,$F6DEV(C) + CALL SIXTYO + ] +PPNRB: ; [ + MOVEI A,"] + JRST TYOERR +];IFN DECSW + +FILSPC: ": +IFN ITSSW, 40 ? 40 ? "; +IFN DECSW, ". ? 0 + +] ; END IFN DECSW\ITSSW + +SUBTTL Command switches + +; CMDSW - Hacks either a single switch or switch list; A should +; contain "/ for the former, "( for the latter. +; Returns in A next char after switch hackery done. This may be ^M. +; Skip returns if neither "/ nor "( was furnished to it. + +CMDSW: CAIN A,"/ ; Single switch? + JRST [ PUSHJ P,RCH ; Get next char + CAIN A,^M + POPJ P, + PUSHJ P,CMDSW1 + PJRST RCH] + CAIE A,"( ; Switch list? + JRST POPJ1 ; Neither slash nor paren, make skip return. +CMDSWL: PUSHJ P,RCH + CAIN A,^M + POPJ P, + CAIN A,") + PJRST RCH + PUSHJ P,CMDSW1 + JRST CMDSWL + + ; Command switch processing. CMDSW1 processes the switch char + ; in A. +CMDSW1: CAIL A,140 ; Lower case to upper. + SUBI A,40 + CAIN A,"T + SOS TTYINS ; Count # T-switches. + + CAIN A,"W ; W - prevent tty messages, and +IFE ERRSW,AOS WSWCNT ; request error output file if possible. +.ELSE [ + AOSA WSWCNT + CAIN A,"E ; E - request error log file. + SETOM ERRFP + ] + +IFN CREFSW,[ + CAIN A,"C ; C - request CREF output. + SETOM CREFP + ] + +IFN LISTSW,[ + CAIE A,"L ; L - request listing + POPJ P, + SETOM LISTP ; Say want listing. + AOS LISTP1 ; (starts as -1, will be positive after 2nd (L)) + ] + + POPJ P, + +SUBTTL TENEX Filename Reader/printer (RFD, TYPFB) + +IFN TNXSW,[ ; Moby conditional for Tenex reader. + +; TNXRFD - TENEX-style Filename Reader. +; Takes input from RCH, +; Deposits name strings into filblk F points to. +; Clobbers A,B,C,D, (and AA,T,TT due to FNCHK) +; Uses FRFEXT flag to see if already read extension (type) or not. +; Refuses to accept existing defaults for version, ;T, account, +; protection, or JFN. It will also zap an existing directory +; default if a device is specified, and vice versa. This is so that +; logical names will win a little better. +; Implements crufty ^R hack (if see ^R, act as if just starting to +; read filename, so effect is stuff before ^R has set defaults.) + +IFNDEF FRFDEV,FRFDEV==2 ; Set if read device. +IFNDEF FRFDIR,FRFDIR==1 ; Set if read directory. +IFNDEF FRFEXT,FRFEXT==FRFN1 ; Borrow this bit. Set if read extension. + +RFD: TRZ FF,FRNNUL + SETZM $FJFN(F) ; Zap JFN since the filename we'll read won't match it. + SETZM $FACCT(F) ; Also zap other things that we don't want defaulted. + SETZM $FPROT(F) + SETZM $FTEMP(F) + SETZM $FVERS(F) +TRFD01: TRZ FF,FRFEXT+FRFDEV+FRFDIR ; Jump here if ^R seen. +TRFD10: PUSHJ P,GPASST ; remove tabs, spaces and get first non-tab/space + TRNN FF,FRCMND ; If parsing command line, + CAIE A,"; ; or if char isn't semicolon, + JRST TRFD21 ; just handle normally. +TRFD15: PUSHJ P,RCH ; Semi-colon and not command line, it's a comment! + CAIE A,^M ; So flush rest, up to EOL. + JRST TRFD15 + POPJ P, + +TRFD1: TLO FF,FLUNRD ; come here to re-read last char +TRFD2: PUSHJ P,RCH ; Get char +TRFD21: CAIE A,40 ; Space? (come here to scan already-read char) + CAIN A,^I ; or tab? + JRST [TRNE FF,FRCMND ; Space/tab, if reading command line + JRST TRFD2 ; then ignore and continue scanning (for switches), but + JRST TRFD15] ; if not in cmd line, go flush entire rest of line! + CAIN A,^M ; End of line? + POPJ P, ; If so, obviously done. + CAIN A,^R ; Crufty ^R hack? + JRST TRFD01 ; Sigh, pretend starting over. + TRNN FF,FRCMND ; Must we check for cmd line frobs? + JRST TRFD22 ; Nope, skip them. + + ; Must check for chars special only in command line. + CAIN A,"= + MOVEI A,"_ + CAIE A,"_ ; backarrow is filename terminator... + CAIN A,", ; as is comma. + POPJ P, + CAIN A,"! ; For CCL hacking... + POPJ P, .SEE RFDRUN + PUSHJ P,CMDSW ; Check for switches... + JRST TRFD21 ; got some, process next char (returned by CMDSW) + ; Skips if none, drop thru. + + ; Now see if char signifies start of anything in particular. +TRFD22: CAIE A,"< ; Start of directory name? + JRST TRFD24 ; No + PUSHJ P,RCH + PUSHJ P,TRFDW ; Read word, starting with next char +TRFD23: CAIN A,". ; Allow . as part of directory name + JRST [ PUSHJ P,TRFDW5 ; Read a continuation to this word + JRST TRFD23] ; And try again + MOVEI D,$FDIR ; Set up index. + CAIN A,"> ; Terminator should be end of dir name... + PUSHJ P,RCH ; If so, get next to avoid scan of ">". + ; else bleah, but aren't supposed to fail... + TRNN FF,FRFDEV ; Unless a device has been explicitly given, + SETZM $FDEV(F) ; zap any furnished default. 0 means DSK. + TRO FF,FRFDIR ; Now say dir was explicitly given. + JRST TRFD6 ; Go store it. +TRFD24: CAIN A,". ; Start of $FTYPE or $FVERS (20x)? + JRST [ MOVEI D,$FTYPE ; Assume reading $FTYPE field, + TLNE FF,FL20X ; always if 10X, but if really on 20X, then + TRON FF,FRFEXT ; use $FTYPE only if not already seen. + JRST TRFD4 ; $FTYPE - jump to get word & store. + PUSHJ P,TRFDNM ; $FVERS - 20X and $FTYPE already seen. Get #. + MOVEM B,$FVERS(F) ; Store it away if successful. + JRST TRFD1] ; and go re-read delimiting char. + + CAIN A,"; ; Start of $FVERS (10x) or attribute? + JRST [ PUSHJ P,RCH ; Find what next char is. + CAIL A,"a ; Must uppercasify. + CAILE A,"z + CAIA + SUBI A,40 + CAIN A,"T ; Temporary file? + JRST [ SETOM $FTEMP(C) + JRST TRFD2] + CAIN A,"A ; Account? + JRST [ MOVEI D,$FACCT ; Set index, and + JRST TRFD4] ; go gobble following word. + CAIN A,"P ; Protection? + JRST [ MOVEI D,$FPROT ; Set index, and + JRST TRFD4] ; go gobble following word. + TLO FF,FLUNRD ; Not alpha, try numeric. Re-read char, + PUSHJ P,TRFDNM ; trying to parse as number. + MOVEM B,$FVERS(F) ; Win, parsed as number! Store it. + JRST TRFD1] ; If none of above, ignore ";" entirely. + + PUSHJ P,TRFDW ; Let's try reading it as word, + JUMPLE C,APOPJ ; If nothing read, assume it's some terminating delimiter. + CAIN A,": ; Else have something, check trailing delim for special cases + JRST [ MOVEI D,$FDEV ; Aha, a device. + PUSHJ P,RCH ; Flush the terminator & get next char. + TRNN FF,FRFDIR ; Unless dir was explicitly given, + SETZM $FDIR(F) ; zap furnished default. 0 uses connected dir. + TRO FF,FRFDEV ; Say device was explicitly given, and + JRST TRFD6] ; store name away. + MOVEI D,$FNAME ; Else assume it's the filename. + JRST TRFD6 + + +TRFD4: PUSHJ P,RCH ; Here when must gobble next char, +TRFD5: PUSHJ P,TRFDW ; here when first char of wd already read. +TRFD6: PUSHJ P,FNCHKZ ; Note this can return and store a null string! + ADDI D,(F) ; Get address (filblk+index), and + MOVEM A,(D) ; store string pointer in the appropriate place. + TRO FF,FRNNUL ; Say non-null spec seen, + JRST TRFD1 ; and go re-read the delimiter, to process it. + +; TRFDW - Read a word (string), for use by TNXRFD. Copies sequence of +; acceptable filename chars into FNBUF, until non-valid char seen. +; A/ First char of word, +; Returns A/ delimiting char, C/ count of chars in string, +; clobbers nothing else. + +TRFDW4: SUBI A,40 ; Make lowercase +TRFDW5: IDPB A,FNBWP ; Deposit into FNBUF, + PUSHJ P,RCH ; get next char, + AOSA C ; and bump count, skipping over zap instruction. +TRFDW: SETZ C, ; When called, zero cnt of chars in string. + CAIL A,"A ; See if char is uppercase alpha, + CAILE A,"Z + CAIA + JRST TRFDW5 + CAIL A,"a ; or lowercase alpha, + CAILE A,"z + CAIA + JRST TRFDW4 + CAIL A,"0 ; or numeric, + CAILE A,"9 + CAIA + JRST TRFDW5 + CAIE A,"$ ; or dollarsign + CAIN A,"- ; or hyphen + JRST TRFDW5 + CAIN A,"_ ; Backarrow is special case, because + JRST [ TRNN FF,FRCMND ; if reading command, + TLNN FF,FL20X ; or running on 10X, + POPJ P, ; must treat as delimiter. + JRST TRFDW5] + CAIN A,^V ; ^V is quote char... + JRST [ PUSHJ P,RCH ; Quote, get next. + CAIE A,^M ; Quote anything but this. + CAIN A,0 ; or this. + POPJ P, ; time to exit. + PUSH P,A ; Quote it! Save char, + MOVEI A,^V ; so that a quoter can precede it. + IDPB A,FNBWP ; Fortunately this hair only needs care + POP P,A ; for quoted chars, which are + JRST TRFDW5] ; rare. + TLNE FF,FL20X ; Are we on a 10X? + POPJ P, ; If not, anything at this point is delimiter. + CAIL A,41 ; Check general bounds + CAIL A,137 ; Range from space to _ exclusive. + POPJ P, ; If outside that, delimiter. + CAIL A,72 ; This range includes :, ;, <, =, > + CAILE A,76 + CAIA + POPJ P, ; delimiter. + CAIE A,". + CAIN A,", + POPJ P, + CAIE A,"* + CAIN A,"@ + POPJ P, + ; Finally, check out chars which are acceptable to 10X but which + ; might be delimiter in cmd line... + TRNN FF,FRCMND + JRST TRFDW5 ; Not hacking cmd line, it's an OK char. + CAIE A,"/ + CAIN A,"( + POPJ P, + CAIN A,"! + POPJ P, + JRST TRFDW5 ; at long last done. + + +; TRFDNM - Read numerical string, halt when non-digit +; seen, leaves result (decimal) in B, with delimiting char in A. +; One peculiarity is skip return if no numerical char is seen at all; +; else doesn't skip and B has a valid number. + +TRFDNM: PUSHJ P,RCH ; First char needs special check. + CAIL A,"0 + CAILE A,"9 + JRST POPJ1 ; Not a number at all? + TDZA B,B +TRFDN2: IMULI B,10. + ADDI B,-"0(A) ; Convert to number + PUSHJ P,RCH ; Get following chars. + CAIL A,"0 + CAILE A,"9 + POPJ P, ; Nope, not digit so treat as delimiter. + JRST TRFDN2 ; Yep, a number + +] ;IFN TNXSW + +IFN TNXSW,[ + +; TYPFB - Type out FB pointed to by F + +TYPFB: SKIPE B,$FDEV(F) ; First, device name? + JRST [ PUSHJ P,TYPZ + MOVEI A,": + PUSHJ P,TYOERR + JRST .+1] + SKIPE B,$FDIR(F) ; Directory? + JRST [ MOVEI A,"< + PUSHJ P,TYOERR + PUSHJ P,TYPZ + MOVEI A,"> + PUSHJ P,TYOERR + JRST .+1] + SKIPE B,$FNAME(F) + PUSHJ P,TYPZ + MOVEI A,". + PUSHJ P,TYOERR + SKIPE B,$FEXT(F) + PUSHJ P,TYPZ + MOVEI A,". ; 20X uses "." to set off version, + TLNN FF,FL20X ; but 10X uses ";". + MOVEI A,"; + PUSHJ P,TYOERR + HRRE A,$FVERS(F) + JUMPL A,[MOVM B,A ; Is possible to have -1, -2, etc. + MOVEI A,"- + PUSHJ P,TYOERR + MOVE A,B + JRST .+1] + PUSHJ P,DPNT ; Version # output in decimal. + SKIPE $FTEMP(F) + TYPE ";T" ; May be temporary. + SKIPE B,$FPROT(F) + JRST [ TYPE ";P" + PUSHJ P,TYPZ + JRST .+1] + SKIPE B,$FACCT(F) + JRST [ TYPE ";A" + PUSHJ P,TYPZ + JRST .+1] + POPJ P, + + ; Takes BP in B, outputs to TYOERR until zero byte seen. +TYPZ: CAIA + PUSHJ P,TYOERR + ILDB A,B + JUMPN A,TYPZ+1 + POPJ P, +] ; IFN TNXSW + +SUBTTL TENEX misc. Filename Routines, FS string storage + +IFN TNXSW,[ .SEE FSDSK ; Part of this page is NOT conditionalized!! + +; To handle filenames of ASCIZ strings instead of SIXBIT words, each +; word has instead a byte pointer to an ASCIZ string. For purposes of +; easy comparison, all of these bp's point into FNBUF, and a routine +; (FNCHK) is provided which checks a just-stored string and returns a bp +; to either this string, if unique, or to a previously stored string if +; it is the same as the one just stored (which is then flushed). Thus +; strings can be compared for equality simply by a comparison of their +; byte pointers. While not necessary, strings are stored beginning on +; word boundaries for easier hacking. + + ; <# files>**+<# wds for constants> +LFNBUF==*5*3+20 ; Enough to hold strings for all output files, + ; all translated files, and all .insrt files encountered. + ; Later a GC'er can be hacked up so that of the latter only + ; enough for the max .insrt level need be allocated. + +LVAR FNBUF: BLOCK LFNBUF + + ; Macro to easily define constant strings for comparison purposes +DEFINE DEFSTR *STR* +440700,,%%FNLC +%%LSAV==. +LOC %%FNLC +ASCIZ STR +%%FNLC==. +LOC %%LSAV +TERMIN + %%FNLC==FNBUF +] ; IFN TNXSW!!! + + ; If not assembling for TENEX, the following strings become + ; simple SIXBIT values. This makes it possible to write simple + ; code to work for both TENEX and non-TENEX without messy conditionals. + +IFE TNXSW,[EQUALS DEFSTR,SIXBIT] + +FSDSK: DEFSTR /DSK/ ; This stuff defines various BP's into FNBUF to +FSSYS: DEFSTR /SYS/ ; use for comparison purposes later. +FSTTY: DEFSTR /TTY/ +FSNUL: DEFSTR /NUL/ +FSPTP: DEFSTR /PTP/ +FSATSN: DEFSTR /@/ +FSSBSY: DEFSTR /SUBSYS/ +FSPROG: DEFSTR /PROG/ +FSMID: DEFSTR /MID/ +FSMDAS: DEFSTR /MIDAS/ +FSGRTN: DEFSTR />/ +FSCRF: DEFSTR /CRF/ +FSCREF: DEFSTR /CREF/ +FSERR: DEFSTR /ERR/ +FSLST: DEFSTR /LST/ +FSLIST: DEFSTR /LIST/ +FSSAV: DEFSTR /SAV/ +FSEXE: DEFSTR /EXE/ + +IFN TNXSW,[ +VBLK +FNBBP: 440700,,FNBUF ; Points to beg of FNBUF (hook for dynamic alloc) +FNBEP: FNBUF+LFNBUF-1 ; Points to last wd in FNBUF (address, not BP) +FNBWP: 440700,,%%FNLC ; Write Pointer into FNBUF. +FNBLWP: 440700,,%%FNLC ; Last Write Pointer, points to beg of string being stored +PBLK +EXPUNG %%FNLC + +; NOTE - provided MIDAS never restarts, no initialization is necessary to +; start using FNCHK. (Unless of course FNBUF is dynamically allocated someday) + +; FNCHK - Check out just-stored filename. Returns BP in A to ASCIZ string, +; which will be "canonical" for comparison purposes. +; Clobbers A,B,T,TT,AA +; FNCHKZ - Makes sure just-writ string is ASCIZ'd out before FNCHK'ing. + +FNCHKZ: MOVE B,FNBWP ; Get write ptr, + LDB A,B ; see if last char was 0, + JUMPE A,FNCHK0 ; if so can skip one clobberage. + SETZ A, + IDPB A,B ; zero out bytes, +FNCHK0: TLNE B,760000 ; until at end of word. + JRST .-2 + ADD B,[<440700,,1>-<010700,,>] ; bump BP to point canonically at next. + MOVEM B,FNBWP + +FNCHK: HRRZ B,FNBWP ; See if write ptr + CAML B,FNBEP ; has hit end of FNBUF, and + ETF [ASCIZ /Filename buffer overflow/] ; barf horribly if so. + MOVE A,FNBBP ; A - bp to start of existing string + MOVE AA,FNBLWP ; AA - bp to start of new string to store +FNCHK2: MOVEI T,(A) ; T - current addr being checked, existing str + MOVEI TT,(AA) ; TT - current addr, new str + CAIL T,(TT) ; If addrs are same, or overran somehow, + JRST [ MOVE A,AA ; didn't find any match, accept new string. + MOVE B,FNBWP + MOVEM B,FNBLWP ; Set up new last-write-ptr + POPJ P,] +FNCHK3: MOVE B,(T) + CAMN B,(TT) ; Compare strings, full word swoops. + JRST [ TRNE B,377 ; equal, last char zero? + AOJA T,[AOJA TT,FNCHK3] ; no, continue for whole string + ; Found it! Flush just-stored string, don't want duplicate. + MOVEM AA,FNBWP ; Clobber write ptr to previous value. + POPJ P,] + ; Not equal, move to next string to compare + MOVEI B,377 ; Check for ASCIZ, + TDNE B,(T) ; moving to end of current string + AOJA T,.-1 + HRRI A,1(T) ; and updating BP to point at new string. + JRST FNCHK2 ; (T gets pointed there too at FNCHK2). + +; JFNSTR - Get filename strings for active JFN. +; A/ active JFN +; F/ addr of filename block to clobber. +; JFNSTB - Same, but ignores A and assumes JFN is already stored in block. +; Clobbers A,C + +JFNSTB: SKIPA A,$FJFN(F) ; JFNSTB gets the JFN from block itself. +JFNSTR: MOVEM A,$FJFN(F) ; whereas JFNSTR stores it there... + MOVSI D,-NJSTRF ; Set up aobjn thru table. +JFNST2: PUSH P,T + SYSCAL JFNS,[FNBWP ? $FJFN(F) ? JSTRFX+1(D)][FNBWP] + POP P,T + MOVE C,JSTRFX(D) ; Now get index to place it belongs in file block, + CAIN C,$FVERS ; and check for this, because + JRST [ MOVE A,FNBLWP ; it wants to be a number, not a string. + MOVEM A,FNBWP ; Zap write pointer back to forget string, + PUSHJ P,CVSDEC ; and quickly convert before anything clobbers it. + JRST .+2] ; Skip over the FNCHKZ call. + PUSHJ P,FNCHKZ ; Fix it up, and get BP to it. + ADDI C,(F) ; make it an addr, and + MOVEM A,(C) ; store BP. (or value, for $FVERS) + ADDI D,1 + AOBJN D,JFNST2 + POPJ P, + + ; Filblk idx, output format wd for JFNS call +JSTRFX: $FDEV ? 100000,, + $FDIR ? 010000,, + $FNAME ? 001000,, + $FTYPE ? 000100,, + $FVERS ? 000010,, +NJSTRF==<.-JSTRFX>/2 + +; CVSDEC - Converts ASCIZ string to decimal, assumes only digits seen. +; A/ BP to ASCIZ +; Returns value in A, clobbers nothing else. + +CVSDEC: PUSH P,B + PUSH P,C + MOVE C,A + SETZ A, + JRST CVSDC3 +CVSDC2: IMULI A,10. + ADDI A,-"0(B) +CVSDC3: ILDB B,C + JUMPN B,CVSDC2 + POP P,C + POP P,B + POPJ P, + +; CVSSIX - Converts ASCIZ string to SIXBIT word. +; A/ BP to ASCIZ string, +; Returns SIXBIT word in A. Clobbers nothing else. + +CVSSIX: PUSH P,B + PUSH P,C + PUSH P,D + MOVE D,A + SETZ A, + MOVE B,[440600,,A] + JRST CVSSX3 +CVSSX2: CAIL C,140 + SUBI C,40 ; Uppercase force + SUBI C,40 ; cvt to 6bit + IDPB C,B ; deposit + TLNN B,770000 ; If BP at end of word, + JRST CVSSX5 ; leave loop. +CVSSX3: ILDB C,D + JUMPN C,CVSSX2 +CVSSX5: POP P,D + POP P,C + POP P,B + POPJ P, + +; CV6STR - Takes 6bit word in A, writes into FNBUF and makes a string of +; it, returning BP in A. +; Clobbers A,B,T,TT,AA (due to FHCHKZ) + +CV6STR: MOVE B,A +CV6ST2: SETZ A, + LSHC A,6 ; Get a 6bit char + ADDI A,40 ; Make ASCII + IDPB A,FNBWP ; deposit + JUMPN B,CV6ST2 ; Continue until nothing left + PJRST FNCHKZ ; Make output thus far a string. + + +; CVFSIX - Takes current filblk (pointed to by F) and puts the +; right stuff in $F6 entries. + +CVFSIX: PUSH P,A + PUSH P,B + MOVSI B,-L$F6BL +CVFSX2: MOVE A,@CVFTAB(B) ; Get BP to string + PUSHJ P,CVSSIX ; Convert to 6bit + ADDI B,$F6DEV(F) ; Get index to right place to store. + MOVEM A,(B) + SUBI B,$F6DEV(F) ; restore aobjn pointer... + AOBJN B,CVFSX2 + POP P,B + POP P,A + POPJ P, + +CVFTAB: $FDEV(F) + $FNAME(F) + $FEXT(F) + $FDIR(F) +IFN <.-CVFTAB>-L$F6BL, .ERR CVFTAB loses. + +] ; IFN TNXSW + +SUBTTL DEC/TENEX - RUN hacking. (Process FOO! in CCL) +IFN DECSW,[ + +; Process "FOO!", which means "run SYS:FOO with an offset of 1". +; Note that the RUN call needs a block of 6 ACs, but at this point +; it doesn't matter what gets clobbered. + + + ; Entry point for restart, from TSRETN. +RERUN: MOVE B,FSMDAS ; Get name - using SYS:MIDAS + SETZB C,D+1 ; (no ext or ppn) + JRST RFDRU1 + +VBLK + +RFDRUN: MOVE A,$F6DEV(F) ; Load up the 4 filenames to use. + MOVE B,$F6FNM(F) + MOVE C,$F6EXT(F) + MOVE D+1,$F6DIR(F) + JUMPN A,RFDRU3 ; If device specified, use that, + MOVSI A,'DSK ; else default to DSK + CAIN D+1, ; if a PPN was given, and +RFDRU1: MOVSI A,'SYS ; to SYS: otherwise. +RFDRU3: SETZB D,D+2 ; These acs must always be zero... + MOVEI D+3,177 ; Flush all core above this address. +IFN SAILSW,[ + SETZ D+4, + CORE2 D+4, ; Flush hiseg by hand on SAIL. + GOHALT + ] +.ELSE HRLI D+3,1 ; Elsewhere, just set LH to this to flush hiseg. + + MOVE D+4,[RUNCOD,,D+5] ; Move core-less code into position in ACs. + BLT D+4,+LRUNCD-1 + MOVE D+4,[1,,A] ; ,,
+ JRST D+5 ; Go flush core and run program. + +RUNCOD: CORE D+3, ; Flush as much core as possible; RUN uuo can lose + GOHALT ; Because of how much we have. + RUN D+4, + GOHALT +LRUNCD==.-RUNCOD + ; Make sure symbols A-D leave enuf room. +IFL 17-, .ERR RFDRUN ACs lose. +PBLK +] ;END IFN DECSW + +IFN TNXSW,[ + ; On TENEX, we'll do things without compat package (boo hiss) + + ; Entry point for starting new MIDAS, come here from TSRETN. +RERUN: MOVEI F,FB + BLTZ L$FBLK,FB ; Clear out scratch filblk, point at it. + MOVE A,FSMDAS ; Get BP to "MIDAS", store in + MOVEM A,$FNAME(F) ; filblk, and drop thru for defaults. + + ; Here to start up specified program, for CCL hacking. +RFDRUN: TLNN FF,FL20X ; 20X or Tenex? + JRST [ MOVE A,FSSBSY ; Tenex, get BP to SUBSYS string + SKIPN $FDIR(F) ; Unless directory specified, + MOVEM A,$FDIR(F) ; default dir to . + MOVE A,FSSAV ; And do similar thing for ext (.SAV) + JRST RFDRN2] + MOVE A,FSSYS ; 20X, get BP to SYS string + SKIPN $FDEV(F) ; Unless device specified, + MOVEM A,$FDEV(F) ; default dev to SYS:. + MOVE A,FSEXE ; And ditto for ext (.EXE) + +RFDRN2: SKIPN $FEXT(F) ; If extension not specified, + MOVEM A,$FEXT(F) ; Store appropriate one. + PUSHJ P,GETJFI ; Get JFN for input... + GOHALT ; Ugh, bletch, etc. + + ; OK, all ready to smash ACs with loader, etc. + MOVE R1,$FJFN(F) ; Put JFN into RH + HRLI R1,.FHSLF ; and fork handle (self) in LH. + MOVE R2,[RUNCOD,,R3] ; Load into ACs beginning at AC 3 + BLT R2,R3+LRUNCD-1 + JRST R3 ; Off we go, never to return... + + ; Following code is executed in AC's, position independent. +RUNCOD: GET ; Load up the file. + MOVEI R1,.FHSLF + GEVEC ; Find entry vector word for it, returned in AC 2. + JRST R1(R2) ; and go execute instruction in reenter slot. +LRUNCD==.-RUNCOD ; Pretty small loader, huh? +] ; IFN TNXSW + +SUBTTL Core Allocation routine - GCCORQ gets another K for MACTAB + +; Get another K of MACTAB space. + +GCCORQ: MOVE A,MACHI + LSH A,-2 ; Convert to word # + CAIL A,MXMACL ; Want more than allowed? + POPJ P, + MOVE A,MACTND ; No, get addr of block we want to get. + PUSH P,A ; Entry, save A in case have to try again +CORRQ1: +IFN ITSSW,[ + LSH A,-10. + SYSCAL CORBLK,[MOVEI %CBNDR+%CBNDW + MOVEI %JSELF ? A ? MOVEI %JSNEW] + JRST CORRQL ; Lose +] +IFN DECSW,[ + IORI A,1777 + CORE A, + JRST CORRQL ; Lose +] +IFN TNXSW,[ + SKIPN MEMDBG ; Only need to hack if want. + JRST CORRQ3 + ; Super kludge. No way to ask 10X for a "new page"; must + ; get it via default create-on-reference. Hence to get page + ; without bombing, must be sure .ICNXP interrupt deactivated! + PUSH P,T + SYSCAL DIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Deactivate. + SETZM (A) ; Reference 1st page + SETZM 1000(A) ; Reference 2nd page. + SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Re-activate. + POP P,T +CORRQ3: +] + + REST A + ADDI A,2000 + JRST MACIN2 ; Update pointers to end of MACTAB. + +IFN ITSSW\DECSW,[ + ; Lossage handler for GCCORQ. Only ITS or DEC can fail. +CORRQL: PUSH P,C + PUSH P,D + TLOE AA,400000 + JRST CORQL1 + TYPE " +No core for macro table." +CORQL1: TYPE " +Try again? " +CORQL2: PUSHJ P,TYI ; Get char + CAIL A,140 ; Cheap uppercase force + SUBI A,40 + CAIN A,"Y ; Y, + JRST CORRQA ; => try again + CAIN A,"N ; N, + JRST CORRQB ; => back to DDT then try again + CAIN A,"? ; ?, + ERJ CORQL1 ; => type out error-type blurb + TYPE "? " ; something else + JRST CORQL2 + +CORRQB: +IFN ITSSW,.VALUE ; Loop point for don't-proceed +IFN DECSW,EXIT 1, + TLZ AA,400000 +CORRQA: POP P,D + POP P,C + MOVE A,(P) ; Restore A from PDL + JRST CORRQ1 +] ; IFN ITSSW\DECSW + +SUBTTL CORGET - allocate fresh pages + +; CORGET - Takes arg in AA, an ITS page AOBJN to pages to grab. +; AA/ -<# pages>,,<1st page #> +; Clobbers only AA. + +CORGET: JUMPGE AA,APOPJ ; Ignore arg if nothing to do about it. +IFN ITSSW,[ + SYSCAL CORBLK,[ MOVEI %CBNDR+%CBNDW ; Get both read and write. + MOVEI %JSELF ; Into self + AA ; AA is AOBJN of pages. + SETZI %JSNEW] ; Want fresh pages. + .LOSE %LSSYS +] +IFN TNXSW,[ + SKIPN MEMDBG ; Ignore anyway if not hacking mem ref debugging. + POPJ P, + PUSH P,R1 + PUSH P,R2 + PUSH P,R3 + MOVE R3,AA + ASH R3,1 ; Get Tenex page AOBJN + MOVEI R1,(R3) + LSH R1,9. ; Get word address of first page. + HRR R3,R1 ; Stick back in AOBJN. + + ; Super kludge. No way to ask 10X for a "new page"; must + ; get it via default create-on-reference. Hence to get page + ; without bombing, must be sure .ICNXP interrupt deactivated! + MOVEI R1,.FHSLF + MOVE R2,[1_<35.-.ICNXP>] + DIC ; Deactivate. +TCORG3: SETZM (R3) ; Get the page. + ADDI R3,777 ; Bump word address, + AOBJN R3,TCORG3 ; and get next page (note adds 1 more to RH) + AIC ; Now re-activate... + POP P,R3 + POP P,R2 + POP P,R1 +] ;IFN TNXSW + POPJ P, + \ No newline at end of file diff --git a/src/midas/tsrtns.231 b/src/midas/tsrtns.231 new file mode 100755 index 00000000..f6624ba2 --- /dev/null +++ b/src/midas/tsrtns.231 @@ -0,0 +1,4586 @@ +;-*-MIDAS-*- + +SUBTTL TS Definitions, parameters + + ; For convenience in defining isolated variables/tables, + ; especially when have to know on pass1 where the + ; table is going to be (.VECTOR etc don't know until end of pass) +DEFINE LVAR -LINE +VBLK +LINE +PBLK +TERMIN + +DEFINE TMPLOC AT,STUFF +%%%TLC==. ? LOC AT + STUFF +LOC %%%TLC +TERMIN + + ; Nice macro for minimizing coding. Doesn't hack indirection tho. + ; Could conceivably optimize to do MOVE AC,[FROM,,TO] but that + ; would be overly hairy for something you can do just by writing + ; 2 instructions. +DEFINE BLTMAC AC,LEN,FROM,TO + MOVSI AC,FROM + HRRI AC,TO + BLT AC,TO+LEN-1 +TERMIN + + ; Also handy for standard zaps (and nice mnemonic) + ; won't work for indirection either. +DEFINE BLTZAC AC,LEN,FROM + SETZM FROM +IFG LEN-1,[ + MOVEI AC,FROM+1 + HRLI AC,-1(AC) + BLT AC,FROM+LEN-1 +] +TERMIN + + ; More convenient when A is clobberable... +DEFINE BLTM LEN,FROM,TO +BLTMAC A,LEN,FROM,TO +TERMIN + +DEFINE BLTZ LEN,FROM +BLTZAC A,LEN,FROM +TERMIN + + ; Following inserts a SYSCAL for JSYS's. Be warned that it + ; clobbers T when used!! +IFN TNXSW,.INSRT XJSYS + +IFNDEF PMAPSW,PMAPSW==TNXSW ; 1 to assemble PMAP input, 0 for SIN input. +IFNDEF ERRSW,ERRSW==1 ; 1 for error file output capability. + +IFNDEF TYPDLC,TYPDLC==7 ; Maximum total depth of .insrt (including tty) +IFNDEF MX.INS,MX.INS==5 ; Maximum depth .insrt files only +IFNDEF MAXIND,MAXIND==6 ; Maximum # @: table entries for .insrt + + ; Define sizes of various I/O buffers +IFN DECSW,[ +IFNDEF DECBFL,DECBFL==203 ; Standard DEC buffer size for DSK (200 wds data) +IFN SAILSW,IFNDEF NINBFS,NINBFS==19. ; For SAIL, hack full disk track of input. +IFNDEF NINBFS,NINBFS==2 ; # standard-size buffers to use for input. +IFNDEF UTIBFL,UTIBFL==*NINBFS ; Input buffs need 1 wd for EOB hacking +IFNDEF UTOBFL,UTOBFL==DECBFL ; All output chans have just 1 buffer. +IFNDEF CRFBSZ,CRFBSZ==DECBFL +IFNDEF LSTBSZ,LSTBSZ==DECBFL +IFNDEF ERRBSZ,ERRBSZ==DECBFL +] ;DECSW +IFNDEF CMBFL,CMBFL==50 ; Length of command buffer. +IFNDEF UTIBFL,UTIBFL==400 ; " Input buffer. +IFNDEF UTOBFL,UTOBFL==200 ; " BIN output buffer. +IFNDEF CRFBSZ,CRFBSZ==200 ; " CREF output buffer. +IFNDEF LSTBSZ,LSTBSZ==200 ; " LIST output buffer. +IFNDEF ERRBSZ,ERRBSZ==1 ; " ERR output buffer. Very small to avoid + ; losing much data if things crash. + + +ERRC==0 ; Err device input channel +TYIC==1 ; TTY input channel +TYOC==2 ; TTY output channel +CREFC==3 ; CREF output +UTYOC==4 ; BIN output +LPTC==5 ; LIST output (LPT) +ERRFC==6 ; ERR Assembly error output file. +UTYIC==7 ; 1st input channel, UTYIC+n used for nth .INSRT level in dec version. + +SUBTTL File Description Storage (FILBLK's) + +VBLK + ; Definitions for indices into a FILBLK. + + ; Scratch block FB is formed while defining indices... +FB: OFFSET -. + ; Lots of crocks depend on the exact order of these 4 items. +$F6DEV:: 0 ; SIXBIT Device name +$F6FNM:: $F6FN1:: 0 ; SIXBIT Filename (on ITS, FN1) +$F6TYP:: $F6FN2:: $F6EXT:: 0 ; SIXBIT Extension (on ITS, FN2) +$F6DIR:: 0 ; SIXBIT Directory (may be numerical PPN) + L$F6BLK==. +$FVERS:: $FGEN:: 0 ; File version (or generation). NUMBER, not string. +IFN TNXSW,[ ; Almost all entries here are BP's to ASCIZ strings. +$FDEV:: 0 ; Device name +$FDIR:: 0 ; Directory name +$FNAME:: 0 ; File name (i.e. main name) +$FTYPE:: $FEXT:: 0 ; File type (or extension) +$FTEMP:: 0 ; -1 => File is a temporary file. +$FACCT:: 0 ; Account string +$FPROT:: 0 ; Protection string +$FJFN:: 0 ; JFN for file (may be ,,) +] +IFN ITSSW\DECSW,[ +$FDEV==:$F6DEV ; These definitions made so some common code can do +$FDIR==:$F6DIR ; the right things. +$FNAME==:$F6FNM +$FTYPE==:$F6TYP +$FEXT==:$F6TYP +] + L$FBLK==. ; Length of a FILBLK. + OFFSET 0 ; End of index definitions. + + + ; FILBLK's for various files + +ISFB: BLOCK L$FBLK ; Input file specification as given in command line. +INFB: BLOCK L$FBLK ; Actual current input file. +OUTFB: BLOCK L$FBLK ; Output file + +IFN CREFSW, CRFFB: BLOCK L$FBLK ; CREF output file +IFN LISTSW, LSTFB: BLOCK L$FBLK ; Listing output file +IFN ERRSW, ERRFB: BLOCK L$FBLK ; Error output file + +INFCNT: 0 ; AOS'd each time an input file is opened. +INFCUR: 0 ; What INFCNT was when current file opened. +INFERR: 0 ; What INFCUR held at last err msg. + +INDDP: MAXIND,,TBLOFS ; Pointer into tables below +TBLOFS: BLOCK MAXIND*L$FBLK ; Actual filenames corresponding to those in TBLSFS, for opening. +TBLSFS: BLOCK MAXIND*L$FBLK ; Source-specified filenames for @: files + + +RFNAM1: 0 ; .FNAM1, .FNAM2, .FVERS +RFNAM2: 0 +RFVERS: 0 +IFNM1: 0 ; .IFNM1, .IFNM2, .IFVRS +IFNM2: 0 +IFVRS: 0 +INFFN1==:INFB+$F6FN1 ; Some crocks seem to reference this. +OFNM1==:OUTFB+$F6FN1 ; Pseudo .OFNM1 needs this. +OFNM2==:OUTFB+$F6FN2 ; ditto, .OFNM2 +RSYSNM: 0 ; Initial system name + +IFN TNXSW,[ +USRNUM: 0 ;User# of person running program +UNAMLN: 0 ;# of words in his username. +USRNAM: BLOCK 40./5 ;Max username is 39. characters +FNAMLN: 0 +FILNAM: BLOCK 200./5 ;Max filename is around 170. characters. +];TNXSW +PBLK + +SUBTTL I/O Buffers + +VBLK ; Input buffer and variables + +UTIBUF: BLOCK UTIBFL +UTIHDR: 0 ; Input buffer header (dec version) +UREDP: 440700,,UTIBUF ; Input byte pointer +UTICNT: 0 ; Input byte count (dec version) +IUREDP: 440700,,UTIBUF ; Initial UREDP, used for re-initializing. +UTIBED: UTIBUF ; EOF comparison with RH(UREDP), 4.9 => EOF on .IOT + +IFN DECSW,UTICHN: UTYIC + + ; BIN Output buffer + +UTOBUF: BLOCK UTOBFL ; Output buffer +UTOHDR: UTOBFL,,UTOBUF-1 +UTYOP: 444400,, ; Output (36. bit) byte pointer +UTYOCT: 0 ; # words left in utobuf +IFN ITSSW,OCLOSP: @1(C) ; Turned into bp to unused part of last bffer wd used. + + ; CREF output buffer +IFN CREFSW,[ +CRFBUF: BLOCK CRFBSZ +CRFHDR: CRFBSZ,,CRFBUF-1 ; Header, assembled value used only ifn itssw +CRFPTR: 444400,, ; Bp for filling buffer (full words) +CRFCNT: 0 ; Num. wds. empty in buffer +] + + ; LISTing output buffer +IFN LISTSW,[ +LSTBUF: BLOCK LSTBSZ +LSTHDR: 5*LSTBSZ,,LSTBUF-1 +LSTPTR: 440700,, +LSTCNT: 0 +] + + ; ERRor output buffer +IFN ERRSW,[ +ERRBUF: BLOCK ERRBSZ +ERRHDR: 5*ERRBSZ,,ERRBUF-1 +ERRPTR: 440700,, +ERRFCT: 0 ; Can't call this ERRCNT since that's used for # errors. +ERRFP: 0 ; Non-0 if want error output file. +ERRFOP: 0 ; Non-0 if error file open (ie try outputting to it) +] +PBLK + +SUBTTL Interrupt Handling + +; Note that only PDL OV is now enabled in general. +; TTY input interrupts are also handled when possible for +; ^H, ^W, and ^V. + +.SCALAR INTSVP ; Saves P on interrupt for debugging + +IFN ITSSW,[ + TMPLOC 42, JSR TSINT ; Interrupt vector for ITS +VBLK +.JBCNI: +TSINT: 0 ; 1st wd interrupts currently considered fatal errors. +.JBTPC: 0 ; Error processor re-enables interrupts + .SUSET [.RJPC,,INTJPC] + SKIPGE TSINT + JRST TTYINT ; Second-word ints. + JRST TSINT1 ; Jump into pure coding and process interrupt +INTJPC: 0 ; Saves .JPC at interrupt. +PBLK + ; Jrst here from TSINT for 2nd wd interrupts. +TTYINT: PUSH P,A + MOVEI A,TYIC ; The tty chnl is the only one enabled. + .ITYIC A, + JRST TTYINX ; No int. char. + CAIN A,^W + AOS TTYFLG ; ^W silences, + CAIN A,^V + SOS TTYFLG ; ^V unsilences, + CAIN A,^H + SETOM TTYBRF ; ^H says break next time thru ASSEM1 loop. +TTYINX: REST A + .DISMIS .JBTPC +] ; IFN ITSSW + +IFN DECSW, TMPLOC .JBAPR, TSINT1 ; Interrupt vector for DEC + +IFN ITSSW\DECSW,[ + ; Amazing but can use almost same basic rtn for both! + +TSINT1: MOVEM P,INTSVP ; Save P for possible debugging +IFN ITSSW,.SUSET [.SPICL,,[-1]] ; For ITS, re-enable ints. + MOVE A,.JBCNI ; Get interrupt request word + TRNE A,200000 ; PDL overflow? + JRST CONFLP + MOVE B,[TYPE "Unknown interrupt - Fatal"] ; anything else. + MOVEM B,40 + MOVE A,.JBTPC ; So error routine will print out properly + JSA A,ERROR +] + +IFN TNXSW,[ + ; TENEX Interrupt handler +; Note that NXP (non-ex page) is enabled, but no provision is +; currently made for handling it. This causes process termination and +; EXEC will print error message. If NXP wasn't enabled, a page would +; simply be created without fuss (page is always created, incidentally, +; whether or not interrupt happens) + +LVAR MEMDBG: 0 ; For nonce, this gets set when PURIFG does. + +LEVTAB: INTPC1 ; Where to store PC for level 1 interrupt. + 0 ? 0 ; Levels 2 and 3 unused. +CHNTAB: BLOCK 36. ; Where to go for indicated condition. Most zero. + +.IC.CV==1 ; Define user channel 1 for ^V interrupt +.IC.CW==2 ; " 2 for ^W +.IC.CH==3 ; " 3 for ^H +%%LSV==. +LOC CHNTAB+.ICPOV ? 1,,TSINT1 ; Put right word in CHNTAB for PDL OV dispatch. +LOC CHNTAB+.IC.CV ? 1,,INT.CV ; Ditto for ^V dispatch +LOC CHNTAB+.IC.CW ? 1,,INT.CW ; " ^W +LOC CHNTAB+.IC.CH ? 1,,INT.CH ; " ^H + ; The next 3 are to handle all reasonable interrupts resulting from + ; a failing JSYS. +LOC CHNTAB+.ICILI ? 1,,INT.IL ; Illegal instruction (normally a failing JSYS) +LOC CHNTAB+.ICEOF ? 1,,INT.IL ; EOF encountered +LOC CHNTAB+.ICDAE ? 1,,INT.IL ; Data error encountered +LOC %%LSV + +.SCALAR INTPC1 ; Level 1 interrupt PC stored here. + + ; Handle PDL OV interrupt +TSINT1: MOVEM P,INTSVP ; Save PDL ptr. + MOVEI A,CONFLP ; OK to clobber A in PDLOV. + MOVEM A,INTPC1 ; Dismiss to CONFLP. + DEBRK ; Off we go. + + ; Handle ^V interrupt +INT.CV: SOS TTYFLG ; Unsilence typeout + DEBRK + + ; Handle ^W +INT.CW: AOS TTYFLG ; Silence typeout + DEBRK + + ; Handle ^H +INT.CH: SETOM TTYBRF ; Set flag to check at main level ASSEM1 loop. + DEBRK + + ; Handle Illegal Instruction (normally a failing JSYS, bletch!) + ; 10X ERJMP-handling interrupt routine. +ERJMPA==: ; For use instead of ERJMP where JSYS normally skips. +IFNDEF ERJMP,ERJMP==: +IFNDEF ERCAL,ERCAL==: + +ERXJMP==: ; For easier code writing +ERXCAL==: +ERXJPA==: + +INT.IL: PUSH P,A + PUSH P,B + MOVE A,INTPC1 ; Get PC we got interrupted from + LDB B,[271500,,(A)] ; Get op-code and AC field of instr + CAIN B,ERXJPA + JRST ERJFAK + CAIE B,ERXJMP ; Is it a magic cookie? + CAIN B,ERXCAL + JRST ERJFAK + AOJ A, + LDB B,[271500,,(A)] ; Try next instr + CAIE B,ERXJMP ; Any better luck? + CAIN B,ERXCAL + JRST ERJFAK + ETF [ASCIZ "Fatal interrupt encountered"] + +ERJFAK: CAIN B,ERXCAL ; See which action to hack + JRST ERJFK2 ; Go handle ERCAL, messy. + MOVEI A,@(A) ; ERJMP, get the jump address desired + MOVEM A,INTPC1 ; Make it the new PC + POP P,B + POP P,A + DEBRK +ERJFK2: MOVEI B,@(A) ; Get jump address + MOVEM B,INTPC1 ; Make it the new PC + POP P,B + AOJ A, ; old PC needs to be bumped for return + EXCH A,(P) ; Restore old A, and save PC+1 on stack + DEBRK + +; (Actually, since ERCAL is not special except after a JSYS, it would +; still work if the ERCAL-simulation didn't bump the PC; control would +; just drop through to the next instruction on return. Might confuse +; people looking through the stack frames, though.) +] ;IFN TNXSW + +SUBTTL MIDAS BEGINS HERE - Program Startup + +VBLK +NVRRUN: -1 ; 0 => MIDAS was run; error to start or purify. +FATAL: 0 ; At end of assembly, not 0 iff fatal error occurred. +PBLK + +BEG: ; Start address! +IFN DECSW\TNXSW,[ + TDZA A,A + SETO A, + MOVEM A,CCLFLG ; Remember type of start-up +] + SETZ FF, ; Initialize flags + MOVE P,[-LPDL,,PDL-1] ; Initialize P + +IFN DECSW,[ + RESET + MOVEI A,600000 + APRENB A, +] + ; For TENEX, must determine right away which system we're on. +IFN TNXSW,[ + RESET +; TLZ FF,FL20X ; Assume 10X until proven otherwise. (done by SETZ above) + +IFN 0,[ ; One way of determining OS which doesn't work on some places. + MOVE A,[112,,11] ; Magic word that will win on 10X,T20 (and maybe T10) +GETTAB=<047000,,41> ; CALLI 41 + GETTAB A, ; Returns 10000 T10, 20000 ITS, 30000 10X, 40000 T20 + MOVEI A,30000 ; Shouldn't ever fail, but if it does, assume 10X. + LDB A,[140300,,A] ; Flush other fields too + CAIN A,4 ; = Tops-20? + TLO FF,FL20X ; Yes, set flag. +]; IFN 0 +IFN 0,[ ; This is a loser too, since there ARE KL Tenices! + SETZ A, ; In lieu of above, use hardware hack... + BLT A, ; test for KL-ness. + CAIE A, + TLO FF,FL20X ; KL will fail to skip, assume that means 20X OS. +];IFN 0 +IFN 1,[ ; Boy I hope DEC never defines LOADTB! -- MRC + SYSCAL SYSGT,[['LOADTB]][A ? D] + SKIPN D ; If LOADTB is not defined + TLO FF,FL20X ; it must be a Twenex +]; IFN 1 + + SYSCAL SCVEC,[[.FHSLF] ? [-1]] ; and flush compat package, + ; disabling UUO's 40-77; this is good for debugging. + + ; Set up stuff for interrupts + SYSCAL SIR,[[.FHSLF] + [LEVTAB,,CHNTAB]] ; Specify tables + SYSCAL EIR,[[.FHSLF]] ; Enable interrupts + SYSCAL AIC,[[.FHSLF] ; Activate PDL OV and ^V, ^W, ^H +[IRP BIT,,[.ICPOV,.IC.CV,.IC.CW,.IC.CH] +<1_<35.-BIT>>+!TERMIN ]] + SYSCAL ATI,[[.TICCV,,.IC.CV]] ; Make various mappings from + SYSCAL ATI,[[.TICCW,,.IC.CW]] ; terminal bits to int. channels. + SYSCAL ATI,[[.TICCH,,.IC.CH]] ; What a losing interrupt sys 10X has! + SKIPN MEMDBG ; Hacking memory ref debugging? + JRST BEG20 + ; Make sure that all low impure pages exist + ; whether or not they consist of all zeros. Problem is that EXEC SAVE + ; command ignores pages that are all zero, so they won't exist on + ; startup and we have to re-create them or risk getting a NXP int. + MOVSI A,-2*MINBNK + MOVE B,(A) ; Reference them all to create them if nec. + ADDI A,777 + AOBJN A,.-2 + MOVE B,-1 ; Ditto last TNX page of initial MACTAB + ; Now enable interrupts for Non-eXistent Pages. + SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] + +BEG20: SYSCAL GJINF,[][USRNUM] ;Get your user# into USRNUM + SYSCAL DIRST,[[-1,,USRNAM] ? USRNUM] ;And then make username string + JFCL + MOVEI A,1 ;# words in username string. + MOVE B,USRNAM-1(A) + TRNE B,376 ;check last position in this word + AOJA A,.-2 ; filled, so check next word. + MOVEM A,UNAMLN ;Save # words. + +] ;TNXSW + +IFN ITSSW,[ + MOVE A,[-5,,[ ; Set and read various vars in a chunk. + .SMASK,,[%PIPDL] ; 1st-wd Interrupt only on PDL ovfl. + .SMSK2,,[1_TYIC] ; 2nd-wd on TTY input channel. + .SPICL,,[-1] ; and enable interrupt system. + .RSNAM,,RSYSNM ; Get system name (default dir to use) + .RXJNAM,,B ]] ; and XJNAME for temp. hacking below. + .SUSET A + SYSCAL TTYSET,[1000,,TYIC ; Set TTYST wds - PI echo, no act/int + [232020,,202020] ; except ctls activate & interrupt + [232020,,220220]] ; CR, DEL activate but don't int; + ; DEL doesn't echo. +] + + AOSE NVRRUN ; Test for this job's already being run... + JRST [ TYPE "Can't restart MIDAS" + JRST TSRETN] + + ; Initialize impure memory for paged systems +IFN ITSSW\TNXSW,[ + MOVE AA,[MXICLR-MXIMAC,,MXICLR] + CALL CORGET ; Get MACTAB pages not loaded into. +IFN PURESW,[ + MOVE AA,[MINBNK-MINMAC,,MINBNK] + CALL CORGET ; Get pages for blank code & symtab. + SKIPN PURIFG + JRST .+3 ; If purified, skip cleanup + JSP F,FLSPGS ; If not purified => flush pages of + ,,MXIMAC ; MACTAB created by loading but not needed. +] ;PURESW +] ;IFN ITSSW\TNXSW + + MOVEI D,SYMDSZ ; Get default symtab size +IFN ITSSW,[ ; Remember that B set to XJNAME above. + CAME B,['MMIDAS] ; Set symtab size larger for MMIDAS + CAMN B,[SIXBIT/MM/] ; (random sort of hack now that .SYMTAB exists) + MOVEI D,SYMMSZ +] + SKIPGE ISYMF ; The first time through, + MOVEM D,SYMLEN ; Make that the size to use. + CALL SITINI ; Initialize stuff for .SITE. + CALL JCLINI ; Now try to fetch JCL; set CMPTR accordingly. +IFN ITSSW,[ + SKIPGE ISYMF ; Skip if syms spread; if not, + CALL TSYMGT ; get TS syms from system. +] + SKIPE CMPTR ; If have JCL, + JRST GO2AA ; skip announcing midas's name and version. + +IFG PURESW-DECSW,[ ; If meaningful, + SKIPGE PURIFG ; Check for purity + TYPE "NOTPUR " ; and type little warning if unpurified. + ] + TYPE "MIDAS." ; and announce self. + MOVE B,[MIDVRS] + PUSHJ P,SIXTYO + JRST GO2AA + +SUBTTL MIDAS Top-level control path + +GO2A: SETZM CMPTR ; Recycles here, so JCL only hacked once. +GO2AA: SETOM FATAL ; Assume fatal errors, unless cleared at GO8 when done. + SETZM TTYFLG ; Allow TTY typeout. + SETZM ERRCNT ; Initialize error counter (total errors) +IFN RUNTSW,[ PUSHJ P,RNTTMA ; Get initial run time. + MOVEM A,IRUNTM] + SETZM LSTTTY ; Tell TYOERR not to try output to LST file (none yet!) + PUSHJ P,CMD ; Get typed in command (or scan cmd line if CMPTR ne 0) + + SKIPGE SMSRTF ; What's this for, I wonder? + JRST GO21 + TYPECR "SYMTAB clobbered" + JRST GO2A + + ; Filenames and switches all specified, now see if files can be set up. +GO21: PUSHJ P,OPNRD ; Open input file + JRST GO2A ; Error, msg was typed, go try again with new cmd line. + PUSHJ P,WINIT ; Open output file, cref file. +IFN DECSW\TNXSW,[ + SKIPGE CCLFLG + TYPE "MIDAS: " +] +IFN A1PSW,[ + SETOM PRGC + SETOM OUTC +GO3: ] + MOVE A,WSWCNT + MOVEM A,TTYFLG ; Turn off typeout if there were (W) switches. + SETOM LSTTTY ; Allow TYOERR to output to both TTY and LST. + JSP A,$INIT ; Initialize for assembly + JSP A,PS1 ; Do pass 1 + TRNN FF,FRNPSS ; If 2 pass assembly, + JRST GO4 + PUSHJ P,OPNRD ; Then re-open input file + JRST GO2A ; Couldn't re-open???? Do something better here. +GO4: JSP A,PLOD ; Maybe punch out SBLK loader in some format + JSP A,PS2 ; Do pass 2 + JSP A,PSYMS ; Maybe punch out symbol table +IFN A1PSW,[ + TLZ FF,$FLOUT + AOS PRGC ; Indicate end statement encountered + SETOM OUTC ; " " " + TRNN FF,FRNPSS ; If 1 pass assembly, + SKIPGE CONTRL + CAIA + JRST GO3 ; Then try to assemble another program +] +IFN FASLP,[ + SKIPGE A,CONTRL + TRNN A,FASL + JRST GO8 + MOVE A,[SIXBIT /*FASL*/] ; "finish" FASL file + MOVEI B,17 + PUSHJ P,FASO ; Ignore end frob, but output FASL end code + MOVE A,[ASCIC//] ; pad with ^C's. + PUSHJ P,FASO1 ; Randomness + PUSHJ P,FASBE ; Write out last block +] + ; Jump directly here for certain main-input EOF conditions. +GO8: SETZM FATAL ; There was no fatal error: output files get renamed. + + ; Jump directly here if hit fatal error (incl .FATAL, illegal UUO, etc) +GO9: PUSHJ P,.FILE ; Close (and rename if FATAL = 0) output files. + SETZM LSTTTY +IFN RUNTSW, PUSHJ P,RNTTYO ; Type out run time used since GO2A + CALL ERRCLS ; File away error file - only thing not closed by .FILE + JRST TSRETN ; and die according to system's wishes. + +SUBTTL MIDAS Death (TSRETN) - system dependent exit routines + +IFN ITSSW,[ +TSRETN: +IFN PURESW,[ + SKIPGE PURIFG ; If not yet purified, assume being debugged. + .VALUE +] + .LOGOUT ; Come here to commit suicide. + .BREAK 16,160000 +] ;IFN ITSSW + +IFN DECSW,[ + +TSRETN: SKIPLE A,ERRCNT ; If had any errors, + ADDM A,.JBERR ; let loader know about them. (???) Well, + .SEE ERR1 ; for strange comment. + SKIPN CCLMOR ; Any more CCL commands? + EXIT ; Nope, all done. + JRST RERUN ; More CCL to hack, start up a new MIDAS. +] ; IFN DECSW + + +IFN TNXSW,[ +TSRETN: SKIPE CCLMOR ; Need to hack any more CCL? + JRST RERUN ; Yeah. +TSRET1: HALTF + HRROI 1,[ASCIZ/Can't continue/] + PSOUT ; Better than dying randomly + JRST TSRET1 +] ; IFN TNXSW + +SUBTTL MIDAS Murder - fatal internal error handling (GOHALT) + +VBLK +HALTER: 0 ; JSR'd here when fatal internal error seen. + JRST HALTEP ; Jump to pure-code handling +PBLK +HALTEP: +IFN ITSSW,[ + .VALUE [ASCIZ |: ===== Fatal MIDAS internal error! ===== +Please send a message to BUG-MIDAS describing circumstances. +Error was at location:  +HALTER/ +|] +] ;IFN ITSSW + +IFN TNXSW,[ +.SCALAR HALTR1,HALTR2,HALTR3 + MOVEM R1,HALTR1 ; Save R1 etc. for later examination + MOVEM R2,HALTR2 + MOVEM R3,HALTR3 + HRROI R1,[ASCIZ | ===== Fatal MIDAS internal error! ===== +Please send a message to BUG-MIDAS @ MIT-MC describing circumstances. +Error was at location: |] + PSOUT + MOVEI R1,.PRIOU + HRRZ B,HALTER + MOVEI C,8. + NOUT + ERJMP .+1 + HRROI R1,[ASCIZ / +/] + PSOUT + MOVE R1,HALTR1 ; Restore R1 etc. for later examination + MOVE R2,HALTR2 + MOVE R3,HALTR3 + HALTF +] ;IFN TNXSW + +IFN DECSW,[ + OUTSTR [ASCIZ | ===== Fatal MIDAS internal error! ===== +Please send a message to BUG-MIDAS @ MIT-MC describing circumstances. +Error location can be found in HALTER/ (please look at it with DDT to +find out where the error came from). +|] + EXIT +] ;IFN DECSW + + JRST .-1 ; Just in case + +SUBTTL MIDAS Purification - PURIFY startup, also DECDBM + +IFN ITSSW\TNXSW,[ +IFN PURESW,[ + +PURIFY: SKIPL NVRRUN +IFN ITSSW,[ .VALUE [ASCIZ /: Already run, can't purify  +/]] +IFN TNXSW,[ + JRST [ HRROI 1,[ASCIZ /? Already run, can't purify +/] + PSOUT + HALTF + JRST .+1] ; If continued, go ahead anyway. +] ;IFN TNXSW +PURIF1: MOVEI P,17 ; Start PDL at 20 + JSP F,FLSPGS ; First flush blank-code pages, + ,,MINBNK ; incl. symbol table area. + JSP F,FLSPGS ; Flush MACTAB pages created by load + ,,MXICLR ; but not needed. + JSP F,PURIFD ; Purify pure pages. + ,,MINPUR + SETZM PURIFG ; Set "purified" flag +IFN TNXSW,SETOM MEMDBG ; For TNX, ask for mem checking. + MOVE [1,,2] ; Now clear out remains of data of self + MOVEI 1,0 + BLT 40 +IFN ITSSW,[ + .VALUE [ASCIZ /: Purified, type CR to dump  +:PDUMP SYS;TS MIDAS/] +] ;IFN ITSSW + +IFN TNXSW,[ + HRROI 1,[ASCIZ / Purified, now SAVE +/] + PSOUT + HALTF +] ; IFN TNXSW + JRST BEG + + ; JSP F,FLSPGS + ; -<# pgs>,, + ; Flush pages specified by page AOBJN + +FLSPGS: MOVE A,(F) ; Get the page AOBJN +IFN ITSSW,[ + SYSCAL CORBLK,[MOVEI 0 ? MOVEI %JSELF ? A] + .LOSE 1000 +] +IFN TNXSW,[ + ASH A,1 ; Multiply # pages, page # by 2. + HLRE B,A + HRLI A,.FHSLF + MOVNS B + TLO B,(PM%CNT) ; Say hacking repeat count +FLSPG2: SYSCAL PMAP,[[-1] ? A ? B] ; Flush these pages. + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI B,-1(B) ; Else, on 10X, must iterate manually. + TRNE B,400000 ; See if became "negative". + JRST .+1 ; Yep, done with manual iteration. + AOJA A,FLSPG2] ; Nope, bump page #. +] + JRST 1(F) + + ; JSP F,PURIFD - Just like FLSPGS, but purifies the pages instead. + +PURIFD: MOVE A,(F) ; Get page AOBJN +IFN ITSSW,[ + SYSCAL CORBLK,[MOVEI %CBNDR ; Read access only. + MOVEI %JSELF ? A] + .LOSE 1000 +] +IFN TNXSW,[ + ASH A,1 ; Double everything to get in terms of TNX pages. + HLRE B,A + MOVNS B ; Get # pages in B + MOVEI C,(A) + ADDI C,-1(B) ; Find # of last page to purify + LSH C,9. ; Get addr of 1st wd of last page + MOVES (C) ; Touch it so that it is guaranteed to exist! + ; This is necessary since last ITS page may only + ; include one TNX page instead of two. + HRLI A,.FHSLF +PURID1: SYSCAL SPACS,[A ? [PA%RD+PA%EX]] + ADDI A,1 + SOJG B,PURID1 +] + JRST 1(F) + +IFN TNXSW,[ + +; PURSAV - A startup routine like PURIFY, for possible use on TNX if +; the EXEC "SAVE" command does not preserve page access bits. +; Current T20 EXEC seems to do OK though. This is only useful +; when trying to catch illegal writes to "read-only" code. + +PURSV0: PUSHJ P,RDJERR +PURSAV: MOVEI P,20 + HRROI R1,[ASCIZ /Pure-Save to file: /] + PSOUT + MOVSI R1,(GJ%NEW+GJ%FOU+GJ%SHT+GJ%FNS) + MOVE R2,[.PRIIN,,.PRIOU] + GTJFN ; Get JFN from TTY + JRST PURSV0 + SETZM PURIFG ; Claim purified... + SETOM MEMDBG ; and keeping watch on memory. + HRLI R1,.FHSLF + MOVEI R2,[ + 2*<0-MINBNK>,,0+SS%RD+SS%WR+SS%EXE ; Variables/buffers + 2*,,2*MINMAC+SS%RD+SS%WR+SS%EXE ; MACTAB init + 2*,,2*MINPUR+SS%RD+SS%EXE ; Purify pure pages. + 0 ] ; End of SSAVE table + SETZ R3, + SSAVE ; Do it! + HRROI R1,[ASCIZ /Saved./] + PSOUT + HALTF +] ; IFN TNXSW + +] ; IFN PURESW +] ; IFN ITSSW\TNXSW + +IFN DECDBG,[ +DECDBM: 0 + HRLZ A,.JBSYM ;GET ADDR OF START OF DDT SYMS, + HRRI A,DECDBB+200 ;LEAVE 200 WD SPACE BEFORE THEM. + HRRM A,.JBSYM ;MOVE THEM INTO SPACE PROVIDED + HLRE B,.JBSYM + MOVMS B + BLT A,DECDBB+177(B) ;SO THEY WON'T GET IN MACTAB'S WAY. + JRST @DECDBM +] + +SUBTTL System-dependent Symbol Table stuff. + +IFN ITSSW,[ + +; TSYMGT - Gobble syms from system (ITS feature!) +; TABLE AREA IN SYSTEM: +; FIRST LOC SYSYMB +; LAST (AS OPPOSED TO LAST + 1) SYSYME + +TSYMGT: MOVEI A,EISYMT ;EISYMT FIRST LOC FOR ITS SYMS + MOVE B,[SIXBIT /CALLS/] ;SYSTEM CALLS + .GETSYS A, ;READ IN SYSTEM CALLS (SHOULD SKIP) + .LOSE %LSSYS + SKIPGE A + .LOSE ;.GETSYS DIDN'T UPDATE AOBJN POINTER + HRRM A,SP1 ;MARK END OF SYMS + ANDI A,-1 + CAIL A,MACTBA+MACL + .LOSE ;MACL TOO SMALL! INITS MIGHT LOSE. + MOVEI B,EISYMT + MOVEI AA,SYMC_<-18.+4> ;SQUOZE FLAG FOR SYM +TSYMG2: DPB AA,[400400,,(B)] + ADDI B,2 + CAIE B,(A) + JRST TSYMG2 + POPJ P, +]; IFN ITSSW + +SUBTTL .SITE pseudo & initialization (SITINI) + +IFN ITSSW, LVSITE==1 ; ITS only uses 1 word of mach name. +IFN DECSW\TNXSW,LVSITE==5 ; whereas others need 5 words (25 chars max) + +LVAR V.SITE: BLOCK LVSITE ; .SITE string stored here. + + ; .SITE N, returns nth word of sixbit machine name. + +A.SITE: CALL AGETFD ; Get field as argument. + JUMPL A,CABPOP ; Ignore negative indices. + CAIL A,LVSITE ; Make sure index is within bounds of string. + JRST CABPOP + MOVE A,V.SITE(A) ; Win, get indexed word. + JRST CLBPOP + + +; SITINI - Initialization routine called only at MIDAS startup, for +; setting up .SITE and maybe other things. + +SITINI: BLTZ LVSITE,V.SITE ; Clear out string location + +IFN ITSSW,[ ; For ITS, use up just 1 word and need 1 call to set V.SITE + SYSCAL SSTATU,[REPEAT 5,[ ? MOVEM A] ? MOVEM V.SITE] + .LOSE %LSSYS + POPJ P, ] + +IFN SAILSW,[ ; SAIL needs special kludge, since it doesn't have the + MOVE A,[SIXBIT /SAIL/] ; right GETTAB used. + MOVEM A,V.SITE + POPJ P, ] + + ; This code sets TNX .OSMIDAS at runtime as appropriate. +IFN TNXSW,[ + MOVE A,[SIXBIT /TENEX/] ; Assume running on 10X + TLNE FF,FL20X ; unless proved otherwise + MOVE A,[SIXBIT /TWENEX/] + MOVEM A,OSMID ; Store directly as symtab value! +] + ; If TNX and on ARPA network, get Arpanet host name for .SITE +IFN TNXSW,[ + SYSCAL SYSGT,[['LHOSTN]][A ? B] ; Get local host # + JUMPL A,SITIN3 ; Tops-20 release 3 has a LHOSTN table + JUMPE B,SITIN3 ; Jump if none, not on net. + SYSCAL CVHST,[FNBWP ? A][A] ; Write string into FNBUF. + JRST SITIN3 ; No string for that host #?? + SETZ B, + IDPB B,A ; Make sure string is ASCIZ'd. + MOVE B,FNBWP ; Note that FNBWP isn't altered by the syscal! + MOVE C,[440600,,V.SITE] +SITIN2: ILDB A,B + JUMPE A,APOPJ ; return when string ended. + TRCE A,140 ; Convert char to sixbit. + TRCE A,140 + TRCE A,140 + IDPB A,C + JRST SITIN2 +] + + ; For non-network TENEX and DEC in general, very similar. +IFN DECSW\TNXSW,[ +IFN TNXSW,[ +SITIN3: SYSCAL SYSGT,[['SYSVER]][A ? D] ; Best to get table index dynamically, + JUMPE D,APOPJ ; If can't, lose. + ] +IFN DECSW,MOVEI D,11 ; 11 = .GTCNF But on T10 we can assume this. + + MOVE AA,[440600,,V.SITE] + MOVSI C,-5 ; Process 5 words of .GTCNF (max possible) +SITIN4: HRLZ B,C ; Get subindex we want, + HRRI B,(D) ; and produce ,,
+IFN DECSW, GETTAB B, ; Get 1 word of table, using appropriate call. +IFN TNXSW, SYSCAL GETAB,[B][B] + POPJ P, ; If call fails, exit. +SITIN5: SETZ A, + LSHC A,7 ; Extract an ascii char + CAIE A,", ; If it's a comma, + CAIG A,40 ; or ctl or space, + POPJ P, ; then let's stop. + TRCE A,140 ; Swap bit 40 with bit 100, thus turning + TRCE A,140 ; "A to 'A, "a to 'A, "1 to '1, etc, and ^@ to ' . + TRCE A,140 + IDPB A,AA ; Store the sixbit into V.SITE + JUMPN B,SITIN5 ; When nothing left of this word of .GTCNF, get next. + AOBJN C,SITIN4 + POPJ P, +] ;DECSW\TNXSW + +SUBTTL RunTime - .MRUNT and end-of-assembly typeout +IFN RUNTSW,[ + +.SCALAR IRUNTM ; Holds initial run time (set at start of assembly) + + ; .MRUNT - Returns runtime since start of assembly. + +A.MRUN: PUSHJ P,RNTTMA ; Get current run time + SUB A,IRUNTM ; Subtract initial run time +IFN ITSSW,[MULI A,4069. ; ITS - Convert to nanoseconds, + DIV A,[1.^6] ; then to milliseconds. +] + PJRST CLBPOP + + ; RNTTMA - internal routine to return in A the current runtime, + ; in whatever units the OS furnishes. +RNTTMA: +IFN ITSSW, .SUSET [.RRUNT,,A] ; Gets runtime in 4.096 usec units. +IFN DECSW, SETZ A, ? RUNTIM A, ; Runtime in msec +IFN TNXSW,[ + IFN A-1, EXCH R1,A + MOVEI R1,.FHSLF + RUNTM ; Runtime in msec for self. + IFN A-1, EXCH R1,A + ] + POPJ P, + +; RNTTYO - Called at end of assembly to type out runtime, +; # of errors, and # symbols used. + +RNTTYO: +IFN DECSW,[ ; Nobody wants this on ITS, but other people do...sigh... + SKIPE A,ERRCNT ; Any assembly errors? + JRST [ TYPE "? " ; Yes, error message for batch controllers + CALL DPNT + TYPECR " error(s) detected" + JRST .+1] + SKIPE CCLFLG ; Called via CCL? + RET +] + TYPE "Run time = " + CALL A.MRUN ; Get runtime in millisec. in A. + IDIVI A,10. + IDIVI A,100. ; Get secs and hundredths. + HRLM B,(P) ; Save remainder + PUSHJ P,HMSTYO ; Type out secs + MOVEI A,". + CALL TYO + HLRZ A,(P) + CALL HMSTY3 ; Type out hundredths + CALL CRR + CALL A.SYMC + CALL DPNT + TYPE " Symbols including initial ones (" + CALL A.SYMC + IMULI A,100. + IDIV A,SYMLEN ; Get % symtab used + CALL DPNT + TYPECR "% used)" + RET + +; HMSTYO - Type out H:MM:SS time in A +; Doesn't work for times .ge. 60. hours + +HMSTYO: IDIVI A,60. + JUMPE A,[MOVE A,B ? PJRST DPNT] + HRLM B,(P) + PUSHJ P,HMSTYO + MOVEI A,": + PUSHJ P,TYO ; Type delimiting char + HLRZ A,(P) +HMSTY3: IDIVI A,10. + PUSHJ P,ADGTYO ; Type out digit in A + MOVEI A,"0(B) + PJRST TYO + +] ; IFN RUNTSW + +SUBTTL COMMON Output Routine WINIT - Open all output files. + +; WINIT - Called from top-level control to open all necessary output files. +; + +WINIT: +IFN ERRSW,[ + SKIPN ERRFP ; If want error output file, + JRST WINIT2 + CALL OINIT ; Open it, first of all. + 0 ERRFC,ERRFB + SIXBIT/ERROUT/ + ERRHDR,,ERRBUF + SETOM ERRFOP ; Error file now open. +WINIT2: ] + PUSHJ P,OINIT ; Open main output file. + 13^9 UTYOC,OUTFB ; chnl,name-block. + SIXBIT/OUTPUT/ + UTOHDR,,UTOBUF +IFN ITSSW,[ + TLZ FF,FLPTPF ; Initially assume device not paper tape punch + .STATUS UTYOC,A ; Get status of output channel + ANDI A,77 ; Mask to device code + CAIN A,7 ; If paper tape punch, + TLO FF,FLPTPF ; Then set FLPTPF. +] +IFN LISTSW,[ + SKIPN LISTP + JRST WINIT1 + CALL OINIT ; Open listing file if desired. + 0 LPTC,LSTFB + SIXBIT/LSTOUT/ + LSTHDR,,LSTBUF +WINIT1: +] +IFN CREFSW,[ + SKIPN CREFP ; If cref requested, + RET + PUSHJ P,OINIT ; Open cref file, FN2 = CRFOUT + 13^9 CREFC,CRFFB + SIXBIT/CRFOUT/ + CRFHDR,,CRFBUF + MOVE A,[.BYTE 7 ? 177 ? "B ? ^W] + PUSHJ P,CRFOUT ; Output header to indicate image input. + PUSHJ P,CRFSSF ; Output set-source-file block. +] + RET + +SUBTTL COMMON Output Routines - Output Chars/Words to BIN, TTY, ERR, CREF, LIST + + ; PPB - Punch Binary word. + +PPB: JUMPGE FF,CPOPJ ; Don't punch if not punching pass. +PPBA: ; This entry pt "Always" punches. +TPPB: SOSGE UTYOCT ; If no more room in buffer, + JRST [ CALL TPPBF ; Output & re-init buffer. + JRST TPPB] + IDPB A,UTYOP + RET + +TPPBF: PUSH P,[0 UTYOC,UTOHDR] ; Drop thru to COBUFO. + + ; Common OBUFO. Takes ,
on stack, clobbers no ACs. + ; See rtns below for usual calling sequence. +COBUFO: EXCH C,(P) ; Get arg off stack, save C. + CALL OBUFO ; Output & re-init buffer. + REST C + RET + + ; TYO - Output char in A, outputting also to ERR file if possible. +TAB: MOVEI A,^I +TYO: SKIPG A.TTYF + CALL TYOX ; Actually output to TTY with OS-dependent routine. + ; Then fall through for ERR output. +ERRCHR: +IFE ERRSW,RET +IFN ERRSW,[ + SKIPN ERRFOP ; Output char in A to error file if one is open. + RET + SOSGE ERRFCT + JRST [ PUSH P,[ERRCHR] + PUSH P,[0 ERRFC,ERRHDR] + PJRST COBUFO] + IDPB A,ERRPTR + RET +] ;IFN ERRSW + + ; CRFOUT - Output word in A to CREF file. + +IFN CREFSW,[ +CRFOUT: SOSGE CRFCNT + JRST [ PUSH P,[CRFOUT] ; Buffer full, go output it. + PUSH P,[0 CREFC,CRFHDR] + PJRST COBUFO] + IDPB A,CRFPTR + POPJ P, + +CRFSSF: SKIPA A,[1] ; Output set-source-file block. +CRFPSH: MOVEI A,3 ; Output push-source-file block. +REPEAT L$F6BL,[ + CALL CRFOUT + MOVE A,INFB+$F6DEV+.RPCNT + ] + JRST CRFOUT +] ; IFN CREFSW + + + ; PILPT - Output character in A to listing file. + +IFN LISTSW,[ +PILPT: SOSGE LSTCNT + JRST [ PUSH P,[PILPT] ; When buffer full, output it. + PUSH P,[0 LPTC,LSTHDR] + PJRST COBUFO] + IDPB A,LSTPTR + RET + +LPTCLS=:CPOPJ ; Hmmm, random noop-ness ref'd by AEND. + +] ;END IFN LISTSW, + +SUBTTL COMMON Output Routine .FILE - Close all output files. + +; .FILE - Counterpart to WINIT. +; Close input, bin, cref and list files. + +.FILE: ; Closing input file is simple enough... +IFN DECSW, RELEAS UTYIC, +IFN ITSSW, .CLOSE UTYIC, +IFN TNXSW,[ +IFN PMAPSW, MOVE A,[NIBFPS,,1STBFP] ? CALL DELPGS ; flush buffer pages + MOVE R1,INFB+$FJFN + CLOSF + JFCL + SETZM INFB+$FJFN + SETZM JFNCHS+UTYIC +] + MOVNI A,1 + SKIPL B,CONTRL ; If relocatable, + PUSHJ P,TPPB ; Output a -1 so stink will see EOF + SETZ A, ; In dec fmt, output a 0 at end. + TRNE B,DECREL + CALL TPPB + SKIPE OUTFB+$FEXT ; Check general name. + JRST .FILE2 ; Output fnam2 was explicitly specified + + ; Output extension (fn2) wasn't specified, default depends + ; on system and output type. +IFN ITSSW, MOVSI A,'BIN ; Default to SBLK output format; note that +IFE ITSSW, MOVSI A,'SBK ; this will include RIM, RIM10. + SKIPL B,CONTRL ; Using STINK output format? +IFN ITSSW, MOVSI A,'REL ; Yes, use appropriate thing for site. +IFE ITSSW, MOVSI A,'STK + TRNE B,DECSAV ; Using DECSAV output format? + MOVSI A,'SAV +IFN TNXSW,[ + TRNE B,DECSAV ; If using DECSAV format and + TLNN FF,FL20X ; on a 20X, then + CAIA + MOVSI A,'EXE ; use this extension instead. +] + TRNE B,DECREL ; Using DECREL output format? + MOVSI A,'REL +IFN FASLP,[ + TRNE B,FASL ; Using FASL output format? +IFE DECSW, MOVE A,[SIXBIT /FASL/] ; yes, smash as appropriate. +IFN DECSW, MOVSI A,'FAS +] +IFE TNXSW, MOVEM A,OUTFB+$F6EXT ; For 6bit systems, store final selection. +IFN TNXSW, PUSHJ P,TNXODF ; If Tenex, call output default hackery, since + ; changing stuff is a bit hairier. + +.FILE2: JSP A,OCLOSE + 0 UTYOC,UTOHDR ; Write out buffer, rename and close output file. + OUTFB +IFN LISTSW,[ + SKIPN LISTP ; Listing file open => + JRST .FILE3 + CALL PNTCR ; End with cr and ff. + MOVEI A,^L + CALL PILPT + PUSH P,FATAL ; Rename listing file even if fatal error. + SETZM FATAL + JSP A,OCLOSE + 0 LPTC,LSTHDR ; Output buffer, rename & close it. + LSTFB + POP P,FATAL +.FILE3: +] ;IFN LISTSW +IFN CREFSW,[ + SKIPN CREFP ; If cref file open, + POPJ P, + MOVEI A,0 + PUSHJ P,CRFOUT ; Output eof block, + JSP A,OCLOSE ; Write buffer, close. + 0 CREFC,CRFHDR ; 0 chnl,header + CRFFB +] + RET + + ; File out error output file. This isn't done in .FILE so that + ; error file can include a few more goodies and be closed separately + ; later on. +ERRCLS: SETZM FATAL ; Err file renamed even after fatal error. +IFN ERRSW,[ + SKIPN ERRFOP + RET ; There is none. + MOVEI A,^M + CALL ERRCHR ; Put crlf at ennd. + MOVEI A,^J + CALL ERRCHR + JSP A,OCLOSE ; Rename and close. + 0 ERRFC,ERRHDR + ERRFB + SETZM ERRFOP +] + RET + +SUBTTL ITS - Output file Open, Output, Close/Rename. +IFN ITSSW,[ + +; PUSHJ P,OINIT ; Open output file +; Mode chnl,name-block-addr +; Sixbit/desired-temporary-fn2/ +; Header,,buffer space ;used only in dec version. +; The mode should be 13^9 for binary, 0 for ascii. + +OINIT: MOVE A,(P) + HLRZ B,2(A) ; Get addr of header, + SETOM 2(B) ; Set buffer byte count to -1 => not initted. + MOVE AA,1(A) ; Get 2nd arg, temp FN2 to use. + MOVE F,(A) ; Get 1st arg - , + SYSCAL TRANS,[5000,,.UAO ; For output mode, + REPEAT 4,[? .RPCNT(F) ] ; translate from given names + REPEAT 4,[? MOVEM .RPCNT+FB+$F6DEV ]] ; into actual names, in scratch blk. + JRST OINITL ; (too many translations) + + SYSCAL DELETE,[FB+$F6DEV ; Delete old temp name file. + TMPFN1 ? AA ? FB+$F6DIR] + JFCL ; If none, it's ok. + LDB A,[270400,,F] ; Get channel num. + HRLI A,.BAO ; Open mode (default ascii) + TLNE F,777000 ; But maybe want image mode. + HRLI A,.BIO ; Yep, use that instead, to get ,, + SYSCAL OPEN,[A ? FB+$F6DEV ; Open file, + TMPFN1 ? AA ; using these temp filenames. + FB+$F6DIR] + JRST OINITL + BLTM L$F6BL,FB+$F6DEV,$F6DEV(F) ; Copy translated names into + ; name-block for file, for eventual rename. + +POPJ3: AOS (P) ; Skip over 3 args. +POPJ2: AOS (P) + JRST POPJ1 + +TMPFN1: SIXBIT /_MIDAS/ ; FN1 to use for temp filenames. + + + +; OINITL - jumped to from OINIT if some lossage +; encountered when opening output files. + + +OINITL: HLLZ A,@(P) ; Get chnl num, + TLZ A,777037 ; Mask to just ac field (chnl num) + IOR A,[.STATUS A] + XCT A ; Read its status, + PUSHJ P,OPNER ; Type out reason for open failure, and ask + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Get typein, one line. + MOVE F,@(P) ; Get + PUSHJ P,RFD ; Get new file description into filblk spec'd by F + JRST OINIT ; and jump back to try again. + +VBLK +ERRDNM: .UAI,,'ERR ? 3 +ERRCOD: 0 +IFSTS: 0 ; .STATUS word stored by OPNRD1 when .OPEN loses +PBLK + + ; Openloss documentation routine + +IOPNER: MOVE A,IFSTS ; Input +OPNER: MOVEM A,ERRCOD ; Save .status word + PUSHJ P,TYPFB ; Type out file description + PUSHJ P,CRRERR ; Now crlf to ensure room for following + .OPEN ERRC,ERRDNM ; Now get the system to say what's wrong + .LOSE %LSSYS ; Can't open err device? +IOPNR2: .IOT ERRC,A ; Get character from system + CAIGE A,40 ; Ends with ^L or ^C or other cruft. + PJRST CRRERR ; Return, typing out CRLF. + PUSHJ P,TYOERR ; Type out character + JRST IOPNR2 ; Loop back for next + + +; JSP A,OCLOSE +; 0 chnl,header +; Nameblockaddr +; Write out last buffer, rename to names in nameblock and close. + +OCLOSE: MOVE C,(A) ; 1st wd of args is what OBUFO wants. + LDB B,[360600,,1(C)] ; Just in case this is ascii file, + DPB B,[300600,,OCLOSP] ; Get bp to unused part of last wd of buffer, + MOVE B,[ASCIC//] + DPB B,OCLOSP ; And pad with ^c's. + SOS 2(C) ; Obufo assumes byte count was sos'd. + CALL OBUFO ; Write out last partial buffer + MOVE F,1(A) ; Get + LDB C,[270400,,(A)] ; Get chnl num. + SKIPE FATAL + JRST OCLOS1 ; After fatal error, don't rename outputfiles. + SYSCAL RENMWO,[C ; Rename (F has nameblock addr) + $F6FN1(F) ? $F6FN2(F)] + .LOSE %LSSYS +OCLOS1: SYSCAL CLOSE,[C] ; Close channel. + .LOSE %LSSYS + JRST 2(A) ; Skip over args on return. + + +; OBUFO - Write out and reinitialize buffer for file. +; Assumes byte count (header 3rd wd) was sos'd. +; C has <0 chnl,header> +; In ITS version, header 1st wd has ,,-1 + +OBUFO: PUSH P,A + PUSH P,AA + AOSGE 2(C) ; Was count sos'd from -1? + JRST OBUFO1 ; Yes, buffer hadn't been initted, don't write it. + MOVN A,1(C) + ADD A,(C) ; RH(A) has -<# wds used in buffer>. + MOVSI A,(A) + HRR A,(C) + AOS A ; A has aobjn -> used part of buffer. + HLLZ AA,C + IOR AA,[.IOT A] + CAIGE A, + XCT AA ; Write it in file. +OBUFO1: MOVE A,1(C) + HRR A,(C) ; Position the b.p. before start of buffer, + TLZ A,770000 ; After last byte in wd (idpb will use 1st buffer wd) + MOVEM A,1(C) + HLRE A,(C) + MOVEM A,2(C) ; Set up byte count. + REST AA + JRST POPAJ + +TFEED: TLNN FF,FLPTPF ; If output device not PTP, + POPJ P, ; Then do nothing + PUSHJ P,TPPBF ; Otherwise output the buffer, +TFEED1: .FEED UTYOC, ; Feed a line, + TLZA FF,FLPTPF ; If this is executed, utyoc doesn't have ptp after all + SOJG B,TFEED1 ; Feed the specified number of lines, + POPJ P, ; And return + +] ; IFN ITSSW + +SUBTTL DEC - Output file Open, Output, Close/Rename + +IFN DECSW,[ + +OINIT: MOVE AA,(P) + MOVE F,(AA) ; Get , + HLLZ TT,F + TLZ TT,#(0 17,) ; Mask off AC field in TT + HRRZ D,2(AA) ; Get buffer space addr. + HLLZ C,2(AA) ; Get header addr. + HLRZ A,C + SETZM (A) ; Clear out its-version contents of 1st header wd. + LDB A,[331100,,F] ; Get mode to open in (will be ascii or image binary) + IOR TT,[OPEN A] ; Cons up OPEN instruction for chan, + MOVE B,$F6DEV(F) ; and bring in last arg. + XCT TT ; Open channel,a + JRST OINITL ; Lost? + + PUSH P,.JBFF ; Now to fake out DEC system into consing up buffer + MOVEM D,.JBFF ; at this location. T10 uses .JBFF as pointer. + XOR TT,[#] ; Request buffer setup (one of) + XCT TT + REST .JBFF + MOVE A,[SIXBIT /000MD /] + PJOB B, ; Get job number, to make sixbit /md/ + IDIVI B,10. + DPB C,[220400,,A] + IDIVI B,10. + DPB C,[300400,,A] ; Put the digits of the job number into the sixbit word. + DPB B,[360400,,A] + MOVE AA,(P) + LDB B,[360600,,1(AA)] ; Get 1st char of 'output, 'lstout, 'crfout, 'errout. + IOR A,B ; Use it as last char of temp file name. + MOVSI B,'TMP ; Set up ext (fn2), + SETZ C, ; zap prot/date/time etc to default, + MOVE D,$F6DIR(F) ; and PPN. + XOR TT,[#] + XCT TT ; Do ENTER UTYOC,A + JRST OINITL +POPJ3: AOS (P) +POPJ2: AOS (P) + JRST POPJ1 + +; OINITL - jumped to from OINIT if some lossage +; encountered when opening output files. Jumps back to OINIT +; directly. + +OINITL: PUSHJ P,OPNER ; Type out reason for open failure, and ask: + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Get typein, one line. + PUSHJ P,RFD ; Get new file description into filblk spec'd by F + JRST OINIT ; and jump back to try again. + + ; Openloss documentation routine - not much to say. + +IOPNER: ; Input +OPNER: PUSHJ P,TYPFB ; Type out file description + PUSHJ P,CRRERR ; Now crlf to ensure room for following + TYPE "OPEN failed" + PJRST CRRERR ; Return, typing out another CRLF. + +;CLOSE AN OUTPUT FILE, SEE NON-DEC VERSION FOR ARGS. + +OCLOSE: PUSH P,A ; Save return addr + MOVE F,1(A) ; Get + SKIPGE FATAL ; If fatal error happened, + JRST OCLOS2 ; don't rename, just close. + MOVE C,$F6DEV(F) ; Delete any file with names + SETZB B,D ; we want to rename to. + OPEN ERRC,B ; Use ERRC as temporary channel. + JRST OCLOS1 + MOVE A,$F6FN1(F) + HLLZ B,$F6EXT(F) + SETZ C, + MOVE D,$F6DIR(F) + LOOKUP ERRC,A + JRST OCLOS1 ; There is none, just rename. + SETZ A, ; Say to delete this file + MOVE D,$F6DIR(F) ; From right UFD + RENAME ERRC,A + JFCL + RELEAS ERRC, +OCLOS1: MOVE A,$F6FN1(F) ; Desired fn1. + HLLZ B,$F6EXT(F) ; Desired fn2. + SETZ C, ; Bottoms-10 DATE75 lossage must never be forgotten! + MOVE D,$F6DIR(F) ; Sname (that is, ppn) + HLLZ AA,@(P) ; Get just chnl num. + IOR AA,[CLOSE] ; Close it & finalize, + XCT AA + XOR AA,[CLOSE#] + XCT AA ; Then rename to desired names. + JFCL ; at this point, ignore any lossage, sigh. +OCLOS2: HLLZ B,@(P) ; Get chnl in ac field. + IOR B,[RELEAS] + XCT B ; Finally, release channel. + JRST POPJ2 ; and skip over args on return. + + ; Write out buffer of output file, C has <0 chnl,header> +OBUFO: AND C,[0 17,] ; Get just chnl num. (sys remembers where header is for ch) + TLO C,(OUT) ; Output current buffer. + XCT C + RET ; Normal return! + PUSH P,A ; Error return from out uuo. + XOR C,[OUT#] + XCT C ; Read file status. + TRZ A,74^4 ; Clear error bits. + ETR [ASCIZ /Output data error/] + XOR C,[#] + XCT C + JRST POPAJ + + ; Paper tape stuff, do nothing. +TFEED: RET + +] ;END IFN DECSW, + +SUBTTL TNX - Output file Open, Output, Close/Rename + +IFN TNXSW,[ + +TFEED: RET ; Again, null out paper-tape hack. + +; OINIT - Open Output file. +; P points to first word of args which follow the call: +; 1: , ; is 0 for ascii, 13^9 for bin. +; 2: sixbit // +; 3:
,, +; +; Clobbers A,B,C + +; For Tenex, it is necessary to fudge the fileblock consistency slightly; +; $FJFN has in RH the actual JFN used to write to the temporary-name +; file, and in LH the JFN for the final desired filename. Note that if +; the $FEXT is null for main output file, it will be defaulted by TNXODF +; at close time, (to SAV, EXE, or REL) and the +; "final desired" JFN won't actually be used. +; Both JFNS are "active" rather than just a file spec. + +OINIT: MOVE C,(P) ; Get addr of arg block + HLRZ A,2(C) ; Get
, + SETOM 2(A) ; and set buffer byte cnt to -1 to mark for init. + MOVE F,(C) ; Get , + PUSHJ P,GETJFO ; Get output JFN for filblk. + JRST OINIT5 ; Lost? +OINIT2: HRLZS $FJFN(F) ; Won, move JFN over into LH. + + ; Aha, successfully grabbed a JFN for desired output filename. + ; Now must get another one for the temporary filename... + MOVSI A,(GJ%FOU+GJ%NEW) + PUSHJ P,TFMAP ; Must set up block again, may have changed due to RDJFNO. + MOVE A,1(C) ; Get sixbit/tmpfn2/ + PUSHJ P,CV6STR ; Convert to ASCIZ and return BP to string. + MOVEM A,GTJBLK+.GJEXT ; Store in long-form call blk. + SYSCAL GTJFN,[[GTJBLK] ? [0]][A] ; Repeat the GTJFN call. + JRST [ MOVEM A,ERRCOD ; Ugh???? + JRST OINIT5] + HRRM A,$FJFN(F) ; Good, got it... + + ; Now have both JFN's packed away, can finally open the + ; temporary filename. + HRRZ B,A ; Need JFN in RH with LH clear... + LDB A,[331100,,F] ; Get + CAIN A, + MOVSI A,070000 ; If 0, use ASCII (7-bit bytes) + TRNE A,-1 + MOVSI A,440000 ; If not 0, use WORD (36-bit bytes) + TRO A,OF%WR ; Get write access. + SYSCAL OPENF,[B ? A][A] ; Open up the temp file (JFN in RH) + JRST [ MOVEM A,ERRCOD ? JRST OINIT6] ; damn + + ; Won, successfully opened output file stuff etc, now wrap up. + HRRZ A,$FJFN(F) ; Get JFN used, + LDB C,[270400,,F] ; and channel number argument, + MOVEM A,JFNCHS(C) ; and store JFN away in channel slot. + PUSHJ P,CVFSIX ; Now put right things in $F6 entries. + MOVEI A,3 + ADDM A,(P) + POPJ P, + +.SCALAR ERRCOD + + ; Come here when GTJFN fails trying to get a JFN for GTJBLK long + ; form argument block. Must print out bad filename. + ; OINIT5 should really use names in GTJBLK, and + ; OINIT6 should really hack GJFNS call to get names, but for now... + +OINIT5: SKIPA A,[[ASCIZ /GTJFN failed for /]] +OINIT6: MOVEI A,[ASCIZ /OPENF failed for /] + PUSHJ P,CRRERR + TYPR (A) + PUSHJ P,OPNER1 ; Type out filename and error message. + PUSHJ P,RDJFNO ; Read new JFN + JRST OINIT2 ; try to open it. + +IOPNER: PUSH P,[CRRERR] ; Do following and add CRLF. +OPNER1: PUSHJ P,TYPFB + TYPE " +Error - " ; Drop thru to TERSTR. + + +TERSTR: MOVE A,ERRCOD + HRLI A,.FHSLF + SYSCAL ERSTR,[[-1,,ERSTRB] ? A ? [-LERSTR,,]][A ? A ? B] + JRST TERST7 ; undefined err #? + GOHALT ; destination bad? + TYPR ERSTRB + POPJ P, +TERST7: TYPE "Unknown error" + POPJ P, + + LERSTR==80. +.VECTOR ERSTRB(/5) + +; RDJFNO - Hack to get a new JFN by reading from TTY, using recognition. +; RDJFNI - Same but for input. Uses current FB for defaults. +; Stashes JFN away in RH of $FJFN(F). + +RDJFNO: SKIPA A,[GJ%FOU+GJ%NEW+GJ%CFM] ; For output +RDJFNI: MOVSI A,(GJ%OLD+GJ%CFM) ; for input + PUSHJ P,TFMAP + MOVE A,[.PRIIN,,.PRIOU] ; Use primary JFNs (TTY) for I/O + MOVEM A,GTJBLK+.GJSRC + PUSH P,R1 + PUSH P,R2 + PUSH P,R3 + SYSCAL DTI,[[.TICCV]] ; Disable ^V as an interrupt character + CAIA +RDJFN2: PUSHJ P,RDJERI ; Come here when get error in GTJFN. + MOVEI R1,.PRIIN ; Make sure that + CFIBF ; TTY input is reset. + HRROI R1,[ASCIZ / +Use what filename instead? /] + PSOUT + MOVEI R1, + MOVEI R1,GTJBLK + SETZ R2, + GTJFN + JRST RDJFN2 ; Error, report it. + SYSCAL ATI,[[.TICCV,,.IC.CV]] ; Turn back on ^V + POP P,R3 + POP P,R2 + HRRM R1,$FJFN(F) + POP P,R1 + PJRST JFNSTB ; Smash FB with names of the JFN we got, and return. + +; RDJERR - Report last error message directly to TTY (primary output). +; Useful when doing quick direct user interaction. + +RDJERR: TROA R2,-1 ; Here to get last error, whatever it was. +RDJERI: MOVE R2,R1 ; Here to use err code in R1. + HRLI R2,.FHSLF + HRROI R1,ERSTRB + MOVSI R3,-LERSTR + ERSTR ; Get error string + JRST RDJER6 + GOHALT + SKIPA R1,[-1,,ERSTRB] +RDJER6: HRROI R1,[ASCIZ /Unknown error/] + ESOUT ; Output to TTY amid other hackery. + POPJ P, + + +; TNXODF - Hack to get yet another "desired" JFN so that when no +; extension was specified for binary output file, one appropriate to +; the type can be selected. +; Basically do a GTJFN again for binary output filenames, furnishing +; the default extension selected, and use that to replace the one +; already in LH of $FJFN. + +TNXODF: PUSHJ P,CV6STR ; Convert sixbit word in A to string, get BP in A + MOVEI F,OUTFB ; Point at right filblk, + MOVEM A,$FEXT(F) ; Store, and now + PUSH P,$FJFN(F) ; Save current set of JFNs before + PUSHJ P,GETJFO ; getting another one + JRST POPAJ ; If lossage, stick to old JFN. + POP P,A + HRLZS $FJFN(F) ; GETJFO puts JFN into RH, we want it in LH. + HRRM A,$FJFN(F) ; now restore previous RH. + HLRZS A ; and get old "desired" JFN in position for + SYSCAL RLJFN,[A] ; releasing. + JFCL + POPJ P, + +; OCLOSE - Close output file, writing out remainder of buffer and renaming +; from temporary to desired filename. +; JSP A,OCLOSE +; 1: 0 ,,
+; 2: +; Clobbers F,C (and obviously A) + +; 10x must do CLOSF, not releasing the JFN, and then a RNAMF from temp +; JFN to desired JFN, after which both can be released. The desired and +; used JFNs are in LH and RH respectively of $FJFN in . +; is ignored except to wipe out its JFNCHS entry. + +OCLOSE: PUSH P,A + MOVE C,(A) ; Get ,,
+ SOS 2(C) ; OBUFO assumes count was SOS'd before each call + PUSHJ P,OBUFO ; Write out anything remaining in buffer. + LDB C,[270400,,(A)] ; Get channel number + MOVE F,1(A) ; Get + HRRZ A,$FJFN(F) ; Find JFN being used... + CAME A,JFNCHS(C) ; Should be same as JFN for channel. + GOHALT ; Synch error or something. + TLO A,(CO%NRJ) ; Say don't release JFN + SYSCAL CLOSF,[A] ; Close file... + GOHALT ; ?!?! + HRRZS A ; Get back 0,,jfn + SETZM JFNCHS(C) ; Indicate "channel" closed... + SKIPE FATAL ; If fatal error happened in assembly, + JRST OCLOS5 ; don't rename from temp filenames. + HLRZ C,$FJFN(F) ; Now see what if anything to rename it to. + JUMPE C,OCLOS5 ; If no renaming needed, skip hair. + SYSCAL RNAMF,[A ? C] ; Rename file from JFN in A to JFN in C. + GOHALT ; WTF? + SYSCAL RLJFN,[C] + GOHALT + JRST OCLOS6 ; JFN in A released by RNAMF. + +OCLOS5: SYSCAL RLJFN,[A] + GOHALT +OCLOS6: SETZM $FJFN(F) + POP P,A + JRST 2(A) + +; OBUFO - Output Buffer and reinitialize. +; C/ 0 ,
+; Clobbers no ACs. + +; 10X is pretty much like ITS, JFN is kept in JFNCHS table indexed by . + +OBUFO: PUSH P,A + PUSH P,B + MOVE A,1(C) ; Get write BP, + HRR A,(C) ; and reset it... + TLZ A,770000 ; to point at start of buffer, + MOVEM A,1(C) ; and store it back, which is OK since we have byte cnt + AOSGE 2(C) ; Was buffer marked for initialization (cnt -1)? + JRST OBUFO1 ; Yes, don't write anything, just go init rest of it. + HLRZ A,(C) ; Get buffer size in wds, + MOVNI A,(A) ; make negative, + ADD A,2(C) ; and add count of bytes left to get -<# bytes used>. + LDB B,[270400,,C] ; Get channel # as index to JFN + PUSH P,T + SYSCAL SOUT,[JFNCHS(B) ? 1(C) ? A] + POP P,T +OBUFO1: HLRZ A,(C) ; Get buffer size again, + MOVEM A,2(C) ; and reset count with it. + POP P,B + POP P,A + POPJ P, + +] ;END IFN TNXSW + +SUBTTL COMMON Input Routines - Main File Open, EOF handling + +; Open main input file for reading (filespec in ISFB) + +OPNRD: +IFN ITSSW, .IOPDL ; Re-initialize IO pdl +IFN DECSW\TNXSW, CALL IOPDLC ; Non-ITS systems must simulate. + INSIRP SETZM,INFCNT INFCUR INFERR + MOVE A,[-TYPDLS-1,,TTYPDL] + MOVEM A,ITTYP ; Initialize "tty pdl" + PUSHJ P,MACIN1 ; Clobber macro expansion status + MOVE A,[ISFB,,INFB] ; Copy ISFB specs to INFB (which will hold + BLT A,INFB+L$FBLK-1 ; actual names of current input file) + MOVE A,ISFB+$FDEV ; Get device name + CAMN A,FSTTY ; TTY? + JRST [ MOVE A,[ISFB+$F6FN1,,IFNM1] ; TTY specified, treat special + BLT A,IFNM2 ; Clobber .IFNM1, .IFNM2 to specified + MOVE A,ISFB+$FVERS + MOVEM A,IFVRS + TYPECR "Reading from TTY:" + MOVEI A,3 ; => input from tty, don't quit on cr + JRST OPNRT2] + MOVEI F,INFB ; Point things at INFB. + PUSHJ P,OPNRD1 ; Try opening file + JRST [ PUSHJ P,IOPNER ; Open lost, type out message + POPJ P,] ; Read new command (this may screw on pass2?) + MOVEM A,INFERR ; Err msg in main file shouldn't type names. + MOVEI A,0 ; => input from file +IFN TNXSW,[ + MOVE T,INFB+$FJFN ; Copy actual jfn to avoid re-GTJFN + MOVEM T,ISFB+$FJFN +] +OPNRT2: MOVE T,[IFNM1,,RFNAM1] + BLT T,RFVERS ; Set up .FNAM1, .FNAM2 + SETOM NEDCRL + AOS (P) ; Won, skip on return. + JRST RCHSET ; Set up to read from file or tty. (arg in A) + + + ; Common stuff for OPNRD1 in all (DEC/ITS/TENEX) versions. +OPNRD3: HRRZM A,UTIBED ; Say buffer empty, + MOVSI A,EOFCH_13 + MOVEM A,@UTIBED ; Cause immediate reload. +OPNRD4: BLTM 2,$F6FN1(F),IFNM1 ; Set up .IFNM1, .IFNM2 from filblk F points at + MOVE A,$FVERS(F) + MOVEM A,IFVRS + AOS A,INFCNT ; Assign this file a number. + MOVEM A,INFCUR ; OPNRD expects this left in A. + JRST POPJ1 + + ; EOF while trying to read character + +RPAEOF: PUSH P,B ; Save B +RPAEO1: MOVE B,ITTYP ; Get pdl pointer + PUSHJ P,BPOPJ ; Call pop routine (maybe NED's out) + JRST RCHTRB ; Return to get character + + ; EOF from main file + +NEDCHK: TRNE FF,FRCMND ; ^C read in command, :KILL self. + JRST TSRETN + SKIPN RCHMOD + AOSE NEDCRL + JRST NEDCH1 + + ; Invent one crlf after end of main file. + MOVE B,[440700,,[.BYTE 7 ? ^M ? ^J ? EOFCH]] + MOVEM B,UREDP + HRRZM B,UTIBED +IFN PMAPSW,[ + HRLI B,170700 ; Make BP pointing at last (3rd) char + MOVEM B,UTIBPE ; Set EOF BP properly. +] + RET +NEDCH1: +IFN A1PSW,[ + PUSHJ P,OUTCHK + MOVSI A,-LNEDT + XCT NEDT(A) ; Skips if NED condition to be complained about + AOBJN A,.-1 + JUMPGE A,GO8 +] + ETF [ASCIZ /No END statement/] + +.SCALAR NEDCRL ; -1 => haven't yet supplied a CRLF at EOF of main file. + +IFN A1PSW,[ ; Holler "NED" if any of the following: +NEDT: SKIPL PRGC ; No end statements have been encountered + SKIPGE OUTC ; Output has occured not matched by an end statement + SKIPGE OUTN1 ; Output has occured other than in 1pass mode + TRNN FF,FRPSS2 ; Currently in pass 2 +LNEDT==.-NEDT ; Length of table +] + +SUBTTL ITS - Input file Open, buffer input +IFN ITSSW,[ + + ; Try .OPENing input file pointed to by F. Skips if successful. + ; Sets filenames to actual names. + +OPNRD1: SYSCAL OPEN,[[.BAI,,UTYIC] + $F6DEV(F) ? $F6FN1(F) ? $F6EXT(F) ? $F6DIR(F)] + JRST [ .STATUS UTYIC,IFSTS ; Lost, save status now before possible + POPJ P,] ; .IOPOP, and make failure return. + SYSCAL RFNAME,[%CLIMM,,UTYIC ; Now find true filenames. + MOVEM A + MOVEM C ; But need to check FN1, FN2 so + MOVEM D ; put them in ACs instead. + MOVEM $F6DIR(F)] + .LOSE %LSFIL + CAMN A,[SIXBIT/DSK/] + MOVE A,V.SITE ; Use machine name instead of DSK. + MOVEM A,$F6DEV(F) + CAIE C, ; If FN1 meaningless for device, skip to use + MOVEM C,$F6FN1(F) ; spec'd FN1 anyway, but else store actual FN1. + CAIE D, + MOVEM D,$F6FN2(F) ; Ditto for FN2. + MOVE D,[440600,,$F6FN2(F)] + SETZ A, +OPNRD7: TLNN D,770000 + JRST OPNRD6 + ILDB C,D ; Calculate version number as number from fn2. + CAIL C,'0 ; Ignore non-digits. + CAILE C,'9 + JRST OPNRD7 + IMULI A,10. + ADDI A,-'0(C) + JRST OPNRD7 + +OPNRD6: SKIPN A ; No digits in FN2 => use -1 as version. + SETO A, + MOVEM A,$FVERS(F) + MOVE A,IUREDP ; Set up reading ptr, + MOVEM A,UREDP + JRST OPNRD3 ; Set up ^C after buffer, infcur, etc. + + + ; EOFCH encountered on read, reload and jump back for next char + +INCHR3: HRRZ CH1,UREDP ; Get byte pointer + CAME CH1,UTIBED ; End of block? + RET ; No, ^C in file. + MOVE A,IUREDP + MOVEM A,UREDP + MOVE A,[-UTIBFL,,UTIBUF] + .IOT UTYIC,A ; Read in block + ANDI A,-1 + CAIN A,UTIBUF ; If the iot didn't give us anything, we are at EOF. + JRST RPAEOF + HRRZM A,UTIBED ; Store RH (updated pointer) for EOF check at INCHR3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ; Store a ^C after the data we read, so at EOB we come to INCHR3. + JRST RCHTRA ; Now try next char +] ;END IFN ITSSW + +SUBTTL DEC - Input file Open, buffer input + +IFN DECSW,[ + +OPNRD1: MOVEI C,UTIHDR ; Open the input file w/ names in dnam ... snam. + SETZ A, ; Mode ascii. + MOVEI D,UTIBUF + MOVE TT,UTICHN ; Get channel num. to use. + LSH TT,27 ; Put in ac field. + IOR TT,[OPEN A] + MOVE B,$F6DEV(F) + XCT TT ; Open channel,a + RET + CALL BUFINI ; Initialize the input buffers and header. + MOVE D,$F6DIR(F) + MOVE A,$F6FNM(F) + HLLZ B,$F6EXT(F) + TLC TT,(OPEN#LOOKUP) + XCT TT ; Lookup channel,a + RET ; Failed. +IFE SAILSW,[ + MOVE A,$F6DEV(F) + DEVNAM A, ; Get real name of device. + CAIA + MOVEM A,$F6DEV(F) +] + MOVE D,[440600,,$F6FN2(F)] + SETZ A, +OPNRD7: TLNN D,770000 + JRST OPNRD6 + ILDB C,D ; Calculate version number as number from fn2. + CAIL C,'0 ; Ignore non-digits. + CAILE C,'9 + JRST OPNRD7 + IMULI A,10. + ADDI A,-'0(C) + JRST OPNRD7 + +OPNRD6: SKIPN A ; No digits in FN2 => use -1 as version. + SETO A, + MOVEM A,$FVERS(F) + MOVE A,UREDP + JRST OPNRD3 + + + ; Reload buffer, DEC style. +INCHR3: HRRZ CH1,UREDP ; Is this ^C at end of buffer? + CAME CH1,UTIBED + RET ; No, ^C in file. + PUSH P,B + MOVE A,UTICHN + LSH A,27 ; Channel num. in ac fld. + TLO A,(IN) + XCT A ; Get next bufferfull. + CAIA ; Succeed. + JRST INCHR4 ; Error. +INCHR5: MOVE A,UTICNT + ADDI A,9 + IDIVI A,5 + ADD A,UREDP ; -> 1st wd not read into. + HRRZM A,UTIBED + HRRZ A,UREDP + AOS A + MOVEI B,1 ; Scan the file and replace all line numbers with nulls. +INCHR6: CAMN A,UTIBED + JRST INCHR7 + TDNE B,(A) + MOVEM B,(A) + AOJA A,INCHR6 + +INCHR7: MOVSI B,EOFCH_13 + MOVEM B,(A) ; Put EOF char after buffer, in extra word. + JRST RCHTRB ; Retry RCH. + +INCHR4: XOR A,[#IN] + XCT A + TRZE B,74^4 + ETR [ASCIZ /Input data error/] + XOR A,[#] + XCT A ; Clear error bits in status. + TRNN B,2^4 + JRST INCHR5 + JRST RPAEO1 ; EOF. + +; BUFINI - Create DEC-style buffer ring, with 1 extra word following +; each buffer... +; A/ +; B/ +; C/
+; D/ +; Note that this extra-word crock is necessary just so it can be filled +; with ^C's to stop read loop and switch to next buffer. + +BUFINI: MOVEI AA,A +IFE SAILSW,DEVSIZ AA, + SKIPA AA,[DECBFL+1] ; Default buffer size is that for dsk. + AOJLE AA,.-1 ; Get size including extra wd. + MOVEI T,1(D) ; Addr of wd 2 of 1st buffer. + HRLI AA,T ; @AA is addr of 2nd wd of next buffer. + SUBI D,(AA) ; Facilitate test for end of buffer space. + HRLI T,400000 + MOVEM T,(C) ; Header -> a buffer, sign set. + HRRM T,1(C) ; Make rh of bp -> buffer 1st wd. + MOVSI T,440000 ; Set up p-field of b.p. + IORM T,1(C) + HRRZ T,1(C) + AOS 1(C) + HRLI T,-3(AA) ; Data-area-size +1,,addr-of-2nd-wd +BUFIN1: CAIGE D,-UTIBFL(T) ; Room for another after this buffer? + JRST BUFIN2 ; No, wrap up. + MOVEM T,@AA ; Yes, make next buffer -> this one, + HRRI T,@AA ; Point to next one. + JRST BUFIN1 + +BUFIN2: ADDI D,1(AA) ; -> 2nd wd of 1st buffer. + MOVEM T,(D) ; 1st buffer -> last, making ring. + RET + +] ;END IFN DECSW, + +SUBTTL TNX - Input file Open, buffer input + +IFN TNXSW,[ + +; OPNRD1 - Open File for Reading. Old stuff assumed fnm in DNAM +; using UTYIC channel, but new should furnish arguments: +; F/ to open + +; Essentially just GTJFN and OPENF like OINIT does, with same +; sort of error handling, except that when reading from cmd line +; as opposed to .INSRT, just go back to get completely new command. +; (perhaps if typein is just CRLF, go to special TNX style cmd input?) + +OPNRD1: CAIN F,INFB ; Horrible kludge necessary because MIDAS main + ; level doesn't bother to explicitly close main + ; input file when pass 1 is done, and TNX barfs if + ; you try to re-open a JFN... sigh. + JRST [ SKIPN $FJFN(F) ; Main file. Already opened it? + JRST .+1 ; nope, get JFN & open normally. + IFE PMAPSW,[ ; Already open. If not mapping, reset read ptr. + SYSCAL SFPTR,[$FJFN(F) ? [0]][ERRCOD] + POPJ P,] + JRST OPNRD2] ; and avoid attempt to re-open the JFN. + SKIPN $FJFN(F) + JRST [ PUSHJ P,GETJFI ; No JFN, get one for input. + POPJ P, ; Could fail. + JRST .+1] + PUSH P,T ; Read access, full word input. + SYSCAL OPENF,[$FJFN(F) ? [440000,,OF%RD]][ERRCOD] + JRST [POP P,T ? POPJ P,] ; Failure + POP P,T +OPNRD2: HRRZ A,$FJFN(F) + MOVEM A,JFNCHS+UTYIC ; Indicate "channel" open with this JFN. + PUSHJ P,JFNSTB ; Get actual names/version #. + PUSHJ P,CVFSIX ; Put right stuff in $F6 entries. + MOVE A,IUREDP ; Opened, set up buffer. + MOVEM A,UREDP ; Initialize BP into buffer. +IFE PMAPSW, JRST OPNRD3 +IFN PMAPSW, JRST OPNR50 ; for PMAP hacking, lots of stuff to do. + + ; Get a JFN for current FILBLK (in F) and stick it into $FJFN(F). + ; A should hold flags in LH to use in 1st wd of block. + ; GETJFI - sets usual flags for input + ; GETJFO - sets " " output + ; GETJFN - takes whatever A holds. + +GETJFO: SKIPA A,[GJ%FOU+GJ%NEW] ; If hacking output, ask for new version. +GETJFI: MOVSI A,(GJ%OLD) ; If hacking input, file must exist. +GETJFN: PUSHJ P,TFMAP ; Stick filblk stuff into GTJFN scratch block. + PUSH P,R1 + PUSH P,R2 + MOVEI R1,GTJBLK + SETZ R2, + GTJFN + JRST [ MOVEM R1,ERRCOD ; failure, save error code. + JRST GETJF5] + HRRM R1,$FJFN(F) ; Win, save JFN. + AOS -2(P) +GETJF5: POP P,R2 ; Can't return in ACs cuz don't know what R1 etc are, + POP P,R1 ; and might clobber them here. + POPJ P, + +; TFMAP - Map Tenex filenames from filblk pointed to by F into +; standard scratch block for long-form GTJFN. +; A/ ,,0 ; flags will go into LH of .GJGEN. +; Clobbers only A. + +TFMAP: HRR A,$FVERS(F) ; Put version # in RH + SKIPE $FTEMP(F) ; If asking for temp file, + TLO A,(GJ%TMP) ; set appropriate flag. + MOVEM A,GTJBLK+.GJGEN +IRP FROM,,[$FDEV,$FDIR,$FNAME,$FTYPE,$FPROT,$FACCT,$FJFN]TO,,[.GJDEV,.GJDIR,.GJNAM,.GJEXT,.GJPRO,.GJACT,.GJJFN] + MOVE A,FROM(F) + MOVEM A,GTJBLK+TO +TERMIN + MOVE A,[.NULIO,,.NULIO] + MOVEM A,GTJBLK+.GJSRC ; Don't hack I/O in gtjfn. + POPJ P, + +.VECTOR GTJBLK(10.) ; Need exactly this many wds for non-extended long call + +IFE PMAPSW,[ + ; EOFCH seen in input, check it here. + +INCHR3: HRRZ CH1,UREDP ; Get byte pointer + CAME CH1,UTIBED ; End of block? + RET ; No, ^C in file. + MOVE A,IUREDP + MOVEM A,UREDP + PUSH P,T + SYSCAL SIN,[JFNCHS+UTYIC ? [444400,,UTIBUF] ? [-UTIBFL]][A ? A ? A] + POP P,T + ADDI A,UTIBUF+UTIBFL ; Get UTIBUF + <# bytes stored> + CAIG A,UTIBUF ; If the sin didn't give us anything, we are at eof. + JRST RPAEOF + HRRZM A,UTIBED ; Store rh (updated pointer) for eof check at inchr3 + MOVSI A,EOFCH_<18.-7> + MOVEM A,@UTIBED ; Store a ^c after the data we read + JRST RCHTRA ; Now try next character + +] ; IFE PMAPSW + +IFN PMAPSW,[ ; New stuff for PMAP'ing input etc. + +VBLK +IFNDEF NIBFPS,NIBFPS==10 ; # of pages per buffer +PGBFL==NIBFPS*1000 ; Length of a buffer in wds. +IFNDEF 1STBFP,1STBFP==500 ; # of first page to start buffers at. + +INBFPG: 1STBFP ; # of 1st buffer page (in our address space) +INFPAG: 0 ; # of page in file corresponding to 1st page in buffer. +INPGCT: 0 ; -# times to refill buffer with new pages. +INLPGS: 0 ; # pages to slurp on last refill (instead of NIBFPS) +UTIBPE: 0 ; BP to last byte of data in buffer (holding ^C) +UTIBPL: 0 ; BP to last byte position in buffer area (constant) +UTIBPX: 0 ; BP to last byte of data when last pages have been mapped. +INLCHR: 0 ; Place to save char that ^C replaces. If -1, no char. +;SOSSW: 0 ; non-Z if hacking SOS line-number type file. +FBBYV: 0 ; GTFDB dumps cruft in these two locs. +FBSIZ: 0 ; e.g. this gets size of file in bytes. +PBLK + + ; Wrap up open of an input file, by initializing all the cruft + ; above. +OPNR50: SYSCAL GTFDB,[$FJFN(F) ? [2,,.FBBYV] ? MOVEI FBBYV] + LDB C,[300600,,FBBYV] ; Get byte size of file + CAIN C, + MOVEI C,36. ; If 0 use 36-bit bytes (full wds) + MOVEI A,36. + IDIVI A,(C) ; Get bytes per wd, ignore remainder. + MOVE B,FBSIZ ; Now, with # bytes in file, + EXCH A,B + IDIVI A,(B) ; find <# in fil>/<# per wd> = # wds in file + CAIE B, ; Also hack + ADDI A,1 ; rounding up (gasp, wheeze, finally done.) + IDIVI A,PGBFL ; Now get # times buffer will need slurping... + ADDI A,1 ; And another for the final slurp (even if it will be empty) + MOVNM A,INPGCT ; Store -# slurps. + MOVEI A,777(B) + LSH A,-9. ; Find # pages last slurp really needs. + MOVEM A,INLPGS ; and store away. + HRLI B,010700 + MOVEM B,UTIBPX ; Store relative BP to last ch (when last pages mapped) + HRRI B,PGBFL ; And relative BP to last char in whole buffer + MOVEM B,UTIBPL ; Note UTIBPX and UTIBPL actually point to next wd + ; but this is fixed when abs addr is added in. + + MOVE A,INBFPG ; Find page # buffer starts at in core, + LSH A,9. ; Get address, and + SUBI A,1 ; Subtract one, to fix UTIBPX, UTIBPL, and IUREDP. + ADDM A,UTIBPX ; add into the BP's to make them absolute. + ADDM A,UTIBPL + HRLI A,010700 ; And use for initial read pointer - + ; MUST be "canonical form", so that SEMIC hackery + MOVEM A,IUREDP ; will work with weird way INCHR3 returns here. + MOVNI A,NIBFPS ; Use this as initial file page #, so the ADDB in + MOVEM A,INFPAG ; INCHR3 will do right thing to it. + MOVE A,[440700,,[EOFCH_35]] + MOVEM A,UREDP ; set up things so first RCH will instantly cause reload. + ILDB B,A + MOVEM A,UTIBPE + SETOM INLCHR ; Mustn't forget that we don't have a stored char yet. + JRST OPNRD4 ; Finally done with PMAP init stuff. + + ; Come here when hit ^C +INCHR3: MOVE CH1,UREDP ; Get current read ptr + CAME CH1,UTIBPE ; At end of buffer? + POPJ P, ; Nope, ^C in file, actual input. + AOSLE CH1,INPGCT ; Aha, end of buffer. Bump times refilled... + JRST INCH56 ; and if no more refills, go handle EOF. + MOVE A,IUREDP + MOVEM A,UREDP +IFN A-1,PUSH P,R1 +IFN A-2,PUSH P,R2 +IFN A-3,PUSH P,R3 + MOVEI R1,NIBFPS ; Get # of input buffer pages + ADDB R1,INFPAG ; and find current page in file to get + HRL R1,$FJFN+INFB ; current input file's JFN + MOVE R2,INBFPG ; and usual pointer to destination buffer page + HRLI R2,.FHSLF ; Why the fuck doesn't 10X default this?!?! + MOVEI R3,NIBFPS ; Set # pages to slurp up + JUMPN CH1,INCH51 ; But if this is last slurp, + SKIPG R3,INLPGS ; Use pre-calculated # to avoid non-ex pages. + JRST INCH55 ; No pages in last slurp! Avoid new PMAP. + +INCH51: TLO R3,(PM%CNT+PM%RD+PM%CPY) ; Read access, copy-on-write. +INCH52: PMAP ; Gobble gobble + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI R3,-1(R3) ; Else, on 10X, must iterate manually. + TRNE R3,400000 ; See if became "negative". + JRST INCH53 ; Yep, done with manual iteration. + ADDI R2,1 ; Nope, bump page #'s. + AOJA R1,INCH52] +INCH53: +IFN A-3,POP P,R3 +IFN A-2,POP P,R2 +IFN A-1,POP P,R1 + CAIE CH1, ; Was this the last slurp? + SKIPA CH1,UTIBPL ; no, use BP to Last char at end of buffer. + MOVE CH1,UTIBPX ; yes, need BP to last char in last page. +IFN 0,[ SKIPE SOSSW ; If hacking line number lossage, + JRST [ MOVE A,(CH1) ; must beware of getting wiped, so have to + TRNE A,1 ; check here, and if depositing EOFCH in #, + HRLI CH1,350700 ; then move the EOFCH to beg of word! + JRST .+1] +] + LDB A,CH1 ; Replace last char of buffer's data + MOVEI CH2,EOFCH + DPB CH2,CH1 ; with the EOF char. + MOVEM CH1,UTIBPE ; Remember ptr to end of data, + EXCH A,INLCHR ; and save char for then, returning whatever + JUMPL A,RCHTRA ; was the last char of last bufferfull. + ; (may be -1, in which case RCHTRA tries again) + + ; Jump here to return a new char in A, something like + ; RCHTRA without all the fuss. +INCHR7: POP P,CH1 ; Get return addr + ANDI CH1,-1 + CAIE CH1,RREOF+1 + JRST -2(CH1) ; Note -2 not -3 as in RCHTRA! + JRST (CH1) ; Special hack since -2 loses for RREOF. + ; Perhaps someday it will win. + +INCH55: ; Here when doing last slurp and no pages to slurp. +IFN A-3,POP P,R3 +IFN A-2,POP P,R2 +IFN A-1,POP P,R1 +INCH56: SKIPGE A,INLCHR ; No more refills, see if last char left + JRST RPAEOF ; No? All done, true EOF. + SETOM INLCHR ; Almost, one last char. + MOVE CH1,UREDP ; Must bump ptr back one char, so next read + ADD CH1,[070000,,] ; will also stop. + CAIG CH1, + SUB CH1,[430000,,1] + MOVEM CH1,UREDP + JRST INCHR7 ; Return very last char in A. + +] ; IFN PMAPSW + +] ;END IFN TNXSW + +ifn 0,[ ; turn off but keep around for a while. +SUBTTL old .INSRT Processing + +; .INSRT ; Insert file here +; TTY: => ok, reads line at a time, rubout allowed within line +; Pushes macro expansion, other .INSRT's +; In filedescription, ^R => reset file name counter [?!? - KLH] +; If device is "@:", always ask for translation. + +A.INSR: NOVAL + MOVE A,[ISFB,,FB] ; Default names are those of spec'd input file + BLT A,FB+L$FBLK-1 ; Zap them into scratch filblk. + MOVEI F,FB ; And point at it. + MOVE A,FSDSK + MOVE B,FSTTY ; Compare "TTY" with + CAMN B,$FDEV(F) ; device name, and if identical, + MOVEM A,$FDEV(F) ; default to DSK. +IFE ITSSW,MOVE A,FSMID ; Always set default extension to "MID" or ">" +IFN ITSSW,MOVE A,FSGRTN + MOVEM A,$FEXT(F) + + TLO FF,FLUNRD +A.IN1: PUSHJ P,RFD ; Read file description + MOVE A,$FDEV(F) ; Get specified device name + CAME A,FSATSN ; Atsign? + PUSHJ P,A.ITRY ; No, try opening file + + ; If return, open failed. + MOVE A,$F6DEV(F) + AOJE A,A.INT1 ; Already trying to set up table entry + SKIPA F,[MAXIND,,TBLOFS] ; Atsign, or fnf, search table + +A.IN2: SUBI F,-L$FBLK ; Loop point searching table, increment to next entry, count down LH + CAMN F,INDDP ; Compare with pointer to top of table + JRST A.IN3 ; Agree => this file not in table + +; MOVEI A,-TBLOFS(F) ; Get index relative to table base. +; MIDAS complains "illegal use of relocation" when try to use above addr, so must use next 2 instructions instead - barf barf + MOVEI A,(F) + SUBI A,TBLOFS + + MOVSI B,-L$FBLK ; And index into FB. + MOVE T,TBLSFS(A) ; Get specification name this entry +A.IN25: CAMN T,FB(B) ; Compare with that just specified + AOBJN B,[AOJA A,.-2] ; Check all names this entry +IFE TNXSW, JUMPL B,A.IN2 +IFN TNXSW,[JUMPL B,[ MOVEI C,(B) + CAIN C,$FJFN ; One item of entry didn7t match, was it JFN? + JRST A.IN25 ; Yes, ignore it and continue. + JRST A.IN2] ; Sigh, was something else, entry doesn't match. + ] + + ; File is in table + MOVSI A,(F) ; Move description from TBLOFS to FB. + HRRI A,FB + BLT A,FB+L$FBLK-1 +IFN TNXSW, SETZM FB+$FJFN ; Since re-opening, must zap previous JFN. + PUSHJ P,A.ITRY ; Try opening file + + ; If return, open failed. + MOVSI A,TBLSFS-TBLOFS(F) ; Set up LH(BLT pointer), + HRRI A,FB + BLT A,FB+L$FBLK-1 ; Unmap to original names(TBLSFS to FB) + PUSHJ P,TYPFB ; Type out specified names + TYPE " -> " ; Type out pointer + MOVSI A,(F) ; Copy translation (TBLOFS entry) back to FB. + HRRI A,FB + BLT A,FB+L$FBLK-1 + SETOM $F6DEV(F) ; "half-kill" entry in TBLOFS + +A.INT1: PUSH P,F + MOVEI F,FB + PUSHJ P,IOPNER ; Open lost, type out cruft + POP P,F + TYPE "Use what filename instead? " +A.INT2: PUSHJ P,GTYIP ; Prepare to read one line from tty + JRST A.IN1 ; Try again with what he types in + + ; File not in table, try to add a translation for it. + +A.IN3: TLNN F,-1 ; More room for another entry in table? + ETF [ASCIZ /Too many @: files/] + MOVEI A,TBLSFS-TBLOFS(F) ; Copy FB into TBLSFS (specified name) + HRLI A,FB + BLT A,TBLSFS-TBLOFS+L$FBLK-1(F) + SETOM $F6DEV(F) ; Document fact that entry has only key, not translation + MOVNI A,-L$FBLK + ADDM A,INDDP ; Update pointer into table + MOVE A,FB+$FDEV ; Get specified device name + CAME A,FSATSN ; Atsign? + JRST A.INT1 ; No, type out garbage and try again, reading from tty + MOVE A,ISFB+$FDEV ; Yes, clobber from input device name + MOVEM A,FB+$FDEV + JRST A.INT2 + +;TRY OPENING INPUT FILE FOR .INSRT, RETURN IF UNSUCCESSFUL + +A.ITRY: MOVE A,FB+$FDEV ; Get specified device name + CAMN A,FSTTY ; TTY? + JRST A.ITRT ; Yes, treat special + TLO FF,FLUNRD + PUSHJ P,IPUSH ; Save current status + PUSH P,F ; save what F points at + MOVEI F,FB + PUSHJ P,OPNRD1 + JRST [POP P,F ? JRST IPOPL] ; Lose, pop and return + POP P,F + MOVE B,[FB,,INFB] ; Kludge for time being - if win, + BLT B,INFB+L$FBLK-1 ; Copy all stuff into INFB. +IFN ITSSW,CALL SETWH2 + MOVE B,ITTYP + MOVEI A,-2-TYPDEL(B) ; + HRLI A,IFNM1 + BLT A,-TYPDEL(B) ; Introduce hysteresis so .INSRT'ing file can reference .IFNM1, .IFNM2 +IFN CREFSW,[ + SKIPE CRFONP ; If creffing, output push-file block. + PUSHJ P,CRFPSH ; (pop-file block output at ipop) +] +A.ITR2: + MOVE A,$F6DEV(F) ; Push successful, now check to see if table entry should be finished + AOJN A,ASSEM1 + MOVEI A,(F) ; Move FB into TBLOFS as translation entry. + HRLI A,FB + BLT A,L$FBLK-1(F) + JRST ASSEM1 ; Now assemble from file (ASSEM1 clobbers pdl) + + ; .INSRT TTY: + +A.ITRT: PUSHJ P,GTYIPA ; Read from tty, don't quit until .INEOF + JRST A.ITR2 ; Fall back in (doesn't touch .IFNM1, .IFNM2) +] ; end IFN 0 + +SUBTTL .INSRT Processing + +; .INSRT ; Insert file here +; TTY: => ok, reads line at a time, rubout allowed within line +; Pushes macro expansion, other .INSRT's +; If device is "@:", always ask for translation. + +A.INSR: NOVAL + + ; First set up defaults for parsing filename. + BLTM L$FBLK,ISFB,FB ; Default names are those of spec'd input file, + MOVEI F,FB ; stuffed into scratch FB. + MOVE A,FSDSK + MOVE B,FSTTY ; Compare "TTY" with + CAMN B,$FDEV(F) ; device name, and if identical, + MOVEM A,$FDEV(F) ; default to DSK. +IFE ITSSW,MOVE A,FSMID ; Always set default extension to "MID" or ">" +IFN ITSSW,MOVE A,FSGRTN + MOVEM A,$FEXT(F) + + TLO FF,FLUNRD + PUSHJ P,RFD ; Read file description from current input. + MOVE A,$FDEV(F) ; Get specified device name + CAMN A,FSATSN ; Atsign? + JRST A.IN50 ; If so, check out translation right away. + +A.IN2: CAMN A,FSTTY ; TTY? Must handle specially. + JRST [ PUSHJ P,GTYIPA ; Set up to read until .INEOF or EOF char. + JRST ASSEM1] ; And don't do anything to .IFNM1/2, etc. + PUSHJ P,IPUSH ; File, push the world. + PUSHJ P,OPNRD1 ; Try opening file. + JRST [ PUSHJ P,IPOPL ; Sigh, failed, pop world back and go + JRST A.IN50] ; try translation entries or TTY input. + ; Always jumps back to A.IN2. + + ; Come here when input file successfully opened. Clean up etc. + BLTM L$FBLK,(F),INFB ; Move current filespec to INFB, +IFN ITSSW,CALL SETWH2 + MOVE B,ITTYP + BLTM 3,IFNM1,-2-TYPDEL(B) ; Copy new .IFNM1, .IFNM2 onto stack, + ; to clobber .IFNM1/2 for previous file, so + ; that .IFNM1/2 etc refers to last file .INSRT'd by + ; current file (or current file if none .INSRT'd yet) +IFN CREFSW,[ + SKIPE CRFONP ; If creffing, output a push-file block. + PUSHJ P,CRFPSH ; (pop-file block is output at IPOP) + ] + + JRST ASSEM1 ; and jump off to smash things to toplevel. + + ; Come here when open attempt fails or @: device specified. +A.IN50: CAIE F,FB ; Tried translations yet? + JRST A.IN60 ; Yes, skip table hacking and go get fnm from TTY. + + ; First open attempt, so OK to search translation table. + SKIPA D,[MAXIND,,TBLOFS] ; Load up aobjn-style index to transl table +A.IN52: SUBI D,-L$FBLK ; Loop point for searching table - increment to next entry, count down LH + CAMN D,INDDP ; Compare with pointer to top of table + JRST A.IN60 ; Agree => this file not in table, get from TTY. + + MOVEI A,(D) ; Get scratch index into tables, + HRLI A,-L$FBLK ; making AOBJN of it, + MOVEI B,(F) ; and get index into current FB. +A.IN54: MOVE C,TBLSFS-TBLOFS(A) ; Get a specification name for this entry +IFN TNXSW,CAIE B,$FJFN(F) ; (ignoring the JFN item, for TENEX) + CAMN C,(B) ; Compare name with that of failed filblk. + AOBJN A,[AOJA B,A.IN54] ; Check all names this entry + JUMPL A,A.IN52 ; If not found, try next entry. + + ; File is in table, try opening it using TBLOFS description. + MOVE F,D ; Replace old F by ptr to winning TBLOFS entry. +IFN TNXSW, SETZM $FJFN(F) ; Since re-opening, must zap any previous JFN. + JRST A.IN2 ; Jump off to try opening. + + ; Come here when open failed and no matching transl entry. + ; Must set up to gobble down a translation from TTY... +A.IN60: TYPE "Error in .INSRT; " + CAIE F,FB ; Were we trying to open a translated entry? + JRST [ PUSHJ P,TYPFB ; Yes, so print out appropriate info + TYPE " -> " ; to show translated stuff. + JRST A.IN70] + + ; First time, no translation entry exists, make one. + MOVE A,INDDP ; Get current pointer to top of tables + TLNN A,-1 ; Room for more? + JRST A.IN70 ; Nope, can't remember transl, but get right fnm anyway. + MOVE F,A ; Yep, use it as pointer to table entry to use. + SUBI A,-L$FBLK ; and get new table-top pointer with clever + MOVEM A,INDDP ; SOS of LH and ADDI to RH. + BLTM L$FBLK,FB,(F) ; Move FB contents to both TBLOFS, + BLTM L$FBLK,FB,TBLSFS-TBLOFS(F) ; and TBLSFS. + +A.IN70: ; Print out filename F points to, & err msg. +IFN TNXSW,[ + PUSHJ P,OPNER1 + PUSHJ P,RDJFNI ; On 10X, get new filename this way. + ] +IFN ITSSW\DECSW,[ ; Elsewhere do it painful way. + PUSHJ P,IOPNER + TYPE "Use what filename instead? " + PUSHJ P,GTYIP ; Setup to read 1 line from TTY, + PUSHJ P,RFD ; and do it, parsing filename. +] + JRST A.IN2 ; now go try opening it. + +SUBTTL Misc. .INSRT-related things + + ; .INEOF - EOF pseudo + +A.IEF2: PUSHJ P,PMACP ; Loop point, pop entry off macro pdl +A.INEO: TLNE FF,FLMAC ; Inputting from macro? + JRST A.IEF2 ; Yes, pop it off + PUSH P,CMACCR ; Back to inputting from file or tty, cause return to maccr + MOVE B,ITTYP ; Get pdl pointer + POPJ B, ; Return to pop routine + + + ; Call from ERRH; type input file's names if changed since last err msg. +ERRTFL: MOVE C,INFCUR + EXCH C,INFERR ; Say last error msg in this file. + CAMN C,INFERR ; If prev. msg was in other file, + POPJ P, + PUSH P,F + MOVEI F,INFB ; Point to current input file, + PUSHJ P,TYPFB ; and type out its filename. + POP P,F + PJRST CRRERR + +SUBTTL COMMON IO PDL routines for input. (.INSRT support) + +;IO PDL ROUTINES FOR INPUT FILE +; Push the input file + +IPUSH: AOSN CMEOF ; Want to pop out of tty? (^C typed in) + CALL POPTT ; Yes, do now before forget. + +IFE PMAPSW,[ + MOVE D,UREDP ; Get input byte pointer +IFN ITSSW\TNXSW,[ +IFN ITSSW, .IOPUS UTYIC, +IFN TNXSW, MOVEI A,UTYIC ? PUSHJ P,$IOPUSH + TLNN D,760000 ; At end of word? + ADD D,[430000,,1] ; Yes, make it point to beginning of next word + MOVEM D,UREDP + MOVNI A,-2(D) + ADD A,UTIBED ; Get # wds we'll need in MACTAB. + HLR D,UTIBED ; Remember whether EOF on last .IOT. + HRRZS UTIBED ; Now clear out left half for following +] +IFN DECSW,[ + AOS A,UTICHN ; Do ".IOPUSH" - use next channel. + LSH A,27 + ADD A,[WAIT-<0 1,>] ; Construct a WAIT uuo for the current input channel. + MOVE C,RCHMOD ; We mustn't copy the buffers while I/O is going on. + CAMN A,[WAIT UTYIC,] ; But: if we are currently in the top-level input file + CAIE C,3 ; And it is device TTY:, this channel was never opened. + XCT A ; Don't move buffers while io going on! + MOVEI A,UTIBFL+2 ; Assume must save all buffer space. +] + PUSH P,A + ADD A,FREPTB + ANDI A,-1 + PUSH P,A + CAML A,MACTND ; No room in MACTAB => gc it. + CALL GCA1 + REST A + CAML A,MACTND ; Did the GC win? + PUSHJ P,GCCORQ ; NO!! Try to win somehow + MOVEI A,370 + CALL PUTREL ; Indicate start of saved buffer. + REST A + AOS B,FREPTB + SUBI A,1 + MOVE C,ITTYP ; Get addr of tty pdl wd that'll point to saved buffer. + ADDI C,1 + HRRZM C,(B) ; Store in rh of 1st wd, + MOVEI C,(B) ; Remember addr of saved buffer to push on ttypdl. + HRLM A,(B) ; Put length in lh. + AOS B +IFN ITSSW\TNXSW,HRL B,UREDP ; LH <- addr of 1st wd to save. +IFN DECSW,HRLI B,UTIBUF + ADDI A,-2(B) ; Addr of last wd to blt into. + BLT B,(A) + HRLI A,041000 + MOVEM A,FREPTB ; Make free bp -> last byte just used. + SUB A,MACTAD + ANDI A,-1 + LSH A,2 + ADDI A,4 ; Get char addr of next free byte. + MOVEM A,FREEPT +] +IFN PMAPSW, CALL IOBPUS + + MOVE B,ITTYP ; Get local version of iopdl +IPSHP: +IFE PMAPSW, PUSH B,C ; Push -> saved buffer (GC will relocate) +IFN DECSW,PUSH B,UTIBED ? PUSH B,UTIHDR +REPEAT L$FBLK, PUSH B,INFB+.RPCNT ; Save names of input file. + PUSH B,INFCUR ; Save number of input file. +IFE PMAPSW, PUSH B,D ; Lh=lh(old uredp), rh=lh(old utibed) (or just UREDP) +IFN PMAPSW, INSIRP PUSH B,[INFPAG INPGCT INLPGS UTIBPE UTIBPL UTIBPX INLCHR UREDP IUREDP ] + + ; Following three must be last pushed + INSIRP PUSH B,[IFNM1 IFNM2 IFVRS] ; Clobbered on pdl if .open successful +INPDEL==.-IPSHP ; Length of each entry on pdl + + MOVE A,FREEPT ; W must use same gc convention as putrel; + CAML A,MACHI ; Namely, gc after using up the last byte. + CALL GCA1 + MOVEI A,0 ; => input from file + MOVEM B,ITTYP ; Store back updated pointer + JSP B,PUSHTT ; Save stuff, address modify and return + + + ; Pop into the input file +IPOP: +IFN CREFSW,[ MOVEI A,2 ; If creffing, output pop-file block. + SKIPE CRFONP + PUSHJ P,CRFOUT] +IPOPL: PUSHJ P,POPTT ; Come here if .INSRT's open failed. + PUSH P,C + MOVE B,ITTYP ; Get pointer + INSIRP POP B,[IFVRS IFNM2 IFNM1] ; Pop stuff +IFE PMAPSW, POP B,A ; Pop off UREDP (or halves thereof) +IFN PMAPSW, INSIRP POP B,[ IUREDP UREDP INLCHR UTIBPX UTIBPL UTIBPE INLPGS INPGCT INFPAG] + POP B,INFCUR +REPEAT L$FBLK,POP B,INFB+L$FBLK-1-.RPCNT +IFN DECSW,[ + POP B,C + PUSH P,C ; Old UTIHDR + POP B,UTIBED +] +IFE PMAPSW, POP B,C + MOVEM B,ITTYP ; Save updated pdl pointer. +IFE PMAPSW,[ + HLRZ B,(C) ; Get length of saved buffer, +IFN ITSSW\TNXSW,[ + PUSH P,A +IFN ITSSW, CALL SETWH2 ? .IOPOP UTYIC, +IFN TNXSW, MOVEI A,UTYIC ? CALL $IOPOP + REST A + MOVEI AA,UTIBUF-1(B) ; Get addr of 1st wd won't blt into in utibuf, + HRLI AA,(A) ; Get saved lh of utibed, + MOVEM AA,UTIBED + HRRI A,UTIBUF ; Make A -> 1st wd in buffer, +] +IFN DECSW,[ + MOVE AA,UTICHN + LSH AA,27 + IOR AA,[RELEAS] + XCT AA ; This code equivalent to .IOPOP. + SOS UTICHN + REST UTIHDR +] + MOVEM A,UREDP + MOVSI A,EOFCH_13 + MOVEM A,@UTIBED ; Put EOF char after buffer. + MOVSI A,1(C) ; Get addr of 1st data wd of saved buffer, + HRRI A,UTIBUF + CAIE B,1 + BLT A,UTIBUF-2(B) + HLLZS (C) ; Tell GC to reclaim saved buffer. +] ;IFE PMAPSW + +IFN PMAPSW, CALL IOBPOP + +POPCJ: REST C + RET + +;SAVE INTERNAL POINTERS CONCERNING INPUT MODE + +TYPDEL==2 ; Number of words in relevant pdl entry + +PUSHTT: PUSH P,A + PUSH P,F + AOSN CMEOF ; If supposed to pop out of tty soon, + CALL POPTT ; Do it now before cmeof clobbered. + MOVE F,ITTYP ; Get relevant pdl pointer + MOVEI A,0 + EXCH A,CLNN ; Set up new line number + HRL A,CPGN ; Save current page number + SETZM CPGN ; Now re-initialize + SKIPGE CRFILE ; Save cref-all-on-one-line flag. + TLO A,400000 + PUSH F,A ; Save cpgn,,clnn + MOVE A,-1(P) ; Retrieve new mode + PUSHJ P,PSHLMB ; Save limbo1 and set up instructions for new mode +IFN ITSSW,[ + CALL SETWH2 + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ; Store back updated pointer + JRST POPFAJ + + ; Restore internal pointers concerning input mode + +POPTT: PUSH P,A + PUSH P,F + MOVE F,ITTYP ; Get pdl pointer + PUSHJ P,POPLMB ; Pop into limbo1, set up new mode + POP F,A ; Get cpgn,,clnn + SETZM CRFILE ; Restore all-on-one-line flag. + TLZE A,400000 + SETOM CRFILE + HLRZM A,CPGN + HRRZM A,CLNN +IFN ITSSW,[ + CALL SETWH2 + ADD A,CPGN + .SUSET [.SWHO3,,A] +] + MOVEM F,ITTYP ; Store back updated pointer + JRST POPFAJ + +IFN ITSSW,[ +SETWH2: MOVE A,RCHMOD + CAIL A,2 + SKIPA A,[SIXBIT /TTY:/] + MOVE A,INFB+$F6FN1 + .SUSET [.SWHO2,,A] + MOVE A,A.PASS + LSH A,30 + ADD A,[SIXBIT /P0/+1] + RET +] + +SUBTTL Storage for IO PDL stuff + + ; IO PDL storage stuff + +VBLK +TYPDLS==TYPDLC*TYPDEL+INPDEL*MX.INS + ; "tty pdl", stores information about current input mode + ; (similar to macro pdl but not garbage collected) + +ITTYP: -TYPDLS-1,,TTYPDL ; Pdl pointer (typdel=length of each entry) +TTYPDL: NEDCHK ; Actual pdl: initial entry to overpop routine + BLOCK TYPDLS ; Pdl proper +PBLK + +SUBTTL TNX - IO PDL Routines (IOPDLC, $IOPUSH, $IOPOP) + +IFN TNXSW,[ + +IFN PMAPSW,[ + ; Push IO buffer & channel... +IOBPUS: PUSH P,A + MOVEI A,UTYIC + CALL $IOPUSH + MOVEI A,NIBFPS ; Point at next set of buffer pages. + ADDM A,INBFPG + POP P,A + POPJ P, + + ; Pop IO buffer & channel... +IOBPOP: PUSH P,A + MOVE A,INBFPG + HRLI A,NIBFPS + CALL DELPGS ; flush buffer pages. + MOVNI A,NIBFPS + ADDM A,INBFPG ; point down at previous set of buffer pages... + MOVEI A,UTYIC + CALL $IOPOP + POP P,A + POPJ P, + +; DELPGS - Take arg in A as <# pgs>,, and flush these pages. + +DELPGS: PUSH P,A + PUSH P,B + HLRZ B,A + HRLI A,.FHSLF ; ,, + TLO B,(PM%CNT) + PUSH P,T +DELPG2: SYSCAL PMAP,[[-1] ? A ? B][A ? A ? B] ; Free up buffer pages. + TLNN FF,FL20X ; If on 20X, that's all. + JRST [ HRRI B,-1(B) ; Else, on 10X, must iterate manually. + TRNE B,400000 ; See if became "negative". + JRST .+1 ; Yep, done with manual iteration. + AOJA A,DELPG2] ; Nope, bump page #'s. + POP P,T + POP P,B + POP P,A + POPJ P, +] ;IFN PMAPSW + +; IOPDLC - Clear IOPDL stack, close all channels on it. +; Clobbers no ACs + +; for 10x, need to CLOSF and release each JFN on IOPDL stack. + +IOPDLC: PUSH P,R1 +IFE R1-A,.ERR IOPDLC WONT WORK WITH A=1 +IFN PMAPSW,[ + MOVEI R1,1STBFP ; Reset to point at 1st page of buffer space. + MOVEM R1,INBFPG +] + EXCH A,IOPDLP + JRST IOPDC3 +IOPDC2: MOVE R1,(A) + CAME R1,ISFB+$FJFN ; Dont close main input file + CLOSF + JFCL + SUB A,[1,,1] +IOPDC3: CAMLE A,[-LIOPDL,,$IOPDL-1] + JRST IOPDC2 + EXCH A,IOPDLP + POP P,R1 + POPJ P, + +; $IOPUSH - Push I/O channel in A onto $IOPDL stack. +; Clobbers no ACs +; for 10X this means storing JFN on stack and clearing JFNCHS table entry. + +$IOPUSH:EXCH B,IOPDLP ; Get stack pointer + PUSH B,JFNCHS(A) ; save JFN for channel + EXCH B,IOPDLP + SETZM JFNCHS(A) ; Zap entry in channel table to make it look gone + POPJ P, + +; $IOPOP - Pops channel off $IOPDL into channel # in A. +; Clobbers no ACs + +; for 10X just pop $IOPDL into JFNCHS, must close and release old JFN tho. + +$IOPOP: PUSH P,T + SYSCAL CLOSF,[JFNCHS(A)] + JFCL + POP P,T + EXCH B,IOPDLP ; Get stack ptr + POP B,JFNCHS(A) + EXCH B,IOPDLP + POPJ P, + +VBLK +JFNCHS: BLOCK 20 ; Channel table index, JFNCHS(ch) gets JFN for chan. + ; (zero if none) +LIOPDL==8. ; Length of IO PDL +IOPDLP: -LIOPDL,,$IOPDL-1 +$IOPDL: BLOCK LIOPDL +PBLK +] ; IFN TNXSW + +SUBTTL DEC - IO PDL Routines (IOPDLC) + +IFN DECSW,[ + +; IOPDLC - Simulate ITS .IOPDL call. Flushes all channels from +; UTICHN downwards to UTYIC. Actually not a simulation but something +; that works in the particular situation for which MIDAS uses .IOPDL. + +IOPDLC: MOVEI A,UTYIC + EXCH A,UTICHN ; Set input chnl num. to lowest. + LSH A,27 + IOR A,[RELEAS] ; Set up to releas the highest in use first. +IOPDL1: XCT A ; Releas one input channel, + CAMN A,[RELEAS UTYIC,] + RET ; All done. + SUB A,[0 1,] + JRST IOPDL1 ; Releas the next one down. +] ;IFN DECSW + +SUBTTL COMMON TTY input routines & variables + +VBLK +CMBUF: BLOCK CMBFL ; Typein buffer (also used as JCL buffer) +CMPTR: 0 ; Byte pointer to CMBUF. +CMEOF: 0 ; -1 => POPTT instead of reloading after this bufferfull. +TTYOPF: 0 ; -1 => the TTY is already open. +LINEL: 0 ; Width of TTY (may be 1,, meaning assume infinite). +A.TTYFLG: ; Value of .TTYFLG pseudo - another label for TTYFLG. +TTYFLG: 0 ; TTY typeout permitted iff >= 0. +WSWCNT: 0 ; The number of W-switches in the last cmd string. +TTYBRF: 0 ; -1 => ^H break has been requested but not yet done. +PBLK + ; Cause input from tty (main routines) + +GTYIPA: SETZM A.TTYF ; Push to tty, don't stop at cr. + +IFN ITSSW, TYPECR "TTY: .INSRTed, end input with ^C" +IFN DECSW\TNXSW,[ + IFE SAILSW,TYPECR "TTY: .INSRTed, end input with ^Z" + IFN SAILSW,TYPECR "TTY: .INSRTed, end input with CTL-META-LF" + ] + +GTYIP1: SKIPA A,[3] +GTYIP: MOVEI A,2 ; Input from tty, stop after 1 line. + SETZM CMPTR ; Force reload on 1st read. + JSP B,PUSHTT ; Set up variables and return +GTYIPR: SETZM CMPTR ; Return on .ineof or cr + JRST POPTT + + ; Call here from ASSEM1 loop when a ^H interrupt is detected. +TTYBRK: SETZM A.TTYF + ETR [ASCIZ/^H - break /] ; Type filename, page and line #. + SKIPE ASMOUT + TYPECR "within a <>, () or []" + JRST GTYIPA + + ; RCHSET routines for reading from TTY + ; RCHMOD=3 => don't quit on CR + ; 2 => quit on CR. +RCHTRC: +RCHARC: TLO FF,FLTTY ; Set flag + JSP A,CPOPJ +RCHAC1: REPEAT 2,[ ; RCH2, RR1 + ILDB A,CMPTR ; Get char + CAIN A,0 ; End of string marked with 0 + PUSHJ P,TYRLDR ; Reload, jump back for next char +] + GOHALT ; RRL1 +IFN .-RCHAC1-RCHPSN,.ERR RCHAC1 LOSES. + ILDB A,CMPTR ; SEMIC + CAIN A,15 + JRST SEMICR + JUMPN A,SEMIC + PUSHJ P,TYRLD + JRST SEMIC + +TYRLD: MOVEI A,3 ; Return after the call, not before. + ADDM A,(P) + + ; TYRLDR - Read in string. + ; Reload buffer if ran out in call to RCH. + +TYRLDR: AOSN CMEOF ; EOF detected after last reload => + JRST RPAEOF ; Pop out of tty. + PUSH P,A + PUSH P,B + MOVE B,RCHMOD + PUSH P,F + PUSH P,A.TTYF ; If chars rubbed out they should be printed. + SETZM A.TTYF +IFN TNXSW,SYSCAL DTI,[[.TICCV]] ; Disable ^V as an interrupt character + MOVE F,[10700,,CMBUF-1] ; Initial byte pointer to buffer + MOVEM F,CMPTR ; Store as byte pointer for read +TYRLD2: PUSHJ P,TYI ; Get character +IFN TNXSW,[ + CAMN F,CMPTR ; at beg of line? + CAIE A,^J ; and char is LF? + CAIA + JRST TYRLD2 ; If so then ignore it completely. +] + CAIN A,177 ; Rubout? + JRST TYRLD3 ; Yes + CAIE A,^C + CAIN A,^Z + JRST TYRLD7 ; ^C, ^Z => EOF. Ought to be EOFCH for consistency? + CAIN A,^U + JRST TYRLD5 ; Rub out all + CAIE B,2 ; For .TTYMAC handling, convert lower case to upper. + JRST TYRLD6 + CAIL A,"A+40 + CAILE A,"Z+40 + CAIA + SUBI A,40 +TYRLD6: CAME F,[010700,,CMBUF+CMBFL-2] + IDPB A,F ; Store character in buffer unless buffer nearly full. + CAIE A,^M ; CR? + JRST TYRLD2 ; No, go back for next + CAIN B,2 ; .TTYMAC (mode 2) => CR ends input, so fake EOF. + SETOM CMEOF + MOVEI A,^J ; Follow the CR with a LF. + IDPB A,F + PUSH P,F ; Output the entire line to the error file + MOVE F,[10700,,CMBUF-1] +TYRLD8: CAMN F,(P) + JRST TYRLD9 + ILDB A,F + CAIN A,^M ; If line was ended by a ^C or ^Z, put that in error + SKIPL CMEOF ; file, which needs hair since that char is not + JRST TYRLD0 ; In the string we stored. + MOVEI A,"^ + CALL ERRCHR +IFN ITSSW,MOVEI A,"C +IFN DECSW\TNXSW,MOVEI A,"Z + CALL ERRCHR + LDB A,F +TYRLD0: CALL ERRCHR + JRST TYRLD8 + +TYRLD9: REST F + MOVEI A,0 + IDPB A,F ; Mark end of string + IDPB A,F +IFN TNXSW,SYSCAL ATI,[[.TICCV,,.IC.CV]] ; Turn back on ^V + REST A.TTYF + REST F + REST B + REST A + JRST RCHTRA + +TYRLD7: SETOM CMEOF ; ^C, ^Z force EOF, + CALL TYRLCR ; After turning into ^M. + MOVEI A,^M + JRST TYRLD6 + +TYRLCR: MOVEI A,^M + CALL TYOX + MOVEI A,^J + JRST TYOX + +TYRLD3: CAMN F,[10700,,CMBUF-1] ; Rubout, beginning of buffer? + JRST TYRLD4 ; Yes + LDB A,F ; Get last character in buffer + CALL TYOX ; Type it out, don't write in error file. + ADD F,[70000,,] ; Decrement pointer + JUMPGE F,TYRLD2 ; Jump if valid + SUB F,[430000,,1] ; Was 440700,,something, back it up + JRST TYRLD2 + +TYRLD5: MOVE F,[10700,,CMBUF-1] ; ^U, back to beginning of line +TYRLD4: PUSHJ P,TYRLCR ; Rubout when at beginning of buffer, type CR + JRST TYRLD2 + +SUBTTL ITS - TTY routines (TYOX, TYI, TTYINI) and JCLINI. + +IFN ITSSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOPF + CALL TTYINI + .IOT TYOC,A + POPJ P, + + ; TYI - Get (just typed in) char in A +TYI: SKIPN TTYOPF + CALL TTYINI ; Open the tty if not already done. + .IOT TYIC,A + ANDI A,-1 ; Non-tty devices can return -1,,3. + JUMPE A,TYI + CAIN A,^L ; This must be assuming that ^L clears screen? + JRST TYI + POPJ P, + + ; Initialize tty +TTYINI: PUSH P,A + .OPEN TYIC,[.UAI,,'TTY] ; Input + .LOSE + .OPEN TYOC,[%TJDIS+.UAO,,'TTY] ; Display mode output + .LOSE + SYSCAL CNSGET,[1000,,TYOC ? 2000,,A ? 2000,,A] + MOVSI A,1 ; TTY: is translated to something else => assume infinite linel + MOVEM A,LINEL ; Else linel gets width of tty. + SETOM TTYOPF ; Say the tty is now open. + JRST POPAJ + +JCLINI: SETZM CMPTR + .SUSET [.ROPTIO,,A] + TLNN A,%OPCMD ; Has our superior said it has a cmd? + RET ; No. + BLTZ CMBFL-1,CMBUF ; Zero all but last word, + SETOM CMBUF+CMBFL-1 ; and ensure last word non-zero. + .BREAK 12,[5,,CMBUF] ; Try to read command string. + MOVE A,[440700,,CMBUF] + SKIPE CMBUF ; If read a cmd-string, + MOVEM A,CMPTR ; Tell TYRLD, GO2A it's there. + POPJ P, + +]; END IFN ITSSW + +SUBTTL TNX - TTY routines (TYOX, TYI, TTYINI) and JCLINI + +IFN TNXSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOPF + CALL TTYINI +IFN A-1,EXCH A,R1 + PBOUT +IFN A-1,EXCH A,R1 + POPJ P, + + ; TYI - Get (just typed in) char in A + ; There is a screw for 20X in that it's not really possible + ; to know if the system is going to feed you a CR-LF + ; or just a CR; TYRLD2 checks for that, by flushing LF's, but + ; this would be the place to check if it were easy to do. +TYI: SKIPN TTYOPF + CALL TTYINI ; Open the tty if not already done. +IFN A-1,EXCH R1,A + PBIN ; Get char into AC 1 + JUMPE R1,.-1 ; Ignore nulls. + TLNE FF,FL20X ; Cretinous differences between 10X/20X + JRST TYI2 ; 20X, skip EOL check. + CAIN R1,^_ ; On 10X, CR turned into ^_ (EOL); change it back. + MOVEI R1,^M +TYI2: +IFN A-1,EXCH R1,A ; Restore everything to right place if necessary. + POPJ P, + + ; TTYINI - Initialize tty + +TTYINI: PUSH P,A + PUSH P,T + SYSCAL RFMOD,[[.PRIIN]][A ? A] + POP P,T + HLRZS A + ANDI A,177 ; Terminal width + CAIGE A,30. ; If too low, + ADDI A,128. ; Assume twenex crockishness + MOVEM A,LINEL ; Linel gets width of tty. + SETOM TTYOPF ; Say the tty is now open. + POP P,A + POPJ P, + + ; Read "JCL" - RSCAN buffer or nnnMID.TMP file (from CCL) + +JCLINI: SETZM CMPTR + SKIPE CCLFLG ; Started at CCL location? + JRST JCLIN5 ; Yep, go snarf stuff specially. + TLNN FF,FL20X ; Is this Tenex? + JRST [ MOVEI R1,.PRIIN + BKJFN ; see what previous character was + POPJ P,; *Gasp* + PBIN + CAIE R1,^_ ; Tenex newline? + SETOM CMPTR ; No, set flag saying "TTY but no prompt" + POPJ P,]; and skip the Twenex hackery below + SETZ R1, ; If not, check RSCAN. + RSCAN ; See if have anything in RSCAN buffer. + POPJ P, ; Huh? Shouldn't happen, but ignore it. + JUMPLE R1,APOPJ ; Also return if char cnt says nothing there. + MOVNI R3,(R1) ; Aha, set up cnt for SIN + HRROI R2,CMBUF + MOVEI R1,.CTTRM ; Now ready for business... + SIN + LDB R1,R2 ; Now examine wages thereof + CAIE R1,^M ; Last char CR? + JRST [ MOVEI R1,^M + IDPB R1,R2 ; If not, make it so. + JRST .+1] + SETZ R1, + IDPB R1,R2 ; Must also ensure ASCIZ. + + MOVE B,[440700,,CMBUF] ; Flush any spaces in front + ILDB A,B + CAIN A,40 + JRST .-2 + + ; If the rescan line starts with "RUN", skip that. + MOVE C,B ; Save backup pos +IRPC X,,[RUN] + CAIE A,"X+40 ; Allow lowercase + CAIN A,"X + CAIA + JRST JCLIN2 ; Jump as soon as no match + ILDB A,B ; Matched, get next char. +TERMIN + +JCLIN2: CAIE A,40 ; Is next char a space? + JRST [ MOVE B,C ; When non-space seen, back up to saved pos + LDB A,B + JRST JCLIN4] + ILDB A,B ; Saw space so we won. Get next char + MOVE C,B ; Say backup should start here + JRST JCLIN2 ; and flush all spaces. + + ILDB A,B +JCLIN4: CAILE A,40 ; Now skip the filename used to invoke MIDAS. + JRST .-2 ; Flush until random ctl seen (space, ^M) + CAIE A,40 ; If it wasn't a space, + POPJ P, ; then forget about the whole thing. +JCLIN3: MOVE C,B ; Now flush spaces. Save last ptr for chars. + ILDB A,B + CAIN A,40 + JRST JCLIN3 + CAIN A,^M ; And is first non-space something besides CR? + POPJ P, ; Bah, there wasn't anything in the JCL!! + MOVEM C,CMPTR ; Else save ptr to start of real goods. + POPJ P, + + ; TNX snarf of CCL file. No such thing as tmpcor, so just + ; look for real file with appropriate name. +JCLIN5: SETZM CCLFLG ; Want 0 in case abort out, will reset if win. + GJINF ; Get job # in R3 + HRROI R1,CMBUF ; Use CMBUF to form filename string. + MOVEI R2,(R3) + MOVE R3,[NO%LFL+NO%ZRO+<3_18.>+10.] + NOUT ; ship out job num in 3 digits, radix 10. + GOHALT + HRROI R2,[ASCIZ /MID.TMP/] + SETZ R3, + SOUT ; Flesh out rest of filename string. + SETZ R2, ; Make sure it's ASCIZ. + BOUT + MOVE R1,[GJ%OLD+GJ%SHT] ; Use short-form GTJFN + HRROI R2,CMBUF ; and gobble name from CMBUF. + GTJFN + POPJ P, ; If failed, forget it. + MOVE R2,[070000,,OF%RD] ; Read 7-bit bytes + OPENF + POPJ P, ; Bah + HRROI R2,CMBUF ; Gobble stuff up. + MOVEI R3,CMBFL*5 ; Read until buffer full, + MOVEI R4,^J ; or LF seen. + SIN + JUMPLE R3,APOPJ ; Forget it if too big for buffer!! + + MOVE R2,[440700,,CMBUF] ; Aha, we've got something, so set + MOVEM R2,CMPTR ; pointer to slurped stuff. + SETOM CCLFLG + HRROI R2,UTIBUF ; Slurp rest into larger buffer, + MOVNI R3,UTIBFL*5 ; using count only. + SIN + JUMPGE R3,APOPJ ; Refuse to hack grossly large file. + ADDI R3,UTIBFL*5 + JUMPLE R3,APOPJ ; if nothing read, need write nothing out. + HRLI R1,(CO%NRJ) ; Don't release JFN, + CLOSF ; but stop reading from file. + POPJ P, + MOVE R2,[070000,,OF%WR] ; Now try to hack write access. + OPENF + POPJ P, + MOVE R2,R1 ; Source becomes destination... + HRROI R1,UTIBUF ; and UTIBUF becomes source, + MOVNS R3 ; for just as many bytes as were read. + SOUT + MOVEI R1,(R2) ; done, now just close file. + CLOSF ; (this time, release JFN). + POPJ P, + SETOM CCLMOR ; say that more CCL remains. + POPJ P, +] ; END IFN TNXSW + +SUBTTL DEC - TTY routines (TYOX, TYI, TTYINI) + +IFN DECSW,[ + + ; TYOX - Type out char in A +TYOX: SKIPN TTYOPF + CALL TTYINI + OUTCHR A + POPJ P, + + ; TYI - Get a typed-in char in A + +TYI: SKIPN TTYOPF ; Open the tty, if not already done. + CALL TTYINI + INCHWL A +IFN SAILSW,[ + CAIN A,612 ; On SAIL, EOF is 612, + MOVEI A,^Z ; so turn into normal EOF if found. +] + CAIE A,^M ; Throw away the LF after a CR. + RET + INCHWL A + MOVEI A,^M ; Note that TYRLDR will put it back in. + RET + +TTYINI: INSIRP PUSH P,AA A B +IFE SAILSW,[ + PJOB A, + TRMNO. A, + JRST TTYIN1 + MOVEI AA,1012 ; .TOWID + MOVE B,[2,,AA] + TRMOP. B, ; Read width of tty line into B. +] +TTYIN1: MOVEI B,80. ; TRMOP. failed or not tried => assume width is 80. + MOVEM B,LINEL + INSIRP POP P,B A AA + SETOM TTYOPF + RET + + TMPLOC .JBREN, TTYREN +TTYREN: SETOM TTYBRF ; "REENTER" command comes here +R: G: JRST @.JBOPC ; To request a ^H-break. Note crufty labels pointing here. + +];IFN DECSW + +SUBTTL DEC Hackery for JCLINI - Read CCL commands. + +IFN DECSW\TNXSW,[ +VBLK +CCLFLG: 0 ; Flag to indicate CCL entry from COMPIL, SNAIL, CCL, or EXEC +CCLMOR: 0 ; -1 => There are more lines of CCL commands, + ; so do a RUN SYS:MIDAS when finished. +PBLK +] + +IFN DECSW,[ ; DEC only hacks CCL as "JCL". + +.SCALAR CCLFIL ; Saves FN1 for tmp file hacking. + +; Read MID temp core file, if that loses, try nnnMID.TMP file. +; Clobbers A,B,C,D. + +JCLINI: SETZM CMPTR + SKIPN CCLFLG ; Was midas called from CCL level? + RET ; No, do not snarf tempcore + SETZM CCLFIL ; No CCL file yet + SETZM CCLFLG ; If tmpcor loses want this 0 (will re-setom below) + BLTZ CMBFL,CMBUF ; Zero cmd buffer. + MOVE A,[2,,['MID,, ? -,,CMBUF-1]] ; read (leave last wd 0) + TMPCOR A, ; Read compil-generated command + JRST [ OPEN [17 ? 'DSK,, ? 0] ; No tempcore, maybe try dump mode. + RET ; Argh but let something else die + PJOB A, ; Get job # + IDIVI A,100. ; Want decimal job number in sixbit + ADDI A,'0 + LSH A,6 + IDIVI B,10. + ADDI A,'0(B) + LSH A,6 + ADDI A,'0(C) + LSH A,18. + HRRI A,'MID ; Form file name as nnnMID.TMP + MOVEM A,CCLFIL ; Save for writing below + MOVSI B,'TMP + SETZB C,D ; No protect or ppn trash + LOOKUP A ; Try to get file + RET ; Give up + MOVE A,[-,,CMBUF-1] + SETZ B, + INPUT A ; Try to read command + SETZB A,B + RENAME A ; Try to delete it now + JFCL ; Ignore failure + CLOSE ; Happy sail + JRST .+1] + SKIPN CMBUF ; One last check for it to be there + RET ; Alas, there is none + MOVE A,[440700,,CMBUF] ; Load a byte pointer to the command + SETOM CCLFLG + MOVEM A,CMPTR ; There is, set command pointer +JCLIN1: ILDB B,A + CAIE B,^J ; See if our command file has anything after 1st line. + JRST JCLIN1 + ILDB B,A + JUMPE B,JCLIN3 + SETOM CCLMOR ; It does; set flag so after handling 1st line we'll + MOVE C,[440700,,UTIBUF+2] +JCLIN2: IDPB B,C + ILDB B,A + JUMPN B,JCLIN2 + SUBI C,UTIBUF+1 ; Get # words written in utibuf. operand is relocatable! + HRLOI C,-1(C) ; These 2 insns turn size into -size,,utibuf+1 + EQVI C,UTIBUF+1 + MOVEM C,UTIBUF+1 + SKIPE A,CCLFIL ; Was this called with a temp file? + JRST [ MOVSI B,'TMP + SETZB C,D + ENTER A ; Try to re-write file + RET ; Sigh + MOVE A,UTIBUF+1 + SETZ B, + OUTPUT A + RELEASE + RET] + MOVSI C,'MID + MOVEM C,UTIBUF + MOVE C,[3,,UTIBUF] + TMPCOR C, + JFCL ; [KLH - there used to be some random cruft here.] +JCLIN3: RET + +] ;END IFN DECSW + +SUBTTL Old Command Line Reader (CMD) +ifn 0,[ + ; Read command & filenames & hack defaulting. + +CMD: SKIPE CMPTR ; Unless have DDT or RSCAN cmd string, + JRST CMD06 ; (we don't) + CALL CRR ; type a CRLF, prompt etc. +CMD05: SETZM CMPTR + TYPE "*" +CMD06: MOVEI A,3 ; Read from TTY (or string <- cmptr) + CALL RCHSET + MOVEI F,FB ; Point to scratch filblk. + BLTZ L$FBLK,FB ; and clear the whole thing. + TRO FF,FRCMND ; Tell RFD it's scanning a command line. + CALL RFD ; Now see if command null, and whether has _. +IFN DECSW\TNXSW,[ + CAIN A,"! ; If terminator was "!", go run program. + JRST RFDRUN +] + TRNN FF,FRNNUL ; If no filespec was seen, + CAIE A,^M ; and terminator is EOL, + CAIA + JRST CMD05 ; then prompt again and get another string. + TRZ FF,FRARRO ; Got something, clear saw-"_" flag. +CMD07: CAIN A,"_ + TRO FF,FRARRO ; FRARRO will be on if there's a "_" in string. + CAIN A,^M + JRST CMD1 ; Read thru the whole command. + CALL RFD + JRST CMD07 + + ; Now re-read the string, for real this time. Previous scan was + ; mainly just to see if "_" existed. If not, then first filename + ; must be input file, and output filenames are all defaulted. +CMD1: MOVE T,[440700,,CMBUF] ; Restore original ptr to + MOVEM T,CMPTR ; beginning of string. +IFN CREFSW,SETZM CREFP ; Clear all switches before decoding them. +INSIRP SETZM 0,ERRFP TTYINS WSWCNT +IFN LISTSW,[ + SETZM LISTP + SETOM LISTP1 ; Will be AOSed by each (L) switch. +] + + MOVE T,FSDSK + MOVEM T,$FDEV(F) +IFE TNXSW,[MOVE T,RSYSNM ? MOVEM T,$FDIR(F)] +IFN TNXSW, SETZM $FDIR(F) + SETZM $FNAME(F) + SETZM $FEXT(F) + + TRZ FF,FRNNUL + TRNE FF,FRARRO ; Don't gobble input spec as output! + CALL RFD ; Read bin file spec. + MOVE TT,FF ; Remember whether null + BLTMAC T,L$FBLK,(F),OUTFB ; Copy from scratch to OUTFB. + + MOVE T,$FDEV(F) + CAMN T,FSNUL + MOVE T,FSDSK + MOVEM T,$FDEV(F) +IFE ITSSW, MOVE T,FSCRF +IFN ITSSW, MOVE T,FSCREF + MOVEM T,$FEXT(F) + + TRNN FF,FRARRO ; If "_" doesn't exist in cmd line, + MOVEI A,"_ ; then only filespec is for input, kludge to get it. + CAIN A,"_ ; If "_" exists in cmd line, did we hit it? + JRST CMD2 ; Ran out of output specs => just use defaults. + CALL RFD ; Read cref file spec. +IFN CREFSW,[ + TRNN FF,FRNNUL ; If spec not null or ended by _, + CAIN A,"_ + SETOM CREFP ; We must want to cref. +CMD2: BLTMAC T,L$FBLK,(F),CRFFB ; Copy specs from FB to CREF FB. +] +IFE CREFSW,CMD2: + MOVE T,FSERR + MOVEM T,$FEXT(F) + CAIN A,"_ + JRST CMD6 ; No more output specs. + CALL RFD ; Read error file sppec. +IFN ERRSW,[ + TRNN FF,FRNNUL ; Nonnull spec or last spec => + CAIN A,"_ + SETOM ERRFP ; Must want an error file. +CMD6: BLTMAC T,L$FBLK,(F),ERRFB ; Copy specs from FB to ERR filblk. +] +IFE ERRSW,CMD6: +IFN LISTSW,[ +IFE ITSSW, MOVE T,FSLST +IFN ITSSW, MOVE T,FSLIST + MOVEM T,$FEXT(F) + CAIN A,"_ ; Any output spec remaining? + JRST CMD3 + CALL RFD ; Yes, read one. + SETOM LISTP ; List spec given implies want listing. +CMD3: BLTMAC T,L$FBLK,(F),LSTFB ; Copy specs from FB to LST filblk. +] + +CMD5: CAIN A,"_ + JRST CMD4 + CALL RFD ; Ignore any output specs not needed. + JRST CMD5 + +CMD4: MOVE T,FSDSK ; Default the input names. + MOVE A,$FDEV(F) + CAME A,FSPTP ; Don't leave dev name set to common out-only devs. + CAMN A,FSNUL + MOVEM T,$FDEV(F) +IFE ITSSW, MOVE T,FSMID +IFN ITSSW, MOVE T,FSGRTN ; > on ITS. + MOVEM T,$FEXT(F) + MOVE T,FSPROG + SKIPN $FNAME(F) ; The fn1 alone is sticky across the _. + MOVEM T,$FNAME(F) + + TRZ FF,FRARRO ; If only 1 name it should be FNAM1. + CALL RFD ; Read input spec. + BLTMAC T,L$FBLK,(F),ISFB ; Copy into specified-input filblk. + MOVE T,$FNAME(F) ; Default output FN1's to input. + SKIPN OUTFB+$FNAME + MOVEM T,OUTFB+$FNAME +IFN CREFSW,[ + SKIPN CRFFB+$FNAME + MOVEM T,CRFFB+$FNAME +] +IFN LISTSW,[ + SKIPN LSTFB+$FNAME + MOVEM T,LSTFB+$FNAME +] +IFN ERRSW,[ + SKIPN ERRFB+$FNAME + MOVEM T,ERRFB+$FNAME +] + MOVE A,FSNUL ; The output dev defaults to NUL: + MOVE T,$FDEV(F) ; If the input is from TTY: + CAMN T,FSTTY + TRNE FF,FRNNUL ; And the bin spec was null. + CAIA + MOVEM A,OUTFB+$FDEV + TRZ FF,FRARRO ; Don't louse up .INSRT's reading. + RET +] ;ifn 0 + +SUBTTL Command Line Reader (CMD) + + ; CMD - Read command & filenames & hack defaulting. + +.SCALAR CMDPSV ; Saves read ptr into CMBUF, for re-scanning. + +CMD: MOVE T,CMPTR ; Check JCL. + CAMN T,[-1] ; If Tenex-type "JCL", + JRST CMD06X ; normal TTY input 'cept no prompt. + JUMPL T,CMD06 ; For DDT/RSCAN/CCL strings, type nothing out. + CALL CRR ; Else must type a CRLF, prompt etc. +CMD05: TYPE "*" +CMD06X: SETZB T,CMPTR +CMD06: MOVEM T,CMDPSV ; Save pointer for later restoration + MOVEI A,3 ; Read from TTY (or string <- cmptr) + CALL RCHSET + + MOVEI F,ISFB ; Point to input-spec filblk. + BLTZ L$FBLK,(F) ; Zap it through and through. + TRO FF,FRCMND ; Tell RFD it's scanning a command line. + CALL RFD ; Now see if command null, and whether has _. +IFN DECSW\TNXSW,[ + CAIN A,"! ; If terminator was "!", go run program. + JRST RFDRUN +] + TRNN FF,FRNNUL ; If no filespec was seen, + CAIE A,^M ; and terminator is EOL, + CAIA + JRST CMD05 ; then prompt again and get another string. + TRZA FF,FRARRO ; Got something, clear saw-"_" flag. +CMD07: CALL RFD + CAIN A,"_ + JRST [ TRO FF,FRARRO ; FRARRO will be on if there's a "_" in string. + CALL RFD ; Gobble next filename, input filespec. + JRST CMD1] + CAIE A,^M + JRST CMD07 ; Read thru the whole command until read input filespec + + + ; Now re-read the string, for real this time. Previous scan was + ; mainly to latch onto input filespec and see if "_" existed. + +CMD1: SKIPN T,CMDPSV ; Restore original ptr if there's one, + MOVE T,[440700,,CMBUF] ; else point at beg of buffer. + MOVEM T,CMPTR + SETZM TTYINS ? SETZM WSWCNT ; Clear all switches. +IFN CREFSW,SETZM CREFP +IFN ERRSW, SETZM ERRFP +IFN LISTSW,SETZM LISTP ? SETOM LISTP1 ; Will be AOSed by each (L) switch. + SETZ A, + TRNN FF,FRARRO ; If "_" doesn't exist in cmd line, + MOVEI A,"_ ; then only filespec is for input, kludge to get it. + + MOVEI F,OUTFB + BLTZAC T,L$FBLK,(F) ; Clear output filblk. + MOVE T,FSDSK ; Default dev to DSK. + MOVEM T,$FDEV(F) + SKIPN T,$FNAME+ISFB ; Now default FN1 from input filespec + MOVE T,FSPROG ; (use "PROG" if none) + MOVEM T,$FNAME(F) +IFE TNXSW,[MOVE T,RSYSNM ; Now default directory if need to + MOVEM T,$FDIR(F)] + + TRZ FF,FRNNUL + CAIE A,"_ ; If it exists, + CALL RFD ; Read bin file spec. + TRNN FF,FRNNUL ; If spec was null, + JRST [ MOVE T,FSTTY ; and input spec was TTY:, + CAME T,$FDEV+ISFB + JRST .+1 + MOVE T,FSNUL ; then set device to NUL:. + MOVEM T,$FDEV(F) + JRST .+1] + +DEFINE CFMAC SWIT,PTR,INSTR,DEXT +IFN SWIT,[ + MOVE T,DEXT + MOVE TT,[[INSTR],,PTR] +] .ELSE SETZB T,TT + PUSHJ P,CMDFGT +TERMIN + + CFMAC CREFSW,CRFFB,[SETOM CREFP][IFN ITSSW,[FSCREF] .ELSE FSCRF] + + CFMAC ERRSW, ERRFB,[SETOM ERRFP] FSERR + + CFMAC LISTSW,LSTFB,[SETOM LISTP][IFN ITSSW,[FSLIST] .ELSE FSLST] + +CMD50: CAIE A,"_ + JRST [ SETZB T,TT ; Point to scratch FB etc. + CALL CMDFGT ; Ignore any output specs not needed. + JRST CMD50] ; Must do this way to retain default stuffs. + + ; Finally read input file. + BLTMAC T,L$FBLK,(F),ISFB ; Copy last stuff to input spec + MOVEI F,ISFB ; and point at it. + PUSHJ P,CMDDVX ; Hack device-name default. +IFE ITSSW, MOVE T,FSMID +IFN ITSSW, MOVE T,FSGRTN ; > on ITS. + MOVEM T,$FEXT(F) + CALL RFD ; Read input spec. + RET ; Yep, that's really all! + + ; TT has ,, + ; T has default $FEXT. + ; Takes defaults from current F, sets F to new filblk. +CMDFGT: JUMPE TT,[SETZ T, ; If 0, do usual but into oblivion (scratch FB) + MOVE TT,[[JFCL],,FB] + JRST .+1] + BLTMAC B,L$FBLK,(F),(TT) ; Copy from current filblk to new. + MOVE F,TT ; set new F. + MOVEM T,$FEXT(F) ; Set default $FEXT + PUSHJ P,CMDDVX ; Set up device, defaulting to DSK. + CAIN A,"_ ; If last delimiter was start of input spec, + POPJ P, ; don't read anything - just use defaults. + PUSHJ P,RFD + TRNN FF,FRNNUL ; If spec non-null or + CAIN A,"_ ; ended by _, then + CAIA ; hack specified instr. + POPJ P, + HLRZ T,F + XCT (T) + POPJ P, + +CMDDVX: SKIPN T,$FDEV(F) + MOVE T,FSDSK + CAME T,FSPTP + CAMN T,FSNUL + MOVE T,FSDSK + MOVEM T,$FDEV(F) + POPJ P, + +SUBTTL ITS/DEC Filename Reader/printer (RFD, TYPFB) + +IFN DECSW\ITSSW,[ ; Begin moby conditional for sixbit reader. + +; RFD - Reads a single file description from .INSRT or command line, +; using RCH, into specified FILBLK. +; F points at FILBLK to store description in. +; Implements crufty ^R hack (if see ^R, act as if just starting to +; read filename, so effect is stuff before ^R has set defaults.) +; If FRCMND set, recognize -, comma, / and ( as special characters, +; and hack switches. +; Sets FRNNUL if spec was nonnull. +; Clobbers A,B,C only. + +RFD: TRZ FF,FRNNUL +RFD01: SETZM RFDCNT ; Zero cnt of "normal" filenames. Jump here if see ^R. + +RFD10: PUSHJ P,GPASST ; Flush out spaces/tabs + TRNN FF,FRCMND ; If parsing command line, + CAIE A,"; ; or if char isn't semi-colon, + JRST RFD22 ; just handle normally. +RFD15: PUSHJ P,RCH ; Semi-colon and not command line!! Flush rest + CAIE A,^M ; of line, assuming it's a comment! + JRST RFD15 + POPJ P, + +RFD2: PUSHJ P,RCH ; Get character in A +RFD20: CAIE A,40 ; Space (Come here to scan already-read char.) + CAIN A,^I ; or tab? + JRST RFD10 ; Ach, go into flush-whitespace loop. +RFD22: CAIN A,^M ; End of line? + POPJ P, ; If so, obviously done. + CAIN A,^R ; Crufty ^R hack? + JRST RFD01 ; Sigh, pretend just starting to read filename. + TRNN FF,FRCMND ; Reading command line? + JRST RFD40 ; Nope, skip over cmnd-line frobs. + + ; Reading cmd line, test special chars. +IFN ITSSW\SAILSW, CAIN A," ; SAIL underscore, ITS backarrow like _. + .ELSE CAIN A,"= ; Either gets munged, + MOVEI A,"_ ; into canonical "_". + CAIE A,"_ ; Backarrow is output_input marker. + CAIN A,", ; Comma is also a terminator... + POPJ P, +IFN DECSW\TNXSW,[ ; I'm not sure if this belongs here, but + CAIN A,"! .SEE RFDRUN + POPJ P, +] + PUSHJ P,CMDSW ; Check for switches... + JRST RFD20 ; Got some, scan next char (returned by CMDSW) + ; Got none, drop thru. + + + ; No special delimiters, + ; Check for chars which signal what following word is. +RFD40: +IFN DECSW,[ + CAIN A,"[ ;] Left bracket signals start of PPN. + JRST [ PUSHJ P,RFDPPN ; Slurp it up, + MOVEM C,$F6DIR(F) ; store it, + TRO FF,FRNNUL ; saying spec not null. + JRST RFD20] ; and go process leftover delimiter. + + CAIN A,". ; Period signals start of extension. + JRST [ PUSHJ P,RCH ; Get the next character + PUSHJ P,RFDW ; Read in a word. + MOVEM C,$F6EXT(F) ; Store it... + TRO FF,FRNNUL ; and say spec non-null (even if C/ 0) + JRST RFD20] ; and process delimiting char. +] + + ; Here, char doesn't signal the start of anything, so we'll assume + ; it's the start of a name. + PUSHJ P,RFDW ; Gobble up a word. + JUMPE C,RFD2 ; If nothing was read, must ignore char; get another. + + ; Aha, name was read, now examine delimiter to see if it specifies + ; anything we know about. + TRO FF,FRNNUL ; Set flag saying spec non-null. + CAIN A,": ; If colon... + JRST [ MOVEM C,$F6DEV(F) ; Then store name as device. + JRST RFD2] ; and flush delimiter. +IFN ITSSW,[ + CAIN A,"; ; If semicolon... + JRST [ MOVEM C,$F6DIR(F) ; Then store name as directory (sname) + JRST RFD2] ; and flush delimiter. +] + ; Whatever it is, at this point delimiter doesn't signify anything + ; special in terms of what the name is. So we just store it, using + ; the usual FN1 FN2 DEV DIR sequence, and hand delimiter off to + ; the prefix scanning stuff. + MOVE B,RFDCNT ; Get current count for random names. + XCT RFDTAB(B) ; Either MOVEM C, to right place, or ignore + AOS RFDCNT ; by skipping over this instr. + JRST RFD20 ; and go examine delimiter. + + +.SCALAR RFDCNT ; Count to index RFDTAB by. + +RFDTAB: MOVEM C,$F6FNM(F) ; 1st name. + MOVEM C,$F6EXT(F) ; 2nd name. + MOVEM C,$F6DEV(F) ; 3rd name is dev. + MOVEM C,$F6DIR(F) ; 4th is sname. + CAIA ; 5th and on ignored, don't incr. cnt. + +; RFDW - Reads a "word" - any string of contiguous SIXBIT chars, +; barring certain delimiters, and leaves SIXBIT result in C. +; Begins reading with char currently in A. Returns with delimiter +; char in A (it's possible this can be the same char!) +; Clobbers B. + +RFDW: SETZ C, ; First things first, zap result. + SKIPA B,[440600,,C] +RFDW2: PUSHJ P,RCH + CAIN A,^Q ; Is char the quoter char? + JRST [ PUSHJ P,RCH ; Yup, gobble next... + CAIN A,^M ; and accept anything but CR + POPJ P, ; since that terminates the whole line. + JRST RFDW7] ; OK, go stuff the char into C. + CAIE A,40 ; Space + CAIN A,^I ; or tab + POPJ P, ; is always a break. + CAIN A,^M ; As is CR. + POPJ P, + TRNN FF,FRCMND ; And certain chars are bummers when reading cmd. + JRST RFDW4 + CAIE A,"/ + CAIN A,"( + POPJ P, +IFN DECSW\TNXSW, CAIE A,"= + CAIN A,"_ + POPJ P, +IFN ITSSW\SAILSW, CAIE A," + CAIN A,", + POPJ P, +IFN DECSW\TNXSW,[ + CAIN A,"! + POPJ P, +] + ; Not reading cmd line, or no cmd-line type chars seen. +RFDW4: +IFN ITSSW,[ + CAIE A,": ; For ITS filenames, these chars are special. + CAIN A,"; + POPJ P, +] +IFN DECSW,[ + CAIL A,140 ; For DEC, allow only alphanumeric. + SUBI A,40 ; cvt to uppercase, then + CAIL A,"A ; see if alpha. + CAILE A,"Z + JRST [CAIL A,"0 ; Nope, see if numeric. + CAILE A,"9 + POPJ P, ; Not alphanumeric, assume delimiter. + JRST .+1] +] +RFDW7: TLNN B,770000 ; Enough room in C for another char? + JRST RFDW2 ; Nope, ignore it and get next. + CAIL A,140 ; Enuf room, cvt lower to uppercase + SUBI A,40 + SUBI A,40 ; and cvt to sixbit, + IDPB A,B ; and deposit. + JRST RFDW2 ; Get another. + +] ; END IFN DECSW\ITSSW + +IFN DECSW,[ ; PPN Reader + +RFDPPN: PUSHJ P,RFDOCT ; Read project num, +IFN CMUSW, JUMPE C,RCMUPP ; At CMU watch for our funny ppns + HRLM C,(P) + PUSHJ P,RFDOCT ; Read programmer num. + HLL C,(P) + POPJ P, + +IFE SAILSW,RFDOCL=="0 ? RFDOCH=="8 ; Read octal numbers. +IFN SAILSW,RFDOCL==40 ? RFDOCH==140 ; Read sixbit (right-justified). + +RFDOCT: SETZ C, ; Read octal num, return in C. +RFDOC1: PUSHJ P,RCH + CAIL A,140 + SUBI A,40 +IFN SAILSW,[ ;[ ; Even if reading sixbit names (for SAIL), + CAIE A,", ; Comma and closebracket are still special. + CAIN A,"] + POPJ P, +] + CAIL A,RFDOCL + CAIL A,RFDOCH + POPJ P, ; Not octal or not 6bit, return. + IMULI C,RFDOCH-RFDOCL + ADDI C,-RFDOCL(A) + JRST RFDOC1 + +IFN CMUSW,[ ; [ +RCMUPP: CAIN A,"] ; Watch out for [] + POPJ P, +REPEAT 4, SETZM PPNBUF+.RPCNT + MOVE C,[440700,,PPNBUF] +RCMUPL: CAIE A,^M ; Don't look too far + SKIPE PPNBUF+3 + JRST RCMUPD + IDPB A,C + PUSHJ P,RCH ; [ + CAIE A,"] + JRST RCMUPL +RCMUPD: MOVE A,[C,,PPNBUF] + CMUDEC A, + SETZ C, + POPJ P, + +.VECTOR PPNBUF(4) ; Storage to buffer up a string for CMUDEC uuo to scan. + +] ;IFN CMUSW +] ;IFN DECSW + +IFN DECSW\ITSSW,[ + +; TYPFB - Type out current filblk (what F points at) as file specification +; Clobbers A,B,C + +TYPFB: MOVSI C,-3-ITSSW + HRR C,F +TYPF1: MOVE B,$F6DEV(C) ; Get next name + PUSHJ P,SIXTYO ; Type out name + HLRZ A,C + MOVE A,FILSPC+3+ITSSW(A) ; Now get delimiting character + PUSHJ P,TYOERR ; Type out + AOBJN C,TYPF1 ; Loop for all names +IFN ITSSW, POPJ P, +IFN DECSW,[ + SKIPN B,$F6DEV(C) ; On DEC system PPN is a special case + POPJ P, + MOVEI A,"[ ;] + CALL TYOERR +IFN CMUSW,[ + MOVE A,[B,,PPNBUF] + DECCMU A, + JRST OCTPPN + TYPR PPNBUF + JRST PPNRB + ] +IFE SAILSW,[ +OCTPPN: HLRZ B,$F6DEV(C) ; LH is proj, + CALL OCTPNT + ] +.ELSE [ HLLZ B,$F6DEV(C) + CALL SIXTYO +] + MOVEI A,", + CALL TYOERR +IFE SAILSW,[ + HRRZ B,$F6DEV(C) + CALL OCTPNT ; RH is prog. +] +.ELSE [ HRLZ B,$F6DEV(C) + CALL SIXTYO + ] +PPNRB: ; [ + MOVEI A,"] + JRST TYOERR +];IFN DECSW + +FILSPC: ": +IFN ITSSW, 40 ? 40 ? "; +IFN DECSW, ". ? 0 + +] ; END IFN DECSW\ITSSW + +SUBTTL Command switches + +; CMDSW - Hacks either a single switch or switch list; A should +; contain "/ for the former, "( for the latter. +; Returns in A next char after switch hackery done. This may be ^M. +; Skip returns if neither "/ nor "( was furnished to it. + +CMDSW: CAIN A,"/ ; Single switch? + JRST [ PUSHJ P,RCH ; Get next char + CAIN A,^M + POPJ P, + PUSHJ P,CMDSW1 + PJRST RCH] + CAIE A,"( ; Switch list? + JRST POPJ1 ; Neither slash nor paren, make skip return. +CMDSWL: PUSHJ P,RCH + CAIN A,^M + POPJ P, + CAIN A,") + PJRST RCH + PUSHJ P,CMDSW1 + JRST CMDSWL + + ; Command switch processing. CMDSW1 processes the switch char + ; in A. +CMDSW1: CAIL A,140 ; Lower case to upper. + SUBI A,40 + CAIN A,"T + SOS TTYINS ; Count # T-switches. + + CAIN A,"W ; W - prevent tty messages, and +IFE ERRSW,AOS WSWCNT ; request error output file if possible. +.ELSE [ + AOSA WSWCNT + CAIN A,"E ; E - request error log file. + SETOM ERRFP + ] + +IFN CREFSW,[ + CAIN A,"C ; C - request CREF output. + SETOM CREFP + ] + +IFN LISTSW,[ + CAIE A,"L ; L - request listing + POPJ P, + SETOM LISTP ; Say want listing. + AOS LISTP1 ; (starts as -1, will be positive after 2nd (L)) + ] + + POPJ P, + +SUBTTL TENEX Filename Reader/printer (RFD, TYPFB) + +IFN TNXSW,[ ; Moby conditional for Tenex reader. + +; TNXRFD - TENEX-style Filename Reader. +; Takes input from RCH, +; Deposits name strings into filblk F points to. +; Clobbers A,B,C,D, (and AA,T,TT due to FNCHK) +; Uses FRFEXT flag to see if already read extension (type) or not. +; Refuses to accept existing defaults for version, ;T, account, +; protection, or JFN. It will also zap an existing directory +; default if a device is specified, and vice versa. This is so that +; logical names will win a little better. +; Implements crufty ^R hack (if see ^R, act as if just starting to +; read filename, so effect is stuff before ^R has set defaults.) + +IFNDEF FRFDEV,FRFDEV==2 ; Set if read device. +IFNDEF FRFDIR,FRFDIR==1 ; Set if read directory. +IFNDEF FRFEXT,FRFEXT==FRFN1 ; Borrow this bit. Set if read extension. + +RFD: TRZ FF,FRNNUL + SETZM $FJFN(F) ; Zap JFN since the filename we'll read won't match it. + SETZM $FACCT(F) ; Also zap other things that we don't want defaulted. + SETZM $FPROT(F) + SETZM $FTEMP(F) + SETZM $FVERS(F) +TRFD01: TRZ FF,FRFEXT+FRFDEV+FRFDIR ; Jump here if ^R seen. +TRFD10: PUSHJ P,GPASST ; remove tabs, spaces and get first non-tab/space + TRNN FF,FRCMND ; If parsing command line, + CAIE A,"; ; or if char isn't semicolon, + JRST TRFD21 ; just handle normally. +TRFD15: PUSHJ P,RCH ; Semi-colon and not command line, it's a comment! + CAIE A,^M ; So flush rest, up to EOL. + JRST TRFD15 + POPJ P, + +TRFD1: TLO FF,FLUNRD ; come here to re-read last char +TRFD2: PUSHJ P,RCH ; Get char +TRFD21: CAIE A,40 ; Space? (come here to scan already-read char) + CAIN A,^I ; or tab? + JRST [TRNE FF,FRCMND ; Space/tab, if reading command line + JRST TRFD2 ; then ignore and continue scanning (for switches), but + JRST TRFD15] ; if not in cmd line, go flush entire rest of line! + CAIN A,^M ; End of line? + POPJ P, ; If so, obviously done. + CAIN A,^R ; Crufty ^R hack? + JRST TRFD01 ; Sigh, pretend starting over. + TRNN FF,FRCMND ; Must we check for cmd line frobs? + JRST TRFD22 ; Nope, skip them. + + ; Must check for chars special only in command line. + CAIN A,"= + MOVEI A,"_ + CAIE A,"_ ; backarrow is filename terminator... + CAIN A,", ; as is comma. + POPJ P, + CAIN A,"! ; For CCL hacking... + POPJ P, .SEE RFDRUN + PUSHJ P,CMDSW ; Check for switches... + JRST TRFD21 ; got some, process next char (returned by CMDSW) + ; Skips if none, drop thru. + + ; Now see if char signifies start of anything in particular. +TRFD22: CAIE A,"< ; Start of directory name? + JRST TRFD24 ; No + PUSHJ P,RCH + PUSHJ P,TRFDW ; Read word, starting with next char +TRFD23: CAIN A,". ; Allow . as part of directory name + JRST [ PUSHJ P,TRFDW5 ; Read a continuation to this word + JRST TRFD23] ; And try again + MOVEI D,$FDIR ; Set up index. + CAIN A,"> ; Terminator should be end of dir name... + PUSHJ P,RCH ; If so, get next to avoid scan of ">". + ; else bleah, but aren't supposed to fail... + TRNN FF,FRFDEV ; Unless a device has been explicitly given, + SETZM $FDEV(F) ; zap any furnished default. 0 means DSK. + TRO FF,FRFDIR ; Now say dir was explicitly given. + JRST TRFD6 ; Go store it. +TRFD24: CAIN A,". ; Start of $FTYPE or $FVERS (20x)? + JRST [ MOVEI D,$FTYPE ; Assume reading $FTYPE field, + TLNE FF,FL20X ; always if 10X, but if really on 20X, then + TRON FF,FRFEXT ; use $FTYPE only if not already seen. + JRST TRFD4 ; $FTYPE - jump to get word & store. + PUSHJ P,TRFDNM ; $FVERS - 20X and $FTYPE already seen. Get #. + MOVEM B,$FVERS(F) ; Store it away if successful. + JRST TRFD1] ; and go re-read delimiting char. + + CAIN A,"; ; Start of $FVERS (10x) or attribute? + JRST [ PUSHJ P,RCH ; Find what next char is. + CAIL A,"a ; Must uppercasify. + CAILE A,"z + CAIA + SUBI A,40 + CAIN A,"T ; Temporary file? + JRST [ SETOM $FTEMP(C) + JRST TRFD2] + CAIN A,"A ; Account? + JRST [ MOVEI D,$FACCT ; Set index, and + JRST TRFD4] ; go gobble following word. + CAIN A,"P ; Protection? + JRST [ MOVEI D,$FPROT ; Set index, and + JRST TRFD4] ; go gobble following word. + TLO FF,FLUNRD ; Not alpha, try numeric. Re-read char, + PUSHJ P,TRFDNM ; trying to parse as number. + MOVEM B,$FVERS(F) ; Win, parsed as number! Store it. + JRST TRFD1] ; If none of above, ignore ";" entirely. + + PUSHJ P,TRFDW ; Let's try reading it as word, + JUMPLE C,APOPJ ; If nothing read, assume it's some terminating delimiter. + CAIN A,": ; Else have something, check trailing delim for special cases + JRST [ MOVEI D,$FDEV ; Aha, a device. + PUSHJ P,RCH ; Flush the terminator & get next char. + TRNN FF,FRFDIR ; Unless dir was explicitly given, + SETZM $FDIR(F) ; zap furnished default. 0 uses connected dir. + TRO FF,FRFDEV ; Say device was explicitly given, and + JRST TRFD6] ; store name away. + MOVEI D,$FNAME ; Else assume it's the filename. + JRST TRFD6 + + +TRFD4: PUSHJ P,RCH ; Here when must gobble next char, +TRFD5: PUSHJ P,TRFDW ; here when first char of wd already read. +TRFD6: PUSHJ P,FNCHKZ ; Note this can return and store a null string! + ADDI D,(F) ; Get address (filblk+index), and + MOVEM A,(D) ; store string pointer in the appropriate place. + TRO FF,FRNNUL ; Say non-null spec seen, + JRST TRFD1 ; and go re-read the delimiter, to process it. + +; TRFDW - Read a word (string), for use by TNXRFD. Copies sequence of +; acceptable filename chars into FNBUF, until non-valid char seen. +; A/ First char of word, +; Returns A/ delimiting char, C/ count of chars in string, +; clobbers nothing else. + +TRFDW4: SUBI A,40 ; Make lowercase +TRFDW5: IDPB A,FNBWP ; Deposit into FNBUF, + PUSHJ P,RCH ; get next char, + AOSA C ; and bump count, skipping over zap instruction. +TRFDW: SETZ C, ; When called, zero cnt of chars in string. + CAIL A,"A ; See if char is uppercase alpha, + CAILE A,"Z + CAIA + JRST TRFDW5 + CAIL A,"a ; or lowercase alpha, + CAILE A,"z + CAIA + JRST TRFDW4 + CAIL A,"0 ; or numeric, + CAILE A,"9 + CAIA + JRST TRFDW5 + CAIE A,"$ ; or dollarsign + CAIN A,"- ; or hyphen + JRST TRFDW5 + CAIN A,"_ ; Backarrow is special case, because + JRST [ TRNN FF,FRCMND ; if reading command, + TLNN FF,FL20X ; or running on 10X, + POPJ P, ; must treat as delimiter. + JRST TRFDW5] + CAIN A,^V ; ^V is quote char... + JRST [ PUSHJ P,RCH ; Quote, get next. + CAIE A,^M ; Quote anything but this. + CAIN A,0 ; or this. + POPJ P, ; time to exit. + PUSH P,A ; Quote it! Save char, + MOVEI A,^V ; so that a quoter can precede it. + IDPB A,FNBWP ; Fortunately this hair only needs care + POP P,A ; for quoted chars, which are + JRST TRFDW5] ; rare. + TLNE FF,FL20X ; Are we on a 10X? + POPJ P, ; If not, anything at this point is delimiter. + CAIL A,41 ; Check general bounds + CAIL A,137 ; Range from space to _ exclusive. + POPJ P, ; If outside that, delimiter. + CAIL A,72 ; This range includes :, ;, <, =, > + CAILE A,76 + CAIA + POPJ P, ; delimiter. + CAIE A,". + CAIN A,", + POPJ P, + CAIE A,"* + CAIN A,"@ + POPJ P, + ; Finally, check out chars which are acceptable to 10X but which + ; might be delimiter in cmd line... + TRNN FF,FRCMND + JRST TRFDW5 ; Not hacking cmd line, it's an OK char. + CAIE A,"/ + CAIN A,"( + POPJ P, + CAIN A,"! + POPJ P, + JRST TRFDW5 ; at long last done. + + +; TRFDNM - Read numerical string, halt when non-digit +; seen, leaves result (decimal) in B, with delimiting char in A. +; One peculiarity is skip return if no numerical char is seen at all; +; else doesn't skip and B has a valid number. + +TRFDNM: PUSHJ P,RCH ; First char needs special check. + CAIL A,"0 + CAILE A,"9 + JRST POPJ1 ; Not a number at all? + TDZA B,B +TRFDN2: IMULI B,10. + ADDI B,-"0(A) ; Convert to number + PUSHJ P,RCH ; Get following chars. + CAIL A,"0 + CAILE A,"9 + POPJ P, ; Nope, not digit so treat as delimiter. + JRST TRFDN2 ; Yep, a number + +] ;IFN TNXSW + +IFN TNXSW,[ + +; TYPFB - Type out FB pointed to by F + +TYPFB: SKIPE B,$FDEV(F) ; First, device name? + JRST [ PUSHJ P,TYPZ + MOVEI A,": + PUSHJ P,TYOERR + JRST .+1] + SKIPE B,$FDIR(F) ; Directory? + JRST [ MOVEI A,"< + PUSHJ P,TYOERR + PUSHJ P,TYPZ + MOVEI A,"> + PUSHJ P,TYOERR + JRST .+1] + SKIPE B,$FNAME(F) + PUSHJ P,TYPZ + MOVEI A,". + PUSHJ P,TYOERR + SKIPE B,$FEXT(F) + PUSHJ P,TYPZ + MOVEI A,". ; 20X uses "." to set off version, + TLNN FF,FL20X ; but 10X uses ";". + MOVEI A,"; + PUSHJ P,TYOERR + HRRE A,$FVERS(F) + JUMPL A,[MOVM B,A ; Is possible to have -1, -2, etc. + MOVEI A,"- + PUSHJ P,TYOERR + MOVE A,B + JRST .+1] + PUSHJ P,DPNT ; Version # output in decimal. + SKIPE $FTEMP(F) + TYPE ";T" ; May be temporary. + SKIPE B,$FPROT(F) + JRST [ TYPE ";P" + PUSHJ P,TYPZ + JRST .+1] + SKIPE B,$FACCT(F) + JRST [ TYPE ";A" + PUSHJ P,TYPZ + JRST .+1] + POPJ P, + + ; Takes BP in B, outputs to TYOERR until zero byte seen. +TYPZ: CAIA + PUSHJ P,TYOERR + ILDB A,B + JUMPN A,TYPZ+1 + POPJ P, +] ; IFN TNXSW + +SUBTTL TENEX misc. Filename Routines, FS string storage + +IFN TNXSW,[ .SEE FSDSK ; Part of this page is NOT conditionalized!! + +; To handle filenames of ASCIZ strings instead of SIXBIT words, each +; word has instead a byte pointer to an ASCIZ string. For purposes of +; easy comparison, all of these bp's point into FNBUF, and a routine +; (FNCHK) is provided which checks a just-stored string and returns a bp +; to either this string, if unique, or to a previously stored string if +; it is the same as the one just stored (which is then flushed). Thus +; strings can be compared for equality simply by a comparison of their +; byte pointers. While not necessary, strings are stored beginning on +; word boundaries for easier hacking. + + ; <# files>**+<# wds for constants> +LFNBUF==*5*3+20 ; Enough to hold strings for all output files, + ; all translated files, and all .insrt files encountered. + ; Later a GC'er can be hacked up so that of the latter only + ; enough for the max .insrt level need be allocated. + +LVAR FNBUF: BLOCK LFNBUF + + ; Macro to easily define constant strings for comparison purposes +DEFINE DEFSTR *STR* +440700,,%%FNLC +%%LSAV==. +LOC %%FNLC +ASCIZ STR +%%FNLC==. +LOC %%LSAV +TERMIN + %%FNLC==FNBUF +] ; IFN TNXSW!!! + + ; If not assembling for TENEX, the following strings become + ; simple SIXBIT values. This makes it possible to write simple + ; code to work for both TENEX and non-TENEX without messy conditionals. + +IFE TNXSW,[EQUALS DEFSTR,SIXBIT] + +FSDSK: DEFSTR /DSK/ ; This stuff defines various BP's into FNBUF to +FSSYS: DEFSTR /SYS/ ; use for comparison purposes later. +FSTTY: DEFSTR /TTY/ +FSNUL: DEFSTR /NUL/ +FSPTP: DEFSTR /PTP/ +FSATSN: DEFSTR /@/ +FSSBSY: DEFSTR /SUBSYS/ +FSPROG: DEFSTR /PROG/ +FSMID: DEFSTR /MID/ +FSMDAS: DEFSTR /MIDAS/ +FSGRTN: DEFSTR />/ +FSCRF: DEFSTR /CRF/ +FSCREF: DEFSTR /CREF/ +FSERR: DEFSTR /ERR/ +FSLST: DEFSTR /LST/ +FSLIST: DEFSTR /LIST/ +FSSAV: DEFSTR /SAV/ +FSEXE: DEFSTR /EXE/ + +IFN TNXSW,[ +VBLK +FNBBP: 440700,,FNBUF ; Points to beg of FNBUF (hook for dynamic alloc) +FNBEP: FNBUF+LFNBUF-1 ; Points to last wd in FNBUF (address, not BP) +FNBWP: 440700,,%%FNLC ; Write Pointer into FNBUF. +FNBLWP: 440700,,%%FNLC ; Last Write Pointer, points to beg of string being stored +PBLK +EXPUNG %%FNLC + +; NOTE - provided MIDAS never restarts, no initialization is necessary to +; start using FNCHK. (Unless of course FNBUF is dynamically allocated someday) + +; FNCHK - Check out just-stored filename. Returns BP in A to ASCIZ string, +; which will be "canonical" for comparison purposes. +; Clobbers A,B,T,TT,AA +; FNCHKZ - Makes sure just-writ string is ASCIZ'd out before FNCHK'ing. + +FNCHKZ: MOVE B,FNBWP ; Get write ptr, + LDB A,B ; see if last char was 0, + JUMPE A,FNCHK0 ; if so can skip one clobberage. + SETZ A, + IDPB A,B ; zero out bytes, +FNCHK0: TLNE B,760000 ; until at end of word. + JRST .-2 + ADD B,[<440700,,1>-<010700,,>] ; bump BP to point canonically at next. + MOVEM B,FNBWP + +FNCHK: HRRZ B,FNBWP ; See if write ptr + CAML B,FNBEP ; has hit end of FNBUF, and + ETF [ASCIZ /Filename buffer overflow/] ; barf horribly if so. + MOVE A,FNBBP ; A - bp to start of existing string + MOVE AA,FNBLWP ; AA - bp to start of new string to store +FNCHK2: MOVEI T,(A) ; T - current addr being checked, existing str + MOVEI TT,(AA) ; TT - current addr, new str + CAIL T,(TT) ; If addrs are same, or overran somehow, + JRST [ MOVE A,AA ; didn't find any match, accept new string. + MOVE B,FNBWP + MOVEM B,FNBLWP ; Set up new last-write-ptr + POPJ P,] +FNCHK3: MOVE B,(T) + CAMN B,(TT) ; Compare strings, full word swoops. + JRST [ TRNE B,377 ; equal, last char zero? + AOJA T,[AOJA TT,FNCHK3] ; no, continue for whole string + ; Found it! Flush just-stored string, don't want duplicate. + MOVEM AA,FNBWP ; Clobber write ptr to previous value. + POPJ P,] + ; Not equal, move to next string to compare + MOVEI B,377 ; Check for ASCIZ, + TDNE B,(T) ; moving to end of current string + AOJA T,.-1 + HRRI A,1(T) ; and updating BP to point at new string. + JRST FNCHK2 ; (T gets pointed there too at FNCHK2). + +; JFNSTR - Get filename strings for active JFN. +; A/ active JFN +; F/ addr of filename block to clobber. +; JFNSTB - Same, but ignores A and assumes JFN is already stored in block. +; Clobbers A,C + +JFNSTB: SKIPA A,$FJFN(F) ; JFNSTB gets the JFN from block itself. +JFNSTR: MOVEM A,$FJFN(F) ; whereas JFNSTR stores it there... + MOVSI D,-NJSTRF ; Set up aobjn thru table. +JFNST2: PUSH P,T + SYSCAL JFNS,[FNBWP ? $FJFN(F) ? JSTRFX+1(D)][FNBWP] + POP P,T + MOVE C,JSTRFX(D) ; Now get index to place it belongs in file block, + CAIN C,$FVERS ; and check for this, because + JRST [ MOVE A,FNBLWP ; it wants to be a number, not a string. + MOVEM A,FNBWP ; Zap write pointer back to forget string, + PUSHJ P,CVSDEC ; and quickly convert before anything clobbers it. + JRST .+2] ; Skip over the FNCHKZ call. + PUSHJ P,FNCHKZ ; Fix it up, and get BP to it. + ADDI C,(F) ; make it an addr, and + MOVEM A,(C) ; store BP. (or value, for $FVERS) + ADDI D,1 + AOBJN D,JFNST2 + POPJ P, + + ; Filblk idx, output format wd for JFNS call +JSTRFX: $FDEV ? 100000,, + $FDIR ? 010000,, + $FNAME ? 001000,, + $FTYPE ? 000100,, + $FVERS ? 000010,, +NJSTRF==<.-JSTRFX>/2 + +; CVSDEC - Converts ASCIZ string to decimal, assumes only digits seen. +; A/ BP to ASCIZ +; Returns value in A, clobbers nothing else. + +CVSDEC: PUSH P,B + PUSH P,C + MOVE C,A + SETZ A, + JRST CVSDC3 +CVSDC2: IMULI A,10. + ADDI A,-"0(B) +CVSDC3: ILDB B,C + JUMPN B,CVSDC2 + POP P,C + POP P,B + POPJ P, + +; CVSSIX - Converts ASCIZ string to SIXBIT word. +; A/ BP to ASCIZ string, +; Returns SIXBIT word in A. Clobbers nothing else. + +CVSSIX: PUSH P,B + PUSH P,C + PUSH P,D + MOVE D,A + SETZ A, + MOVE B,[440600,,A] + JRST CVSSX3 +CVSSX2: CAIL C,140 + SUBI C,40 ; Uppercase force + SUBI C,40 ; cvt to 6bit + IDPB C,B ; deposit + TLNN B,770000 ; If BP at end of word, + JRST CVSSX5 ; leave loop. +CVSSX3: ILDB C,D + JUMPN C,CVSSX2 +CVSSX5: POP P,D + POP P,C + POP P,B + POPJ P, + +; CV6STR - Takes 6bit word in A, writes into FNBUF and makes a string of +; it, returning BP in A. +; Clobbers A,B,T,TT,AA (due to FHCHKZ) + +CV6STR: MOVE B,A +CV6ST2: SETZ A, + LSHC A,6 ; Get a 6bit char + ADDI A,40 ; Make ASCII + IDPB A,FNBWP ; deposit + JUMPN B,CV6ST2 ; Continue until nothing left + PJRST FNCHKZ ; Make output thus far a string. + + +; CVFSIX - Takes current filblk (pointed to by F) and puts the +; right stuff in $F6 entries. + +CVFSIX: PUSH P,A + PUSH P,B + MOVSI B,-L$F6BL +CVFSX2: MOVE A,@CVFTAB(B) ; Get BP to string + PUSHJ P,CVSSIX ; Convert to 6bit + ADDI B,$F6DEV(F) ; Get index to right place to store. + MOVEM A,(B) + SUBI B,$F6DEV(F) ; restore aobjn pointer... + AOBJN B,CVFSX2 + POP P,B + POP P,A + POPJ P, + +CVFTAB: $FDEV(F) + $FNAME(F) + $FEXT(F) + $FDIR(F) +IFN <.-CVFTAB>-L$F6BL, .ERR CVFTAB loses. + +] ; IFN TNXSW + +SUBTTL DEC/TENEX - RUN hacking. (Process FOO! in CCL) +IFN DECSW,[ + +; Process "FOO!", which means "run SYS:FOO with an offset of 1". +; Note that the RUN call needs a block of 6 ACs, but at this point +; it doesn't matter what gets clobbered. + + + ; Entry point for restart, from TSRETN. +RERUN: MOVE B,FSMDAS ; Get name - using SYS:MIDAS + SETZB C,D+1 ; (no ext or ppn) + JRST RFDRU1 + +VBLK + +RFDRUN: MOVE A,$F6DEV(F) ; Load up the 4 filenames to use. + MOVE B,$F6FNM(F) + MOVE C,$F6EXT(F) + MOVE D+1,$F6DIR(F) + JUMPN A,RFDRU3 ; If device specified, use that, + MOVSI A,'DSK ; else default to DSK + CAIN D+1, ; if a PPN was given, and +RFDRU1: MOVSI A,'SYS ; to SYS: otherwise. +RFDRU3: SETZB D,D+2 ; These acs must always be zero... + MOVEI D+3,177 ; Flush all core above this address. +IFN SAILSW,[ + SETZ D+4, + CORE2 D+4, ; Flush hiseg by hand on SAIL. + GOHALT + ] +.ELSE HRLI D+3,1 ; Elsewhere, just set LH to this to flush hiseg. + + MOVE D+4,[RUNCOD,,D+5] ; Move core-less code into position in ACs. + BLT D+4,+LRUNCD-1 + MOVE D+4,[1,,A] ; ,,
+ JRST D+5 ; Go flush core and run program. + +RUNCOD: CORE D+3, ; Flush as much core as possible; RUN uuo can lose + GOHALT ; Because of how much we have. + RUN D+4, + GOHALT +LRUNCD==.-RUNCOD + ; Make sure symbols A-D leave enuf room. +IFL 17-, .ERR RFDRUN ACs lose. +PBLK +] ;END IFN DECSW + +IFN TNXSW,[ + ; On TENEX, we'll do things without compat package (boo hiss) + + ; Entry point for starting new MIDAS, come here from TSRETN. +RERUN: MOVEI F,FB + BLTZ L$FBLK,FB ; Clear out scratch filblk, point at it. + MOVE A,FSMDAS ; Get BP to "MIDAS", store in + MOVEM A,$FNAME(F) ; filblk, and drop thru for defaults. + + ; Here to start up specified program, for CCL hacking. +RFDRUN: TLNN FF,FL20X ; 20X or Tenex? + JRST [ MOVE A,FSSBSY ; Tenex, get BP to SUBSYS string + SKIPN $FDIR(F) ; Unless directory specified, + MOVEM A,$FDIR(F) ; default dir to . + MOVE A,FSSAV ; And do similar thing for ext (.SAV) + JRST RFDRN2] + MOVE A,FSSYS ; 20X, get BP to SYS string + SKIPN $FDEV(F) ; Unless device specified, + MOVEM A,$FDEV(F) ; default dev to SYS:. + MOVE A,FSEXE ; And ditto for ext (.EXE) + +RFDRN2: SKIPN $FEXT(F) ; If extension not specified, + MOVEM A,$FEXT(F) ; Store appropriate one. + PUSHJ P,GETJFI ; Get JFN for input... + GOHALT ; Ugh, bletch, etc. + + ; OK, all ready to smash ACs with loader, etc. + MOVE R1,$FJFN(F) ; Put JFN into RH + HRLI R1,.FHSLF ; and fork handle (self) in LH. + MOVE R2,[RUNCOD,,R3] ; Load into ACs beginning at AC 3 + BLT R2,R3+LRUNCD-1 + JRST R3 ; Off we go, never to return... + + ; Following code is executed in AC's, position independent. +RUNCOD: GET ; Load up the file. + MOVEI R1,.FHSLF + GEVEC ; Find entry vector word for it, returned in AC 2. + JRST R1(R2) ; and go execute instruction in reenter slot. +LRUNCD==.-RUNCOD ; Pretty small loader, huh? +] ; IFN TNXSW + +SUBTTL Core Allocation routine - GCCORQ gets another K for MACTAB + +; Get another K of MACTAB space. + +GCCORQ: MOVE A,MACHI + LSH A,-2 ; Convert to word # + CAIL A,MXMACL ; Want more than allowed? + POPJ P, + MOVE A,MACTND ; No, get addr of block we want to get. + PUSH P,A ; Entry, save A in case have to try again +CORRQ1: +IFN ITSSW,[ + LSH A,-10. + SYSCAL CORBLK,[MOVEI %CBNDR+%CBNDW + MOVEI %JSELF ? A ? MOVEI %JSNEW] + JRST CORRQL ; Lose +] +IFN DECSW,[ + IORI A,1777 + CORE A, + JRST CORRQL ; Lose +] +IFN TNXSW,[ + SKIPN MEMDBG ; Only need to hack if want. + JRST CORRQ3 + ; Super kludge. No way to ask 10X for a "new page"; must + ; get it via default create-on-reference. Hence to get page + ; without bombing, must be sure .ICNXP interrupt deactivated! + PUSH P,T + SYSCAL DIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Deactivate. + SETZM (A) ; Reference 1st page + SETZM 1000(A) ; Reference 2nd page. + SYSCAL AIC,[[.FHSLF] ? [1_<35.-.ICNXP>]] ; Re-activate. + POP P,T +CORRQ3: +] + + REST A + ADDI A,2000 + JRST MACIN2 ; Update pointers to end of MACTAB. + +IFN ITSSW\DECSW,[ + ; Lossage handler for GCCORQ. Only ITS or DEC can fail. +CORRQL: PUSH P,C + PUSH P,D + TLOE AA,400000 + JRST CORQL1 + TYPE " +No core for macro table." +CORQL1: TYPE " +Try again? " +CORQL2: PUSHJ P,TYI ; Get char + CAIL A,140 ; Cheap uppercase force + SUBI A,40 + CAIN A,"Y ; Y, + JRST CORRQA ; => try again + CAIN A,"N ; N, + JRST CORRQB ; => back to DDT then try again + CAIN A,"? ; ?, + ERJ CORQL1 ; => type out error-type blurb + TYPE "? " ; something else + JRST CORQL2 + +CORRQB: +IFN ITSSW,.VALUE ; Loop point for don't-proceed +IFN DECSW,EXIT 1, + TLZ AA,400000 +CORRQA: POP P,D + POP P,C + MOVE A,(P) ; Restore A from PDL + JRST CORRQ1 +] ; IFN ITSSW\DECSW + +SUBTTL CORGET - allocate fresh pages + +; CORGET - Takes arg in AA, an ITS page AOBJN to pages to grab. +; AA/ -<# pages>,,<1st page #> +; Clobbers only AA. + +CORGET: JUMPGE AA,APOPJ ; Ignore arg if nothing to do about it. +IFN ITSSW,[ + SYSCAL CORBLK,[ MOVEI %CBNDR+%CBNDW ; Get both read and write. + MOVEI %JSELF ; Into self + AA ; AA is AOBJN of pages. + MOVEI %JSNEW] ; Want fresh pages. + .LOSE %LSSYS +] +IFN TNXSW,[ + SKIPN MEMDBG ; Ignore anyway if not hacking mem ref debugging. + POPJ P, + PUSH P,R1 + PUSH P,R2 + PUSH P,R3 + MOVE R3,AA + ASH R3,1 ; Get Tenex page AOBJN + MOVEI R1,(R3) + LSH R1,9. ; Get word address of first page. + HRR R3,R1 ; Stick back in AOBJN. + + ; Super kludge. No way to ask 10X for a "new page"; must + ; get it via default create-on-reference. Hence to get page + ; without bombing, must be sure .ICNXP interrupt deactivated! + MOVEI R1,.FHSLF + MOVE R2,[1_<35.-.ICNXP>] + DIC ; Deactivate. +TCORG3: SETZM (R3) ; Get the page. + ADDI R3,777 ; Bump word address, + AOBJN R3,TCORG3 ; and get next page (note adds 1 more to RH) + AIC ; Now re-activate... + POP P,R3 + POP P,R2 + POP P,R1 +] ;IFN TNXSW + POPJ P,