Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	TITLE GLXTXT	--  Formatted Text Handler for GLXLIB
	SUBTTL	Preliminaries

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975, 1988.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A  LICENSE AND MAY BE USED AND  COPIED
;	ONLY IN  ACCORDANCE  WITH  THE  TERMS OF  SUCH  LICENSE  AND  WITH  THE
;	INCLUSION OF THE ABOVE  COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY  OTHER
;	COPIES THEREOF MAY NOT BE PROVIDED  OR OTHERWISE MADE AVAILABLE TO  ANY
;	OTHER PERSON.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.


	SEARCH	GLXMAC,ORNMAC		;GET AT GALAXY LIBRARY SYMBOLS
	PROLOG(GLXTXT,TXT)		;PRODUCE PROLOG CODE

	TXTMAN==:0			;Maintenance edit number
	TXTDEV==:101			;Development edit number
	VERSIN (TXT)			;Generate edit number

	EXTERNAL IPCEDT,KBDEDT,LNKEDT
	EXSYM1==:IPCEDT+KBDEDT+LNKEDT+TXTEDT	;Calculate part of GLXVRS

	ENTRY	T%INIT			;INITIALIZATION 
	ENTRY	T%TEXT			;$TEXT ENTRY POINT
	ENTRY	T%TTY			;DEFAULT TERMINAL OUTPUT

	GLOB	<IIB>			;IIB is external
	GLOB	<CNTDT>			;CNTDT is external
TOPS10<	GLOB	<CNVNOD>>		;CNVNOD is external


; This file contains the support code for the $TEXT macro, which
;	is responsible for formatting all static string and variable type
;	output.  For a more detailed explanation of the $TEXT macro, please
;	refer to the GLXMAC and GLXLIB modules.

; This module differs from most members of the GLXLIB family in two respects.
;	First, it is called via a pseudo instruction, $TEXT, rather than
;	via the usual S1/S2 accumulator calls.  Secondly, all ACs are preserved
;	across calls, which are skippable.

; The user of the $TEXT instruction must provide one or several output routines.
; This routine must conform to the standard GLXLIB conventions.

	Subttl	Table of Contents

