diff --git a/src/SM.ml b/src/SM.ml index 1784ffa91..223e4f39c 100644 --- a/src/SM.ml +++ b/src/SM.ml @@ -1427,7 +1427,7 @@ let compile cmd ((imports, _), p) = | Expr.Ignore s -> let ls, env = env#get_label in add_code (compile_expr tail ls env s) ls false [ DROP ] - | Expr.ElemRef (x, i) -> compile_list tail l env [ x; i ] + | Expr.ElemRef _ -> failwith "Should not happen. Indirect assignemts are temporarily prohibited." | Expr.Var x -> ( let env, line = env#gen_line x in let env, acc = env#lookup x in @@ -1438,10 +1438,7 @@ let compile cmd ((imports, _), p) = false, line @ [ PROTO (name, env#current_function) ] ) | _ -> (env, false, line @ [ LD acc ])) - | Expr.Ref x -> - let env, line = env#gen_line x in - let env, acc = env#lookup x in - (env, false, line @ [ LDA acc ]) + | Expr.Ref _ -> failwith "Should not happen. Indirect assignemts are temporarily prohibited." | Expr.Const n -> (env, false, [ CONST n ]) | Expr.String s -> (env, false, [ STRING s ]) | Expr.Binop (op, x, y) -> @@ -1496,12 +1493,15 @@ let compile cmd ((imports, _), p) = let env, line = env#gen_line x in let env, acc = env#lookup x in add_code (compile_expr false lassn env e) lassn false (line @ [ ST acc ]) - | Expr.Assign (x, e) -> + | Expr.Assign (Expr.ElemRef (x, i), e) -> let lassn, env = env#get_label in add_code - (compile_list false lassn env [ x; e ]) + (compile_list false lassn env [ x; i; e ]) lassn false - [ (match x with Expr.ElemRef _ -> STA | _ -> STI) ] + [ STA ] + | Expr.Assign (x, _) -> + failwith + (Printf.sprintf "Indirect assignment is not supported yet: %s" (show Expr.t x)) | Expr.Skip -> (env, false, []) | Expr.Seq (s1, s2) -> compile_list tail l env [ s1; s2 ] | Expr.If (c, s1, s2) -> diff --git a/src/X86_64.ml b/src/X86_64.ml index cd3d48195..85461e33e 100644 --- a/src/X86_64.ml +++ b/src/X86_64.ml @@ -697,7 +697,8 @@ let compile cmd env imports code = let l, env = env#allocate in let env, call = compile_call env ~fname:".string" 1 false in (env, mov addr l @ call) - | LDA x -> ( + | LDA _ -> failwith "Should not happen. Indirect assignemts are temporarily prohibited." + (* let s, env' = (env#variable x)#allocate in let s', env'' = env'#allocate in let loc_x = env'#loc x in @@ -710,7 +711,7 @@ let compile cmd env imports code = assignment :(" | _ -> (); - (env'', [ Lea (loc_x, rax); Mov (rax, s); Mov (rax, s') ])) + (env'', [ Lea (loc_x, rax); Mov (rax, s); Mov (rax, s') ])*) | LD x -> ( let s, env' = (env#variable x)#allocate in ( env', @@ -725,7 +726,8 @@ let compile cmd env imports code = | S _ | M _ -> [ Mov (s, rax); Mov (rax, env'#loc x) ] | _ -> [ Mov (s, env'#loc x) ] )) | STA -> compile_call env ~fname:".sta" 3 false - | STI -> ( + | STI -> failwith "Should not happen. Indirect assignemts are temporarily prohibited." + (* let v, env = env#pop in let x = env#peek in ( env, @@ -737,7 +739,7 @@ let compile cmd env imports code = Mov (rdx, I (0, rax)); Mov (rdx, x); ] - | _ -> [ Mov (v, rax); Mov (rax, I (0, x)); Mov (rax, x) ] )) + | _ -> [ Mov (v, rax); Mov (rax, I (0, x)); Mov (rax, x) ] )*) | BINOP op -> compile_binop env op | LABEL s | FLABEL s | SLABEL s -> (env, [ Label s ]) | JMP l -> ((env#set_stack l)#set_barrier, [ Jmp l ])