.NLIST	TOC,SYM
.TITLE	$FORMAT
.SBTTL	ULBLIB 017	- General Purpose Formatting Routine
.IDENT	\V02.00\
.PSECT	.LIBC.
.ENABL	LC,GBL

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  with  the
; inclusion of the above copyright notice.  This software,  or
; any other copies thereof, may not be provided  or  otherwise
; made available to any other person except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
;+
; $FORMAT
; This routine is made up of several special purpose output formatting
; routines.  It collects them together under one driver whose input is
; similar to a Burroughs ALGOL format statement.
;
; The formatting directives are always enclosed in square-brackets, to
; distinguish them from the rest of the string to be output.  Anything
; which is not a directive will be placed in the output string.  The
; output string will be an ASCIZ string (string of printable ASCII
; characters, possibly with embedded carriage control, followed by a
; zero byte).  R0 will return pointing to the zero byte.
;
; Formatting Directives
;
; Numeric Formatting Directives
;
; All of the numeric output directives take an optional field size argument.
; this is specified by a decimal number following the directive.  If the
; field size is specified, the number will be output right justified in a
; field of that many blanks.  Otherwise, the number will be output left
; justified.  Note that no checking is done on the field size and the number
; of positions the output takes up.  This means that the output may overprint
; data already in the buffer.
;
; [Bn]	- Octal output, no lead zero suppression
;	  This directive will output an octal number with leading zeros.
;
; [On]	- Octal output, lead zero suppression
;	  This directive will output an octal number with no leading
;	  zeros.
;
; [Dn]	- Decimal ouput, signed
;	  This routine will output a decimal number in the range of
;	  -32768 to +32767.  If the number is negative, a minus sign
;	  will be included.
;
; [Un]	- Decimal output, unsigned
;	  This directive will output an unsigned decimal number in the
;	  range of 0 to 65535
;
; ASCII Formatting Directives
;
; The following directives are used to output ASCII strings or characters.
;
; [Ao]	- Single character output
;	  This directive is used to output a non-printing or run-time
;	  specific character (see Run-time Formatting).  The number
;	  following the directive is interpreted as an octal number.
;
; [Nn:c]- Repeated character output
;	  This directive outputs the specified character (c) the number
;	  of times specified by the repeat count (n).  If the colon is not
;	  included in the formatting directive, the next argument is used
;	  as the output character.
;
; [R]	- RAD50 output
;	  This directive converts RAD50 to ASCII and places it in the output
;	  buffer.  Its inputs are the pointer to the RAD50 words to convert
;	  and the number of words.
;
; [S]	- String output
;	  This directive outputs a string.  Its inputs are the pointer to
;	  the string and the length of the string.
;
; [Z]	- ASCIZ string output
;	  This directive outputs an ASCIZ string.  Its input is the pointer
;	  to the string.
;
; Carriage Control Directives
;
; These directives are used to embedd carriage control in the output stream.
;
; [/]	- Carriage Return
;	  This directive places a <CR><LF> pair in the output buffer.
;
; [P]	- Form Feed
;	  This directive places a <FF> in the output buffer.
;
; [Tn]	- Tab
;	  This directive blank fills from the current position in the buffer
;	  to the n'th position from the beginning of the current buffer.
;	  If n is greater than 32767, or the current position is past the
;	  desired position, on blank is inserted.  It is quite similar to
;	  the BASIC TAB function.
;
; Run-time Formatting
;
; Often the precise output format cannot be determined at assembly time.  If
; this is the case, the * formatting directive is useful.  This is not
; a directive, as it informs the $FORMAT routine to replace it with the next
; argument.  It may be use in the place of a directive, a field size, the
; character to output in the A directives, or the repeat count in the N
; directive.
;
;
;	R0	-> output buffer
;	(SP)	=  <n + 1> * 2 where n = number of arguments
;	(SP+2)	-> format directive string
;	(SP+4)	=  arg 1
;	(SP+6)	=  arg 2
;	   :	:    :
;     (SP+n*2+2)=  arg n
;
;	JSR	PC,$FORMAT
;
;	R0	-> next position in output buffer
;-

.PSECT	.LIBD.

DIRECT:
	.ASCIZ	\*ABDNOPRSTUZ/\
	.EVEN

ADDR:	.WORD	STAR		;Run-time formatting
	.WORD	ASCII		;ASCII character output
	.WORD	OCTALZ		;Octal, leading zeros
	.WORD	DECIMA		;Decimal, signed
	.WORD	REPEAT		;Repeated character
	.WORD	OCTALN		;Octal, lead zero suppress
	.WORD	FF		;<FF>
	.WORD	RAD50		;RAD50 conversion
	.WORD	STRING		;String output
	.WORD	TAB		;BASIC TAB function
	.WORD	UNSIGN		;Decimal, unsigned
	.WORD	ASCIZ		;ASCIZ string output
	.WORD	CRLF		;<CR><LF>
.PSECT	.LIBC.

$FORMAT::
	MOV	R5,-(SP)	;Save the registers
	MOV	R4,-(SP)	;
	MOV	R3,-(SP)	;
	MOV	R2,-(SP)	;
	MOV	R1,-(SP)	;
	MOV	SP,R5		;Point R5 at the stack
	ADD	#16,R5		;Point to the argument list
	MOV	(R5)+,R4	;Point R4 at the formatting directives
	MOV	R0,-(SP)	;Save the buffer pointer for [Tn]
	MOV	R0,R3		;Point R3 at the output buffer
START:	MOVB	(R4)+,R2	;Get the next character
	CMPB	R2,#']		;Is it the optional close?
	BEQ	START		;Branch if so.  Ignore it
	CMPB	R2,#'[		;The start of a format directive?
	BNE	NOMTCH		;Branch if so.  Output the character.
	MOVB	(R4)+,R2	; Else, get the directive character.
FIND:	MOV	#DIRECT,R0	;Point at the valid directives
	MOV	#ADDR,R1	;Point the routine addresses
1$:	CMPB	R2,(R0)+	;Is this it?
	BNE	2$		;Branch if not
	JMP	@(R1)		; Else, go call the routine

2$:	TST	(R1)+		;Go to the next routine
	TSTB	@R0		;Any more directives?
	BNE	1$		;Branch if so.  Try again.
NOMTCH:	MOVB	R2,(R3)+	;Put the character in the buffer
	BNE	START		;If it's not a null, do the next

	DEC	R3		;Back up the output pointer
	TST	(SP)+		;Clear away the buffer pointer
	MOV	SP,R0		;Point R0 at the stack
	ADD	#16,R0		;Point into the argument list
	MOV	R0,R1		;Copy it
	ADD	-(R1),R0	;Point to the bottom of the list
	MOV	12(SP),-(R0)	;Copy the return address
	MOV	R3,-(R0)	; and the end address of the buffer
	MOV	(SP)+,R1	;Restore registers
	MOV	(SP)+,R2	;
	MOV	(SP)+,R3	;
	MOV	(SP)+,R4	;
	MOV	(SP)+,R5	;
	MOV	R0,SP		;Restore stack pointer
	MOV	(SP)+,R0	;Get the buffer address for user
	RETURN
.SBTTL	Formatting Directive Routines

; Handle the "*" directive

STAR:	MOV	(R5)+,R2	;Get the next parameter
	BR	FIND		; and use it as directive

; Handle the [P] directive

FF:	MOVB	#14,(R3)+	;Insert a formfeed
	BR	START		;Do it again

; Handle the [/] directive

CRLF:	MOVB	#15,(R3)+	;Insert a <CR>
	MOVB	#12,(R3)+	; and a <LF>
	BR	START		;

; Handle the [S] directive

STRING:	MOV	(R5)+,R0	;Get the address of the string
	MOV	(R5)+,R1	; and the length
1$:	DEC	R1		;Down the count
	BLT	START		;Branch if done
	MOVB	(R0)+,(R3)+	;Move in a character
	BR	1$		;Loop

; Handle the [Z] directive

ASCIZ:	MOV	(R5)+,R0	;Get the address of the string
1$:	MOVB	(R0)+,(R3)+	;Move a character
	BNE	1$		;Loop until done
	DEC	R3		;Correct the output pointer
	BR	START		;

; Handle the [R] directive

RAD50:	MOV	(R5)+,R2	;Get address of the block
	MOV	R3,R1		;Copy output pointer for conversion
1$:	DEC	@R5		;Decrement the number of words
	BLT	2$		;Branch if done
	MOV	(R2)+,R0	;Copy the RAD50 word
	CALL	$R50ASC		;Convert it to ASCII
	BR	1$		;Loop

2$:	MOV	R1,R3		;Restore updated output pointer
	TST	(R5)+		;Clean the word count off
	BR	START		;

; Handle the [Ao] directive

ASCII:	CALL	G8PARM		;Get the parameter (octal)
	MOVB	R0,(R3)+	;Save it
	BR	START

; Handle the [Nn(:c)] directive

.ENABL	LSB
REPEAT:	CALL	G1PARM		;Get the field size, if any
	MOV	R0,-(SP)	;Save it
	CMPB	@R4,#':		;Is character in the format string?
	BNE	1$		;Branch if not
	TSTB	(R4)+		;Get rid of ":"
	MOVB	(R4)+,R0	;Get the character
	BR	2$		;

