X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=MUDDLE%2Fnprint.8;fp=MUDDLE%2Fnprint.8;h=e7199848668cb0e528555161ec82a6958a4af2b0;hb=39c5769144e7f2a58076bdb973d2c80fa603345c;hp=0000000000000000000000000000000000000000;hpb=bab072f950a643ac109660a223b57e635492ac25;p=pdp10-muddle.git

diff --git a/MUDDLE/nprint.8 b/MUDDLE/nprint.8
new file mode 100644
index 0000000..e719984
--- /dev/null
+++ b/MUDDLE/nprint.8
@@ -0,0 +1,799 @@
+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
+
\ No newline at end of file