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

check trampoline on function entry and function exit.

Browse Source
This commit is contained in:
Danny Yoo 2011-09-09 15:46:43 -04:00
parent 13bdc38418
commit 690e3a423c
1 changed files with 19 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
js-assembler/assemble.rkt
View File

@ -46,12 +46,12 @@
(define-values (basic-blocks entry-points) (fracture stmts)) (define-values (basic-blocks entry-points) (fracture stmts))
(define function-entry-names (define function-entry-and-exit-names
(list->set (get-function-entry-names stmts))) (list->set (get-function-entry-and-exit-names stmts)))
(write-blocks basic-blocks (write-blocks basic-blocks
(list->set entry-points) (list->set entry-points)
function-entry-names function-entry-and-exit-names
op) op)
(write-linked-label-attributes stmts op) (write-linked-label-attributes stmts op)
@ -73,7 +73,7 @@ EOF
(: write-blocks ((Listof BasicBlock) (Setof Symbol) (Setof Symbol) Output-Port -> Void)) (: write-blocks ((Listof BasicBlock) (Setof Symbol) (Setof Symbol) Output-Port -> Void))
;; Write out all the basic blocks associated to an entry point. ;; Write out all the basic blocks associated to an entry point.
(define (write-blocks blocks entry-points function-entry-names op) (define (write-blocks blocks entry-points function-entry-and-exit-names op)
(: blockht : Blockht) (: blockht : Blockht)
(define blockht (make-hash)) (define blockht (make-hash))
@ -89,7 +89,7 @@ EOF
(assemble-basic-block (hash-ref blockht s) (assemble-basic-block (hash-ref blockht s)
blockht blockht
entry-points entry-points
function-entry-names function-entry-and-exit-names
op) op)
(newline op)) (newline op))
entry-points)) entry-points))
@ -178,7 +178,7 @@ EOF
(: assemble-basic-block (BasicBlock Blockht (Setof Symbol) (Setof Symbol) Output-Port -> 'ok)) (: assemble-basic-block (BasicBlock Blockht (Setof Symbol) (Setof Symbol) Output-Port -> 'ok))
(define (assemble-basic-block a-basic-block blockht entry-points function-entry-names op) (define (assemble-basic-block a-basic-block blockht entry-points function-entry-and-exit-names op)
(match (BasicBlock-stmts a-basic-block) (match (BasicBlock-stmts a-basic-block)
;; [(list (struct PopEnvironment (n (and (? (lambda (c) (equal? c (Const 0)))) ;; [(list (struct PopEnvironment (n (and (? (lambda (c) (equal? c (Const 0))))
;; skip))) ;; skip)))
@ -190,14 +190,14 @@ EOF
;; (assemble-label target)) ;; (assemble-label target))
;; 'ok] ;; 'ok]
[else [else
(default-assemble-basic-block a-basic-block blockht entry-points function-entry-names op)])) (default-assemble-basic-block a-basic-block blockht entry-points function-entry-and-exit-names op)]))
(: default-assemble-basic-block (BasicBlock Blockht (Setof Symbol) (Setof Symbol) Output-Port -> 'ok)) (: default-assemble-basic-block (BasicBlock Blockht (Setof Symbol) (Setof Symbol) Output-Port -> 'ok))
(define (default-assemble-basic-block a-basic-block blockht entry-points function-entry-names op) (define (default-assemble-basic-block a-basic-block blockht entry-points function-entry-and-exit-names op)
(cond (cond
[(set-contains? function-entry-names (BasicBlock-name a-basic-block)) [(set-contains? function-entry-and-exit-names (BasicBlock-name a-basic-block))
(fprintf op "var ~a=function(M){if(--M.callsBeforeTrampoline<0){throw ~a;}\n" (fprintf op "var ~a=function(M){if(--M.callsBeforeTrampoline<0){throw ~a;}\n"
(assemble-label (make-Label (BasicBlock-name a-basic-block))) (assemble-label (make-Label (BasicBlock-name a-basic-block)))
(assemble-label (make-Label (BasicBlock-name a-basic-block))))] (assemble-label (make-Label (BasicBlock-name a-basic-block))))]
@ -562,24 +562,28 @@ EOF
(: get-function-entry-names ((Listof Statement) -> (Listof Symbol))) (: get-function-entry-and-exit-names ((Listof Statement) -> (Listof Symbol)))
(define (get-function-entry-names stmts) (define (get-function-entry-and-exit-names stmts)
(cond (cond
[(empty? stmts) [(empty? stmts)
'()] '()]
[else [else
(define first-stmt (first stmts)) (define first-stmt (first stmts))
(cond (cond
[(LinkedLabel? first-stmt)
(cons (LinkedLabel-label first-stmt)
(cons (LinkedLabel-linked-to first-stmt)
(get-function-entry-and-exit-names (rest stmts))))]
[(AssignPrimOpStatement? first-stmt) [(AssignPrimOpStatement? first-stmt)
(define op (AssignPrimOpStatement-op first-stmt)) (define op (AssignPrimOpStatement-op first-stmt))
(cond (cond
[(MakeCompiledProcedure? op) [(MakeCompiledProcedure? op)
(cons (MakeCompiledProcedure-label op) (cons (MakeCompiledProcedure-label op)
(get-function-entry-names (rest stmts)))] (get-function-entry-and-exit-names (rest stmts)))]
[(MakeCompiledProcedureShell? first-stmt) [(MakeCompiledProcedureShell? first-stmt)
(cons (MakeCompiledProcedureShell-label op) (cons (MakeCompiledProcedureShell-label op)
(get-function-entry-names (rest stmts)))] (get-function-entry-and-exit-names (rest stmts)))]
[else [else
(get-function-entry-names (rest stmts))])] (get-function-entry-and-exit-names (rest stmts))])]
[else [else
(get-function-entry-names (rest stmts))])])) (get-function-entry-and-exit-names (rest stmts))])]))