sumex/reader.mcr264

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