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

simplify stack frame

parent 9359272d
Hide whitespace changes
Inline Side-by-side
interpreter/code.c
View file @ 420c41f9
......@@ -26,20 +26,11 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
}
break;
case CT_VAR:
switch (expr->local_type) {
case VAR_FN:
if (expr->local_type == VAR_LOCAL) {
Thunk* var = local(frame_ptr, ((VarEntry*) expr)->index);
return forward_to(target, var);
}else{
return updateF(target, get_slice(((VarEntry*) expr)->f, 0));
case VAR_ARG:
{
Thunk* var = arg(frame_ptr, ((VarEntry*) expr)->index);
return forward_to(target, var);
}
case VAR_LOCAL:
{
Thunk* var = local(frame_ptr, ((VarEntry*) expr)->index + 1);
return forward_to(target, var);
}
}
break;
case CT_APP:
......@@ -51,8 +42,28 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
var = ((AppEntry*) expr)->var;
Thunk* thunk;
switch (var->base.local_type) {
case VAR_FN:
if (var->base.local_type == VAR_LOCAL) {
Thunk* basethunk = eval(local(frame_ptr, var->index));
Desc* slice =
get_slice(basethunk->desc->type == FT_SLICE ?
((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);
thunk = updateF(target, 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] = exec(((AppEntry*) expr)->args[i], frame_ptr, NULL, false);
}
return thunk;
}
else
{
Desc* slice = get_slice(var->f, expr->nr_args);
......@@ -71,15 +82,15 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
}
else if (force && slice->type == FT_FUN) {
int old_top = stack_top_a;
int new_frame_ptr = stack_top_a;
for (int i = 0; i < expr->nr_args; i++) {
push_a(exec(((AppEntry*) expr)->args[i], frame_ptr, NULL, is_strict_fun_arg((FunEntry*) slice, i)));
}
thunk = exec(((FunEntry*) slice)->body, stack_top_a - 1, target, true);
thunk = exec(((FunEntry*) slice)->body, new_frame_ptr, target, true);
stack_top_a = old_top;
stack_top_a = new_frame_ptr;
}
else {
thunk = updateF(target, slice);
......@@ -92,37 +103,10 @@ exec(Code* expr, int frame_ptr, Thunk* target, bool force)
}
return thunk;
}
case VAR_ARG:
{
Thunk* basethunk = eval(arg(frame_ptr, var->index));
Desc* slice =
get_slice(basethunk->desc->type == FT_SLICE ?
((SliceEntry*) basethunk->desc)->forward_ptr : basethunk->desc, basethunk->desc->arity + expr->nr_args);
thunk = updateF(target, 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] = exec(((AppEntry*) expr)->args[i], frame_ptr, NULL, false);
}
return thunk;
}
default:
printf("Exec: Unhandled VAR type in CT_APP");
exit(-1);
}
break;
case CT_SELECT:
{
Thunk* pattern = exec(((SelectEntry*) expr)->expr, frame_ptr, NULL, true);
Thunk* p = pattern;
pattern = eval(pattern);
for (int i = 0; i < expr->nr_cases; i++) {
......
interpreter/code.h
View file @ 420c41f9
......@@ -40,9 +40,8 @@ struct LitEntry {
};
};
#define VAR_ARG 1
#define VAR_LOCAL 2
#define VAR_FN 3
#define VAR_LOCAL 0
#define VAR_FN 1
struct VarEntry {
struct Code base;
......
interpreter/mem.h
View file @ 420c41f9
......@@ -13,8 +13,7 @@ extern Thunk* stack_a[STACK_SIZE_A];
#define pop_a() stack_a[--stack_top_a]
#define push_a(r) stack_a[stack_top_a++]=(r)
#define arg(base, idx) stack_a[base-idx]
#define local(base, idx) stack_a[base+idx]
#define local(base, idx) stack_a[base+idx-1]
void init_mem();
void print_stat();
......
interpreter/parse.c
View file @ 420c41f9
......@@ -274,13 +274,6 @@ VarEntry* parseVar(char **ptr) {
entry->base.type = CT_VAR;
switch (type) {
case 'A': // Argument
{
entry->base.local_type = VAR_ARG;
if (!parseInt(ptr, &entry->index)) return 0;
break;
}
case 'L': // Local var
{
entry->base.local_type = VAR_LOCAL;
......
interpreter/prim.c
View file @ 420c41f9
......@@ -6,9 +6,11 @@
#include "thunk.h"
#include "mem.h"
#define arg(idx) stack_a[stack_top_a - idx]
struct Thunk* __add(Thunk* target) {
Thunk* arg1 = arg(stack_top_a, 2);
Thunk* arg2 = arg(stack_top_a, 1);
Thunk* arg1 = arg(2);
Thunk* arg2 = arg(1);
arg1 = eval(arg1);
arg2 = eval(arg2);
......@@ -17,8 +19,8 @@ struct Thunk* __add(Thunk* target) {
}
struct Thunk* __sub(Thunk* target) {
Thunk* arg1 = arg(stack_top_a, 2);
Thunk* arg2 = arg(stack_top_a, 1);
Thunk* arg1 = arg(2);
Thunk* arg2 = arg(1);
arg1 = eval(arg1);
arg2 = eval(arg2);
......@@ -27,8 +29,8 @@ struct Thunk* __sub(Thunk* target) {
}
struct Thunk* __gt(Thunk* target) {
Thunk* arg1 = arg(stack_top_a, 2);
Thunk* arg2 = arg(stack_top_a, 1);
Thunk* arg1 = arg(2);
Thunk* arg2 = arg(1);
arg1 = eval(arg1);
arg2 = eval(arg2);
......@@ -37,8 +39,8 @@ struct Thunk* __gt(Thunk* target) {
}
struct Thunk* __lt(Thunk* target) {
Thunk* arg1 = arg(stack_top_a, 2);
Thunk* arg2 = arg(stack_top_a, 1);
Thunk* arg1 = arg(2);
Thunk* arg2 = arg(1);
arg1 = eval(arg1);
arg2 = eval(arg2);
......@@ -47,8 +49,8 @@ struct Thunk* __lt(Thunk* target) {
}
struct Thunk* __eqI(Thunk* target) {
Thunk* arg1 = arg(stack_top_a, 2);
Thunk* arg2 = arg(stack_top_a, 1);
Thunk* arg1 = arg(2);
Thunk* arg2 = arg(1);
arg1 = eval(arg1);
arg2 = eval(arg2);
......@@ -57,8 +59,8 @@ struct Thunk* __eqI(Thunk* target) {
}
struct Thunk* __eqB(Thunk* target) {
Thunk* arg1 = arg(stack_top_a, 2);
Thunk* arg2 = arg(stack_top_a, 1);
Thunk* arg1 = arg(2);
Thunk* arg2 = arg(1);
arg1 = eval(arg1);
arg2 = eval(arg2);
......@@ -67,7 +69,7 @@ struct Thunk* __eqB(Thunk* target) {
}
struct Thunk* __not(Thunk* target) {
Thunk* arg1 = arg(stack_top_a, 1);
Thunk* arg1 = arg(1);
arg1 = eval(arg1);
......
interpreter/thunk.c
View file @ 420c41f9
......@@ -146,19 +146,19 @@ struct Thunk* eval(Thunk* thunk) {
case FT_RECORD:
return thunk;
case FT_FUN:
int old_top;
old_top = stack_top_a;
int frame_ptr;
frame_ptr = stack_top_a;
for (int i = 0; i < thunk->desc->arity; i++) {
// TODO: handle strictness
push_a(thunk->_args[i]);
}
thunk = exec(((FunEntry*) thunk->desc)->body, stack_top_a - 1, thunk, true);
thunk = exec(((FunEntry*) thunk->desc)->body, frame_ptr, thunk, true);
stack_top_a = old_top;
stack_top_a = frame_ptr;
break;
case FT_PRIM:
old_top = stack_top_a;
frame_ptr = stack_top_a;
for (int i = 0; i < thunk->desc->arity; i++) {
push_a(thunk->_args[i]);
......@@ -166,7 +166,7 @@ struct Thunk* eval(Thunk* thunk) {
((PrimEntry*) thunk->desc)->exec(thunk);
stack_top_a = old_top;
stack_top_a = frame_ptr;
break;
default:
printf("eval: unhandled DESC\n");
......
precompiler/precompiler.icl
View file @ 420c41f9
......@@ -14,7 +14,7 @@ import Text.Unicode.Encodings.JS
import System.CommandLine
import System.File
:: VarType = Arg Int | Local Int | Fun String
:: VarType = Local Int | Fun String
:: Context = { vars :: Map String VarType
, localcount :: Int
......@@ -22,18 +22,15 @@ import System.File
newContext = {vars = newMap, localcount = 0}
registerParams vars idx [] = vars
registerParams vars idx [v:vs] = registerParams (put (unpackVar v) (Arg idx) vars) (idx - 1) vs
registerLocals vars idx [] = vars
registerLocals vars idx [v:vs] = registerLocals (put (unpackVar v) (Local idx) vars) (idx + 1) vs
registerLocals vars idx [v:vs] = registerLocals (put (unpackVar v) (Local (idx+1)) 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 = registerParams ctx.vars (length params - 1) params}
# ctx = {ctx & vars = registerLocals 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
......@@ -72,7 +69,6 @@ sSelectCase ctx (PDefault, expr) a
sVar ctx var a
= case get varName ctx.vars of
(Just (Arg i)) = a <++ "A" <++ sNum i
(Just (Local i)) = a <++ "L" <++ sNum i
_ = a <++ "F" <++ sText varName
where
......
Supports Markdown
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