SEARCH HDRFIL
COMPIL(PRN,<$PRINT,$$PRIN,SETPRINT,GETPRINT,$PINT,$PREL,$PITM,$PSET,$PLST,$PREC,$PSTR>
	,<GOGTAB,X22,OUT,OUTSTR,INCHWL,OPEN,GETCHAN,ENTER,.SKIP.,RELEASE,CAT,GETFOR,SETFOR,CATCHR,CVIS,X33,CVS,CVG>
	,<STRING PRINTING ROUTINE>)
NOTTTY ←← 400000		; WANT PRINT OUTPUT TO THE TELETYPE
WNTFLE ←← 200000		; WANT PRINT OUTPUT TO A FILE
HAVFLE ←← 100000		; HAVE A FILE FOR OUTPUT
WNTTTY ←← 000000		; DONT WANT ANY OUTPUT AT ALL
BEGIN STRPRN
UROUTB ←← 400000		; IF ON THEN JRST (CTRL)
RTNSTR ←← 200000		; IF ON THEN RETURN(S) ELSE RETURN (NULL)
TTYYES ←← 100000		; IF ON THEN ALWAYS DO OUTSTR
TTYNOT ←← 040000		; IF ON THEN DONT OUTSTR UNLESS TTYYES ON
CHNSPC ←← 020000		; IF ON THEN RH(CTRL) IS CHANNEL (OR JFN)
CHNNOT ←← 010000		; IF ON THEN DO NOT PUT OUT ANYTHING ON DEFAULT
HERE($$PRIN)
	TDZA	A,A
HERE($PRINT)
	MOVEI	A,1
	MOVE	C,-1(P)		;CONTROL BITS
	MOVE	USER,GOGTAB	;
	MOVE	B,PRNINF(USER)	;"DEFAULT" BITS
	JUMPE	A,SPRN.1	;CAME FROM STRPR1?
	TLNE	C,UROUTB	;USER ROUTINE?
	JRST	(C)		;YES
	TLNE	B,UROUTB	;USER SPEC ONE HERE?
	JRST	(B)		;YES
SPRN.1:			;STRPR1 COMES IN HERE
	TLNE	C,TTYYES	;DID HE DEMAND OUTSTR?
	JRST	.OSTRC		;YES
	TLNE	C,TTYNOT	;DID HE DEMAND NOT?
	JRST	SPRN.3		;YES
	TLNN	B,TTYNOT!TTYYES ;IS A DEFAULT ESTABLISHED?
	PUSHJ	P,PDFSET	;NO, DO SO
SPRN.2:	TLNN	B,TTYYES	;DOES HE WANT IT?
	JRST	SPRN.3		;NO
.OSTRC:	PUSH	SP,-1(SP)	;
	PUSH	SP,-1(SP)	;
	PUSHJ	P,OUTSTR	;OUTSTR(S);
SPRN.3:	TLNE	C,CHNSPC	;SPECIFIED CHANNEL?
	JSP	D,OUTFN		;OUT(SPEC CHAN,S);
	JUMP	(C)		;EFFECTIVE ADDRESS IS CHANNEL NO
SPRN.4:	TLNE	C,CHNNOT	;DID HE SAY THAT IS ALL?
	JRST	SPRN.5		;YES
	TLNN	B,CHNNOT!CHNSPC	;DEFAULTS SET YET?
	PUSHJ	P,PDFSET	;NOPE DO IT NOW
	TLNE	B,CHNSPC	;CHANNEL SPECIFIED NOW?
	JSP	D,OUTFN		;OUTPUT FUNCTION
	JUMP	(B)		;PASS CHANNEL NUMBER THIS WAY
SPRN.5:	TLNN	C,RTNSTR	;DID WE WANT S KEPT?
	SETZM	-1(SP)		;RETURN A NULL INSTEAD OF S
	SUB	P,X22		;RETURN
	JRST	@2(P)		;
OUTFN:	MOVEI	A,@(D)		;GET CHANNEL NUMBER
	PUSH	P,A		;PUSH IT
	PUSH	SP,-1(SP)	;
	PUSH	SP,-1(SP)	;COPY IS LIKELY FOOLISH
	PUSHJ	P,OUT		;
	JRST	1(D)		;RETURN --RELY ON OUT TO SAVE ACS
PDFSET:	PUUO	3,[ASCIZ/
$PRINT called without initialization.
Output to teletype?/]
	MOVSI	B,TTYYES!CHNNOT	;INITIALLY, ASSUME TTYON
	PUSHJ	P,$YN
	MOVSI	B,TTYNOT!CHNNOT	;NO WE DONT
	PUUO	3,[ASCIZ/Output to file?/];
	PUSHJ	P,$YN		;ASK ABOUT IT
	JRST	OPTSET		;NO
	TLC	B,CHNNOT!CHNSPC	;YES, WE WILL
DOOP:	PUSHJ	P,GETCHAN	;CHANNEL NUMBER
	HRR	B,A		;REMEMBER HERE,TOO
	PUSH	P,A		;CHANNEL NO
	PUSH	SP,[3]		;DSK
	PUSH	SP,[ POINT 7,[ASCIZ/DSK/]]
	PUSH	P,[0]		;MODE 0
	PUSH	P,[0]		;NO INPUT
	PUSH	P,[3]		;3 OUTPUT BUFFERS
	PUSH	P,[0]
	PUSH	P,[0]
	PUSH	P,[.SKIP.]	;EOF VAR 
	SETZM	.SKIP.
OPIT:	PUSHJ	P,OPEN		;OPEN THE CHANNEL
	SKIPE	.SKIP.
	ERR	<OPEN LOST>,1,DOOP
ENIT:	PUUO	3,[ASCIZ /File Id=/]
	PUSH	P,A
	PUSHJ	P,INCHWL
	PUSH	P,[.SKIP.]
	PUSHJ	P,ENTER
	SKIPE	.SKIP.
	JRST	ENIT
OPTSET:	MOVEM	B,PRNINF(USER)
	POPJ	P,
$YN:	PUSHJ	P,INCHWL
	HRRZ	FF,-1(SP);
	JUMPE	FF,YNRET;
	ILDB	FF,(SP)
	CAIE	FF,"Y"
	CAIN	FF,"y"
	AOS	(P)		;SKIP RET IF YES
YNRET:	SUB	SP,X22
	POPJ	P,
INTERNAL P.FIN
HERE(P.FIN)
	BEGIN 	P.FIN
	MOVE	USER,GOGTAB
	SKIPE	B,PRNINF(USER)			;FIRST CLOSE $PRINT FILE
	TLNE	B,UROUTB
	  JRST	CONTIN
	TLNN	B,CHNSPC
	  JRST	CONTIN
	HRRZS	B
	PUSH	P,B
	PUSH	P,[0]
	PUSHJ	P,RELEASE
CONTIN:	SKIPE	B,PRTINF(USER)			;NOW CLOSE PRINT FILE (WOW!)
	TLNN	B,HAVFLE
	  POPJ	P,
	HRRZS	B
	PUSH	P,B
	PUSH	P,[0]
	PUSHJ	P,RELEASE
	POPJ	P,
	BEND	P.FIN
BEND STRPRN
HEREFK(SETPRINT,SETPR.)
	BEGIN	SETPRINT
DEFINE TST(X,Y) <
	CAIN	D,"X"
	  MOVSI	B,Y
>;
	MOVE	USER,GOGTAB
	MOVE	TEMP,(P)
	MOVEM	TEMP,UUO1(USER)
	MOVE	D,-1(P)				;GET ARGUMENT
	CAIL	D,"a"
	CAILE	D,"z"
	  SKIPA
	  SUBI	D,40				;CONVERT TO UPPER CASE
	SETO	B,
	CAIN	D,"C"				;CONSOLE?
	  JRST	[MOVE	B,PRTINF(USER)
		TLZ	B,NOTTTY		;TURN ON TELETYPE
		 JRST	SETRET]
	CAIN	D,"I"				;IGNORE TERMINAL
	  JRST	[MOVE	B,PRTINF(USER)
		TLO	B,NOTTTY
		 JRST	SETRET]
	TST	T,WNTTTY
	TST	F,NOTTTY+WNTFLE+HAVFLE
	TST	B,WNTTTY+WNTFLE+HAVFLE
	TST	N,NOTTTY
	TST	S,NOTTTY+HAVFLE
	TST	O,WNTTTY+HAVFLE
	CAME	B,[-1]				;NOT LEGAL OPTION
	  JRST	OKSET
	PUUO	1,D				;PRINT A CHAR
	ERR	<
SETPRINT:  Above mode is not legal>,1
	MOVSI	B,WNTTTY			;FOR DEFAULT ASSUME TTY
	JRST	SETRET
