conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* 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.
This commit is contained in:
Abdulaziz Ghuloum 2007-05-21 23:09:45 -04:00
parent 9f1e3dcb0b
commit 890dd348b2
7 changed files with 92 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
bin/ikarus
View File

Binary file not shown.

16
bin/ikarus-fasl.c
View File

@ -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;
}

BIN
src/ikarus.boot
View File

Binary file not shown.

32
src/ikarus.fasl.write.ss
View File

@ -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)
(write-int (string-length x) p)
(let f ([x x] [i 0] [n (string-length x)])
(cond
[(fx= i n) m]
[else
(write-int (char->integer (string-ref x i)) p)
(f x (fxadd1 i) n)]))]
(cond
[(ascii-string? x)
(write-char #\s p)
(write-int (string-length x) p)
(let f ([x x] [i 0] [n (string-length x)])
(unless (fx= i n)
(write-char (string-ref x i) p)
(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

43
src/ikarus.numerics.ss
View File

@ -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

1
src/makefile.ss
View File

@ -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]

14
src/run-tests.ss
View File

@ -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")