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

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

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

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

@ -102,4 +102,7 @@
(symbol->string (ModuleVariable-name 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)]
[(ControlFrameTemporary? target)
(assemble-control-frame-temporary target)]
[(GlobalsReference? target)
(format "M.globals[~s]" (symbol->string (GlobalsReference-name target)))]
[(ModulePrefixTarget? target)
(format "M.modules[~s].prefix"
(symbol->string (ModuleLocator-name (ModulePrefixTarget-path target))))])

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

@ -21,6 +21,10 @@
(CheckToplevelBound!-pos op)
(add1 (CheckToplevelBound!-depth 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)

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

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

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

@ -73,6 +73,7 @@
(define op (open-output-bytes))
(write raw-bytecode 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))
(pretty-print compiled-bytecode)
(define assembled-op (open-output-string))