TITLE	PRINTER ROUTINE FOR MUDDLE

RELOCATABLE

.INSRT DSK:MUDDLE >

.GLOBAL	IPNAME,MTYO,RLOOKU,RADX,INAME,INTFCN,LINLN,DOIOTO,BFCLS1,ATOSQ,IGVAL
.GLOBAL BYTPNT,OPNCHN,CHRWRD,IDVAL,CHARGS,CHFRM,CHLOCI,PRNTYP,PRTYPE,IBLOCK,WXCT
.GLOBAL VECBOT,VAL,ITEM,INDIC,IOINS,DIRECT,TYPVEC,CHRPOS,LINPOS,ACCESS,PAGLN,ROOT,PROCID
.GLOBAL BADCHN,WRONGD,CHNCLS,IGET,FNFFL,ILLCHO,BUFSTR,BYTDOP,6TOCHS,PURVEC,STBL,RXCT
.GLOBAL TMPLNT,TD.LNT,BADTPL,MPOPJ,SSPEC1,GLOTOP,GTLPOS,SPSTOR,PVSTOR
.GLOBAL CIPRIN,CIPRNC,CIPRN1,CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR
.GLOBAL CIFLTZ,CITERP,CIUPRS,CPCH,CPCH1,CICRLF,NONSPC

BUFLNT==100		; BUFFER LENGTH IN WORDS

FLAGS==0	;REGISTER USED TO STORE FLAGS
CARRET==15	;CARRIAGE RETURN CHARACTER
ESCHAR=="\	;ESCAPE CHARACTER
SPACE==40	;SPACE CHARACTER
ATMBIT==200000	;BIT SWITCH FOR ATOM-NAME PRINT
NOQBIT==020000	;SWITCH FOR NO ESCAPING OF OUTPUT (PRINC)
SEGBIT==010000	;SWITCH TO INDICATE PRINTING A SEGMENT
SPCBIT==004000	;SWITCH TO INDICATE "PRINT" CALL (PUT A SPACE AFTER)
FLTBIT==002000	;SWITCH TO INDICATE "FLATSIZE" CALL
HSHBIT==001000	;SWITCH TO INDICATE "PHASH" CALL
TERBIT==000400	;SWITCH TO INDICATE "TERPRI" CALL
UNPRSE==000200	;SWITCH TO INDICATE "UNPARSE" CALL
ASCBIT==000100	;SWITCH TO INDICATE USING A "PRINT" CHANNEL
BINBIT==000040	;SWITCH TO INDICATE USING A "PRINTB" CHANNEL
CNTLPC==000020	;SWITCH TO INDICATE USING ^P CODE IOT
PJBIT==400000
C.BUF==1
C.PRIN==2
C.BIN==4
C.OPN==10
C.READ==40


MFUNCTION	FLATSIZE,SUBR
	DEFINE FLTMAX
		4(B) TERMIN
	DEFINE FLTSIZ
		2(B)TERMIN
;FLATSIZE TAKES TWO OR THREE ARGUMENTS: THE FIRST IS AN OBJECT THE SECOND
;IS THE MAXIMUM SIZE BEFORE IT GIVES UP AN RETURNS FALSE
;THE THIRD (OPTIONAL) ARGUMENT IS A RADIX
	ENTRY
	CAMG	AB,[-2,,0]	;CHECK NUMBER OF ARGS
	CAMG	AB,[-6,,0]
	JRST	WNA
	PUSH	P,3(AB)

	GETYP	A,2(AB)
	CAIE	A,TFIX
	JRST	WTYP2		;SECOND ARG NOT FIX THEN LOSE

	CAMG	AB,[-4,,0]	;SEE IF THERE IS A RADIX ARGUMENT
	JRST	.+3		; RADIX SUPPLIED
	PUSHJ	P,GTRADX	; GET THE RADIX FROM OUTCHAN
	JRST	FLTGO
	GETYP	A,4(AB)		;CHECK TO SEE THAT RADIX IS FIX
	CAIE	A,TFIX
	JRST 	WTYP		;ERROR THIRD ARGUMENT WRONG TYPE
	MOVE	C,5(AB)
	PUSHJ	P,GETARG	; GET ARGS INTO A AND B
FLTGO:	POP	P,D		; RESTORE FLATSIZE MAXIMUM
	PUSHJ	P,CIFLTZ
	JFCL
	JRST	FINIS



MFUNCTION UNPARSE,SUBR
	DEFINE UPB
		0(B) TERMIN

	ENTRY

	JUMPGE	AB,TFA
	MOVE	E,TP		;SAVE TP POINTER



;TURN ON FLTBIT TO AVOID PRINTING LOSSAGE
;TURN ON UNPRSE TO CAUSE CHARS TO BE STASHED
	CAMG	AB,[-2,,0]	;SKIP IF RADIX SUPPLIED
	JRST	.+3
	PUSHJ	P,GTRADX	;GET THE RADIX FROM OUTCHAN
	JRST	UNPRGO
	CAMGE	AB,[-5,,0]	;CHECK FOR TOO MANY
	JRST	TMA
	GETYP 	0,2(AB)
	CAIE	0,TFIX		;SEE IF RADIX IS FIXED
	JRST	WTYP2
	MOVE	C,3(AB)		;GET RADIX
	PUSHJ	P,GETARG	;GET ARGS INTO A AND B
UNPRGO:	PUSHJ	P,CIUPRS
	JRST	FINIS
	JRST	FINIS


GTRADX:	MOVE	B,IMQUOTE OUTCHAN
	PUSH	P,0		;SAVE FLAGS
	PUSHJ	P,IDVAL		;GET VALUE FOR OUTCHAN
	POP	P,0
	GETYP	A,A		;CHECK TYPE OF CHANNEL
	CAIE	A,TCHAN
	JRST	FUNCH1-1	;IT IS A TP-POINTER
	MOVE	C,RADX(B)	;GET RADIX FROM OUTCHAN
	JRST	FUNCH1
	MOVE	C,(B)+6		;GET RADIX FROM STACK

FUNCH1:	CAIG	C,1		;CHECK FOR STRANGE RADIX
	MOVEI	C,10.		;DEFAULT IF THIS IS THE CASE
GETARG:	MOVE	A,(AB)
	MOVE	B,1(AB)
	POPJ	P,


IMFUNCTION	PRINT,SUBR
	ENTRY	
	PUSHJ	P,AGET		; GET ARGS
	PUSHJ	P,CIPRIN
	JRST	FINIS

MFUNCTION	PRINC,SUBR
	ENTRY	
	PUSHJ	P,AGET		; GET ARGS
	PUSHJ	P,CIPRNC
	JRST	FINIS

MFUNCTION	PRIN1,SUBR
	ENTRY	
	PUSHJ	P,AGET
	PUSHJ	P,CIPRN1
	JRST	FINIS


MFUNCTION CRLF,SUBR
	ENTRY
	PUSHJ	P,AGET1
	PUSHJ	P,CICRLF
	JRST	FINIS

MFUNCTION	TERPRI,SUBR
	ENTRY
	PUSHJ	P,AGET1
	PUSHJ	P,CITERP
	JRST	FINIS


CICRLF:	SKIPA	E,.
CITERP:	MOVEI	E,0
	SUBM	M,(P)
	MOVSI	0,TERBIT+SPCBIT	; SET UP FLAGS
	PUSH	P,E
	PUSHJ	P,TESTR		; TEST FOR GOOD CHANNEL
	MOVEI	A,CARRET	; MOVE IN CARRIAGE-RETURN
	PUSHJ	P,PITYO		; PRINT IT OUT
	MOVEI	A,12		; LINE-FEED
	PUSHJ	P,PITYO
	POP	P,0
	JUMPN	0,.+4
	MOVSI	A,TFALSE	; RETURN A FALSE
	MOVEI	B,0
	JRST	MPOPJ		; RETURN

	MOVSI	A,TATOM
	MOVE	B,IMQUOTE T
	JRST	MPOPJ

TESTR:	GETYP	E,A
	CAIN	E,TCHAN		; CHANNEL?
	JRST	TESTR1		; OK?
	CAIE	E,TTP
	JRST 	BADCHN
	HLRZS	0
	IOR	0,A		; RESTORE FLAGS
	HRLZS	0
	POPJ	P,
TESTR1:	HRRZ	E,-2(B)		; GET IN FLAGS FROM CHANNEL
	SKIPN	IOINS(B)
	PUSHJ	P,OPENIT
	TRNN	E,C.OPN		; SKIP IF OPEN
	JRST	CHNCLS
	TRC	E,C.PRIN+C.OPN	; CHECK TO SEE THAT CHANNEL IS GOOD
	TRNE	E,C.PRIN+C.OPN
	JRST	BADCHN		; ITS A LOSER
	TRNE	E,C.BIN
	JRST	PSHNDL		; DON'T HANDLE BINARY
	TLO	ASCBIT		; ITS ASCII
	POPJ	P,		; ITS A WINNER
	
PSHNDL:	PUSH	TP,C		; SAVE ARGS
	PUSH	TP,D
	PUSH	TP,A		; PUSH CHANNEL ONTO STACK
	PUSH	TP,B
	PUSHJ	P,BPRINT	; CHECK BUFFER
	POP	TP,B
	POP	TP,A
	POP	TP,D
	POP	TP,C
	POPJ	P,


;CIUPRS NEEDS A RADIX IN C AND A TYPE-OBJECT PAIR IN A,B

CIUPRS:	SUBM	M,(P)		; MODIFY M-POINTER
	MOVE	E,TP		; SAVE TP-POINTER
	PUSH	TP,[0]		; SLOT FOR FIRST STRING COPY
	PUSH	TP,[0]
	PUSH	TP,[0]		; AND SECOND STRING
	PUSH	TP,[0]
	PUSH	TP,A		; SAVE OBJECTS
	PUSH	TP,B
	PUSH	TP,$TTP		; SAVE TP POINTER
	PUSH	TP,E
	PUSH	P,C
	MOVE	D,[377777,,-1]	; MOVE IN MAXIMUM NUMBER FOR FLATSIZE
	PUSHJ	P,CIFLTZ	; FIND LENGTH OF STRING
	FATAL UNPARSE BLEW IT
	MOVEI	A,4(B)
	PUSH	P,B
	IDIVI	A,5
	PUSHJ	P,IBLOCK	; GET A BLOCK
	POP	P,A
	HRLI	A,TCHSTR
	HRLI	B,010700
	SUBI	B,1
	POP	TP,E		; RESTORE TP-POINTER
	SUB	TP,[1,,1]	;GET RID OF TYPE WORD
	MOVEM	A,1(E)		; SAVE RESULTS
	MOVEM	A,3(E)
	MOVEM	B,2(E)
	MOVEM	B,4(E)
	POP	TP,B		; RESTORE THE WORLD
	POP	TP,A
	POP	P,C
	MOVSI	0,FLTBIT+UNPRSE	; SET UP FLAGS
	PUSHJ	P,CUSET
	JRST	MPOPJ		; RETURN



; FOR CIFLTZ C CONTAINS THE RADIX, D THE MAXIMUM NUMBER OF CHARACTERS,
; A,B THE TYPE-OBJECT PAIR

CIFLTZ:	SUBM	M,(P)
	MOVE	E,TP		; SAVE POINTER
	PUSH	TP,$TFIX	; PUSH ON FLATSIZE COUNT
	PUSH	TP,[0]
	PUSH	TP,$TFIX	; PUSH ON FLATSIZE MAXIMUM
	PUSH	TP,D
	MOVSI	0,FLTBIT	; MOVE ON FLATSIZE FLAG
	PUSHJ	P,CUSET		; CONTINUE
	JRST	MPOPJ
	SOS	(P)		; SKIP RETURN
	JRST	MPOPJ		; RETURN

; CUSET IS THE ROUTINE USED BY FLATSIZE AND UNPARSE TO DO THE PUSHING,POPING AND CALLING
; NEEDED TO GET A RESULT.

CUSET:	PUSH	TP,$TFIX	; PUSH ON RADIX
	PUSH	TP,C
	PUSH	TP,$TPDL
	PUSH	TP,P		; PUSH ON RETURN POINTER IN CASE FLATSIZE GETS A FALSE
	PUSH	TP,A		; SAVE OBJECTS
	PUSH	TP,B
	MOVSI	C,TTP		; CONSTRUCT TP-POINTER
	HLR	C,FLAGS		; SAVE FLAGS IN TP-POINTER
	MOVE	D,E
	PUSH	TP,C		; PUSH ON CHANNEL
	PUSH	TP,D
	PUSHJ	P,IPRINT	; GO TO INTERNAL PRINTER
	POP	TP,B		; GET IN TP POINTER
	MOVE	TP,B		; RESTORE POINTER
	TLNN	FLAGS,UNPRSE	; SEE IF UNPARSE CALL
	JRST	FLTGEN		; ITS A FLATSIZE
	MOVE	A,UPB+3		; RETURN STRING
	MOVE	B,UPB+4
	POPJ	P,		; DONE
FLTGEN:	MOVE	A,FLTSIZ-1	; GET IN COUNT
	MOVE	B,FLTSIZ
	AOS	(P)
	POPJ	P,		; EXIT


; CIPRIN,CIPRNC,CIPRN1,CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR ALL ASSUME
; THAT C,D CONTAIN THE OBJECT AND A AND B CONTAIN THE CHANNEL

CIPRIN:	SUBM	M,(P)
	MOVSI	0,SPCBIT	; SET UP FLAGS
	PUSHJ	P,TPRT		; PRINT INITIALIZATION
	PUSHJ	P,IPRINT
	JRST	TPRTE		; EXIT

CIPRN1:	SUBM	M,(P)
	MOVEI	FLAGS,0		; SET UP FLAGS
	PUSHJ	P,TPR1		; INITIALIZATION
	PUSHJ	P,IPRINT	; PRINT IT OUT
	JRST	TPR1E		; EXIT

CIPRNC:	SUBM	M,(P)
	MOVSI	FLAGS,NOQBIT	; SET UP FLAGS
	PUSHJ	P,TPR1		; INITIALIZATION
	PUSHJ	P,IPRINT
	JRST	TPR1E		; EXIT

; INITIALIZATION FOR PRINT ROUTINES

TPRT:	PUSHJ	P,TESTR		; SEE IF CHANNEL IS OK
	PUSH	TP,C		; SAVE ARGUMENTS
	PUSH	TP,D
	PUSH	TP,A		; SAVE CHANNEL
	PUSH	TP,B
	MOVEI	A,CARRET	; PRINT CARRIAGE RETURN
	PUSHJ	P,PITYO
	MOVEI	A,12		; AND LF
	PUSHJ	P,PITYO
	MOVE	A,-3(TP)	; MOVE IN ARGS
	MOVE	B,-2(TP)
	POPJ	P,

