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

some code cleanup

Browse Source
This commit is contained in:
Danny Yoo 2012-03-23 16:31:22 -04:00
parent e16a66f20b
commit e3e82f66a3
3 changed files with 247 additions and 244 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
compiler/compiler.rkt
View File

@ -10,7 +10,6 @@
"analyzer-structs.rkt"
"../parameters.rkt"
"../sets.rkt"
racket/bool
racket/list
racket/match)
@ -42,18 +41,17 @@
;; Note: the toplevel generates the lambda body streams at the head, and then the
;; rest of the instruction stream.
(define (-compile exp target linkage)
(let* ([after-lam-bodies (make-label 'afterLamBodies)]
[before-pop-prompt-multiple (make-label 'beforePopPromptMultiple)]
[before-pop-prompt (make-LinkedLabel
(make-label 'beforePopPrompt)
before-pop-prompt-multiple)])
(define lambda-bodies (collect-all-lambdas-with-bodies exp))
(define after-lam-bodies (make-label 'afterLamBodies))
(define-values (before-pop-prompt-multiple before-pop-prompt)
(new-linked-labels 'beforePopPrompt))
(optimize-il
(statements
(append-instruction-sequences
;; Layout the lambda bodies...
(make-Goto (make-Label after-lam-bodies))
(compile-lambda-bodies (collect-all-lambdas-with-bodies exp))
(compile-lambda-bodies lambda-bodies)
after-lam-bodies
;; Begin a prompted evaluation:
@ -66,7 +64,7 @@
before-pop-prompt
(if (eq? target 'val)
empty-instruction-sequence
(make-AssignImmediate target (make-Reg 'val))))))))
(make-AssignImmediate target (make-Reg 'val)))))))
@ -518,10 +516,8 @@
[(kernel-module-name? a-module-name)
empty-instruction-sequence]
[else
(let* ([linked (make-label 'linked)]
[on-return-multiple (make-label 'onReturnMultiple)]
[on-return (make-LinkedLabel (make-label 'onReturn)
on-return-multiple)])
(define linked (make-label 'linked))
(define-values (on-return-multiple on-return) (new-linked-labels 'onReturn))
(append-instruction-sequences
(make-TestAndJump (make-TestTrue (make-ModulePredicate a-module-name 'linked?))
linked)
@ -541,7 +537,7 @@
(make-PopEnvironment (new-SubtractArg (make-Reg 'argcount)
(make-Const 1))
(make-Const 0))
on-return))]))
on-return)]))
@ -752,9 +748,8 @@
(cond [(empty? seq)
(end-with-linkage linkage cenv empty-instruction-sequence)]
[(empty? (rest seq))
(let* ([on-return/multiple (make-label 'beforePromptPopMultiple)]
[on-return (make-LinkedLabel (make-label 'beforePromptPop)
on-return/multiple)])
(define-values (on-return/multiple on-return)
(new-linked-labels 'beforePromptPop))
(end-with-linkage
linkage
cenv
@ -765,11 +760,10 @@
(emit-values-context-check-on-procedure-return (linkage-context linkage)
on-return/multiple
on-return)
(make-AssignImmediate target (make-Reg 'val)))))]
(make-AssignImmediate target (make-Reg 'val))))]
[else
(let* ([on-return/multiple (make-label 'beforePromptPopMultiple)]
[on-return (make-LinkedLabel (make-label 'beforePromptPop)
on-return/multiple)])
(define-values (on-return/multiple on-return)
(new-linked-labels 'beforePromptPop))
(append-instruction-sequences
(make-PushControlFrame/Prompt (make-DefaultContinuationPromptTag)
on-return)
@ -780,7 +774,7 @@
(make-Const 1))
(make-Const 0))
on-return
(compile-splice (rest seq) cenv target linkage)))]))
(compile-splice (rest seq) cenv target linkage))]))
(: compile-begin0 ((Listof Expression) CompileTimeEnvironment Target Linkage -> InstructionSequence))
@ -1767,33 +1761,30 @@
;; 2. Non-tail calls (next/label linkage) that write to val
;; 3. Calls in argument position (next/label linkage) that write to the stack.
(define (compile-compiled-procedure-application cenv number-of-arguments entry-point target linkage)
(let* ([entry-point-target
(define entry-point-target
;; Optimization: if the entry-point is known to be a static label,
;; use that. Otherwise, grab the entry point from the proc register.
(cond [(Label? entry-point)
entry-point]
[(eq? entry-point 'dynamic)
(make-CompiledProcedureEntry (make-Reg 'proc))])]
(make-CompiledProcedureEntry (make-Reg 'proc))]))
;; If the target isn't val, migrate the value from val into it.
[maybe-migrate-val-to-target
(define maybe-migrate-val-to-target
(cond
[(eq? target 'val)
empty-instruction-sequence]
[else
(make-AssignImmediate target (make-Reg 'val))])]
(make-AssignImmediate target (make-Reg 'val))]))
[on-return/multiple (make-label 'procReturnMultiple)]
[on-return (make-LinkedLabel (make-label 'procReturn)
on-return/multiple)]
(define-values (on-return/multiple on-return) (new-linked-labels 'procReturn))
;; This code does the initial jump into the procedure. Clients of this code
;; are expected to generate the proc-return-multiple and proc-return code afterwards.
[nontail-jump-into-procedure
(define nontail-jump-into-procedure
(append-instruction-sequences
(make-PushControlFrame/Call on-return)
(make-Goto entry-point-target))])
(make-Goto entry-point-target)))
(cond [(ReturnLinkage? linkage)
(cond
@ -1836,7 +1827,7 @@
nontail-jump-into-procedure
check-values-context-on-procedure-return
maybe-migrate-val-to-target
maybe-jump-to-label))])))
maybe-jump-to-label))]))
@ -2228,18 +2219,18 @@
(: in-other-context ((U NextLinkage LabelLinkage) -> InstructionSequence))
(define (in-other-context linkage)
(let* ([on-return/multiple: (make-label 'procReturnMultiple)]
[on-return: (make-LinkedLabel (make-label 'procReturn) on-return/multiple:)]
[context (linkage-context linkage)]
[check-values-context-on-procedure-return
(define-values (on-return/multiple: on-return:)
(new-linked-labels 'procReturn))
(define context (linkage-context linkage))
(define check-values-context-on-procedure-return
(emit-values-context-check-on-procedure-return
context on-return/multiple: on-return:)]
[maybe-migrate-val-to-target
context on-return/multiple: on-return:))
(define maybe-migrate-val-to-target
(cond
[(eq? target 'val)
empty-instruction-sequence]
[else
(make-AssignImmediate target (make-Reg 'val))])])
(make-AssignImmediate target (make-Reg 'val))]))
(append-instruction-sequences
(make-PushControlFrame/Call on-return:)
(compile (WithContMark-key exp) cenv 'val next-linkage/expects-single)
@ -2249,7 +2240,7 @@
(make-Perform (make-InstallContinuationMarkEntry!))
(compile (WithContMark-body exp) cenv 'val return-linkage/nontail)
check-values-context-on-procedure-return
maybe-migrate-val-to-target)))
maybe-migrate-val-to-target))
(cond
[(ReturnLinkage? linkage)
(in-return-context)]

12
compiler/il-structs.rkt
View File

@ -206,6 +206,18 @@
#:transparent)
;; Returns a pair of labels, the first being the mutiple-value-return
;; label and the second its complementary single-value-return label.
(: new-linked-labels (Symbol -> (Values Symbol LinkedLabel)))
(define (new-linked-labels sym)
(define a-label-multiple (make-label (string->symbol (format "~aMultiple" sym))))
(define a-label (make-LinkedLabel (make-label sym) a-label-multiple))
(values a-label-multiple a-label))
;; FIXME: it would be nice if I can reduce AssignImmediate and
;; AssignPrimOp into a single Assign statement, but I run into major
;; issues with Typed Racket taking minutes to compile. So we're

2
version.rkt
View File

@ -7,4 +7,4 @@
(provide version)
(: version String)
(define version "1.228")
(define version "1.229")