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

still working on linkage

Browse Source
This commit is contained in:
dyoo 2011-03-03 15:40:30 -05:00
parent 30e9e82877
commit 0d4a3f859d
2 changed files with 28 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
compile.rkt
View File

@ -59,9 +59,9 @@
[(eq? linkage 'return) [(eq? linkage 'return)
(make-instruction-sequence `(,(make-AssignPrimOpStatement 'proc (make-instruction-sequence `(,(make-AssignPrimOpStatement 'proc
(make-GetControlStackLabel)) (make-GetControlStackLabel))
,(make-PopEnv (lexical-environment-pop-depth cenv) ,(make-PopEnvironment (lexical-environment-pop-depth cenv)
0) 0)
,(make-PopControl) ,(make-PopControlFrame)
,(make-GotoStatement (make-Reg 'proc))))] ,(make-GotoStatement (make-Reg 'proc))))]
[(eq? linkage 'next) [(eq? linkage 'next)
empty-instruction-sequence] empty-instruction-sequence]
@ -76,10 +76,10 @@
(compile-linkage cenv linkage))) (compile-linkage cenv linkage)))
(: end-with-application-linkage (Linkage CompileTimeEnvironment InstructionSequence -> (: end-with-compiled-application-linkage (Linkage CompileTimeEnvironment InstructionSequence ->
InstructionSequence)) InstructionSequence))
;; Add linkage for applications; we need to specialize this to preserve tail calls. ;; Add linkage for applications; we need to specialize this to preserve tail calls.
(define (end-with-application-linkage linkage cenv instruction-sequence) (define (end-with-compiled-application-linkage linkage cenv instruction-sequence)
(append-instruction-sequences instruction-sequence (append-instruction-sequences instruction-sequence
(compile-application-linkage cenv linkage))) (compile-application-linkage cenv linkage)))
@ -92,12 +92,15 @@
[(eq? linkage 'return) [(eq? linkage 'return)
(make-instruction-sequence `(,(make-AssignPrimOpStatement 'proc (make-instruction-sequence `(,(make-AssignPrimOpStatement 'proc
(make-GetControlStackLabel)) (make-GetControlStackLabel))
,(make-PopControl) ,(make-PopControlFrame)
,(make-GotoStatement (make-Reg 'proc))))] ,(make-GotoStatement (make-Reg 'proc))))]
[(eq? linkage 'next) [(eq? linkage 'next)
empty-instruction-sequence] (make-instruction-sequence `(,(make-PopEnvironment (lexical-environment-pop-depth cenv)
0)))]
[(symbol? linkage) [(symbol? linkage)
(make-instruction-sequence `(,(make-GotoStatement (make-Label linkage))))])) (make-instruction-sequence `(,(make-PopEnvironment (lexical-environment-pop-depth cenv)
0)
,(make-GotoStatement (make-Label linkage))))]))
@ -277,7 +280,7 @@
;; in the environment. We need to install ;; in the environment. We need to install
;; the closure's values now. ;; the closure's values now.
(append-instruction-sequences (append-instruction-sequences
(make-instruction-sequence `(,(make-PushEnv (length (App-operands exp))))) (make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)))))
proc-code proc-code
(juggle-operands operand-codes) (juggle-operands operand-codes)
(compile-procedure-call extended-cenv (length (App-operands exp)) target linkage)))) (compile-procedure-call extended-cenv (length (App-operands exp)) target linkage))))
@ -316,6 +319,7 @@
(: compile-procedure-call (CompileTimeEnvironment Natural Target Linkage -> InstructionSequence)) (: compile-procedure-call (CompileTimeEnvironment Natural Target Linkage -> InstructionSequence))
;; Assumes the procedure value has been loaded into the proc register. ;; Assumes the procedure value has been loaded into the proc register.
;; n is the number of arguments passed in.
(define (compile-procedure-call cenv n target linkage) (define (compile-procedure-call cenv n target linkage)
(let ([primitive-branch (make-label 'primitiveBranch)] (let ([primitive-branch (make-label 'primitiveBranch)]
[compiled-branch (make-label 'compiledBranch)] [compiled-branch (make-label 'compiledBranch)]
@ -330,7 +334,7 @@
primitive-branch))) primitive-branch)))
compiled-branch compiled-branch
(end-with-application-linkage (end-with-compiled-application-linkage
compiled-linkage compiled-linkage
cenv cenv
(compile-proc-appl cenv n target compiled-linkage)) (compile-proc-appl cenv n target compiled-linkage))
@ -378,13 +382,13 @@
[(and (eq? target 'val) [(and (eq? target 'val)
(eq? linkage 'return)) (eq? linkage 'return))
;; This case happens when we're in tail position. ;; This case happens when we're in tail position.
;; FIXME: do tail call stuff! ;; We clean up the stack right before the jump, and do not add
;; Must shift existing environment to replace ;; to the control stack.
(make-instruction-sequence (make-instruction-sequence
`(,(make-AssignPrimOpStatement 'val `(,(make-AssignPrimOpStatement 'val
(make-GetCompiledProcedureEntry)) (make-GetCompiledProcedureEntry))
,(make-PopEnv (max 0 (- (lexical-environment-pop-depth cenv) n)) ,(make-PopEnvironment (max 0 (- (lexical-environment-pop-depth cenv) n))
n) n)
,(make-GotoStatement (make-Reg 'val))))] ,(make-GotoStatement (make-Reg 'val))))]
[(and (not (eq? target 'val)) [(and (not (eq? target 'val))

19
il-structs.rkt
View File

@ -52,10 +52,10 @@
GotoStatement GotoStatement
TestAndBranchStatement TestAndBranchStatement
PopEnv PopEnvironment
PopControl PushEnvironment
PushEnv PushControlFrame
PushControlFrame)) PopControlFrame))
(define-type Statement (U UnlabeledStatement (define-type Statement (U UnlabeledStatement
Symbol ;; label Symbol ;; label
)) ))
@ -68,12 +68,15 @@
#:transparent) #:transparent)
(define-struct: PopEnv ([n : Natural] ;; Pop n slots from the environment, skipping past a few first.
[skip : Natural]) (define-struct: PopEnvironment ([n : Natural]
[skip : Natural])
#:transparent) #:transparent)
(define-struct: PopControl () (define-struct: PushEnvironment ([n : Natural])
#:transparent) #:transparent)
(define-struct: PushEnv ([n : Natural])
(define-struct: PopControlFrame ()
#:transparent) #:transparent)
;; Adding a frame for getting back after procedure application. ;; Adding a frame for getting back after procedure application.