;;; -*- Mode:MIDAS -*- 
SUBTTL Switch setup, to-do comments.

;PRINT VERSION NUMBER
.TYO6 .IFNM1
.TYO 40
.TYO6 .IFNM2
PRINTX/ included in this assembly.
/

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;							;;;;;
;;;;;			"OUT" 				;;;;;
;;;;;	     NEW OUTPUT PACKAGE INTERFACE		;;;;;
;;;;;							;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;							;;;;;
;;;;;	Documentation in MC:KSC;?OUT >			;;;;;
;;;;;		or [SRI-NIC]<NICPROG>OUT.DOC		;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;	REQUIRES:
;;;;;		.INSRT MACROS	- KSC;MACROS or <NICPROG>MACROS
;;;;;		U1,U2,U3,U4	- Sequential ACs
;;;;;		P		- PDL AC
;;;;;		AUTPSY		- JSR'd to for fatal errors
;;;;;	Certain items will require other defs if they are assembled.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

IFNDEF $$O%1T,$$O%1T==0		; Initialize once-only flag
IFE $$O%1T-.PASS, .INEOF	; If already seen OUT package this pass, flush.
$$O%1T==.PASS

IFNDEF $$OUT,$$OUT==1	; 1 = Using new OUT stuff.  Flush flag eventually.
IFNDEF $$DQ,$$DQ==0	; Not using DQ: device unless we understand it.

	; Various item class conditional switches
IFNDEF $$OFLT,$$OFLT==0	; Floating point output
IFNDEF $$OBUF,$$OBUF==0	; UC$BUF Buffered output	(must .INSRT PAGSER)
IFNDEF $$OTIM,$$OTIM==0	; Time output items		(must .INSRT TIMRTS)
IFNDEF $$OHST,$$OHST==0	; Network Host name/#	(on ITS, must .INSRT NETWRK)
IFNDEF $$OERR,$$OERR==0	; OS Error string output (on ITS must define ERRCHN)
IFNDEF $$OPRF,$$OPRF==0	; PRINTF routine hack

	; More conditional switches needed when not using NUUOs.
IFNDEF UAREAS,UAREAS==0	; Disable "uuo area" stuff
IFNDEF ULISTS,ULISTS==0	; Likewise "uuo lists"
IFNDEF USTRGS,USTRGS==0	; ditto "strings" stuff.

	; Parameters
IFNDEF $$CHMX,$$CHMX==:20	; Max # of channels user can use.

comment |
To-do stuff:

Interpreted O.-instrs vs. inline code
	Interpretation: compact but slower.
	Inline: faster, but larger.  More flexible?
	Finally decided to flush all $$ORID code (retaining old copy in case
		it ever becomes useful, which seems unlikely)

