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

* Heap and stack overflows now use interrupt-calls in order to push 

the calls to the handlers outside of the main-line code.
This commit is contained in:
Abdulaziz Ghuloum 2006-12-21 18:01:46 +03:00
parent 0af5f6cc2a
commit a41457ae66
2 changed files with 11 additions and 13 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.

24
src/libcompile.ss
View File

@ -2184,10 +2184,9 @@
(define who 'insert-stack-overflow-checks) (define who 'insert-stack-overflow-checks)
(define (insert-check body) (define (insert-check body)
(make-seq (make-seq
(make-conditional (make-interrupt-call
(make-primcall '$fp-overflow '()) (make-primcall '$fp-overflow '())
(make-funcall (make-primref 'do-stack-overflow) '()) (make-funcall (make-primref 'do-stack-overflow) '()))
(make-primcall 'void '()))
body)) body))
(define (Expr x) (define (Expr x)
(record-case x (record-case x
@ -2243,37 +2242,34 @@
(define who 'insert-allocation-checks) (define who 'insert-allocation-checks)
(define (check-bytes n var body) (define (check-bytes n var body)
(make-seq (make-seq
(make-conditional (make-interrupt-call
(make-primcall '$ap-check-bytes (make-primcall '$ap-check-bytes
(list (make-constant n) var)) (list (make-constant n) var))
(make-forcall "ik_collect" ;(make-primref 'do-overflow) (make-forcall "ik_collect"
(list (list
(make-primcall '$fx+ (make-primcall '$fx+
(list (make-constant (fx+ n 4096)) var)))) (list (make-constant (fx+ n 4096)) var)))))
(make-primcall 'void '()))
body)) body))
(define (check-words n var body) (define (check-words n var body)
(make-seq (make-seq
(make-conditional (make-interrupt-call
(make-primcall '$ap-check-words (make-primcall '$ap-check-words
(list (make-constant n) var)) (list (make-constant n) var))
(make-forcall "ik_collect" ; (make-primref 'do-overflow-words) (make-forcall "ik_collect" ; (make-primref 'do-overflow-words)
(list (list
(make-primcall '$fx+ (make-primcall '$fx+
(list (make-constant (fx+ n 4096)) var)))) (list (make-constant (fx+ n 4096)) var)))))
(make-primcall 'void '()))
body)) body))
(define (check-const n body) (define (check-const n body)
(cond (cond
[(fxzero? n) body] [(fxzero? n) body]
[else [else
(make-seq (make-seq
(make-conditional (make-interrupt-call
(make-primcall '$ap-check-const (make-primcall '$ap-check-const
(list (make-constant n))) (list (make-constant n)))
(make-forcall "ik_collect" ;(make-primref 'do-overflow) (make-forcall "ik_collect" ;(make-primref 'do-overflow)
(list (make-constant (fx+ n 4096)))) (list (make-constant (fx+ n 4096)))))
(make-primcall 'void '()))
body)])) body)]))
(define (closure-size x) (define (closure-size x)
(record-case x (record-case x
@ -2350,6 +2346,8 @@
(make-appcall (Expr op) (map Expr arg*))] (make-appcall (Expr op) (map Expr arg*))]
[(jmpcall label op arg*) [(jmpcall label op arg*)
(make-jmpcall label (Expr op) (map Expr arg*))] (make-jmpcall label (Expr op) (map Expr arg*))]
[(interrupt-call e0 e1)
(make-interrupt-call (Expr e0) (Expr e1))]
[else (error who "invalid expression ~s" (unparse x))])) [else (error who "invalid expression ~s" (unparse x))]))
(define (Tail x) (define (Tail x)
(record-case x (record-case x