Google
 

Trailing-Edge - PDP-10 Archives - BB-D868C-BM - language-sources/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 Irwin L. Goverman/ILG/CER/MLB/DC/PJT/WLH Sept 27, 1979

;
;
;
;           COPYRIGHT (c) 1975,1976,1977,1978,1979 BY
;           DIGITAL EQUIPMENT CORPORATION, MAYNARD, MA.
;
;     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

	TXTEDT==35			;MODULE EDIT LEVEL

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


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


COMMENT \

Edit	SPR/GCO		Explanation
----	-------		---------------------------------------------
0001			First attempt
0002			Convert to new OTS format
0003			Make multiple levels work
0004			Add PRO2 and PROQ
0005			Add PROB and PRO1
0006	G013		Add PRON/PUTN
0007	G014		FIX BUG IN ^I OF SPACING CAUSING SPACING TO
			HAPPEN TWICE.
0010			FIX BUG WHICH DID NOT ALLOW THE
			FIRST PARAMETER IN $TEXT MACRO TO USE
			INDIRECT AND INDEXED ADDRESSING. THIS MOD NEEDS
			ONLY TO JFCL 1 INSTRUCTION IN X.
0011			CHANGE T%INIT TO USE IIB SET UP BE I%INI1
0012			Add ^R for Job Info blocks and isolate PUTU for
			Displaying User Info.
0013			Add STOPCODE IJU for Bad User Info in JIB (^R)
0014			Change ^R Display
0015			Convert to use I%JINF Routines
0016			Fix ^R on -10 with 0 second name word
0017			Fix ^N to Handle SIXBIT on the -10
0020			Make IQN $STOP give bad index, addr of error
0021			Make BTA $STOP give a hint of where we went south

0022			Removed usage of PJUMPE opdef
0023			Have ^E on the -20 accept 20 error codes and expand
			them. Those are codes greater than 600000
0024			Allow Indexing and Indirect references for ^Q
0025			Generate Stopcode on invalid ^E function value
0026			Generate asciz pointer for ^Q if size and
			position weren't set in fetched pointer.
			(i.e. allow ^Q/KEYTAB(S1),LHMASK/)
0027			Change ^E to get dynamic buffer area and have -2
			represent the last TOPS20 error.
0030			Fix -10 ^B to Check Node name and Number to decide
			if at same node
0031			Modify PROB (Object Block Processor) so that if the
			object type is .OTMNT then the unit is put out as a
			sixbit value.
0032			Output Date/Time internally instead of using ODTIM.
0033			Convert CNTDT to accept and return arguments in S1 and
			S2
0034			Change PUTU so that if the DIRST fails (-20 only),
			we will put out 'User Unknown' instead of stopcode'ing
0035			Fix a bug. Initialize LINPTR in $TEXT init code.

\	;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

	EXT	IIB			;EXTERNAL INITIALIZATION BLOCK

	$DATA	DEFERR			;DEFAULT ERROR EXIT ADDRESS FROM IB.
	$DATA	DEFOUT			;DEFAULT OUTPUT ROUTINE FROM IB
	$GDATA	TXTLVL			;LEVEL WE ARE AT

	$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 CALLER'S OUTPUT ROUTINE
	$DATA	USRRET			;FIRST WORD AFTER $TEXT ARG BLOCK

TOPS20<	$DATA	ERRBUF>			;ERROR BUFFER AREA
	$DATA	CALOC			;CURRENT ARGUMENT EFFECTIVE ADDRESS
	$DATA	CAFLG			;CURRENT ARGUMENT'S FLAGS + RAW ADDRESS
	$DATA	CAPTR			;POINTER WORD FOR CURRENT ARG (IF ANY)
	$DATA	CASPAC			;SPACING WORD FOR CURRENT ARGUMENT (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
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:	SKIPN	S1,IIB+IB.OUT		;PICK UP USER DEFAULT OUTPUT ROUTINE
	$STOP(DOR,Default output routine required) ;MUST BE THERE
	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

TOPS20	<
	PUSHJ	P,CLCFCT		;CALCULATE A TIMEZONE CONVERSION FACTOR
>;END TOPS20 CONDITIONAL
	$RETT				;AND RETURN


;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.

TOPS20	<
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 THE ADDRESS CALLED FROM
	MOVE	0,1(S1)			;GET THE USER ROUTINE ADDRESS INSTR.
	MOVE	S1,USRACS+1		;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
	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
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:	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
	SKIPT				;IF OK, DONT'T STOP NOW
	$STOP(BTA,<Bad $TEXT argument given at address ^O/ARGADR/>)
	LOAD	S1,CASPAC,TXT.SP	;GET SPACING POSITIONS
	LOAD	S2,CASPAC,TXT.SS	;AND SIDE CODE
	CAXE	S1,0			;IF NOT SPACING,
	CAXN	S2,TXT.SR		; OR RIGHT JUSTIFYING,
	JRST	PROBLK			;JUST LOOP FOR NEXT ARGUMENT
	PUSHJ	P,SPACES		;GIVE ANY SPACES NEEDED
	JRST	PROBLK			;THEN LOOP FOR NEXT ARGUMENT
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 CHARACTER COUNTER
	SETZM	CASPAC			;AND THE SPACING WORD
	SETZM	CAPTR			;AND POINTER WORD
	MOVE	S1,@ARGADR		;GET CONTENTS OF FIRST ARG WORD
	MOVEM	S1,CAFLG		;SAVE IT FOR ITS FLAGS
	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,@CAFLG		;CALCULATE EFFECTIVE ADDRESS
	MOVEM	S1,CALOC		;STORE EFFECTIVE ADDR (0 FOR TXT.NA)
	EXCH	P,USRACS+P		;RESTORE STACK POINTER
	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.1		;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.1:	LOAD	S1,CAFLG,TXT.S		;IS THERE A SPACING WORD?
	JUMPE	S1,PARG.2		;NO, DONT PROCESS IT
	AOS	S1,ARGADR		;GET THE ADDRESS OF SPACING WORD
	MOVE	S1,0(S1)		;GET THE SPACING WORD
	MOVEM	S1,CASPAC		;AND STORE IT
PARG.2:	AOS	ARGADR			;ADJUST CURRENT ADDRESS
	LOAD	S1,CAFLG,TXT.M		;GET THE QUALIFIER INDEX ALONE
	CAILE	S1,0			;IF OUT OF RANGE,
	CAIL	S1,PTABL		;
	$STOP(IQN,Illegal qualifier number ^O/S1/ at ^O/T1/)
	LOAD	T1,CASPAC,TXT.SP	;GET SPACING POSITIONS
	MOVEM	T1,CACMAX		;STORE AS MAXIMUM CHARS IN FIELD
	LOAD	S2,CASPAC,TXT.SS	;AND GET SIDE CODE
	CAXE	T1,0			;IF NO SPACING,
	CAXN	S2,TXT.SL		;OR LEFT JUSTIFYING ONLY
	PJRST	@PTAB(S1)		;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.M		;GET QUALIFIER NUMBER AGAIN
	PJRST	@PTAB(S1)		;THEN FINALLY OUTPUT THE ARGUMENT
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	X(A,ARG)<
		Z	PRO'A
	>


PTAB:	PJRST	.RETF			;FILL IN THE 0 (UNUSED) ENTRY
	TQUALS				;AND THEN THE REST OF THE TABLE
	  PTABL==.-PTAB
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.
; CASPAC is the optional spacing information word, used only when the 
;	 argument type-out is to have left justification, right justification, or be
;	 centered.
; 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			;AND PROCESS IT
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
	JUMPE	S1,.RETT		;QUIT NOW IF NO NODE
	MOVE	T1,S1			;SAVE THE NODE
	SETOM	S1			;SET FOR MY JOB
	MOVX	S2,JI.LOC		;GET THE LOCATION
	PUSHJ	P,I%JINF		;GET THE DATA IN S2
	SKIPT				;SKIP IF O.K.
	SETZ	S2,			;MAKE IT 0
	MOVE	S1,T1			;PLACE VALUE IN S1
	CAMN	S2,S1			;SAVE AS CURRENT
	$RETT				;RETURN
TOPS10<	MOVE	T3,S2			;COPY NODE NUMBER TO P2
	MOVE	T1,[XWD 2,T2]		;AC FOR NODE.
	MOVX	T2,.NDRNN		;FUNCTION FOR NODE.
	NODE.	T1,			;GET THE NODE NAME
	   JRST	PROB.3			;ERROR..PRINT OUT NODE
	CAMN	T1,S1			;IS IT SAME NODE
	$RETT				;YES..BYPASS NODE OUTPUT
>;END TOPS10
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
	$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:	$PUT7(<,>)			;PUT OUT A COMMA
	MOVEI	S1,.FDPAT(P1)		;GET SFD LOCATION
	PUSHJ	P,FETCH			;LOAD IT
	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
	JUMPE	P2,PROR.2		;ALL OUT CONTINUE ON
PROR.1:	MOVEI	S1,40			;GET A BLANK
	PUSHJ	P,PUT7			;OUTPUT THE BLANK
	SOJG	P2,PROR.1		;FILL TO 6 CHARACTERS
PROR.2:	MOVEI	S1,JIB.NM+1(P1)		;GET USER NAME WORD 1
	PUSHJ	P,FETCH			;FETCH IT
	SKIPE	S1			;ZERO..IGNORE SECOND WORD
	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
	SKIPE	S1			;ZERO ELEMENT..FATAL ERROR
	PJRST	PUTU			;DISPLAY USER NAME OR PPN AND RETURN
	$STOP(IJU,INVALID USER ID IN JOB INFO BLOCK)
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 APART
	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 3600]		;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
	IDIVI	S1,^D60			;GET MINS
	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
	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:	PUSH	P,ARGADR		;SAVE CURRENT ARGUMENT LIST LOCATION
	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
	POP	P,ARGADR		;RESTORE OLD ARG BLOCK ADDRESS
	SETZM	CASPAC			;CLEAR SPACING WORD[:G014]
	$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:		CASPAC & CACCTR should be set up
;
; Return:	Always TRUE

SPACES:	PUSHJ	P,.SAVE1		;GET ONE PERMANENT REGISTER
	LOAD	P1,CASPAC,TXT.SP	;GET THE SPACING CODE WIDTH
	SUB	P1,CACCTR		;SUBTRACT CHARACTERS FOR OUTPUT
	SETZM	CACCTR			;THEN CLEAR CHARACTERS OUTPUT
	LOAD	S1,CASPAC,TXT.SS	;NOW GET THE SPACING CODE
	CAXE	S1,TXT.SM		;WANT THIS CENTERED?
	JRST	SPAC.1			;NO, SO SKIP THIS
	ASH	P1,-1			;DIVIDE SPACING NEEDED BY 2
	MOVX	S1,TXT.SL		;SET NOW FOR LEFT JUSTIFICATION ONLY
	STORE	S1,CASPAC,TXT.SS	;AND FALL INTO REGULAR SPACING CODE
SPAC.1:	JUMPLE	P1,.RETT		;CHECK FOR DONENESS
	LOAD	S1,CASPAC,TXT.SC	;GET THE CHARACTER TO OUTPUT
	PUSHJ	P,PUT7			;AND PRINT IT
	SOJA	P1,SPAC.1		;REPEAT TILL DONE
SUBTTL CNTDT  - Convert UDT to TOPS-10 DATE UUO Time and Seconds


; This routine gratefully stolen from SCAN
;
;Call:	MOVE	S1,DATE/TIME
;	PUSHJ	P,.CNTDT
;	Return with T1=Seconds since Midnight, T2=Date in system format (.LT. 0 if arg .LT. 0)
;Based on ideas by John Barnaby, David Rosenberg, Peter Conklin
;Uses T1-4

CNTDT::	PUSH	P,S1			;SAVE TIME FOR LATER
	JUMPL	S1,CNTDT6		;DEFEND AGAINST JUNK INPUT
	HLRZ	S1,S1			;GET DATE PORTION (DAYS SINCE 1858)

	RADIX	10			;**** NOTE WELL ****

	ADDI	S1,<1857-1500>*365+<1857-1500>/4-<1857-1500>/100+<1857-1500>/400+31+28+31+30+31+30+31+31+30+31+17
					;S1=DAYS SINCE JAN 1, 1501	
	IDIVI	S1,400*365+400/4-400/100+400/400
					;SPLIT INTO QUADRACENTURY	
	LSH	S2,2			;CONVERT TO NUMBER OF QUARTER DAYS  
	IDIVI	S2,<100*365+100/4-100/100>*4+400/400
					;SPLIT INTO CENTURY		
	IORI	T1,3			;DISCARD FRACTIONS OF DAY	
	IDIVI	T1,4*365+1		;SEPARATE INTO YEARS		
	LSH	T2,-2			;T2=NO DAYS THIS YEAR		
	LSH	S1,2			;S1=4*NO QUADRACENTURIES	
	ADD	S1,S2			;S1=NO CENTURIES
	IMULI	S1,100			;S1=100*NO CENTURIES		
	ADDI	S1,1501(T1)		;S1 HAS YEAR, S2 HAS DAY IN YEAR

	MOVE	S2,S1			;COPY YEAR TO SEE IF LEAP YEAR
	TRNE	S2,3			;IS THE YEAR A MULT OF 4?
	JRST	CNTDT0			;NO--JUST INDICATE NOT A LEAP YEAR 
	IDIVI	S2,100			;SEE IF YEAR IS MULT OF 100
	SKIPN	T1			;IF NOT, THEN LEAP
	TRNN	S2,3			;IS YEAR MULT OF 400?
	TDZA	T1,T1			;YES--LEAP YEAR AFTER ALL
