--- /dev/null
+; ******* THERE IS PROBABLY A LOSSAGE INVOLVED IN MAKING 'COMPARE' AN
+; ESSENTIAL QUESTION: IT ONLY WORKS (CAUSING OUTPUT OF REDO EVEN IF
+; COMPARE WASN'T ASKED IN THE COMPILATION TYPE) BECAUSE %ESSEN ISN'T
+; CHECKED IN DOCASK AND PROBABLY SHOULD BE.*****
+
+TITLE NCOMBAT
+
+.SYMTAB 8001.
+
+O=0
+A=1
+B=2
+C=3
+D=4
+E=5
+F=6
+G=7
+H=10
+BK=11 ; STACK OF FROBS FOR CTRL-R
+OBSCEN=12 ; USED IN DOCOMM AS OFFSET INTO CTABLE
+RET=13
+QOFF=14
+OUTPTR=15
+CMPBLK=16
+
+P=17
+.XCREF O,A,B,C,D,E,F,G,H,P
+
+DSKCHN==2
+OUTCHN==3
+TTYO==3
+TTYI==4
+MCFILI==10
+MCINFO==11
+ERRCHN==12
+
+; OFFSETS IN NODES OF QUESTION TREE (POINTED TO BY OBSCEN), CONTAINED IN BLOCK
+; STARTING AT QTREE
+THISQ==0 ; -1, OR OFFSET OF QUESTION ASSOCIATED WITH THIS NODE
+FORKS==1 ; SKIP,,NOSKIP OF INSTRUCTION EXECUTED AT THIS NODE
+INST==2 ; INSTRUCTION TO EXECUTE
+BACK==3 ; WHERE TO BACK UP TO
+
+; BITS IN LH OF THISQ SLOT OF TREE. ONLY MEANINGFUL IF %TNOTQ IS ON.
+%TNOTQ==400000 ; I'M NOT REALLY A QUESTION, SO DON'T SET UP OUTPTR &C.
+%TNBCK==200000 ; YOU CAN'T BACK UP TO ME, SO GO TO MY PREDECESSOR
+%TNMEM==100000 ; DON'T REMEMBER ME: DON'T CLOBBER MY SUCCESSOR'S SLOT AT ALL.
+
+; OFFSETS ON BK STACK
+BKPRPT==-3 ; SAVED PROMPT
+BKRET==-2 ; SAVED RETURN ADDRESS
+BKADDR==-1 ; ADDRESS TO PUSHJ TO
+BKPSAV==0 ; SAVED P-STACK
+
+$SSMAL==100 ; LOWEST SPECIAL TYPE IN TAILOR TABLE
+$FINIS==100 ; SPECIAL IN TAILOR TABLE
+$DELQ==101 ; DELETE QUESTION
+$SQDEF==102 ; SET QUESTION DEFAULT
+$PRTYP==103 ; PRINT CURRENT TYPE
+$CLINK==104 ; LINK TO
+$DLINK==105 ; DELETE LINK
+$XLINK==106 ; EXPAND LINK
+$XXLIN==107 ; EXPAND ALL LINKS
+$LLINK==110 ; LIST LINKS TO ME
+$PLINK==111 ; LIST LINKS FROM ME
+
+; LINK AREA DEFINITIONS
+; FORMAT IS: HEADER IS <- #LINKS HERE>
+; THEN N LINK POINTERS, AS NAME POINTER,,BLOCK POINTER (SO CAN BE USED AS SYMBOL TABLE)
+LNKCNT==5 ; NUMBER OF WORDS ALLOCATED FOR LINKS IN A BLOCK
+LNKHDR==<-LNKCNT>-1 ; OFFSET TO GET LINK HEADER
+LNALEN==LNKCNT+1 ; # OF WORDS IN LINK AREA
+
+; TAILOR TABLE DEFINITONS
+$TSYMBOL==400000
+$TFILE==200000
+
+$TSTR==0
+$TSYM==500000
+$TTF==400000
+$TFIL==300000
+$TFSP==200000
+%GIGNO==40000 ; PRETEND THIS QUESTION DOESN'T EXIST
+%NOQ==10000 ; DON'T SKIP THIS QUESTION EVEN IF CTRL-Q TYPED
+%NSYSD==2000
+%TNMNY==1000
+%ESSEN==400 ; SAYS ALWAYS FROB THIS, REGARDLESS
+%RDCMT==100
+%RDCRT==40
+%KILLB==%NSYSD+%TNMNY+%ESSEN+%RDCRT+%RDCMT+%NOQ
+
+
+; BITS DEFINED IN LH OF WORD 1 IN TAILORED GROUP
+
+%TVERB==400000 ; TAILORING OF VERBOSITY
+%NMRAS==200000 ; ASK 'Another compilation?' QUESTION (0==> ASK)
+%MRANS==100000 ; IF NOT ASK, THE ANSWER (1==> YES)
+%MNVRB==40000 ; INVERSE OF MUDVRB
+%NWFMT==20000 ; NEW FORMAT FILE
+%TFNEX==10000 ; ALLOW ONLY EXISTING FILES FOR INPUT&PRECOMP
+
+; BITS IN LH OF TAILOR BLOCKS (AND QTABLE FOR %TQID)
+
+%TPLEN==301000 ; BITS FOR LENGTH OF BLOCK
+%TQID==220600 ; BITS FOR QUESTION ID
+
+; BITS IN LH OF OUTPUT BLOCK
+
+%DATAH==400000 ; SAYS OUTPUT HERE FROM HOW-TO-RUN ESCAPE
+
+; USED IN CMPBLKS: %ASK SAYS ASK ME, %IGNOR SAYS DON'T ASK ME, %DSUP
+; SAYS (ONLY IN USER TYPES) HE GAVE A DEFAULT WHICH SHOULD BE OUTPUT. TASTEFULLY
+; ENOUGH, THE DEFAULT IS COPIED TO THE OUTPUT BLOCK BEFORE THE QUESTION IS
+; ASKED/IGNORED.
+
+%ASK==400000
+%IGNOR==200000
+%DSUP==100000
+; IN RIGHT HALF, IDENTIFIES SPECIAL COMPILATION TYPES
+$SPTYP==400000
+
+FSPSIZ==6 ; SIZE OF BLOCK FOR FILE NAME
+ITSSIZ==4
+QNUM==-37. ; # OF WORDS IN BLOCK
+CMPSIZ==40.
+CMPLEN==CMPSIZ+LNALEN ; # OF WORDS WITH LINK AREA INCLUDED
+HOWLOC==39. ; OFFSET FOR HOW-TO-RUN TAILOR
+MORLOC==38. ; OFFSET FOR MORE? TAILOR
+
+; OFFSETS INTO BLOCK IN CTABLE
+QTWORD==0
+CTWORD==1
+CTRWRD==2
+CTINST==3
+
+IF1,[ITS==0
+ PRINTC /Combat for ITS? (Y OR N)/
+ .TTYMAC A
+ IFSE A,Y,[ITS==1]
+ TERMIN
+]
+
+IF1,[
+ IFE ITS,[
+ .TNXDF
+ .DECSAV
+]]
+
+\f
+SUBTTL MACRO DEFINITIONS
+
+; CLEAR THE SCREEN
+
+DEFINE SCLEAR
+IFN ITS,[
+ OCTLP "C
+]
+IFE ITS,[
+ PUSHJ P,XCLEAR
+]
+TERMIN
+
+; INTERRUPT ENABLE/DISABLE
+
+DEFINE INTOFF
+IFN ITS,[
+ .SUSET [.SIDF2,,[1_TTYI]]
+]
+IFE ITS,[
+ PUSH P,A
+ MOVEI A,.FHSLF
+ DIR
+ POP P,A
+]
+TERMIN
+
+DEFINE INTON
+IFN ITS,[
+ .SUSET [.SADF2,,[1_TTYI]]
+]
+IFE ITS,[
+ PUSH P,A
+ MOVEI A,.FHSLF
+ EIR
+ POP P,A
+]
+TERMIN
+
+; SKIPS IF WORD IN AC IS >0 AND <3 (FILE NAME OF CTRL-X OR CTRL-Y)
+DEFINE SPNAME AC
+ PUSH P,A
+ MOVE A,AC
+ PUSHJ P,XSPNM
+TERMIN
+
+; SKIPS IF WORD IN AC IS <1 OR >2 (NOT OF SPNAME)
+DEFINE SPNAM1 AC
+ SPNAME AC
+ CAIA
+TERMIN
+
+DEFINE SAVACS
+ JSP RET,SAVAC
+TERMIN
+
+DEFINE RSTACS
+ JSP RET,RSTAC
+TERMIN
+
+; DECREMENT BYTE POINTER
+DEFINE DBP AC
+ ADD AC,[70000,,]
+ TLNE AC,400000
+ ADD AC,[347777,,-1]
+TERMIN
+
+; LIKES FOO TO START AT INITIAL VALUE FOR TABLE. STORES AS VALUE OF SYMBOL
+; FOO, AOSES FOO.
+DEFINE SYMBOL NAME
+ [ASCIZ /!NAME!/],,FOO
+ FOO==FOO+1
+TERMIN
+
+; MAKES SYMBOL WITH SUPPLIED VALUE.
+DEFINE SYMVAL NAME,VALUE
+ [ASCIZ /!NAME!/],,VALUE
+TERMIN
+
+; TAKES LOCATION, SYMBOL. LOCATION GOES INTO DISPATCH TABLE, SYMBOL IS
+; == TO OFFSET INTO DISPATCH TABLE. DSPTBL==.+1 SHOULD PRECEDE DISPATCH
+; TABLE
+DEFINE DISPATCH LOC,VALUE
+ LOC
+ VALUE==.-DSPTBL
+TERMIN
+
+; USED TO MAKE QTABLE.
+DEFINE QUESTION BITS,ID,SYM,NAME
+ IFSN SYM,,[SYM==.-QTABLE]
+ BITS+ID,,[ASCIZ /NAME/]
+TERMIN
+
+; USED TO MAKE OUTSPC (OUTPUT SPECIFICATION TABLE).
+DEFINE OUTPUT TYPE,OFFSET,*HEADER*,TRAILER,NOHDR=0
+ IFN NOHDR,.GO OUT1
+ TYPE,,[ASCIZ /HEADER/]
+ .GO OUT2
+ .TAG OUT1
+ TYPE,,
+ .TAG OUT2
+ OFFSET,,TRAILER
+TERMIN
+
+; USED TO MAKE ERROR TABLE
+DEFINE ERRMAC SYM,STRING\
+ SYM==.-ERRMSG
+ [ASCIZ /!STRING!/]
+TERMIN
+
+; LOSSAGES
+DEFINE FATINS NAME\
+IFN ITS,[
+ .VALUE [ASCIZ /\17:\e\16 FATAL ERROR -- !NAME!\17\e\16
+/]
+]
+IFE ITS,[
+ HALTF
+]
+TERMIN
+
+DEFINE ECHO
+IFN ITS,[
+ .IOT TTYO,A
+]
+IFE ITS,[
+ PBOUT
+]
+TERMIN
+
+
+; MACROS USED ON CTRL-R STACK
+DEFINE BKOFF
+ SUB BK,[4,,4]
+TERMIN
+DEFINE BKON W,X,Y,Z
+ PUSH BK,W
+ PUSH BK,X
+ PUSH BK,Y
+ PUSH BK,Z
+TERMIN
+
+; DEFINE QTREE ENTRIES
+DEFINE QTM SYM,QSYM,SYMYES,SYMNO,INST
+SYM==.
+ QSYM
+ SYMYES,,SYMNO
+ INST
+ 0
+TERMIN
+
+\f
+
+LOC 40
+ 0
+ JSR UUOH
+IFN ITS,[
+ JSR TSINT
+LOC 100
+]
+IFE ITS,[
+LOC 140
+]
+\f
+SUBTTL VARIABLE DEFINITIONS
+
+NMEMHK: 0 ; IF -1, LAST QUESTION ASKED HAD %TNMEM SET IN TREE
+TPFUDG: 0 ; TO GET RIGHT TYPE TABLE AT GCOMTP
+NOSIG: 0 ; DON'T SIGNAL DAEMON IF SET
+WASTAG: 0 ; -1 ==> PRINTING OUT 'WASTE' INSTEAD OF 'PLAN'
+SQDEF: 0 ; SET WHEN SETTING QUESTION DEFAULT
+CHPOS: 0
+CVPOS: 0 ; CURSOR POSITION--USED IN RUBOUT ROUTINES
+MDBKSV: 0 ; MDKILL SAVES BK HERE IN CASE CTRL-R TYPED IN MIDDLE
+MDPDLF: 0
+MDMISF: 0
+MDOVCF: 0 ; ERROR FLAGS
+INREAD: 0 ; IF -1, IN READER
+ITSFXF: 0
+ENDSW: 0
+PRSSYM: 0
+NCOMPF: 0
+PCOMPF: 0
+SSSPPP: 0
+MULFLG: 0 ; USED TO SAY DON'T CRETINIZE
+MNYFLG: 0
+CMPSAV: 0 ; CONTAINS CURRENT COMPILATION TYPE
+OUTBLK: 0 ; CURRENT OUTPUT BLOCK
+OUTSTR: 0 ; FIRST OUTPUT BLOCK: START HERE
+RVALS: 0 ; TAILORING AND HASK SAVE (OUTPTR) HERE
+LONGOT: 0 ; -1 IF MOREING ON
+LSTOUT: 0 ; LAST BLOCK OUTPUT, FOR FOLLOWING THE CHAIN
+DEBUG: 0 ; DEBUGGING SWITCH: OUTPUT TO TTY
+FSTBLK: 0 ; SAYS OUTPUTTING FIRST BLOCK IF -1
+FRETOP: 0
+GCSTOP: 0
+SNAME: 0
+PSNAME: 0 ; SET BY SNAME QUESTION
+PR2SW: -1 ; DEFAULTLY ON: PRINTING OF SEMANTIC PROMPT
+MUDVRB: -1 ; LET MUDCOM PRINT CRAP
+NMORAS: 0 ; DEFAULTLY OFF: ANOTHER COMPILATION? QUESTION
+MORANS: 0 ; ANSWER TO ANOTHER COMPILATION IF NMORAS ON
+DOEND: 0 ; USED IN OTREDO
+ALTER: 0 ; SET BY ALTGRP TO GROUP BEING ALTERED
+CTRLQ: 0 ; SET BY CONTROL-Q HACKER: DEFAULT TO END
+RQUOTE: 0 ; QUOTE NEXT CHARACTER
+INPLEN: 0
+SMEXAC: 0
+XTRCHR: 0
+INPACT: 0
+INPSAV: 0
+SMVAL: 0
+UPTFLG: 0
+SMBEST: 0
+SMBLEN: 0
+SMNUM: 0
+SYMMOD: 0
+JCLINP: 0
+LSTBRK: 0
+UUOD: 0
+UUOE: 0
+UUOSCR: BLOCK 2
+BASE: 0
+TTYOPT: 0
+XCTRUB: 0
+TOERS: 0 ; -1 SAYS ERASE WORKS
+TOFCI: 0 ; -1 SAYS TV KEYBOARD
+MCHANG: -1 ; -1 SAYS NO MUDCOM AROUND
+QVERS: 10 ; SHOULD BE AOSED WHEN QTABLE FROBBED
+JCLPTR: 0
+PRMPT1: 0
+PRMPT2: 0
+CSYMTB: 0
+IFN ITS,[
+VERSIO: .FNAM2
+]
+IFE ITS,[
+VERSIO: .FVERS
+]
+GPSAVE: 0 ; GACK SAVES PRMPT1 HERE
+GPRSAV: 0 ; AND HERE
+NODUMP: 0 ; INHIBIT DUMPING WHEN DO LOAD TAILOR OR REPLACE TAILOR
+LDFLAG: 0 ; IF NON-0, CONS 'UNIQUE' NAME FOR EACH TYPE IN TAILOR
+ERRFLG: 0 ; IF -1, PRINT ERROR WHEN FAIL TO FIND TAILOR FILE
+NAME: BLOCK 6
+MCACS: BLOCK 20
+NAMCNT: 0
+TALSTR: BLOCK 2 ; CONTAINS TAILOR SNAME
+TALSLN: 0 ; CONTAINS # CHARS THEREIN
+
+TALDV: 1,,[ASCIZ /DSK/]
+ 0
+IFN ITS,[
+ 1,,[ASCIZ /%COMBT/]
+]
+IFE ITS,[
+ 1,,[ASCIZ /COMBAT/]
+]
+ 1,,[ASCIZ /TAILOR/]
+ 0
+ 0
+
+TALDEV: SIXBIT /DSK/
+TALSNM: 0
+TALFN1: SIXBIT /%COMBT/
+TALFN2: SIXBIT /TAILOR/
+
+TLSNAM: 0
+FILEXP: -1 ; IF 0, UNFILLED SLOTS IN FILE NAMES ARE LEFT EMPTY
+SPCHR: 0 ; IF NON-ZERO, HAVE CTRL-X OR CTRL-Y HANGING AROUND
+DIDEXP: 0 ; SET TO -1 BY GETFNM WHEN ^X OR ^Y ENCOUNTERED
+
+FILNAM:
+DEVICE: 0
+DIRECT: 0
+FNAME1: 0
+FNAME2: 0
+GENCNT: 0
+ETCETC: 0
+
+SYSDEV: 1,,[ASCIZ /DSK/]
+SYSDIR: 1,,[ASCIZ /CHOMP/]
+IFN ITS,[
+SYSFN1: 1,,[ASCIZ /LOSER/]
+SYSFN2: 1,,[ASCIZ />/]
+SYSGEN: 0]
+IFE ITS,[
+SYSFN1: 0
+SYSFN2: 1,,[ASCIZ /MUD/]
+SYSGEN: 1,,[ASCIZ /0/]
+]
+SYSETC: 0
+
+FILPR2: ASCIZ /(FILE) /
+FSPPR2: ASCIZ /(FILESPEC) /
+STRPR2: ASCIZ /(TEXT) /
+SYMPR2: ASCIZ /(SYM) /
+LINPR2: ASCIZ /(LINE) /
+
+TOPSTK: -40,,PDL-1 ; P FOR EMPTY STACK
+TOPBK: -60,,BKSTK-1
+
+INPBLN==400
+INPBUF: BLOCK INPBLN
+TINBUF: BLOCK INPBLN ; SAVE CONTENTS OF BUFFER DURING GACK
+PATCH: BLOCK 40
+BKSTK: BLOCK 60
+PDL: BLOCK 40
+JCLBUF: BLOCK 20
+MCJCLL==100
+MCJCLB: BLOCK MCJCLL
+
+IFN ITS,[
+SUSETS: .RUNAME,,B
+ .RMEMT,,FRETOP
+ .RSNAME,,A
+ .SMASK,,[%PIATY+%PIPDL]
+SUSET: SUSETS-.,,SUSETS
+]
+IFE ITS,[
+
+XCSCHN==0
+XCBCHN==1
+
+CHNTAB: 1,,XCTRLS ; CHANNEL 0
+ 1,,XCTRLB
+ 0
+ 0
+ 0
+ 0 ; CHANNEL 5
+ 0
+ 0
+ 0
+ 0
+ 0 ; CHANNEL 10
+ 0
+ 0
+ 0
+ 0
+ 0 ; CHANNEL 15
+ 0
+ 0
+ 0
+ 2,,XINFER ; CHANNEL 19
+ 0 ; CHANNEL 20
+ BLOCK 15 ; CHANNEL 21-35
+
+LEVTAB: 0,,PCLEV1
+ 0,,PCLEV2
+ 0
+
+PCLEV1: 0
+PCLEV2: 0
+]
+\f
+SUBTTL TOPLEVEL
+DSTART: SETOM DEBUG
+START: MOVE P,TOPSTK
+ MOVE BK,TOPBK
+ MOVE A,MUMBLE
+ MOVEM A,GCSTOP
+IFN ITS,[
+ MOVE C,SUSET
+ .SUSET C ; UNAME->B, SNAME->A, MEMT->FRETOP
+ HLRES B
+ CAMN B,[-1]
+ .VALUE [ASCIZ /\17:\e\16LOG IN\17\eKILL\16
+/]
+ MOVEM A,TALSNM
+ MOVEM A,TLSNAM
+ PUSHJ P,SIXASC
+ MOVEM A,PSNAME
+ MOVEM A,SYSDIR
+ MOVEM A,SNAME
+]
+IFE ITS,[
+; MOVEI A,15.
+; PUSHJ P,IBLOCK
+; PUSH P,A
+; GJINF
+; HLL B,A
+; HRRO A,(P)
+; DIRST
+; JFCL
+; POP P,A
+; HRLI A,15.
+; MOVEM A,TALSNM
+ SETZM TALSNM
+ SETZM TLSNAM
+ SETZM PSNAME
+ SETZM SYSDIR
+ SETZM SNAME
+]
+ SETZM ERRFLG
+ MOVE A,[ITYPLE,,TYPTBL]
+ MOVEM A,TYPLEN
+ MOVEI A,UTYPTB
+ MOVEM A,UTYPLN
+ PUSHJ P,TTYOPN
+ OASC [ASCIZ /COMBAT./]
+IFN ITS,[
+ OSIX VERSIO
+]
+IFE ITS,[
+ ODEC VERSIO
+]
+ SETZM LDFLAG ; DON'T NEED TO UNIQIFY NAMES
+ PUSHJ P,LDTAIL
+ SETOM ERRFLG
+ PUSHJ P,JCLRED
+ PUSHJ P,MSGRED
+\f
+SUBTTL MAIN QUESTION-ASKING LOOP
+; FIRST SETS UP STUFF FOR CTRL-R, THEN GOES INTO INFINITE LOOP: EXECUTE
+; INSTRUCTION, PROCEDE TO NEXT NODE ACCORDING TO WHETHER INSTRUCTION SKIPPED
+; OR NOT. AT NEXT NODE, CLOBBERS POINTER TO ANCESTOR, TO ENABLE BACKUP TO
+; IT. NOTE THAT IF THE QOFF SLOT AT THE CURRENT NODE IS <0, IT IS ASSUMED
+; THAT BACKUP TO THIS NODE IS IMPOSSIBLE; THEREFORE, BACKUP WILL BE TO
+; WHATEVER IS CONTAINED IN THE BACK SLOT.
+; TASTEFUL, TASTEFUL.
+
+QDOASK: SETZM TPFUDG
+QDOAS1: MOVEI OBSCEN,QTREE
+QDOAS2: PUSH BK,[0] ; NO PROMPT SAVED
+ PUSH BK,[QDOCTR]
+ PUSH BK,[STDBCK]
+ PUSH BK,P ; SET THINGS UP FOR CTRL-R
+QDONXT: SKIPGE A,THISQ(OBSCEN)
+ JRST QNOTQ
+ MOVE QOFF,A
+ MOVE OUTPTR,OUTBLK
+ ADD OUTPTR,A
+ MOVE CMPBLK,CMPSAV
+ ADD CMPBLK,A ; SET UP AC'S IF QUESTION BEING ASKED
+QNOTQ: XCT INST(OBSCEN) ; DO IT
+ JRST QLOST
+ HLRZ A,FORKS(OBSCEN)
+ JRST QNEXT
+QLOST: HRRZ A,FORKS(OBSCEN)
+QNEXT: SKIPL B,THISQ(OBSCEN) ; A REAL QUESTION?
+ JRST QADV
+ TLNE B,%TNMEM
+ JRST QADV1
+ TLNN B,%TNBCK ; UNREAL QUESTION: DON'T BACK UP TO ME
+ JRST QADV
+ MOVE OBSCEN,BACK(OBSCEN) ; YES, SO DON'T BACK UP TO IT
+QADV: MOVEM OBSCEN,BACK(A) ; WHERE TO BACK UP TO
+QADV1: MOVE OBSCEN,A ; CLOBBER POINTER
+ JRST QDONXT ; AND GO TO THE NEXT ONE
+
+; RETURN FROM CTRL-R
+QDOCTR: JRST QDOAS2
+ JRST QDONXT ; RETURN FROM ^G ^R
+
+\f
+SUBTTL ASK WHICH COMPILATION TYPE
+; PUSHJ P, TO HERE TO GET A COMPILATION TYPE. IF A SPECIAL TYPE, DOESN'T
+; SKIP; IF NORMAL (QUESTIONS TO BE ASKED), DOES.
+GCOMTP: MOVE A,TYPLEN
+ SUB A,TPFUDG ; SET BY MORCMP TO 1,,1 IN SOME CASES
+ MOVEI B,[ASCIZ /Type of compilation /]
+ MOVEM B,PRMPT1
+ PUSHJ P,COMTYP ; GET COMPILE TYPE NAME,,TABLE FOR IT IN A
+ MOVE CMPBLK,A ; COMPILATION TYPE
+ TRZE A,$SPTYP ; SKIPS IF NON-SPECIAL COMPIL TYPE
+ JRST [PUSHJ P,@SPTYPE(A) ; SPTYPE IS DISPATCH TABLE FOR LOAD, PRINT,ETC.
+ POPJ P,]
+ PUSHJ P,LINKX ; EXPAND LINKS
+ MOVEI A,CMPSIZ+2 ; GET CORE FOR COMPILATION--POINTER IN A
+ PUSHJ P,IBLOCK
+ SETOM FILEXP ; CAUSE FILE NAMES TO BE EXPANDED IN PARSER
+ SKIPE MNYFLG ; IF 'MANY', CHAIN THIS BLOCK TO PREVIOUS BLOCK
+ JRST [MOVE OUTPTR,OUTBLK
+ MOVEM A,CMPSIZ+1(OUTPTR) ; POINTER GOES IN LAST WORD OF BLOCK
+ JRST OTINIT]
+ MOVEM A,OUTSTR ; IF NOT MANY MODE SAVE BLOCK: 1ST IN CHAIN
+OTINIT: MOVEM A,OUTBLK ; SAVE POINTER TO TOP OF OUTPUT BLOCK
+ MOVEM A,OUTPTR ; AC POINTER TO CURRENT OUTPUT SLOT
+ MOVEM CMPBLK,CMPSIZ(OUTPTR) ; SAVE COMPILATION TYPE WITH OUTPUT BLOCK
+ MOVEM CMPBLK,CMPSAV
+ SETZM CTRLQ ; NOT IN CTRLQ ANY MORE
+ JRST POPJ1 ; AND SKIP
+\f
+SUBTTL NORMAL QUESTIONS
+; PUSHJ P, TO HERE TO ASK NORMAL SORTS OF QUESTIONS. ASSUMES CMPBLK, QOFF, OUTPTR
+; SET UP APPROPRIATELY. SKIPS IF ANSWER GIVEN OR (IN CASE OF T/F) IF TRUE GIVEN.
+
+ASKQ: SETZM FASKQS
+ASKQ1: MOVE B,(CMPBLK)
+ MOVE A,QTABLE(QOFF) ; GET QUESTION DESCRIPTION
+ TLNE A,%GIGNO ; DOES THE QUESTION REALLY EXIST?
+ POPJ P, ; NO, GO ON TO NEXT
+ SKIPE CTRLQ ; CTRL-Q TYPED IN THIS COMPILATION
+ JRST QUACK
+NOQ: TLNE B,%IGNOR ; DOES LOSER WANT THIS QUESTION ASKED?
+ JRST DEFHAK ; NO, DEFAULT
+ TLNE A,$TFILE ; SKIP IF NOT FILE-SPEC
+ JRST [PUSHJ P,DEFILE ; SETS UP FILE DEFAULTS, SETS SYS DEFAULTS
+ JRST ASKMNY]
+ PUSHJ P,NRMDEF ; DOESN'T SKIP RETURN--SETS UP OTHER DEFAULTS
+ASKMNY: MOVE A,QTABLE(QOFF)
+ TLNE A,%TNMNY ; SKIP THIS QUESTION IF IN MANY MODE
+ JRST [SKIPN MNYFLG ; IN MANY MODE?
+ JRST ASKER
+ POPJ P,]
+ASKER: TLNE A,$TTF
+ JRST TFASK ; HACK FOR T/F, SINCE COMPLETION MAY SCREW IT UP
+ PUSHJ P,ASK ; ASK THE QUESTION
+ POPJ P, ; IF HE TYPED NOTHING?
+ JRST POPJ1
+TFASK: PUSHJ P,ASK
+ JFCL
+ HRRZ A,(OUTPTR) ; GET ANSWER
+ JUMPN A,POPJ1 ; IF ANSWERED YES
+ POPJ P,
+
+; HERE FOR CERTAIN FILE QUESTIONS WHICH WANT TO SEE IF FILE EXISTS WHEN
+; GIVEN (USED FOR INPUT, PRECOMPILATION). CALLS ASKQ, DOES FUNNINESS IF
+; IT SKIPS.
+FASKQ: SETOM FASKQS'
+ PUSHJ P,ASKQ1
+ JRST [MOVE A,QTABLE(QOFF)
+ TLNN A,%ESSEN
+ POPJ P,
+ JRST FASKQ1]
+ AOS (P)
+FASKQ1: MOVE B,(OUTPTR) ; POINTER TO FILE NAME
+
+IFN ITS,[
+ PUSH P,B
+ MOVE A,(B)
+ PUSHJ P,ASCSIX
+ PUSH P,A
+ MOVE A,1(B)
+ PUSHJ P,ASCSIX
+ PUSH P,A
+ MOVE A,2(B)
+ PUSHJ P,ASCSIX
+ PUSH P,A
+ MOVE A,3(B)
+ PUSHJ P,ASCSIX
+ .CALL [SETZ
+ SIXBIT /OPEN/
+ [.BII,,DSKCHN]
+ MOVE -2(P)
+ MOVE (P)
+ MOVE A
+ SETZ -1(P)]
+ JRST FASKQL
+FASKQE: SUB P,[4,,4]
+ .CLOSE DSKCHN,
+ POPJ P,
+
+FASKQL: SKIPE FILEXI
+ JRST FASKQE
+ SUB P,[3,,3]
+ OASCR [0]
+ OASC [ASCIZ /WARNING: Open of /]
+ POP P,A
+ PUSHJ P,NFNAME
+ OASCI 40
+ PUSH P,[RNDFAL]
+ JRST ERRPR1
+]
+IFE ITS,[
+ SKIPN FILEXI ; IF THE MUST EXIST FLAG IS SET
+ POPJ P, ; THEN DON'T DO ANYTHING - HE'S BEEN TOLD
+ PUSH P,B ; SAVE FILE NAME POINTER
+ SKIPN JFN ; HM. THIS IS A DEFAULT, CHOMP!
+ JRST FASKQ3
+ MOVEI A,20. ; GET A BLOCK FOR JFNS
+ PUSHJ P,IBLOCK
+ HRROS A
+ PUSH P,A
+ MOVE B,JFN' ; GET BACK THE FUNNY JFN
+ SETZ C,
+ SETZ D,
+ JFNS ; GET THE REAL STRING
+ MOVSI A,(GJ%OLD+GJ%SHT)
+ POP P,B
+ PUSHJ P,ECHON
+ GTJFN ; GET A REAL FILE-OPENING JFN
+ JRST FASKQ2
+ PUSHJ P,ECHOFF
+FASKQ4: MOVE B,[440000,,OF%RD]
+ OPENF
+ JRST FASKQ2
+ CLOSF
+ JFCL
+ POP P,A
+ POPJ P,
+
+FASKQ2: SKIPE FILEXI
+ JRST POPAJ ; DONT COMPLAIN IF FLAGS SET
+ PUSHJ P,ECHOFF
+ OASCR [0]
+ OASC [ASCIZ /WARNING: Open of /]
+ POP P,A
+ PUSHJ P,NFNAME
+ OASCR [ASCIZ / failed./]
+ POPJ P,
+
+FASKQ3: MOVE C,[-4,,GTJFN3+.GJDEV]
+ HRRO D,(B)
+ MOVEM D,(C)
+ AOJ B,
+ AOBJN C,FASKQ3+1
+ SETZ B,
+ MOVEI A,GTJFN3
+ GTJFN
+ JRST FASKQ2
+ JRST FASKQ4
+
+ECHON: SAVACS
+ MOVEI A,.PRIOU
+ RFCOC
+ SKIPE RFCOC1
+ JRST ECHON1
+ MOVEM B,RFCOC1
+ MOVEM C,RFCOC2
+ECHON1: TLO C,24 ;MAKE ^X AND ^Y WORK
+ SFCOC
+ RSTACS
+ SETOM ECHFLG'
+ POPJ P,
+
+ECHOFF: SKIPN ECHFLG
+ POPJ P,
+ SETZM ECHFLG
+ SAVACS
+ MOVEI A,.PRIOU
+ MOVE B,RFCOC1
+ MOVE C,RFCOC2
+ SFCOC
+ RSTACS
+ POPJ P,
+
+RFCOC1: 0
+RFCOC2: 0
+]
+\f
+
+; HACKER WHEN IN CTRLQ MODE: A HAS QTABLE SLOT, B HAS CMPBLK SLOT
+QUACK: TLNE A,$TFILE ; FILE-TYPE QUESTION?
+ JRST QFILE
+QDEFLT: TLNE A,%NOQ ; ASK THIS EVEN IF CTRL-Q TYPED
+ JRST NOQ
+ HRRZ B,(CMPBLK) ; DO DEFAULT
+ MOVEM B,(OUTPTR)
+ TLNE A,%DSUP
+ POPJ P,
+ JRST POPJ1
+QFILE: TLNE A,%DSUP+%ESSEN ; IF USER SUPPLIED DEFAULT, ESSENTIAL, DO THAT.
+ JRST [PUSHJ P,DEFILE
+ JRST POPJ1]
+ SETZM (OUTPTR)
+ POPJ P,
+\f
+; ASK SNAME QUESTION: GET STRING, CONVERT TO SIXBIT AND STUFF IN PSNAME
+
+ASKSNM: MOVE B,(CMPBLK)
+ PUSHJ P,NRMDEF ; PICK UP DEFAULT
+ SKIPE CTRLQ
+ JRST ASNMDO
+ TLNE B,%IGNOR
+ JRST ASNMDO ; PICK UP DEFAULT AND LEAVE
+ PUSHJ P,ASK ; ASK THE QUESTION
+ JFCL
+ASNMDO: PUSHJ P,ASNMD1
+ POPJ P,
+
+; CALLED FROM HERE AND FROM HASK (HSNAM)
+ASNMD1: HRRZ A,(OUTPTR) ; GET THE ANSWER
+ JUMPE A,CPOPJ ; IF 0, LET IT GO
+ HRLI A,440700 ; BP TO ANSWER
+ PUSH P,A ; SAVE IT
+ MOVEI A,20
+ PUSHJ P,IBLOCK ; GET ANOTHER BLOCK CORRECT LENGTH
+ MOVE B,A
+ HRLI B,440700 ; MAKE BP TO NEW BLOCK
+ POP P,A
+ PUSH P,B
+ HRLM C,(P) ; WORD COUNT
+ASNMLP: ILDB O,A ; GET A CHAR
+ CAIN O,";
+ JRST ASNMDN ; ; TERMINATES
+ CAIN O,""
+ JRST ASNMLP ; IGNORE "
+ JUMPE O,ASNMDN
+ CAIE O,"
+ CAIN O,11
+ JRST ASNMDN ; FALL OUT
+ CAIN O,^Q
+ ILDB O,A
+ CAIL O,"a
+ SUBI O,40
+ IDPB O,B
+ TLNE B,770000
+ JRST ASNMLP
+ASNMDN: POP P,A
+ SKIPN (A)
+ POPJ P, ; DIDN'T GET ANYTHING
+ MOVEM A,SYSDIR
+ MOVEM A,PSNAME ; SAVE RESULT AWAY
+ POPJ P, ; AND LEAVE
+
+
+\f
+SUBTTL GET HOW-TO-RUN
+; AFTER ALL QUESTIONS HAVE BEEN ASKED, COME HERE TO DETERMINE HOW-TO-RUN.
+; NORMALLY WILL PRINT OUT PLAN, POSSIBLY SIGNAL DAEMON, ETC. IF 'QUESTION'
+; ESCAPE IS USED, WILL SKIP-RETURN; QUESTION ESCAPE IS NEXT IN TREE. OTHERWISE,
+; WILL NOT SKIP; IN THIS CASE, (ASSUMING WE GET BACK HERE AT ALL), QUESTIONING
+; WILL CONTINUE WITH ANOTHER COMPILATION TYPE.
+DONE: MOVE A,OUTBLK ; PICK UP POINTER TO TOP OF CURRENT CMPBLK
+ MOVE A,CMPSIZ(A)
+ MOVE A,HOWLOC(A) ; GET HOW TO RUN SPEC
+ TLNN A,%ASK ; ASK?
+ JRST HOWGO
+DONE1: MOVE A,[HOWTLN,,HOWTBL] ; ASK HOW TO RUN: PTLONG JRST HERE, TOO.
+ MOVEI B,[ASCIZ /How to Run /]
+ MOVEM B,PRMPT1
+ PUSHJ P,COMTYP ; ANSWER IN A
+HOWGO: PUSHJ P,@HOWRUN (A) ; GO TO PROPER ROUTINE FOR FROBBING PLAN OUT
+; PCOMP WILL START UP & DIE IF APPROPRIATE, COMBAT WILL DEMSIG ZONE IF APPROPRIATE
+; RETURN HERE IFF IN MANY OR LOSER SAYS HE HAS MORE. MNYFLG SET APPROPRIATELY.
+; IN MANY, WILL STRING OUTBLKS TOGETHER; IN MULTIPLE, WILL WASTE. QUESTION MODE
+; SKIP RETURNS, AND DOES NOTHING ELSE.
+ JRST [SETZM BACK(OBSCEN)
+ POPJ P,]
+ JRST POPJ1
+ JRST DONE1 ; HPRTHK SKIPS TWICE, SO WE LOOP BACK
+
+\f
+SUBTTL DEFAULT HACKERS
+; IF QUESTION IS NOT TO BE ASKED, MOVES DEFAULTS OVER TO OUTPUT BLOCK. NORMALLY
+; PICKS UP RIGHT HALF OF CMPBLK WORD, STUFFS IT IN OUTBLK. SPECIAL HACKING FOR
+; FILE NAMES.
+DEFHAK:
+IFE ITS,[
+ SETZM JFN
+]
+ TLNE A,$TFILE ; SPECIAL HACKING FOR FILE NAMES
+ JRST [PUSHJ P,DEFILE
+ JRST RDEF]
+ HRRZ A,(CMPBLK)
+ HRRM A,(OUTPTR) ; SMASH SUPPLIED DEFAULT INTO OUTPUT BLOCK
+RDEF: MOVE B,(CMPBLK)
+ TLNE B,%DSUP ; DID HE REALLY GIVE AN ANSWER?
+ JRST POPJ1 ; YES, SO SKIP RETURN
+ POPJ P,
+
+; PRETENDS TO ASK FILE QUESTION IF DEFAULT SUPPLIED. FILLS IN THINGS NOT SUPPLIED
+; FROM SYSTEM DEFAULTS (UNLESS %NSYSD), AND SETS SYSTEM DEFAULTS WHERE THINGS SUPPLIED.
+DEFILE: HRRZ A,(CMPBLK) ; IF NO DEFAULT HERE, GO TO HAKFIL, WHICH
+ JUMPE A,HAKFIL ; (IF %ESSEN) WILL GET THE DEFAULTS FROM VTABLE
+ PUSHJ P,FILDEF ; STUFF IN DEFAULTS IF SUPPLIED
+
+; SETS SYSTEM DEFAULTS, FILLS IN SUPPLIED DEFAULT FROM SYSTEM DEFAULTS, UNLESS %NSYSD.
+SETDEF: MOVE A,QTABLE(QOFF)
+ TLNE A,%NSYSD ; NO SYS DEFAULTS?
+ POPJ P, ; YES. GO AWAY.
+ MOVE A,(OUTPTR) ; MAKE AOBJN POINTER TO OUTPUT FILE NAME
+ HRLI A,-FSPSIZ
+ MOVEI C,SYSDEV-1 ; GET POINTER TO SYSTEM DEFAULTS
+ SETZM DIDEXP
+DEFLP: AOJ C,
+ SKIPN B,(A) ; SKIP IF NON-ZERO (==> EXISTS OR ^X,^Y) ENTRY
+ JRST DEFSYS ; ZERO-->USE SYS DEFAULT
+ PUSHJ P,GETFNM ; EXPAND CTRL-X, CTRL-Y
+ MOVEM B,(A) ; STUFF EXPANDED NAME OUT
+ MOVEM B,(C) ; SET SYSTEM DEFAULT
+ JRST DEFLPE ; AND TRY AGAIN
+DEFSYS: MOVE B,(C)
+ MOVEM B,(A)
+DEFLPE: AOBJN A,DEFLP
+ SKIPN DIDEXP
+ POPJ P,
+ SETZM DIDEXP
+ MOVE A,(CMPBLK)
+ TLNE A,%ASK ; QUESTION IS BEING ASKED, SO DON'T PRINT
+ POPJ P,
+ HRRZ A,QTABLE(QOFF)
+ OASCR [0]
+ OASC (A)
+ OASC [ASCIZ / /]
+ MOVE A,(OUTPTR)
+ PUSHJ P,NFNAME
+ POPJ P,
+
+; HERE TO DO 'RIGHT THING' IF %IGNOR & %ESSEN ARE
+; SET AND FOR FILE NAME: GET THE DEFAULT ANYWAY
+; JRSTED TO FROM DEFILE. RETURNS TO SETDEF
+HAKFIL: MOVEI A,FSPSIZ
+ PUSHJ P,IBLOCK
+ MOVEM A,(OUTPTR)
+ MOVE A,QTABLE(QOFF)
+ TLNN A,%ESSEN ; NOT ESSENTIAL, SO LEAVE
+ POPJ P,
+ PUSH P,CMPBLK
+ MOVEI CMPBLK,VTABLE(QOFF) ; GET DEFAULT FROM VTABLE
+ PUSHJ P,FILDEF ; SET IT UP
+ POP P,CMPBLK
+ JRST SETDEF ; BACK
+
+; EXPECTS POINTER TO OUTPUT SLOT IN OUTPTR, TO CMPBLK SLOT IN CMPBLK. BLTS
+; COPY OF FILE-DEFAULTS SUPPLIED IN CMPBLK TO A NEW BLOCK, PUTS POINTER TO
+; SAME IN OUTPUT SLOT. IF NO DEFAULT GIVEN, WILL LEAVE OUTPUT SLOT POINTING AT
+; FOUR WORDS OF ZERO.
+FILDEF: MOVEI A,FSPSIZ
+ PUSHJ P,IBLOCK
+ MOVEM A,(OUTPTR) ; POINTER TO FILE-NAME BLOCK
+ HRLZ B,(CMPBLK) ; POINTER TO DEFAULT
+ JUMPE B,POPJ1 ; NO DEFAULT SUPPLIED, TOO BAD.
+ HRR B,A ; POINTER TO NEW BLOCK
+ BLT B,FSPSIZ-1(A) ; MOVE 'EM OVER
+ POPJ P,
+
+; DOES DEFAULT IN SIMPLE (NON FILE-NAME) CASE: PICK IT UP AND PUT IT BACK DOWN.
+NRMDEF: HRRZ A,(CMPBLK)
+ MOVEM A,(OUTPTR)
+ POPJ P,
+
+\f
+
+; HACK CONTROL-G
+GACK: MOVE O,PRMPT1
+ TLNE O,700000 ; SKIPS IF THIS IS A STRING TYPE
+ JUMPN C,RCMDL ; MUST BE FIRST CHARACTER TYPED IF NOT
+ TLNE O,%RDCMT ; CONTROL-G ALLOWED?
+ JRST [OASCR [ASCIZ /^G disabled/]
+ JRST RREPEA] ; MAKE IT LIKE CONTROL-D IF NOT
+ TLNN O,700000
+ PUSHJ P,SINBUF ; COPY INPUT BUFFER IF STRING TYPE
+ PUSH BK,O
+ PUSH BK,-3(BK) ; SAME RETURN ADDRESS AS BEFORE
+ AOS (BK) ; PLUS 1
+ PUSH BK,[[POPJ P,]] ; ALWAYS SKIP, DO NOTHING
+ PUSH BK,-3(BK) ; SAME STACK
+ MOVEM O,GPSAVE
+ MOVEM O,GPRSAV
+ PUSH P,B
+ PUSH P,C ; SAVE BUFFER POINTER AND COUNT
+ MOVEI B,[ASCIZ /Get from type /]
+ PUSH P,PRMPT1
+ PUSH P,PRMPT2
+ PUSHJ P,GETTP1 ; GET GROUP IN A
+ JRST [BKOFF
+ POP P,PRMPT2
+ POP P,PRMPT1
+ SUB P,[2,,2] ; FLUSH SAVED BUFFER
+ JRST RSTBF1] ; COMES HERE IF NO TYPES EXIST
+ POP P,PRMPT2
+ POP P,PRMPT1
+ PUSH P,CMPBLK
+ MOVE CMPBLK,A ; STUFF INTO CMPBLK
+ PUSHJ P,LINKX ; EXPAND LINKS
+ MOVE A,CMPBLK
+ POP P,CMPBLK
+ SETZM SYMMOD
+ ADDI A,(QOFF) ; GET REAL CMPBLK SLOT
+ MOVE D,(A) ; GET CONTENTS OF BLOCK IN D
+ TLNN D,%DSUP ; USER-SUPPLIED DEFAULT HERE?
+ JRST [OASC [ASCIZ /Type doesn't define this slot./]
+ BKOFF
+ SUB P,[2,,2]
+ JRST RSTBF1]
+ HRRZS D
+ LDB B,[410300,,GPSAVE] ; GET TYPE OF INPUT
+ SETOM GPSAVE
+ OASC [ASCIZ / /]
+ JRST @GETTBL (B) ; GO TO APPROPRIATE ROUTINE
+
+GETTBL: GETSTR
+ BADTYP
+ GETFIL
+ GETFIL
+ GETTF
+ GETTF
+ BADTYP
+ BADTYP
+
+GETOUT: BKOFF
+ SKIPN P,BKPSAV(BK) ; ????????
+ MOVE P,TOPSTK
+ AOBJN P,.+1
+ SKIPN GPSAVE
+ POPJ P, ; SO FILE-HACKERS CAN NOT SKIP-RETURN
+ JRST POPJ1
+
+GETTF: MOVEM D,(OUTPTR)
+ OASCR HLPTF(D)
+ JRST GETOUT
+
+; PUTS STUFF IN INPUT BUFFER, LETS PERSON EDIT/CONFIRM/ETC.
+; ENTERS WITH BLOCK POINTER IN D (ALSO (A)), MUST LEAVE (TO REPPER)
+; WITH C CONTAINING # CHARACTERS, B CONTAINING BPTR TO LAST CHAR.
+
+GETSTR: BKOFF
+ PUSHJ P,RINBUF
+ POP P,C
+ POP P,B ; RESTORE BUFFER
+ MOVE O,GPRSAV
+ MOVEM O,PRMPT1
+ HRLI D,440700
+GETSTL: ILDB A,D
+ JUMPE A,REPPER ; STRING IS ASCIZ
+ IDPB A,B
+ AOJA C,GETSTL
+
+GETFIL: JUMPE D,GETFLS ; OLD IN D
+ MOVEI A,FSPSIZ
+ PUSHJ P,IBLOCK
+ MOVEM A,(OUTPTR) ; NEW IN A
+ HRLI A,-FSPSIZ
+ MOVEI B,SYSDEV ; SYS IN B
+ MOVEI C,CHRTBL
+GFILLP: SKIPN E,(D)
+ MOVE E,(B)
+ MOVEM E,(B) ; SET SYS DEFAULT
+ MOVEM E,(A) ; PUT IN OUTBLK
+ OASC (E) ; PRINT
+ OASC (C) ; PRINT BREAK CHARACTER
+ AOJ C,
+ AOJ D,
+ AOJ B,
+ AOBJN A,GFILLP
+ OASCR [0]
+ JRST GETOUT
+GETFLS: SETZM (OUTPTR)
+ SETZM GPSAVE
+ JRST GETOUT
+
+; HACK CONTROL-R
+RACK: SETZM CTRLQ ; CLOBBER CTRLQ
+ SETZM INREAD ; NOT IN READER ANY MORE
+ SKIPE A,BKPRPT(BK) ; PROMPT?
+ MOVEM A,PRMPT1 ; RESTORE IT
+ PUSHJ P,@BKADDR(BK) ; FROB AWAY
+ MOVE P,BKPSAV(BK)
+ MOVE A,BKRET(BK)
+ BKOFF ; FLUSH THIS ONE
+ JRST (A) ; BYE-BYE
+
+; STANDARD ROUTINE FOR BACKING UP IN QUESTIONS
+STDBCK: SKIPL THISQ(OBSCEN)
+ SETZM (OUTPTR) ; DON'T FORGET THIS QUESTION
+STDBC1: SKIPN OBSCEN,BACK(OBSCEN) ; BACKUP IS 0?
+ JRST TOPLEV ; FLUSH EVERYTHING
+ MOVE C,THISQ(OBSCEN) ; PICK UP QUESTION OFFSET
+ CAMN C,[-1] ; NOT A QUESTION
+ JRST STDBC1
+ JUMPL C,CPOPJ ; A 'SYSTEM QUESTION'; ALWAYS STOP
+ MOVE B,QTABLE(C) ; THIS QUESTION
+ TLNE B,%GIGNO
+ JRST STDBC1 ; QUESTION IS GLOBALLY OFF, SO CAN'T STOP HERE
+ MOVE OUTPTR,OUTBLK
+ ADD OUTPTR,C
+ SETZM (OUTPTR) ; CLOBBER SLOT IN OUTPUT BLOCK
+ MOVE CMPBLK,CMPSAV
+ ADD CMPBLK,C ; POINTER TO COMPILE TYPE SLOT
+ MOVE A,(CMPBLK)
+ TLNN A,%ASK ; ASK THIS QUESTION?
+ JRST STDBC1
+ POPJ P, ; YES, DONE
+
+TOPLEV: MOVE P,TOPSTK
+ MOVE BK,TOPBK
+ SETZM MDBKSV
+ SETZM INREAD
+ SKIPN MNYFLG ; IF IN MANY MODE, ONLY KILL THIS ONE
+ JRST QDOAS1 ; ASK COMPILATION TYPE
+
+; AT THIS POINT, WE KNOW THAT THERE ARE AT LEAST TWO OUTPUT BLOCKS ON THE CHAIN,
+; AND THAT THE LAST ONE WANTS TO BE ABORTED. TO DO THIS, IT IS NECESSARY TO MAKE
+; OUTBLK POINT TO THE NEXT-TO-LAST OUTPUT BLOCK (WHICH NOW POINTS TO THE LAST ONE),
+; AND TO ZERO THE NEXT BLOCK POINTER IN IT.
+ MOVE A,OUTSTR ; FIRST BLOCK
+ MOVE B,OUTBLK ; LAST BLOCK
+TOPLOP: MOVE O,CMPSIZ+1(A) ; POINTER TO NEXT BLOCK
+ CAIN O,(B) ; IS THE 'NEXT BLOCK' THE LAST ONE?
+ JRST TOPLOT
+ MOVE A, ; ADVANCE POINTER
+ JRST TOPLOP
+TOPLOT: MOVEM A,OUTBLK ; SAVE AWAY WINNING POINTER
+ SETZM CMPSIZ+1(A) ; ZERO ITS NEXT-BLOCK POINTER
+ JRST QDOAS1 ; AND LEAVE
+
+\f
+SUBTTL MUDCOM INTERFACE
+
+MCASCI: HRLI D,440700
+ ILDB F,D
+ JUMPE F,CPOPJ
+ IDPB F,C
+ JRST .-3
+
+
+; PUSHJ P,MCFILE
+; STUFF AN ENTIRE FILE NAME INTO THE JCL BUFFER
+; IN B, A POINTER TO A FILE BLOCK
+; IN C, BYTE POINTER TO JCL BUFFER
+
+IFN ITS,[
+MCFILE: MOVE D,(B)
+ PUSHJ P,MCASCI
+ MOVEI D,":
+ IDPB D,C
+ MOVE D,1(B)
+ PUSHJ P,MCASCI
+ MOVEI D,";
+ IDPB D,C
+ MOVE D,2(B)
+ PUSHJ P,MCASCI
+ MOVEI D,40
+ IDPB D,C
+ MOVE D,3(B)
+ PUSHJ P,MCASCI
+ POPJ P,
+]
+IFE ITS,[
+MCFILE: MOVE A,B
+ PUSHJ P,XFNEXP ; EXPAND FILE NAME
+ JRST MCFNF
+ HRLI A,440700
+MCFIL1: ILDB D,A
+ JUMPE D,CPOPJ
+ IDPB D,C
+ JRST MCFIL1
+
+MCFNF: OASC [ASCIZ /File not found - /]
+ MOVE A,B
+ PUSHJ P,NFNAME
+ OASCR [0]
+ SUB P,[1,,1]
+ POPJ P,
+]
+
+; PUSHJ P,MUDCOM
+; IN A, A POINTER TO A FILE NAME BLOCK (FROM COMPARE QUESTION)
+; OR 0, IF NO NAME GIVEN
+
+MUDCOM: OASC [ASCIZ /
+ Comparing.../]
+ SETZM MCJCLB
+ MOVE B,[MCJCLB,,MCJCLB+1]
+ HLRZ C,B
+ BLT B,MCJCLL-1(C) ; CLEAR JCL BLOCK
+ MOVE C,[440700,,MCJCLB] ; POINTER TO JCL BLOCK
+ SKIPN -1(OUTPTR) ; YES OR NO TO MANIFEST QUESTION?
+ JRST MUDJCL ; NO
+IFN ITS,[
+ MOVEI O,"/
+ IDPB O,C
+ MOVEI O,"M
+ IDPB O,C
+ MOVEI O,"
+ IDPB O,C
+]
+MUDJCL:
+IFE ITS,[
+ MOVEI O,"
+ IDPB O,C
+]
+ SKIPN B,(OUTPTR) ; EXTRA JCL?
+ JRST MUDFIL ; NO
+ HRLI B,440700
+MUDJLP: ILDB O,B
+ JUMPE O,MUDFI1 ; DONE?
+ IDPB O,C
+ JRST MUDJLP
+MUDFI1: MOVEI O,"
+ IDPB O,C
+MUDFIL: MOVE B,-2(OUTPTR) ; POINTER TO COMPARE FILE BLOCK
+ MOVE D,3(B) ; FILE NAME 2
+ MOVE D,(D) ; POINTER TO ASCIZ OF FILE NAME 2
+ CAMN D,[ASCIZ /NBIN/] ; NBIN HACK?
+ JRST [MOVE B,OUTBLK ; YES, DO FILES IN OTHER ORDER
+ MOVE B,.QINP(B)
+ PUSHJ P,MCFILE
+ MOVEI D,",
+ IDPB D,C
+ MOVE B,-2(OUTPTR)
+ PUSHJ P,MCFILE
+ SETZM -2(OUTPTR)
+ JRST MUDRDY]
+ PUSHJ P,MCFILE ; STUFF IT OUT
+ SETZM -2(OUTPTR) ; AND ZERO IT
+ MOVEI D,", ; DEPOSIT A COMMA
+ IDPB D,C
+ MOVE B,OUTBLK ; POINTER TO INPUT FILE BLOCK
+ MOVE B,.QINP(B)
+ PUSHJ P,MCFILE ; PUT INPUT FILE INTO BLOCK
+MUDRDY: SETZ D,
+ IDPB D,C ; FINISH THE JCL BLOCK
+IFN ITS,[
+MUDSTT: .CALL [SETZ ; OPEN TS MUDCOM
+ SIXBIT /OPEN/
+ MOVSI .BII
+ MOVEI MCFILI
+ [SIXBIT /DSK/]
+ [SIXBIT /TS/]
+ [SIXBIT /MUDCOM/]
+ SETZ [SIXBIT /SYS/]]
+ .LOSE 1000
+ SETZM MCHANG ; SAY INFERIOR EXISTS
+ .CALL [SETZ ; OPEN THE INFERIOR
+ SIXBIT /OPEN/
+ MOVSI .BIO
+ MOVEI MCINFO
+ [SIXBIT /USR/]
+ [0]
+ SETZ [SIXBIT /MUDCOM/]]
+ JRST [SETOM MCHANG
+ PUSH P,[RACK] ; SO ERRPRT WILL RETURN TO WINNAGE
+ PUSH P,[INFFAL]
+ JRST ERRPRT]
+ .RESET MCINFO,
+ .CALL [SETZ ; GET IT A PAGE ONE
+ SIXBIT /CORBLK/
+ MOVEI 400000
+ MOVEI MCINFO
+ MOVEI
+ SETZI -5]
+ .LOSE 1000
+ .USET MCINFO,[.RINTB,,RET] ; READ THE INTERRUPT WORD
+ .SUSET [.SIMSK2,,RET] ; SET UP INTERRUPT FOR THIS
+ .ACCESS MCINFO,[100] ; GO TO 100
+ MOVE B,[-MCJCLL,,MCJCLB]
+ .IOT MCINFO,B ; AND IOT THE JCL
+ SKIPN MUDVRB
+ OASC MCJCLB
+ .CALL [SETZ ; LOAD TS MUDCOM
+ SIXBIT /LOAD/
+ MOVEI MCINFO
+ SETZI MCFILI]
+ .LOSE 1000
+ MOVE B,[-1,,C] ; READ THE STARTING ADDRESS
+ .IOT MCFILI,B
+ .CLOSE MCFILI, ; CLOSE THE FILE
+ ADDI C,1
+ TLZ C,-1 ; CLEAR THE LEFT HALF
+ .USET MCINFO,[.SUPC,,C] ; SET UPC
+ SKIPN MUDVRB
+ JRST MUDBEG
+ .ACCESS MCINFO,[1]
+ MOVE B,[-1,,C]
+ MOVNI C,1
+ .IOT MCINFO,B
+ .ATTY MCINFO,
+ .LOSE 1000
+MUDBEG: .USET MCINFO,[.SUSTP,,[0]] ; START IT UP
+ SKIPN MCHANG
+ .HANG ; WAIT FOR INTERRUPT
+ SKIPN MUDVRB
+ JRST MCHEND
+ SETZM MCHANG
+ .USET MCINFO,[.RSV40,,C]
+ HRRZS C
+ CAIE C,100000
+ JRST MCHEND
+ .CALL [SETZ
+ SIXBIT /USRVAR/
+ MOVEI MCINFO
+ MOVEI .RTTY
+ MOVEI 0
+ SETZ [TLO %TBOUT]]
+ .LOSE %LSSYS
+ .USET MCINFO,[.SPIRQ,,[0]]
+ .USET MCINFO,[.SUSTP,,[0]]
+ SKIPN MCHANG
+ .HANG
+MCHEND: .CALL [SETZ ; OPEN A READ CHANNEL TO INFERIOR
+ SIXBIT /OPEN/
+ MOVSI .BII
+ MOVEI MCFILI
+ [SIXBIT /USR/]
+ [0]
+ SETZ [SIXBIT /MUDCOM/]]
+ .LOSE 1000
+ .RESET TTYO,
+ .ACCESS MCFILI,[1] ; GET TO WORD 1
+ MOVE B,[-1,,C]
+ .IOT MCFILI,B ; READ IT (0 = WINNAGE 1+ = ERROR CODE)
+ JUMPN C,MCERR
+ MOVE B,[-1,,C]
+ .IOT MCFILI,B ; READ CHARACTER COUNT
+ TDNE C,[-1,,770000] ; GARBAGE FROM MUDCOM?
+ JRST [MOVEI C,11
+ JRST MCERR]
+ MOVE B,[-1,,D]
+ .IOT MCFILI,B ; READ LOCATION OF RETURN
+ .ACCESS MCFILI,D ; ACCESS THERE
+ IDIVI C,5
+ ADDI C,1 ; NUMBER OF WORDS NEEDED
+ MOVN D,C
+ MOVSS D ; TO LEFT HALF
+ HRRI D,INPBUF
+ .IOT MCFILI,D ; IOT IN THE RETURN
+ .UCLOSE MCFILI, ; FLUSH THE JOB
+]
+IFE ITS,[
+MUDSTT: MOVSI A,(CR%CAP)
+ SETZM MCHANG ; SAY WE'RE IN MUDCOM NOW
+ CFORK ; MAKE A FORK
+ HALTF ; WHY?
+ MOVEM A,MCHNDL' ; SAVE PROCESS HANDLE
+ MOVSI A,(GJ%SHT+GJ%OLD)
+ MOVE B,[-1,,[ASCIZ /SYS:MUDCOM.EXE/]]
+ GTJFN ; JFN FOR FILE
+ HALTF
+ HRL A,MCHNDL ; HANDLE,,JFN
+ GET ; GET A MUDCOM
+ MOVE A,MCHNDL
+ GEVEC ; GET ENTRY VECTOR
+ PUSH P,B ; SAVE STARTING ADDRESS, ETC
+ HRROI A,MCJCLB
+ RSCAN ; PUT JCL IN BUFFER
+ JFCL
+ SETZ A,
+ RSCAN ; THIS IS A CROCK. I HATE 20X!
+ JFCL
+ POP P,B
+ HRRZS B
+ ADDI B,1 ; STARTING ADDRESS IS START+1
+ MOVE A,MCHNDL
+ SFORK
+ WAIT
+ JFCL ; RETURNS HERE FROM XINFER
+ MOVE A,MCHNDL
+ MOVEI B,MCACS
+ RFACS ; GET THE AC'S
+ SKIPE MCACS+A
+ JRST MCERR
+ MOVEI A,.RSINI
+ RSCAN ; CONS COUNT OF JCL
+ JFCL
+ JUMPE A,MCERR
+ MOVN C,A
+ MOVE B,[440700,,INPBUF]
+ MOVEI A,-1
+ SIN ; READ JCL
+ MOVE C,MCACS+B ; GET COUNT IN C
+ ADDI C,4
+ IDIVI C,5
+ MOVE A,MCHNDL
+ KFORK ; KILL THE MUDCOM
+ JRST MCPARS
+
+]
+; AT THIS POINT IN TIME, THE RETURN FROM MUDCOM IS IN INPBUF
+; THE LENGTH IN WORDS OF THE RETURN IS IN C
+
+MCPARS: MOVE A,[440700,,INPBUF]
+ ILDB B,A
+ CAIE B,""
+ JRST MCNOPK
+ SETZ D,
+MCPAKL: ILDB B,A ; GET LENGTH OF PACKAGE IN CHARS
+ CAIE B,""
+ AOJA D,MCPAKL
+ IDIVI D,5 ; GET LENGTH IN WORDS
+ ADDI D,1
+ MOVE A,D
+ PUSHJ P,IBLOCK ; GET A BLOCK OF THAT LENGTH
+ PUSH P,A
+ MOVE E,A
+ HRLI E,440700 ; GET BYTE POINTER TO BLOCK
+ MOVE A,[440700,,INPBUF] ; GET BYTE POINTER TO INPUT
+ MOVEI D,40
+ ILDB B,A ; READ OFF THE INITIAL "
+ DPB D,A ; ZERO THE CHARACTER
+MCP2LP: ILDB B,A
+ CAIN B,""
+ JRST MCPAKE
+ DPB D,A ; ZERO THE CHARACTER
+ IDPB B,E ; STUFF IN BLOCK
+ JRST MCP2LP
+
+MCPAKE: DPB D,A
+ POP P,2(OUTPTR)
+ OASC [ASCIZ /
+ Package = /]
+ OASC @2(OUTPTR)
+
+MCNOPK: MOVE A,C ; NUMBER OF WORDS FOR ATOMS
+ PUSH P,C
+ PUSHJ P,IBLOCK ; GET A BLOCK
+ MOVE C,(P)
+ MOVEM A,(P)
+ HRLI A,INPBUF
+ ADDI C,-1(A)
+ BLT A,(C) ; BLT INTO NEW BLOCK
+ POP P,-2(OUTPTR)
+ OASC [ASCIZ /
+ Functions = /]
+ MOVE A,-2(OUTPTR)
+ HRLI A,440700
+ ILDB B,A
+ CAIN B,40
+ JRST .-2
+ ADD A,[70000,,]
+ TLNE A,400000
+ ADD A,[347777,,-1]
+ OBPTR A
+ POPJ P,
+
+MCERR:
+IFN ITS,[
+ JUMPN C,MCERR1 ; ERROR FROM INTERRUPT HANDLER?
+]
+IFE ITS,[
+ MOVE C,MCACS+A ; ERROR CODE FROM AC A
+ JRST MCERR1
+]
+ OASC [ASCIZ /
+MUDCOM returned abnormally: /]
+IFN ITS,[
+ TLNE A,%PJLOS
+ JRST [OASC [ASCIZ /.LOSE/]
+ JRST MCERFN]
+ TRNE A,%PIMPV
+ JRST [OASC [ASCIZ /MPV/]
+ JRST MCERFN]
+ TRNE A,%PIIOC
+ JRST MCIOC
+ TRNE A,%PIVAL
+ JRST MCVAL
+ TRNE A,%PIILO
+ JRST [OASC [ASCIZ /ILOPR/]
+ JRST MCERFN]
+MCERUN: OASC [ASCIZ /Unspecified lossage/]
+MCERFN: OASC [ASCIZ / at /]
+ .USET MCINFO,[.RUPC,,A]
+ HRRZS A
+ OOCT A
+ OASCR [ASCIZ /
+Return ignored. Inferior saved for debugging./]
+ SETZM (OUTPTR)
+ POPJ P,
+
+MCIOC: .USET MCINFO,[.RBCHN,,A]
+ HRLS A
+ ADD A,[.RIOS,,A]
+ .USET MCINFO,A
+ .CALL [SETZ
+ SIXBIT /OPEN/
+ [.UAI,,ERRCHN]
+ [SIXBIT /ERR/]
+ [3]
+ SETZ A]
+ JRST MCERUN
+ MOVE A,[440700,,INPBUF]
+ PUSH P,B
+ MOVEI B,INPBLN
+ .CALL [SETZ
+ SIXBIT /SIOT/
+ MOVEI ERRCHN
+ A
+ SETZ B]
+ .LOSE 1400
+ .CLOSE ERRCHN,
+ MOVEI O,
+ DPB O,A
+ OASC [ASCIZ /IOCERR: /]
+ OASC INPBUF
+ POP P,B
+ JRST MCERFN
+MCVAL: .USET MCINFO,[.RSV40,,A]
+ HRRZS A
+ JUMPE A,[OASC [ASCIZ /.VAL 0/]
+ JRST MCERFN]
+ .USET MCINFO,[.RUIND,,C]
+ TRO C,400000
+ .CALL [SETZ
+ SIXBIT /OPEN/
+ [.BII,,MCFILI]
+ [SIXBIT /USR/]
+ C
+ SETZ [0]]
+ JRST MCERUN
+ .ACCESS MCFILI,A
+ MOVE A,[-10,,INPBUF]
+ .IOT MCFILI,A
+ OASC INPBUF
+ JRST MCERFN
+]
+IFE ITS,[
+ OASC [ASCIZ /Unresolved??/]
+ POPJ P,
+]
+
+MCERR1:
+IFN ITS,[
+ SKIPE MUDVRB
+ JRST [.RESET TTYO,
+ JRST MCERRO]
+]
+ CAIE C,10
+ OASC [ASCIZ /
+ERROR from MUDCOM - /]
+ OASCR @MCERRS(C)
+MCERRO: SETZM (OUTPTR)
+IFN ITS,[
+ .UCLOSE MCFILI,
+]
+IFE ITS,[
+ MOVE A,MCHNDL
+ KFORK
+] POPJ P,
+
+MCERRS: 0
+ [ASCIZ /Self Comparison/]
+ [ASCIZ /Bad JCL?/]
+ [ASCIZ /Syntax Error/]
+ [ASCIZ /Open Failed/]
+ [ASCIZ /INTERNAL BUG/]
+ [ASCIZ /No Differences Encountered?/]
+ [ASCIZ /No Similarities Encountered?/]
+ [ASCIZ /No Changes Encountered/]
+ [ASCIZ /MUDCOM returned garbage--result ignored./]
+\f
+SUBTTL HOW TO RUN & SPECIAL COMPILATION TYPES
+
+; TABLE OF POINTERS TO HOW-TO-RUN ROUTINES
+DSPTBL==.+1 ; OFFSET FOR DISPATCH MACRO
+HOWRUN: DISPATCH COMBAT,.HCOMBT ; DEMON
+ DISPATCH FILOUT,.HFILE ; FILE AS SNAME;PLAN >
+ DISPATCH PCOMP,.HPCOMP ; FILE AS SNAME;PCOMP > & START PCOMP
+ DISPATCH WASTE,.HWASTE ; PUT ON LOW-PRIORITY QUEUE
+ DISPATCH MANY,.HMANY ; LONG PLAN
+ DISPATCH TOPLEV,.HABRT ; ABORT PLAN
+ DISPATCH HASKHK,.HQUES ; ASK A QUESTION ON NEXT LOOP
+ DISPATCH HPRTHK,.HPRIN ; PRINT PLAN TO TTY
+
+; TABLE OF POINTERS TO ROUTINES FOR SPECIAL COMPILATION TYPES
+DSPTBL==.+1
+SPTYPE: DISPATCH MULTPL,.TMULT ; MULTIPLE COMPILATIONS
+ DISPATCH QUIT,.TQUIT ; BYE
+ DISPATCH ALTGRP,.TALTG ; ALTER GROUP
+ DISPATCH PRTGRP,.TPRTG ; PRINT GROUP
+ DISPATCH CRTAIL,.TCRTG ; CREATE GROUP
+ DISPATCH GETAIL,.TLDTL ; LOAD TAILOR
+ DISPATCH RPTAIL,.TRPTL ; REPLACE TAILOR
+ DISPATCH DELGRP,.TDELG ; KILL GROUP
+ DISPATCH VERBOS,.TTOGV ; VERBOSITY
+ DISPATCH MVERBO,.TTOMV ; MUDCOM VERBOSITY
+ DISPATCH FEXIST,.TTOEX ; FILES MUST EXIST (GLOBAL - IN TAILOR)
+ DISPATCH XEROX,.TXROX ; COPY GROUP
+ DISPATCH RENAME,.TRNM ; RENAME
+ DISPATCH SETMOR,.TSMOR ; ANSWER 'ANOTHER COMPILATION?'
+ DISPATCH PTLONG,.TPLON ; PRINT ACCUMULATED PLAN
+ DISPATCH FLUSH,.TFLUS ; GET RID OF LONG COMPILATION
+ DISPATCH LSTLNK,.TLNKL ; LIST LINKS
+ DISPATCH MYLINK,.TMLNK
+\f
+; HOW-TO-RUN ROUTINES: COMBAT (DEFAULT), FILOUT, PCOMP, AND MANY
+FILOUT: MOVE A,[SIXBIT /PLAN/]
+ MOVE B,SNAME
+ PUSHJ P,PTPLAN
+ SKIPN DEBUG
+IFN ITS,[
+ .IOPOP OUTCHN,
+]
+IFE ITS,[
+ PUSHJ P,XIOPOP
+]
+ JRST MORCMP
+
+PCOMP: SETOM PCOMPF ; SAYS THAT NEED TO START PCOMP WHEN LEAVE
+ MOVE A,[SIXBIT /PCOMP/]
+ MOVE B,SNAME
+ PUSHJ P,PTPLAN
+ SKIPN DEBUG
+IFN ITS,[
+ .IOPOP OUTCHN,
+]
+IFE ITS,[
+ PUSHJ P,XIOPOP
+]
+ SETZM NCOMPF
+ MOVE A,OUTSTR
+ MOVEI O,1
+ TDNE O,.QNEWC(A) ; IS THIS OLD COMPILER?
+ SETOM NCOMPF ; NO, SO WHEN LEAVE SAY :NPCOMP
+ JRST MORCMP
+
+MANY: SETOM MNYFLG ; MANY MODE: SET FLAG, GET ANOTHER
+ POPJ P,
+
+IFE ITS,[
+XIOPSH: MOVE O,OUTJFN'
+ MOVEM O,OUTJF1'
+ POPJ P,
+
+XIOPOP: PUSH P,A
+ MOVE A,OUTJFN
+ CLOSF
+ JFCL
+ POP P,A
+ MOVE O,OUTJF1
+ MOVEM O,OUTJFN
+ POPJ P,
+]
+
+; LOW-PRIORITY PLANS: GO TO COMBAT;WASTE >, OTHERWISE IDENTICAL WITH COMBAT.
+WASTE: MOVE A,[SIXBIT /WASTE/]
+ SETOM WASTAG
+ JRST COMBT1
+
+; DEFAULT: PLAN TO COMBAT;PLAN >.
+COMBAT:
+IFN ITS,[
+ MOVE A,[SIXBIT /PLAN/]
+ SETZM WASTAG
+]
+IFE ITS,[
+ MOVE A,[SIXBIT /PLAN/]
+]
+COMBT1: MOVE B,[2,,[ASCIZ /COMBAT/]]
+ PUSHJ P,PTPLAN
+IFN ITS,[
+ SKIPN DEBUG
+ JRST [.CALL GPLANN
+ .LOSE 1000
+ .IOPOP OUTCHN,
+ OASCR [0]
+ MOVEI B,[ASCIZ /COMBAT #/]
+ SKIPE WASTAG
+ MOVEI B,[ASCIZ /WASTAGE #/]
+ OASC (B)
+ OSIX A
+ OASCR [ASCIZ / scheduled./]
+ JRST .+1]
+ CAME A,[SIXBIT /1/] ; IF NOT PLAN 1, DON'T NEED TO SIGNAL
+ SETOM NOSIG
+ SKIPE WASTAG
+ JRST HRCHK ; WASTES DON'T CARE ABOUT WEEKENDS
+ .RYEAR A,
+ LDB A,[320300,,A] ; IS IT A WEEKEND?
+ JUMPE A,SDEMON
+ CAIN A,6
+ JRST SDEMON
+HRCHK: .RTIME A,
+ LDB A,[301400,,A] ; IS IT OFFICE HOURS?
+ SKIPE WASTAG ; OFFICE HOURS DEFINED DIFFERENTLY
+ JRST [CAIGE A,'01
+ JRST SSTATU
+ CAIGE A,'08
+ JRST SDEMON ; WIN
+ JRST SSTATU] ; OTHERWISE CAUSE THE CROCK TO COME UP
+ CAIGE A,'20
+ CAIGE A,'08
+ JRST SDEMON
+ .RDATE A,
+ .CALL HOLOPN ; IS IT A HOLIDAY?
+ JRST SSTATU ; OTHERWISE, DO STDMST
+SDEMON: SKIPE NOSIG
+ JRST MORCMP
+ OASCR [ASCIZ /Demon signalled./]
+ SKIPN DEBUG
+ .CALL DEMSIG ; START UP COMBAT
+ JFCL
+ JRST MORCMP
+
+SSTATU: .CALL RQDATE ; GET HALF-SEC SINCE MIDNIGHT IN B
+ JFCL
+ TLZ B,-1
+ SKIPE WASTAG
+ JRST [MOVEI A,120.*65.
+ CAILE B,7200. ; HALF-SEC BETWEEN MIDNIGHT & 1AM
+ MOVEI A,<25.*7200.>+<5*120.> ; IF BEFORE MIDNIGHT
+ JRST SSTAT1]
+ MOVEI A,1205.*120. ; HALF-SEC BETWEEN MIDNIGHT & 8PM
+SSTAT1: SUB A,B ; HALF-SEC NOW TO 8PM
+ IDIVI A,240. ; CONVERT TO TWO-MINUTE TICKS
+ .CALL RDDMST ; IDX--\>B, TIME TO SIGNAL TO C
+ .VALUE
+ JUMPN B,MORCMP ; DEMON ALREADY UP
+ JUMPE B,SSTAT2 ; IF NEVER COMING UP...
+ CAIL A,B ; WOULD WE CAUSE IT TO COME UP SOONER?
+ JRST MORCMP ; NO
+SSTAT2: .CALL STDMST ; YES, SO SET IT
+ .VALUE
+ JRST MORCMP
+
+DEMSIG: SETZ
+ SIXBIT /DEMSIG/
+ [SIXBIT /ZONE/]
+ SETZI 0
+
+GPLANN: SETZ
+ SIXBIT /RCHST/
+ MOVEI OUTCHN
+ MOVEM A
+ MOVEM A
+ SETZM A
+
+HOLOPN: SETZ
+ SIXBIT /OPEN/
+ [6,,DSKCHN]
+ [SIXBIT /DSK/]
+ [SIXBIT /HLIDAY/]
+ A
+ SETZ [SIXBIT /COMBAT/]
+
+RQDATE: SETZ
+ SIXBIT /RQDATE/
+ SETZM B
+
+STDMST: SETZ
+ SIXBIT /STDMST/
+ [SIXBIT /ZONE/]
+ [5000.,,0]
+ SETZ A
+
+RDDMST: SETZ
+ SIXBIT /RDDMST/
+ [SIXBIT /ZONE/]
+ MOVEM B
+ MOVEM C
+ SETZM C
+]
+IFE ITS,[
+ PUSHJ P,XIOPOP
+ JRST MORCMP
+]
+
+\f
+
+; COME HERE TO PRINT CURRENT PLAN TO TTY. SETS UP MOREAGE, SAVES SUITABLE
+; AC'S, GOES TO FUNNY ENTRY TO PTPLAN. EVENTUALLY SKIPS TWICE, SO HOW-TO-RUN
+; GETS ASKED AGAIN.
+
+HPRTHK: PUSH BK,[0]
+ PUSH BK,[HPROUT]
+ PUSH BK,[[POPJ P,]]
+ PUSH BK,P
+ SETOM LONGOT ; ENABLE MORES
+ OASCR [0]
+ PUSHJ P,PTPLA1 ; DO PRINTING
+HPROUT: SETZM LONGOT
+ BKOFF
+ AOS (P)
+ JRST POPJ1
+
+HASKHK: JRST POPJ1
+
+; 'QUESTION' ESCAPE FROM HOW TO RUN: ASKS FOR QUESTION, STUFFS ANSWER IN OUTBLK,
+; RETURNS TO HOW TO RUN VIA SKIP-RETURN. CALLED VIA JSP, RETURN ADDRESS IN RET.
+; THIS ALLOWS PROPER HANDLING OF CTRL-R FROM THE 'Question' QUESTION.
+
+HASK: SETZM PRMPT1
+HASK1: MOVE A,[TAILEN+TALSPC,,TAILTB] ; TABLE OF REASONABLE QUESTIONS
+ PUSH BK,PRMPT1 ; FROM HERE, RETURN TO NORMAL LOOP
+ PUSH BK,[QDONXT]
+ PUSH BK,[HSKRT1] ; NO SPECIAL HACKS
+ PUSH BK,P
+ PUSHJ P,COMTYP ; GET QUESTION OFFSET IN A
+ BKOFF
+ MOVE B,QTABLE(A) ; GET QUESTION SPEC IN B
+ TLNE B,%GIGNO ; SEE IF IT CAN BE ASKED?
+ JRST [OASCR [ASCIZ /Question disabled?/]
+ JRST POPJ1]
+ PUSH P,OUTPTR ; SAVE OFFSETS FOR CTRL-R
+ PUSH P,QOFF
+ PUSH P,CMPBLK
+ MOVE OUTPTR,OUTBLK ; SET UP CMPBLK & OUTPTR
+ MOVE CMPBLK,CMPSIZ(OUTPTR)
+ ADD CMPBLK,A
+ ADD OUTPTR,A
+ HRRZ QOFF,A
+ MOVE A,(OUTPTR) ; SAVE OLD VALUE IN CASE OF CTRL-R
+ MOVEM A,RVALS
+ MOVE C,QTABLE(QOFF)
+ TLNE C,$TFILE ; FILE QUESTION?
+ JRST [JUMPN A,HASKER ; IF NON-ZERO, BLOCK THERE ALREADY
+ PUSHJ P,DEFILE ; OTHERWISE FROB IT
+ JRST HASKER]
+ SETZM (OUTPTR) ; CLEAR PREVIOUS ANSWER
+ MOVE C,(CMPBLK)
+ TLNN C,%ASK+%DSUP ; USER-SUPPLIED DEFAULT ALREADY?
+ SKIPGE (OUTPTR) ; <0-->ANSWERED USING ESCAPE
+ JRST HASKER ; DEFAULT EXISTS, SO GO ASK IT
+ MOVEI CMPBLK,VTABLE(QOFF) ; PRETEND CMPBLK IS VTABLE
+ TLNE B,$TFILE ; AND SET UP DEFAULTS
+ JRST [PUSHJ P,DEFILE
+ JRST HASKER]
+ PUSHJ P,NRMDEF
+HASKER: PUSH BK,[[ASCIZ / Question/]]
+ PUSH BK,[HSKRET] ; RETURN TO HSKRET IF CTRL-R
+ PUSH BK,[[POPJ P,]] ; NOTHING SPECIAL
+ PUSH BK,P ; SAVE P
+ SETZ A,
+ DPB A,[430100,,(OUTPTR)] ; CLEAR %DATAH BIT, FOR ASKER
+ CAIN QOFF,.QCOMP ; COMPARE QUESTION?
+ JRST HCOMP
+ CAIN QOFF,.QSNAM ; SNAME QUESTION?
+ JRST HSNAM
+ HLLZ A,QTABLE(QOFF) ; TO HAVE THE BITS
+ PUSHJ P,ASK1
+ JRST HSKPOP
+HASKOT: MOVEI A,1
+ DPB A,[430100,,(OUTPTR)] ; TURN ON %DATAH BIT
+HSKPOP: POP P,CMPBLK
+ POP P,QOFF
+ POP P,OUTPTR
+ BKOFF
+ JRST POPJ1
+
+; ASK SNAME QUESTION
+
+HSNAM: PUSHJ P,ASK ; ASK THE QUESTION
+ JFCL
+ PUSHJ P,ASNMD1
+ JRST HSKPOP
+
+
+; ASK COMPARE QUESTION
+HCOMP: MOVE A,<.QPREC-.QCOMP>(CMPBLK)
+ TLNE A,%DSUP+%ASK ; WAS THIS QUESTION ASKED?
+ JRST [SKIPN <.QPREC-.QCOMP>(OUTPTR) ; AND ANSWERED AFFIRMATIVELY?
+ JRST HCNOPR
+ JRST HCOMP1]
+ SKIPL A,<.QPREC-.QCOMP>(OUTPTR) ; GOT ANSWER IN HERE?
+ JRST HCNOPR
+HCOMP1: HLLZ A,QTABLE(QOFF)
+ PUSHJ P,ASK1 ; ASK THE QUESTION
+ JRST HSKPOP ; NO ANSWER
+ ADDI OUTPTR,<.QCJCL-.QCOMP> ; MOVE OUTPTR UP A BIT
+ PUSHJ P,MUDCOM ; .WINI
+ JRST HASKOT
+HCNOPR: SETZM (OUTPTR)
+ OASCR [ASCIZ / No precompiled?/]
+ JRST HSKPOP
+
+; FOR RETURN FROM ASKING QUESTION
+HSKRET: MOVE A,RVALS ; GET SAVED VALUE
+ MOVEM A,(OUTPTR) ; AND RESTORE IT
+ POP P,CMPBLK ; CONTROL-R RETURNS HERE
+ POP P,QOFF
+ POP P,OUTPTR
+ JRST HASK1
+
+; HANDLE CTRL-R FROM ASKING FOR QUESTION
+HSKRT1: MOVE OBSCEN,BACK(OBSCEN) ; GO BACK TO 'HOW TO RUN'
+ MOVE A,BKPSAV(BK)
+ SUB A,[1,,1]
+ MOVEM A,BKPSAV(BK) ; FLUSH EXTRA SLOT ON P
+ POPJ P,
+\f
+; SPECIAL COMPILATION TYPES: MULTIPLE, TAILOR FROBBING, QUIT, FLUSH
+
+MULTPL: SKIPE MULFLG
+ OASC [ASCIZ / What a chomper! /]
+ SETOM MULFLG
+ POPJ P,
+
+VERBOS: SETCMM PR2SW
+ PUSHJ P,PRTAIL
+ MOVEI A,[ASCIZ / Verbose/]
+ SKIPN PR2SW
+ MOVEI A,[ASCIZ / Unverbose/]
+ OASC (A)
+ POPJ P,
+
+MVERBO: SETCMM MUDVRB
+ PUSHJ P,PRTAIL
+ MOVEI A,[ASCIZ /MUDCOM verbosity/]
+ SKIPN MUDVRB
+ MOVEI A,[ASCIZ /MUDCOM silence/]
+ OASC (A)
+ POPJ P,
+
+FEXIST: SETCMM FILEXI'
+ PUSHJ P,PRTAIL
+ MOVEI A,[ASCIZ /Files Must Exist/]
+ SKIPE FILEXI
+ MOVEI A,[ASCIZ /Files Need Not Exist/]
+ OASC (A)
+ POPJ P,
+
+; TAILOR ANOTHER COMPILATION QUESTION
+SETMOR: MOVEI A,[ASCIZ /Another compilation? /]
+ MOVEM A,PRMPT1
+ MOVE A,[TFALEN,,TFATBL]
+ PUSHJ P,COMTYP
+ TRNE A,400000 ; FIRST ELEMENT OF TABLE HAS VAL -1, MEANS ASK
+ JRST [SETZM NMORAS
+ JRST SETOUT]
+ SETOM NMORAS
+ MOVEM A,MORANS
+SETOUT: PUSHJ P,PRTAIL
+ POPJ P,
+
+IFN ITS,[
+QUIT: SKIPN PCOMPF ; PCOMP TO BE RUN?
+ .BREAK 16,160000
+ MOVEI B,OPCOMP ; VALRET THE RIGHT THING
+ SKIPE NCOMPF
+ MOVEI B,NPCOMP
+ .VALUE (B)
+OPCOMP: ASCIZ /\17:KILL
+\16:PCOMP
+/
+NPCOMP: ASCIZ /\17:KILL
+\16:NPCOMP
+/
+]
+
+IFE ITS,[
+QUIT: SKIPN PCOMPF
+ HALTF
+ MOVEI A,.FHSLF
+ MOVEI B,200000 ; TURN OFF INFERIOR INTERRUPT, ECCH!
+ DIC
+ MOVSI A,(GJ%SHT+GJ%OLD)
+ MOVE B,[440700,,[ASCIZ /SYS:PCOMP.EXE/]]
+ SKIPE NCOMPF
+ MOVE B,[440700,,[ASCIZ /NEW:NPCOMP.EXE/]]
+ GTJFN
+ JRST LDERR
+ OASCR [0]
+ OASCR [ASCIZ /Loading compiler./]
+ HRLI A,.FHSLF
+ MOVEM A,PCLOAD+1
+ MOVSI P,PCLOAD
+ BLT P,P
+ JRST B ; BYE BYE
+
+LDERR: OASCR [0]
+ OASC [ASCIZ /Load of PCOMP failed: /]
+ MOVE B,A
+ TLO B,.FHSLF
+ MOVEI A,.PRIOU
+ SETZ C,
+ ERSTR
+ JFCL
+ JFCL
+ OASCR [0]
+ HALTF
+
+PCLOAD: 0
+ 0
+ GET
+ MOVEI A,400000
+ GEVEC
+ RESET
+ JRST (B)
+]
+
+; GET RID OF LONG COMPILATION
+FLUSH: SETZM MNYFLG
+ POPJ P,
+
+; PRINT OUT ACCUMULATED LONG COMPILATION, IN CASE YOU FORGOT
+PTLONG: SKIPN MNYFLG
+ JRST [OASC [ASCIZ /
+No plans pending./]
+ POPJ P,]
+ POP P, ; BLETCH! THIS CROCK IS PUSHJ'ED TO, AND WANTS TO JRST
+ ; INTO THE MIDDLE OF SOMETHING THAT DOESN'T POPJ.
+ ; BLETCH! BLETCH! BLETCH!
+ JRST DONE1 ; JRST TO FUNNY ENTRY, WHICH IGNORES TAILORING
+\f
+; FOR THE SAKE OF CRETINOUS COMBAT USERS, ASK WHETHER ANOTHER COMPILATION IS WANTED.
+; LOOKS FIRST AT MULTIPLE MODE, THEN AT CURRENT PLAN, THEN AT SETTINGS OF NMORAS AND
+; MORANS (SET IN TAILOR FILE)
+
+MORCMP: SETZM NOSIG
+ SETZM TPFUDG
+ MOVE A,[1,,[ASCIZ /DSK/]]
+ MOVEM A,SYSDEV
+IFN ITS,[
+ MOVE A,[1,,[ASCIZ />/]]
+]
+IFE ITS,[
+ MOVE A,[1,,[ASCIZ /MUD/]]
+]
+ MOVEM A,SYSFN2
+ SKIPE MNYFLG ; ALWAYS ASK ANOTHER IF MAKING LONG COMPILATION
+ POPJ P,
+ MOVE A,SNAME ; RESET DEFAULT SNAMES
+ MOVEM A,PSNAME
+ MOVEM A,SYSDIR
+ SKIPE MULFLG ; ALWAYS GIVE ANOTHER
+ POPJ P,
+ MOVE A,MORLOC(CMPBLK) ; DID LUSER GIVE AN ANSWER ALREADY?
+ TLNN A,%DSUP
+ JRST ASKMOR
+ HRRZS A ; GET IT IN A
+ JUMPN A,CPOPJ
+ JRST QUIT
+ASKMOR: SKIPN NMORAS ; DID HE SAY TO ASK?
+ JRST ASKMR1
+ SKIPN A,MORANS ; SKIPS IF ANSWER YES
+ JRST QUIT
+ POPJ P,
+ASKMR1: MOVE A,[1,,1] ; IF SAID TO ASK, MAKES DEFAULT 'None'
+ MOVEM A,TPFUDG
+ POPJ P,
+
+\f
+SUBTTL PLAN PRINTER
+
+; HERE TO PRINT PLAN OUT. TAKES FN1 IN A, SNAME IN B. RETURNS NOTHING, CHANGES
+; NOTHING. DOESN'T CLOSE CHANNEL. USES OUTCHN (OTTY OR TO DSK) INTERNALLY,
+; A POINTS TO OUTPUT FORMAT, D CONTAINS PTR TO FIRST OF FORMAT PAIR.
+PTPLAN: SKIPN DEBUG
+ PUSHJ P,PLNOPN
+ SETZM MNYFLG ; NO LONGER NEEDED
+PTPLA1: SETOM FSTBLK ; PRINTING FIRST, SO NEED NEW CMP
+ MOVE OUTPTR,OUTSTR
+ MOVEM OUTPTR,LSTOUT
+MANYLP: MOVE CMPBLK,CMPSIZ(OUTPTR) ; EXPECTS OUTBLK IN OUTPTR
+ MOVE A,OUTTBL ; AOBJN PTR TO OUTPUT SPECS
+OUTLP: MOVE D,(A) ; GET FIRST WORD OF SPEC
+ HLRZ B,1(A) ; GET OFFSET INTO OUTBLK & QSPECS
+ MOVEI F,QTABLE(B)
+ MOVE F,(F)
+ TLNE F,%GIGNO ; SEE IF QUESTION SHOULD EVER BE USED
+ JRST EAOBJN
+ SKIPN FSTBLK
+ JRST [TLNN F,%TNMNY ; LOOK AT QSPEC TO SEE IF THIS IS
+ JRST CONTIN ; OUTPUT ONLY FIRST TIME THROUGH
+ JRST EAOBJN]
+CONTIN: MOVE E,B
+ ADD B,OUTPTR ; POINTER TO SLOT IN OUTBLK
+ ADD E,CMPBLK ; GET POINTER TO SLOT IN CMPBLK
+ MOVE E,(E) ; GET CMPBLK SLOT IN E
+ TLNE E,%IGNOR
+ JRST [TLNN E,%DSUP ; IF USER-SUPPLIED DEFAULT
+ JRST CKESSN ; SEE IF ESSENTIAL
+ JRST DOOUT]
+DOOUT: HRRZ B,(B) ; GET DATA TO BE OUTPUT FROM OUTBLK
+ HLRZ E,D ; GET TYPE OF FROB IN E
+ PUSHJ P,@OUTYPE (E) ; DISPATCH FOR DIFFERENT OUTPUT TYPES
+EAOBJN: AOBJN A,.+1
+ENDOUT: AOBJN A,TSTDON
+OUTDON: MOVE OUTPTR,LSTOUT ; PICK UP POINTER TO THIS OUTPUT BLOCK
+ SKIPN OUTPTR,CMPSIZ+1(OUTPTR) ; IS IT CHAINED TO ANOTHER? (MANY MODE)
+ POPJ P, ; NO, DONE
+ MOVEM OUTPTR,LSTOUT ; MAKE LSTOUT, OUTPTR POINT TO NEW ONE
+ SETZM FSTBLK ; MULTIPLE COMPILATION MODE
+ JRST MANYLP
+TSTDON: SKIPN (A)
+ JRST OUTDON
+ JRST OUTLP
+
+IFN ITS,[
+PLNOPN: EXCH A,B
+ PUSHJ P,ASCSIX ; GET THIS IN SIXBIT
+ EXCH A,B
+ .IOPUSH OUTCHN,
+ .CALL [SETZ
+ SIXBIT /OPEN/
+ MOVSI .UAO
+ MOVEI OUTCHN
+ [SIXBIT /DSK/]
+ A
+ [SIXBIT />/]
+ SETZ B]
+ .LOSE 1000
+ POPJ P,
+]
+; IN A, THE SIXBIT NAME OF THE FILE TO OPEN (I.E. PCOMP, WASTE, ETC.)
+; IN B, THE DIRECTORY (IN ASCII)
+IFE ITS,[
+PLNOPN: PUSHJ P,XIOPSH
+ PUSHJ P,SIXASC ; GET IT IN ASCII POINTER FORMAT
+ HRROM A,.GJNAM+GTJFNP ; PUT IT IN THE FILE NAME SLOT
+ SKIPE B
+ HRROM B,.GJDIR+GTJFNP ; SO ALSO WITH THE DIRECTORY NAME
+ SKIPE A,SNAME
+ HRROM A,.GJDIR+GTJFNP
+ MOVEI A,GTJFNP
+ SETZ B,
+ GTJFN
+ JRST PLNOPF
+ MOVEM A,OUTJFN
+ MOVE B,[070000,,OF%WR]
+ OPENF
+ CAIA
+ POPJ P,
+
+PLNOPF: OASCR [ASCIZ /Open of PLAN failed?/]
+ HALTF
+
+
+GTJFNP: SETZ
+ .NULIO,,.NULIO
+ 0
+ 0
+ -1,,[ASCIZ /PCOMP/]
+ -1,,[ASCIZ /PLAN/]
+ 0
+ 0
+ 0
+]
+
+; SEE IF THIS QUESTION HAS TO BE OUTPUT REGARDLESS OF SETTING IN CMPBLK
+CKESSN: SKIPGE (B) ; IF THERE'S OUTPUT, MUST BE PRINTED
+ JRST DOOUT
+CKESS2: HLRZ F,1(A)
+ MOVE F,QTABLE(F)
+ TLNN F,%ESSEN ; SKIPS IF ESSENTIAL QUESTION
+ JRST EAOBJN ; INESSENTIAL, SO GO TO NEXT
+ JRST DOOUT
+
+AOPOP: AOBJN A,.+1 ; RETURN POINT IF NOTHING PRINTED
+ POPJ P,
+; DISPATCH TABLE FOR DIFFERENT TYPES OF OUTPUT
+; ALL SKIP RETURN IF ANY OUTPUT PRINTED
+OUTYPE: T.FDF
+ T.FDT
+ FNAME
+ FORM
+ STRING
+ OTREDO
+ OSNAME ; OUTPUT SNAME
+\f
+; HERE FOR FLAGS: T/F, DEFAULT <>
+T.FDF: JUMPE B,CPOPJ
+ OASC (D) ; PRINT OUT LEADING FROB
+ OASC $TRUE
+ AOBJN A,.+1
+PRTOUT: HRRZ C,(A) ; COMMON TO ALL PRINTOUT ROUTINES: PRINT OUT TRAILER,
+ OASC (C) ; THEN SKIP-RETURN
+POPJ1: AOS (P)
+CPOPJ: POPJ P,
+
+; SAME, BUT DEFAULT T
+T.FDT: JUMPN B,CPOPJ
+ OASC (D)
+ OASC $FALSE
+ AOBJN A,PRTOUT
+
+$TRUE: ASCIZ /T/
+$FALSE: ASCIZ /#FALSE ()/
+
+; HERE TO PRINT OUT FILE NAMES. SURROUNDS THEM WITH QUOTES, AUTOMAGICALLY
+FNAME: JUMPE B,CPOPJ
+ OASC (D)
+ OASCI ""
+ PUSH P,A
+ MOVE A,B
+ PUSHJ P,NFNAME
+ POP P,A
+ OASCI ""
+ AOBJN A,PRTOUT
+
+; NEW FILE NAME PRINTER. A HAS POINTER TO BLOCK OF NAMES
+NFNAME: PUSH P,C
+ PUSH P,D
+ MOVEI D,CHRTBL
+ HRLI A,-FSPSIZ
+NFNMLP: MOVE C,(A)
+ SPNAM1 C
+ JRST [MOVEI C,[ASCIZ /<filename1>/]
+ SKIPE SSSPPP
+ MOVEI C,[ASCIZ /<filename2>/]
+ OASC (C)
+ JRST .+2]
+ OASC (C)
+ MOVE E,1(A) ; NEXT NAME
+ MOVE E,(E) ; GET ASCII
+ CAMN E,[ASCIZ /0/]
+ JRST NFNMDN ; DON'T PRINT .0!
+ SKIPN 1(A)
+ JRST NFNMDN
+ OASC (D)
+ ADDI D,1
+ AOBJN A,NFNMLP
+NFNMDN: POP P,D
+ POP P,C
+ POPJ P,
+
+IFN ITS,[
+CHRTBL: ASCIZ /:/
+ ASCIZ /;/
+ ASCIZ / /
+ ASCIZ /?/
+ ASCIZ /?/
+]
+IFE ITS,[
+CHRTBL: ASCIZ /:</
+ ASCIZ />/
+ ASCIZ /./
+ ASCIZ /./
+ ASCIZ /;/
+]
+
+; PRINT OUT A FORM IFF THE GIVEN SWITCH IS T (NEW COMPILER, MAINLY)
+FORM: JUMPE B,CPOPJ
+ OASC (D)
+ AOBJN A,PRTOUT
+
+; PRINT OUT A STRING, NOT SURROUNDED BY QUOTES (PACKAGE MODE, ETC.)
+STRING: JUMPE B,CPOPJ
+ OASC (D)
+ OASC (B)
+ AOBJN A,PRTOUT
+
+;PRINT OUT REDO LIST: APPENDS LIST FROM COMPARE, LIST FROM REDO
+OTREDO: JUMPE B,RREDO ; ANYTHING FROM COMPARE?
+ OASC (D) ; YES, PRINT '<SET REDO!- (
+ MOVSI F,440700 ; CONS UP BYTE POINTER
+ HRR F,B
+OTLOOP: ILDB F ; FLUSH LEADING BLANKS
+ CAIN 0,"
+ JRST OTLOOP
+ ADD F,[70000,,] ; DECREMENT THE POINTER--JUST FOUND NON-BLANK
+ TLNE F,400000
+ ADD F,[347777,,-1]
+ OBPTR F ; PRINT LIST
+ SETOM DOEND ; SAYS THAT NEED TO PRINT ')>' EVEN IF NOTHING
+ ; IN USER-SUPPLIED REDO LIST
+RREDO: HLRZ B,1(A)
+ ADD B,OUTPTR
+ ADDI B,3
+ HRRZ B,(B)
+ JUMPE B,[SKIPN DOEND ; NOTHING IN USER-SUPPLIED LIST. COMPARE LIST?
+ POPJ P, ; NO, SO LEAVE IMMEDIATE
+ JRST LDO]
+ SKIPN DOEND
+ OASC (D)
+ OASC (B)
+LDO: SETZM DOEND
+ AOBJN A,PRTOUT
+
+; OUTPUT <SNAME "FOO"> FROM PSNAME
+OSNAME: SKIPN PSNAME
+ AOBJN A,POPJ1 ; FLUSH COMPLETELY
+ OASC (D) ; PRINT <SNAME "
+ TRNN B,-1 ; 0?
+ JRST OSNAM1 ; YES, SO USE PSNAME
+ OASC (B) ; PRINT SNAME
+ AOBJN A,PRTOUT ; AND GO CLEAN UP
+OSNAM1: PUSH P,C
+ MOVE C,PSNAME
+ OASC (C)
+ POP P,C
+OSNAMO: AOBJN A,PRTOUT
+\f
+SUBTTL TAILORING
+
+; PUSHJ P,LDTAIL
+; COME HERE TO READ A TAILOR FILE INTO NCOMBAT
+A; ALWAYS RETURNS WITHOUT SKIPPING
+
+IFN ITS,[
+TALOPI: SETZ
+ SIXBIT /OPEN/
+ MOVSI .BII
+ MOVEI DSKCHN
+ TALDEV
+ TALFN1
+ TALFN2
+ SETZ TALSNM
+
+TALOPO: SETZ
+ SIXBIT /OPEN/
+ MOVSI .BIO
+ MOVEI DSKCHN
+ TALDEV
+ TALFN1
+ TALFN2
+ SETZ TLSNAM
+]
+; PUSHJ P,MKTAIL
+; A = POINTER TO START OF TAILOR BLOCK
+; INITIALIZES BLOCK TO %IGNOR+<QUESTION ID>,,0
+
+MKTAIL: PUSH P,F
+ MOVEI QOFF,0 ; INITIALIZE QOFF
+
+MKTLP: LDB F,[220600,,QTABLE(QOFF)]
+ TRO F,%IGNOR
+ HRLZM F,(A)
+ AOJ A,
+ AOJ QOFF,
+ SKIPE QTABLE(QOFF)
+ JRST MKTLP
+ MOVSI F,%IGNOR+CRETQ ; FINISH INITIALIZING, ALL TO CRETQ
+ MOVEM F,(A)
+ HRLZ F,A
+ HRRI F,1(A)
+ MOVE A,-2(P)
+ BLT F,MORLOC-1(A)
+ POP P,F
+ POPJ P,
+
+; PUSHJ P,LDTAIL
+; LOADS TAILOR FILE
+
+LDTAIL:
+IFN ITS,[
+ .CALL TALOPI
+]
+IFE ITS,[
+ MOVEI A,XTALNM
+ SETZ B,
+ GTJFN
+]
+ JRST [SKIPN ERRFLG
+ POPJ P,
+ PUSH P,[OPNFAL]
+ JRST ERRPRT]
+IFE ITS,[
+ MOVEM A,DSKJFN'
+ MOVE B,[440000,,OF%RD]
+ OPENF
+ JRST [OASCR [ASCIZ /Open of TAILOR failed?/]
+ HALTF]
+]
+ SKIPE LDFLAG
+ PUSHJ P,NAMMAK ; CONS STRING AND LENGTH FOR NAMUNQ
+ SETOM UTPSAV
+IFN ITS,[
+LDLOOP: MOVE C,[-2,,D]
+ .IOT DSKCHN,C ; GET THE FIRST WORDS IN D AND E
+]
+IFE ITS,[
+LDLOOP: MOVE C,[-2,,XCHOMP']
+ PUSHJ P,XIOTI
+ C
+ JRST LDOUT
+ MOVE D,XCHOMP
+ MOVE E,XCHOMP+1
+ JRST LDLOP0
+]
+ JUMPL C,LDOUT
+ JUMPE D,LDOUT
+LDLOP0: SKIPGE UTPSAV
+ JRST [HLRE A,UTYPLN
+ MOVNS A
+ HRLS A
+ MOVEM A,UTPSAV
+ JRST .+1] ; SAVE <#TYPES>,,<#TYPES> FOR HACKING LINKS
+ SETZM PR2SW
+ TLZN D,%NWFMT
+IFN ITS,[
+ SETOM ITSFXF
+]
+IFE ITS,[
+ JFCL
+] TLZE D,%TVERB
+ SETOM PR2SW
+ SETZM NMORAS
+ TLZE D,%NMRAS ; SKIPS IF SAID 'ASK'
+ SETOM NMORAS
+ SETZM FILEXI
+ TLZE D,%TFNEX
+ SETOM FILEXI
+ SETOM MORANS
+ TLZN D,%MRANS ; SKIPS IF ANSWER 'YES'
+ SETZM MORANS
+ SETZM MUDVRB
+ TLZN D,%MNVRB
+ SETOM MUDVRB
+ LDB F,[220600,,D] ; GET THE VERSION NUMBER
+ CAME F,QVERS
+ SETOM UPTFLG ; MUST DO AN UPDATE
+ TLZ D,777777 ; FLUSH LEFT HALF
+ MOVE A,D
+ PUSHJ P,IBLOCK ; GET WORDS FOR NAME
+ PUSH P,A ; SAVE THE LOCATION OF THE NAME
+ MOVN B,D ; MAKE AOBJN POINTER TO BLOCK
+ MOVSS B
+ HRR B,A
+IFN ITS,[
+ .IOT DSKCHN,B ; IOT IN THE NAME
+]
+IFE ITS,[
+ PUSHJ P,XIOTI
+ B
+ JFCL
+]
+ SKIPE LDFLAG ; ARE WE DOING A LOAD TAILOR?
+ PUSHJ P,NAMUNQ ; MAKE NAME UNIQUE
+ MOVE A,E
+ PUSHJ P,IBLOCK ; GET WORDS FOR BLOCK
+ ADDI A,LNALEN ; POINT PAST LINK AREA
+ PUSH P,A ; SAVE THE LOCATION OF BLOCK
+ MOVN B,E
+ MOVSS B
+ HRRI B,-LNALEN(A) ; START IOT AT BEGINNING OF LINK AREA
+IFN ITS,[
+ .IOT DSKCHN,B ; IOT IN THE BLOCK
+]
+IFE ITS,[
+ PUSHJ P,XIOTI
+ B
+ JFCL
+]
+ MOVE C,A
+ MOVSI QOFF,QNUM ; AOBJN POINTER TO QUESTION BLOCK
+ MOVE CMPBLK,QOFF ; SET UP SAME POINTER FOR FIXUP HACKING
+LDLOP1: SKIPE UPTFLG
+ JRST UPTAIL
+ MOVE B,QTABLE(QOFF) ; GET SLOT FOR THIS QUESTION
+ TLNE B,$TSYMBOL
+ JRST LDEND1
+ HRRZ B,(C) ; GET THE RH OF THE FROBNITZ
+ JUMPE B,LDEND1 ; EMPTY. FINISH
+ ADDM A,(C) ; UPDATE THE POINTER
+ MOVE B,QTABLE(QOFF)
+ TLNE B,$TFILE
+ PUSHJ P,LDFILE
+LDEND1: AOS C
+ AOBJN QOFF,LDLOP1
+LDEND2: JSP RET,NEWTYP
+ JRST LDLOOP
+LDOUT:
+IFN ITS,[
+ .CLOSE DSKCHN,
+]
+IFE ITS,[
+ MOVE A,DSKJFN
+ CLOSF
+ JFCL
+]
+ SKIPGE A,UTPSAV
+ JRST LDOUT1
+; FIX UP LINK POINTERS: STORED IN SAVE FILE AS (0-BASED) OFFSETS
+; INTO NEW SECTION OF USER TYPE TABLE
+ ADD A,UTYPLN ; GET AOBJN POINTER TO NEW TYPES
+ MOVE B,A ; IN TWO PLACES
+ PUSH P,A
+LDLN1: MOVE C,(B) ; PICK UP FIRST NEW TYPE
+ HRLZ D,LNKHDR(C) ; PICK UP LINK COUNT
+ JUMPE D,LDLNKL ; NONE
+ HRRI D,LNKHDR+1(C) ; AOBJN POINTER TO LINKS
+LDLNLP: ADD A,(D) ; GET POINTER TO TYPE FOR THIS LINK
+ MOVE E,(A)
+ MOVEM E,(D) ; STUFF IT IN BLOCK
+ MOVE A,(P) ; RESTORE A
+ AOBJN D,LDLNLP
+LDLNKL: AOBJN B,LDLN1
+ POP P,A
+LDOUT1: SKIPE UPTFLG
+ JRST [SKIPN NODUMP
+ PUSHJ P,PRTAIL
+ JRST .+1]
+ SETZM UPTFLG
+ SKIPE ITSFXF
+ PUSHJ P,PRTAIL ; WRITE OUT UPDATE FILE (NEW FORMAT)
+ POPJ P,
+
+;FIXUP POINTERS TO FILE NAMES
+
+LDFILE: HRRZ D,(C)
+ HRLI D,-FSPSIZ
+ SKIPE ITSFXF
+ JRST [PUSH P,A
+ HRLI D,-ITSSIZ
+ MOVEI A,FSPSIZ
+ PUSHJ P,IBLOCK
+ MOVE F,A
+ POP P,A
+ JRST .+1]
+LDFLP: SKIPE ITSFXF
+ JRST ITSFIX
+ SKIPN E,(D)
+ CAIA
+ ADDM A,(D)
+LDFLPE: AOBJN D,LDFLP
+ SKIPN ITSFXF
+ POPJ P,
+ SUBI F,ITSSIZ
+ HRRM F,(C)
+ POPJ P,
+
+ITSFIX: SKIPN E,(D)
+ JRST ITSFX1
+ PUSH P,A
+ MOVE A,E
+ CAIGE E,3
+ CAIG E,0
+ CAIA
+ JRST [MOVE A,[1,,[ASCIZ /\18/]]
+ CAIE E,1
+ MOVE A,[1,,[ASCIZ /\19/]]
+ JRST ITSFX2]
+ PUSHJ P,SIXASC
+ITSFX2: MOVEM A,(F)
+ POP P,A
+ITSFX1: AOJA F,LDFLPE
+
+UPTAIL: MOVEI A,CMPLEN
+ PUSHJ P,IBLOCK ; GET A NEW BLOCK
+ MOVE O,(P)
+ SUBI O,6
+ MOVSS O
+ HRR O,A
+ BLT O,LNALEN(A) ; COPY LINK STUFF
+ ADDI A,LNALEN ; POINT TO FIRST NON-LINK WORD
+ MOVE O,(P)
+ MOVEM A,(P)
+ PUSHJ P,MKTAIL ; MUMBLE THE BLOCK CORRECTLY
+ MOVE RET,O
+ MOVE A,(P) ; AND SAVE ADDRESS AS ABOVE
+ MOVE B,HOWLOC(RET) ; HACK HOW TO RUN AND MORE?
+ MOVEM B,HOWLOC(A)
+ MOVE B,MORLOC(RET)
+ MOVEM B,MORLOC(A)
+UPTLP: MOVE B,(C) ; GET THIS ENTRY IN TAILOR
+ PUSHJ P,QFIND ; GET OFFSET FOR THIS QUESTION IN QOFF, LOC IN D
+ JRST UPEND
+ MOVEM B,(D) ; SAVE AWAY AT CORRECT SLOT
+ MOVE B,QTABLE(QOFF) ; GET THE TYPE CODES
+ TLNE B,$TSYMBOL
+ JRST UPEND
+ HRRZ B,(C) ; GET THE LOCATION OF BLOCK POINTER
+ JUMPE B,UPEND
+ ADDM O,(D) ; UPDATE POINTER
+UPEND: AOJ C,
+ AOBJN CMPBLK,UPTLP
+ JRST LDEND2
+
+; PUSHJ P,QFIND
+; B = WORD FROM TAILOR CONTAINING QUESTION ID BITS
+; SKIP RETURNS IF MUMBLER FOUND, WITH QOFF SET AND D POINTING TO GOOD BLOCK
+
+QFIND: MOVSI QOFF,QNUM
+ LDB F,[220600,,B] ; QUESTION ID FOR THIS QUESTION
+QFLOOP: LDB E,[220600,,QTABLE(QOFF)]
+ CAMN E,F ; SAME QUESTION ID?
+ JRST QFWIN
+ AOBJN QOFF,QFLOOP ; NO. CONTINUE
+ POPJ P,
+
+QFWIN: MOVE D,A ; YES. SET D PROPERLY
+ ADDI D,(QOFF)
+ JRST POPJ1
+
+; PUSHJ P,NAMMAK:
+; TAKES TALSNM, CONSES STRING (LIVES IN TALSTR AND TALSTR+1) AND LENGTH (TALSLN) FOR
+; THAT SNAME
+NAMMAK: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVEI O, ; FOR LENGTH OF FROB
+ MOVE A,[440600,,TALSNM]
+ MOVE B,[440700,,TALSTR] ; BYTE POINTERS
+ MOVEI C,"-
+ IDPB C,B
+ ADDI O,1 ; PRECEDE WITH -
+NAMLOP: ILDB C,A ; GET CHAR
+ JUMPE C,NAMDON
+ AOJ O, ; AOS COUNT
+ ADDI C,40 ; MAKE INTO ASCII
+ IDPB C,B
+ CAIGE O,7
+ JRST NAMLOP ; NOT DONE YET
+NAMDON: ADDI O,1 ; SO WILL GET ASCIZ
+ MOVEM O,TALSLN ; SAVE AWAY LENGTH
+ MOVEI C,0
+ IDPB C,B
+ POP P,C
+ POP P,B
+POPAJ: POP P,A
+ POPJ P,
+
+; PUSHJ P,NAMUNQ: APPENDS CONTENTS OF TALSTR (BETTER BE A STRING AS SET
+; UP BY NAMMAK) TO THE TYPE NAME CONTAINED IN -1(P) (BEFORE ALL THE AC'S
+; ARE PUSHED; AFTER THAT, IT'S BLKLOC(P)). THE BLOCK IS GROWN IF NECESSARY,
+; AND THE POINTER IS UPDATED.
+; LENGTH (IN WORDS) IS INITIALLY IN D
+NAMUNQ: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+BLKLOC==-4 ; LOCATION OF NAME BLOCK ON STACK
+ MOVE A,BLKLOC(P) ; GET NAME BLOCK
+ ADDI A,-1(D) ; POINTER TO LAST WORD
+ HRLI A,10700 ; POINTER TO LAST BYTE
+ MOVEI B, ; INITIALIZE COUNT
+NAMULP: LDB O,A ; GET CHARACTER
+ JUMPN O,NAMTWO ; FOUND REAL NAME?
+ DBP A ; NOPE. GO TO NEXT CHAR
+ AOJA B,NAMULP ; AFTER AOSING COUNT, OF COURSE
+; NUMBER OF FREE CHARACTERS IN LAST WORD OF NAME IS NOW IN B; LENGTH OF
+; STRING TO BE APPENDED IS IN TALSLN.
+NAMTWO: CAML B,TALSLN ; ARE THERE ENOUGH FREE CHARACTERS?
+ JRST NAMBLT ; YES: WIN IMMEDIATE
+ PUSH P,A ; SAVE ILDB POINTER TO LAST BYTE OF NAME
+ MOVE A,B ; GET COUNT IN RIGHT AC
+ SUB A,TALSLN ; HOW MANY CHARS?
+ MOVNS A
+ IDIVI A,5 ; HOW MANY WORDS?
+ JUMPE B,NAMTW1 ; HACK REMAINDER
+ ADDI A,1
+NAMTW1: ADDI A,(D) ; NUMBER OF WORDS NEEDED FOR NEW NAME
+ PUSHJ P,IBLOCK ; GET CORE
+ MOVE B,A
+ HRL B,BLKLOC-1(P) ; CONS UP BLT POINTER
+ MOVEI C,(A) ; OTHER HALF
+ ADDI C,-1(D) ; INCLUDE LENGTH
+ BLT B,(C) ; MOVE NAME BLOCK
+ SUB A,BLKLOC-1(P) ; OFFSET TO NEW BLOCK
+ ADDM A,BLKLOC-1(P) ; UPDATE POINTER
+ ADDM A,(P) ; UPDATE BYTE POINTER
+ POP P,A ; GET IT BACK
+; ILDB POINTER TO NAME IS IN A, REST IS IN TALSTR AND TALSLN
+NAMBLT: MOVE B,[440700,,TALSTR]
+ MOVE C,TALSLN
+NAMBLP: ILDB O,B ; GET CHAR
+ IDPB O,A ; STUFF IT IN
+ SOJG C,NAMBLP ; DONE?
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+; JSP RET,NEWTYP
+; TO ADD A NEW ENTRY TO THE COMPILATION TYPES TABLE
+; LOC OF BLOCK IS IN (P). LOC OF NAME BLOCK IS IN -1(P)
+
+NEWTYP: INTOFF
+ MOVE B,UTYPLN
+ HLRE A,B
+ SUBM B,A
+ POP P,(A) ; POP LOC. OF BLOCK INTO TABLE
+ POP P,D
+ HRLM D,(A) ; MOVE LOC. OF NAME INTO TABLE
+ SUB B,[1,,0]
+ MOVEM B,UTYPLN
+ MOVE B,TYPLEN
+ SUB B,[1,,0]
+ MOVEM B,TYPLEN
+ INTON
+ JRST @RET
+
+IFE ITS,[
+XTALNM: GJ%OLD
+ .NULIO,,.NULIO
+ -1,,[ASCIZ /DSK/]
+ 0
+ -1,,[ASCIZ /COMBAT/]
+ -1,,[ASCIZ /TAILOR/]
+ 0
+ 0
+ 0
+ 0
+]
+; PUSHJ P,PRTAIL
+; PRTAIL PRINTS OUT THE TAILOR INFO TO A FILE
+; ALWAYS RETURNS WITHOUT SKIPPING
+
+PRTAIL:
+IFN ITS,[
+ .CALL TALOPO
+]
+IFE ITS,[
+ MOVSI A,(GJ%FOU+GJ%SHT)
+ HRROI B,[ASCIZ /COMBAT.TAILOR/]
+ GTJFN
+ JRST PRTLER
+ MOVEM A,DSKJFN
+ MOVE B,[440000,,OF%WR]
+ OPENF
+]
+PRTLER: JRST [PUSH P,[OPNFAL]
+ JRST ERRPRT] ; PRINT ERROR
+ SKIPL A,UTYPLN
+ JRST PRTLDN ; EMPTY TABLE ==> LEAVE
+ INTOFF
+PRLOOP: PUSH P,A ; SAVE POINTER TO UTYPTB
+ PUSHJ P,CLINBF
+ MOVEI F,INPBUF+2
+ HLRZ B,(A) ; POINTER TO NAME
+ PUSH P,B
+ HRLI B,440700
+ SETZ D,
+PRCNT: ILDB C,B
+ JUMPE C,PRTAL1
+ AOJA D,PRCNT
+PRTAL1: IDIVI D,5 ; CALCULATE WORDS FOR NAME
+ ADDI D,1
+ POP P,B
+ HRLS B
+ HRR B,F
+ PUSH P,D
+ ADDB D,F ; UPDATE BLOCK POINTER IN F
+ BLT B,-1(D) ; BLT NAME INTO BLOCK
+ HRLZ B,(A)
+ ADD B,[-LNALEN,,0] ; POINT TO REAL BEGINNING OF BLOCK
+ HRR B,F
+ BLT B,CMPLEN-1(F) ; BLT THE COMBLK INTO F
+ PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ HRLZ A,(F) ; # LINKS
+ JUMPE A,PRLNKO
+ HRRI A,1(F) ; AOBJN POINTER TO LINKS
+PRLNK1: MOVE B,UTYPLN
+ MOVEI C,0
+ MOVE D,(A) ; PICK UP POINTER TO TYPE FROM LINK AREA
+PRLNKL: CAMN D,(B) ; COMPARE WITH POINTER IN TYPE TABLE
+ JRST [MOVEM C,(A)
+ JRST PRLNKE] ; SAVE RELATIVE OFFSET IN BLOCK, GO TO NEXT LINK
+ ADDI C,1
+ AOBJN B,PRLNKL ; TRY NEXT TYPE IN TABLE
+IFN ITS,[
+ .VALUE ; THIS CAN'T HAPPEN
+]
+IFE ITS,[
+ HALTF
+]
+PRLNKE: AOBJN A,PRLNK1 ; NEXT LINK
+PRLNKO: POP P,D
+ POP P,C
+ POP P,B
+ POP P,A
+ PUSH P,F
+ ADDI F,LNALEN
+ MOVE C,F ; START OF COPY OF COMBLK
+ ADDI F,CMPSIZ ; AND UPDATE BLOCK POINTER
+ MOVSI QOFF,QNUM
+ MOVEI E,CMPSIZ ; COUNTER OF OFFSETS
+PRLOP1: MOVE B,QTABLE(QOFF)
+ JUMPE B,PREND2
+ TLNE B,$TSYMBOL
+ JRST PREND1
+ HRLZ D,(C)
+ JUMPE D,PREND1
+ TLNE B,$TFILE
+ JRST [MOVEI B,FSPSIZP
+ JRST PRCOPY]
+ LDB B,[%TPLEN,,(C)]
+PRCOPY: PUSH P,F
+ MOVE A,F
+ ADDI A,-1(B)
+ HRR D,F
+ BLT D,(A) ; BLT THIS BLOCK INTO INPBUF
+ HRRM E,(C) ; RELATIVIZED OFFSET
+ ADD E,B ; UPDATE OFFSET
+ ADD F,B ; UPDATE BLOCK END
+ POP P,A
+ MOVE B,QTABLE(QOFF) ; DO FANCY UPDATE FOR FILE NAMES
+ TLNE B,$TFILE
+ PUSHJ P,PRFILE
+PREND1: AOJ C,
+ AOJA QOFF,PRLOP1
+PREND2: POP P,C
+ SUB C,F
+ MOVNM C,INPBUF+1
+ POP P,A ; GET BACK NAME BLOCK LENGTH
+ TLO A,%NWFMT ; ALWAYS NEW FORMAT NOW
+ SKIPE PR2SW
+ TLO A,%TVERB
+ SKIPE FILEXI
+ TLO A,%TFNEX
+ SKIPE NMORAS ; GET ANSWERS TO ANOTHER COMPILATION
+ TLO A,%NMRAS
+ SKIPE MORANS
+ TLO A,%MRANS
+ SKIPN MUDVRB
+ TLO A,%MNVRB
+ MOVE RET,QVERS
+ DPB RET ,[220600,,A]
+ MOVEM A,INPBUF
+ MOVEI A,INPBUF
+ SUB A,F
+ HRLZS A
+ HRRI A,INPBUF ; MAKE AOBJN POINTER TO INPBUF
+IFN ITS,[
+ .IOT DSKCHN,A
+]
+IFE ITS,[
+ PUSHJ P,XIOT
+ A
+ JFCL
+]
+ POP P,A
+ AOBJN A,PRLOOP
+
+PRTLDN: INTON
+IFN ITS,[
+ .CLOSE DSKCHN,
+]
+IFE ITS,[
+ MOVE A,DSKJFN
+ CLOSF
+ JFCL
+]
+ POPJ P,
+
+;RELATIVIZE POINTERS TO FILE NAMES
+PRFILE: HRLI A,-FSPSIZ
+PRFLP: SKIPN B,(A) ; GET FILE NAME POINTER
+ JRST PRFLE ; 0 IS END OF POINTERS
+ HLRZ D,B ; # WORDS IN D
+ ADDI D,-1(F) ; TO POINTER (FOR BLT)
+ MOVE B,F ; CALCULATE FROM POINTER
+ HRL B,(A)
+ BLT B,(D) ; BLT FILE NAME INTO BUFFER
+ HRRM E,(A) ; AND SAVE RELATIVIZED POINTER
+ HLRZ B,(A) ; # WORDS AGAIN IN B
+ ADD E,B ; UPDATE RELATIVIZING ACS
+ ADD F,B
+PRFLE: AOBJN A,PRFLP ; LOOP ON FILE NAMES
+ POPJ P,
+
+\f
+; CREATE USER-DEFINED GROUP. ALTGRP JRST TO CRTAIL, BELOW, AFTER INITIALIZING
+; THINGS TO ITS SATISFACTION. HERE, GET NAME, CREATE BLOCK, INITIALIZE IT MAINLY
+; TO %IGNOR,,0.
+CRTAIL: SETZM ALTER ; CLEAR ALTER FLAG
+ MOVEI A,[ASCIZ /Name of type /] ; GET GROUP NAME
+ MOVEM A,PRMPT1
+ MOVEI A,LINPR2
+ MOVEM A,PRMPT2
+ SETZM CSYMTB
+ MOVEI OUTPTR,0
+ PUSHJ P,GETLIN
+ JUMPE C,CPOPJ
+ PUSHJ P,PRSINP
+ PUSH P,D ; SAVE LOCATION OF NAME
+ MOVEI A,CMPLEN ; GET FRESH BLOCK
+ PUSHJ P,IBLOCK
+ ADDI A,LNALEN ; POINT TO FIRST NON-LINK WORD
+ PUSH P,A ; SAVE LOCATION OF BLOCK
+ PUSHJ P,MKTAIL ; INITIALIZE TAILOR BLOCK
+ MOVE A,(P) ; INITIALIZE HOW TO RUN TO ASK
+ MOVSI B,%ASK+HOWLOC
+ MOVEM B,HOWLOC(A)
+
+; WANTS POINTER TO BLOCK AS TOP OF STACK. CRTAIL & ALTGRP BOTH USE THIS.
+
+CRLOPI: PUSH BK,[0]
+ PUSH BK,[QDONXT]
+ PUSH BK,[[POPJ P,]]
+ PUSH BK,P
+ SETZM FILEXP ; SO FILE NAMES WON'T BE FILLED IN
+CRLOOP: SETZM SQDEF ; DECIDE IF SETTING QUESTION DEFAULT
+CRLOP1: MOVEI B,[ASCIZ /Question /] ; GET QUESTION TO HANDLE
+ MOVE A,[TAILEN,,TAILTB]
+ SKIPE SQDEF ; FUNNY PROMPT AND QUESTION TABLE IF SETDEF
+ JRST [ADD A,[TALSPC,,0]
+ MOVEI B,[ASCIZ / Question /]
+ JRST .+1]
+ MOVEM B,PRMPT1
+ MOVE OUTPTR,(P) ; POINTER TO BLOCK BEING HACKED
+ PUSHJ P,COMTYP
+ TRZE A,$SSMAL ; SPECIAL TYPE?
+ JRST @CRSPEC(A) ; GO HACK IT
+ CAIN A,HOWLOC ; WAS IT HOW TO RUN?
+ JRST HOWTAL
+ CAIN A,MORLOC ; WAS IT ANOTHER COMPILATION??
+ JRST MORC
+ MOVE QOFF,A ; NORMAL CASE
+ ADD OUTPTR,QOFF ; POINTER TO SLOT IN QUESTION
+ MOVE C,(OUTPTR) ; SAVE OLD VALUE FOR CTRL-R
+ MOVEM C,RVALS
+ PUSH BK,[0]
+ PUSH BK,[CRLOPR]
+ PUSH BK,[[POPJ P,]]
+ PUSH BK,P
+CTRRET: MOVE C,QTABLE(QOFF)
+ TLNE C,$TTF ; TRUE/FALSE QUESTION
+ JRST CRTRF
+ TLNE C,$TFILE ; FILE QUESTION
+ JRST [PUSHJ P,CRFDEF
+ JRST TLRASK]
+ HRRZ A,VTABLE (QOFF) ; SET DEFAULT
+ HRRM A,(OUTPTR)
+TLRASK: HLLZ A,QTABLE(QOFF) ;CRETINISM
+ PUSHJ P,ASK1 ; ASK QUESTION
+ JRST NOANS
+; EXPECTS USER-SUPPLIED DEFAULT TO BE IN (OUTPTR), MAKES LH OF A BE RIGHT
+TLRSET: BKOFF
+ HLLZ A,QTABLE(QOFF) ; SINCE CLOBBERED BY ASK, SOMETIMES
+ LDB B,[%TPLEN,,(OUTPTR)] ; GET STRING LENGTH
+ DPB B,[301400,,A] ; PUT IT IN A, TURNING OFF NON-SEQUENCE BITS TOO
+ SKIPE SQDEF
+ JRST [TLO A,%ASK+%DSUP
+ BKOFF
+ JRST TLRST2]
+ TLO A,%IGNOR+%DSUP
+TLRST2: HLLM A,(OUTPTR)
+ JRST CRLOOP
+; HERE FROM CTRL-R. RESTORE (OUTPTR) TO VALUE SAVED IN RVALS
+CRLOPR: CAIA
+ JRST CRLCTG
+ MOVE A,RVALS
+ MOVEM A,(OUTPTR)
+ JRST CRLOP1
+CRLCTG: MOVE A,RVALS
+ MOVEM A,(OUTPTR)
+ JRST CTRRET ; GO HERE IF RETURNING FROM CTRL-G
+
+CRFDEF: MOVEI A,FSPSIZ ; SETS UP SPACE FOR FILE NAME BEFORE ASKING
+ PUSHJ P,IBLOCK
+ HRRM A,(OUTPTR)
+ POPJ P,
+
+; DISPATCH TABLE TO SPECIAL ROUTINES
+CRSPEC: CRDONE ; FINISHED HACKING
+ QDEL ; DELETE QUESTION
+ SETQDF ; SET QUESTION DEFAULT
+ CPRTGP ; PRINT CURRENT TYPE
+ CLINK ; CREATE LINK
+ DLINK ; DELETE LINK
+ XLINK ; EXPAND LINK
+ XXLINK ; EXPAND ALL LINKS
+ LSTLN1 ; LIST LINKS TO ME
+ MYLIN1 ; LIST LINKS FROM ME
+
+; SET UP FOR SETTING QUESTION DEFAULT
+SETQDF: SETOM SQDEF ; SAYS THAT NEXT THING HACKED WILL BE DEF SET
+ PUSH BK,[[ASCIZ /Question/]]
+ PUSH BK,[CRLOOP]
+ PUSH BK,[[POPJ P,]]
+ PUSH BK,P ; SET UP ACTIVATION
+ JRST CRLOP1
+
+; PRINT CURRENT GROUP
+CPRTGP: OASCR [0]
+ PUSH P,[CRLOOP] ; RETURN ADDRESS FROM PRINTER (AN OBSCENITY)
+ MOVE CMPBLK,-1(P) ; CURRENT TYPE
+ PUSHJ P,LINKX1
+ PUSH P,CMPBLK
+ MOVE F,[QNUM-1,,VTABLE]
+ MOVEI QOFF,QTABLE
+ JRST GRPPST
+
+CRDONE: BKOFF
+ SKIPE ALTER ; IF IN ALTER, LET IT CLEAN UP
+ JRST ALTEND
+TALADD: JSP RET,NEWTYP ; GO TO ROUTINE TO ADD NEW TYPE
+TALOUT: PUSHJ P,PRTAIL
+ POPJ P,
+
+; HACKERY FOR TAILORING TRUE/FALSE: DEFAULT IS ASK, BUT LOSER CAN GIVE HIS OWN
+
+CRTRF: SETZM PRMPT1
+ MOVE A,[TFALEN,,TFATBL]
+ PUSHJ P,COMTYP ; GET RESULT
+ TRNE A,400000 ; DID HE DEFAULT?
+ JRST NOANS ; YES: TURN ON ASK BIT
+ HRRM A,(OUTPTR) ; SAVE DEFAULT IN BLOCK
+ HLL A,QTABLE(QOFF)
+ JRST TLRSET
+
+; IF NO ANSWER GIVEN: TURN ON %ASK
+
+NOANS: BKOFF
+ SKIPE SQDEF
+ BKOFF
+ HLLZ A,QTABLE(QOFF)
+ HRR A,VTABLE(QOFF)
+ TLZ A,777700
+ TLO A,%ASK
+ MOVEM A,(OUTPTR)
+ MOVE C,QTABLE(QOFF)
+ TLNN C,$TTF ; IF IT WAS T/F, DON'T NEED TO PRINT <ASK>
+ OASC ASKMSG
+ JRST CRLOOP
+
+; TAILOR HOW TO RUN
+
+HOWTAL: MOVE OUTPTR,(P)
+ SETOM RVALS ; PREVENT MUNGAGE IF CTRL-R
+ MOVE A,[HOWTLN+HOWSPC-1,,HOWTLT] ; TABLE WITH ASK DEFAULT, - ABORT & QUES
+ SETZM PRMPT1
+ JSP RET,MAKACT
+ PUSHJ P,COMTYP
+ BKOFF
+ HRRES A
+ JUMPL A,HOWRED ; SAID 'ASK' IF JUMPS
+ HRLI A,%IGNOR+%DSUP
+ MOVEM A,HOWLOC(OUTPTR)
+ JRST CRLOOP
+HOWRED: MOVSI A,%ASK
+ MOVEM A,HOWLOC(OUTPTR)
+ JRST CRLOOP
+
+; TAILOR ANOTHER COMPILATION? QUESTION
+MORC: SETZM PRMPT1
+ SETOM RVALS
+ MOVE A,[MORLEN,,TMORTB]
+ JSP RET,MAKACT
+ PUSHJ P,COMTYP
+ BKOFF
+ HRRES A ; WILL BE -1 IF SAID ASK
+ JUMPGE A,[HRLI A,%IGNOR+%DSUP
+ JRST MORCOT]
+ MOVSI A,%ASK
+MORCOT: MOVE OUTPTR,(P)
+ MOVEM A,MORLOC(OUTPTR)
+ JRST CRLOOP
+
+; MAKE ACTIVATION--USED BY MORC,QDEL,&C.
+MAKACT: PUSH BK,[[ASCIZ /Question/]]
+ PUSH BK,[CRLOOP]
+ PUSH BK,[[POPJ P,]]
+ PUSH BK,P
+ JRST (RET)
+
+; DELETE QUESTION FROM TAILOR FILE
+QDEL: MOVE A,[TAILEN+TAILSP,,TAILTB]
+ SETZM PRMPT1
+ JSP RET,MAKACT
+ PUSHJ P,COMTYP ; GET QUESTION
+ BKOFF
+ CAIN A,HOWLOC ; IF HOW TO RUN, DEFAULT IS %ASK
+ JRST [TLZ A,777700
+ TLO A,%ASK
+ MOVE OUTPTR,(P)
+ MOVEM A,HOWLOC (OUTPTR)
+ JRST CRLOOP]
+ MOVE OUTPTR,(P)
+ ADD OUTPTR,A
+ MOVE B,QTABLE(A)
+ MOVE A,(OUTPTR)
+ TLNE B,%ESSEN
+ HLLZS A
+ TLZ A,777700
+ TLO A,%IGNOR
+ MOVEM A,(OUTPTR)
+ JRST CRLOOP
+
+\f
+; GET USER COMPILATION TYPE
+GETTYP: MOVEI B,[ASCIZ /Named /]
+GETTP1: MOVEM B,PRMPT1 ; ENTRY FOR FUNNY PROMPTS
+ PUSH P,C
+ MOVE A,UTYPLN
+ TLNE A,-1
+ JRST ARESOM
+ OASCR [ASCIZ /No compilation types defined./]
+ POP P,C
+ POPJ P,
+ARESOM: PUSHJ P,COMTYP ; GET POINTER TO GROUP'S CMPBLK
+ OASCR [0]
+ POP P,C
+ JRST POPJ1
+
+; DELETE USER COMPILATION TYPE: BLTS TABLE UP TO COVER THE VACATED SLOT,
+; FIXES UP TYPE TABLE AOBJN POINTERS
+DELGRP: PUSHJ P,GETTYP
+ POPJ P,
+ PUSHJ P,FNDLNK ; GET LINKS
+ SKIPN B,LNKTPT ; ANY HERE?
+ JRST DELGR1 ; NO, GO DO DELETE
+ PUSH P,SMVAL
+ OASCR [ASCIZ /The following types are linked:/]
+ PUSHJ P,LNKPRT ; PRINT LINKS
+ OASC [ASCIZ /Are you sure you want to delete this?/]
+ MOVEI A,[ASCIZ /(Yes or no) /]
+ MOVEM A,PRMPT1
+ MOVE A,[TFTLEN,,TFTBL]
+ PUSHJ P,COMTYP
+ JUMPE A,[POP P,SMVAL
+ POPJ P,]
+ MOVE B,LNKTPT
+DELLOP: MOVE CMPBLK,1(B)
+ HRRZ A,(B)
+ PUSHJ P,LNKDEL
+ ADD B,[2,,2]
+ JUMPL B,DELLOP
+ POP P,SMVAL
+DELGR1: MOVE A,SMVAL
+ HRRZ B,A
+ HRLS B
+ ADD B,[1,,0]
+ HLRE C,A
+ SUBM A,C
+ BLT B,-1(C)
+ MOVE A,[1,,0]
+ ADDM A,UTYPLN
+ ADDM A,TYPLEN
+ PUSHJ P,PRTAIL
+ POPJ P,
+\f
+; ALTER GROUP: GETS POINTER TO BLOCK, JRST INTO MIDDLE OF CREATE GROUP.
+; MAKES COPY OF GROUP, CHANGES INTO IT; REPLACES IN UTYPTB IFF NORMAL
+; (NON CTRL-R) EXIT FROM CRLOOP.
+ALTGRP: PUSHJ P,GETTYP
+ POPJ P,
+ MOVEM A,ALTER
+ PUSH P,A
+ MOVE E,A
+ PUSHJ P,GETCOP ; COPY WILL BE IN A
+ PUSH P,A ; SAVE IT
+ JRST CRLOPI
+ALTEND: POP P,D ; NEW BLOCK
+ POP P,A ; GET OLD BLOCK
+ MOVEI B,UTYPTB ; GET USER TYPE TABLE
+ALTLOP: HRRZ C,(B)
+ CAME A,C ; IS THIS IT?
+ AOJA B,ALTLOP
+ HRRM D,(B) ; STUFF IT IN
+ MOVE A,ALTER
+ SETZM ALTER
+ PUSHJ P,FNDLNK ; GET EVERYBODY WHO POINTS TO ME
+ SKIPN A,LNKTPT
+ JRST TALOUT ; NOBODY
+ALTLP1: MOVE B,(A) ; POINTER TO SLOT
+ HRRM D,(B) ; CLOBBER TYPE POINTER
+ ADD A,[1,,1] ; ADDED THIS INST. - MARC 12/24 GROSS ME OUT TIM
+ AOBJN A,ALTLP1
+ JRST TALOUT ; PRINT OUT NEW TAILOR
+\f
+; XEROX COPIES A GROUP FROM X TO [NEW] GROUP Y. DUE TO JMB, CHOMP.
+XEROX: PUSHJ P,GETTYP ; GET OLD GROUP
+ POPJ P,
+ MOVE E,A ; OLD GROUP IS IN E
+ MOVEI O,[ASCIZ /To (new type) /]
+ MOVEM O,PRMPT1
+ MOVEI O,LINPR2
+ MOVEM O,PRMPT2
+ SETZM CSYMTB
+ MOVEI OUTPTR,0
+ PUSHJ P,GETLIN ; GET NAME OF NEW GROUP
+ JUMPE C,CPOPJ
+ PUSHJ P,PRSINP ; NAME IS IN D
+ PUSHJ P,GETCOP ; NEW GROUP SHOULD COME OUT IN A, OLD IS IN E
+ PUSH P,D
+ PUSH P,A
+ JRST TALADD ; ADD IT AND DUMP OUT
+
+; RENAME CHANGES NAME OF TYPE. THIS WOULD BE EASY, EXCEPT THAT ALL
+; LINKS TO THE TYPE HAVE TO BE UPDATED.
+RENAME: PUSHJ P,GETTYP ; GROUP BEING RENAMED
+ POPJ P,
+ PUSH P,A ; POINTER TO TYPE
+ PUSH P,SMVAL ; POINTER TO SLOT IN TABLE
+ MOVEI A,[ASCIZ /To (new name) /]
+ MOVEM A,PRMPT1
+ MOVEI A,LINPR2
+ MOVEM A,PRMPT2
+ SETZM CSYMTB
+ MOVEI OUTPTR,0
+ PUSHJ P,GETLIN ; GET NEW NAME
+ JUMPE C,CPOPJ
+ PUSHJ P,PRSINP ; NAME IS IN D
+ POP P,A
+ HRLM D,(A) ; CHANGE NAME IN TABLE
+ POP P,A
+ PUSHJ P,FNDLNK ; GET TABLE OF LINKS TO ME
+ SKIPN A,LNKTPT
+ JRST TALOUT ; DUMP TAILOR--NO LINKS
+RNMLOP: MOVE B,(A) ; PICK UP POINTER TO SLOT
+ HRLM D,(B) ; CLOBBER NAME
+ AOBJN A,RNMLOP
+ JRST TALOUT ; AND DUMP TAILOR
+
+; HERE TO PRINT COMPILE TYPES FOR USER'S INFORMATION
+
+PRTGRP: PUSHJ P,GETTYP
+ POPJ P,
+ MOVE CMPBLK,A
+ PUSHJ P,LINKX1
+ PUSH P,CMPBLK
+ MOVEI QOFF,QTABLE ; TABLE OF QUESTIONS
+ MOVE F,[QNUM-1,,VTABLE] ; USED FOR DEFAULTS
+; WANTS POINTER TO TYPE IN CMPBLK (GETS DESTROYED), QTABLE IN QOFF (DITTO),
+; VTABLE IN F (DITTO), MUNGS B,C. ALSO WANTS TYPE AS TOP OF STACK, TO BE
+; POPPED. FORTUNATELY CALLED FROM CRLOOP, WHICH DOESN'T CARE ABOUT ANY OF
+; THE ACS WHICH GET KILLED (I HOPE!)
+GRPPST: PUSH BK,[0]
+ PUSH BK,[PRAOUT] ; MAKE ACTIVATION TO GET OUT
+ PUSH BK,[[POPJ P,]]
+ PUSH BK,P
+ SETOM LONGOT
+ PUSH P,D
+ PUSH P,H
+GRPPLP: MOVE B,(CMPBLK)
+ TLNE B,%ASK ; DID HE SAY TO ASK?
+ JRST PRASK
+ TLNN B,%DSUP ; DID HE SUPPLY A DEFAULT?
+ JRST ENDPR2 ; NOPE. SKIP THIS ONE.
+ MOVE C,(QOFF) ; PRINT QUESTION
+ TLNE C,%GIGNO ; IS QUESTION TURNED OFF?
+ OASCI "*
+ OASC (C)
+ OHPOS 20.
+DEFPRT: TLNE C,$TFILE ; FILE SPEC?
+ JRST PFSPEC
+ TLNE C,$TTF ; TRUE/FALSE?
+ JRST PTF
+PATOM: OASC (B) ; PRINT WHAT'S THERE
+ENDPR: SKIPN D,H
+ JRST ENDPR1
+ SKIPN D,(D)
+ JRST ENDPR1
+ OASC [ASCIZ / {/]
+ OASC (D)
+ OASCI "}
+ENDPR1: OASCR [0]
+ENDPR2: AOBJN F,MNGACS ; DONE?
+ POP P,H
+ POP P,D
+ POP P,CMPBLK ; PRINT HOW TO RUN
+ MOVEM P,BKPSAV(BK) ; UPDATE SAVED P
+ AOS BKRET(BK) ; SINCE NO LONGER HAVE TO DO POP
+ OASC [ASCIZ /How to run/]
+ OHPOS 20.
+ MOVE A,HOWLOC(CMPBLK)
+ TLNE A,%ASK
+ JRST [OASCR ASKMSG
+ JRST PRMORE]
+ HLRZ A,HOWTBL+1(A)
+ OASC (A)
+ SKIPE A,HOWLOC(H)
+ JRST [OASC [ASCIZ / {/]
+ OASC (A)
+ OASCI "}
+ JRST .+1]
+ OASCR [0]
+PRMORE: OASC [ASCIZ /Another compilation/]
+ OHPOS 20.
+ MOVE A,MORLOC(CMPBLK)
+ TLNN A,%DSUP
+ JRST [OASCR ASKMSG
+ JRST PRDONE]
+ OASC $NO(A)
+ SKIPE A,HOWLOC(H)
+ JRST [OASC [ASCIZ / {/]
+ OASC (A)
+ OASCI "}
+ JRST .+1]
+PRDONE: OASCR [0]
+ SETZM LONGOT
+ BKOFF
+ POPJ P,
+PRAOUT: POP P,CMPBLK
+ POPJ P,
+MNGACS: ADDI CMPBLK,1
+ ADDI QOFF,1
+ JUMPE H,GRPPLP
+ AOJA H,GRPPLP
+
+; PRINT FILE SPEC WHEN DEFAULT SUPPLIED
+PFSPEC: PUSH P,A
+ PUSH P,C
+ MOVEI C,CHRTBL
+ HRLI B,-FSPSIZ
+PFSLP: SKIPN A,(B)
+ JRST PFS1
+ SPNAM1 A
+ JRST [PUSHJ P,CXPRT
+ JRST PFS2]
+ OASC (A)
+ SKIPE 1(B)
+PFS2: OASC (C)
+PFS1: AOJ C,
+ AOBJN B,PFSLP
+ POP P,C
+ POP P,A
+ JRST ENDPR
+
+CXPRT: MOVE A,SSSPPP
+ CAIE A,1
+ JRST CXPRT1
+ OASCI ^X
+ POPJ P,
+
+CXPRT1: OASCI ^Y
+ POPJ P,
+
+; PRINT TRUE/FALSE TYPE QUESTION
+PTF: OASC $NO(B)
+ JRST ENDPR
+$NO: ASCIZ /No/
+$YES: ASCIZ /Yes/
+
+ASKMSG: ASCIZ /<ASK>/
+PRASK: MOVE C,(QOFF)
+ TLNE C,%GIGNO
+ OASCI "*
+ OASC (C)
+ OHPOS 20.
+ OASC ASKMSG
+ TLNE B,%DSUP ; DEFAULT SUPPLIED?
+ JRST [OASC [ASCIZ /: /]
+ JRST DEFPRT]
+ JRST ENDPR
+
+; LOAD AND REPLACE: MUNGIFICATE YOUR FROBNITZES
+GETAIL: SETO QOFF, ; CRETINIZE THE POINTER
+ MOVEI OUTPTR,TALPTR ; TALPTR HAS POINTER TO TAILOR INPUT FILE NAMES
+ ; ==> DEFAULTS GET SET, ETC.
+ SETOM FILEXP
+ PUSHJ P,ASK ; GO GET FILE NAME
+ JRST DRPOUT
+IFN ITS,[
+ MOVE O,SNAME
+]
+IFE ITS,[
+ MOVE O,(OUTPTR)
+]
+ MOVEM O,SYSDIR ; RESTORE SYSTEM DEFAULTS
+ CAME O,TALSNM
+ SETOM NODUMP
+ SETOM LDFLAG
+
+IFN ITS,[
+ MOVEI B,TALDV
+ MOVE A,(B)
+ PUSHJ P,ASCSIX
+ MOVEM A,TALDEV
+ MOVE A,1(B)
+ PUSHJ P,ASCSIX
+ MOVEM A,TALSNM
+ MOVE A,2(B)
+ PUSHJ P,ASCSIX
+ MOVEM A,TALFN1
+ MOVE A,3(B)
+ PUSHJ P,ASCSIX
+ MOVEM A,TALFN2
+]
+
+IFE ITS,[
+ MOVE A,TALDV
+ HRROM A,XTALNM+.GJDEV
+ MOVE A,TALDV+1
+ HRROM A,XTALNM+.GJDIR
+ MOVE A,TALDV+2
+ HRROM A,XTALNM+.GJNAM
+ MOVE A,TALDV+3
+ HRROM A,XTALNM+.GJEXT
+]
+ PUSHJ P,LDTAIL ; LOAD NEW FILE
+ SETZM NODUMP
+ POPJ P,
+; REPLACE TAILOR. JUST LIKE ABOVE, EXCEPT CLOBBERS CURRENT USER TYPE TABLES
+; FIRST
+RPTAIL: SETO QOFF,
+ MOVEI OUTPTR,TALPTR
+ SETOM FILEXP ; WANT FULLY-SPECIFIED FILE NAMES
+ PUSHJ P,ASK
+ JRST DRPOUT
+ HLLZ A,UTYPLN ; GET NUMBER OF USER TYPES
+ MOVNS A ; MAKE IT POSITIVE
+ ADDM A,TYPLEN ; ADD TO LEFT HALF OF AOBJN POINTERS
+ ADDM A,UTYPLN
+ MOVE O,SNAME
+ MOVEM O,SYSDIR ; RESTORE SYSTEM DEFAULTS
+ CAME O,TALSNM
+ SETOM NODUMP
+ SETZM LDFLAG ; DON'T NEED TO UNIQIFY NAMES
+ PUSHJ P,LDTAIL ; LOAD NEW FILE
+ SETZM NODUMP
+ POPJ P,
+
+; COME HERE IF LOSER REFUSED TO GIVE FILE NAME.
+
+DRPOUT: IFE ITS,MOVEI TALDV
+ IFN ITS,MOVEI TALDEV
+ HRRM TALPTR
+ OASCR [ASCIZ /Aborted?/]
+ POPJ P,
+
+\f
+SUBTTL LINK HACKERS
+
+; COME HERE TO CREATE (IF NEEDED) A NEW BLOCK, WITH ALL LINKS EXPANDED.
+; INITIAL BLOCK IS IN CMPBLK, RETURN IN CMPBLK. LINKX1 CAUSES BLOCK WITH
+; POINTERS TO TYPES USED TO BE SET UP AS WELL; H IS RESERVED FOR A POINTER TO
+; THIS IF IT EXISTS, AND THE POINTER IS RETURNED THERE.
+
+LINKX1: CAIG CMPBLK,MUMBLE ; USER TYPES WILL BE ABOVE MUMBLE
+ POPJ P,
+ SKIPN LNKHDR(CMPBLK) ; ANY LINKS?
+ JRST [MOVEI H,0
+ POPJ P,] ; NO
+ PUSH P,A
+ MOVEI A,CMPSIZ
+ PUSHJ P,IBLOCK
+ MOVE H,A
+ JRST LINKX2
+LINKX: MOVEI H,0
+ CAIG CMPBLK,MUMBLE
+ POPJ P,
+ PUSH P,A
+LINKX2: SKIPN A,LNKHDR(CMPBLK)
+ JRST POPAJ ; NO LINKS, SO LEAVE
+ PUSH P,B ; AOBJN POINTER TO LINK AREA
+ PUSH P,C ; LINK TO THIS TYPE IS BEING EXPANDED
+ MOVEI B,-LNKCNT(CMPBLK) ; ADDRESS OF FIRST LINK
+ HRLI B,(A)
+ MOVEI A,CMPSIZ
+ PUSHJ P,IBLOCK
+ HRLI C,(CMPBLK)
+ HRRI C,(A)
+ BLT C,CMPSIZ-1(A)
+LINKXL: MOVE C,(B) ; GET POINTER TO LINK TYPE
+ PUSHJ P,EXPAND ; EXPAND IT
+ AOBJN B,LINKXL
+ MOVE CMPBLK,A
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+; COME HERE TO EXPAND A SINGLE LINK. BLOCK TO EXPAND INTO IS IN A, BLOCK TO
+; EXPAND FROM IS IN C, BLOCK TO SAVE TYPE INFO IN (IF EXISTS) IS IN H.
+EXPAND: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ PUSH P,H
+ HRLI A,-CMPSIZ ; SET UP AOBJN POINTER
+EXLOOP: MOVE B,(A) ; PICK UP WORD
+ TLNE B,%DSUP+%ASK ; SOMETHING ALREADY HERE?
+ JRST EXLOPE ; YES, GO TO NEXT
+ MOVE B,(C)
+ TLNN B,%DSUP+%ASK ; SOMETHING IN LINK TYPE?
+ JRST EXLOPE
+ MOVEM B,(A) ; YES, STUFF IT OUT
+ JUMPE H,EXLOPE ; IF NOTHING IN H, LOOP AGAIN
+ HLRM C,(H) ; SAVE POINTER TO NAME OF TYPE THIS CAME FROM
+EXLOPE: AOBJP A,EXPOUT ; END OF BLOCK?
+ ADDI C,1
+ JUMPE H,EXLOOP
+ AOJA H,EXLOOP ; UPDATE POINTERS, LOOP AGAIN
+EXPOUT: POP P,H
+ POP P,D
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+\f
+; COME HERE FROM TAILOR LOOP TO CREATE LINK. GET TYPE FROM USER, STUFF
+; IT INTO LINK AREA OF CURRENT GROUP.
+
+CLINK: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ MOVE C,OUTPTR
+ PUSHJ P,GETTYP ; GET TYPE IN A
+ JRST CLINKO
+ SKIPN B,ALTER ; IN ALTER GROUP?
+ JRST CLINK1
+ CAMN A,B ; LINKING TO SELF?
+ JRST [OASCR [ASCIZ /Can't link group to self./]
+ JRST CLINKO]
+CLINK1: HRLZ B,LNKHDR(C)
+ JUMPE B,CLINKW
+ HRRI B,LNKHDR+1(C)
+CLINKC: HRRZ D,(B)
+ CAIN D,(A) ; SAME TYPE?
+ JRST [OASCR [ASCIZ /Already linked./]
+ JRST CLINKO]
+ AOBJN B,CLINKC
+ MOVN B,LNKHDR(C) ; GET # OF LINKS ALREADY HERE
+ CAIL B,LNKCNT
+ JRST [OASCR [ASCIZ /Link area full./]
+ JRST CLINKO]
+CLINKW: PUSHJ P,GETNAM ; TURN TYPE (IN A) INTO NAME,,TYPE
+ ADDI B,1
+ MOVNM B,LNKHDR(C) ; SAVE - THE COUNT AWAY
+ ADDI B,LNKHDR(C) ; SLOT TO CLOBBER
+ MOVEM A,(B) ; SAVE LINK AWAY
+CLINKO: POP P,D
+ POP P,C
+ POP P,B
+ POP P,A
+ JRST CRLOOP ; BACK INTO LOOP
+\f
+; LINK DELETION ROUTINES. DLINK IS CALLED FROM CRLOOP; LNKDEL ACTUALLY DOES
+; THE WORK, AND IS CALLED FROM NUMEROUS PLACES (DELETE TYPE, FOR EXAMPLE).
+
+DLINK: PUSH P,A
+ MOVE CMPBLK,OUTPTR
+ PUSHJ P,LNKGET ; GET POINTER TO LINK SLOT AFFECTED, IN A
+ JRST DLINKO ; OH, WELL
+ PUSHJ P,LNKDEL ; DO DELETION
+DLINKO: POP P,A
+ JRST CRLOOP
+
+; COME HERE TO DELETE LINK IN SLOT POINTED AT BY A FROM BLOCK IN CMPBLK
+LNKDEL: PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ MOVN B,LNKHDR(CMPBLK) ; NUMBER OF LINKS
+ MOVEI C,(A)
+ SUBI C,LNKHDR(CMPBLK)
+ CAIN C,(B) ; LAST LINK IN BLOCK?
+ JRST LNKDLO
+ HRRI C,(A)
+ HRLI C,1(A) ; BLT POINTER
+ ADDI B,LNKHDR-1(CMPBLK) ; LAST WORD IN BLT
+ BLT C,(B) ; BLT BLOCK UP
+LNKDLO: AOS LNKHDR(CMPBLK) ; UPDATE COUNT
+POPDCB: POP P,D
+ POP P,C
+ POP P,B
+ POPJ P,
+\f
+; COME HERE TO EXPAND LINK IN TAILORING. XLINK DOES A SINGLE LINK,
+; XXLINK DOES ALL LINKS.
+XLINK: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ MOVE CMPBLK,OUTPTR
+ PUSHJ P,LNKGET ; GET POINTER TO SLOT IN A
+ JRST XLINKO ; NOTHING TO FROB
+ HRRZ C,(A) ; PUT IT IN C
+ PUSH P,A
+ MOVE A,OUTPTR
+ PUSHJ P,EXPAND ; DO EXPANSION
+ POP P,A
+ PUSHJ P,LNKDEL ; DELETE LINK FROM BLOCK, SINCE IT'S EXPANDED
+XLINKO: POP P,C
+ POP P,B
+ POP P,A
+ JRST CRLOOP
+
+XXLINK: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ HRLZ B,LNKHDR(OUTPTR) ; GET COUNT
+ JUMPE B,XLINKO
+ HRRI B,LNKHDR+1(OUTPTR) ; AOBJN POINTER
+ MOVE A,OUTPTR
+XXLNLP: HRRZ C,(B)
+ PUSHJ P,EXPAND
+ AOBJN B,XXLNLP
+ SETZM LNKHDR(A) ; ZERO COUNT
+ HRLI B,LNKHDR(A)
+ HRRI B,LNKHDR+1(A)
+ BLT B,-1(A) ; ZERO ALL POINTERS
+ JRST XLINKO ; AND LEAVE
+\f
+; MAKE A COPY OF A BLOCK, WITH LINKS. RETURN COPY IN A, BLOCK TO BE COPIED
+; IS IN E.
+
+GETCOP: PUSH P,B
+ PUSH P,C
+ MOVEI A,CMPLEN
+ PUSHJ P,IBLOCK
+ MOVEI B,LNKHDR(E) ; POINTER TO BEGINNING OF OLD BLOCK
+ HRL C,B
+ HRR C,A
+ BLT C,CMPLEN-1(A)
+ ADDI A,LNALEN ; UPDATE POINTER TO NEW BLOCK
+ POP P,C
+ POP P,B
+ POPJ P,
+
+; GIVEN POINTER TO TYPE IN A, RETURN IN A NAME,,TYPE.
+GETNAM: PUSH P,B
+ PUSH P,C
+ MOVE B,UTYPLN
+GETNLP: HRRZ C,(B)
+ CAIE A,(C)
+ AOBJN B,GETNLP ; MUST SUCCEED EVENTUALLY
+ MOVE A,(B)
+ POP P,C
+ POP P,B
+ POPJ P,
+
+; GET POINTER TO SLOT IN LINK AREA WE WANT TO PLAY WITH. SKIPS IF WINS.
+LNKGET: PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ HRLZ A,LNKHDR(CMPBLK)
+ JUMPE A,[OASCR [ASCIZ /No links?/]
+ JRST POPDCB] ; NO LINKS, TOO BAD
+ HRRI A,LNKHDR+1(CMPBLK)
+ PUSH P,A
+ MOVEI B,[ASCIZ /Named /]
+ MOVEM B,PRMPT1
+ PUSHJ P,COMTYP ; GET TYPE
+ OASCR [0]
+ POP P,B
+LNKGLP: HRRZ C,(B) ; SEARCH FOR SLOT
+ CAIE C,(A)
+ AOBJN B,LNKGLP
+ MOVE A,B
+ AOS -3(P)
+ JRST POPDCB
+\f
+; FNDLNK CONSES UP TABLE OF ALL POINTERS TO THIS TYPE: FORMAT IS
+; LNKTPT: <AOBJN POINTER TO LNKTAB>
+; LNKTAB: NAME OF TYPE LINKING,,POINTER TO SLOT CONTAINING LINK
+; POINTER TO TYPE
+; THIS IS USED FOR THE 'LINKS?' COMMAND, FOR DELETE TYPE, RENAME TYPE,
+; AND ALTER TYPE (TO DO SUBSTITUTES). TYPE IS IN A.
+FNDLNK: PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ PUSH P,E
+ PUSH P,F
+ MOVEI B,LNKTAB ; BUILD A SORT OF AOBJN POINTER
+ MOVE F,UTYPLN ; POINTER TO USER TYPES
+ TLNN F,-1
+ JRST FNDLNO ; ANY TYPES DEFINED?
+FNDOUT: MOVE C,(F) ; POINTER TO TYPE
+ HRLZ D,LNKHDR(C) ; NUMBER OF LINKS IN THIS BLOCK
+ JUMPE D,FNDLPE
+ HRRI D,LNKHDR+1(C) ; AOBJN POINTER TO LINKS
+FNDIN1: HRRZ E,(D)
+ CAIE A,(E)
+ JRST FNDINL
+ HLL D,C ; STUFF POINTER TO NAME IN LH
+ MOVEM D,(B) ; SAVE IN LNKTAB
+ HRRZM C,1(B) ; SAVE TYPE
+ ADD B,[2,,2]
+ JRST FNDLPE ; END LOOP
+FNDINL: AOBJN D,FNDIN1 ; THROUGH WITH THIS TYPE?
+FNDLPE: AOBJN F,FNDOUT ; GO TO NEXT TYPE
+FNDLNO: TLNN B,-1 ; ANY LINKS FOUND?
+ JRST [SETZM LNKTPT
+ JRST FNDDON]
+ HLRZS B
+ MOVNS B
+ HRLZS B
+ HRRI B,LNKTAB
+ MOVEM B,LNKTPT
+FNDDON: POP P,F
+ POP P,E
+ JRST POPDCB
+\f
+; LSTLNK PRINTS ALL TYPES LINKED TO A TYPE OBTAINED FROM THE USER.
+LSTLNK: PUSH P,A
+ PUSHJ P,GETTYP
+ JRST POPAJ
+ PUSHJ P,FNDLNK ; GET ALL LINKS
+ PUSHJ P,LNKPRT
+ JRST POPAJ
+
+; SAME FOR CALL FROM ALTER GROUP
+LSTLN1: PUSH P,A
+ OASCR [0]
+ SKIPN A,ALTER
+ JRST [OASCR [ASCIZ /No links/]
+ JRST LSTLNO]
+ PUSHJ P,FNDLNK
+ PUSHJ P,LNKPRT
+LSTLNO: POP P,A
+ JRST CRLOOP
+
+; PUSHJ P HERE AFTER CALL TO FNDLNK TO PRINT NAMES OF ALL LINKS IN LNKTAB
+LNKPRT: PUSH P,A
+ SKIPN A,LNKTPT
+ JRST [OASCR [ASCIZ /No links/]
+ JRST POPAJ]
+ PUSH P,B
+ PUSH BK,[0]
+ PUSH BK,[LNKPRO]
+ PUSH BK,[[POPJ P,]]
+ PUSH BK,P
+ SETOM LONGOT
+LNKPRL: HLRZ B,(A)
+ OASCR (B)
+ ADD A,[2,,2]
+ JUMPL A,LNKPRL
+ SETZM LONGOT
+ BKOFF
+LNKPRO: POP P,B
+ JRST POPAJ
+
+; TYPE OF COMPILATION: EVERYBODY I'M LINKED TO
+MYLINK: PUSHJ P,GETTYP
+ POPJ P,
+ PUSHJ P,MYLNKP ; TAKES ARG IN A
+ POPJ P,
+
+MYLNKP: PUSH P,B
+ PUSH P,C
+ HRLZ B,LNKHDR(A)
+ JUMPE B,[OASCR [ASCIZ /No links/]
+ JRST MYLNKO]
+ HRRI B,LNKHDR+1(A)
+ PUSH BK,[0]
+ PUSH BK,[MYLNKO]
+ PUSH BK,[[POPJ P,]]
+ PUSH BK,P
+ SETOM LONGOT
+ OASCR [ASCIZ /Links to:/]
+MYLNKL: HLRZ C,(B)
+ OASCR (C)
+ AOBJN B,MYLNKL
+ SETZM LONGOT
+ BKOFF
+MYLNKO: POP P,C
+ POP P,B
+ POPJ P,
+
+; COME HERE FROM ALTER GROUP TO DO SAME
+MYLIN1: MOVE A,OUTPTR
+ PUSHJ P,MYLNKP
+ JRST CRLOOP
+\f
+SUBTTL TABLES: QUESTIONS, OUTPUT, HOW TO RUN, &C.
+; TYPE CODES,,QUESTION LOCATION
+
+TALPTR: TALDV
+LDQUES: QUESTION $TFSP,0,,[From ] ; QUESTION FOR LOAD & REPLACE TAILOR
+QTABLE: QUESTION $TSTR+%ESSEN,25.,.QSNAM,[Sname ]
+ QUESTION $TTF+%TNMNY,0,.QNEWC,[Use new compiler? ]
+ QUESTION %GIGNO+$TTF,27.,.QDEBU,[Debugging compiler? ]
+ QUESTION $TFIL+%ESSEN,1,.QINP,[Input from ]
+ QUESTION $TFIL+%ESSEN,2,.QOUT,[Output to ]
+ QUESTION $TFSP,3,.QPREC,[Precompilation from ]
+ QUESTION $TFSP+%ESSEN,4,.QCOMP,[Compare with ]
+ QUESTION $TTF,22.,.QMANI,[Check macros? ]
+ QUESTION $TSTR,23.,.QCJCL,[Extra JCL ]
+ QUESTION $TSTR,5,.QREDO,[Redo ]
+ QUESTION $TSTR+%ESSEN,6,.QPACK,[Package mode ]
+ QUESTION %GIGNO+$TSTR,20.,.QGROP,[Group mode ]
+ QUESTION %GIGNO+$TSTR,7,.QSURV,[Survivors ]
+ QUESTION $TFSP+%NSYSD,8.,.QTEMP,[Temporary file to ]
+ QUESTION $TFSP,9.,.QSRC,[Source file to ]
+ QUESTION $TTF,10.,.QSPEC,[Special? ]
+ QUESTION $TTF,12.,.QEXPF,[Expand floads? ]
+ QUESTION $TTF,13.,.QEXPS,[Expand splices? ]
+ QUESTION $TTF,14.,.QCARE,[Careful? ]
+ QUESTION $TTF,15.,.QREAS,[Reasonable? ]
+ QUESTION $TTF,16.,.QGLUE,[Glue? ]
+ QUESTION $TTF,17.,.QMCRO,[Macro compile? ]
+ QUESTION $TTF,21.,.QMCRF,[Macro flush? ]
+ QUESTION $TTF,18.,.QMAXS,[Max space? ]
+ QUESTION $TSTR,26.,.QTHN0,[First things to do ]
+ QUESTION $TSTR+%NOQ,19.,.QTHNG,[Things to do ]
+ QUESTION $TSTR,24.,.QTHN1,[Last things to do ]
+ 0 ; HAS TO BE ZERO--END OF REGULAR QUESTIONS
+
+CRETQ=63. ; 'NULL QUESTION', USED SOMEWHERE
+\f
+SUBTTL QUESTION TREE
+; FORMAT: THISQ: QUESTION OFFSET OR -1 (-1-->NOT REALLY A QUESTION)
+; FORKS: YES,,NO
+; INST: EXECUTE ME TO ASK QUESTION (OR WHATEVER)
+; BACK: LOCATION TO BACK UP TO (CLOBBERED BY MAIN LOOP)
+; ENTRIES GENERATED BY QTM MACRO: CALL IS
+; QTM SYMBOL,QSYM,SYMYES,SYMNO,[INST]
+
+QTREE: QTM .TCOMT,<%TNOTQ+%TNMEM>_22,.TSNAM,.TCOMT,[PUSHJ P,GCOMTP] ; COMPILATION TYPE
+ QTM .TSNAM,.QSNAM,.TNEWC,.TNEWC,[PUSHJ P,ASKSNM] ; SNAME QUESTION
+ QTM .TNEWC,.QNEWC,.TDEBU,.TDEBU,[PUSHJ P,ASKQ] ; NEW COMPILER
+ QTM .TDEBU,.QDEBU,.TINP,.TINP,[PUSHJ P,ASKQ] ; DEBUGGING COMPILER?
+ QTM .TINP,.QINP,.TOUT,.TOUT,[PUSHJ P,FASKQ] ; INPUT FILE
+ QTM .TOUT,.QOUT,.TPREC,.TPREC,[PUSHJ P,ASKQ] ; OUTPUT FILE
+ QTM .TPREC,.QPREC,.TCOMP,.TGROP,[PUSHJ P,FASKQ] ; PRECOMPILED?
+ QTM .TCOMP,.QCOMP,.TMANI,.TRED0,[PUSHJ P,ASKQ] ; COMPARE? (ONLY IF PRECOMPILED)
+ QTM .TMANI,.QMANI,.TCJCL,.TCJCL,[PUSHJ P,ASKQ] ; CHECK MACROS? (IF COMPARE)
+ QTM .TCJCL,.QCJCL,.TRUN,.TRUN,[PUSHJ P,ASKQ] ; EXTRA JCL?
+ QTM .TRUN,<%TNOTQ+%TNBCK>_22,.TRED1,.TRED1,[PUSHJ P,MUDCOM] ; RUN MUDCOM
+ QTM .TRED1,.QREDO,.TTEMP,.TTEMP,[PUSHJ P,ASKQ] ; ASK REDO (ONLY IF MUDCOM)
+ QTM .TRED0,.QREDO,.TPACK,.TTEMP,[PUSHJ P,ASKQ] ; ASK REDO IF NO MUDCOM
+ QTM .TPACK,.QPACK,.TTEMP,.TTEMP,[PUSHJ P,ASKQ] ; ASK PACKAGE MODE IF NO MUDCOM
+ QTM .TGROP,.QGROP,.TSURV,.TTEMP,[PUSHJ P,ASKQ] ; ASK GROUP COMPILE, IF NO PREC
+ QTM .TSURV,.QSURV,.TTEMP,.TTEMP,[PUSHJ P,ASKQ] ; ASK SURVIVORS IF GROUP COMPILE
+ QTM .TTEMP,.QTEMP,.TSRC,.TSRC,[PUSHJ P,ASKQ] ; TEMPORARY FILE
+ QTM .TSRC,.QSRC,.TSPEC,.TSPEC,[PUSHJ P,ASKQ] ; SOURCE
+ QTM .TSPEC,.QSPEC,.TEXPF,.TEXPF,[PUSHJ P,ASKQ] ; SPECIAL?
+ QTM .TEXPF,.QEXPF,.TEXPS,.TEXPS,[PUSHJ P,ASKQ] ; EXPAND FLOADS?
+ QTM .TEXPS,.QEXPS,.TCARE,.TCARE,[PUSHJ P,ASKQ] ; EXPAND SPLICES?
+ QTM .TCARE,.QCARE,.TREAS,.TREAS,[PUSHJ P,ASKQ] ; CAREFUL?
+ QTM .TREAS,.QREAS,.TGLUE,.TGLUE,[PUSHJ P,ASKQ] ; REASONABLE?
+ QTM .TGLUE,.QGLUE,.TMCRO,.TMCRO,[PUSHJ P,ASKQ] ; GLUE?
+ QTM .TMCRO,.QMCRO,.TMAXS,.TMCRF,[PUSHJ P,ASKQ] ; MACRO COMPILE?
+ QTM .TMCRF,.QMCRF,.TMAXS,.TMAXS,[PUSHJ P,ASKQ] ; MACRO FLUSH? (IF NOT COMPILE)
+ QTM .TMAXS,.QMAXS,.TTHN0,.TTHN0,[PUSHJ P,ASKQ] ; MAX SPACE?
+ QTM .TTHN0,.QTHN0,.TTHNG,.TTHNG,[PUSHJ P,ASKQ] ; FIRST THINGS TO DO
+ QTM .TTHNG,.QTHNG,.TTHN1,.TTHN1,[PUSHJ P,ASKQ] ; THINGS TO DO
+ QTM .TTHN1,.QTHN1,.THOWR,.THOWR,[PUSHJ P,ASKQ] ; LAST THINGS TO DO
+ QTM .THOWR,<%TNOTQ+%TNBCK>_22,.TASK,.TCOMT,[PUSHJ P,DONE] ; HOW-TO-RUN
+ QTM .TASK,<%TNOTQ+%TNMEM>_22,.THOWR,.THOWR,[PUSHJ P,HASK] ; QUESTION ESCAPE
+
+
+
+\f
+SUBTTL MORE TABLES
+; SPECIFIES OUTPUT ORDER: TYPE,,LEADING IN FIRST WORD, OFFSET INTO OUTPUT,,TRAILING
+; IN SECOND
+
+$OT.FF==0
+$OT.FT==1
+$OFNAM==2
+$OFORM==3
+$OSTRG==4
+$OREDO==5
+$OSNAM==6 ; OUTPUT <SNAME "FOO">
+
+; OUTPUT SPECIFICATIONS
+; TYPE,OFFSET,HEADER,TRAILER
+
+OUTSPC: OUTPUT $OSNAM, .QSNAM,/<SNAME "/, CSTRNG
+ OUTPUT $OFORM, .QNEWC,/<OR <GASSIGNED? EXPERIMENTAL!-> <NEWCOMP!->> /, CR
+ OUTPUT $OFNAM, .QINP,/<SETG COMBAT!- /, CANGLB
+ OUTPUT $OFNAM, .QPREC,/<SET PRECOMPILED!- /, CANGLB
+ OUTPUT $OREDO, .QCOMP,/<SET REDO!- (/, CLIST
+ OUTPUT $OSTRG, .QPACK,/<SET PACKAGE-MODE!- "/, CSTRNG
+ OUTPUT $OSTRG, .QSURV,/<SET SURVIVORS!- (/, CLIST
+ OUTPUT $OFNAM, .QTEMP,/<SET TEMPNAME!- /, CANGLB
+ OUTPUT $OFNAM, .QSRC,/<SET SOURCE!- /, CANGLB
+ OUTPUT $OT.FF, .QSPEC,/<SET SPECIAL!- /, CANGLB
+ OUTPUT $OT.FF, .QEXPF,/<SET EXPFLOAD!- /, CANGLB
+ OUTPUT $OT.FF, .QEXPS,/<SET EXPSPLICE!- /, CANGLB
+ OUTPUT $OT.FF, .QDEBU,/<SET DEBUG-COMPILE!- /,CANGLB
+ OUTPUT $OT.FT, .QCARE,/<SET CAREFUL!- /, CANGLB
+ OUTPUT $OT.FT, .QREAS,/<SET REASONABLE!- /, CANGLB
+ OUTPUT $OT.FT, .QGLUE,/<SET GLUE!- /, CANGLB
+ OUTPUT $OT.FF, .QMCRO,/<SET MACRO-COMPILE!- /, CANGLB
+ OUTPUT $OT.FF, .QMCRF,/<SET MACRO-FLUSH!- /,CANGLB
+ OUTPUT $OT.FF, .QMAXS,/<SET MAX-SPACE!- /, CANGLB
+ OUTPUT $OSTRG, .QTHN0,, CR,1
+ OUTPUT $OSTRG, .QTHNG,, CR,1
+ OUTPUT $OSTRG, .QTHN1,, CR,1
+ OUTPUT $OFNAM, .QINP,/<FCOMP %.INCHAN /,
+ OUTPUT $OFNAM, .QOUT,/ /, CANGLB
+ 0
+ 0
+
+OUTTBL: -2*CMPSIZ,,OUTSPC
+
+CR: ASCIZ /
+/
+CANGLB: ASCIZ />
+/
+CLIST: ASCIZ /)>
+/
+CSTRNG: ASCIZ /">
+/
+\f
+; INITIAL TABLE OF COMPILATION TYPES. $SPTYPE MEANS THAT TYPE DOESN'T MAKE
+; A PLAN--HANDLED BY TURNING OFF $SPTYPE, JRSTING TO NTH ELEMENT OF TABLE FOR
+; SPECIALS.
+NTYPTB: SYMVAL None,$SPTYPE+.TQUIT ; USED AFTER FIRST COMPILATION
+TYPTBL: SYMVAL Verbose,VTABLE ; VERBOSE COMPILATION--DEFAULT
+ SYMVAL Short,STABLE ; SHORT COMPILATION
+ SYMVAL Multiple,$SPTYPE+.TMULT ; MULTIPLE
+ SYMVAL Toggle Verbosity,$SPTYPE+.TTOGV ; TOGGLE VERBOSITY
+ SYMVAL Toggle MUDCOM verbosity,$SPTYPE+.TTOMV
+ SYMVAL Toggle Input File Existence Check,$SPTYPE+.TTOEX
+ SYMVAL More compilations,$SPTYPE+.TSMOR ; SET ANOTHER COMPILATION
+ SYMVAL Create type,$SPTYP+.TCRTG ; CREATE TYPE
+ SYMVAL Alter type,$SPTYP+.TALTG ; CHANGE TYPE
+ SYMVAL Print type,$SPTYP+.TPRTG ; PRINT TYPE
+ SYMVAL Delete type,$SPTYP+.TDELG ; DELETE TYPE
+ SYMVAL Rename type,$SPTYP+.TRNM ; RENAME TYPE
+ SYMVAL Xerox type,$SPTYP+.TXROX ; COPY TYPE
+ SYMVAL Load tailor,$SPTYP+.TLDTL ; LOAD TAILOR
+ SYMVAL Replace tailor,$SPTYP+.TRPTL ; REPLACE TAILOR
+ SYMVAL Quit,$SPTYPE+.TQUIT ; QUIT
+ SYMVAL Many flush,$SPTYPE+.TFLUS ; KILL LONG COMPILATION
+ SYMVAL Many print,$SPTYPE+.TPLON ; PRINT LONG COMPILATION
+ SYMVAL List links to type,$SPTYPE+.TLNKL ; WHO'S LINKED TO ME?
+ SYMVAL List links from type,$SPTYPE+.TMLNK ; TO WHOM?
+ITYPLE==TYPTBL-.
+UTYPTB: BLOCK 80. ;SPACE FOR USER-DEFINED TYPES
+UTYPLN: UTYPTB
+UTPSAV: 0 ; USED IN LOAD TAILOR FOR LINK HACKING
+TYPLEN: ITYPLE,,TYPTBL ; INITIAL AOBJN POINTER TO TYPTBL
+LNKTPT: 0 ; AOBJN POINTER INTO LNKTAB
+LNKTAB: BLOCK 60. ; USED TO ACCUMULATE POINTERS TO A GIVEN TYPE
+
+; TABLE FOR HOW-TO-RUN. FIRST ELEMENT IS USED IN TAILOR-MAKING, SO DEFAULT
+; THERE IS ASK.
+
+HOWTLT: SYMVAL <ASK>,-1
+IFN ITS,[
+HOWTBL: SYMVAL Waste,.HWASTE
+ SYMVAL Combat,.HCOMBT
+ SYMVAL File,.HFILE
+ SYMVAL Pcomp,.HPCOMP
+]
+IFE ITS,[
+HOWTBL: SYMVAL Pcomp,.HPCOMP
+ SYMVAL Combat,.HCOMBT
+ SYMVAL File,.HFILE
+]
+
+ SYMVAL Many,.HMANY
+ SYMVAL Abort,.HABRT
+ SYMVAL Question,.HQUES
+ SYMVAL Type plan,.HPRIN
+
+HOWTLN==HOWTBL-.
+HOWSPC==3 ; NUMBER OF THINGS AT END THAT CAN'T BE TAILORED
+
+; TABLE FOR TAILORING MORE COMPILATIONS? USED BY COMTYP, SO DEFAULT IS
+; <ASK>.
+TMORTB: SYMVAL <ASK>,-1
+ SYMVAL No,0
+ SYMVAL Yes,1
+ SYMVAL False,0
+ SYMVAL True,1
+MORLEN==TMORTB-.
+MORPMP: ASCIZ /Another compilation?/
+
+\f
+;TABLE FOR VERBOSE COMPILATIONS
+VTABLE: %IGNOR,,0 ; SNAME
+ %ASK,,0 ; NEW COMPILER
+ %ASK,,0 ; DEBUGGING COMPILER
+IFN ITS,[
+ %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ />/] ? 0 ? 0] ; INPUT
+]
+IFE ITS,[
+ %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /MUD/] ? 0 ? 0] ; INPUT
+]
+ %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /NBIN/] ? 0 ? 0] ; OUTPUT
+ %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /NBIN/] ? 0 ? 0] ; PRECOMP
+ %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /NBIN/] ? 0 ? 0] ; COMPARE
+ %ASK,,0 ; MANIFEST SWITCH
+ %ASK,,0 ; EXTRA JCL
+ %ASK,,0 ; REDO
+ %ASK,,0 ; PACKAGE MODE
+ %IGNOR,,0 ; GROUP MODE
+ %IGNOR,,0 ; SURVIVORS
+ %IGNOR,,0 ; TEMPNAME
+ %IGNOR,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /SOURCE/] ? 0 ? 0]; SOURCE
+ %IGNOR,,0 ; SPECIAL?
+ %ASK,,0 ; EXPFLOAD
+ %IGNOR,,0 ; EXPSPLICE
+ %ASK,,1 ; CAREFUL?
+ %ASK,,1 ; REASONABLE
+ %IGNOR,,1 ; GLUE
+ %IGNOR,,0 ; MACRO COMPILE
+ %IGNOR,,0 ; MACRO FLUSH
+ %IGNOR,,0 ; MAX SPACE
+ %IGNOR,,0 ; FIRST THINGS
+ %ASK,,0 ; THINGS TO DO
+ %IGNOR,,0 ; MORE THINGS
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %ASK,,0
+
+; SUPER-SHORT: DEFAULTS EVERYTHING BUT NEW COMPILER, HOW TO RUN, AND INPUT
+STABLE: %IGNOR,,0
+ %ASK,,0
+ %IGNOR,,0
+IFN ITS,[
+ %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ />/] ? 0 ? 0]
+]
+IFE ITS,[
+ %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ />/] ? 0 ? 0]
+]
+ %IGNOR,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /NBIN/] ? 0 ? 0]
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,1
+ %IGNOR,,1
+ %IGNOR,,1
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %IGNOR,,0
+ %ASK,,0
+
+; QUESTIONS FOR TAILOR
+
+TAILTB: SYMVAL Sname,.QSNAM
+ SYMVAL New compiler?,.QNEWC
+ SYMVAL Debugging compiler?,.QDEBU
+ SYMVAL Input file,.QINP
+ SYMVAL Output file,.QOUT
+ SYMVAL Precompilation,.QPREC
+ SYMVAL Compare with,.QCOMP
+ SYMVAL Check macros?,.QMANI
+ SYMVAL Extra JCL,.QCJCL
+ SYMVAL Redo,.QREDO
+ SYMVAL Package mode,.QPACK
+ SYMVAL Survivors,.QSURV
+ SYMVAL Temporary file,.QTEMP
+ SYMVAL Source file,.QSRC
+ SYMVAL Special?,.QSPEC
+ SYMVAL Expand floads?,.QEXPF
+ SYMVAL Expand splices?,.QEXPS
+ SYMVAL Careful?,.QCARE
+ SYMVAL Reasonable?,.QREAS
+ SYMVAL Glue?,.QGLUE
+ SYMVAL Macro compile?,.QMCRO
+ SYMVAL Macro flush?,.QMCRF
+ SYMVAL Max space?,.QMAXS
+ SYMVAL First things to do,.QTHN0
+ SYMVAL Things to do,.QTHNG
+ SYMVAL Last things to do,.QTHN1
+ SYMVAL Another compilation?,MORLOC ; MORLOC=38
+ SYMVAL How to run,HOWLOC
+ SYMVAL Set question default,$SQDEF
+ SYMVAL Finis,$FINIS
+ SYMVAL Delete question,$DELQ
+ SYMVAL Print current type,$PRTYP
+ SYMVAL Link to type,$CLINK
+ SYMVAL Unlink from type,$DLINK
+ SYMVAL Expand link to type,$XLINK
+ SYMVAL Expand all links,$XXLIN
+ SYMVAL List links to current type,$LLINK
+ SYMVAL List links from current type,$PLINK
+TAILEN==TAILTB-.
+TAILSP==10. ; # OF UNREAL QUESTIONS
+TALSPC==12. ; # OF QUESTIONS WITH UNTOUCHABLE DEFAULTS
+
+JCLIOT: ILDB A,JCLPTR
+ JUMPE A,JCLLOS
+ JRST 1(RET)
+
+JCLLOS: SETZM JCLINP
+ JRST (RET)
+
+JCLRED:
+IFN ITS,[
+ .BREAK 12,[5,,JCLBUF]
+]
+ SKIPN JCLBUF
+ POPJ P,
+ MOVE A,[440700,,JCLBUF]
+ SETOM JCLINP
+ MOVEM A,JCLPTR
+ POPJ P,
+
+PRHELP: JUMPN C,RCMDL ; ONLY ON FIRST CHARACTER
+ LDB A,[410300,,PRMPT1]
+ JRST @HLPTBL(A)
+
+HLPTBL: HLPSTR
+ BADTYP
+ HLPFSP
+ HLPFIL
+ HLPCMT
+ HLPCMT
+ BADTYP
+ BADTYP
+
+SAVAC: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ JRST @RET
+
+RSTAC: POP P,C
+ POP P,B
+ POP P,A
+ JRST @RET
+
+HLPSMM: ASCIZ /
+ Symbolic input accepted.
+ To complete a response, type <space>.
+ To complete and terminate a response, type <altmode> or <cr>.
+ To use the default, type <altmode> or <cr>.
+ The default is /
+
+HLPTF: ASCIZ /No/
+ ASCIZ /Yes/
+
+HLPCMT: HLRZ A,PRMPT1
+ TRNE A,%RDCMT
+ JRST HLPSYM
+ SAVACS
+ OASC HLPSMM
+ MOVE A,(OUTPTR)
+ OASC HLPTF(A)
+ JRST HLPOUT
+
+HLPSYM: SAVACS
+ OASC HLPSMM
+ MOVE A,CSYMTB
+ HLRZ A,(A)
+ OASC (A)
+ JRST HLPOUT
+
+HLPSTM: ASCIZ /
+ Input text terminated by an altmode/
+HLPST2: ASCIZ /.
+ To use the default, type <altmode>.
+ The current default is /
+
+HLPSTR: SAVACS
+ OASC HLPSTM
+ JUMPE OUTPTR,HLPOUT
+ HRRZ B,(OUTPTR)
+ JUMPE B,HLPOUT
+ OASC HLPST2
+ OASC (B)
+ JRST HLPOT1
+
+HLPFSM: ASCIZ /
+ Input a file name. Typing an <altmode> will indicate a negative response.
+ To get the current default, type <space> <altmode>.
+ The current default is /
+
+HLPFSP: SAVACS
+ OASC HLPFSM
+ PUSHJ P,HLPFDF
+ JRST HLPOUT
+
+HLPFLM: ASCIZ /
+ Input a file name. Typing an <altmode> will cause the default to be used.
+ The current default is /
+
+HLPFIL: SAVACS
+ OASC HLPFLM
+ PUSHJ P,HLPFDF
+HLPOUT: OASCI ".
+HLPOT1: OASCR [0]
+ RSTACS
+ JRST REPPER
+
+HLPFDF: MOVE A,(OUTPTR)
+ PUSHJ P,NFNAME
+ POPJ P,
+
+\f
+SUBTTL INPUT ROUTINES
+
+; PUSHJ P,ASK TO READ AN ANSWER AND FILL IN THE STUFF
+ASK: MOVE A,QTABLE(QOFF); GET THE TYPE WORD AND QUESTION
+ASK1: TLO A,%RDCRT
+ TLZ A,77
+ MOVEM A,PRMPT1 ; SAVE AS THE PROMPT
+ASK2: MOVE A,PRMPT1
+ SETZM CSYMTB
+ SETZM SYMMOD
+ TLNE A,$TSYMBOL
+ JRST [MOVEI B,SYMPR2
+ MOVEM B,PRMPT2
+ MOVE B,[TFTLEN,,TFTBL]
+ MOVEM B,CSYMTB
+ SETOM SYMMOD
+ JRST ASK3]
+ TLNE A,$TFIL
+ JRST [MOVEI B,FILPR2
+ MOVEM B,PRMPT2
+ JRST ASK3]
+ TLNE A,$TFSP
+ JRST [MOVEI B,FSPPR2
+ MOVEM B,PRMPT2
+ JRST ASK3]
+ MOVEI B,STRPR2
+ MOVEM B,PRMPT2
+ASK3:
+IFE ITS,[
+ TLNE A,$TFIL
+ JRST XASKF
+]
+ PUSHJ P,GETLN1
+ LDB A,[410300,,QTABLE(QOFF)]
+ JRST @PRSTBL(A)
+
+BADTYP: FATINS BAD TYPE CODE
+
+PRSTBL: PRSSTR
+ BADTYP
+ PRSFSP
+ PRSFIL
+ PRSTF
+ PRSSYM
+ BADTYP
+ BADTYP
+
+; PUSHJ P,COMTYP
+; A HAS SYMBOL TABLE (1 OF WHICH IS THE DEFAULT)
+; RETURNS IN A THE VALUE OF THE SYMBOL
+
+COMTYP: PUSH P,A
+ MOVEM A,CSYMTB
+ MOVSI O,$TSYMBOL+%RDCMT+%RDCRT
+ HLLM O,PRMPT1
+ MOVEI O,SYMPR2
+ MOVEM O,PRMPT2
+ PUSHJ P,GETLNS
+ SKIPN INPBUF
+ JRST [POP P,A
+ MOVEM A,SMVAL
+ HLRZ B,(A)
+ OASC (B)
+ OASCI 33
+ HRRZ A,(A)
+ POPJ P,]
+ MOVE B,(P)
+ MOVE A,[440700,,INPBUF]
+ PUSHJ P,SMATCH
+ POP P,
+ POPJ P,
+
+TFATBL: SYMVAL <ASK>,-1
+TFTBL: SYMVAL Yes,1
+ SYMVAL True,1
+ SYMVAL No,0
+ SYMVAL False,0
+TFTLEN==TFTBL-.
+TFALEN==TFATBL-.
+
+; PARSING ROUTINES
+
+PRSSTR: JUMPE C,CPOPJ
+ PUSHJ P,PRSINP
+ DPB C,[%TPLEN,,D]
+ MOVEM D,(OUTPTR)
+ JRST POPJ1
+
+; PUSHJ P,PRSINP
+; TAKES THE CHARACTER COUNT IN C, COPIES THE INPUT BUFFER INTO SOME NEW CORE
+; AND RETURNS THE ADDRESS IN D
+
+PRSINP: IDIVI C,5
+ ADDI C,1
+ MOVE A,C
+ PUSH P,A
+ PUSHJ P,IBLOCK
+ MOVE D,A
+ HRLI A,INPBUF
+ MOVE B,(P)
+ ADDI B,-1(A)
+ BLT A,(B)
+ POP P,C
+ POPJ P,
+
+ ; PARSE TRUE/FALSE TYPE QUESTIONS
+
+PRSTF: SKIPN INPBUF ; NO INPUT?
+ JRST [MOVEI B,[ASCIZ /Yes/]
+ SKIPN (OUTPTR)
+ MOVEI B,[ASCIZ /No/]
+ OASC (B)
+ OASCI 33
+ POPJ P,]
+ MOVE A,[440700,,INPBUF]
+ MOVE B,[TFTLEN,,TFTBL]
+ PUSHJ P,SMATCH
+ MOVEM A,(OUTPTR)
+ JRST POPJ1
+
+; TWENEX FILE NAME READING
+; READ A FILE NAME WITH DEFAULTS
+
+IFE ITS,[
+XASKF: OASCR [0]
+ PUSHJ P,PPRMPT
+ MOVE A,QTABLE(QOFF)
+ TLZ A,7777
+ HLRZS A
+ CAIN A,$TFSP
+ JRST XASKF3
+XASKF0: MOVE A,(OUTPTR)
+ HRLI A,-ITSSIZ
+ MOVEI B,GTJFN2+.GJDEV
+XASKFL: SKIPN (A) ; FILL IN FILE NAME DEFAULTS
+ JRST XASKFE
+ HRRO C,(A) ; WITH -1 IN LH
+ MOVEM C,(B)
+XASKFE: AOJ B,
+ AOBJN A,XASKFL ; LOOP THROUGH DEV, SNM, FN1, FN2
+ MOVEI A,.PRIIN
+ RFMOD
+ TRO B,TT%ECO
+ SFMOD ; GODDAMN GTJFN!
+XASKFA: MOVEI A,GTJFN2
+ SETZ B,
+ HRRO C,PRMPT1
+ MOVEM C,GTJFN2+.GJRTY ; SETUP PROMPT
+ SETOM INPBUF
+ PUSHJ P,ECHON
+ SKIPN FASKQS
+ JRST XASKFB
+ SKIPN FILEXI
+ JRST [MOVE A,[GTJFN2+1,,GTJFNN+1]
+ BLT A,GTJFNN+15
+ MOVEI A,GTJFNN
+ JRST .+1]
+XASKFB: GTJFN
+ JRST XASKF2
+ PUSHJ P,ECHOFF
+ MOVEM A,JFN
+ PUSH P,A ; SAVE THIS GODAWFUL JFN
+ MOVEI A,.PRIIN
+ RFMOD
+ TRZ B,TT%ECO
+ SFMOD ; GODDAMN GTJFN!
+ MOVE E,[-5,,JFNSBT] ; AOBJN FOR JFNS'ING
+ MOVE F,(OUTPTR) ; POINTER TO BLOCK
+ SETZ D, ; D IS ALWAYS 0 FOR JFNS
+XASKF1: MOVEI A,15.
+ PUSHJ P,IBLOCK
+ HRLI A,15.
+ MOVEM A,(F)
+ HRROS A ; POINTER TO STRING
+ MOVE B,(P) ; JFN
+ MOVE C,(E) ; CORRECT BIT FOR PARSING ONE FIELD
+ CAMN C,[JS%GEN]
+ JRST [TLNN B,(GJ%UHV) ; WAS HIGHEST GIVEN BY DEFAULT?
+ JRST .+1
+ MOVE B,[ASCIZ /0/]
+ MOVEM B,(A) ; MAKE IT 0, THEN... HACK, HACK
+ JRST XASKFU]
+ JFNS ; PARSE THE NAME
+XASKFU: AOJ F,
+ AOBJN E,XASKF1 ; UPDATE POINTERS
+ POP P,A ; RESTORE JFN (NOT NEEDED ANYHOW)
+ SKIPE FILEXP
+ JRST PRSFIX
+ JRST PRSFID
+
+XASKF2: PUSHJ P,ECHOFF
+ SETZM INPBUF ; THIS IS SO FILESPECS WILL FALL OUT
+ CAIN A,GJFX34 ; ? TYPED
+ JRST XASKFH
+ CAIN A,GJFX37 ; NULL BUFFER
+ JRST PRSFID
+ SKIPN FILEXI
+ JRST XASKF5
+XASKF6: OASC [ASCIZ / Aborted? /]
+ POPJ P,
+
+XASKF3: PBIN
+ PBOUT
+ CAIE A,33
+ JRST XASKF4
+ SETZM INPBUF
+ SETZM (OUTPTR)
+ JRST PRSFID
+
+XASKF4: MOVEI A,.PRIIN
+ BKJFN
+ JFCL
+ JRST XASKF0
+
+XASKF5: OASC [ASCIZ / ERROR - /]
+ MOVEI A,.PRIOU
+ MOVE B,[SETZ -1]
+ SETZ C,
+ ERSTR
+ JFCL
+ JFCL
+ SUB P,[1,,1] ; BACK TO FASKQ
+ POPJ P,
+
+XASKFH: MOVE A,QTABLE(QOFF)
+ TLNE A,$TFSP
+ JRST XHLPFS
+ SAVACS
+ OASC HLPFLM
+ PUSHJ P,XHLPFD
+XHLPOU: OASCI ".
+XHLPOT: OASCR [0]
+ RSTACS
+ JRST XASKFA
+
+XHLPFM: ASCIZ /
+ Input a file name. Typing a <rubout> will indicate a negative response.
+ To get the current default, type <space> <altmode>.
+ The current default is /
+
+XHLPFS: SAVACS
+ OASC XHLPFM
+ PUSHJ P,XHLPFD
+ JRST XHLPOU
+
+XHLPFD: MOVE A,(OUTPTR)
+ PUSHJ P,NFNAME
+ POPJ P,
+
+JFNSBT: JS%DEV
+ JS%DIR
+ JS%NAM
+ JS%TYP
+ JS%GEN
+
+GTJFN3: GJ%OLD
+ .NULIO,,.NULIO
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+
+GTJFNN: GJ%OLD+GJ%FLG+GJ%XTN ; IN THIS BLOCK, FILE MUST EXIST
+ BLOCK 16
+
+GTJFN2: GJ%OFG+GJ%XTN
+ .PRIIN,,.PRIOU
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ G1%RND+3
+ 0
+ 0
+ 0
+
+]
+
+; GIVEN A POINTER TO A FILE NAME BLOCK IN A, CONS THE
+; WHOLE FILE NAME WITH GTJFN AND SKIP RETURN WITH A
+; POINTER TO THE ASCIZ STRING NAME (A LA JFNS) IN A
+
+IFE ITS,[
+
+XFNEXP: HRLI A,-5
+ MOVEI B,GTJFNE+.GJDEV
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+XFNX1: HRRO C,(A) ; FILL IN THE FIELDS
+ MOVEM C,(B)
+ AOJ B,
+ AOBJN A,XFNX1
+ MOVEI A,GTJFNE
+ SETZ B,
+ GTJFN ; ASK FOR JFN (MUST EXIST!)
+ JRST POPDCB
+ MOVE B,A
+ MOVEI A,30. ; PLACE TO WRITE STRING
+ PUSHJ P,IBLOCK
+ PUSH P,A
+ HRROS A
+ SETZ C,
+ SETZ D,
+ JFNS
+ POP P,A
+ AOS -3(P)
+ JRST POPDCB
+
+GTJFNE: GJ%OLD
+ .NULIO,,.NULIO
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+ 0
+
+]
+; PARSE FILE INPUT SPECIFICATIONS
+
+PRSFIL: PUSHJ P,FPARSE
+ JRST [OASC [ASCIZ / - Illegal character in file name/]
+ JRST ASK2]
+ MOVE A,(OUTPTR)
+ SKIPN FILEXP
+ JRST [HRLI B,DEVICE
+ HRR B,A
+ MOVEI C,5(A)
+ BLT B,(C)
+ JRST PRSFID]
+PRSFIX: MOVE A,(OUTPTR)
+ PUSH P,A
+ HRLI A,-ITSSIZ
+ MOVEI D,DEVICE
+ MOVEI E,SYSDEV
+PRSFLL: SKIPN B,(D)
+ JRST [SKIPN B,(A)
+ MOVE B,(E)
+ JRST .+1]
+ PUSHJ P,GETFNM
+ MOVEM B,(A)
+ AOJ D,
+ AOJ E,
+ AOBJN A,PRSFLL
+ OASC [ASCIZ / [/]
+ POP P,A
+ PUSHJ P,NFNAME
+ OASCI "]
+PRSFID: MOVE A,QTABLE(QOFF)
+ TLNN A,%NSYSD
+ PUSHJ P,FPSYS
+ SKIPN INPBUF
+ POPJ P,
+ JRST POPJ1
+
+;IN A, THE POINTER TO ASCIZ
+;A HAS BEEN PUSHED PREVIOUSLY
+
+XSPNM: PUSH P,B
+ MOVE B,(A)
+IFN ITS,[
+ CAMN B,[ASCIZ /\18/]
+]
+IFE ITS,[
+ CAMN B,[ASCIZ /\16\18/]
+]
+ JRST XSPNM1
+IFN ITS,[
+ CAME B,[ASCIZ /\19/]
+]
+IFE ITS,[
+ CAME B,[ASCIZ /\16\19/]
+]
+ JRST XSPNM2
+ TDZA B,B
+XSPNM1: MOVEI B,1
+ MOVEM B,SSSPPP
+ AOS -1(P)
+XSPNM2: MOVE B,-2(P)
+ EXCH B,-1(P)
+ MOVEM B,-2(P)
+ POP P,B
+ POP P,A
+ POPJ P,
+
+GETFNM: SPNAME B ; IS GIVEN NAME CTRL-X OR CTRL-Y?
+ POPJ P, ; NO
+ SETOM DIDEXP ; CTRL-X OR CTRL-Y HAPPENED
+ MOVE B,SSSPPP
+ CAIE B,1 ; CTRL-X
+ JRST GETFN1
+ MOVE B,SYSFN1 ; SO GET FIRST FILE NAME
+ POPJ P,
+
+GETFN1: MOVE B,SYSFN2
+ POPJ P,
+
+PRSFSP: SKIPN INPBUF
+ JRST [SETZM (OUTPTR)
+ POPJ P,]
+ JRST PRSFIL
+\f
+; PUSHJ P,FPARSE
+; COME HERE TO PARSE A FILE NAME.
+; DEPOSIT THE STUFF IN 4 WORDS AT FILNAM
+
+FPSYS: MOVE B,(OUTPTR) ; PICK UP POINTER TO NAMES IF ^X OR ^Y APPEARS
+ PUSH P,C
+ PUSH P,D
+ MOVE C,[-FSPSIZ,,DEVICE]
+ MOVEI D,SYSDEV
+FPSYSL: SKIPE A,(B)
+ JRST [SPNAM1 A ; SKIPS IF NOT ^X OR ^Y--INVERSE OF SPNAME
+ MOVE A,(B)
+ MOVEM A,(D)
+ JRST .+1]
+ AOJ B,
+ AOJ D,
+ AOBJN C,FPSYSL
+ POP P,D
+ POP P,C
+ POPJ P,
+
+FPARSE: MOVE E,[440700,,INPBUF]
+ SETZM ENDSW
+ SETZM DEVICE
+ MOVE B,[DEVICE,,DEVICE+1] ;CLEAR ALL NAMES
+ BLT B,ETCETC
+FPARSS: MOVEI A,FSPSIZ
+ PUSHJ P,IBLOCK
+ MOVEM A,NAME
+ SETZM NAMCNT
+ SKIPE ENDSW
+ JRST POPJ1
+ MOVE F,A ;BP TO NAME AREA
+ HRLI F,440700
+
+GETCHR: ILDB B,E ;FIND NEXT NON-EMPTY CHARACTER
+ JUMPE B,[SETOM ENDSW
+ JRST FIELD1]
+ CAIE B,40
+ CAIN B,^I
+ JRST GETCHR
+
+FIELD: CAIN B,":
+ JRST DEV ;DEVICE NAME
+ CAIN B,";
+ JRST FDIR ;SNAME
+FIELD1: CAIE B,40 ;HERE TO GET A NAME
+ CAIN B,^I
+ JRST FNAM ;SPACE AND TAB MAKE FNAME1 AND 2
+ CAIE B,0
+ CAIN B,^M
+ JRST FNAM ;SO DO 0 AND <CR>
+ CAIE B,^X
+ CAIN B,^Y
+ JRST FIELD2
+ CAIN B,^Q ;HANDLE QUOTING
+ ILDB B,E
+ CAIGE B,40 ;SUBI B,40 < 0 (BAD CHARACTER)
+ JRST CPOPJ
+ CAIL B,"a
+ SUBI B,40 ;CASE CONVERSION
+FIELD2: IDPB B,F
+ AOS NAMCNT
+FPARS2: ILDB B,E
+ JRST FIELD
+
+DEV: MOVE A,NAME
+ JSP RET,FNMCNT
+ MOVEM A,DEVICE
+ SETZM SPCHR
+ JRST FPARSS
+
+FDIR: MOVE A,NAME
+ JSP RET,FNMCNT
+ MOVEM A,DIRECT
+ SETZM SPCHR
+ JRST FPARSS
+
+FNAM1:
+FNAM: SKIPN NAMCNT
+ JRST FPARSS
+ MOVE A,NAME
+ JSP RET,FNMCNT
+ SKIPE FNAME1 ;DOES HE HAVE AN FNAME1 ALREAD?
+ JRST FNAM2 ;YES - OOPS. HE IS GIVING TWO NAMES
+ MOVEM A,FNAME1 ;NO - TRY IT AS FNAME1
+ JRST FPARSS
+
+FNAM2: MOVEM A,FNAME2 ;PUT NEW NAME INTO FNAME2
+ JRST FPARSS
+
+FNMCNT: MOVE B,NAMCNT ;PUT COUNT IN HERE
+ IDIVI B,5
+ ADDI B,1
+ HRL A,B
+ JRST (RET)
+
+; CLEAR THE SCREEN
+
+IFE ITS,[
+XCLEAR: SAVACS
+ MOVEI 1,.PRIOU ;ENTER HERE FOR THINGS THAT BLANK INCIDENTALLY
+ RFMOD ;CHANGE TO
+ PUSH P,2
+ TRZ 2,TT%DAM ;BINARY MODE
+ SFMOD
+ GTTYP
+ HRROI 1,BLNKTB(2) ;GET RIGHT MAGIC
+ PSOUT
+ MOVEI 1,.PRIOU
+ POP P,2
+ SFMOD
+ RSTACS
+ POPJ P,
+
+BLNKTB: REPEAT 4, <.BYTE 7 ? 15 ? 12 ? 0> ; 0-3
+ <.BYTE 7 ? 177 ? 220-176 ? 0> ; 4 IMLACS
+ <.BYTE 7 ? 35 ? 36 ? 0> ; 5 DM
+ <.BYTE 7 ? 33 ? "H ? 33 ? "J ? 0> ; 6 HP2640
+ REPEAT 4 ? <.BYTE 7 ? 15 ? 12 ? 0> ; 7-10
+ <.BYTE 7 ? 33 ? "H ? 33 ? "J ? 0> ; 11 VT50
+ <.BYTE 7 ? 15 ? 12 ? 0> ; 12
+ <.BYTE 7 ? 33 ? "( ? 177 ? 0> ; 13 LP
+ <.BYTE 7 ? 15 ? 12 ? 0> ; 14
+ <.BYTE 7 ? 33 ? "H ? 33 ? "J ? 0> ; 15 VT52
+ REPEAT 3, <.BYTE 7 ? 15 ? 12 ? 0> ; ETC
+]
+
+IFE ITS,[
+; DO TWENEX IOTING
+; IN (P) IS THE WORD WHICH ITS WOULD LIKE
+
+XIOTI: PUSH P,[SIN]
+ CAIA
+XIOT: PUSH P,[SOUT]
+ MOVE O,[A,,XACS]
+ BLT O,XACS+2
+ MOVE A,-1(P)
+ MOVE A,(A)
+ MOVE O,XACS-1(A)
+ MOVE A,DSKJFN
+ HRRZ B,O
+ TLO B,444400
+ HLRE C,O
+ PUSH P,C
+ XCT -1(P)
+ CAME C,(P)
+ AOS -2(P)
+ MOVE O,[XACS,,A]
+ BLT O,C
+ SUB P,[2,,2]
+ JRST POPJ1
+
+XACS: BLOCK 3
+]
+
+; CONVERT ASCII NAME IN A TO SIXBIT WORD IN A
+; CHOMP ,CHOMP
+
+ASCSIX: PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ MOVE B,A
+ HRLI B,440700 ; B POINTS TO ASCII BLOCK
+ SETZ A,
+ MOVE C,[440600,,A] ; C POINTS TO A (SIXBIT WORD)
+ASCSIL: ILDB D,B
+ JUMPE D,SIXAS2
+ SUBI D,40
+ CAIL D,100
+ SUBI D,40
+ IDPB D,C
+ TLNE C,770000 ; SKIP IF A IS FULL
+ JRST ASCSIL
+ JRST SIXAS2
+
+; CONVERT SIXBIT NAME IN A TO STANDARD ASCII POINTER
+; I.E. WORD-COUNT(=2),,POINTER
+
+SIXASC: PUSH P,B ; SAVE RANDOM ACS
+ PUSH P,C
+ PUSH P,D
+ PUSH P,A ; TEMPORARILY SAVE SIXBIT WORD
+ MOVEI A,2
+ PUSHJ P,IBLOCK ; GET BLOCK FOR ASCII
+ POP P,B ; RESTORE SIXBIT WORD
+ PUSH P,A ; SAVE ASCII BLOCK POINTER
+ HRLI A,440700 ; POINTER TO ASCII BLOCK
+ MOVE C,[440600,,B] ; POINTER TO SIXBIT WORD
+SIXASL: ILDB D,C ; GET CHARACTER
+ JUMPE D,SIXAS1 ; FINIS
+ ADDI D,40
+ IDPB D,A ; DEPOSIT CHARACTER
+ TLNE C,760000
+ JRST SIXASL ; LOOP
+SIXAS1: POP P,A ; FINISHED. RESTORE POINTER
+ HRLI A,2 ; 2 IN LH (WORD COUNT)
+SIXAS2: POP P,D ; AND RETURN
+ POP P,C
+ POP P,B
+ POPJ P,
+
+\f
+; GENERAL PURPOSE MATCH LOSSAGE HANDLERS
+
+; COMPS GIVEN BP'S IN A AND E, RETURNS THE NUMBER OF = LETTERS
+
+COMPS: SETZ F, ; COUNT OF MATCHING CHARACTERS
+COMPS1: ILDB C,A
+ JUMPE C,[MOVE C,E ; COPY THE BP TO TABLE ENTRY
+ ILDB C,C
+ SKIPN C ; THIS ZERO ALSO??
+ MOVEM B,SMEXAC ; YES. THIS IS AN EXACT MATCH
+ JRST POPJ1]
+ TRO C,40 ; LOWER CASE
+ ILDB D,E
+ JUMPE D,CPOPJ
+ TRO D,40 ; LOWER CASE
+ CAMN C,D
+ AOJA F,COMPS1
+ POPJ P, ; LOSE IMMEDIATE
+
+; PUSHJ P,SPOSS
+; LIST POSSIBILITIES. AC'S AS BELOW
+
+SPOSS: PUSH P,[-1]
+ OASCR [0]
+ OASCR [ASCIZ /The following are possible: /]
+ JRST SMATIN
+
+; PUSHJ P,SMATCH
+; SYMBOL-TABLE MATCH HACKER
+; A = BYTE POINTER TO INPUT BLOCK
+; B = AOBJN POINTER TO SYMBOL TABLE
+; C = # OF CHARS IN INPUT BUFFER
+; LSTBRK HAS LAST BREAK CHARACTER
+
+SMATCH: PUSH P,[0]
+SMATIN: PUSH P,A
+ MOVEM C,INPLEN ; SAVE INPUT LENGTH
+ SETZM SMEXAC ; ZERO SOME SWITCHES
+ SETZM SMBEST
+ SETZM SMBLEN
+ SETZM SMNUM
+SMLP2: MOVE A,(P) ; GET BP TO INPUT BUFFER
+ HLRZ E,(B)
+ HRLI E,440700 ; GET BP TO TABLE ENTRY
+ PUSH P,E ; AND SAVE IT
+ PUSHJ P,COMPS ; GET THE MATCHING
+ JRST SMNEXT ; DOES NOT MATCH. GO TO NEXT ENTRY.
+ SKIPL -2(P) ; IS THIS A CONTROL-F?
+ JRST SMWINR ; NO. HACK THIS ENTRY
+ AOS SMNUM ; INCREMENT THE COUNT OF WINNERS
+ HLRZ E,(B) ; YES. PRINT THE ENTRY
+ OASCR (E)
+SMNEXT: POP P,E ; RESET THE STACK
+SMNXT1: AOBJN B,SMLP2 ; LOOP ON THE SYMBOL TABLE
+ POP P, ; RESTORE BP TO INPUT BUFFER
+ POP P,A ; GET CODE
+ JUMPL A,SMNPOS ; THIS WAS PUSHJ P,SPOSS
+ MOVE D,SMBEST ; GET THE BEST BP
+ MOVE B,INPSAV ; AND THE INPUT BUFFER
+ ADD B,[70000,,] ; DECREMENT THE POINTER
+ TLNE B,400000
+ ADD B,[347777,,-1]
+ SKIPN A,SMBLEN ; ANY CHARACTERS TO COMPLETE?
+ JRST [SKIPE SMEXAC ; NO. IS THERE AN EXACT MATCH?
+ JRST SMEXOK ; YES. WIN IMMEDIATE
+ JRST SMMDON] ; NO. CHECK FOR PARTIAL MATCHES, ETC.
+
+; COME HERE TO COMPLETE
+
+SMDEP: ILDB E,D ; GET THE NEXT CHARACTER
+ OASCI (E) ; ECHO IT
+ IDPB E,B ; DEPOSIT INTO THE INPUT BUFFER
+ SOJN A,SMDEP ; CONTINUE
+SMMDON: MOVE D,SMNUM ; GET THE NUMBER OF MATCHES
+ CAIN D,1 ; JUST 1?
+ JRST SMTERM ; YES. TERMINATE
+SMCONT: SKIPE JCLINP ; JCL INPUT?
+ JRST SMLOSR ; YES. CHOMPER.
+ JUMPE D,SMLOSE ; NO MATCHES. LOSE, LOSE
+ AOS XTRCHR ; INCREMENT EXTRA CHARACTER COUNT
+IFN ITS,[
+ OASCI "& ; AND PRINT CONTINUATION CHAR
+]
+SMCNT1: MOVE C,SMBLEN
+ ADD C,INPLEN ; UPDATE CHARACTER COUNT FOR READER
+ MOVE D,INPACT ; GET THE ACTIVATION FOR INPUT
+ HRRM D,(P)
+ JRST RCMD1 ; RETURN TO READER
+
+SMLOSR: OASC [ASCIZ /Matching error - JCL input aborted/]
+ CAIA
+SMLOSE: OASC [ASCIZ / No symbol matches input /]
+ SETZM JCLINP ; FLUSH INPUT FROM JCL
+ MOVE D,INPACT ; GET THE ACTIVATION FOR INPUT
+ HRRM D,(P)
+ JRST GETLNS ; RETURN TO READER
+
+; COME HERE WHENEVER A SYMBOL TABLE ENTRY MATCHES THE INPUT IN THE BUFFER
+
+SMWINR: MOVEM A,INPSAV ; SAVE POINTER TO INPUT BUFFER
+ AOS SMNUM ; INCREMENT # OF MATCHES
+ SKIPN A,SMBEST ; CHECK FOR BEST SO FAR
+ JRST SMFRST ; NONE. CREATE ONE
+ MOVEM E,(P) ; SAVE THE BP TO THIS ENTRY
+ PUSHJ P,COMPS ; COMPARE THIS ENTRY TO BEST SO FAR
+ JFCL
+ CAML F,SMBLEN ; ARE THERE FEWER MATCHES THAN BEST?
+ JRST SMNEXT ; NO. NEXT VICTIM
+ POP P,SMBEST ; MAKE THIS THE BEST SO FAR
+ MOVEM B,SMVAL ; SAVE VALUE WORD
+ MOVEM F,SMBLEN ; SAVE BEST LENGTH
+ JRST SMNXT1 ; CHECK ON
+
+SMFRST: MOVEM E,SMBEST ; SAVE BP TO THE REMAINDER AS BEST
+ PUSHJ P,STRLEN ; GET ITS LENGTH
+ MOVEM E,SMBLEN ; AND MAKE IT BEST LENGTH
+ MOVEM B,SMVAL ; SAVE VALUE WORD
+ JRST SMNEXT ; GET NEXT ENTRY
+
+; COME HERE IF THERE IS AN EXACT MATCH OR ONLY ONE POSSIBLE COMPLETION
+
+SMEXOK: MOVE A,SMEXAC ; HAVE EXACT MATCH
+ MOVEM A,SMVAL ; SAVE IT
+SMTERM: MOVE E,LSTBRK ; GET THE BREAK CHARACTER
+ CAIE E,33 ; IF ALTMODE, TERMINATE
+ JRST SMTRM1 ; ELSE, CHECK ON
+ OASCI (E) ; PRINT TERMINATION CHARACTER
+SMTRM2: MOVE A,SMVAL
+ HRRZ A,(A) ; GET THE VALUE IN A AND RETURN
+ POPJ P,
+
+SMTRM1: CAIE E,^M ; IS THE BREAK A <CR>
+ JRST SMTRM3 ; NO. COMPLETE ONLY
+ MOVE A,PRMPT1
+ TLNE A,%RDCRT ; IS THE TERMINATE ON <CR> BIT SET?
+ JRST SMTRM2 ; YES. TERMINATE
+SMTRM3: AOS XTRCHR ; NO. GIVE AN EXCL AND WAIT
+ OASCI "!
+ JRST SMCNT1
+
+; COME HERE AT END OF CONTROL-F HACK
+
+SMNPOS: SKIPN SMNUM ; ANY POSSIBILITIES MATCH?
+ OASCR [ASCIZ / None possible /]
+ POPJ P,
+
+; GET THE LENGTH OF A STRING POINTED TO BY E
+
+STRLEN: MOVE C,E
+ SETZ E,
+STRLLP: ILDB D,C
+ JUMPE D,CPOPJ
+ AOJA E,STRLLP
+
+; CLEAR THE INPUT BUFFER
+
+CLINBF: SETZM INPBUF
+ MOVE O,[INPBUF,,INPBUF+1]
+ BLT O,INPBUF+INPBLN-1
+ POPJ P,
+
+; COPY THE INPUT BUFFER INTO TINBUF
+SINBUF: PUSH P,A
+ MOVE A,[INPBUF,,TINBUF]
+ BLT A,TINBUF+INPBLN-1
+ JRST POPAJ
+
+; COPY TINBUF BACK INTO THE INPUT BUFFER
+RINBUF: PUSH P,A
+ MOVE A,[TINBUF,,INPBUF]
+ BLT A,INPBUF+INPBLN-1
+ JRST POPAJ
+
+; COMMAND READER.
+; PUSHJ P,GETLIN READS TO AN ALTMODE AND FILLS IN THE INPUT BUFFER
+; ACCORDINGLY
+
+GETLNS: SETOM SYMMOD
+ CAIA
+GETLIN: SETZM SYMMOD
+GETLN1: SETZM XTRCHR
+ MOVE RET,(P)
+ MOVEM RET,INPACT ; SAVE "ACTIVATION"
+ PUSHJ P,CLINBF
+ HRRZ B,PRMPT1
+ JUMPE B,RCMD
+RCMDXX: OASCR [0]
+RCMD: MOVE B,[440700,,INPBUF]
+ PUSHJ P,PPRMPT
+ SETOM INREAD ; HAVE REASONABLE INPUT BUFFER TO REDISPLAY
+ MOVEI C,0 ; COUNT OF CHARACTERS
+RCMD1: SETZM MDPDLF
+ SETZM MDMISF
+ SETZM MDOVCF ; CLEAR ERROR FLAGS
+ SETZM MDBKSV
+RCMDER: SKIPE JCLINP ; COME HERE IF ERROR FLAG JUST SET
+REBLK: JSP RET,JCLIOT ; FOR HYSTERICAL REASONS
+IFN ITS,[
+ .IOT TTYI,A
+]
+IFE ITS,[
+ PBIN
+]
+ SKIPN MDMISF
+ SKIPE MDOVCF
+ OCTLP "L ; CLEAR ERROR MESSAGE, IF EXISTS
+ SKIPE MDPDLF
+ OCTLP "L
+ SKIPE XTRCHR
+ PUSHJ P,XTRCLR
+ SKIPE RQUOTE ; IN QUOTE MODE?
+ JRST [SETZM RQUOTE
+ JRST RCMDL]
+ CAIN A,"\
+ JRST [SETOM RQUOTE
+ JRST RCMD1]
+ CAIN A,^W ; ERASE A WORD
+ JRST WDFLUS
+ CAIN A,^X ; ERASE A LINE
+ JRST [MOVE O,PRMPT1
+ TLNN O,$TFILE ; DOESN'T WORK IN FILE MODE
+ JRST LNFLUS
+ JRST RCMDL]
+ CAIN A,^K ; ERASE AN OBJECT
+ JRST [MOVE O,PRMPT1
+ TLNE O,700000 ; STRING?
+ JRST WDFLUS ; NO, SO TURN INTO WORD FLUSH
+ JRST MDFLUS]
+ CAIN A,177
+ JRST RUB
+ CAIN A,^F
+ JRST POSCHK
+ CAIN A,^G
+ JRST GACK ; GET FROM GROUP
+ JUMPE A,RSTBUF
+ CAIN A,^D ; DISPLAY BUFFER
+ JRST RREPEA
+ CAIN A,^L ; CLEAR SCREEN AND DISPLAY BUFFER
+ JRST RCLEAR
+ CAIN A,"?
+ JRST PRHELP
+ CAIN A,^Q
+ JRST [SETOM CTRLQ
+ MOVEI A,33
+ JRST RCMDX1]
+ CAIN A,33 ; TERMINATE ON ALTMODE
+ JRST RCMDXE
+ CAIE A,^B ; MAKE CONTROL-B DO BACK UP ALSO (LIKE FOR 20X)
+ CAIN A,^R
+ JRST RACK ; BACK UP
+ CAIN A,^S ; QUIT
+ JRST TOPLEV
+ CAIN A,^M
+ JSP RET,CRCHK
+ SKIPE SYMMOD
+ JSP RET,SYMCHR
+RCMDL: ADDI C,1
+ CAIL C,INPBLN
+ FATINS PDL OVERFLOW ON NON-EXPANDABLE PDL
+ CAIN A,^J
+ JRST [SKIPE FOOBR'
+ JRST RCMD1 ; WHAT THE FUCK HAPPENS HERE?
+ SETOM FOOBR
+ JRST .+2]
+ SETZM FOOBR
+ IDPB A,B
+ ECHO
+ JRST RCMD1
+
+RCMDXE:
+ SKIPN SYMMOD ; HERE ON ALTMODE
+ ECHO ; ECHO NON-SYMBOL ALTMODES
+RCMDX1: MOVEM A,LSTBRK ; SAVE BREAK CHARACTER
+ MOVEI A,0 ; DEPOSIT ZERO
+ IDPB A,B
+ SETZM INREAD
+ MOVEM C,CHRLEN'
+ POPJ P, ; EXIT
+
+RSTBUF: ECHO ; ECHO THE CHAR AND CLEAR THE BUFFER
+RSTBF1: OASCR [0]
+ SETZ C,
+ PUSHJ P,CLINBF
+ MOVE B,[440700,,INPBUF]
+ JRST REPPER
+
+POSCHK: SKIPN CSYMTB
+ JRST RCMDL
+ MOVE A,[440700,,INPBUF]
+ PUSH P,B
+ MOVE B,CSYMTB
+ PUSH P,C
+ PUSH BK,[0] ; CREATE ACTIVATION FOR ABORT
+ PUSH BK,[POSCHR]
+ PUSH BK,[[POPJ P,]]
+ PUSH BK,P
+ SETOM LONGOT ; ENABLE MORES, ^R ^S TO STOP
+ PUSHJ P,SPOSS
+ SETZM LONGOT ; DISABLE
+ BKOFF
+POSCHR: PUSHJ P,PPRMPT
+ POP P,C
+ POP P,B
+ OASC INPBUF
+ JRST RCMD1
+
+XTRCLR: OCTLP "X
+ SOSE XTRCHR
+ JRST XTRCLR
+ POPJ P,
+
+CRCHK: HLRZ D,PRMPT1
+ TRNN D,$TFILE
+ TRNE D,$TSYMBOL
+ JRST RCMDX1
+ ECHO
+ IDPB A,B
+ MOVEI A,^J
+ AOJ C,
+ JRST @RET
+
+SYMCHR: CAIN A,40
+ JRST RCMDX1
+ JRST @RET
+
+PPRMPT: OASC @PRMPT1
+ SKIPE PR2SW
+ OASC @PRMPT2
+ POPJ P,
+
+RREPEA: ECHO
+ OASCR [0] ; RETYPE LINE
+ JRST REPPER
+RCLEAR: SCLEAR
+REPPER: PUSHJ P,PPRMPT
+ OASC INPBUF
+ JRST RCMD1
+\f
+SUBTTL RUBOUTS &C.
+
+; CHARACTER COUNT IS IN C, BYTE POINTER IS IN B
+
+RUB: PUSHJ P,RUBBER ; FLUSH A CHAR
+ JRST RCMDXX ; NONE LEFT--REDISPLAY PROMPT
+ JRST RCMD1 ; JUST KEEP FROBBING
+
+RUBBER: SOJL C,CPOPJ
+ LDB A,B ; GET CHARACTER
+ MOVEI D,0
+ DPB D,B ; ZERO IT
+ XCT XCTRUB ; DO THE RUBOUT
+ DBP B
+ AOS (P)
+ POPJ P, ; SKIP RETURN, WITH CHARACTER IN A
+
+RUBECH: OASCI (A) ; ECHO
+ POPJ P,
+
+; MUCH OF THE FOLLOWING IS RIPPED OFF FROM MUDDLE
+RUBFLS: PUSH P,B
+ PUSH P,C
+ PUSHJ P,RCPOS ; GET CURSOR POSITION
+ PUSHJ P,CHRTYP ; GET CHARACTER TYPE
+ SKIPGE C,FIXIM2(C) ; # OF CHARS, OR ROUTINE TO HACK IT
+ JRST (C) ; SPECIAL ROUTINE
+ OCTLP "X ; RUB IT OUT
+ SOJG C,.-1 ; UNTIL DONE
+RUBDON: POP P,C
+ POP P,B
+ POPJ P,
+
+; RETURN CHARACTER TYPE (OFFSET INTO FIXIM2 AND FIXIM3) IN C. CHARACTER IS IN A
+CHRTYP: MOVEI C,0
+ CAIG A,37 ; SKIP IF MIGHT BE FUNNY
+ JRST CHRTY1
+ CAIN A,177 ; RUBOUT?
+ AOJA C,CPOPJ ; TWO CHARACTERS WIDE
+ POPJ P,
+CHRTY1: PUSH P,A
+ IDIVI A,12. ; GET WORD TO ACCESS
+ MOVE A,FIXIML(A) ; FROM FIXIML TABLE
+ IMULI B,3
+ ROTC A,3(B) ; GET CODE INTO LOW END OF B
+ ANDI B,7 ; AND KILL EVERYTHING ELSE
+ MOVEI C,(B) ; PUT IT IN C
+ POP P,A
+ POPJ P,
+
+; CTRL-Z AND CTRL-_
+FOURQ: OCTLP "X
+ OCTLP "X
+ SKIPE TOFCI ; TV KEYBOARD?
+ JRST RUBDON
+ OCTLP "X
+ OCTLP "X
+ JRST RUBDON
+
+; BACK SPACE
+BSKILL: AOS CHPOS ; GET NEW HPOS +8.
+ OHPOS @CHPOS
+ JRST RUBDON
+
+CGKILL: JRST RUBDON ; CTRL-G TAKES NO SPACE
+
+TBKILL: PUSHJ P,GHPOS ; FIND NEW POSITION
+ OHPOS @CHPOS
+ OCTLP "L ; CLEAR TO END OF LINE
+ JRST RUBDON
+
+CRKILL: PUSHJ P,GHPOS
+ OHPOS @CHPOS
+ JRST RUBDON
+
+LFKILL: PUSH P,A
+ MOVEI A,1
+ PUSHJ P,LNSTRV
+ POP P,A
+ JRST RUBDON
+
+; TAKES NUMBER OF LINES TO GO UP IN A, POSITIONS CURSOR AT END OF LAST LINE REMAINING
+LNSTRV: CAMLE A,CVPOS
+ JRST LNREDO
+ SOJE A,LNONE ; SPECIAL CASE FOR ONE LINEFEED
+ OCTLP "H ; GO TO BEGINNING OF LINE
+ OASCI 10
+LNSLOP: OCTLP "L ; KILL LINE AND GO UP
+ OCTLP "U
+ SOS CVPOS ; UPDATE CVPOS
+ SOJGE A,LNSLOP ; LOOP
+ PUSHJ P,GHPOS
+ OHPOS @CHPOS ; FROB HORIZONTAL POSITION
+ OCTLP "L ; AND CLEAR THE LAST LINE
+ POPJ P,
+; ONLY ONE TO HACK
+LNONE: OCTLP "U ; DO LINE STARVE
+ POPJ P,
+LNREDO: OCTLP "T ; HOME UP AND CLEAR FIRST LINE
+ OCTLP "L
+ PUSHJ P,PPRMPT ; REDISPLAY PROMPT
+ OASC INPBUF ; INPUT BUFFER
+ PUSHJ P,RCPOS ; READ CURSOR POSITION
+ POPJ P, ; AND FLUSH
+
+; TABLE OF CHARACTER LENGTHS OR SPECIAL ROUTINES
+FIXIM2: 1
+ 2
+ SETZ FOURQ ; CTRL-Z AND CTRL-_
+ SETZ CRKILL ; SETZ SO SKIPGE WON'T
+ SETZ LFKILL ; LINE FEED
+ SETZ BSKILL ; BACK SPACE
+ SETZ TBKILL ; TAB
+ SETZ CGKILL ; CTRL-G
+
+; INSTRUCTIONS TO GET CHARACTER WIDTHS ON DISPLAY, INTO C
+FIXIM3: MOVEI C,1
+ MOVEI C,2
+ PUSHJ P,CNTCTZ ; MAY BE EITHER TWO OR FOUR
+ MOVEI C,0
+ MOVEI C,0
+ MOVNI C,1
+ PUSHJ P,CNTTAB ; GET WIDTH OF TAB
+
+CNTCTZ: MOVEI C,2
+ SKIPN TOFCI ; TV KEYBOARD?
+ MOVEI C,4
+ POPJ P,
+
+CNTTAB: ANDCMI O,7 ; ZERO LOW THREE BITS OF POSITION COUNT
+ ADDI O,10 ; AND ADD 8
+ MOVEI C,0
+ POPJ P,
+
+FIXIML: 111111,,175641 ; CTRL @ABCDE,,FGHIJK
+ 131111,,111111 ; LMNOPQ,,RSTUVW
+ 112011,,120000 ; XYZ[\],,^_
+
+; READ CURSOR POSITION, PUT IN CHPOS AND CVPOS
+RCPOS: PUSH P,A
+IFN ITS,[
+ .CALL [SETZ
+ SIXBIT /RCPOS/
+ MOVEI TTYI
+ SETZM A]
+ .LOSE %LSSYS
+ HLRM A,CVPOS
+ HRRM A,CHPOS
+]
+ POP P,A
+ POPJ P,
+
+; COME HERE TO FIND CURRENT HORIZONTAL POSITION (GIVEN THAT CURSOR ISN'T
+; IN THE RIGHT PLACE, DUMMY). PUT IT IN CHPOS. ACCUMULATE IN 0
+GHPOS: PUSH P,O
+ PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ MOVEI O,0
+ MOVE D,PRMPT1 ; PICK UP LONG PROMPT
+ PUSHJ P,CNTSTR ; GET LENGTH OF IT IN O
+ SKIPN PR2SW
+ JRST GHPOS1
+ MOVE D,PRMPT2
+ PUSHJ P,CNTSTR
+GHPOS1: MOVEI D,INPBUF
+ PUSHJ P,CNTSTR
+ MOVEM O,CHPOS
+ POP P,D
+ POP P,C
+ POP P,B
+ POP P,A
+ POP P,O
+ POPJ P,
+
+CNTSTR: HRLI D,440700 ; BYTE POINTER TO STRING
+CNTST1: ILDB A,D ; GET CHARACTER
+ JUMPE A,CPOPJ ; NULL TERMINATES
+ CAIN A,^M ; CR?
+ JRST [MOVEI O,0
+ JRST CNTST1]
+ PUSHJ P,CHRTYP
+ XCT FIXIM3(C)
+ ADD O,C ; UPDATE COUNT
+ JRST CNTST1 ; AND TRY AGAIN
+\f
+; RUB OUT A WORD: STOP AT <CR>, <LF>, <TAB>, OR <SP>, RUBBING OUT AT LEAST
+; ONE CHARACTER NOT IN THAT SET.
+
+WDFLUS: PUSHJ P,RUBBER ; RETURNS DEAD CHAR IN A
+ JRST RCMDXX ; RAN OUT OF CHARACTERS
+ PUSHJ P,BREAK ; BREAK CHARACTER?
+ JRST WDFLU1 ; NO, SO GO TO SECOND LOOP
+ JRST WDFLUS ; KEEP TRYING
+WDFLU1: JUMPE C,RCMD1
+ LDB A,B ; GET CHARACTER ABOUT TO FLUSH
+ PUSHJ P,BREAK
+ JRST WDFLU2
+ JRST RCMD1 ; FOUND A BREAK, SO STOP
+WDFLU2: PUSHJ P,RUBBER
+ JRST RCMDXX
+ JRST WDFLU1
+
+; SKIP IF CHARACTER IN A IS ONE OF <SP>, <CR>, <LF>, <TAB>, <;>
+BREAK: CAIE A,^I
+ CAIN A,^J
+ JRST POPJ1
+ CAIE A,^M
+ CAIN A,40
+ JRST POPJ1
+ CAIN A,";
+ JRST POPJ1
+ POPJ P,
+\f
+; DELETE A LINE. IF AT BEGINNING OF LINE (FIRST CHAR IS CTRL-J, DELETE
+; PREVIOUS LINE.
+LNFLUS: PUSHJ P,RUBBER ; ONE CHARACTER WILL ALWAYS BE FLUSHED
+ JRST RCMDXX
+LNFLUL: LDB A,B
+ CAIN A,^J ; FINISHED?
+ JRST LNFLUD
+ MOVEI O,0
+ DPB O,B ; ZERO THE CHAR
+ DBP B
+ SOJLE C,LNLEAV ; OUT OF CHARS?
+ JRST LNFLUL
+LNFLUD: PUSH P,B
+ DBP B
+ LDB A,B
+ POP P,B ; LOOK AT THE CHARACTER BEFORE THE CTRL-J
+ CAIN A,^M
+ JRST LNFLKL ; CTRL-M, SO JUST KILL THE LINE
+LNLEAV: PUSHJ P,GHPOS
+LNLEV1: SKIPN TOERS ; CAN WE DO ERASE?
+ JRST [OASCR [ASCIZ / XXX?/]
+ JRST RCMD1]
+ OHPOS @CHPOS ; GET HORIZONTAL POSITION
+ OCTLP "L ; AND CLEAR LINE
+ JRST RCMD1
+LNFLKL: SETZM CHPOS ; HORIZONTAL POSITION IS 0
+ JRST LNLEV1 ; GO DO IT
+\f
+; FLUSH A MUDDLE OBJECT. FIRST FLUSH TRAILING BLANKS, REGARDLESS.
+MDFLUS: SKIPE MDOVCF ; OVERCLOSE IMMEDIATELY BEFORE-->CTRL-@
+ JRST RSTBUF ; KILL BUFFER
+ JUMPE C,RCMDXX ; NOTHING HERE
+ PUSH P,A
+ PUSH P,D
+ PUSH P,E
+MDSFLP: LDB A,B ; GET A CHAR
+ PUSHJ P,BREAK ; BREAK?
+ JRST MDFLU1
+ PUSHJ P,RUBBER
+ JRST MDFLOT
+ JUMPG C,MDSFLP
+ JRST MDFLOT
+; WE NOW HAVE A NON-BREAK IN A, READY TO BE GROSSLY FROBBED.
+MDFLU1: SKIPE TOERS
+ PUSHJ P,RCPOS
+ PUSHJ P,RITBKT ; RIGHT BRACKET?
+ JRST MDFLU2
+ JRST MDOBJF ; YES--WE REALLY HAVE AN OBJECT TO FLUSH
+MDFLU2: PUSHJ P,LFTBKT ; LEFT BRACKET?
+ JRST MDATOM ; NO--THIS MUST BE AN ATOM OR SOMETHING
+ PUSHJ P,RUBBER ; YES--JUST RUB IT OUT
+ JRST MDFLOT
+ JRST MDFLOT ; AND LEAVE
+; KILL AN ATOM--GO TO BREAK OR TO UNQUOTED BRACKET
+MDATOM: PUSHJ P,RUBBER ; FLUSH A CHAR
+ JRST MDFLOT
+ JUMPE C,MDFLOT
+ LDB A,B ; GET THE NEXT ONE
+ PUSHJ P,BREAK ; BREAK?
+ JRST MDATO1
+ PUSHJ P,QUOTEQ ; QUOTED?
+ JRST MDFLOT ; NO, SO DONE
+ JRST MDATOM ; YES, SO FLUSH IT
+MDATO1: PUSHJ P,LFTBKT ; LEFT BRACKET?
+ JRST MDATO2
+ JRST MDFLOT ; YES, SO DONE
+MDATO2: PUSHJ P,RITBKT
+ JRST MDATOM ; NOT A BRACKET, SO FLUSH IT
+ JRST MDFLOT
+
+; HAVING FINISHED THE TRIVIA, WE NOW GET TO THE INTERESTING STUFF--
+; FLUSHING A MUDDLE OBJECT. 'DISGUSTING' DOESN'T DO THIS CROCK JUSTICE.
+MDOBJF: PUSH P,BK ; WE USE THE BK STACK FOR STORING BRACKETS
+ MOVEM BK,MDBKSV
+ PUSH P,B
+ PUSH P,C ; SAVE OLD BUFFER, SINCE MAY NOT DO ANYTHING
+ ADDI C,1
+ MOVEI D,0 ; USE TO ACCUMULATE CTRL-J'S PASSED
+ IBP B
+MDOBLP: SOJLE C,OVERCL ; OUT OF CHARS BEFORE TERMINATION, SO ERROR
+ DBP B
+ LDB A,B ; GET A CHARACTER
+ PUSHJ P,RITBKT ; RIGHT BRACKET?
+ JRST MDOBJ1 ; NO, TRY SOMETHING ELSE
+ CAIN A,"" ; STRING?
+ JRST MDSTRG ; YES, GO HACK IT
+ PUSH BK,A ; ELSE, SAVE THE CHAR
+MDPDLO: JRST MDOBLP ; AND GO TO THE NEXT CHARACTER
+MDOBJ1: PUSHJ P,LFTBKT ; LEFT BRACKET?
+ JRST [CAIE A,^J
+ JRST MDOBLP
+ AOJA D,MDOBLP]; NOPE--GO TO THE NEXT CHAR
+ PUSHJ P,SAMBKT ; IS THIS THE SAME AS THE ONE ON THE STACK?
+ JRST MISMAT ; NO--YOU LOSE
+MDMISA: SUB BK,[1,,1] ; YES--OR MISMATCHES ARE ALLOWED
+MDDONQ: CAME BK,-2(P) ; IS THE STACK EMPTY?
+ JRST MDOBLP ; NO, SO CONTINUE
+ SUB P,[3,,3] ; CLEAN UP P
+ LDB E,B
+ MOVEI A,0
+ DPB A,B ; MAKE THE BUFFER ASCIZ
+ DBP B
+ SOJLE C,MDDNQ1 ; FLUSH THE LAST CHAR
+ CAIN E,"" ; DID WE JUST RUB OUT A STRING?
+ JRST MDDNQ1 ; YES, SO DON'T CHECK FOR LEADING !
+ LDB A,B
+ CAIE A,"!
+ JRST MDDNQ1
+ SUBI B,1
+ DBP B ; FLUSH THE !
+MDDNQ1: SKIPN TOERS ; CAN THE TERMINAL ERASE?
+ JRST [OASCR [ASCIZ /XXXX?/]
+ JRST MDODON] ; NO
+ JUMPE D,MDODN3 ; NO CTRL-J'S--STAY ON THIS LINE
+ CAIN D,1
+ JRST MDODN2 ; ONE CTRL-J
+ MOVEI A,(D)
+ PUSHJ P,LNSTRV
+ JRST MDODON ; GO CLEAR OUT INPUT BUFFER
+MDODN2: SETZM CHPOS
+ OHPOS @CHPOS
+ OCTLP "L ; CLEAR THE LINE
+ OCTLP "U ; AND GO UP
+MDODN3: PUSHJ P,GHPOS
+ OHPOS @CHPOS
+ OCTLP "L ; CLOBBER THE END OF THE LINE
+; CLEAR TO END OF INPUT BUFFER: FILL IN WORD THAT WE'RE POINTING AT,
+; THEN BLT 0 THROUGH THE REST
+MDODON: PUSH P,B ; SAVE BUFFER POINTER
+ MOVEI A,0
+MDODNL: TLNN B,760000 ; ALREADY AT BEGINNING OF WORD?
+ JRST MDODBT ; YES--GO CLOBBER THE REST
+ IDPB A,B ; NO--KILL THIS CHAR
+ JRST MDODNL
+MDODBT: ADDI B,1
+ HRRZS B
+ CAIL B,INPBUF+INPBLN-1 ; POINTING AT LAST WORD OF BUFFER?
+ JRST MDODND ; YES, DONE
+ ADDI B,1
+ SETZM (B)
+ CAIL B,INPBUF+INPBLN-1 ; IS THE LAST BUFFER WORD THE FIRST TO GO?
+ JRST MDODND ; YES, SO WE'RE DONE
+ HRLS B
+ ADDI B,1
+ BLT B,INPBUF+INPBLN-1 ; KILL THE REST OF THE BUFFER
+MDODND: POP P,B
+MDFLOT: POP P,E
+ POP P,D
+ POP P,A
+ JRST RCMD1 ; ALL DONE
+
+; HACK STRINGS
+MDSTRG: SOJLE C,OVERCL
+ DBP B
+ LDB A,B
+ CAIE A,""
+ JRST [CAIE A,^J
+ JRST MDSTRG
+ AOJA D,MDSTRG] ; COUNT LF'S
+ PUSHJ P,QUOTEQ ; QUOTED "?
+ JRST MDDONQ ; NO, SO HAVE A STRING
+ JRST MDSTRG
+\f
+RITBKT: CAIE A,">
+ CAIN A,")
+ JRST RITBK1
+ CAIE A,"]
+ CAIN A,""
+ JRST RITBK1
+ CAIE A,"}
+ POPJ P, ; NO CHANCE
+RITBK1: PUSHJ P,QUOTEQ ; QUOTED?
+ JRST POPJ1 ; NO--REALLY A RIGHT BRACKET
+ POPJ P,
+
+LFTBKT: CAIE A,"<
+ CAIN A,"(
+ JRST LFTBK1
+ CAIE A,"[
+ CAIN A,"{
+ JRST LFTBK1
+ POPJ P,
+LFTBK1: PUSHJ P,QUOTEQ
+ JRST POPJ1
+ POPJ P,
+
+; IS THE LEFT BRACKET IN A A MATE FOR THE RIGHT BRACKET IN (BK)?
+SAMBKT: PUSH P,B
+ CAIN A,"<
+ JRST [MOVEI B,">
+ JRST SAMBR1]
+ CAIN A,"(
+ JRST [MOVEI B,")
+ JRST SAMBR1]
+ CAIN A,"[
+ JRST [MOVEI B,"]
+ JRST SAMBR1]
+ MOVEI B,"}
+SAMBR1: CAMN B,(BK)
+ AOS -1(P)
+ POP P,B
+ POPJ P,
+
+; IS THE CHAR IN A QUOTED?
+QUOTEQ: PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ MOVEI D,0 ; # OF \'S ENCOUNTERED
+QUOTEL: SOJLE C,QUOTEO ; OUT OF CHARS
+ DBP B
+ LDB A,B
+ CAIE A,"\
+ JRST QUOTEO
+ AOJA D,QUOTEL ; AOS THE # OF QUOTES, TRY AGAIN
+QUOTEO: JUMPE D,QUOTDN ; NONE, SO LEAVE
+ SOJLE C,QUOTDC
+ LDB A,B
+ CAIE A,"! ; !\
+ JRST QUOTDC ; NO, SO NO MORE TESTS REQUIRED
+ PUSHJ P,QUOTEQ ; SEE IF THE ! IS QUOTED
+ SOJA D,QUOTDC ; SNARF ONE, GO DECIDE IF CURRENT CHAR IS QUOTED
+QUOTDC: TRNE D,1 ; EVEN?
+ AOS -4(P) ; NO, SO SKIP
+QUOTDN: POP P,D
+ POP P,C
+ POP P,B
+ POP P,A
+ POPJ P,
+
+\f
+; ERROR ROUTINES FOR MUDDLE OBJECT RUBOUT
+
+; MISMATCHED BRACKETS
+MISMAT: SKIPE MDMISF
+ JRST MDMISA ; \v AFTER MISMATCH, SO LET IT GO
+ OCTLP "S ; SAVE CURSOR POSITION
+ OASC [ASCIZ / /]
+ OASCI (A)
+ OASC [ASCIZ / mismatched by /]
+ OASCI @(BK)
+ OCTLP "R
+ SETOM MDMISF
+MDERRO: POP P,C ; RESTORE INPUT COUNT
+ POP P,B ; AND POINTER
+ POP P,BK ; RESTORE BK STACK
+ POP P,E
+ POP P,D
+ POP P,A
+ JRST RCMDER ; ERROR LOOP
+
+OVERCL: SETOM MDOVCF
+ OCTLP "S
+ OASC [ASCIZ / Too many close brackets./]
+ OCTLP "R
+ JRST MDERRO
+
+PDLOVF: SETOM MDPDLF
+ OCTLP "S
+ OASC [ASCIZ / \aPDL overflow./]
+ OCTLP "R
+ JRST MDERRO
+\f
+SUBTTL START-UP ROUTINES
+
+; COME HERE TO OPEN UP THE INPUT AND OUTPUT TTY'S
+; THE CONSOLE TYPE IS READ AND IS USED TO DETERMINE
+; THE RUBOUT PROCEDURE
+
+IFN ITS,[
+TTYOPN: .CALL [SETZ
+ SIXBIT /OPEN/
+ [.UAI,,TTYI]
+ [SIXBIT /TTY/]
+ [SIXBIT /TTY/]
+ [SIXBIT /TTY/]
+ SETZB LSTERR]
+ .LOSE 1000
+ .CALL [SETZ
+ SIXBIT /OPEN/
+ [.UAO,,TTYO]
+ [SIXBIT /TTY/]
+ [SIXBIT /TTY/]
+ [SIXBIT /TTY/]
+ SETZB LSTERR]
+ .LOSE 1000
+ .CALL [SETZ
+ 'CNSGET
+ [TTYO]
+ MOVEM ; vsize
+ MOVEM ; hsize
+ MOVEM ; tctyp
+ MOVEM ; ttycom
+ MOVEM TTYOPT
+ SETZB LSTERR']
+ .LOSE 1000
+ .SUSET [.SIMSK2,,[1_TTYI+1_TTYO]]
+ .CALL [SETZ
+ SIXBIT /USRVAR/
+ MOVEI %JSELF
+ MOVEI .RTTY
+ 0
+ SETZ [TLO %TBINF]]
+ .LOSE 1000
+ .CALL TTYSET ; SET UP TTY TO TAKE CONTROL CHARACTERS
+ .LOSE 1000
+ MOVE A,TTYOPT ; SET UP RUBOUT HANDLERS
+ MOVE [PUSHJ P,RUBECH]
+ TLNE A,%TOERS
+ MOVE [PUSHJ P,RUBFLS]
+ MOVEM XCTRUB
+ SETZM TOERS
+ TLNE A,%TOERS
+ SETOM TOERS
+ SETZM TOFCI
+ TLNE A,%TOFCI ; TV KEYBOARD?
+ SETOM TOFCI
+ POPJ P,
+
+TTYSET: SETZ
+ SIXBIT /TTYSET/
+ 1000,,TTYI
+ [030202,,020202]
+ SETZ [030202,,020202]
+]
+IFE ITS,[
+TTYOPN: MOVEI A,.PRIIN
+ RFMOD
+ TDO B,[TT%WKF\TT%WKN\TT%WKP\TT%WKA]
+ TRZ B,TT%ECO
+ SFMOD
+ MOVEI A,.PRIIN
+ MOVEM A,OUTJFN
+ MOVEI A,.FHSLF
+ MOVE B,[LEVTAB,,CHNTAB]
+ SIR
+ EIR
+ MOVE B,[600000,,200000]
+ AIC
+ MOVE A,[.TICCB,,XCBCHN]
+ ATI
+ MOVE A,[.TICCS,,XCSCHN]
+ ATI
+ MOVE [PUSHJ P,RUBECH]
+ MOVEM XCTRUB
+ POPJ P,
+]
+\f
+IFN ITS,[
+MSGOPN: SETZ
+ SIXBIT /OPEN/
+ MOVSI .BII
+ MOVEI DSKCHN
+ [SIXBIT /DSK/]
+ [SIXBIT /COMBAT/]
+ [SIXBIT /MESSAG/]
+ SETZ [SIXBIT /COMBAT/]
+]
+
+MSGRED:
+IFN ITS,[
+ .SUSET [.RXUNAM,,A]
+ .CALL [SETZ
+ SIXBIT /OPEN/
+ [.BII,,DSKCHN]
+ [SIXBIT /DSK/]
+ [SIXBIT /.FILE./]
+ [SIXBIT /(DIR)/]
+ SETZ A]
+ OASCR [ASCIZ /
+This program is used to generate input to the MUDDLE compiler. Don't
+use it unless you have something that needs to be compiled./]
+ .CLOSE DSKCHN,
+ .CALL MSGOPN
+ POPJ P,
+ MOVE A,[-177,,INPBUF] ; READ IN MESSAGE
+ .IOT DSKCHN,A
+ HLRE O,A ; COMPUTE # OF CHARACTERS IN ALL BUT LAST WORD
+ ADDI O,176
+ IMULI O,5
+ SOJ A,
+ HRLI A,440700
+ MOVEI C,6
+MSGRD1: SOJE C,MSGRD2
+ ILDB B,A ; MARCH THROUGH LAST WORD LOOKING FOR 3 OR 0
+ JUMPE B,MSGRD2
+ CAIN B,^C
+ JRST MSGRD2
+ AOJA O,MSGRD1 ; IF NEITHER, THEN A REAL CHARACTER, SO AOS #
+MSGRD2: .CLOSE DSKCHN,
+ MOVE A,[440700,,INPBUF] ; GET BYTE POINTER FOR INPUT BUFFER
+ .CALL [SETZ ; AND PRINT MESSAGE
+ SIXBIT /SIOT/
+ [TTYO]
+ A
+ SETZ O]
+ .LOSE 1000
+ POPJ P,
+]
+IFE ITS,[
+ POPJ P,
+]
+\f
+SUBTTL PRINT ERROR MESSAGE FOR CHANNELS
+
+ERRPR1: SETOM ERRCR'
+ERRPRT:
+IFN ITS,[
+ .CALL [SETZ
+ SIXBIT /OPEN/
+ MOVEI ERRCHN
+ [SIXBIT /ERR/]
+ MOVEI 1
+ SETZI 0]
+ .LOSE 1400
+ MOVE A,[440700,,INPBUF]
+ MOVEI B,INPBLN
+ .CALL [SETZ
+ SIXBIT /SIOT/
+ MOVEI ERRCHN
+ A
+ SETZ B]
+ .LOSE 1000
+ .CLOSE ERRCHN,
+ MOVEI O,
+ DPB O,A
+ SKIPN ERRCR
+ OASCR [0]
+ SETZM ERRCR
+ MOVE A,(P)
+ OASC @ERRMSG(A)
+ OASC INPBUF
+ SUB P,[1,,1]
+ POPJ P,
+]
+IFE ITS,[
+ERRPRT: OASC [ASCIZ / ERROR - /]
+ MOVEI A,.PRIOU
+ MOVE B,[SETZ -1]
+ SETZ C,
+ ERSTR
+ JFCL
+ JFCL
+ SUB P,[1,,1]
+ POPJ P,
+]
+
+ERRMSG: ERRMAC OPNFAL,OPEN FAILED--
+ ERRMAC INFFAL,INFERIOR CREATION FAILED--
+ ERRMAC RNDFAL,failed--
+
+IFE ITS,[
+ HALTF
+]
+\f
+SUBTTL CORE ALLOCATOR
+
+;IBLOCK: TAKES #WORDS IN A, RETURNS POINTER IN A
+
+IFE ITS,[
+IBLOCK: PUSH P,B
+ PUSH P,C
+ MOVE B,GCSTOP
+ HRLS B
+ ADDI B,1
+ SETZM -1(B)
+ MOVE C,GCSTOP
+ ADDI C,-1(A)
+ BLT B,(C)
+ POP P,C
+ POP P,B
+ ADD A,GCSTOP
+ EXCH A,GCSTOP
+ POPJ P,
+]
+
+IFN ITS,[
+IBLOCK: ADD A,GCSTOP ; FIND NEW GCSTOP
+ CAML A,FRETOP ; GREATER THAN FRETOP?
+ JRST MORCOR ; YES
+ EXCH A,GCSTOP ; OLD GCSTOP IS POINTER TO CORE ALLOCATED
+ POPJ P,
+
+; IF REQUEST BIGGER THAN AVAILABLE CORE, GET ANOTHER PAGE
+MORCOR: PUSH P,B
+ MOVE B,FRETOP ; FIND NEW PAGE NUMBER
+ LSH B,-12
+%GETIP: .CALL [SETZ ; FOR HYSTERICAL REASONS
+ SIXBIT /CORBLK/
+ MOVEI %CBNDW+%CBPRV
+ MOVEI %JSELF
+ B
+ SETZI %JSNEW]
+ FATINS NO CORE AVAILABLE TO SATISFY REQUEST
+ MOVEI B,2000
+ ADDM B,FRETOP ; UPDATE FRETOP
+ POP P,B
+ EXCH A,GCSTOP ; A NOW HAS POINTER TO CORE, GCSTOP UPDATED
+ POPJ P,
+]
+\f
+SUBTTL MAINTENANCE
+
+; QMUNG\eG TO TURN QUESTIONS ON/OFF
+QMUNG: MOVE P,TOPSTK ; CONS UP STACK, FREE STORAGE
+ MOVE A,MUMBLE
+ MOVEM A,GCSTOP
+IFN ITS,[
+ .SUSET [.RMEMT,,FRETOP]
+]
+ PUSHJ P,TTYOPN ; GET TTY
+ MOVEI [ASCIZ /Question to mung /]
+ MOVEM PRMPT1
+ MOVE A,[TAILEN+TALSPC,,TAILTB]
+ PUSHJ P,COMTYP ; GET QUESTION
+ PUSH P,A
+ MOVEI [ASCIZ /On or off? /]
+ MOVEM PRMPT1
+ MOVE A,[MUNGLN,,MUNGTB]
+ PUSHJ P,COMTYP ; GET VALUE
+ POP P,B
+ MOVE C,QTABLE(B) ; GET QUESTION TABLE SLOT
+ JUMPE A,TURNON ; VALUE IS 0 IF TURN ON
+ TLO C,%GIGNO
+ MOVEM C,QTABLE(B)
+IFN ITS,[
+ .VALUE
+]
+IFE ITS,[
+ HALTF
+]
+TURNON: TLZ C,%GIGNO
+ MOVEM C,QTABLE(B)
+IFN ITS,[
+ .VALUE
+]
+IFE ITS,[
+ HALTF
+]
+; TABLE FOR MUNGER
+MUNGTB: SYMVAL On,0
+ SYMVAL Off,1
+MUNGLN==MUNGTB-.
+\f
+SUBTTL INTERRUPT HANDLER
+
+; INTERRUPT HANDLER: ON INFERIOR INTERRUPT (INDICATING MUDCOM DONE), DOES
+; SETOM MCHANG AND .DISMIS, CAUSING MAIN PROGRAM TO UNHANG AND HANDLE
+; MUDCOM'S RETURN. FOR TTYI INTERRUPT, IF CTRL-R OR CTRL-S AND INFERIOR
+; EXISTS, KILLS IT, RESETS INPUT CHANNEL, AND PRETENDS CHARACTER TYPED
+; NORMALLY. EVERYTHING ELSE IS IGNORED.
+
+IFE ITS,[
+XCTRLS: SETZM XCRFLG'
+XCTRLB: SETOM XCRFLG
+ SAVACS
+ MOVEI A,.PRIIN
+ RFMOD
+ TRZ B,TT%ECO
+ SFMOD ; GODDAMN GTJFN!
+ RSTACS
+ SKIPN MCHANG
+ OASCR [ASCIZ / Comparison Aborted? /]
+ JRST MCMRDR
+
+XINFER: SETOM MCHANG
+ AOS PCLEV2
+ PUSH P,A
+ MOVSI A,10000 ; USER MODE BIT
+ IORM A,PCLEV2
+ POP P,A
+ DEBRK
+]
+
+IFN ITS,[
+TSINT: 0 ;HERE TO CATCH INTERRUPTS
+TSINTR: 0
+ EXCH A,TSINT
+ TLNN A,400000 ; WORD ONE INTERRUPT?
+ JRST FATALS
+ TLNE A,377 ; INFERIOR INTERRUPT?
+ JRST UNHANG ; LET IT RETURN
+ TRNN A,1_TTYI ; TTY INPUT?
+ JRST TSMORE ; NO, SO MUST BE MORE
+ MOVEI A,TTYI
+ .ITYIC A, ; GET CHARACTER
+ JRST TSOUT ; TOO BAD
+ SKIPE MCHANG ; MUDCOM?
+ JRST LONGPR ; CHECK LONG PRINT-OUT
+ CAIE A,^R ; AUTHORIZED INTERRUPT CHARACTER?
+ CAIN A,^S
+ JRST MCMRDR ; GO FROB IT
+ CAIE A,^L ; TO CLEAR SCREEN WHILE MUDCOM RUNNING
+ JRST TSOUT
+ .RESET TTYI,
+ SCLEAR
+ .DISMIS TSINTR ; BACK TO HANG
+LONGPR: CAIE A,^S
+ CAIN A,^R
+ CAIA
+ JRST TSOUT ; FLUSH IF NOT CTRL-S OR -R
+ SKIPN LONGOT ; PRINTING SOMETHING MOBY?
+ JRST SHRTPR ; NO, SO TREAT THIS AS A NORMAL CTRL CHAR
+ .RESET TTYI,
+LONGP1: OASCR [0] ; PRINT A CR
+ POP BK,P ; RESTORE P-STACK
+ MOVE A,-1(BK) ; RETURN ADDRESS
+ SUB BK,[3,,3] ; FLUSH IT ALL
+ SETZM LONGOT
+ .DISMIS A ; AND RETURN
+
+; COME HERE WITH CTRL-S OR CTRL-R (IN A) IF NOT SET UP TO ABORT PRINTING
+; CLEANLY
+SHRTPR: CAIE A,^S
+ JRST SHRCTR ; IF NOT CONTROL-S, CAN'T DO MUCH
+ .RESET TTYI,
+ .DISMIS [TOPLEV]
+SHRCTR: SKIPN MDBKSV ; IN MIDDLE OF CTRL-K?
+ JRST TSOUT ; NO, SO FLUSH
+ .RESET TTYI,
+ MOVE BK,MDBKSV ; RESTORE BK
+ SETZM MDBKSV
+ .DISMIS [RACK] ; GO HACK IT
+
+TSMORE: MOVEI A,[ASCII /**More**/]
+ SKIPE LONGOT
+ MOVEI A,[ASCII /--More--/] ; INTELLIGENT MORE MODE
+ PUSH P,B
+ HRLI A,440700
+ MOVEI B,10
+ .CALL TSSIOT ; PRINT IT
+ .LOSE 1000
+ .CALL [SETZ
+ SIXBIT /FINISH/
+ SETZI TTYO]
+ JFCL
+ .CALL [SETZ
+ SIXBIT /IOT/
+ MOVSI %TIPEK+%TIACT+%TIINT
+ MOVEI TTYI
+ SETZ A]
+ .LOSE 1000
+ CAIN A,40 ; SPACE?
+ JRST TSMOR1
+ CAIN A,177
+ .RESET TTYI, ; FLUSH RUBOUT
+ SKIPN LONGOT
+ JRST TSMOR2 ; IF NOT LONG OUTPUT, JUST CONTINUE
+ MOVE A,[440700,,[ASCII /Flushed/]]
+ MOVEI B,7
+ .CALL TSSIOT
+ .LOSE 1000
+ POP P,B
+ EXCH A,TSINT
+ JRST LONGP1 ; AND GO FLUSH IT
+TSMOR1: .RESET TTYI,
+TSMOR2: MOVE A,[440700,,[ASCII /\10T\10L/]]
+ MOVEI B,4
+ .CALL TSSIOT
+ .LOSE 1000
+ POP P,B
+ JRST TSOUT
+TSSIOT: SETZ
+ SIXBIT /SIOT/
+ MOVSI %TJDIS
+ MOVEI TTYO
+ A
+ SETZ B
+
+; WORD ONE INTERRUPTS COME HERE. TSINT IS IN A
+
+FATALS: TLNE A,%PJATY
+ JRST ATTY
+ TRNE A,%PIPDL
+ JRST PDLOV
+ .DISMI TSINTR
+
+ATTY: MOVE A,TSINTR
+ TLNE A,%PC1PR
+ JRST TSOUT ; FLUSH IF SINGLE-STEPPING
+ SKIPE DEBUG
+ JRST TSOUT ; DON'T DO THIS IF DEBUGGING
+ SKIPN INREAD ; IN READER?
+ JRST TSOUT ; NO
+ PUSHJ P,PPRMPT
+ OASC INPBUF
+ JRST TSOUT
+
+; PEOPLE COME HERE IF THE INTERRUPT DOESN'T CAUSE FUNNINESS
+
+UNHANG: SETOM MCHANG
+ .DTTY
+ JFCL
+ .USET MCINFO,[.RPIRQ,,A]
+ TRNN A,%PIBRK ; NORMAL DEATH?
+ JRST [MOVEI C,0
+ .DISMI [MCERR]] ; DIED HORRIBLY
+TSOUT: EXCH A,TSINT
+ .DISMIS TSINTR
+
+PDLOV: EXCH B,TSINTR
+ HRRZS B
+ CAIE B,MDPDLO ; LOCATION WHERE 'LEGIT' STACK OVERFLOW CAN GO
+ FATINS PDL OVERFLOW
+ EXCH A,TSINT
+ EXCH B,TSINTR
+ .DISMIS [PDLOVF] ; GO TO ROUTINE TO FIX IT
+]
+
+; COME HERE TO VIOLENTLY FLUSH MUDCOM
+MCMRDR: SETOM MCHANG
+IFN ITS,[
+ .UCLOSE MCINFO, ; KILL INFERIOR
+ .RESET TTYI, ; EAT CHARACTER
+ OASCR [ASCIZ /
+Comparison aborted/]
+ CAIE A,^R ; CTRL-R?
+ .DISMIS [TOPLEV] ; CTRL-S, SO GO TO TOPLEVEL
+ .DISMIS [RACK] ; PRETEND NORMAL CTRL-R
+]
+IFE ITS,[
+ SKIPN XCRFLG ; CTRL-R?
+ JRST XTOPLV ; CTRL-S, SO GO TO TOPLEVEL
+ SKIPA A,[RACK] ; PRETEND NORMAL CTRL-R
+XTOPLV: MOVEI A,TOPLEV
+ SETZM XCRFLG
+ MOVEM A,PCLEV1
+ MOVE A,MCHNDL
+ SKIPN MCHANG
+ KFORK
+ DEBRK ; RETURN
+]
+\f
+SUBTTL UUOS
+
+; TYPEOUT UUOS (STRAIGHT FROM DIRED, WITH SOME HELP FROM PDL)
+
+UUOCT==0
+UUOTAB: JRST ILUUO
+ IRPS X,,[OOCT ODEC OBPTR OHPOS OCTLP OSIX OASC OASCI OASCR]
+ UUOCT==UUOCT+1
+ X=UUOCT_33
+ JRST U!X
+ TERMIN
+
+UUOMAX==.-UUOTAB
+
+UUOH: 0
+ PUSH P,A
+ PUSH P,B
+ PUSH P,C
+ PUSH P,D
+ MOVEI @40 ; GET EFF ADDR. OF UUO
+ MOVEM UUOE
+ MOVE @0
+ MOVEM UUOD ; CONTENTS OF EFF ADR
+ MOVE B,UUOE ; EFF ADR
+ LDB A,[270400,,40] ; GET UUO AC,
+ LDB C,[330600,,40] ; OP CODE
+ CAIL C,UUOMAX
+ MOVEI C,0 ; GRT=>ILLEGAL
+ JRST @UUOTAB(C) ; GO TO PROPER ROUT
+
+UUORET: POP P,D
+ POP P,C
+ POP P,B
+ POP P,A ; RESTORE AC'S
+ JRST 2,@UUOH
+
+ILUUO: FATINS ILLEGAL UUO
+UOBPTR: MOVEI C,0
+ MOVE B,UUOD ; PICK UP BYTE POINTER
+ JRST UOASC1 ; AND JOIN CODE
+UOASCR: SKIPA C,[-1] ; CR FOR END OF TYPE
+UOASC: MOVEI C,0 ; NO CR
+ HRLI B,440700 ; MAKE ASCII POINTER
+UOASC1: MOVEI A,0
+ PUSH P,B ; SAVE BPTR
+UOASCC: ILDB D,B ; GET CHAR
+ JUMPE D,UOASCD ; FINISH?
+ AOJA A,UOASCC ; AOS COUNT, GO ON
+UOASCD: POP P,B
+ PUSHJ P,SIOTA ; SPIT IT OUT
+ JUMPE C,UUORET ; CR NEEDED?
+ SETZM XHPOS'
+ MOVEI A,2 ; YES
+ MOVE B,[440700,,[ASCIZ /
+/]]
+ PUSHJ P,SIOTA
+ JRST UUORET
+
+UOCTLP:
+IFN ITS,[
+ MOVEI A,^P
+ PUSHJ P,IOTAD
+ MOVE A,B
+ PUSHJ P,IOTAD ; DISPLAY-MODE IOT
+]
+ JRST UUORET
+
+UOASCI: MOVE A,B ; PRT ASCII IMMEDIATE
+ PUSHJ P,IOTA
+ JRST UUORET
+
+UOSIX: SKIPN C,UUOD
+ JRST UUORET
+ MOVEI A,0
+ MOVE B,[440700,,UUOSCR]
+USXOOP: LDB D,[360600,,C]
+ ADDI D,40
+ IDPB D,B
+ ADDI A,1
+ LSH C,6
+ JUMPN C,USXOOP
+ MOVE B,[440700,,UUOSCR]
+ PUSHJ P,SIOTA
+ JRST UUORET
+
+UOHPOS:
+IFN ITS,[
+ MOVEI A,^P
+ PUSHJ P,IOTAD
+ MOVEI A,"H
+ PUSHJ P,IOTAD
+ MOVEI A,10(B)
+ PUSHJ P,IOTAD
+]
+IFE ITS,[
+ CAMG B,XHPOS
+ JRST UOHPS1
+UOHPSL: CAMG B,XHPOS
+ JRST UUORET
+ MOVEI A,40
+ PUSHJ P,IOTA
+ JRST UOHPSL
+
+UOHPS1: MOVEI A,^I
+ PUSHJ P,IOTA
+]
+ JRST UUORET
+
+UODEC: SKIPA C,[10.] ; GET BASE FOR DECIMAL
+UOOCT: MOVEI C,8. ; OCTAL BASE
+ MOVE B,UUOD ; GET ACTUAL WORD TO PRT
+ JRST .+3 ; JOIN CODE
+UODECI: SKIPA C,[10.] ; DECIMAL
+UOOCTI: MOVEI C,8.
+ MOVEM C,BASE
+ SKIPN A
+ MOVEI A,0 ; A=DIGIT COUNT
+ MOVE C,B ; PUT # TO PRT IN C
+ MOVE B,[010700,,UUOSCR+1]
+ PUSHJ P,UONUM ; PRINT NUMBR
+ JRST UUORET
+
+UONUM: IDIV C,BASE
+ ADDI D,"0
+ CAILE D,"9
+ ADDI D,"A-"9-1 ; MAKE HEX DIGIT, IF NOT DECIMAL
+ DPB D,B ; SAVE DIGIT
+ DBP B
+ ADDI A,1
+ JUMPN C,UONUM ; IF NON-ZERO, STILL CRAP LEFT
+ PUSHJ P,SIOTA
+ POPJ P,
+
+IOTA:
+IFN ITS,[
+ .IOT OUTCHN,A
+]
+IFE ITS,[
+ MOVE B,A
+ MOVE A,OUTJFN
+ BOUT
+]
+ AOS XHPOS
+ POPJ P,
+
+IOTAD:
+IFN ITS,[
+ .CALL [SETZ
+ SIXBIT /IOT/
+ MOVSI %TJDIS ; TURN ON DISPLAY MODE FOR THIS
+ MOVEI OUTCHN
+ SETZ A]
+ .LOSE %LSSYS
+ POPJ P,
+]
+IFE ITS,[
+ JRST IOTA
+]
+
+SIOTA: ADDM A,XHPOS
+IFN ITS,[
+ .CALL [SETZ
+ SIXBIT /SIOT/
+ MOVEI OUTCHN
+ B
+ SETZ A]
+ .LOSE %LSSYS
+]
+IFE ITS,[
+ PUSH P,C
+ PUSH P,D
+ MOVE C,A
+ MOVE A,OUTJFN
+ SETZ D,
+ SOUT
+ POP P,D
+ POP P,C
+]
+ POPJ P,
+
+\f
+
+CONSTA
+VARIAB
+MUMBLE: GCSBOT
+GCSBOT: 0
+
+END START
\ No newline at end of file
projects / pdp10-muddle.git / commitdiff