; EXIT FOR PRINT ROUTINES

TPRTE:	POP	TP,B		; RESTORE CHANNEL
	MOVEI	A,SPACE		; PRINT TRAILING SPACE
	PUSHJ	P,PITYO
	SUB	TP,[1,,1]	; GET RID OF CHANNEL TYPE-WORD
	POP	TP,B		; RETURN WHAT WAS PASSED
	POP	TP,A
	JRST	MPOPJ		; EXIT

; INITIALIZATION FOR PRIN1 AND PRINC ROUTINES

TPR1:	PUSHJ	P,TESTR		; SEE IF CHANNEL IS OK
	PUSH	TP,C		; SAVE ARGS
	PUSH	TP,D
	PUSH	TP,A		; SAVE CHANNEL
	PUSH	TP,B
	MOVE	A,-3(TP)		; GET ARGS
	MOVE	B,-2(TP)
	POPJ	P,

; EXIT FOR PRIN1 AND PRINC ROUTINES

TPR1E:	SUB	TP,[2,,2]	; REMOVE CHANNEL
	POP	TP,B		; RETURN ARGUMENTS THAT WERE GIVEN
	POP	TP,A
	JRST	MPOPJ		; EXIT



CPATM:	SUBM	M,(P)
	MOVSI	C,TATOM		; GET TYPE FOR BINARY
	MOVEI	0,SPCBIT	; SET UP FLAGS
	PUSHJ	P,TPRT		; PRINT INITIALIZATION
	PUSHJ	P,CPATOM	; PRINT IT OUT
	JRST	TPRTE		; EXIT

CP1ATM:	SUBM	M,(P)
	MOVE	C,$TATOM
	MOVEI	FLAGS,0		; SET UP FLAGS
	PUSHJ	P,TPR1		; INITIALIZATION
	PUSHJ	P,CPATOM	; PRINT IT OUT
	JRST	TPR1E		; EXIT

CPCATM:	SUBM	M,(P)
	MOVE	C,$TATOM
	MOVSI	FLAGS,NOQBIT	; SET UP FLAGS
	PUSHJ	P,TPR1		; INITIALIZATION
	PUSHJ	P,CPATOM	; PRINT IT OUT
	JRST	TPR1E		; EXIT


; THIS ROUTINE IS USD TO PRINT ONE CHARACTER. THE CHANNEL IS IN A AND B THE 
; CHARACTER IS IN C.
CPCH1:	TDZA	0,0
CPCH:	MOVEI	0,1
	SUBM	M,(P)
	PUSH	P,0
	MOVSI	FLAGS,NOQBIT
	MOVE	C,$TCHRS
	PUSHJ	P,TESTR		; SEE IF CHANNEL IS GOOD
	EXCH	D,(P)		; CHAR TO STACK, IND TO D
	MOVE	A,(P)		; MOVE IN CHARACTER FOR PITYO
	JUMPE	D,.+3
	PUSHJ	P,PRETIF
	JRST	.+2
	PUSHJ	P,PITYO
	MOVE	A,$TCHRST	; RETURN THE CHARACTER
	POP	P,B
	JRST	MPOPJ




CPSTR:	SUBM	M,(P)
	HRLI	C,TCHSTR
	MOVSI	0,SPCBIT	; SET UP FLAGS
	PUSHJ	P,TPRT		; PRINT INITIALIZATION
	PUSHJ	P,CPCHST	; PRINT IT OUT
	JRST	TPRTE		; EXIT

CP1STR:	SUBM	M,(P)
	HRLI	C,TCHSTR
	MOVEI	FLAGS,0		; SET UP FLAGS
	PUSHJ	P,TPR1		; INITIALIZATION
	PUSHJ	P,CPCHST	; PRINT IT OUT
	JRST	TPR1E		; EXIT

CPCSTR:	SUBM	M,(P)
	HRLI	C,TCHSTR
	MOVSI	FLAGS,NOQBIT	; SET UP FLAGS
	PUSHJ	P,TPR1		; INITIALIZATION
	PUSHJ	P,CPCHST	; PRINT IT OUT
	JRST	TPR1E		; EXIT


CPATOM:	PUSH	TP,A		; COPY ARGS FOR INTERNAL SAKE
	PUSH	TP,B
	PUSH	P,0		; ATOM CALLER ROUTINE
	PUSH	P,C
	SKIPN	C,PRNTYP+1
	 JRST	PATOM
	ADDI	C,TATOM+TATOM
	SKIPE	(C)		; SKIP IF UNCHANGED PRINT TYPE OR DISPATCH
	 JRST	PRDIS1
	SKIPN	C,1(C)
	 JRST	PATOM
	  JRST	(C)

CPCHST:	PUSH	TP,A		; COPY ARGS FOR INTERNAL SAKE
	PUSH	TP,B
	PUSH	P,C		; STRING CALLER ROUTINE
	PUSH	P,FLAGS
	SKIPN	C,PRNTYP+1
	 JRST	PATOM
	ADDI	C,TCHSTR+TCHSTR
	SKIPE	(C)		; SKIP IF UNCHANGED PRINT TYPE OR DISPATCH
	 JRST	PRDIS1
	SKIPN	C,1(C)
	 JRST	PCHSTR
	  JRST	(C)



AGET:	MOVEI	FLAGS,0
	SKIPL	E,AB		; COPY ARG POINTER
	JRST	TFA		;NO ARGS IS AN ERROR
	ADD	E,[2,,2]	;POINT AT POSSIBLE CHANNEL
	JRST	COMPT
AGET1:	MOVE	E,AB		; GET COPY OF AB
	MOVSI	FLAGS,TERBIT

COMPT:	PUSH	TP,$TFIX	;LEAVE ROOM ON STACK FOR ONE CHANNEL
	PUSH	TP,[0]
	JUMPGE	E,DEFCHN	;IF NO CHANNEL ARGUMENT, USE CURRENT BINDING
	CAMG	E,[-2,,0]	;IF MORE ARGS THEN ERROR
	JRST	TMA
	MOVE	A,(E)		;GET CHANNEL
	MOVE	B,(E)+1
	JRST	NEWCHN

DEFCHN:	MOVE	B,IMQUOTE OUTCHAN
	MOVSI	A,TATOM
	PUSH	P,FLAGS		;SAVE FLAGS
	PUSHJ	P,IDVAL		;GET VALUE OF OUTCHAN
	POP	P,0

NEWCHN:	TLNE	FLAGS,TERBIT	; SEE IF TERPRI
	POPJ	P,
	MOVE	C,(AB)	; GET ARGS
	MOVE	D,1(AB)
	POPJ	P,

; HERE IF USING A PRINTB CHANNEL

BPRINT:	TLO	FLAGS,BINBIT
	SKIPE	BUFSTR(B)	; ANY OUTPUT BUFFER?
	POPJ	P,

; HERE TO GENERATE A STRING BUFFER

	PUSH	P,FLAGS
	MOVEI	A,BUFLNT	; GET BUFFER LENGTH
	PUSHJ	P,IBLOCK	; MAKE A BUFFER
	MOVSI	0,TWORD+.VECT.	; CLOBBER U TYPE
	MOVEM	0,BUFLNT(B)
	SETOM	(B)		; -1 THE BUFFER
	MOVEI	C,1(B)
	HRLI	C,(B)
	BLT	C,BUFLNT-1(B)
	HRLI	B,010700
	SUBI	B,1
	MOVE	C,(TP)
	MOVEM	B,BUFSTR(C)	; STOR BYTE POINTER
	MOVE	0,[TCHSTR,,BUFLNT*5]
	MOVEM	0,BUFSTR-1(C)
	POP	P,FLAGS
	MOVE	B,(TP)
	POPJ	P,


IPRINT:	PUSH	P,C		; SAVE C
	PUSH	P,FLAGS	;SAVE PREVIOUS FLAGS
	PUSH	TP,A	;SAVE ARGUMENT ON TP-STACK
	PUSH	TP,B
	
	INTGO		;ALLOW INTERRUPTS HERE
 
	GETYP	A,-1(TP)	;GET THE TYPE CODE OF THE ITEM
	SKIPE	C,PRNTYP+1	; USER TYPE TABLE?
	JRST	PRDISP
NORMAL:	CAILE	A,NUMPRI	;PRIMITIVE?
	JRST	PUNK		;JUMP TO ERROR ROUTINE IF CODE TOO GREAT
	HRRO	A,PRTYPE(A)	;YES-DISPATCH
	JRST	(A)

; HERE FOR USER PRINT DISPATCH

PRDISP:	ADDI	C,(A)		; POINT TO SLOT
	ADDI	C,(A)
	SKIPE	(C)		; SKIP EITHER A LOSER OR JRST DISP
	JRST	PRDIS1		; APPLY EVALUATOR
	SKIPN	C,1(C)		; GET ADDR OR GO TO PURE DISP
	JRST	NORMAL
	JRST	(C)

PRDIS1: SUB	C,PRNTYP+1
	PUSH	P,C
	PUSH	TP,[TATOM,,-1]	; PUSH ON OUTCHAN FOR SPECBIND
	PUSH	TP,IMQUOTE OUTCHAN
	PUSH	TP,-5(TP)
	PUSH	TP,-5(TP)
	PUSH	TP,[0]
	PUSH	TP,[0]
	PUSHJ	P,SPECBIND
	POP	P,C		; RESTORE C
	ADD	C,PRNTYP+1		; RESTORE C
	PUSH	TP,(C)		; PUSH ARGS FOR APPLY
	PUSH	TP,1(C)
	PUSH	TP,-9(TP)
	PUSH	TP,-9(TP)
	MCALL	2,APPLY		; APPLY HACKER TO OBJECT
	MOVEI	E,-8(TP)
	PUSHJ	P,SSPEC1	;UNBIND OUTCHAN
	SUB	TP,[6,,6]	; POP OFF STACK
	JRST	PNEXT

; PRINT DISPATCH TABLE

IF2,PUNKS==400000,,PUNK

DISTBL	PRTYPE,PUNKS,[[TATOM,PATOM],[TFORM,PFORM],[TSEG,PSEG],[TFIX,PFIX]
[TFLOAT,PFLOAT],[TLIST,PLIST],[TVEC,PVEC],[TCHRS,PCHRS],[TCHSTR,PCHSTR]
[TARGS,PARGS],[TUVEC,PUVEC],[TDEFER,PDEFER],[TINTH,PINTH],[THAND,PHAND]
[TILLEG,ILLCH],[TRSUBR,PRSUBR],[TENTER,PENTRY],[TPCODE,PPCODE],[TTYPEW,PTYPEW]
[TTYPEC,PTYPEC],[TTMPLT,TMPRNT],[TLOCD,LOCPT1],[TLOCR,LOCRPT],[TQRSUB,PRSUBR]
[TQENT,PENTRY],[TSATC,PSATC],[TBYTE,PBYTE]
[TOFFS,POFFSE]]

PUNK:	MOVE	C,TYPVEC+1	; GET AOBJN-POINTER TO VECTOR OF TYPE ATOMS
	GETYP	B,-1(TP)	; GET THE TYPE CODE INTO REG B
	LSH	B,1		; MULTIPLY BY TWO
	HRL	B,B		; DUPLICATE IT IN THE LEFT HALF
	ADD	C,B		; INCREMENT THE AOBJN-POINTER
	JUMPGE	C,PRERR		; IF POSITIVE, INDEX > VECTOR SIZE

	MOVE	B,-2(TP)		; MOVE IN CHANNEL
	PUSH	TP,$TVEC		; SAVE ALLTYPES VECTOR
	PUSH 	TP,C
	PUSHJ	P,RETIF1	; START NEW LINE IF NO ROOM
	MOVEI	A,"#		; INDICATE TYPE-NAME FOLLOWS
	PUSHJ	P,PITYO
	POP	TP,C
	SUB	TP,[1,,1]
	MOVE	A,(C)		; GET TYPE-ATOM
	MOVE	B,1(C)
	PUSH	TP,-3(TP)		; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT	; PRINT ATOM-NAME
	SUB	TP,[2,,2]	; POP STACK 
	MOVE	B,-2(TP)		; MOVE IN CHANNEL
	PUSHJ	P,SPACEQ	;  MAYBE SPACE
	MOVE	B,(B)		; RESET THE REAL ARGUMENT POINTER
	HRRZ	A,(C)		; GET THE STORAGE-TYPE
	ANDI	A,SATMSK
	CAILE	A,NUMSAT	; SKIP IF TEMPLATE
	JRST	TMPRNT		; PRINT TEMPLATED DATA STRUCTURE
	HRRO	A,UKTBL(A)	; USE DISPATCH TABLE ON STORAGE TYPE
	JRST	(A)

DISTBS	UKTBL,POCTAL,[[S2WORD,PLIST],[S2NWORD,PVEC],[SNWORD,PUVEC],[SATOM,PATOM]
[SCHSTR,PCHSTR],[SFRAME,PFRAME],[SARGS,PARGS],[SPVP,PPVP],[SLOCID,LOCPT],[SLOCA,LOCP]
[SLOCV,LOCP],[SLOCU,LOCP],[SLOCS,LOCP],[SLOCL,LOCP],[SLOCN,LOCP],[SASOC,ASSPNT]
[SLOCT,LOCP],[SLOCB,LOCP],[SBYTE,PBYTE],[SOFFS,POFFSE]]
	; SELECK AN ILLEGAL

ILLCH:	MOVEI	B,-1(TP)
	JRST	ILLCHO

; PRINT INTERRUPT HANDLER

PHAND:	MOVE	B,-2(TP)	; MOVE CHANNEL INTO B
	PUSHJ	P,RETIF1
	MOVEI	A,"#
	PUSHJ	P,PITYO		; SAY "FUNNY TYPE"
	MOVSI	A,TATOM
	MOVE	B,MQUOTE HANDLER
	PUSH	TP,-3(TP)	; PUSH CHANNEL ON FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT		; PRINT THE TYPE NAME
	SUB	TP,[2,,2]		; POP CHANNEL OFF STACK
	MOVE	B,-2(TP)	; GET CHANNEL
	PUSHJ	P,SPACEQ		; SPACE MAYBE
	SKIPN	B,(TP)		; GET ARG BACK
	JRST	PNEXT
	MOVE	A,INTFCN(B)	; PRINT FUNCTION FOR NOW
	MOVE	B,INTFCN+1(B)
	PUSH	TP,-3(TP)		; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT	; PRINT THE INT FUNCTION
	SUB	TP,[2,,2]	; POP CHANNEL OFF
	JRST	PNEXT

