.titl PDMl

;DoubleAdd(a,b)  -- a,b pointers to double-precision numbers
;DoubleAddV(a,i) -- a = a+i; where 'i' is a single-precision value
;DoubleSub(a,b) -- a-b
;DoubleShr(a) -- shift a right (arithmetically) by one bit
;DoubleCop(a,b) -- a←b
;MulDiv(a,b,c) returns (unsigned) a*b/c without losing intermediate precision
;MulMod(a,b,c) returns (unsigned) (a*b) rem c
;MulFull(a,b,v) v!0 and v!1 stuffed with (signed) double result a*b
;DivFull(a,b) -- returns (signed) a/b; where 'a' is a double-precision value
;Ugt(a,b) returns true if a>b unsigned 16-bit
;TGr(a,b) returns true if a>b using "true compare"
;BitBLT(table) -- calls BITBLT

savedPC=1
temp=2
extraArguments=3
SWAT=401		;should be 77400 for real SWAT call

	.srel
DoubleAdd:		.DoubleAdd
DoubleSub:		.DoubleSub
DoubleShr:		.DoubleShr
DoubleCop:		.DoubleCop
MulDiv:		.UMulDiv
MulMod:		.MulMod
MulFull:		.MulFull
DivFull:	.DivFull
DoubleAddV:		.DoubleAddImmediate
Ugt:			.Ugt
TGr:		.TGr
BitBLT:	.BitBLT
	.ent DoubleAdd,DoubleSub,DoubleShr,DoubleCop,MulDiv,MulMod,MulFull,DoubleAddV,DivFull,Ugt,TGr,BitBLT

	.nrel


	0

.BitBLT: sta 3 savedPC,2
	sta 2,saved2
	mov 0,2
	sub 1,1	;AC1←0
	BITBLT
	lda 2,saved2
	lda 3 savedPC,2
	jmp 1,3
 
.DoubleAdd:
	sta 3 savedPC,2
	sta 1 temp,2			; => first word of arg 2
	mov 1,3
	lda 1,1,3			; word 2 of arg 2
	mov 0 3
	lda 0,1,3			; word 2 of arg 1
	addz 1,0
	sta 0,1,3			; word 2 of arg 1
	lda 0,0,3			; word 1 of arg 1
	lda 1 @temp,2			; word 1 of arg 2
	mov 0,0,szc
	 inc 0,0
	add 1,0
	sta 0,0,3			; word 1 of arg 1
	lda 3 savedPC,2
	jmp 1,3


.DoubleAddImmediate:
	sta 3 savedPC,2
	sta	2,saved2
        mov 0 3			; save arg 1
	movl# 1 1,snc		; generate high order word of i
	sub 2 2,skp		; 0 if positive
	adc 2 2			; -1 if negative
        lda 0 1 3		; word 2 of arg 1
        addz 1 0 szc		; add integer
	 inc	2,2		; add in carry
        sta 0 1 3		; replace word 2 of arg 1
	lda 0 0 3		; word 1 of arg 1
	add 2 0			; result to ac0
	sta 0 0 3		; store result
	lda	2,saved2
        lda 3 savedPC,2
        jmp 1 3

saved2:	0

.DoubleSub:
	sta 3 savedPC,2
	sta 1 temp,2			; => first word of arg 2
	mov 1 3
	lda 1,1,3			; word 2 of arg 2
	mov 0 3
	lda 0,1,3			; word 2 of arg 1
	subz 1,0
	sta 0,1,3			; word 2 of arg 1
	lda 0,0,3			; word 1 of arg 1
	lda 1 @temp,2			; word 1 of arg 2
	mov 0,0,szc
	 inc 0,0
	adc 1,0
	sta 0,0,3			; word 1 of arg 1
	lda 3 savedPC,2
	jmp 1,3



.DoubleShr:
	sta 3 savedPC,2
	MOV	0,3			;SAVE POINTER TO NUMBER
	LDA	0,0,3			;HIGH ORDER PART
	MOVL#	0,0,SZC			;TEST SIGN BIT
	 MOVOR	 0,0,SKP		;SHIFT IN A 1
	MOVZR	0,0			;SHIFT IN A 0
	STA	0,0,3
	LDA	1,1,3			;LOW ORDER
	MOVR	1,1			;SHIFT CARRY BIT IN
	STA	1,1,3			;AND REPLACE
	lda 3 savedPC,2
	jmp 1,3				;RETURN INTEGER PART...


.DoubleCop:
	sta 3 savedPC,2
	mov 0 3				; destination address
	sta 1 temp,2
	lda 0 @temp,2			; high order
	sta 0 0,3			; save it
	isz temp,2
	lda 0 @temp,2
	sta 0 1,3			; low order
	lda 3 savedPC,2
	jmp 1,3				;RETURN INTEGER PART...


.UMulDiv:
	sta 3 savedPC,2
	mov 2,3				; stack pointer
	mov 0 2				; a
	lda 0 extraArguments,3			; c
	movzr 0 0			; c/2 for rounding
	mul				; go multiply
	lda 2 extraArguments,3			; c
	div
	 mov# 0,0
	mov 1 0				; answer
	mov 3 2
	lda 3 savedPC,2
	jmp 1,3

.MulMod:
	sta 3 savedPC,2
	mov 2,3				; stack pointer
	mov 0 2				; a
	sub 0 0
	mul				; go multiply
	lda 2 extraArguments,3			; c
	div
	 mov# 0,0
	mov 3 2		;div returns remainder in AC0
	lda 3 savedPC,2
	jmp 1,3

.MulFull:
;this routine uses the following trick.  In two's complement notation, -k
; is represented as 2↑16 - k.  Thus, for example, an unsigned multiply
; of (2↑16 - k)*(2↑16 - m) would yield 2↑32 - (k + m)*2↑16 + k*m.
; This routine calculates the correction factor k + m and adds it to the
; high order word of the product.  Similarly if only one operand is negative.
	sta 3 savedPC,2
	mov 2 3			; stack pointer
	mov 0 2			; a

	movl#		1,1,snc	; leave a as correction factor if b is negative
	 sub		0,0		; otherwise zero correction factor
	movl#		2,2,szc		; if a is negative ...
	 add		1,0		; ... add b to the correction factor
	sta		0,temp,3	; finally save correction
	sub		0,0		; and clear 0 for multiplication
	mul
	lda		2,temp,3	;pick up correction factor
	sub		2,0		; subtract it from high order word
	lda		2,extraArguments,3
	sta		0,0,2		;give high order to user
	sta		1,1,2		; and low order
	mov		3,2
	lda		3,savedPC,2
	jmp		1,3
	

.DivFull:
	sta 3 savedPC,2
	mov 2 3			; stack pointer
	sta	1,temp,3	; stash divisor for now
	movz	0,2		; => dividend (and clear carry)
	lda	0,0,2		; high order dividend
	lda	1,1,2		; low order dividend
	lda	2,temp,3	; divisor again
	movl#	0,0,snc	; skip if dividend is negative
	 jmp	.+5		; don't bother with next if positive

	neg	1,1,szr		; negate double word dividend
	com	0,0,skp
	neg	0,0
	negz	2,2		; also negate divisor (leave carry clear)

	movl#	2,2,szc		; is divisor negative?
	 nego	2,2		; if so, negate it and set carry

	div			; div preserves carry
	 SWAT			; SWAT
	mov	1,0,szc		; answer and if carry was set ...
	 neg	0,0		; ... negate it

	mov 3 2
	lda 3 savedPC,2
	jmp 1 3

.Ugt:	sgtu 0,1
	mkzero 0,0,skp
	mkminusone 0,0
	jmp 1,3

.TGr:	sta 3 savedPC,2
	subzr 3,3
	and 1,3
	addl 0,3
	adc# 1,0,snc
	 sub 0,0,skp		; false
	adc 0,0			; true
	lda 3 savedPC,2
	jmp 1,3

	.END