Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
sapl-interpreter
Commits
98384066
Commit
98384066
authored
Sep 03, 2015
by
Laszlo Domoszlai
Browse files
clean-up before start to use B stack finally
parent
2ed05f42
Changes
9
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_t
o
(
get_dst
(
root_frame_ptr
)
,
thunk
)
;
forward_t
hunk
(
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