.TITLE	PLUS		
; JEFFREY KODOSKY	ARL	JUL76
;
; FSUBR
; ENTRY:	1 ARG
; EXIT:		1 ARG		<N>
; ERRORS:	I4, HARD MATH ERROR (SUPPRESSED WITH Z SWITCH
;			FOR LEGAL INFINITY OPERATIONS. INFINITY
;			MINUS INFINITY IS ALWAYS ILLEGAL)
; CALLS:	EVLIS
;		CAR
;		CDR
;		ATM2N
;		I2ATM
;		IDR
;		IR
;		GET
;		ADR
;		R2ATM
	.GLOBL	PLUS,ZPLUS,APVAL,ZSW,QI4ERR,QGET,QEVLIS,QCDR
	.GLOBL	QCAR,QATM2N,QI2ATM,QIDR,QIR,QADR,QR2ATM
PLUS:	QEVLIS		;EVALUATE LIST OF ARGUMENTS
	CLR	(PC)+	;FLAG: 0=INT,>0=REAL,<0=INF
ACFLAG:	.WORD	0
	MOV	@R5,R3	;GET FIRST ARGUMENT
	BEQ	PLUS00	;JUMP IF NO ARGS
	QCDR
	MOV	R3,-(R5)
	QCAR
	QATM2N
	BCC	PLUS01	;JUMP IF AC IS TO BE INTEGER
	INC	ACFLAG	;SIGNAL REAL AC
	BIT	#77777,@SP	;CHECK FOR INF
	BNE	PLUS01
	TST	2(SP)
	BEQ	PLUS01	;JUMP IF ZERO
	NEG	ACFLAG	;SIGNAL INF IN AC
	BR	PLUS13	;JUMP TO SEE IF ITS ALLOWED
PLUS00:	MOV	(R5)+,-(SP)	;POP NIL AND MAKE INTEGER 0
PLUS98:	QI2ATM
	.WORD	0
PLUS99:	CMP	ACFLAG,(R5)+	;TST ACFLAG
	BEQ	PLUS98
	QR2ATM
	.WORD	0
	CMP	(SP)+,(SP)+
PLUS01:	MOV	@R5,R3	;GET NEXT NUMBER
	BEQ	PLUS99	;JUMP IF NO MORE
	QCDR
	MOV	R3,-(R5)
	QCAR
	QATM2N
	BCS	PLUS04	;JUMP IF NEXT NUMBER IS REAL
	TST	ACFLAG
	BMI	PLUS01	;JUMP IF AC IS INFINITY ALREADY
	BNE	PLUS23	;JUMP IF AC IS REAL AND ARG IS INT
	ADD	(SP)+,@SP	;ELSE ADD INTEGERS
	BVC	PLUS01
	CLR	-(SP)	;CONVERT TO REAL ON OVERFLOWS
	TST	2(SP)
	BMI	.+4
	DEC	@SP	;SIGN EXTEND HIGH WORD
	QIDR
	INC	ACFLAG	;NOTE REAL AC
	BR	PLUS01
PLUS04:	BIT	#77777,@SP	;ARG IS REAL, CHECK IF INF
	BNE	PLUS17	;JUMP IF NORMAL REAL
	TST	2(SP)
	BEQ	PLUS01-2;ZERO IS TRIVIAL
	TST	ACFLAG	;ARG IS INFINITY, CHECK AC
	BPL	PLUS07
	CMP	@SP,4(SP)	;AC IS INF, IS THIS A LEGAL OPERATION?
	BEQ	PLUS01-2	;YES, AC IS UNCHANGED
PLUS06:	QI4ERR		;ELSE HARD ERROR (REGARDLESS OF ZSW)
PLUS07:	BEQ	PLUS10	;JUMP IF AC IS INTEGER
	MOV	(SP)+,2(SP)	;MOVE INF INTO AC
	MOV	(SP)+,2(SP)
	NEG	ACFLAG
	BR	PLUS13	;JUMP TO CHECK IF INF ALLOWED
PLUS10:	MOV	2(SP),4(SP)	;MOV INF INTO AC
	MOV	(SP)+,@SP
	DEC	ACFLAG
PLUS13:	ROOM	3	;CHECK IF INF ALLOWED
	MOV	APVAL,-(R5)
	MOV	ZSW,-(R5)
	QGET
	TST	(R5)+
	BEQ	PLUS06	;JUMP IF NOT
	MOV	#-1,2(SP)	;MAKE CLEAN INF
	BR	PLUS01
PLUS17:	TST	ACFLAG
	BEQ	PLUS20	;JUMP IF ARG REAL AND AC INT
	BMI	PLUS01-2;JUMP IF AC INF AND ARG REAL: AC UNCHANGED
PLUS18:	QADR		;ELSE ADD REALS
	BCC	PLUS01
	NEG	ACFLAG
	BR	PLUS13	;CHECK IF INF OK ON OVERFLOWS
PLUS20:	MOV	4(SP),R3;SWITCH AC AND ARG
	MOV	2(SP),4(SP)
	MOV	(SP)+,@SP
	MOV	R3,-(SP)
	INC	ACFLAG
PLUS23:	QIR		;CONVERT TO REAL
	BR	PLUS18	;AND ADD REALS
ZPLUS=.-PLUS
	.END