OKSET:	
	MOVE	D,PRTINF(USER)			;GET OLD VALUE
	TLNE	D,HAVFLE			;IF HAVE A FILE
	TLNE	B,HAVFLE			;BUT DONT WANT IT
	  JRST	OKREL
	HRRZS	D
	PUSH	P,D
	PUSH	P,[0]				;CLOSE INHIBIT BITS
	PUSHJ	P,RELEASE			;RELEASE FILE
	JRST	SETRET				;AND RETURN
OKREL:
	TLNE	D,HAVFLE			;IF WE HAVE A FILE
	TLNN	B,HAVFLE			;AND WANT A FILE
	  JRST	CHKNEED				
	HRR	B,D				;THEN USE IT
	JRST	SETRET
CHKNEED:
	TLNN	B,HAVFLE			;WANT A FILE?
	  JRST	SETRET
NOTENX<
	HRRZ	A,-1(SP)
	JUMPG	A,.+2				;HAVE A FILE NAME?
	PUSHJ	P,GETNAME			;NEED A NAME
GETDSK:
	PUSHJ	P,GETCHAN			;GET A CHANNEL
	CAMN	A,[-1]
	  ERR	<SETPRINT:  GETCHAN failed>
	HRR	B,A				;PUT CHANNEL NUMBER IN RH(B)
	PUSH	P,A				;CHANNEL ARG
	PUSH	SP,[3]
	PUSH	SP,[POINT 7,[ASCIZ/DSK/],-1]
	PUSH	P,[0]				;MODE 0
	PUSH	P,[0]				;INPUT BUFFERS
	PUSH	P,[3]				;OUTPUT BUFFERS
	PUSH	P,[0]				;COUNT WORD
	PUSH	P,[0]				;BRCHAR
	SETZM	.SKIP.
	PUSH	P,[.SKIP.]			;END OF FILE
	PUSHJ	P,OPEN				;CALL FUNCTION
	SKIPE	.SKIP.				;A PROBLEM
	  ERR 	<SETPRINT:  OPEN to the DSK has failed>,1,GETDSK
DOENT:	PUSH	P,A				;CHANNEL
	PUSH	SP,-1(SP)
	PUSH	SP,-1(SP)			;FILE NAME
	PUSH	P,[.SKIP.]
	PUSHJ	P,ENTER
	SKIPE	.SKIP.
	  JRST	[PUUO 3,[ASCIZ/SETPRINT:  ENTER failed, type file name
/]
		 PUSHJ	P,GETNAME
		 JRST	DOENT]
	JRST	SETRET
GETNAME:
	PUUO	3,[ASCIZ/
File for PRINT output  */]
	PUSHJ	P,INCHWL
	POP	SP,-2(SP)
	POP	SP,-2(SP)
	POPJ	P,
>;NOTENX
TENX<
EXTERNAL OPENFILE
GETDSK:
	PUSH	P,B
	HRRZ	A,-1(SP)			;COUNT OF FILENAME
	JUMPG	A,.+2				;CHECK LENGTH
	PUUO	3,[ASCIZ/
File for PRINT output  */]
	PUSH	SP,-1(SP)
	PUSH	SP,-1(SP)			;FILE NAME
	PUSH	SP,[2]
	PUSH	SP,[POINT 7,[ASCIZ/WC/],-1]
	PUSHJ	P,OPENFILE
	POP	P,B
	HRR	B,A				;CHANNEL NUMBER
	JRST	SETRET
>;TENX
SETRET:	
	MOVEM	B,PRTINF(USER)
	SUB	SP,X22
	SUB	P,X22
	JRST	@2(P)				;RETURN
	BEND SETPRINT
HEREFK(GETPRINT,GETPR.)
	BEGIN 	GETPRINT
DEFINE TST(X,Y) <
	CAIN	TEMP,X
	  MOVEI	A,"Y"
>;
	MOVE	USER,GOGTAB
	MOVE	TEMP,(P)
	MOVEM	TEMP,UUO1(USER)
	HLRZ	TEMP,PRTINF(USER)
	SETO	A,
	TST	WNTTTY,T
	TST	NOTTTY+WNTFLE+HAVFLE,F
	TST	WNTFLE+WNTTTY+HAVFLE,B
	TST	NOTTTY,N
	TST	NOTTTY+HAVFLE,S
	TST	HAVFLE+WNTTTY,O
	CAMN	A,[-1]
	  ERR	<GETPRINT:  Illegal mode>,1
	POPJ	P,
	BEND 	GETPRINT
$PRSTR:	
	BEGIN $PRSTR
	MOVE	USER,GOGTAB
	SKIPE	TEMP,$$PROU(USER)
	  JRST	WNTOWN				;OWN OUTPUTTING FN.
PRINT1:	MOVE	TEMP,-1(P)			;GET CHANNEL NUMBER
	CAME	TEMP,[-1]			;IS IT -1?
	  JRST	WNTCHN				;NO, MUST BE A CHANNEL
	SKIPN	B,PRTINF(USER)			;SEE IF SETPRINT DONE
	  JRST	OUTSTR				;JUST DEFAULT SETPRINT, THAT'S ALL
	TLNE	B,NOTTTY			;TELETYPE WANTED?
	  JRST	NOTTY				;NO
	PUSH	SP,-1(SP)
	PUSH	SP,-1(SP)
	PUSHJ	P,OUTSTR
NOTTY:	TLNN	B,WNTFLE			;FILE WANTED?
	  JRST	[SUB	SP,X22
		 POPJ	P,]
	HRRZS	B
	PUSH	P,B
	JRST	WNTCH1
WNTCHN:	PUSH	P,TEMP				;THE CHANNEL NUMBER
WNTCH1:	PUSHJ	P,OUT				;STRING ON STACK
	POPJ	P,				;AND RETURN
WNTOWN:	PUSH	P,-1(P)				;PUSH CHANNEL NO.
	PUSHJ	P,(TEMP)			;CALL USER FUNCTION
	POPJ	P,
	BEND $PRSTR
DEFINE PMAK ! (X,X1,Y,Z) <
HEREFK(X,X1)
	MOVE	USER,GOGTAB
	MOVE	TEMP,(P)
	MOVEM	TEMP,UUO1(USER)
	PUSH	P,-1(P)			;PUSH THE ARGUMENT
	SKIPE	TEMP,Z(USER)		;USER FORMATTING FUNCTION
	   JRST	PRTOWN
	PUSHJ	P,Y			;NO, CALL STANDARD FORMATTING
	JRST	PRRET			
>;PMAK
PRTOWN:	PUSHJ	P,(TEMP)
PRRET:	POP	P,-1(P)			;SPLICE ARG OUT FROM STACK
	JRST	$PRSTR			;AND RETURN
PMAK	$PINT,$PINT.,CVS,$$FINT
PMAK	$PREL,$PREL.,CVG,$$FREL
PMAK	$PITM,$PITM.,PN,$$FITM
PMAK	$PSET,$PSET.,PSET1,$$FSET
PMAK	$PLST,$PLST.,PLST1,$$FLST
PMAK	$PREC,$PREC.,PREC,$$FREC
HEREFK($PSTR,$PSTR.)
	MOVE	USER,GOGTAB
	MOVE	TEMP,(P)
	MOVEM	TEMP,UUO1(USER)
	SKIPE	TEMP,$$FSTR(USER)	;SPECIAL STRING FORMATTER?
	  PUSHJ	P,(TEMP)		;YES
	JRST	$PRSTR			;PRINT AND RETURN
PN:	
	BEGIN PN
	PUSH	P,[0]			;USE STACK FOR VARIABLE
	MOVEI	A,(P)
	PUSH	P,-2(P)			;ARGUMENT X NOW
	PUSH	P,A			;ADDRESS OF FLAG
	PUSHJ	P,CVIS			;GET STRING ON STRING STACK	
	SKIPN	(P)			;FLAG OK?
	  JRST	RET			;YES OK
	SUB	SP,X22			;CLEAR OFF STACK
	MOVE	A,-2(P)			;GET ITEM NUMBER
	CAILE	A,3			;BIGGER THAN BUILTIN RANGE?
	  JRST	USENUM			;YES, USE THE NUMBER
	PUSH	SP,[3↔6↔6↔12](A)
	PUSH	SP,[440700,,STRN
		    170700,,STRN
		    100700,,STRN+1
		    440700,,STRN+3](A)
	JRST	RET
USENUM:	PUSH	SP,[5]
	PUSH	SP,[POINT 7,[ASCII/ITEM!/],-1]
	PUSH	P,-2(P)			;ARGUMENT AGAIN
	PUSH	P,[-4]			;FOR ACVS
	PUSHJ	P,ACVS			;GO OFF AND DO IT
	PUSHJ	P,CAT			;CONCATENATE
RET:	SUB	P,X33			;CLEAR OFF EVERYTHING
	JRST	@2(P)			;AND RETURN
STRN:	ASCII/ANYMAINPIBINDITEVENT!TYPE/
	BEND PN
ACVS:
	PUSH	P,[0]
	PUSH	P,[0]
	MOVEI	A,-1(P)
	PUSH	P,A
	MOVEI	A,-1(P)
	PUSH	P,A
	PUSHJ	P,GETFORMAT		;GET FORMAT INTO STACK LOCATIONS
	PUSH	P,-3(P)			;F ARGUMENT
	PUSH	P,[0]			;DOESNT MATTER
	PUSHJ	P,SETFORMAT
	PUSH	P,-4(P)			;I ARGUMENT
	PUSHJ	P,CVS			;GET STRING ONTO STRING STACK
	PUSHJ	P,SETFORMAT
	SUB	P,X33			;CLEAR OFF STACK
	JRST	@3(P)			;AND RETURN
GODOWN:	BEGIN GODOWN
	PUSH	SP,[0]
	PUSH	SP,[0]			;PREPARE FOR STRING
	MOVE	1,-1(P)
	HRRZ	1,(1)
LOOP:	JUMPE	1,DONE
	HLRZ	2,(1)			;J ← CAR(I)
	HRRZ	1,(1)			;I ← CDR(I)
	PUSH	P,1			;SAVE
	PUSH	P,2			;SAVE
	PUSH	P,2			;ARGUMENT
	PUSHJ	P,PN			;GET STRING
	PUSHJ	P,CAT			;HOOK ON STRING
	POP	P,2			;RESTORE
	POP	P,1
	JUMPE	1,DONE			
	PUSH	SP,[2]
	PUSH	SP,[POINT 7,[ASCIZ/, /],-1]
	PUSHJ	P,CAT
	JRST	LOOP
DONE:	SUB	P,X22
	JRST	@2(P)			;RETURN
	BEND GODOWN
PSET1:	BEGIN PSET1
	SKIPN	-1(P)			;EMPTY?
	  JRST	RETPHI			;YES
	PUSH	SP,[1]
	PUSH	SP,[POINT 7,[BYTE (7) 173,173],-1]
	PUSH	P,-1(P)
	PUSHJ	P,GODOWN
	PUSHJ	P,CAT
	PUSH	SP,[1]
STANFO <
	PUSH	SP,[POINT 7,[BYTE (7) 176,176],-1]
>
NOSTANFO <
	PUSH	SP,[POINT 7,[BYTE (7) 175,175,0,0,0],-1]
>
	PUSHJ	P,CAT	
RET:	SUB	P,X22
	JRST	@2(P)
RETPHI:	PUSH	SP,[3]
	PUSH	SP,[POINT 7,[ASCIZ/PHI/],-1]
	JRST	RET
	BEND PSET1
PLST1:	BEGIN PLST1
	SKIPN	-1(P)				;ANYTHING THERE?
	  JRST	RETNIL				;NO
	PUSH	SP,[2]
	PUSH	SP,[POINT 7,[BYTE (7) 173,173],-1]
	PUSH	P,-1(P)
	PUSHJ	P,GODOWN
	PUSHJ	P,CAT
	PUSH	SP,[2]
STANFO <
	PUSH	SP,[POINT 7,[BYTE (7) 176,176],-1]	;STANFORD CROCK "ASCII"
>
NOSTANFO <
	PUSH	SP,[POINT 7,[BYTE (7) 175,175,0,0,0],-1]
>
	PUSHJ	P,CAT
RET:	SUB	P,X22
	JRST	@2(P)
RETNIL:	PUSH	SP,[3]
	PUSH	SP,[POINT 7,[ASCIZ/NIL/],-1]
	JRST	RET
	BEND PLST1
PREC:	BEGIN PREC
	MOVE	3,-1(P)			;RECORD
	JUMPE	3,NULLREC		;SPECIAL FOR NULL!RECORD
	MOVE	3,(3)			;POINTER TO CLASS
	MOVE	3,5(3)			;POINTER TO WD2 OF STRING
	PUSH	SP,-1(3)
	PUSH	SP,(3)			;STRING TO STACK
	PUSH	P,["."]
	PUSHJ	P,CATCHR
	PUSH	P,-1(P)
	PUSH	P,[0]
	PUSHJ	P,ACVS
	PUSHJ	P,CAT
RECRET:	SUB	P,X22
	JRST	@2(P)
NULLREC:
	PUSH	SP,[=11]
	PUSH	SP,[POINT 7,[ASCIZ/NULL!RECORD/],-1]
	JRST	RECRET
	BEND PREC
ENDCOM(PRN)
END