;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ****** PRINT AND FILE-HANDLING FUNCTIONS *******
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************


SUBTTL	FUNNY PRINTING ROUTINES

PGBOT PRT


.NOPOINT:
	PUSHJ P,NOTNOT
	HRRZM A,V.NOPOINT
	POPJ P,


COMMENT |	HERE IS A FINE HACK THAT GOT SUPERSEDED BY CTYP

CTY:	PUSHJ P,TYOI	;THIS IS ALWAYS DONE BY A XCT "Q,CTY - FOR RANDOM Q.
TYOI:	PUSH P,A	; USEFUL MAINLY BECAUSE IT SAVES A. WARNING!!!
	MOVE A,-1(P)	; THIS CODE IS VERY HACKISH, DEPENDENT ON THE OPCODE
	LDB A,[270600,,-1(A)]	; OF XCT (256). THIS ONLY WORKS FOR ASCII
	PUSHJ P,(R)	; CHARS IN THE RANGE 40-57. THUS Q MUST BE AMONG
	JRST POPAJ	;  [ !"#$%&'()*+,-./] (THE BRACKETS ARE META-CHARS!)

|		;END OF COMMENT


;;;	XCT N,CTYP
;;; CAUSES THE N'TH CHARACTER IN TYO1TB TO GET PRINTED VIA
;;; THE ROUTINE IN R.  SYMBOLS ARE DEFINED FOR THESE XCT'S.

CTYP:	PUSHJ P,TYO1C
TYO1C:	PUSH P,A
	HRRZ A,-1(P)
	LDB A,[270400,,-1(A)]
	MOVE A,TYO1TB(A)
	PUSHJ P,(R)
	JRST POPAJ

TYO1TB:
IRP X,,[#,(,),+,-,.,/,|,:,", ,_,E,D,,.]Z,,[NMBR,LPAR,RPAR,POS
NEG,DOT,SLSH,VBAR,CLN,DBLQ,SPC,BAK,E,D,CTLQ,DCML]
%!Z!%=XCT .IRPCNT,CTYP
	"X
TERMIN
IFG .-TYO1TB-20, WARN [TOO MANY TYO1TB CHARACTERS]



SUBTTL	NEWIO TYO FUNCTION AND RELATED ROUTINES

;;; CALLED BY FUNCTIONS LIKE PRINT WHICH TAKE AN ARG AND
;;; AN OPTIONAL ASCII OUTPUT FILE ARRAY. DOES ARGS CHECKING
;;; AND SETS UP AR1 WITH THE CORRECT OUTPUT FILE(S).
;;; IF ONE ARG IS GIVEN AND THERE ARE NO FILES TO OUTPUT TO
;;; (^W IS NON-NIL, AND EITHER ^R OR OUTFILES IS NIL),
;;; THEN A POPJ IS DONE, RETURNING FOR THE CALLING FUNCTION.
;;; LEFT HALF BITS IN AR1:
;;;	400000	RH OF AR1 HAS SINGLE FILE ARRAY (ELSE LIST)
;;;	200000	DO *NOT* OUTPUT TO TTY AS WELL
;;;		IFN SFA, THEN ALSO PRINT/PRINC/PRIN1/TYO BIT
;;;
;;; CALLED BY:
;;;		JSP F,PRNARG
;;;		   XXX,,[QPRINT]	;ATOM FOR WNA ERROR
;;;	-OR-	   XXX,,[<SFA-BIT>,,QPRINT] ;IFN SFA
;;; XXX IS TYPICALLY JFCL.  IF XXX IS NEGATIVE, THE RETURN VALUE
;;; FOR THE FUNCTION IS NIL INSTEAD OF T.

PRNARG:	AOJN T,PRNAR2
	POP P,A
PRNAR$:	SOVE AR1 AR2A CPNAGX
PRNAR0:	SKIPE AR1,TAPWRT	;IF ^R NOT SET, USE NIL
	 HRRZ AR1,VOUTFILES	;OTHERWISE USE OUTFILES
	JUMPN AR1,PRNAR3
	SKIPE TTYOFF
	 JRST PRNAR8
PRNAR3:
SFA$	HLRZ T,@(F)		;PLACE OPERATIONS FLAG IN AR1
SFA$	TLO AR1,(T)
	TRNN AR1,-1
SFA$	 JRST PRNTTY		;GOING TO THE TTY
SFA%	 JRST 1(F)
	PUSHJ P,MPFLOK
	 JRST 1(F)
PRNAR7:	PUSHJ P,OFCAN
	EXCH A,AR1
	PUSHJ P,[IOL [LOSING OUTPUT FILE SPECS!]]
	EXCH A,AR1
	JUMPE T,PRNAR0
	JRST PRNAR4

IFN SFA,[
PRNTTY:	TLNE AR1,200000		;REALLY GOING TO THE TTY?
	 JRST 1(F)		;NOPE, SO RETURN
	MOVSI T,AS.SFA		;IS C(TYO) AN SFA?
	MOVE R,V%TYO
	TDNN T,ASAR(R)
	 JRST 1(F)		;NOPE, SO ALL IS OK
	HLLZ T,@(F)		;SFA OPERATION MASK
	MOVEI TT,SR.WOM
	TDNN T,@TTSAR(R)	;CAN THE SFA DO THIS OPERATION DIRECTLY?
	 JRST 1(F)		;NOPE, IT WILL HANDLER A LOWER-LEVEL THING
	MOVEI C,(A)		;ARG IS THING TO PRINT/PRINC/PRIN1
	MOVEI AR1,(R)		;THE SFA
	JRST ISTCAL		;DO AN INTERNAL SFA CALL
]		;END IFN SFA

PRNAR2:	CAME T,XC-1
	 JRST PRNAR9
	MOVE A,-1(P)
	MOVEM AR1,-1(P)
	EXCH AR2A,(P)
	PUSH P,CPNAGX
	SKIPN AR1,AR2A
	 AOJA T,PRNAR0
PRNAR4:	JSP T,PRNARK
	 JRST PRNARA		;ERRONEOUS FILE
	 JRST PRNAR6		;LIST OF SOME KIND
SFA$	 SKIPA			;NORMAL RETURN
SFA$	 JRST PRNAR8		;HANDLED THE SFA
PRNAR5:	TLO AR1,600000		;VALID FILE OBJECT
	HLRZ T,@(F)
	TLO AR1,(T)
	JRST 1(F)

PRNAR6:	TLO AR1,200000
	JRST PRNAR3

PRNARA:	TLO AR1,200000		;MAKE ERROR MESSAGE PRINT CORRECTLY
	JRST PRNAR7

PRNAR8:	SKIPGE (F)
	 JRST FALSE
	JRST TRUE

PRNAR9:	HRRZ D,@(F)
	JRST S1WNAL

PNAGX:	RSTR AR2A AR1
CPNAGX:	POPJ P,PNAGX

;;; CHECK LIST OF FILES IN AR1 FOR VALIDITY.
;;; SKIPS ON *FAILURE*.

MPFLOK:	PUSH P,AR1		;MUST PRESERVE LH OF AR1
	MOVEI AR2A,(AR1)
MPFLO1:	JUMPE AR2A,MPFLO2
	HLRZ AR1,(AR2A)
	JSP T,PRNARK
	 JRST MPFLO3		;ERROR
	 JRST MPFLO3		;LIST (NOT ALLOWED WITHIN ANOTHER LIST)
SFA$	 SKIPA			;NORMAL
SFA$	 JFCL			;HANDLED THE SFA
	HRRZ AR2A,(AR2A)
	JRST MPFLO1

MPFLO3:	AOS -1(P)		;ERROR - SKIP
MPFLO2:	POP P,AR1
	POPJ P,

;;; CHECK OUT OBJECT IN AR1.
;;;	SKIP 3 IF AN SFA, AND HANDLED IT
;;;	SKIP 2 IF A VALID, OPEN, NON-BINARY, OUTPUT FILE OBJECT.
;;;	SKIP 1 IF A LIST (ELEMENTS ARE NOT CHECKED).
;;;	SKIP 0 OTHERWISE.

PRNARK:	CAIN AR1,TRUTH		;ARG CHECK FOR PRNARG
	 HRRZ AR1,V%TYO		;FOR T, ASSUME CONTENTS OF TYO
	JSP TT,XFOSP		;MUST BE FILE ARRAY OR SFA
	 JRST PRNRK2
IFN SFA,[
	  JRST PRNRK1
	PUSH P,T		;SAVE T
	MOVEI TT,SR.WOM		;AN SFA
	HLLZ T,@(F)		;THE APPROPRIATE FUNCTION
	TDNN T,@TTSAR(AR1)	;CAN THE SFA DO IT?
	 JRST PRNRK3		;NOPE, RESTORE T AND PROCEED
	PUSHJ FXP,SAV5		;SAVE THE 'WORLD'
	PUSHJ P,SAVX5
	MOVEI C,(A)		;ARGUMENT TO SFA
	PUSHJ P,ISTCAL
	PUSHJ P,RSTX5
	PUSHJ FXP,RST5
	POP P,T
	JRST 3(T)		;TRIPLE-SKIP RETURN
PRNRK3:	POP P,T
	JRST 2(T)		;DOUBLE-SKIP RETURN, LOWER-LEVEL WILL HANDLE IT
PRNRK1:	]	;END IFN SFA
	MOVE TT,TTSAR(AR1)
	TLNE TT,TTS.IO		;MUST BE OUTPUT FILE
	 TLNE TT,TTS<BN+CL>	;MUST NOT BE CLOSED, NOR BINARY
	  JRST (T)		;ERROR
	JRST 2(T)		;SUCCESS - VALID FILE OBJECT

PRNRK2:	MOVEI TT,(AR1)
	LSH TT,-SEGLOG
	SKIPGE ST(TT)
	 JRST 1(T)		;OKAY IF LIST (CALLER USUALLY WILL USE MPFLOK)
	JRST (T)		;ELSE ERROR

IFN SFA,[
;;; FILE-ARRAY OR LIST IN AR1: IF ZERO USE V%TYO
PRTSTO:	PUSH P,PRTSO1		;IN CASE PRTSTR POPJS
	PUSH FXP,F
	PUSH FXP,A
	MOVEI A,(FXP)		;GIVE IT A PDL NUMBER
	JSP F,PRTSTR		;DO SFA CHECKING
	[SO.TYO,,]
	POP FXP,A
	POPI P,1
PRTSO1:	POPJ FXP,.+1		;RETURN TO CALLER
	POPI FXP,2		;HANDLED ALL WE NEEDED TO
	POPJ P,

PRTSTR:	JUMPE AR1,PRTST1	;HANDLE DEFAULT CONDITION SPECIALLY
	JSP T,PRNARK		;CHECK OUT C(AR1)
	 JFCL			;PROBABLY BAD OUTFILES
	 JRST PRTSTL		;A LIST
	 JRST 1(F)		;A FILE ARRAY OR UNHANDLED SFA
	 POPJ P,		;A HANDLED SFA

PRTST1:	HRRZ AR1,V%TYO
	MOVEI TT,SR.WOM		;AN SFA
	HLLZ T,@(F)		;THE APPROPRIATE FUNCTION
	TDNN T,@TTSAR(AR1)	;CAN THE SFA DO IT?
	 JRST PRTST2		;NOPE, RETURN NORMALLY
	PUSHJ FXP,SAV5		;SAVE THE 'WORLD'
	PUSHJ P,SAVX5
	MOVEI C,(A)		;ARGUMENT TO SFA
	PUSHJ P,ISTCAL
	PUSHJ P,RSTX5
	PUSHJ FXP,RST5
	POPJ P,			;RETURN
PRTST2:	SETZ AR1,		;MAKE SURE AR1 IS STILL ZERO
	JRST 1(F)		;THEN RETURN TO CALLER

PRTSTL:	PUSHJ P,MPFLOK		;CHECK THE LIST IN AR1
	 JRST 1(F)		;RETURN IF ALL OK
	PUSHJ P,OFCAN
	EXCH A,AR1
	PUSHJ P,[IOL [LOSING OUTPUT FILE SPECS!]]
	EXCH A,AR1
	JRST PRTSTR
]		;END IFN SFA


TYO$:	JSP F,PRNAR$			;USER'S "*TYO" ENTRY
SFA$		[SO.TYO,,QTYO$]
SFA%		[QTYO$]
	JRST %TYO1

%TYO:	JSP F,PRNARG			;USER'S "TYO" ENTRY
SFA%	 JFCL [Q%TYO]
SFA$	 JFCL [SO.TYO,,Q%TYO]
%TYO1:	JSP T,GTRDTB
	PUSHJ P,TYO1
	JRST TRUE

TYO:	SKIPE AR1,TAPWRT		;ENTRY FOR SINGLE-ENTER INTERNALS
	 HRRZ AR1,VOUTFILES		;TEMP ??
SFA$	JSP F,PRTSTO			;DO SFA CHECKING STUFF

$TYO:	PUSH FXP,T			;ENTRY FOR PRIN1, PRINC, GC-PRINTOUT,
	PUSH FXP,TT			;  AND MULTIPLE-ENTER INTERNALS
	PUSH P,[PXTTTJ]	
	JSP T,GTRDTB
TYOPR:	SKIPA TT,A			;MUST SAVE R FOR PRINT
TYO1:	 JSP F,TYOARG
;AT THIS POINT: CHAR IN TT, FILE(S) IN AR1, READTABLE IN AR2A
;MUST SOVE A,B,C,AR1,R
TYO6:	.5LKTOPOPJ
STRTYO:	JUMPGE AR1,TYO5
	TLNN AR1,200000
	 SKIPE TTYOFF
	  JRST TYO6A
	SKIPLE TYOSW
	 JRST TYO6A
	PUSH P,AR1
	HRR AR1,V%TYO
	TLZ AR1,600000	
	PUSHJ P,TYOF
	POP P,AR1
TYO6A:	MOVEI T,(AR1)
	CAIE T,TRUTH
	 JRST TYO6B
	HRR AR1,V%TYO		;T MEANS SAME AS VALUE OF TYO,
	SKIPN TTYOFF		; BUT CAN BE SILENCED BY ^W
TYO6B:	 SKIPGE TYOSW
	  POPJ P,
	JRST TYOF

TYO5:
REPEAT 2, PUSH P,AR1
	HRRZS -1(P)
	TLNN AR1,200000
	 SKIPE TTYOFF
	  JRST TYO2
	HRR AR1,V%TYO
	SKIPG TYOSW
	 PUSHJ P,TYOF
TYO2:	SKIPL TYOSW
TYO2A:  SKIPN AR1,-1(P)
	  JRST TYO4
	HLRZ AR1,(AR1)
	CAIN AR1,TRUTH
	 JRST TYO2Z
	HLL AR1,(P)
	JRST TYO2B
TYO2Z:	HRRZ AR1,V%TYO
	HLL AR1,(P)
	SKIPN TTYOFF
TYO2B:	 PUSHJ P,TYOF
	HRRZ AR1,@-1(P)
	MOVEM AR1,-1(P)
	JRST TYO2A

TYO4:	POP P,AR1		;PRESERVE AR1
	JRST POP1J

TYOARG:	JSP T,FXNV1
IFN SAIL\ITS, TDNN TT,[777777,,770000]	;UP TO 12. BITS OKAY
IFE SAIL\ITS, TDNN TT,[777777,,777400]	;UP TO 8 BITS OKAY
	 JRST (F)
	JRST TYOAGE


;;; TYO ONE CHARACTER TO ONE FILE.  MUST PRESERVE AR1,AR2A
;;;	USER INTERRUPTS LOCKED OUT. (??)
;;;	FILE ARRAY IN AR1.
;;;	READTABLE IN AR2A.
;;;	CHARACTER IN TT (MUST BE PRESERVED).
;;; TYOF HANDLES ALL CHARPOS, LINENUM, AND PAGENUM PROCESSING,
;;; CONTROL CHARACTERS, SAIL MODE OUTPUT, ETC.
;;; ALL CR'S NOT FOLLOWED BY LF'S HAVE LF'S SUPPLIED FOR THEM.
;;; MUST SAVE R FOR PRINT.

TYOFA:	MOVE TT,A
TYOFIL:	.5LKTOPOPJ
TYOF:	TRNN AR1,-1
	 JRST TYOFE
IFN SFA,[
	MOVSI T,AS.SFA		;AN SFA?
	TDNN T,ASAR(AR1)
	 JRST TYOFS0		;NOPE
	PUSHJ FXP,SAV5		;SAVE THE 'WORLD'
	PUSHJ P,SAVX5
	SKIPGE TT		   ;DO A CONVERSION ON FORMAT INFO
	 MOVNI TT,(TT)
	JSP T,FXCONS		;CONS UP A FIXNUM
	HLLZ T,AR1		;HAS THIS SFA BEEN HACKED AT A HIGHER LEVEL?
	TLZ T,600000		;BITS NOT OF INTEREST TO THE SFA
	MOVEI TT,SR.WOM
	TDNE T,@TTSAR(AR1)	;CHECK THE OPERATIONS MASK
	 JRST TYOFS1		;ALRADY DONE IT, SO RETURN
	HRRZS INHIBI		;REALLY DIDN'T WANT THAT .5LKTOPOPJ
	MOVEI C,(A)		;AS THE ARGUMENT TO THE SFA
	MOVEI B,Q%TYO		;A TYO OPERATION
	MOVEI A,(AR1)		;THE SFA ITSELF
	PUSHJ P,ISTCSH		;DO SHORT INTERNAL SFA CALL
TYOFS1:	PUSHJ FXP,RST5
	JRST RSTX5		;RESTORE ACS AND RETURN
TYOFS0:	]	;END IFN SFA
	MOVE T,TTSAR(AR1)
	JUMPL TT,TYOF7		;NEGATIVE => FORMAT INFO
	SKIPGE ATO.LC(T)
	 PUSHJ P,TYOFXL
IT%	CAIN TT,177		;RUBOUT HAS NO PRINT WIDTH
IT%	 JRST TYOF4
	CAIN TT,7		;<BELL> HAS NO PRINT WIDTH
	 JRST TYOF0G
IT$	CAIE TT,177		;ITS RUBOUT PRINTS AS TWO CHARACTERS
	 CAIGE TT,40		;CONTROL CHARACTERS HAVE WIDTH
	  JRST TYOF2		; OF 1 OR 2, OR ELSE ARE FUNNY
TYOF0D:	AOS D,AT.CHS(T)		;INCREMENT CHARPOS
	SKIPE ATO.LC(T)		;SKIP UNLESS LAST CHAR WAS /
	 JRST TYOF0G
	SKIPLE FO.LNL(T)	;ZERO OR NEGATIVE LINEL => INFINITY
	 TLNE T,TTS<IM>		.SEE STERPRI
	  JRST TYOF0E		;FOR IMAGE OUTPUT, NO EXTRA CHARS
	CAMLE D,FO.LNL(T)
	 SKIPE V%TERPRI
	  JRST TYOF0E
	HRLM TT,(P)		;NEW LINE NEEDED BEFORE THIS CHAR
	MOVEI TT,^M		;BECAUSE OF AUTO-TERPRI
	PUSHJ P,TYOF4
	PUSHJ P,TYOFXL
	MOVEI TT,1
	MOVEM TT,AT.CHS(T)		;SO THIS CHAR WILL BE AT CHARPOS 1
	HLRZ TT,(P)
TYOF0E:	MOVE D,@TTSAR(AR2A)		;GET READTABLE ENTRY FOR THIS
	TLNE D,2000	.SEE SYNTAX	;IF THIS IS A /, SET FLAG
	 HLLOS ATO.LC(T)		; FOR NEXT TIME AROUND
	JRST TYOF4

TYOF0G:	SETZM ATO.LC(T)		;RESET / FLAG
	JRST TYOF4		;OUTPUT CHAR, IGNORING LINEL

TYOF2:	CAIG TT,^M		;FOUND CONTROL CHAR
	 CAIGE TT,^H
	  JRST TYOF3		;REGULAR CONTROL CHAR
	JRST @.+1-^H(TT)	;FORMAT EFFECTOR - PECULIAR
		TYOFBS		;^H	BACKSPACE
		TYOFTB		;^I	TAB
		TYOFLF		;^J	LINE FEED
		TYOF3		;^K	<NOT REALLY FORMAT CHAR>
		TYOFFF		;^L	FORM FEED
		TYOFCR		;^M	CARRIAGE RETURN

TYOFXL:	SETZM ATO.LC(T)		;LINE FEED NEEDED BEFORE THIS CHAR
	CAIE TT,^J		;FORGET IT IF THIS CHAR IS LF
	 TLNE T,TTS<IM>		;DON'T GENERATE LF FOR IMAGE FILE
	  POPJ P,
	HRLM TT,(P)
	MOVEI TT,^J
	PUSHJ P,TYOFLF
	HLRZ TT,(P)
	POPJ P,

TYOFE:	EXCH A,AR1
	%WTA [SIXBIT \NOT A FILE - TYO!\]


TYOF3:	CAIN TT,33		;ALTMODES ARE ALWAYS 1 WIDE
	 JRST TYOF0D
	MOVE D,F.MODE(T)	;RANDOM CONTROL CHAR
IFE SAIL,[
IT$	CAIE TT,177		;RUBOUT PRINTS TWO POSITIONS EVEN IN SAIL MODE
	 TLNN D,FBT<SA>		;SKIP IF SAIL MODE FILE
	  AOS AT.CHS(T)		;OTHERWISE CONTROL CHARS ARE 2 WIDE
]	;END OF IFE SAIL
	JRST TYOF0D

TYOFBS:	SKIPLE AT.CHS(T)	;BACKSPACE - UNLESS AGAINST LEFT MARGIN,
	 SOS AT.CHS(T)		; DECREMENT CHARPOS
	SETZM ATO.LC(T)		;CLEAR / FLAG
	JRST TYOF4

TYOFTB:	MOVEI D,7		;TAB FOUND - JUMP TO NEXT
	IORM D,AT.CHS(T)	;MULTIPLE-OF-8 CHARPOS
	JRST TYOF0D

TYOFLF:	AOS D,AT.LNN(T)		;INCREMENT LINENUM
	SKIPLE FO.PGL(T)	;ZERO PAGEL => INFINITY
	 CAMGE D,FO.PGL(T)	;SKIP IF OVER PAGE LENGTH
	  JRST TYOF4
	SETZM AT.LNN(T)		;ZERO LINE NUMBER
	AOS AT.PGN(T)		;INCREMENT PAGE NUMBER
	JRST TYFFF0

TYOFFF:	SETZM AT.LNN(T)		;ZERO LINE NUMBER
	AOS AT.PGN(T)		;INCREMENT PAGE NUMBER
	TLNN T,TTS.TY		;IF TTY THEN DON'T GIVE END PAGE INT ON ^L
TYFFF0:	 SKIPN FO.EOP(T)	;IF IT HAS AN ENDPAGEFN, THEN
	  JRST TYOF4		; WANT TO GIVE USER INTERRUPT
	PUSHJ P,TYOF4
	MOVEI D,200000+2*FO.EOP+1
	HRLI D,(AR1)
	JRST UINT

TYOF7:	SKIPLE FO.LNL(T)	;INFINITE LINEL
	 TLNE T,TTS<IM>		; OR IMAGE MODE TTY
	  POPJ P,		; => IGNORE FORMAT DATA
	SKIPN V%TERPRI
	SKIPN AT.CHS(T)		;CAN'T DO ANY BETTER THAN TO BE
	 POPJ P,		; AT THE BEGINNING OF A LINE
	MOVEI D,(TT)
	ADD D,AT.CHS(T)
	CAMG D,FO.LNL(T)
	 POPJ P,
	SETZM AT.CHS(T)
	PUSH FXP,TT
	MOVEI TT,^M		;IF TOO LONG, DO AN AUTO-TERPRI
	PUSHJ P,TYOFCR
	POP FXP,TT
	POPJ P,

TYOFCR:	SETZM AT.CHS(T)		;CR - SET CHARPOS TO ZERO
	PUSHJ P,TYOF4
	SETOM ATO.LC(T)		;SET LF FLAG (MUSTN'T DO UNTIL AFTER IOT
	POPJ P,			; OF CR BECAUSE A **MORE** MIGHT OCCUR)

TYOF4:				.SEE PTYO
IFN ITS\D20,[
	TLNE T,TTS.TY
	 JRST TYOF4C
]	;IFN ITS\D20
TYOF6:
TYOF4A:	SKIPL F.MODE(T)		.SEE FBT.CM
	 JRST TYOF5
IFN ITS,[
	MOVE D,F.CHAN(T)	;CHARMODE (UNIT MODE)
	LSH D,27		;TYI USES THIS CODE TOO (SAVES F)
	IOR D,[.IOT TT]
   SPECPRO INTTYX
TYOXCT:	XCT D
   NOPRO
]		;END OF IFN ITS
IFN D10,[
SA$	 OUTCHR TT
IFE SAIL,[
	TLNE T,TTS.IM
	 TLNN T,TTS.TY
	  JRST .+3
	   IONEOU TT		;DO THIS IF IMAGE MODE TTY
	   JRST .+5
	CAIE TT,33		;NON-SAIL MONITORS LOSE ALTMODES
	 OUTCHR TT
	CAIN TT,33		;FOR THEM, WE OUTPUT ALTMODE AS $
	 OUTCHR C$		; (ON THE TTY ONLY!)
]		;END OF IFE SAIL
]		;END OF IFN D10
IFN D20,[
	PUSHJ FXP,SAV2
	HRRZ 1,F.JFN(T)
	MOVEI 2,(TT)
	BOUT			;OUTPUT THE BYTE
	 ERJMP OIOERR
	PUSHJ FXP,RST2
]		;END OF IFN D20
	AOS F.FPOS(T)		;ADJUST FILE POSITION (DOESN'T HURT IF F.FLEN NEG)
C$:	POPJ P,"$

INTTYR:	HRROS INHIBIT		.SEE $IWAIT	;COME HERE AFTER INTERRUPT
	MOVE T,TTSAR(AR1)	;FILE ARRAY MAY HAVE MOVED
	POPJ P,			.SEE TYIXCT TYICAL

TYOF5:				;BLOCK MODE
IFN ITS\D20,[
	IDPB TT,FB.BP(T)	;PUT BYTE IN BUFFER
	SOSLE FB.CNT(T)		;DECREMENT COUNT
]		;END OF IFN ITS\D20
IFN D10,[
	MOVE D,FB.HED(T)	;FOR D10, BYTE POINTER AND COUNT ARE IN BUFFER HEADER
	IDPB TT,1(D)		;PUT BYTE IN BUFFER
	SOSLE 2(D)		;DECREMENT COUNT
]		;END OF IFN D10
	 POPJ P,
	HRLM TT,(P)
	MOVE TT,T
	PUSH FXP,F
	PUSHJ P,IFORCE
	POP FXP,F
	HLRZ TT,(P)
TYOF5Y:	MOVE T,TTSAR(AR1)
	POPJ P,

IFN ITS\D20,[
TYOF4C:	TLNN T,TTS.IM		;DO NOT HACK THIS FOR IMAGE MODE
	 CAIE TT,^P		;^P IS THE DISPLAY ESCAPE CODE, AND
	  JRST TYOF4A		; MUST BE TREATED SPECIALLY
	SKIPGE F.MODE(T)	.SEE FBT.CM
	 JRST TYOF4J
	MOVE TT,FB.CNT(T)	;FOR BLOCK MODE, BE CAREFUL
	PUSH FXP,F
	CAIGE T,2		; ABOUT SPLITTING A ^P-CODE
	 PUSHJ P,IFORCE		; ACROSS A BLOCK BOUNDARY
	POP FXP,F
TYOF4J:	MOVE T,TTSAR(AR1)	;OUTPUT ^P AS ^P P
	MOVEI TT,^P
	PUSHJ P,TYOF4A
	MOVE T,TTSAR(AR1)
	MOVEI TT,"P
	PUSHJ P,TYOF4A
	JRST TYOF5Y
]		;END OF IFN ITS\D20



SUBTTL	TERPRI AND PTYO FUNCTIONS


%TERPRI:
	JUMPN T,.+3
	 PUSH P,R70
	 MOVNI T,1
	PUSH P,(P)		;EVEN THOUGH LSUBR (0 . 1)
	SOS T			;PRETEND TO BE (1 . 2) FOR PRNARG'S SAKE
	JSP F,PRNARG		;PRNARG MAY DO A POPJ FOR US - BEWARE!
SFA%	   400000,,[Q%TERPRI]		;BIT 4.9 => RETURN VALUE IS NIL
SFA$	   400000,,[SO.TRP,,Q%TERPRI]	;BIT 4.9 => RETURN VALUE IS NIL
	JRST TERP1

TRP$:	JSP F,PRNAR$
SFA%	   400000,,[QTRP$]
SFA$	   400000,,[SO.TRP,,QTRP$]
	JRST TERP1

TERPRI:	SKIPE AR1,TAPWRT	;1/4-INTERNAL TERPRI
	 HRRZ AR1,VOUTFILES
SFA$	JSP F,PRTSTR		;DO SFA CHECKING STUFF
SFA$	[SO.TRP,,]
TERP1:	JSP T,GTRDTB		;SEMI-INTERNAL TERPRI
	MOVEI A,NIL
ITERPRI:
	PUSH P,A		;INTERNAL TERPRI - SAVES A,B,C
	MOVEI TT,^M		;MUST HAVE FILE ARRAY IN AR1,
	PUSHJ P,TYO6		; READTABLE IN AR2A
	MOVEI TT,^J
	PUSHJ P,TYO6
	JRST POPAJ

PTYO:	CAIN B,TRUTH		; +TYO: SUBR 2
	 MOVE B,V%TYO		;IF T, MAKE TYO
	SKIPE V.RSET
	 JRST PTYO2
PTYO1:	MOVE TT,(A)		;FIRST ARG IS ASCII VALUE
IFN SFA,[
	MOVSI T,AS.SFA		;CHECK IF AN SFA
	TDNE T,ASAR(B)		;SFA BIT SET IN ASAR?
	 JRST PTYO3
]		;END IFN SFA
	.5LKTOPOPJ
	MOVE T,TTSAR(B)		;SECOND ARG IS FILE
	MOVEI A,TRUTH		;RETURNS T
	JRST TYOF4

PTYO2:	MOVE AR1,B
IFN SFA,[
	JSP TT,XFOSP
	 JRST TYO$		;LET *TYO GENERATE THE ERROR FOR NON-FILE
	 JRST PTYO2A	
PTYO3:	MOVEI C,(A)		;THIRD ARG IS THE FIXNUM
	MOVEI A,(B)		;FIRST ARG IS SFA ITSELF
	MOVEI B,Q%TYO		;TYO OPERATION
	JRST ISTCSH
PTYO2A:]		;END IFN SFA
	PUSHJ P,ATOFOK
	MOVE B,AR1
	UNLOCKI
	JRST PTYO1


SUBTTL	PRINT, PRIN1, PRINC, PRINT-OBJECT

PRINT:	SKIPE AR1,TAPWRT	;INTERNAL "SUBR" VERSION OF PRINT
	 MOVE AR1,VOUTFILES
SFA$	JSP F,PRTSTR		;DO SFA CHECKING STUFF
SFA$	[SO.PRT,,]
	JRST $PRINT

IFN HNKLOG,[
%PRO:				;PRINT-OBJECT SUBR (4 . 5)
PRINTOBJECT:
	JSP TT,LWNACK		;Check number of arguments
	  LA45,,Q%PRO
	CAMN T,IN0-5		;5 arguments?
	  POP P,AR1		;  Ignore it for LISPM compatability
	POP P,B			;STREAM
	POP P,AR1		;SLASHIFY-P
	POP P,C			;I-PRINLEVEL
	POP P,A			;Object
	PUSH P,[TRUE]		;Arrange to return T
	PUSH P,C		;Save these two values
	PUSH P,AR1		;From PRNARG harm and the GC
	PUSH FXP,P		;Remember our stack pointer
	PUSH P,A		;Now pretend we're a standard LSUBR (1 . 2)
	PUSH P,B
	MOVNI T,2		;Called with 2 args
	JSP F,PRNARG
SFA%	  JFCL [Q%PRO]
SFA$	  JFCL [SO.OUT,,Q%PRO]
	MOVE R,[PR.ATR,,$TYO]	;AR1 SHOULD BE SET UP BEFORE COMING HERE
	POP FXP,P		;Flush cruft PRNARG pushed
	MOVEI D,%PRO3		;Come back to %PRO3 after checking PRINLEVEL
	SKIPE V%TERPRI
	 TLZ R,PR.ATR		;TERPRI NON-NIL => NEVER AUTO-TERPRI
	JRST PRINT0

%PRO3:	POP P,A
	POP P,TT		;SLASHIFY-P
	SKIPN TT		;Is this really PRINC
	  TLO R,PR.PRC		;  Note the fact
	POP P,TT		;I-PRINLEVEL
	MOVE TT,(TT)
	MOVEM TT,PRINLV

	PUSH P,A
	JRST PRINT1		;Print it as if called by PRIN1
%PROX:

] ; END of IFN HNKLOG,

%PRINT:	 JSP F,PRNARG		;LSUBR (1 . 2)
SFA%	  JFCL [Q%PRINT]
SFA$	  JFCL [SO.PRT,,Q%PRINT]
$PRINT:	JSP T,GTRDTB		;AR1 SHOULD BE SET UP BEFORE COMING HERE
	PUSHJ P,ITERPRI
CTY1:	PUSHJ P,$PRIN1
CTY2:	%SPC%
	POPJ P,

PRIN1B:	MOVE A,B
PRIN1:	SKIPE AR1,TAPWRT	;INTERNAL "SUBR" VERSION OF PRIN1
	 MOVE AR1,VOUTFILES
SFA$	JSP F,PRTSTR
SFA$	[SO.PR1,,]
	JRST $PRIN1
%PRIN1:	
%PR1:	 JSP F,PRNARG		;LSUBR (1 . 2)
SFA%	  JFCL [Q%PR1]
SFA$	  JFCL [SO.PR1,,Q%PR1]
$PRIN1:	MOVE R,[PR.ATR,,$TYO]	;AR1 SHOULD BE SET UP BEFORE COMING HERE
%PR1A:	JSP T,GTRDTB
	PUSHJ P,PRINTY
	JRST TRUE

PRINC:	SKIPE AR1,TAPWRT	;INTERNAL "SUBR" VERSION OF PRINC
	 MOVE AR1,VOUTFILES
SFA$	JSP F,PRTSTR
SFA$	[SO.PRC,,]
	JRST $PRINC
%PRINC:	
%PRC:	JSP F,PRNARG		;LSUBR (1 . 2)
SFA%	  JFCL [Q%PRC]
SFA$	  JFCL [SO.PRC,,Q%PRC]
$PRINC:	MOVE R,[PR.PRC,,$TYO]	;AR1 SHOULD BE SET UP BEFORE COMING HERE
	JRST %PR1A

;;;	SUBR VERSIONS - *PRINT, *PRIN1, *PRINC 
IFE SFA,[
IRPS X,,[PRT$:PR1$:PRC$:]Y,,[$PRINT,$PRIN1,$PRINC]
X:	JSP F,PRNAR$
		[Q!X]

	JRST Y
TERMIN
]		;END IFE SFA

IFN SFA,[
IRPS X,,[PRT$:PR1$:PRC$:]Y,,[$PRINT,$PRIN1,$PRINC]Z,,[SO.PRT,SO.PR1,SO.PRC]
X:	JSP F,PRNAR$
		[Z,,Q!X]
	JRST Y
TERMIN
]		;END IFN SFA


SUBTTL	MAIN PRINTOUT ROUTINE

;;; ***** OKAY, OUTPUT LOVERS, HERE'S YOUR MAIN PRINT ROUTINE *****

;;; CALLED WITH OBJECT TO PRINT IN A, ADDRESS OF "TYO" ROUTINE IN R.
;;; CLOBBERS A (RETURNS GARBAGE); TO SAVE A OVER PRINTY, USE APRINT.
;;; VARIOUS BITS ARE KEPT IN THE LEFT HALF OF R.
;;; SOME ARE PASSED IN, AND OTHERS ARE INITIALIZED AND USED INTERNALLY.
PR.PRC==400000		;MUST BE SIGN BIT! 0 => PRIN1, 1 => PRINC. (PASSED IN)
PR.ATR==200000		;1 => DO AUTO-TERPRI HACKS
PR.NAS==10000 		;NOT A PSEUDO-STRING
PR.NUM==4000		;SYMBOL LOOKS LIKE A NUMBER SO FAR
PR.NVB==2000		;NOT PROVEN YET THAT VERTICAL BAR NEEDED
PR.EFC==1000		;EMBEDDED FUNNY CHARACTER IN SYMBOL FLAG (1 => NONE SEEN)
PR.NLS==400		;NOT PROVEN YET THAT LEADING SLASH NEEDED
;;; PRINTA EXPECTS B,C,T,TT,R SAFE OVER THE "TYO" ROUTINE.
;;; THE "TYO" ROUTINE GENERALLY EXPECTS AR1 AND AR2A SAFE OVER PRINTA.
;;; USES DIRECTLY OR INDIRECTLY A,B,C,T,TT,D,R,F.
;;; IN THE USELESS VERSION OF LISP, THERE ARE ABBREVIATION HACKS:
;;; PRINTY IS THE ENTRY FOR PRIN1/PRINC; ABBREVIATION IS CONTROLLED
;;; BY BIT 1.1 OF (STATUS ABBREVIATE). TYOSW INDICATES WHETHER
;;; A CHAR IS MEANT FOR TTY, FILES, OR BOTH (IN THIS WAY THE TTY
;;; CAN RECEIVE ABBREVIATIONS WHILE FILES RECEIVE FULL S-EXPRS).
;;; PRINTF IS THE ENTRY FOR FLATSIZE/EXPLODE; ABBREVIATION IS
;;; CONTROLLED BY BIT 1.2 OF (STATUS ABBREVIATE).
;;; PRINTA IS THE ENTRY FOR ALL OTHER PRINT HACKERS; IT
;;; NEVER ABBREVIATES.

IFE USELESS,[
PRINTY:	SKIPE V%TERPRI		;TERPRI NON-NIL => NEVER AUTO-TERPRI
PRINTF:			;ENTRY FOR FLATSIZE/EXPLODE
PRINTA:  TLZ R,PR.ATR	;OTHER GUYS DON'T WANT AUTO-TERPRI HACKS
PRINT3:	PUSH P,A	;MAIN RECURSIVE ENTRY FOR PRINTING
	ROT A,-SEGLOG	;NOTE THAT A IS SAFE ON PDL
 	SKIPL TT,ST(A)	;MUST DO A ROT, NOT LSH! SEE PRINX
	 JRST PRINX
	%LPAR%		;PRINT A LIST. FIRST TYO A (
PRINT4:	HLRZ A,@(P)
IFN HNKLOG,[
	TLNE TT,HNK
	 JRST PRINH0
PRINH6:
]		;END OF IFN HNKLOG
	PUSHJ P,PRINT3	;NOW PRINT CAR OF THE LIST
	HRRZ A,@(P)
	JUMPE A,PRIN8A	;IF CDR IS NIL, NEED ONLY A )
PRIN7A:	MOVEM A,(P)
	%SPC%		;ELSE SPACE IN BETWEEN
	LSH A,-SEGLOG	;WE KNOW A IS NON-NIL!
 	SKIPGE TT,ST(A)
	 JRST PRINT4	;IF CDR IS NON-ATOMIC, LOOP
	%DOT%		;ELSE DOTTED LIST
	%SPC%
	PUSHJ P,PRIN1A	;SO PRINT THE ATOM AFTER THE LISP DOT
PRIN8A:	%RPAR%		;NOW TYO A )
	JRST POP1J
]		;END OF IFE USELESS


IFN USELESS,[

PRINTY:	MOVEI D,PRINT1		;ENTRY FOR PRIN1/PRINC
	SKIPE V%TERPRI
	 TLZ R,PR.ATR		;TERPRI NON-NIL => NEVER AUTO-TERPRI
	JRST PRINT0

PRINTF:	MOVEI D,PRINT2		;ENTRY FOR FLATSIZE/EXPLODE
	TLZ R,PR.ATR
	JRST PRINT0

APRINT:	PUSH P,A
	PUSH P,CPOPAJ
PRINTA:	MOVEI D,PRIN3A	;ENTRY FOR NO ABBREVIATIONS
	TLZ R,PR.ATR
PRINT0:	PUSH P,A	;CLOBBERS ARG (RETURNS GARBAGE)
	SKIPN V.RSET	;IF IN *RSET MODE, CHECK VALUES OF
	 JRST PRIN0A	; PRINLEVEL AND PRINLENGTH
IRP X,,[%LEVEL,%LENGTH]Y,,[%LV,%LN]
Y!CHK:	SKIPN A,V!X	;NIL IS A VALID VALUE
	 JRST PRT!Y
	SKOTT A,FX
	 JRST Y!ERR
	SKIPGE (A)
	 JRST Y!ERR
PRT!Y:
TERMIN
PRIN0A:	SETOM PRINLV	;PRINLV HAS <ACTUAL PRINT LEVEL>-1
	SETZM ABBRSW	;ASSUME ABBRSW ZERO
	JSP T,RSXST
	MOVEI A,LRCT-2	;GET (STATUS ABBREVIATE)
NW%	HRRZ T,@RSXTB
NW$	LDB T,[001120,,RSXTB]	;PICK UP CHTRAN
	HRRZ A,(P)	;MUST LEAVE ARG IN A FOR PRINT3, %PRO3
	SETZM PRPRCT
	JRST (D)	;DISPATCH TO PRINT1, PRINT2, PRINT3, %PRO3

PRINT1:	SETOM ABBRSW	;PRIN1/PRINC
	 SKIPE TAPWRT	;OPEN FILES? WHETHER OR NOT TO ABBREVIATE THEM
	  JRST PRIN1Q
	SKIPN TTYOFF	;IF NO FILES OPEN, THEN ABBREVIATE FOR TTY
	 JRST PRIN3A
PRIN1Q:	TRNN T,1	;ULTIMATE DECISION ON FILE ABBREVIATION
	 HRRZS ABBRSW	; COMES FROM (STATUS ABBREVIATE)
	JRST PRIN3A

PRINT2:	TRNE T,2	;FLATSIZE/EXPLODE - DECIDE WHETHER IT
	 SETOM ABBRSW	; WANTS ABBREVIATION OR NOT
	JRST PRIN3A

PRINT3:	PUSH P,A	;MAIN RECURSIVE ENTRY FOR PRINTING
PRIN3A:	ROT A,-SEGLOG	;NOT LSH! SEE PRINX
	SKIPL TT,ST(A)
	 JRST PRINX	;IF SO, USE AN ATOM PRINTER
IFN HNKLOG,[
	TLNN TT,HNK	;Is this a hunk?
	  JRST PRN3NH	;  Nope...
	PUSH FXP,PRPRCT
	PUSH FXP,FLAT1	;If for some totally random reason it called FLATSIZE..
	MOVE A,(P)
	PUSH P,TT 	;TT get's used WAY WAY below!
	PUSHJ P,USRHNP	;Is this a user hunk?
	POP P,TT
	POP FXP,FLAT1
	POP FXP,PRPRCT
	JUMPE T,PRN3NH	;If not, just print an ordinary hunk
	MOVEI T,FLAT2
	MOVEI B,FLATO2
	CAIE B,(R)	;Is this really a FLATSIZE hack?
	  CAIN T,(R)
	    JRST FLTHNK	;  Yes, just get the FLATSIZE and add it in
	MOVEI B,TRUTH	;Say this comes from PRINT
	PUSH FXP,PRINLV ;Don't let calls to FLATSIZE screw us!
	PUSHJ P,SENDFL	;Send the message to the frob
	POP FXP,PRINLV
	MOVE T,(A)	;Get the size
	PUSHJ P,PRINLP	;print all necessary lparens
	MOVE A,(P)	;Recover the object
	PUSHJ P,SENDPR	;Send it to the frob
	JRST POP1J

FLTHNK:	SETZ T,
	PUSHJ P,PRINLP	;Be sure to get any needed parens out there
	PUSH FXP,FLAT1	;Remember how much we got so far
	MOVEI A,FLATO2	;For test
	SETZ B,		;We are really comming from FLATSIZE
	CAIN A,(R)	;Is this from FLATSIZE-OBJECT with PRINTP T?
	  MOVEI B,TRUTH	;  Yes, we're really a recursive call from PRINT
	MOVE A,(P)	;Recover our object from the stack
	PUSHJ P,SENDFL	;Send the message to the frob
	MOVE TT,(A)	;Get the result
	POP FXP,FLAT1	;Recover flatsize-so-far
	ADDM TT,FLAT1	;and add them up
	JRST POP1J

SENDFL:	PUSH P,AR1
	MOVE AR1,B		;Get whether from PRINT
	MOVEI B,QFLATSIZE
	JRST SENDP1

SENDPR:	PUSH P,AR1
	MOVEI B,Q%SLFPR
SENDP1:	SOVE AR2A R
	PUSH FXP,PRPRCT	;Save pending RPAREN count
	PUSH FXP,PRINLV	;And paren level
	PUSHJ P,[PUSH P,A	;Object
		 PUSH P,B	;Message
		 TLNN AR1,200000	;If 200000 is not set, then we are
		  SETZI AR1,		;printing to the TTY and OUTFILES
					;so a stream of NIL will suffice.
		 MOVEI AR1,(AR1)	;Eliminate flags from left half
		 PUSH P,AR1	;stream or printp if FLATSIZE
		 MOVEI A,(FXP)	;Fixnum level
		 PUSH P,A
		 PUSH P,NIL	;No slashification
		 MOVEI T,TRUTH
		 SKIPL R		;Are we doing PRIN1 instead of PRINC?
		   MOVEM T,(P)	;  Then say to do slashification
		 MOVNI T,5
		 XCT SENDI	;Ask the SEND interpreter
		 ]
SNDPR0:	POP FXP,PRINLV
	POP FXP,PRPRCT
	RSTR R AR2A AR1
	POPJ P,

PRN3NH:
]; END IFN HNKLOG,

	MOVE T,TYOSW	;Save old value of TYOSW
	HRLM T,-1(P)	; (I.E. that of previous level)
	JUMPN T,PRINT4	;If previous level was non-abbrev,
	SKIPN ABBRSW	; Or if we don't ever want abbrev,
	 JRST PRINT4	; Then needn't try to abbrev!
	AOS T,PRINLV	;Else increment level count
	SKIPE V%LEVEL	;If PRINLEVEL=NIL, or if actual level
	 CAMGE T,@V%LEVEL  ; Is less, then don't abbrev
	  JRST PRINT4
	SKIPL ABBRSW
	 SETOM TYOSW
	CAME T,@V%LEVEL	;If we're exactly equal to PRINLEVEL,
	 JRST PRIN3F
	MOVEI T,1
	PUSHJ P,PRINLP
	%NMBR%		; SHOOT OUT LEVEL ABBREVIATION
PRIN3F:	SKIPGE ABBRSW	;IF WE ONLY WANT ABBREVIATION,
	 JRST PRINT9	; NEEDN'T GROVEL OVER THE SUBLIST
	HRRZS TYOSW	;ELSE SIGNAL NON-ABBREV ONLY MODE
PRINT4:	PUSH FXP,PRPRCT	;SAVE PARENS COUNTS
	HLLOS PRPRCT	;CLEAR RIGHT PARENS COUNT, AND
	AOS PRPRCT	; INCREMENT LEFT PARENS COUNT
	PUSH FXP,XC-1	;<ACTUAL PRINT LENGTH>-1 FOR THIS LEVEL
	MOVE T,TYOSW	;SAVE CURRENT TYOSW (DETERMINES WHETHER
	HRLM T,(P)	; ABBREV MODE OUTPUT WANTS A ) AT END)
PRINT5:	SKIPN TYOSW	;IF WE ARE IN NON-ABBREV ONLY MODE,
	 SKIPN ABBRSW	; OR IF WE NEVER WANT ABBREV,
	  JRST PRINT7	; THEN DON'T TRY TO ABBREV!
	AOS T,(FXP)	;ELSE INCREMENT PRINT LENGTH
	SKIPE V%LENGTH	;IF PRINLENGTH=NIL, OR IF WE'RE LESS
	 CAMGE T,@V%LENGTH	; THAN IT, THEN DON'T ABBREV
	  JRST PRINT7
	SKIPL ABBRSW
	 SETOM TYOSW
	CAME T,@V%LENGTH
	 JRST PRINT6	;IF WE'RE EXACTLY EQUAL, THEN ABBREV
	MOVEI T,3
	PUSHJ P,PRINLP
REPEAT 3, %DOT%
PRINT6:	SKIPGE ABBRSW	;IF WE DON'T WANT NON-ABBREV ONLY MODE,
	 JRST PRINT8	; THEN CAN IGNORE REST OF LIST
	HRRZS TYOSW	;ELSE SIGNAL NON-ABBREV ONLY MODE
PRINT7:	HRRZ A,(P)
	HRRZ B,(A)
	HLRZ A,(A)
	HRRZ T,-1(FXP)
	ADDI T,1
	SKIPN B
	 HRRM T,PRPRCT
IFN HNKLOG,[
	TLNE TT,HNK
	 JRST PRINH0
PRINH6:
]		;END OF IFN HNKLOG
	PUSHJ P,PRINT3	;SO PRINT THE CAR OF THE LIST
	SETZM PRPRCT
	HRRZ A,(P)
	HRRZ A,(A)
	JUMPE A,PRINT8	;IF CDR IS NIL, NEED ONLY A ) NOW
