* fasl files now may contain ascii strings as a special type in

order to reduce the size of the fasl file.  Gains: reduces the
  size of the current boot file from 2.9M down to 2.5M.

bin/ikarus-fasl.c

@@ -274,11 +274,19 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
     /* ascii string */
     int len;
     fasl_read_buf(p, &len, sizeof(int));
-    int size = align(len + disp_string_data + 1);
+    int size = align(len*string_char_size + disp_string_data);
     ikp str = ik_alloc(pcb, size) + string_tag;
     ref(str, off_string_length) = fix(len);
     fasl_read_buf(p, str+off_string_data, len);
-    str[off_string_data+len] = 0;
+    {
+      unsigned char* pi = (unsigned char*) (str+off_string_data);
+      ikp* pj = (ikp*) (str+off_string_data);
+      int i = len-1;
+      for(i=len-1; i >= 0; i--){
+        pj[i] = integer_to_char(pi[i]);
+      }
+    }
+    //str[off_string_data+len] = 0;
     if(put_mark_index){
       p->marks[put_mark_index] = str;
     }
@@ -288,7 +296,7 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
     /* string */
     int len;
     fasl_read_buf(p, &len, sizeof(int));
-    int size = align(len*string_char_size + disp_string_data + 1);
+    int size = align(len*string_char_size + disp_string_data);
     ikp str = ik_alloc(pcb, size) + string_tag;
     ref(str, off_string_length) = fix(len);
     int i;
@@ -297,7 +305,7 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
       fasl_read_buf(p, &c, sizeof(int));
       string_set(str, i, integer_to_char(c));
     }
-    str[off_string_data+len*string_char_size] = 0;
+    //str[off_string_data+len*string_char_size] = 0;
     if(put_mark_index){
       p->marks[put_mark_index] = str;
     }

src/ikarus.fasl.write.ss

@@ -7,6 +7,8 @@
     (ikarus system $io)
     (ikarus system $bytevectors)
     (ikarus system $fx)
+    (ikarus system $chars)
+    (ikarus system $strings)
     (ikarus code-objects)
     (except (ikarus) fasl-write))
 
@@ -40,6 +42,12 @@
         [(eq? x (void)) (write-char #\U p)]
         [else (error 'fasl-write "~s is not a fasl-writable immediate" x)])))
   
+  (define (ascii-string? s)
+    (let f ([s s] [i 0] [n (string-length s)])
+      (or ($fx= i n)
+          (and ($char<= ($string-ref s i) ($fixnum->char 127))
+               (f s ($fxadd1 i) n)))))
+
   (define do-write
     (lambda (x p h m)
       (cond
@@ -57,14 +65,22 @@
               (f x (fxadd1 i) n
                  (fasl-write-object (vector-ref x i) p h m))]))]
         [(string? x) 
-         (write-char #\S p)
+         (cond
-         (write-int (string-length x) p)
+           [(ascii-string? x)
-         (let f ([x x] [i 0] [n (string-length x)])
+            (write-char #\s p)
-           (cond
+            (write-int (string-length x) p)
-             [(fx= i n) m]
+            (let f ([x x] [i 0] [n (string-length x)])
-             [else
+              (unless (fx= i n)
-              (write-int (char->integer (string-ref x i)) p)
+                (write-char (string-ref x i) p)
-              (f x (fxadd1 i) n)]))]
+                (f x (fxadd1 i) n)))]
+           [else
+            (write-char #\S p)
+            (write-int (string-length x) p)
+            (let f ([x x] [i 0] [n (string-length x)])
+              (unless (= i n)
+                (write-int (char->integer (string-ref x i)) p)
+                (f x (fxadd1 i) n)))])
+         m]
         [(gensym? x)
          (write-char #\G p)
          (fasl-write-object (gensym->unique-string x) p h

src/ikarus.numerics.ss

@@ -28,7 +28,7 @@
 
 (library (ikarus generic-arithmetic)
   (export + - * / zero? = < <= > >= add1 sub1 quotient remainder
-          positive? expt gcd lcm numerator denominator
+          positive? expt gcd lcm numerator denominator exact-integer-sqrt
           quotient+remainder number->string string->number)
   (import 
     (ikarus system $fx)
@@ -38,7 +38,8 @@
     (ikarus system $strings)
     (except (ikarus) + - * / zero? = < <= > >= add1 sub1 quotient
             remainder quotient+remainder number->string positive?
-            string->number expt gcd lcm numerator denominator))
+            string->number expt gcd lcm numerator denominator
+            exact-integer-sqrt))
 
   (define (fixnum->flonum x)
     (foreign-call "ikrt_fixnum_to_flonum" x))
@@ -1021,8 +1022,46 @@
       (cond
         [(flonum? x) (foreign-call "ikrt_fl_sqrt" x)]
         [(fixnum? x) (foreign-call "ikrt_fx_sqrt" x)]
+        [(bignum? x) (error 'sqrt "BUG: bignum sqrt not implemented")]
+        [(ratnum? x) (/ (sqrt ($ratnum-n x)) (sqrt ($ratnum-d x)))]
         [else (error 'sqrt "unsupported ~s" x)])))
 
+  (define exact-integer-sqrt
+    (lambda (x)
+      (define who 'exact-integer-sqrt)
+      (define (fxsqrt x i k) 
+        (let ([j ($fxsra ($fx+ i k) 1)])
+          (let ([j^2 ($fx* j j)])
+             (if ($fx> j^2 x)
+                 (fxsqrt x i j)
+                 (if ($fx= i j) 
+                     (values j ($fx- x j^2))
+                     (fxsqrt x j k))))))
+      (define (bnsqrt x i k) 
+        (let ([j (quotient (+ i k) 2)])
+          (let ([j^2 (* j j)])
+             (if (> j^2 x)
+                 (bnsqrt x i j)
+                 (if (= i j) 
+                     (values j (- x j^2))
+                     (bnsqrt x j k))))))
+      (cond
+        [(fixnum? x) 
+         (cond
+           [($fx< x 0) (error who "invalid argument ~s" x)]
+           [($fx= x 0) (values 0 0)]
+           [($fx< x 4) (values 1 ($fx- x 1))]
+           [($fx< x 9) (values 2 ($fx- x 4))]
+           [($fx< x 46340) (fxsqrt x 3 ($fxsra x 1))]
+           [else           (fxsqrt x 215 23171)])]
+        [(bignum? x) 
+         (cond
+           [($bignum-positive? x) 
+            (bnsqrt x 23170 (quotient x 23170))]
+           [else (error who "invalid argument ~s" x)])]
+        [else (error who "invalid argument ~s" x)])))
+
+
   (define numerator
     (lambda (x)
       (cond

src/makefile.ss

@@ -383,6 +383,7 @@
     [lcm                     i r]
     [numerator               i r]
     [denominator             i r]
+    [exact-integer-sqrt      i r]
     [symbol?                 i r symbols]
     [gensym?                 i symbols]
     [gensym                  i symbols]

src/run-tests.ss

@@ -4,6 +4,20 @@
         (tests reader)
         (tests bytevectors))
 
+(define (test-exact-integer-sqrt)
+  (define (f i j inc)
+    (when (< i j)
+      (let-values ([(s r) (exact-integer-sqrt i)])
+        (unless (and (= (+ (* s s) r) i)
+                     (< i (* (+ s 1) (+ s 1))))
+          (error 'exact-integer-sqrt "wrong result for ~s" i))
+        (f (+ i inc) j inc))))
+  (f 0 10000 1)
+  (f 0 536870911 10000)
+  (f 0 536870911000 536870911)
+  (printf "[exact-integer-sqrt] Happy Happy Joy Joy\n"))
+
 (test-reader)
 (test-bytevectors)
+(test-exact-integer-sqrt)
 (printf "Happy Happy Joy Joy\n")