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

Added label parametrization

Browse source
This commit is contained in:
Roman Venediktov 2024-02-15 10:43:47 +01:00
parent 618dbdfc0f
commit de2c516935
2 changed files with 37 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

19
src/SM.ml
View file

@ -14,6 +14,8 @@ type scope = {
}
[@@deriving gt ~options:{ show }]
let label s = "L" ^ s
let scope_label i s = label s ^ "_" ^ string_of_int i
let show_scope = show scope
(* The type for the stack machine instructions *)
@ -265,13 +267,13 @@ module ByteCode = struct
add_fixup s;
add_ints [ 0 ]
(* 0x70 *)
| CALL ("Lread", _, _) -> add_bytes [ (7 * 16) + 0 ]
| CALL (f, _, _) when f = label "read" -> add_bytes [ (7 * 16) + 0 ]
(* 0x71 *)
| CALL ("Lwrite", _, _) -> add_bytes [ (7 * 16) + 1 ]
| CALL (f, _, _) when f = label "write" -> add_bytes [ (7 * 16) + 1 ]
(* 0x72 *)
| CALL ("Llength", _, _) -> add_bytes [ (7 * 16) + 2 ]
| CALL (f, _, _) when f = label "length" -> add_bytes [ (7 * 16) + 2 ]
(* 0x73 *)
| CALL ("Lstring", _, _) -> add_bytes [ (7 * 16) + 3 ]
| CALL (f, _, _) when f = label "string" -> add_bytes [ (7 * 16) + 3 ]
(* 0x74 *)
| CALL (".array", n, _) ->
add_bytes [ (7 * 16) + 4 ];
@ -534,9 +536,10 @@ let[@ocaml.warning "-8-20"] rec eval env
eval env
(cstack, stack', glob, loc, i, o)
(if
(c = "z" && Value.to_int x = 0) || (c = "nz" && Value.to_int x <> 0)
then env#labeled l
else prg')
(c = "z" && Value.to_int x = 0)
|| (c = "nz" && Value.to_int x <> 0)
then env#labeled l
else prg')
| CLOSURE (name, dgs) ->
let closure =
Array.of_list
@ -802,8 +805,6 @@ let run p i =
Takes a program in the source language and returns an equivalent program for the
stack machine
*)
let label s = "L" ^ s
let scope_label i s = label s ^ "_" ^ string_of_int i
let check_name_and_add names name mut =
if List.exists (fun (n, _) -> n = name) names then

44
src/X86.ml
View file

@ -1,5 +1,6 @@
open GT
open Language
open SM
(* X86 codegeneration interface *)
@ -384,23 +385,31 @@ let compile_binop env op =
let safepoint_functions =
[
"Ls__Infix_58";
"Lsubstring";
"Lclone";
label "s__Infix_58";
label "substring";
label "clone";
"Bstring";
"Lstringcat";
"Lstring";
label "stringcat";
label "string";
"Bclosure";
"Barray";
"Bsexp";
"Li__Infix_4343"
(* "LmakeArray"; not required as do not have ptr arguments *)
(* "LmakeString"; not required as do not have ptr arguments *)
(* "LgetEnv", not required as do not have ptr arguments *)
label "i__Infix_4343"
(* "makeArray"; not required as do not have ptr arguments *)
(* "makeString"; not required as do not have ptr arguments *)
(* "getEnv", not required as do not have ptr arguments *)
(* "set_args", not required as do not have ptr arguments *);
(* Lsprintf, or Bsprintf is an extra dirty hack that works? *)
]
let vararg_functions =
[
(label "printf", 1);
(label "fprintf", 2);
(label "sprintf", 1);
(label "failure", 1);
]
let compile_call env ?fname nargs tail =
let fname =
Option.map
@ -485,9 +494,10 @@ let compile_call env ?fname nargs tail =
in
let add_printf_count =
match fname with
| Some "Lprintf" | Some "Lsprintf" | Some "Lfailure" ->
[ Mov (L (nargs - 1), r11) ]
| Some "Lfprintf" -> [ Mov (L (nargs - 2), r11) ]
| Some fname -> (
match List.assoc_opt fname vararg_functions with
| Some n -> [ Mov (L (nargs - n), r11) ]
| None -> [])
| _ -> []
in
let stack_slots, env, setup_args_code = setup_arguments env nargs in
@ -714,10 +724,10 @@ let compile cmd env imports code =
CJmp ("z", "_continue");
Ret;
Label "_ERROR";
Call "Lbinoperror";
Call (label "binoperror");
Ret;
Label "_ERROR2";
Call "Lbinoperror2";
Call (label "binoperror2");
Ret;
Label "_continue";
Mov (L 1, M "_init");
@ -1172,7 +1182,7 @@ class env prg =
(* gets a number of stack positions allocated *)
method allocated = stack_slots
method allocated_size = Printf.sprintf "LS%s_SIZE" fname
method allocated_size = label (Printf.sprintf "S%s_SIZE" fname)
(* enters a function *)
method enter f nargs nlocals has_closure =
@ -1185,10 +1195,10 @@ class env prg =
; first_line = true>}
(* returns a label for the epilogue *)
method epilogue = Printf.sprintf "L%s_epilogue" fname
method epilogue = label (Printf.sprintf "%s_epilogue" fname)
(* returns a name for local size meta-symbol *)
method lsize = Printf.sprintf "L%s_SIZE" fname
method lsize = label (Printf.sprintf "%s_SIZE" fname)
(* returns a list of live registers *)
method live_registers =