diff --git a/assemble.rkt b/assemble.rkt index f3f72a7..e23dfcb 100644 --- a/assemble.rkt +++ b/assemble.rkt @@ -29,6 +29,10 @@ (displayln (assemble-basic-block basic-block) op) (newline op)) basic-blocks) + (for-each (lambda: ([a-paired-label : PairedLabel]) + (assemble-paired-label a-paired-label op) + (newline op)) + (collect-paired-labels stmts)) (fprintf op "MACHINE.params.currentErrorHandler = fail;\n") (fprintf op "MACHINE.params.currentSuccessHandler = success;\n") (fprintf op #< (Listof PairedLabel))) +(define (collect-paired-labels stmts) + (cond + [(empty? stmts) + empty] + [else + (let ([first-stmt (first stmts)]) + (cond + [(PairedLabel? first-stmt) + (cons first-stmt (collect-paired-labels (rest stmts)))] + [else + (collect-paired-labels (rest stmts))]))])) ;; collect-general-jump-targets: (listof stmt) -> (listof label) @@ -493,3 +508,10 @@ EOF (assemble-label a-location)])) +(: assemble-paired-label (PairedLabel Output-Port -> 'ok)) +;; Write out the code to make it easy to jump to the previous label. +(define (assemble-paired-label a-paired-label op) + (fprintf op "~a.predecessor = ~a;" + (PairedLabel-label a-paired-label) + (PairedLabel-previous a-paired-label)) + 'ok) \ No newline at end of file diff --git a/compile.rkt b/compile.rkt index d851f3f..d93a729 100644 --- a/compile.rkt +++ b/compile.rkt @@ -821,20 +821,22 @@ (: compile-procedure-call/statically-known-lam (StaticallyKnownLam CompileTimeEnvironment CompileTimeEnvironment Natural Target Linkage -> InstructionSequence)) (define (compile-procedure-call/statically-known-lam static-knowledge cenv extended-cenv n target linkage) - (let*: ([after-call : LabelLinkage (make-LabelLinkage (make-label 'afterCall))] - [compiled-linkage : Linkage (if (ReturnLinkage? linkage) - linkage - after-call)]) - (append-instruction-sequences - (compile-proc-appl extended-cenv - (make-Label (StaticallyKnownLam-entry-point static-knowledge)) - n - target - compiled-linkage) - (end-with-linkage - linkage - cenv - (LabelLinkage-label after-call))))) + (let-values ([(after-call-multiple + after-call-single) + (make-paired-labels 'afterCallMultiple 'afterCallSingle)]) + (let*: ([compiled-linkage : Linkage (if (ReturnLinkage? linkage) + linkage + (make-Label after-call-single))]) + (append-instruction-sequences + (compile-proc-appl extended-cenv + (make-Label (StaticallyKnownLam-entry-point static-knowledge)) + n + target + compiled-linkage) + (end-with-linkage + linkage + cenv + after-call-single))))) diff --git a/il-structs.rkt b/il-structs.rkt index 5dbdffd..458af37 100644 --- a/il-structs.rkt +++ b/il-structs.rkt @@ -304,10 +304,10 @@ -(: make-paired-labels (Symbol -> (values Symbol PairedLabel))) -(define (make-paired-labels name) - (let* ([first-label (make-label name)] - [second-label (make-label name)]) +(: make-paired-labels (Symbol Symbol -> (values Symbol PairedLabel))) +(define (make-paired-labels first-name second-name) + (let* ([first-label (make-label first-name)] + [second-label (make-label second-name)]) (values first-label (make-PairedLabel second-label first-label))))