PRIN7A:	HRRM A,(P)
	%SPC%		;ELSE SPACE BETWEEN
	LSH A,-SEGLOG
	SKIPL TT,ST(A)
	 JRST PRIN7B		; IF AN ATOM, THEN NEED A DOT
	TLNN TT,HNK		; IF NOT A HUNK, THEN A CDR WHICH IS A LIST,
	 JRST PRINT5		;  SO LOOP.  ELSE, WE HAVE A DOTTED LIST
PRIN7B:	%DOT%
	%SPC%
	HRRZ T,-1(FXP)
	ADDI T,1
	MOVEM T,PRPRCT
	HRRZ A,(P)      ;SET UP A WITH CDR-OBJECT TO PRINT (HUNK OR ATOM)
	PUSHJ P,PRINT3	;JUMP TO GENERAL RECURSIVE PRINTER
PRINT8:	HLRZ T,(P)	;THIS WILL TELL TYO WHAT TO
	MOVEM T,TYOSW	; DO WITH THE )
PRIN8A:	%RPAR%		;TYO A ) TO END THE LIST

IFE USELESS, PRIN8B:	;A normally useless symbol

	SUB FXP,R70+1
	POP FXP,PRPRCT
PRINT9:	HLRZ T,-1(P)	;RESTORE TYOSW TO WHAT IT WAS
	MOVEM T,TYOSW	; ON LAST (RECURSIVE!) ENTRY
	JUMPN T,POP1J	;IF AND ONLY IF WE AOS'ED PRINLV,
	SKIPE ABBRSW	; WE MUST NOW SOS IT, AND THEN POP1J
	 SOS PRINLV
	JRST POP1J
]		;END OF IFN USELESS

SUBTTL	PRINT A HUNK

IFN HNKLOG,[

PRINH0:	SKIPN VHUNKP			;IF HUNKP IS NIL, THEN PRINT A HUNK
	 JRST PRINH6			; AS IF IT WERE A LIST CELL

IFE USELESS,[
	PUSHJ P,USRHNP		;Is this a user's extended hunk?
	JUMPE T,PRINH8

	PUSHJ P,SENDPR
	JRST PRIN8B

PRINH8:
]; -- END of IFE USELESS,

	HRRZS TT		   ;Flush left half
	CAIN TT,QHUNK0
	 CAIE A,-1
	  JRST .+2
	   JRST PRHN3B
	PUSH FXP,TT
	PUSHJ P,PRINT3			;PRINT FIRST ELT
IFN USELESS,	SETZM PRPRCT
	POP FXP,TT
	MOVSI T,-1
   2DIF [LSH T,(TT)]0,QHUNK0
	HRR T,(P)
	ADD T,R70+1
	JUMPGE T,PRHN3A			;"HUNK2" CASE, WITH 2 ELEMENTS
	PUSH P,T
PRINH2:	MOVEM T,(P)
PRHN2B:	HRRZ A,(P)
	HRRZ A,(A)
	CAIN A,-1
	 JRST PRINH3
	%SPC%
	%DOT%
	%SPC%
	PUSHJ P,PRINT3
	HRRZ A,(P)
	HLRZ A,(A)
	CAIN A,-1
	 JRST PRINH3
	%SPC%
	%DOT%
	%SPC%
	PUSHJ P,PRINT3
	MOVE T,(P)
	AOBJN T,PRINH2
PRINH3:	SUB P,R70+1		;FINISHED WITH HUNK (EXCEPT FOR CDR)
PRHN3A:	%SPC%
	%DOT%
	%SPC%
PRHN3B:	HRRZ A,(P)
	HRRZ A,(A)
	PUSHJ P,PRINT3
	%SPC%
	%DOT%
	JRST PRIN8A


]		;END OF IFN HNKLOG

SUBTTL	PRINT ATOM DISPATCH, AND PRINT AN ARRAY OR A RANDOM

PRINX:	PUSH P,CPOP1J		;PRINT AN ATOM (ON THE PDL)
PRIN1A:				;TT HAS ST ENTRY
	HRRZ A,-1(P)		;NIL IS SYMBOL, NOT RANDOM!!!
	JUMPE A,PRINIL
   2DIF JRST (TT),.,QLIST	.SEE STDISP	;TT MUST HAVE ST ENTRY
PRIN1Z:	JRST PRINI	;FIXNUM
	JRST PRINO	;FLONUM
BG$	JRST PRINB	;BIGNUM
	JRST PRINN	;SYMBOL
HN$  REPEAT HNKLOG+1, .VALUE	;HUNKS
	JFCL		;RANDOM
IFN .-PRIN1Z-NTYPES+2, WARN [WRONG LENGTH TABLE]
IFN USELESS,[
	MOVEI T,25.
	PUSHJ P,PRINLP
	SETZM PRPRCT
]		;END OF IFN USELESS
	%NMBR%		;ARRAY (AND RANDOM)
	TLNN TT,SA
	 JRST PRINX5
	HRRZ A,-1(P)
	MOVE TT,ASAR(A)
	CAIE TT,ADEAD
	 JRST PRINA2
	SKIPA TT,[440700,,[ASCIZ \DEAD-ARRAY\]]
PRINA1:	 PUSHJ P,(R)
	ILDB A,TT
	JUMPN A,PRINA1
	POPJ P,

PRINA2:	TLNE TT,AS<FIL>
	 JRST PRNFL
	TLNE TT,AS<JOB>
	 JRST PRNJB
SFA$	TLNE TT,AS.SFA		;SFA?
SFA$	 JRST PRNSR
	JFFO TT,.+1
	HRRZ A,ARYTYP(D)
	TLC TT,AS<SX>		;CROCK FOR NSTORE ARRAYS
	TLNN TT,AS<SX+GCP>
	 SETZ A,
	PUSHJ P,PRINSY
	%NEG%
	HRRZ A,-1(P)
	LDB F,[TTSDIM,,TTSAR(A)]
PRINA3:	HRRZ A,-1(P)
	MOVNI TT,(F)
	MOVE TT,@TTSAR(A)
IFE USELESS,	MOVE C,@VBASE		;BETTER BE A FIXNUM!
IFN USELESS,[
	HRRZ C,VBASE
	CAIE C,QROMAN
	 SKIPA C,(C)
	  PUSHJ P,PROMAN
]		;END OF IFN USELESS
	   PUSHJ P,PRINI9
	SOJE F,PRINA4
	%CLN%
	JRST PRINA3
PRINA4:	%NEG%
PRINX5:	HRRZ TT,-1(P)
PRINL4:	MOVEI C,10	;N BASE 8
	JRST PRINI3


SUBTTL	PRINT A FILE OBJECT, PRINT A JOB OBJECT, PRINT AN SFA

;;; PRINT A JOB OBJECT AS #JOB-|<NAME>|-<ADDRESS>
;;; PRINT A FILE OBJECT AS #FILE-<DIR>-|<NAME>|-<ADDRESS>
;;; PRINT AN SFA AS #SFA-|<SFA-PRINTNAME>|-<ADDRESS>
;;; WHERE <DIR> IS "IN" OR "OUT", <NAME> IS THE TRUENAME,
;;; <SFA-PRINTNAME> IS THE THING GIVEN AS THE THIRD ARG TO CREATE-SFA
;;; AND <ADDRESS> IS THE OCTAL ADDRESS OF THE SAR.

IFN SFA,[
PRNSR:	MOVEI T,[ASCIZ \SFA-\]
	JRST PRNF5
]		;END IFN SFA
PRNJB:	MOVEI T,[ASCIZ \JOB-\]
	JRST PRNF5
PRNFL:	MOVEI T,[ASCIZ \FILE-\]
PRNF5:	PUSHJ P,PRNSTO
	HRRZ A,-1(P)
	MOVE TT,ASAR(A)
SFA$	TLNE TT,AS.SFA		;SFA?
SFA$	 JRST PRNSR1		;YES, PRINT DIFFERENTLY
	PUSH FXP,TT
	TLNE TT,AS.JOB		;DON'T PRINT DIR FOR JOB ARRAY
	 JRST PRNF6
	MOVE TT,TTSAR(A)
;FORMERLY, THIS ROUTINE USED PRINSY TO PRINT IN OR OUT.  BUT, SINCE THIS
;ROUTINE CAN BE CALLED FROM THE GARBAGE COLLECTOR, THE POINTERS COULD BE
;MARKED AND THEREFORE INVALID.  TO AVOID PRINTING LOSSAGE, PRINTING IS DONE
;MANUALLY.
	MOVEI T,[ASCII \IN\]	;ASSUME INPUT FILE
	TLNE TT,TTS<IO>
	 MOVEI T,[ASCII \OUT\]
	PUSHJ P,PRNSTO
	%NEG%
PRNF6:	%VBAR%
	POP FXP,T		    ;SAVED ASAR
	MOVNI TT,LPNBUF
	PUSH FXP,PNBUF+LPNBUF(TT)   ;UNFORTUNATELY, SOMEONE MIGHT BE USING 
	AOJL TT,.-1		    ; PNBUF, SO WE MUST SAVE IT
	HRRZ A,-1(P)
	PUSH FXP,R
20$	MOVE TT,TTSAR(A)	;FOR D20 CLOSED FILE NEEDS SPECIAL HANDLING
20$	TLNN TT,TTS.CL		;CLOSED? (ASAR SAVED IN T)
	TLNE T,AS.JOB		;DON'T GET TRUENAME FOR JOB ARRRAYS
	 JRST PRNJ1
	PUSHJ P,TRU6BT		;GET TRUENAME OF FILE ON FXP
PRNJ2:	PUSHJ P,6BTNSL		;CONVERT THAT TO A NAMESTRING IN PNBUF
	POP FXP,R
	MOVEI TT,-LPNBUF+1(FXP)
	MOVSI T,-LPNBUF
PRNF1:	MOVE D,PNBUF(T)		;SWAP PNBUF WITH COPY ON PDL
	EXCH D,(TT)
	MOVEM D,PNBUF(T)
	ADDI TT,1
	AOBJN T,PRNF1
	MOVEI T,-LPNBUF+1(FXP)
	PUSHN FXP,1			;BE SURE STRING ENDS WITH ZEROS
	PUSHJ P,PRNSTO
	POPI FXP,LPNBUF+1		;POP THE CRUD
	%VBAR%
	JRST PRINA4

PRNSTO:	HRLI T,440700
	ILDB A,T
	JUMPE A,CPOPJ
	PUSHJ P,(R)
	JRST .-3

PRNJ1:	HRRZ TT,TTSAR(A)
	HRLI TT,-L.F6BT
20%	PUSH FXP,F.RDEV(TT)
20$	PUSH FXP,F.DEV(TT)
	AOBJN TT,.-1
	JRST PRNJ2
IFN SFA,[
PRNSR1:	%VBAR%
	MOVEI TT,SR.PNA		;GET THE PNAME
	HRRZ A,-1(P)		;PICK UP ARRAY POINTER
	HRRZ A,@TTSAR(A)
	PUSH FXP,R		;REMEMBER R OVER RECURSIVE CALL TO PRINT
	TLO R,PR.PRC
	PUSHJ P,PRINTA		;PRINT THE NAME
	POP FXP,R
	%VBAR%
	JRST PRINA4
]		;END IFN SFA

SUBTTL	PRINT AN ATOMIC SYMBOL

;PRINIL:
;IFN USELESS, PUSHJ P,PLP1
;	MOVEI A,"(		;PRINT () FOR NIL
;	PUSHJ P,(R)
;	MOVEI A,")
;	JRST (R)

PRINSY:	PUSH P,A
	PUSH P,CPOP1J
	JUMPE A,PRINIL
PRINN:	SKIPA A,-1(P)
PRINIL:	 MOVEI A,[$$$NIL,,]
	JSP C,MAPNAME
	JUMPGE R,PRNN2		.SEE PR.PRC
IFN USELESS,	PUSHJ P,PLP1
PRNN1:	JSP C,(C)		;FOR PRINC, JUST OUTPUT THE CHARS
	 POPJ P,
	MOVEI A,(TT)
	PUSHJ P,(R)
	JRST PRNN1

PRNN2:
	TLO R,PR.NAS+PR.NVB+PR.NUM+PR.EFC+PR.NLS
	MOVE A,-1(P)
	PUSH P,B
	MOVEI B,Q%ISM
	PUSHJ P,GET1
	SKIPE A
	 TLZ R,PR.NAS+PR.NVB
	POP P,B
	JSP C,(C)		;GET FIRST CHAR
	 JRST PRNN2A		;FOR NULL PNAME, JUST PRINT HANGING LEFT PARENS
	SETZ F,			;F COUNTS: <# SLASHES,,# CHARS>
	HRRZ A,VREADTABLE
	MOVE D,@TTSAR(A)
	TLNN D,14		;IF NOT A DIGIT OR A SIGN,
	 TLZ R,PR.NUM		; THEN IT ISN'T NUMBER-LIKE
	TLNN D,400		;IF NOT SLASHIFIED AS FIRST CHAR,
	 AOJA F,PRNN3A		; JUST BUMP CHAR COUNTER
	TLZ R,PR.EFC		;ELSE ONE FUNNY CHAR SEEN ALREADY
	TLNE D,171000		;REAL WEIRDIES FORCE VERTICAL BARS
	 TLZ R,PR.NVB
PRNN3:	ADD F,R70+1		;BUMP CHAR COUNT AND SLASH COUNT
PRNN3A:	JSP C,(C)		;GET NEXT CHAR
	 JRST PRNN4
	MOVE D,@TTSAR(A)
	TLNN D,24		;IF IT LOOKS LIKE A NUMBER SO FAR
	 TLZN R,PR.NUM		; BUT THIS NEXT CHAR ISN'T DIGIT OR ARROW,
	  JRST PRNN3B
	TRNE F,777770		; THEN WE NEED A LEADING SLASH IF THERE WERE
	 TLZ R,PR.NLS		; MORE THAN SEVEN LEADING NUMBER-LIKE CHARS
PRNN3B:	TLNN D,100		;IF NOT SLASHIBLE IN FIRST POSITION,
PRNN3C:	 AOJA F,PRNN3A		; JUST BUMP CHAR COUNTER
	TLNN D,2000		;VERTICAL BARS CAN'T HELP A SLASH
	 CAIN TT,"|		; OR VERTICAL BAR, SO COUNT THEM AS
	  AOJA F,PRNN3C		; TWO CHARACTERS AND NO SLASHES
	TLNN D,171000		;REAL WEIRDIES
	 TLZN R,PR.EFC		; OR TWO EMBEDDED FUNNY CHARS
	  TLZ R,PR.NVB		; FORCE VERTICAL BARS
	JRST PRNN3

PRNN4:	CAIN F,1		;A SIGN WITH NO FOLLOWING
	 TLNN D,10		; DIGITS DOESN'T NEED A SLASH
	  CAIA
	   JRST PRNN4A
	TLNE R,PR.NUM		;IF THE WHOLE THING IS NUMBER-LIKE,
	 TLZ R,PR.NLS		; THEN DEFINITELY NEED A LEADING SLASH
PRNN4A:	MOVEI T,2(F)
	TLNN R,PR.NVB
	 JRST PRNN4B
	HLRZ T,F		;WE AREN'T USING VERTICAL-BARS OR DOUBLE-QUOTES
	ADDI T,1(F)		; SO MUST COMPUTE UP ROOM TAKEN BY
	TLNN R,PR.NLS		; CHARS AND SLASHES, PLUS ONE FOR THE SPACE
	 ADDI T,1		; WHICH MAY FOLLOW
PRNN4B:	PUSHJ P,PRINLP
	SKIPN A,-1(P)
	 MOVEI A,[$$$NIL,,]
	JSP C,MAPNAME
	TLNE R,PR.NVB
	 JRST PRNN6
	TLNN R,PR.NAS		;IF USING |'S OR "'S THEN OUTPUT LEADING ONE
	 JRST [ %DBLQ% 
		JRST PRNN5 ]
	%VBAR%	
PRNN5:	JSP C,(C)
	 JRST PRNN5X
	CAIN TT,^M
	 JRST PRNN5A
	TLNN R,PR.NAS
	 JRST [ CAIN TT,""	;WITHIN A PSEUDO-STRING, "'S MUST BE SLAHSED
		 JRST PRNN5A
		JRST PRNN5B ]
	CAIN TT,"|		;NOT IN A PSEUDO-STRING, SO |'S MUST BE SLASHED
	 JRST PRNN5A
PRNN5B:	MOVE A,VREADTABLE
	MOVE D,@TTSAR(A)
	TLNE D,2000
PRNN5A:	 %SLSH%
	MOVEI A,(TT)
	PUSHJ P,(R)
	JRST PRNN5

PRNN5X:	TLNN R,PR.NAS
	 JRST [ %DBLQ% 
		POPJ P, ]
	%VBAR%
	POPJ P,

PRNN6:	MOVEI F,400
PRNN6A:	JSP C,(C)
	 POPJ P,
20$	PUSH P,B		;B MUST BE PRESERVED
	MOVE A,VREADTABLE
	MOVE D,@TTSAR(A)
	TLOE R,PR.NLS
	 TLNE D,(F)
	  %SLSH%
	MOVEI A,(TT)
	PUSHJ P,(R)
20$	POP P,B
	MOVEI F,100
	JRST PRNN6A


PRNN2A:
IFN USELESS,[
	HLRZ T,PRPRCT
PRNN2B:	SOJL T,PRNN2C
	%LPAR%
	JRST PRNN2B
PRNN2C:	HRRZS PRPRCT
]	;END OF IFN USELESS
	TLNN R,PR.NAS
	 JRST [	%DBLQ%		;FOR NULL PSEUDO-STRING, PRINT ""
		%DBLQ%
		JRST PLP1 ]
	%VBAR%			;FOR NULL PNAME, PRINT ||
	%VBAR%
	JRST PLP1


;;; COROUTINE TO DELIVER UP CHARACTERS OF A PRINT NAME.
;;; USES JSP C,(C) TO CALL.  USES B, T; YIELDS CHARS IN TT.
;;; SETUP USES A.  SKIPS UNLESS NO MORE CHARS.

MAPNAME:
	HLRZ B,(A)
	HRRZ B,1(B)
	JSP C,(C)
MAPNM1:	HLRZ T,(B)
	MOVE T,(T)
	TRZ T,1			;FORCE OFF LOW ORDER BIT, IS UNUSED IN ASCII
MAPNM2:	SETZ TT,
	ROTC T,7
	SKIPN T			;ONLY CHECK FOR NULLS IF AT THE END OF THE WORD
	 JUMPE TT,MAPNM3
	JSP C,1(C)
	JRST MAPNM2

MAPNM3:	HRRZ B,(B)
	JUMPN B,MAPNM1
	JRST (C)


;;; ROUTINE TO FEED FORMATTING INFORMATION TO TYO IF DESIRED,
;;; THEN PRINT ANY PENDING LEFT PARENTHESES.
;;; THE LENGTH OF THE ATOM TO BE PRINTED IS IN T.
;;; USES ONLY A AND T.

PRINLP:	TLNN R,PR.ATR
	 JRST PLP1
IFN USELESS,[
	MOVSI T,(T)
	ADD T,PRPRCT
	HLRZ T,T
	ADD T,PRPRCT
]		;END OF IFN USELESS
	TRNE T,777000
	 MOVEI T,777
	HRROI A,1(T)		;ALLOW FOR FOLLOWING SPACE
	 PUSHJ P,(R)
PLP1:				.SEE PRNN1
IFE USELESS,	POPJ P,
IFN USELESS,[
	HLRZ T,PRPRCT
PRINLQ:	SOJL T,CPOPJ
	%LPAR%
	JRST PRINLQ
]		;END OF IFN USELESS

SUBTTL	PRINT A FIXNUM

PRINI:	MOVE A,VBASE
IFN USELESS,	CAIN A,QROMAN
IFN USELESS,	 JRST PRINRM
	SKOTT A,FX
	 JRST BASER
	MOVE C,(A)		;TRUE VALUE OF BASE IN C
	CAIG C,36.
	 CAIGE C,2
	  JRST BASER
PRI2D:	HRRZ A,-1(P)
	JSP T,FXNV1		;THE TYO ROUTINE MUST SAVE TT HERE
IFN USELESS,[
	MOVMS TT		;ESTIMATE LENGTH OF FIXNUM
	JFFO TT,.+2		; ASSUMING OCTAL BASE
	 MOVEI D,43
	MOVNI T,3
	IDIVM D,T		;AVOID CLOBBERING EXTRA ACS
	ADDI T,14
	SKIPGE @-1(P)		;ALLOW FOR MINUS SIGN
	 ADDI T,1
	PUSHJ P,PRINLP
	MOVE TT,@-1(P)
]		;END OF IFN USELESS
	CAIN C,8		;FOR OCTAL NUMBERS, WE MAY WANT
	 JRST PRI2B		; TO USE A FUNNY SHIFTED FORMAT
PRI2C:	JUMPL TT,PRI2Q
	SKIPE V.NOPOINT
	 JRST PRINI2		;HAPPY PRATT?
	CAILE C,10.
	 %POS%
	JRST PRINI2

PRI2Q:	%NEG%
PRI2A:	MOVNS TT
PRINI2:	JSP T,PRI.		;INSERT DECIMAL POINT IF NECESSARY
PRINI9:	MOVEI T,1		;MUST SAVE F - SEE GCPNT1, GCWORRY
	TLZN TT,400000		;IF NUMBER COULD BE MOBY, THEN MOVE HIGH ORDER BIT
PRINI3:	 SETZ T,		.SEE FP4B1	;MUSTN'T DISTURB B
	JSP D,PRINI5
	SKIPE TT,T
	 PUSHJ P,PRINI3
FP7A1:	HLRZ A,(P)
FP7B:	MOVEI A,"0(A)
	CAIE A,".
	 JRST (R)
	%DCML%
	POPJ P,

PRINI5:	DIVI TT-1,(C)
	CAILE TT,9
	 ADDI TT,"A-"9-1	;KLUDGY DIGITS GREATER THAN 9 ARE "A, B, C, ..., Y, Z"
PRINI7:	HRLM TT,(P)
	JRST (D)

PRI.:	CAIN C,10.		;IF THE RADIX IS 10.
	 SKIPE V.NOPOINT	; AND *NOPOINT IS NOT SET,
	  JRST (T)		; THEN KLUDGILY ARRANGE
	HRLI T,".-"0		; TO PRINT A "." AFTER THE
	HLLM T,(P)		; DIGITS ARE PRINTED
	PUSH P,[FP7A1]
	JRST (T)

PRI2B:	MOVM D,TT
	TRNN D,777
	 TLNN D,-1
	  JRST PRI2C
	MOVEI T,(C)
	MOVE C,VREADTABLE
	MOVE D,TT
	MOVEI TT,LRCT-1		;RH OF LAST RCT ENTRY IS (STATUS _)
	HRRZ C,@TTSAR(C)
	EXCH T,C
	MOVE TT,D
	JUMPE T,PRI2C
	MOVNI D,11		;PRINT OUT AS ONE OF:
	TRNE TT,777000		;	NNNNNNNNN_11
	 JRST PRI2B3		;	NNNNNN_22
	MOVNI D,22		;	NNN_33
	TLNN TT,777		;	N_41
	 MOVNI D,33		; IN ORDER THAT LOSERS NEED NOT
	TLNN TT,77777		; COUNT ALL THE ZEROS OF AN
	 MOVNI D,41		; OCTAL NUMBER.
PRI2B3:	ASH TT,(D)
	PUSH FXP,D
	PUSHJ P,PRI2C
	%BAK%
	POP FXP,TT
	JRST PRI2A

IFN USELESS,[
PROMAN:	AOS (P)
	JRST PRINR0

PRINRM:	HRRZ A,-1(P)
	JSP T,FXNV1
PRINR0:	MOVEI C,10.
	JUMPLE TT,PRI2D
	CAIL TT,4000.
	JRST PRI2D
	MOVEI T,15.
	PUSHJ P,PRINLP
	SETZ T,
PRINR1:	IDIVI TT,10.
	HRLM D,(P)
	ADDI T,1
	JUMPE TT,PRINR2
	PUSHJ P,PRINR1
PRINR2:	HLRZ TT,(P)
	SUBI T,1
	JUMPE TT,CPOPJ
	CAIE TT,9
	JRST PRINR3
	HLRZ A,PRINR9(T)
	PUSHJ P,(R)
	HLRZ A,PRINR9+1(T)
	JRST (R)

PRINR3:	CAIE TT,4
	JRST PRINR4
	HLRZ A,PRINR9(T)
	PUSHJ P,(R)
	HRRZ A,PRINR9(T)
	JRST (R)

PRINR4:	CAIGE TT,5
	JRST PRINR6
	SUBI TT,5
	HRRZ A,PRINR9(T)
PRINR5:	PUSHJ P,(R)
PRINR6:	SOJL TT,CPOPJ
	HLRZ A,PRINR9(T)
	JRST PRINR5

PRINR9:	"I,,"V
	"X,,"L
	"C,,"D
	"M,,
]		;END OF IFN USELESS

SUBTTL	PRINT A FLONUM 


PRINO:
IFN USELESS,[
	MOVEI T,17.		;GROSS ESTIMATE OF LENGTH OF FLONUM
	PUSHJ P,PRINLP
]		;END OF IFN USELESS
	MOVE T,@-1(P)
;A FLONUM TO PRINT IS IN T
FP0:
FP0A:	JUMPGE T,FP0B
	%NEG%
	MOVNS T
FP0B:
;A POSITIVE FLONUM TO PRINT IS IN T; 
FP1:
	SETZB TT,F		;TT IS SECOND WORD FOR T; F WILL BE EXPONENT
	CAMGE T,[0.01]
	 JRST FP4		;0.01 (OR 0.1) AND 1.0^8 ARE CHOSEN SO THAT THE
	CAML T,[1.0^8]		; FRACTIONAL PART WILL HAVE AT LEAST ONE
	 JRST FP4E0		; BIT, BUT NOT LOSE ANY OFF THE RIGHT END
;A POSITIVE FLONUM BETWEEN .01 AND 1.0^8 IS IN T
FP3:	SETZB TT,D
	ASHC T,-33		;SPLIT EXPONENT PART OFF - MANTISSA IN TT
	ASHC TT,-243(T)		;SPLIT NUMBER INTO INTEGRAL AND FRACTIONAL PART
	MOVSI F,200000		;COMPUTE POSITION OF LAST SIGNIFICANT BITS
	ASH F,-243+<43-33>(T)	;F GETS A VALUE EQUAL TO 1/2 LSB
	PUSH FXP,F
	PUSH FXP,D		;SAVE FRACTION
	MOVEI C,10.		;PRINT INTEGER PART AS A DECIMAL FIXNUM
	PUSHJ P,PRINI3
	%DCML%			;PRINT DECIMAL POINT
	POP FXP,TT
;NOW TT HAS FRACTION INFO BITS, AND (FXP) HAS SLIDING MASK BIT (TOLERANCE)
FP3A:	MOVE T,TT		;REMAINING INFO BITS IN TT
	MULI T,10.		;T GETS NEXT DIGIT TO PRINT, MORE OR LESS
	POP FXP,F
	JFCL 8,.+1		;CLEAR OVERFLOW
	IMULI F,10.		;OVERFLOW ON (FSC 231400000001 0) AND (FSC 175631463150 0)
	JFCL 8,FP3A1		;CUT OFF WHEN MASK BIT OVERFLOWS
	CAMGE TT,F
	 JRST FP3A1		; OR WHEN REMAINING INFO BITS ARE BELOW MASK
	MOVN D,F
	TLZ D,400000
	CAMLE TT,D
	 AOJA T,FPX0		;LAST SIG DIGIT, BUT ROUND UPWARDS
	PUSH FXP,F
	PUSHJ P,FPX0		;OUTPUT A DIGIT, AND GO AROUND FOR ANOTHER
	JRST FP3A

FP3A1:	TLNE TT,200000		;SIZE OF REMAINDER DETERMINES ROUNDING
	 ADDI T,1
FPX0:	MOVEI A,"0(T)		;COME HERE TO OUTPUT A DIGIT IN T
	JRST (R)

;HERE ON FLONUMS < 0.01 (DB%) OR < 0.1 (DB$)
FP4:	JUMPN T,FP4E		;FLOATING POINT "E" FORMAT
	PUSHJ P,FP4A		;CLEVER WAY TO PRINT OUT "0.0" QUICKLY
	%DCML%
FP4A:	MOVEI A,"0
	JRST (R)

;HERE ON FLONUMS >= 1.0E8
FP4E0:	SKIPN KA10P
	 JRST .+5
	FDVL T,D1.0E8		;BE DOUBLY PRECISE IN DIVIDING
	FDVR TT,D1.0E8		; BY 10^8 TO GET NUMBER IN RANGE
	FADL T,TT
	JRST .+2
	 DFDV T,D1.0E8
	ADDI F,8
	CAML T,D1.0E8
	 JRST FP4E0		;KEEP DIVIDING UNTIL < 10^8
FP4E1:	CAMGE T,D10.0
	 JRST FP4B
	SKIPN KA10P
	 JRST .+5
	FDVL T,D10.0		;NOW REDUCE UNTIL < 10.0
	FDVRI TT,(10.0)
	FADL T,TT
	JRST .+2
	 DFDV T,D10.0
	AOJA F,FP4E1


;HERE FOR NON-ZERO FLONUMS < 0.01 (DB%) OR < 0.1 (DB$)
FP4E:	CAML T,[1.0^-8]		;BE DOUBLY PRECISE IN MULTIPLYING BY 10^8
	 JRST FP4E2A
	SKIPN KA10P
	 JRST .+7
	FMPR TT,D1.0E8
	MOVEM TT,D
	FMPL T,D1.0E8
	UFA TT,D
	FADL T,D
	JRST .+2
	 DFMP T,D1.0E8
	SUBI F,8
	JRST FP4E

FP4E2:	SKIPN KA10P
	 JRST .+7
	FMPRI TT,(10.0)		;NOW INCREASE UNTIL >= 1.0
	MOVEM TT,D
	FMPL T,D10.0
	UFA TT,D
	FADL T,D
	JRST .+2
	 DFMP T,D10.0
FP4E2A:	CAMGE T,[1.0]
	 SOJA F,FP4E2
;HERE WHEN NUMBER BETWEEN 1.0 (INCL) AND 10.0 (EXCL); F IS THE EXPONENT TO BE PRINTED.
FP4B:	SKIPE KA10P
	 JRST .+6

	TLNN TT,200000		;DECIDE WHETHER ROUNDING WILL HAVE ANY EFFECT
	 JRST FP4B1
	HLLZ TT,T		;IF SO, CREATE A FLONUM WHOSE VALUE IS
	TLZ TT,777		; 1/2 LSB OF FRACTION IN T
	ADD TT,[777000,,1]

	FADR T,TT		;ADD LOW PART TO HIGH PART, ROUNDING
	CAMGE T,D10.0		;ROUNDING UP MAY TAKE US OUT OF RANGE AGAIN
	 JRST FP4B1
	FDVRI T,(10.0)
	ADDI F,1		;ADJUST EXPONENT FOR THE DIVISION


;; FALLS THRU

FP4B1:	PUSH FLP,F		;DON'T USE FXP!  WILL CONFLICT WITH MASK OF DB$
	PUSHJ P,FP3		;NUMBER HAS BEEN NORMALIZED FOR  1.0 .LE. X < 10.0
	 %E%			;FOR SINGLE PRECISION, "E" INDICATES EXPONENT
	POP FLP,TT		;POP EXPONENT
	SKIPLE TT		;PRINT SIGN (BUT PRINT NO SIGN FOR 0)
	 %POS%
	SKIPGE TT
	 %NEG%
	MOVEI C,10.
	MOVMS TT
	JRST PRINI3		;PRINT EXPONENT AS A DECIMAL INTEGER



SUBTTL	PRINT A COMPLEX OR A DUPLEX

IFN CXFLAG,[
PRINCX:
IFN USELESS,[
	MOVEI T,35.
	SKIPN @-1(P)
	 MOVEI T,18.
	PUSHJ P,PRINLP
]		;END OF IFN USELESS
	SKIPE T,@-1(P)		;DON'T PRINT REAL PART IF 0
	 PUSHJ P,FP0
KA	HRRZ A,-1(P)
KA	MOVE T,(A)
KA	MOVE TT,1(A)
KIKL	DMOVE T,@-1(P)
	JUMPE T,PRNCX2
	SKIPL TT
	 %POS%
PRNCX2:	JUMPE TT,PRNCX4
	SKIPGE TT
	 %NEG%
	MOVM T,TT
	PUSHJ P,FP0
PRNCX3:	MOVEI A,"J		;CROCK
	JRST (R)

PRNCX4:	MOVEI A,"0
	PUSHJ P,(R)
	JRST PRNCX3
]		;END OF IFN CXFLAG

IFN DXFLAG,[
PRINDX:
IFN USELESS,[
	MOVEI T,60.
	SKIPN @-1(P)
	 MOVEI T,30.
	PUSHJ P,PRINLP
]		;END OF IFN USELESS
KA	HRRZ A,-1(P)
KA	MOVE T,(A)
KA	MOVE TT,1(A)
KIKL	DMOVE T,@-1(P)
	SKIPE T			;DON'T PRINT REAL PART IF 0
	 PUSHJ P,DFP0
	HRRZ A,-1(P)
KA	MOVE T,2(A)
KA	MOVE TT,3(A)
KIKL	DMOVE T,2(A)
	SKIPN @-1(P)
	 JRST PRNDX2
	SKIPL T
	 %POS%
PRNDX2:	JUMPE T,PRNCX4
	SKIPGE T
	 %NEG%
	JUMPGE T,PRNDX5
KA	DFN T,TT
KIKL	DMOVN T,T
PRNDX5:	PUSHJ P,DFP0
	JRST PRNCX3
]		;END OF IFN DXFLAG

IFN BIGNUM,[

SUBTTL	PRINT A BIGNUM

PRINB:
IFN USELESS,[
	HRRZ B,@-1(P)
	MOVEI T,1
PRINB0:	ADDI T,12.
	HRRZ B,(B)
	JUMPN B,PRINB0
	PUSHJ P,PRINLP
]		;END OF IFN USELESS
	HRRZ A,-1(P)
	SKIPGE A,(A)
	JRST PRINBQ
IFE USELESS,	HRRZ D,@VBASE
IFN USELESS,[
	HRRZ D,VBASE
	CAIE D,QROMAN
	SKIPA D,(D)
	MOVEI D,10.
]		;END OF IFN USELESS
	CAILE D,10.
	 %POS%
	JRST PRINBZ
PRINBQ:	%NEG%		;NEGATIVE BIGNUM
PRINBZ:	MOVEM R,RSAVE
	HRRZM P,FSAVE	;STORE PDL POSITION SO AR1 AND AR2A CAN BE FOUND
	PUSH P,AR1
	PUSH P,AR2A
	PUSHJ P,YPOCB
	PUSH P,A
	PUSH P,[PRINB4]
	MOVE B,VBASE
IFN USELESS,[
	CAIN B,QROMAN
	SKIPA D,[10.]
]		;END OF IFN USELESS
	JSP T,FXNV2
	MOVE C,D
	JSP T,PRI.
	MOVE R,D
	MOVEI F,1
	MOVE T,D
PRBAB:	MUL T,D
	JUMPN T,.+4
	MOVE T,TT
	MOVE R,TT
	AOJA F,PRBAB
	MOVEM F,NORMF
	MOVE D,R
PRINB3:	MOVE C,A
	HLRZ B,(C)
	MOVE F,(B)
	MOVEI R,0
PNFBLP:	DIV R,D
	MOVEM R,(B)
	MOVE B,(C)
	TRNN B,-1
	JRST PRBFIN
	MOVE C,(C)
	MOVE R,F
	HLRZ B,(C)
	MOVE F,(B)
	JRST PNFBLP


PRBFNA:	HLR A,B
PRBFIN:	MOVS B,(A)
	TLNE B,-1
	SKIPE (B)
	JRST .+2
	JRST PRBFNA
	PUSH FXP,F
	MOVE R,(A)
	TRNN R,-1
	JRST PRBNUF
	PUSHJ P,PRINB3
PRINBI:	POP FXP,TT
	MOVE F,NORMF
	MOVE R,RSAVE
PRINBJ:	SETZ T,
	JSP D,PRINI5
	SOJE F,FP7A1
	MOVE TT,T
	PUSHJ P,PRINBJ
	JRST FP7A1

PRBNUF:	HLRZ A,R
	MOVE TT,(A)
	MOVE AR2A,FSAVE
	MOVE AR1,1(AR2A)	;RESTORE AR1 AND AR2A
	MOVE AR2A,2(AR2A)
	HRRZ C,VBASE
IFN USELESS,	CAIN C,QROMAN
IFN USELESS,	SKIPA R,[10.]
	JSP T,FXNV3
	MOVE C,R
	MOVE R,RSAVE
	SKIPE TT
	PUSHJ P,PRINI3
	JRST PRINBI

PRINB4:	POP P,A
	MOVEI B,TRUTH
	PUSHJ P,RECLAIM
	POP P,AR2A
	POP P,AR1
	POPJ P,
]		;END OF IFN BIGNUM

SUBTTL	FLATSIZE, FLATC, EXPLODEC, EXPLODEN, EXPLODE

FLATSIZE:
	PUSH P,CFIX1		;SUBR 1
	SKOTTN A,LS
IFN HNKLOG,[
	 TLNN TT,HNK
	  JRST FLAT5
	PUSHJ P,USRHNP		;Is this a user's extended hunk?
	JUMPE T,FLAT5
	SETZ B,			;Say we aren't PRINT
	SETZ R,			;Say to do slashification
	PUSHJ P,SENDFL
	MOVE TT,(A)		;Get the result
	POPJ P,			;And make it into a FIXNUM
] ; End of IFN HNKLOG,

FLAT5:	SKIPA R,CFLAT2		;POPJ IS POSITIVE
FLAT4:	 HRROI R,FLAT2
FLAT3:	SETZM FLAT1
	PUSHJ P,PRINTF
	SKIPA TT,FLAT1
FLAT2:	 AOS FLAT1
CFLAT2:	POPJ P,FLAT2

IFN HNKLOG,[
%FLO:				;(FLATSIZE-OBJECT object printp i-depth slash)
FLATOBJECT:			;LSUBR (4 . 5)
	JSP TT,LWNACK		;Check number of arguments
	  LA45,,Q%FLO
	CAMN T,IN0-5		;5 args?
	  POP P,AR1		;  Yes, throw one away
	POP P,AR1
	POP P,C
	POP P,B
	POP P,A
	PUSH P,CFIX1
	MOVE TT,(C)
	MOVEM TT,PRINLV
	MOVE R,[PR.ATR,,FLAT2]
	SKIPE B			;Is this from inside print?
	  HRRI R,FLATO2		;  Yes, fake out PRINT to think it's from print
	SKIPN AR1		;Slashify?
	  TLO R,PR.PRC		;  Nope, tell PRINT not to.
	SETZM FLAT1
	PUSHJ P,PRINTF
	MOVE TT,FLAT1
	POPJ P,

FLATO2: AOS FLAT1
	POPJ P,
]; END of IFN HNKLOG,

FLATC:	PUSH P,CFIX1		;SUBR 1
	SKOTTN A,LS
IFN HNKLOG,[
	 TLNN TT,HNK
	  JRST FLAT7
	PUSHJ P,USRHNP		;Is this a user-extend HUNK?
	JUMPE T,FLAT7		;Maybe not
	SETZ AR1		;Say not from PRINT
	SETO R,			;Say no slashification
	SETZ B,			;Say we aren't print
	PUSHJ P,SENDFL		;Send it the message to get value to return
	MOVE TT,(A)		;Get result (better be fixnum)
	POPJ P,			;We'll definately return a fixnum! (we cons it)
] ; End of IFN HNKLOG,

FLAT7:	TLNN TT,SY
	 JRST FLAT7A
FLATC1:	HLRZ TT,(A)		;FAST-FLATC FOR SYMBOLS
	HRRZ A,1(TT)
FLTC1A:	SETZ TT,
FLATC2:	HRRZ B,(A)		;COUNT 5 CHARS PER PNAME WORD
	ADDI TT,BYTSWD
	JUMPE B,FLATC3
	HRRZ A,(B)
	ADDI TT,BYTSWD
	JUMPN A,FLATC2
	MOVEI A,(B)
FLATC3:	HLRZ A,(A)		;LAST PNAME WORD MAY BE PARTIAL
	SKIPN T,(A)		;WATCH OUT FOR NULL PNAME!
	 SUBI TT,1
	TRNE T,177_1
	 POPJ P,
	TRNE T,177_10
	 SOJA TT,CPOPJ
	SUBI TT,3
	TDNE T,[177_17]
	 AOJA TT,CPOPJ
	TLNN T,(177_26)
	 SUBI TT,1
	POPJ P,

