TITLE	PRINTER ROUTINE FOR MUDDLE

RELOCATABLE

.INSRT DSK:MUDDLE >

.GLOBAL	IPNAME,MTYO,FLOATB,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,MPOPJ,SSPEC1
.GLOBAL CIPRIN,CIPRNC,CIPRN1,CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR
.GLOBAL CIFLTZ,CITERP,CIUPRS,CPCH

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
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,


MFUNCTION	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
	JRST	PRIN01	;CALL IPRINT AFTER SAVING STUFF


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


CITERP:	SUBM	M,(P)
	MOVSI	0,TERBIT+SPCBIT	; SET UP FLAGS
	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
	MOVSI	A,TFALSE	; RETURN A FALSE
	MOVEI	B,0
	JRST	MPOPJ		; RETURN


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,-4(B)		; GET IN FLAGS FROM CHANNEL
	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
	PUSH	TP,$TFIX	; MOVE IN ARGUMENT FOR ISTRING
	PUSH	TP,B
	MCALL	1,ISTRING
	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
	MOVE	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.
CPCH:	SUBM	M,(P)
	MOVSI	FLAGS,NOQBIT
	MOVE	C,$TCHRS
	PUSHJ	P,TESTR		; SEE IF CHANNEL IS GOOD
	PUSH	P,D
	MOVE	A,D		; MOVE IN CHARACTER FOR PITYO
	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
	JRST	PATOM

CPCHST:	PUSH	TP,A		; COPY ARGS FOR INTERNAL SAKE
	PUSH	TP,B
	PUSH	P,0		; STRING CALLER ROUTINE
	PUSH	P,C
	JRST	PCHSTR



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,440700
	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(TVP)	; USER TYPE TABLE?
	JRST	PRDISP
NORMAL:	CAIG	A,NUMPRI	;PRIMITIVE?
	JRST	@PRTYPE(A)	;YES-DISPATCH
	JRST	PUNK	;JUMP TO ERROR ROUTINE IF CODE TOO GREAT

; 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:	PUSH	P,C		; SAVE 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
	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

DISTBL	PRTYPE,PUNK,[[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]]

PUNK:	MOVE	C,TYPVEC+1(TVP)	; 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
	PUSHJ	P,RETIF1	; START NEW LINE IF NO ROOM
	MOVEI	A,"#		; INDICATE TYPE-NAME FOLLOWS
	PUSHJ	P,PITYO
	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
	CAIG	A,NUMSAT	; SKIP IF TEMPLATE
	JRST	@UKTBL(A)	; USE DISPATCH TABLE ON STORAGE TYPE
	JRST	TMPRNT		; PRINT TEMPLATED DATA STRUCTURE

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]]

	; 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	PNEXT
	MOVE	A,INAME(B)	; GET NAME
	MOVE	B,INAME+1(B)
	PUSHJ	P,IPRINT
	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
	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(TVP)
	JUMPL	A,PTYPX1	; JUMP FOR A WINNER
	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE BAD-TYPE-CODE
	JRST	CALER1

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,@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

; PRINT PURE CODE POINTER

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(TVP)	; 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
	MOVSI	A,TATOM		; UNLINK
	HLLM	A,(B)
	MOVE	A,1(B)
	MOVE	A,3(A)
	MOVEM	A,1(B)
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,MQUOTE 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
	MOVSI	A,TVEC
	MOVE	B,-2(TP)
	PUSHJ	P,IPRINT
	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
	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE BAD-ENTRY-BLOCK
	JRST	CALER1

; 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(TVP)	; 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,MQUOTE 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
	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)
	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)
	PUSHJ	P,ATOSQ		; GET SQUOZE
	JRST	BADFXU
	TLO	E,400000	; USE TO DIFFERENTIATE BETWEEN STRING
	PUSHJ	P,EOUT

