SUBTTL	TYIPEEK FUNCTION


TYIPEEK:			;LSUBR (0 . 3) NCALLABLE
	SKIPA F,CFIX1
	 MOVEI F,CPOPJ
	MOVEI D,QTYIPEEK
	CAMGE T,XC-3
	 JRST WNALOSE
	SKIPE T			;NO ARGS <=> ONE ARG OF NIL
	 AOSA T			;ELSE DECREMENT ARG COUNT FOR INCALL
	  PUSH P,R70
	MOVEI D,(P)
	ADDI D,(T)
	MOVEI AR2A,CPOPJ
	EXCH AR2A,(D)
	JSP D,XINCALL		;PROCESS ARGS 2 AND 3
SFA%	   QTYIPEEK		; (ALSO PUSHES F ONTO P)
SFA$	[SO.TIP,,],,QTYIPEEK
	MOVEI A,Q%TYI
	HRLZ A,BFPRDP		;DON'T CLOBBER RH - MAY BE IN A RE-ENTRANT READ
	MOVEI A,(AR2A)		;GET ARG 1 IN A
	JSP T,GTRDTB		;GET READTABLE IN AR2A
	JUMPN A,TYPK1		;NIL => ACCEPT ANY CHAR
	 PUSHJ P,$PEEK
	 JRST TYPKX
TYPK1:	CAIE A,TRUTH		;T => SEARCH FOR READER START
	 JRST TYPK3		; CHARACTER (E.G. PAREN, MACRO)
TYPK1C:	PUSHJ P,$$PEEK		;PEEK AT A CHAR
	JUMPL TT,TYPK9A		;HIT EOF - TAKE A "SOFT" EOF, RETURN -1
	MOVE T,@TTSAR(AR2A)	;PEEK SETS UP AR2A
	TLC T,4040	.SEE SYNTAX
	TLCE T,4040
	 JRST TYPK1F
	PUSH P,T
	PUSHJ P,@TYIMAN
	POP P,T
	CALLF 0,(T)		;HIT A HORRIBLE SPLICING MACRO
	JSP T,GTRDTB		;Refetch the read table.  User code clobbers
				;AR2A, and may have SETQed READTABLE
	JRST TYPK1C		;GO BACK AND TRY AGAIN


$$PEEK:	HRRZ TT,TYIMAN		;CALL TYIMAN ONE EARLY TO
	JRST -1(TT)		; SPECIFY PEEKING

TYPK1F:	TLNE T,266217	.SEE SYNTAX	;READER START CHARS
	 JRST TYPKX
TYPK1H:	PUSHJ P,@TYIMAN		;CHAR NOT ACCEPTABLE - GOBBLE IT
	JRST TYPK1C		;NOW GO TRY AGAIN

TYPK3:	JSP T,FXNV1		;ARG MUST BE FIXNUM
	JUMPL TT,TYPK3C		;ARG BETWEEN 0 AND 777 =>
	CAIG TT,777		; SCAN FOR THAT CHARACTER;
	 TLOA TT,400000		; OTHERWISE IS A SYNTAX, LSH'ED
TYPK3C:	  LSH TT,-11		; LEFT BY 11, TO SERVE AS MASK
	PUSH FXP,TT
TYPK4:	PUSHJ P,$$PEEK		;PEEK AT A CHAR
	JUMPL TT,TYPK9		;SOFT EOF - GO RETURN -1 OR WHATEVER
	SKIPL D,(FXP)		;SKIP IF SPECIFIC CHARACTER
	 JRST TYPK6
	CAIN TT,(D)		;COMPARE TO ONE WE GOT
	 JRST TYPKXT		;SUPER WIN
TYPK5:	PUSHJ P,@TYIMAN		;NOT THE ONE - GOBBLE AND RETRY
	JRST TYPK4

TYPK6:	HLRZ T,@TTSAR(AR2A)	.SEE SYNTAX
	TDNN T,D		;CHECK SYNTAX AGAINST MASK
	 JRST TYPK5
TYPKXT:	POP FXP,T
TYPKX:	POP FXP,BFPRDP		;EXIT
	POPJ P,


TYPK9:	POPI FXP,2		;FLUSH "BFPRDP" AND "T"
TYPK9A:	SKIPN EOFRTN		;"SOFT" EOF.  DOES NOT INVOKE
	 JRST M1TTPJ		; THE EOFFN, BUT WILL PICK UP
	JRST EOF9		; THE EOFVAL IF NECESSARY.