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