; 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

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
	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,C		; CONTINUE SETTING UP BTB
	POP	C,@D		; MOVE 'EM DOWN
	TLNE	C,-1
	JRST	.-2
	HRRI	A,@D		; OUTPUT POINTER
	ADDI	A,1
	MOVSI	B,TUVEC
	MOVEM	B,ASTO(PVP)
	MOVE	B,-6(TP)
	PUSHJ	P,DOIOTO	; WRITE IT OUT
	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
	MOVEM	0,ASTO(PVP)
	MOVSI	0,TLIST
	MOVEM	0,DSTO(PVP)
	MOVEM	0,CSTO(PVP)
	PUSHJ	P,DOIOTO	; OUT IT GOES
	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
	MOVEM	C,ASTO(PVP)
	PUSHJ	P,DOIOTO	; GO
	SETZM	ASTO(PVP)
	SUB	P,[1,,1]
	SUB	TP,[4,,4]
	JRST	PNEXT

RCANT:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE RSUBR-LACKS-FIXUPS
	JRST	CALER1


BADFXU:	PUSH	TP,$TATOM
	PUSH	TP,EQUOTE BAD-FIXUPS
	JRST	CALER1

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
	CAIN	0,TENTER
	JRST	.+3		; JUMP IF RSUBR ENTRY
	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
	MOVEM	0,1(C)
	MOVSI	A,TATOM
	MOVEM	A,(C)		; UNLINK

PRSBR4:	MOVE	FLAGS,(P)	; RESTORE FLAGS
	MOVE	B,(TP)
	MOVE	A,(B)
	MOVE	B,1(B)		; PRINT IT
	PUSH	TP,-7(TP)	; PUSH CHANNEL FOR IPRINT
	PUSH	TP,-7(TP)
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]	; POP OFF 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	C,@-1(C)	; NAME OF IT
	MOVEM	C,1(B)		; SMASH
	MOVSI	C,TATOM		; AND TYPE
	MOVEM	C,(B)
	JRST	PRSBR4

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,MQUOTE 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,MQUOTE 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 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
PITYO3:	MOVEI	C,(TB)
	CAILE	C,1(TP)
	JRST	PITYO2
	POP	P,0		; RESTORE FLAGS
	MOVSI	A,TFALSE	;IN WHICH CASE IT IMMEDIATELY GIVES UP AND RETURNS FALSE
	MOVEI	B,0
	POPJ	P,

PITYO2:	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
ITYOCH:	PUSH	P,A		;SAVE OUTPUT CHARACTER


ITYO1:	TLNE	FLAGS,UNPRSE	;SKIPS UNPRSE NOT SET
	JRST	UNPROUT		;IF FROM UNPRSE, STASH IN STRING
	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,WXCT		;OUTPUT THE C-R
	PUSHJ	P,AOSACC	; BUMP COUNT
	AOS	C,LINPOS(B)	;ADD ONE TO THE LINE NUMBER
	CAMG	C,PAGLN(B)	;SKIP IF THIS TAKES US PAST PAGE END
	JRST	ITYXT1

	SETZM	LINPOS(B)	;ZERO THE LINE POSITION
;	PUSHJ	P,WXCT		; REMOVED FOR NOW
;	PUSHJ	P,AOSACC
;	MOVEI	A,^L		; DITTO
	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
	AOS	CHRPOS(B)	;ADD TO CHARACTER NUMBER

ITYXT:	PUSHJ	P,AOSACC	; BUMP ACCESS
ITYXTA:	PUSHJ	P,WXCT		;OUTPUT THE CHARACTER
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,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
	HRLM	D,(P)		; SAVE REMAINDER
	SKIPE	C
	PUSHJ	P,FIXTYO
	HLRZ	A,(P)		; 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
	MOVEI	E,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
	MOVE	A,C	;MAKE SURE THAT # WILL FIT ON PRINT LINE
PFLT1:	PUSH	P,B		; SAVE B
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,RETIF	;START NEW LINE IF IT WON'T
	POP	P,B		; RESTORE B

	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

					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