; PRINT INT HEADER

PINTH:	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,RETIF1
	MOVEI	A,"#
	PUSHJ	P,PITYO
	MOVSI	A,TATOM		; AND NAME
	MOVE	B,MQUOTE IHEADER
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	MOVE	B,-4(TP)	; GET CHANNEL INTO B
	PUSHJ	P,SPACEQ	; MAYBE SPACE
	SKIPN	B,-2(TP)		; INT HEADER BACK
	JRST	PINTH1
	MOVE	A,INAME(B)	; GET NAME
	MOVE	B,INAME+1(B)
	PUSHJ	P,IPRINT
PINTH1:	SUB	TP,[2,,2]	; CLEAN OFF STACK
	JRST	PNEXT


; PRINT ASSOCIATION BLOCK

ASSPNT:	MOVEI	A,"(		; MAKE IT BE (ITEN INDIC VAL)
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,PRETIF		; MAKE ROOM AND PRINT
	SKIPA	C,[-3,,0]	; # OF FIELDS
ASSLP:	PUSHJ	P,SPACEQ
	MOVE	D,(TP)		; RESTORE GOODIE
	ADD	D,ASSOFF(C)	; POINT TO FIELD
	MOVE	A,(D)		; GET IT
	MOVE	B,1(D)
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT	; AND PRINT IT
	SUB	TP,[2,,2]	; POP OFF CHANNEL
	MOVE	B,-2(TP)	; GET CHANNEL
	AOBJN	C,ASSLP

	MOVEI	A,")
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,PRETIF	; CLOSE IT
	JRST	PNEXT

ASSOFF:	ITEM
	INDIC
	VAL
; PRINT TYPE-C AND TYPE-W

PTYPEW:	HRRZ	A,(TP)	; POSSIBLE RH
	HLRZ	B,(TP)
	MOVE	C,MQUOTE TYPE-W
	JRST	PTYPEX

PTYPEC:	HRRZ	B,(TP)
	MOVEI	A,0
	MOVE	C,MQUOTE TYPE-C

PTYPEX:	PUSH	P,B
	PUSH	P,A
	PUSH	TP,$TATOM
	PUSH	TP,C
	MOVEI	A,2
	MOVE	B,-4(TP)	; GET CHANNEL INTO B
	PUSHJ	P,RETIF		; ROOM TO START?
	MOVEI	A,"%
	PUSHJ	P,PITYO
	MOVEI	A,"<
	PUSHJ	P,PITYO
	POP	TP,B		; GET NAME
	POP	TP,A
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT	; AND PRINT IT AS 1ST ELEMENT
	SUB	TP,[2,,2]	; POP OFF CHANNEL
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,SPACEQ	; MAYBE SPACE
	MOVE	A,-1(P)		; TYPE CODE
	ASH	A,1
	HRLI	A,(A)		; MAKE SURE WINS
	ADD	A,TYPVEC+1
	JUMPL	A,PTYPX1	; JUMP FOR A WINNER
	ERRUUO	EQUOTE BAD-TYPE-CODE

PTYPX1:	MOVE	B,1(A)		; GET TYPE NAME
	HRRZ	A,(A)		; AND SAT
	ANDI	A,SATMSK
	MOVEM	A,-1(P)		; AND SAVE IT
	MOVSI	A,TATOM
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT	; OUT IT GOES
	SUB	TP,[2,,2]	; POP OFF CHANNEL
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,SPACEQ	; MAYBE SPACE
	MOVE	A,-1(P)		; GET SAT BACK
	MOVE	B,IMQUOTE TEMPLATE
	CAIGE	A,NUMSAT
	MOVE	B,@STBL(A)
	MOVSI	A,TATOM		; AND PRINT IT
	PUSH	TP,-3(TP)		; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]	; POP OFF STACK
	SKIPN	B,(P)		; ANY EXTRA CRAP?
	JRST	PTYPX2

	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,SPACEQ
	MOVE	B,(P)
	MOVSI	A,TFIX
	PUSH	TP,-3(TP)	; PUSH CHANNELS FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT	; PRINT EXTRA
	SUB	TP,[2,,2]	; POP OFF CHANNEL

PTYPX2:	MOVEI	A,">
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,PRETIF
	SUB	P,[2,,2]	; FLUSH CRUFT
	JRST	PNEXT

; PRIMTYPE CODE

; PRINT PURE CODE POINTER

PSATC:	MOVEI	A,2
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,RETIF
	MOVEI	A,"%
	PUSHJ	P,PITYO
	MOVEI	A,"<
	PUSHJ	P,PITYO
	MOVSI	A,TATOM		; PRINT SUBR CALL
	MOVE	B,MQUOTE PRIMTYPE-C
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	MOVE	B,-4(TP)	; GET CHANNEL INTO B
	PUSHJ	P,SPACEQ	; MAYBE SPACE?
	MOVE	A,-2(TP)
	CAILE	A,NUMSAT
	JRST	TMPPTY

	MOVE	B,@STBL(A)
	JRST	PSATC1

TMPPTY:	MOVE	B,TYPVEC+1
PSATC3:	HRRZ	C,(B)
	ANDI	C,SATMSK
	CAIN	A,(C)
	JRST	PSATC2
	ADD	B,[2,,2]
	JUMPL	B,PSATC3

	ERRUUO	EQUOTE BAD-PRIMTYPEC

PSATC2:	MOVE	B,1(B)
PSATC1:	MOVSI	A,TATOM
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]
	MOVEI	A,">
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,PRETIF	; CLOSE THE FORM
	JRST	PNEXT
	

PPCODE:	MOVEI	A,2
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,RETIF
	MOVEI	A,"%
	PUSHJ	P,PITYO
	MOVEI	A,"<
	PUSHJ	P,PITYO
	MOVSI	A,TATOM		; PRINT SUBR CALL
	MOVE	B,MQUOTE PCODE
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	MOVE	B,-4(TP)	; GET CHANNEL INTO B
	PUSHJ	P,SPACEQ	; MAYBE SPACE?
	HLRZ	A,-2(TP)		; OFFSET TO VECTOR
	ADD	A,PURVEC+1	; SLOT TO A
	MOVE	A,(A)		; SIXBIT NAME
	PUSH	P,FLAGS
	PUSHJ	P,6TOCHS	; TO A STRING
	POP	P,FLAGS
	PUSHJ	P,IPRINT
	MOVE	B,-4(TP)	; GET CHANNEL INTO B
	PUSHJ	P,SPACEQ
	HRRZ	B,-2(TP)	; GET OFFSET
	MOVSI	A,TFIX
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]	; POP CHANNEL OFF STACK
	MOVEI	A,">
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,PRETIF	; CLOSE THE FORM
	JRST	PNEXT


; PRINT SUB-ENTRY TO RSUBR

PENTRY:	MOVE	B,(TP)		; GET BLOCK
	GETYP	A,(B)		; TYPE OF 1ST ELEMENT
	CAIE	A,TRSUBR	; RSUBR, OK
	JRST	PENT1
PENT2:	MOVEI	A,2		; CHECK ROOM
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,RETIF
	MOVEI	A,"%		; SETUP READ TIME MACRO
	PUSHJ	P,PITYO
	MOVEI	A,"<
	PUSHJ	P,PITYO
	MOVSI	A,TATOM
	MOVE	B,IMQUOTE RSUBR-ENTRY
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	MOVE	B,-4(TP)
	PUSHJ	P,SPACEQ	; MAYBE SPACE
	MOVEI	A,"'		; QUOTE TO AVOID EVALING IT
	PUSHJ	P,PRETIF
	MOVEI	A,"[		; OPEN SQUARE BRAKET
	PUSHJ	P,PRETIF
	MOVE	B,-2(TP)
	GETYP	A,(B)
	CAIN	A,TRSUBR
	JRST	PENT3
	MOVE	A,(B)
	MOVE	B,1(B)
	PUSHJ	P,IPRINT
	MOVE	B,-4(TP)		; MOVE IN CHANNEL
	JRST	PENT4
PENT3:	MOVE	A,1(B)
	MOVE	B,3(A)
	MOVSI	A,TATOM		; FOOL EVERYBODY AND SEND OUT ATOM
	PUSHJ	P,IPRINT
	MOVE	B,-4(TP)		; PRINT SPACE
PENT4:	PUSHJ	P,SPACEQ
	MOVE	B,-2(TP)		; GET PTR BACK TO VECTOR
	MOVE	A,2(B)		; THE NAME OF THE ENTRY
	MOVE	B,3(B)
	PUSHJ	P,IPRINT	; OUT IT GOES
	HLRZ	B,-2(TP)
	CAIL	B,-4		; SEE IF DONE
	JRST	EXPEN
	MOVE	B,-4(TP)		; PRINT SPACE
	PUSHJ	P,SPACEQ
	MOVE	B,-2(TP)	; GET POINTER
	MOVE	A,4(B)		; DECL
	MOVE	B,5(B)
	PUSHJ	P,IPRINT
EXPEN:	MOVE	B,-4(TP)	; GET CHANNEL INTO B
	MOVEI	A,"]		; CLOSE SQUARE BRAKET
	PUSHJ	P,PRETIF
	MOVE	B,-4(TP)		; GET CHANNEL INTO B
	PUSHJ	P,SPACEQ
	MOVE	B,-2(TP)
	HRRZ	B,2(B)
	MOVSI	A,TFIX
	PUSHJ	P,IPRINT
	MOVEI	A,">
	SUB	TP,[2,,2]	; POP CHANNEL OFF STACK
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,PRETIF
	JRST	PNEXT

PENT1:	CAIN	A,TATOM
	JRST	PENT2
	ERRUUO	EQUOTE BAD-ENTRY-BLOCK

; HERE TO PRINT TEMPLATED DATA STRUCTURE

TMPRNT:	PUSH	P,FLAGS		; SAVE FLAGS
	MOVE	A,(TP)		; GET POINTER
	GETYP	A,(A)		; GET SAT
	PUSH	P,A		; AND SAVE IT
	MOVEI	A,"{		; OPEN SQUIGGLE
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,PRETIF	; PRINT WITH CHECKING
	HLRZ	A,(TP)		; GET AMOUNT RESTED OFF
	SUBI	A,1
	PUSH	P,A		; AND SAVE IT
	MOVE	A,-1(P)		; GET SAT
	SUBI	A,NUMSAT+1	; FIXIT UP
	HRLI	A,(A)
	ADD	A,TD.LNT+1	; CHECK FOR WINNAGE
	JUMPGE	A,BADTPL	; COMPLAIN
	HRRZS	C,(TP)		; GET LENGTH
	XCT	(A)		;  INTO B
	SUB	B,(P)		; FUDGE FOR RESTS
	MOVEI	B,-1(B)		; FUDGE IT
	PUSH	P,B		; AND SAVE IT

TMPRN1:	AOS	C,-1(P)		; GET ELEMENT OF INTEREST
	SOSGE	(P)		; CHECK FOR ANY LEFT
	JRST	TMPRN2		; ALL DONE

	MOVE	B,(TP)		; POINTER
	HRRZ	0,-2(P)		; SAT
	PUSHJ	P,TMPLNT	; GET THE ITEM
	MOVE	FLAGS,-3(P)	; RESTORE FLAGS
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT	; PRINT THIS ELEMENT
	SUB	TP,[2,,2]	; POP CHANNEL OFF STACK
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	SKIPE	(P)		; IF NOT LAST ONE THEN
	PUSHJ	P,SPACEQ	;   SEPARATE WITH A SPACE
	JRST	TMPRN1

TMPRN2:	SUB	P,[4,,4]
	MOVE	B,-2(TP)
	MOVEI	A,"}		; CLOSE THIS GUY
	PUSHJ	P,PRETIF
	JRST	PNEXT


; RSUBR PRINTING ROUTINES.  ON PRINTB CHANNELS, WRITES OUT
; COMPACT BINARY.  ON PRINT CHANNELS ALL IS ASCII

PRSUBR:	MOVE	A,(TP)		; GET RSUBR IN QUESTION
	GETYP	A,(A)		; CHECK FOR PURE RSUBR
	CAIN	A,TPCODE
	JRST	PRSBRP		; PRINT IT SPECIAL WAY

	TLNN	FLAGS,BINBIT	; SKIP IF BINARY OUTPUT
	JRST	ARSUBR

	PUSH	P,FLAGS
	MOVSI	A,TRSUBR	; FIND FIXUPS
	MOVE	B,(TP)
	HLRE	D,1(B)		; -LENGTH OF CODE VEC
	PUSH	P,D		; SAVE SAME
	MOVSI	C,TATOM
	MOVE	D,IMQUOTE RSUBR
	PUSHJ	P,IGET		; GO GET THEM
	JUMPE	B,RCANT		; NO FIXUPS, BINARY LOSES
	PUSH	TP,A		; SAVE FIXUP LIST
	PUSH	TP,B

	MOVNI	A,1		; USE ^C AS MARKER FOR RSUBR
	MOVE	FLAGS,-1(P)	; RESTORE FLAGS
	MOVE	B,-4(TP)	; GET CHANNEL FOR PITYO
	PUSHJ	P,PITYO		; OUT IT GOES

PRSBR1:	MOVE	B,-4(TP)
	PUSHJ	P,BFCLS1	; FLUSH OUT CURRENT BUFFER

	MOVE	B,-4(TP)		; CHANNEL BACK
	MOVN	E,(P)		; LENGTH OF CODE
	PUSH	P,E
	HRROI	A,(P)		; POINT TO SAME
	PUSHJ	P,DOIOTO	; OUT GOES COUNT
	MOVSI	C,TCODE
	MOVE	PVP,PVSTOR+1
	MOVEM	C,ASTO(PVP)	; FOR IOT INTERRUPTS
	MOVE	A,-2(TP)	; GET POINTER TO CODE
	MOVE	A,1(A)
	PUSHJ	P,DOIOTO	; IOT IT OUT
	POP	P,E
	ADDI	E,1		; UPDATE ACCESS
	ADDM	E,ACCESS(B)
	MOVE	PVP,PVSTOR+1
	SETZM	ASTO(PVP)	; UNSCREW A

; NOW PRINT OUT NORMAL RSUBR VECTOR

	MOVE	FLAGS,-1(P)	; RESTORE FLAGS
	SUB	P,[1,,1]
	MOVE	B,-2(TP)	; GET RSUBR VECTOR
	PUSHJ	P,PRBODY	; PRINT ITS BODY

