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

debuggin

Browse Source
This commit is contained in:
Danny Yoo 2012-02-27 18:09:19 -05:00
parent 8d9c1100f7
commit 1d6d1d481a
6 changed files with 60 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
compiler/compiler.rkt
View File

@ -501,7 +501,11 @@
prefix-element)
))]
[else
(make-AssignPrimOp target prefix-element)])]
(make-AssignImmediate
target
(make-EnvPrefixReference (ToplevelRef-depth exp)
(ToplevelRef-pos exp)
#t))])]
[else
(append-instruction-sequences
(if (ToplevelRef-check-defined? exp)
@ -512,7 +516,8 @@
(make-AssignImmediate
target
(make-EnvPrefixReference (ToplevelRef-depth exp)
(ToplevelRef-pos exp))))])
(ToplevelRef-pos exp)
#f)))])
singular-context-check))))
@ -525,25 +530,30 @@
(define (compile-toplevel-set exp cenv target linkage)
(define prefix (ensure-prefix (list-ref cenv (ToplevelSet-depth exp))))
(define prefix-element (list-ref (Prefix-names prefix) (ToplevelSet-pos exp)))
(let ([lexical-pos (make-EnvPrefixReference (ToplevelSet-depth exp)
(ToplevelSet-pos exp))])
(let ([get-value-code
(cond
[(ModuleVariable? prefix-element)
(compile (ToplevelSet-value exp) cenv prefix-element
next-linkage/expects-single)]
[else
(compile (ToplevelSet-value exp) cenv lexical-pos
next-linkage/expects-single)])]
[singular-context-check (emit-singular-context linkage)])
(end-with-linkage
linkage
cenv
(append-instruction-sequences
get-value-code
(make-AssignImmediate target (make-Const (void)))
singular-context-check)))))
(let ([get-value-code
(cond
[(ModuleVariable? prefix-element)
(compile (ToplevelSet-value exp)
cenv
(make-EnvPrefixReference (ToplevelSet-depth exp)
(ToplevelSet-pos exp)
#t)
next-linkage/expects-single)]
[else
(compile (ToplevelSet-value exp)
cenv
(make-EnvPrefixReference (ToplevelSet-depth exp)
(ToplevelSet-pos exp)
#f)
next-linkage/expects-single)])]
[singular-context-check (emit-singular-context linkage)])
(end-with-linkage
linkage
cenv
(append-instruction-sequences
get-value-code
(make-AssignImmediate target (make-Const (void)))
singular-context-check))))
(: compile-branch (Branch CompileTimeEnvironment Target Linkage -> InstructionSequence))
@ -1296,9 +1306,10 @@
[(ToplevelRef? e)
(cond
[(ModuleVariable? k)
k]
(make-EnvPrefixReference (ToplevelRef-depth e) (ToplevelRef-pos e) #t)]
[else
(make-EnvPrefixReference (ToplevelRef-depth e) (ToplevelRef-pos e))])]
(make-EnvPrefixReference (ToplevelRef-depth e) (ToplevelRef-pos e) #f)])]
[else
(error 'all-operands-are-constant "Impossible")]))
rands
@ -2128,7 +2139,8 @@
;; there may be additional values that are currently there.
(make-EnvPrefixReference (+ (ensure-natural (sub1 n))
(ToplevelRef-depth id))
(ToplevelRef-pos id))
(ToplevelRef-pos id)
#f)
from))
ids
(if (> n 0)
@ -2215,7 +2227,8 @@
(EnvLexicalReference-unbox? target))]
[(EnvPrefixReference? target)
(make-EnvPrefixReference (+ n (EnvPrefixReference-depth target))
(EnvPrefixReference-pos target))]
(EnvPrefixReference-pos target)
(EnvPrefixReference-modvar? target))]
[(PrimitivesReference? target)
target]
[(ControlFrameTemporary? target)

9
compiler/lexical-env.rkt
View File

@ -48,11 +48,11 @@
(let: ([n : (U False Symbol GlobalBucket ModuleVariable) (first names)])
(cond
[(and (symbol? n) (eq? name n))
(make-EnvPrefixReference depth pos)]
(make-EnvPrefixReference depth pos #f)]
[(and (ModuleVariable? n) (eq? name (ModuleVariable-name n)))
(make-EnvPrefixReference depth pos)]
(make-EnvPrefixReference depth pos #t)]
[(and (GlobalBucket? n) (eq? name (GlobalBucket-name n)))
(make-EnvPrefixReference depth pos)]
(make-EnvPrefixReference depth pos #f)]
[else
(prefix-loop (rest names) (add1 pos))]))]))]
@ -218,7 +218,8 @@
(EnvLexicalReference-unbox? target))]
[(EnvPrefixReference? target)
(make-EnvPrefixReference (+ n (EnvPrefixReference-depth target))
(EnvPrefixReference-pos target))]
(EnvPrefixReference-pos target)
(EnvPrefixReference-modvar? target))]
[(EnvWholePrefixReference? target)
(make-EnvWholePrefixReference (+ n (EnvWholePrefixReference-depth target)))]))

3
compiler/lexical-structs.rkt
View File

@ -53,7 +53,8 @@
#:transparent)
(define-struct: EnvPrefixReference ([depth : Natural]
[pos : Natural])
[pos : Natural]
[modvar? : Boolean])
#:transparent)
(define-struct: EnvWholePrefixReference ([depth : Natural])

3
compiler/optimize-il.rkt
View File

@ -404,7 +404,8 @@
(EnvLexicalReference-unbox? oparg))]
[(EnvPrefixReference? oparg)
(make-EnvPrefixReference (ensure-natural (+ n (EnvPrefixReference-depth oparg)))
(EnvPrefixReference-pos oparg))]
(EnvPrefixReference-pos oparg)
(EnvPrefixReference-modvar? oparg))]
[(EnvWholePrefixReference? oparg)
(make-EnvWholePrefixReference (ensure-natural (+ n (EnvWholePrefixReference-depth oparg))))]
[(SubtractArg? oparg)

35
js-assembler/assemble-helpers.rkt
View File

@ -248,26 +248,6 @@
(assemble-numeric-constant (imag-part a-num))
")")]))
(: assemble-lexical-reference (EnvLexicalReference -> String))
(define (assemble-lexical-reference a-lex-ref)
@ -277,11 +257,20 @@
(format "M.e[M.e.length-~a]"
(add1 (EnvLexicalReference-depth a-lex-ref)))))
(: assemble-prefix-reference (EnvPrefixReference -> String))
(define (assemble-prefix-reference a-ref)
(format "M.e[M.e.length-~a][~a]"
(add1 (EnvPrefixReference-depth a-ref))
(EnvPrefixReference-pos a-ref)))
(cond
[(EnvPrefixReference-modvar? a-ref)
(format "M.e[M.e.length-~a][~a].prefix[M.e[M.e.length-~a][~a].offset]"
(add1 (EnvPrefixReference-depth a-ref))
(EnvPrefixReference-pos a-ref)
(add1 (EnvPrefixReference-depth a-ref))
(EnvPrefixReference-pos a-ref))]
[else
(format "M.e[M.e.length-~a][~a]"
(add1 (EnvPrefixReference-depth a-ref))
(EnvPrefixReference-pos a-ref))]))
(: assemble-whole-prefix-reference (EnvWholePrefixReference -> String))
(define (assemble-whole-prefix-reference a-prefix-ref)

2
version.rkt
View File

@ -7,4 +7,4 @@
(provide version)
(: version String)
(define version "1.186")
(define version "1.187")