;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 DOUBLE QUOTE
	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
	PUSHJ	P,PITYO	;PRINT IT
	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
	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 BYET POINTER

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+6	; 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
	SKIPN	C,2(C)		; GET ITS OBLIST
	AOJA	A,NOOBL1	; NONE, USE FALSE
	JUMPL	C,.+3		; JUMP IF REAL OBLIST
	ADDI	C,(TVP)		; ELSE MUST BE OFFSET
	MOVE	C,(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(TVP)	; 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)
	CAIL	B,6		; 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
	MOVE	B,2(C)
	JUMPL	B,.+3
	ADDI	B,(TVP)
	MOVE	B,(B)
	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
	SKIPGE	C,2(C)		; AND ITS OBLIST
	JRST	CHROOT
	ADDI	C,(TVP)
	MOVE	C,(C)
	JRST	CHROOT


; STATE TABLES FOR \ OF FIRST CHAR

RADIX 16.

STATS:	431244000
	434444400
	222224200
	434564200
	444444400
	454564200
	487444200
	484444400
	484444200

RADIX 8.

STABYT:	400400,,STATS(A)
	340400,,STATS(A)
	300400,,STATS(A)
	240400,,STATS(A)
	200400,,STATS(A)
	140400,,STATS(A)
	100400,,STATS(A)

;PRINT LONG CHARACTER STRINGS.
;
PCHSTR:	MOVE	B,(TP)
	TLZ	FLAGS,ATMBIT	;WE ARE NOT USING ATOM-NAME TYPE ESCAPING
	PUSH	P,-1(TP)	; PUSH CHAR COUNT
	MOVE	D,[AOS E]	;GET INSTRUCTION TO COUNT CHARACTERS
	SETZM	E	;ZERO COUNT
	PUSHJ	P,PCHRST	;GO THROUGH STRING, ESCAPING, ETC. AND COUNTING
	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
	PUSH	P,B		; SAVE B
	MOVE	B,-2(TP)	; GET CHANNEL INTO B
	PUSHJ	P,RETIF	;START NEW LINE IF NO SPACE
	POP	P,B		; RESTORE B
	TLNE	FLAGS,NOQBIT	;SKIP (PRINT ") IF BIT IS OFF (NOT PRINC)
	JRST	PCHS01	;OTHERWISE, DON'T QUOTE
	MOVEI	A,""	;PRINT A DOUBLE QUOTE
	PUSH	P,B		; SAVE B
	MOVE B,-2(TP)
	PUSHJ	P,PITYO
	POP	P,B		; RESTORE B

PCHS01:	MOVE	D,[PUSHJ P,PITYO]	;OUTPUT INSTRUCTION
	MOVEM	B,(TP)	;RESET BYTE POINTER
	POP	P,-1(TP)	; RESET CHAR COUNT
	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
	PUSH	P,B		; SAVE B
	MOVE	B,-2(TP)	; GET CHANNEL
	PUSHJ	P,PITYO
	POP	P,B		;RESTORE B
	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)	; "
	CAIGE	B,6	;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
	XCT	(P)-1	;PRINT IT
	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 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
	CAMGE	B,VECTOP
	CAMGE	B,VECBOT
	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]
	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]
	PUSHJ	P,SPACEQ
	MOVSI	A,TATOM
	MOVE	B,MQUOTE T
	PUSH	TP,-3(TP)
	PUSH	TP,-3(TP)
	PUSHJ	P,IPRINT
	SUB	TP,[2,,2]
	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
	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
	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,MQUOTE LVAL
	MOVEI	D,".
	CAMN	B,MQUOTE GVAL
	MOVEI	D,",
	CAMN	B,MQUOTE 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,E
	PUSH	P,FLAGS
	PUSHJ	P,OPNCHN
	POP	P,FLAGS
	POP	P,E
	JUMPGE	B,FNFFL	;ERROR IF IT CANNOT BE OPENED
	POPJ	P,


END