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