2 TITLE READER FOR MUDDLE
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)
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
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
29 FF=0 ;FALG REGISTER DURING NUMBER CONVERSION
31 ;FLAGS USED (RIGHT HALF)
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
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
60 ; TABLE OF POWERS OF TEN
62 TENTAB: REPEAT 39. 10.0^<.RPCNT-1>
64 ITENTB: REPEAT 11. 10.^<.RPCNT-1>
67 \f; TEXT FILE LOADING PROGRAM
69 MFUNCTION MLOAD,SUBR,[LOAD]
73 HLRZ A,AB ;GET NO. OF ARGS
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?
82 TRY2: CAIE A,-2 ;IS ONE SUPPLIED
85 CHECK1: GETYP A,(AB) ;GET TYPE
86 CAIE A,TCHAN ;IS IT A CHANNEL
89 LOAD1: HLRZ A,TB ;GET CURRENT TIME
90 PUSH TP,$TTIME ;AND SAVE IT
93 MOVEI C,CLSNGO ; LOCATION OF FUNNY CLOSER
94 PUSHJ P,IUNWIN ; SET UP AS UNWINDER
96 LOAD2: PUSH TP,(AB) ;USE SUPPLIED CHANNEL
98 PUSH TP,(TB) ;USE TIME AS EOF ARG
100 CAML AB,C%M20 ; [-2,,0] ;CHECK FOR 2ND ARG
102 PUSH TP,2(AB) ;PUSH ON 2ND ARG
105 JRST CHKRET ;CHECK FOR EOF RET
108 CHKRET: CAMN A,(TB) ;IS TYPE EOF HACK
109 CAME B,1(TB) ;AND IS VALUE
110 JRST EVALIT ;NO, GO EVAL RESULT
118 CLSNGO: PUSH TP,$TCHAN
121 JRST UNWIN2 ; CONTINUE UNWINDING
130 ; OTHER FILE LOADING PROGRAM
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 READB
143 MOVE A,AB ;COPY OF ARGUMENT POINTER
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
151 PUSH TP,(A) ;SAVE THESE ARGS
153 ADD A,C%22 ; [2,,2] ;BUMP A
154 AOJA C,FARGS ;COUNT AND GO
156 OBLSV: MOVEM A,1(TB) ;SAVE THE AB
158 CALOPN: ACALL C,FOPEN ;OPEN THE FILE
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?
165 MCALL 1,MLOAD ;NO, JUST CALL
169 2ARGS: PUSH TP,(B) ;PUSH THE OBLIST
175 FNFFL: PUSH TP,$TATOM
176 PUSH TP,EQUOTE FILE-SYSTEM-ERROR
183 \fMFUNCTION READ,SUBR
187 PUSH P,[SETZ IREAD1] ;WHERE TO GO AFTER BINDING
188 READ0: PUSH TP,$TTP ;SLOT FOR LAST THING READ (TYPE IS UNREADABLE)
190 PUSH TP,$TFIX ;SLOT FOR RADIX
192 PUSH TP,$TCHAN ;AND SLOT FOR CHANNEL
194 PUSH TP,C%0 ; USER DISP SLOT
197 PUSH TP,C%0 ;SEGMENT FOR SPLICING MACROS
198 JUMPGE AB,READ1 ;NO ARGS, NO BINDING
199 GETYP C,(AB) ;ISOLATE TYPE
202 PUSH TP,[TATOM,,-1] ;PUSH THE ATOMS
203 PUSH TP,IMQUOTE INCHAN
204 PUSH TP,(AB) ;PUSH ARGS
208 MOVE B,1(AB) ;GET CHANNEL POINTER
209 ADD AB,C%22 ;AND ARG POINTER
210 JUMPGE AB,BINDEM ;MORE?
212 ADD B,[EOFCND-1,,EOFCND-1]
217 JUMPGE AB,BINDEM ;IF ANY MORE ARGS GO PROCESS AND BIND THEM
218 GETYP C,(AB) ;ISOLATE TYPE
223 PUSH TP,[TATOM,,-1] ;PUSH THE ATOMS
224 PUSH TP,IMQUOTE OBLIST
225 PUSH TP,(AB) ;PUSH ARGS
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
235 PUSH TP,IMQUOTE READ-TABLE
240 ADD AB,C%22 ; BUMP TO NEXT ARG
241 JUMPL AB,TMA ;MORE ?, ERROR
242 BINDEM: PUSHJ P,SPECBIND
245 MFUNCTION RREADC,SUBR,READCHR
249 JRST READC0 ;GO BIND VARIABLES
251 MFUNCTION NXTRDC,SUBR,NEXTCHR
256 READC0: CAMGE AB,C%M40 ; [-5,,]
261 MOVE B,IMQUOTE INCHAN
277 CAML AB,C%M20 ; [-3,,]
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
296 MOVEI A,33 ; CHANGE IT TO AN ALT, SNEAKY HUH?
297 CAIN B,MANYT ; TYPE OF MULTIPLE CLOSE, I.E. ! ALT
299 PUSHJ P,IREAD1 ;GO DO THE READING
301 JRST LPSRET ;PROPER EXIT
302 NOPRS: ERRUUO EQUOTE CAN'T-PARSE
304 MFUNCTION LPARSE,SUBR
308 PUSHJ P,GAPRS ;GET THE ARGS TO THE PARSE
316 PUSH TP,C%0 ; LETTER SAVE
318 PUSH TP,C%0 ; PARSE TABLE MAYBE?
320 PUSH TP,C%0 ;SEGMENT FOR SPLICING MACROS
321 PUSH TP,C%0 ;SLOT FOR LOCATIVE TO STRING
325 PUSH TP,IMQUOTE PARSE-STRING
327 PUSH TP,1(AB) ; BIND OLD PARSE-STRING
346 PUSH TP,IMQUOTE OBLIST
348 PUSH TP,1(AB) ; HE WANTS HIS OWN OBLIST
358 PUSH TP,IMQUOTE PARSE-TABLE
370 MOVEM 0,5(TB) ; STUFF IN A LOOK-AHEAD CHARACTER IF HE WANTS
373 USPSTR: MOVE B,IMQUOTE PARSE-STRING
374 PUSHJ P,ILOC ; GET A LOCATIVE TO THE STRING, WHEREVER
376 CAIN 0,TUNBOUND ; NONEXISTANT
378 GETYP 0,(B) ; IT IS POINTING TO A STRING
385 LPRS1: PUSHJ P,GPT ; GET THE VALUE OF PARSE-TABLE IN SLOT
387 PUSH TP,C%0 ; HERE WE ARE MAKE PLACE TO SAVE GOODIES
390 LPRS2: PUSHJ P,IREAD1
391 JRST LPRSDN ; IF WE ARE DONE, WE ARE THROUGH
396 MOVEM B,-2(TP) ; SAVE THE BEGINNING ON FIRST
398 HRRM B,(C) ; PUTREST INTO IT
401 LPRSDN: MOVSI A,TLIST
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
407 JRST FINIS ; IF ATE WHOLE STRING, DONT GIVE BACK ANY
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
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
419 \f; ARGUMENTS ARE BOUND, NOW GET THE VALUES OF THINGS
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
437 MOVE B,IMQUOTE INCHAN
439 PUSHJ P,IDVAL ;NOW GOBBLE THE REAL CHANNEL
441 HLLZS A ; INCASE OF FUNNY BUG
442 CAME A,$TCHAN ;IS IT A CHANNEL
444 MOVEM A,4(TB) ; STORE CHANNEL
452 TRNE A,C.BIN ; SKIP IF NOT BIN
453 JRST BREAD ; CHECK FOR BUFFER
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
460 MOVEM B,5(TB) ;SAVE CHANNEL
461 REREAD: HRRZ D,LSTCH(B) ;ANY CHARS AROUND?
463 CAIN D,400033 ;FLUSH THE TERMINATOR HACK
464 HRRM 0,LSTCH(B) ; MAKE ! ALT INTO JUST ALT IF IT IS STILL AROUND
466 PUSHJ P,@(P) ;CALL INTERNAL READER
468 RFINIS: SUB P,C%11 ;POP OFF LOSER
471 JUMPE C,FLSCOM ; FLUSH TOP LEVEL COMMENT
475 MOVE B,5(TB) ; GET CHANNEL
477 MOVE D,IMQUOTE COMMENT
486 MOVE D,IMQUOTE COMMENT
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
498 MCALL 1,EVAL ;AND EVAL IT
500 GETYP 0,A ; CHECK FOR FUNNY ACT
502 JRST RFINIS ; AND RETURN
504 PUSHJ P,CHUNW ; UNWIND TO POINT
505 MOVSI A,TREADA ; SEND MESSAGE BACK
508 ;HERE TO ATTEMPT TO OPEN A CLOSED CHANNEL
510 OPNFIL: PUSHJ P,OPNCHN ;GO DO THE OPEN
511 JUMPGE B,FNFFL ;LOSE IC B IS 0
515 CHLSTC: MOVE B,5(TB) ;GET CHANNEL BACK
519 BREAD: MOVE B,5(TB) ; GET CHANNEL
522 MOVEI A,BUFLNT ; GET A BUFFER
524 MOVEI C,BUFLNT(B) ; POINT TO END
526 MOVE B,5(TB) ; CHANNEL BACK
530 MOVSI C,TCHSTR+.VECT.
533 \f;MAIN ENTRY TO READER
535 NIREAD: PUSHJ P,LSTCHR
536 NIREA1: PUSH P,C%M1 ; [-1] ; DONT GOBBLE COMMENTS
540 PUSHJ P,LSTCHR ;DON'T REREAD LAST CHARACTER
541 IREAD1: PUSH P,C%0 ; FLAG SAYING SNARF COMMENTS
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
548 JUMPN B,@DTBL-1(B) ;ERROR ON ZERO TYPE OR FUNNY TYPE
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
556 MOVE C,1(C) ;IF SO, DO DEFEREMENT
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
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]
589 SPACE: PUSHJ P,LSTCHR ;DONT REREAD SPACER
592 USRDS1: SKIPA B,A ; GET CHAR IN B
593 USRDS2: MOVEI B,200(A) ; ! CHAR, DISP 200 FURTHER
595 ADD B,7(TB) ; POINT TO TABLE ENTRY
598 MOVE B,1(B) ; IF LIST, USE FIRST ITEM-SPECIAL NO BREAK HACK
599 SKIPL C,5(TB) ; GET CHANNEL POINTER (IF ANY)
601 ADD C,[EOFCND-1,,EOFCND-1]
604 HRRM SP,(TP) ; BUILD A TBVL
611 MOVEI D,PVLNT*2+1(PVP)
617 USRDS3: PUSH TP,(B) ; APPLIER
619 PUSH TP,$TCHRS ; APPLY TO CHARACTER
621 PUSHJ P,LSTCHR ; FLUSH CHAR
622 MCALL 2,APPLY ; GO TO USER GOODIE
626 HRRZ E,1(SP) ; POINT TO EOFCND SLOT
627 HRRZ SP,(SP) ; UNBIND MANUALLY
636 SUB TP,C%22 ; FLUSH TP CRAP
637 USRDS9: GETYP 0,A ; CHECK FOR DISMISS?
639 JRST GOTSPL ; RETURN OF SEGMENT INDICATES SPLICAGE
640 CAIN 0,TREADA ; FUNNY?
643 JRST RET ; NO, RETURN FROM IREAD
644 JRST BDLP ; YES, IGNORE RETURN
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?
650 ;HERE ON NUMBER OR LETTER, START ATOM
652 ESCSTR: PUSHJ P,NXTC1 ; ESCAPE FIRST
653 LETTER: MOVEI FF,NOTNUM ; LETTER
656 ASTSTR: MOVEI FF,OCTSTR
660 NUMBER: MOVEI FF,NUMWIN ; SYMBOL OR NUMBER
661 NUMBR1: MOVEI B,(A) ; TO A NUMBER
668 NNUMBE: MOVEI FF,NEGF
671 NUMBLD: PUSH TP,$TFIX
678 ATMBLD: LSH A,<36.-7>
680 MOVEI D,1 ; D IS CHAR COUNT
681 MOVSI C,350700+P ; BYTE PNTR
687 PUSHJ P,NXTCH ; GET NEXT CHAR
689 TRNN FF,NOTNUM ; IF NOT NUMBER, SKIP
692 ATLP2: CAILE B,NONSPC ; SKIP IF STILL LETTER OR NUMBER
695 ATLP1: PUSHJ P,LSTCHR ; DONT REUSE
697 TLNE C,760000 ; SKIP IF OK WORD
704 CHKEND: CAIN B,ESCTYP ; ESCAPE?
707 CHKEN1: SKIPGE C ; SKIP IF TOP SLOT FULL
709 PUSH P,D ; COUNT OF CHARS
711 JRST LOOPA ; GO HACK TRAILERS
714 ; HERE IF STILL COULD BE A NUMBER
716 NUMCHK: CAIN B,NUMCOD ; STILL NUMBER
719 CAILE B,NONSPC ; NUMBER FINISHED?
726 JRST NUMCH3 ; NO . IN OCTAL OR EXPONENT
727 TRO FF,DECFRC ; MUST BE DECIMAL NOW
730 NUMCH1: TRO FF,NUMWIN
733 TRNE FF,OCTSTR+OCTWIN ; IS THIS *DDDDDD* HACK
734 JRST NUMCH4 ; YES, GO DO IT
736 JRST NUMCH7 ; DO EXPONENT
738 TRNE FF,DOTSEN ; FORCE FLOAT
741 JFCL 17,.+1 ; KILL ALL FLAGS
742 MOVE E,CNUM(TP) ; COMPUTE CURRENT RADIX
744 ADDI E,(B) ; ADD IN CURRENT DIGIT
749 MOVE E,3(TB) ; SEE IF CURRENT RADIX DECIMAL
751 JRST NUMCH5 ; YES, FORCE FLOAT
754 NUMCH5: TRO FF,FLONUM ; SET FLOATING FLAG
755 NUMCH6: JFCL 17,.+1 ; CLEAR ALL FLAGS
756 MOVE E,DNUM(TP) ; GET DECIMAL NUMBER
758 JFCL 10,NUMCH8 ; JUMP IF OVERFLOW
759 ADDI E,(B) ; ADD IN DIGIT
761 TRNE FF,FLONUM ; IS THIS FRACTION?
762 SOS NDIGS(TP) ; YES, DECREASE EXPONENT BY ONE
765 NUMCH8: TRNE FF,DOTSEN ; OVERFLOW IN DECMIMAL
766 JRST ATLP1 ; OK, IN FRACTION
769 TRO FF,FLONUM ; MAKE IT FLOATING TO FIT
772 NUMCH4: TRNE FF,OCTWIN
773 JRST NUMCH3 ; ALREADY ONE, MORE DIGITS LOSE
775 TLNE E,700000 ; SKIP IF WORD NOT FULL
778 ADDI E,(B) ; ADD IN NEW ONE
782 NUMCH3: SUB TP,[NUMTMP,,NUMTMP] ; FLUSH NUMBER CRUFT
786 NUMCH2: CAIN B,ASTCOD ; POSSIBLE END OF OCTAL
787 TRZN FF,OCTSTR ; RESET FLAG AND WIN
795 JRST NUMC10 ; STILL COULD BE +- EXPONENT
797 TRZ FF,NUMWIN ; IN CASE NO MORE DIGITS
801 NUMCH7: MOVE E,ENUM(TP)
804 MOVEM E,ENUM(TP) ; UPDATE ECPONENT
805 TRO FF,EPOS ; FLUSH IF SIGN COMES NOW
808 NUMC10: TRNE FF,ENEG+EPOS ; SIGN FOR EXPONENT SEEN?
809 JRST NUMCH3 ; NOT A NUMBER
818 ; HERE AFTER \ QUOTER
820 DOESC1: PUSHJ P,NXTC1 ; GET CHAR
821 JRST ATLP1 ; FALL BACK INTO LOOP
824 ; HERE TO CONVERT NUMBERS AS NEEDED
826 NUMCNV: CAIE B,ESCTYP
833 SKIPGE C ; SKIP IF NEW WORD ADDED
835 HRLI D,(D) ; TOO BOTH HALVES
836 SUB P,D ; REMOVE CHAR STRING
837 MOVE D,3(TB) ; IS RADIX 10?
840 TRNN FF,FLONUM+EFLG ;IS IT A FLOATING POINT NUMBER
842 JRST FLOATIT ;YES, GO MAKE IT WIN
847 MOVE B,DNUM(TP) ;GRAB FIXED GOODIE
848 TRNE FF,OCTWIN ; SKIP IF NOT OCTAL
849 MOVE B,ONUM(TP) ; USE OCTAL VALUE
850 FINID2: MOVSI A,TFIX ;SAY FIXED POINT
851 FINID1: TRNE FF,NEGF ;NEGATE
853 SUB TP,[NUMTMP,,NUMTMP] ;FINISH HACK
858 JFCL 17,.+1 ;CLEAR ALL ARITHMETIC FLAGS
859 TRNE FF,EFLG ;"E" SEEN?
860 JRST EXPDO ;YES, DO EXPONENT
861 MOVE D,NDIGS(TP) ;GET IMPLICIT EXPONENT
863 FLOATE: MOVE A,DNUM(TP) ;GET DECIMAL NUMBER
864 IDIVI A,400000 ;SPLIT
865 FSC A,254 ;CONVERT MOST SIGNIFICANT
866 FSC B,233 ; AND LEAST SIGNIFICANT
869 MOVM A,D ;GET MAGNITUDE OF EXPONENT
871 JFCL 17,.+1 ; CLEAR ALL OVERFLOW/UNDERFLOW BITS
873 JRST .+3 ;TOO BIG-FLOATING OUT OF RANGE
876 JUMPGE D,FLOAT1 ;JUMP IF EXPONENT POSITIVE
878 FDVR B,TENTAB(A) ;DIVIDE BY TEN TO THE EXPONENT
882 FMPR B,TENTAB(A) ;SCALE UP
884 SETFLO: JFCL 17,FOOR ;FLOATING OUT OF RANGE ON OVERFLOW
886 TRZ FF,FRSDOT ;FLOATING NUMBER NOT VALUE
890 HRRZ D,ENUM(TP) ;GET EXPONENT
891 TRNE FF,ENEG ;IS EXPONENT NEGATIVE?
893 ADD D,NDIGS(TP) ;ADD IMPLICIT EXPONENT
894 JUMPL D,FLOATE ;FLOATING IF EXPONENT NEGATIVE
895 CAIG D,10. ;OR IF EXPONENT TOO LARGE
896 TRNE FF,FLONUM ;OR IF FLAG SET
900 JFCL 10,FLOATE ;IF OVERFLOW, MAKE FLOATING
901 JRST FINID2 ;GO MAKE FIXED NUMBER
904 ; HERE TO START BUILDING A CHARACTER STRING GOODIE
908 MOVEI D,0 ; CHARCOUNT
909 MOVSI C,440700+P ; AND BYTE POINTER
913 PUSHJ P,NXTC1 ; GET NEXT CHAR
916 CAIN B,CSTYP ; END OF STRING?
919 CAIN B,ESCTYP ; ESCAPE?
923 TLNE C,760000 ; SKIP IF OK WORD
939 ;ARRIVE HERE TO INVOKE A READ TIME MACRO FUNCTION
941 MACCAL: PUSHJ P,NXTCH1 ;READ ONE MORE CHARACTER
942 CAIE B,MACTYP ;IS IT ANOTHER MACRO CHAR
944 JRST MACAL2 ;NO, CALL MACRO AND USE VALUE
945 PUSHJ P,LSTCHR ;DONT REREAD %
946 PUSHJ P,MACAL1 ;OTHERWISE, USE SIDE EFFECCT, BUT NOT VALUE
950 MACAL1: PUSHJ P,IREAD1 ;READ FUNCTION NAME
953 PUSH TP,D ; SAVE COMMENT IF ANY
954 PUSH TP,A ;SAVE THE RESULT
955 PUSH TP,B ;AND USE IT AS AN ARGUMENT
958 POP TP,C ; RESTORE COMMENT IF ANY...
961 ;CALL GOBBLE TO FIND THE TYPE AND THEN IREAD TO READ IT
963 SPECTY: PUSHJ P,NIREAD ; READ THE TYPES NAME (SHOULD BE AN ATOM)
970 PUSHJ P,NXTCH ; GET NEXT CHAR
971 CAIN B,TMPTYP ; SKIP IF NOT TEMPLATE START
976 PUSH TP,A ;BEGIN SETTING UP CHTYPE CALL
978 PUSHJ P,IREAD1 ;NOW READ STRUCTURE
980 MOVEM C,-3(TP) ; SAVE COMMENT
982 EXCH A,-1(TP) ;USE AS FIRST ARG
984 PUSH TP,A ;USE OTHER AS 2D ARG
986 MCALL 2,CHTYPE ;ATTEMPT TO MUNG
988 POP TP,C ; RESTORE COMMENT
989 RET12: SETOM (P) ; DONT LOOOK FOR MORE!
992 RDTMPL: PUSH P,["}] ; SET UP TERMINATE TEST
997 PUSH P,[BLDTMP] ; FLAG FOR VECTOR READING CODE
1000 BLDTMP: ADDI A,1 ; 1 MORE ARGUMENT
1001 ACALL A,APPLY ; DO IT TO IT
1004 BYTIN: PUSHJ P,NXTCH ; CHECK FOR OPENR
1011 ERRUUO EQUOTE BAD-USE-OF-BYTE-STRING
1016 CBYTE1: AOJA A,CBYTES
1018 RETERR: SKIPL A,5(TB)
1019 MOVEI A,5(TB)-LSTCH ;NO CHANNEL, USE SLOT
1020 HRRM B,LSTCH(A) ; RESTORE LAST CHAR
1027 ;THIS CODE CALLS IREAD RECURSIVELY TO READ THAT WHICH IS
1028 ;BETWEEN (), ARRIVED AT WHEN ( IS READ
1030 SEGIN: PUSH TP,$TSEG
1033 OPNANG: PUSH TP,$TFORM ;SAVE TYPE
1038 PUSH TP,$TLIST ;START BY ASSUMING NIL
1040 PUSHJ P,LSTCHR ;DON'T REREAD PARENS
1041 LLPLOP: PUSHJ P,IREAD1 ;READ IT
1042 JRST LDONE ;HIT TERMINATOR
1044 ;HERE WHEN MUST ADD CAR TO CURRENT WINNER
1046 GENCAR: PUSH TP,C ; SAVE COMMENT
1048 MOVE C,A ; SET UP CALL
1050 PUSHJ P,INCONS ; CONS ON TO NIL
1054 JUMPN E,CDRIN ;IF STACKED GOODIE NOT NIL SKIP
1055 PUSH TP,B ;AND USE AS TOTAL VALUE
1056 PUSH TP,$TLIST ;SAVE THIS AS FIRSST THING ON LIST
1057 MOVE A,-2(TP) ; GET REAL TYPE
1058 JRST .+2 ;SKIP CDR SETTING
1060 PUSH TP,B ;CLOBBER IN NEW PARTIAL GOODIE
1061 JUMPE C,LLPLOP ; JUMP IF NO COMMENT
1065 MOVE D,IMQUOTE COMMENT
1067 JRST LLPLOP ;AND CONTINUE
1069 ; HERE TO RAP UP LIST
1071 LDONE: CAME B,(P) ;CHECK VALIDITY OF CHARACTER
1072 PUSHJ P,MISMAT ;REPORT MISMATCH
1074 POP TP,B ;GET VALUE OF PARTIAL RESULT
1075 POP TP,A ;AND TYPE OF SAME
1076 JUMPE B,RET ;VALUE IS NIL, DON'T POP AGAIN
1077 POP TP,B ;POP FIRST LIST ELEMENT
1081 ;THIS CODE IS SIMILAR TO LIST GENERATING CODE BUT IS FOR VECTORS
1082 OPNBRA: PUSH P,["}] ; SAVE TERMINATOR
1083 UVECIN: PUSH P,[135] ; CLOSE SQUARE BRACKET
1084 PUSH P,[SETZ IEUVECTOR] ;PUSH NAME OF U VECT HACKER
1087 LBRACK: PUSH P,[135] ; SAVE TERMINATE
1088 PUSH P,[SETZ IEVECTOR] ;PUSH GEN VECTOR HACKER
1089 LBRAK2: PUSHJ P,LSTCHR ;FORCE READING NEW CHAR
1090 PUSH P,C%0 ; COUNT ELEMENTS
1091 PUSH TP,$TLIST ; AND SLOT FOR GOODIES
1094 LBRAK1: PUSHJ P,IREAD1 ;RECURSIVELY READ ELEMENTS OF ARRAY
1095 JRST LBDONE ;RAP UP ON TERMINATOR
1097 STAKIT: EXCH A,-1(TP) ; STORE RESULT AND GET CURRENT LIST
1099 AOS (P) ; COUNT ELEMENTS
1100 JUMPE C,LBRAK3 ; IF NO COMMENT, GO ON
1101 MOVEI E,(B) ; GET CDR
1102 PUSHJ P,ICONS ; CONS IT ON
1103 MOVEI E,(B) ; SAVE RS
1104 MOVSI C,TFIX ; AND GET FIXED NUM
1107 LBRAK3: PUSH TP,A ; SAVE CURRENT COMMENT LIST
1111 ; HERE TO RAP UP VECTOR
1113 LBDONE: CAME B,-2(P) ; FINISHED RETURN (WAS THE RIGHT STOP USED?)
1114 PUSHJ P,MISMAB ; WARN USER
1115 POP TP,1(TB) ; REMOVE COMMENT LIST
1117 MOVE A,(P) ; COUNT TO A
1118 PUSHJ P,-1@(P) ; MAKE THE VECTOR
1121 ; PUT COMMENTS ON VECTOR (OR UVECTOR)
1123 MOVNI C,1 ; INDICATE TEMPLATE HACK
1126 CAMN A,$TUVEC ; SKIP IF UVECTOR
1129 PUSH TP,A ; SAVE VECTOR/UVECTOR
1132 VECCOM: SKIPN C,1(TB) ; ANY LEFT?
1133 JRST RETVEC ; NO, LEAVE
1134 MOVE A,1(C) ; ASSUME WINNING TYPES
1136 HRRZ C,(C) ; CDR THE LIST
1138 MOVEM E,1(TB) ; SAVE CDR
1139 GETYP E,(C) ; CHECK DEFFERED
1141 CAIN E,TDEFER ; SKIP IF NOT DEFERRED
1144 GETYPF D,(C) ; GET REAL TYPE
1145 MOVE B,(TP) ; GET VECTOR POINTER
1146 SKIPGE (P) ; SKIP IF NOT TEMPLATE
1148 HRLI A,(A) ; COUNTER
1149 LSH A,@(P) ; MAYBE SHIFT IT
1151 MOVE A,-1(TP) ; TYPE
1153 PUSH TP,1(C) ; PUSH THE COMMENT
1155 MOVE D,IMQUOTE COMMENT
1169 ; BUILD A SINGLE CHARACTER ITEM
1171 SINCHR: PUSHJ P,NXTC1 ;FORCE READ NEXT
1172 CAIN B,ESCTYP ;ESCAPE?
1173 PUSHJ P,NXTC1 ;RETRY
1179 ; HERE ON RIGHT PAREN, BRACKET, ANGLE BRACKET OR CTL C
1182 CLSANG: ;CLOSE ANGLE BRACKETS
1183 RBRACK: ;COMMON RETURN FOR END OF ARRAY ALSO
1184 RPAREN: PUSHJ P,LSTCHR ;DON'T REREAD
1185 EOFCH1: MOVE B,A ;GETCHAR IN B
1186 MOVSI A,TCHRS ;AND TYPE IN A
1191 JUMPL A,EOFCH1 ; JUMP ON REAL EOF
1192 JRST RRSUBR ; MAYBE A BINARY RSUBR
1194 DOEOF: MOVE A,[-1,,3]
1199 ; NORMAL RETURN FROM IREAD/IREAD1
1201 RETCL: PUSHJ P,LSTCHR ;DONT REREAD
1202 RET: AOS -1(P) ;SKIP
1204 RETC: JUMPL E,RET2 ; DONT LOOK FOR COMMENTS
1205 PUSH TP,A ; SAVE ITEM
1207 CHCOMN: PUSHJ P,NXTCH ; READ A CHARACTER
1208 CAIE B,COMTYP ; SKIP IF COMMENT
1210 PUSHJ P,IREAD ; READ THE COMMENT
1220 CHSPA: CAIN B,SPATYP
1221 PUSHJ P,SPACEQ ; IS IT A REAL SPACE
1223 PUSHJ P,LSTCHR ; FLUSH THE SPACE
1226 ;RANDOM MINI-SUBROUTINES USED BY THE READER
1228 ;READ A CHAR INTO A AND TYPE CODE INTO D
1230 NXTC3: SKIPL B,5(TB) ;GET CHANNEL
1231 JRST NXTPR4 ;NO CHANNEL, GO READ STRING
1233 PUSHJ P,CNTACC ; COUNT ON ACCESS POINTER
1238 NXTC1: SKIPL B,5(TB) ;GET CHANNEL
1239 JRST NXTPR1 ;NO CHANNEL, GO READ STRING
1241 PUSHJ P,CNTACC ; COUNT ON ACCESS POINTER
1243 NXTC: SKIPL B,5(TB) ;GET CHANNEL
1244 JRST NXTPRS ;NO CHANNEL, GO READ STRING
1245 SKIPE A,LSTCH(B) ;CHAR IN A IF REUSE
1247 NXTC2: PUSHJ P,RXCT ;GET CHAR FROM INPUT
1248 TLO A,200000 ; BIT TO AVOID ^@ LOSSAGE
1249 HLLZS 2(TB) ;FLAG INDICATING ONE CHAR LOOK AHEAD
1250 MOVEM A,LSTCH(B) ;SAVE THE CHARACTER
1251 PRSRET: TLZ A,200000
1252 TRZE A,400000 ;DONT SKIP IF SPECIAL
1253 TRO A,200 ;GO HACK SPECIALLY
1254 GETCTP: PUSH P,A ;AND SAVE FROM DIVISION
1256 IDIVI A,CHRWD ;YIELDS WORD AND CHAR NUMBER
1257 LDB B,BYTPNT(B) ;GOBBLE TYPE CODE
1259 ANDI A,177 ; RETURN REAL ASCII
1262 NXTPR4: MOVEI F,400000
1265 NXTPRS: SKIPE A,5(TB) ;GET OLD CHARACTER IF ONE EXISTS
1268 NXTPR5: MOVE A,11.(TB)
1269 HRRZ B,(A) ;GET THE STRING
1272 ILDB A,1(A) ;GET THE CHARACTER FROM THE STRING
1274 NXTPR2: MOVEM A,5(TB) ;SAVE IT
1275 JRST PRSRET ;CONTINUE
1277 NXTPR3: SETZM 8.(TB)
1278 SETZM 9.(TB) ;CLEAR OUT LOCATIVE, AT END OF STRING
1282 ; NXTCH AND NXTCH1 ARE SAME AS NXTC AND NXTC1 EXCEPT THEY CHECK !
1285 NXTCH1: PUSHJ P,NXTC1 ;READ CHAR
1287 NXTCH: PUSHJ P,NXTC ;READ CHAR
1288 PUSHJ P,CHKUS1 ; CHECK FOR USER DISPATCH
1290 CAIE B,NTYPES+1 ; SKIP IF ! ING NEXT CHAR
1292 PUSHJ P,NXTC3 ;READ NEXT ONE
1293 HLLOS 2(TB) ;FLAG FOR TWO CHAR LOOK AHEAD
1295 CRMLST: IORI A,400000 ;CLOBBER LASTCHR
1297 SKIPL B,5(TB) ;POINT TO CHANNEL
1298 MOVEI B,5(TB)-LSTCH ;NO CHANNEL, POINT AT SLOT
1300 ANDI A,377777 ;DECREASE CHAR
1303 CHKUS2: SKIPN 7(TB) ; SKIP IF USER TABLE
1306 ASH F,1 ; POINT TO SLOT
1309 JUMPGE F,CPOPJ ;IS THERE VECTOR ENOUGH?
1310 SKIPN 1(F) ; NON-ZERO==>USER FCN EXISTS
1311 JRST CPOPJ ; HOPE HE APPRECIATES THIS
1313 CHKRDO: PUSH P,0 ; CHECK FOR REDOING IF CHAR IN TABLE
1317 POP P,0 ;WE ARE TRANSMOGRIFYING
1318 MOVE A,1(F) ;GET NEW CHARACTER
1320 PUSH P,2(TB) ; FLAGS FOR NUM OF CHRS IN LOOK AHEAD
1321 PUSH P,5(TB) ; TO AVOID SMASHING LSTCHR
1322 SETZM 5(TB) ; CLEAR OUT CHANNEL
1323 SETZM 7(TB) ;CLEAR OUT TABLE
1325 TRO A,400000 ; TURN ON PROPER BIT
1327 POP P,5(TB) ; GET BACK CHANNEL
1329 POP P,7(TB) ;GET BACK OLD PARSE TABLE
1334 JRST .+4 ; SPECIAL NON-BREAK TYPE HACK
1335 MOVNS (P) ; INDICATE BY NEGATIVE
1336 MOVE A,1(F) ; GET <1 LIST>
1337 GETYP 0,(A) ; AND GET THE TYPE OF THAT
1338 CAIE 0,TFIX ; SEE IF HE WANTS SAME CHAR WITH DIFF TYPE
1339 JRST CHKUS6 ; JUST A VANILLA HACK
1340 MOVE A,1(F) ; PRETEND IT IS SAME TYPE AS NEW CHAR
1341 PUSH P,7(TB) ; CLEAR OUT TRANSLATE TABLE
1342 PUSH P,2(TB) ; FLAGS FOR # OF CHRS IN LOOK AHEAD
1345 TRO A,400000 ; TURN ON PROPER BIT IF ! HACK
1346 PUSHJ P,PRSRET ; REGET TYPE
1348 POP P,7(TB) ; PUT TRANSLATE TABLE BACK
1349 CHKUS6: SKIPGE -1(P) ; SEE IF A SPECIAL NON-BREAK
1350 MOVNS B ; SEXY, HUH?
1353 MOVMS A ; FIX UP A POSITIVE CHARACTER
1359 CHKUS1: SKIPN 7(TB) ; USER CHECK FOR NOT ! CASE
1369 JRST CHKRDO ; TRANSMOGRIFY CHARACTER?
1374 UPLO: POPJ P, ; LETS NOT AND SAY WE USED TO
1375 ; AVOID STRANGE ! BLECHAGE
1377 PUSH P,A ; HACK TO NOT TRANSLATE CHAR
1378 PUSHJ P,CHKUS1 ; BUT DO TRANSLATION OF TYPE IF HE WANTS
1379 POP P,A ; USED TO BUILD UP STRINGS
1382 CHKALT: CAIN A,33 ;ALT?
1387 TERM: MOVEI B,0 ;RETURN A 0
1391 CHKMIN: CAIN A,"- ; IF CHAR IS -, WINNER
1395 LOSPAT: PUSHJ P,LSTCHR ; FIX RECURSIVE LOSAGE
1396 ERRUUO EQUOTE UNATTACHED-PATH-NAME-SEPARATOR
1399 ; HERE TO SEE IF READING RSUBR
1401 RRSUBR: PUSHJ P,LSTCHR ; FLUSH JUST READ CHAR
1402 SKIPL B,5(TB) ; SKIP IF A CHANNEL EXISTS
1403 JRST SPACE ; ELSE LIKE A SPACE
1404 HRRZ C,BUFSTR(B) ; SEE IF FLAG SAYS START OF RSUBR
1406 TRNN C,1 ; SKIP IF REAL RSUBR
1407 JRST EOFCH2 ; NO, IGNORE FOR NOW
1409 ; REALLY ARE READING AN RSUBR
1411 HRRZ 0,4(TB) ; GET READ/READB INDICATOR
1412 MOVE C,ACCESS(B) ; GET CURRENT ACCESS
1413 JUMPN 0,.+3 ; ALREADY WORDS, NO NEED TO DIVIDE
1416 PUSH P,C ; SAVE WORD ACCESS
1417 MOVEI A,(C) ; COPY IT FOR CALL
1420 MOVEM C,ACCESS(B) ; FIXUP ACCESS
1421 HLLZS ACCESS-1(B) ; FOR READB LOSER
1422 PUSHJ P,DOACCS ; AND GO THERE
1423 PUSH P,C%0 ; FOR READ IN
1424 HRROI A,(P) ; PREPARE TO READ LENGTH
1425 PUSHJ P,DOIOTI ; READ IT
1426 POP P,C ; GET READ GOODIE
1427 JUMPGE A,.+4 ; JUMP IF WON
1431 MOVEI A,(C) ; COPY FOR GETTING BLOCK
1432 ADDI C,1 ; COUNT COUNT WORD
1434 PUSH TP,$TUVEC ; WILL HOLD UVECTOR OF FIXUPS IF THEY STAY
1436 PUSHJ P,IBLOCK ; GET A BLOCK
1438 PUSH TP,B ; AND SAVE
1439 MOVE A,B ; READY TO IOT IT IN
1440 MOVE B,5(TB) ; GET CHANNEL BACK
1441 MOVSI 0,TUVEC ; SETUP A'S TYPE
1444 PUSHJ P,DOIOTI ; IN COMES THE WHOLE BLOCK
1446 SETZM ASTO(PVP) ; A NO LONGER SPECIAL
1447 MOVEI C,BUFSTR-1(B) ; NO RESET BUFFER
1448 PUSHJ P,BYTDOP ; A POINTS TO DOPW WORD
1450 HRLI A,010700 ; SETUP BYTE POINTER TO END
1451 HLLZS BUFSTR-1(B) ; ZERO CHAR COUNNT
1453 HRRZ A,4(TB) ; READ/READB FLG
1454 MOVE C,(P) ; ACCESS IN WORDS
1455 SKIPN A ; SKIP FOR ASCII
1457 MOVEM C,ACCESS(B) ; UPDATE ACCESS
1458 PUSHJ P,NIREAD ; READ RSUBR VECTOR
1460 GETYP A,A ; VERIFY A LITTLE
1461 CAIE A,TVEC ; DONT SKIP IF BAD
1462 JRST BRSUBR ; NOT A GOOD FILE
1463 PUSHJ P,LSTCHR ; FLUSH REREAD CHAR
1464 MOVE C,(TP) ; CODE VECTOR BACK
1466 HLR A,B ; FUNNY COUNT
1467 MOVEM A,(B) ; CLOBBER
1469 PUSH TP,$TRSUBR ; MAKE RSUBR
1472 ; NOW LOOK OVER FIXUPS
1474 MOVE B,5(TB) ; GET CHANNEL
1476 HLLZS ACCESS-1(B) ; FOR READB LOSER
1477 HRRZ 0,4(TB) ; READ/READB FLG
1480 IDIVI C,5 ; TO WORDS
1481 MOVEI D,(C) ; FIXUP ACCESS
1483 MOVEM D,ACCESS(B) ; AND STORE
1484 RSUB1: ADDI C,1 ; ACCOUNT FOR EXTRA COUNTERS
1485 MOVEM C,(P) ; SAVE FOR LATER
1486 MOVEI A,-1(C) ; FOR DOACS
1487 MOVEI C,2 ; UPDATE REAL ACCESS
1488 SKIPN 0 ; SKIP FOR READB CASE
1491 PUSHJ P,DOACCS ; DO THE ACCESS
1492 PUSH TP,$TUVEC ; SLOT FOR FIXUP BUFFER
1495 ; FOUND OUT IF FIXUPS STAY
1497 MOVE B,IMQUOTE KEEP-FIXUPS
1498 PUSHJ P,ILVAL ; GET VALUE
1500 MOVE B,5(TB) ; CHANNEL BACK TO B
1503 JRST RSUB4 ; NO, NOT KEEPING FIXUPS
1504 PUSH P,C%0 ; SLOT TO READ INTO
1505 HRROI A,(P) ; GET LENGTH OF SAME
1508 MOVEI A,(C) ; GET UVECTOR FOR KEEPING
1509 ADDM C,(P) ; ACCESS TO END
1510 PUSH P,C ; SAVE LENGTH OF FIXUPS
1512 MOVEM B,-6(TP) ; AND SAVE
1513 MOVE A,B ; FOR IOTING THEM IN
1514 ADD B,C%11 ; POINT PAST VERS #
1519 MOVE B,5(TB) ; AND CHANNEL
1520 PUSHJ P,DOIOTI ; GET THEM
1523 MOVE A,(TP) ; GET VERS
1524 PUSH P,-1(A) ; AND PUSH IT
1528 PUSH P,C%0 ; 2 SLOTS FOR READING
1534 ADDM C,-2(P) ; NOW -2(P) IS ACCESS TO END OF FIXUPS
1535 RSUB5: MOVEI C,BUFSTR-1(B) ; FIXUP BUFFER
1537 SUBI A,2 ; POINT BEFORE D.W.
1543 SUBI A,BUFLNT-1 ; ALSO MAKE AN IOT FLAVOR BUFFER
1552 RSUB2A: PUSH P,-1(P) ; ANOTHER COPY OF LENGTH OF FIXUPS
1554 ; LOOP FIXING UP NEW TYPES
1556 RSUB2: PUSHJ P,WRDIN ; SEE WHAT NEXT THING IS
1557 JRST RSUB3 ; NO MORE, DONE
1558 JUMPL E,STSQ ; MUST BE FIRST SQUOZE
1559 MOVNI 0,(E) ; TO UPDATE AMNT OF FIXUPS
1561 HRLI E,(E) ; IS LENGTH OF STRING IN WORDS
1562 ADD E,(TP) ; FIXUP BUFFER POINTER
1564 SUB E,[BUFLNT,,BUFLNT]
1565 JUMPGE E,.-1 ; STILL NOT RIGHT
1566 EXCH E,(TP) ; FIX UP SLOT
1567 HLRE C,E ; FIX BYTE POINTER ALSO
1568 IMUL C,[-5] ; + CHARS LEFT
1569 MOVE B,5(TB) ; CHANNEL
1573 HRLI E,440700 ; AND BYTE POINTER
1575 PUSHJ P,NIREAD ; READ ATOM NAME OF TYPE
1576 TDZA 0,0 ; FLAG LOSSAGE
1578 MOVE C,5(TB) ; RESET BUFFER
1581 JUMPE 0,BRSUBR ; BAD READ OF RSUBR
1582 GETYP A,A ; A LITTLE CHECKING
1585 PUSHJ P,LSTCHR ; FLUSH REREAD CHAR
1586 HRRZ 0,4(TB) ; FIXUP ACCESS PNTR
1589 HLLZS ACCESS-1(C) ; FOR READB HACKER
1594 MOVEM D,ACCESS(C) ; RESET
1595 TYFIXE: PUSHJ P,TYPFND ; SEE IF A LEGAL TYPE NAME
1596 JRST TYPFIX ; GO SEE USER ABOUT THIS
1597 PUSHJ P,FIXCOD ; GO FIX UP THE CODE
1600 ; NOW FIX UP SUBRS ETC. IF NECESSARY
1602 STSQ: MOVE B,IMQUOTE MUDDLE
1603 PUSHJ P,IGVAL ; GET CURRENT VERS
1604 CAME B,-1(P) ; SKIP IF NO FIXUPS NEEDED
1605 JRST DOFIX0 ; MUST DO THEM
1607 ; ALL DONE, ACCESS PAST FIXUPS AND RETURN
1608 RSUB31: PUSHJ P,SQUKIL ; DONE FIXING UP, KILL SQUOZE TABLE IF IN INTERP
1611 MOVEI C,(A) ; UPDATE CHANNEL ACCESS IN CASE SKIPPING
1612 HRRZ 0,4(TB) ; READ/READB FLAG
1615 MOVEM C,ACCESS(B) ; INTO ACCESS SLOT
1617 PUSHJ P,DOACCS ; ACCESSED
1618 MOVEI C,BUFSTR-1(B) ; FIX UP BUFFER
1624 SKIPN A,-6(TP) ; SKIP IF KEEPING FIXUPS
1631 MOVE D,IMQUOTE RSUBR
1632 PUSHJ P,IPUT ; DO THE ASSOCIATION
1634 RSUB6: MOVE C,-4(TP) ; DO SPECIAL FIXUPS
1636 MOVE B,-2(TP) ; GET RSUBR
1638 SUB P,C%44 ; FLUSH P CRUFT
1644 DOFIX0: SKIPN C,-6(TP) ; GET BUFFER IF KEEPING
1646 MOVEM B,(C) ; CLOBBER
1649 FIXUPL: PUSHJ P,WRDIN
1651 DOFIXE: JUMPGE E,BRSUBR
1652 TLZ E,740000 ; KILL BITS
1654 CAME E,[SQUOZE 0,DSTO]
1656 MOVE E,[SQUOZE 40,DSTORE]
1666 PUSHJ P,SQUTOA ; LOOK IT UP
1668 MOVEI D,(E) ; FOR FIXCOD
1669 PUSHJ P,FIXCOD ; FIX 'EM UP
1672 ; BAD SQUOZE, BE MORE SPECIFIC
1674 BRSUB1: PUSHJ P,SQSTR
1676 PUSH TP,EQUOTE SQUZE-SYMBOL-NOT-FOUND-ERRET CORRECTION
1684 ERRUUO EQUOTE VALUE-MUST-BE-FIX
1688 ; CONVERT SQUOZE TO A MUDDLE STRING FOR USER
1721 ;0 1-12 13-44 45 46 47
1724 ; ROUTINE TO FIXUP ACTUAL CODE
1726 FIXCOD: MOVEI E,0 ; FOR HWRDIN
1727 PUSH P,D ; NEW VALUE
1728 PUSHJ P,HWRDIN ; GET HW NEEDED
1729 MOVE D,(P) ; GET NEW VAL
1730 MOVE A,(TP) ; AND BUFFER POINTER
1731 SKIPE -6(TP) ; SAVING?
1732 HRLM D,-1(A) ; YES, CLOBBER
1733 SUB C,(P) ; DIFFERENCE
1736 FIXLP: PUSHJ P,HWRDIN ; GET AN OFFSET
1738 HRRES C ; MAKE NEG IF NEC
1740 ADD C,-4(TP) ; POINT INTO CODE
1742 LDB 0,[220400,,-1(C)] ; GET INDEX FIELD
1746 DPB 0,[220400,,-1(C)]
1748 NOTV: CAIE 0,6 ; IS IT PVP
1751 CAIE 0,12 ; OLD DSTO
1770 ; ROUTINE TO READ A WORD FROM BUFFER
1774 SOSG -3(P) ; COUNT IT DOWN
1776 AOS -2(P) ; SKIP RETURN
1777 MOVE B,5(TB) ; CHANNEL
1778 HRRZ A,4(TB) ; READ/READB SW
1783 MOVE A,(TP) ; BUFFER
1785 AOBJP A,WRDIN2 ; NEED NEW BUFFER
1791 WRDIN2: MOVE B,-3(P) ; IS THIS LAST WORD?
1792 SOJLE B,WRDIN1 ; YES, DONT RE-IOT
1793 SUB A,[BUFLNT,,BUFLNT]
1804 ; READ IN NEXT HALF WORD
1806 HWRDIN: JUMPN E,NOIOT ; USE EXISTING WORD
1807 PUSH P,-3(P) ; FAKE OUT WRDIN IF NEC.
1810 POP P,-4(P) ; RESET COUNTER
1818 TYPFIX: PUSH TP,$TATOM
1819 PUSH TP,EQUOTE BAD-TYPE-NAME
1823 PUSH TP,EQUOTE ERRET-TYPE-NAME-DESIRED
1827 BRSUBR: ERRUUO EQUOTE RSUBR-IN-BAD-FORMAT
1831 ;TABLE OF BYTE POINTERS FOR GETTING CHARS
1833 BYTPNT": 350700,,CHTBL(A)
1839 ;HERE ARE THE TABLES OF CHXRACTERS (NOTE EVERYTHING NOT SPECIFIED IS
1840 ;IN THE NUMBER LETTER CATAGORY)
1842 CHROFF==0 ; USED FOR ! HACKS
1843 SETCHR NUMCOD,[0123456789]
1855 SETCOD SPATYP,[0,15,12,11,14,40,33] ;ALL ARE TYPE 2 (SPACING - FF,TAB,SPACE,ALT-MODE)
1857 INCRCH LPATYP,[()[]'%"\#<>] ;GIVE THESE INCREASRNG CODES FROM 3
1859 SETCOD EOFTYP,[3] ;^C - EOF CHARACTER
1861 SETCOD SPATYP,[32] ;^Z - TENEX/TOPS-20 EOF (SET IN BOTH TO BE CONSISTENT)
1863 INCRCH COMTYP,[;,{}!] ;COMMENT AND GLOBAL VALUE AND SPECIAL
1865 CHROFF==200 ; CODED AS HAVING 200 ADDED
1867 INCRCH EXCEXC,[!.[]'"<>,-\]
1872 OUTTBL ;OUTPUT THE TABLE RIGHT HERE
1875 \f; THIS CODE FLUSHES WANDERING COMMENTS
1877 COMNT: PUSHJ P,IREAD
1881 COMNT2: SKIPL A,5(TB) ; RESTORE CHANNEL
1882 MOVEI A,5(TB)-LSTCH ;NO CHANNEL, POINT AT SLOT
1883 HRRM B,LSTCH(A) ; CLOBBER IN CHAR
1888 ;HERE TO SET UP FOR .FOO ..FOO OR.<ABC>
1890 DOTSTR: PUSHJ P,NXTCH1 ; GOBBLE A NEW CHARACTER
1891 MOVEI FF,FRSDOT+DOTSEN ; SET FLAG IN CASE
1892 CAIN B,NUMCOD ; SKIP IF NOT NUMERIC
1893 JRST DOTST1 ; NUMERIC, COULD BE FLONUM
1895 ; CODE TO HANDLE ALL IMPLICIT CALLS I.E. QUOTE, LVAL, GVAL
1897 MOVSI B,TFORM ; LVAL
1901 GLOSEG: SKIPA B,$TSEG ;SEG CALL TO GVAL
1902 GLOVAL: MOVSI B,TFORM ;FORM CALL TO SAME
1906 QUOSEG: SKIPA B,$TSEG ;SEG CALL TO QUOTE
1907 QUOTIT: MOVSI B,TFORM
1908 MOVE A,IMQUOTE QUOTE
1911 SEGDOT: MOVSI B,TSEG ;SEG CALL TO LVAL
1913 IMPCAL: PUSHJ P,LSTCHR ;FLUSH LAST CHAR EXCEPT
1914 IMPCA1: PUSH TP,$TATOM ;FOR .FOO FLAVOR
1915 PUSH TP,A ;PUSH ARGS
1917 PUSHJ P,IREAD1 ;READ
1918 JRST USENIL ; IF NO ARG, USE NIL
1921 MOVE C,A ; GET READ THING
1923 PUSHJ P,INCONS ; CONS TO NIL
1924 MOVEI E,(B) ; PREPARE TON CONS ON
1925 POPARE: POP TP,D ; GET ATOM BACK
1927 EXCH C,-1(TP) ; SAVE THAT COMMENT
1930 POP P,A ;GET FINAL TYPE
1931 JRST RET13 ;AND RETURN
1936 SKIPL A,5(TB) ; RESTOR LAST CHR
1937 MOVEI A,5(TB)-LSTCH ;NO CHANNEL, POINT AT SLOT
1942 ;HERE AFTER READING ATOM TO CALL VALUE
1944 .SET: PUSH P,$TFORM ;GET WINNING TYPE
1946 PUSHJ P,RETC ; CHECK FOR POSSIBLE COMMENT
1948 PUSH TP,IMQUOTE LVAL
1949 JRST IMPCA2 ;GO CONS LIST
1951 LOOPA: PUSH P,FF ; SAVE FLAGS IN CASE .ATOM
1952 LOOPAT: PUSHJ P,NXTCH ; CHECK FOR TRAILER
1953 CAIN B,PATHTY ; PATH BEGINNER
1954 JRST PATH0 ; YES, GO PROCESS
1955 CAIN B,SPATYP ; SPACER?
1956 PUSHJ P,SPACEQ ; CHECK FOR REAL SPACE
1958 PUSHJ P,LSTCHR ; FLUSH IT AND RETRY
1960 PATH0: PUSHJ P,NXTCH1 ; READ FORCED NEXT
1961 CAIE B,SPCTYP ; DO #FALSE () HACK
1964 CAIL B,SPATYP ; SPACER?
1965 JRST PATH3 ; YES, USE THE ROOT OBLIST
1966 PATH4: PUSHJ P,NIREA1 ; READ NEXT ITEM
1967 PUSHJ P,ERRPAR ; LOSER
1968 CAME A,$TATOM ; ONLY ALLOW ATOMS
1974 MOVE D,IMQUOTE OBLIST
1975 PUSHJ P,IGET ; GET THE OBLIST
1976 ; IF NOT OBLIST, MAKE ONE
1978 MCALL 1,MOBLIS ; MAKE ONE
1985 PATH3: MOVE B,ROOT+1 ; GET ROOT OBLIST
1987 PATH1: POP P,FF ; FLAGS
1990 PUSHJ P,RLOOKU ; AND LOOK IT UP
1994 PATH.: PUSHJ P,RLOOKU
1995 JRST .SET ; CONS AN LVAL FORM
2006 PATH2: MOVE B,IMQUOTE OBLIST
2010 BADPAT: ERRUUO EQUOTE NON-ATOMIC-OBLIST-NAME
2014 ; HERE TO READ ONE CHARACTER FOR USER.
2057 CRDEOF: .MCALL 1,FCLOSE
2064 MOVE B,(TP) ; CHANNEL
2065 HRRZ A,-2(B) ; GET BLESS BITS
2077 MOVEM A,LSTCH(B) ; SAVE CHAR
2078 CAMN A,C%M1 ; [-1] ; SPECIAL PSEUDO TTY HACK?
2079 JRST PSEUDO ; YES, RET AS FIX
2082 TRZN A,400000 ; UNDO ! HACK
2086 MOVEI A,"! ; RETURN AN !
2087 NOEXC1: SKIPGE B,A ; CHECK EOF
2088 SOS (P) ; DO EOF RETURN
2089 MOVE B,A ; CHAR TO B
2101 NOEXCL: JUMPE E,NOEXC1
2106 ; READER ERRORS COME HERE
2108 ERRPAR: PUSH TP,$TCHRS ;DO THE OFFENDER
2113 PUSH TP,CHQUOT UNEXPECTED
2116 ;COMPLAIN ABOUT MISMATCHED CLOSINGS
2118 MISMAB: SKIPA A,["]]
2119 MISMAT: MOVE A,-1(P) ;GOBBLE THE DESIRED CHARACTER
2120 JUMPE B,CPOPJ ;IGNORE UNIVERSAL CLOSE
2124 PUSH TP,CHQUOT [ INSTEAD-OF ]
2127 MISMA1: MCALL 3,STRING
2129 PUSH TP,EQUOTE READER-SYNTAX-ERROR-ERRET-ANYTHING-TO-GO-ON
2137 ; HERE ON BAD INPUT CHARACTER
2139 BADCHR: ERRUUO EQUOTE BAD-ASCII-CHARACTER
2141 ; HERE ON YUCKY PARSE TABLE
2143 BADPTB: ERRUUO EQUOTE BAD-MACRO-TABLE
2145 BDPSTR: ERRUUO EQUOTE BAD-PARSE-STRING
2147 ILLSQG: PUSHJ P,LSTCHR ; DON'T MESS WITH IT AGAIN
2148 ERRUUO EQUOTE BAD-USE-OF-SQUIGGLY-BRACKETS
2151 ;FLOATING POINT NUMBER TOO LARGE OR SMALL
2152 FOOR: ERRUUO EQUOTE NUMBER-OUT-OF-RANGE
2157 LSTCHR: SKIPL F,5(TB) ;GET CHANNEL
2158 JRST LSTCH1 ;NO CHANNEL, POINT AT SLOT
2160 LSTCH2: SKIPE LSTCH(F) ;ARE WE REALLY FLUSHING A REUSE CHARACTER ?
2165 LSTCH1: SETZM 5(TB) ;ZERO THE LETTER AND RETURN
2169 CNTACX: HRRZ G,-2(F) ; GET BITS
2175 CNTBIN: AOS G,ACCESS-1(F)
2183 ;TABLE OF NAMES OF ARGS AND ALLOWED TYPES
2186 IRP A,,[[[CAIN C,TUNBOU]],[[CAIE C,TCHAN],INCHAN],[[PUSHJ P,CHOBL],OBLIST]]
2194 CHOBL: CAIE C,TLIST ;A LIST OR AN OBLIST