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

9
compiler/lexical-env.rkt
View File

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

3
compiler/lexical-structs.rkt
View File

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

3
compiler/optimize-il.rkt
View File

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

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

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

2
version.rkt
View File

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