; HERE TO PRINT BINARY FIXUPS

	MOVEI	E,0		; 1ST COMPUTE LENGTH OF FIXUPS
	SKIPN	A,(TP)	; LIST TO A
	JRST	PRSBR5		; EMPTY, DONE
	JUMPL	A,UFIXES	; JUMP IF FIXUPS IN UVECTOR FORM
	ADDI	E,1		; FOR VERS

PRSBR6:	HRRZ	A,(A)		; NEXT?
	JUMPE	A,PRSBR5
	GETYP	B,(A)
	CAIE	B,TDEFER	; POSSIBLE STRING
	JRST	PRSBR7		; COULD BE ATOM
	MOVE	B,1(A)		; POSSIBLE STRINGER
	GETYP	C,(B)
	CAIE	C,TCHSTR	; YES!!!
	JRST	BADFXU		; LOSING FIXUPS
	HRRZ	C,(B)		; # OF CHARS TO C
	ADDI	C,5+5		; ROUND AND ADD FOR COUNT
	IDIVI	C,5		; TO WORDS
	ADDI	E,(C)
	JRST	FIXLST		; COUNT FOR USE LIST ETC.

PRSBR7:	GETYP	B,(A)		; GET TYPE
	CAIE	B,TATOM
	JRST	BADFXU
	ADDI	E,1

FIXLST:	HRRZ	A,(A)		; REST IT TO OLD VAL
	JUMPE	A,BADFXU
	GETYP	B,(A)		; FIX?
	CAIE	B,TFIX
	JRST	BADFXU
	MOVEI	D,1
	HRRZ	A,(A)		; TO USE LIST
	JUMPE	A,BADFXU
	GETYP	B,(A)
	CAIE	B,TLIST
	JRST	BADFXU		; LOSER
	MOVE	C,1(A)		; GET LIST

PRSBR8:	JUMPE	C,PRSBR9
	GETYP	B,(C)		; TYPE OK?
	CAIE	B,TFIX
	JRST	BADFXU
	HRRZ	C,(C)
	AOJA	D,PRSBR8	; LOOP

PRSBR9:	ADDI	D,2		; ROUND UP
	ASH	D,-1		; DIV BY 2 FOR TWO GOODIES PER HWORD
	ADDI	E,(D)
	JRST	PRSBR6

PRSBR5:	PUSH	P,E		; SAVE LENGTH OF FIXUPS
	PUSH	TP,$TUVEC	; SLOT FOR BUFFER POINTER
	PUSH	TP,[0]

PFIXU1:	MOVE	B,-6(TP)		; START LOOPING THROUGH CHANNELS
	PUSHJ	P,BFCLS1	; FLUSH BUFFER
	MOVE	B,-6(TP)		; CHANNEL BACK
	MOVEI	C,BUFSTR-1(B)	; SETUP BUFFER
	PUSHJ	P,BYTDOP	; FIND D.W.
	SUBI	A,BUFLNT+1
	HRLI	A,-BUFLNT
	MOVEM	A,(TP)
	MOVE	E,(P)		; LENGTH OF FIXUPS
	SETZB	C,D		; FOR EOUT
	PUSHJ	P,EOUT
	MOVE	C,-2(TP)	; FIXUP LIST
	MOVE	E,1(C)		; HAVE VERS
	PUSHJ	P,EOUT		; OUT IT GOES

PFIXU2:	HRRZ	C,(C)		; FIRST THING
	JUMPE	C,PFIXU3	; DONE?
	GETYP	A,(C)		; STRING OR ATOM
	CAIN	A,TATOM		; MUST BE STRING
	JRST	PFIXU4
	MOVE	A,1(C)		; POINT TO POINTER
	HRRZ	D,(A)		; LENGTH
	IDIVI	D,5
	PUSH	P,E		; SAVE REMAINDER
	MOVEI	E,1(D)
	MOVNI	D,(D)
	MOVSI	D,(D)
	PUSH	P,D
	PUSHJ	P,EOUT
	MOVEI	D,0
PFXU1A:	MOVE	A,1(C)		; RESTORE POINTER
	HRRZ	A,1(A)		; BYTE POINTER
	ADD	A,(P)
	MOVE	E,(A)
	PUSHJ	P,EOUT
	MOVE	A,[1,,1]
	ADDB	A,(P)
	JUMPL	A,PFXU1A
	MOVE	D,-1(P)		; LAST WORD
	MOVE	A,1(C)
	HRRZ	A,1(A)
	ADD	A,(P)
	SKIPE	E,D
	MOVE	E,(A)		; LAST WORD OF CHARS
	IOR	E,PADS(D)
	PUSHJ	P,EOUT		; OUT
	SUB	P,[1,,1]
	JRST	PFIXU5

PADS:	ASCII /#####/
	ASCII /####/
	ASCII /###/
	ASCII /##/
	ASCII /#/

PFIXU4:	HRRZ	E,(C)		; GET CURRENT VAL
	MOVE	E,1(E)
	MOVEM	C,-2(TP)
	PUSHJ	P,ATOSQ		; GET SQUOZE
	JRST	BADFXU
	TLO	E,400000	; USE TO DIFFERENTIATE BETWEEN STRING
	PUSHJ	P,EOUT
	MOVE	C,-2(TP)

; HERE TO WRITE OUT LISTS

PFIXU5:	HRRZ	C,(C)		; POINT TO CURRENT VALUE
	HRLZ	E,1(C)
	HRRZ	C,(C)		; POINT TO USES LIST
	HRRZ	D,1(C)		; GET IT
	MOVEM	C,-2(TP)

PFIXU6:	TLCE	D,400000	; SKIP FOR RH
	HRLZ	E,1(D)		; SETUP LH
	JUMPG	D,.+3
	HRR	E,1(D)
	PUSHJ	P,EOUT		; WRITE IT OUT
	HRR	D,(D)
	TRNE	D,-1		; SKIP IF DONE
	JRST	PFIXU6

	TRNE	E,-1		; SKIP IF ZERO BYTE EXISTS
	MOVEI	E,0
	PUSHJ	P,EOUT
	MOVE	C,-2(TP)
	JRST	PFIXU2		; DO NEXT

PFIXU3:	HLRE	C,(TP)		; -AMNT LEFT IN BUFFER
	MOVN	D,C		; PLUS SAME
	ADDI	C,BUFLNT	; WORDS USED TO C
	JUMPE	C,PFIXU7	; NONE USED, LEAVE
	MOVSS	C		; START SETTING UP BTB
	MOVN	A,C		; ALSO FINAL IOT POINTER
	HRR	C,(TP)		; PDL POINTER PART OF BTB
	SUBI	C,1
	HRLI	D,400000+C	; CONTINUE SETTING UP BTB (400000 IS FOR MULTI
				;	SEGS
	POP	C,@D		; MOVE 'EM DOWN
	TLNE	C,-1
	JRST	.-2
	HRRI	A,@D		; OUTPUT POINTER
	ADDI	A,1
	MOVSI	B,TUVEC
	MOVE	PVP,PVSTOR+1
	MOVEM	B,ASTO(PVP)
	MOVE	B,-6(TP)
	PUSHJ	P,DOIOTO	; WRITE IT OUT
	MOVE	PVP,PVSTOR+1
	SETZM	ASTO(PVP)

PFIXU7:		SUB	TP,[4,,4]
	SUB	P,[2,,2]
	JRST	PNEXT

; ROUTINE TO OUTPUT CONTENTS OF E

EOUT:	MOVE	B,-6(TP)	; CHANNEL
	AOS	ACCESS(B)
	MOVE	A,(TP)		; BUFFER POINTER
	MOVEM	E,(A)
	AOBJP	A,.+3		; COUNT AND GO
	MOVEM	A,(TP)
	POPJ	P,

	SUBI	A,BUFLNT	; SET UP IOT POINTER
	HRLI	A,-BUFLNT
	MOVEM	A,(TP)		; RESET SAVED POINTER
	MOVSI	0,TUVEC
	MOVE	PVP,PVSTOR+1
	MOVEM	0,ASTO(PVP)
	MOVSI	0,TLIST
	MOVEM	0,DSTO(PVP)
	MOVEM	0,CSTO(PVP)
	PUSHJ	P,DOIOTO	; OUT IT GOES
	MOVE	PVP,PVSTOR+1
	SETZM	ASTO(PVP)
	SETZM	CSTO(PVP)
	SETZM	DSTO(PVP)
	POPJ	P,

; HERE IF UVECOR FORM OF FIXUPS

UFIXES:	PUSH	TP,$TUVEC
	PUSH	TP,A		; SAVE IT

UFIX1:		MOVE	B,-6(TP)		; GET SAME
	PUSHJ	P,BFCLS1	; FLUSH OUT BUFFER
	HLRE	C,(TP)	; GET LENGTH
	MOVMS	C
	PUSH	P,C
	HRROI	A,(P)		; READY TO ZAP IT OUT
	PUSHJ	P,DOIOTO	; ZAP!
	SUB	P,[1,,1]
	HLRE	C,(TP)		; LENGTH BACK
	MOVMS	C
	ADDI	C,1
	ADDM	C,ACCESS(B)	; UPDATE ACCESS
	MOVE	A,(TP)		; NOW THE UVECTOR
	MOVSI	C,TUVEC
	MOVE	PVP,PVSTOR+1
	MOVEM	C,ASTO(PVP)
	PUSHJ	P,DOIOTO	; GO
	MOVE	PVP,PVSTOR+1
	SETZM	ASTO(PVP)
	SUB	P,[1,,1]
	SUB	TP,[4,,4]
	JRST	PNEXT

RCANT:	ERRUUO	EQUOTE RSUBR-LACKS-FIXUPS


BADFXU:	ERRUUO	EQUOTE BAD-FIXUPS

PRBODY:	TDZA	C,C		; FLAG SAYING FLUSH CODE
PRBOD1:	MOVEI	C,1		; PRINT CODE ALSO
	PUSH	P,FLAGS
	PUSH	TP,$TRSUBR
	PUSH	TP,B
	PUSH	P,C
	MOVEI	A,"[		; START VECTOR TEXT
	MOVE	B,-6(TP)	; GET CHANNEL FOR PITYO
	PUSHJ	P,PITYO
	POP	P,C
	MOVE	B,(TP)		; RSUBR BACK
	JUMPN	C,PRSON		; GO START PRINTING
	MOVEI	A,"0		; PLACE SAVER FOR CODE VEC
	MOVE	B,-6(TP)	; GET CHANNEL FOR PITYO
	PUSHJ	P,PITYO

PRSBR2:	MOVE	B,[2,,2]	; BUMP VECTOR
	ADDB	B,(TP)
	JUMPGE	B,PRSBR3	; NO SPACE IF LAST
	MOVE	B,-6(TP)	; GET CHANNEL FOR SPACEQ
	PUSHJ	P,SPACEQ
	SKIPA	B,(TP)		; GET BACK POINTER
PRSON:	JUMPGE	B,PRSBR3
	GETYP	0,(B)		; SEE IF RSUBR POINTED TO
	CAIE	0,TQENT
	CAIN	0,TENTER
	JRST	.+5		; JUMP IF RSUBR ENTRY
	CAIN	0,TQRSUB
	JRST	.+3
	CAIE	0,TRSUBR	; YES!
	JRST	PRSB10		; COULD BE SUBR/FSUBR
	MOVE	C,1(B)		; GET RSUBR
	PUSH	P,0		; SAVE TYPE FOUND
	GETYP	0,2(C)		; SEE IF ATOM
	CAIE	0,TATOM
	JRST	PRSBR4
	MOVE	B,3(C)		; GET ATOM NAME
	PUSHJ	P,IGVAL		; GO LOOK
	MOVE	C,(TP)		; ORIG RSUBR BACK
	GETYP	A,A
	POP	P,0		; DESIRED TYPE
	CAIE	0,(A)		; SAME TYPE
	JRST	PRSBR4
	MOVE	D,1(C)
	MOVE	0,3(D)		; NAME OF RSUBR IN QUESTION
	CAME	0,3(B)		; WIN?
	JRST	PRSBR4
	HRRZ	E,C
	MOVSI	A,TATOM
	MOVE	B,0		; GET ATOM
	MOVE	FLAGS,(P)
	JRST	PRS101

PRSBR4:	MOVE	FLAGS,(P)	; RESTORE FLAGS
	MOVE	B,(TP)
	MOVE	A,(B)
	MOVE	B,1(B)		; PRINT IT
PRS101:	PUSH	TP,-7(TP)	; PUSH CHANNEL FOR IPRINT
	PUSH	TP,-7(TP)
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]	; POP OFF CHANNEL
	MOVE	B,-2(TP)		; MOVE IN CHANNEL
	JRST	PRSBR2

PRSB10:	CAIE	0,TSUBR		; SUBR?
	CAIN	0,TFSUBR
	JRST	.+2
	JRST	PRSBR4
	MOVE	C,1(B)		; GET LOCN OF SUBR OR FSUBR
	MOVE	B,@-1(C)	; NAME OF IT
	MOVSI	A,TATOM		; AND TYPE
	JRST	PRS101

PRSBR3:	MOVEI	A,"]
	MOVE	B,-6(TP)
	PUSHJ	P,PRETIF	; CLOSE IT UP
	SUB	TP,[2,,2]	; FLUSH CRAP
	POP	P,FLAGS
	POPJ	P,


; HERE TO PRINT PURE RSUBRS

PRSBRP:	MOVEI	A,2		; WILL "%<" FIT?
	MOVE	B,-2(TP)	; GET CHANNEL FOR RETIF
	PUSHJ	P,RETIF
	MOVEI	A,"%
	PUSHJ	P,PITYO
	MOVEI	A,"<
	PUSHJ	P,PITYO
	MOVSI	A,TATOM
	MOVE	B,IMQUOTE RSUBR
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT	; PRINT IT OUT
	SUB	TP,[2,,2]	; POP OFF CHANNEL
	MOVE	B,-2(TP)
	PUSHJ	P,SPACEQ	; MAYBE SPACE
	MOVEI	A,"'		; QUOTE THE VECCTOR
	PUSHJ	P,PRETIF
	MOVE	B,(TP)		; GET RSUBR BODY BACK
	PUSH	TP,$TFIX		; STUFF THE STACK
	PUSH	TP,[0]
	PUSHJ	P,PRBOD1	; PRINT AND UNLINK
	SUB	TP,[2,,2]	; GET JUNK OFF STACK
	MOVE	B,-2(TP)	; GET CHANNEL FOR RETIF
	MOVEI	A,">
	PUSHJ	P,PRETIF
	JRST	PNEXT

; HERE TO PRINT ASCII RSUBRS

ARSUBR:	PUSH	P,FLAGS		; SAVE FROM GET
	MOVSI	A,TRSUBR
	MOVE	B,(TP)
	MOVSI	C,TATOM
	MOVE	D,IMQUOTE RSUBR
	PUSHJ	P,IGET		; TRY TO GET FIXUPS
	POP	P,FLAGS
	JUMPE	B,PUNK		; NO FIXUPS LOSE
	GETYP	A,A
	CAIE	A,TLIST		; ARE FIXUPS A LIST?
	JRST	PUNK		; NO, AGAIN LOSE
	PUSH	TP,$TLIST
	PUSH	TP,B		; SAVE FIXUPS
	MOVEI	A,17.
	MOVE	B,-4(TP)
	PUSHJ	P,RETIF
	PUSH	P,[440700,,[ASCIZ /%<FIXUP!-RSUBRS!-/]]

AL1:	ILDB	A,(P)		; GET CHAR
	JUMPE	A,.+3
	PUSHJ	P,PITYO
	JRST	AL1

	SUB	P,[1,,1]
	PUSHJ	P,SPACEQ

	MOVEI	A,"'
	PUSHJ	P,PRETIF	; QUOTE TO AVOID ADDITIONAL EVAL
	MOVE	B,-2(TP)	; PRINT ACTUAL KLUDGE
	PUSHJ	P,PRBOD1
	MOVE	B,-4(TP)	; GET CHANNEL FOR SPACEQ
	PUSHJ	P,SPACEQ
	MOVEI	A,"'		; DONT EVAL FIXUPS EITHER
	PUSHJ	P,PRETIF
	POP	TP,B
	POP	TP,A
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]	; POP CHANNEL OFF STACK
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	MOVEI	A,">
	PUSHJ	P,PRETIF
	JRST	PNEXT

; HERE TO DO OFFSETS:  %<OFFSET N '<VECTOR FIX FLOAT>>

POFFSE:	MOVEI	A,2
	MOVE	B,-2(TP)
	PUSHJ	P,RETIF
	MOVEI	A,"%
	PUSHJ	P,PITYO
	MOVEI	A,"<
	PUSHJ	P,PITYO
	MOVSI	A,TATOM
	MOVE	B,MQUOTE OFFSET
	PUSH	TP,-3(TP)
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]
	MOVE	B,-2(TP)	; RESTORE CHANNEL
	PUSHJ	P,SPACEQ
	MOVSI	A,TFIX
	HRRE	B,(TP)		; PICK UPTHE FIX
	PUSH	TP,-3(TP)
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]
	MOVE	B,-2(TP)	; RESTORE CHANNEL
	PUSHJ	P,SPACEQ
	HLRZ	A,(TP)
	JUMPE	A,POFFS2
	GETYP	B,(A)
	CAIE	B,TFORM		; FORMS HAVE TO BE QUOTED
	 JRST	POFFS1
	MOVEI	A,"'
	MOVE	B,-2(TP)
	PUSHJ	P,PRETIF
POFFS1:	HLRZ	B,(TP)
	MOVE	A,(B)
	MOVE	B,1(B)
POFFPT:	PUSH	TP,-3(TP)
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]
	MOVE	B,-2(TP)	; RESTORE CHANNEL
	MOVEI	A,">
	PUSHJ	P,PRETIF
	JRST	PNEXT
; PRINT 'ANY' IF 0
POFFS2:	MOVSI	A,TATOM
	MOVE	B,IMQUOTE ANY
	JRST	POFFPT

; HERE TO DO LOCATIVES (PRINT CONTENTS THEREOF)

LOCP:	PUSH	TP,-1(TP)
	PUSH	TP,-1(TP)
	PUSH	P,0
	MCALL	1,IN		; GET ITS CONTENTS FROM "IN"
	POP	P,0
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT	; PRINT IT
	SUB	TP,[2,,2]	; POP CHANNEL OFF STACK
	JRST	PNEXT
;INTERNAL SUBROUTINE TO HANDLE CHARACTER OUTPUT
;B CONTAINS CHANNEL
;PRINTER ITYO USED FOR FLATSIZE FAKE OUT
PITYO:	TLNN	FLAGS,FLTBIT
	JRST	ITYO
PITYO1:	PUSH	TP,[TTP,,0]	; PUSH ON TP POINTER
	PUSH	TP,B
	TLNE	FLAGS,UNPRSE	;SKIPS UNPRSE NOT SET
	JRST	ITYO+2
	AOS	FLTSIZ	;FLATSIZE DOESN'T PRINT
			;INSTEAD IT COUNTS THE CHARACTERS THAT WOULD BE OUTPUT
	SOSGE	FLTMAX	;UNLESS THE MAXIMUM IS EXCEEDED
	JRST	.+4
	POP	TP,B		; GET CHANNEL BACK
	SUB	TP,[1,,1]
	POPJ	P,
	MOVEI	E,(B)		; GET POINTER FOR UNBINDING
	PUSHJ	P,SSPEC1
	MOVE	P,UPB+8		; RESTORE P
	POP	TP,B		; GET BACK TP POINTER
	PUSH	P,0		; SAVE FLAGS
	MOVE	TP,B		; RESTORE TP
	MOVEI	C,(TB)		; SEE IF TB IS CORRECT
	CAIG	C,1(TP)		; SKIP IF NEEDS UNWINDING
	JRST	PITYO4
PITYO3:	MOVEI	C,(TB)
	CAILE	C,1(TP)
	JRST	PITYO2
	MOVEI	A,PITYO4	; SET UP PARAMETERS TO BE RESTORED BY FINIS
	HRRM	A,PCSAV(C)
	MOVEM	TP,TPSAV(C)
	MOVE	SP,SPSTOR+1
	MOVEM	SP,SPSAV(C)
	MOVEM	P,PSAV(C)
	MOVE	TB,D		; SET TB TO ONE FRAME AHEAD
	JRST	FINIS
PITYO4:	POP	P,0		; RESTORE FLAGS
	MOVSI	A,TFALSE	;IN WHICH CASE IT IMMEDIATELY GIVES UP AND RETURNS FALSE
	MOVEI	B,0
	POPJ	P,

PITYO2:	MOVE	D,TB		; SAVE ONE FRAME AHEAD
	HRR	TB,OTBSAV(TB)	; RESTORE TB
	JRST	PITYO3


;THE REAL THING
;NOTE THAT THE FOLLOWING CODE HAS BUGS IF IT IS PRINTING OUT LONG
;CHARACTER STRINGS
; (NOTE THAT THE ABOVE COMMENT, IF TRUE, SHOULD NOT BE ADMITTED.)
ITYO:	PUSH	TP,$TCHAN
	PUSH	TP,B
	PUSH	P,FLAGS		;SAVE STUFF
	PUSH	P,C
	PUSH	P,A		;SAVE OUTPUT CHARACTER


	TLNE	FLAGS,UNPRSE	;SKIPS UNPRSE NOT SET
	 JRST	UNPROUT		;IF FROM UNPRSE, STASH IN STRING
	CAIN	A,^J
	 PUSHJ	P,INTCHK
	PUSH	P,A
	PUSHJ	P,WXCT
	POP	P,A
	CAIE	A,^L		;SKIP IF THIS IS A FORM-FEED
	 JRST	NOTFF
	SETZM	LINPOS(B)	;ZERO THE LINE NUMBER
	JRST	ITYXT

NOTFF:	CAIE	A,15		;SKIP IF IT IS A CR
	 JRST	NOTCR
	SETZM	CHRPOS(B)	;ZERO THE CHARACTER POSITION
	PUSHJ	P,AOSACC	; BUMP COUNT
	JRST	ITYXT1

NOTCR:	CAIN	A,^I		;SKIP IF NOT TAB
	 JRST	TABCNT
	CAIE	A,10		; BACK SPACE
	 JRST	.+3
	SOS	CHRPOS(B)	; BACK UP ONE
	JRST	ITYXT
	CAIE	A,^J		;SKIP IF LINE FEED
	 JRST	NOTLF
	AOS	C,LINPOS(B)	;ADD ONE TO THE LINE NUMBER
	CAMLE	C,PAGLN(B)	;SKIP IF THIS DOESN'T TAKES US PAST PAGE END
	 SETZM	LINPOS(B)
	MOVE	FLAGS,-2(P)
	JRST	ITYXT

INTCHK:	HRRZ	0,-2(B)		; GET CHANNELS FLAGS
	TRNN	0,C.INTL	; LOSER INTERESTED IN LFS?
	 POPJ	P,		; LEAVE IF NOTHING TO DO
	PUSH	TP,$TCHAN
	PUSH	TP,B		; SAVE CHANNEL
	PUSH	P,C
	PUSH	P,E
	PUSHJ	P,GTLPOS		; READ SYSTEMS VERSION OF LINE #
	PUSH	TP,$TATOM
	PUSH	TP,MQUOTE CHAR,CHAR,INTRUP
	PUSH	TP,$TFIX
	PUSH	TP,A
	PUSH	TP,$TCHAN
	PUSH	TP,B
	MCALL	3,INTERRUPT
	POP	P,E		; RESTORE POSSIBLE COUNTS
	POP	P,C
	POP	TP,B		; RESTORE CHANNEL
	SUB	TP,[1,,1]
	MOVEI	A,^J
	POPJ	P,

NOTLF:	CAIGE	A,40
	AOS	CHRPOS(B)	; FOR CONTROL CHARS THAT NEED 2 SPACES
	AOS	CHRPOS(B)	;ADD TO CHARACTER NUMBER

ITYXT:	PUSHJ	P,AOSACC	; BUMP ACCESS
ITYXT1:	POP	P,A		;RESTORE THE ORIGINAL CHARACTER

ITYRET:	POP	P,C		;RESTORE REGS & RETURN
	POP	P,FLAGS
	POP	TP,B		; GET CHANNEL BACK
	SUB	TP,[1,,1]
	POPJ	P,

TABCNT:	PUSH	P,D
	MOVE	C,CHRPOS(B)
	ADDI	C,8.		;INCREMENT COUNT BY EIGHT (MOD EIGHT)
	IDIVI	C,8.
	IMULI	C,8.
	MOVEM	C,CHRPOS(B)	;REPLACE COUNT
	POP	P,D
	JRST	ITYXT

UNPROUT: POP	P,A	;GET BACK THE ORIG CHAR
	IDPB	A,UPB+2		;DEPOSIT USING BYTE POINTER I PUSHED LONG AGO
	SOS	UPB+1
	JRST	ITYRET	;RETURN

AOSACC:	TLNN	FLAGS,BINBIT
	JRST	NRMACC
	AOS	C,ACCESS-1(B)	; COUNT CHARS IN WORD
	CAMN	C,[TFIX,,1]
	AOS	ACCESS(B)
	CAMN	C,[TFIX,,5]
	HLLZS	ACCESS-1(B)
	POPJ	P,

NRMACC:	AOS	ACCESS(B)
	POPJ	P,

SPACEQ:	MOVEI	A,40
	TLNE	FLAGS,FLTBIT+BINBIT
	JRST	PITYO		; JUST OUTPUT THE SPACE
	PUSH	P,[1]		; PRINT SPACE IF NOT END OF LINE
	MOVEI	A,1
	JRST	RETIF2

RETIF1:	MOVEI	A,1

RETIF:	PUSH	P,[0]
	TLNE	FLAGS,FLTBIT+BINBIT
	JRST	SPOPJ		; IF WE ARE IN FLATSIZE THEN ESCAPE
RETIF2:	PUSH	P,FLAGS
RETCH:	PUSH	P,A

RETCH1:	ADD	A,CHRPOS(B)	;ADD THE CHARACTER POSITION
	SKIPN	CHRPOS(B)	; IF JUST RESET, DONT DO IT AGAIN
	JRST	RETXT
	CAMG	A,LINLN(B)	;SKIP IF GREATER THAN LINE LENGTH
	JRST	RETXT1

	MOVEI	A,^M		;FORCE A CARRIAGE RETURN
	SETZM	CHRPOS(B)
	PUSHJ	P,WXCT
	PUSHJ	P,AOSACC	; BUMP CHAR COUNT
	MOVEI	A,^J		;AND FORCE A LINE FEED
	PUSHJ	P,INTCHK	; CHECK FOR ^J INTERRUPTS
	PUSHJ	P,WXCT
	PUSHJ	P,AOSACC	; BUMP CHAR COUNT
	AOS	A,LINPOS(B)
	CAMG	A,PAGLN(B)	;AT THE END OF THE PAGE ?
	JRST	RETXT
;	MOVEI	A,^L	;IF SO FORCE A FORM FEED
;	PUSHJ	P,WXCT
;	PUSHJ	P,AOSACC	; BUMP CHAR COUNT
	SETZM	LINPOS(B)

RETXT:	POP	P,A

	POP	P,FLAGS
SPOPJ:	SUB	P,[1,,1]
	POPJ	P,	;RETURN

PRETIF:	PUSH	P,A	;SAVE CHAR
	PUSHJ	P,RETIF1
	POP	P,A
	JRST	PITYO

RETIF3:	TLNE	FLAGS,FLTBIT	; NOTHING ON FLATSIZE
	POPJ	P,
	PUSH	P,[0]
	PUSH	P,FLAGS
	HRRI	FLAGS,2		; PRETEND ONLY 1 CHANNEL
	PUSH	P,A
	JRST	RETCH1

RETXT1:	SKIPN	-2(P)		; SKIP IF SPACE HACK
	JRST	RETXT
	MOVEI	A,40
	PUSHJ	P,WXCT
	AOS	CHRPOS(B)
	PUSH	P,C
	PUSHJ	P,AOSACC
	POP	P,C
	JRST	RETXT

;THIS IS CODE TO HANDLE UNKNOWN DATA TYPES.
;IT PRINTS "*XXXXXX*XXXXXXXXXXXX*", WHERE THE FIRST NUMBER IS THE
;TYPE CODE IN OCTAL, THE SECOND IS THE VALUE FIELD IN OCTAL.
PRERR:	MOVEI	A,21.	;CHECK FOR 21. SPACES LEFT ON PRINT LINE
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,RETIF	;INSERT CARRIAGE RETURN IF NOT ENOUGH
	MOVEI	A,"*	;JUNK TO INDICATE ERROR PRINTOUT IN OCTAL
	PUSHJ	P,PITYO	;TYPE IT

	MOVE	E,[000300,,-2(TP)]	;GET POINTER INDEXED OFF TP SO THAT
				;TYPE CODE MAY BE OBTAINED FOR PRINTING.
	MOVEI	D,6	;# OF OCTAL DIGITS IN HALF WORD
OCTLP1:	ILDB	A,E	;GET NEXT 3-BIT BYTE OF TYPE CODE
	IORI	A,60	;OR-IN 60 FOR ASCII DIGIT
	PUSHJ	P,PITYO	;PRINT IT
	SOJG	D,OCTLP1	;REPEAT FOR SIX CHARACTERS

