;<PUP>PUPUUO.MAC;12    20-JAN-83 15:03:23    EDIT BY TAFT
; Change %Z back the way it was before; add %A for ARPA-format date
;<PUP>PUPUUO.MAC;10    19-JAN-83 11:44:03    EDIT BY TAFT
;<PUP>PUPUUO.MAC;9    19-JAN-83 10:33:21    EDIT BY TAFT
; Change date printing code to handle Tops20 dates without crashing
;<PUP>PUPUUO.MAC;8    13-JAN-83 14:15:00    EDIT BY TAFT
; Change %Z to omit hyphens in dates (per ARPA mail standards).
;<PUP>PUPUUO.MAC;7    24-APR-81 21:17:00    EDIT BY TAFT
; Add %Z escape sequence -- date/time including zone
;<PUP>PUPUUO.MAC;6     2-SEP-79 16:00:59    EDIT BY TAFT
;<PUP>PUPUUO.MAC;5    12-NOV-77 18:08:19    EDIT BY TAFT
; Print octal numbers unsigned
;<PUP>PUPUUO.MAC;4    15-APR-77 09:59:32    EDIT BY TAFT
; Different format for %F conversion if SERVF is set
;<PUP>PUPUUO.MAC;2    10-MAR-77 14:37:23    EDIT BY TAFT
; Split out from PUPFTP.MAC

; Copyright 1979 by Xerox Corporation

	TITLE PUPUUO -- UUO HANDLER FOR PUPSRV AND PUPFTP
	SUBTTL E. A. Taft / March 1977

	SEARCH PUPDEF,STENEX


LOC 41
	UPSHJ P,UUODSP-1	; Dispatch on UUO (Maxc opcode)
RELOC


; UUO dispatch table (driven by definitions in PUPDEF)
; UUO handler routines are responsible for saving their own ac's

UUODSP:	EXPAND(UUOS,<	IF2,<IFNDEF ITEM,<EXTERN ITEM>>
			EXP ITEM>)



; PRINT "char"
; Print the given character

%PRINT:	EXCH A,40		; Get the character
	ANDI A,177		; Mask to just 7 bits
	CAIE A,37		; EOL?
	 JRST %PRIN1		; No
	MOVEI A,15		; Yes, substitute crlf
	PBOUT
	MOVEI A,12
%PRIN1:	PBOUT			; Print it
	MOVE A,40		; Restore ac
	POPJ P,


; DTYPE <string>
; Type given string iff debugging, with formatting actions

%UDTYP:	TLNN F,(DEBUGF)		; Debugging?
	 POPJ P,		; No, ignore DTYPE

; TYPE <string>
; Type given string with formatting actions

%UTYPE:	PUSHJ P,FORMAT		; Call formatter
	 PUSHJ P,%UTYP1		; Setup
	 CAI			; No completion action
	POPJ P,			; Return from UUO

%UTYP1:	MOVEI A,101		; Setup destination designator
	TLNE F,(DEBUGF)		; Debugging?
	 DOBE			; Yes, avoid intermixed output
	POPJ P,

; ERROR <string>  or  ERROR <string>,n
; Same as TYPE except also clears input buffer
; If n is nonzero, n extra levels are popped before return

%UERRO:	PUSH P,40		; Save the UUO itself
	PUSHJ P,FORMAT		; Call formatter
	 MOVEI A,101		; Setup destination
	 PUSHJ P,%UERR2		; Completion -- clear input buffer
	SUB P,0(P)		; Pop off extra levels as required
	POPJ P,

%UERR2:	MOVEI A,↑D500		; Wait half a second
	DISMS
	MOVEI A,100		; Clear terminal input buffer
	CFIBF
	LDB A,[POINT 4,-6(P),12]  ; Get ac field of UUO
	ADDI A,1		; Make word for fixing stack
	HRLI A,(A)
	MOVEM A,-6(P)		; Put it back
	POPJ P,


; WRITE <string>   or   WRITE ac,<string>
; Write given string with formatting actions on arbitrary
;  destination designator given in ac (default ac is A)

%UWRIT:	PUSHJ P,FORMAT		; Call formatter
	 PUSHJ P,%UWRI1		; Setup -- get selected designator
	 PUSHJ P,%UWRI2		; Completion -- update designator
	POPJ P,			; Return from UUO

; Setup routine -- fetch designator from ac specified in UUO
%UWRI1:	LDB A,[POINT 4,40,12]	; Get ac field of UUO
	CAIG A,D		; Ac in protected range?
	 ADDI A,-5(P)		; Yes, now on stack
	HRLM A,-5(P)		; Save address for finishing up
	MOVE A,0(A)		; Get designator from specified ac
	POPJ P,

; Completion routine -- store possibly updated designator
%UWRI2:	HLRZ D,-5(P)		; Recover ac field of UUO
	MOVEM A,0(D)		; Store updated designator
	SETZ B,			; Prepare to store null
	TLNE A,-1		; Outputting to string?
	 IDPB B,A		; Yes, append null
	POPJ P,

; Perform output formatting for UUO routines.
; Assumes ASCIZ string pointed to by 40 (effective adr of UUO).
; Performs substitution for escape sequences of the form
;	% <number> <letter>
; where <number> sometimes specifies an ac and <letter> specifies
; the operation (see table LETDSP).

; Call by:
;	PUSHJ P,FORMAT
;	 Instruction to set up destination designator in A
;	 Instruction to finish up after entire string written
; Returns +3 always
; No ac's clobbered

FORMAT::PUSH P,A		; Save a block of ac's
	PUSH P,B
	PUSH P,C
	PUSH P,D
	XCT @-4(P)		; Execute setup instruction
	TLC A,-1		; -1 in lh of designator?
	TLCN A,-1
	 HRLI A,(POINT 7)	; Yes, make string ptr
	HRRZ B,40		; Get the effective address
	HRLI B,(POINT 7)	; Make byte ptr
	PUSH P,B		; Put on stack

; Loop here for each character
; A/ destination designator
FORMAL:	ILDB B,0(P)		; Get a char from the string
	JUMPE B,FORMA2		; Jump if finished
	CAIN B,"%"		; Escape?
	 JRST FORMA3		; Yes, go handle

; Not special character, just output it
FORMA1:	PUSHJ P,FBOUT		; Do BOUT
	JRST FORMAL		; Loop

; Here when done
FORMA2:	SUB P,[1,,1]		; Flush byte ptr
	MOVE D,-4(P)		; Get caller pc
	XCT 1(D)		; Execute completion instruction
	POP P,D			; Restore ac's
	POP P,C
	POP P,B
	POP P,A
	JRST SK2RET		; Return +3


; Internal BOUT routine
; Same as BOUT except much faster in string pointer case
; (Does not handle case of lh=-1

FBOUT::	TLNN A,-1		; Outputting to a file?
	 BOUT			; Yes, do so in normal manner
	TLNE A,-1		; To string?
	 IDPB B,A		; Yes (much faster than BOUT)
	POPJ P,

; FORMAT (cont'd)

; Here when hit escape sequence
FORMA3:	SETZ C,			; Init number
FORMA4:	ILDB D,0(P)		; Get next char
	CAIL D,"0"		; A digit?
	CAILE D,"7"
	 JRST FORMA5		; No
	LSH C,3			; Yes, multiply number by 8
	ADDI C,-"0"(D)		; Add value of new digit
	JRST FORMA4

FORMA5:	MOVEI B,-5(P)		; Get loc-1 of ac block on stack
	ADDI B,(C)		; Add ac #
	CAIG C,D		; One of the protected ac's?
	 SKIPA B,0(B)		; Yes, get contents from stack
	 MOVE B,0(C)		; No, get contents directly
	CAIL D,"A"		; Check bounds
	CAILE D,"Z"
	 JRST [	CAIN D,"%"	; %% means just quote %
		 JRST [	MOVEI B,"%"
			JRST FORMA1]
		CAIN D,"/"	; %/ means crlf
		 JRST [	MOVEI B,15
			PUSHJ P,FBOUT
			MOVEI B,12
			JRST FORMA1]
		PUSHJ P,SCREWUP##]  ; Anything else is a bug
	PUSHJ P,@LETDSP-"A"(D)	; Dispatch on command
	JRST FORMAL		; Loop


; Dispatch table for escape sequence function letters
; The routine dispatched to has the calling sequence:
;	A/ Destination designator
;	B/ Contents of ac
;	C/ The ac number itself
; Returns +1
; Must update A appropriately;  may clobber B-D

LETDSP:	%LETA		; A - Date and time, ARPA format
	SCREWUP##	; B
	%LETC##		; C - Pup contents as string (PUPSRV only)
	%LETD		; D - Decimal integer in ac
	SCREWUP##	; E
	%LETF		; F - Filename for JFN in ac
	SCREWUP##	; G
	SCREWUP##	; H
	%LETI		; I - Insert character given octal code
	%LETJ		; J - String for JSYS error # in ac
	SCREWUP##	; K
	SCREWUP##	; L
	SCREWUP##	; M
	SCREWUP##	; N
	%LETO		; O - Octal integer in ac
	%LETP##		; P - Address from Pup (PUPSRV only)
	SCREWUP##	; Q
	%LETR		; R - Runime interval in ac - HH:MM:SS.S
	%LETS		; S - ASCIZ string pointed to by ac
	%LETT		; T - Date and time in ac
	%LETU		; U - User name for directory # in ac
	SCREWUP##	; V
	SCREWUP##	; W
	SCREWUP##	; X
	SCREWUP##	; Y
	%LETZ		; Z - Date and time, including zone

; Individual functions for escape sequences

; A - Date and time in ARPA standard form -- like %Z but
; with space punctuation instead of hyphens
%LETA:	PUSHJ P,FIXDAT
	MOVSI C,(1B7+1B13)	; Space punctuation, append zone
	JRST %LETZ1


; D - Decimal integer in ac
%LETD:	MOVEI C,↑D10		; Decimal radix
	NOUT			; Output number
	 PUSHJ P,SCREWUP##
	POPJ P,


; F - Filename for JFN in ac
%LETF:	HRRZS B			; Ensure no flags on in lh
	TLNN F,(SERVF)		; Are we in server?
	 TDZA C,C		; No, use standard form
	 MOVE C,[211120,,1]	; Yes, force printing of directory
	JFNS			; Generate filename string
	POPJ P,


; I - Insert character for given octal code
%LETI:	MOVE B,C		; Get the code
	JRST FBOUT		; Output it


; J - String for JSYS error # in ac
%LETJ:	HRLI B,400000		; This fork
	SETZ C,			; Expand fully
	ERSTR			; Convert error # to string
	 JRST [	HRRZ D,B	; Not defined, save error #
		HRROI B,[ASCIZ /Undefined JSYS error /]
		SOUT		; Complain
		HRRZ B,D	; Recover error #
		MOVEI C,10	; Octal radix
		NOUT		; Include error # in message
		 PUSHJ P,SCREWUP##
		POPJ P,]
	 PUSHJ P,SCREWUP##	; Bad designator?
	POPJ P,			; Done


; O - Octal integer in ac
%LETO:	MOVE C,[1B0+10]		; Unsigned, octal
	NOUT			; Output number
	 PUSHJ P,SCREWUP##
	POPJ P,

; Individual functions for escape sequences (cont'd)

; R - Runtime interval in ac (ms), in form HH:MM:SS.S
%LETR:	ADDI B,↑D50		; Round up to nearest 0.1 second
	IDIV B,[↑D<60*60*1000>]	; Get hours
	PUSH P,C		; Save remainder
	MOVEI C,↑D10		; Output hours
	NOUT
	 PUSHJ P,SCREWUP##
	MOVEI B,":"		; Colon
	PUSHJ P,FBOUT
	POP P,B			; Recover remainder
	IDIVI B,↑D<60*1000>	; Get minutes
	IDIVI C,↑D1000		; Get seconds
	PUSH P,C		; Save seconds
	MOVE C,[1B2+1B3+2B17+↑D10]  ; Decimal, always 2 digits
	NOUT			; Output minutes
	 PUSHJ P,SCREWUP##
	MOVEI B,":"		; Colon
	PUSHJ P,FBOUT
	POP P,B			; Recover seconds
	NOUT			; Output them
	 PUSHJ P,SCREWUP##
	MOVEI B,"."		; Decimal point
	PUSHJ P,FBOUT
	MOVE B,D		; Get thousanths
	IDIVI B,↑D100		; Convert to tenths
	MOVEI C,↑D10
	NOUT			; Output tenths
	 PUSHJ P,SCREWUP##
	POPJ P,


; S - String pointed to by ac
%LETS:	SETZ C,			; Terminate by null
	SOUT			; Append the string
	POPJ P,


; T - Date and time in ac, in standard form DD-MMM-YY HH:MM:SS
%LETT:	PUSHJ P,FIXDAT
	SETZ C,			; Specify standard form
	ODTIM			; Output date and time
	POPJ P,


; U - User name for directory # in ac
%LETU:	DIRST			; Directory to string
	 JRST %LETO		; Failed, output octal number
	POPJ P,


; Z - Date and time -- like %T but with zone appended
%LETZ:	PUSHJ P,FIXDAT
	MOVSI C,(1B13)		; Append zone
%LETZ1:	ODTIM
	TLNN A,-1		; Outputting to a string?
	 POPJ P,		; No, all we can do
	MOVE B,A		; Yes, back up ending ptr 3 characters
	ADD B,[↑D21B5]
	SKIPGE B
	 SUB B,[↑D35B5+1]
	LDB C,B
	CAIN C,"-"		; Replace hyphen with space
	 MOVEI C," "
	DPB C,B
	POPJ P,

; Convert Tops20 date in B to Tenex format if necessary.
; This is a crock and is not really right anyway, but failure to do something
; along these lines causes ODTIM to get an instruction trap.
; Clobbers C

FIXDAT:	MOVE C,B
	AOJE C,CPOPJ		; All ones is OK
	HRRZ C,B		; Get time portion
	CAIGE C,↑D86400		; Legal Tenex time?
	 POPJ P,		; Yes

; Tops20 time is an 18-bit fraction of a day.
	IMULI C,↑D86400		; Convert fraction to seconds
	HLR B,C			; Copy result; binary point is in middle of word
	POPJ P,

; -----------------------------------------------------------------
;	Miscellaneous subroutines
; -----------------------------------------------------------------

; Calling SAVEn (n=1 to 4) at the beginning of a subroutine causes
; ac's P1 through Pn to be saved on the stack.  When the subroutine
; returns, control passes back to SAVEn, which restores the same
; ac's and returns to the caller of the subroutine.  A subroutine
; that calles SAVEn must return either +1 or +2.

SAVE1::	EXCH P1,0(P)		; Save P1, get caller pc
	HRLI P1,0(P)		; Remember where saved P1 is
	PUSHJ P,SAVJMP		; Save our pc and return to caller
	 SOS -1(P)		; Caller returned +1, compensate
	JRST P1SKP		; +2, restore P1 and return +2

SAVE2::	EXCH P1,0(P)		; Save P1, get caller pc
	HRLI P1,0(P)		; Remember where saved P1 is
	PUSH P,P2		; Save P2
	PUSHJ P,SAVJMP		; Save our pc and return to caller
	 SOS -2(P)		; Caller returned +1, compensate
	JRST P2SKP		; +2, restore P1-P2 and return +2

SAVE3::	EXCH P1,0(P)		; Save P1, get caller pc
	HRLI P1,0(P)		; Remember where saved P1 is
	PUSH P,P2		; Save P2
	PUSH P,P3		; Save P3
	PUSHJ P,SAVJMP		; Save our pc and return to caller
	 SOS -3(P)		; Caller returned +1, compensate
	JRST P3SKP		; +2, restore P1-P3 and return +2

SAVE4::	EXCH P1,0(P)		; Save P1, get caller pc
	HRLI P1,0(P)		; Remember where saved P1 is
	PUSH P,P2		; Save P2
	PUSH P,P3		; Save P3
	PUSH P,P4		; Save P4
	PUSHJ P,SAVJMP		; Save our pc and return to caller
	 SOS -4(P)		; Caller returned +1, compensate

	POP P,P4		; Restore P4
P3SKP:	POP P,P3		; Restore P3
P2SKP:	POP P,P2		; Restore P2
P1SKP:	POP P,P1		; Restore P1
	AOS 0(P)		; Return +2 to caller of caller
	POPJ P,


; The following instruction restores P1 from stack and dispatches
; to the caller of SAVEn.

SAVJMP:	JRA P1,0(P1)



; Common subroutine returns

SK3RET::AOS 0(P)		; Return +4 (i.e., skip 3)
SK2RET::AOS 0(P)		; Return +3 (i.e., skip 2)
SKPRET::AOS 0(P)		; Return +2 (i.e., skip 1)
CPOPJ::	POPJ P,			; Return +1


	END