mirror of
https://github.com/ProgramSnail/Lama.git
synced 2025-12-06 06:48:48 +00:00
Intermediate; pattern matching in x86
This commit is contained in:
Dmitry Boulytchev
parent
34767b9dcb
commit
1f1ef2ce57
7 changed files with 184 additions and 303 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,23 +0,0 @@
|
|||
fun append (x, y) {
|
||||
case x of
|
||||
`nil -> return y
|
||||
| `cons (h, t) -> return `cons (h, append (t, y))
|
||||
esac
|
||||
}
|
||||
|
||||
fun printList (x) {
|
||||
case x of
|
||||
`nil -> skip
|
||||
| `cons (h, t) -> write (h); printList (t)
|
||||
esac
|
||||
}
|
||||
|
||||
n := read ();
|
||||
|
||||
x := `cons (1, `cons (2, `nil));
|
||||
y := `cons (3, `cons (4, `nil));
|
||||
|
||||
printList (x);
|
||||
printList (y);
|
||||
printList (append (x, y));
|
||||
printList (append (y, x))
|
||||
|
|
@ -1,31 +0,0 @@
|
|||
fun insert (t, x) {
|
||||
case t of
|
||||
`leaf -> return `node (x, `leaf, `leaf)
|
||||
| `node (y, l, r) -> if x > y
|
||||
then return `node (y, insert (l, x), r)
|
||||
else return `node (y, l, insert (r, x))
|
||||
fi
|
||||
esac
|
||||
}
|
||||
|
||||
fun find (t, x) {
|
||||
case t of
|
||||
`leaf -> return 0
|
||||
| `node (y, l, r) -> if x == y then return 1
|
||||
elif x > y then return find (l, x)
|
||||
else return find (r, x)
|
||||
fi
|
||||
esac
|
||||
}
|
||||
|
||||
n := read ();
|
||||
|
||||
t := insert (insert (insert (insert (`leaf, 5), 4), 6), 3);
|
||||
|
||||
write (find (t, 5));
|
||||
write (find (t, 4));
|
||||
write (find (t, 6));
|
||||
write (find (t, 3));
|
||||
write (find (t, 2));
|
||||
write (find (t, 1))
|
||||
|
||||
|
|
@ -8,19 +8,25 @@
|
|||
# include <alloca.h>
|
||||
|
||||
# define STRING_TAG 0x00000000
|
||||
# define ARRAYU_TAG 0x01000000
|
||||
# define ARRAYB_TAG 0x02000000
|
||||
# define ARRAY_TAG 0x01000000
|
||||
# define SEXP_TAG 0x02000000
|
||||
|
||||
# define LEN(x) (x & 0x00FFFFFF)
|
||||
# define TAG(x) (x & 0xFF000000)
|
||||
|
||||
# define TO_DATA(x) ((data*)((char*)(x)-sizeof(int)))
|
||||
# define TO_SEXP(x) ((sexp*)((char*)(x)-2*sizeof(int)))
|
||||
|
||||
typedef struct {
|
||||
int tag;
|
||||
char contents[0];
|
||||
} data;
|
||||
|
||||
typedef struct {
|
||||
int tag;
|
||||
data contents;
|
||||
} sexp;
|
||||
|
||||
extern int Blength (void *p) {
|
||||
data *a = TO_DATA(p);
|
||||
return LEN(a->tag);
|
||||
|
|
@ -30,7 +36,9 @@ extern void* Belem (void *p, int i) {
|
|||
data *a = TO_DATA(p);
|
||||
|
||||
if (TAG(a->tag) == STRING_TAG) return (void*)(int)(a->contents[i]);
|
||||
|
||||
|
||||
//printf ("elem %d = %p\n", i, (void*) ((int*) a->contents)[i]);
|
||||
|
||||
return (void*) ((int*) a->contents)[i];
|
||||
}
|
||||
|
||||
|
|
@ -49,7 +57,7 @@ extern void* Barray (int n, ...) {
|
|||
int i;
|
||||
data *r = (data*) malloc (sizeof(int) * (n+1));
|
||||
|
||||
r->tag = ARRAYB_TAG | n; //(boxed ? ARRAYB_TAG : ARRAYU_TAG) | size;
|
||||
r->tag = ARRAY_TAG | n;
|
||||
|
||||
va_start(args, n);
|
||||
|
||||
|
|
@ -63,6 +71,36 @@ extern void* Barray (int n, ...) {
|
|||
return r->contents;
|
||||
}
|
||||
|
||||
extern void* Bsexp (int n, ...) {
|
||||
va_list args;
|
||||
int i;
|
||||
sexp *r = (sexp*) malloc (sizeof(int) * (n+2));
|
||||
data *d = &(r->contents);
|
||||
|
||||
d->tag = SEXP_TAG | (n-1);
|
||||
|
||||
va_start(args, n);
|
||||
|
||||
for (i=0; i<n-1; i++) {
|
||||
int ai = va_arg(args, int);
|
||||
//printf ("arg %d = %x\n", i, ai);
|
||||
((int*)d->contents)[i] = ai;
|
||||
}
|
||||
|
||||
r->tag = va_arg(args, int);
|
||||
va_end(args);
|
||||
|
||||
//printf ("tag %d\n", r->tag);
|
||||
//printf ("returning %p\n", d->contents);
|
||||
|
||||
return d->contents;
|
||||
}
|
||||
|
||||
extern int Btag (void *d, int t) {
|
||||
data *r = TO_DATA(d);
|
||||
return TAG(r->tag) == SEXP_TAG && TO_SEXP(d)->tag == t;
|
||||
}
|
||||
|
||||
extern void Bsta (int n, int v, void *s, ...) {
|
||||
va_list args;
|
||||
int i, k;
|
||||
|
|
@ -82,227 +120,30 @@ extern void Bsta (int n, int v, void *s, ...) {
|
|||
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);
|
||||
void Lprintf (char *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_start (args, s);
|
||||
vprintf (s, args);
|
||||
va_end (args);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
extern void* Lfread (char *fname) {
|
||||
data *result;
|
||||
int size;
|
||||
FILE * file;
|
||||
int n = Lstrlen ((void*)fname);
|
||||
void Lfprintf (FILE *f, char *s, ...) {
|
||||
va_list args;
|
||||
|
||||
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;
|
||||
va_start (args, s);
|
||||
vfprintf (f, s, args);
|
||||
va_end (args);
|
||||
}
|
||||
|
||||
// New one
|
||||
*/
|
||||
FILE* Lfopen (char *f, char *m) {
|
||||
return fopen (f, m);
|
||||
}
|
||||
|
||||
void Lfclose (FILE *f) {
|
||||
fclose (f);
|
||||
}
|
||||
|
||||
/* Lread is an implementation of the "read" construct */
|
||||
extern int Lread () {
|
||||
int result;
|
||||
|
|
|
|||
|
|
@ -231,7 +231,7 @@ module Expr =
|
|||
!(Ostap.Util.expr
|
||||
(fun x -> x)
|
||||
(Array.map (fun (a, s) -> a,
|
||||
List.map (fun s -> ostap(- $(s)), (fun x y -> Binop (s, x, y))) s
|
||||
List.map (fun s -> ostap(- $(s)), (fun x y -> Binop (s, x, y))) s
|
||||
)
|
||||
[|
|
||||
`Lefta, ["!!"];
|
||||
|
|
|
|||
|
|
@ -222,7 +222,7 @@ let compile (defs, p) =
|
|||
|
||||
| Stmt.Case (e, brs) ->
|
||||
let n = List.length brs - 1 in
|
||||
let ldrop, env = env#get_label in
|
||||
(*let ldrop, env = env#get_label in*)
|
||||
let env, _, _, code =
|
||||
List.fold_left
|
||||
(fun (env, lab, i, code) (p, s) ->
|
||||
|
|
@ -232,12 +232,12 @@ let compile (defs, p) =
|
|||
else env#get_label, [JMP l]
|
||||
in
|
||||
let env, _, pcode = pattern env lfalse p in
|
||||
let env, _, scode = compile_stmt ldrop env (Stmt.Seq (s, Stmt.Leave)) in
|
||||
let env, _, scode = compile_stmt l(*ldrop*) env (Stmt.Seq (s, Stmt.Leave)) in
|
||||
(env, Some lfalse, i+1, ((match lab with None -> [] | Some l -> [LABEL l; DUP]) @ pcode @ bindings p @ scode @ jmp) :: code)
|
||||
)
|
||||
(env, None, 0, []) brs
|
||||
in
|
||||
env, true, expr e @ [DUP] @ (List.flatten @@ List.rev code) @ [JMP l; LABEL ldrop; DROP]
|
||||
env, true, expr e @ [DUP] @ (List.flatten @@ List.rev code) @ [JMP l] (*; LABEL ldrop; DROP]*)
|
||||
in
|
||||
let compile_def env (name, (args, locals, stmt)) =
|
||||
let lend, env = env#get_label in
|
||||
|
|
|
|||
150
src/X86.ml
150
src/X86.ml
|
|
@ -1,3 +1,5 @@
|
|||
open GT
|
||||
|
||||
(* X86 codegeneration interface *)
|
||||
|
||||
(* The registers: *)
|
||||
|
|
@ -7,14 +9,15 @@ let regs = [|"%ebx"; "%ecx"; "%esi"; "%edi"; "%eax"; "%edx"; "%ebp"; "%esp"|]
|
|||
let num_of_regs = Array.length regs - 5
|
||||
|
||||
(* We need to know the word size to calculate offsets correctly *)
|
||||
let word_size = 4
|
||||
let word_size = 4;;
|
||||
|
||||
(* We need to distinguish the following operand types: *)
|
||||
type opnd =
|
||||
@type opnd =
|
||||
| R of int (* hard register *)
|
||||
| S of int (* a position on the hardware stack *)
|
||||
| M of string (* a named memory location *)
|
||||
| L of int (* an immediate operand *)
|
||||
with show
|
||||
|
||||
(* For convenience we define the following synonyms for the registers: *)
|
||||
let ebx = R 0
|
||||
|
|
@ -91,6 +94,8 @@ open SM
|
|||
of x86 instructions
|
||||
*)
|
||||
let compile env code =
|
||||
SM.print_prg code;
|
||||
flush stdout;
|
||||
let suffix = function
|
||||
| "<" -> "l"
|
||||
| "<=" -> "le"
|
||||
|
|
@ -102,6 +107,7 @@ let compile env code =
|
|||
in
|
||||
let rec compile' env scode =
|
||||
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 call env f n p =
|
||||
let f =
|
||||
match f.[0] with '.' -> "B" ^ String.sub f 1 (String.length f - 1) | _ -> f
|
||||
|
|
@ -121,19 +127,21 @@ let compile env code =
|
|||
let env, pushs = push_args env [] n in
|
||||
let pushs =
|
||||
match f with
|
||||
| "Barray" -> List.rev @@ (Push (L n)) :: pushs
|
||||
| "Barray" -> List.rev @@ (Push (L n)) :: pushs
|
||||
| "Bsexp" -> List.rev @@ (Push (L n)) :: pushs
|
||||
| "Bsta" ->
|
||||
let x::v::is = List.rev pushs in
|
||||
is @ [x; v] @ [Push (L (n-2))]
|
||||
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)
|
||||
env, pushr @ pushs @ [Call f; Binop ("+", L (4 * List.length pushs), 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' ->
|
||||
let stack = env#show_stack in
|
||||
let env', code' =
|
||||
match instr with
|
||||
| CONST n ->
|
||||
|
|
@ -152,7 +160,8 @@ let compile env code =
|
|||
(match s with
|
||||
| S _ | M _ -> [Mov (env'#loc x, eax); Mov (eax, s)]
|
||||
| _ -> [Mov (env'#loc x, s)]
|
||||
)
|
||||
)
|
||||
|
||||
| STA (x, n) ->
|
||||
let s, env = (env#global x)#allocate in
|
||||
let push =
|
||||
|
|
@ -162,6 +171,7 @@ let compile env code =
|
|||
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',
|
||||
|
|
@ -169,6 +179,7 @@ let compile env code =
|
|||
| S _ | M _ -> [Mov (s, eax); Mov (eax, env'#loc x)]
|
||||
| _ -> [Mov (s, env'#loc x)]
|
||||
)
|
||||
|
||||
| BINOP op ->
|
||||
let x, y, env' = env#pop2 in
|
||||
env'#push y,
|
||||
|
|
@ -227,11 +238,13 @@ let compile env code =
|
|||
then [Mov (x, eax); Binop (op, eax, y)]
|
||||
else [Binop (op, x, y)]
|
||||
)
|
||||
| LABEL s -> env, [Label s]
|
||||
| JMP l -> env, [Jmp l]
|
||||
| LABEL s -> (if env#is_barrier then (env#drop_barrier)#retrieve_stack s else env), [Label s]
|
||||
|
||||
| JMP l -> (env#set_stack l)#set_barrier, [Jmp l]
|
||||
|
||||
| CJMP (s, l) ->
|
||||
let x, env = env#pop in
|
||||
env, [Binop ("cmp", L 0, x); CJmp (s, l)]
|
||||
env#set_stack l, [Binop ("cmp", L 0, x); CJmp (s, l)]
|
||||
|
||||
| BEGIN (f, a, l) ->
|
||||
let env = env#enter f a l in
|
||||
|
|
@ -251,49 +264,104 @@ let compile env code =
|
|||
else env, [Jmp env#epilogue]
|
||||
|
||||
| CALL (f, n, p) -> call env f n p
|
||||
(*
|
||||
|
||||
| SEXP (t, n) ->
|
||||
let s, env = env#allocate in
|
||||
let env, code = call env ".sexp" (n+1) false in
|
||||
env, [Mov (L env#hash t, s)] @ code
|
||||
|
||||
| DROP -> snd env#pop, []
|
||||
| DUP -> let x = env#peek in
|
||||
let s, env = env#allocate in
|
||||
env, [Mov (x, s)]
|
||||
| SWAP -> let x, y = env#peek2 in
|
||||
env, [Push x; Push y; Pop x; Pop y]
|
||||
|
||||
| TAG t
|
||||
| ENTER xs
|
||||
| LEAVE *)
|
||||
|
||||
| DUP ->
|
||||
let x = env#peek in
|
||||
let s, env = env#allocate in
|
||||
env, mov x s
|
||||
|
||||
| SWAP ->
|
||||
let x, y = env#peek2 in
|
||||
env, [Push x; Push y; Pop x; Pop y]
|
||||
|
||||
| TAG t ->
|
||||
let s, env = env#allocate in
|
||||
let env, code = call env ".tag" 2 false in
|
||||
env, [Mov (L env#hash t, s)] @ code
|
||||
|
||||
| ENTER xs ->
|
||||
let env, code =
|
||||
List.fold_left
|
||||
(fun (env, code) v ->
|
||||
let s, env = env#pop in
|
||||
env, (mov s @@ env#loc v) :: code
|
||||
)
|
||||
(env#scope @@ List.rev xs, []) xs
|
||||
in
|
||||
env, List.flatten @@ List.rev code
|
||||
|
||||
| LEAVE -> env#unscope, []
|
||||
in
|
||||
let env'', code'' = compile' env' scode' in
|
||||
env'', code' @ code''
|
||||
env'', [Meta (Printf.sprintf "# %s / % s" (GT.show(SM.insn) instr) stack)] @ code' @ code''
|
||||
in
|
||||
compile' env code
|
||||
|
||||
(* A set of strings *)
|
||||
module S = Set.Make (String)
|
||||
module S = Set.Make (String)
|
||||
|
||||
(* A map indexed by strings *)
|
||||
module M = Map.Make (String)
|
||||
module M = Map.Make (String)
|
||||
|
||||
(* Environment implementation *)
|
||||
let make_assoc l = List.combine l (List.init (List.length l) (fun x -> x))
|
||||
|
||||
class env =
|
||||
let chars = "_abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNJPQRSTUVWXYZ" in
|
||||
let make_assoc l i = List.combine l (List.init (List.length l) (fun x -> x + i)) in
|
||||
let rec assoc x = function [] -> raise Not_found | l :: ls -> try List.assoc x l with Not_found -> assoc x ls in
|
||||
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 static_size = 0 (* static data size *)
|
||||
val stack = [] (* symbolic stack *)
|
||||
val args = [] (* function arguments *)
|
||||
val locals = [] (* function local variables *)
|
||||
val fname = "" (* function name *)
|
||||
val stackmap = M.empty (* labels to stack map *)
|
||||
val barrier = false (* barrier condition *)
|
||||
|
||||
method show_stack =
|
||||
GT.show(list) (GT.show(opnd)) stack
|
||||
|
||||
method print_locals =
|
||||
Printf.printf "LOCALS: size = %d\n" static_size;
|
||||
List.iter
|
||||
(fun l ->
|
||||
Printf.printf "(";
|
||||
List.iter (fun (a, i) -> Printf.printf "%s=%d " a i) l;
|
||||
Printf.printf ")\n"
|
||||
) locals;
|
||||
Printf.printf "END LOCALS\n"
|
||||
|
||||
(* check barrier condition *)
|
||||
method is_barrier = barrier
|
||||
|
||||
(* set barrier *)
|
||||
method set_barrier = {< barrier = true >}
|
||||
|
||||
(* drop barrier *)
|
||||
method drop_barrier = {< barrier = false >}
|
||||
|
||||
(* associates a stack to a label *)
|
||||
method set_stack l = Printf.printf "Setting stack for %s\n" l; {< stackmap = M.add l stack stackmap >}
|
||||
|
||||
(* retrieves a stack for a label *)
|
||||
method retrieve_stack l = Printf.printf "Retrieving stack for %s\n" l;
|
||||
try {< stack = M.find l stackmap >} with Not_found -> self
|
||||
|
||||
(* gets a name for a global variable *)
|
||||
method loc x =
|
||||
try S (- (List.assoc x args) - 1)
|
||||
with Not_found ->
|
||||
try S (List.assoc x locals) with Not_found -> M ("global_" ^ x)
|
||||
try S (assoc x locals) with Not_found -> M ("global_" ^ x)
|
||||
|
||||
(* allocates a fresh position on a symbolic stack *)
|
||||
method allocate =
|
||||
|
|
@ -302,7 +370,7 @@ class env =
|
|||
| [] -> ebx , 0
|
||||
| (S n)::_ -> S (n+1) , n+2
|
||||
| (R n)::_ when n < num_of_regs -> R (n+1) , stack_slots
|
||||
| _ -> S stack_slots, stack_slots+1
|
||||
| _ -> S static_size, static_size+1
|
||||
in
|
||||
allocate' stack
|
||||
in
|
||||
|
|
@ -317,6 +385,20 @@ class env =
|
|||
(* pops two operands from the symbolic stack *)
|
||||
method pop2 = let x::y::stack' = stack in x, y, {< stack = stack' >}
|
||||
|
||||
(* peeks the top of the stack (the stack does not change) *)
|
||||
method peek = List.hd stack
|
||||
|
||||
(* peeks two topmost values from the stack (the stack itself does not change) *)
|
||||
method peek2 = let x::y::_ = stack in x, y
|
||||
|
||||
(* tag hash: gets a hash for a string tag *)
|
||||
method hash tag =
|
||||
let h = ref 0 in
|
||||
for i = 0 to min (String.length tag - 1) 4 do
|
||||
h := (!h lsl 6) lor (String.index chars tag.[i])
|
||||
done;
|
||||
!h
|
||||
|
||||
(* registers a global variable in the environment *)
|
||||
method global x = {< globals = S.add ("global_" ^ x) globals >}
|
||||
|
||||
|
|
@ -339,8 +421,20 @@ class env =
|
|||
|
||||
(* enters a function *)
|
||||
method enter f a l =
|
||||
{< stack_slots = List.length l; stack = []; locals = make_assoc l; args = make_assoc a; fname = f >}
|
||||
let n = List.length l in
|
||||
{< static_size = n; stack_slots = n; stack = []; locals = [make_assoc l 0]; args = make_assoc a 0; fname = f >}
|
||||
|
||||
(* enters a scope *)
|
||||
method scope vars =
|
||||
let n = List.length vars in
|
||||
let static_size' = n + static_size in
|
||||
{< stack_slots = max stack_slots static_size'; static_size = static_size'; locals = (make_assoc vars static_size) :: locals >}
|
||||
|
||||
(* leaves a scope *)
|
||||
method unscope =
|
||||
let n = List.length (List.hd locals) in
|
||||
{< static_size = static_size - n; locals = List.tl locals >}
|
||||
|
||||
(* returns a label for the epilogue *)
|
||||
method epilogue = Printf.sprintf "L%s_epilogue" fname
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue