DataMuseum.dk

top - download

    Length: 2560 (0xa00)
    Types: TextFile
    Names: »FPRLOP.SRC«

└─⟦c9df7130d⟧ Bits:30005915 Pascal MT+ Release 5.2 (Jet-80)
    └─ ⟦this⟧ »FPRLOP.SRC« 

TextFile

; floating point relational operators
;
	NAME FPRLOP
	ENTRY FPEQ,FPNEQ,FPLTE,FPLT,FPGTE,FPGT
	INCLUDE FPINIT.SRC
;
frelop:	macro	flags		;;do a relop and check the correct flags
	call	cmpops		;;compare the operands
	ani	flags		;;check the return flags
	jr	relfin		;;...and finish the relop
	endmac
fpgt:	frelop	gtbit		;check the greater than bit
fpgte:	frelop	gtbit+eqbit	;check the greater than and equal to bits
fplt:	frelop	ltbit		;check the less than bit
fplte:	frelop	ltbit+eqbit	;check the less than and equal to bits
fpeq:	frelop	eqbit		;check equal to bit
fpneq:	frelop	ltbit+gtbit	;check less than and greater than bits
relfin:	mvi	a,0		;clear accumulator
	rz			;return false if status bit wasn't set
	stc			;otherwize set the carry bit
	ret			;and return
;
; compare two floating point operands
;
cmpops:	push	x		;save ix
	lxi	x,6		;make ix point to bottom of op2
	xra	a		;clear the carry and...
	dadx	s
	mov	c,6(x)		;get sign of op1
	mov	e,2(x)		;get sign of op2
	mov	a,c
	xra	e		;check for like signs
	jm	dfsgns		;no, different signs
	mov	a,5(x)		;check for op1 = 0
	ora	4(x)
	ora	c
	jrnz	cmp2		;no, it's non-zero
	mvi	7(x),080h	;yes, set exponent to -128
cmp2:	mov	a,1(x)		;check for op2 = 0
	ora	0(x)
	ora	e
	jrnz	cmp3		;no, it's non-zero
	mvi	3(x),080h	;yes, set exponent to -128
cmp3:	mov	a,7(x)		;yes, get exponents and toggle
	xri	80h		;the high order bit in order to
	mov	b,a		;check the relative magnitudes
	mov	a,3(x)		;now do op2
	xri	80h
	cmp	b		;check against op1.exponent
	jrnz	fpdiff		;they're different
	mov	a,e		;get high byte of op2's mantissa
	cmp	c		;check against op1's
	jrnz	fpdiff		;they're diferent
	mov	a,1(x)		;get middle byte of op2's mantissa
	cmp	5(x)		;compare against op1's
	jrnz	fpdiff
	mov	a,0(x)		;get low byte of op2's mantissa
	cmp	4(x)		;check against op1's
	jrnz	fpdiff
	mvi	a,eqbit		;op1 = op2
	jr	cmpdon		;done comparing
dfsgns:	slar	e		;get sign bit of op2 into carry
	jr	fpdf1		;don't check signs
fpdiff:	bit	sign,c		;check sign bit
	jrz	fpdf1		;both numbers +ive
	cmc			;both numbers negative, reverse test
fpdf1:	jrc	obig		;if carry then op1 > op2
	mvi	a,ltbit		;op1 < op2
	jr	cmpdon
obig:	mvi	a,gtbit		;op1 > op2
cmpdon:	pop	x		;restore ix
	pop	d		;get return address
	pop	h		;get second return address
	pop	b		;kill op2
	pop	b
	pop	b		;kill op1
	xthl			;restore second return address
	xchg			;hl <- return address
	pchl			;return
;
;
; STATUS BITS
EQBIT:	EQU	1		;HL = DE
LTBIT:	EQU	2		;HL < DE
GTBIT:	EQU	4		;HL > DE
«eof»