diff --git a/assemble.rkt b/assemble.rkt index 58ac2a7..af46367 100644 --- a/assemble.rkt +++ b/assemble.rkt @@ -336,6 +336,11 @@ EOF (format "MACHINE.env[MACHINE.env.length - 1 - ~a]" (EnvWholePrefixReference-depth ref))])) +(: assemble-display-name ((U Symbol False) -> String)) +(define (assemble-display-name symbol-or-string) + (if (symbol? symbol-or-string) + (format "~s" (symbol->string symbol-or-string)) + "false")) (: assemble-op-expression (PrimitiveOperator -> String)) (define (assemble-op-expression op) @@ -344,7 +349,7 @@ EOF "MACHINE.proc.label"] [(MakeCompiledProcedure? op) - (format "new Closure(~a, ~a, [~a], ~s)" + (format "new Closure(~a, ~a, [~a], ~a)" (MakeCompiledProcedure-label op) (MakeCompiledProcedure-arity op) (string-join (map assemble-env-reference/closure-capture @@ -354,7 +359,7 @@ EOF ;; during install-closure-values. (reverse (MakeCompiledProcedure-closed-vals op))) ", ") - (symbol->string (MakeCompiledProcedure-display-name op)))] + (assemble-display-name (MakeCompiledProcedure-display-name op)))] [(ApplyPrimitiveProcedure? op) (format "MACHINE.proc(~a, ~a)" diff --git a/simulator-structs.rkt b/simulator-structs.rkt index a5d48a3..6891b3c 100644 --- a/simulator-structs.rkt +++ b/simulator-structs.rkt @@ -42,6 +42,9 @@ ;; other metrics for debugging [stack-size : Natural] + + ;; compute position from label + [jump-table : (HashTable Symbol Natural)] ) #:transparent #:mutable) diff --git a/simulator.rkt b/simulator.rkt index b96550f..1267fec 100644 --- a/simulator.rkt +++ b/simulator.rkt @@ -30,7 +30,15 @@ (: new-machine ((Listof Statement) -> machine)) (define (new-machine program-text) - (make-machine (make-undefined) (make-undefined) '() '() 0 (list->vector program-text) 0)) + (let: ([m : machine (make-machine (make-undefined) (make-undefined) '() '() 0 (list->vector program-text) 0 + ((inst make-hash Symbol Natural)))]) + (let: loop : Void ([i : Natural 0]) + (when (< i (vector-length (machine-text m))) + (let: ([stmt : Statement (vector-ref (machine-text m) i)]) + (when (symbol? stmt) + (hash-set! (machine-jump-table m) stmt i)) + (loop (add1 i))))) + m)) @@ -404,7 +412,7 @@ (define (current-instruction m) (match m [(struct machine (val proc env control pc text - stack-size)) + stack-size jump-table)) (vector-ref text pc)])) @@ -424,7 +432,7 @@ (: env-push! (machine SlotValue -> 'ok)) (define (env-push! m v) (match m - [(struct machine (val proc env control pc text stack-size)) + [(struct machine (val proc env control pc text stack-size jump-table)) (set-machine-env! m (cons v env)) (set-machine-stack-size! m (add1 stack-size)) 'ok])) @@ -432,7 +440,7 @@ (: env-push-many! (machine (Listof SlotValue) -> 'ok)) (define (env-push-many! m vs) (match m - [(struct machine (val proc env control pc text stack-size)) + [(struct machine (val proc env control pc text stack-size jump-table)) (set-machine-env! m (append vs env)) (set-machine-stack-size! m (+ stack-size (length vs))) 'ok])) @@ -441,13 +449,13 @@ (: env-ref (machine Natural -> SlotValue)) (define (env-ref m i) (match m - [(struct machine (val proc env control pc text stack-size)) + [(struct machine (val proc env control pc text stack-size jump-table)) (list-ref env i)])) (: env-mutate! (machine Natural SlotValue -> 'ok)) (define (env-mutate! m i v) (match m - [(struct machine (val proc env control pc text stack-size)) + [(struct machine (val proc env control pc text stack-size jump-table)) (set-machine-env! m (list-replace env i v)) 'ok])) @@ -465,7 +473,7 @@ (: env-pop! (machine Natural Natural -> 'ok)) (define (env-pop! m n skip) (match m - [(struct machine (val proc env control pc text stack-size)) + [(struct machine (val proc env control pc text stack-size jump-table)) (set-machine-env! m (append (take env skip) (drop env (+ skip n)))) (set-machine-stack-size! m (ensure-natural (- stack-size n))) @@ -475,7 +483,7 @@ (: control-push! (machine frame -> 'ok)) (define (control-push! m a-frame) (match m - [(struct machine (val proc env control pc text stack-size)) + [(struct machine (val proc env control pc text stack-size jump-table)) (set-machine-control! m (cons a-frame control)) 'ok])) @@ -483,7 +491,7 @@ (: control-pop! (machine -> 'ok)) (define (control-pop! m) (match m - [(struct machine (val proc env control pc text stack-size)) + [(struct machine (val proc env control pc text stack-size jump-table)) (set-machine-control! m (rest control)) 'ok])) @@ -500,21 +508,12 @@ ;; Jumps directly to the instruction at the given label. (define (jump! m l) (match m - [(struct machine (val proc env control pc text stack-size)) - (set-machine-pc! m (vector-find text l)) + [(struct machine (val proc env control pc text stack-size jump-table)) + (set-machine-pc! m (hash-ref jump-table l)) 'ok])) -(: vector-find (All (A) (Vectorof A) A -> Natural)) -(define (vector-find vec x) - (let: loop : Natural ([i : Natural 0]) - (cond - [(eq? (vector-ref vec i) x) - i] - [else - (loop (add1 i))]))) - (: toplevel-mutate! (toplevel Natural PrimitiveValue -> 'ok)) (define (toplevel-mutate! a-top index v) diff --git a/test-assemble.rkt b/test-assemble.rkt index 5a7a082..aed1711 100644 --- a/test-assemble.rkt +++ b/test-assemble.rkt @@ -177,7 +177,7 @@ 'closureStart (make-GotoStatement (make-Label 'afterLambda)) 'afterLambda - (make-AssignPrimOpStatement 'val (make-MakeCompiledProcedure 'closureStart 0 '()))) + (make-AssignPrimOpStatement 'val (make-MakeCompiledProcedure 'closureStart 0 '() 'closureStart))) "MACHINE.val.displayName") "closureStart") @@ -194,7 +194,8 @@ (make-Const "world")) (make-AssignPrimOpStatement 'val (make-MakeCompiledProcedure 'closureStart 0 (list (make-EnvLexicalReference 0 #f) - (make-EnvLexicalReference 1 #f))))) + (make-EnvLexicalReference 1 #f)) + 'closureStart))) "MACHINE.val.closedVals[1] + ',' + MACHINE.val.closedVals[0]") "hello,world") @@ -213,7 +214,8 @@ (make-Const "world")) (make-AssignPrimOpStatement 'proc (make-MakeCompiledProcedure 'closureStart 0 (list (make-EnvLexicalReference 0 #f) - (make-EnvLexicalReference 1 #f)))) + (make-EnvLexicalReference 1 #f)) + 'closureStart)) (make-PopEnvironment 2 0) (make-GotoStatement (make-Label 'closureStart)) 'theEnd) @@ -237,7 +239,8 @@ (make-Const "world")) (make-AssignPrimOpStatement 'proc (make-MakeCompiledProcedure 'closureStart 0 (list (make-EnvLexicalReference 0 #f) - (make-EnvLexicalReference 1 #f)))) + (make-EnvLexicalReference 1 #f)) + 'closureStart)) (make-PopEnvironment 2 0) (make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry))) "typeof(MACHINE.val) + ',' + (MACHINE.val === MACHINE.proc.label)") @@ -259,7 +262,8 @@ (make-Const "world")) (make-AssignPrimOpStatement 'proc (make-MakeCompiledProcedure 'closureStart 5 (list (make-EnvLexicalReference 0 #f) - (make-EnvLexicalReference 1 #f)))) + (make-EnvLexicalReference 1 #f)) + 'closureStart)) (make-PopEnvironment 2 0) (make-PerformStatement (make-CheckClosureArity! 5))))) @@ -281,7 +285,8 @@ (make-Const "world")) (make-AssignPrimOpStatement 'proc (make-MakeCompiledProcedure 'closureStart 5 (list (make-EnvLexicalReference 0 #f) - (make-EnvLexicalReference 1 #f)))) + (make-EnvLexicalReference 1 #f)) + 'closureStart)) (make-PopEnvironment 2 0) (make-PerformStatement (make-CheckClosureArity! 1))))) (error 'expected-failure))