mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-06 06:48:48 +00:00
Arrays/strings in x86
This commit is contained in:
Dmitry Boulytchev
danyaberezun
parent
25b4a79832
commit
f2cecd9bf1
5 changed files with 385 additions and 34 deletions
|
|
@ -7,7 +7,7 @@ RC=../src/rc.opt
|
|||
check: $(TESTS)
|
||||
|
||||
$(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) -s $< > $@.log && diff $@.log orig/$@.log
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,307 @@
|
|||
/* Runtime library */
|
||||
|
||||
# include <stdio.h>
|
||||
# include <stdio.h>
|
||||
# include <malloc.h>
|
||||
# include <string.h>
|
||||
# include <stdarg.h>
|
||||
# include <alloca.h>
|
||||
|
||||
# define STRING_TAG 0x00000000
|
||||
# define ARRAYU_TAG 0x01000000
|
||||
# define ARRAYB_TAG 0x02000000
|
||||
|
||||
# define LEN(x) (x & 0x00FFFFFF)
|
||||
# define TAG(x) (x & 0xFF000000)
|
||||
|
||||
# define TO_DATA(x) ((data*)((char*)(x)-sizeof(int)))
|
||||
|
||||
typedef struct {
|
||||
int tag;
|
||||
char contents[0];
|
||||
} data;
|
||||
|
||||
extern int Blength (void *p) {
|
||||
data *a = TO_DATA(p);
|
||||
return LEN(a->tag);
|
||||
}
|
||||
|
||||
extern void* Belem (void *p, int i) {
|
||||
data *a = TO_DATA(p);
|
||||
|
||||
if (TAG(a->tag) == STRING_TAG) return (void*)(int)(a->contents[i]);
|
||||
|
||||
return (void*) ((int*) a->contents)[i];
|
||||
}
|
||||
|
||||
extern void* Bstring (void *p) {
|
||||
int n = strlen (p);
|
||||
data *r = (data*) malloc (n + 1 + sizeof (int));
|
||||
|
||||
r->tag = n;
|
||||
strncpy (r->contents, p, n + 1);
|
||||
|
||||
return r->contents;
|
||||
}
|
||||
|
||||
extern void* Barray (int n, ...) {
|
||||
va_list args;
|
||||
int i;
|
||||
data *r = (data*) malloc (sizeof(int) * (n+1));
|
||||
|
||||
r->tag = ARRAYB_TAG | n; //(boxed ? ARRAYB_TAG : ARRAYU_TAG) | size;
|
||||
|
||||
va_start(args, n);
|
||||
|
||||
for (i=0; i<n; i++) {
|
||||
int ai = va_arg(args, int);
|
||||
((int*)r->contents)[i] = ai;
|
||||
}
|
||||
|
||||
va_end(args);
|
||||
|
||||
return r->contents;
|
||||
}
|
||||
|
||||
extern void Bsta (int n, int v, void *s, ...) {
|
||||
va_list args;
|
||||
int i, k;
|
||||
data *a;
|
||||
|
||||
va_start(args, s);
|
||||
|
||||
for (i=0; i<n-1; i++) {
|
||||
k = va_arg(args, int);
|
||||
s = ((int**) s) [k];
|
||||
}
|
||||
|
||||
k = va_arg(args, int);
|
||||
a = TO_DATA(s);
|
||||
|
||||
if (TAG(a->tag) == STRING_TAG)((char*) s)[k] = (char) v;
|
||||
else ((int*) s)[k] = v;
|
||||
}
|
||||
|
||||
/*
|
||||
extern void* Lstrdup (void *p) {
|
||||
data *s = TO_DATA(p);
|
||||
data *r = (data*) malloc (s->tag + sizeof(int) + 1);
|
||||
r->tag = s->tag;
|
||||
strncpy (r->contents, s->contents, s->tag + 1);
|
||||
return r->contents;
|
||||
}
|
||||
|
||||
extern int Lstrget (void *p, int i) {
|
||||
data *s = TO_DATA(p);
|
||||
return s->contents[i];
|
||||
}
|
||||
|
||||
extern void* Lstrset (void *p, int i, int c) {
|
||||
data *s = TO_DATA(p);
|
||||
s->contents[i] = c;
|
||||
return s;
|
||||
}
|
||||
|
||||
extern void* Lstrcat (void *p1, void *p2) {
|
||||
data *s1 = TO_DATA(p1), *s2 = TO_DATA(p2);
|
||||
data *r = (data*) malloc (s1->tag + s2->tag + sizeof (int) + 1);
|
||||
r->tag = s1->tag + s2->tag;
|
||||
strncpy (r->contents, s1->contents, s1->tag);
|
||||
strncpy (&(r->contents)[s1->tag], s2->contents, s2->tag+1);
|
||||
return r->contents;
|
||||
}
|
||||
|
||||
extern void* Lstrmake (int n, int c) {
|
||||
data *r = (data*) malloc (n + sizeof (int) + 1);
|
||||
int i;
|
||||
r->tag = n;
|
||||
for (i=0; i<n; i++) r->contents[i] = c;
|
||||
r->contents[n] = 0;
|
||||
return r->contents;
|
||||
}
|
||||
|
||||
extern void* Lstrsub (void *p, int i, int l) {
|
||||
data *s = TO_DATA(p);
|
||||
data *r = (data*) malloc (l + sizeof (int) + 1);
|
||||
r->tag = l;
|
||||
strncpy (r->contents, &(s->contents[i]), l);
|
||||
r->contents[l] = 0;
|
||||
return r->contents;
|
||||
}
|
||||
|
||||
extern int Lstrcmp (void *p1, void *p2) {
|
||||
int i;
|
||||
data *s1 = TO_DATA(p1), *s2 = TO_DATA(p2);
|
||||
int b = s1->tag < s2->tag ? s1->tag : s2->tag;
|
||||
for (i=0; i < b; i++) {
|
||||
if (s1->contents[i] < s2->contents[i]) return -1;
|
||||
if (s2->contents[i] < s1->contents[i]) return 1;
|
||||
}
|
||||
if (s1->tag < s2->tag) return -1;
|
||||
if (s1->tag > s2->tag) return 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
extern int Larrlen (void *p) {
|
||||
data *a = TO_DATA(p);
|
||||
return a->tag & 0x00FFFFFF;
|
||||
}
|
||||
|
||||
extern int L0arrElem (int i, void *p) {
|
||||
data *a = TO_DATA(p);
|
||||
return ((int*) a->contents)[i];
|
||||
}
|
||||
|
||||
extern void* L0sta (void *s, int n, ...) {
|
||||
data *a = TO_DATA(s);
|
||||
va_list args;
|
||||
int i, k, v;
|
||||
data *p = a;
|
||||
|
||||
va_start(args, n);
|
||||
|
||||
for (i=0; i<n-1; i++) {
|
||||
k = va_arg(args, int);
|
||||
p = (data*) ((int*) p->contents)[k];
|
||||
}
|
||||
|
||||
k = va_arg(args, int);
|
||||
v = va_arg(args, int);
|
||||
|
||||
((int*) p->contents)[k] = v;
|
||||
|
||||
va_end(args);
|
||||
|
||||
return p;
|
||||
}
|
||||
|
||||
extern void* L0makeArray (int boxed, int size, ...) {
|
||||
va_list args;
|
||||
int i;
|
||||
data *r = (data*) malloc (sizeof(int)*(size+1));
|
||||
|
||||
r->tag = (boxed ? ARRAYB_TAG : ARRAYU_TAG) | size;
|
||||
|
||||
va_start(args, size);
|
||||
|
||||
for (i=0; i<size; i++) {
|
||||
int ai = va_arg(args, int);
|
||||
((int*)r->contents)[i] = ai;
|
||||
}
|
||||
|
||||
va_end(args);
|
||||
|
||||
return r->contents;
|
||||
}
|
||||
|
||||
extern void* L0makeSexp (int tag, int size, ...) {
|
||||
va_list args;
|
||||
int i;
|
||||
data *r = (data*) malloc (sizeof(int)*(size+1));
|
||||
|
||||
r->tag = ((tag+3) << 24) | size;
|
||||
|
||||
va_start(args, size);
|
||||
|
||||
for (i=0; i<size; i++) {
|
||||
int ai = va_arg(args, int);
|
||||
((int*)r->contents)[i] = ai;
|
||||
}
|
||||
|
||||
va_end(args);
|
||||
|
||||
return r->contents;
|
||||
}
|
||||
|
||||
extern int Ltag (void *p) {
|
||||
data *s = TO_DATA(p);
|
||||
int t = ((s->tag & 0xFF000000) >> 24) - 3;
|
||||
return t;
|
||||
}
|
||||
|
||||
extern int Ltagcmp (int t1, int t2) {
|
||||
return t1 == t2;
|
||||
}
|
||||
|
||||
extern void* Larrmake (int size, int val) {
|
||||
data *a = (data*) malloc (sizeof(int)*(size+1));
|
||||
int i;
|
||||
|
||||
a->tag = ARRAYU_TAG | size;
|
||||
|
||||
for (i=0; i<size; i++)
|
||||
((int*)a->contents)[i] = val;
|
||||
|
||||
return a->contents;
|
||||
}
|
||||
|
||||
extern void* LArrmake (int size, void *val) {
|
||||
data *a = (data*) malloc (sizeof(int)*(size+1));
|
||||
int i;
|
||||
|
||||
a->tag = ARRAYB_TAG | size;
|
||||
|
||||
for (i=0; i<size; i++)
|
||||
((data**)a->contents)[i] = val;
|
||||
|
||||
return a->contents;
|
||||
}
|
||||
|
||||
extern int Lread () {
|
||||
int result;
|
||||
|
||||
printf ("> ");
|
||||
fflush (stdout);
|
||||
scanf ("%d", &result);
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
extern int Lwrite (int n) {
|
||||
printf ("%d\n", n);
|
||||
fflush (stdout);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
extern int Lprintf (char *format, ...) {
|
||||
va_list args;
|
||||
int n = Lstrlen ((void*)format);
|
||||
|
||||
va_start (args, format);
|
||||
|
||||
vprintf (format, args);
|
||||
|
||||
va_end (args);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
extern void* Lfread (char *fname) {
|
||||
data *result;
|
||||
int size;
|
||||
FILE * file;
|
||||
int n = Lstrlen ((void*)fname);
|
||||
|
||||
file = fopen (fname, "rb");
|
||||
|
||||
fseek (file, 0, SEEK_END);
|
||||
size = ftell (file);
|
||||
rewind (file);
|
||||
|
||||
result = (data*) malloc (size+sizeof(int)+1);
|
||||
result->tag = size;
|
||||
|
||||
fread (result->contents, sizeof(char), size, file);
|
||||
fclose (file);
|
||||
|
||||
result->contents[size] = 0;
|
||||
|
||||
return result->contents;
|
||||
}
|
||||
|
||||
// New one
|
||||
*/
|
||||
|
||||
/* Lread is an implementation of the "read" construct */
|
||||
extern int Lread () {
|
||||
|
|
@ -20,3 +321,4 @@ extern int Lwrite (int n) {
|
|||
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -71,19 +71,19 @@ module State =
|
|||
(* Builtins *)
|
||||
module Builtin =
|
||||
struct
|
||||
|
||||
|
||||
let eval (st, i, o, _) args = function
|
||||
| "read" -> (match i with z::i' -> (st, i', o, Some (Value.of_int z)) | _ -> failwith "Unexpected end of input")
|
||||
| "write" -> (st, i, o @ [Value.to_int @@ List.hd args], None)
|
||||
| "$elem" -> let [b; j] = args in
|
||||
| ".elem" -> let [b; j] = args in
|
||||
(st, i, o, let i = Value.to_int j in
|
||||
Some (match b with
|
||||
| Value.String s -> Value.of_int @@ Char.code s.[i]
|
||||
| Value.Array a -> List.nth a i
|
||||
)
|
||||
)
|
||||
| "$length" -> (st, i, o, Some (Value.of_int (match List.hd args with Value.Array a -> List.length a | Value.String s -> String.length s)))
|
||||
| "$array" -> (st, i, o, Some (Value.of_array args))
|
||||
| ".length" -> (st, i, o, Some (Value.of_int (match List.hd args with Value.Array a -> List.length a | Value.String s -> String.length s)))
|
||||
| ".array" -> (st, i, o, Some (Value.of_array args))
|
||||
| "isArray" -> let [a] = args in (st, i, o, Some (Value.of_int @@ match a with Value.Array _ -> 1 | _ -> 0))
|
||||
| "isString" -> let [a] = args in (st, i, o, Some (Value.of_int @@ match a with Value.String _ -> 1 | _ -> 0))
|
||||
|
||||
|
|
@ -158,7 +158,7 @@ module Expr =
|
|||
| Var x -> (st, i, o, Some (State.eval st x))
|
||||
| Array xs ->
|
||||
let (st, i, o, vs) = eval_list env conf xs in
|
||||
env#definition env "$array" vs (st, i, o, None)
|
||||
env#definition env ".array" vs (st, i, o, None)
|
||||
| Sexp (t, xs) ->
|
||||
let (st, i, o, vs) = eval_list env conf xs in
|
||||
(st, i, o, Some (Value.Sexp (t, vs)))
|
||||
|
|
@ -168,10 +168,10 @@ module Expr =
|
|||
(st, i, o, Some (Value.of_int @@ to_func op (Value.to_int x) (Value.to_int y)))
|
||||
| Elem (b, i) ->
|
||||
let (st, i, o, args) = eval_list env conf [b; i] in
|
||||
env#definition env "$elem" args (st, i, o, None)
|
||||
env#definition env ".elem" args (st, i, o, None)
|
||||
| Length e ->
|
||||
let (st, i, o, Some v) = eval env conf e in
|
||||
env#definition env "$length" [v] (st, i, o, None)
|
||||
env#definition env ".length" [v] (st, i, o, None)
|
||||
| Call (f, args) ->
|
||||
let (st, i, o, args) = eval_list env conf args in
|
||||
env#definition env f args (st, i, o, None)
|
||||
|
|
@ -244,7 +244,6 @@ module Stmt =
|
|||
Takes an environment, a configuration and a statement, and returns another configuration. The
|
||||
environment is the same as for expressions
|
||||
*)
|
||||
|
||||
let update st x v is =
|
||||
let rec update a v = function
|
||||
| [] -> v
|
||||
|
|
|
|||
|
|
@ -74,7 +74,7 @@ let rec eval env ((cstack, stack, ((st, i, o) as c)) as conf) = function
|
|||
Takes a program, an input stream, and returns an output stream this program calculates
|
||||
*)
|
||||
let run p i =
|
||||
(* print_prg p; *)
|
||||
(*print_prg p; *)
|
||||
let module M = Map.Make (String) in
|
||||
let rec make_map m = function
|
||||
| [] -> m
|
||||
|
|
@ -119,9 +119,9 @@ let compile (defs, p) =
|
|||
| Expr.String s -> [STRING s]
|
||||
| Expr.Binop (op, x, y) -> expr x @ expr y @ [BINOP op]
|
||||
| Expr.Call (f, args) -> call f args false
|
||||
| Expr.Array xs -> List.flatten (List.map expr xs) @ [CALL ("$array", List.length xs, false)]
|
||||
| Expr.Elem (a, i) -> expr a @ expr i @ [CALL ("$elem", 2, false)]
|
||||
| Expr.Length e -> expr e @ [CALL ("$length", 1, false)]
|
||||
| Expr.Array xs -> List.flatten (List.map expr xs) @ [CALL (".array", List.length xs, false)]
|
||||
| Expr.Elem (a, i) -> expr a @ expr i @ [CALL (".elem", 2, false)]
|
||||
| Expr.Length e -> expr e @ [CALL (".length", 1, false)]
|
||||
in
|
||||
let rec compile_stmt l env = function
|
||||
| Stmt.Assign (x, [], e) -> env, false, expr e @ [ST x]
|
||||
|
|
|
|||
92
src/X86.ml
92
src/X86.ml
|
|
@ -102,6 +102,35 @@ let compile env code =
|
|||
in
|
||||
let rec compile' env scode =
|
||||
let on_stack = function S _ -> true | _ -> false in
|
||||
let call env f n p =
|
||||
let f =
|
||||
match f.[0] with '.' -> "B" ^ String.sub f 1 (String.length f - 1) | _ -> f
|
||||
in
|
||||
let pushr, popr =
|
||||
List.split @@ List.map (fun r -> (Push r, Pop r)) (env#live_registers n)
|
||||
in
|
||||
let env, code =
|
||||
if n = 0
|
||||
then env, pushr @ [Call f] @ (List.rev popr)
|
||||
else
|
||||
let rec push_args env acc = function
|
||||
| 0 -> env, acc
|
||||
| n -> let x, env = env#pop in
|
||||
push_args env ((Push x)::acc) (n-1)
|
||||
in
|
||||
let env, pushs = push_args env [] n in
|
||||
let pushs =
|
||||
match f with
|
||||
| "Barray" -> List.rev @@ (Push (L n)) :: pushs
|
||||
| "Bsta" ->
|
||||
let x::v::is = List.rev pushs in
|
||||
is @ [x; v] @ [Push (L (n-2))]
|
||||
| _ -> List.rev pushs
|
||||
in
|
||||
env, pushr @ pushs @ [Call f; Binop ("+", L (n*4), esp)] @ (List.rev popr)
|
||||
in
|
||||
(if p then env, code else let y, env = env#allocate in env, code @ [Mov (eax, y)])
|
||||
in
|
||||
match scode with
|
||||
| [] -> env, []
|
||||
| instr :: scode' ->
|
||||
|
|
@ -110,6 +139,13 @@ let compile env code =
|
|||
| CONST n ->
|
||||
let s, env' = env#allocate in
|
||||
(env', [Mov (L n, s)])
|
||||
|
||||
| STRING s ->
|
||||
let s, env = env#string s in
|
||||
let l, env = env#allocate in
|
||||
let env, call = call env ".string" 1 false in
|
||||
(env, Mov (M ("$" ^ s), l) :: call)
|
||||
|
||||
| LD x ->
|
||||
let s, env' = (env#global x)#allocate in
|
||||
env',
|
||||
|
|
@ -117,7 +153,15 @@ let compile env code =
|
|||
| S _ | M _ -> [Mov (env'#loc x, eax); Mov (eax, s)]
|
||||
| _ -> [Mov (env'#loc x, s)]
|
||||
)
|
||||
| STA (x, n) -> failwith ""
|
||||
| STA (x, n) ->
|
||||
let s, env = (env#global x)#allocate in
|
||||
let push =
|
||||
match s with
|
||||
| S _ | M _ -> [Mov (env#loc x, eax); Mov (eax, s)]
|
||||
| _ -> [Mov (env#loc x, s)]
|
||||
in
|
||||
let env, code = call env ".sta" (n+2) true in
|
||||
env, push @ code
|
||||
| ST x ->
|
||||
let s, env' = (env#global x)#pop in
|
||||
env',
|
||||
|
|
@ -206,23 +250,7 @@ let compile env code =
|
|||
then let x, env = env#pop in env, [Mov (x, eax); Jmp env#epilogue]
|
||||
else env, [Jmp env#epilogue]
|
||||
|
||||
| CALL (f, n, p) ->
|
||||
let pushr, popr =
|
||||
List.split @@ List.map (fun r -> (Push r, Pop r)) env#live_registers
|
||||
in
|
||||
let env, code =
|
||||
if n = 0
|
||||
then env, pushr @ [Call f] @ (List.rev popr)
|
||||
else
|
||||
let rec push_args env acc = function
|
||||
| 0 -> env, acc
|
||||
| n -> let x, env = env#pop in
|
||||
push_args env ((Push x)::acc) (n-1)
|
||||
in
|
||||
let env, pushs = push_args env [] n in
|
||||
env, pushr @ (List.rev pushs) @ [Call f; Binop ("+", L (n*4), esp)] @ (List.rev popr)
|
||||
in
|
||||
(if p then env, code else let y, env = env#allocate in env, code @ [Mov (eax, y)])
|
||||
| CALL (f, n, p) -> call env f n p
|
||||
in
|
||||
let env'', code'' = compile' env' scode' in
|
||||
env'', code' @ code''
|
||||
|
|
@ -232,12 +260,17 @@ let compile env code =
|
|||
(* A set of strings *)
|
||||
module S = Set.Make (String)
|
||||
|
||||
(* A map indexed by strings *)
|
||||
module M = Map.Make (String)
|
||||
|
||||
(* Environment implementation *)
|
||||
let make_assoc l = List.combine l (List.init (List.length l) (fun x -> x))
|
||||
|
||||
class env =
|
||||
object (self)
|
||||
val globals = S.empty (* a set of global variables *)
|
||||
val stringm = M.empty (* a string map *)
|
||||
val scount = 0 (* string count *)
|
||||
val stack_slots = 0 (* maximal number of stack positions *)
|
||||
val stack = [] (* symbolic stack *)
|
||||
val args = [] (* function arguments *)
|
||||
|
|
@ -276,9 +309,20 @@ class env =
|
|||
(* registers a global variable in the environment *)
|
||||
method global x = {< globals = S.add ("global_" ^ x) globals >}
|
||||
|
||||
(* registers a string constant *)
|
||||
method string x =
|
||||
try M.find x stringm, self
|
||||
with Not_found ->
|
||||
let y = Printf.sprintf "string_%d" scount in
|
||||
let m = M.add x y stringm in
|
||||
y, {< scount = scount + 1; stringm = m>}
|
||||
|
||||
(* gets all global variables *)
|
||||
method globals = S.elements globals
|
||||
|
||||
(* gets all string definitions *)
|
||||
method strings = M.bindings stringm
|
||||
|
||||
(* gets a number of stack positions allocated *)
|
||||
method allocated = stack_slots
|
||||
|
||||
|
|
@ -293,8 +337,13 @@ class env =
|
|||
method lsize = Printf.sprintf "L%s_SIZE" fname
|
||||
|
||||
(* returns a list of live registers *)
|
||||
method live_registers =
|
||||
List.filter (function R _ -> true | _ -> false) stack
|
||||
method live_registers depth =
|
||||
let rec inner d acc = function
|
||||
| [] -> acc
|
||||
| (R _ as r)::tl -> inner (d+1) (if d >= depth then (r::acc) else acc) tl
|
||||
| _::tl -> inner (d+1) acc tl
|
||||
in
|
||||
inner 0 [] stack
|
||||
|
||||
end
|
||||
|
||||
|
|
@ -308,7 +357,8 @@ let genasm (ds, stmt) =
|
|||
(new env)
|
||||
((LABEL "main") :: (BEGIN ("main", [], [])) :: SM.compile (ds, stmt))
|
||||
in
|
||||
let data = Meta "\t.data" :: (List.map (fun s -> Meta (s ^ ":\t.int\t0")) env#globals) in
|
||||
let data = Meta "\t.data" :: (List.map (fun s -> Meta (Printf.sprintf "%s:\t.int\t0" s )) env#globals) @
|
||||
(List.map (fun (s, v) -> Meta (Printf.sprintf "%s:\t.string\t\"%s\"" v s)) env#strings) in
|
||||
let asm = Buffer.create 1024 in
|
||||
List.iter
|
||||
(fun i -> Buffer.add_string asm (Printf.sprintf "%s\n" @@ show i))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue