TITLE	PRINTER ROUTINE FOR MUDDLE
RELOCATABLE
.INSRT DSK:MUDDLE >
.GLOBAL	IPNAME,TYO,FIXB,FLOATB
.GLOBAL BYTPNT,OPNCHN,CHRWRD,IDVAL,CHARGS,CHFRM,NONSPC

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

P.STUF:	0

PSYM:
	EXCH A,P.STUFF
	.VALUE [ASCIZ .=P.STUF!QîP.STUF/Q!:VP ]
	PUSH TP, (A)
	PUSH TP, 1(A)
	MCALL 1,PRINT
	EXCH A,P.STUFF
	POPJ P,

P.=PUSHJ P, PSYM

MFUNCTION	FLATSIZE,SUBR
	DEFINE FLTMAX
		2(AB)TERMIN
	DEFINE FLTSIZ
		0(TB)TERMIN
;FLATSIZE TAKES TWO ARGUMENTS: THE FIRST IS AN OBJECT THE SECOND
;IS THE MAXIMUM SIZE BEFORE IT GIVES UP AN RETURNS FALSE
	ENTRY	2
	HLRZ	A,2(AB)
	CAIN	A,TFIX
	JRST	FLAT1
;IF THE SECOND ARGUMENT IS NOT FIXED POINT LOSE
	PUSH	TP,$TATOM
	PUSH	TP,MQUOTE WRONG-TYPE
	JRST	CALER1

FLAT1:	PUSH	TP,$TFIX
	PUSH	TP,[0]	;THE VALUE IS ACCUMULATED IN FLTSIZ
	PUSH	P,FLAGS
	MOVSI	FLAGS,FLTBIT
	MOVE	A,(AB)	;IPRINT TAKES ITS ARGUMENT A AND B
	MOVE	B,1(AB)
	PUSHJ	P,IPRINT
	MOVE	A,FLTSIZ
	MOVE	B,FLTSIZ+1
	JRST	FINIS

MFUNCTION	PHASH,SUBR
	DEFINE HSHMAX
		2(AB)TERMIN
	DEFINE HSHNUM
		0(TB)TERMIN
;PHASH TAKES TWO ARGUMENTS: THE FIRST IS AN OBJECT THE SECOND
;IS THE MAXIMUM SIZE BEFORE IT GIVES UP AN RETURNS THE HASH NUMBER
	ENTRY	2
	HLRZ	A,2(AB)
	CAIN	A,TFIX
	JRST	HASH1
;IF THE SECOND ARGUMENT IS NOT FIXED POINT LOSE
	PUSH	TP,$TATOM
	PUSH	TP,MQUOTE WRONG-TYPE
	JRST	CALER1

HASH1:	PUSH	TP,$TFIX
	PUSH	TP,[0]	;THE VALUE IS ACCUMULATED IN HASHNUM
	PUSH	P,FLAGS
	MOVSI	FLAGS,HSHBIT
	MOVE	A,(AB)	;IPRINT TAKES ITS ARGUMENT A AND B
	MOVE	B,1(AB)
	PUSHJ	P,IPRINT
	MOVE	A,HSHNUM
	MOVE	B,HSHNUM+1
	JRST	FINIS

MFUNCTION	PRINT,SUBR
	ENTRY	
	PUSH	P,FLAGS	;SAVE THE FLAGS REGISTER
	MOVSI	FLAGS,SPCBIT	;INDICATE PRINTING OF SPACE WHEN DONE
	JRST	PRIN01	;CALL IPRINT AFTER SAVING STUFF

MFUNCTION	PRINC,SUBR
	ENTRY	
	PUSH	P,FLAGS	;SAVE THE FLAGS REGISTER
	MOVSI	FLAGS,NOQBIT	;INDICATE PRINC (NO QUOTES OR ESCAPES)
	JRST	PRIN01	;CALL IPRINT AFTER SAVING STUFF

MFUNCTION	PRIN1,SUBR
	ENTRY	
	PUSH	P,FLAGS	;SAVE FLAGS REGISTER
	MOVEI	FLAGS,0	;ZERO (TURN OFF) ALL FLAGS
	JRST	PRIN01	;CALL IPRINT AFTER SAVING STUFF


MFUNCTION	TERPRI,SUBR
	ENTRY
	MOVSI	FLAGS,TERBIT+SPCBIT
	JUMPGE	AB,DEFCHN	;IF NO ARG GO GET CURRENT OUT-CHANNEL BINDING
	CAMG	AB,[-2,,0]
	JRST	WNA
	PUSH	TP,$TFIX	;SAVE ROOM ON STACK FOR ONE CHANNEL
	PUSH	TP,[0]
	MOVE	A,(AB)
	MOVE	B,(AB)+1
	JRST	COMPT

PRIN01:	PUSH	P,C	;SAVE REGISTERS C,D, AND E
	PUSH	P,D
	PUSH	P,E
	PUSH	TP,$TFIX	;LEAVE ROOM ON STACK FOR ONE CHANNEL
	PUSH	TP,[0]

	HLRZ	C,AB	;GET THE AOBJN COUNT FROM AB
	CAIN	C,-2	;SKIP IF NOT JUST ONE ARGUMENT GIVEN
	JRST	DEFCHN	;ELSE USE EXISTING BINDING OF "OUTCHAN"
	CAIE	C,-4	;ELSE, THERE MUST BE ONLY TWO ARGUMENTS
	JRST	ARGERR	;MORE ARGUMENTS IS AN ERROR
	MOVE	A,(AB)+2
	MOVE	B,(AB)+3
COMPT:	CAME	A,$TLIST
	JRST	BINDPT
	SKIPN	C,(AB)3	;EMPTY LIST ?
	JRST	FINIS	;IF SO, NO NEED TO CONTINUE
LISTCK:	HRRZ	C,(C)	;REST OF LIST
	JUMPE	C,BINDPT	;FINISHED ?
	PUSH	TP,$TFIX	;LEAVE ROOM ON STACK FOR THIS ADDITIONAL CHANNEL
	PUSH	TP,[0]
	JRST	LISTCK

BINDPT:	PUSH	TP,[TATOM,,-1]
	PUSH	TP,MQUOTE OUTCHAN
	PUSH	TP,A	;PUSH NEW OUT-CHANNEL
	PUSH	TP,B
	PUSH	TP,[0]
	PUSH	TP,[0]
	PUSH	P,FLAGS	;THESE WILL GET CLOBBERED BY SPECBIND
	PUSHJ	P,SPECBIND
	POP	P,FLAGS

DEFCHN:	MOVE	B,MQUOTE OUTCHAN
	MOVSI	A,TATOM
	PUSHJ	P,IDVAL	;GET VALUE OF CHANNEL
	SETZ	E,	;CLEAR E FOR SINGLE CHANNEL ARGUMENTS
	CAMN	A,$TCHAN	;SKIP IF IT ISN'T A VALID SINGLE CHANNEL
	JRST	SAVECH
	CAME	A,$TLIST	;SKIP IF IT IS A LIST OF CHANNELS
	JRST	CHNERR	;CAN'T HANDLE ANYTHING ELSE (FOR NOW)
	SKIPA	E,B	;SAVE LIST POINTER IN E
LOOPCH:	ADDI	FLAGS,2	;INCREMENT NUMBER OF CHANNELS COLLECTED
	HLLZ	A,(E)	;GET TYPE (SHOULD BE CHANNEL)
	CAME	A,$TCHAN
	JRST	CHNERR
	MOVE	B,(E)+1	;GET VALUE
	HRRZ	E,(E)	;UPDATE LIST POINTER

SAVECH:	HRRZ	C,FLAGS	;GET CURRENT CHANNEL COUNT
	ADDI	C,(TB)	;APPROPRIATE STACK LOCATION
	CAIN	C,(TP)+1	;NEED MORE ROOM ON STACK FOR LIST ELEMENT CHANNELS ?
	ADD	TP,[2,,2]	;IF SO, GET MORE STACK ROOM
	MOVEM	A,(C)	;SAVE CHANNEL POINTER ON STACK
	MOVEM	B,(C)+1
	SKIPN	IOINS(B)	;SKIP IF I/O INSTRUCTION IS NON-ZERO
	PUSHJ	P,OPNCHN	;ELSE TRY TO OPEN THE CHANNEL
	JUMPE	B,CHNERR	;ERROR IF IT CANNOT BE OPENED
	MOVEI	B,DIRECT-1(B)	;POINT TO DIRECTION
	PUSHJ	P,CHRWRD
	JFCL
	CAME	B,[ASCII /PRINT/]	;IS IT PRINT
	JRST	CHNERR	;ELSE IT IS AN ERROR
	JUMPN	E,LOOPCH	;IF MORE CHANNELS ON LIST, GO CONSIDER THEM
	ADDI	FLAGS,2	;MAKE FINAL UPDATE OF COUNT
	MOVEI	A,CARRET	;GET A CARRIAGE RETURN
	TLNE	FLAGS,SPCBIT	;TYPE IT ONLY IF BIT IS ONE (PRINT)
	PUSHJ	P,PITYO
	TLNE	FLAGS,TERBIT	;IF A CALL TO "TERPRI" YOU ARE THROUGH
	JRST	RFALSE

	MOVE	A,(AB)	;FIRST WORD OF ARGUMENT GOES INTO REG A
	MOVE	B,1(AB)	;SECOND WORD INTO REG B
	PUSHJ	P,IPRINT	;CALL INTERNAL ROUTINE TO PRINT IT

	MOVEI	A,SPACE
	TLNE	FLAGS,SPCBIT	;SKIP (PRINT A TRAILING SPACE) IF SPCBIT IS ON
	PUSHJ	P,PITYO

	MOVE	A,(AB)	;GET FIRST ARGUMENT TO RETURN AS PRINT'S VALUE
	MOVE	B,1(AB)

	POP	P,E	;RESTORE REGISTERS C,D, AND E
	POP	P,D
	POP	P,C
	POP	P,FLAGS	;RESTORE THE FLAGS REGISTER
	JRST	FINIS






RFALSE:	MOVSI	A,TFALSE
	MOVEI	B,0
	JRST	FINIS
IPRINT:	PUSH	P,C	;SAVE REGISTER C ON THE P-STACK
	PUSH	P,FLAGS	;SAVE PREVIOUS FLAGS
	PUSH	TP,A	;SAVE ARGUMENT ON TP-STACK
	PUSH	TP,B

	INTGO		;ALLOW INTERRUPTS HERE
 
	HLRZ	A,-1(TP)	;GET THE TYPE CODE OF THE ITEM

	CAILE	A,NUMPRI	;SKIP IF TYPE NOT OUTSIDE OF VALID RANGE
	JRST	PUNK	;JUMP TO ERROR ROUTINE IF CODE TOO GREAT
	JRST	@PTBL(A)	;USE IT AS INDEX TO TRANSFER TABLE TO PRINT ITEM

DISTBL	PTBL,PUNK,[[TATOM,PATOM],[TFORM,PFORM],[TSEG,PSEG],[TFIX,PFIX]
[TFLOAT,PFLOAT],[TLIST,PLIST],[TVEC,PVEC],[TCHRS,PCHRS],[TCHSTR,PCHSTR]
[TARGS,PARGS],[TFRAME,PFRAME],[TUVEC,PUVEC],[TDEFER,PDEFER]
[TUNAS,PUNAS]]

PUNK:	MOVE	C,TYPVEC+1(TVP)	;GET AOBJN-POINTER TO VECTOR OF TYPE ATOMS
	HLRZ	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

	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)
	PUSHJ	P,IPRINT	;PRINT ATOM-NAME
	MOVE	B,(TP)	;RESET THE REAL ARGUMENT POINTER
	MOVEI	A,SPACE	;PRINT A SEPARATING SPACE
	PUSHJ	P,PITYO

	HRRZ	A,(C)	;GET THE STORAGE-TYPE
	JRST	@UKTBL(A)	;USE DISPATCH TABLE ON STORAGE TYPE

DISTBS	UKTBL,POCTAL,[[S2WORD,PLIST],[S2NWORD,PVEC],[SNWORD,PUVEC]
[SCHSTR,PCHSTR],[SFRAME,PFRAME],[SARGS,PARGS],[SPVP,PPVP]]



;INTERNAL SUBROUTINE TO HANDLE CHARACTER OUTPUT
;
;PRINTER ITYO USED FOR FLATSIZE FAKE OUT
PITYO:	TLNN	FLAGS,FLTBIT
	JRST	PITYO1
	AOS	FLTSIZE+1	;FLATSIZE DOESN'T PRINT
			;INSTEAD IT COUNTS THE CHARACTERS THAT WOULD BE OUTPUT
	SOSL	FLTMAX+1	;UNLESS THE MAXIMUM IS EXCEEDED
	POPJ	P,
	MOVSI	A,TFALSE	;IN WHICH CASE IT IMMEDIATELY GIVES UP AND RETURNS FALSE
	MOVEI	B,0
	JRST	FINIS

PITYO1:	TLNN FLAGS,HSHBIT
	JRST ITYO
	EXCH A,HSHNUM+1
	ROT A,-7
	XOR A,HSHNUM+1
	EXCH A,HSHNUM+1
	SOSL HSHMAX+1
	POPJ P,
	MOVSI A,TFIX
	MOVE B,HSHNUM+1
	JRST FINIS

;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	P,FLAGS	;SAVE STUFF
	PUSH	P,B
	PUSH	P,C
ITYOCH:	PUSH	P,A	;SAVE OUTPUT CHARACTER

	HRRZ	B,FLAGS	;GET CURRENT CHANNEL COUNT
	ADDI	B,(TB)-1
	MOVE	B,(B)	;GET THE CHANNEL POINTER

	CAIE	A,^L	;SKIP IF THIS IS A FORM-FEED
	JRST	NOTFF
	SETZM	LINPOS(B)	;ZERO THE LINE NUMBER
	SETZM	CHRPOS(B)	;	AND CHARACTER NUMBER.
	XCT	IOINS(B)	;FIRST DO A CARRIAGE RETURN-LINE FEED
	MOVEI	A,^L
	JRST	ITYXT

NOTFF:	CAIE	A,^M	;SKIP IF IT IS A CARRIAGE RETURN
	JRST	NOTCR
	SETZM	CHRPOS(B)	;ZERO THE CHARACTER POSITION
	XCT	IOINS(B)	;OUTPUT THE C-R
	MOVEI	A,^J	;FOLLOW WITTH A LINE-FEED
	AOS	C,LINPOS(B)	;ADD ONE TO THE LINE NUMBER
	CAMG	C,PAGLN(B)	;SKIP IF THIS TAKES US PAST PAGE END
	JRST	ITYXT

	SETZM	LINPOS(B)	;ZERO THE LINE POSITION
	XCT	IOINS(B)	;OUTPUT THE LINE FEED
	MOVEI	A,^L	;GET A FORM FEED
	JRST	ITYXT

NOTCR:	CAIN	A,^I	;SKIP IF NOT TAB
	JRST	TABCNT
	CAIN	A,^J	;SKIP IF NOT LINE FEED
	JRST	ITYXT	;ELSE, DON'T COUNT (JUST OUTPUT IT)
	AOS	CHRPOS(B)	;ADD TO CHARACTER NUMBER

