.TITLE	IFMATH
.IDENT	/1909.1/
;
;
;
;	WRITTEN BY	RAY DI MARCO
;			19-SEP-81.
;
;
;	VERSION		190981/01.
;
;
;---------------------------------------------------------------------
;
; This module contains the fortran callable routines
;
;	CALL	IFZERO	()
;
;		that clears the accumulator
;
;
;	CALL	IFPUT	(ISIZE,BUFFER)
;
;		that copys the numric string in BUFFER into the accumulator
;
;
;	CALL	IFGET	(ISIZE,BUFFER)
;
;		that copys the contents of the accumulator into BUFFER
;
;
;	ISIGN	= IFSGNR ()
;
;		returns +/- to indicate sign off accumulators contents
;
;
;	CALL	IFADD	(ISIZE,BUFFER)
;
;		that adds the numeric string in BUFFER to the accumulator.
;
;	where	ISIZE	is the size (in bytes) of the buffer
;		BUFFER	is a LOGICAL*1 array of size ISIZE
;
; This module refrences the IFCNV routine in module "IFCNV"
;
;
;

;
;
.SBTTL	DOCUMENTATION	STRING FORMAT
;
;
; The format of a numeric string is defined to be
;
;
;	[<space>...<space>] [<digit>...<digit>] [<dot>] [<digit>] [<digit>]
;
;
; legal strings are
;
;		1		==>	      1.00
;		1.10		==>	      1.10
;		1.9		==>	      1.90
;				==>	      0.00
;		.1		==>	      0.10
;
; All numeric strings input to this module are "normalized" by
;
;		forcing the string to contain a decimal point
;		and two digits after the point
;
;		forcing at least one digit to be placed before
;		the decimal point
;
;		converting all leading zeros (other than that
;		before the decimal point) to spaces.
;
; The user can zero the accumulator, load and read it, and add a numeric
; string to it. The size of the accumulator is determined by the "BUFSIZ"
; parameter, and can be changed at assembly time.
;
; A negitive number is any string that contains a '-' or '(' character.
;
;

;
;
.SBTTL	DECLARATIONS
;
;
;
.MCALL	.PRINT,.EXIT				; RT-11 EMTS
;
.GLOBL	IFZERO,IFPUT,IFGET,IFSGNR,IFADD		; ENTRIES
.GLOBL	IFCNV,IFSIGN				; EXTERNAL
;
;
.IIF	NDF,BUFSIZ,	BUFSIZ = 50.		; MAX STRING SIZE
;
;
;
	.PSECT	CODE				; OPEN CODE AREA
;
;
;

;
;
;
.SBTTL	ROUTINE - 'IFZERO'	...	ZERO ACCUMULATOR
;
;
;	THIS ZOUTINE CAUSES THE ACCUMULATOR TO BE LOADED WITH THE
;	STRING '0.00', THEREBY ZEROING IT.
;
;
;
IFZERO:	MOV	#BUFSIZ,R2			; R2 = COUNTER
	MOV	#BUF,R0				; R0 = POINTER
1000$:	MOVB	#40,(R0)+			; FILL WITH SPACES
	SOB	R2,1000$			; LOOP
	.IRP	X,<0,0,.,0>			; --- REPEAT LOOP ---
		MOVB	#''X',-(R0)		;	INSERT 0.00
	.ENDR					; -------------------
	MOV	#'+,ACCSIGN			; SET SIGN '+'
	RETURN					; EXIT
;
;
;

;
;
;
.SBTTL	ROUTINE	- 'IFPUT'	...	PUT STRING IN ACCUMULATOR
;
;
;	THIS ROUTINE CAUSES THE ACCUMULATOR TO BE LOADED WITH THE
;	SPECIFIED STRING!
;
;
IFPUT:	MOV	#BUF,R0				; R0 --> START BUFFER
	MOV	#BUFSIZ,R2			; R2 = BUFFER SIZE
	SUB	@2(R5),R2			; ROOM LEFT
	BMI	7000$				; < 0 --> ERROR
	BEQ	1000$				; JUST FIT -> SKIP
400$:	MOVB	#40,(R0)+			; FILL
	SOB	R2,400$				; LOOP
;
1000$:	MOV	2(R5),ARG1			; SIZE -> ARG1
	MOV	4(R5),ARG2			; BUF1 -> ARG2
	MOV	R0,ARG3				; BUF2 -> ARG3
	MOV	R5,-(SP)			; SAVE FORTRAN ARGBLK ADDRESS
	MOV	#ARGBLK,R5			; SET UP ARGBLK
	CALL	IFCNV				; LOAD STRING
	MOV	(SP)+,R5			; RESTORE OLD ARGBLK ADDRESS
	MOV	IFSIGN,ACCSIGN			; SET UP SIGN
	CALL	ZERCHK				; ACC IS ZERO?
	BNE	2000$				; NOT ZERO -> SKIP
	MOV	#'+,ACCSIGN			; ENSURE SIGN '+'
2000$:	RETURN					; EXIT
;
;
7000$:	.PRINT	#ERRPUT				; TELL FAILED
	.EXIT					; ABORT
;
;
;

;
;
;
.SBTTL	ROUTINE - 'IFGET'	...	GET CONTENTS OF ACCUMULATOR
;
;
;	This routine returns the contents of the accumulator
;	in the specified string
;
;
IFGET:	MOV	#BUFSIZ,R2			; R2 = SIZE OF BUFFER
	SUB	@2(R5),R2			; R2 = NUMBER EXTRA CHARS
	BEQ	4000$				; EXACT FIT -> OK
	BGT	3000$				; ACCUMULATOR LARGER -> SKIP
	NEG	R2				; R2 = NUMBER FILLS
	MOV	4(R5),R0			; R0 --> OUTPUT STRING
1000$:	MOVB	#40,(R0)+			; FILL
	SOB	R2,1000$			; LOOP
	BR	4100$				; RETURN CONTENTS OF ACC
;
3000$:	CMPB	BUF-1(R2),#40			; CAN ACC FIT?
	BNE	7000$				; NO -> ERROR
	MOV	#BUF,R1				; R1 = INPUT STRING
	ADD	R2,R1				; R1 = 1ST CHARACTER
	MOV	4(R5),R0			; R0 = OUTPUT STRING
	MOV	@2(R5),R2			; R2 = COUNTER
	BR	4300$				; EXIT AFTER COPYING
;
4000$:	MOV	4(R5),R0			; R0 = OUTPUT BUFFER
4100$:	MOV	#BUF,R1				; R1 = INPUT BUFFER
4200$:	MOV	#BUFSIZ,R2			; R2 = NUMBER CHARS IN ACC
4300$:	MOVB	(R1)+,(R0)+			; COPY
	SOB	R2,4300$			; LOOP
	CLR	R0				; NO ERROR
	RETURN					; EXIT
;
;
7000$:	.PRINT	#ERRGET				; TELL FAILED
	.EXIT					; ABORT
;
;
;

;
;
;
.SBTTL	ROUTINE	- 'IFSGNR'	...	RETURN SIGN
;
;
IFSGNR:	MOV	ACCSIGN,R0			; SIGN -> R0
	RETURN					; EXIT
;
;
;

;
;
;
.SBTTL	ROUTINE	- "IFADD"	...	ADD STRING TO ACCUMULATOR
;
;
;	This routine is called to add the numeric string to the contents
;	of the accumulator. Ensure that the accumulator is initially
;	zeroed!
;
IFADD:	CALL	ZERCHK				; IS ACC = 0?
	BNE	100$				; NOT ZERO -> SKIP
	JMP	IFPUT				; ACC ZERO - USE 'PUT'
;
100$:	MOV	#BUFAUX,R0			; R0 --> START BUFFER (AUX)
	MOV	#BUFSIZ,R2			; R2 = BUFFER SIZE
	SUB	@2(R5),R2			; ROOM LEFT
	BMI	7000$				; <0 -> ERROR
	BEQ	1000$				; JUST FIT -> SKIP
400$:	MOVB	#40,(R0)+			; FILL
	SOB	R2,400$				; LOOP
;
1000$:	MOV	2(R5),ARG1			; SIZE -> ARG1
	MOV	4(R5),ARG2			; BUF1 -> ARG2
	MOV	R0,ARG3				; BUF2 -> ARG3
	MOV	R5,-(SP)			; SAVE FORTRAN ARGBLK ADDRESS
	MOV	#ARGBLK,R5			; R5 --> ARGBLK
	CALL	IFCNV				; LOAD STRING
	MOV	(SP)+,R5			; RESTORE OLD ARGBLK ADDRESS
	MOV	IFSIGN,AUXSIGN			; SAVE SIGN
	TST	R0				; ERROR?
	BMI	7100$				; YES -> ABORT
;
	CMP	AUXSIGN,ACCSIGN			; ADDING NUMBER OF SAME SIGN?
	BNE	3000$				; NO -> EXTRA WORK TIME
	MOV	#BUF+BUFSIZ,R0			; R0 --> CONTENTS ACCUMULATOR
	MOV	#BUFAUX+BUFSIZ,R1		; R1 --> STRING TO ADD
	CLR	OVERFL				; NO OVERFLOW
	CALL	11000$				; ADD CENTS UNIT
	CALL	11000$				; ADD CENTS TENS
	CMPB	-(R0),-(R1)			; SKIP '.'
