--- /dev/null
+
+TITLE READER FOR MUDDLE
+
+;C. REEVE DEC. 1970
+
+RELOCA
+
+READER==1 ;TELL MUDDLE > TO USE SOME SPECIAL HACKS
+FRMSIN==1 ;FLAG SAYING WHETHER OR "." AND "'" HACKS EXIST
+KILTV==1 ;FLAG SAYING THAT (TVP) SHOULD BE REMOVED (MUDDLE 54 ONLY)
+
+.INSRT MUDDLE >
+
+F==PVP
+G==TVP
+
+.GLOBAL CONS,VECTOR,NXTCHR,RLOOKU,CRADIX,SPTIME,QUOTE,CHMAK,FLUSCH,IGET
+.GLOBAL SETDEV,OPNCHN,ILVAL,RADX,IDVAL,LSTCH,EVECTOR,EUVECTOR,CHUNW,NONSPC
+.GLOBAL CHRWRD,EOFCND,DIRECT,ACCESS,IOINS,ROOT,DIRECT,DOIOTI,DOACCS,IGVAL,BYTDOP
+.GLOBAL ICONS,INCONS,IEVECT,IEUVEC,BUFSTR,TYPFND,SQUTOA,SQUKIL,IBLOCK,GRB
+.GLOBAL BADCHN,WRONGD,CHNCLS,FNFFL,IPUT,IGET,ILOC,RXCT,WXCT,IUNWIN,UNWIN2
+.GLOBAL CNXTCH,CREADC,MPOPJ,CREDC1,CNXTC1,IREMAS,CBYTES,PVSTOR,SPSTOR,DSTORE
+.GLOBAL SFIX
+.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
+.GLOBAL C%M20,C%M30,C%M40,C%M60
+
+BUFLNT==100
+
+FF=0 ;FALG REGISTER DURING NUMBER CONVERSION
+
+;FLAGS USED (RIGHT HALF)
+
+NOTNUM==1 ;NOT A NUMBER
+NFIRST==2 ;NOT FIRST CHARACTER BEING READ
+DECFRC==4 ;FORCE DECIMAL CONVERSION
+NEGF==10 ;NEGATE THIS THING
+NUMWIN==20 ;DIGIT(S) SEEN
+INSTRN==40 ;IN QUOTED CHARACTER STRING
+FLONUM==100 ;NUMBER IS FLOOATING POINT
+DOTSEN==200 ;. SEEN IN IMPUT STREAM
+EFLG==400 ;E SEEN FOR EXPONENT
+FRSDOT==1000 ;. CAME FIRST
+USEAGN==2000 ;SPECIAL DOT HACK
+
+OCTWIN==4000
+OCTSTR==10000
+OVFLEW==40000
+ENEG==100000
+EPOS==200000
+;TEMPORARY OFFSETS
+
+VCNT==0 ;NUMBER OF ELEMENTS IN CURRENT VECTOR
+ONUM==-4 ;CURRENT NUMBER IN OCTAL
+DNUM==-4 ;CURRENT NUMBER IN DECIMAL
+CNUM==-2 ;IN CURRENT RADIX
+NDIGS==0 ;NUMBER OF DIGITS
+ENUM==-2 ;EXPONENT
+NUMTMP==6
+
+; TABLE OF POWERS OF TEN
+
+TENTAB: REPEAT 39. 10.0^<.RPCNT-1>
+
+ITENTB: REPEAT 11. 10.^<.RPCNT-1>
+
+
+\f; TEXT FILE LOADING PROGRAM
+
+MFUNCTION MLOAD,SUBR,[LOAD]
+
+ ENTRY
+
+ HLRZ A,AB ;GET NO. OF ARGS
+ CAIE A,-4 ;IS IT 2
+ JRST TRY2 ;NO, TRY ANOTHER
+ GETYP A,2(AB) ;GET TYPE
+ CAIE A,TOBLS ;IS IT OBLIST
+ CAIN A,TLIST ; OR LIST THEREOF?
+ JRST CHECK1
+ JRST WTYP2
+
+TRY2: CAIE A,-2 ;IS ONE SUPPLIED
+ JRST WNA
+
+CHECK1: GETYP A,(AB) ;GET TYPE
+ CAIE A,TCHAN ;IS IT A CHANNEL
+ JRST WTYP1
+
+LOAD1: HLRZ A,TB ;GET CURRENT TIME
+ PUSH TP,$TTIME ;AND SAVE IT
+ PUSH TP,A
+
+ MOVEI C,CLSNGO ; LOCATION OF FUNNY CLOSER
+ PUSHJ P,IUNWIN ; SET UP AS UNWINDER
+
+LOAD2: PUSH TP,(AB) ;USE SUPPLIED CHANNEL
+ PUSH TP,1(AB)
+ PUSH TP,(TB) ;USE TIME AS EOF ARG
+ PUSH TP,1(TB)
+ CAML AB,C%M20 ; [-2,,0] ;CHECK FOR 2ND ARG
+ JRST LOAD3 ;NONE
+ PUSH TP,2(AB) ;PUSH ON 2ND ARG
+ PUSH TP,3(AB)
+ MCALL 3,READ
+ JRST CHKRET ;CHECK FOR EOF RET
+
+LOAD3: MCALL 2,READ
+CHKRET: CAMN A,(TB) ;IS TYPE EOF HACK
+ CAME B,1(TB) ;AND IS VALUE
+ JRST EVALIT ;NO, GO EVAL RESULT
+ PUSH TP,(AB)
+ PUSH TP,1(AB)
+ MCALL 1,FCLOSE
+ MOVE A,$TCHSTR
+ MOVE B,CHQUOTE DONE
+ JRST FINIS
+
+CLSNGO: PUSH TP,$TCHAN
+ PUSH TP,1(AB)
+ MCALL 1,FCLOSE
+ JRST UNWIN2 ; CONTINUE UNWINDING
+
+EVALIT: PUSH TP,A
+ PUSH TP,B
+ MCALL 1,EVAL
+ JRST LOAD2
+
+
+
+; OTHER FILE LOADING PROGRAM
+
+
+\f
+MFUNCTION FLOAD,SUBR
+
+ ENTRY
+
+ MOVEI C,1 ;INITIALIZE OPEN'S ARG COUNT
+ PUSH TP,$TAB ;SLOT FOR SAVED AB
+ PUSH TP,C%0 ; [0] ;EMPTY FOR NOW
+ PUSH TP,$TCHSTR ;PUT IN FIRST ARG
+ PUSH TP,CHQUOTE READ
+ MOVE A,AB ;COPY OF ARGUMENT POINTER
+
+FARGS: JUMPGE A,CALOPN ;DONE? IF SO CALL OPEN
+ GETYP B,(A) ;NO, CHECK TYPE OF THIS ARG
+ CAIE B,TOBLS ;OBLIST?
+ CAIN B,TLIST ; OR LIST THEREOF
+ JRST OBLSV ;YES, GO SAVE IT
+
+ PUSH TP,(A) ;SAVE THESE ARGS
+ PUSH TP,1(A)
+ ADD A,C%22 ; [2,,2] ;BUMP A
+ AOJA C,FARGS ;COUNT AND GO
+
+OBLSV: MOVEM A,1(TB) ;SAVE THE AB
+
+CALOPN: ACALL C,FOPEN ;OPEN THE FILE
+
+ JUMPGE B,FNFFL ;FILE MUST NO EXIST
+ EXCH A,(TB) ;PLACE CHANNEL ON STACK
+ EXCH B,1(TB) ;OBTAINING POSSIBLE OBLIST
+ JUMPN B,2ARGS ;OBLIST SUOPPLIED?
+
+ MCALL 1,MLOAD ;NO, JUST CALL
+ JRST FINIS
+
+
+2ARGS: PUSH TP,(B) ;PUSH THE OBLIST
+ PUSH TP,1(B)
+ MCALL 2,MLOAD
+ JRST FINIS
+
+
+FNFFL: PUSH TP,$TATOM
+ PUSH TP,EQUOTE FILE-SYSTEM-ERROR
+ JUMPE B,CALER1
+ PUSH TP,A
+ PUSH TP,B
+ MOVEI A,2
+ JRST CALER
+
+\fMFUNCTION READ,SUBR
+
+ ENTRY
+
+ PUSH P,[SETZ IREAD1] ;WHERE TO GO AFTER BINDING
+READ0: PUSH TP,$TTP ;SLOT FOR LAST THING READ (TYPE IS UNREADABLE)
+ PUSH TP,C%0
+ PUSH TP,$TFIX ;SLOT FOR RADIX
+ PUSH TP,C%0
+ PUSH TP,$TCHAN ;AND SLOT FOR CHANNEL
+ PUSH TP,C%0
+ PUSH TP,C%0 ; USER DISP SLOT
+ PUSH TP,C%0
+ PUSH TP,$TSPLICE
+ PUSH TP,C%0 ;SEGMENT FOR SPLICING MACROS
+ JUMPGE AB,READ1 ;NO ARGS, NO BINDING
+ GETYP C,(AB) ;ISOLATE TYPE
+ CAIN C,TUNBOU
+ JRST WTYP1
+ PUSH TP,[TATOM,,-1] ;PUSH THE ATOMS
+ PUSH TP,IMQUOTE INCHAN
+ PUSH TP,(AB) ;PUSH ARGS
+ PUSH TP,1(AB)
+ PUSH TP,C%0 ;DUMMY
+ PUSH TP,C%0
+ MOVE B,1(AB) ;GET CHANNEL POINTER
+ ADD AB,C%22 ;AND ARG POINTER
+ JUMPGE AB,BINDEM ;MORE?
+ PUSH TP,[TVEC,,-1]
+ ADD B,[EOFCND-1,,EOFCND-1]
+ PUSH TP,B
+ PUSH TP,(AB)
+ PUSH TP,1(AB)
+ ADD AB,C%22
+ JUMPGE AB,BINDEM ;IF ANY MORE ARGS GO PROCESS AND BIND THEM
+ GETYP C,(AB) ;ISOLATE TYPE
+ CAIE C,TLIST
+ CAIN C,TOBLS
+ SKIPA
+ JRST WTYP3
+ PUSH TP,[TATOM,,-1] ;PUSH THE ATOMS
+ PUSH TP,IMQUOTE OBLIST
+ PUSH TP,(AB) ;PUSH ARGS
+ PUSH TP,1(AB)
+ PUSH TP,C%0 ;DUMMY
+ PUSH TP,C%0
+ ADD AB,C%22 ;AND ARG POINTER
+ JUMPGE AB,BINDEM ; ALL DONE, BIND ATOMS
+ GETYP 0,(AB) ; GET TYPE OF TABLE
+ CAIE 0,TVEC ; SKIP IF BAD TYPE
+ JRST WTYP ; ELSE COMPLAIN
+ PUSH TP,[TATOM,,-1]
+ PUSH TP,IMQUOTE READ-TABLE
+ PUSH TP,(AB)
+ PUSH TP,1(AB)
+ PUSH TP,C%0
+ PUSH TP,C%0
+ ADD AB,C%22 ; BUMP TO NEXT ARG
+ JUMPL AB,TMA ;MORE ?, ERROR
+BINDEM: PUSHJ P,SPECBIND
+ JRST READ1
+
+MFUNCTION RREADC,SUBR,READCHR
+
+ ENTRY
+ PUSH P,[SETZ IREADC]
+ JRST READC0 ;GO BIND VARIABLES
+
+MFUNCTION NXTRDC,SUBR,NEXTCHR
+
+ ENTRY
+
+ PUSH P,[SETZ INXTRD]
+READC0: CAMGE AB,C%M40 ; [-5,,]
+ JRST TMA
+ PUSH TP,(AB)
+ PUSH TP,1(AB)
+ JUMPL AB,READC1
+ MOVE B,IMQUOTE INCHAN
+ PUSHJ P,IDVAL
+ GETYP 0,A
+ CAIE 0,TCHAN
+ JRST BADCHN
+ MOVEM A,-1(TP)
+ MOVEM B,(TP)
+READC1: PUSHJ P,@(P)
+ JRST .+2
+ JRST FINIS
+
+ PUSH TP,-1(TP)
+ PUSH TP,-1(TP)
+ MCALL 1,FCLOSE
+ MOVE A,EOFCND-1(B)
+ MOVE B,EOFCND(B)
+ CAML AB,C%M20 ; [-3,,]
+ JRST .+3
+ MOVE A,2(AB)
+ MOVE B,3(AB)
+ PUSH TP,A
+ PUSH TP,B
+ MCALL 1,EVAL
+ JRST FINIS
+
+
+MFUNCTION PARSE,SUBR
+
+ ENTRY
+
+ PUSHJ P,GAPRS ;GET ARGS FOR PARSES
+ PUSHJ P,GPT ;GET THE PARSE TABLE
+ PUSHJ P,NXTCH ; GET A CHAR TO TEST FOR ! ALT
+ SKIPN 11.(TB) ; EOF HIT, COMPLAIN TO LOOSER
+ JRST NOPRS
+ MOVEI A,33 ; CHANGE IT TO AN ALT, SNEAKY HUH?
+ CAIN B,MANYT ; TYPE OF MULTIPLE CLOSE, I.E. ! ALT
+ MOVEM A,5(TB)
+ PUSHJ P,IREAD1 ;GO DO THE READING
+ JRST .+2
+ JRST LPSRET ;PROPER EXIT
+NOPRS: ERRUUO EQUOTE CAN'T-PARSE
+
+MFUNCTION LPARSE,SUBR
+
+ ENTRY
+
+ PUSHJ P,GAPRS ;GET THE ARGS TO THE PARSE
+ JRST LPRS1
+
+GAPRS: PUSH TP,$TTP
+ PUSH TP,C%0
+ PUSH TP,$TFIX
+ PUSH TP,[10.]
+ PUSH TP,$TFIX
+ PUSH TP,C%0 ; LETTER SAVE
+ PUSH TP,C%0
+ PUSH TP,C%0 ; PARSE TABLE MAYBE?
+ PUSH TP,$TSPLICE
+ PUSH TP,C%0 ;SEGMENT FOR SPLICING MACROS
+ PUSH TP,C%0 ;SLOT FOR LOCATIVE TO STRING
+ PUSH TP,C%0
+ JUMPGE AB,USPSTR
+ PUSH TP,[TATOM,,-1]
+ PUSH TP,IMQUOTE PARSE-STRING
+ PUSH TP,(AB)
+ PUSH TP,1(AB) ; BIND OLD PARSE-STRING
+ PUSH TP,C%0
+ PUSH TP,C%0
+ PUSHJ P,SPECBIND
+ ADD AB,C%22
+ JUMPGE AB,USPSTR
+ GETYP 0,(AB)
+ CAIE 0,TFIX
+ JRST WTYP2
+ MOVE 0,1(AB)
+ MOVEM 0,3(TB)
+ ADD AB,C%22
+ JUMPGE AB,USPSTR
+ GETYP 0,(AB)
+ CAIE 0,TLIST
+ CAIN 0,TOBLS
+ SKIPA
+ JRST WTYP3
+ PUSH TP,[TATOM,,-1]
+ PUSH TP,IMQUOTE OBLIST
+ PUSH TP,(AB)
+ PUSH TP,1(AB) ; HE WANTS HIS OWN OBLIST
+ PUSH TP,C%0
+ PUSH TP,C%0
+ PUSHJ P,SPECBIND
+ ADD AB,C%22
+ JUMPGE AB,USPSTR
+ GETYP 0,(AB)
+ CAIE 0,TVEC
+ JRST WTYP
+ PUSH TP,[TATOM,,-1]
+ PUSH TP,IMQUOTE PARSE-TABLE
+ PUSH TP,(AB)
+ PUSH TP,1(AB)
+ PUSH TP,C%0
+ PUSH TP,C%0
+ PUSHJ P,SPECBIND
+ ADD AB,C%22
+ JUMPGE AB,USPSTR
+ GETYP 0,(AB)
+ CAIE 0,TCHRS
+ JRST WTYP
+ MOVE 0,1(AB)
+ MOVEM 0,5(TB) ; STUFF IN A LOOK-AHEAD CHARACTER IF HE WANTS
+ ADD AB,C%22
+ JUMPL AB,TMA
+USPSTR: MOVE B,IMQUOTE PARSE-STRING
+ PUSHJ P,ILOC ; GET A LOCATIVE TO THE STRING, WHEREVER
+ GETYP 0,A
+ CAIN 0,TUNBOUND ; NONEXISTANT
+ JRST BDPSTR
+ GETYP 0,(B) ; IT IS POINTING TO A STRING
+ CAIE 0,TCHSTR
+ JRST BDPSTR
+ MOVEM A,10.(TB)
+ MOVEM B,11.(TB)
+ POPJ P,
+
+LPRS1: PUSHJ P,GPT ; GET THE VALUE OF PARSE-TABLE IN SLOT
+ PUSH TP,$TLIST
+ PUSH TP,C%0 ; HERE WE ARE MAKE PLACE TO SAVE GOODIES
+ PUSH TP,$TLIST
+ PUSH TP,C%0
+LPRS2: PUSHJ P,IREAD1
+ JRST LPRSDN ; IF WE ARE DONE, WE ARE THROUGH
+ MOVE C,A
+ MOVE D,B
+ PUSHJ P,INCONS
+ SKIPN -2(TP)
+ MOVEM B,-2(TP) ; SAVE THE BEGINNING ON FIRST
+ SKIPE C,(TP)
+ HRRM B,(C) ; PUTREST INTO IT
+ MOVEM B,(TP)
+ JRST LPRS2
+LPRSDN: MOVSI A,TLIST
+ MOVE B,-2(TP)
+LPSRET: SKIPLE C,5(TB) ; EXIT FOR PARSE AND LPARSE
+ CAIN C,400033 ; SEE IF NO PEEK AHEAD OR IF ! ALTMODE
+ JRST FINIS ; IF SO NO NEED TO BACK STRING ONE
+ SKIPN C,11.(TB)
+ JRST FINIS ; IF ATE WHOLE STRING, DONT GIVE BACK ANY
+BUPRS: MOVEI D,1
+ ADDM D,(C) ; AOS THE COUNT OF STRING LENGTH
+ SKIPG D,1(C) ; SEXIER THAN CLR'S CODE FOR DECREMENTING
+ SUB D,[430000,,1] ; A BYTE POINTER
+ ADD D,[70000,,0]
+ MOVEM D,1(C)
+ HRRZ E,2(TB)
+ JUMPE E,FINIS ; SEE IF WE NEED TO BACK UP TWO
+ HLLZS 2(TB) ; CLEAR OUT DOUBLE CHR LOOKY FLAG
+ JRST BUPRS ; AND BACK UP PARSE STRING A LITTLE MORE
+
+\f; ARGUMENTS ARE BOUND, NOW GET THE VALUES OF THINGS
+
+
+GRT: MOVE B,IMQUOTE READ-TABLE
+ SKIPA ; HERE TO GET TABLE FOR READ
+GPT: MOVE B,IMQUOTE PARSE-TABLE
+ MOVSI A,TATOM ; TO FILL SLOT WITH PARSE TABLE
+ PUSHJ P,ILVAL
+ GETYP 0,A
+ CAIN 0,TUNBOUND
+ POPJ P,
+ CAIE 0,TVEC
+ JRST BADPTB
+ MOVEM A,6(TB)
+ MOVEM B,7(TB)
+ POPJ P,
+
+READ1: PUSHJ P,GRT
+ MOVE B,IMQUOTE INCHAN
+ MOVSI A,TATOM
+ PUSHJ P,IDVAL ;NOW GOBBLE THE REAL CHANNEL
+ TLZ A,TYPMSK#777777
+ HLLZS A ; INCASE OF FUNNY BUG
+ CAME A,$TCHAN ;IS IT A CHANNEL
+ JRST BADCHN
+ MOVEM A,4(TB) ; STORE CHANNEL
+ MOVEM B,5(TB)
+ HRRZ A,-2(B)
+ TRNN A,C.OPN
+ JRST CHNCLS
+ TRNN A,C.READ
+ JRST WRONGD
+ HLLOS 4(TB)
+ TRNE A,C.BIN ; SKIP IF NOT BIN
+ JRST BREAD ; CHECK FOR BUFFER
+ HLLZS 4(TB)
+GETIOA: MOVE B,5(TB)
+GETIO: MOVE A,IOINS(B) ;GOBBLE THE I/O INSTRUCTION
+ JUMPE A,OPNFIL ;GO REALLY OPEN THE CROCK
+ MOVE A,RADX(B) ;GET RADIX
+ MOVEM A,3(TB)
+ MOVEM B,5(TB) ;SAVE CHANNEL
+REREAD: HRRZ D,LSTCH(B) ;ANY CHARS AROUND?
+ MOVEI 0,33
+ CAIN D,400033 ;FLUSH THE TERMINATOR HACK
+ HRRM 0,LSTCH(B) ; MAKE ! ALT INTO JUST ALT IF IT IS STILL AROUND
+
+ PUSHJ P,@(P) ;CALL INTERNAL READER
+ JRST BADTRM ;LOST
+RFINIS: SUB P,C%11 ;POP OFF LOSER
+ PUSH TP,A
+ PUSH TP,B
+ JUMPE C,FLSCOM ; FLUSH TOP LEVEL COMMENT
+ PUSH TP,C
+ PUSH TP,D
+ MOVE A,4(TB)
+ MOVE B,5(TB) ; GET CHANNEL
+ MOVSI C,TATOM
+ MOVE D,IMQUOTE COMMENT
+ PUSHJ P,IPUT
+RFINI1: POP TP,B
+ POP TP,A
+ JRST FINIS
+
+FLSCOM: MOVE A,4(TB)
+ MOVE B,5(TB)
+ MOVSI C,TATOM
+ MOVE D,IMQUOTE COMMENT
+ PUSHJ P,IREMAS
+ JRST RFINI1
+
+BADTRM: MOVE C,5(TB) ; GET CHANNEL
+ JUMPGE B,CHLSTC ;NO, MUST BE UNMATCHED PARENS
+ SETZM LSTCH(C) ; DONT REUSE EOF CHR
+ PUSH TP,4(TB) ;CLOSE THE CHANNEL
+ PUSH TP,5(TB)
+ MCALL 1,FCLOSE
+ PUSH TP,EOFCND-1(B)
+ PUSH TP,EOFCND(B)
+ MCALL 1,EVAL ;AND EVAL IT
+ SETZB C,D
+ GETYP 0,A ; CHECK FOR FUNNY ACT
+ CAIE 0,TREADA
+ JRST RFINIS ; AND RETURN
+
+ PUSHJ P,CHUNW ; UNWIND TO POINT
+ MOVSI A,TREADA ; SEND MESSAGE BACK
+ JRST CONTIN
+
+;HERE TO ATTEMPT TO OPEN A CLOSED CHANNEL
+
+OPNFIL: PUSHJ P,OPNCHN ;GO DO THE OPEN
+ JUMPGE B,FNFFL ;LOSE IC B IS 0
+ JRST GETIO
+
+
+CHLSTC: MOVE B,5(TB) ;GET CHANNEL BACK
+ JRST REREAD
+
+
+BREAD: MOVE B,5(TB) ; GET CHANNEL
+ SKIPE BUFSTR(B)
+ JRST GETIO
+ MOVEI A,BUFLNT ; GET A BUFFER
+ PUSHJ P,IBLOCK
+ MOVEI C,BUFLNT(B) ; POINT TO END
+ HRLI C,440700
+ MOVE B,5(TB) ; CHANNEL BACK
+ MOVEI 0,C.BUF
+ IORM 0,-2(B)
+ MOVEM C,BUFSTR(B)
+ MOVSI C,TCHSTR+.VECT.
+ MOVEM C,BUFSTR-1(B)
+ JRST GETIO
+\f;MAIN ENTRY TO READER
+
+NIREAD: PUSHJ P,LSTCHR
+NIREA1: PUSH P,C%M1 ; [-1] ; DONT GOBBLE COMMENTS
+ JRST IREAD2
+
+IREAD:
+ PUSHJ P,LSTCHR ;DON'T REREAD LAST CHARACTER
+IREAD1: PUSH P,C%0 ; FLAG SAYING SNARF COMMENTS
+IREAD2: INTGO
+BDLP: SKIPE C,9.(TB) ;HAVE WE GOT A SPLICING MACRO LEFT
+ JRST SPLMAC ;IF SO GIVE HIM SOME OF IT
+ PUSHJ P,NXTCH ;GOBBLE CHAR IN A AND TYPE IN D
+ MOVMS B ; FOR SPECIAL NEG HACK OF MACRO TABLES
+ CAIG B,ENTYPE
+ JUMPN B,@DTBL-1(B) ;ERROR ON ZERO TYPE OR FUNNY TYPE
+ JRST BADCHR
+
+
+SPLMAC: HRRZ D,(C) ;GET THE REST OF THE SEGMENT
+ MOVEM D,9.(TB) ;AND PUT BACK IN PLACE
+ GETYP D,(C) ;SEE IF DEFERMENT NEEDED
+ CAIN D,TDEFER
+ MOVE C,1(C) ;IF SO, DO DEFEREMENT
+ MOVE A,(C)
+ MOVE B,1(C) ;GET THE GOODIE
+ AOS -1(P) ;ALWAYS A SKIP RETURN
+ POP P,(P) ;DONT WORRY ABOUT COMMENT SEARCHAGE
+ SETZB C,D ;MAKE SURE HE DOESNT THINK WE GOT COMMENT
+ POPJ P, ;GIVE HIM WHAT HE DESERVES
+
+DTBL:
+CODINI==0
+IRP A,,[[LETCOD,LETTER],[NUMCOD,NUMBER],[PLUCOD,PNUMBE],[NEGCOD,NNUMBE],[ASTCOD,ASTSTR],[DOTTYP,DOTSTR],[ETYPE,LETTER]
+[SPATYP,SPACE],[LPATYP,LPAREN],[RPATYP,RPAREN],[LBRTYP,LBRACK],[RBRTYP,RBRACK]
+[QUOTYP,QUOTIT],[MACTYP,MACCAL],[CSTYP,CSTRING],[ESCTYP,ESCSTR],[SPCTYP,SPECTY]
+[SLMNT,OPNANG],[CNGTYP,CLSANG],[EOFTYP,EOFCHR],[COMTYP,COMNT],[GLMNT,GLOVAL]
+[TMPTYP,ILLSQG],[NTYPES,CLSBRA],[EXCEXC,LETTER],[DOTEXT,SEGDOT],[LBREXT,UVECIN]
+[RBREXT,RBRACK],[QUOEXT,QUOSEG],[CSEXT,SINCHR],[SLMEXT,SEGIN],[ELMEXT,CLSANG]
+[GLMEXT,GLOSEG],[PATHTY,LOSPATH],[BSLEXT,SINCHR],[MANYT,TERM],[USTYP1,USRDS1]
+[USTYP2,USRDS2]]
+
+ IRP B,C,[A]
+ CODINI==CODINI+1
+ B==CODINI
+ SETZ C
+ .ISTOP
+ TERMIN
+TERMIN
+
+EXPUNGE CODINI
+
+ENTYPE==.-DTBL
+
+NONSPC==ETYPE
+
+SPACE: PUSHJ P,LSTCHR ;DONT REREAD SPACER
+ JRST BDLP
+
+USRDS1: SKIPA B,A ; GET CHAR IN B
+USRDS2: MOVEI B,200(A) ; ! CHAR, DISP 200 FURTHER
+ ASH B,1
+ ADD B,7(TB) ; POINT TO TABLE ENTRY
+ GETYP 0,(B)
+ CAIN 0,TLIST
+ MOVE B,1(B) ; IF LIST, USE FIRST ITEM-SPECIAL NO BREAK HACK
+ SKIPL C,5(TB) ; GET CHANNEL POINTER (IF ANY)
+ JRST USRDS3
+ ADD C,[EOFCND-1,,EOFCND-1]
+ PUSH TP,$TBVL
+ MOVE SP,SPSTOR+1
+ HRRM SP,(TP) ; BUILD A TBVL
+ MOVE SP,TP
+ MOVEM SP,SPSTOR+1
+ PUSH TP,C
+ PUSH TP,(C)
+ PUSH TP,1(C)
+ MOVE PVP,PVSTOR+1
+ MOVEI D,PVLNT*2+1(PVP)
+ HRLI D,TREADA
+ MOVEM D,(C)
+ MOVEI D,(TB)
+ HLL D,OTBSAV(TB)
+ MOVEM D,1(C)
+USRDS3: PUSH TP,(B) ; APPLIER
+ PUSH TP,1(B)
+ PUSH TP,$TCHRS ; APPLY TO CHARACTER
+ PUSH TP,A
+ PUSHJ P,LSTCHR ; FLUSH CHAR
+ MCALL 2,APPLY ; GO TO USER GOODIE
+ SKIPL 5(TB)
+ JRST USRDS9
+ MOVE SP,SPSTOR+1
+ HRRZ E,1(SP) ; POINT TO EOFCND SLOT
+ HRRZ SP,(SP) ; UNBIND MANUALLY
+ MOVEI D,(TP)
+ SUBI D,(SP)
+ MOVSI D,(D)
+ HLL SP,TP
+ SUB SP,D
+ MOVEM SP,SPSTOR+1
+ POP TP,1(E)
+ POP TP,(E)
+ SUB TP,C%22 ; FLUSH TP CRAP
+USRDS9: GETYP 0,A ; CHECK FOR DISMISS?
+ CAIN 0,TSPLICE
+ JRST GOTSPL ; RETURN OF SEGMENT INDICATES SPLICAGE
+ CAIN 0,TREADA ; FUNNY?
+ JRST DOEOF
+ CAIE 0,TDISMI
+ JRST RET ; NO, RETURN FROM IREAD
+ JRST BDLP ; YES, IGNORE RETURN
+
+GOTSPL: MOVEM B,9.(TB) ; STICK IN THE SPLICAGE SLOT SO IREADS WILL GET HIM
+ JRST BDLP ; GO BACK AND READ FROM OUR SPLICE, OK?
+
+\f
+;HERE ON NUMBER OR LETTER, START ATOM
+
+ESCSTR: PUSHJ P,NXTC1 ; ESCAPE FIRST
+LETTER: MOVEI FF,NOTNUM ; LETTER
+ JRST ATMBLD
+
+ASTSTR: MOVEI FF,OCTSTR
+DOTST1: MOVEI B,0
+ JRST NUMBLD
+
+NUMBER: MOVEI FF,NUMWIN ; SYMBOL OR NUMBER
+NUMBR1: MOVEI B,(A) ; TO A NUMBER
+ SUBI B,60
+ JRST NUMBLD
+
+PNUMBE: SETZB FF,B
+ JRST NUMBLD
+
+NNUMBE: MOVEI FF,NEGF
+ MOVEI B,0
+
+NUMBLD: PUSH TP,$TFIX
+ PUSH TP,B
+ PUSH TP,$TFIX
+ PUSH TP,B
+ PUSH TP,$TFIX
+ PUSH TP,C%0
+
+ATMBLD: LSH A,<36.-7>
+ PUSH P,A
+ MOVEI D,1 ; D IS CHAR COUNT
+ MOVSI C,350700+P ; BYTE PNTR
+ PUSHJ P,LSTCHR
+
+ATLP: PUSH P,FF
+ INTGO
+
+ PUSHJ P,NXTCH ; GET NEXT CHAR
+ POP P,FF
+ TRNN FF,NOTNUM ; IF NOT NUMBER, SKIP
+ JRST NUMCHK
+
+ATLP2: CAILE B,NONSPC ; SKIP IF STILL LETTER OR NUMBER
+ JRST CHKEND
+
+ATLP1: PUSHJ P,LSTCHR ; DONT REUSE
+ IDPB A,C ; INTO ATOM
+ TLNE C,760000 ; SKIP IF OK WORD
+ AOJA D,ATLP
+
+ PUSH P,C%0
+ MOVSI C,440700+P
+ AOJA D,ATLP
+
+CHKEND: CAIN B,ESCTYP ; ESCAPE?
+ JRST DOESC1
+
+CHKEN1: SKIPGE C ; SKIP IF TOP SLOT FULL
+ SUB P,C%11
+ PUSH P,D ; COUNT OF CHARS
+
+ JRST LOOPA ; GO HACK TRAILERS
+
+
+; HERE IF STILL COULD BE A NUMBER
+
+NUMCHK: CAIN B,NUMCOD ; STILL NUMBER
+ JRST NUMCH1
+
+ CAILE B,NONSPC ; NUMBER FINISHED?
+ JRST NUMCNV
+
+ CAIN B,DOTTYP
+ TROE FF,DOTSEN
+ JRST NUMCH2
+ TRNE FF,OCTSTR+EFLG
+ JRST NUMCH3 ; NO . IN OCTAL OR EXPONENT
+ TRO FF,DECFRC ; MUST BE DECIMAL NOW
+ JRST ATLP1
+
+NUMCH1: TRO FF,NUMWIN
+ MOVEI B,(A)
+ SUBI B,60
+ TRNE FF,OCTSTR+OCTWIN ; IS THIS *DDDDDD* HACK
+ JRST NUMCH4 ; YES, GO DO IT
+ TRNE FF,EFLG
+ JRST NUMCH7 ; DO EXPONENT
+
+ TRNE FF,DOTSEN ; FORCE FLOAT
+ JRST NUMCH5
+
+ JFCL 17,.+1 ; KILL ALL FLAGS
+ MOVE E,CNUM(TP) ; COMPUTE CURRENT RADIX
+ IMUL E,3(TB)
+ ADDI E,(B) ; ADD IN CURRENT DIGIT
+ JFCL 10,.+3
+ MOVEM E,CNUM(TP)
+ JRST NUMCH6
+
+ MOVE E,3(TB) ; SEE IF CURRENT RADIX DECIMAL
+ CAIE E,10.
+ JRST NUMCH5 ; YES, FORCE FLOAT
+ TROA FF,OVFLEW
+
+NUMCH5: TRO FF,FLONUM ; SET FLOATING FLAG
+NUMCH6: JFCL 17,.+1 ; CLEAR ALL FLAGS
+ MOVE E,DNUM(TP) ; GET DECIMAL NUMBER
+ IMULI E,10.
+ JFCL 10,NUMCH8 ; JUMP IF OVERFLOW
+ ADDI E,(B) ; ADD IN DIGIT
+ MOVEM E,DNUM(TP)
+ TRNE FF,FLONUM ; IS THIS FRACTION?
+ SOS NDIGS(TP) ; YES, DECREASE EXPONENT BY ONE
+ JRST ATLP1
+
+NUMCH8: TRNE FF,DOTSEN ; OVERFLOW IN DECMIMAL
+ JRST ATLP1 ; OK, IN FRACTION
+
+ AOS NDIGS(TP)
+ TRO FF,FLONUM ; MAKE IT FLOATING TO FIT
+ JRST ATLP1
+
+NUMCH4: TRNE FF,OCTWIN
+ JRST NUMCH3 ; ALREADY ONE, MORE DIGITS LOSE
+ MOVE E,ONUM(TP)
+ TLNE E,700000 ; SKIP IF WORD NOT FULL
+ TRO FF,OVFLEW
+ LSH E,3
+ ADDI E,(B) ; ADD IN NEW ONE
+ MOVEM E,ONUM(TP)
+ JRST ATLP1
+
+NUMCH3: SUB TP,[NUMTMP,,NUMTMP] ; FLUSH NUMBER CRUFT
+ TRO FF,NOTNUM
+ JRST ATLP2
+
+NUMCH2: CAIN B,ASTCOD ; POSSIBLE END OF OCTAL
+ TRZN FF,OCTSTR ; RESET FLAG AND WIN
+ JRST NUMCH9
+
+ TRO FF,OCTWIN
+ JRST ATLP2
+
+NUMCH9: CAIN B,ETYPE
+ TROE FF,EFLG
+ JRST NUMC10 ; STILL COULD BE +- EXPONENT
+
+ TRZ FF,NUMWIN ; IN CASE NO MORE DIGITS
+ SETZM ENUM(TP)
+ JRST ATLP1
+
+NUMCH7: MOVE E,ENUM(TP)
+ IMULI E,10.
+ ADDI E,(B)
+ MOVEM E,ENUM(TP) ; UPDATE ECPONENT
+ TRO FF,EPOS ; FLUSH IF SIGN COMES NOW
+ JRST ATLP1
+
+NUMC10: TRNN FF,EFLG ; IF NOT IN EXPONENT, LOSE
+ TRNE FF,ENEG+EPOS ; SIGN FOR EXPONENT SEEN?
+ JRST NUMCH3 ; NOT A NUMBER
+ CAIN B,PLUCOD
+ TRO FF,EPOS
+ CAIN B,NEGCOD
+ TRO FF,ENEG
+ TRNE FF,EPOS+ENEG
+ JRST ATLP1
+ JRST NUMCH3
+
+; HERE AFTER \ QUOTER
+
+DOESC1: PUSHJ P,NXTC1 ; GET CHAR
+ JRST ATLP1 ; FALL BACK INTO LOOP
+
+
+; HERE TO CONVERT NUMBERS AS NEEDED
+
+NUMCNV: CAIE B,ESCTYP
+ TRNE FF,OCTSTR
+ JRST NUMCH3
+ TRNN FF,NUMWIN
+ JRST NUMCH3
+ ADDI D,4
+ IDIVI D,5
+ SKIPGE C ; SKIP IF NEW WORD ADDED
+ ADDI D,1
+ HRLI D,(D) ; TOO BOTH HALVES
+ SUB P,D ; REMOVE CHAR STRING
+ MOVE D,3(TB) ; IS RADIX 10?
+ CAIE D,10.
+ TRNE FF,DECFRC
+ TRNN FF,FLONUM+EFLG ;IS IT A FLOATING POINT NUMBER
+ TRNE FF,EFLG
+ JRST FLOATIT ;YES, GO MAKE IT WIN
+ TRNE FF,OVFLEW
+ JRST FOOR
+ MOVE B,CNUM(TP)
+ TRNE FF,DECFRC
+ MOVE B,DNUM(TP) ;GRAB FIXED GOODIE
+ TRNE FF,OCTWIN ; SKIP IF NOT OCTAL
+ MOVE B,ONUM(TP) ; USE OCTAL VALUE
+FINID2: MOVSI A,TFIX ;SAY FIXED POINT
+FINID1: TRNE FF,NEGF ;NEGATE
+ MOVNS B ;YES
+ SUB TP,[NUMTMP,,NUMTMP] ;FINISH HACK
+ JRST RET ;AND RETURN
+
+\f
+FLOATIT:
+ JFCL 17,.+1 ;CLEAR ALL ARITHMETIC FLAGS
+ TRNE FF,EFLG ;"E" SEEN?
+ JRST EXPDO ;YES, DO EXPONENT
+ MOVE D,NDIGS(TP) ;GET IMPLICIT EXPONENT
+
+FLOATE: MOVE A,DNUM(TP) ;GET DECIMAL NUMBER
+ IDIVI A,400000 ;SPLIT
+ FSC A,254 ;CONVERT MOST SIGNIFICANT
+ FSC B,233 ; AND LEAST SIGNIFICANT
+ FADR B,A ;COMBINE
+
+ MOVM A,D ;GET MAGNITUDE OF EXPONENT
+ MOVSI E,(1.0)
+ JFCL 17,.+1 ; CLEAR ALL OVERFLOW/UNDERFLOW BITS
+ CAIG A,38. ;HOW BIG?
+ JRST .+3 ;TOO BIG-FLOATING OUT OF RANGE
+ MOVE E,[1.0^38.]
+ SUBI A,38.
+ JUMPGE D,FLOAT1 ;JUMP IF EXPONENT POSITIVE
+ FDVR B,E
+ FDVR B,TENTAB(A) ;DIVIDE BY TEN TO THE EXPONENT
+ JRST SETFLO
+
+FLOAT1: FMPR B,E
+ FMPR B,TENTAB(A) ;SCALE UP
+
+SETFLO: JFCL 17,FOOR ;FLOATING OUT OF RANGE ON OVERFLOW
+ MOVSI A,TFLOAT
+ TRZ FF,FRSDOT ;FLOATING NUMBER NOT VALUE
+ JRST FINID1
+
+EXPDO:
+ HRRZ D,ENUM(TP) ;GET EXPONENT
+ TRNE FF,ENEG ;IS EXPONENT NEGATIVE?
+ MOVNS D ;YES
+ ADD D,NDIGS(TP) ;ADD IMPLICIT EXPONENT
+ JUMPL D,FLOATE ;FLOATING IF EXPONENT NEGATIVE
+ CAIG D,10. ;OR IF EXPONENT TOO LARGE
+ TRNE FF,FLONUM ;OR IF FLAG SET
+ JRST FLOATE
+ MOVE B,DNUM(TP) ;
+ IMUL B,ITENTB(D)
+ JFCL 10,FLOATE ;IF OVERFLOW, MAKE FLOATING
+ JRST FINID2 ;GO MAKE FIXED NUMBER
+
+
+; HERE TO START BUILDING A CHARACTER STRING GOODIE
+
+CSTRING:
+ PUSH P,C%0
+ MOVEI D,0 ; CHARCOUNT
+ MOVSI C,440700+P ; AND BYTE POINTER
+
+CSLP: PUSH P,FF
+ INTGO
+ PUSHJ P,NXTC1 ; GET NEXT CHAR
+ POP P,FF
+
+ CAIN B,CSTYP ; END OF STRING?
+ JRST CSLPEND
+
+ CAIN B,ESCTYP ; ESCAPE?
+ PUSHJ P,NXTC1
+
+ IDPB A,C ; INTO ATOM
+ TLNE C,760000 ; SKIP IF OK WORD
+ AOJA D,CSLP
+
+ PUSH P,C%0
+ MOVSI C,440700+P
+ AOJA D,CSLP
+
+CSLPEND:
+ SKIPGE C
+ SUB P,C%11
+ PUSH P,D
+ PUSHJ P,CHMAK
+ PUSHJ P,LSTCHR
+
+ JRST RET
+
+;ARRIVE HERE TO INVOKE A READ TIME MACRO FUNCTION
+
+MACCAL: PUSHJ P,NXTCH1 ;READ ONE MORE CHARACTER
+ CAIE B,MACTYP ;IS IT ANOTHER MACRO CHAR
+
+ JRST MACAL2 ;NO, CALL MACRO AND USE VALUE
+ PUSHJ P,LSTCHR ;DONT REREAD %
+ PUSHJ P,MACAL1 ;OTHERWISE, USE SIDE EFFECCT, BUT NOT VALUE
+ JRST IREAD2
+
+MACAL2: PUSH P,CRET
+MACAL1: PUSHJ P,IREAD1 ;READ FUNCTION NAME
+ PUSHJ P,RETERR
+ PUSH TP,C
+ PUSH TP,D ; SAVE COMMENT IF ANY
+ PUSH TP,A ;SAVE THE RESULT
+ PUSH TP,B ;AND USE IT AS AN ARGUMENT
+ MCALL 1,EVAL
+ POP TP,D
+ POP TP,C ; RESTORE COMMENT IF ANY...
+CRET: POPJ P,RET12
+
+;CALL GOBBLE TO FIND THE TYPE AND THEN IREAD TO READ IT
+
+SPECTY: PUSHJ P,NIREAD ; READ THE TYPES NAME (SHOULD BE AN ATOM)
+ PUSHJ P,RETERR
+ PUSH TP,A
+ PUSH TP,B
+ GETYP A,A
+ CAIN A,TFIX
+ JRST BYTIN
+ PUSHJ P,NXTCH ; GET NEXT CHAR
+ CAIN B,TMPTYP ; SKIP IF NOT TEMPLATE START
+ JRST RDTMPL
+ SETZB A,B
+ EXCH A,-1(TP)
+ EXCH B,(TP)
+ PUSH TP,A ;BEGIN SETTING UP CHTYPE CALL
+ PUSH TP,B
+ PUSHJ P,IREAD1 ;NOW READ STRUCTURE
+ PUSHJ P,RETERR
+ MOVEM C,-3(TP) ; SAVE COMMENT
+ MOVEM D,-2(TP)
+ EXCH A,-1(TP) ;USE AS FIRST ARG
+ EXCH B,(TP)
+ PUSH TP,A ;USE OTHER AS 2D ARG
+ PUSH TP,B
+ MCALL 2,CHTYPE ;ATTEMPT TO MUNG
+RET13: POP TP,D
+ POP TP,C ; RESTORE COMMENT
+RET12: SETOM (P) ; DONT LOOOK FOR MORE!
+ JRST RET
+
+RDTMPL: PUSH P,["}] ; SET UP TERMINATE TEST
+ MOVE B,(TP)
+ PUSHJ P,IGVAL
+ MOVEM A,-1(TP)
+ MOVEM B,(TP)
+ PUSH P,[BLDTMP] ; FLAG FOR VECTOR READING CODE
+ JRST LBRAK2
+
+BLDTMP: ADDI A,1 ; 1 MORE ARGUMENT
+ ACALL A,APPLY ; DO IT TO IT
+ POPJ P,
+
+BYTIN: PUSHJ P,NXTCH ; CHECK FOR OPENR
+ CAIN B,SPATYP
+ PUSHJ P,SPACEQ
+ JRST .+3
+ PUSHJ P,LSTCHR
+ JRST BYTIN
+ CAIE B,TMPTYP
+ ERRUUO EQUOTE BAD-USE-OF-BYTE-STRING
+ PUSH P,["}]
+ PUSH P,[CBYTE1]
+ JRST LBRAK2
+
+CBYTE1: AOJA A,CBYTES
+
+RETERR: SKIPL A,5(TB)
+ MOVEI A,5(TB)-LSTCH ;NO CHANNEL, USE SLOT
+ HRRM B,LSTCH(A) ; RESTORE LAST CHAR
+ PUSHJ P,ERRPAR
+ SOS (P)
+ SOS (P)
+ POPJ P,
+
+\f
+;THIS CODE CALLS IREAD RECURSIVELY TO READ THAT WHICH IS
+;BETWEEN (), ARRIVED AT WHEN ( IS READ
+
+SEGIN: PUSH TP,$TSEG
+ JRST OPNAN1
+
+OPNANG: PUSH TP,$TFORM ;SAVE TYPE
+OPNAN1: PUSH P,[">]
+ JRST LPARN1
+
+LPAREN: PUSH P,[")]
+ PUSH TP,$TLIST ;START BY ASSUMING NIL
+LPARN1: PUSH TP,C%0
+ PUSHJ P,LSTCHR ;DON'T REREAD PARENS
+LLPLOP: PUSHJ P,IREAD1 ;READ IT
+ JRST LDONE ;HIT TERMINATOR
+
+;HERE WHEN MUST ADD CAR TO CURRENT WINNER
+
+GENCAR: PUSH TP,C ; SAVE COMMENT
+ PUSH TP,D
+ MOVE C,A ; SET UP CALL
+ MOVE D,B
+ PUSHJ P,INCONS ; CONS ON TO NIL
+ POP TP,D
+ POP TP,C
+ POP TP,E ;GET CDR
+ JUMPN E,CDRIN ;IF STACKED GOODIE NOT NIL SKIP
+ PUSH TP,B ;AND USE AS TOTAL VALUE
+ PUSH TP,$TLIST ;SAVE THIS AS FIRSST THING ON LIST
+ MOVE A,-2(TP) ; GET REAL TYPE
+ JRST .+2 ;SKIP CDR SETTING
+CDRIN: HRRM B,(E)
+ PUSH TP,B ;CLOBBER IN NEW PARTIAL GOODIE
+ JUMPE C,LLPLOP ; JUMP IF NO COMMENT
+ PUSH TP,C
+ PUSH TP,D
+ MOVSI C,TATOM
+ MOVE D,IMQUOTE COMMENT
+ PUSHJ P,IPUT
+ JRST LLPLOP ;AND CONTINUE
+
+; HERE TO RAP UP LIST
+
+LDONE: CAME B,(P) ;CHECK VALIDITY OF CHARACTER
+ PUSHJ P,MISMAT ;REPORT MISMATCH
+ SUB P, C%11
+ POP TP,B ;GET VALUE OF PARTIAL RESULT
+ POP TP,A ;AND TYPE OF SAME
+ JUMPE B,RET ;VALUE IS NIL, DON'T POP AGAIN
+ POP TP,B ;POP FIRST LIST ELEMENT
+ POP TP,A ;AND TYPE
+ JRST RET
+\f
+;THIS CODE IS SIMILAR TO LIST GENERATING CODE BUT IS FOR VECTORS
+OPNBRA: PUSH P,["}] ; SAVE TERMINATOR
+UVECIN: PUSH P,[135] ; CLOSE SQUARE BRACKET
+ PUSH P,[SETZ IEUVECTOR] ;PUSH NAME OF U VECT HACKER
+ JRST LBRAK2 ;AND GO
+
+LBRACK: PUSH P,[135] ; SAVE TERMINATE
+ PUSH P,[SETZ IEVECTOR] ;PUSH GEN VECTOR HACKER
+LBRAK2: PUSHJ P,LSTCHR ;FORCE READING NEW CHAR
+ PUSH P,C%0 ; COUNT ELEMENTS
+ PUSH TP,$TLIST ; AND SLOT FOR GOODIES
+ PUSH TP,C%0
+
+LBRAK1: PUSHJ P,IREAD1 ;RECURSIVELY READ ELEMENTS OF ARRAY
+ JRST LBDONE ;RAP UP ON TERMINATOR
+
+STAKIT: EXCH A,-1(TP) ; STORE RESULT AND GET CURRENT LIST
+ EXCH B,(TP)
+ AOS (P) ; COUNT ELEMENTS
+ JUMPE C,LBRAK3 ; IF NO COMMENT, GO ON
+ MOVEI E,(B) ; GET CDR
+ PUSHJ P,ICONS ; CONS IT ON
+ MOVEI E,(B) ; SAVE RS
+ MOVSI C,TFIX ; AND GET FIXED NUM
+ MOVE D,(P)
+ PUSHJ P,ICONS
+LBRAK3: PUSH TP,A ; SAVE CURRENT COMMENT LIST
+ PUSH TP,B
+ JRST LBRAK1
+
+; HERE TO RAP UP VECTOR
+
+LBDONE: CAME B,-2(P) ; FINISHED RETURN (WAS THE RIGHT STOP USED?)
+ PUSHJ P,MISMAB ; WARN USER
+ POP TP,1(TB) ; REMOVE COMMENT LIST
+ POP TP,(TB)
+ MOVE A,(P) ; COUNT TO A
+ PUSHJ P,-1@(P) ; MAKE THE VECTOR
+ SUB P,C%33
+
+; PUT COMMENTS ON VECTOR (OR UVECTOR)
+
+ MOVNI C,1 ; INDICATE TEMPLATE HACK
+ CAMN A,$TVEC
+ MOVEI C,1
+ CAMN A,$TUVEC ; SKIP IF UVECTOR
+ MOVEI C,0
+ PUSH P,C ; SAVE
+ PUSH TP,A ; SAVE VECTOR/UVECTOR
+ PUSH TP,B
+
+VECCOM: SKIPN C,1(TB) ; ANY LEFT?
+ JRST RETVEC ; NO, LEAVE
+ MOVE A,1(C) ; ASSUME WINNING TYPES
+ SUBI A,1
+ HRRZ C,(C) ; CDR THE LIST
+ HRRZ E,(C) ; AGAIN
+ MOVEM E,1(TB) ; SAVE CDR
+ GETYP E,(C) ; CHECK DEFFERED
+ MOVSI D,(E)
+ CAIN E,TDEFER ; SKIP IF NOT DEFERRED
+ MOVE C,1(C)
+ CAIN E,TDEFER
+ GETYPF D,(C) ; GET REAL TYPE
+ MOVE B,(TP) ; GET VECTOR POINTER
+ SKIPGE (P) ; SKIP IF NOT TEMPLATE
+ JRST TMPCOM
+ HRLI A,(A) ; COUNTER
+ LSH A,@(P) ; MAYBE SHIFT IT
+ ADD B,A
+ MOVE A,-1(TP) ; TYPE
+TMPCO1: PUSH TP,D
+ PUSH TP,1(C) ; PUSH THE COMMENT
+ MOVSI C,TATOM
+ MOVE D,IMQUOTE COMMENT
+ PUSHJ P,IPUT
+ JRST VECCOM
+
+TMPCOM: MOVSI A,(A)
+ ADD B,A
+ MOVSI A,TTMPLT
+ JRST TMPCO1
+
+RETVEC: SUB P,C%11
+ POP TP,B
+ POP TP,A
+ JRST RET
+
+; BUILD A SINGLE CHARACTER ITEM
+
+SINCHR: PUSHJ P,NXTC1 ;FORCE READ NEXT
+ CAIN B,ESCTYP ;ESCAPE?
+ PUSHJ P,NXTC1 ;RETRY
+ MOVEI B,(A)
+ MOVSI A,TCHRS
+ JRST RETCL
+
+\f
+; HERE ON RIGHT PAREN, BRACKET, ANGLE BRACKET OR CTL C
+
+CLSBRA:
+CLSANG: ;CLOSE ANGLE BRACKETS
+RBRACK: ;COMMON RETURN FOR END OF ARRAY ALSO
+RPAREN: PUSHJ P,LSTCHR ;DON'T REREAD
+EOFCH1: MOVE B,A ;GETCHAR IN B
+ MOVSI A,TCHRS ;AND TYPE IN A
+RET1: SUB P,C%11
+ POPJ P,
+
+EOFCHR: SETZB C,D
+ JUMPL A,EOFCH1 ; JUMP ON REAL EOF
+ JRST RRSUBR ; MAYBE A BINARY RSUBR
+
+DOEOF: MOVE A,[-1,,3]
+ SETZB C,D
+ JRST EOFCH1
+
+
+; NORMAL RETURN FROM IREAD/IREAD1
+
+RETCL: PUSHJ P,LSTCHR ;DONT REREAD
+RET: AOS -1(P) ;SKIP
+ POP P,E ; POP FLAG
+RETC: JUMPL E,RET2 ; DONT LOOK FOR COMMENTS
+ PUSH TP,A ; SAVE ITEM
+ PUSH TP,B
+CHCOMN: PUSHJ P,NXTCH ; READ A CHARACTER
+ CAIE B,COMTYP ; SKIP IF COMMENT
+ JRST CHSPA
+ PUSHJ P,IREAD ; READ THE COMMENT
+ JRST POPAJ
+ MOVE C,A
+ MOVE D,B
+ JRST .+2
+POPAJ: SETZB C,D
+ POP TP,B
+ POP TP,A
+RET2: POPJ P,
+
+CHSPA: CAIN B,SPATYP
+ PUSHJ P,SPACEQ ; IS IT A REAL SPACE
+ JRST POPAJ
+ PUSHJ P,LSTCHR ; FLUSH THE SPACE
+ JRST CHCOMN
+
+;RANDOM MINI-SUBROUTINES USED BY THE READER
+
+;READ A CHAR INTO A AND TYPE CODE INTO D
+
+NXTC3: SKIPL B,5(TB) ;GET CHANNEL
+ JRST NXTPR4 ;NO CHANNEL, GO READ STRING
+ SKIPE LSTCH(B)
+ PUSHJ P,CNTACC ; COUNT ON ACCESS POINTER
+ PUSHJ P,RXCT
+ TRO A,200
+ JRST GETCTP
+
+NXTC1: SKIPL B,5(TB) ;GET CHANNEL
+ JRST NXTPR1 ;NO CHANNEL, GO READ STRING
+ SKIPE LSTCH(B)
+ PUSHJ P,CNTACC ; COUNT ON ACCESS POINTER
+ JRST NXTC2
+NXTC: SKIPL B,5(TB) ;GET CHANNEL
+ JRST NXTPRS ;NO CHANNEL, GO READ STRING
+ SKIPE A,LSTCH(B) ;CHAR IN A IF REUSE
+ JRST PRSRET
+NXTC2: PUSHJ P,RXCT ;GET CHAR FROM INPUT
+ TLO A,200000 ; BIT TO AVOID ^@ LOSSAGE
+ HLLZS 2(TB) ;FLAG INDICATING ONE CHAR LOOK AHEAD
+ MOVEM A,LSTCH(B) ;SAVE THE CHARACTER
+PRSRET: TLZ A,200000
+ TRZE A,400000 ;DONT SKIP IF SPECIAL
+ TRO A,200 ;GO HACK SPECIALLY
+GETCTP: PUSH P,A ;AND SAVE FROM DIVISION
+ ANDI A,377
+ IDIVI A,CHRWD ;YIELDS WORD AND CHAR NUMBER
+ LDB B,BYTPNT(B) ;GOBBLE TYPE CODE
+ POP P,A
+ ANDI A,177 ; RETURN REAL ASCII
+ POPJ P,
+
+NXTPR4: MOVEI F,400000
+ JRST NXTPR5
+
+NXTPRS: SKIPE A,5(TB) ;GET OLD CHARACTER IF ONE EXISTS
+ JRST PRSRET
+NXTPR1: MOVEI F,0
+NXTPR5: MOVE A,11.(TB)
+ HRRZ B,(A) ;GET THE STRING
+ SOJL B,NXTPR3
+ HRRM B,(A)
+ ILDB A,1(A) ;GET THE CHARACTER FROM THE STRING
+ IORI A,(F)
+NXTPR2: MOVEM A,5(TB) ;SAVE IT
+ JRST PRSRET ;CONTINUE
+
+NXTPR3: SETZM 8.(TB)
+ SETZM 9.(TB) ;CLEAR OUT LOCATIVE, AT END OF STRING
+ MOVEI A,400033
+ JRST NXTPR2
+
+; NXTCH AND NXTCH1 ARE SAME AS NXTC AND NXTC1 EXCEPT THEY CHECK !
+; HACKS
+
+NXTCH1: PUSHJ P,NXTC1 ;READ CHAR
+ JRST .+2
+NXTCH: PUSHJ P,NXTC ;READ CHAR
+ PUSHJ P,CHKUS1 ; CHECK FOR USER DISPATCH
+
+ CAIE B,NTYPES+1 ; SKIP IF ! ING NEXT CHAR
+ POPJ P,
+ PUSHJ P,NXTC3 ;READ NEXT ONE
+ HLLOS 2(TB) ;FLAG FOR TWO CHAR LOOK AHEAD
+
+CRMLST: IORI A,400000 ;CLOBBER LASTCHR
+ PUSH P,B
+ SKIPL B,5(TB) ;POINT TO CHANNEL
+ MOVEI B,5(TB)-LSTCH ;NO CHANNEL, POINT AT SLOT
+ HRRM A,LSTCH(B)
+ ANDI A,377777 ;DECREASE CHAR
+ POP P,B
+
+CHKUS2: SKIPN 7(TB) ; SKIP IF USER TABLE
+ POPJ P,
+ MOVEI F,200(A)
+ ASH F,1 ; POINT TO SLOT
+ HRLI F,(F)
+ ADD F,7(TB)
+ JUMPGE F,CPOPJ ;IS THERE VECTOR ENOUGH?
+ SKIPN 1(F) ; NON-ZERO==>USER FCN EXISTS
+ JRST CPOPJ ; HOPE HE APPRECIATES THIS
+ MOVEI B,USTYP2
+CHKRDO: PUSH P,0 ; CHECK FOR REDOING IF CHAR IN TABLE
+ GETYP 0,(F)
+ CAIE 0,TCHRS
+ JRST CHKUS5
+ POP P,0 ;WE ARE TRANSMOGRIFYING
+ MOVE A,1(F) ;GET NEW CHARACTER
+ PUSH P,7(TB)
+ PUSH P,2(TB) ; FLAGS FOR NUM OF CHRS IN LOOK AHEAD
+ PUSH P,5(TB) ; TO AVOID SMASHING LSTCHR
+ SETZM 5(TB) ; CLEAR OUT CHANNEL
+ SETZM 7(TB) ;CLEAR OUT TABLE
+ TRZE A,200 ; ! HACK
+ TRO A,400000 ; TURN ON PROPER BIT
+ PUSHJ P,PRSRET
+ POP P,5(TB) ; GET BACK CHANNEL
+ POP P,2(TB)
+ POP P,7(TB) ;GET BACK OLD PARSE TABLE
+ POPJ P,
+
+CHKUS5: PUSH P,A
+ CAIE 0,TLIST
+ JRST .+4 ; SPECIAL NON-BREAK TYPE HACK
+ MOVNS (P) ; INDICATE BY NEGATIVE
+ MOVE A,1(F) ; GET <1 LIST>
+ GETYP 0,(A) ; AND GET THE TYPE OF THAT
+ CAIE 0,TFIX ; SEE IF HE WANTS SAME CHAR WITH DIFF TYPE
+ JRST CHKUS6 ; JUST A VANILLA HACK
+ MOVE A,1(F) ; PRETEND IT IS SAME TYPE AS NEW CHAR
+ PUSH P,7(TB) ; CLEAR OUT TRANSLATE TABLE
+ PUSH P,2(TB) ; FLAGS FOR # OF CHRS IN LOOK AHEAD
+ SETZM 7(TB)
+ TRZE A,200
+ TRO A,400000 ; TURN ON PROPER BIT IF ! HACK
+ PUSHJ P,PRSRET ; REGET TYPE
+ POP P,2(TB)
+ POP P,7(TB) ; PUT TRANSLATE TABLE BACK
+CHKUS6: SKIPGE -1(P) ; SEE IF A SPECIAL NON-BREAK
+ MOVNS B ; SEXY, HUH?
+ POP P,A
+ POP P,0
+ MOVMS A ; FIX UP A POSITIVE CHARACTER
+ POPJ P,
+
+CHKUS4: POP P,A
+ POPJ P,
+
+CHKUS1: SKIPN 7(TB) ; USER CHECK FOR NOT ! CASE
+ POPJ P,
+ MOVEI F,(A)
+ ASH F,1
+ HRLI F,(F)
+ ADD F,7(TB)
+ JUMPGE F,CPOPJ
+ SKIPN 1(F)
+ POPJ P,
+ MOVEI B,USTYP1
+ JRST CHKRDO ; TRANSMOGRIFY CHARACTER?
+
+CHKUS3: POP P,A
+ POPJ P,
+
+UPLO: POPJ P, ; LETS NOT AND SAY WE USED TO
+ ; AVOID STRANGE ! BLECHAGE
+NXTCS: PUSHJ P,NXTC
+ PUSH P,A ; HACK TO NOT TRANSLATE CHAR
+ PUSHJ P,CHKUS1 ; BUT DO TRANSLATION OF TYPE IF HE WANTS
+ POP P,A ; USED TO BUILD UP STRINGS
+ POPJ P,
+
+CHKALT: CAIN A,33 ;ALT?
+ MOVEI B,MANYT
+ JRST CRMLST
+
+
+TERM: MOVEI B,0 ;RETURN A 0
+ JRST RET1
+ ;AND RETURN
+
+CHKMIN: CAIN A,"- ; IF CHAR IS -, WINNER
+ MOVEI B,PATHTY
+ JRST CRMLST
+
+LOSPAT: PUSHJ P,LSTCHR ; FIX RECURSIVE LOSAGE
+ ERRUUO EQUOTE UNATTACHED-PATH-NAME-SEPARATOR
+
+\f
+; HERE TO SEE IF READING RSUBR
+
+RRSUBR: PUSHJ P,LSTCHR ; FLUSH JUST READ CHAR
+ SKIPL B,5(TB) ; SKIP IF A CHANNEL EXISTS
+ JRST SPACE ; ELSE LIKE A SPACE
+ HRRZ C,BUFSTR(B) ; SEE IF FLAG SAYS START OF RSUBR
+ MOVE C,(C)
+ TRNN C,1 ; SKIP IF REAL RSUBR
+ JRST EOFCH2 ; NO, IGNORE FOR NOW
+
+; REALLY ARE READING AN RSUBR
+
+ HRRZ 0,4(TB) ; GET READ/READB INDICATOR
+ MOVE C,ACCESS(B) ; GET CURRENT ACCESS
+ JUMPN 0,.+3 ; ALREADY WORDS, NO NEED TO DIVIDE
+ ADDI C,4 ; ROUND UP
+ IDIVI C,5
+ PUSH P,C ; SAVE WORD ACCESS
+ MOVEI A,(C) ; COPY IT FOR CALL
+ JUMPN 0,.+3
+ IMULI C,5
+ MOVEM C,ACCESS(B) ; FIXUP ACCESS
+ HLLZS ACCESS-1(B) ; FOR READB LOSER
+ PUSHJ P,DOACCS ; AND GO THERE
+ PUSH P,C%0 ; FOR READ IN
+ HRROI A,(P) ; PREPARE TO READ LENGTH
+ PUSHJ P,DOIOTI ; READ IT
+ POP P,C ; GET READ GOODIE
+ JUMPGE A,.+4 ; JUMP IF WON
+ SUB P,C%11
+EOFCH2: HRROI A,3
+ JRST EOFCH1
+ MOVEI A,(C) ; COPY FOR GETTING BLOCK
+ ADDI C,1 ; COUNT COUNT WORD
+ ADDM C,(P)
+ PUSH TP,$TUVEC ; WILL HOLD UVECTOR OF FIXUPS IF THEY STAY
+ PUSH TP,C%0
+ PUSHJ P,IBLOCK ; GET A BLOCK
+ PUSH TP,$TUVEC
+ PUSH TP,B ; AND SAVE
+ MOVE A,B ; READY TO IOT IT IN
+ MOVE B,5(TB) ; GET CHANNEL BACK
+ MOVSI 0,TUVEC ; SETUP A'S TYPE
+ MOVE PVP,PVSTOR+1
+ MOVEM 0,ASTO(PVP)
+ PUSHJ P,DOIOTI ; IN COMES THE WHOLE BLOCK
+ MOVE PVP,PVSTOR+1
+ SETZM ASTO(PVP) ; A NO LONGER SPECIAL
+ MOVEI C,BUFSTR-1(B) ; NO RESET BUFFER
+ PUSHJ P,BYTDOP ; A POINTS TO DOPW WORD
+ SUBI A,2
+ HRLI A,010700 ; SETUP BYTE POINTER TO END
+ HLLZS BUFSTR-1(B) ; ZERO CHAR COUNNT
+ MOVEM A,BUFSTR(B)
+ HRRZ A,4(TB) ; READ/READB FLG
+ MOVE C,(P) ; ACCESS IN WORDS
+ SKIPN A ; SKIP FOR ASCII
+ IMULI C,5 ; BUMP
+ MOVEM C,ACCESS(B) ; UPDATE ACCESS
+ PUSHJ P,NIREAD ; READ RSUBR VECTOR
+ JRST BRSUBR ; LOSER
+ GETYP A,A ; VERIFY A LITTLE
+ CAIE A,TVEC ; DONT SKIP IF BAD
+ JRST BRSUBR ; NOT A GOOD FILE
+ PUSHJ P,LSTCHR ; FLUSH REREAD CHAR
+ MOVE C,(TP) ; CODE VECTOR BACK
+ MOVSI A,TCODE
+ HLR A,B ; FUNNY COUNT
+ MOVEM A,(B) ; CLOBBER
+ MOVEM C,1(B)
+ PUSH TP,$TRSUBR ; MAKE RSUBR
+ PUSH TP,B
+
+; NOW LOOK OVER FIXUPS
+
+ MOVE B,5(TB) ; GET CHANNEL
+ MOVE C,ACCESS(B)
+ HLLZS ACCESS-1(B) ; FOR READB LOSER
+ HRRZ 0,4(TB) ; READ/READB FLG
+ JUMPN 0,RSUB1
+ ADDI C,4 ; ROUND UP
+ IDIVI C,5 ; TO WORDS
+ MOVEI D,(C) ; FIXUP ACCESS
+ IMULI D,5
+ MOVEM D,ACCESS(B) ; AND STORE
+RSUB1: ADDI C,1 ; ACCOUNT FOR EXTRA COUNTERS
+ MOVEM C,(P) ; SAVE FOR LATER
+ MOVEI A,-1(C) ; FOR DOACS
+ MOVEI C,2 ; UPDATE REAL ACCESS
+ SKIPN 0 ; SKIP FOR READB CASE
+ MOVEI C,10.
+ ADDM C,ACCESS(B)
+ PUSHJ P,DOACCS ; DO THE ACCESS
+ PUSH TP,$TUVEC ; SLOT FOR FIXUP BUFFER
+ PUSH TP,C%0
+
+; FOUND OUT IF FIXUPS STAY
+
+ MOVE B,IMQUOTE KEEP-FIXUPS
+ PUSHJ P,ILVAL ; GET VALUE
+ GETYP 0,A
+ MOVE B,5(TB) ; CHANNEL BACK TO B
+ CAIE 0,TUNBOU
+ CAIN 0,TFALSE
+ JRST RSUB4 ; NO, NOT KEEPING FIXUPS
+ PUSH P,C%0 ; SLOT TO READ INTO
+ HRROI A,(P) ; GET LENGTH OF SAME
+ PUSHJ P,DOIOTI
+ POP P,C
+ MOVEI A,(C) ; GET UVECTOR FOR KEEPING
+ ADDM C,(P) ; ACCESS TO END
+ PUSH P,C ; SAVE LENGTH OF FIXUPS
+ PUSHJ P,IBLOCK
+ MOVEM B,-6(TP) ; AND SAVE
+ MOVE A,B ; FOR IOTING THEM IN
+ ADD B,C%11 ; POINT PAST VERS #
+ MOVEM B,(TP)
+ MOVSI C,TUVEC
+ MOVE PVP,PVSTOR+1
+ MOVEM C,ASTO(PVP)
+ MOVE B,5(TB) ; AND CHANNEL
+ PUSHJ P,DOIOTI ; GET THEM
+ MOVE PVP,PVSTOR+1
+ SETZM ASTO(PVP)
+ MOVE A,(TP) ; GET VERS
+ PUSH P,-1(A) ; AND PUSH IT
+ JRST RSUB5
+
+RSUB4: PUSH P,C%0
+ PUSH P,C%0 ; 2 SLOTS FOR READING
+ MOVEI A,-1(P)
+ HRLI A,-2
+ PUSHJ P,DOIOTI
+ MOVE C,-1(P)
+ MOVE D,(P)
+ ADDM C,-2(P) ; NOW -2(P) IS ACCESS TO END OF FIXUPS
+RSUB5: MOVEI C,BUFSTR-1(B) ; FIXUP BUFFER
+ PUSHJ P,BYTDOP
+ SUBI A,2 ; POINT BEFORE D.W.
+ HRLI A,10700
+ MOVEM A,BUFSTR(B)
+ HLLZS BUFSTR-1(B)
+ SKIPE -6(TP)
+ JRST RSUB2A
+ SUBI A,BUFLNT-1 ; ALSO MAKE AN IOT FLAVOR BUFFER
+ HRLI A,-BUFLNT
+ MOVEM A,(TP)
+ MOVSI C,TUVEC
+ MOVE PVP,PVSTOR+1
+ MOVEM C,ASTO(PVP)
+ PUSHJ P,DOIOTI
+ MOVE PVP,PVSTOR+1
+ SETZM ASTO(PVP)
+RSUB2A: PUSH P,-1(P) ; ANOTHER COPY OF LENGTH OF FIXUPS
+
+; LOOP FIXING UP NEW TYPES
+
+RSUB2: PUSHJ P,WRDIN ; SEE WHAT NEXT THING IS
+ JRST RSUB3 ; NO MORE, DONE
+ JUMPL E,STSQ ; MUST BE FIRST SQUOZE
+ MOVNI 0,(E) ; TO UPDATE AMNT OF FIXUPS
+ ADDB 0,(P)
+ HRLI E,(E) ; IS LENGTH OF STRING IN WORDS
+ ADD E,(TP) ; FIXUP BUFFER POINTER
+ JUMPL E,.+3
+ SUB E,[BUFLNT,,BUFLNT]
+ JUMPGE E,.-1 ; STILL NOT RIGHT
+ EXCH E,(TP) ; FIX UP SLOT
+ HLRE C,E ; FIX BYTE POINTER ALSO
+ IMUL C,[-5] ; + CHARS LEFT
+ MOVE B,5(TB) ; CHANNEL
+ PUSH TP,BUFSTR-1(B)
+ PUSH TP,BUFSTR(B)
+ HRRM C,BUFSTR-1(B)
+ HRLI E,440700 ; AND BYTE POINTER
+ MOVEM E,BUFSTR(B)
+ PUSHJ P,NIREAD ; READ ATOM NAME OF TYPE
+ TDZA 0,0 ; FLAG LOSSAGE
+ MOVEI 0,1 ; WINNAGE
+ MOVE C,5(TB) ; RESET BUFFER
+ POP TP,BUFSTR(C)
+ POP TP,BUFSTR-1(C)
+ JUMPE 0,BRSUBR ; BAD READ OF RSUBR
+ GETYP A,A ; A LITTLE CHECKING
+ CAIE A,TATOM
+ JRST BRSUBR
+ PUSHJ P,LSTCHR ; FLUSH REREAD CHAR
+ HRRZ 0,4(TB) ; FIXUP ACCESS PNTR
+ MOVE C,5(TB)
+ MOVE D,ACCESS(C)
+ HLLZS ACCESS-1(C) ; FOR READB HACKER
+ ADDI D,4
+ IDIVI D,5
+ IMULI D,5
+ SKIPN 0
+ MOVEM D,ACCESS(C) ; RESET
+TYFIXE: PUSHJ P,TYPFND ; SEE IF A LEGAL TYPE NAME
+ JRST TYPFIX ; GO SEE USER ABOUT THIS
+ PUSHJ P,FIXCOD ; GO FIX UP THE CODE
+ JRST RSUB2
+
+; NOW FIX UP SUBRS ETC. IF NECESSARY
+
+STSQ: MOVE B,IMQUOTE MUDDLE
+ PUSHJ P,IGVAL ; GET CURRENT VERS
+ CAME B,-1(P) ; SKIP IF NO FIXUPS NEEDED
+ JRST DOFIX0 ; MUST DO THEM
+
+; ALL DONE, ACCESS PAST FIXUPS AND RETURN
+RSUB31: PUSHJ P,SQUKIL ; DONE FIXING UP, KILL SQUOZE TABLE IF IN INTERP
+RSUB3: MOVE A,-3(P)
+ MOVE B,5(TB)
+ MOVEI C,(A) ; UPDATE CHANNEL ACCESS IN CASE SKIPPING
+ HRRZ 0,4(TB) ; READ/READB FLAG
+ SKIPN 0
+ IMULI C,5
+ MOVEM C,ACCESS(B) ; INTO ACCESS SLOT
+ HLLZS ACCESS-1(B)
+ PUSHJ P,DOACCS ; ACCESSED
+ MOVEI C,BUFSTR-1(B) ; FIX UP BUFFER
+ PUSHJ P,BYTDOP
+ SUBI A,2
+ HRLI A,10700
+ MOVEM A,BUFSTR(B)
+ HLLZS BUFSTR-1(B)
+ SKIPN A,-6(TP) ; SKIP IF KEEPING FIXUPS
+ JRST RSUB6
+ PUSH TP,$TUVEC
+ PUSH TP,A
+ MOVSI A,TRSUBR
+ MOVE B,-4(TP)
+ MOVSI C,TATOM
+ MOVE D,IMQUOTE RSUBR
+ PUSHJ P,IPUT ; DO THE ASSOCIATION
+
+RSUB6: MOVE C,-4(TP) ; DO SPECIAL FIXUPS
+ PUSHJ P,SFIX
+ MOVE B,-2(TP) ; GET RSUBR
+ MOVSI A,TRSUBR
+ SUB P,C%44 ; FLUSH P CRUFT
+ SUB TP,[10,,10]
+ JRST RET
+
+; FIXUP SUBRS ETC.
+
+DOFIX0: SKIPN C,-6(TP) ; GET BUFFER IF KEEPING
+ JRST DOFIXE
+ MOVEM B,(C) ; CLOBBER
+ JRST DOFIXE
+
+FIXUPL: PUSHJ P,WRDIN
+ JRST RSUB31
+DOFIXE: JUMPGE E,BRSUBR
+ TLZ E,740000 ; KILL BITS
+IFN KILTV,[
+ CAME E,[SQUOZE 0,DSTO]
+ JRST NOOPV
+ MOVE E,[SQUOZE 40,DSTORE]
+ MOVE A,(TP)
+ SKIPE -6(TP)
+ MOVEM E,-1(A)
+ MOVEI E,53
+ HRLM E,(A)
+ MOVEI E,DSTORE
+ JRST .+3
+NOOPV:
+]
+ PUSHJ P,SQUTOA ; LOOK IT UP
+ PUSHJ P,BRSUB1
+ MOVEI D,(E) ; FOR FIXCOD
+ PUSHJ P,FIXCOD ; FIX 'EM UP
+ JRST FIXUPL
+
+; BAD SQUOZE, BE MORE SPECIFIC
+
+BRSUB1: PUSHJ P,SQSTR
+ PUSH TP,$TATOM
+ PUSH TP,EQUOTE SQUZE-SYMBOL-NOT-FOUND-ERRET CORRECTION
+ PUSH TP,A
+ PUSH TP,B
+ PUSH TP,$TATOM
+ PUSH TP,MQUOTE READ
+ MCALL 3,ERROR
+ GETYP A,A
+ CAIE A,TFIX
+ ERRUUO EQUOTE VALUE-MUST-BE-FIX
+ MOVE E,B
+ POPJ P,
+
+; CONVERT SQUOZE TO A MUDDLE STRING FOR USER
+
+SQSTR: PUSHJ P,SPTT
+ PUSH P,C
+ CAIN B,6 ; 6 chars?
+ PUSH P,D
+ PUSH P,B
+ PUSHJ P,CHMAK
+ POPJ P,
+
+SPTT: SETZB B,C
+ MOVE A,[440700,,C]
+ MOVEI D,0
+
+SPT1: IDIVI E,50
+ PUSH P,F
+ JUMPE E,SPT3
+ PUSHJ P,SPT1
+SPT3: POP P,E
+ ADDI E,"0-1
+ CAILE E,"9
+ ADDI E,"A-"9-1
+ CAILE E,"Z
+ SUBI E,"Z-"#+1
+ CAIN E,"#
+ MOVEI E,".
+ CAIN E,"/
+SPC: MOVEI E,40
+ IDPB E,A
+ ADDI B,1
+ POPJ P,
+
+
+;0 1-12 13-44 45 46 47
+;NULL 0-9 A-Z . $ %
+
+; ROUTINE TO FIXUP ACTUAL CODE
+
+FIXCOD: MOVEI E,0 ; FOR HWRDIN
+ PUSH P,D ; NEW VALUE
+ PUSHJ P,HWRDIN ; GET HW NEEDED
+ MOVE D,(P) ; GET NEW VAL
+ MOVE A,(TP) ; AND BUFFER POINTER
+ SKIPE -6(TP) ; SAVING?
+ HRLM D,-1(A) ; YES, CLOBBER
+ SUB C,(P) ; DIFFERENCE
+ MOVN D,C
+
+FIXLP: PUSHJ P,HWRDIN ; GET AN OFFSET
+ JUMPE C,FIXED
+ HRRES C ; MAKE NEG IF NEC
+ JUMPL C,LHFXUP
+ ADD C,-4(TP) ; POINT INTO CODE
+IFN KILTV,[
+ LDB 0,[220400,,-1(C)] ; GET INDEX FIELD
+ CAIE 0,7
+ JRST NOTV
+KIND: MOVEI 0,0
+ DPB 0,[220400,,-1(C)]
+ JRST DONTV
+NOTV: CAIE 0,6 ; IS IT PVP
+ JRST DONTV
+ HRRZ 0,-1(C)
+ CAIE 0,12 ; OLD DSTO
+ JRST DONTV
+ MOVEI 0,33.
+ ADDM 0,-1(C)
+ JRST KIND
+DONTV:
+]
+ ADDM D,-1(C)
+ JRST FIXLP
+
+LHFXUP: MOVMS C
+ ADD C,-4(TP)
+ MOVSI 0,(D)
+ ADDM 0,-1(C)
+ JRST FIXLP
+
+FIXED: SUB P,C%11
+ POPJ P,
+
+; ROUTINE TO READ A WORD FROM BUFFER
+
+WRDIN: PUSH P,A
+ PUSH P,B
+ SOSG -3(P) ; COUNT IT DOWN
+ JRST WRDIN1
+ AOS -2(P) ; SKIP RETURN
+ MOVE B,5(TB) ; CHANNEL
+ HRRZ A,4(TB) ; READ/READB SW
+ MOVEI E,5
+ SKIPE A
+ MOVEI E,1
+ ADDM E,ACCESS(B)
+ MOVE A,(TP) ; BUFFER
+ MOVE E,(A)
+ AOBJP A,WRDIN2 ; NEED NEW BUFFER
+ MOVEM A,(TP)
+WRDIN1: POP P,B
+ POP P,A
+ POPJ P,
+
+WRDIN2: MOVE B,-3(P) ; IS THIS LAST WORD?
+ SOJLE B,WRDIN1 ; YES, DONT RE-IOT
+ SUB A,[BUFLNT,,BUFLNT]
+ MOVEM A,(TP)
+ MOVSI B,TUVEC
+ MOVE PVP,PVSTOR+1
+ MOVEM B,ASTO(PVP)
+ MOVE B,5(TB)
+ PUSHJ P,DOIOTI
+ MOVE PVP,PVSTOR+1
+ SETZM ASTO(PVP)
+ JRST WRDIN1
+
+; READ IN NEXT HALF WORD
+
+HWRDIN: JUMPN E,NOIOT ; USE EXISTING WORD
+ PUSH P,-3(P) ; FAKE OUT WRDIN IF NEC.
+ PUSHJ P,WRDIN
+ JRST BRSUBR
+ POP P,-4(P) ; RESET COUNTER
+ HLRZ C,E ; RET LH
+ POPJ P,
+
+NOIOT: HRRZ C,E
+ MOVEI E,0
+ POPJ P,
+
+TYPFIX: PUSH TP,$TATOM
+ PUSH TP,EQUOTE BAD-TYPE-NAME
+ PUSH TP,$TATOM
+ PUSH TP,B
+ PUSH TP,$TATOM
+ PUSH TP,EQUOTE ERRET-TYPE-NAME-DESIRED
+ MCALL 3,ERROR
+ JRST TYFIXE
+
+BRSUBR: ERRUUO EQUOTE RSUBR-IN-BAD-FORMAT
+\f
+
+
+;TABLE OF BYTE POINTERS FOR GETTING CHARS
+
+BYTPNT": 350700,,CHTBL(A)
+ 260700,,CHTBL(A)
+ 170700,,CHTBL(A)
+ 100700,,CHTBL(A)
+ 010700,,CHTBL(A)
+
+;HERE ARE THE TABLES OF CHXRACTERS (NOTE EVERYTHING NOT SPECIFIED IS
+;IN THE NUMBER LETTER CATAGORY)
+
+CHROFF==0 ; USED FOR ! HACKS
+SETCHR NUMCOD,[0123456789]
+
+SETCHR PLUCOD,[+]
+
+SETCHR NEGCOD,[-]
+
+SETCHR ASTCOD,[*]
+
+SETCHR DOTTYP,[.]
+
+SETCHR ETYPE,[Ee]
+
+SETCOD SPATYP,[0,15,12,11,14,40,33] ;ALL ARE TYPE 2 (SPACING - FF,TAB,SPACE,ALT-MODE)
+
+INCRCH LPATYP,[()[]'%"\#<>] ;GIVE THESE INCREASRNG CODES FROM 3
+
+SETCOD EOFTYP,[3] ;^C - EOF CHARACTER
+
+SETCOD SPATYP,[32] ;^Z - TENEX/TOPS-20 EOF (SET IN BOTH TO BE CONSISTENT)
+
+INCRCH COMTYP,[;,{}!] ;COMMENT AND GLOBAL VALUE AND SPECIAL
+
+CHROFF==200 ; CODED AS HAVING 200 ADDED
+
+INCRCH EXCEXC,[!.[]'"<>,-\]
+
+SETCOD MANYT,[33]
+
+CHTBL:
+ OUTTBL ;OUTPUT THE TABLE RIGHT HERE
+
+
+\f; THIS CODE FLUSHES WANDERING COMMENTS
+
+COMNT: PUSHJ P,IREAD
+ JRST COMNT2
+ JRST BDLP
+
+COMNT2: SKIPL A,5(TB) ; RESTORE CHANNEL
+ MOVEI A,5(TB)-LSTCH ;NO CHANNEL, POINT AT SLOT
+ HRRM B,LSTCH(A) ; CLOBBER IN CHAR
+ PUSHJ P,ERRPAR
+ JRST BDLP
+\f
+
+;HERE TO SET UP FOR .FOO ..FOO OR.<ABC>
+
+DOTSTR: PUSHJ P,NXTCH1 ; GOBBLE A NEW CHARACTER
+ MOVEI FF,FRSDOT+DOTSEN+NUMWIN ; SET FLAG IN CASE
+ CAIN B,NUMCOD ; SKIP IF NOT NUMERIC
+ JRST DOTST1 ; NUMERIC, COULD BE FLONUM
+
+; CODE TO HANDLE ALL IMPLICIT CALLS I.E. QUOTE, LVAL, GVAL
+
+ TRZ FF,NUMWIN ; WE ARE NOT A NUMBER
+ MOVSI B,TFORM ; LVAL
+ MOVE A,IMQUOTE LVAL
+ JRST IMPCA1
+
+GLOSEG: SKIPA B,$TSEG ;SEG CALL TO GVAL
+GLOVAL: MOVSI B,TFORM ;FORM CALL TO SAME
+ MOVE A,IMQUOTE GVAL
+ JRST IMPCAL
+
+QUOSEG: SKIPA B,$TSEG ;SEG CALL TO QUOTE
+QUOTIT: MOVSI B,TFORM
+ MOVE A,IMQUOTE QUOTE
+ JRST IMPCAL
+
+SEGDOT: MOVSI B,TSEG ;SEG CALL TO LVAL
+ MOVE A,IMQUOTE LVAL
+IMPCAL: PUSHJ P,LSTCHR ;FLUSH LAST CHAR EXCEPT
+IMPCA1: PUSH TP,$TATOM ;FOR .FOO FLAVOR
+ PUSH TP,A ;PUSH ARGS
+ PUSH P,B ;SAVE TYPE
+ PUSHJ P,IREAD1 ;READ
+ JRST USENIL ; IF NO ARG, USE NIL
+IMPCA2: PUSH TP,C
+ PUSH TP,D
+ MOVE C,A ; GET READ THING
+ MOVE D,B
+ PUSHJ P,INCONS ; CONS TO NIL
+ MOVEI E,(B) ; PREPARE TON CONS ON
+POPARE: POP TP,D ; GET ATOM BACK
+ POP TP,C
+ EXCH C,-1(TP) ; SAVE THAT COMMENT
+ EXCH D,(TP)
+ PUSHJ P,ICONS
+ POP P,A ;GET FINAL TYPE
+ JRST RET13 ;AND RETURN
+
+
+USENIL: PUSH TP,C
+ PUSH TP,D
+ SKIPL A,5(TB) ; RESTOR LAST CHR
+ MOVEI A,5(TB)-LSTCH ;NO CHANNEL, POINT AT SLOT
+ HRRM B,LSTCH(A)
+ MOVEI E,0
+ JRST POPARE
+\f
+;HERE AFTER READING ATOM TO CALL VALUE
+
+.SET: PUSH P,$TFORM ;GET WINNING TYPE
+ MOVE E,(P)
+ PUSHJ P,RETC ; CHECK FOR POSSIBLE COMMENT
+ PUSH TP,$TATOM
+ PUSH TP,IMQUOTE LVAL
+ JRST IMPCA2 ;GO CONS LIST
+
+LOOPA: PUSH P,FF ; SAVE FLAGS IN CASE .ATOM
+LOOPAT: PUSHJ P,NXTCH ; CHECK FOR TRAILER
+ CAIN B,PATHTY ; PATH BEGINNER
+ JRST PATH0 ; YES, GO PROCESS
+ CAIN B,SPATYP ; SPACER?
+ PUSHJ P,SPACEQ ; CHECK FOR REAL SPACE
+ JRST PATH2
+ PUSHJ P,LSTCHR ; FLUSH IT AND RETRY
+ JRST LOOPAT
+PATH0: PUSHJ P,NXTCH1 ; READ FORCED NEXT
+ CAIE B,SPCTYP ; DO #FALSE () HACK
+ CAIN B,ESCTYP
+ JRST PATH4
+ CAIL B,SPATYP ; SPACER?
+ JRST PATH3 ; YES, USE THE ROOT OBLIST
+PATH4: PUSHJ P,NIREA1 ; READ NEXT ITEM
+ PUSHJ P,ERRPAR ; LOSER
+ CAME A,$TATOM ; ONLY ALLOW ATOMS
+ JRST BADPAT
+
+ PUSH TP,A
+ PUSH TP,B
+ MOVSI C,TATOM
+ MOVE D,IMQUOTE OBLIST
+ PUSHJ P,IGET ; GET THE OBLIST
+ ; IF NOT OBLIST, MAKE ONE
+ JUMPN B,PATH6
+ MCALL 1,MOBLIS ; MAKE ONE
+ JRST PATH1
+
+PATH6: SUB TP,C%22
+ JRST PATH1
+
+
+PATH3: MOVE B,ROOT+1 ; GET ROOT OBLIST
+ MOVSI A,TOBLS
+PATH1: POP P,FF ; FLAGS
+ TRNE FF,FRSDOT
+ JRST PATH.
+ PUSHJ P,RLOOKU ; AND LOOK IT UP
+
+ JRST RET
+
+PATH.: PUSHJ P,RLOOKU
+ JRST .SET ; CONS AN LVAL FORM
+
+SPACEQ: ANDI A,-1
+ CAIE A,33
+ CAIN A,400033
+ POPJ P,
+ CAIE A,3
+ AOS (P)
+ POPJ P,
+\f
+
+PATH2: MOVE B,IMQUOTE OBLIST
+ PUSHJ P,IDVAL
+ JRST PATH1
+
+BADPAT: ERRUUO EQUOTE NON-ATOMIC-OBLIST-NAME
+
+\f
+
+; HERE TO READ ONE CHARACTER FOR USER.
+
+CREDC1: SUBM M,(P)
+ PUSH TP,A
+ PUSH TP,B
+ PUSHJ P,IREADC
+ JRST CRDEO1
+ JRST RMPOPJ
+
+CNXTC1: SUBM M,(P)
+ PUSH TP,A
+ PUSH TP,B
+ PUSHJ P,INXTRD
+ JRST CRDEO1
+ JRST RMPOPJ
+
+CRDEO1: MOVE B,(TP)
+ PUSH TP,EOFCND-1(B)
+ PUSH TP,EOFCND(B)
+ PUSH TP,$TCHAN
+ PUSH TP,B
+ MCALL 1,FCLOSE
+ MCALL 1,EVAL
+ JRST RMPOPJ
+
+
+CREADC: SUBM M,(P)
+ PUSH TP,A
+ PUSH TP,B
+ PUSHJ P,IREADC
+ JRST CRDEOF
+ SOS (P)
+ JRST RMPOPJ
+
+CNXTCH: SUBM M,(P)
+ PUSH TP,A
+ PUSH TP,B
+ PUSHJ P,INXTRD
+ JRST CRDEOF
+ SOS (P)
+RMPOPJ: SUB TP,C%22
+ JRST MPOPJ
+
+CRDEOF: .MCALL 1,FCLOSE
+ MOVSI A,TCHRS
+ HRROI B,3
+ JRST MPOPJ
+
+INXTRD: TDZA E,E
+IREADC: MOVEI E,1
+ MOVE B,(TP) ; CHANNEL
+ HRRZ A,-2(B) ; GET BLESS BITS
+ TRNE A,C.BIN
+ TRNE A,C.BUF
+ JRST .+3
+ PUSHJ P,GRB
+ HRRZ A,-2(B)
+ TRC A,C.OPN+C.READ
+ TRNE A,C.OPN+C.READ
+ JRST BADCHN
+ SKIPN A,LSTCH(B)
+ PUSHJ P,RXCT
+ TLO A,200000
+ MOVEM A,LSTCH(B) ; SAVE CHAR
+ CAMN A,C%M1 ; [-1] ; SPECIAL PSEUDO TTY HACK?
+ JRST PSEUDO ; YES, RET AS FIX
+; ANDI A,-1
+ TLZ A,200000
+ TRZN A,400000 ; UNDO ! HACK
+ JRST NOEXCL
+ SKIPE E
+ MOVEM A,LSTCH(B)
+ MOVEI A,"! ; RETURN AN !
+NOEXC1: SKIPGE B,A ; CHECK EOF
+ SOS (P) ; DO EOF RETURN
+ MOVE B,A ; CHAR TO B
+ MOVSI A,TCHRS
+PSEUD1: AOS (P)
+ POPJ P,
+
+PSEUDO: MOVE F,B
+ SKIPE E
+ PUSHJ P,LSTCH2
+ MOVE B,A
+ MOVSI A,TFIX
+ JRST PSEUD1
+
+NOEXCL: JUMPE E,NOEXC1
+ MOVE F,B
+ PUSHJ P,LSTCH2
+ JRST NOEXC1
+
+; READER ERRORS COME HERE
+
+ERRPAR: PUSH TP,$TCHRS ;DO THE OFFENDER
+ PUSH TP,B
+ PUSH TP,$TCHRS
+ PUSH TP,[40] ;SPACE
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOT UNEXPECTED
+ JRST MISMA1
+
+;COMPLAIN ABOUT MISMATCHED CLOSINGS
+
+MISMAB: SKIPA A,["]]
+MISMAT: MOVE A,-1(P) ;GOBBLE THE DESIRED CHARACTER
+ JUMPE B,CPOPJ ;IGNORE UNIVERSAL CLOSE
+ PUSH TP,$TCHRS
+ PUSH TP,B
+ PUSH TP,$TCHSTR
+ PUSH TP,CHQUOT [ INSTEAD-OF ]
+ PUSH TP,$TCHRS
+ PUSH TP,A
+MISMA1: MCALL 3,STRING
+ PUSH TP,$TATOM
+ PUSH TP,EQUOTE READER-SYNTAX-ERROR-ERRET-ANYTHING-TO-GO-ON
+ PUSH TP,A
+ PUSH TP,B
+ PUSH TP,$TATOM
+ PUSH TP,MQUOTE READ
+ MCALL 3,ERROR
+CPOPJ: POPJ P,
+\f
+; HERE ON BAD INPUT CHARACTER
+
+BADCHR: ERRUUO EQUOTE BAD-ASCII-CHARACTER
+
+; HERE ON YUCKY PARSE TABLE
+
+BADPTB: ERRUUO EQUOTE BAD-MACRO-TABLE
+
+BDPSTR: ERRUUO EQUOTE BAD-PARSE-STRING
+
+ILLSQG: PUSHJ P,LSTCHR ; DON'T MESS WITH IT AGAIN
+ ERRUUO EQUOTE BAD-USE-OF-SQUIGGLY-BRACKETS
+
+
+;FLOATING POINT NUMBER TOO LARGE OR SMALL
+FOOR: ERRUUO EQUOTE NUMBER-OUT-OF-RANGE
+
+
+NILSXP: 0,,0
+
+LSTCHR: SKIPL F,5(TB) ;GET CHANNEL
+ JRST LSTCH1 ;NO CHANNEL, POINT AT SLOT
+
+LSTCH2: SKIPE LSTCH(F) ;ARE WE REALLY FLUSHING A REUSE CHARACTER ?
+ PUSHJ P,CNTACX
+ SETZM LSTCH(F)
+ POPJ P,
+
+LSTCH1: SETZM 5(TB) ;ZERO THE LETTER AND RETURN
+ POPJ P,
+
+CNTACC: MOVE F,B
+CNTACX: HRRZ G,-2(F) ; GET BITS
+ TRNE G,C.BIN
+ JRST CNTBIN
+ AOS ACCESS(F)
+CNTDON: POPJ P,
+
+CNTBIN: AOS G,ACCESS-1(F)
+ CAMN G,[TFIX,,1]
+ AOS ACCESS(F)
+ CAMN G,[TFIX,,5]
+ HLLZS ACCESS-1(F)
+ POPJ P,
+
+
+;TABLE OF NAMES OF ARGS AND ALLOWED TYPES
+
+ARGS:
+ IRP A,,[[[CAIN C,TUNBOU]],[[CAIE C,TCHAN],INCHAN],[[PUSHJ P,CHOBL],OBLIST]]
+ IRP B,C,[A]
+ B
+ IFSN [C],IMQUOTE C
+ .ISTOP
+ TERMIN
+ TERMIN
+
+CHOBL: CAIE C,TLIST ;A LIST OR AN OBLIST
+ CAIN C,TOBLS
+ AOS (P)
+ POPJ P,
+
+END
+
+\f
\ No newline at end of file
projects / pdp10-muddle.git / blobdiff