From 1d6d1d481a0b37677efac9a3fbfcb7ceda42f35f Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Mon, 27 Feb 2012 18:09:19 -0500 Subject: [PATCH] debuggin --- compiler/compiler.rkt | 63 +++++++++++++++++++------------ compiler/lexical-env.rkt | 9 +++-- compiler/lexical-structs.rkt | 3 +- compiler/optimize-il.rkt | 3 +- js-assembler/assemble-helpers.rkt | 35 ++++++----------- version.rkt | 2 +- 6 files changed, 60 insertions(+), 55 deletions(-) diff --git a/compiler/compiler.rkt b/compiler/compiler.rkt index 99a5c31..1e07611 100644 --- a/compiler/compiler.rkt +++ b/compiler/compiler.rkt @@ -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) diff --git a/compiler/lexical-env.rkt b/compiler/lexical-env.rkt index 8a8c587..b7cb90a 100644 --- a/compiler/lexical-env.rkt +++ b/compiler/lexical-env.rkt @@ -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)))])) diff --git a/compiler/lexical-structs.rkt b/compiler/lexical-structs.rkt index 4df9158..e54ffdf 100644 --- a/compiler/lexical-structs.rkt +++ b/compiler/lexical-structs.rkt @@ -53,7 +53,8 @@ #:transparent) (define-struct: EnvPrefixReference ([depth : Natural] - [pos : Natural]) + [pos : Natural] + [modvar? : Boolean]) #:transparent) (define-struct: EnvWholePrefixReference ([depth : Natural]) diff --git a/compiler/optimize-il.rkt b/compiler/optimize-il.rkt index d7fa332..237e4c0 100644 --- a/compiler/optimize-il.rkt +++ b/compiler/optimize-il.rkt @@ -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) diff --git a/js-assembler/assemble-helpers.rkt b/js-assembler/assemble-helpers.rkt index 1c98673..8bff99b 100644 --- a/js-assembler/assemble-helpers.rkt +++ b/js-assembler/assemble-helpers.rkt @@ -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) diff --git a/version.rkt b/version.rkt index 8e87ef1..218bb28 100644 --- a/version.rkt +++ b/version.rkt @@ -7,4 +7,4 @@ (provide version) (: version String) -(define version "1.186") +(define version "1.187")