picolisp

commit 97843c83f47087c89688d4022cf189c1271c32ec
parent ea3a9860c43a39c9dade61ce8d871594ecdec420
Author: Alexander Burger <abu@software-lab.de>
Date:   Fri,  8 Jul 2011 12:11:15 +0200

'rand' analog to 'seed'
Diffstat:
M
ersatz/picolisp.jar
 | 
0

M
lib/tags
 | 
2
+-
M
src/big.c
 | 
7
+++----
M
src/vers.h
 | 
2
+-
M
src64/big.l
 | 
7
++-----
M
src64/version.l
 | 
4
++--

6 files changed, 9 insertions(+), 13 deletions(-)
diff --git a/ersatz/picolisp.jar b/ersatz/picolisp.jar
Binary files differ.
diff --git a/lib/tags b/lib/tags
@@ -275,7 +275,7 @@ pwd (2675 . "@src64/main.l")
 queue (1918 . "@src64/sym.l")
 quit (1090 . "@src64/main.l")
 quote (139 . "@src64/flow.l")
-rand (2975 . "@src64/big.l")
+rand (2974 . "@src64/big.l")
 range (997 . "@src64/subr.l")
 rank (3033 . "@src64/subr.l")
 raw (450 . "@src64/main.l")
diff --git a/src/big.c b/src/big.c
@@ -1,4 +1,4 @@
-/* 07mar11abu
+/* 08jul11abu
  * (c) Software Lab. Alexander Burger
  */
 
@@ -1137,8 +1137,7 @@ static u_int64_t initSeed(any x) {
 
 // (seed 'any) -> cnt
 any doSeed(any ex) {
-   return boxCnt(
-         hi(Seed = initSeed(EVAL(cadr(ex))) * 6364136223846793005LL + 1) );
+   return box(hi(Seed = initSeed(EVAL(cadr(ex))) * 6364136223846793005LL));
 }
 
 // (rand ['cnt1 'cnt2] | ['T]) -> cnt | flg
@@ -1149,7 +1148,7 @@ any doRand(any ex) {
    x = cdr(ex);
    Seed = Seed * 6364136223846793005LL + 1;
    if (isNil(x = EVAL(car(x))))
-      return boxCnt(hi(Seed));
+      return box(hi(Seed));
    if (x == T)
       return hi(Seed) & 1 ? T : Nil;
    n = xCnt(ex,x);
diff --git a/src/vers.h b/src/vers.h
@@ -1 +1 @@
-static byte Version[4] = {3,0,7,1};
+static byte Version[4] = {3,0,7,2};
diff --git a/src64/big.l b/src64/big.l
@@ -1,4 +1,4 @@
-# 04jul11abu
+# 08jul11abu
 # (c) Software Lab. Alexander Burger
 
 ### Destructive primitives ###
@@ -2963,7 +2963,6 @@
    call initSeedE_E  # Initialize 'Seed'
    ld A 6364136223846793005  # Multiplier
    mul E  # times 'Seed'
-   add D 1  # plus 1
    ld (Seed) D  # Save
    shr A (- 32 3)  # Get higher 32 bits
    ld E A
@@ -2985,9 +2984,7 @@
    eval  # Eval first arg
    cmp E Nil  # Any?
    if eq  # No
-      shl C 32  # Get middle 64 bits
-      shr A 32
-      or A C
+      shr A (- 32 3)  # Get higher 32 bits
       ld E A
       off E 7  # Keep sign
       or E CNT  # Make short number
diff --git a/src64/version.l b/src64/version.l
@@ -1,6 +1,6 @@
-# 30jun11abu
+# 08jul11abu
 # (c) Software Lab. Alexander Burger
 
-(de *Version 3 0 7 1)
+(de *Version 3 0 7 2)
 
 # vi:et:ts=3:sw=3