1$:	MOV	(R5)+,R0	;Get the character
2$:	DEC	@SP		;Decrement repeat count
	BLT	3$		;Branch if done
25$:	MOVB	R0,(R3)+	;Output the character
	BR	2$		;Loop

3$:	TST	(SP)+		;Clean the stack
LNK1:	BR	START		;

; Handle the [Tn] directive

TAB:	CALL	G1PARM		;Get the desired buffer position
	MOV	R0,-(SP)	;Save it
	MOV	#40,R0		;Use blank as filler
	ADD	2(SP),@SP	;Add in start of buffer
	SUB	R3,@SP		;Subtract out current position
	DEC	@SP		;Off by one
	BGE	2$		;Go do blank filler
	CLR	@SP		;Else do one blank
	BR	25$		;Go do it
.DSABL	LSB

; Handle the [D(n)] directive

DECIMA:	JSR	R3,SETUP	;Call co-routine set up
	CLR	R2		;Flag lead zero suppression
	CALL	$CBDSG		;Convert binary to ASCII
	RETURN			;!!!Co-routine return!!!

; Handle the [O(n)] directive

OCTALN:	JSR	R3,SETUP	;Call co-routine set up
	CLR	R2		;Flag no lead zero's
	CALL	$CBOMG		;Convert binary to ASCII
	RETURN			;!!!Co-routine return!!!

; Handle the [B(n)] directive

OCTALZ:	JSR	R3,SETUP	;Call co-routine set up
	MOV	#1,R2		;Flag lead zero's wanted
	CALL	$CBOMG		;Convert binary to ASCII
	RETURN			;!!!Co-routine return!!!

; Handle the [U(n)] directive

UNSIGN:	JSR	R3,SETUP	;Call co-routine set up
	CLR	R2		;Flag lead zero suppression
	CALL	$CBDMG		;Convert binary to ASCII
	RETURN			;!!!Co-routine return!!!
.SBTTL	Support Routines
.SBTTL	SETUP	-	Set up for numeric conversions

SETUP:	CALL	G1PARM		;Get field size, if any (decimal)
	MOV	R0,-(SP)	;Save it
	MOV	(R5)+,R1	;Get the number to output
	SUB	#6,SP		;Set up the temp buffer
	MOV	SP,R0		;Save pointer to area
	MOV	R3,-(SP)	;Put return address on stack
	JSR	PC,@(SP)+	;Co-routine return
	SUB	SP,R0		;Get the number characters converted
	MOV	10(SP),R3	;Point to output buffer
	MOV	R3,R1		;Copy it
	MOV	R3,R2		;Copy it
	ADD	6(SP),R3	;Add the field size
	CMP	R2,R3		;Zero length feild?
	BEQ	2$		;Branch if so
	SUB	R0,R3		;We have to have that many characters
	MOV	R3,R1		;Save it
1$:	CMP	R2,R3		;Blank this space?
	BHIS	2$		;Branch if not
	MOVB	#40,-(R3)	;Put in a blank
	BR	1$		;Loop

2$:	MOV	R1,R3		;Copy the output pointer
	MOV	SP,R1		;Point to temp buffer
3$:	DEC	R0		;Count down
	BLT	4$		;Branch if done
	MOVB	(R1)+,(R3)+	;Store the character
	BR	3$		;Loop

4$:	ADD	#12,SP		;Clean off the stack
	BR	LNK1
.SBTTL	Support Routines
.SBTTL	G8PARM, G1PARM	-	Get parameters

G8PARM:	MOV	#7,R1		;Indicate octal parameter
	BR	GPARM		;Go get it

G1PARM:	MOV	#9.,R1		;Indicate decimal parameter

GPARM:	CMPB	@R4,#'*		;Parameter in directive list?
	BEQ	3$		;Branch if not.  In the parameter list

	CLR	R0		;Value accumulator
1$:	MOVB	(R4)+,R2	;Get the character
	BIC	#177600,R2	;Clear ugly bits
	SUB	#'0,R2		;Make it binary
	BLT	4$		;Branch if not a number.  Done
	CMP	R1,R2		;Is it in range?
	BLO	4$		;Branch if not.  Done.
	MOV	R0,-(SP)	;Save in case decimal
	ASL	R0		; * 2
	ASL	R0		; * 4
	CMP	R1,#7		;Octal?
	BEQ	2$		;Branch if so
	ADD	@SP,R0		; * 5
2$:	TST	(SP)+		;Clean the stack
	ASL	R0		; * 8 or * 10
	ADD	R2,R0		;Add in new value
	BR	1$		;Do the next character

3$:	TSTB	(R4)+		;Clean off the "*"
	MOV	(R5)+,R0	;Get the parameter
	BR	5$		;

4$:	TSTB	-(R4)		;Fix directive list pointer
5$:	RETURN

.END