FLAT7A:	JUMPN A,FLAT4
	HRRZ A,$$$NIL+1
	JRST FLTC1A

$EXPLODEC:
	PUSHJ P,USRHPP		;Is this a user hunk?
	JUMPN T,$$EXPU		;If so, send an EXPLODEC message
	MOVE R,EXPL0		;SUBR 1	;HRRZI IS NEGATIVE!!!
	JRST $$EXP1

$$EXPU:	PUSH P,A
	PUSH P,[QEXPLODE]
	PUSH P,NIL		;SLASHIFY-P
	PUSH P,NIL		;NUMBER-P
	JRST $$EXSN

$$EXPLODEN:
	PUSHJ P,USRHPP		;Is this a user hunk?
	JUMPE T,$$EXP0		;Nope, hack normally
	PUSH P,A
	PUSH P,[QEXPLODE]
	PUSH P,NIL		;SLASHIFY-P
	PUSH P,[TRUTH]		;NUMBER-P
$$EXSN:	MOVNI T,4
	XCT SENDI		;Never returns
	
$$EXP0:	HRROI R,EXPL2		;SUBR 1
$$EXP1:	SKOTT A,SY
	 JRST EXPL4
	HLRZ T,(A)
	HRRZ A,1(T)
	PUSH P,R70		;FORMING LIST OF CHARS
	MOVEI B,(P)
	PUSH P,A
	PUSH P,B
	XOR R,EXPL0
	PUSH FXP,R
EXPLY1:	SKIPN A,-1(P)
	JRST EXPLY9
	HLRZ B,(A)
	MOVE D,(B)
	HRRZ A,(A)
	MOVEM A,-1(P)
EXPLY2:	JUMPE D,EXPLY1
	SETZ TT,
	LSHC TT,7
	SKIPE (FXP)
	JRST EXPLY3
	PUSH FXP,D
	PUSHJ P,RDCH2
	POP FXP,D
	JRST EXPLY4
EXPLY3:	MOVEI A,IN0(TT)		.SEE HINUM
EXPLY4:	PUSHJ P,NCONS
	HRRM A,@(P)
	HRRZM A,(P)
	JRST EXPLY2

EXPLY9:	SUB P,R70+2
	SUB FXP,R70+1
	JRST POPAJ

EXPLODE:
	PUSHJ P,USRHPP		;Is it a USERHUNK?
	JUMPE T,EXPL0
	PUSH P,A
	PUSH P,[QEXPLODE]
	PUSH P,[TRUTH]		;SLASHIFY-P
	PUSH P,NIL		;NUMBER-P
	JRST $$EXSN

EXPL0:	HRRZI R,EXPL1		;SUBR 1
EXPL4:	PUSH P,R70
	HRRZM P,EXPL5
	PUSHJ P,PRINTF
	JRST POPAJ

EXPL1:	SOVE B C
	PUSHJ P,SAVX5
	ANDI A,177
	PUSHJ P,RDCH3
	POP P,C
EXPL3:	PUSHJ P,NCONS
	HRRM A,@EXPL5
	HRRZM A,EXPL5
	PUSHJ P,RSTX5
	JRST POPBJ

EXPL2:	PUSH P,B
	PUSHJ P,SAVX5
	MOVEI A,IN0(A)
	JRST EXPL3


SUBTTL	BAKTRACE

BAKTRACE:			;PRINT A BAKTRACE
	JSP TT,LWNACK
	LA01,,QBAKTRACE
	MOVNI TT,1
	JRST BKTR0
BAKLIST:			;RETURN A LIST (SIMILAR TO PRINTED FORMAT)
	JSP TT,LWNACK
	LA01,,QBAKLIST
	MOVSI TT,400000
BKTR0:	MOVEM TT,BACTYF		;TYPE FLAG FOR BAKTRACE/BAKLIST
	MOVEI A,NIL		;START WITH NIL
	SKIPE T			;OR USER SUPPLIED ARG
	 POP P,A
	JSP R,GTPDLP		;GET APPROPRIATE PDL POINTER
		0
	 JFCL
	MOVEI A,(D)		;SAVE PDL POINTER IN A
	MOVE B,(A)		;GET TOP OF STACK
	CAME B,[QBAKTRACE,,CPOPJ]
	 CAMN B,[QBAKLIST,,CPOPJ]
	  SOS A			;SKIP FIRST SLOT IF CALL TO US
	MOVEI R,60		;LOOK AT ABOUT 60 STACK LOCATIONS
	HRRZ TT,C2		;GET PDL ORIGION
	SUBM A,TT		;SAVE PDL OFFSET IN TT
	CAIG TT,(R)		;FEWER THAN 60 LOCATIONS TO LOOK AT?
	 MOVE R,TT		;YES, SO LOOK AT THAT MANY
	MOVE T,A
	SETZM CPJSW		;ASSUME *RSET HAS BEEN OFF
	MOVEI B,CPOPJ
BKTR3:	MOVE TT,(T)		;CUT OUT STUFF FROM *RSET LOOP, IF USED
	CAIN B,(TT)
	 TLNN TT,-1
	  SKIPA
	   SETOM CPJSW		;APPARENTLY *RSET HAS BEEN ON
	TLZ TT,-1#10000
	CAMN TT,[10000,,LSPRET]
	 MOVEI A,-1(T)
	SOS T
	SOJG R,BKTR3
	MOVEM A,BKTRP		;SET UP FOR BAKTRACE LOOP AND GO THERE
	MOVE A,BACTYF
	AOJE A,BKTR2		;IF TRACING THEN SKIP LIST HACKING STUFF
	PUSH P,R70		;SET UP LIST TO HOLD BAKLISTING
	HRLM P,(P)		;SET UP LAST-OF-LIST POINTER
BKTR2:	HRRZ A,C2		;THE PDL-HUNTING LOOP
	ADDI A,1
	CAML A,BKTRP
	 JRST BKTR2X		;EXIT WHEN BACKED UP TO BOTTOM OF PDL
	AOSN BACTYF
	 STRT [SIXBIT \^MBAKTRACE^M!\]
	HRRZ A,@BKTRP
	CAIN A,CPOPJ		;IN *RSET MODE, THIS IS A TAG
	 JRST BKTR1C		;PUT ON PDL UPON ENTRY TO A FUNCTION
	CAIN A,ILIST3
	 JRST BKTR1B
	MOVE D,@BKTRP
	TLNE D,10000#-1		;TO BE A PUSHJ RETURN ADDR, THERE MUST 
	 CAIN A,BKCOM1		; BE PC FLAGS IN LH
	  JRST BKTR1
	CAIL A,BEGFUN
	 CAIL A,ENDFUN
	  JRST BKTR1A
	CAIE A,CON2
	 CAIN A,CON3
	  JRST BKTR1G
	CAIN A,PG0A
	 JRST BKTR1E
	CAIN A,LMBLP1
	 JRST BKTR1
	CAILE A,BRLP1
	 CAILE A,BRLP2
	  SKIPA
	   JRST BKTR1H
	 CAIN A,REKRD1
	  JRST BKTRR3
	CAIE A,UNBIND
	 JRST BKTR1A
BKTR1:	SOS BKTRP
	JRST BKTR2
BKTR2X:	AOSE BACTYF
	 SKIPL BACTYF
	  JRST TERPRI
	POP P,A
	JRST RHAPJ

BKTR1A:	CAMGE A,@VBPORG		;LETS HOPE THAT BPORG ISN'T SCREWED UP
	 CAIGE A,BBPSSG
	  JRST BKTR1
BK1A2:	MOVEI AR1,-1(A)
BK1A4:	HLRZ B,-1(A)		;SOMEWHERE IN BINARY PROGRAMS
	MOVEI R,PRIN1B		;IF "CALL", THEN SUBR ATOM NAME WILL BE IN B
	TRC B,37		;LIKELY NOT AN INSTRUCTION IF ALL THE INDIRECT,
	TRCE B,37		; AND INDEXING BITS ARE ONES
	 CAIGE B,(CALL )
	  JRST BKTR1
	CAIG B,(JCALLF 17,)
	 JRST BK1A1
	CAIE B,(XCT)		;MIGHT BE A XCT OF A CALL, JRST, PUSHJ TO SUBR
	 JRST .+3
	   HRRZ A,-1(A)		;IF SO, CYCLE TO TRY TO FIND CALLED SUBR NAME
	   AOJA A,BK1A4
	MOVEI R,ERRADR		;HA! MAYBE  PUSHJ OR JRST, SO NOW WE HAVE 
	CAIN B,(JRST 0,)	; ONLY BEGINNING ADDRESS OF SUBR.  HENCE
	 JRST BK1A1		; IT HAS TO BE DECODED INTO ATOM NAME.
	CAIE B,(PUSHJ P,)
	 JRST BKTR1		;LOSE, DON'T KNOW WHAT KIND OF INST THIS IS
	HLLZ B,@BKTRP
	TLNN B,10000		;USER MODE FLAG - STOPS RANDOM
	 JRST BKTR1		; DATA NOT ENTERED BY PUSHJ

BK1A1:	MOVE B,-1(A)		;EITHER "(J)CALL(F)", "JRST", OR "PUSHJ P,"
	TLNE B,7777760		;LET INDIRECTION HAPPEN, BUT CAN'T CHANCE 
	 TLNE B,((17))		;  DOING IT IF THE UUO IS INDEXED, OR 
	  JRST BK1A1B		;  ADDRESSES AN AC
	MOVEI B,@-1(A)		;LET INDIRECT DO ITS THING
BK1A1C:	PUSH P,AR1		;ORIGINAL PC WHEREFROM SUBR WAS CALLED
	SKIPGE BACTYF
	 JRST BK1A3
	PUSHJ P,(R)		;R HAS EITHER PRIN1B OR ERRADR
	STRT [SIXBIT \_!\]	;  DEPENDING ON WHETHER "CALL" OR "PUSHJ P,"
	POP P,B
	PUSHJ P,ERRADR
	STRT [SIXBIT \ !\]
	JRST BKTR1

BK1A3:	CAIE R,ERRADR
	 SKIPA A,B
	  PUSHJ P,ERRDCD	;"ERRDCD" DECODES ADDRESS IN B, GETS ATOM IN A
	EXCH A,(P)
	PUSHJ P,ERRDCD
	PUSH P,[QLA]
	PUSH P,A
	MOVNI T,3
	JRST BKT1F2

BK1A1B:	CAIN R,ERRADR
	 TDZA B,B
	  MOVEI B,QM
	JRST BK1A1C

BKTR1B:	MOVE D,BKTRP
	HRRZ B,-1(D)	;PROBABLY FOR ENTRY TO SOME SUBR, LSUBR, OR EXPR
	CAIE B,ELSB1	;LISTING TINGS UP ON THE PDL
	 CAIN B,ESB1
	  JRST .+3
	CAIE B,IAPPLY
	 JRST BKTR1
	HLRE B,-1(D)
	ADDI B,-3(D)
	HLRZ A,(B)
	JUMPE A,BKTR1
	HRRZM B,BKTRP
	SKIPGE BACTYF
	 JRST BKT1B1
	STRT [SIXBIT \(!\]
	PUSHJ P,PRIN1
	STRT [SIXBIT \ EVALARGS) !\]
	JRST BKTR1

BKTR1C:	HLRZ A,@BKTRP	;PROBABLY ENTERED AN F-TYPE FUNCTION
	JUMPE A,BKTR1	;WELL, NIL ISN'T REALLY A FUNCTION
BKTR1F:	SKIPGE BACTYF
	JRST BKT1F1
	PUSHJ P,PRIN1
	STRT [SIXBIT \_ !\]
	JRST BKTR1

BKT1B1:	SKIPA B,[QEVALARGS]
BKT1F1:	 MOVEI B,QLA
	PUSH P,A
	PUSH P,B
	MOVNI T,2
BKT1F2:	PUSHJ FXP,LISTX
	PUSHJ P,NCONS
	HLRZ B,(P)
	HRRM A,(B)	;NCONC MOST RECENT GOODIE ONTO END OF LIST
	HRLM A,(P)	;UPDATE LAST-OF-LIST POINTER
	JRST BKTR1

BKTR1H:	MOVNI T,LERSTP+5-1	;2 FROM BREAK, 2 FROM EDERRL, 1 FROM BRLP = 5
	MOVEI A,QBREAK		;-1 SINCE BKTR1 WILL TAKE OFF ONE MORE
	JRST BKTR1D
BKTR1E:	MOVNI T,LPRP		;BACK UP OFF A PROG
	MOVEI A,QPROG
BKTR1D:	ADDM T,BKTRP
	JRST BKTR1I

BKTR1G:	MOVEI A,QCOND		;FOUND A COND ENTRY
BKTR1I:	SKIPE CPJSW
	 JRST BKTR1		;IF *RSET WAS ON, ENTRY IS BE MARKED BY CPOPJ
	JRST BKTR1F

BKTRR3:	SKIPA T,XC-3
BKTRR5:	 MOVNI T,5
	ADDM T,BKTRP
	JRST BKTR1


PGTOP PRT,[PRINT,TYO,EXPLODE,FLATC,BAKTRACE,ETC]