TITLE	OUTLIB	COMMON OUTPUT ROUTINES NEEDED BY MACRO PROGRAMS
	SUBTTL	ERNIE PETRIDES, WESLEYAN UNIVERSITY, JANUARY, 1979

COMMENT	\

		TO USE THIS OUTPUT PACKAGE, THE USER MUST MAKE A
	UNIVERSAL FILE NAMED "AC" WHICH DEFINES ACCUMULATOR USAGE.
	NOTE THAT EXCEPT FOR THE TEMPS, THE ASSIGNMENTS MUST MATCH
	THOSE USED IN THE USER'S PROGRAM.  ALL ASSIGNMENTS, OF COURSE
	MUST BE UNIQUE.  "C" IS ALWAYS SET TO THE ASCII VALUE OF THE
	LAST CHARACTER TYPED (OR ZERO IF A STRING WAS PROCESSED) AND
	"M" IS USED AS AN ILDB POINTER FOR STRINGS.  ALL THE OTHERS
	ARE ALWAYS PRESERVED.
		T1 -- THREE CONSECUTIVE SCRATCH ACCUMULATORS (PRESERVED)
		T2 -- MUST BE EQUAL TO T1 + 1 (PRESERVED)
		T3 -- THIRD SCRATCH ACCUMULATOR (PRESERVED)
		C -- PROVIDES (AND SET TO) CHARACTER TO BE OUTPUT
		M -- MESSAGE POINTER TO ASCIZ STRING TO BE OUTPUT
		N -- NUMBER FOR NORMAL INTEGER TYPE-OUT (PRESERVED)
		P -- PUSH DOWN STACK POINTER (MIN. 20 LEVELS NEEDED)

ALSO: IF FEATURES OF THE ACTION CHARACTER HANDLER ARE DESIRED TO BE
	INACTIVE, THE ASSEMBLY SWITCH OF THE FORM ".FT'ACT" (WHERE
	"ACT" IS THE THREE LETTER ACTION CODE) MUST BE DEFINED AS
	ZERO IN THE UNIVERSAL FILE "AC".  NON-STANDARD PARAMETER
	SETTINGS AFFECTING ASSEMBLY OF THE BASIC "CHROUT" ROUTINE
	MUST ALSO BE DEFINED IN SAID FILE.
\
	SUBTTL	TABLE OF CONTENTS FOR OUTLIB

COMMENT	\


	 NAME			DESCRIPTION			      PAGE

	OUTLIB	COMMON OUTPUT ROUTINES NEEDED BY MACRO PROGRAMS		1
		TABLE OF CONTENTS FOR OUTLIB				2
	ACTOUT	OUTPUT STRING WITH SPECIAL ACTION CHARACTERS		3
		ACTION CHARACTER SUBROUTINES AND EXIT			4
		ACTION CHARACTER CODE TABLE AND DISPATCH TABLE		5
	ERROUT	OUTPUT ERROR MESSAGES PRECEDED BY PREFIX IN "ERR"	6
	APCOUT	OUTPUT "AT USER PC N" OF N				7
	DATOUT	OUTPUT THE CURRENT DATE IN DD-MMM-YY FORMAT		8
	TIMOUT	OUTPUT THE CURRENT TIME IN HH:MM:SS FORMAT		9
	LINOUT	OUTPUT ASCIZ STRING FOLLOWED BY A CRLF			10
	STROUT	OUTPUT A PLAIN OLD ASCIZ STRING				11
	FILOUT	OUTPUT FULL FILE SPECIFICATION (DEV,FIL,EXT,PPN)	12
	DEVOUT	OUTPUT SIXBIT DEVICE LEFT JUSTIFIED IN "DEV"		13
	SIXOUT	OUTPUT THE SIXBIT CHARACTERS IN "SIX"			14
	PPNOUT	OUTPUT [PROJ,PROG] PAIR IN "PPN"			15
	NUMOUT	OUTPUT N IN DECIMAL, OCTAL, OR ANY RADIX IN "RAD"	16
	DMPOUT	OUTPUT N IN OCTAL DUMP FORMAT (WITH LEADING 0'S)	17
	MISC	OUTPUT OF COMMON MISCELLANEOUS CHARACTERS		18
	CHROUT	OUTPUT OF THE SINGLE CHARACTER IN C			19
		CHROUT ROUTINE MAIN BODY				20
		BUFFER ROUTINES FOR CHROUT				21
	PDLTSV	PDL MANIPULATION ROUTINES FOR SAVING TEMPS		22
	PDLCPJ	PDL MANIPULATION ROUTINES FOR DOING SKIP RETURNS	22

\
	SALL		;GENERATE A NICE LISTING
	PRGEND
	TITLE	ACTOUT	OUTPUT STRING WITH SPECIAL ACTION CHARACTERS

	ENTRY	ACTOUT
	EXTERN	CHROUT,DECOUT,ERROUT,TSAV1
	SEARCH	AC
	TWOSEG

	OPDEF	PJRST [JRST]

DEFINE	ACTDEF
	<ITEM	CLF,"_"		;;DO A CRILIF
	ITEM	BRK,"*"		;;BREAK OUTPUT
	ITEM	FUC,74		;;FORCE UPPER CASE (OPEN ANGLE BRACKET)
	ITEM	FLC,76		;;FORCE LOWER CASE (CLOSE ANGLE BRACKET)
	ITEM	FNC,"="		;;DON'T FORCE EITHER CASE
	ITEM	NUM,"#"		;;THE DECIMAL NUMBER IN N
	ITEM	PLU,"$"		;;"S" IF N NOT EQUAL TO 1
	ITEM	SPC,"("		;;SING./PLURAL COND. SUPPRESS (USES \ AND ) )
	ITEM	DEV,":"		;;DEVICE: IN "DEV"
	ITEM	PPN,"["		;;[P,PN] IN "PPN"
	ITEM	FIL,"^"		;;FULL FILE SPEC IN DEV,FIL,EXT,PPN
	ITEM	WRN,"%"		;;WARNING MESSAGE PREFIX IN "ERR"
	ITEM	FTL,"?"		;;FATAL MESSAGE (LIKE WARN) AND BOMB
	ITEM	APC,"@"		;;"AT USER PC N" OF N
	ITEM	TIM,"+"		;;CURRENT TIME FROM GETTAB
	ITEM	DAT,"&"		;;CURRENT DATA FROM GETTAB>

IF1,	<NACTS==0>		;INITIALIZE ACTCHR FEATURE COUNTER
DEFINE	ITEM (ACT,CHR)
<IF1,	<IFNDEF .FT'ACT,<.FT'ACT'==-1>
	IFN .FT'ACT,<NACTS==NACTS+1>>>
	ACTDEF	;TURN ON ALL UNDECLARED ACT FEATURES AND TALLY THOSE ON

IFN .FTNUM,<IFNDEF .FTSNZ,<.FTSNZ==-1>>	;SUBSTITUTE "NO" FOR 0 ON #

IFN .FTSPC,<SUPCON:EXP 0>	;FLAG TO SHOW INSIDE SUPPRESS CONDITIONAL
IFN .FTFTL,<FTLERR:EXP 0>	;FLAG TO SHOW FATAL ERROR REQUEST TO EXIT

	RELOC	400000

ACTOUT:	PUSHJ	P,TSAV1			;SAVE A TEMP W/ AUTO RESTORE
IFN .FTSPC,<SETZM SUPCON>		;INIT SUPPRESS CONDITIONAL FLAG
IFN .FTFTL,<SETZM FTLERR>		;INIT FATAL ERROR FLAG
	HRLI	M,440700		;MAKE AN ILDB POINTER TO STRING
NEXTCH:	ILDB	C,M			;LOAD A CHAR FROM STRING
	JUMPE	C,ACTXIT		;OFF TO MAIN EXIT WHEN NULL
IFLE NACTS,<PUSHJ P,NOACT>		;NEVER ACT IF ALL FEATURES OFF
IFG NACTS,<MOVSI T1,-NACTS		;LOAD NEGATIVE TABLE LENGTH IN LEFT
	CAME	C,ACTCHR(T1)		;SKIP IF WE'VE GOT A MATCH
	AOBJN	T1,.-1			;KEEP TRYING UNTIL NONE LEFT
	SKIPE	SUPCON			;IF IN A SUPPRESS CONDITIONAL,
	 PUSHJ	P,DOSUP			;DO SPECIAL ROUTINE (MIGHT SKIP)
	  PUSHJ	P,@ACTDSP(T1)>		;DO THE APPROPRIATE DISPATCH
	JRST	NEXTCH			;LOOP BACK FOR NEXT CHARACTER
	SUBTTL	ACTION CHARACTER SUBROUTINES AND EXIT

;THIS IS THE CENTRAL EXIT FOR ACTOUT
ACTXIT:
IFN .FTFTL,<SKIPN FTLERR		;TEST FOR FATAL ERROR MESSAGE
	  POPJ	P,			;JUST RETURN IF NORMAL
	PUSHJ	P,BRKOUT		;ELSE FORCE OUT ALL BUFFERS
	EXIT	1,>			;AND EXIT TO MONITOR
	POPJ	P,			;BUT LET USER CONTINUE ANYWAY


;SUBROUTINE FOR NORMAL CHARACTER OUTPUT
NOACT:	PJRST	CHROUT			;OUTPUT PLAIN CHAR AND RETURN

;SUBROUTINE TO OUTPUT A NUMBER FOR "#"
IFN .FTNUM,<NUMOUT:	;ALL GOES UNDER CONDITIONAL ASSEMBLY OPTION
IFN .FTSNZ,<SKIPE N>			;IF N IS NOT ZERO (OR OPTION OFF),
	  PJRST DECOUT			;  THEN OUTPUT DECIMAL AND RETURN
IFN .FTSNZ,<MOVEI C,"N"+40		;OTHERWISE, LOAD A LC "N"
	PUSHJ	P,CHROUT		;SEND IT OUT IN STYLE
	MOVEI	C,"O"+40		;AND LOAD A LC "O"
	PJRST	CHROUT>			;OUTPUT IT AND RETURN
>;END OF IFN .FTNUM CONDITIONAL

;SUBROUTINES TO HANDLE ERROR MESSAGES (CHARACTER ALREADY IN C)
IFN .FTFTL,<FTLOUT:SETOM FTLERR>	;SET THE FLAG TO BOMB
IFN .FTWRN,<WRNOUT:>
IFN .FTFTL!.FTWRN,<PJRST ERROUT>	;DO ERROR PREFIX AND RETURN

;SUBROUTINES TO HANDLE SUPPRESSION CONDITIONALS (N SINGULAR OR PLURAL)
IFN .FTSPC,<	;ALL GOES UNDER CONDITIONAL ASSEMBLY OPTION
;HERE ON NORMAL DISPATCH TO ENTER SURPRESSION CONDITIONAL
SPCOUT:	SETOM	SUPCON			;ASSUME WE'LL START SUPPRESSING
	CAIN	N,1			;BUT IF N IS SINGULAR,
	  MOVNS	SUPCON			;  DO OUTPUT IN CONDITIONAL
	POPJ	P,			;RETURN
;HERE INSTEAD OF DISPATCH WHEN IN SUPPRESS CONDITIONAL
DOSUP:	CAIN	C,"\"			;IF WE'VE GOT A CONDITIONAL FLIP,
	  JRST	DOSUP1			;  THEN DO SPECIAL STUFF
	CAIN	C,")"			;IF WE'VE GOT A CONDTIONAL END,
	  JRST	DOSUP2			;  DO OTHER SPECIAL STUFF
	SKIPG	SUPCON			;OTHERWISE, IF WE ARE SUPPRESSING,
	  AOS	(P)			;  THEN SKIP THE NORMAL DISPATCH
	POPJ	P,			;RETURN TO DISPATCH OR NEXT CHAR
DOSUP1:	MOVNS	SUPCON			;HERE TO FLIP CONDITIONAL ON "\"
	CAIA				;SKIP AND DON'T OUTPUT IT
DOSUP2:	SETZM	SUPCON			;HERE TO END CONDTIONAL ON ")"
	AOS	(P)			;AVOID THE OUTPUT DISPATCH
	POPJ	P,			;RETURN FOR NEXT CHARACTER
>;END OF IFN .FTSPC CONDITIONAL
	SUBTTL	ACTION CHARACTER CODE TABLE AND DISPATCH TABLE

DEFINE	ITEM (ACT,CHR) <IFN .FT'ACT,<EXP CHR>>
ACTCHR:	ACTDEF			;GENERATE THE CHARACTER TABLE

DEFINE	ITEM (ACT,CHR)
<IFN .FT'ACT,<IFNDEF ACT'OUT,<EXTERN ACT'OUT>
		EXP ACT'OUT>>
ACTDSP:	ACTDEF			;NOW MAKE THE DISPATCH TABLE
	EXP	NOACT		;AND APPEND THE NO ACTION DISPATCH

	PRGEND			;END OF ACTOUT ROUTINE
	TITLE	ERROUT	OUTPUT ERROR MESSAGES PRECEDED BY PREFIX IN "ERR"

	ENTRY	WRNOUT,FTLOUT,ERROUT
	EXTERN	STROUT,BRKOUT,CLFOUT,CHROUT,SXSOUT,DSPOUT,SIX
	SEARCH	AC
	TWOSEG

	OPDEF	PJRST [JRST]

ERR::	EXP	0		;PLACE TO PUT SIXBIT ERROR CODES

	RELOC	400000

WRNOUT:	MOVEI	C,"%"			;LOAD A WARNING INDICATOR
	PUSHJ	P,ERROUT		;OUTPUT THE ERROR HEADER
	PJRST	STROUT			;OUTPUT THE MESSAGE AND RETURN

FTLOUT:	MOVEI	C,"?"			;LOAD A FATAL INDICATOR
	PUSHJ	P,ERROUT		;OUTPUT THE ERROR HEADER
	PUSHJ	P,STROUT		;OUTPUT THE MESSAGE
	PUSHJ	P,BRKOUT		;FORCE OUT THE BUFFERS
	EXIT	1,			;AND RETURN TO MONITOR
	POPJ	P,			;BUT LET USER CONTINUE

ERROUT:	PUSH	P,C			;SAVE THE ERROR MARKER
	PUSHJ	P,CLFOUT		;GET A NEW LINE
	POP	P,C			;LOAD THE SAVED MARKER
	PUSHJ	P,CHROUT		;SEND IT OUT
	PUSH	P,ERR			;TRANSFER ERROR CODE
	POP	P,SIX			;TO SIXBIT OUTPUT BUFFER
	PJRST	SXSOUT			;NO TRAILING SPACES AND RETURN

	PRGEND
	TITLE	APCOUT	OUTPUT "AT USER PC N" OF N

	ENTRY	APCOUT
	EXTERN	STROUT,RHFOUT
	SEARCH	AC
	TWOSEG

	OPDEF	PJRST [JRST]

	RELOC	400000

APCOUT:	PUSH	P,M			;SAVE CURRENT MESSAGE POINTER
	MOVEI	M,[ASCIZ/at user PC /]	;LOAD OUR OWN (LOWER CASE!)
	PUSHJ	P,STROUT		;OUTPUT THE CHARS
	POP	P,M			;RESTORE OLD M
	PJRST	RHFOUT			;TYPE RH OF N AND RETURN

	PRGEND
	TITLE	DATOUT	OUTPUT THE CURRENT DATE IN DD-MMM-YY FORMAT

	ENTRY	DATOUT
	EXTERN	DECOUT,CHROUT,STROUT,TSAV2
	SEARCH	AC
	TWOSEG

	RELOC	400000

DATOUT:	PUSHJ	P,TSAV2			;SAVE TEMPS WITH AUTO RESTORE
	PUSH	P,N			;SAVE THE NUMBER REGISTER
	PUSH	P,M			;AND THE MESSAGE POINTER
	DATE	T1,			;GET THE DATE IN 15-BIT FORMAT
	IDIVI	T1,^D31			;PUT DAY NUMBER - 1 IN T2
	MOVEI	N,1(T2)			;INCREMENT AND LOAD INTO N
	PUSHJ	P,DECOUT		;OUTPUT THE DECIMAL CHARACTERS
	MOVEI	C,"-"			;LOAD A HYPHEN
	PUSHJ	P,CHROUT		;AND SEND IT OUT
	IDIVI	T1,^D12			;PUT MONTH NUMBER - 1 IN T2
	MOVEI	M,MONTAB(T2)		;LOAD POINTER TO MONTH TABLE
	PUSHJ	P,STROUT		;OUTPUT THE STRING WITH A HYPHEN
	ADDI	T1,^D1964		;CALCULATE THE YEAR NUMBER
	IDIVI	T1,^D100		;EVERYONE KNOWS THE CENTURY
	MOVEI	N,(T2)			;LOAD N WITH THE 2-DIGIT YEAR
	MOVEI	C,"0"			;PUT A LEADING ZERO IN C
	CAIGE	N,^D10			;IN CASE YEAR IS ONLY ONE DIGIT
	  PUSHJ	P,CHROUT		;SO WON'T SCREW UP FORMAT
	PUSHJ	P,DECOUT		;AND OUTPUT THE YEAR
	POP	P,M			;RESTORE MESSAGE POINTER
	POP	P,N			;RESTORE NUMBER REGISTER
	POPJ	P,			;RESTORE TEMPS AND RETURN

