* makefile and the compiler now signal an error if a primitive
is not associated with a location.
This commit is contained in:
parent
a146056491
commit
6dc380029c
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -5,7 +5,7 @@
|
||||||
(import
|
(import
|
||||||
(only (ikarus system $codes) $code->closure)
|
(only (ikarus system $codes) $code->closure)
|
||||||
(only (ikarus system $records) $record-ref $record/rtd?)
|
(only (ikarus system $records) $record-ref $record/rtd?)
|
||||||
(except (ikarus) ;fasl-write
|
(except (ikarus)
|
||||||
compile-core-expr-to-port assembler-output
|
compile-core-expr-to-port assembler-output
|
||||||
current-primitive-locations eval-core)
|
current-primitive-locations eval-core)
|
||||||
(ikarus intel-assembler)
|
(ikarus intel-assembler)
|
||||||
|
@ -3190,12 +3190,6 @@
|
||||||
[(base-rtd) (mem 44 pcr)]
|
[(base-rtd) (mem 44 pcr)]
|
||||||
[else (error 'pcb-ref "invalid arg ~s" x)])))
|
[else (error 'pcb-ref "invalid arg ~s" x)])))
|
||||||
|
|
||||||
(define do-warn
|
|
||||||
(let ([ls '()])
|
|
||||||
(lambda (x)
|
|
||||||
(unless (memq x ls)
|
|
||||||
(printf "[ERR ~s] " x)
|
|
||||||
(set! ls (cons x ls))))))
|
|
||||||
|
|
||||||
(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))
|
||||||
|
@ -3207,9 +3201,7 @@
|
||||||
"~s is not a valid location for ~s" x op))
|
"~s is not a valid location for ~s" x op))
|
||||||
(mem (fx- disp-symbol-value symbol-tag) (obj x)))]
|
(mem (fx- disp-symbol-value symbol-tag) (obj x)))]
|
||||||
[else
|
[else
|
||||||
(do-warn op)
|
(error 'compile "cannot find location of primitive ~s" op)]))
|
||||||
(mem (fx- disp-symbol-system-value symbol-tag)
|
|
||||||
(obj op))]))
|
|
||||||
|
|
||||||
|
|
||||||
(define (generate-code x)
|
(define (generate-code x)
|
||||||
|
|
|
@ -114,7 +114,6 @@
|
||||||
[$arg-list (ikarus system $arg-list)]
|
[$arg-list (ikarus system $arg-list)]
|
||||||
[$stack (ikarus system $stack)]
|
[$stack (ikarus system $stack)]
|
||||||
[$junkyard (ikarus system $junkyard)]
|
[$junkyard (ikarus system $junkyard)]
|
||||||
;[$lists (ikarus system $lists)]
|
|
||||||
))
|
))
|
||||||
|
|
||||||
(define ikarus-macros-map
|
(define ikarus-macros-map
|
||||||
|
@ -718,7 +717,8 @@
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(cond
|
(cond
|
||||||
[(assq x locs) => cdr]
|
[(assq x locs) => cdr]
|
||||||
[else #f]))])
|
[else
|
||||||
|
(error 'bootstrap "no location for ~s" x)]))])
|
||||||
(let ([p (open-output-file "ikarus.boot" 'replace)])
|
(let ([p (open-output-file "ikarus.boot" 'replace)])
|
||||||
(for-each
|
(for-each
|
||||||
(lambda (x) (compile-core-expr-to-port x p))
|
(lambda (x) (compile-core-expr-to-port x p))
|
||||||
|
|
Loading…
Reference in New Issue