ripping out getlexical because it's superfluous
This commit is contained in:
parent
fd25182d42
commit
5b406543bc
|
@ -117,8 +117,6 @@ EOF
|
||||||
(list (MakeCompiledProcedure-label op))]
|
(list (MakeCompiledProcedure-label op))]
|
||||||
[(ApplyPrimitiveProcedure? op)
|
[(ApplyPrimitiveProcedure? op)
|
||||||
(list (ApplyPrimitiveProcedure-label op))]
|
(list (ApplyPrimitiveProcedure-label op))]
|
||||||
[(LookupLexicalAddress? op)
|
|
||||||
empty]
|
|
||||||
[(LookupToplevelAddress? op)
|
[(LookupToplevelAddress? op)
|
||||||
empty]
|
empty]
|
||||||
[(GetControlStackLabel? op)
|
[(GetControlStackLabel? op)
|
||||||
|
@ -328,10 +326,6 @@ EOF
|
||||||
(ApplyPrimitiveProcedure-arity op)
|
(ApplyPrimitiveProcedure-arity op)
|
||||||
(ApplyPrimitiveProcedure-label op))]
|
(ApplyPrimitiveProcedure-label op))]
|
||||||
|
|
||||||
[(LookupLexicalAddress? op)
|
|
||||||
(format "MACHINE.env[MACHINE.env.length - 1 - ~a][~a]"
|
|
||||||
(LookupLexicalAddress-depth op))]
|
|
||||||
|
|
||||||
[(LookupToplevelAddress? op)
|
[(LookupToplevelAddress? op)
|
||||||
(format "MACHINE.env[MACHINE.env.length - 1 - ~a][~a]"
|
(format "MACHINE.env[MACHINE.env.length - 1 - ~a][~a]"
|
||||||
(LookupToplevelAddress-depth op)
|
(LookupToplevelAddress-depth op)
|
||||||
|
|
|
@ -142,9 +142,9 @@
|
||||||
(end-with-linkage linkage
|
(end-with-linkage linkage
|
||||||
cenv
|
cenv
|
||||||
(make-instruction-sequence
|
(make-instruction-sequence
|
||||||
`(,(make-AssignPrimOpStatement
|
`(,(make-AssignImmediateStatement
|
||||||
target
|
target
|
||||||
(make-LookupLexicalAddress (LocalAddress-depth lexical-pos))))))]
|
(make-EnvLexicalReference (LocalAddress-depth lexical-pos))))))]
|
||||||
[(PrefixAddress? lexical-pos)
|
[(PrefixAddress? lexical-pos)
|
||||||
(end-with-linkage linkage
|
(end-with-linkage linkage
|
||||||
cenv
|
cenv
|
||||||
|
|
|
@ -16,8 +16,7 @@
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
|
||||||
|
;; An operation can refer to the following arguments:
|
||||||
;; An operation can refer to the following:
|
|
||||||
(define-type OpArg (U Const ;; an constant
|
(define-type OpArg (U Const ;; an constant
|
||||||
Label ;; an label
|
Label ;; an label
|
||||||
Reg ;; an register
|
Reg ;; an register
|
||||||
|
@ -25,6 +24,12 @@
|
||||||
EnvWholePrefixReference ;; a reference into a toplevel prefix in the stack.
|
EnvWholePrefixReference ;; a reference into a toplevel prefix in the stack.
|
||||||
))
|
))
|
||||||
|
|
||||||
|
|
||||||
|
;; Targets: these are the allowable lhs's for an assignment.
|
||||||
|
(define-type Target (U AtomicRegisterSymbol EnvLexicalReference))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(define-struct: Label ([name : Symbol])
|
(define-struct: Label ([name : Symbol])
|
||||||
#:transparent)
|
#:transparent)
|
||||||
(define-struct: Reg ([name : AtomicRegisterSymbol])
|
(define-struct: Reg ([name : AtomicRegisterSymbol])
|
||||||
|
@ -36,15 +41,13 @@
|
||||||
(define-struct: EnvWholePrefixReference ([depth : Natural])
|
(define-struct: EnvWholePrefixReference ([depth : Natural])
|
||||||
#:transparent)
|
#:transparent)
|
||||||
|
|
||||||
;; An environment reference
|
|
||||||
|
;; An environment reference is either lexical or referring to a whole prefix.
|
||||||
(define-type EnvReference (U EnvLexicalReference
|
(define-type EnvReference (U EnvLexicalReference
|
||||||
EnvWholePrefixReference))
|
EnvWholePrefixReference))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;; instruction sequences
|
;; instruction sequences
|
||||||
(define-type UnlabeledStatement (U
|
(define-type UnlabeledStatement (U
|
||||||
AssignImmediateStatement
|
AssignImmediateStatement
|
||||||
|
@ -58,6 +61,7 @@
|
||||||
PushEnvironment
|
PushEnvironment
|
||||||
PushControlFrame
|
PushControlFrame
|
||||||
PopControlFrame))
|
PopControlFrame))
|
||||||
|
|
||||||
(define-type Statement (U UnlabeledStatement
|
(define-type Statement (U UnlabeledStatement
|
||||||
Symbol ;; label
|
Symbol ;; label
|
||||||
))
|
))
|
||||||
|
@ -105,7 +109,6 @@
|
||||||
(define-type PrimitiveOperator (U GetCompiledProcedureEntry
|
(define-type PrimitiveOperator (U GetCompiledProcedureEntry
|
||||||
MakeCompiledProcedure
|
MakeCompiledProcedure
|
||||||
ApplyPrimitiveProcedure
|
ApplyPrimitiveProcedure
|
||||||
LookupLexicalAddress
|
|
||||||
LookupToplevelAddress
|
LookupToplevelAddress
|
||||||
GetControlStackLabel))
|
GetControlStackLabel))
|
||||||
|
|
||||||
|
@ -131,10 +134,6 @@
|
||||||
[label : Symbol])
|
[label : Symbol])
|
||||||
#:transparent)
|
#:transparent)
|
||||||
|
|
||||||
;; Gets the value stored at the given depth in the environment.
|
|
||||||
(define-struct: LookupLexicalAddress ([depth : Natural])
|
|
||||||
#:transparent)
|
|
||||||
|
|
||||||
;; Looks up the value in the prefix installed in the environment.
|
;; Looks up the value in the prefix installed in the environment.
|
||||||
(define-struct: LookupToplevelAddress ([depth : Natural]
|
(define-struct: LookupToplevelAddress ([depth : Natural]
|
||||||
[pos : Natural]
|
[pos : Natural]
|
||||||
|
@ -218,8 +217,6 @@
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;; Targets: these are the allowable lhs's for an assignment.
|
|
||||||
(define-type Target (U AtomicRegisterSymbol EnvLexicalReference))
|
|
||||||
|
|
||||||
|
|
||||||
;; Linkage
|
;; Linkage
|
||||||
|
|
|
@ -241,14 +241,6 @@
|
||||||
[else
|
[else
|
||||||
(error 'apply-primitive-procedure)]))]
|
(error 'apply-primitive-procedure)]))]
|
||||||
|
|
||||||
[(LookupLexicalAddress? op)
|
|
||||||
(let: ([a-val : SlotValue (env-ref m (LookupLexicalAddress-depth op))])
|
|
||||||
(cond
|
|
||||||
[(toplevel? a-val)
|
|
||||||
(error 'lookup-lexical-address)]
|
|
||||||
[else
|
|
||||||
(target-updater m a-val)]))]
|
|
||||||
|
|
||||||
[(LookupToplevelAddress? op)
|
[(LookupToplevelAddress? op)
|
||||||
(let: ([a-top : SlotValue (env-ref m (LookupToplevelAddress-depth op))])
|
(let: ([a-top : SlotValue (env-ref m (LookupToplevelAddress-depth op))])
|
||||||
(cond
|
(cond
|
||||||
|
|
|
@ -398,7 +398,7 @@
|
||||||
,(make-AssignImmediateStatement (make-EnvLexicalReference 1) (make-Const 'curly))
|
,(make-AssignImmediateStatement (make-EnvLexicalReference 1) (make-Const 'curly))
|
||||||
,(make-AssignImmediateStatement (make-EnvLexicalReference 2) (make-Const 'moe))
|
,(make-AssignImmediateStatement (make-EnvLexicalReference 2) (make-Const 'moe))
|
||||||
|
|
||||||
,(make-AssignPrimOpStatement 'val (make-LookupLexicalAddress 0))))])
|
,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0))))])
|
||||||
(test (machine-val (run m))
|
(test (machine-val (run m))
|
||||||
'larry))
|
'larry))
|
||||||
;; Another lexical lookup test
|
;; Another lexical lookup test
|
||||||
|
@ -408,7 +408,7 @@
|
||||||
,(make-AssignImmediateStatement (make-EnvLexicalReference 1) (make-Const 'curly))
|
,(make-AssignImmediateStatement (make-EnvLexicalReference 1) (make-Const 'curly))
|
||||||
,(make-AssignImmediateStatement (make-EnvLexicalReference 2) (make-Const 'moe))
|
,(make-AssignImmediateStatement (make-EnvLexicalReference 2) (make-Const 'moe))
|
||||||
|
|
||||||
,(make-AssignPrimOpStatement 'val (make-LookupLexicalAddress 1))))])
|
,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 1))))])
|
||||||
(test (machine-val (run m))
|
(test (machine-val (run m))
|
||||||
'curly))
|
'curly))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user