Better support for assignment

This commit is contained in:
Dmitry Boulytchev 2019-04-11 17:31:45 +03:00
parent 7bf40bf26f
commit 061bd3c48d
2 changed files with 19 additions and 5 deletions

View file

@ -12,7 +12,8 @@ open Language
(* create an S-expression *) | SEXP of string * int (* create an S-expression *) | SEXP of string * int
(* load a variable to the stack *) | LD of string (* load a variable to the stack *) | LD of string
(* load a variable address to the stack *) | LDA of string (* load a variable address to the stack *) | LDA of string
(* store a value into a reference *) | ST (* store a value into a variable *) | ST of string
(* store a value into a reference *) | STI
(* store a value into array/sexp/string *) | STA (* store a value into array/sexp/string *) | STA
(* a label *) | LABEL of string (* a label *) | LABEL of string
(* unconditional jump *) | JMP of string (* unconditional jump *) | JMP of string
@ -67,7 +68,8 @@ let rec eval env ((cstack, stack, ((st, i, o) as c)) as conf) = function
eval env (cstack, (Value.sexp s @@ List.rev vs)::stack', c) prg' eval env (cstack, (Value.sexp s @@ List.rev vs)::stack', c) prg'
| LD x -> eval env (cstack, State.eval st x :: stack, c) prg' | LD x -> eval env (cstack, State.eval st x :: stack, c) prg'
| LDA x -> eval env (cstack, (Value.Var x) :: stack, c) prg' | LDA x -> eval env (cstack, (Value.Var x) :: stack, c) prg'
| ST -> let z::r::stack' = stack in eval env (cstack, z::stack', (Expr.update st r z, i, o)) prg' | ST x -> let z::stack' = stack in eval env (cstack, z::stack', (State.update x z st, i, o)) prg'
| STI -> let z::r::stack' = stack in eval env (cstack, z::stack', (Expr.update st r z, i, o)) prg'
| STA -> let v::j::x::stack' = stack in eval env (cstack, v::stack', (Expr.update st (Value.Elem (x, Value.to_int j)) v, i, o)) prg' | STA -> let v::j::x::stack' = stack in eval env (cstack, v::stack', (Expr.update st (Value.Elem (x, Value.to_int j)) v, i, o)) prg'
| LABEL _ -> eval env conf prg' | LABEL _ -> eval env conf prg'
| JMP l -> eval env conf (env#labeled l) | JMP l -> eval env conf (env#labeled l)
@ -259,9 +261,12 @@ let compile (defs, p) =
| Expr.StringVal e -> let lsv, env = env#get_label in | Expr.StringVal e -> let lsv, env = env#get_label in
add_code (compile_expr lsv env e) lsv false [CALL (".stringval", 1)] add_code (compile_expr lsv env e) lsv false [CALL (".stringval", 1)]
| Expr.Assign (x, e) -> let lassn, env = env#get_label in | Expr.Assign (x, e) -> let lassn, env = env#get_label in
add_code (compile_list lassn env [x; e]) lassn false [match x with Expr.ElemRef _ -> STA | _ -> ST] (match x with
| Expr.Ref x -> add_code (compile_expr lassn env e) lassn false [ST x]
| _ -> add_code (compile_list lassn env [x; e]) lassn false [match x with Expr.ElemRef _ -> STA | _ -> STI]
)
| Expr.Skip -> env, false, [] | Expr.Skip -> env, false, []

View file

@ -180,11 +180,20 @@ let compile env code =
| S _ | M _ -> [Mov (env'#loc x, eax); Mov (eax, s)] | S _ | M _ -> [Mov (env'#loc x, eax); Mov (eax, s)]
| _ -> [Mov (env'#loc x, s)] | _ -> [Mov (env'#loc x, s)]
) )
| ST x ->
let env' = env#variable x in
let s = env'#peek in
env',
(match s with
| S _ | M _ -> [Mov (s, eax); Mov (eax, env'#loc x)]
| _ -> [Mov (s, env'#loc x)]
)
| STA -> | STA ->
call env ".sta" 3 call env ".sta" 3
| ST -> | STI ->
let v, x, env' = env#pop2 in let v, x, env' = env#pop2 in
env'#push x, env'#push x,
(match x with (match x with