;		     Table of Contents for GLXTXT
;
;				  Section		      Page
;
;
;    1. Revision History . . . . . . . . . . . . . . . . . . .   4
;    2. Local Macros . . . . . . . . . . . . . . . . . . . . .   5
;    3. Global storage . . . . . . . . . . . . . . . . . . . .   6
;    4. T%INIT - Initialize the TEXT module  . . . . . . . . .   7
;    5. T%TEXT - Routine to format text output . . . . . . . .   8
;    6. T%TTY - Buffered terminal output routine . . . . . . .  10
;    7. PROBLK - Process an entire T%TEXT argument block . . .  11
;    8. PROARG - Routine to process each T%TEXT argument . . .  12
;    9. PROTXT - ROUTINE TO PROCESS THE ACTUAL FUNCTION  . . .  13
;   10. PTAB - Dispatch table for argument processors  . . . .  14
;   11. PROx - Processors for each type of formatting  . . . .  15
;   12. PROT - Process a string of ASCIZ text  . . . . . . . .  16
;   13. PROQ - Process a byte pointer to an ASCIZ string . . .  17
;   14. PROB - Process a GLXLIB object block . . . . . . . . .  18
;   15. PRO1 - Process an object type  . . . . . . . . . . . .  19
;   16. PROO - Process unsigned octal numbers  . . . . . . . .  20
;   17. PROF - Process a system dependent file specification .  21
;   18. PRO7 - Process a single 7 bit ASCII character  . . . .  22
;   19. PROP - Process a directory ID of either PPN or directo  23
;   20. PROR - Process routine for Job Info Block  . . . . . .  24
;   21. PROE - Process a GLXLIB error number . . . . . . . . .  26
;   22. PROI - Process an indirect text request  . . . . . . .  27
;   23. PROV - Process a program version number  . . . . . . .  28
;   24. PROM - Process a request for a CONTROL-M (Carriage Ret  29
;   25. FETCH - Routine to get a word from caller's address sp  30
;   26. SPACES - Routine to provide any padding requested  . .  31
;   27. Local output routines  . . . . . . . . . . . . . . . .  32
;   28. PUTU - Output user name or PPN . . . . . . . . . . . .  36
;   29. SAVLVL-RSTLVL - Save and restore TEXT levels . . . . .  37

SUBTTL Revision History


COMMENT \

*****  Release 4.2 -- begin maintenance edits  *****

51	4.2.1216
	Edit 34 prints 'User unknown' when DIRST JSYS fails.
	Likewise for the -10, if the PPN is zero type 'PPN unknown'.

52	4.2.1551	14-Sep-83
	Edit 50 doesn't make it.  Go back to disabling interrupt when
	evaluating arguments with P set funny. 	But be clever and
	check first to see if indirect or indexed info is included in
	argument and skip the whole thing if not.

53	4.2.1580	11-Jul-84
	Add 500 milliseconds to the time returned by CNTDT to give the
	correct time when showing the status of a print or batch job
	submitted with the /AFTER switch using absolute time.
	


*****  Release 5.0 -- begin development edits  *****

60	5.1002		28-Dec-82
	Move to new development area.  Clean up edit organization.  Update TOC.

61	5.1132		9-APR-84
	Calculate part of GLXVRS in this module to get around the Polish
Notation stack limitation of MACRO.

62	5.1218		14-MAY-85
	Use ODTIM JSYS to convert date and time from internal format to ASCII 
text. Delete routine CLCFCT.

63	5.1221		20-Jun-85
	Edit 62 is missing a $RETT in T%INIT.

*****	Release 5.0 -- begin maintenance edits	*****

70	Increment maintenance edit level for version 5 of GALAXY.

*****	Release 6.0 -- begin development edits	*****

100	6.1021		19-Oct-87
	Change PROB to process remote LPT name blocks.
	Change edit numbers

101	6.1225		8-Mar-88
	Update copyright notice.

\   ;End of Revision History

SUBTTL Local Macros

; These macros are pseudo instructions, and as such they
;	preserve all registers and are skippable.


; Define a local macro for printing single characters

	DEFINE $PUT7(CHAR)<
	PUSHJ	P,PUT7X			;;CHARACTER OUTPUT ROUTINE
	XLIST				;;NO NEED TO LIST
	JUMP	"CHAR"			;;NO-OP + CHARACTER
	LIST
 > ;END OF $PUT7 DEFINITION


; DEFINE A LOCAL MACRO FOR PRINTING STRINGS

	DEFINE	$PUTT(STRING)<
	PUSHJ	P,PUTTX
	XLIST
	JUMP	[ASCIZ \STRING\]
	LIST
> ;END OF $PUTT DEFINITION

	SYSPRM	TTXBFS,2,^D10		;TEMPORARY TEXT BUFFER SIZE
	ND	LINSIZ,^D20		;SIZE OF DEFAULT OUTPUT LINE
	ND	EBFSZ,^D20		;SIZE OF BUFFER AREA

SUBTTL Global storage

;Global storage

	$DATA	TXTBEG,0		;BEGINNING OF ZEROABLE $DATA SPACE
	$GDATA	TXTLVL			;LEVEL WE ARE AT

;Local storage

	$DATA	DEFERR			;DEFAULT ERROR EXIT ADDRESS FROM IB.
	$DATA	DEFOUT			;DEFAULT OUTPUT ROUTINE FROM IB

	$DATA	FSAVE,0			;FIRST LOCATION TO SAVE AT EACH LEVEL

	$DATA	LINBUF,LINSIZ		;LINE BUFFER
	  LINMAX==<<LINSIZ>*^D5>-1	;MAXIMUM CHARACTER COUNT

	$DATA	ARGADR			;ADDRESS OF CALLER'S ARG LIST

	$DATA	USRACS,20		;USER-CONTEXT ACS
	$DATA	USROUT			;ADDRESS OF CALLING OUTPUT RTN.
	$DATA	USRARG			;ADDRESS OF USER ARGUMENTS
	$DATA	NXTARG			;POINTS TO NEXT ARGUMENT
	$DATA	MAXARG			;NUMBER OF ARGUMENTS SPECIFIED
	$DATA	USRRET			;FIRST WORD AFTER $TEXT ARG BLOCK

TOPS20<	$DATA	ERRBUF>			;ERROR BUFFER AREA
	$DATA	CAPNTR			;BYTE POINTER FOR PR03 PROCESSING
	$DATA	CALOC			;CURRENT ARGUMENT EFFECTIVE ADDRESS
	$DATA	CAFLG			;CURRENT ARGUMENTS FLAGS
	$DATA	CAPTR			;POINTER WORD FOR CURRENT ARG (IF ANY)
	$DATA	CACCTR			;NUMBER OF CHARACTERS IN CURRENT ARGUMENT
	$DATA	CACMAX			;MAXIMUM CHARACTERS FIELD MAY BE


	$DATA	ENDFLG			;-1=NOTHING,0=CR-LF,+1=NULL AT END
	$DATA	NOOUTP			;-1 WHEN ACTUAL OUTPUT IS SUPRESSED
	$DATA	ERREXT			;A USER EXIT ROUTINE HAS RETURNED FALSE.

	$DATA	TTXBUF,TTXBFS		;PLACE TO BUILD TEMPORARY STRINGS

	$DATA	LINCTR			;COUNTER FOR CURRENT LINE
	$DATA	LINPTR			;POINTER TO CURRENT LINE
	$DATA	TMFCTR			;TIME ADJUSTMENT FACTOR
	$DATA	DSTCHG			;TIME FACTOR IS BASED ON

	$DATA	LSAVE,0			;LAST LOCATION TO SAVE

	  IF1,<SSAREA==<LSAVE-FSAVE-1>>	;SIZE OF THE SAVE AREA
	$DATA	SAREA,SSAREA		;PLACE TO SAVE EACH LEVEL
	$DATA	TXTEND,0		;END OF ZEROABLE $DATA SPACE

SUBTTL T%INIT - Initialize the TEXT module

;This routine puts the TEXT module into a known state and
;	stores the user specified default output routine

;CALL IS:	IIB setup by I%INI1 in GLXINI
;
;TRUE RETURN:	Always

T%INIT:	MOVE	S1,[TXTBEG,,TXTBEG+1]	;BLT PTR TO BEGINNING OF $DATA SPACE
	SETZM	TXTBEG			;KILL THE FIRST WORD
	BLT	S1,TXTEND-1		;NOW KILL THE REST
	SKIPN	S1,IIB+IB.OUT		;PICKUP DEFAULT OUTPUT ROUTINE
	MOVEI	S1,T%TTY		;NONE SPECIFIED..USE OUR DEFAULT
	MOVEM	S1,DEFOUT		;SAVE IT FOR LATER
	MOVE	S1,IIB+IB.ERR		;GET USER ERROR EXIT ROUTINE
	MOVEM	S1,DEFERR		;SAVE IT FOR LATER.
	SETOM	TXTLVL			;INITIALIZE THE COUNT OF LEVELS
	$RETT				;Return

SUBTTL T%TEXT - Routine to format text output

;Calls to T%TEXT come only through invokation of the $TEXT
;	macro, described in GLXMAC.


; Call is:	Pushdown list top entry points to start of argument block-1,
;		which is a JRST around an argument block, formatted as follows:
;
;		PUSHJ	P,T%TEXT	;CALL
;		JRST	%L1		;JUMP AROUND CALL
;		OUTPUT ROUTINE OR B.P.	;ADDR OF CHAR OUTPUT ROUTINE OR -1,,ADDR (BP)
;		FLAGS+<QUAL.#>+ADDRESS	;DESCRIPTION AND ADDRESS OF ARG
;		BYTE POINTER FOR ARG	;ONLY IF A BYTE POINTER IS NEEDED
;		SPACING INFORMATION	;ONLY IF SPACING INFORMATION IS NEEDED
; 		....			;MORE ARGUMENT SINGLETS,PAIRS OR TRIPLETS
;	%L1:
;Where:	Flags tell us whether qualifier takes any argument
;		and whether position and spacing words are present.
; The spacing information is: "CHAR"B6+<SIDE>B17+<Number of positions>B35
;
; Return:	Return is to the location after the PUSHJ to T%TEXT, which
;		is the JRST around the arg block. This makes $TEXT skippable.

T%TEXT:	AOSE	TXTLVL			;INCREMENT LEVEL COUNT
	PUSHJ	P,SAVLVL		;SAVE LEVEL IF NOT FIRST
	MOVEM	0,USRACS		;STORE FIRST AC
	MOVE	0,[XWD 1,USRACS+1]	;TRANSFER USER ACS TO THE
	BLT	0,USRACS+17		;SAVE AREA
	SOS	USRACS+P		;ADJUST SHADOW VERSION OF "P"
	SETZM	ENDFLG			;ASSUME WANTS CR-LF AT END
	SETZM	ERREXT			;NO USER EXIT ERROR.
	SETZM	NOOUTP			;NOT SUPRESSING OUTPUT
	SETOM	LINCTR			;FLAG THAT BUFFER IS NOT IN USE
	MOVE	S1,[POINT 7,LINBUF]	;GET POINTER TO TTY OUTPUT BUFFER
	MOVEM	S1,LINPTR		;AND SAVE IT
	HRRZ	S1,0(P)			;Get return address
	HLRZ	TF,0(S1)		;Get return instruction
	CAIN	TF,(JUMP)		;New style call?
	JRST	TEXT.2			;Yes..Process it
	MOVE	TF,1(S1)		;GET THE USER ROUTINE ADDRESS INSTR.
	MOVE	S1,USRACS+S1		;RESTORE S1 TO ORIGIONAL VALUE.
	XCT	0			;GET THE USER REUTINE/BYTE PTR ADDR.
	HRRZ	S1,0(P)			;RE-GET THE ADDRESS CALLED FROM.
	HRRZ	S2,0(S1)		;GET FIRST WORD PAST ARGUMENT BLOCK
	MOVEM	S2,USRRET		;REMEMBER WHERE IT IS
	SKIPN	S2,0			;FETCH USER OUTPUT ROUTINE ADDRESS
	MOVE	S2,DEFOUT		;IF NONE SPECIFIED, USE DEFAULT
	SKIPN	S2			;HAVE WE GOT ONE SOME WAY?
	MOVEI	S2,T%TTY		;NO, MUST NOT BE INITED YET
	JUMPG	S2,TEXT.1		;HAVE WE GOT A DEFAULT BYTE POINTER?
	HRLI	S2,(POINT 7,0)		;MAKE IT A BYTE POINTER.
	MOVEM	S2,LINPTR		;AND STORE POINTER
	MOVEI	S2,TDPB			;GET ADDR OF ROUTINE TO USE THE POINTER
TEXT.1:	MOVEM	S2,USROUT		;STORE IT AWAY FOR LATER
	ADDI	S1,2			;COMPUTE THE START OF PARAMETER BLOCK
	MOVEM	S1,ARGADR		;REMEMBER IT
TEXT.3:	PUSHJ	P,PROBLK		;PROCESS THE ARGUMENT BLOCK
	PUSHJ	P,PEND			;GIVE PROPER ENDING TO STRING
	SKIPL	LINCTR			;IF WE USED DEFAULT ROUTINE, 
	PUSHJ	P,TDMP			;DUMP BUFFER NOW
	MOVE	0,[XWD USRACS+1,1]	;RESTORE USER ACS
	BLT	0,16			;EXCEPT FOR PDL POINTER
	MOVE	0,USRACS		;RESTORE AC USED FOR BLT
	SOSL	TXTLVL			;DECREMENT COUNT, IF NOT
	PUSHJ	P,RSTLVL		;AT PRIMARY, RESTORE THE LEVEL
	SKIPE	ERREXT			;DO WE TAKE THE ERROR EXIT ???
	SKIPN	DEFERR			;IS THE ROUTINE ADDRESS THERE ???
	SKIPA				;NO,,JUST RETURN NORMALLY.
	JRST	@DEFERR			;YES,,DO IT.
	POPJ	P,			;RETURN WITHOUT AFFECTING TF

;This calling convention is extensible and superceeds the previous
;calling sequence.

;Thus $TEXT(RTN,<STRING>,<ARGS>) would produce the following call:


;	$CALL	T%TEXT
;	JUMP	[XWD 2,0		;Length of header
;		 EXP <RTN>		;Text output routine or pointer
;		 ITEXT(<STRING>,<ARGS>)];Start of ITEXT arguments

TEXT.2:	HRRZ	S1,0(S1)		;Get address of argument list
	HLRZ	TF,(S1)			;Get the header count
	ADDI	TF,(S1)			;Get ITEXT address
	MOVEM	TF,ARGADR		; and save it
	SETZM	USRRET			;Clear return address
	MOVE	TF,1(S1)		;Get calling TOR or pointer
	TLC	TF,777777		;MAKE -1 INTO A WORD POINTER
	TLCN	TF,777777
	 HRLI	TF,(POINT 7)
	TXNN	TF,<@(17)>		;Check for index or indirect
	JRST	TEXT.4			;None, no need to resolve address
	PUSH	P,TF			;Save pointer for a minute
	$CALL	I%IOFF			;Disable interrupts
	POP	P,TF			;Get the pointer back
	MOVE	S1,USRACS+S1		;RESTORE USERS S1
	EXCH	P,USRACS+P		; AND STACK POINTER
	HRRI	TF,@TF			;REMOVE INDEXING AND INDIRECTION
	EXCH	P,USRACS+P		;RESTORE OUR POINTER
	TLZ	TF,(@(17))		;CLEAR THE BITS
	PUSH	P,TF			;Save the pointer for a minute
	$CALL	I%ION			;Enable interrupts
	POP	P,TF			;Get the pointer back
TEXT.4:	TLNE	TF,777777		;IS THIS A POINTER?
	 JRST	[MOVEM TF,LINPTR	;YES..SAVE IT
		 MOVEI TF,TDPB		;GET POINTER ROUTINE ADDRESS
		 JRST .+1]		;AND SAVE THAT
	SKIPN	TF			;Do we have a routine?
	MOVE	TF,DEFOUT		;No..use the default
	MOVEM	TF,USROUT		;SAVE ROUTINE ADDRESS
	JRST	TEXT.3			;Back to process arguments

SUBTTL T%TTY  - Buffered terminal output routine

;If a $TEXT instruction has a blank first argument, then the
;	default output routine is used. This routine is identified
;	in the Initialization Block.


;T%TTY is a default output routine which buffers output to
;	the terminal controlling this job.

; Call is:	S1/ contains 1 character, 7 bit, right justified
;
; Return:	TRUE always

T%TTY:	SOSGE	LINCTR			;ROOM IN THE BUFFER?
	JRST	[ PUSHJ P,TDMP		;NO, DUMP THE BUFFER
		  JRST T%TTY ]		;AND RETRY
	JUMPE	S1,.RETT		;IF NULL CHARACTER, RETURN NOW
	IDPB	S1,LINPTR		;DEPOSIT THE CHARACTER
	$RETT				;ALWAYS RETURN TRUE

TDMP:	PUSH	P,S1			;SAVE CHARACTER
	MOVEI	S1,0			;GET NULL CHARACTER
	IDPB	S1,LINPTR		;STORE TERMINATING NULL INTO BUFFER
	MOVE	S1,[POINT 7,LINBUF]	;GET BUFFER POINTER
	MOVEM	S1,LINPTR		;STORE IT
	SKIPE	LINBUF			;IF NULL BUFFER, SKIP IT
	PUSHJ	P,K%SOUT		;ELSE PRINT IT
	SETZM	LINBUF			;CLEAR FIRST WORD OF BUFFER
	MOVEI	S1,LINMAX		;RESET THE BUFFER COUNTER
	MOVEM	S1,LINCTR		;TO ITS MAXIMUM
	POP	P,S1			;RESTORE THE CHARACTER
	$RETT				;AND RETURN



TDPB:	IDPB	S1,LINPTR		;STORE WHERE CALLER SPECIFIED
	$RETT				;AND RETURN

SUBTTL PROBLK - Process an entire T%TEXT argument block


;PROBLK is used to process a list of T%TEXT arguments. The
;	lower level routine, PROARG, is called to process each
;	argument and errors are checked for.

; Call:		ARGADR/	Address of start of argument block
;
; Return:	Always TRUE

PROBLK:	SETZM	USRARG			;ASSUME NO ARGUMENTS BLOCK
	SETZM	MAXARG			;ZERO THE COUNT
	SETZM	NXTARG			;CLEAR POINTER TO NEXT ARGUMENT
	MOVE	S1,ARGADR		;GET ADDRESS OF ITEXT BLOCK
	LOAD	S2,0(S1),TXT.FN		;GET THE FUNCTION
	CAIE	S2,0			;IS ARGUMENT BLOCK PRESENT?
	JRST	PROBL1			;NO..PROCESS NORMALLY
	MOVEM	S1,USRARG		;SAVE ADDRESS OF ARGUMENTS
	HLRZ	S2,0(S1)		;YES..GET HEADER LENGTH
	ADD	S2,S1			;COMPUTE START OF ITEXT
	MOVEM	S2,ARGADR		;AND SAVE THAT
	SUBI	S2,1			;COMPUTE MAXIMUM ARG ADDRESS
	MOVEM	S2,MAXARG		;SAVE MAXIMUM ARGUMENT ADDRESS
	ADDI	S1,1			;COMPUTE NEXT ARGUMENT ADDRESS
	MOVEM	S1,NXTARG
PROBL1:	MOVE	S1,ARGADR		;GET ADDRESS OF CURRENT ARGUMENT WORD
	CAME	S1,USRRET		;ARE WE PAST THE END?
	SKIPN	0(S1)			;  OR INTO ZERO WORD (ITEXT BLOCK END)?
	$RETT				;YES, SO RETURN NOW TO CALLER
	PUSHJ	P,PROARG		;PROCESS THE ARGUMENT POINTED TO
	JUMPT	PROBL1			;IF OK, DON'T STOP NOW
	$STOP(BTA,<Bad $TEXT argument given at address ^O/ARGADR/>)

SUBTTL PROARG - Routine to process each T%TEXT argument

;PROARG is responsible for setting up argument specific data
;	areas for the processing routines and adjusting ARGADR.

; CALL IS:	NO ARGUMENTS
;
; RETURN:	TRUE		IF NO BAD ARGUMENTS DETECTED
;		FALSE		IF SOMETHING IS WRONG
;

PROARG:	SETZM	CACCTR			;CLEAR JUSTIFICATION COUNTER
	SETZM	CALOC			;CLEAR LOCATION WORD
	MOVE	S1,@ARGADR		;GET CONTENTS OF FIRST ARG WORD
	TXNN	S1,TXT.AD		;IS ADDRESS WORD PRESENT?
	JRST	PARG.1			;NO..PROCESS OLD BLOCK
	MOVEM	S1,CAFLG		;YES..PROCESS 2 WORD BLOCK
	AOS	S1,ARGADR
	MOVE	S1,@ARGADR		;GET POINTER TO ARGUMENT
	STORE	S1,CALOC,TXT.EA		;SAVE EFFECTIVE ADDRESS
	ANDX	S1,TXT.PT		;MASK POINTER PORTION
	MOVEM	S1,CAPTR		;SAVE IT
	JRST	PARG.3			;GO FINISH UP
PARG.1:	STORE	S1,CALOC,TXT.EA		;SAVE EFFECTIVE ADDRESS
	TXZ	S1,TXT.EA		;CLEAR IT
	MOVEM	S1,CAFLG		;SAVE THE FLAGS
	SETZM	CAPTR			;CLEAR POINTER WORD
	MOVEI	T1,@ARGADR		;Get address of this arg, for $STOP
	LOAD	S1,CAFLG,TXT.P		;IS THIS A TWO WORD TYPE OF ARG?
	JUMPE	S1,PARG.2		;NO, SO ADJUST BY ONLY ONE WORD
	AOS	S1,ARGADR		;ELSE ADJUST FOR THE SECOND WORD NOW
	MOVE	S1,0(S1)		;GET THE BYTE POINTER WORD
	MOVEM	S1,CAPTR		;AND STORE FOR LATER
PARG.2:	LOAD	S1,CAFLG,TXT.S		;IS THERE A SPACING WORD?
	JUMPE	S1,PARG.3		;NO, DONT PROCESS IT
	AOS	S1,ARGADR		;GET THE ADDRESS OF SPACING WORD
	MOVE	S1,0(S1)		;GET THE SPACING WORD
	LOAD	S2,S1,TXT.SC		;YES..GET THE FILL CHARACTER
	STORE	S2,CAFLG,TXT.FC
	LOAD	S2,S1,TXT.SS		;GET JUSTIFICATION CODE
	STORE	S2,CAFLG,TXT.JU
	LOAD	S2,S1,TXT.SP		;GET WIDTH
	STORE	S2,CAFLG,TXT.WD
PARG.3:	AOS	ARGADR			;ADJUST CURRENT ADDRESS
	MOVE	S1,CALOC		;GET ADDRESS
	TXNN	S1,<@(17)>		;INDEXING OR INDIRECT
	JRST	PARG.4			;NO..THEN SKIP THIS
	$CALL	I%IOFF			;TURN OFF INTERRUPTS
	MOVE	0,[XWD USRACS+1,1]	;RESTORE THE ACS
	BLT	0,16			;THAT WE MAY RESEMBLE
	MOVE	0,USRACS		;THE USER'S CONTEXT
	EXCH	P,USRACS+P		;SET UP PUSHDOWN LIST TOO
	MOVEI	S1,@CALOC		;CALCULATE EFFECTIVE ADDRESS
	MOVEM	S1,CALOC		;STORE ACTUAL ADDRESS
	EXCH	P,USRACS+P		;RESTORE STACK POINTER
	$CALL	I%ION			;TURN ON INTERRUPTS
PARG.4:	PJRST	PROTXT			;PROCESS THE TEXT

SUBTTL	PROTXT - ROUTINE TO PROCESS THE ACTUAL FUNCTION

PROTXT:	LOAD	S1,CAFLG,TXT.FN		;GET THE QUALIFIER INDEX ALONE
	CAILE	S1,0			;IF OUT OF RANGE,
	CAIL	S1,PTABL		;
	$STOP(IQN,Illegal qualifier number ^O/S1/ at ^O/ARGADR/)
	LOAD	T1,CAFLG,TXT.WD		;GET SPACING POSITIONS
	MOVEM	T1,CACMAX		;STORE AS MAXIMUM CHARS IN FIELD
	LOAD	S2,CAFLG,TXT.JU		;AND GET SIDE CODE
	CAXE	T1,0			;IF NO SPACING,
	CAXN	S2,.TXTJL		;OR LEFT JUSTIFYING ONLY
	JRST	PROTX1			;THEN JUST DO THE OUTPUT
	SETOM	NOOUTP			;SUPRESS THE OUTPUT,
	PUSHJ	P,@PTAB(S1)		;THEN, CALL THE PROCESSOR
	SETZM	NOOUTP			;CLEAR THE SUPRESS FLAG
	PUSHJ	P,SPACES		;GIVE ANY PADDING NECESSARY,
	LOAD	S1,CAFLG,TXT.FN		;GET QUALIFIER NUMBER AGAIN
PROTX1:	PUSHJ	P,@PTAB(S1)		;DO THE OUTPUT
	LOAD	S1,CAFLG,TXT.WD		;GET SPACING POSITIONS
	LOAD	S2,CAFLG,TXT.JU		;AND SIDE CODE
	CAXE	S1,0			;IF NOT SPACING,
	CAXN	S2,.TXTJR		; OR RIGHT JUSTIFYING,
	$RETT				;JUST RETURN
	PUSHJ	P,SPACES		;GIVE ANY SPACES NEEDED
	$RETT

SUBTTL PTAB   - Dispatch table for argument processors

; Note well:	Any changes in the order or contents of the TQUALS
;		macro in GLXMAC should be reflected by recompilation and/or
;		code changes in GLXTXT.

;	Define processor table creation mechanism

	DEFINE	TQ(CHR,ARGS,TYP,PROC) <EXP PRO'CHR>

PTAB:	PJRST	.RETF			;FILL IN THE 0 (UNUSED) ENTRY
	TQUALS				;AND THEN THE REST OF THE TABLE
	  PTABL==.-PTAB

	DEFINE	TQ(CHR,ARGS,TYP,PROC) <XWD ARGS,"CHR">
PTAB2:	EXP	0			;FILL IN THE 0 (UNUSED) ENTRY
	TQUALS				;AND THEN THE REST OF THE TABLE

SUBTTL PROx   - Processors for each type of formatting

;The following are the separate processors for each type of
;	ASCII formatting that we might have to do. Most are system
;	independent, a couple are not.  for all intents and
;	purposes, these are the top level routines, and they have
;	access to all AC's etc.

;Several locations are set up for these routines to use:

; CALOC	is the effective address of the current argument
;  or 0 (which will be unused) for TXT.NA (argument-less) qualifers
; CAFLG is the flag word for this argument
; CAPTR is the optional pointer word, used to get only a byte from the
;  	 word containing the argument.
; ARGADR points to the word immediately following this argument in the list
; USRACS contain registers 0-17 inclusive of the caller's ACS
; USRRET contains the address of the first word not part of this $TEXT's
;	 argument block. It is used to calculate the end of the T%TEXT arg block.

;USROUT contains the address of the user routine for
;	outputting each byte The supplied routine takes its byte as
;	7 bit ASCII, right justified in AC S1, and returns either
;	TRUE or FALSE.  A return of FALSE will cause a STOP CODE to
;	occur.  The output routine supplied may destroy both S1 and
;	S2, but must preserve all other registers.


;Each of the following routines is named 'PROx' where x is
;	the letter or digit corresponding to the $TEXT qualifier
;	that follows the '^' (up-arrow) to indicate that this type
;	of output is wanted.

SUBTTL PROT   - Process a string of ASCIZ text

;Since a user created string could be in the ACs or be a field or
;	something odd like that, we process it one word at at a time if we
;	have to.  If we do not, then we go to PRO3 which is faster.

PROT:	MOVE	P1,CALOC		;GET LOCATION OF STRING
	MOVEI	P2,0			;FAKE EXHAUSTED COUNT
	SKIPN	CAPTR			;IS THIS A FIELD ONLY?
	CAIGE	P1,20			;OR IN THE ACS?
	SOSA	P1			;YES, BACK ADDR OF ONE FOR LOOP, USE WORD BY WORD
	JRST	PRO3			;ELSE DO AS PURE ASCIZ STRING

PROT.1:	SOJGE	P2,PROT.2		;ANY MORE BYTES IN WORD?
	AOS	S1,P1			;NO, NEED NEXT WORD
	PUSHJ	P,FETCH			;SO GET IT
	MOVE	P3,S1			;AND MOVE INTO PERMANENT PLACE
	MOVE	P4,[POINT 7,P3]		;MAKE UP A BYTE POINTER
	MOVEI	P2,4			;GET NEW COUNT
PROT.2:	ILDB	S1,P4			;GET A BYTE
	JUMPE	S1,.RETT		;RETURN NOW IF WE GET A NULL
	PUSHJ	P,PUT7			;PUT OUT THE BYTE
	JRST	PROT.1			;LOOP FOR NEXT BYTE



SUBTTL PRO3   - Process a an ASCIZ string created by $TEXT

;PRO3 is used to process strings created by the $TEXT instruction itself.
;	These strings do not have to be processed word by word since
;	they are created in a literal.

PRO3:	MOVE	S1,CALOC		;GET LOCATION STRING STARTS AT
	PJRST	PUTT				;STORE THE STRING

SUBTTL PROQ   - Process a byte pointer to an ASCIZ string

;PROQ is used to process an ASCIZ string which does not start on a word
;	boundary.  The address fed to the ^Q qualifer is that of a byte
;	pointer to the string to be output.

PROQ:	PUSHJ	P,.SAVE1		;PRESERVE AN AC
	MOVE	S1,CALOC		;GET LOCATION OF BYTE POINTER
	PUSHJ	P,FETCH			;FETCH IT NOW
	TLNN	S1,777700		;WAS POINTER SPECIFIED?
	TLO	S1,(POINT 7,0)		;NO..MAKE STANDARD POINTER
	TLC	S1,-1
	TLCN	S1,-1			;WAS POINTER -1,,X
	 HRLI	S1,(POINT 7,0)		;YES..CREATE BYTE POINTER
PROQ.1:	TXNN	S1,<@(17)>		;INDIRECT OR INDEXED?
	 JRST	PROQ.3			;NO..PROCESS IT
	LDB	S2,[POINT 4,S1,17]	;GET THE INDEX FIELD
	JUMPE	S2,PROQ.2		;JUMP IF NO INDEXING
	HRRZ	S2,USRACS(S2)		;GET THE INDEX VALUE
	ADDI	S2,(S1)			;DO INDEX CALCULATION
	HRR	S1,S2			;STORE NEW EFFECTIVE ADDRESS
	TLZ	S1,17			;CLEAR INDEXING
PROQ.2:	TXNN	S1,<@>			;INDIRECT?
	 JRST	PROQ.3			;NO..FINISH UP
	MOVE	P1,S1			;SAVE THE POINTER
	HRRZ	S1,S1			;EXTRACT THE ADDRESS
	PUSHJ	P,FETCH			;GET THE INDIRECT WORD
	LDB	S2,[POINT 12,P1,11]	;GET POSITION AND SIZE
	DPB	S2,[POINT 12,S1,11]	;STORE IN NEW POINTER
	JRST	PROQ.1			;PROCESS POINTER
PROQ.3:	HRRZ	S2,S1			;GET ADDRESS
	CAIGE	S2,20			;POINT TO THE AC'S?
	ADDI	S2,USRACS		;YES..POINT TO OUR COPY
	JRST	PUTQ			;OUTPUT IT

SUBTTL PROB   - Process a GLXLIB object block

PROB:	MOVE	P1,CALOC		;GET ARG LOC 
	MOVEI	S1,OBJ.TY(P1)		;GET ADDRESS OF TYPE WORD
	PUSHJ	P,FETCH			;GET ITS CONTENTS
	MOVE	T1,S1			;SAVE THE OBJECT TYPE IN T1
	HRRZS	S1			;[100]ISOLATE THE OBJECT CODE
	MOVSI	P2,-OBJLEN		;MAKE AN AOBJN PTR TO TABLE OF OBJECTS
PROB.1:	HLRZ	S2,OBJTAB(P2)		;GET OBJECT TYPE FROM TABLE
	CAME	S2,S1			;MATCH?
	AOBJN	P2,PROB.1		;NO, LOOP
	JUMPGE	P2,.RETF		;AOBJN EXPIRED, LOSE
	TXNE	T1,.CLLPT		;[100]IS THIS A CLUSTER LPT?
	JRST	PROB.3			;[100]YES, INDICATE IN THE TEXT
	TXNE	T1,.DQLPT		;[100]IS THIS A DQS LPT?
	JRST	PROB.2			;[100]YES, INDICATE IN THE TEXT
	TXNN	T1,.LALPT		;[100]IS THIS A LAT LPT?
	JRST	PROB.4			;[100]NO, GO PROCESS THE UNIT NUMBER

	$PUTT	(<LAT >)		;[100]INDICATE THAT IT IS A LAT LPT
	HRRZ	S1,OBJTAB(P2)		;[100]PICK UP THE PRINTER TEXT
	$CALL	PUTT			;[100]PLACE IN THE STRING
	MOVEI	P3,OBJ.SZ(P1)		;[100]POINT TO THE NAME BLOCK
	MOVEI	S1,[ASCIZ/ PORT /]	;[100]ASSUME IT IS A PORT
	LOAD	S2,ARG.HD(P3),AR.TYP	;[100]PICK UP THE NAME TYPE
	CAIE	S2,.KYPOR		;[100]IS IT A PORT?
	MOVEI	S1,[ASCIZ/ SERVICE /]	;[100]NO, THEN IT IS A SERVICE
	$CALL	PUTT			;[100]PLACE IN THE STRING
	MOVEI	S1,ARG.DA(P3)		;[100]POINT TO THE PORT/SERVICE NAME
	$CALL	PUTT			;[100]PLACE IN THE STRING
	MOVE	S1,OBJ.ND(P1)		;[100]PICK UP THE NODE NAME
	JRST	PROB.6			;[100]GO PLACE NODE NAME IN THE STRING

PROB.2:	$PUTT	(<DQS >)		;[100]INDICATE THAT IT IS A DQS LPT
	HRRZ	S1,OBJTAB(P2)		;[100]PICK UP THE PRINTER TEXT
	$CALL	PUTT			;[100]PLACE IN THE STRING
	$PUT7(< >)			;OUTPUT A SPACE
	MOVEI	S1,OBJ.SZ+ARG.DA(P1)	;[100]PICK UP ADDRESS OF VMS QUEUE NAME
	$CALL	PUTT			;[100]PLACE NAME IN THE STRING
	MOVE	S1,OBJ.ND(P1)		;[100]PICK UP THE NODE NAME
	JRST	PROB.6			;[100]GO PLACE NODE NAME IN THE STRING

PROB.3:	$PUTT	(<Cluster >)		;[100]INDICATE THAT IT IS A CLUSTER LPT

PROB.4:	HRRZ	S1,OBJTAB(P2)		;GET ADDRESS OF APPROPRIATE TEXT
	PUSHJ	P,PUTT			;AND OUTPUT IT
	$PUT7(< >)			;OUTPUT A SPACE
	MOVEI	S1,OBJ.UN(P1)		;GET ADDRESS OF UNIT NUMBER WORD
	PUSHJ	P,FETCH			;FETCH IT
	CAIN	T1,.OTMNT		;IS THIS A TAPE/DISK OBJECT TYPE
	JRST	[PUSHJ	P,PUTW		;YES,,PUT OUT THE UNIT AS SIXBIT
		 PJRST	PROB.5 ]	;AND CONTINUE ON
	MOVE	P2,S1			;COPY IT
	LOAD	S1,P2,OU.LRG		;GET LOW END OF RANGE
	PUSHJ	P,PUTD			;OUTPUT IT IN DECIMAL
	LOAD	S1,P2,OU.HRG		;GET HIGH END OF RANGE
	JUMPE	S1,PROB.5		;SKIP IF NO HIGH UNIT
	$PUT7(<:>)			;OUTPUT RANGE SEPARATOR
	PUSHJ	P,PUTD			;AND THEN HIGH END OF RANGE
PROB.5:	MOVEI	S1,OBJ.ND(P1)		;GET ADDRESS OF USER'S NODE WORD
	PUSHJ	P,FETCH			;GO GET ITS CONTENTS
PROB.6:	SKIPN	T1,S1			;SAVE THE SUPPLIED NODE
	JRST	PROB.8			;DONT DISPLAY IF NULL
TOPS10<	TLNN	S1,770000		;MAKE SURE WE HAVE SIXBIT
	$CALL	CNVNOD
	 JUMPF	[MOVE	S1,T1		;FAILURE..RESTORE SUPPLIED NODE
		 JRST	PROB.7]		;AND DISPLAY IT
	MOVE	T1,S1			;SAVE SIXBIT NODE
> ;End TOPS10
	SETOM	S1			;SET FOR MY JOB
	MOVX	S2,JI.LOC		;GET MY LOCATION
	PUSHJ	P,I%JINF
	 JUMPF	[MOVE	S1,T1		;RESTORE THE SUPPLIED NODE
		 JRST	PROB.7]		;AND DISPLAY IT
	MOVE	S1,T1			;PLACE SIXBIT IN S1
	CAMN	S2,S1			;SAME LOCATION?
	JRST	PROB.8			;YES..RETURN
PROB.7:	PUSH	P,S1			;SAVE THE NODE SPEC
	$PUTT(< [>)			;OPENER
	POP	P,S1			;RESTORE IT
	PUSHJ	P,PUTN			;PUT OUT THE NODE NAME
	$PUT7(<]>)			;AND CLOSER
PROB.8:	$RETT

SUBTTL PRO1   - Process an object type

PRO1:	MOVE	S1,CALOC		;GET ADDR OF ARGUMENT
	PUSHJ	P,FETCH			;FETCH IT
	MOVSI	P1,-OBJLEN		;MAKE AN AOBJN PTR TO TABLE OF OBJECTS
PRO1.1:	HLRZ	S2,OBJTAB(P1)		;GET OBJECT TYPE FROM TABLE
	CAME	S2,S1			;MATCH?
	AOBJN	P1,PRO1.1		;NO, LOOP
	JUMPGE	P1,.RETF		;AOBJN EXPIRED, LOSE
	HRRZ	S1,OBJTAB(P1)		;GET ADDRESS OF APPROPRIATE TEXT
	PJRST	PUTT			;AND OUTPUT IT

;Define the X macro so we can generate the table of strings
;	for the object types.

DEFINE X(A,B),<
	XWD	A,[ASCIZ/B/]
>

;Now generate the table of object type strings.

OBJTAB:	OBJCTS
	OBJLEN==.-OBJTAB



SUBTTL PRON   - Process a node specification

PRON:	MOVE	S1,CALOC		;GET ADDRESS OF ARGUMENT
	PUSHJ	P,FETCH			;FETCH FROM USER SPACE
	PJRST	PUTN			;AND PRINT IT OUT

SUBTTL PROO   - Process unsigned octal numbers

PROO:	MOVE	S1,CALOC		;GET ARGUMENT LOCATION
	PUSHJ	P,FETCH			;FETCH IT
	PJRST	PUTO			;JUST PRINT THE NUMBER



SUBTTL PROD   - Process a signed decimal number

PROD:	MOVE	S1,CALOC		;GET ADDRESS OF CURRENT ARGUMENT
	PUSHJ	P,FETCH			;GET IT
	PJRST	PUTD			;JUST PRINT THE NUMBER

SUBTTL PROF   - Process a  system dependent file specification

TOPS10 <
PROF:	MOVE	P1,CALOC		;GET LOCATION OF THE FD
	MOVEI	S1,.FDSTR(P1)		;LOCATION OF STRUCTURE NAME
	PUSHJ	P,FETCH			;GET IT
	JUMPE	S1,PROF.1		;IF NULL, FORGET IT
	PUSHJ	P,PUTW			;PRINT IT
	$PUT7(<:>)			;FOLLOW IT WITH COLON
PROF.1:	MOVEI	S1,.FDNAM(P1)		;GET NAME OF FILE
	PUSHJ	P,FETCH			;FROM USER
	SKIPE	S1			;IF NULL, DON'T PRINT IT
	PUSHJ	P,PUTW			;PRINT AS SIXBIT WORD
	MOVEI	S1,.FDEXT(P1)		;NOW GET EXTENSION
	PUSHJ	P,FETCH			;FROM USER
	JUMPE	S1,PROF.2		;IF NULL, IGNORE IT
	$PUT7(<.>)			;PUT OUT DOT AS FILE.EXT SEPARATOR
	PUSHJ	P,PUTW			;NOW PRINT THE SIXBIT EXTENSION

PROF.2:	MOVEI	S1,.FDPPN(P1)		;GET LOCATION OF PPN
	PUSHJ	P,FETCH			;GET THE PPN
	JUMPE	S1,.RETT		;IF NULL,SKIP PPN AND PATH
	PUSH	P,S1			;SAVE PPN
	$PUT7(<[>)			;PUT OUT A BRACKET TO OPEN PPN
	HLRZ	S1,0(P)			;ISOLATE PROJECT NUMBER
	PUSHJ	P,PUTO			;PUT IT OUT
	$PUT7(<,>)			;SEPARATE HALVES
	POP	P,S1			;RESTORE PPN
	ANDI	S1,-1			;ISOLATE THE PROGRAMMER NUMBER
	PUSHJ	P,PUTO			;PRINT IT
	MOVEI	S1,.FDLEN(P1)		;GET ADDRESS OF FD LENGTH
	PUSHJ	P,FETCH			;FETCH IT
	LOAD	S1,S1,FD.LEN		;GET LENGTH ONLY
	CAIG	S1,.FDPAT		;IS THERE A PATH?
	JRST	PROF.4			;NO
	SUBI	S1,.FDPAT		;GET NUMBER OF SFDS
	MOVNS	S1			;NEGATE IT
	HRL	P1,S1			;GET COUNT INTO PLACE

PROF.3:	MOVEI	S1,.FDPAT(P1)		;GET SFD LOCATION
	PUSHJ	P,FETCH			;LOAD IT
	JUMPE	S1,PROF.4		;Null SFD?  All done then...
	$PUT7(<,>)			;Nonnull, type a comma
	PUSHJ	P,PUTW			;PRINT IT
	AOBJN	P1,PROF.3		;LOOP FOR ALL
PROF.4:	$PUT7(<]>)			;CLOSE PPN WITH A BRACKET
> ;END TOPS10 CONDITIONAL
TOPS20 <
PROF:	MOVEI	S1,.FDSTG		;GET OFFSET TO DESCRIPTIVE STRING
	PUSH	P,CALOC			;SAVE LOCATION OF ARGUMENT
	ADDM	S1,CALOC		;POINT TO "STRING PART" OF FD
	PUSHJ	P,PROT			;HANDLE AS ASCIZ TEXT
	POP	P,CALOC			;RESTORE ORIGINAL LOCATION
> ;END TOPS20 CONDITIONAL
	$RETT				;THEN RETURN

SUBTTL PRO7   - Process a single 7 bit ASCII character

PRO7:	MOVE	S1,CALOC		;GET LOCATION
	PUSHJ	P,FETCH			;FETCH THE CHARACTER
	PJRST	PUT7			;PRINT IT AND RETURN FROM THERE


SUBTTL PRO6   - Process a single 6 bit ASCII character

PRO6:	MOVE	S1,CALOC		;GET LOCATION
	PUSHJ	P,FETCH			;LOAD IT
	PJRST	PUT6			;PRINT IT AND RETURN FROM THERE

SUBTTL PRO5   - Process ASCIZ single word

PRO5:	MOVE	S1,CALOC		;GET LOCATION OF WORD TO PRINT
	PUSHJ	P,FETCH			;LOAD IT
	MOVEM	S1,TTXBUF		;STORE INTO TEMPORARY BUFFER
	SETZM	S1,TTXBUF+1		;INSURE 6TH CHARACTER IS NULL
	MOVEI	S1,TTXBUF		;GET LOCATION TO PUT OUT STRING AT
	PJRST	PUTT			;AND PUT OUT THE TEXT


SUBTTL PROW   - Process a SIXBIT word

PROW:	MOVE	S1,CALOC		;GET LOCATION OF ARGUMENT
	PUSHJ	P,FETCH			;LOAD FROM USER ADDRESS SPACE
	SKIPN	CAPTR			;IF NOT A BYTE,
	PJRST	PUTW			;JUST PRINT IT OUT
	JUMPE	S1,.RETT##		;IF NULL, RETURN NOW
PROW.1:	TXNE	S1,77B5			;IS FIELD LEFT JUSTIFIED?
	PJRST	PUTW			;YES, PRINT IT OUT NOW
	LSH	S1,6			;SHIFT OVER ONE PLACE
	JRST	PROW.1			;AND TRY AGAIN

SUBTTL PROP   - Process a directory ID of either PPN or directory NUMBER


SUBTTL PROU   - Process a user ID or either PPN or User number


PROU:	SKIPA	T1,[EXP JI.USR]		;USE JOB'S USER NUMBER
PROP:	MOVX	T1,JI.CDN		;USE JOB'S DIRECTORY NUMBER
	MOVE	S1,CALOC		;GET CURRENT ARGUMENT'S LOCATION
	PUSHJ	P,FETCH			;NOW FETCH THAT ARGUMENT
	CAME	S1,[EXP -1]		;DO THEY WANT THE DEFAULT?
	PJRST	PUTU			;NO,OUTPUT USER INFO
	MOVE	S2,T1			;PLACE FUNCTION CODE IN S2
	PUSHJ	P,I%JINF		;GET THE DATA
	MOVE	S1,S2			;PLACE VALUE IN S1
PROP.1:	PJRST	PUTU			;OUTPUT USER INFO

SUBTTL PROR   - Process routine for Job Info Block 

;This routine will output the Job Info Block for the Galaxy
;	Spoolers or anyone formating a JIB according to GLXMAC
;	Specification.

PROR:	MOVEI	S1,[ASCIZ/Job /]	;START JOBNAME
	PUSHJ	P,PUTT			;OUTPUT THE TEXT
	MOVE	P1,CALOC		;GET ADDR OF ARGUMENT
	MOVEI	S1,JIB.JN(P1)		;GET THE ADDRESS OF JOBNAME FIELD
	PUSHJ	P,FETCH			;FETCH IT
	JUMPE	S1,.RETF		;NONE..ERROR..RETURN FALSE
	PUSHJ	P,PUTW			;DISPLAY THE JOBNAME
	MOVEI	S1,[ASCIZ/ Req #/]	;REQUEST IDENTIFIER
	PUSHJ	P,PUTT			;OUTPUT BLOCK
	MOVEI	S1,JIB.ID(P1)		;GET ADDRESS OF REQUEST ID
	PUSHJ	P,FETCH			;FETCH IT
	JUMPLE	S1,.RETF		;ERROR...RETURN
	PUSHJ	P,PUTD			;OUTPUT THE NUMBER
	MOVEI	S1,[ASCIZ/ for /]	;USER NAME IDENTIFIER
	PUSHJ	P,PUTT			;OUTPUT THE TEXT
TOPS10 <
	MOVEI	S1,JIB.NM(P1)		;GET USER NAME WORD 1
	PUSHJ	P,FETCH			;FETCH IT
	JUMPE	S1,PROR.3		;NO NAME GO TO PPN
	MOVE	P2,CACCTR		;GET CURRENT CHARACTER COUNT
	ADDI	P2,6			;EXPECTED COUNT AFTER OUTPUT
	PUSHJ	P,PUTW			;OUTPUT THE NAME
	SUB	P2,CACCTR		;GET COUNT OUTPUT
	MOVEI	S1,JIB.NM+1(P1)		;GET USER NAME WORD 2
	PUSHJ	P,FETCH			;FETCH IT
	JUMPE	S1,PROR.3		;ANYTHING ELSE TO PRINT ?
	JUMPE	P2,PROR.2		;ALL OUT CONTINUE ON
	PUSH	P,S1			;SAVE USER NAME WORD 2
PROR.1:	MOVEI	S1,40			;GET A BLANK
	PUSHJ	P,PUT7			;OUTPUT THE BLANK
	SOJG	P2,PROR.1		;FILL TO 6 CHARACTERS
	POP	P,S1			;GET SAVED S1
PROR.2:	PUSHJ	P,PUTW			;OUTPUT THE NAME
PROR.3:	MOVEI	S1,40			;GET A BLANK
	PUSHJ	P,PUT7			;OUTPUT THE CHARACTER
>;END TOPS10
	MOVEI	S1,JIB.US(P1)		;GET USER NUMBER OR PPN
	PUSHJ	P,FETCH			;FETCH THE ARGUMENT
	PJRST	PUTU			;DISPLAY USER NAME OR PPN AND RETURN

PROH:	TDZA	P1,P1			;USE FOR FLAG THAT DATE IS WANTED
PROC:	SETO	P1,			;-1 MEANS TIME ONLY
	MOVE	S1,CALOC		;GET LOCATION OF ARGUMENT
	PUSHJ	P,FETCH			;GRAB IT
	CAMN	S1,[EXP -1]		;IS IT -1, FOR "NOW"?
	PUSHJ	P,I%NOW			;GET CURRENT DATE AND TIME

;  Convert date and time to ASCII string

	MOVE	S2,S1			;Put the date and time AC 2
	HRROI	S1,TTXBUF		;String goes into TTXBUF
	PUSH	P,T1			;Save AC 3 
	SETZ	T1,			;For now no flags
	SKIPE	P1			;Do we want date and time
	TXO	T1,OT%NDA		;Only want time
	ODTIM				;Convert
	 ERJMP .STOP			;Can't covert time
	POP	P,T1			;Restore AC 3
	MOVEI	S1,TTXBUF		;String goes into AC 1
	PJRST	PUTT			;Print it

SUBTTL PROE   - Process a GLXLIB error number

PROE:	MOVE	S1,CALOC		;GET LOCATION OF THE ARGUMENT
	PUSHJ	P,FETCH			;GET IT
TOPS20<
	CAMN	S1,[EXP -2]		;WANT LAST TOPS20 ERROR
	  JRST	PROE.4			;YES..SETUP ERRO VALUES
>;END TOPS20
	CAMN	S1,[EXP -1]		;WANT 'LAST ERROR'?
	SKIPA	S1,.LGERR##		;YES, PICK UP LAST ERROR PROCESS VIA .ERET
	CAIL	S1,0			;IF LESS THAN 0 OR
	CAIL	S1,ERRSLN		; OFF THE END OF THE TABLE
	  PJRST	PROE.1			;CHECK FOR -20 ERRORS
	HRRZ	S1,ERRTAB(S1)		;GET STRING ADDRESS
	PJRST	PUTT			;RETURN AFTER PUTTING OUT THE STRING
PROE.1:
TOPS20<	MOVE	S2,S1			;PLACE CODE IN S2
	CAIGE	S1,.ERBAS		;CHECK FOR -20 ERROR
	  PJRST	PROE.3			;BAD ERROR CODE
PROE.2:	PUSH	P,S2			;SAVE S2
	MOVEI	S1,EBFSZ		;SIZE OF THE BUFFER
	PUSHJ	P,M%GMEM		;GET BUFFER ADDRESS
	MOVEM	S2,ERRBUF		;SAVE THE ADDRESS
	POP	P,S2			;RESTORE ERROR CODE
	HRLI	S2,.FHSLF		;FOR THIS PROCESS
	HRROI	S1,@ERRBUF		;STORE IN ERROR BUFFER
	HRLZI	T1,-<EBFSZ*5>		;MAXIMUM NUMBER OF CHARACTERS
	ERSTR				;DO THE FUNCTION
	  PJRST	PROE.3			;BAD ERROR CODE
	  $RETF				;BAD STRING SIZE
	MOVEI	S1,@ERRBUF		;POINT TO ERROR BUFFER
	PUSHJ	P,PUTT			;DUMP THE TEXT
	MOVEI	S1,EBFSZ		;SIZE OF AREA
	MOVE	S2,ERRBUF		;ADDRESS OF BUFFER
	PUSHJ	P,M%RMEM		;RETURN THE MEMORY
	$RETT				;RETURN
PROE.3:	PUSH	P,S2			;SAVE S2
	MOVEI	S1,[ASCIZ/Invalid Error Code /]
	PUSHJ	P,PUTT			;PUT OUT THE TEXT
	POP	P,S2			;RESTORE S2
	HRRZ	S1,S2			;GET THE ERROR CODE ONLY
	PUSHJ	P,PUTO			;DUMP THE NUMBER
	$RETT				;RETURN
PROE.4:	MOVEI	S2,-1			;GET LAST ERROR
	JRST	PROE.2			;FINISH OFF ERROR
>;END TOPS20

TOPS10<	$RETF		>		;ERROR..JUST RETURN


;Make a table of known errors, for each we have the address
;	of expanded string.


	DEFINE ERR(A,B)<
	Z	[ASCIZ \B\]
> ;END OF ERR DEFINITION

ERRTAB:	[ASCIZ /No errors yet/]		;0 ENTRY FOR LAST ERROR, BUT NONE SEEN
	ERRORS				;PRODUCE THE TABLE
	ERRSLN==.-ERRTAB		;LENGTH OF TABLE

SUBTTL PROI   - Process an indirect text request


;Just as ^T can be used to include remote ASCIZ strings in a
;	$TEXT call, the ^I qualifier can be used to include strings
;	that are more complex.  The address specified with an ^I
;	qualifier specifies the location of a block, built with the
;	ITEXT macro, which will be included at this point in the
;	$TEXT string.  Any qualifier may appear in the ITEXT string,
;	including more ^I qualifiers.


PROI:	$SAVE	<CAFLG,ARGADR,USRARG,MAXARG,NXTARG>
	MOVE	S1,CALOC		;GET ADDRESS GIVEN AS ^I ARGUMENT
	MOVEM	S1,ARGADR		;MAKE IT NEW ARG ADDR
	PUSHJ	P,PROBLK		;PROCESS THE BLOCK POINTED TO
	$RETT				;THEN RETURN

SUBTTL PROV   - Process a program version number

; Type out a specially formatted program version number.  This is the
;	standard version number, containing version number, major and
;	minor edit numbers and a code indicating who editted the code last.

; Define the fields of the version number

	VI%WHO==7B2			;WHO EDITTED LAST
	VI%MAJ==777B11			;MAJOR VERSION NUMBER
	VI%MIN==77B17			;MINOR VERSION NUMBER
	VI%EDT==777777B35		;EDIT NUMBER

PROV:	MOVE	S1,CALOC		;GET LOCATION OF VERSION NUMBER
	PUSHJ	P,FETCH			;FETCH IT
	MOVE	P1,S1			;GET INTO SAFER PLACE
	LOAD	S1,P1,VI%MAJ		;GET MAJOR VERSION NUMBER
	PUSHJ	P,PUTO			;PRINT IT OUT
	LOAD	P2,P1,VI%MIN		;GET MINOR VERSION NUMBER
	JUMPE	P2,PROV.2		;SKIP MINOR VERSION IF ZERO
	SUBI	P2,1			;BACK OFF ONE
	IDIVI	P2,^D26			;PICK APART LETTERS
	JUMPE	P2,PROV.1		;IF FIRST LETTER NULL, SKIP IT
	MOVEI	S1,"A"-1(P2)		;GET FIRST PART
	PUSHJ	P,PUT7			;PUT OUT THE LETTER
PROV.1:	MOVEI	S1,"A"(P3)		;CONVERT IT
	PUSHJ	P,PUT7			;AND PRINT IT
PROV.2:	$PUT7(<(>)			;PUT OUT PARENTHESIS
	LOAD	S1,P1,VI%EDT		;GET THE EDIT NUMBER
	PUSHJ	P,PUTO			;PRINT IT
	$PUT7(<)>)			;AND CLOSE PARENTHESIS
	LOAD	S1,P1,VI%WHO		;GET FINAL PART
	JUMPE	S1,.RETT##		;IF NULL, WE ARE DONE
	$PUT7(-)			;ELSE SEPARATE "WHO" FIELD AND
	PJRST	PUTO			;RETURN PRINTING IT

SUBTTL PROM   - Process a request for a CONTROL-M (Carriage Ret.)

PROM:	MOVEI	S1,"M"-100		;LOAD ^M
	PJRST	PUT7			;PUT IT OUT,RETURN


SUBTTL PROJ   - Process a request for a CONTROL-J (Line Feed)

PROJ:	MOVEI	S1,"J"-100		;LOAD ^J
	PJRST	PUT7			;PUT IT OUT,RETURN


SUBTTL PROL   - Process a request for a CONTROL-L (Form Feed)

PROL:	MOVEI	S1,"L"-100		;LOAD ^L
	PJRST	PUT7			;PUT IT OUT, RETURN


SUBTTL PROK   - Process a request for a CONTROL-K (Vertical Tab)

PROK:	MOVEI	S1,"K"-100		;LOAD ^K
	PJRST	PUT7			;PUT IT OUT, RETURN


SUBTTL PRO2   - Process a request for up-arrow

PRO2:	MOVEI	S1,"^"			;GET UP-ARROW OR CARET
	PJRST	PUT7			;AND PUT IT OUT


SUBTTL PROA   - Process a request to supress free <CR-LF>

PROA:	SETOM	ENDFLG			;SET FLAG TO SUPRESS END OF TEXT STUFF
	$RETT				;TAKE GOOD RETURN


SUBTTL PRO0   - Process a request to put null (0) at end of line

PRO0:	MOVEI	S1,1			;SET END TO PUT NULL INSTEAD
	MOVEM	S1,ENDFLG		;OF CR-LF AT END OF LINE
	$RETT				;AND RETURN

SUBTTL FETCH  - Routine to get a word from caller's address space

;FETCH is responsible for getting a word from the user,
;	checking for it's being in the AC shadow block and masking
;	for proper size and place if the argument has a byte-mode
;	address.

; Call:		S1/ Address to fetch word from
;
; Return:	S1/Contents of that word or byte


FETCH:	CAIG	S1,17			;IS THE VALUE IN THE ACS?
	SKIPA	S1,USRACS(S1)		;YES, FETCH IT FROM THERE
	MOVE	S1,0(S1)		;OTHERWISE, PICK IT UP FROM MEMORY
	SKIPN	S2,CAPTR		;IS THERE A POINTER WORD?
	$RETT				;NO, SO RETURN NOW
	HRRI	S2,S1			;POINT TO REGISTER WITH WHOLE WORD
	LDB	S1,S2			;GET PROPER PART
	$RETT				;AND TAKE GOOD RETURN

SUBTTL SPACES - Routine to provide any padding requested

;Spaces is actually a misnomer, since the pad character may
;	be any character that the user specifies. The spacing
;	information is passed in an optional word associated with
;	each argument.  The user may specify the number of spaces
;	that the field will take up, the side to justify to, and the
;	character to pad with.  Only the width actually must be
;	given, as the side and character are defaulted by the $TEXT
;	macros.  The default justification is right justification
;	for numeric items (^D and ^O) and left justification for all
;	others. The default padding character is always a blank
;	(octal 40).

;This routine places X pad characters into the output stream,
;	where X is computed as the difference between the number in
;	CACCTR and the user specified width.  It also provides the
;	centering.


; Call:		CACCTR should be set up
;
; Return:	Always TRUE

SPACES:	PUSHJ	P,.SAVE1		;GET ONE PERMANENT REGISTER
	LOAD	P1,CAFLG,TXT.WD		;GET THE SPACING CODE WIDTH
	SUB	P1,CACCTR		;SUBTRACT CHARACTERS FOR OUTPUT
	SETZM	CACCTR			;THEN CLEAR CHARACTERS OUTPUT
	LOAD	S1,CAFLG,TXT.JU		;NOW GET THE SPACING CODE
	CAXE	S1,.TXTJC		;WANT THIS CENTERED?
	JRST	SPAC.1			;NO, SO SKIP THIS
	ASH	P1,-1			;DIVIDE SPACING NEEDED BY 2
	MOVX	S1,.TXTJL		;SET NOW FOR LEFT JUSTIFICATION ONLY
	STORE	S1,CAFLG,TXT.JU		;AND FALL INTO REGULAR SPACING CODE
SPAC.1:	JUMPLE	P1,.RETT		;CHECK FOR DONENESS
	LOAD	S1,CAFLG,TXT.FC		;GET THE CHARACTER TO OUTPUT
	PUSHJ	P,PUT7			;AND PRINT IT
	SOJA	P1,SPAC.1		;REPEAT TILL DONE

SUBTTL Local output routines

;These routines are local to the TEXT module and are used to
;	do output. GLXTXT cannot use the $TEXT macro because it
;	would overwrite the callers AC's with its own.

; PUTTX -- Output an ASCIZ string, called via the $PUTT macro

PUTTX:	PUSH	P,S1			;SAVE ACS S1 AND S2
	PUSH	P,S2			;
	AOS	S1,-2(P)		;UPDATE STACK, GET ADDRESS
	HRRZ	S1,-1(S1)		;PICK UP ADDRESS OF STRING
	PUSHJ	P,PUTT			;CALL ROUTINE
	PJRST	S2POPJ			;RETURN, RESTORING THE ACS

; PUTT -- Output an ASCIZ string, address of string is in S1

PUTT:	PUSHJ	P,.SAVE1		;GET ONE PERMANENT AC
	HRRZ	P1,S1			;GET ADDRESS INTO IT
	HRLI	P1,(POINT 7,0)		;CONVERT IT TO A BYTE POINTER
PUTT1:	ILDB	S1,P1			;GET A BYTE
	JUMPE	S1,.RETT		;IF NULL, RETURN
	PUSHJ	P,PUT7			;PRINT THE CHARACTER
	JRST	PUTT1			;LOOP FOR NEXT ONE


; PUT7X -- Output a character, called via the $PUT7 macro

PUT7X:	PUSH	P,S1			;SAVE S1
	PUSH	P,S2			;AND S2
	AOS	S1,-2(P)		;UPDATE STACK, GET ADDRESS
	HRRZ	S1,-1(S1)		;GET CHARACTER
	PUSHJ	P,PUT7			;PUT OUT THE CHARACTER
S2POPJ:	POP	P,S2			;RESTORE THE AC
	POP	P,S1			;AND THE OTHER
	POPJ	P,			;RETURN

; PUT7 -- Output a character, character in S1

PUT7:	SKIPE	ERREXT			;IF AN ERROR HAS OCCURED,,
	$RETT				;   THEN JUST RETURN.
	MOVX	TF,177			;MASK SEVEN BITS
	AND	TF,S1			;PUT CHARACTER IN TF
	AOS	S1,CACCTR		;INCREASE CHARACTER COUNT
	SKIPE	NOOUTP			;SUPRESSING ACTUAL OUTPUT?
	$RETT				;YES, RETURN TRUE NOW
	SKIPN	CACMAX			;IF FIELD IS NOT COUNTED
	MOVX	S1,1B0			;MAKE ALL CHARACTERS BE PRINTED
	CAMLE	S1,CACMAX		;CHECK FOR MAXIMUM
	$RETT				;IF TOO MANY, DON'T PRINT IT
	MOVE	S1,TF			;RESTORE CHARACTER
	PUSHJ	P,@USROUT		;OUTPUT IT
	PORTAL	.+1			;ALLOW EXECUTE-ONLY RETURN
	JUMPT	.RETT			;IF RETURNED OK, RETURN NOW
	SETOM	ERREXT			;INDICATE AN ERROR OCCURED.
	$RETT				;AND RETURN.

; PUTQ -- Output an ASCIZ string, byte pointer to string is in S1

PUTQ:	PUSHJ	P,.SAVE1		;SAVE ONE PERM AC
	MOVE	P1,S1			;COPY POINTER
	JRST	PUTT1			;AND CONTINUE

; PUTO -- Output an unsigned octal number, number in S1

PUTO:	PUSHJ	P,.SAVE3		;GET 3 REGISTERS
	MOVEI	P1,0			;CLEAR SHIFT REGISTER
	MOVE	P2,S1			;GET INTO GOOD PLACE
	MOVEI	P3,^D12			;TWELVE POSSIBLE DIGITS
PUTO.1:	LSHC	P1,3			;DELETE LEADING 0
	SKIPN	P1			;IF STILL ZERO,
	SOJG	P3,PUTO.1		;LOOP
PUTO.2:	ANDI	P1,7			;ISOLATE THE BYTE
	MOVEI	S1,"0"(P1)		;MAKE IT ASCII
	PUSHJ	P,PUT7			;PUT OUT THE BYTE
	LSHC	P1,3			;GET NEXT BYTE
	SOJG	P3,PUTO.2		;REPEAT
	$RETT				;OR RETURN NOW


; PUTD -- Put out a signed decimal number, number in S1

PUTD:	PUSHJ	P,.SAVE2		;NEED TWO ACS
	MOVE	P1,S1			;GET INTO PERMANENT PLACE
	JUMPGE	P1,PUTD.1		;IS IT NEGATIVE?
	$PUT7(<->)			;YES, SO PRINT A MINUS SIGN
	MOVMS	P1			;AND CONVERT TO POSITIVE
PUTD.1:	IDIVI	P1,^D10			;PICK OFF A DIGIT
	HRLM	P2,0(P)			;BET YOU'VE SEEN THIS BEFORE
	SKIPE	P1			;ANY DIGITS LEFT?
	PUSHJ	P,PUTD.1		;YES, GET NEXT ONE
	HLRZ	S1,0(P)			;GET A DIGIT
	ADDI	S1,"0"			;CONVERT TO ASCII
	PJRST	PUT7			;PUT OUT DIGIT, LOOP OR RETURN FORM THERE

;  PUTW -- Put out a SIXBIT word, word in S1

PUTW:	PUSHJ	P,.SAVE2		;NEED TWO ACS
	MOVE	P2,S1			;GET WORD INTO SAFE PLACE
PUTW.1:	JUMPE	P2,.RETT		;RETURN IF ONLY BLANKS LEFT
	LSHC	P1,6			;GET A CHARACTER
	MOVE	S1,P1			;GET INTO PLACE
	PUSHJ	P,PUT6			;PRINT THE CHARACTER
	JRST	PUTW.1			;LOOP FOR ALL


; PUT6 -- Put Out A Single SIXBIT character, character in S1

PUT6:	ANDI	S1,77			;INSURE ITS SIXBIT
	ADDI	S1," "			;CONVERT TO ASCII
	PJRST	PUT7			;OUTPUT AS AN ASCII CHARACTER



; PEND -- Put proper ending on the text line


PEND:	SKIPGE	ENDFLG			;WANT SOMETHING DONE?
	$RETT				;NO, RETURN NOW
	SETZM	CACMAX			;NOT PART OF ANY COUNTED FIELD
	SKIPG	ENDFLG			;WANT A NULL?
	JRST	PEND.1			;NO, MUST WANT CR-LF
	MOVX	S1,0			;ASCII NULL
	PJRST	PUT7			;RETURN, PRINT IT

PEND.1:	MOVEI	S1,.CHCRT		;GET A 'CARRIAGE-RETURN'
	PUSHJ	P,PUT7			;PRINT IT
	MOVEI	S1,.CHLFD		;GET A 'LINE-FEED'
	PJRST	PUT7			;PRINT IT, RETURN

; PUTN -- Put out a node specification (in S1)

TOPS20 <
PUTN:	PJRST	PUTW			;PUT IT OUT AS SIXBIT AND RETURN
>   ;END TOPS20 CONDITIONAL

TOPS10 <
PUTN:	MOVE	S2,S1			;COPY NODE NUMBER TO S2
	$CALL	CNVNOD			;CONVERT NAME/NUMBER
	  JUMPF	[MOVE	S1,S2		;RESTORE THE NODE NUMBER
		TLNN	S1,770000	;WAS IT SIXBIT
		 PJRST	PUTO		;JUST OUTPUT THE NODE NUMBER.
		PJRST	PUTW]		;OUTPUT NODE NAME AND RETURN
	TLNN	S1,770000		;PUT NAME IN S1
	EXCH	S1,S2			;PUT NUMBER IN S2
	PUSH	P,S2			;SAVE THE NUMBER
	PUSHJ	P,PUTW			;OUTPUT THE NAME
	POP	P,S1			;PUT THE NUMBER IN S1
	$PUT7(<(>)			;THEN A LEFT BRACKET
	PUSHJ	P,PUTO			;OUTPUT IT IN OCTAL
	$PUT7(<)>)			;THEN THE RIGHT BRACKET
	$RETT				;AND RETURN
>   ;END TOPS10 CONDITIONAL

SUBTTL PUTU - Output user name or PPN

;This routine will take PPN or user number in S1 and output contents

TOPS10 <
PUTU:	SKIPN	S1			;HAVE A GOOD PPN?
	JRST	[MOVEI	S1,[ASCIZ |(PPN unknown)|]
		 PJRST	PUTT]		;THE BEST WE CAN DO
	PUSH	P,S1			;SAVE IT
	$PUT7(<[>)			;GET AN OPEN BRACKET PRINTED
	HLRZ	S1,0(P)			;GET PROJECT PART OF PPN
	PUSHJ	P,PUTO			;PRINT IT
	$PUT7(<,>)			;SEPARATE THE P FROM THE PN
	POP	P,S1			;RESTORE PPN
	ANDI	S1,-1			;DISCARD PROJECT NUMBER
	PUSHJ	P,PUTO			;PRINT IT
	MOVEI	S1,"]"			;GET CLOSE BRACKET
	PJRST	PUT7			;PRINT IT AND RETURN
>;END TOPS10

TOPS20 <
PUTU:	MOVE	S2,S1			;GET LOGGED IN DIRECTORY NUMBER
	HRROI	S1,TTXBUF		;POINT TO TEMPORARY TEXT BUFFER
	DIRST				;AND PUT DOWN THE STRING
	  ERJMP	[MOVEI S1,[ASCIZ/(User unknown)/]  ;IF BAD,,POINT TO 'UNKNOWN'
		 PJRST PUTT ]		;AND PUT THAT OUT !!!
	MOVEI	S1,TTXBUF		;POINT TO TEXT BUFFER
	PJRST	PUTT			;PUT IT OUT AND RETURN
>;END TOPS20

SUBTTL SAVLVL-RSTLVL - Save and restore TEXT levels

;In order to make the $TEXT instruction work at both normal
;	and interrupt level, the T%TEXT routine must detect calls
;	made while inside itself.  IF such a call is made, these
;	routines are used to save away the data base.

SAVLVL:	PUSH	P,S1			;SAVE AN AC
	MOVE	S1,TXTLVL		;GET LEVEL
	CAIE	S1,1			;ONLY SUPPORT TWO LEVELS
	$STOP(TML,Too many levels of call)
	MOVE	S1,[XWD FSAVE,SAREA]	;PREPARE FOR THE BLT
	BLT	S1,SAREA+SSAREA-1	;SAVE AWAY OUR DATA BASE
	POP	P,S1			;RESTORE THE AC
	POPJ	P,			;AND RETURN



RSTLVL:	PUSH	P,S1			;SAVE S1
	MOVE	S1,[XWD SAREA,FSAVE]	;RESTORE THE AREA
	BLT	S1,LSAVE-1		;THAT WAS WIPED BY THIS LEVEL
	POP	P,S1			;RESTORE S1
	POPJ	P,			;RETURN

TXT%L:
		END