.TITLE	FPRINT

;;
;	INTEGER FUNCTION FPRINT ( format , value1 , value2 , ... )
;
;
;	Prints a line which is built using the $FAO system service instead
;	of a FORMAT statement.   The advantage of doing this is that  $FAO
;	prints numberic values using exactly enough columns to display the
;	number;  you will never get 'value too large for field'  errors or
;	have extra white space in front of a number.  Also, $FAO can auto-
;	matically decide whether to put an 's' in a print line, like:
;
;		'1 Error Occurred'	'2 Errors Occurred'
;
;	The first argument to FPRINT must be a $FAO format control string.
;	Section 12.1 and pages 107-110 of the VAX/VMS System Services Ref-
;	erence Manual describe these strings.  The remaining arguments are
;	variable values (either integers or character strings) to be prin-
;	ted.  Integer and string values can be  freely intermixed;  FPRINT
;	is smart enough to tell an integer from a string.  Example:
;
;	      CALL FPRINT('!UL Error!%S Occured in !AS',NERR,'XSUB')
;							 ^      ^
;						    Integer    String
;
;	The first  character of the resultant line is used as the carriage
;	control character.
;
;	FPRINT calls a routine named  FPRINT_2  to actually print the line
;	after $FAO builds it.   You may provide your own  FPRINT_2  if you
;	want, for instance, to write to a file other than SYS$OUTPUT.  The
;	routine must use one argument, a variable-length character string,
;	as, for example:
;
;			  INTEGER FUNCTION FPRINT_2(STRING)
;			  CHARACTER*(*) STRING
;			  WRITE (3,1000) STRING
;			  FPRINT_2 = 1
;		     1000 FORMAT (A)
;			  END
;
;	Note that FPRINT_2 must be a function, returning a VMS status val-
;	ue ('success' is 1).   The function result of FPRINT is also a VMS
;	status value; if $FAO fails, this is the value returned from $FAO;
;	otherwise this is the value returned from FPRINT_2.
;
;	FPRINT will not work correctly  if any of the VALUEi arguments are
;	integers with hex values '010Ennnn' (where n is any digit).
;
;	.INDEX FORMATTING OUTPUT>>
;
;	Alan L. Zirkle     Naval Surface Weapons Center
;			   Code K53
;	10 Aug 1984	   Dahlgren, Virginia  22448
;

	.PSECT	$CODE, LONG,PIC,SHR,EXE,RD,NOWRT


	.ENTRY	FPRINT, ^M<R2>

	MOVZBL	(AP), R0	; R0 = Count of arguments

LOOP:				; Build parameter list for $FAOL on stack
	MOVL	(AP)[R0], R1	; R1 = Address of (i)th value
	MOVW	2(R1), R2	; R2 = upper 16 bits of value or descriptor
	CMPW	R2, #^X010E	; Is this a string descriptor?
	BEQL	DESCR		; Branch if it is
	PUSHL	(R1)		; Push %VAL of integer value on stack
	BRB	LOOPEND

DESCR:				; (i)th value is a character string
	PUSHL	R1		; Push address of string descriptor on stack

LOOPEND:			; loop through all arguments from the last
	ACBL	#2,#-1,R0,LOOP	;  down to the second

	MOVL	4(AP), ARG1	; 1st argument to FPRINT also 1st to $FAOL
	MOVL	SP, ARG4	; 4th argument to $FAOL is our stacked list

	MOVL	#256, OUT	; Output buffer is 256 bytes long
	SUBL2	#256, SP	; Create output buffer on the stack
	MOVL	SP, OUT2	; Save buffer address in its descriptor

	CALLG	ARGS, G^SYS$FAOL  ; Call $FAOL system service

	BLBC	R0, RETURN	; Quit now if $FAOL failed

	PUSHAW	OUT		; Argument to FPRINT_2 is buffer descriptor

	CALLS	#1, G^FPRINT_2	; Call FPRINT_2 to print the resultant line

RETURN:
	RET			; Return to calling program


	.PSECT	$LOCAL, LONG,PIC,NOSHR,NOEXE,RD,WRT


ARGS:				; Argument list for call to $FAOL
	.LONG	4		; $FAOL requires 4 arguments
ARG1:	.LONG			; Format control string descriptor
ARG2:	.ADDRESS OUT		; Address of word to get resultant length
ARG3:	.ADDRESS OUT		; Address of output buffer string descriptor
ARG4:	.LONG			; Address of parameter list

OUT:				; Output buffer descriptor
	.WORD	^X010E		; Fixed length string
	.WORD			; Length of output buffer
OUT2:	.LONG			; Address of output buffer

	.END