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

Byterun/some intrinsics

Browse source
This commit is contained in:
Dmitry Boulytchev 2021-10-03 17:10:21 +03:00
parent c90a73c10f
commit 4d56ccc068
4 changed files with 70 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

42
byterun/byterun.c
View file

@ -14,6 +14,7 @@ typedef struct {
char *string_ptr; /* A pointer to the beginning of the string table */ char *string_ptr; /* A pointer to the beginning of the string table */
int *public_ptr; /* A pointer to the beginning of publics table */ int *public_ptr; /* A pointer to the beginning of publics table */
char *code_ptr; /* A pointer to the bytecode itself */ char *code_ptr; /* A pointer to the bytecode itself */
int *global_ptr; /* A pointer to the global area */
int stringtab_size; /* The size (in bytes) of the string table */ int stringtab_size; /* The size (in bytes) of the string table */
int global_area_size; /* The size (in words) of global area */ int global_area_size; /* The size (in words) of global area */
int public_symbols_number; /* The number of public symbols */ int public_symbols_number; /* The number of public symbols */
@ -49,7 +50,7 @@ bytefile* read_file (char *fname) {
failure ("%s\n", strerror (errno)); failure ("%s\n", strerror (errno));
} }
file = (bytefile*) malloc (sizeof(int)*3 + (size = ftell (f))); file = (bytefile*) malloc (sizeof(int)*4 + (size = ftell (f)));
if (file == 0) { if (file == 0) {
failure ("*** FAILURE: unable to allocate memory.\n"); failure ("*** FAILURE: unable to allocate memory.\n");
@ -66,6 +67,7 @@ bytefile* read_file (char *fname) {
file->string_ptr = &file->buffer [file->public_symbols_number * 2 * sizeof(int)]; file->string_ptr = &file->buffer [file->public_symbols_number * 2 * sizeof(int)];
file->public_ptr = (int*) file->buffer; file->public_ptr = (int*) file->buffer;
file->code_ptr = &file->string_ptr [file->stringtab_size]; file->code_ptr = &file->string_ptr [file->stringtab_size];
file->global_ptr = (int*) malloc (file->global_area_size * sizeof (int));
return file; return file;
} }
@ -81,7 +83,7 @@ void disassemble (FILE *f, bytefile *bf) {
char *ip = bf->code_ptr; char *ip = bf->code_ptr;
char *ops [] = {"+", "-", "*", "/", "%", "<", "<=", ">", ">=", "==", "!=", "&&", "!!"}; char *ops [] = {"+", "-", "*", "/", "%", "<", "<=", ">", ">=", "==", "!=", "&&", "!!"};
char *pats[] = {"=str", "#string", "#array", "#sexp", "#ref", "#val", "#fun"}; char *pats[] = {"=str", "#string", "#array", "#sexp", "#ref", "#val", "#fun"};
char *lds [] = {"LD\t", "LDA\t", "ST\t"}; char *lds [] = {"LD", "LDA", "ST"};
do { do {
char x = BYTE, char x = BYTE,
h = (x & 0xF0) >> 4, h = (x & 0xF0) >> 4,
@ -145,6 +147,10 @@ void disassemble (FILE *f, bytefile *bf) {
fprintf (f, "SWAP"); fprintf (f, "SWAP");
break; break;
case 11:
fprintf (f, "ELEM");
break;
default: default:
FAIL; FAIL;
} }
@ -166,11 +172,11 @@ void disassemble (FILE *f, bytefile *bf) {
case 5: case 5:
switch (l) { switch (l) {
case 0: case 0:
fprintf (f, "CJMPz\t%0x.8x", INT); fprintf (f, "CJMPz\t0x%.8x", INT);
break; break;
case 1: case 1:
fprintf (f, "CJMPnz\t%0x.8x", INT); fprintf (f, "CJMPnz\t0x%.8x", INT);
break; break;
case 2: case 2:
@ -234,6 +240,34 @@ void disassemble (FILE *f, bytefile *bf) {
fprintf (f, "PATT\t%s", pats[l]); fprintf (f, "PATT\t%s", pats[l]);
break; break;
case 7: {
switch (l) {
case 0:
fprintf (f, "CALL\tLread");
break;
case 1:
fprintf (f, "CALL\tLwrite");
break;
case 2:
fprintf (f, "CALL\tLlength");
break;
case 3:
fprintf (f, "CALL\tLstring");
break;
case 4:
fprintf (f, "CALL\tBarray");
break;
default:
FAIL;
}
}
break;
default: default:
FAIL; FAIL;
} }

25
src/SM.ml
View file

@ -25,6 +25,7 @@ let show_scope = show(scope);;
(* store a value into a variable *) | ST of Value.designation (* store a value into a variable *) | ST of Value.designation
(* store a value into a reference *) | STI (* store a value into a reference *) | STI
(* store a value into array/sexp/string *) | STA (* store a value into array/sexp/string *) | STA
(* takes an element of array/string/sexp *) | ELEM
(* a label *) | LABEL of string (* a label *) | LABEL of string
(* a forwarded label *) | FLABEL of string (* a forwarded label *) | FLABEL of string
(* a scope label *) | SLABEL of string (* a scope label *) | SLABEL of string
@ -48,6 +49,7 @@ let show_scope = show(scope);;
(* match failure (location, leave a value *) | FAIL of Loc.t * bool (* match failure (location, leave a value *) | FAIL of Loc.t * bool
(* external definition *) | EXTERN of string (* external definition *) | EXTERN of string
(* public definition *) | PUBLIC of string (* public definition *) | PUBLIC of string
(* import clause *) | IMPORT of string
(* line info *) | LINE of int (* line info *) | LINE of int
with show with show
@ -126,11 +128,13 @@ module ByteCode =
let st = StringTab.create () in let st = StringTab.create () in
let lmap = Stdlib.ref M.empty in let lmap = Stdlib.ref M.empty in
let pubs = Stdlib.ref S.empty in let pubs = Stdlib.ref S.empty in
let imports = Stdlib.ref S.empty in
let globals = Stdlib.ref M.empty in let globals = Stdlib.ref M.empty in
let glob_count = Stdlib.ref 0 in let glob_count = Stdlib.ref 0 in
let fixups = Stdlib.ref [] in let fixups = Stdlib.ref [] in
let add_lab l = lmap := M.add l (Buffer.length code) !lmap in let add_lab l = lmap := M.add l (Buffer.length code) !lmap in
let add_public l = pubs := S.add l !pubs in let add_public l = pubs := S.add l !pubs in
let add_import l = imports := S.add l !imports in
let add_fixup l = fixups := (Buffer.length code, l) :: !fixups in let add_fixup l = fixups := (Buffer.length code, l) :: !fixups in
let add_bytes = List.iter (fun x -> Buffer.add_char code @@ Char .chr x) in let add_bytes = List.iter (fun x -> Buffer.add_char code @@ Char .chr x) in
let add_ints = List.iter (fun x -> Buffer.add_int32_ne code @@ Int32.of_int x) in let add_ints = List.iter (fun x -> Buffer.add_int32_ne code @@ Int32.of_int x) in
@ -175,7 +179,7 @@ module ByteCode =
(* 0x18 *) | DROP -> add_bytes [1*16 + 8] (* 0x18 *) | DROP -> add_bytes [1*16 + 8]
(* 0x19 *) | DUP -> add_bytes [1*16 + 9] (* 0x19 *) | DUP -> add_bytes [1*16 + 9]
(* 0x1a *) | SWAP -> add_bytes [1*16 + 10] (* 0x1a *) | SWAP -> add_bytes [1*16 + 10]
(* 0x1b *) | ELEM -> add_bytes [1*16 + 11]
(* 0x2d n:32 *) | LD d -> add_designations (Some 2) [d] (* 0x2d n:32 *) | LD d -> add_designations (Some 2) [d]
(* 0x3d n:32 *) | LDA d -> add_designations (Some 3) [d] (* 0x3d n:32 *) | LDA d -> add_designations (Some 3) [d]
@ -184,6 +188,12 @@ module ByteCode =
(* 0x50 l:32 *) | CJMP ("z" , s) -> add_bytes [5*16 + 0]; add_fixup s; add_ints [0] (* 0x50 l:32 *) | CJMP ("z" , s) -> add_bytes [5*16 + 0]; add_fixup s; add_ints [0]
(* 0x51 l:32 *) | CJMP ("nz", s) -> add_bytes [5*16 + 1]; add_fixup s; add_ints [0] (* 0x51 l:32 *) | CJMP ("nz", s) -> add_bytes [5*16 + 1]; add_fixup s; add_ints [0]
(* 0x70 *) | CALL ("Lread", _, _) -> add_bytes [7*16 + 0]
(* 0x71 *) | CALL ("Lwrite", _, _) -> add_bytes [7*16 + 1]
(* 0x72 *) | CALL ("Llength", _, _) -> add_bytes [7*16 + 2]
(* 0x72 *) | CALL ("Lstring", _, _) -> add_bytes [7*16 + 3]
(* 0x72 *) | CALL (".array", _, _) -> add_bytes [7*16 + 4]
(* 0x52 n:32 n:32 *) | BEGIN (_, a, l, [], _, _) -> add_bytes [5*16 + 2]; add_ints [a; l] (* with no closure *) (* 0x52 n:32 n:32 *) | BEGIN (_, a, l, [], _, _) -> add_bytes [5*16 + 2]; add_ints [a; l] (* with no closure *)
(* 0x53 n:32 n:32 *) | BEGIN (_, a, l, _, _, _) -> add_bytes [5*16 + 3]; add_ints [a; l] (* with a closure *) (* 0x53 n:32 n:32 *) | BEGIN (_, a, l, _, _, _) -> add_bytes [5*16 + 3]; add_ints [a; l] (* with a closure *)
(* 0x54 l:32 n:32 d*:32 *) | CLOSURE (s, ds) -> add_bytes [5*16 + 4]; add_fixup s; add_ints [0; List.length ds]; add_designations None ds (* 0x54 l:32 n:32 d*:32 *) | CLOSURE (s, ds) -> add_bytes [5*16 + 4]; add_fixup s; add_ints [0; List.length ds]; add_designations None ds
@ -197,6 +207,7 @@ module ByteCode =
| EXTERN s -> () | EXTERN s -> ()
| PUBLIC s -> add_public s | PUBLIC s -> add_public s
| IMPORT s -> add_import s
in in
List.iter insn_code insns; List.iter insn_code insns;
add_bytes [255]; add_bytes [255];
@ -305,6 +316,10 @@ let rec eval env (((cstack, stack, glob, loc, i, o) as conf) : config) = functio
| STRING s -> eval env (cstack, (Value.of_string @@ Bytes.of_string s)::stack, glob, loc, i, o) prg' | STRING s -> eval env (cstack, (Value.of_string @@ Bytes.of_string s)::stack, glob, loc, i, o) prg'
| SEXP (s, n) -> let vs, stack' = split n stack in | SEXP (s, n) -> let vs, stack' = split n stack in
eval env (cstack, (Value.sexp s @@ List.rev vs)::stack', glob, loc, i, o) prg' eval env (cstack, (Value.sexp s @@ List.rev vs)::stack', glob, loc, i, o) prg'
| ELEM -> let a :: b :: stack' = stack in
eval env (env#builtin ".elem" [a; b] (cstack, stack', glob, loc, i, o)) prg'
| LD x -> eval env (cstack, (match x with | LD x -> eval env (cstack, (match x with
| Value.Global x -> glob x | Value.Global x -> glob x
| Value.Local i -> loc.locals.(i) | Value.Local i -> loc.locals.(i)
@ -882,7 +897,7 @@ let compile cmd ((imports, infixes), p) =
List.fold_left List.fold_left
(fun (i, env, code) p -> (fun (i, env, code) p ->
let env, _, pcode = pattern env ldrop p in let env, _, pcode = pattern env ldrop p in
i+1, env, ([DUP; CONST i; CALL (".elem", 2, false)] @ pcode) :: code i+1, env, ([DUP; CONST i; ELEM (*CALL (".elem", 2, false)*) ] @ pcode) :: code
) )
(0, env, []) (0, env, [])
ps ps
@ -918,7 +933,7 @@ let compile cmd ((imports, infixes), p) =
(*Printf.printf "End Bindings..\n";*) (*Printf.printf "End Bindings..\n";*)
env, env,
([DUP] @ ([DUP] @
List.concat (List.map (fun i -> [CONST i; CALL (".elem", 2, false)]) path) @ List.concat (List.map (fun i -> [CONST i; ELEM (* CALL (".elem", 2, false)*)]) path) @
[ST dsg; DROP]) :: acc [ST dsg; DROP]) :: acc
) )
(env, []) (env, [])
@ -1000,7 +1015,7 @@ let compile cmd ((imports, infixes), p) =
add_code (compile_list false lsexp env xs) lsexp false [SEXP (t, List.length xs)] add_code (compile_list false lsexp env xs) lsexp false [SEXP (t, List.length xs)]
| Expr.Elem (a, i) -> let lelem, env = env#get_label in | Expr.Elem (a, i) -> let lelem, env = env#get_label in
add_code (compile_list false lelem env [a; i]) lelem false [CALL (".elem", 2, tail)] add_code (compile_list false lelem env [a; i]) lelem false [ELEM (* CALL (".elem", 2, tail) *)]
| Expr.Assign (Expr.Ref x, e) -> let lassn, env = env#get_label in | Expr.Assign (Expr.Ref x, e) -> let lassn, env = env#get_label in
let env , line = env#gen_line x in let env , line = env#gen_line x in
@ -1119,7 +1134,7 @@ let compile cmd ((imports, infixes), p) =
let code = if flag then code @ [LABEL lend] else code in let code = if flag then code @ [LABEL lend] else code in
let topname = cmd#topname in let topname = cmd#topname in
let env, prg = compile_fundefs [[LABEL topname; BEGIN (topname, (if topname = "main" then 2 else 0), env#nlocals, [], [], [])] @ code @ [END]] env in let env, prg = compile_fundefs [[LABEL topname; BEGIN (topname, (if topname = "main" then 2 else 0), env#nlocals, [], [], [])] @ code @ [END]] env in
let prg = [PUBLIC topname] @ env#get_decls @ List.flatten prg in let prg = (List.map (fun i -> IMPORT i) imports) @ [PUBLIC topname] @ env#get_decls @ List.flatten prg in
(*Printf.eprintf "Before propagating closures:\n"; (*Printf.eprintf "Before propagating closures:\n";
Printf.eprintf "%s\n%!" env#show_funinfo; Printf.eprintf "%s\n%!" env#show_funinfo;
*) *)

3
src/X86.ml
View file

@ -241,6 +241,7 @@ let compile cmd env imports code =
match instr with match instr with
| PUBLIC name -> env#register_public name, [] | PUBLIC name -> env#register_public name, []
| EXTERN name -> env#register_extern name, [] | EXTERN name -> env#register_extern name, []
| IMPORT name -> env, []
| CLOSURE (name, closure) -> | CLOSURE (name, closure) ->
let pushr, popr = let pushr, popr =
@ -492,6 +493,8 @@ let compile cmd env imports code =
let x = env#peek in let x = env#peek in
env, [Mov (x, eax); Jmp env#epilogue] env, [Mov (x, eax); Jmp env#epilogue]
| ELEM -> call env ".elem" 2 false
| CALL (f, n, tail) -> call env f n tail | CALL (f, n, tail) -> call env f n tail
| CALLC (n, tail) -> callc env n tail | CALLC (n, tail) -> callc env n tail

2
src/version.ml
View file

@ -1 +1 @@
let version = "Version 1.10, 11203f3a8, Tue Aug 31 01:47:49 2021 +0300" let version = "Version 1.10, c90a73c10, Tue Sep 28 10:39:02 2021 +0300"