modifying popenvironment to take arbitrary oparg instead of guaranteed constant.
This commit is contained in:
Danny Yoo
parent
49d2fd4803
commit
1873a9ca78
16
assemble.rkt
16
assemble.rkt
|
|
@ -296,15 +296,13 @@ EOF
|
|||
"undefined")))
|
||||
", ")))]
|
||||
[(PopEnvironment? stmt)
|
||||
(if (= (PopEnvironment-n stmt) 0)
|
||||
""
|
||||
(if (= (PopEnvironment-skip stmt) 0)
|
||||
(format "MACHINE.env.length = MACHINE.env.length - ~a;"
|
||||
(PopEnvironment-n stmt))
|
||||
(format "MACHINE.env.splice(MACHINE.env.length-(~a),~a);"
|
||||
(+ (PopEnvironment-skip stmt)
|
||||
(PopEnvironment-n stmt))
|
||||
(PopEnvironment-n stmt))))])))
|
||||
(if (= (PopEnvironment-skip stmt) 0)
|
||||
(format "MACHINE.env.length = MACHINE.env.length - ~a;"
|
||||
(assemble-oparg (PopEnvironment-n stmt)))
|
||||
(format "MACHINE.env.splice(MACHINE.env.length-(~a + ~a),~a);"
|
||||
(PopEnvironment-skip stmt)
|
||||
(assemble-oparg (PopEnvironment-n stmt))
|
||||
(assemble-oparg (PopEnvironment-n stmt))))])))
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -43,7 +43,7 @@
|
|||
1 ;; the continuation consumes a single value
|
||||
(list 0 1)
|
||||
'call/cc))
|
||||
,(make-PopEnvironment 2 0)
|
||||
,(make-PopEnvironment (make-Const 2) 0)
|
||||
,(make-AssignImmediateStatement 'argcount (make-Const 1))))
|
||||
|
||||
;; Finally, do a tail call into f.
|
||||
|
|
@ -166,7 +166,7 @@
|
|||
|
||||
;; Push the procedure into proc.
|
||||
(make-AssignImmediateStatement 'proc (make-EnvLexicalReference 0 #f))
|
||||
(make-PopEnvironment 1 0)
|
||||
(make-PopEnvironment (make-Const 1) 0)
|
||||
;; Correct the number of arguments to be passed.
|
||||
(make-AssignPrimOpStatement 'val
|
||||
(make-CallKernelPrimitiveProcedure 'sub1
|
||||
|
|
|
|||
16
compile.rkt
16
compile.rkt
|
|
@ -174,7 +174,7 @@
|
|||
`(,(make-PerformStatement (make-ExtendEnvironment/Prefix! names))))
|
||||
(compile (Top-code top) (cons (Top-prefix top) cenv) target next-linkage)
|
||||
(make-instruction-sequence
|
||||
`(,(make-PopEnvironment 1 0)))))))
|
||||
`(,(make-PopEnvironment (make-Const 1) 0)))))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -192,7 +192,7 @@
|
|||
(cond
|
||||
[(ReturnLinkage? linkage)
|
||||
(make-instruction-sequence `(,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))
|
||||
,(make-PopEnvironment (length cenv) 0)
|
||||
,(make-PopEnvironment (make-Const (length cenv)) 0)
|
||||
,(make-PopControlFrame)
|
||||
,(make-GotoStatement (make-Reg 'proc))))]
|
||||
[(PromptLinkage? linkage)
|
||||
|
|
@ -589,7 +589,7 @@
|
|||
(if (empty? rest-operands)
|
||||
empty-instruction-sequence
|
||||
(make-instruction-sequence `(,(make-PopEnvironment
|
||||
(length rest-operands)
|
||||
(make-Const (length rest-operands))
|
||||
0))))]
|
||||
|
||||
[(constant-operand-poss)
|
||||
|
|
@ -826,7 +826,7 @@
|
|||
`(,(make-PerformStatement (make-CheckPrimitiveArity! (make-Reg 'argcount)))
|
||||
,(make-AssignPrimOpStatement 'val
|
||||
(make-ApplyPrimitiveProcedure))
|
||||
,(make-PopEnvironment number-of-arguments 0)
|
||||
,(make-PopEnvironment (make-Reg 'argcount) 0)
|
||||
,(make-AssignImmediateStatement target (make-Reg 'val))))
|
||||
(LabelLinkage-label after-call)))))))
|
||||
|
||||
|
|
@ -868,7 +868,7 @@
|
|||
(make-instruction-sequence
|
||||
`(,(make-AssignPrimOpStatement 'val
|
||||
(make-GetCompiledProcedureEntry))))
|
||||
(make-instruction-sequence `(,(make-PopEnvironment num-slots-to-delete n)))
|
||||
(make-instruction-sequence `(,(make-PopEnvironment (make-Const num-slots-to-delete) n)))
|
||||
(make-instruction-sequence
|
||||
`(;; Assign the proc value of the existing call frame
|
||||
,(make-PerformStatement
|
||||
|
|
@ -1017,7 +1017,7 @@
|
|||
rhs-code
|
||||
body-code
|
||||
(LabelLinkage-label after-body-code)
|
||||
(make-instruction-sequence `(,(make-PopEnvironment 1 0)))
|
||||
(make-instruction-sequence `(,(make-PopEnvironment (make-Const 1) 0)))
|
||||
after-let1))))
|
||||
|
||||
|
||||
|
|
@ -1053,7 +1053,7 @@
|
|||
body-code
|
||||
(LabelLinkage-label after-body-code)
|
||||
(if (> n 0)
|
||||
(make-instruction-sequence `(,(make-PopEnvironment n 0)))
|
||||
(make-instruction-sequence `(,(make-PopEnvironment (make-Const n) 0)))
|
||||
empty-instruction-sequence)
|
||||
after-let))))
|
||||
|
||||
|
|
@ -1116,7 +1116,7 @@
|
|||
(compile (LetRec-body exp) extended-cenv (adjust-target-depth target n) letrec-linkage)
|
||||
(LabelLinkage-label after-body-code)
|
||||
(if (> n 0)
|
||||
(make-instruction-sequence `(,(make-PopEnvironment n 0)))
|
||||
(make-instruction-sequence `(,(make-PopEnvironment (make-Const n) 0)))
|
||||
empty-instruction-sequence)))))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -84,7 +84,7 @@
|
|||
|
||||
|
||||
;; Pop n slots from the environment, skipping past a few first.
|
||||
(define-struct: PopEnvironment ([n : Natural]
|
||||
(define-struct: PopEnvironment ([n : OpArg]
|
||||
[skip : Natural])
|
||||
#:transparent)
|
||||
(define-struct: PushEnvironment ([n : Natural]
|
||||
|
|
|
|||
|
|
@ -152,7 +152,9 @@
|
|||
|
||||
(: step-pop-environment! (machine PopEnvironment -> 'ok))
|
||||
(define (step-pop-environment! m stmt)
|
||||
(env-pop! m (PopEnvironment-n stmt) (PopEnvironment-skip stmt)))
|
||||
(env-pop! m
|
||||
(ensure-natural (evaluate-oparg m (PopEnvironment-n stmt)))
|
||||
(PopEnvironment-skip stmt)))
|
||||
|
||||
|
||||
(: step-push-control-frame! (machine PushControlFrame -> 'ok))
|
||||
|
|
|
|||
|
|
@ -114,7 +114,7 @@
|
|||
"MACHINE.env.length")
|
||||
"2")
|
||||
(test (E-many (list (make-PushEnvironment 2 #f)
|
||||
(make-PopEnvironment 1 0))
|
||||
(make-PopEnvironment (make-Const 1) 0))
|
||||
"MACHINE.env.length")
|
||||
"1")
|
||||
|
||||
|
|
@ -203,7 +203,7 @@
|
|||
(make-AssignPrimOpStatement 'proc (make-MakeCompiledProcedure 'closureStart 0
|
||||
(list 0 1)
|
||||
'closureStart))
|
||||
(make-PopEnvironment 2 0)
|
||||
(make-PopEnvironment (make-Const 2) 0)
|
||||
(make-GotoStatement (make-Label 'closureStart))
|
||||
'theEnd)
|
||||
"String(MACHINE.env.length) + ',' + MACHINE.env[1] + ',' + MACHINE.env[0]")
|
||||
|
|
@ -227,7 +227,7 @@
|
|||
(make-AssignPrimOpStatement 'proc (make-MakeCompiledProcedure 'closureStart 0
|
||||
(list 0 1)
|
||||
'closureStart))
|
||||
(make-PopEnvironment 2 0)
|
||||
(make-PopEnvironment (make-Const 2) 0)
|
||||
(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry)))
|
||||
"typeof(MACHINE.val) + ',' + (MACHINE.val === MACHINE.proc.label)")
|
||||
"function,true")
|
||||
|
|
@ -249,7 +249,7 @@
|
|||
(make-AssignPrimOpStatement 'proc (make-MakeCompiledProcedure 'closureStart 5
|
||||
(list 0 1)
|
||||
'closureStart))
|
||||
(make-PopEnvironment 2 0)
|
||||
(make-PopEnvironment (make-Const 2) 0)
|
||||
(make-PerformStatement (make-CheckClosureArity! (make-Const 5))))))
|
||||
|
||||
;; this should fail, since the check is for 1, but the closure expects 5.
|
||||
|
|
@ -271,7 +271,7 @@
|
|||
(make-AssignPrimOpStatement 'proc (make-MakeCompiledProcedure 'closureStart 5
|
||||
(list 0 1)
|
||||
'closureStart))
|
||||
(make-PopEnvironment 2 0)
|
||||
(make-PopEnvironment (make-Const 2) 0)
|
||||
(make-PerformStatement (make-CheckClosureArity! (make-Const 1))))))
|
||||
(error 'expected-failure))
|
||||
|
||||
|
|
|
|||
|
|
@ -131,35 +131,35 @@
|
|||
|
||||
;; PopEnv
|
||||
(let ([m (new-machine `(,(make-PushEnvironment 20 #f)
|
||||
,(make-PopEnvironment 20 0)))])
|
||||
,(make-PopEnvironment (make-Const 20) 0)))])
|
||||
(test (machine-env (run m)) '()))
|
||||
|
||||
(let* ([m (new-machine `(,(make-PushEnvironment 3 #f)
|
||||
,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const "hewie"))
|
||||
,(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) (make-Const "dewey"))
|
||||
,(make-AssignImmediateStatement (make-EnvLexicalReference 2 #f) (make-Const "louie"))
|
||||
,(make-PopEnvironment 1 0)))])
|
||||
,(make-PopEnvironment (make-Const 1) 0)))])
|
||||
(test (machine-env (run m)) '("dewey" "louie")))
|
||||
|
||||
(let* ([m (new-machine `(,(make-PushEnvironment 3 #f)
|
||||
,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const "hewie"))
|
||||
,(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) (make-Const "dewey"))
|
||||
,(make-AssignImmediateStatement (make-EnvLexicalReference 2 #f) (make-Const "louie"))
|
||||
,(make-PopEnvironment 1 1)))])
|
||||
,(make-PopEnvironment (make-Const 1) 1)))])
|
||||
(test (machine-env (run m)) '("hewie" "louie")))
|
||||
|
||||
(let* ([m (new-machine `(,(make-PushEnvironment 3 #f)
|
||||
,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const "hewie"))
|
||||
,(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) (make-Const "dewey"))
|
||||
,(make-AssignImmediateStatement (make-EnvLexicalReference 2 #f) (make-Const "louie"))
|
||||
,(make-PopEnvironment 1 2)))])
|
||||
,(make-PopEnvironment (make-Const 1) 2)))])
|
||||
(test (machine-env (run m)) '("hewie" "dewey")))
|
||||
|
||||
(let* ([m (new-machine `(,(make-PushEnvironment 3 #f)
|
||||
,(make-AssignImmediateStatement (make-EnvLexicalReference 0 #f) (make-Const "hewie"))
|
||||
,(make-AssignImmediateStatement (make-EnvLexicalReference 1 #f) (make-Const "dewey"))
|
||||
,(make-AssignImmediateStatement (make-EnvLexicalReference 2 #f) (make-Const "louie"))
|
||||
,(make-PopEnvironment 2 1)))])
|
||||
,(make-PopEnvironment (make-Const 2) 1)))])
|
||||
(test (machine-env (run m)) '("hewie")))
|
||||
|
||||
|
||||
|
|
@ -427,7 +427,7 @@
|
|||
0
|
||||
(list 3 0 2)
|
||||
'procedure-entry))
|
||||
,(make-PopEnvironment 3 0)
|
||||
,(make-PopEnvironment (make-Const 3) 0)
|
||||
,(make-GotoStatement (make-Label 'end))
|
||||
procedure-entry
|
||||
end
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user