<sys.unsupported>/combat.mid.151

   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.*****
   5
   6 TITLE NCOMBAT
   7
   8 .SYMTAB 8001.
   9
  10 O=0
  11 A=1
  12 B=2
  13 C=3
  14 D=4
  15 E=5
  16 F=6
  17 G=7
  18 H=10
  19 BK=11                   ; STACK OF FROBS FOR CTRL-R
  20 OBSCEN=12               ; USED IN DOCOMM AS OFFSET INTO CTABLE
  21 RET=13
  22 QOFF=14
  23 OUTPTR=15
  24 CMPBLK=16
  25
  26 P=17
  27 .XCREF O,A,B,C,D,E,F,G,H,P
  28
  29 DSKCHN==2
  30 OUTCHN==3
  31 TTYO==3
  32 TTYI==4
  33 MCFILI==10
  34 MCINFO==11
  35 ERRCHN==12
  36
  37 ; OFFSETS IN NODES OF QUESTION TREE (POINTED TO BY OBSCEN), CONTAINED IN BLOCK
  38 ; STARTING AT QTREE
  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
  43
  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.
  48
  49 ; OFFSETS ON BK STACK
  50 BKPRPT==-3              ; SAVED PROMPT
  51 BKRET==-2               ; SAVED RETURN ADDRESS
  52 BKADDR==-1              ; ADDRESS TO PUSHJ TO
  53 BKPSAV==0               ; SAVED P-STACK
  54
  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
  60 $CLINK==104             ; LINK TO
  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
  66
  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
  73
  74 ; TAILOR TABLE DEFINITONS
  75 $TSYMBOL==400000
  76 $TFILE==200000
  77
  78 $TSTR==0
  79 $TSYM==500000
  80 $TTF==400000
  81 $TFIL==300000
  82 $TFSP==200000
  83 %GIGNO==40000           ; PRETEND THIS QUESTION DOESN'T EXIST
  84 %NOQ==10000             ; DON'T SKIP THIS QUESTION EVEN IF CTRL-Q TYPED
  85 %NSYSD==2000
  86 %TNMNY==1000
  87 %ESSEN==400             ; SAYS ALWAYS FROB THIS, REGARDLESS
  88 %RDCMT==100
  89 %RDCRT==40
  90 %KILLB==%NSYSD+%TNMNY+%ESSEN+%RDCRT+%RDCMT+%NOQ
  91
  92
  93 ; BITS DEFINED IN LH OF WORD 1 IN TAILORED GROUP
  94
  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
 101
 102 ; BITS IN LH OF TAILOR BLOCKS (AND QTABLE FOR %TQID)
 103
 104 %TPLEN==301000          ; BITS FOR LENGTH OF BLOCK
 105 %TQID==220600           ; BITS FOR QUESTION ID
 106
 107 ; BITS IN LH OF OUTPUT BLOCK
 108
 109 %DATAH==400000          ; SAYS OUTPUT HERE FROM HOW-TO-RUN ESCAPE
 110
 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
 114 ; ASKED/IGNORED.
 115
 116 %ASK==400000
 117 %IGNOR==200000
 118 %DSUP==100000
 119 ; IN RIGHT HALF, IDENTIFIES SPECIAL COMPILATION TYPES
 120 $SPTYP==400000
 121
 122 FSPSIZ==6               ; SIZE OF BLOCK FOR FILE NAME
 123 ITSSIZ==4
 124 QNUM==-37.              ; # OF WORDS IN BLOCK
 125 CMPSIZ==40.
 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
 129
 130 ; OFFSETS INTO BLOCK IN CTABLE
 131 QTWORD==0
 132 CTWORD==1
 133 CTRWRD==2
 134 CTINST==3
 135
 136 IF1,[ITS==0
 137      PRINTC /Combat for ITS? (Y OR N)/
 138      .TTYMAC A
 139      IFSE A,Y,[ITS==1]
 140      TERMIN
 141 ]
 142
 143 IF1,[
 144   IFE ITS,[
 145         .TNXDF
 146         .DECSAV
 147 ]]
 148
 149 \f
 150 SUBTTL  MACRO DEFINITIONS
 151
 152 ; CLEAR THE SCREEN
 153
 154 DEFINE SCLEAR
 155 IFN ITS,[
 156         OCTLP   "C
 157 ]
 158 IFE ITS,[
 159         PUSHJ   P,XCLEAR
 160 ]
 161 TERMIN
 162
 163 ; INTERRUPT ENABLE/DISABLE
 164
 165 DEFINE INTOFF
 166 IFN ITS,[
 167         .SUSET  [.SIDF2,,[1_TTYI]]
 168 ]
 169 IFE ITS,[
 170         PUSH    P,A
 171         MOVEI   A,.FHSLF
 172         DIR
 173         POP     P,A
 174 ]
 175 TERMIN
 176
 177 DEFINE INTON
 178 IFN ITS,[
 179         .SUSET  [.SADF2,,[1_TTYI]]
 180 ]
 181 IFE ITS,[
 182         PUSH    P,A
 183         MOVEI   A,.FHSLF
 184         EIR
 185         POP     P,A
 186 ]
 187 TERMIN
 188
 189 ; SKIPS IF WORD IN AC IS >0 AND <3 (FILE NAME OF CTRL-X OR CTRL-Y)
 190 DEFINE SPNAME   AC
 191         PUSH    P,A
 192         MOVE    A,AC
 193         PUSHJ   P,XSPNM
 194 TERMIN
 195
 196 ; SKIPS IF WORD IN AC IS <1 OR >2 (NOT OF SPNAME)
 197 DEFINE SPNAM1   AC
 198         SPNAME  AC
 199          CAIA
 200 TERMIN
 201
 202 DEFINE SAVACS
 203         JSP     RET,SAVAC
 204 TERMIN
 205
 206 DEFINE RSTACS
 207         JSP     RET,RSTAC
 208 TERMIN
 209
 210 ; DECREMENT BYTE POINTER
 211 DEFINE DBP AC
 212         ADD     AC,[70000,,]
 213         TLNE    AC,400000
 214         ADD     AC,[347777,,-1]
 215 TERMIN
 216
 217 ; LIKES FOO TO START AT INITIAL VALUE FOR TABLE.  STORES AS VALUE OF SYMBOL
 218 ; FOO, AOSES FOO.
 219 DEFINE  SYMBOL NAME
 220         [ASCIZ /!NAME!/],,FOO
 221         FOO==FOO+1
 222 TERMIN
 223
 224 ; MAKES SYMBOL WITH SUPPLIED VALUE.
 225 DEFINE SYMVAL NAME,VALUE
 226         [ASCIZ /!NAME!/],,VALUE
 227 TERMIN
 228
 229 ; TAKES LOCATION, SYMBOL.  LOCATION GOES INTO DISPATCH TABLE, SYMBOL IS
 230 ; == TO OFFSET INTO DISPATCH TABLE.  DSPTBL==.+1 SHOULD PRECEDE DISPATCH
 231 ; TABLE
 232 DEFINE DISPATCH LOC,VALUE
 233         LOC
 234         VALUE==.-DSPTBL
 235 TERMIN
 236
 237 ; USED TO MAKE QTABLE.
 238 DEFINE QUESTION BITS,ID,SYM,NAME
 239         IFSN SYM,,[SYM==.-QTABLE]
 240         BITS+ID,,[ASCIZ /NAME/]
 241 TERMIN
 242
 243 ; USED TO MAKE OUTSPC (OUTPUT SPECIFICATION TABLE).
 244 DEFINE OUTPUT TYPE,OFFSET,*HEADER*,TRAILER,NOHDR=0
 245         IFN NOHDR,.GO OUT1
 246         TYPE,,[ASCIZ /HEADER/]
 247         .GO OUT2
 248         .TAG OUT1
 249         TYPE,,
 250         .TAG OUT2
 251         OFFSET,,TRAILER
 252 TERMIN
 253
 254 ; USED TO MAKE ERROR TABLE
 255 DEFINE ERRMAC SYM,STRING\
 256         SYM==.-ERRMSG
 257         [ASCIZ  /!STRING!/]
 258 TERMIN
 259
 260 ; LOSSAGES
 261 DEFINE FATINS NAME\
 262 IFN ITS,[
 263         .VALUE  [ASCIZ /\17:\e\16 FATAL ERROR -- !NAME!\17\e\16
 264 /]
 265 ]
 266 IFE ITS,[
 267         HALTF
 268 ]
 269 TERMIN
 270
 271 DEFINE ECHO
 272 IFN ITS,[
 273         .IOT TTYO,A
 274 ]
 275 IFE ITS,[
 276         PBOUT
 277 ]
 278 TERMIN
 279
 280
 281 ; MACROS USED ON CTRL-R STACK
 282 DEFINE BKOFF
 283         SUB BK,[4,,4]
 284 TERMIN
 285 DEFINE BKON W,X,Y,Z
 286         PUSH BK,W
 287         PUSH BK,X
 288         PUSH BK,Y
 289         PUSH BK,Z
 290 TERMIN
 291
 292 ; DEFINE QTREE ENTRIES
 293 DEFINE QTM SYM,QSYM,SYMYES,SYMNO,INST
 294 SYM==.
 295         QSYM
 296         SYMYES,,SYMNO
 297         INST
 298         0
 299 TERMIN
 300
 301 \f
 302
 303 LOC 40
 304         0
 305         JSR     UUOH
 306 IFN ITS,[
 307         JSR     TSINT
 308 LOC 100
 309 ]
 310 IFE ITS,[
 311 LOC 140
 312 ]
 313 \f
 314 SUBTTL  VARIABLE DEFINITIONS
 315
 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
 321 CHPOS:  0
 322 CVPOS:  0                       ; CURSOR POSITION--USED IN RUBOUT ROUTINES
 323 MDBKSV: 0                       ; MDKILL SAVES BK HERE IN CASE CTRL-R TYPED IN MIDDLE
 324 MDPDLF: 0
 325 MDMISF: 0
 326 MDOVCF: 0                       ; ERROR FLAGS
 327 INREAD: 0                       ; IF -1, IN READER
 328 ITSFXF: 0
 329 ENDSW:  0
 330 PRSSYM: 0
 331 NCOMPF: 0
 332 PCOMPF: 0
 333 SSSPPP: 0
 334 MULFLG: 0                               ; USED TO SAY DON'T CRETINIZE
 335 MNYFLG: 0
 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
 344 FRETOP: 0
 345 GCSTOP: 0
 346 SNAME:  0
 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
 356 INPLEN: 0
 357 SMEXAC: 0
 358 XTRCHR: 0
 359 INPACT: 0
 360 INPSAV: 0
 361 SMVAL:  0
 362 UPTFLG: 0
 363 SMBEST: 0
 364 SMBLEN: 0
 365 SMNUM:  0
 366 SYMMOD: 0
 367 JCLINP: 0
 368 LSTBRK: 0
 369 UUOD:   0
 370 UUOE:   0
 371 UUOSCR: BLOCK   2
 372 BASE:   0
 373 TTYOPT: 0
 374 XCTRUB: 0
 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
 379 JCLPTR: 0
 380 PRMPT1: 0
 381 PRMPT2: 0
 382 CSYMTB: 0
 383 IFN ITS,[
 384 VERSIO: .FNAM2
 385 ]
 386 IFE ITS,[
 387 VERSIO: .FVERS
 388 ]
 389 GPSAVE: 0                       ; GACK SAVES PRMPT1 HERE
 390 GPRSAV: 0                       ; AND 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
 394 NAME:   BLOCK   6
 395 MCACS:  BLOCK   20
 396 NAMCNT: 0
 397 TALSTR: BLOCK 2                 ; CONTAINS TAILOR SNAME
 398 TALSLN: 0                       ; CONTAINS # CHARS THEREIN
 399
 400 TALDV:  1,,[ASCIZ /DSK/]
 401         0
 402 IFN ITS,[
 403         1,,[ASCIZ /%COMBT/]
 404 ]
 405 IFE ITS,[
 406         1,,[ASCIZ /COMBAT/]
 407 ]
 408         1,,[ASCIZ /TAILOR/]
 409         0
 410         0
 411
 412 TALDEV: SIXBIT /DSK/
 413 TALSNM: 0
 414 TALFN1: SIXBIT /%COMBT/
 415 TALFN2: SIXBIT /TAILOR/
 416
 417 TLSNAM: 0
 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
 421
 422 FILNAM:
 423 DEVICE: 0
 424 DIRECT: 0
 425 FNAME1: 0
 426 FNAME2: 0
 427 GENCNT: 0
 428 ETCETC: 0
 429
 430 SYSDEV: 1,,[ASCIZ /DSK/]
 431 SYSDIR: 1,,[ASCIZ /CHOMP/]
 432 IFN ITS,[
 433 SYSFN1: 1,,[ASCIZ /LOSER/]
 434 SYSFN2: 1,,[ASCIZ />/]
 435 SYSGEN: 0]
 436 IFE ITS,[
 437 SYSFN1: 0
 438 SYSFN2: 1,,[ASCIZ /MUD/]
 439 SYSGEN: 1,,[ASCIZ /0/]
 440 ]
 441 SYSETC: 0
 442
 443 FILPR2: ASCIZ /(FILE) /
 444 FSPPR2: ASCIZ /(FILESPEC) /
 445 STRPR2: ASCIZ /(TEXT) /
 446 SYMPR2: ASCIZ /(SYM) /
 447 LINPR2: ASCIZ /(LINE) /
 448
 449 TOPSTK: -40,,PDL-1                      ; P FOR EMPTY STACK
 450 TOPBK:  -60,,BKSTK-1
 451
 452 INPBLN==400
 453 INPBUF: BLOCK   INPBLN
 454 TINBUF: BLOCK   INPBLN                  ; SAVE CONTENTS OF BUFFER DURING GACK
 455 PATCH:  BLOCK   40
 456 BKSTK:  BLOCK   60
 457 PDL:    BLOCK   40
 458 JCLBUF: BLOCK   20
 459 MCJCLL==100
 460 MCJCLB: BLOCK   MCJCLL
 461
 462 IFN ITS,[
 463 SUSETS: .RUNAME,,B
 464         .RMEMT,,FRETOP
 465         .RSNAME,,A
 466         .SMASK,,[%PIATY+%PIPDL]
 467 SUSET:  SUSETS-.,,SUSETS
 468 ]
 469 IFE ITS,[
 470
 471 XCSCHN==0
 472 XCBCHN==1
 473
 474 CHNTAB: 1,,XCTRLS               ; CHANNEL 0
 475         1,,XCTRLB
 476         0
 477         0
 478         0
 479         0                       ; CHANNEL 5
 480         0
 481         0
 482         0
 483         0
 484         0                       ; CHANNEL 10
 485         0
 486         0
 487         0
 488         0
 489         0                       ; CHANNEL 15
 490         0
 491         0
 492         0
 493         2,,XINFER               ; CHANNEL 19
 494         0                       ; CHANNEL 20
 495         BLOCK   15              ; CHANNEL 21-35
 496
 497 LEVTAB: 0,,PCLEV1
 498         0,,PCLEV2
 499         0
 500
 501 PCLEV1: 0
 502 PCLEV2: 0
 503 ]
 504 \f
 505 SUBTTL  TOPLEVEL
 506 DSTART: SETOM   DEBUG
 507 START:  MOVE    P,TOPSTK
 508         MOVE    BK,TOPBK
 509         MOVE    A,MUMBLE
 510         MOVEM   A,GCSTOP
 511 IFN ITS,[
 512         MOVE    C,SUSET
 513         .SUSET  C                       ; UNAME->B, SNAME->A, MEMT->FRETOP
 514         HLRES   B
 515         CAMN    B,[-1]
 516          .VALUE [ASCIZ /\17:\e\16LOG IN\17\eKILL\16
 517 /]
 518         MOVEM   A,TALSNM
 519         MOVEM   A,TLSNAM
 520         PUSHJ   P,SIXASC
 521         MOVEM   A,PSNAME
 522         MOVEM   A,SYSDIR
 523         MOVEM   A,SNAME
 524 ]
 525 IFE ITS,[
 526 ;       MOVEI   A,15.
 527 ;       PUSHJ   P,IBLOCK
 528 ;       PUSH    P,A
 529 ;       GJINF
 530 ;       HLL     B,A
 531 ;       HRRO    A,(P)
 532 ;       DIRST
 533 ;        JFCL
 534 ;       POP     P,A
 535 ;       HRLI    A,15.
 536 ;       MOVEM   A,TALSNM
 537         SETZM   TALSNM
 538         SETZM   TLSNAM
 539         SETZM   PSNAME
 540         SETZM   SYSDIR
 541         SETZM   SNAME
 542 ]
 543         SETZM   ERRFLG
 544         MOVE    A,[ITYPLE,,TYPTBL]
 545         MOVEM   A,TYPLEN
 546         MOVEI   A,UTYPTB
 547         MOVEM   A,UTYPLN
 548         PUSHJ   P,TTYOPN
 549         OASC    [ASCIZ /COMBAT./]
 550 IFN ITS,[
 551         OSIX    VERSIO
 552 ]
 553 IFE ITS,[
 554         ODEC    VERSIO
 555 ]
 556         SETZM   LDFLAG                          ; DON'T NEED TO UNIQIFY NAMES
 557         PUSHJ   P,LDTAIL
 558         SETOM   ERRFLG
 559         PUSHJ   P,JCLRED
 560         PUSHJ   P,MSGRED
 561 \f
 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.
 570
 571 QDOASK: SETZM   TPFUDG
 572 QDOAS1: MOVEI   OBSCEN,QTREE
 573 QDOAS2: PUSH    BK,[0]                          ; NO PROMPT SAVED
 574         PUSH    BK,[QDOCTR]
 575         PUSH    BK,[STDBCK]
 576         PUSH    BK,P                            ; SET THINGS UP FOR CTRL-R
 577 QDONXT: SKIPGE  A,THISQ(OBSCEN)
 578          JRST   QNOTQ
 579         MOVE    QOFF,A
 580         MOVE    OUTPTR,OUTBLK
 581         ADD     OUTPTR,A
 582         MOVE    CMPBLK,CMPSAV
 583         ADD     CMPBLK,A                        ; SET UP AC'S IF QUESTION BEING ASKED
 584 QNOTQ:  XCT     INST(OBSCEN)                    ; DO IT
 585          JRST   QLOST
 586         HLRZ    A,FORKS(OBSCEN)
 587         JRST    QNEXT
 588 QLOST:  HRRZ    A,FORKS(OBSCEN)
 589 QNEXT:  SKIPL   B,THISQ(OBSCEN)                 ; A REAL QUESTION?
 590          JRST   QADV
 591         TLNE    B,%TNMEM
 592          JRST   QADV1
 593         TLNN    B,%TNBCK                        ; UNREAL QUESTION:  DON'T BACK UP TO ME
 594          JRST   QADV
 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
 599
 600 ; RETURN FROM CTRL-R
 601 QDOCTR: JRST    QDOAS2
 602         JRST    QDONXT                          ; RETURN FROM ^G ^R
 603
 604 \f
 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 /]
 611         MOVEM   B,PRMPT1
 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.
 616                  POPJ  P,]
 617         PUSHJ   P,LINKX                 ; EXPAND LINKS
 618         MOVEI   A,CMPSIZ+2              ; GET CORE FOR COMPILATION--POINTER IN A
 619         PUSHJ   P,IBLOCK
 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
 624                  JRST OTINIT]
 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
 629         MOVEM   CMPBLK,CMPSAV
 630         SETZM   CTRLQ                   ; NOT IN CTRLQ ANY MORE
 631         JRST    POPJ1                   ; AND SKIP
 632 \f
 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.
 636
 637 ASKQ:   SETZM   FASKQS
 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
 643          JRST   QUACK
 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
 648                  JRST ASKMNY]
 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?
 653                  JRST ASKER
 654                  POPJ P,]
 655 ASKER:  TLNE    A,$TTF
 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?
 659         JRST    POPJ1
 660 TFASK:  PUSHJ   P,ASK
 661          JFCL
 662         HRRZ    A,(OUTPTR)              ; GET ANSWER
 663         JUMPN   A,POPJ1                 ; IF ANSWERED YES
 664         POPJ    P,
 665
 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
 668 ; IT SKIPS.
 669 FASKQ:  SETOM   FASKQS'
 670         PUSHJ   P,ASKQ1
 671          JRST   [MOVE   A,QTABLE(QOFF)
 672                  TLNN   A,%ESSEN
 673                   POPJ  P,
 674                  JRST   FASKQ1]
 675         AOS     (P)
 676 FASKQ1: MOVE    B,(OUTPTR)              ; POINTER TO FILE NAME
 677
 678 IFN ITS,[
 679         PUSH    P,B
 680         MOVE    A,(B)
 681         PUSHJ   P,ASCSIX
 682         PUSH    P,A
 683         MOVE    A,1(B)
 684         PUSHJ   P,ASCSIX
 685         PUSH    P,A
 686         MOVE    A,2(B)
 687         PUSHJ   P,ASCSIX
 688         PUSH    P,A
 689         MOVE    A,3(B)
 690         PUSHJ   P,ASCSIX
 691         .CALL   [SETZ
 692                  SIXBIT /OPEN/
 693                  [.BII,,DSKCHN]
 694                  MOVE -2(P)
 695                  MOVE (P)
 696                  MOVE A
 697                  SETZ -1(P)]
 698          JRST   FASKQL
 699 FASKQE: SUB     P,[4,,4]
 700         .CLOSE  DSKCHN,
 701         POPJ    P,
 702
 703 FASKQL: SKIPE   FILEXI
 704          JRST   FASKQE
 705         SUB     P,[3,,3]
 706         OASCR   [0]
 707         OASC    [ASCIZ  /WARNING:  Open of /]
 708         POP     P,A
 709         PUSHJ   P,NFNAME
 710         OASCI   40
 711         PUSH    P,[RNDFAL]
 712         JRST    ERRPR1
 713 ]
 714 IFE ITS,[
 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!
 719          JRST   FASKQ3
 720         MOVEI   A,20.                   ; GET A BLOCK FOR JFNS
 721         PUSHJ   P,IBLOCK
 722         HRROS   A
 723         PUSH    P,A
 724         MOVE    B,JFN'                  ; GET BACK THE FUNNY JFN
 725         SETZ    C,
 726         SETZ    D,
 727         JFNS                            ; GET THE REAL STRING
 728         MOVSI   A,(GJ%OLD+GJ%SHT)
 729         POP     P,B
 730         PUSHJ   P,ECHON
 731         GTJFN                           ; GET A REAL FILE-OPENING JFN
 732          JRST   FASKQ2
 733         PUSHJ   P,ECHOFF
 734 FASKQ4: MOVE    B,[440000,,OF%RD]
 735         OPENF
 736          JRST   FASKQ2
 737         CLOSF
 738          JFCL
 739         POP     P,A
 740         POPJ    P,
 741
 742 FASKQ2: SKIPE   FILEXI
 743          JRST   POPAJ                   ; DONT COMPLAIN IF FLAGS SET
 744         PUSHJ   P,ECHOFF
 745         OASCR   [0]
 746         OASC    [ASCIZ /WARNING:  Open of /]
 747         POP     P,A
 748         PUSHJ   P,NFNAME
 749         OASCR   [ASCIZ / failed./]
 750         POPJ    P,
 751
 752 FASKQ3: MOVE    C,[-4,,GTJFN3+.GJDEV]
 753         HRRO    D,(B)
 754         MOVEM   D,(C)
 755         AOJ     B,
 756         AOBJN   C,FASKQ3+1
 757         SETZ    B,
 758         MOVEI   A,GTJFN3
 759         GTJFN
 760          JRST   FASKQ2
 761         JRST    FASKQ4
 762
 763 ECHON:  SAVACS
 764         MOVEI   A,.PRIOU
 765         RFCOC
 766         SKIPE   RFCOC1
 767          JRST   ECHON1
 768         MOVEM   B,RFCOC1
 769         MOVEM   C,RFCOC2
 770 ECHON1: TLO     C,24                    ;MAKE ^X AND ^Y WORK
 771         SFCOC
 772         RSTACS
 773         SETOM   ECHFLG'
 774         POPJ    P,
 775
 776 ECHOFF: SKIPN   ECHFLG
 777          POPJ   P,
 778         SETZM   ECHFLG
 779         SAVACS
 780         MOVEI   A,.PRIOU
 781         MOVE    B,RFCOC1
 782         MOVE    C,RFCOC2
 783         SFCOC
 784         RSTACS
 785         POPJ    P,
 786
 787 RFCOC1: 0
 788 RFCOC2: 0
 789 ]
 790 \f
 791
 792 ; HACKER WHEN IN CTRLQ MODE:  A HAS QTABLE SLOT, B HAS CMPBLK SLOT
 793 QUACK:  TLNE    A,$TFILE                ; FILE-TYPE QUESTION?
 794          JRST   QFILE
 795 QDEFLT: TLNE    A,%NOQ                  ; ASK THIS EVEN IF CTRL-Q TYPED
 796          JRST   NOQ
 797         HRRZ    B,(CMPBLK)              ; DO DEFAULT
 798         MOVEM   B,(OUTPTR)
 799         TLNE    A,%DSUP
 800          POPJ   P,
 801         JRST    POPJ1
 802 QFILE:  TLNE    A,%DSUP+%ESSEN          ; IF USER SUPPLIED DEFAULT, ESSENTIAL, DO THAT.
 803          JRST   [PUSHJ P,DEFILE
 804                  JRST  POPJ1]
 805         SETZM   (OUTPTR)
 806         POPJ    P,
 807 \f
 808 ; ASK SNAME QUESTION:  GET STRING, CONVERT TO SIXBIT AND STUFF IN PSNAME
 809
 810 ASKSNM: MOVE    B,(CMPBLK)
 811         PUSHJ   P,NRMDEF        ; PICK UP DEFAULT
 812         SKIPE   CTRLQ
 813          JRST   ASNMDO
 814         TLNE    B,%IGNOR
 815          JRST   ASNMDO          ; PICK UP DEFAULT AND LEAVE
 816         PUSHJ   P,ASK           ; ASK THE QUESTION
 817          JFCL
 818 ASNMDO: PUSHJ   P,ASNMD1
 819         POPJ    P,
 820
 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
 825         PUSH    P,A             ; SAVE IT
 826         MOVEI   A,20
 827         PUSHJ   P,IBLOCK        ; GET ANOTHER BLOCK CORRECT LENGTH
 828         MOVE    B,A
 829         HRLI    B,440700        ; MAKE BP TO NEW BLOCK
 830         POP     P,A
 831         PUSH    P,B
 832         HRLM    C,(P)           ; WORD COUNT
 833 ASNMLP: ILDB    O,A             ; GET A CHAR
 834         CAIN    O,";
 835          JRST   ASNMDN          ; ; TERMINATES
 836         CAIN    O,""
 837          JRST   ASNMLP          ; IGNORE "
 838         JUMPE   O,ASNMDN
 839         CAIE    O,"
 840          CAIN   O,11
 841           JRST  ASNMDN          ; FALL OUT
 842         CAIN    O,^Q
 843          ILDB   O,A
 844         CAIL    O,"a
 845          SUBI   O,40
 846         IDPB    O,B
 847         TLNE    B,770000
 848          JRST   ASNMLP
 849 ASNMDN: POP     P,A
 850         SKIPN   (A)
 851          POPJ   P,              ; DIDN'T GET ANYTHING
 852         MOVEM   A,SYSDIR
 853         MOVEM   A,PSNAME        ; SAVE RESULT AWAY
 854         POPJ    P,              ; AND LEAVE
 855
 856
 857 \f
 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
 865         MOVE    A,CMPSIZ(A)
 866         MOVE    A,HOWLOC(A)     ; GET HOW TO RUN SPEC
 867         TLNN    A,%ASK          ; ASK?
 868          JRST   HOWGO
 869 DONE1:  MOVE    A,[HOWTLN,,HOWTBL]      ; ASK HOW TO RUN:  PTLONG JRST HERE, TOO.
 870         MOVEI   B,[ASCIZ /How to Run /]
 871         MOVEM   B,PRMPT1
 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)
 879                  POPJ   P,]
 880         JRST    POPJ1
 881         JRST    DONE1                   ; HPRTHK SKIPS TWICE, SO WE LOOP BACK
 882
 883 \f
 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
 887 ; FILE NAMES.
 888 DEFHAK:
 889 IFE ITS,[
 890         SETZM   JFN
 891 ]
 892         TLNE    A,$TFILE                ; SPECIAL HACKING FOR FILE NAMES
 893          JRST   [PUSHJ  P,DEFILE
 894                  JRST   RDEF]
 895         HRRZ    A,(CMPBLK)
 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
 900         POPJ    P,
 901
 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
 907
 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
 913         HRLI    A,-FSPSIZ
 914         MOVEI   C,SYSDEV-1              ; GET POINTER TO SYSTEM DEFAULTS
 915         SETZM   DIDEXP
 916 DEFLP:  AOJ     C,
 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
 923 DEFSYS: MOVE    B,(C)
 924         MOVEM   B,(A)
 925 DEFLPE: AOBJN   A,DEFLP
 926         SKIPN   DIDEXP
 927          POPJ   P,
 928         SETZM   DIDEXP
 929         MOVE    A,(CMPBLK)
 930         TLNE    A,%ASK                  ; QUESTION IS BEING ASKED, SO DON'T PRINT
 931          POPJ   P,
 932         HRRZ    A,QTABLE(QOFF)
 933         OASCR   [0]
 934         OASC    (A)
 935         OASC    [ASCIZ  /   /]
 936         MOVE    A,(OUTPTR)
 937         PUSHJ   P,NFNAME
 938         POPJ    P,
 939
 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
 944         PUSHJ   P,IBLOCK
 945         MOVEM   A,(OUTPTR)
 946         MOVE    A,QTABLE(QOFF)
 947         TLNN    A,%ESSEN                ; NOT ESSENTIAL, SO LEAVE
 948          POPJ   P,
 949         PUSH    P,CMPBLK
 950         MOVEI   CMPBLK,VTABLE(QOFF)     ; GET DEFAULT FROM VTABLE
 951         PUSHJ   P,FILDEF                ; SET IT UP
 952         POP     P,CMPBLK
 953         JRST    SETDEF                  ; BACK
 954
 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
 960         PUSHJ   P,IBLOCK
 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
 966         POPJ    P,
 967
 968 ; DOES DEFAULT IN SIMPLE (NON FILE-NAME) CASE:  PICK IT UP AND PUT IT BACK DOWN.
 969 NRMDEF: HRRZ    A,(CMPBLK)
 970         MOVEM   A,(OUTPTR)
 971         POPJ    P,
 972
 973 \f
 974
 975 ; HACK CONTROL-G
 976 GACK:   MOVE    O,PRMPT1
 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
 982         TLNN    O,700000
 983          PUSHJ  P,SINBUF                ; COPY INPUT BUFFER IF STRING TYPE
 984         PUSH    BK,O
 985         PUSH    BK,-3(BK)               ; SAME RETURN ADDRESS AS BEFORE
 986         AOS     (BK)                    ; PLUS 1
 987         PUSH    BK,[[POPJ P,]]          ; ALWAYS SKIP, DO NOTHING
 988         PUSH    BK,-3(BK)               ; SAME STACK
 989         MOVEM   O,GPSAVE
 990         MOVEM   O,GPRSAV
 991         PUSH    P,B
 992         PUSH    P,C                     ; SAVE BUFFER POINTER AND COUNT
 993         MOVEI   B,[ASCIZ /Get from type /]
 994         PUSH    P,PRMPT1
 995         PUSH    P,PRMPT2
 996         PUSHJ   P,GETTP1                ; GET GROUP IN A
 997          JRST   [BKOFF
 998                  POP P,PRMPT2
 999                  POP P,PRMPT1
1000                  SUB P,[2,,2]           ; FLUSH SAVED BUFFER
1001                  JRST RSTBF1]           ; COMES HERE IF NO TYPES EXIST
1002         POP     P,PRMPT2
1003         POP     P,PRMPT1
1004         PUSH    P,CMPBLK
1005         MOVE    CMPBLK,A                ; STUFF INTO CMPBLK
1006         PUSHJ   P,LINKX                 ; EXPAND LINKS
1007         MOVE    A,CMPBLK
1008         POP     P,CMPBLK
1009         SETZM   SYMMOD
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./]
1014                  BKOFF
1015                  SUB    P,[2,,2]
1016                  JRST   RSTBF1]
1017         HRRZS   D
1018         LDB     B,[410300,,GPSAVE]              ; GET TYPE OF INPUT
1019         SETOM   GPSAVE
1020         OASC    [ASCIZ /  /]
1021         JRST    @GETTBL (B)             ; GO TO APPROPRIATE ROUTINE
1022
1023 GETTBL: GETSTR
1024         BADTYP
1025         GETFIL
1026         GETFIL
1027         GETTF
1028         GETTF
1029         BADTYP
1030         BADTYP
1031
1032 GETOUT: BKOFF
1033         SKIPN   P,BKPSAV(BK)            ; ????????
1034          MOVE   P,TOPSTK
1035         AOBJN   P,.+1
1036         SKIPN   GPSAVE
1037          POPJ   P,                      ; SO FILE-HACKERS CAN NOT SKIP-RETURN
1038         JRST    POPJ1
1039
1040 GETTF:  MOVEM   D,(OUTPTR)
1041         OASCR   HLPTF(D)
1042         JRST    GETOUT
1043
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.
1047
1048 GETSTR: BKOFF
1049         PUSHJ   P,RINBUF
1050         POP     P,C
1051         POP     P,B                     ; RESTORE BUFFER
1052         MOVE    O,GPRSAV
1053         MOVEM   O,PRMPT1
1054         HRLI    D,440700
1055 GETSTL: ILDB    A,D
1056         JUMPE   A,REPPER                ; STRING IS ASCIZ
1057         IDPB    A,B
1058         AOJA    C,GETSTL
1059
1060 GETFIL: JUMPE   D,GETFLS                ; OLD IN D
1061         MOVEI   A,FSPSIZ
1062         PUSHJ   P,IBLOCK
1063         MOVEM   A,(OUTPTR)              ; NEW IN A
1064         HRLI    A,-FSPSIZ
1065         MOVEI   B,SYSDEV                ; SYS IN B
1066         MOVEI   C,CHRTBL
1067 GFILLP: SKIPN   E,(D)
1068          MOVE   E,(B)
1069         MOVEM   E,(B)                   ; SET SYS DEFAULT
1070         MOVEM   E,(A)                   ; PUT IN OUTBLK
1071         OASC    (E)                     ; PRINT
1072         OASC    (C)                     ; PRINT BREAK CHARACTER
1073         AOJ     C,
1074         AOJ     D,
1075         AOJ     B,
1076         AOBJN   A,GFILLP
1077         OASCR   [0]
1078         JRST    GETOUT
1079 GETFLS: SETZM   (OUTPTR)
1080         SETZM   GPSAVE
1081         JRST    GETOUT
1082
1083 ; HACK CONTROL-R
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
1089         MOVE    P,BKPSAV(BK)
1090         MOVE    A,BKRET(BK)
1091         BKOFF                           ; FLUSH THIS ONE
1092         JRST    (A)                     ; BYE-BYE
1093
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
1101          JRST   STDBC1
1102         JUMPL   C,CPOPJ                 ; A 'SYSTEM QUESTION'; ALWAYS STOP
1103         MOVE    B,QTABLE(C)             ; THIS QUESTION
1104         TLNE    B,%GIGNO
1105          JRST   STDBC1                  ; QUESTION IS GLOBALLY OFF, SO CAN'T  STOP HERE
1106         MOVE    OUTPTR,OUTBLK
1107         ADD     OUTPTR,C
1108         SETZM   (OUTPTR)                ; CLOBBER SLOT IN OUTPUT BLOCK
1109         MOVE    CMPBLK,CMPSAV
1110         ADD     CMPBLK,C                ; POINTER TO COMPILE TYPE SLOT
1111         MOVE    A,(CMPBLK)
1112         TLNN    A,%ASK                  ; ASK THIS QUESTION?
1113          JRST   STDBC1
1114         POPJ    P,                      ; YES, DONE
1115
1116 TOPLEV: MOVE    P,TOPSTK
1117         MOVE    BK,TOPBK
1118         SETZM   MDBKSV
1119         SETZM   INREAD
1120         SKIPN   MNYFLG                  ; IF IN MANY MODE, ONLY KILL THIS ONE
1121          JRST   QDOAS1                  ; ASK COMPILATION TYPE
1122
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?
1131          JRST   TOPLOT
1132         MOVE    A,                      ; ADVANCE POINTER
1133         JRST    TOPLOP
1134 TOPLOT: MOVEM   A,OUTBLK                ; SAVE AWAY WINNING POINTER
1135         SETZM   CMPSIZ+1(A)             ; ZERO ITS NEXT-BLOCK POINTER
1136         JRST    QDOAS1                  ; AND LEAVE
1137
1138 \f
1139 SUBTTL  MUDCOM INTERFACE
1140
1141 MCASCI: HRLI    D,440700
1142         ILDB    F,D
1143         JUMPE   F,CPOPJ
1144         IDPB    F,C
1145         JRST    .-3
1146
1147
1148 ; PUSHJ P,MCFILE
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
1152
1153 IFN ITS,[
1154 MCFILE: MOVE    D,(B)
1155         PUSHJ   P,MCASCI
1156         MOVEI   D,":
1157         IDPB    D,C
1158         MOVE    D,1(B)
1159         PUSHJ   P,MCASCI
1160         MOVEI   D,";
1161         IDPB    D,C
1162         MOVE    D,2(B)
1163         PUSHJ   P,MCASCI
1164         MOVEI   D,40
1165         IDPB    D,C
1166         MOVE    D,3(B)
1167         PUSHJ   P,MCASCI
1168         POPJ    P,
1169 ]
1170 IFE ITS,[
1171 MCFILE: MOVE    A,B
1172         PUSHJ   P,XFNEXP                ; EXPAND FILE NAME
1173          JRST   MCFNF
1174         HRLI    A,440700
1175 MCFIL1: ILDB    D,A
1176         JUMPE   D,CPOPJ
1177         IDPB    D,C
1178         JRST    MCFIL1
1179
1180 MCFNF:  OASC    [ASCIZ /File not found - /]
1181         MOVE    A,B
1182         PUSHJ   P,NFNAME
1183         OASCR   [0]
1184         SUB     P,[1,,1]
1185         POPJ    P,
1186 ]
1187
1188 ; PUSHJ P,MUDCOM
1189 ; IN A, A POINTER TO A FILE NAME BLOCK (FROM COMPARE QUESTION)
1190 ;  OR 0, IF NO NAME GIVEN
1191
1192 MUDCOM: OASC    [ASCIZ /
1193  Comparing.../]
1194         SETZM   MCJCLB
1195         MOVE    B,[MCJCLB,,MCJCLB+1]
1196         HLRZ    C,B
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?
1200          JRST   MUDJCL                  ; NO
1201 IFN ITS,[
1202         MOVEI   O,"/
1203         IDPB    O,C
1204         MOVEI   O,"M
1205         IDPB    O,C
1206         MOVEI   O,"
1207         IDPB    O,C
1208 ]
1209 MUDJCL:
1210 IFE ITS,[
1211         MOVEI   O,"
1212         IDPB    O,C
1213 ]
1214         SKIPN   B,(OUTPTR)              ; EXTRA JCL?
1215          JRST   MUDFIL                  ; NO
1216         HRLI    B,440700
1217 MUDJLP: ILDB    O,B
1218         JUMPE   O,MUDFI1                ; DONE?
1219         IDPB    O,C
1220         JRST    MUDJLP
1221 MUDFI1: MOVEI   O,"
1222         IDPB    O,C
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
1228                  MOVE   B,.QINP(B)
1229                  PUSHJ  P,MCFILE
1230                  MOVEI  D,",
1231                  IDPB   D,C
1232                  MOVE   B,-2(OUTPTR)
1233                  PUSHJ  P,MCFILE
1234                  SETZM  -2(OUTPTR)
1235                  JRST   MUDRDY]
1236         PUSHJ   P,MCFILE                ; STUFF IT OUT
1237         SETZM   -2(OUTPTR)              ; AND ZERO IT
1238         MOVEI   D,",                    ; DEPOSIT A COMMA
1239         IDPB    D,C
1240         MOVE    B,OUTBLK                ; POINTER TO INPUT FILE BLOCK
1241         MOVE    B,.QINP(B)
1242         PUSHJ   P,MCFILE                ; PUT INPUT FILE INTO BLOCK
1243 MUDRDY: SETZ    D,
1244         IDPB    D,C                     ; FINISH THE JCL BLOCK
1245 IFN ITS,[
1246 MUDSTT: .CALL   [SETZ                   ; OPEN TS MUDCOM
1247                  SIXBIT /OPEN/
1248                  MOVSI .BII
1249                  MOVEI MCFILI
1250                  [SIXBIT /DSK/]
1251                  [SIXBIT /TS/]
1252                  [SIXBIT /MUDCOM/]
1253                  SETZ [SIXBIT /SYS/]]
1254          .LOSE  1000
1255         SETZM   MCHANG                  ; SAY INFERIOR EXISTS
1256         .CALL   [SETZ                   ; OPEN THE INFERIOR
1257                  SIXBIT /OPEN/
1258                  MOVSI .BIO
1259                  MOVEI MCINFO
1260                  [SIXBIT /USR/]
1261                  [0]
1262                  SETZ [SIXBIT /MUDCOM/]]
1263          JRST   [SETOM  MCHANG
1264                  PUSH   P,[RACK]        ; SO ERRPRT WILL RETURN TO WINNAGE
1265                  PUSH   P,[INFFAL]
1266                  JRST   ERRPRT]
1267         .RESET  MCINFO,
1268         .CALL   [SETZ                   ; GET IT A PAGE ONE
1269                  SIXBIT /CORBLK/
1270                  MOVEI 400000
1271                  MOVEI MCINFO
1272                  MOVEI
1273                  SETZI -5]
1274          .LOSE  1000
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
1280         SKIPN   MUDVRB
1281          OASC   MCJCLB
1282         .CALL   [SETZ                   ; LOAD TS MUDCOM
1283                  SIXBIT /LOAD/
1284                  MOVEI MCINFO
1285                  SETZI MCFILI]
1286          .LOSE  1000
1287         MOVE    B,[-1,,C]               ; READ THE STARTING ADDRESS
1288         .IOT    MCFILI,B
1289         .CLOSE  MCFILI,                 ; CLOSE THE FILE
1290         ADDI    C,1
1291         TLZ     C,-1                    ; CLEAR THE LEFT HALF
1292         .USET   MCINFO,[.SUPC,,C]       ; SET UPC
1293         SKIPN   MUDVRB
1294          JRST   MUDBEG
1295         .ACCESS MCINFO,[1]
1296         MOVE    B,[-1,,C]
1297         MOVNI   C,1
1298         .IOT    MCINFO,B
1299         .ATTY   MCINFO,
1300          .LOSE  1000
1301 MUDBEG: .USET   MCINFO,[.SUSTP,,[0]]    ; START IT UP
1302         SKIPN   MCHANG
1303         .HANG                           ; WAIT FOR INTERRUPT
1304         SKIPN   MUDVRB
1305          JRST   MCHEND
1306         SETZM   MCHANG
1307         .USET   MCINFO,[.RSV40,,C]
1308         HRRZS   C
1309         CAIE    C,100000
1310          JRST   MCHEND
1311         .CALL   [SETZ
1312                  SIXBIT /USRVAR/
1313                  MOVEI  MCINFO
1314                  MOVEI  .RTTY
1315                  MOVEI  0
1316                  SETZ   [TLO %TBOUT]]
1317          .LOSE  %LSSYS
1318         .USET   MCINFO,[.SPIRQ,,[0]]
1319         .USET   MCINFO,[.SUSTP,,[0]]
1320         SKIPN   MCHANG
1321          .HANG
1322 MCHEND: .CALL   [SETZ                   ; OPEN A READ CHANNEL TO INFERIOR
1323                  SIXBIT /OPEN/
1324                  MOVSI .BII
1325                  MOVEI MCFILI
1326                  [SIXBIT /USR/]
1327                  [0]
1328                  SETZ [SIXBIT /MUDCOM/]]
1329          .LOSE  1000
1330         .RESET  TTYO,
1331         .ACCESS MCFILI,[1]              ; GET TO WORD 1
1332         MOVE    B,[-1,,C]
1333         .IOT    MCFILI,B                ; READ IT (0 = WINNAGE 1+ = ERROR CODE)
1334         JUMPN   C,MCERR
1335         MOVE    B,[-1,,C]
1336         .IOT    MCFILI,B                ; READ CHARACTER COUNT
1337         TDNE    C,[-1,,770000]          ; GARBAGE FROM MUDCOM?
1338          JRST   [MOVEI  C,11
1339                  JRST   MCERR]
1340         MOVE    B,[-1,,D]
1341         .IOT    MCFILI,B                ; READ LOCATION OF RETURN
1342         .ACCESS MCFILI,D                ; ACCESS THERE
1343         IDIVI   C,5
1344         ADDI    C,1                     ; NUMBER OF WORDS NEEDED
1345         MOVN    D,C
1346         MOVSS   D                       ; TO LEFT HALF
1347         HRRI    D,INPBUF
1348         .IOT    MCFILI,D                ; IOT IN THE RETURN
1349         .UCLOSE MCFILI,                 ; FLUSH THE JOB
1350 ]
1351 IFE ITS,[
1352 MUDSTT: MOVSI   A,(CR%CAP)
1353         SETZM   MCHANG                  ; SAY WE'RE IN MUDCOM NOW
1354         CFORK                           ; MAKE A FORK
1355          HALTF                          ; WHY?
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
1360          HALTF
1361         HRL     A,MCHNDL                ; HANDLE,,JFN
1362         GET                             ; GET A MUDCOM
1363         MOVE    A,MCHNDL
1364         GEVEC                           ; GET ENTRY VECTOR
1365         PUSH    P,B                     ; SAVE STARTING ADDRESS, ETC
1366         HRROI   A,MCJCLB
1367         RSCAN                           ; PUT JCL IN BUFFER
1368          JFCL
1369         SETZ    A,
1370         RSCAN                           ; THIS IS A CROCK. I HATE 20X!
1371          JFCL
1372         POP     P,B
1373         HRRZS   B
1374         ADDI    B,1                     ; STARTING ADDRESS IS START+1
1375         MOVE    A,MCHNDL
1376         SFORK
1377         WAIT
1378         JFCL                            ; RETURNS HERE FROM XINFER
1379         MOVE    A,MCHNDL
1380         MOVEI   B,MCACS
1381         RFACS                           ; GET THE AC'S
1382         SKIPE   MCACS+A
1383          JRST   MCERR
1384         MOVEI   A,.RSINI
1385         RSCAN                           ; CONS COUNT OF JCL
1386          JFCL
1387         JUMPE   A,MCERR
1388         MOVN    C,A
1389         MOVE    B,[440700,,INPBUF]
1390         MOVEI   A,-1
1391         SIN                             ; READ JCL
1392         MOVE    C,MCACS+B               ; GET COUNT IN C
1393         ADDI    C,4
1394         IDIVI   C,5
1395         MOVE    A,MCHNDL
1396         KFORK                           ; KILL THE MUDCOM
1397         JRST    MCPARS
1398
1399 ]
1400 ; AT THIS POINT IN TIME, THE RETURN FROM MUDCOM IS IN INPBUF
1401 ; THE LENGTH IN WORDS OF THE RETURN IS IN C
1402
1403 MCPARS: MOVE    A,[440700,,INPBUF]
1404         ILDB    B,A
1405         CAIE    B,""
1406          JRST   MCNOPK
1407         SETZ    D,
1408 MCPAKL: ILDB    B,A                     ; GET LENGTH OF PACKAGE IN CHARS
1409         CAIE    B,""
1410          AOJA   D,MCPAKL
1411         IDIVI   D,5                     ; GET LENGTH IN WORDS
1412         ADDI    D,1
1413         MOVE    A,D
1414         PUSHJ   P,IBLOCK                ; GET A BLOCK OF THAT LENGTH
1415         PUSH    P,A
1416         MOVE    E,A
1417         HRLI    E,440700                ; GET BYTE POINTER TO BLOCK
1418         MOVE    A,[440700,,INPBUF]      ; GET BYTE POINTER TO INPUT
1419         MOVEI   D,40
1420         ILDB    B,A                     ; READ OFF THE INITIAL "
1421         DPB     D,A                     ; ZERO THE CHARACTER
1422 MCP2LP: ILDB    B,A
1423         CAIN    B,""
1424          JRST   MCPAKE
1425         DPB     D,A                     ; ZERO THE CHARACTER
1426         IDPB    B,E                     ; STUFF IN BLOCK
1427         JRST    MCP2LP
1428
1429 MCPAKE: DPB     D,A
1430         POP     P,2(OUTPTR)
1431         OASC    [ASCIZ /
1432  Package =  /]
1433         OASC    @2(OUTPTR)
1434
1435 MCNOPK: MOVE    A,C                     ; NUMBER OF WORDS FOR ATOMS
1436         PUSH    P,C
1437         PUSHJ   P,IBLOCK                ; GET A BLOCK
1438         MOVE    C,(P)
1439         MOVEM   A,(P)
1440         HRLI    A,INPBUF
1441         ADDI    C,-1(A)
1442         BLT     A,(C)                   ; BLT INTO NEW BLOCK
1443         POP     P,-2(OUTPTR)
1444         OASC    [ASCIZ /
1445  Functions =  /]
1446         MOVE    A,-2(OUTPTR)
1447         HRLI    A,440700
1448         ILDB    B,A
1449         CAIN    B,40
1450          JRST   .-2
1451         ADD     A,[70000,,]
1452         TLNE    A,400000
1453         ADD     A,[347777,,-1]
1454         OBPTR   A
1455         POPJ    P,
1456
1457 MCERR:
1458 IFN ITS,[
1459         JUMPN   C,MCERR1                ; ERROR FROM INTERRUPT HANDLER?
1460 ]
1461 IFE ITS,[
1462         MOVE    C,MCACS+A               ; ERROR CODE FROM AC A
1463         JRST    MCERR1
1464 ]
1465         OASC    [ASCIZ  /
1466 MUDCOM returned abnormally:  /]
1467 IFN ITS,[
1468         TLNE    A,%PJLOS
1469          JRST   [OASC   [ASCIZ /.LOSE/]
1470                  JRST   MCERFN]
1471         TRNE    A,%PIMPV
1472          JRST   [OASC   [ASCIZ /MPV/]
1473                  JRST   MCERFN]
1474         TRNE    A,%PIIOC
1475          JRST   MCIOC
1476         TRNE    A,%PIVAL
1477          JRST   MCVAL
1478         TRNE    A,%PIILO
1479          JRST   [OASC   [ASCIZ /ILOPR/]
1480                  JRST   MCERFN]
1481 MCERUN: OASC    [ASCIZ  /Unspecified lossage/]
1482 MCERFN: OASC    [ASCIZ / at /]
1483         .USET   MCINFO,[.RUPC,,A]
1484         HRRZS   A
1485         OOCT    A
1486         OASCR   [ASCIZ  /
1487 Return ignored.  Inferior saved for debugging./]
1488         SETZM   (OUTPTR)
1489         POPJ    P,
1490
1491 MCIOC:  .USET   MCINFO,[.RBCHN,,A]
1492         HRLS    A
1493         ADD     A,[.RIOS,,A]
1494         .USET   MCINFO,A
1495         .CALL   [SETZ
1496                  SIXBIT /OPEN/
1497                  [.UAI,,ERRCHN]
1498                  [SIXBIT /ERR/]
1499                  [3]
1500                  SETZ   A]
1501          JRST   MCERUN
1502         MOVE    A,[440700,,INPBUF]
1503         PUSH    P,B
1504         MOVEI   B,INPBLN
1505         .CALL   [SETZ
1506                  SIXBIT /SIOT/
1507                  MOVEI  ERRCHN
1508                  A
1509                  SETZ   B]
1510          .LOSE  1400
1511         .CLOSE  ERRCHN,
1512         MOVEI   O,
1513         DPB     O,A
1514         OASC    [ASCIZ  /IOCERR: /]
1515         OASC    INPBUF
1516         POP     P,B
1517         JRST    MCERFN
1518 MCVAL:  .USET   MCINFO,[.RSV40,,A]
1519         HRRZS   A
1520         JUMPE   A,[OASC [ASCIZ /.VAL 0/]
1521                    JRST MCERFN]
1522         .USET   MCINFO,[.RUIND,,C]
1523         TRO     C,400000
1524         .CALL   [SETZ
1525                  SIXBIT /OPEN/
1526                  [.BII,,MCFILI]
1527                  [SIXBIT /USR/]
1528                  C
1529                  SETZ   [0]]
1530          JRST   MCERUN
1531         .ACCESS MCFILI,A
1532         MOVE    A,[-10,,INPBUF]
1533         .IOT    MCFILI,A
1534         OASC    INPBUF
1535         JRST    MCERFN
1536 ]
1537 IFE ITS,[
1538         OASC    [ASCIZ /Unresolved??/]
1539         POPJ    P,
1540 ]
1541
1542 MCERR1:
1543 IFN ITS,[
1544         SKIPE   MUDVRB
1545          JRST   [.RESET TTYO,
1546                  JRST   MCERRO]
1547 ]
1548         CAIE    C,10
1549          OASC   [ASCIZ /
1550 ERROR from MUDCOM - /]
1551         OASCR   @MCERRS(C)
1552 MCERRO: SETZM   (OUTPTR)
1553 IFN ITS,[
1554         .UCLOSE MCFILI,
1555 ]
1556 IFE ITS,[
1557         MOVE    A,MCHNDL
1558         KFORK
1559 ]       POPJ    P,
1560
1561 MCERRS: 0
1562         [ASCIZ /Self Comparison/]
1563         [ASCIZ /Bad JCL?/]
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./]
1571 \f
1572 SUBTTL  HOW TO RUN & SPECIAL COMPILATION TYPES
1573
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
1584
1585 ; TABLE OF POINTERS TO ROUTINES FOR SPECIAL COMPILATION TYPES
1586 DSPTBL==.+1
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
1605 \f
1606 ; HOW-TO-RUN ROUTINES:  COMBAT (DEFAULT), FILOUT, PCOMP, AND MANY
1607 FILOUT: MOVE    A,[SIXBIT /PLAN/]
1608         MOVE    B,SNAME
1609         PUSHJ   P,PTPLAN
1610         SKIPN   DEBUG
1611 IFN ITS,[
1612          .IOPOP OUTCHN,
1613 ]
1614 IFE ITS,[
1615          PUSHJ  P,XIOPOP
1616 ]
1617         JRST    MORCMP
1618
1619 PCOMP:  SETOM   PCOMPF                  ; SAYS THAT NEED TO START PCOMP WHEN LEAVE
1620         MOVE    A,[SIXBIT /PCOMP/]
1621         MOVE    B,SNAME
1622         PUSHJ   P,PTPLAN
1623         SKIPN   DEBUG
1624 IFN ITS,[
1625          .IOPOP OUTCHN,
1626 ]
1627 IFE ITS,[
1628          PUSHJ  P,XIOPOP
1629 ]
1630         SETZM   NCOMPF
1631         MOVE    A,OUTSTR
1632         MOVEI   O,1
1633         TDNE    O,.QNEWC(A)                     ; IS THIS OLD COMPILER?
1634          SETOM  NCOMPF                  ; NO, SO WHEN LEAVE SAY :NPCOMP
1635         JRST    MORCMP
1636
1637 MANY:   SETOM   MNYFLG                  ; MANY MODE:  SET FLAG, GET ANOTHER
1638         POPJ    P,
1639
1640 IFE ITS,[
1641 XIOPSH: MOVE    O,OUTJFN'
1642         MOVEM   O,OUTJF1'
1643         POPJ    P,
1644
1645 XIOPOP: PUSH    P,A
1646         MOVE    A,OUTJFN
1647         CLOSF
1648          JFCL
1649         POP     P,A
1650         MOVE    O,OUTJF1
1651         MOVEM   O,OUTJFN
1652         POPJ    P,
1653 ]
1654
1655 ; LOW-PRIORITY PLANS:  GO TO COMBAT;WASTE >, OTHERWISE IDENTICAL WITH COMBAT.
1656 WASTE:  MOVE    A,[SIXBIT /WASTE/]
1657         SETOM   WASTAG
1658         JRST    COMBT1
1659
1660 ; DEFAULT:  PLAN TO COMBAT;PLAN >.
1661 COMBAT:
1662 IFN ITS,[
1663         MOVE    A,[SIXBIT /PLAN/]
1664         SETZM   WASTAG
1665 ]
1666 IFE ITS,[
1667         MOVE    A,[SIXBIT /PLAN/]
1668 ]
1669 COMBT1: MOVE    B,[2,,[ASCIZ /COMBAT/]]
1670         PUSHJ   P,PTPLAN
1671 IFN ITS,[
1672         SKIPN   DEBUG
1673          JRST   [.CALL  GPLANN
1674                  .LOSE  1000
1675                  .IOPOP OUTCHN,
1676                  OASCR  [0]
1677                  MOVEI  B,[ASCIZ /COMBAT #/]
1678                  SKIPE  WASTAG
1679                   MOVEI B,[ASCIZ /WASTAGE #/]
1680                  OASC   (B)
1681                  OSIX   A
1682                  OASCR  [ASCIZ / scheduled./]
1683                  JRST .+1]
1684         CAME    A,[SIXBIT /1/]                  ; IF NOT PLAN 1, DON'T NEED TO SIGNAL
1685          SETOM  NOSIG
1686         SKIPE   WASTAG
1687          JRST   HRCHK                           ; WASTES DON'T CARE ABOUT WEEKENDS
1688         .RYEAR  A,
1689          LDB    A,[320300,,A]                   ; IS IT A WEEKEND?
1690         JUMPE   A,SDEMON
1691         CAIN    A,6
1692          JRST   SDEMON
1693 HRCHK:  .RTIME  A,
1694         LDB     A,[301400,,A]                   ; IS IT OFFICE HOURS?
1695         SKIPE   WASTAG                          ; OFFICE HOURS DEFINED DIFFERENTLY
1696          JRST   [CAIGE  A,'01
1697                   JRST  SSTATU
1698                  CAIGE  A,'08
1699                   JRST  SDEMON                  ; WIN
1700                  JRST   SSTATU]                 ; OTHERWISE CAUSE THE CROCK TO COME UP
1701         CAIGE   A,'20
1702          CAIGE  A,'08
1703           JRST  SDEMON
1704         .RDATE  A,
1705         .CALL   HOLOPN                          ; IS IT A HOLIDAY?
1706          JRST   SSTATU                          ; OTHERWISE, DO STDMST
1707 SDEMON: SKIPE   NOSIG
1708          JRST   MORCMP
1709         OASCR   [ASCIZ  /Demon signalled./]
1710         SKIPN   DEBUG
1711          .CALL  DEMSIG                          ; START UP COMBAT
1712          JFCL
1713         JRST    MORCMP
1714
1715 SSTATU: .CALL   RQDATE                          ; GET HALF-SEC SINCE MIDNIGHT IN B
1716          JFCL
1717         TLZ     B,-1
1718         SKIPE   WASTAG
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
1722                  JRST   SSTAT1]
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
1727          .VALUE
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?
1731          JRST   MORCMP                          ; NO
1732 SSTAT2: .CALL   STDMST                          ; YES, SO SET IT
1733          .VALUE
1734         JRST    MORCMP
1735
1736 DEMSIG: SETZ
1737         SIXBIT  /DEMSIG/
1738         [SIXBIT /ZONE/]
1739         SETZI   0
1740
1741 GPLANN: SETZ
1742         SIXBIT /RCHST/
1743         MOVEI   OUTCHN
1744         MOVEM   A
1745         MOVEM   A
1746         SETZM   A
1747
1748 HOLOPN: SETZ
1749         SIXBIT  /OPEN/
1750         [6,,DSKCHN]
1751         [SIXBIT /DSK/]
1752         [SIXBIT /HLIDAY/]
1753         A
1754         SETZ    [SIXBIT /COMBAT/]
1755
1756 RQDATE: SETZ
1757         SIXBIT  /RQDATE/
1758         SETZM   B
1759
1760 STDMST: SETZ
1761         SIXBIT  /STDMST/
1762         [SIXBIT /ZONE/]
1763         [5000.,,0]
1764         SETZ    A
1765
1766 RDDMST: SETZ
1767         SIXBIT  /RDDMST/
1768         [SIXBIT /ZONE/]
1769         MOVEM   B
1770         MOVEM   C
1771         SETZM   C
1772 ]
1773 IFE ITS,[
1774         PUSHJ   P,XIOPOP
1775         JRST    MORCMP
1776 ]
1777
1778 \f
1779
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
1782 ; GETS ASKED AGAIN.
1783
1784 HPRTHK: PUSH    BK,[0]
1785         PUSH    BK,[HPROUT]
1786         PUSH    BK,[[POPJ P,]]
1787         PUSH    BK,P
1788         SETOM   LONGOT                          ; ENABLE MORES
1789         OASCR   [0]
1790         PUSHJ   P,PTPLA1                        ; DO PRINTING
1791 HPROUT: SETZM   LONGOT
1792         BKOFF
1793         AOS     (P)
1794         JRST    POPJ1
1795
1796 HASKHK: JRST    POPJ1
1797
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.
1801
1802 HASK:   SETZM   PRMPT1
1803 HASK1:  MOVE    A,[TAILEN+TALSPC,,TAILTB]       ; TABLE OF REASONABLE QUESTIONS
1804         PUSH    BK,PRMPT1                       ; FROM HERE, RETURN TO NORMAL LOOP
1805         PUSH    BK,[QDONXT]
1806         PUSH    BK,[HSKRT1]                     ; NO SPECIAL HACKS
1807         PUSH    BK,P
1808         PUSHJ   P,COMTYP                        ; GET QUESTION OFFSET IN A
1809         BKOFF
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?/]
1813                  JRST POPJ1]
1814         PUSH    P,OUTPTR                        ; SAVE OFFSETS FOR CTRL-R
1815         PUSH    P,QOFF
1816         PUSH    P,CMPBLK
1817         MOVE    OUTPTR,OUTBLK                   ; SET UP CMPBLK & OUTPTR
1818         MOVE    CMPBLK,CMPSIZ(OUTPTR)
1819         ADD     CMPBLK,A
1820         ADD     OUTPTR,A
1821         HRRZ    QOFF,A
1822         MOVE    A,(OUTPTR)                      ; SAVE OLD VALUE IN CASE OF CTRL-R
1823         MOVEM   A,RVALS
1824         MOVE    C,QTABLE(QOFF)
1825         TLNE    C,$TFILE                        ; FILE QUESTION?
1826          JRST   [JUMPN  A,HASKER                ; IF NON-ZERO, BLOCK THERE ALREADY
1827                  PUSHJ  P,DEFILE                ; OTHERWISE FROB IT
1828                  JRST   HASKER]
1829         SETZM   (OUTPTR)                        ; CLEAR PREVIOUS ANSWER
1830         MOVE    C,(CMPBLK)
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
1837                  JRST   HASKER]
1838         PUSHJ   P,NRMDEF
1839 HASKER: PUSH    BK,[[ASCIZ /  Question/]]
1840         PUSH    BK,[HSKRET]                     ; RETURN TO HSKRET IF CTRL-R
1841         PUSH    BK,[[POPJ P,]]                  ; NOTHING SPECIAL
1842         PUSH    BK,P                            ; SAVE P
1843         SETZ    A,
1844         DPB     A,[430100,,(OUTPTR)]            ; CLEAR %DATAH BIT, FOR ASKER
1845         CAIN    QOFF,.QCOMP                     ; COMPARE QUESTION?
1846          JRST   HCOMP
1847         CAIN    QOFF,.QSNAM                     ; SNAME QUESTION?
1848          JRST   HSNAM
1849         HLLZ    A,QTABLE(QOFF)                  ; TO HAVE THE BITS
1850         PUSHJ   P,ASK1
1851          JRST   HSKPOP
1852 HASKOT: MOVEI   A,1
1853         DPB     A,[430100,,(OUTPTR)]            ; TURN ON %DATAH BIT
1854 HSKPOP: POP     P,CMPBLK
1855         POP     P,QOFF
1856         POP     P,OUTPTR
1857         BKOFF
1858         JRST    POPJ1
1859
1860 ; ASK SNAME QUESTION
1861
1862 HSNAM:  PUSHJ   P,ASK           ; ASK THE QUESTION
1863          JFCL
1864         PUSHJ   P,ASNMD1
1865         JRST    HSKPOP
1866
1867
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?
1872                   JRST  HCNOPR
1873                  JRST   HCOMP1]
1874         SKIPL   A,<.QPREC-.QCOMP>(OUTPTR)       ; GOT ANSWER IN HERE?
1875          JRST   HCNOPR
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
1881         JRST    HASKOT
1882 HCNOPR: SETZM   (OUTPTR)
1883         OASCR   [ASCIZ /  No precompiled?/]
1884         JRST    HSKPOP
1885
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
1890         POP     P,QOFF
1891         POP     P,OUTPTR
1892         JRST    HASK1
1893
1894 ; HANDLE CTRL-R FROM ASKING FOR QUESTION
1895 HSKRT1: MOVE    OBSCEN,BACK(OBSCEN)             ; GO BACK TO 'HOW TO RUN'
1896         MOVE    A,BKPSAV(BK)
1897         SUB     A,[1,,1]
1898         MOVEM   A,BKPSAV(BK)                    ; FLUSH EXTRA SLOT ON P
1899         POPJ    P,
1900 \f
1901 ; SPECIAL COMPILATION TYPES:  MULTIPLE, TAILOR FROBBING, QUIT, FLUSH
1902
1903 MULTPL: SKIPE   MULFLG
1904          OASC   [ASCIZ / What a chomper! /]
1905         SETOM   MULFLG
1906         POPJ    P,
1907
1908 VERBOS: SETCMM  PR2SW
1909         PUSHJ   P,PRTAIL
1910         MOVEI   A,[ASCIZ / Verbose/]
1911         SKIPN   PR2SW
1912         MOVEI   A,[ASCIZ / Unverbose/]
1913         OASC    (A)
1914         POPJ    P,
1915
1916 MVERBO: SETCMM  MUDVRB
1917         PUSHJ   P,PRTAIL
1918         MOVEI   A,[ASCIZ /MUDCOM verbosity/]
1919         SKIPN   MUDVRB
1920          MOVEI  A,[ASCIZ /MUDCOM silence/]
1921         OASC    (A)
1922         POPJ    P,
1923
1924 FEXIST: SETCMM  FILEXI'
1925         PUSHJ   P,PRTAIL
1926         MOVEI   A,[ASCIZ /Files Must Exist/]
1927         SKIPE   FILEXI
1928          MOVEI  A,[ASCIZ /Files Need Not Exist/]
1929         OASC    (A)
1930         POPJ    P,
1931
1932 ; TAILOR ANOTHER COMPILATION QUESTION
1933 SETMOR: MOVEI   A,[ASCIZ /Another compilation? /]
1934         MOVEM   A,PRMPT1
1935         MOVE    A,[TFALEN,,TFATBL]
1936         PUSHJ   P,COMTYP
1937         TRNE    A,400000        ; FIRST ELEMENT OF TABLE HAS VAL -1, MEANS ASK
1938          JRST   [SETZM  NMORAS
1939                  JRST   SETOUT]
1940         SETOM   NMORAS
1941         MOVEM   A,MORANS
1942 SETOUT: PUSHJ   P,PRTAIL
1943         POPJ    P,
1944
1945 IFN ITS,[
1946 QUIT:   SKIPN   PCOMPF          ; PCOMP TO BE RUN?
1947          .BREAK 16,160000
1948         MOVEI   B,OPCOMP        ; VALRET THE RIGHT THING
1949         SKIPE   NCOMPF
1950          MOVEI  B,NPCOMP
1951         .VALUE  (B)
1952 OPCOMP: ASCIZ   /\17:KILL
1953 \16:PCOMP
1954 /
1955 NPCOMP: ASCIZ   /\17:KILL
1956 \16:NPCOMP
1957 /
1958 ]
1959
1960 IFE ITS,[
1961 QUIT:   SKIPN   PCOMPF
1962          HALTF
1963         MOVEI   A,.FHSLF
1964         MOVEI   B,200000                ; TURN OFF INFERIOR INTERRUPT, ECCH!
1965         DIC
1966         MOVSI   A,(GJ%SHT+GJ%OLD)
1967         MOVE    B,[440700,,[ASCIZ /SYS:PCOMP.EXE/]]
1968         SKIPE   NCOMPF
1969          MOVE   B,[440700,,[ASCIZ /NEW:NPCOMP.EXE/]]
1970         GTJFN
1971          JRST   LDERR
1972         OASCR   [0]
1973         OASCR   [ASCIZ /Loading compiler./]
1974         HRLI    A,.FHSLF
1975         MOVEM   A,PCLOAD+1
1976         MOVSI   P,PCLOAD
1977         BLT     P,P
1978         JRST    B               ; BYE BYE
1979
1980 LDERR:  OASCR   [0]
1981         OASC    [ASCIZ /Load of PCOMP failed: /]
1982         MOVE    B,A
1983         TLO     B,.FHSLF
1984         MOVEI   A,.PRIOU
1985         SETZ    C,
1986         ERSTR
1987          JFCL
1988           JFCL
1989         OASCR   [0]
1990         HALTF
1991
1992 PCLOAD: 0
1993         0
1994         GET
1995         MOVEI   A,400000
1996         GEVEC
1997         RESET
1998         JRST    (B)
1999 ]
2000
2001 ; GET RID OF LONG COMPILATION
2002 FLUSH:  SETZM   MNYFLG
2003         POPJ    P,
2004
2005 ; PRINT OUT ACCUMULATED LONG COMPILATION, IN CASE YOU FORGOT
2006 PTLONG: SKIPN   MNYFLG
2007          JRST   [OASC   [ASCIZ /
2008 No plans pending./]
2009                  POPJ   P,]
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
2014 \f
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)
2018
2019 MORCMP: SETZM   NOSIG
2020         SETZM   TPFUDG
2021         MOVE    A,[1,,[ASCIZ /DSK/]]
2022         MOVEM   A,SYSDEV
2023 IFN ITS,[
2024         MOVE    A,[1,,[ASCIZ />/]]
2025 ]
2026 IFE ITS,[
2027         MOVE    A,[1,,[ASCIZ /MUD/]]
2028 ]
2029         MOVEM   A,SYSFN2
2030         SKIPE   MNYFLG          ; ALWAYS ASK ANOTHER IF MAKING LONG COMPILATION
2031          POPJ   P,
2032         MOVE    A,SNAME         ; RESET DEFAULT SNAMES
2033         MOVEM   A,PSNAME
2034         MOVEM   A,SYSDIR
2035         SKIPE   MULFLG          ; ALWAYS GIVE ANOTHER
2036          POPJ   P,
2037         MOVE    A,MORLOC(CMPBLK)        ; DID LUSER GIVE AN ANSWER ALREADY?
2038         TLNN    A,%DSUP
2039          JRST   ASKMOR
2040         HRRZS   A                       ; GET IT IN A
2041         JUMPN   A,CPOPJ
2042          JRST   QUIT
2043 ASKMOR: SKIPN   NMORAS                  ; DID HE SAY TO ASK?
2044          JRST   ASKMR1
2045         SKIPN   A,MORANS                ; SKIPS IF ANSWER YES
2046          JRST   QUIT
2047         POPJ    P,
2048 ASKMR1: MOVE    A,[1,,1]                ; IF SAID TO ASK, MAKES DEFAULT 'None'
2049         MOVEM   A,TPFUDG
2050         POPJ    P,
2051
2052 \f
2053 SUBTTL  PLAN PRINTER
2054
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.
2058 PTPLAN: SKIPN   DEBUG
2059          PUSHJ  P,PLNOPN
2060         SETZM   MNYFLG                  ; NO LONGER NEEDED
2061 PTPLA1: SETOM   FSTBLK                  ; PRINTING FIRST, SO NEED NEW CMP
2062         MOVE    OUTPTR,OUTSTR
2063         MOVEM   OUTPTR,LSTOUT
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
2068         MOVEI   F,QTABLE(B)
2069         MOVE    F,(F)
2070         TLNE    F,%GIGNO                        ; SEE IF QUESTION SHOULD EVER BE USED
2071          JRST   EAOBJN
2072         SKIPN   FSTBLK
2073          JRST   [TLNN F,%TNMNY                  ; LOOK AT QSPEC TO SEE IF THIS IS
2074                   JRST CONTIN                   ; OUTPUT ONLY FIRST TIME THROUGH
2075                  JRST EAOBJN]
2076 CONTIN: MOVE    E,B
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
2080         TLNE    E,%IGNOR
2081          JRST   [TLNN E,%DSUP                   ; IF USER-SUPPLIED DEFAULT
2082                   JRST CKESSN                   ; SEE IF ESSENTIAL
2083                  JRST DOOUT]
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
2087 EAOBJN: AOBJN   A,.+1
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)
2091          POPJ   P,                              ; NO, DONE
2092         MOVEM   OUTPTR,LSTOUT                   ; MAKE LSTOUT, OUTPTR POINT TO NEW ONE
2093         SETZM   FSTBLK                          ; MULTIPLE COMPILATION MODE
2094         JRST    MANYLP
2095 TSTDON: SKIPN   (A)
2096          JRST   OUTDON
2097         JRST    OUTLP
2098
2099 IFN ITS,[
2100 PLNOPN: EXCH    A,B
2101         PUSHJ   P,ASCSIX                        ; GET THIS IN SIXBIT
2102         EXCH    A,B
2103         .IOPUSH OUTCHN,
2104          .CALL  [SETZ
2105                  SIXBIT /OPEN/
2106                  MOVSI  .UAO
2107                  MOVEI  OUTCHN
2108                  [SIXBIT /DSK/]
2109                  A
2110                  [SIXBIT />/]
2111                  SETZ B]
2112         .LOSE 1000
2113         POPJ P,
2114 ]
2115 ; IN A, THE SIXBIT NAME OF THE FILE TO OPEN (I.E. PCOMP, WASTE, ETC.)
2116 ; IN B, THE DIRECTORY (IN ASCII)
2117 IFE ITS,[
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
2121         SKIPE   B
2122          HRROM  B,.GJDIR+GTJFNP         ; SO ALSO WITH THE DIRECTORY NAME
2123         SKIPE   A,SNAME
2124          HRROM  A,.GJDIR+GTJFNP
2125         MOVEI   A,GTJFNP
2126         SETZ    B,
2127         GTJFN
2128          JRST   PLNOPF
2129         MOVEM   A,OUTJFN
2130         MOVE    B,[070000,,OF%WR]
2131         OPENF
2132          CAIA
2133         POPJ    P,
2134
2135 PLNOPF: OASCR [ASCIZ /Open of PLAN failed?/]
2136         HALTF
2137
2138
2139 GTJFNP: SETZ
2140         .NULIO,,.NULIO
2141         0
2142         0
2143         -1,,[ASCIZ /PCOMP/]
2144         -1,,[ASCIZ /PLAN/]
2145         0
2146         0
2147         0
2148 ]
2149
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
2152          JRST   DOOUT
2153 CKESS2: HLRZ    F,1(A)
2154         MOVE    F,QTABLE(F)
2155         TLNN    F,%ESSEN                        ; SKIPS IF ESSENTIAL QUESTION
2156          JRST   EAOBJN                          ; INESSENTIAL, SO GO TO NEXT
2157         JRST    DOOUT
2158
2159 AOPOP:  AOBJN   A,.+1                           ; RETURN POINT IF NOTHING PRINTED
2160         POPJ    P,
2161 ; DISPATCH TABLE FOR DIFFERENT TYPES OF OUTPUT
2162 ; ALL SKIP RETURN IF ANY OUTPUT PRINTED
2163 OUTYPE: T.FDF
2164         T.FDT
2165         FNAME
2166         FORM
2167         STRING
2168         OTREDO
2169         OSNAME                  ; OUTPUT SNAME
2170 \f
2171 ; HERE FOR FLAGS:  T/F, DEFAULT <>
2172 T.FDF:  JUMPE   B,CPOPJ
2173         OASC    (D)             ; PRINT OUT LEADING FROB
2174         OASC    $TRUE
2175         AOBJN   A,.+1
2176 PRTOUT: HRRZ    C,(A)           ; COMMON TO ALL PRINTOUT ROUTINES:  PRINT OUT TRAILER,
2177         OASC    (C)             ; THEN SKIP-RETURN
2178 POPJ1:  AOS     (P)
2179 CPOPJ:  POPJ    P,
2180
2181 ; SAME, BUT DEFAULT T
2182 T.FDT:  JUMPN   B,CPOPJ
2183         OASC    (D)
2184         OASC    $FALSE
2185         AOBJN   A,PRTOUT
2186
2187 $TRUE:  ASCIZ   /T/
2188 $FALSE: ASCIZ   /#FALSE ()/
2189
2190 ; HERE TO PRINT OUT FILE NAMES.  SURROUNDS THEM WITH QUOTES, AUTOMAGICALLY
2191 FNAME:  JUMPE   B,CPOPJ
2192         OASC    (D)
2193         OASCI   ""
2194         PUSH    P,A
2195         MOVE    A,B
2196         PUSHJ   P,NFNAME
2197         POP     P,A
2198         OASCI   ""
2199         AOBJN   A,PRTOUT
2200
2201 ; NEW FILE NAME PRINTER.  A HAS POINTER TO BLOCK OF NAMES
2202 NFNAME: PUSH    P,C
2203         PUSH    P,D
2204         MOVEI   D,CHRTBL
2205         HRLI    A,-FSPSIZ
2206 NFNMLP: MOVE    C,(A)
2207         SPNAM1  C
2208          JRST   [MOVEI C,[ASCIZ /<filename1>/]
2209                  SKIPE SSSPPP
2210                   MOVEI C,[ASCIZ /<filename2>/]
2211                  OASC (C)
2212                  JRST .+2]
2213         OASC    (C)
2214         MOVE    E,1(A)          ; NEXT NAME
2215         MOVE    E,(E)           ; GET ASCII
2216         CAMN    E,[ASCIZ /0/]
2217          JRST   NFNMDN          ; DON'T PRINT .0!
2218         SKIPN   1(A)
2219          JRST   NFNMDN
2220         OASC    (D)
2221         ADDI    D,1
2222         AOBJN   A,NFNMLP
2223 NFNMDN: POP     P,D
2224         POP     P,C
2225         POPJ    P,
2226
2227 IFN ITS,[
2228 CHRTBL: ASCIZ /:/
2229         ASCIZ /;/
2230         ASCIZ / /
2231         ASCIZ /?/
2232         ASCIZ /?/
2233 ]
2234 IFE ITS,[
2235 CHRTBL: ASCIZ /:</
2236         ASCIZ />/
2237         ASCIZ /./
2238         ASCIZ /./
2239         ASCIZ /;/
2240 ]
2241
2242 ; PRINT OUT A FORM IFF THE GIVEN SWITCH IS T (NEW COMPILER, MAINLY)
2243 FORM:   JUMPE   B,CPOPJ
2244         OASC    (D)
2245         AOBJN   A,PRTOUT
2246
2247 ; PRINT OUT A STRING, NOT SURROUNDED BY QUOTES (PACKAGE MODE, ETC.)
2248 STRING: JUMPE   B,CPOPJ
2249         OASC    (D)
2250         OASC    (B)
2251         AOBJN   A,PRTOUT
2252
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
2257         HRR     F,B
2258 OTLOOP: ILDB    F               ; FLUSH LEADING BLANKS
2259         CAIN    0,"
2260          JRST   OTLOOP
2261         ADD     F,[70000,,]             ; DECREMENT THE POINTER--JUST FOUND NON-BLANK
2262         TLNE    F,400000
2263         ADD     F,[347777,,-1]
2264         OBPTR   F                       ; PRINT LIST
2265         SETOM   DOEND                   ; SAYS THAT NEED TO PRINT ')>' EVEN IF NOTHING
2266                                         ; IN USER-SUPPLIED REDO LIST
2267 RREDO:  HLRZ    B,1(A)
2268         ADD     B,OUTPTR
2269         ADDI    B,3
2270         HRRZ    B,(B)
2271         JUMPE   B,[SKIPN DOEND          ; NOTHING IN USER-SUPPLIED LIST. COMPARE LIST?
2272                     POPJ P,             ; NO, SO LEAVE IMMEDIATE
2273                    JRST LDO]
2274         SKIPN   DOEND
2275          OASC   (D)
2276         OASC    (B)
2277 LDO:    SETZM   DOEND
2278         AOBJN   A,PRTOUT
2279
2280 ; OUTPUT <SNAME "FOO"> FROM PSNAME
2281 OSNAME: SKIPN   PSNAME
2282          AOBJN  A,POPJ1                 ; FLUSH COMPLETELY
2283         OASC    (D)                     ; PRINT <SNAME "
2284         TRNN    B,-1                    ; 0?
2285          JRST   OSNAM1                  ; YES, SO USE PSNAME
2286         OASC    (B)                     ; PRINT SNAME
2287         AOBJN   A,PRTOUT                ; AND GO CLEAN UP
2288 OSNAM1: PUSH    P,C
2289         MOVE    C,PSNAME
2290         OASC    (C)
2291         POP     P,C
2292 OSNAMO: AOBJN   A,PRTOUT
2293 \f
2294 SUBTTL  TAILORING
2295
2296 ; PUSHJ P,LDTAIL
2297 ; COME HERE TO READ A TAILOR FILE INTO NCOMBAT
2298 A; ALWAYS RETURNS WITHOUT SKIPPING
2299
2300 IFN ITS,[
2301 TALOPI: SETZ
2302         SIXBIT /OPEN/
2303         MOVSI .BII
2304         MOVEI DSKCHN
2305         TALDEV
2306         TALFN1
2307         TALFN2
2308         SETZ TALSNM
2309
2310 TALOPO: SETZ
2311         SIXBIT /OPEN/
2312         MOVSI .BIO
2313         MOVEI DSKCHN
2314         TALDEV
2315         TALFN1
2316         TALFN2
2317         SETZ TLSNAM
2318 ]
2319 ; PUSHJ P,MKTAIL
2320 ; A = POINTER TO START OF TAILOR BLOCK
2321 ; INITIALIZES BLOCK TO %IGNOR+<QUESTION ID>,,0
2322
2323 MKTAIL: PUSH    P,F
2324         MOVEI   QOFF,0                  ; INITIALIZE QOFF
2325
2326 MKTLP:  LDB     F,[220600,,QTABLE(QOFF)]
2327         TRO     F,%IGNOR
2328         HRLZM   F,(A)
2329         AOJ     A,
2330         AOJ     QOFF,
2331         SKIPE   QTABLE(QOFF)
2332          JRST   MKTLP
2333         MOVSI   F,%IGNOR+CRETQ          ; FINISH INITIALIZING, ALL TO CRETQ
2334         MOVEM   F,(A)
2335         HRLZ    F,A
2336         HRRI    F,1(A)
2337         MOVE    A,-2(P)
2338         BLT     F,MORLOC-1(A)
2339         POP     P,F
2340         POPJ    P,
2341
2342 ; PUSHJ P,LDTAIL
2343 ; LOADS TAILOR FILE
2344
2345 LDTAIL:
2346 IFN ITS,[
2347         .CALL   TALOPI
2348 ]
2349 IFE ITS,[
2350         MOVEI   A,XTALNM
2351         SETZ    B,
2352         GTJFN
2353 ]
2354          JRST   [SKIPN  ERRFLG
2355                   POPJ  P,
2356                  PUSH   P,[OPNFAL]
2357                  JRST   ERRPRT]
2358 IFE ITS,[
2359         MOVEM   A,DSKJFN'
2360         MOVE    B,[440000,,OF%RD]
2361         OPENF
2362          JRST   [OASCR [ASCIZ /Open of TAILOR failed?/]
2363                  HALTF]
2364 ]
2365         SKIPE   LDFLAG
2366          PUSHJ  P,NAMMAK        ; CONS STRING AND LENGTH FOR NAMUNQ
2367         SETOM   UTPSAV
2368 IFN ITS,[
2369 LDLOOP: MOVE    C,[-2,,D]
2370         .IOT    DSKCHN,C        ; GET THE FIRST WORDS IN D AND E
2371 ]
2372 IFE ITS,[
2373 LDLOOP: MOVE    C,[-2,,XCHOMP']
2374         PUSHJ   P,XIOTI
2375          C
2376          JRST   LDOUT
2377         MOVE    D,XCHOMP
2378         MOVE    E,XCHOMP+1
2379         JRST    LDLOP0
2380 ]
2381         JUMPL   C,LDOUT
2382         JUMPE   D,LDOUT
2383 LDLOP0: SKIPGE  UTPSAV
2384          JRST   [HLRE   A,UTYPLN
2385                  MOVNS  A
2386                  HRLS   A
2387                  MOVEM  A,UTPSAV
2388                  JRST   .+1]    ; SAVE <#TYPES>,,<#TYPES> FOR HACKING LINKS
2389         SETZM   PR2SW
2390         TLZN    D,%NWFMT
2391 IFN ITS,[
2392          SETOM  ITSFXF
2393 ]
2394 IFE ITS,[
2395          JFCL
2396 ]       TLZE    D,%TVERB
2397          SETOM  PR2SW
2398         SETZM   NMORAS
2399         TLZE    D,%NMRAS        ; SKIPS IF SAID 'ASK'
2400          SETOM  NMORAS
2401         SETZM   FILEXI
2402         TLZE    D,%TFNEX
2403          SETOM  FILEXI
2404         SETOM   MORANS
2405         TLZN    D,%MRANS        ; SKIPS IF ANSWER 'YES'
2406          SETZM  MORANS
2407         SETZM   MUDVRB
2408         TLZN    D,%MNVRB
2409          SETOM  MUDVRB
2410         LDB     F,[220600,,D]   ; GET THE VERSION NUMBER
2411         CAME    F,QVERS
2412          SETOM  UPTFLG          ; MUST DO AN UPDATE
2413         TLZ     D,777777        ; FLUSH LEFT HALF
2414         MOVE    A,D
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
2418         MOVSS   B
2419         HRR     B,A
2420 IFN ITS,[
2421         .IOT    DSKCHN,B        ; IOT IN THE NAME
2422 ]
2423 IFE ITS,[
2424         PUSHJ   P,XIOTI
2425          B
2426          JFCL
2427 ]
2428         SKIPE   LDFLAG          ; ARE WE DOING A LOAD TAILOR?
2429          PUSHJ  P,NAMUNQ        ; MAKE NAME UNIQUE
2430         MOVE    A,E
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
2434         MOVN    B,E
2435         MOVSS   B
2436         HRRI    B,-LNALEN(A)    ; START IOT AT BEGINNING OF LINK AREA
2437 IFN ITS,[
2438         .IOT    DSKCHN,B        ; IOT IN THE BLOCK
2439 ]
2440 IFE ITS,[
2441         PUSHJ   P,XIOTI
2442          B
2443          JFCL
2444 ]
2445         MOVE    C,A
2446         MOVSI   QOFF,QNUM       ; AOBJN POINTER TO QUESTION BLOCK
2447         MOVE    CMPBLK,QOFF     ; SET UP SAME POINTER FOR FIXUP HACKING
2448 LDLOP1: SKIPE   UPTFLG
2449          JRST   UPTAIL
2450         MOVE    B,QTABLE(QOFF)  ; GET SLOT FOR THIS QUESTION
2451         TLNE    B,$TSYMBOL
2452          JRST   LDEND1
2453         HRRZ    B,(C)           ; GET THE RH OF THE FROBNITZ
2454         JUMPE   B,LDEND1        ; EMPTY. FINISH
2455         ADDM    A,(C)           ; UPDATE THE POINTER
2456         MOVE    B,QTABLE(QOFF)
2457         TLNE    B,$TFILE
2458          PUSHJ  P,LDFILE
2459 LDEND1: AOS     C
2460         AOBJN   QOFF,LDLOP1
2461 LDEND2: JSP     RET,NEWTYP
2462         JRST    LDLOOP
2463 LDOUT:
2464 IFN ITS,[
2465         .CLOSE  DSKCHN,
2466 ]
2467 IFE ITS,[
2468         MOVE    A,DSKJFN
2469         CLOSF
2470          JFCL
2471 ]
2472         SKIPGE  A,UTPSAV
2473          JRST   LDOUT1
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
2478         PUSH    P,A
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
2484         MOVE    E,(A)
2485         MOVEM   E,(D)           ; STUFF IT IN BLOCK
2486         MOVE    A,(P)           ; RESTORE A
2487         AOBJN   D,LDLNLP
2488 LDLNKL: AOBJN   B,LDLN1
2489         POP     P,A
2490 LDOUT1: SKIPE   UPTFLG
2491          JRST   [SKIPN  NODUMP
2492                   PUSHJ P,PRTAIL
2493                  JRST   .+1]
2494         SETZM   UPTFLG
2495         SKIPE   ITSFXF
2496          PUSHJ  P,PRTAIL        ; WRITE OUT UPDATE FILE (NEW FORMAT)
2497         POPJ    P,
2498
2499 ;FIXUP POINTERS TO FILE NAMES
2500
2501 LDFILE: HRRZ    D,(C)
2502         HRLI    D,-FSPSIZ
2503         SKIPE   ITSFXF
2504          JRST   [PUSH P,A
2505                  HRLI D,-ITSSIZ
2506                  MOVEI A,FSPSIZ
2507                  PUSHJ P,IBLOCK
2508                  MOVE F,A
2509                  POP P,A
2510                  JRST .+1]
2511 LDFLP:  SKIPE   ITSFXF
2512          JRST   ITSFIX
2513         SKIPN   E,(D)
2514         CAIA
2515          ADDM   A,(D)
2516 LDFLPE: AOBJN   D,LDFLP
2517         SKIPN   ITSFXF
2518          POPJ   P,
2519         SUBI    F,ITSSIZ
2520         HRRM    F,(C)
2521         POPJ    P,
2522
2523 ITSFIX: SKIPN   E,(D)
2524          JRST   ITSFX1
2525         PUSH    P,A
2526         MOVE    A,E
2527         CAIGE   E,3
2528          CAIG   E,0
2529           CAIA
2530            JRST [MOVE A,[1,,[ASCIZ /\18/]]
2531                  CAIE E,1
2532                   MOVE A,[1,,[ASCIZ /\19/]]
2533                  JRST ITSFX2]
2534         PUSHJ   P,SIXASC
2535 ITSFX2: MOVEM   A,(F)
2536         POP     P,A
2537 ITSFX1: AOJA    F,LDFLPE
2538
2539 UPTAIL: MOVEI   A,CMPLEN
2540         PUSHJ   P,IBLOCK        ; GET A NEW BLOCK
2541         MOVE    O,(P)
2542         SUBI    O,6
2543         MOVSS   O
2544         HRR     O,A
2545         BLT     O,LNALEN(A)     ; COPY LINK STUFF
2546         ADDI    A,LNALEN        ; POINT TO FIRST NON-LINK WORD
2547         MOVE    O,(P)
2548         MOVEM   A,(P)
2549         PUSHJ   P,MKTAIL        ; MUMBLE THE BLOCK CORRECTLY
2550         MOVE    RET,O
2551         MOVE    A,(P)           ; AND SAVE ADDRESS AS ABOVE
2552         MOVE    B,HOWLOC(RET)   ; HACK HOW TO RUN AND MORE?
2553         MOVEM   B,HOWLOC(A)
2554         MOVE    B,MORLOC(RET)
2555         MOVEM   B,MORLOC(A)
2556 UPTLP:  MOVE    B,(C)           ; GET THIS ENTRY IN TAILOR
2557         PUSHJ   P,QFIND         ; GET OFFSET FOR THIS QUESTION IN QOFF, LOC IN D
2558          JRST   UPEND
2559         MOVEM   B,(D)           ; SAVE AWAY AT CORRECT SLOT
2560         MOVE    B,QTABLE(QOFF)  ; GET THE TYPE CODES
2561         TLNE    B,$TSYMBOL
2562          JRST   UPEND
2563         HRRZ    B,(C)           ; GET THE LOCATION OF BLOCK POINTER
2564         JUMPE   B,UPEND
2565         ADDM    O,(D)           ; UPDATE POINTER
2566 UPEND:  AOJ     C,
2567         AOBJN   CMPBLK,UPTLP
2568         JRST    LDEND2
2569
2570 ; PUSHJ P,QFIND
2571 ; B = WORD FROM TAILOR CONTAINING QUESTION ID BITS
2572 ; SKIP RETURNS IF MUMBLER FOUND, WITH QOFF SET AND D POINTING TO GOOD BLOCK
2573
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?
2578          JRST   QFWIN
2579         AOBJN   QOFF,QFLOOP     ; NO. CONTINUE
2580         POPJ    P,
2581
2582 QFWIN:  MOVE    D,A             ; YES. SET D PROPERLY
2583         ADDI    D,(QOFF)
2584         JRST    POPJ1
2585
2586 ; PUSHJ P,NAMMAK:
2587 ; TAKES TALSNM, CONSES STRING (LIVES IN TALSTR AND TALSTR+1) AND LENGTH (TALSLN) FOR
2588 ; THAT SNAME
2589 NAMMAK: PUSH    P,A
2590         PUSH    P,B
2591         PUSH    P,C
2592         MOVEI   O,                      ; FOR LENGTH OF FROB
2593         MOVE    A,[440600,,TALSNM]
2594         MOVE    B,[440700,,TALSTR]      ; BYTE POINTERS
2595         MOVEI   C,"-
2596         IDPB    C,B
2597         ADDI    O,1                     ; PRECEDE WITH -
2598 NAMLOP: ILDB    C,A                     ; GET CHAR
2599         JUMPE   C,NAMDON
2600         AOJ     O,                      ; AOS COUNT
2601         ADDI    C,40                    ; MAKE INTO ASCII
2602         IDPB    C,B
2603         CAIGE   O,7
2604          JRST   NAMLOP                  ; NOT DONE YET
2605 NAMDON: ADDI    O,1                     ; SO WILL GET ASCIZ
2606         MOVEM   O,TALSLN                ; SAVE AWAY LENGTH
2607         MOVEI   C,0
2608         IDPB    C,B
2609         POP     P,C
2610         POP     P,B
2611 POPAJ:  POP     P,A
2612         POPJ    P,
2613
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
2619 NAMUNQ: PUSH    P,A
2620         PUSH    P,B
2621         PUSH    P,C
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?
2638         MOVNS   A
2639         IDIVI   A,5             ; HOW MANY WORDS?
2640         JUMPE   B,NAMTW1        ; HACK REMAINDER
2641         ADDI    A,1
2642 NAMTW1: ADDI    A,(D)           ; NUMBER OF WORDS NEEDED FOR NEW NAME
2643         PUSHJ   P,IBLOCK        ; GET CORE
2644         MOVE    B,A
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]
2655         MOVE    C,TALSLN
2656 NAMBLP: ILDB    O,B             ; GET CHAR
2657         IDPB    O,A             ; STUFF IT IN
2658         SOJG    C,NAMBLP        ; DONE?
2659         POP     P,C
2660         POP     P,B
2661         POP     P,A
2662         POPJ    P,
2663
2664 ; JSP RET,NEWTYP
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)
2667
2668 NEWTYP: INTOFF
2669         MOVE    B,UTYPLN
2670         HLRE    A,B
2671         SUBM    B,A
2672         POP     P,(A)           ; POP LOC. OF BLOCK INTO TABLE
2673         POP     P,D
2674         HRLM    D,(A)           ; MOVE LOC. OF NAME INTO TABLE
2675         SUB     B,[1,,0]
2676         MOVEM   B,UTYPLN
2677         MOVE    B,TYPLEN
2678         SUB     B,[1,,0]
2679         MOVEM   B,TYPLEN
2680         INTON
2681         JRST    @RET
2682
2683 IFE ITS,[
2684 XTALNM: GJ%OLD
2685         .NULIO,,.NULIO
2686         -1,,[ASCIZ /DSK/]
2687         0
2688         -1,,[ASCIZ /COMBAT/]
2689         -1,,[ASCIZ /TAILOR/]
2690         0
2691         0
2692         0
2693         0
2694 ]
2695 ; PUSHJ P,PRTAIL
2696 ; PRTAIL PRINTS OUT THE TAILOR INFO TO A FILE
2697 ; ALWAYS RETURNS WITHOUT SKIPPING
2698
2699 PRTAIL:
2700 IFN ITS,[
2701         .CALL   TALOPO
2702 ]
2703 IFE ITS,[
2704         MOVSI   A,(GJ%FOU+GJ%SHT)
2705         HRROI   B,[ASCIZ /COMBAT.TAILOR/]
2706         GTJFN
2707          JRST   PRTLER
2708         MOVEM   A,DSKJFN
2709         MOVE    B,[440000,,OF%WR]
2710         OPENF
2711 ]
2712 PRTLER:  JRST   [PUSH   P,[OPNFAL]
2713                  JRST   ERRPRT]         ; PRINT ERROR
2714         SKIPL   A,UTYPLN
2715          JRST   PRTLDN          ; EMPTY TABLE ==> LEAVE
2716         INTOFF
2717 PRLOOP: PUSH    P,A             ; SAVE POINTER TO UTYPTB
2718         PUSHJ   P,CLINBF
2719         MOVEI   F,INPBUF+2
2720         HLRZ    B,(A)           ; POINTER TO NAME
2721         PUSH    P,B
2722         HRLI    B,440700
2723         SETZ    D,
2724 PRCNT:  ILDB    C,B
2725         JUMPE   C,PRTAL1
2726         AOJA    D,PRCNT
2727 PRTAL1: IDIVI   D,5             ; CALCULATE WORDS FOR NAME
2728         ADDI    D,1
2729         POP     P,B
2730         HRLS    B
2731         HRR     B,F
2732         PUSH    P,D
2733         ADDB    D,F             ; UPDATE BLOCK POINTER IN F
2734         BLT     B,-1(D)         ; BLT NAME INTO BLOCK
2735         HRLZ    B,(A)
2736         ADD     B,[-LNALEN,,0]  ; POINT TO REAL BEGINNING OF BLOCK
2737         HRR     B,F
2738         BLT     B,CMPLEN-1(F)   ; BLT THE COMBLK INTO F
2739         PUSH    P,A
2740         PUSH    P,B
2741         PUSH    P,C
2742         PUSH    P,D
2743         HRLZ    A,(F)           ; # LINKS
2744         JUMPE   A,PRLNKO
2745         HRRI    A,1(F)          ; AOBJN POINTER TO LINKS
2746 PRLNK1: MOVE    B,UTYPLN
2747         MOVEI   C,0
2748         MOVE    D,(A)           ; PICK UP POINTER TO TYPE FROM LINK AREA
2749 PRLNKL: CAMN    D,(B)           ; COMPARE WITH POINTER IN TYPE TABLE
2750          JRST   [MOVEM  C,(A)
2751                  JRST   PRLNKE] ; SAVE RELATIVE OFFSET IN BLOCK, GO TO NEXT LINK
2752         ADDI    C,1
2753         AOBJN   B,PRLNKL        ; TRY NEXT TYPE IN TABLE
2754 IFN ITS,[
2755         .VALUE                  ; THIS CAN'T HAPPEN
2756 ]
2757 IFE ITS,[
2758         HALTF
2759 ]
2760 PRLNKE: AOBJN   A,PRLNK1        ; NEXT LINK
2761 PRLNKO: POP     P,D
2762         POP     P,C
2763         POP     P,B
2764         POP     P,A
2765         PUSH    P,F
2766         ADDI    F,LNALEN
2767         MOVE    C,F             ; START OF COPY OF COMBLK
2768         ADDI    F,CMPSIZ        ; AND UPDATE BLOCK POINTER
2769         MOVSI   QOFF,QNUM
2770         MOVEI   E,CMPSIZ        ; COUNTER OF OFFSETS
2771 PRLOP1: MOVE    B,QTABLE(QOFF)
2772         JUMPE   B,PREND2
2773         TLNE    B,$TSYMBOL
2774          JRST   PREND1
2775         HRLZ    D,(C)
2776         JUMPE   D,PREND1
2777         TLNE    B,$TFILE
2778          JRST   [MOVEI B,FSPSIZP
2779                  JRST PRCOPY]
2780         LDB     B,[%TPLEN,,(C)]
2781 PRCOPY: PUSH    P,F
2782         MOVE    A,F
2783         ADDI    A,-1(B)
2784         HRR     D,F
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
2789         POP     P,A
2790         MOVE    B,QTABLE(QOFF)  ; DO FANCY UPDATE FOR FILE NAMES
2791         TLNE    B,$TFILE
2792          PUSHJ  P,PRFILE
2793 PREND1: AOJ     C,
2794         AOJA    QOFF,PRLOP1
2795 PREND2: POP     P,C
2796         SUB     C,F
2797         MOVNM   C,INPBUF+1
2798         POP     P,A             ; GET BACK NAME BLOCK LENGTH
2799         TLO     A,%NWFMT        ; ALWAYS NEW FORMAT NOW
2800         SKIPE   PR2SW
2801          TLO    A,%TVERB
2802         SKIPE   FILEXI
2803          TLO    A,%TFNEX
2804         SKIPE   NMORAS          ; GET ANSWERS TO ANOTHER COMPILATION
2805          TLO    A,%NMRAS
2806         SKIPE   MORANS
2807          TLO    A,%MRANS
2808         SKIPN   MUDVRB
2809          TLO    A,%MNVRB
2810         MOVE    RET,QVERS
2811         DPB     RET ,[220600,,A]
2812         MOVEM   A,INPBUF
2813         MOVEI   A,INPBUF
2814         SUB     A,F
2815         HRLZS   A
2816         HRRI    A,INPBUF        ; MAKE AOBJN POINTER TO INPBUF
2817 IFN ITS,[
2818         .IOT    DSKCHN,A
2819 ]
2820 IFE ITS,[
2821         PUSHJ   P,XIOT
2822          A
2823          JFCL
2824 ]
2825         POP     P,A
2826         AOBJN   A,PRLOOP
2827
2828 PRTLDN: INTON
2829 IFN ITS,[
2830         .CLOSE  DSKCHN,
2831 ]
2832 IFE ITS,[
2833         MOVE    A,DSKJFN
2834         CLOSF
2835          JFCL
2836 ]
2837         POPJ    P,
2838
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
2846         HRL     B,(A)
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
2851         ADD     F,B
2852 PRFLE:  AOBJN   A,PRFLP                 ; LOOP ON FILE NAMES
2853         POPJ    P,
2854
2855 \f
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
2858 ; TO %IGNOR,,0.
2859 CRTAIL: SETZM   ALTER           ; CLEAR ALTER FLAG
2860         MOVEI   A,[ASCIZ /Name of type /]       ; GET GROUP NAME
2861         MOVEM   A,PRMPT1
2862         MOVEI   A,LINPR2
2863         MOVEM   A,PRMPT2
2864         SETZM   CSYMTB
2865         MOVEI   OUTPTR,0
2866         PUSHJ   P,GETLIN
2867         JUMPE   C,CPOPJ
2868         PUSHJ   P,PRSINP
2869         PUSH    P,D             ; SAVE LOCATION OF NAME
2870         MOVEI   A,CMPLEN        ; GET FRESH BLOCK
2871         PUSHJ   P,IBLOCK
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
2876         MOVSI   B,%ASK+HOWLOC
2877         MOVEM   B,HOWLOC(A)
2878
2879 ; WANTS POINTER TO BLOCK AS TOP OF STACK.  CRTAIL & ALTGRP BOTH USE THIS.
2880
2881 CRLOPI: PUSH    BK,[0]
2882         PUSH    BK,[QDONXT]
2883         PUSH    BK,[[POPJ P,]]
2884         PUSH    BK,P
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 /]
2892                  JRST   .+1]
2893         MOVEM   B,PRMPT1
2894         MOVE    OUTPTR,(P)              ; POINTER TO BLOCK BEING HACKED
2895         PUSHJ   P,COMTYP
2896         TRZE    A,$SSMAL                ; SPECIAL TYPE?
2897          JRST   @CRSPEC(A)              ; GO HACK IT
2898         CAIN    A,HOWLOC                ; WAS IT HOW TO RUN?
2899          JRST   HOWTAL
2900         CAIN    A,MORLOC                ; WAS IT ANOTHER COMPILATION??
2901          JRST   MORC
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
2905         MOVEM   C,RVALS
2906         PUSH    BK,[0]
2907         PUSH    BK,[CRLOPR]
2908         PUSH    BK,[[POPJ P,]]
2909         PUSH    BK,P
2910 CTRRET: MOVE    C,QTABLE(QOFF)
2911         TLNE    C,$TTF                  ; TRUE/FALSE QUESTION
2912          JRST   CRTRF
2913         TLNE    C,$TFILE                ; FILE QUESTION
2914          JRST   [PUSHJ  P,CRFDEF
2915                  JRST   TLRASK]
2916         HRRZ    A,VTABLE (QOFF)         ; SET DEFAULT
2917         HRRM    A,(OUTPTR)
2918 TLRASK: HLLZ    A,QTABLE(QOFF)          ;CRETINISM
2919         PUSHJ   P,ASK1                  ; ASK QUESTION
2920          JRST   NOANS
2921 ; EXPECTS USER-SUPPLIED DEFAULT TO BE IN (OUTPTR), MAKES LH OF A BE RIGHT
2922 TLRSET: BKOFF
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
2926         SKIPE   SQDEF
2927          JRST   [TLO A,%ASK+%DSUP
2928                  BKOFF
2929                  JRST TLRST2]
2930         TLO     A,%IGNOR+%DSUP
2931 TLRST2: HLLM    A,(OUTPTR)
2932         JRST    CRLOOP
2933 ; HERE FROM CTRL-R.  RESTORE (OUTPTR) TO VALUE SAVED IN RVALS
2934 CRLOPR: CAIA
2935          JRST   CRLCTG
2936         MOVE    A,RVALS
2937         MOVEM   A,(OUTPTR)
2938         JRST    CRLOP1
2939 CRLCTG: MOVE    A,RVALS
2940         MOVEM   A,(OUTPTR)
2941         JRST    CTRRET                  ; GO HERE IF RETURNING FROM CTRL-G
2942
2943 CRFDEF: MOVEI   A,FSPSIZ                ; SETS UP SPACE FOR FILE NAME BEFORE ASKING
2944         PUSHJ   P,IBLOCK
2945         HRRM    A,(OUTPTR)
2946         POPJ    P,
2947
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
2953         CLINK           ; CREATE LINK
2954         DLINK           ; DELETE LINK
2955         XLINK           ; EXPAND LINK
2956         XXLINK          ; EXPAND ALL LINKS
2957         LSTLN1          ; LIST LINKS TO ME
2958         MYLIN1          ; LIST LINKS FROM ME
2959
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/]]
2963         PUSH    BK,[CRLOOP]
2964         PUSH    BK,[[POPJ P,]]
2965         PUSH    BK,P            ; SET UP ACTIVATION
2966         JRST    CRLOP1
2967
2968 ; PRINT CURRENT GROUP
2969 CPRTGP: OASCR   [0]
2970         PUSH    P,[CRLOOP]              ; RETURN ADDRESS FROM PRINTER (AN OBSCENITY)
2971         MOVE    CMPBLK,-1(P)            ; CURRENT TYPE
2972         PUSHJ   P,LINKX1
2973         PUSH    P,CMPBLK
2974         MOVE    F,[QNUM-1,,VTABLE]
2975         MOVEI   QOFF,QTABLE
2976         JRST    GRPPST
2977
2978 CRDONE: BKOFF
2979         SKIPE   ALTER                   ; IF IN ALTER, LET IT CLEAN UP
2980          JRST   ALTEND
2981 TALADD: JSP     RET,NEWTYP              ; GO TO ROUTINE TO ADD NEW TYPE
2982 TALOUT: PUSHJ   P,PRTAIL
2983         POPJ    P,
2984
2985 ; HACKERY FOR TAILORING TRUE/FALSE:  DEFAULT IS ASK, BUT LOSER CAN GIVE HIS OWN
2986
2987 CRTRF:  SETZM   PRMPT1
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
2993         HLL     A,QTABLE(QOFF)
2994         JRST    TLRSET
2995
2996 ; IF NO ANSWER GIVEN:  TURN ON %ASK
2997
2998 NOANS:  BKOFF
2999         SKIPE   SQDEF
3000          BKOFF
3001         HLLZ    A,QTABLE(QOFF)
3002         HRR     A,VTABLE(QOFF)
3003         TLZ     A,777700
3004         TLO     A,%ASK
3005         MOVEM   A,(OUTPTR)
3006         MOVE    C,QTABLE(QOFF)
3007         TLNN    C,$TTF                  ; IF IT WAS T/F, DON'T NEED TO PRINT <ASK>
3008          OASC   ASKMSG
3009         JRST    CRLOOP
3010
3011 ; TAILOR HOW TO RUN
3012
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
3016         SETZM   PRMPT1
3017         JSP     RET,MAKACT
3018         PUSHJ   P,COMTYP
3019         BKOFF
3020         HRRES   A
3021         JUMPL   A,HOWRED                        ; SAID 'ASK' IF JUMPS
3022         HRLI    A,%IGNOR+%DSUP
3023         MOVEM   A,HOWLOC(OUTPTR)
3024         JRST    CRLOOP
3025 HOWRED: MOVSI   A,%ASK
3026         MOVEM   A,HOWLOC(OUTPTR)
3027         JRST    CRLOOP
3028
3029 ; TAILOR ANOTHER COMPILATION? QUESTION
3030 MORC:   SETZM   PRMPT1
3031         SETOM   RVALS
3032         MOVE    A,[MORLEN,,TMORTB]
3033         JSP     RET,MAKACT
3034         PUSHJ   P,COMTYP
3035         BKOFF
3036         HRRES   A                       ; WILL BE -1 IF SAID ASK
3037         JUMPGE  A,[HRLI A,%IGNOR+%DSUP
3038                    JRST MORCOT]
3039         MOVSI   A,%ASK
3040 MORCOT: MOVE    OUTPTR,(P)
3041         MOVEM   A,MORLOC(OUTPTR)
3042         JRST    CRLOOP
3043
3044 ; MAKE ACTIVATION--USED BY MORC,QDEL,&C.
3045 MAKACT: PUSH    BK,[[ASCIZ /Question/]]
3046         PUSH    BK,[CRLOOP]
3047         PUSH    BK,[[POPJ P,]]
3048         PUSH    BK,P
3049         JRST    (RET)
3050
3051 ; DELETE QUESTION FROM TAILOR FILE
3052 QDEL:   MOVE    A,[TAILEN+TAILSP,,TAILTB]
3053         SETZM   PRMPT1
3054         JSP     RET,MAKACT
3055         PUSHJ   P,COMTYP                ; GET QUESTION
3056         BKOFF
3057         CAIN    A,HOWLOC                ; IF HOW TO RUN, DEFAULT IS %ASK
3058          JRST   [TLZ    A,777700
3059                  TLO    A,%ASK
3060                  MOVE   OUTPTR,(P)
3061                  MOVEM  A,HOWLOC (OUTPTR)
3062                  JRST   CRLOOP]
3063         MOVE    OUTPTR,(P)
3064         ADD     OUTPTR,A
3065         MOVE    B,QTABLE(A)
3066         MOVE    A,(OUTPTR)
3067         TLNE    B,%ESSEN
3068          HLLZS  A
3069         TLZ     A,777700
3070         TLO     A,%IGNOR
3071         MOVEM   A,(OUTPTR)
3072         JRST    CRLOOP
3073
3074 \f
3075 ; GET USER COMPILATION TYPE
3076 GETTYP: MOVEI   B,[ASCIZ /Named /]
3077 GETTP1: MOVEM   B,PRMPT1                        ; ENTRY FOR FUNNY PROMPTS
3078         PUSH    P,C
3079         MOVE    A,UTYPLN
3080         TLNE    A,-1
3081          JRST   ARESOM
3082         OASCR   [ASCIZ /No compilation types defined./]
3083         POP     P,C
3084         POPJ    P,
3085 ARESOM: PUSHJ   P,COMTYP                        ; GET POINTER TO GROUP'S CMPBLK
3086         OASCR   [0]
3087         POP     P,C
3088         JRST    POPJ1
3089
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
3093          POPJ   P,
3094         PUSHJ   P,FNDLNK                        ; GET LINKS
3095         SKIPN   B,LNKTPT                        ; ANY HERE?
3096          JRST   DELGR1                          ; NO, GO DO DELETE
3097         PUSH    P,SMVAL
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) /]
3102         MOVEM   A,PRMPT1
3103         MOVE    A,[TFTLEN,,TFTBL]
3104         PUSHJ   P,COMTYP
3105         JUMPE   A,[POP  P,SMVAL
3106                    POPJ P,]
3107         MOVE    B,LNKTPT
3108 DELLOP: MOVE    CMPBLK,1(B)
3109         HRRZ    A,(B)
3110         PUSHJ   P,LNKDEL
3111         ADD     B,[2,,2]
3112         JUMPL   B,DELLOP
3113         POP     P,SMVAL
3114 DELGR1: MOVE    A,SMVAL
3115         HRRZ    B,A
3116         HRLS    B
3117         ADD     B,[1,,0]
3118         HLRE    C,A
3119         SUBM    A,C
3120         BLT     B,-1(C)
3121         MOVE    A,[1,,0]
3122         ADDM    A,UTYPLN
3123         ADDM    A,TYPLEN
3124         PUSHJ   P,PRTAIL
3125         POPJ    P,
3126 \f
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
3131          POPJ   P,
3132         MOVEM   A,ALTER
3133         PUSH    P,A
3134         MOVE    E,A
3135         PUSHJ   P,GETCOP                ; COPY WILL BE IN A
3136         PUSH    P,A                     ; SAVE IT
3137         JRST    CRLOPI
3138 ALTEND: POP     P,D                     ; NEW BLOCK
3139         POP     P,A                     ; GET OLD BLOCK
3140         MOVEI   B,UTYPTB                ; GET USER TYPE TABLE
3141 ALTLOP: HRRZ    C,(B)
3142         CAME    A,C                     ; IS THIS IT?
3143          AOJA   B,ALTLOP
3144         HRRM    D,(B)                   ; STUFF IT IN
3145         MOVE    A,ALTER
3146         SETZM   ALTER
3147         PUSHJ   P,FNDLNK                ; GET EVERYBODY WHO POINTS TO ME
3148         SKIPN   A,LNKTPT
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
3153         AOBJN   A,ALTLP1
3154         JRST    TALOUT                  ; PRINT OUT NEW TAILOR
3155 \f
3156 ; XEROX COPIES A GROUP FROM X TO [NEW] GROUP Y.  DUE TO JMB, CHOMP.
3157 XEROX:  PUSHJ   P,GETTYP                ; GET OLD GROUP
3158          POPJ   P,
3159         MOVE    E,A                     ; OLD GROUP IS IN E
3160         MOVEI   O,[ASCIZ /To (new type) /]
3161         MOVEM   O,PRMPT1
3162         MOVEI   O,LINPR2
3163         MOVEM   O,PRMPT2
3164         SETZM   CSYMTB
3165         MOVEI   OUTPTR,0
3166         PUSHJ   P,GETLIN                ; GET NAME OF NEW GROUP
3167         JUMPE   C,CPOPJ
3168         PUSHJ   P,PRSINP                ; NAME IS IN D
3169         PUSHJ   P,GETCOP                ; NEW GROUP SHOULD COME OUT IN A, OLD IS IN E
3170         PUSH    P,D
3171         PUSH    P,A
3172         JRST    TALADD                  ; ADD IT AND DUMP OUT
3173
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
3177          POPJ   P,
3178         PUSH    P,A                     ; POINTER TO TYPE
3179         PUSH    P,SMVAL                 ; POINTER TO SLOT IN TABLE
3180         MOVEI   A,[ASCIZ /To (new name) /]
3181         MOVEM   A,PRMPT1
3182         MOVEI   A,LINPR2
3183         MOVEM   A,PRMPT2
3184         SETZM   CSYMTB
3185         MOVEI   OUTPTR,0
3186         PUSHJ   P,GETLIN                ; GET NEW NAME
3187         JUMPE   C,CPOPJ
3188         PUSHJ   P,PRSINP                ; NAME IS IN D
3189         POP     P,A
3190         HRLM    D,(A)                   ; CHANGE NAME IN TABLE
3191         POP     P,A
3192         PUSHJ   P,FNDLNK                ; GET TABLE OF LINKS TO ME
3193         SKIPN   A,LNKTPT
3194          JRST   TALOUT                  ; DUMP TAILOR--NO LINKS
3195 RNMLOP: MOVE    B,(A)                   ; PICK UP POINTER TO SLOT
3196         HRLM    D,(B)                   ; CLOBBER NAME
3197         AOBJN   A,RNMLOP
3198         JRST    TALOUT                  ; AND DUMP TAILOR
3199
3200 ; HERE TO PRINT COMPILE TYPES FOR USER'S INFORMATION
3201
3202 PRTGRP: PUSHJ   P,GETTYP
3203          POPJ   P,
3204         MOVE    CMPBLK,A
3205         PUSHJ   P,LINKX1
3206         PUSH    P,CMPBLK
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!)
3213 GRPPST: PUSH    BK,[0]
3214         PUSH    BK,[PRAOUT]                     ; MAKE ACTIVATION TO GET OUT
3215         PUSH    BK,[[POPJ P,]]
3216         PUSH    BK,P
3217         SETOM   LONGOT
3218         PUSH    P,D
3219         PUSH    P,H
3220 GRPPLP: MOVE    B,(CMPBLK)
3221         TLNE    B,%ASK                          ; DID HE SAY TO ASK?
3222          JRST   PRASK
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?
3227          OASCI  "*
3228         OASC    (C)
3229         OHPOS   20.
3230 DEFPRT: TLNE    C,$TFILE                        ; FILE SPEC?
3231          JRST   PFSPEC
3232         TLNE    C,$TTF                          ; TRUE/FALSE?
3233          JRST   PTF
3234 PATOM:  OASC    (B)                             ; PRINT WHAT'S THERE
3235 ENDPR:  SKIPN   D,H
3236          JRST   ENDPR1
3237         SKIPN   D,(D)
3238          JRST   ENDPR1
3239         OASC    [ASCIZ /   {/]
3240         OASC    (D)
3241         OASCI   "}
3242 ENDPR1: OASCR   [0]
3243 ENDPR2: AOBJN   F,MNGACS                        ; DONE?
3244         POP     P,H
3245         POP     P,D
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/]
3250         OHPOS   20.
3251         MOVE    A,HOWLOC(CMPBLK)
3252         TLNE    A,%ASK
3253          JRST   [OASCR  ASKMSG
3254                  JRST   PRMORE]
3255         HLRZ    A,HOWTBL+1(A)
3256         OASC    (A)
3257         SKIPE   A,HOWLOC(H)
3258          JRST   [OASC   [ASCIZ /   {/]
3259                  OASC   (A)
3260                  OASCI  "}
3261                  JRST   .+1]
3262         OASCR   [0]
3263 PRMORE: OASC    [ASCIZ /Another compilation/]
3264         OHPOS   20.
3265         MOVE    A,MORLOC(CMPBLK)
3266         TLNN    A,%DSUP
3267          JRST   [OASCR  ASKMSG
3268                  JRST   PRDONE]
3269         OASC    $NO(A)
3270         SKIPE   A,HOWLOC(H)
3271          JRST   [OASC   [ASCIZ /   {/]
3272                  OASC   (A)
3273                  OASCI  "}
3274                  JRST   .+1]
3275 PRDONE: OASCR   [0]
3276         SETZM   LONGOT
3277         BKOFF
3278         POPJ    P,
3279 PRAOUT: POP     P,CMPBLK
3280         POPJ    P,
3281 MNGACS: ADDI    CMPBLK,1
3282         ADDI    QOFF,1
3283         JUMPE   H,GRPPLP
3284         AOJA    H,GRPPLP
3285
3286 ; PRINT FILE SPEC WHEN DEFAULT SUPPLIED
3287 PFSPEC: PUSH    P,A
3288         PUSH    P,C
3289         MOVEI   C,CHRTBL
3290         HRLI    B,-FSPSIZ
3291 PFSLP:  SKIPN   A,(B)
3292          JRST   PFS1
3293         SPNAM1  A
3294          JRST   [PUSHJ P,CXPRT
3295                  JRST PFS2]
3296         OASC    (A)
3297         SKIPE   1(B)
3298 PFS2:    OASC   (C)
3299 PFS1:   AOJ     C,
3300         AOBJN   B,PFSLP
3301         POP     P,C
3302         POP     P,A
3303         JRST    ENDPR
3304
3305 CXPRT:  MOVE    A,SSSPPP
3306         CAIE    A,1
3307          JRST   CXPRT1
3308         OASCI   ^X
3309         POPJ    P,
3310
3311 CXPRT1: OASCI   ^Y
3312         POPJ    P,
3313
3314 ; PRINT TRUE/FALSE TYPE QUESTION
3315 PTF:    OASC    $NO(B)
3316         JRST    ENDPR
3317 $NO:    ASCIZ   /No/
3318 $YES:   ASCIZ   /Yes/
3319
3320 ASKMSG: ASCIZ   /<ASK>/
3321 PRASK:  MOVE    C,(QOFF)
3322         TLNE    C,%GIGNO
3323          OASCI  "*
3324         OASC    (C)
3325         OHPOS   20.
3326         OASC    ASKMSG
3327         TLNE    B,%DSUP         ; DEFAULT SUPPLIED?
3328          JRST   [OASC [ASCIZ /:  /]
3329                  JRST DEFPRT]
3330         JRST    ENDPR
3331
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.
3336         SETOM   FILEXP
3337         PUSHJ   P,ASK           ; GO GET FILE NAME
3338          JRST   DRPOUT
3339 IFN ITS,[
3340         MOVE    O,SNAME
3341 ]
3342 IFE ITS,[
3343         MOVE    O,(OUTPTR)
3344 ]
3345         MOVEM   O,SYSDIR        ; RESTORE SYSTEM DEFAULTS
3346         CAME    O,TALSNM
3347          SETOM  NODUMP
3348         SETOM   LDFLAG
3349
3350 IFN ITS,[
3351         MOVEI   B,TALDV
3352         MOVE    A,(B)
3353         PUSHJ   P,ASCSIX
3354         MOVEM   A,TALDEV
3355         MOVE    A,1(B)
3356         PUSHJ   P,ASCSIX
3357         MOVEM   A,TALSNM
3358         MOVE    A,2(B)
3359         PUSHJ   P,ASCSIX
3360         MOVEM   A,TALFN1
3361         MOVE    A,3(B)
3362         PUSHJ   P,ASCSIX
3363         MOVEM   A,TALFN2
3364 ]
3365
3366 IFE ITS,[
3367         MOVE    A,TALDV
3368         HRROM   A,XTALNM+.GJDEV
3369         MOVE    A,TALDV+1
3370         HRROM   A,XTALNM+.GJDIR
3371         MOVE    A,TALDV+2
3372         HRROM   A,XTALNM+.GJNAM
3373         MOVE    A,TALDV+3
3374         HRROM   A,XTALNM+.GJEXT
3375 ]
3376         PUSHJ   P,LDTAIL        ; LOAD NEW FILE
3377         SETZM   NODUMP
3378         POPJ    P,
3379 ; REPLACE TAILOR.  JUST LIKE ABOVE, EXCEPT CLOBBERS CURRENT USER TYPE TABLES
3380 ; FIRST
3381 RPTAIL: SETO    QOFF,
3382         MOVEI   OUTPTR,TALPTR
3383         SETOM   FILEXP          ; WANT FULLY-SPECIFIED FILE NAMES
3384         PUSHJ   P,ASK
3385          JRST   DRPOUT
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
3389         ADDM    A,UTYPLN
3390         MOVE    O,SNAME
3391         MOVEM   O,SYSDIR        ; RESTORE SYSTEM DEFAULTS
3392         CAME    O,TALSNM
3393          SETOM  NODUMP
3394         SETZM   LDFLAG          ; DON'T NEED TO UNIQIFY NAMES
3395         PUSHJ   P,LDTAIL        ; LOAD NEW FILE
3396         SETZM   NODUMP
3397         POPJ    P,
3398
3399 ; COME HERE IF LOSER REFUSED TO GIVE FILE NAME.
3400
3401 DRPOUT: IFE ITS,MOVEI   TALDV
3402         IFN ITS,MOVEI   TALDEV
3403         HRRM    TALPTR
3404         OASCR   [ASCIZ /Aborted?/]
3405         POPJ    P,
3406
3407 \f
3408 SUBTTL  LINK HACKERS
3409
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.
3414
3415 LINKX1: CAIG    CMPBLK,MUMBLE           ; USER TYPES WILL BE ABOVE MUMBLE
3416          POPJ   P,
3417         SKIPN   LNKHDR(CMPBLK)          ; ANY LINKS?
3418          JRST   [MOVEI  H,0
3419                  POPJ   P,]             ; NO
3420         PUSH    P,A
3421         MOVEI   A,CMPSIZ
3422         PUSHJ   P,IBLOCK
3423         MOVE    H,A
3424         JRST    LINKX2
3425 LINKX:  MOVEI   H,0
3426         CAIG    CMPBLK,MUMBLE
3427          POPJ   P,
3428         PUSH    P,A
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
3434         HRLI    B,(A)
3435         MOVEI   A,CMPSIZ
3436         PUSHJ   P,IBLOCK
3437         HRLI    C,(CMPBLK)
3438         HRRI    C,(A)
3439         BLT     C,CMPSIZ-1(A)
3440 LINKXL: MOVE    C,(B)                   ; GET POINTER TO LINK TYPE
3441         PUSHJ   P,EXPAND                ; EXPAND IT
3442         AOBJN   B,LINKXL
3443         MOVE    CMPBLK,A
3444         POP     P,C
3445         POP     P,B
3446         POP     P,A
3447         POPJ    P,
3448
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.
3451 EXPAND: PUSH    P,A
3452         PUSH    P,B
3453         PUSH    P,C
3454         PUSH    P,D
3455         PUSH    P,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
3460         MOVE    B,(C)
3461         TLNN    B,%DSUP+%ASK            ; SOMETHING IN LINK TYPE?
3462          JRST   EXLOPE
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?
3467         ADDI    C,1
3468         JUMPE   H,EXLOOP
3469         AOJA    H,EXLOOP                ; UPDATE POINTERS, LOOP AGAIN
3470 EXPOUT: POP     P,H
3471         POP     P,D
3472         POP     P,C
3473         POP     P,B
3474         POP     P,A
3475         POPJ    P,
3476 \f
3477 ; COME HERE FROM TAILOR LOOP TO CREATE LINK.  GET TYPE FROM USER, STUFF
3478 ; IT INTO LINK AREA OF CURRENT GROUP.
3479
3480 CLINK:  PUSH    P,A
3481         PUSH    P,B
3482         PUSH    P,C
3483         PUSH    P,D
3484         MOVE    C,OUTPTR
3485         PUSHJ   P,GETTYP                ; GET TYPE IN A
3486          JRST   CLINKO
3487         SKIPN   B,ALTER                 ; IN ALTER GROUP?
3488          JRST   CLINK1
3489         CAMN    A,B                     ; LINKING TO SELF?
3490          JRST   [OASCR  [ASCIZ /Can't link group to self./]
3491                  JRST   CLINKO]
3492 CLINK1: HRLZ    B,LNKHDR(C)
3493         JUMPE   B,CLINKW
3494         HRRI    B,LNKHDR+1(C)
3495 CLINKC: HRRZ    D,(B)
3496         CAIN    D,(A)                   ; SAME TYPE?
3497          JRST   [OASCR  [ASCIZ /Already linked./]
3498                  JRST   CLINKO]
3499         AOBJN   B,CLINKC
3500         MOVN    B,LNKHDR(C)             ; GET # OF LINKS ALREADY HERE
3501         CAIL    B,LNKCNT
3502          JRST   [OASCR  [ASCIZ /Link area full./]
3503                  JRST   CLINKO]
3504 CLINKW: PUSHJ   P,GETNAM                ; TURN TYPE (IN A) INTO NAME,,TYPE
3505         ADDI    B,1
3506         MOVNM   B,LNKHDR(C)             ; SAVE - THE COUNT AWAY
3507         ADDI    B,LNKHDR(C)             ; SLOT TO CLOBBER
3508         MOVEM   A,(B)                   ; SAVE LINK AWAY
3509 CLINKO: POP     P,D
3510         POP     P,C
3511         POP     P,B
3512         POP     P,A
3513         JRST    CRLOOP                  ; BACK INTO LOOP
3514 \f
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).
3517
3518 DLINK:  PUSH    P,A
3519         MOVE    CMPBLK,OUTPTR
3520         PUSHJ   P,LNKGET                ; GET POINTER TO LINK SLOT AFFECTED, IN A
3521          JRST   DLINKO                  ; OH, WELL
3522         PUSHJ   P,LNKDEL                ; DO DELETION
3523 DLINKO: POP     P,A
3524         JRST    CRLOOP
3525
3526 ; COME HERE TO DELETE LINK IN SLOT POINTED AT BY A FROM BLOCK IN CMPBLK
3527 LNKDEL: PUSH    P,B
3528         PUSH    P,C
3529         PUSH    P,D
3530         MOVN    B,LNKHDR(CMPBLK)        ; NUMBER OF LINKS
3531         MOVEI   C,(A)
3532         SUBI    C,LNKHDR(CMPBLK)
3533         CAIN    C,(B)                   ; LAST LINK IN BLOCK?
3534          JRST   LNKDLO
3535         HRRI    C,(A)
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
3540 POPDCB: POP     P,D
3541         POP     P,C
3542         POP     P,B
3543         POPJ    P,
3544 \f
3545 ; COME HERE TO EXPAND LINK IN TAILORING.  XLINK DOES A SINGLE LINK,
3546 ; XXLINK DOES ALL LINKS.
3547 XLINK:  PUSH    P,A
3548         PUSH    P,B
3549         PUSH    P,C
3550         MOVE    CMPBLK,OUTPTR
3551         PUSHJ   P,LNKGET                ; GET POINTER TO SLOT IN A
3552          JRST   XLINKO                  ; NOTHING TO FROB
3553         HRRZ    C,(A)                   ; PUT IT IN C
3554         PUSH    P,A
3555         MOVE    A,OUTPTR
3556         PUSHJ   P,EXPAND                ; DO EXPANSION
3557         POP     P,A
3558         PUSHJ   P,LNKDEL                ; DELETE LINK FROM BLOCK, SINCE IT'S EXPANDED
3559 XLINKO: POP     P,C
3560         POP     P,B
3561         POP     P,A
3562         JRST    CRLOOP
3563
3564 XXLINK: PUSH    P,A
3565         PUSH    P,B
3566         PUSH    P,C
3567         HRLZ    B,LNKHDR(OUTPTR)        ; GET COUNT
3568         JUMPE   B,XLINKO
3569         HRRI    B,LNKHDR+1(OUTPTR)      ; AOBJN POINTER
3570         MOVE    A,OUTPTR
3571 XXLNLP: HRRZ    C,(B)
3572         PUSHJ   P,EXPAND
3573         AOBJN   B,XXLNLP
3574         SETZM   LNKHDR(A)               ; ZERO COUNT
3575         HRLI    B,LNKHDR(A)
3576         HRRI    B,LNKHDR+1(A)
3577         BLT     B,-1(A)                 ; ZERO ALL POINTERS
3578         JRST    XLINKO                  ; AND LEAVE
3579 \f
3580 ; MAKE A COPY OF A BLOCK, WITH LINKS.  RETURN COPY IN A, BLOCK TO BE COPIED
3581 ; IS IN E.
3582
3583 GETCOP: PUSH    P,B
3584         PUSH    P,C
3585         MOVEI   A,CMPLEN
3586         PUSHJ   P,IBLOCK
3587         MOVEI   B,LNKHDR(E)             ; POINTER TO BEGINNING OF OLD BLOCK
3588         HRL     C,B
3589         HRR     C,A
3590         BLT     C,CMPLEN-1(A)
3591         ADDI    A,LNALEN                ; UPDATE POINTER TO NEW BLOCK
3592         POP     P,C
3593         POP     P,B
3594         POPJ    P,
3595
3596 ; GIVEN POINTER TO TYPE IN A, RETURN IN A NAME,,TYPE.
3597 GETNAM: PUSH    P,B
3598         PUSH    P,C
3599         MOVE    B,UTYPLN
3600 GETNLP: HRRZ    C,(B)
3601         CAIE    A,(C)
3602          AOBJN  B,GETNLP                ; MUST SUCCEED EVENTUALLY
3603         MOVE    A,(B)
3604         POP     P,C
3605         POP     P,B
3606         POPJ    P,
3607
3608 ; GET POINTER TO SLOT IN LINK AREA WE WANT TO PLAY WITH.  SKIPS IF WINS.
3609 LNKGET: PUSH    P,B
3610         PUSH    P,C
3611         PUSH    P,D
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)
3616         PUSH    P,A
3617         MOVEI   B,[ASCIZ /Named /]
3618         MOVEM   B,PRMPT1
3619         PUSHJ   P,COMTYP                ; GET TYPE
3620         OASCR   [0]
3621         POP     P,B
3622 LNKGLP: HRRZ    C,(B)                   ; SEARCH FOR SLOT
3623         CAIE    C,(A)
3624          AOBJN  B,LNKGLP
3625         MOVE    A,B
3626         AOS     -3(P)
3627         JRST    POPDCB
3628 \f
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
3632 ;         POINTER TO TYPE
3633 ; THIS IS USED FOR THE 'LINKS?' COMMAND, FOR DELETE TYPE, RENAME TYPE,
3634 ; AND ALTER TYPE (TO DO SUBSTITUTES).  TYPE IS IN A.
3635 FNDLNK: PUSH    P,B
3636         PUSH    P,C
3637         PUSH    P,D
3638         PUSH    P,E
3639         PUSH    P,F
3640         MOVEI   B,LNKTAB                ; BUILD A SORT OF AOBJN POINTER
3641         MOVE    F,UTYPLN                ; POINTER TO USER TYPES
3642         TLNN    F,-1
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
3646         JUMPE   D,FNDLPE
3647         HRRI    D,LNKHDR+1(C)           ; AOBJN POINTER TO LINKS
3648 FNDIN1: HRRZ    E,(D)
3649         CAIE    A,(E)
3650          JRST   FNDINL
3651         HLL     D,C                     ; STUFF POINTER TO NAME IN LH
3652         MOVEM   D,(B)                   ; SAVE IN LNKTAB
3653         HRRZM   C,1(B)                  ; SAVE TYPE
3654         ADD     B,[2,,2]
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?
3659          JRST   [SETZM  LNKTPT
3660                  JRST   FNDDON]
3661         HLRZS   B
3662         MOVNS   B
3663         HRLZS   B
3664         HRRI    B,LNKTAB
3665         MOVEM   B,LNKTPT
3666 FNDDON: POP     P,F
3667         POP     P,E
3668         JRST    POPDCB
3669 \f
3670 ; LSTLNK PRINTS ALL TYPES LINKED TO A TYPE OBTAINED FROM THE USER.
3671 LSTLNK: PUSH    P,A
3672         PUSHJ   P,GETTYP
3673          JRST   POPAJ
3674         PUSHJ   P,FNDLNK                ; GET ALL LINKS
3675         PUSHJ   P,LNKPRT
3676         JRST    POPAJ
3677
3678 ; SAME FOR CALL FROM ALTER GROUP
3679 LSTLN1: PUSH    P,A
3680         OASCR   [0]
3681         SKIPN   A,ALTER
3682          JRST   [OASCR [ASCIZ /No links/]
3683                  JRST   LSTLNO]
3684         PUSHJ   P,FNDLNK
3685         PUSHJ   P,LNKPRT
3686 LSTLNO: POP     P,A
3687         JRST    CRLOOP
3688
3689 ; PUSHJ P HERE AFTER CALL TO FNDLNK TO PRINT NAMES OF ALL LINKS IN LNKTAB
3690 LNKPRT: PUSH    P,A
3691         SKIPN   A,LNKTPT
3692          JRST   [OASCR  [ASCIZ /No links/]
3693                  JRST   POPAJ]
3694         PUSH    P,B
3695         PUSH    BK,[0]
3696         PUSH    BK,[LNKPRO]
3697         PUSH    BK,[[POPJ P,]]
3698         PUSH    BK,P
3699         SETOM   LONGOT
3700 LNKPRL: HLRZ    B,(A)
3701         OASCR   (B)
3702         ADD     A,[2,,2]
3703         JUMPL   A,LNKPRL
3704         SETZM   LONGOT
3705         BKOFF
3706 LNKPRO: POP     P,B
3707         JRST    POPAJ
3708
3709 ; TYPE OF COMPILATION:  EVERYBODY I'M LINKED TO
3710 MYLINK: PUSHJ   P,GETTYP
3711          POPJ   P,
3712         PUSHJ   P,MYLNKP                ; TAKES ARG IN A
3713         POPJ    P,
3714
3715 MYLNKP: PUSH    P,B
3716         PUSH    P,C
3717         HRLZ    B,LNKHDR(A)
3718         JUMPE   B,[OASCR [ASCIZ /No links/]
3719                    JRST MYLNKO]
3720         HRRI    B,LNKHDR+1(A)
3721         PUSH    BK,[0]
3722         PUSH    BK,[MYLNKO]
3723         PUSH    BK,[[POPJ P,]]
3724         PUSH    BK,P
3725         SETOM   LONGOT
3726         OASCR   [ASCIZ  /Links to:/]
3727 MYLNKL: HLRZ    C,(B)
3728         OASCR   (C)
3729         AOBJN   B,MYLNKL
3730         SETZM   LONGOT
3731         BKOFF
3732 MYLNKO: POP     P,C
3733         POP     P,B
3734         POPJ    P,
3735
3736 ; COME HERE FROM ALTER GROUP TO DO SAME
3737 MYLIN1: MOVE    A,OUTPTR
3738         PUSHJ   P,MYLNKP
3739         JRST    CRLOOP
3740 \f
3741 SUBTTL  TABLES: QUESTIONS, OUTPUT, HOW TO RUN, &C.
3742 ; TYPE CODES,,QUESTION LOCATION
3743
3744 TALPTR: TALDV
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
3774
3775 CRETQ=63.               ; 'NULL QUESTION', USED SOMEWHERE
3776 \f
3777 SUBTTL  QUESTION TREE
3778 ; FORMAT:  THISQ:  QUESTION OFFSET OR -1 (-1-->NOT REALLY A QUESTION)
3779 ;          FORKS:  YES,,NO
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]
3784
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
3817
3818
3819
3820 \f
3821 SUBTTL  MORE TABLES
3822 ; SPECIFIES OUTPUT ORDER:  TYPE,,LEADING IN FIRST WORD, OFFSET INTO OUTPUT,,TRAILING
3823 ; IN SECOND
3824
3825 $OT.FF==0
3826 $OT.FT==1
3827 $OFNAM==2
3828 $OFORM==3
3829 $OSTRG==4
3830 $OREDO==5
3831 $OSNAM==6               ; OUTPUT <SNAME "FOO">
3832
3833 ; OUTPUT SPECIFICATIONS
3834 ; TYPE,OFFSET,HEADER,TRAILER
3835
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
3860         0
3861         0
3862
3863 OUTTBL: -2*CMPSIZ,,OUTSPC
3864
3865 CR:     ASCIZ   /
3866 /
3867 CANGLB: ASCIZ   />
3868 /
3869 CLIST:  ASCIZ   /)>
3870 /
3871 CSTRNG: ASCIZ   /">
3872 /
3873 \f
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
3876 ; SPECIALS.
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?
3898 ITYPLE==TYPTBL-.
3899 UTYPTB: BLOCK   80.                             ;SPACE FOR USER-DEFINED TYPES
3900 UTYPLN: UTYPTB
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
3905
3906 ; TABLE FOR HOW-TO-RUN.  FIRST ELEMENT IS USED IN TAILOR-MAKING, SO DEFAULT
3907 ; THERE IS ASK.
3908
3909 HOWTLT: SYMVAL  <ASK>,-1
3910 IFN ITS,[
3911 HOWTBL: SYMVAL  Waste,.HWASTE
3912         SYMVAL  Combat,.HCOMBT
3913         SYMVAL  File,.HFILE
3914         SYMVAL  Pcomp,.HPCOMP
3915 ]
3916 IFE ITS,[
3917 HOWTBL: SYMVAL  Pcomp,.HPCOMP
3918         SYMVAL  Combat,.HCOMBT
3919         SYMVAL  File,.HFILE
3920 ]
3921
3922         SYMVAL  Many,.HMANY
3923         SYMVAL  Abort,.HABRT
3924         SYMVAL  Question,.HQUES
3925         SYMVAL  Type plan,.HPRIN
3926
3927 HOWTLN==HOWTBL-.
3928 HOWSPC==3               ; NUMBER OF THINGS AT END THAT CAN'T BE TAILORED
3929
3930 ; TABLE FOR TAILORING MORE COMPILATIONS? USED BY COMTYP, SO DEFAULT IS
3931 ; <ASK>.
3932 TMORTB: SYMVAL  <ASK>,-1
3933         SYMVAL  No,0
3934         SYMVAL  Yes,1
3935         SYMVAL  False,0
3936         SYMVAL  True,1
3937 MORLEN==TMORTB-.
3938 MORPMP: ASCIZ   /Another compilation?/
3939
3940 \f
3941 ;TABLE FOR VERBOSE COMPILATIONS
3942 VTABLE: %IGNOR,,0                                       ; SNAME
3943         %ASK,,0                                         ; NEW COMPILER
3944         %ASK,,0                                         ; DEBUGGING COMPILER
3945 IFN ITS,[
3946         %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ  />/] ? 0 ? 0]      ; INPUT
3947 ]
3948 IFE ITS,[
3949         %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ  /MUD/] ? 0 ? 0]    ; INPUT
3950 ]
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
3955         %ASK,,0                                         ; EXTRA JCL
3956         %ASK,,0                                         ; REDO
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?
3963         %ASK,,0                                         ; EXPFLOAD
3964         %IGNOR,,0                                       ; EXPSPLICE
3965         %ASK,,1                                         ; CAREFUL?
3966         %ASK,,1                                         ; REASONABLE
3967         %IGNOR,,1                                       ; GLUE
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
3974         %IGNOR,,0
3975         %IGNOR,,0
3976         %IGNOR,,0
3977         %IGNOR,,0
3978         %IGNOR,,0
3979         %IGNOR,,0
3980         %IGNOR,,0
3981         %IGNOR,,0
3982         %IGNOR,,0
3983         %IGNOR,,0
3984         %IGNOR,,0
3985         %IGNOR,,0
3986         %ASK,,0
3987
3988 ; SUPER-SHORT:  DEFAULTS EVERYTHING BUT NEW COMPILER, HOW TO RUN, AND INPUT
3989 STABLE: %IGNOR,,0
3990         %ASK,,0
3991         %IGNOR,,0
3992 IFN ITS,[
3993         %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ />/] ? 0 ? 0]
3994 ]
3995 IFE ITS,[
3996         %ASK,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ />/] ? 0 ? 0]
3997 ]
3998         %IGNOR,,[1,,[ASCIZ /DSK/] ? 0 ? 0 ? 1,,[ASCIZ /NBIN/] ? 0 ? 0]
3999         %IGNOR,,0
4000         %IGNOR,,0
4001         %IGNOR,,0
4002         %IGNOR,,0
4003         %IGNOR,,0
4004         %IGNOR,,0
4005         %IGNOR,,0
4006         %IGNOR,,0
4007         %IGNOR,,0
4008         %IGNOR,,0
4009         %IGNOR,,0
4010         %IGNOR,,1
4011         %IGNOR,,1
4012         %IGNOR,,1
4013         %IGNOR,,0
4014         %IGNOR,,0
4015         %IGNOR,,0
4016         %IGNOR,,0
4017         %IGNOR,,0
4018         %IGNOR,,0
4019         %IGNOR,,0
4020         %IGNOR,,0
4021         %IGNOR,,0
4022         %IGNOR,,0
4023         %IGNOR,,0
4024         %IGNOR,,0
4025         %IGNOR,,0
4026         %IGNOR,,0
4027         %IGNOR,,0
4028         %IGNOR,,0
4029         %IGNOR,,0
4030         %IGNOR,,0
4031         %IGNOR,,0
4032         %IGNOR,,0
4033         %ASK,,0
4034
4035 ; QUESTIONS FOR TAILOR
4036
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
4046         SYMVAL Redo,.QREDO
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
4056         SYMVAL Glue?,.QGLUE
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
4066         SYMVAL Finis,$FINIS
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
4075 TAILEN==TAILTB-.
4076 TAILSP==10.                             ; # OF UNREAL QUESTIONS
4077 TALSPC==12.                             ; # OF QUESTIONS WITH UNTOUCHABLE DEFAULTS
4078
4079 JCLIOT: ILDB    A,JCLPTR
4080         JUMPE   A,JCLLOS
4081         JRST    1(RET)
4082
4083 JCLLOS: SETZM   JCLINP
4084         JRST    (RET)
4085
4086 JCLRED:
4087 IFN ITS,[
4088         .BREAK  12,[5,,JCLBUF]
4089 ]
4090         SKIPN   JCLBUF
4091          POPJ   P,
4092         MOVE    A,[440700,,JCLBUF]
4093         SETOM   JCLINP
4094         MOVEM   A,JCLPTR
4095         POPJ    P,
4096
4097 PRHELP: JUMPN   C,RCMDL         ; ONLY ON FIRST CHARACTER
4098         LDB     A,[410300,,PRMPT1]
4099         JRST    @HLPTBL(A)
4100
4101 HLPTBL: HLPSTR
4102         BADTYP
4103         HLPFSP
4104         HLPFIL
4105         HLPCMT
4106         HLPCMT
4107         BADTYP
4108         BADTYP
4109
4110 SAVAC:  PUSH    P,A
4111         PUSH    P,B
4112         PUSH    P,C
4113         JRST    @RET
4114
4115 RSTAC:  POP     P,C
4116         POP     P,B
4117         POP     P,A
4118         JRST    @RET
4119
4120 HLPSMM: ASCIZ /
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>.
4125  The default is /
4126
4127 HLPTF:  ASCIZ /No/
4128         ASCIZ /Yes/
4129
4130 HLPCMT: HLRZ    A,PRMPT1
4131         TRNE    A,%RDCMT
4132          JRST   HLPSYM
4133         SAVACS
4134         OASC    HLPSMM
4135         MOVE    A,(OUTPTR)
4136         OASC    HLPTF(A)
4137         JRST    HLPOUT
4138
4139 HLPSYM: SAVACS
4140         OASC    HLPSMM
4141         MOVE    A,CSYMTB
4142         HLRZ    A,(A)
4143         OASC    (A)
4144         JRST    HLPOUT
4145
4146 HLPSTM: ASCIZ /
4147  Input text terminated by an altmode/
4148 HLPST2: ASCIZ /.
4149  To use the default, type <altmode>.
4150  The current default is /
4151
4152 HLPSTR: SAVACS
4153         OASC    HLPSTM
4154         JUMPE   OUTPTR,HLPOUT
4155         HRRZ    B,(OUTPTR)
4156         JUMPE   B,HLPOUT
4157         OASC    HLPST2
4158         OASC    (B)
4159         JRST    HLPOT1
4160
4161 HLPFSM: ASCIZ /
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 /
4165
4166 HLPFSP: SAVACS
4167         OASC    HLPFSM
4168         PUSHJ   P,HLPFDF
4169         JRST    HLPOUT
4170
4171 HLPFLM: ASCIZ /
4172  Input a file name.  Typing an <altmode> will cause the default to be used.
4173  The current default is /
4174
4175 HLPFIL: SAVACS
4176         OASC    HLPFLM
4177         PUSHJ   P,HLPFDF
4178 HLPOUT: OASCI   ".
4179 HLPOT1: OASCR   [0]
4180         RSTACS
4181         JRST    REPPER
4182
4183 HLPFDF: MOVE    A,(OUTPTR)
4184         PUSHJ   P,NFNAME
4185         POPJ    P,
4186
4187 \f
4188 SUBTTL  INPUT ROUTINES
4189
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
4192 ASK1:   TLO     A,%RDCRT
4193         TLZ     A,77
4194         MOVEM   A,PRMPT1        ; SAVE AS THE PROMPT
4195 ASK2:   MOVE    A,PRMPT1
4196         SETZM   CSYMTB
4197         SETZM   SYMMOD
4198         TLNE    A,$TSYMBOL
4199          JRST   [MOVEI B,SYMPR2
4200                  MOVEM B,PRMPT2
4201                  MOVE B,[TFTLEN,,TFTBL]
4202                  MOVEM B,CSYMTB
4203                  SETOM SYMMOD
4204                  JRST ASK3]
4205         TLNE    A,$TFIL
4206          JRST   [MOVEI B,FILPR2
4207                  MOVEM B,PRMPT2
4208                  JRST ASK3]
4209         TLNE    A,$TFSP
4210          JRST   [MOVEI B,FSPPR2
4211                  MOVEM B,PRMPT2
4212                  JRST ASK3]
4213         MOVEI   B,STRPR2
4214         MOVEM   B,PRMPT2
4215 ASK3:
4216 IFE ITS,[
4217         TLNE    A,$TFIL
4218          JRST   XASKF
4219 ]
4220         PUSHJ   P,GETLN1
4221         LDB     A,[410300,,QTABLE(QOFF)]
4222         JRST    @PRSTBL(A)
4223
4224 BADTYP: FATINS  BAD TYPE CODE
4225
4226 PRSTBL: PRSSTR
4227         BADTYP
4228         PRSFSP
4229         PRSFIL
4230         PRSTF
4231         PRSSYM
4232         BADTYP
4233         BADTYP
4234
4235 ; PUSHJ P,COMTYP
4236 ; A HAS SYMBOL TABLE (1 OF WHICH IS THE DEFAULT)
4237 ; RETURNS IN A THE VALUE OF THE SYMBOL
4238
4239 COMTYP: PUSH    P,A
4240         MOVEM   A,CSYMTB
4241         MOVSI   O,$TSYMBOL+%RDCMT+%RDCRT
4242         HLLM    O,PRMPT1
4243         MOVEI   O,SYMPR2
4244         MOVEM   O,PRMPT2
4245         PUSHJ   P,GETLNS
4246         SKIPN   INPBUF
4247          JRST   [POP P,A
4248                  MOVEM A,SMVAL
4249                  HLRZ B,(A)
4250                  OASC (B)
4251                  OASCI 33
4252                  HRRZ A,(A)
4253                  POPJ P,]
4254         MOVE    B,(P)
4255         MOVE    A,[440700,,INPBUF]
4256         PUSHJ   P,SMATCH
4257         POP     P,
4258         POPJ    P,
4259
4260 TFATBL: SYMVAL  <ASK>,-1
4261 TFTBL:  SYMVAL  Yes,1
4262         SYMVAL  True,1
4263         SYMVAL  No,0
4264         SYMVAL  False,0
4265 TFTLEN==TFTBL-.
4266 TFALEN==TFATBL-.
4267
4268 ; PARSING ROUTINES
4269
4270 PRSSTR: JUMPE   C,CPOPJ
4271         PUSHJ   P,PRSINP
4272         DPB     C,[%TPLEN,,D]
4273         MOVEM   D,(OUTPTR)
4274         JRST    POPJ1
4275
4276 ; PUSHJ P,PRSINP
4277 ; TAKES THE CHARACTER COUNT IN C, COPIES THE INPUT BUFFER INTO SOME NEW CORE
4278 ; AND RETURNS THE ADDRESS IN D
4279
4280 PRSINP: IDIVI   C,5
4281         ADDI    C,1
4282         MOVE    A,C
4283         PUSH    P,A
4284         PUSHJ   P,IBLOCK
4285         MOVE    D,A
4286         HRLI    A,INPBUF
4287         MOVE    B,(P)
4288         ADDI    B,-1(A)
4289         BLT     A,(B)
4290         POP     P,C
4291         POPJ    P,
4292
4293    ; PARSE TRUE/FALSE TYPE QUESTIONS
4294
4295 PRSTF:  SKIPN   INPBUF          ; NO INPUT?
4296          JRST   [MOVEI B,[ASCIZ /Yes/]
4297                  SKIPN (OUTPTR)
4298                  MOVEI B,[ASCIZ /No/]
4299                  OASC (B)
4300                  OASCI 33
4301                  POPJ P,]
4302         MOVE    A,[440700,,INPBUF]
4303         MOVE    B,[TFTLEN,,TFTBL]
4304         PUSHJ   P,SMATCH
4305         MOVEM   A,(OUTPTR)
4306         JRST    POPJ1
4307
4308 ; TWENEX FILE NAME READING
4309 ; READ A FILE NAME WITH DEFAULTS
4310
4311 IFE ITS,[
4312 XASKF:  OASCR   [0]
4313         PUSHJ   P,PPRMPT
4314         MOVE    A,QTABLE(QOFF)
4315         TLZ     A,7777
4316         HLRZS   A
4317         CAIN    A,$TFSP
4318          JRST   XASKF3
4319 XASKF0: MOVE    A,(OUTPTR)
4320         HRLI    A,-ITSSIZ
4321         MOVEI   B,GTJFN2+.GJDEV
4322 XASKFL: SKIPN   (A)                     ; FILL IN FILE NAME DEFAULTS
4323          JRST   XASKFE
4324         HRRO    C,(A)                   ; WITH -1 IN LH
4325         MOVEM   C,(B)
4326 XASKFE: AOJ     B,
4327         AOBJN   A,XASKFL                ; LOOP THROUGH DEV, SNM, FN1, FN2
4328         MOVEI   A,.PRIIN
4329         RFMOD
4330         TRO     B,TT%ECO
4331         SFMOD                           ; GODDAMN GTJFN!
4332 XASKFA: MOVEI   A,GTJFN2
4333         SETZ    B,
4334         HRRO    C,PRMPT1
4335         MOVEM   C,GTJFN2+.GJRTY         ; SETUP PROMPT
4336         SETOM   INPBUF
4337         PUSHJ   P,ECHON
4338         SKIPN   FASKQS
4339          JRST   XASKFB
4340         SKIPN   FILEXI
4341          JRST   [MOVE A,[GTJFN2+1,,GTJFNN+1]
4342                  BLT A,GTJFNN+15
4343                  MOVEI A,GTJFNN
4344                  JRST .+1]
4345 XASKFB: GTJFN
4346          JRST   XASKF2
4347         PUSHJ   P,ECHOFF
4348         MOVEM   A,JFN
4349         PUSH    P,A                     ; SAVE THIS GODAWFUL JFN
4350         MOVEI   A,.PRIIN
4351         RFMOD
4352         TRZ     B,TT%ECO
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
4357 XASKF1: MOVEI   A,15.
4358         PUSHJ   P,IBLOCK
4359         HRLI    A,15.
4360         MOVEM   A,(F)
4361         HRROS   A                       ; POINTER TO STRING
4362         MOVE    B,(P)                   ; JFN
4363         MOVE    C,(E)                   ; CORRECT BIT FOR PARSING ONE FIELD
4364         CAMN    C,[JS%GEN]
4365          JRST   [TLNN   B,(GJ%UHV)      ; WAS HIGHEST GIVEN BY DEFAULT?
4366                   JRST  .+1
4367                  MOVE   B,[ASCIZ /0/]
4368                  MOVEM  B,(A)           ; MAKE IT 0, THEN... HACK, HACK
4369                  JRST   XASKFU]
4370         JFNS                            ; PARSE THE NAME
4371 XASKFU: AOJ     F,
4372         AOBJN   E,XASKF1                ; UPDATE POINTERS
4373         POP     P,A                     ; RESTORE JFN (NOT NEEDED ANYHOW)
4374         SKIPE   FILEXP
4375          JRST   PRSFIX
4376         JRST    PRSFID
4377
4378 XASKF2: PUSHJ   P,ECHOFF
4379         SETZM   INPBUF                  ; THIS IS SO FILESPECS WILL FALL OUT
4380         CAIN    A,GJFX34                ; ? TYPED
4381          JRST   XASKFH
4382         CAIN    A,GJFX37                ; NULL BUFFER
4383          JRST   PRSFID
4384         SKIPN   FILEXI
4385          JRST   XASKF5
4386 XASKF6: OASC    [ASCIZ / Aborted? /]
4387         POPJ    P,
4388
4389 XASKF3: PBIN
4390         PBOUT
4391         CAIE    A,33
4392          JRST   XASKF4
4393         SETZM   INPBUF
4394         SETZM   (OUTPTR)
4395         JRST    PRSFID
4396
4397 XASKF4: MOVEI   A,.PRIIN
4398         BKJFN
4399          JFCL
4400         JRST    XASKF0
4401
4402 XASKF5: OASC    [ASCIZ /    ERROR - /]
4403         MOVEI   A,.PRIOU
4404         MOVE    B,[SETZ -1]
4405         SETZ    C,
4406         ERSTR
4407          JFCL
4408           JFCL
4409         SUB     P,[1,,1]                ; BACK TO FASKQ
4410         POPJ    P,
4411
4412 XASKFH: MOVE    A,QTABLE(QOFF)
4413         TLNE    A,$TFSP
4414          JRST   XHLPFS
4415         SAVACS
4416         OASC    HLPFLM
4417         PUSHJ   P,XHLPFD
4418 XHLPOU: OASCI   ".
4419 XHLPOT: OASCR   [0]
4420         RSTACS
4421         JRST    XASKFA
4422
4423 XHLPFM: ASCIZ /
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 /
4427
4428 XHLPFS: SAVACS
4429         OASC    XHLPFM
4430         PUSHJ   P,XHLPFD
4431         JRST    XHLPOU
4432
4433 XHLPFD: MOVE    A,(OUTPTR)
4434         PUSHJ   P,NFNAME
4435         POPJ    P,
4436
4437 JFNSBT: JS%DEV
4438         JS%DIR
4439         JS%NAM
4440         JS%TYP
4441         JS%GEN
4442
4443 GTJFN3: GJ%OLD
4444         .NULIO,,.NULIO
4445         0
4446         0
4447         0
4448         0
4449         0
4450         0
4451         0
4452         0
4453         0
4454
4455 GTJFNN: GJ%OLD+GJ%FLG+GJ%XTN                    ; IN THIS BLOCK, FILE MUST EXIST
4456         BLOCK 16
4457
4458 GTJFN2: GJ%OFG+GJ%XTN
4459         .PRIIN,,.PRIOU
4460         0
4461         0
4462         0
4463         0
4464         0
4465         0
4466         0
4467         G1%RND+3
4468         0
4469         0
4470         0
4471
4472 ]
4473
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
4477
4478 IFE ITS,[
4479
4480 XFNEXP: HRLI    A,-5
4481         MOVEI   B,GTJFNE+.GJDEV
4482         PUSH    P,B
4483         PUSH    P,C
4484         PUSH    P,D
4485 XFNX1:  HRRO    C,(A)                   ; FILL IN THE FIELDS
4486         MOVEM   C,(B)
4487         AOJ     B,
4488         AOBJN   A,XFNX1
4489         MOVEI   A,GTJFNE
4490         SETZ    B,
4491         GTJFN                           ; ASK FOR JFN (MUST EXIST!)
4492          JRST   POPDCB
4493         MOVE    B,A
4494         MOVEI   A,30.                   ; PLACE TO WRITE STRING
4495         PUSHJ   P,IBLOCK
4496         PUSH    P,A
4497         HRROS   A
4498         SETZ    C,
4499         SETZ    D,
4500         JFNS
4501         POP     P,A
4502         AOS     -3(P)
4503         JRST    POPDCB
4504
4505 GTJFNE: GJ%OLD
4506         .NULIO,,.NULIO
4507         0
4508         0
4509         0
4510         0
4511         0
4512         0
4513         0
4514         0
4515
4516 ]
4517 ; PARSE FILE INPUT SPECIFICATIONS
4518
4519 PRSFIL: PUSHJ   P,FPARSE
4520          JRST   [OASC [ASCIZ / - Illegal character in file name/]
4521                  JRST ASK2]
4522         MOVE    A,(OUTPTR)
4523         SKIPN   FILEXP
4524          JRST   [HRLI   B,DEVICE
4525                  HRR    B,A
4526                  MOVEI  C,5(A)
4527                  BLT    B,(C)
4528                  JRST   PRSFID]
4529 PRSFIX: MOVE    A,(OUTPTR)
4530         PUSH    P,A
4531         HRLI    A,-ITSSIZ
4532         MOVEI   D,DEVICE
4533         MOVEI   E,SYSDEV
4534 PRSFLL: SKIPN   B,(D)
4535          JRST   [SKIPN B,(A)
4536                   MOVE B,(E)
4537                  JRST .+1]
4538         PUSHJ   P,GETFNM
4539         MOVEM   B,(A)
4540         AOJ     D,
4541         AOJ     E,
4542         AOBJN   A,PRSFLL
4543         OASC    [ASCIZ  /   [/]
4544         POP     P,A
4545         PUSHJ   P,NFNAME
4546         OASCI   "]
4547 PRSFID: MOVE    A,QTABLE(QOFF)
4548         TLNN    A,%NSYSD
4549          PUSHJ  P,FPSYS
4550         SKIPN   INPBUF
4551          POPJ   P,
4552         JRST    POPJ1
4553
4554 ;IN A, THE POINTER TO ASCIZ
4555 ;A HAS BEEN PUSHED PREVIOUSLY
4556
4557 XSPNM:  PUSH    P,B
4558         MOVE    B,(A)
4559 IFN ITS,[
4560         CAMN    B,[ASCIZ /\18/]
4561 ]
4562 IFE ITS,[
4563         CAMN    B,[ASCIZ /\16\18/]
4564 ]
4565          JRST   XSPNM1
4566 IFN ITS,[
4567         CAME    B,[ASCIZ /\19/]
4568 ]
4569 IFE ITS,[
4570         CAME    B,[ASCIZ /\16\19/]
4571 ]
4572          JRST   XSPNM2
4573         TDZA    B,B
4574 XSPNM1:  MOVEI  B,1
4575         MOVEM   B,SSSPPP
4576         AOS     -1(P)
4577 XSPNM2: MOVE    B,-2(P)
4578         EXCH    B,-1(P)
4579         MOVEM   B,-2(P)
4580         POP     P,B
4581         POP     P,A
4582         POPJ    P,
4583
4584 GETFNM: SPNAME  B                       ; IS GIVEN NAME CTRL-X OR CTRL-Y?
4585          POPJ   P,                      ; NO
4586         SETOM   DIDEXP                  ; CTRL-X OR CTRL-Y HAPPENED
4587         MOVE    B,SSSPPP
4588         CAIE    B,1                     ; CTRL-X
4589          JRST   GETFN1
4590         MOVE    B,SYSFN1                ; SO GET FIRST FILE NAME
4591         POPJ    P,
4592
4593 GETFN1: MOVE    B,SYSFN2
4594         POPJ    P,
4595
4596 PRSFSP: SKIPN   INPBUF
4597          JRST   [SETZM (OUTPTR)
4598                  POPJ P,]
4599         JRST    PRSFIL
4600 \f
4601 ; PUSHJ P,FPARSE
4602 ; COME HERE TO PARSE A FILE NAME.
4603 ; DEPOSIT THE STUFF IN 4 WORDS AT FILNAM
4604
4605 FPSYS:  MOVE    B,(OUTPTR)              ; PICK UP POINTER TO NAMES IF ^X OR ^Y APPEARS
4606         PUSH    P,C
4607         PUSH    P,D
4608         MOVE    C,[-FSPSIZ,,DEVICE]
4609         MOVEI   D,SYSDEV
4610 FPSYSL: SKIPE   A,(B)
4611          JRST   [SPNAM1 A               ; SKIPS IF NOT ^X OR ^Y--INVERSE OF SPNAME
4612                   MOVE  A,(B)
4613                  MOVEM  A,(D)
4614                  JRST   .+1]
4615         AOJ     B,
4616         AOJ     D,
4617         AOBJN   C,FPSYSL
4618         POP     P,D
4619         POP     P,C
4620         POPJ    P,
4621
4622 FPARSE: MOVE    E,[440700,,INPBUF]
4623         SETZM   ENDSW
4624         SETZM   DEVICE
4625         MOVE    B,[DEVICE,,DEVICE+1]    ;CLEAR ALL NAMES
4626         BLT     B,ETCETC
4627 FPARSS: MOVEI   A,FSPSIZ
4628         PUSHJ   P,IBLOCK
4629         MOVEM   A,NAME
4630         SETZM   NAMCNT
4631         SKIPE   ENDSW
4632          JRST   POPJ1
4633         MOVE    F,A                     ;BP TO NAME AREA
4634         HRLI    F,440700
4635
4636 GETCHR: ILDB    B,E                     ;FIND NEXT NON-EMPTY CHARACTER
4637         JUMPE   B,[SETOM ENDSW
4638                    JRST  FIELD1]
4639         CAIE    B,40
4640          CAIN   B,^I
4641           JRST  GETCHR
4642
4643 FIELD:  CAIN    B,":
4644          JRST   DEV                     ;DEVICE NAME
4645         CAIN    B,";
4646          JRST   FDIR                    ;SNAME
4647 FIELD1: CAIE    B,40                    ;HERE TO GET A NAME
4648          CAIN   B,^I
4649           JRST  FNAM                    ;SPACE AND TAB MAKE FNAME1 AND 2
4650         CAIE    B,0
4651          CAIN   B,^M
4652           JRST  FNAM                    ;SO DO 0 AND <CR>
4653         CAIE    B,^X
4654          CAIN   B,^Y
4655           JRST  FIELD2
4656         CAIN    B,^Q                    ;HANDLE QUOTING
4657          ILDB   B,E
4658         CAIGE   B,40                    ;SUBI B,40 < 0 (BAD CHARACTER)
4659          JRST   CPOPJ
4660         CAIL    B,"a
4661          SUBI   B,40                    ;CASE CONVERSION
4662 FIELD2: IDPB    B,F
4663          AOS    NAMCNT
4664 FPARS2: ILDB    B,E
4665         JRST    FIELD
4666
4667 DEV:    MOVE    A,NAME
4668         JSP     RET,FNMCNT
4669         MOVEM   A,DEVICE
4670         SETZM   SPCHR
4671         JRST    FPARSS
4672
4673 FDIR:   MOVE    A,NAME
4674         JSP     RET,FNMCNT
4675         MOVEM   A,DIRECT
4676         SETZM   SPCHR
4677         JRST    FPARSS
4678
4679 FNAM1:
4680 FNAM:   SKIPN   NAMCNT
4681          JRST   FPARSS
4682         MOVE    A,NAME
4683         JSP     RET,FNMCNT
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
4687         JRST    FPARSS
4688
4689 FNAM2:  MOVEM   A,FNAME2                ;PUT NEW NAME INTO FNAME2
4690         JRST    FPARSS
4691
4692 FNMCNT: MOVE    B,NAMCNT                ;PUT COUNT IN HERE
4693         IDIVI   B,5
4694         ADDI    B,1
4695         HRL     A,B
4696         JRST    (RET)
4697
4698 ; CLEAR THE SCREEN
4699
4700 IFE ITS,[
4701 XCLEAR: SAVACS
4702         MOVEI   1,.PRIOU        ;ENTER HERE FOR THINGS THAT BLANK INCIDENTALLY
4703         RFMOD                   ;CHANGE TO
4704         PUSH    P,2
4705         TRZ     2,TT%DAM        ;BINARY MODE
4706         SFMOD
4707         GTTYP
4708         HRROI   1,BLNKTB(2)     ;GET RIGHT MAGIC
4709         PSOUT
4710         MOVEI   1,.PRIOU
4711         POP     P,2
4712         SFMOD
4713         RSTACS
4714         POPJ    P,
4715
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
4727 ]
4728
4729 IFE ITS,[
4730 ; DO TWENEX IOTING
4731 ; IN (P) IS THE WORD WHICH ITS WOULD LIKE
4732
4733 XIOTI:  PUSH    P,[SIN]
4734         CAIA
4735 XIOT:    PUSH   P,[SOUT]
4736         MOVE    O,[A,,XACS]
4737         BLT     O,XACS+2
4738         MOVE    A,-1(P)
4739         MOVE    A,(A)
4740         MOVE    O,XACS-1(A)
4741         MOVE    A,DSKJFN
4742         HRRZ    B,O
4743         TLO     B,444400
4744         HLRE    C,O
4745         PUSH    P,C
4746         XCT     -1(P)
4747         CAME    C,(P)
4748          AOS    -2(P)
4749         MOVE    O,[XACS,,A]
4750         BLT     O,C
4751         SUB     P,[2,,2]
4752         JRST    POPJ1
4753
4754 XACS:   BLOCK   3
4755 ]
4756
4757 ; CONVERT ASCII NAME IN A TO SIXBIT WORD IN A
4758 ; CHOMP ,CHOMP
4759
4760 ASCSIX: PUSH    P,B
4761         PUSH    P,C
4762         PUSH    P,D
4763         MOVE    B,A
4764         HRLI    B,440700                ; B POINTS TO ASCII BLOCK
4765         SETZ    A,
4766         MOVE    C,[440600,,A]           ; C POINTS TO A (SIXBIT WORD)
4767 ASCSIL: ILDB    D,B
4768         JUMPE   D,SIXAS2
4769         SUBI    D,40
4770         CAIL    D,100
4771          SUBI   D,40
4772         IDPB    D,C
4773         TLNE    C,770000                ; SKIP IF A IS FULL
4774          JRST   ASCSIL
4775         JRST    SIXAS2
4776
4777 ; CONVERT SIXBIT NAME IN A TO STANDARD ASCII POINTER
4778 ; I.E. WORD-COUNT(=2),,POINTER
4779
4780 SIXASC: PUSH    P,B             ; SAVE RANDOM ACS
4781         PUSH    P,C
4782         PUSH    P,D
4783         PUSH    P,A             ; TEMPORARILY SAVE SIXBIT WORD
4784         MOVEI   A,2
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
4792         ADDI    D,40
4793         IDPB    D,A             ; DEPOSIT CHARACTER
4794         TLNE    C,760000
4795          JRST   SIXASL          ; LOOP
4796 SIXAS1: POP     P,A             ; FINISHED. RESTORE POINTER
4797         HRLI    A,2             ; 2 IN LH (WORD COUNT)
4798 SIXAS2: POP     P,D             ; AND RETURN
4799         POP     P,C
4800         POP     P,B
4801         POPJ    P,
4802
4803 \f
4804 ; GENERAL PURPOSE MATCH LOSSAGE HANDLERS
4805
4806 ; COMPS  GIVEN BP'S IN A AND E, RETURNS THE NUMBER OF = LETTERS
4807
4808 COMPS:  SETZ    F,              ; COUNT OF MATCHING CHARACTERS
4809 COMPS1: ILDB    C,A
4810         JUMPE   C,[MOVE C,E     ; COPY THE BP TO TABLE ENTRY
4811                    ILDB C,C
4812                    SKIPN C      ; THIS ZERO ALSO??
4813                     MOVEM B,SMEXAC      ; YES.  THIS IS AN EXACT MATCH
4814                    JRST POPJ1]
4815         TRO     C,40            ; LOWER CASE
4816         ILDB    D,E
4817         JUMPE   D,CPOPJ
4818         TRO     D,40            ; LOWER CASE
4819         CAMN    C,D
4820          AOJA   F,COMPS1
4821         POPJ    P,              ; LOSE IMMEDIATE
4822
4823 ; PUSHJ P,SPOSS
4824 ; LIST POSSIBILITIES.  AC'S AS BELOW
4825
4826 SPOSS:  PUSH    P,[-1]
4827         OASCR   [0]
4828         OASCR   [ASCIZ /The following are possible: /]
4829         JRST    SMATIN
4830
4831 ; PUSHJ P,SMATCH
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
4837
4838 SMATCH: PUSH    P,[0]
4839 SMATIN: PUSH    P,A
4840         MOVEM   C,INPLEN                ; SAVE INPUT LENGTH
4841         SETZM   SMEXAC                  ; ZERO SOME SWITCHES
4842         SETZM   SMBEST
4843         SETZM   SMBLEN
4844         SETZM   SMNUM
4845 SMLP2:  MOVE    A,(P)                   ; GET BP TO INPUT BUFFER
4846         HLRZ    E,(B)
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
4855         OASCR   (E)
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
4859         POP     P,A                     ; GET CODE
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
4864         TLNE    B,400000
4865         ADD     B,[347777,,-1]
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.
4870
4871 ; COME HERE TO COMPLETE
4872
4873 SMDEP:  ILDB    E,D                     ; GET THE NEXT CHARACTER
4874         OASCI   (E)                     ; ECHO IT
4875         IDPB    E,B                     ; DEPOSIT INTO THE INPUT BUFFER
4876         SOJN    A,SMDEP                 ; CONTINUE
4877 SMMDON: MOVE    D,SMNUM                 ; GET THE NUMBER OF MATCHES
4878         CAIN    D,1                     ; JUST 1?
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
4884 IFN ITS,[
4885         OASCI   "&                      ; AND PRINT CONTINUATION CHAR
4886 ]
4887 SMCNT1: MOVE    C,SMBLEN
4888         ADD     C,INPLEN                ; UPDATE CHARACTER COUNT FOR READER
4889         MOVE    D,INPACT                ; GET THE ACTIVATION FOR INPUT
4890         HRRM    D,(P)
4891         JRST    RCMD1                   ; RETURN TO READER
4892
4893 SMLOSR: OASC    [ASCIZ /Matching error - JCL input aborted/]
4894         CAIA
4895 SMLOSE: OASC [ASCIZ / No symbol matches input /]
4896         SETZM JCLINP                    ; FLUSH INPUT FROM JCL
4897         MOVE D,INPACT                   ; GET THE ACTIVATION FOR INPUT
4898         HRRM D,(P)
4899         JRST GETLNS                     ; RETURN TO READER
4900
4901 ; COME HERE WHENEVER A SYMBOL TABLE ENTRY MATCHES THE INPUT IN THE BUFFER
4902
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
4909          JFCL
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
4916
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
4922
4923 ; COME HERE IF THERE IS AN EXACT MATCH OR ONLY ONE POSSIBLE COMPLETION
4924
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
4933         POPJ    P,
4934
4935 SMTRM1: CAIE    E,^M                    ; IS THE BREAK A <CR>
4936          JRST   SMTRM3                  ; NO. COMPLETE ONLY
4937         MOVE    A,PRMPT1
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
4941         OASCI "!
4942         JRST SMCNT1
4943
4944 ; COME HERE AT END OF CONTROL-F HACK
4945
4946 SMNPOS: SKIPN   SMNUM                   ; ANY POSSIBILITIES MATCH?
4947          OASCR  [ASCIZ / None possible /]
4948         POPJ    P,
4949
4950 ; GET THE LENGTH OF A STRING POINTED TO BY E
4951
4952 STRLEN: MOVE    C,E
4953         SETZ    E,
4954 STRLLP: ILDB    D,C
4955         JUMPE   D,CPOPJ
4956         AOJA    E,STRLLP
4957
4958 ; CLEAR THE INPUT BUFFER
4959
4960 CLINBF: SETZM   INPBUF
4961         MOVE    O,[INPBUF,,INPBUF+1]
4962         BLT     O,INPBUF+INPBLN-1
4963         POPJ    P,
4964
4965 ; COPY THE INPUT BUFFER INTO TINBUF
4966 SINBUF: PUSH    P,A
4967         MOVE    A,[INPBUF,,TINBUF]
4968         BLT     A,TINBUF+INPBLN-1
4969         JRST    POPAJ
4970
4971 ; COPY TINBUF BACK INTO THE INPUT BUFFER
4972 RINBUF: PUSH    P,A
4973         MOVE    A,[TINBUF,,INPBUF]
4974         BLT     A,INPBUF+INPBLN-1
4975         JRST    POPAJ
4976
4977 ; COMMAND READER.
4978 ; PUSHJ P,GETLIN READS TO AN ALTMODE AND FILLS IN THE INPUT BUFFER
4979 ; ACCORDINGLY
4980
4981 GETLNS: SETOM   SYMMOD
4982         CAIA
4983 GETLIN:  SETZM  SYMMOD
4984 GETLN1: SETZM   XTRCHR
4985         MOVE    RET,(P)
4986         MOVEM   RET,INPACT      ; SAVE "ACTIVATION"
4987         PUSHJ   P,CLINBF
4988         HRRZ    B,PRMPT1
4989         JUMPE   B,RCMD
4990 RCMDXX: OASCR   [0]
4991 RCMD:   MOVE    B,[440700,,INPBUF]
4992         PUSHJ   P,PPRMPT
4993         SETOM   INREAD          ; HAVE REASONABLE INPUT BUFFER TO REDISPLAY
4994         MOVEI   C,0             ; COUNT OF CHARACTERS
4995 RCMD1:  SETZM   MDPDLF
4996         SETZM   MDMISF
4997         SETZM   MDOVCF          ; CLEAR ERROR FLAGS
4998         SETZM   MDBKSV
4999 RCMDER: SKIPE   JCLINP          ; COME HERE IF ERROR FLAG JUST SET
5000 REBLK:   JSP    RET,JCLIOT      ; FOR HYSTERICAL REASONS
5001 IFN ITS,[
5002         .IOT    TTYI,A
5003 ]
5004 IFE ITS,[
5005         PBIN
5006 ]
5007         SKIPN   MDMISF
5008          SKIPE  MDOVCF
5009           OCTLP "L              ; CLEAR ERROR MESSAGE, IF EXISTS
5010         SKIPE   MDPDLF
5011          OCTLP  "L
5012         SKIPE   XTRCHR
5013          PUSHJ  P,XTRCLR
5014         SKIPE   RQUOTE          ; IN QUOTE MODE?
5015          JRST   [SETZM RQUOTE
5016                  JRST RCMDL]
5017         CAIN    A,"\
5018          JRST   [SETOM RQUOTE
5019                  JRST RCMD1]
5020         CAIN    A,^W            ; ERASE A WORD
5021          JRST   WDFLUS
5022         CAIN    A,^X            ; ERASE A LINE
5023          JRST   [MOVE   O,PRMPT1
5024                  TLNN   O,$TFILE        ; DOESN'T WORK IN FILE MODE
5025                   JRST  LNFLUS
5026                  JRST   RCMDL]
5027         CAIN    A,^K            ; ERASE AN OBJECT
5028          JRST   [MOVE   O,PRMPT1
5029                  TLNE   O,700000        ; STRING?
5030                   JRST  WDFLUS          ; NO, SO TURN INTO WORD FLUSH
5031                  JRST   MDFLUS]
5032         CAIN    A,177
5033          JRST   RUB
5034         CAIN    A,^F
5035          JRST   POSCHK
5036         CAIN    A,^G
5037          JRST   GACK            ; GET FROM GROUP
5038         JUMPE   A,RSTBUF
5039         CAIN    A,^D            ; DISPLAY BUFFER
5040          JRST   RREPEA
5041         CAIN    A,^L            ; CLEAR SCREEN AND DISPLAY BUFFER
5042          JRST   RCLEAR
5043         CAIN    A,"?
5044          JRST   PRHELP
5045         CAIN    A,^Q
5046          JRST   [SETOM CTRLQ
5047                  MOVEI A,33
5048                  JRST RCMDX1]
5049         CAIN    A,33            ; TERMINATE ON ALTMODE
5050          JRST   RCMDXE
5051         CAIE    A,^B            ; MAKE CONTROL-B DO BACK UP ALSO (LIKE FOR 20X)
5052          CAIN   A,^R
5053           JRST  RACK            ; BACK UP
5054         CAIN    A,^S            ; QUIT
5055          JRST   TOPLEV
5056         CAIN    A,^M
5057          JSP    RET,CRCHK
5058         SKIPE   SYMMOD
5059          JSP    RET,SYMCHR
5060 RCMDL:  ADDI    C,1
5061         CAIL    C,INPBLN
5062          FATINS PDL OVERFLOW ON NON-EXPANDABLE PDL
5063         CAIN    A,^J
5064          JRST   [SKIPE FOOBR'
5065                   JRST RCMD1    ; WHAT THE FUCK HAPPENS HERE?
5066                  SETOM FOOBR
5067                  JRST .+2]
5068         SETZM   FOOBR
5069         IDPB    A,B
5070         ECHO
5071         JRST    RCMD1
5072
5073 RCMDXE:
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
5078         IDPB    A,B
5079         SETZM   INREAD
5080         MOVEM   C,CHRLEN'
5081         POPJ    P,              ; EXIT
5082
5083 RSTBUF: ECHO                    ; ECHO THE CHAR AND CLEAR THE BUFFER
5084 RSTBF1: OASCR   [0]
5085         SETZ    C,
5086         PUSHJ   P,CLINBF
5087         MOVE    B,[440700,,INPBUF]
5088         JRST    REPPER
5089
5090 POSCHK: SKIPN   CSYMTB
5091          JRST   RCMDL
5092         MOVE    A,[440700,,INPBUF]
5093         PUSH    P,B
5094         MOVE    B,CSYMTB
5095         PUSH    P,C
5096         PUSH    BK,[0]                          ; CREATE ACTIVATION FOR ABORT
5097         PUSH    BK,[POSCHR]
5098         PUSH    BK,[[POPJ P,]]
5099         PUSH    BK,P
5100         SETOM   LONGOT                          ; ENABLE MORES, ^R ^S TO STOP
5101         PUSHJ   P,SPOSS
5102         SETZM   LONGOT                          ; DISABLE
5103         BKOFF
5104 POSCHR: PUSHJ   P,PPRMPT
5105         POP     P,C
5106         POP     P,B
5107         OASC    INPBUF
5108         JRST    RCMD1
5109
5110 XTRCLR: OCTLP   "X
5111         SOSE    XTRCHR
5112          JRST   XTRCLR
5113         POPJ    P,
5114
5115 CRCHK:  HLRZ    D,PRMPT1
5116         TRNN    D,$TFILE
5117          TRNE   D,$TSYMBOL
5118           JRST  RCMDX1
5119         ECHO
5120         IDPB    A,B
5121         MOVEI   A,^J
5122         AOJ     C,
5123         JRST    @RET
5124
5125 SYMCHR: CAIN    A,40
5126          JRST   RCMDX1
5127         JRST    @RET
5128
5129 PPRMPT: OASC    @PRMPT1
5130         SKIPE   PR2SW
5131          OASC   @PRMPT2
5132         POPJ    P,
5133
5134 RREPEA: ECHO
5135         OASCR   [0]             ; RETYPE LINE
5136         JRST    REPPER
5137 RCLEAR: SCLEAR
5138 REPPER: PUSHJ   P,PPRMPT
5139         OASC    INPBUF
5140         JRST    RCMD1
5141 \f
5142 SUBTTL  RUBOUTS &C.
5143
5144 ; CHARACTER COUNT IS IN C, BYTE POINTER IS IN B
5145
5146 RUB:    PUSHJ   P,RUBBER                ; FLUSH A CHAR
5147          JRST   RCMDXX                  ; NONE LEFT--REDISPLAY PROMPT
5148         JRST    RCMD1                   ; JUST KEEP FROBBING
5149
5150 RUBBER: SOJL    C,CPOPJ
5151         LDB     A,B                     ; GET CHARACTER
5152         MOVEI   D,0
5153         DPB     D,B                     ; ZERO IT
5154         XCT     XCTRUB                  ; DO THE RUBOUT
5155         DBP     B
5156         AOS     (P)
5157         POPJ    P,                      ; SKIP RETURN, WITH CHARACTER IN A
5158
5159 RUBECH: OASCI   (A)                     ; ECHO
5160         POPJ    P,
5161
5162 ; MUCH OF THE FOLLOWING IS RIPPED OFF FROM MUDDLE
5163 RUBFLS: PUSH    P,B
5164         PUSH    P,C
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
5171 RUBDON: POP     P,C
5172         POP     P,B
5173         POPJ    P,
5174
5175 ; RETURN CHARACTER TYPE (OFFSET INTO FIXIM2 AND FIXIM3) IN C.  CHARACTER IS IN A
5176 CHRTYP: MOVEI   C,0
5177         CAIG    A,37                    ; SKIP IF MIGHT BE FUNNY
5178          JRST   CHRTY1
5179         CAIN    A,177                   ; RUBOUT?
5180          AOJA   C,CPOPJ                 ; TWO CHARACTERS WIDE
5181         POPJ    P,
5182 CHRTY1: PUSH    P,A
5183         IDIVI   A,12.                   ; GET WORD TO ACCESS
5184         MOVE    A,FIXIML(A)             ; FROM FIXIML TABLE
5185         IMULI   B,3
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
5189         POP     P,A
5190         POPJ    P,
5191
5192 ; CTRL-Z AND CTRL-_
5193 FOURQ:  OCTLP   "X
5194         OCTLP   "X
5195         SKIPE   TOFCI                   ; TV KEYBOARD?
5196          JRST   RUBDON
5197         OCTLP   "X
5198         OCTLP   "X
5199         JRST    RUBDON
5200
5201 ; BACK SPACE
5202 BSKILL: AOS     CHPOS                   ; GET NEW HPOS +8.
5203         OHPOS   @CHPOS
5204         JRST    RUBDON
5205
5206 CGKILL: JRST    RUBDON                  ; CTRL-G TAKES NO SPACE
5207
5208 TBKILL: PUSHJ   P,GHPOS                 ; FIND NEW POSITION
5209         OHPOS   @CHPOS
5210         OCTLP   "L                      ; CLEAR TO END OF LINE
5211         JRST    RUBDON
5212
5213 CRKILL: PUSHJ   P,GHPOS
5214         OHPOS   @CHPOS
5215         JRST    RUBDON
5216
5217 LFKILL: PUSH    P,A
5218         MOVEI   A,1
5219         PUSHJ   P,LNSTRV
5220         POP     P,A
5221         JRST    RUBDON
5222
5223 ; TAKES NUMBER OF LINES TO GO UP IN A, POSITIONS CURSOR AT END OF LAST LINE REMAINING
5224 LNSTRV: CAMLE   A,CVPOS
5225          JRST   LNREDO
5226         SOJE    A,LNONE                 ; SPECIAL CASE FOR ONE LINEFEED
5227         OCTLP   "H                      ; GO TO BEGINNING OF LINE
5228         OASCI   10
5229 LNSLOP: OCTLP   "L                      ; KILL LINE AND GO UP
5230         OCTLP   "U
5231         SOS     CVPOS                   ; UPDATE CVPOS
5232         SOJGE   A,LNSLOP                ; LOOP
5233         PUSHJ   P,GHPOS
5234         OHPOS   @CHPOS                  ; FROB HORIZONTAL POSITION
5235         OCTLP   "L                      ; AND CLEAR THE LAST LINE
5236         POPJ    P,
5237 ; ONLY ONE TO HACK
5238 LNONE:  OCTLP   "U                      ; DO LINE STARVE
5239         POPJ    P,
5240 LNREDO: OCTLP   "T              ; HOME UP AND CLEAR FIRST LINE
5241         OCTLP   "L
5242         PUSHJ   P,PPRMPT                ; REDISPLAY PROMPT
5243         OASC    INPBUF                  ; INPUT BUFFER
5244         PUSHJ   P,RCPOS                 ; READ CURSOR POSITION
5245         POPJ    P,                      ; AND FLUSH
5246
5247 ; TABLE OF CHARACTER LENGTHS OR SPECIAL ROUTINES
5248 FIXIM2: 1
5249         2
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
5254         SETZ    TBKILL                  ; TAB
5255         SETZ    CGKILL                  ; CTRL-G
5256
5257 ; INSTRUCTIONS TO GET CHARACTER WIDTHS ON DISPLAY, INTO C
5258 FIXIM3: MOVEI   C,1
5259         MOVEI   C,2
5260         PUSHJ   P,CNTCTZ                ; MAY BE EITHER TWO OR FOUR
5261         MOVEI   C,0
5262         MOVEI   C,0
5263         MOVNI   C,1
5264         PUSHJ   P,CNTTAB                ; GET WIDTH OF TAB
5265
5266 CNTCTZ: MOVEI   C,2
5267         SKIPN   TOFCI                   ; TV KEYBOARD?
5268          MOVEI  C,4
5269         POPJ    P,
5270
5271 CNTTAB: ANDCMI  O,7                     ; ZERO LOW THREE BITS OF POSITION COUNT
5272         ADDI    O,10                    ; AND ADD 8
5273         MOVEI   C,0
5274         POPJ    P,
5275
5276 FIXIML: 111111,,175641                  ; CTRL @ABCDE,,FGHIJK
5277         131111,,111111                  ; LMNOPQ,,RSTUVW
5278         112011,,120000                  ; XYZ[\],,^_
5279
5280 ; READ  CURSOR POSITION, PUT IN CHPOS AND CVPOS
5281 RCPOS:  PUSH    P,A
5282 IFN ITS,[
5283         .CALL   [SETZ
5284                  SIXBIT /RCPOS/
5285                  MOVEI  TTYI
5286                  SETZM  A]
5287          .LOSE  %LSSYS
5288         HLRM    A,CVPOS
5289         HRRM    A,CHPOS
5290 ]
5291         POP     P,A
5292         POPJ    P,
5293
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
5296 GHPOS:  PUSH    P,O
5297         PUSH    P,A
5298         PUSH    P,B
5299         PUSH    P,C
5300         PUSH    P,D
5301         MOVEI   O,0
5302         MOVE    D,PRMPT1                ; PICK UP LONG PROMPT
5303         PUSHJ   P,CNTSTR                ; GET LENGTH OF IT IN O
5304         SKIPN   PR2SW
5305          JRST   GHPOS1
5306         MOVE    D,PRMPT2
5307         PUSHJ   P,CNTSTR
5308 GHPOS1: MOVEI   D,INPBUF
5309         PUSHJ   P,CNTSTR
5310         MOVEM   O,CHPOS
5311         POP     P,D
5312         POP     P,C
5313         POP     P,B
5314         POP     P,A
5315         POP     P,O
5316         POPJ    P,
5317
5318 CNTSTR: HRLI    D,440700                ; BYTE POINTER TO STRING
5319 CNTST1: ILDB    A,D                     ; GET CHARACTER
5320         JUMPE   A,CPOPJ                 ; NULL TERMINATES
5321         CAIN    A,^M                    ; CR?
5322          JRST   [MOVEI  O,0
5323                  JRST   CNTST1]
5324         PUSHJ   P,CHRTYP
5325         XCT     FIXIM3(C)
5326         ADD     O,C                     ; UPDATE COUNT
5327         JRST    CNTST1                  ; AND TRY AGAIN
5328 \f
5329 ; RUB OUT A WORD:  STOP AT <CR>, <LF>, <TAB>, OR <SP>, RUBBING OUT AT LEAST
5330 ; ONE CHARACTER NOT IN THAT SET.
5331
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
5339         PUSHJ   P,BREAK
5340          JRST   WDFLU2
5341         JRST    RCMD1                   ; FOUND A BREAK, SO STOP
5342 WDFLU2: PUSHJ   P,RUBBER
5343          JRST   RCMDXX
5344         JRST    WDFLU1
5345
5346 ; SKIP IF CHARACTER IN A IS ONE OF <SP>, <CR>, <LF>, <TAB>, <;>
5347 BREAK:  CAIE    A,^I
5348          CAIN   A,^J
5349           JRST  POPJ1
5350         CAIE    A,^M
5351          CAIN   A,40
5352           JRST  POPJ1
5353         CAIN    A,";
5354          JRST   POPJ1
5355         POPJ    P,
5356 \f
5357 ; DELETE A LINE.  IF AT BEGINNING OF LINE (FIRST CHAR IS CTRL-J, DELETE
5358 ; PREVIOUS LINE.
5359 LNFLUS: PUSHJ   P,RUBBER                ; ONE CHARACTER WILL ALWAYS BE FLUSHED
5360          JRST   RCMDXX
5361 LNFLUL: LDB     A,B
5362         CAIN    A,^J                    ; FINISHED?
5363          JRST   LNFLUD
5364         MOVEI   O,0
5365         DPB     O,B                     ; ZERO THE CHAR
5366         DBP     B
5367         SOJLE   C,LNLEAV                ; OUT OF CHARS?
5368         JRST    LNFLUL
5369 LNFLUD: PUSH    P,B
5370         DBP     B
5371         LDB     A,B
5372         POP     P,B                     ; LOOK AT THE CHARACTER BEFORE THE CTRL-J
5373         CAIN    A,^M
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?/]
5378                  JRST   RCMD1]
5379         OHPOS   @CHPOS                  ; GET HORIZONTAL POSITION
5380         OCTLP   "L                      ; AND CLEAR LINE
5381         JRST    RCMD1
5382 LNFLKL: SETZM   CHPOS                   ; HORIZONTAL POSITION IS 0
5383         JRST    LNLEV1                  ; GO DO IT
5384 \f
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
5389         PUSH    P,A
5390         PUSH    P,D
5391         PUSH    P,E
5392 MDSFLP: LDB     A,B             ; GET A CHAR
5393         PUSHJ   P,BREAK         ; BREAK?
5394          JRST   MDFLU1
5395         PUSHJ   P,RUBBER
5396          JRST   MDFLOT
5397         JUMPG   C,MDSFLP
5398         JRST    MDFLOT
5399 ; WE NOW HAVE A NON-BREAK IN A, READY TO BE GROSSLY FROBBED.
5400 MDFLU1: SKIPE   TOERS
5401          PUSHJ  P,RCPOS
5402         PUSHJ   P,RITBKT        ; RIGHT BRACKET?
5403          JRST   MDFLU2
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
5408          JRST   MDFLOT
5409         JRST    MDFLOT          ; AND LEAVE
5410 ; KILL AN ATOM--GO TO BREAK OR TO UNQUOTED BRACKET
5411 MDATOM: PUSHJ   P,RUBBER        ; FLUSH A CHAR
5412          JRST   MDFLOT
5413         JUMPE   C,MDFLOT
5414         LDB     A,B             ; GET THE NEXT ONE
5415         PUSHJ   P,BREAK         ; BREAK?
5416          JRST   MDATO1
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?
5421          JRST   MDATO2
5422         JRST    MDFLOT          ; YES, SO DONE
5423 MDATO2: PUSHJ   P,RITBKT
5424          JRST   MDATOM          ; NOT A BRACKET, SO FLUSH IT
5425         JRST    MDFLOT
5426
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
5430         MOVEM   BK,MDBKSV
5431         PUSH    P,B
5432         PUSH    P,C             ; SAVE OLD BUFFER, SINCE MAY NOT DO ANYTHING
5433         ADDI    C,1
5434         MOVEI   D,0             ; USE TO ACCUMULATE CTRL-J'S PASSED
5435         IBP     B
5436 MDOBLP: SOJLE   C,OVERCL        ; OUT OF CHARS BEFORE TERMINATION, SO ERROR
5437         DBP     B
5438         LDB     A,B             ; GET A CHARACTER
5439         PUSHJ   P,RITBKT        ; RIGHT BRACKET?
5440          JRST   MDOBJ1          ; NO, TRY SOMETHING ELSE
5441         CAIN    A,""            ; STRING?
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?
5446          JRST   [CAIE   A,^J
5447                   JRST  MDOBLP
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
5455         LDB     E,B
5456         MOVEI   A,0
5457         DPB     A,B             ; MAKE THE BUFFER ASCIZ
5458         DBP     B
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 !
5462         LDB     A,B
5463         CAIE    A,"!
5464          JRST   MDDNQ1
5465         SUBI    B,1
5466         DBP     B               ; FLUSH THE !
5467 MDDNQ1: SKIPN   TOERS           ; CAN THE TERMINAL ERASE?
5468          JRST   [OASCR  [ASCIZ /XXXX?/]
5469                  JRST   MDODON] ; NO
5470         JUMPE   D,MDODN3        ; NO CTRL-J'S--STAY ON THIS LINE
5471         CAIN    D,1
5472          JRST   MDODN2          ; ONE CTRL-J
5473         MOVEI   A,(D)
5474         PUSHJ   P,LNSTRV
5475         JRST    MDODON          ; GO CLEAR OUT INPUT BUFFER
5476 MDODN2: SETZM   CHPOS
5477         OHPOS   @CHPOS
5478         OCTLP   "L              ; CLEAR THE LINE
5479         OCTLP   "U              ; AND GO UP
5480 MDODN3: PUSHJ   P,GHPOS
5481         OHPOS   @CHPOS
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
5486         MOVEI   A,0
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
5490         JRST    MDODNL
5491 MDODBT: ADDI    B,1
5492         HRRZS   B
5493         CAIL    B,INPBUF+INPBLN-1       ; POINTING AT LAST WORD OF BUFFER?
5494          JRST   MDODND                  ; YES, DONE
5495         ADDI    B,1
5496         SETZM   (B)
5497         CAIL    B,INPBUF+INPBLN-1       ; IS THE LAST BUFFER WORD THE FIRST TO GO?
5498          JRST   MDODND                  ; YES, SO WE'RE DONE
5499         HRLS    B
5500         ADDI    B,1
5501         BLT     B,INPBUF+INPBLN-1       ; KILL THE REST OF THE BUFFER
5502 MDODND: POP     P,B
5503 MDFLOT: POP     P,E
5504         POP     P,D
5505         POP     P,A
5506         JRST    RCMD1                   ; ALL DONE
5507
5508 ; HACK STRINGS
5509 MDSTRG: SOJLE   C,OVERCL
5510         DBP     B
5511         LDB     A,B
5512         CAIE    A,""
5513          JRST   [CAIE   A,^J
5514                   JRST  MDSTRG
5515                  AOJA   D,MDSTRG]       ; COUNT LF'S
5516         PUSHJ   P,QUOTEQ                ; QUOTED "?
5517          JRST   MDDONQ                  ; NO, SO HAVE A STRING
5518         JRST    MDSTRG
5519 \f
5520 RITBKT: CAIE    A,">
5521          CAIN   A,")
5522           JRST  RITBK1
5523         CAIE    A,"]
5524          CAIN   A,""
5525           JRST  RITBK1
5526         CAIE    A,"}
5527          POPJ   P,                      ; NO CHANCE
5528 RITBK1: PUSHJ   P,QUOTEQ                ; QUOTED?
5529          JRST   POPJ1                   ; NO--REALLY A RIGHT BRACKET
5530         POPJ    P,
5531
5532 LFTBKT: CAIE    A,"<
5533          CAIN   A,"(
5534           JRST  LFTBK1
5535         CAIE    A,"[
5536          CAIN   A,"{
5537           JRST  LFTBK1
5538         POPJ    P,
5539 LFTBK1: PUSHJ   P,QUOTEQ
5540          JRST   POPJ1
5541         POPJ    P,
5542
5543 ; IS THE LEFT BRACKET IN A A MATE FOR THE RIGHT BRACKET IN (BK)?
5544 SAMBKT: PUSH    P,B
5545         CAIN    A,"<
5546          JRST   [MOVEI  B,">
5547                  JRST   SAMBR1]
5548         CAIN    A,"(
5549          JRST   [MOVEI  B,")
5550                  JRST   SAMBR1]
5551         CAIN    A,"[
5552          JRST   [MOVEI  B,"]
5553                  JRST   SAMBR1]
5554         MOVEI   B,"}
5555 SAMBR1: CAMN    B,(BK)
5556          AOS    -1(P)
5557         POP     P,B
5558         POPJ    P,
5559
5560 ; IS THE CHAR IN A QUOTED?
5561 QUOTEQ: PUSH    P,A
5562         PUSH    P,B
5563         PUSH    P,C
5564         PUSH    P,D
5565         MOVEI   D,0                     ; # OF \'S ENCOUNTERED
5566 QUOTEL: SOJLE   C,QUOTEO                ; OUT OF CHARS
5567         DBP     B
5568         LDB     A,B
5569         CAIE    A,"\
5570          JRST   QUOTEO
5571         AOJA    D,QUOTEL                ; AOS THE # OF QUOTES, TRY AGAIN
5572 QUOTEO: JUMPE   D,QUOTDN                ; NONE, SO LEAVE
5573         SOJLE   C,QUOTDC
5574         LDB     A,B
5575         CAIE    A,"!                    ; !\
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
5581 QUOTDN: POP     P,D
5582         POP     P,C
5583         POP     P,B
5584         POP     P,A
5585         POPJ    P,
5586
5587 \f
5588 ; ERROR ROUTINES FOR MUDDLE OBJECT RUBOUT
5589
5590 ; MISMATCHED BRACKETS
5591 MISMAT: SKIPE   MDMISF
5592          JRST   MDMISA                  ; \v AFTER MISMATCH, SO LET IT GO
5593         OCTLP   "S                      ; SAVE CURSOR POSITION
5594         OASC    [ASCIZ  /  /]
5595         OASCI   (A)
5596         OASC    [ASCIZ  / mismatched by /]
5597         OASCI   @(BK)
5598         OCTLP   "R
5599         SETOM   MDMISF
5600 MDERRO: POP     P,C                     ; RESTORE INPUT COUNT
5601         POP     P,B                     ; AND POINTER
5602         POP     P,BK                    ; RESTORE BK STACK
5603         POP     P,E
5604         POP     P,D
5605         POP     P,A
5606         JRST    RCMDER                  ; ERROR LOOP
5607
5608 OVERCL: SETOM   MDOVCF
5609         OCTLP   "S
5610         OASC    [ASCIZ  /  Too many close brackets./]
5611         OCTLP   "R
5612         JRST    MDERRO
5613
5614 PDLOVF: SETOM   MDPDLF
5615         OCTLP   "S
5616         OASC    [ASCIZ  /  \aPDL overflow./]
5617         OCTLP   "R
5618         JRST    MDERRO
5619 \f
5620 SUBTTL  START-UP ROUTINES
5621
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
5625
5626 IFN ITS,[
5627 TTYOPN: .CALL   [SETZ
5628                  SIXBIT /OPEN/
5629                  [.UAI,,TTYI]
5630                  [SIXBIT /TTY/]
5631                  [SIXBIT /TTY/]
5632                  [SIXBIT /TTY/]
5633                  SETZB LSTERR]
5634          .LOSE  1000
5635         .CALL   [SETZ
5636                  SIXBIT /OPEN/
5637                  [.UAO,,TTYO]
5638                  [SIXBIT /TTY/]
5639                  [SIXBIT /TTY/]
5640                  [SIXBIT /TTY/]
5641                  SETZB LSTERR]
5642          .LOSE  1000
5643         .CALL   [SETZ
5644                  'CNSGET
5645                  [TTYO]
5646                  MOVEM ; vsize
5647                  MOVEM ; hsize
5648                  MOVEM ; tctyp
5649                  MOVEM ; ttycom
5650                  MOVEM TTYOPT
5651                  SETZB LSTERR']
5652          .LOSE  1000
5653         .SUSET  [.SIMSK2,,[1_TTYI+1_TTYO]]
5654         .CALL   [SETZ
5655                  SIXBIT /USRVAR/
5656                  MOVEI  %JSELF
5657                  MOVEI  .RTTY
5658                  0
5659                  SETZ   [TLO %TBINF]]
5660          .LOSE  1000
5661         .CALL   TTYSET          ; SET UP TTY TO TAKE CONTROL CHARACTERS
5662          .LOSE  1000
5663         MOVE    A,TTYOPT        ; SET UP RUBOUT HANDLERS
5664         MOVE    [PUSHJ P,RUBECH]
5665         TLNE    A,%TOERS
5666          MOVE   [PUSHJ P,RUBFLS]
5667         MOVEM   XCTRUB
5668         SETZM   TOERS
5669         TLNE    A,%TOERS
5670          SETOM  TOERS
5671         SETZM   TOFCI
5672         TLNE    A,%TOFCI        ; TV KEYBOARD?
5673          SETOM  TOFCI
5674         POPJ    P,
5675
5676 TTYSET: SETZ
5677         SIXBIT /TTYSET/
5678         1000,,TTYI
5679         [030202,,020202]
5680         SETZ [030202,,020202]
5681 ]
5682 IFE ITS,[
5683 TTYOPN: MOVEI   A,.PRIIN
5684         RFMOD
5685         TDO     B,[TT%WKF\TT%WKN\TT%WKP\TT%WKA]
5686         TRZ     B,TT%ECO
5687         SFMOD
5688         MOVEI   A,.PRIIN
5689         MOVEM   A,OUTJFN
5690         MOVEI   A,.FHSLF
5691         MOVE    B,[LEVTAB,,CHNTAB]
5692         SIR
5693         EIR
5694         MOVE    B,[600000,,200000]
5695         AIC
5696         MOVE    A,[.TICCB,,XCBCHN]
5697         ATI
5698         MOVE    A,[.TICCS,,XCSCHN]
5699         ATI
5700         MOVE    [PUSHJ  P,RUBECH]
5701         MOVEM   XCTRUB
5702         POPJ    P,
5703 ]
5704 \f
5705 IFN ITS,[
5706 MSGOPN: SETZ
5707         SIXBIT /OPEN/
5708         MOVSI .BII
5709         MOVEI DSKCHN
5710         [SIXBIT /DSK/]
5711         [SIXBIT /COMBAT/]
5712         [SIXBIT /MESSAG/]
5713         SETZ [SIXBIT /COMBAT/]
5714 ]
5715
5716 MSGRED:
5717 IFN ITS,[
5718         .SUSET  [.RXUNAM,,A]
5719         .CALL   [SETZ
5720                  SIXBIT /OPEN/
5721                  [.BII,,DSKCHN]
5722                  [SIXBIT /DSK/]
5723                  [SIXBIT /.FILE./]
5724                  [SIXBIT /(DIR)/]
5725                  SETZ   A]
5726          OASCR  [ASCIZ  /
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./]
5729         .CLOSE  DSKCHN,
5730         .CALL   MSGOPN
5731          POPJ   P,
5732         MOVE    A,[-177,,INPBUF]        ; READ IN MESSAGE
5733         .IOT    DSKCHN,A
5734         HLRE    O,A                     ; COMPUTE # OF CHARACTERS IN ALL BUT LAST WORD
5735         ADDI    O,176
5736         IMULI   O,5
5737         SOJ     A,
5738         HRLI    A,440700
5739         MOVEI   C,6
5740 MSGRD1: SOJE    C,MSGRD2
5741         ILDB    B,A                     ; MARCH THROUGH LAST WORD LOOKING FOR 3 OR 0
5742         JUMPE   B,MSGRD2
5743         CAIN    B,^C
5744          JRST   MSGRD2
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
5749                  SIXBIT /SIOT/
5750                  [TTYO]
5751                  A
5752                  SETZ   O]
5753          .LOSE  1000
5754         POPJ    P,
5755 ]
5756 IFE ITS,[
5757         POPJ    P,
5758 ]
5759 \f
5760 SUBTTL  PRINT ERROR MESSAGE FOR CHANNELS
5761
5762 ERRPR1: SETOM   ERRCR'
5763 ERRPRT:
5764 IFN ITS,[
5765         .CALL   [SETZ
5766                  SIXBIT /OPEN/
5767                  MOVEI  ERRCHN
5768                  [SIXBIT /ERR/]
5769                  MOVEI  1
5770                  SETZI  0]
5771          .LOSE  1400
5772         MOVE    A,[440700,,INPBUF]
5773         MOVEI   B,INPBLN
5774         .CALL   [SETZ
5775                  SIXBIT /SIOT/
5776                  MOVEI  ERRCHN
5777                  A
5778                  SETZ   B]
5779          .LOSE  1000
5780         .CLOSE  ERRCHN,
5781         MOVEI   O,
5782         DPB     O,A
5783         SKIPN   ERRCR
5784          OASCR  [0]
5785         SETZM   ERRCR
5786         MOVE    A,(P)
5787         OASC    @ERRMSG(A)
5788         OASC    INPBUF
5789         SUB     P,[1,,1]
5790         POPJ    P,
5791 ]
5792 IFE ITS,[
5793 ERRPRT: OASC    [ASCIZ / ERROR - /]
5794         MOVEI   A,.PRIOU
5795         MOVE    B,[SETZ -1]
5796         SETZ    C,
5797         ERSTR
5798          JFCL
5799           JFCL
5800         SUB     P,[1,,1]
5801         POPJ    P,
5802 ]
5803
5804 ERRMSG: ERRMAC  OPNFAL,OPEN FAILED--
5805         ERRMAC  INFFAL,INFERIOR CREATION FAILED--
5806         ERRMAC  RNDFAL,failed--
5807
5808 IFE ITS,[
5809         HALTF
5810 ]
5811 \f
5812 SUBTTL  CORE ALLOCATOR
5813
5814 ;IBLOCK:  TAKES #WORDS IN A, RETURNS POINTER IN A
5815
5816 IFE ITS,[
5817 IBLOCK: PUSH    P,B
5818         PUSH    P,C
5819         MOVE    B,GCSTOP
5820         HRLS    B
5821         ADDI    B,1
5822         SETZM   -1(B)
5823         MOVE    C,GCSTOP
5824         ADDI    C,-1(A)
5825         BLT     B,(C)
5826         POP     P,C
5827         POP     P,B
5828         ADD     A,GCSTOP
5829         EXCH    A,GCSTOP
5830         POPJ    P,
5831 ]
5832
5833 IFN ITS,[
5834 IBLOCK: ADD     A,GCSTOP                ; FIND NEW GCSTOP
5835         CAML    A,FRETOP                ; GREATER THAN FRETOP?
5836          JRST   MORCOR                  ; YES
5837         EXCH    A,GCSTOP                ; OLD GCSTOP IS POINTER TO CORE ALLOCATED
5838         POPJ    P,
5839
5840 ; IF REQUEST BIGGER THAN AVAILABLE CORE, GET ANOTHER PAGE
5841 MORCOR: PUSH    P,B
5842         MOVE    B,FRETOP                ; FIND NEW PAGE NUMBER
5843         LSH     B,-12
5844 %GETIP: .CALL   [SETZ                   ; FOR HYSTERICAL REASONS
5845                  SIXBIT /CORBLK/
5846                  MOVEI  %CBNDW+%CBPRV
5847                  MOVEI  %JSELF
5848                  B
5849                  SETZI  %JSNEW]
5850          FATINS NO CORE AVAILABLE TO SATISFY REQUEST
5851         MOVEI   B,2000
5852         ADDM    B,FRETOP                ; UPDATE FRETOP
5853         POP     P,B
5854         EXCH    A,GCSTOP                ; A NOW HAS POINTER TO CORE, GCSTOP UPDATED
5855         POPJ    P,
5856 ]
5857 \f
5858 SUBTTL  MAINTENANCE
5859
5860 ; QMUNG\eG TO TURN QUESTIONS ON/OFF
5861 QMUNG:  MOVE    P,TOPSTK                ; CONS UP STACK, FREE STORAGE
5862         MOVE    A,MUMBLE
5863         MOVEM   A,GCSTOP
5864 IFN ITS,[
5865         .SUSET  [.RMEMT,,FRETOP]
5866 ]
5867         PUSHJ   P,TTYOPN                ; GET TTY
5868         MOVEI   [ASCIZ  /Question to mung /]
5869         MOVEM   PRMPT1
5870         MOVE    A,[TAILEN+TALSPC,,TAILTB]
5871         PUSHJ   P,COMTYP                ; GET QUESTION
5872         PUSH    P,A
5873         MOVEI   [ASCIZ  /On or off? /]
5874         MOVEM   PRMPT1
5875         MOVE    A,[MUNGLN,,MUNGTB]
5876         PUSHJ   P,COMTYP                ; GET VALUE
5877         POP     P,B
5878         MOVE    C,QTABLE(B)             ; GET QUESTION TABLE SLOT
5879         JUMPE   A,TURNON                ; VALUE IS 0 IF TURN ON
5880         TLO     C,%GIGNO
5881         MOVEM   C,QTABLE(B)
5882 IFN ITS,[
5883         .VALUE
5884 ]
5885 IFE ITS,[
5886         HALTF
5887 ]
5888 TURNON: TLZ     C,%GIGNO
5889         MOVEM   C,QTABLE(B)
5890 IFN ITS,[
5891         .VALUE
5892 ]
5893 IFE ITS,[
5894         HALTF
5895 ]
5896 ; TABLE FOR MUNGER
5897 MUNGTB: SYMVAL  On,0
5898         SYMVAL  Off,1
5899 MUNGLN==MUNGTB-.
5900 \f
5901 SUBTTL  INTERRUPT HANDLER
5902
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.
5908
5909 IFE ITS,[
5910 XCTRLS: SETZM   XCRFLG'
5911 XCTRLB: SETOM   XCRFLG
5912         SAVACS
5913         MOVEI   A,.PRIIN
5914         RFMOD
5915         TRZ     B,TT%ECO
5916         SFMOD                           ; GODDAMN GTJFN!
5917         RSTACS
5918         SKIPN   MCHANG
5919          OASCR  [ASCIZ / Comparison Aborted? /]
5920         JRST    MCMRDR
5921
5922 XINFER: SETOM   MCHANG
5923         AOS     PCLEV2
5924         PUSH    P,A
5925         MOVSI   A,10000                 ; USER MODE BIT
5926         IORM    A,PCLEV2
5927         POP     P,A
5928         DEBRK
5929 ]
5930
5931 IFN ITS,[
5932 TSINT:  0                               ;HERE TO CATCH INTERRUPTS
5933 TSINTR: 0
5934         EXCH    A,TSINT
5935         TLNN    A,400000                ; WORD ONE INTERRUPT?
5936          JRST   FATALS
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
5941         MOVEI   A,TTYI
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?
5947          CAIN   A,^S
5948           JRST  MCMRDR                  ; GO FROB IT
5949         CAIE    A,^L                    ; TO CLEAR SCREEN WHILE MUDCOM RUNNING
5950          JRST   TSOUT
5951         .RESET  TTYI,
5952         SCLEAR
5953         .DISMIS TSINTR                  ; BACK TO HANG
5954 LONGPR: CAIE    A,^S
5955          CAIN   A,^R
5956           CAIA
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
5960         .RESET  TTYI,
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
5965         SETZM   LONGOT
5966         .DISMIS A                       ; AND RETURN
5967
5968 ; COME HERE WITH CTRL-S OR CTRL-R (IN A) IF NOT SET UP TO ABORT PRINTING
5969 ; CLEANLY
5970 SHRTPR: CAIE    A,^S
5971          JRST   SHRCTR                  ; IF NOT CONTROL-S, CAN'T DO MUCH
5972         .RESET  TTYI,
5973         .DISMIS [TOPLEV]
5974 SHRCTR: SKIPN   MDBKSV                  ; IN MIDDLE OF CTRL-K?
5975          JRST   TSOUT                   ; NO, SO FLUSH
5976         .RESET  TTYI,
5977         MOVE    BK,MDBKSV               ; RESTORE BK
5978         SETZM   MDBKSV
5979         .DISMIS [RACK]                  ; GO HACK IT
5980
5981 TSMORE: MOVEI   A,[ASCII /**More**/]
5982         SKIPE   LONGOT
5983          MOVEI  A,[ASCII /--More--/]    ; INTELLIGENT MORE MODE
5984         PUSH    P,B
5985         HRLI    A,440700
5986         MOVEI   B,10
5987         .CALL   TSSIOT                  ; PRINT IT
5988          .LOSE  1000
5989         .CALL   [SETZ
5990                  SIXBIT /FINISH/
5991                  SETZI  TTYO]
5992          JFCL
5993         .CALL   [SETZ
5994                  SIXBIT /IOT/
5995                  MOVSI  %TIPEK+%TIACT+%TIINT
5996                  MOVEI  TTYI
5997                  SETZ   A]
5998          .LOSE  1000
5999         CAIN    A,40                    ; SPACE?
6000           JRST  TSMOR1
6001         CAIN    A,177
6002          .RESET TTYI,                   ; FLUSH RUBOUT
6003         SKIPN   LONGOT
6004          JRST   TSMOR2                  ; IF NOT LONG OUTPUT, JUST CONTINUE
6005         MOVE    A,[440700,,[ASCII /Flushed/]]
6006         MOVEI   B,7
6007         .CALL   TSSIOT
6008          .LOSE  1000
6009         POP     P,B
6010         EXCH    A,TSINT
6011         JRST    LONGP1                  ; AND GO FLUSH IT
6012 TSMOR1: .RESET  TTYI,
6013 TSMOR2: MOVE    A,[440700,,[ASCII /\10T\10L/]]
6014         MOVEI   B,4
6015         .CALL   TSSIOT
6016          .LOSE  1000
6017         POP     P,B
6018         JRST    TSOUT
6019 TSSIOT: SETZ
6020         SIXBIT  /SIOT/
6021         MOVSI   %TJDIS
6022         MOVEI   TTYO
6023         A
6024         SETZ    B
6025
6026 ; WORD ONE INTERRUPTS COME HERE.  TSINT IS IN A
6027
6028 FATALS: TLNE    A,%PJATY
6029          JRST   ATTY
6030         TRNE    A,%PIPDL
6031          JRST   PDLOV
6032         .DISMI  TSINTR
6033
6034 ATTY:   MOVE    A,TSINTR
6035         TLNE    A,%PC1PR
6036          JRST   TSOUT                   ; FLUSH IF SINGLE-STEPPING
6037         SKIPE   DEBUG
6038          JRST   TSOUT                   ; DON'T DO THIS IF DEBUGGING
6039         SKIPN   INREAD                  ; IN READER?
6040          JRST   TSOUT                   ; NO
6041         PUSHJ   P,PPRMPT
6042         OASC    INPBUF
6043         JRST    TSOUT
6044
6045 ; PEOPLE COME HERE IF THE INTERRUPT DOESN'T CAUSE FUNNINESS
6046
6047 UNHANG: SETOM   MCHANG
6048         .DTTY
6049          JFCL
6050         .USET   MCINFO,[.RPIRQ,,A]
6051         TRNN    A,%PIBRK                ; NORMAL DEATH?
6052          JRST   [MOVEI  C,0
6053                  .DISMI [MCERR]]        ; DIED HORRIBLY
6054 TSOUT:  EXCH    A,TSINT
6055         .DISMIS TSINTR
6056
6057 PDLOV:  EXCH    B,TSINTR
6058         HRRZS   B
6059         CAIE    B,MDPDLO                ; LOCATION WHERE 'LEGIT' STACK OVERFLOW CAN GO
6060          FATINS PDL OVERFLOW
6061         EXCH    A,TSINT
6062         EXCH    B,TSINTR
6063         .DISMIS [PDLOVF]                ; GO TO ROUTINE TO FIX IT
6064 ]
6065
6066 ; COME HERE TO VIOLENTLY FLUSH MUDCOM
6067 MCMRDR: SETOM   MCHANG
6068 IFN ITS,[
6069         .UCLOSE MCINFO,                 ; KILL INFERIOR
6070         .RESET  TTYI,                   ; EAT CHARACTER
6071         OASCR   [ASCIZ /
6072 Comparison aborted/]
6073         CAIE    A,^R                    ; CTRL-R?
6074          .DISMIS [TOPLEV]               ; CTRL-S, SO GO TO TOPLEVEL
6075         .DISMIS [RACK]                  ; PRETEND NORMAL CTRL-R
6076 ]
6077 IFE ITS,[
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
6082         SETZM   XCRFLG
6083         MOVEM   A,PCLEV1
6084         MOVE    A,MCHNDL
6085         SKIPN   MCHANG
6086          KFORK
6087         DEBRK                           ; RETURN
6088 ]
6089 \f
6090 SUBTTL  UUOS
6091
6092 ; TYPEOUT UUOS (STRAIGHT FROM DIRED, WITH SOME HELP FROM PDL)
6093
6094 UUOCT==0
6095 UUOTAB: JRST ILUUO
6096         IRPS X,,[OOCT ODEC OBPTR OHPOS OCTLP OSIX OASC OASCI OASCR]
6097         UUOCT==UUOCT+1
6098         X=UUOCT_33
6099         JRST U!X
6100         TERMIN
6101
6102 UUOMAX==.-UUOTAB
6103
6104 UUOH:   0
6105         PUSH    P,A
6106         PUSH    P,B
6107         PUSH    P,C
6108         PUSH    P,D
6109         MOVEI   @40                     ; GET EFF ADDR. OF UUO
6110         MOVEM   UUOE
6111         MOVE    @0
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
6116         CAIL    C,UUOMAX
6117         MOVEI   C,0     ; GRT=>ILLEGAL
6118         JRST    @UUOTAB(C)      ; GO TO PROPER ROUT
6119
6120 UUORET: POP     P,D
6121         POP     P,C
6122         POP     P,B
6123         POP     P,A             ; RESTORE AC'S
6124         JRST    2,@UUOH
6125
6126 ILUUO:  FATINS  ILLEGAL UUO
6127 UOBPTR: MOVEI   C,0
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
6133 UOASC1: MOVEI   A,0
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
6138 UOASCD: POP     P,B
6139         PUSHJ   P,SIOTA         ; SPIT IT OUT
6140         JUMPE   C,UUORET        ; CR NEEDED?
6141         SETZM   XHPOS'
6142         MOVEI   A,2             ; YES
6143         MOVE    B,[440700,,[ASCIZ /
6144 /]]
6145         PUSHJ   P,SIOTA
6146         JRST    UUORET
6147
6148 UOCTLP:
6149 IFN ITS,[
6150         MOVEI   A,^P
6151         PUSHJ   P,IOTAD
6152         MOVE    A,B
6153         PUSHJ   P,IOTAD         ; DISPLAY-MODE IOT
6154 ]
6155         JRST    UUORET
6156
6157 UOASCI: MOVE    A,B             ; PRT ASCII IMMEDIATE
6158         PUSHJ   P,IOTA
6159         JRST    UUORET
6160
6161 UOSIX:  SKIPN   C,UUOD
6162          JRST   UUORET
6163         MOVEI   A,0
6164         MOVE    B,[440700,,UUOSCR]
6165 USXOOP: LDB     D,[360600,,C]
6166         ADDI    D,40
6167         IDPB    D,B
6168         ADDI    A,1
6169         LSH     C,6
6170         JUMPN   C,USXOOP
6171         MOVE    B,[440700,,UUOSCR]
6172         PUSHJ   P,SIOTA
6173         JRST    UUORET
6174
6175 UOHPOS:
6176 IFN ITS,[
6177         MOVEI   A,^P
6178         PUSHJ   P,IOTAD
6179         MOVEI   A,"H
6180         PUSHJ   P,IOTAD
6181         MOVEI   A,10(B)
6182         PUSHJ   P,IOTAD
6183 ]
6184 IFE ITS,[
6185         CAMG    B,XHPOS
6186          JRST   UOHPS1
6187 UOHPSL: CAMG    B,XHPOS
6188          JRST   UUORET
6189         MOVEI   A,40
6190         PUSHJ   P,IOTA
6191         JRST    UOHPSL
6192
6193 UOHPS1: MOVEI   A,^I
6194         PUSHJ   P,IOTA
6195 ]
6196         JRST    UUORET
6197
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
6203 UOOCTI: MOVEI   C,8.
6204         MOVEM   C,BASE
6205         SKIPN   A
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
6210         JRST    UUORET
6211
6212 UONUM:  IDIV    C,BASE
6213         ADDI    D,"0
6214         CAILE   D,"9
6215          ADDI   D,"A-"9-1       ; MAKE HEX DIGIT, IF NOT DECIMAL
6216         DPB     D,B             ; SAVE DIGIT
6217         DBP     B
6218         ADDI    A,1
6219         JUMPN   C,UONUM         ; IF NON-ZERO, STILL CRAP LEFT
6220         PUSHJ   P,SIOTA
6221         POPJ    P,
6222
6223 IOTA:
6224 IFN ITS,[
6225         .IOT OUTCHN,A
6226 ]
6227 IFE ITS,[
6228         MOVE    B,A
6229         MOVE    A,OUTJFN
6230         BOUT
6231 ]
6232         AOS     XHPOS
6233         POPJ P,
6234
6235 IOTAD:
6236 IFN ITS,[
6237         .CALL   [SETZ
6238                  SIXBIT /IOT/
6239                  MOVSI  %TJDIS  ; TURN ON DISPLAY MODE FOR THIS
6240                  MOVEI  OUTCHN
6241                  SETZ   A]
6242          .LOSE  %LSSYS
6243         POPJ    P,
6244 ]
6245 IFE ITS,[
6246         JRST    IOTA
6247 ]
6248
6249 SIOTA:  ADDM    A,XHPOS
6250 IFN ITS,[
6251         .CALL   [SETZ
6252                  SIXBIT /SIOT/
6253                  MOVEI  OUTCHN
6254                  B
6255                  SETZ   A]
6256          .LOSE  %LSSYS
6257 ]
6258 IFE ITS,[
6259         PUSH    P,C
6260         PUSH    P,D
6261         MOVE    C,A
6262         MOVE    A,OUTJFN
6263         SETZ    D,
6264         SOUT
6265         POP     P,D
6266         POP     P,C
6267 ]
6268         POPJ    P,
6269
6270 \f
6271
6272 CONSTA
6273 VARIAB
6274 MUMBLE: GCSBOT
6275 GCSBOT: 0
6276
6277 END     START