From: Lars Brinkhoff Date: Thu, 15 Nov 2018 06:30:24 +0000 (+0100) Subject: COMBAT, MUDCOM, and bootstrapper. X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=4ac271f03b0b4ece4802d0fd08b45f73bec17924;p=pdp10-muddle.git COMBAT, MUDCOM, and bootstrapper. --- diff --git a//combat.mid.151 b//combat.mid.151 new file mode 100644 index 0000000..631d5a2 --- /dev/null +++ b//combat.mid.151 @@ -0,0 +1,6277 @@ +; ******* 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 +]] + + +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 /: FATAL ERROR -- !NAME! +/] +] +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 + + + +LOC 40 + 0 + JSR UUOH +IFN ITS,[ + JSR TSINT +LOC 100 +] +IFE ITS,[ +LOC 140 +] + +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 +] + +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 /:LOG INKILL +/] + 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 + +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 + + +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 + +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 +] + + +; 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, + +; 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 + + + +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 + + +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, + + + +; 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 + + +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./] + +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 + +; 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 +] + + + +; 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, + +; 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 /:KILL +:PCOMP +/ +NPCOMP: ASCIZ /:KILL +: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 + +; 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, + + +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 + +; 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 //] + SKIPE SSSPPP + MOVEI C,[ASCIZ //] + 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 /;/ +] + +; 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 '' 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 FROM PSNAME +OSNAME: SKIPN PSNAME + AOBJN A,POPJ1 ; FLUSH COMPLETELY + OASC (D) ; PRINT ,,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 //]] + CAIE E,1 + MOVE A,[1,,[ASCIZ //]] + 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, + + +; 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 + 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 + + +; 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, + +; 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 + +; 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 // +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, + + +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, + +; 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 + +; 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, + +; 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 + +; 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 + +; FNDLNK CONSES UP TABLE OF ALL POINTERS TO THIS TYPE: FORMAT IS +; LNKTPT: +; 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 + +; 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 + +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 + +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 + + + + +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 + +; OUTPUT SPECIFICATIONS +; TYPE,OFFSET,HEADER,TRAILER + +OUTSPC: OUTPUT $OSNAM, .QSNAM,/ > /, CR + OUTPUT $OFNAM, .QINP,/ +/ +CLIST: ASCIZ /)> +/ +CSTRNG: ASCIZ /"> +/ + +; 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 ,-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 +; . +TMORTB: SYMVAL ,-1 + SYMVAL No,0 + SYMVAL Yes,1 + SYMVAL False,0 + SYMVAL True,1 +MORLEN==TMORTB-. +MORPMP: ASCIZ /Another compilation?/ + + +;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 . + To complete and terminate a response, type or . + To use the default, type or . + 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 . + 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 will indicate a negative response. + To get the current default, type . + The current default is / + +HLPFSP: SAVACS + OASC HLPFSM + PUSHJ P,HLPFDF + JRST HLPOUT + +HLPFLM: ASCIZ / + Input a file name. Typing an 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, + + +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 ,-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 will indicate a negative response. + To get the current default, type . + 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 //] +] +IFE ITS,[ + CAMN B,[ASCIZ //] +] + JRST XSPNM1 +IFN ITS,[ + CAME B,[ASCIZ //] +] +IFE ITS,[ + CAME B,[ASCIZ //] +] + 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 + +; 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 + 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, + + +; 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 + JRST SMTRM3 ; NO. COMPLETE ONLY + MOVE A,PRMPT1 + TLNE A,%RDCRT ; IS THE TERMINATE ON 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 + +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 + +; RUB OUT A WORD: STOP AT , , , OR , 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 , , , , <;> +BREAK: CAIE A,^I + CAIN A,^J + JRST POPJ1 + CAIE A,^M + CAIN A,40 + JRST POPJ1 + CAIN A,"; + JRST POPJ1 + POPJ P, + +; 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 + +; 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 + +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, + + +; ERROR ROUTINES FOR MUDDLE OBJECT RUBOUT + +; MISMATCHED BRACKETS +MISMAT: SKIPE MDMISF + JRST MDMISA ; 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 / PDL overflow./] + OCTLP "R + JRST MDERRO + +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, +] + +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, +] + +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 +] + +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, +] + +SUBTTL MAINTENANCE + +; QMUNGG 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-. + +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 /TL/]] + 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 +] + +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, + + + +CONSTA +VARIAB +MUMBLE: GCSBOT +GCSBOT: 0 + +END START \ No newline at end of file diff --git a//mudcom.mid.118 b//mudcom.mid.118 new file mode 100644 index 0000000..e622f28 --- /dev/null +++ b//mudcom.mid.118 @@ -0,0 +1,2724 @@ +TITLE MUDCOM -- MUDDLE SRCCOM (MARC) + +.SYMTAB 8001. + +O=0 +F=0 +A=1 +B=2 +C=3 +D=4 +E=5 +X=6 + +ENTPTR=10 +MANPTR=11 +CMNPTR=12 +COMPTR=13 + +CH=14 +TMAX=16 + +P=17 ;CANONICAL DM STACK LOCATION + + +IF1,[ITS==0 + PRINTC /MUDCOM for ITS? (Y OR N)/ + .TTYMAC A + IFSE A,Y,[ITS==1] + TERMIN +] +IF1,[ + IFE ITS,[ + .TNXDF + .DECSAV +]] + + + +IFN ITS,[ +LOC 77 +] +IFE ITS,[ +LOC 140 +] +JCLTOP: ASCII / / +JCL: BLOCK 100. +JNAME: BLOCK 2 +JFNBLK: BLOCK 1000. +TIMBLK: BLOCK 3 +NBNBLK: BLOCK 25. +GCSTOP: JFNBLK +JCLINB: BLOCK 250. +PDL: BLOCK 30. +CPDL: BLOCK 100. +INPBLK: BLOCK 500. +SYLBUF: BLOCK 10. +FTABLE: BLOCK 1200. +PAKBUF: BLOCK 3 +ENTBUF: BLOCK 900. +COMBUF: BLOCK 400. +RNDTBL: BLOCK 800. +MANBUF: BLOCK 800. +CMNBUF: BLOCK 400. +DIRPAG: BLOCK 1024. +PATCH: BLOCK 20. + +VERSIO: .FVERS +BLKEND: 0 +JFN: 0 +F1JFN: 0 +F2JFN: 0 +F1BLK: 0 +F2BLK: 0 +F1PTR: 0 +F2PTR: 0 +FBLOCK: 0 +DSKJFN: 0 +XTABLE: 0 +CMNMAX: -1 +CMNFLG: 0 +MANFLG: 0 +JCLPTR: 0 + +; FILE NAME DEFINITIONS + +UFN1==0 +UFN2==1 +UNDATE==3 +LUNBLK==5 + +; CHANNEL DEFINITIONS + +DSK1==0 +DSK2==1 +TYOC==2 +DSKI==3 + +; TYPE CODES + +DEFMAC==1 +SETG==2 +MSETG==3 +ENTRY==7 +PACKAGE==10 +ENDPACKAGE==11 +RPACKAGE==12 +MANIFEST==13 + +; FTABLE RECORDS + +RECLEN==3 + +; ERROR CODES + +ESELF==1 ; SELF COMPARISON +EILLCH==2 ; ILLEGAL CHARACTER IN FILE NAME +ESYNER==3 ; SYNTAX ERROR +EOPNFL==4 ; OPEN FAILED +EINTER==5 ; INTERNAL BUG IN MUDCOM +ENDIFF==6 ; NO DIFFERENCES +ENSIM==7 ; NO SIMILARITIES + +; SEPARATORS + +LF==12 +FF==14 +CR==15 +TAB==11 + +; TYPE CODES FOR MACRO/MANIFEST HACKS + +MACPAD==0 +NMNPAD==1 +CMNPAD==2 +XXXXXX==3 ;DON'T USE THIS! +ASKPAD==4 + +; TYPE TABLE + +GTYPE: ASCIZ /DEFINE/ + ASCIZ /DEFMAC/ + ASCIZ /SETG/ + 0 + ASCIZ /MSETG/ + ASCIZ /TITLE/ + ASCIZ /SUB-ENTRY/ + ASCIZ /SET/ + 0 + ASCIZ /ENTRY/ + ASCIZ /PACKAGE/ + ASCIZ /ENDPACKAG/ + ASCIZ /RPACKAGE/ + ASCIZ /MANIFEST/ + +PTYPE: ASCIZ /FUNCTION/ + ASCIZ /MACRO/ + ASCIZ /GVAL/ + 0 + ASCIZ /MSETG/ + ASCIZ /CRUFTY/ + ASCIZ /CRUFTY/ + ASCIZ /LVAL/ + 0 +PGTYPE: ASCIZ /FOOBAR/ + ASCIZ /FOOBAR/ + ASCIZ /FOOBAR/ + ASCIZ /FOOBAR/ + ASCIZ /FOOBAR/ + +NUMTYP==</2> + ; NUMBER OF OBJECT TYPES INTERESTED IN +MAXTYP==<.-GTYPE> + ; MUST BE DEFINED BEFORE USED +MXGTYP==5 + +TBLTOP: RNDTBL +NAME: 0 +FNBLKI: +FNAME1: 0 + 0 +FNAME2: SIXBIT />-1/ + SIXBIT />/ +SNAME: 0 + 0 +DEVICE: SIXBIT /DSK/ +FNBLKO: 0 + +HPOS: 0 + +SAVBLK: 0 + 0 + SIXBIT />-1/ + SIXBIT />/ + 0 + 0 + SIXBIT /DSK/ + 0 + +CHGTOT: BLOCK NUMTYP +NEWTOT: BLOCK NUMTYP +REMTOT: BLOCK NUMTYP +SAMTOT: BLOCK NUMTYP + +ZSTART: +P2SW: 0 +P3SW: 0 +BIGLOS: 0 ; -1 IF ANY SIMILARITIES ENCOUNTERED +SMALOS: 0 ; -1 IF ANY DIFFERENCES ENCOUNTERED + +PRELOD: 0 + +LSTPTR: 0 +LSTTYP: 0 + +CURCHN: 0 + +DEPTH: 0 + +WINNER: 0 +SPACSW: 0 + +CHKSW: 0 + +COMCNT: 0 +PAKSW: 0 +RPAKSW: 0 +MQUOTE: 0 +MMACRO: 0 +SKIPPR: 0 + +TOTSW: 0 +GETSW: 0 +STRSW: 0 +QUOTSW: 0 +ENDSW: 0 +EXCLSW: 0 + +ENDFLG: 0 +ZFINIS: +LSTFLG: 0 + + +COMSW: 0 +ACCPTR: -1 +ACCSAV: 0 + +DEFINE HALT +IFN ITS,[ + .BREAK 16,140000 +] +IFE ITS,[ + JRST XHALT +] +TERMIN + +DEFINE DBP X ;DECREMENT BYTE POINTER + ADD X,[070000,,0] + JUMPGE X,.+3 + SOS X + HRLI X,010700 +TERMIN + +DEFINE SAFEIN AC, + PUSH P,A + MOVE AC,ACCPTR + MOVEM AC,ACCSAV +TERMIN + +DEFINE SAFEOUT AC, + MOVE AC,ACCSAV + CAMN AC,ACCPTR + JRST .+3 + PUSHJ P,LSTBLK + JRST .-3 + POP P,A +TERMIN + +DEFINE NXTCHR X + IBP A + HRRZ A + CAML BLKEND + PUSHJ P,NXTBLK + LDB X,A + JUMPL X,EOFERR +TERMIN + +DEFINE COMCHR CHR + MOVEI CHR + IDPB COMPTR + AOS COMCNT +TERMIN + +DEFINE COMAC AC, + IDPB AC,COMPTR + AOS COMCNT +TERMIN + +DEFINE CHRADD INST,CHR +ZZZ==. + LOC CHRTBL+CHR + JRST INST +LOC ZZZ +TERMIN + + +SUBTTL CHARACTER TABLE + +CHRTBL: REPEAT 200,JFCL + +CHRADD PAD,40 +CHRADD PAD,TAB +CHRADD PAD,CR +CHRADD PAD,LF +CHRADD PAD,FF +CHRADD PUSHER,"< +CHRADD PUSHER,"( +CHRADD PUSHER,"[ +CHRADD PUSHER,"{ +CHRADD POPPER,") +CHRADD POPPER,"} +CHRADD POPPER,"] +CHRADD POPPER,"> + +;START OF MUDCOM CODE + +IFN ITS,[ +START: CAIA + JRST COMBAT + .CALL TTYOPN + .VALUE + .BREAK 12,[5,,JCL] +STARTX: .SUSET [.RSNAME,,A] + MOVEM A,SNAME ;DEFAULT THE SNAMES + MOVE P,[-30,,PDL-1] + .SUSET [.RJNAME,,B] + PUSHJ P,JNMCHK + MOVE MANPTR,[440700,,MANBUF] + MOVE CMNPTR,[440700,,CMNBUF] + SKIPA E,[440700,,JCLTOP] +STARTC: MOVE E,JCLPTR + SKIPE FROBSW + JRST FROBCN + MOVE ENTPTR,[440700,,ENTBUF] + MOVE COMPTR,[440700,,COMBUF] + SETZ D, + PUSHJ P,FPARSS ;GET FIRST NAME + PUSH P,E + PUSHJ P,FPHACK ;HACK THE NAME + POP P,E + .CALL DSKOPN ;OPEN A CHANNEL + JRST OPNFL + .CALL RCHST ;GET REAL FILE NAMES + .LOSE 1000 + SKIPE CHKSW + JRST START1 + SKIPE LSTFLG + JRST STARTL + MOVEI D,1 + SKIPN ENDBRK + PUSHJ P,FPARSS ;GET SECOND NAME + MOVEM E,JCLPTR + SKIPN FNAME1(D) ;DEFAULT FNAME1 IF NECESSARY + JRST [MOVE A,FNAME1 + MOVEM A,FNAME1(D) + JRST .+1] + SKIPN SNAME(D) ;DEFAULT SNAME TO FIRST FILE SNAME + JRST [MOVE A,SNAME + MOVEM A,SNAME(D) + JRST .+1] + SKIPN DEVICE(D) + JRST [MOVE A,DEVICE + MOVEM A,DEVICE(D) + JRST .+1] + PUSHJ P,FPHACK ;HACK THE NAME + .CALL DSKOPN ;OPEN A CHANNEL + JRST OPNFL + .CALL RCHST ;GET REAL FILE NAMES + .LOSE 1000 + MOVE A,FNAME1 ;SEE IF FIRST NAME IS SECOND NAME + CAME A,FNAME1+1 + JRST START0 + MOVE A,FNAME2 + CAME A,FNAME2+1 + JRST START0 + MOVE A,SNAME + CAME A,SNAME+1 + JRST START0 + MOVE A,DEVICE + CAME A,DEVICE+1 + JRST START0 + + SETZ D, ;SELF COMPARISON??? + OASC [ASCIZ /Asked to compare /] + PUSHJ P,PFNAME + OASCR [ASCIZ / with itself?/] + MOVEI B,ESELF + JRST LOST + +] +STARTL: OASC [ASCIZ /Listing /] + CAIA +START1: OASC [ASCIZ /Checking /] + PUSHJ P,PFNAME + OASCR [ASCIZ /./] + JRST START2 + +IFE ITS,[ +START: CAIA + SETOM COMSW + MOVE P,[-30,,PDL-1] + MOVE MANPTR,[440700,,MANBUF] + MOVE CMNPTR,[440700,,CMNBUF] + MOVE ENTPTR,[440700,,ENTBUF] + MOVE COMPTR,[440700,,COMBUF] + SETO A, + MOVE B,[-1,,E] + MOVEI C,.JISNM + GETJI + JFCL + MOVE B,E + PUSHJ P,JNMCHK +; IF SNAME IS 0, WILL USE CONNECTED DIRECTORY... +; MOVEI A,15. ; GET A BLOCK FOR SNAME +; PUSHJ P,IBLOCK ; IN A +; PUSH P,A +; GJINF +; HLL B,A +; HRRO A,(P) +; DIRST ; HERE IT IS +; JFCL +; POP P,A + SETZM XSNAME' ; GET POINTER TO ASCII SNAME + SETZ A, + RSCAN + JFCL + JUMPE A,TTYJCL + MOVN C,A + MOVEI A,.PRIIN + MOVE B,[440700,,JCL] + SIN ; READ JCL + MOVE A,[440700,,JCL] ; INTO JCL BLOCK + ILDB B,A ; PARSE IT + JUMPE B,TTYJCL + CAIE B,40 ; FIRST FLUSH LEADING 'MUDCOM ' + JRST .-3 + MOVEM A,F1PTR ; SAVE POINTER TO FIRST FILE NAME +STT1: ILDB B,A + JUMPE B,TTYJCL ; FUNNY HACK NOW FOR TTY FNM READING + CAIN B,"/ + PUSHJ P,XSWTCH + SKIPN CHKSW + SKIPE LSTFLG + JRST STT2 + CAIE B,", ; FIND SEPARATOR + JRST STT1 + MOVEI B,0 + DPB B,A + MOVEM A,F2PTR ; AND POINTER TO SECOND FILE NAME +STT2: MOVEI A,GTJFN1 + MOVE B,F1PTR + MOVEM B,FPTR' + SKIPE C,XSNAME + HRROM C,GTJFN1+.GJDIR ; DEFAULT THE SNAME + MOVE C,[-1,,[ASCIZ /MUD/]] + MOVEM C,GTJFN1+.GJEXT ; AND MUD AS SECOND FILE NAME + MOVSI C,(GJ%OLD) + MOVEM C,GTJFN1+.GJGEN + GTJFN ; GET THE JFN + JRST JOPNFL ; THIS FILE DOESN'T EXIST -> LOSE + MOVEM A,F1JFN ; SAVE THE JFN + MOVEM A,JFN + MOVE B,[440000,,OF%RD] + OPENF ; OPEN THE FILE + JRST JOPNFL ; WHY? IF GTJFN WON??? + MOVEI A,F1BLK + MOVEM A,FBLOCK + PUSHJ P,XJFNS ; PARSE THE NAME AND PUT POINTER IN F1BLK + SKIPE CHKSW ; FUNNYNESS WITH MUDCHK AND MUDLST + JRST START1 + SKIPE LSTFLG + JRST STARTL + PUSHJ P,F1DEF ; FILL DEFAULTS + MOVEI A,GTJFN1 + MOVE B,F2PTR ; NOW DO GTJFN, USING DEFAULTS AND JCL + MOVEM B,FPTR + MOVSI C,(GJ%OLD) + MOVEM C,GTJFN1+.GJGEN + GTJFN + JRST JOPNFL ; FILE DOESN'T EXIST +STT3: MOVEM A,F2JFN ; SAVE JFN HERE ALSO + MOVEM A,JFN + MOVE B,[440000,,OF%RD] + OPENF ; OPEN THE FILE + JRST JOPNFL ; WHY? + MOVEI A,F2BLK + MOVEM A,FBLOCK + PUSHJ P,XJFNS ; PARSE THE FILE NAME AND SAVE IN F2BLK + MOVE A,F2BLK + MOVE B,3(A) ; GET FILE NAME 2 + MOVE B,(B) ; INTO AC + CAME B,[ASCIZ /MSUBR/] + CAMN B,[ASCIZ /TEMP/] + JRST FOONM2 + CAME B,[ASCIZ /MIMA/] + CAMN B,[ASCIZ /NBIN/] ; IS THIS NBIN?? + JRST FOONM2 + JRST START0 ; START THE BALL ROLLING.... + +;here to find a MUD older than the file given as second file +FOONM2: MOVE A,F2JFN + MOVEI B,TIMBLK + MOVEI C,2 + RFTAD ; SAVE CREATION DATE, ETC. + MOVE A,TIMBLK+.RSCRV + MOVEM A,NBNTIM' + PUSHJ P,F1DEF + MOVSI A,(GJ%OLD+GJ%IFG) + HRRI A,-3 + MOVEM A,GTJFN1 ; MAKE IT FOO.BAR.* + MOVEI A,GTJFN1 + SETZ B, + GTJFN ; GET INDEXABLE POINTER + HALT + MOVEM A,JFN ; AND SAVE THIS + SETZ D, +JFNLP: HRRZS A ; FLUSH BITS + MOVEI B,TIMBLK + MOVEI C,2 + RFTAD + MOVE B,TIMBLK+.RSCRV + CAMG B,NBNTIM + CAMGE B,BSTTIM' + JRST NXTJFN + MOVEM B,BSTTIM + SETZM NBNBLK + MOVE B,[NBNBLK,,NBNBLK+1] + BLT B,NBNBLK+24. + MOVE B,A + HRROI A,NBNBLK + SETZ C, + JFNS +NXTJFN: MOVE A,JFN + GNJFN + CAIA + JRST JFNLP + + SKIPN BSTTIM + JRST NBNLOS + MOVSI A,(GJ%OLD+GJ%SHT) + HRROI B,NBNBLK + GTJFN + HALT ; WENT AWAY? + MOVEM A,F2JFN + MOVEM A,JFN + MOVE B,[440000,,OF%RD] + OPENF + HALT ; WHY? + MOVEI A,F2BLK + MOVEM A,FBLOCK + PUSHJ P,XJFNS ; PARSE THE FILE NAME AND SAVE IN F2BLK + JRST START0 + +; FILL DEFAULTS INTO GTJFN BLOCK FROM FILE NAME 1 + +F1DEF: MOVEI B,GTJFN1+.GJDEV +F1DEF1: MOVE A,F1BLK + HRLI A,-5 + HRRO C,(A) + MOVEM C,(B) + AOJ B, + AOBJN A,.-3 ; FILL IN NEW DEFAULTS FROM FILE NAME 1 + POPJ P, + +XJFNS: MOVE E,[-5,,JFNSBT] ; AOBJN FOR JFNS'ING + MOVEI A,6 + PUSHJ P,IBLOCK + MOVEM A,@FBLOCK + MOVE X,A + SETZ D, ; D IS ALWAYS 0 FOR JFNS +XASKF1: MOVEI A,15. + PUSHJ P,IBLOCK + HRLI A,15. + MOVEM A,(X) + HRROS A ; POINTER TO STRING + MOVE B,JFN ; JFN + MOVE C,(E) ; CORRECT BIT FOR PARSING ONE FIELD + JFNS ; PARSE THE NAME + AOJ X, + AOBJN E,XASKF1 ; UPDATE POINTERS + POPJ P, + +JFNSBT: JS%DEV + JS%DIR + JS%NAM + JS%TYP + JS%GEN + +JOPNFL: OASC [ASCIZ /File not found - /] + MOVE A,FPTR + OBPTR A + HALT + +JCLLOS: OASCR [ASCIZ /ERROR - JCL terminated abruptly./] + HALT + +GTJFN1: GJ%OLD + .NULIO,,.NULIO + 0 + 0 + 0 + 0 + 0 + 0 + 0 + 0 + + +NOJCL: OASCR [ASCIZ /ERROR - JCL must be supplied./] + HALT + +; HERE TO READ STUFF FROM TTY INSTEAD OF JCL LINE +; MOST OF CODE ABSTRACTED FROM START UP PORTION + +TTYJCL: OASC [ASCIZ /MUDCOM./] + ODEC VERSIO + OASCR [0] +TTYJ0: SKIPE C,XSNAME + HRROM C,GTJFN2+.GJDIR + MOVE C,[-1,,[ASCIZ /MUD/]] + MOVEM C,GTJFN2+.GJEXT + MOVEI A,GTJFN2 + SETZ B, + MOVEI D,. + MOVEM D,GTACT' + HRROI C,[ASCIZ /Compare (FILE) /] + MOVEM C,GTJFN2+.GJRTY + OASC (C) + MOVSI D,(GJ%CFM) + ANDCAM D,GTJFN2+.GJGEN + GTJFN + JRST TTYJ1 + MOVEM A,JFN + MOVEM A,F1JFN + MOVE B,[440000,,OF%RD] + OPENF + HALT + MOVEI A,F1BLK + MOVEM A,FBLOCK + PUSHJ P,XJFNS + MOVEI B,GTJFN2+.GJDEV + PUSHJ P,F1DEF1 + MOVEI D,. + MOVEM D,GTACT + HRROI C,[ASCIZ / with (FILE) /] + MOVEM C,GTJFN2+.GJRTY + OASC (C) + MOVSI D,(GJ%CFM) + IORM D,GTJFN2+.GJGEN + MOVEI A,GTJFN2 + SETZ B, + GTJFN + JRST TTYJ1 + JRST STT3 + +TTYJ1: CAIN A,GJFX34 ; ? TYPED + JRST TTYHLP + CAIN A,GJFX37 ; NULL BUFFER + JRST TTYNUL + OASC [ASCIZ / ERROR - /] + MOVEI A,.PRIOU + MOVE B,[SETZ -1] + SETZ C, + ERSTR + JFCL + JFCL + OASCR [0] + JRST TTYJ0 + +TTYHLP: OASCR [0] + OASCR [ASCIZ /Type in a file name./] + JRST @GTACT + +TTYNUL: OASCR [0] + OASCR [ASCIZ /Flushed?/] + JRST TTYJ0 + +GTJFN2: GJ%OLD + .PRIIN,,.PRIOU + 0 + 0 + 0 + 0 + 0 + 0 + 0 + G1%RND+<20000,,0>+3 + 0 + 0 + 0 + +XSWTCH: ILDB B,A + CAIL B,"a + SUBI B,40 ; UPPER CASE + CAIN B,"T + JRST [SETOM TOTSW + JRST XSW1] + CAIN B,"C + JRST [SETOM CHKSW + JRST XSW1] + CAIN B,"M + JRST [SETOM MANFLG + JRST XSW1] + CAIN B,"L + JRST [SETOM LSTFLG + JRST XSW1] + OASC [ASCIZ /Illegal switch in JCL - /] + OASCI (B) + OASCR [ASCIZ /./] + POPJ P, + +XSW1: ILDB B,A + JUMPE B,JCLLOS + CAIN B,40 + JRST XSW1 + DBP A + MOVEM A,F1PTR + POPJ P, +] + +JNMCHK: CAMN B,[SIXBIT /MUDCHK/] + JRST [SETOM CHKSW +IFN ITS,[ + MOVE A,[SIXBIT />/] + MOVEM A,FNAME2 +] + JRST .+1] + CAMN B,[SIXBIT /MUDLST/] + JRST [SETOM LSTFLG +IFN ITS,[ + MOVE A,[SIXBIT />/] + MOVEM A,FNAME2 +] + JRST .+1] + CAMN B,[SIXBIT /MUDFND/] + JRST [MOVE A,[440700,,JCLTOP] + MOVEI B,"( + IDPB B,A + SETOM FNDFLG' + JRST .+1] + POPJ P, + +START0: SETZ D, ;PRINT TITLE LINES + MOVEI A,[ASCIZ /Comparison of /] + SKIPE PRELOD + MOVEI A,[ASCIZ /Preload comparison of /] + SKIPN COMSW + OASC (A) + PUSHJ P,PFNAME + OASC [ASCIZ / and /] + MOVEI D,1 + PUSHJ P,PFNAME + OASCR [ASCIZ /./] +START2: MOVEI A,DSK1 + MOVEM A,CURCHN + MOVE A,[10700,,BLKEND-1] + +;FIRST PHASE OF COMPARISON, READING IN FIRST FILE + +IFE ITS,[ + MOVE A,F1JFN + MOVEM A,DSKJFN +] +PASS1: PUSHJ P,GETSUM + JRST PASS02 + SKIPE WINNER + JRST [MOVEM B,FTABLE(TMAX) + AOJA TMAX,PASS1] + JRST PASS1 + + +;SECOND PHASE OF THE COMPARISON, READING SECOND FILE + +PASS02: +IFE ITS,[ + MOVE A,F2JFN + MOVEM A,DSKJFN +] + SKIPE FROBSW + JRST CONTI1 + SKIPE CHKSW + JRST CHKWIN + SKIPE LSTFLG + JRST LSTWIN +; SKIPN MANFLG ; TAA 5/5/78 SEEMED TO DIE OTHERWISE: IF +; .CLOSE DSK1, ; CHANGED MANIFEST, WENT TO PASS3 REGARDLESS OF MANFLG + MOVEI A,DSK2 + MOVEM A,CURCHN + SETOM P2SW + PUSHJ P,CLFLAG + PUSHJ P,NXTBLK + HRLI A,440700 + +PASS2: PUSHJ P,GETSUM + JRST PASS3 + SKIPN WINNER + JRST PASS2 + PUSH P,A + PUSH P,B + MOVE A,[440700,,SYLBUF] ;BUFFER IN A + MOVE B,LSTTYP ;TYPE IN B + PUSHJ P,MATCH + JRST [PUSHJ P,NEWOBJ + JRST P2ENDR] + SETOM BIGLOS + CAME A,(P) ;CHECKSUM IS IN A. ACCESS POINTER IN B. TYPE IN C + JRST [PUSHJ P,CHGOBJ + JRST P2ENDR] + AOSA SAMTOT(C) + +P2ENDR: OASCR [0] +P2END: POP P,B + POP P,A + JRST PASS2 + + +;ROUTINES TO PRINT AND RECORD CHANGES + +REMOBJ: HLRZ C,-1(A) + SETOM SMALOS + AOS REMTOT(C) + OASC [ASCIZ /Removed /] + PUSHJ P,TYPPRT + MOVE B,-1(A) + OASCR (B) + JRST P3END + +CHGOBJ: OASC [ASCIZ /Changed /] + AOS CHGTOT(C) + CAIN C,DEFMAC + PUSHJ P,MACHAK + CAIN C,SETG + JRST [SKIPE MANFLG + PUSHJ P,MANCHK + JRST .+1] + CAIG C,1 ;MAKE FUNCTIONS AND MACROS WIN + SKIPN COMSW + JRST NEWOB1 + PUSH P,A + PUSH P,B + PUSH P,C + MOVE F,[440700,,SYLBUF] +GH1: ILDB A,F + JUMPE A,GH2 + COMAC A, + JRST GH1 + +GH2: SKIPN PAKSW + JRST GH3 + PUSHJ P,ENTLKP + JRST ADDTR + SKIPN RPAKSW + JRST GH3 + COMCHR "! + COMCHR "- +GH3: COMCHR 40 + POP P,C + POP P,B + POP P,A + JRST NEWOB1 + +ADDTR: COMCHR "! + COMCHR "- + MOVE A,[440700,,PAKBUF] +ADDTR1: ILDB B,A + JUMPE B,GH3 + COMAC B, + JRST ADDTR1 + +NEWOBJ: OASC [ASCIZ /New /] + AOS NEWTOT(C) +NEWOB1: SKIPE CMNFLG + OASC [ASCIZ /MANIFEST /] + SETZM CMNFLG + PUSHJ P,TYPPRT + OASC SYLBUF + SETOM SMALOS + POPJ P, + + +;THIRD GROSS PASS, FOR MANIFEST AND MACRO HACK + +PASS3: SETOM P3SW + SKIPL CMNMAX ; ONLY IF ONE CHANGED + SKIPL MANFLG ; BETTER BE LOOKING 7/8/78 (MARC) + JRST PASS4 + SETZM ENDFLG + MOVEI A,DSK1 + MOVEM A,CURCHN +IFN ITS,[ + .ACCESS DSK1,[0] +] +IFE ITS,[ + MOVE A,F1JFN + SETZ B, + SFPTR + HALT ; WHY CAN'T ACCESS? +] + MOVE A,[10700,,BLKEND-1] + PUSHJ P,ATOM + JRST PASS4 + JRST .-2 + +;FOURTH PASS, FOR REMOVED OBJECTS + +PASS4: MOVEI A,FTABLE+1 + MOVE B,(A) + JUMPE B,FINIS + JUMPGE B,REMOBJ +P3END: ADDI A,RECLEN + JRST PASS4+1 + + +;FINIS. PRINT SUMMARIES + +WINEND: POP P, + POPJ P, + +CONTIN: OASCR [0] +CONTI1: PUSHJ P,CLFLAG + SETZ TMAX, + MOVE [SAVBLK,,FNBLKI] + BLT FNBLKO + SETZM ZSTART + MOVE [ZSTART,,ZSTART+1] + BLT ZFINIS + MOVEI RNDTBL + MOVEM TBLTOP +IFN ITS,[ + JRST STARTC +] +IFE ITS,[ + OASC UNIMPL + HALT +] + +UNIMPL: ASCIZ /Unimplemented on the 20. Sorry./ + +CLFLAG: SETZM ENDFLG + SETZM SPACSW + SETZM GETSW + SETZM STRSW + SETZM QUOTSW + SETZM ENDSW + SETZM EXCLSW + SETOM ACCPTR + POPJ P, + +FINIS: SKIPE PRELOD + JRST CONTIN + SKIPN BIGLOS ; SKIP IF ANY SIMILARITIES + JRST LOSER + SKIPN SMALOS + JRST EQUAL + SKIPN TOTSW + JRST FINIS1 + OASC [ASCIZ / + FUNCTION MACRO GVAL LVAL +SAME/] + MOVEI D,SAMTOT + PUSHJ P,TOTAL + OASC [ASCIZ / +CHANGED/] + MOVEI D,CHGTOT + PUSHJ P,TOTAL + OASC [ASCIZ / +NEW/] + MOVEI D,NEWTOT + PUSHJ P,TOTAL + OASC [ASCIZ / +REMOVED/] + MOVEI D,REMTOT + PUSHJ P,TOTAL +FINIS1: SKIPN COMSW + HALT ;just halt if not under combat + + SETZ A, + SKIPN B,COMCNT + MOVEI A,10 +IFN ITS,[ + MOVEI C,COMBUF +] +IFE ITS,[ + PUSH P,A + HRROI A,COMBUF + RSCAN + JFCL + SETZ A, + RSCAN + JFCL + POP P,A +] + HALT ; THIS IS WAY TO END LEGIT + +TOTAL: MOVEI C,4 + HRLI D,-NUMTYP +TOTLP: ADDI C,6 + OHPOS (C) + OALIGN 4,(D) + AOBJN D,TOTLP + POPJ P, + +EQUAL: OASC [ASCIZ /No differences encountered./] + MOVEI A,6 + MOVEI C,COMBUF + HALT + +;MY FAVORITE! + +LOSER: OASC [ASCIZ /No similarities encountered./] + MOVEI A,7 + HALT + +CHKWIN: OASC [ASCIZ /Blessed./] + HALT + +LSTWIN: HALT + + +;GTNAM GETS THE NAME OF THE SUBR AND IF IT IS ONE WHICH IS HACKED +;(E.G. DEFINE) IT GETS THE NAME OF THE FUNCTION AND PLACES IT IN +;THE TABLE WITH THE CORRECT CODE + +GTNAM: AOS OBJCNT' + PUSH P,B + PUSH P,C + PUSH P,D + PUSH P,F + MOVE C,ACCPTR + IMULI C,500. ;FIX UP FOR 500 WORD BLOCKS + HRRZ D,A + ADD C,D ;SUBTRACT THE BP + SUBI C,INPBLK+1 + MOVEM C,LSTPTR ;AND SAVE IT + MOVE B,[440700,,SYLBUF] + PUSHJ P,GETSYL ;GET FIRST ATOM IN FORM + PUSHJ P,GETTYP ;IS IT ONE OF OURS? + JRST GETEND ;LOSE + SKIPE P2SW ;WINNING ATOM + JRST GETNP2 + HRRZ B,TBLTOP + HRL B,F ;SAVE POINTER TO NAME OF FUNCTION/ATOM + MOVEM B,FTABLE(TMAX) + MOVE C,LSTPTR ;SAVE ACCESS POINTER TO OBJECT + MOVEM C,FTABLE+1(TMAX) + ADDI TMAX,2 + HRLI B,440700 + PUSH P,B + PUSH P,F + PUSHJ P,GETSYL ;GET NAME OF FUNCTION/ATOM + POP P,C + POP P,D + SKIPE FROBSW + PUSHJ P,FROBCH + SKIPN LSTFLG + JRST GETNPR + SKIPE MMACRO + OASC [ASCIZ /INPUT MACRO /] + PUSHJ P,TYPPRT ;PRINT TYPE + OBPTR D ;AND NAME + OASCR [0] +GETNPR: ADDI B,1 + HRRM B,TBLTOP + SETOM WINNER ;MARK THAT WE HAVE WON +GETEND: POP P,F + POP P,D + POP P,C + POP P,B + POPJ P, + +GETNP2: MOVE B,[440700,,SYLBUF] + MOVEM F,LSTTYP + PUSHJ P,GETSYL ;GET NAME OF FUNCTION/ATOM AND + SETOM WINNER ;LEAVE IT IN SYLBUF + JRST GETEND + +FROBCH: PUSH P,A + PUSH P,B + MOVEM C,LSTTYP + MOVE A,D + MOVE B,[440700,,CMNBUF] + MOVEI 3 + IDPB CMNPTR + PUSHJ P,ATMLKP + JRST [POP P,B + JRST POPDAJ] + MOVE C,LSTTYP + PUSHJ P,TYPPRT + OBPTR A + OASC [ASCIZ / in file /] + SETZ D, + PUSHJ P,PFNAME + OASCR [ASCIZ /./] + SOSG CMNSAV + JRST [OASCR [ASCIZ /All present and accounted for./] + HALT +] + POP P,B + JRST POPDAJ + +;GETSYL RETURNS A SYLLABLE (ATOM) FROM THE DATA POINTED TO +;BY A AND PLACES THE SYLLABLE FOLLOWED BY ASCII 0 IN A LOCATION +;POINTED TO BY B + +GETSLF: SKIPA D,[-1] +GETSYL: SETZ D, + SETZM GETSW +GTNAM1: NXTCHR C + CAIN C,"; + PUSHJ P,SKPMAN + PUSHJ P,SEP + JRST GETSL1 + CAIN C,"" + JRST GETSL1 + CAIE C,"[ ; ALLOW OPEN BRACKETS TO WIN HERE + CAIN C,"{ + JRST GETSL1 + CAIE C,"( + CAIN C,"< + JRST GETSL1 + CAIN C,"> + JRST GETSLE + SETOM GETSW + IDPB C,B + JRST GTNAM1 + +GETSLE: JUMPN D,GETSL2 +GETSL1: SKIPN GETSW + JRST GTNAM1 +GETSL2: MOVEI F,0 + IDPB F,B + DBP A + POPJ P, + + +;GETTYP CHECKS WHETHER THE SYLLABLE IN SYLBUF MATCHES ANY +;OF THE KNOWN TYPES (DEFINE, SETG, ETC..) AND SKIP RETURNS +;IF IT DOES. THE CODE FOR THE MATCHING TYPE IS PLACED IN F. + +GETTYP: SETZM MSTGFL' + PUSH P,A + MOVEI A,GTYPE-2 + SETO F, +GETLP1: ADDI F,1 + CAIN F,MAXTYP + JRST POPAJ + ADDI A,2 + HRLI A,440700 + MOVE B,[440700,,SYLBUF] +GETLP2: ILDB C,A + ILDB D,B + CAME C,D + JRST GETLP1 + JUMPE D,GETLP3 + JRST GETLP2 + +GETLP3: POP P,A + SKIPE P3SW + JRST [MOVE B,[440700,,SYLBUF] + PUSHJ P,GETSYL + POPJ P,] + CAIN F,MSETG + JRST [SETOM MSTGFL + JRST MANHAK] + CAIG F,MXGTYP + JRST POPJ1 + CAIN F,MANIFEST + JRST MANHAK + SKIPE P2SW + POPJ P, + CAIN F,ENTRY + JRST ENTHAK + CAIN F,PACKAGE + JRST PAKHAK + CAIN F,RPACKAGE + JRST RPAKHK + CAIN F,ENDPACKAGE + JRST EPKHAK + POPJ P, + + +;PACKAGE AND ENTRY HACKERY + +;ENTRY STATEMENT + +ENTHAK: SKIPN PAKSW + POPJ P, + SKIPE MQUOTE + JRST [SKIPN SILENT + OASCR [ASCIZ /Quoted ENTRY statement ignored./] + POPJ P,] +ENTHK1: SETOM FUDGE' +ENTCHR: NXTCHR B + CAIN B,"; + PUSHJ P,SKPONE + CAIN B,"> + POPJ P, + CAIE B,15 + CAIN B,12 + SETZ B, + CAIE B,11 + CAIN B," + SETZ B, + IDPB B,ENTPTR + JRST ENTCHR + +MANHAK: SETOM FUDGE + SAFEIN B, + PUSHJ P,MANCHR + SAFEOUT B, + SKIPE P2SW + JRST MANHK2 + +MANHLP: HRRZ B,TBLTOP + HRLI B,MANIFEST + MOVE X,B + HRLI B,440700 + SAFEIN C, + PUSHJ P,GETSLF + SKIPN GETSW + JRST POPSJ + ADDI B,1 + HRRM B,TBLTOP + MOVEM X,FTABLE(TMAX) + SETOM FTABLE+1(TMAX) + ADDI TMAX,RECLEN + SKIPE MSTGFL + JRST MANHL1 + SUB P,[1,,1] + JRST MANHLP + +POPSJ: SUB P,[1,,1] + POPJ P, + +MANHL1: MOVEI F,SETG + SETZM FUDGE + SAFEOUT C, + JRST POPJ1 + +MANHK2: MOVE B,[440700,,SYLBUF] + SETZM FUDGE + PUSHJ P,GETSLF + SKIPN GETSW + POPJ P, + PUSH P,A + MOVE A,[440700,,SYLBUF] + MOVEI B,MANIFEST + PUSHJ P,MATCH + JRST [PUSHJ P,MNFOO + OASC [ASCIZ /New MANIFEST /] + OASCR SYLBUF + AOS CMNMAX + JRST .+1] + POP P,A + SKIPN MSTGFL + JRST MANHK2 + PUSH P,A + MOVE A,[440700,,SYLBUF] + MOVEI B,SETG + MOVEM B,LSTTYP + PUSHJ P,MATCH + JRST [OASC [ASCIZ /New GVAL /] + OASCR SYLBUF + JRST POPAJ] + POP P,A + SUB P,[1,,1] + SETOM WINNER + JRST GETEND + +MANCHR: SETZM MCHRFL' + SETZM MPADFL' +MANCHL: NXTCHR B + CAIN B,"; + PUSHJ P,SKPMAN + CAIN B,"> + JRST [SETZ B, + IDPB B,MANPTR + POPJ P,] + CAIE B,15 + CAIN B,12 + JRST MPAD + CAIE B,11 + CAIN B,40 + JRST MPAD + SETOM MCHRFL + SETZM MPADFL +MPUT: IDPB B,MANPTR + JRST MANCHL + +SKPMAN: MOVEI B,ATOMSK + MOVEM B,ACTIV + JRST SKPHAK + +MPAD: SKIPN MCHRFL + JRST MANCHL + SKIPE MPADFL + JRST MANCHL + SETOM MPADFL + SETZ B, + SKIPN MSTGFL + JRST MPUT + IDPB B,MANPTR + POPJ P, + +MNFOO: PUSH P,D + MOVEI D,NMNPAD + JRST MACHK1 +MACHAK: PUSH P,D + MOVEI D,MACPAD +MACHK1: PUSH P,A + PUSH P,B + PUSH P,C + JRST MANCIN + +MANCHK: PUSH P,D + PUSH P,A + PUSH P,B + PUSH P,C + MOVEI D,CMNPAD + MOVEI B,3 + IDPB B,MANPTR + MOVE B,[440700,,MANBUF] + PUSHJ P,ENTLIN + JRST MANOUT + SETOM CMNFLG +MANCIN: MOVE A,[440700,,SYLBUF] + MOVE C,CMNPTR +MANLP: ILDB B,A + IDPB B,CMNPTR + JUMPN B,MANLP + IDPB D,CMNPTR + AOS CMNMAX +MANOUT: POP P,C + POP P,B + POP P,A + POP P,D + POPJ P, + +;PACKAGE STATEMENT + +RPAKHK: SETOM RPAKSW +PAKHAK: SKIPE MQUOTE + JRST [SKIPN SILENT + OASCR [ASCIZ /Quoted PACKAGE statement ignored./] + POPJ P,] + SETOM PAKSW + PUSH P,A + MOVE B,[440700,,PAKBUF] + MOVEI C,"I + IDPB C,B + COMCHR "" +PAKHK1: ILDB C,A + CAIN C,"> + JRST PAKEND + PUSHJ P,SEP + JRST PAKHK1 + CAIN C,"" + JRST PAKHK1 + IDPB C,B + COMAC C, + JRST PAKHK1 + +PAKEND: COMCHR "" + COMCHR 40 + SKIPN RPAKSW + JRST PENDL1 + MOVE A,[440700,,[ASCIZ /!-RPACKAGE/]] +PENDLP: ILDB C,A + JUMPE C,PENDL1 + IDPB C,B + JRST PENDLP + +PENDL1: SETZ C, + IDPB C,B + JRST POPAJ + +;ENDPACKAGE ==> RESET POINTERS + +EPKHAK: SKIPE MQUOTE + JRST [SKIPN SILENT' + OASCR [ASCIZ /Quoted ENDPACKAGE statement ignored./] + POPJ P,] + MOVE ENTPTR,[440700,,ENTBUF] + SETZM PAKBUF + SETZM PAKSW + POPJ P, + + +;ENTRY LOOKUP FUNCTION. EXPECTS ITEM IN SYLBUF. +;SKIP RETURNS IF SUCCESSFUL + +ENTLKP: MOVEI B,3 + IDPB B,ENTPTR + MOVE B,[440700,,ENTBUF] +ENTLIN: MOVE A,[440700,,SYLBUF] + PUSH P,A +ENTL0: ILDB D,B + JUMPE D,.-1 + CAIN D,3 + JRST POPAJ + SKIPA A,(P) +ENTL1: ILDB D,B + ILDB C,A + CAME C,D + JRST ENTL2 + CAIE C,0 + JRST ENTL1 + ILDB C,B + SETOM MACFLG' + JUMPE C,.+2 + SETZM MACFLG + JRST POPAJ1 + +ENTL2: ILDB C,B + JUMPE C,ENTL0 + CAIE C,3 + JRST ENTL2 + JRST POPAJ + + +;MATCHING ROUTINE. A IS A BP TO ITEM TO BE SEARCHED FOR. B IS +;THE TYPE CODE OF THE ITEM. MATCH SKIPS IF THE ITEM IS FOUND AND +;RETURNS IN A THE CHECKSUM OF THE ITEM. THE SEARCH ENDS IF ANY +;TABLE ENTRY IS NOT GREATER THAN ZERO +;C,D, AND E ARE MUNGED + +MATCH: MOVEI X,FTABLE + PUSH P,A +MATCH0: SKIPG C,(X) + JRST [MOVE C,B + JRST POPAJ] ;LOST + HLRZ F,C + CAME F,B + JRST MATCH2 ;NOT OF SAME TYPE + HRLI C,440700 ;D IS BP TO TABLE ENTRY + MOVE A,(P) +MATCH1: ILDB D,C ;GET CHAR FROM TABLE ENTRY + ILDB E,A ;GET CHAR FROM SEARCH ITEM + CAME D,E + JRST MATCH2 ;NOT EQUAL ==> LOSE + CAIE E,0 ;BOTH 0 ==> WIN + JRST MATCH1 + POP P,A + MOVE A,2(X) ;MOVE CHECKSUM INTO A + MOVE C,B ;TYPE CODE + MOVSI B,400000 + IORB B,1(X) + JRST POPJ1 ;RETURN +MATCH2: ADDI X,RECLEN ;GO TO NEXT ENTRY + JRST MATCH0 + + +;GETSUM CREATES A CHECKSUM FOR THE MUDDLE OBJECT WHICH IS POINTED +;TO BY A BP IN A. CHECKSUM IS RETURNED IN B. +;C GETS CLOBBERED +;SKPONE SKIPS OVER ONE MUDDLE OBJECT + +SKPONE: MOVEI B,GETSM1 + MOVEM B,ACTIV + +SKPHAK: PUSH P,DEPTH ;SAVE THE CURRENT DEPTH + SETZM DEPTH ;INDICATE TOP LEVEL OBJECT + SETZM MQUOTE ;NO QUOTING + SETZM MMACRO + SETZ B, + SETOM SKIPPR ;SET SKIP FLAG + PUSHJ P,@ACTIV ;SKIP THE OBJECT + JFCL ;EOF. DONT WORRY + SETZM SKIPPR + POP P,DEPTH ;RESTORE THE DEPTH + POPJ P, ;AND RETURN + +;FLUSH TOP LEVEL STRINGS + +GETSTT: CAIN C,"" ; IGNORE STRINGS AT TOP LEVEL + JRST GETST1 + SKIPE STRSW + JRST GETST0 + CAIE C,"( + CAIN C,"{ + POPJ P, + CAIN C,"[ + POPJ P, + CAIN C,"' + JRST [SETOM MQUOTE + JRST GETST0] + CAIN C,"% + JRST [SETOM MMACRO + JRST GETST0] + CAIE C,"< + JRST [SUB P,[1,,1] + JRST @ACTIV] +GETST0: PUSHJ P,GTNAM + SETZM MQUOTE + SETZM MMACRO + SETZ B, + SKIPE FUDGE + MOVEI C,40 + SETZM FUDGE + POPJ P, + +GETST1: SETCMM STRSW + SUB P,[1,,1] + JRST @ACTIV + +;HERE TO DO THE CHECKSUMMING + +GETSUM: SETZM WINNER + MOVE CH,[-100.,,CPDL] + SETZM DEPTH + MOVEI X,GETSM1 + MOVEM X,ACTIV' + +;PUSHJ TO GETSM1 WITH CORRECT HACKS PERFORMED WILL SKIP OVER ONE +;OBJECT. SEE SKPONE. + +GETSM1: NXTCHR C + SKIPN STRSW + SKIPE SKIPPR + JRST GETSM3 + SKIPN DEPTH ;IF DEPTH=0, FIND NEXT OBJECT + PUSHJ P,GETSTT ;START? +GETSM3: SKIPE QUOTSW + JRST EXCLQU ;QUOTE SWITCH SET. CHECK FOR !"\\ + CAIN C,"\ + JRST QUOTER ;QUOTE ONE CHARACTER + CAIN C,"" + JRST STRING ;TOGGLE STRSW AND CHECK FOR !" + CAIN C,"! + JRST EXCL ;TOGGLE EXCLSW + SKIPE STRSW + JRST GETSM2 ;INSIDE STRING. IGNORE BRACKETS, ETC.. + XCT CHRTBL(C) +GETSM2: SKIPE SKIPPR + JRST SETSM5 + ROT B,7 ;ADD IN THE LUCKY CHARACTER + XOR B,C +SETSM5: SETZM QUOTSW ;CLEAR RANDOM ONCE ONLY SWITCHES + SETZM EXCLSW + SETZM SPACSW + JRST GETSM1 ;NEXT + +;COME HERE IF QUOTE SWITCH IS SET +;IF BOTH EXCL SWITCH IS SET AND CHAR IS \, GO TO QUOTER (E.G. !"\\) +;ELSE JUST SNARF ONE CHARACTER AND BE DONE WITH IT + +EXCLQU: CAIN C,"\ + SKIPN EXCLSW + JRST GETSM2 + SETZM EXCLSW + JRST QUOTER + + +;COME HERE IF CHARACTER IS A SEPARATOR. +;FIRST SEP GOES IN AS A SPACE. REST ARE IGNORED + +PAD: SKIPN SPACSW ;HACK SEPARATORS CORRECTLY + JRST [SETOM SPACSW + MOVEI C,40 + SKIPE SKIPPR + JRST .+3 + ROT B,7 ;ADD IN THE LUCKY CHARACTER + XOR B,C + SETZM QUOTSW + SETZM EXCLSW + JRST GETSM1] + JRST GETSM1 + +;HANDLE EXCL +;CHECKSUM THE EXCL AND SET EXCLSW IF NOT IN STRING + +EXCL: SKIPE SKIPPR + JRST .+3 + ROT B,7 ;ADD IN THE LUCKY CHARACTER + XOR B,C + SKIPE STRSW + JRST GETSM2 + SETOM EXCLSW + JRST GETSM1 + +;HANDLE STRINGAGE + +STRING: SKIPE EXCLSW + JRST QUOTER ;MUST BE !"X + SETCMM STRSW ;ELSE TOGGLE STRING MODE + SKIPE STRSW ;ENTERING STRING? + JRST GETSM2 ;YES. CONTINUE. + SKIPN DEPTH ;TOP LEVEL STRING? + JRST POPJ1 ;YES. FINIS. + JRST GETSM2 ;NO. CONTINUE + +;QUOTE A CHARACTER + +QUOTER: SKIPE SKIPPR + JRST .+3 + ROT B,7 ;ADD IN THE LUCKY CHARACTER + XOR B,C + SETOM QUOTSW + JRST GETSM1 + +;PUSH AN CLOSED BRACKET CORRESPONDING TO CHAR IN C ON THE CH STACK +;ALSO PUSH AN ACCESS POINTER TO THE CHAR IN CASE OF SYNTAX ERROR + +PUSHER: HRLZ D,ACCPTR + HRR D,A + PUSH CH,D + CAIN C,"< ;PUSH ONTO CH WHAT WE WANT BACK + PUSH CH,[">] + CAIN C,"[ + PUSH CH,["]] + CAIN C,"( + PUSH CH,[")] + CAIN C,"{ + PUSH CH,["}] + AOS DEPTH ;INCREMENT DEPTH + JRST GETSM2 + +;HERE IF CLOSED BRACKET ENCOUNTERED +;POP THE CH STACK AND COMPARE TO SEE IF WINNING + +POPPER: PUSH P,B + POP CH,B + POP CH,D ;GET LAST PUSHED CHARACTER + CAME B,C ;BETTER BE WHAT WE PUSHED + JRST SYNERR ;OH WELL, CANT WILL EM ALL + POP P,B + SOSLE DEPTH ;DECREMENT DEPTH + JRST GETSM2 + SKIPE SKIPPR + JRST .+3 + ROT B,7 ;ADD IN THE LUCKY CHARACTER + XOR B,C + JRST POPJ1 ;DONE ==> WIN + + +;NXTBLK READS IN THE NEXT 500 WORDS OF THE INPUT FILE, AND +;RETURNS IN A A BP TO THE TOP OF THE BLOCK + +NXTJCL: SKIPA A,[-500.,,JCLINB] +NXTBLK: MOVE A,[-500.,,INPBLK] + MOVE A + SKIPE ENDFLG + JRST EOFERR ;END OF FILE +IFN ITS,[ + .CALL DSKIOT + .LOSE 1000 ;WHY? + AOS ACCPTR + JUMPGE .+2 + SETOM ENDFLG + HRRZM BLKEND +] +IFE ITS,[ + PUSHJ P,XIOTI + A + SETOM ENDFLG + AOS ACCPTR +] + MOVE A,[350700,,INPBLK] + POPJ P, ;RETURN BP TO NEW BUFFER IN A + +LSTBLK: PUSH P,A + SOSGE A,ACCPTR + HALT ;HUH? + IMULI A,500. +IFN ITS,[ + .CALL DSKACC + .LOSE 1000 + MOVE [-500.,,INPBLK] + .CALL DSKIOT + .LOSE 1000 +] +IFE ITS,[ + PUSH P,B + MOVE B,A + MOVE A,DSKJFN + SFPTR + HALT ; HUH? + MOVE A,[-500.,,INPBLK] + PUSHJ P,XIOTI + A + JFCL +] + HRRZM BLKEND + SETZM ENDFLG + POP P,B + JRST POPAJ + + +;ERROR HANDLERS + +ILLCHR: OASC [ASCIZ /ILLEGAL CHARACTER IN FILE NAME/] + MOVEI B,EILLCH + JRST LOST + +EOFERR: SKIPN DEPTH + JRST WINEND + OASC [ASCIZ /SYNTAX ERROR - EOF INSTEAD OF /] + OASCI @(CH) + JRST SYNER1 + +SYNERR: OASC [ASCIZ /SYNTAX ERROR /] + OASCI (C) + OASC [ASCIZ / INSTEAD OF /] + OASCI (B) + OASC [ASCIZ / in /] + SKIPN CURCHN + JRST [SKIPN TMAX + JRST SYNLOS + HLRZ C,FTABLE-2(TMAX) + PUSHJ P,TYPPRT + MOVE C,FTABLE-2(TMAX) + OASC (C) + JRST SYNER1] + MOVE C,LSTTYP + SKIPN TMAX + JRST SYNLOS + PUSHJ P,TYPPRT + OASC SYLBUF +SYNER1: OASCR [ASCIZ /./] + PUSH P,D + MOVE D,CURCHN + PUSHJ P,PFNAME + OASC [ASCIZ / [LOC=/] + POP P,D ; PRINT RANGE OF LOSSAGE + HLRZ C,D + IMULI C,500. + ADDI C,(D) + SUBI C,INPBLK + IMULI C,5 + ODEC C + OASCI ", + MOVE C,ACCPTR + IMULI C,500. + ADDI C,(A) + SUBI C,INPBLK + IMULI C,5 + ODEC C + OASCI "] + SKIPE FJCLSW + JRST FSYNER + SKIPE CHKSW + JRST CHKLOS + OASC [ASCIZ /. +Comparison aborted./] + MOVEI B,ESYNER + JRST LOST + +CHKLOS: OASC [ASCIZ /. +Check aborted./] + JRST LOST + +SYNLOS: OASC [ASCIZ /What the hell is this file, FORTRAN?/] + HALT + +OPNFL: OASC [ASCIZ /Open of /] + PUSHJ P,PFNAME + OASC [ASCIZ / failed./] +OPNFL2: MOVEI B,EOPNFL + JRST LOST + +OPNFL1: OASC [ASCIZ /Open of the /] + OASC SNAME(D) + OASC [ASCIZ / directory failed./] + JRST OPNFL2 + + +;RANDOM CALL BLOCKS + +TTYOPN: SETZ + SIXBIT /OPEN/ + 5000,,4001 + MOVEI TYOC + SETZ [SIXBIT /TTY/] + +DSKOPN: SETZ + SIXBIT /OPEN/ + 5000,,2 + D + DEVICE(D) + FNAME1(D) + FNAME2(D) + SETZ SNAME(D) + +RCHST: SETZ + SIXBIT /RCHST/ + D + MOVEM DEVICE(D) + MOVEM FNAME1(D) + MOVEM FNAME2(D) + SETZM SNAME(D) + +DIROPN: SETZ + SIXBIT /OPEN/ + 5000,,6 + MOVEI DSKI + DEVICE(D) + [SIXBIT /.FILE./] + [SIXBIT /(DIR)/] + SETZ SNAME(D) + +DIRIOT: SETZ + SIXBIT /IOT/ + MOVEI DSKI + SETZ + +DSKACC: SETZ + SIXBIT /ACCESS/ + CURCHN + SETZ A + +DSKIOT: SETZ + SIXBIT /IOT/ + CURCHN + SETZ + + +;RANDOM UTILITY ROUTINES + +;SEP SKIP RETURNS IF THE CHARACTER IN C IS NOT A SEPARATOR + +SEP: CAIE C,40 + CAIN C,TAB + POPJ P, + CAIE C,CR + CAIN C,LF + POPJ P, + CAIN C,FF + POPJ P, + JRST POPJ1 + +;TYPPRT PRINTS AN OBJECT TYPE IN C. + +TYPPRT: IMULI C,2 + OASC PTYPE(C) + OASCI 40 + POPJ P, + + + +;CORE ALLOCATOR OF A SORT + +IBLOCK: ADD A,GCSTOP + EXCH A,GCSTOP + POPJ P, + +IFE ITS,[ + +; THIS IS CRETINOUS, BUT WHAT DO YOU EXPECT FROM DEC SOFTWARE? + +XHALT: HALTF + JRST XHALT + +; DO TWENEX IOTING +; IN (P) IS THE WORD WHICH ITS WOULD LIKE + +XIOTI: PUSH P,[SIN] + CAIA + PUSH P,[SOUT] +XIOT: 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) + HRRZM B,BLKEND + AOS BLKEND ;FUCK THIS + CAME C,(P) + AOS -2(P) + MOVE O,[XACS,,A] + BLT O,C + SUB P,[2,,2] + JRST POPJ1 + +XACS: BLOCK 3 +] + + +;ROUTINE TO PARSE FILE NAMES (FROM SHARER) + +FPARSS: SETZM ENDSW +FPARSE: SETZM NAME ;CLEAR NAME SLOT + SKIPE ENDSW + POPJ P, + MOVE F,[440600,,NAME] + +GETCHR: ILDB B,E ;FIND NEXT NON-EMPTY CHARACTER + CAIE B,0 + CAIN B,3 + JRST [SKIPN FJCLSW + POPJ P, + .CLOSE + SETZM FJCLSW + MOVE E,FJCLPT + JRST GETCHR] + CAIE B,40 + CAIN B,^I + JRST GETCHR + CAIN B,"[ + JRST [SETOM PRELOD + JRST GETCHR] + CAIN B,"( + JRST [PUSHJ P,ASKHAK + SETOM MANFLG + JRST GETCHR] + CAIN B,"{ + JRST [PUSHJ P,FROBOZ + JRST GETCHR] + CAIN B,"" + JRST [PUSHJ P,FILJCL + JRST GETCHR] + +FIELD: CAIN B,^J + POPJ P, + 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 DOES 0 AND + CAIN B,"" + JRST FNAM + CAIN B,", + JRST [SETOM ENDSW + JRST FNAM] + SKIPN COMSW + JRST [CAIE B,"_ + JRST FIELD1 + SETOM ENDSW + JRST FNAM] +FIELD1: CAIN B,": + JRST DEV ;DEVICE NAME + CAIE B,"} + CAIN B,"] + JRST [SETOM ENDSW + SETOM ENDBRK' + JRST FNAM] + CAIN B,"/ + JRST SWITCH + CAIN B,"; + JRST FDIR ;SNAME + CAIN B,^Q ;HANDLE QUOTING + ILDB B,E + CAIGE B,40 ;SUBI B,40 < 0 (BAD CHARACTER) + JRST ILLCHR + SUBI B,40 + CAIL B,100 + SUBI B,40 ;CASE CONVERSION + TLNE F,770000 ;IGNORE MORE THAN 6 CHARACTERS + IDPB B,F +FPARS2: ILDB B,E + JRST FIELD + +SWITCH: ILDB B,E + CAIN B,"T + SETOM TOTSW + CAIN B,"C + SETOM CHKSW + CAIN B,"M + SETOM MANFLG + CAIN B,"L + SETOM LSTFLG + JRST FPARS2 + +DEV: MOVE A,NAME ;SAVE DEVICE + MOVEM A,DEVICE(D) + JRST FPARSE + +FDIR: MOVE A,NAME ;SAVE SNAME + MOVEM A,SNAME(D) + JRST FPARSE + +FNAM: MOVE A,NAME + JUMPE A,FPARSE + SKIPE FNAME1(D) ;DOES HE HAVE AN FNAME1 ALREAD? + JRST FNAM1 ;YES - OOPS. HE IS GIVING TWO NAMES + MOVEM A,FNAME1(D) ;NO - TRY IT AS FNAME1 + JRST FPARSE + +FNAM1: MOVEM A,FNAME2(D) ;PUT NEW NAME INTO FNAME2 + JRST FPARSE + +; HERE TO HACK GROSS FIND'AGE IN LIST OF FILES + +FROBOZ: SETOM SILENT + MOVE CMNMAX + ADDI 1 + MOVEM CMNTOT' + MOVEM CMNSAV' +FROBCN: SKIPE ENDBRK + JRST FROBBD + SKIPE JCLPTR + MOVE E,JCLPTR + SETZ D, + MOVE A,[SIXBIT />/] + MOVEM A,FNAME2 + SETZM FNAME1 + PUSHJ P,FPARSS + PUSH P,E +IFN ITS,[ + PUSHJ P,FPHACK +] +IFE ITS,[ + OASC UNIMPL + HALT +] + POP P,JCLPTR + SKIPN FNAME1 + JRST FROBCN +IFN ITS,[ + .CALL DSKOPN + JRST FROBOF + .CALL RCHST + .LOSE 1000 +] + SETOM CHKSW + SETOM FROBSW' + JRST START2 + +FSYNER: SUB P,[1,,1] + OASCR [0] + JRST FROBCN + +FROBOF: OASC [ASCIZ /Open of /] + PUSHJ P,PFNAME + OASCR [ASCIZ / failed./] + JRST FROBCN + +FROBBD: OASC [ASCIZ /Found /] + MOVE A,CMNTOT + SUB A,CMNSAV + ODEC A + OASC [ASCIZ / out of /] + ODEC CMNTOT + OASCR [ASCIZ /./] + HALT + +; HERE TO READ JCL FROM A FILE + +FILJCL: SKIPE STRSW + JRST FILTRM + SETOM STRSW + MOVE [SIXBIT />/] + MOVEM FNAME2 + SETZM JCLPTR + PUSHJ P,FPARSS + CAIA +FILTRM: SUB P,[1,,1] ; FLUSH THIS PUSHJ TO FPARSS + MOVEM E,FJCLPT' + SETZ D, +IFN ITS,[ + .CALL DSKOPN + JRST FILOPF +] +IFE ITS,[ + OASC UNIMPL + HALT +] + PUSHJ P,NXTJCL + MOVE E,[440700,,JCLINB] + SETOM FJCLSW' + POPJ P, + +FILOPF: OASC [ASCIZ /Open of /] + PUSHJ P,PFNAME + OASCR [ASCIZ / failed./] + HALT + +; HERE TO GET ATOMS FROM JCL TO BE LOOKED FOR + +ASKHAK: SETZM MCHRFL + SETZM MPADFL + CAIA +ASKCLP: AOS CMNMAX + ILDB C,E + PUSHJ P,SEP + JRST ASKSEP + CAIE C,"{ + CAIN C,") + JRST ASKSP1 + CAIN C,"" + JRST ASKSP1 + SETOM MCHRFL + SETZM MPADFL + IDPB C,CMNPTR + JRST ASKCLP+1 + +ASKSEP: SKIPN MCHRFL + JRST ASKCLP+1 + SKIPE MPADFL + JRST ASKCLP+1 + SETOM MPADFL +ASKSP1: SETZ B, + IDPB B,CMNPTR + MOVEI B,ASKPAD + IDPB B,CMNPTR + CAIN C,") + POPJ P, + CAIE C,"{ + CAIN C,"" + CAIA + JRST ASKCLP + DBP E + POPJ P, + + +IFN ITS,[ +;HACK >-1 +;MOST OF THIS CODE FROM ARCDEV (I.E. FROM ITS) + +FPHACK: MOVE X,FNAME2(D) + MOVE A,FNAME1(D) + SETZ B, + SETZ C, + CAMN X,[SIXBIT /NBIN/] + JRST NHAIR +HAIR: TLNE X,770000 ;LEFT JUSTIFY + JRST HAIR1 + LSH X,6 + JRST HAIR +HAIR1: LDB F,[301400,,X] + CAMN F,[SIXBIT / <+/] + JRST HAIR2 + CAME F,[SIXBIT / >-/] + POPJ P, ;CAN'T HACK THIS + SETO C, + LSH X,6 +HAIR2: LSH X,6 ;GET RID OF CRUFT + LDB F,[360600,,X] + JUMPE F,HAIR3 + CAIL F,'0 ;GET THE ARGUMENT + CAILE F,'9 + JRST HAIR2 + IMULI B,10 + SUBI F,'0 + ADD B,F + JRST HAIR2 +HAIR3: SKIPE C + TLO B,400000 ;SET BIT + +;4.9 BIT IN B IS SET FOR > +;RH OF B IS ARGUMENT FOR THE SEARCH + +QLOOK: MOVE [-2000,,DIRPAG] + .CALL DIROPN + JRST OPNFL1 + .CALL DIRIOT + JRST LOST0 ;REPORT INTERNAL BUG + .CLOSE DSKI, +QLOOKR: MOVEI E,DIRPAG+2000-5 + PUSH P,D + PUSH P,[-1] ;BEST INDEX + PUSH P,[SETZ] ;BEST "NUMERIC" PART + PUSH P,[SETZ] ;BEST ALPHA PART +QLOOK4: CAIGE E,DIRPAG + JRST QLOOK2 + CAME A,UFN1(E) + JRST QLOOK3 + SKIPE X,UFN2(E) +QLOOK6: TRNE X,77 + JRST QLOOK5 + LSH X,-6 + JRST QLOOK6 +QLOOK5: MOVEI F,0 +QLOOK8: LDB D,[600,,X] + CAIL D,'0 + CAILE D,'9 + JRST QLOOK7 ;NOT A DIGIT +QLOK5B: TRNE F,77 ;RIGHT ADJ LOW NON NUM PART + JRST QLOK5A + LSH F,-6 + JUMPN F,QLOK5B +QLOK5A: TLC X,400000 ;AVOID CAM LOSSAGE + TLC F,400000 + SKIPGE -2(P) + JRST QLOK5D ;FIRST MATCH + JUMPGE B,QLOK5E ;GET LEAST + CAMGE X,-1(P) ;GET GREATEST + JRST QLOOK3 + CAME X,-1(P) + JRST QLOK5D + CAMGE F,(P) + JRST QLOOK3 ;NOT AS GOOD +QLOK5D: HRRZM E,-2(P) + MOVEM X,-1(P) + MOVEM F,(P) +QLOOK3: SUBI E,LUNBLK + JRST QLOOK4 + + +QLOK5E: CAMLE X,-1(P) + JRST QLOOK3 + CAME X,-1(P) + JRST QLOK5D + CAMLE F,(P) + JRST QLOOK3 + JRST QLOK5D + +QLOOK7: LSHC X,-6 ;LOW DIGIT NOT NUMERIC + JUMPN X,QLOOK8 ;NO NUMERIC DIGITS AT ALL ("BIN", MAYBE?) + JUMPL B,QLOK5B ;IF LOOKING FOR GREATEST, LET THIS BE LEAST + MOVNI X,1 ;GREATEST IF LOOKING FOR LEAST + JRST QLOK5B + +QLOOK2: SUB P,[1,,1] + POP P,C ;BEST "NUMERIC" PART + POP P,E ;ADR + JUMPL E,[POP P,D + POPJ P,] + HRRZ D,B + SOJL D,QFINIS ;KEEP GOING UNTIL REQUEST IS SATISFIED + POP P,D + SOJ B, + MOVE F,[SIXBIT /!!!!!!/] + MOVEM F,UFN1(E) ;MUNGE THE DIRECTORY + JRST QLOOKR ;START OVER + +QFINIS: POP P,D ;DONE! + MOVE B,UFN2(E) + MOVEM B,FNAME2(D) + POPJ P, + +;HERE TO HACK THE NBIN'AGE + +NHAIR: .CALL DIROPN + JRST OPNFL1 + MOVE [-2000,,DIRPAG] + .CALL DIRIOT + JRST LOST0 + PUSH P,D + SETZ C, + MOVEI E,DIRPAG+2000-5 +NBNFND: CAIGE E,DIRPAG + JRST NONBIN + MOVE X,UFN2(E) + CAMN A,UFN1(E) + CAME X,[SIXBIT /NBIN/] + JRST NBNNXT + MOVE B,UNDATE(E) + SETZ D, + .CALL DIROPN ; OPEN THE CORRECT DIRECTORY + JRST OPNFL1 + MOVE [-2000,,DIRPAG] + .CALL DIRIOT + JRST LOST0 + MOVEI E,DIRPAG+2000-5 +NLOOP: CAIGE E,DIRPAG + JRST NDONE + CAME A,UFN1(E) + JRST NLNXT + SKIPE X,UFN2(E) +NLOOP1: TRNE X,77 ;RIGHT JUSTIFY NAME + JRST NLOOP2 + LSH X,-6 + JRST NLOOP1 +NLOOP2: LDB D,[600,,X] ;MAKE SURE NAME ENDS IN NUMERIC + CAIL D,'0 + CAILE D,'9 + JRST NLNXT +NLOOP3: CAMLE B,UNDATE(E) ;COMPARE CREATION DATES + CAML C,UNDATE(E) + JRST NLNXT + MOVE C,UNDATE(E) + MOVE F,UFN2(E) + JRST NLNXT + +NDONE: JUMPL C,NBNLOS + POP P,D + MOVEM F,FNAME2(D) + MOVE F,SNAME + MOVEM F,SNAME(D) + POPJ P, + +NONBIN: OASC [ASCIZ /No NBIN file found./] + JRST OPNFL2 + +NLNXT: SUBI E,LUNBLK + JRST NLOOP + +NBNNXT: SUBI E,LUNBLK + JRST NBNFND + +] + +NBNLOS: OASC [ASCIZ /No file created before NBIN./] + JRST OPNFL2 + + +;PRINT A FILE NAME. CHANNEL NUMBER IS IN D + +IFN ITS,[ +PFNAME: OSIX DEVICE(D) + OASCI ": + OSIX SNAME(D) + OASCI "; + OSIX FNAME1(D) + OASCI " + OSIX FNAME2(D) + POPJ P, +] +IFE ITS,[ +PFNAME: MOVE A,F1BLK(D) + MOVE B,(A) + OASC (B) + OASCI ": + OASCI "< + MOVE B,1(A) + OASC (B) + OASCI "> + MOVE B,2(A) + OASC (B) + OASCI ". + MOVE B,3(A) + OASC (B) + OASCI ". + MOVE B,4(A) + OASC (B) + POPJ P, +] + +; TYPEOUT UUOS (STRAIGHT FROM DIRED, WITH SOME HELP FROM PDL) + +ZZZ==. + LOC 40 + 0 + JSR UUOH + LOC ZZZ +UUOCT==0 +UUOTAB: JRST ILUUO + IRPS X,,[ODEC OBPTR OHPOS OCTLP OALIGN OSIX OASC OASCI OASCR OSIXS] + 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 + +IFN ITS,[ +ILUUO: .VALUE [ASCIZ /:ILLEGAL UUO/] +] +IFE ITS,[ +ILUUO: HALT +] +UOBPTR: MOVEI C,0 + MOVE B,UUOD + JRST UOASC1 +UOASCR: SKIPA C,[^M] ; CR FOR END OF TYPE +UOASC: MOVEI C,0 ; NO CR + HRLI B,440700 ; MAKE ASCII POINTER +UOASC1: ILDB A,B ; GET CHAR + JUMPE A,.+3 ; FINISH? + PUSHJ P,IOTA + JRST .-3 ; AND GET ANOTHER + SKIPN A,C ; GET SAVED CR? + JRST UUORET + PUSHJ P,IOTA + MOVEI A,^J + PUSHJ P,IOTA + JRST UUORET + +UOASCC: HRLI B,440700 ; MAKE ASCII POINTER +UOAS1C: ILDB A,B ; GET CHAR + CAIN A,^C + JRST UUORET + PUSHJ P,IOTA + JRST UOAS1C ; AND GET ANOTHER + +UOCTLP: MOVEI A,^P + PUSHJ P,IOTA1 + +UOASCI: MOVE A,B ; PRT ASCII IMMEDIATE + PUSHJ P,IOTA + JRST UUORET + +UOSIX: MOVE B,UUOD +USXOOP: JUMPE B,UUORET + LDB A,[360600,,B] + ADDI A,40 + PUSHJ P,IOTA + LSH B,6 + JRST USXOOP + +UOSIXS: MOVE A,[440600,,UUOD] +USLOOP: ILDB C,A + ADDI C,40 + PUSHJ P,IOTC + TLNE A,770000 + JRST USLOOP + JRST UUORET + +UOHPOS: SUB B,HPOS + JUMPLE B,UOASCI +UOHPO1: MOVEI A,40 + PUSHJ P,IOTA + SOJG B,UOHPO1 + JRST UUORET + +POWER: 0 ? 1 ? 10. ? 100. ? 1000. ? 10000. ? 100000. ? 1000000. + +UOALIG: MOVE D,UUOD + ANDI A,7 + MOVE A,POWER(A) + MOVEI C,40 +UOALI1: CAMLE A,D + PUSHJ P,IOTC + IDIVI A,10. + CAIE A,1 + JRST UOALI1 + SETZ A, + +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 + HRREI A,-1 ; A=DIGIT COUNT + PUSHJ P,UONUM ; PRINT NUMBR + JRST UUORET + +UONUM: IDIV B,BASE + HRLM C,(P) ; SAVE DIGIT + SOJE A,UONUM1 ; DONE IF 0 + SKIPG A ; + => MORE + SKIPE B ; - => B=0 => DONE + PUSHJ P,UONUM ; ELSE MORE +UONUM1: HLRZ C,(P) ; RETREIVE DIGITS + ADDI C,"0 ; MAKE TO ASCII + CAILE C,"9 ; IS IT GOOD DIG + ADDI C,"A-"9-1 ; MAKE HEX DIGIT + PUSHJ P,IOTC + POPJ P, ; RET + +IOTC: PUSH P,A + MOVE A,C + PUSHJ P,IOTA + JRST POPAJ + +IOTA: CAIN A,^P + JRST IOTAP +IOTA1: +IFN ITS,[ + CAIN A,^J + POPJ P, + .IOT TYOC,A +] +IFE ITS,[ + PBOUT +] + CAIN A,^I + JRST [MOVE A,HPOS + ADDI A,10 + ANDI A,7770 + MOVEM A,HPOS + POPJ P,] + AOS HPOS + CAIE A,^M + POPJ P, + SETZM HPOS + POPJ P, +IOTAP: +IFN ITS,[ + .IOT TYOC,["^] + ADDI A,100 + JRST IOTA1 +] +IFE ITS,[ + POPJ P, +] + +POPAJ: POP P,A + POPJ P, + +IFN ITS,[ +COMBAT: SETOM COMSW + JUMPL A,COMTTO + .CALL [SETZ + SIXBIT /OPEN/ + 5000,,1 + MOVEI TYOC + SETZ [SIXBIT /NUL/]] + JRST LOST0 + JRST STARTX +COMTTO: .CALL TTYOPN + .VALUE + .CALL [SETZ + SIXBIT /TTYGET/ + MOVEI TYOC + MOVEM A + MOVEM B + SETZM C] + .LOSE 1000 + TLO C,%TSMOR + .CALL [SETZ + SIXBIT /TTYSET/ + MOVEI TYOC + A + B + SETZ C] + .LOSE 1000 + .BREAK 16,100000 + JRST STARTX +] + +LOST0: MOVEI B,EINTER +LOST: SKIPE COMSW + MOVE A,B + HALT + + +; DISGUSTITUDE, R.E. MANIFESTS, ETC. + +INATOM: 0 + +ATOM: SETZM WINNER + SETZM DEPTH + MOVEI ATOM1 + MOVEM ACTIV +ATOMSK: MOVE CH,[440700,,WRDBUF] +ATOM1: NXTCHR C + SKIPE SKIPPR + JRST ATOM3 + SETOM FUDGE ;TAA 5/31/78 OTHERWISE GOT DEPTH COUNT OFF + SKIPN DEPTH + PUSHJ P,GETSTT +ATOM3: SKIPE QUOTSW + JRST AEXCLQ ;QUOTE SWITCH SET. CHECK FOR !"\\ + CAIN C,"\ + JRST AQUOTE ;QUOTE ONE CHARACTER + CAIN C,"" + JRST ASTRIN ;TOGGLE STRSW AND CHECK FOR !" + CAIN C,"! + JRST AEXCL ;TOGGLE EXCLSW + SKIPE STRSW + JRST ATOM2 ;INSIDE STRING. IGNORE BRACKETS, ETC.. + CAILE C,40 + JRST ABRACK + CAIE C,40 ;SEP ROUTINE INCLUDED HERE FOR SPEED + CAIN C,TAB + JRST APAD + CAIE C,CR + CAIN C,LF + JRST APAD + CAIN C,FF + JRST APAD +ABRACK: CAIE C,"< ;DO THE RIGHT THING WITH BRACKETS + CAIN C,"( + JRST APUSH + CAIE C,"[ + CAIN C,"{ + JRST APUSH + CAIE C,") + CAIN C,"} + JRST APOP + CAIE C,"> + CAIN C,"] + JRST APOP + CAIN C,"' + JRST APAD + CAIN C,54 + JRST NOATM + CAIE C,"# + CAIN C,". + JRST NOATM +ATMCHR: SETOM INATOM + IDPB C,CH +ATOM2: SETZM QUOTSW ;CLEAR RANDOM ONCE ONLY SWITCHES + SETZM EXCLSW + SETZM SPACSW + JRST ATOM1 ;NEXT + +NOATM: SKIPE INATOM + JRST ATMCHR + JRST ATOM2 + +APUSH: AOS DEPTH + JRST APAD + +APOP: SOSLE DEPTH + JRST APAD + JRST POPJ1 + +AEXCLQ: CAIN C,"\ + SKIPN EXCLSW + JRST ATOM2 + SETZM EXCLSW + JRST AQUOTE + +;COME HERE IF CHARACTER IS A SEPARATOR. + +APAD: SKIPE SPACSW ;HACK SEPARATORS CORRECTLY + JRST ATOM1 + SETOM SPACSW + SKIPE INATOM + PUSHJ P,ATMHAK +APAD1: SETZM INATOM + SETZM QUOTSW + SETZM EXCLSW + JRST ATOM1 + +ATMHAK: PUSH P,A + SETZ B, + IDPB B,CH + MOVE B,[440700,,CMNBUF] + MOVE A,[440700,,WRDBUF] + MOVE CH,A + SKIPN WRDBUF + JRST POPAJ + MOVEI C,3 + IDPB C,CMNPTR + PUSHJ P,ATMLKP + JRST POPDAJ + MOVE C,LSTTYP + CAILE C,1 + JRST POPDAJ + MOVE A,OBJCNT + CAMN A,OBJSAV' + JRST POPDAJ + PUSH P,D + PUSHJ P,CHGOBJ + MOVEM A,OBJSAV + POP P,C + CAIN C,NMNPAD + MOVEI A,[ASCIZ / [New MANIFEST = /] + CAIN C,MACPAD + MOVEI A,[ASCIZ / [Changed MACRO = /] + CAIN C,CMNPAD + MOVEI A,[ASCIZ / [Changed MANIFEST = /] + CAIN C,ASKPAD + MOVEI A,[ASCIZ / [Requested ATOM = /] + OASC (A) + OASC WRDBUF + OASCR [ASCIZ /]/] + JRST POPDAJ + +POPDAJ: DBP CMNPTR + JRST POPAJ + +; LOOKUP ROUTINE FOR CHANGED MANIFESTS/MACROS +; SIMILAR TO ENTLKP EXCEPT FOR PAD CODES + +ATMLKP: PUSH P,A + ILDB C,A + JUMPE C,POPAJ +ATMLP: ILDB D,B + CAIN D,3 + JRST POPAJ + SKIPA A,(P) +ATMLP1: ILDB D,B + ILDB C,A + CAME C,D + JRST ATMLP2 + JUMPN C,ATMLP1 + ILDB D,B +POPAJ1: POP P,A +POPJ1: AOS (P) +CPOPJ: POPJ P, + +ATMLP2: ILDB C,B + CAIN C,3 + JRST POPAJ + JUMPN C,ATMLP2 + ILDB C,B + JRST ATMLP + +WRDBUF: BLOCK 10. + +;HANDLE EXCL + +AEXCL: SKIPE STRSW + JRST ATOM2 + SETOM EXCLSW + JRST ATOM1 + +;HANDLE STRINGAGE + +ASTRIN: SKIPE EXCLSW + JRST AQUOTE ;MUST BE !"X + SETCMM STRSW ;ELSE TOGGLE STRING MODE + JRST ATOM2 ;NO. CONTINUE + +;QUOTE A CHARACTER + +AQUOTE: SETOM QUOTSW + JRST ATOM1 + + END START \ No newline at end of file diff --git a//muddleboot.mid.5 b//muddleboot.mid.5 new file mode 100644 index 0000000..fdd5b03 --- /dev/null +++ b//muddleboot.mid.5 @@ -0,0 +1,60 @@ +TITLE SUBSYS -- Tops-20 Muddle Subsystem Bootstrapper + + .DECSAV + +IF1,[ PRINTC /Type in Muddle version: / + .TTYMAC A + DEFINE MUDNAM + ASCIZ /PS:MDL!A!.EXE/ + TERMIN + TERMIN +] + + O=0 + A=1 + B=2 + C=3 + D=4 + E=5 + + LOC 140 + +START: TDZA 17,17 + MOVEI 17,1 + MOVSI A,(GJ%OLD\GJ%SHT) + HRROI B,[MUDNAM] + GTJFN + JRST NOMDL + HRLI A,400000 + MOVE BLTPTR,[LOADGO,,B] + BLT BLTPTR,BLTPTR + JRST B + +LOADGO: GET ; LOAD INTERPRETER + MOVEI A,400000 + GEVEC ; CONS STARTING ADDRESS + ADD B,17 + MOVEI 17,0 + JRST (B) ; JRST TO START+1 IN INTERPRETER + +BLTPTR=.-LOADGO+1 + + + +NOMDL: MOVE B,A + HRROI A,[ASCIZ /No Muddle Interpreter? (/] + PSOUT + HRROI A,[MUDNAM] + PSOUT + HRROI A,[ASCIZ /): /] + PSOUT + HRRZI A,-1 + HRLI B,400000 + MOVEI C,0 + ERSTR ; PRINT ERROR + HALTF ;UNDEFINED ERROR. + HALTF ;CHOMPING DEST. + HALTF ;WON. + JRST .-1 + + END START diff --git a//mudsub.mid.2 b//mudsub.mid.2 new file mode 100644 index 0000000..6e5e66b --- /dev/null +++ b//mudsub.mid.2 @@ -0,0 +1,146 @@ +TITLE SUBSYS -- Tops-20 Muddle Subsystem Bootstrapper + + .DECSAV + + O=0 + A=1 + B=2 + C=3 + D=4 + E=5 + + LOC 140 + +GTJFNB: 100000,,0 + .NULIO,,.NULIO + 0 + 0 +JOBPTR: 440700,,JOBNAM + -1,,[ASCIZ /SAVE/] + 0 + 0 + 0 + +SVNSAV: 0 +JOBNAM: ASCIZ /MUDDLE/ + +START: RESET + SETZ A, + RSCAN + JFCL + JUMPE A,NOJCL ; NO JCL, FLUSH + MOVN C,A + MOVEI A,.PRIIN + MOVE B,[440700,,SAVFIL] + SIN ; READ JCL + + MOVE B,[440700,,SAVFIL] + MOVE D,JOBPTR +NAMLOP: ILDB B + CAIG 40 + JRST NAMDON + IDPB O,D + JRST NAMLOP + +NAMDON: MOVEI O,0 + IDPB O,D + MOVEM B,SVNSAV + ILDB O,B + CAIL O,40 + JRST .-2 + MOVEI O,0 + DPB O,B + MOVE A,JOBNAM + CAME A,[ASCII /MUDSU/] + JRST OTHER + MOVE A,[ASCII /MUDDL/] + MOVEM A,JOBNAM + MOVE A,[ASCIZ /E/] + MOVEM A,JOBNAM+1 +OTHER: MOVEI A,GTJFNB + MOVE B,SVNSAV + GTJFN + JRST NOSAVE + MOVEI 0,(A) ;JFN TO SAVE FILE + TLZ A,-1 + MOVE B,[440000,,240000] + OPENF ; HAS TO BE OPEN + JRST NOSAV1 + BIN + MOVE D,B +; set access back to beginning + MOVEI B,0 + SFPTR + HALTF +; create muddle version number + MOVE B,[440700,,FILE] + MOVE C,[440700,,D] + ILDB E,B + CAIE E,"X ; "X" SIGNALS START OF VERSION NUMBER + JRST .-2 +VERLUP: ILDB E,C + CAIN E,40 ; SPACE SIGNALS END OF VERSION + JRST RDMDL + DPB E,B + IBP B + JRST VERLUP + +; now try to read it +RDMDL: HRLZI A,100001 + MOVE B,[440700,,FILE] + GTJFN ; JFN TO INTERPRETER + JRST NOMDL + HRLI A,400000 + MOVE BLTPTR,[LOADGO,,B] + BLT BLTPTR,BLTPTR + JRST B + +LOADGO: GET ; LOAD INTERPRETER + MOVEI A,400000 + GEVEC ; CONS STARTING ADDRESS + JRST 1(B) ; JRST TO START+1 IN INTERPRETER + +BLTPTR=.-LOADGO+1 + + +; junk past here is only used if there are errors +NOJCL: HRROI A,[ASCIZ /You must specify the SAVE file to load. +/] + PSOUT +DEATH: HALTF + JRST .-1 + +NOSAVE: MOVE B,A + HRROI A,[ASCIZ /Can't find SAVE file? (/] + PSOUT + MOVE A,SVNSAV +NOFILE: PSOUT + HRROI A,[ASCIZ /): /] + PSOUT + JRST ERPRNT + +NOSAV1: MOVE B,A + HRROI A,[ASCIZ /Can't OPENF SAVE file? (/] + PSOUT + HRROI A,SAVFIL + JRST NOFILE + +NOMDL: MOVE B,A + HRROI A,[ASCIZ /No Muddle Interpreter? (/] + PSOUT + HRROI A,FILE + JRST NOFILE + +ERPRNT: HRRZI A,-1 + HRLI B,400000 + MOVEI C,0 + ERSTR ; PRINT ERROR + HALTF ;UNDEFINED ERROR. + HALTF ;CHOMPING DEST. + HALTF ;WON. + JRST DEATH + +FILE: ASCIZ /PS:MDLXXX.EXE/ +SAVFIL: BLOCK 20. + + END START diff --git a/README.md b/README.md index 27e1c61..1544643 100644 --- a/README.md +++ b/README.md @@ -5,6 +5,8 @@ There should also be support for ITS, but it won't build as is. `` contains a TOPS-20 Muddle compiler from around 1982. +`` contains a few progams in the Muddle ecosystem. + `MUDDLE` contains Muddle for ITS, from around 1973. `mim` contains Machine-Independent MDL for TOPS-20 and VAX.