commit 861e3ba0080b50cb8d51683dd6cb2d0bd69107b0
parent 38ccbc8bd5eefa023fd0705f88db0ec5c895625e
Author: Commit-Bot <unknown>
Date: Sun, 3 Oct 2010 12:17:25 +0000
Automatic commit from picoLisp.tgz, From: Sun, 03 Oct 2010 12:17:25 GMT
Diffstat:
| M | lib/tags | | | 6 | +++--- |
| M | src/big.c | | | 4 | ++-- |
| M | src/io.c | | | 60 | +++++++++++++++--------------------------------------------- |
| M | src/pico.h | | | 3 | ++- |
| M | src64/io.l | | | 112 | +++++++++++++++++++++++++++++++++++++------------------------------------------ |
5 files changed, 74 insertions(+), 111 deletions(-)
diff --git a/lib/tags b/lib/tags
@@ -250,7 +250,7 @@ poll (3222 . "@src64/io.l")
pool (648 . "@src64/db.l")
pop (1773 . "@src64/sym.l")
port (5 . "@src64/net.l")
-pr (5108 . "@src64/io.l")
+pr (5100 . "@src64/io.l")
pre? (1411 . "@src64/sym.l")
prin (4916 . "@src64/io.l")
prinl (4930 . "@src64/io.l")
@@ -283,7 +283,7 @@ reverse (1665 . "@src64/subr.l")
rewind (5000 . "@src64/io.l")
rollback (1890 . "@src64/db.l")
rot (848 . "@src64/subr.l")
-rpc (5141 . "@src64/io.l")
+rpc (5133 . "@src64/io.l")
run (305 . "@src64/flow.l")
sect (2515 . "@src64/subr.l")
seed (2944 . "@src64/big.l")
@@ -340,7 +340,7 @@ when (1877 . "@src64/flow.l")
while (2054 . "@src64/flow.l")
wipe (3090 . "@src64/sym.l")
with (1323 . "@src64/flow.l")
-wr (5125 . "@src64/io.l")
+wr (5117 . "@src64/io.l")
xchg (1538 . "@src64/sym.l")
xor (1694 . "@src64/flow.l")
x| (2871 . "@src64/big.l")
diff --git a/src/big.c b/src/big.c
@@ -1,4 +1,4 @@
-/* 02jul10abu
+/* 03oct10abu
* (c) Software Lab. Alexander Burger
*/
@@ -237,7 +237,7 @@ static any bigMul(any x1, any x2) {
}
/* Multiply digit with a (positive) bignum */
-static void digMul(any x, word n) {
+void digMul(any x, word n) {
word2 t;
any y;
diff --git a/src/io.c b/src/io.c
@@ -1,4 +1,4 @@
-/* 27sep10abu
+/* 03oct10abu
* (c) Software Lab. Alexander Burger
*/
@@ -2514,9 +2514,8 @@ any doExt(any ex) {
// (rd ['sym]) -> any
// (rd 'cnt) -> num | NIL
any doRd(any x) {
- int i, j;
long cnt;
- word n;
+ int n, i;
cell c1;
x = cdr(x), x = EVAL(car(x));
@@ -2527,54 +2526,25 @@ any doRd(any x) {
drop(c1);
return x;
}
- if (!InFile)
- return Nil;
if ((cnt = unBox(x)) < 0) {
- byte buf[cnt = -cnt];
-
- if (!rdBytes(InFile->fd, buf, cnt, NO)) // Little Endian
+ if ((n = getBinary()) < 0)
return Nil;
- if (cnt % sizeof(word) == 0)
- Push(c1, Nil);
- else {
- n = buf[--cnt];
-
- while (cnt % sizeof(word))
- n = n << 8 | buf[--cnt];
- Push(c1, box(n));
- }
- while ((cnt -= WORD) >= 0) {
- n = buf[cnt + WORD-1];
- i = WORD-2;
- do
- n = n << 8 | buf[cnt + i];
- while (--i >= 0);
- data(c1) = consNum(n, data(c1));
+ i = 0, Push(c1, x = box(n));
+ while (++cnt) {
+ if ((n = getBinary()) < 0)
+ return Nil;
+ byteSym(n, &i, &x);
}
}
else {
- byte buf[cnt];
-
- if (!rdBytes(InFile->fd, buf, cnt, NO))
+ if ((n = getBinary()) < 0)
return Nil;
- if (cnt % sizeof(word) == 0) {
- i = 0;
- Push(c1, Nil);
- }
- else {
- n = buf[0];
-
- for (i = 1; i < (int)(cnt % sizeof(word)); ++i)
- n = n << 8 | buf[i];
- Push(c1, box(n));
- }
- while (i < cnt) {
- n = buf[i++];
- j = 1;
- do
- n = n << 8 | buf[i++];
- while (++j < WORD);
- data(c1) = consNum(n, data(c1));
+ i = 0, Push(c1, x = box(n));
+ while (--cnt) {
+ if ((n = getBinary()) < 0)
+ return Nil;
+ digMul(data(c1), 256);
+ digAdd(data(c1), n);
}
}
zapZero(data(c1));
diff --git a/src/pico.h b/src/pico.h
@@ -1,4 +1,4 @@
-/* 30sep10abu
+/* 03oct10abu
* (c) Software Lab. Alexander Burger
*/
@@ -296,6 +296,7 @@ void db(any,any,int);
int dbSize(any,any);
void digAdd(any,word);
void digDiv2(any);
+void digMul(any,word);
void digMul2(any);
void digSub1(any);
any doubleToNum(double);
diff --git a/src64/io.l b/src64/io.l
@@ -1,4 +1,4 @@
-# 28sep10abu
+# 03oct10abu
# (c) Software Lab. Alexander Burger
# Close file descriptor
@@ -5032,75 +5032,67 @@
# (rd ['sym]) -> any
# (rd 'cnt) -> num | NIL
(code 'doRd 2)
+ push X
+ push Z
+ link
+ push ZERO # <L I> Result
+ link
ld E ((E CDR)) # Get arg
eval # Eval it
- cnt E # Read raw bytes?
- if z # No
- push Z
- ld Z (InFile) # Current InFile
- null Z # Any?
- if nz # Yes
- link
- push E # <L I> EOF
- link
+ ld Z (InFile) # Current InFile?
+ null Z
+ if nz # Yes
+ cnt E # Read raw bytes?
+ if z # No
+ ld (L I) E # EOF
ld (GetBinZ_FB) getBinaryZ_FB # Set binary read function
ld (Extn) (ExtN) # Set external symbol offset
call binReadZ_FE # Read item?
ldc E (L I) # No: Return EOF
- drop
+ else
+ shr E 4 # Normalize
+ jz 90 # Zero
+ if c # Little endian
+ lea X (L I) # X on result
+ ld C 3 # Build signed number
+ do
+ call getBinaryZ_FB # Enough bytes?
+ jc 90 # No
+ call byteNumBCX_CX # Add next byte to number
+ dec E # Done?
+ until z # Yes
+ ld A (L I) # Double result
+ call twiceA_A
+ else
+ ld X E # Count in X
+ do
+ call getBinaryZ_FB # Enough bytes?
+ jc 90 # No
+ zxt
+ push A # Save byte
+ ld A (L I) # Multiply number by 256
+ ld E (hex "1002")
+ call muluAE_A
+ ld (L I) A # Save digit
+ pop E # Get digit
+ shl E 4 # Make short number
+ or E CNT
+ call adduAE_A # Add to number
+ ld (L I) A # Save again
+ dec X # Done?
+ until z # Yes
+ end
+ big A # Bignum?
+ if nz # Yes
+ call zapZeroA_A # Remove leading zeroes
+ end
+ ld E A # Get result
end
- pop Z
- ret
- end
- ld C (InFile) # Current InFile?
- null C
- jz retNil # No
- push X
- push Y
- push Z
- link
- push ZERO # <L I> Result
- link
- shr E 4 # Normalize
- jz 80 # Zero
- if c # Little endian
- sub S E # Buffer
- ld Y S # Buffer pointer
- ld Z 1 # Forward direction
else
- ld Y S # Buffer pointer
- ld Z -1 # Backward direction
- add Y Z # Point to last byte
- sub S E # Buffer
+90 ld E Nil # Return NIL
end
- cmp S (StkLimit) # Stack check
- jlt stkErr
- ld C (C) # Get 'fd' of InFile
- ld X S # Buffer pointer
- push E # <S> Count
- call rdBytesCEX_F # OK?
- if z # No
-80 ld E Nil # Return NIL
- jmp 90
- end
- lea X (L I) # X on result
- ld C 4 # Build unsigned number
- do
- ld B (Y) # Next byte from buffer
- call byteNumBCX_CX
- add Y Z # Add direction offset
- dec (S) # Decrement count
- until z
- ld E (L I) # Get result
- big E # Bignum?
- if nz # Yes
- ld A E
- call zapZeroA_A # Remove leading zeroes
- ld E A
- end
-90 drop
+ drop
pop Z
- pop Y
pop X
ret
