; OUT - GENERAL PURPOSE OUTPUT ROUTINE
; LAST EDIT:	9-NOV-81
;-
;
; DEFINE SYMBOL BLURB FOR DESCRIPTIONS
;BLURB=0
;
	.IDENT	/V002/
	.NLIST
	.LIST	TTM
	.NLIST SEQ,LOC,BIN,BEX,CND
	.TITLE	OUT
	.LIST
.IIF	NDF	BLURB	.NLIST
; GENERAL OUTPUT ROUTINE FOR UCH & ORSAY APPLICATIONS
;
; A TODD-POKROPEK  MARCH 76
; LINE CONCATENATION           DLP 6/10/77
; RT11 ORSAY MODS		DLP 20-JAN-78
; SYSTEM COMPATIBILITY MODS	DLP 15-NOV-78
;+
;
; OUTS PROVIDES A SET OF FORTRAN OR MACRO CALLABLE ROUTINES FOR
; OUTPUT OF TEXT AND NUMBERS TO TERMINALS AND PRINTERS.
;
; OUTS ENABLES OUTPUT REQUESTS TO BE EXPRESSED IN A SIMPLE FORM
; WHICH AVOIDS SEPARATE FORMAT STATEMENTS WITHOUT RESTRICTING
; GENERALITY.
;
; OUTS PROVIDES SUPPORT FOR DEVICES WHICH REQUIRE SPECIAL PARAMETERS
; SUCH AS COLOUR TV AND CURSOR ADDRESSABLE TERMINALS. IT CAN BE
; READILY EXTENDED TO ACCOMODATE ANY SPECIAL DEVICE IN A COMPATIBLE
; MANNER.
;
;
; THE BASIC CALL IS:-
;
;	CALL OUTS('TEXT'[,V1,V2...])
;
; WHERE TEXT IS ANY STRING WHICH MAY POSSIBLY CONTAIN THE THE 
; SPECIAL SYMBOLS # AND & TO INDICATE THE POSITIONING AND FORMAT
; OF SUBSTITUTED VALUES AND TEXT.
;  # SIGNIFIES A DECIMAL DIGIT
;  & AN ASCII CHARACTER
;  . INDICATES THE POSITION OF A DECIMAL POINT WITHIN A REAL
;
;  THESE SPECIAL CHARACTERS ARE REPLACED BY VALUES TAKEN FROM THE
;  ARGUMENT LIST FOLLOWING THE TEXT.
;
; THUS THE FOLLOWING CALL:
;
;	I=3
;	B=55.6
;	CALL OUTS('FIRST IS ## SECOND IS ####.###',I,B)
; PRODUCES THE OUTPUT:
;	FIRST IS  3 SECOND IS   55.600
; ON THE TERMINAL.
;
; CHARACTER STRINGS MAY ALSO BE INCLUDED BY:
;
;	DATA STR/'STRING'/
;	....
;	I=66
;	CALL OUTS('&&&&&&  ##',STR,I)
;
; WHEN FLOATING POINT VALUES ARE OUTPUT THE DECIMAL POINT MUST
; BE PRECEDED BY AT LEAST ONE #.
;
;
;
;
; A SIMILAR CALL IS OUT
;
; OUT HAS EXACTLY THE SAME SYNTAX AS ABOVE BUT DOES NOT OUTPUT
; ANY TEXT IMMEDIATLY. REPEATED CALLS TO OUT PRODUCE TEXT
; CONCATTENATED ON A LINE WHICH WILL ONLY BE OUTPUT WHEN OUTS
; IS CALLED. THUS:
;
;	CALL OUT('I=###',I)
;	CALL OUT(' J=###',J)
;	CALL OUTS(' V=###.###',V)
; MIGHT PRINT:
;	I= 20 J=  3 V=125.145
; WHICH IS ONLY OUTPUT WHEN OUTS IS CALLED.
; THE MAXIMUM LENGTH OF LINE WHICH MAY BE COMPOSED IN THIS WAY IS
; CURRENTLY 80 CHARACTERS.
MAXSTR=80.
;
;
; OUTS MAY BE PASSED ADDITIONAL PARAMETERS AFTER THE VALUE LIST.
; THESE MAY BE USED FOR OUTPUT DEVICE SELECTION AND FOR SPECIAL
; FORMATTING COMMANDS SUCH AS SELECTING A LINE ON A VDU SCREEN.
;
; THESE PARAMETERS WILL BE SOMEWHAT IMPLEMENTATION DEPENDANT AS
; DIFFERENT HARDWARE CONFIGURATIONS WILL HAVE DIFFERENT REQUIREMENTS
; HOWEVER BY CONVENTION THE FIRST WILL BE CALLED 'LINE' AND WILL
; DESCRIBE THE OUTPUT FORMAT AND THE SECOND WILL BE 'IDEV' AND
; WILL DESCRIBE THE OUTPUT DEVICE.
;
; THE GENERAL CALL IS THUS:
;
;	CALL OUTS('TEXT',V1....,LINE,IDEV)
;
; ANY ARGUMENTS MAY BE OMITTED EXCEPT THAT IF A FORMAT CHARACTER 
; EXISTS WITHIN 'TEXT' THE CORRESPONDING VALUE MUST ALSO BE PRESENT.
; IF TEXT IS OMITTED A LINE IS OUTPUT EITHER NULL OR CONTAINING ANY
; DATA PREVIOUSLY PLACED BY OUT.
;
; IF LINE IS OMITTED THE CURRENT DEFAULT LINE AS STORED WITHIN OUTS
; IS USED.
;
; IF IDEV IS OMITTED THE CURRENT DEFAULT DEVICE IS USED. THIS WILL
; GENERALY BE THE TERMINAL ON WHICH THE CALLING PROGRAM IS RUNNING.
;
;
; INTERPRETATION OF LINE PARAMETER:-
;	OUTS CAN SUPPORT LINE ADDRESSABLE DEVICES E.G. RAMTEK,VT55
;	THE LINE NUMBER ON THE DEVICE CAN BE SELECTED BY SPECIFYING
;	10.*N AS THE LINE PARAMETER.
;	THE FOLLOWING SPECIAL VALUES ARE RECOGNISED:
;		0 - FORM FEED BEFORE WRITE TO LINE 0
;		1   WRITE TO LINE 0 NO FORM FEED
;		2   PROMPT MODE, MESSAGE IS OUTPUT ON
;		    DEFAULT PROMPT LINE.
;		    THE REMAINING CODES 3-9 ACT AS 1
;		-1  WRITE TO NEXT LINE OF DEVICE
;		-2  PLACE TEXT IN BUFFER BUT DO NOT OUTPUT
;		    AS FOR OUT.
;		-3  (UCH ONLY)
;		    ENABLES VD TRACK SELECTION (CC=) E.G.
;			CALL OUTS('##C.......',ITRACK,....-3,'VD0')
;			TO WRITE TO ITRACK LINE 'C'.
;		    SEE VD DOCUMENTATION FOR FULL DESCRIPTION.
;		     THIS IS GENERALY THE DEFAULT MODE FOR TERMINALS
;	THE DEFAULT VALUE FOR LINE IS -1
;
;
; INTERPRETATION OF IDEV :-
;	VALUES <65. ARE INTERPRETED AS AN INDEX IN
;	A LOCAL DEVICE NAME TABLE 'DEVTAB' WHICH YIELDS A
;	NAME AND UNIT FOR THE SPECIFIED DEVICE.
;	IF >=65. DEVICE IS INTERPRETED AS A DEVICE NAME STRING
;	E.G. 'TT3'
;
;	LOCALY ASSIGNED NUMBERS ARE AS FOLLOWS:
;	ORSAY:
;	0	TERMINAL ON WHICH PROGRAM IS RUNNING (TI:)
;	1	LINE PRINTER (LP:)
;	3,4,5	TT0:1:2
;	7	BREAKTHROUGH WRITE TO TI:
;	-1	BLACK HOLE NL:
;
; UCH VALUES: IN OCTAL
;	-3	PP:
;	-2	LP:
;	-1	CL:
;	0-15	VD0:15
;	16	TT0
;	17	TI:
;
;
;
; THE DEFAULT VALUES OF THESE PARAMETERS MAY BE MODIFIED WITH OUTSAV.
;
;	CALL OUTSAV(LINE,IDEV,LUN,MAXLIN)
;		LINE,IDEV	SET DEFAULTS FOR ABOVE
;		LUN 		IS LUN FOR OUTPUT (RSX ONLY)
;		MAXLIN  NUMBER OF LINES IN DEVICE (INIT 250.)
;
;	ANY OF THESE ARGUMENTS MAY BE OMITTED TO LEAVE THE CURRENT
;	VALUE UNCHANGED.
;
;
; 
; AN ADDITIONAL CALL IS:
;	CALL OUTTAB(ICOL)
; OR	ICOL=OUTTAB()
;
; WHICH WRITE AND READ RESPECTIVLY THE CURRENT CHARACTER POSITION.
; AFTER A CALL OF THE FORMER TYPE, THE NEXT TEXT WRITTEN WITH OUTS
; OR WITH OUT WILL START AT THE SPECIFIED POSITION IN THE LINE.
; NOTE THAT IF THE POINTER IS MOVED BACKWARDS THE INTERNAL BUFFER
; IS OVERWRITTEN RATHER THAN OVERPRINTING ON THE TERMINAL.
;
; THE RESULT OF THE FUNCTION OUTTAB IS THE CURRENT CHARACTER POSITION.
; IN THIS CASE OUTTAB MUST BE DELARED INTEGER.
; 
;
;
; ANOTHER FUNCTION IS OUTCLR
;
;	CALL OUTCLR
;
; ERASES ANY TEXT CURRENTLY PLACED IN THE BUFFER AND NOT OUTPUT.
; IT MAY BE USEFUL TO CLEAR THE BUFFER AFTER AN ERROR.
;
;
;
;
; THE LUN USED FOR OUTPUT IN RSX IS 5 BY DEFAULT BUT MAY BE
; CHANGED BY A CALL TO OUTSAV.
DEFLUN=5
; THIS LUN IS ASSIGNED TO THE SELECTED DEVICE BEFORE EACH
; OUTPUT CALL. THIS MAY BE UNDESIRABLE IN SOME CIRCUMSTANCES
; FOR EXAMPLE IF THE DEVICE IS ATTACHED. IN THIS CASE:
;	CALL OUTLUN(L)
; TO SPECIFY A NEW LUN FOR OUTPUT WHICH WILL NOT BE
; ASSIGNED AUTOMATICALY BY OUTS.
;	CALL OUTLUN(0)
; TO RETURN TO DEFAULT OR VALUE CURRENTLY SET BY OUTSAV.
;
;
;
;-
; A ROUTINE USED INTERNALY IS ALSO AVAILABLE.
; 	CALL OUTM(STRING,LENGTH,[DEV],[LINE])
;	WHICH DOES NO PARAMETER SUBSTITUTION
;-
	.NLIST
	.LIST SEQ,LOC,BIN
	.LIST
.IIF	NDF	BLURB	.LIST
;
;
; CONDITIONAL ASSEMBLY PARAMETERS
; IF FOR RSX11M/D	DEFINE 'RSX'
; IF FOR RT11		DEFINE 'RT11'
RSX=0
;
; NOW SPECIFY THE SITE ORSAY/UCH
; OTHER SITES WILL HAVE TO EDIT A BIT
;
ORSAY=0
;
.GLOBL	OUTM,OUTS,OUTTAB,OUTSAV
.IF	DF	RT11
	.CSECT	OUT		;*RT11
	.MCALL	..V2..,.REGDEF	;*RT11
	.MCALL	.PRINT,.TTYOUT	;*RT11
	..V2..			;*RT11
	.REGDEF			;*RT11
.IFF
	.PSECT	OUT		;*RSX
	.MCALL	DIR$,QIOW$	;*RSX
	.MCALL	ALUN$S,GLUN$S	;*RSX
.ENDC
;
;
; DEFINE FORTRAN PARAMETER BLOCK OFFSETS
P1=2
P2=4
P3=6
P4=10
P5=12
;
; 
CR=15
LF=12
ETX=3
;
OUTSAV:	MOVB	(R5),ICNT
	CMP	P1(R5),#-1
	BEQ	1$
	MOV	@P1(R5),ILINE
	MOV	ILINE,ILSAV
1$:	DECB	ICNT
	BLE	10$
	CMP	P2(R5),#-1
	BEQ	2$
	MOV	P2(R5),R0
	MOV	(R0),ICSAV
	MOV	2(R0),ICSAV+2
2$:	DECB	ICNT
	BLE	10$
	CMP	P3(R5),#-1
	BEQ	3$
	MOV	@P3(R5),DFLUN
3$:	DECB	ICNT
	BLE	10$
	MOV	@P4(R5),MAXLIN
10$:	RTS	PC
;
; OUTLUN - SPECIFY USER ASSIGNED LUN
OUTLUN::MOV	@P1(R5),SPLUN
	RTS	PC
;
;
OUTM:	MOV	R0,-(SP)	
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	CMPB	(R5),#3
	BGE	1$
	MOV	#ICSAV,R1
	BR	2$
1$:	MOV	P3(R5),R1	;ADDRESS OF DEVICE ARG
2$:	CMPB	(R1),#'A	;DEVICE NAME OR NUMBER ?
	BGE	3$		;SKIP IF NAME
	MOV	(R1),R1		;GET NUMBER
	MOVB	UNITAB(R1),R2	;GET UNIT
	ASL	R1		;INDEX DEVICE TABLE
	MOV	DEVTAB(R1),R1	;GET DEVICE NAME
	BR	4$
;
3$:	CLR	R2		;DECODE ASCII UNIT #
	MOVB	2(R1),R3
	SUB	#'0,R3
	BLT	7$
	CMP	R3,#7
	BGT	7$
	MOV	R3,R2		;UNIT HIGH ORDER
	MOVB	3(R1),R3
	SUB	#'0,R3
	BLT	7$
	CMP	R3,#7
	BGT	7$
	ASH	#3,R2
	BISB	R3,R2
7$:	MOV	(R1),R1		;AND GET DEVICE NAME
4$:	CMPB	(R5),#4		;LINE NUMBER SPECIFIED ?
	BGE	5$
	MOV	ILSAV,R3
	BR	6$
5$:	MOV	@P4(R5),R3	;GET LINE
6$:
;
; NOW WE HAVE THE DEVICE NAME & UNIT IN R1,R2 RESPECTIVLY
; AND THE LINE # PARAMETER IN R3
; P1(R5) & P2(R5) CONTAIN BUFFER ADDRESS AND LENGTH.
;
; AT THIS POINT WE CAN BRANCH OFF ANY SPECIAL DEVICES TO 
; ROUTINES NAMED OUT$XX WHERE XX IS THE SPECIFIED DEVICE
; NAME.
;
DEV:	CMP	R1,#"NL		;NULL DEVICE
	BEQ	OUTMX		;IF SO JUST QUIT
.IF	DF	RSX
;*RSX* THE FOLLOWING DEVICES MUST BE ADDRESSED BY SOME FORM OF QIO
	MOV	#IO.WVB,BLK+Q.IOFN;INIT FUNCTION CODE
	CMP	R1,#"BT		;BREAKTHROUGH WRITE ?
	BNE	1$
	MOV	#"TI,R1
	CLR	R2
	MOV	#IO.WBT,BLK+Q.IOFN
1$:	MOV	SPLUN,LUNNO	;*RSX* USER ASSIGNED LUN ?
	BNE	DEV1		;*RSX* SKIP LUN ASSIGNMENT IF SO
	MOV	DFLUN,LUNNO	;*RSX* ELSE SET DEFAULT LUN
	ALUN$S	LUNNO,R1,R2	;*RSX* ASSIGN LUN TO DEVICE
	BCS	OUTMX		;*RSX* FAIL IF ERROR
	GLUN$S	LUNNO,#LUNDAT	;*RSX* AND READ BACK LUN DATA
	MOV	LUNDAT,R1	;*RSX* DEVICE MAY HAVE CHANGED
DEV1:	MOV	#BLK,R0		;*RSX* PICK UP DPB ADDRESS
	MOV	P1(R5),Q.IOPL(R0);*RSX* SAVE BUFFER ADDRESS
	MOV	@P2(R5),Q.IOPL+2(R0);*RSX* AND LENGTH
.ENDC
.IF	DF	UCH
	CMP	R1,#"VD		;*UCH* UCH VIDIO-DISK DRIVER
	BNE	1$		;*UCH* 
	JSR	PC,OUT$VD	;*UCH*
	BR	OUTMX		;*UCH*
.ENDC
1$:
.IF	DF	ORSAY
2$:	CMP	R1,#"LD		;*ORSAY* LED DISPLAY
	BNE	3$		;*ORSAY*
	JSR	PC,OUT$LD	;*ORSAY*
	BR	OUTMX		;*ORSAY*
.ENDC
3$:
; HERE WE'VE JUST A STOCK STANDARD TERMINAL
OUTTT:	
.IF	DF	RT11
	TST	R3		;*RT11* NEW PAGE ?
	BNE	1$		;*RT11* 
	.TTYOUT	#FF		;*RT11*
1$:	MOV	P1(R5),R0	;*RT11* GET BUFFER
	MOV	@P2(R5),R1	;*RT11* GET LENGTH
	ADD	R0,R1		;*RT11* END OF BUFFER
	MOVB	(R1),R2		;*RT11* SAVE VALUE
	CLRB	(R1)		;*RT11* FORCE ZERO BYTE
	CMP	R3,#2		;*RT11* PROMPT MODE ?
	BNE	2$
	MOVB	#200,(R1)	;*RT11* SET NO CR
2$:	.PRINT			;*RT11*
	MOVB	R2,(R1)		;*RT11* RESET LAST BYTE
.IFF
.IF	DF	UCH		;*RSX&UCH*
	CMP	R3,ILSAV	;*RSX&UCH* ASSUME PROMPT IF DEFAULTED
	BEQ	4$		;*RSX&UCH*
.ENDC
	TST	R3		;*RSX* FORM-FEED ?
	BNE	1$		;*RSX*
	MOV	#'1,R1		;*RSX*
	BR	3$		;*RSX*
1$:	CMP	R3,#2		;*RSX* PROMPT MODE
	BNE	5$		;*RSX*
4$:	MOV	#'$,R1
	BR	3$		;*RSX*
5$:	MOV	#' ,R1		;*RSX* JUST A NORMAL WRITE
3$:	MOV	R1,Q.IOPL+4(R0)	;*RSX* SET CC IN DPB
	MOV	LUNNO,Q.IOLU(R0);*RSX* SET LUN
	MOVB	LUNNO,Q.IOEF(R0);*RSX* USE AS EF
	DIR$	R0		;*RSX* ISSUE QIO AND WAIT
	BCS	3$		;*RSX* LOOP TO HELP FAULT LOCATION
.ENDC
OUTMX:	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RTS	PC
;
.IF	DF	UCH
; THE FOLLOWING IS AN EXAMPLE OF A SPECIAL DEVICE PROCESSOR
; THIS IS FOR THE UCH VIDIO DISK.
; ON ENTRY
;	R0	DPB SET UP WITH IO.WVB,LUN,E.F.,BUFFER ADDRESS, BUFFER LENGTH
;	R1	DEVICE NAME
;	R2	DEVICE UNIT
;	R3 LINE # PARAMETER
;
OUT$VD:	TST	R3		;*UCH* NEW PAGE ?
	BNE	1$		;*UCH* 
	MOV	#'1,R2		;*UCH* SET CC CODE
	BR	3$		;*UCH* 
1$:	CMP	R3,#-3		;*UCH* TRACK SELECT FUNCTION ?
	BNE	2$		;*UCH* 
	MOV	#'=,R2		;*UCH* 
	BR	3$		;*UCH* 
2$:	CLR	R2		;*UCH* JUST DEVIDE ARG BY 10.
	DIV	#10.,R2		;*UCH* 
	ADD	#'A,R2		;*UCH* 
3$:	MOV	R2,Q.IOPL+4(R0)	;*UCH* 
	DIR$	R0		;*UCH* 
	CLR	Q.IOPL+6(R0)	;*UCH* RESET TRACK NUMBER
	RTS	PC		;*UCH* 
;
.ENDC
;
.IF	DF	ORSAY
; INSERT NULL RETURNS FOR RAMTEK & LD ROUTINES
OUT$LD:				;*ORSAY*
	RTS	PC		;*ORSAY*
;
.ENDC
;
;
; THIS IS THE MAIN ENTRY POINT.
OUT::	MOV	#-2,ILINE
	BR	OUT1
;
;
OUTS::	CLR	ILINE
OUT1:	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	STFPS	-(SP)		;SAVE FPP STATUS
	SETF			;SET FPP MODETO SINGLE PRECISION
	SETI			;SINGLE LENGTH INTEGER
	MOV	R5,-(SP)
	CLR	ICNT
	MOVB	(R5),ICNT	;GET # ARGS
	MOV	R5,MSAV		;AND SAVE PARM LIST
	ADD	#4,MSAV		;SKIP COUNT AND STRING
	MOV	MCAL+2,R2	;PICK UP WORKSPACE
	CLR	R1		;COUNTER FOR ARG STRING LENGTH
	DEC	ICNT
	BMI	3$		;NOTHING THERE
	MOV	2(R5),R0	;GET STRING ADDRESS
	CMP	R0,#-1		;IS IT NULL
	BEQ	3$
;
1$:	TSTB	(R0)		;END OF STRING ?
	BEQ	3$		;BREAK IF SO
	CMP	R2,#MSBFE	;ANY ROOM IN BUFFER ?
	BHIS	2$		;NO- SKIP COPY
	MOVB	(R0),(R2)+	;COPY STRING TO BUFFER
2$:	INC	R0		;NEXT CHAR
	INC	R1		;AND BUMP COUNT
	BR	1$		;KEEP LOOPING
;
3$:	CLRB	(R2)		;POP A ZERO ON THE END
	MOV	R2,LENGTH	;RE-CALCULATE LENGTH
	SUB	#MSBF,LENGTH
;
	TST	ICNT		;IS THERE A STRING ARG ?
	BMI	4$
	MOV	2(R5),R0	;GET STRING POINTER
	CMP	R0,#-1		;IS IT NULL
	BNE	OTS43
