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

simplifying the il a little bit, getting assignment

Browse Source
This commit is contained in:
dyoo 2011-03-03 17:17:10 -05:00
parent be89ec9f0f
commit cefc85c72f
4 changed files with 71 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
compile.rkt
View File

@ -263,7 +263,7 @@
extended-cenv
(if (empty? (App-operands exp))
'proc
(make-EnvOffset (max 0 (sub1 (length (App-operands exp))))))
(make-EnvLexicalReference (max 0 (sub1 (length (App-operands exp))))))
'next)]
[operand-codes (map (lambda: ([operand : Expression]
[target : Target])
@ -272,7 +272,7 @@
(build-list (length (App-operands exp))
(lambda: ([i : Natural])
(if (< i (sub1 (length (App-operands exp))))
(make-EnvOffset i)
(make-EnvLexicalReference i)
'val))))])
;; FIXME: we need to push the control.
@ -308,7 +308,7 @@
(make-instruction-sequence
`(,(make-AssignImmediateStatement 'proc
(make-EnvLexicalReference n))
,(make-AssignImmediateStatement (make-EnvOffset n)
,(make-AssignImmediateStatement (make-EnvLexicalReference n)
(make-Reg 'val)))))]
[else
;; Otherwise, add instructions to juggle the operator and operands in the stack.

10
il-structs.rkt
View File

@ -26,7 +26,7 @@
(define-struct: Label ([name : Symbol])
#:transparent)
(define-struct: Reg ([name : RegisterSymbol])
(define-struct: Reg ([name : AtomicRegisterSymbol])
#:transparent)
(define-struct: Const ([const : Any])
#:transparent)
@ -91,7 +91,7 @@
[rands : (Listof (U Label Reg Const))])
#:transparent)
(define-struct: TestAndBranchStatement ([op : PrimitiveTest]
[register-rand : RegisterSymbol]
[register-rand : AtomicRegisterSymbol]
[label : Symbol])
#:transparent)
@ -199,10 +199,8 @@
;; Targets
(define-type Target (U RegisterSymbol ControlTarget EnvOffset))
(define-struct: EnvOffset ([depth : Natural]) #:transparent)
(define-struct: ControlTarget () #:transparent)
;; Targets: these are the allowable lhs's for an assignment.
(define-type Target (U AtomicRegisterSymbol EnvLexicalReference))
;; Linkage

82
simulator.rkt
View File

@ -26,28 +26,29 @@
;; Take one simulation step.
(define (step m)
(let: ([i : Statement (current-instruction m)])
(cond
[(symbol? i)
(increment-pc m)]
[(AssignImmediateStatement? i)
(error 'step)]
[(AssignPrimOpStatement? i)
(error 'step)]
[(PerformStatement? i)
(error 'step)]
[(GotoStatement? i)
(step-goto m i)]
[(TestAndBranchStatement? i)
(error 'step)]
[(PopEnvironment? i)
(error 'step)]
[(PushEnvironment? i)
(error 'step)]
[(PushControlFrame? i)
(error 'step)]
[(PopControlFrame? i)
(error 'step)])))
(increment-pc
(cond
[(symbol? i)
m]
[(AssignImmediateStatement? i)
(step-assign-immediate m i)]
[(AssignPrimOpStatement? i)
(error 'step)]
[(PerformStatement? i)
(error 'step)]
[(GotoStatement? i)
(step-goto m i)]
[(TestAndBranchStatement? i)
(error 'step)]
[(PopEnvironment? i)
(error 'step)]
[(PushEnvironment? i)
(error 'step)]
[(PushControlFrame? i)
(error 'step)]
[(PopControlFrame? i)
(error 'step)]))))
(: step-goto (machine GotoStatement -> machine))
(define (step-goto m a-goto)
@ -65,6 +66,39 @@
(error 'step-goto "Register '~s is supposed to be either 'val or 'proc"
reg)]))])))
(: step-assign-immediate (machine AssignImmediateStatement -> machine))
(define (step-assign-immediate m stmt)
(let: ([t : Target (AssignImmediateStatement-target stmt)]
[v : Any (evaluate-oparg m (AssignImmediateStatement-value stmt))])
(cond [(eq? t 'proc)
(proc-update m v)]
[(eq? t 'val)
(val-update m v)]
[(EnvLexicalReference? t)
(env-mutate m (EnvLexicalReference-depth t) v)])))
(: evaluate-oparg (machine OpArg -> Any))
(define (evaluate-oparg m an-oparg)
(cond
[(Const? an-oparg)
(Const-const an-oparg)]
[(Label? an-oparg)
(Label-name an-oparg)]
[(Reg? an-oparg)
(let: ([n : AtomicRegisterSymbol (Reg-name an-oparg)])
(cond
[(eq? n 'proc)
(machine-proc m)]
[(eq? n 'val)
(machine-val m)]))]
[(EnvLexicalReference? an-oparg)
(list-ref (machine-env m) (EnvLexicalReference-depth an-oparg))]
[(EnvWholePrefixReference? an-oparg)
;; TODO: check that the value is a prefix value.
(list-ref (machine-env m) (EnvWholePrefixReference-depth an-oparg))]))
(: ensure-symbol (Any -> Symbol))
;; Make sure the value is a symbol.
@ -156,11 +190,11 @@
(: jump (machine Symbol -> machine))
;; Jumps directly to the instruction right after the given label.
;; Jumps directly to the instruction at the given label.
(define (jump m l)
(match m
[(struct machine (val proc env control pc text))
(make-machine val proc env control (add1 (vector-find text l)) text)]))
(make-machine val proc env control (vector-find text l) text)]))
(: vector-find (All (A) (Vectorof A) A -> Natural))

7
test-simulator.rkt
View File

@ -31,4 +31,9 @@
(test (machine-pc (step-n m 2)) 2)
(test (machine-pc (step-n m 3)) 1)
(test (machine-pc (step-n m 4)) 2)
(test (machine-pc (step-n m 5)) 1))
(test (machine-pc (step-n m 5)) 1))
(let ([m (new-machine `(,(make-AssignImmediateStatement 'val (make-Const 42))))])
(test (machine-val m) (void))
(test (machine-val (step m)) 42))