Procedure codes no longer save their cp if the cp has no free vars.
This commit is contained in:
Abdulaziz Ghuloum
parent
62b42e8bb8
commit
876a2d7824
BIN
lib/ikarus.boot
BIN
lib/ikarus.boot
Binary file not shown.
|
|
@ -221,7 +221,7 @@
|
||||||
(define-record eval-cp (check body))
|
(define-record eval-cp (check body))
|
||||||
(define-record return (value))
|
(define-record return (value))
|
||||||
(define-record call-cp
|
(define-record call-cp
|
||||||
(call-convention label rp-convention base-idx arg-count live-mask))
|
(call-convention label save-cp? rp-convention base-idx arg-count live-mask))
|
||||||
(define-record tailcall-cp (convention label arg-count))
|
(define-record tailcall-cp (convention label arg-count))
|
||||||
(define-record primcall (op arg*))
|
(define-record primcall (op arg*))
|
||||||
(define-record primref (name))
|
(define-record primref (name))
|
||||||
|
|
@ -467,7 +467,7 @@
|
||||||
`(save-cp ,(E expr))]
|
`(save-cp ,(E expr))]
|
||||||
[(eval-cp check body)
|
[(eval-cp check body)
|
||||||
`(eval-cp ,check ,(E body))]
|
`(eval-cp ,check ,(E body))]
|
||||||
[(call-cp call-convention label rp-convention base-idx arg-count live-mask)
|
[(call-cp call-convention label save-cp? rp-convention base-idx arg-count live-mask)
|
||||||
`(call-cp [conv: ,call-convention]
|
`(call-cp [conv: ,call-convention]
|
||||||
[label: ,label]
|
[label: ,label]
|
||||||
[rpconv: ,rp-convention]
|
[rpconv: ,rp-convention]
|
||||||
|
|
@ -1945,210 +1945,219 @@
|
||||||
|
|
||||||
(define (remove-local-variables x)
|
(define (remove-local-variables x)
|
||||||
(define who 'remove-local-variables)
|
(define who 'remove-local-variables)
|
||||||
(define (simple* x* r)
|
(define (Body orig-x orig-si orig-r orig-live save-cp?)
|
||||||
(map (lambda (x)
|
(define (simple* x* r)
|
||||||
(cond
|
(map (lambda (x)
|
||||||
[(assq x r) => cdr]
|
(cond
|
||||||
[else
|
[(assq x r) => cdr]
|
||||||
(when (var? x) (error who "unbound var ~s" x))
|
[else
|
||||||
x]))
|
(when (var? x) (error who "unbound var ~s" x))
|
||||||
x*))
|
x]))
|
||||||
(define (env->mask r sz)
|
x*))
|
||||||
(let ([s (make-vector (fxsra (fx+ sz 7) 3) 0)])
|
(define (env->mask r sz)
|
||||||
(for-each
|
(let ([s (make-vector (fxsra (fx+ sz 7) 3) 0)])
|
||||||
(lambda (idx)
|
(for-each
|
||||||
(let ([q (fxsra idx 3)]
|
(lambda (idx)
|
||||||
[r (fxlogand idx 7)])
|
(let ([q (fxsra idx 3)]
|
||||||
(vector-set! s q
|
[r (fxlogand idx 7)])
|
||||||
(fxlogor (vector-ref s q) (fxsll 1 r)))))
|
(vector-set! s q
|
||||||
r)
|
(fxlogor (vector-ref s q) (fxsll 1 r)))))
|
||||||
s))
|
r)
|
||||||
(define (check? x)
|
s))
|
||||||
(cond
|
(define (check? x)
|
||||||
[(primref? x) #f] ;;;; PRIMREF CHECK
|
(cond
|
||||||
[(closure? x) #f]
|
[(primref? x) #f] ;;;; PRIMREF CHECK
|
||||||
[else #t]))
|
[(closure? x) #f]
|
||||||
(define (do-new-frame label op rand* si r call-convention rp-convention orig-live)
|
[else #t]))
|
||||||
(make-new-frame (fxadd1 si) (fx+ (length rand*) 2)
|
(define (do-new-frame label op rand* si r call-convention rp-convention orig-live)
|
||||||
(let f ([r* rand*] [nsi (fx+ si 2)] [live orig-live])
|
(let ([start-si (if save-cp? (fxadd1 si) si)])
|
||||||
|
(make-new-frame start-si (fx+ (length rand*) 2)
|
||||||
|
(let f ([r* rand*] [nsi (fxadd1 start-si)] [live orig-live])
|
||||||
|
(cond
|
||||||
|
[(null? r*)
|
||||||
|
(make-seq
|
||||||
|
(make-seq
|
||||||
|
(if save-cp?
|
||||||
|
(make-save-cp (make-frame-var si))
|
||||||
|
(nop))
|
||||||
|
(case call-convention
|
||||||
|
[(normal apply)
|
||||||
|
(make-eval-cp (check? op) (Expr op nsi r (cons si live)))]
|
||||||
|
[(direct)
|
||||||
|
(make-eval-cp (check? op) (Expr op nsi r (cons si live)))]
|
||||||
|
[(foreign)
|
||||||
|
(make-eval-cp #f (make-foreign-label op))]
|
||||||
|
[else (error who "invalid convention ~s" call-convention)]))
|
||||||
|
(make-call-cp call-convention label save-cp?
|
||||||
|
rp-convention
|
||||||
|
start-si ; frame size
|
||||||
|
(length rand*) ; argc
|
||||||
|
(env->mask (if save-cp?
|
||||||
|
(cons si orig-live)
|
||||||
|
orig-live)
|
||||||
|
start-si)))] ; mask-size ~~ frame size
|
||||||
|
[else
|
||||||
|
(make-seq
|
||||||
|
(make-assign (make-frame-var nsi)
|
||||||
|
(Expr (car r*) nsi r live))
|
||||||
|
(f (cdr r*) (fxadd1 nsi) (cons nsi live)))])))))
|
||||||
|
(define (nop) (make-primcall 'void '()))
|
||||||
|
(define (do-bind lhs* rhs* body si r live k)
|
||||||
|
(let f ([lhs* lhs*] [rhs* rhs*] [si si] [nr r] [live live])
|
||||||
(cond
|
(cond
|
||||||
[(null? r*)
|
[(null? lhs*) (k body si nr live)]
|
||||||
(make-seq
|
|
||||||
(make-seq
|
|
||||||
(make-save-cp (make-frame-var si))
|
|
||||||
(case call-convention
|
|
||||||
[(normal apply direct)
|
|
||||||
(make-eval-cp (check? op) (Expr op nsi r (cons si live)))]
|
|
||||||
[(foreign)
|
|
||||||
(make-eval-cp #f (make-foreign-label op))]
|
|
||||||
[else (error who "invalid convention ~s" call-convention)]))
|
|
||||||
(make-call-cp call-convention label
|
|
||||||
rp-convention
|
|
||||||
(fxadd1 si) ; frame size
|
|
||||||
(length rand*) ; argc
|
|
||||||
(env->mask (cons si orig-live) ; cp and everything before it
|
|
||||||
(fxadd1 si))))] ; mask-size ~~ frame size
|
|
||||||
[else
|
[else
|
||||||
(make-seq
|
(let ([v (make-frame-var si)])
|
||||||
(make-assign (make-frame-var nsi)
|
(make-seq
|
||||||
(Expr (car r*) nsi r live))
|
(make-assign v (Expr (car rhs*) si r live))
|
||||||
(f (cdr r*) (fxadd1 nsi) (cons nsi live)))]))))
|
(f (cdr lhs*) (cdr rhs*) (fxadd1 si)
|
||||||
(define (nop) (make-primcall 'void '()))
|
(cons (cons (car lhs*) v) nr)
|
||||||
(define (do-bind lhs* rhs* body si r live k)
|
(cons si live))))])))
|
||||||
(let f ([lhs* lhs*] [rhs* rhs*] [si si] [nr r] [live live])
|
(define (do-closure r)
|
||||||
(cond
|
(lambda (x)
|
||||||
[(null? lhs*) (k body si nr live)]
|
(record-case x
|
||||||
[else
|
[(closure code free*)
|
||||||
(let ([v (make-frame-var si)])
|
(make-closure code (simple* free* r))])))
|
||||||
|
(define (do-fix lhs* rhs* body si r live k)
|
||||||
|
(let f ([l* lhs*] [nlhs* '()] [si si] [r r] [live live])
|
||||||
|
(cond
|
||||||
|
[(null? l*)
|
||||||
|
(make-fix (reverse nlhs*)
|
||||||
|
(map (do-closure r) rhs*)
|
||||||
|
(k body si r live))]
|
||||||
|
[else
|
||||||
|
(let ([v (make-frame-var si)])
|
||||||
|
(f (cdr l*) (cons v nlhs*) (fxadd1 si)
|
||||||
|
(cons (cons (car l*) v) r)
|
||||||
|
(cons si live)))])))
|
||||||
|
(define (do-tail-frame label op rand* si r call-conv live)
|
||||||
|
(define (const? x)
|
||||||
|
(record-case x
|
||||||
|
[(constant) #t]
|
||||||
|
[(primref) #t]
|
||||||
|
[else #f]))
|
||||||
|
(define (evalrand* rand* i si r live ac)
|
||||||
|
(cond
|
||||||
|
[(null? rand*)
|
||||||
|
;;; evaluate operator after all operands
|
||||||
(make-seq
|
(make-seq
|
||||||
(make-assign v (Expr (car rhs*) si r live))
|
(make-eval-cp (check? op) (Expr op si r live))
|
||||||
(f (cdr lhs*) (cdr rhs*) (fxadd1 si)
|
ac)]
|
||||||
(cons (cons (car lhs*) v) nr)
|
[(const? (car rand*))
|
||||||
(cons si live))))])))
|
;;; constants are not live since they can be assigned
|
||||||
(define (do-closure r)
|
;;; after all args are evaluated
|
||||||
(lambda (x)
|
(evalrand* (cdr rand*) (fxadd1 i) (fxadd1 si) r live
|
||||||
|
(make-seq ac
|
||||||
|
(make-assign (make-frame-var i) (car rand*))))]
|
||||||
|
[else
|
||||||
|
(let ([vsi (make-frame-var si)]
|
||||||
|
[rhs (Expr (car rand*) si r live)])
|
||||||
|
(cond
|
||||||
|
[(and (frame-var? rhs)
|
||||||
|
(fx= (frame-var-idx rhs) i))
|
||||||
|
;;; value of rhs is already in f[i]
|
||||||
|
;;; just mark it live
|
||||||
|
(evalrand* (cdr rand*) (fx+ i 1) (fx+ si 1) r live ac)]
|
||||||
|
[(fx= i si)
|
||||||
|
(make-seq
|
||||||
|
(make-assign vsi rhs)
|
||||||
|
(evalrand* (cdr rand*) (fx+ i 1) (fx+ si 1) r
|
||||||
|
(cons si live) ac))]
|
||||||
|
[else
|
||||||
|
(make-seq
|
||||||
|
(make-assign vsi rhs)
|
||||||
|
(evalrand* (cdr rand*) (fxadd1 i) (fxadd1 si) r (cons si live)
|
||||||
|
(make-seq ac
|
||||||
|
(make-assign (make-frame-var i) vsi))))]))]))
|
||||||
|
(make-seq
|
||||||
|
(evalrand* rand* 1 si r live (make-primcall 'void '()))
|
||||||
|
(make-tailcall-cp call-conv label (length rand*))))
|
||||||
|
(define (Tail x si r live)
|
||||||
(record-case x
|
(record-case x
|
||||||
[(closure code free*)
|
[(return v) (make-return (Expr v si r live))]
|
||||||
(make-closure code (simple* free* r))])))
|
[(bind lhs* rhs* body)
|
||||||
(define (do-fix lhs* rhs* body si r live k)
|
(do-bind lhs* rhs* body si r live Tail)]
|
||||||
(let f ([l* lhs*] [nlhs* '()] [si si] [r r] [live live])
|
[(fix lhs* rhs* body)
|
||||||
(cond
|
(do-fix lhs* rhs* body si r live Tail)]
|
||||||
[(null? l*)
|
[(conditional test conseq altern)
|
||||||
(make-fix (reverse nlhs*)
|
(make-conditional
|
||||||
(map (do-closure r) rhs*)
|
(Expr test si r live)
|
||||||
(k body si r live))]
|
(Tail conseq si r live)
|
||||||
[else
|
(Tail altern si r live))]
|
||||||
(let ([v (make-frame-var si)])
|
[(seq e0 e1) (make-seq (Effect e0 si r live) (Tail e1 si r live))]
|
||||||
(f (cdr l*) (cons v nlhs*) (fxadd1 si)
|
[(primcall op arg*)
|
||||||
(cons (cons (car l*) v) r)
|
(make-return
|
||||||
(cons si live)))])))
|
(make-primcall op
|
||||||
(define (do-tail-frame label op rand* si r call-conv live)
|
(map (lambda (x) (Expr x si r live)) arg*)))]
|
||||||
(define (const? x)
|
|
||||||
|
[(funcall op rand*)
|
||||||
|
(do-tail-frame #f op rand* si r 'normal live)]
|
||||||
|
[(appcall op rand*)
|
||||||
|
(do-tail-frame #f op rand* si r 'apply live)]
|
||||||
|
[(jmpcall label op rand*)
|
||||||
|
(do-tail-frame label op rand* si r 'direct live)]
|
||||||
|
[else (error who "invalid expression ~s" (unparse x))]))
|
||||||
|
(define (Effect x si r live)
|
||||||
(record-case x
|
(record-case x
|
||||||
[(constant) #t]
|
[(constant) (nop)]
|
||||||
[(primref) #t]
|
[(var) (nop)]
|
||||||
[else #f]))
|
[(primref) (nop)]
|
||||||
(define (evalrand* rand* i si r live ac)
|
[(closure code free*) (nop)]
|
||||||
(cond
|
[(bind lhs* rhs* body)
|
||||||
[(null? rand*)
|
(do-bind lhs* rhs* body si r live Effect)]
|
||||||
;;; evaluate operator after all operands
|
[(fix lhs* rhs* body)
|
||||||
(make-seq
|
(do-fix lhs* rhs* body si r live Effect)]
|
||||||
(make-eval-cp (check? op) (Expr op si r live))
|
[(conditional test conseq altern)
|
||||||
ac)]
|
(make-conditional
|
||||||
[(const? (car rand*))
|
(Expr test si r live)
|
||||||
;;; constants are not live since they can be assigned
|
(Effect conseq si r live)
|
||||||
;;; after all args are evaluated
|
(Effect altern si r live))]
|
||||||
(evalrand* (cdr rand*) (fxadd1 i) (fxadd1 si) r live
|
[(seq e0 e1) (make-seq (Effect e0 si r live) (Effect e1 si r live))]
|
||||||
(make-seq ac
|
[(primcall op arg*)
|
||||||
(make-assign (make-frame-var i) (car rand*))))]
|
|
||||||
[else
|
|
||||||
(let ([vsi (make-frame-var si)]
|
|
||||||
[rhs (Expr (car rand*) si r live)])
|
|
||||||
(cond
|
|
||||||
[(and (frame-var? rhs)
|
|
||||||
(fx= (frame-var-idx rhs) i))
|
|
||||||
;;; value of rhs is already in f[i]
|
|
||||||
;;; just mark it live
|
|
||||||
(evalrand* (cdr rand*) (fx+ i 1) (fx+ si 1) r live ac)]
|
|
||||||
[(fx= i si)
|
|
||||||
(make-seq
|
|
||||||
(make-assign vsi rhs)
|
|
||||||
(evalrand* (cdr rand*) (fx+ i 1) (fx+ si 1) r
|
|
||||||
(cons si live) ac))]
|
|
||||||
[else
|
|
||||||
(make-seq
|
|
||||||
(make-assign vsi rhs)
|
|
||||||
(evalrand* (cdr rand*) (fxadd1 i) (fxadd1 si) r (cons si live)
|
|
||||||
(make-seq ac
|
|
||||||
(make-assign (make-frame-var i) vsi))))]))]))
|
|
||||||
(make-seq
|
|
||||||
(evalrand* rand* 1 si r live (make-primcall 'void '()))
|
|
||||||
(make-tailcall-cp call-conv label (length rand*))))
|
|
||||||
(define (Tail x si r live)
|
|
||||||
(record-case x
|
|
||||||
[(return v) (make-return (Expr v si r live))]
|
|
||||||
[(bind lhs* rhs* body)
|
|
||||||
(do-bind lhs* rhs* body si r live Tail)]
|
|
||||||
[(fix lhs* rhs* body)
|
|
||||||
(do-fix lhs* rhs* body si r live Tail)]
|
|
||||||
[(conditional test conseq altern)
|
|
||||||
(make-conditional
|
|
||||||
(Expr test si r live)
|
|
||||||
(Tail conseq si r live)
|
|
||||||
(Tail altern si r live))]
|
|
||||||
[(seq e0 e1) (make-seq (Effect e0 si r live) (Tail e1 si r live))]
|
|
||||||
[(primcall op arg*)
|
|
||||||
(make-return
|
|
||||||
(make-primcall op
|
(make-primcall op
|
||||||
(map (lambda (x) (Expr x si r live)) arg*)))]
|
(map (lambda (x) (Expr x si r live)) arg*))]
|
||||||
|
[(forcall op rand*)
|
||||||
[(funcall op rand*)
|
(do-new-frame #f op rand* si r 'foreign 'effect live)]
|
||||||
(do-tail-frame #f op rand* si r 'normal live)]
|
[(funcall op rand*)
|
||||||
[(appcall op rand*)
|
(do-new-frame #f op rand* si r 'normal 'effect live)]
|
||||||
(do-tail-frame #f op rand* si r 'apply live)]
|
[(jmpcall label op rand*)
|
||||||
[(jmpcall label op rand*)
|
(do-new-frame label op rand* si r 'direct 'effect live)]
|
||||||
(do-tail-frame label op rand* si r 'direct live)]
|
[(appcall op rand*)
|
||||||
[else (error who "invalid expression ~s" (unparse x))]))
|
(do-new-frame #f op rand* si r 'apply 'effect live)]
|
||||||
(define (Effect x si r live)
|
[else (error who "invalid effect expression ~s" (unparse x))]))
|
||||||
(record-case x
|
(define (Expr x si r live)
|
||||||
[(constant) (nop)]
|
(record-case x
|
||||||
[(var) (nop)]
|
[(constant) x]
|
||||||
[(primref) (nop)]
|
[(var)
|
||||||
[(closure code free*) (nop)]
|
(cond
|
||||||
[(bind lhs* rhs* body)
|
[(assq x r) => cdr]
|
||||||
(do-bind lhs* rhs* body si r live Effect)]
|
[else (error who "unbound var ~s" x)])]
|
||||||
[(fix lhs* rhs* body)
|
[(primref) x]
|
||||||
(do-fix lhs* rhs* body si r live Effect)]
|
[(closure code free*)
|
||||||
[(conditional test conseq altern)
|
(make-closure code (simple* free* r))]
|
||||||
(make-conditional
|
[(bind lhs* rhs* body)
|
||||||
(Expr test si r live)
|
(do-bind lhs* rhs* body si r live Expr)]
|
||||||
(Effect conseq si r live)
|
[(fix lhs* rhs* body)
|
||||||
(Effect altern si r live))]
|
(do-fix lhs* rhs* body si r live Expr)]
|
||||||
[(seq e0 e1) (make-seq (Effect e0 si r live) (Effect e1 si r live))]
|
[(conditional test conseq altern)
|
||||||
[(primcall op arg*)
|
(make-conditional
|
||||||
(make-primcall op
|
(Expr test si r live)
|
||||||
(map (lambda (x) (Expr x si r live)) arg*))]
|
(Expr conseq si r live)
|
||||||
[(forcall op rand*)
|
(Expr altern si r live))]
|
||||||
(do-new-frame #f op rand* si r 'foreign 'effect live)]
|
[(seq e0 e1) (make-seq (Effect e0 si r live) (Expr e1 si r live))]
|
||||||
[(funcall op rand*)
|
[(primcall op arg*)
|
||||||
(do-new-frame #f op rand* si r 'normal 'effect live)]
|
(make-primcall op
|
||||||
[(jmpcall label op rand*)
|
(map (lambda (x) (Expr x si r live)) arg*))]
|
||||||
(do-new-frame label op rand* si r 'direct 'effect live)]
|
[(forcall op rand*)
|
||||||
[(appcall op rand*)
|
(do-new-frame #f op rand* si r 'foreign 'value live)]
|
||||||
(do-new-frame #f op rand* si r 'apply 'effect live)]
|
[(funcall op rand*)
|
||||||
[else (error who "invalid effect expression ~s" (unparse x))]))
|
(do-new-frame #f op rand* si r 'normal 'value live)]
|
||||||
(define (Expr x si r live)
|
[(jmpcall label op rand*)
|
||||||
(record-case x
|
(do-new-frame label op rand* si r 'direct 'value live)]
|
||||||
[(constant) x]
|
[(appcall op rand*)
|
||||||
[(var)
|
(do-new-frame #f op rand* si r 'apply 'value live)]
|
||||||
(cond
|
[else (error who "invalid expression ~s" (unparse x))]))
|
||||||
[(assq x r) => cdr]
|
(Tail orig-x orig-si orig-r orig-live))
|
||||||
[else (error who "unbound var ~s" x)])]
|
|
||||||
[(primref) x]
|
|
||||||
[(closure code free*)
|
|
||||||
(make-closure code (simple* free* r))]
|
|
||||||
[(bind lhs* rhs* body)
|
|
||||||
(do-bind lhs* rhs* body si r live Expr)]
|
|
||||||
[(fix lhs* rhs* body)
|
|
||||||
(do-fix lhs* rhs* body si r live Expr)]
|
|
||||||
[(conditional test conseq altern)
|
|
||||||
(make-conditional
|
|
||||||
(Expr test si r live)
|
|
||||||
(Expr conseq si r live)
|
|
||||||
(Expr altern si r live))]
|
|
||||||
[(seq e0 e1) (make-seq (Effect e0 si r live) (Expr e1 si r live))]
|
|
||||||
[(primcall op arg*)
|
|
||||||
(make-primcall op
|
|
||||||
(map (lambda (x) (Expr x si r live)) arg*))]
|
|
||||||
[(forcall op rand*)
|
|
||||||
(do-new-frame #f op rand* si r 'foreign 'value live)]
|
|
||||||
[(funcall op rand*)
|
|
||||||
(do-new-frame #f op rand* si r 'normal 'value live)]
|
|
||||||
[(jmpcall label op rand*)
|
|
||||||
(do-new-frame label op rand* si r 'direct 'value live)]
|
|
||||||
[(appcall op rand*)
|
|
||||||
(do-new-frame #f op rand* si r 'apply 'value live)]
|
|
||||||
[else (error who "invalid expression ~s" (unparse x))]))
|
|
||||||
(define (bind-fml* fml* r)
|
(define (bind-fml* fml* r)
|
||||||
(let f ([si 1] [fml* fml*])
|
(let f ([si 1] [fml* fml*])
|
||||||
(cond
|
(cond
|
||||||
|
|
@ -2169,7 +2178,7 @@
|
||||||
(f (cdr free*) (fxadd1 idx)
|
(f (cdr free*) (fxadd1 idx)
|
||||||
(cons (cons (car free*) (make-cp-var idx)) r))])))
|
(cons (cons (car free*) (make-cp-var idx)) r))])))
|
||||||
(define CaseExpr
|
(define CaseExpr
|
||||||
(lambda (r)
|
(lambda (r save-cp?)
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(record-case x
|
(record-case x
|
||||||
[(clambda-case info body)
|
[(clambda-case info body)
|
||||||
|
|
@ -2178,17 +2187,17 @@
|
||||||
(let-values ([(fml* si r live) (bind-fml* fml* r)])
|
(let-values ([(fml* si r live) (bind-fml* fml* r)])
|
||||||
(make-clambda-case
|
(make-clambda-case
|
||||||
(make-case-info label fml* proper)
|
(make-case-info label fml* proper)
|
||||||
(Tail body si r live)))])]))))
|
(Body body si r live save-cp?)))])]))))
|
||||||
(define (CodeExpr x)
|
(define (CodeExpr x)
|
||||||
(record-case x
|
(record-case x
|
||||||
[(clambda L cases free)
|
[(clambda L cases free)
|
||||||
(let ([r (bind-free* free)])
|
(let ([r (bind-free* free)])
|
||||||
(make-clambda L (map (CaseExpr r) cases) free))]))
|
(make-clambda L (map (CaseExpr r (not (null? free))) cases) free))]))
|
||||||
(define (CodesExpr x)
|
(define (CodesExpr x)
|
||||||
(record-case x
|
(record-case x
|
||||||
[(codes list body)
|
[(codes list body)
|
||||||
(make-codes (map CodeExpr list)
|
(make-codes (map CodeExpr list)
|
||||||
(Tail body 1 '() '()))]))
|
(Body body 1 '() '() #f))]))
|
||||||
(CodesExpr x))
|
(CodesExpr x))
|
||||||
|
|
||||||
(define (optimize-ap-check x)
|
(define (optimize-ap-check x)
|
||||||
|
|
@ -3619,7 +3628,7 @@
|
||||||
(do-value-prim op rand* ac)]
|
(do-value-prim op rand* ac)]
|
||||||
[(new-frame base-idx size body)
|
[(new-frame base-idx size body)
|
||||||
(NonTail body ac)]
|
(NonTail body ac)]
|
||||||
[(call-cp call-convention direct-label rp-convention offset size mask)
|
[(call-cp call-convention direct-label save-cp? rp-convention offset size mask)
|
||||||
(let ([L_CALL (unique-label)])
|
(let ([L_CALL (unique-label)])
|
||||||
(case call-convention
|
(case call-convention
|
||||||
[(normal)
|
[(normal)
|
||||||
|
|
@ -3635,7 +3644,7 @@
|
||||||
`(byte 0) ; direct calls are ok
|
`(byte 0) ; direct calls are ok
|
||||||
L_CALL
|
L_CALL
|
||||||
(indirect-cpr-call)
|
(indirect-cpr-call)
|
||||||
(movl (mem 0 fpr) cpr)
|
(if save-cp? (movl (mem 0 fpr) cpr) '(nop))
|
||||||
(subl (int (frame-adjustment offset)) fpr)
|
(subl (int (frame-adjustment offset)) fpr)
|
||||||
ac)]
|
ac)]
|
||||||
[(direct)
|
[(direct)
|
||||||
|
|
@ -3649,7 +3658,7 @@
|
||||||
(rp-label rp-convention)
|
(rp-label rp-convention)
|
||||||
L_CALL
|
L_CALL
|
||||||
(call (label direct-label))
|
(call (label direct-label))
|
||||||
(movl (mem 0 fpr) cpr)
|
(if save-cp? (movl (mem 0 fpr) cpr) '(nop))
|
||||||
(subl (int (frame-adjustment offset)) fpr)
|
(subl (int (frame-adjustment offset)) fpr)
|
||||||
ac)]
|
ac)]
|
||||||
[(foreign)
|
[(foreign)
|
||||||
|
|
@ -3667,7 +3676,7 @@
|
||||||
'(byte 0)
|
'(byte 0)
|
||||||
L_CALL
|
L_CALL
|
||||||
(call ebx)
|
(call ebx)
|
||||||
(movl (mem 0 fpr) cpr)
|
(if save-cp? (movl (mem 0 fpr) cpr) '(nop))
|
||||||
(subl (int (frame-adjustment offset)) fpr)
|
(subl (int (frame-adjustment offset)) fpr)
|
||||||
ac)]
|
ac)]
|
||||||
[else
|
[else
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue