X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;ds=sidebyside;f=%3Cmdl.int%3E%2Freader.mid.356;fp=%3Cmdl.int%3E%2Freader.mid.356;h=db5cb35c0bbc9b5c4f9cf0cff4511ba43adde1cb;hb=bab072f950a643ac109660a223b57e635492ac25;hp=0000000000000000000000000000000000000000;hpb=233a3c5245f8274882cc9d27a3c20e9b3678000c;p=pdp10-muddle.git

diff --git a/<mdl.int>/reader.mid.356 b/<mdl.int>/reader.mid.356
new file mode 100644
index 0000000..db5cb35
--- /dev/null
+++ b/<mdl.int>/reader.mid.356
@@ -0,0 +1,2203 @@
+
+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>
+
+
+; 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
+
+
+
+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
+
+MFUNCTION 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
+
+; 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
+;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?
+
+
+;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
+
+
+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,
+
+
+;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
+
+;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
+
+
+; 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
+
+
+; 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
+
+
+
+;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
+
+
+; 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
+
+
+;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
+
+;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,
+
+
+PATH2:	MOVE	B,IMQUOTE OBLIST
+	PUSHJ	P,IDVAL
+	JRST	PATH1
+
+BADPAT:	ERRUUO	EQUOTE NON-ATOMIC-OBLIST-NAME
+
+
+
+; 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,
+
+; 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
+
+
\ No newline at end of file