2000$:	CALL	11000$				; ADD DOLLARS
	BCC	2000$				; LOOP TILL DONE
	CLR	R0				; ALL OK
	RETURN					; EXIT
;
;

;
;
;
;
3000$:	MOV	#BUF,R0				; R0 --> ACC
	MOV	#BUFAUX,R1			; R1 --> NEW NUMBER
	CALL	COMPAR				; ARE THEY SAME?
	BNE	3100$				; NO -> SKIP
	JMP	IFZERO				; YES -> ZERO ACC
;
;
;
3100$:	BGT	3200$				; MAG(ACC) > MAG(AUX) -> SKIP
	MOV	AUXSIGN,ACCSIGN			; WILL HAVE SIGN OF (AUX)
	MOV	#BUFSIZ,R2			; COUNTER
	MOV	#BUFAUX,R1			; R1 --> AUX
	MOV	#BUF,R0				; R0 --> ACC
3140$:	MOVB	(R0),R3				; ACC BYTE -> R4
	MOVB	(R1),(R0)+			; AUX BYTE -> ACC
	MOVB	R3,(R1)+			; ACC BYTE -> AUX
	SOB	R2,3140$			; LOOP
;
;
3200$:	MOV	#BUF+BUFSIZ,R0			; R0 --> CONTENTS ACCUMULATOR
	MOV	#BUFAUX+BUFSIZ,R1		; R1 --> STRING TO ADD
	CLR	OVERFL				; NO OVERFLOW
	CALL	12000$				; SUB CENTS UNIT
	CALL	12000$				; SUB CENTS TENS
	CMPB	-(R0),-(R1)			; SKIP '.'
3300$:	CALL	12000$				; SUB DOLLARS
	BCC	3300$				; LOOP TILL DONE
;
;
	MOV	#BUFSIZ,-(SP)			; SIZE -> (SP)
	MOV	SP,ARG1				; ARG1 --> BUFSIZ
	MOV	#BUF,ARG2			; INPUT = ACC
	MOV	#BUF,ARG3			; OUTPUT = ACC
	MOV	R5,-(SP)			; SAVE FORTRAN ARGBLK ADDRESS
	MOV	#ARGBLK,R5			; R5 --> ARGBLK
	CALL	IFCNV				; LOAD STRING
	MOV	(SP)+,R5			; RESTORE OLD ARGBLK ADDRESS
	ADD	#2,SP				; POP OFF BUFSIZ
	CLR	R0				; ALL OK
	RETURN					; EXIT
;
;

;
;
7000$:	.PRINT	#ERRADD				; TELL STRING TOO LARGE
	.EXIT					; ABORT
;
7100$:	.PRINT	#ERRADA				; TELL STRING ILLEGAL
	.EXIT					; ABORT
;
7200$:	.PRINT	#ERRADO				; TELL OVERFLOWED
	.EXIT					; ABORT
;

;
;
;
11000$:	MOVB	-(R0),R3			; DIGIT -> R3
	CMPB	R3,#40				; SPACE?
	BEQ	11300$				; YES -> POSSIBLE END
;
11040$:	MOVB	-(R1),R4			; DIGIT -> R4
	CMPB	R4,#40				; SPACE?
	BNE	11100$				; NO -> SKIP
	MOVB	#'0,R4				; MAKE '0'
;
11100$:	SUB	#'0,R3				; ASCII -> VALUE
	SUB	#'0,R4				; ASCII -> VALUE
	ADD	R3,R4				; DIGIT1+DIGIT2 -> R4
	ADD	OVERFL,R4			; ADD IN OVERFLOW
	CLR	OVERFL				; CLEAR OVERFLOW
;
11110$:	CMPB	R4,#9.				; OVERFLOWED?
	BLE	11120$				; NO -> SKIP
	INC	OVERFL				; UPDATE OVERFLOW COUNTER
	SUB	#10.,R4				; DOWN SUM BY 10
	BR	11110$				; LOOP
;
11120$:	ADD	#'0,R4				; VALUE -> ASCII
	MOVB	R4,(R0)				; STORE DIGIT
	CMP	R0,#BUF				; AT START OF BUFFER?
	BEQ	11200$				; YES -> SKIP
	CLC					; CLEAR 'C'
	RETURN					; EXIT
;
;
11200$:	TST	OVERFL				; ANY OVERFLOW?
	BNE	7200$				; YES -> ABORT
	SEC					; INDICATE DONE
	RETURN					; EXIT