4$:	JMP	OTS5		;GO START OUTPUT
;
OTS43:	TSTB	(R0)		;END OF STRING ?
	BNE	1$
	JMP	OTS5		;IF SO GO OUTPUT
1$:	CMPB	#'#,(R0)	;SCAN FOR SPECIAL CHARS
	BEQ	INT		;NUMERIC SUBSTITUTION
	CMPB	#'&,(R0)
	BEQ	STR		;STRING SUBSTITUTION
	INC	R0		;ON TO NEXT CHAR
	BR	OTS43		;BACK FOR MORE
;
; SUBSTITUTE STRING
STR:	JSR	PC,FIELD	;FIND FIELD WIDTH
	TST	ICNT		;ANY ARGS
	BGT	2$
	JMP	OTS5
2$:	DEC	ICNT
	TST	R2		;ANY FIELD LEFT?
	BLE	OTS49		;NO JUST QUIT
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	MSAV,R1		;GET BACK ARG LIST
	MOV	(R1),R1		;ADDRESS OF STRING
1$:	MOVB	(R1)+,(R3)+	;COPY STRING
	SOB	R2,1$
	BR	OTS48
;
; SUBSTITUTE INTEGER
INT:	JSR	PC,FIELD	;GET FIELD WIDTH
	TST	ICNT
	BGT	1$
	JMP	OTS5
1$:	DEC	ICNT
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	CMPB	(R0),#'.	;REAL REQUIRED?
	BEQ	FINT		;YES GO GET IT
	TST	R2		;ANY THING TO DO?
	BLE	OTS48		;NO SKIP CONVERSION
	MOV	R3,-(SP)	;STACK FIELD ADDRESS
	MOV	R2,-(SP)	;AND FIELD WIDTH
	MOV	MSAV,R2		;ADDRESS OF ARG
	CLR	-(SP)		;CLEAR HIGH ORDER INTEGER WORD
	MOV	@(R2),-(SP)	;STACK INTEGER VALUE
	SXT	2(SP)		;SIGN EXTEND
	JSR	PC,ICO$		;CONVERT INTEGER
	BR	OTS48
;
FINT:	TST	R2		;ANYTHING TO DO?
	BLE	1$
	MOV	R3,-(SP)	;STACK ADDRESS OF FIELD
	ADD	R2,(SP)		;AND CONVERT TO END OF BUFFER
	DEC	(SP)
	MOV	R3,-(SP)	;PUSH FIELD ADDRESS FOR ICO$
	MOV	R2,-(SP)	;AND PUSH FIELD WIDTH
	MOV	MSAV,R2		;GET ARG ADDRESS
	SETF
	LDF	@(R2),%0	;GET REAL VALUE
	CFCC			;GET SIGN SO WE CAN ROUND THE RIGHT WAY
	BLT	3$		;SKIP IF NEGATIVE
	ADDF	VSM,%0		;ROUND UP IF +VE
	BR	4$
3$:	SUBF	VSM,%0		;LIKEWISE DOWN FOR NEGATIVE
4$:	SETL			;SET LONG INTEGER MODE
	MOV	#IRVL,R3	;LOCATION TO RECEIVE VALUE
	STCFL	%0,(R3)		;STORE AS LONG INTEGER
	MOV	(R3)+,-(SP)	;PUSH ONTO STACK
	MOV	(R3)+,-(SP)
	CALL	ICO$		;CONVERT THE VALUE
	MOV	(SP)+,R3	;GET BACK BUFFER
	TSTF	%0		;IS VALUE NEGATIVE
	CFCC
	BPL	1$		;SKIP IF NOT
	CMPF	FMONE,%0
	CFCC
	BGT	1$		;SKIP IF <=-1.
	MOVB	#'-,(R3)	;STORE MINUS SIGN
1$:	MOV	(SP)+,R1
	MOV	(SP)+,R0
FFRAC:	INC	R0		;SKIP POINT
	CMPB	(R0),#'#	;ANY FRACTION?
	BNE	OTS49		;NO CONTINUE
	JSR	PC,FIELD	;WIDTH
	TST	R2
	BLE	OTS49
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R3,-(SP)	;STACK START OF FIELD
	MOV	R3,-(SP)	;AND AGAIN FOR ICO$
	MOV	R2,-(SP)	;STACK WIDTH
	ABSF	%0		;GET ABSOLOLUTE VALUE
	MODF	FONE,%0		;GET FRACTION IN %1
1$:	MULF	FTEN,%0		;SCALE UP FRACTION
	SOB	R2,1$
	SETL			;SET LONG INTEGER MODE
	MOV	#IRVL,R3	;LOCATION TO SAVE DOUBLE VALUE
	STCFL	%0,(R3)		;STORE AS LONG INTEGER
	MOV	(R3)+,-(SP)	;PUSH ONTO STACK FOR ICO$
	MOV	(R3)+,-(SP)
	CALL	ICO$		;DO CONVERSION
	MOV	(SP)+,R3	;GET BACK ADDR OF FIELD
2$:	CMPB	(R3),#' 	;PUT IN LEADING ZEROS
	BNE	OTS48
	MOVB	#'0,(R3)+
	BR	2$
;
FONE:	.FLT2	1.
FTEN:	.FLT2	10.
FMONE:	.FLT2	-1.
VSM:	.FLT2	0.000001
IRVL:	.WORD	0,0		;DOUBLE LENGTH INTEGER SAVE LOCATION
;
; COMMON RETURN POINT
OTS48:	MOV	(SP)+,R1
	MOV	(SP)+,R0
OTS49:	ADD	#2,MSAV		;NEXT ARG
	JMP	OTS43		;AND GO BACK FOR MORE
;
;
; FIND WIDTH OF FIELD OF LIKE CHARACTERS.
; POINTER TO FIRST IN R0, LENGTH COUNT R1
; WIDTH IS RETURNED IN R2
; ADDRESS IN R3. R2 IS -VE ON RETURN IF FIELD STARTS OUTSIDE
; BUFFER . AND FIELD IS TRUNCATED IF IT CROSSES END OF BUFFER.
;
FIELD:	MOV	R4,-(SP)
	MOVB	(R0),R4		;SAVE CHAR
	CLR	R2
	MOV	R0,R3
	SUB	2(R5),R3	;GET BUFFER OFFSET
	ADD	MCAL+2,R3	;AND FORM ADDRESS
1$:	CMPB	R4,(R0)
	BNE	2$
	INC	R2
	INC	R0
	SOB	R1,1$
2$:	CMP	R3,#MSBFE	;END OF BUFFER?
	BLOS	3$		;NO DO WE OVERRUN?
	NEG	R2		;FLAG NO CONVERSION
	BR	4$
3$:	MOV	#MSBFE2,R4	;ABSOLUTE END OF FIELD
	SUB	R3,R4		;REMAINING SPACE
	CMP	R4,R2		;BIGGER THAN FIELD?
	BGE	4$		;YES NO PROBS
	MOV	R4,R2		;TRUNCATE FIELD
4$:	INC	R1
	MOV	(SP)+,R4
	RTS	PC
;
;
; UPDATE BUFFER POINTER OR OUTPUT
;
OTS5:	MOV	MSAV,R5
	TST	ICNT
	BLE	4$
	CMP	(R5),#-1	;NULL
	BNE	3$
4$:	TST	ILINE		;WAS THIS AN OUT CALL ?
	BNE	5$
	MOV	ILSAV,ILINE	;GET DEFAULT LINE
	BR	OTS52
3$:	CMP	@(R5),#-1	;WRITE TO NEXT LINE ?
	BNE	1$
	ADD	#10.,ILINE	;NEXT LINE #
	CMP	ILINE,MAXLIN
	BLT	OTS52
	CLR	ILINE
	BR	OTS52
1$:	CMP	@(R5),#-2	;CONCATENATE
	BNE	2$
5$:	MOV	#MSBF,MCAL+2	;UPDATE BUFFER POINTER
	ADD	LENGTH,MCAL+2
	BR	OTS56
2$:	MOV	@(R5),ILINE	;GET LINE #
OTS52:	DEC	ICNT
	BLE	1$	
	CMP	2(R5),#-1	;NULL DEVICE ARG ?
	BEQ	1$
	MOV	2(R5),MCAL+P3	;ADDRESS OF DEVICE ARG
	BR	OTS54
1$:	MOV	#ICSAV,MCAL+P3	;RESET DEFAULT DEVICE
;
; NOW CALL OUTM DO DO THE OUTPUT
OTS54:	MOV	LENGTH,R0
	BNE	2$
	INC	LENGTH		;NULL LINES SHOULD PRINT SOMETHING
	INC	R0
2$:	CLRB	MSBF(R0)	;ADD ZERO BYTE
	MOV	#MCAL,R5
	MOV	#MSBF,2(R5)	;START OF BUFFER
	CALL	OUTM
	CALL	OUTCLR		;RESET BUFFER TO BLANKS
;
OTS56:	MOV	(SP)+,R5
	LDFPS	(SP)+
	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RTS	PC
