Skip to content
GitLab
Commit 98384066 authored by Laszlo Domoszlai's avatar Laszlo Domoszlai
Browse files

clean-up before start to use B stack finally

parent 2ed05f42
Hide whitespace changes
Inline Side-by-side
interpreter/code.c
View file @ 98384066
......@@ -7,57 +7,95 @@
#include "mem.h"
#include "desc.h"
// For compressing the source code a bit
#define follow_thunk(thunk) if (thunk->desc == (Desc*) __FORWARD_PTR__) thunk = thunk->_forward_ptr;
#define forward_thunk(thunk, frame_ptr) \
Thunk* dst = get_dst(frame_ptr); \
if(dst != NULL) \
{ \
dst->desc = (Desc*) __FORWARD_PTR__; \
dst->_forward_ptr = thunk; \
}
#define arg_from_thunk(desc, arg) \
if(((FunEntry*) (desc))->strictness & argmask) \
{ \
push_a(eval(arg)); \
} \
else \
{ \
push_a(arg); \
} \
argmask <<= 1;
#define arg_from_code(desc, arg) \
if(((FunEntry*) (desc))->strictness & argmask) \
{ \
push_a(NULL); \
exec(arg, frame_ptr, stack_top_a); \
} \
else \
{ \
push_a(create_thunk(arg, frame_ptr)); \
} \
argmask <<= 1;
struct Thunk* create_thunk(Code* expr, int frame_ptr)
{
assert(expr != NULL);
// TODO: check over application
// TODO: enforce strictness in ADT/Record
switch (expr->type) {
case CT_APP:
{
// TODO: check over application
// TODO: enforce strictness in ADT/Record
if (expr->dyn_app)
{
Thunk* basethunk = local(frame_ptr, ((AppEntry*)expr)->var.index);
if(!((AppEntry*)expr)->var.base.strict) basethunk = eval(basethunk);
Desc* slice =
get_slice(basethunk->desc->type == FT_SLICE ?
((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);
Thunk* thunk = createF(((AppEntry*) expr)->f);
Thunk* thunk = createF(slice);
assert(thunk->desc->arity == expr->nr_args);
assert(thunk->desc->arity == basethunk->desc->arity + expr->nr_args);
for (int i = 0; i < expr->nr_args; i++) {
thunk->_args[i] = create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
}
for (int i = 0; i < basethunk->desc->arity; i++) {
thunk->_args[i] = basethunk->_args[i];
}
return thunk;
}
case CT_APP_DYN:
{
Thunk* basethunk = local(frame_ptr, ((AppEntry*)expr)->var.index);
if(!((AppEntry*)expr)->var.base.strict) basethunk = eval(basethunk);
for (int i = 0; i < expr->nr_args; i++) {
thunk->_args[basethunk->desc->arity + i]
= create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
}
Desc* slice =
get_slice(basethunk->desc->type == FT_SLICE ?
((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);
return thunk;
}
else
{
Thunk* thunk = createF(((AppEntry*) expr)->f);
Thunk* thunk = createF(slice);
assert(thunk->desc->arity == expr->nr_args);
assert(thunk->desc->arity == basethunk->desc->arity + expr->nr_args);
for (int i = 0; i < expr->nr_args; i++) {
thunk->_args[i] = create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
}
for (int i = 0; i < basethunk->desc->arity; i++) {
thunk->_args[i] = basethunk->_args[i];
}
return thunk;
for (int i = 0; i < expr->nr_args; i++) {
thunk->_args[basethunk->desc->arity + i]
= create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
}
}
return thunk;
}
case CT_VAR:
case CT_VAR_STRICT:
return local(frame_ptr, ((VarEntry*) expr)->index);
case CT_THUNK:
return &((ThunkEntry*) expr)->thunk;
return &((ThunkEntry*) expr)->thunk;
case CT_SELECT:
case CT_IF:
// Only here to avoid intervalum check at switch
abort("Unexpected code type");
}
}
......@@ -67,174 +105,158 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
{
assert(expr != NULL);
assert(stack_top_a < STACK_SIZE_A);
// TODO: check over application
// TODO: enforce strictness in ADT/Record
switch (expr->type) {
case CT_APP:
{
// TODO: check over application
// TODO: enforce strictness in ADT/Record
Desc* slice = ((AppEntry*) expr)->f;
if (expr->dyn_app)
switch (slice->type) {
case FT_PRIM:
{
Thunk* basethunk = local(frame_ptr, ((AppEntry*)expr)->var.index);
if(!((AppEntry*)expr)->var.base.strict) basethunk = eval(basethunk);
Desc* slice =
get_slice(basethunk->desc->type == FT_SLICE ?
((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);
if(slice->type == FT_PRIM)
{
for (int i = 0; i < basethunk->desc->arity; i++) {
push_a(eval(basethunk->_args[i]));
}
for (int i = 0; i < expr->nr_args; i++) {
push_a(NULL);
exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
}
((PrimEntry*) slice)->exec(root_frame_ptr);
destroy_stack_frame(root_frame_ptr);
return;
}
else if(slice->type == FT_FUN)
{
int new_frame_ptr = stack_top_a;
int argmask = 1;
for (int i = 0; i < basethunk->desc->arity; i++) {
if(((FunEntry*) slice)->strictness & argmask)
{
push_a(eval(basethunk->_args[i]));
}
else
{
push_a(basethunk->_args[i]);
}
argmask <<= 1;
}
for (int i = 0; i < expr->nr_args; i++) {
if(((FunEntry*) slice)->strictness & argmask)
{
push_a(NULL);
exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
}
else
{
push_a(create_thunk(((AppEntry*) expr)->args[i], frame_ptr));
}
argmask <<= 1;
}
expr = ((FunEntry*) slice)->body;
frame_ptr = new_frame_ptr;
continue;
Thunk args[expr->nr_args];
for (int i = 0; i < expr->nr_args; i++) {
push_a(&args[i]);
exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
}
else
{
Thunk* thunk = updateF(get_dst(root_frame_ptr), slice);
assert(thunk->desc->arity == basethunk->desc->arity + expr->nr_args);
for (int i = 0; i < basethunk->desc->arity; i++) {
thunk->_args[i] = basethunk->_args[i];
}
for (int i = 0; i < expr->nr_args; i++) {
thunk->_args[basethunk->desc->arity + i]
= create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
}
set_return(root_frame_ptr, thunk);
destroy_stack_frame(root_frame_ptr);
return;
((PrimEntry*) slice)->exec(root_frame_ptr);
destroy_stack_frame(root_frame_ptr);
return;
}
case FT_FUN:
{
int new_frame_ptr = stack_top_a;
int argmask = 1;
for (int i = 0; i < expr->nr_args; i++) {
arg_from_code(slice, ((AppEntry*) expr)->args[i]);
}
expr = ((FunEntry*) slice)->body;
frame_ptr = new_frame_ptr;
continue;
}
else
case FT_SLICE:
case FT_ADT:
case FT_RECORD:
{
Desc* slice = ((AppEntry*) expr)->f;
if (slice->type == FT_PRIM) {
Thunk args[expr->nr_args];
Thunk* thunk = updateF(get_dst(root_frame_ptr), slice);
for (int i = 0; i < expr->nr_args; i++) {
push_a(&args[i]);
exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
}
assert(thunk->desc->arity == expr->nr_args);
((PrimEntry*) slice)->exec(root_frame_ptr);
destroy_stack_frame(root_frame_ptr);
return;
}
else if (slice->type == FT_FUN) {
int new_frame_ptr = stack_top_a;
int argmask = 1;
for (int i = 0; i < expr->nr_args; i++) {
if(((FunEntry*) slice)->strictness & argmask)
{
push_a(NULL);
exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
}
else
{
push_a(create_thunk(((AppEntry*) expr)->args[i], frame_ptr));
}
argmask <<= 1;
}
expr = ((FunEntry*) slice)->body;
frame_ptr = new_frame_ptr;
continue;
}
else {
Thunk* thunk = updateF(get_dst(root_frame_ptr), slice);
assert(thunk->desc->arity == expr->nr_args);
for (int i = 0; i < expr->nr_args; i++) {
thunk->_args[i]
= create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
}
set_return(root_frame_ptr, thunk);
destroy_stack_frame(root_frame_ptr);
return;
for (int i = 0; i < expr->nr_args; i++) {
thunk->_args[i]
= create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
}
set_return(root_frame_ptr, thunk);
destroy_stack_frame(root_frame_ptr);
return;
}
break;
}
case CT_VAR:
case FT_BOXED_LIT:
abort("Literal unexpected here");
case FT_CAF:
case FT_CAF_REDUCED:
not_implemented("CAF");
}
}
case CT_APP_DYN:
{
Thunk* thunk = local(frame_ptr, ((VarEntry*) expr)->index);
Thunk* basethunk = local(frame_ptr, ((AppEntry*)expr)->var.index);
if(!((AppEntry*)expr)->var.base.strict) basethunk = eval(basethunk);
if(((VarEntry*) expr)->base.strict)
Desc* slice =
get_slice(basethunk->desc->type == FT_SLICE ?
((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);
switch(slice->type) {
case FT_PRIM:
{
assert(is_hnf(thunk));
for (int i = 0; i < basethunk->desc->arity; i++) {
push_a(eval(basethunk->_args[i]));
}
set_return(root_frame_ptr, thunk);
for (int i = 0; i < expr->nr_args; i++) {
push_a(NULL);
exec(((AppEntry*) expr)->args[i], frame_ptr, stack_top_a);
}
((PrimEntry*) slice)->exec(root_frame_ptr);
destroy_stack_frame(root_frame_ptr);
return;
}
case FT_FUN:
{
int new_frame_ptr = stack_top_a;
int argmask = 1;
for (int i = 0; i < basethunk->desc->arity; i++) {
arg_from_thunk(slice, basethunk->_args[i])
}
for (int i = 0; i < expr->nr_args; i++) {
arg_from_code(slice, ((AppEntry*) expr)->args[i]);
}
while (thunk->desc == (Desc*) __FORWARD_PTR__) {
thunk = thunk->_forward_ptr;
expr = ((FunEntry*) slice)->body;
frame_ptr = new_frame_ptr;
continue;
}
case FT_SLICE:
case FT_ADT:
case FT_RECORD:
{
Thunk* thunk = updateF(get_dst(root_frame_ptr), slice);
assert(thunk->desc->arity == basethunk->desc->arity + expr->nr_args);
for (int i = 0; i < basethunk->desc->arity; i++) {
thunk->_args[i] = basethunk->_args[i];
}
for (int i = 0; i < expr->nr_args; i++) {
thunk->_args[basethunk->desc->arity + i]
= create_thunk(((AppEntry*) expr)->args[i], frame_ptr);
}
set_return(root_frame_ptr, thunk);
destroy_stack_frame(root_frame_ptr);
return;
}
case FT_BOXED_LIT:
abort("Literal unexpected here");
case FT_CAF:
case FT_CAF_REDUCED:
not_implemented("CAF");
}
}
case CT_VAR_STRICT:
{
Thunk* thunk = local(frame_ptr, ((VarEntry*) expr)->index);
assert(is_hnf(thunk));
forward_to(get_dst(root_frame_ptr), thunk);
forward_thunk(thunk, root_frame_ptr);
set_return(root_frame_ptr, thunk);
destroy_stack_frame(root_frame_ptr);
return;
}
case CT_VAR:
{
Thunk* thunk = local(frame_ptr, ((VarEntry*) expr)->index);
if (thunk->desc->type == FT_FUN) {
follow_thunk(thunk);
forward_thunk(thunk, root_frame_ptr);
set_return(root_frame_ptr, thunk);
switch(thunk->desc->type) {
case FT_FUN:
{
// Destroy stack frame before eval, it is not needed any more
// Greatly reduces stack usage
destroy_stack_frame(root_frame_ptr);
......@@ -244,45 +266,39 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
int argmask = 1;
for (int i = 0; i < thunk->desc->arity; i++) {
if(((FunEntry*) thunk->desc)->strictness & argmask)
{
push_a(eval(thunk->_args[i]));
}
else
{
push_a(thunk->_args[i]);
}
argmask <<= 1;
arg_from_thunk(thunk->desc, thunk->_args[i]);
}
expr = ((FunEntry*) thunk->desc)->body;
continue;
}
else if(thunk->desc->type == FT_PRIM) {
case FT_PRIM:
{
for (int i = 0; i < thunk->desc->arity; i++) {
push_a(eval(thunk->_args[i]));
}
((PrimEntry*) thunk->desc)->exec(root_frame_ptr);
}
destroy_stack_frame(root_frame_ptr);
return;
destroy_stack_frame(root_frame_ptr);
return;
}
case FT_CAF:
case FT_CAF_REDUCED:
not_implemented("CAF");
case FT_SLICE:
case FT_ADT:
case FT_RECORD:
case FT_BOXED_LIT:
destroy_stack_frame(root_frame_ptr);
return;
}
}
case CT_THUNK:
{
Thunk* target = get_dst(root_frame_ptr);
Thunk* thunk = &((ThunkEntry*) expr)->thunk;
if(target != NULL)
{
target->desc = (Desc*) __FORWARD_PTR__;
target->_forward_ptr = thunk;
}
Thunk* thunk = &((ThunkEntry*) expr)->thunk;
forward_thunk(thunk, root_frame_ptr);
set_return(root_frame_ptr, thunk);
destroy_stack_frame(root_frame_ptr);
return;
......@@ -344,11 +360,53 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
expr = ((IfEntry*) expr)->fexpr;
continue;
}
}
default:
printf("Exec: Unhandled CODE type");
exit(-1);
}
}
}
}
struct Thunk* eval(Thunk* thunk) {
assert(thunk != NULL);
follow_thunk(thunk);
switch(thunk->desc->type) {
case FT_FUN:
{
push_a(thunk);
int frame_ptr = stack_top_a;
int argmask = 1;
for (int i = 0; i < thunk->desc->arity; i++) {
arg_from_thunk(thunk->desc, thunk->_args[i]);
}
exec(((FunEntry*) thunk->desc)->body, frame_ptr, frame_ptr);
thunk = pop_a();
return thunk;
}
case FT_PRIM:
{
push_a(thunk);
int frame_ptr = stack_top_a;
for (int i = 0; i < thunk->desc->arity; i++) {
push_a(eval(thunk->_args[i]));
}
((PrimEntry*) thunk->desc)->exec(frame_ptr);
stack_top_a = frame_ptr;
thunk = pop_a();
return thunk;
}
case FT_CAF:
case FT_CAF_REDUCED:
not_implemented("CAF");
case FT_SLICE:
case FT_ADT:
case FT_RECORD:
case FT_BOXED_LIT:
return thunk;
}
}
interpreter/code.h
View file @ 98384066
......@@ -3,16 +3,13 @@
#include "thunk.h"
#define CT_THUNK 1 // Shared thunk
#define CT_VAR 2
#define CT_APP 3
#define CT_SELECT 4
#define CT_IF 5
enum CodeType {
CT_VAR, CT_VAR_STRICT, CT_APP, CT_APP_DYN, CT_SELECT, CT_IF, CT_THUNK
};
struct Code {
unsigned int type : 3;
CodeType type : 3;
unsigned int nr_args : 5; // used in AppEntry
unsigned int dyn_app : 1; // used in AppEntry
unsigned int nr_cases : 5; // used in SelectEntry
unsigned int strict : 1; // used in VarEntry
};
......@@ -64,5 +61,6 @@ struct IfEntry {
};
void exec(Code* expr, int frame_ptr, int root_frame_ptr);
struct Thunk* eval(Thunk* thunk);
#endif // __CODE_H
\ No newline at end of file
interpreter/debug.c 0 → 100644
View file @ 98384066
#include <stdio.h>
#include <stdlib.h>
#include "debug.h"
void not_implemented(char* msg)
{
printf("Function not implemented: %s\n", msg);
exit(-1);
}
void abort(char* msg)
{
printf("Abort: %s\n", msg);
exit(-1);
}
interpreter/debug.h
View file @ 98384066
......@@ -10,5 +10,8 @@
#include <assert.h>
void not_implemented(char* msg);
void abort(char* msg);
#endif /* DEBUG_H */
interpreter/desc_base.h
View file @ 98384066
#ifndef __DESC_BASE_H
#define __DESC_BASE_H
#define FT_BOXED_LIT 0
#define FT_RECORD 1
#define FT_ADT 2