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

X86 almost done for expr + stms (GC issues)

Browse source
This commit is contained in:
Dmitry Boulytchev 2019-04-11 16:24:57 +03:00
parent 9bec185603
commit 2aa460a25a
6 changed files with 30 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

2
regression/Makefile
View file

@ -7,7 +7,7 @@ RC=../src/rc.opt
check: $(TESTS) check: $(TESTS)
$(TESTS): %: %.expr $(TESTS): %: %.expr
#@$(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log @$(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
@cat $@.input | $(RC) -i $< > $@.log && diff $@.log orig/$@.log @cat $@.input | $(RC) -i $< > $@.log && diff $@.log orig/$@.log
@cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log @cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log

2
regression/deep-expressions/Makefile
View file

@ -7,7 +7,7 @@ RC = ../../src/rc.opt
check: $(TESTS) check: $(TESTS)
$(TESTS): %: %.expr $(TESTS): %: %.expr
#@RC_RUNTIME=../../runtime $(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log @RC_RUNTIME=../../runtime $(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
@cat $@.input | $(RC) -i $< > $@.log && diff $@.log orig/$@.log @cat $@.input | $(RC) -i $< > $@.log && diff $@.log orig/$@.log
@cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log @cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log

2
regression/expressions/Makefile
View file

@ -7,7 +7,7 @@ RC = ../../src/rc.opt
check: $(TESTS) check: $(TESTS)
$(TESTS): %: %.expr $(TESTS): %: %.expr
#@RC_RUNTIME=../../runtime $(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log @RC_RUNTIME=../../runtime $(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log
@cat $@.input | $(RC) -i $< > $@.log && diff $@.log orig/$@.log @cat $@.input | $(RC) -i $< > $@.log && diff $@.log orig/$@.log
@cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log @cat $@.input | $(RC) -s $< > $@.log && diff $@.log orig/$@.log

23
runtime/runtime.c
View file

@ -339,29 +339,12 @@ extern int Bsexp_tag_patt (void *x) {
return BOX(TAG(TO_DATA(x)->tag) == SEXP_TAG); return BOX(TAG(TO_DATA(x)->tag) == SEXP_TAG);
} }
/*
extern void Bsta (int n, int v, void *s, ...) {
va_list args = (va_list) BOX (NULL);
int i = 0, k = 0;
data *a = (data*) BOX (NULL);
va_start(args, s); extern void* Bsta (void *v, int i, void *x) {
for (i = 0; i < n-1; i++) {
k = UNBOX(va_arg(args, int));
s = ((int**) s) [k];
}
k = UNBOX(va_arg(args, int));
a = TO_DATA(s);
if (TAG(a->tag) == STRING_TAG)((char*) s)[k] = (char) UNBOX(v);
else ((int*) s)[k] = v;
}
*/
extern void Bsta (void *v, int i, void *x) {
if (TAG(TO_DATA(x)->tag) == STRING_TAG)((char*) x)[UNBOX(i)] = (char) UNBOX(v); if (TAG(TO_DATA(x)->tag) == STRING_TAG)((char*) x)[UNBOX(i)] = (char) UNBOX(v);
else ((int*) x)[UNBOX(i)] = v; else ((int*) x)[UNBOX(i)] = v;
return v;
} }
extern int Lraw (int x) { extern int Lraw (int x) {

34
src/X86.ml
View file

@ -110,7 +110,7 @@ open SM
of x86 instructions of x86 instructions
*) *)
let compile env code = let compile env code =
SM.print_prg code; (* SM.print_prg code; *)
flush stdout; flush stdout;
let suffix = function let suffix = function
| "<" -> "l" | "<" -> "l"
@ -124,7 +124,7 @@ let compile env code =
let rec compile' env scode = let rec compile' env scode =
let on_stack = function S _ -> true | _ -> false in let on_stack = function S _ -> true | _ -> false in
let mov x s = if on_stack x && on_stack s then [Mov (x, eax); Mov (eax, s)] else [Mov (x, s)] in let mov x s = if on_stack x && on_stack s then [Mov (x, eax); Mov (eax, s)] else [Mov (x, s)] in
let call env f n p = let call env f n =
let f = let f =
match f.[0] with '.' -> "B" ^ String.sub f 1 (String.length f - 1) | _ -> f match f.[0] with '.' -> "B" ^ String.sub f 1 (String.length f - 1) | _ -> f
in in
@ -147,7 +147,7 @@ let compile env code =
in in
env, pushr @ pushs @ [Call f; Binop ("+", L (4 * List.length pushs), esp)] @ (List.rev popr) env, pushr @ pushs @ [Call f; Binop ("+", L (4 * List.length pushs), esp)] @ (List.rev popr)
in in
(if p then env, code else let y, env = env#allocate in env, code @ [Mov (eax, y)]) let y, env = env#allocate in env, code @ [Mov (eax, y)]
in in
match scode with match scode with
| [] -> env, [] | [] -> env, []
@ -162,7 +162,7 @@ let compile env code =
| STRING s -> | STRING s ->
let s, env = env#string s in let s, env = env#string s in
let l, env = env#allocate in let l, env = env#allocate in
let env, call = call env ".string" 1 false in let env, call = call env ".string" 1 in
(env, Mov (M ("$" ^ s), l) :: call) (env, Mov (M ("$" ^ s), l) :: call)
| LDA x -> | LDA x ->
@ -182,14 +182,14 @@ let compile env code =
) )
| STA -> | STA ->
call env ".sta" 3 true call env ".sta" 3
| ST -> | ST ->
let v, x, env' = env#pop2 in let v, x, env' = env#pop2 in
env', env'#push x,
(match x with (match x with
| S _ | M _ -> [Mov (v, edx); Mov (x, eax); Mov (edx, I eax)] | S _ | M _ -> [Mov (v, edx); Mov (x, eax); Mov (edx, I eax); Mov (edx, x)]
| _ -> [Mov (v, eax); Mov (eax, I x)] | _ -> [Mov (v, eax); Mov (eax, I x); Mov (eax, x)]
) )
| BINOP op -> | BINOP op ->
@ -290,6 +290,7 @@ let compile env code =
env#set_stack l, [Sar1 x; (*!!!*) Binop ("cmp", L 0, x); CJmp (s, l)] env#set_stack l, [Sar1 x; (*!!!*) Binop ("cmp", L 0, x); CJmp (s, l)]
| BEGIN (f, a, l) -> | BEGIN (f, a, l) ->
env#assert_empty_stack;
let env = env#enter f a l in let env = env#enter f a l in
env, [Push ebp; Mov (esp, ebp); Binop ("-", M ("$" ^ env#lsize), esp); env, [Push ebp; Mov (esp, ebp); Binop ("-", M ("$" ^ env#lsize), esp);
Mov (esp, edi); Mov (esp, edi);
@ -311,11 +312,11 @@ let compile env code =
let x, env = env#pop in let x, env = env#pop in
env, [Mov (x, eax); Jmp env#epilogue] env, [Mov (x, eax); Jmp env#epilogue]
| CALL (f, n) -> call env f n (f <> "Lraw" && f <> "Lcollect_ints" && f <> "Lcollect_ints_acc" && f <> "Lread" && f <> ".elem" && f <> ".array" && f <> ".length") | CALL (f, n) -> call env f n
| SEXP (t, n) -> | SEXP (t, n) ->
let s, env = env#allocate in let s, env = env#allocate in
let env, code = call env ".sexp" (n+1) false in let env, code = call env ".sexp" (n+1) in
env, [Mov (L env#hash t, s)] @ code env, [Mov (L env#hash t, s)] @ code
| DROP -> | DROP ->
@ -333,15 +334,15 @@ let compile env code =
| TAG (t, n) -> | TAG (t, n) ->
let s1, env = env#allocate in let s1, env = env#allocate in
let s2, env = env#allocate in let s2, env = env#allocate in
let env, code = call env ".tag" 3 false in let env, code = call env ".tag" 3 in
env, [Mov (L env#hash t, s1); Mov (L n, s2)] @ code env, [Mov (L env#hash t, s1); Mov (L n, s2)] @ code
| ARRAY n -> | ARRAY n ->
let s, env = env#allocate in let s, env = env#allocate in
let env, code = call env ".array_patt" 2 false in let env, code = call env ".array_patt" 2 in
env, [Mov (L n, s)] @ code env, [Mov (L n, s)] @ code
| PATT StrCmp -> call env ".string_patt" 2 false | PATT StrCmp -> call env ".string_patt" 2
| PATT patt -> | PATT patt ->
call env call env
@ -351,7 +352,7 @@ let compile env code =
| Array -> ".array_tag_patt" | Array -> ".array_tag_patt"
| String -> ".string_tag_patt" | String -> ".string_tag_patt"
| Sexp -> ".sexp_tag_patt" | Sexp -> ".sexp_tag_patt"
) 1 false ) 1
| ENTER xs -> | ENTER xs ->
let env, code = let env, code =
@ -416,6 +417,9 @@ class env =
) locals; ) locals;
Printf.printf "END LOCALS\n" Printf.printf "END LOCALS\n"
(* Assert empty stack *)
method assert_empty_stack = assert (stack = [])
(* check barrier condition *) (* check barrier condition *)
method is_barrier = barrier method is_barrier = barrier
@ -538,7 +542,7 @@ class env =
let genasm (ds, stmt) = let genasm (ds, stmt) =
let stmt = let stmt =
Language.Expr.Seq ( Language.Expr.Seq (
Language.Expr.Call (Language.Expr.Var "__gc_init", []), Language.Expr.Ignore (Language.Expr.Call (Language.Expr.Var "__gc_init", [])),
Language.Expr.Seq (stmt, Language.Expr.Return (Some (Language.Expr.Call (Language.Expr.Var "raw", [Language.Expr.Const 0])))) Language.Expr.Seq (stmt, Language.Expr.Return (Some (Language.Expr.Call (Language.Expr.Var "raw", [Language.Expr.Const 0]))))
) )
in in