1 ; ******* THERE IS PROBABLY A LOSSAGE INVOLVED IN MAKING 'COMPARE' AN
2 ; ESSENTIAL QUESTION: IT ONLY WORKS (CAUSING OUTPUT OF REDO EVEN IF
3 ; COMPARE WASN'T ASKED IN THE COMPILATION TYPE) BECAUSE %ESSEN ISN'T
4 ; CHECKED IN DOCASK AND PROBABLY SHOULD BE.*****
19 BK=11 ; STACK OF FROBS FOR CTRL-R
20 OBSCEN=12 ; USED IN DOCOMM AS OFFSET INTO CTABLE
27 .XCREF O,A,B,C,D,E,F,G,H,P
37 ; OFFSETS IN NODES OF QUESTION TREE (POINTED TO BY OBSCEN), CONTAINED IN BLOCK
39 THISQ==0 ; -1, OR OFFSET OF QUESTION ASSOCIATED WITH THIS NODE
40 FORKS==1 ; SKIP,,NOSKIP OF INSTRUCTION EXECUTED AT THIS NODE
41 INST==2 ; INSTRUCTION TO EXECUTE
42 BACK==3 ; WHERE TO BACK UP TO
44 ; BITS IN LH OF THISQ SLOT OF TREE. ONLY MEANINGFUL IF %TNOTQ IS ON.
45 %TNOTQ==400000 ; I'M NOT REALLY A QUESTION, SO DON'T SET UP OUTPTR &C.
46 %TNBCK==200000 ; YOU CAN'T BACK UP TO ME, SO GO TO MY PREDECESSOR
47 %TNMEM==100000 ; DON'T REMEMBER ME: DON'T CLOBBER MY SUCCESSOR'S SLOT AT ALL.
50 BKPRPT==-3 ; SAVED PROMPT
51 BKRET==-2 ; SAVED RETURN ADDRESS
52 BKADDR==-1 ; ADDRESS TO PUSHJ TO
53 BKPSAV==0 ; SAVED P-STACK
55 $SSMAL==100 ; LOWEST SPECIAL TYPE IN TAILOR TABLE
56 $FINIS==100 ; SPECIAL IN TAILOR TABLE
57 $DELQ==101 ; DELETE QUESTION
58 $SQDEF==102 ; SET QUESTION DEFAULT
59 $PRTYP==103 ; PRINT CURRENT TYPE
61 $DLINK==105 ; DELETE LINK
62 $XLINK==106 ; EXPAND LINK
63 $XXLIN==107 ; EXPAND ALL LINKS
64 $LLINK==110 ; LIST LINKS TO ME
65 $PLINK==111 ; LIST LINKS FROM ME
67 ; LINK AREA DEFINITIONS
68 ; FORMAT IS: HEADER IS <- #LINKS HERE>
69 ; THEN N LINK POINTERS, AS NAME POINTER,,BLOCK POINTER (SO CAN BE USED AS SYMBOL TABLE)
70 LNKCNT==5 ; NUMBER OF WORDS ALLOCATED FOR LINKS IN A BLOCK
71 LNKHDR==<-LNKCNT>-1 ; OFFSET TO GET LINK HEADER
72 LNALEN==LNKCNT+1 ; # OF WORDS IN LINK AREA
74 ; TAILOR TABLE DEFINITONS
83 %GIGNO==40000 ; PRETEND THIS QUESTION DOESN'T EXIST
84 %NOQ==10000 ; DON'T SKIP THIS QUESTION EVEN IF CTRL-Q TYPED
87 %ESSEN==400 ; SAYS ALWAYS FROB THIS, REGARDLESS
90 %KILLB==%NSYSD+%TNMNY+%ESSEN+%RDCRT+%RDCMT+%NOQ
93 ; BITS DEFINED IN LH OF WORD 1 IN TAILORED GROUP
95 %TVERB==400000 ; TAILORING OF VERBOSITY
96 %NMRAS==200000 ; ASK 'Another compilation?' QUESTION (0==> ASK)
97 %MRANS==100000 ; IF NOT ASK, THE ANSWER (1==> YES)
98 %MNVRB==40000 ; INVERSE OF MUDVRB
99 %NWFMT==20000 ; NEW FORMAT FILE
100 %TFNEX==10000 ; ALLOW ONLY EXISTING FILES FOR INPUT&PRECOMP
102 ; BITS IN LH OF TAILOR BLOCKS (AND QTABLE FOR %TQID)
104 %TPLEN==301000 ; BITS FOR LENGTH OF BLOCK
105 %TQID==220600 ; BITS FOR QUESTION ID
107 ; BITS IN LH OF OUTPUT BLOCK
109 %DATAH==400000 ; SAYS OUTPUT HERE FROM HOW-TO-RUN ESCAPE
111 ; USED IN CMPBLKS: %ASK SAYS ASK ME, %IGNOR SAYS DON'T ASK ME, %DSUP
112 ; SAYS (ONLY IN USER TYPES) HE GAVE A DEFAULT WHICH SHOULD BE OUTPUT. TASTEFULLY
113 ; ENOUGH, THE DEFAULT IS COPIED TO THE OUTPUT BLOCK BEFORE THE QUESTION IS
119 ; IN RIGHT HALF, IDENTIFIES SPECIAL COMPILATION TYPES
122 FSPSIZ==6 ; SIZE OF BLOCK FOR FILE NAME
124 QNUM==-37. ; # OF WORDS IN BLOCK
126 CMPLEN==CMPSIZ+LNALEN ; # OF WORDS WITH LINK AREA INCLUDED
127 HOWLOC==39. ; OFFSET FOR HOW-TO-RUN TAILOR
128 MORLOC==38. ; OFFSET FOR MORE? TAILOR
130 ; OFFSETS INTO BLOCK IN CTABLE
137 PRINTC /Combat for ITS? (Y OR N)/
150 SUBTTL MACRO DEFINITIONS
163 ; INTERRUPT ENABLE/DISABLE
167 .SUSET [.SIDF2,,[1_TTYI]]
179 .SUSET [.SADF2,,[1_TTYI]]
189 ; SKIPS IF WORD IN AC IS >0 AND <3 (FILE NAME OF CTRL-X OR CTRL-Y)
196 ; SKIPS IF WORD IN AC IS <1 OR >2 (NOT OF SPNAME)
210 ; DECREMENT BYTE POINTER
217 ; LIKES FOO TO START AT INITIAL VALUE FOR TABLE. STORES AS VALUE OF SYMBOL
220 [ASCIZ /!NAME!/],,FOO
224 ; MAKES SYMBOL WITH SUPPLIED VALUE.
225 DEFINE SYMVAL NAME,VALUE
226 [ASCIZ /!NAME!/],,VALUE
229 ; TAKES LOCATION, SYMBOL. LOCATION GOES INTO DISPATCH TABLE, SYMBOL IS
230 ; == TO OFFSET INTO DISPATCH TABLE. DSPTBL==.+1 SHOULD PRECEDE DISPATCH
232 DEFINE DISPATCH LOC,VALUE
237 ; USED TO MAKE QTABLE.
238 DEFINE QUESTION BITS,ID,SYM,NAME
239 IFSN SYM,,[SYM==.-QTABLE]
240 BITS+ID,,[ASCIZ /NAME/]
243 ; USED TO MAKE OUTSPC (OUTPUT SPECIFICATION TABLE).
244 DEFINE OUTPUT TYPE,OFFSET,*HEADER*,TRAILER,NOHDR=0
246 TYPE,,[ASCIZ /HEADER/]
254 ; USED TO MAKE ERROR TABLE
255 DEFINE ERRMAC SYM,STRING\
263 .VALUE [ASCIZ /
\17:
\e\16 FATAL ERROR -- !NAME!
\17\e\16
281 ; MACROS USED ON CTRL-R STACK
292 ; DEFINE QTREE ENTRIES
293 DEFINE QTM SYM,QSYM,SYMYES,SYMNO,INST
314 SUBTTL VARIABLE DEFINITIONS
316 NMEMHK: 0 ; IF -1, LAST QUESTION ASKED HAD %TNMEM SET IN TREE
317 TPFUDG: 0 ; TO GET RIGHT TYPE TABLE AT GCOMTP
318 NOSIG: 0 ; DON'T SIGNAL DAEMON IF SET
319 WASTAG: 0 ; -1 ==> PRINTING OUT 'WASTE' INSTEAD OF 'PLAN'
320 SQDEF: 0 ; SET WHEN SETTING QUESTION DEFAULT
322 CVPOS: 0 ; CURSOR POSITION--USED IN RUBOUT ROUTINES
323 MDBKSV: 0 ; MDKILL SAVES BK HERE IN CASE CTRL-R TYPED IN MIDDLE
326 MDOVCF: 0 ; ERROR FLAGS
327 INREAD: 0 ; IF -1, IN READER
334 MULFLG: 0 ; USED TO SAY DON'T CRETINIZE
336 CMPSAV: 0 ; CONTAINS CURRENT COMPILATION TYPE
337 OUTBLK: 0 ; CURRENT OUTPUT BLOCK
338 OUTSTR: 0 ; FIRST OUTPUT BLOCK: START HERE
339 RVALS: 0 ; TAILORING AND HASK SAVE (OUTPTR) HERE
340 LONGOT: 0 ; -1 IF MOREING ON
341 LSTOUT: 0 ; LAST BLOCK OUTPUT, FOR FOLLOWING THE CHAIN
342 DEBUG: 0 ; DEBUGGING SWITCH: OUTPUT TO TTY
343 FSTBLK: 0 ; SAYS OUTPUTTING FIRST BLOCK IF -1
347 PSNAME: 0 ; SET BY SNAME QUESTION
348 PR2SW: -1 ; DEFAULTLY ON: PRINTING OF SEMANTIC PROMPT
349 MUDVRB: -1 ; LET MUDCOM PRINT CRAP
350 NMORAS: 0 ; DEFAULTLY OFF: ANOTHER COMPILATION? QUESTION
351 MORANS: 0 ; ANSWER TO ANOTHER COMPILATION IF NMORAS ON
352 DOEND: 0 ; USED IN OTREDO
353 ALTER: 0 ; SET BY ALTGRP TO GROUP BEING ALTERED
354 CTRLQ: 0 ; SET BY CONTROL-Q HACKER: DEFAULT TO END
355 RQUOTE: 0 ; QUOTE NEXT CHARACTER
375 TOERS: 0 ; -1 SAYS ERASE WORKS
376 TOFCI: 0 ; -1 SAYS TV KEYBOARD
377 MCHANG: -1 ; -1 SAYS NO MUDCOM AROUND
378 QVERS: 10 ; SHOULD BE AOSED WHEN QTABLE FROBBED
389 GPSAVE: 0 ; GACK SAVES PRMPT1 HERE
391 NODUMP: 0 ; INHIBIT DUMPING WHEN DO LOAD TAILOR OR REPLACE TAILOR
392 LDFLAG: 0 ; IF NON-0, CONS 'UNIQUE' NAME FOR EACH TYPE IN TAILOR
393 ERRFLG: 0 ; IF -1, PRINT ERROR WHEN FAIL TO FIND TAILOR FILE
397 TALSTR: BLOCK 2 ; CONTAINS TAILOR SNAME
398 TALSLN: 0 ; CONTAINS # CHARS THEREIN
400 TALDV: 1,,[ASCIZ /DSK/]
414 TALFN1: SIXBIT /%COMBT/
415 TALFN2: SIXBIT /TAILOR/
418 FILEXP: -1 ; IF 0, UNFILLED SLOTS IN FILE NAMES ARE LEFT EMPTY
419 SPCHR: 0 ; IF NON-ZERO, HAVE CTRL-X OR CTRL-Y HANGING AROUND
420 DIDEXP: 0 ; SET TO -1 BY GETFNM WHEN ^X OR ^Y ENCOUNTERED
430 SYSDEV: 1,,[ASCIZ /DSK/]
431 SYSDIR: 1,,[ASCIZ /CHOMP/]
433 SYSFN1: 1,,[ASCIZ /LOSER/]
434 SYSFN2: 1,,[ASCIZ />/]
438 SYSFN2: 1,,[ASCIZ /MUD/]
439 SYSGEN: 1,,[ASCIZ /0/]
443 FILPR2: ASCIZ /(FILE) /
444 FSPPR2: ASCIZ /(FILESPEC) /
445 STRPR2: ASCIZ /(TEXT) /
446 SYMPR2: ASCIZ /(SYM) /
447 LINPR2: ASCIZ /(LINE) /
449 TOPSTK: -40,,PDL-1 ; P FOR EMPTY STACK
454 TINBUF: BLOCK INPBLN ; SAVE CONTENTS OF BUFFER DURING GACK
466 .SMASK,,[%PIATY+%PIPDL]
467 SUSET: SUSETS-.,,SUSETS
474 CHNTAB: 1,,XCTRLS ; CHANNEL 0
493 2,,XINFER ; CHANNEL 19
495 BLOCK 15 ; CHANNEL 21-35
513 .SUSET C ; UNAME->B, SNAME->A, MEMT->FRETOP
516 .VALUE [ASCIZ /
\17:
\e\16LOG IN
\17\eKILL
\16
544 MOVE A,[ITYPLE,,TYPTBL]
549 OASC [ASCIZ /COMBAT./]
556 SETZM LDFLAG ; DON'T NEED TO UNIQIFY NAMES
562 SUBTTL MAIN QUESTION-ASKING LOOP
563 ; FIRST SETS UP STUFF FOR CTRL-R, THEN GOES INTO INFINITE LOOP: EXECUTE
564 ; INSTRUCTION, PROCEDE TO NEXT NODE ACCORDING TO WHETHER INSTRUCTION SKIPPED
565 ; OR NOT. AT NEXT NODE, CLOBBERS POINTER TO ANCESTOR, TO ENABLE BACKUP TO
566 ; IT. NOTE THAT IF THE QOFF SLOT AT THE CURRENT NODE IS <0, IT IS ASSUMED
567 ; THAT BACKUP TO THIS NODE IS IMPOSSIBLE; THEREFORE, BACKUP WILL BE TO
568 ; WHATEVER IS CONTAINED IN THE BACK SLOT.
569 ; TASTEFUL, TASTEFUL.
572 QDOAS1: MOVEI OBSCEN,QTREE
573 QDOAS2: PUSH BK,[0] ; NO PROMPT SAVED
576 PUSH BK,P ; SET THINGS UP FOR CTRL-R
577 QDONXT: SKIPGE A,THISQ(OBSCEN)
583 ADD CMPBLK,A ; SET UP AC'S IF QUESTION BEING ASKED
584 QNOTQ: XCT INST(OBSCEN) ; DO IT
588 QLOST: HRRZ A,FORKS(OBSCEN)
589 QNEXT: SKIPL B,THISQ(OBSCEN) ; A REAL QUESTION?
593 TLNN B,%TNBCK ; UNREAL QUESTION: DON'T BACK UP TO ME
595 MOVE OBSCEN,BACK(OBSCEN) ; YES, SO DON'T BACK UP TO IT
596 QADV: MOVEM OBSCEN,BACK(A) ; WHERE TO BACK UP TO
597 QADV1: MOVE OBSCEN,A ; CLOBBER POINTER
598 JRST QDONXT ; AND GO TO THE NEXT ONE
602 JRST QDONXT ; RETURN FROM ^G ^R
605 SUBTTL ASK WHICH COMPILATION TYPE
606 ; PUSHJ P, TO HERE TO GET A COMPILATION TYPE. IF A SPECIAL TYPE, DOESN'T
607 ; SKIP; IF NORMAL (QUESTIONS TO BE ASKED), DOES.
608 GCOMTP: MOVE A,TYPLEN
609 SUB A,TPFUDG ; SET BY MORCMP TO 1,,1 IN SOME CASES
610 MOVEI B,[ASCIZ /Type of compilation /]
612 PUSHJ P,COMTYP ; GET COMPILE TYPE NAME,,TABLE FOR IT IN A
613 MOVE CMPBLK,A ; COMPILATION TYPE
614 TRZE A,$SPTYP ; SKIPS IF NON-SPECIAL COMPIL TYPE
615 JRST [PUSHJ P,@SPTYPE(A) ; SPTYPE IS DISPATCH TABLE FOR LOAD, PRINT,ETC.
617 PUSHJ P,LINKX ; EXPAND LINKS
618 MOVEI A,CMPSIZ+2 ; GET CORE FOR COMPILATION--POINTER IN A
620 SETOM FILEXP ; CAUSE FILE NAMES TO BE EXPANDED IN PARSER
621 SKIPE MNYFLG ; IF 'MANY', CHAIN THIS BLOCK TO PREVIOUS BLOCK
622 JRST [MOVE OUTPTR,OUTBLK
623 MOVEM A,CMPSIZ+1(OUTPTR) ; POINTER GOES IN LAST WORD OF BLOCK
625 MOVEM A,OUTSTR ; IF NOT MANY MODE SAVE BLOCK: 1ST IN CHAIN
626 OTINIT: MOVEM A,OUTBLK ; SAVE POINTER TO TOP OF OUTPUT BLOCK
627 MOVEM A,OUTPTR ; AC POINTER TO CURRENT OUTPUT SLOT
628 MOVEM CMPBLK,CMPSIZ(OUTPTR) ; SAVE COMPILATION TYPE WITH OUTPUT BLOCK
630 SETZM CTRLQ ; NOT IN CTRLQ ANY MORE
631 JRST POPJ1 ; AND SKIP
633 SUBTTL NORMAL QUESTIONS
634 ; PUSHJ P, TO HERE TO ASK NORMAL SORTS OF QUESTIONS. ASSUMES CMPBLK, QOFF, OUTPTR
635 ; SET UP APPROPRIATELY. SKIPS IF ANSWER GIVEN OR (IN CASE OF T/F) IF TRUE GIVEN.
638 ASKQ1: MOVE B,(CMPBLK)
639 MOVE A,QTABLE(QOFF) ; GET QUESTION DESCRIPTION
640 TLNE A,%GIGNO ; DOES THE QUESTION REALLY EXIST?
641 POPJ P, ; NO, GO ON TO NEXT
642 SKIPE CTRLQ ; CTRL-Q TYPED IN THIS COMPILATION
644 NOQ: TLNE B,%IGNOR ; DOES LOSER WANT THIS QUESTION ASKED?
645 JRST DEFHAK ; NO, DEFAULT
646 TLNE A,$TFILE ; SKIP IF NOT FILE-SPEC
647 JRST [PUSHJ P,DEFILE ; SETS UP FILE DEFAULTS, SETS SYS DEFAULTS
649 PUSHJ P,NRMDEF ; DOESN'T SKIP RETURN--SETS UP OTHER DEFAULTS
650 ASKMNY: MOVE A,QTABLE(QOFF)
651 TLNE A,%TNMNY ; SKIP THIS QUESTION IF IN MANY MODE
652 JRST [SKIPN MNYFLG ; IN MANY MODE?
656 JRST TFASK ; HACK FOR T/F, SINCE COMPLETION MAY SCREW IT UP
657 PUSHJ P,ASK ; ASK THE QUESTION
658 POPJ P, ; IF HE TYPED NOTHING?
662 HRRZ A,(OUTPTR) ; GET ANSWER
663 JUMPN A,POPJ1 ; IF ANSWERED YES
666 ; HERE FOR CERTAIN FILE QUESTIONS WHICH WANT TO SEE IF FILE EXISTS WHEN
667 ; GIVEN (USED FOR INPUT, PRECOMPILATION). CALLS ASKQ, DOES FUNNINESS IF
671 JRST [MOVE A,QTABLE(QOFF)
676 FASKQ1: MOVE B,(OUTPTR) ; POINTER TO FILE NAME
707 OASC [ASCIZ /WARNING: Open of /]
715 SKIPN FILEXI ; IF THE MUST EXIST FLAG IS SET
716 POPJ P, ; THEN DON'T DO ANYTHING - HE'S BEEN TOLD
717 PUSH P,B ; SAVE FILE NAME POINTER
718 SKIPN JFN ; HM. THIS IS A DEFAULT, CHOMP!
720 MOVEI A,20. ; GET A BLOCK FOR JFNS
724 MOVE B,JFN' ; GET BACK THE FUNNY JFN
727 JFNS ; GET THE REAL STRING
728 MOVSI A,(GJ%OLD+GJ%SHT)
731 GTJFN ; GET A REAL FILE-OPENING JFN
734 FASKQ4: MOVE B,[440000,,OF%RD]
743 JRST POPAJ ; DONT COMPLAIN IF FLAGS SET
746 OASC [ASCIZ /WARNING: Open of /]
749 OASCR [ASCIZ / failed./]
752 FASKQ3: MOVE C,[-4,,GTJFN3+.GJDEV]
770 ECHON1: TLO C,24 ;MAKE ^X AND ^Y WORK
792 ; HACKER WHEN IN CTRLQ MODE: A HAS QTABLE SLOT, B HAS CMPBLK SLOT
793 QUACK: TLNE A,$TFILE ; FILE-TYPE QUESTION?
795 QDEFLT: TLNE A,%NOQ ; ASK THIS EVEN IF CTRL-Q TYPED
797 HRRZ B,(CMPBLK) ; DO DEFAULT
802 QFILE: TLNE A,%DSUP+%ESSEN ; IF USER SUPPLIED DEFAULT, ESSENTIAL, DO THAT.
808 ; ASK SNAME QUESTION: GET STRING, CONVERT TO SIXBIT AND STUFF IN PSNAME
810 ASKSNM: MOVE B,(CMPBLK)
811 PUSHJ P,NRMDEF ; PICK UP DEFAULT
815 JRST ASNMDO ; PICK UP DEFAULT AND LEAVE
816 PUSHJ P,ASK ; ASK THE QUESTION
818 ASNMDO: PUSHJ P,ASNMD1
821 ; CALLED FROM HERE AND FROM HASK (HSNAM)
822 ASNMD1: HRRZ A,(OUTPTR) ; GET THE ANSWER
823 JUMPE A,CPOPJ ; IF 0, LET IT GO
824 HRLI A,440700 ; BP TO ANSWER
827 PUSHJ P,IBLOCK ; GET ANOTHER BLOCK CORRECT LENGTH
829 HRLI B,440700 ; MAKE BP TO NEW BLOCK
832 HRLM C,(P) ; WORD COUNT
833 ASNMLP: ILDB O,A ; GET A CHAR
835 JRST ASNMDN ; ; TERMINATES
837 JRST ASNMLP ; IGNORE "
841 JRST ASNMDN ; FALL OUT
851 POPJ P, ; DIDN'T GET ANYTHING
853 MOVEM A,PSNAME ; SAVE RESULT AWAY
858 SUBTTL GET HOW-TO-RUN
859 ; AFTER ALL QUESTIONS HAVE BEEN ASKED, COME HERE TO DETERMINE HOW-TO-RUN.
860 ; NORMALLY WILL PRINT OUT PLAN, POSSIBLY SIGNAL DAEMON, ETC. IF 'QUESTION'
861 ; ESCAPE IS USED, WILL SKIP-RETURN; QUESTION ESCAPE IS NEXT IN TREE. OTHERWISE,
862 ; WILL NOT SKIP; IN THIS CASE, (ASSUMING WE GET BACK HERE AT ALL), QUESTIONING
863 ; WILL CONTINUE WITH ANOTHER COMPILATION TYPE.
864 DONE: MOVE A,OUTBLK ; PICK UP POINTER TO TOP OF CURRENT CMPBLK
866 MOVE A,HOWLOC(A) ; GET HOW TO RUN SPEC
869 DONE1: MOVE A,[HOWTLN,,HOWTBL] ; ASK HOW TO RUN: PTLONG JRST HERE, TOO.
870 MOVEI B,[ASCIZ /How to Run /]
872 PUSHJ P,COMTYP ; ANSWER IN A
873 HOWGO: PUSHJ P,@HOWRUN (A) ; GO TO PROPER ROUTINE FOR FROBBING PLAN OUT
874 ; PCOMP WILL START UP & DIE IF APPROPRIATE, COMBAT WILL DEMSIG ZONE IF APPROPRIATE
875 ; RETURN HERE IFF IN MANY OR LOSER SAYS HE HAS MORE. MNYFLG SET APPROPRIATELY.
876 ; IN MANY, WILL STRING OUTBLKS TOGETHER; IN MULTIPLE, WILL WASTE. QUESTION MODE
877 ; SKIP RETURNS, AND DOES NOTHING ELSE.
878 JRST [SETZM BACK(OBSCEN)
881 JRST DONE1 ; HPRTHK SKIPS TWICE, SO WE LOOP BACK
884 SUBTTL DEFAULT HACKERS
885 ; IF QUESTION IS NOT TO BE ASKED, MOVES DEFAULTS OVER TO OUTPUT BLOCK. NORMALLY
886 ; PICKS UP RIGHT HALF OF CMPBLK WORD, STUFFS IT IN OUTBLK. SPECIAL HACKING FOR
892 TLNE A,$TFILE ; SPECIAL HACKING FOR FILE NAMES
896 HRRM A,(OUTPTR) ; SMASH SUPPLIED DEFAULT INTO OUTPUT BLOCK
897 RDEF: MOVE B,(CMPBLK)
898 TLNE B,%DSUP ; DID HE REALLY GIVE AN ANSWER?
899 JRST POPJ1 ; YES, SO SKIP RETURN
902 ; PRETENDS TO ASK FILE QUESTION IF DEFAULT SUPPLIED. FILLS IN THINGS NOT SUPPLIED
903 ; FROM SYSTEM DEFAULTS (UNLESS %NSYSD), AND SETS SYSTEM DEFAULTS WHERE THINGS SUPPLIED.
904 DEFILE: HRRZ A,(CMPBLK) ; IF NO DEFAULT HERE, GO TO HAKFIL, WHICH
905 JUMPE A,HAKFIL ; (IF %ESSEN) WILL GET THE DEFAULTS FROM VTABLE
906 PUSHJ P,FILDEF ; STUFF IN DEFAULTS IF SUPPLIED
908 ; SETS SYSTEM DEFAULTS, FILLS IN SUPPLIED DEFAULT FROM SYSTEM DEFAULTS, UNLESS %NSYSD.
909 SETDEF: MOVE A,QTABLE(QOFF)
910 TLNE A,%NSYSD ; NO SYS DEFAULTS?
911 POPJ P, ; YES. GO AWAY.
912 MOVE A,(OUTPTR) ; MAKE AOBJN POINTER TO OUTPUT FILE NAME
914 MOVEI C,SYSDEV-1 ; GET POINTER TO SYSTEM DEFAULTS
917 SKIPN B,(A) ; SKIP IF NON-ZERO (==> EXISTS OR ^X,^Y) ENTRY
918 JRST DEFSYS ; ZERO-->USE SYS DEFAULT
919 PUSHJ P,GETFNM ; EXPAND CTRL-X, CTRL-Y
920 MOVEM B,(A) ; STUFF EXPANDED NAME OUT
921 MOVEM B,(C) ; SET SYSTEM DEFAULT
922 JRST DEFLPE ; AND TRY AGAIN
925 DEFLPE: AOBJN A,DEFLP
930 TLNE A,%ASK ; QUESTION IS BEING ASKED, SO DON'T PRINT
940 ; HERE TO DO 'RIGHT THING' IF %IGNOR & %ESSEN ARE
941 ; SET AND FOR FILE NAME: GET THE DEFAULT ANYWAY
942 ; JRSTED TO FROM DEFILE. RETURNS TO SETDEF
943 HAKFIL: MOVEI A,FSPSIZ
947 TLNN A,%ESSEN ; NOT ESSENTIAL, SO LEAVE
950 MOVEI CMPBLK,VTABLE(QOFF) ; GET DEFAULT FROM VTABLE
951 PUSHJ P,FILDEF ; SET IT UP
955 ; EXPECTS POINTER TO OUTPUT SLOT IN OUTPTR, TO CMPBLK SLOT IN CMPBLK. BLTS
956 ; COPY OF FILE-DEFAULTS SUPPLIED IN CMPBLK TO A NEW BLOCK, PUTS POINTER TO
957 ; SAME IN OUTPUT SLOT. IF NO DEFAULT GIVEN, WILL LEAVE OUTPUT SLOT POINTING AT
958 ; FOUR WORDS OF ZERO.
959 FILDEF: MOVEI A,FSPSIZ
961 MOVEM A,(OUTPTR) ; POINTER TO FILE-NAME BLOCK
962 HRLZ B,(CMPBLK) ; POINTER TO DEFAULT
963 JUMPE B,POPJ1 ; NO DEFAULT SUPPLIED, TOO BAD.
964 HRR B,A ; POINTER TO NEW BLOCK
965 BLT B,FSPSIZ-1(A) ; MOVE 'EM OVER
968 ; DOES DEFAULT IN SIMPLE (NON FILE-NAME) CASE: PICK IT UP AND PUT IT BACK DOWN.
969 NRMDEF: HRRZ A,(CMPBLK)
977 TLNE O,700000 ; SKIPS IF THIS IS A STRING TYPE
978 JUMPN C,RCMDL ; MUST BE FIRST CHARACTER TYPED IF NOT
979 TLNE O,%RDCMT ; CONTROL-G ALLOWED?
980 JRST [OASCR [ASCIZ /^G disabled/]
981 JRST RREPEA] ; MAKE IT LIKE CONTROL-D IF NOT
983 PUSHJ P,SINBUF ; COPY INPUT BUFFER IF STRING TYPE
985 PUSH BK,-3(BK) ; SAME RETURN ADDRESS AS BEFORE
987 PUSH BK,[[POPJ P,]] ; ALWAYS SKIP, DO NOTHING
988 PUSH BK,-3(BK) ; SAME STACK
992 PUSH P,C ; SAVE BUFFER POINTER AND COUNT
993 MOVEI B,[ASCIZ /Get from type /]
996 PUSHJ P,GETTP1 ; GET GROUP IN A
1000 SUB P,[2,,2] ; FLUSH SAVED BUFFER
1001 JRST RSTBF1] ; COMES HERE IF NO TYPES EXIST
1005 MOVE CMPBLK,A ; STUFF INTO CMPBLK
1006 PUSHJ P,LINKX ; EXPAND LINKS
1010 ADDI A,(QOFF) ; GET REAL CMPBLK SLOT
1011 MOVE D,(A) ; GET CONTENTS OF BLOCK IN D
1012 TLNN D,%DSUP ; USER-SUPPLIED DEFAULT HERE?
1013 JRST [OASC [ASCIZ /Type doesn't define this slot./]
1018 LDB B,[410300,,GPSAVE] ; GET TYPE OF INPUT
1021 JRST @GETTBL (B) ; GO TO APPROPRIATE ROUTINE
1033 SKIPN P,BKPSAV(BK) ; ????????
1037 POPJ P, ; SO FILE-HACKERS CAN NOT SKIP-RETURN
1040 GETTF: MOVEM D,(OUTPTR)
1044 ; PUTS STUFF IN INPUT BUFFER, LETS PERSON EDIT/CONFIRM/ETC.
1045 ; ENTERS WITH BLOCK POINTER IN D (ALSO (A)), MUST LEAVE (TO REPPER)
1046 ; WITH C CONTAINING # CHARACTERS, B CONTAINING BPTR TO LAST CHAR.
1051 POP P,B ; RESTORE BUFFER
1056 JUMPE A,REPPER ; STRING IS ASCIZ
1060 GETFIL: JUMPE D,GETFLS ; OLD IN D
1063 MOVEM A,(OUTPTR) ; NEW IN A
1065 MOVEI B,SYSDEV ; SYS IN B
1069 MOVEM E,(B) ; SET SYS DEFAULT
1070 MOVEM E,(A) ; PUT IN OUTBLK
1072 OASC (C) ; PRINT BREAK CHARACTER
1079 GETFLS: SETZM (OUTPTR)
1084 RACK: SETZM CTRLQ ; CLOBBER CTRLQ
1085 SETZM INREAD ; NOT IN READER ANY MORE
1086 SKIPE A,BKPRPT(BK) ; PROMPT?
1087 MOVEM A,PRMPT1 ; RESTORE IT
1088 PUSHJ P,@BKADDR(BK) ; FROB AWAY
1091 BKOFF ; FLUSH THIS ONE
1094 ; STANDARD ROUTINE FOR BACKING UP IN QUESTIONS
1095 STDBCK: SKIPL THISQ(OBSCEN)
1096 SETZM (OUTPTR) ; DON'T FORGET THIS QUESTION
1097 STDBC1: SKIPN OBSCEN,BACK(OBSCEN) ; BACKUP IS 0?
1098 JRST TOPLEV ; FLUSH EVERYTHING
1099 MOVE C,THISQ(OBSCEN) ; PICK UP QUESTION OFFSET
1100 CAMN C,[-1] ; NOT A QUESTION
1102 JUMPL C,CPOPJ ; A 'SYSTEM QUESTION'; ALWAYS STOP
1103 MOVE B,QTABLE(C) ; THIS QUESTION
1105 JRST STDBC1 ; QUESTION IS GLOBALLY OFF, SO CAN'T STOP HERE
1108 SETZM (OUTPTR) ; CLOBBER SLOT IN OUTPUT BLOCK
1110 ADD CMPBLK,C ; POINTER TO COMPILE TYPE SLOT
1112 TLNN A,%ASK ; ASK THIS QUESTION?
1116 TOPLEV: MOVE P,TOPSTK
1120 SKIPN MNYFLG ; IF IN MANY MODE, ONLY KILL THIS ONE
1121 JRST QDOAS1 ; ASK COMPILATION TYPE
1123 ; AT THIS POINT, WE KNOW THAT THERE ARE AT LEAST TWO OUTPUT BLOCKS ON THE CHAIN,
1124 ; AND THAT THE LAST ONE WANTS TO BE ABORTED. TO DO THIS, IT IS NECESSARY TO MAKE
1125 ; OUTBLK POINT TO THE NEXT-TO-LAST OUTPUT BLOCK (WHICH NOW POINTS TO THE LAST ONE),
1126 ; AND TO ZERO THE NEXT BLOCK POINTER IN IT.
1127 MOVE A,OUTSTR ; FIRST BLOCK
1128 MOVE B,OUTBLK ; LAST BLOCK
1129 TOPLOP: MOVE O,CMPSIZ+1(A) ; POINTER TO NEXT BLOCK
1130 CAIN O,(B) ; IS THE 'NEXT BLOCK' THE LAST ONE?
1132 MOVE A, ; ADVANCE POINTER
1134 TOPLOT: MOVEM A,OUTBLK ; SAVE AWAY WINNING POINTER
1135 SETZM CMPSIZ+1(A) ; ZERO ITS NEXT-BLOCK POINTER
1136 JRST QDOAS1 ; AND LEAVE
1139 SUBTTL MUDCOM INTERFACE
1141 MCASCI: HRLI D,440700
1149 ; STUFF AN ENTIRE FILE NAME INTO THE JCL BUFFER
1150 ; IN B, A POINTER TO A FILE BLOCK
1151 ; IN C, BYTE POINTER TO JCL BUFFER
1172 PUSHJ P,XFNEXP ; EXPAND FILE NAME
1180 MCFNF: OASC [ASCIZ /File not found - /]
1189 ; IN A, A POINTER TO A FILE NAME BLOCK (FROM COMPARE QUESTION)
1190 ; OR 0, IF NO NAME GIVEN
1192 MUDCOM: OASC [ASCIZ /
1195 MOVE B,[MCJCLB,,MCJCLB+1]
1197 BLT B,MCJCLL-1(C) ; CLEAR JCL BLOCK
1198 MOVE C,[440700,,MCJCLB] ; POINTER TO JCL BLOCK
1199 SKIPN -1(OUTPTR) ; YES OR NO TO MANIFEST QUESTION?
1214 SKIPN B,(OUTPTR) ; EXTRA JCL?
1218 JUMPE O,MUDFI1 ; DONE?
1223 MUDFIL: MOVE B,-2(OUTPTR) ; POINTER TO COMPARE FILE BLOCK
1224 MOVE D,3(B) ; FILE NAME 2
1225 MOVE D,(D) ; POINTER TO ASCIZ OF FILE NAME 2
1226 CAMN D,[ASCIZ /NBIN/] ; NBIN HACK?
1227 JRST [MOVE B,OUTBLK ; YES, DO FILES IN OTHER ORDER
1236 PUSHJ P,MCFILE ; STUFF IT OUT
1237 SETZM -2(OUTPTR) ; AND ZERO IT
1238 MOVEI D,", ; DEPOSIT A COMMA
1240 MOVE B,OUTBLK ; POINTER TO INPUT FILE BLOCK
1242 PUSHJ P,MCFILE ; PUT INPUT FILE INTO BLOCK
1244 IDPB D,C ; FINISH THE JCL BLOCK
1246 MUDSTT: .CALL [SETZ ; OPEN TS MUDCOM
1253 SETZ [SIXBIT /SYS/]]
1255 SETZM MCHANG ; SAY INFERIOR EXISTS
1256 .CALL [SETZ ; OPEN THE INFERIOR
1262 SETZ [SIXBIT /MUDCOM/]]
1264 PUSH P,[RACK] ; SO ERRPRT WILL RETURN TO WINNAGE
1268 .CALL [SETZ ; GET IT A PAGE ONE
1275 .USET MCINFO,[.RINTB,,RET] ; READ THE INTERRUPT WORD
1276 .SUSET [.SIMSK2,,RET] ; SET UP INTERRUPT FOR THIS
1277 .ACCESS MCINFO,[100] ; GO TO 100
1278 MOVE B,[-MCJCLL,,MCJCLB]
1279 .IOT MCINFO,B ; AND IOT THE JCL
1282 .CALL [SETZ ; LOAD TS MUDCOM
1287 MOVE B,[-1,,C] ; READ THE STARTING ADDRESS
1289 .CLOSE MCFILI, ; CLOSE THE FILE
1291 TLZ C,-1 ; CLEAR THE LEFT HALF
1292 .USET MCINFO,[.SUPC,,C] ; SET UPC
1301 MUDBEG: .USET MCINFO,[.SUSTP,,[0]] ; START IT UP
1303 .HANG ; WAIT FOR INTERRUPT
1307 .USET MCINFO,[.RSV40,,C]
1318 .USET MCINFO,[.SPIRQ,,[0]]
1319 .USET MCINFO,[.SUSTP,,[0]]
1322 MCHEND: .CALL [SETZ ; OPEN A READ CHANNEL TO INFERIOR
1328 SETZ [SIXBIT /MUDCOM/]]
1331 .ACCESS MCFILI,[1] ; GET TO WORD 1
1333 .IOT MCFILI,B ; READ IT (0 = WINNAGE 1+ = ERROR CODE)
1336 .IOT MCFILI,B ; READ CHARACTER COUNT
1337 TDNE C,[-1,,770000] ; GARBAGE FROM MUDCOM?
1341 .IOT MCFILI,B ; READ LOCATION OF RETURN
1342 .ACCESS MCFILI,D ; ACCESS THERE
1344 ADDI C,1 ; NUMBER OF WORDS NEEDED
1346 MOVSS D ; TO LEFT HALF
1348 .IOT MCFILI,D ; IOT IN THE RETURN
1349 .UCLOSE MCFILI, ; FLUSH THE JOB
1352 MUDSTT: MOVSI A,(CR%CAP)
1353 SETZM MCHANG ; SAY WE'RE IN MUDCOM NOW
1356 MOVEM A,MCHNDL' ; SAVE PROCESS HANDLE
1357 MOVSI A,(GJ%SHT+GJ%OLD)
1358 MOVE B,[-1,,[ASCIZ /SYS:MUDCOM.EXE/]]
1359 GTJFN ; JFN FOR FILE
1361 HRL A,MCHNDL ; HANDLE,,JFN
1364 GEVEC ; GET ENTRY VECTOR
1365 PUSH P,B ; SAVE STARTING ADDRESS, ETC
1367 RSCAN ; PUT JCL IN BUFFER
1370 RSCAN ; THIS IS A CROCK. I HATE 20X!
1374 ADDI B,1 ; STARTING ADDRESS IS START+1
1378 JFCL ; RETURNS HERE FROM XINFER
1381 RFACS ; GET THE AC'S
1385 RSCAN ; CONS COUNT OF JCL
1389 MOVE B,[440700,,INPBUF]
1392 MOVE C,MCACS+B ; GET COUNT IN C
1396 KFORK ; KILL THE MUDCOM
1400 ; AT THIS POINT IN TIME, THE RETURN FROM MUDCOM IS IN INPBUF
1401 ; THE LENGTH IN WORDS OF THE RETURN IS IN C
1403 MCPARS: MOVE A,[440700,,INPBUF]
1408 MCPAKL: ILDB B,A ; GET LENGTH OF PACKAGE IN CHARS
1411 IDIVI D,5 ; GET LENGTH IN WORDS
1414 PUSHJ P,IBLOCK ; GET A BLOCK OF THAT LENGTH
1417 HRLI E,440700 ; GET BYTE POINTER TO BLOCK
1418 MOVE A,[440700,,INPBUF] ; GET BYTE POINTER TO INPUT
1420 ILDB B,A ; READ OFF THE INITIAL "
1421 DPB D,A ; ZERO THE CHARACTER
1425 DPB D,A ; ZERO THE CHARACTER
1426 IDPB B,E ; STUFF IN BLOCK
1435 MCNOPK: MOVE A,C ; NUMBER OF WORDS FOR ATOMS
1437 PUSHJ P,IBLOCK ; GET A BLOCK
1442 BLT A,(C) ; BLT INTO NEW BLOCK
1459 JUMPN C,MCERR1 ; ERROR FROM INTERRUPT HANDLER?
1462 MOVE C,MCACS+A ; ERROR CODE FROM AC A
1466 MUDCOM returned abnormally: /]
1469 JRST [OASC [ASCIZ /.LOSE/]
1472 JRST [OASC [ASCIZ /MPV/]
1479 JRST [OASC [ASCIZ /ILOPR/]
1481 MCERUN: OASC [ASCIZ /Unspecified lossage/]
1482 MCERFN: OASC [ASCIZ / at /]
1483 .USET MCINFO,[.RUPC,,A]
1487 Return ignored. Inferior saved for debugging./]
1491 MCIOC: .USET MCINFO,[.RBCHN,,A]
1502 MOVE A,[440700,,INPBUF]
1514 OASC [ASCIZ /IOCERR: /]
1518 MCVAL: .USET MCINFO,[.RSV40,,A]
1520 JUMPE A,[OASC [ASCIZ /.VAL 0/]
1522 .USET MCINFO,[.RUIND,,C]
1532 MOVE A,[-10,,INPBUF]
1538 OASC [ASCIZ /Unresolved??/]
1550 ERROR from MUDCOM - /]
1552 MCERRO: SETZM (OUTPTR)
1562 [ASCIZ /Self Comparison/]
1564 [ASCIZ /Syntax Error/]
1565 [ASCIZ /Open Failed/]
1566 [ASCIZ /INTERNAL BUG/]
1567 [ASCIZ /No Differences Encountered?/]
1568 [ASCIZ /No Similarities Encountered?/]
1569 [ASCIZ /No Changes Encountered/]
1570 [ASCIZ /MUDCOM returned garbage--result ignored./]
1572 SUBTTL HOW TO RUN & SPECIAL COMPILATION TYPES
1574 ; TABLE OF POINTERS TO HOW-TO-RUN ROUTINES
1575 DSPTBL==.+1 ; OFFSET FOR DISPATCH MACRO
1576 HOWRUN: DISPATCH COMBAT,.HCOMBT ; DEMON
1577 DISPATCH FILOUT,.HFILE ; FILE AS SNAME;PLAN >
1578 DISPATCH PCOMP,.HPCOMP ; FILE AS SNAME;PCOMP > & START PCOMP
1579 DISPATCH WASTE,.HWASTE ; PUT ON LOW-PRIORITY QUEUE
1580 DISPATCH MANY,.HMANY ; LONG PLAN
1581 DISPATCH TOPLEV,.HABRT ; ABORT PLAN
1582 DISPATCH HASKHK,.HQUES ; ASK A QUESTION ON NEXT LOOP
1583 DISPATCH HPRTHK,.HPRIN ; PRINT PLAN TO TTY
1585 ; TABLE OF POINTERS TO ROUTINES FOR SPECIAL COMPILATION TYPES
1587 SPTYPE: DISPATCH MULTPL,.TMULT ; MULTIPLE COMPILATIONS
1588 DISPATCH QUIT,.TQUIT ; BYE
1589 DISPATCH ALTGRP,.TALTG ; ALTER GROUP
1590 DISPATCH PRTGRP,.TPRTG ; PRINT GROUP
1591 DISPATCH CRTAIL,.TCRTG ; CREATE GROUP
1592 DISPATCH GETAIL,.TLDTL ; LOAD TAILOR
1593 DISPATCH RPTAIL,.TRPTL ; REPLACE TAILOR
1594 DISPATCH DELGRP,.TDELG ; KILL GROUP
1595 DISPATCH VERBOS,.TTOGV ; VERBOSITY
1596 DISPATCH MVERBO,.TTOMV ; MUDCOM VERBOSITY
1597 DISPATCH FEXIST,.TTOEX ; FILES MUST EXIST (GLOBAL - IN TAILOR)
1598 DISPATCH XEROX,.TXROX ; COPY GROUP
1599 DISPATCH RENAME,.TRNM ; RENAME
1600 DISPATCH SETMOR,.TSMOR ; ANSWER 'ANOTHER COMPILATION?'
1601 DISPATCH PTLONG,.TPLON ; PRINT ACCUMULATED PLAN
1602 DISPATCH FLUSH,.TFLUS ; GET RID OF LONG COMPILATION
1603 DISPATCH LSTLNK,.TLNKL ; LIST LINKS
1604 DISPATCH MYLINK,.TMLNK
1606 ; HOW-TO-RUN ROUTINES: COMBAT (DEFAULT), FILOUT, PCOMP, AND MANY
1607 FILOUT: MOVE A,[SIXBIT /PLAN/]
1619 PCOMP: SETOM PCOMPF ; SAYS THAT NEED TO START PCOMP WHEN LEAVE
1620 MOVE A,[SIXBIT /PCOMP/]
1633 TDNE O,.QNEWC(A) ; IS THIS OLD COMPILER?
1634 SETOM NCOMPF ; NO, SO WHEN LEAVE SAY :NPCOMP
1637 MANY: SETOM MNYFLG ; MANY MODE: SET FLAG, GET ANOTHER
1641 XIOPSH: MOVE O,OUTJFN'
1655 ; LOW-PRIORITY PLANS: GO TO COMBAT;WASTE >, OTHERWISE IDENTICAL WITH COMBAT.
1656 WASTE: MOVE A,[SIXBIT /WASTE/]
1660 ; DEFAULT: PLAN TO COMBAT;PLAN >.
1663 MOVE A,[SIXBIT /PLAN/]
1667 MOVE A,[SIXBIT /PLAN/]
1669 COMBT1: MOVE B,[2,,[ASCIZ /COMBAT/]]
1677 MOVEI B,[ASCIZ /COMBAT #/]
1679 MOVEI B,[ASCIZ /WASTAGE #/]
1682 OASCR [ASCIZ / scheduled./]
1684 CAME A,[SIXBIT /1/] ; IF NOT PLAN 1, DON'T NEED TO SIGNAL
1687 JRST HRCHK ; WASTES DON'T CARE ABOUT WEEKENDS
1689 LDB A,[320300,,A] ; IS IT A WEEKEND?
1694 LDB A,[301400,,A] ; IS IT OFFICE HOURS?
1695 SKIPE WASTAG ; OFFICE HOURS DEFINED DIFFERENTLY
1700 JRST SSTATU] ; OTHERWISE CAUSE THE CROCK TO COME UP
1705 .CALL HOLOPN ; IS IT A HOLIDAY?
1706 JRST SSTATU ; OTHERWISE, DO STDMST
1709 OASCR [ASCIZ /Demon signalled./]
1711 .CALL DEMSIG ; START UP COMBAT
1715 SSTATU: .CALL RQDATE ; GET HALF-SEC SINCE MIDNIGHT IN B
1719 JRST [MOVEI A,120.*65.
1720 CAILE B,7200. ; HALF-SEC BETWEEN MIDNIGHT & 1AM
1721 MOVEI A,<25.*7200.>+<5*120.> ; IF BEFORE MIDNIGHT
1723 MOVEI A,1205.*120. ; HALF-SEC BETWEEN MIDNIGHT & 8PM
1724 SSTAT1: SUB A,B ; HALF-SEC NOW TO 8PM
1725 IDIVI A,240. ; CONVERT TO TWO-MINUTE TICKS
1726 .CALL RDDMST ; IDX--\>B, TIME TO SIGNAL TO C
1728 JUMPN B,MORCMP ; DEMON ALREADY UP
1729 JUMPE B,SSTAT2 ; IF NEVER COMING UP...
1730 CAIL A,B ; WOULD WE CAUSE IT TO COME UP SOONER?
1732 SSTAT2: .CALL STDMST ; YES, SO SET IT
1754 SETZ [SIXBIT /COMBAT/]
1780 ; COME HERE TO PRINT CURRENT PLAN TO TTY. SETS UP MOREAGE, SAVES SUITABLE
1781 ; AC'S, GOES TO FUNNY ENTRY TO PTPLAN. EVENTUALLY SKIPS TWICE, SO HOW-TO-RUN
1788 SETOM LONGOT ; ENABLE MORES
1790 PUSHJ P,PTPLA1 ; DO PRINTING
1791 HPROUT: SETZM LONGOT
1798 ; 'QUESTION' ESCAPE FROM HOW TO RUN: ASKS FOR QUESTION, STUFFS ANSWER IN OUTBLK,
1799 ; RETURNS TO HOW TO RUN VIA SKIP-RETURN. CALLED VIA JSP, RETURN ADDRESS IN RET.
1800 ; THIS ALLOWS PROPER HANDLING OF CTRL-R FROM THE 'Question' QUESTION.
1803 HASK1: MOVE A,[TAILEN+TALSPC,,TAILTB] ; TABLE OF REASONABLE QUESTIONS
1804 PUSH BK,PRMPT1 ; FROM HERE, RETURN TO NORMAL LOOP
1806 PUSH BK,[HSKRT1] ; NO SPECIAL HACKS
1808 PUSHJ P,COMTYP ; GET QUESTION OFFSET IN A
1810 MOVE B,QTABLE(A) ; GET QUESTION SPEC IN B
1811 TLNE B,%GIGNO ; SEE IF IT CAN BE ASKED?
1812 JRST [OASCR [ASCIZ /Question disabled?/]
1814 PUSH P,OUTPTR ; SAVE OFFSETS FOR CTRL-R
1817 MOVE OUTPTR,OUTBLK ; SET UP CMPBLK & OUTPTR
1818 MOVE CMPBLK,CMPSIZ(OUTPTR)
1822 MOVE A,(OUTPTR) ; SAVE OLD VALUE IN CASE OF CTRL-R
1825 TLNE C,$TFILE ; FILE QUESTION?
1826 JRST [JUMPN A,HASKER ; IF NON-ZERO, BLOCK THERE ALREADY
1827 PUSHJ P,DEFILE ; OTHERWISE FROB IT
1829 SETZM (OUTPTR) ; CLEAR PREVIOUS ANSWER
1831 TLNN C,%ASK+%DSUP ; USER-SUPPLIED DEFAULT ALREADY?
1832 SKIPGE (OUTPTR) ; <0-->ANSWERED USING ESCAPE
1833 JRST HASKER ; DEFAULT EXISTS, SO GO ASK IT
1834 MOVEI CMPBLK,VTABLE(QOFF) ; PRETEND CMPBLK IS VTABLE
1835 TLNE B,$TFILE ; AND SET UP DEFAULTS
1836 JRST [PUSHJ P,DEFILE
1839 HASKER: PUSH BK,[[ASCIZ / Question/]]
1840 PUSH BK,[HSKRET] ; RETURN TO HSKRET IF CTRL-R
1841 PUSH BK,[[POPJ P,]] ; NOTHING SPECIAL
1844 DPB A,[430100,,(OUTPTR)] ; CLEAR %DATAH BIT, FOR ASKER
1845 CAIN QOFF,.QCOMP ; COMPARE QUESTION?
1847 CAIN QOFF,.QSNAM ; SNAME QUESTION?
1849 HLLZ A,QTABLE(QOFF) ; TO HAVE THE BITS
1853 DPB A,[430100,,(OUTPTR)] ; TURN ON %DATAH BIT
1854 HSKPOP: POP P,CMPBLK
1860 ; ASK SNAME QUESTION
1862 HSNAM: PUSHJ P,ASK ; ASK THE QUESTION
1868 ; ASK COMPARE QUESTION
1869 HCOMP: MOVE A,<.QPREC-.QCOMP>(CMPBLK)
1870 TLNE A,%DSUP+%ASK ; WAS THIS QUESTION ASKED?
1871 JRST [SKIPN <.QPREC-.QCOMP>(OUTPTR) ; AND ANSWERED AFFIRMATIVELY?
1874 SKIPL A,<.QPREC-.QCOMP>(OUTPTR) ; GOT ANSWER IN HERE?
1876 HCOMP1: HLLZ A,QTABLE(QOFF)
1877 PUSHJ P,ASK1 ; ASK THE QUESTION
1878 JRST HSKPOP ; NO ANSWER
1879 ADDI OUTPTR,<.QCJCL-.QCOMP> ; MOVE OUTPTR UP A BIT
1880 PUSHJ P,MUDCOM ; .WINI
1882 HCNOPR: SETZM (OUTPTR)
1883 OASCR [ASCIZ / No precompiled?/]
1886 ; FOR RETURN FROM ASKING QUESTION
1887 HSKRET: MOVE A,RVALS ; GET SAVED VALUE
1888 MOVEM A,(OUTPTR) ; AND RESTORE IT
1889 POP P,CMPBLK ; CONTROL-R RETURNS HERE
1894 ; HANDLE CTRL-R FROM ASKING FOR QUESTION
1895 HSKRT1: MOVE OBSCEN,BACK(OBSCEN) ; GO BACK TO 'HOW TO RUN'
1898 MOVEM A,BKPSAV(BK) ; FLUSH EXTRA SLOT ON P
1901 ; SPECIAL COMPILATION TYPES: MULTIPLE, TAILOR FROBBING, QUIT, FLUSH
1903 MULTPL: SKIPE MULFLG
1904 OASC [ASCIZ / What a chomper! /]
1908 VERBOS: SETCMM PR2SW
1910 MOVEI A,[ASCIZ / Verbose/]
1912 MOVEI A,[ASCIZ / Unverbose/]
1916 MVERBO: SETCMM MUDVRB
1918 MOVEI A,[ASCIZ /MUDCOM verbosity/]
1920 MOVEI A,[ASCIZ /MUDCOM silence/]
1924 FEXIST: SETCMM FILEXI'
1926 MOVEI A,[ASCIZ /Files Must Exist/]
1928 MOVEI A,[ASCIZ /Files Need Not Exist/]
1932 ; TAILOR ANOTHER COMPILATION QUESTION
1933 SETMOR: MOVEI A,[ASCIZ /Another compilation? /]
1935 MOVE A,[TFALEN,,TFATBL]
1937 TRNE A,400000 ; FIRST ELEMENT OF TABLE HAS VAL -1, MEANS ASK
1942 SETOUT: PUSHJ P,PRTAIL
1946 QUIT: SKIPN PCOMPF ; PCOMP TO BE RUN?
1948 MOVEI B,OPCOMP ; VALRET THE RIGHT THING
1952 OPCOMP: ASCIZ /
\17:KILL
1955 NPCOMP: ASCIZ /
\17:KILL
1964 MOVEI B,200000 ; TURN OFF INFERIOR INTERRUPT, ECCH!
1966 MOVSI A,(GJ%SHT+GJ%OLD)
1967 MOVE B,[440700,,[ASCIZ /SYS:PCOMP.EXE/]]
1969 MOVE B,[440700,,[ASCIZ /NEW:NPCOMP.EXE/]]
1973 OASCR [ASCIZ /Loading compiler./]
1981 OASC [ASCIZ /Load of PCOMP failed: /]
2001 ; GET RID OF LONG COMPILATION
2005 ; PRINT OUT ACCUMULATED LONG COMPILATION, IN CASE YOU FORGOT
2006 PTLONG: SKIPN MNYFLG
2010 POP P, ; BLETCH! THIS CROCK IS PUSHJ'ED TO, AND WANTS TO JRST
2011 ; INTO THE MIDDLE OF SOMETHING THAT DOESN'T POPJ.
2012 ; BLETCH! BLETCH! BLETCH!
2013 JRST DONE1 ; JRST TO FUNNY ENTRY, WHICH IGNORES TAILORING
2015 ; FOR THE SAKE OF CRETINOUS COMBAT USERS, ASK WHETHER ANOTHER COMPILATION IS WANTED.
2016 ; LOOKS FIRST AT MULTIPLE MODE, THEN AT CURRENT PLAN, THEN AT SETTINGS OF NMORAS AND
2017 ; MORANS (SET IN TAILOR FILE)
2021 MOVE A,[1,,[ASCIZ /DSK/]]
2024 MOVE A,[1,,[ASCIZ />/]]
2027 MOVE A,[1,,[ASCIZ /MUD/]]
2030 SKIPE MNYFLG ; ALWAYS ASK ANOTHER IF MAKING LONG COMPILATION
2032 MOVE A,SNAME ; RESET DEFAULT SNAMES
2035 SKIPE MULFLG ; ALWAYS GIVE ANOTHER
2037 MOVE A,MORLOC(CMPBLK) ; DID LUSER GIVE AN ANSWER ALREADY?
2040 HRRZS A ; GET IT IN A
2043 ASKMOR: SKIPN NMORAS ; DID HE SAY TO ASK?
2045 SKIPN A,MORANS ; SKIPS IF ANSWER YES
2048 ASKMR1: MOVE A,[1,,1] ; IF SAID TO ASK, MAKES DEFAULT 'None'
2055 ; HERE TO PRINT PLAN OUT. TAKES FN1 IN A, SNAME IN B. RETURNS NOTHING, CHANGES
2056 ; NOTHING. DOESN'T CLOSE CHANNEL. USES OUTCHN (OTTY OR TO DSK) INTERNALLY,
2057 ; A POINTS TO OUTPUT FORMAT, D CONTAINS PTR TO FIRST OF FORMAT PAIR.
2060 SETZM MNYFLG ; NO LONGER NEEDED
2061 PTPLA1: SETOM FSTBLK ; PRINTING FIRST, SO NEED NEW CMP
2064 MANYLP: MOVE CMPBLK,CMPSIZ(OUTPTR) ; EXPECTS OUTBLK IN OUTPTR
2065 MOVE A,OUTTBL ; AOBJN PTR TO OUTPUT SPECS
2066 OUTLP: MOVE D,(A) ; GET FIRST WORD OF SPEC
2067 HLRZ B,1(A) ; GET OFFSET INTO OUTBLK & QSPECS
2070 TLNE F,%GIGNO ; SEE IF QUESTION SHOULD EVER BE USED
2073 JRST [TLNN F,%TNMNY ; LOOK AT QSPEC TO SEE IF THIS IS
2074 JRST CONTIN ; OUTPUT ONLY FIRST TIME THROUGH
2077 ADD B,OUTPTR ; POINTER TO SLOT IN OUTBLK
2078 ADD E,CMPBLK ; GET POINTER TO SLOT IN CMPBLK
2079 MOVE E,(E) ; GET CMPBLK SLOT IN E
2081 JRST [TLNN E,%DSUP ; IF USER-SUPPLIED DEFAULT
2082 JRST CKESSN ; SEE IF ESSENTIAL
2084 DOOUT: HRRZ B,(B) ; GET DATA TO BE OUTPUT FROM OUTBLK
2085 HLRZ E,D ; GET TYPE OF FROB IN E
2086 PUSHJ P,@OUTYPE (E) ; DISPATCH FOR DIFFERENT OUTPUT TYPES
2088 ENDOUT: AOBJN A,TSTDON
2089 OUTDON: MOVE OUTPTR,LSTOUT ; PICK UP POINTER TO THIS OUTPUT BLOCK
2090 SKIPN OUTPTR,CMPSIZ+1(OUTPTR) ; IS IT CHAINED TO ANOTHER? (MANY MODE)
2092 MOVEM OUTPTR,LSTOUT ; MAKE LSTOUT, OUTPTR POINT TO NEW ONE
2093 SETZM FSTBLK ; MULTIPLE COMPILATION MODE
2101 PUSHJ P,ASCSIX ; GET THIS IN SIXBIT
2115 ; IN A, THE SIXBIT NAME OF THE FILE TO OPEN (I.E. PCOMP, WASTE, ETC.)
2116 ; IN B, THE DIRECTORY (IN ASCII)
2118 PLNOPN: PUSHJ P,XIOPSH
2119 PUSHJ P,SIXASC ; GET IT IN ASCII POINTER FORMAT
2120 HRROM A,.GJNAM+GTJFNP ; PUT IT IN THE FILE NAME SLOT
2122 HRROM B,.GJDIR+GTJFNP ; SO ALSO WITH THE DIRECTORY NAME
2124 HRROM A,.GJDIR+GTJFNP
2130 MOVE B,[070000,,OF%WR]
2135 PLNOPF: OASCR [ASCIZ /Open of PLAN failed?/]
2150 ; SEE IF THIS QUESTION HAS TO BE OUTPUT REGARDLESS OF SETTING IN CMPBLK
2151 CKESSN: SKIPGE (B) ; IF THERE'S OUTPUT, MUST BE PRINTED
2155 TLNN F,%ESSEN ; SKIPS IF ESSENTIAL QUESTION
2156 JRST EAOBJN ; INESSENTIAL, SO GO TO NEXT
2159 AOPOP: AOBJN A,.+1 ; RETURN POINT IF NOTHING PRINTED
2161 ; DISPATCH TABLE FOR DIFFERENT TYPES OF OUTPUT
2162 ; ALL SKIP RETURN IF ANY OUTPUT PRINTED
2169 OSNAME ; OUTPUT SNAME
2171 ; HERE FOR FLAGS: T/F, DEFAULT <>
2172 T.FDF: JUMPE B,CPOPJ
2173 OASC (D) ; PRINT OUT LEADING FROB
2176 PRTOUT: HRRZ C,(A) ; COMMON TO ALL PRINTOUT ROUTINES: PRINT OUT TRAILER,
2177 OASC (C) ; THEN SKIP-RETURN
2181 ; SAME, BUT DEFAULT T
2182 T.FDT: JUMPN B,CPOPJ
2188 $FALSE: ASCIZ /#FALSE ()/
2190 ; HERE TO PRINT OUT FILE NAMES. SURROUNDS THEM WITH QUOTES, AUTOMAGICALLY
2191 FNAME: JUMPE B,CPOPJ
2201 ; NEW FILE NAME PRINTER. A HAS POINTER TO BLOCK OF NAMES
2208 JRST [MOVEI C,[ASCIZ /<filename1>/]
2210 MOVEI C,[ASCIZ /<filename2>/]
2214 MOVE E,1(A) ; NEXT NAME
2215 MOVE E,(E) ; GET ASCII
2217 JRST NFNMDN ; DON'T PRINT .0!
2242 ; PRINT OUT A FORM IFF THE GIVEN SWITCH IS T (NEW COMPILER, MAINLY)
2247 ; PRINT OUT A STRING, NOT SURROUNDED BY QUOTES (PACKAGE MODE, ETC.)
2248 STRING: JUMPE B,CPOPJ
2253 ;PRINT OUT REDO LIST: APPENDS LIST FROM COMPARE, LIST FROM REDO
2254 OTREDO: JUMPE B,RREDO ; ANYTHING FROM COMPARE?
2255 OASC (D) ; YES, PRINT '<SET REDO!- (
2256 MOVSI F,440700 ; CONS UP BYTE POINTER
2258 OTLOOP: ILDB F ; FLUSH LEADING BLANKS
2261 ADD F,[70000,,] ; DECREMENT THE POINTER--JUST FOUND NON-BLANK
2264 OBPTR F ; PRINT LIST
2265 SETOM DOEND ; SAYS THAT NEED TO PRINT ')>' EVEN IF NOTHING
2266 ; IN USER-SUPPLIED REDO LIST
2271 JUMPE B,[SKIPN DOEND ; NOTHING IN USER-SUPPLIED LIST. COMPARE LIST?
2272 POPJ P, ; NO, SO LEAVE IMMEDIATE
2280 ; OUTPUT <SNAME "FOO"> FROM PSNAME
2281 OSNAME: SKIPN PSNAME
2282 AOBJN A,POPJ1 ; FLUSH COMPLETELY
2283 OASC (D) ; PRINT <SNAME "
2285 JRST OSNAM1 ; YES, SO USE PSNAME
2286 OASC (B) ; PRINT SNAME
2287 AOBJN A,PRTOUT ; AND GO CLEAN UP
2292 OSNAMO: AOBJN A,PRTOUT
2297 ; COME HERE TO READ A TAILOR FILE INTO NCOMBAT
2298 A; ALWAYS RETURNS WITHOUT SKIPPING
2320 ; A = POINTER TO START OF TAILOR BLOCK
2321 ; INITIALIZES BLOCK TO %IGNOR+<QUESTION ID>,,0
2324 MOVEI QOFF,0 ; INITIALIZE QOFF
2326 MKTLP: LDB F,[220600,,QTABLE(QOFF)]
2333 MOVSI F,%IGNOR+CRETQ ; FINISH INITIALIZING, ALL TO CRETQ
2360 MOVE B,[440000,,OF%RD]
2362 JRST [OASCR [ASCIZ /Open of TAILOR failed?/]
2366 PUSHJ P,NAMMAK ; CONS STRING AND LENGTH FOR NAMUNQ
2369 LDLOOP: MOVE C,[-2,,D]
2370 .IOT DSKCHN,C ; GET THE FIRST WORDS IN D AND E
2373 LDLOOP: MOVE C,[-2,,XCHOMP']
2383 LDLOP0: SKIPGE UTPSAV
2388 JRST .+1] ; SAVE <#TYPES>,,<#TYPES> FOR HACKING LINKS
2399 TLZE D,%NMRAS ; SKIPS IF SAID 'ASK'
2405 TLZN D,%MRANS ; SKIPS IF ANSWER 'YES'
2410 LDB F,[220600,,D] ; GET THE VERSION NUMBER
2412 SETOM UPTFLG ; MUST DO AN UPDATE
2413 TLZ D,777777 ; FLUSH LEFT HALF
2415 PUSHJ P,IBLOCK ; GET WORDS FOR NAME
2416 PUSH P,A ; SAVE THE LOCATION OF THE NAME
2417 MOVN B,D ; MAKE AOBJN POINTER TO BLOCK
2421 .IOT DSKCHN,B ; IOT IN THE NAME
2428 SKIPE LDFLAG ; ARE WE DOING A LOAD TAILOR?
2429 PUSHJ P,NAMUNQ ; MAKE NAME UNIQUE
2431 PUSHJ P,IBLOCK ; GET WORDS FOR BLOCK
2432 ADDI A,LNALEN ; POINT PAST LINK AREA
2433 PUSH P,A ; SAVE THE LOCATION OF BLOCK
2436 HRRI B,-LNALEN(A) ; START IOT AT BEGINNING OF LINK AREA
2438 .IOT DSKCHN,B ; IOT IN THE BLOCK
2446 MOVSI QOFF,QNUM ; AOBJN POINTER TO QUESTION BLOCK
2447 MOVE CMPBLK,QOFF ; SET UP SAME POINTER FOR FIXUP HACKING
2448 LDLOP1: SKIPE UPTFLG
2450 MOVE B,QTABLE(QOFF) ; GET SLOT FOR THIS QUESTION
2453 HRRZ B,(C) ; GET THE RH OF THE FROBNITZ
2454 JUMPE B,LDEND1 ; EMPTY. FINISH
2455 ADDM A,(C) ; UPDATE THE POINTER
2461 LDEND2: JSP RET,NEWTYP
2474 ; FIX UP LINK POINTERS: STORED IN SAVE FILE AS (0-BASED) OFFSETS
2475 ; INTO NEW SECTION OF USER TYPE TABLE
2476 ADD A,UTYPLN ; GET AOBJN POINTER TO NEW TYPES
2477 MOVE B,A ; IN TWO PLACES
2479 LDLN1: MOVE C,(B) ; PICK UP FIRST NEW TYPE
2480 HRLZ D,LNKHDR(C) ; PICK UP LINK COUNT
2481 JUMPE D,LDLNKL ; NONE
2482 HRRI D,LNKHDR+1(C) ; AOBJN POINTER TO LINKS
2483 LDLNLP: ADD A,(D) ; GET POINTER TO TYPE FOR THIS LINK
2485 MOVEM E,(D) ; STUFF IT IN BLOCK
2486 MOVE A,(P) ; RESTORE A
2488 LDLNKL: AOBJN B,LDLN1
2490 LDOUT1: SKIPE UPTFLG
2496 PUSHJ P,PRTAIL ; WRITE OUT UPDATE FILE (NEW FORMAT)
2499 ;FIXUP POINTERS TO FILE NAMES
2516 LDFLPE: AOBJN D,LDFLP
2530 JRST [MOVE A,[1,,[ASCIZ /
\18/]]
2532 MOVE A,[1,,[ASCIZ /
\19/]]
2537 ITSFX1: AOJA F,LDFLPE
2539 UPTAIL: MOVEI A,CMPLEN
2540 PUSHJ P,IBLOCK ; GET A NEW BLOCK
2545 BLT O,LNALEN(A) ; COPY LINK STUFF
2546 ADDI A,LNALEN ; POINT TO FIRST NON-LINK WORD
2549 PUSHJ P,MKTAIL ; MUMBLE THE BLOCK CORRECTLY
2551 MOVE A,(P) ; AND SAVE ADDRESS AS ABOVE
2552 MOVE B,HOWLOC(RET) ; HACK HOW TO RUN AND MORE?
2556 UPTLP: MOVE B,(C) ; GET THIS ENTRY IN TAILOR
2557 PUSHJ P,QFIND ; GET OFFSET FOR THIS QUESTION IN QOFF, LOC IN D
2559 MOVEM B,(D) ; SAVE AWAY AT CORRECT SLOT
2560 MOVE B,QTABLE(QOFF) ; GET THE TYPE CODES
2563 HRRZ B,(C) ; GET THE LOCATION OF BLOCK POINTER
2565 ADDM O,(D) ; UPDATE POINTER
2571 ; B = WORD FROM TAILOR CONTAINING QUESTION ID BITS
2572 ; SKIP RETURNS IF MUMBLER FOUND, WITH QOFF SET AND D POINTING TO GOOD BLOCK
2574 QFIND: MOVSI QOFF,QNUM
2575 LDB F,[220600,,B] ; QUESTION ID FOR THIS QUESTION
2576 QFLOOP: LDB E,[220600,,QTABLE(QOFF)]
2577 CAMN E,F ; SAME QUESTION ID?
2579 AOBJN QOFF,QFLOOP ; NO. CONTINUE
2582 QFWIN: MOVE D,A ; YES. SET D PROPERLY
2587 ; TAKES TALSNM, CONSES STRING (LIVES IN TALSTR AND TALSTR+1) AND LENGTH (TALSLN) FOR
2592 MOVEI O, ; FOR LENGTH OF FROB
2593 MOVE A,[440600,,TALSNM]
2594 MOVE B,[440700,,TALSTR] ; BYTE POINTERS
2597 ADDI O,1 ; PRECEDE WITH -
2598 NAMLOP: ILDB C,A ; GET CHAR
2601 ADDI C,40 ; MAKE INTO ASCII
2604 JRST NAMLOP ; NOT DONE YET
2605 NAMDON: ADDI O,1 ; SO WILL GET ASCIZ
2606 MOVEM O,TALSLN ; SAVE AWAY LENGTH
2614 ; PUSHJ P,NAMUNQ: APPENDS CONTENTS OF TALSTR (BETTER BE A STRING AS SET
2615 ; UP BY NAMMAK) TO THE TYPE NAME CONTAINED IN -1(P) (BEFORE ALL THE AC'S
2616 ; ARE PUSHED; AFTER THAT, IT'S BLKLOC(P)). THE BLOCK IS GROWN IF NECESSARY,
2617 ; AND THE POINTER IS UPDATED.
2618 ; LENGTH (IN WORDS) IS INITIALLY IN D
2622 BLKLOC==-4 ; LOCATION OF NAME BLOCK ON STACK
2623 MOVE A,BLKLOC(P) ; GET NAME BLOCK
2624 ADDI A,-1(D) ; POINTER TO LAST WORD
2625 HRLI A,10700 ; POINTER TO LAST BYTE
2626 MOVEI B, ; INITIALIZE COUNT
2627 NAMULP: LDB O,A ; GET CHARACTER
2628 JUMPN O,NAMTWO ; FOUND REAL NAME?
2629 DBP A ; NOPE. GO TO NEXT CHAR
2630 AOJA B,NAMULP ; AFTER AOSING COUNT, OF COURSE
2631 ; NUMBER OF FREE CHARACTERS IN LAST WORD OF NAME IS NOW IN B; LENGTH OF
2632 ; STRING TO BE APPENDED IS IN TALSLN.
2633 NAMTWO: CAML B,TALSLN ; ARE THERE ENOUGH FREE CHARACTERS?
2634 JRST NAMBLT ; YES: WIN IMMEDIATE
2635 PUSH P,A ; SAVE ILDB POINTER TO LAST BYTE OF NAME
2636 MOVE A,B ; GET COUNT IN RIGHT AC
2637 SUB A,TALSLN ; HOW MANY CHARS?
2639 IDIVI A,5 ; HOW MANY WORDS?
2640 JUMPE B,NAMTW1 ; HACK REMAINDER
2642 NAMTW1: ADDI A,(D) ; NUMBER OF WORDS NEEDED FOR NEW NAME
2643 PUSHJ P,IBLOCK ; GET CORE
2645 HRL B,BLKLOC-1(P) ; CONS UP BLT POINTER
2646 MOVEI C,(A) ; OTHER HALF
2647 ADDI C,-1(D) ; INCLUDE LENGTH
2648 BLT B,(C) ; MOVE NAME BLOCK
2649 SUB A,BLKLOC-1(P) ; OFFSET TO NEW BLOCK
2650 ADDM A,BLKLOC-1(P) ; UPDATE POINTER
2651 ADDM A,(P) ; UPDATE BYTE POINTER
2652 POP P,A ; GET IT BACK
2653 ; ILDB POINTER TO NAME IS IN A, REST IS IN TALSTR AND TALSLN
2654 NAMBLT: MOVE B,[440700,,TALSTR]
2656 NAMBLP: ILDB O,B ; GET CHAR
2657 IDPB O,A ; STUFF IT IN
2658 SOJG C,NAMBLP ; DONE?
2665 ; TO ADD A NEW ENTRY TO THE COMPILATION TYPES TABLE
2666 ; LOC OF BLOCK IS IN (P). LOC OF NAME BLOCK IS IN -1(P)
2672 POP P,(A) ; POP LOC. OF BLOCK INTO TABLE
2674 HRLM D,(A) ; MOVE LOC. OF NAME INTO TABLE
2688 -1,,[ASCIZ /COMBAT/]
2689 -1,,[ASCIZ /TAILOR/]
2696 ; PRTAIL PRINTS OUT THE TAILOR INFO TO A FILE
2697 ; ALWAYS RETURNS WITHOUT SKIPPING
2704 MOVSI A,(GJ%FOU+GJ%SHT)
2705 HRROI B,[ASCIZ /COMBAT.TAILOR/]
2709 MOVE B,[440000,,OF%WR]
2712 PRTLER: JRST [PUSH P,[OPNFAL]
2713 JRST ERRPRT] ; PRINT ERROR
2715 JRST PRTLDN ; EMPTY TABLE ==> LEAVE
2717 PRLOOP: PUSH P,A ; SAVE POINTER TO UTYPTB
2720 HLRZ B,(A) ; POINTER TO NAME
2727 PRTAL1: IDIVI D,5 ; CALCULATE WORDS FOR NAME
2733 ADDB D,F ; UPDATE BLOCK POINTER IN F
2734 BLT B,-1(D) ; BLT NAME INTO BLOCK
2736 ADD B,[-LNALEN,,0] ; POINT TO REAL BEGINNING OF BLOCK
2738 BLT B,CMPLEN-1(F) ; BLT THE COMBLK INTO F
2743 HRLZ A,(F) ; # LINKS
2745 HRRI A,1(F) ; AOBJN POINTER TO LINKS
2746 PRLNK1: MOVE B,UTYPLN
2748 MOVE D,(A) ; PICK UP POINTER TO TYPE FROM LINK AREA
2749 PRLNKL: CAMN D,(B) ; COMPARE WITH POINTER IN TYPE TABLE
2751 JRST PRLNKE] ; SAVE RELATIVE OFFSET IN BLOCK, GO TO NEXT LINK
2753 AOBJN B,PRLNKL ; TRY NEXT TYPE IN TABLE
2755 .VALUE ; THIS CAN'T HAPPEN
2760 PRLNKE: AOBJN A,PRLNK1 ; NEXT LINK
2767 MOVE C,F ; START OF COPY OF COMBLK
2768 ADDI F,CMPSIZ ; AND UPDATE BLOCK POINTER
2770 MOVEI E,CMPSIZ ; COUNTER OF OFFSETS
2771 PRLOP1: MOVE B,QTABLE(QOFF)
2778 JRST [MOVEI B,FSPSIZP
2785 BLT D,(A) ; BLT THIS BLOCK INTO INPBUF
2786 HRRM E,(C) ; RELATIVIZED OFFSET
2787 ADD E,B ; UPDATE OFFSET
2788 ADD F,B ; UPDATE BLOCK END
2790 MOVE B,QTABLE(QOFF) ; DO FANCY UPDATE FOR FILE NAMES
2798 POP P,A ; GET BACK NAME BLOCK LENGTH
2799 TLO A,%NWFMT ; ALWAYS NEW FORMAT NOW
2804 SKIPE NMORAS ; GET ANSWERS TO ANOTHER COMPILATION
2811 DPB RET ,[220600,,A]
2816 HRRI A,INPBUF ; MAKE AOBJN POINTER TO INPBUF
2839 ;RELATIVIZE POINTERS TO FILE NAMES
2840 PRFILE: HRLI A,-FSPSIZ
2841 PRFLP: SKIPN B,(A) ; GET FILE NAME POINTER
2842 JRST PRFLE ; 0 IS END OF POINTERS
2843 HLRZ D,B ; # WORDS IN D
2844 ADDI D,-1(F) ; TO POINTER (FOR BLT)
2845 MOVE B,F ; CALCULATE FROM POINTER
2847 BLT B,(D) ; BLT FILE NAME INTO BUFFER
2848 HRRM E,(A) ; AND SAVE RELATIVIZED POINTER
2849 HLRZ B,(A) ; # WORDS AGAIN IN B
2850 ADD E,B ; UPDATE RELATIVIZING ACS
2852 PRFLE: AOBJN A,PRFLP ; LOOP ON FILE NAMES
2856 ; CREATE USER-DEFINED GROUP. ALTGRP JRST TO CRTAIL, BELOW, AFTER INITIALIZING
2857 ; THINGS TO ITS SATISFACTION. HERE, GET NAME, CREATE BLOCK, INITIALIZE IT MAINLY
2859 CRTAIL: SETZM ALTER ; CLEAR ALTER FLAG
2860 MOVEI A,[ASCIZ /Name of type /] ; GET GROUP NAME
2869 PUSH P,D ; SAVE LOCATION OF NAME
2870 MOVEI A,CMPLEN ; GET FRESH BLOCK
2872 ADDI A,LNALEN ; POINT TO FIRST NON-LINK WORD
2873 PUSH P,A ; SAVE LOCATION OF BLOCK
2874 PUSHJ P,MKTAIL ; INITIALIZE TAILOR BLOCK
2875 MOVE A,(P) ; INITIALIZE HOW TO RUN TO ASK
2879 ; WANTS POINTER TO BLOCK AS TOP OF STACK. CRTAIL & ALTGRP BOTH USE THIS.
2885 SETZM FILEXP ; SO FILE NAMES WON'T BE FILLED IN
2886 CRLOOP: SETZM SQDEF ; DECIDE IF SETTING QUESTION DEFAULT
2887 CRLOP1: MOVEI B,[ASCIZ /Question /] ; GET QUESTION TO HANDLE
2888 MOVE A,[TAILEN,,TAILTB]
2889 SKIPE SQDEF ; FUNNY PROMPT AND QUESTION TABLE IF SETDEF
2890 JRST [ADD A,[TALSPC,,0]
2891 MOVEI B,[ASCIZ / Question /]
2894 MOVE OUTPTR,(P) ; POINTER TO BLOCK BEING HACKED
2896 TRZE A,$SSMAL ; SPECIAL TYPE?
2897 JRST @CRSPEC(A) ; GO HACK IT
2898 CAIN A,HOWLOC ; WAS IT HOW TO RUN?
2900 CAIN A,MORLOC ; WAS IT ANOTHER COMPILATION??
2902 MOVE QOFF,A ; NORMAL CASE
2903 ADD OUTPTR,QOFF ; POINTER TO SLOT IN QUESTION
2904 MOVE C,(OUTPTR) ; SAVE OLD VALUE FOR CTRL-R
2910 CTRRET: MOVE C,QTABLE(QOFF)
2911 TLNE C,$TTF ; TRUE/FALSE QUESTION
2913 TLNE C,$TFILE ; FILE QUESTION
2914 JRST [PUSHJ P,CRFDEF
2916 HRRZ A,VTABLE (QOFF) ; SET DEFAULT
2918 TLRASK: HLLZ A,QTABLE(QOFF) ;CRETINISM
2919 PUSHJ P,ASK1 ; ASK QUESTION
2921 ; EXPECTS USER-SUPPLIED DEFAULT TO BE IN (OUTPTR), MAKES LH OF A BE RIGHT
2923 HLLZ A,QTABLE(QOFF) ; SINCE CLOBBERED BY ASK, SOMETIMES
2924 LDB B,[%TPLEN,,(OUTPTR)] ; GET STRING LENGTH
2925 DPB B,[301400,,A] ; PUT IT IN A, TURNING OFF NON-SEQUENCE BITS TOO
2927 JRST [TLO A,%ASK+%DSUP
2931 TLRST2: HLLM A,(OUTPTR)
2933 ; HERE FROM CTRL-R. RESTORE (OUTPTR) TO VALUE SAVED IN RVALS
2939 CRLCTG: MOVE A,RVALS
2941 JRST CTRRET ; GO HERE IF RETURNING FROM CTRL-G
2943 CRFDEF: MOVEI A,FSPSIZ ; SETS UP SPACE FOR FILE NAME BEFORE ASKING
2948 ; DISPATCH TABLE TO SPECIAL ROUTINES
2949 CRSPEC: CRDONE ; FINISHED HACKING
2950 QDEL ; DELETE QUESTION
2951 SETQDF ; SET QUESTION DEFAULT
2952 CPRTGP ; PRINT CURRENT TYPE
2956 XXLINK ; EXPAND ALL LINKS
2957 LSTLN1 ; LIST LINKS TO ME
2958 MYLIN1 ; LIST LINKS FROM ME
2960 ; SET UP FOR SETTING QUESTION DEFAULT
2961 SETQDF: SETOM SQDEF ; SAYS THAT NEXT THING HACKED WILL BE DEF SET
2962 PUSH BK,[[ASCIZ /Question/]]
2965 PUSH BK,P ; SET UP ACTIVATION
2968 ; PRINT CURRENT GROUP
2970 PUSH P,[CRLOOP] ; RETURN ADDRESS FROM PRINTER (AN OBSCENITY)
2971 MOVE CMPBLK,-1(P) ; CURRENT TYPE
2974 MOVE F,[QNUM-1,,VTABLE]
2979 SKIPE ALTER ; IF IN ALTER, LET IT CLEAN UP
2981 TALADD: JSP RET,NEWTYP ; GO TO ROUTINE TO ADD NEW TYPE
2982 TALOUT: PUSHJ P,PRTAIL
2985 ; HACKERY FOR TAILORING TRUE/FALSE: DEFAULT IS ASK, BUT LOSER CAN GIVE HIS OWN
2988 MOVE A,[TFALEN,,TFATBL]
2989 PUSHJ P,COMTYP ; GET RESULT
2990 TRNE A,400000 ; DID HE DEFAULT?
2991 JRST NOANS ; YES: TURN ON ASK BIT
2992 HRRM A,(OUTPTR) ; SAVE DEFAULT IN BLOCK
2996 ; IF NO ANSWER GIVEN: TURN ON %ASK
3007 TLNN C,$TTF ; IF IT WAS T/F, DON'T NEED TO PRINT <ASK>
3013 HOWTAL: MOVE OUTPTR,(P)
3014 SETOM RVALS ; PREVENT MUNGAGE IF CTRL-R
3015 MOVE A,[HOWTLN+HOWSPC-1,,HOWTLT] ; TABLE WITH ASK DEFAULT, - ABORT & QUES
3021 JUMPL A,HOWRED ; SAID 'ASK' IF JUMPS
3023 MOVEM A,HOWLOC(OUTPTR)
3025 HOWRED: MOVSI A,%ASK
3026 MOVEM A,HOWLOC(OUTPTR)
3029 ; TAILOR ANOTHER COMPILATION? QUESTION
3032 MOVE A,[MORLEN,,TMORTB]
3036 HRRES A ; WILL BE -1 IF SAID ASK
3037 JUMPGE A,[HRLI A,%IGNOR+%DSUP
3040 MORCOT: MOVE OUTPTR,(P)
3041 MOVEM A,MORLOC(OUTPTR)
3044 ; MAKE ACTIVATION--USED BY MORC,QDEL,&C.
3045 MAKACT: PUSH BK,[[ASCIZ /Question/]]
3051 ; DELETE QUESTION FROM TAILOR FILE
3052 QDEL: MOVE A,[TAILEN+TAILSP,,TAILTB]
3055 PUSHJ P,COMTYP ; GET QUESTION
3057 CAIN A,HOWLOC ; IF HOW TO RUN, DEFAULT IS %ASK
3061 MOVEM A,HOWLOC (OUTPTR)
3075 ; GET USER COMPILATION TYPE
3076 GETTYP: MOVEI B,[ASCIZ /Named /]
3077 GETTP1: MOVEM B,PRMPT1 ; ENTRY FOR FUNNY PROMPTS
3082 OASCR [ASCIZ /No compilation types defined./]
3085 ARESOM: PUSHJ P,COMTYP ; GET POINTER TO GROUP'S CMPBLK
3090 ; DELETE USER COMPILATION TYPE: BLTS TABLE UP TO COVER THE VACATED SLOT,
3091 ; FIXES UP TYPE TABLE AOBJN POINTERS
3092 DELGRP: PUSHJ P,GETTYP
3094 PUSHJ P,FNDLNK ; GET LINKS
3095 SKIPN B,LNKTPT ; ANY HERE?
3096 JRST DELGR1 ; NO, GO DO DELETE
3098 OASCR [ASCIZ /The following types are linked:/]
3099 PUSHJ P,LNKPRT ; PRINT LINKS
3100 OASC [ASCIZ /Are you sure you want to delete this?/]
3101 MOVEI A,[ASCIZ /(Yes or no) /]
3103 MOVE A,[TFTLEN,,TFTBL]
3105 JUMPE A,[POP P,SMVAL
3108 DELLOP: MOVE CMPBLK,1(B)
3114 DELGR1: MOVE A,SMVAL
3127 ; ALTER GROUP: GETS POINTER TO BLOCK, JRST INTO MIDDLE OF CREATE GROUP.
3128 ; MAKES COPY OF GROUP, CHANGES INTO IT; REPLACES IN UTYPTB IFF NORMAL
3129 ; (NON CTRL-R) EXIT FROM CRLOOP.
3130 ALTGRP: PUSHJ P,GETTYP
3135 PUSHJ P,GETCOP ; COPY WILL BE IN A
3138 ALTEND: POP P,D ; NEW BLOCK
3139 POP P,A ; GET OLD BLOCK
3140 MOVEI B,UTYPTB ; GET USER TYPE TABLE
3142 CAME A,C ; IS THIS IT?
3144 HRRM D,(B) ; STUFF IT IN
3147 PUSHJ P,FNDLNK ; GET EVERYBODY WHO POINTS TO ME
3149 JRST TALOUT ; NOBODY
3150 ALTLP1: MOVE B,(A) ; POINTER TO SLOT
3151 HRRM D,(B) ; CLOBBER TYPE POINTER
3152 ADD A,[1,,1] ; ADDED THIS INST. - MARC 12/24 GROSS ME OUT TIM
3154 JRST TALOUT ; PRINT OUT NEW TAILOR
3156 ; XEROX COPIES A GROUP FROM X TO [NEW] GROUP Y. DUE TO JMB, CHOMP.
3157 XEROX: PUSHJ P,GETTYP ; GET OLD GROUP
3159 MOVE E,A ; OLD GROUP IS IN E
3160 MOVEI O,[ASCIZ /To (new type) /]
3166 PUSHJ P,GETLIN ; GET NAME OF NEW GROUP
3168 PUSHJ P,PRSINP ; NAME IS IN D
3169 PUSHJ P,GETCOP ; NEW GROUP SHOULD COME OUT IN A, OLD IS IN E
3172 JRST TALADD ; ADD IT AND DUMP OUT
3174 ; RENAME CHANGES NAME OF TYPE. THIS WOULD BE EASY, EXCEPT THAT ALL
3175 ; LINKS TO THE TYPE HAVE TO BE UPDATED.
3176 RENAME: PUSHJ P,GETTYP ; GROUP BEING RENAMED
3178 PUSH P,A ; POINTER TO TYPE
3179 PUSH P,SMVAL ; POINTER TO SLOT IN TABLE
3180 MOVEI A,[ASCIZ /To (new name) /]
3186 PUSHJ P,GETLIN ; GET NEW NAME
3188 PUSHJ P,PRSINP ; NAME IS IN D
3190 HRLM D,(A) ; CHANGE NAME IN TABLE
3192 PUSHJ P,FNDLNK ; GET TABLE OF LINKS TO ME
3194 JRST TALOUT ; DUMP TAILOR--NO LINKS
3195 RNMLOP: MOVE B,(A) ; PICK UP POINTER TO SLOT
3196 HRLM D,(B) ; CLOBBER NAME
3198 JRST TALOUT ; AND DUMP TAILOR
3200 ; HERE TO PRINT COMPILE TYPES FOR USER'S INFORMATION
3202 PRTGRP: PUSHJ P,GETTYP
3207 MOVEI QOFF,QTABLE ; TABLE OF QUESTIONS
3208 MOVE F,[QNUM-1,,VTABLE] ; USED FOR DEFAULTS
3209 ; WANTS POINTER TO TYPE IN CMPBLK (GETS DESTROYED), QTABLE IN QOFF (DITTO),
3210 ; VTABLE IN F (DITTO), MUNGS B,C. ALSO WANTS TYPE AS TOP OF STACK, TO BE
3211 ; POPPED. FORTUNATELY CALLED FROM CRLOOP, WHICH DOESN'T CARE ABOUT ANY OF
3212 ; THE ACS WHICH GET KILLED (I HOPE!)
3214 PUSH BK,[PRAOUT] ; MAKE ACTIVATION TO GET OUT
3220 GRPPLP: MOVE B,(CMPBLK)
3221 TLNE B,%ASK ; DID HE SAY TO ASK?
3223 TLNN B,%DSUP ; DID HE SUPPLY A DEFAULT?
3224 JRST ENDPR2 ; NOPE. SKIP THIS ONE.
3225 MOVE C,(QOFF) ; PRINT QUESTION
3226 TLNE C,%GIGNO ; IS QUESTION TURNED OFF?
3230 DEFPRT: TLNE C,$TFILE ; FILE SPEC?
3232 TLNE C,$TTF ; TRUE/FALSE?
3234 PATOM: OASC (B) ; PRINT WHAT'S THERE
3243 ENDPR2: AOBJN F,MNGACS ; DONE?
3246 POP P,CMPBLK ; PRINT HOW TO RUN
3247 MOVEM P,BKPSAV(BK) ; UPDATE SAVED P
3248 AOS BKRET(BK) ; SINCE NO LONGER HAVE TO DO POP
3249 OASC [ASCIZ /How to run/]
3251 MOVE A,HOWLOC(CMPBLK)
3258 JRST [OASC [ASCIZ / {/]
3263 PRMORE: OASC [ASCIZ /Another compilation/]
3265 MOVE A,MORLOC(CMPBLK)
3271 JRST [OASC [ASCIZ / {/]
3279 PRAOUT: POP P,CMPBLK
3281 MNGACS: ADDI CMPBLK,1
3286 ; PRINT FILE SPEC WHEN DEFAULT SUPPLIED
3305 CXPRT: MOVE A,SSSPPP
3314 ; PRINT TRUE/FALSE TYPE QUESTION
3320 ASKMSG: ASCIZ /<ASK>/
3321 PRASK: MOVE C,(QOFF)
3327 TLNE B,%DSUP ; DEFAULT SUPPLIED?
3328 JRST [OASC [ASCIZ /: /]
3332 ; LOAD AND REPLACE: MUNGIFICATE YOUR FROBNITZES
3333 GETAIL: SETO QOFF, ; CRETINIZE THE POINTER
3334 MOVEI OUTPTR,TALPTR ; TALPTR HAS POINTER TO TAILOR INPUT FILE NAMES
3335 ; ==> DEFAULTS GET SET, ETC.
3337 PUSHJ P,ASK ; GO GET FILE NAME
3345 MOVEM O,SYSDIR ; RESTORE SYSTEM DEFAULTS
3368 HRROM A,XTALNM+.GJDEV
3370 HRROM A,XTALNM+.GJDIR
3372 HRROM A,XTALNM+.GJNAM
3374 HRROM A,XTALNM+.GJEXT
3376 PUSHJ P,LDTAIL ; LOAD NEW FILE
3379 ; REPLACE TAILOR. JUST LIKE ABOVE, EXCEPT CLOBBERS CURRENT USER TYPE TABLES
3383 SETOM FILEXP ; WANT FULLY-SPECIFIED FILE NAMES
3386 HLLZ A,UTYPLN ; GET NUMBER OF USER TYPES
3387 MOVNS A ; MAKE IT POSITIVE
3388 ADDM A,TYPLEN ; ADD TO LEFT HALF OF AOBJN POINTERS
3391 MOVEM O,SYSDIR ; RESTORE SYSTEM DEFAULTS
3394 SETZM LDFLAG ; DON'T NEED TO UNIQIFY NAMES
3395 PUSHJ P,LDTAIL ; LOAD NEW FILE
3399 ; COME HERE IF LOSER REFUSED TO GIVE FILE NAME.
3401 DRPOUT: IFE ITS,MOVEI TALDV
3402 IFN ITS,MOVEI TALDEV
3404 OASCR [ASCIZ /Aborted?/]
3410 ; COME HERE TO CREATE (IF NEEDED) A NEW BLOCK, WITH ALL LINKS EXPANDED.
3411 ; INITIAL BLOCK IS IN CMPBLK, RETURN IN CMPBLK. LINKX1 CAUSES BLOCK WITH
3412 ; POINTERS TO TYPES USED TO BE SET UP AS WELL; H IS RESERVED FOR A POINTER TO
3413 ; THIS IF IT EXISTS, AND THE POINTER IS RETURNED THERE.
3415 LINKX1: CAIG CMPBLK,MUMBLE ; USER TYPES WILL BE ABOVE MUMBLE
3417 SKIPN LNKHDR(CMPBLK) ; ANY LINKS?
3429 LINKX2: SKIPN A,LNKHDR(CMPBLK)
3430 JRST POPAJ ; NO LINKS, SO LEAVE
3431 PUSH P,B ; AOBJN POINTER TO LINK AREA
3432 PUSH P,C ; LINK TO THIS TYPE IS BEING EXPANDED
3433 MOVEI B,-LNKCNT(CMPBLK) ; ADDRESS OF FIRST LINK
3440 LINKXL: MOVE C,(B) ; GET POINTER TO LINK TYPE
3441 PUSHJ P,EXPAND ; EXPAND IT
3449 ; COME HERE TO EXPAND A SINGLE LINK. BLOCK TO EXPAND INTO IS IN A, BLOCK TO
3450 ; EXPAND FROM IS IN C, BLOCK TO SAVE TYPE INFO IN (IF EXISTS) IS IN H.
3456 HRLI A,-CMPSIZ ; SET UP AOBJN POINTER
3457 EXLOOP: MOVE B,(A) ; PICK UP WORD
3458 TLNE B,%DSUP+%ASK ; SOMETHING ALREADY HERE?
3459 JRST EXLOPE ; YES, GO TO NEXT
3461 TLNN B,%DSUP+%ASK ; SOMETHING IN LINK TYPE?
3463 MOVEM B,(A) ; YES, STUFF IT OUT
3464 JUMPE H,EXLOPE ; IF NOTHING IN H, LOOP AGAIN
3465 HLRM C,(H) ; SAVE POINTER TO NAME OF TYPE THIS CAME FROM
3466 EXLOPE: AOBJP A,EXPOUT ; END OF BLOCK?
3469 AOJA H,EXLOOP ; UPDATE POINTERS, LOOP AGAIN
3477 ; COME HERE FROM TAILOR LOOP TO CREATE LINK. GET TYPE FROM USER, STUFF
3478 ; IT INTO LINK AREA OF CURRENT GROUP.
3485 PUSHJ P,GETTYP ; GET TYPE IN A
3487 SKIPN B,ALTER ; IN ALTER GROUP?
3489 CAMN A,B ; LINKING TO SELF?
3490 JRST [OASCR [ASCIZ /Can't link group to self./]
3492 CLINK1: HRLZ B,LNKHDR(C)
3496 CAIN D,(A) ; SAME TYPE?
3497 JRST [OASCR [ASCIZ /Already linked./]
3500 MOVN B,LNKHDR(C) ; GET # OF LINKS ALREADY HERE
3502 JRST [OASCR [ASCIZ /Link area full./]
3504 CLINKW: PUSHJ P,GETNAM ; TURN TYPE (IN A) INTO NAME,,TYPE
3506 MOVNM B,LNKHDR(C) ; SAVE - THE COUNT AWAY
3507 ADDI B,LNKHDR(C) ; SLOT TO CLOBBER
3508 MOVEM A,(B) ; SAVE LINK AWAY
3513 JRST CRLOOP ; BACK INTO LOOP
3515 ; LINK DELETION ROUTINES. DLINK IS CALLED FROM CRLOOP; LNKDEL ACTUALLY DOES
3516 ; THE WORK, AND IS CALLED FROM NUMEROUS PLACES (DELETE TYPE, FOR EXAMPLE).
3520 PUSHJ P,LNKGET ; GET POINTER TO LINK SLOT AFFECTED, IN A
3521 JRST DLINKO ; OH, WELL
3522 PUSHJ P,LNKDEL ; DO DELETION
3526 ; COME HERE TO DELETE LINK IN SLOT POINTED AT BY A FROM BLOCK IN CMPBLK
3530 MOVN B,LNKHDR(CMPBLK) ; NUMBER OF LINKS
3532 SUBI C,LNKHDR(CMPBLK)
3533 CAIN C,(B) ; LAST LINK IN BLOCK?
3536 HRLI C,1(A) ; BLT POINTER
3537 ADDI B,LNKHDR-1(CMPBLK) ; LAST WORD IN BLT
3538 BLT C,(B) ; BLT BLOCK UP
3539 LNKDLO: AOS LNKHDR(CMPBLK) ; UPDATE COUNT
3545 ; COME HERE TO EXPAND LINK IN TAILORING. XLINK DOES A SINGLE LINK,
3546 ; XXLINK DOES ALL LINKS.
3551 PUSHJ P,LNKGET ; GET POINTER TO SLOT IN A
3552 JRST XLINKO ; NOTHING TO FROB
3553 HRRZ C,(A) ; PUT IT IN C
3556 PUSHJ P,EXPAND ; DO EXPANSION
3558 PUSHJ P,LNKDEL ; DELETE LINK FROM BLOCK, SINCE IT'S EXPANDED
3567 HRLZ B,LNKHDR(OUTPTR) ; GET COUNT
3569 HRRI B,LNKHDR+1(OUTPTR) ; AOBJN POINTER
3574 SETZM LNKHDR(A) ; ZERO COUNT
3577 BLT B,-1(A) ; ZERO ALL POINTERS
3578 JRST XLINKO ; AND LEAVE
3580 ; MAKE A COPY OF A BLOCK, WITH LINKS. RETURN COPY IN A, BLOCK TO BE COPIED
3587 MOVEI B,LNKHDR(E) ; POINTER TO BEGINNING OF OLD BLOCK
3591 ADDI A,LNALEN ; UPDATE POINTER TO NEW BLOCK
3596 ; GIVEN POINTER TO TYPE IN A, RETURN IN A NAME,,TYPE.
3602 AOBJN B,GETNLP ; MUST SUCCEED EVENTUALLY
3608 ; GET POINTER TO SLOT IN LINK AREA WE WANT TO PLAY WITH. SKIPS IF WINS.
3612 HRLZ A,LNKHDR(CMPBLK)
3613 JUMPE A,[OASCR [ASCIZ /No links?/]
3614 JRST POPDCB] ; NO LINKS, TOO BAD
3615 HRRI A,LNKHDR+1(CMPBLK)
3617 MOVEI B,[ASCIZ /Named /]
3619 PUSHJ P,COMTYP ; GET TYPE
3622 LNKGLP: HRRZ C,(B) ; SEARCH FOR SLOT
3629 ; FNDLNK CONSES UP TABLE OF ALL POINTERS TO THIS TYPE: FORMAT IS
3630 ; LNKTPT: <AOBJN POINTER TO LNKTAB>
3631 ; LNKTAB: NAME OF TYPE LINKING,,POINTER TO SLOT CONTAINING LINK
3633 ; THIS IS USED FOR THE 'LINKS?' COMMAND, FOR DELETE TYPE, RENAME TYPE,
3634 ; AND ALTER TYPE (TO DO SUBSTITUTES). TYPE IS IN A.
3640 MOVEI B,LNKTAB ; BUILD A SORT OF AOBJN POINTER
3641 MOVE F,UTYPLN ; POINTER TO USER TYPES
3643 JRST FNDLNO ; ANY TYPES DEFINED?
3644 FNDOUT: MOVE C,(F) ; POINTER TO TYPE
3645 HRLZ D,LNKHDR(C) ; NUMBER OF LINKS IN THIS BLOCK
3647 HRRI D,LNKHDR+1(C) ; AOBJN POINTER TO LINKS
3651 HLL D,C ; STUFF POINTER TO NAME IN LH
3652 MOVEM D,(B) ; SAVE IN LNKTAB
3653 HRRZM C,1(B) ; SAVE TYPE
3655 JRST FNDLPE ; END LOOP
3656 FNDINL: AOBJN D,FNDIN1 ; THROUGH WITH THIS TYPE?
3657 FNDLPE: AOBJN F,FNDOUT ; GO TO NEXT TYPE
3658 FNDLNO: TLNN B,-1 ; ANY LINKS FOUND?
3670 ; LSTLNK PRINTS ALL TYPES LINKED TO A TYPE OBTAINED FROM THE USER.
3674 PUSHJ P,FNDLNK ; GET ALL LINKS
3678 ; SAME FOR CALL FROM ALTER GROUP
3682 JRST [OASCR [ASCIZ /No links/]
3689 ; PUSHJ P HERE AFTER CALL TO FNDLNK TO PRINT NAMES OF ALL LINKS IN LNKTAB
3692 JRST [OASCR [ASCIZ /No links/]
3709 ; TYPE OF COMPILATION: EVERYBODY I'M LINKED TO
3710 MYLINK: PUSHJ P,GETTYP
3712 PUSHJ P,MYLNKP ; TAKES ARG IN A
3718 JUMPE B,[OASCR [ASCIZ /No links/]
3726 OASCR [ASCIZ /Links to:/]
3736 ; COME HERE FROM ALTER GROUP TO DO SAME
3737 MYLIN1: MOVE A,OUTPTR
3741 SUBTTL TABLES: QUESTIONS, OUTPUT, HOW TO RUN, &C.
3742 ; TYPE CODES,,QUESTION LOCATION
3745 LDQUES: QUESTION $TFSP,0,,[From ] ; QUESTION FOR LOAD & REPLACE TAILOR
3746 QTABLE: QUESTION $TSTR+%ESSEN,25.,.QSNAM,[Sname ]
3747 QUESTION $TTF+%TNMNY,0,.QNEWC,[Use new compiler? ]
3748 QUESTION %GIGNO+$TTF,27.,.QDEBU,[Debugging compiler? ]
3749 QUESTION $TFIL+%ESSEN,1,.QINP,[Input from ]
3750 QUESTION $TFIL+%ESSEN,2,.QOUT,[Output to ]
3751 QUESTION $TFSP,3,.QPREC,[Precompilation from ]
3752 QUESTION $TFSP+%ESSEN,4,.QCOMP,[Compare with ]
3753 QUESTION $TTF,22.,.QMANI,[Check macros? ]
3754 QUESTION $TSTR,23.,.QCJCL,[Extra JCL ]
3755 QUESTION $TSTR,5,.QREDO,[Redo ]
3756 QUESTION $TSTR+%ESSEN,6,.QPACK,[Package mode ]
3757 QUESTION %GIGNO+$TSTR,20.,.QGROP,[Group mode ]
3758 QUESTION %GIGNO+$TSTR,7,.QSURV,[Survivors ]
3759 QUESTION $TFSP+%NSYSD,8.,.QTEMP,[Temporary file to ]
3760 QUESTION $TFSP,9.,.QSRC,[Source file to ]
3761 QUESTION $TTF,10.,.QSPEC,[Special? ]
3762 QUESTION $TTF,12.,.QEXPF,[Expand floads? ]
3763 QUESTION $TTF,13.,.QEXPS,[Expand splices? ]
3764 QUESTION $TTF,14.,.QCARE,[Careful? ]
3765 QUESTION $TTF,15.,.QREAS,[Reasonable? ]
3766 QUESTION $TTF,16.,.QGLUE,[Glue? ]
3767 QUESTION $TTF,17.,.QMCRO,[Macro compile? ]
3768 QUESTION $TTF,21.,.QMCRF,[Macro flush? ]
3769 QUESTION $TTF,18.,.QMAXS,[Max space? ]
3770 QUESTION $TSTR,26.,.QTHN0,[First things to do ]
3771 QUESTION $TSTR+%NOQ,19.,.QTHNG,[Things to do ]
3772 QUESTION $TSTR,24.,.QTHN1,[Last things to do ]
3773 0 ; HAS TO BE ZERO--END OF REGULAR QUESTIONS
3775 CRETQ=63. ; 'NULL QUESTION', USED SOMEWHERE
3777 SUBTTL QUESTION TREE
3778 ; FORMAT: THISQ: QUESTION OFFSET OR -1 (-1-->NOT REALLY A QUESTION)
3780 ; INST: EXECUTE ME TO ASK QUESTION (OR WHATEVER)
3781 ; BACK: LOCATION TO BACK UP TO (CLOBBERED BY MAIN LOOP)
3782 ; ENTRIES GENERATED BY QTM MACRO: CALL IS
3783 ; QTM SYMBOL,QSYM,SYMYES,SYMNO,[INST]
3785 QTREE: QTM .TCOMT,<%TNOTQ+%TNMEM>_22,.TSNAM,.TCOMT,[PUSHJ P,GCOMTP] ; COMPILATION TYPE
3786 QTM .TSNAM,.QSNAM,.TNEWC,.TNEWC,[PUSHJ P,ASKSNM] ; SNAME QUESTION
3787 QTM .TNEWC,.QNEWC,.TDEBU,.TDEBU,[PUSHJ P,ASKQ] ; NEW COMPILER
3788 QTM .TDEBU,.QDEBU,.TINP,.TINP,[PUSHJ P,ASKQ] ; DEBUGGING COMPILER?
3789 QTM .TINP,.QINP,.TOUT,.TOUT,[PUSHJ P,FASKQ] ; INPUT FILE
3790 QTM .TOUT,.QOUT,.TPREC,.TPREC,[PUSHJ P,ASKQ] ; OUTPUT FILE
3791 QTM .TPREC,.QPREC,.TCOMP,.TGROP,[PUSHJ P,FASKQ] ; PRECOMPILED?
3792 QTM .TCOMP,.QCOMP,.TMANI,.TRED0,[PUSHJ P,ASKQ] ; COMPARE? (ONLY IF PRECOMPILED)
3793 QTM .TMANI,.QMANI,.TCJCL,.TCJCL,[PUSHJ P,ASKQ] ; CHECK MACROS? (IF COMPARE)
3794 QTM .TCJCL,.QCJCL,.TRUN,.TRUN,[PUSHJ P,ASKQ] ; EXTRA JCL?
3795 QTM .TRUN,<%TNOTQ+%TNBCK>_22,.TRED1,.TRED1,[PUSHJ P,MUDCOM] ; RUN MUDCOM
3796 QTM .TRED1,.QREDO,.TTEMP,.TTEMP,[PUSHJ P,ASKQ] ; ASK REDO (ONLY IF MUDCOM)
3797 QTM .TRED0,.QREDO,.TPACK,.TTEMP,[PUSHJ P,ASKQ] ; ASK REDO IF NO MUDCOM
3798 QTM .TPACK,.QPACK,.TTEMP,.TTEMP,[PUSHJ P,ASKQ] ; ASK PACKAGE MODE IF NO MUDCOM
3799 QTM .TGROP,.QGROP,.TSURV,.TTEMP,[PUSHJ P,ASKQ] ; ASK GROUP COMPILE, IF NO PREC
3800 QTM .TSURV,.QSURV,.TTEMP,.TTEMP,[PUSHJ P,ASKQ] ; ASK SURVIVORS IF GROUP COMPILE
3801 QTM .TTEMP,.QTEMP,.TSRC,.TSRC,[PUSHJ P,ASKQ] ; TEMPORARY FILE
3802 QTM .TSRC,.QSRC,.TSPEC,.TSPEC,[PUSHJ P,ASKQ] ; SOURCE
3803 QTM .TSPEC,.QSPEC,.TEXPF,.TEXPF,[PUSHJ P,ASKQ] ; SPECIAL?
3804 QTM .TEXPF,.QEXPF,.TEXPS,.TEXPS,[PUSHJ P,ASKQ] ; EXPAND FLOADS?
3805 QTM .TEXPS,.QEXPS,.TCARE,.TCARE,[PUSHJ P,ASKQ] ; EXPAND SPLICES?
3806 QTM .TCARE,.QCARE,.TREAS,.TREAS,[PUSHJ P,ASKQ] ; CAREFUL?
3807 QTM .TREAS,.QREAS,.TGLUE,.TGLUE,[PUSHJ P,ASKQ] ; REASONABLE?
3808 QTM .TGLUE,.QGLUE,.TMCRO,.TMCRO,[PUSHJ P,ASKQ] ; GLUE?
3809 QTM .TMCRO,.QMCRO,.TMAXS,.TMCRF,[PUSHJ P,ASKQ] ; MACRO COMPILE?
3810 QTM .TMCRF,.QMCRF,.TMAXS,.TMAXS,[PUSHJ P,ASKQ] ; MACRO FLUSH? (IF NOT COMPILE)
3811 QTM .TMAXS,.QMAXS,.TTHN0,.TTHN0,[PUSHJ P,ASKQ] ; MAX SPACE?
3812 QTM .TTHN0,.QTHN0,.TTHNG,.TTHNG,[PUSHJ P,ASKQ] ; FIRST THINGS TO DO
3813 QTM .TTHNG,.QTHNG,.TTHN1,.TTHN1,[PUSHJ P,ASKQ] ; THINGS TO DO
3814 QTM .TTHN1,.QTHN1,.THOWR,.THOWR,[PUSHJ P,ASKQ] ; LAST THINGS TO DO
3815 QTM .THOWR,<%TNOTQ+%TNBCK>_22,.TASK,.TCOMT,[PUSHJ P,DONE] ; HOW-TO-RUN
3816 QTM .TASK,<%TNOTQ+%TNMEM>_22,.THOWR,.THOWR,[PUSHJ P,HASK] ; QUESTION ESCAPE
3822 ; SPECIFIES OUTPUT ORDER: TYPE,,LEADING IN FIRST WORD, OFFSET INTO OUTPUT,,TRAILING
3831 $OSNAM==6 ; OUTPUT <SNAME "FOO">
3833 ; OUTPUT SPECIFICATIONS
3834 ; TYPE,OFFSET,HEADER,TRAILER
3836 OUTSPC: OUTPUT $OSNAM, .QSNAM,/<SNAME "/, CSTRNG
3837 OUTPUT $OFORM, .QNEWC,/<OR <GASSIGNED? EXPERIMENTAL!-> <NEWCOMP!->> /, CR
3838 OUTPUT $OFNAM, .QINP,/<SETG COMBAT!- /, CANGLB
3839 OUTPUT $OFNAM, .QPREC,/<SET PRECOMPILED!- /, CANGLB
3840 OUTPUT $OREDO, .QCOMP,/<SET REDO!- (/, CLIST
3841 OUTPUT $OSTRG, .QPACK,/<SET PACKAGE-MODE!- "/, CSTRNG
3842 OUTPUT $OSTRG, .QSURV,/<SET SURVIVORS!- (/, CLIST
3843 OUTPUT $OFNAM, .QTEMP,/<SET TEMPNAME!- /, CANGLB
3844 OUTPUT $OFNAM, .QSRC,/<SET SOURCE!- /, CANGLB
3845 OUTPUT $OT.FF, .QSPEC,/<SET SPECIAL!- /, CANGLB
3846 OUTPUT $OT.FF, .QEXPF,/<SET EXPFLOAD!- /, CANGLB
3847 OUTPUT $OT.FF, .QEXPS,/<SET EXPSPLICE!- /, CANGLB
3848 OUTPUT $OT.FF, .QDEBU,/<SET DEBUG-COMPILE!- /,CANGLB
3849 OUTPUT $OT.FT, .QCARE,/<SET CAREFUL!- /, CANGLB
3850 OUTPUT $OT.FT, .QREAS,/<SET REASONABLE!- /, CANGLB
3851 OUTPUT $OT.FT, .QGLUE,/<SET GLUE!- /, CANGLB
3852 OUTPUT $OT.FF, .QMCRO,/<SET MACRO-COMPILE!- /, CANGLB
3853 OUTPUT $OT.FF, .QMCRF,/<SET MACRO-FLUSH!- /,CANGLB
3854 OUTPUT $OT.FF, .QMAXS,/<SET MAX-SPACE!- /, CANGLB
3855 OUTPUT $OSTRG, .QTHN0,, CR,1
3856 OUTPUT $OSTRG, .QTHNG,, CR,1
3857 OUTPUT $OSTRG, .QTHN1,, CR,1
3858 OUTPUT $OFNAM, .QINP,/<FCOMP %.INCHAN /,
3859 OUTPUT $OFNAM, .QOUT,/ /, CANGLB
3863 OUTTBL: -2*CMPSIZ,,OUTSPC
3874 ; INITIAL TABLE OF COMPILATION TYPES. $SPTYPE MEANS THAT TYPE DOESN'T MAKE
3875 ; A PLAN--HANDLED BY TURNING OFF $SPTYPE, JRSTING TO NTH ELEMENT OF TABLE FOR
3877 NTYPTB: SYMVAL None,$SPTYPE+.TQUIT ; USED AFTER FIRST COMPILATION
3878 TYPTBL: SYMVAL Verbose,VTABLE ; VERBOSE COMPILATION--DEFAULT
3879 SYMVAL Short,STABLE ; SHORT COMPILATION
3880 SYMVAL Multiple,$SPTYPE+.TMULT ; MULTIPLE
3881 SYMVAL Toggle Verbosity,$SPTYPE+.TTOGV ; TOGGLE VERBOSITY
3882 SYMVAL Toggle MUDCOM verbosity,$SPTYPE+.TTOMV
3883 SYMVAL Toggle Input File Existence Check,$SPTYPE+.TTOEX
3884 SYMVAL More compilations,$SPTYPE+.TSMOR ; SET ANOTHER COMPILATION
3885 SYMVAL Create type,$SPTYP+.TCRTG ; CREATE TYPE
3886 SYMVAL Alter type,$SPTYP+.TALTG ; CHANGE TYPE
3887 SYMVAL Print type,$SPTYP+.TPRTG ; PRINT TYPE
3888 SYMVAL Delete type,$SPTYP+.TDELG ; DELETE TYPE
3889 SYMVAL Rename type,$SPTYP+.TRNM ; RENAME TYPE
3890 SYMVAL Xerox type,$SPTYP+.TXROX ; COPY TYPE
3891 SYMVAL Load tailor,$SPTYP+.TLDTL ; LOAD TAILOR
3892 SYMVAL Replace tailor,$SPTYP+.TRPTL ; REPLACE TAILOR
3893 SYMVAL Quit,$SPTYPE+.TQUIT ; QUIT
3894 SYMVAL Many flush,$SPTYPE+.TFLUS ; KILL LONG COMPILATION
3895 SYMVAL Many print,$SPTYPE+.TPLON ; PRINT LONG COMPILATION
3896 SYMVAL List links to type,$SPTYPE+.TLNKL ; WHO'S LINKED TO ME?
3897 SYMVAL List links from type,$SPTYPE+.TMLNK ; TO WHOM?
3899 UTYPTB: BLOCK 80. ;SPACE FOR USER-DEFINED TYPES
3901 UTPSAV: 0 ; USED IN LOAD TAILOR FOR LINK HACKING
3902 TYPLEN: ITYPLE,,TYPTBL ; INITIAL AOBJN POINTER TO TYPTBL
3903 LNKTPT: 0 ; AOBJN POINTER INTO LNKTAB
3904 LNKTAB: BLOCK 60. ; USED TO ACCUMULATE POINTERS TO A GIVEN TYPE
3906 ; TABLE FOR HOW-TO-RUN. FIRST ELEMENT IS USED IN TAILOR-MAKING, SO DEFAULT
3909 HOWTLT: SYMVAL <ASK>,-1
3911 HOWTBL: SYMVAL Waste,.HWASTE
3912 SYMVAL Combat,.HCOMBT
3914 SYMVAL Pcomp,.HPCOMP
3917 HOWTBL: SYMVAL Pcomp,.HPCOMP
3918 SYMVAL Combat,.HCOMBT
3924 SYMVAL Question,.HQUES
3925 SYMVAL Type plan,.HPRIN
3928 HOWSPC==3 ; NUMBER OF THINGS AT END THAT CAN'T BE TAILORED
3930 ; TABLE FOR TAILORING MORE COMPILATIONS? USED BY COMTYP, SO DEFAULT IS
3932 TMORTB: SYMVAL <ASK>,-1
3938 MORPMP: ASCIZ /Another compilation?/
3941 ;TABLE FOR VERBOSE COMPILATIONS
3942 VTABLE: %IGNOR,,0 ; SNAME
3943 %ASK,,0 ; NEW COMPILER
3944 %ASK,,0 ; DEBUGGING COMPILER
3946 %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ />/] ? 0 ? 0] ; INPUT
3949 %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /MUD/] ? 0 ? 0] ; INPUT
3951 %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /NBIN/] ? 0 ? 0] ; OUTPUT
3952 %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /NBIN/] ? 0 ? 0] ; PRECOMP
3953 %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /NBIN/] ? 0 ? 0] ; COMPARE
3954 %ASK,,0 ; MANIFEST SWITCH
3957 %ASK,,0 ; PACKAGE MODE
3958 %IGNOR,,0 ; GROUP MODE
3959 %IGNOR,,0 ; SURVIVORS
3960 %IGNOR,,0 ; TEMPNAME
3961 %IGNOR,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /SOURCE/] ? 0 ? 0]; SOURCE
3962 %IGNOR,,0 ; SPECIAL?
3964 %IGNOR,,0 ; EXPSPLICE
3966 %ASK,,1 ; REASONABLE
3968 %IGNOR,,0 ; MACRO COMPILE
3969 %IGNOR,,0 ; MACRO FLUSH
3970 %IGNOR,,0 ; MAX SPACE
3971 %IGNOR,,0 ; FIRST THINGS
3972 %ASK,,0 ; THINGS TO DO
3973 %IGNOR,,0 ; MORE THINGS
3988 ; SUPER-SHORT: DEFAULTS EVERYTHING BUT NEW COMPILER, HOW TO RUN, AND INPUT
3993 %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ />/] ? 0 ? 0]
3996 %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ />/] ? 0 ? 0]
3998 %IGNOR,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /NBIN/] ? 0 ? 0]
4035 ; QUESTIONS FOR TAILOR
4037 TAILTB: SYMVAL Sname,.QSNAM
4038 SYMVAL New compiler?,.QNEWC
4039 SYMVAL Debugging compiler?,.QDEBU
4040 SYMVAL Input file,.QINP
4041 SYMVAL Output file,.QOUT
4042 SYMVAL Precompilation,.QPREC
4043 SYMVAL Compare with,.QCOMP
4044 SYMVAL Check macros?,.QMANI
4045 SYMVAL Extra JCL,.QCJCL
4047 SYMVAL Package mode,.QPACK
4048 SYMVAL Survivors,.QSURV
4049 SYMVAL Temporary file,.QTEMP
4050 SYMVAL Source file,.QSRC
4051 SYMVAL Special?,.QSPEC
4052 SYMVAL Expand floads?,.QEXPF
4053 SYMVAL Expand splices?,.QEXPS
4054 SYMVAL Careful?,.QCARE
4055 SYMVAL Reasonable?,.QREAS
4057 SYMVAL Macro compile?,.QMCRO
4058 SYMVAL Macro flush?,.QMCRF
4059 SYMVAL Max space?,.QMAXS
4060 SYMVAL First things to do,.QTHN0
4061 SYMVAL Things to do,.QTHNG
4062 SYMVAL Last things to do,.QTHN1
4063 SYMVAL Another compilation?,MORLOC ; MORLOC=38
4064 SYMVAL How to run,HOWLOC
4065 SYMVAL Set question default,$SQDEF
4067 SYMVAL Delete question,$DELQ
4068 SYMVAL Print current type,$PRTYP
4069 SYMVAL Link to type,$CLINK
4070 SYMVAL Unlink from type,$DLINK
4071 SYMVAL Expand link to type,$XLINK
4072 SYMVAL Expand all links,$XXLIN
4073 SYMVAL List links to current type,$LLINK
4074 SYMVAL List links from current type,$PLINK
4076 TAILSP==10. ; # OF UNREAL QUESTIONS
4077 TALSPC==12. ; # OF QUESTIONS WITH UNTOUCHABLE DEFAULTS
4079 JCLIOT: ILDB A,JCLPTR
4083 JCLLOS: SETZM JCLINP
4088 .BREAK 12,[5,,JCLBUF]
4092 MOVE A,[440700,,JCLBUF]
4097 PRHELP: JUMPN C,RCMDL ; ONLY ON FIRST CHARACTER
4098 LDB A,[410300,,PRMPT1]
4121 Symbolic input accepted.
4122 To complete a response, type <space>.
4123 To complete and terminate a response, type <altmode> or <cr>.
4124 To use the default, type <altmode> or <cr>.
4130 HLPCMT: HLRZ A,PRMPT1
4147 Input text terminated by an altmode/
4149 To use the default, type <altmode>.
4150 The current default is /
4162 Input a file name. Typing an <altmode> will indicate a negative response.
4163 To get the current default, type <space> <altmode>.
4164 The current default is /
4172 Input a file name. Typing an <altmode> will cause the default to be used.
4173 The current default is /
4183 HLPFDF: MOVE A,(OUTPTR)
4188 SUBTTL INPUT ROUTINES
4190 ; PUSHJ P,ASK TO READ AN ANSWER AND FILL IN THE STUFF
4191 ASK: MOVE A,QTABLE(QOFF); GET THE TYPE WORD AND QUESTION
4194 MOVEM A,PRMPT1 ; SAVE AS THE PROMPT
4199 JRST [MOVEI B,SYMPR2
4201 MOVE B,[TFTLEN,,TFTBL]
4206 JRST [MOVEI B,FILPR2
4210 JRST [MOVEI B,FSPPR2
4221 LDB A,[410300,,QTABLE(QOFF)]
4224 BADTYP: FATINS BAD TYPE CODE
4236 ; A HAS SYMBOL TABLE (1 OF WHICH IS THE DEFAULT)
4237 ; RETURNS IN A THE VALUE OF THE SYMBOL
4241 MOVSI O,$TSYMBOL+%RDCMT+%RDCRT
4255 MOVE A,[440700,,INPBUF]
4260 TFATBL: SYMVAL <ASK>,-1
4270 PRSSTR: JUMPE C,CPOPJ
4277 ; TAKES THE CHARACTER COUNT IN C, COPIES THE INPUT BUFFER INTO SOME NEW CORE
4278 ; AND RETURNS THE ADDRESS IN D
4293 ; PARSE TRUE/FALSE TYPE QUESTIONS
4295 PRSTF: SKIPN INPBUF ; NO INPUT?
4296 JRST [MOVEI B,[ASCIZ /Yes/]
4298 MOVEI B,[ASCIZ /No/]
4302 MOVE A,[440700,,INPBUF]
4303 MOVE B,[TFTLEN,,TFTBL]
4308 ; TWENEX FILE NAME READING
4309 ; READ A FILE NAME WITH DEFAULTS
4319 XASKF0: MOVE A,(OUTPTR)
4321 MOVEI B,GTJFN2+.GJDEV
4322 XASKFL: SKIPN (A) ; FILL IN FILE NAME DEFAULTS
4324 HRRO C,(A) ; WITH -1 IN LH
4327 AOBJN A,XASKFL ; LOOP THROUGH DEV, SNM, FN1, FN2
4331 SFMOD ; GODDAMN GTJFN!
4332 XASKFA: MOVEI A,GTJFN2
4335 MOVEM C,GTJFN2+.GJRTY ; SETUP PROMPT
4341 JRST [MOVE A,[GTJFN2+1,,GTJFNN+1]
4349 PUSH P,A ; SAVE THIS GODAWFUL JFN
4353 SFMOD ; GODDAMN GTJFN!
4354 MOVE E,[-5,,JFNSBT] ; AOBJN FOR JFNS'ING
4355 MOVE F,(OUTPTR) ; POINTER TO BLOCK
4356 SETZ D, ; D IS ALWAYS 0 FOR JFNS
4361 HRROS A ; POINTER TO STRING
4363 MOVE C,(E) ; CORRECT BIT FOR PARSING ONE FIELD
4365 JRST [TLNN B,(GJ%UHV) ; WAS HIGHEST GIVEN BY DEFAULT?
4368 MOVEM B,(A) ; MAKE IT 0, THEN... HACK, HACK
4370 JFNS ; PARSE THE NAME
4372 AOBJN E,XASKF1 ; UPDATE POINTERS
4373 POP P,A ; RESTORE JFN (NOT NEEDED ANYHOW)
4378 XASKF2: PUSHJ P,ECHOFF
4379 SETZM INPBUF ; THIS IS SO FILESPECS WILL FALL OUT
4380 CAIN A,GJFX34 ; ? TYPED
4382 CAIN A,GJFX37 ; NULL BUFFER
4386 XASKF6: OASC [ASCIZ / Aborted? /]
4397 XASKF4: MOVEI A,.PRIIN
4402 XASKF5: OASC [ASCIZ / ERROR - /]
4409 SUB P,[1,,1] ; BACK TO FASKQ
4412 XASKFH: MOVE A,QTABLE(QOFF)
4424 Input a file name. Typing a <rubout> will indicate a negative response.
4425 To get the current default, type <space> <altmode>.
4426 The current default is /
4433 XHLPFD: MOVE A,(OUTPTR)
4455 GTJFNN: GJ%OLD+GJ%FLG+GJ%XTN ; IN THIS BLOCK, FILE MUST EXIST
4458 GTJFN2: GJ%OFG+GJ%XTN
4474 ; GIVEN A POINTER TO A FILE NAME BLOCK IN A, CONS THE
4475 ; WHOLE FILE NAME WITH GTJFN AND SKIP RETURN WITH A
4476 ; POINTER TO THE ASCIZ STRING NAME (A LA JFNS) IN A
4481 MOVEI B,GTJFNE+.GJDEV
4485 XFNX1: HRRO C,(A) ; FILL IN THE FIELDS
4491 GTJFN ; ASK FOR JFN (MUST EXIST!)
4494 MOVEI A,30. ; PLACE TO WRITE STRING
4517 ; PARSE FILE INPUT SPECIFICATIONS
4519 PRSFIL: PUSHJ P,FPARSE
4520 JRST [OASC [ASCIZ / - Illegal character in file name/]
4529 PRSFIX: MOVE A,(OUTPTR)
4547 PRSFID: MOVE A,QTABLE(QOFF)
4554 ;IN A, THE POINTER TO ASCIZ
4555 ;A HAS BEEN PUSHED PREVIOUSLY
4560 CAMN B,[ASCIZ /
\18/]
4563 CAMN B,[ASCIZ /
\16\18/]
4567 CAME B,[ASCIZ /
\19/]
4570 CAME B,[ASCIZ /
\16\19/]
4577 XSPNM2: MOVE B,-2(P)
4584 GETFNM: SPNAME B ; IS GIVEN NAME CTRL-X OR CTRL-Y?
4586 SETOM DIDEXP ; CTRL-X OR CTRL-Y HAPPENED
4590 MOVE B,SYSFN1 ; SO GET FIRST FILE NAME
4593 GETFN1: MOVE B,SYSFN2
4596 PRSFSP: SKIPN INPBUF
4597 JRST [SETZM (OUTPTR)
4602 ; COME HERE TO PARSE A FILE NAME.
4603 ; DEPOSIT THE STUFF IN 4 WORDS AT FILNAM
4605 FPSYS: MOVE B,(OUTPTR) ; PICK UP POINTER TO NAMES IF ^X OR ^Y APPEARS
4608 MOVE C,[-FSPSIZ,,DEVICE]
4611 JRST [SPNAM1 A ; SKIPS IF NOT ^X OR ^Y--INVERSE OF SPNAME
4622 FPARSE: MOVE E,[440700,,INPBUF]
4625 MOVE B,[DEVICE,,DEVICE+1] ;CLEAR ALL NAMES
4627 FPARSS: MOVEI A,FSPSIZ
4633 MOVE F,A ;BP TO NAME AREA
4636 GETCHR: ILDB B,E ;FIND NEXT NON-EMPTY CHARACTER
4637 JUMPE B,[SETOM ENDSW
4644 JRST DEV ;DEVICE NAME
4647 FIELD1: CAIE B,40 ;HERE TO GET A NAME
4649 JRST FNAM ;SPACE AND TAB MAKE FNAME1 AND 2
4652 JRST FNAM ;SO DO 0 AND <CR>
4656 CAIN B,^Q ;HANDLE QUOTING
4658 CAIGE B,40 ;SUBI B,40 < 0 (BAD CHARACTER)
4661 SUBI B,40 ;CASE CONVERSION
4684 SKIPE FNAME1 ;DOES HE HAVE AN FNAME1 ALREAD?
4685 JRST FNAM2 ;YES - OOPS. HE IS GIVING TWO NAMES
4686 MOVEM A,FNAME1 ;NO - TRY IT AS FNAME1
4689 FNAM2: MOVEM A,FNAME2 ;PUT NEW NAME INTO FNAME2
4692 FNMCNT: MOVE B,NAMCNT ;PUT COUNT IN HERE
4702 MOVEI 1,.PRIOU ;ENTER HERE FOR THINGS THAT BLANK INCIDENTALLY
4705 TRZ 2,TT%DAM ;BINARY MODE
4708 HRROI 1,BLNKTB(2) ;GET RIGHT MAGIC
4716 BLNKTB: REPEAT 4, <.BYTE 7 ? 15 ? 12 ? 0> ; 0-3
4717 <.BYTE 7 ? 177 ? 220-176 ? 0> ; 4 IMLACS
4718 <.BYTE 7 ? 35 ? 36 ? 0> ; 5 DM
4719 <.BYTE 7 ? 33 ? "H ? 33 ? "J ? 0> ; 6 HP2640
4720 REPEAT 4 ? <.BYTE 7 ? 15 ? 12 ? 0> ; 7-10
4721 <.BYTE 7 ? 33 ? "H ? 33 ? "J ? 0> ; 11 VT50
4722 <.BYTE 7 ? 15 ? 12 ? 0> ; 12
4723 <.BYTE 7 ? 33 ? "( ? 177 ? 0> ; 13 LP
4724 <.BYTE 7 ? 15 ? 12 ? 0> ; 14
4725 <.BYTE 7 ? 33 ? "H ? 33 ? "J ? 0> ; 15 VT52
4726 REPEAT 3, <.BYTE 7 ? 15 ? 12 ? 0> ; ETC
4731 ; IN (P) IS THE WORD WHICH ITS WOULD LIKE
4757 ; CONVERT ASCII NAME IN A TO SIXBIT WORD IN A
4764 HRLI B,440700 ; B POINTS TO ASCII BLOCK
4766 MOVE C,[440600,,A] ; C POINTS TO A (SIXBIT WORD)
4773 TLNE C,770000 ; SKIP IF A IS FULL
4777 ; CONVERT SIXBIT NAME IN A TO STANDARD ASCII POINTER
4778 ; I.E. WORD-COUNT(=2),,POINTER
4780 SIXASC: PUSH P,B ; SAVE RANDOM ACS
4783 PUSH P,A ; TEMPORARILY SAVE SIXBIT WORD
4785 PUSHJ P,IBLOCK ; GET BLOCK FOR ASCII
4786 POP P,B ; RESTORE SIXBIT WORD
4787 PUSH P,A ; SAVE ASCII BLOCK POINTER
4788 HRLI A,440700 ; POINTER TO ASCII BLOCK
4789 MOVE C,[440600,,B] ; POINTER TO SIXBIT WORD
4790 SIXASL: ILDB D,C ; GET CHARACTER
4791 JUMPE D,SIXAS1 ; FINIS
4793 IDPB D,A ; DEPOSIT CHARACTER
4796 SIXAS1: POP P,A ; FINISHED. RESTORE POINTER
4797 HRLI A,2 ; 2 IN LH (WORD COUNT)
4798 SIXAS2: POP P,D ; AND RETURN
4804 ; GENERAL PURPOSE MATCH LOSSAGE HANDLERS
4806 ; COMPS GIVEN BP'S IN A AND E, RETURNS THE NUMBER OF = LETTERS
4808 COMPS: SETZ F, ; COUNT OF MATCHING CHARACTERS
4810 JUMPE C,[MOVE C,E ; COPY THE BP TO TABLE ENTRY
4812 SKIPN C ; THIS ZERO ALSO??
4813 MOVEM B,SMEXAC ; YES. THIS IS AN EXACT MATCH
4815 TRO C,40 ; LOWER CASE
4818 TRO D,40 ; LOWER CASE
4821 POPJ P, ; LOSE IMMEDIATE
4824 ; LIST POSSIBILITIES. AC'S AS BELOW
4828 OASCR [ASCIZ /The following are possible: /]
4832 ; SYMBOL-TABLE MATCH HACKER
4833 ; A = BYTE POINTER TO INPUT BLOCK
4834 ; B = AOBJN POINTER TO SYMBOL TABLE
4835 ; C = # OF CHARS IN INPUT BUFFER
4836 ; LSTBRK HAS LAST BREAK CHARACTER
4840 MOVEM C,INPLEN ; SAVE INPUT LENGTH
4841 SETZM SMEXAC ; ZERO SOME SWITCHES
4845 SMLP2: MOVE A,(P) ; GET BP TO INPUT BUFFER
4847 HRLI E,440700 ; GET BP TO TABLE ENTRY
4848 PUSH P,E ; AND SAVE IT
4849 PUSHJ P,COMPS ; GET THE MATCHING
4850 JRST SMNEXT ; DOES NOT MATCH. GO TO NEXT ENTRY.
4851 SKIPL -2(P) ; IS THIS A CONTROL-F?
4852 JRST SMWINR ; NO. HACK THIS ENTRY
4853 AOS SMNUM ; INCREMENT THE COUNT OF WINNERS
4854 HLRZ E,(B) ; YES. PRINT THE ENTRY
4856 SMNEXT: POP P,E ; RESET THE STACK
4857 SMNXT1: AOBJN B,SMLP2 ; LOOP ON THE SYMBOL TABLE
4858 POP P, ; RESTORE BP TO INPUT BUFFER
4860 JUMPL A,SMNPOS ; THIS WAS PUSHJ P,SPOSS
4861 MOVE D,SMBEST ; GET THE BEST BP
4862 MOVE B,INPSAV ; AND THE INPUT BUFFER
4863 ADD B,[70000,,] ; DECREMENT THE POINTER
4866 SKIPN A,SMBLEN ; ANY CHARACTERS TO COMPLETE?
4867 JRST [SKIPE SMEXAC ; NO. IS THERE AN EXACT MATCH?
4868 JRST SMEXOK ; YES. WIN IMMEDIATE
4869 JRST SMMDON] ; NO. CHECK FOR PARTIAL MATCHES, ETC.
4871 ; COME HERE TO COMPLETE
4873 SMDEP: ILDB E,D ; GET THE NEXT CHARACTER
4875 IDPB E,B ; DEPOSIT INTO THE INPUT BUFFER
4876 SOJN A,SMDEP ; CONTINUE
4877 SMMDON: MOVE D,SMNUM ; GET THE NUMBER OF MATCHES
4879 JRST SMTERM ; YES. TERMINATE
4880 SMCONT: SKIPE JCLINP ; JCL INPUT?
4881 JRST SMLOSR ; YES. CHOMPER.
4882 JUMPE D,SMLOSE ; NO MATCHES. LOSE, LOSE
4883 AOS XTRCHR ; INCREMENT EXTRA CHARACTER COUNT
4885 OASCI "& ; AND PRINT CONTINUATION CHAR
4887 SMCNT1: MOVE C,SMBLEN
4888 ADD C,INPLEN ; UPDATE CHARACTER COUNT FOR READER
4889 MOVE D,INPACT ; GET THE ACTIVATION FOR INPUT
4891 JRST RCMD1 ; RETURN TO READER
4893 SMLOSR: OASC [ASCIZ /Matching error - JCL input aborted/]
4895 SMLOSE: OASC [ASCIZ / No symbol matches input /]
4896 SETZM JCLINP ; FLUSH INPUT FROM JCL
4897 MOVE D,INPACT ; GET THE ACTIVATION FOR INPUT
4899 JRST GETLNS ; RETURN TO READER
4901 ; COME HERE WHENEVER A SYMBOL TABLE ENTRY MATCHES THE INPUT IN THE BUFFER
4903 SMWINR: MOVEM A,INPSAV ; SAVE POINTER TO INPUT BUFFER
4904 AOS SMNUM ; INCREMENT # OF MATCHES
4905 SKIPN A,SMBEST ; CHECK FOR BEST SO FAR
4906 JRST SMFRST ; NONE. CREATE ONE
4907 MOVEM E,(P) ; SAVE THE BP TO THIS ENTRY
4908 PUSHJ P,COMPS ; COMPARE THIS ENTRY TO BEST SO FAR
4910 CAML F,SMBLEN ; ARE THERE FEWER MATCHES THAN BEST?
4911 JRST SMNEXT ; NO. NEXT VICTIM
4912 POP P,SMBEST ; MAKE THIS THE BEST SO FAR
4913 MOVEM B,SMVAL ; SAVE VALUE WORD
4914 MOVEM F,SMBLEN ; SAVE BEST LENGTH
4915 JRST SMNXT1 ; CHECK ON
4917 SMFRST: MOVEM E,SMBEST ; SAVE BP TO THE REMAINDER AS BEST
4918 PUSHJ P,STRLEN ; GET ITS LENGTH
4919 MOVEM E,SMBLEN ; AND MAKE IT BEST LENGTH
4920 MOVEM B,SMVAL ; SAVE VALUE WORD
4921 JRST SMNEXT ; GET NEXT ENTRY
4923 ; COME HERE IF THERE IS AN EXACT MATCH OR ONLY ONE POSSIBLE COMPLETION
4925 SMEXOK: MOVE A,SMEXAC ; HAVE EXACT MATCH
4926 MOVEM A,SMVAL ; SAVE IT
4927 SMTERM: MOVE E,LSTBRK ; GET THE BREAK CHARACTER
4928 CAIE E,33 ; IF ALTMODE, TERMINATE
4929 JRST SMTRM1 ; ELSE, CHECK ON
4930 OASCI (E) ; PRINT TERMINATION CHARACTER
4931 SMTRM2: MOVE A,SMVAL
4932 HRRZ A,(A) ; GET THE VALUE IN A AND RETURN
4935 SMTRM1: CAIE E,^M ; IS THE BREAK A <CR>
4936 JRST SMTRM3 ; NO. COMPLETE ONLY
4938 TLNE A,%RDCRT ; IS THE TERMINATE ON <CR> BIT SET?
4939 JRST SMTRM2 ; YES. TERMINATE
4940 SMTRM3: AOS XTRCHR ; NO. GIVE AN EXCL AND WAIT
4944 ; COME HERE AT END OF CONTROL-F HACK
4946 SMNPOS: SKIPN SMNUM ; ANY POSSIBILITIES MATCH?
4947 OASCR [ASCIZ / None possible /]
4950 ; GET THE LENGTH OF A STRING POINTED TO BY E
4958 ; CLEAR THE INPUT BUFFER
4960 CLINBF: SETZM INPBUF
4961 MOVE O,[INPBUF,,INPBUF+1]
4962 BLT O,INPBUF+INPBLN-1
4965 ; COPY THE INPUT BUFFER INTO TINBUF
4967 MOVE A,[INPBUF,,TINBUF]
4968 BLT A,TINBUF+INPBLN-1
4971 ; COPY TINBUF BACK INTO THE INPUT BUFFER
4973 MOVE A,[TINBUF,,INPBUF]
4974 BLT A,INPBUF+INPBLN-1
4978 ; PUSHJ P,GETLIN READS TO AN ALTMODE AND FILLS IN THE INPUT BUFFER
4981 GETLNS: SETOM SYMMOD
4983 GETLIN: SETZM SYMMOD
4984 GETLN1: SETZM XTRCHR
4986 MOVEM RET,INPACT ; SAVE "ACTIVATION"
4991 RCMD: MOVE B,[440700,,INPBUF]
4993 SETOM INREAD ; HAVE REASONABLE INPUT BUFFER TO REDISPLAY
4994 MOVEI C,0 ; COUNT OF CHARACTERS
4997 SETZM MDOVCF ; CLEAR ERROR FLAGS
4999 RCMDER: SKIPE JCLINP ; COME HERE IF ERROR FLAG JUST SET
5000 REBLK: JSP RET,JCLIOT ; FOR HYSTERICAL REASONS
5009 OCTLP "L ; CLEAR ERROR MESSAGE, IF EXISTS
5014 SKIPE RQUOTE ; IN QUOTE MODE?
5020 CAIN A,^W ; ERASE A WORD
5022 CAIN A,^X ; ERASE A LINE
5024 TLNN O,$TFILE ; DOESN'T WORK IN FILE MODE
5027 CAIN A,^K ; ERASE AN OBJECT
5029 TLNE O,700000 ; STRING?
5030 JRST WDFLUS ; NO, SO TURN INTO WORD FLUSH
5037 JRST GACK ; GET FROM GROUP
5039 CAIN A,^D ; DISPLAY BUFFER
5041 CAIN A,^L ; CLEAR SCREEN AND DISPLAY BUFFER
5049 CAIN A,33 ; TERMINATE ON ALTMODE
5051 CAIE A,^B ; MAKE CONTROL-B DO BACK UP ALSO (LIKE FOR 20X)
5062 FATINS PDL OVERFLOW ON NON-EXPANDABLE PDL
5065 JRST RCMD1 ; WHAT THE FUCK HAPPENS HERE?
5074 SKIPN SYMMOD ; HERE ON ALTMODE
5075 ECHO ; ECHO NON-SYMBOL ALTMODES
5076 RCMDX1: MOVEM A,LSTBRK ; SAVE BREAK CHARACTER
5077 MOVEI A,0 ; DEPOSIT ZERO
5083 RSTBUF: ECHO ; ECHO THE CHAR AND CLEAR THE BUFFER
5087 MOVE B,[440700,,INPBUF]
5090 POSCHK: SKIPN CSYMTB
5092 MOVE A,[440700,,INPBUF]
5096 PUSH BK,[0] ; CREATE ACTIVATION FOR ABORT
5100 SETOM LONGOT ; ENABLE MORES, ^R ^S TO STOP
5102 SETZM LONGOT ; DISABLE
5104 POSCHR: PUSHJ P,PPRMPT
5115 CRCHK: HLRZ D,PRMPT1
5129 PPRMPT: OASC @PRMPT1
5135 OASCR [0] ; RETYPE LINE
5138 REPPER: PUSHJ P,PPRMPT
5144 ; CHARACTER COUNT IS IN C, BYTE POINTER IS IN B
5146 RUB: PUSHJ P,RUBBER ; FLUSH A CHAR
5147 JRST RCMDXX ; NONE LEFT--REDISPLAY PROMPT
5148 JRST RCMD1 ; JUST KEEP FROBBING
5150 RUBBER: SOJL C,CPOPJ
5151 LDB A,B ; GET CHARACTER
5154 XCT XCTRUB ; DO THE RUBOUT
5157 POPJ P, ; SKIP RETURN, WITH CHARACTER IN A
5159 RUBECH: OASCI (A) ; ECHO
5162 ; MUCH OF THE FOLLOWING IS RIPPED OFF FROM MUDDLE
5165 PUSHJ P,RCPOS ; GET CURSOR POSITION
5166 PUSHJ P,CHRTYP ; GET CHARACTER TYPE
5167 SKIPGE C,FIXIM2(C) ; # OF CHARS, OR ROUTINE TO HACK IT
5168 JRST (C) ; SPECIAL ROUTINE
5169 OCTLP "X ; RUB IT OUT
5170 SOJG C,.-1 ; UNTIL DONE
5175 ; RETURN CHARACTER TYPE (OFFSET INTO FIXIM2 AND FIXIM3) IN C. CHARACTER IS IN A
5177 CAIG A,37 ; SKIP IF MIGHT BE FUNNY
5179 CAIN A,177 ; RUBOUT?
5180 AOJA C,CPOPJ ; TWO CHARACTERS WIDE
5183 IDIVI A,12. ; GET WORD TO ACCESS
5184 MOVE A,FIXIML(A) ; FROM FIXIML TABLE
5186 ROTC A,3(B) ; GET CODE INTO LOW END OF B
5187 ANDI B,7 ; AND KILL EVERYTHING ELSE
5188 MOVEI C,(B) ; PUT IT IN C
5195 SKIPE TOFCI ; TV KEYBOARD?
5202 BSKILL: AOS CHPOS ; GET NEW HPOS +8.
5206 CGKILL: JRST RUBDON ; CTRL-G TAKES NO SPACE
5208 TBKILL: PUSHJ P,GHPOS ; FIND NEW POSITION
5210 OCTLP "L ; CLEAR TO END OF LINE
5213 CRKILL: PUSHJ P,GHPOS
5223 ; TAKES NUMBER OF LINES TO GO UP IN A, POSITIONS CURSOR AT END OF LAST LINE REMAINING
5224 LNSTRV: CAMLE A,CVPOS
5226 SOJE A,LNONE ; SPECIAL CASE FOR ONE LINEFEED
5227 OCTLP "H ; GO TO BEGINNING OF LINE
5229 LNSLOP: OCTLP "L ; KILL LINE AND GO UP
5231 SOS CVPOS ; UPDATE CVPOS
5232 SOJGE A,LNSLOP ; LOOP
5234 OHPOS @CHPOS ; FROB HORIZONTAL POSITION
5235 OCTLP "L ; AND CLEAR THE LAST LINE
5238 LNONE: OCTLP "U ; DO LINE STARVE
5240 LNREDO: OCTLP "T ; HOME UP AND CLEAR FIRST LINE
5242 PUSHJ P,PPRMPT ; REDISPLAY PROMPT
5243 OASC INPBUF ; INPUT BUFFER
5244 PUSHJ P,RCPOS ; READ CURSOR POSITION
5247 ; TABLE OF CHARACTER LENGTHS OR SPECIAL ROUTINES
5250 SETZ FOURQ ; CTRL-Z AND CTRL-_
5251 SETZ CRKILL ; SETZ SO SKIPGE WON'T
5252 SETZ LFKILL ; LINE FEED
5253 SETZ BSKILL ; BACK SPACE
5255 SETZ CGKILL ; CTRL-G
5257 ; INSTRUCTIONS TO GET CHARACTER WIDTHS ON DISPLAY, INTO C
5260 PUSHJ P,CNTCTZ ; MAY BE EITHER TWO OR FOUR
5264 PUSHJ P,CNTTAB ; GET WIDTH OF TAB
5267 SKIPN TOFCI ; TV KEYBOARD?
5271 CNTTAB: ANDCMI O,7 ; ZERO LOW THREE BITS OF POSITION COUNT
5272 ADDI O,10 ; AND ADD 8
5276 FIXIML: 111111,,175641 ; CTRL @ABCDE,,FGHIJK
5277 131111,,111111 ; LMNOPQ,,RSTUVW
5278 112011,,120000 ; XYZ[\],,^_
5280 ; READ CURSOR POSITION, PUT IN CHPOS AND CVPOS
5294 ; COME HERE TO FIND CURRENT HORIZONTAL POSITION (GIVEN THAT CURSOR ISN'T
5295 ; IN THE RIGHT PLACE, DUMMY). PUT IT IN CHPOS. ACCUMULATE IN 0
5302 MOVE D,PRMPT1 ; PICK UP LONG PROMPT
5303 PUSHJ P,CNTSTR ; GET LENGTH OF IT IN O
5308 GHPOS1: MOVEI D,INPBUF
5318 CNTSTR: HRLI D,440700 ; BYTE POINTER TO STRING
5319 CNTST1: ILDB A,D ; GET CHARACTER
5320 JUMPE A,CPOPJ ; NULL TERMINATES
5326 ADD O,C ; UPDATE COUNT
5327 JRST CNTST1 ; AND TRY AGAIN
5329 ; RUB OUT A WORD: STOP AT <CR>, <LF>, <TAB>, OR <SP>, RUBBING OUT AT LEAST
5330 ; ONE CHARACTER NOT IN THAT SET.
5332 WDFLUS: PUSHJ P,RUBBER ; RETURNS DEAD CHAR IN A
5333 JRST RCMDXX ; RAN OUT OF CHARACTERS
5334 PUSHJ P,BREAK ; BREAK CHARACTER?
5335 JRST WDFLU1 ; NO, SO GO TO SECOND LOOP
5336 JRST WDFLUS ; KEEP TRYING
5337 WDFLU1: JUMPE C,RCMD1
5338 LDB A,B ; GET CHARACTER ABOUT TO FLUSH
5341 JRST RCMD1 ; FOUND A BREAK, SO STOP
5342 WDFLU2: PUSHJ P,RUBBER
5346 ; SKIP IF CHARACTER IN A IS ONE OF <SP>, <CR>, <LF>, <TAB>, <;>
5357 ; DELETE A LINE. IF AT BEGINNING OF LINE (FIRST CHAR IS CTRL-J, DELETE
5359 LNFLUS: PUSHJ P,RUBBER ; ONE CHARACTER WILL ALWAYS BE FLUSHED
5362 CAIN A,^J ; FINISHED?
5365 DPB O,B ; ZERO THE CHAR
5367 SOJLE C,LNLEAV ; OUT OF CHARS?
5372 POP P,B ; LOOK AT THE CHARACTER BEFORE THE CTRL-J
5374 JRST LNFLKL ; CTRL-M, SO JUST KILL THE LINE
5375 LNLEAV: PUSHJ P,GHPOS
5376 LNLEV1: SKIPN TOERS ; CAN WE DO ERASE?
5377 JRST [OASCR [ASCIZ / XXX?/]
5379 OHPOS @CHPOS ; GET HORIZONTAL POSITION
5380 OCTLP "L ; AND CLEAR LINE
5382 LNFLKL: SETZM CHPOS ; HORIZONTAL POSITION IS 0
5383 JRST LNLEV1 ; GO DO IT
5385 ; FLUSH A MUDDLE OBJECT. FIRST FLUSH TRAILING BLANKS, REGARDLESS.
5386 MDFLUS: SKIPE MDOVCF ; OVERCLOSE IMMEDIATELY BEFORE-->CTRL-@
5387 JRST RSTBUF ; KILL BUFFER
5388 JUMPE C,RCMDXX ; NOTHING HERE
5392 MDSFLP: LDB A,B ; GET A CHAR
5393 PUSHJ P,BREAK ; BREAK?
5399 ; WE NOW HAVE A NON-BREAK IN A, READY TO BE GROSSLY FROBBED.
5402 PUSHJ P,RITBKT ; RIGHT BRACKET?
5404 JRST MDOBJF ; YES--WE REALLY HAVE AN OBJECT TO FLUSH
5405 MDFLU2: PUSHJ P,LFTBKT ; LEFT BRACKET?
5406 JRST MDATOM ; NO--THIS MUST BE AN ATOM OR SOMETHING
5407 PUSHJ P,RUBBER ; YES--JUST RUB IT OUT
5409 JRST MDFLOT ; AND LEAVE
5410 ; KILL AN ATOM--GO TO BREAK OR TO UNQUOTED BRACKET
5411 MDATOM: PUSHJ P,RUBBER ; FLUSH A CHAR
5414 LDB A,B ; GET THE NEXT ONE
5415 PUSHJ P,BREAK ; BREAK?
5417 PUSHJ P,QUOTEQ ; QUOTED?
5418 JRST MDFLOT ; NO, SO DONE
5419 JRST MDATOM ; YES, SO FLUSH IT
5420 MDATO1: PUSHJ P,LFTBKT ; LEFT BRACKET?
5422 JRST MDFLOT ; YES, SO DONE
5423 MDATO2: PUSHJ P,RITBKT
5424 JRST MDATOM ; NOT A BRACKET, SO FLUSH IT
5427 ; HAVING FINISHED THE TRIVIA, WE NOW GET TO THE INTERESTING STUFF--
5428 ; FLUSHING A MUDDLE OBJECT. 'DISGUSTING' DOESN'T DO THIS CROCK JUSTICE.
5429 MDOBJF: PUSH P,BK ; WE USE THE BK STACK FOR STORING BRACKETS
5432 PUSH P,C ; SAVE OLD BUFFER, SINCE MAY NOT DO ANYTHING
5434 MOVEI D,0 ; USE TO ACCUMULATE CTRL-J'S PASSED
5436 MDOBLP: SOJLE C,OVERCL ; OUT OF CHARS BEFORE TERMINATION, SO ERROR
5438 LDB A,B ; GET A CHARACTER
5439 PUSHJ P,RITBKT ; RIGHT BRACKET?
5440 JRST MDOBJ1 ; NO, TRY SOMETHING ELSE
5442 JRST MDSTRG ; YES, GO HACK IT
5443 PUSH BK,A ; ELSE, SAVE THE CHAR
5444 MDPDLO: JRST MDOBLP ; AND GO TO THE NEXT CHARACTER
5445 MDOBJ1: PUSHJ P,LFTBKT ; LEFT BRACKET?
5448 AOJA D,MDOBLP]; NOPE--GO TO THE NEXT CHAR
5449 PUSHJ P,SAMBKT ; IS THIS THE SAME AS THE ONE ON THE STACK?
5450 JRST MISMAT ; NO--YOU LOSE
5451 MDMISA: SUB BK,[1,,1] ; YES--OR MISMATCHES ARE ALLOWED
5452 MDDONQ: CAME BK,-2(P) ; IS THE STACK EMPTY?
5453 JRST MDOBLP ; NO, SO CONTINUE
5454 SUB P,[3,,3] ; CLEAN UP P
5457 DPB A,B ; MAKE THE BUFFER ASCIZ
5459 SOJLE C,MDDNQ1 ; FLUSH THE LAST CHAR
5460 CAIN E,"" ; DID WE JUST RUB OUT A STRING?
5461 JRST MDDNQ1 ; YES, SO DON'T CHECK FOR LEADING !
5467 MDDNQ1: SKIPN TOERS ; CAN THE TERMINAL ERASE?
5468 JRST [OASCR [ASCIZ /XXXX?/]
5470 JUMPE D,MDODN3 ; NO CTRL-J'S--STAY ON THIS LINE
5472 JRST MDODN2 ; ONE CTRL-J
5475 JRST MDODON ; GO CLEAR OUT INPUT BUFFER
5478 OCTLP "L ; CLEAR THE LINE
5479 OCTLP "U ; AND GO UP
5480 MDODN3: PUSHJ P,GHPOS
5482 OCTLP "L ; CLOBBER THE END OF THE LINE
5483 ; CLEAR TO END OF INPUT BUFFER: FILL IN WORD THAT WE'RE POINTING AT,
5484 ; THEN BLT 0 THROUGH THE REST
5485 MDODON: PUSH P,B ; SAVE BUFFER POINTER
5487 MDODNL: TLNN B,760000 ; ALREADY AT BEGINNING OF WORD?
5488 JRST MDODBT ; YES--GO CLOBBER THE REST
5489 IDPB A,B ; NO--KILL THIS CHAR
5493 CAIL B,INPBUF+INPBLN-1 ; POINTING AT LAST WORD OF BUFFER?
5494 JRST MDODND ; YES, DONE
5497 CAIL B,INPBUF+INPBLN-1 ; IS THE LAST BUFFER WORD THE FIRST TO GO?
5498 JRST MDODND ; YES, SO WE'RE DONE
5501 BLT B,INPBUF+INPBLN-1 ; KILL THE REST OF THE BUFFER
5506 JRST RCMD1 ; ALL DONE
5509 MDSTRG: SOJLE C,OVERCL
5515 AOJA D,MDSTRG] ; COUNT LF'S
5516 PUSHJ P,QUOTEQ ; QUOTED "?
5517 JRST MDDONQ ; NO, SO HAVE A STRING
5528 RITBK1: PUSHJ P,QUOTEQ ; QUOTED?
5529 JRST POPJ1 ; NO--REALLY A RIGHT BRACKET
5539 LFTBK1: PUSHJ P,QUOTEQ
5543 ; IS THE LEFT BRACKET IN A A MATE FOR THE RIGHT BRACKET IN (BK)?
5560 ; IS THE CHAR IN A QUOTED?
5565 MOVEI D,0 ; # OF \'S ENCOUNTERED
5566 QUOTEL: SOJLE C,QUOTEO ; OUT OF CHARS
5571 AOJA D,QUOTEL ; AOS THE # OF QUOTES, TRY AGAIN
5572 QUOTEO: JUMPE D,QUOTDN ; NONE, SO LEAVE
5576 JRST QUOTDC ; NO, SO NO MORE TESTS REQUIRED
5577 PUSHJ P,QUOTEQ ; SEE IF THE ! IS QUOTED
5578 SOJA D,QUOTDC ; SNARF ONE, GO DECIDE IF CURRENT CHAR IS QUOTED
5579 QUOTDC: TRNE D,1 ; EVEN?
5580 AOS -4(P) ; NO, SO SKIP
5588 ; ERROR ROUTINES FOR MUDDLE OBJECT RUBOUT
5590 ; MISMATCHED BRACKETS
5591 MISMAT: SKIPE MDMISF
5592 JRST MDMISA ;
\v AFTER MISMATCH, SO LET IT GO
5593 OCTLP "S ; SAVE CURSOR POSITION
5596 OASC [ASCIZ / mismatched by /]
5600 MDERRO: POP P,C ; RESTORE INPUT COUNT
5601 POP P,B ; AND POINTER
5602 POP P,BK ; RESTORE BK STACK
5606 JRST RCMDER ; ERROR LOOP
5608 OVERCL: SETOM MDOVCF
5610 OASC [ASCIZ / Too many close brackets./]
5614 PDLOVF: SETOM MDPDLF
5616 OASC [ASCIZ /
\aPDL overflow./]
5620 SUBTTL START-UP ROUTINES
5622 ; COME HERE TO OPEN UP THE INPUT AND OUTPUT TTY'S
5623 ; THE CONSOLE TYPE IS READ AND IS USED TO DETERMINE
5624 ; THE RUBOUT PROCEDURE
5653 .SUSET [.SIMSK2,,[1_TTYI+1_TTYO]]
5661 .CALL TTYSET ; SET UP TTY TO TAKE CONTROL CHARACTERS
5663 MOVE A,TTYOPT ; SET UP RUBOUT HANDLERS
5664 MOVE [PUSHJ P,RUBECH]
5666 MOVE [PUSHJ P,RUBFLS]
5672 TLNE A,%TOFCI ; TV KEYBOARD?
5680 SETZ [030202,,020202]
5683 TTYOPN: MOVEI A,.PRIIN
5685 TDO B,[TT%WKF\TT%WKN\TT%WKP\TT%WKA]
5691 MOVE B,[LEVTAB,,CHNTAB]
5694 MOVE B,[600000,,200000]
5696 MOVE A,[.TICCB,,XCBCHN]
5698 MOVE A,[.TICCS,,XCSCHN]
5700 MOVE [PUSHJ P,RUBECH]
5713 SETZ [SIXBIT /COMBAT/]
5727 This program is used to generate input to the MUDDLE compiler. Don't
5728 use it unless you have something that needs to be compiled./]
5732 MOVE A,[-177,,INPBUF] ; READ IN MESSAGE
5734 HLRE O,A ; COMPUTE # OF CHARACTERS IN ALL BUT LAST WORD
5740 MSGRD1: SOJE C,MSGRD2
5741 ILDB B,A ; MARCH THROUGH LAST WORD LOOKING FOR 3 OR 0
5745 AOJA O,MSGRD1 ; IF NEITHER, THEN A REAL CHARACTER, SO AOS #
5746 MSGRD2: .CLOSE DSKCHN,
5747 MOVE A,[440700,,INPBUF] ; GET BYTE POINTER FOR INPUT BUFFER
5748 .CALL [SETZ ; AND PRINT MESSAGE
5760 SUBTTL PRINT ERROR MESSAGE FOR CHANNELS
5762 ERRPR1: SETOM ERRCR'
5772 MOVE A,[440700,,INPBUF]
5793 ERRPRT: OASC [ASCIZ / ERROR - /]
5804 ERRMSG: ERRMAC OPNFAL,OPEN FAILED--
5805 ERRMAC INFFAL,INFERIOR CREATION FAILED--
5806 ERRMAC RNDFAL,failed--
5812 SUBTTL CORE ALLOCATOR
5814 ;IBLOCK: TAKES #WORDS IN A, RETURNS POINTER IN A
5834 IBLOCK: ADD A,GCSTOP ; FIND NEW GCSTOP
5835 CAML A,FRETOP ; GREATER THAN FRETOP?
5837 EXCH A,GCSTOP ; OLD GCSTOP IS POINTER TO CORE ALLOCATED
5840 ; IF REQUEST BIGGER THAN AVAILABLE CORE, GET ANOTHER PAGE
5842 MOVE B,FRETOP ; FIND NEW PAGE NUMBER
5844 %GETIP: .CALL [SETZ ; FOR HYSTERICAL REASONS
5850 FATINS NO CORE AVAILABLE TO SATISFY REQUEST
5852 ADDM B,FRETOP ; UPDATE FRETOP
5854 EXCH A,GCSTOP ; A NOW HAS POINTER TO CORE, GCSTOP UPDATED
5860 ; QMUNG
\eG TO TURN QUESTIONS ON/OFF
5861 QMUNG: MOVE P,TOPSTK ; CONS UP STACK, FREE STORAGE
5865 .SUSET [.RMEMT,,FRETOP]
5867 PUSHJ P,TTYOPN ; GET TTY
5868 MOVEI [ASCIZ /Question to mung /]
5870 MOVE A,[TAILEN+TALSPC,,TAILTB]
5871 PUSHJ P,COMTYP ; GET QUESTION
5873 MOVEI [ASCIZ /On or off? /]
5875 MOVE A,[MUNGLN,,MUNGTB]
5876 PUSHJ P,COMTYP ; GET VALUE
5878 MOVE C,QTABLE(B) ; GET QUESTION TABLE SLOT
5879 JUMPE A,TURNON ; VALUE IS 0 IF TURN ON
5888 TURNON: TLZ C,%GIGNO
5901 SUBTTL INTERRUPT HANDLER
5903 ; INTERRUPT HANDLER: ON INFERIOR INTERRUPT (INDICATING MUDCOM DONE), DOES
5904 ; SETOM MCHANG AND .DISMIS, CAUSING MAIN PROGRAM TO UNHANG AND HANDLE
5905 ; MUDCOM'S RETURN. FOR TTYI INTERRUPT, IF CTRL-R OR CTRL-S AND INFERIOR
5906 ; EXISTS, KILLS IT, RESETS INPUT CHANNEL, AND PRETENDS CHARACTER TYPED
5907 ; NORMALLY. EVERYTHING ELSE IS IGNORED.
5910 XCTRLS: SETZM XCRFLG'
5911 XCTRLB: SETOM XCRFLG
5916 SFMOD ; GODDAMN GTJFN!
5919 OASCR [ASCIZ / Comparison Aborted? /]
5922 XINFER: SETOM MCHANG
5925 MOVSI A,10000 ; USER MODE BIT
5932 TSINT: 0 ;HERE TO CATCH INTERRUPTS
5935 TLNN A,400000 ; WORD ONE INTERRUPT?
5937 TLNE A,377 ; INFERIOR INTERRUPT?
5938 JRST UNHANG ; LET IT RETURN
5939 TRNN A,1_TTYI ; TTY INPUT?
5940 JRST TSMORE ; NO, SO MUST BE MORE
5942 .ITYIC A, ; GET CHARACTER
5943 JRST TSOUT ; TOO BAD
5944 SKIPE MCHANG ; MUDCOM?
5945 JRST LONGPR ; CHECK LONG PRINT-OUT
5946 CAIE A,^R ; AUTHORIZED INTERRUPT CHARACTER?
5948 JRST MCMRDR ; GO FROB IT
5949 CAIE A,^L ; TO CLEAR SCREEN WHILE MUDCOM RUNNING
5953 .DISMIS TSINTR ; BACK TO HANG
5957 JRST TSOUT ; FLUSH IF NOT CTRL-S OR -R
5958 SKIPN LONGOT ; PRINTING SOMETHING MOBY?
5959 JRST SHRTPR ; NO, SO TREAT THIS AS A NORMAL CTRL CHAR
5961 LONGP1: OASCR [0] ; PRINT A CR
5962 POP BK,P ; RESTORE P-STACK
5963 MOVE A,-1(BK) ; RETURN ADDRESS
5964 SUB BK,[3,,3] ; FLUSH IT ALL
5966 .DISMIS A ; AND RETURN
5968 ; COME HERE WITH CTRL-S OR CTRL-R (IN A) IF NOT SET UP TO ABORT PRINTING
5971 JRST SHRCTR ; IF NOT CONTROL-S, CAN'T DO MUCH
5974 SHRCTR: SKIPN MDBKSV ; IN MIDDLE OF CTRL-K?
5975 JRST TSOUT ; NO, SO FLUSH
5977 MOVE BK,MDBKSV ; RESTORE BK
5979 .DISMIS [RACK] ; GO HACK IT
5981 TSMORE: MOVEI A,[ASCII /**More**/]
5983 MOVEI A,[ASCII /--More--/] ; INTELLIGENT MORE MODE
5987 .CALL TSSIOT ; PRINT IT
5995 MOVSI %TIPEK+%TIACT+%TIINT
6002 .RESET TTYI, ; FLUSH RUBOUT
6004 JRST TSMOR2 ; IF NOT LONG OUTPUT, JUST CONTINUE
6005 MOVE A,[440700,,[ASCII /Flushed/]]
6011 JRST LONGP1 ; AND GO FLUSH IT
6012 TSMOR1: .RESET TTYI,
6013 TSMOR2: MOVE A,[440700,,[ASCII /
\10T
\10L/]]
6026 ; WORD ONE INTERRUPTS COME HERE. TSINT IS IN A
6028 FATALS: TLNE A,%PJATY
6036 JRST TSOUT ; FLUSH IF SINGLE-STEPPING
6038 JRST TSOUT ; DON'T DO THIS IF DEBUGGING
6039 SKIPN INREAD ; IN READER?
6045 ; PEOPLE COME HERE IF THE INTERRUPT DOESN'T CAUSE FUNNINESS
6047 UNHANG: SETOM MCHANG
6050 .USET MCINFO,[.RPIRQ,,A]
6051 TRNN A,%PIBRK ; NORMAL DEATH?
6053 .DISMI [MCERR]] ; DIED HORRIBLY
6057 PDLOV: EXCH B,TSINTR
6059 CAIE B,MDPDLO ; LOCATION WHERE 'LEGIT' STACK OVERFLOW CAN GO
6063 .DISMIS [PDLOVF] ; GO TO ROUTINE TO FIX IT
6066 ; COME HERE TO VIOLENTLY FLUSH MUDCOM
6067 MCMRDR: SETOM MCHANG
6069 .UCLOSE MCINFO, ; KILL INFERIOR
6070 .RESET TTYI, ; EAT CHARACTER
6072 Comparison aborted/]
6074 .DISMIS [TOPLEV] ; CTRL-S, SO GO TO TOPLEVEL
6075 .DISMIS [RACK] ; PRETEND NORMAL CTRL-R
6078 SKIPN XCRFLG ; CTRL-R?
6079 JRST XTOPLV ; CTRL-S, SO GO TO TOPLEVEL
6080 SKIPA A,[RACK] ; PRETEND NORMAL CTRL-R
6081 XTOPLV: MOVEI A,TOPLEV
6092 ; TYPEOUT UUOS (STRAIGHT FROM DIRED, WITH SOME HELP FROM PDL)
6096 IRPS X,,[OOCT ODEC OBPTR OHPOS OCTLP OSIX OASC OASCI OASCR]
6109 MOVEI @40 ; GET EFF ADDR. OF UUO
6112 MOVEM UUOD ; CONTENTS OF EFF ADR
6113 MOVE B,UUOE ; EFF ADR
6114 LDB A,[270400,,40] ; GET UUO AC,
6115 LDB C,[330600,,40] ; OP CODE
6117 MOVEI C,0 ; GRT=>ILLEGAL
6118 JRST @UUOTAB(C) ; GO TO PROPER ROUT
6123 POP P,A ; RESTORE AC'S
6126 ILUUO: FATINS ILLEGAL UUO
6128 MOVE B,UUOD ; PICK UP BYTE POINTER
6129 JRST UOASC1 ; AND JOIN CODE
6130 UOASCR: SKIPA C,[-1] ; CR FOR END OF TYPE
6131 UOASC: MOVEI C,0 ; NO CR
6132 HRLI B,440700 ; MAKE ASCII POINTER
6134 PUSH P,B ; SAVE BPTR
6135 UOASCC: ILDB D,B ; GET CHAR
6136 JUMPE D,UOASCD ; FINISH?
6137 AOJA A,UOASCC ; AOS COUNT, GO ON
6139 PUSHJ P,SIOTA ; SPIT IT OUT
6140 JUMPE C,UUORET ; CR NEEDED?
6143 MOVE B,[440700,,[ASCIZ /
6153 PUSHJ P,IOTAD ; DISPLAY-MODE IOT
6157 UOASCI: MOVE A,B ; PRT ASCII IMMEDIATE
6164 MOVE B,[440700,,UUOSCR]
6165 USXOOP: LDB D,[360600,,C]
6171 MOVE B,[440700,,UUOSCR]
6187 UOHPSL: CAMG B,XHPOS
6198 UODEC: SKIPA C,[10.] ; GET BASE FOR DECIMAL
6199 UOOCT: MOVEI C,8. ; OCTAL BASE
6200 MOVE B,UUOD ; GET ACTUAL WORD TO PRT
6201 JRST .+3 ; JOIN CODE
6202 UODECI: SKIPA C,[10.] ; DECIMAL
6206 MOVEI A,0 ; A=DIGIT COUNT
6207 MOVE C,B ; PUT # TO PRT IN C
6208 MOVE B,[010700,,UUOSCR+1]
6209 PUSHJ P,UONUM ; PRINT NUMBR
6215 ADDI D,"A-"9-1 ; MAKE HEX DIGIT, IF NOT DECIMAL
6216 DPB D,B ; SAVE DIGIT
6219 JUMPN C,UONUM ; IF NON-ZERO, STILL CRAP LEFT
6239 MOVSI %TJDIS ; TURN ON DISPLAY MODE FOR THIS