Commit a9f0c3a6 authored by Laszlo Domoszlai's avatar Laszlo Domoszlai
Browse files

+ set in VarEntry whether its strict and use this to avoid unnecessary "eval"s

+ "eval" where cannot be avoided
parent 6ef36f0b
......@@ -92,8 +92,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
if(slice->type == FT_PRIM)
{
for (int i = 0; i < basethunk->desc->arity; i++) {
// TODO: eval
push_a(basethunk->_args[i]);
push_a(eval(basethunk->_args[i]));
}
for (int i = 0; i < expr->nr_args; i++) {
......@@ -110,13 +109,28 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
int new_frame_ptr = stack_top_a;
for (int i = 0; i < basethunk->desc->arity; i++) {
// TODO: eval
push_a(basethunk->_args[i]);
if(is_strict_fun_arg((FunEntry*) slice, i))
{
push_a(eval(basethunk->_args[i]));
}
else
{
push_a(basethunk->_args[i]);
}
}
for (int i = 0; i < expr->nr_args; i++) {
// TODO: eval
push_a(create_thunk(((AppEntry*) expr)->args[i], frame_ptr));
if(is_strict_fun_arg((FunEntry*) slice, basethunk->desc->arity + i))
{
push_a(NULL);
exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
}
else
{
push_a(create_thunk(((AppEntry*) expr)->args[i], frame_ptr));
}
}
expr = ((FunEntry*) slice)->body;
......@@ -200,7 +214,16 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
case CT_VAR:
if (expr->local_type == VAR_LOCAL) {
Thunk* thunk = local(frame_ptr, ((VarEntry*) expr)->index);
if(((VarEntry*) expr)->base.strict)
{
assert(is_hnf(thunk));
set_return(root_frame_ptr, thunk);
destroy_stack_frame(root_frame_ptr);
return;
}
while (thunk->desc == (Desc*) __FORWARD_PTR__) {
thunk = thunk->_forward_ptr;
}
......@@ -217,8 +240,15 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
// Here frame_ptr == root_frame_ptr
for (int i = 0; i < thunk->desc->arity; i++) {
// TODO: handle strictness
push_a(thunk->_args[i]);
if(is_strict_fun_arg((FunEntry*) thunk->desc, i))
{
push_a(eval(thunk->_args[i]));
}
else
{
push_a(thunk->_args[i]);
}
}
expr = ((FunEntry*) thunk->desc)->body;
......@@ -227,8 +257,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
else if(thunk->desc->type == FT_PRIM) {
for (int i = 0; i < thunk->desc->arity; i++) {
// TODO: handle strictness
push_a(thunk->_args[i]);
push_a(eval(thunk->_args[i]));
}
((PrimEntry*) thunk->desc)->exec(root_frame_ptr);
......@@ -261,7 +290,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
{
push_a(NULL);
exec(((SelectEntry*) expr)->expr, frame_ptr, stack_top_a);
Thunk* pattern = eval(pop_a());
Thunk* pattern = pop_a();
assert(is_hnf(pattern));
assert(pattern->desc->type == FT_ADT);
......@@ -304,7 +333,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
push_a(&tmp);
exec(((IfEntry*) expr)->cond, frame_ptr, stack_top_a);
Thunk* cond = eval(pop_a());
Thunk* cond = pop_a();
if (readB(cond)) {
expr = ((IfEntry*) expr)->texpr;
......
......@@ -12,8 +12,9 @@
struct Code {
unsigned int type : 3;
unsigned int local_type : 3;
unsigned int nr_args : 5; // used in AppEntry
unsigned int nr_cases : 5; // used in SelectEntry
unsigned int nr_args : 5; // used in AppEntry
unsigned int nr_cases : 5; // used in SelectEntry
unsigned int strict : 1; // used in VarEntry
};
#define LIT_INT 1
......
#ifndef DEBUG_H
#define DEBUG_H
#define DEBUG
// Adjoxo: 2200
//#define DEBUG
#define BENCHMARK
#ifndef DEBUG
#define NDEBUG
......
......@@ -29,7 +29,7 @@ int main ( int argc, char *argv[] )
init_desc();
init_prim();
char* input = "..\\tests\\Braun.bsapl";
char* input = "..\\tests\\fib.bsapl";
if ( argc == 2 )
{
......@@ -79,27 +79,29 @@ int main ( int argc, char *argv[] )
Code* expr = parseTerm(&exprstream);
#ifdef DEBUG
#ifdef BENCHMARK
struct timeval t1, t2;
gettimeofday(&t1, NULL);
#endif
push_a(NULL);
exec(expr, stack_top_a, stack_top_a);
Thunk* res = eval(pop_a());
Thunk* res = pop_a();
#ifdef DEBUG
#ifdef BENCHMARK
gettimeofday(&t2, NULL);
#endif
#endif
print(res, true);
#ifdef DEBUG
#ifdef BENCHMARK
// compute and print the elapsed time in millisec
double elapsedTime = (t2.tv_sec - t1.tv_sec) * 1000.0; // sec to ms
elapsedTime += (t2.tv_usec - t1.tv_usec) / 1000.0; // us to ms
elapsedTime += (t2.tv_usec - t1.tv_usec) / 1000.0; // us to ms
printf("\n\nexecution time: %G ms\n", elapsedTime);
#endif
#ifdef DEBUG
print_stat();
#endif
......
......@@ -15,12 +15,12 @@ extern Thunk stack_b[STACK_SIZE_B];
#define pop_a() stack_a[--stack_top_a]
#define push_a(r) stack_a[stack_top_a++]=(r)
#define local(base, idx) stack_a[base+idx-1]
#define local(base, idx) stack_a[base+idx]
#define set_return(base, r) stack_a[base-1]=(r)
#define destroy_stack_frame(base) stack_top_a = base
#define get_dst(base) stack_a[base-1]
#define alloc_b(nr) stack_top_b+=nr
#define alloc_b() &stack_b[stack_top_b++]
#define destroy_stack_frame_b(base) stack_top_b = base
......
......@@ -277,8 +277,10 @@ VarEntry* parseVar(char **ptr, VarEntry* target) {
switch (type) {
case 'L': // Local var
case 'S': // Strict local var
{
entry->base.local_type = VAR_LOCAL;
entry->base.strict = type == 'S';
if (!parseInt(ptr, &entry->index)) return 0;
break;
}
......
......@@ -39,50 +39,50 @@ int thunk_size(Thunk* thunk) {
}
}
struct Thunk* updateI(Thunk* target, int i) {
if (target == NULL) target = (Thunk*) alloc_heap(sizeof (Thunk));
// always can be overwritten with boxed integer
target->desc = (Desc*) __INT__;
target->_int = i;
return target;
}
#ifdef DEBUG
int readI(Thunk* thunk) {
assert(thunk != NULL);
#ifdef DEBUG
if (thunk->desc != (Desc*) __INT__) {
printf("readI: not an integer\n");
printf("readI: not an integer: ");
printDesc(thunk->desc);
exit(-1);
}
#endif
return thunk->_int;
}
struct Thunk* updateB(Thunk* target, int b) {
if (target == NULL) target = (Thunk*) alloc_heap(sizeof (Thunk));
// always can be overwritten with boxed integer
target->desc = (Desc*) __BOOL__;
target->_bool = b;
return target;
}
int readB(Thunk* thunk) {
assert(thunk != NULL);
#ifdef DEBUG
if (thunk->desc != (Desc*) __BOOL__) {
printf("readB: not a boolean\n");
printf("readB: not a boolean: ");
printDesc(thunk->desc);
exit(-1);
}
#endif
return thunk->_bool;
}
#endif
struct Thunk* updateI(Thunk* target, int i) {
if (target == NULL) target = (Thunk*) alloc_heap(sizeof (Thunk));
// always can be overwritten with boxed integer
target->desc = (Desc*) __INT__;
target->_int = i;
return target;
}
struct Thunk* updateB(Thunk* target, int b) {
if (target == NULL) target = (Thunk*) alloc_heap(sizeof (Thunk));
// always can be overwritten with boxed integer
target->desc = (Desc*) __BOOL__;
target->_bool = b;
return target;
}
struct Thunk* updateT(Thunk* target, Thunk* source) {
if (target == NULL) target = (Thunk*) alloc_heap(sizeof (Thunk));
......@@ -130,8 +130,14 @@ struct Thunk* eval(Thunk* thunk) {
int frame_ptr = stack_top_a;
for (int i = 0; i < thunk->desc->arity; i++) {
// TODO: handle strictness
push_a(thunk->_args[i]);
if(is_strict_fun_arg((FunEntry*) thunk->desc, i))
{
push_a(eval(thunk->_args[i]));
}
else
{
push_a(thunk->_args[i]);
}
}
exec(((FunEntry*) thunk->desc)->body, frame_ptr, frame_ptr);
thunk = pop_a();
......@@ -141,7 +147,7 @@ struct Thunk* eval(Thunk* thunk) {
int frame_ptr = stack_top_a;
for (int i = 0; i < thunk->desc->arity; i++) {
push_a(thunk->_args[i]);
push_a(eval(thunk->_args[i]));
}
((PrimEntry*) thunk->desc)->exec(frame_ptr);
......
......@@ -29,14 +29,21 @@ typedef struct __attribute__((packed)) Thunk {
Thunk* forward_to(Thunk* target, Thunk* thunk);
struct Thunk* updateI(Thunk* target, int i);
int readI(Thunk* thunk);
#ifdef DEBUG
struct Thunk* updateB(Thunk* target, int b);
int readI(Thunk* thunk);
int readB(Thunk* thunk);
struct Thunk* updateT(Thunk* target, Thunk* source);
#else
#define readI(thunk) thunk->_int
#define readB(thunk) thunk->_bool
#endif
struct Thunk* updateI(Thunk* target, int i);
struct Thunk* updateB(Thunk* target, int b);
struct Thunk* updateT(Thunk* target, Thunk* source);
struct Thunk* updateF(Thunk* target, Desc* f);
bool is_hnf(Thunk* thunk);
......
......@@ -14,7 +14,7 @@ from Text.Unicode.UChar import instance toChar UChar
import System.CommandLine
import System.File
:: VarType = Local Int | Fun String
:: VarType = Local Int Bool | Fun String
:: Context = { vars :: Map String VarType
, localcount :: Int
......@@ -22,15 +22,18 @@ import System.File
newContext = {vars = newMap, localcount = 0}
registerArgs vars idx [] = vars
registerArgs vars idx [v:vs] = registerArgs (put (unpackVar v) (Local idx (isStrictVar v)) vars) (idx + 1) vs
registerLocals vars idx [] = vars
registerLocals vars idx [v:vs] = registerLocals (put (unpackVar v) (Local (idx+1)) vars) (idx + 1) vs
registerLocals vars idx [v:vs] = registerLocals (put (unpackVar v) (Local idx (isStrictVar v)) vars) (idx + 1) vs
calcStrictness [] = 0
calcStrictness [StrictVar _ _:vs] = (1 << (length vs)) + calcStrictness vs
calcStrictness [NormalVar _ _:vs] = calcStrictness vs
sFunc ctx (FTFunc name body params) a
# ctx = {ctx & vars = registerLocals ctx.vars 0 params, localcount = length params}
# ctx = {ctx & vars = registerArgs ctx.vars 0 params, localcount = length params}
= a <++ "F" <++ sText (unpackVar name) <++ sNum (length params) <++ sNum (calcStrictness params) <++ sTerm ctx body
sFunc ctx (FTCAF name body) a
......@@ -69,8 +72,9 @@ sSelectCase ctx (PDefault, expr) a
sVar ctx var a
= case get varName ctx.vars of
(Just (Local i)) = a <++ "L" <++ sNum i
_ = a <++ "F" <++ sText varName
(Just (Local i True)) = a <++ "S" <++ sNum i
(Just (Local i False)) = a <++ "L" <++ sNum i
_ = a <++ "F" <++ sText varName
where
varName = unpackVar var
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment