Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 5-galaxy/glxtxt.mac
There are 27 other files named glxtxt.mac in the archive. Click here to see a list.
	TITLE GLXTXT	--  Formatted Text Handler for GLXLIB
	SUBTTL	Preliminaries

;
;
;	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION
;	1975,1976,1977,1978,1979,1980,1981,1982,1983,1984
;
;     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  WHICH  IS  NOT SUPPLIED BY
;     DIGITAL.


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

	TXTMAN==:53			;Maintenance edit number
	TXTDEV==:61			;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. Preliminaries. . . . . . . . . . . . . . . . . . . . .    1
;   2. Table of Contents. . . . . . . . . . . . . . . . . . .    2
;   3. Revision History . . . . . . . . . . . . . . . . . . .    3
;   4. Local Macros . . . . . . . . . . . . . . . . . . . . .    4
;   5. Global storage . . . . . . . . . . . . . . . . . . . .    5
;   6. T%INIT - Initialize the TEXT module. . . . . . . . . .    6
;   7. T%TEXT - Routine to format text output . . . . . . . .    7
;   8. T%TTY  - Buffered terminal output routine. . . . . . .    9
;   9. PROBLK - Process an entire T%TEXT argument block . . .   10
;  10. PROARG - Routine to process each T%TEXT argument . . .   11
;  11. PROTXT
;       11.1.   ROUTINE TO PROCESS THE ACTUAL FUNCTION. . . .   12
;  12. PTAB   - Dispatch table for argument processors. . . .   13
;  13. PROx   - Processors for each type of formatting. . . .   14
;  14. PROT   - Process a string of ASCIZ text. . . . . . . .   15
;  15. PRO3   - Process a an ASCIZ string created by $TEXT. .   15
;  16. PROQ   - Process a byte pointer to an ASCIZ string . .   16
;  17. PROB   - Process a GLXLIB object block . . . . . . . .   17
;  18. PRO1   - Process an object type. . . . . . . . . . . .   18
;  19. PRON   - Process a node specification. . . . . . . . .   18
;  20. PROO   - Process unsigned octal numbers. . . . . . . .   19
;  21. PROD   - Process a signed decimal number . . . . . . .   19
;  22. PROF   - Process a  system dependent file specification  20
;  23. PRO7   - Process a single 7 bit ASCII character. . . .   21
;  24. PRO6   - Process a single 6 bit ASCII character. . . .   21
;  25. PRO5   - Process ASCIZ single word . . . . . . . . . .   21
;  26. PROW   - Process a SIXBIT word . . . . . . . . . . . .   21
;  27. PROP   - Process a directory ID of either PPN or directory NUMBER  22
;  28. PROU   - Process a user ID or either PPN or User number  22
;  29. PROR   - Process routine for Job Info Block  . . . . .   23
;  30. PROE   - Process a GLXLIB error number . . . . . . . .   25
;  31. PROI   - Process an indirect text request. . . . . . .   26
;  32. PROV   - Process a program version number. . . . . . .   27
;  33. PROM   - Process a request for a CONTROL-M (Carriage Ret.)   28
;  34. PROJ   - Process a request for a CONTROL-J (Line Feed)   28
;  35. PROL   - Process a request for a CONTROL-L (Form Feed)   28
;  36. PROK   - Process a request for a CONTROL-K (Vertical Tab)  28
;  37. PRO2   - Process a request for up-arrow. . . . . . . .   28
;  38. PROA   - Process a request to supress free <CR-LF> . .   28
;  39. PRO0   - Process a request to put null (0) at end of line  28
;  40. FETCH  - Routine to get a word from caller's address space   29
;  41. SPACES - Routine to provide any padding requested. . .   30
;  42. Local output routines. . . . . . . . . . . . . . . . .   31
;  43. PUTU
;       43.1.   Output user name or PPN . . . . . . . . . . .   35
;  44. SAVLVL-RSTLVL - Save and restore TEXT levels . . . . .   36
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.

\   ;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
TOPS10<	$RETT>				;RETURN FOR TOPS10

TOPS20<
;This routine is called to recompute the local time
;	conversion factor.  The factor takes into account
;	the local time zone as well as the daylight savings
;	time adjustment.  Note that the routine calculates
;	the next local time occurrence of 0200 hours and
;	saves it for later comparison.

CLCFCT:	MOVEI	S1,.SFTMZ		;TIME ZONE FUNCTION
	TMON				;GET THE ZONE
	SETOM	TMFCTR			;REVERSE NUMBER LINE VALUE
	IMULM	S2,TMFCTR		;CALCULATE BASE HOURS
	GTAD				;GET DATE/TIME
	MOVE	S2,S1			;RELOCATE
	HRRI	S2,25253*2		;LOAD RIGHT WITH 0200
	MOVEM	S2,DSTCHG		;SAVE IT
	HRRZ	S2,S1
	CAIG	S2,25253*2		;AFTER 0200?
	JRST	TINI.1			;NO,WE'RE DONE
	HRLZI	S2,1			;YUP, MAKE IT TOMORROW
	ADDM	S2,DSTCHG		;..
