<mdl.int>/reader.mid.357

   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: TRNN    FF,EFLG         ; IF NOT IN EXPONENT, LOSE
 809          TRNE   FF,ENEG+EPOS    ; SIGN FOR EXPONENT SEEN?
 810           JRST  NUMCH3          ; NOT A NUMBER
 811         CAIN    B,PLUCOD
 812         TRO     FF,EPOS
 813         CAIN    B,NEGCOD
 814         TRO     FF,ENEG
 815         TRNE    FF,EPOS+ENEG
 816         JRST    ATLP1
 817         JRST    NUMCH3
 818
 819 ; HERE AFTER \ QUOTER
 820
 821 DOESC1: PUSHJ   P,NXTC1         ; GET CHAR
 822         JRST    ATLP1           ; FALL BACK INTO LOOP
 823
 824
 825 ; HERE TO CONVERT NUMBERS AS NEEDED
 826
 827 NUMCNV: CAIE    B,ESCTYP
 828         TRNE    FF,OCTSTR
 829         JRST    NUMCH3
 830         TRNN    FF,NUMWIN
 831         JRST    NUMCH3
 832         ADDI    D,4
 833         IDIVI   D,5
 834         SKIPGE  C               ; SKIP IF NEW WORD ADDED
 835         ADDI    D,1
 836         HRLI    D,(D)           ; TOO BOTH HALVES
 837         SUB     P,D             ; REMOVE CHAR STRING
 838         MOVE    D,3(TB)         ; IS RADIX 10?
 839         CAIE    D,10.
 840         TRNE    FF,DECFRC
 841         TRNN    FF,FLONUM+EFLG  ;IS IT A FLOATING POINT NUMBER
 842         TRNE    FF,EFLG
 843         JRST    FLOATIT         ;YES, GO MAKE IT WIN
 844         TRNE    FF,OVFLEW
 845         JRST    FOOR
 846         MOVE    B,CNUM(TP)
 847         TRNE    FF,DECFRC
 848         MOVE    B,DNUM(TP)      ;GRAB FIXED GOODIE
 849         TRNE    FF,OCTWIN       ; SKIP IF NOT OCTAL
 850         MOVE    B,ONUM(TP)      ; USE OCTAL VALUE
 851 FINID2: MOVSI   A,TFIX          ;SAY FIXED POINT
 852 FINID1: TRNE    FF,NEGF         ;NEGATE
 853         MOVNS   B               ;YES
 854         SUB     TP,[NUMTMP,,NUMTMP]     ;FINISH HACK
 855         JRST    RET             ;AND RETURN
 856
 857 \f
 858 FLOATIT:
 859         JFCL    17,.+1          ;CLEAR ALL ARITHMETIC FLAGS
 860         TRNE    FF,EFLG         ;"E" SEEN?
 861         JRST    EXPDO           ;YES, DO EXPONENT
 862         MOVE    D,NDIGS(TP)     ;GET IMPLICIT EXPONENT
 863
 864 FLOATE: MOVE    A,DNUM(TP)      ;GET DECIMAL NUMBER
 865         IDIVI   A,400000        ;SPLIT
 866         FSC     A,254           ;CONVERT MOST SIGNIFICANT
 867         FSC     B,233           ; AND LEAST SIGNIFICANT
 868         FADR    B,A             ;COMBINE
 869
 870         MOVM    A,D             ;GET MAGNITUDE OF EXPONENT
 871         MOVSI   E,(1.0)
 872         JFCL    17,.+1          ; CLEAR ALL OVERFLOW/UNDERFLOW BITS
 873         CAIG    A,38.           ;HOW BIG?
 874         JRST    .+3             ;TOO BIG-FLOATING OUT OF RANGE
 875         MOVE    E,[1.0^38.]
 876         SUBI    A,38.
 877         JUMPGE  D,FLOAT1        ;JUMP IF EXPONENT POSITIVE
 878         FDVR    B,E
 879         FDVR    B,TENTAB(A)     ;DIVIDE BY TEN TO THE EXPONENT
 880         JRST    SETFLO
 881
 882 FLOAT1: FMPR    B,E
 883         FMPR    B,TENTAB(A)     ;SCALE UP
 884
 885 SETFLO: JFCL    17,FOOR         ;FLOATING OUT OF RANGE ON OVERFLOW
 886         MOVSI   A,TFLOAT
 887         TRZ     FF,FRSDOT       ;FLOATING NUMBER NOT VALUE
 888         JRST    FINID1
 889
 890 EXPDO:
 891         HRRZ    D,ENUM(TP)      ;GET EXPONENT
 892         TRNE    FF,ENEG         ;IS EXPONENT NEGATIVE?
 893         MOVNS   D               ;YES
 894         ADD     D,NDIGS(TP)     ;ADD IMPLICIT EXPONENT
 895         JUMPL   D,FLOATE        ;FLOATING IF EXPONENT NEGATIVE
 896         CAIG    D,10.           ;OR IF EXPONENT TOO LARGE
 897         TRNE    FF,FLONUM       ;OR IF FLAG SET
 898         JRST    FLOATE
 899         MOVE    B,DNUM(TP)      ;
 900         IMUL    B,ITENTB(D)
 901         JFCL    10,FLOATE       ;IF OVERFLOW, MAKE FLOATING
 902         JRST    FINID2          ;GO MAKE FIXED NUMBER
 903
 904
 905 ; HERE TO START BUILDING A CHARACTER STRING GOODIE
 906
 907 CSTRING:
 908         PUSH    P,C%0
 909         MOVEI   D,0             ; CHARCOUNT
 910         MOVSI   C,440700+P      ; AND BYTE POINTER
 911
 912 CSLP:   PUSH    P,FF
 913         INTGO
 914         PUSHJ   P,NXTC1         ; GET NEXT CHAR
 915         POP     P,FF
 916
 917         CAIN    B,CSTYP         ; END OF STRING?
 918         JRST    CSLPEND
 919
 920         CAIN    B,ESCTYP        ; ESCAPE?
 921         PUSHJ   P,NXTC1
 922
 923         IDPB    A,C             ; INTO ATOM
 924         TLNE    C,760000        ; SKIP IF OK WORD
 925         AOJA    D,CSLP
 926
 927         PUSH    P,C%0
 928         MOVSI   C,440700+P
 929         AOJA    D,CSLP
 930
 931 CSLPEND:
 932         SKIPGE  C
 933         SUB     P,C%11
 934         PUSH    P,D
 935         PUSHJ   P,CHMAK
 936         PUSHJ   P,LSTCHR
 937
 938         JRST    RET
 939
 940 ;ARRIVE HERE TO INVOKE A READ TIME MACRO FUNCTION
 941
 942 MACCAL: PUSHJ   P,NXTCH1        ;READ ONE MORE CHARACTER
 943         CAIE    B,MACTYP        ;IS IT ANOTHER MACRO CHAR
 944
 945         JRST    MACAL2          ;NO, CALL MACRO AND USE VALUE
 946         PUSHJ   P,LSTCHR        ;DONT REREAD %
 947         PUSHJ   P,MACAL1        ;OTHERWISE, USE SIDE EFFECCT, BUT NOT VALUE
 948         JRST    IREAD2
 949
 950 MACAL2: PUSH    P,[RET12]
 951 MACAL1: PUSHJ   P,IREAD1        ;READ FUNCTION NAME
 952         PUSHJ   P,RETERR
 953         PUSH    TP,C
 954         PUSH    TP,D            ; SAVE COMMENT IF ANY
 955         PUSH    TP,A            ;SAVE THE RESULT
 956         PUSH    TP,B            ;AND USE IT AS AN ARGUMENT
 957         MCALL   1,EVAL
 958         POP     TP,D
 959         POP     TP,C            ; RESTORE COMMENT IF ANY...
 960 CRET:   POPJ    P,RET12
 961
 962 ;CALL GOBBLE TO FIND THE TYPE AND THEN IREAD TO READ IT
 963
 964 SPECTY: PUSHJ   P,NIREAD        ; READ THE TYPES NAME (SHOULD BE AN ATOM)
 965         PUSHJ   P,RETERR
 966         PUSH    TP,A
 967         PUSH    TP,B
 968         GETYP   A,A
 969         CAIN    A,TFIX
 970         JRST    BYTIN
 971         PUSHJ   P,NXTCH         ; GET NEXT CHAR
 972         CAIN    B,TMPTYP        ; SKIP IF NOT TEMPLATE START
 973         JRST    RDTMPL
 974         SETZB   A,B
 975         EXCH    A,-1(TP)
 976         EXCH    B,(TP)
 977         PUSH    TP,A            ;BEGIN SETTING UP CHTYPE CALL
 978         PUSH    TP,B
 979         PUSHJ   P,IREAD1        ;NOW READ STRUCTURE
 980         PUSHJ   P,RETERR
 981         MOVEM   C,-3(TP)        ; SAVE COMMENT
 982         MOVEM   D,-2(TP)
 983         EXCH    A,-1(TP)        ;USE AS FIRST ARG
 984         EXCH    B,(TP)
 985         PUSH    TP,A            ;USE OTHER AS 2D ARG
 986         PUSH    TP,B
 987         MCALL   2,CHTYPE        ;ATTEMPT TO MUNG
 988 RET13:  POP     TP,D
 989         POP     TP,C            ; RESTORE COMMENT
 990 RET12:  SETOM   (P)             ; DONT LOOOK FOR MORE!
 991         JRST    RET
 992
 993 RDTMPL: PUSH    P,["}]          ; SET UP TERMINATE TEST
 994         MOVE    B,(TP)
 995         PUSHJ   P,IGVAL
 996         MOVEM   A,-1(TP)
 997         MOVEM   B,(TP)
 998         PUSH    P,[BLDTMP]      ; FLAG FOR VECTOR READING CODE
 999         JRST    LBRAK2
1000
1001 BLDTMP: ADDI    A,1             ; 1 MORE ARGUMENT
1002         ACALL   A,APPLY         ; DO IT TO IT
1003         POPJ    P,
1004
1005 BYTIN:  PUSHJ   P,NXTCH         ; CHECK FOR OPENR
1006         CAIN    B,SPATYP
1007         PUSHJ   P,SPACEQ
1008         JRST    .+3
1009         PUSHJ   P,LSTCHR
1010         JRST    BYTIN
1011         CAIE    B,TMPTYP
1012         ERRUUO  EQUOTE BAD-USE-OF-BYTE-STRING
1013         PUSH    P,["}]
1014         PUSH    P,[CBYTE1]
1015         JRST    LBRAK2
1016
1017 CBYTE1: AOJA    A,CBYTES
1018
1019 RETERR: SKIPL   A,5(TB)
1020         MOVEI   A,5(TB)-LSTCH   ;NO CHANNEL, USE SLOT
1021         HRRM    B,LSTCH(A)      ; RESTORE LAST CHAR
1022         PUSHJ   P,ERRPAR
1023         SOS     (P)
1024         SOS     (P)
1025         POPJ    P,
1026
1027 \f
1028 ;THIS CODE CALLS IREAD RECURSIVELY TO READ THAT WHICH IS
1029 ;BETWEEN (),  ARRIVED AT WHEN ( IS READ
1030
1031 SEGIN:  PUSH    TP,$TSEG
1032         JRST    OPNAN1
1033
1034 OPNANG: PUSH    TP,$TFORM       ;SAVE TYPE
1035 OPNAN1: PUSH    P,[">]
1036         JRST    LPARN1
1037
1038 LPAREN: PUSH    P,[")]
1039         PUSH    TP,$TLIST       ;START BY ASSUMING NIL
1040 LPARN1: PUSH    TP,C%0
1041         PUSHJ   P,LSTCHR        ;DON'T REREAD PARENS
1042 LLPLOP: PUSHJ   P,IREAD1        ;READ IT
1043         JRST    LDONE           ;HIT TERMINATOR
1044
1045 ;HERE WHEN MUST ADD CAR TO CURRENT WINNER
1046
1047 GENCAR: PUSH    TP,C            ; SAVE COMMENT
1048         PUSH    TP,D
1049         MOVE    C,A             ; SET UP CALL
1050         MOVE    D,B
1051         PUSHJ   P,INCONS        ; CONS ON TO NIL
1052         POP     TP,D
1053         POP     TP,C
1054         POP     TP,E            ;GET CDR
1055         JUMPN   E,CDRIN         ;IF STACKED GOODIE NOT NIL SKIP
1056         PUSH    TP,B            ;AND USE AS TOTAL VALUE
1057         PUSH    TP,$TLIST       ;SAVE THIS AS FIRSST THING ON LIST
1058         MOVE    A,-2(TP)        ; GET REAL TYPE
1059         JRST    .+2             ;SKIP CDR SETTING
1060 CDRIN:  HRRM    B,(E)
1061         PUSH    TP,B            ;CLOBBER IN NEW PARTIAL GOODIE
1062         JUMPE   C,LLPLOP        ; JUMP IF NO COMMENT
1063         PUSH    TP,C
1064         PUSH    TP,D
1065         MOVSI   C,TATOM
1066         MOVE    D,IMQUOTE COMMENT
1067         PUSHJ   P,IPUT
1068         JRST    LLPLOP          ;AND CONTINUE
1069
1070 ; HERE TO RAP UP LIST
1071
1072 LDONE:  CAME    B,(P)           ;CHECK VALIDITY OF CHARACTER
1073         PUSHJ   P,MISMAT        ;REPORT MISMATCH
1074         SUB     P, C%11
1075         POP     TP,B            ;GET VALUE OF PARTIAL RESULT
1076         POP     TP,A            ;AND TYPE OF SAME
1077         JUMPE   B,RET           ;VALUE IS NIL, DON'T POP AGAIN
1078         POP     TP,B            ;POP FIRST LIST ELEMENT
1079         POP     TP,A            ;AND TYPE
1080         JRST    RET
1081 \f
1082 ;THIS CODE IS SIMILAR TO LIST GENERATING CODE BUT IS FOR VECTORS
1083 OPNBRA: PUSH    P,["}]          ; SAVE TERMINATOR
1084 UVECIN: PUSH    P,[135]         ; CLOSE SQUARE BRACKET
1085         PUSH    P,[SETZ IEUVECTOR]      ;PUSH NAME OF U VECT HACKER
1086         JRST    LBRAK2          ;AND GO
1087
1088 LBRACK: PUSH    P,[135]         ; SAVE TERMINATE
1089         PUSH    P,[SETZ IEVECTOR]       ;PUSH GEN VECTOR HACKER
1090 LBRAK2: PUSHJ   P,LSTCHR        ;FORCE READING NEW CHAR
1091         PUSH    P,C%0           ; COUNT ELEMENTS
1092         PUSH    TP,$TLIST       ; AND SLOT FOR GOODIES
1093         PUSH    TP,C%0
1094
1095 LBRAK1: PUSHJ   P,IREAD1        ;RECURSIVELY READ  ELEMENTS OF ARRAY
1096         JRST    LBDONE          ;RAP UP ON TERMINATOR
1097
1098 STAKIT: EXCH    A,-1(TP)        ; STORE RESULT AND GET CURRENT LIST
1099         EXCH    B,(TP)
1100         AOS     (P)             ; COUNT ELEMENTS
1101         JUMPE   C,LBRAK3        ; IF NO COMMENT, GO ON
1102         MOVEI   E,(B)           ; GET CDR
1103         PUSHJ   P,ICONS         ; CONS IT ON
1104         MOVEI   E,(B)           ; SAVE RS
1105         MOVSI   C,TFIX          ; AND GET FIXED NUM
1106         MOVE    D,(P)
1107         PUSHJ   P,ICONS
1108 LBRAK3: PUSH    TP,A            ; SAVE CURRENT COMMENT LIST
1109         PUSH    TP,B
1110         JRST    LBRAK1
1111
1112 ; HERE TO RAP UP VECTOR
1113
1114 LBDONE: CAME    B,-2(P)         ; FINISHED RETURN (WAS THE RIGHT STOP USED?)
1115         PUSHJ   P,MISMAB        ; WARN USER
1116         POP     TP,1(TB)        ; REMOVE COMMENT LIST
1117         POP     TP,(TB)
1118         MOVE    A,(P)           ; COUNT TO A
1119         PUSHJ   P,-1@(P)        ; MAKE THE VECTOR
1120         SUB     P,C%33
1121
1122 ; PUT COMMENTS ON VECTOR (OR UVECTOR)
1123
1124         MOVNI   C,1             ; INDICATE TEMPLATE HACK
1125         CAMN    A,$TVEC
1126         MOVEI   C,1
1127         CAMN    A,$TUVEC        ; SKIP IF UVECTOR
1128         MOVEI   C,0
1129         PUSH    P,C             ; SAVE
1130         PUSH    TP,A            ; SAVE VECTOR/UVECTOR
1131         PUSH    TP,B
1132
1133 VECCOM: SKIPN   C,1(TB)         ; ANY LEFT?
1134         JRST    RETVEC          ; NO, LEAVE
1135         MOVE    A,1(C)          ; ASSUME WINNING TYPES
1136         SUBI    A,1
1137         HRRZ    C,(C)           ; CDR THE LIST
1138         HRRZ    E,(C)           ; AGAIN
1139         MOVEM   E,1(TB)         ; SAVE CDR
1140         GETYP   E,(C)           ; CHECK DEFFERED
1141         MOVSI   D,(E)
1142         CAIN    E,TDEFER        ; SKIP IF NOT DEFERRED
1143         MOVE    C,1(C)
1144         CAIN    E,TDEFER
1145         GETYPF  D,(C)           ; GET REAL TYPE
1146         MOVE    B,(TP)          ; GET VECTOR POINTER
1147         SKIPGE  (P)             ; SKIP IF NOT TEMPLATE
1148         JRST    TMPCOM
1149         HRLI    A,(A)           ; COUNTER
1150         LSH     A,@(P)          ; MAYBE SHIFT IT
1151         ADD     B,A
1152         MOVE    A,-1(TP)        ; TYPE
1153 TMPCO1: PUSH    TP,D
1154         PUSH    TP,1(C)         ; PUSH THE COMMENT
1155         MOVSI   C,TATOM
1156         MOVE    D,IMQUOTE COMMENT
1157         PUSHJ   P,IPUT
1158         JRST    VECCOM
1159
1160 TMPCOM: MOVSI   A,(A)
1161         ADD     B,A
1162         MOVSI   A,TTMPLT
1163         JRST    TMPCO1
1164
1165 RETVEC: SUB     P,C%11
1166         POP     TP,B
1167         POP     TP,A
1168         JRST    RET
1169
1170 ; BUILD A SINGLE CHARACTER ITEM
1171
1172 SINCHR: PUSHJ   P,NXTC1         ;FORCE READ NEXT
1173         CAIN    B,ESCTYP                ;ESCAPE?
1174         PUSHJ   P,NXTC1         ;RETRY
1175         MOVEI   B,(A)
1176         MOVSI   A,TCHRS
1177         JRST    RETCL
1178
1179 \f
1180 ; HERE ON RIGHT PAREN, BRACKET, ANGLE BRACKET OR CTL C
1181
1182 CLSBRA:
1183 CLSANG:                         ;CLOSE ANGLE BRACKETS
1184 RBRACK:                         ;COMMON RETURN FOR END OF ARRAY ALSO
1185 RPAREN: PUSHJ   P,LSTCHR        ;DON'T REREAD
1186 EOFCH1: MOVE    B,A             ;GETCHAR IN B
1187         MOVSI   A,TCHRS         ;AND TYPE IN A
1188 RET1:   SUB     P,C%11
1189         POPJ    P,
1190
1191 EOFCHR: SETZB   C,D
1192         JUMPL   A,EOFCH1        ; JUMP ON REAL EOF
1193         JRST    RRSUBR          ; MAYBE A BINARY RSUBR
1194
1195 DOEOF:  MOVE    A,[-1,,3]
1196         SETZB   C,D
1197         JRST    EOFCH1
1198
1199
1200 ; NORMAL RETURN FROM IREAD/IREAD1
1201
1202 RETCL:  PUSHJ   P,LSTCHR        ;DONT REREAD
1203 RET:    AOS     -1(P)           ;SKIP
1204         POP     P,E             ; POP FLAG
1205 RETC:   JUMPL   E,RET2          ; DONT LOOK FOR COMMENTS
1206         PUSH    TP,A            ; SAVE ITEM
1207         PUSH    TP,B
1208 CHCOMN: PUSHJ   P,NXTCH         ; READ A CHARACTER
1209         CAIE    B,COMTYP        ; SKIP IF COMMENT
1210         JRST    CHSPA
1211         PUSHJ   P,IREAD         ; READ THE COMMENT
1212         JRST    POPAJ
1213         MOVE    C,A
1214         MOVE    D,B
1215         JRST    .+2
1216 POPAJ:  SETZB   C,D
1217         POP     TP,B
1218         POP     TP,A
1219 RET2:   POPJ    P,
1220
1221 CHSPA:  CAIN    B,SPATYP
1222         PUSHJ   P,SPACEQ        ; IS IT A REAL SPACE
1223         JRST    POPAJ
1224         PUSHJ   P,LSTCHR        ; FLUSH THE SPACE
1225         JRST    CHCOMN
1226
1227 ;RANDOM MINI-SUBROUTINES USED BY THE READER
1228
1229 ;READ A CHAR INTO A AND TYPE CODE INTO D
1230
1231 NXTC3:  SKIPL   B,5(TB) ;GET CHANNEL
1232         JRST    NXTPR4          ;NO CHANNEL, GO READ STRING
1233         SKIPE   LSTCH(B)
1234         PUSHJ   P,CNTACC        ; COUNT ON ACCESS POINTER
1235         PUSHJ   P,RXCT
1236         TRO     A,200
1237         JRST    GETCTP
1238
1239 NXTC1:  SKIPL   B,5(TB) ;GET CHANNEL
1240         JRST    NXTPR1          ;NO CHANNEL, GO READ STRING
1241         SKIPE   LSTCH(B)
1242         PUSHJ   P,CNTACC        ; COUNT ON ACCESS POINTER
1243         JRST    NXTC2
1244 NXTC:   SKIPL   B,5(TB) ;GET CHANNEL
1245         JRST    NXTPRS          ;NO CHANNEL, GO READ STRING
1246         SKIPE   A,LSTCH(B)      ;CHAR IN A IF REUSE
1247         JRST    PRSRET
1248 NXTC2:  PUSHJ   P,RXCT          ;GET CHAR FROM INPUT
1249         TLO     A,200000        ; BIT TO AVOID ^@ LOSSAGE
1250         HLLZS   2(TB)           ;FLAG INDICATING ONE CHAR LOOK AHEAD
1251         MOVEM   A,LSTCH(B)      ;SAVE THE CHARACTER
1252 PRSRET: TLZ     A,200000
1253         TRZE    A,400000        ;DONT SKIP IF SPECIAL
1254         TRO     A,200           ;GO HACK SPECIALLY
1255 GETCTP: PUSH    P,A     ;AND SAVE FROM DIVISION
1256         ANDI    A,377
1257         IDIVI   A,CHRWD ;YIELDS WORD AND CHAR NUMBER
1258         LDB     B,BYTPNT(B)     ;GOBBLE TYPE CODE
1259         POP     P,A
1260         ANDI    A,177   ; RETURN REAL ASCII
1261         POPJ    P,
1262
1263 NXTPR4: MOVEI   F,400000
1264         JRST    NXTPR5
1265
1266 NXTPRS: SKIPE   A,5(TB)         ;GET OLD CHARACTER IF ONE EXISTS
1267         JRST    PRSRET
1268 NXTPR1: MOVEI   F,0
1269 NXTPR5: MOVE    A,11.(TB)
1270         HRRZ    B,(A)           ;GET THE STRING
1271         SOJL    B,NXTPR3
1272         HRRM    B,(A)
1273         ILDB    A,1(A)          ;GET THE CHARACTER FROM THE STRING
1274         IORI    A,(F)
1275 NXTPR2: MOVEM   A,5(TB)         ;SAVE IT
1276         JRST    PRSRET          ;CONTINUE
1277
1278 NXTPR3: SETZM   8.(TB)
1279         SETZM   9.(TB)          ;CLEAR OUT LOCATIVE, AT END OF STRING
1280         MOVEI   A,400033
1281         JRST    NXTPR2
1282
1283 ; NXTCH AND NXTCH1 ARE SAME AS NXTC AND NXTC1 EXCEPT THEY CHECK !
1284 ; HACKS
1285
1286 NXTCH1: PUSHJ   P,NXTC1         ;READ CHAR
1287         JRST    .+2
1288 NXTCH:  PUSHJ   P,NXTC          ;READ CHAR
1289         PUSHJ   P,CHKUS1        ; CHECK FOR USER DISPATCH
1290
1291         CAIE    B,NTYPES+1      ; SKIP IF ! ING NEXT CHAR
1292          POPJ   P,
1293         PUSHJ   P,NXTC3         ;READ NEXT ONE
1294         HLLOS   2(TB)           ;FLAG FOR TWO CHAR LOOK AHEAD
1295
1296 CRMLST: IORI    A,400000        ;CLOBBER LASTCHR
1297         PUSH    P,B
1298         SKIPL   B,5(TB)         ;POINT TO CHANNEL
1299         MOVEI   B,5(TB)-LSTCH   ;NO CHANNEL, POINT AT SLOT
1300         HRRM    A,LSTCH(B)
1301         ANDI    A,377777        ;DECREASE CHAR
1302         POP     P,B
1303
1304 CHKUS2: SKIPN   7(TB)           ; SKIP IF USER TABLE
1305         POPJ    P,
1306         MOVEI   F,200(A)
1307         ASH     F,1             ; POINT TO SLOT
1308         HRLI    F,(F)
1309         ADD     F,7(TB)
1310         JUMPGE  F,CPOPJ         ;IS THERE VECTOR ENOUGH?
1311         SKIPN   1(F)            ; NON-ZERO==>USER FCN EXISTS
1312         JRST    CPOPJ           ; HOPE HE APPRECIATES THIS
1313         MOVEI   B,USTYP2
1314 CHKRDO: PUSH    P,0             ; CHECK FOR REDOING IF CHAR IN TABLE
1315         GETYP   0,(F)
1316         CAIE    0,TCHRS
1317         JRST    CHKUS5
1318         POP     P,0             ;WE ARE TRANSMOGRIFYING
1319         MOVE    A,1(F)          ;GET NEW CHARACTER
1320         PUSH    P,7(TB)
1321         PUSH    P,2(TB)         ; FLAGS FOR NUM OF CHRS IN LOOK AHEAD
1322         PUSH    P,5(TB)         ; TO AVOID SMASHING LSTCHR
1323         SETZM   5(TB)           ; CLEAR OUT CHANNEL
1324         SETZM   7(TB)           ;CLEAR OUT TABLE
1325         TRZE    A,200           ; ! HACK
1326         TRO     A,400000        ; TURN ON PROPER BIT
1327         PUSHJ   P,PRSRET
1328         POP     P,5(TB)         ; GET BACK CHANNEL
1329         POP     P,2(TB)
1330         POP     P,7(TB)         ;GET BACK OLD PARSE TABLE
1331         POPJ    P,
1332
1333 CHKUS5: PUSH    P,A
1334         CAIE    0,TLIST
1335         JRST    .+4             ; SPECIAL NON-BREAK TYPE HACK
1336         MOVNS   (P)             ; INDICATE BY NEGATIVE
1337         MOVE    A,1(F)          ; GET <1 LIST>
1338         GETYP   0,(A)           ; AND GET THE TYPE OF THAT
1339         CAIE    0,TFIX          ; SEE IF HE WANTS SAME CHAR WITH DIFF TYPE
1340         JRST    CHKUS6          ; JUST A VANILLA HACK
1341         MOVE    A,1(F)          ; PRETEND IT IS SAME TYPE AS NEW CHAR
1342         PUSH    P,7(TB)         ; CLEAR OUT TRANSLATE TABLE
1343         PUSH    P,2(TB)         ; FLAGS FOR # OF CHRS IN LOOK AHEAD
1344         SETZM   7(TB)
1345         TRZE    A,200
1346         TRO     A,400000        ; TURN ON PROPER BIT IF ! HACK
1347         PUSHJ   P,PRSRET                ; REGET TYPE
1348         POP     P,2(TB)
1349         POP     P,7(TB) ; PUT TRANSLATE TABLE BACK
1350 CHKUS6: SKIPGE  -1(P)           ; SEE IF A SPECIAL NON-BREAK
1351         MOVNS   B               ; SEXY, HUH?
1352         POP     P,A
1353         POP     P,0
1354         MOVMS   A               ; FIX UP A POSITIVE CHARACTER
1355         POPJ    P,
1356
1357 CHKUS4: POP     P,A
1358         POPJ    P,
1359
1360 CHKUS1: SKIPN   7(TB)           ; USER CHECK FOR NOT ! CASE
1361         POPJ    P,
1362         MOVEI   F,(A)
1363         ASH     F,1
1364         HRLI    F,(F)
1365         ADD     F,7(TB)
1366         JUMPGE  F,CPOPJ
1367         SKIPN   1(F)
1368         POPJ    P,
1369         MOVEI   B,USTYP1
1370         JRST    CHKRDO          ; TRANSMOGRIFY CHARACTER?
1371
1372 CHKUS3: POP     P,A
1373         POPJ    P,
1374
1375 UPLO:   POPJ    P,              ; LETS NOT AND SAY WE USED TO
1376                                 ; AVOID STRANGE ! BLECHAGE
1377 NXTCS:  PUSHJ   P,NXTC
1378         PUSH    P,A             ; HACK TO NOT TRANSLATE CHAR
1379         PUSHJ   P,CHKUS1        ; BUT DO TRANSLATION OF TYPE IF HE WANTS
1380         POP     P,A             ; USED TO BUILD UP STRINGS
1381         POPJ    P,
1382
1383 CHKALT: CAIN    A,33            ;ALT?
1384         MOVEI   B,MANYT
1385         JRST    CRMLST
1386
1387
1388 TERM:   MOVEI   B,0             ;RETURN A 0
1389         JRST    RET1
1390                 ;AND RETURN
1391
1392 CHKMIN: CAIN    A,"-            ; IF CHAR IS -, WINNER
1393         MOVEI   B,PATHTY
1394         JRST    CRMLST
1395
1396 LOSPAT: PUSHJ   P,LSTCHR                ; FIX RECURSIVE LOSAGE
1397         ERRUUO  EQUOTE UNATTACHED-PATH-NAME-SEPARATOR
1398
1399 \f
1400 ; HERE TO SEE IF READING RSUBR
1401
1402 RRSUBR: PUSHJ   P,LSTCHR        ; FLUSH JUST READ CHAR
1403         SKIPL   B,5(TB)         ; SKIP IF A CHANNEL EXISTS
1404         JRST    SPACE           ; ELSE LIKE A SPACE
1405         HRRZ    C,BUFSTR(B)     ; SEE IF FLAG SAYS START OF RSUBR
1406         MOVE    C,(C)
1407         TRNN    C,1             ; SKIP IF REAL RSUBR
1408         JRST    EOFCH2          ; NO, IGNORE FOR NOW
1409
1410 ; REALLY ARE READING AN RSUBR
1411
1412         HRRZ    0,4(TB)         ; GET READ/READB INDICATOR
1413         MOVE    C,ACCESS(B)     ; GET CURRENT ACCESS
1414         JUMPN   0,.+3           ; ALREADY WORDS, NO NEED TO DIVIDE
1415         ADDI    C,4             ; ROUND UP
1416         IDIVI   C,5
1417         PUSH    P,C             ; SAVE WORD ACCESS
1418         MOVEI   A,(C)           ; COPY IT FOR CALL
1419         JUMPN   0,.+3
1420         IMULI   C,5
1421         MOVEM   C,ACCESS(B)     ; FIXUP ACCESS
1422         HLLZS   ACCESS-1(B)     ; FOR READB LOSER
1423         PUSHJ   P,DOACCS        ; AND GO THERE
1424         PUSH    P,C%0           ; FOR READ IN
1425         HRROI   A,(P)           ; PREPARE TO READ LENGTH
1426         PUSHJ   P,DOIOTI        ; READ IT
1427         POP     P,C             ; GET READ GOODIE
1428         JUMPGE  A,.+4           ; JUMP IF WON
1429         SUB     P,C%11
1430 EOFCH2: HRROI   A,3
1431         JRST    EOFCH1
1432         MOVEI   A,(C)           ; COPY FOR GETTING BLOCK
1433         ADDI    C,1             ; COUNT COUNT WORD
1434         ADDM    C,(P)
1435         PUSH    TP,$TUVEC       ; WILL HOLD UVECTOR OF FIXUPS IF THEY STAY
1436         PUSH    TP,C%0
1437         PUSHJ   P,IBLOCK        ; GET A BLOCK
1438         PUSH    TP,$TUVEC
1439         PUSH    TP,B            ; AND SAVE
1440         MOVE    A,B             ; READY TO IOT IT IN
1441         MOVE    B,5(TB)         ; GET CHANNEL BACK
1442         MOVSI   0,TUVEC         ; SETUP A'S TYPE
1443         MOVE    PVP,PVSTOR+1
1444         MOVEM   0,ASTO(PVP)
1445         PUSHJ   P,DOIOTI                ; IN COMES THE WHOLE BLOCK
1446         MOVE    PVP,PVSTOR+1
1447         SETZM   ASTO(PVP)       ; A NO LONGER SPECIAL
1448         MOVEI   C,BUFSTR-1(B)   ; NO RESET BUFFER
1449         PUSHJ   P,BYTDOP        ; A POINTS TO DOPW WORD
1450         SUBI    A,2
1451         HRLI    A,010700        ; SETUP BYTE POINTER TO END
1452         HLLZS   BUFSTR-1(B)     ; ZERO CHAR COUNNT
1453         MOVEM   A,BUFSTR(B)
1454         HRRZ    A,4(TB)         ; READ/READB FLG
1455         MOVE    C,(P)           ; ACCESS IN WORDS
1456         SKIPN   A               ; SKIP FOR ASCII
1457         IMULI   C,5             ; BUMP
1458         MOVEM   C,ACCESS(B)     ; UPDATE ACCESS
1459         PUSHJ   P,NIREAD        ; READ RSUBR VECTOR
1460         JRST    BRSUBR          ; LOSER
1461         GETYP   A,A             ; VERIFY A LITTLE
1462         CAIE    A,TVEC          ; DONT SKIP IF BAD
1463         JRST    BRSUBR          ; NOT A GOOD FILE
1464         PUSHJ   P,LSTCHR        ; FLUSH REREAD CHAR
1465         MOVE    C,(TP)          ; CODE VECTOR BACK
1466         MOVSI   A,TCODE
1467         HLR     A,B             ; FUNNY COUNT
1468         MOVEM   A,(B)           ; CLOBBER
1469         MOVEM   C,1(B)
1470         PUSH    TP,$TRSUBR      ; MAKE RSUBR
1471         PUSH    TP,B
1472
1473 ; NOW LOOK OVER FIXUPS
1474
1475         MOVE    B,5(TB)         ; GET CHANNEL
1476         MOVE    C,ACCESS(B)
1477         HLLZS   ACCESS-1(B)     ; FOR READB LOSER
1478         HRRZ    0,4(TB)         ; READ/READB FLG
1479         JUMPN   0,RSUB1
1480         ADDI    C,4             ; ROUND UP
1481         IDIVI   C,5             ; TO WORDS
1482         MOVEI   D,(C)           ; FIXUP ACCESS
1483         IMULI   D,5
1484         MOVEM   D,ACCESS(B)     ; AND STORE
1485 RSUB1:  ADDI    C,1             ; ACCOUNT FOR EXTRA COUNTERS
1486         MOVEM   C,(P)           ; SAVE FOR LATER
1487         MOVEI   A,-1(C)         ; FOR DOACS
1488         MOVEI   C,2             ; UPDATE REAL ACCESS
1489         SKIPN   0               ; SKIP FOR READB CASE
1490         MOVEI   C,10.
1491         ADDM    C,ACCESS(B)
1492         PUSHJ   P,DOACCS        ; DO THE ACCESS
1493         PUSH    TP,$TUVEC       ; SLOT FOR FIXUP BUFFER
1494         PUSH    TP,C%0
1495
1496 ; FOUND OUT IF FIXUPS STAY
1497
1498         MOVE    B,IMQUOTE KEEP-FIXUPS
1499         PUSHJ   P,ILVAL         ; GET VALUE
1500         GETYP   0,A
1501         MOVE    B,5(TB)         ; CHANNEL BACK TO B
1502         CAIE    0,TUNBOU
1503         CAIN    0,TFALSE
1504         JRST    RSUB4           ; NO, NOT KEEPING FIXUPS
1505         PUSH    P,C%0           ; SLOT TO READ INTO
1506         HRROI   A,(P)           ; GET LENGTH OF SAME
1507         PUSHJ   P,DOIOTI
1508         POP     P,C
1509         MOVEI   A,(C)           ; GET UVECTOR FOR KEEPING
1510         ADDM    C,(P)           ; ACCESS TO END
1511         PUSH    P,C             ; SAVE LENGTH OF FIXUPS
1512         PUSHJ   P,IBLOCK
1513         MOVEM   B,-6(TP)        ; AND SAVE
1514         MOVE    A,B             ; FOR IOTING THEM IN
1515         ADD     B,C%11          ; POINT PAST VERS #
1516         MOVEM   B,(TP)
1517         MOVSI   C,TUVEC
1518         MOVE    PVP,PVSTOR+1
1519         MOVEM   C,ASTO(PVP)
1520         MOVE    B,5(TB)         ; AND CHANNEL
1521         PUSHJ   P,DOIOTI                ; GET THEM
1522         MOVE    PVP,PVSTOR+1
1523         SETZM   ASTO(PVP)
1524         MOVE    A,(TP)          ; GET VERS
1525         PUSH    P,-1(A)         ; AND PUSH IT
1526         JRST    RSUB5
1527
1528 RSUB4:  PUSH    P,C%0
1529         PUSH    P,C%0           ; 2 SLOTS FOR READING
1530         MOVEI   A,-1(P)
1531         HRLI    A,-2
1532         PUSHJ   P,DOIOTI
1533         MOVE    C,-1(P)
1534         MOVE    D,(P)
1535         ADDM    C,-2(P)         ; NOW -2(P) IS ACCESS TO END OF FIXUPS
1536 RSUB5:  MOVEI   C,BUFSTR-1(B)   ; FIXUP BUFFER
1537         PUSHJ   P,BYTDOP
1538         SUBI    A,2             ; POINT BEFORE D.W.
1539         HRLI    A,10700
1540         MOVEM   A,BUFSTR(B)
1541         HLLZS   BUFSTR-1(B)
1542         SKIPE   -6(TP)
1543         JRST    RSUB2A
1544         SUBI    A,BUFLNT-1      ; ALSO MAKE AN IOT FLAVOR BUFFER
1545         HRLI    A,-BUFLNT
1546         MOVEM   A,(TP)
1547         MOVSI   C,TUVEC
1548         MOVE    PVP,PVSTOR+1
1549         MOVEM   C,ASTO(PVP)
1550         PUSHJ   P,DOIOTI
1551         MOVE    PVP,PVSTOR+1
1552         SETZM   ASTO(PVP)
1553 RSUB2A: PUSH    P,-1(P)         ; ANOTHER COPY OF LENGTH OF FIXUPS
1554
1555 ; LOOP FIXING UP NEW TYPES
1556
1557 RSUB2:  PUSHJ   P,WRDIN         ; SEE WHAT NEXT THING IS
1558         JRST    RSUB3           ; NO MORE, DONE
1559         JUMPL   E,STSQ          ; MUST BE FIRST SQUOZE
1560         MOVNI   0,(E)           ; TO UPDATE AMNT OF FIXUPS
1561         ADDB    0,(P)
1562         HRLI    E,(E)           ; IS LENGTH OF STRING IN WORDS
1563         ADD     E,(TP)          ; FIXUP BUFFER POINTER
1564         JUMPL   E,.+3
1565         SUB     E,[BUFLNT,,BUFLNT]
1566         JUMPGE  E,.-1           ; STILL NOT RIGHT
1567         EXCH    E,(TP)          ; FIX UP SLOT
1568         HLRE    C,E             ; FIX BYTE POINTER ALSO
1569         IMUL    C,[-5]          ; + CHARS LEFT
1570         MOVE    B,5(TB)         ; CHANNEL
1571         PUSH    TP,BUFSTR-1(B)
1572         PUSH    TP,BUFSTR(B)
1573         HRRM    C,BUFSTR-1(B)
1574         HRLI    E,440700        ; AND BYTE POINTER
1575         MOVEM   E,BUFSTR(B)
1576         PUSHJ   P,NIREAD        ; READ ATOM NAME OF TYPE
1577         TDZA    0,0             ; FLAG LOSSAGE
1578         MOVEI   0,1             ; WINNAGE
1579         MOVE    C,5(TB)         ; RESET BUFFER
1580         POP     TP,BUFSTR(C)
1581         POP     TP,BUFSTR-1(C)
1582         JUMPE   0,BRSUBR        ; BAD READ OF RSUBR
1583         GETYP   A,A             ; A LITTLE CHECKING
1584         CAIE    A,TATOM
1585         JRST    BRSUBR
1586         PUSHJ   P,LSTCHR        ; FLUSH REREAD CHAR
1587         HRRZ    0,4(TB)         ; FIXUP ACCESS PNTR
1588         MOVE    C,5(TB)
1589         MOVE    D,ACCESS(C)
1590         HLLZS   ACCESS-1(C)     ; FOR READB HACKER
1591         ADDI    D,4
1592         IDIVI   D,5
1593         IMULI   D,5
1594         SKIPN   0
1595         MOVEM   D,ACCESS(C)     ; RESET
1596 TYFIXE: PUSHJ   P,TYPFND        ; SEE IF A LEGAL TYPE NAME
1597         JRST    TYPFIX          ; GO SEE USER ABOUT THIS
1598         PUSHJ   P,FIXCOD        ; GO FIX UP THE CODE
1599         JRST    RSUB2
1600
1601 ; NOW FIX UP SUBRS ETC. IF NECESSARY
1602
1603 STSQ:   MOVE    B,IMQUOTE MUDDLE
1604         PUSHJ   P,IGVAL         ; GET CURRENT VERS
1605         CAME    B,-1(P)         ; SKIP IF NO FIXUPS NEEDED
1606         JRST    DOFIX0          ; MUST DO THEM
1607
1608 ; ALL DONE, ACCESS PAST FIXUPS AND RETURN
1609 RSUB31: PUSHJ   P,SQUKIL        ; DONE FIXING UP, KILL SQUOZE TABLE IF IN INTERP
1610 RSUB3:  MOVE    A,-3(P)
1611         MOVE    B,5(TB)
1612         MOVEI   C,(A)           ; UPDATE CHANNEL ACCESS IN CASE SKIPPING
1613         HRRZ    0,4(TB)         ; READ/READB FLAG
1614         SKIPN   0
1615         IMULI   C,5
1616         MOVEM   C,ACCESS(B)     ; INTO ACCESS SLOT
1617         HLLZS   ACCESS-1(B)
1618         PUSHJ   P,DOACCS        ; ACCESSED
1619         MOVEI   C,BUFSTR-1(B)   ; FIX UP BUFFER
1620         PUSHJ   P,BYTDOP
1621         SUBI    A,2
1622         HRLI    A,10700
1623         MOVEM   A,BUFSTR(B)
1624         HLLZS   BUFSTR-1(B)
1625         SKIPN   A,-6(TP)                ; SKIP IF KEEPING FIXUPS
1626         JRST    RSUB6
1627         PUSH    TP,$TUVEC
1628         PUSH    TP,A
1629         MOVSI   A,TRSUBR
1630         MOVE    B,-4(TP)
1631         MOVSI   C,TATOM
1632         MOVE    D,IMQUOTE RSUBR
1633         PUSHJ   P,IPUT          ; DO THE ASSOCIATION
1634
1635 RSUB6:  MOVE    C,-4(TP)        ; DO SPECIAL FIXUPS
1636         PUSHJ   P,SFIX
1637         MOVE    B,-2(TP)        ; GET RSUBR
1638         MOVSI   A,TRSUBR
1639         SUB     P,C%44          ; FLUSH P CRUFT
1640         SUB     TP,[10,,10]
1641         JRST    RET
1642
1643 ; FIXUP SUBRS ETC.
1644
1645 DOFIX0: SKIPN   C,-6(TP)                ; GET BUFFER IF KEEPING
1646         JRST    DOFIXE
1647         MOVEM   B,(C)           ; CLOBBER
1648         JRST    DOFIXE
1649
1650 FIXUPL: PUSHJ   P,WRDIN
1651         JRST    RSUB31
1652 DOFIXE: JUMPGE  E,BRSUBR
1653         TLZ     E,740000        ; KILL BITS
1654 IFN KILTV,[
1655         CAME    E,[SQUOZE 0,DSTO]
1656         JRST    NOOPV
1657         MOVE    E,[SQUOZE 40,DSTORE]
1658         MOVE    A,(TP)
1659         SKIPE   -6(TP)
1660         MOVEM   E,-1(A)
1661         MOVEI   E,53
1662         HRLM    E,(A)
1663         MOVEI   E,DSTORE
1664         JRST    .+3
1665 NOOPV:
1666 ]
1667         PUSHJ   P,SQUTOA        ; LOOK IT UP
1668         PUSHJ   P,BRSUB1
1669         MOVEI   D,(E)           ; FOR FIXCOD
1670         PUSHJ   P,FIXCOD        ; FIX 'EM UP
1671         JRST    FIXUPL
1672
1673 ; BAD SQUOZE, BE MORE SPECIFIC
1674
1675 BRSUB1: PUSHJ   P,SQSTR
1676         PUSH    TP,$TATOM
1677         PUSH    TP,EQUOTE SQUZE-SYMBOL-NOT-FOUND-ERRET CORRECTION
1678         PUSH    TP,A
1679         PUSH    TP,B
1680         PUSH    TP,$TATOM
1681         PUSH    TP,MQUOTE READ
1682         MCALL   3,ERROR
1683         GETYP   A,A
1684         CAIE    A,TFIX
1685         ERRUUO  EQUOTE VALUE-MUST-BE-FIX
1686         MOVE    E,B
1687         POPJ    P,
1688
1689 ; CONVERT SQUOZE TO A MUDDLE STRING FOR USER
1690
1691 SQSTR:  PUSHJ   P,SPTT
1692         PUSH    P,C
1693         CAIN    B,6             ; 6 chars?
1694         PUSH    P,D
1695         PUSH    P,B
1696         PUSHJ   P,CHMAK
1697         POPJ    P,
1698
1699 SPTT:   SETZB   B,C
1700         MOVE    A,[440700,,C]
1701         MOVEI   D,0
1702
1703 SPT1:   IDIVI   E,50
1704         PUSH    P,F
1705         JUMPE   E,SPT3
1706         PUSHJ   P,SPT1
1707 SPT3:   POP     P,E
1708         ADDI    E,"0-1
1709         CAILE   E,"9
1710         ADDI    E,"A-"9-1
1711         CAILE   E,"Z
1712         SUBI    E,"Z-"#+1
1713         CAIN    E,"#
1714         MOVEI   E,".
1715         CAIN    E,"/
1716 SPC:    MOVEI   E,40
1717         IDPB    E,A
1718         ADDI    B,1
1719         POPJ    P,
1720
1721
1722 ;0    1-12 13-44 45 46 47
1723 ;NULL 0-9   A-Z  .  $  %
1724
1725 ; ROUTINE TO FIXUP ACTUAL CODE
1726
1727 FIXCOD: MOVEI   E,0             ; FOR HWRDIN
1728         PUSH    P,D             ; NEW VALUE
1729         PUSHJ   P,HWRDIN        ; GET HW NEEDED
1730         MOVE    D,(P)           ; GET NEW VAL
1731         MOVE    A,(TP)          ; AND BUFFER POINTER
1732         SKIPE   -6(TP)          ; SAVING?
1733         HRLM    D,-1(A)         ; YES, CLOBBER
1734         SUB     C,(P)           ; DIFFERENCE
1735         MOVN    D,C
1736
1737 FIXLP:  PUSHJ   P,HWRDIN        ; GET AN OFFSET
1738         JUMPE   C,FIXED
1739         HRRES   C               ; MAKE NEG IF NEC
1740         JUMPL   C,LHFXUP
1741         ADD     C,-4(TP)        ; POINT INTO CODE
1742 IFN KILTV,[
1743         LDB     0,[220400,,-1(C)]       ; GET INDEX FIELD
1744         CAIE    0,7
1745         JRST    NOTV
1746 KIND:   MOVEI   0,0
1747         DPB     0,[220400,,-1(C)]
1748         JRST    DONTV
1749 NOTV:   CAIE    0,6                     ; IS IT PVP
1750         JRST    DONTV
1751         HRRZ    0,-1(C)
1752         CAIE    0,12                    ; OLD DSTO
1753         JRST    DONTV
1754         MOVEI   0,33.
1755         ADDM    0,-1(C)
1756         JRST    KIND
1757 DONTV:
1758 ]
1759         ADDM    D,-1(C)
1760         JRST    FIXLP
1761
1762 LHFXUP: MOVMS   C
1763         ADD     C,-4(TP)
1764         MOVSI   0,(D)
1765         ADDM    0,-1(C)
1766         JRST    FIXLP
1767
1768 FIXED:  SUB     P,C%11
1769         POPJ    P,
1770
1771 ; ROUTINE TO READ A WORD FROM BUFFER
1772
1773 WRDIN:  PUSH    P,A
1774         PUSH    P,B
1775         SOSG    -3(P)           ; COUNT IT DOWN
1776         JRST    WRDIN1
1777         AOS     -2(P)           ; SKIP RETURN
1778         MOVE    B,5(TB)         ; CHANNEL
1779         HRRZ    A,4(TB)         ; READ/READB SW
1780         MOVEI   E,5
1781         SKIPE   A
1782         MOVEI   E,1
1783         ADDM    E,ACCESS(B)
1784         MOVE    A,(TP)          ; BUFFER
1785         MOVE    E,(A)
1786         AOBJP   A,WRDIN2        ; NEED NEW BUFFER
1787         MOVEM   A,(TP)
1788 WRDIN1: POP     P,B
1789         POP     P,A
1790         POPJ    P,
1791
1792 WRDIN2: MOVE    B,-3(P)         ; IS THIS LAST WORD?
1793         SOJLE   B,WRDIN1        ; YES, DONT RE-IOT
1794         SUB     A,[BUFLNT,,BUFLNT]
1795         MOVEM   A,(TP)
1796         MOVSI   B,TUVEC
1797         MOVE    PVP,PVSTOR+1
1798         MOVEM   B,ASTO(PVP)
1799         MOVE    B,5(TB)
1800         PUSHJ   P,DOIOTI
1801         MOVE    PVP,PVSTOR+1
1802         SETZM   ASTO(PVP)
1803         JRST    WRDIN1
1804
1805 ; READ IN NEXT HALF WORD
1806
1807 HWRDIN: JUMPN   E,NOIOT         ; USE EXISTING WORD
1808         PUSH    P,-3(P)         ; FAKE OUT WRDIN IF NEC.
1809         PUSHJ   P,WRDIN
1810         JRST    BRSUBR
1811         POP     P,-4(P)         ; RESET COUNTER
1812         HLRZ    C,E             ; RET LH
1813         POPJ    P,
1814
1815 NOIOT:  HRRZ    C,E
1816         MOVEI   E,0
1817         POPJ    P,
1818
1819 TYPFIX: PUSH    TP,$TATOM
1820         PUSH    TP,EQUOTE BAD-TYPE-NAME
1821         PUSH    TP,$TATOM
1822         PUSH    TP,B
1823         PUSH    TP,$TATOM
1824         PUSH    TP,EQUOTE ERRET-TYPE-NAME-DESIRED
1825         MCALL   3,ERROR
1826         JRST    TYFIXE
1827
1828 BRSUBR: ERRUUO  EQUOTE RSUBR-IN-BAD-FORMAT
1829 \f
1830
1831
1832 ;TABLE OF BYTE POINTERS FOR GETTING CHARS
1833
1834 BYTPNT":        350700,,CHTBL(A)
1835         260700,,CHTBL(A)
1836         170700,,CHTBL(A)
1837         100700,,CHTBL(A)
1838         010700,,CHTBL(A)
1839
1840 ;HERE ARE THE TABLES OF CHXRACTERS (NOTE EVERYTHING NOT SPECIFIED IS
1841 ;IN THE NUMBER LETTER CATAGORY)
1842
1843 CHROFF==0                       ; USED FOR ! HACKS
1844 SETCHR NUMCOD,[0123456789]
1845
1846 SETCHR PLUCOD,[+]
1847
1848 SETCHR NEGCOD,[-]
1849
1850 SETCHR ASTCOD,[*]
1851
1852 SETCHR DOTTYP,[.]
1853
1854 SETCHR ETYPE,[Ee]
1855
1856 SETCOD SPATYP,[0,15,12,11,14,40,33]     ;ALL ARE TYPE 2 (SPACING - FF,TAB,SPACE,ALT-MODE)
1857
1858 INCRCH LPATYP,[()[]'%"\#<>]     ;GIVE THESE INCREASRNG CODES FROM 3
1859
1860 SETCOD EOFTYP,[3]       ;^C - EOF CHARACTER
1861
1862 SETCOD SPATYP,[32]      ;^Z - TENEX/TOPS-20 EOF (SET IN BOTH TO BE CONSISTENT)
1863
1864 INCRCH COMTYP,[;,{}!]           ;COMMENT AND GLOBAL VALUE AND SPECIAL
1865
1866 CHROFF==200             ; CODED AS HAVING 200 ADDED
1867
1868 INCRCH EXCEXC,[!.[]'"<>,-\]
1869
1870 SETCOD MANYT,[33]
1871
1872 CHTBL:
1873         OUTTBL                  ;OUTPUT THE TABLE RIGHT HERE
1874
1875
1876 \f; THIS CODE FLUSHES WANDERING COMMENTS
1877
1878 COMNT:  PUSHJ   P,IREAD
1879         JRST    COMNT2
1880         JRST    BDLP
1881
1882 COMNT2: SKIPL   A,5(TB)         ; RESTORE CHANNEL
1883         MOVEI   A,5(TB)-LSTCH   ;NO CHANNEL, POINT AT SLOT
1884         HRRM    B,LSTCH(A)      ; CLOBBER IN CHAR
1885         PUSHJ   P,ERRPAR
1886         JRST    BDLP
1887 \f
1888
1889 ;HERE TO SET UP FOR .FOO ..FOO OR.<ABC>
1890
1891 DOTSTR: PUSHJ   P,NXTCH1        ; GOBBLE A NEW CHARACTER
1892         MOVEI   FF,FRSDOT+DOTSEN+NUMWIN ; SET FLAG IN CASE
1893         CAIN    B,NUMCOD        ; SKIP IF NOT NUMERIC
1894         JRST    DOTST1          ; NUMERIC, COULD BE FLONUM
1895
1896 ; CODE TO HANDLE ALL IMPLICIT CALLS  I.E. QUOTE, LVAL, GVAL
1897
1898         TRZ     FF,NUMWIN       ; WE ARE NOT A NUMBER
1899         MOVSI   B,TFORM         ; LVAL
1900         MOVE    A,IMQUOTE LVAL
1901         JRST    IMPCA1
1902
1903 GLOSEG: SKIPA   B,$TSEG         ;SEG CALL TO GVAL
1904 GLOVAL: MOVSI   B,TFORM ;FORM CALL TO SAME
1905         MOVE    A,IMQUOTE GVAL
1906         JRST    IMPCAL
1907
1908 QUOSEG: SKIPA   B,$TSEG         ;SEG CALL TO QUOTE
1909 QUOTIT: MOVSI   B,TFORM
1910         MOVE    A,IMQUOTE QUOTE
1911         JRST    IMPCAL
1912
1913 SEGDOT: MOVSI   B,TSEG          ;SEG CALL TO LVAL
1914         MOVE    A,IMQUOTE LVAL
1915 IMPCAL: PUSHJ   P,LSTCHR        ;FLUSH LAST CHAR EXCEPT
1916 IMPCA1: PUSH    TP,$TATOM       ;FOR .FOO FLAVOR
1917         PUSH    TP,A            ;PUSH ARGS
1918         PUSH    P,B             ;SAVE TYPE
1919         PUSHJ   P,IREAD1                ;READ
1920         JRST    USENIL          ; IF NO ARG, USE NIL
1921 IMPCA2: PUSH    TP,C
1922         PUSH    TP,D
1923         MOVE    C,A             ; GET READ THING
1924         MOVE    D,B
1925         PUSHJ   P,INCONS        ; CONS TO NIL
1926         MOVEI   E,(B)           ; PREPARE TON CONS ON
1927 POPARE: POP     TP,D            ; GET ATOM BACK
1928         POP     TP,C
1929         EXCH    C,-1(TP)        ; SAVE THAT COMMENT
1930         EXCH    D,(TP)
1931         PUSHJ   P,ICONS
1932         POP     P,A             ;GET FINAL TYPE
1933         JRST    RET13           ;AND RETURN
1934
1935
1936 USENIL: PUSH    TP,C
1937         PUSH    TP,D
1938         SKIPL   A,5(TB)         ; RESTOR LAST CHR
1939         MOVEI   A,5(TB)-LSTCH   ;NO CHANNEL, POINT AT SLOT
1940         HRRM    B,LSTCH(A)
1941         MOVEI   E,0
1942         JRST    POPARE
1943 \f
1944 ;HERE AFTER READING ATOM TO CALL VALUE
1945
1946 .SET:   PUSH    P,$TFORM        ;GET WINNING TYPE
1947         MOVE    E,(P)
1948         PUSHJ   P,RETC          ; CHECK FOR POSSIBLE COMMENT
1949         PUSH    TP,$TATOM
1950         PUSH    TP,IMQUOTE LVAL
1951         JRST    IMPCA2          ;GO CONS LIST
1952
1953 LOOPA:  PUSH    P,FF            ; SAVE FLAGS IN CASE .ATOM
1954 LOOPAT: PUSHJ   P,NXTCH         ; CHECK FOR TRAILER
1955         CAIN    B,PATHTY        ; PATH BEGINNER
1956         JRST    PATH0           ; YES, GO PROCESS
1957         CAIN    B,SPATYP        ; SPACER?
1958         PUSHJ   P,SPACEQ        ; CHECK FOR REAL SPACE
1959         JRST    PATH2
1960         PUSHJ   P,LSTCHR        ; FLUSH IT AND RETRY
1961         JRST    LOOPAT
1962 PATH0:  PUSHJ   P,NXTCH1        ; READ FORCED NEXT
1963         CAIE    B,SPCTYP        ; DO #FALSE () HACK
1964         CAIN    B,ESCTYP
1965         JRST    PATH4
1966         CAIL    B,SPATYP        ; SPACER?
1967         JRST    PATH3           ; YES, USE THE ROOT OBLIST
1968 PATH4:  PUSHJ   P,NIREA1        ; READ NEXT ITEM
1969         PUSHJ   P,ERRPAR        ; LOSER
1970         CAME    A,$TATOM        ; ONLY ALLOW ATOMS
1971         JRST    BADPAT
1972
1973         PUSH    TP,A
1974         PUSH    TP,B
1975         MOVSI   C,TATOM
1976         MOVE    D,IMQUOTE OBLIST
1977         PUSHJ   P,IGET          ; GET THE OBLIST
1978                                 ; IF NOT OBLIST, MAKE ONE
1979         JUMPN   B,PATH6
1980         MCALL   1,MOBLIS        ; MAKE ONE
1981         JRST    PATH1
1982
1983 PATH6:  SUB     TP,C%22
1984         JRST    PATH1
1985
1986
1987 PATH3:  MOVE    B,ROOT+1        ; GET ROOT OBLIST
1988         MOVSI   A,TOBLS
1989 PATH1:  POP     P,FF            ; FLAGS
1990         TRNE    FF,FRSDOT
1991         JRST    PATH.
1992         PUSHJ   P,RLOOKU                ; AND LOOK IT UP
1993
1994         JRST    RET
1995
1996 PATH.:  PUSHJ   P,RLOOKU
1997         JRST    .SET                    ; CONS AN LVAL FORM
1998
1999 SPACEQ: ANDI    A,-1
2000         CAIE    A,33
2001         CAIN    A,400033
2002         POPJ    P,
2003         CAIE    A,3
2004         AOS     (P)
2005         POPJ    P,
2006 \f
2007
2008 PATH2:  MOVE    B,IMQUOTE OBLIST
2009         PUSHJ   P,IDVAL
2010         JRST    PATH1
2011
2012 BADPAT: ERRUUO  EQUOTE NON-ATOMIC-OBLIST-NAME
2013
2014 \f
2015
2016 ; HERE TO READ ONE CHARACTER FOR USER.
2017
2018 CREDC1: SUBM    M,(P)
2019         PUSH    TP,A
2020         PUSH    TP,B
2021         PUSHJ   P,IREADC
2022         JRST    CRDEO1
2023         JRST    RMPOPJ
2024
2025 CNXTC1: SUBM    M,(P)
2026         PUSH    TP,A
2027         PUSH    TP,B
2028         PUSHJ   P,INXTRD
2029         JRST    CRDEO1
2030         JRST    RMPOPJ
2031
2032 CRDEO1: MOVE    B,(TP)
2033         PUSH    TP,EOFCND-1(B)
2034         PUSH    TP,EOFCND(B)
2035         PUSH    TP,$TCHAN
2036         PUSH    TP,B
2037         MCALL   1,FCLOSE
2038         MCALL   1,EVAL
2039         JRST    RMPOPJ
2040
2041
2042 CREADC: SUBM    M,(P)
2043         PUSH    TP,A
2044         PUSH    TP,B
2045         PUSHJ   P,IREADC
2046         JRST    CRDEOF
2047         SOS     (P)
2048         JRST    RMPOPJ
2049
2050 CNXTCH: SUBM    M,(P)
2051         PUSH    TP,A
2052         PUSH    TP,B
2053         PUSHJ   P,INXTRD
2054         JRST    CRDEOF
2055         SOS     (P)
2056 RMPOPJ: SUB     TP,C%22
2057         JRST    MPOPJ
2058
2059 CRDEOF: .MCALL  1,FCLOSE
2060         MOVSI   A,TCHRS
2061         HRROI   B,3
2062         JRST    MPOPJ
2063
2064 INXTRD: TDZA    E,E
2065 IREADC: MOVEI   E,1
2066         MOVE    B,(TP)          ; CHANNEL
2067         HRRZ    A,-2(B)         ; GET BLESS BITS
2068         TRNE    A,C.BIN
2069         TRNE    A,C.BUF
2070         JRST    .+3
2071         PUSHJ   P,GRB
2072         HRRZ    A,-2(B)
2073         TRC     A,C.OPN+C.READ
2074         TRNE    A,C.OPN+C.READ
2075         JRST    BADCHN
2076         SKIPN   A,LSTCH(B)
2077         PUSHJ   P,RXCT
2078         TLO     A,200000
2079         MOVEM   A,LSTCH(B)      ; SAVE CHAR
2080         CAMN    A,C%M1          ; [-1]  ; SPECIAL PSEUDO TTY HACK?
2081         JRST    PSEUDO          ; YES, RET AS FIX
2082 ;       ANDI    A,-1
2083         TLZ     A,200000
2084         TRZN    A,400000        ; UNDO ! HACK
2085         JRST    NOEXCL
2086         SKIPE   E
2087         MOVEM   A,LSTCH(B)
2088         MOVEI   A,"!            ; RETURN AN !
2089 NOEXC1: SKIPGE  B,A             ; CHECK EOF
2090         SOS     (P)             ; DO EOF RETURN
2091         MOVE    B,A             ; CHAR TO B
2092         MOVSI   A,TCHRS
2093 PSEUD1: AOS     (P)
2094         POPJ    P,
2095
2096 PSEUDO: MOVE    F,B
2097         SKIPE   E
2098         PUSHJ   P,LSTCH2
2099         MOVE    B,A
2100         MOVSI   A,TFIX
2101         JRST    PSEUD1
2102
2103 NOEXCL: JUMPE   E,NOEXC1
2104         MOVE    F,B
2105         PUSHJ   P,LSTCH2
2106         JRST    NOEXC1
2107
2108 ; READER ERRORS COME HERE
2109
2110 ERRPAR: PUSH    TP,$TCHRS       ;DO THE OFFENDER
2111         PUSH    TP,B
2112         PUSH    TP,$TCHRS
2113         PUSH    TP,[40]         ;SPACE
2114         PUSH    TP,$TCHSTR
2115         PUSH    TP,CHQUOT UNEXPECTED
2116         JRST    MISMA1
2117
2118 ;COMPLAIN ABOUT MISMATCHED CLOSINGS
2119
2120 MISMAB: SKIPA   A,["]]
2121 MISMAT: MOVE    A,-1(P)         ;GOBBLE THE DESIRED CHARACTER
2122         JUMPE   B,CPOPJ         ;IGNORE UNIVERSAL CLOSE
2123         PUSH    TP,$TCHRS
2124         PUSH    TP,B
2125         PUSH    TP,$TCHSTR
2126         PUSH    TP,CHQUOT [ INSTEAD-OF ]
2127         PUSH    TP,$TCHRS
2128         PUSH    TP,A
2129 MISMA1: MCALL   3,STRING
2130         PUSH    TP,$TATOM
2131         PUSH    TP,EQUOTE READER-SYNTAX-ERROR-ERRET-ANYTHING-TO-GO-ON
2132         PUSH    TP,A
2133         PUSH    TP,B
2134         PUSH    TP,$TATOM
2135         PUSH    TP,MQUOTE READ
2136         MCALL   3,ERROR
2137 CPOPJ:  POPJ    P,
2138 \f
2139 ; HERE ON BAD INPUT CHARACTER
2140
2141 BADCHR: ERRUUO  EQUOTE BAD-ASCII-CHARACTER
2142
2143 ; HERE ON YUCKY PARSE TABLE
2144
2145 BADPTB: ERRUUO  EQUOTE BAD-MACRO-TABLE
2146
2147 BDPSTR: ERRUUO  EQUOTE BAD-PARSE-STRING
2148
2149 ILLSQG: PUSHJ   P,LSTCHR        ; DON'T MESS WITH IT AGAIN
2150         ERRUUO  EQUOTE BAD-USE-OF-SQUIGGLY-BRACKETS
2151
2152
2153 ;FLOATING POINT NUMBER TOO LARGE OR SMALL
2154 FOOR:   ERRUUO  EQUOTE NUMBER-OUT-OF-RANGE
2155
2156
2157 NILSXP: 0,,0
2158
2159 LSTCHR: SKIPL   F,5(TB) ;GET CHANNEL
2160         JRST    LSTCH1          ;NO CHANNEL, POINT AT SLOT
2161
2162 LSTCH2: SKIPE   LSTCH(F)        ;ARE WE REALLY FLUSHING A REUSE CHARACTER ?
2163         PUSHJ   P,CNTACX
2164         SETZM   LSTCH(F)
2165         POPJ    P,
2166
2167 LSTCH1: SETZM   5(TB)           ;ZERO THE LETTER AND RETURN
2168         POPJ    P,
2169
2170 CNTACC: MOVE    F,B
2171 CNTACX: HRRZ    G,-2(F)         ; GET BITS
2172         TRNE    G,C.BIN
2173         JRST    CNTBIN
2174         AOS     ACCESS(F)
2175 CNTDON: POPJ    P,
2176
2177 CNTBIN: AOS     G,ACCESS-1(F)
2178         CAMN    G,[TFIX,,1]
2179          AOS    ACCESS(F)
2180         CAMN    G,[TFIX,,5]
2181          HLLZS  ACCESS-1(F)
2182         POPJ    P,
2183
2184
2185 ;TABLE OF NAMES OF ARGS AND ALLOWED TYPES
2186
2187 ARGS:
2188         IRP     A,,[[[CAIN C,TUNBOU]],[[CAIE C,TCHAN],INCHAN],[[PUSHJ P,CHOBL],OBLIST]]
2189                 IRP B,C,[A]
2190                         B
2191                         IFSN [C],IMQUOTE C
2192                         .ISTOP
2193                 TERMIN
2194         TERMIN
2195
2196 CHOBL:  CAIE    C,TLIST ;A LIST OR AN OBLIST
2197         CAIN    C,TOBLS
2198         AOS     (P)
2199         POPJ    P,
2200
2201 END
2202
2203 \f