.TITLE	RMNFOR
.IDENT	/3001.1/
;
;
;
;	WRITTEN BY	RAY DI MARCO
;			30-JAN-81.
;
;	VERSION		300181/01.
;
;-----------------------------------------------------------
;
; THIS ROUTINE AIDS IN COMPILING FORTRAN RECORDS FOR OUTPUT. THE
; CALLING SEQUENCES ARE -
;
;	CALL	RMNFOR	(0,BUF,SIZE)
;
;		CLEARS RECORD TO SPACES
;
;
;	CALL	RMNFOR	(1,BUF,AT,STRING,SIZE)
;
;		COPIES STRING INTO BUF AT OFFSET 'AT'.
;
;	CALL	RMNFOR	(N,BUF,AT,NUM)
;
;		CONVERTS NUM TO 'N' ASCII DIGITS, AND STORES IT
;		IN THE RECORD BUF AT OFFSET 'AT'. 'N' = 2,3,4
;
;

;
;
;
.SBTTL	DECLARATIONS
;
.MCALL	.PRINT,.EXIT			; ERROR TRAPPING
;
.GLOBL	RMNFOR
;
;
.GLOBL	CNAFD2,CNAFD3,CNAFD4,CNAFD5		; NUMBER CONVERSION
;
;
	.PSECT	CODE				; OPEN CODE AREA
;	------	----
;
;
;
;
.SBTTL	MACRO	DEFINITIONS
;
;
.MACRO	ERRON	CND,MES,?X,?Y,?Z
	B'CND	X
	BR	Y
X:	.PRINT	#'Z
	.EXIT
Z:	.ASCII	/"RMNFOR" -FATAL-/
	.ASCII	/MES/<200>
.EVEN
Y:
.ENDM	ERRON
;
;

;
;
;
.SBTTL	ENTRY - 'RMNFOR'	...	DISPATCHER
;
;
;
RMNFOR:	CMP	(R5),#1			; RIGHT NUMBER OF ARGUMENTS?
	ERRON	LO,<NOT ENOUGH ARGUMENTS>
;
	MOV	@2(R5),R0		; FUNCTION NUMBER -> R0
	CMP	R0,1000$-2		; LEGAL FUNCTION?
	ERRON	HIS,<ILLEGAL FUNCTION CODE>
	ASL	R0			; FUNCTION CODE*2 -> R0
	JMP	@1000$(R0)		; PROCEED TO FUNCTION
;
;
	.WORD	<1100$-1000$>/2		; NUMBER FUNCTIONS
1000$:	.WORD	ZERO			; ZERO A RECORD
	.WORD	ASCCOP			; COPY ASCII
	.WORD	NUM2			; 2 DIGIT NUMBER
	.WORD	NUM3			; 3 DIGIT NUMBER
	.WORD	NUM4			; 4 DIGIT NUMBER
1100$:	.WORD	0			; EOT
;
;

;
;
;
ZERO:	CMP	(R5),#3			; NEED 3 ARGUMENTS
	ERRON	NE,<'ZERO' NEED 3 ARGUMENTS>
;
	MOV	4(R5),R0		; BUF ADD -> R0
	MOV	@6(R5),R1		; SIZE -> R1
10$:	MOVB	#40,(R0)+		; BLANK
	SOB	R1,10$			; LOOP
;
	RETURN				; EXIT
;
;
;

;
;
;
ASCCOP:	CMP	(R5),#5			; NEED 5 ARGUMENTS
	ERRON	NE,<'ASCCOP' NEED 5 ARGUMENTS>
;
	MOV	4(R5),R0		; BUF ADD -> R0
	ADD	@6(R5),R0		; TAB TO POSITION
	MOV	10(R5),R1		; SOURCE
	MOV	@12(R5),R2		; SIZE
10$:	MOVB	(R1)+,(R0)+		; COPY
	SOB	R2,10$			; LOOP
;
	RETURN				; EXIT
;
;
;

;
;
;
NUM2:	CMP	(R5),#4			; NEED 4 ARGUMENTS
	ERRON	NE,<'NUM2' NEED 4 ARGUMENTS>
;
	MOV	4(R5),R1		; BUF ADD -> R1
	ADD	@6(R5),R1		; TAB TO POSITION
	MOV	@10(R5),R2		; NUMBER
	CLR	R0			; NO FORMATTING
	CALL	CNAFD2			; TO ASCII
	RETURN				; EXIT
;

;
;
;
;
NUM3:	CMP	(R5),#4			; NEED 4 ARGUMENTS
	ERRON	NE,<'NUM3' NEED 4 ARGUMENTS>
;
	MOV	4(R5),R1		; BUF ADD -> R1
	ADD	@6(R5),R1		; TAB TO POSITION
	MOV	@10(R5),R2		; NUMBER
	CLR	R0			; NO FORMATTING
	CALL	CNAFD3			; TO ASCII
	RETURN				; EXIT
;

;
;
;
;
NUM4:	CMP	(R5),#4			; NEED 4 ARGUMENTS
	ERRON	NE,<'NUM4' NEED 4 ARGUMENTS>
;
	MOV	4(R5),R1		; BUF ADD -> R1
	ADD	@6(R5),R1		; TAB TO POSITION
	MOV	@10(R5),R2		; NUMBER
	CLR	R0			; NO FORMATTING
	CALL	CNAFD4			; TO ASCII
	RETURN				; EXIT
;

;
.END