X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=sumex%2Freader.mcr264;fp=sumex%2Freader.mcr264;h=5468f072953ab397085262851e19ca209db6bf98;hp=0000000000000000000000000000000000000000;hb=1c973408824dee4a587c040bc8075cd1bf047ba3;hpb=a3df309bdd1ea54242d39e62403548d1e4845f8e

diff --git a/sumex/reader.mcr264 b/sumex/reader.mcr264
new file mode 100644
index 0000000..5468f07
--- /dev/null
+++ b/sumex/reader.mcr264
@@ -0,0 +1,2121 @@
+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
+
+.INSRT MUDDLE >
+
+.GLOBAL CONS,VECTOR,NXTCHR,RLOOKU,CRADIX,SPTIME,QUOTE,TENTAB,CHMAK,FLUSCH,ITENTB
+.GLOBAL SETDEV,OPNCHN,ILVAL,RADX,IDVAL,LSTCH,EVECTOR,EUVECTOR,CHUNW
+.GLOBAL CHRWRD,EOFCND,DIRECT,ACCESS,IOINS,ROOT,DIRECT,DOIOTI,DOACCS,IGVAL,BYTDOP
+.GLOBAL ICONS,INCONS,IEVECT,IEUVEC,BUFSTR,TYPFND,SQUTOA,IBLOCK,GRB
+.GLOBAL BADCHN,WRONGD,CHNCLS,FNFFL,IPUT,IGET,ILOC,RXCT,WXCT,IUNWIN,UNWIN2
+.GLOBAL CNXTCH,CREADC,MPOPJ,CREDC1,CNXTC1,IREMAS
+
+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
+IFN FRMSIN,[
+	FRSDOT==1000			;. CAME FIRST
+	USEAGN==2000			;SPECIAL DOT HACK
+]
+OCTWIN==4000
+OCTSTR==10000
+
+;TEMPORARY OFFSETS
+
+VCNT==0	;NUMBER OF ELEMENTS IN CURRENT VECTOR
+ONUM==1	;CURRENT NUMBER IN OCTAL
+DNUM==3	;CURRENT NUMBER IN DECIMAL
+FNUM==5	;CURRENTLY UNUSED
+CNUM==7	;IN CURRENT RADIX
+NDIGS==11	;NUMBER OF DIGITS
+ENUM==13 ;EXPONENT
+
+
+; 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,[-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,[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,[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,[IREAD1]	;WHERE TO GO AFTER BINDING
+READ0:	PUSH	TP,$TTP		;SLOT FOR LAST THING READ (TYPE IS UNREADABLE)
+	PUSH	TP,[0]
+	PUSH	TP,$TFIX	;SLOT FOR RADIX
+	PUSH	TP,[0]
+	PUSH	TP,$TCHAN	;AND SLOT FOR CHANNEL
+	PUSH	TP,[0]
+	PUSH	TP,[0]		; USER DISP SLOT
+	PUSH	TP,[0]
+	PUSH	TP,$TSPLICE
+	PUSH	TP,[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,[0]		;DUMMY
+	PUSH	TP,[0]
+	MOVE	B,1(AB)		;GET CHANNEL POINTER
+	ADD	AB,[2,,2]	;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,[2,,2]
+	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,[0]		;DUMMY
+	PUSH	TP,[0]
+	ADD	AB,[2,,2]	;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,[0]
+	PUSH	TP,[0]
+	ADD	AB,[2,,2]	; BUMP TO NEXT ARG
+	JUMPL	AB,TMA		;MORE ?, ERROR
+BINDEM:	PUSHJ	P,SPECBIND
+	JRST	READ1
+
+MFUNCTION RREADC,SUBR,READCHR
+
+	ENTRY
+	PUSH	P,[IREADC]
+	JRST	READC0		;GO BIND VARIABLES
+
+MFUNCTION NXTRDC,SUBR,NEXTCHR
+
+	ENTRY
+
+	PUSH	P,[INXTRD]
+READC0:	CAMGE	AB,[-5,,]
+	JRST	TMA
+	PUSH	TP,(AB)
+	PUSH	TP,1(AB)
+	JUMPL	AB,READC1
+	MOVE	B,IMQUOTE INCHAN
+	PUSHJ	P,IDVAL
+	GETYP	A,A
+	CAIE	A,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,[-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:	PUSH	TP,$TATOM
+	PUSH	TP,EQUOTE CAN'T-PARSE
+	JRST	CALER1
+
+MFUNCTION LPARSE,SUBR
+
+	ENTRY
+
+	PUSHJ	P,GAPRS		;GET THE ARGS TO THE PARSE
+	JRST	LPRS1
+
+GAPRS:	PUSH	TP,$TTP
+	PUSH	TP,[0]
+	PUSH	TP,$TFIX
+	PUSH	TP,[10.]
+	PUSH	TP,$TFIX
+	PUSH	TP,[0]		; LETTER SAVE
+	PUSH	TP,[0]
+	PUSH	TP,[0]		; PARSE TABLE MAYBE?
+	PUSH	TP,$TSPLICE
+	PUSH	TP,[0]		;SEGMENT FOR SPLICING MACROS
+	PUSH	TP,[0]		;SLOT FOR LOCATIVE TO STRING
+	PUSH	TP,[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,[0]
+	PUSH	TP,[0]
+	PUSHJ	P,SPECBIND
+	ADD	AB,[2,,2]
+	JUMPGE	AB,USPSTR
+	GETYP	0,(AB)
+	CAIE	0,TFIX
+	JRST	WTYP2
+	MOVE	0,1(AB)
+	MOVEM	0,3(TB)
+	ADD	AB,[2,,2]
+	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,[0]
+	PUSH	TP,[0]
+	PUSHJ	P,SPECBIND
+	ADD	AB,[2,,2]
+	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,[0]
+	PUSH	TP,[0]
+	PUSHJ	P,SPECBIND
+	ADD	AB,[2,,2]
+	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,[2,,2]
+	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,[0]		; HERE WE ARE MAKE PLACE TO SAVE GOODIES
+	PUSH	TP,$TLIST
+	PUSH	TP,[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,-4(B)
+	TRC	A,C.OPN+C.READ
+	TRNE	A,C.OPN+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:	MOVE	D,LSTCH(B)	;ANY CHARS AROUND?
+	MOVEI	0,33
+	CAIN	D,400033	;FLUSH THE TERMINATOR HACK
+	MOVEM	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,[1,,1]	;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,MQUOTE 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,MQUOTE 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,-4(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,[-1]		; DONT GOBBLE COMMENTS
+	JRST	IREAD2
+
+IREAD:
+	PUSHJ	P,LSTCHR	;DON'T REREAD LAST CHARACTER
+IREAD1:	PUSH	P,[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:	NUMLET			;HERE IF NUMBER OR LETTER
+	NUMLET			;NUMBER
+NUMCOD==.-DTBL
+	NUMLET			;+-
+PLUMIN==.-DTBL
+	NUMLET			;.
+DOTTYP==.-DTBL
+	NUMLET			;E
+NONSPC==.-DTBL	;NUMBER OF NON-SPECIAL CHARACTERS
+	SPACE			;SPACING CHAR CR,LF,SP,TAB ETC.
+SPATYP==.-DTBL	;TYPE FOR SPACE CHARS
+
+
+;THE FOLLOWING ENTRIES ARE VARIOUS PUNCTUATION CROCKS
+
+	LPAREN			;( - BEGIN LIST
+	RPAREN			;) - END CURRENT LEVEL OF INPUT
+	LBRACK			;[ -BEGIN ARRAY
+LBRTYP==.-DTBL
+	RBRACK			;] - END OF ARRAY
+	QUOTIT			;' - QUOTE THE FOLLOWING GOODIE
+QUOTYP==.-DTBL
+
+	MACCAL			;% - INVOKE A READ TIME MACRO
+MACTYP==.-DTBL
+	CSTRING			;" - CHARACTER STRING
+CSTYP==.-DTBL
+	NUMLET			;\ - ESCAPE,BEGIN ATOM
+
+ESCTYP==.-DTBL	;TYPE OF ESCAPE CHARACTER
+
+	SPECTY			;# - SPECIAL TYPE TO BE READ
+SPCTYP==.-DTBL
+	OPNANG			;< - BEGIN ELEMENT CALL
+
+SLMNT==.-DTBL	;TYPE OF START OF SEGMENT
+
+	CLSANG			;> - END ELEMENT CALL
+
+
+	EOFCHR			;^C - END OF FILE
+
+	COMNT			;; - BEGIN COMMENT
+COMTYP==.-DTBL	;TYPE OF START OF COMMENT
+
+	GLOVAL			;, - GET GLOBAL VALUE
+GLMNT==.-DTBL
+	ILLSQG			;{ - START TEMPLATE STRUCTURE
+TMPTYP==.-DTBL
+	CLSBRA			;} - END TEMPLATE STRUCTURE
+
+NTYPES==.-DTBL
+
+
+
+; EXTENDED TABLE FOR ! HACKS
+
+	NUMLET			; !! FAKE OUT
+	SEGDOT			;!. - CALL TO LVAL (SEG)
+DOTEXT==.-DTBL
+	UVECIN			;![ - INPUT UNIFORM VECTOR ]
+LBREXT==.-DTBL
+	QUOSEG			;!' - SEG CALL TO QUOTE
+QUOEXT==.-DTBL
+	SINCHR			;!" - INPUT ONE CHARACTER
+CSEXT==.-DTBL
+	SEGIN			;!< - SEG CALL
+SLMEXT==.-DTBL
+	GLOSEG			;!, - SEG CALL TO GVAL
+GLMEXT==.-DTBL
+	LOSPATH			;!- - PATH NAME SEPARATOR
+PATHTY==.-DTBL
+	TERM			;!$ - (EXCAL-ALT MODE) PUT ALL CLOSES
+MANYT==.-DTBL
+	USRDS1			; DISPATCH FOR USER TABLE (NO !)
+USTYP1==.-DTBL
+	USRDS2			;   "       "   "     "   (WITH !)
+USTYP2==.-DTBL
+ENTYPE==.-DTBL
+
+
+
+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
+	HRRM	SP,(TP)		; BUILD A TBVL
+	MOVE	SP,TP
+	PUSH	TP,C
+	PUSH	TP,(C)
+	PUSH	TP,1(C)
+	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
+	HRRZ	SP,(SP)		; UNBIND MANUALLY
+	MOVEI	D,(TP)
+	SUBI	D,(SP)
+	MOVSI	D,(D)
+	HLL	SP,TP
+	SUB	SP,D
+	SUB	TP,[4,,4]	; FLUSH TP CRAP
+	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
+
+NUMLET:	PUSHJ	P,GOBBLE	;READ IN THE ATOM AND PUT PNTR ON ARG PDL
+	JRST	RET		;NO SKIP RETURN I.E. NON NIL
+
+;HERE TO START BUILDING A CHARACTER STRING GOODIE
+
+CSTRING:	PUSHJ	P,GOBBL1	;READ IN STRING
+	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
+	JRST	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)
+	JRST	RETERR
+	PUSH	TP,A
+	PUSH	TP,B
+	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
+	JRST	RETER1
+	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,
+
+RETER1:	SUB	TP,[2,,2]
+RETERR:	SKIPL	A,5(TB)
+	MOVEI	A,5(TB)-LSTCH	;NO CHANNEL, USE SLOT
+	MOVEM	B,LSTCH(A)	; RESTORE LAST CHAR
+	PUSHJ	P,ERRPAR
+	JRST	RET1
+
+;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,[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,MQUOTE 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, [1,,1]
+	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,[IEUVECTOR]	;PUSH NAME OF U VECT HACKER
+	JRST	LBRAK2		;AND GO
+
+LBRACK:	PUSH	P,[135]		; SAVE TERMINATE
+	PUSH	P,[IEVECTOR]	;PUSH GEN VECTOR HACKER
+LBRAK2:	PUSHJ	P,LSTCHR	;FORCE READING NEW CHAR
+	PUSH	P,[0]		; COUNT ELEMENTS
+	PUSH	TP,$TLIST	; AND SLOT FOR GOODIES
+	PUSH	TP,[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,[3,,3]	
+
+; 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,MQUOTE COMMENT
+	PUSHJ	P,IPUT
+	JRST	VECCOM
+
+TMPCOM:	MOVSI	A,(A)
+	ADD	B,A
+	MOVSI	A,TTMPLT
+	JRST	TMPCO1
+
+RETVEC:	SUB	P,[1,,1]
+	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,[1,,1]
+	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
+
+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
+	HLLZS	2(TB)		;FLAG INDICATING ONE CHAR LOOK AHEAD
+	MOVEM	A,LSTCH(B)	;SAVE THE CHARACTER
+PRSRET:	TRZE	A,400000	;DONT SKIP IF SPECIAL
+	JRST	RETYPE		;GO HACK SPECIALLY
+GETCTP:	CAILE	A,177		; CHECK RANGE
+	JRST	BADCHR
+	PUSH	P,A	;AND SAVE FROM DIVISION
+	ANDI	A,177
+	IDIVI	A,CHRWD	;YIELDS WORD AND CHAR NUMBER
+	LDB	B,BYTPNT(B)	;GOBBLE TYPE CODE
+	POP	P,A
+	POPJ	P,
+
+NXTPRS:	SKIPE	A,5(TB)		;GET OLD CHARACTER IF ONE EXISTS
+	JRST	PRSRET
+NXTPR1:	MOVEI	A,400033
+	PUSH	P,C
+	MOVE	C,11.(TB)
+	HRRZ	B,(C)		;GET THE STRING
+	SOJL	B,NXTPR3
+	HRRM	B,(C)
+	ILDB	A,1(C)	;GET THE CHARACTER FROM THE STRING
+NXTPR2:	MOVEM	A,5(TB)		;SAVE IT
+	POP	P,C
+	JRST	PRSRET		;CONTINUE
+NXTPR3:	SETZM	8.(TB)
+	SETZM	9.(TB)		;CLEAR OUT LOCATIVE, AT END OF STRING
+	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
+	CAIGE	B,NTYPES+1	;IF 1 > THAN MAX, MUST BE SPECIAL
+	JRST	CHKUS1		; CHECK FOR USER DISPATCH
+
+	CAIN	B,NTYPES+1	;FOR OBSCURE BUG FOUND BY MSG
+	PUSHJ	P,NXTC1		;READ NEXT ONE
+	HLLOS	2(TB)		;FLAG FOR TWO CHAR LOOK AHEAD
+
+RETYP1:	CAIN	A,".		;!.
+	MOVEI	B,DOTEXT	;YES, GET EXTENDED TYPE
+	CAIN	A,"[
+	MOVEI	B,LBREXT
+	CAIN	A,"'
+	MOVEI	B,QUOEXT
+	CAIN	A,""
+	MOVEI	B,CSEXT
+	CAIN	A,"-
+	MOVEI	B,PATHTY
+	CAIN	A,"<
+	MOVEI	B,SLMEXT
+	CAIN	A,",
+	MOVEI	B,GLMEXT
+	CAIN	A,33
+	MOVEI	B,MANYT		;! ALTMODE
+
+CRMLST:	ADDI	A,400000		;CLOBBER LASTCHR
+	PUSH	P,B
+	SKIPL	B,5(TB)		;POINT TO CHANNEL
+	MOVEI	B,5(TB)-LSTCH	;NO CHANNEL, POINT AT SLOT
+	MOVEM	A,LSTCH(B)
+	SUBI	A,400000		;DECREASE CHAR
+	POP	P,B
+
+CHKUS2:	SKIPN	7(TB)		; SKIP IF USER TABLE
+	JRST	UPLO
+	PUSH	P,A
+	ADDI	A,200
+	ASH	A,1		; POINT TO SLOT
+	HRLS	A
+	ADD	A,7(TB)
+	SKIPL	A		;IS THERE VECTOR ENOUGH?
+	JRST	CHKUS4
+	SKIPN	1(A)		; NON-ZERO==>USER FCN EXISTS
+	JRST	CHKUS4		; HOPE HE APPRECIATES THIS
+	MOVEI	B,USTYP2
+CHKRDO:	PUSH	P,0		; CHECK FOR REDOING IF CHAR IN TABLE
+	GETYP	0,(A)
+	CAIE	0,TCHRS
+	JRST	CHKUS5
+	POP	P,0		;WE ARE TRANSMOGRIFYING
+	POP	P,(P)		;FLUSH OLD CHAR
+	MOVE	A,1(A)		;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:	CAIE	0,TLIST
+	JRST	.+4		; SPECIAL NON-BREAK TYPE HACK
+	MOVNS	-1(P)		; INDICATE BY NEGATIVE 
+	MOVE	A,1(A)		; 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(A)		; 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,0
+	POP	P,A
+	MOVMS	A		; FIX UP A POSITIVE CHARACTER
+	POPJ	P,
+
+CHKUS4:	POP	P,A
+	JRST	UPLO
+
+CHKUS1:	SKIPN	7(TB)		; USER CHECK FOR NOT ! CASE
+	POPJ	P,
+	PUSH	P,A
+	ASH	A,1
+	HRLS	A
+	ADD	A,7(TB)
+	SKIPL	A
+	JRST	CHKUS3
+	SKIPN	1(A)
+	JRST	CHKUS3
+	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
+
+RETYPE:	PUSHJ	P,GETCTP	;GET TYPE OF CHAR
+	JRST	RETYP1
+
+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
+	PUSH	TP,$TATOM
+	PUSH	TP,EQUOTE UNATTACHED-PATH-NAME-SEPARATOR
+	JRST	CALER1
+
+
+; 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
+	MOVE	C,@BUFSTR(B)	; SEE IF FLAG SAYS START OF RSUBR
+	TRNN	C,1		; SKIP IF REAL RSUBR
+	JRST	SPACE		; 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,[0]		; FOR READ IN
+	HRROI	A,(P)		; PREPARE TO READ LENGTH
+	PUSHJ	P,DOIOTI	; READ IT
+	POP	P,C		; GET READ GOODIE
+	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,[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
+	MOVEM	0,ASTO(PVP)
+	PUSHJ	P,DOIOTI		; IN COMES THE WHOLE BLOCK
+	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,[0]
+
+; FOUND OUT IF FIXUPS STAY
+
+	MOVE	B,MQUOTE 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,[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,[1,,1]	; POINT PAST VERS #
+	MOVEM	B,(TP)
+	MOVSI	C,TUVEC
+	MOVEM	C,ASTO(PVP)
+	MOVE	B,5(TB)		; AND CHANNEL
+	PUSHJ	P,DOIOTI		; GET THEM
+	SETZM	ASTO(PVP)
+	MOVE	A,(TP)		; GET VERS
+	PUSH	P,-1(A)		; AND PUSH IT
+	JRST	RSUB5
+
+RSUB4:	PUSH	P,[0]
+	PUSH	P,[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
+	MOVEM	C,ASTO(PVP)
+	PUSHJ	P,DOIOTI
+	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,MQUOTE 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
+
+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,MQUOTE RSUBR
+	PUSHJ	P,IPUT		; DO THE ASSOCIATION
+
+RSUB6:	MOVE	B,-2(TP)	; GET RSUBR
+	MOVSI	A,TRSUBR
+	SUB	P,[4,,4]	; 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	RSUB3
+DOFIXE:	JUMPGE	E,BRSUBR
+	TLZ	E,740000	; KILL BITS
+	PUSHJ	P,SQUTOA	; LOOK IT UP
+	JRST	BRSUBR
+	MOVEI	D,(E)		; FOR FIXCOD
+	PUSHJ	P,FIXCOD	; FIX 'EM UP
+	JRST	FIXUPL
+
+; 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
+	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,[1,,1]
+	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
+	MOVEM	B,ASTO(PVP)
+	MOVE	B,5(TB)
+	PUSHJ	P,DOIOTI
+	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:	PUSH	TP,$TATOM
+	PUSH	TP,EQUOTE RSUBR-IN-BAD-FORMAT
+	JRST	CALER1
+
+
+
+;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)
+
+SETCHR 2,[0123456789]
+
+SETCHR 3,[+-]
+
+SETCHR 4,[.]
+
+SETCHR 5,[Ee]
+
+SETCOD 6,[15,12,11,14,40,33]	;ALL ARE TYPE 2 (SPACING - FF,TAB,SPACE,ALT-MODE)
+
+INCRCH 7,[()[]'%"\#<>]	;GIVE THESE INCREASRNG CODES FROM 3
+
+SETCOD 22,[3]	;^C - EOF CHARACTER
+
+INCRCH 23,[;,{}!]		;COMMENT AND GLOBAL VALUE AND SPECIAL
+
+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
+	MOVEM	B,LSTCH(A)	; CLOBBER IN CHAR
+	PUSHJ	P,ERRPAR
+	JRST	BDLP
+
+;SUBROUTINE TO READ CHARS ONTO STACK
+
+GOBBL1:	MOVEI	FF,0		;KILL ALL FLAGS
+	PUSHJ	P,LSTCHR	;DON'T REREAD "
+	TROA	FF,NOTNUM+INSTRN	;SURPRESS NUMBER CONVERSION
+GOBBLE:	MOVEI	FF,0		;FLAGS CONCERRNING CURRENT GOODIE IN HERE
+	MOVE	A,TP		;GOBBLE CURRENT TP TO BE PUSHED
+	MOVEI	C,6		;NOW PUSH 6 0'S ON TO STACK
+	PUSH	TP,$TFIX	;TYPE IS FIXED
+	PUSH	TP,FF		;AND VALUE IS 0
+	SOJG	C,.-2		;FOUR OF THEM
+	PUSH	TP,$TTP		;NOW SAVE OLD TP
+	ADD	A,[1,,1]	;MAKE IT LOOK LIKE A TB
+	PUSH	TP,A
+	MOVEI	D,0		;ZERO OUT CHARACTER COUNT
+GOB1:	MOVSI	C,(<440700,,(P)>)	;SET UP FIRST WORD OF CHARS
+	PUSH	P,[0]		;BYTE POINTER
+GOB2:	PUSH	P,FF		;SAVE FLAG REGISTER
+	INTGO			; IN CASE P OVERFLOWS
+	MOVEI	A,NXTCH
+	TRNE	FF,INSTRN
+	MOVEI	A,NXTCS		; HACK TO GET MAYBE NEW TYPE WITHOUT CHANGE
+	PUSHJ	P,(A)
+	POP	P,FF		;AND RESTORE FLAG REGISTER
+	CAIN	B,ESCTYP	;IS IT A CHARACTER TO BE ESCAPED
+	JRST	ESCHK		;GOBBLE THE ESCAPED CHARACTER
+	TRNE	FF,INSTRN	;ARE WE BUILDING A CHAR STRING
+	JRST	ADSTRN		;YES, GO READ IN
+	CAILE	B,NONSPC	;IS IT SPECIAL
+	JRST	DONEG		;YES, RAP THIS UP
+
+	TRNE	FF,NOTNUM	;IS  NUMERIC STILL WINNING
+	JRST	SYMB2		;NO, ONLY DO CHARACTER HACKING
+	CAIL	A,60		;CHECK FOR DIGIT
+	CAILE	A,71
+	JRST	SYMB1	;NOT A DIGIT
+	JRST	CNV		;GO CONVERT TO NUMBER
+CNV:
+
+;ARRIVE HERE IF STILL BUILDING A NUMBER
+CNV:	MOVE	B,(TP)	;GOBBLE POINTER TO TEMPS
+	TRO	FF,NUMWIN	;SAY DIGITSSEEN
+	SUBI	A,60	;CONVERT TO  A NUMBER
+	TRNE	FF,EFLG	;HAS E BEEN SEEN
+	JRST	ECNV		;YES, CONVERT EXPONENT
+	TRNE	FF,DOTSEN	;HAS A DOT BEEN SEEN
+
+	JRST	DECNV		;YES, THIS IS A FLOATING NUMBER
+
+	MOVE	E,ONUM(B)	; OCTAL CONVERT
+	LSH	E,3
+	ADDI	E,(A)
+	MOVEM	E,ONUM(B)
+	TRNE	FF,OCTSTR	; SKIP OTHER CONVERSIONS IF OCTAL FORCE
+	JRST	CNV1
+
+	JFCL	17,.+1	;KILL ALL FLAGS
+	MOVE	E,CNUM(B)	;COMPUTE CURRENT RADIX
+	IMUL	E,3(TB)
+	ADD	E,A	;ADD IN CURRENT DIGIT
+	JFCL	10,.+2
+	MOVEM	E,CNUM(B)	;AND SAVE IT
+
+
+
+;INSERT OCTAL AND CRADIX CROCK HERE IF NECESSSARY
+	JRST	DECNV1		;CONVERT TO DECIMAL(FIXED)
+
+
+DECNV:	TRO	FF,FLONUM	;SET FLOATING FLAG
+DECNV1:	JFCL	17,.+1	;CLEAR ALL FLAGS
+	MOVE 	E,DNUM(B)	;GET DECIMAL NUMBER
+	IMULI	E,10.
+	JFCL	10,CNV2	;JUMP IF OVERFLOW
+	ADD	E,A	;ADD IN DIGIT
+	MOVEM	E,DNUM(B)
+	TRNE	FF,FLONUM	;IS THIS FRACTION?
+	SOS	NDIGS(B)	;YES, DECREASE EXPONENT BY ONE
+
+CNV1:	PUSHJ	P,NXTCH		;RE-GOBBLE CHARACTER
+	JRST	SYMB2		;ALSO DEPOSIT INTO SYMBOL BEING MADE
+CNV2:				;OVERFLOW IN DECIMAL NUMBER
+	TRNE	FF,DOTSEN	;IS THIS FRACTION PART?
+	JRST	CNV1		;YES,IGNORE DIGIT
+	AOS	NDIGS(B)	;NO, INCREASE IMPLICIT EXPONENT BY ONE
+	TRO	FF,FLONUM	;SET FLOATING FLAG BUT 
+	JRST	CNV1		;DO NOT FORCE DECIMAL(DECFRC)
+
+ECNV:			;CONVERT A DECIMAL EXPONENT
+	HRRZ	E,ENUM(B)	;GET EXPONENT
+	IMULI	E,10.
+	ADD	E,A		;ADD IN DIGIT
+	TLNN	E,777777	;IF OVERFLOW INTO LEFT HALF
+	HRRM	E,ENUM(B)	;DO NOT STORE(CATCH ERROR LATER)
+	JRST	CNV1
+	JRST	SYMB2		;ALSO DEPOSIT INTO SYMBOL BEING MADE
+
+
+;HERE TO PUT INTO IDENTIFIER BEING BUILT
+
+ESCHK:	PUSHJ	P,NXTC1		;GOBBLE NEXT CHAR
+SYMB:	MOVE	B,(TP)		;GET BACK TEM POINTER
+	TRNE	FF,EFLG		;IF E FLAG SET
+	HLRZ	FF,ENUM(B)	;RESTORE SAVED FLAGS
+	TRO	FF,NOTNUM	;SET NOT NUMBER FLAG
+SYMB2:	TRO	FF,NFIRST	;NOT FIRST IN WORLD
+SYMB3:	IDPB	A,C		;INSERT IT
+	PUSHJ	P,LSTCHR	;READ NEW CHARACTER
+	TLNE	C,760000	;WORD FULL?
+	AOJA	D,GOB2		;NO, KEEP TRYING
+	AOJA	D,GOB1		;COUNT WORD AND GO
+
+;HERE TO CHECK FOR +,-,. IN NUMBER
+
+SYMB1:	TRNE	FF,NFIRST	;IS THIS THE FIRST CHARACTER
+	JRST	CHECK.		;NO, ONLY LOOK AT DOT
+	CAIE	A,"-		;IS IT MINUS
+	JRST	.+3		;NO CHECK PLUS
+	TRO	FF,NEGF		;YES, NEGATE AT THE END
+	JRST	SYMB2
+	CAIN	A,"+		;IS IT +
+	JRST	SYMB2		;ESSENTIALLY IGNORE IT
+	CAIE	A,"*		; FUNNY OCTAL CROCK?
+	JRST	CHECK.
+
+	TRO	FF,OCTSTR
+	JRST	SYMB2
+
+;COULD BE .
+
+CHECK.:	PUSHJ	P,LSTCHR	;FLUSH LAST CHARACTER
+	MOVEI	E,0
+	TRNN	FF,DOTSEN+EFLG	;IF ONE ALREADY SEEN
+	CAIE	A,".
+	JRST	CHECKE		;GO LOOK FOR E
+
+IFN FRMSIN,[
+	TRNN	FF,NFIRST	;IS IT THE FIRST
+	JRST	DOT1		;YES, COULD MEAN EVALUATE A VARIABLE
+]
+
+CHCK.1:	TRO	FF,DECFRC+DOTSEN	;FORCE DECIMAL 
+IFN FRMSIN,	TRNN	FF,FRSDOT	;IF NOT FIRST ., PUT IN CHAR STRING
+	JRST	SYMB2		;ENTER INTO SYMBOL
+IFN FRMSIN,	JRST	GOB2		;IGNORE THE "."
+
+
+
+IFN FRMSIN,[
+
+;HERE TO SET UP FOR .FOO ..FOO OR.<ABC>
+
+DOT1:	PUSH	P,FF		;SAVE FLAGS
+	PUSHJ	P,NXTCH1	;GOBBLE A NEW CHARACTER
+	POP	P,FF		;RESTORE FLAGS
+	TRO	FF,FRSDOT		;SET FLAG IN CASE
+	CAIN	B,NUMCOD		;SKIP IF NOT NUMERIC
+	JRST	CHCK.1		;NUMERIC, COULD BE FLONUM
+
+; CODE TO HANDLE ALL IMPLICIT CALLS  I.E. QUOTE, LVAL, GVAL
+
+	MOVSI	B,TFORM		;LVAL
+	MOVE	A,MQUOTE LVAL
+	SUB	P,[2,,2]	;POP OFF BYTE POINTER AND GOBBLE CALL
+	POP	TP,TP
+	SUB	TP,[1,,1]	;REMOVE  TP JUNK
+	JRST	IMPCA1
+
+GLOSEG:	SKIPA	B,$TSEG		;SEG CALL TO GVAL
+GLOVAL:	MOVSI	B,TFORM	;FORM CALL TO SAME
+	MOVE	A,MQUOTE GVAL
+	JRST	IMPCAL
+
+QUOSEG:	SKIPA	B,$TSEG		;SEG CALL TO QUOTE
+QUOTIT:	MOVSI	B,TFORM
+	MOVE	A,MQUOTE QUOTE
+	JRST	IMPCAL
+
+SEGDOT:	MOVSI	B,TSEG		;SEG CALL TO LVAL
+	MOVE	A,MQUOTE 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
+	MOVEM	B,LSTCH(A)
+	MOVEI	E,0
+	JRST	POPARE
+
+;HERE AFTER READING ATOM TO CALL VALUE
+
+.SET:	SUB	P,[1,,1]	;FLUSH GOBBLE CALL
+	PUSH	P,$TFORM	;GET WINNING TYPE
+	MOVE	E,(P)
+	PUSHJ	P,RETC		; CHECK FOR POSSIBLE COMMENT
+	PUSH	TP,$TATOM
+	PUSH	TP,MQUOTE LVAL
+	JRST	IMPCA2		;GO CONS LIST
+
+]
+
+;HERE TO CHECK FOR "E" FLAVOR OF EXPONENT
+
+CHECKE:	CAIN	A,"*		; CHECK FOR FINAL *
+	JRST	SYMB4
+	TRNN	FF,EFLG		;HAS ONE BEEN SEEN
+	CAIE	B,NONSPC		;IF NOT, IS THIS ONE
+	JRST	SYMB		;NO, ENTER AS SYMBOL KILL NUMERIC WIN
+
+	TRNN	FF,NUMWIN	;HAVE DIGITS BEEN SEEN?
+	JRST	SYMB		;NO, NOT A NUMBER
+	MOVE	B,(TP)		;GET POINTER TO TEMPS
+	HRLM	FF,ENUM(B)	;SAVE FLAGS
+	HRRI	FF,DECFRC+DOTSEN+EFLG	;SET NEW FLAGS
+	JRST	SYMB3		;ENTER SYMBOL
+
+
+SYMB4:	TRZN	FF,OCTSTR
+	JRST	SYMB
+	TRZN	FF,OCTWIN	; ALREADY WON?
+	TROA	FF,OCTWIN	; IF NOT DO IT NOW
+	JRST	SYMB
+	JRST	SYMB2
+
+;HERE ON READING CHARACTER STRING
+
+ADSTRN:	SKIPL	A		; EOF?
+	CAIN	B,MANYT		;TERMINATE?
+	JRST	DONEG		;YES
+	CAIE	B,CSTYP
+	JRST	SYMB2		;NO JUST INSERT IT
+ADSTN1:	PUSHJ	P,LSTCHR	;DON'T REREAD """
+
+
+;HERE TO FINISH THIS CROCK
+
+DONEG:	TRNN	FF,OCTSTR	; IF START OCTAL BUT NOT FINISH..
+	TRNN	FF,NUMWIN	;HAVE DIGITS BEEN SEEN?
+	TRO	FF,NOTNUM	;NO,SET NOT NUMBER FLAG
+	SKIPGE	C		; SKIP IF STUFF IN TOP WORD
+	SUB	P,[1,,1]
+	PUSH	P,D
+	TRNN	FF,NOTNUM	;NUMERIC?
+	JRST	NUMHAK		;IS NUMERIC, GO TO IT
+
+IFN FRMSIN,[
+	MOVE	A,(TP)		;GET POINTER TO TEMPS
+	MOVEM	FF,NDIGS(A)	;USE TO HOLD FLAGS
+]
+	TRNE	FF,INSTRN	;ARE WE BUILDING A STRING
+	JRST	MAKSTR		;YES, GO COMPLETE SAME
+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
+	PUSH	TP,A
+	PUSH	TP,B
+	PUSH	TP,$TATOM
+	PUSH	TP,IMQUOTE OBLIST
+	MCALL	2,GET		; GET THE OBLIST
+	CAMN	A,$TOBLS	; IF NOT OBLIST, MAKE ONE
+	JRST	PATH6
+	MCALL	1,MOBLIS	; MAKE ONE
+	JRST	PATH1
+
+PATH6:	SUB	TP,[2,,2]
+	JRST	PATH1
+
+
+PATH3:	MOVE	B,ROOT+1(TVP)	; GET ROOT OBLIST
+	MOVSI	A,TOBLS
+PATH1:	PUSHJ	P,RLOOKU		; AND LOOK IT UP
+
+IFN FRMSIN,[
+	MOVE	C,(TP)		;SET TO REGOBBLE FLAGS
+	MOVE	FF,NDIGS(C)
+]
+	JRST	FINID
+
+
+SPACEQ:	ANDI	A,-1
+	CAIE	A,33
+	CAIN	A,400033
+	POPJ	P,
+	CAIE	A,3
+	AOS	(P)
+	POPJ	P,
+
+;HERE TO RAP UP CHAR STRING ITEM
+
+MAKSTR:	MOVE	C,D		;SETUP TO CALL CHMAK
+	PUSHJ	P,CHMAK		;GO MAKE SAME
+	JRST	FINID
+
+
+NUMHAK:	MOVE	C,(TP)		;REGOBBLETEMP POINTER
+	POP	P,D	;POP OFF STACK TOP
+	ADDI	D,4
+	IDIVI	D,5
+	HRLI	D,(D)	;TOO BOTH HALVES
+	SUB	P,D		;REMOVE CHAR STRING
+	TRNE	FF,FLONUM+EFLG	;IS IT A FLOATING POINT NUMBER
+	JRST	FLOATIT		;YES, GO MAKE IT WIN
+	MOVE	B,CNUM(C)
+	TRNE	FF,DECFRC
+	MOVE	B,DNUM(C)	;GRAB FIXED GOODIE
+	TRNE	FF,OCTWIN	; SKIP IF NOT OCTAL
+	MOVE	B,ONUM(C)	; USE OCTAL VALUE
+
+FINID2:	MOVSI	A,TFIX		;SAY FIXED POINT
+FINID1:	TRNE	FF,NEGF		;NEGATE
+	MOVNS	B		;YES
+FINID:	POP	TP,TP		;RESTORE OLD TP
+	SUB	TP,[1,,1]	;FINISH HACK
+IFN FRMSIN,[
+	TRNE	FF,FRSDOT	;DID . START IT
+	JRST	.SET		;YES, GO HACK
+]
+	POPJ	P,		;AND RETURN
+
+
+
+
+PATH2:	MOVE	B,IMQUOTE OBLIST
+	PUSHJ	P,IDVAL
+	JRST	PATH1
+
+BADPAT:	PUSH	TP,$TATOM
+	PUSH	TP,EQUOTE NON-ATOMIC-OBLIST-NAME
+	JRST	CALER1
+
+
+FLOATIT:
+	JFCL	17,.+1		;CLEAR ALL ARITHMETIC FLAGS
+
+	TRNE	FF,EFLG	;"E" SEEN?
+	JRST	EXPDO	;YES, DO EXPONENT
+	MOVE	D,NDIGS(C)	;GET IMPLICIT EXPONENT
+
+FLOATE:	MOVE	A,DNUM(C)	;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	
+	CAILE	A,37.		;HOW BIG?
+	JRST	FOOR		;TOO BIG-FLOATING OUT OF RANGE
+	JUMPGE	D,FLOAT1	;JUMP IF EXPONENT POSITIVE
+	FDVR	B,TENTAB(A)	;DIVIDE BY TEN TO THE EXPONENT
+	JRST	SETFLO
+
+FLOAT1:	FMPR	B,TENTAB(A)	;SCALE UP
+
+SETFLO:	JFCL	10,FOOR	;FLOATING OUT OF RANGE ON OVERFLOW
+	MOVSI	A,TFLOAT
+IFN FRMSIN,	TRZ	FF,FRSDOT	;FLOATING NUMBER NOT VALUE
+	JRST	FINID1
+
+EXPDO:
+	HRRZ	D,ENUM(C)	;GET EXPONENT
+	TRNE	FF,NEGF	;IS EXPONENT NEGATIVE?
+	MOVNS	D		;YES
+	ADD	D,NDIGS(C)	;ADD IMPLICIT EXPONENT
+	HLR	FF,ENUM(C)	;RESTORE FLAGS
+	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(C)	;
+	IMUL	B,ITENTB(D)	
+	JFCL	10,FLOATE		;IF OVERFLOW, MAKE FLOATING
+	JRST	FINID2		;GO MAKE FIXED NUMBER
+
+; HERE TO READ ONE CHARACTER FOR USER.
+
+CREDC1:	SUBM	M,(P)
+	PUSH	TP,A
+	PUSH	TP,B
+	PUSHJ	P,IREADC
+	JFCL
+	JRST	MPOPJ
+
+CNXTC1:	SUBM	M,(P)
+	PUSH	TP,A
+	PUSH	TP,B
+	PUSHJ	P,INXTRD
+	JFCL
+	JRST	MPOPJ
+
+CREADC:	SUBM	M,(P)
+	PUSH	TP,A
+	PUSH	TP,B
+	PUSHJ	P,IREADC
+	JRST	RMPOPJ
+	SOS	(P)
+	JRST	RMPOPJ
+
+CNXTCH:	SUBM	M,(P)
+	PUSH	TP,A
+	PUSH	TP,B
+	PUSHJ	P,INXTRD
+	JRST	RMPOPJ
+	SOS	(P)
+RMPOPJ:	SUB	TP,[2,,2]
+	JRST	MPOPJ
+
+INXTRD:	TDZA	E,E
+IREADC:	MOVEI	E,1
+	MOVE	B,(TP)		; CHANNEL
+	HRRZ	A,-4(B)		; GET BLESS BITS
+	TRNE	A,C.BIN
+	TRNE	A,C.BUF
+	JRST	.+3
+	PUSHJ	P,GRB
+	HRRZ	A,-4(B)
+	TRC	A,C.OPN+C.READ
+	TRNE	A,C.OPN+C.READ
+	JRST	BADCHN
+	SKIPN	A,LSTCH(B)
+	PUSHJ	P,RXCT
+	MOVEM	A,LSTCH(B)	; SAVE CHAR
+	CAMN	A,[-1]		; SPECIAL PSEUDO TTY HACK?
+	JRST	PSEUDO		; YES, RET AS FIX
+	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:	SKIPE	E
+	PUSHJ	P,LSTCH2
+	MOVE	B,A
+	MOVSI	A,TFIX
+	JRST	PSEUD1
+
+NOEXCL:	SKIPE	E
+	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:	PUSH	TP,$TATOM
+	PUSH	TP,EQUOTE BAD-ASCII-CHARACTER
+	JRST	CALER1
+
+; HERE ON YUCKY PARSE TABLE
+
+BADPTB:	PUSH	TP,$TATOM
+	PUSH	TP,EQUOTE BAD-MACRO-TABLE
+	JRST	CALER1
+
+BDPSTR:	PUSH	TP,$TATOM
+	PUSH	TP,EQUOTE BAD-PARSE-STRING
+	JRST	CALER1
+
+ILLSQG:	PUSHJ	P,LSTCHR	; DON'T MESS WITH IT AGAIN
+	PUSH	TP,$TATOM
+	PUSH	TP,EQUOTE BAD-USE-OF-SQUIGGLY-BRACKETS
+	JRST	CALER1
+
+
+;FLOATING POINT NUMBER TOO LARGE OR SMALL
+FOOR:	PUSH	TP,$TATOM
+	PUSH	TP,EQUOTE NUMBER-OUT-OF-RANGE
+	JRST	CALER1
+
+
+NILSXP:	0,,0
+
+LSTCHR:	PUSH	P,B
+	SKIPL	B,5(TB)	;GET CHANNEL
+	JRST	LSTCH1		;NO CHANNEL, POINT AT SLOT
+	PUSHJ	P,LSTCH2
+	POP	P,B
+	POPJ	P,
+
+LSTCH2:	SKIPE	LSTCH(B)	;ARE WE REALLY FLUSHING A REUSE CHARACTER ?
+	PUSHJ	P,CNTACC
+	SETZM	LSTCH(B)
+	POPJ	P,
+
+LSTCH1:	SETZM	5(TB)		;ZERO THE LETTER AND RETURN
+	POP	P,B
+	POPJ	P,
+
+CNTACC:	PUSH	P,A
+	HRRZ	A,-4(B)		; GET BITS
+	TRNE	A,C.BIN
+	JRST	CNTBIN
+	AOS	ACCESS(B)
+CNTDON:	POP	P,A
+	POPJ	P,
+
+CNTBIN:	AOS	A,ACCESS-1(B)
+	CAMN	A,[TFIX,,1]
+	AOS	ACCESS(B)
+	CAMN	A,[TFIX,,5]
+	HLLZS	ACCESS-1(B)
+	JRST	CNTDON
+
+
+;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