X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=sumex%2Fprint.mcr246;fp=sumex%2Fprint.mcr246;h=62a4fbdc5abc95046be856bb138df23a8c69180c;hp=0000000000000000000000000000000000000000;hb=1c973408824dee4a587c040bc8075cd1bf047ba3;hpb=a3df309bdd1ea54242d39e62403548d1e4845f8e

diff --git a/sumex/print.mcr246 b/sumex/print.mcr246
new file mode 100644
index 0000000..62a4fbd
--- /dev/null
+++ b/sumex/print.mcr246
@@ -0,0 +1,2246 @@
+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
+