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

Right in the middle of getting global references to work, some more

Browse Source
This commit is contained in:
Danny Yoo 2013-03-03 16:12:27 -07:00
parent 35d154345b
commit 7026c7aa24
7 changed files with 46 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
whalesong/compiler/compiler.rkt
View File

@ -440,8 +440,7 @@
(make-AssignPrimOp target (make-AssignPrimOp target
(make-PrimitivesReference (make-PrimitivesReference
(kernel-module-variable->primitive-name (kernel-module-variable->primitive-name
prefix-element) prefix-element)))]
))]
[else [else
(make-AssignImmediate (make-AssignImmediate
target target
@ -453,11 +452,10 @@
(if (ToplevelRef-check-defined? exp) (if (ToplevelRef-check-defined? exp)
(make-Perform (make-CheckGlobalBound! (GlobalBucket-name prefix-element))) (make-Perform (make-CheckGlobalBound! (GlobalBucket-name prefix-element)))
empty-instruction-sequence) empty-instruction-sequence)
(make-AssignImmediate (make-AssignPrimOp
target target
(make-GlobalsReference (GlobalBucket-name prefix-element))))] (make-GlobalsReference (GlobalBucket-name prefix-element))))]
[(or (eq? prefix-element #f) [(or (eq? prefix-element #f) (symbol? prefix-element))
(symbol? prefix-element))
(append-instruction-sequences (append-instruction-sequences
(if (ToplevelRef-check-defined? exp) (if (ToplevelRef-check-defined? exp)
(make-Perform (make-CheckToplevelBound! (make-Perform (make-CheckToplevelBound!
@ -2080,24 +2078,32 @@
;; values are on the stack. ;; values are on the stack.
(if (> n 0) (if (> n 0)
(apply append-instruction-sequences (apply append-instruction-sequences
(map (lambda: ([id : ToplevelRef] (map (lambda: ([id : ToplevelRef]
[from : OpArg]) [from : OpArg])
(make-AssignImmediate (define prefix
;; Slightly subtle: the toplevelrefs were with respect to the (ensure-prefix (list-ref cenv (ToplevelRef-depth id))))
;; stack at the beginning of def-values, but at the moment, (define prefix-element (list-ref (Prefix-names prefix) (ToplevelRef-pos id)))
;; there may be additional values that are currently there. (cond
(make-EnvPrefixReference (+ (ensure-natural (sub1 n)) [(GlobalBucket? prefix-element)
(ToplevelRef-depth id)) (make-AssignImmediate (make-GlobalsReference (GlobalBucket-name prefix-element))
(ToplevelRef-pos id) from)]
#f) [else
from)) ;; Slightly subtle: the toplevelrefs were with respect to the
ids ;; stack at the beginning of def-values, but at the moment,
(if (> n 0) ;; there may be additional values that are currently there.
(cons (make-Reg 'val) (make-AssignImmediate
(build-list (sub1 n) (make-EnvPrefixReference (+ (ensure-natural (sub1 n))
(lambda: ([i : Natural]) (ToplevelRef-depth id))
(make-EnvLexicalReference i #f)))) (ToplevelRef-pos id)
empty))) #f)
from)]))
ids
(if (> n 0)
(cons (make-Reg 'val)
(build-list (sub1 n)
(lambda: ([i : Natural])
(make-EnvLexicalReference i #f))))
empty)))
empty-instruction-sequence) empty-instruction-sequence)
;; Finally, make sure any multiple values are off the stack. ;; Finally, make sure any multiple values are off the stack.
@ -2175,6 +2181,8 @@
(EnvPrefixReference-modvar? target))] (EnvPrefixReference-modvar? target))]
[(PrimitivesReference? target) [(PrimitivesReference? target)
target] target]
[(GlobalsReference? target)
target]
[(ControlFrameTemporary? target) [(ControlFrameTemporary? target)
target] target]
[(ModulePrefixTarget? target) [(ModulePrefixTarget? target)

1
whalesong/compiler/il-structs.rkt
View File

@ -38,7 +38,6 @@
ModulePredicate ModulePredicate
PrimitiveKernelValue PrimitiveKernelValue
VariableReference VariableReference
GlobalsReference
)) ))

5
whalesong/js-assembler/assemble-expression.rkt
View File

@ -102,4 +102,7 @@
(symbol->string (ModuleVariable-name op)))] (symbol->string (ModuleVariable-name op)))]
[(PrimitivesReference? op) [(PrimitivesReference? op)
(format "M.primitives[~s]" (symbol->string (PrimitivesReference-name op)))])) (format "M.primitives[~s]" (symbol->string (PrimitivesReference-name op)))]
[(GlobalsReference? op)
(format "M.globals[~s]" (symbol->string (GlobalsReference-name op)))]))

2
whalesong/js-assembler/assemble-helpers.rkt
View File

@ -115,6 +115,8 @@
(assemble-prefix-reference target)] (assemble-prefix-reference target)]
[(ControlFrameTemporary? target) [(ControlFrameTemporary? target)
(assemble-control-frame-temporary target)] (assemble-control-frame-temporary target)]
[(GlobalsReference? target)
(format "M.globals[~s]" (symbol->string (GlobalsReference-name target)))]
[(ModulePrefixTarget? target) [(ModulePrefixTarget? target)
(format "M.modules[~s].prefix" (format "M.modules[~s].prefix"
(symbol->string (ModuleLocator-name (ModulePrefixTarget-path target))))]) (symbol->string (ModuleLocator-name (ModulePrefixTarget-path target))))])

4
whalesong/js-assembler/assemble-perform-statement.rkt
View File

@ -21,6 +21,10 @@
(CheckToplevelBound!-pos op) (CheckToplevelBound!-pos op)
(add1 (CheckToplevelBound!-depth op)) (add1 (CheckToplevelBound!-depth op))
(CheckToplevelBound!-pos op))] (CheckToplevelBound!-pos op))]
[(CheckGlobalBound!? op)
(format "if (M.globals[~s]===void(0)){ RT.raiseUnboundToplevelError(M,~s); }"
(symbol->string (CheckGlobalBound!-name op))
(symbol->string (CheckGlobalBound!-name op)))]
[(CheckClosureAndArity!? op) [(CheckClosureAndArity!? op)

4
whalesong/js-assembler/collect-jump-targets.rkt
View File

@ -125,6 +125,8 @@
[(ModuleVariable? op) [(ModuleVariable? op)
empty] empty]
[(PrimitivesReference? op) [(PrimitivesReference? op)
empty]
[(GlobalsReference? op)
empty])) empty]))
@ -276,6 +278,8 @@
[(ModuleVariable? op) [(ModuleVariable? op)
empty] empty]
[(PrimitivesReference? op) [(PrimitivesReference? op)
empty]
[(GlobalsReference? op)
empty])) empty]))
(: collect-primitive-command (PrimitiveCommand -> (Listof Symbol))) (: collect-primitive-command (PrimitiveCommand -> (Listof Symbol)))

1
whalesong/repl-prototype/server.rkt
View File

@ -73,6 +73,7 @@
(define op (open-output-bytes)) (define op (open-output-bytes))
(write raw-bytecode op) (write raw-bytecode op)
(define whalesong-bytecode (parse-bytecode (open-input-bytes (get-output-bytes op)))) (define whalesong-bytecode (parse-bytecode (open-input-bytes (get-output-bytes op))))
(pretty-print whalesong-bytecode)
(define compiled-bytecode (compile-for-repl whalesong-bytecode)) (define compiled-bytecode (compile-for-repl whalesong-bytecode))
(pretty-print compiled-bytecode) (pretty-print compiled-bytecode)
(define assembled-op (open-output-string)) (define assembled-op (open-output-string))