commit cc54fff8b0700ad5390ebad7993521dbf0e3a655
parent c467837e5bc762e09a5ff6471e16c8e09add24e0
Author: Commit-Bot <unknown>
Date: Mon, 5 Jul 2010 15:21:50 +0000
Automatic commit from picoLisp.tgz, From: Mon, 05 Jul 2010 15:21:50 GMT
Diffstat:
8 files changed, 450 insertions(+), 130 deletions(-)
diff --git a/CHANGES b/CHANGES
@@ -1,4 +1,5 @@
* XXsep10 picoLisp-3.0.4
+ Faster bignum division (64-bit)
* 29jun10 picoLisp-3.0.3
'assert' function
diff --git a/README b/README
@@ -1,4 +1,4 @@
-12nov09abu
+05jul10abu
(c) Software Lab. Alexander Burger
Perfection is attained
@@ -53,7 +53,7 @@ You can download the latest release version at
(2) As an application server framework, PicoLisp provides for
- Database Management
+ NoSQL Database Management
Index trees
Object local indexes
Entity/Relation classes
diff --git a/ReleaseNotes b/ReleaseNotes
@@ -1,7 +1,11 @@
-29jun10abu
+04jul10abu
(c) Software Lab. Alexander Burger
Release Notes for picoLisp-3.0.4
================================
+A. In the 64-bit version bignum division is now faster by a factor between 20
+ and 60. That version had used an inefficient algorithm (bitwise shifts),
+ which was now replaced by Knuth's wordwise division algorithm (as is used
+ 32-bit version).
diff --git a/lib/boss.l b/lib/boss.l
@@ -1,4 +1,4 @@
-# 26feb09abu
+# 01jul10abu
# (c) Software Lab. Alexander Burger
# "tmp+" "tmp-"
@@ -12,5 +12,5 @@
(de boss @
(out "tmp+" (pr (rest))) )
-(de reply Exe #-> any
+(de reply Exe #> any
(out "tmp-" (pr (eval Exe))) )
diff --git a/lib/tags b/lib/tags
@@ -1,13 +1,13 @@
! (2869 . "@src64/flow.l")
$ (2971 . "@src64/flow.l")
-% (2253 . "@src64/big.l")
-& (2474 . "@src64/big.l")
-* (2072 . "@src64/big.l")
-*/ (2129 . "@src64/big.l")
-+ (1854 . "@src64/big.l")
-- (1892 . "@src64/big.l")
+% (2570 . "@src64/big.l")
+& (2791 . "@src64/big.l")
+* (2389 . "@src64/big.l")
+*/ (2446 . "@src64/big.l")
++ (2171 . "@src64/big.l")
+- (2209 . "@src64/big.l")
-> (3820 . "@src64/subr.l")
-/ (2194 . "@src64/big.l")
+/ (2511 . "@src64/big.l")
: (2898 . "@src64/sym.l")
:: (2922 . "@src64/sym.l")
; (2824 . "@src64/sym.l")
@@ -22,8 +22,8 @@ $ (2971 . "@src64/flow.l")
=T (2168 . "@src64/subr.l")
> (2254 . "@src64/subr.l")
>= (2284 . "@src64/subr.l")
->> (2308 . "@src64/big.l")
-abs (2398 . "@src64/big.l")
+>> (2625 . "@src64/big.l")
+abs (2715 . "@src64/big.l")
accept (139 . "@src64/net.l")
adr (609 . "@src64/main.l")
alarm (483 . "@src64/main.l")
@@ -41,7 +41,7 @@ assoc (2907 . "@src64/subr.l")
at (2128 . "@src64/flow.l")
atom (2372 . "@src64/subr.l")
bind (1381 . "@src64/flow.l")
-bit? (2415 . "@src64/big.l")
+bit? (2732 . "@src64/big.l")
bool (1743 . "@src64/flow.l")
box (841 . "@src64/flow.l")
box? (999 . "@src64/sym.l")
@@ -103,7 +103,7 @@ cut (1797 . "@src64/sym.l")
date (2114 . "@src64/main.l")
dbck (2092 . "@src64/db.l")
de (549 . "@src64/flow.l")
-dec (2006 . "@src64/big.l")
+dec (2323 . "@src64/big.l")
def (473 . "@src64/flow.l")
default (1661 . "@src64/sym.l")
del (1852 . "@src64/sym.l")
@@ -139,18 +139,18 @@ flush (4849 . "@src64/io.l")
fold (3345 . "@src64/sym.l")
for (2247 . "@src64/flow.l")
fork (3269 . "@src64/flow.l")
-format (1772 . "@src64/big.l")
+format (2089 . "@src64/big.l")
free (2034 . "@src64/db.l")
from (3342 . "@src64/io.l")
full (1066 . "@src64/subr.l")
fun? (734 . "@src64/sym.l")
gc (446 . "@src64/gc.l")
-ge0 (2374 . "@src64/big.l")
+ge0 (2691 . "@src64/big.l")
get (2750 . "@src64/sym.l")
getd (742 . "@src64/sym.l")
getl (3032 . "@src64/sym.l")
glue (1234 . "@src64/sym.l")
-gt0 (2385 . "@src64/big.l")
+gt0 (2702 . "@src64/big.l")
head (1807 . "@src64/subr.l")
heap (538 . "@src64/main.l")
hear (3064 . "@src64/io.l")
@@ -161,7 +161,7 @@ if (1824 . "@src64/flow.l")
if2 (1843 . "@src64/flow.l")
ifn (1884 . "@src64/flow.l")
in (3988 . "@src64/io.l")
-inc (1939 . "@src64/big.l")
+inc (2256 . "@src64/big.l")
index (2611 . "@src64/subr.l")
info (2437 . "@src64/main.l")
intern (875 . "@src64/sym.l")
@@ -188,7 +188,7 @@ loop (2190 . "@src64/flow.l")
low? (3217 . "@src64/sym.l")
lowc (3247 . "@src64/sym.l")
lst? (2389 . "@src64/subr.l")
-lt0 (2363 . "@src64/big.l")
+lt0 (2680 . "@src64/big.l")
lup (2226 . "@src64/sym.l")
made (1098 . "@src64/subr.l")
make (1079 . "@src64/subr.l")
@@ -271,7 +271,7 @@ pwd (2364 . "@src64/main.l")
queue (1920 . "@src64/sym.l")
quit (1033 . "@src64/main.l")
quote (141 . "@src64/flow.l")
-rand (2642 . "@src64/big.l")
+rand (2959 . "@src64/big.l")
range (988 . "@src64/subr.l")
rank (2970 . "@src64/subr.l")
raw (461 . "@src64/main.l")
@@ -286,7 +286,7 @@ rot (848 . "@src64/subr.l")
rpc (4998 . "@src64/io.l")
run (331 . "@src64/flow.l")
sect (2515 . "@src64/subr.l")
-seed (2627 . "@src64/big.l")
+seed (2944 . "@src64/big.l")
seek (1159 . "@src64/apply.l")
send (1150 . "@src64/flow.l")
seq (1090 . "@src64/db.l")
@@ -343,9 +343,9 @@ with (1349 . "@src64/flow.l")
wr (4982 . "@src64/io.l")
xchg (1538 . "@src64/sym.l")
xor (1720 . "@src64/flow.l")
-x| (2554 . "@src64/big.l")
+x| (2871 . "@src64/big.l")
yield (2724 . "@src64/flow.l")
yoke (1187 . "@src64/subr.l")
zap (1063 . "@src64/sym.l")
zero (1631 . "@src64/sym.l")
-| (2514 . "@src64/big.l")
+| (2831 . "@src64/big.l")
diff --git a/src/big.c b/src/big.c
@@ -1,4 +1,4 @@
-/* 19jun10abu
+/* 02jul10abu
* (c) Software Lab. Alexander Burger
*/
@@ -106,11 +106,10 @@ void bigAdd(any dst, any src) {
} while (isNum(src = cdr(numCell(src))));
break;
}
- if ((n = carry + unDig(src)) >= carry)
+ if ((n = carry + unDig(src)) >= carry) {
carry = unDig(dst) > (n += unDig(dst));
- else
- n = unDig(dst);
- setDig(dst,n);
+ setDig(dst,n);
+ }
src = cdr(numCell(src));
dst = cdr(numCell(x = dst));
}
@@ -356,11 +355,10 @@ static any bigDiv(any u, any v, bool rem) {
y = v;
carry = unDig(y) > num(setDig(x, unDig(y) + unDig(x)));
while (x = cdr(numCell(x)), isNum(y = cdr(numCell(y)))) {
- if ((n = carry + unDig(y)) >= carry)
+ if ((n = carry + unDig(y)) >= carry) {
carry = unDig(x) > (n += unDig(x));
- else
- n = unDig(x);
- setDig(x,n);
+ setDig(x,n);
+ }
}
setDig(x, carry + unDig(x));
}
diff --git a/src64/big.l b/src64/big.l
@@ -1,4 +1,4 @@
-# 11jun10abu
+# 03jul10abu
# (c) Software Lab. Alexander Burger
### Destructive primitives ###
@@ -32,7 +32,7 @@
ld A ((E) DIG) # Digit in null-tail
test A (hex "F000000000000000") # Fit in short number?
if nz # No
- ld (C) ZERO # Trim short-tail
+ ld ((E) BIG) ZERO # Trim null-tail
else
shl A 4 # Make short number
or A CNT
@@ -54,6 +54,7 @@
shr A 3
jmp boxNumA_A # Return bignum
end
+: twiceBigA_A
push A # Save bignum
ld C (A DIG) # Lowest digit
shl C 1 # Shift left
@@ -1040,8 +1041,8 @@
pop X
jmp zapZeroA_A # Remove leading zeroes
-# Divide two (unsigned) numbers
-(code 'divuAE_AC 0)
+# Divide two (unsigned) numbers (Knuth Vol.2, p.257)
+(code 'divuAE_A 0)
cnt A # A short?
if nz # Yes
cnt E # E also short?
@@ -1052,123 +1053,439 @@
div E # Divide
shl A 4 # Make short number
or A CNT # Quotient
- shl C 4
- or C CNT # Remainder
ret
end
- ld C A
ld A ZERO # Else return zero
ret
end
+ push X
+ push Y
+ push Z
link
push ZERO # <L III> Quotient
- push A # <L II> Dividend
- push E # <L I> Divisor
+ push A # <L II> Dividend 'u'
+ push E # <L I> Divisor 'v'
link
- # Calculate dividend's bit count
- ld C 0 # Counter
+ ld E (A DIG) # Copy dividend
+ call boxNumE_E
+ ld (L II) E # Save new 'u'
+ ld X 0 # Calculate 'm'
do
- cnt (A BIG) # Last cell?
+ ld A (A BIG) # Next cell of 'u'
+ cnt A # Last one?
while z # No
- add C 64 # Increment by digit size
- ld A (A BIG)
+ call boxNum_C # Copy next digit
+ ld (C DIG) (A DIG)
+ ld (E BIG) C
+ ld E C
+ inc X # Increment 'm'
loop
- zero (A BIG) # Last short zero?
- if eq # Yes
- ld A (A DIG) # Take last digit
- else
- add C 64 # Increment for last digit
- ld A (A BIG) # Take last short
+ zero A # Trailing short zero?
+ if ne # No
shr A 4 # Normalize
- end
- do
- inc C # Increment counter
- shr A 1 # More bits?
- until z # No
- # Subtract divisor's bit count
- cnt E # E short?
+ call boxNum_C # Append in new cell
+ ld (C DIG) A
+ ld (E BIG) C
+ ld E C
+ inc X # Increment 'm'
+ end
+ ld Z E # Keep last cell in Z
+ push X # <L -I> 'm'
+ ld Y 0 # Last cell
+ ld C 0 # Calculate 'n'
+ ld A (L I) # Get divisor
+ cnt A # Short?
if nz # Yes
- shr E 4 # Normalize
- do
- dec C # Decrement counter
- shr E 1 # More bits?
- until z # No
+ shr A 4 # Normalize
+ call boxNumA_A # Make big
+ ld (L I) A # Save new 'v'
+ ld X A # Keep in X
+ inc C # 'n' = 1
else
+ call boxNum_X # Copy divisor
+ ld (X DIG) (A DIG)
+ ld (L I) X # Save new 'v'
do
- cnt (E BIG) # Last cell?
+ inc C # Increment 'n'
+ ld A (A BIG) # Next cell of 'v'
+ cnt A # Last one?
while z # No
- sub C 64 # Decrement by digit size
- ld E (E BIG)
+ ld E (A DIG) # Copy next digit
+ call boxNumE_E
+ ld (X BIG) E # Append to 'v'
+ ld Y X # Keep last cell
+ ld X E
+ dec (L -I) # Decrement 'm'
loop
- zero (E BIG) # Last short zero?
- if eq # Yes
- ld E (E DIG) # Take last digit
+ zero A # Trailing short zero?
+ if ne # No
+ shr A 4 # Normalize
+ call boxNumA_A # Append in new cell
+ ld (X BIG) A # Append to 'v'
+ ld Y X # Set last cell
+ ld X A
+ dec (L -I) # Decrement 'm'
+ inc C # Increment 'n'
+ end
+ null (L -I) # 'm' negative?
+ js divUnder # Yes
+ end
+ push C # <L -II> 'n'
+ ld A 0 # Append additional cell
+ call boxNumA_A
+ ld (Z BIG) A
+ ld Z 0 # Calculate 'd'
+ do
+ null (X DIG) # Max left position?
+ while ns # No
+ ld A (L II) # Shift left 'u'
+ call twiceBigA_A
+ ld A (L I) # and 'v'
+ call twiceBigA_A
+ inc Z # Increment 'd'
+ loop
+ push Z # <L -III> 'd'
+ push (X DIG) # <L -IV> 'v1'
+ null Y # Last cell?
+ if nz # Yes
+ ld Y (Y DIG) # Yes: Get digit
+ end
+ push Y # <L -V> Last cell 'v2'
+ push 0 # <S> tmp
+ do
+ ld C (L -I) # Get 'm'
+ ld X (L II) # and 'u'
+ do
+ sub C 1
+ while ge
+ ld X (X BIG) # Index X -> u
+ loop
+ ld E (L -II) # Get 'n' in E
+ ld Y X
+ ld C 0 # 'u1' in C
+ ld A 0 # 'u2' in A
+ do
+ ld (S) A # Save 'u3' im tmp
+ ld A C # Shift words
+ ld C (Y DIG)
+ ld Y (Y BIG)
+ sub E 1
+ until lt
+ ld Z C # Keep 'r' = 't' in Z,Y
+ ld Y A
+ cmp C (L -IV) # 'u1' = 'v1'?
+ if ne # No
+ div (L -IV) # 'q' = 't' / 'v1'
else
- sub C 64 # Decrement for last digit
- ld E (E BIG) # Take last short
- shr E 4 # Normalize
+ ld A -1 # 'q' = MAX
end
+ ld E A # Save 'q' in E
+ mul (L -IV) # 'q' * 'v1'
+ sub Y A # Subtract from 'r'
+ subc Z C
do
- dec C # Decrement counter
- shr E 1 # More bits?
- until z # No
- end
- push C # <L -I> Shift offsets
- inc C
- push C # <L -II>
- sub (L -I) 1 # Any shift?
- if ns # Yes
- ld A (L I) # Get divisor
- call shluA_A # Shift (non-destructive)
- ld (L I) A
- ld C (L -I) # Shift offset
+ null Z # 'r' <= MAX?
+ while z # Yes
+ ld A E # 'q' * 'v2'
+ mul (L -V)
+ cmp C Y # > lo(r), 'u3'?
+ while ge
+ if eq
+ cmp A (S) # 'u3' in tmp
+ break le
+ end
+ dec E # Yes: Decrement 'q'
+ add Y (L -IV) # Increment 'r' by 'v1'
+ addc Z 0
+ loop
+ ld (S) E # Save 'q' in tmp
+ ld Z X # Get 'x'
+ ld Y (L I) # 'v'
+ ld A E # and 'q'
+ mul (Y DIG) # Multiply lowest digit
+ sub (Z DIG) A # Subtract from 'x'
+ addc C 0
+ ld E C # Borrow in E
do
- cmp C 64 # More than 64 bits?
- while ge # Yes
- sub C 64 # Decrement shift count by digit size
- ld E 0 # Cons zero
- call consNumEA_A
+ ld Y (Y BIG) # More in 'v'?
+ cnt Y
+ while z # Yes
+ ld Z (Z BIG) # Next 'x'
+ ld A (S) # Multiply with 'q' in tmp
+ mul (Y DIG) # 't' in D
+ sub (Z DIG) E # Subtract borrow
+ ld E 0
+ rcl E 1 # New borrow
+ sub (Z DIG) A # Subtract lo(t)
+ addc E C # Adjust borrow plus hi(t)
loop
- ld (L I) A # Save shifted divisor
- ld (L -I) C # Save remaining count
+ null E # Borrow?
+ if nz # Yes
+ ld Z (Z BIG) # Next 'x'
+ sub (Z DIG) E # Subtract borrow
+ if c
+ dec (S) # Decrement 'q'
+ null (L -I) # 'm' ?
+ if nz # Yes
+ ld Y (L I) # Get 'v'
+ add (X DIG) (Y DIG) # 'x' += 'v'
+ push F # Save carry
+ do
+ ld X (X BIG) # More?
+ ld Y (Y BIG)
+ cnt Y
+ while z # Yes
+ pop F # Get carry
+ addc (X DIG) (Y DIG) # Add digits
+ push F
+ loop
+ pop F # Final carry
+ addc (X DIG) 0
+ end
+ end
+ end
+ ld A (S) # Get 'q'
+ ld C (L III) # Quotient so far
+ call consNumAC_A # Prepend 'q'
+ ld (L III) A # Store result
+ sub (L -I) 1 # Decrement 'm'
+ until lt
+ ld A (L III) # Return quotient in A
+ call zapZeroA_A
+: divDone
+ drop
+ pop Z
+ pop Y
+ pop X
+ ret
+: divUnder # Dividend smaller than divisor
+ ld A ZERO # Return quotient 0
+ jmp divDone
+
+# Remainder of two (unsigned) numbers
+(code 'remuAE_A 0)
+ cnt A # A short?
+ if nz # Yes
+ cnt E # E also short?
+ if nz # Yes
+ shr A 4 # Normalize A
+ ld C 0
+ shr E 4 # Normalize E
+ div E # Divide
+ ld A C # Get remainder
+ shl A 4 # Make short number
+ or A CNT # Quotient
+ ret
+ end
+ ret # Remainder is in A
+ end
+ push X
+ push Y
+ push Z
+ link
+ push ZERO # <L III> Quotient
+ push A # <L II> Dividend 'u'
+ push E # <L I> Divisor 'v'
+ link
+ ld E (A DIG) # Copy dividend
+ call boxNumE_E
+ ld (L II) E # Save new 'u'
+ ld X 0 # Calculate 'm'
+ do
+ ld A (A BIG) # Next cell of 'u'
+ cnt A # Last one?
+ while z # No
+ call boxNum_C # Copy next digit
+ ld (C DIG) (A DIG)
+ ld (E BIG) C
+ ld E C
+ inc X # Increment 'm'
+ loop
+ zero A # Trailing short zero?
+ if ne # No
+ shr A 4 # Normalize
+ call boxNum_C # Append in new cell
+ ld (C DIG) A
+ ld (E BIG) C
+ ld E C
+ inc X # Increment 'm'
+ end
+ ld Z E # Keep last cell in Z
+ push X # <L -I> 'm'
+ ld Y 0 # Last cell
+ ld C 0 # Calculate 'n'
+ ld A (L I) # Get divisor
+ cnt A # Short?
+ if nz # Yes
+ shr A 4 # Normalize
+ call boxNumA_A # Make big
+ ld (L I) A # Save new 'v'
+ ld X A # Keep in X
+ inc C # 'n' = 1
+ else
+ call boxNum_X # Copy divisor
+ ld (X DIG) (A DIG)
+ ld (L I) X # Save new 'v'
do
- sub (L -I) 1 # Shift remaining bits?
- while ns # Yes
- call twiceA_A # Shift divisor left (destructive)
- ld (L I) A # Save again
+ inc C # Increment 'n'
+ ld A (A BIG) # Next cell of 'v'
+ cnt A # Last one?
+ while z # No
+ ld E (A DIG) # Copy next digit
+ call boxNumE_E
+ ld (X BIG) E # Append to 'v'
+ ld Y X # Keep last cell
+ ld X E
+ dec (L -I) # Decrement 'm'
loop
+ zero A # Trailing short zero?
+ if ne # No
+ shr A 4 # Normalize
+ call boxNumA_A # Append in new cell
+ ld (X BIG) A # Append to 'v'
+ ld Y X # Set last cell
+ ld X A
+ dec (L -I) # Decrement 'm'
+ inc C # Increment 'n'
+ end
+ null (L -I) # 'm' negative?
+ js remUnder # Yes
end
+ push C # <L -II> 'n'
+ ld A 0 # Append additional cell
+ call boxNumA_A
+ ld (Z BIG) A
+ ld Z 0 # Calculate 'd'
do
- sub (L -II) 1 # Division steps?
- while ns # Yes
- ld A (L III) # Get quotient
- call twiceA_A # Shift (destructive)
- ld (L III) A
- ld E (L II) # Get dividend
- ld A (L I) # and divisor
- call cmpuAE_F # Divisor <= dividend?
- if le # Yes
- ld A (L II) # Subtract divisor from dividend
- ld E (L I)
- call subuAE_A
- ld (L II) A # Save dividend
- ld A (L III) # Quotient
- cnt A # Short?
- if nz # Yes
- add B (hex "10") # Increment short
- ld (L III) A
- else
- inc (A DIG) # Increment digit
+ null (X DIG) # Max left position?
+ while ns # No
+ ld A (L II) # Shift left 'u'
+ call twiceBigA_A
+ ld A (L I) # and 'v'
+ call twiceBigA_A
+ inc Z # Increment 'd'
+ loop
+ push Z # <L -III> 'd'
+ push (X DIG) # <L -IV> 'v1'
+ null Y # Last cell?
+ if nz # Yes
+ ld Y (Y DIG) # Yes: Get digit
+ end
+ push Y # <L -V> Last cell 'v2'
+ push 0 # <S> tmp
+ do
+ ld C (L -I) # Get 'm'
+ ld X (L II) # and 'u'
+ do
+ sub C 1
+ while ge
+ ld X (X BIG) # Index X -> u
+ loop
+ ld E (L -II) # Get 'n' in E
+ ld Y X
+ ld C 0 # 'u1' in C
+ ld A 0 # 'u2' in A
+ do
+ ld (S) A # Save 'u3' im tmp
+ ld A C # Shift words
+ ld C (Y DIG)
+ ld Y (Y BIG)
+ sub E 1
+ until lt
+ ld Z C # Keep 'r' = 't' in Z,Y
+ ld Y A
+ cmp C (L -IV) # 'u1' = 'v1'?
+ if ne # No
+ div (L -IV) # 'q' = 't' / 'v1'
+ else
+ ld A -1 # 'q' = MAX
+ end
+ ld E A # Save 'q' in E
+ mul (L -IV) # 'q' * 'v1'
+ sub Y A # Subtract from 'r'
+ subc Z C
+ do
+ null Z # 'r' <= MAX?
+ while z # Yes
+ ld A E # 'q' * 'v2'
+ mul (L -V)
+ cmp C Y # > lo(r), 'u3'?
+ while ge
+ if eq
+ cmp A (S) # 'u3' in tmp
+ break le
+ end
+ dec E # Yes: Decrement 'q'
+ add Y (L -IV) # Increment 'r' by 'v1'
+ addc Z 0
+ loop
+ ld (S) E # Save 'q' in tmp
+ ld Z X # Get 'x'
+ ld Y (L I) # 'v'
+ ld A E # and 'q'
+ mul (Y DIG) # Multiply lowest digit
+ sub (Z DIG) A # Subtract from 'x'
+ addc C 0
+ ld E C # Borrow in E
+ do
+ ld Y (Y BIG) # More in 'v'?
+ cnt Y
+ while z # Yes
+ ld Z (Z BIG) # Next 'x'
+ ld A (S) # Multiply with 'q' in tmp
+ mul (Y DIG) # 't' in D
+ sub (Z DIG) E # Subtract borrow
+ ld E 0
+ rcl E 1 # New borrow
+ sub (Z DIG) A # Subtract lo(t)
+ addc E C # Adjust borrow plus hi(t)
+ loop
+ null E # Borrow?
+ if nz # Yes
+ ld Z (Z BIG) # Next 'x'
+ sub (Z DIG) E # Subtract borrow
+ if c
+ dec (S) # Decrement 'q'
+ ld Y (L I) # Get 'v'
+ add (X DIG) (Y DIG) # 'x' += 'v'
+ push F # Save carry
+ do
+ ld X (X BIG) # More?
+ ld Y (Y BIG)
+ cnt Y
+ while z # Yes
+ pop F # Get carry
+ addc (X DIG) (Y DIG) # Add digits
+ push F
+ loop
+ pop F # Final carry
+ addc (X DIG) 0
end
end
- ld A (L I) # Divisor
- call shruA_A # Shift divisor right (non-destructive)
- ld (L I) A
+ ld A (S) # Get 'q'
+ ld C (L III) # Quotient so far
+ call consNumAC_A # Prepend 'q'
+ ld (L III) A # Store result
+ sub (L -I) 1 # Decrement 'm'
+ until lt
+ ld A (L II) # Get remainder
+ call zapZeroA_A
+ do
+ null (L -III) # 'd'?
+ while nz # Yes
+ call halfA_A # Shift right (destructive)
+ dec (L -III) # Decrement 'd'
loop
- ld A (L III) # Return quotient in A
- ld C (L II) # and remainder in C
+: remDone
drop
+ pop Z
+ pop Y
+ pop X
ret
+: remUnder # Dividend smaller than divisor
+ ld A (L II) # Get remainder
+ call zapZeroA_A
+ jmp remDone
# Increment a (signed) number
(code 'incE_A 0)
@@ -2175,7 +2492,7 @@
ld E (L I) # Product
call adduAE_A # Add for rounding
ld E (L II) # Last argument
- call divuAE_AC # Divide
+ call divuAE_A # Divide
ld E A # Result
test (L -I) 1 # Sign?
if nz # Yes
@@ -2232,7 +2549,7 @@
end
ld (L II) E # Save arg
ld A (L I) # Result
- call divuAE_AC # Divide
+ call divuAE_A # Divide
ld (L I) A # Result
loop
ld E (L I) # Result
@@ -2287,8 +2604,8 @@
off E SIGN # Make argument positive
ld (L II) E # Save arg
ld A (L I) # Result
- call divuAE_AC # Divide
- ld (L I) C # Result
+ call remuAE_A # Remainder
+ ld (L I) A # Result
loop
ld E (L I) # Result
test (L -I) 1 # Sign?
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 29jun10abu
+# 04jul10abu
# (c) Software Lab. Alexander Burger
-(de *Version 3 0 3 1)
+(de *Version 3 0 3 2)
# vi:et:ts=3:sw=3