Protocol for OC channel AC
	Must preserve U2 (esp over UUO's) if == to OC.
	Reshuffle 4 UUO ac's, so OC not in middle?(interfers with 2-ac stuff)
	STDCH macro to set OC explicitly.
	Should OUT save/restore? Yes - can specify alternate chan.
	Should STDOUT?
		For STDOUT(ch,arg) should preserve?  force use of STDCH
		to explicitly set.
	Can use file of 2-AC instrs for CREFFin to find dependencies.
	See whether any dep on U1/U2.  If not, make U1 the channel AC?
	Problem: UUO's clobber it, so can't simply make it
	"default"... only within an OUT or similar.

Allow use of STDOUT, STDOBP.
	Extend STDOUT macro to take chan, byte addr args?
	Add STROUT plus ditto?
	Pain to save/restore (unless all use OUT call?)
	Screw if smashed by sub.  User must know how to save/restore OC.

Put STRMOVE (from FSCOPY) in for string ops, allow direct access.

Have error macro to replace JSR AUTPSY, so that can specify string.
	Something like:
	CALL @[OUTERR ? ASCIZ /text/]

Implement recursive FMT... problem with hacking temp buffer.  May
	need to allocate extra space, etc.

Should allow user to specify string rtn for XCT-type channels.
	Actually should specify vector holding everything necessary
	such as string-mode rtn addr, unit-mode instr, overflow rtn addr,
	etc.
|

subttl .BEGIN OUT - Macro definitions

.BEGIN OUT	; Start symbol block
.NSTGW		; Lots of hairy defs, make sure no storage assembled.
QMTCH==.QMTCH	; Save value and ensure
.QMTCH==0	; package assembles with traditional quoting style.

SLEV==0		; Stack level at start of OUT macro.
IF1 [	; Begin moby conditional for macro defs
	; Only assemble if pass 1.

	;;; Establish stack macro
DEFINE .M"STK		; To use instead of (P).
(P)-OUT"SLEV!TERMIN

DEFINE DEFMOC NAME,*PRE*,*POST*	; Intermediate useful macro.
DEFINE NAME (CH,A=$,B=$,C=$,D=$,E=$,F=$,G=$,H=$,I=$,J=$,K=$,L=$,M=$,N=$,O=$,Q=$,R=$,S=$,T=$,U=$,V=$,W)
PRE
OUT"$!A
OUT"$!B
OUT"$!C
OUT"$!D
OUT"$!E
OUT"$!F
OUT"$!G
OUT"$!H
OUT"$!I
OUT"$!J
OUT"$!K
OUT"$!L
OUT"$!M
OUT"$!N
OUT"$!O
OUT"$!Q
OUT"$!R
OUT"$!S
OUT"$!T
OUT"$!U
OUT"$!V
.ERR No more than 20 arguments allowed!
.TAG HO
POST
TERMIN
TERMIN

DEFMOC .M"OUTCOD,|
IFNB [CH]{ PUSH P,OC ? MOVEI OC,CH ? OUT"SLEV==OUT"SLEV+1 }
|,|IFNB [CH]{ POP P,OC ? OUT"SLEV==OUT"SLEV-1 }|

DEFMOC .M"OUTCAL,|
PUSHJ P,[
IFNB [CH]{ HRLM OC,(P) ? MOVEI OC,CH }
OUT"SLEV==OUT"SLEV+1
|,|IFNB [CH]{ HLRZ OC,(P) }
OUT"SLEV==OUT"SLEV-1
POPJ P,]|

EXPUNGE DEFMOC

;;; Establish default for simple "OUT" to use.

EQUALS .M"OUT,OUTCOD	; For now, default is inline.
;EQUALS .M"OUT,OUTCAL	; Alternative would be default of CALL.

;;;-----------------------------------------------------------------
;;;	Fundamental "OUT" item definitions
;;;	These are critical to proper operation of the OUT macro!!

DEFINE $$		; Invoked when no arg furnished, to terminate macro. 
.GO HO
TERMIN

			; Define appropriate macro for constant text output.
			; Optimizes 1-char case.
DEFINE $ &TEXT&
IFN <.LENGTH TEXT>-1,{
	MOVE U3,[.LENGTH TEXT,,[ASCII TEXT]]
	CALL OUT"OXTC
}
.ELSE {
	MOVEI U1,<ASCII TEXT>_-29.
	STDOUT
}
TERMIN

	; Continuation of single OUT, in case want to squeeze more items
	; into a single OUT statement.
DEFINE $OUT (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V)
OUTCOD(,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V)
TERMIN

;;;--------------------------------------------------------
;;;	More standard OUT items
;;;		Not so fundamental to macro hackery,
;;;		but closely tied to package.

DEFINE $CH (ARG)		; CH(chan) - Force to a new channel
MOVEI OC,ARG
TERMIN

DEFINE $OPEN (TYP,ARG,L,BS)	; Open the channel
MOVEI U1,TYP
MOVEI U3,[IFSN [ARG][]{ARG} .ELSE {[0]}
	L+0
	BS+0 ]
IFSN [L!BS][] TLO U3,<IFSN [L][]{(UC%LIM)} .ELSE {0} IFSN [BS][]{\(UC%BSZ)}>
CALL OUT"UOPEN3
TERMIN

DEFINE $PTV (ARG)		; Read channel I/O ptr
CALL OUT"UPTV
MOVEM U1,ARG
TERMIN

DEFINE $FRC			; Force out buffered stuff on channel
CALL OUT"OXFRC
TERMIN

DEFINE $RST			; Reset channel
CALL OUT"OXRST
TERMIN

DEFINE $CLS			; Close channel
CALL OUT"OXCLS
TERMIN

DEFINE $PUSH			; Push channel on IO PDL
CALL OUT"OXPUSH
TERMIN

DEFINE $POP			; Pop off PDL into channel
CALL OUT"OXPOP
TERMIN

DEFINE $POPALL			; Pop entire PDL	
CALL OUT"OXPDLR
TERMIN

DEFINE $CALL (ARG)		; Invoke random routine.
CALL ARG
TERMIN


		; Maybe this macro should take an initial arg saying
		; how many additional instrs the field should apply to???
DEFINE $FMT (A,B,C,D)
OUT"$FMB(B,C,D)
OUT"$!A
OUT"$FME
TERMIN

DEFINE $FMB (WID,PREC,FILL,NUM=E,)	; Last "," needed to end default val.
	HRREI U1,WID
IFB [PREC!FILL]{ CALL OUT"OXFST1 ? .STOP }
IFB [PREC] HRLOI U3,377777
.ELSE	MOV!NUM!I U3,PREC
IFB [FILL]{ CALL OUT"OXFST2 ? .STOP }
	MOVEI U4,FILL
	CALL OUT"OXFST3
TERMIN

DEFINE $FME
CALL OUT"OXFDON
TERMIN

DEFINE $XCT (A)
A
TERMIN

;-----------------------------------------------------------------
;	Value-printing "OUT" item routines.

	; General fmt of numerical output items is
	;	N(<addr of num>,width,prec,fill)
	; where N =	O - Octal
	;		D - Decimal
	;		X - Hexadecimal
	;		F - Floating (at moment really G)
	;		E - Floating E fmt (at moment really G)
	;		G - Floating F/E fmt (whichever "best")
	; See "FMT" for explanation of width,prec,fill.

IRP NAM,,[O,D,X,F,E,G]RDX,,[8,10,16,F,E,G]
DEFINE $!NAM (NUM,A,B,C)
IFNB [A!!B!!C] OUT"$FMB(A,B,C,N)
MOVE U3,NUM
CALL OUT"OXN!RDX
IFNB [A!!B!!C] OUT"$FME
TERMIN
TERMIN

DEFINE $N10 (ARG)	; "N10" - Number, base 10 ; signed decimal value,
MOVE U3,ARG		;	with decimal point.
CALL OUT"OXN10
STDOUT(".)
TERMIN


	; Following setup for DEFITM isn't very pretty, but is necessary
	; to produce minimal macro code for each item.  If only MIDAS
	; had string variables!!!
DEFINE DEFIT2 ITM,*INSTR*,INTNAM	; Auxiliary for DEFITM below.
IFNB [INTNAM]{ DEFINE $!ITM (ARG)
INSTR
CALL OUT"INTNAM
TERMIN .STOP }
DEFINE $!ITM (ARG)
INSTR
CALL OUT"OX!ITM
TERMIN
TERMIN

DEFINE DEFITM ITM,INSTR,INTNAM		; Macro for standard item definitions.
IFSE [INSTR][]{ DEFIT2 ITM,"MOVE U3,ARG",INTNAM
		.STOP }
IFSE [INSTR][-]{ DEFIT2 ITM,,INTNAM
		.STOP }
IFE <INSTR>&17,{ DEFIT2 ITM,"INSTR U3,ARG",INTNAM
		.STOP }
DEFIT2 ITM,"INSTR,ARG",INTNAM
TERMIN


DEFITM CRLF,-		   ; CRLF() - obvious
DEFITM EOL,-		   ; EOL() - same as CRLF
DEFITM TAB,-		   ; TAB() - output a tab
DEFITM SP,-		   ; SP() - output a space
DEFITM TLS,,OXLS	   ; TLS([slp]) - Text, List String.
DEFITM TA,MOVEI U1,OXAR	   ; TA(arpt) - Text, Area.  Outputs whole area.
DEFITM TS,MOVEI,OXS	   ; TS([,,# ? bp]) - Text, String variable.

EQUALS $N9,$D
EQUALS $N8,$O
EQUALS $OCT,$O		   ; "OCT" - OCTal value of word, same as N8.
EQUALS $DEC,$N10	   ; "DEC" - DECimal value of word, same as N10.

DEFITM NFL,,OXNFL	   ; NFL(aval) - floating number (G fmt)

DEFITM TZ,MOVEI,OXZA	   ; TZ(a-asciz) - Outputs asciz string
DEFITM TZ$,HRRZ,OXZA	   ; TZ$(a-[a-asciz]) like TZ(@A) but avoids
			   ; further indirection (if LH non-z)

DEFITM TC,,OXTC		   ; TC([#,,[asciz]])  Outputs ASCNT string
DEFITM TPZ,,OXZ		   ; TPZ([bp]) - Outputs BYTEZ string
DEFITM TPC,,OXPC	   ; TPC([#,,[bp]]) a bit of a kludge.

DEFITM W,,OXWD		   ; W(aval) - 36 bit binary word, as-is.
DEFITM WLH,HLRZ,OXWD	   ; WLH(aval) - left halfword, binary, ditto.
DEFITM WRH,HRRZ,OXWD	   ; WRH(aval) - right halfword, ...
DEFITM WBA,,OXWBA	   ; WBA(#,,[ascii]) binary ASCNT (36 bit chars)

DEFITM RH,HRRZ		   ; RH(aval) - Right halfword, full (6 digits)
DEFITM LH,HLRZ,OXRH	   ; LH(aval) - Left halfword, full.
DEFITM HWD		   ; HWD(aval) - "LH,,RH"
EQUALS $H,$HWD		   ; H(aval) - same as HWD
DEFITM RHV,HRRZ,OXN8	   ; RHV(aval) - RH as octal num, not bit pattern.
DEFITM LHV,HLRZ,OXN8	   ; LHV(aval) - LH as octal num, not bit pattern.
DEFITM HV		   ; HV(aval) - LHV,,RHV
DEFITM RHS,HRRE,OXN8	   ; RHS(aval) - RH as signed octal num
DEFITM LHS,HLRE,OXN8	   ; LHS(aval) - LH as signed octal num
DEFITM HS,,OXNHS	   ; HS(aval) - LHS,,RHS

DEFITM 6F		   ; 6F(aval) - Outputs as sixbit without trailing sp.
DEFITM 6W		   ; 6W(aval) - Outputs all 6 sixbit chars
DEFITM 6Q		   ; 6Q(aval) - like 6F but quotes punct. chars with ^Q

; Arpanet host output items.  Requires HOSTS3 and NETWRK, unless OS%TNX.
; For all 4 items, argument is a host number value (normally HOSTS3 fmt)
DEFITM HN		   ; HN(aval) - Host # simplifying if possible
DEFITM HND		   ; HND(aval) - like HN but decimal Internet fmt.
DEFITM HST		   ; HST(aval) - Host name (becomes HND if no name)
			   ; HOST(aval,{item}) - Host name; if no name,
			   ;	output alternate item spec instead.
DEFINE $HOST (ARG,ALTITM)
	MOVE U3,ARG
	CALL OUT"OXHOST
IFB [ALTITM] NOP
.ELSE	 OUTCAL(,ALTITM)
TERMIN

;;; Idiosyncratic items

DEFINE $C (CH)		; C - character (furnish immediate value)
MOVEI U1,CH
STDOUT
TERMIN

DEFINE $S (CNT,BP)	; S - String([#],[bp])
MOVE U3,BP
SKIPLE U4,CNT
 CALL @OUT"USCOPT(OC)
TERMIN

DEFINE $SL (SLP,SAR)	; String, List.  SAR is optional LSE addr.
MOVE U3,SLP
IFB [SAR] CALL OUT"OXSL ? .STOP
SKIPE U1,SAR	; Feeble robustness.
 CALL OUT"OXSLA
TERMIN

	; Define item names for various chars which would fuck up
	; MIDAS macro parsing if seen in literal string.  Other
	; baddies are CRLF and sometimes comma or double-quote.
IRP ITM,,[LABR,RABR,LBRK,RBRK,LBRC,RBRC,LPAR,RPAR]VAL,,[74,76,133,135,173,175,50,51]
DEFINE $!ITM
STDOUT(VAL)
TERMIN
TERMIN

DEFINE $ERR (ARG)	; "ERR" - System error message.  If arg is blank,
IFB [ARG] CALL OUT"OXERRL	; use last err, otherwise arg is error code
.ELSE	MOVE U3,ARG ? CALL OUT"OXERR
TERMIN


DEFINE $TIM (TYP,ARG)
IFB [ARG]{	; If no arg, use current time.
	IFN OS%ITS, CALL OUT"UTMGTS
	IFN OS%TNX, SETO U3,
} .ELSE MOVE U3,ARG
	MOVEI U1,OUT"T$!TYP
	CALL OUT"OXTXS
TERMIN
	; DEFT - for matching subtype names with routines.
	; Subtypes are defined in the $$OTIM section.
DEFINE DEFT ITM,RTN
IF2 T$!ITM==:RTN
TERMIN

] ;END MOBY PASS 1 CONDITIONAL

IF2 [	; Only assemble if pass 2

	; For anything that needs pass2 def?

]	; END PASS 2

.YSTGW			; OK to gen code now.

;;; Resolve a few awkward defs that are shared with other files
;;; which may or may not be inserted (specifically NUUOS)

IF2 IFNDEF AUTPSY, AUTPSY:
	0 ? JRST 4,.

IF1 $$O%BP==0
IF1 IFNDEF MADBP7,$$O%BP==1
IFN $$O%BP,[			; Needs 7-bit ADJBP macro and tables
DEFINE MADBP7 BP,CNT
	MULI BP,5
	ADD BP+1,UADBP7(BP)
	ADD BP+1,CNT
	MOVE BP,BP+1
	IDIVI BP,5
	SUB BP,UHADB7(BP+1)
TERMIN

	; Subtracted from 0,,addr to give appropriate BP pointing at
	; indexed char (ILDB to get it).
UHADB7:	-010700,,1
	-350700,,0
	-260700,,0
	-170700,,0
	-100700,,0
	-010700,,0	; 5th char, may want to index table by UHADB7+1(A)
			; so as to get pointer for LDB, not ILDB.


	133500,,0	; to handle -5 produced by 440700
	repeat 4,0
UADBP7:	-54300,,5
	-104300,,4
	-134300,,3
	-164300,,2
	-214300,,1
] ; IFN $$O%BP

SUBTTL Output package channel definitions

; $UNCHS - Establish how many channels will be used, and
;	set things up so that package-related channel #'s
;	will have space reserved for them, altho illegal for
;	"user" channels.

IF1 [
	%%LSV==. ? OFFSET -.+$$CHMX
UFLDC::	0				; OUT package field-output channel
IFDEF USTRGS,IFNDEF STRC,.M"STRC:: 0	; UUO package string area channel
.M"$UNCHS::		; REAL maximum legal # of channels.

	OFFSET 0 ? LOC %%LSV	; Don't waste space
	EXPUNGE %%LSV


] ;IF1

SUBTTL OUT channel maintenance - basic support

;;;;;;;;;;;;; Unit Output Inline Macro for OUT Channels ;;;;;;;;

	; STDOUT	outputs single byte in U1 on channel in OC.
	; STDOUT(arg)	outputs byte "arg" on channel in OC, clobbers U1.
DEFINE .M"STDOUT (A)
IFSN [A][] MOVEI U1,A
AOSLE @OUT"UCHCNT(OC)
 PUSHJ P,OUT"UCHMP
XCT OUT"UCOPT(OC)
TERMIN
	; STDOBP - variant of STDOUT to be used when there is a BP in
	; U3 that may be susceptible to "bumping".
DEFINE .M"STDOBP (A)
IFSN [A][] MOVEI U1,A
AOSLE @OUT"UCHCNT(OC)
 PUSHJ P,OUT"UCHMPX
XCT OUT"UCOPT(OC)
TERMIN

;;;;;;;;;;;;;;;;; Tables for OUT channels ;;;;;;;;;;;;;;;;;;;;

BVAR
UCOPT:	BLOCK $UNCHS		; XCT'd unit-mode instruction
USCOPT:	BLOCK $UNCHS		; Addr of string-mode routine
UCHCNT:	BLOCK $UNCHS		; Addr of char countdown
UCNTS:	BLOCK $UNCHS		; Char countdown if non-area
UCHLIM:	BLOCK $UNCHS		; Original count allowed
UCHTYP:	BLOCK $UNCHS		; <flags>,,<chan type>
IFN OS%TNX,UCHJFN: BLOCK $UNCHS	; JFN for channel if any
UCHSTB:	BLOCK $UNCHS		; Byte ptr (UC$BPT) or ARPT (UC$UAR)
IFN UAREAS,[
UBMPSP:	0	; Holds special ptr for string output UUO's to avoid area-shift
		; clobberage.
	; UCHSTB, and locs immediately following up to NUSPBP, will be
	; adjusted automatically to compensate for any shifts of UUO areas.
NUSPBP==.-UCHSTB ]
EVAR
;-----------------------------------------------------------------

	; OUT Channel types.

.M"UC$UAR==0	; UAR - UUO area output.  Channel type 0 for easy check.
.M"UC$XCT==1	; XCT - Execute given instr for each output char
.M"UC$BPT==2	; BPT - Byte PTr
.M"UC$IOT==3	; IOT - .IOT/SIOT (or BOUT/SOUT)
.M"UC$BUF==4	; BUF - Buffered UC$IOT
.M"UC$TRN==5	; TRN - Translate into another chan.
.M"UC$NUL==6	; NUL - Null output sink
  .M"UC$NX==7	;==> # of executable channel types.
.M"UC$SAO==7	; SAO - Like UAR for LSE's String-Area.
  .M"UC$NO==10	;==> # of OPEN-able channel types.

UC%FLD==<7_5>,,0		; Mask for type number (in AC field).
.M"UC%LIM==1000,,0		; Arg flag meaning byte # limit specified.
.M"UC%BSZ==2000,,0		; Arg flag meaning bytesize specified.

UC%DBF==200000			; UCHTYP flag, means dynamic UC$BUF buffer.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; Item OPEN(type,arg,arg2) - Opens an OUT channel.  See OUT doc.

	; If there is any chance that U3 will have I or X bits set at
	; this point, then the following instr should be uncommented.
	; In theory the $OPN macro will never use it.
;UOPEN2:	HRRI U3,@U3		; Set RH to true effective address.

	; Entry point for $OPN macro invocation.
	; OC - Channel #
	; U1 - channel type
	; U3 - <flags> <type>,[<arg1addr> ? <arg2addr> ? ... ]
UOPEN3:	CAIL U1,UC$NO		; Check type
	 JSR AUTPSY		; Unknown type! Bad argument.

;; Should the following code be implemented??  Would it break
;; any programs, or be grossly inefficient, or what? --KLH 11/11/82
;;	SKIPN UCHTYP(OC)	; Check existing channel type
;;	 JRST [	PUSHAE P,[U1,U3] ; Ugh, it's still open!
;;		CALL OXCLS	; Close up the channel!
;;		POPAE P,[U3,U1]
;;		JRST .+1]

	MOVEM U1,UCHTYP(OC)	; Store channel type, with zeroed flags.
	PJRST @UOPENT(U1)	; Dispatch for further processing.

UOPENT:	UOPNAR		; Area
	UOPNX		; XCT
	UOPNBP		; BPT
	UOPNIO		; IOT
	UOPNBF		; BUF
	UOPNTR		; Transl.
	UOPNNL		; NUL
	UOPNSA		; SAO
IFN UC$NO-<.-UOPENT> .ERR UOPENT table loses

	; Common return point for some types.
	; U1 - unit-mode instr
	; U4 - <lim>,,<no lim> rtn addrs for string-mode output.
UOPN3:	MOVEM U1,UCOPT(OC)	; Store instruction for unit-mode byte output.
	TLNE U3,(UC%LIM)	; Was limit explicitly specified?
	 JRST [	HLRZM U4,USCOPT(OC)	; Yes, use limit-type string routine.
		MOVN U4,@1(U3)		; And get specified limit value.
		JRST UOPN4]
	HRRZM U4,USCOPT(OC)	; No, use no-limit string routine.
	MOVSI U4,(SETZ)		; And use max neg # for "limit".
UOPN4:	MOVEM U4,UCHLIM(OC)	; Set up limit.
	MOVEM U4,UCNTS(OC)	; and count.
	MOVEI U1,UCNTS(OC)	; Find addr of count
	MOVEM U1,UCHCNT(OC)	; and store that.
	RET

; UC$UAR - Channel type AREA

UOPNAR:
IFE UAREAS,JSR AUTPSY		; Lose if no area hackery assembled.
.ELSE [	
	MOVEI U4,@(U3)		; Get ARPT to area
UOPNA1:	MOVEM U4,UCHSTB(OC)	; Store ARPT, instead of a BP
	HLL U4,$ARTYP(U4)	; Get type bits.
	MOVEI U1,$ARWPT(U4)	; Get addr to write place,
	HRLI U1,(IDPB U1,)	; and insert instruction to XCT.
	TLNN U4,%ARTCH		; But if area is in binary mode
	 MOVE U1,[CALL UOL.AW]	;  need hairy insn
	MOVEM U1,UCOPT(OC)	; Store XCT for unit mode,
	MOVEI U1,$ARCHL(U4)
	MOVEM U1,UCHCNT(OC)	; and addr to find char countdown in.
	MOVEI U1,UOL.AR		; Get addr of string output rtn
	TLNN U4,%ARTCH		; But if area is in binary mode
	 MOVEI U1,UOL.AB	;  need different rtn
	MOVEM U1,USCOPT(OC)	; and set up.
UOPNA9:	CAIGE U3,		; Now, if sign bit was set in flags,
	 CALL UXRST		; reset the area.
	RET

; UOL.AW - Binary word output routine for UC$ARs.
UOL.AW:	MOVE U4,UCHSTB(OC)	; Get ARPT for area
	MOVE U3,$ARWPT(U4)	; Get write ptr
	MOVEM U1,@U3		; Store down it
	AOS $ARWPT(U4)		; Update ptr
	RET


; UOL.AR - String output routine for UC$UAR type.
UOL.AR:	ADDM U4,@UCHCNT(OC)	; Add into count
	SKIPLE @UCHCNT(OC)	; Check it.
	 PUSHJ P,UCHMPX		; If no room left, go get some.
IFE OC-U2, PUSH P,U2
	MOVE U2,@UCOPT(OC)	; Get BP used by the IDPB (from $ARWPT)
	ILDB U1,U3
	IDPB U1,U2
	SOJG U4,.-2
IFE OC-U2,[
	EXCH U2,(P)		; Now restore BP to area's $ARWPT
	POP P,@UCOPT(OC) ]
.ELSE	MOVEM U2,@UCOPT(OC)
	RET

; UOL.AB - Binary-mode string output routine for UC$UAR type.
UOL.AB:	ADDM U4,@UCHCNT(OC)	; Add into count
	SKIPLE @UCHCNT(OC)	; Check it
	 PUSHJ P,UCHMPX		; If no room left, go get some
IFE OC-U2, PUSH P,U2
	MOVE U2,UCHSTB(OC)	; Get area pointer
	ILDB U1,U3		; Get source word
	MOVEM U1,@$ARWPT(U2)	; Write into the area
	AOS $ARWPT(U2)		; Increment ptr
	SOJG U4,.-3		; Loop for all output wds
IFE OC-U2, POP P,U2
	RET

] ; IFN UAREAS

; UC$XCT - Channel type XCT

UOPNX:	MOVE U4,[UOL.X,,UOS.X]	; Specify string-mode rtns to use
	MOVE U1,@(U3)		; Get instr to XCT
	JRST UOPN3

	; String output, XCT
UOL.X:	SKIPG U1,U4
	 RET
	ADDB U1,@UCHCNT(OC)
	JUMPL U1,UOS.X2
	CALL OVFS		; Handle overflow.
UOS.X:	ADDM U4,@UCHCNT(OC)
UOS.X2:	ILDB U1,U3
	XCT UCOPT(OC)		; for now, really unit-mode.
	SOJG U4,.-2
	RET

; UC$BPT - Channel type BPT (Byte Ptr)

UOPNBP:	MOVE U1,@(U3)		; Get byte ptr
	MOVEM U1,UCHSTB(OC)	; And use that as channel state.
	MOVE U1,[IDPB U1,UCHSTB]
	ADDI U1,(OC)		; Make IDPB point to right BP
	MOVE U4,[UOL.BP,,UOS.BP] ; Specify string-mode output rtns.
	JRST UOPN3		; Store instruction & other stuff.

	; String output, BP
UOL.BP:	SKIPG U1,U4
	 RET
	ADDB U1,@UCHCNT(OC)
	JUMPL U1,UOS.B2
	CALL OVFS		; Handle overflow.
UOS.BP:	ADDM U4,@UCHCNT(OC)	; Inc. count
UOS.B2:	ILDB U1,U3
	IDPB U1,UCHSTB(OC)	; BP lives there.
	SOJG U4,.-2
	RET

; UC$IOT - Channel Type IOT ("Hard" channel)

UOPNIO:
IFN OS%ITS,[	MOVE U1,[.IOT U1]	; Get unit operation
		CAILE OC,17		; Ch # must fit into AC field.
		 JSR AUTPSY
		DPB OC,[$ACFLD,,U1]	; Store ch # into instr
]
IFN OS%TNX,[	MOVE U1,@(U3)		; Get JFN for channel
		MOVEM U1,UCHJFN(OC)	; store
		MOVE U1,[CALL U.BOUT]	; Set up instr to xct
]
	MOVE U4,[UOL.IO,,UOS.IO]	; Specify string-mode output rtns
	JRST UOPN3

IFN OS%TNX,[
U.BOUT:	PUSHAE P,[1,2]		; Routine called for UC$IOT byte output
	MOVE 1,UCHJFN(OC)
	MOVE 2,U1
	BOUT
	POPAE P,[2,1]
	POPJ P,
]
	;String output, .IOT
UOL.IO:	SKIPG U1,U4
	 RET
	ADDB U1,@UCHCNT(OC)
	JUMPL U1,UOS.I2
	CALL OVFS		; Handle overflow.
UOS.IO:	ADDM U4,@UCHCNT(OC)		; Bump cnt.
UOS.I2:
IFN OS%ITS,[	SYSCAL SIOT,[OC ? U3 ? U4]	; Trivial!
		 JSR AUTPSY			; ?!?!
]
IFN OS%TNX,[	PUSHAE P,[1,2,3]
		MOVE 1,UCHJFN(OC)	; Set up JFN
		MOVE 2,U3		; bp to string
		MOVN 3,U4		; byte count
		SOUT
		POPAE P,[3,2,1]
]
	RET

; UC$BUF - Channel type BUF (buffered UC$IOT)
;	This code assumes U3 is of form
;		<flags> <typ>,[ [arg] ? [lim] ? [bytesize]]
;	<arg> is as for UC$IOT - on TNX, the JFN to use.
;	<bytesize> is the size of bytes to use.
;		Defaults to 7.
;	<lim> is the buffer size, IN BYTES, to use.
;		Defaults to one page.
;		If negative, it is treated as an AOBJN pointer to
;			the buffer; LH is # of WORDS.
;		If unspecified or zero, the buffer is dynamically allocated.
;			Be sure to CLS the channel, or the buffer will
;			stay around forever!

UOPNBF:
IFE $$OBUF,JSR AUTPSY
.ELSE [	MOVE U1,U3		; Get arg ptr into better place
IFN OS%TNX,[
	MOVE U4,@(U1)		; Get 1st arg (JFN)
	MOVEM U4,UCHJFN(OC)	; Store...
]
	TLNN U1,(UC%BSZ)	; Was byte-size specified?
	 JRST [	MOVEI U3,440700	; No, default to 7-bit.  Set up BP LH
		HRLZM U3,UCHSTB(OC)
		MOVEI U4,5	; and use this many bytes/wd
		JRST UOPNB2]
	SKIPLE U4,@2(U1)	; Get byte-size...
	 CAILE U4,36.		; Make sure it's reasonable.
	  JSR AUTPSY
	MOVEI U3,440000
	DPB U4,[060600,,U3]	; Insert it into S field of BP LH
	HRLZM U3,UCHSTB(OC)	; and store LH for later use.
	MOVEI U3,36.
	IDIV U3,@2(U1)		; Find # bytes per word
	MOVE U4,U3		; Save

	; Have <bytes per wd> in U4, now find buffer length.
UOPNB2:	TLNN U1,(UC%LIM)	; Byte limit specified?
	 JRST UOPNBD		; Nope, use default.
	SKIPGE U3,@1(U1)	; If <lim> is AOBJN, it specifies # words.
	 JRST [	HLRO U3,U3	; Get -<# wds>
		MOVN U3,U3
		JRST UOPNB3]	; Go set up stuff.
	JUMPE U3,UOPNBD		; If zero, use default of one page.
	PUSH P,U3	; Save # bytes
	IDIVI U3,(U4)	; Find # words to use
	CAIE U4,	; If any remainder,
	 ADDI U3,1	; round up to next # of words.
	POP P,U4	; Restore # bytes (want to use exact # given).
	JRST UOPNB4
	
UOPNBD:	MOVEI U3,PG$SIZ
UOPNB3:	IMULI U4,(U3)		; Find # bytes to use in buffer.
UOPNB4:	MOVNM U4,UCHLIM(OC)	; Save -<# bytes> as limit.
	MOVNM U4,UCNTS(OC)	; and set up actual countdown.

	; Now have buffer length in U3 as # words.  See if must allocate.
	TLNE U1,(UC%LIM)	; Check again for <lim> existence.
	 SKIPL U1,@1(U1)	; Clobber arg ptr, skip if AOBJN given.
	  CAIA
	   JRST UOPNB5		; Needn't allocate!  U1 RH has buf addr!
IFE U2-OC,PUSH P,OC
	MOVEI U1,(U3)		; Ask for this many wds.
IFDEF CORGET,CALL CORGET	; Get buffer space, return addr in U2
.ELSE JSR AUTPSY ? IF2 .ERR PAGSER package must be inserted for UC$BUF!!
	MOVEI U1,(U2)
IFE U2-OC,POP P,OC		; Need hair when U2 == OC.
	MOVSI U4,UC%DBF		; Must set "dynamic buffer" flag
	IORM U4,UCHTYP(OC)	; so we remember to de-allocate later.

UOPNB5:	ADDI U3,(U1)		; Find last addr + 1
	HRLM U1,UCHLIM(OC)	; Save start addr of buffer
	HRRM U1,UCHSTB(OC)	; and set up initial BP addr.
	HRLI U1,(U1)
	ADDI U1,1		; Set up src,,src+1 for BLT zap.
	SETZM -1(U1)
	CAILE U3,(U1)		; Handle screw case of 1-wd buffer.
	 BLT U1,-1(U3)		; Clean out the buffer.

	MOVEI U4,UCNTS(OC)
	MOVEM U4,UCHCNT(OC)	; Set addr of countdown
	MOVEI U4,UOL.BF		; Set string-mode rtn addr.
	MOVEM U4,USCOPT(OC)	; Set it.
	MOVEI U1,UCHSTB(OC)
	HRLI U1,(IDPB U1,)	; Cons up unit-mode instr
	MOVEM U1,UCOPT(OC)	; Set.
	RET			; Done...


UOL.BF:	SKIPG U1,U4		; Get temp in U1
	 RET			; making sure something to write.
	ADDB U1,@UCHCNT(OC)	; Add into count
	JUMPGE U1,UOLBF1	; Jump if buffer would be filled up.
	ILDB U1,U3		; Nope, just copy light-heartedly.
	IDPB U1,UCHSTB(OC)
	SOJG U4,.-2
	RET

	; "Overflow".  Note that unlike usual case, we come here even
	; when count is zero, in order to optimize bulk I/O.
	; The idea behind this optimization is that if buffer is
	; empty and byte sizes for request/output are same, we
	; can output directly and skip the copy overhead!
	; This is also done if stuff is already in the buffer but
	; the new stuff is large enough to force two system calls anyway.
	; Only possible problem is if something depends on size of
	; string output for each sys call, eg if one wants to do PMAP
	; type stuff.  If that ever becomes desirable, a new output type
	; or flag can be created.

UOLBF1:	PUSH P,U3
	HRRO U3,UCHLIM(OC)	; Get original limit (fill out LH)
	SUB U1,U4		; Get original countdown,  -<# left>
	CAMG U1,U3		; Countdown increased from original?
	 JRST UOLBF2	; No, making huge request of virgin buffer - Optimize!
	MOVM U3,U3		; Get positive buffer length
	SUB U3,U1		; Add # bytes of room left in buffer
	CAMGE U3,U4		; Will we need more than one sys call?
	 JRST UOLBF4	; No, jump to copy & output.

UOLBF2:	PUSH P,U1		; Save -<# left>
	LDB U1,[$SFLD,,-1(P)]	; Get S field of source BP
	LDB U3,[$SFLD,,UCHSTB(OC)]	; Ditto for buffer BP
	CAIE U1,(U3)		; If same, way's clear!
	 JRST UOLBF3		; Nope, must convert via copy.
IFN OS%ITS,[
;;; Following code prevents the disoptimization of doing non-word-aligned
;;; SIOTs which are very slow in ITS
	CAIE U1,7		; Only if byte size is 7
	 JRST UOLB2A
	PUSH P,U2
	MOVN U1,(P)		; Space available in buffer
	IDIVI U1,5
	JUMPN U2,UOLB2B		; Mustn't SIOT
	MOVE U1,U4		; Amount to be output
	IDIVI U1,5
	JUMPN U2,UOLB2B
	POP P,U2		; Okay, go ahead
UOLB2A:
;;; End of antidisoptimization code
] ;IFN OS%ITS
	EXCH U4,(P)		; Save output cnt on PDL, get back -<# left>
	HRRO U3,UCHLIM(OC)	; Get -<buflen> for quick check...
	MOVEM U3,UCNTS(OC)	; and reset limit in case no force-out.
	CAMGE U3,U4		; Anything at all in buffer?
	 CALL UFRCBI		; Yes, force it out using U4 for UCNTS.
	POPAE P,[U4,U3]		; Then restore original source BP and cnt
	CALRET UOS.I2		; and go output directly via UC$IOT rtn!

IFN OS%ITS,[
UOLB2B:	POP P,U2		; This could be smarter!
]
UOLBF3:	POP P,U1		; Restore -<# left>
UOLBF4:	EXCH U4,(P)		; Save output cnt, get back BP
	MOVE U3,U4		; Put BP in usual place
	JUMPGE U1,UOLBF6	; If buffer already full, skip copy.
	ADDM U1,(P)		; Update saved output cnt.
	MOVM U4,U1		; and get cnt of chars to copy.
	ILDB U1,U3		; Twiddle
	IDPB U1,UCHSTB(OC)	; twaddle
	SOJG U4,.-2
UOLBF6:	PUSH P,U3		; Save source BP
	CALL UFRCBA		; Buffer always full here; output All.
	POP P,U3		; Now restore source BP
	POP P,U4		; and updated count
	JRST UOL.BF		; and start over...

; UFRCBF - Force out buffer.  Clobbers U1,U3,U4.
; Alternate entry points UFRCBI - takes -<#left> countdown in U4 (Immediate)
;			 UFRCBA - sets -<#left> countdown to 0 (All of buffer)

UFRCBA:	TDZA U4,U4
UFRCBF:	 MOVE U4,UCNTS(OC)	; Get -<# left>
UFRCBI:	CAILE U4,		; Make sure something didn't trash buffer!
	 JSR AUTPSY		; Ugh, buffer overflowed?!?!
	CALL UBFRST		; Reset buffer cnt/ptr, get -len in U1.
	SUB U4,U1		; -<# left> - -<buflen> = # to output.
	JUMPG U4,UOS.I2		; Output buffer as per UC$IOT type.
	RET

; UBFRST - Called to reset buffer channel.
;	Doesn't clobber U4, and leaves -<buffer len> in U1.
;	UFRCBF depends on this.

UBFRST:	MOVE U1,UCHLIM(OC)	; Get <bufaddr>,,<-len>
	HLRZ U3,U1
	HLL U3,UCHSTB(OC)	; Cons up new BP to start of buffer
	TLZ U3,770000
	TLO U3,440000		; Force P to 1st byte in word.
	MOVEM U3,UCHSTB(OC)	; and set up new ptr.
	TLO U1,-1		; Make length a kosher neg. num.
	MOVEM U1,UCNTS(OC)	; Store to re-initialize countdown.
	RET

] ;IFN $$OBUF

; UC$TRN - Channel type TRANSL (translate to another UUO chan)
;	Ignores any count specified.
;	Main hair is setting things up so unit-mode AOS and XCT
;	will work; for everything else including string-mode, the
;	mapping is straightforward.

UOPNTR:	MOVE U4,@(U3)		; Get channel to translate to.
	CAIL U4,$UNCHS		; Make sure it's reasonable!
	 JSR AUTPSY
	MOVE U1,[XCT UCOPT]
	ADDI U1,(U4)		; Do a XCT UCOPT+chan
	MOVEM U1,UCOPT(OC)
	MOVE U1,[@UCHCNT]	; Assemble an indirect into
	ADDI U1,(U4)		; the target channel's countdown.
	MOVEM U1,UCHCNT(OC)
	MOVE U1,UCHSTB(U4)	; Just copy UCHSTB
	MOVEM U1,UCHSTB(OC)
	MOVEM U4,UCNTS(OC)	; and hide true channel # in unused count slot.
	MOVEI U3,UOS.TR
	MOVEM U3,USCOPT(OC)
	RET

	;String output, Translate.
UOS.TR:	PUSH P,OC
	MOVE OC,UCNTS(OC)	; Find right channel # to use.
	CALL @USCOPT(OC)	; and go hack.
	POP P,OC
	RET

; UC$NUL - Null output sink

UOPNNL:	MOVE U4,[UOS.NL,,UOS.NL]	; Specify string-mode rtns to use
	MOVE U1,[NOP]			; Get instr to XCT
	TLZ U3,(UC%LIM)		; Ignore any specified limit.
	JRST UOPN3

UOS.NL:	ADDM U4,@UCHCNT(OC)	; Might as well keep track of count.
	RET			; But that's it.


; UCHMP - called when byte count on channel runs out during unit-mode
;	output; see the STDOUT macro for context.  Only other place this
;	routine is called is from UAR-type string output.
;	OC - channel #,
;	@UCHCNT(OC) contains positive # of chars "over-run".
;		for output to areas, this is # of chars needed.
; UCHMPX - variant in which
;	U3 contains a BP that must be preserved across area bumps.

UCHMPX:
IFN UAREAS,[
	MOVEM U3,UBMPSP	; Save U3 in holy place,
	PUSHJ P,UCHMP	; so that its input ptr is bumped correctly if nec.
	MOVE U3,UBMPSP	; Restore from sanctuary.
	POPJ P,
]

UCHMP:	PUSHAE P,[U1,OC,U3,U4]
UCHMP0:	MOVE U1,UCHTYP(OC)	; Get channel type
	JRST @OVFTAB(U1)	; Dispatch to appropriate handler
OVFTAB:	OVFLAR	; UAR
	OVFLX	; XCT
	OVFLBP	; BPT
	OVFLIO	; IOT
	OVFLBF	; BUF
	OVFLTR	; TRAN
	OVFLNL	; NUL
IFN .-<OVFTAB+UC$NX>, .ERR OVFTAB Loses

	; TRAN type overflow.
OVFLTR:	MOVE OC,UCNTS(OC)	; Translate, get real chan #
	JRST UCHMP0		; and try again.

	; BUF type overflow.
OVFLBF:
IFE $$OBUF,JSR AUTPSY
.ELSE [
	SOS @UCHCNT(OC)		; Restore #-left to zero.
	CALL UFRCBF		; Force out buffer
	AOS @UCHCNT(OC)		; Allow for char wanting output
	JRST UCHMP9		; And return normally.
]

	; NUL, XCT, IOT, and BPT type overflow.
OVFLNL:
OVFLX:
OVFLIO:
OVFLBP:	MOVE U1,UCHLIM(OC)	; Get limit for channel
	CAME U1,[SETZ]		; If using maximum, no limit.
	 JRST OVFLIM		; uh-oh, actually limiting... go handle.
	MOVEM U1,UCNTS(OC)	; No limit, just reset count.
	JRST UCHMP9		; Return and output char.

	; UAR type overflow
OVFLAR:
IFE UAREAS,JSR AUTPSY
IFN UAREAS,[
	MOVE U1,UCHSTB(OC)	; Get ARPT for area
	SKIPG U3,$ARCHL(U1)	; In char mode get # chars needed
	 JSR AUTPSY		; Ugh?? Called when not supposed to?
IFN USTRGS,[
	CAIN U1,USTRAR		; Is this the string output area?
	 PUSHJ P,USTRGC		; Ugh, yes.  Go see about GC'ing.
	  JRST OVFAR2		; Didn't GC, proceed normally and expand
	SKIPL $ARCHL(U1)	; If still need room after possible GC,
	 JRST OVFAR2		; go expand normally.
	ADDB U3,$ARCHL(U1)	; GC'd! Add to cnt of chars now available
	JUMPL U1,UCHMP9		; and exit if have enough now
OVFAR2:]			; else drop thru to normal expansion.
	HLL U4,$ARTYP(U1)	; Get area type bits
	TLNN U4,%ARTCH		; If binary mode
	 JRST OVFAR5		;  can write into whole thing
	ADDI U3,4		; Char mode - need to convert len to wds
	IDIVI U3,5		; Round up to # wds needed (clobbers U4)
	MOVEM U3,ARUNIT		; Insert # as arg to UABUMP
	PUSHJ P,UABUMP		; Go bumpit - adjusts $ARCHL.
	SKIPLE $ARCHL(U1)	; Check to be SURE.
	 JSR AUTPSY		; Foo, didn't update or didn't get enough.
	JRST UCHMP9

OVFAR5:	MOVE U4,$ARWPT(U1)	; Current write ptr.
	ADD U4,U3		; New stuff would put us here.
	CAMGE U4,$ARTOP(U1)	; If this would fit
	 JRST UCHMP9		;  no need to bump the area.
	MOVEM U3,ARUNIT		; Else insert # as arg to UABUMP.
	PUSHJ P,UABUMP		; Go bumpit.
	JRST UCHMP9

] ;IFN UAREAS

OVFLIM:	SOS @UCHCNT(OC)		; Restore original count
UCHMP8:	AOS -4(P)		; Abnormal return - DON'T output char!!
UCHMP9:				; Normal return - output char.
	POPAE P,[U4,U3,OC,U1]
	POPJ P,

; OVFS - General-purpose overflow handler for string-mode routines.
;	Only invoked for channels which are definitely being limited;
;	it allows output only up to the limit specified.
;	See BPT, IOT, etc. routines for context.
;	This is a bit inefficient, could be improved by turning
;	unit/string mode ops into NOPs.
;	OC - channel #
;	U1 - # chars overflowed
;	U3 - source BP
;	U4 - source cnt
;	(P) - place to return for no-limit output
;	-1(P) - place to return for no output at all.

OVFS:	SUB U1,U4		; Find original count of -<# left>
	MOVEM U1,@UCHCNT(OC)	; Store back
	MOVN U4,U1		; Smash source cnt to max allowable
	CAIG U4,		; If result is non-null then skip to output
	 POP P,U1		; Else flush 1st return, take 2nd for no output
	RET

; Old doc
; OUTPTV CH,[<returned cnt>]	For use with UUO channels.
;	Returns to c(E) the cnt of chars outputted on channel since
;	opened.  For channels opened into an area, this is
;	the # of chars between start of area and current Write BP.
; End of Old doc

UPTV:	MOVE U1,UCHTYP(OC)	; Get channel type.
	PJRST @UPTTAB(U1)
UPTTAB:	UPTAR		; Area
	UPTX		; XCT
	UPTBP		; BPT
	UPTIO		; IOT
	UPTBF		; BUF
	UPTTR		; Transl.
	UPTNL		; NUL
IFN UC$NX-<.-UPTTAB> .ERR UPTTAB table loses

UPTAR:
IFE UAREAS, JSR AUTPSY
.ELSE [	MOVE U4,UCHSTB(OC)	; Get ARPT
	MOVE U1,$ARWPT(U4)	; Get write ptr into area
IFE OC-U2,PUSH P,U2
	HRRZ U2,$ARLOC(U4)	; and "ptr" to start.
	CALL UPDIF7		; Find diff between the 2 ptrs
	MOVE U1,U2
IFE OC-U2,POP P,U2
	RET
]

UPTIO: UPTX: UPTNL:		; These types share similar code.
UPTBP:	SKIPA U1,UCHLIM(OC)	; Find beginning count.
UPTBF:	 HRRO U1,UCHLIM(OC)	; BUF type has cruft in the LH.
	SUB U1,@UCHCNT(OC)	; <-max> - <-max + cnt> = -cnt
	MOVM U1,U1
	RET

UPTTR:	PUSH P,OC
	MOVE OC,UCNTS(OC)	; Get true channel #
	CALL UPTV
	POP P,OC
	RET

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;		Other maintenance routines

; OUTINI - Initialize output package.

OUTINI:	PUSH P,OC
	PUSH P,[$UNCHS]	; Keep cnt on PDL cuz ACs clobbered.
OUTIN2:	SOSGE OC,(P)
	 JRST OUTIN3
	CALL OXCLS	; Close channel
	JRST OUTIN2
OUTIN3:	
	; Set up for field-output channel.
	OUTCOD(,CH(UFLDC),OPEN(UC$BPT,[440700,,UFBUF],[$LUBUF]))
	SUB P,[1,,1]
	POP P,OC
	RET

OIFRC:
OXFRC:
IFN $$OBUF,[
	HRRZ U1,UCHTYP(OC)	; Get channel type
	CAIN U1,UC$BUF		; If type BUF,
	 CALRET UFRCBF		; Go force it out,
]
	RET			; else just return.

	; Reset channel.  Only meaningful for UAR and BUF.
OIRST:
OXRST:	HRRZ U1,UCHTYP(OC)	; Get channel type
IFN $$OBUF,[
	CAIN U1,UC$BUF
	 CALRET UBFRST		; Do special buffer reset if BUF.
]
IFN UAREAS,[
	CAIN U1,UC$UAR
	 JRST [	MOVE U4,UCHSTB(OC)	; Get ARPT to area
		HLL U4,$ARTYP(U4)	; and set up type bits
		PJRST UXRST]		; and go reset area.
]
	RET

OICLS:
OXCLS:	HRRZ U1,UCHTYP(OC)	; Get channel type
	CALL @OXCLST(U1)	; Do whatever needed for specific type
OXCLS7:	MOVEI U1,UCNTS(OC)
	MOVEM U1,UCHCNT(OC)	; Set safe address for count (not zero!!!)
	MOVE U1,[CALL OBADCH]
	MOVEM U1,UCOPT(OC)	; Store unit-mode instruction
	MOVEM U1,USCOPT(OC)	; and string-mode rtn addr.
	SETZM UCHTYP(OC)	; Make channel type "closed" (actually UAR,
IF2 IFNDEF APOPJ,APOPJ:
	RET			; but what to do?  Set -1?)

OXCLST:	APOPJ		; Area
	APOPJ		; XCT
	APOPJ		; BPT
	OCCLS		; IOT
	OXCLS3		; BUF
	APOPJ		; Transl.
	APOPJ		; NUL
	APOPJ		; SAO
IFN UC$NO-<.-OXCLST> .ERR OXCLST table loses

OXCLS3:
IFE $$OBUF,	JSR AUTPSY
IFN $$OBUF,[	; Buffered output close.
	CALL UFRCBF		; Buffered, must force out vestiges.
	MOVE U3,UCHTYP(OC)	; Now get flags in LH
	HLRZ U1,UCHLIM(OC)	; and buffer addr in U1
	TLNE U3,UC%DBF		; Dynamically allocated buffer?
	 CALL CORREL		; Yup, must release it!
				; Now drop thru to call OCCLS and proceed.
]

OCCLS:
IFN OS%ITS,{SYSCAL CLOSE,[OC] ? JSR AUTPSY }
IFN OS%TNX,{
	PUSH P,1
	HRRZ 1,UCHJFN(OC)
	CLOSF
	 ERJMP .+1
	POP P,1
}
	RET

OBADCH:	JSR AUTPSY		; Output attempted on closed channel.
	RET

; IO Channel "PDL" - PUSH, POP, POPALL

IFN UAREAS,[
.SCALAR IOPDLP			; Address of ARBLK for IOPDL area.
.SCALAR IOPCNT			; # of channels pushed.

OXPUSH:	; Save channel vars
	SKIPN U4,IOPDLP		; Get address of ARBLK
	 JRST [	UAROPN U4,[0 ? [200]]	; Must create, so make one.
		HRRZM U4,IOPDLP
		SETZM IOPCNT
		JRST .+1]
	AOS IOPCNT
	HRRZ U1,$ARWPT(U4)	; Get write ptr,
	HRRZ U3,$ARTOP(U4)	; and 1st non-ex addr,
	CAIL U1,-$OCFRM(U3)	; and ensure enough room.
	 JRST [	MOVEI U4,$OCFRM
		UAREXP U4,@IOPDLP	; Expand the area.
		MOVE U4,IOPDLP	; Restore ARPT
		HRRZ U1,$ARWPT	; Restore write ptr.
		JRST .+1]
	ADD U1,[1,,-1]		; Avoid PDLOV interrupt overhead and get ptr.
%%OCNT==.
	IRP LOC,,[UCOPT,USCOPT,UCHCNT,UCNTS,UCHLIM,UCHTYP,UCHSTB]
	PUSH U1,LOC(OC)
	TERMIN
IFN OS%TNX,PUSH U1,UCHJFN(OC)
$OCFRM==:<.-%%OCNT>		; Get # wds per frame.
	ADDI U1,1
	HRRZM U1,$ARWPT(U4)	; Store new write ptr.

	HRRZ U1,UCHTYP(OC)
	CAIE U1,UC$IOT
	 CAIN U1,UC$BUF
	  CAIA
	   CALRET OXCLS7
IFN OS%ITS,[
	MOVE U1,[.IOPUSH]
	DPB OC,[$ACFLD,,U1]
	XCT U1
]
	CALRET OXCLS7		; Softwarily close channel.


	CALL OXPOP
OXPDLR:	SKIPLE IOPCNT
	 JRST .-2
	UARCLS @IOPDLP
	SETZM IOPDLP
	RET

OXPOP:	SOSGE IOPCNT
	 JSR AUTPSY
	CALL OXCLS		; Close channel currently in slot.
	; Restore channel vars.
	SKIPN U4,IOPDLP
	 JSR AUTPSY		; Attempt to pop empty stack...
	MOVE U1,$ARWPT(U4)
	SUB U1,[1,,1]
IFN OS%TNX,POP U1,UCHJFN(OC)
	IRP LOC,,[UCHSTB,UCHTYP,UCHLIM,UCNTS,UCHCNT,USCOPT,UCOPT]
	POP U1,LOC(OC)
	TERMIN
	ADDI U1,1
	HRRZM U1,$ARWPT(U4)

	; Fix up channel vars in case popped into different channel.
	HRRZ U3,UCHTYP(OC)
	JRST @.+1(U3)
%%OTMP==.
	OXPUAR
	OXPXCT
	OXPBPT
	OXPIOT
	OXPBUF
	OXPTRN
	OXPNUL
IFN <.-%%OTMP>-UC$NX, .ERR UXPOP table loses

OXPBUF:
OXPIOT:
IFN OS%ITS,[
	DPB OC,[$ACFLD,,UCOPT(OC)]	; Set up new chan for unit-mode .IOT
	MOVE U1,[.IOPOP]
	DPB OC,[$ACFLD,,U1]
	XCT U1			; Pop back hardware channel.
]
	CAIE U3,UC$BUF
	 JRST OXPNUL
OXPBPT:	MOVEI U1,UCHSTB(OC)
	HRRM U1,UCOPT(OC)
OXPXCT:
OXPNUL:	MOVEI U1,UCNTS(OC)
	MOVEM U1,UCHCNT(OC)
OXPUAR:
OXPTRN:
	RET

] ; IFN UAREAS

SUBTTL OUT - Formatting routines

OXFLD:	JSP U4,@U3		; Call routine
	JRST OXFST1		; Return vectors according to # params.
	JRST OXFST2
	JRST OXFST3

BVAR
UFFLG:	0	; If -1, format params in effect.
UFWID:	0	; If non-z, specifies a field width.
UFPREC:	0	; Specifies "precision" for strings & floating output
UFFILL:	-1	; Fill char, defaults to neg (meaning blank).
UFSCNT:	0	; Saved channel char cnt
UFSCHN:	0	; Saved channel #
EVAR

OXFST1:	HRLOI U3,377777	; Specify width only.  Set prec to max.
OXFST2:	SETO U4,	; Specify width & prec only.  Set fill char to blank.
OXFST3:	MOVEM U4,UFFILL	; Set fill
	MOVEM U3,UFPREC	; Set prec
	MOVEM U1,UFWID	; Set width
	SETOM UFFLG	; Say hacking format parameters.

	; Set up channel for temporary buffer storage
	MOVEM OC,UFSCHN		; Save current channel, and
	MOVEI OC,UFLDC		; substitute "field" channel.
	SKIPN UCOPT(OC)		; Make sure something there...
	 OUTCAL(,OPEN(UC$BPT,0,[$LUBUF]))	; If not, open it with limit.
	MOVE U1,[440700,,UFBUF]
	MOVEM U1,UCHSTB(OC)	; Reset write-pointer
	SKIPL U1,UFPREC		; Use desired limit.  If negative,
	 CAILE U1,$LUBUF	; or too large,
	  MOVEI U1,$LUBUF	; use maximum.
	MOVNM U1,UCNTS(OC)	; Reset byte countdown to limit.
	MOVNM U1,UCHLIM(OC)	; And save limit being used.
	RET


	; Finalize formatting... called when output done.
OXFDON:	SETZM UFFLG		; Turn off formatting.
	CAIE OC,UFLDC		; Make sure channel is correct one.
	 JSR AUTPSY		; Got zapped in meantime!!??
	MOVE U1,UCNTS(OC)	; Get resulting byte countdown
	SUB U1,UCHLIM(OC)	; <-max + cnt> - <-max> = <# chars written>
	MOVE OC,UFSCHN		; Now can restore previous channel.
	SKIPL U3,UFWID		; What sort of justification?
	 JRST OXFRD		; Right justifying.

	; Left justifying, so output buffer, then fill.
	ADD U3,U1		; <# chars written> + -<field width>
	PUSH P,U3		; Save -<# pads>
	SKIPG U4,U1		; Set up <# chars> for output
	 JRST OXFDL3		; Nothing to output?
	MOVE U3,[440700,,UFBUF]
	CALL @USCOPT(OC)	; Output buffered stuff to real channel.
OXFDL3:	POP P,U4		; Restore -<# pads>
	JUMPGE U4,[RET]		; If no fill needed, return.
	MOVM U4,U4		; Get <# pads>
	SKIPGE U1,UFFILL	; If strange fill char,
	 CAIL U4,$LBSTR		; or filling more than is reasonable,
	  JRST OXFDF		; jump to handle special case.
	MOVE U3,[440700,,UBLSTR]	; Normal case will efficiently
	PJRST @USCOPT(OC)	; output string of padding blanks and return.

	; Finalize right-justified string...
OXFRD:	PUSH P,U1		; Save <# chars written>
	SUB U1,U3		; Find -<# pads to prepend>
	JUMPGE U1,OXFDR4	; Jump if none; can simply output stuff.
	SKIPGE UFFILL		; If strange fill char,
	 CAMGE U1,[-$LBSTR]	; or too much padding,
	  JRST OXFDR3		; do it hard way.
	MOVE U3,[440700,,UFBUF]
	MADBP7 U3,U1		; Adjust BP in U3 by cnt in U1
	POP P,U4
	SUB U4,U1		; <# writ> - <- # pad> = total to write out
	PJRST @USCOPT(OC)	; Output string of blanks AND data together!!

OXFDR3:	MOVM U4,U1		; Move <# pads> to right place
	CALL OXFDF		; Output fill chars one at a time.
OXFDR4:	POP P,U4		; Restore # chars written originally
	MOVE U3,[440700,,UFBUF]	; Point at field buffer
	JUMPG U4,@USCOPT(OC)	; Output and return.
	RET

OXFDF:	SKIPGE U1,UFFILL	; If fill char negative,
	 MOVEI U1,40		; means regular blank.
OXRPTC:	STDOUT			; Repeatedly output byte...
	SOJG U4,OXRPTC
	RET

BVAR
$LBSTR==5*30.			; # blanks in filler buffer
UBLSTR:	.BYTE 7
	REPEAT $LBSTR,40
	.BYTE			; Note buffers contiguous!!

	$LUBUF==$LBSTR		; # chars avail in field-adjusting buffer
UFBUF:	BLOCK <$LUBUF+4>/5
EVAR

SUBTTL OUT - Basic output routines

; Item C(char)	- Output byte

OXC:	STDOUT		; Direct entry pt (if needed)
	RET


; Items EOL,CRLF,TAB,SP		- Output specific chars

OXCRLF:
OXEOL:	STDOUT(^M)
	STDOUT(^J)
	RET
OXTAB:	SKIPA U1,[^I]	; For convenience.
OXSP:	 MOVEI U1,40	; Ditto
	STDOUT
	RET

; Item TZ([asciz]) - Output ASCIZ string

OXZA:	HRLI U3,440700	; form byte ptr
	JRST OXZ	; Jump into loop

; Item PZ([bp]) - Output BYTEZ string

OXZ1:	STDOBP		; Output byte (BP in U3 in case count out)
OXZ:	ILDB U1,U3	; Get input byte
	JUMPN U1,OXZ1	; Loop til hit zero byte.
	RET

; Item PC([#,,[bp]) - Crock kept for compatibility

OXPC:	HLRZ U4,U3	; Direct entry - get cnt
	MOVE U3,(U3)	; Get the bp
	JUMPN U4,@USCOPT(OC)	; Dispatch
	RET

; Item TC([#,,[asciz]]) - Output ASCNT string

OXTC:	HLRZ U4,U3		; Get cnt
	HRLI U3,440700		; Form BP in U3
	JUMPG U4,@USCOPT(OC)	; Dispatch
	RET

; Item TS([,,# ? bp]) - Output byte string var

OXS:	HRRZ U4,(U3)		; Get byte cnt
	MOVE U3,1(U3)		; Get byte ptr
	JUMPG U4,@USCOPT(OC)	; Jump into output rtn
	RET			; Return if null string.

SUBTTL OUT - Sixbit output

; Item 6W(aval) - Output val as 6 SIXBIT chars

OX6W:	MOVE U4,[440600,,U3]
OX6W1:	ILDB U1,U4		; Get 6bit char
	ADDI U1,40		; Convert to ASCII
	STDOUT			; Output
	TLNE U4,770000		; BP counted out yet?
	 JRST OX6W1
	RET

; Item 6F(aval) - Output val as SIXBIT with no trailing spaces

OX6F:	SETZ U4,	; Direct calling sequence SKIPE U3,ARG ? CALL OX6F
	ROTC U3,6
	STDOUT(40(U4))
	JUMPN U3,OX6F
	RET

; Item 6Q(aval) - Output val as SIXBIT like 6F, but quotes punctuation with ^Q

OX6Q:	SETZ U4,
	ROTC U3,6	; Get next character in 6bit
	CAIN U4,'-	; If other than letter, number, or hyphen
	 JRST OX6Q3	; will need a ^Q to quote it.
	CAIL U4,'0
	 CAILE U4,'Z
	  JRST OX6Q2
	CAILE U4,'9
	 CAIL U4,'A
	  JRST OX6Q3
OX6Q2:	STDOUT(^Q)
OX6Q3:	STDOUT(40(U4))
	JUMPN U3,OX6Q
	RET

SUBTTL OUT - Numerical output

; Item O(aval) - Octal
; Item D(aval) - Decimal
; Item X(aval) - Hexadecimal

OXN10.:	MOVEI U1,10.
	CALL OXNTYP
	STDOUT(".)
	RET

OXNTY5:	MOVM U3,U3	; Negative, print minus sign.
	MOVE U4,U1	; Save radix
	STDOUT("-)
	MOVE U1,U4	; Restore radix
	JRST OXNTY1

	; Direct call entry points to numerical typeout rtn.
OXN16:	MOVEI U1,16. ? JRST OXNTYP
OXN8:	SKIPA U1,[8.]
OXN10:	 MOVEI U1,10.

OXNTYP:	JUMPL U3,OXNTY5		; Go print minus sign.
OXNTY1:	IDIVI U3,(U1)
	JUMPE U3,OXNTY2
	HRLM U4,(P)		; save digit on stack.
	PUSHJ P,OXNTY1
	HLRZ U4,(P)
OXNTY2:	CAILE U4,9.
	 SKIPA U1,-10.(U4)+["A ? "B ? "C ? "D ? "E ? "F] ; For hex output
	  MOVEI U1,"0(U4)		;put char in u1
	STDOUT
	POPJ P,

SUBTTL	OUT - Halfword output

; First, experimental Item W(aval) - outputs a single 36 bit word.
; WLH(aval) and WRH(aval), ditto for halfwords.
; The user could call STDOUT directly, but this way he can
; include it from an OUT macro call too.

OXWD:	MOVE U1,U3		; Fetch arg.
	STDOUT			; Output it.
	RET			; What could be simpler?


; Item RH(aval) - Output RH of arg as 6 octal digits
; Item LH(aval) - ditto for LH
; Item HWD(aval) - LH,,RH

OXHWD:	PUSH P,U3
	CALL OXLH
	POP P,U3
	STDOUT(54)	; Comma
	STDOUT(54)
	CALRET OXRH

; Item HV(aval) - Output val as LHV,,RHV (positive octal values)
; Item HS(aval) - Output val as LHS,,RHS (signed octal values)

OXHV:	PUSH P,U3
	HLRZ U3,U3
	CALL OXN8
	POP P,U3
	STDOUT(54)
	STDOUT(54)
	HRRZ U3,U3
	CALRET OXN8

OXHS:	PUSH P,U3
	HLRE U3,U3
	CALL OXN8
	POP P,U3
	STDOUT(54)
	STDOUT(54)
	HRRE U3,U3
	CALRET OXN8

OXLH:	HLRZ U3,U3		; Somewhat useless since can just setup arg to
				; call OXRH directly, but for completeness...

OXRH:	MOVE U4,[220300,,U3]	; Set up BP, 6 bytes of 3 bits.
OXRH1:	ILDB U1,U4
	STDOUT("0(U1))		; Convert & output
	TLNE U4,770000		; BP counted out yet?
	 JRST OXRH1
	RET


; Item WBA (output Ackermans?) a cross between W and TC.
; WBA([#,,[asciz]]) - Output ascnt string in binary

OXWBA:	HLRZ U4,U3		; Get cnt
	HRLI U3,440700		; Form BP in U3
	JUMPG U4,@USCOPT(OC)	; Dispatch
	RET




SUBTTL OUT - Floating-point output
IFN $$OFLT,[

.SCALAR OFLTFS	; Indicates type of output.  - E, + F, 0 G.
FLT%FE==400000,,0
FLT%FF==200000,,0

IFNDEF E,E=:D+1
IFGE E-U1, .ERR ACs will lose for floating output!

OXNE:	SKIPA U1,[OUT"FLT%FE]	; E format, m.nnnnnE+ee
OXNF:	 MOVEI U1,OUT"FLT%FF	; F format, mmm.nn
	PJRST OXNFL

OXNG:	SETZ U1,	; G format; F if within range, else E.  Maximum prec.

OXNFL:	PUSHAE P,[A,B,C,D,E,OFLTFS]
	MOVEM U1,OFLTFS		; Set flags to use
	PUSHJ P,UNFO
	POPAE P,[OFLTFS,E,D,C,B,A]
	RET

; This routine adapted from that in MACLISP.

UNFO:	SKIPL A,U3
	 JRST UFP1
	STDOUT("-)
	MOVN A,U3
UFP1:	SKIPLE OFLTFS		; If want F-format,
	 JRST UFP1F		; Go straight to it.
	SETZB B,D		; For E-fmt, B holds add'l signif bin digits
	CAMGE A,[.01]		; and D is exponent sign indicator
	 JRST UFP4		; D=0 => negative exponent [x < 1.0e-2]
	CAML A,[1.0^8]
	 AOJA D,UFP4F		; D=1 => positive exponent [x > 1.0e+8 - 1]
	SKIPGE OFLTFS		; Made it, can use F fmt, but is E required?
	 JRST [	CAMGE A,[1.0]	; Yes, test to get exponent sign.
		 JRST UFP4	; Neg exp
		AOJA D,UFP4F]	; Pos exp

	; "F" format.  "G" comes here for 1.0e-2 <= x < 1.0e8
UFP1F:	CAMGE A,[1.0]		; First find -<# digits to right of point.>
	 JRST [	MOVNI E,10.
		CAML A,[.1]	; .1 <= x < 1.0
		 JRST UFP3
		SOJA E,UFP3]	; .01 <= x < .1
	PUSHJ P,UFPL10		; <# digits to left of .>+1 will now be in E
	SUBI E,9.		; Get -<# digits to right.>
UFP3:	SETZB B,C
	ASHC A,-27.		; Split exponent part off
	ASHC B,-243(A)		; Split number into integral and fract part

	MOVE U3,B		; Output integer part
	PUSHJ P,OXN10
	STDOUT(".)

	MOVE B,C		; Move fract part
	MOVM D,E		; D now holds # digits to print to right of .
	MOVSI E,200000		; Compute position of last significant bits
	ASH E,-243+1+<43-27.>(A)
	SKIPE U4,UFFLG		; Format params in effect?
	 MOVN U4,UFPREC		; Yes, get precision (# columns to right of .)
UFP3A:	MOVE A,B
	MULI A,10.
	IMULI E,10.
	CAMGE B,E
	 JRST UFPX0
	MOVN C,E
	TLZ C,400000
	CAMLE B,C
	 AOJA A,UFPX0		; Last sig digit, but round upwards
	; Note only truncate when U4 was positive to start with.
	SOJE U4,[TLNE B,200000	; If forcing last digit, round upwards.
		 CAIL A,9.	; Round.  This is a KLUDGE check since
		  JRST UFPX0	; can't carry the roundup further (digits
		AOJA A,UFPX0]	; already output).  Oh well.
	STDOUT("0(A))
	CAIN D,2		; On ninth output digit, use only half a digit
	 ASH E,-1		; for end-of-precision test
	SOJG D,UFP3A
	JUMPG U4,UFPX1
	POPJ P,			; Last significant digit, so stop

UFPX0:	STDOUT("0(A))
	SOJG U4,UFPX1		; Skip if precision not done yet.
	 RET
UFPX1:	MOVEI U1,40		; Need to pad out.  Default filler is space,
	SKIPGE OFLTFS		; but if doing E fmt,
	 MOVEI U1,"0		; then pad with zeros instead.
	CALRET OXRPTC		; Go pad out.


; ----------- Here for "E" format -------------------

UFP4:	JUMPN A,UFP4F		; Floating point "E" format
	STDOUT("0)
	STDOUT(".)
	STDOUT("0)
	SKIPE U4,UFFLG
	 MOVN U4,UFPREC		; If formating, get precision.
	SOJG U4,UFPX1		; If must space out, do so.
	POPJ P,

UFP4F:	MOVEI E,1
	JUMPE D,UFP4E		; Jump out if negative exponent.
UFP4E0:	FDVL A,UFP10.0		; Double-prec div by 10.0 until
	FDVRI A+1,(10.0)	; quotient is < 10.0
	FADL A,A+1
	CAML A,UFP10.0
	 AOJA E,UFP4E0
	JRST UFP4B

UFP4E:	FMPRI A+1,(10.0)
	MOVEM A+1,A+2		; Double-precision mul by 10.0 until
	FMPL A,UFP10.0		; product is >= 1.0
	UFA A+1,A+2		; Keeping count in E
	FADL A,A+2
	CAMGE A,UFP1.0
	 AOJA E,UFP4E

UFP4B:	PUSH P,E		; Save exponent
	PUSH P,(D)["- ? "+]	; Save sign of exponent
	SETZ B,
	MOVNI E,8.
	MOVSI U4,(FLT%FE)	; Indicate hacking E format.
	IORM U4,OFLTFS
	PUSHJ P,UFP3		; Num has been normalized for 1.0 <= x < 10.0

	STDOUT("E)
	POP P,U1		; Restore sign char
	STDOUT			; Output it.
	POP P,U3		; Restore exponent value
	CAIL U3,100.		; Shouldn't be possible to exceed, but...
	 PJRST OXN10		; hack more than 2 digits in exponent.
	IDIVI U3,10.
	STDOUT("0(U3))		; Always use 2 digits in output.
	STDOUT("0(U4))
	POPJ P,

UFPL10:	MOVEI E,8
	CAMGE A,UFP1.0-1(E)
	 SOJG E,.-1
	POPJ P,

UFP1.0:	REPEAT 8,1.0^.RPCNT
UFP10.0=UFP1.0+1

] ;end IFN $$OFLT

SUBTTL C-style PRINTF routine

IFN $$OPRF,[
; PRINTF for the OUT package.  This code was mostly done for the hell
; of it -- it is considerably less efficient than simply using the OUT
; macro directly!

; The following description is taken almost verbatim from "The C Programming
; Language" by Kernighan and Ritchie, 1978, p. 145-146.
; The PRINTF control string is composed of ordinary chars (which are output
; as-is) and conversion specifications.  Each conversion spec is introduced
; by the char "%" and ended by a conversion char.  Between the % and the
; conversion char there may be:
;	A minus sign, which specifies left adjustment of the converted arg
;		in its field.
;	A digit string specifying a minimum field width.  The converted
;		number will be printed in a field at least this wide, and
;		wider if necessary.  If the converted arg has fewer chars
;		than the field width it will be padded on the left (or
;		right, if the left adjustment indicator has been given) to
;		make up the field width.  The padding char is blank normally
;		and zero if the field width was specified with a leading zero
;		(this zero does not imply an octal field width).
;	A period, which separates the field width from the next digit string.
;	A digit string (the precision), which specifies the maximum number
;		of chars to be printed from a string, or the number of digits
;		to be printed to the right of the decimal point of a FLOAT
;		or DOUBLE.
;	A length modifier "l" which indicates that the corresponding data
;		item is a LONG rather than an INT.

; The conversion chars and their meanings are:
;	d - The arg is converted to decimal notation.
;	o - The arg is converted to unsigned octal notation (without a leading
;		zero).
;	x - The arg is converted to unsigned hexadecimal notation (without a
;		leading 0x).
;	u - The arg is converted to unsigned decimal notation.
;	c - The arg is taken to be a single char.
;	s - The arg is a string; chars from the string are printed until a
;		null char is reached or until the number of chars indicated
;		by the precision specification is exhausted.
;	e - The arg is taken to be a FLOAT or DOUBLE and converted to decimal
;		notation of the form [-]m.nnnnE[-+]xx where the length of the
;		string of n's is specified by the precision.  The default
;		precision is 6.
;	f - The arg is taken to be a FLOAT or DOUBLE and converted to decimal
;		notation of the form [-]mmm.nnnn where the length of the string
;		of n's is specified by the precision.  The default precision is
;		6.  Note that the precision does not determine the # of
;		significant digits printed in F format.
;	g - Use %e or %f, whichever is shorter; non-significant zeros are not
;		printed.

; If the char after the % is not a conversion char, that char is printed;
; thus % may be printed by %%.

DEFINE PRINTF (CH,&STR&,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P)
	IFNB [CH]{ PUSH P,OC ? MOVEI OC,CH }
	MOVEI U1,[ASCIZ STR]
	MOVEI U3,[A ? B ? C ? D ? E ? F ? G ? H ? I ? J ? K ? L ? M ? N ? O ? P]
	CALL OXPNTF
	IFNB [CH]{ POP P,OC }
TERMIN

OXPNTF:	HRLI U1,440700
	PUSH P,U1
	TLO U3,(@)		; Turn on the indirect bit in arg pointer
	PUSH P,U3
	JRST OXPT10

OXPT05:	STDOUT
OXPT10:	ILDB U1,-1(P)		; Get char from string
	CAIN U1,"%
	 JRST OXPT20		; Special escape char, hack it.
	JUMPN U1,OXPT05
OXPT90:	SUB P,[2,,2]		; End of string, done!
	RET
OXPT15:	AOS (P)			; Done with one arg, point to next.
	JRST OXPT10

	; Handle special escape within string!
	; Need the following vars:
	;	Minus-sign flag
	;	Padding-char value (blank or 0)
	;	Field-width value
	;	Precision value
	;	Possible argtype indicator (L, indirect, immediate etc)
OXPT20:	SETZB U3,U4		; Clear minus,,pad and field width
	ILDB U1,-1(P)		; Get next char (indicating type)
	CAIN U1,"-		; Minus sign?
	 JRST [	TLO U3,(SETZ)	; Use negative field
		ILDB U1,-1(P)	; and get another char.
		JRST .+1]
	CAIE U1,"0		; First digit a 0?
	 HRRI U3,40		; No, so use blank for pad-char.
OXPT22:	CAIL U1,"0
	 CAILE U1,"9
	  JRST OXPT25		; Jump when done with field-width arg
	IMULI U4,10.
	ADDI U4,-"0(U1)
	ILDB U1,-1(P)
	JRST OXPT22

OXPT25:	TLZE U3,(SETZ)		; If minus was given,
	 MOVNS U4		; make field width negative.
	PUSH P,U3		; Save fill char value
	SETZ U3,		; Clear val of prec field
	CAIE U1,".
	 JRST OXPT30		; No precision field
OXPT26:	ILDB U1,-2(P)		; Get next char (note stack index changed)
	CAIL U1,"0
	 CAILE U1,"9
	  JRST OXPT30		; Jump when done with precision arg
	IMULI U3,10.
	ADDI U3,-"0(U1)
	JRST OXPT26
	
	; (P)/ pad char
	; U4/ field width (0 if none)
	; U3/ precision (0 if none)
	; U1/ break char (either the modifier or the conversion char)
OXPT30:	CAIE U1,"l	; For now, ignore all arg modifiers.
	 CAIN U1,"L
	  JRST [ILDB U1,-2(P)
		JRST .+1]

	; Now have conversion char in U1.  Make uppercase.
	JUMPE U1,[POP P,U1 ? JRST OXPT90]	; Fail here if string gone.
	CAIL U1,"a
	 CAILE U1,"z
	  CAIA
	   TRO U1,40
	CAIN U3,
	 JUMPE U4,[SETZM (P)	; Jump if no field specs whatsoever.
		JRST OXPT40]
	; Hacking field formatting!
	CAIE U1,"S		; Unless type is S,
	 MOVNS U3		; Ensure precision (if any) is negative!
	EXCH U1,U4		; Get field width in U1,
	EXCH U4,(P)		; pad char in U4, and conversion char in (P)
	CAIN U1,		; If no width given,
	 HRLOI U1,377777	; Use maximum.
	CAIN U3,		; If no prec given,
	 MOVNI U3,6		; Likewise specify max (for numbers, default 6)
	CALL OXFST3		; Set up field output stuff!
	SETO U1,
	EXCH U1,(P)		; Say we're formatting!

	; (P)/ non-zero if formatting
	; U1/ conversion char
OXPT40:	CAIN U1,"C		; C - Output char value
	 JRST [	MOVE U1,@-1(P)
		JRST OXPT69]
	CAIN U1,"S		; S - Output an ASCIZ string.
	 JRST [	MOVE U3,@-1(P)
		TLCE U3,-1	; If all zeros, skip
		 TLCN U3,-1	; If all ones, don't skip
		  HRLI U3,44070	; If LH is 0 or -1, substitute this.
		CALL OXZ	; Output zero-terminated byte string
		JRST OXPT70]
	CAIN U1,"D		; D - Output decimal value
	 JRST [	MOVE U3,@-1(P)
		CALL OXN10
		JRST OXPT70]
	CAIN U1,"O		; O - Output octal value
	 JRST [	MOVE U3,@-1(P)
		CALL OXN8
		JRST OXPT70]
	CAIN U1,"X		; X - Output hexadecimal value
	 JRST [	MOVE U3,@-1(P)
		CALL OXN16
		JRST OXPT70]
	CAIN U1,"U		; U - Output unsigned decimal value
	 JRST [	SKIPL U3,@-1(P)
		 JRST [	CALL OXN10
			JRST OXPT70]
		LSHC U3,-35.
		LSH U4,-1.	; Get low 35 bits in U4, high bit in U3
		DIVI U3,10.	; Get quotient in U3, rem in U4
		PUSH P,U4
		CALL OXN10	; Output all but last decimal digit
		POP P,U3	; Restore last digit value
		ADDI U3,"0	; Make ASCII
		JRST OXPT69]	; Output and done.

	CAIN U1,"E		; E - Output floating point
	 JRST [	MOVE U3,@-1(P)
		CALL OXNE
		JRST OXPT70]
	CAIN U1,"F		; F - Output floating point
	 JRST [	MOVE U3,@-1(P)
		CALL OXNF
		JRST OXPT70]
	CAIN U1,"G		; G - Output floating point
	 JRST [	MOVE U3,@-1(P)
		CALL OXNG
		JRST OXPT70]

	; No match, illegal type spec... just output it!
	SOS -1(P)		; Decrement count to nullify later increment.
OXPT69:	STDOUT			; Output char

OXPT70:	POP P,U1		; Pop format indicator off stack.
	JUMPE U1,OXPT15		; Back to normal loop!
	CALL OXFDON		; We were formatting, wrap up.
	JRST OXPT15
] ;IFN $$OPRF

SUBTTL Various special item output

IFN UAREAS,[

OXAR:	SKIPN $AROPN(U1)	; Make sure it's open.
	 RET			; Just return if it isn't.
	MOVE U3,$ARWPT(U1)	; Get write pointer (end of used area)
	SUB U3,$ARLOC(U1)	; Make relative to beg
	MULI U3,5		; do bp hack
	ADD U4,UADBP7(U3)	; Get # chars.
	MOVE U3,$ARLOC(U1)	; Now cons up a BP to start.
	HRLI U3,440700
	JUMPG U4,@USCOPT(OC)	; Finally dispatch to string output,
	RET			; unless nothing to output.
] ;IFN UAREAS

IFN ULISTS,[

; Item TLS(slp) - Output string that SLP points to

OXLS:
OXSL:				; Preferred label.
IF1 IFNDEF LISTAR, NOP		; 1st pass may not have macro def'd yet.
.ELSE	MOVE U3,LISTAR(U3)+1	; Get its SPT.
	HLRZ U4,U3		; Get count.
	ADD U3,$LSLOC(L)	; Make address absolute
	HRLI U3,440700		; and turn into a BP.
	JUMPG U4,@USCOPT(OC)	; Jump into output loop if anything there.
	RET			; Else no-op.

	; List-String relative to specific LSE.
	; U1 - addr of LSE
	; U3 - SLP to SLN within that LSE.
OXSLA:	EXCH L,U1		; For addressing purposes...
IF1 IFNDEF LISTAR, NOP	; 1st pass may not have macro def'd yet.
.ELSE	MOVE U3,LISTAR(U3)+1	; Get the SPT.
	ADD U3,$LSLOC(L)	; Make address absolute.
	MOVE L,U1		; Restore original L.
	HLRZ U4,U3		; Get count,
	HRLI U3,440700		; make BP,
	JUMPG U4,@USCOPT(OC)	; and off to output it.
	RET

] ;IFN ULISTS

; UC$SAO output type - replaces old SAOBEG UUO.
;	Initializes for standard UUO output into SA area; argument is
;	a LSE pointer, e.g. OPEN(UC$SAO,$ARLOC+MSGAR) or OUTOPN CH,[$UCSAO,,L].
;	The %LTSAO type bit in MAKELN will form a string LN of accumulated
;	output.

UOPNSA:
IFE ULISTS, JSR AUTPSY
.ELSE [	SKIPN U4,@(U3)		; Get pointer to LSE
	 MOVE U4,L		; If none specified, use current LSE.
	MOVE U1,$LSFRE(U4)
	ADD U1,$LSLOC(U4)	; Get abs start addr
	HRLI U1,440700		; Form BP
	MOVEM U1,$LSWPT(U4)	; and set up new write ptr for area.
	MOVEI U1,(U1)
	SUB U1,$LSTOP(U4)	; Get -<# wds left>
	IMULI U1,5
	MOVEM U1,$LSCHL(U4)	; Store as $ARCHL for SA.

	MOVEI U4,$LSAR(U4)	; Finally get pointer to string-area ARPT.
	MOVEI U1,UC$UAR		; Replace channel type with normal area.
	MOVEM U1,UCHTYP(OC)
	PJRST UOPNA1		; Dispatch to complete normal area-open.

] ;IFN ULISTS

SUBTTL ERR item output
IFN $$OERR,[

; Code for ERR output type.
;	Arg is error #.
;	If arg -1, use "last error".

; Include crocks for compatibility with old kludge.
ERRMOA:	SKIPA U3,A
ERRMO:	 SETO U3,
	PUSH P,OC
	MOVEI OC,(B)
	CALL OXERR
	POP P,OC
	RET

; Item ERR(val) - Output system error string for given error #
;		If no val or -1 specified, use last syscal error.

OXERRL:	MOVE U3,[-1]	; Entry pt to use last error
OXERR:	
IFN OS%ITS,[
	MOVEI U4,4	; Assume # specified,
	CAIGE U3,	; But if want "last error",
	 MOVEI U4,1	; ask system for that.
IFNDEF ERRCHN,.ERR ERRCHN must be defined for $$OERR to work.
	SYSCAL OPEN,[CIMM ERRCHN
		[SIXBIT/ERR/] ? U4 ? U3 ]
	 JRST [	MOVEI U3,[ASCIZ "?? Can't get error msg from ERR device ??"]
		PJRST OXZA]
OXERR2:	.IOT ERRCHN,U1
	CAIGE U1,40
	 JRST [	.CLOSE ERRCHN,
		RET ]
	STDOUT
	JRST OXERR2
] ;END IFN ITS

IFN OS%TNX,[
	PUSHAE P,[1,2,3]
	MOVEI 2,(U3)
	HRLI 2,.FHSLF		; 2 = <fork>,,<err #>
	MOVSI 3,-UERBFL		; 3 = -<# chs>,,
	HRROI 1,UERBUF		; 1 = -1,,<dest addr>
	ERSTR			; Get error string
	 ERJMP [MOVEI U3,[ASCIZ /<Illegal error #: /]
		CALL OXZA
		MOVEI U3,(2)
		CALL OXN8
		MOVEI U3,[ASCIZ />/]
		JRST OXERR5]
	 JRST [	MOVEI U3,[ASCIZ /<Bad ERSTR call?!>/]
		JRST OXERR5]
	SETZ 3,
	IDPB 3,1
	MOVEI U3,UERBUF
OXERR5:	POPAE P,[3,2,1]
	PJRST OXZA

UERBFL==140.	; Max # chars in err msg
.VECTOR UERBUF(<UERBFL+4>/5)
] ;END IFN TNX

];end IFN $$OERR

SUBTTL Host name/number output


; NOTE: this code now assumes addresses are in HOSTS3 format!

; Item HN(aval) - Output host num in octal (single #)
; Item HND(aval) - Output host num in decimal (Internet fmt)

OXHN:	CALRET OXN8		; Simply output in octal

OXHND:	PUSH P,U3
IF1,	BLOCK 3
IF2 [	IFDEF NETWRK"CVH3NA, EXCH A,(P) ? CALL NETWRK"CVH3NA ? EXCH A,(P)
	.ELSE JRST .+3 ? JRST 4,. ? JRST 4,.
]
	TLNE U3,(17_32.)	; Internet address?
	 JRST [	LDB U3,[.BP <17_32.>, (P)]	; No, so exhibit high 4 bits.
		CALL OXN8	; Note octal!
		STDOUT(":)
		JRST .+1]
REPEAT 4,[
	IFN .RPCNT, STDOUT(".)
	LDB U3,[.BP <377_<8.*<3-.RPCNT>>>, (P)]
	CALL OXN10
]
	POP P,U3
	RET

IFN $$OHST,[

; Item HST(aval) - Output host name for given address (else number)

	LSQBR==:133		; "[" character
	RSQBR==:135		; "]" character

OXHST:
	; Special hack for COMSAT only... host number 0 means self.
IFN OS%ITS,IFE .FNAM1-<SIXBIT /COMSAT/>, CAIN U3, ? MOVE U3,OWNHST
	CALL OXHOST		; Output host name if possible
	 SKIPA			; Not possible
	  RET			; Won
	STDOUT(LSQBR)		; Do it as "[a.b.c.d]" format
	CALL OXHND		; since this is supposed to be a hostname.
	STDOUT(RSQBR)
	RET

; Item HOST(aval,{altitm}) - Output host name and skip, else no skip
;	so that alternate item is output instead.

OXHOST:
IFN OS%ITS,[
	PUSHAE P,[A,B,D]	;clobbered by HSTSRC routine 
	MOVE B,U3
	;; Make A point to ASCIZ name.

IFE $$DQ,{			; Not doing DQ: device hackery

IF2, IFNDEF NETWRK"HSTSRC,.FATAL Missing NETWRK but $$OHST is on!

	CALL NETWRK"HSTSRC
	 JRST OXHST4		; Lookup failed, take nonskip return.
}
.ELSE {				; Are doing DQ: hacking

IF2, IFNDEF RESOLV"HSTSRC,.FATAL Missing RESOLV but $$OHST and $$DQ are on!

	MOVE A,[440700,,HSTBUF]	;A has dest, B has host address.
	CALL RESOLV"HSTSRC
	 JRST OXHST4
	MOVE A,[440700,,HSTBUF]
}				; Done with DQ: hacking

	MOVEI U3,(A)
	CALL OXZA
	AOS -3(P)		; Won, so skip on return.
OXHST4:	POPAE P,[D,B,A]
	RET

.VECTOR HSTBUF(24.)		;Buffer to hold host name string from RESOLV.

] ;IFN ITS



IFN OS%TNX,[
UHSTBL==20.	; Allow hostname up to 99. chars long
	PUSHAE P,[1,2,3,4]
	MOVEI 1,.GTHNS		; Number to Name
	HRROI 2,1(P)		; Dest string ptr
	ADD P,[UHSTBL,,UHSTBL]	; Make room on PDL
	MOVE 3,U3
	GTHST
	 JRST OXHST6		; Lost, take nonskip return.
	MOVEI U3,-<UHSTBL-1>(P)
	CALL OXZA
	AOS -<4+UHSTBL>(P)		; Won, take skip return.
OXHST6:	SUB P,[UHSTBL,,UHSTBL]
	POPAE P,[4,3,2,1]
	RET

] ;IFN TNX
] ;IFN $$OHST





SUBTTL Time Output

IFN $$OTIM,[
; Requires that DATIME package be .INSRT'd someplace;
; The external defs needed from it include:
; (ITS)	TIMADY	- rtn to cvt sys-int timeword to abs (used for finding DOW)
; (ITS)	TIMGET	- rtn to get current sys-int time, with DST bit set.
; (ITS) TMONTB  - table of month names

	; Sub-types for "TIM" output item.  Up to 4 letters significant.
	; YOU try to think of better names for F1, F2, etc!!
DEFT HMS,OXTMTS		; HMS	- Time as "hh:mm:ss". (old WC)
DEFT MDY,OXTMD		; MDY	- Date as "mm/dd/yy"
DEFT YMD,OXTYMD		; YMD	- Date as "yymmdd"
DEFT MDYT,OXTMDT	; MDYT	- Datime as "mm/dd/yy hh:mm:ss" (old WA)
DEFT TNX,OXTTNX		; TNX	- Datime as "dd-Mon-yy hh:mm:ss" (TNX default)
DEFT MONTH,OXTLMN	; MONTH	- Month as "Month"
DEFT MON,OXTMON		; MON	- Month as "Mon"
DEFT MONU,OXTMN		; MONU	- Month as "MON"
DEFT DOW,OXTLDW		; DOW	- Day of week as "Fooday"
DEFT DOW3,OXTDW		; DOW3	- Day of week as "Foo"
DEFT F1,OXTME		; F1	- Datime as "dd MON yy hhmm ZON" (old WB)
DEFT F2,OXTMX		; F2	- Datime as "dd Month yyyy hh:mm ZON" (old WD)
DEFT F3,OXTMF3		; F3	- Datime as "dd MON yy hhmm-ZON"
DEFT RFC1,OXTRF1	; RFC1  - Datime as RFC822 "dd Mon yy hh:mm:ss ZON"
DEFT RFC2,OXTRF2	; RFC2	- Datime as RFC822 (RFC1) but with short DOW.


;   OUT invocations
;		with TIM() use the sequence
;			(arg in U3)
;			MOVEI U1,OXTnam
;			CALL OXTXS
;		with TIMA() use sequence like TIM() but CALL OXTXA.
;		with TIMB() use the sequence
;			(arg in UTMAC)
;			CALL OXTnam

IFNDEF $LTIMB,[
	; Define time-block here if not already def'd elsewhere
	TM.YR==:0
	TM.MON==:1
	TM.DAY==:2
	TM.HR==:3
	TM.MIN==:4
	TM.SEC==:5
	TM.ZON==:6	; <DST flag>,,<timezone value>
	TM.DOW==:7	; 0 = Monday, 6 = Sunday
$LTIMB==:10
]

IFN U2-OC, UTMAC==:U2	; Normal case
.ELSE	UTMAC==:U4	; Screw case

; OXTXS - Execute time-routine using System-internal time.
;	OC/ <channel>
;	U1/ <time-rtn addr>
;	U3/ <system-internal timeword>

OXTXS:
IFE U2-OC, PUSH P,OC
	MOVEI U2,1(P)		; Get pointer to timeblock
	ADD P,[$LTIMB,,$LTIMB]	; Make room for timeblock
	CALL OXTCSB		; Insert values in timeblock
IFE U2-OC, MOVEI U4,(U2) ? MOVE OC,-$LTIMB(P)
	CALL (U1)		; Process stuff
IFN U2-OC, SUB P,[$LTIMB,,$LTIMB]
.ELSE	SUB P,[$LTIMB+1,,$LTIMB+1]
	RET

; OXTCSB - Convert System-internal timeword to timeblock.
;	U2/ <ptr to timeblock>
;	U3/ <system-internal timeword>
; Smashes U3, U4 only

OXTCSB:	
IFN OS%ITS,[
	LDB U4,[DATIME"TM$YR,,U3]
	ADDI U4,1900.
	MOVEM U4,TM.YR(U2)
	LDB U4,[DATIME"TM$MON,,U3]
	MOVEM U4,TM.MON(U2)
	LDB U4,[DATIME"TM$DAY,,U3]
	MOVEM U4,TM.DAY(U2)
	SKIPN U4,UTZLV		; Get local timezone
	 JRST [	CALL UTZGET	; Get if not initialized
		JRST .-1]	; Repeat after init.
	TRNE U3,1		; DST bit set?
	 TLOA U4,-1		; Yes, set LH to -1
	  TLZ U4,-1		; No, ensure LH clear
	MOVEM U4,TM.ZON(U2)
	MOVEI U3,(U3)
	LSH U3,-1
	IDIVI U3,60.*60.
	MOVEM U3,TM.HR(U2)
	MOVEI U3,(U4)
	IDIVI U3,60.
	MOVEM U3,TM.MIN(U2)
	MOVEM U4,TM.SEC(U2)
	SETOM TM.DOW(U2)	; Punt DOW value for now, rarely use it.
	RET
]
IFN OS%TNX,[
	PUSHAE P,[1,2,3,4]
	MOVE 2,U3
	SETZ 4,
	ODCNV
	 ERJMP [SETZB 2,3	; 20X only (10X generates .ICILI)
		SETZ 4,
		JRST .+1]
	HLRZM 2,TM.YR(U2)	; Store year #
	ADDI 2,1
	HRRZM 2,TM.MON(U2)	; Store month # (1 based)
	HLRZM 3,TM.DAY(U2)
	AOS TM.DAY(U2)		; Day # (1 based)
	HRRZM 3,TM.DOW(U2)	; Store day-of-week (0=Monday)
	MOVEI 1,(4)
	IDIVI 1,60.*60.
	IDIVI 2,60.
	MOVEM 1,TM.HR(U2)
	MOVEM 2,TM.MIN(U2)
	MOVEM 3,TM.SEC(U2)
	LDB 1,[.BP <IC%TMZ>,4]	; Get timezone
	TLNE 4,(IC%ADS)		; If DST was applied
	 TLO 1,-1		; then put -1 in LH
	MOVEM 1,TM.ZON(U2)
	POPAE P,[4,3,2,1]
	RET
]

; All of the following output routines assume that UTMAC points
; to a timeblock structure.

	; Date as MM/DD/YY
OXTMD:	MOVE U3,TM.MON(UTMAC)
	CALL OXTD2
	STDOUT("/)
	MOVE U3,TM.DAY(UTMAC)
	CALL OXTD2
	STDOUT("/)
OXTYR2:	MOVE U3,TM.YR(UTMAC)	; Year as 2-digit number.
	SUBI U3,1900.
	CALRET OXTD2
	
	; Date as YYMMDD
OXTYMD:	MOVE U3,TM.YR(UTMAC)	; Year as 2-digit number.
	SUBI U3,1900.
	CALL OXTD2
	MOVE U3,TM.MON(UTMAC)	; Month.
	CALL OXTD2
	MOVE U3,TM.DAY(UTMAC)	; Day.
	CALRET OXTD2

	; Date/time as DD-Mon-YY HH:MM:SS (TNX default format)
OXTTNX:	CALL OXTDAY
	STDOUT("-)
	CALL OXTMON		; Output month
	STDOUT("-)
	CALL OXTYR2
	STDOUT(40)
	CALRET OXTMTS		; Then do time.

	; Date/time as MM/DD/YY HH:MM:SS
OXTMDT:	CALL OXTMD		; Date
	STDOUT(40)
				; Fall through for time

	; Time as HH:MM:SS
OXTMTS:	MOVE U3,TM.HR(UTMAC)
	CALL OXTD2		; Output hours
	STDOUT(":)
	MOVE U3,TM.MIN(UTMAC)
	CALL OXTD2		; Output minutes
	STDOUT(":)
	MOVE U3,TM.SEC(UTMAC)
	CALRET OXTD2		; Output secs and done.


	; Date/time as " 7 AUG 1976 0831 EDT" (constant length)

OXTME:	CALL OXTMFX
	CALRET OXTMZB		; Print time-zone & return

OXTMF3:	CALL OXTMFX
	CALRET OXTMZD

OXTMFX:	CALL OXTDAY		; Output day, 2 columns
	STDOUT(40)
	CALL OXTMN		; Output 3-letter month
	STDOUT(40)		; Space out
	CALL OXTYR		; Output 4-digit year
	STDOUT(40)
	MOVE U3,TM.HR(UTMAC)
	CALL OXTD2		; Output hrs
	MOVE U3,TM.MIN(UTMAC)
	CALRET OXTD2		; Output mins

;;; RFC822 standard mail timestamps: RFC1 and RFC2.

OXTRF2:	CALL OXTDW		; Output short day of week.
	STDOUT(54)		
	STDOUT(40)		; Space out.
OXTRF1:	CALL OXTDAY
	STDOUT(40)
	CALL OXTMON		; Output 3-letter month
	STDOUT(40)		; Space out
	MOVE U3,TM.YR(UTMAC)	; Year as 2-digit number.
	SUBI U3,1900.
	CALL OXTD2
	STDOUT(40)
	MOVE U3,TM.HR(UTMAC)
	CALL OXTD2		; Output hrs
	STDOUT(":)
	MOVE U3,TM.MIN(UTMAC)
	CALL OXTD2		; Output mins
	STDOUT(":)
	MOVE U3,TM.SEC(UTMAC)
	CALL OXTD2		; Output secs
	CALRET OXTMZB		; Go do timezone

	; Date/time as "7 August 1976 08:31 EDT"

OXTMX:	CALL OXTDAV		; Output day, one or two columns
	STDOUT(40)
	CALL OXTLMN		; Output "long" month name
	STDOUT(40)
	CALL OXTYR		; Output 4-digit year
	STDOUT(40)
	MOVE U3,TM.HR(UTMAC)
	CALL OXTD2		; Output hrs
	STDOUT(":)
	MOVE U3,TM.MIN(UTMAC)
	CALL OXTD2		; Output mins
				; Fall through to output timezone & return.

	; Output local timezone (time-word val indicates whether DST)
OXTMZD:	STDOUT("-)		; Entry pt for prefix dash
	JRST OXTMZ
OXTMZB:	STDOUT(40)		; Entry pt for prefix blank
OXTMZ:	SKIPN U3,UTZLSS		; Get pointer to local timezone
	 JRST [	CALL UTZGET	; Not there yet?  Set it up.
		JRST .-1]
	SKIPGE TM.ZON(UTMAC)	; Daylight savings on?
	 MOVE U3,UTZLDS		; Yes, use DST version instead.
	CALRET OXZA		; Output ASCIZ.

	; Day of the month in two columns.
OXTDAY:	MOVE U3,TM.DAY(UTMAC)	; Get day
	CAIL U3,10.		; If number will have two digits,
	 CALRET OXTD2		; dispatch to routine for that.
	STDOUT(40)		; Else output a space
	STDOUT("0(U3))		; and the digit.
	RET

	; Day of the month in one or two columns (Variable format).
OXTDAV:	MOVE U3,TM.DAY(UTMAC)	; Get day
	CAIL U3,10.		; If two digits,
	 CALRET OXTD2		; dispatch to better routine.
	STDOUT("0(U3))
	RET

	; For both versions of month output, use ASCIZ
	; rather than ASCNT since former guarantees U2
	; will be preserved.
OXTLMN:	MOVE U3,TM.MON(UTMAC)	; Get month
	MOVE U3,UTBMON(U3)	; Get ascnt ptr to string for it
	CALRET OXZA		; Output ASCIZ string

OXTMN:	MOVE U3,TM.MON(UTMAC)	; Get month
	MOVE U3,UTBMO3(U3)	; Get ascnt ptr to string for it
	CALRET OXZA		; Output asciz (only 3 chars)

	; Output month as "Mon"
OXTMON:	MOVE U3,TM.MON(UTMAC)	; Get month
	MOVE U3,UTBMON(U3)	; Get ascnt ptr to long-form name
	HRLI U3,440700		; Set up BP then output 1st 3 chars.
	REPEAT 3,ILDB U1,U3 ? STDOUT
	RET

; Day-Of-Week output

OXTDW:	SKIPA U1,[UTBDO3(U3)]	; Use short-form table.
OXTLDW:	 MOVE U1,[UTBDOW(U3)]	; Use long-form table.
	SKIPGE U3,TM.DOW(UTMAC)	; All's well if have valid DOW value
	 CALL UTMGDW		; Sigh, must get it (into U3)
	MOVE U3,@U1		; Get appropriate string, table idx'd by U3
	CALRET OXZA		; Output as asciz to avoid U4 clobberage.

OXTYR:	MOVE U3,TM.YR(UTMAC)	; Get year
				; Fall through to output 4 digits.

	; Internal routines to output 4 or 2 digits of num in U3.
OXTD4:
IFE UTMAC-U4, PUSH P,U4
	IDIVI U3,100.	; Output 4 digits
	PUSH P,U4
	CALL OXTD2
	POP P,U3	; Fall thru to OXTD2 again
IFE UTMAC-U4, CAIA

OXTD2:
IFE UTMAC-U4, PUSH P,U4
	IDIVI U3,10.	; Output 2 digits
	STDOUT("0(U3))
	STDOUT("0(U4))
IFE UTMAC-U4, POP P,U4
	RET


	; Get system internal time in U3
UTMGTS:
IFN OS%ITS,[
	PUSH P,A
	CALL DATIME"TIMGET
	CAMN A,[-1]
	 JSR AUTPSY
	MOVE U3,A
	POP P,A
]
IFN OS%TNX,[
	PUSH P,1
	GTAD
	MOVE U3,1
	POP P,1
]
	RET

; UTMGDW - Given ptr to time-block in UTMAC, return
;	DOW value in U3 (0=Monday).  Clobbers U4 (unless == UTMAC)

UTMGDW:
IFN OS%TNX, MOVEI U3,7	; TNX shouldn't ever have to ask
IFN OS%ITS,[
	CALL UTCBDA		; Get absolute # days
	IFE UTMAC-U4,PUSH P,U4
	IDIVI U3,7
	MOVEI U3,(U4)
	IFE UTMAC-U4,POP P,U4
] ;OS%ITS
	RET

; UTCBDA - Time Convert, Block to Day Absolute
;	UTMAC/ ptr to time-block
; Returns
;	U3/ absolute # days since Jan 1, 1900
; Clobbers U4 (unless == UTMAC)
IFN OS%ITS,[
UTCBDA:	IFN UTMAC-U2,PUSH P,U2 ? MOVE U2,UTMAC	; Ensure ptr in U2
	PUSH P,U1
	MOVE U3,TM.DAY(U2)	; Get day #
	MOVE U1,TM.MON(U2)	; Get month #
	ADD U3,DATIME"TMONTB(U1); Add days thus far in year
	MOVE U4,TM.YR(U2)	; Get year
	SUBI U4,1900.		; Make simplifying assumption
	TRNE U4,3		; Specified year a leap year?
	 JRST .+3		; No, can skip month check
	CAIL U1,3		; Leap year -- is it after Feb?
	 ADDI U3,1		; Yes, add extra day
	MOVEI U1,-1(U4)		; Adjust, and
	LSH U1,-2		; Get # of leapyears since 1900, excl this yr
	IMULI U4,365.		; # years times 365
	ADDI U4,(U1)		; plus # prior leapyears (extra days)
	ADDI U3,-1(U4)		; plus days so far this yr (-1 because day #
	POP P,U1		; was 1-based)
	IFE UTMAC-U4, MOVE UTMAC,U2 ? POP P,U2
	RET
] ;IFN OS%ITS

; Time-zone hacks

	; For all three params below, LH=-1 when set (thus 0 val means
	; var isn't initialized).  Actual var is in RH.
.SCALAR UTZLV	; Local timezone value
.SCALAR UTZLSS	; Local STD timezone string (addr of ASCIZ)
.SCALAR UTZLDS	; Local DST timezone string (addr of ASCIZ)

; UTZGET - Set up the above three parameters.

UTZGET:	PUSH P,U1

IFN OS%ITS,MOVEI U1,5		; All ITS systems are in EST
IFN OS%TNX,[
	PUSHAE P,[2,3,4]
	SETO 2,
	SETZ 4,
	ODCNV
	LDB U1,[.BP IC%TMZ, 4]
	POPAE P,[4,3,2]
]
	HRROM U1,UTZLV		; Store local time-zone value
	MOVE U1,UTBZON(U1)	; Get ASCIZ strings for zone
	HLROM U1,UTZLSS		; Store STD string
	HRROM U1,UTZLDS		; Store DST string
	POP P,U1
	RET

DEFINE TZONE STD,DST
	[ASCIZ /STD/],,[ASCIZ /DST/]
TERMIN

UTBZON:	TZONE GMT,GMT	; 0 How to ask for British Summer Time??
	TZONE		; 1
	TZONE		; 2
	TZONE		; 3 (NST = Newfoundland is -0330)
	TZONE AST,ADT	; 4 Atlantic
	TZONE EST,EDT	; 5 Eastern
	TZONE CST,CDT	; 6 Central
	TZONE MST,MDT	; 7 Mountain
	TZONE PST,PDT	; 8 Pacific
	TZONE YST,YDT	; 9 Yukon
	TZONE HST,HDT	; 10 Alaska-Hawaii
	TZONE BST,BDT	; 11 Bering
	REPEAT 24.-11.,TZONE	; 12-24 unspecified

; Various tables

	; Table for printing month, indexed by 1-12.
UTBMON:	0
	IRP M,,[January,February,March,April,May,June,July,August,September,October,November,December]
	.LENGTH "M",,[ASCIZ "M"]
	TERMIN

	; Table for printing month, indexed by 1-12.
UTBMO3:	0
	IRP M,,[JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC]
	3,,[ASCIZ /M/]		; All strings length 3.
	TERMIN


	; Tables for printing day-of-week, indexed by 0-6.
	; Note TNX internal convention has 0 = Monday.
	; Note also that Jan 1, 1900 (abs day 0) = Monday.
	; Fooday included so masking low 3 bits of DOW value will always win.
UTBDOW:	IRP D,,[Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday,Fooday]
	.LENGTH /D/,,[ASCIZ /D/]
	TERMIN

UTBDO3:	IRP D,,[Mon,Tue,Wed,Thu,Fri,Sat,Sun,Foo]
	3,,[ASCIZ /D/]		; All strings of length 3.
	TERMIN

] ;IFN $$OTIM

SUBTTL .END OUT - Additional comments

.QMTCH==QMTCH	; Now can restore user's parsing mode.
.END		; End the OUT symbols block.
.INEOF		; Stop parsing here.

COMMENT |

Table of OUT channel variables:

UCHTYP	UCOPT		USCOPT	UCHCNT	UCNTS	UCHSTB	UCHJFN	UCHLIM

UC$UAR	idpb u1,$arwpt	uol.ar	$archl	-	<arpt>	-	-
UC$XCT	<arg>		uo*.x	<ucnts>	count	-	-	<orig lim>
UC$BPT	idpb u1,uchstb	uo*.bp	<ucnts>	count	<BParg>	-	<orig lim>
UC$IOT	.iot u1 / bout	uo*.io	<ucnts>	count	-	<jfn>	<orig lim>
UC$BUF	idpb u1,uchstb	uol.bf	<ucnts>	count	<BP>	<jfn>	<buff>,,<size>
UC$TRN	xct ucopt+x	uos.tr	<uchcnt+x><ch#>	<copy>	-	-
UC$NUL	nop		uos.nl	<ucnts>	count	-	-	<max lim>

Note: UO*.X corresponds to either UOL.X or UOS.X depending on whether the
channel was opened with a count limit (UOL) or not (UOS).

UCOPT		; XCT'd unit-mode instruction (always)
USCOPT		; Addr of string-mode routine (always)
UCHCNT		; Addr of char countdown (always)
UCNTS		; Char countdown (except UAR, TRN)
UCHLIM		; Original count (except UAR, TRN, BUF)
UCHTYP		; <flags>,,<chan type>
UCHJFN		; JFN for channel if any (only TNX IOT, BUF)
UCHSTB		; Byte ptr (UC$BPT) or ARPT (UC$UAR)

List of type-dependent OUT functions:

OPEN		UOPENT(typ)
  Unit Output	UCOPT(ch)
  String Output	USCOPT(ch)
  Overflow	OVFTAB(typ)
CLS		OXCLST(typ)
PTV		UPTTAB(typ)
FRC		OXFRCT(typ)	Doesn't exist but should
RST		OXRSTT(typ)	"
PUSH,POP	OXPOPT(typ)	"

|