st/lama_byterun
1
0
Fork 0
mirror of https://github.com/ProgramSnail/Lama.git synced 2025-12-06 06:48:48 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Prohibit indirect assignments

Browse source
This commit is contained in:
Roman Venediktov 2024-12-20 19:12:34 +01:00
parent cfe325b121
commit 2dad84df22
2 changed files with 14 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

16
src/SM.ml
View file

@ -1427,7 +1427,7 @@ let compile cmd ((imports, _), p) =
| Expr.Ignore s -> | Expr.Ignore s ->
let ls, env = env#get_label in let ls, env = env#get_label in
add_code (compile_expr tail ls env s) ls false [ DROP ] 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 -> ( | Expr.Var x -> (
let env, line = env#gen_line x in let env, line = env#gen_line x in
let env, acc = env#lookup x in let env, acc = env#lookup x in
@ -1438,10 +1438,7 @@ let compile cmd ((imports, _), p) =
false, false,
line @ [ PROTO (name, env#current_function) ] ) line @ [ PROTO (name, env#current_function) ] )
| _ -> (env, false, line @ [ LD acc ])) | _ -> (env, false, line @ [ LD acc ]))
| Expr.Ref x -> | Expr.Ref _ -> failwith "Should not happen. Indirect assignemts are temporarily prohibited."
let env, line = env#gen_line x in
let env, acc = env#lookup x in
(env, false, line @ [ LDA acc ])
| Expr.Const n -> (env, false, [ CONST n ]) | Expr.Const n -> (env, false, [ CONST n ])
| Expr.String s -> (env, false, [ STRING s ]) | Expr.String s -> (env, false, [ STRING s ])
| Expr.Binop (op, x, y) -> | Expr.Binop (op, x, y) ->
@ -1496,12 +1493,15 @@ let compile cmd ((imports, _), p) =
let env, line = env#gen_line x in let env, line = env#gen_line x in
let env, acc = env#lookup x in let env, acc = env#lookup x in
add_code (compile_expr false lassn env e) lassn false (line @ [ ST acc ]) 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 let lassn, env = env#get_label in
add_code add_code
(compile_list false lassn env [ x; e ]) (compile_list false lassn env [ x; i; e ])
lassn false 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.Skip -> (env, false, [])
| Expr.Seq (s1, s2) -> compile_list tail l env [ s1; s2 ] | Expr.Seq (s1, s2) -> compile_list tail l env [ s1; s2 ]
| Expr.If (c, s1, s2) -> | Expr.If (c, s1, s2) ->

10
src/X86_64.ml
View file

@ -697,7 +697,8 @@ let compile cmd env imports code =
let l, env = env#allocate in let l, env = env#allocate in
let env, call = compile_call env ~fname:".string" 1 false in let env, call = compile_call env ~fname:".string" 1 false in
(env, mov addr l @ call) (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#variable x)#allocate in
let s', env'' = env'#allocate in let s', env'' = env'#allocate in
let loc_x = env'#loc x in let loc_x = env'#loc x in
@ -710,7 +711,7 @@ let compile cmd env imports code =
assignment :(" 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 -> ( | LD x -> (
let s, env' = (env#variable x)#allocate in let s, env' = (env#variable x)#allocate in
( env', ( env',
@ -725,7 +726,8 @@ let compile cmd env imports code =
| S _ | M _ -> [ Mov (s, rax); Mov (rax, env'#loc x) ] | S _ | M _ -> [ Mov (s, rax); Mov (rax, env'#loc x) ]
| _ -> [ Mov (s, env'#loc x) ] )) | _ -> [ Mov (s, env'#loc x) ] ))
| STA -> compile_call env ~fname:".sta" 3 false | 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 v, env = env#pop in
let x = env#peek in let x = env#peek in
( env, ( env,
@ -737,7 +739,7 @@ let compile cmd env imports code =
Mov (rdx, I (0, rax)); Mov (rdx, I (0, rax));
Mov (rdx, x); 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 | BINOP op -> compile_binop env op
| LABEL s | FLABEL s | SLABEL s -> (env, [ Label s ]) | LABEL s | FLABEL s | SLABEL s -> (env, [ Label s ])
| JMP l -> ((env#set_stack l)#set_barrier, [ Jmp l ]) | JMP l -> ((env#set_stack l)#set_barrier, [ Jmp l ])