
;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ****** READ AND RELATED FUNCTIONS **************
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************


	PGBOT [RDR]


SUBTTL	HIRSUTE READER AND INPUT PACKAGE


SUBTTL	HAIRY READER BIT DESCRIPTIONS

	;OBJECT FLAGS  - AS AN OBJECT ACCUMULATES, THE LH OF ACC T
	;	HAS BITS SET TO DESCRIBE THE STATE OF THE OBJECT
	;BIT	VALUE	MEANING
	;3.1	1	TOP LEVEL OBJECT
	;3.2	2	FIRST OBJECT OF A LIST
	;3.3	4	DOTTED PAIR OBJECT - SECOND HALF
	;3.4	10	DELAYED DOT READ
	;3.5	20	ALPHA ATOM (I.E., NON-NUMBER ATOM)
	;3.6	40	NUMBER ATOM
	;3.7	100	DECIMAL NUMBER
	;3.8	200	FLOATING NUMBER
	;3.9	400	NEGATIVE NUMBER
	;4.1	1000	EXPONENT-MODIFIED NUMBER, E.G. ^ OR E (OR SPLICING, IF MACRO)
	;4.2	2000	LSH-ED NUMBER, I.E. _
	;4.3	4000	LIST-TYPE OBJECT
	;4.4	10000	SIGNED NUMBER ATOM, E.G. +A
	;4.5	20000	MACRO-PRODUCED OBJECT
	;4.6	40000	BIGNUM BASE 10.
	;4.7	100000	BIGNUM BASE IBASE
	;4.8	200000	HUNK
	;4.9	400000	A form has been seen after a dot.  For error checking
	;		splicing macros.

	;CHARACTER FLAGS - THE RH OF AN ENTRY IN THE RCT TABLE
	;	GENERALLY HAS THE ASCII TRANSLATION FOR THE CHARACTER,
	;	EXCEPT MACRO-CHARACTERS, WHICH HOLD A FUNCTION TO EXECUTE
	;	THE LH HAS DESCRIPTOR BITS AS FOLLOWS:
	;BIT	VALUE	MEANING
	;3.1	1	ALPHABETIC, I.E. A,B,C,...,Z
	;3.2	2	EXTENDED ALPHABETIC, E.G., !,",#,$, ETC. AND LOWERCASE
	;3.3	4	DECIMAL DIGIT, I.E. 0,1,2,...,9
	;3.4	10	+ OR -
	;3.5	20	^ OR _
	;3.6	40	SECOND CHOICE DENOTER FOR 3.4, 3.5, 4.1, AND 4.3
	;3.7	100	PRINT SHOULD SLASHIFY IF NOT FIRST CHAR
	;3.8	200	. <DECIMAL POINT> KIND OF DOT
	;3.9	400	PRINT SHOULD SLASHIFY WHEN IN FIRST POSITION
	;4.1	1000	THE RUBOUT CHARACTER, OR THE TTY FORCE FEED CHAR
	;4.2	2000	THE READ "QUOTE" CHARACTER, I.E. /
	;4.3	4000	MACRO CHARACTER, E.G. ', OR SPLICING MACRO
	;4.4	10000	)
	;4.5	20000	. <DOTTED-PAIR> KIND OF DOT
	;4.6	40000	(
	;4.7	100000	<SPACE> OR <TAB>
	;4.8	200000	CHARACTER OBJECT
	;4.9	400000	WORTHLESS CHARACTERS, AND ANY WITH BIT 3.8
	;		OR BITS  4.1-4.8 ON.

IFN NEWRD,[
;;;DEFINE READER-SYNTAX BITS

;;;THESE BITS OCCUPY 2.1-3.8.  DO NOT USE 3.9 (SEE TYIPEEK)

RS.FF==004000,,			;FORCE-FEED CHARACTER
RS.VMO==002000,,		;VERTICAL MOTION (LF, FF)
RS.SQX==001000,,		;EXPONENT MARKER, STRING QUOTE
RS.BRK==000400,,		;SPECIAL ACTION NEEDED ON INPUT
RS.SCO==000200,,		;SINGLE-CHARACTER OBJECT
RS.WSP==000100,,		;WHITE SPACE - SPACE, TAB, COMMA, CR
RS.LP ==000040,,		;LEFT PARENTHESIS
RS.DOT==000020,,		;DOTTED-PAIR DOT
RS.RP ==000010,,		;RIGHT PARENTHESIS
RS.MAC==000004,,		;MACRO-CHARACTER (RS.ALT = SPLICING)
RS.SLS==000002,,		;SLASHIFIER
RS.RBO==000001,,		;RUBOUT, FORCEFEED
RS.SL1==400000			;SLASH IF FIRST IN PNAME
RS.PNT==200000			;DECIMAL POINT (FOR NUMBERS)
RS.SL9==100000			;SLASH IF NOT FIRST IN PNAME
RS.ALT==040000			;CHANGE MEANING OF OTHER BITS
RS.ARR==020000			;NUMBER MODIFIERS _ AND ^
RS.SGN==010000			;NUMBERS SIGNS + AND -
RS.DIG==004000			;DIGITS 0 THROUGH 9
RS.XLT==002000			;EXTENDED LETTERS (LIKE :)
RS.LTR==001000			;REGULAR LETTERS (LIKE X)

IRP A,,[FF,VMO,SQX,BRK,SCO,WSP,LP,DOT,RP,MAC,SLS,RBO]
	RS%!A==<RS.!A>_22
TERMIN

NWTNE==:TRNE
NWTNN==:TRNN

DEFINE NWTN ZP,AC,SX
	TDN!ZP AC,[RS.!SX]
TERMIN

]	;END IFN NEWRD

IFE NEWRD,[
;;;DEFINE READER-STYNTAX BITS

RS.FF==0
RS.VMO==0
RS.SQX==0
RS.BRK==400000
RS.SCO==200000
RS.WSP==100000
RS.LP==40000
RS.DOT==20000
RS.RP==10000
RS.MAC==4000
RS.SLS==2000
RS.RBO==1000
RS.SL1==400
RS.PNT==200
RS.SL9==100
RS.ALT==40
RS.ARR==20
RS.SGN==10
RS.DIG==4
RS.XLT==2
RS.LTR==1
IRP A,,[FF,VMO,SQX,BRK,SCO,WSP,LP,DOT,RP,MAC,SLS,RBO]
	RS%!A==RS.!A
TERMIN

NWTNE==:TLNE
NWTNN==:TLNN

DEFINE NWTN ZP,AC,SX
	TLN!ZP AC,RS.!SX
TERMIN

]	;END OF IFE NEWRD

RS.CMS==RS.<BRK+SL1+SL9+MAC>	;CHARACTER-MACRO SYNTAX
RS.SCS==RS.<BRK+SL1+SL9+SCO>	;SINGLE-CHAR-OBJ SYNTAX
				;SYNTAX FOR CHARS THAT BEGIN OBJECTS
RS.OBB==RS.<SQX+SCO+LP+MAC+SLS+PNT+SGN+DIG+XLT+LTR>
RS.WTH==RS.<OBB+DOT+RP+ARR>	;PRETTY MUCH, ANY WORTHY CHAR
RS.SEE==RS.<WTH+WSP+RBO+FF>	;ALMOST ANY CHAR THAT YOU REALLY SEE



SUBTTL	READCH AND ASCII FUNCTIONS, 

$READCH:	JSP D,INCALL
		   Q$READCH
RDCH$:
READCH:	PUSHJ P,TYI
RDCH3:	MOVE TT,A
	JRST RDCH2

$ASCII:	JSP T,FXNV1
RDCH2:
	CAIN TT,203		;RARE CASE WHEN READCH IS CALLED FROM WITHIN
	 JRST READCH		; A READLIST - MAY SEE A PSEUDO-SPACE.
SA$	CAIN TT,315		;NORMALIZE CR FOR SAIL
SA$	 MOVEI TT,15
	ANDI TT,177
	MOVE B,TT
	MOVE D,VOBARRAY
	ADDI TT,OBTSIZ+1
	ROT TT,-1
	JUMPL TT,.+3
	HLRZ A,@1(D)
	JRST .+2
	HRRZ A,@1(D)
	JUMPN A,CPOPJ
	MOVEI T,1
	MOVEI TT,RDCHO
RDCH4:	PUSH P,T
	PUSH FXP,PNBUF-1(T)
	SOJG T,.-1
	PUSH FXP,LPNF
	PUSHJ P,(TT)
	POP FXP,LPNF
	POP P,T
	MOVNS T
	HRLZS T
	POP FXP,PNBUF(T)
	AOBJN T,.-1
	POPJ P,



SUBTTL	NEWIO INPUT FUNCTION ARGS PROCESSOR

;;;	JSP D,INCALL
;;;		Q<FNNAME>
;;; PROCESSES ARGUMENTS FOR AN INPUT FUNCTION TAKING STANDARD
;;; ARGUMENTS (EOF VALUE AND/OR FILE ARRAY). SAVES F.
;;;	JSP D,XINCALL
;;;		Q<FNNAME>
;;; IS SIMILAR, BUT INSISTS ON A FIXNUM RESULT (FOR TYI, TYIPEEK),
;;; AND EXPECTS F TO CONTAIN EITHER "FIX1" OR "CPOPJ".
;;; SAVES AR2A (SEE TYIPEEK).

XINCALL:
	JUMPN T,XINCA1
	PUSH P,F
SFA%	JRST 1(D)
IFN SFA,[
INCAST:	PUSHJ P,SINFGET		;GETS VINFILE IN AR1, STANDARDIZED FOR "T"
	HRLZI T,AS.SFA		;CHECK FOR AN SFA
	TDNN T,ASAR(AR1)	;FOUND AN SFA?
	 JRST 1(D)		;NOPE, RETURN RIGHT AWAY
	HLRZ TT,(D)		;GET POINTER TO OP BIT
	MOVE T,(TT)		;GET THE ACTUAL BIT
	MOVEI TT,SR.WOM		;CHECK AGAINST KNOWN THINGS
	TDNN T,@TTSAR(AR1)	;CAN IT DO THIS SPECIFIC OPERATION?
	 JRST 1(D)		;NO, RETURN AS NORMAL
INCSEO:	TLNE T,SO.TIP		;FOO! TYIPEEK IS DIFFERENT!
	 TDZA C,C		;  BUT IF NOT TYIPEEK THEN USE
	  MOVEI C,INCSEO	;  NEW EOF VALUE, SOMETHING UNIQUE
	PUSH FXP,D		;MAY NEED TO RETURN IF OVER-RUBOUT
	PUSH P,AR1		;REMEMBER THE SFA
	PUSHJ P,ISTCAL		;YES, PROCESS IT
	POP FXP,D
	POP P,AR1
	CAIE A,INCSEO		;DID THE SFA RETURN EOF?
	 JRST .+3
	  PUSHJ P,EOF		;HANDLE EOF
	  JRST INCAST		;IF RETURN THEN PROCEED AROUND AGAIN
	MOVE TT,(A)
	POPJ P, 		;NO, RETURN
]		;END IFN SFA
XINCA1:	TLOA D,1		;MUST HAVE FIXNUM RESULT
INCALL:
SFA$	JUMPE T,INCAST		;ZERO ARGS
SFA%	JUMPE T,1(D)
	AOJL T,INCAL2
	SETZ AR1,
	EXCH AR1,(P)		;DEFAULT NIL FOR EOF VALUE
INCAL4:	JUMPE AR1,EOFBN0	;NOT IF NIL
	JSP TT,XFOSP		;FILE OR SFA?
	 JRST EOFBN0		;NOT IF T, OR IF NOT FILE
IFN SFA,[
	  JRST INCAL5
INCST2:	HLRZ TT,(D)		;GET POINTER TO OP BIT
	MOVE T,(TT)		;GET THE ACTUAL BIT
	MOVEI TT,SR.WOM		;CHECK AGAINST KNOWN THINGS
	TDNN T,@TTSAR(AR1)	;CAN IT DO THIS SPECIFIC OPERATION?
	 JRST INCALZ		;NO, HANDLE NORMALLY: LOWER LEVEL WILL TRAP
	POP P,C			;GET EOF VALUE
	TLNN D,1		;EXPECTING A FIXNUM RESULT?
	 JRST ISTCAL		;NOPE, CALL THE STREAM AND GO ON
	PUSH P,C		;REMEMBER EOF VALUE AGAIN
INCST3:	TLNE T,SO.TIP		;FOO! TYIPEEK IS DIFFERENT!
	 TDZA C,C		;  BUT IF NOT TYIPEEK THEN USE
	  MOVEI C,INCST3	;  NEW EOF VALUE, SOMETHING UNIQUE
	PUSHJ P,ISTCAL		;CALL THE SFA
	POP P,C			;RESTORE EOF VALUE
	CAIN A,INCST3		;DID THE SFA RETURN EOF?
	 JRST INCST4		;YES, HANDLE IT
	JSP T,FXNV1		;ELSE THE VALUE RETURNED MUST BE A FIXNUM
	POPJ P,

INCST4:	SKIPN A,C		;FOR A NULL EOF VALUE, SNEAKILY
	 MOVEI A,IN0-1		; SLIP IN -1
	JSP T,FXNV1		;ELSE WHAT WAS PROVIDED
	POPJ P,			; MUST BE A FIXNUM
]		;END IFN SFA
INCAL5:	MOVE A,TTSAR(AR1)	;GET ARRAY TYPE BITS
	TLNN A,TTS<IO>		;MUST BE INPUT
	 JRST INCAL1
	EXCH A,AR1
	PUSHJ P,[IOL [NOT AN INPUT FILESPEC!]]
	EXCH A,AR1
	JRST INCAL4
INCAL1:	TLNN A,TTS<TY>		;IF TTY ALLOW BINARY MODE
	 TLNN A,TTS<BN>		;MUST NOT BE BINARY FILE
	  JRST INCALZ
	EXCH A,AR1
	PUSHJ P,[IOL [NOT ASCII FILE!]]
	EXCH A,AR1
	JRST INCAL4
INCALZ:	POP P,A			;RESTORE EOF VALUE
INBIND:	SKIPE B,AR1
	 JRST INBN4
	PUSHJ P,INFGET		;GETS VINFILE IN AR1
	MOVEI B,(AR1)
INBN4:	CAIN B,TRUTH
	 TDZA C,C
	  SKIPA C,[TRUTH]
	   HRRZ AR1,V%TYI
;	PUSHJ P,ATIFOK
;	UNLOCKI
	MOVSI T,-LINBN9		;OPEN-CODING OF SPECBIND
	MOVEM SP,SPSV
INBN1:	HRRZ TT,INBN9(T)
	HRRZ R,(TT)
	HRLI R,(TT)
	PUSH SP,R
	HLRZ R,INBN9(T)
	TRNN R,777760
	 HRRZ R,(R)
	MOVEM R,(TT)
	AOBJN T,INBN1
	JSP T,SPECX		;END OF SPECBIND
	PUSH P,CUNBIND
	JRST EOFBIND

INBN9:	      C,,TAPRED		;TABLE OF VALUE CELLS FOR INBIND
	      B,,VINFILE	;  EACH ENTRY IS OF FORM:
	    NIL,,VINSTACK	;	<NEW VALUE>,,<VALUE CELL>
	$DEVICE,,TYIMAN		;  IF NEW VALUE IS AN AC, THEN
	 IUNTYI,,UNTYIMAN	;  THE AC CONTAINS THE REAL
;;	   UNRD,,UNREADMAN	;  NEW VALUE.
;;	  READP,,READPMAN
LINBN9==.-INBN9

INCAL2:	AOJL T,INCAL7
	POP P,A			;TWO ARGS
	POP P,AR1
	JUMPE AR1,INBIND
	CAIN AR1,TRUTH
	 JRST INBIND
	PUSH P,A		;SAVE EOF VALUE
	JSP TT,XFOSP
SFA%	 SKIPA
SFA%	JRST INCAL5
IFN SFA,[
	 JRST INCST1
	  JRST INCAL5
	   JRST INCST2
INCST1:	]	;END IFN SFA
	EXCH A,AR1		;OTHER MUST BE FILE ARRAY
	MOVEM A,(P)		;STORE NEW EOF VALUE
	JRST INCAL4		;MAKE SURE OTHER IS CORRECT

INCAL7:	HRRZ D,(D)		;MORE THAN TWO ARGS: FOOEY.
	JRST S2WNAL

EOFBN0: POPI P,1		;GET EOF VALUE OFF STACK
	MOVEI A,(AR1)
EOFBIND:
	TLNN D,1		;BIND FOR INPUT EOF TRAP
	 JRST EOFBN3
	PUSH P,F		;FOR NUMERICAL INPUT FN, FIX1 OR CPOPJ
	TLO A,400000
EOFBN3:	PUSH P,A
	PUSH P,CEOFBN5
	JSP T,ERSTP		;SET UP A FRAME
	MOVEM P,EOFRTN		;THIS IS AN EOF FRAME
	SETZM BFPRDP		.SEE EOF2
SFA%	PUSHJ P,1(D)		;RUN CALLING FUNCTION
SFA$	MOVEI C,(A)		;THIS IS THE EOF VALUE FOR SFAS
SFA$	PUSHJ P,INCAST		;HANDLE AN SFA, ELSE RUN THE CALLER
	MOVSI D,-LEP1+1(P)	;RESTORE FRAME STUFF
	HRRI D,ERRTN
	BLT D,ERRTN+LEP1-1
	SUB P,[LERSTP+2,,LERSTP+2]	;FLUSH FRAME
	POPJ P,			;RETURN (RESULT IN A OR TT)

EOFBN5:	POP P,A			;COME HERE ON EOF
	TLZN A,400000
CEOFBN5:
	POPJ P,EOFBN5
	SKIPN A			;FOR A NULL EOF VALUE, SNEAKILY
	 SKIPA TT,XC-1		; SLIP IN A -1 INSTEAD
	  JSP T,FXNV1		;ELSE WHAT WAS PROVIDED
	POPJ P,			; MUST BE A FIXNUM


SUBTTL	NEWIO END-OF-FILE HANDLING

;;; HANDLE EOF ON STANDARD FILE ARRAY IN AR1.

EOF:	PUSHJ FXP,SAV5
	HRRZ T,BFPRDP		;CHECK WHETHER IN READ
	JUMPN T,EOFER
EOF2:
SFA$	MOVSI TT,AS.SFA
SFA$	TDNE TT,ASAR(AR1)	;DID AN SFA GET EOF?
SFA$	 JRST EOFZ		;YES, NEVER ANY EOFFN
	MOVEI TT,FI.EOF
	HRRZ B,@TTSAR(AR1)
	JUMPE B,EOF5
	EXCH B,AR1
	SKIPE A,EOFRTN
	 HRRZ A,-LERSTP-1(A)	.SEE EOFBIND
	EXCH A,B
	CALLF 2,(AR1)
	JUMPN A,EOF4
EOF8:	SKIPE TAPRED		;READING FROM INFILE?
	 PUSHJ P,INPOP		;YES, POP THE INPUT STACK
	PUSHJ P,EOF7
EOF1:	JSP R,PDLA2-5
	POPJ P,

EOF7:	HRRZ A,-2(P)		;SAVED AR1
	MOVE TT,TTSAR(A)
	TLNN TT,TTS<TY>		;DON'T CLOSE TTY INPUT,
	 PUSHJ P,ICLOSE		; FOR THAT WAS MERELY OVER-RUBOUT
	POPJ P,

EOF4:	CAIN A,TRUTH
	 JRST EOF1
	SKIPN T,EOFRTN
	 JRST EOF8
	HRRM A,-LERSTP-1(T)	.SEE EOFBIND
EOF9:	MOVE P,EOFRTN		.SEE TYPK9
	JRST ERR1

EOF5:	PUSHJ P,EOF7
EOFZ:	SKIPE TAPRED		;NO EOF FUNCTION. READING FROM INFILE?
	 PUSHJ P,INPOP		;YES, POP THE STACK
	SKIPN EOFRTN
	 JRST EOF1
	JRST EOF9


SUBTTL	NEWIO INPUSH FUNCTION

;;; HAIRY INPUSH FUNCTION. PUSHES FILE ONTO INSTACK,
;;; OR MAYBE PUSHES INFILE, OR MAYBE POPS.
;;; INPOP POPS INSTACK INTO INFILE ONCE.

INPUSH:	CAIN A,TRUTH		;SUBR 1
	 HRRZ A,V%TYI
IFN SFA,[
	JSP TT,AFOSP		;DO WE HAVE AN SFA?
	 JRST INPU2		;Nope, nothing
	 JRST INPU1A		;Ah, a file.
	MOVEI T,SO.TYI+SO.RED+SO.RDL
	TDNN T,@TTSAR(AR1)	;Can this SFA do any of these operations?
	 JRST INFLZE		; NO? then can't put it into INFILE
	JRST INPU1B
INPU1A:]	;END OF IFN SFA
IFE SFA,[
	JSP TT,AFILEP
	 JRST INPU2
]	;END OF IFN SFA
	PUSHJ P,ATIFOK
	UNLOCKI
INPU1B:	EXCH A,VINFILE
	HRRZ B,VINSTACK
	PUSHJ P,CONS
	MOVEM B,VINSTACK
INPU1:	SKIPN A,VINFILE
	 JRST INFLZE
	CAIN A,TRUTH
	 SETZM TAPRED
	POPJ P,

INFLZE:	PUSHJ P,INFLUZ
	JRST INPU1

INPU2:	SKOTT A,FX
	 JRST INFLZE
	SKIPN TT,(A)
	 JRST INPU1
	JUMPL TT,INPU5
INPU3:	HRRZ A,VINFILE		;AN INPUSH LOOP
	HRRZ B,VINSTACK
	PUSHJ P,CONS
	MOVEM A,VINSTACK
	SOJG TT,INPU3
	JRST INPU1

INPOP:	MOVNI TT,1
	PUSH P,A		;MUST SAVE A (E.G., SEE LOAD)
	PUSH P,CPOPAJ
INPU5:	PUSH FXP,TT
INPU6:	SKIPN A,VINSTACK
	JRST INPU8
	HLRZ AR1,(A)
;	PUSHJ P,ATIFOK
;	UNLOCKI
	HLRZ AR1,(A)
	MOVEM AR1,VINFILE
	HRRZ A,(A)
	MOVEM A,VINSTACK
	AOSGE (FXP)
	JRST INPU6
INPU7:	SUB FXP,R70+1
	JRST INPU1

INPU8:	MOVEI A,TRUTH
	MOVEM A,VINFILE
	JRST INPU7


SUBTTL	TYI FUNCTION AND RELATED ROUTINES


TYI$:	SKIPA F,CFIX1		;SUBR (NIL . 0) NCALLABLE, FOR *TYI FUNCTION
	 MOVEI F,CPOPJ
	PUSH P,F
	JRST TYI
%TYI:	SKIPA F,CFIX1		;LSUBR (0 . 2) NCALLABLE, FOR TYI FUNCTION
	 MOVEI F,CPOPJ
	JSP D,XINCALL
SFA%	   Q%TYI
SFA$	   [SO.TYI,,],,Q%TYI
TYI:	MOVEI A,Q%TYI
	PUSH FXP,BFPRDP
	HRLZM A,BFPRDP
	PUSHJ P,@TYIMAN
	POP FXP,BFPRDP
	MOVEI A,(TT)		;BARF
	POPJ P,

PTYI:	PUSH P,CFIX1		; +TYI: SUBR 1	(NCALLABLE)
	CAIN A,TRUTH
	 MOVE A,V%TYI		;IF T, THEN MAKE IT TYI
	SKIPE V.RSET
	 JRST PTYI2
	MOVEI AR1,(A)
PTYI1:
IFN SFA,[
	MOVSI T,AS.SFA		;CHECK IF AN SFA (SFA BIT SET IN ASAR?)
	TDNE T,ASAR(A)		; GO DO FAST SFACALL IF SO
	 JRST PTYI3
]	;END OF IFN SFA
	MOVEI D,2		;SIGNAL TO $DEVICE TO JUST RETURN -1 ON EOF
	MOVEI R,Q%TYI		;THIS IS TO BE A "TYI-LIKE" OPERATION
	JRST .$DEV

PTYI2:	MOVEI AR1,(A)
IFN SFA,[
	JSP TT,XFOSP		;CHECK FOR AN SFA
	 JFCL
	 SKIPA			;NOPE
	  JRST PTYI3		;YUP, SO CALL IT
]		;END IFN SFA
	PUSHJ P,ATIFOK	
	UNLOCKI 
	JRST PTYI1

IFN SFA,[
PTYI3:	MOVEI C,NIL		;DO FAST INTERNAL SFA CALL WITH
	MOVSI T,SO.TYI		;TYI OPERATION
	PUSHJ P,ISTCAL
	JSP T,FXNV1		;BE SURE IT RETURNS A FIXNUM VALUE
	POPJ P,
]		;END IFN SFA



;;; MAIN UNTYI ROUTINE
;;;	ACCEPTS CHARACTER IN A AND INPUT FILE IN B
;;;	STICKS CHARACTER BACK INTO CHARACTER BUFFER.
;;;	CLOBBERS A,B,AR1,T,TT,D.  MUST SAVE C (SEE READ).

;; UNDO THE FORMER TYI OPERATION.  -- user interface.
UNTYI:	CAIN B,TRUTH
	 MOVE B,V%TYI		;IF T, THEN MAKE IT TYI
	MOVEI AR1,(B)
	SKIPN V.RSET
	 JRST UNTYI2
	JSP TT,XFOSP
	 JFCL				;FOR RANDOM OBJS, AND FOR FILE ARRAYS,
	 PUSHJ P,[ PUSHJ P,ATIFOK	; CHECK FOR ASCII INPUT FILE
		   JRST INTREL ]
UNTYI2:	JSP T,FXNV1
	MOVE A,TT		;GET ACTUAL FIXNUM VALUE INTO A
	PUSHJ P,UNTYI1
	JRST TRUE


IUNTYI:	PUSHJ P,SINFGET		;INTERNAL UNTYI'ER -- GETS VINFILE IN AR1
UNTYI1:
IFN SFA,[
	MOVSI TT,AS.SFA		;HANDLE DIFFERENTLY IF AN SFA
	TDNE TT,ASAR(AR1)	;SKIP IF NOT AN SFA
	 JRST SUNTYI		;SFA UNTYI
]		;END IFN SFA
	MOVEI D,300000(A)	;USE 200000 BIT (IN CASE OF ^@)
	MOVEI TT,FI.BBC		;THE 100000 BIT IS A CROCK FOR PRATT
				;THAT MEANS DO NOT PUT CHAR OUT ON ECHOFILES
	HLRZ T,@TTSAR(AR1)	;GET SINGLE BUFFERED CHAR
	JUMPE T,UNTYI3		;THERE IS NONE - THIS IS EASY
	HRRZ B,@TTSAR(AR1)	;FOOEY - WE MUST CONS THE
	MOVEI TT,-200000(T)	; OLD BUFFERED BACK CHAR
	JSP T,FXCONS		; INTO THE LIST TO LEAVE ROOM
	PUSHJ P,CONS		; FOR THE NEW ONE
	MOVEI TT,FI.BBC
	HRRZM A,@TTSAR(AR1)
UNTYI3:	HRLM D,@TTSAR(AR1)	;BUFFER BACK NEW CHAR
	POPJ P,

IFN SFA,[
SUNTYI:	PUSH P,C		;CANNOT BASH C
	MOVEI TT,(A)		;CHARACTER INTO TT
	JSP T,FXCONS		;GENERATE A LISP FIXNUM (really won't "cons")
	MOVSI T,SO.UNT		;UNTYI OPERATION
	MOVEI C,(A)		;ARGUMENT INTO C (CHARACTER TO UNTYI)
	PUSHJ P,ISTCAL		;GO TO THE SFA CALLER
	POP P,C
	POPJ P,
]		;END IFN SFA


;;; MAIN INPUT FILE ARRAY HANDLER
;;;	FILE ARRAY IN VINFILE.
;;;	SAVES A,B,C,AR2A; CLOBBERS AR1.
;;;	RETURNS CHARACTER IN TT.
;;;	ACCUMULATOR D IS ZERO FOR PEEKING, 1 FOR NORMAL INPUT, AND 2 FOR
;;; 	  INPUT WHICH MERELY RETURNS -1 AT EOF.

$PEEK:	TDZA D,D
$DEVICE: MOVEI D,1
$DEV$:	PUSHJ P,SINFGET		;GETS VINFILE IN AR1
IFN SFA,[
	MOVSI T,AS.SFA		;BREAK AWAY HERE IF SFA
	TDNE T,ASAR(AR1)	;SFA?
	 JRST $DEVSFA		;NOPE, CONTINUE AS USUAL
]	;END OF IFN SFA
	MOVSI T,TTS<CL>	
	TDNE T,TTSAR(AR1)
	 JRST $DVLUZ		;INPUT (FILE) CLOSED LOSSAGE!
$DEV0:	HLRZ R,BFPRDP
.$DEV:				.SEE .TYI	
	LOCKI			;ALREADY HAVE MOST ACS SETUP WITH INFO
	MOVE T,TTSAR(AR1)	; SUCH AS FILE-ARRAY IN AR1, "TYPE" IN R
	SKIPN TT,FI.BBC(T)
	 JRST $DEV2		;ANY "BUFFERED-BACK" CHARS?
	JUMPE R,$DEV1
	TLNN T,TTS<TY>		;IF THIS FILE-ARRAY ISN'T A TTY, THEN WE CAN
	 JRST $DEV1		; JUST TAKE THE BUFFERED BACK CHAR
	CAIE R,Q%TYI		;FOR "READ" OR "READLINE" REQUESTS, WE MAY WANT
	 JRST $DEV2A		; TO RUN THE TTYBUF FUNCTION.
$DEV1:	TLZN TT,200000
	 JRST $DEV1A
	HLRZ TT,TT
	SKIPE D
	 HRRZS FI.BBC(T)
	JRST $DEV1B
$DEV1A:	MOVS TT,(TT)		;THERE IS A BUFFER-BACK LIST
	SKIPE D
	 HLRZM TT,FI.BBC(T)	;"CDR" IT IF NOT MERELY PEEKING
	MOVE TT,(TT)		;AND TAKE TOP CHAR
$DEV1B:	TRZN TT,100000		;100000 MEANS DON'T OUTPUT TO ECHOFILES
	 JRST $DEVECO
	UNLKPOPJ		.SEE UNTYI


;;; NO CHARS BUFFERED BACK, SO DISPATCH ON FILE TYPE

$DEV2:	TLNN T,TTS<TY>		;IF THIS ISN'T A TTY,
	 JRST $DEV4		; THEN FORGET CLEVER HACKS
	CAIN R,Q%TYI		;IF THIS IS "TYI", THEN
	 JRST $DEVAH		; PULL CLEVER ACTIVATION HACK
$DEV2A:	MOVE F,F.MODE(T)
	JUMPE R,$DEV4		;NIL MEANS NO CLEVERNESS AT ALL
	HRRZ R,TI.BFN(T)
	JUMPN R,$DEVPS
	TLNN F,FBT<FU>		;NO PRE-SCAN FUNCTION IN FILE
	 JRST $DEV4
	UNLOCKI			;CANT "PRESCAN" FROM TTY WITH 12.-BIT CHARS
	PUSHJ P,INFLUZ
	JRST $DEV$

;;; MOBY WINNING PRESCAN READER FOR TTYs

$DEVPS:
IFN D20,[
	SKIPN TENEXP		;No RDTTY on TENEX, and SIN doesn't do rubouts
	 TLNN F,FBT<LN>
	  SKIPA
	   JRST $DEVLM
]	;END OF INF D20
	HRLM D,(P)		;INVOKE THE PRE-SCAN FUNCTION 
	PUSHJ FXP,SAV5		;FIRST, SAVE THE WORLD THEN CALL THE SCANNER
	MOVEI AR2A,(R)		;FUNCTION WITH 3 ARGUMENTS:
	MOVEI A,(AR1)		; (1) THE FILE ARRAY
	HLRZ B,BFPRDP		; (2) THE FUNCTION TO BUFFER FOR
	LDB T,[002100,,BFPRDP]	; (3) IF (2) IS 'READ, THE
	UNLOCKI
	PUSH FXP,T		;     NUMBER OF HANGING OPEN
	MOVEI C,(FXP)		;     PARENTHESES
	PUSH FXP,BFPRDP
	PUSH FXP,LPNF
	CALLF 3,(AR2A)
	POP FXP,LPNF
	POP FXP,BFPRDP
	HRRZS BFPRDP
	SUB FXP,R70+1
	HRRZ AR1,-1(P)
	JUMPE A,$DVEF0		;NIL MEANS OVER-RUBOUT, ERGO EOF
	MOVEI C,(A)
	SKIPE V.RSET
	 CAIN R,QTTYBUF		;DON'T NEED TO CHECK RESULT IF
	  JRST $DVPS1		; IT WAS OUR OLD FRIEND TTYBUF
	MOVEI B,(C)
	HLRZ A,(B)		;LOOP TO VERIFY THAT RESULTS FROM TTY
	 JSP F,TYOARG		; PRESCAN ARE INDEED ASCII VALUES
	 HRRZ B,(B)
	 JUMPN B,.-3
$DVPS1:	LOCKI
$DVPS0:	HRRZ AR1,-1(P)	
	MOVE T,TTSAR(AR1)
	EXCH C,FI.BBC(T)	;SO ADD LIST OF CHARS TO BUFFER-BACK
	JUMPN C,$DVPS2		;   OOPS, SOME "SNEAKED" IN
$DVPSX:	JSP R,PDLA2-5
	HLRZ D,(P)
	UNLOCKI
	JRST $DEV$		;AND TRY AGAIN!

$DVPS2:	TLZE C,200000
	 JRST $DVPS3
	MOVE A,FI.BBC(T)	
	MOVEI B,(C)		;BUFFER-BACK LIST "SNEAKED" UP IN THE MEANTIME
	PUSHJ P,.NCONC		; JUST TACK IT ON END (SINCE IT WAS "LATER")
	JRST $DVPSX

$DVPS3:	LDB TT,[221400,,C]	;BUFFER-BACK CHAR "SNEAKED" UP IN THE MEANTIME
	MOVEI C,0
	EXCH C,FI.BBC(T)	;LIST FROM TTYSCAN PLACED IN C
	UNLOCKI			;FOO! PERMIT CONSING. FOO!  FOO!  FOO! 
	JSP T,FXCONS
	MOVE B,C
	PUSHJ P,CONS
	MOVE C,A
	JRST $DVPS1

;;; LINEMODE FOR TTYs

IFN D20,[
$DEVLM:	SKIPE TT,FI.BBC(T)	;It may happen, for re-entrant READs, that
 	 JRST $DEV1		; there is dispatch to "Pre-Scan", even though
	HRLM D,(P)		; there are already chars in the buffer.
	POP FXP,TT 			;POP THE LOCKI WORD
	PUSHJ FXP,SAV5
	PUSHN FXP,80.
;;; THIS IS SUBOPTIMAL BEHAVIOR -- SEE ABOVE
;;	SKIPE TENEXP
;;	 JRST $DVLMX
	MOVEI 1,-80.+1(FXP)
	HRLI 1,440700
	MOVE 2,[RD%RND+RD%BEL 400.]
	SETZ 3,
	MOVE R,1			;SAVE BP IN R
	HRROM TT,INHIBIT		;make up .5LOCKI
	RDTTY
	 ERJMP IIOERR
	HRREI F,-400.(2)
$DVLMQ:	JUMPN F,$DVLM0
	POPI FXP,80.
	PUSH FXP,TT			;RESTORE LOCKI WORD
	JRST $DVPSX			;EXIT AND TRY AGAIN IF NOTHING INPUT

$DVLM0: PUSH FXP,TT			;RESTORE LOCKI WORD
	UNLOCKI				;UNLOCK TO PERMIT CONSING
	MOVEI B,NIL
$DVLM1:	ILDB TT,R
;;; SEE ABOVE -- SIN LOSSAGE, WILL NEVER GET HERE ON TENEX
;;	SKIPN TENEXP			;IF NOT TENEX
;;	 CAIE TT,37			;OR NOT <NEWLINE>
;;	  SKIPA				;THEN LEAVE AS IS
;;	   MOVEI TT,15			;ELSE CONVERT TO ^M
	JSP T,FXCONS
	PUSHJ P,CONS
	MOVE B,A
	AOJL F,$DVLM1
	POPI FXP,80.
	PUSHJ P,NREVERSE		;CONS UP THE LIST
	MOVE C,A
	JRST $DVPS1			; AND JOIN "PRESCANNER" CODE

;;$DVLMX:
;;	MOVEI 2,-80.+1(FXP)
;;	HRLI 2,440700
;;	MOVEI 3,400.
;;	MOVEI 4,37
;;	MOVEI 1,-1
;;	HRROM TT,INHIBIT
;;	MOVE R,2
;;	SIN
;;	 ERJMP IIOERR
;;	HRREI F,-400.(3)
;;	MOVE 1,2
;;	HRR 2,3
;;	JRST $DVLMQ

]		;END OF IFN D20


î

;;; UNIT INPUT ON REAL DEVICE 	- INCLUDING "TTY" IN CASE OF CALL TO TYI FUNCT

$DEV4:	SKIPL F,F.MODE(T)		.SEE FBT.CM
	 JRST $DEV5
	HRRO TT,(FXP)			;This had better get the saved INHIBIT
					.SEE $DEV0
	MOVEM TT, INHIBIT		;TURN THE LOCKI INTO A .5LOCKI
IFN ITS,[
	MOVE R,F.CHAN(T)
	LSH R,27
	IOR R,[.IOT 0,TT]
   SPECPRO INTTYX
TYIXCT:	XCT R			;INPUT CHARACTER
   NOPRO
$DEV4B:	JUMPL TT,$DEVEF		;JUMP ON EOF
	AOS F.FPOS(T)		;OTHERWISE INCREMENT FILE POSITION (OK EVEN IF F.FLEN NEG)
	JRST $DEV6
]		;END OF IFN ITS
IFN D20,[
$DEV4C:	PUSHJ FXP,SAV3
	HRRZ 1,F.JFN(T)
   SPECPRO INTTYX
TYIXCT:	BIN			;INPUT CHARACTER
	 ERJMP $DEV4T
   NOPRO
	MOVE TT,2
	PUSHJ FXP,RST3
	AOS F.FPOS(T)		;OTHERWISE INCREMENT FILE POSITION (OK EVEN IF F.FLEN NEG)
	SKIPN TENEXP
	 JRST $DEV6
	TRNN F,10		;SAIL DOES THIS TOO?
	TLNE F,FBT<FU>		;I DON'T UNDERSTAND THIS
	 JRST $DEV6
	CAIN TT,37		;TENEX ^_ IS CR, BARF
	 MOVEI TT,^M		;^_ -> CR
	JRST $DEV6
]		;END OF IFN D20
IFN D10,[
SA$ $DEV4C:			;SAIL WANT'S LINMOD CHECK EVEN FOR TYI
	MOVE R,[INCHWL TT]
	TLNN F,FBT<LN>
SA% $DEV4C:
	 MOVE R,[INCHRW TT]
   SPECPRO INTTYX
TYIXCT:	XCT R
   NOPRO
IFN SAIL,[
	TRNE F,10		;FORGET THIS HACK FOR IMAGE MODE
	 JRST $DEV6
	MOVEI R,(TT)		;CANONICALIZE ASCII CODES
	TLNE F,FBT<FU>		;I DON'T UNDERSTAND THIS
	JRST $DEVS4		;BUT CONVERT IN NON-FULL MODE
	CAIN R,32		;TILDE: 32 => 176
	 HRROI R,176
	CAIN R,176		;RIGHT BRACE: 176 => 175
	 HRROI R,175
	CAIN R,175		;ALTMODE: 175 => 33
	 HRROI R,33
	CAIN R,33		;NOT EQUALS: 33 => 32
	 HRROI R,32
$DEVS4:	ANDI TT,600
	IORI TT,(R)
	TLNE F,FBT<FU>		;IF FULL CHARACTER SET (BUCKY BITS),
	 JRST $DEV4S		; DON'T DO ANY CONVERSIONS
	CAIN TT,33		;ALTMODE?
	 JRST $DEV4S		;YUP! SO LEAVE IT ALONE
	CAIGE TT,40		;A CONTROL CHARACTER?
	 ADDI TT,%TXCTL+"@	;YES, CONVERT TO EXTENDED ASCII FORMAT
$DEV4S:	TRNN TT,%TXCTL+%TXMTA	;USE PRESENCE OF CONTROL BIT TO CHECK FOR INT
	 JRST $DEV6
;	PUSH FXP,TT		;SAVE THE ACTUAL CHARACTER
;	SUBI TT,%TXCTL+"@
;	CAIL TT,"a-"@		;IS IT A LOWER CASE LETTER?
;	 CAILE TT,"z-"@
;	  SKIPA			;NOPE, LEAVE ALONE
;	   SUBI TT,"a-"@-1	;ELSE CONVERT TO REAL CONTROL CHARACTER
;	SKIPL TT
;	 CAILE TT,"_		;IS IT A REAL "CONTROL" CHARACTER?
;	  JRST $DEV4V		;NO, FIXUP THE WORLD AND PROCEED
]		;END OF IFN SAIL
SA%	CAIL TT,40		;CONTROL CHARS CAUSE AN INTERRUPT WHEN READ
SA%	 JRST $DEV6
$DEV4U:	HRLM D,(P)
	MOVEI D,(TT)		;ONLY INTERRUPT IF INT FUNCTION EXISTS
	ROT D,-1		;CLEVER ARRAY ACCESS AS PER TTYICH
	ADDI D,FB.BUF(T)
	PUSH FXP,R
	HLRZ R,(D)
	SKIPGE D
	 HRRZ R,(D)
	JUMPE R,$DEV4Z
	MOVEI D,400000(TT)
	HRLI D,(AR1)		;THERE IS NO OBVIOUS NEED FOR THIS NOW
	PUSHJ P,UCHINT		;GIVE USER INTERRUPT FOR TTY INT CHAR
$DEV4Z:	POP FXP,R
	HLRZ D,(P)
; SA$ $DEV4V:	POP FXP,TT		;RESTORE THE CONTROL CHARACTER
	JRST $DEV6
]		;END OF IFN D10

IFN D20,[
$DEV4T:	GTSTS
	TLNN 2,(GS%EOF)
	 JRST IIOERR
	JRST $DEVEF
]		;END OF IFN D20


;;; A TRICKY HACK TO BE CLEVER ABOUT IMMEDIATE ACTIVATION
;;; WHEN TYI (OR READCH, OR WHATEVER) IS INVOLVED.

$DEVAH:	SKIPL F,F.MODE(T)	;MUST BE THE TTY FOR THIS TO WORK
	 JRST $DEV5
	HRRO TT,(FXP)		;This had better get the saved INHIBIT
				.SEE $DEV0
	MOVEM TT,INHIBIT	;TURN THE LOCKI INTO A .5LOCKI
IT%	JRST $DEV4C		;IGNORE LINE MODE, AND USE CHARACTER INPUT UUO
IFN ITS,[
   SPECPRO INTTYX
TYICAL:	.CALL $DEV4M		;GOBBLE CHAR, EVEN IF NOT ACTIVATED
   NOPRO
	 .LOSE 1400
	MOVE TT,TTSAR(AR1)
	SKIPN R,FT.CNS(TT)
	 JRST $DVAH1		;DONE IF NO ASSOCIATED OUTPUT TTY
	HRLM D,(P)
	MOVE TT,TTSAR(R)	;UPDATE CHARPOS AND LINENUM FROM CURSOR
	PUSH FXP,T
	PUSHJ FXP,CLRO4		; POSITION OF ASSOCIATED OUTPUT TTY
	POP FXP,T
	HLRZ D,(P)
	MOVE TT,TTSAR(AR1)
$DVAH1:	EXCH T,TT
	JRST $DEV4B

$DEV4M:	SETZ
	SIXBIT \IOT\		;I/O TRANSFER
	  5000,,%TIACT		;READ CHARACTER IMMEDIATELY EVEN IF NOT ACTIVATOR
	      ,,F.CHAN(T)	;CHANNEL #
	402000,,T		;SINGLE CHAR RETURNED HERE (T, NOT TT!)
]		;END OF IFN ITS


 
;;; CODE FOR FILE ARRAYS WITH A BUFFER


$DEV5A:	PUSHJ P,$DEVBUF		;GET A NEW BUFFER LOAD.  WATCH OUT FOR EOF
	 JRST $DEVEF	
$DEV5:				;BASIC GET-1-CHAR FROM BUFFERED FILE
10$	HRRZ TT,FB.HED(T)
10$	SOSGE 2(TT)
10%	SOSGE FB.CNT(T)		;GOBBLE NEXT INPUT CHAR
	 JRST $DEV5A		;MAY NEED TO GET NEW BUFFER
10$	ILDB TT,1(TT)
10%	ILDB TT,FB.BP(T)
10$	TLNN T,TTS<IM>		;IN IMAGE MODE, WHAT YOU SEES IS WHAT YOU GETS
10$	 JUMPE TT,$DEV5		;IN ASCII MODE, A NULL IS LITTERA NON GRATA
	JRST $DEV6W


;;; READ IN A NEW BUFFERLOAD  - SKIP RETURN ON SUCCESS, NO SKIP ON EOF
;;; EXPECTS ARRAY PTR IN AR1, TTSAR IN T - SAVES D AND F

.SEE FPOS5
$DEV5K:				;LOSING SYMBOL FOR DSK:JLK;LISPT PATCH
$DEVBUF:	PUSH FXP,D
	MOVE D,FB.BVC(T)
	ADDM D,F.FPOS(T)	;UPDATE FILEPOS BY NUMBER OF VALID BYTES
	SETZM FB.BVC(T)
IFN ITS,[
	EXCH T,TT
	MOVE D,FB.BFL(TT)	;BYTE COUNT
	MOVE T,FB.IBP(TT)	;BYTE POINTER
TYICA1:	.CALL SIOT
	 .LOSE 1400
	EXCH T,TT
	SUB D,FB.BFL(T)		;NEGATIVE OF NUMBERS OF BYTES READ
	MOVNM D,FB.CNT(T)
	MOVNM D,FB.BVC(T)
]		;END OF IFN ITS
IFN D20,[
	PUSHJ FXP,SAV3		;PRESERVE LOW THREE AC'S
	HRRZ 1,F.JFN(T)
	MOVE 2,FB.IBP(T)
	MOVN 3,FB.BFL(T)
	SIN			;READ A BUFFERFUL
	ADD 3,FB.BFL(T)
	MOVEM 3,FB.CNT(T)	;STORE COUNT OF BYTES READ IN FILE OBJECT
	MOVEM 3,FB.BVC(T)
	MOVE D,3
	PUSHJ FXP,RST3
]		;END OF IFN D20
IFN D10,[
	MOVE TT,F.CHAN(T)
	LSH TT,27
IFE SAIL,[
	TLNN T,TTS.BM
	 JRST $DEV5R
	HRRZ TT,FB.HED(T)	;MAYBE BUFFER HAS BEEN RELOCATED? THEN FOR
	MOVSI D,(BF.IOU) 
	ANDCAB D,@(TT)		;TURNS OFF BUFFER-IN-USE BIT AND ADVANCES BUFFER
	SKIPGE (D)		;BF.IOU MUST BE BIT 4.9 FOR THIS TO WORK
	 JRST $DEV5S 
	MOVSI TT,TTS.BM
	ANDCAM TT,TTSAR(AR1)	;TURN OFF "BUFFER-MOVED" BIT, BUT LEAVE BUF ADDR IN D
	MOVE TT,F.CHAN(T)
	LSH TT,27
	HRR TT,D
]	;END OF IFE SAIL
$DEV5R:	TLO TT,(IN 0,)
	XCT TT			;READ A NEW BUFFERFUL
	 JRST $DEV5M		;SUCCESS!
SA%	ANDCMI TT,-1
	XOR TT,[<STATO 0,IO.EOF>#<IN 0,>]
	XCT TT
	 JRST IIOERR		;LOSEY,LOSEY
IFN SAIL,[
	MOVE D,FB.HED(T)
	MOVE D,2(D)
	MOVEM D,FB.BVC(T)
	JUMPG D,$DEV5M
]		;END OF IFN SAIL
]		;END OF IFN D10
IFN ITS+D20,	JUMPN D,$DEV5M		;D HOLDS "NOT-EOF-P"
	 POP FXP,D		;FALLS THRU TO HERE ON EOF CONDITION
	POPJ P,			; AND EXITS WITHOUT SKIPPING

IFN D10*<1-SAIL>,[
$DEV5S: HRRZ TT,FB.HED(T)
	HRRZM D,(TT)		;STORE CURRENT BUFFER ADDR IN CONTROL BLOCK
	TLZ D,-1
	ADD D,[0700,,1]
	TLNE T,TTS.BN
	 TLC D,0700#4400
	MOVEM D,1(TT)		;CONSTRUCT NEW BP FOR BUFFER
	MOVE D,(D)
	TLNN T,TTS.BN
	 IMULI D,5
	MOVEM D,2(TT)		;STORE NEW BYTE COUNT INITO BUFFERCONTROL-BLOCK
;FALL THRU TO $DEV5M
]	;END OF IFN D10*<1-SAIL>

$DEV5M:				;MORE INPUT WAS OBTAINED BY BUFFERED INPUT
IFN D10,[
	MOVE D,FB.HED(T)
	MOVE D,2(D)		;NUMBER OF VALID BYTES
	MOVEM D,FB.BVC(T)
]	;END OF IFN D10
.ELSE,[
	MOVE TT,FB.IBP(T)
	MOVEM TT,FB.BP(T)	;INITIALIZE BUFFER POINTER
]	;END OF .ELSE
	POP FXP,D
	JRST POPJ1		;SKIP RETURN ON SUCCESS



;;; WRAP UP, WITH NEW CHAR IN TT.  UPDATE "PAGENUM" AND "LINENUM", AND ECHO

$DEV6:	SETOM INHIBIT 		;RECONVERT .5LOCKI TO LOCKI
	SKIPN F,FI.BBC(T)
	 JRST $DEV6W
	HRLM D,(P)
	MOVE R,T
	PUSHJ FXP,SAV5
	JSP T,FXCONS
	PUSHJ P,NCONS
	MOVE C,A
	JRST $DVPS0

$DEV6W:	JUMPN D,$DEV6B
	MOVEI D,(TT)
	ANDI D,177+%TXCTL	;? THIS MAY SCREW CONTROL CHARS ON SAIL
	TRZN D,%TXCTL
	 JRST $DEV6A
	CAIE D,177
	 TRZ D,140
$DEV6A:	TRO D,200000
	HRLM D,FI.BBC(T)
	SETZ D,
$DEV6B:	CAIN TT,^J
	 AOS AT.LNN(T)
	CAIE TT,^L
	 JRST $DEVECO
	SETZM AT.LNN(T)
	AOS AT.PGN(T)
$DEVECO: SKIPE AR1,VECHOFILES	;SKIP UNLESS ECHO FILES
	  SKIPN D		;DON'T ECHO PEEKED-AT CHARS
	   UNLKPOPJ
SA$	CAIN TT,203
SA$	UNLKPOPJ
SA$	CAIE TT,%TXCTL+"M
SA$	 CAIN TT,%TXCTL+"m
SA$	MOVEI TT,15
	HRLI AR1,200000		;LIST OF FILES, NO TTY
	HRLM TT,AR2A
	PUSH P,AR2A
	JSP T,GTRDTB		;GET READTABLE
	LDB TT,[220700,,(P)]	;WATCHIT!  CHAR COULD BE 12. BITS
	UNLOCKI
	PUSHJ P,TYO6		;PUSH CHAR INTO ALL ECHO FILES
	HLRZ TT,(P)
	POP P,AR2A
	POPJ P,


$DEVEF:	UNLOCKI			;COME HERE ON EOF
$DVEF1:	MOVNI TT,1
	TRNN D,1	.SEE .TYI	;0 SAYS ONLY PEEKING, SO RETURN -1
	 POPJ P, 			; 2 SAYS DON'T DO EOF, SO RETURN  -1
	PUSHJ P,EOF			;SIGNAL EOF
	JRST $DEVICE			;RETRY IF WE SURVIVE

$DVEF0:	JSP R,PDLA2-5		;EOF AFTER TTYSCANNING
	JRST $DVEF1



;;; LOSING CODE FOR "$DEVICE"ING A SFA

IFN SFA,[
$DEVSFA:	PUSHJ FXP,SAV5
	PUSH FXP,D		;SAVE D OVER CALL
	SETZ C,			;NIL AS OP DEPENDENT ARGS
	JUMPE D,$DEVPE		;PEEKING, MIGHT HANDLE THE SFA DIFFERENTLY
	HRLZI T,SO.TYI		;WE ARE DOING A TYI
$DEVP1:	PUSHJ P,ISTCAL		;INTERNAL SFA CALL, SFA IN AR1
$DEVP2:	PUSHJ FXP,RST5M1
	POP FXP,D
	SKIPE A			;ALLOW NIL
	 JSP T,FXNV1		;INSURE FIXNUM AND GET INTO TT
	JUMPN A,POPAJ		;IF NON-NIL THEN GOT SOMETHING, SO RETURN IT
	MOVNI TT,1
	JUMPE D,POPAJ		;ONLY PEEKING, SO MERELY RETURN -1
	PUSHJ P,EOF		;SIGNAL EOF
	POP P,A
	JRST $DEVICE		;RETRY IF WE SURVIVE

$DEVPE:	MOVEI TT,SR.WOM		;CHECK THE WHICH-OPERATIONS MASK FOR TYIPEEK
	MOVSI T,SO.TIP
	TDNE T,@TTSAR(AR1)	;CAN IT DO IT?
	 JRST $DEVP1		;YES, DO IT DIRECTLY
	MOVSI T,SO.TYI		;ELSE DO IT AS TYI/UNTYI
	PUSHJ P,ISTCAL		;DO THE TYI
	JUMPE A,$DEVP2		;HIT EOF
	PUSH P,A		;REMEMBER THE CHAR WE WERE HANDED
	MOVSI T,SO.UNT		;NOW UNTYI THE CHARACTER
	MOVEI C,(A)		;THE ARG IS THE CHARACTER
	MOVE AR1,-2(P)		;GET THE SFA AS FIRST ARG
	PUSHJ P,ISTCAL		;DO THE UNTYI
	POP P,A			;FUDGE THE CHARACTER AS THE RETURNED VALUE
	JRST $DEVP2
]	;END IFN SFA


INFGT0:	PUSHJ P,INFLUZ
INFGET:	SKIPN AR1,VINFILE	;GET VINFILE IN AR1
	 JRST INFGT0
	POPJ P,

SINFGET: SKIPN AR1,VINFILE	;Standardizing INFile GETter
	  PUSHJ P,INFGET	;GETS VINFILE IN AR1
	SKIPE TAPRED
	 CAIN AR1,TRUTH
	  HRRZ AR1,V%TYI
	POPJ P,

$DVLUZ:	PUSH P,[$DEV$]
INFLZZ:	SKIPA T,[[SIXBIT \INFILE CLOSED!\]]
INFLUZ:	 MOVEI T,[SIXBIT \BAD VALUE FOR INFILE!\]
	PUSH P,A
	MOVEI A,TRUTH		;INFILE IS A LOSER!
	EXCH A,VINFILE
	PUSH P,CPOPAJ
	%FAC (T)



SUBTTL	READLIST, IMPLODE, MAKNAM


BYTEAC==TT

MKNR6C:	MOVEM T,MKNCH
	JSP TT,IRDA
	SKIPA
MKR6DB:	IDPB BYTEAC,C
	PUSHJ P,@MKNCH
	 JRST RDAEND
	SOJGE D,MKR6DB
	PUSH FXP,BYTEAC
	PUSHJ FXP,RDA4
	JSP TT,IRDA1
	POP FXP,BYTEAC
	SOJA D,MKR6DB




READLIST:
	JUMPE A,RDL12
	MOVEI B,RDLTYI
	MOVEI C,RDLUNTYI
	JSP T,SPECBIND
	   0 A,RDLARG
	   0 B,TYIMAN
	   0 C,UNTYIMAN
	MOVEI A,RDIN
	MOVEI TT,READ0A
	MOVEI T,LPNBUF
	PUSHJ P,RDCH4
	SKIPE T,RDLARG		;REALLY OUGHT TO ALLOW
	 CAIN T,-1		; A TRAILING SPACE
	  JRST UNBIND
	LERR RDRM1		;TOO MANY CHARS

READ0A:	PUSHJ P,REKRD		;READ AS IF "RE-ENTRANT", BUT
	TLNN T,4060		; DON'T PERMIT TOP-LEVEL SPLICING MACROS
	 JRST RMCER
	POPJ P,

;;; READLIST PEEK AND TYI ROUTINES.  (CF. $DEVICE).
;;; SAVES A,B,C,AR2A; CLOBBERS AR1.  RETURNS CHARACTER IN TT.

RDLPEK:	JRST RDLPK1		;RDLTYI-1 IS FOR PEEKING (SEE TYIPEEK)
RDLTYI:	PUSH P,A
	SKIPN A,RDLARG
	 JRST RDLTY2
	CAIN A,-1
	 LERR RDRM3		;TOO FEW CHARS
	HRRZ AR1,(A)
	MOVEM AR1,RDLARG
RDLTY1:	HLRZ A,(A)
RDLTY3:	JSP T,CHNV1
	JRST POPAJ

RDLTY9:	SIXBIT \NOT ASCII CHAR!\

RDLTY2:	HLLOS RDLARG
	MOVEI TT,203		;PSEUDO-SPACE
	JRST POPAJ

RDLPK1:	SKIPE TT,RDLARG
	 CAIN TT,-1
	  JRST M1TTPJ		;RETURN -1 FOR PEEKING AT "EOF"
	PUSH P,A
	HLRZ A,@RDLARG
	JRST RDLTY3		;ELSE RETURN CHAR, BUT DON'T FLUSH

RDLUNTYI:
	MOVEI TT,(A)
	JSP T,FXCONS
	HRRZ B,RDLARG
	PUSHJ P,CONS
	MOVEM A,RDLARG
	POPJ P,

READ6C:	PUSH FXP,A
	MOVEI T,R6C1
	PUSHJ FXP,MKNR6C
	SUB FXP,R70+1
	JRST RINTERN

R6C1:	ILDB TT,-1(FXP)
	JUMPE TT,CPOPJ
	ADDI TT,40
	JRST POPJ1



SUBTTL	READ FUNCTION


;;; ********** HIRSUTE READER **********
READ$:	MOVEI T,0	;FOR "*READ", WHICH IS "READ" WITH NO ARGS
	JRST READ

OREAD:	JSP D,INCALL
SFA%	   QOREAD
SFA$	   [SO.RED,,],,QOREAD
READ:	MOVEI A,QOREAD	;ENABLE TTY PRE-SCAN
	HRLM A,BFPRDP
	MOVEI A,RDIN
	HRRZ T,BFPRDP
	JUMPN T,READ0	;OOOOPS, A RE-ENTRANT CALL TO READ
	PUSHJ P,READ0B	;TOP-LEVEL READ
	HLLZS BFPRDP
	SKIPA B,RDBKC
READ0:	 PUSHJ P,REKRD	;RE-ENTRANT READ
	TLC T,21000	;LOSING SPLICING MACROS AT TOP LEVEL
	TLCN T,21000
	 JRST READST	;JUST GO AROUND AND TRY AGAIN

READS0:	TLNE B,100000	;IF WE ENDED WITH A PSEUDO-SPACE
	 TLNN B,40	; (40-BIT SET IN SPACE SYNTAX),
	  TLNN T,60	; OR IF OBJECT WASN'T AN ATOM,
	   POPJ P,	; THEN DO NOT BUFFER BACK A CHAR
;;; READS0:	TLNN B,100000	;IF WE ENDED WITH A "WHITE-SPACE" CHARACTER
;;; 	 TLNN T,60	; OR IF OBJECT WASN'T AN ATOM,
;;; 	  POPJ P,	; THEN DO NOT BUFFER BACK A CHAR

	JSP R,RVRCT	;OTHERWISE MUST UNTYI A CHARACTER
	EXCH A,C
	PUSHJ P,@UNTYIMAN
	JRST CRETJ

;We got a splicing macro at top level.  If it's NIL, we go around again
;Otherwise, we just CDR it.
READST: JUMPE A,READ	;If we have NIL, we have nothing!
	PUSHJ P,RDSMCK	;Check for it being a legal frob w/ CDR null
	HLRZ A,(A)	;Take the CAR of it.
	JRST READS0	;and finish up as if it were what we'd read


;;; ***** HERE IT IS FANS, THE BASIC READER *****

READ0B:	HRRZM A,RDINCH	;READ-IN CHANNEL FILTER
RD0B1:	JSP T,RDIBGT
	JSP T,RSXST
RD0B2A:
BG$	SUBI TT,10.
BG$	MOVEM TT,NRD10FL
	MOVSI T,3	;TOP LEVEL, FIRST OF LIST FLAGS
	PUSHJ P,RDOBJ1	;READ ONE OBJECT
	HRRZS A
	SETZB C,AR1
	MOVEI AR2A,0
	POPJ P,

;; PRE-FETCH VALUE OF IBASE, CHECK FOR CONSISTENCY, AND SAVE IN "RDIBS"
RDIBGT:	HRRZ TT,VIBASE
IFN USELESS,[
	CAIN TT,QROMAN
	 JRST RD0BRM
]		;END OF IFN USELESS
	SKOTT TT,FX
	 JRST IBSERR
	MOVE TT,@VIBASE
	JUMPLE TT,IBSERR
	CAIL TT,200
	 JRST IBSERR
IFN USELESS,	SETZM RDROMP
	MOVEM TT,RDIBS
	JRST (T)

IFN USELESS,[
RD0BRM:	MOVEI TT,10.
	SETOM RDROMP
	JRST (T)
]		;END OF IFN USELESS

RVRCT:	MOVE C,VREADTABLE
	MOVSI TT,-LRCT+2
	CAME B,@TTSAR(C)
	AOBJN TT,.-1
	JUMPGE TT,ER3	;BLAST? - READ
	MOVEI C,(TT)
	JRST (R)


REKRD:	SOVE RDINCH RDIBS
	PUSHJ P,READ0B	
REKRD1:	RSTR RDIBS RDINCH
	POPJ P,

RDOBJ3:	TLNE B,RS%WSP	;TAB,SPACE,COMMA
	 JRST RDOBJ1
	TLNN T,1
	 POPJ P,
	HRRZ TT,BFPRDP
	JUMPN TT,RMCER
RDOBJ1:	JSP TT,RDCHAR			;*** READ ONE OBJECT ROUTINE ***
RDOBJ:	NWTN N,B,OBB		;OBJECT BEGIN CHAR - NOT USAGE AT TYIPEEK
	 JRST RDOBJ3
	MOVEI TT,400000
	IORM TT,BFPRDP
	TLNE B,RS%MAC
	 JRST RDOBM2		;MACRO CHAR.
	TLNE B,RS%SCO
	 JRST RDCHO1		;SINGLE CHAR OBJ.
	NWTNE B,RS.<LTR+XLT>
	 JRST RDALPH		;RDOBJ WILL EXIT WITH OBJECT READ
	TLNE B,RS%LP		;IN ACC A, AND RCT ENTRY OF BREAK 
	 JRST RDLST		;CHARACTER IN ACC B
	NWTNE B,RS.DIG
	 JRST RDNUM
	NWTNE B,RS.SGN
	 JRST RDOBJ6		;+,-
	MOVE AR1,B
	JSP TT,RDCHAR		;DEFAULT IS . <DOT>
	TLNN AR1,RS.PNT
	 JRST RDOBJ0		;WAS DOTTED PAIR POINT ONLY
	NWTNE B,RS.DIG		;IS NEXT CHAR A DIGIT?
	 JRST RDOBJ5		;IF SO, THEN MUST BE FLOATING NUM COMING UP
	TLNN AR1,RS%DOT
	 JRST RDJ2A		;IF NOT DOTTED PAIR, THEN TRY ALPHABETIC
RDOBJ0:	TLNE AR1,RS%DOT		;*** DOT IS DOTTED-PAIR DOT ***
	TLNE T,1
	 JRST ER2
	TLOE T,4		;LOSE IF ALREADY IN DOTTED PAIR
	 JRST ER2
	TLNN T,200000		;SO GET SECOND PART OF DOTTED PAIR
	 JRST RDOBJ		; BUT IF HUNK, THEN DO SOME CHECKING FIRST
	PUSHJ P,RDSKWH
	 POPJ P,		;ENCOUNTERED %RP, EXIT LOOKING LIKE SECOND
	TLZ T,4			; PART OF DOT-PAIR TO SIGNAL HUNK ENDING
	JRST RDOBJ



;;;. WITH DECIMAL SYNTAX ONLY TURNS INTO SCO, IF FOLLOWED BY BREAK
;;;OR BEGINNING OF ALPHA IF FOLLOWED BY ALPHA
RDJ2A:	TLNN B,RS%<BRK+SCO+WSP+LP+DOT+RP+MAC+SLS+RBO>
	NWTNN B,RS.<PNT+ARR+SGN+XLT+LTR>
	JRST RDCHO4
	JRST RDJ2A1

RDOBJ5:	TLOA T,200	;FOUND FLOATING NUM
RDOBJ2:	TLO T,10000	;NUM FORCED WITH "+"
RDJ2A1:	JSP TT,IRDA
	IDPB AR1,C
	AOS D
	JRST RDNUM2


RDOBJ6:	JSP TT,IRDA	;PROCESS OBJ BEGINNING WITH + OR -
	IDPB B,C
	SOS D
	NWTNE B,RS.ALT
	TLO T,400	;-
	JSP TT,RDCHAR
	JRST @RDOBJ8	;CHECK FOR WHITE'S + HAC, USING RD8W, OR DONT BOTHER, USING RD8N
RDJ6A:	TLNE B,RS%<MAC+RP+LP+SCO+WSP>
	JRST RDOBJ4
	NWTNN B,RS.PNT
	JRST ER1
	MOVE AR1,B
	JSP TT,RDCHAR
	TLNE T,4
	JRST ER1
	JRST RDOBJ5	;+.D  DECIMAL FLOATING FORMAT
RDOBJ7:	NWTNE B,RS.DIG
	JRST RDNUM2	;+<DECIMAL DIGIT>
	TLO T,20	;+<ALPHA CHARA> OR +<EXTENDED ALPHA>
	JRST RDA1

	ER1:	LERR RDRM2

RDOBJ4:	TLO T,20	;SINGLE CHARA "+" OR "-"
	JRST RDBK
RD8W:	NWTNE B,RS.<DIG+LTR>
	JRST RDOBJ2
	JRST RDJ6A
RD8N:	NWTNE B,RS.<SGN+DIG+LTR+XLT>
	JRST RDOBJ7
	JRST RDJ6A


RDNUM:	JSP TT,IRDA				;*** NUMBER ATOM ***
RDNUM2:
IFE BIGNUM,	SETZM AR1	;FLAG INDICATES HOW MANY DIGITS BEYOND OVERFLOW
RDNM10:	SETZB F,R	;BASE 10. NUMBER IN R, BASE IBASE IN F
	TLOA T,40
RDNUM1:	JSP TT,RDCHAR
	NWTNE B,RS.PNT
	JRST RDNUM4	;DECIMAL POINT [WITHOUT BREAK BIT SET]
	SOSLE D 
	IDPB B,C
	NWTNE B,RS.DIG
	JRST RDNUM5
	TLNE T,300	;ALPHA CHAR SEEN
	JRST RDNUM8
	NWTNN B,RS.LTR
	JRST RDNUM7
	TLNN T,10000
	JRST RDNUM6
NW%	MOVEI TT,(B)	;GET CHTRAN
NW$	HRRZ TT,B
NW$	ANDI TT,177
	CAIL TT,"a	;ALLOW FOR LOWER CASE LETTERS
	SUBI B,"a-"A
	SUBI B,"A-"0-10.	;LETTERS ARE SUPRA-DECIMAL:
	JRST RDNUM5		; A=10., B=11., ..., Z=35.

RDNUM8:
NW%	CAIE A,"E	;UPPER AND LOWER CASE E ALLOWED
NW%	CAIN A,"e	;MUST TIDY THIS UP SOMEDAY
NW$	TLNE B,RS%SQX	;EXPONENT OR (SOMEDAY) STRING-QUOTE
	JRST RDNM8A
	NWTNN B,RS.XLT
	JRST ER1
RDNUM7:	TLNE T,37000	;EXTENDED ALPHA CHAR SEEN
	JRST ER1
	NWTNN B,RS.ARR
	JRST RDNUM6
	NWTNE B,RS.ALT
	TLOA T,2000	;_
	TLO T,1000	;^
BG$	SKIPN NRD10FL	;IF WE ARE READING IN BASE 10., THEN
BG$	TLO T,100	; F HAS NOTHING IN IT - SO MUST TAKE R
RDNUM9:	TLNN T,140000
	JRST RDNM9E
	TLNE T,300	;FOR EXPONENT-IFIED BIGNUMS, RDNSV WILL
	HRR AR2A,AR1	;BE MEANINGLESS
	HRLI AR2A,0
	TLNE T,400	;BIGNUM OF CORRECT BASE AND SIGN IS PUT IN AR2A
	TLO AR2A,-1
	JRST RDNM9B
RDNM9E:	TLNE T,300
	MOVE F,R
	TLNE T,400
	MOVNS F
	MOVEM F,RDNSV
RDNM9B:	TLZ T,500		;ZERO OUT SIGN AND DECIMAL BITS
	MOVEI D,BYTSWD*LPNBUF
	JSP TT,RDCHAR
RDNM9C:	NWTNN B,RS.<DIG+SGN>
	JRST ER1
	NWTNN B,RS.SGN
	JRST RDNM10
	NWTNE B,RS.ALT	;SKIP IF +
	TLO T,400
	JSP TT,RDCHAR
	JRST RDNM10


RDNUM0:	IDPB B,C
RDNUM6:	TLZ T,340	;TWAS REALLY AN ALPHA ATOM
	TLO T,20
	JRST RDA3

RDNM8A:	TLZ T,100
	TLO T,1200
	MOVEM D,RDDSV
	JRST RDNUM9


RDNMF:	JRST 2,@[.+1]	;CLEAR OUT ALL ARITHMETIC OVERFLOW BITS
	MOVE B,T
	MOVE TT,F	;FINISHED WITH NUMBER READ, SO PICK UP NUMBER IN BASE IBASE
BG$	SKIPN NRD10FL
BG$	TLO T,100
	TLNN T,300
	JRST RDNM2
	MOVE TT,R	;PICK UP NUMBER IN BASE 10.
IFE BIGNUM,[
	JUMPE AR1,RDNM2	;NUMBER OF OVERFLOW DIGITS IN AR1
	TLNN T,200
	JRST RDNMER
	ADDM AR1,D
	ADDM AR1,RDDSV
]
RDNM2:	TLNE T,400
	MOVNS TT	;NEGATIVE NUMBER, IF INDICATED
BG$	TLNE T,140000
BG$	JRST RDBIGN
RDNM2A:	TLNE T,200
	JRST RDFLNM
RDFXNM:	TLNE T,3000
	JRST RDFXEX
RDFX1:	JSP T,FXCONS
RDFL1:	MOVE T,B
	JRST RDNMX



RDNUM5:	JFCL 8.,.+1		;BASIC LOOP THAT INCREMENTALLY ADDS IN ONE DIGIT
IFE BIGNUM, JUMPN AR1,RDNUMC
IFN BIGNUM,[
	TLNE T,40000
	JRST RDBG10
]
RDNUMD:	MOVE TT,R	;BASE 10. VALUE ACCUMULATES IN R
	IMULI R,10.	;BASE IBASE VALUE IN F
NW%	ADDI R,-"0(B)
NW$	LDB A,[001100,,B]
NW$	ADD R,A
	JFCL 8,RD10OV
IFN BIGNUM,[
	TLNE T,100000	;BIGNUM VALUE BASE 10. HELD IN AR1
	JRST RDBGIB	;BIGNUM VALUE BASE IBASE HELD IN AR2A
RDNUMB:	SKIPN NRD10FL
	JRST RDNUM1
]
IFE BIGNUM, RDNUMB: 
	JFCL 8,.+1	;MIGHT BE SET IF OVFL ON BASE 10. READIN, WENT TO RD10OV, DID A C1CONS,
	MOVE TT,F	;DID A GC, HACKED AROUND AND SET IT AGAIN!
	IMUL F,RDIBS
NW%	ADDI F,-"0(B)
NW$	LDB A,[001100,,B]
NW$	ADD F,A
	JFCL 8,RDIBOV
	JRST RDNUM1

IFE BIGNUM,[
RDIBOV:	MOVE F,T
	MOVE T,TT	;OVERFLOW WHILE ACCUMULATING NUMBER
	MUL T,RDIBS	;IN BASE IBASE.  TRY TO RECUPERATE
	LSH T+1,1	;TO ALLOW, FOR EXAMPLE, 400000000000
	LSHC T,35.
NW%	ADDI T,-"0(B)
NW$	ADD T,A
	EXCH T,F
	JRST RDNUM1
RD10OV:	MOVE R,TT
RDNUMC:	AOJA AR1,RDNUMB
]


RDFXEX:
IFN BIGNUM,	CAIG A,77
	TLNE T,600
	JRST ER1
	ANDI TT,777
	EXCH TT,RDNSV
	TLNN T,2000
	JRST .+3
	LSH TT,@RDNSV
	JRST RDFX1
IFN BIGNUM,[
	SKIPGE TT
	TLO T,400
	MOVMS TT
RX1:	SOSGE RDNSV
	JRST RDFX2
	TLNE T,100000
	JRST RDEX3
]
IFE BIGNUM,[
RX1:	SOSGE RDNSV
	JRST RDFX1
]
	MUL TT,RDIBS
IFN BIGNUM,JUMPN TT,RDEXOF
	LSH TT+1,1
	LSHC TT,35.
	JRST RX1

IFN BIGNUM,[
RDFX2:	TLNE T,100000
	JRST RDBIGM
	TLNE T,400
	MOVNS TT
	JRST RDFX1
]

RDFLNM:	TLNN T,1000
	JRST RDFL3
	MOVE D,RDDSV
	ADD D,TT
	AOS D
	MOVE TT,RDNSV
RDFL3:	HRREI R,-BYTSWD*LPNBUF-1(D)
IFN BIGNUM,[
	TLZE T,140000
	JRST RDFL3A
]
	IDIVI TT,400000
	SKIPE TT
	TLC TT,254000
	TLC TT+1,233000
	SKIPE KA10P
	 JRST .+7
	PUSH FLP,TT+1
	SETZ TT+1,
	PUSH FLP,TT+1
	DFAD TT,-1(FLP)
	POPI FLP,2
	JRST .+2
	 FADL TT,TT+1
RDFL3A:	MOVM T,R
RDFL2A:	JUMPGE R,RDL2A2
RDFL2D:	SETZ R,
	CAIG T,30.
	JRST RDL2D3
	FSC TT,54.		;SCALE, SO THERE WONT BE UNDERFLOWS
	MOVNI R,54.
RDL2D0:	SKIPN KA10P
	 JRST .+5
	FDVL TT,D1.0E8		;LOOP FOR MULTIPLYING-IN NEGATIVE POWER OF 10.0
	FDVR TT+1,D1.0E8
	FADL TT,TT+1
	JRST .+2
	 DFDV TT,D1.0E8
	SUBI T,8
RDL2D3:	CAILE T,8
	JRST RDL2D0
	JUMPE T,RDFL2E
RDL2D1:	SKIPN KA10P
	 JRST .+5
	FDVL TT,D10.0
	FDVR TT+1,D10.0
	FADL TT,TT+1
	JRST .+2
	 DFDV TT,D10.0
	SOJG T,RDL2D1
RDFL2E:	SKIPE KA10P
	 JRST RDL2EB
	SKIPGE T,TT		;REMEMBER SIGN IN T
	 DMOVN TT,TT		;NEGATE SO THAT "ROUNDP" TEST CAN BE EASY.
	TLNE TT+1,200000	;DECIDE WHAT EFFECT, IF ANY, ROUNDING WILL HAVE
	 TRON TT,1		; LSB WAS 0, SO JUST SET IT
	  JRST RDL2EC		; OR NO EFFECT AT ALL
	MOVE TT+1,TT		;"HEAVY" CASE. CREATE A FLONUM  IN TT+1 WHOSE 
	AND TT+1,[777000,,1]	; VALUE IS 1 LSB OF FRACTION (ACCOUNTING FOR
	JUMPGE T,RDL2EB		; A PROPOGATED CARRY).
	 MOVNS TT		;RE-NEGATE BACK, IF NECESSARY
	 MOVNS TT+1
RDL2EB:	FADR TT,TT+1		;ADD IN THE ROUNDING BIT
RDL2EA:	FSC TT,(R)
	JFCL 8,RDL2E1
RDL2E0:	JSP T,FPCONS
	JRST RDFL1
RDL2E1:	JSP T,.+1
	SKIPE VZUNDERFLOW
	TLNN T,100			;RANDOM FP UNDERFLOW BIT
	JRST RDNMER
	MOVEI TT,0
	JRST RDL2E0

RDL2EC: SKIPG T
	 MOVNS TT
	JRST RDL2EA

RDL2A0:	SKIPN KA10P		;LOOP FOR MULTIPLYING-IN POSITIVE POWER OF 10.0
	 JRST .+7
	MOVE TT+2,TT+1
	FMPR TT+2,D1.0E8
	FMPL TT,D1.0E8
	UFA TT+1,TT+2
	FADL TT,TT+2
	JRST .+2
	 DFMP TT,D1.0E8
	SUBI T,8
RDL2A2:	CAIL T,8
	JRST RDL2A0
	JUMPE T,RDL2A3
RDL2A1:	SKIPN KA10P
	 JRST .+7
	MOVE TT+2,TT+1
	FMPRI TT+2,(10.0)
	FMPL TT,D10.0
	UFA TT+1,TT+2
	FADL TT,TT+2
	JRST .+2
	 DFMP TT,D10.0
	SOJG T,RDL2A1
RDL2A3:	SETZ R,
	JRST RDFL2E



RDLST:	AOS BFPRDP
	PUSH P,T	;*** READ LIST ***
	PUSH P,R70	;POINTER TO LAST OF FORMING LIST
	HRLZI T,2
	JRST RDLST3

RDLSTA:	TLZE T,2	;"ADD" AN ITEM TO A FORMING LIST
	JRST RDLSAA
	HLR B,(P)	;IFN NEWRD,??
	HRRM A,(B)
	JRST (TT)
RDLSAA:	MOVEM A,(P)
	JRST (TT)

RDHNK1:	TLZN T,4060	;IF THE NULL ITEM, FOLLOWED BY %RP 
	 JRST RDLSX	; FOR HUNK, THEN EXIT.
RDLST1:	PUSHJ P,NCONS	;GOT NEXT ITEM FOR LIST (OR HUNK)
	JSP TT,RDLSTA
	HRLM A,(P)
RDLST0:	MOVE B,AR2A	;ZAP OUT OBJECT BITS, EXCEPT FOR "HUNK" AND
RDHNKA:	TLZA T,-1#200002; "FIRST OBJECT" (MAYBE null splicing macro
RDLST3:	 JSP TT,RDCHAR	;  causes return to here with nothing accumulated).
RDLS3Y:	PUSHJ P,RDOBJ
	TLZE T,4
	 JRST RDLST4	;OJBECT JUST READ WAS PRECEEDED BY A DOT
	MOVEM B,AR2A
	TLZE T,20000
	 JRST RDLS3D	;MACRO-PRODUCED OBJ RETURNED
	TLNE T,200000
	 JRST RDHNK1	;CONTINUING WITH A HUNK
	TLNE T,24060	;EXIT IF NO OBJECT READ
	 JRST RDLST1
RDLSX:	TLNN B,RS%RP
	LERR RDRM6	;BLAST, MISSING ")"
	SOS BFPRDP
	POP P,A
	TLZE T,200000
	 PUSHJ P,MAKHUNK
	POP P,T
RDLSX1:	MOVSI B,RS%<BRK+WSP>	;THROWAWAY BREAK-CHARACTER
	TLO T,4000
	POPJ P,


RDLS3D:	TLNN T,4060		;MACRO-OBJECT RETURNED WITHIN A LIST, HENCE
RMCER:	 LERR RDRM5		;READ MACRO CONTEXT ERROR
	TLNN T,1000
	 JRST RDLST1		;NORMAL MACRO OBJECT
	TLZ T,-1#200002		;DONT FLUSH "HUNK" OR "1ST OBJ OF LIST" BITS
	JUMPE A,RDLST0		;NIL is just ignored
	MOVEI TT,(A)		;Let's check this out, is this an atom?
	LSH TT,-SEGLOG		;Get the segment number
	SKIPL ST(TT)		;Is it a CARCDRable?
	  JRST RDSMER		;  yes, let him know he lost
	JSP TT,RDLSTA
	JSP AR1,RLAST		;SPLICING MACRO OBJECT
	HRLM A,(P)
	JRST RDLST0



RDLST4:	JUMPN T,RDLS4A		;OJBECT JUST READ WAS PRECEEDED BY A DOT
	SKIPN VMAKHUNK
	 JRST ER2
	TLO T,200000		; BUT NOTHING AFTER THE DOT EXCEPT A %RP
	JRST RDLSX

RDLS4A:	TLNE T,2		;*** DOT PAIR ***
	 JRST ER2
	TLZ T,60
	TLNE T,200000		;COMBINATION OF "HUNK" AND "DOT" BITS ON 
	 JRST RDLSX		; WHEN EXITING FROM RDOBJ MEANS ".)" CASE
	MOVS TT,(P)
	HRRM A,(TT)
	TLZE T,20000
	 TLZN T,1000		;OJBECT IMMEDIATELY FOLLOWING "DOT" IS
	  JRST RDLS4B
	MOVE AR2A,RCT0+".	;MACRO-PRODUCED SPLICING OBJECT AS "DOT"+OBJ 
	JUMPE A,RDLST0		;THROW AWAY IF RETURN ()
	HRRZ AR2A,(A)
	JUMPN AR2A,ER2
	HLRZ A,(A)
	HRRM A,(TT)	
RDLS4B:	PUSHJ P,RDSKWH		;SCAN CHARS FOLLOWING OBJ TO RIGHT OF DOT
	 JRST RDLSX		; HOPEFULLY, NEXT INTERESTING ONE IS A %RP
	TLNE B,RS%DOT
	 JRST RDHNK		;IF ITS ANOTHER DOT, THEN WE HAVE A HUNK
	TLNE B,RS%MAC
	 NWTNN B,RS.ALT
	  JRST ER2
	PUSHJ P,RDOBJM		;SPLICING MACRO AFTER "DOT"+OBJECT
	JUMPE A,RDLS4B		;THROW AWAY IF RETURN ()
	JRST RDSME2		;Otherwise, it's gotta be an error!

RDHNK:	SKIPN VMAKHUNK
	 JRST ER2
	TLO T,200000	;BEGIN NOTICING THAT THIS IS A HUNK
	MOVS TT,(P)
	HRRZ A,(TT)	;UNDO THE CDR OF THE CELL
	PUSHJ P,NCONS
	HRRM A,(TT)
	HRLM A,(P)
	PUSHJ P,RDSKWX		;SCAN CHARS FOLLOWING OBJ TO RIGHT OF DOT
	 JRST RDLSX		; HOPEFULLY, NEXT INTERESTING ONE IS A %RP

	JRST RDHNKA

RDSKWH:	TLNE B,RS%RP	;RIGHT PAREN? THEN EXIT NORMALLY
	 POPJ P,
	NWTN E,B,WTH
	 JRST POPJ1	;EXIT BY SKIPPING IF "INTERESTING" CHAR IS NOT PARENS
RDSKWX:	JSP TT,RDCHAR	;IF CHAR IS UNWORTHY, THEN FLUSH IT AND TRY AGAIN
	JRST RDSKWH


RDOBM2:	PUSHJ P,RDOBJM	;Get the object.
	TLNE T,4	;Was this proceeded by a .?
	  TLNN T,1000	;  And splicing?
	    POPJ P,	;    NO
	JRST RDSMCK	;Yes, do error checking and return


RDOBJM:	TLO T,20000	;*** MACRO CHARACTER ***
	NWTNE B,RS.ALT	;SPLICING?
	TLO T,1000	;SPLICING MACRO
	PUSH P,T
	PUSH FXP,BFPRDP
NW%	CALLF 0,(B)	;MACRO CHARACTER HAS LINK IN RH OF
IFN NEWRD,[
	LDB D, [001100,,B]
	PUSHJ P, GETMAC
	HRRZ A, (A)
	CALLF 0, (A)
]	;END OF IFN NEWRD
	POP FXP,BFPRDP
	JSP T,RDIBGT	;RE-CACHE THE IBASE DATA
	JSP T,RSXST	;RE-CACHE THE READTABLE DATA
	POP P,T
	JRST RDLSX1

RDSMCK:	JUMPE A,CPOPJ	;NIL is always OK
	PUSH FXP,T	;Temp
	MOVEI T,(A)	;Copy
	LSH T,-SEGLOG	;Get the type bits
	SKIPL ST(T)	;Can it be CARCDRed?
	  JRST RDSME1	;  No, barf about it (ILLEGAL RETURN VALUE FROM ...)
	POP FXP,T
	HRRZ B,(A)	;CDR the frob
	JUMPN B,RDSMER	;  Error if more than one
	POPJ P,


RDALPH:	TLO T,20	;*** PNAME ATOM ***
	SETOM LPNF
RDA0:	JSP TT,IRDA1
RDA1:	IDPB B,C
RDA3:	JSP TT,RDCHAR
	SOJG D,RDA1
	MOVEM B,AR2A
	PUSHJ FXP,RDA4
	MOVE B,AR2A
	JRST RDA0

RDA4:	PUSHJ P,PNCONS	;ADDS ANOTHER SEGMENT TO A LONG PNAME LIST
	AOSN LPNF
	PUSH P,R70
	MOVE B,(P)
	EXCH A,B
	PUSHJ P,.NCONC
	MOVEM A,(P)
	POPJ FXP,

RLAST:	JUMPE A,(AR1)
RLAST1:	HRRZ TT,(A)
	JUMPE TT,(AR1)
	LSH TT,-SEGLOG
	SKIPL ST(TT)
	 JRST RMCER
	HRRZ A,(A)
	JRST RLAST1

RDCHO1:	MOVE AR1,B
	NWTNN B,RS.PNT
	JRST RDCHO3
	JSP TT,RDCHAR	;. AS SCO ALSO HAS DECIMAL PT. SYNTAX
	NWTNE B,RS.DIG
	JRST RDOBJ5	;WILL TAKE AS FLOTING PT. NUM
	NWTN N,B,WTH	;SKIP IF WORTHY CHAR
	JRST RDCHO3	;CAN TOSS OUT NEXT UNWORTHY CHAR
RDCHO4:	PUSH FXP,B	;OTHERWISE, SAVE NEXT CHAR AS IF IT WERE IMPORTANT BREAK CHAR
	SKIPA C,[RDCHO2]
RDCHO3:	MOVEI C,RDLSX1
	MOVE B,AR1
	PUSH P,C
RDCHO:	JSP TT,IRDA	;*** SINGLE CHARA OBJECT ***
	SETZM PNBUF
	IDPB B,C
	JRST RINTERN


RDCHO2:	POP FXP,B	;AFTER MAKING UP . AS SCO,
	MOVEM B,RDBKC	;MAKE NEXT CHAR LOOK LIKE
	TLO T,20	;IMPORTANT BREAK CHAR
	POPJ P,

IFN BIGNUM,[
RD10OV:	TLO T,40000
	JSP A,RDRGSV
	PUSHJ P,C1CONS
	MOVE AR1,A
	JRST RDBG1A

RDIBOV:	TLO T,100000
	JSP A,RDRGSV
	PUSHJ P,C1CONS
	MOVE AR2A,A
	JRST RDBGIA


RDBG10:	TLNE T,3000
	JRST RDNUMD	;GETTING EXPONENT MODIFIER
	JSP A,RDRGSV
RDBG1A:	MOVE T,AR1
	MOVEI D,-"0(B)
NW$	ANDI D,177
	MOVEI TT,10.
	PUSHJ P,.TM.PL
	MOVE T,TSAVE
	TLNE T,100000
	JRST RDBGIA
	JSP A,RDRGRS
	JRST RDNUMB

RDBGIB:	TLNE T,3000
	JRST RDNUMB	;GETTING EXPONENT MODIFIER
	JSP A,RDRGSV
RDBGIA:	MOVE T,AR2A
	MOVE TT,RDIBS
	MOVEI D,-"0(B)
NW$	ANDI D,177
	PUSHJ P,.TM.PL
	JSP A,RDRGRS
	JRST RDNUM1

.RDMULP:	SKIPA T,A
.TIMER:	MOVEI D,0	;T IS LIST OF DIGITS, TT IS MULTIPLIER, 
.TM.PL:	HLRZ A,(T)	;D IS CARRY.  
	MOVE R,(A)
	MUL R,TT
	ADD R+1,D
	TLZE R+1,400000
	AOS R
	MOVEM R+1,(A)
	MOVE D,R
	HRRZ A,(T)
	JUMPN A,.RDMULP
	JUMPE D,CPOPJ
	MOVE TT,D
	PUSHJ P,C1CONS
	HRRM A,(T)
	POPJ P,

;;;	IFN BIGNUM

RDRGSV:	MOVEM T,TSAVE
	MOVEM D,DSAVE
	MOVEM R,RSAVE
	MOVEM F,FSAVE
	JRST (A)

RDRGRS:	MOVE T,TSAVE
	MOVE D,DSAVE
	MOVE R,RSAVE
	MOVE F,FSAVE
	JRST (A)


RDEXOF:	TLO T,100000
	PUSH FXP,TT+1
	PUSHJ P,C1CONS
	MOVE B,A
	POP FXP,TT
	PUSHJ P,C1CONS
	HRRM B,(A)
	TLNE T,400
	TLO A,-1
	JRST RX1

RDEX3:	PUSH P,A
	MOVEM T,TSAVE
	MOVE T,A
	MOVE TT,RDIBS
	PUSHJ P,.TIMER
	MOVE T,TSAVE
	POP P,A
	JRST RX1


RDBIGN:	TLNE T,3000
	JRST RDBGEX
	HRLI A,0	;CREATE BIGNUM SIGN
	TLNE T,400
	TLO A,-1
	TLNE T,100000
	TLNE T,300
	JRST RDCBG
	HRR A,AR2A
RDBIGM:	PUSHJ P,BNTRSZ
	MOVE TT,[400000,,0]
	JRST RDFX1
	PUSHJ P,BNCONS
	MOVE B,RDBKC
	POPJ P,


;;;	IFN BIGNUM

RDBGEX:	TLNE T,200
	JRST RDBXFL
	MOVEI D,1
	TLNE T,2000
	JRST RDBFSH
	JUMPLE TT,RDBGXM
	IMUL D,RDIBS	;<BIGNUM>^(TT)
	SOJG TT,.-1
RDBGXM:	MOVE TT,D
	MOVEM T,TSAVE
	HRRZ T,AR2A
	PUSHJ P,.TIMER
	MOVE A,AR2A
	MOVE T,TSAVE
	JRST RDBIGM

RDBFSH:	LSH D,(TT)	;<BIGNUM>_(TT)
	JRST RDBGXM


RDBXFL:	ADD TT,RDDSV
	SUBI TT,BYTSWD*LPNBUF
	MOVE A,AR2A
	JRST RDCBG1

RDCBG:	TLNN T,300
	JRST RDNM2B
	HRR A,AR1
	TLNN T,200
	JRST RDBIGM
	HRREI TT,-BYTSWD*LPNBUF-1(D)
RDCBG1:	PUSH FXP,TT		;THIS IS THE POWER-OF-TEN EXPONENT
	MOVE TT,A
	PUSHJ P,FLBIGZ
	POP FXP,R
	JFCL 8.,RDNMER
	JUMPGE A,RDFL3A
	DFN TT,TT+1
	JRST RDFL3A


RDNM2B:	TLZ T,140000	;A BIGNUMBER BASE 10. WAS REALLY A REGNUM
	JRST RDNM2A	;BASE IBASE, BUT BIG ENOUGH TO OVFLO BASE 10. CALC
]		;END OF IFN BIGNUM

SUBTTL	READER SINGLE-CHARACTER FILTER

;;; ***** READ ONE CHARACTER (FOR READ) *****

RDCHAR:	PUSHJ P,@RDINCH
	MOVE B,@RSXTB
RDCH1:
NW%	JUMPGE B,(TT)
NW$	NWTNE B,RS%BRK
NW$	JRST (TT)
	NWTN E,B,[<SQX+SCO+WSP+LP+DOT+RP+MAC+PNT>]
	  JRST RDBK	;BREAKING CHAR FOUND
	NWTN N,B,WTH
	JRST RDCHAR	;WORTHLESS CHAR
	TLNN B,RS%SLS
	JRST (TT)	;ALPHABETIC CHAR WITH BREAK BIT SOMEHOW SET
	PUSHJ P,@RDINCH	;/
NW%	HRR B,A		;PUT EXTENDED ALPHABETIC SYNTAX ON THIS CHAR
NW%	HRLI B,2
NW$	MOVEI B,RS.XLT(A)
	JRST (TT)
RDBK:	MOVEM B,RDBKC
	TLNN T,60
	  JRST (TT)
	TLNN T,20		   ;From here down, we're reading literal token
	  JRST RDNUM4
	PUSHJ FXP,RDAEND	   ;Symbol
IFN USELESS,	SKIPE RDROMP
IFN USELESS,	PUSHJ P,RDROM
	PUSHJ P,RINTERN
RDNMX:	MOVE B,RDBKC
	POPJ P,

RDNUM4:	TLNN T,300
	  TLNN B,200
	    JRST RDNM4A
	PUSHJ P,@RDINCH		;. FOUND
	MOVE B,@RSXTB
	NWTN N,B,SEE
	  JRST .-3		;CONTROL-CHARS ARE IGNORED
	MOVEI D,BYTSWD*LPNBUF+1
	NWTNE B,RS.DIG
	  TLOA T,200
	    TLO T,100
	JRST RDCH1

RDNM4A:	TLNE B,RS.SGN
	  TLNN T,3000
	    JRST RDNMF	;TERMINATES A NUMBER TOKEN, UNLESS A SIGN IS 
	      JRST (TT)	;FOLLOWING AN EXPONENTIATOR


IFN USELESS,[
RDROM:	SKIPGE LPNF
	 SKIPN PNBUF
	  POPJ P,
	MOVEI D,(C)
	CAIL D,PNBUF+LPNBUF-1		;TOO BIG TO DO ANOTHER ILDB ?
	 POPJ P,
	PUSH FXP,C
	SETZB TT,D
	IDPB D,C
	MOVE C,[440700,,PNBUF]
RDROM1:	ILDB F,C
	JUMPN F,RDROM2
	PUSH FXP,T
	JSP T,FXCONS
	POP FXP,T
	SUB FXP,R70+1
	JRST POPJ1

RDROM2:	SETZ R,
IRP X,,[M,D,C,L,X,V,I]N,,[1000.,500.,100.,50.,10.,5,1]
	CAIN F,"X
	MOVEI R,N
TERMIN
	JUMPE R,RDROM7
	ADDI TT,(R)
	CAIG R,(D)
	 JRST RDROM3
REPEAT 2,	SUBI TT,(D)
RDROM3:	MOVEI D,(R)
	JRST RDROM1

RDROM7:	POP FXP,C
	POPJ P,
]		;END OF IFN USELESS


RDAEND:	LSHC B,6
	DPB B,[360600,,C]
	SETZM B
	LSHC B,-6
	DPB B,C
	SKIPGE LPNF
	POPJ FXP,
	PUSHJ P,PNCONS	;DESTROYS TT
	POP P,B
	EXCH A,B
	PUSHJ P,.NCONC
	POPJ FXP,

IRDA:	SETOM LPNF		;INITIALIZE FOR READING PNAME-TYPE ATOM
IRDA1:	MOVE C,PNBP
	MOVEI D,BYTSWD*LPNBUF
	JRST (TT)

RDIN:	PUSHJ FXP,SAV5M1
	PUSHJ P,SAVX5
	PUSHJ P,@TYIMAN
	MOVEI A,(TT)		;***** GRUMBLE *****
	PUSHJ FXP,RST5M1
	JRST RSTX5


;;;; ERROR MSGS ETC

ER2:	LERR RDRM4	;CONTEXT ERROR WITH DOT NOTATION -READ
ER3:	LERR RDRM7	;BLAST?
RDNMER:	LERR RDRM8	;NUMERIC OVERFLOW
RDSME2:	LER3 RDRM9	;MULTIPLE SPLICING MACROS RETURNED NON-NIL AFTER "."

RDSME1:	POP FXP,T
RDSMER:	LER3 RDRM11	;ILLEGAL RETURN VALUE FROM SPLICING MACR




SUBTTL	BUILT-IN MACRO CHARACTER PROCESSORS

;;; SINGLE QUOTE PROCESSOR:
;;;	'FOO  =>  (QUOTE FOO)

RDQTE:	MOVEI T,0
	PUSHJ P,OREAD		;FOR THE WHITE SINGLE-QUOTE HAC
	PUSHJ P,NCONS
	MOVEI B,QQUOTE
	JRST XCONS

;;; SEMICOLON COMMENT PROCESSOR:		(SPLICING)
;;;	; -- ANYTHING -- <CR>  =>  NIL, HENCE IGNORED

RDSEMI:	PUSHJ P,RDSMI0
	JUMPE A,CPOPJ		;OK, FOUND CR
	JRST RDLNER
	
RDSMI0:	PUSH P,[,,-1]
	MOVNI T,1
	JSP D,INCALL
	   QRDSEMI	;THIS SHOULD NEVER [!!] BE USED
RDSMI1:	PUSHJ P,TYI
SA$	CAIE A,%TXCTL+"M
SA$	 CAIN A,%TXCTL+"m
SA$	  JRST FALSE	;YET ANOTHER GODDAM SAIL CHARACTER SET SCREWUP
	CAIE A,15	;CR
	 JRST RDSMI1
	JRST FALSE

;;; VERTICAL BAR PROCESSOR:
;;;	|ANYTHING|  =>  /A/N/Y/T/H/I/N/G
;;;	I.E. IT IS A SUPER SYMBOL QUOTER (ALMOST LIKE ""'S)

RDVBAR:	SKIPA T,["|]
RDDBLQ:	MOVEI T,"" 
	PUSH FXP,T
	PUSH FXP,R70		;WATCH OUT - THESE SLOTS USED BY RDVB2
	PUSHJ P,RDVB0
	SUB FXP,R70+1
	POP FXP,T
	CAIN A,-1
	 JRST EOFER
	CAIN T,"|
	 JRST RINTERN
	PUSHJ P,PNGNK1		;FOR "
	MOVE AR1,A
	JSP T,.SET		;HAPPILY, THE RESULT IS ALSO IN A
RDVB5:	MOVEI C,Q%ISM
	MOVEI B,TRUTH
	PUSHJ P,PUTPROP
	MOVE A,AR1
	POPJ P,

RDVB0:	PUSH P,[,,-1]
	MOVNI T,1
	JSP D,INCALL
	   QRDVBAR	;THIS SHOULD NEVER [!!] BE USED
	JSP T,GTRDTB
	MOVEI T,RDVB3
	PUSHJ FXP,MKNR6C
	POPJ P,


RDVB2:	SETOM -1(FXP)
RDVB3:	PUSH FXP,D
	PUSHJ P,TYI
	POP FXP,D
	CAIN TT,203		;RARE CASE WHEN | IS CALLED FROM WITHIN
	 JRST RDVB3		; A READLIST - MAY SEE A PSEUDO-SPACE.
SA$	CAIE TT,%TXCTL+"M
SA$	 CAIN TT,%TXCTL+"m
SA$	MOVEI TT,15
	CAIN TT,^J
	 SKIPN -1(FXP)
	  JRST RDVB4
	SETZM -1(FXP)
	JRST RDVB3

RDVB4:	SETZM -1(FXP)
	CAMN TT,-2(FXP)
	 POPJ P,
	SKIPGE T,@TTSAR(AR2A)
	 TLNN T,2000
	  JRST POPJ1
	PUSH FXP,D
	PUSHJ P,TYI
	POP FXP,D
	CAIN TT,^M
	 SETOM -1(FXP)
	JRST POPJ1

IFN ITS+SAIL,[

;;; SPLICING MACRO CHARACTER FUNCTIONS FOR ^Q AND ^S.

CTRLQ:	MOVEI A,TRUTH
	MOVEM A,TAPRED
	JRST FALSE

CTRLS:	SETZM TTYOFF
	JRST TERPRI

]	;END OF IFN ITS+SAIL


SUBTTL	NEWIO TTY PRESCAN, RUBOUT HANDLER, AND READLINE

;;; INITIAL TTY CHARACTER BUFFERING ROUTINE.
;;; BUFFERS UP A LIST OF CHARACTERS FOR TTY INPUT.
;;; HANDLES ALL APPROPRIATE RUBOUT PROCESSING.
;;; ARGUMENTS ARE A TTY INPUT FILE ARRAY IN A,
;;; THE FUNCTION TO BUFFER FOR IN B (E.G. QOREAD),
;;; AND THE COUNT OF UNMATCHED LEFT PARENS IN C.
;;; RUBOUT ECHOING IS PERFORMED ON THE ASSOCIATED OUTPUT
;;; TTY, IF ANY.  HAIRY ERASING RUBOUT IS DONE FOR DISPLAYS.
;;; NO RUBOUT HACKING IS DONE IF THERE IS NO ECHO FILE.

;;; THESE ARE COMPATIBLE WITH THE ITS DEFINITIONS:
%TXMTA==:400			;META BIT
%TXCTL==:200			;CONTROL BIT
%TXASC==:177			;ASCII CODE

TTYBUF:
IFN SFA,[
	JSP TT,AFOSP
	 JFCL
	 JRST .+2
	  JRST	[ CALLF 3,QLIST
		  HRRZ C,(A)
		  HLRZ A,(A)
		  MOVEI B,QTTYBUF
		  JRST ISTCSH ]
]	;END OF IFN SFA
	JSP T,SPECBIND
	    VECHOFILES
	0 A,VINFILE
	CAIN A,TRUTH
	 HRRZ A,V%TYI
	PUSH FXP,(C)
	CAIE C,QOREAD
	 SETZM (FXP)
	JSP T,GTRDTB		;GET READTABLE;AR2A 4.9 = USEFULP
	CAIN B,Q%READLINE	;AR2A 4.9 => USEFULP
	 TLO AR2A,200000	;AR2A 4.8 => READLINE
	MOVEI TT,LRCT-2		;AR2A 4.7 => (STATUS TTYREAD) = T
	HLRZ C,@TTSAR(AR2A)
	SKIPE C
	 TLO AR2A,100000
	MOVE C,A
	MOVEI TT,FT.CNS		;GET ASSOCIATED OUTPUT TTY
	SKIPE C,@TTSAR(A)	; (THE SIGN BIT TELLS TYO6 THIS IS ONE FILE)
	 PUSHJ P,TTYBRC		;MAYBE GET CURCOR POSITION IN D
	PUSH FXP,D
	PUSH FXP,-1(FXP)	;PARENS COUNT
	MOVEI TT,F.MODE
	MOVE R,@TTSAR(A)	;GET INPUT FILE MODE BITS
	PUSH FXP,R
	PUSH FXP,XC-1		;PUSH -1 (NOT IN STRING YET)
	SETZ B,			;B HOLDS LIST OF CHARACTERS
	HRRZS BFPRDP		;WE WANT NO CLEVERNESS FROM $DEVICE
;STATE OF THE WORLD:
;	B HAS LIST OF BUFFERED CHARS (IN REVERSE ORDER)
;	C HAS TTY OUTPUT FILE ARRAY
;	AR2A HAS READTABLE
;		4.9 => USEFUL CHAR SEEN
;		4.8 => READLINE INSTEAD OF READ
;		4.7 => (STATUS TTYREAD) = T
;	VINFILE HAS TTY INPUT FILE ARRAY
;	FXP:	STRING TERMINATOR CHAR (-1 IF NOT IN STRING)
;		MODE BITS FOR INPUT FILE
;		PARENTHESIS COUNT
;		SAVED CURSOR POSITION
;		ORIGINAL PARENS COUNT
TTYB1:	PUSHJ P,TTYBCH		;GET A CHARACTER
	MOVE D,@TTSAR(AR2A)	;GET READTABLE SYNTAX
	MOVE R,-1(FXP)		;GET MODE BITS
IFN SAIL,[
	CAIE TT,%TXCTL+"M
	 CAIN TT,%TXCTL+"m
	  JRST TTYB1E
]		;END IFN SAIL
	CAIE TT,^M
	 JRST TTYB7
TTYB1E:	TLNE AR2A,200000	;CR TERMINATES READLINE
	 JRST TTYB9
	TLNN R,FBT<LN>		;SKIP IF LINE MODE
	 JRST TTYB2
	MOVEI TT,203		;PSEUDO-SPACE
	TLNN AR2A,200000	;SKIP IF HACKING A STRING
	 JSP R,TTYPSH		;ELSE PUSH CHAR ONTO BUFFER
SA%	MOVEI TT,^M
SA$	MOVEI TT,%TXCTL+"M
	JRST TTYB9		;ALL DONE

TTYB7:
IFN SAIL,[
	CAIE TT,%TXCTL+"K
	 CAIN TT,%TXCTL+"k	;LOWER CASE K
	  JRST TTYB7E
;	TLNN R,FBT<FU>
]		;END OF IFN SAIL
20$	CAIE TT,^R		;FOR A ^R (ON TWENEX) WE RETYPE THE BUFFER
	 CAIN TT,^K		;FOR A ^K, WE TERPRI AND RETYPE THE BUFFER
	  JRST TTYB7E
TTYB7F:
IFN SAIL,[
	CAIE TT,%TXCTL+"L
	 CAIN TT,%TXCTL+"l	;LOWER CASE L
	  JRST TTYB7E
;	TLNN R,FBT<FU>
]		;END OF IFN SAIL
	 CAIE TT,^L		;RPUSH FXP FOR ^L, WE CLEAR THE SCREEN,
	  JRST TTYB2		; THEN RETYPE THE BUFFER
	SKIPN AR1,C
	 JRST TTYB1
	MOVEI TT,F.MODE
	MOVE R,@TTSAR(AR1)
	TLNN R,FBT<CP>		;IF WE CAN'T CLEAR THE SCREEN,
	 JRST TTYB7G		; WE JUST MAKE LIKE ^K
	PUSHJ P,CLRSRN
TTYB7N:	PUSHJ P,TTYBRC		;READ THE TTY CURSOR POSITION
	MOVEM D,-3(FXP)
	PUSHJ P,TTYBLT		;ZAP OUT TTY BUFFER
	JRST TTYB1

TTYB7E:	SKIPN AR1,C
	 JRST TTYB1
TTYB7G:	PUSHJ P,ITERPRI
	JRST TTYB7N


CLRSRN:				;CLEAR THE "SCREEN"
IFN ITS\D20,[
	MOVEI D,"C
	JRST CNPCOD
]		;END OF IFN ITS\D20
IFN D10,[
	PUSH P,A		;SAVE A OVER TYO
	MOVEI A,14		;^L
	PUSHJ P,$TYO		;AT THIS POINT, THE FILE MUST BE A TTY
	JRST POPAJ
];END IFN D10
IFE ITS\D20\D10, WARN [SAY, YOU WILL LOSE WITH ITS\D20\D10 = 0]




TTYB2:	TLNN AR2A,200000	;READLINE IGNORES SLASHES
	 TLNN D,2000	.SEE SYNTAX	;SLASH
	  JRST TTYB4
	JSP R,TTYPSH
	PUSHJ P,TTYBCH
	TLO TT,400000		;SLASHIFIED CHAR
TTYB3:	TLO AR2A,400000		;USEFUL FROB SEEN
TTYB3A:	JSP R,TTYPSH
	JRST TTYB1

TTYB4:	TLNE D,1000	.SEE SYNTAX	;RUBOUT
	 TLNE D,40	.SEE SYNTAX	;NOT SECOND CHOICE
	  JRST TTYB5
	JUMPN B,TTYB4C
	HRRZ T,BFPRDP
	JUMPE T,TTYB9J		;RETURN TO CALLER FOR EOF
	SKIPE AR1,C		;OOPS! INSIDE READ ALREADY!
	 PUSHJ P,ITERPRI	; WE MUST SIMPLY TERPRI
	JRST TTYB1		; (IF POSSIBLE) AND TRY IT AGAIN

TTYB4C:	PUSHJ P,RUB1CH		;RUB OUT CHAR
	SKIPL TT,(A)		;SKIP IF CHAR WAS SLASHIFIED
	 JRST TTYB4G
	PUSHJ P,RUB1CH		;RUB OUT SLASH TOO
	JRST TTYB1

RUB1CH:	HLRZ A,(B)		;DELETE CHAR FROM BUFFERED LIST
	HRRZ B,(B)
	JUMPE C,CPOPJ		;THAT'S IT IF NO ECHO FILE
	PUSH P,A
	HRRZ A,(A)		;GET CHARACTER IN A
	MOVEI AR1,(C)
	PUSHJ P,RUB1C1
	 JRST POPAJ		;NORMAL RETURN: DONE IT
20$	  JRST RUB2CH		;SINGLE SKIP: RETYPE ON "DUMB" OPERATING SYSTEM
20%	  JFCL			;CAN'T GET HERE ON ITS
IFN ITS\D20,	PUSHJ P,RSTCUR	;MUST RETYPE WHOLE STRING IN PLACE
	PUSHJ P,TTYBLT
IFN ITS\D20,	PUSHJ P,CNPL
	JRST POPAJ

IFN D20,[
RUB2CH:	PUSHJ P,TTYBLT		;RETYPE INPUT
	JRST POPAJ
]	;END IFN D20

TTYB4G:	SKIPL (FXP)		;SKIP UNLESS IN STRING
	 JRST TTYB4J
	TLNE TT,100000
	 JRST TTYB4M
	MOVE D,@TTSAR(AR2A)	;GET CHARACTER SYNTAX
	TLNE D,40000	.SEE SYNTAX	;OPEN PAREN
	 SOS -2(FXP)
	TLNN D,10000	.SEE SYNTAX	;CLOSE PAREN
	 JRST TTYB1
	SKIPLE -2(FXP)
	 AOS -2(FXP)
	JRST TTYB1


TTYB4J:	TLNE TT,200000		;RUBBED OUT BACK OUT OF STRING
	 SETOM (FXP)
	JRST TTYB1

TTYB4M:	HRRZM TT,(FXP)		;RUBBED OUT BACK INTO A STRING
	JRST TTYB1

TTYB5:	TLNE AR2A,200000	;GO BACK AROUND IF READLINE
	 JRST TTYB3A
	SKIPGE R,(FXP)		;SKIP IF IN STRING
	 JRST TTYB5H
	CAIE R,(TT)
	 JRST TTYB3A
	TLO TT,100000		;MARK AS STRING END
	SETOM (FXP)
	JRST TTYB3A

TTYB5H:	TLNE D,1000	.SEE SYNTAX	;FORCE FEED
	 TLNN D,40	.SEE SYNTAX	;SECOND CHOICE
	  JRST TTYB5K
	JSP R,TTYPSH
	JRST TTYB9A

TTYB5K:	TLNN D,100000	.SEE SYNTAX	;SPACE
	 JRST TTYB6
TTYB5M:	JSP T,TTYATM
	JRST TTYB3A

TTYB6:	TLNN D,200000	.SEE SYNTAX	;SINGLE CHAR OBJECT
	 JRST TTYB6C
	TLO AR2A,400000		;USEFUL THING SEEN
	JRST TTYB5M

TTYB6C:	TLNN D,4000
	 JRST TTYB6J		;NOT A MACRO CHAR
	HRRZ R,VTSCSR		; ((#/; . #\CR) (#/| . #/|) (#/" . #/"))

	MOVS F,(R)
	MOVS T,(F)
	CAMN TT,(T)
	 JRST .+4
	  HLRZ R,F
	  JUMPN R,.-5
	  JRST TTYB6J		;NOT A STRING-LIKE MACRO CHAR

	MOVSS T
	MOVE F,(T)
	TLO AR2A,400000		;USEFUL FROB SEEN
	TLO TT,200000		;STRING BEGIN
	MOVEM F,(FXP)
	JRST TTYB3

TTYB6J:	TLNN D,40000	.SEE SYNTAX	;OPEN PAREN
	 JRST TTYB6Q
	AOS -2(FXP)
	JRST TTYB3

TTYB6Q:	TLNN D,10000	.SEE SYNTAX	;CLOSE PAREN
	 JRST TTYB8
	JSP T,TTYATM
	SOSLE T,-2(FXP)
	 JRST TTYB3
	JUMPE T,TTYB9		;AHA, PARENS BALANCE
	TLNE AR2A,400000	;IF NOTHING USEFUL HAS COME IN SO FAR, THEN
	 JRST TTYB9
	SETZM -2(FXP)		;THROW AWAY A STRAY TOP-LEVEL RIGHT PARENS
	JRST TTYB3A

TTYB9:	JSP R,TTYPSH
	TLNN AR2A,100000
	 JRST TTYB1		;ONLY FORCE-FEED ENDS TTYSCAN
TTYB9A:	JUMPE C,TTYB9B
	PUSHJ P,TTYBRC
	MOVEI TT,AT.LNN		;UPDATE LINENUM AND CHARPOS
	HLRZM D,@TTSAR(C)	; OF ASSOCIATED OUTPUT FILE
	MOVEI TT,AT.CHS
	HRRZM D,@TTSAR(C)
TTYB9B:	MOVEI A,(B)
	PUSHJ P,NREVERSE
	MOVEI B,(A)
	MOVEI C,(A)
TTYB9D:	JUMPE C,TTYB9J
	HLRZ A,(C)
	MOVE TT,(A)
	TLZE TT,-1
	 JSP T,FXCONS
	HRLM A,(C)
	HRRZ C,(C)
	JRST TTYB9D

TTYB9J:	POPI FXP,5
	MOVEI A,(B)
	JRST UNBIND

TTYB8:	TLNE D,277237	.SEE SYNTAX	;SKIP IF NOT WORTHY CHAR
	 JRST TTYB3
	JRST TTYB3A


TTYBRC:	HRROS AR1,C
TTYBR1:	MOVE TT,TTSAR(AR1)	;GET CURSOR POSITION OF FILE FROM (AR1) INTO D
	PUSHJ P,IFORCE
IFE ITS\D20, JRST TTYBR2	;? WHAT TO DO?
IFN ITS\D20,[
	MOVEI TT,F.MODE
	MOVE F,@TTSAR(AR1)		;C HAS OUTPUT FILE FOR ECHOING
	PUSHJ FLP,RCPOS
	TLNE F,FBT<EC>
	 MOVE D,R		;MAYBE NEED ECHO AREA CURSOR
	POPJ P,
]		;END OF IFN ITS\D20

TTYBR2:	SETZ D,
	POPJ P, 

TTYPSH:
IFN 0,[
	ANDI TT,%TXCTL+%TXASC	;? FOLD CHARACTER DOWN TO 7 BITS
	TRZN TT,%TXCTL
	 JRST TTYPS1
	CAIE TT,177
	 TRZ TT,140
TTYPS1:
]		;END OF IFN 0
	JSP T,FXCONS		;PUSH CHAR IN TT ON FRONT
	PUSHJ P,CONS		; OF LIST OF BUFFERED CHARS
	MOVEI B,(A)
	JRST (R)


TTYATM:	JUMPGE AR2A,(T)		;DECIDE WHETHER WE MAY HAVE
	MOVE R,-1(FXP)		; TERMINATED A TOP LEVEL ATOM,
	SKIPG -2(FXP)		; AND IF SO GO TO TTYB9 AND OUT
	 TLNE R,FBT<LN>		;WE HAVE *NOT* TERMINATED IF:
	  JRST (T)		; NO USEFUL CHARS SEEN YET
	TLNN AR2A,100000	; (STATUS TTYREAD) = NIL
	 JRST (T)		; OPEN PARENS ARE HANGING
	JRST TTYB9		; TTY INPUT IS IN LINE MODE


TTYBCH:	PUSHJ P,$DEVICE		;GOBBLE A CHARACTER
IFN ITS,[
	ANDI TT,%TXCTL+%TXASC	;FOLD CHARACTER TO 7 BITS
	TRZN TT,%TXCTL
	 POPJ P,
	CAIE TT,177
	 TRZ TT,140
	MOVEI D,(TT)		;ATTEMPT TO FLUSH INTERRUPT CHARS
	ROT TT,-1
	ADDI TT,FB.BUF		;REALLY SHOULD BE MORE CLEVER
	HRRZ AR1,VINFILE
	HLRZ R,@TTSAR(AR1)
	SKIPGE TT
	 HRRZ R,@TTSAR(AR1)
	JUMPN R,TTYBCH
	MOVEI TT,(D)
]		;END OF IFN ITS
	POPJ P,


TTYBLT:	SKIPN AR1,C
	 POPJ P,
	MOVEI A,(B)		;TYPE OUT ALL BUFFERED CHARS
	PUSHJ P,NREVERSE	; ONTO THE ECHO OUTPUT FILE
	MOVEI B,(A)
	SKIPG -4(FXP)		;IF WE ENTERED WITH HANGING
	 JRST TTYBL1		; PARENS, PRINT THEM
	PUSH FXP,-4(FXP)
TTYBL4:	MOVEI TT,"(
	PUSHJ P,TYOFIL
	SOSLE (FXP)
	 JRST TTYBL4
	SUB FXP,R70+1
	MOVEI TT,40
	PUSHJ P,TYOFIL
TTYBL1:	JUMPE B,TTYBL2		;ECHO ALL CHARS TO ECHO TTY
	HLRZ C,(B)
	HRRZ TT,(C)
	PUSHJ P,TYOFIL
	HRRZ B,(B)
	JRST TTYBL1

TTYBL2:	PUSHJ P,NREVERSE
	MOVEI B,(A)		;RESTORE BACKWARDS LIST OF CHARS
	MOVE C,AR1		;RESTORE C (NREVERSE CLOBBERED)
	POPJ P,




RUBOUT:	MOVEI D,QRUBOUT		;LSUBR (1 . 2)
	CAMGE T,XC-2
	 JRST WNALOSE		;MORE THAN 2 ARGS
	JUMPE T,WNALOSE		; 0 ARGS
	CAME T,XC-2	
	 SKIPA AR1,V%TYO
	  POP P,AR1
	POP P,A
	JSP F,TYOARG
IFN SFA,[
	JSP TT,XFOSP
	 JRST RUBOU1
	 JRST RUBOU1
	MOVEI T,SO.RUB
	MOVEI TT,SR.WOM
	TDNN T,@TTSAR(AR1)	;CAN IT DO THE RUBOUT OPERATION?
	 JRST FALSE		; NO, SO JUST RETURN ()
	MOVE C,A
	JRST ISTCAL
RUBOU1:]	;END IFN SFA
	MOVE A,(A)		;RE-FETCH NUMERICAL ASCII VALUE
	PUSHJ P,TOFLOK
	PUSHJ P,RUB1C1
	 JRST UNLKTRUE
	  JFCL			;DOUBLE SKIP LIKE SINGLE SKIP HERE
	SETZ A,
	UNLKPOPJ


;;; ROUTINE WHICH ATTEMPTS TO RUB OUT A CHARACTER ON A TTY.
;;; SKIPS ON *FAILURE* TO RUB IT OUT.
;;; OUTPUT TTY FILE ARRAY MUST BE IN AR1.

RUB1C1:	MOVEI TT,F.MODE
	MOVE F,@TTSAR(AR1)
	TLNE F,FBT<SE>		;IF CAN'T SELECTIVELY ERASE
	 TLNN F,FBT<CP>		; AND MOVE CURSOR AROUND FREELY,
20%	  JRST TYOFA		; MERELY ECHO RUBBED-OUT CHAR
20$	  JRST RUB1C2
IFE ITS\D20,	HALT
IFN ITS\D20,[
	CAIN A,177		;RUBOUT DOESN'T PRINT, HENCE NEEDN'T KILL
	 POPJ P,
	MOVEI T,1
	CAILE A,^_		;CHARS FROM 40 TO 176 ARE ONE
	 JRST RUB1C3		; POSITION WIDE, SO BACK UP AND ERASE
	CAIN A,^I		;TABS ARE VARIABLE - MUST RETYPE
	 JRST RUB1C4
	CAIN A,^J		;LINE FEED IS DOWNWARD MOTION -
	 JRST CNPU		; ERASE BY MOVING UP
	CAIN A,^H		;BACKSPACE IS ERASED BY
	 JRST CNPF		; MOVING FORWARD
	CAIE A,^M		;FOR CR, DON'T KNOW LENGTH OF PREVIOUS LINE
	 CAIN A,^_		;FOR ^_, MAY OR MAY NOT HAVE BEEN DOUBLED
	  JRST RUB1C4
	CAIE A,33		;ALTMODE IS ALWAYS 1 WIDE
	 TLNE F,FBT<SA>		;OTHER CONTROLS ONE WIDE IF IN SAIL MODE
	  JRST RUB1C3
	MOVEI T,2		;OTHERWISE CONTROL CHARS ARE TWO WIDE
RUB1C3:
;;	PUSHJ FLP,RCPOS
;;	TLNE F,FBT<EC>
;;	 MOVE D,R
	MOVEI R,(T)
;;	CAILE T,(D)		;CLAIM IS, AS OF 1980, THAT THAT ^PB AND ^PX
;;	 PUSHJ P,CNPU		; KNOW ENOUGH TO DO THIS ALREADY
	CAIE R,2
	 JRST CNPBL
	JRST CNPBBL

RUB1C4:	AOS (P)			;DOUBLE SKIP RETURN, RETYPE ON SMART TTY
	AOS (P)
	POPJ P,
]		;END OF IFN ITS\D20

IFN D20,[
RUB1C2:	SKIPN TENEXP		;ONLY TENICIES HAVE DELCH JSYS
	 JRST TYOFA		;SO ON TOPS-20 CAN ONLY REECHO CHARACTER
	MOVE TT,A		;SAVE RUBBED OUT CHARACTER
	LOCKI			;LOCK OVER SYSTEM CALL
	MOVE T,TTSAR(AR1)
	HRRZ A,F.JFN(T)
RUB1C8:	DELCH
	 JRST RUB1C5		;NOT TTY??  JUST PRINT CHARACTER
	  JRST RUB1C6		;AT BEGINNING OF LINE, RETYPE INPUT
	   JRST RUB1C7		;DID IT, JUST RETURN
;;; HERE IF NON-DISPLAY, NOT TTY, OR IF DELCH GOT AN ILLEGAL INSTRUCTION TRAP
.SEE INTILO
RUB1C5:	UNLOCKI			;RELEASE LOCK
	MOVE A,TT		;PUT SOMETHING SAFE IN A
	JRST TYOFIL		;THEN OUTPUT CHARACTER FROM TT

RUB1C6:	AOS (P)			;SKIP RETURN MEANS REECHO
	UNLKPOPJ

RUB1C7:	CAIL TT,^H		;PROBABLY ^ FORMAT
	 JRST RUB1C9
RUB1CA:	MOVEI TT,"^		;TURN CHARACTER UNTO AN UPARROW
	JRST RUB1C8		;THEN GET RID OF IT TOO

RUB1C9:	CAIG TT,^M		;OUT OF MAGIC CHARACTER RANGE?
	 JRST RUB1CC		;NOPE, PROBABLY BE BETTER TO RETYPE THEN
	CAIN TT,33		;ESCAPE IS MAGIC, AS IT PRINTS AS ONLY ONE CHAR
	 UNLKPOPJ
	CAIGE TT,40		;SOME OTHER CONTROL CHAR?
	 JRST RUB1CA		;YES, GET RID OF THE PRECEEDING UPARROW
	MOVE A,TT
	UNLKPOPJ		;ELSE JUST RETURN, THE WORK IS DONE

RUB1CC:	UNLOCKI
	AOS (P)			;SETUP FOR SKIP (RETYPE) RETURN
	MOVEI A,15		;BUT FIRST GET TO A NEW LINE
	JRST TYOFA

]	;END IFN D20

;;; READLINE TAKES STANDARD FILE/EOF INPUT ARGUMENTS AND READS
;;; ONE LINE FROM A FILE.  IT INVOKES PRE-SCANNING FOR TTY'S.
;;; THE RESULT IS RETURNED AS AN ATOMIC SYMBOL, EXCLUDING THE
;;; CARRIAGE RETURN WHICH TERMINATES THE LINE.  LINE FEEDS
;;; ARE IGNORED (NECESSARY FOR SUCCESSIVE READLINE'S).

%READLINE:
	JSP D,INCALL
SFA%	    Q%READLINE
SFA$	    [SO.RDL,,],,Q%READLINE
	MOVEI A,Q%READLINE
	HRLZM A,BFPRDP		;PERMIT TTY PRE-SCAN
	MOVEI T,%RDLN5
	PUSHJ FXP,MKNR6C	;PART OF MAKNAM
	JRST PNGNK1		;CREATE NON-INTERNED SYMBOL

%RDLN5:	PUSH FXP,D
%RDLN6:	PUSHJ P,@TYIMAN
IFN SAIL,[
	ANDI TT,%TXCTL+%TXASC	;FOLD CHARACTER DOWN TO 7 BITS
	TRZN TT,%TXCTL
	 JRST %RDLNZ
	CAIE TT,177
	 TRZ TT,140
%RDLNZ:
]		;END IFN SAIL
	CAIN TT,^J		;IGNORE LINE FEEDS
	 JRST %RDLN6
	POP FXP,D
	CAIN TT,^M		;CR TERMINATES
	 POPJ P,
	MOVEI A,(TT)
	JRST POPJ1


	PGTOP RDR,[HIRSUTE READER, MAKNAM, ETC.]