;
; OUTTAB - TAB TO COLUMN N
;	CALL OUTTAB[(N)]
; FUNCTION RESULT IS CURRENT COLUMN
;
OUTTAB::TSTB	(R5)		;ANY ARGS ?
	BEQ	10$		;IF NOT GO RETURN POSITION
	CMP	P1(R5),#-1	;FIRST ARG NULL ?
	BEQ	10$
	MOV	#MSBF,R0
	ADD	@P1(R5),R0
	CMP	R0,#MSBFE
	BLOS	1$
	MOV	#MSBFE,MCAL+2
	BR	2$
1$:	MOV	R0,MCAL+2
2$:	MOV	#MSBF,R0	;PATCH OUT ANY NULLS BEFORE THE TAB
3$:	CMP	R0,MCAL+2
	BHIS	10$
	TSTB	(R0)+
	BNE	3$
	MOVB	#40,-1(R0)
	BR	3$
10$:	MOV	MCAL+2,R0	;GET POINTER
	SUB	#MSBF,R0
	CMP	R0,LENGTH
	BLT	6$
	MOV	R0,LENGTH
6$:	CMPB	(R5),#2		;SECOND ARG ?
	BLT	7$
	MOV	R0,@P2(R5)
7$:	RETURN
;
;
;
;
; OUTCLR - CLEAR OUTS BUFFER
;
OUTCLR::MOV	R0,-(SP)
	MOV	#MSBF,R0	;POINT TO BUFFER
1$:	MOVB	#' ,(R0)+	;FILL WITH BLANKS
	CMP	R0,#MSBFE
	BLO	1$
	MOV	#MSBF,MCAL+2	;RESET CURRENT POINTER
	CLR	LENGTH		;RESET LENGTH
	MOV	(SP)+,R0
	RETURN
;
;
.IF	DF	RSX
BLK:	QIOW$	IO.WVB,0,0,0,0,0,<0,0,0>	;*RSX*
.ENDC
 
MCAL:	4,MSBF,LENGTH,0,ILINE
;
; THE FOLLOWING GLOBAL ENABLES A VECTOR OF OUTS PARAMETERS
; TO BE ACCESSED BY OTHER UTILITIES. DO NOT CHANGE THE
; ORDER OF THE NEXT FEW WORDS.
;
OUTIMP::
DFLUN:	.WORD	DEFLUN	;DEFAULT LUN FOR OUTS OUTPUT
SPLUN:	.WORD	0	;SPECIAL LUN FOR USER ASSIGNED OUTPUT.
ILSAV:	.WORD	250.	;CURRENT OUTPUT LINE
ICSAV:	.WORD	0,0	;CURRENT OUTPUT DEVICE
BUFP:	.WORD	MSBF	;OUTS BUFFER POINTER
LENGTH:	.WORD	0	;AND LENGTH OF CURRENT STRING
;
; END OF COMUNICATIONS VECTOR
ILINE:	.WORD	0	;LINE NUMBER IN THIS REQUEST
;
LUNNO:	.WORD	0	;LUN CURRENTLY IN USE
LUNDAT:	.BLKW	6
MSAV:	.WORD	0
ICNT:	.WORD	0
MAXLIN:	.WORD	260.
;
;
;
; WE SUPPORT NEGATIVE DEVICE CODES
; HENCE DEVTAB & INITAB ARE RELATIVE TO DEVS & UNITS
;
.IF	DF	UCH
DEVS:	.ASCII	/PPLPCLVDVDVDVDVDVDVDVDVDVDVDVDVDVDTTTI/	;*UCH*
UNITS:	.BYTE	0,0,0,0,1,2,3,4,5,6,7,10,11,12,13,14,15,0,0	;*UCH*
DEVTAB=DEVS+6							;*UCH*
UNITAB=UNITS+3							;*UCH*
;
.ENDC
;
.IF	DF	ORSAY
DEVS:	.ASCII	/NLTILPLDTTTTTTRM/	;*ORSAY*
UNITS:	.BYTE	0,0,0,0,0,1,2,0		;*ORSAY*
DEVTAB=DEVS+2				;*ORSAY*
UNITAB=UNITS+1				;*ORSAY*
;
.ENDC
	.EVEN
; THIS IS THE MAIN BUFFER
; MAXSTR CHARS + 10. TO OVERRUN INTO
MSBF:	.REPT	MAXSTR+10.
	.BYTE	40
	.ENDR
; ALLOW A BIT OF EXTRA SPACE TO OVERRUN INTO
MSBFE2=.
MSBFE=MSBFE2-10.
	.END