;
;
11300$:	MOVB	#'0,R3				; SPACE -> '0'
	TST	OVERFL				; ANY OVERFLOW
	BNE	11040$				; YES -> ADD IN
	MOVB	-(R1),R4			; GET DIGIT
	CMPB	R4,#40				; SPACE
	BNE	11100$				; NO -> PROCESS
	SEC					; INDICATE AT EOS
	RETURN					; EXIT
;
;

;
;
;
12000$:	MOVB	-(R0),R3			; ACC DIGIT -> R3
	CMPB	R3,#40				; SPACE?
	BEQ	12300$				; YES -> POSSIBLE END
;
12040$:	MOVB	-(R1),R4			; AUX DIGIT -> R4
	CMPB	R4,#40				; SPACE?
	BNE	12100$				; NO -> SKIP
	MOVB	#'0,R4				; MAKE '0'
;
12100$:	SUB	#'0,R3				; ASCII -> VALUE
	SUB	#'0,R4				; ASCII -> VALUE
	ADD	OVERFL,R4			; ADD IN OVERFLOW
	CLR	OVERFL				; CLEAR OVERFLOW
	SUB	R4,R3				; ACC-AUX-OVERFL -> R3
;
12110$:	TST	R3				; UNDERFLOWED?
	BGE	12120$				; NO -> SKIP
	INC	OVERFL				; UPDATE OVERFLOW COUNTER
	ADD	#10.,R3				; ADD IN BORROW
	BR	12110$				; LOOP
;
12120$:	ADD	#'0,R3				; VALUE -> ASCII
	MOVB	R3,(R0)				; STORE DIGIT
	CMP	R0,#BUF				; AT START OF BUFFER?
	BEQ	12200$				; YES -> SKIP
	CLC					; CLEAR 'C'
	RETURN					; EXIT
;
;
12200$:	TST	OVERFL				; ANY OVERFLOW?
	BNE	7200$				; YES -> ABORT
	SEC					; INDICATE DONE
	RETURN					; EXIT
;
;
12300$:	MOVB	#'0,R3				; SPACE -> '0'
	TST	OVERFL				; ANY OVERFLOW
	BNE	12040$				; YES -> ADD IN
	MOVB	-(R1),R4			; GET DIGIT
	CMPB	R4,#40				; SPACE
	BNE	12100$				; NO -> PROCESS
	SEC					; INDICATE AT EOS
	RETURN					; EXIT
;
;

;
;
;
ZERCHK:	MOV	#BUF+BUFSIZ-5,R0		; R0 --> 'XX.XX'
	MOV	#10000$,R1			; R1 == COMPARE STRING
	CALL	COMPARE				; COMPARE TIME
	RETURN					; EXIT
;
10000$:	.ASCIZ	/ 0.00/				; ==> ACC IS ZERO
;
;

;
;
;
COMPAR:	CMPB	(R0)+,(R1)+			; MATCH?
	BNE	1000$				; NO -> SKIP
	TSTB	(R1)				; AT EOS?
	BNE	COMPAR				; NO -> LOOP
1000$:	RETURN					; EXIT
;
;
;

;
;
;
.SBTTL	VARIABLES AND MESSAGES
;
;
;
ACCSIG:	.WORD	0				; ACCUMULATOR SIGN
AUXSIG:	.WORD	0				; AUX ACC SIGN
OVERFL:	.WORD	0				; USED BY 'IFADD'
ARGBLK:	.WORD	3				; 3 ARGUMENTS
ARG1:	.WORD	1				; SIZE OF STRING
ARG2:	.WORD	1				; INPUT BUFFER
ARG3:	.WORD	1				; OUTPUT BUFFER
;
BUF:	.BLKB	BUFSIZ				; ACCUMULATOR
	.BYTE	0				; EOB TERMINATOR
BUFAUX:	.BLKB	BUFSIZ				; AUXILARY BUFFER
	.BYTE	0				; EOB TERMINATOR
;
;
.NLIST	BIN					; NO BINARY
.ENABL	LC					; LC ON
ERRPUT:	.ASCIZ	/"IFPUT"  - string too large for accumulator?/
ERRGET:	.ASCIZ	/"IFGET"  - string not large enough to hold accumulator?/
;
ERRADD:	.ASCIZ	/"IFADD"  - string too large for accumulator - aborting?/
ERRADA:	.ASCIZ	/"IFADD"  - illegal string for addition - aborting?/
ERRADO:	.ASCIZ	/"IFADD"  - overflowed accumulator - aborting?/
;
;
.END