CNTDT0:	MOVEI	T1,1			;SET LEAP YEAR FLAG
					;T1 IS 0 IF LEAP YEAR
		;UNDER RADIX 10 **** NOTE WELL ****

CNTDT1:	SUBI	S1,1964			;SET TO SYSTEM ORIGIN
	IMULI	S1,31*12		;CHANGE TO SYSTEM PSEUDO DAYS
	JUMPN	T1,CNTDT2		;IF NOT LEAP YEAR, PROCEED
	CAIGE	T2,31+29		;LEAP YEAR--SEE IF BEYOND FEB 29
	JRST	CNTDT5			;NO--JUST INCLUDE IN ANSWER
	SOS	T2			;YES--BACK OFF ONE DAY
CNTDT2:	MOVSI	S2,-11			;LOOP FOR 11 MONTHS

CNTDT3:	CAMGE	T2,MONTAB+1(S2)		;SEE IF BEYOND THIS MONTH
	JRST	CNTDT4			;YES--GO FINISH UP
	ADDI	S1,31			;NO--COUNT SYSTEM MONTH
	AOBJN	S2,CNTDT3		;LOOP THROUGH NOVEMBER

CNTDT4:	SUB	T2,MONTAB(S2)		;GET DAYS IN THIS MONTH
CNTDT5:	ADD	S1,T2			;INCLUDE IN FINAL RESULT

CNTDT6:	SKIPGE	S1			;TEST FOR JUNK
	SETZ	S1,0
	EXCH	S1,(P)			;SAVE ANSWER, GET TIME
	TLZ	S1,-1			;CLEAR DATE
	MULI	S1,<EXP 24*60*60>	;CONVERT TO SECONDS/DAY
	DIV	S1,[1B17]		;SHIFT BINARY POINT
	CAIL	S2,<EXP 1B18>		;ROUND UP?
	ADDI	S1,1			;YES, DO SO
	POP	P,S2			;RECOVER DATE
	$RETT				;RETURN

MONTAB:	EXP 0,31,59,90,120,151,181,212,243,273,304,334,365

	RADIX	8			;BACK TO USUAL RADIX
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.

; 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.
	ANDI	S1,177			;MAKE SURE ITS ONLY SEVEN BITS
	AOS	S2,CACCTR		;INCREASE CHARACTER COUNT
	SKIPE	NOOUTP			;SUPRESSING ACTUAL OUTPUT?
	$RETT				;YES, RETURN TRUE NOW
	SKIPN	CACMAX			;IF FIELD IS NOT COUNTED
	MOVX	S2,1B0			;MAKE ALL CHARACTERS BE PRINTED
	CAMLE	S2,CACMAX		;CHECK FOR MAXIMUM
	$RETT				;IF TOO MANY, DON'T PRINT IT
	PUSHJ	P,@USROUT		;ELSE, OUTPUT IT
	JUMPT	.RETT			;IF RETURNED OK, RETURN NOW
	SETOM	ERREXT			;INDICATE AN ERROR OCCURED.
	$RETT				;AND RETURN.


; 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
; 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:	PUSHJ	P,.SAVE2		;SAVE P1 AND P2
	MOVE	P2,S1			;COPY NODE NUMBER TO P2
	MOVE	S1,[2,,P1]		;AC FOR NODE.
	MOVX	P1,.NDRNN		;FUNCTION FOR NODE.
	NODE.	S1,			;GET THE NODE NAME
	  JRST	[MOVE	S1,P2		;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		;WAS IT SIXBIT
	EXCH	S1,P2			;GET THE SIXBIT VALUE
	PUSHJ	P,PUTW			;OUTPUT THE NAME
	$PUT7(<(>)			;THEN A LEFT BRACKET
	MOVE	S1,P2			;COPY NUMBER TO S1
	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:	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