PRE01:	MOVEI	A,"*	;DELIMIT TYPE CODE FROM VALUE FIELD
	PUSHJ	P,PITYO

	HRLZI	E,(410300,,(TP))	;BYTE POINTER TO SECOND WORD
				;INDEXED OFF TP
	MOVEI	D,12.	;# OF OCTAL DIGITS IN A WORD
OCTLP2:	LDB	A,E	;GET 3 BITS
	IORI	A,60	;CONVERT TO ASCII
	PUSHJ	P,PITYO	;PRINT IT
	IBP	E	;INCREMENT POINTER TO NEXT BYTE
	SOJG	D,OCTLP2	;REPEAT FOR 12. CHARS

	MOVEI	A,"*	;DELIMIT END OF ERROR TYPEOUT
	PUSHJ	P,PITYO	;REPRINT IT

	JRST	PNEXT	;RESTORE REGS & POP UP ONE LEVEL TO CALLER

POCTAL:	MOVEI	A,14.	;RETURN TO NEW LINE IF 14. SPACES NOT LEFT
	MOVE	B,-2(TP)		; GET CHANNEL INTO B
	PUSHJ	P,RETIF
	JRST	PRE01	;PRINT VALUE AS "*XXXXXXXXXXXX*"

;PRINT BINARY INTEGERS IN DECIMAL.
;
PFIX:	MOVM	E,(TP)		; GET # (MAFNITUDE)
	JUMPL	E,POCTAL	; IF ABS VAL IS NEG, MUST BE SETZ
	PUSH	P,FLAGS

PFIX1:	MOVE	B,-2(TP)	; GET CHANNEL INTO B
PFIX2:	MOVE	D,UPB+6		; IF UNPARSE, THIS IS RADIX
	TLNE	FLAGS,UNPRSE+FLTBIT	;SKIPS IF NOT FROM UNPARSE OR FLATSIZE
	JRST	PFIXU
	MOVE	D,RADX(B)	; GET OUTPUT RADIX
PFIXU:	CAIG	D,1		; DONT ALLOW FUNNY RADIX
	MOVEI	D,10.		; IF IN DOUBT USE 10.
	PUSH	P,D
	MOVEI	A,1		; START A COUNTER
	SKIPGE	B,(TP)		; CHECK SIGN
	MOVEI	A,2		; NEG, NEED CHAR FOR SIGN

	IDIV	B,D		; START COUNTING
	JUMPE	B,.+2
	AOJA	A,.-2

	MOVE	B,-2(TP)	; CHANNEL TO B
	TLNN	FLAGS,FLTBIT+BINBIT
	PUSHJ	P,RETIF3	; CHECK FOR C.R.
	MOVE	B,-2(TP)		; RESTORE CHANNEL
	MOVEI	A,"-		; GET SIGN
	SKIPGE	(TP)		; SKIP IF NOT NEEDED
	PUSHJ	P,PITYO
	MOVM	C,(TP)	; GET MAGNITUDE OF #
	MOVE	B,-2(TP)	; RESTORE CHANNEL
	POP	P,E		; RESTORE RADIX
	PUSHJ	P,FIXTYO	; WRITE OUT THE #
	MOVE	FLAGS,-1(P)
	SUB	P,[1,,1]	; FLUSH P STUFF
	JRST	PNEXT

FIXTYO:	IDIV	C,E
	PUSH	P,D		; SAVE REMAINDER
	SKIPE	C
	PUSHJ	P,FIXTYO
	POP	P,A		; START GETTING #'S BACK
	ADDI	A,60
	MOVE	B,-2(TP)		; CHANNEL BACK
	JRST	PITYO

;PRINT SINGLE-PRECISION FLOATING POINT NUMBERS IN DECIMAL.
;
PFLOAT: SKIPN	A,(TP)		; SKIP IF NUMBER IS NON-ZERO 
				;	SPECIAL HACK FOR ZERO)
	JRST	PFLT0		; HACK THAT ZERO
	MOVM	E,A		; CHECK FOR NORMALIZED
	TLNN	E,400		; NORMALIZED
	JRST	PUNK
	MOVE	E,[SETZ FLOATB]	;ADDRESS OF FLOATING POINT CONVERSION ROUTINE
	MOVE	D,[6,,6]	;# WORDS TO GET FROM STACK

PNUMB:	HRLI	A,1(P)		; LH(A) TO CONTAIN ADDRESS OF RETURN AREA
				;	ON STACK
	HRR	A,TP		; RH(A) TO CONTAIN ADDRESS OF DATA ITEM
	HLRZ	B,A		; SAVE RETURN AREA ADDRESS IN REG B
	ADD	P,D		; ADD # WORDS OF RETURN AREA TO BOTH HALVES OF
				;	SP
	JUMPGE	P,PDLERR	; PLUS OR ZERO STACK POINTER IS OVERFLOW
PDLWIN:	PUSHJ	P,(E)		; CALL ROUTINE WHOSE ADDRESS IS IN REG E

	MOVE	C,(B)		; GET COUNT 0F # CHARS RETURNED
PFLT1:	MOVE	A,B
	HRR	B,P		; GET PSTACK POINTER AND PRODUCE RELATAVIZED
	SUB	A,B
	HRLS	A			; ADD TO AOBJN
	ADD	A,P		; PRODUCE PDL POINTER
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSH	TP,$TPDL		; PUSH PDL POINTER
	PUSH	TP,A
	MOVE	A,C		; MAKE SURE THAT # WILL FIT ON PRINT LINE
	PUSH	P,D		; WATCH THAT MCALL
	PUSHJ	P,RETIF		; START NEW LINE IF IT WON'T
	POP	P,D
	POP	TP,B		; RESTORE B
	SUB	TP,[1,,1]		; CLEAN OFF STACK

	HRLI	B,000700	;MAKE REG B INTO BYTE POINTER TO FIRST CHAR
				;	LESS ONE
PNUM01:	ILDB	A,B		; GET NEXT BYTE
	PUSH	P,B		; SAVE B
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,PITYO		; PRINT IT
	POP	P,B		; RESTORE B
	SOJG	C,PNUM01	; DECREMENT CHAR COUNT: LOOP IF NON-ZERO

	SUB	P,D	;SUBTRACT # WORDS USED ON STACK FOR RETURN
	JRST	PNEXT	;STORE REGS & POP UP ONE LEVEL TO CALLER


PFLT0:	MOVEI	A,9.	; WIDTH OF 0.0000000
	MOVEI	C,9.	; SEE ABOVE
	MOVEI	D,0	; WE'RE GONNA TEST D SOON...SO WILL DO RIGHT THING
	MOVEI	B,[ASCII /0.0000000/]
	SOJA	B,PFLT1	; PT TO 1 BELOW CONST, THEN REJOIN CODE




PDLERR:	SUB	P,D		;REST STACK POINTER
REPEAT 6,PUSH	P,[0]
	JRST PDLWIN

; FLOATING POINT PRINTER STOLEN FROM DDT

F==E+1
G==F+1
H==G+1
I==H+1
J==I+1
TEM1==I

FLOATB:	PUSH	P,B
	PUSH	P,C
	PUSH	P,D
	PUSH	P,F
	PUSH	P,G
	PUSH	P,H
	PUSH	P,I
	PUSH	P,0
	PUSH	P,J
	MOVSI	0,440700	; BUILD BYTEPNTR
	HLRZ	J,A		; POINT TO BUFFER
	HRRI	0,1(J)
	ANDI	A,-1
	MOVE	A,(A)		; GET NUMBER
	MOVE	D,A
	SETZM	(J)		; Clear counter
	PUSHJ	P,NFLOT
	POP	P,J
	POP	P,0
	POP	P,I
	POP	P,H
	POP	P,G
	POP	P,F
	POP	P,D
	POP	P,C
	POP	P,B
	POPJ	P,

; at this point we enter code abstracted from DDT.
NFLOT:	JUMPG	A,TFL1
	JUMPE	A,FP1A
	MOVNS	A
	PUSH	P,A
	MOVEI	A,"-
	PUSHJ	P,CHRO
	POP	P,A
	TLZE	A,400000
	JRST	FP1A

TFL1:	MOVEI	B,0
TFLX:	CAMGE	A,FT01
	JRST	FP4
	CAML	A,FT8
	AOJA	B,FP4
FP1A:
FP3:	SETZB	C,TEM1		; CLEAR DIGIT CNTR, C TO RECEIVE FRACTION
	MULI	A,400
	ASHC	B,-243(A)
	MOVE	A,B
	PUSHJ	P,FP7
	PUSH	P,A
	MOVEI	A,".
	PUSHJ	P,CHRO
	POP	P,A
	MOVNI	A,10
	ADD	A,TEM1
	MOVE	E,C
FP3A:	MOVE	D,E
	MULI	D,12
	PUSHJ	P,FP7B
	SKIPE	E
	AOJL	A,FP3A
	POPJ	P,		; ONE return from OFLT here

FP4:	MOVNI	C,6
	MOVEI	F,0
FP4A:	ADDI	F,1(F)
	XCT	FCP(B)
	SOSA	F
	FMPR	A,@FXP+1(B)
	AOJN	C,FP4A
	PUSH	P,EXPSGN(B)
	PUSHJ	P,FP3
	PUSH	P,A
	MOVEI	A,"E
	PUSHJ	P,CHRO
	POP	P,A
	POP	P,D
	PUSHJ	P,FDIGIT
	MOVE	A,F

FP7:	SKIPE	A	; AVOID AOSING TEM1, NOT SIGNIFICANT DIGIT
	AOS	TEM1
	IDIVI	A,12
	PUSH	P,B
	JUMPE	A,FP7A1
	PUSHJ	P,FP7

FP7A1:	POP	P,D
FP7B:	ADDI	D,"0

; type digit
FDIGIT:	PUSH	P,A
	MOVE	A,D
	PUSHJ	P,CHRO
	POP	P,A
	POPJ	P,

CHRO:	AOS	(J)	; COUNT CHAR
	IDPB	A,0	; STUFF CHAR
	POPJ	P,

; constants
	1.0^32.
	1.0^16.
FT8:	1.0^8
	1.0^4
	1.0^2
	1.0^1
FT:	1.0^0
	1.0^-32.
	1.0^-16.
	1.0^-8
	1.0^-4
	1.0^-2
FT01:	1.0^-1
FT0=FT01+1

; instructions
FCP:	CAMLE	A, FT0(C)
	CAMGE	A, FT(C)
	0, FT0(C)
FXP:	SETZ FT0(C)
	SETZ FT(C)
	SETZ FT0(C)
EXPSGN:	"-
	"+


;PRINT SHORT (ONE WORD) CHARACTER STRINGS

PCHRS:	MOVEI	A,3	;MAX # CHARS PLUS 2 (LESS ESCAPES)
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	TLNE	FLAGS,NOQBIT	;SKIP IF QUOTES WILL BE USED
	MOVEI	A,1	;ELSE, JUST ONE CHARACTER POSSIBLE
	PUSHJ	P,RETIF	;NEW LINE IF INSUFFICIENT SPACE
	TLNE	FLAGS,NOQBIT	;DON'T QUOTE IF IN PRINC MODE
	JRST	PCASIS
	MOVEI	A,"!	;TYPE A EXCL
	PUSHJ	P,PITYO
	MOVEI	A,"\		;AND A BACK SLASH
	PUSHJ	P,PITYO

PCASIS:	MOVE	A,(TP)		;GET NEXT BYTE FROM WORD
	TLNE	FLAGS,NOQBIT	;SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
	JRST	PCPRNT		;IF BIT IS ON, PRINT WITHOUT ESCAPING
	CAIE	A,ESCHAR	;SKIP IF NOT THE ESCAPE CHARACTER
	JRST	PCPRNT		;ESCAPE THE ESCAPE CHARACTER

ESCPRT:	MOVEI	A,ESCHAR	;TYPE THE ESCAPE CHARACTER
	PUSHJ	P,PITYO	
PCPRNT:	MOVE	A,(TP)		;GET THE CHARACTER AGAIN
	TLNE	FLAGS,NOQBIT	;SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
	TLO	FLAGS,CNTLPC	;SWITCH ON ^P MODE TEMPORARY
	PUSHJ	P,PITYO		;PRINT IT
	TLZ	FLAGS,CNTLPC	;SWITCH OFF ^P MODE
	JRST	PNEXT


;PRINT DEFERED (INVISIBLE) ITEMS. (PRINTED AS THE THING POINTED TO)
;
PDEFER:	MOVE	A,(B)	;GET FIRST WORD OF ITEM
	MOVE	B,1(B)	;GET SECOND
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT	;PRINT IT
	SUB	TP,[2,,2]	; POP OFF CHANNEL
	JRST	PNEXT	;GO EXIT


; Print an ATOM.  TRAILERS are added if the atom is not in the current
; lexical path.  Also escaping of charactets is performed to allow READ
; to win.

PATOM:	PUSH	P,[440700,,D]	; PUSH BYE POINTER TO FINAL STRING
	SETZB	D,E		; SET CHARCOUNT AD DESTINATION TO 0
	HLLZS	-1(TP)		; RH OF TATOM,, WILL COUNT ATOMS IN PATH

PATOM0:	PUSH	TP,$TPDL	; SAVE CURRENT STAKC FOR \ LOGIC
	PUSH	TP,P
	LDB	A,[301400,,(P)]	; GET BYTE PTR POSITION
	DPB	A,[301400,,E]	; SAVE IN E
	MOVE	C,-2(TP)	; GET ATOM POINTER
	ADD	C,[3,,3]	; POINT TO PNAME
	JUMPGE	C,BADPNM	; NO PNAME, ERROR
	HLRE	A,C		; -# WORDS TO A
	PUSH	P,A		; PUSH THAT FOR "AOSE"
	MOVEI	A,177		; PUT RUBOUT WHERE \ MIGHT GO
	JSP	B,DOIDPB
	HRLI	C,440700	; BUILD BYTE POINTER
	ILDB	A,C		; GET FIRST BYTE
	JUMPE	A,BADPNM	; NULL PNAME, ERROR
	SKIPA
PATOM1:	ILDB	A,C		; GET A CHAR
	JUMPE	A,PATDON	; END OF PNAME?
	TLNN	C,760000	; SKIP IF NOT WORD BOUNDARY
	AOS	(P)		; COUNT WORD
	JRST	PENTCH		; ENTER THE CHAR INTO OUTPUT

PATDON:	LDB	A,[220600,,E]	; GET "STATE"
	LDB	A,STABYT+NONSPC+1	; SIMULATE "END" CHARACTER
	DPB	A,[220600,,E]	; AND STORE
	MOVE	B,E		; SETUP BYTE POINTER TO 1ST CHAR
	TLZ	B,77
	HRR	B,(TP)	; POINT
	SUB	TP,[2,,2]	; FLUSH SAVED PDL
	MOVE	C,-1(P)		; GET BYE POINTER
	SUB	P,[2,,2]	; FLUSH
	PUSH	P,D
	MOVEI	A,0
	IDPB	A,B
	AOS	-1(TP)		; COUNT ATOMS
	TLNE	FLAGS,NOQBIT	; SKIP IF NOT "PRINC"
	JRST	NOLEX4		; NEEDS NO LEXICAL TRAILERS
	MOVEI	A,"\		; GET QUOTER
	TLNN	E,2		; SKIP IF NEEDED
	JRST	PATDO1
	SOS	-1(TP)		; DONT COUNT BECAUSE OF SLASH
	DPB	A,B		; CLOBBER
PATDO1:	MOVEI	E,(E)		; CLEAR LH(E)
	PUSH	P,C		; SAVE BYTER
	PUSH	P,E		; ALSO CHAR COUNT

	MOVE	B,IMQUOTE OBLIST
	PUSH	P,FLAGS
	PUSHJ	P,IDVAL		; GET LOCAL/GLOBAL VALUE
	POP	P,FLAGS		; AND RESTORES FLAGS
	MOVE	C,(TP)		; GET ATOM BACK
	HRRZ	C,2(C)		; GET ITS OBLIST
	SKIPN	C
	AOJA	A,NOOBL1	; NONE, USE FALSE
	CAMG	C,VECBOT	; JUMP IF REAL OBLIST
	MOVE	C,(C)
	HRROS	C
	CAME	A,$TLIST	; SKIP IF  A LIST
	CAMN	A,$TOBLS	; SKIP IF UNREASONABLE VALUE
	JRST	CHOBL		; WINS, NOW LOCATE IT

CHROOT:	CAME	C,ROOT+1	; IS THIS ROOT?
	JRST	FNDOBL		; MUST FIND THE PATH NAME
	POP	P,E		; RESTORE CHAR COUNT
	MOVE	D,(P)		; AND PARTIAL WORD
	EXCH	D,-1(P)		; STORE BYTE POINTER AND GET PARTIAL WORD
	MOVEI	A,"!		; PUT OUT MAGIC
	JSP	B,DOIDPB	; INTO BUFFER
	MOVEI	A,"-	
	JSP	B,DOIDPB
	MOVEI	A,40
	JSP	B,DOIDPB

NOLEX0:	SUB	P,[2,,2]	; REMOVE COUNTER AND BYTE POINTER
	PUSH	P,D		; PUSH NEXT WORD IF ANY
	JRST	NOLEX4

NOLEX:	MOVE	E,(P)		; GET COUNT
	SUB	P,[2,,2]
NOLEX4:	MOVEI	E,(E)		; CLOBBER LH(E)
	MOVE	A,E		; COUNT TO A
	SKIPN	(P)		; FLUSH 0 WORD
	SUB	P,[1,,1]
	HRRZ	C,-1(TP)	; GET # OF ATOMS
	SUBI	A,(C)		; FIX COUNT
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,RETIF		; MAY NEED C.R.
	MOVEI	C,-1(E)		; COMPUTE WORDS-1
	IDIVI	C,5		; WORDS-1 TO C
	HRLI	C,(C)
	MOVE	D,P	
	SUB	D,C		; POINTS TO 1ST WORD OF CHARS
	MOVSI	C,440700+D	; BYTEPOINTER TO STRING
	PUSH	TP,$TPDL		; SAVE FROM GC
	PUSH	TP,D

PATOUT:	ILDB	A,C		; READ A CHAR
	SKIPE	A		; IGNORE NULS
	PUSHJ	P,PITYO		; PRINT IT
	MOVE	D,(TP)		; RESTORE POINTER
	SOJG	E,PATOUT

NOLEXD:	SUB	TP,[2,,2]	; FLUSH TP JUNK
	MOVE	P,D		; RESTORE P
	SUB	P,[1,,1]
	JRST	PNEXT


PENTCH:	TLNE	FLAGS,NOQBIT	; "PRINC"?
	JRST	PENTC1		; YES, AVOID SLASHING
	IDIVI	A,CHRWD	; GET CHARS TYPE
	LDB	B,BYTPNT(B)
	CAILE	B,NONSPC	; SKIP IF NOT SPECIAL
	JRST	PENTC2		; SLASH IMMEDIATE
	LDB	A,[220600,,E]	; GET "STATE"
	LDB	A,STABYT-1(B)	; GET NEW STATE
	DPB	A,[220600,,E]	; AND SAVE IT
PENTC3:	LDB	A,C		; RESTORE CHARACTER
PENTC1:	JSP	B,DOIDPB
	SKIPGE	(P)		; SKIP IF DONE
	JRST	PATOM1		; CONTINUE
	JRST	PATDON

PENTC2:	MOVEI	A,"\		; GET CHAR QUOTER
	JSP	B,DOIDPB	; NEEDED, DO IT
	MOVEI	A,4		; PATCH FOR ATOMS ALREADY BACKSLASHED
	JRST	PENTC3-1

; ROUTINE TO PUT ONE CHAR ON STACK BUFFER

DOIDPB:	IDPB	A,-1(P)		; DEPOSIT
	TRNN	D,377		; SKIP IF D FULL
	AOJA	E,(B)
	PUSH	P,(P)		; MOVE TOP OF STACK UP
	MOVEM	D,-2(P)		; SAVE WORDS
	MOVE	D,[440700,,D]
	MOVEM	D,-1(P)
	MOVEI	D,0
	AOJA	E,(B)

; CHECK FOR UNIQUENESS LOOKING INTO PATH

CHOBL:	CAME	A,$TOBLS	; SINGLE OBLIST?
	JRST	LSTOBL		; NO, AL LIST THEREOF
	CAME	B,C		; THE RIGTH ONE?
	JRST	CHROOT		; NO, CHECK ROOT
	JRST	NOLEX		; WINNER, NO TRAILERS!

LSTOBL:	PUSH	TP,A		; SCAN A LIST OF OBLISTS
	PUSH	TP,B
	PUSH	TP,A
	PUSH	TP,B
	PUSH	TP,$TOBLS
	PUSH	TP,C

NXTOB2:	INTGO			; LIST LOOP, PREVENT LOSSAGE
	SKIPN	C,-2(TP)		; SKIP IF NOT DONE
	JRST	CHROO1		; EMPTY, CHECK ROOT
	MOVE	B,1(C)		; GET ONE
	CAME	B,(TP)		; WINNER?
	JRST	NXTOBL		; NO KEEP LOOKING
	CAMN	C,-4(TP)	; SKIP IF NOT FIRST ON  LIST
	JRST	NOLEX1
	MOVE	A,-6(TP)	; GET ATOM BACK
	MOVEI	D,0
	ADD	A,[3,,3]	; POINT TO PNAME
	PUSH	P,0		; SAVE FROM RLOOKU
	PUSH	P,(A)
	ADDI	D,5
	AOBJN	A,.-2		; PUSH THE PNAME
	PUSH	P,D		; AND CHAR COUNT
	MOVSI	A,TLIST		; TELL RLOOKU WE WIN
	MOVE	B,-4(TP)	; GET BACK OBLIST LIST
	SUB	TP,[6,,6]	; FLUSH CRAP
	PUSHJ	P,RLOOKU	; FIND IT
	POP	P,0
	CAMN	B,(TP)		; SKIP IF NON UNIQUE
	JRST	NOLEX		; UNIQUE , NO TRAILER!!
	JRST	CHROO2		; CHECK ROOT

NXTOBL:	HRRZ	B,@-2(TP)	; STEP THE LIST
	MOVEM	B,-2(TP)
	JRST	NXTOB2


FNDOBL:	MOVE	C,(TP)		; GET ATOM
	MOVSI	A,TOBLS
	HRRZ	B,2(C)
	CAMG	B,VECBOT
	MOVE	B,(B)
	HRLI	B,-1
	MOVSI	C,TATOM
	MOVE	D,IMQUOTE OBLIST
	PUSH	P,0
	PUSHJ	P,IGET
	POP	P,0
NOOBL1:	POP	P,E		; RESTORE CHAR COUNT
	MOVE	D,(P)		; GET PARTIAL WORD
	EXCH	D,-1(P)		; AND BYTE POINTER
	CAME	A,$TATOM	; IF NOT ATOM, USE FALSE
	JRST	NOOBL
	MOVEM	B,(TP)		; STORE IN ATOM SLOT
	MOVEI	A,"!
	JSP	B,DOIDPB	; WRITE IT OUT
	MOVEI	A,"-
	JSP	B,DOIDPB
	SUB	P,[1,,1]
	JRST	PATOM0		; AND LOOP