TINI.1:	MOVE	S2,S1			;RELOCATE TIME
	SETZ	T2,0			;..
	ODCNV
	SETZ	S2,0			;SET FOR NO DST ADJUSTMENT
	TXNE	T2,IC%ADS		;FACTOR FOR DST?
	AOS	TMFCTR			;YES, DO SO
	HRLZI	S1,1			;SETUP FULL DAY FACTOR [1,,0]
	IMUL	S1,TMFCTR		;COMPUTE FACTOR HOURS
	IDIVI	S1,^D24			;..AND THE BASE OFFSET
	MOVEM	S1,TMFCTR		;STORE IT AWAY
	$RETT
>;END OF TOPS20 CONDITIONAL ASSEMBLY
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
	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
	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
	CAXN	T1,.OTMNT		;IS THIS A TAPE/DISK OBJECT TYPE
	JRST	[PUSHJ	P,PUTW		;YES,,PUT OUT THE UNIT AS SIXBIT
		 PJRST	PROB.2 ]	;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.2		;SKIP IF NO HIGH UNIT
	$PUT7(<:>)			;OUTPUT RANGE SEPARATOR
	PUSHJ	P,PUTD			;AND THEN HIGH END OF RANGE
PROB.2:	MOVEI	S1,OBJ.ND(P1)		;GET ADDRESS OF USER'S NODE WORD
	PUSHJ	P,FETCH			;GO GET ITS CONTENTS
	SKIPN	T1,S1			;SAVE THE SUPPLIED NODE
	JRST	PROB.4			;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.3]		;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.3]		;AND DISPLAY IT
	MOVE	S1,T1			;PLACE SIXBIT IN S1
	CAMN	S2,S1			;SAME LOCATION?
	JRST	PROB.4			;YES..RETURN
PROB.3:	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.4:	$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
TOPS20	<
	PUSH	P,S1			;SAVE S1
	CAML	S1,DSTCHG		;HAVE WE PASSED NEXT 0200?
	PUSHJ	P,CLCFCT		;YUP, RECOMPUTE LOCAL ADJUSTMENT FACTOR
	POP	P,S1			;RESTORE S1
	ADD	S1,TMFCTR		;MAKE LOCAL TIME ADJUSTMENT
	SKIPGE	S1			;GUARD AGAINST GARBAGE DATES
	SETZ	S1,0			;AND SET TO EARLIEST POSSIBLE
>;;END OF TOPS20 CONDITIONAL ASSEMBLY

PROH.1:	PUSHJ	P,CNTDT			;TAKE IT APART
	ADDI	S1,^D500		;Round to the nearest second
	DMOVE	T1,S1			;GET THE RETURNED VALUES
	PUSH	P,S1			;SAVE TIME
	JUMPL	P1,PROH.2		;IF FLAG IS UP, GIVE TIME ONLY
	MOVE	T1,T2			;POSITION DATE
	IDIVI	T1,^D31			;GET DAYS
	MOVE	T4,T1			;SAVE REST
	MOVEI	S1,1(T2)		;GET DAYS AS 1-31
	CAIGE	S1,^D10			;IF ONE DIGIT,
	$PUT7(< >)			; FILL WITH A SPACE
	PUSHJ	P,PUTD			;PRINT DECIMAL NUMBER
	IDIVI	T4,^D12			;GET MONTHS
	MOVEI	S1,[ASCIZ /-Jan/
		    ASCIZ /-Feb/
		    ASCIZ /-Mar/
		    ASCIZ /-Apr/
		    ASCIZ /-May/
		    ASCIZ /-Jun/
		    ASCIZ /-Jul/
		    ASCIZ /-Aug/
		    ASCIZ /-Sep/
		    ASCIZ /-Oct/
		    ASCIZ /-Nov/
		    ASCIZ /-Dec/](P1)	;GET ASCII
	PUSHJ	P,PUTT			;TYPE THE ASCIZ STRING
	MOVEI	S1,^D64(T4)		;GET YEAR SINCE 1900
	IDIVI	S1,^D100		;GET JUST YEARS IN CENTURY	
	MOVN	S1,S2			;NEGATE TO GET - SIGN		
	PUSHJ	P,PUTD			;TYPE IT OUT
	$PUT7(< >)			;NOW SPACE OVER ONE
PROH.2:	POP	P,S1			;GET TIME BACK
	IDIV	S1,[DEC 3600000]	;GET HOURS
	MOVE	T4,S2			;SAVE REST
	CAIGE	S1,^D10			;IF ONLY ONE DIGIT,
	$PUT7(< >)			;SPACE OVER
	PUSHJ	P,PUTD			;PUT DECIMAL NUMBER OUT
	$PUT7(<:>)			;NOW A COLON TO DIVIDE HOURS FROM MINUTES
	MOVE	S1,T4			;RESTORE REST
	IDIV	S1,[DEC 60000]		;GET MINUTES
	MOVE	T4,S2			;SAVE REST
	CAIGE	S1,^D10			;IF NOT TWO DIGITS,
	$PUT7(<0>)			;GIVE A ZERO FILL
	PUSHJ	P,PUTD			;PRINT DECIMAL MINUTES
	$PUT7(<:>)			;AND SEPARATING COLON
	MOVE	S1,T4			;RESTORE THE REST
	IDIV	S1,[DEC 1000]		;EXTRACT THE SECONDS
	CAIGE	S1,^D10			;IF ITS NOT TWO DIGITS,
	$PUT7(<0>)			; ZERO FILL IT
	PJRST	PUTD			;THEN PRINT IT, RETURN
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