ITYXT:	XCT	IOINS(B)	;OUTPUT THE CHARACTER
	POP	P,A	;RESTORE THE ORIGINAL CHARACTER
	SUBI	FLAGS,2	;DECREMENT CHANNEL COUNT
	TRNE	FLAGS,-1	;ANY MORE CHANNELS ?
	JRST	ITYOCH	;IF SO GO OUTPUT TO THEM

	POP	P,C	;RESTORE REGS & RETURN
	POP	P,B
	POP	P,FLAGS
	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

RETIF1:	MOVEI	A,1

RETIF:	TLNE	FLAGS,FLTBIT
	POPJ	P,	;IF WE ARE IN FLATSIZE THEN ESCAPE
	TLNE	FLAGS,HSHBIT	;ALSO ESCAPE IF IN HASH
	POPJ	P,
	PUSH	P,FLAGS
	PUSH	P,B
RETCH:	PUSH	P,A

	HRRZ	B,FLAGS	;GET THE CURRENT CHANNEL COUNT
	ADDI	B,(TB)-1	;CORRECT PLACE ON STACK
	MOVE	B,(B)	;GET THE CHANNEL POINTER
	ADD	A,CHRPOS(B)	;ADD THE CHARACTER POSITION
	CAMG	A,LINLN(B)	;SKIP IF GREATER THAN LINE LENGTH
	JRST	RETXT

	MOVEI	A,^M	;FORCE A CARRIAGE RETURN
	SETZM	CHRPOS(B)
	XCT	IOINS(B)
	MOVEI	A,^J	;AND FORCE A LINE FEED
	XCT	IOINS(B)
	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
	XCT	IOINS(B)
	SETZM	LINPOS(B)

RETXT:	POP	P,A
	SUBI	FLAGS,2	;DECREMENT CHANNEL COUNT
	TRNE	FLAGS,-1	;ANY MORE CHANNELS ?
	JRST	RETCH	;IF SO GO CONSIDER THEM

	POP	P,B
	POP	P,FLAGS
	POPJ	P,	;RETURN

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

;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
	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
	PUSHJ	P,RETIF
	JRST	PRE01	;PRINT VALUE AS "*XXXXXXXXXXXX*"

;PRINT BINARY INTEGERS IN DECIMAL.
;
PFIX:	MOVEI	E,FIXB	;GET ADDRESS OF FIXED POINT CONVERSION ROUTINE
	MOVE	D,[4,,4]	;PUT # WORDS RESERVED ON STACK INTO REG F
	JRST	PNUMB	;PRINT THE NUMBER

;PRINT SINGLE-PRECISION FLOATING POINT NUMBERS IN DECIMAL.
;
PFLOAT:	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
	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
	PUSHJ	P,RETIF	;START NEW LINE IF IT WON'T

	HRLI	B,000700	;MAKE REG B INTO BYTE POINTER TO FIRST CHAR LESS ONE
PNUM01:	ILDB	A,B	;GET NEXT BYTE
	PUSHJ	P,PITYO	;PRINT IT
	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

