MUDDLE/reader.117

   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
  11 .INSRT MUDDLE >
  12
  13 .GLOBAL CONS,VECTOR,NXTCHR,RLOOKU,CRADIX,SPTIME,QUOTE,TENTAB,CHMAK,FLUSCH,ITENTB
  14 .GLOBAL SETDEV,OPNCHN,ILVAL,RADX,IDVAL,LSTCH,EVECTOR,EUVECTOR
  15 .GLOBAL CHRWRD
  16
  17 ;MACRO TO FLOAT
  18 FF=0    ;FALG REGISTER DURING NUMBER CONVERSION
  19
  20 ;FLAGS USED (RIGHT HALF)
  21
  22 NOTNUM==1       ;NOT A NUMBER
  23 NFIRST==2       ;NOT FIRST CHARACTER BEING READ
  24 DECFRC==4       ;FORCE DECIMAL CONVERSION
  25 NEGF==10        ;NEGATE THIS THING
  26 NUMWIN==20      ;DIGIT(S) SEEN
  27 INSTRN==40      ;IN QUOTED CHARACTER STRING
  28 FLONUM==100     ;NUMBER IS FLOOATING POINT
  29 DOTSEN==200     ;. SEEN IN IMPUT STREAM
  30 EFLG==400       ;E SEEN FOR EXPONENT
  31 IFN FRMSIN,[
  32         FRSDOT==1000                    ;. CAME FIRST
  33         USEAGN==2000                    ;SPECIAL DOT HACK
  34 ]
  35
  36 ;TEMPORARY OFFSETS
  37
  38 VCNT==0 ;NUMBER OF ELEMENTS IN CURRENT VECTOR
  39 ONUM==1 ;CURRENT NUMBER IN OCTAL
  40 DNUM==3 ;CURRENT NUMBER IN DECIMAL
  41 FNUM==5 ;CURRENTLY UNUSED
  42 CNUM==7 ;IN CURRENT RADIX
  43 NDIGS==11       ;NUMBER OF DIGITS
  44 ENUM==13 ;EXPONENT
  45
  46
  47 \f; TEXT FILE LOADING PROGRAM
  48
  49 MFUNCTION LOAD,SUBR
  50
  51         ENTRY
  52
  53         HLRZ    A,AB            ;GET NO. OF ARGS
  54         CAIE    A,-4            ;IS IT 2
  55         JRST    TRY2            ;NO, TRY ANOTHER
  56         HLRZ    A,2(AB)         ;GET TYPE
  57         CAIE    A,TOBLS         ;IS IT OBLIST
  58         JRST    WRONGT
  59         JRST    CHECK1
  60
  61 TRY2:   CAIE    A,-2            ;IS ONE SUPPLIED
  62         JRST    WNA"
  63
  64 CHECK1: HLRZ    A,(AB)          ;GET TYPE
  65         CAIE    A,TCHAN         ;IS IT A CHANNEL
  66         JRST    WRONGT
  67
  68 LOAD1:  HLRZ    A,TB            ;GET CURRENT TIME
  69         PUSH    TP,$TTIME       ;AND SAVE IT
  70         PUSH    TP,A
  71
  72 LOAD2:  PUSH    TP,(TB)         ;USE TIME AS EOF ARG
  73         PUSH    TP,1(TB)
  74         PUSH    TP,(AB)         ;USE SUPPLIED CHANNEL
  75         PUSH    TP,1(AB)
  76
  77         CAML    AB,[-2,,0]      ;CHECK FOR 2ND ARG
  78         JRST    LOAD3           ;NONE
  79
  80         PUSH    TP,2(AB)        ;PUSH ON 2ND ARG
  81         PUSH    TP,3(AB)
  82         MCALL   3,READ
  83         JRST    CHKRET          ;CHECK FOR EOF RET
  84
  85 LOAD3:  MCALL   2,READ
  86 CHKRET: CAMN    A,(TB)          ;IS TYPE EOF HACK
  87         CAME    B,1(TB)         ;AND IS VALUE
  88         JRST    EVALIT          ;NO, GO EVAL RESULT
  89         PUSH    TP,(AB)
  90         PUSH    TP,1(AB)
  91         MCALL   1,FCLOSE
  92         MOVE    A,$TCHSTR
  93         MOVE    B,CHQUOTE DONE
  94         JRST    FINIS
  95
  96 EVALIT: PUSH    TP,A
  97         PUSH    TP,B
  98         MCALL   1,EVAL
  99         JRST    LOAD2
 100
 101
 102
 103 ; OTHER FILE LOADING PROGRAM
 104
 105
 106 \fMFUNCTION FLOAD,SUBR
 107
 108         ENTRY
 109
 110         MOVEI   C,1             ;INITIALIZE OPEN'S ARG COUNT
 111         PUSH    TP,$TAB ;SLOT FOR SAVED AB
 112         PUSH    TP,[0]  ;EMPTY FOR NOW
 113         PUSH    TP,$TCHSTR      ;PUT IN FIRST ARG
 114         PUSH    TP,CHQUOTE READ
 115         MOVE    A,AB            ;COPY OF ARGUMENT POINTER
 116
 117 FARGS:  JUMPGE  A,CALOPN        ;DONE? IF SO CALL OPEN
 118         HLRZ    B,(A)           ;NO, CH\0ECK TYPE OF THIS ARG
 119         CAIN    B,TOBLS         ;OBLIST?
 120         JRST    OBLSV           ;YES, GO SAVE IT
 121
 122         PUSH    TP,(A)          ;SAVE THESE ARGS
 123         PUSH    TP,1(A)
 124         ADD     A,[2,,2]        ;BUMP A
 125         AOJA    C,FARGS         ;COUNT AND GO
 126
 127 OBLSV:  MOVEM   A,1(TB) ;SAVE THE AB
 128
 129 CALOPN: ACALL   C,FOPEN         ;OPEN THE FILE
 130
 131         JUMPE   B,FNFFL ;FILE MUST NO EXIST
 132         EXCH    A,(TB)  ;PLACE CHANNEL ON STACK
 133         EXCH    B,1(TB)         ;OBTAINING POSSIBLE OBLIST
 134         JUMPN   B,2ARGS         ;OBLIST SUOPPLIED?
 135
 136         MCALL   1,LOAD          ;NO, JUST CALL
 137         JRST    FINIS
 138
 139
 140 2ARGS:  PUSH    TP,(B)          ;PUSH THE OBLIST
 141         PUSH    TP,1(B)
 142         MCALL   2,LOAD
 143         JRST    FINIS
 144
 145
 146 FNFFL:  PUSH    TP,$TATOM
 147         PUSH    TP,MQUOTE FILE-NOT-FOUND
 148         JRST    CALER1
 149
 150 \fMFUNCTION RREADC,SUBR,READCHR
 151
 152         ENTRY
 153         PUSH    P,[IREADC]      ;WHERE TO GO AFTER BINDING
 154         JRST    READ0           ;GO BIND VARIABLES
 155
 156 MFUNCTION NXTRDC,SUBR,NEXTCHR
 157
 158         ENTRY
 159
 160         PUSH    P,[INXTRD]
 161         JRST    READ0
 162
 163 MFUNCTION READ,SUBR
 164
 165         ENTRY
 166
 167         PUSH    P,[IREAD1]      ;WHERE TO GO AFTER BINDING
 168 READ0:  PUSH    TP,$TTP         ;SLOT FOR LAST THING READ (TYPE IS UNREADABLE)
 169         PUSH    TP,[0]
 170         PUSH    TP,$TFIX        ;SLOT FOR RADIX
 171         PUSH    TP,[0]
 172         PUSH    TP,$TCHAN       ;AND SLOT FOR CHANNEL
 173         PUSH    TP,[0]
 174         JUMPGE  AB,READ1        ;NO ARGS, NO BINDING
 175         MOVE    B,AB            ;GET A COPY OF THE ARG BLOCK
 176         MOVEI   D,0             ;ACCESS ARG TABLE
 177 ARGLP:  HLRZ    C,(B)           ;ISOLATE TYPE
 178         XCT     ARGS(D)         ;DO THE APROPRIATE COMPARE
 179         JRST    WRONGT
 180         PUSH    TP,[TATOM,,-1]  ;PUSH THE ATOMS
 181         PUSH    TP,@ARGS+1(D)
 182         PUSH    TP,(B)          ;PUSH ARGS
 183         PUSH    TP,1(B)
 184         PUSH    TP,[0]          ;DUMMY
 185         PUSH    TP,[0]
 186         ADDI    D,2             ;BUMP ARG TBL POINTER
 187         ADD     B,[2,,2]        ;AND ARG POINTER
 188         JUMPL   B,ARGLP         ;MORE?
 189
 190         PUSHJ   P,SPECBIND      ;NO, GO BIND
 191
 192
 193 \f; ARGUMENTS ARE BOUND, NOW GET THE VALUES OF THINGS
 194
 195 READ1:  MOVE    B,MQUOTE INCHAN,,       ;GET INPUT CHANNEL
 196         MOVSI   A,TATOM
 197         PUSHJ   P,IDVAL         ;NOW GOBBLE THE REAL CHANNEL
 198         CAME    A,$TCHAN        ;IS IT A CHANNEL
 199         JRST    CHNLOS
 200         MOVEM   B,5(TB)         ;SAVE CHANNEL
 201         MOVEI   B,DIRECT-1(B)   ;POINT TO DIRECTION
 202         PUSHJ   P,CHRWRD        ;GOBBLE AND CHECK
 203         JRST    WRNGDI
 204         CAME    B,[ASCIZ /READ/]
 205         JRST    WRNGDI
 206         MOVE    B,5(TB)
 207 GETIO:  MOVE    A,IOINS(B)      ;GOBBLE THE I/O INSTRUCTION
 208         JUMPE   A,OPNFIL        ;GO REALLY OPEN THE CROCK
 209         MOVE    A,RADX(B)       ;GET RADIX
 210         MOVEM   A,3(TB)
 211         MOVEM   B,5(TB) ;SAVE CHANNEL
 212 REREAD: MOVE    D,LSTCH(B)      ;ANY CHARS AROUND?
 213         CAIN    D,233           ;FLUSH THE TERMINATOR HACK
 214         SETZM   LSTCH(B)
 215
 216         PUSHJ   P,@(P)          ;CALL INTERNAL READER
 217         JRST    BADTRM          ;LOST
 218 RFINIS: MOVE    C,5(TB)         ;GET CHANNEL
 219         MOVE    D,LSTCH(C)              ;GET LAST CHR
 220         CAIN    D,233           ;SPECIAL ENDER?
 221         SETZM   LSTCH(C)                ;YES CLOBBER
 222         SUB     P,[1,,1]        ;POP OFF LOSER
 223         JRST    FINIS
 224
 225 BADTRM: CAIE    B,3             ;READ 'FAILED' IS LOSER EOF
 226         JRST    CHLSTC          ;NO, MUST BE UNMATCHED PARENS
 227         PUSH    TP,4(TB)                ;CLOSE THE CHANNEL
 228         PUSH    TP,5(TB)
 229         MCALL   1,FCLOSE
 230         MOVE    B,MQUOTE EOF,,  ;GET EOF
 231         MOVSI   A,TATOM
 232         PUSHJ   P,IDVAL         ;GET LOCAL VALUE
 233         CAMN    A,$TUNBOU       ;UNBOUND IS ONLY LOSER
 234         JRST    NEOF
 235         PUSH    TP,A            ;SETUP CALL TO EVAL
 236         PUSH    TP,B
 237         MCALL   1,EVAL          ;AND EVAL IT
 238         JRST    RFINIS          ; AND RETURN
 239
 240 ;HERE TO ATTEMPT TO OPEN A CLOSED CHANNEL
 241
 242 OPNFIL: PUSHJ   P,OPNCHN        ;GO DO THE OPEN
 243         JUMPE   B,OPNERR        ;LOSE IC B IS 0
 244         JRST    GETIO
 245
 246
 247 CHLSTC: MOVE    B,5(TB)         ;GET CHANNEL BACK
 248         JRST    REREAD
 249
 250 \f;MAIN ENTRY TO READER
 251
 252 IREAD:
 253         PUSHJ   P,LSTCHR        ;DON'T REREAD LAST CHARACTER
 254 IREAD1: INTGO
 255         PUSH    TP,(TB)         ;SAVE LAST FORM
 256         PUSH    TP,1(TB)
 257 BDLP:   PUSHJ   P,NXTCH         ;GOBBLE CHAR IN A AND TYPE IN D
 258         CAIG    B,ENTYPE
 259         JUMPN   B,@.+1(B)       ;ERROR ON ZERO TYPE OR FUNNY TYPE
 260         JRST    BADCHR
 261 DTBL:   NUMLET                  ;HERE IF NUMBER OR LETTER
 262         NUMLET                  ;NUMBER
 263 NUMCOD==.-DTBL
 264         NUMLET                  ;+-
 265         NUMLET                  ;.
 266 DOTTYP==.-DTBL
 267         NUMLET                  ;E
 268 NONSPC==.-DTBL  ;NUMBER OF NON-SPECIAL CHARACTERS
 269         SPACE                   ;SPACING CHAR CR,LF,SP,TAB ETC.
 270 SPATYP==.-DTBL  ;TYPE FOR SPACE CHARS
 271
 272
 273 ;THE FOLLOWING ENTRIES ARE VARIOUS PUNCTUATION CROCKS
 274
 275         LPAREN                  ;( - BEGIN LIST
 276         RPAREN                  ;) - END CURRENT LEVEL OF INPUT
 277         LBRACK                  ;[ -BEGIN ARRAY
 278 LBRTYP==.-DTBL
 279         RBRACK                  ;] - END OF ARRAY
 280         QUOTIT                  ;' - QUOTE THE FOLLOWING GOODIE
 281 QUOTYP==.-DTBL
 282
 283         MACCAL                  ;% - INVOKE A READ TIME MACRO
 284 MACTYP==.-DTBL
 285         CSTRING                 ;" - CHARACTER STRING
 286 CSTYP==.-DTBL
 287         NUMLET                  ;\ - ESCAPE,BEGIN ATOM
 288
 289 ESCTYP==.-DTBL  ;TYPE OF ESCAPE CHARACTER
 290
 291         SPECTY                  ;# - SPECIAL TYPE TO BE READ
 292         OPNANG                  ;< - BEGIN ELEMENT CALL
 293
 294 SLMNT==.-DTBL   ;TYPE OF START OF SEGMENT
 295
 296         CLSANG                  ;> - END ELEMENT CALL
 297
 298
 299         EOFCHR                  ;^C - END OF FILE
 300
 301         COMNT                   ;; - BEGIN COMMENT
 302
 303         GLOVAL                  ;, - GET GLOBAL VALUE
 304 GLMNT==.-DTBL
 305
 306 NTYPES==.-DTBL
 307 \f
 308
 309
 310 ; EXTENDED TABLE FOR ! HACKS
 311
 312         SEGDOT                  ;!. - CALL TO LVAL (SEG)
 313 DOTEXT==.-DTBL
 314         UVECIN                  ;![ - INPUT UNIFORM VECTOR ]
 315 LBREXT==.-DTBL
 316         QUOSEG                  ;!' - SEG CALL TO QUOTE
 317 QUOEXT==.-DTBL
 318         SINCHR                  ;!" - INPUT ONE CHARACTER
 319 CSEXT==.-DTBL
 320         SEGIN                   ;!< - SEG CALL
 321 SLMEXT==.-DTBL
 322         GLOSEG                  ;!, - SEG CALL TO GVAL
 323 GLMEXT==.-DTBL
 324         TERM                    ;!$ - (EXCAL-ALT MODE) PUT ALL CLOSES
 325 MANYT==.-DTBL
 326 ENTYPE==.-DTBL
 327
 328
 329
 330 SPACE:  PUSHJ   P,LSTCHR                ;DONT REREAD SPACER
 331         JRST    BDLP
 332
 333 \f
 334 ;HERE ON NUMBER OR LETTER, START ATOM
 335
 336 NUMLET: PUSHJ   P,GOBBLE        ;READ IN THE ATOM AND PUT PNTR ON ARG PDL
 337         JRST    RET             ;NO SKIP RETURN I.E. NON NIL
 338
 339 ;HERE TO START BUILDING A CHARACTER STRING GOODIE
 340
 341 CSTRING:        PUSHJ   P,GOBBL1        ;READ IN STRING
 342         JRST    RET
 343
 344 ;ARRIVE HERE TO INVOKE A READ TIME MACRO FUNCTION
 345
 346 MACCAL: PUSHJ   P,NXTCH1        ;READ ONE MORE CHARACTER
 347         CAIE    B,MACTYP        ;IS IT ANOTHER MACRO CHAR
 348
 349         JRST    MACAL1          ;NO, CALL MACRO AND USE VALUE
 350         PUSHJ   P,LSTCHR        ;DONT REREAD %
 351         PUSHJ   P,MACAL1        ;OTHERWISE, USE SIDE EFFECCT, BUT NOT VALUE
 352         JFCL                    ;IGNORE LOSER
 353         JRST    IREAD1
 354
 355 MACAL1: PUSHJ   P,IREAD1        ;READ FUNCTION NAME
 356         PUSHJ   P,ERRPAR        ;BAD PARENS
 357         PUSH    TP,A            ;SAVE THE RESULT
 358         PUSH    TP,B            ;AND USE IT AS AN ARGUMENT
 359         MCALL   1,EVAL
 360         JRST    RET
 361
 362 ;CALL GOBBLE TO FIND THE TYPE AND THEN IREAD TO READ IT
 363
 364 SPECTY: PUSHJ   P,IREAD         ;READ THE TYPES NAME (SHOULD BE AN ATOM)
 365         PUSHJ   P,ERRPAR
 366         PUSH    TP,A            ;BEGIN SETTING UP CHTYPE CALL
 367         PUSH    TP,B
 368         PUSHJ   P,IREAD1        ;NOW READ STRUCTURE
 369         PUSHJ   P,ERRPAR        ;LOSSAGE
 370         EXCH    A,-1(TP)        ;USE AS FIRST ARG
 371         EXCH    B,(TP)
 372         PUSH    TP,A            ;USE OTHER AS 2D ARG
 373         PUSH    TP,B
 374         MCALL   2,CHTYPE        ;ATTEMPT TO MUNG
 375         JRST    RET
 376 \f
 377 ;THIS CODE CALLS IREAD RECURSIVELY TO READ THAT WHICH IS
 378 ;BETWEEN (),  ARRIVED AT WHEN ( IS READ
 379
 380 SEGIN:  PUSH    TP,$TSEG
 381         JRST    OPNAN1
 382
 383 OPNANG: PUSH    TP,$TFORM       ;SAVE TYPE
 384 OPNAN1: PUSH    P,[">]
 385         JRST    LPARN1
 386
 387 LPAREN: PUSH    P,[")]
 388         PUSH    TP,$TLIST       ;START BY ASSUMING NIL
 389 LPARN1: PUSH    TP,[0]
 390         PUSHJ   P,LSTCHR        ;DON'T REREAD PARENS
 391 LLPLOP: PUSHJ   P,IREAD1        ;READ IT
 392         JRST    LDONE           ;HIT TERMINATOR
 393
 394 ;HERE WHEN MUST ADD CAR TO CURRENT WINNER
 395
 396 GENCAR: PUSH    TP,A            ;SAVE TYPE OF VALUE
 397         PUSH    TP,B            ;AND VALUE
 398         MCALL   1,NCONS         ;GOBBLE NIL LISTE
 399         MOVEM   A,(TB)          ;SAVE AWAY
 400         MOVEM   B,1(TB)         ;FOR COMMENT
 401         POP     TP,C            ;GET CDR
 402         JUMPN   C,CDRIN         ;IF STACKED GOODIE NOT NIL SKIP
 403         MOVE    C,(TP)          ;FIX UP LAT TYPE
 404         MOVEM   C,(TB)
 405         PUSH    TP,B            ;AND USE AS TOTAL VALUE
 406         PUSH    TP,A            ;SAVE THIS AS FIRSST THING ON LIST
 407         JRST    .+2             ;SKIP CDR SETTING
 408 CDRIN:  HRRM    B,(C)
 409         PUSH    TP,B            ;CLOBBER IN NEW PARTIAL GOODIE
 410         JRST    LLPLOP          ;AND CONTINUE
 411
 412 ; HERE TO RAP UP LIST
 413
 414 LDONE:  CAME    B,(P)           ;CHECK VALIDITY OF CHARACTER
 415         PUSHJ   P,MISMAT        ;REPORT MISMATCH
 416         SUB     P, [1,,1]
 417         POP     TP,B            ;GET VALUE OF PARTIAL RESULT
 418         POP     TP,A            ;AND TYPE OF SAME
 419         JUMPE   B,RET           ;VALUE IS NIL, DON'T POP AGAIN
 420         POP     TP,B            ;POP FIRST LIST ELEMENT
 421         POP     TP,A            ;AND TYPE
 422         JRST    RET
 423 \f
 424 ;THIS CODE IS SIMILAR TO LIST GENERATING CODE BUT IS FOR VECTORS
 425 UVECIN: PUSH    P,[EUVECTOR]    ;PUSH NAME OF U VECT HACKER
 426         JRST    LBRAK2          ;AND GO
 427
 428 LBRACK: PUSH    P,[EVECTOR]             ;PUSH GEN VECTOR HACKER
 429 LBRAK2: PUSHJ   P,LSTCHR        ;FORCE READING NEW CHAR
 430         PUSH    P,[0]           ;INITIALIZE TO (WILL COUNT VECTOR ELEMENTS)
 431
 432 LBRAK1: PUSHJ   P,IREAD1        ;RECURSIVELY READ  ELEMENTS OF ARRAY
 433         JRST    LBDONE          ;RAP UP ON TERMINATOR
 434
 435 STAKIT: PUSH    TP,A            ;SAVE RESULT TYPE
 436         PUSH    TP,B            ;AND VALUE
 437         AOS     VCNT(P)         ;AND COUNT
 438         JRST    LBRAK1
 439
 440 ; HERE TO RAP UP VECTOR
 441
 442 LBDONE: CAIE    B,"]            ;FINISHED RETURN (WAS THE RIGHT STOP USED?)
 443         PUSHJ   P,MISMAB        ;WARN USER
 444         MOVE    A,VCNT(P)
 445         ACALL   A,@-1(P)        ;MAKE THE VECTOR
 446         SUB     P,[2,,2]
 447         JRST    RET
 448
 449
 450 ; BUILD A SINGLE CHARACTER ITEM
 451
 452 SINCHR: PUSHJ   P,NXTC1         ;FORCE READ NEXT
 453         CAIN    B,ESCTYP                ;ESCAPE?
 454         PUSHJ   P,NXTC1         ;RETRY
 455         LSHC    A,29.-36.       ;POSITION IN B
 456         MOVSI   A,TCHRS
 457         JRST    RETCL
 458
 459 \f
 460 ; HERE ON RIGHT PAREN, BRACKET, ANGLE BRACKET OR CTL C
 461
 462 CLSANG:                         ;CLOSE ANGLE BRACKETS
 463 RBRACK:                         ;COMMON RETURN FOR END OF ARRAY ALSO
 464 RPAREN: PUSHJ   P,LSTCHR        ;DON'T REREAD
 465 EOFCHR: MOVE    B,A             ;GETCHAR IN B
 466         MOVSI   A,TCHRS         ;AND TYPE IN A
 467         JRST    RET1            ;AND LEAVE
 468
 469 ; NORMAL RETURN FROM IREAD/IREAD1
 470
 471 RETCL:  PUSHJ   P,LSTCHR        ;DONT REREAD
 472 RET:    AOS     (P)             ;SKIP
 473 RET1:   POP     TP,1(TB)        ;SAVE LAST READ CROCK
 474         POP     TP,(TB)
 475         POPJ    P,
 476
 477
 478 ;RANDOM MINI-SUBROUTINES USED BY THE READER
 479
 480 ;READ A CHAR INTO A AND TYPE CODE INTO D
 481
 482 NXTC1:  MOVE    B,5(TB) ;GET CHANNEL
 483         JRST    NXTC2
 484 NXTC:   MOVE    B,5(TB) ;GET CHANNEL
 485         SKIPN   A,LSTCH(B)      ;CHAR IN A IF REUSE
 486 NXTC2:  XCT     IOINS(B)        ;GET CHARACTER FROM INPUT
 487         ANDI    A,377           ;INCASE IT IS EOF
 488         MOVEM   A,LSTCH(B)      ;SAVE THE CHARACTER
 489         TRZE    A,200           ;DONT SKIP IF SPECIAL
 490         JRST    RETYPE          ;GO HACK SPECIALLY
 491 GETCTP: PUSH    P,A     ;AND SAVE FROM DIVISION
 492         IDIVI   A,CHRWD ;YIELDS WORD AND CHAR NUMBER
 493         LDB     B,BYTPNT(B)     ;GOBBLE TYPE CODE
 494         POP     P,A
 495         POPJ    P,
 496
 497 ; NXTCH AND NXTCH1 ARE SAME AS NXTC AND NXTC1 EXCEPT THEY CHECK !
 498 ; HACKS
 499
 500 NXTCH1: PUSHJ   P,NXTC1         ;READ CHAR
 501         JRST    .+2
 502 NXTCH:  PUSHJ   P,NXTC          ;READ CHAR
 503         CAIE    B,NTYPES+1      ;IF 1 > THAN MAX, MUST BE SPECIAL
 504         POPJ    P,              ;OTHERWISE JUST RETURN
 505
 506         PUSHJ   P,NXTC1         ;READ NEXT ONE
 507         CAIN    B,1             ;LETTER?
 508         JRST    UPLO            ;YES, INVERT CASE
 509 RETYP1: CAIN    B,DOTTYP        ;!.
 510         MOVEI   B,DOTEXT        ;YES, GET EXTENDED TYPE
 511         CAIN    B,LBRTYP        ;DO FOR ALL SPECIALS
 512         MOVEI   B,LBREXT
 513         CAIN    B,QUOTYP
 514         MOVEI   B,QUOEXT
 515         CAIN    B,CSTYP
 516         MOVEI   B,CSEXT
 517         CAIN    B,SLMNT
 518         MOVEI   B,SLMEXT
 519         CAIN    B,GLMNT
 520         MOVEI   B,GLMEXT
 521         CAIN    B,SPATYP                ;SPACER?
 522         JRST    CHKALT          ;YES, CHECK IT
 523
 524 CRMLST: ADDI    A,200           ;CLOBBER LASTCHR
 525         PUSH    P,B
 526         MOVE    B,5(TB)         ;POINT TO CHANNEL
 527         MOVEM   A,LSTCH(B)
 528         SUBI    A,200           ;DECREASE CHAR
 529         POP     P,B
 530         POPJ    P,
 531
 532 UPLO:   ADDI    A,40            ;CHANGE CASE OF LETTER IN A
 533         CAIL    A,173
 534         SUBI    A,100
 535         JRST    CRMLST
 536
 537 RETYPE: PUSHJ   P,GETCTP        ;GET TYPE OF CHAR
 538         JRST    RETYP1
 539
 540
 541 CHKALT: CAIN    A,33            ;ALT?
 542         MOVEI   B,MANYT
 543         JRST    CRMLST
 544
 545
 546 TERM:   MOVEI   B,0             ;RETURN A 0
 547         POPJ    P,              ;AND RETURN
 548 \f
 549
 550
 551 ;TABLE OF BYTE POINTERS FOR GETTING CHARS
 552
 553 BYTPNT":        350700,,CHTBL(A)
 554         260700,,CHTBL(A)
 555         170700,,CHTBL(A)
 556         100700,,CHTBL(A)
 557         010700,,CHTBL(A)
 558
 559 ;HERE ARE THE TABLES OF CHXRACTERS (NOTE EVERYTHING NOT SPECIFIED IS
 560 ;IN THE NUMBER LETTER CATAGORY)
 561
 562 SETCHR 2,[0123456789]
 563
 564 SETCHR 3,[+-]
 565
 566 SETCHR 4,[.]
 567
 568 SETCHR 5,[Ee]
 569
 570 SETCOD 6,[15,12,11,14,40,33]    ;ALL ARE TYPE 2 (SPACING - FF,TAB,SPACE,ALT-MODE)
 571
 572 INCRCH 7,[()[]'%"\#<>]  ;GIVE THESE INCREASRNG CODES FROM 3
 573
 574 SETCOD 22,[3]   ;^C - EOF CHARACTER
 575
 576 INCRCH 23,[;,!]         ;COMMENT AND GLOBAL VALUE AND SPECIAL
 577
 578 CHTBL:
 579         OUTTBL                  ;OUTPUT THE TABLE RIGHT HERE
 580
 581
 582 \f
 583 ; THIS CODE ASSOCIATES A COMMENT WITH THE LAST READ GOODIE
 584
 585 COMNT:  HLRZ    A,(TB)          ;CHECK THERE IS AN ITEM TO COMMENT
 586         CAIN    A,TTP           ;TYPE TP MEANS NONE THERE
 587         JRST    NOCMNT
 588         PUSH    TP,(TB)         ;SAVE THEM
 589         PUSH    TP,1(TB)
 590         MOVSI   A,TTP           ;RESET LAST GOODIE
 591         MOVEM   A,(TB)
 592         SETZM   1(TB)
 593         PUSHJ   P,IREAD         ;CALL READER FLUSHING ,
 594         PUSHJ   P,ERRPAR
 595         PUSH    TP,$TATOM
 596         PUSH    TP,MQUOTE COMMENT
 597         PUSH    TP,A            ;PUSH THE COMMENT
 598         PUSH    TP,B
 599         MCALL   3,PUT           ;PUT THE COMMENT ON
 600         JRST    BDLP
 601
 602 ; THIS CODE FLUSHES WANDERING COMMENTS
 603
 604 NOCMNT: PUSHJ   P,IREAD
 605         PUSHJ   P,ERRPAR
 606         JRST    BDLP
 607 \f
 608 ;SUBROUTINE TO READ CHARS ONTO STACK
 609
 610 GOBBL1: MOVEI   FF,0            ;KILL ALL FLAGS
 611         PUSHJ   P,LSTCHR        ;DON'T REREAD "
 612         TROA    FF,NOTNUM+INSTRN        ;SURPRESS NUMBER CONVERSION
 613 GOBBLE: MOVEI   FF,0            ;FLAGS CONCERRNING CURRENT GOODIE IN HERE
 614         MOVE    A,TP            ;GOBBLE CURRENT TP TO BE PUSHED
 615         MOVEI   C,6             ;NOW PUSH 6 0'S ON TO STACK
 616         PUSH    TP,$TFIX        ;TYPE IS FIXED
 617         PUSH    TP,FF           ;AND VALUE IS 0
 618         SOJG    C,.-2           ;FOUR OF THEM
 619         PUSH    TP,$TTP         ;NOW SAVE OLD TP
 620         ADD     A,[1,,1]        ;MAKE IT LOOK LIKE A TB
 621         PUSH    TP,A
 622         MOVEI   D,0             ;ZERO OUT CHARACTER COUNT
 623 GOB1:   MOVEI   C,0             ;SET UP FIRST WORD OF CHARS
 624         PUSH    P,[440700,,C]   ;BYTE POINTER
 625 GOB2:   PUSH    P,FF            ;SAVE FLAG REGISTER
 626         PUSHJ   P,NXTCH         ;READ A CHAACTER
 627         POP     P,FF            ;AND RESTORE FLAG REGISTER
 628         CAIN    B,ESCTYP        ;IS IT A CHARACTER TO BE ESCAPED
 629         JRST    ESCHK           ;GOBBLE THE ESCAPED CHARACTER
 630         TRNE    FF,INSTRN       ;ARE WE BUILDING A CHAR STRING
 631         JRST    ADSTRN          ;YES, GO READ IN
 632         CAILE   B,NONSPC        ;IS IT SPECIAL
 633         JRST    DONEG           ;YES, RAP THIS UP
 634
 635         TRNE    FF,NOTNUM       ;IS  NUMERIC STILL WINNING
 636         JRST    SYMB2           ;NO, ONLY DO CHARACTER HACKING
 637         CAIL    A,60            ;CHECK FOR DIGIT
 638         CAILE   A,71
 639         JRST    SYMB1   ;NOT A DIGIT
 640         JRST    CNV             ;GO CONVERT TO NUMBER
 641 \fCNV:
 642
 643 ;ARRIVE HERE IF STILL BUILDING A NUMBER
 644 CNV:    MOVE    B,(TP)  ;GOBBLE POINTER TO TEMPS
 645         TRO     FF,NUMWIN       ;SAY DIGITSSEEN
 646         SUBI    A,60    ;CONVERT TO  A NUMBER
 647         TRNE    FF,EFLG ;HAS E BEEN SEEN
 648         JRST    ECNV            ;YES, CONVERT EXPONENT
 649         TRNE    FF,DOTSEN       ;HAS A DOT BEEN SEEN
 650
 651         JRST    DECNV           ;YES, THIS IS A FLOATING NUMBER
 652
 653         JFCL    17,.+1  ;KILL ALL FLAGS
 654         MOVE    E,CNUM(B)       ;COMPUTE CURRENT RADIX
 655         IMUL    E,3(TB)
 656         ADD     E,A     ;ADD IN CURRENT DIGIT
 657         JFCL    10,.+2
 658         MOVEM   E,CNUM(B)       ;AND SAVE IT
 659
 660
 661
 662 ;INSERT OCTAL AND CRADIX CROCK HERE IF NECESSSARY
 663         JRST    DECNV1          ;CONVERT TO DECIMAL(FIXED)
 664
 665
 666 DECNV:  TRO     FF,FLONUM       ;SET FLOATING FLAG
 667 DECNV1: JFCL    17,.+1  ;CLEAR ALL FLAGS
 668         MOVE    E,DNUM(B)       ;GET DECIMAL NUMBER
 669         IMULI   E,10.
 670         JFCL    10,CNV2 ;JUMP IF OVERFLOW
 671         ADD     E,A     ;ADD IN DIGIT
 672         MOVEM   E,DNUM(B)
 673         TRNE    FF,FLONUM       ;IS THIS FRACTION?
 674         SOS     NDIGS(B)        ;YES, DECREASE EXPONENT BY ONE
 675
 676 CNV1:   PUSHJ   P,NXTCH         ;RE-GOBBLE CHARACTER
 677         JRST    SYMB2           ;ALSO DEPOSIT INTO SYMBOL BEING MADE\rîCNV2:                             ;OVERFLOW IN DECIMAL NUMBER
 678         TRNE    FF,DOTSEN       ;IS THIS FRACTION PART?
 679         JRST    CNV1            ;YES,IGNORE DIGIT
 680         AOS     NDIGS(B)        ;NO, INCREASE IMPLICIT EXPONENT BY ONE
 681         TRO     FF,FLONUM       ;SET FLOATING FLAG BUT
 682         JRST    CNV1            ;DO NOT FORCE DECIMAL(DECFRC)
 683
 684 ECNV:                   ;CONVERT A DECIMAL EXPONENT
 685         HRRZ    E,ENUM(B)       ;GET EXPONENT
 686         IMULI   E,10.
 687         ADD     E,A             ;ADD IN DIGIT
 688         TLNN    E,777777        ;IF OVERFLOW INTO LEFT HALF
 689         HRRM    E,ENUM(B)       ;DO NOT STORE(CATCH ERROR LATER)
 690         JRST    CNV1
 691         JRST    SYMB2           ;ALSO DEPOSIT INTO SYMBOL BEING MADE
 692
 693 \f
 694 ;HERE TO PUT INTO IDENTIFIER BEING BUILT
 695
 696 ESCHK:  PUSHJ   P,NXTC1         ;GOBBLE NEXT CHAR
 697 SYMB:   MOVE    B,(TP)          ;GET BACK TEM POINTER
 698         TRNE    FF,EFLG         ;IF E FLAG SET
 699         HLRZ    FF,ENUM(B)      ;RESTORE SAVED FLAGS
 700         TRO     FF,NOTNUM       ;SET NOT NUMBER FLAG
 701 SYMB2:  TRO     FF,NFIRST       ;NOT FIRST IN WORLD
 702 SYMB3:  IDPB    A,(P)           ;INSERT IT
 703         PUSHJ   P,LSTCHR        ;READ NEW CHARACTER
 704         TRNN    C,377           ;WORD FULL?
 705         JRST    GOB2            ;NO, KEEP TRYING
 706         MOVEM   C,(P)           ;YES,STORE IT
 707         AOJA    D,GOB1          ;COUNT WORD AND GO
 708
 709 ;HERE TO CHECK FOR +,-,. IN NUMBER
 710
 711 SYMB1:  TRNE    FF,NFIRST       ;IS THIS THE FIRST CHARACTER
 712         JRST    CHECK.          ;NO, ONLY LOOK AT DOT
 713         CAIE    A,"-            ;IS IT MINUS
 714         JRST    .+3             ;NO CHECK PLUS
 715         TRO     FF,NEGF         ;YES, NEGATE AT THE END
 716         JRST    SYMB2
 717         CAIN    A,"+            ;IS IT +
 718         JRST    SYMB2           ;ESSENTIALLY IGNORE IT
 719
 720 ;COULD BE .
 721
 722 CHECK.: PUSHJ   P,LSTCHR        ;FLUSH LAST CHARACTER
 723         MOVEI   E,0
 724         TRNN    FF,DOTSEN+EFLG  ;IF ONE ALREADY SEEN
 725         CAIE    A,".
 726         JRST    CHECKE          ;GO LOOK FOR E
 727
 728 IFN FRMSIN,[
 729         TRNN    FF,NFIRST       ;IS IT THE FIRST
 730         JRST    DOT1            ;YES, COULD MEAN EVALUATE A VARIABLE
 731 ]
 732
 733 CHCK.1: TRO     FF,DECFRC+DOTSEN        ;FORCE DECIMAL
 734 IFN FRMSIN,     TRNN    FF,FRSDOT       ;IF NOT FIRST ., PUT IN CHAR STRING
 735         JRST    SYMB2           ;ENTER INTO SYMBOL
 736 IFN FRMSIN,     JRST    GOB2            ;IGNORE THE "."
 737 \f
 738
 739
 740 IFN FRMSIN,[
 741
 742 ;HERE TO SET UP FOR .FOO ..FOO OR.<ABC>
 743
 744 DOT1:   PUSH    P,FF            ;SAVE FLAGS
 745         PUSHJ   P,NXTCH1        ;GOBBLE A NEW CHARACTER
 746         POP     P,FF            ;RESTORE FLAGS
 747         TRO     FF,FRSDOT               ;SET FLAG IN CASE
 748         CAIN    B,NUMCOD                ;SKIP IF NOT NUMERIC
 749         JRST    CHCK.1          ;NUMERIC, COULD BE FLONUM
 750
 751 ; CODE TO HANDLE ALL IMPLICIT CALLS  I.E. QUOTE, LVAL, GVAL
 752
 753         MOVSI   B,TFORM         ;LVAL
 754         MOVE    A,MQUOTE LVAL
 755         SUB     P,[2,,2]        ;POP OFF BYTE POINTER AND GOBBLE CALL
 756         POP     TP,TP
 757         SUB     TP,[1,,1]       ;REMOVE  TP JUNK
 758         JRST    IMPCA1
 759
 760 GLOSEG: SKIPA   B,$TSEG         ;SEG CALL TO GVAL
 761 GLOVAL: MOVSI   B,TFORM ;FORM CALL TO SAME
 762         MOVE    A,MQUOTE GVAL
 763         JRST    IMPCAL
 764
 765 QUOSEG: SKIPA   B,$TSEG         ;SEG CALL TO QUOTE
 766 QUOTIT: MOVSI   B,TFORM
 767         MOVE    A,MQUOTE QUOTE
 768         JRST    IMPCAL
 769
 770 SEGDOT: MOVSI   B,TSEG          ;SEG CALL TO LVAL
 771         MOVE    A,MQUOTE LVAL
 772 IMPCAL: PUSHJ   P,LSTCHR        ;FLUSH LAST CHAR EXCEPT
 773 IMPCA1: PUSH    TP,$TATOM       ;FOR .FOO FLAVOR
 774         PUSH    TP,A            ;PUSH ARGS
 775         PUSH    P,B             ;SAVE TYPE
 776         PUSHJ   P,IREAD1                ;READ
 777         PUSHJ   P,ERRPAR
 778 IMPCA2: PUSH    TP,A            ;PUSH RESULTS
 779         PUSH    TP,B
 780         MCALL   2,LIST          ;MAKE THE LIST
 781         POP     P,A             ;GET FINAL TYPE
 782         JRST    RET             ;AND RETURN
 783
 784 \f
 785 ;HERE AFTER READING ATOM TO CALL VALUE
 786
 787 .SET:   SUB     P,[1,,1]        ;FLUSH GOBBLE CALL
 788         PUSH    P,$TFORM        ;GET WINNING TYPE
 789 .SET1:  PUSH    TP,$TATOM
 790         PUSH    TP,MQUOTE LVAL
 791         JRST    IMPCA2          ;GO CONS LIST
 792
 793 ]
 794
 795 ;HERE TO CHECK FOR "E" FLAVOR OF EXPONENT
 796
 797 CHECKE: TRNN    FF,EFLG         ;HAS ONE BEEN SEEN
 798         CAIE    A,"E            ;IF NOT, IS THIS ONE
 799         JRST    SYMB            ;NO, ENTER AS SYMBOL KILL NUMERIC WIN
 800
 801         TRNN    FF,NUMWIN       ;HAVE DIGITS BEEN SEEN?
 802         JRST    SYMB            ;NO, NOT A NUMBER
 803         MOVE    B,(TP)          ;GET POINTER TO TEMPS
 804         HRLM    FF,ENUM(B)      ;SAVE FLAGS
 805         HRRI    FF,DECFRC+DOTSEN+EFLG   ;SET NEW FLAGS
 806         JRST    SYMB3           ;ENTER SYMBOL
 807
 808
 809 ;HERE ON READING CHARACTER STRING
 810
 811 ADSTRN: CAIN    B,MANYT         ;TERMINATE?
 812         JRST    DONEG           ;YES
 813         CAIE    A,""            ;QUOTE CHAR?
 814         JRST    SYMB2           ;NO JUST INSERT IT
 815 ADSTN1: PUSHJ   P,LSTCHR        ;DON'T REREAD """
 816
 817 \f
 818 ;HERE TO FINISH THIS CROCK
 819
 820 DONEG:  TRNN    FF,NUMWIN       ;HAVE DIGITS BEEN SEEN?
 821         TRO     FF,NOTNUM       ;NO,SET NOT NUMBER FLAG
 822         POP     P,A             ;FLUSH POINT BYTER
 823         JUMPE   C,.+3           ;LAST WORD USED?
 824         PUSH    P,C             ;YES, STORE IT
 825         AOS     D               ;AND BUMP COUNT
 826         PUSH    P,D             ;SAVE IT
 827         TRNN    FF,NOTNUM       ;NUMERIC?
 828         JRST    NUMHAK          ;IS NUMERIC, GO TO IT
 829
 830 IFN FRMSIN,[
 831         MOVE    A,(TP)          ;GET POINTER TO TEMPS
 832         MOVEM   FF,NDIGS(A)     ;USE TO HOLD FLAGS
 833 ]
 834         TRNE    FF,INSTRN       ;ARE WE BUILDING A STRING
 835         JRST    MAKSTR          ;YES, GO COMPLETE SAME
 836         MOVSI   A,TATOM         ;GET AATOM TYPE
 837         MOVE    B,MQUOTE OBLIST,
 838         PUSHJ   P,IDVAL         ;GET VALUE
 839         PUSHJ   P,RLOOKU
 840
 841 IFN FRMSIN,[
 842         MOVE    C,(TP)          ;SET TO REGOBBLE FLAGS
 843         MOVE    FF,NDIGS(C)
 844 ]
 845         JRST    FINID
 846
 847 ;HERE TO RAP UP CHAR STRING ITEM
 848
 849 MAKSTR: MOVE    C,D             ;SETUP TO CALL CHMAK
 850         PUSHJ   P,CHMAK         ;GO MAKE SAME
 851         JRST    FINID
 852
 853
 854 NUMHAK: MOVE    C,(TP)          ;REGOBBLETEMP POINTER
 855         POP     P,D     ;POP OFF STACK TOP
 856         HRLI    D,(D)   ;TOO BOTH HALVES
 857         SUB     P,D             ;REMOVE CHAR STRING
 858         TRNE    FF,FLONUM+EFLG  ;IS IT A FLOATING POINT NUMBER
 859         JRST    FLOATIT         ;YES, GO MAKE IT WIN
 860         MOVE    B,CNUM(C)
 861         TRNE    FF,DECFRC
 862         MOVE    B,DNUM(C)       ;GRAB FIXED GOODIE
 863 \rFINID2:        MOVSI   A,TFIX          ;SAY FIXED POINT
 864 FINID1: TRNE    FF,NEGF         ;NEGATE
 865         MOVNS   B               ;YES
 866 FINID:  POP     TP,TP           ;RESTORE OLD TP
 867         SUB     TP,[1,,1]       ;FINISH HACK
 868 IFN FRMSIN,[
 869         TRNE    FF,FRSDOT       ;DID . START IT
 870         JRST    .SET            ;YES, GO HACK
 871 ]
 872         POPJ    P,              ;AND RETURN
 873
 874
 875 \fFLOATIT:î      JFCL    17,.+1          ;CLEAR ALL ARITHMETIC FLAGS
 876 \r       TRNE    FF,EFLG ;"E" SEEN?
 877         JRST    EXPDO   ;YES, DO EXPONENT
 878         MOVE    D,NDIGS(C)      ;GET IMPLICIT EXPONENT
 879
 880 FLOATE: MOVE    A,DNUM(C)       ;GET DECIMAL NUMBER\0
 881         IDIVI   A,400000        ;SPLIT
 882         FSC     A,254   ;CONVER\0T MOST SIGNIFICANT
 883         FSC     B,233   ; AND LEAST SIGNIFICANT
 884         FADR    B,A             ;COMBINE
 885
 886         MOVM    A,D             ;GET MAGNITUDE OF EXPONENT
 887         CAILE   A,37.           ;HOW BIG?
 888         JRST    FOOR            ;TOO BIG-FLOATING OUT OF RANGE
 889         JUMPGE  D,FLOAT1        ;JUMP IF EXPONENT POSITIVE
 890         FDVR    B,TENTAB(A)     ;DIVIDE BY TEN TO THE EXPONENT
 891         JRST    SETFLO
 892
 893 FLOAT1: FMPR    B,TENTAB(A)     ;SCALE UP
 894
 895 SETFLO: JFCL    10,FOOR ;FLOATING OUT OF RANGE ON OVERFLOW
 896         MOVSI   A,TFLOAT
 897 IFN FRMSIN,     TRZ     FF,FRSDOT       ;FLOATING NUMBER NOT VALUE
 898         JRST    FINID1
 899
 900 EXPDO:
 901         HRRZ    D,ENUM(C)       ;GET EXPONENT
 902         TRNE    FF,NEGF ;IS EXPONENT NEGATIVE?
 903         MOVNS   D               ;YES
 904         ADD     D,NDIGS(C)      ;ADD IMPLICIT EXPONENT
 905         HLR     FF,ENUM(C)      ;RESTORE FLAGS
 906         JUMPL   D,FLOATE        ;FLOATING IF EXPONENT NEGATIVE
 907         CAIG    D,10.           ;OR IF EXPONENT TOO LARGE
 908         TRNE    FF,FLONUM       ;OR IF FLAG SET
 909         JRST    FLOATE
 910         MOVE    B,DNUM(C)       ;
 911         IMUL    B,ITENTB(D)
 912         JFCL    10,FLOATE               ;IF OVERFLOW, MAKE FLOATING
 913         JRST    FINID2          ;GO MAKE FIXED NUMBER
 914 \f
 915 ; HERE TO READ ONE CHARACTER FOR USER.
 916
 917 INXTRD: SKIPA   E,[JFCL]        ;NULL CLEAR INS
 918 IREADC: MOVE    E,[PUSHJ P,LSTCHR]      ;AVOID RE-READ
 919         PUSHJ   P,NXTC  ;GOBBLE THE CHAR
 920         XCT     E               ;CLEAR LSTCHR IF NECESSARY
 921         CAIN    A,3             ;IS IT EOF?
 922         JRST    EOFCHR          ;DO EOF RETURN
 923         MOVE    B,A             ;CHAR TO B
 924         LSH     B,29.           ;LEFT JUSTIFY
 925         MOVSI   A,TCHRS         ;AND TYPE
 926         JRST    RET
 927
 928 ; READER ERRORS COME HERE
 929
 930 ERRPAR: PUSH    TP,$TCHRS       ;DO THE OFFENDER
 931         LSH     B,29.           ;POSITION IN WORD
 932         PUSH    TP,B
 933         PUSH    TP,$TCHRS
 934         PUSH    TP,[40_29.]             ;SPACE
 935         PUSH    TP,$TATOM
 936         PUSH    TP,MQUOTE WARNING-UNMATCHED
 937         MCALL   1,PRIN1
 938         MCALL   1,PRINC
 939         MCALL   1,PRINC
 940         PUSHJ   P,LSTCHR                ;FLUSH THE CHARACTER
 941         SOS     (P)             ;SIMULATE JRST .-1
 942         SOS     (P)
 943         POPJ    P,
 944
 945 ;COMPLAIN ABOUT MISMATCHED CLOSINGS
 946
 947 MISMAB: SKIPA   A,["]]
 948 MISMAT: MOVE    A,-1(P)         ;GOBBLE THE DESIRED CHARACTER
 949         JUMPE   B,CPOPJ         ;IGNORE UNIVERSAL CLOSE
 950         LSH     A,29.           ;POSITION
 951         PUSH    TP,$TCHRS
 952         PUSH    TP,A
 953         PUSH    TP,$TATOM
 954         PUSH    TP,MQUOTE [ INSTEAD-OF ]
 955         PUSH    TP,$TCHRS
 956         LSH     B,29.
 957         PUSH    TP,B
 958         MCALL   1,PRINC
 959         MCALL   1,PRINC
 960         MCALL   1,PRINC
 961 CPOPJ:  POPJ    P,
 962
 963
 964
 965 ; HERE TO RESET A READ CHANNEL
 966
 967 MFUNCTION RRRES,SUBR,RESET
 968
 969         ENTRY   1
 970         GETYP   A,(AB)
 971         CAIE    A,TCHAN
 972         JRST    WRONGT
 973         MOVE    C,1(AB)         ;GET CHANNEL
 974         MOVEI   B,DIRECT-1(C)   ;POINT TO DIRECTION
 975         PUSHJ   P,CHRWRD                ;CONVER T TO A WORD
 976         JFCL
 977         CAME    B,[ASCII /READ/]
 978         JRST    WRNGDI
 979         MOVE    B,1(AB)         ;RESTORE CHANNEL
 980         SETZM   LSTCH(B)
 981         PUSHJ   P,RRESET"       ;DO REAL RESET
 982         MOVE    A,(AB)          ;RETURN ARG
 983         JRST    FINIS
 984
 985 \f
 986 ; HERE ON BAD INPUT CHARACTER
 987
 988 BADCHR: PUSH    TP,$TATOM
 989         PUSH    TP,MQUOTE BAD CHARACTER IGNORED
 990         MCALL   1,PRINT
 991         JRST    IREAD
 992
 993
 994 ;EOF ERROR
 995
 996 NEOF:   PUSH    TP,$TATOM       ;GENERATE ERROR MESSAGE
 997         PUSH    TP,MQUOTE EOF-REACHED
 998         JRST    CALER1
 999
1000 ;LOSING CHANNEL FOR INPUT
1001
1002 CHNLOS: PUSH    TP,$TATOM
1003         PUSH    TP,MQUOTE BAD-CHANNEL
1004         JRST    CALER1
1005
1006
1007 ;OPEN ERROR
1008
1009 OPNERR: PUSH    TP,$TATOM       ;SETUP MESSAGE
1010         PUSH    TP,MQUOTE OPEN-FAILED
1011         JRST    CALER1
1012
1013 ;HERE FOR DIRECTION ERROR
1014
1015 WRNGDI: PUSH    TP,$TATOM       ;SET UP ERROR
1016         PUSH    TP,MQUOTE NOT-OPEN-FOR-READING
1017         JRST    CALER1
1018
1019 ;WRONG ARG TYPE
1020
1021 WRONGT: PUSH    TP,$TATOM
1022         PUSH    TP,MQUOTE WRONG-TYPE
1023         JRST    CALER1
1024
1025 ;FLOATING POINT NUMBER TOO LARGE OR SMALL
1026 FOOR:   PUSH    TP,$TATOM
1027         PUSH    TP,MQUOTE NUMBER-OUT-OF-RANGE
1028         JRST    CALER1
1029
1030
1031 NILSXP: 0,,0
1032
1033 LSTCHR: PUSH    P,B
1034         MOVE    B,5(TB) ;GET CHANNEL
1035         SETZM   LSTCH(B)
1036         POP     P,B
1037         POPJ    P,
1038
1039
1040
1041 ;TABLE OF NAMES OF ARGS AND ALLOWED TYPES
1042
1043 ARGS:
1044         IRP     A,,[[[CAIN C,TUNBOU],EOF],[[CAIE C,TCHAN],INCHAN],[[PUSHJ P,CHOBL],OBLIST]]
1045                 IRP B,C,[A]
1046                         B
1047                         MQUOTE C
1048                         .ISTOP
1049                 TERMIN
1050         TERMIN
1051
1052 CHOBL:  CAIE    C,TLIST ;A LIST OR AN OBLIST
1053         CAIN    C,TOBLS
1054         AOS     (P)
1055         POPJ    P,
1056
1057 END
1058
1059 \f\f\ 3\f