<mdl.int>/reader.mid.355

   1
   2 TITLE READER FOR MUDDLE
   3
   4 ;C. REEVE DEC. 1970
   5
   6 RELOCA
   7
   8 READER==1       ;TELL MUDDLE > TO USE SOME SPECIAL HACKS
   9 FRMSIN==1       ;FLAG SAYING WHETHER OR "." AND "'" HACKS EXIST
  10 KILTV==1        ;FLAG SAYING THAT (TVP) SHOULD BE REMOVED (MUDDLE 54 ONLY)
  11
  12 .INSRT MUDDLE >
  13
  14 F==PVP
  15 G==TVP
  16
  17 .GLOBAL CONS,VECTOR,NXTCHR,RLOOKU,CRADIX,SPTIME,QUOTE,CHMAK,FLUSCH,IGET
  18 .GLOBAL SETDEV,OPNCHN,ILVAL,RADX,IDVAL,LSTCH,EVECTOR,EUVECTOR,CHUNW,NONSPC
  19 .GLOBAL CHRWRD,EOFCND,DIRECT,ACCESS,IOINS,ROOT,DIRECT,DOIOTI,DOACCS,IGVAL,BYTDOP
  20 .GLOBAL ICONS,INCONS,IEVECT,IEUVEC,BUFSTR,TYPFND,SQUTOA,SQUKIL,IBLOCK,GRB
  21 .GLOBAL BADCHN,WRONGD,CHNCLS,FNFFL,IPUT,IGET,ILOC,RXCT,WXCT,IUNWIN,UNWIN2
  22 .GLOBAL CNXTCH,CREADC,MPOPJ,CREDC1,CNXTC1,IREMAS,CBYTES,PVSTOR,SPSTOR,DSTORE
  23 .GLOBAL SFIX
  24 .GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10
  25 .GLOBAL C%M20,C%M30,C%M40,C%M60
  26
  27 BUFLNT==100
  28
  29 FF=0    ;FALG REGISTER DURING NUMBER CONVERSION
  30
  31 ;FLAGS USED (RIGHT HALF)
  32
  33 NOTNUM==1       ;NOT A NUMBER
  34 NFIRST==2       ;NOT FIRST CHARACTER BEING READ
  35 DECFRC==4       ;FORCE DECIMAL CONVERSION
  36 NEGF==10        ;NEGATE THIS THING
  37 NUMWIN==20      ;DIGIT(S) SEEN
  38 INSTRN==40      ;IN QUOTED CHARACTER STRING
  39 FLONUM==100     ;NUMBER IS FLOOATING POINT
  40 DOTSEN==200     ;. SEEN IN IMPUT STREAM
  41 EFLG==400       ;E SEEN FOR EXPONENT
  42 FRSDOT==1000                    ;. CAME FIRST
  43 USEAGN==2000                    ;SPECIAL DOT HACK
  44
  45 OCTWIN==4000
  46 OCTSTR==10000
  47 OVFLEW==40000
  48 ENEG==100000
  49 EPOS==200000
  50 ;TEMPORARY OFFSETS
  51
  52 VCNT==0 ;NUMBER OF ELEMENTS IN CURRENT VECTOR
  53 ONUM==-4        ;CURRENT NUMBER IN OCTAL
  54 DNUM==-4        ;CURRENT NUMBER IN DECIMAL
  55 CNUM==-2        ;IN CURRENT RADIX
  56 NDIGS==0        ;NUMBER OF DIGITS
  57 ENUM==-2         ;EXPONENT
  58 NUMTMP==6
  59
  60 ; TABLE OF POWERS OF TEN
  61
  62 TENTAB: REPEAT 39. 10.0^<.RPCNT-1>
  63
  64 ITENTB: REPEAT 11. 10.^<.RPCNT-1>
  65
  66
  67 \f; TEXT FILE LOADING PROGRAM
  68
  69 MFUNCTION MLOAD,SUBR,[LOAD]
  70
  71         ENTRY
  72
  73         HLRZ    A,AB            ;GET NO. OF ARGS
  74         CAIE    A,-4            ;IS IT 2
  75         JRST    TRY2            ;NO, TRY ANOTHER
  76         GETYP   A,2(AB)         ;GET TYPE
  77         CAIE    A,TOBLS         ;IS IT OBLIST
  78         CAIN    A,TLIST         ; OR LIST THEREOF?
  79         JRST    CHECK1
  80         JRST    WTYP2
  81
  82 TRY2:   CAIE    A,-2            ;IS ONE SUPPLIED
  83         JRST    WNA
  84
  85 CHECK1: GETYP   A,(AB)          ;GET TYPE
  86         CAIE    A,TCHAN         ;IS IT A CHANNEL
  87         JRST    WTYP1
  88
  89 LOAD1:  HLRZ    A,TB            ;GET CURRENT TIME
  90         PUSH    TP,$TTIME       ;AND SAVE IT
  91         PUSH    TP,A
  92
  93         MOVEI   C,CLSNGO        ; LOCATION OF FUNNY CLOSER
  94         PUSHJ   P,IUNWIN        ; SET UP AS UNWINDER
  95
  96 LOAD2:  PUSH    TP,(AB)         ;USE SUPPLIED CHANNEL
  97         PUSH    TP,1(AB)
  98         PUSH    TP,(TB)         ;USE TIME AS EOF ARG
  99         PUSH    TP,1(TB)
 100         CAML    AB,C%M20        ; [-2,,0] ;CHECK FOR 2ND ARG
 101         JRST    LOAD3           ;NONE
 102         PUSH    TP,2(AB)        ;PUSH ON 2ND ARG
 103         PUSH    TP,3(AB)
 104         MCALL   3,READ
 105         JRST    CHKRET          ;CHECK FOR EOF RET
 106
 107 LOAD3:  MCALL   2,READ
 108 CHKRET: CAMN    A,(TB)          ;IS TYPE EOF HACK
 109         CAME    B,1(TB)         ;AND IS VALUE
 110         JRST    EVALIT          ;NO, GO EVAL RESULT
 111         PUSH    TP,(AB)
 112         PUSH    TP,1(AB)
 113         MCALL   1,FCLOSE
 114         MOVE    A,$TCHSTR
 115         MOVE    B,CHQUOTE DONE
 116         JRST    FINIS
 117
 118 CLSNGO: PUSH    TP,$TCHAN
 119         PUSH    TP,1(AB)
 120         MCALL   1,FCLOSE
 121         JRST    UNWIN2          ; CONTINUE UNWINDING
 122
 123 EVALIT: PUSH    TP,A
 124         PUSH    TP,B
 125         MCALL   1,EVAL
 126         JRST    LOAD2
 127
 128
 129
 130 ; OTHER FILE LOADING PROGRAM
 131
 132
 133 \f
 134 MFUNCTION FLOAD,SUBR
 135
 136         ENTRY
 137
 138         MOVEI   C,1             ;INITIALIZE OPEN'S ARG COUNT
 139         PUSH    TP,$TAB         ;SLOT FOR SAVED AB
 140         PUSH    TP,C%0          ; [0] ;EMPTY FOR NOW
 141         PUSH    TP,$TCHSTR      ;PUT IN FIRST ARG
 142         PUSH    TP,CHQUOTE READ
 143         MOVE    A,AB            ;COPY OF ARGUMENT POINTER
 144
 145 FARGS:  JUMPGE  A,CALOPN        ;DONE? IF SO CALL OPEN
 146         GETYP   B,(A)           ;NO, CHECK TYPE OF THIS ARG
 147         CAIE    B,TOBLS         ;OBLIST?
 148         CAIN    B,TLIST         ; OR LIST THEREOF
 149         JRST    OBLSV           ;YES, GO SAVE IT
 150
 151         PUSH    TP,(A)          ;SAVE THESE ARGS
 152         PUSH    TP,1(A)
 153         ADD     A,C%22          ; [2,,2] ;BUMP A
 154         AOJA    C,FARGS         ;COUNT AND GO
 155
 156 OBLSV:  MOVEM   A,1(TB) ;SAVE THE AB
 157
 158 CALOPN: ACALL   C,FOPEN         ;OPEN THE FILE
 159
 160         JUMPGE  B,FNFFL ;FILE MUST NO EXIST
 161         EXCH    A,(TB)  ;PLACE CHANNEL ON STACK
 162         EXCH    B,1(TB)         ;OBTAINING POSSIBLE OBLIST
 163         JUMPN   B,2ARGS         ;OBLIST SUOPPLIED?
 164
 165         MCALL   1,MLOAD         ;NO, JUST CALL
 166         JRST    FINIS
 167
 168
 169 2ARGS:  PUSH    TP,(B)          ;PUSH THE OBLIST
 170         PUSH    TP,1(B)
 171         MCALL   2,MLOAD
 172         JRST    FINIS
 173
 174
 175 FNFFL:  PUSH    TP,$TATOM
 176         PUSH    TP,EQUOTE FILE-SYSTEM-ERROR
 177         JUMPE   B,CALER1
 178         PUSH    TP,A
 179         PUSH    TP,B
 180         MOVEI   A,2
 181         JRST    CALER
 182
 183 \fMFUNCTION READ,SUBR
 184
 185         ENTRY
 186
 187         PUSH    P,[SETZ IREAD1] ;WHERE TO GO AFTER BINDING
 188 READ0:  PUSH    TP,$TTP         ;SLOT FOR LAST THING READ (TYPE IS UNREADABLE)
 189         PUSH    TP,C%0
 190         PUSH    TP,$TFIX        ;SLOT FOR RADIX
 191         PUSH    TP,C%0
 192         PUSH    TP,$TCHAN       ;AND SLOT FOR CHANNEL
 193         PUSH    TP,C%0
 194         PUSH    TP,C%0          ; USER DISP SLOT
 195         PUSH    TP,C%0
 196         PUSH    TP,$TSPLICE
 197         PUSH    TP,C%0          ;SEGMENT FOR SPLICING MACROS
 198         JUMPGE  AB,READ1        ;NO ARGS, NO BINDING
 199         GETYP   C,(AB)          ;ISOLATE TYPE
 200         CAIN    C,TUNBOU
 201         JRST    WTYP1
 202         PUSH    TP,[TATOM,,-1]  ;PUSH THE ATOMS
 203         PUSH    TP,IMQUOTE INCHAN
 204         PUSH    TP,(AB)         ;PUSH ARGS
 205         PUSH    TP,1(AB)
 206         PUSH    TP,C%0          ;DUMMY
 207         PUSH    TP,C%0
 208         MOVE    B,1(AB)         ;GET CHANNEL POINTER
 209         ADD     AB,C%22         ;AND ARG POINTER
 210         JUMPGE  AB,BINDEM               ;MORE?
 211         PUSH    TP,[TVEC,,-1]
 212         ADD     B,[EOFCND-1,,EOFCND-1]
 213         PUSH    TP,B
 214         PUSH    TP,(AB)
 215         PUSH    TP,1(AB)
 216         ADD     AB,C%22
 217         JUMPGE  AB,BINDEM               ;IF ANY MORE ARGS GO PROCESS AND BIND THEM
 218         GETYP   C,(AB)          ;ISOLATE TYPE
 219         CAIE    C,TLIST
 220         CAIN    C,TOBLS
 221         SKIPA
 222         JRST    WTYP3
 223         PUSH    TP,[TATOM,,-1]  ;PUSH THE ATOMS
 224         PUSH    TP,IMQUOTE OBLIST
 225         PUSH    TP,(AB)         ;PUSH ARGS
 226         PUSH    TP,1(AB)
 227         PUSH    TP,C%0          ;DUMMY
 228         PUSH    TP,C%0
 229         ADD     AB,C%22         ;AND ARG POINTER
 230         JUMPGE  AB,BINDEM       ; ALL DONE, BIND ATOMS
 231         GETYP   0,(AB)          ; GET TYPE OF TABLE
 232         CAIE    0,TVEC          ; SKIP IF BAD TYPE
 233         JRST    WTYP            ; ELSE COMPLAIN
 234         PUSH    TP,[TATOM,,-1]
 235         PUSH    TP,IMQUOTE READ-TABLE
 236         PUSH    TP,(AB)
 237         PUSH    TP,1(AB)
 238         PUSH    TP,C%0
 239         PUSH    TP,C%0
 240         ADD     AB,C%22         ; BUMP TO NEXT ARG
 241         JUMPL   AB,TMA          ;MORE ?, ERROR
 242 BINDEM: PUSHJ   P,SPECBIND
 243         JRST    READ1
 244
 245 MFUNCTION RREADC,SUBR,READCHR
 246
 247         ENTRY
 248         PUSH    P,[SETZ IREADC]
 249         JRST    READC0          ;GO BIND VARIABLES
 250
 251 MFUNCTION NXTRDC,SUBR,NEXTCHR
 252
 253         ENTRY
 254
 255         PUSH    P,[SETZ INXTRD]
 256 READC0: CAMGE   AB,C%M40        ; [-5,,]
 257         JRST    TMA
 258         PUSH    TP,(AB)
 259         PUSH    TP,1(AB)
 260         JUMPL   AB,READC1
 261         MOVE    B,IMQUOTE INCHAN
 262         PUSHJ   P,IDVAL
 263         GETYP   0,A
 264         CAIE    0,TCHAN
 265         JRST    BADCHN
 266         MOVEM   A,-1(TP)
 267         MOVEM   B,(TP)
 268 READC1: PUSHJ   P,@(P)
 269         JRST    .+2
 270         JRST    FINIS
 271
 272         PUSH    TP,-1(TP)
 273         PUSH    TP,-1(TP)
 274         MCALL   1,FCLOSE
 275         MOVE    A,EOFCND-1(B)
 276         MOVE    B,EOFCND(B)
 277         CAML    AB,C%M20        ; [-3,,]
 278          JRST   .+3
 279         MOVE    A,2(AB)
 280         MOVE    B,3(AB)
 281         PUSH    TP,A
 282         PUSH    TP,B
 283         MCALL   1,EVAL
 284         JRST    FINIS
 285
 286
 287 MFUNCTION PARSE,SUBR
 288
 289         ENTRY
 290
 291         PUSHJ   P,GAPRS         ;GET ARGS FOR PARSES
 292         PUSHJ   P,GPT           ;GET THE PARSE TABLE
 293         PUSHJ   P,NXTCH         ; GET A CHAR TO TEST FOR ! ALT
 294         SKIPN   11.(TB)         ; EOF HIT, COMPLAIN TO LOOSER
 295         JRST    NOPRS
 296         MOVEI   A,33            ; CHANGE IT TO AN ALT, SNEAKY HUH?
 297         CAIN    B,MANYT         ; TYPE OF MULTIPLE CLOSE, I.E. ! ALT
 298         MOVEM   A,5(TB)
 299         PUSHJ   P,IREAD1        ;GO DO THE READING
 300         JRST    .+2
 301         JRST    LPSRET          ;PROPER EXIT
 302 NOPRS:  ERRUUO  EQUOTE CAN'T-PARSE
 303
 304 MFUNCTION LPARSE,SUBR
 305
 306         ENTRY
 307
 308         PUSHJ   P,GAPRS         ;GET THE ARGS TO THE PARSE
 309         JRST    LPRS1
 310
 311 GAPRS:  PUSH    TP,$TTP
 312         PUSH    TP,C%0
 313         PUSH    TP,$TFIX
 314         PUSH    TP,[10.]
 315         PUSH    TP,$TFIX
 316         PUSH    TP,C%0          ; LETTER SAVE
 317         PUSH    TP,C%0
 318         PUSH    TP,C%0          ; PARSE TABLE MAYBE?
 319         PUSH    TP,$TSPLICE
 320         PUSH    TP,C%0          ;SEGMENT FOR SPLICING MACROS
 321         PUSH    TP,C%0          ;SLOT FOR LOCATIVE TO STRING
 322         PUSH    TP,C%0
 323         JUMPGE  AB,USPSTR
 324         PUSH    TP,[TATOM,,-1]
 325         PUSH    TP,IMQUOTE PARSE-STRING
 326         PUSH    TP,(AB)
 327         PUSH    TP,1(AB)        ; BIND OLD PARSE-STRING
 328         PUSH    TP,C%0
 329         PUSH    TP,C%0
 330         PUSHJ   P,SPECBIND
 331         ADD     AB,C%22
 332         JUMPGE  AB,USPSTR
 333         GETYP   0,(AB)
 334         CAIE    0,TFIX
 335         JRST    WTYP2
 336         MOVE    0,1(AB)
 337         MOVEM   0,3(TB)
 338         ADD     AB,C%22
 339         JUMPGE  AB,USPSTR
 340         GETYP   0,(AB)
 341         CAIE    0,TLIST
 342         CAIN    0,TOBLS
 343         SKIPA
 344         JRST    WTYP3
 345         PUSH    TP,[TATOM,,-1]
 346         PUSH    TP,IMQUOTE OBLIST
 347         PUSH    TP,(AB)
 348         PUSH    TP,1(AB)        ; HE WANTS HIS OWN OBLIST
 349         PUSH    TP,C%0
 350         PUSH    TP,C%0
 351         PUSHJ   P,SPECBIND
 352         ADD     AB,C%22
 353         JUMPGE  AB,USPSTR
 354         GETYP   0,(AB)
 355         CAIE    0,TVEC
 356         JRST    WTYP
 357         PUSH    TP,[TATOM,,-1]
 358         PUSH    TP,IMQUOTE PARSE-TABLE
 359         PUSH    TP,(AB)
 360         PUSH    TP,1(AB)
 361         PUSH    TP,C%0
 362         PUSH    TP,C%0
 363         PUSHJ   P,SPECBIND
 364         ADD     AB,C%22
 365         JUMPGE  AB,USPSTR
 366         GETYP   0,(AB)
 367         CAIE    0,TCHRS
 368         JRST    WTYP
 369         MOVE    0,1(AB)
 370         MOVEM   0,5(TB)         ; STUFF IN A LOOK-AHEAD CHARACTER IF HE WANTS
 371         ADD     AB,C%22
 372         JUMPL   AB,TMA
 373 USPSTR: MOVE    B,IMQUOTE PARSE-STRING
 374         PUSHJ   P,ILOC          ; GET A LOCATIVE TO THE STRING, WHEREVER
 375         GETYP   0,A
 376         CAIN    0,TUNBOUND      ; NONEXISTANT
 377         JRST    BDPSTR
 378         GETYP   0,(B)           ; IT IS POINTING TO A STRING
 379         CAIE    0,TCHSTR
 380         JRST    BDPSTR
 381         MOVEM   A,10.(TB)
 382         MOVEM   B,11.(TB)
 383         POPJ    P,
 384
 385 LPRS1:  PUSHJ   P,GPT           ; GET THE VALUE OF PARSE-TABLE IN SLOT
 386         PUSH    TP,$TLIST
 387         PUSH    TP,C%0          ; HERE WE ARE MAKE PLACE TO SAVE GOODIES
 388         PUSH    TP,$TLIST
 389         PUSH    TP,C%0
 390 LPRS2:  PUSHJ   P,IREAD1
 391         JRST    LPRSDN          ; IF WE ARE DONE, WE ARE THROUGH
 392         MOVE    C,A
 393         MOVE    D,B
 394         PUSHJ   P,INCONS
 395         SKIPN   -2(TP)
 396         MOVEM   B,-2(TP)        ; SAVE THE BEGINNING ON FIRST
 397         SKIPE   C,(TP)
 398         HRRM    B,(C)           ; PUTREST INTO IT
 399         MOVEM   B,(TP)
 400         JRST    LPRS2
 401 LPRSDN: MOVSI   A,TLIST
 402         MOVE    B,-2(TP)
 403 LPSRET: SKIPLE C,5(TB)          ; EXIT FOR PARSE AND LPARSE
 404         CAIN    C,400033        ; SEE IF NO PEEK AHEAD OR IF ! ALTMODE
 405         JRST    FINIS           ; IF SO NO NEED TO BACK STRING ONE
 406         SKIPN   C,11.(TB)
 407         JRST    FINIS           ; IF ATE WHOLE STRING, DONT GIVE BACK ANY
 408 BUPRS:  MOVEI   D,1
 409         ADDM    D,(C)           ; AOS THE COUNT OF STRING LENGTH
 410         SKIPG   D,1(C)          ; SEXIER THAN CLR'S CODE FOR DECREMENTING
 411         SUB     D,[430000,,1]   ; A BYTE POINTER
 412         ADD     D,[70000,,0]
 413         MOVEM   D,1(C)
 414         HRRZ    E,2(TB)
 415         JUMPE   E,FINIS         ; SEE IF WE NEED TO BACK UP TWO
 416         HLLZS   2(TB)           ; CLEAR OUT DOUBLE CHR LOOKY FLAG
 417         JRST    BUPRS           ; AND BACK UP PARSE STRING A LITTLE MORE
 418
 419 \f; ARGUMENTS ARE BOUND, NOW GET THE VALUES OF THINGS
 420
 421
 422 GRT:    MOVE    B,IMQUOTE READ-TABLE
 423         SKIPA                   ; HERE TO GET TABLE FOR READ
 424 GPT:    MOVE    B,IMQUOTE PARSE-TABLE
 425         MOVSI   A,TATOM         ; TO FILL SLOT WITH PARSE TABLE
 426         PUSHJ   P,ILVAL
 427         GETYP   0,A
 428         CAIN    0,TUNBOUND
 429         POPJ    P,
 430         CAIE    0,TVEC
 431         JRST    BADPTB
 432         MOVEM   A,6(TB)
 433         MOVEM   B,7(TB)
 434         POPJ    P,
 435
 436 READ1:  PUSHJ   P,GRT
 437         MOVE    B,IMQUOTE INCHAN
 438         MOVSI   A,TATOM
 439         PUSHJ   P,IDVAL         ;NOW GOBBLE THE REAL CHANNEL
 440         TLZ     A,TYPMSK#777777
 441         HLLZS   A               ; INCASE OF FUNNY BUG
 442         CAME    A,$TCHAN        ;IS IT A CHANNEL
 443         JRST    BADCHN
 444         MOVEM   A,4(TB)         ; STORE CHANNEL
 445         MOVEM   B,5(TB)
 446         HRRZ    A,-2(B)
 447         TRNN    A,C.OPN
 448         JRST    CHNCLS
 449         TRNN    A,C.READ
 450         JRST    WRONGD
 451         HLLOS   4(TB)
 452         TRNE    A,C.BIN         ; SKIP IF NOT BIN
 453         JRST    BREAD           ; CHECK FOR BUFFER
 454         HLLZS   4(TB)
 455 GETIOA: MOVE    B,5(TB)
 456 GETIO:  MOVE    A,IOINS(B)      ;GOBBLE THE I/O INSTRUCTION
 457         JUMPE   A,OPNFIL        ;GO REALLY OPEN THE CROCK
 458         MOVE    A,RADX(B)       ;GET RADIX
 459         MOVEM   A,3(TB)
 460         MOVEM   B,5(TB) ;SAVE CHANNEL
 461 REREAD: HRRZ    D,LSTCH(B)      ;ANY CHARS AROUND?
 462         MOVEI   0,33
 463         CAIN    D,400033        ;FLUSH THE TERMINATOR HACK
 464         HRRM    0,LSTCH(B)      ; MAKE ! ALT INTO JUST ALT IF IT IS STILL AROUND
 465
 466         PUSHJ   P,@(P)          ;CALL INTERNAL READER
 467         JRST    BADTRM          ;LOST
 468 RFINIS: SUB     P,C%11          ;POP OFF LOSER
 469         PUSH    TP,A
 470         PUSH    TP,B
 471         JUMPE   C,FLSCOM                ; FLUSH TOP LEVEL COMMENT
 472         PUSH    TP,C
 473         PUSH    TP,D
 474         MOVE    A,4(TB)
 475         MOVE    B,5(TB)         ; GET CHANNEL
 476         MOVSI   C,TATOM
 477         MOVE    D,IMQUOTE COMMENT
 478         PUSHJ   P,IPUT
 479 RFINI1: POP     TP,B
 480         POP     TP,A
 481         JRST    FINIS
 482
 483 FLSCOM: MOVE    A,4(TB)
 484         MOVE    B,5(TB)
 485         MOVSI   C,TATOM
 486         MOVE    D,IMQUOTE COMMENT
 487         PUSHJ   P,IREMAS
 488         JRST    RFINI1
 489
 490 BADTRM: MOVE    C,5(TB)         ; GET CHANNEL
 491         JUMPGE  B,CHLSTC        ;NO, MUST BE UNMATCHED PARENS
 492         SETZM   LSTCH(C)        ; DONT REUSE EOF CHR
 493         PUSH    TP,4(TB)                ;CLOSE THE CHANNEL
 494         PUSH    TP,5(TB)
 495         MCALL   1,FCLOSE
 496         PUSH    TP,EOFCND-1(B)
 497         PUSH    TP,EOFCND(B)
 498         MCALL   1,EVAL          ;AND EVAL IT
 499         SETZB   C,D
 500         GETYP   0,A             ; CHECK FOR FUNNY ACT
 501         CAIE    0,TREADA
 502         JRST    RFINIS          ; AND RETURN
 503
 504         PUSHJ   P,CHUNW         ; UNWIND TO POINT
 505         MOVSI   A,TREADA        ; SEND MESSAGE BACK
 506         JRST    CONTIN
 507
 508 ;HERE TO ATTEMPT TO OPEN A CLOSED CHANNEL
 509
 510 OPNFIL: PUSHJ   P,OPNCHN        ;GO DO THE OPEN
 511         JUMPGE  B,FNFFL         ;LOSE IC B IS 0
 512         JRST    GETIO
 513
 514
 515 CHLSTC: MOVE    B,5(TB)         ;GET CHANNEL BACK
 516         JRST    REREAD
 517
 518
 519 BREAD:  MOVE    B,5(TB)         ; GET CHANNEL
 520         SKIPE   BUFSTR(B)
 521         JRST    GETIO
 522         MOVEI   A,BUFLNT                ; GET A BUFFER
 523         PUSHJ   P,IBLOCK
 524         MOVEI   C,BUFLNT(B)     ; POINT TO END
 525         HRLI    C,440700
 526         MOVE    B,5(TB)         ; CHANNEL BACK
 527         MOVEI   0,C.BUF
 528         IORM    0,-2(B)
 529         MOVEM   C,BUFSTR(B)
 530         MOVSI   C,TCHSTR+.VECT.
 531         MOVEM   C,BUFSTR-1(B)
 532         JRST    GETIO
 533 \f;MAIN ENTRY TO READER
 534
 535 NIREAD: PUSHJ   P,LSTCHR
 536 NIREA1: PUSH    P,C%M1          ; [-1]  ; DONT GOBBLE COMMENTS
 537         JRST    IREAD2
 538
 539 IREAD:
 540         PUSHJ   P,LSTCHR        ;DON'T REREAD LAST CHARACTER
 541 IREAD1: PUSH    P,C%0           ; FLAG SAYING SNARF COMMENTS
 542 IREAD2: INTGO
 543 BDLP:   SKIPE   C,9.(TB)        ;HAVE WE GOT A SPLICING MACRO LEFT
 544         JRST    SPLMAC          ;IF SO GIVE HIM SOME OF IT
 545         PUSHJ   P,NXTCH         ;GOBBLE CHAR IN A AND TYPE IN D
 546         MOVMS   B               ; FOR SPECIAL NEG HACK OF MACRO TABLES
 547         CAIG    B,ENTYPE
 548         JUMPN   B,@DTBL-1(B)    ;ERROR ON ZERO TYPE OR FUNNY TYPE
 549         JRST    BADCHR
 550
 551
 552 SPLMAC: HRRZ    D,(C)           ;GET THE REST OF THE SEGMENT
 553         MOVEM   D,9.(TB)        ;AND PUT BACK IN PLACE
 554         GETYP   D,(C)           ;SEE IF DEFERMENT NEEDED
 555         CAIN    D,TDEFER
 556         MOVE    C,1(C)          ;IF SO, DO DEFEREMENT
 557         MOVE    A,(C)
 558         MOVE    B,1(C)          ;GET THE GOODIE
 559         AOS     -1(P)           ;ALWAYS A SKIP RETURN
 560         POP     P,(P)           ;DONT WORRY ABOUT COMMENT SEARCHAGE
 561         SETZB   C,D             ;MAKE SURE HE DOESNT THINK WE GOT COMMENT
 562         POPJ    P,              ;GIVE HIM WHAT HE DESERVES
 563
 564 DTBL:
 565 CODINI==0
 566 IRP A,,[[LETCOD,LETTER],[NUMCOD,NUMBER],[PLUCOD,PNUMBE],[NEGCOD,NNUMBE],[ASTCOD,ASTSTR],[DOTTYP,DOTSTR],[ETYPE,LETTER]
 567 [SPATYP,SPACE],[LPATYP,LPAREN],[RPATYP,RPAREN],[LBRTYP,LBRACK],[RBRTYP,RBRACK]
 568 [QUOTYP,QUOTIT],[MACTYP,MACCAL],[CSTYP,CSTRING],[ESCTYP,ESCSTR],[SPCTYP,SPECTY]
 569 [SLMNT,OPNANG],[CNGTYP,CLSANG],[EOFTYP,EOFCHR],[COMTYP,COMNT],[GLMNT,GLOVAL]
 570 [TMPTYP,ILLSQG],[NTYPES,CLSBRA],[EXCEXC,LETTER],[DOTEXT,SEGDOT],[LBREXT,UVECIN]
 571 [RBREXT,RBRACK],[QUOEXT,QUOSEG],[CSEXT,SINCHR],[SLMEXT,SEGIN],[ELMEXT,CLSANG]
 572 [GLMEXT,GLOSEG],[PATHTY,LOSPATH],[BSLEXT,SINCHR],[MANYT,TERM],[USTYP1,USRDS1]
 573 [USTYP2,USRDS2]]
 574
 575         IRP B,C,[A]
 576                 CODINI==CODINI+1
 577                 B==CODINI
 578                 SETZ C
 579                 .ISTOP
 580                 TERMIN
 581 TERMIN
 582
 583 EXPUNGE CODINI
 584
 585 ENTYPE==.-DTBL
 586
 587 NONSPC==ETYPE
 588
 589 SPACE:  PUSHJ   P,LSTCHR                ;DONT REREAD SPACER
 590         JRST    BDLP
 591
 592 USRDS1: SKIPA   B,A             ; GET CHAR IN B
 593 USRDS2: MOVEI   B,200(A)        ; ! CHAR, DISP 200 FURTHER
 594         ASH     B,1
 595         ADD     B,7(TB)         ; POINT TO TABLE ENTRY
 596         GETYP   0,(B)
 597         CAIN    0,TLIST
 598         MOVE    B,1(B)          ; IF LIST, USE FIRST ITEM-SPECIAL NO BREAK HACK
 599         SKIPL   C,5(TB)         ; GET CHANNEL POINTER (IF ANY)
 600         JRST    USRDS3
 601         ADD     C,[EOFCND-1,,EOFCND-1]
 602         PUSH    TP,$TBVL
 603         MOVE    SP,SPSTOR+1
 604         HRRM    SP,(TP)         ; BUILD A TBVL
 605         MOVE    SP,TP
 606         MOVEM   SP,SPSTOR+1
 607         PUSH    TP,C
 608         PUSH    TP,(C)
 609         PUSH    TP,1(C)
 610         MOVE    PVP,PVSTOR+1
 611         MOVEI   D,PVLNT*2+1(PVP)
 612         HRLI    D,TREADA
 613         MOVEM   D,(C)
 614         MOVEI   D,(TB)
 615         HLL     D,OTBSAV(TB)
 616         MOVEM   D,1(C)
 617 USRDS3: PUSH    TP,(B)          ; APPLIER
 618         PUSH    TP,1(B)
 619         PUSH    TP,$TCHRS       ; APPLY TO CHARACTER
 620         PUSH    TP,A
 621         PUSHJ   P,LSTCHR        ; FLUSH CHAR
 622         MCALL   2,APPLY         ; GO TO USER GOODIE
 623         SKIPL   5(TB)
 624         JRST    USRDS9
 625         MOVE    SP,SPSTOR+1
 626         HRRZ    E,1(SP)         ; POINT TO EOFCND SLOT
 627         HRRZ    SP,(SP)         ; UNBIND MANUALLY
 628         MOVEI   D,(TP)
 629         SUBI    D,(SP)
 630         MOVSI   D,(D)
 631         HLL     SP,TP
 632         SUB     SP,D
 633         MOVEM   SP,SPSTOR+1
 634         POP     TP,1(E)
 635         POP     TP,(E)
 636         SUB     TP,C%22         ; FLUSH TP CRAP
 637 USRDS9: GETYP   0,A             ; CHECK FOR DISMISS?
 638         CAIN    0,TSPLICE
 639         JRST    GOTSPL          ; RETURN OF SEGMENT INDICATES SPLICAGE
 640         CAIN    0,TREADA        ; FUNNY?
 641         JRST    DOEOF
 642         CAIE    0,TDISMI
 643         JRST    RET             ; NO, RETURN FROM IREAD
 644         JRST    BDLP            ; YES, IGNORE RETURN
 645
 646 GOTSPL: MOVEM   B,9.(TB)        ; STICK IN THE SPLICAGE SLOT SO IREADS WILL GET HIM
 647         JRST    BDLP            ; GO BACK AND READ FROM OUR SPLICE, OK?
 648
 649 \f
 650 ;HERE ON NUMBER OR LETTER, START ATOM
 651
 652 ESCSTR: PUSHJ   P,NXTC1         ; ESCAPE FIRST
 653 LETTER: MOVEI   FF,NOTNUM       ; LETTER
 654         JRST    ATMBLD
 655
 656 ASTSTR: MOVEI   FF,OCTSTR
 657 DOTST1: MOVEI   B,0
 658         JRST    NUMBLD
 659
 660 NUMBER: MOVEI   FF,NUMWIN       ; SYMBOL OR NUMBER
 661 NUMBR1: MOVEI   B,(A)           ; TO A NUMBER
 662         SUBI    B,60
 663         JRST    NUMBLD
 664
 665 PNUMBE: SETZB   FF,B
 666         JRST    NUMBLD
 667
 668 NNUMBE: MOVEI   FF,NEGF
 669         MOVEI   B,0
 670
 671 NUMBLD: PUSH    TP,$TFIX
 672         PUSH    TP,B
 673         PUSH    TP,$TFIX
 674         PUSH    TP,B
 675         PUSH    TP,$TFIX
 676         PUSH    TP,C%0
 677
 678 ATMBLD: LSH     A,<36.-7>
 679         PUSH    P,A
 680         MOVEI   D,1             ; D IS CHAR COUNT
 681         MOVSI   C,350700+P      ; BYTE PNTR
 682         PUSHJ   P,LSTCHR
 683
 684 ATLP:   PUSH    P,FF
 685         INTGO
 686
 687         PUSHJ   P,NXTCH         ; GET NEXT CHAR
 688         POP     P,FF
 689         TRNN    FF,NOTNUM       ; IF NOT NUMBER, SKIP
 690         JRST    NUMCHK
 691
 692 ATLP2:  CAILE   B,NONSPC        ; SKIP IF STILL LETTER OR NUMBER
 693         JRST    CHKEND
 694
 695 ATLP1:  PUSHJ   P,LSTCHR        ; DONT REUSE
 696         IDPB    A,C             ; INTO ATOM
 697         TLNE    C,760000        ; SKIP IF OK WORD
 698         AOJA    D,ATLP
 699
 700         PUSH    P,C%0
 701         MOVSI   C,440700+P
 702         AOJA    D,ATLP
 703
 704 CHKEND: CAIN    B,ESCTYP        ; ESCAPE?
 705         JRST    DOESC1
 706
 707 CHKEN1: SKIPGE  C               ; SKIP IF TOP SLOT FULL
 708         SUB     P,C%11
 709         PUSH    P,D             ; COUNT OF CHARS
 710
 711         JRST    LOOPA           ; GO HACK TRAILERS
 712
 713
 714 ; HERE IF STILL COULD BE A NUMBER
 715
 716 NUMCHK: CAIN    B,NUMCOD        ; STILL NUMBER
 717         JRST    NUMCH1
 718
 719         CAILE   B,NONSPC        ; NUMBER FINISHED?
 720         JRST    NUMCNV
 721
 722         CAIN    B,DOTTYP
 723         TROE    FF,DOTSEN
 724         JRST    NUMCH2
 725         TRNE    FF,OCTSTR+EFLG
 726         JRST    NUMCH3          ; NO . IN OCTAL OR EXPONENT
 727         TRO     FF,DECFRC       ; MUST BE DECIMAL NOW
 728         JRST    ATLP1
 729
 730 NUMCH1: TRO     FF,NUMWIN
 731         MOVEI   B,(A)
 732         SUBI    B,60
 733         TRNE    FF,OCTSTR+OCTWIN        ; IS THIS *DDDDDD* HACK
 734         JRST    NUMCH4          ; YES, GO DO IT
 735         TRNE    FF,EFLG
 736         JRST    NUMCH7          ; DO EXPONENT
 737
 738         TRNE    FF,DOTSEN       ; FORCE FLOAT
 739         JRST    NUMCH5
 740
 741         JFCL    17,.+1          ; KILL ALL FLAGS
 742         MOVE    E,CNUM(TP)      ; COMPUTE CURRENT RADIX
 743         IMUL    E,3(TB)
 744         ADDI    E,(B)           ; ADD IN CURRENT DIGIT
 745         JFCL    10,.+3
 746         MOVEM   E,CNUM(TP)
 747         JRST    NUMCH6
 748
 749         MOVE    E,3(TB)         ; SEE IF CURRENT RADIX DECIMAL
 750         CAIE    E,10.
 751         JRST    NUMCH5          ; YES, FORCE FLOAT
 752         TROA    FF,OVFLEW
 753
 754 NUMCH5: TRO     FF,FLONUM       ; SET FLOATING FLAG
 755 NUMCH6: JFCL    17,.+1          ; CLEAR ALL FLAGS
 756         MOVE    E,DNUM(TP)      ; GET DECIMAL NUMBER
 757         IMULI   E,10.
 758         JFCL    10,NUMCH8       ; JUMP IF OVERFLOW
 759         ADDI    E,(B)           ; ADD IN DIGIT
 760         MOVEM   E,DNUM(TP)
 761         TRNE    FF,FLONUM       ; IS THIS FRACTION?
 762         SOS     NDIGS(TP)       ; YES, DECREASE EXPONENT BY ONE
 763         JRST    ATLP1
 764
 765 NUMCH8: TRNE    FF,DOTSEN       ; OVERFLOW IN DECMIMAL
 766         JRST    ATLP1           ; OK, IN FRACTION
 767
 768         AOS     NDIGS(TP)
 769         TRO     FF,FLONUM       ; MAKE IT FLOATING TO FIT
 770         JRST    ATLP1
 771
 772 NUMCH4: TRNE    FF,OCTWIN
 773         JRST    NUMCH3          ; ALREADY ONE, MORE DIGITS LOSE
 774         MOVE    E,ONUM(TP)
 775         TLNE    E,700000        ; SKIP IF WORD NOT FULL
 776         TRO     FF,OVFLEW
 777         LSH     E,3
 778         ADDI    E,(B)           ; ADD IN NEW ONE
 779         MOVEM   E,ONUM(TP)
 780         JRST    ATLP1
 781
 782 NUMCH3: SUB     TP,[NUMTMP,,NUMTMP]     ; FLUSH NUMBER CRUFT
 783         TRO     FF,NOTNUM
 784         JRST    ATLP2
 785
 786 NUMCH2: CAIN    B,ASTCOD                ; POSSIBLE END OF OCTAL
 787         TRZN    FF,OCTSTR               ; RESET FLAG AND WIN
 788         JRST    NUMCH9
 789
 790         TRO     FF,OCTWIN
 791         JRST    ATLP2
 792
 793 NUMCH9: CAIN    B,ETYPE
 794         TROE    FF,EFLG
 795         JRST    NUMC10          ; STILL COULD BE +- EXPONENT
 796
 797         TRZ     FF,NUMWIN       ; IN CASE NO MORE DIGITS
 798         SETZM   ENUM(TP)
 799         JRST    ATLP1
 800
 801 NUMCH7: MOVE    E,ENUM(TP)
 802         IMULI   E,10.
 803         ADDI    E,(B)
 804         MOVEM   E,ENUM(TP)      ; UPDATE ECPONENT
 805         TRO     FF,EPOS         ; FLUSH IF SIGN COMES NOW
 806         JRST    ATLP1
 807
 808 NUMC10: TRNE    FF,ENEG+EPOS    ; SIGN FOR EXPONENT SEEN?
 809         JRST    NUMCH3          ; NOT A NUMBER
 810         CAIN    B,PLUCOD
 811         TRO     FF,EPOS
 812         CAIN    B,NEGCOD
 813         TRO     FF,ENEG
 814         TRNE    FF,EPOS+ENEG
 815         JRST    ATLP1
 816         JRST    NUMCH3
 817
 818 ; HERE AFTER \ QUOTER
 819
 820 DOESC1: PUSHJ   P,NXTC1         ; GET CHAR
 821         JRST    ATLP1           ; FALL BACK INTO LOOP
 822
 823
 824 ; HERE TO CONVERT NUMBERS AS NEEDED
 825
 826 NUMCNV: CAIE    B,ESCTYP
 827         TRNE    FF,OCTSTR
 828         JRST    NUMCH3
 829         TRNN    FF,NUMWIN
 830         JRST    NUMCH3
 831         ADDI    D,4
 832         IDIVI   D,5
 833         SKIPGE  C               ; SKIP IF NEW WORD ADDED
 834         ADDI    D,1
 835         HRLI    D,(D)           ; TOO BOTH HALVES
 836         SUB     P,D             ; REMOVE CHAR STRING
 837         MOVE    D,3(TB)         ; IS RADIX 10?
 838         CAIE    D,10.
 839         TRNE    FF,DECFRC
 840         TRNN    FF,FLONUM+EFLG  ;IS IT A FLOATING POINT NUMBER
 841         TRNE    FF,EFLG
 842         JRST    FLOATIT         ;YES, GO MAKE IT WIN
 843         TRNE    FF,OVFLEW
 844         JRST    FOOR
 845         MOVE    B,CNUM(TP)
 846         TRNE    FF,DECFRC
 847         MOVE    B,DNUM(TP)      ;GRAB FIXED GOODIE
 848         TRNE    FF,OCTWIN       ; SKIP IF NOT OCTAL
 849         MOVE    B,ONUM(TP)      ; USE OCTAL VALUE
 850 FINID2: MOVSI   A,TFIX          ;SAY FIXED POINT
 851 FINID1: TRNE    FF,NEGF         ;NEGATE
 852         MOVNS   B               ;YES
 853         SUB     TP,[NUMTMP,,NUMTMP]     ;FINISH HACK
 854         JRST    RET             ;AND RETURN
 855
 856 \f
 857 FLOATIT:
 858         JFCL    17,.+1          ;CLEAR ALL ARITHMETIC FLAGS
 859         TRNE    FF,EFLG         ;"E" SEEN?
 860         JRST    EXPDO           ;YES, DO EXPONENT
 861         MOVE    D,NDIGS(TP)     ;GET IMPLICIT EXPONENT
 862
 863 FLOATE: MOVE    A,DNUM(TP)      ;GET DECIMAL NUMBER
 864         IDIVI   A,400000        ;SPLIT
 865         FSC     A,254           ;CONVERT MOST SIGNIFICANT
 866         FSC     B,233           ; AND LEAST SIGNIFICANT
 867         FADR    B,A             ;COMBINE
 868
 869         MOVM    A,D             ;GET MAGNITUDE OF EXPONENT
 870         MOVSI   E,(1.0)
 871         JFCL    17,.+1          ; CLEAR ALL OVERFLOW/UNDERFLOW BITS
 872         CAIG    A,38.           ;HOW BIG?
 873         JRST    .+3             ;TOO BIG-FLOATING OUT OF RANGE
 874         MOVE    E,[1.0^38.]
 875         SUBI    A,38.
 876         JUMPGE  D,FLOAT1        ;JUMP IF EXPONENT POSITIVE
 877         FDVR    B,E
 878         FDVR    B,TENTAB(A)     ;DIVIDE BY TEN TO THE EXPONENT
 879         JRST    SETFLO
 880
 881 FLOAT1: FMPR    B,E
 882         FMPR    B,TENTAB(A)     ;SCALE UP
 883
 884 SETFLO: JFCL    17,FOOR         ;FLOATING OUT OF RANGE ON OVERFLOW
 885         MOVSI   A,TFLOAT
 886         TRZ     FF,FRSDOT       ;FLOATING NUMBER NOT VALUE
 887         JRST    FINID1
 888
 889 EXPDO:
 890         HRRZ    D,ENUM(TP)      ;GET EXPONENT
 891         TRNE    FF,ENEG         ;IS EXPONENT NEGATIVE?
 892         MOVNS   D               ;YES
 893         ADD     D,NDIGS(TP)     ;ADD IMPLICIT EXPONENT
 894         JUMPL   D,FLOATE        ;FLOATING IF EXPONENT NEGATIVE
 895         CAIG    D,10.           ;OR IF EXPONENT TOO LARGE
 896         TRNE    FF,FLONUM       ;OR IF FLAG SET
 897         JRST    FLOATE
 898         MOVE    B,DNUM(TP)      ;
 899         IMUL    B,ITENTB(D)
 900         JFCL    10,FLOATE       ;IF OVERFLOW, MAKE FLOATING
 901         JRST    FINID2          ;GO MAKE FIXED NUMBER
 902
 903
 904 ; HERE TO START BUILDING A CHARACTER STRING GOODIE
 905
 906 CSTRING:
 907         PUSH    P,C%0
 908         MOVEI   D,0             ; CHARCOUNT
 909         MOVSI   C,440700+P      ; AND BYTE POINTER
 910
 911 CSLP:   PUSH    P,FF
 912         INTGO
 913         PUSHJ   P,NXTC1         ; GET NEXT CHAR
 914         POP     P,FF
 915
 916         CAIN    B,CSTYP         ; END OF STRING?
 917         JRST    CSLPEND
 918
 919         CAIN    B,ESCTYP        ; ESCAPE?
 920         PUSHJ   P,NXTC1
 921
 922         IDPB    A,C             ; INTO ATOM
 923         TLNE    C,760000        ; SKIP IF OK WORD
 924         AOJA    D,CSLP
 925
 926         PUSH    P,C%0
 927         MOVSI   C,440700+P
 928         AOJA    D,CSLP
 929
 930 CSLPEND:
 931         SKIPGE  C
 932         SUB     P,C%11
 933         PUSH    P,D
 934         PUSHJ   P,CHMAK
 935         PUSHJ   P,LSTCHR
 936
 937         JRST    RET
 938
 939 ;ARRIVE HERE TO INVOKE A READ TIME MACRO FUNCTION
 940
 941 MACCAL: PUSHJ   P,NXTCH1        ;READ ONE MORE CHARACTER
 942         CAIE    B,MACTYP        ;IS IT ANOTHER MACRO CHAR
 943
 944         JRST    MACAL2          ;NO, CALL MACRO AND USE VALUE
 945         PUSHJ   P,LSTCHR        ;DONT REREAD %
 946         PUSHJ   P,MACAL1        ;OTHERWISE, USE SIDE EFFECCT, BUT NOT VALUE
 947         JRST    IREAD2
 948
 949 MACAL2: PUSH    P,CRET
 950 MACAL1: PUSHJ   P,IREAD1        ;READ FUNCTION NAME
 951         PUSHJ   P,RETERR
 952         PUSH    TP,C
 953         PUSH    TP,D            ; SAVE COMMENT IF ANY
 954         PUSH    TP,A            ;SAVE THE RESULT
 955         PUSH    TP,B            ;AND USE IT AS AN ARGUMENT
 956         MCALL   1,EVAL
 957         POP     TP,D
 958         POP     TP,C            ; RESTORE COMMENT IF ANY...
 959 CRET:   POPJ    P,RET12
 960
 961 ;CALL GOBBLE TO FIND THE TYPE AND THEN IREAD TO READ IT
 962
 963 SPECTY: PUSHJ   P,NIREAD        ; READ THE TYPES NAME (SHOULD BE AN ATOM)
 964         PUSHJ   P,RETERR
 965         PUSH    TP,A
 966         PUSH    TP,B
 967         GETYP   A,A
 968         CAIN    A,TFIX
 969         JRST    BYTIN
 970         PUSHJ   P,NXTCH         ; GET NEXT CHAR
 971         CAIN    B,TMPTYP        ; SKIP IF NOT TEMPLATE START
 972         JRST    RDTMPL
 973         SETZB   A,B
 974         EXCH    A,-1(TP)
 975         EXCH    B,(TP)
 976         PUSH    TP,A            ;BEGIN SETTING UP CHTYPE CALL
 977         PUSH    TP,B
 978         PUSHJ   P,IREAD1        ;NOW READ STRUCTURE
 979         PUSHJ   P,RETERR
 980         MOVEM   C,-3(TP)        ; SAVE COMMENT
 981         MOVEM   D,-2(TP)
 982         EXCH    A,-1(TP)        ;USE AS FIRST ARG
 983         EXCH    B,(TP)
 984         PUSH    TP,A            ;USE OTHER AS 2D ARG
 985         PUSH    TP,B
 986         MCALL   2,CHTYPE        ;ATTEMPT TO MUNG
 987 RET13:  POP     TP,D
 988         POP     TP,C            ; RESTORE COMMENT
 989 RET12:  SETOM   (P)             ; DONT LOOOK FOR MORE!
 990         JRST    RET
 991
 992 RDTMPL: PUSH    P,["}]          ; SET UP TERMINATE TEST
 993         MOVE    B,(TP)
 994         PUSHJ   P,IGVAL
 995         MOVEM   A,-1(TP)
 996         MOVEM   B,(TP)
 997         PUSH    P,[BLDTMP]      ; FLAG FOR VECTOR READING CODE
 998         JRST    LBRAK2
 999
1000 BLDTMP: ADDI    A,1             ; 1 MORE ARGUMENT
1001         ACALL   A,APPLY         ; DO IT TO IT
1002         POPJ    P,
1003
1004 BYTIN:  PUSHJ   P,NXTCH         ; CHECK FOR OPENR
1005         CAIN    B,SPATYP
1006         PUSHJ   P,SPACEQ
1007         JRST    .+3
1008         PUSHJ   P,LSTCHR
1009         JRST    BYTIN
1010         CAIE    B,TMPTYP
1011         ERRUUO  EQUOTE BAD-USE-OF-BYTE-STRING
1012         PUSH    P,["}]
1013         PUSH    P,[CBYTE1]
1014         JRST    LBRAK2
1015
1016 CBYTE1: AOJA    A,CBYTES
1017
1018 RETERR: SKIPL   A,5(TB)
1019         MOVEI   A,5(TB)-LSTCH   ;NO CHANNEL, USE SLOT
1020         HRRM    B,LSTCH(A)      ; RESTORE LAST CHAR
1021         PUSHJ   P,ERRPAR
1022         SOS     (P)
1023         SOS     (P)
1024         POPJ    P,
1025
1026 \f
1027 ;THIS CODE CALLS IREAD RECURSIVELY TO READ THAT WHICH IS
1028 ;BETWEEN (),  ARRIVED AT WHEN ( IS READ
1029
1030 SEGIN:  PUSH    TP,$TSEG
1031         JRST    OPNAN1
1032
1033 OPNANG: PUSH    TP,$TFORM       ;SAVE TYPE
1034 OPNAN1: PUSH    P,[">]
1035         JRST    LPARN1
1036
1037 LPAREN: PUSH    P,[")]
1038         PUSH    TP,$TLIST       ;START BY ASSUMING NIL
1039 LPARN1: PUSH    TP,C%0
1040         PUSHJ   P,LSTCHR        ;DON'T REREAD PARENS
1041 LLPLOP: PUSHJ   P,IREAD1        ;READ IT
1042         JRST    LDONE           ;HIT TERMINATOR
1043
1044 ;HERE WHEN MUST ADD CAR TO CURRENT WINNER
1045
1046 GENCAR: PUSH    TP,C            ; SAVE COMMENT
1047         PUSH    TP,D
1048         MOVE    C,A             ; SET UP CALL
1049         MOVE    D,B
1050         PUSHJ   P,INCONS        ; CONS ON TO NIL
1051         POP     TP,D
1052         POP     TP,C
1053         POP     TP,E            ;GET CDR
1054         JUMPN   E,CDRIN         ;IF STACKED GOODIE NOT NIL SKIP
1055         PUSH    TP,B            ;AND USE AS TOTAL VALUE
1056         PUSH    TP,$TLIST       ;SAVE THIS AS FIRSST THING ON LIST
1057         MOVE    A,-2(TP)        ; GET REAL TYPE
1058         JRST    .+2             ;SKIP CDR SETTING
1059 CDRIN:  HRRM    B,(E)
1060         PUSH    TP,B            ;CLOBBER IN NEW PARTIAL GOODIE
1061         JUMPE   C,LLPLOP        ; JUMP IF NO COMMENT
1062         PUSH    TP,C
1063         PUSH    TP,D
1064         MOVSI   C,TATOM
1065         MOVE    D,IMQUOTE COMMENT
1066         PUSHJ   P,IPUT
1067         JRST    LLPLOP          ;AND CONTINUE
1068
1069 ; HERE TO RAP UP LIST
1070
1071 LDONE:  CAME    B,(P)           ;CHECK VALIDITY OF CHARACTER
1072         PUSHJ   P,MISMAT        ;REPORT MISMATCH
1073         SUB     P, C%11
1074         POP     TP,B            ;GET VALUE OF PARTIAL RESULT
1075         POP     TP,A            ;AND TYPE OF SAME
1076         JUMPE   B,RET           ;VALUE IS NIL, DON'T POP AGAIN
1077         POP     TP,B            ;POP FIRST LIST ELEMENT
1078         POP     TP,A            ;AND TYPE
1079         JRST    RET
1080 \f
1081 ;THIS CODE IS SIMILAR TO LIST GENERATING CODE BUT IS FOR VECTORS
1082 OPNBRA: PUSH    P,["}]          ; SAVE TERMINATOR
1083 UVECIN: PUSH    P,[135]         ; CLOSE SQUARE BRACKET
1084         PUSH    P,[SETZ IEUVECTOR]      ;PUSH NAME OF U VECT HACKER
1085         JRST    LBRAK2          ;AND GO
1086
1087 LBRACK: PUSH    P,[135]         ; SAVE TERMINATE
1088         PUSH    P,[SETZ IEVECTOR]       ;PUSH GEN VECTOR HACKER
1089 LBRAK2: PUSHJ   P,LSTCHR        ;FORCE READING NEW CHAR
1090         PUSH    P,C%0           ; COUNT ELEMENTS
1091         PUSH    TP,$TLIST       ; AND SLOT FOR GOODIES
1092         PUSH    TP,C%0
1093
1094 LBRAK1: PUSHJ   P,IREAD1        ;RECURSIVELY READ  ELEMENTS OF ARRAY
1095         JRST    LBDONE          ;RAP UP ON TERMINATOR
1096
1097 STAKIT: EXCH    A,-1(TP)        ; STORE RESULT AND GET CURRENT LIST
1098         EXCH    B,(TP)
1099         AOS     (P)             ; COUNT ELEMENTS
1100         JUMPE   C,LBRAK3        ; IF NO COMMENT, GO ON
1101         MOVEI   E,(B)           ; GET CDR
1102         PUSHJ   P,ICONS         ; CONS IT ON
1103         MOVEI   E,(B)           ; SAVE RS
1104         MOVSI   C,TFIX          ; AND GET FIXED NUM
1105         MOVE    D,(P)
1106         PUSHJ   P,ICONS
1107 LBRAK3: PUSH    TP,A            ; SAVE CURRENT COMMENT LIST
1108         PUSH    TP,B
1109         JRST    LBRAK1
1110
1111 ; HERE TO RAP UP VECTOR
1112
1113 LBDONE: CAME    B,-2(P)         ; FINISHED RETURN (WAS THE RIGHT STOP USED?)
1114         PUSHJ   P,MISMAB        ; WARN USER
1115         POP     TP,1(TB)        ; REMOVE COMMENT LIST
1116         POP     TP,(TB)
1117         MOVE    A,(P)           ; COUNT TO A
1118         PUSHJ   P,-1@(P)        ; MAKE THE VECTOR
1119         SUB     P,C%33
1120
1121 ; PUT COMMENTS ON VECTOR (OR UVECTOR)
1122
1123         MOVNI   C,1             ; INDICATE TEMPLATE HACK
1124         CAMN    A,$TVEC
1125         MOVEI   C,1
1126         CAMN    A,$TUVEC        ; SKIP IF UVECTOR
1127         MOVEI   C,0
1128         PUSH    P,C             ; SAVE
1129         PUSH    TP,A            ; SAVE VECTOR/UVECTOR
1130         PUSH    TP,B
1131
1132 VECCOM: SKIPN   C,1(TB)         ; ANY LEFT?
1133         JRST    RETVEC          ; NO, LEAVE
1134         MOVE    A,1(C)          ; ASSUME WINNING TYPES
1135         SUBI    A,1
1136         HRRZ    C,(C)           ; CDR THE LIST
1137         HRRZ    E,(C)           ; AGAIN
1138         MOVEM   E,1(TB)         ; SAVE CDR
1139         GETYP   E,(C)           ; CHECK DEFFERED
1140         MOVSI   D,(E)
1141         CAIN    E,TDEFER        ; SKIP IF NOT DEFERRED
1142         MOVE    C,1(C)
1143         CAIN    E,TDEFER
1144         GETYPF  D,(C)           ; GET REAL TYPE
1145         MOVE    B,(TP)          ; GET VECTOR POINTER
1146         SKIPGE  (P)             ; SKIP IF NOT TEMPLATE
1147         JRST    TMPCOM
1148         HRLI    A,(A)           ; COUNTER
1149         LSH     A,@(P)          ; MAYBE SHIFT IT
1150         ADD     B,A
1151         MOVE    A,-1(TP)        ; TYPE
1152 TMPCO1: PUSH    TP,D
1153         PUSH    TP,1(C)         ; PUSH THE COMMENT
1154         MOVSI   C,TATOM
1155         MOVE    D,IMQUOTE COMMENT
1156         PUSHJ   P,IPUT
1157         JRST    VECCOM
1158
1159 TMPCOM: MOVSI   A,(A)
1160         ADD     B,A
1161         MOVSI   A,TTMPLT
1162         JRST    TMPCO1
1163
1164 RETVEC: SUB     P,C%11
1165         POP     TP,B
1166         POP     TP,A
1167         JRST    RET
1168
1169 ; BUILD A SINGLE CHARACTER ITEM
1170
1171 SINCHR: PUSHJ   P,NXTC1         ;FORCE READ NEXT
1172         CAIN    B,ESCTYP                ;ESCAPE?
1173         PUSHJ   P,NXTC1         ;RETRY
1174         MOVEI   B,(A)
1175         MOVSI   A,TCHRS
1176         JRST    RETCL
1177
1178 \f
1179 ; HERE ON RIGHT PAREN, BRACKET, ANGLE BRACKET OR CTL C
1180
1181 CLSBRA:
1182 CLSANG:                         ;CLOSE ANGLE BRACKETS
1183 RBRACK:                         ;COMMON RETURN FOR END OF ARRAY ALSO
1184 RPAREN: PUSHJ   P,LSTCHR        ;DON'T REREAD
1185 EOFCH1: MOVE    B,A             ;GETCHAR IN B
1186         MOVSI   A,TCHRS         ;AND TYPE IN A
1187 RET1:   SUB     P,C%11
1188         POPJ    P,
1189
1190 EOFCHR: SETZB   C,D
1191         JUMPL   A,EOFCH1        ; JUMP ON REAL EOF
1192         JRST    RRSUBR          ; MAYBE A BINARY RSUBR
1193
1194 DOEOF:  MOVE    A,[-1,,3]
1195         SETZB   C,D
1196         JRST    EOFCH1
1197
1198
1199 ; NORMAL RETURN FROM IREAD/IREAD1
1200
1201 RETCL:  PUSHJ   P,LSTCHR        ;DONT REREAD
1202 RET:    AOS     -1(P)           ;SKIP
1203         POP     P,E             ; POP FLAG
1204 RETC:   JUMPL   E,RET2          ; DONT LOOK FOR COMMENTS
1205         PUSH    TP,A            ; SAVE ITEM
1206         PUSH    TP,B
1207 CHCOMN: PUSHJ   P,NXTCH         ; READ A CHARACTER
1208         CAIE    B,COMTYP        ; SKIP IF COMMENT
1209         JRST    CHSPA
1210         PUSHJ   P,IREAD         ; READ THE COMMENT
1211         JRST    POPAJ
1212         MOVE    C,A
1213         MOVE    D,B
1214         JRST    .+2
1215 POPAJ:  SETZB   C,D
1216         POP     TP,B
1217         POP     TP,A
1218 RET2:   POPJ    P,
1219
1220 CHSPA:  CAIN    B,SPATYP
1221         PUSHJ   P,SPACEQ        ; IS IT A REAL SPACE
1222         JRST    POPAJ
1223         PUSHJ   P,LSTCHR        ; FLUSH THE SPACE
1224         JRST    CHCOMN
1225
1226 ;RANDOM MINI-SUBROUTINES USED BY THE READER
1227
1228 ;READ A CHAR INTO A AND TYPE CODE INTO D
1229
1230 NXTC3:  SKIPL   B,5(TB) ;GET CHANNEL
1231         JRST    NXTPR4          ;NO CHANNEL, GO READ STRING
1232         SKIPE   LSTCH(B)
1233         PUSHJ   P,CNTACC        ; COUNT ON ACCESS POINTER
1234         PUSHJ   P,RXCT
1235         TRO     A,200
1236         JRST    GETCTP
1237
1238 NXTC1:  SKIPL   B,5(TB) ;GET CHANNEL
1239         JRST    NXTPR1          ;NO CHANNEL, GO READ STRING
1240         SKIPE   LSTCH(B)
1241         PUSHJ   P,CNTACC        ; COUNT ON ACCESS POINTER
1242         JRST    NXTC2
1243 NXTC:   SKIPL   B,5(TB) ;GET CHANNEL
1244         JRST    NXTPRS          ;NO CHANNEL, GO READ STRING
1245         SKIPE   A,LSTCH(B)      ;CHAR IN A IF REUSE
1246         JRST    PRSRET
1247 NXTC2:  PUSHJ   P,RXCT          ;GET CHAR FROM INPUT
1248         TLO     A,200000        ; BIT TO AVOID ^@ LOSSAGE
1249         HLLZS   2(TB)           ;FLAG INDICATING ONE CHAR LOOK AHEAD
1250         MOVEM   A,LSTCH(B)      ;SAVE THE CHARACTER
1251 PRSRET: TLZ     A,200000
1252         TRZE    A,400000        ;DONT SKIP IF SPECIAL
1253         TRO     A,200           ;GO HACK SPECIALLY
1254 GETCTP: PUSH    P,A     ;AND SAVE FROM DIVISION
1255         ANDI    A,377
1256         IDIVI   A,CHRWD ;YIELDS WORD AND CHAR NUMBER
1257         LDB     B,BYTPNT(B)     ;GOBBLE TYPE CODE
1258         POP     P,A
1259         ANDI    A,177   ; RETURN REAL ASCII
1260         POPJ    P,
1261
1262 NXTPR4: MOVEI   F,400000
1263         JRST    NXTPR5
1264
1265 NXTPRS: SKIPE   A,5(TB)         ;GET OLD CHARACTER IF ONE EXISTS
1266         JRST    PRSRET
1267 NXTPR1: MOVEI   F,0
1268 NXTPR5: MOVE    A,11.(TB)
1269         HRRZ    B,(A)           ;GET THE STRING
1270         SOJL    B,NXTPR3
1271         HRRM    B,(A)
1272         ILDB    A,1(A)          ;GET THE CHARACTER FROM THE STRING
1273         IORI    A,(F)
1274 NXTPR2: MOVEM   A,5(TB)         ;SAVE IT
1275         JRST    PRSRET          ;CONTINUE
1276
1277 NXTPR3: SETZM   8.(TB)
1278         SETZM   9.(TB)          ;CLEAR OUT LOCATIVE, AT END OF STRING
1279         MOVEI   A,400033
1280         JRST    NXTPR2
1281
1282 ; NXTCH AND NXTCH1 ARE SAME AS NXTC AND NXTC1 EXCEPT THEY CHECK !
1283 ; HACKS
1284
1285 NXTCH1: PUSHJ   P,NXTC1         ;READ CHAR
1286         JRST    .+2
1287 NXTCH:  PUSHJ   P,NXTC          ;READ CHAR
1288         PUSHJ   P,CHKUS1        ; CHECK FOR USER DISPATCH
1289
1290         CAIE    B,NTYPES+1      ; SKIP IF ! ING NEXT CHAR
1291          POPJ   P,
1292         PUSHJ   P,NXTC3         ;READ NEXT ONE
1293         HLLOS   2(TB)           ;FLAG FOR TWO CHAR LOOK AHEAD
1294
1295 CRMLST: IORI    A,400000        ;CLOBBER LASTCHR
1296         PUSH    P,B
1297         SKIPL   B,5(TB)         ;POINT TO CHANNEL
1298         MOVEI   B,5(TB)-LSTCH   ;NO CHANNEL, POINT AT SLOT
1299         HRRM    A,LSTCH(B)
1300         ANDI    A,377777        ;DECREASE CHAR
1301         POP     P,B
1302
1303 CHKUS2: SKIPN   7(TB)           ; SKIP IF USER TABLE
1304         POPJ    P,
1305         MOVEI   F,200(A)
1306         ASH     F,1             ; POINT TO SLOT
1307         HRLI    F,(F)
1308         ADD     F,7(TB)
1309         JUMPGE  F,CPOPJ         ;IS THERE VECTOR ENOUGH?
1310         SKIPN   1(F)            ; NON-ZERO==>USER FCN EXISTS
1311         JRST    CPOPJ           ; HOPE HE APPRECIATES THIS
1312         MOVEI   B,USTYP2
1313 CHKRDO: PUSH    P,0             ; CHECK FOR REDOING IF CHAR IN TABLE
1314         GETYP   0,(F)
1315         CAIE    0,TCHRS
1316         JRST    CHKUS5
1317         POP     P,0             ;WE ARE TRANSMOGRIFYING
1318         MOVE    A,1(F)          ;GET NEW CHARACTER
1319         PUSH    P,7(TB)
1320         PUSH    P,2(TB)         ; FLAGS FOR NUM OF CHRS IN LOOK AHEAD
1321         PUSH    P,5(TB)         ; TO AVOID SMASHING LSTCHR
1322         SETZM   5(TB)           ; CLEAR OUT CHANNEL
1323         SETZM   7(TB)           ;CLEAR OUT TABLE
1324         TRZE    A,200           ; ! HACK
1325         TRO     A,400000        ; TURN ON PROPER BIT
1326         PUSHJ   P,PRSRET
1327         POP     P,5(TB)         ; GET BACK CHANNEL
1328         POP     P,2(TB)
1329         POP     P,7(TB)         ;GET BACK OLD PARSE TABLE
1330         POPJ    P,
1331
1332 CHKUS5: PUSH    P,A
1333         CAIE    0,TLIST
1334         JRST    .+4             ; SPECIAL NON-BREAK TYPE HACK
1335         MOVNS   (P)             ; INDICATE BY NEGATIVE
1336         MOVE    A,1(F)          ; GET <1 LIST>
1337         GETYP   0,(A)           ; AND GET THE TYPE OF THAT
1338         CAIE    0,TFIX          ; SEE IF HE WANTS SAME CHAR WITH DIFF TYPE
1339         JRST    CHKUS6          ; JUST A VANILLA HACK
1340         MOVE    A,1(F)          ; PRETEND IT IS SAME TYPE AS NEW CHAR
1341         PUSH    P,7(TB)         ; CLEAR OUT TRANSLATE TABLE
1342         PUSH    P,2(TB)         ; FLAGS FOR # OF CHRS IN LOOK AHEAD
1343         SETZM   7(TB)
1344         TRZE    A,200
1345         TRO     A,400000        ; TURN ON PROPER BIT IF ! HACK
1346         PUSHJ   P,PRSRET                ; REGET TYPE
1347         POP     P,2(TB)
1348         POP     P,7(TB) ; PUT TRANSLATE TABLE BACK
1349 CHKUS6: SKIPGE  -1(P)           ; SEE IF A SPECIAL NON-BREAK
1350         MOVNS   B               ; SEXY, HUH?
1351         POP     P,A
1352         POP     P,0
1353         MOVMS   A               ; FIX UP A POSITIVE CHARACTER
1354         POPJ    P,
1355
1356 CHKUS4: POP     P,A
1357         POPJ    P,
1358
1359 CHKUS1: SKIPN   7(TB)           ; USER CHECK FOR NOT ! CASE
1360         POPJ    P,
1361         MOVEI   F,(A)
1362         ASH     F,1
1363         HRLI    F,(F)
1364         ADD     F,7(TB)
1365         JUMPGE  F,CPOPJ
1366         SKIPN   1(F)
1367         POPJ    P,
1368         MOVEI   B,USTYP1
1369         JRST    CHKRDO          ; TRANSMOGRIFY CHARACTER?
1370
1371 CHKUS3: POP     P,A
1372         POPJ    P,
1373
1374 UPLO:   POPJ    P,              ; LETS NOT AND SAY WE USED TO
1375                                 ; AVOID STRANGE ! BLECHAGE
1376 NXTCS:  PUSHJ   P,NXTC
1377         PUSH    P,A             ; HACK TO NOT TRANSLATE CHAR
1378         PUSHJ   P,CHKUS1        ; BUT DO TRANSLATION OF TYPE IF HE WANTS
1379         POP     P,A             ; USED TO BUILD UP STRINGS
1380         POPJ    P,
1381
1382 CHKALT: CAIN    A,33            ;ALT?
1383         MOVEI   B,MANYT
1384         JRST    CRMLST
1385
1386
1387 TERM:   MOVEI   B,0             ;RETURN A 0
1388         JRST    RET1
1389                 ;AND RETURN
1390
1391 CHKMIN: CAIN    A,"-            ; IF CHAR IS -, WINNER
1392         MOVEI   B,PATHTY
1393         JRST    CRMLST
1394
1395 LOSPAT: PUSHJ   P,LSTCHR                ; FIX RECURSIVE LOSAGE
1396         ERRUUO  EQUOTE UNATTACHED-PATH-NAME-SEPARATOR
1397
1398 \f
1399 ; HERE TO SEE IF READING RSUBR
1400
1401 RRSUBR: PUSHJ   P,LSTCHR        ; FLUSH JUST READ CHAR
1402         SKIPL   B,5(TB)         ; SKIP IF A CHANNEL EXISTS
1403         JRST    SPACE           ; ELSE LIKE A SPACE
1404         HRRZ    C,BUFSTR(B)     ; SEE IF FLAG SAYS START OF RSUBR
1405         MOVE    C,(C)
1406         TRNN    C,1             ; SKIP IF REAL RSUBR
1407         JRST    EOFCH2          ; NO, IGNORE FOR NOW
1408
1409 ; REALLY ARE READING AN RSUBR
1410
1411         HRRZ    0,4(TB)         ; GET READ/READB INDICATOR
1412         MOVE    C,ACCESS(B)     ; GET CURRENT ACCESS
1413         JUMPN   0,.+3           ; ALREADY WORDS, NO NEED TO DIVIDE
1414         ADDI    C,4             ; ROUND UP
1415         IDIVI   C,5
1416         PUSH    P,C             ; SAVE WORD ACCESS
1417         MOVEI   A,(C)           ; COPY IT FOR CALL
1418         JUMPN   0,.+3
1419         IMULI   C,5
1420         MOVEM   C,ACCESS(B)     ; FIXUP ACCESS
1421         HLLZS   ACCESS-1(B)     ; FOR READB LOSER
1422         PUSHJ   P,DOACCS        ; AND GO THERE
1423         PUSH    P,C%0           ; FOR READ IN
1424         HRROI   A,(P)           ; PREPARE TO READ LENGTH
1425         PUSHJ   P,DOIOTI        ; READ IT
1426         POP     P,C             ; GET READ GOODIE
1427         JUMPGE  A,.+4           ; JUMP IF WON
1428         SUB     P,C%11
1429 EOFCH2: HRROI   A,3
1430         JRST    EOFCH1
1431         MOVEI   A,(C)           ; COPY FOR GETTING BLOCK
1432         ADDI    C,1             ; COUNT COUNT WORD
1433         ADDM    C,(P)
1434         PUSH    TP,$TUVEC       ; WILL HOLD UVECTOR OF FIXUPS IF THEY STAY
1435         PUSH    TP,C%0
1436         PUSHJ   P,IBLOCK        ; GET A BLOCK
1437         PUSH    TP,$TUVEC
1438         PUSH    TP,B            ; AND SAVE
1439         MOVE    A,B             ; READY TO IOT IT IN
1440         MOVE    B,5(TB)         ; GET CHANNEL BACK
1441         MOVSI   0,TUVEC         ; SETUP A'S TYPE
1442         MOVE    PVP,PVSTOR+1
1443         MOVEM   0,ASTO(PVP)
1444         PUSHJ   P,DOIOTI                ; IN COMES THE WHOLE BLOCK
1445         MOVE    PVP,PVSTOR+1
1446         SETZM   ASTO(PVP)       ; A NO LONGER SPECIAL
1447         MOVEI   C,BUFSTR-1(B)   ; NO RESET BUFFER
1448         PUSHJ   P,BYTDOP        ; A POINTS TO DOPW WORD
1449         SUBI    A,2
1450         HRLI    A,010700        ; SETUP BYTE POINTER TO END
1451         HLLZS   BUFSTR-1(B)     ; ZERO CHAR COUNNT
1452         MOVEM   A,BUFSTR(B)
1453         HRRZ    A,4(TB)         ; READ/READB FLG
1454         MOVE    C,(P)           ; ACCESS IN WORDS
1455         SKIPN   A               ; SKIP FOR ASCII
1456         IMULI   C,5             ; BUMP
1457         MOVEM   C,ACCESS(B)     ; UPDATE ACCESS
1458         PUSHJ   P,NIREAD        ; READ RSUBR VECTOR
1459         JRST    BRSUBR          ; LOSER
1460         GETYP   A,A             ; VERIFY A LITTLE
1461         CAIE    A,TVEC          ; DONT SKIP IF BAD
1462         JRST    BRSUBR          ; NOT A GOOD FILE
1463         PUSHJ   P,LSTCHR        ; FLUSH REREAD CHAR
1464         MOVE    C,(TP)          ; CODE VECTOR BACK
1465         MOVSI   A,TCODE
1466         HLR     A,B             ; FUNNY COUNT
1467         MOVEM   A,(B)           ; CLOBBER
1468         MOVEM   C,1(B)
1469         PUSH    TP,$TRSUBR      ; MAKE RSUBR
1470         PUSH    TP,B
1471
1472 ; NOW LOOK OVER FIXUPS
1473
1474         MOVE    B,5(TB)         ; GET CHANNEL
1475         MOVE    C,ACCESS(B)
1476         HLLZS   ACCESS-1(B)     ; FOR READB LOSER
1477         HRRZ    0,4(TB)         ; READ/READB FLG
1478         JUMPN   0,RSUB1
1479         ADDI    C,4             ; ROUND UP
1480         IDIVI   C,5             ; TO WORDS
1481         MOVEI   D,(C)           ; FIXUP ACCESS
1482         IMULI   D,5
1483         MOVEM   D,ACCESS(B)     ; AND STORE
1484 RSUB1:  ADDI    C,1             ; ACCOUNT FOR EXTRA COUNTERS
1485         MOVEM   C,(P)           ; SAVE FOR LATER
1486         MOVEI   A,-1(C)         ; FOR DOACS
1487         MOVEI   C,2             ; UPDATE REAL ACCESS
1488         SKIPN   0               ; SKIP FOR READB CASE
1489         MOVEI   C,10.
1490         ADDM    C,ACCESS(B)
1491         PUSHJ   P,DOACCS        ; DO THE ACCESS
1492         PUSH    TP,$TUVEC       ; SLOT FOR FIXUP BUFFER
1493         PUSH    TP,C%0
1494
1495 ; FOUND OUT IF FIXUPS STAY
1496
1497         MOVE    B,IMQUOTE KEEP-FIXUPS
1498         PUSHJ   P,ILVAL         ; GET VALUE
1499         GETYP   0,A
1500         MOVE    B,5(TB)         ; CHANNEL BACK TO B
1501         CAIE    0,TUNBOU
1502         CAIN    0,TFALSE
1503         JRST    RSUB4           ; NO, NOT KEEPING FIXUPS
1504         PUSH    P,C%0           ; SLOT TO READ INTO
1505         HRROI   A,(P)           ; GET LENGTH OF SAME
1506         PUSHJ   P,DOIOTI
1507         POP     P,C
1508         MOVEI   A,(C)           ; GET UVECTOR FOR KEEPING
1509         ADDM    C,(P)           ; ACCESS TO END
1510         PUSH    P,C             ; SAVE LENGTH OF FIXUPS
1511         PUSHJ   P,IBLOCK
1512         MOVEM   B,-6(TP)        ; AND SAVE
1513         MOVE    A,B             ; FOR IOTING THEM IN
1514         ADD     B,C%11          ; POINT PAST VERS #
1515         MOVEM   B,(TP)
1516         MOVSI   C,TUVEC
1517         MOVE    PVP,PVSTOR+1
1518         MOVEM   C,ASTO(PVP)
1519         MOVE    B,5(TB)         ; AND CHANNEL
1520         PUSHJ   P,DOIOTI                ; GET THEM
1521         MOVE    PVP,PVSTOR+1
1522         SETZM   ASTO(PVP)
1523         MOVE    A,(TP)          ; GET VERS
1524         PUSH    P,-1(A)         ; AND PUSH IT
1525         JRST    RSUB5
1526
1527 RSUB4:  PUSH    P,C%0
1528         PUSH    P,C%0           ; 2 SLOTS FOR READING
1529         MOVEI   A,-1(P)
1530         HRLI    A,-2
1531         PUSHJ   P,DOIOTI
1532         MOVE    C,-1(P)
1533         MOVE    D,(P)
1534         ADDM    C,-2(P)         ; NOW -2(P) IS ACCESS TO END OF FIXUPS
1535 RSUB5:  MOVEI   C,BUFSTR-1(B)   ; FIXUP BUFFER
1536         PUSHJ   P,BYTDOP
1537         SUBI    A,2             ; POINT BEFORE D.W.
1538         HRLI    A,10700
1539         MOVEM   A,BUFSTR(B)
1540         HLLZS   BUFSTR-1(B)
1541         SKIPE   -6(TP)
1542         JRST    RSUB2A
1543         SUBI    A,BUFLNT-1      ; ALSO MAKE AN IOT FLAVOR BUFFER
1544         HRLI    A,-BUFLNT
1545         MOVEM   A,(TP)
1546         MOVSI   C,TUVEC
1547         MOVE    PVP,PVSTOR+1
1548         MOVEM   C,ASTO(PVP)
1549         PUSHJ   P,DOIOTI
1550         MOVE    PVP,PVSTOR+1
1551         SETZM   ASTO(PVP)
1552 RSUB2A: PUSH    P,-1(P)         ; ANOTHER COPY OF LENGTH OF FIXUPS
1553
1554 ; LOOP FIXING UP NEW TYPES
1555
1556 RSUB2:  PUSHJ   P,WRDIN         ; SEE WHAT NEXT THING IS
1557         JRST    RSUB3           ; NO MORE, DONE
1558         JUMPL   E,STSQ          ; MUST BE FIRST SQUOZE
1559         MOVNI   0,(E)           ; TO UPDATE AMNT OF FIXUPS
1560         ADDB    0,(P)
1561         HRLI    E,(E)           ; IS LENGTH OF STRING IN WORDS
1562         ADD     E,(TP)          ; FIXUP BUFFER POINTER
1563         JUMPL   E,.+3
1564         SUB     E,[BUFLNT,,BUFLNT]
1565         JUMPGE  E,.-1           ; STILL NOT RIGHT
1566         EXCH    E,(TP)          ; FIX UP SLOT
1567         HLRE    C,E             ; FIX BYTE POINTER ALSO
1568         IMUL    C,[-5]          ; + CHARS LEFT
1569         MOVE    B,5(TB)         ; CHANNEL
1570         PUSH    TP,BUFSTR-1(B)
1571         PUSH    TP,BUFSTR(B)
1572         HRRM    C,BUFSTR-1(B)
1573         HRLI    E,440700        ; AND BYTE POINTER
1574         MOVEM   E,BUFSTR(B)
1575         PUSHJ   P,NIREAD        ; READ ATOM NAME OF TYPE
1576         TDZA    0,0             ; FLAG LOSSAGE
1577         MOVEI   0,1             ; WINNAGE
1578         MOVE    C,5(TB)         ; RESET BUFFER
1579         POP     TP,BUFSTR(C)
1580         POP     TP,BUFSTR-1(C)
1581         JUMPE   0,BRSUBR        ; BAD READ OF RSUBR
1582         GETYP   A,A             ; A LITTLE CHECKING
1583         CAIE    A,TATOM
1584         JRST    BRSUBR
1585         PUSHJ   P,LSTCHR        ; FLUSH REREAD CHAR
1586         HRRZ    0,4(TB)         ; FIXUP ACCESS PNTR
1587         MOVE    C,5(TB)
1588         MOVE    D,ACCESS(C)
1589         HLLZS   ACCESS-1(C)     ; FOR READB HACKER
1590         ADDI    D,4
1591         IDIVI   D,5
1592         IMULI   D,5
1593         SKIPN   0
1594         MOVEM   D,ACCESS(C)     ; RESET
1595 TYFIXE: PUSHJ   P,TYPFND        ; SEE IF A LEGAL TYPE NAME
1596         JRST    TYPFIX          ; GO SEE USER ABOUT THIS
1597         PUSHJ   P,FIXCOD        ; GO FIX UP THE CODE
1598         JRST    RSUB2
1599
1600 ; NOW FIX UP SUBRS ETC. IF NECESSARY
1601
1602 STSQ:   MOVE    B,IMQUOTE MUDDLE
1603         PUSHJ   P,IGVAL         ; GET CURRENT VERS
1604         CAME    B,-1(P)         ; SKIP IF NO FIXUPS NEEDED
1605         JRST    DOFIX0          ; MUST DO THEM
1606
1607 ; ALL DONE, ACCESS PAST FIXUPS AND RETURN
1608 RSUB31: PUSHJ   P,SQUKIL        ; DONE FIXING UP, KILL SQUOZE TABLE IF IN INTERP
1609 RSUB3:  MOVE    A,-3(P)
1610         MOVE    B,5(TB)
1611         MOVEI   C,(A)           ; UPDATE CHANNEL ACCESS IN CASE SKIPPING
1612         HRRZ    0,4(TB)         ; READ/READB FLAG
1613         SKIPN   0
1614         IMULI   C,5
1615         MOVEM   C,ACCESS(B)     ; INTO ACCESS SLOT
1616         HLLZS   ACCESS-1(B)
1617         PUSHJ   P,DOACCS        ; ACCESSED
1618         MOVEI   C,BUFSTR-1(B)   ; FIX UP BUFFER
1619         PUSHJ   P,BYTDOP
1620         SUBI    A,2
1621         HRLI    A,10700
1622         MOVEM   A,BUFSTR(B)
1623         HLLZS   BUFSTR-1(B)
1624         SKIPN   A,-6(TP)                ; SKIP IF KEEPING FIXUPS
1625         JRST    RSUB6
1626         PUSH    TP,$TUVEC
1627         PUSH    TP,A
1628         MOVSI   A,TRSUBR
1629         MOVE    B,-4(TP)
1630         MOVSI   C,TATOM
1631         MOVE    D,IMQUOTE RSUBR
1632         PUSHJ   P,IPUT          ; DO THE ASSOCIATION
1633
1634 RSUB6:  MOVE    C,-4(TP)        ; DO SPECIAL FIXUPS
1635         PUSHJ   P,SFIX
1636         MOVE    B,-2(TP)        ; GET RSUBR
1637         MOVSI   A,TRSUBR
1638         SUB     P,C%44          ; FLUSH P CRUFT
1639         SUB     TP,[10,,10]
1640         JRST    RET
1641
1642 ; FIXUP SUBRS ETC.
1643
1644 DOFIX0: SKIPN   C,-6(TP)                ; GET BUFFER IF KEEPING
1645         JRST    DOFIXE
1646         MOVEM   B,(C)           ; CLOBBER
1647         JRST    DOFIXE
1648
1649 FIXUPL: PUSHJ   P,WRDIN
1650         JRST    RSUB31
1651 DOFIXE: JUMPGE  E,BRSUBR
1652         TLZ     E,740000        ; KILL BITS
1653 IFN KILTV,[
1654         CAME    E,[SQUOZE 0,DSTO]
1655         JRST    NOOPV
1656         MOVE    E,[SQUOZE 40,DSTORE]
1657         MOVE    A,(TP)
1658         SKIPE   -6(TP)
1659         MOVEM   E,-1(A)
1660         MOVEI   E,53
1661         HRLM    E,(A)
1662         MOVEI   E,DSTORE
1663         JRST    .+3
1664 NOOPV:
1665 ]
1666         PUSHJ   P,SQUTOA        ; LOOK IT UP
1667         PUSHJ   P,BRSUB1
1668         MOVEI   D,(E)           ; FOR FIXCOD
1669         PUSHJ   P,FIXCOD        ; FIX 'EM UP
1670         JRST    FIXUPL
1671
1672 ; BAD SQUOZE, BE MORE SPECIFIC
1673
1674 BRSUB1: PUSHJ   P,SQSTR
1675         PUSH    TP,$TATOM
1676         PUSH    TP,EQUOTE SQUZE-SYMBOL-NOT-FOUND-ERRET CORRECTION
1677         PUSH    TP,A
1678         PUSH    TP,B
1679         PUSH    TP,$TATOM
1680         PUSH    TP,MQUOTE READ
1681         MCALL   3,ERROR
1682         GETYP   A,A
1683         CAIE    A,TFIX
1684         ERRUUO  EQUOTE VALUE-MUST-BE-FIX
1685         MOVE    E,B
1686         POPJ    P,
1687
1688 ; CONVERT SQUOZE TO A MUDDLE STRING FOR USER
1689
1690 SQSTR:  PUSHJ   P,SPTT
1691         PUSH    P,C
1692         CAIN    B,6             ; 6 chars?
1693         PUSH    P,D
1694         PUSH    P,B
1695         PUSHJ   P,CHMAK
1696         POPJ    P,
1697
1698 SPTT:   SETZB   B,C
1699         MOVE    A,[440700,,C]
1700         MOVEI   D,0
1701
1702 SPT1:   IDIVI   E,50
1703         PUSH    P,F
1704         JUMPE   E,SPT3
1705         PUSHJ   P,SPT1
1706 SPT3:   POP     P,E
1707         ADDI    E,"0-1
1708         CAILE   E,"9
1709         ADDI    E,"A-"9-1
1710         CAILE   E,"Z
1711         SUBI    E,"Z-"#+1
1712         CAIN    E,"#
1713         MOVEI   E,".
1714         CAIN    E,"/
1715 SPC:    MOVEI   E,40
1716         IDPB    E,A
1717         ADDI    B,1
1718         POPJ    P,
1719
1720
1721 ;0    1-12 13-44 45 46 47
1722 ;NULL 0-9   A-Z  .  $  %
1723
1724 ; ROUTINE TO FIXUP ACTUAL CODE
1725
1726 FIXCOD: MOVEI   E,0             ; FOR HWRDIN
1727         PUSH    P,D             ; NEW VALUE
1728         PUSHJ   P,HWRDIN        ; GET HW NEEDED
1729         MOVE    D,(P)           ; GET NEW VAL
1730         MOVE    A,(TP)          ; AND BUFFER POINTER
1731         SKIPE   -6(TP)          ; SAVING?
1732         HRLM    D,-1(A)         ; YES, CLOBBER
1733         SUB     C,(P)           ; DIFFERENCE
1734         MOVN    D,C
1735
1736 FIXLP:  PUSHJ   P,HWRDIN        ; GET AN OFFSET
1737         JUMPE   C,FIXED
1738         HRRES   C               ; MAKE NEG IF NEC
1739         JUMPL   C,LHFXUP
1740         ADD     C,-4(TP)        ; POINT INTO CODE
1741 IFN KILTV,[
1742         LDB     0,[220400,,-1(C)]       ; GET INDEX FIELD
1743         CAIE    0,7
1744         JRST    NOTV
1745 KIND:   MOVEI   0,0
1746         DPB     0,[220400,,-1(C)]
1747         JRST    DONTV
1748 NOTV:   CAIE    0,6                     ; IS IT PVP
1749         JRST    DONTV
1750         HRRZ    0,-1(C)
1751         CAIE    0,12                    ; OLD DSTO
1752         JRST    DONTV
1753         MOVEI   0,33.
1754         ADDM    0,-1(C)
1755         JRST    KIND
1756 DONTV:
1757 ]
1758         ADDM    D,-1(C)
1759         JRST    FIXLP
1760
1761 LHFXUP: MOVMS   C
1762         ADD     C,-4(TP)
1763         MOVSI   0,(D)
1764         ADDM    0,-1(C)
1765         JRST    FIXLP
1766
1767 FIXED:  SUB     P,C%11
1768         POPJ    P,
1769
1770 ; ROUTINE TO READ A WORD FROM BUFFER
1771
1772 WRDIN:  PUSH    P,A
1773         PUSH    P,B
1774         SOSG    -3(P)           ; COUNT IT DOWN
1775         JRST    WRDIN1
1776         AOS     -2(P)           ; SKIP RETURN
1777         MOVE    B,5(TB)         ; CHANNEL
1778         HRRZ    A,4(TB)         ; READ/READB SW
1779         MOVEI   E,5
1780         SKIPE   A
1781         MOVEI   E,1
1782         ADDM    E,ACCESS(B)
1783         MOVE    A,(TP)          ; BUFFER
1784         MOVE    E,(A)
1785         AOBJP   A,WRDIN2        ; NEED NEW BUFFER
1786         MOVEM   A,(TP)
1787 WRDIN1: POP     P,B
1788         POP     P,A
1789         POPJ    P,
1790
1791 WRDIN2: MOVE    B,-3(P)         ; IS THIS LAST WORD?
1792         SOJLE   B,WRDIN1        ; YES, DONT RE-IOT
1793         SUB     A,[BUFLNT,,BUFLNT]
1794         MOVEM   A,(TP)
1795         MOVSI   B,TUVEC
1796         MOVE    PVP,PVSTOR+1
1797         MOVEM   B,ASTO(PVP)
1798         MOVE    B,5(TB)
1799         PUSHJ   P,DOIOTI
1800         MOVE    PVP,PVSTOR+1
1801         SETZM   ASTO(PVP)
1802         JRST    WRDIN1
1803
1804 ; READ IN NEXT HALF WORD
1805
1806 HWRDIN: JUMPN   E,NOIOT         ; USE EXISTING WORD
1807         PUSH    P,-3(P)         ; FAKE OUT WRDIN IF NEC.
1808         PUSHJ   P,WRDIN
1809         JRST    BRSUBR
1810         POP     P,-4(P)         ; RESET COUNTER
1811         HLRZ    C,E             ; RET LH
1812         POPJ    P,
1813
1814 NOIOT:  HRRZ    C,E
1815         MOVEI   E,0
1816         POPJ    P,
1817
1818 TYPFIX: PUSH    TP,$TATOM
1819         PUSH    TP,EQUOTE BAD-TYPE-NAME
1820         PUSH    TP,$TATOM
1821         PUSH    TP,B
1822         PUSH    TP,$TATOM
1823         PUSH    TP,EQUOTE ERRET-TYPE-NAME-DESIRED
1824         MCALL   3,ERROR
1825         JRST    TYFIXE
1826
1827 BRSUBR: ERRUUO  EQUOTE RSUBR-IN-BAD-FORMAT
1828 \f
1829
1830
1831 ;TABLE OF BYTE POINTERS FOR GETTING CHARS
1832
1833 BYTPNT":        350700,,CHTBL(A)
1834         260700,,CHTBL(A)
1835         170700,,CHTBL(A)
1836         100700,,CHTBL(A)
1837         010700,,CHTBL(A)
1838
1839 ;HERE ARE THE TABLES OF CHXRACTERS (NOTE EVERYTHING NOT SPECIFIED IS
1840 ;IN THE NUMBER LETTER CATAGORY)
1841
1842 CHROFF==0                       ; USED FOR ! HACKS
1843 SETCHR NUMCOD,[0123456789]
1844
1845 SETCHR PLUCOD,[+]
1846
1847 SETCHR NEGCOD,[-]
1848
1849 SETCHR ASTCOD,[*]
1850
1851 SETCHR DOTTYP,[.]
1852
1853 SETCHR ETYPE,[Ee]
1854
1855 SETCOD SPATYP,[0,15,12,11,14,40,33]     ;ALL ARE TYPE 2 (SPACING - FF,TAB,SPACE,ALT-MODE)
1856
1857 INCRCH LPATYP,[()[]'%"\#<>]     ;GIVE THESE INCREASRNG CODES FROM 3
1858
1859 SETCOD EOFTYP,[3]       ;^C - EOF CHARACTER
1860
1861 SETCOD SPATYP,[32]      ;^Z - TENEX/TOPS-20 EOF (SET IN BOTH TO BE CONSISTENT)
1862
1863 INCRCH COMTYP,[;,{}!]           ;COMMENT AND GLOBAL VALUE AND SPECIAL
1864
1865 CHROFF==200             ; CODED AS HAVING 200 ADDED
1866
1867 INCRCH EXCEXC,[!.[]'"<>,-\]
1868
1869 SETCOD MANYT,[33]
1870
1871 CHTBL:
1872         OUTTBL                  ;OUTPUT THE TABLE RIGHT HERE
1873
1874
1875 \f; THIS CODE FLUSHES WANDERING COMMENTS
1876
1877 COMNT:  PUSHJ   P,IREAD
1878         JRST    COMNT2
1879         JRST    BDLP
1880
1881 COMNT2: SKIPL   A,5(TB)         ; RESTORE CHANNEL
1882         MOVEI   A,5(TB)-LSTCH   ;NO CHANNEL, POINT AT SLOT
1883         HRRM    B,LSTCH(A)      ; CLOBBER IN CHAR
1884         PUSHJ   P,ERRPAR
1885         JRST    BDLP
1886 \f
1887
1888 ;HERE TO SET UP FOR .FOO ..FOO OR.<ABC>
1889
1890 DOTSTR: PUSHJ   P,NXTCH1        ; GOBBLE A NEW CHARACTER
1891         MOVEI   FF,FRSDOT+DOTSEN+NUMWIN ; SET FLAG IN CASE
1892         CAIN    B,NUMCOD        ; SKIP IF NOT NUMERIC
1893         JRST    DOTST1          ; NUMERIC, COULD BE FLONUM
1894
1895 ; CODE TO HANDLE ALL IMPLICIT CALLS  I.E. QUOTE, LVAL, GVAL
1896
1897         TRZ     FF,NUMWIN       ; WE ARE NOT A NUMBER
1898         MOVSI   B,TFORM         ; LVAL
1899         MOVE    A,IMQUOTE LVAL
1900         JRST    IMPCA1
1901
1902 GLOSEG: SKIPA   B,$TSEG         ;SEG CALL TO GVAL
1903 GLOVAL: MOVSI   B,TFORM ;FORM CALL TO SAME
1904         MOVE    A,IMQUOTE GVAL
1905         JRST    IMPCAL
1906
1907 QUOSEG: SKIPA   B,$TSEG         ;SEG CALL TO QUOTE
1908 QUOTIT: MOVSI   B,TFORM
1909         MOVE    A,IMQUOTE QUOTE
1910         JRST    IMPCAL
1911
1912 SEGDOT: MOVSI   B,TSEG          ;SEG CALL TO LVAL
1913         MOVE    A,IMQUOTE LVAL
1914 IMPCAL: PUSHJ   P,LSTCHR        ;FLUSH LAST CHAR EXCEPT
1915 IMPCA1: PUSH    TP,$TATOM       ;FOR .FOO FLAVOR
1916         PUSH    TP,A            ;PUSH ARGS
1917         PUSH    P,B             ;SAVE TYPE
1918         PUSHJ   P,IREAD1                ;READ
1919         JRST    USENIL          ; IF NO ARG, USE NIL
1920 IMPCA2: PUSH    TP,C
1921         PUSH    TP,D
1922         MOVE    C,A             ; GET READ THING
1923         MOVE    D,B
1924         PUSHJ   P,INCONS        ; CONS TO NIL
1925         MOVEI   E,(B)           ; PREPARE TON CONS ON
1926 POPARE: POP     TP,D            ; GET ATOM BACK
1927         POP     TP,C
1928         EXCH    C,-1(TP)        ; SAVE THAT COMMENT
1929         EXCH    D,(TP)
1930         PUSHJ   P,ICONS
1931         POP     P,A             ;GET FINAL TYPE
1932         JRST    RET13           ;AND RETURN
1933
1934
1935 USENIL: PUSH    TP,C
1936         PUSH    TP,D
1937         SKIPL   A,5(TB)         ; RESTOR LAST CHR
1938         MOVEI   A,5(TB)-LSTCH   ;NO CHANNEL, POINT AT SLOT
1939         HRRM    B,LSTCH(A)
1940         MOVEI   E,0
1941         JRST    POPARE
1942 \f
1943 ;HERE AFTER READING ATOM TO CALL VALUE
1944
1945 .SET:   PUSH    P,$TFORM        ;GET WINNING TYPE
1946         MOVE    E,(P)
1947         PUSHJ   P,RETC          ; CHECK FOR POSSIBLE COMMENT
1948         PUSH    TP,$TATOM
1949         PUSH    TP,IMQUOTE LVAL
1950         JRST    IMPCA2          ;GO CONS LIST
1951
1952 LOOPA:  PUSH    P,FF            ; SAVE FLAGS IN CASE .ATOM
1953 LOOPAT: PUSHJ   P,NXTCH         ; CHECK FOR TRAILER
1954         CAIN    B,PATHTY        ; PATH BEGINNER
1955         JRST    PATH0           ; YES, GO PROCESS
1956         CAIN    B,SPATYP        ; SPACER?
1957         PUSHJ   P,SPACEQ        ; CHECK FOR REAL SPACE
1958         JRST    PATH2
1959         PUSHJ   P,LSTCHR        ; FLUSH IT AND RETRY
1960         JRST    LOOPAT
1961 PATH0:  PUSHJ   P,NXTCH1        ; READ FORCED NEXT
1962         CAIE    B,SPCTYP        ; DO #FALSE () HACK
1963         CAIN    B,ESCTYP
1964         JRST    PATH4
1965         CAIL    B,SPATYP        ; SPACER?
1966         JRST    PATH3           ; YES, USE THE ROOT OBLIST
1967 PATH4:  PUSHJ   P,NIREA1        ; READ NEXT ITEM
1968         PUSHJ   P,ERRPAR        ; LOSER
1969         CAME    A,$TATOM        ; ONLY ALLOW ATOMS
1970         JRST    BADPAT
1971
1972         PUSH    TP,A
1973         PUSH    TP,B
1974         MOVSI   C,TATOM
1975         MOVE    D,IMQUOTE OBLIST
1976         PUSHJ   P,IGET          ; GET THE OBLIST
1977                                 ; IF NOT OBLIST, MAKE ONE
1978         JUMPN   B,PATH6
1979         MCALL   1,MOBLIS        ; MAKE ONE
1980         JRST    PATH1
1981
1982 PATH6:  SUB     TP,C%22
1983         JRST    PATH1
1984
1985
1986 PATH3:  MOVE    B,ROOT+1        ; GET ROOT OBLIST
1987         MOVSI   A,TOBLS
1988 PATH1:  POP     P,FF            ; FLAGS
1989         TRNE    FF,FRSDOT
1990         JRST    PATH.
1991         PUSHJ   P,RLOOKU                ; AND LOOK IT UP
1992
1993         JRST    RET
1994
1995 PATH.:  PUSHJ   P,RLOOKU
1996         JRST    .SET                    ; CONS AN LVAL FORM
1997
1998 SPACEQ: ANDI    A,-1
1999         CAIE    A,33
2000         CAIN    A,400033
2001         POPJ    P,
2002         CAIE    A,3
2003         AOS     (P)
2004         POPJ    P,
2005 \f
2006
2007 PATH2:  MOVE    B,IMQUOTE OBLIST
2008         PUSHJ   P,IDVAL
2009         JRST    PATH1
2010
2011 BADPAT: ERRUUO  EQUOTE NON-ATOMIC-OBLIST-NAME
2012
2013 \f
2014
2015 ; HERE TO READ ONE CHARACTER FOR USER.
2016
2017 CREDC1: SUBM    M,(P)
2018         PUSH    TP,A
2019         PUSH    TP,B
2020         PUSHJ   P,IREADC
2021         JRST    CRDEO1
2022         JRST    RMPOPJ
2023
2024 CNXTC1: SUBM    M,(P)
2025         PUSH    TP,A
2026         PUSH    TP,B
2027         PUSHJ   P,INXTRD
2028         JRST    CRDEO1
2029         JRST    RMPOPJ
2030
2031 CRDEO1: MOVE    B,(TP)
2032         PUSH    TP,EOFCND-1(B)
2033         PUSH    TP,EOFCND(B)
2034         PUSH    TP,$TCHAN
2035         PUSH    TP,B
2036         MCALL   1,FCLOSE
2037         MCALL   1,EVAL
2038         JRST    RMPOPJ
2039
2040
2041 CREADC: SUBM    M,(P)
2042         PUSH    TP,A
2043         PUSH    TP,B
2044         PUSHJ   P,IREADC
2045         JRST    CRDEOF
2046         SOS     (P)
2047         JRST    RMPOPJ
2048
2049 CNXTCH: SUBM    M,(P)
2050         PUSH    TP,A
2051         PUSH    TP,B
2052         PUSHJ   P,INXTRD
2053         JRST    CRDEOF
2054         SOS     (P)
2055 RMPOPJ: SUB     TP,C%22
2056         JRST    MPOPJ
2057
2058 CRDEOF: .MCALL  1,FCLOSE
2059         MOVSI   A,TCHRS
2060         HRROI   B,3
2061         JRST    MPOPJ
2062
2063 INXTRD: TDZA    E,E
2064 IREADC: MOVEI   E,1
2065         MOVE    B,(TP)          ; CHANNEL
2066         HRRZ    A,-2(B)         ; GET BLESS BITS
2067         TRNE    A,C.BIN
2068         TRNE    A,C.BUF
2069         JRST    .+3
2070         PUSHJ   P,GRB
2071         HRRZ    A,-2(B)
2072         TRC     A,C.OPN+C.READ
2073         TRNE    A,C.OPN+C.READ
2074         JRST    BADCHN
2075         SKIPN   A,LSTCH(B)
2076         PUSHJ   P,RXCT
2077         TLO     A,200000
2078         MOVEM   A,LSTCH(B)      ; SAVE CHAR
2079         CAMN    A,C%M1          ; [-1]  ; SPECIAL PSEUDO TTY HACK?
2080         JRST    PSEUDO          ; YES, RET AS FIX
2081 ;       ANDI    A,-1
2082         TLZ     A,200000
2083         TRZN    A,400000        ; UNDO ! HACK
2084         JRST    NOEXCL
2085         SKIPE   E
2086         MOVEM   A,LSTCH(B)
2087         MOVEI   A,"!            ; RETURN AN !
2088 NOEXC1: SKIPGE  B,A             ; CHECK EOF
2089         SOS     (P)             ; DO EOF RETURN
2090         MOVE    B,A             ; CHAR TO B
2091         MOVSI   A,TCHRS
2092 PSEUD1: AOS     (P)
2093         POPJ    P,
2094
2095 PSEUDO: MOVE    F,B
2096         SKIPE   E
2097         PUSHJ   P,LSTCH2
2098         MOVE    B,A
2099         MOVSI   A,TFIX
2100         JRST    PSEUD1
2101
2102 NOEXCL: JUMPE   E,NOEXC1
2103         MOVE    F,B
2104         PUSHJ   P,LSTCH2
2105         JRST    NOEXC1
2106
2107 ; READER ERRORS COME HERE
2108
2109 ERRPAR: PUSH    TP,$TCHRS       ;DO THE OFFENDER
2110         PUSH    TP,B
2111         PUSH    TP,$TCHRS
2112         PUSH    TP,[40]         ;SPACE
2113         PUSH    TP,$TCHSTR
2114         PUSH    TP,CHQUOT UNEXPECTED
2115         JRST    MISMA1
2116
2117 ;COMPLAIN ABOUT MISMATCHED CLOSINGS
2118
2119 MISMAB: SKIPA   A,["]]
2120 MISMAT: MOVE    A,-1(P)         ;GOBBLE THE DESIRED CHARACTER
2121         JUMPE   B,CPOPJ         ;IGNORE UNIVERSAL CLOSE
2122         PUSH    TP,$TCHRS
2123         PUSH    TP,B
2124         PUSH    TP,$TCHSTR
2125         PUSH    TP,CHQUOT [ INSTEAD-OF ]
2126         PUSH    TP,$TCHRS
2127         PUSH    TP,A
2128 MISMA1: MCALL   3,STRING
2129         PUSH    TP,$TATOM
2130         PUSH    TP,EQUOTE READER-SYNTAX-ERROR-ERRET-ANYTHING-TO-GO-ON
2131         PUSH    TP,A
2132         PUSH    TP,B
2133         PUSH    TP,$TATOM
2134         PUSH    TP,MQUOTE READ
2135         MCALL   3,ERROR
2136 CPOPJ:  POPJ    P,
2137 \f
2138 ; HERE ON BAD INPUT CHARACTER
2139
2140 BADCHR: ERRUUO  EQUOTE BAD-ASCII-CHARACTER
2141
2142 ; HERE ON YUCKY PARSE TABLE
2143
2144 BADPTB: ERRUUO  EQUOTE BAD-MACRO-TABLE
2145
2146 BDPSTR: ERRUUO  EQUOTE BAD-PARSE-STRING
2147
2148 ILLSQG: PUSHJ   P,LSTCHR        ; DON'T MESS WITH IT AGAIN
2149         ERRUUO  EQUOTE BAD-USE-OF-SQUIGGLY-BRACKETS
2150
2151
2152 ;FLOATING POINT NUMBER TOO LARGE OR SMALL
2153 FOOR:   ERRUUO  EQUOTE NUMBER-OUT-OF-RANGE
2154
2155
2156 NILSXP: 0,,0
2157
2158 LSTCHR: SKIPL   F,5(TB) ;GET CHANNEL
2159         JRST    LSTCH1          ;NO CHANNEL, POINT AT SLOT
2160
2161 LSTCH2: SKIPE   LSTCH(F)        ;ARE WE REALLY FLUSHING A REUSE CHARACTER ?
2162         PUSHJ   P,CNTACX
2163         SETZM   LSTCH(F)
2164         POPJ    P,
2165
2166 LSTCH1: SETZM   5(TB)           ;ZERO THE LETTER AND RETURN
2167         POPJ    P,
2168
2169 CNTACC: MOVE    F,B
2170 CNTACX: HRRZ    G,-2(F)         ; GET BITS
2171         TRNE    G,C.BIN
2172         JRST    CNTBIN
2173         AOS     ACCESS(F)
2174 CNTDON: POPJ    P,
2175
2176 CNTBIN: AOS     G,ACCESS-1(F)
2177         CAMN    G,[TFIX,,1]
2178          AOS    ACCESS(F)
2179         CAMN    G,[TFIX,,5]
2180          HLLZS  ACCESS-1(F)
2181         POPJ    P,
2182
2183
2184 ;TABLE OF NAMES OF ARGS AND ALLOWED TYPES
2185
2186 ARGS:
2187         IRP     A,,[[[CAIN C,TUNBOU]],[[CAIE C,TCHAN],INCHAN],[[PUSHJ P,CHOBL],OBLIST]]
2188                 IRP B,C,[A]
2189                         B
2190                         IFSN [C],IMQUOTE C
2191                         .ISTOP
2192                 TERMIN
2193         TERMIN
2194
2195 CHOBL:  CAIE    C,TLIST ;A LIST OR AN OBLIST
2196         CAIN    C,TOBLS
2197         AOS     (P)
2198         POPJ    P,
2199
2200 END
2201
2202 \f