NOOBL:	MOVE	C,[440700,,[ASCIZ /!-#FALSE ()/]]
	ILDB	A,C
	JUMPE	A,NOLEX0
	JSP	B,DOIDPB
	JRST	.-3


NOLEX1:	SUB	TP,[6,,6]	; FLUSH STUFF
	JRST	NOLEX

CHROO1:	SUB	TP,[6,,6]
CHROO2:	MOVE	C,(TP)		; GET ATOM
	HRRZ	C,2(C)		; AND ITS OBLIST
	CAMG	C,VECBOT
	MOVE	C,(C)
	HRROS	C
	JRST	CHROOT
BADPNM:	ERRUUO	EQUOTE BAD-PNAME


; STATE TABLES FOR \ OF FIRST CHAR
;	Each word is a state and each 4 bit byte tells where to go based on the input
; type.  The types are defined in READER >.  The input type selects a byte pointer
; into the table which is indexed by the current state.

RADIX 16.

STATS:	431192440		; INITIAL STATE (0)
	434444444		; HERE ON INIT +- (1)
	222222242		; HERE ON INIT . (2)
	434445642		; HERE ON INIT DIGIT (3)
	444444444		; HERE IF NO \ NEEDE (4)
	454444642		; HERE ON DDDD. (5)
	487744444		; HERE ON E (6)
	484444444		; HERE ON E+- (7)
	484444442		; HERE ON E+-DDD (8)
	494444444+<1_28.>	; HERE ON * (HACK IS TO GET A 10 IN THERE) (9)
	494494444+<1_28.>+<2_16.>	; HERE ON *DDDDD (10)
	444444442

RADIX 8.

STABYT:	400400,,STATS(A)	; LETTERS
	340400,,STATS(A)	; NUMBERS
	300400,,STATS(A)	; PLUS SIGN +
	240400,,STATS(A)	; MINUS SIGN -
	200400,,STATS(A)	; asterick *
	140400,,STATS(A)	; PERIOD .
	100400,,STATS(A)	; LETTER E
	040400,,STATS(A)	; extra
	000400,,STATS(A)	; HERE ON RAP UP

;PRINT LONG CHARACTER STRINGS.
;
PCHSTR:	MOVE	B,(TP)
	TLZ	FLAGS,ATMBIT	;WE ARE NOT USING ATOM-NAME TYPE ESCAPING
	MOVE	D,[AOS E]	;GET INSTRUCTION TO COUNT CHARACTERS
	SETZM	E		;ZERO COUNT
	PUSH	TP,-3(TP)
	PUSH	TP,-3(TP)
	PUSH	TP,-3(TP)
	PUSH	TP,-3(TP)	;GIVE PCHRST SOME GOODIES TO PLAY WITH
	PUSHJ	P,PCHRST	;GO THROUGH STRING, ESCAPING, ETC. AND COUNTING
	SUB	TP,[4,,4]	;FLUSH MUNGED GOODIES
	MOVE	A,E		;PUT COUNT RETURNED IN REG A
	TLNN	FLAGS,NOQBIT	;SKIP (NO QUOTES) IF IN PRINC (BIT ON)
	 ADDI	A,2		;PLUS TWO FOR QUOTES
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,RETIF		;START NEW LINE IF NO SPACE
	TLNE	FLAGS,NOQBIT	;SKIP (PRINT ") IF BIT IS OFF (NOT PRINC)
	 JRST	PCHS01		;OTHERWISE, DON'T QUOTE
	MOVEI	A,""		;PRINT A DOUBLE QUOTE
	MOVE	B,-2(TP)
	PUSHJ	P,PITYO

PCHS01:	MOVE	D,[PUSHJ P,PITYO] ;OUTPUT INSTRUCTION
	PUSHJ	P,PCHRST	;TYPE STRING

	TLNE	FLAGS,NOQBIT	;AGAIN, SKIP IF DOUBLE-QUOTING TO BE DONE
	 JRST	PNEXT		;RESTORE REGS & POP UP ONE LEVEL TO CALLER
	MOVEI	A,""		;PRINT A DOUBLE QUOTE
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,PITYO
	JRST	PNEXT


;INTERNAL ROUTINE USED TO COUNT OR OUTPUT CHARACTER STRINGS.
;THE APPROPRIATE ESCAPING CONVENTIONS ARE USED AS DETERMINED BY THE FLAG BITS.
PCHRST:	PUSH	P,A	;SAVE REGS
	PUSH	P,B
	PUSH	P,C
	PUSH	P,D

PCHR02:	INTGO			; IN CASE VERY LONG STRING
	HRRZ	C,-1(TP)	;GET COUNT
	SOJL	C,PCSOUT	; DONE?
	HRRM	C,-1(TP)
	ILDB	A,(TP)		; GET CHAR

	TLNE	FLAGS,NOQBIT	;SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
	JRST	PCSPRT	;IF BIT IS ON, PRINT WITHOUT ESCAPING
	CAIN	A,ESCHAR	;SKIP IF NOT THE ESCAPE CHARACTER
	JRST	ESCPRN	;ESCAPE THE ESCAPE CHARACTER
	CAIN	A,""	;SKIP IF NOT A DOUBLE QUOTE
	JRST	ESCPRN	;OTHERWISE, ESCAPE THE """
	IDIVI	A,CHRWD	;CODE HERE FINDS CHARACTER TYPE
	LDB	B,BYTPNT(B)	; "
	CAIG	B,NONSPC	;SKIP IF NOT A NUMBER/LETTER
	JRST	PCSPRT	;OTHERWISE, PRINT IT
	TLNN	FLAGS,ATMBIT	;SKIP IF PRINTING AN ATOM-NAME (UNQUOTED)
	JRST	PCSPRT	;OTHERWISE, NO OTHER CHARS TO ESCAPE

ESCPRN:	MOVEI	A,ESCHAR	;TYPE THE ESCAPE CHARACTER
	PUSH	P,B		; SAVE B
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	XCT	(P)-1	
	POP	P,B		; RESTORE B

PCSPRT:	LDB	A,(TP)	;GET THE CHARACTER AGAIN
	PUSH	P,B		; SAVE B
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	TLNE	FLAGS,NOQBIT	; SKIP IF WE ARE NOT IN PRINC MODE (NOQBIT=0)
	TLO	FLAGS,CNTLPC	; SWITCH ON TEMPORARY ^P MODE
	XCT	(P)-1		;PRINT IT
	TLZ	FLAGS,CNTLPC	; SWITCH OFF ^P MODE
	POP	P,B		; RESTORE B
	JRST	PCHR02		;LOOP THROUGH STRING

PCSOUT:	POP	P,D
	POP	P,C	;RESTORE REGS & RETURN
	POP	P,B
	POP	P,A
	POPJ	P,



; PRINT AN ARBITRARY BYTE STRING

PBYTE:	PUSH	TP,-3(TP)
	PUSH	TP,-3(TP)
	MOVEI	A,"#
	MOVE	B,(TP)
	PUSHJ	P,PRETIF
	LDB	B,[300600,,-2(TP)]
	MOVSI	A,TFIX
	PUSHJ	P,IPRINT
	MOVE	B,(TP)
	PUSHJ	P,SPACEQ
	MOVEI	A,"{
	MOVE	B,(TP)
	PUSHJ	P,PRETIF
	HRRZ	A,-3(TP)		; CHAR COUNT
	JUMPE	A,CLSBYT

BYTLP:	SOS	-3(TP)
	ILDB	B,-2(TP)		; GET A BYTE
	MOVSI	A,TFIX
	PUSHJ	P,IPRINT
	HRRZ	A,-3(TP)
	JUMPE	A,CLSBYT
	MOVE	B,(TP)
	PUSHJ	P,SPACEQ
	JRST	BYTLP

CLSBYT:	MOVEI	A,"}
	MOVE	B,(TP)
	PUSHJ	P,PRETIF
	SUB	TP,[2,,2]
	JRST	PNEXT


;PRINT AN ARGUMENT LIST
;CHECK FOR TIME ERRORS

PARGS:	MOVEI	B,-1(TP)	;POINT TO ARGS POINTER
	PUSHJ	P,CHARGS	;AND CHECK THEM
	JRST	PVEC		; CHEAT TEMPORARILY



;PRINT A FRAME
PFRAME:	MOVEI	B,-1(TP)	;POINT TO FRAME POINTER
	PUSHJ	P,CHFRM
	HRRZ	B,(TP)		;POINT TO FRAME ITSELF
	HRRZ	B,FSAV(B)	;GET POINTER TO SUBROUTINE
	CAIL	B,HIBOT
	SKIPA	B,@-1(B)	; SUBRS AND FSUBRS
	MOVE	B,3(B)		; FOR RSUBRS
	MOVSI	A,TATOM
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT	;PRINT FUNCTION NAME
	SUB	TP,[2,,2]	; POP CHANNEL OFF STACK
	JRST	PNEXT

PPVP:	MOVE	B,(TP)		; PROCESS TO B
	MOVSI	A,TFIX
	JUMPE	B,.+3
	MOVE	A,PROCID(B)
	MOVE	B,PROCID+1(B)	;GET ID
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]	; POP CHANNEL OFF STACK
	JRST	PNEXT

; HERE TO PRINT LOCATIVES

LOCPT1:	HRRZ	A,-1(TP)
	JUMPN	A,PUNK
LOCPT:	MOVEI	B,-1(TP)	; VALIDITY CHECK
	PUSHJ	P,CHLOCI
	HRRZ	A,-1(TP)
	JUMPE	A,GLOCPT
	MOVE	B,(TP)
	MOVE	A,(B)
	MOVE	B,1(B)
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]	; POP CHANNEL OFF STACK
	JRST	PNEXT

GLOCPT:	MOVEI	A,2
	MOVE	B,-2(TP)		; GET CHANNEL
	PUSHJ	P,RETIF
	MOVEI	A,"%
	PUSHJ	P,PITYO
	MOVEI	A,"<
	PUSHJ	P,PITYO
	MOVSI	A,TATOM
	MOVE	B,MQUOTE GLOC
	PUSH	TP,-3(TP)
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]
	MOVE	B,-2(TP)		; MOVE IN CHANNEL
	PUSHJ	P,SPACEQ
	MOVE	B,(TP)
	MOVSI	A,TATOM
	MOVE	B,-1(B)
	PUSH	TP,-3(TP)
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]
	MOVE	B,-2(TP)		; MOVE IN CHANNEL
	PUSHJ	P,SPACEQ
	MOVSI	A,TATOM
	MOVE	B,IMQUOTE T
	PUSH	TP,-3(TP)
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]
	MOVE	B,-2(TP)		; MOVE IN CHANNEL
	MOVEI	A,">
	PUSHJ	P,PRETIF
	JRST	PNEXT

LOCRPT:	MOVEI	A,2
	MOVE	B,-2(TP)		; GET CHANNEL
	PUSHJ	P,RETIF
	MOVEI	A,"%
	PUSHJ	P,PITYO
	MOVEI	A,"<
	PUSHJ	P,PITYO
	MOVSI	A,TATOM
	MOVE	B,MQUOTE RGLOC
	PUSH	TP,-3(TP)
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]
	MOVE	B,-2(TP)		; MOVE IN CHANNEL
	PUSHJ	P,SPACEQ
	MOVE	B,(TP)
	MOVSI	A,TATOM
	ADD	B,GLOTOP+1		; GET TO REAL ATOM
	MOVE	B,-1(B)
	PUSH	TP,-3(TP)
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]
	MOVE	B,-2(TP)		; MOVE IN CHANNEL
	PUSHJ	P,SPACEQ
	MOVSI	A,TATOM
	MOVE	B,IMQUOTE T
	PUSH	TP,-3(TP)
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]
	MOVE	B,-2(TP)		; MOVE IN CHANNEL
	MOVEI	A,">
	PUSHJ	P,PRETIF
	JRST	PNEXT

;PRINT UNIFORM VECTORS.
;
PUVEC:	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	MOVEI	A,2		; ROOM FOR ! AND SQ BRACK?
	PUSHJ	P,RETIF
	MOVEI	A,"!	;TYPE AN ! AND OPEN SQUARE BRACKET
	PUSHJ	P,PITYO
	MOVEI	A,"[
	PUSHJ	P,PITYO

	MOVE	C,(TP)	;GET AOBJN POINTER TO VECTOR
	TLNN	C,777777	;SKIP ONLY IF COUNT IS NOT ZERO
	JRST	NULVEC	;ELSE, VECTOR IS EMPTY

	HLRE	A,C	;GET NEG COUNT
	MOVEI	D,(C)	;COPY POINTER
	SUB	D,A	;POINT TO DOPE WORD
	HLLZ	A,(D)	;GET TYPE
	PUSH	P,A	;AND SAVE IT

PUVE02:	MOVE	A,(P)	;PUT TYPE CODE IN REG A
	MOVE	B,(C)	;PUT DATUM INTO REG B
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT	;TYPE IT
	SUB	TP,[2,,2]	; POP CHANNEL OF STACK
	MOVE	C,(TP)	;GET AOBJN POINTER
	AOBJP	C,NULVE1	;JUMP IF COUNT IS ZERO
	MOVEM	C,(TP)	;PUT POINTER BACK ONTO STACK

	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,SPACEQ
	MOVE	C,(TP)
	JRST	PUVE02	;LOOP THROUGH VECTOR

NULVE1:	SUB	P,[1,,1]	;REMOVE STACK CRAP
NULVEC:	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	MOVEI	A,"!	;TYPE CLOSE BRACKET
	PUSHJ	P,PRETIF
	MOVEI	A,"]
	PUSHJ	P,PRETIF
	JRST	PNEXT

;PRINT A GENERALIZED VECTOR
;
PVEC:	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,RETIF1	;NEW LINE IF NO ROOM FOR [
	MOVEI	A,"[		;PRINT A LEFT-BRACKET
	PUSHJ	P,PITYO

	MOVE	C,(TP)		;GET AOBJN POINTER TO VECTOR
	TLNN	C,777777	;SKIP IF POINTER-COUNT IS NON-ZERO
	JRST	PVCEND		;ELSE, FINISHED WITH VECTOR
PVCR01:	MOVE	A,(C)		;PUT FIRST WORD OF NEXT ELEMENT INTO REG A
	MOVE	B,1(C)		;SECOND WORD OF LIST INTO REG B
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT	;PRINT THAT ELEMENT
	SUB	TP,[2,,2]	; POP CHANNEL OFF STACK

	MOVE	C,(TP)		;GET AOBJN POINTER FROM TP-STACK
	AOBJP	C,PVCEND	;POSITIVE HERE SERIOUS ERROR! (THOUGH NOT PDL)
	AOBJN	C,.+2		;SKIP AND CONTINUE LOOP IF COUNT NOT ZERO
	JRST	PVCEND		;ELSE, FINISHED WITH VECTOR
	MOVEM	C,(TP)		;PUT INCREMENTED POINTER BACK ON TP-STACK

	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,SPACEQ
	MOVE	C,(TP)		; RESTORE REGISTER C
	JRST	PVCR01		;CONTINUE LOOPING THROUGH OBJECTS ON VECTOR

PVCEND:	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,RETIF1	;NEW LINE IF NO ROOM FOR ]
	MOVEI	A,"]		; PRINT A RIGHT-BRACKET
	PUSHJ	P,PITYO
	JRST	PNEXT

;PRINT A LIST.
;
PLIST:	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,RETIF1	;NEW LINE IF NO SPACE LEFT FOR "("
	MOVEI	A,"(		;TYPE AN OPEN PAREN
	PUSHJ	P,PITYO
	PUSHJ	P,LSTPRT	;PRINT THE INSIDES
	MOVE	B,-2(TP)		; RESTORE CHANNEL TO B
	PUSHJ	P,RETIF1	;NEW LINE IF NO ROOM FOR THE CLOSE PAREN
	MOVEI	A,")	;TYPE A CLOSE PAREN
	PUSHJ	P,PITYO
	JRST	PNEXT

PSEG:	TLOA	FLAGS,SEGBIT	;PRINT A SEGMENT (& SKIP)

PFORM:	TLZ	FLAGS,SEGBIT	;PRINT AN ELEMENT

PLMNT3:	MOVE	C,(TP)
	JUMPE	C,PLMNT1	;IF THE CALL IS EMPTY GO AWAY
	MOVE	B,1(C)
	MOVEI	D,0
	CAMN	B,IMQUOTE LVAL
	MOVEI	D,".
	CAMN	B,IMQUOTE GVAL
	MOVEI	D,",
	CAMN	B,IMQUOTE QUOTE
	MOVEI	D,"'
	JUMPE	D,PLMNT1		;NEITHER, LEAVE

;ITS A SPECIAL HACK
	HRRZ	C,(C)
	JUMPE	C,PLMNT1	;NIL BODY?

;ITS VALUE OF AN ATOM
	HLLZ	A,(C)
	MOVE	B,1(C)
	HRRZ	C,(C)
	JUMPN	C,PLMNT1	;IF TERE ARE EXTRA ARGS GO AWAY

	PUSH	P,D		;PUSH THE CHAR
	PUSH	TP,A
	PUSH	TP,B
	TLNN	FLAGS,SEGBIT	;SKIP (CONTINUE) IF THIS IS A SEGMENT
	JRST	PLMNT4	;ELSE DON'T PRINT THE "."

;ITS A SEGMENT CALL
	MOVE	B,-4(TP)	; GET CHANNEL INTO B
	MOVEI	A,2		; ROOM FOR ! AND . OR ,
	PUSHJ	P,RETIF
	MOVEI	A,"!
	PUSHJ	P,PITYO

PLMNT4:	MOVE	B,-4(TP)		; GET CHANNEL INTO B
	PUSHJ	P,RETIF1
	POP	P,A		;RESTORE CHAR
	PUSHJ	P,PITYO
	POP	TP,B
	POP	TP,A
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]	; POP CHANNEL OFF STACK
	JRST	PNEXT


PLMNT1:	TLNN	FLAGS,SEGBIT	;SKIP IF THIS IS A SEGMENT
	JRST	PLMNT5	;ELSE DON'T TYPE THE "!"

;ITS A SEGMENT CALL
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	MOVEI	A,2		; ROOM FOR ! AND <
	PUSHJ	P,RETIF
	MOVEI	A,"!
	PUSHJ	P,PITYO

PLMNT5:	MOVE	B,-2(TP)	; GET CHANNEL FOR B
	PUSHJ	P,RETIF1	
	MOVEI	A,"<
	PUSHJ	P,PITYO
	PUSHJ	P,LSTPRT
	MOVEI	A,"!
	MOVE	B,-2(TP)		; GET CHANNEL INTO B
	TLNE	FLAGS,SEGBIT	;SKIP IF NOT SEGEMNT
	PUSHJ	P,PRETIF
	MOVEI	A,">
	PUSHJ	P,PRETIF
	JRST	PNEXT



LSTPRT:	SKIPN	C,(TP)
	POPJ	P,
	HLLZ	A,(C)	;GET NEXT ELEMENT
	MOVE	B,1(C)
	HRRZ	C,(C)	;CHOP THE LIST
	JUMPN	C,PLIST1
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT	;PRINT THE LAST ELEMENT
	SUB	TP,[2,,2]	; POP CHANNEL OFF STACK
	POPJ	P,

PLIST1:	MOVEM	C,(TP)
	PUSH	TP,-3(TP)	; GET CHANNEL FOR IPRINT
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT	;PRINT THE NEXT ELEMENT
	SUB	TP,[2,,2]	; POP CHANNEL OFF STACK
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,SPACEQ
	JRST	LSTPRT	;REPEAT

PNEXT:	POP	P,FLAGS	;RESTORE PREVIOUS FLAG BITS
	SUB	TP,[2,,2]	;REMOVE	INPUT ELEMENT FROM TP-STACK
	POP	P,C	;RESTORE REG C
	POPJ	P,

OPENIT:	PUSH	P,A
	PUSH	P,B
	PUSH	P,C
	PUSH	P,D
	PUSH	P,FLAGS
	PUSHJ	P,OPNCHN
	POP	P,FLAGS
	POP	P,D
	POP	P,C
	POP	P,B
	POP	P,A
	JUMPGE	B,FNFFL		;ERROR IF IT CANNOT BE OPENED
	HRRZ	E,-2(B)
	POPJ	P,


END