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

Fixed bug in libfasl that caused reading a thunk to return the code 

instead.
This commit is contained in:
Abdulaziz Ghuloum 2006-12-26 12:03:43 +03:00
parent 0b38b1ff30
commit d38880b777
3 changed files with 7 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

3
src/libcompile.ss
View File

@ -4916,7 +4916,8 @@
(primitive-set! 'assembler-output (make-parameter #f)) (primitive-set! 'assembler-output (make-parameter #f))
(primitive-set! 'compile (primitive-set! 'compile
(lambda (x) (lambda (x)
(let ([code (compile-expr x)]) (let ([code
(if (code? x) x (compile-expr x))])
(let ([proc ($code->closure code)]) (let ([proc ($code->closure code)])
(proc))))) (proc)))))

8
src/libfasl.ss
View File

@ -313,7 +313,7 @@
(let ([clos ($code->closure code)]) (let ([clos ($code->closure code)])
(put-mark clos-m clos) (put-mark clos-m clos)
(set-code-reloc-vector! code (read)) (set-code-reloc-vector! code (read))
clos)] code)]
[else [else
(set-code-reloc-vector! code (read)) (set-code-reloc-vector! code (read))
code])))) code]))))
@ -321,7 +321,8 @@
(let ([c (read-char p)]) (let ([c (read-char p)])
(case c (case c
[(#\x) [(#\x)
(read-code #f m)] (let ([code (read-code #f m)])
(if m (vector-ref marks m) ($code->closure code)))]
[(#\<) [(#\<)
(let ([cm (read-int p)]) (let ([cm (read-int p)])
(unless (fx< cm (vector-length marks)) (unless (fx< cm (vector-length marks))
@ -333,7 +334,8 @@
[(#\>) [(#\>)
(let ([cm (read-int p)]) (let ([cm (read-int p)])
(assert-eq? (read-char p) #\x) (assert-eq? (read-char p) #\x)
(read-code cm m))] (let ([code (read-code cm m)])
(if m (vector-ref marks m) ($code->closure code))))]
[else (error who "invalid code header ~s" c)]))) [else (error who "invalid code header ~s" c)])))
(define (read/mark m) (define (read/mark m)
(define (nom) (define (nom)