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
420c41f9
Commit
420c41f9
authored
Aug 25, 2015
by
Laszlo Domoszlai
Browse files
simplify stack frame
parent
9359272d
Changes
7
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
=
register
Param
s
ctx
.
vars
(
length
params
-
1
)
params
}
#
ctx
=
{
ctx
&
vars
=
register
Local
s
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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment