suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

still chasing abort bug

Browse Source
This commit is contained in:
Danny Yoo 2013-04-16 18:15:47 -06:00
parent c5ccbe32e5
commit d482c78ac4
2 changed files with 22 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
whalesong/compiler/compiler.rkt
View File

@ -77,6 +77,7 @@
(define lambda-bodies (collect-all-lambdas-with-bodies exp)) (define lambda-bodies (collect-all-lambdas-with-bodies exp))
(define after-lam-bodies: (make-label 'afterLamBodies)) (define after-lam-bodies: (make-label 'afterLamBodies))
(define after-first-seq: (make-label 'afterFirstSeq)) (define after-first-seq: (make-label 'afterFirstSeq))
(define abort-with-multiple-values: (make-label 'abortWithMultipleValues))
(define last: (make-label 'last)) (define last: (make-label 'last))
(define-values (after-pop-prompt-multiple: after-pop-prompt:) (define-values (after-pop-prompt-multiple: after-pop-prompt:)
(new-linked-labels 'afterPopPrompt)) (new-linked-labels 'afterPopPrompt))
@ -97,6 +98,7 @@
;; After coming back from the evaluation, rearrange the return values ;; After coming back from the evaluation, rearrange the return values
;; as a list. ;; as a list.
(make-PopControlFrame) ; pop off the synthetic prompt frame
(make-TestAndJump (make-TestZero (make-Reg 'argcount)) after-first-seq:) (make-TestAndJump (make-TestZero (make-Reg 'argcount)) after-first-seq:)
(make-PushImmediateOntoEnvironment (make-Reg 'val) #f) (make-PushImmediateOntoEnvironment (make-Reg 'val) #f)
after-first-seq: after-first-seq:
@ -105,10 +107,27 @@
(make-PopEnvironment (make-Const 1) (make-Const 0)) (make-PopEnvironment (make-Const 1) (make-Const 0))
(make-Goto (make-Label last:)) (make-Goto (make-Label last:))
;; If we abort, the abort handler code also needs to return values back:
after-pop-prompt-multiple: after-pop-prompt-multiple:
(make-PopEnvironment (make-SubtractArg (make-Reg 'argcount) (make-Const 1)) (make-DebugPrint (make-Const "abort multiple"))
(make-Const 0)) (make-TestAndJump (make-TestZero (make-Reg 'argcount)) abort-with-multiple-values:)
(make-PushImmediateOntoEnvironment (make-Reg 'val) #f)
abort-with-multiple-values:
(make-Perform (make-UnspliceRestFromStack! (make-Const 0) (make-Reg 'argcount)))
(make-AssignImmediate 'val (make-EnvLexicalReference 0 #f))
(make-PopEnvironment (make-Const 1) (make-Const 0))
(make-Goto (make-Label last:))
after-pop-prompt: after-pop-prompt:
(make-DebugPrint (make-Const "abort single"))
;; If we escaped with a single value, return that single value in a singleton list
(make-PushImmediateOntoEnvironment (make-Reg 'val) #f)
(make-Perform (make-UnspliceRestFromStack! (make-Const 0) (make-Const 1)))
(make-AssignImmediate 'val (make-EnvLexicalReference 0 #f))
(make-PopEnvironment (make-Const 1) (make-Const 0))
last: last:
;; Finally, return to the success continuation on the stack. ;; Finally, return to the success continuation on the stack.
(make-AssignImmediate 'proc (make-ControlStackLabel)) (make-AssignImmediate 'proc (make-ControlStackLabel))

2
whalesong/js-assembler/assemble.rkt
View File

@ -79,7 +79,7 @@ EOF
(assemble-label (make-Label (BasicBlock-name (first basic-blocks)))))] (assemble-label (make-Label (BasicBlock-name (first basic-blocks)))))]
[else [else
;; Otherwise, we want to run under a trampolining context. ;; Otherwise, we want to run under a trampolining context.
(display "M.c.push(new RT.Closure(function(M){ console.log('calling success'); setTimeout(success, 0); },RT.makeArityAtLeast(0),void(0),'toplevel'));\n" op) (display "M.c.push(new RT.CallFrame(function(M){ setTimeout(success, 0); },M.p));\n" op)
(fprintf op "M.trampoline(~a, ~a); })" (fprintf op "M.trampoline(~a, ~a); })"
(assemble-label (make-Label (BasicBlock-name (first basic-blocks)))) (assemble-label (make-Label (BasicBlock-name (first basic-blocks))))
(cond [(eq? trampoline-option 'with-preemption) (cond [(eq? trampoline-option 'with-preemption)