DEFINE	MONTHS (MMM) <IRP MMM,<ASCIZ/'MMM'-/>>
MONTAB:	MONTHS	<Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec>

	PRGEND
	TITLE	TIMOUT	OUTPUT THE CURRENT TIME IN HH:MM:SS FORMAT

	ENTRY	TIMOUT
	EXTERN	CHROUT,DECOUT,TSAV2
	SEARCH	AC
	TWOSEG

	OPDEF	PJRST [JRST]

	RELOC	400000

TIMOUT:	PUSHJ	P,TSAV2			;SAVE TEMPS WITH AUTO RESTORE
	PUSH	P,N			;ALSO SAVE NUMBER REGISTER
	MSTIME	T1,			;GET TIME OF DAY IN MILLISECS
	IDIVI	T1,^D1000		;DIVIDE OUT THE MILLISECONDS
	CAIL	T2,^D500		;IF MORE THAN HALF A SECOND,
	  AOJ	T1,			;  THEN ROUND UP TO NEXT SEC
	IDIVI	T1,^D60			;PUT NUMBER OF SECONDS IN T2
	PUSH	P,T2			;AND SAVE IT FOR LATER
	IDIVI	T1,^D60			;SEPARATE HOURS AND MINUTES
	MOVEM	T1,N			;LOAD THE HOURS
	PUSHJ	P,DECOUT		;OUTPUT THE CHARS
	MOVEM	T2,N			;LOAD THE MINUTES
	PUSHJ	P,DOTIM			;OUTPUT BOTH DIGITS
	POP	P,N			;LOAD THE SAVED SECONDS
	PUSHJ	P,DOTIM			;OUTPUT BOTH DIGITS
	POP	P,N			;RESTORE ORIGINAL N
	POPJ	P,			;RESTORE AND RETURN
DOTIM:	MOVEI	C,":"			;LOAD UP A COLON
	PUSHJ	P,CHROUT		;GET IT OUT OF HERE
	MOVEI	C,"0"			;LOAD A ZERO CHAR
	CAIGE	N,^D10			;MAKE SURE WE'VE GOT TWO DIGITS
	  PUSHJ	P,CHROUT		;ELSE NEED AN EXTRA ZERO
	PJRST	DECOUT			;OUTPUT THE WHATEVER AND RETURN

	PRGEND
	TITLE	LINOUT	OUTPUT ASCIZ STRING FOLLOWED BY A CRLF

	ENTRY	LINOUT
	EXTERN	STROUT,CLFOUT
	SEARCH	AC
	TWOSEG

	OPDEF	PJRST [JRST]

	RELOC	400000

LINOUT:	PUSHJ	P,STROUT		;DO A NORMAL STRING OUTPUT
	PJRST	CLFOUT			;DO A CRLF AND RETURN

	PRGEND
	TITLE	STROUT	OUTPUT A PLAIN OLD ASCIZ STRING

	ENTRY	STROUT
	EXTERN	CHROUT
	SEARCH	AC
	TWOSEG

	RELOC	400000

STROUT:	HRLI	M,440700		;MAKE M AN ILDB POINTER
	ILDB	C,M			;LOAD A CHARACTER FROM STRING
	SKIPN	C			;IF IT'S THE TERMINATING NULL,
	  POPJ	P,			;  THEN RETURN
	PUSHJ	P,CHROUT		;OTHERWISE, OUTPUT CHARACTER
	JRST	STROUT+1		;AND LOOP FOR NEXT CHARACTER

	PRGEND
	TITLE	FILOUT	OUTPUT FULL FILE SPECIFICATION (DEV,FIL,EXT,PPN)

	ENTRY	FILOUT
	EXTERN	DEVOUT,SXSOUT,PPNOUT,CHROUT,SIX
	SEARCH	AC
	TWOSEG

	OPDEF	PJRST [JRST]

FIL::	EXP	0		;FOR SIXBIT FILE NAME
EXT::	EXP	0		;FOR SIXBIT EXTENSION (IN LEFT)

	RELOC	400000

FILOUT:	PUSHJ	P,DEVOUT		;OUTPUT THE DEVICE NAME
	PUSH	P,FIL			;TRANSFER FILE NAME
	POP	P,SIX			;TO SIXBIT OUTPUT BUFFER
	PUSHJ	P,SXSOUT		;DO FILE WITHOUT TRAILING SPACES
	HLLZS	EXT			;ZERO RIGHT HALF OF EXTENSION
	SKIPN	EXT			;IF THERE'S NO EXTENSION,
	  PJRST	PPNOUT			;  JUST DO PPN AND RETURN
	MOVEI	C,"."			;LOAD A PERIOD
	PUSHJ	P,CHROUT		;OUTPUT IT THE SEPARATOR
	PUSH	P,EXT			;OTHERWISE, TRANSFER EXTENSION
	POP	P,SIX			;TO SIXBIT OUTPUT BUFFER
	PUSHJ	P,SXSOUT		;OUTPUT LEFT HALF EXTENSION
	PJRST	PPNOUT			;OUTPUT PPN AND RETURN

	PRGEND
	TITLE	DEVOUT	OUTPUT SIXBIT DEVICE LEFT JUSTIFIED IN "DEV"

	ENTRY	DEVOUT
	EXTERN	SXSOUT,CHROUT,SIX
	SEARCH	AC
	TWOSEG

	OPDEF	PJRST [JRST]

DEV::	EXP	0		;SIXBIT DEVICE NAME

	RELOC	400000

DEVOUT:	SKIPN	DEV			;IF THERE'S NO DEVICE
	  POPJ	P,			;  DON'T DO ANYTHING
	PUSH	P,DEV			;OTHERWISE, TRANSFER DEVICE
	POP	P,SIX			;TO SIXBIT OUTPUT BUFFER
	PUSHJ	P,SXSOUT		;AND OUTPUT THE DEVICE
	MOVEI	C,":"			;THEN LOAD A COLON
	PJRST	CHROUT			;OUTPUT IT AND RETURN

	PRGEND
	TITLE	SIXOUT	OUTPUT THE SIXBIT CHARACTERS IN "SIX"

	ENTRY	SIXOUT,SXSOUT
	EXTERN	CHROUT,TSAV3,TSAV2
	SEARCH	AC
	TWOSEG

	OPDEF	PJRST [JRST]

SIX::	EXP	0		;PLACE WHERE SIXBIT MUST BE LOADED

	RELOC	400000

SIXOUT:	PUSHJ	P,TSAV3			;SAVE THREE TEMPS W/ AUTO RESTORE
	MOVEI	T3,6			;LOAD SIX CHARACTER COUNT
	MOVE	T2,SIX			;LOAD THE SIXBIT WORD
	PUSHJ	P,DOSIX			;SHIFT IN AND OUTPUT THE CHAR
	SOJG	T3,.-1			;LOOP UNTIL NO MORE CHARS
	POPJ	P,			;RESTORE TEMPS AND RETURN
SXSOUT:	PUSHJ	P,TSAV2			;THIS IS THE SAME AS SIXOUT BUT
	MOVE	T2,SIX			;SURPRESSES ALL TRAILING SPACES
	SKIPN	T2			;IF NO MORE CHARACTERS LEFT,
	  POPJ	P,			;  RESTORE TEMPS AND RETURN
	PUSHJ	P,DOSIX			;ELSE SHIFT AND OUTPUT CHAR
	JRST	.-3			;KEEP LOOPING FOR TEST
DOSIX:	SETZ	T1,			;CLEAR SOME WORKING SPACE
	LSHC	T1,6			;SHIFT IN THE SIXBIT CHAR
	MOVEI	C,40(T1)		;CONVERT IT TO ASCII
	PJRST	CHROUT			;OUTPUT CHAR AND RETURN TO ABOVE

	PRGEND
	TITLE	PPNOUT	OUTPUT [PROJ,PROG] PAIR IN "PPN"

	ENTRY	PPNOUT
	EXTERN	CHROUT,OCTOUT
	SEARCH	AC
	TWOSEG

	OPDEF	PJRST [JRST]

PPN::	EXP	0		;PPN TO BE OUTPUT

	RELOC	400000

PPNOUT:	SKIPN	PPN			;IF NO PPN STATED,
	  POPJ	P,			;  DON'T OUTPUT ANYTHING
	MOVEI	C,"["			;ELSE LOAD AN OPEN BRACKET
	PUSHJ	P,CHROUT		;SEND IT TO BE OUTPUT
	PUSH	P,N			;SAVE THE CURRENT N
	HLRZ	N,PPN			;LOAD PROJECT NUMBER
	PUSHJ	P,OCTOUT		;OUTPUT FIRST HALF
	MOVEI	C,","			;LOAD A COMMA
	PUSHJ	P,CHROUT		;OUTPUT THE SEPARATOR
	HRRZ	N,PPN			;LOAD PROGRAMMER NUMBER
	PUSHJ	P,OCTOUT		;OUTPUT THE SECOND HALF
	POP	P,N			;RESTORE PREVIOUS N
	MOVEI	C,"]"			;LOAD A CLOSE BRACKET
	PJRST	CHROUT			;OUTPUT IT AND RETURN

	PRGEND
	TITLE	NUMOUT	OUTPUT N IN DECIMAL, OCTAL, OR ANY RADIX IN "RAD"

	ENTRY	DECOUT,OCTOUT,NUMOUT,DIGOUT
	EXTERN	TSAV2,CHROUT
	SEARCH	AC
	TWOSEG

RAD::	EXP	0		;THE CURRENT RADIX

	RELOC	400000

DECOUT:	MOVEM	T1,RAD			;SAVE A TEMP IN RADIX
	MOVEI	T1,^D10			;LOAD A DECIMAL BASE
	EXCH	T1,RAD			;RESTORE T1 AND SET RADIX
	JRST	NUMOUT			;DO THE NUMOUT ROUTINE
OCTOUT:	MOVEM	T1,RAD			;SAVE A TEMP IN RADIX
	MOVEI	T1,^O10			;LOAD AND OCTAL BASE
	EXCH	T1,RAD			;RESTORE T1 AND SET RADIX
					;FALL THROUGH TO NUMOUT
NUMOUT:	PUSHJ	P,TSAV2			;SAVE TWO TEMPS W/ AUTO RESTORE
	SKIPL	T1,N			;CHECK SIGN OF AND LOAD N
	  JRST	DONUM			;POSITIVE OR ZERO--AHEAD
	MOVNS	T1			;NEGATIVE--REVERSE THE SIGN
	MOVEI	C,"-"			;LOAD A MINUS SIGN
	PUSHJ	P,CHROUT		;OUTPUT THE INDICATOR
DONUM:	IDIV	T1,RAD			;PUT REMAINDER IN T2
	HRLM	T2,(P)			;STORE DIGIT IN LEFT OF STACK
	SKIPE	T1			;IF STILL MORE DIGITS,
	  PUSHJ	P,DONUM			;  DO RECURSIVE CALL
	HLRZ	C,(P)			;ELSE RESTORE LAST DIGIT
DIGOUT:	MOVEI	C,"0"(C)		;CONVERT TO ASCII CHAR
	PUSHJ	P,CHROUT		;AND OUTPUT IT
	POPJ	P,			;DO NEXT DIGIT OR RETURN

	PRGEND
	TITLE	DMPOUT	OUTPUT N IN OCTAL DUMP FORMAT (WITH LEADING 0'S)

	ENTRY	DMPOUT,RHFOUT,LHFOUT
	EXTERN	SPCOUT,CHROUT,TSAV3
	SEARCH	AC
	TWOSEG

	OPDEF	PJRST [JRST]

	RELOC	400000

DMPOUT:	PUSHJ	P,LHFOUT		;FIRST DO THE LEFT HALF
	PUSHJ	P,SPCOUT		;THEN OUTPUT ONE SPACE
					;FALL THROUGH FOR RIGHT AND RETURN
RHFOUT:	PUSHJ	P,TSAV3			;SAVE THREE TEMPS W/ AUTO RESTORE
	HRLZ	T2,N			;LOAD UP RIGHT HALF OF N
	PJRST	DOHLF			;OUTPUT THE HALF AND RETURN
LHFOUT:	PUSHJ	P,TSAV3			;SAVE THREE TEMPS W/ AUTO RESTORE
	HLLZ	T2,N			;LOAD UP LEFT HALF OF N
					;FALL THROUGH AND RETURN
DOHLF:	MOVEI	T3,6			;LOAD SIX DIGIT COUNT
DODMP:	SETZ	T1,			;CLEAR WORKING SPACE
	LSHC	T1,3			;SHIFT IN ONE DIGIT
	MOVEI	C,"0"(T1)		;LOAD ITS ASCII VALUE
	PUSHJ	P,CHROUT		;OUTPUT THE CHARACTER
	SOJG	T3,DODMP		;LOOP UNTIL NO MORE DIGITS
	POPJ	P,			;RESTORE TEMPS AND RETURN

	PRGEND
	TITLE	MISC	OUTPUT OF COMMON MISCELLANEOUS CHARACTERS

	ENTRY	DLFOUT,CLFOUT,DSPOUT,SPCOUT,BRKOUT,TABOUT,PLUOUT
	EXTERN	CHROUT
	SEARCH	AC
	TWOSEG

	OPDEF	PJRST [JRST]

	RELOC	400000

DLFOUT:	PUSHJ	P,CLFOUT		;HERE TO OUTPUT A DOUBLE CRLF
CLFOUT:	MOVEI	C,15			;LOAD A CARRIAGE RETURN
	PUSHJ	P,CHROUT		;GO OUTPUT IT
	MOVEI	C,12			;LOAD A LINE FEED
	PJRST	CHROUT			;OUTPUT IT AND RETURN

DSPOUT:	PUSHJ	P,SPCOUT		;HERE FOR A DOUBLE SPACE
SPCOUT:	MOVEI	C,40			;HERE TO OUTPUT A SPACE
	PJRST	CHROUT			;OUTPUT IT AND RETURN

BRKOUT:	TDZA	C,C			;HERE TO FORCE OUT BUFFERS
TABOUT:	MOVEI	C,11			;HERE TO OUTPUT A TAB
	PJRST	CHROUT			;DO WHATEVER AND RETURN

PLUOUT:	CAIN	N,1			;HERE TO MAKE THE WORD PLURAL
	  POPJ	P,			;ONLY IF N IS NOT SINGULAR
	MOVEI	C,"S"+40		;LOAD UP A LOWER CASE "S"
	PJRST	CHROUT			;OUTPUT IT AND RETURN

	PRGEND
	TITLE	CHROUT	OUTPUT OF THE SINGLE CHARACTER IN C

	ENTRY	CHROUT,FLCOUT,FUCOUT,FNCOUT
	EXTERN	TSAV2,TSAV1
	SEARCH	AC
	TWOSEG

	OPDEF	PJRST [JRST]

IFNDEF	.FTMOD,<.FTMOD==3>	;MAXIMUM OUTPUT DEVICES (ONLY TTY IF 0)
IFNDEF	.FTLMD,<.FTLMD==-1>	;LINE MODE OUTPUT (BREAK ON LF,FF,VT)
IFNDEF	.FTTBL,<.FTTBL==^D80>	;TERMINAL BUFFER LENGTH (OUTCHR IF 0)
IFNDEF	.FTIOE,<.FTIOE==0>	;FLAG TO IGNORE OUTPUT ERRORS (WHO?)

CFORCE:	EXP	0		;CASE FORCE FLAG (-1 LOWER, 0 NONE, 1 UPPER)
IFG .FTTBL,<
TBCNTR:	EXP	0		;TERMINAL BUFFER COUNTER (FREE CHARS)
TBPNTR:	EXP	0		;TERMINAL BUFFER POINTER (FOR IDPB)
TOBUFR:	BLOCK	<.FTTBL/5>+1	;THE TERMINAL OUTPUT BUFFER (FOR OUTSTR)
>;END OF IFG .FTTBL CONDITIONAL
IFG .FTMOD,<
OUTLST::BLOCK	.FTMOD		;OUTPUT DEVICE LIST (-1 FOR TTY)
>;END OF IFG .FTMOD CONDITIONAL	;(FORMAT: CHANNEL,,BUFFER RING HEADER ADR)
				;(ZERO ENTRIES IGNORED, DON'T TERMINATE)


	RELOC	400000

IFG .FTMOD,<OLPNTR:XWD -.FTMOD,OUTLST>	;INITIAL AOBN POINTER TO OUTPUT LIST

;ENTRIES TO DETERMINE CONVERSION OF UPPER/LOWER CASE (100-137,140-177)
FUCOUT:	SETZM	CFORCE			;HERE TO FORCE UPPER CASE
	AOSA	CFORCE			;MAKE FLAG POSITIVE
FLCOUT:	SETOM	CFORCE			;HERE TO FORCE LOWER CASE (NEGATIVE)
	POPJ	P,			;RETURN
FNCOUT:	SETZM	CFORCE			;HERE TO CLEAR FORCE REQUEST (ZERO)
	POPJ	P,			;RETURN


;HERE IS THE ROUTINE YOU'VE ALL BEEN WAITING FOR
CHROUT:	CAIGE	C,100			;IF NOT IN CHARACTER RANGE,
	  JRST	CHR0			;  DON'T CHECK FOR CASE FORCE
	CAIGE	C,140			;IF NOT IN UPPER CASE RANGE,
	SKIPL	CFORCE			;OR NOT FORCING LOWER CASE,
	 CAIA				; DON'T DO ANYTHING
	  ADDI	C,40			;  ELSE CONVERT TO LOWER CASE
	CAIL	C,140			;IF NOT IN LOWER CASE RANGE,
	SKIPG	CFORCE			;OR NOT FORCING UPPER CASE,
	 CAIA				; DON'T DO ANYTHING
	  SUBI	C,40			;  ELSE CONVERT TO UPPER CASE
CHR0:					;DO THE APPROPRIATE CHROUT ROUTINE
	SUBTTL	CHROUT ROUTINE MAIN BODY

IFG .FTMOD,<	;ALL THIS GOES UNDER MULTIPLE OUTPUT DEVICE CONDITIONAL
	PUSHJ	P,TSAV2			;SAVE TWO TEMPS W/ AUTO RESTORE
	TRNN	C,177			;IF WE WERE SENT A NULL BYTE,
	  PJRST	EMPALL			;  JUST EMPTY ALL THE BUFFERS
	MOVE	T1,OLPNTR		;LOAD AOBJ POINTER TO OUTPUT LIST
	SKIPE	T2,(T1)			;LOAD AN OUTPUT SPEC FROM LIST
	  PUSHJ	P,DOCHR			;DO THIS DEVICE IF GIVEN
	AOBJN	T1,.-2			;LOOP UNTIL END OF LIST
IFN .FTLMD,<CAIG C,14			;IF GREATER THAN A FORM FEED,
	CAIGE	C,12>			;OR LESS THAN A LINE FEED,
	  POPJ	P,			;  THEN RESTORE AND RETURN
EMPALL:	MOVE	T1,OLPNTR		;HERE TO FORCE OUT ALL BUFFERS
	SKIPE	T2,(T1)			;LOAD AN OUTPUT SPEC FROM LIST
	  PUSHJ	P,DOBUF			;DO THIS DEVICE IF GIVEN
	AOBJN	T1,.-2			;LOOP UNTIL END OF LIST
	POPJ	P,			;AND RESTORE AND RETURN
>;END OF IFG .FTMOD CONDITIONAL

IFLE .FTMOD,<	;OTHERWISE ALL OUTPUT GOES ONLY TO TERMINAL
IFG .FTTBL,<	;FIRST CHOICE IS FOR INTERNALLY BUFFERED OUTPUT
	PUSHJ	P,TSAV2			;SAVE TEMPS ONLY IF WILL BE USED
	TRNN	C,177			;IF WE'VE GOT A NULL BYTE,
	  PJRST	TTYEMP			;  JUST EMPTY BUFFER AND RETURN
IFN .FTLMD,<PUSHJ P,TTYPUT		;PUT THE CHARACTER IN BUFFER
	CAIG	C,14			;IF GREATER THAN A FORM FEED,
	CAIGE	C,12			;OR LESS THAN A LINE FEED,
	  POPJ	P,			;  JUST DO THE RETURN
	PJRST	TTYEMP>			;OTHERWISE, EMPTY BUFFER FIRST
IFE .FTLMD,<PJRST TTYPUT>		;OR JUST PUT CHARACTER AND RETURN
>;END OF IFG .FTTBL CONDITIONAL
IFLE .FTTBL,<	;SECOND CHOICE IS FOR OUTCHR'S INSTEAD
	TRNN	C,177			;MAKE SURE THERE IS A CHARACTER
	  POPJ	P,			;JUST RETURN IF THERE ISN'T ONE
	PJRST	TTYPUT			;ELSE OUTCHR CHARACTER AND RETURN
>;END OF IFLE .FTTBL CONDITIONAL
>;END OF IFLE .FTMOD CONDITIONAL
	SUBTTL	BUFFER ROUTINES FOR CHROUT

IFG .FTMOD,<				;HERE TO PUT A CHAR IN BUFFER
DOCHR:	JUMPL	T2,TTYPUT		;NEGATIVE ENTRY MEANS FOR TTY
BUFPUT:	SOSG	2(T2)			;HERE TO DO IT FOR MONITOR BUFFER
	  PUSHJ	P,BUFEMP		;EMPTY BUFFER IF ALREADY FULL
	IDPB	C,1(T2)			;LOAD CHAR INTO REAL BUFFER
	POPJ	P,>			;AND RETURN
TTYPUT:					;HERE FOR TTY CHAR ROUTINE
IFLE .FTTBL,<OUTCHR C>			;IF NO TTY BUFFER, USE OUTCHR
IFG .FTTBL,<SOSG TBCNTR			;ELSE DECREMENT FREE BYTE COUNT
	  PUSHJ	P,TTYEMP		;EMPTY TTY BUFFER IF ALREADY FULL
	IDPB	C,TBPNTR>		;LOAD UP CHAR INTO TTY BUFFER
	POPJ	P,			;AND RETURN

IFG .FTMOD,<	;THIS ROUTINE ONLY NEEDED FOR MULTIPLE OUTPUT DEVICES
DOBUF:	SKIPG	T2			;NEGATIVE MEANS FOR TTY
IFG .FTTBL,<PJRST TTYEMP>		;EMPTY TTY BUFFER AND RETURN
IFLE .FTTBL,<POPJ P,>			;ALTERNATE IF OUTCHR METHOD
BUFEMP:	PUSHJ	P,TSAV1			;HERE FOR REGULAR OUT
	MOVSI	T1,17			;LOAD AC FIELD WIDTH
	AND	T1,T2			;LOAD CHANNEL SPEC
	LSH	T1,5			;SHIFT INTO PLACE
IFE .FTIOE,<TLO T1,(OUT)>		;MAKE AN OUT UUO
IFN .FTIOE,<TLO T1,(OUTPUT)>		;(OUTPUT UUO IF IGNORING ERRORS)
	XCT	T1			;AND EXECUTE IT
	  POPJ	P,			;NORMAL RETURN
IFE .FTIOE,<TLZ T1,777000		;ERROR--CLEAR OP-CODE
	TLO	T1,(GETSTS)		;MAKE A GETSTS UUO
	PUSH	P,0			;FIRST SAVE AC 0
	XCT	T1			;EXECUTE THE GETSTS
	OUTSTR	[ASCIZ/
? Output error in CHROUT -- channel status bits in AC 0
/]					;TYPE OUT ERROR MESSAGE
	EXIT	1,			;AND BOMB
	POP	P,0			;BUT ALLOW CONTINUE
	POPJ	P,			;RETURN ANYWAY
>;END OF IFE .FTIOE CONDITIONAL
>;END OF IFG .FTMOD CONDITIONAL

IFG .FTTBL,<	;THIS ROUTINE ONLY IF DOING INTERNALLY BUFFERED OUTPUT TO TTY
TTYEMP:	SKIPN	TBPNTR			;IF POINTER NOT SET UP,
	  JRST	.+4			;  THEN JUST INIT FIRST TIME
	SETZ	T2,			;ELSE PREPARE TO DEPOSIT A NULL
	IDPB	T2,TBPNTR		;AT THE END OF THE TTY BUFFER
	OUTSTR	TOBUFR			;SO OUTSTR KNOWS WHEN TO STOP
	MOVEI	T2,.FTTBL		;LOAD TTY BUFFER LENGTH
	MOVEM	T2,TBCNTR		;INITIALIZE COUNTER
	MOVE	T2,[POINT 7,TOBUFR]	;LOAD TTY BUFFER POINTER
	MOVEM	T2,TBPNTR		;NOW INITIALIZE IT, TOO
	POPJ	P,			;AND RETURN
>;END OF IFG .FTTBL CONDITIONAL

	PRGEND
	TITLE	PDLTSV	PDL MANIPULATION ROUTINES FOR SAVING TEMPS

	ENTRY	TSAV1,TSAV2,TSAV3,TRES3,TRES2,TRES1
	SEARCH	AC
	TWOSEG

	OPDEF	PJRST [JRST]

	RELOC	400000

TSAV1:	EXCH	T1,(P)			;SAVE T1 AND RECOVER RETURN
	MOVEM	T1,1(P)			;PUT IT AHEAD OF THE STACK
	MOVE	T1,(P)			;FIX UP T1 FOR SUBROUTNE
	PUSHJ	P,@1(P)			;CONTINUE IN CALLED ROUTINE
	  CAIA				;RETURN HERE IF NORMAL
	AOS	-1(P)			;RETURN HERE IF SKIP
	PJRST	TRES1			;RESTORE AND RETURN
TSAV2:	EXCH	T1,(P)			;SAVE T1 AND RECOVER RETURN
	PUSH	P,T2			;ALSO SAVE T2
	MOVEM	T1,1(P)			;PUT RETURN AHEAD OF STACK
	MOVE	T1,-1(P)		;FIX UP T1 FOR SUBROUTINE
	PUSHJ	P,@1(P)			;CONTINUE IN CALLED ROUTINE
	  CAIA				;RETURN HERE IF NORMAL
	AOS	-2(P)			;RETURN HERE IF SKIP
	PJRST	TRES2			;RESTORE AND RETURN
TSAV3:	EXCH	T1,(P)			;SAVE T1 AND RECOVER RETURN
	PUSH	P,T2			;ALSO SAVE T2
	PUSH	P,T3			;ALSO SAVE T3
	MOVEM	T1,1(P)			;PUT RETURN AHEAD OF STACK
	MOVE	T1,-2(P)		;FIX UP T1 FOR SUBROUTINE
	PUSHJ	P,@1(P)			;CONTINUE IN CALLED ROUTINE
	  CAIA				;RETURN HERE IF NORMAL
	AOS	-3(P)			;RETURN HERE IF SKIP
TRES3:	POP	P,T3			;RESTORE T3
TRES2:	POP	P,T2			;RESTORE T2
TRES1:	POP	P,T1			;RESTORE T1
	POPJ	P,			;RETURN TO ORIGINAL CALLER

	PRGEND


	TITLE	PDLCPJ	PDL MANIPULATION ROUTINES FOR DOING SKIP RETURNS

	ENTRY	CPOPJ2,CPOPJ1,CPOPJ0
	SEARCH	AC
	TWOSEG

	RELOC	400000

CPOPJ2:	AOS	(P)			;NON-STANDARD DOUBLE SKIP RETURN
CPOPJ1:	AOS	(P)			;REGULAR (APPROVED) SKIP RETURN
CPOPJ0:	POPJ	P,			;STRAIGHT RETURN (FOR JUMPE, ETC.)

	END