;PRINT SHORT (ONE WORD) CHARACTER STRINGS.
;
PCHRS:	MOVEI	A,3	;MAX # CHARS PLUS 2 (LESS ESCAPES)
	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:	LDB	A,[350700,,(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:	LDB	A,[350700,,(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
	PUSHJ	P,IPRINT	;PRINT IT
	JRST	PNEXT	;GO EXIT

;PRINT ATOM NAMES.
;
PATOM:	TLO	FLAGS,ATMBIT	;INDICATE ATOM-NAME PRINT OUT
	HRRZ	B,(TP)	;GET ADDRESS OF ATOM
	ADDI	B,2	;POINT TO FIRST P-NAME WORD
	HRLI	B,350700	;MAKE INTO A BYTE POINTER
	HLRE	A,(TP)	;GET LENGTH
	MOVMS	A	;ABSOLUTE VALUE
	ADDI	A,-1(B)	;POINT TO LAST WORD
	HRLI	A,TCHSTR	;CHANGE TYPE
	PUSH	TP,A	;PUT STRING ON STACK
	PUSH	TP,B

	MOVE	D,[AOS E]	;GET COUNTING INSTRUCTION
	SETZM	E	;ZERO COUNT
	PUSHJ	P,PCHRST	;COUNT CHARACTERS & ESCAPES
	MOVE	A,E	;GET RETURNED COUNT
	PUSHJ	P,RETIF	;DO A CARRIAGE RETURN IF NOT ENOUGH ROOM ON THIS LINE

	MOVEM	B,(TP)	;RESET BYTE POINTER
	MOVE	D,[PUSHJ P,PITYO]	;GET OUTPUT INSTRUCTION
	PUSHJ	P,PCHRST	;PRINT STRING

	SUB	TP,[2,,2]	;REMOVE CHARACTER STRING ITEM
	JRST	PNEXT

;PRINT LONG CHARACTER STRINGS.
;
PCHSTR:	TLZ	FLAGS,ATMBIT	;WE ARE NOT USING ATOM-NAME TYPE ESCAPING

	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
	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
	PUSHJ	P,PITYO

PCHS01:	MOVE	D,[PUSHJ P,PITYO]	;OUTPUT INSTRUCTION
	MOVEM	B,(TP)	;RESET BYTE POINTER
	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
	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
	LDB	A,(TP)	;GET FIRST BYTE
	SKIPA

PCHR02:	ILDB	A,(TP)	;GET THE NEXT CHARACTER
	JUMPE	A,PCSOUT	;ZERO BYTE TERMINATES
	HRRZ	C,-1(TP)	;GET ADDRESS OF DOPE WORD
	HRRZ	B,(TP)	;GET WORD ADDRESS OF LAST BYTE
	CAIL	B,-1(C)	;SKIP IF IT IS AT LEAST TWO BEFORE DOPE WORD
	JRST	PCSOUT	;ELSE, STRING IS FINISHED

	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 ATOM-BREAKER
	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
	XCT	D	

PCSPRT:	LDB	A,(TP)	;GET THE CHARACTER AGAIN
	XCT	D	;PRINT IT
	JRST	PCHR02	;LOOP THROUGH STRING

PCSOUT:	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
	MOVE	B,@-1(B)		;PICKUP ATOM
	PUSH	TP,$TATOM
	PUSH	TP,B		;SAVE IT
	MOVSI	A,TATOM
	MOVE	B,MQUOTE -STACK-FRAME-FOR-
	PUSHJ	P,IPRINT		;PRINT IT
	POP	TP,B
	POP	TP,A
	PUSHJ	P,IPRINT		;PRINT FUNCTION NAME
	JRST	PNEXT

PPVP:	MOVE	B,MQUOTE -PROCESS-
	MOVSI	A,TATOM
	PUSHJ	P,IPRINT
	MOVE	B,(TP)		;GET PVP
	MOVE	A,PROCID(B)
	MOVE	B,PROCID+1(B)	;GET ID
	PUSHJ	P,IPRINT
	JRST	PNEXT
;PRINT UNIFORM VECTORS.
;
PUVEC:	MOVEI	A,"!	;TYPE AN ! AND OPEN SQUARE BRACKET
	PUSHJ	P,PRETIF
	MOVEI	A,"[
	PUSHJ	P,PRETIF

	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
	PUSHJ	P,IPRINT	;TYPE IT

	MOVE	C,(TP)	;GET AOBJN POINTER
	AOBJP	C,NULVE1	;JUMP IF COUNT IS ZERO
	MOVEM	C,(TP)	;PUT POINTER BACK ONTO STACK

	MOVEI	A,SPACE	;TYPE A BLANK
	PUSHJ	P,PITYO
	JRST	PUVE02	;LOOP THROUGH VECTOR

NULVE1:	SUB	P,[1,,1]	;REMOVE STACK CRAP
NULVEC:	MOVEI	A,"!	;TYPE CLOSE BRACKET
	PUSHJ	P,PRETIF
	MOVEI	A,"]
	PUSHJ	P,PRETIF
	JRST	PNEXT

;PRINT A GENERALIZED VECTOR.
;
PVEC:	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
	PUSHJ	P,IPRINT	;PRINT THAT ELEMENT

	MOVE	C,(TP)	;GET AOBJN POINTER FROM TP-STACK
	AOBJP	C,PDLERR	;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

	MOVEI	A," 	;PRINT A SPACE
	PUSHJ	P,PITYO
	JRST	PVCR01	;CONTINUE LOOPING THROUGH OBJECTS ON VECTOR

PVCEND:	PUSHJ	P,RETIF1	;NEW LINE IF NO ROOM FOR ]
	MOVEI	A,"]	;PRINT A RIGHT-BRACKET
	PUSHJ	P,PITYO
	JRST	PNEXT

;PRINT A LIST.
;
PLIST:	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
	PUSHJ	P,RETIF1	;NEW LINE IF NO ROOM FOR THE CLOSE PAREN
	MOVEI	A,")	;TYPE A CLOSE PAREN
	PUSHJ	P,PITYO
	JRST	PNEXT



;PRINT AN UNASSIGNED

PUNAS:	PUSHJ	P,RETIF1
	MOVEI	A,"?
	PUSHJ	P,PITYO
	JRST	PLIST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,"'
	CAMN	B,MQUOTE GIVEN
	MOVEI	D,"?
	CAMN	B,MQUOTE ALTER
	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
	PUSHJ	P,RETIF1
	MOVEI	A,"!
	PUSHJ	P,PITYO

PLMNT4:	PUSHJ	P,RETIF1
	POP	P,A		;RESTORE CHAR
	PUSHJ	P,PITYO
	POP	TP,B
	POP	TP,A
	PUSHJ	P,IPRINT
	JRST	PNEXT

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

;ITS A SEGMENT CALL
	PUSHJ	P,RETIF1
	MOVEI	A,"!
	PUSHJ	P,PITYO

PLMNT5:	PUSHJ	P,RETIF1	
	MOVEI	A,"<
	PUSHJ	P,PITYO
	PUSHJ	P,LSTPRT
	MOVEI	A,"!
	TLNE	FLAGS,SEGBIT	;SKIP IF NOT SEGEMNT
	PUSHJ	P,PRETIF
	MOVEI	A,">
	PUSHJ	P,PRETIF
	JRST	PNEXT

LSTPRT:	INTGO	;WATCH	OUT FOR GARBAGE COLLECTION!
	SKIPN	C,(TP)
	POPJ	P,
	HLLZ	A,(C)	;GET NEXT ELEMENT
	MOVE	B,1(C)
	HRRZ	C,(C)	;CHOP THE LIST
	JUMPN	C,PLIST1
	PUSHJ	P,IPRINT	;PRINT THE LAST ELEMENT
	POPJ	P,

PLIST1:	MOVEM	C,(TP)
	PUSHJ	P, IPRINT	;PRINT THE NEXT ELEMENT
	PUSHJ	P,RETIF1
	MOVEI	A," 
	PUSHJ	P,PITYO	;PRINT THE SPACE AFTER THE NEXT ELEMENT
	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,

PDLERR:	.VALUE	0	;P-STACK OVERFLOW, VERY SERIOUS, MUDDLE DIES!

CHNERR:	PUSH	TP,$TATOM
	PUSH	TP,MQUOTE BAD-CHANNEL
	JRST	CALER1

ARGERR:	PUSH	TP,$TATOM	;TYPE WRONG # ARGUMENTS
	PUSH	TP,MQUOTE WRONG-NUMBER-OF-ARGUMENTS
	JRST	CALER1

END