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

Arithmetics+corrections (expressions only)

Browse source
This commit is contained in:
Dmitry Boulytchev 2018-10-23 23:18:00 +03:00
parent ee402687de
commit eb72a6aa3d
6 changed files with 72 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

6
regression/expressions/Makefile
View file

@ -7,9 +7,9 @@ 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
clean: clean:
rm -f *.log *.s *~ $(TESTS) rm -f *.log *.s *~ $(TESTS)

17
regression/test034.expr
View file

@ -1,17 +0,0 @@
fun printString (x) {
for i:=0, i<x.length, i:=i+1 do
write (x[i])
od
}
n := read ();
x := "abcdefgh";
printString (x);
for i:=0, i<x.length, i:=i+1 do
x[i] := x[i]+2
od;
printString (x)

18
runtime/runtime.c
View file

@ -120,7 +120,11 @@ extern void Bsta (int n, int v, void *s, ...) {
else ((int*) s)[k] = v; else ((int*) s)[k] = v;
} }
void Lprintf (char *s, ...) { extern int Lraw (int x) {
return x >> 1;
}
extern void Lprintf (char *s, ...) {
va_list args; va_list args;
va_start (args, s); va_start (args, s);
@ -128,7 +132,7 @@ void Lprintf (char *s, ...) {
va_end (args); va_end (args);
} }
void* Lstrcat (void *a, void *b) { extern void* Lstrcat (void *a, void *b) {
data *da = TO_DATA(a); data *da = TO_DATA(a);
data *db = TO_DATA(b); data *db = TO_DATA(b);
@ -142,7 +146,7 @@ void* Lstrcat (void *a, void *b) {
return d->contents; return d->contents;
} }
void Lfprintf (FILE *f, char *s, ...) { extern void Lfprintf (FILE *f, char *s, ...) {
va_list args; va_list args;
va_start (args, s); va_start (args, s);
@ -150,11 +154,11 @@ void Lfprintf (FILE *f, char *s, ...) {
va_end (args); va_end (args);
} }
FILE* Lfopen (char *f, char *m) { extern FILE* Lfopen (char *f, char *m) {
return fopen (f, m); return fopen (f, m);
} }
void Lfclose (FILE *f) { extern void Lfclose (FILE *f) {
fclose (f); fclose (f);
} }
@ -166,12 +170,12 @@ extern int Lread () {
fflush (stdout); fflush (stdout);
scanf ("%d", &result); scanf ("%d", &result);
return result; return (result << 1) | 0x0001;
} }
/* Lwrite is an implementation of the "write" construct */ /* Lwrite is an implementation of the "write" construct */
extern int Lwrite (int n) { extern int Lwrite (int n) {
printf ("%d\n", n); printf ("%d\n", n >> 1);
fflush (stdout); fflush (stdout);
return 0; return 0;

2
src/SM.ml
View file

@ -113,7 +113,7 @@ let run p i =
let args, stack' = split n stack in let args, stack' = split n stack in
let (st, i, o, r) = Language.Builtin.eval (st, i, o, None) (List.rev args) f in let (st, i, o, r) = Language.Builtin.eval (st, i, o, None) (List.rev args) f in
let stack'' = if p then stack' else let Some r = r in r::stack' in let stack'' = if p then stack' else let Some r = r in r::stack' in
Printf.printf "Builtin: %s\n"; (*Printf.printf "Builtin:\n";*)
(cstack, stack'', (st, i, o)) (cstack, stack'', (st, i, o))
end end
) )

66
src/X86.ml
View file

@ -48,6 +48,11 @@ type instr =
(* a non-conditional jump *) | Jmp of string (* a non-conditional jump *) | Jmp of string
(* directive *) | Meta of string (* directive *) | Meta of string
(* arithmetic correction: decrement *) | Dec of opnd
(* arithmetic correction: or 0x0001 *) | Or1 of opnd
(* arithmetic correction: shl 1 *) | Sal1 of opnd
(* arithmetic correction: shr 1 *) | Sar1 of opnd
(* Instruction printer *) (* Instruction printer *)
let show instr = let show instr =
let binop = function let binop = function
@ -82,6 +87,10 @@ let show instr =
| Jmp l -> Printf.sprintf "\tjmp\t%s" l | Jmp l -> Printf.sprintf "\tjmp\t%s" l
| CJmp (s , l) -> Printf.sprintf "\tj%s\t%s" s l | CJmp (s , l) -> Printf.sprintf "\tj%s\t%s" s l
| Meta s -> Printf.sprintf "%s\n" s | Meta s -> Printf.sprintf "%s\n" s
| Dec s -> Printf.sprintf "\tdecl\t%s" (opnd s)
| Or1 s -> Printf.sprintf "\torl\t$0x0001,\t%s" (opnd s)
| Sal1 s -> Printf.sprintf "\tsall\t%s" (opnd s)
| Sar1 s -> Printf.sprintf "\tsarl\t%s" (opnd s)
(* Opening stack machine to use instructions without fully qualified names *) (* Opening stack machine to use instructions without fully qualified names *)
open SM open SM
@ -146,7 +155,7 @@ let compile env code =
match instr with match instr with
| CONST n -> | CONST n ->
let s, env' = env#allocate in let s, env' = env#allocate in
(env', [Mov (L n, s)]) (env', [Mov (L ((n lsl 1) lor 1), s)])
| STRING s -> | STRING s ->
let s, env = env#string s in let s, env = env#string s in
@ -184,11 +193,27 @@ let compile env code =
let x, y, env' = env#pop2 in let x, y, env' = env#pop2 in
env'#push y, env'#push y,
(match op with (match op with
| "/" | "%" -> | "/" ->
[Mov (y, eax); [Mov (y, eax);
Sar1 eax;
Cltd; Cltd;
(* x := x >> 1 ?? *)
Sar1 x; (*!!!*)
IDiv x; IDiv x;
Mov ((match op with "/" -> eax | _ -> edx), y) Sal1 eax;
Or1 eax;
Mov (eax, y)
]
| "%" ->
[Mov (y, eax);
Sar1 eax;
Cltd;
(* x := x >> 1 ?? *)
Sar1 x; (*!!!*)
IDiv x;
Sal1 edx;
Or1 edx;
Mov (edx, y)
] ]
| "<" | "<=" | "==" | "!=" | ">=" | ">" -> | "<" | "<=" | "==" | "!=" | ">=" | ">" ->
(match x with (match x with
@ -197,25 +222,31 @@ let compile env code =
Mov (x, edx); Mov (x, edx);
Binop ("cmp", edx, y); Binop ("cmp", edx, y);
Set (suffix op, "%al"); Set (suffix op, "%al");
Sal1 eax;
Or1 eax;
Mov (eax, y) Mov (eax, y)
] ]
| _ -> | _ ->
[Binop ("^" , eax, eax); [Binop ("^" , eax, eax);
Binop ("cmp", x, y); Binop ("cmp", x, y);
Set (suffix op, "%al"); Set (suffix op, "%al");
Sal1 eax;
Or1 eax;
Mov (eax, y) Mov (eax, y)
] ]
) )
| "*" -> | "*" ->
if on_stack x && on_stack y if on_stack y
then [Mov (y, eax); Binop (op, x, eax); Mov (eax, y)] then [Dec y; Mov (x, eax); Sar1 eax; Binop (op, y, eax); Or1 eax; Mov (eax, y)]
else [Binop (op, x, y)] else [Dec y; Mov (x, eax); Sar1 eax; Binop (op, eax, y); Or1 y]
| "&&" -> | "&&" ->
[Mov (x, eax); [Dec x; (*!!!*)
Mov (x, eax);
Binop (op, x, eax); Binop (op, x, eax);
Mov (L 0, eax); Mov (L 0, eax);
Set ("ne", "%al"); Set ("ne", "%al");
Dec y; (*!!!*)
Mov (y, edx); Mov (y, edx);
Binop (op, y, edx); Binop (op, y, edx);
Mov (L 0, edx); Mov (L 0, edx);
@ -223,20 +254,29 @@ let compile env code =
Binop (op, edx, eax); Binop (op, edx, eax);
Set ("ne", "%al"); Set ("ne", "%al");
Sal1 eax;
Or1 eax;
Mov (eax, y) Mov (eax, y)
] ]
| "!!" -> | "!!" ->
[Mov (y, eax); [Mov (y, eax);
Sar1 eax;
Sar1 x; (*!!!*)
Binop (op, x, eax); Binop (op, x, eax);
Mov (L 0, eax); Mov (L 0, eax);
Set ("ne", "%al"); Set ("ne", "%al");
Sal1 eax;
Or1 eax;
Mov (eax, y) Mov (eax, y)
] ]
| _ -> | "+" ->
if on_stack x && on_stack y if on_stack x && on_stack y
then [Mov (x, eax); Binop (op, eax, y)] then [Mov (x, eax); Dec eax; Binop ("+", eax, y)]
else [Binop (op, x, y)] else [Binop (op, x, y); Dec y]
| "-" ->
if on_stack x && on_stack y
then [Mov (x, eax); Binop (op, eax, y); Or1 y]
else [Binop (op, x, y); Or1 y]
) )
| LABEL s -> (if env#is_barrier then (env#drop_barrier)#retrieve_stack s else env), [Label s] | LABEL s -> (if env#is_barrier then (env#drop_barrier)#retrieve_stack s else env), [Label s]
@ -244,7 +284,7 @@ let compile env code =
| CJMP (s, l) -> | CJMP (s, l) ->
let x, env = env#pop in let x, env = env#pop in
env#set_stack l, [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) ->
let env = env#enter f a l in let env = env#enter f a l in
@ -456,7 +496,7 @@ class env =
the stack code, then generates x86 assember code, then prints the assembler file the stack code, then generates x86 assember code, then prints the assembler file
*) *)
let genasm (ds, stmt) = let genasm (ds, stmt) =
let stmt = Language.Stmt.Seq (stmt, Language.Stmt.Return (Some (Language.Expr.Const 0))) in let stmt = Language.Stmt.Seq (stmt, Language.Stmt.Return (Some (Language.Expr.Call ("raw", [Language.Expr.Const 0])))) in
let env, code = let env, code =
compile compile
(new env) (new env)