; ******* 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