<sys.unsupported>/mudcom.mid.118

   1 TITLE MUDCOM  -- MUDDLE SRCCOM  (MARC)
   2
   3 .SYMTAB 8001.
   4
   5 O=0
   6 F=0
   7 A=1
   8 B=2
   9 C=3
  10 D=4
  11 E=5
  12 X=6
  13
  14 ENTPTR=10
  15 MANPTR=11
  16 CMNPTR=12
  17 COMPTR=13
  18
  19 CH=14
  20 TMAX=16
  21
  22 P=17                            ;CANONICAL DM STACK LOCATION
  23
  24
  25 IF1,[ITS==0
  26      PRINTC /MUDCOM for ITS? (Y OR N)/
  27      .TTYMAC A
  28      IFSE A,Y,[ITS==1]
  29      TERMIN
  30 ]
  31 IF1,[
  32   IFE ITS,[
  33         .TNXDF
  34         .DECSAV
  35 ]]
  36
  37
  38
  39 IFN ITS,[
  40 LOC 77
  41 ]
  42 IFE ITS,[
  43 LOC 140
  44 ]
  45 JCLTOP: ASCII   /     /
  46 JCL:    BLOCK   100.
  47 JNAME:  BLOCK   2
  48 JFNBLK: BLOCK   1000.
  49 TIMBLK: BLOCK   3
  50 NBNBLK: BLOCK   25.
  51 GCSTOP: JFNBLK
  52 JCLINB: BLOCK   250.
  53 PDL:    BLOCK   30.
  54 CPDL:   BLOCK   100.
  55 INPBLK: BLOCK   500.
  56 SYLBUF: BLOCK   10.
  57 FTABLE: BLOCK   1200.
  58 PAKBUF: BLOCK   3
  59 ENTBUF: BLOCK   900.
  60 COMBUF: BLOCK   400.
  61 RNDTBL: BLOCK   800.
  62 MANBUF: BLOCK   800.
  63 CMNBUF: BLOCK   400.
  64 DIRPAG: BLOCK   1024.
  65 PATCH:  BLOCK   20.
  66
  67 VERSIO: .FVERS
  68 BLKEND: 0
  69 JFN:    0
  70 F1JFN:  0
  71 F2JFN:  0
  72 F1BLK:  0
  73 F2BLK:  0
  74 F1PTR:  0
  75 F2PTR:  0
  76 FBLOCK: 0
  77 DSKJFN: 0
  78 XTABLE: 0
  79 CMNMAX: -1
  80 CMNFLG: 0
  81 MANFLG: 0
  82 JCLPTR: 0
  83
  84 ; FILE NAME DEFINITIONS
  85
  86 UFN1==0
  87 UFN2==1
  88 UNDATE==3
  89 LUNBLK==5
  90
  91 ; CHANNEL DEFINITIONS
  92
  93 DSK1==0
  94 DSK2==1
  95 TYOC==2
  96 DSKI==3
  97
  98 ; TYPE CODES
  99
 100 DEFMAC==1
 101 SETG==2
 102 MSETG==3
 103 ENTRY==7
 104 PACKAGE==10
 105 ENDPACKAGE==11
 106 RPACKAGE==12
 107 MANIFEST==13
 108
 109 ; FTABLE RECORDS
 110
 111 RECLEN==3
 112
 113 ; ERROR CODES
 114
 115 ESELF==1                                ; SELF COMPARISON
 116 EILLCH==2                               ; ILLEGAL CHARACTER IN FILE NAME
 117 ESYNER==3                               ; SYNTAX ERROR
 118 EOPNFL==4                               ; OPEN FAILED
 119 EINTER==5                               ; INTERNAL BUG IN MUDCOM
 120 ENDIFF==6                               ; NO DIFFERENCES
 121 ENSIM==7                                ; NO SIMILARITIES
 122
 123 ; SEPARATORS
 124
 125 LF==12
 126 FF==14
 127 CR==15
 128 TAB==11
 129
 130 ; TYPE CODES FOR MACRO/MANIFEST HACKS
 131
 132 MACPAD==0
 133 NMNPAD==1
 134 CMNPAD==2
 135 XXXXXX==3               ;DON'T USE THIS!
 136 ASKPAD==4
 137
 138 ; TYPE TABLE
 139
 140 GTYPE:  ASCIZ   /DEFINE/
 141         ASCIZ   /DEFMAC/
 142         ASCIZ   /SETG/
 143         0
 144         ASCIZ   /MSETG/
 145         ASCIZ   /TITLE/
 146         ASCIZ   /SUB-ENTRY/
 147         ASCIZ   /SET/
 148         0
 149         ASCIZ   /ENTRY/
 150         ASCIZ   /PACKAGE/
 151         ASCIZ   /ENDPACKAG/
 152         ASCIZ   /RPACKAGE/
 153         ASCIZ   /MANIFEST/
 154
 155 PTYPE:  ASCIZ   /FUNCTION/
 156         ASCIZ   /MACRO/
 157         ASCIZ   /GVAL/
 158         0
 159         ASCIZ   /MSETG/
 160         ASCIZ   /CRUFTY/
 161         ASCIZ   /CRUFTY/
 162         ASCIZ   /LVAL/
 163         0
 164 PGTYPE: ASCIZ   /FOOBAR/
 165         ASCIZ   /FOOBAR/
 166         ASCIZ   /FOOBAR/
 167         ASCIZ   /FOOBAR/
 168         ASCIZ   /FOOBAR/
 169
 170 NUMTYP==<<PGTYPE-PTYPE>/2>
 171                         ; NUMBER OF OBJECT TYPES INTERESTED IN
 172 MAXTYP==<.-GTYPE>
 173                         ; MUST BE DEFINED BEFORE USED
 174 MXGTYP==5
 175
 176 TBLTOP: RNDTBL
 177 NAME:   0
 178 FNBLKI:
 179 FNAME1: 0
 180         0
 181 FNAME2: SIXBIT  />-1/
 182         SIXBIT  />/
 183 SNAME:  0
 184         0
 185 DEVICE: SIXBIT  /DSK/
 186 FNBLKO: 0
 187
 188 HPOS:   0
 189
 190 SAVBLK: 0
 191         0
 192         SIXBIT  />-1/
 193         SIXBIT  />/
 194         0
 195         0
 196         SIXBIT  /DSK/
 197         0
 198
 199 CHGTOT: BLOCK   NUMTYP
 200 NEWTOT: BLOCK   NUMTYP
 201 REMTOT: BLOCK   NUMTYP
 202 SAMTOT: BLOCK   NUMTYP
 203
 204 ZSTART:
 205 P2SW:   0
 206 P3SW:   0
 207 BIGLOS: 0       ; -1    IF ANY SIMILARITIES ENCOUNTERED
 208 SMALOS: 0       ; -1    IF ANY DIFFERENCES ENCOUNTERED
 209
 210 PRELOD: 0
 211
 212 LSTPTR: 0
 213 LSTTYP: 0
 214
 215 CURCHN: 0
 216
 217 DEPTH:  0
 218
 219 WINNER: 0
 220 SPACSW: 0
 221
 222 CHKSW:  0
 223
 224 COMCNT: 0
 225 PAKSW:  0
 226 RPAKSW: 0
 227 MQUOTE: 0
 228 MMACRO: 0
 229 SKIPPR: 0
 230
 231 TOTSW:  0
 232 GETSW:  0
 233 STRSW:  0
 234 QUOTSW: 0
 235 ENDSW:  0
 236 EXCLSW: 0
 237
 238 ENDFLG: 0
 239 ZFINIS:
 240 LSTFLG: 0
 241
 242
 243 COMSW:  0
 244 ACCPTR: -1
 245 ACCSAV: 0
 246
 247 DEFINE HALT
 248 IFN ITS,[
 249         .BREAK  16,140000
 250 ]
 251 IFE ITS,[
 252         JRST    XHALT
 253 ]
 254 TERMIN
 255
 256 DEFINE  DBP X                           ;DECREMENT BYTE POINTER
 257         ADD     X,[070000,,0]
 258         JUMPGE  X,.+3
 259         SOS     X
 260         HRLI    X,010700
 261 TERMIN
 262
 263 DEFINE  SAFEIN AC,
 264         PUSH    P,A
 265         MOVE    AC,ACCPTR
 266         MOVEM   AC,ACCSAV
 267 TERMIN
 268
 269 DEFINE  SAFEOUT AC,
 270         MOVE    AC,ACCSAV
 271         CAMN    AC,ACCPTR
 272          JRST   .+3
 273         PUSHJ   P,LSTBLK
 274         JRST    .-3
 275         POP     P,A
 276 TERMIN
 277
 278 DEFINE  NXTCHR X
 279         IBP     A
 280         HRRZ    A
 281         CAML    BLKEND
 282          PUSHJ  P,NXTBLK
 283         LDB     X,A
 284         JUMPL   X,EOFERR
 285 TERMIN
 286
 287 DEFINE  COMCHR CHR
 288         MOVEI   CHR
 289         IDPB    COMPTR
 290         AOS     COMCNT
 291 TERMIN
 292
 293 DEFINE  COMAC AC,
 294         IDPB    AC,COMPTR
 295         AOS     COMCNT
 296 TERMIN
 297
 298 DEFINE CHRADD INST,CHR
 299 ZZZ==.
 300         LOC CHRTBL+CHR
 301         JRST INST
 302 LOC ZZZ
 303 TERMIN
 304
 305 \f
 306 SUBTTL CHARACTER TABLE
 307
 308 CHRTBL: REPEAT 200,JFCL
 309
 310 CHRADD PAD,40
 311 CHRADD PAD,TAB
 312 CHRADD PAD,CR
 313 CHRADD PAD,LF
 314 CHRADD PAD,FF
 315 CHRADD PUSHER,"<
 316 CHRADD PUSHER,"(
 317 CHRADD PUSHER,"[
 318 CHRADD PUSHER,"{
 319 CHRADD POPPER,")
 320 CHRADD POPPER,"}
 321 CHRADD POPPER,"]
 322 CHRADD POPPER,">
 323
 324 ;START  OF MUDCOM CODE
 325
 326 IFN ITS,[
 327 START:  CAIA
 328          JRST   COMBAT
 329         .CALL   TTYOPN
 330          .VALUE
 331         .BREAK  12,[5,,JCL]
 332 STARTX: .SUSET  [.RSNAME,,A]
 333         MOVEM   A,SNAME ;DEFAULT THE SNAMES
 334         MOVE    P,[-30,,PDL-1]
 335         .SUSET  [.RJNAME,,B]
 336         PUSHJ   P,JNMCHK
 337         MOVE    MANPTR,[440700,,MANBUF]
 338         MOVE    CMNPTR,[440700,,CMNBUF]
 339         SKIPA   E,[440700,,JCLTOP]
 340 STARTC:  MOVE   E,JCLPTR
 341         SKIPE   FROBSW
 342          JRST   FROBCN
 343         MOVE    ENTPTR,[440700,,ENTBUF]
 344         MOVE    COMPTR,[440700,,COMBUF]
 345         SETZ    D,
 346         PUSHJ   P,FPARSS        ;GET FIRST NAME
 347         PUSH    P,E
 348         PUSHJ   P,FPHACK        ;HACK THE NAME
 349         POP     P,E
 350         .CALL   DSKOPN  ;OPEN A CHANNEL
 351         JRST    OPNFL
 352         .CALL   RCHST   ;GET REAL FILE NAMES
 353          .LOSE  1000
 354         SKIPE   CHKSW
 355          JRST   START1
 356         SKIPE   LSTFLG
 357          JRST   STARTL
 358         MOVEI   D,1
 359         SKIPN   ENDBRK
 360          PUSHJ  P,FPARSS        ;GET SECOND NAME
 361         MOVEM   E,JCLPTR
 362         SKIPN   FNAME1(D)       ;DEFAULT FNAME1 IF NECESSARY
 363          JRST   [MOVE   A,FNAME1
 364                  MOVEM  A,FNAME1(D)
 365                  JRST   .+1]
 366         SKIPN   SNAME(D)  ;DEFAULT SNAME TO FIRST FILE SNAME
 367          JRST   [MOVE   A,SNAME
 368                  MOVEM  A,SNAME(D)
 369                  JRST   .+1]
 370         SKIPN   DEVICE(D)
 371          JRST   [MOVE   A,DEVICE
 372                  MOVEM  A,DEVICE(D)
 373                  JRST   .+1]
 374         PUSHJ   P,FPHACK        ;HACK THE NAME
 375         .CALL   DSKOPN  ;OPEN A CHANNEL
 376          JRST   OPNFL
 377         .CALL   RCHST   ;GET REAL FILE NAMES
 378          .LOSE  1000
 379         MOVE    A,FNAME1        ;SEE IF FIRST NAME IS SECOND NAME
 380         CAME    A,FNAME1+1
 381          JRST   START0
 382         MOVE    A,FNAME2
 383         CAME    A,FNAME2+1
 384          JRST   START0
 385         MOVE    A,SNAME
 386         CAME    A,SNAME+1
 387          JRST   START0
 388         MOVE    A,DEVICE
 389         CAME    A,DEVICE+1
 390          JRST   START0
 391
 392         SETZ    D,              ;SELF COMPARISON???
 393         OASC    [ASCIZ /Asked to compare /]
 394         PUSHJ   P,PFNAME
 395         OASCR   [ASCIZ / with itself?/]
 396         MOVEI   B,ESELF
 397         JRST    LOST
 398
 399 ]
 400 STARTL: OASC    [ASCIZ /Listing /]
 401          CAIA
 402 START1: OASC    [ASCIZ /Checking /]
 403         PUSHJ   P,PFNAME
 404         OASCR   [ASCIZ /./]
 405         JRST    START2
 406
 407 IFE ITS,[
 408 START:  CAIA
 409          SETOM  COMSW
 410         MOVE    P,[-30,,PDL-1]
 411         MOVE    MANPTR,[440700,,MANBUF]
 412         MOVE    CMNPTR,[440700,,CMNBUF]
 413         MOVE    ENTPTR,[440700,,ENTBUF]
 414         MOVE    COMPTR,[440700,,COMBUF]
 415         SETO    A,
 416         MOVE    B,[-1,,E]
 417         MOVEI   C,.JISNM
 418         GETJI
 419          JFCL
 420         MOVE    B,E
 421         PUSHJ   P,JNMCHK
 422 ; IF SNAME IS 0, WILL USE CONNECTED DIRECTORY...
 423 ;       MOVEI   A,15.                   ; GET A BLOCK FOR SNAME
 424 ;       PUSHJ   P,IBLOCK                ; IN A
 425 ;       PUSH    P,A
 426 ;       GJINF
 427 ;       HLL     B,A
 428 ;       HRRO    A,(P)
 429 ;       DIRST                           ; HERE IT IS
 430 ;        JFCL
 431 ;       POP     P,A
 432         SETZM   XSNAME'                 ; GET POINTER TO ASCII SNAME
 433         SETZ    A,
 434         RSCAN
 435          JFCL
 436         JUMPE   A,TTYJCL
 437         MOVN    C,A
 438         MOVEI   A,.PRIIN
 439         MOVE    B,[440700,,JCL]
 440         SIN                             ; READ JCL
 441         MOVE    A,[440700,,JCL]         ; INTO JCL BLOCK
 442         ILDB    B,A                     ; PARSE IT
 443         JUMPE   B,TTYJCL
 444         CAIE    B,40                    ; FIRST FLUSH LEADING 'MUDCOM '
 445          JRST   .-3
 446         MOVEM   A,F1PTR                 ; SAVE POINTER TO FIRST FILE NAME
 447 STT1:   ILDB    B,A
 448         JUMPE   B,TTYJCL                ; FUNNY HACK NOW FOR TTY FNM READING
 449         CAIN    B,"/
 450          PUSHJ  P,XSWTCH
 451         SKIPN   CHKSW
 452          SKIPE  LSTFLG
 453           JRST  STT2
 454         CAIE    B,",                    ; FIND SEPARATOR
 455          JRST   STT1
 456         MOVEI   B,0
 457         DPB     B,A
 458         MOVEM   A,F2PTR                 ; AND POINTER TO SECOND FILE NAME
 459 STT2:   MOVEI   A,GTJFN1
 460         MOVE    B,F1PTR
 461         MOVEM   B,FPTR'
 462         SKIPE   C,XSNAME
 463          HRROM  C,GTJFN1+.GJDIR         ; DEFAULT THE SNAME
 464         MOVE    C,[-1,,[ASCIZ /MUD/]]
 465         MOVEM   C,GTJFN1+.GJEXT         ; AND MUD AS SECOND FILE NAME
 466         MOVSI   C,(GJ%OLD)
 467         MOVEM   C,GTJFN1+.GJGEN
 468         GTJFN                           ; GET THE JFN
 469          JRST   JOPNFL                  ; THIS FILE DOESN'T EXIST -> LOSE
 470         MOVEM   A,F1JFN                 ; SAVE THE JFN
 471         MOVEM   A,JFN
 472         MOVE    B,[440000,,OF%RD]
 473         OPENF                           ; OPEN THE FILE
 474          JRST   JOPNFL                  ; WHY? IF GTJFN WON???
 475         MOVEI   A,F1BLK
 476         MOVEM   A,FBLOCK
 477         PUSHJ   P,XJFNS                 ; PARSE THE NAME AND PUT POINTER IN F1BLK
 478         SKIPE   CHKSW                   ; FUNNYNESS WITH MUDCHK AND MUDLST
 479          JRST   START1
 480         SKIPE   LSTFLG
 481          JRST   STARTL
 482         PUSHJ   P,F1DEF                 ; FILL DEFAULTS
 483         MOVEI   A,GTJFN1
 484         MOVE    B,F2PTR                 ; NOW DO GTJFN, USING DEFAULTS AND JCL
 485         MOVEM   B,FPTR
 486         MOVSI   C,(GJ%OLD)
 487         MOVEM   C,GTJFN1+.GJGEN
 488         GTJFN
 489          JRST   JOPNFL                  ; FILE DOESN'T EXIST
 490 STT3:   MOVEM   A,F2JFN                 ; SAVE JFN HERE ALSO
 491         MOVEM   A,JFN
 492         MOVE    B,[440000,,OF%RD]
 493         OPENF                           ; OPEN THE FILE
 494          JRST   JOPNFL                  ; WHY?
 495         MOVEI   A,F2BLK
 496         MOVEM   A,FBLOCK
 497         PUSHJ   P,XJFNS                 ; PARSE THE FILE NAME AND SAVE IN F2BLK
 498         MOVE    A,F2BLK
 499         MOVE    B,3(A)                  ; GET FILE NAME 2
 500         MOVE    B,(B)                   ; INTO AC
 501         CAME    B,[ASCIZ /MSUBR/]
 502          CAMN   B,[ASCIZ /TEMP/]
 503           JRST  FOONM2
 504         CAME    B,[ASCIZ /MIMA/]
 505          CAMN   B,[ASCIZ /NBIN/]        ; IS THIS NBIN??
 506           JRST  FOONM2
 507         JRST    START0                  ; START THE BALL ROLLING....
 508
 509 ;here to find a MUD older than the file given as second file
 510 FOONM2: MOVE    A,F2JFN
 511         MOVEI   B,TIMBLK
 512         MOVEI   C,2
 513         RFTAD                           ; SAVE CREATION DATE, ETC.
 514         MOVE    A,TIMBLK+.RSCRV
 515         MOVEM   A,NBNTIM'
 516         PUSHJ   P,F1DEF
 517         MOVSI   A,(GJ%OLD+GJ%IFG)
 518         HRRI    A,-3
 519         MOVEM   A,GTJFN1                ; MAKE IT FOO.BAR.*
 520         MOVEI   A,GTJFN1
 521         SETZ    B,
 522         GTJFN                           ; GET INDEXABLE POINTER
 523          HALT
 524         MOVEM   A,JFN                   ; AND SAVE THIS
 525         SETZ    D,
 526 JFNLP:  HRRZS   A                       ; FLUSH BITS
 527         MOVEI   B,TIMBLK
 528         MOVEI   C,2
 529         RFTAD
 530         MOVE    B,TIMBLK+.RSCRV
 531         CAMG    B,NBNTIM
 532          CAMGE  B,BSTTIM'
 533           JRST  NXTJFN
 534         MOVEM   B,BSTTIM
 535         SETZM   NBNBLK
 536         MOVE    B,[NBNBLK,,NBNBLK+1]
 537         BLT     B,NBNBLK+24.
 538         MOVE    B,A
 539         HRROI   A,NBNBLK
 540         SETZ    C,
 541         JFNS
 542 NXTJFN: MOVE    A,JFN
 543         GNJFN
 544          CAIA
 545         JRST    JFNLP
 546
 547         SKIPN   BSTTIM
 548          JRST   NBNLOS
 549         MOVSI   A,(GJ%OLD+GJ%SHT)
 550         HRROI   B,NBNBLK
 551         GTJFN
 552          HALT                           ; WENT AWAY?
 553         MOVEM   A,F2JFN
 554         MOVEM   A,JFN
 555         MOVE    B,[440000,,OF%RD]
 556         OPENF
 557          HALT                           ; WHY?
 558         MOVEI   A,F2BLK
 559         MOVEM   A,FBLOCK
 560         PUSHJ   P,XJFNS                 ; PARSE THE FILE NAME AND SAVE IN F2BLK
 561         JRST    START0
 562
 563 ; FILL DEFAULTS INTO GTJFN BLOCK FROM FILE NAME 1
 564
 565 F1DEF:  MOVEI   B,GTJFN1+.GJDEV
 566 F1DEF1: MOVE    A,F1BLK
 567         HRLI    A,-5
 568         HRRO    C,(A)
 569         MOVEM   C,(B)
 570         AOJ     B,
 571         AOBJN   A,.-3                   ; FILL IN NEW DEFAULTS FROM FILE NAME 1
 572         POPJ    P,
 573
 574 XJFNS:  MOVE    E,[-5,,JFNSBT]          ; AOBJN FOR JFNS'ING
 575         MOVEI   A,6
 576         PUSHJ   P,IBLOCK
 577         MOVEM   A,@FBLOCK
 578         MOVE    X,A
 579         SETZ    D,                      ; D IS ALWAYS 0 FOR JFNS
 580 XASKF1: MOVEI   A,15.
 581         PUSHJ   P,IBLOCK
 582         HRLI    A,15.
 583         MOVEM   A,(X)
 584         HRROS   A                       ; POINTER TO STRING
 585         MOVE    B,JFN                   ; JFN
 586         MOVE    C,(E)                   ; CORRECT BIT FOR PARSING ONE FIELD
 587         JFNS                            ; PARSE THE NAME
 588         AOJ     X,
 589         AOBJN   E,XASKF1                ; UPDATE POINTERS
 590         POPJ    P,
 591
 592 JFNSBT: JS%DEV
 593         JS%DIR
 594         JS%NAM
 595         JS%TYP
 596         JS%GEN
 597
 598 JOPNFL: OASC    [ASCIZ /File not found - /]
 599         MOVE    A,FPTR
 600         OBPTR   A
 601         HALT
 602
 603 JCLLOS: OASCR   [ASCIZ /ERROR - JCL terminated abruptly./]
 604         HALT
 605
 606 GTJFN1: GJ%OLD
 607         .NULIO,,.NULIO
 608         0
 609         0
 610         0
 611         0
 612         0
 613         0
 614         0
 615         0
 616
 617
 618 NOJCL:  OASCR   [ASCIZ /ERROR - JCL must be supplied./]
 619         HALT
 620
 621 ; HERE TO READ STUFF FROM TTY INSTEAD OF JCL LINE
 622 ; MOST OF CODE ABSTRACTED FROM START UP PORTION
 623
 624 TTYJCL: OASC    [ASCIZ /MUDCOM./]
 625         ODEC    VERSIO
 626         OASCR   [0]
 627 TTYJ0:  SKIPE   C,XSNAME
 628          HRROM  C,GTJFN2+.GJDIR
 629         MOVE    C,[-1,,[ASCIZ /MUD/]]
 630         MOVEM   C,GTJFN2+.GJEXT
 631         MOVEI   A,GTJFN2
 632         SETZ    B,
 633         MOVEI   D,.
 634         MOVEM   D,GTACT'
 635         HRROI   C,[ASCIZ /Compare (FILE) /]
 636         MOVEM   C,GTJFN2+.GJRTY
 637         OASC    (C)
 638         MOVSI   D,(GJ%CFM)
 639         ANDCAM  D,GTJFN2+.GJGEN
 640         GTJFN
 641          JRST   TTYJ1
 642         MOVEM   A,JFN
 643         MOVEM   A,F1JFN
 644         MOVE    B,[440000,,OF%RD]
 645         OPENF
 646          HALT
 647         MOVEI   A,F1BLK
 648         MOVEM   A,FBLOCK
 649         PUSHJ   P,XJFNS
 650         MOVEI   B,GTJFN2+.GJDEV
 651         PUSHJ   P,F1DEF1
 652         MOVEI   D,.
 653         MOVEM   D,GTACT
 654         HRROI   C,[ASCIZ / with (FILE) /]
 655         MOVEM   C,GTJFN2+.GJRTY
 656         OASC    (C)
 657         MOVSI   D,(GJ%CFM)
 658         IORM    D,GTJFN2+.GJGEN
 659         MOVEI   A,GTJFN2
 660         SETZ    B,
 661         GTJFN
 662          JRST   TTYJ1
 663         JRST    STT3
 664
 665 TTYJ1:  CAIN    A,GJFX34                ; ? TYPED
 666          JRST   TTYHLP
 667         CAIN    A,GJFX37                ; NULL BUFFER
 668          JRST   TTYNUL
 669         OASC    [ASCIZ / ERROR - /]
 670         MOVEI   A,.PRIOU
 671         MOVE    B,[SETZ -1]
 672         SETZ    C,
 673         ERSTR
 674          JFCL
 675          JFCL
 676         OASCR   [0]
 677         JRST    TTYJ0
 678
 679 TTYHLP: OASCR   [0]
 680         OASCR   [ASCIZ /Type in a file name./]
 681         JRST    @GTACT
 682
 683 TTYNUL: OASCR   [0]
 684         OASCR   [ASCIZ /Flushed?/]
 685         JRST    TTYJ0
 686
 687 GTJFN2: GJ%OLD
 688         .PRIIN,,.PRIOU
 689         0
 690         0
 691         0
 692         0
 693         0
 694         0
 695         0
 696         G1%RND+<20000,,0>+3
 697         0
 698         0
 699         0
 700
 701 XSWTCH: ILDB    B,A
 702         CAIL    B,"a
 703          SUBI   B,40                    ; UPPER CASE
 704         CAIN    B,"T
 705          JRST   [SETOM  TOTSW
 706                  JRST   XSW1]
 707         CAIN    B,"C
 708          JRST   [SETOM  CHKSW
 709                  JRST   XSW1]
 710         CAIN    B,"M
 711          JRST   [SETOM  MANFLG
 712                  JRST   XSW1]
 713         CAIN    B,"L
 714          JRST   [SETOM  LSTFLG
 715                  JRST   XSW1]
 716         OASC    [ASCIZ /Illegal switch in JCL - /]
 717         OASCI   (B)
 718         OASCR   [ASCIZ /./]
 719         POPJ    P,
 720
 721 XSW1:   ILDB    B,A
 722         JUMPE   B,JCLLOS
 723         CAIN    B,40
 724          JRST   XSW1
 725         DBP     A
 726         MOVEM   A,F1PTR
 727         POPJ    P,
 728 ]
 729
 730 JNMCHK: CAMN    B,[SIXBIT       /MUDCHK/]
 731          JRST   [SETOM  CHKSW
 732 IFN ITS,[
 733                  MOVE   A,[SIXBIT />/]
 734                  MOVEM  A,FNAME2
 735 ]
 736                  JRST   .+1]
 737         CAMN    B,[SIXBIT /MUDLST/]
 738          JRST   [SETOM  LSTFLG
 739 IFN ITS,[
 740                  MOVE   A,[SIXBIT />/]
 741                  MOVEM  A,FNAME2
 742 ]
 743                  JRST   .+1]
 744         CAMN    B,[SIXBIT /MUDFND/]
 745          JRST   [MOVE   A,[440700,,JCLTOP]
 746                  MOVEI  B,"(
 747                  IDPB   B,A
 748                  SETOM  FNDFLG'
 749                  JRST   .+1]
 750         POPJ    P,
 751
 752 START0: SETZ    D,              ;PRINT TITLE LINES
 753         MOVEI   A,[ASCIZ /Comparison of /]
 754          SKIPE  PRELOD
 755         MOVEI   A,[ASCIZ /Preload comparison of /]
 756         SKIPN   COMSW
 757          OASC   (A)
 758         PUSHJ   P,PFNAME
 759         OASC    [ASCIZ / and /]
 760         MOVEI   D,1
 761         PUSHJ   P,PFNAME
 762         OASCR   [ASCIZ /./]
 763 START2: MOVEI   A,DSK1
 764         MOVEM   A,CURCHN
 765         MOVE    A,[10700,,BLKEND-1]
 766
 767 ;FIRST PHASE OF COMPARISON, READING IN FIRST FILE
 768
 769 IFE ITS,[
 770         MOVE    A,F1JFN
 771         MOVEM   A,DSKJFN
 772 ]
 773 PASS1:  PUSHJ   P,GETSUM
 774          JRST   PASS02
 775         SKIPE   WINNER
 776          JRST   [MOVEM  B,FTABLE(TMAX)
 777                  AOJA   TMAX,PASS1]
 778         JRST    PASS1
 779
 780 \f
 781 ;SECOND PHASE OF THE COMPARISON, READING SECOND FILE
 782
 783 PASS02:
 784 IFE ITS,[
 785         MOVE    A,F2JFN
 786         MOVEM   A,DSKJFN
 787 ]
 788         SKIPE   FROBSW
 789          JRST   CONTI1
 790         SKIPE   CHKSW
 791          JRST   CHKWIN
 792         SKIPE   LSTFLG
 793          JRST   LSTWIN
 794 ;       SKIPN   MANFLG          ; TAA 5/5/78  SEEMED TO DIE OTHERWISE:  IF
 795 ;        .CLOSE DSK1,           ; CHANGED MANIFEST, WENT TO PASS3 REGARDLESS OF MANFLG
 796         MOVEI   A,DSK2
 797         MOVEM   A,CURCHN
 798         SETOM   P2SW
 799         PUSHJ   P,CLFLAG
 800         PUSHJ   P,NXTBLK
 801         HRLI    A,440700
 802
 803 PASS2:  PUSHJ   P,GETSUM
 804          JRST   PASS3
 805         SKIPN   WINNER
 806          JRST   PASS2
 807         PUSH    P,A
 808         PUSH    P,B
 809         MOVE    A,[440700,,SYLBUF]      ;BUFFER IN A
 810         MOVE    B,LSTTYP        ;TYPE IN B
 811         PUSHJ   P,MATCH
 812          JRST   [PUSHJ  P,NEWOBJ
 813                  JRST   P2ENDR]
 814         SETOM   BIGLOS
 815         CAME    A,(P)   ;CHECKSUM IS IN A. ACCESS POINTER IN B. TYPE IN C
 816          JRST   [PUSHJ  P,CHGOBJ
 817                  JRST   P2ENDR]
 818         AOSA    SAMTOT(C)
 819
 820 P2ENDR: OASCR   [0]
 821 P2END:  POP     P,B
 822         POP     P,A
 823         JRST    PASS2
 824
 825 \f
 826 ;ROUTINES       TO PRINT AND RECORD CHANGES
 827
 828 REMOBJ: HLRZ    C,-1(A)
 829         SETOM   SMALOS
 830         AOS     REMTOT(C)
 831         OASC    [ASCIZ /Removed /]
 832         PUSHJ   P,TYPPRT
 833         MOVE    B,-1(A)
 834         OASCR   (B)
 835         JRST    P3END
 836
 837 CHGOBJ: OASC    [ASCIZ /Changed /]
 838         AOS     CHGTOT(C)
 839         CAIN    C,DEFMAC
 840          PUSHJ  P,MACHAK
 841         CAIN    C,SETG
 842          JRST   [SKIPE  MANFLG
 843                   PUSHJ P,MANCHK
 844                  JRST   .+1]
 845         CAIG    C,1     ;MAKE FUNCTIONS AND MACROS WIN
 846          SKIPN  COMSW
 847           JRST  NEWOB1
 848         PUSH    P,A
 849         PUSH    P,B
 850         PUSH    P,C
 851         MOVE    F,[440700,,SYLBUF]
 852 GH1:    ILDB    A,F
 853         JUMPE   A,GH2
 854         COMAC   A,
 855         JRST    GH1
 856
 857 GH2:    SKIPN   PAKSW
 858          JRST   GH3
 859         PUSHJ   P,ENTLKP
 860          JRST   ADDTR
 861         SKIPN   RPAKSW
 862          JRST   GH3
 863         COMCHR "!
 864         COMCHR "-
 865 GH3:    COMCHR  40
 866         POP     P,C
 867         POP     P,B
 868         POP     P,A
 869         JRST    NEWOB1
 870
 871 ADDTR:  COMCHR "!
 872         COMCHR "-
 873         MOVE    A,[440700,,PAKBUF]
 874 ADDTR1: ILDB    B,A
 875         JUMPE   B,GH3
 876         COMAC   B,
 877         JRST    ADDTR1
 878
 879 NEWOBJ: OASC    [ASCIZ /New /]
 880         AOS     NEWTOT(C)
 881 NEWOB1: SKIPE   CMNFLG
 882          OASC   [ASCIZ /MANIFEST /]
 883         SETZM   CMNFLG
 884         PUSHJ   P,TYPPRT
 885         OASC    SYLBUF
 886         SETOM   SMALOS
 887         POPJ    P,
 888
 889 \f
 890 ;THIRD  GROSS PASS, FOR MANIFEST AND MACRO HACK
 891
 892 PASS3:  SETOM   P3SW
 893         SKIPL   CMNMAX                  ; ONLY IF ONE CHANGED
 894          SKIPL  MANFLG                  ; BETTER BE LOOKING 7/8/78 (MARC)
 895           JRST  PASS4
 896         SETZM   ENDFLG
 897         MOVEI   A,DSK1
 898         MOVEM   A,CURCHN
 899 IFN ITS,[
 900         .ACCESS DSK1,[0]
 901 ]
 902 IFE ITS,[
 903         MOVE    A,F1JFN
 904         SETZ    B,
 905         SFPTR
 906          HALT                           ; WHY CAN'T ACCESS?
 907 ]
 908         MOVE    A,[10700,,BLKEND-1]
 909         PUSHJ   P,ATOM
 910          JRST   PASS4
 911         JRST    .-2
 912
 913 ;FOURTH PASS, FOR REMOVED OBJECTS
 914
 915 PASS4:  MOVEI   A,FTABLE+1
 916         MOVE    B,(A)
 917         JUMPE   B,FINIS
 918         JUMPGE  B,REMOBJ
 919 P3END:  ADDI    A,RECLEN
 920         JRST    PASS4+1
 921
 922 \f
 923 ;FINIS. PRINT SUMMARIES
 924
 925 WINEND: POP     P,
 926         POPJ    P,
 927
 928 CONTIN: OASCR   [0]
 929 CONTI1: PUSHJ   P,CLFLAG
 930         SETZ    TMAX,
 931         MOVE    [SAVBLK,,FNBLKI]
 932         BLT     FNBLKO
 933         SETZM   ZSTART
 934         MOVE    [ZSTART,,ZSTART+1]
 935         BLT     ZFINIS
 936         MOVEI   RNDTBL
 937         MOVEM   TBLTOP
 938 IFN ITS,[
 939         JRST    STARTC
 940 ]
 941 IFE ITS,[
 942         OASC    UNIMPL
 943         HALT
 944 ]
 945
 946 UNIMPL: ASCIZ /Unimplemented on the 20. Sorry./
 947
 948 CLFLAG: SETZM   ENDFLG
 949         SETZM   SPACSW
 950         SETZM   GETSW
 951         SETZM   STRSW
 952         SETZM   QUOTSW
 953         SETZM   ENDSW
 954         SETZM   EXCLSW
 955         SETOM   ACCPTR
 956         POPJ    P,
 957
 958 FINIS:  SKIPE   PRELOD
 959          JRST   CONTIN
 960         SKIPN   BIGLOS          ; SKIP IF ANY SIMILARITIES
 961          JRST   LOSER
 962         SKIPN   SMALOS
 963          JRST   EQUAL
 964         SKIPN   TOTSW
 965          JRST   FINIS1
 966         OASC    [ASCIZ /
 967       FUNCTION  MACRO  GVAL  LVAL
 968 SAME/]
 969         MOVEI   D,SAMTOT
 970         PUSHJ   P,TOTAL
 971         OASC    [ASCIZ /
 972 CHANGED/]
 973         MOVEI   D,CHGTOT
 974         PUSHJ   P,TOTAL
 975         OASC    [ASCIZ /
 976 NEW/]
 977         MOVEI   D,NEWTOT
 978         PUSHJ   P,TOTAL
 979         OASC    [ASCIZ /
 980 REMOVED/]
 981         MOVEI   D,REMTOT
 982         PUSHJ   P,TOTAL
 983 FINIS1: SKIPN   COMSW
 984          HALT                   ;just halt if not under combat
 985
 986         SETZ    A,
 987         SKIPN   B,COMCNT
 988          MOVEI  A,10
 989 IFN ITS,[
 990         MOVEI   C,COMBUF
 991 ]
 992 IFE ITS,[
 993         PUSH    P,A
 994         HRROI   A,COMBUF
 995         RSCAN
 996          JFCL
 997         SETZ    A,
 998         RSCAN
 999          JFCL
1000         POP     P,A
1001 ]
1002         HALT                            ; THIS IS WAY TO END LEGIT
1003
1004 TOTAL:  MOVEI   C,4
1005         HRLI    D,-NUMTYP
1006 TOTLP:  ADDI    C,6
1007         OHPOS   (C)
1008         OALIGN  4,(D)
1009         AOBJN   D,TOTLP
1010         POPJ    P,
1011
1012 EQUAL:  OASC    [ASCIZ /No differences encountered./]
1013         MOVEI   A,6
1014         MOVEI   C,COMBUF
1015         HALT
1016
1017 ;MY     FAVORITE!
1018
1019 LOSER:  OASC    [ASCIZ /No similarities encountered./]
1020         MOVEI   A,7
1021         HALT
1022
1023 CHKWIN: OASC    [ASCIZ /Blessed./]
1024         HALT
1025
1026 LSTWIN: HALT
1027
1028 \f
1029 ;GTNAM  GETS THE NAME OF THE SUBR AND IF IT IS ONE WHICH IS HACKED
1030 ;(E.G.  DEFINE) IT GETS THE NAME OF THE FUNCTION AND PLACES IT IN
1031 ;THE    TABLE WITH THE CORRECT CODE
1032
1033 GTNAM:  AOS     OBJCNT'
1034         PUSH    P,B
1035         PUSH    P,C
1036         PUSH    P,D
1037         PUSH    P,F
1038         MOVE    C,ACCPTR
1039         IMULI   C,500.  ;FIX UP FOR 500 WORD BLOCKS
1040         HRRZ    D,A
1041         ADD     C,D             ;SUBTRACT THE BP
1042         SUBI    C,INPBLK+1
1043         MOVEM   C,LSTPTR        ;AND SAVE IT
1044         MOVE    B,[440700,,SYLBUF]
1045         PUSHJ   P,GETSYL        ;GET FIRST ATOM IN FORM
1046         PUSHJ   P,GETTYP        ;IS IT ONE OF OURS?
1047          JRST   GETEND  ;LOSE
1048         SKIPE   P2SW    ;WINNING ATOM
1049          JRST   GETNP2
1050         HRRZ    B,TBLTOP
1051         HRL     B,F             ;SAVE POINTER TO NAME OF FUNCTION/ATOM
1052         MOVEM   B,FTABLE(TMAX)
1053         MOVE    C,LSTPTR        ;SAVE ACCESS POINTER TO OBJECT
1054         MOVEM   C,FTABLE+1(TMAX)
1055         ADDI    TMAX,2
1056         HRLI    B,440700
1057         PUSH    P,B
1058         PUSH    P,F
1059         PUSHJ   P,GETSYL        ;GET NAME OF FUNCTION/ATOM
1060         POP     P,C
1061         POP     P,D
1062         SKIPE   FROBSW
1063          PUSHJ  P,FROBCH
1064         SKIPN   LSTFLG
1065          JRST   GETNPR
1066         SKIPE   MMACRO
1067          OASC   [ASCIZ /INPUT MACRO /]
1068         PUSHJ   P,TYPPRT        ;PRINT TYPE
1069         OBPTR   D               ;AND NAME
1070         OASCR   [0]
1071 GETNPR: ADDI    B,1
1072         HRRM    B,TBLTOP
1073         SETOM   WINNER  ;MARK THAT WE HAVE WON
1074 GETEND: POP     P,F
1075         POP     P,D
1076         POP     P,C
1077         POP     P,B
1078         POPJ    P,
1079
1080 GETNP2: MOVE    B,[440700,,SYLBUF]
1081         MOVEM   F,LSTTYP
1082         PUSHJ   P,GETSYL        ;GET NAME OF FUNCTION/ATOM AND
1083         SETOM   WINNER  ;LEAVE IT IN SYLBUF
1084         JRST    GETEND
1085
1086 FROBCH: PUSH    P,A
1087         PUSH    P,B
1088         MOVEM   C,LSTTYP
1089         MOVE    A,D
1090         MOVE    B,[440700,,CMNBUF]
1091         MOVEI   3
1092         IDPB    CMNPTR
1093         PUSHJ   P,ATMLKP
1094          JRST   [POP    P,B
1095                  JRST   POPDAJ]
1096         MOVE    C,LSTTYP
1097         PUSHJ   P,TYPPRT
1098         OBPTR   A
1099         OASC    [ASCIZ / in file /]
1100         SETZ    D,
1101         PUSHJ   P,PFNAME
1102         OASCR   [ASCIZ /./]
1103         SOSG    CMNSAV
1104          JRST   [OASCR [ASCIZ /All present and accounted for./]
1105         HALT
1106 ]
1107         POP     P,B
1108         JRST    POPDAJ
1109 \f
1110 ;GETSYL RETURNS A SYLLABLE (ATOM) FROM THE DATA POINTED TO
1111 ;BY     A AND PLACES THE SYLLABLE FOLLOWED BY ASCII 0 IN A LOCATION
1112 ;POINTED        TO BY B
1113
1114 GETSLF: SKIPA   D,[-1]
1115 GETSYL:  SETZ   D,
1116         SETZM   GETSW
1117 GTNAM1: NXTCHR  C
1118         CAIN    C,";
1119          PUSHJ  P,SKPMAN
1120         PUSHJ   P,SEP
1121          JRST   GETSL1
1122         CAIN    C,""
1123          JRST   GETSL1
1124         CAIE    C,"[            ; ALLOW OPEN BRACKETS TO WIN HERE
1125          CAIN   C,"{
1126           JRST  GETSL1
1127         CAIE    C,"(
1128          CAIN   C,"<
1129           JRST  GETSL1
1130         CAIN    C,">
1131          JRST   GETSLE
1132         SETOM   GETSW
1133         IDPB    C,B
1134         JRST    GTNAM1
1135
1136 GETSLE: JUMPN   D,GETSL2
1137 GETSL1: SKIPN   GETSW
1138          JRST   GTNAM1
1139 GETSL2: MOVEI   F,0
1140         IDPB    F,B
1141         DBP     A
1142         POPJ    P,
1143
1144 \f
1145 ;GETTYP CHECKS WHETHER THE SYLLABLE IN SYLBUF MATCHES ANY
1146 ;OF     THE KNOWN TYPES (DEFINE, SETG, ETC..) AND SKIP RETURNS
1147 ;IF     IT DOES.  THE CODE FOR THE MATCHING TYPE IS PLACED IN F.
1148
1149 GETTYP: SETZM   MSTGFL'
1150         PUSH    P,A
1151         MOVEI   A,GTYPE-2
1152         SETO    F,
1153 GETLP1: ADDI    F,1
1154         CAIN    F,MAXTYP
1155          JRST   POPAJ
1156         ADDI    A,2
1157         HRLI    A,440700
1158         MOVE    B,[440700,,SYLBUF]
1159 GETLP2: ILDB    C,A
1160         ILDB    D,B
1161         CAME    C,D
1162          JRST   GETLP1
1163         JUMPE   D,GETLP3
1164         JRST    GETLP2
1165
1166 GETLP3: POP     P,A
1167         SKIPE   P3SW
1168          JRST   [MOVE   B,[440700,,SYLBUF]
1169                  PUSHJ  P,GETSYL
1170                  POPJ   P,]
1171         CAIN    F,MSETG
1172          JRST   [SETOM  MSTGFL
1173                  JRST   MANHAK]
1174         CAIG    F,MXGTYP
1175          JRST   POPJ1
1176         CAIN    F,MANIFEST
1177          JRST   MANHAK
1178         SKIPE   P2SW
1179          POPJ   P,
1180         CAIN    F,ENTRY
1181          JRST   ENTHAK
1182         CAIN    F,PACKAGE
1183          JRST   PAKHAK
1184         CAIN    F,RPACKAGE
1185          JRST   RPAKHK
1186         CAIN    F,ENDPACKAGE
1187          JRST   EPKHAK
1188         POPJ    P,
1189
1190 \f
1191 ;PACKAGE        AND ENTRY HACKERY
1192
1193 ;ENTRY  STATEMENT
1194
1195 ENTHAK: SKIPN   PAKSW
1196          POPJ   P,
1197         SKIPE   MQUOTE
1198          JRST   [SKIPN  SILENT
1199                  OASCR [ASCIZ /Quoted ENTRY statement ignored./]
1200                  POPJ   P,]
1201 ENTHK1: SETOM   FUDGE'
1202 ENTCHR: NXTCHR  B
1203         CAIN    B,";
1204          PUSHJ  P,SKPONE
1205         CAIN    B,">
1206          POPJ   P,
1207         CAIE    B,15
1208          CAIN   B,12
1209           SETZ  B,
1210         CAIE    B,11
1211          CAIN   B,"
1212           SETZ  B,
1213         IDPB    B,ENTPTR
1214         JRST    ENTCHR
1215
1216 MANHAK: SETOM   FUDGE
1217         SAFEIN  B,
1218         PUSHJ   P,MANCHR
1219         SAFEOUT B,
1220         SKIPE   P2SW
1221          JRST   MANHK2
1222
1223 MANHLP: HRRZ    B,TBLTOP
1224         HRLI    B,MANIFEST
1225         MOVE    X,B
1226         HRLI    B,440700
1227         SAFEIN  C,
1228         PUSHJ   P,GETSLF
1229         SKIPN   GETSW
1230          JRST   POPSJ
1231         ADDI    B,1
1232         HRRM    B,TBLTOP
1233         MOVEM   X,FTABLE(TMAX)
1234         SETOM   FTABLE+1(TMAX)
1235         ADDI    TMAX,RECLEN
1236         SKIPE   MSTGFL
1237          JRST   MANHL1
1238         SUB     P,[1,,1]
1239         JRST    MANHLP
1240
1241 POPSJ:  SUB     P,[1,,1]
1242         POPJ    P,
1243
1244 MANHL1: MOVEI   F,SETG
1245         SETZM   FUDGE
1246         SAFEOUT C,
1247         JRST    POPJ1
1248
1249 MANHK2: MOVE    B,[440700,,SYLBUF]
1250         SETZM   FUDGE
1251         PUSHJ   P,GETSLF
1252         SKIPN   GETSW
1253          POPJ   P,
1254         PUSH    P,A
1255         MOVE    A,[440700,,SYLBUF]
1256         MOVEI   B,MANIFEST
1257         PUSHJ   P,MATCH
1258          JRST   [PUSHJ  P,MNFOO
1259                  OASC   [ASCIZ /New MANIFEST /]
1260                  OASCR  SYLBUF
1261                  AOS    CMNMAX
1262                  JRST   .+1]
1263         POP     P,A
1264         SKIPN   MSTGFL
1265          JRST   MANHK2
1266         PUSH    P,A
1267         MOVE    A,[440700,,SYLBUF]
1268         MOVEI   B,SETG
1269         MOVEM   B,LSTTYP
1270         PUSHJ   P,MATCH
1271          JRST   [OASC [ASCIZ /New GVAL /]
1272                  OASCR  SYLBUF
1273                  JRST   POPAJ]
1274         POP     P,A
1275         SUB     P,[1,,1]
1276         SETOM   WINNER
1277         JRST    GETEND
1278
1279 MANCHR: SETZM   MCHRFL'
1280         SETZM   MPADFL'
1281 MANCHL: NXTCHR  B
1282         CAIN    B,";
1283          PUSHJ  P,SKPMAN
1284         CAIN    B,">
1285          JRST   [SETZ   B,
1286                  IDPB   B,MANPTR
1287                  POPJ   P,]
1288         CAIE    B,15
1289          CAIN   B,12
1290           JRST  MPAD
1291         CAIE    B,11
1292          CAIN   B,40
1293           JRST  MPAD
1294         SETOM   MCHRFL
1295         SETZM   MPADFL
1296 MPUT:   IDPB    B,MANPTR
1297         JRST    MANCHL
1298
1299 SKPMAN: MOVEI   B,ATOMSK
1300         MOVEM   B,ACTIV
1301         JRST    SKPHAK
1302
1303 MPAD:   SKIPN   MCHRFL
1304          JRST   MANCHL
1305         SKIPE   MPADFL
1306          JRST   MANCHL
1307         SETOM   MPADFL
1308         SETZ    B,
1309         SKIPN   MSTGFL
1310          JRST   MPUT
1311         IDPB    B,MANPTR
1312         POPJ    P,
1313
1314 MNFOO:  PUSH    P,D
1315         MOVEI   D,NMNPAD
1316         JRST    MACHK1
1317 MACHAK: PUSH    P,D
1318         MOVEI   D,MACPAD
1319 MACHK1: PUSH    P,A
1320         PUSH    P,B
1321         PUSH    P,C
1322         JRST    MANCIN
1323
1324 MANCHK: PUSH    P,D
1325         PUSH    P,A
1326         PUSH    P,B
1327         PUSH    P,C
1328         MOVEI   D,CMNPAD
1329         MOVEI   B,3
1330         IDPB    B,MANPTR
1331         MOVE    B,[440700,,MANBUF]
1332         PUSHJ   P,ENTLIN
1333          JRST   MANOUT
1334         SETOM   CMNFLG
1335 MANCIN: MOVE    A,[440700,,SYLBUF]
1336         MOVE    C,CMNPTR
1337 MANLP:  ILDB    B,A
1338         IDPB    B,CMNPTR
1339         JUMPN   B,MANLP
1340         IDPB    D,CMNPTR
1341         AOS     CMNMAX
1342 MANOUT: POP     P,C
1343         POP     P,B
1344         POP     P,A
1345         POP     P,D
1346         POPJ    P,
1347
1348 ;PACKAGE        STATEMENT
1349
1350 RPAKHK: SETOM   RPAKSW
1351 PAKHAK: SKIPE   MQUOTE
1352          JRST   [SKIPN  SILENT
1353                   OASCR [ASCIZ /Quoted PACKAGE statement ignored./]
1354                  POPJ   P,]
1355         SETOM   PAKSW
1356         PUSH    P,A
1357         MOVE    B,[440700,,PAKBUF]
1358         MOVEI   C,"I
1359         IDPB    C,B
1360         COMCHR ""
1361 PAKHK1: ILDB    C,A
1362         CAIN    C,">
1363          JRST   PAKEND
1364         PUSHJ   P,SEP
1365           JRST  PAKHK1
1366         CAIN    C,""
1367          JRST   PAKHK1
1368         IDPB    C,B
1369         COMAC   C,
1370         JRST    PAKHK1
1371
1372 PAKEND: COMCHR ""
1373         COMCHR  40
1374         SKIPN   RPAKSW
1375          JRST   PENDL1
1376         MOVE    A,[440700,,[ASCIZ /!-RPACKAGE/]]
1377 PENDLP: ILDB    C,A
1378         JUMPE   C,PENDL1
1379         IDPB    C,B
1380         JRST    PENDLP
1381
1382 PENDL1: SETZ    C,
1383         IDPB    C,B
1384         JRST    POPAJ
1385
1386 ;ENDPACKAGE ==> RESET   POINTERS
1387
1388 EPKHAK: SKIPE   MQUOTE
1389          JRST   [SKIPN  SILENT'
1390                   OASCR [ASCIZ /Quoted ENDPACKAGE statement ignored./]
1391                  POPJ   P,]
1392         MOVE    ENTPTR,[440700,,ENTBUF]
1393         SETZM   PAKBUF
1394         SETZM   PAKSW
1395         POPJ    P,
1396
1397 \f
1398 ;ENTRY  LOOKUP FUNCTION. EXPECTS ITEM IN SYLBUF.
1399 ;SKIP   RETURNS IF SUCCESSFUL
1400
1401 ENTLKP: MOVEI   B,3
1402         IDPB    B,ENTPTR
1403         MOVE    B,[440700,,ENTBUF]
1404 ENTLIN: MOVE    A,[440700,,SYLBUF]
1405         PUSH    P,A
1406 ENTL0:  ILDB    D,B
1407         JUMPE   D,.-1
1408         CAIN    D,3
1409          JRST   POPAJ
1410         SKIPA   A,(P)
1411 ENTL1:   ILDB   D,B
1412         ILDB    C,A
1413         CAME    C,D
1414          JRST   ENTL2
1415         CAIE    C,0
1416          JRST   ENTL1
1417         ILDB    C,B
1418         SETOM   MACFLG'
1419         JUMPE   C,.+2
1420          SETZM  MACFLG
1421         JRST    POPAJ1
1422
1423 ENTL2:  ILDB    C,B
1424         JUMPE   C,ENTL0
1425         CAIE    C,3
1426          JRST   ENTL2
1427         JRST    POPAJ
1428
1429 \f
1430 ;MATCHING       ROUTINE.  A IS A BP TO ITEM TO BE SEARCHED FOR. B IS
1431 ;THE    TYPE CODE OF THE ITEM.  MATCH SKIPS IF THE ITEM IS FOUND AND
1432 ;RETURNS        IN A THE CHECKSUM OF THE ITEM.  THE SEARCH ENDS IF ANY
1433 ;TABLE  ENTRY IS NOT GREATER THAN ZERO
1434 ;C,D, AND       E ARE MUNGED
1435
1436 MATCH:  MOVEI   X,FTABLE
1437         PUSH    P,A
1438 MATCH0: SKIPG   C,(X)
1439          JRST   [MOVE   C,B
1440                  JRST   POPAJ]  ;LOST
1441         HLRZ    F,C
1442         CAME    F,B
1443          JRST   MATCH2  ;NOT OF SAME TYPE
1444         HRLI    C,440700        ;D IS BP TO TABLE ENTRY
1445         MOVE    A,(P)
1446 MATCH1: ILDB    D,C     ;GET CHAR FROM TABLE ENTRY
1447         ILDB    E,A     ;GET CHAR FROM SEARCH ITEM
1448         CAME    D,E
1449          JRST   MATCH2  ;NOT EQUAL ==> LOSE
1450         CAIE    E,0     ;BOTH 0 ==> WIN
1451          JRST   MATCH1
1452         POP     P,A
1453         MOVE    A,2(X)  ;MOVE CHECKSUM INTO A
1454         MOVE    C,B     ;TYPE CODE
1455         MOVSI   B,400000
1456         IORB    B,1(X)
1457         JRST    POPJ1   ;RETURN
1458 MATCH2: ADDI    X,RECLEN        ;GO TO NEXT ENTRY
1459         JRST    MATCH0
1460
1461 \f
1462 ;GETSUM CREATES A CHECKSUM FOR THE MUDDLE OBJECT WHICH IS POINTED
1463 ;TO     BY A BP IN A. CHECKSUM IS RETURNED IN B.
1464 ;C      GETS CLOBBERED
1465 ;SKPONE SKIPS OVER ONE MUDDLE OBJECT
1466
1467 SKPONE: MOVEI   B,GETSM1
1468         MOVEM   B,ACTIV
1469
1470 SKPHAK: PUSH    P,DEPTH ;SAVE THE CURRENT DEPTH
1471         SETZM   DEPTH   ;INDICATE TOP LEVEL OBJECT
1472         SETZM   MQUOTE  ;NO QUOTING
1473         SETZM   MMACRO
1474         SETZ    B,
1475         SETOM   SKIPPR  ;SET SKIP FLAG
1476         PUSHJ   P,@ACTIV        ;SKIP THE OBJECT
1477          JFCL           ;EOF.   DONT WORRY
1478         SETZM   SKIPPR
1479         POP     P,DEPTH ;RESTORE THE DEPTH
1480         POPJ    P,              ;AND RETURN
1481
1482 ;FLUSH  TOP LEVEL STRINGS
1483
1484 GETSTT: CAIN    C,""    ; IGNORE STRINGS AT TOP LEVEL
1485          JRST   GETST1
1486         SKIPE   STRSW
1487          JRST   GETST0
1488         CAIE    C,"(
1489          CAIN   C,"{
1490           POPJ  P,
1491         CAIN    C,"[
1492          POPJ   P,
1493         CAIN    C,"'
1494          JRST   [SETOM  MQUOTE
1495                  JRST   GETST0]
1496         CAIN    C,"%
1497          JRST   [SETOM  MMACRO
1498                  JRST   GETST0]
1499         CAIE    C,"<
1500          JRST   [SUB    P,[1,,1]
1501                  JRST   @ACTIV]
1502 GETST0: PUSHJ   P,GTNAM
1503         SETZM   MQUOTE
1504         SETZM   MMACRO
1505         SETZ    B,
1506         SKIPE   FUDGE
1507          MOVEI  C,40
1508         SETZM   FUDGE
1509         POPJ    P,
1510
1511 GETST1: SETCMM  STRSW
1512         SUB     P,[1,,1]
1513         JRST    @ACTIV
1514
1515 ;HERE   TO DO THE CHECKSUMMING
1516
1517 GETSUM: SETZM   WINNER
1518         MOVE    CH,[-100.,,CPDL]
1519         SETZM   DEPTH
1520         MOVEI   X,GETSM1
1521         MOVEM   X,ACTIV'
1522
1523 ;PUSHJ  TO GETSM1 WITH CORRECT HACKS PERFORMED WILL SKIP OVER ONE
1524 ;OBJECT.  SEE   SKPONE.
1525
1526 GETSM1: NXTCHR  C
1527         SKIPN   STRSW
1528          SKIPE  SKIPPR
1529           JRST  GETSM3
1530         SKIPN   DEPTH   ;IF DEPTH=0, FIND NEXT OBJECT
1531          PUSHJ  P,GETSTT        ;START?
1532 GETSM3: SKIPE   QUOTSW
1533          JRST   EXCLQU  ;QUOTE SWITCH SET. CHECK FOR !"\\
1534         CAIN    C,"\
1535          JRST   QUOTER  ;QUOTE ONE CHARACTER
1536         CAIN    C,""
1537          JRST   STRING  ;TOGGLE STRSW AND CHECK FOR !"
1538         CAIN    C,"!
1539          JRST   EXCL    ;TOGGLE EXCLSW
1540         SKIPE   STRSW
1541          JRST   GETSM2  ;INSIDE STRING. IGNORE BRACKETS, ETC..
1542         XCT     CHRTBL(C)
1543 GETSM2: SKIPE   SKIPPR
1544          JRST   SETSM5
1545         ROT     B,7             ;ADD IN THE LUCKY CHARACTER
1546         XOR     B,C
1547 SETSM5: SETZM   QUOTSW  ;CLEAR RANDOM ONCE ONLY SWITCHES
1548         SETZM   EXCLSW
1549         SETZM   SPACSW
1550         JRST    GETSM1  ;NEXT
1551
1552 ;COME   HERE IF QUOTE SWITCH IS SET
1553 ;IF     BOTH EXCL SWITCH IS SET AND CHAR IS \, GO TO QUOTER (E.G. !"\\)
1554 ;ELSE   JUST SNARF ONE CHARACTER AND BE DONE WITH IT
1555
1556 EXCLQU: CAIN    C,"\
1557          SKIPN  EXCLSW
1558           JRST  GETSM2
1559         SETZM   EXCLSW
1560         JRST    QUOTER
1561
1562
1563 ;COME   HERE IF CHARACTER IS A SEPARATOR.
1564 ;FIRST  SEP GOES IN AS A SPACE. REST ARE IGNORED
1565
1566 PAD:    SKIPN   SPACSW  ;HACK SEPARATORS CORRECTLY
1567          JRST   [SETOM  SPACSW
1568                  MOVEI  C,40
1569                  SKIPE  SKIPPR
1570                   JRST  .+3
1571                  ROT    B,7             ;ADD IN THE LUCKY CHARACTER
1572                  XOR    B,C
1573                  SETZM  QUOTSW
1574                  SETZM  EXCLSW
1575                  JRST   GETSM1]
1576         JRST    GETSM1
1577
1578 ;HANDLE EXCL
1579 ;CHECKSUM       THE EXCL AND SET EXCLSW IF NOT IN STRING
1580
1581 EXCL:   SKIPE   SKIPPR
1582          JRST   .+3
1583         ROT     B,7             ;ADD IN THE LUCKY CHARACTER
1584         XOR     B,C
1585         SKIPE   STRSW
1586          JRST   GETSM2
1587         SETOM   EXCLSW
1588         JRST    GETSM1
1589
1590 ;HANDLE STRINGAGE
1591
1592 STRING: SKIPE   EXCLSW
1593          JRST   QUOTER  ;MUST BE !"X
1594         SETCMM  STRSW   ;ELSE TOGGLE STRING MODE
1595         SKIPE   STRSW   ;ENTERING STRING?
1596          JRST   GETSM2  ;YES. CONTINUE.
1597         SKIPN   DEPTH   ;TOP LEVEL STRING?
1598          JRST   POPJ1   ;YES. FINIS.
1599         JRST    GETSM2  ;NO. CONTINUE
1600
1601 ;QUOTE  A CHARACTER
1602
1603 QUOTER: SKIPE   SKIPPR
1604          JRST   .+3
1605         ROT     B,7             ;ADD IN THE LUCKY CHARACTER
1606         XOR     B,C
1607         SETOM   QUOTSW
1608         JRST    GETSM1
1609
1610 ;PUSH   AN CLOSED BRACKET CORRESPONDING TO CHAR IN C ON THE CH STACK
1611 ;ALSO   PUSH AN ACCESS POINTER TO THE CHAR IN CASE OF SYNTAX ERROR
1612
1613 PUSHER: HRLZ    D,ACCPTR
1614         HRR     D,A
1615         PUSH    CH,D
1616         CAIN    C,"<    ;PUSH ONTO CH WHAT WE WANT BACK
1617          PUSH   CH,[">]
1618         CAIN    C,"[
1619          PUSH   CH,["]]
1620         CAIN    C,"(
1621          PUSH   CH,[")]
1622         CAIN    C,"{
1623          PUSH   CH,["}]
1624         AOS     DEPTH   ;INCREMENT DEPTH
1625         JRST    GETSM2
1626
1627 ;HERE   IF CLOSED BRACKET ENCOUNTERED
1628 ;POP    THE CH STACK AND COMPARE TO SEE IF WINNING
1629
1630 POPPER: PUSH    P,B
1631         POP     CH,B
1632         POP     CH,D    ;GET LAST PUSHED CHARACTER
1633         CAME    B,C     ;BETTER BE WHAT WE PUSHED
1634          JRST   SYNERR  ;OH WELL, CANT WILL EM ALL
1635         POP     P,B
1636         SOSLE   DEPTH   ;DECREMENT DEPTH
1637          JRST   GETSM2
1638         SKIPE   SKIPPR
1639          JRST   .+3
1640         ROT     B,7             ;ADD IN THE LUCKY CHARACTER
1641         XOR     B,C
1642         JRST    POPJ1   ;DONE ==> WIN
1643
1644 \f
1645 ;NXTBLK READS IN THE NEXT 500 WORDS OF THE INPUT FILE, AND
1646 ;RETURNS        IN A A BP TO THE TOP OF THE BLOCK
1647
1648 NXTJCL: SKIPA   A,[-500.,,JCLINB]
1649 NXTBLK:  MOVE   A,[-500.,,INPBLK]
1650         MOVE    A
1651         SKIPE   ENDFLG
1652          JRST   EOFERR  ;END OF FILE
1653 IFN ITS,[
1654         .CALL   DSKIOT
1655          .LOSE  1000    ;WHY?
1656         AOS     ACCPTR
1657         JUMPGE  .+2
1658          SETOM  ENDFLG
1659         HRRZM   BLKEND
1660 ]
1661 IFE ITS,[
1662         PUSHJ   P,XIOTI
1663          A
1664          SETOM  ENDFLG
1665         AOS     ACCPTR
1666 ]
1667         MOVE    A,[350700,,INPBLK]
1668         POPJ    P,              ;RETURN BP TO NEW BUFFER IN A
1669
1670 LSTBLK: PUSH    P,A
1671         SOSGE   A,ACCPTR
1672          HALT                   ;HUH?
1673         IMULI   A,500.
1674 IFN ITS,[
1675         .CALL   DSKACC
1676          .LOSE  1000
1677         MOVE    [-500.,,INPBLK]
1678         .CALL   DSKIOT
1679          .LOSE  1000
1680 ]
1681 IFE ITS,[
1682         PUSH    P,B
1683         MOVE    B,A
1684         MOVE    A,DSKJFN
1685         SFPTR
1686          HALT                           ; HUH?
1687         MOVE    A,[-500.,,INPBLK]
1688         PUSHJ   P,XIOTI
1689          A
1690          JFCL
1691 ]
1692         HRRZM   BLKEND
1693         SETZM   ENDFLG
1694         POP     P,B
1695         JRST    POPAJ
1696
1697 \f
1698 ;ERROR  HANDLERS
1699
1700 ILLCHR: OASC    [ASCIZ /ILLEGAL CHARACTER IN FILE NAME/]
1701         MOVEI   B,EILLCH
1702         JRST    LOST
1703
1704 EOFERR: SKIPN   DEPTH
1705          JRST   WINEND
1706         OASC    [ASCIZ /SYNTAX ERROR - EOF INSTEAD OF /]
1707         OASCI   @(CH)
1708         JRST    SYNER1
1709
1710 SYNERR: OASC    [ASCIZ /SYNTAX ERROR /]
1711         OASCI   (C)
1712         OASC    [ASCIZ / INSTEAD OF /]
1713         OASCI   (B)
1714         OASC    [ASCIZ / in /]
1715         SKIPN   CURCHN
1716          JRST   [SKIPN  TMAX
1717                  JRST   SYNLOS
1718                  HLRZ   C,FTABLE-2(TMAX)
1719                  PUSHJ  P,TYPPRT
1720                  MOVE   C,FTABLE-2(TMAX)
1721                  OASC   (C)
1722                  JRST   SYNER1]
1723         MOVE    C,LSTTYP
1724         SKIPN   TMAX
1725          JRST   SYNLOS
1726         PUSHJ   P,TYPPRT
1727         OASC    SYLBUF
1728 SYNER1: OASCR   [ASCIZ /./]
1729         PUSH    P,D
1730         MOVE    D,CURCHN
1731         PUSHJ   P,PFNAME
1732         OASC    [ASCIZ / [LOC=/]
1733         POP     P,D             ; PRINT RANGE OF LOSSAGE
1734         HLRZ    C,D
1735         IMULI   C,500.
1736         ADDI    C,(D)
1737         SUBI    C,INPBLK
1738         IMULI   C,5
1739         ODEC    C
1740         OASCI   ",
1741         MOVE    C,ACCPTR
1742         IMULI   C,500.
1743         ADDI    C,(A)
1744         SUBI    C,INPBLK
1745         IMULI   C,5
1746         ODEC    C
1747         OASCI   "]
1748         SKIPE   FJCLSW
1749          JRST   FSYNER
1750         SKIPE   CHKSW
1751          JRST   CHKLOS
1752         OASC    [ASCIZ /.
1753 Comparison aborted./]
1754         MOVEI   B,ESYNER
1755         JRST    LOST
1756
1757 CHKLOS: OASC    [ASCIZ /.
1758 Check aborted./]
1759         JRST    LOST
1760
1761 SYNLOS: OASC    [ASCIZ /What the hell is this file, FORTRAN?/]
1762         HALT
1763
1764 OPNFL:  OASC    [ASCIZ /Open of /]
1765         PUSHJ   P,PFNAME
1766         OASC    [ASCIZ / failed./]
1767 OPNFL2: MOVEI   B,EOPNFL
1768         JRST    LOST
1769
1770 OPNFL1: OASC    [ASCIZ /Open of the /]
1771         OASC    SNAME(D)
1772         OASC    [ASCIZ / directory failed./]
1773         JRST    OPNFL2
1774
1775 \f
1776 ;RANDOM CALL BLOCKS
1777
1778 TTYOPN: SETZ
1779         SIXBIT  /OPEN/
1780         5000,,4001
1781         MOVEI   TYOC
1782         SETZ    [SIXBIT /TTY/]
1783
1784 DSKOPN: SETZ
1785         SIXBIT /OPEN/
1786         5000,,2
1787         D
1788         DEVICE(D)
1789         FNAME1(D)
1790         FNAME2(D)
1791         SETZ    SNAME(D)
1792
1793 RCHST:  SETZ
1794         SIXBIT /RCHST/
1795         D
1796         MOVEM   DEVICE(D)
1797         MOVEM   FNAME1(D)
1798         MOVEM   FNAME2(D)
1799         SETZM   SNAME(D)
1800
1801 DIROPN: SETZ
1802         SIXBIT /OPEN/
1803         5000,,6
1804         MOVEI   DSKI
1805         DEVICE(D)
1806         [SIXBIT /.FILE./]
1807         [SIXBIT /(DIR)/]
1808         SETZ    SNAME(D)
1809
1810 DIRIOT: SETZ
1811         SIXBIT /IOT/
1812         MOVEI   DSKI
1813         SETZ
1814
1815 DSKACC: SETZ
1816         SIXBIT /ACCESS/
1817         CURCHN
1818         SETZ    A
1819
1820 DSKIOT: SETZ
1821         SIXBIT /IOT/
1822         CURCHN
1823         SETZ
1824
1825 \f
1826 ;RANDOM UTILITY ROUTINES
1827
1828 ;SEP    SKIP RETURNS IF THE CHARACTER IN C IS NOT A SEPARATOR
1829
1830 SEP:    CAIE    C,40
1831          CAIN   C,TAB
1832           POPJ  P,
1833         CAIE    C,CR
1834          CAIN   C,LF
1835           POPJ  P,
1836         CAIN    C,FF
1837          POPJ   P,
1838         JRST    POPJ1
1839
1840 ;TYPPRT PRINTS AN OBJECT TYPE IN C.
1841
1842 TYPPRT: IMULI   C,2
1843         OASC    PTYPE(C)
1844         OASCI   40
1845         POPJ    P,
1846
1847 \f
1848
1849 ;CORE ALLOCATOR OF A SORT
1850
1851 IBLOCK: ADD     A,GCSTOP
1852         EXCH    A,GCSTOP
1853         POPJ    P,
1854
1855 IFE ITS,[
1856
1857 ; THIS IS CRETINOUS, BUT WHAT DO YOU EXPECT FROM DEC SOFTWARE?
1858
1859 XHALT:  HALTF
1860         JRST    XHALT
1861
1862 ; DO TWENEX IOTING
1863 ; IN (P) IS THE WORD WHICH ITS WOULD LIKE
1864
1865 XIOTI:  PUSH    P,[SIN]
1866         CAIA
1867          PUSH   P,[SOUT]
1868 XIOT:   MOVE    O,[A,,XACS]
1869         BLT     O,XACS+2
1870         MOVE    A,-1(P)
1871         MOVE    A,(A)
1872         MOVE    O,XACS-1(A)
1873         MOVE    A,DSKJFN
1874         HRRZ    B,O
1875         TLO     B,444400
1876         HLRE    C,O
1877         PUSH    P,C
1878         XCT     -1(P)
1879         HRRZM   B,BLKEND
1880         AOS     BLKEND                  ;FUCK THIS
1881         CAME    C,(P)
1882          AOS    -2(P)
1883         MOVE    O,[XACS,,A]
1884         BLT     O,C
1885         SUB     P,[2,,2]
1886         JRST    POPJ1
1887
1888 XACS:   BLOCK   3
1889 ]
1890
1891 \f
1892 ;ROUTINE        TO PARSE FILE NAMES (FROM SHARER)
1893
1894 FPARSS: SETZM   ENDSW
1895 FPARSE: SETZM   NAME                    ;CLEAR NAME SLOT
1896         SKIPE   ENDSW
1897          POPJ   P,
1898         MOVE    F,[440600,,NAME]
1899
1900 GETCHR: ILDB    B,E                     ;FIND NEXT NON-EMPTY CHARACTER
1901         CAIE    B,0
1902          CAIN   B,3
1903           JRST  [SKIPN  FJCLSW
1904                   POPJ  P,
1905                  .CLOSE
1906                  SETZM  FJCLSW
1907                  MOVE   E,FJCLPT
1908                  JRST   GETCHR]
1909         CAIE    B,40
1910          CAIN   B,^I
1911           JRST  GETCHR
1912         CAIN    B,"[
1913          JRST   [SETOM  PRELOD
1914                  JRST   GETCHR]
1915         CAIN    B,"(
1916          JRST   [PUSHJ  P,ASKHAK
1917                  SETOM  MANFLG
1918                  JRST   GETCHR]
1919         CAIN    B,"{
1920          JRST   [PUSHJ  P,FROBOZ
1921                  JRST   GETCHR]
1922         CAIN    B,""
1923          JRST   [PUSHJ  P,FILJCL
1924                  JRST   GETCHR]
1925
1926 FIELD:  CAIN    B,^J
1927          POPJ   P,
1928         CAIE    B,40                    ;HERE TO GET A NAME
1929          CAIN   B,^I
1930           JRST  FNAM                    ;SPACE AND TAB MAKE FNAME1 AND 2
1931         CAIE    B,0
1932          CAIN   B,^M
1933           JRST  FNAM                    ;SO DOES 0 AND <CR>
1934         CAIN    B,""
1935          JRST   FNAM
1936         CAIN    B,",
1937          JRST   [SETOM  ENDSW
1938                  JRST   FNAM]
1939         SKIPN   COMSW
1940          JRST   [CAIE   B,"_
1941                   JRST  FIELD1
1942                  SETOM  ENDSW
1943                  JRST   FNAM]
1944 FIELD1: CAIN    B,":
1945          JRST   DEV                     ;DEVICE NAME
1946         CAIE    B,"}
1947          CAIN   B,"]
1948           JRST  [SETOM  ENDSW
1949                  SETOM  ENDBRK'
1950                  JRST   FNAM]
1951         CAIN    B,"/
1952          JRST   SWITCH
1953         CAIN    B,";
1954          JRST   FDIR                    ;SNAME
1955         CAIN    B,^Q                    ;HANDLE QUOTING
1956          ILDB   B,E
1957         CAIGE   B,40                    ;SUBI B,40 < 0 (BAD CHARACTER)
1958          JRST   ILLCHR
1959         SUBI    B,40
1960         CAIL    B,100
1961          SUBI   B,40                    ;CASE CONVERSION
1962         TLNE    F,770000                ;IGNORE MORE THAN 6 CHARACTERS
1963          IDPB   B,F
1964 FPARS2: ILDB    B,E
1965         JRST    FIELD
1966
1967 SWITCH: ILDB    B,E
1968         CAIN    B,"T
1969          SETOM  TOTSW
1970         CAIN    B,"C
1971          SETOM  CHKSW
1972         CAIN    B,"M
1973          SETOM  MANFLG
1974         CAIN    B,"L
1975          SETOM  LSTFLG
1976         JRST    FPARS2
1977
1978 DEV:    MOVE    A,NAME                  ;SAVE DEVICE
1979         MOVEM   A,DEVICE(D)
1980         JRST    FPARSE
1981
1982 FDIR:   MOVE    A,NAME                  ;SAVE SNAME
1983         MOVEM   A,SNAME(D)
1984         JRST    FPARSE
1985
1986 FNAM:   MOVE    A,NAME
1987         JUMPE   A,FPARSE
1988         SKIPE   FNAME1(D)                       ;DOES HE HAVE AN FNAME1 ALREAD?
1989          JRST   FNAM1                   ;YES - OOPS. HE IS GIVING TWO NAMES
1990         MOVEM   A,FNAME1(D)             ;NO - TRY IT AS FNAME1
1991         JRST    FPARSE
1992
1993 FNAM1:  MOVEM   A,FNAME2(D)     ;PUT NEW NAME INTO FNAME2
1994         JRST    FPARSE
1995
1996 ; HERE TO HACK GROSS FIND'AGE IN LIST OF FILES
1997
1998 FROBOZ: SETOM   SILENT
1999         MOVE    CMNMAX
2000         ADDI    1
2001         MOVEM   CMNTOT'
2002         MOVEM   CMNSAV'
2003 FROBCN: SKIPE   ENDBRK
2004          JRST   FROBBD
2005         SKIPE   JCLPTR
2006          MOVE   E,JCLPTR
2007         SETZ    D,
2008         MOVE    A,[SIXBIT />/]
2009         MOVEM   A,FNAME2
2010         SETZM   FNAME1
2011         PUSHJ   P,FPARSS
2012         PUSH    P,E
2013 IFN ITS,[
2014         PUSHJ   P,FPHACK
2015 ]
2016 IFE ITS,[
2017         OASC    UNIMPL
2018         HALT
2019 ]
2020         POP     P,JCLPTR
2021         SKIPN   FNAME1
2022          JRST   FROBCN
2023 IFN ITS,[
2024         .CALL   DSKOPN
2025          JRST   FROBOF
2026         .CALL   RCHST
2027          .LOSE  1000
2028 ]
2029         SETOM   CHKSW
2030         SETOM   FROBSW'
2031         JRST    START2
2032
2033 FSYNER: SUB     P,[1,,1]
2034         OASCR   [0]
2035         JRST    FROBCN
2036
2037 FROBOF: OASC    [ASCIZ /Open of /]
2038         PUSHJ   P,PFNAME
2039         OASCR   [ASCIZ / failed./]
2040         JRST    FROBCN
2041
2042 FROBBD: OASC    [ASCIZ /Found /]
2043         MOVE    A,CMNTOT
2044         SUB     A,CMNSAV
2045         ODEC    A
2046         OASC    [ASCIZ / out of /]
2047         ODEC    CMNTOT
2048         OASCR   [ASCIZ /./]
2049         HALT
2050
2051 ; HERE TO READ JCL FROM A FILE
2052
2053 FILJCL: SKIPE   STRSW
2054          JRST   FILTRM
2055         SETOM   STRSW
2056         MOVE    [SIXBIT />/]
2057         MOVEM   FNAME2
2058         SETZM   JCLPTR
2059         PUSHJ   P,FPARSS
2060         CAIA
2061 FILTRM:  SUB    P,[1,,1]                ; FLUSH THIS PUSHJ TO FPARSS
2062         MOVEM   E,FJCLPT'
2063         SETZ    D,
2064 IFN ITS,[
2065         .CALL   DSKOPN
2066          JRST   FILOPF
2067 ]
2068 IFE ITS,[
2069         OASC    UNIMPL
2070         HALT
2071 ]
2072         PUSHJ   P,NXTJCL
2073         MOVE    E,[440700,,JCLINB]
2074         SETOM   FJCLSW'
2075         POPJ    P,
2076
2077 FILOPF: OASC    [ASCIZ /Open of /]
2078         PUSHJ   P,PFNAME
2079         OASCR   [ASCIZ / failed./]
2080         HALT
2081
2082 ; HERE  TO GET ATOMS FROM JCL TO BE LOOKED FOR
2083
2084 ASKHAK: SETZM   MCHRFL
2085         SETZM   MPADFL
2086         CAIA
2087 ASKCLP:  AOS    CMNMAX
2088         ILDB    C,E
2089         PUSHJ   P,SEP
2090          JRST   ASKSEP
2091         CAIE    C,"{
2092          CAIN   C,")
2093           JRST  ASKSP1
2094         CAIN    C,""
2095          JRST   ASKSP1
2096         SETOM   MCHRFL
2097         SETZM   MPADFL
2098         IDPB    C,CMNPTR
2099         JRST    ASKCLP+1
2100
2101 ASKSEP: SKIPN   MCHRFL
2102          JRST   ASKCLP+1
2103         SKIPE   MPADFL
2104          JRST   ASKCLP+1
2105         SETOM   MPADFL
2106 ASKSP1: SETZ    B,
2107         IDPB    B,CMNPTR
2108         MOVEI   B,ASKPAD
2109         IDPB    B,CMNPTR
2110         CAIN    C,")
2111          POPJ   P,
2112         CAIE    C,"{
2113          CAIN   C,""
2114           CAIA
2115            JRST ASKCLP
2116         DBP     E
2117         POPJ    P,
2118
2119 \f
2120 IFN ITS,[
2121 ;HACK >-1
2122 ;MOST   OF THIS CODE FROM ARCDEV (I.E. FROM ITS)
2123
2124 FPHACK: MOVE    X,FNAME2(D)
2125         MOVE    A,FNAME1(D)
2126         SETZ    B,
2127         SETZ    C,
2128         CAMN    X,[SIXBIT /NBIN/]
2129          JRST   NHAIR
2130 HAIR:   TLNE    X,770000        ;LEFT JUSTIFY
2131          JRST   HAIR1
2132         LSH     X,6
2133         JRST    HAIR
2134 HAIR1:  LDB     F,[301400,,X]
2135         CAMN    F,[SIXBIT /    <+/]
2136          JRST   HAIR2
2137         CAME    F,[SIXBIT /    >-/]
2138          POPJ   P,      ;CAN'T HACK THIS
2139         SETO    C,
2140         LSH     X,6
2141 HAIR2:  LSH     X,6     ;GET RID OF CRUFT
2142         LDB     F,[360600,,X]
2143         JUMPE   F,HAIR3
2144         CAIL    F,'0    ;GET THE ARGUMENT
2145          CAILE  F,'9
2146           JRST  HAIR2
2147         IMULI   B,10
2148         SUBI    F,'0
2149         ADD     B,F
2150         JRST    HAIR2
2151 HAIR3:  SKIPE   C
2152         TLO     B,400000        ;SET BIT
2153
2154 ;4.9    BIT IN B IS SET FOR >
2155 ;RH     OF B IS ARGUMENT FOR THE SEARCH
2156
2157 QLOOK:  MOVE    [-2000,,DIRPAG]
2158         .CALL   DIROPN
2159          JRST   OPNFL1
2160         .CALL   DIRIOT
2161          JRST   LOST0   ;REPORT INTERNAL BUG
2162         .CLOSE  DSKI,
2163 QLOOKR: MOVEI   E,DIRPAG+2000-5
2164         PUSH    P,D
2165         PUSH    P,[-1]  ;BEST INDEX
2166         PUSH    P,[SETZ]        ;BEST "NUMERIC" PART
2167         PUSH    P,[SETZ]        ;BEST ALPHA PART
2168 QLOOK4: CAIGE   E,DIRPAG
2169          JRST   QLOOK2
2170         CAME    A,UFN1(E)
2171          JRST   QLOOK3
2172         SKIPE   X,UFN2(E)
2173 QLOOK6: TRNE    X,77
2174          JRST   QLOOK5
2175         LSH     X,-6
2176         JRST    QLOOK6
2177 QLOOK5: MOVEI   F,0
2178 QLOOK8: LDB     D,[600,,X]
2179         CAIL    D,'0
2180          CAILE  D,'9
2181           JRST  QLOOK7  ;NOT A DIGIT
2182 QLOK5B: TRNE    F,77    ;RIGHT ADJ LOW NON NUM PART
2183          JRST   QLOK5A
2184         LSH     F,-6
2185         JUMPN   F,QLOK5B
2186 QLOK5A: TLC     X,400000        ;AVOID CAM LOSSAGE
2187         TLC     F,400000
2188         SKIPGE -2(P)
2189          JRST   QLOK5D  ;FIRST MATCH
2190         JUMPGE  B,QLOK5E        ;GET LEAST
2191         CAMGE   X,-1(P) ;GET GREATEST
2192          JRST   QLOOK3
2193         CAME    X,-1(P)
2194          JRST   QLOK5D
2195         CAMGE   F,(P)
2196          JRST   QLOOK3  ;NOT AS GOOD
2197 QLOK5D: HRRZM   E,-2(P)
2198         MOVEM   X,-1(P)
2199         MOVEM   F,(P)
2200 QLOOK3: SUBI    E,LUNBLK
2201         JRST    QLOOK4
2202
2203
2204 QLOK5E: CAMLE   X,-1(P)
2205          JRST   QLOOK3
2206         CAME    X,-1(P)
2207          JRST   QLOK5D
2208         CAMLE   F,(P)
2209          JRST   QLOOK3
2210         JRST    QLOK5D
2211
2212 QLOOK7: LSHC    X,-6    ;LOW DIGIT NOT NUMERIC
2213         JUMPN   X,QLOOK8        ;NO NUMERIC DIGITS AT ALL ("BIN", MAYBE?)
2214         JUMPL   B,QLOK5B        ;IF LOOKING FOR GREATEST, LET THIS BE LEAST
2215         MOVNI   X,1     ;GREATEST IF LOOKING FOR LEAST
2216         JRST    QLOK5B
2217
2218 QLOOK2: SUB     P,[1,,1]
2219         POP     P,C             ;BEST "NUMERIC" PART
2220         POP     P,E             ;ADR
2221         JUMPL   E,[POP P,D
2222                    POPJ P,]
2223         HRRZ    D,B
2224         SOJL    D,QFINIS        ;KEEP GOING UNTIL REQUEST IS SATISFIED
2225         POP     P,D
2226         SOJ     B,
2227         MOVE    F,[SIXBIT /!!!!!!/]
2228         MOVEM   F,UFN1(E)       ;MUNGE THE DIRECTORY
2229         JRST    QLOOKR  ;START OVER
2230
2231 QFINIS: POP     P,D             ;DONE!
2232         MOVE    B,UFN2(E)
2233         MOVEM   B,FNAME2(D)
2234         POPJ    P,
2235
2236 ;HERE   TO HACK THE NBIN'AGE
2237
2238 NHAIR:  .CALL   DIROPN
2239          JRST   OPNFL1
2240         MOVE    [-2000,,DIRPAG]
2241         .CALL   DIRIOT
2242          JRST   LOST0
2243         PUSH    P,D
2244         SETZ    C,
2245         MOVEI   E,DIRPAG+2000-5
2246 NBNFND: CAIGE   E,DIRPAG
2247          JRST   NONBIN
2248         MOVE    X,UFN2(E)
2249         CAMN    A,UFN1(E)
2250          CAME   X,[SIXBIT /NBIN/]
2251           JRST  NBNNXT
2252         MOVE    B,UNDATE(E)
2253         SETZ    D,
2254         .CALL   DIROPN          ; OPEN THE CORRECT DIRECTORY
2255          JRST   OPNFL1
2256         MOVE    [-2000,,DIRPAG]
2257         .CALL   DIRIOT
2258          JRST   LOST0
2259         MOVEI   E,DIRPAG+2000-5
2260 NLOOP:  CAIGE   E,DIRPAG
2261          JRST   NDONE
2262         CAME    A,UFN1(E)
2263          JRST   NLNXT
2264         SKIPE   X,UFN2(E)
2265 NLOOP1: TRNE    X,77            ;RIGHT JUSTIFY NAME
2266          JRST   NLOOP2
2267         LSH     X,-6
2268         JRST    NLOOP1
2269 NLOOP2: LDB     D,[600,,X]              ;MAKE SURE NAME ENDS IN NUMERIC
2270         CAIL    D,'0
2271          CAILE  D,'9
2272           JRST  NLNXT
2273 NLOOP3: CAMLE   B,UNDATE(E)     ;COMPARE CREATION DATES
2274          CAML   C,UNDATE(E)
2275           JRST  NLNXT
2276         MOVE    C,UNDATE(E)
2277         MOVE    F,UFN2(E)
2278         JRST    NLNXT
2279
2280 NDONE:  JUMPL   C,NBNLOS
2281         POP     P,D
2282         MOVEM   F,FNAME2(D)
2283         MOVE    F,SNAME
2284         MOVEM   F,SNAME(D)
2285         POPJ    P,
2286
2287 NONBIN: OASC    [ASCIZ /No NBIN file found./]
2288         JRST    OPNFL2
2289
2290 NLNXT:  SUBI    E,LUNBLK
2291         JRST    NLOOP
2292
2293 NBNNXT: SUBI    E,LUNBLK
2294         JRST    NBNFND
2295
2296 ]
2297
2298 NBNLOS: OASC    [ASCIZ /No file created before NBIN./]
2299         JRST    OPNFL2
2300
2301 \f
2302 ;PRINT  A FILE NAME. CHANNEL NUMBER IS IN D
2303
2304 IFN ITS,[
2305 PFNAME: OSIX    DEVICE(D)
2306         OASCI   ":
2307         OSIX    SNAME(D)
2308         OASCI   ";
2309         OSIX    FNAME1(D)
2310         OASCI   "
2311         OSIX    FNAME2(D)
2312         POPJ    P,
2313 ]
2314 IFE ITS,[
2315 PFNAME: MOVE    A,F1BLK(D)
2316         MOVE    B,(A)
2317         OASC    (B)
2318         OASCI   ":
2319         OASCI   "<
2320         MOVE    B,1(A)
2321         OASC    (B)
2322         OASCI   ">
2323         MOVE    B,2(A)
2324         OASC    (B)
2325         OASCI   ".
2326         MOVE    B,3(A)
2327         OASC    (B)
2328         OASCI   ".
2329         MOVE    B,4(A)
2330         OASC    (B)
2331         POPJ    P,
2332 ]
2333 \f
2334 ; TYPEOUT       UUOS (STRAIGHT FROM DIRED, WITH SOME HELP FROM PDL)
2335
2336 ZZZ==.
2337         LOC     40
2338         0
2339         JSR     UUOH
2340         LOC     ZZZ
2341 UUOCT==0
2342 UUOTAB: JRST    ILUUO
2343         IRPS    X,,[ODEC OBPTR OHPOS OCTLP OALIGN OSIX OASC OASCI OASCR OSIXS]
2344         UUOCT==UUOCT+1
2345         X=UUOCT_33
2346         JRST    U!X
2347         TERMIN
2348
2349 UUOMAX==.-UUOTAB
2350
2351 UUOH:   0
2352         PUSH    P,A
2353         PUSH    P,B
2354         PUSH    P,C
2355         PUSH    P,D
2356         MOVEI   @40                     ; GET   EFF ADDR. OF UUO
2357         MOVEM   UUOE'
2358         MOVE    @0
2359         MOVEM   UUOD'                   ; CONTENTS OF EFF ADR
2360         MOVE    B,UUOE                  ; EFF ADR
2361         LDB     A,[270400,,40]          ; GET UUO AC,
2362         LDB     C,[330600,,40]          ; OP CODE
2363         CAIL    C,UUOMAX
2364         MOVEI   C,0     ; GRT=>ILLEGAL
2365         JRST    @UUOTAB(C)      ; GO    TO PROPER ROUT
2366
2367 UUORET: POP     P,D
2368         POP     P,C
2369         POP     P,B
2370         POP     P,A             ; RESTORE AC'S
2371         JRST    2,@UUOH
2372
2373 IFN ITS,[
2374 ILUUO:  .VALUE  [ASCIZ /:\eILLEGAL UUO\e/]
2375 ]
2376 IFE ITS,[
2377 ILUUO:  HALT
2378 ]
2379 UOBPTR: MOVEI   C,0
2380         MOVE    B,UUOD
2381         JRST    UOASC1
2382 UOASCR: SKIPA   C,[^M]  ; CR FOR END OF TYPE
2383 UOASC:  MOVEI   C,0     ; NO CR
2384         HRLI    B,440700        ; MAKE ASCII POINTER
2385 UOASC1: ILDB    A,B     ; GET CHAR
2386         JUMPE   A,.+3   ; FINISH?
2387         PUSHJ   P,IOTA
2388         JRST    .-3     ; AND GET ANOTHER
2389         SKIPN   A,C     ; GET SAVED CR?
2390          JRST   UUORET
2391         PUSHJ   P,IOTA
2392         MOVEI   A,^J
2393         PUSHJ   P,IOTA
2394         JRST    UUORET
2395
2396 UOASCC: HRLI    B,440700        ; MAKE ASCII POINTER
2397 UOAS1C: ILDB    A,B     ; GET CHAR
2398         CAIN    A,^C
2399         JRST    UUORET
2400         PUSHJ   P,IOTA
2401         JRST    UOAS1C  ; AND GET ANOTHER
2402
2403 UOCTLP: MOVEI   A,^P
2404         PUSHJ   P,IOTA1
2405
2406 UOASCI: MOVE    A,B     ; PRT ASCII IMMEDIATE
2407         PUSHJ   P,IOTA
2408         JRST    UUORET
2409
2410 UOSIX:  MOVE    B,UUOD
2411 USXOOP: JUMPE   B,UUORET
2412         LDB     A,[360600,,B]
2413         ADDI    A,40
2414         PUSHJ   P,IOTA
2415         LSH     B,6
2416         JRST    USXOOP
2417
2418 UOSIXS: MOVE    A,[440600,,UUOD]
2419 USLOOP: ILDB    C,A
2420         ADDI    C,40
2421         PUSHJ   P,IOTC
2422         TLNE    A,770000
2423         JRST    USLOOP
2424         JRST    UUORET
2425
2426 UOHPOS: SUB     B,HPOS
2427         JUMPLE  B,UOASCI
2428 UOHPO1: MOVEI   A,40
2429         PUSHJ   P,IOTA
2430         SOJG    B,UOHPO1
2431         JRST    UUORET
2432
2433 POWER:  0 ? 1 ? 10. ? 100. ? 1000. ? 10000. ? 100000. ? 1000000.
2434
2435 UOALIG: MOVE    D,UUOD
2436         ANDI    A,7
2437         MOVE    A,POWER(A)
2438         MOVEI   C,40
2439 UOALI1: CAMLE   A,D
2440         PUSHJ   P,IOTC
2441         IDIVI   A,10.
2442         CAIE    A,1
2443          JRST   UOALI1
2444         SETZ    A,
2445
2446 UODEC:  SKIPA   C,[10.] ; GET BASE FOR DECIMAL
2447 UOOCT:  MOVEI   C,8.    ; OCTAL BASE
2448         MOVE    B,UUOD  ; GET ACTUAL WORD TO PRT
2449         JRST    .+3     ; JOIN CODE
2450 UODECI: SKIPA   C,[10.] ; DECIMAL
2451 UOOCTI: MOVEI   C,8.
2452         MOVEM   C,BASE'
2453         SKIPN   A
2454         HRREI   A,-1    ; A=DIGIT COUNT
2455         PUSHJ   P,UONUM ; PRINT NUMBR
2456         JRST    UUORET
2457
2458 UONUM:  IDIV    B,BASE
2459         HRLM    C,(P)   ; SAVE DIGIT
2460         SOJE    A,UONUM1        ; DONE IF 0
2461         SKIPG   A               ; + => MORE
2462         SKIPE   B               ; - => B=0 => DONE
2463         PUSHJ   P,UONUM ; ELSE MORE
2464 UONUM1: HLRZ    C,(P)   ; RETREIVE DIGITS
2465         ADDI    C,"0    ; MAKE TO ASCII
2466         CAILE   C,"9    ; IS IT GOOD DIG
2467         ADDI    C,"A-"9-1       ; MAKE HEX DIGIT
2468         PUSHJ   P,IOTC
2469         POPJ    P,      ; RET
2470
2471 IOTC:   PUSH    P,A
2472         MOVE    A,C
2473         PUSHJ   P,IOTA
2474         JRST    POPAJ
2475
2476 IOTA:   CAIN    A,^P
2477         JRST    IOTAP
2478 IOTA1:
2479 IFN ITS,[
2480         CAIN    A,^J
2481          POPJ   P,
2482         .IOT    TYOC,A
2483 ]
2484 IFE ITS,[
2485         PBOUT
2486 ]
2487         CAIN    A,^I
2488          JRST   [MOVE   A,HPOS
2489                  ADDI   A,10
2490                  ANDI   A,7770
2491                  MOVEM  A,HPOS
2492                  POPJ   P,]
2493         AOS     HPOS
2494         CAIE    A,^M
2495          POPJ   P,
2496         SETZM   HPOS
2497         POPJ    P,
2498 IOTAP:
2499 IFN ITS,[
2500         .IOT    TYOC,["^]
2501         ADDI    A,100
2502         JRST    IOTA1
2503 ]
2504 IFE ITS,[
2505         POPJ    P,
2506 ]
2507
2508 POPAJ:  POP     P,A
2509         POPJ    P,
2510
2511 IFN ITS,[
2512 COMBAT: SETOM   COMSW
2513         JUMPL   A,COMTTO
2514         .CALL   [SETZ
2515                  SIXBIT /OPEN/
2516                  5000,,1
2517                  MOVEI  TYOC
2518                  SETZ   [SIXBIT /NUL/]]
2519           JRST  LOST0
2520         JRST    STARTX
2521 COMTTO: .CALL   TTYOPN
2522          .VALUE
2523         .CALL   [SETZ
2524                  SIXBIT /TTYGET/
2525                  MOVEI  TYOC
2526                  MOVEM  A
2527                  MOVEM  B
2528                  SETZM  C]
2529          .LOSE  1000
2530         TLO     C,%TSMOR
2531         .CALL   [SETZ
2532                  SIXBIT /TTYSET/
2533                  MOVEI  TYOC
2534                  A
2535                  B
2536                  SETZ   C]
2537          .LOSE  1000
2538         .BREAK  16,100000
2539         JRST    STARTX
2540 ]
2541
2542 LOST0:  MOVEI   B,EINTER
2543 LOST:   SKIPE   COMSW
2544          MOVE   A,B
2545         HALT
2546
2547
2548 ; DISGUSTITUDE, R.E.    MANIFESTS, ETC.
2549
2550 INATOM: 0
2551
2552 ATOM:   SETZM   WINNER
2553         SETZM   DEPTH
2554         MOVEI   ATOM1
2555         MOVEM   ACTIV
2556 ATOMSK: MOVE    CH,[440700,,WRDBUF]
2557 ATOM1:  NXTCHR  C
2558         SKIPE   SKIPPR
2559          JRST   ATOM3
2560         SETOM   FUDGE   ;TAA 5/31/78  OTHERWISE GOT DEPTH COUNT OFF
2561         SKIPN   DEPTH
2562          PUSHJ  P,GETSTT
2563 ATOM3:  SKIPE   QUOTSW
2564          JRST   AEXCLQ  ;QUOTE SWITCH SET. CHECK FOR !"\\
2565         CAIN    C,"\
2566          JRST   AQUOTE  ;QUOTE ONE CHARACTER
2567         CAIN    C,""
2568          JRST   ASTRIN  ;TOGGLE STRSW AND CHECK FOR !"
2569         CAIN    C,"!
2570          JRST   AEXCL   ;TOGGLE EXCLSW
2571         SKIPE   STRSW
2572          JRST   ATOM2   ;INSIDE STRING. IGNORE BRACKETS, ETC..
2573         CAILE   C,40
2574          JRST   ABRACK
2575         CAIE    C,40    ;SEP ROUTINE INCLUDED HERE FOR SPEED
2576          CAIN   C,TAB
2577           JRST  APAD
2578         CAIE    C,CR
2579          CAIN   C,LF
2580           JRST  APAD
2581         CAIN    C,FF
2582          JRST   APAD
2583 ABRACK: CAIE    C,"<    ;DO THE RIGHT THING WITH BRACKETS
2584          CAIN   C,"(
2585           JRST  APUSH
2586         CAIE    C,"[
2587          CAIN   C,"{
2588           JRST  APUSH
2589         CAIE    C,")
2590          CAIN   C,"}
2591           JRST  APOP
2592         CAIE    C,">
2593          CAIN   C,"]
2594           JRST  APOP
2595         CAIN    C,"'
2596          JRST   APAD
2597         CAIN    C,54
2598          JRST   NOATM
2599         CAIE    C,"#
2600          CAIN   C,".
2601           JRST  NOATM
2602 ATMCHR: SETOM   INATOM
2603         IDPB    C,CH
2604 ATOM2:  SETZM   QUOTSW  ;CLEAR RANDOM ONCE ONLY SWITCHES
2605         SETZM   EXCLSW
2606         SETZM   SPACSW
2607         JRST    ATOM1   ;NEXT
2608
2609 NOATM:  SKIPE   INATOM
2610          JRST   ATMCHR
2611         JRST    ATOM2
2612
2613 APUSH:  AOS     DEPTH
2614         JRST    APAD
2615
2616 APOP:   SOSLE   DEPTH
2617          JRST   APAD
2618         JRST    POPJ1
2619
2620 AEXCLQ: CAIN    C,"\
2621          SKIPN  EXCLSW
2622           JRST  ATOM2
2623         SETZM   EXCLSW
2624         JRST    AQUOTE
2625
2626 ;COME   HERE IF CHARACTER IS A SEPARATOR.
2627
2628 APAD:   SKIPE   SPACSW  ;HACK SEPARATORS CORRECTLY
2629          JRST   ATOM1
2630         SETOM   SPACSW
2631         SKIPE   INATOM
2632          PUSHJ  P,ATMHAK
2633 APAD1:  SETZM   INATOM
2634         SETZM   QUOTSW
2635         SETZM   EXCLSW
2636         JRST    ATOM1
2637
2638 ATMHAK: PUSH    P,A
2639         SETZ    B,
2640         IDPB    B,CH
2641         MOVE    B,[440700,,CMNBUF]
2642         MOVE    A,[440700,,WRDBUF]
2643         MOVE    CH,A
2644         SKIPN   WRDBUF
2645          JRST   POPAJ
2646         MOVEI   C,3
2647         IDPB    C,CMNPTR
2648         PUSHJ   P,ATMLKP
2649          JRST   POPDAJ
2650         MOVE    C,LSTTYP
2651         CAILE   C,1
2652          JRST   POPDAJ
2653         MOVE    A,OBJCNT
2654         CAMN    A,OBJSAV'
2655          JRST   POPDAJ
2656         PUSH    P,D
2657         PUSHJ   P,CHGOBJ
2658         MOVEM   A,OBJSAV
2659         POP     P,C
2660         CAIN    C,NMNPAD
2661          MOVEI  A,[ASCIZ / [New MANIFEST = /]
2662         CAIN    C,MACPAD
2663          MOVEI  A,[ASCIZ / [Changed MACRO = /]
2664         CAIN    C,CMNPAD
2665          MOVEI  A,[ASCIZ / [Changed MANIFEST = /]
2666         CAIN    C,ASKPAD
2667          MOVEI  A,[ASCIZ / [Requested ATOM = /]
2668         OASC    (A)
2669         OASC    WRDBUF
2670         OASCR   [ASCIZ /]/]
2671         JRST    POPDAJ
2672
2673 POPDAJ: DBP     CMNPTR
2674         JRST    POPAJ
2675
2676 ; LOOKUP        ROUTINE FOR CHANGED MANIFESTS/MACROS
2677 ; SIMILAR       TO ENTLKP EXCEPT FOR PAD CODES
2678
2679 ATMLKP: PUSH    P,A
2680         ILDB    C,A
2681         JUMPE   C,POPAJ
2682 ATMLP:  ILDB    D,B
2683         CAIN    D,3
2684          JRST   POPAJ
2685         SKIPA   A,(P)
2686 ATMLP1:  ILDB   D,B
2687         ILDB    C,A
2688         CAME    C,D
2689          JRST   ATMLP2
2690         JUMPN   C,ATMLP1
2691         ILDB    D,B
2692 POPAJ1: POP     P,A
2693 POPJ1:  AOS     (P)
2694 CPOPJ:  POPJ    P,
2695
2696 ATMLP2: ILDB    C,B
2697         CAIN    C,3
2698          JRST   POPAJ
2699         JUMPN   C,ATMLP2
2700         ILDB    C,B
2701         JRST    ATMLP
2702
2703 WRDBUF: BLOCK   10.
2704
2705 ;HANDLE EXCL
2706
2707 AEXCL:  SKIPE   STRSW
2708          JRST   ATOM2
2709         SETOM   EXCLSW
2710         JRST    ATOM1
2711
2712 ;HANDLE STRINGAGE
2713
2714 ASTRIN: SKIPE   EXCLSW
2715          JRST   AQUOTE  ;MUST BE !"X
2716         SETCMM  STRSW   ;ELSE TOGGLE STRING MODE
2717         JRST    ATOM2   ;NO. CONTINUE
2718
2719 ;QUOTE  A CHARACTER
2720
2721 AQUOTE: SETOM   QUOTSW
2722         JRST    ATOM1
2723
2724         END     START