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,[RET12]
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