github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-03-03 10:22:59 +00:00
Code Issues Releases Wiki Activity
Files
5579a461eb12f3eb549162122304d4794d5fe2f5
PDP-10.its/src/sysen3/combat.151
Lars Brinkhoff 47d27f5f3c COMBAT - submit jobs to the Muddle compiler.
2018-11-17 08:03:55 +01:00

6277 lines
132 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
; ******* 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 /<filename1>/]
SKIPE SSSPPP
MOVEI C,[ASCIZ /<filename2>/]
OASC (C)
JRST .+2]
OASC (C)
MOVE E,1(A) ; NEXT NAME
MOVE E,(E) ; GET ASCII
CAMN E,[ASCIZ /0/]
JRST NFNMDN ; DON'T PRINT .0!
SKIPN 1(A)
JRST NFNMDN
OASC (D)
ADDI D,1
AOBJN A,NFNMLP
NFNMDN: POP P,D
POP P,C
POPJ P,
IFN ITS,[
CHRTBL: ASCIZ /:/
ASCIZ /;/
ASCIZ / /
ASCIZ /?/
ASCIZ /?/
]
IFE ITS,[
CHRTBL: ASCIZ /:</
ASCIZ />/
ASCIZ /./
ASCIZ /./
ASCIZ /;/
]
; PRINT OUT A FORM IFF THE GIVEN SWITCH IS T (NEW COMPILER, MAINLY)
FORM: JUMPE B,CPOPJ
OASC (D)
AOBJN A,PRTOUT
; PRINT OUT A STRING, NOT SURROUNDED BY QUOTES (PACKAGE MODE, ETC.)
STRING: JUMPE B,CPOPJ
OASC (D)
OASC (B)
AOBJN A,PRTOUT
;PRINT OUT REDO LIST: APPENDS LIST FROM COMPARE, LIST FROM REDO
OTREDO: JUMPE B,RREDO ; ANYTHING FROM COMPARE?
OASC (D) ; YES, PRINT '<SET REDO!- (
MOVSI F,440700 ; CONS UP BYTE POINTER
HRR F,B
OTLOOP: ILDB F ; FLUSH LEADING BLANKS
CAIN 0,"
JRST OTLOOP
ADD F,[70000,,] ; DECREMENT THE POINTER--JUST FOUND NON-BLANK
TLNE F,400000
ADD F,[347777,,-1]
OBPTR F ; PRINT LIST
SETOM DOEND ; SAYS THAT NEED TO PRINT ')>' EVEN IF NOTHING
; IN USER-SUPPLIED REDO LIST
RREDO: HLRZ B,1(A)
ADD B,OUTPTR
ADDI B,3
HRRZ B,(B)
JUMPE B,[SKIPN DOEND ; NOTHING IN USER-SUPPLIED LIST. COMPARE LIST?
POPJ P, ; NO, SO LEAVE IMMEDIATE
JRST LDO]
SKIPN DOEND
OASC (D)
OASC (B)
LDO: SETZM DOEND
AOBJN A,PRTOUT
; OUTPUT <SNAME "FOO"> FROM PSNAME
OSNAME: SKIPN PSNAME
AOBJN A,POPJ1 ; FLUSH COMPLETELY
OASC (D) ; PRINT <SNAME "
TRNN B,-1 ; 0?
JRST OSNAM1 ; YES, SO USE PSNAME
OASC (B) ; PRINT SNAME
AOBJN A,PRTOUT ; AND GO CLEAN UP
OSNAM1: PUSH P,C
MOVE C,PSNAME
OASC (C)
POP P,C
OSNAMO: AOBJN A,PRTOUT
SUBTTL TAILORING
; PUSHJ P,LDTAIL
; COME HERE TO READ A TAILOR FILE INTO NCOMBAT
A; ALWAYS RETURNS WITHOUT SKIPPING
IFN ITS,[
TALOPI: SETZ
SIXBIT /OPEN/
MOVSI .BII
MOVEI DSKCHN
TALDEV
TALFN1
TALFN2
SETZ TALSNM
TALOPO: SETZ
SIXBIT /OPEN/
MOVSI .BIO
MOVEI DSKCHN
TALDEV
TALFN1
TALFN2
SETZ TLSNAM
]
; PUSHJ P,MKTAIL
; A = POINTER TO START OF TAILOR BLOCK
; INITIALIZES BLOCK TO %IGNOR+<QUESTION ID>,,0
MKTAIL: PUSH P,F
MOVEI QOFF,0 ; INITIALIZE QOFF
MKTLP: LDB F,[220600,,QTABLE(QOFF)]
TRO F,%IGNOR
HRLZM F,(A)
AOJ A,
AOJ QOFF,
SKIPE QTABLE(QOFF)
JRST MKTLP
MOVSI F,%IGNOR+CRETQ ; FINISH INITIALIZING, ALL TO CRETQ
MOVEM F,(A)
HRLZ F,A
HRRI F,1(A)
MOVE A,-2(P)
BLT F,MORLOC-1(A)
POP P,F
POPJ P,
; PUSHJ P,LDTAIL
; LOADS TAILOR FILE
LDTAIL:
IFN ITS,[
.CALL TALOPI
]
IFE ITS,[
MOVEI A,XTALNM
SETZ B,
GTJFN
]
JRST [SKIPN ERRFLG
POPJ P,
PUSH P,[OPNFAL]
JRST ERRPRT]
IFE ITS,[
MOVEM A,DSKJFN'
MOVE B,[440000,,OF%RD]
OPENF
JRST [OASCR [ASCIZ /Open of TAILOR failed?/]
HALTF]
]
SKIPE LDFLAG
PUSHJ P,NAMMAK ; CONS STRING AND LENGTH FOR NAMUNQ
SETOM UTPSAV
IFN ITS,[
LDLOOP: MOVE C,[-2,,D]
.IOT DSKCHN,C ; GET THE FIRST WORDS IN D AND E
]
IFE ITS,[
LDLOOP: MOVE C,[-2,,XCHOMP']
PUSHJ P,XIOTI
C
JRST LDOUT
MOVE D,XCHOMP
MOVE E,XCHOMP+1
JRST LDLOP0
]
JUMPL C,LDOUT
JUMPE D,LDOUT
LDLOP0: SKIPGE UTPSAV
JRST [HLRE A,UTYPLN
MOVNS A
HRLS A
MOVEM A,UTPSAV
JRST .+1] ; SAVE <#TYPES>,,<#TYPES> FOR HACKING LINKS
SETZM PR2SW
TLZN D,%NWFMT
IFN ITS,[
SETOM ITSFXF
]
IFE ITS,[
JFCL
] TLZE D,%TVERB
SETOM PR2SW
SETZM NMORAS
TLZE D,%NMRAS ; SKIPS IF SAID 'ASK'
SETOM NMORAS
SETZM FILEXI
TLZE D,%TFNEX
SETOM FILEXI
SETOM MORANS
TLZN D,%MRANS ; SKIPS IF ANSWER 'YES'
SETZM MORANS
SETZM MUDVRB
TLZN D,%MNVRB
SETOM MUDVRB
LDB F,[220600,,D] ; GET THE VERSION NUMBER
CAME F,QVERS
SETOM UPTFLG ; MUST DO AN UPDATE
TLZ D,777777 ; FLUSH LEFT HALF
MOVE A,D
PUSHJ P,IBLOCK ; GET WORDS FOR NAME
PUSH P,A ; SAVE THE LOCATION OF THE NAME
MOVN B,D ; MAKE AOBJN POINTER TO BLOCK
MOVSS B
HRR B,A
IFN ITS,[
.IOT DSKCHN,B ; IOT IN THE NAME
]
IFE ITS,[
PUSHJ P,XIOTI
B
JFCL
]
SKIPE LDFLAG ; ARE WE DOING A LOAD TAILOR?
PUSHJ P,NAMUNQ ; MAKE NAME UNIQUE
MOVE A,E
PUSHJ P,IBLOCK ; GET WORDS FOR BLOCK
ADDI A,LNALEN ; POINT PAST LINK AREA
PUSH P,A ; SAVE THE LOCATION OF BLOCK
MOVN B,E
MOVSS B
HRRI B,-LNALEN(A) ; START IOT AT BEGINNING OF LINK AREA
IFN ITS,[
.IOT DSKCHN,B ; IOT IN THE BLOCK
]
IFE ITS,[
PUSHJ P,XIOTI
B
JFCL
]
MOVE C,A
MOVSI QOFF,QNUM ; AOBJN POINTER TO QUESTION BLOCK
MOVE CMPBLK,QOFF ; SET UP SAME POINTER FOR FIXUP HACKING
LDLOP1: SKIPE UPTFLG
JRST UPTAIL
MOVE B,QTABLE(QOFF) ; GET SLOT FOR THIS QUESTION
TLNE B,$TSYMBOL
JRST LDEND1
HRRZ B,(C) ; GET THE RH OF THE FROBNITZ
JUMPE B,LDEND1 ; EMPTY. FINISH
ADDM A,(C) ; UPDATE THE POINTER
MOVE B,QTABLE(QOFF)
TLNE B,$TFILE
PUSHJ P,LDFILE
LDEND1: AOS C
AOBJN QOFF,LDLOP1
LDEND2: JSP RET,NEWTYP
JRST LDLOOP
LDOUT:
IFN ITS,[
.CLOSE DSKCHN,
]
IFE ITS,[
MOVE A,DSKJFN
CLOSF
JFCL
]
SKIPGE A,UTPSAV
JRST LDOUT1
; FIX UP LINK POINTERS: STORED IN SAVE FILE AS (0-BASED) OFFSETS
; INTO NEW SECTION OF USER TYPE TABLE
ADD A,UTYPLN ; GET AOBJN POINTER TO NEW TYPES
MOVE B,A ; IN TWO PLACES
PUSH P,A
LDLN1: MOVE C,(B) ; PICK UP FIRST NEW TYPE
HRLZ D,LNKHDR(C) ; PICK UP LINK COUNT
JUMPE D,LDLNKL ; NONE
HRRI D,LNKHDR+1(C) ; AOBJN POINTER TO LINKS
LDLNLP: ADD A,(D) ; GET POINTER TO TYPE FOR THIS LINK
MOVE E,(A)
MOVEM E,(D) ; STUFF IT IN BLOCK
MOVE A,(P) ; RESTORE A
AOBJN D,LDLNLP
LDLNKL: AOBJN B,LDLN1
POP P,A
LDOUT1: SKIPE UPTFLG
JRST [SKIPN NODUMP
PUSHJ P,PRTAIL
JRST .+1]
SETZM UPTFLG
SKIPE ITSFXF
PUSHJ P,PRTAIL ; WRITE OUT UPDATE FILE (NEW FORMAT)
POPJ P,
;FIXUP POINTERS TO FILE NAMES
LDFILE: HRRZ D,(C)
HRLI D,-FSPSIZ
SKIPE ITSFXF
JRST [PUSH P,A
HRLI D,-ITSSIZ
MOVEI A,FSPSIZ
PUSHJ P,IBLOCK
MOVE F,A
POP P,A
JRST .+1]
LDFLP: SKIPE ITSFXF
JRST ITSFIX
SKIPN E,(D)
CAIA
ADDM A,(D)
LDFLPE: AOBJN D,LDFLP
SKIPN ITSFXF
POPJ P,
SUBI F,ITSSIZ
HRRM F,(C)
POPJ P,
ITSFIX: SKIPN E,(D)
JRST ITSFX1
PUSH P,A
MOVE A,E
CAIGE E,3
CAIG E,0
CAIA
JRST [MOVE A,[1,,[ASCIZ //]]
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 <ASK>
OASC ASKMSG
JRST CRLOOP
; TAILOR HOW TO RUN
HOWTAL: MOVE OUTPTR,(P)
SETOM RVALS ; PREVENT MUNGAGE IF CTRL-R
MOVE A,[HOWTLN+HOWSPC-1,,HOWTLT] ; TABLE WITH ASK DEFAULT, - ABORT & QUES
SETZM PRMPT1
JSP RET,MAKACT
PUSHJ P,COMTYP
BKOFF
HRRES A
JUMPL A,HOWRED ; SAID 'ASK' IF JUMPS
HRLI A,%IGNOR+%DSUP
MOVEM A,HOWLOC(OUTPTR)
JRST CRLOOP
HOWRED: MOVSI A,%ASK
MOVEM A,HOWLOC(OUTPTR)
JRST CRLOOP
; TAILOR ANOTHER COMPILATION? QUESTION
MORC: SETZM PRMPT1
SETOM RVALS
MOVE A,[MORLEN,,TMORTB]
JSP RET,MAKACT
PUSHJ P,COMTYP
BKOFF
HRRES A ; WILL BE -1 IF SAID ASK
JUMPGE A,[HRLI A,%IGNOR+%DSUP
JRST MORCOT]
MOVSI A,%ASK
MORCOT: MOVE OUTPTR,(P)
MOVEM A,MORLOC(OUTPTR)
JRST CRLOOP
; MAKE ACTIVATION--USED BY MORC,QDEL,&C.
MAKACT: PUSH BK,[[ASCIZ /Question/]]
PUSH BK,[CRLOOP]
PUSH BK,[[POPJ P,]]
PUSH BK,P
JRST (RET)
; DELETE QUESTION FROM TAILOR FILE
QDEL: MOVE A,[TAILEN+TAILSP,,TAILTB]
SETZM PRMPT1
JSP RET,MAKACT
PUSHJ P,COMTYP ; GET QUESTION
BKOFF
CAIN A,HOWLOC ; IF HOW TO RUN, DEFAULT IS %ASK
JRST [TLZ A,777700
TLO A,%ASK
MOVE OUTPTR,(P)
MOVEM A,HOWLOC (OUTPTR)
JRST CRLOOP]
MOVE OUTPTR,(P)
ADD OUTPTR,A
MOVE B,QTABLE(A)
MOVE A,(OUTPTR)
TLNE B,%ESSEN
HLLZS A
TLZ A,777700
TLO A,%IGNOR
MOVEM A,(OUTPTR)
JRST CRLOOP
; 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 /<ASK>/
PRASK: MOVE C,(QOFF)
TLNE C,%GIGNO
OASCI "*
OASC (C)
OHPOS 20.
OASC ASKMSG
TLNE B,%DSUP ; DEFAULT SUPPLIED?
JRST [OASC [ASCIZ /: /]
JRST DEFPRT]
JRST ENDPR
; LOAD AND REPLACE: MUNGIFICATE YOUR FROBNITZES
GETAIL: SETO QOFF, ; CRETINIZE THE POINTER
MOVEI OUTPTR,TALPTR ; TALPTR HAS POINTER TO TAILOR INPUT FILE NAMES
; ==> DEFAULTS GET SET, ETC.
SETOM FILEXP
PUSHJ P,ASK ; GO GET FILE NAME
JRST DRPOUT
IFN ITS,[
MOVE O,SNAME
]
IFE ITS,[
MOVE O,(OUTPTR)
]
MOVEM O,SYSDIR ; RESTORE SYSTEM DEFAULTS
CAME O,TALSNM
SETOM NODUMP
SETOM LDFLAG
IFN ITS,[
MOVEI B,TALDV
MOVE A,(B)
PUSHJ P,ASCSIX
MOVEM A,TALDEV
MOVE A,1(B)
PUSHJ P,ASCSIX
MOVEM A,TALSNM
MOVE A,2(B)
PUSHJ P,ASCSIX
MOVEM A,TALFN1
MOVE A,3(B)
PUSHJ P,ASCSIX
MOVEM A,TALFN2
]
IFE ITS,[
MOVE A,TALDV
HRROM A,XTALNM+.GJDEV
MOVE A,TALDV+1
HRROM A,XTALNM+.GJDIR
MOVE A,TALDV+2
HRROM A,XTALNM+.GJNAM
MOVE A,TALDV+3
HRROM A,XTALNM+.GJEXT
]
PUSHJ P,LDTAIL ; LOAD NEW FILE
SETZM NODUMP
POPJ P,
; REPLACE TAILOR. JUST LIKE ABOVE, EXCEPT CLOBBERS CURRENT USER TYPE TABLES
; FIRST
RPTAIL: SETO QOFF,
MOVEI OUTPTR,TALPTR
SETOM FILEXP ; WANT FULLY-SPECIFIED FILE NAMES
PUSHJ P,ASK
JRST DRPOUT
HLLZ A,UTYPLN ; GET NUMBER OF USER TYPES
MOVNS A ; MAKE IT POSITIVE
ADDM A,TYPLEN ; ADD TO LEFT HALF OF AOBJN POINTERS
ADDM A,UTYPLN
MOVE O,SNAME
MOVEM O,SYSDIR ; RESTORE SYSTEM DEFAULTS
CAME O,TALSNM
SETOM NODUMP
SETZM LDFLAG ; DON'T NEED TO UNIQIFY NAMES
PUSHJ P,LDTAIL ; LOAD NEW FILE
SETZM NODUMP
POPJ P,
; COME HERE IF LOSER REFUSED TO GIVE FILE NAME.
DRPOUT: IFE ITS,MOVEI TALDV
IFN ITS,MOVEI TALDEV
HRRM TALPTR
OASCR [ASCIZ /Aborted?/]
POPJ P,
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: <AOBJN POINTER TO LNKTAB>
; LNKTAB: NAME OF TYPE LINKING,,POINTER TO SLOT CONTAINING LINK
; POINTER TO TYPE
; THIS IS USED FOR THE 'LINKS?' COMMAND, FOR DELETE TYPE, RENAME TYPE,
; AND ALTER TYPE (TO DO SUBSTITUTES). TYPE IS IN A.
FNDLNK: PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
PUSH P,F
MOVEI B,LNKTAB ; BUILD A SORT OF AOBJN POINTER
MOVE F,UTYPLN ; POINTER TO USER TYPES
TLNN F,-1
JRST FNDLNO ; ANY TYPES DEFINED?
FNDOUT: MOVE C,(F) ; POINTER TO TYPE
HRLZ D,LNKHDR(C) ; NUMBER OF LINKS IN THIS BLOCK
JUMPE D,FNDLPE
HRRI D,LNKHDR+1(C) ; AOBJN POINTER TO LINKS
FNDIN1: HRRZ E,(D)
CAIE A,(E)
JRST FNDINL
HLL D,C ; STUFF POINTER TO NAME IN LH
MOVEM D,(B) ; SAVE IN LNKTAB
HRRZM C,1(B) ; SAVE TYPE
ADD B,[2,,2]
JRST FNDLPE ; END LOOP
FNDINL: AOBJN D,FNDIN1 ; THROUGH WITH THIS TYPE?
FNDLPE: AOBJN F,FNDOUT ; GO TO NEXT TYPE
FNDLNO: TLNN B,-1 ; ANY LINKS FOUND?
JRST [SETZM LNKTPT
JRST FNDDON]
HLRZS B
MOVNS B
HRLZS B
HRRI B,LNKTAB
MOVEM B,LNKTPT
FNDDON: POP P,F
POP P,E
JRST POPDCB
; 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 <SNAME "FOO">
; OUTPUT SPECIFICATIONS
; TYPE,OFFSET,HEADER,TRAILER
OUTSPC: OUTPUT $OSNAM, .QSNAM,/<SNAME "/, CSTRNG
OUTPUT $OFORM, .QNEWC,/<OR <GASSIGNED? EXPERIMENTAL!-> <NEWCOMP!->> /, CR
OUTPUT $OFNAM, .QINP,/<SETG COMBAT!- /, CANGLB
OUTPUT $OFNAM, .QPREC,/<SET PRECOMPILED!- /, CANGLB
OUTPUT $OREDO, .QCOMP,/<SET REDO!- (/, CLIST
OUTPUT $OSTRG, .QPACK,/<SET PACKAGE-MODE!- "/, CSTRNG
OUTPUT $OSTRG, .QSURV,/<SET SURVIVORS!- (/, CLIST
OUTPUT $OFNAM, .QTEMP,/<SET TEMPNAME!- /, CANGLB
OUTPUT $OFNAM, .QSRC,/<SET SOURCE!- /, CANGLB
OUTPUT $OT.FF, .QSPEC,/<SET SPECIAL!- /, CANGLB
OUTPUT $OT.FF, .QEXPF,/<SET EXPFLOAD!- /, CANGLB
OUTPUT $OT.FF, .QEXPS,/<SET EXPSPLICE!- /, CANGLB
OUTPUT $OT.FF, .QDEBU,/<SET DEBUG-COMPILE!- /,CANGLB
OUTPUT $OT.FT, .QCARE,/<SET CAREFUL!- /, CANGLB
OUTPUT $OT.FT, .QREAS,/<SET REASONABLE!- /, CANGLB
OUTPUT $OT.FT, .QGLUE,/<SET GLUE!- /, CANGLB
OUTPUT $OT.FF, .QMCRO,/<SET MACRO-COMPILE!- /, CANGLB
OUTPUT $OT.FF, .QMCRF,/<SET MACRO-FLUSH!- /,CANGLB
OUTPUT $OT.FF, .QMAXS,/<SET MAX-SPACE!- /, CANGLB
OUTPUT $OSTRG, .QTHN0,, CR,1
OUTPUT $OSTRG, .QTHNG,, CR,1
OUTPUT $OSTRG, .QTHN1,, CR,1
OUTPUT $OFNAM, .QINP,/<FCOMP %.INCHAN /,
OUTPUT $OFNAM, .QOUT,/ /, CANGLB
0
0
OUTTBL: -2*CMPSIZ,,OUTSPC
CR: ASCIZ /
/
CANGLB: ASCIZ />
/
CLIST: ASCIZ /)>
/
CSTRNG: ASCIZ /">
/
; INITIAL TABLE OF COMPILATION TYPES. $SPTYPE MEANS THAT TYPE DOESN'T MAKE
; A PLAN--HANDLED BY TURNING OFF $SPTYPE, JRSTING TO NTH ELEMENT OF TABLE FOR
; SPECIALS.
NTYPTB: SYMVAL None,$SPTYPE+.TQUIT ; USED AFTER FIRST COMPILATION
TYPTBL: SYMVAL Verbose,VTABLE ; VERBOSE COMPILATION--DEFAULT
SYMVAL Short,STABLE ; SHORT COMPILATION
SYMVAL Multiple,$SPTYPE+.TMULT ; MULTIPLE
SYMVAL Toggle Verbosity,$SPTYPE+.TTOGV ; TOGGLE VERBOSITY
SYMVAL Toggle MUDCOM verbosity,$SPTYPE+.TTOMV
SYMVAL Toggle Input File Existence Check,$SPTYPE+.TTOEX
SYMVAL More compilations,$SPTYPE+.TSMOR ; SET ANOTHER COMPILATION
SYMVAL Create type,$SPTYP+.TCRTG ; CREATE TYPE
SYMVAL Alter type,$SPTYP+.TALTG ; CHANGE TYPE
SYMVAL Print type,$SPTYP+.TPRTG ; PRINT TYPE
SYMVAL Delete type,$SPTYP+.TDELG ; DELETE TYPE
SYMVAL Rename type,$SPTYP+.TRNM ; RENAME TYPE
SYMVAL Xerox type,$SPTYP+.TXROX ; COPY TYPE
SYMVAL Load tailor,$SPTYP+.TLDTL ; LOAD TAILOR
SYMVAL Replace tailor,$SPTYP+.TRPTL ; REPLACE TAILOR
SYMVAL Quit,$SPTYPE+.TQUIT ; QUIT
SYMVAL Many flush,$SPTYPE+.TFLUS ; KILL LONG COMPILATION
SYMVAL Many print,$SPTYPE+.TPLON ; PRINT LONG COMPILATION
SYMVAL List links to type,$SPTYPE+.TLNKL ; WHO'S LINKED TO ME?
SYMVAL List links from type,$SPTYPE+.TMLNK ; TO WHOM?
ITYPLE==TYPTBL-.
UTYPTB: BLOCK 80. ;SPACE FOR USER-DEFINED TYPES
UTYPLN: UTYPTB
UTPSAV: 0 ; USED IN LOAD TAILOR FOR LINK HACKING
TYPLEN: ITYPLE,,TYPTBL ; INITIAL AOBJN POINTER TO TYPTBL
LNKTPT: 0 ; AOBJN POINTER INTO LNKTAB
LNKTAB: BLOCK 60. ; USED TO ACCUMULATE POINTERS TO A GIVEN TYPE
; TABLE FOR HOW-TO-RUN. FIRST ELEMENT IS USED IN TAILOR-MAKING, SO DEFAULT
; THERE IS ASK.
HOWTLT: SYMVAL <ASK>,-1
IFN ITS,[
HOWTBL: SYMVAL Waste,.HWASTE
SYMVAL Combat,.HCOMBT
SYMVAL File,.HFILE
SYMVAL Pcomp,.HPCOMP
]
IFE ITS,[
HOWTBL: SYMVAL Pcomp,.HPCOMP
SYMVAL Combat,.HCOMBT
SYMVAL File,.HFILE
]
SYMVAL Many,.HMANY
SYMVAL Abort,.HABRT
SYMVAL Question,.HQUES
SYMVAL Type plan,.HPRIN
HOWTLN==HOWTBL-.
HOWSPC==3 ; NUMBER OF THINGS AT END THAT CAN'T BE TAILORED
; TABLE FOR TAILORING MORE COMPILATIONS? USED BY COMTYP, SO DEFAULT IS
; <ASK>.
TMORTB: SYMVAL <ASK>,-1
SYMVAL No,0
SYMVAL Yes,1
SYMVAL False,0
SYMVAL True,1
MORLEN==TMORTB-.
MORPMP: ASCIZ /Another compilation?/
;TABLE FOR VERBOSE COMPILATIONS
VTABLE: %IGNOR,,0 ; SNAME
%ASK,,0 ; NEW COMPILER
%ASK,,0 ; DEBUGGING COMPILER
IFN ITS,[
%ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ />/] ? 0 ? 0] ; INPUT
]
IFE ITS,[
%ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /MUD/] ? 0 ? 0] ; INPUT
]
%ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /NBIN/] ? 0 ? 0] ; OUTPUT
%ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /NBIN/] ? 0 ? 0] ; PRECOMP
%ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /NBIN/] ? 0 ? 0] ; COMPARE
%ASK,,0 ; MANIFEST SWITCH
%ASK,,0 ; EXTRA JCL
%ASK,,0 ; REDO
%ASK,,0 ; PACKAGE MODE
%IGNOR,,0 ; GROUP MODE
%IGNOR,,0 ; SURVIVORS
%IGNOR,,0 ; TEMPNAME
%IGNOR,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /SOURCE/] ? 0 ? 0]; SOURCE
%IGNOR,,0 ; SPECIAL?
%ASK,,0 ; EXPFLOAD
%IGNOR,,0 ; EXPSPLICE
%ASK,,1 ; CAREFUL?
%ASK,,1 ; REASONABLE
%IGNOR,,1 ; GLUE
%IGNOR,,0 ; MACRO COMPILE
%IGNOR,,0 ; MACRO FLUSH
%IGNOR,,0 ; MAX SPACE
%IGNOR,,0 ; FIRST THINGS
%ASK,,0 ; THINGS TO DO
%IGNOR,,0 ; MORE THINGS
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%ASK,,0
; SUPER-SHORT: DEFAULTS EVERYTHING BUT NEW COMPILER, HOW TO RUN, AND INPUT
STABLE: %IGNOR,,0
%ASK,,0
%IGNOR,,0
IFN ITS,[
%ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ />/] ? 0 ? 0]
]
IFE ITS,[
%ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ />/] ? 0 ? 0]
]
%IGNOR,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /NBIN/] ? 0 ? 0]
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,1
%IGNOR,,1
%IGNOR,,1
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%IGNOR,,0
%ASK,,0
; QUESTIONS FOR TAILOR
TAILTB: SYMVAL Sname,.QSNAM
SYMVAL New compiler?,.QNEWC
SYMVAL Debugging compiler?,.QDEBU
SYMVAL Input file,.QINP
SYMVAL Output file,.QOUT
SYMVAL Precompilation,.QPREC
SYMVAL Compare with,.QCOMP
SYMVAL Check macros?,.QMANI
SYMVAL Extra JCL,.QCJCL
SYMVAL Redo,.QREDO
SYMVAL Package mode,.QPACK
SYMVAL Survivors,.QSURV
SYMVAL Temporary file,.QTEMP
SYMVAL Source file,.QSRC
SYMVAL Special?,.QSPEC
SYMVAL Expand floads?,.QEXPF
SYMVAL Expand splices?,.QEXPS
SYMVAL Careful?,.QCARE
SYMVAL Reasonable?,.QREAS
SYMVAL Glue?,.QGLUE
SYMVAL Macro compile?,.QMCRO
SYMVAL Macro flush?,.QMCRF
SYMVAL Max space?,.QMAXS
SYMVAL First things to do,.QTHN0
SYMVAL Things to do,.QTHNG
SYMVAL Last things to do,.QTHN1
SYMVAL Another compilation?,MORLOC ; MORLOC=38
SYMVAL How to run,HOWLOC
SYMVAL Set question default,$SQDEF
SYMVAL Finis,$FINIS
SYMVAL Delete question,$DELQ
SYMVAL Print current type,$PRTYP
SYMVAL Link to type,$CLINK
SYMVAL Unlink from type,$DLINK
SYMVAL Expand link to type,$XLINK
SYMVAL Expand all links,$XXLIN
SYMVAL List links to current type,$LLINK
SYMVAL List links from current type,$PLINK
TAILEN==TAILTB-.
TAILSP==10. ; # OF UNREAL QUESTIONS
TALSPC==12. ; # OF QUESTIONS WITH UNTOUCHABLE DEFAULTS
JCLIOT: ILDB A,JCLPTR
JUMPE A,JCLLOS
JRST 1(RET)
JCLLOS: SETZM JCLINP
JRST (RET)
JCLRED:
IFN ITS,[
.BREAK 12,[5,,JCLBUF]
]
SKIPN JCLBUF
POPJ P,
MOVE A,[440700,,JCLBUF]
SETOM JCLINP
MOVEM A,JCLPTR
POPJ P,
PRHELP: JUMPN C,RCMDL ; ONLY ON FIRST CHARACTER
LDB A,[410300,,PRMPT1]
JRST @HLPTBL(A)
HLPTBL: HLPSTR
BADTYP
HLPFSP
HLPFIL
HLPCMT
HLPCMT
BADTYP
BADTYP
SAVAC: PUSH P,A
PUSH P,B
PUSH P,C
JRST @RET
RSTAC: POP P,C
POP P,B
POP P,A
JRST @RET
HLPSMM: ASCIZ /
Symbolic input accepted.
To complete a response, type <space>.
To complete and terminate a response, type <altmode> or <cr>.
To use the default, type <altmode> or <cr>.
The default is /
HLPTF: ASCIZ /No/
ASCIZ /Yes/
HLPCMT: HLRZ A,PRMPT1
TRNE A,%RDCMT
JRST HLPSYM
SAVACS
OASC HLPSMM
MOVE A,(OUTPTR)
OASC HLPTF(A)
JRST HLPOUT
HLPSYM: SAVACS
OASC HLPSMM
MOVE A,CSYMTB
HLRZ A,(A)
OASC (A)
JRST HLPOUT
HLPSTM: ASCIZ /
Input text terminated by an altmode/
HLPST2: ASCIZ /.
To use the default, type <altmode>.
The current default is /
HLPSTR: SAVACS
OASC HLPSTM
JUMPE OUTPTR,HLPOUT
HRRZ B,(OUTPTR)
JUMPE B,HLPOUT
OASC HLPST2
OASC (B)
JRST HLPOT1
HLPFSM: ASCIZ /
Input a file name. Typing an <altmode> will indicate a negative response.
To get the current default, type <space> <altmode>.
The current default is /
HLPFSP: SAVACS
OASC HLPFSM
PUSHJ P,HLPFDF
JRST HLPOUT
HLPFLM: ASCIZ /
Input a file name. Typing an <altmode> will cause the default to be used.
The current default is /
HLPFIL: SAVACS
OASC HLPFLM
PUSHJ P,HLPFDF
HLPOUT: OASCI ".
HLPOT1: OASCR [0]
RSTACS
JRST REPPER
HLPFDF: MOVE A,(OUTPTR)
PUSHJ P,NFNAME
POPJ P,
SUBTTL INPUT ROUTINES
; PUSHJ P,ASK TO READ AN ANSWER AND FILL IN THE STUFF
ASK: MOVE A,QTABLE(QOFF); GET THE TYPE WORD AND QUESTION
ASK1: TLO A,%RDCRT
TLZ A,77
MOVEM A,PRMPT1 ; SAVE AS THE PROMPT
ASK2: MOVE A,PRMPT1
SETZM CSYMTB
SETZM SYMMOD
TLNE A,$TSYMBOL
JRST [MOVEI B,SYMPR2
MOVEM B,PRMPT2
MOVE B,[TFTLEN,,TFTBL]
MOVEM B,CSYMTB
SETOM SYMMOD
JRST ASK3]
TLNE A,$TFIL
JRST [MOVEI B,FILPR2
MOVEM B,PRMPT2
JRST ASK3]
TLNE A,$TFSP
JRST [MOVEI B,FSPPR2
MOVEM B,PRMPT2
JRST ASK3]
MOVEI B,STRPR2
MOVEM B,PRMPT2
ASK3:
IFE ITS,[
TLNE A,$TFIL
JRST XASKF
]
PUSHJ P,GETLN1
LDB A,[410300,,QTABLE(QOFF)]
JRST @PRSTBL(A)
BADTYP: FATINS BAD TYPE CODE
PRSTBL: PRSSTR
BADTYP
PRSFSP
PRSFIL
PRSTF
PRSSYM
BADTYP
BADTYP
; PUSHJ P,COMTYP
; A HAS SYMBOL TABLE (1 OF WHICH IS THE DEFAULT)
; RETURNS IN A THE VALUE OF THE SYMBOL
COMTYP: PUSH P,A
MOVEM A,CSYMTB
MOVSI O,$TSYMBOL+%RDCMT+%RDCRT
HLLM O,PRMPT1
MOVEI O,SYMPR2
MOVEM O,PRMPT2
PUSHJ P,GETLNS
SKIPN INPBUF
JRST [POP P,A
MOVEM A,SMVAL
HLRZ B,(A)
OASC (B)
OASCI 33
HRRZ A,(A)
POPJ P,]
MOVE B,(P)
MOVE A,[440700,,INPBUF]
PUSHJ P,SMATCH
POP P,
POPJ P,
TFATBL: SYMVAL <ASK>,-1
TFTBL: SYMVAL Yes,1
SYMVAL True,1
SYMVAL No,0
SYMVAL False,0
TFTLEN==TFTBL-.
TFALEN==TFATBL-.
; PARSING ROUTINES
PRSSTR: JUMPE C,CPOPJ
PUSHJ P,PRSINP
DPB C,[%TPLEN,,D]
MOVEM D,(OUTPTR)
JRST POPJ1
; PUSHJ P,PRSINP
; TAKES THE CHARACTER COUNT IN C, COPIES THE INPUT BUFFER INTO SOME NEW CORE
; AND RETURNS THE ADDRESS IN D
PRSINP: IDIVI C,5
ADDI C,1
MOVE A,C
PUSH P,A
PUSHJ P,IBLOCK
MOVE D,A
HRLI A,INPBUF
MOVE B,(P)
ADDI B,-1(A)
BLT A,(B)
POP P,C
POPJ P,
; PARSE TRUE/FALSE TYPE QUESTIONS
PRSTF: SKIPN INPBUF ; NO INPUT?
JRST [MOVEI B,[ASCIZ /Yes/]
SKIPN (OUTPTR)
MOVEI B,[ASCIZ /No/]
OASC (B)
OASCI 33
POPJ P,]
MOVE A,[440700,,INPBUF]
MOVE B,[TFTLEN,,TFTBL]
PUSHJ P,SMATCH
MOVEM A,(OUTPTR)
JRST POPJ1
; TWENEX FILE NAME READING
; READ A FILE NAME WITH DEFAULTS
IFE ITS,[
XASKF: OASCR [0]
PUSHJ P,PPRMPT
MOVE A,QTABLE(QOFF)
TLZ A,7777
HLRZS A
CAIN A,$TFSP
JRST XASKF3
XASKF0: MOVE A,(OUTPTR)
HRLI A,-ITSSIZ
MOVEI B,GTJFN2+.GJDEV
XASKFL: SKIPN (A) ; FILL IN FILE NAME DEFAULTS
JRST XASKFE
HRRO C,(A) ; WITH -1 IN LH
MOVEM C,(B)
XASKFE: AOJ B,
AOBJN A,XASKFL ; LOOP THROUGH DEV, SNM, FN1, FN2
MOVEI A,.PRIIN
RFMOD
TRO B,TT%ECO
SFMOD ; GODDAMN GTJFN!
XASKFA: MOVEI A,GTJFN2
SETZ B,
HRRO C,PRMPT1
MOVEM C,GTJFN2+.GJRTY ; SETUP PROMPT
SETOM INPBUF
PUSHJ P,ECHON
SKIPN FASKQS
JRST XASKFB
SKIPN FILEXI
JRST [MOVE A,[GTJFN2+1,,GTJFNN+1]
BLT A,GTJFNN+15
MOVEI A,GTJFNN
JRST .+1]
XASKFB: GTJFN
JRST XASKF2
PUSHJ P,ECHOFF
MOVEM A,JFN
PUSH P,A ; SAVE THIS GODAWFUL JFN
MOVEI A,.PRIIN
RFMOD
TRZ B,TT%ECO
SFMOD ; GODDAMN GTJFN!
MOVE E,[-5,,JFNSBT] ; AOBJN FOR JFNS'ING
MOVE F,(OUTPTR) ; POINTER TO BLOCK
SETZ D, ; D IS ALWAYS 0 FOR JFNS
XASKF1: MOVEI A,15.
PUSHJ P,IBLOCK
HRLI A,15.
MOVEM A,(F)
HRROS A ; POINTER TO STRING
MOVE B,(P) ; JFN
MOVE C,(E) ; CORRECT BIT FOR PARSING ONE FIELD
CAMN C,[JS%GEN]
JRST [TLNN B,(GJ%UHV) ; WAS HIGHEST GIVEN BY DEFAULT?
JRST .+1
MOVE B,[ASCIZ /0/]
MOVEM B,(A) ; MAKE IT 0, THEN... HACK, HACK
JRST XASKFU]
JFNS ; PARSE THE NAME
XASKFU: AOJ F,
AOBJN E,XASKF1 ; UPDATE POINTERS
POP P,A ; RESTORE JFN (NOT NEEDED ANYHOW)
SKIPE FILEXP
JRST PRSFIX
JRST PRSFID
XASKF2: PUSHJ P,ECHOFF
SETZM INPBUF ; THIS IS SO FILESPECS WILL FALL OUT
CAIN A,GJFX34 ; ? TYPED
JRST XASKFH
CAIN A,GJFX37 ; NULL BUFFER
JRST PRSFID
SKIPN FILEXI
JRST XASKF5
XASKF6: OASC [ASCIZ / Aborted? /]
POPJ P,
XASKF3: PBIN
PBOUT
CAIE A,33
JRST XASKF4
SETZM INPBUF
SETZM (OUTPTR)
JRST PRSFID
XASKF4: MOVEI A,.PRIIN
BKJFN
JFCL
JRST XASKF0
XASKF5: OASC [ASCIZ / ERROR - /]
MOVEI A,.PRIOU
MOVE B,[SETZ -1]
SETZ C,
ERSTR
JFCL
JFCL
SUB P,[1,,1] ; BACK TO FASKQ
POPJ P,
XASKFH: MOVE A,QTABLE(QOFF)
TLNE A,$TFSP
JRST XHLPFS
SAVACS
OASC HLPFLM
PUSHJ P,XHLPFD
XHLPOU: OASCI ".
XHLPOT: OASCR [0]
RSTACS
JRST XASKFA
XHLPFM: ASCIZ /
Input a file name. Typing a <rubout> will indicate a negative response.
To get the current default, type <space> <altmode>.
The current default is /
XHLPFS: SAVACS
OASC XHLPFM
PUSHJ P,XHLPFD
JRST XHLPOU
XHLPFD: MOVE A,(OUTPTR)
PUSHJ P,NFNAME
POPJ P,
JFNSBT: JS%DEV
JS%DIR
JS%NAM
JS%TYP
JS%GEN
GTJFN3: GJ%OLD
.NULIO,,.NULIO
0
0
0
0
0
0
0
0
0
GTJFNN: GJ%OLD+GJ%FLG+GJ%XTN ; IN THIS BLOCK, FILE MUST EXIST
BLOCK 16
GTJFN2: GJ%OFG+GJ%XTN
.PRIIN,,.PRIOU
0
0
0
0
0
0
0
G1%RND+3
0
0
0
]
; GIVEN A POINTER TO A FILE NAME BLOCK IN A, CONS THE
; WHOLE FILE NAME WITH GTJFN AND SKIP RETURN WITH A
; POINTER TO THE ASCIZ STRING NAME (A LA JFNS) IN A
IFE ITS,[
XFNEXP: HRLI A,-5
MOVEI B,GTJFNE+.GJDEV
PUSH P,B
PUSH P,C
PUSH P,D
XFNX1: HRRO C,(A) ; FILL IN THE FIELDS
MOVEM C,(B)
AOJ B,
AOBJN A,XFNX1
MOVEI A,GTJFNE
SETZ B,
GTJFN ; ASK FOR JFN (MUST EXIST!)
JRST POPDCB
MOVE B,A
MOVEI A,30. ; PLACE TO WRITE STRING
PUSHJ P,IBLOCK
PUSH P,A
HRROS A
SETZ C,
SETZ D,
JFNS
POP P,A
AOS -3(P)
JRST POPDCB
GTJFNE: GJ%OLD
.NULIO,,.NULIO
0
0
0
0
0
0
0
0
]
; PARSE FILE INPUT SPECIFICATIONS
PRSFIL: PUSHJ P,FPARSE
JRST [OASC [ASCIZ / - Illegal character in file name/]
JRST ASK2]
MOVE A,(OUTPTR)
SKIPN FILEXP
JRST [HRLI B,DEVICE
HRR B,A
MOVEI C,5(A)
BLT B,(C)
JRST PRSFID]
PRSFIX: MOVE A,(OUTPTR)
PUSH P,A
HRLI A,-ITSSIZ
MOVEI D,DEVICE
MOVEI E,SYSDEV
PRSFLL: SKIPN B,(D)
JRST [SKIPN B,(A)
MOVE B,(E)
JRST .+1]
PUSHJ P,GETFNM
MOVEM B,(A)
AOJ D,
AOJ E,
AOBJN A,PRSFLL
OASC [ASCIZ / [/]
POP P,A
PUSHJ P,NFNAME
OASCI "]
PRSFID: MOVE A,QTABLE(QOFF)
TLNN A,%NSYSD
PUSHJ P,FPSYS
SKIPN INPBUF
POPJ P,
JRST POPJ1
;IN A, THE POINTER TO ASCIZ
;A HAS BEEN PUSHED PREVIOUSLY
XSPNM: PUSH P,B
MOVE B,(A)
IFN ITS,[
CAMN B,[ASCIZ //]
]
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 <CR>
CAIE B,^X
CAIN B,^Y
JRST FIELD2
CAIN B,^Q ;HANDLE QUOTING
ILDB B,E
CAIGE B,40 ;SUBI B,40 < 0 (BAD CHARACTER)
JRST CPOPJ
CAIL B,"a
SUBI B,40 ;CASE CONVERSION
FIELD2: IDPB B,F
AOS NAMCNT
FPARS2: ILDB B,E
JRST FIELD
DEV: MOVE A,NAME
JSP RET,FNMCNT
MOVEM A,DEVICE
SETZM SPCHR
JRST FPARSS
FDIR: MOVE A,NAME
JSP RET,FNMCNT
MOVEM A,DIRECT
SETZM SPCHR
JRST FPARSS
FNAM1:
FNAM: SKIPN NAMCNT
JRST FPARSS
MOVE A,NAME
JSP RET,FNMCNT
SKIPE FNAME1 ;DOES HE HAVE AN FNAME1 ALREAD?
JRST FNAM2 ;YES - OOPS. HE IS GIVING TWO NAMES
MOVEM A,FNAME1 ;NO - TRY IT AS FNAME1
JRST FPARSS
FNAM2: MOVEM A,FNAME2 ;PUT NEW NAME INTO FNAME2
JRST FPARSS
FNMCNT: MOVE B,NAMCNT ;PUT COUNT IN HERE
IDIVI B,5
ADDI B,1
HRL A,B
JRST (RET)
; CLEAR THE SCREEN
IFE ITS,[
XCLEAR: SAVACS
MOVEI 1,.PRIOU ;ENTER HERE FOR THINGS THAT BLANK INCIDENTALLY
RFMOD ;CHANGE TO
PUSH P,2
TRZ 2,TT%DAM ;BINARY MODE
SFMOD
GTTYP
HRROI 1,BLNKTB(2) ;GET RIGHT MAGIC
PSOUT
MOVEI 1,.PRIOU
POP P,2
SFMOD
RSTACS
POPJ P,
BLNKTB: REPEAT 4, <.BYTE 7 ? 15 ? 12 ? 0> ; 0-3
<.BYTE 7 ? 177 ? 220-176 ? 0> ; 4 IMLACS
<.BYTE 7 ? 35 ? 36 ? 0> ; 5 DM
<.BYTE 7 ? 33 ? "H ? 33 ? "J ? 0> ; 6 HP2640
REPEAT 4 ? <.BYTE 7 ? 15 ? 12 ? 0> ; 7-10
<.BYTE 7 ? 33 ? "H ? 33 ? "J ? 0> ; 11 VT50
<.BYTE 7 ? 15 ? 12 ? 0> ; 12
<.BYTE 7 ? 33 ? "( ? 177 ? 0> ; 13 LP
<.BYTE 7 ? 15 ? 12 ? 0> ; 14
<.BYTE 7 ? 33 ? "H ? 33 ? "J ? 0> ; 15 VT52
REPEAT 3, <.BYTE 7 ? 15 ? 12 ? 0> ; ETC
]
IFE ITS,[
; DO TWENEX IOTING
; IN (P) IS THE WORD WHICH ITS WOULD LIKE
XIOTI: PUSH P,[SIN]
CAIA
XIOT: PUSH P,[SOUT]
MOVE O,[A,,XACS]
BLT O,XACS+2
MOVE A,-1(P)
MOVE A,(A)
MOVE O,XACS-1(A)
MOVE A,DSKJFN
HRRZ B,O
TLO B,444400
HLRE C,O
PUSH P,C
XCT -1(P)
CAME C,(P)
AOS -2(P)
MOVE O,[XACS,,A]
BLT O,C
SUB P,[2,,2]
JRST POPJ1
XACS: BLOCK 3
]
; CONVERT ASCII NAME IN A TO SIXBIT WORD IN A
; CHOMP ,CHOMP
ASCSIX: PUSH P,B
PUSH P,C
PUSH P,D
MOVE B,A
HRLI B,440700 ; B POINTS TO ASCII BLOCK
SETZ A,
MOVE C,[440600,,A] ; C POINTS TO A (SIXBIT WORD)
ASCSIL: ILDB D,B
JUMPE D,SIXAS2
SUBI D,40
CAIL D,100
SUBI D,40
IDPB D,C
TLNE C,770000 ; SKIP IF A IS FULL
JRST ASCSIL
JRST SIXAS2
; CONVERT SIXBIT NAME IN A TO STANDARD ASCII POINTER
; I.E. WORD-COUNT(=2),,POINTER
SIXASC: PUSH P,B ; SAVE RANDOM ACS
PUSH P,C
PUSH P,D
PUSH P,A ; TEMPORARILY SAVE SIXBIT WORD
MOVEI A,2
PUSHJ P,IBLOCK ; GET BLOCK FOR ASCII
POP P,B ; RESTORE SIXBIT WORD
PUSH P,A ; SAVE ASCII BLOCK POINTER
HRLI A,440700 ; POINTER TO ASCII BLOCK
MOVE C,[440600,,B] ; POINTER TO SIXBIT WORD
SIXASL: ILDB D,C ; GET CHARACTER
JUMPE D,SIXAS1 ; FINIS
ADDI D,40
IDPB D,A ; DEPOSIT CHARACTER
TLNE C,760000
JRST SIXASL ; LOOP
SIXAS1: POP P,A ; FINISHED. RESTORE POINTER
HRLI A,2 ; 2 IN LH (WORD COUNT)
SIXAS2: POP P,D ; AND RETURN
POP P,C
POP P,B
POPJ P,
; GENERAL PURPOSE MATCH LOSSAGE HANDLERS
; COMPS GIVEN BP'S IN A AND E, RETURNS THE NUMBER OF = LETTERS
COMPS: SETZ F, ; COUNT OF MATCHING CHARACTERS
COMPS1: ILDB C,A
JUMPE C,[MOVE C,E ; COPY THE BP TO TABLE ENTRY
ILDB C,C
SKIPN C ; THIS ZERO ALSO??
MOVEM B,SMEXAC ; YES. THIS IS AN EXACT MATCH
JRST POPJ1]
TRO C,40 ; LOWER CASE
ILDB D,E
JUMPE D,CPOPJ
TRO D,40 ; LOWER CASE
CAMN C,D
AOJA F,COMPS1
POPJ P, ; LOSE IMMEDIATE
; PUSHJ P,SPOSS
; LIST POSSIBILITIES. AC'S AS BELOW
SPOSS: PUSH P,[-1]
OASCR [0]
OASCR [ASCIZ /The following are possible: /]
JRST SMATIN
; PUSHJ P,SMATCH
; SYMBOL-TABLE MATCH HACKER
; A = BYTE POINTER TO INPUT BLOCK
; B = AOBJN POINTER TO SYMBOL TABLE
; C = # OF CHARS IN INPUT BUFFER
; LSTBRK HAS LAST BREAK CHARACTER
SMATCH: PUSH P,[0]
SMATIN: PUSH P,A
MOVEM C,INPLEN ; SAVE INPUT LENGTH
SETZM SMEXAC ; ZERO SOME SWITCHES
SETZM SMBEST
SETZM SMBLEN
SETZM SMNUM
SMLP2: MOVE A,(P) ; GET BP TO INPUT BUFFER
HLRZ E,(B)
HRLI E,440700 ; GET BP TO TABLE ENTRY
PUSH P,E ; AND SAVE IT
PUSHJ P,COMPS ; GET THE MATCHING
JRST SMNEXT ; DOES NOT MATCH. GO TO NEXT ENTRY.
SKIPL -2(P) ; IS THIS A CONTROL-F?
JRST SMWINR ; NO. HACK THIS ENTRY
AOS SMNUM ; INCREMENT THE COUNT OF WINNERS
HLRZ E,(B) ; YES. PRINT THE ENTRY
OASCR (E)
SMNEXT: POP P,E ; RESET THE STACK
SMNXT1: AOBJN B,SMLP2 ; LOOP ON THE SYMBOL TABLE
POP P, ; RESTORE BP TO INPUT BUFFER
POP P,A ; GET CODE
JUMPL A,SMNPOS ; THIS WAS PUSHJ P,SPOSS
MOVE D,SMBEST ; GET THE BEST BP
MOVE B,INPSAV ; AND THE INPUT BUFFER
ADD B,[70000,,] ; DECREMENT THE POINTER
TLNE B,400000
ADD B,[347777,,-1]
SKIPN A,SMBLEN ; ANY CHARACTERS TO COMPLETE?
JRST [SKIPE SMEXAC ; NO. IS THERE AN EXACT MATCH?
JRST SMEXOK ; YES. WIN IMMEDIATE
JRST SMMDON] ; NO. CHECK FOR PARTIAL MATCHES, ETC.
; COME HERE TO COMPLETE
SMDEP: ILDB E,D ; GET THE NEXT CHARACTER
OASCI (E) ; ECHO IT
IDPB E,B ; DEPOSIT INTO THE INPUT BUFFER
SOJN A,SMDEP ; CONTINUE
SMMDON: MOVE D,SMNUM ; GET THE NUMBER OF MATCHES
CAIN D,1 ; JUST 1?
JRST SMTERM ; YES. TERMINATE
SMCONT: SKIPE JCLINP ; JCL INPUT?
JRST SMLOSR ; YES. CHOMPER.
JUMPE D,SMLOSE ; NO MATCHES. LOSE, LOSE
AOS XTRCHR ; INCREMENT EXTRA CHARACTER COUNT
IFN ITS,[
OASCI "& ; AND PRINT CONTINUATION CHAR
]
SMCNT1: MOVE C,SMBLEN
ADD C,INPLEN ; UPDATE CHARACTER COUNT FOR READER
MOVE D,INPACT ; GET THE ACTIVATION FOR INPUT
HRRM D,(P)
JRST RCMD1 ; RETURN TO READER
SMLOSR: OASC [ASCIZ /Matching error - JCL input aborted/]
CAIA
SMLOSE: OASC [ASCIZ / No symbol matches input /]
SETZM JCLINP ; FLUSH INPUT FROM JCL
MOVE D,INPACT ; GET THE ACTIVATION FOR INPUT
HRRM D,(P)
JRST GETLNS ; RETURN TO READER
; COME HERE WHENEVER A SYMBOL TABLE ENTRY MATCHES THE INPUT IN THE BUFFER
SMWINR: MOVEM A,INPSAV ; SAVE POINTER TO INPUT BUFFER
AOS SMNUM ; INCREMENT # OF MATCHES
SKIPN A,SMBEST ; CHECK FOR BEST SO FAR
JRST SMFRST ; NONE. CREATE ONE
MOVEM E,(P) ; SAVE THE BP TO THIS ENTRY
PUSHJ P,COMPS ; COMPARE THIS ENTRY TO BEST SO FAR
JFCL
CAML F,SMBLEN ; ARE THERE FEWER MATCHES THAN BEST?
JRST SMNEXT ; NO. NEXT VICTIM
POP P,SMBEST ; MAKE THIS THE BEST SO FAR
MOVEM B,SMVAL ; SAVE VALUE WORD
MOVEM F,SMBLEN ; SAVE BEST LENGTH
JRST SMNXT1 ; CHECK ON
SMFRST: MOVEM E,SMBEST ; SAVE BP TO THE REMAINDER AS BEST
PUSHJ P,STRLEN ; GET ITS LENGTH
MOVEM E,SMBLEN ; AND MAKE IT BEST LENGTH
MOVEM B,SMVAL ; SAVE VALUE WORD
JRST SMNEXT ; GET NEXT ENTRY
; COME HERE IF THERE IS AN EXACT MATCH OR ONLY ONE POSSIBLE COMPLETION
SMEXOK: MOVE A,SMEXAC ; HAVE EXACT MATCH
MOVEM A,SMVAL ; SAVE IT
SMTERM: MOVE E,LSTBRK ; GET THE BREAK CHARACTER
CAIE E,33 ; IF ALTMODE, TERMINATE
JRST SMTRM1 ; ELSE, CHECK ON
OASCI (E) ; PRINT TERMINATION CHARACTER
SMTRM2: MOVE A,SMVAL
HRRZ A,(A) ; GET THE VALUE IN A AND RETURN
POPJ P,
SMTRM1: CAIE E,^M ; IS THE BREAK A <CR>
JRST SMTRM3 ; NO. COMPLETE ONLY
MOVE A,PRMPT1
TLNE A,%RDCRT ; IS THE TERMINATE ON <CR> BIT SET?
JRST SMTRM2 ; YES. TERMINATE
SMTRM3: AOS XTRCHR ; NO. GIVE AN EXCL AND WAIT
OASCI "!
JRST SMCNT1
; COME HERE AT END OF CONTROL-F HACK
SMNPOS: SKIPN SMNUM ; ANY POSSIBILITIES MATCH?
OASCR [ASCIZ / None possible /]
POPJ P,
; GET THE LENGTH OF A STRING POINTED TO BY E
STRLEN: MOVE C,E
SETZ E,
STRLLP: ILDB D,C
JUMPE D,CPOPJ
AOJA E,STRLLP
; CLEAR THE INPUT BUFFER
CLINBF: SETZM INPBUF
MOVE O,[INPBUF,,INPBUF+1]
BLT O,INPBUF+INPBLN-1
POPJ P,
; COPY THE INPUT BUFFER INTO TINBUF
SINBUF: PUSH P,A
MOVE A,[INPBUF,,TINBUF]
BLT A,TINBUF+INPBLN-1
JRST POPAJ
; COPY TINBUF BACK INTO THE INPUT BUFFER
RINBUF: PUSH P,A
MOVE A,[TINBUF,,INPBUF]
BLT A,INPBUF+INPBLN-1
JRST POPAJ
; COMMAND READER.
; PUSHJ P,GETLIN READS TO AN ALTMODE AND FILLS IN THE INPUT BUFFER
; ACCORDINGLY
GETLNS: SETOM SYMMOD
CAIA
GETLIN: SETZM SYMMOD
GETLN1: SETZM XTRCHR
MOVE RET,(P)
MOVEM RET,INPACT ; SAVE "ACTIVATION"
PUSHJ P,CLINBF
HRRZ B,PRMPT1
JUMPE B,RCMD
RCMDXX: OASCR [0]
RCMD: MOVE B,[440700,,INPBUF]
PUSHJ P,PPRMPT
SETOM INREAD ; HAVE REASONABLE INPUT BUFFER TO REDISPLAY
MOVEI C,0 ; COUNT OF CHARACTERS
RCMD1: SETZM MDPDLF
SETZM MDMISF
SETZM MDOVCF ; CLEAR ERROR FLAGS
SETZM MDBKSV
RCMDER: SKIPE JCLINP ; COME HERE IF ERROR FLAG JUST SET
REBLK: JSP RET,JCLIOT ; FOR HYSTERICAL REASONS
IFN ITS,[
.IOT TTYI,A
]
IFE ITS,[
PBIN
]
SKIPN MDMISF
SKIPE MDOVCF
OCTLP "L ; CLEAR ERROR MESSAGE, IF EXISTS
SKIPE MDPDLF
OCTLP "L
SKIPE XTRCHR
PUSHJ P,XTRCLR
SKIPE RQUOTE ; IN QUOTE MODE?
JRST [SETZM RQUOTE
JRST RCMDL]
CAIN A,"\
JRST [SETOM RQUOTE
JRST RCMD1]
CAIN A,^W ; ERASE A WORD
JRST WDFLUS
CAIN A,^X ; ERASE A LINE
JRST [MOVE O,PRMPT1
TLNN O,$TFILE ; DOESN'T WORK IN FILE MODE
JRST LNFLUS
JRST RCMDL]
CAIN A,^K ; ERASE AN OBJECT
JRST [MOVE O,PRMPT1
TLNE O,700000 ; STRING?
JRST WDFLUS ; NO, SO TURN INTO WORD FLUSH
JRST MDFLUS]
CAIN A,177
JRST RUB
CAIN A,^F
JRST POSCHK
CAIN A,^G
JRST GACK ; GET FROM GROUP
JUMPE A,RSTBUF
CAIN A,^D ; DISPLAY BUFFER
JRST RREPEA
CAIN A,^L ; CLEAR SCREEN AND DISPLAY BUFFER
JRST RCLEAR
CAIN A,"?
JRST PRHELP
CAIN A,^Q
JRST [SETOM CTRLQ
MOVEI A,33
JRST RCMDX1]
CAIN A,33 ; TERMINATE ON ALTMODE
JRST RCMDXE
CAIE A,^B ; MAKE CONTROL-B DO BACK UP ALSO (LIKE FOR 20X)
CAIN A,^R
JRST RACK ; BACK UP
CAIN A,^S ; QUIT
JRST TOPLEV
CAIN A,^M
JSP RET,CRCHK
SKIPE SYMMOD
JSP RET,SYMCHR
RCMDL: ADDI C,1
CAIL C,INPBLN
FATINS PDL OVERFLOW ON NON-EXPANDABLE PDL
CAIN A,^J
JRST [SKIPE FOOBR'
JRST RCMD1 ; WHAT THE FUCK HAPPENS HERE?
SETOM FOOBR
JRST .+2]
SETZM FOOBR
IDPB A,B
ECHO
JRST RCMD1
RCMDXE:
SKIPN SYMMOD ; HERE ON ALTMODE
ECHO ; ECHO NON-SYMBOL ALTMODES
RCMDX1: MOVEM A,LSTBRK ; SAVE BREAK CHARACTER
MOVEI A,0 ; DEPOSIT ZERO
IDPB A,B
SETZM INREAD
MOVEM C,CHRLEN'
POPJ P, ; EXIT
RSTBUF: ECHO ; ECHO THE CHAR AND CLEAR THE BUFFER
RSTBF1: OASCR [0]
SETZ C,
PUSHJ P,CLINBF
MOVE B,[440700,,INPBUF]
JRST REPPER
POSCHK: SKIPN CSYMTB
JRST RCMDL
MOVE A,[440700,,INPBUF]
PUSH P,B
MOVE B,CSYMTB
PUSH P,C
PUSH BK,[0] ; CREATE ACTIVATION FOR ABORT
PUSH BK,[POSCHR]
PUSH BK,[[POPJ P,]]
PUSH BK,P
SETOM LONGOT ; ENABLE MORES, ^R ^S TO STOP
PUSHJ P,SPOSS
SETZM LONGOT ; DISABLE
BKOFF
POSCHR: PUSHJ P,PPRMPT
POP P,C
POP P,B
OASC INPBUF
JRST RCMD1
XTRCLR: OCTLP "X
SOSE XTRCHR
JRST XTRCLR
POPJ P,
CRCHK: HLRZ D,PRMPT1
TRNN D,$TFILE
TRNE D,$TSYMBOL
JRST RCMDX1
ECHO
IDPB A,B
MOVEI A,^J
AOJ C,
JRST @RET
SYMCHR: CAIN A,40
JRST RCMDX1
JRST @RET
PPRMPT: OASC @PRMPT1
SKIPE PR2SW
OASC @PRMPT2
POPJ P,
RREPEA: ECHO
OASCR [0] ; RETYPE LINE
JRST REPPER
RCLEAR: SCLEAR
REPPER: PUSHJ P,PPRMPT
OASC INPBUF
JRST RCMD1
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 <CR>, <LF>, <TAB>, OR <SP>, RUBBING OUT AT LEAST
; ONE CHARACTER NOT IN THAT SET.
WDFLUS: PUSHJ P,RUBBER ; RETURNS DEAD CHAR IN A
JRST RCMDXX ; RAN OUT OF CHARACTERS
PUSHJ P,BREAK ; BREAK CHARACTER?
JRST WDFLU1 ; NO, SO GO TO SECOND LOOP
JRST WDFLUS ; KEEP TRYING
WDFLU1: JUMPE C,RCMD1
LDB A,B ; GET CHARACTER ABOUT TO FLUSH
PUSHJ P,BREAK
JRST WDFLU2
JRST RCMD1 ; FOUND A BREAK, SO STOP
WDFLU2: PUSHJ P,RUBBER
JRST RCMDXX
JRST WDFLU1
; SKIP IF CHARACTER IN A IS ONE OF <SP>, <CR>, <LF>, <TAB>, <;>
BREAK: CAIE A,^I
CAIN A,^J
JRST POPJ1
CAIE A,^M
CAIN A,40
JRST POPJ1
CAIN A,";
JRST POPJ1
POPJ P,
; 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
Reference in New Issue View Git Blame Copy Permalink