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

* made the compiler initialization (compiling the error handlers) 

a procedure that's called explicitly at the bottom of the compiler
  library.
This commit is contained in:
Abdulaziz Ghuloum 2007-05-04 03:46:38 -04:00
parent e3398504b8
commit 890c322adb
2 changed files with 13 additions and 5 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.

18
src/libcompile.ss
View File

@ -3216,10 +3216,16 @@
[(interrupted) (mem 40 pcr)] [(interrupted) (mem 40 pcr)]
[else (error 'pcb-ref "invalid arg ~s" x)]))) [else (error 'pcb-ref "invalid arg ~s" x)])))
(define (primref-loc op) (define (primref-loc op)
(unless (symbol? op) (error 'primref-loc "not a symbol ~s" op)) (unless (symbol? op) (error 'primref-loc "not a symbol ~s" op))
(mem (fx- disp-symbol-system-value symbol-tag) (cond
(obj op))) ;[(assq op (current-primitive-locations)) =>
; (lambda (x)
; (mem (fx- disp-symbol-value symbol-tag) (obj (cdr x))))]
[else
(mem (fx- disp-symbol-system-value symbol-tag)
(obj op))]))
(define (generate-code x) (define (generate-code x)
@ -4901,7 +4907,7 @@
(define SL_apply (gensym "SL_apply")) (define SL_apply (gensym "SL_apply"))
(define SL_values (gensym "SL_values")) (define SL_values (gensym "SL_values"))
(define SL_call_with_values (gensym "SL_call_with_values")) (define SL_call_with_values (gensym "SL_call_with_values"))
(module () (define (initialize-system)
(list*->code* (lambda (x) #f) (list*->code* (lambda (x) #f)
(list (list
(list 0 (list 0
@ -5196,12 +5202,14 @@
(primitive-set! 'compile-core-expr-to-port compile-core-expr-to-port) (primitive-set! 'compile-core-expr-to-port compile-core-expr-to-port)
(primitive-set! 'assembler-output (make-parameter #f)) (primitive-set! 'assembler-output (make-parameter #f))
(primitive-set! 'current-primitive-locations
(make-parameter '()))
(initialize-system)
(primitive-set! 'eval-core (primitive-set! 'eval-core
(lambda (x) ((compile-core-expr x)))) (lambda (x) ((compile-core-expr x))))
(primitive-set! 'current-primitive-locations
(make-parameter '()))
)) ))