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

a handful of bugfixes

parent 8faff8cc
......@@ -166,9 +166,9 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
if(heap_curr > gc_trigger) gc();
int root_frame_ptr_b = stack_top_b;
while(1)
{
{
assert(expr != NULL);
assert(stack_top_a < STACK_SIZE_A);
assert(stack_top_b < STACK_SIZE_B);
......@@ -178,7 +178,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
switch (expr->type) {
case CT_APP_PRIM_FAST:
{
{
// careful, "exec" may trigger garbage collection
// read local variables only after the last exec
switch(expr->arg_pattern)
......@@ -238,7 +238,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
Thunk* tmp = (Thunk*) alloc_heap(sizeof(Thunk));
set_return(root_frame_ptr, tmp);
}
((PrimEntry*) ((AppEntry*) expr)->f)->exec(root_frame_ptr);
destroy_stack_frame(root_frame_ptr);
......@@ -249,7 +249,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
{
PrimEntry* desc = (PrimEntry*) ((AppEntry*) expr)->f;
int argmask = 1;
for (int i = 0; i < desc->base.arity; i++) {
if(desc->boxingMap & argmask)
......@@ -270,7 +270,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
Thunk* tmp = (Thunk*) alloc_heap(sizeof(Thunk));
set_return(root_frame_ptr, tmp);
}
desc->exec(root_frame_ptr);
destroy_stack_frame(root_frame_ptr);
......@@ -291,7 +291,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
case CT_APP_FUN2:
{
Desc* slice = ((AppEntry*) expr)->f;
int argmask = 1;
arg_from_code(slice, ((AppEntry*) expr)->args[0]);
......@@ -304,7 +304,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
case CT_APP_FUN:
{
Desc* slice = ((AppEntry*) expr)->f;
int new_frame_ptr = stack_top_a;
int argmask = 1;
......@@ -319,7 +319,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
case CT_APP_FUN_TR:
{
Desc* slice = ((AppEntry*) expr)->f;
// TODO: B stack?
int new_frame_ptr = stack_top_a;
int argmask = 1;
......@@ -522,8 +522,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
not_implemented("CAF");
}
}
case CT_VAR_STRICT:
case CT_VAR_UNBOXED:
case CT_VAR_UNBOXED:
{
Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);
follow_thunk(arg);
......@@ -531,7 +530,38 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
assert(is_hnf(arg));
// no need to check for array length, thunks in HNF are never overwritten
if(get_dst(root_frame_ptr) != NULL && arg->desc->thunk_size <= sizeof(Thunk))
if(get_dst(root_frame_ptr) != NULL)
{
memcpy(get_dst(root_frame_ptr), arg, sizeof(Thunk));
}
else
{
if(instackb(arg))
{
Thunk* newthunk = (Thunk*) alloc_heap(sizeof (Thunk));
memcpy(newthunk, arg, sizeof(Thunk));
set_return(root_frame_ptr, newthunk);
}
else
{
set_return(root_frame_ptr, arg);
}
}
destroy_stack_frame(root_frame_ptr);
destroy_stack_frame_b(root_frame_ptr_b);
return;
}
case CT_VAR_STRICT:
{
Thunk* arg = local(frame_ptr, ((VarEntry*) expr)->index);
follow_thunk(arg);
assert(is_hnf(arg));
// no need to check for array length, thunks in HNF are never overwritten
// arrays always referenced
if(get_dst(root_frame_ptr) != NULL && arg->desc->thunk_size <= sizeof(Thunk) && arg->desc != (Desc*) __ARRAY__)
{
memcpy(get_dst(root_frame_ptr), arg, sizeof(Thunk));
}
......@@ -548,7 +578,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
case CT_VAR:
{
Thunk* thunk = local(frame_ptr, ((VarEntry*) expr)->index);
assert(!instackb(thunk));
follow_thunk(thunk);
......@@ -583,11 +613,9 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
}
case FT_PRIM:
{
int argmask = 1;
for (int i = 0; i < thunk->desc->arity; i++) {
push_a(thunk->_args[i]);
if(((PrimEntry*)thunk->desc)->boxingMap & argmask) thunk->_args[i]->desc->eval();
thunk->_args[i]->desc->eval();
thunk = stack_a[root_frame_ptr-1];
}
......@@ -741,7 +769,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
push_a(NULL);
exec(select->expr, frame_ptr, stack_top_a);
Thunk* cons = pop_a();
expr = select->bodies[((ADTEntry*)cons->desc)->idx];
if(expr != NULL)
......
......@@ -549,7 +549,7 @@ void __array_create2_b_r(int dst_idx)
set_return(dst_idx, target);
}
void __string_update(int dst_idx)
void __string_update_copy(int dst_idx)
{
Thunk* target = get_dst(dst_idx);
Thunk* str = arg(3);
......@@ -577,6 +577,16 @@ void __string_update(int dst_idx)
set_return(dst_idx, target);
}
void __string_update(int dst_idx)
{
Thunk* arr = arg(3);
Thunk* idx = arg(2);
Thunk* elem = arg(1);
arr->_array._chars[idx->_int] = (char) elem->_int;
set_return(dst_idx, arr);
}
void __array_update(int dst_idx)
{
......@@ -816,7 +826,7 @@ void __I2S(int dst_idx) {
int len = strlen(buff);
target = string_create(target, len);
memcpy(target->_string_ptr->chars, buff, len);
memcpy(&target->_array._chars, buff, len);
set_return(dst_idx, target);
}
......@@ -829,7 +839,7 @@ void __R2S(int dst_idx) {
int len = strlen(buff);
target = string_create(target, len);
memcpy(target->_string_ptr->chars, buff, len);
memcpy(target->_array._chars, buff, len);
set_return(dst_idx, target);
}
......@@ -932,11 +942,11 @@ void init_prim() {
add_prim(1, 0b001, 1, "C2I", &__C2I);
add_prim(1, 0b001, 1, "R2I", &__R2I);
add_prim(1, 0b001, 1, "S2I", &__S2I);
add_prim(1, 0b000, 1, "S2I", &__S2I);
add_prim(1, 0b001, 1, "I2C", &__I2C);
add_prim(1, 0b001, 1, "I2R", &__I2R);
add_prim(1, 0b001, 1, "R2R", &__R2R);
add_prim(1, 0b000, 0, "S2R", &__S2R);
add_prim(1, 0b000, 1, "S2R", &__S2R);
add_prim(1, 0b001, 0, "array_create1", &__array_create1);
add_prim(1, 0b001, 0, "array_create1_lazy", &__array_create1);
......@@ -973,6 +983,7 @@ void init_prim() {
add_prim(1, 0b001, 0, "string_create1", &__string_create1);
add_prim(2, 0b011, 0, "string_create2", &__string_create2);
add_prim(3, 0b110, 0, "string_update", &__string_update);
add_prim(3, 0b110, 0, "string_update_copy", &__string_update_copy);
add_prim(3, 0b110, 0, "string_slice", &__string_slice);
add_prim(2, 0b000, 0, "string_append", &__string_append);
add_prim(2, 0b000, 1, "eqS", &__eqS);
......
......@@ -82,7 +82,7 @@ void print(bool force) {
printf("False");
}
} else if ((FunEntry*) thunk->desc == __CHAR__) {
printf("%c", (char) thunk->_int);
printf("'%c'", (char) thunk->_int);
} else if ((FunEntry*) thunk->desc == __REAL__) {
printf("%G", thunk->_real);
} else if ((FunEntry*) thunk->desc == __STRING_PTR__) {
......
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