diff --git a/regression/expressions/Makefile b/regression/expressions/Makefile index fe0e5468b..0ffefb2f6 100644 --- a/regression/expressions/Makefile +++ b/regression/expressions/Makefile @@ -7,9 +7,9 @@ RC = ../../src/rc.opt check: $(TESTS) $(TESTS): %: %.expr - @RC_RUNTIME=../../runtime $(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log - @cat $@.input | $(RC) -i $< > $@.log && diff $@.log orig/$@.log - @cat $@.input | $(RC) -s $< > $@.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) -s $< > $@.log && diff $@.log orig/$@.log clean: rm -f *.log *.s *~ $(TESTS) diff --git a/regression/test034.expr b/regression/test034.expr deleted file mode 100644 index a31a87f19..000000000 --- a/regression/test034.expr +++ /dev/null @@ -1,17 +0,0 @@ -fun printString (x) { - for i:=0, i> 1; +} + +extern void Lprintf (char *s, ...) { va_list args; va_start (args, s); @@ -128,7 +132,7 @@ void Lprintf (char *s, ...) { va_end (args); } -void* Lstrcat (void *a, void *b) { +extern void* Lstrcat (void *a, void *b) { data *da = TO_DATA(a); data *db = TO_DATA(b); @@ -142,7 +146,7 @@ void* Lstrcat (void *a, void *b) { return d->contents; } -void Lfprintf (FILE *f, char *s, ...) { +extern void Lfprintf (FILE *f, char *s, ...) { va_list args; va_start (args, s); @@ -150,11 +154,11 @@ void Lfprintf (FILE *f, char *s, ...) { va_end (args); } -FILE* Lfopen (char *f, char *m) { +extern FILE* Lfopen (char *f, char *m) { return fopen (f, m); } -void Lfclose (FILE *f) { +extern void Lfclose (FILE *f) { fclose (f); } @@ -166,12 +170,12 @@ extern int Lread () { fflush (stdout); scanf ("%d", &result); - return result; + return (result << 1) | 0x0001; } /* Lwrite is an implementation of the "write" construct */ extern int Lwrite (int n) { - printf ("%d\n", n); + printf ("%d\n", n >> 1); fflush (stdout); return 0; diff --git a/src/Language.ml b/src/Language.ml index cb9f0eadf..c9c84aaf8 100644 --- a/src/Language.ml +++ b/src/Language.ml @@ -138,7 +138,7 @@ module Expr = (* variable *) | Var of string (* binary operator *) | Binop of string * t * t (* element extraction *) | Elem of t * t - (* length *) | Length of t + (* length *) | Length of t (* function call *) | Call of string * t list with show (* Available binary operators: diff --git a/src/SM.ml b/src/SM.ml index 345659d11..11894b921 100644 --- a/src/SM.ml +++ b/src/SM.ml @@ -113,7 +113,7 @@ let run p i = 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 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)) end ) diff --git a/src/X86.ml b/src/X86.ml index e54463571..24b019271 100644 --- a/src/X86.ml +++ b/src/X86.ml @@ -47,7 +47,12 @@ type instr = (* a conditional jump *) | CJmp of string * string (* a non-conditional jump *) | Jmp 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 *) let show instr = let binop = function @@ -82,7 +87,11 @@ let show instr = | Jmp l -> Printf.sprintf "\tjmp\t%s" l | CJmp (s , l) -> Printf.sprintf "\tj%s\t%s" s l | 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 *) open SM @@ -146,7 +155,7 @@ let compile env code = match instr with | CONST n -> let s, env' = env#allocate in - (env', [Mov (L n, s)]) + (env', [Mov (L ((n lsl 1) lor 1), s)]) | STRING s -> let s, env = env#string s in @@ -184,11 +193,27 @@ let compile env code = let x, y, env' = env#pop2 in env'#push y, (match op with - | "/" | "%" -> + | "/" -> [Mov (y, eax); + Sar1 eax; Cltd; + (* x := x >> 1 ?? *) + Sar1 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 @@ -197,25 +222,31 @@ let compile env code = Mov (x, edx); Binop ("cmp", edx, y); Set (suffix op, "%al"); + Sal1 eax; + Or1 eax; Mov (eax, y) ] | _ -> [Binop ("^" , eax, eax); Binop ("cmp", x, y); Set (suffix op, "%al"); + Sal1 eax; + Or1 eax; Mov (eax, y) ] ) | "*" -> - if on_stack x && on_stack y - then [Mov (y, eax); Binop (op, x, eax); Mov (eax, y)] - else [Binop (op, x, y)] + if on_stack y + then [Dec y; Mov (x, eax); Sar1 eax; Binop (op, y, eax); Or1 eax; Mov (eax, 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); Mov (L 0, eax); Set ("ne", "%al"); - + + Dec y; (*!!!*) Mov (y, edx); Binop (op, y, edx); Mov (L 0, edx); @@ -223,20 +254,29 @@ let compile env code = Binop (op, edx, eax); Set ("ne", "%al"); - + Sal1 eax; + Or1 eax; Mov (eax, y) ] | "!!" -> [Mov (y, eax); + Sar1 eax; + Sar1 x; (*!!!*) Binop (op, x, eax); Mov (L 0, eax); Set ("ne", "%al"); + Sal1 eax; + Or1 eax; Mov (eax, y) ] - | _ -> + | "+" -> if on_stack x && on_stack y - then [Mov (x, eax); Binop (op, eax, y)] - else [Binop (op, x, y)] + then [Mov (x, eax); Dec eax; Binop ("+", eax, 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] @@ -244,7 +284,7 @@ let compile env code = | CJMP (s, l) -> 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) -> 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 *) 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 = compile (new env)