.TITLE	FMTOUT	;FORMATTED OUTPUT CONVERSIONS
	.IDENT	'V001A'
;
;
	.PSECT	FMTORO,RO
;
; FUNCTION FMTOUT(IBUFFR,IFRMT,IADR1,IADR2,...,IADRN)
; 	  INSERT(   "  ,  "  ,IVAL1,IVAL2,...,IVALN) FOR OCTAL & DECIMAL CONVERSION (IADR'S REMAIN FOR ASCII)
;  INSERT IS ALTERNATE ENTRY POINT FOR VALUES (INSTEAD OF ADDRESSES)
;
; IBUFFR		STARTING LOCATION OF BUFFER AREA
;
; IFRMT		STARTING LOCATION OF FORMAT BLOCK
;
; 		BITS	CONTENTS	VALUE	OPERATION/INTERPRETATION
;
; 		15	(SET FOR SPECIAL CASES WHERE CODE = 7)
;
; 		14- 8	COUNT		1-127	NO. OF REPETITIONS (CODE = 1, 2, OR 4)
;
; 		7 - 5	CODE		0	EXIT TO CALLING PROGRAM
; 					1	OCTAL
; 					2	INTEGER (SINGLE WORD)
; 					3	INTEGER (DOUBLE WORD)UNUSED
; 					4	ASCII
; 					5	UNUSED
; 					6	UNUSED
; 					7	HOLLERITH, N(1HC)
;
; 		4 - 0	LENGTH		1-31	STARTING AT CURRENT BUFFER PTR (CODE = 1 OR 2)
;
; 		FOR CODE = 7, BITS #14-8 CONTAIN CHARACTER TO BE INSERTED
; 		AND BITS #4-0 CONTAIN THE NUMBER OF SUCCESSIVE INSERTIONS TO BE MADE
; 		FOR THIS CASE, IF BITS #14-8 ARE 0, THEN BITS #4-0 CONTAIN NUMBER OF
; 		SUCCESSIVE BYTES TO BE SKIPPED STARTING FROM CURRENT
; 		LOCATION WITHIN THE BUFFER
;
; 		***** SPECIAL CASES *****
; 		VALUE	OPERATION
; 		0	FORMAT TERMINATOR (RETURN TO CALLING PROGRAM)
;
; 		SPECIAL CASES WITH BIT# 15 SET TO 1:
; 		-1	INSERT  ONE CR/LF PAIR
;
;
; INSERT RETURNS BYTE COUNT IN R0 (INCLUDING CR/LF PAIR)
; AND NEXT BUFFER LOCATION IN R4 (= CURRENT BUFFER START + CURRENT LENGTH)
;

INSERT::INC	FLAG			;FLAG NON-0 FOR VALUE CONVERSION
	BR	ISTART
;
FMTOUT::CLR	FLAG			;FLAG = 0 FOR ADDRESS (VALUE) CONVERSION
;
ISTART:	MOV	R5,-(SP)		;PUSH RETURN ADDRESS
	TST	(R5)+
	MOV	(R5)+,R4		;CURRENT BUFFER ADDRESS ALWAYS IN R4
	MOV	R4,BSTART		;SAVE STARTING BUFFER ADDRESS
	MOV	(R5)+,FORMAT		;CURRENT FORMAT POINTER
;
INEXT:	MOV	@FORMAT,R0		;[COUNT:CODE:LENGTH]
	MOV	R0,FORM			;SAVE CURRENT FORMAT
	BIT	#340,R0			;CODE = 0 ?
	BEQ	INEXIT			;EXIT IF 0
;
	ADD	#2,FORMAT		;PRIME FOR NEXT FORMAT ENTRY
;
	MOV	R0,R1
	BIC	#377,R1
	SWAB	R1			;EXTRACT COUNT (CODES 1, 2, OR 4)
	MOV	R1,COUNT
;
	BIC	#177740,R0		;EXTRACT FIELD LENGTH
	MOV	R0,LENGTH
;
	TSTB	FORM			;CODE = 4 TO 7 ?
	BMI	ICHARS			;YES, INSERT CHARACTERS
;
ILOOP:	MOV	R4,-(SP)		;PUSH FIELD START LOCATION
;
	MOV	FORM,R1			;CURRENT FORMAT
	MOV	R1,R0
;
	BIC	#177437,R1		;MASK CODE
	CMP	#140,R1			;DOUBLE WORD INTEGERS ?
	BEQ	IDUBLE			;YES, CODE = 3
;
	MOV	LENGTH,-(SP)		;PUSH FIELD LENGTH
	ADD	(SP),R4			;NEXT FIELD START LOCATION
;
	TST	FLAG			;FLAG = 0 ?
	BEQ	ISKIP1			;YES, USE AS ADDRESS
;
	MOV	(R5)+,-(SP)		;NO, USE AS VALUE
	BR	ISKIP2
;

ISKIP1:	MOV	@(R5)+,-(SP)		;PUSH VALUE
;
ISKIP2:	MOV	FORM,R0			;CURRENT FORMAT
	BIC	#177437,R0		;EXTRACT CODE
	CMP	#40,R0			;CODE = 1 ?
	BEQ	IOCTAL			;YES, PACK OCTAL
;
	JSR	PC,$ICO			;PACK DECIMAL (CODE = 2)
;
; C BIT SET IF ERROR
;
	BR	IAGAIN
;
IOCTAL:	JSR	PC,$OCO			;PACK OCTAL (CODE = 1)
;
; C BIT SET IF ERROR
;
	BR	IAGAIN
;
IDUBLE:	TST	FLAG			;FLAG = 0 ?
	BEQ	ISKIP3			;YES, USE AS ADDRESS
;
	MOV	(R5)+,R0		;HIGH PART OF VALUE                     ;**NEW**
	MOV	(R5)+,R1		;LOW PART OF VALUE                      ;**NEW**
	BR	ISKIP4                                                          ;**NEW**
;                                                                               ;**NEW**
ISKIP3:	MOV	(R5)+,R4		;ADDRESS OF HIGH PART                   ;**NEW**
	MOV	(R4)+,R0		;HIGH PART                              ;**NEW**
	MOV	(R4),R1			;LOW PART                               ;**NEW**
;                                                                               ;**NEW**
ISKIP4:	MOV	#IAREA,R2		;START OF 12. BYTE AREA                 ;**NEW**
;                                                                               ;**NEW**
	JSR	R5,DBTAS.		;CONVERT DOUBLE WORD INTEGER TO ASCII   ;**NEW**
;                                                                               ;**-11
	MOV	(SP)+,R4		;RESTORE R4
;
	MOV	LENGTH,R1
IBLANK:	CMP	#12.,R1			;LENGTH > 12. ?
	BGE	ITWORD			;NO
;
	MOVB	#40,(R4)+		;YES, FILL WITH BLANKS
;
	DEC	R1
	BR	IBLANK
;

ITWORD:	MOV	#IAREA+12.,R0
	SUB	R1,R0			;STARTING ADDRESS
;
IDLOOP:	MOVB	(R0)+,(R4)+		;FILL BUFFER
	DEC	R1
	BGT	IDLOOP
;
IAGAIN:	DEC	COUNT			;DONE ?
	BGT	ILOOP			;NO, LOOP AGAIN ON SAME FORMAT
;
	BR	INEXT			;GET NEXT FORMAT ENTRY
;
ICHARS:	MOV	FORM,R0
;
	BIC	#177437,R0		;EXTRACT CODE
	CMP	#340,R0			;CODE = 7 ?
	BEQ	IHOLLR			;YES, HOLLERITH INSERTION
;
	MOV	(R5)+,R0		;ASCII INSERTION STARTING ADDRESS
IASCII:	MOVB	(R0)+,(R4)+		;DEPOSIT ASCII BYTE
	DEC	COUNT			;DONE ?
	BGT	IASCII			;LOOP UNTIL DONE
;
	BR	INEXT			;GET NEXT FORMAT ENTRY
;
SCOUNT=LENGTH			;COUNT FOR SPECIAL CHARACTERS IS IN BITS# 4-0
;
IHOLLR:	MOV	FORM,R0			;GET ASCII CHARACTER STORED IN CURRENT FORMAT
	SWAB	R0			;PUT IN LOWER BYTE
	TSTB	R0			;UPPER BYTE OF FORM IS < 0 FOR SPECIAL CHRS
	BMI	ISPCL			;SPECIAL CHARACTERS
;
IFILL:	TSTB	R0			;0 TO SKIP BYTES IN BUFFER
	BEQ	ISKIP			;NO DEPOSIT, INCREMENT BUFFER POINTER
	MOVB	R0,(R4)			;DEPOSIT SINGLE CHARACTER
;
ISKIP:	TSTB	(R4)+			;NEXT BUFFER BYTE
	DEC	SCOUNT			;DONE ?
	BGT	IFILL			;LOOP UNTIL DONE
;
	BR	INEXT			;GET NEXT FORMAT ENTRY
;

ISPCL:				;SPECIAL CHARACTERS
ICRLF:	MOV	#CRLF,R0		;FILL WITH CR/LF PAIR
	MOVB	(R0)+,(R4)+		;CR
	MOVB	(R0),(R4)+		;LF
;
	DEC	SCOUNT			;DONE ?
	BGT	ICRLF			;LOOP UNTIL DONE
	BR	INEXT			;GET NEXT FORMAT ENTRY
;
;
INEXIT:	MOV	#CRLF,R0		;INSERT CR/LF PAIR
	MOVB	(R0)+,(R4)+		;CR
	MOVB	(R0),(R4)+		;LF
;
	MOV	R4,R0			;LAST BUFFER POSITION
	SUB	BSTART,R0		;LAST - FIRST = BYTE COUNT
;
	MOV	(SP)+,R5		;RETURN
	RTS	PC
;
	.PSECT	FMTORW,D
;
FORMAT:	0
FORM:	0
COUNT:	0
LENGTH:	0
BSTART:	0
FLAG:	0
;
CRLF:	.BYTE	12,15
;
IAREA:	0,0,0,0,0,0			;DOUBLE WORD STORAGE AREA
;
;
;
;
; DATE OF LAST EDIT:
;
; 	OCTOBER 1972
;
;C. L. DOLNICK
;
;
;
;
;
;
	.END