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
a9f0c3a6
Commit
a9f0c3a6
authored
Aug 29, 2015
by
Laszlo Domoszlai
Browse files
+ set in VarEntry whether its strict and use this to avoid unnecessary "eval"s
+ "eval" where cannot be avoided
parent
6ef36f0b
Changes
9
Hide whitespace changes
Inline
Side-by-side
interpreter/code.c
View file @
a9f0c3a6
...
...
@@ -92,8 +92,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
if
(
slice
->
type
==
FT_PRIM
)
{
for
(
int
i
=
0
;
i
<
basethunk
->
desc
->
arity
;
i
++
)
{
// TODO: eval
push_a
(
basethunk
->
_args
[
i
]);
push_a
(
eval
(
basethunk
->
_args
[
i
]));
}
for
(
int
i
=
0
;
i
<
expr
->
nr_args
;
i
++
)
{
...
...
@@ -110,13 +109,28 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
int
new_frame_ptr
=
stack_top_a
;
for
(
int
i
=
0
;
i
<
basethunk
->
desc
->
arity
;
i
++
)
{
// TODO: eval
push_a
(
basethunk
->
_args
[
i
]);
if
(
is_strict_fun_arg
((
FunEntry
*
)
slice
,
i
))
{
push_a
(
eval
(
basethunk
->
_args
[
i
]));
}
else
{
push_a
(
basethunk
->
_args
[
i
]);
}
}
for
(
int
i
=
0
;
i
<
expr
->
nr_args
;
i
++
)
{
// TODO: eval
push_a
(
create_thunk
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
));
if
(
is_strict_fun_arg
((
FunEntry
*
)
slice
,
basethunk
->
desc
->
arity
+
i
))
{
push_a
(
NULL
);
exec
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
,
stack_top_a
);
}
else
{
push_a
(
create_thunk
(((
AppEntry
*
)
expr
)
->
args
[
i
],
frame_ptr
));
}
}
expr
=
((
FunEntry
*
)
slice
)
->
body
;
...
...
@@ -200,7 +214,16 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
case
CT_VAR
:
if
(
expr
->
local_type
==
VAR_LOCAL
)
{
Thunk
*
thunk
=
local
(
frame_ptr
,
((
VarEntry
*
)
expr
)
->
index
);
if
(((
VarEntry
*
)
expr
)
->
base
.
strict
)
{
assert
(
is_hnf
(
thunk
));
set_return
(
root_frame_ptr
,
thunk
);
destroy_stack_frame
(
root_frame_ptr
);
return
;
}
while
(
thunk
->
desc
==
(
Desc
*
)
__FORWARD_PTR__
)
{
thunk
=
thunk
->
_forward_ptr
;
}
...
...
@@ -217,8 +240,15 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
// Here frame_ptr == root_frame_ptr
for
(
int
i
=
0
;
i
<
thunk
->
desc
->
arity
;
i
++
)
{
// TODO: handle strictness
push_a
(
thunk
->
_args
[
i
]);
if
(
is_strict_fun_arg
((
FunEntry
*
)
thunk
->
desc
,
i
))
{
push_a
(
eval
(
thunk
->
_args
[
i
]));
}
else
{
push_a
(
thunk
->
_args
[
i
]);
}
}
expr
=
((
FunEntry
*
)
thunk
->
desc
)
->
body
;
...
...
@@ -227,8 +257,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
else
if
(
thunk
->
desc
->
type
==
FT_PRIM
)
{
for
(
int
i
=
0
;
i
<
thunk
->
desc
->
arity
;
i
++
)
{
// TODO: handle strictness
push_a
(
thunk
->
_args
[
i
]);
push_a
(
eval
(
thunk
->
_args
[
i
]));
}
((
PrimEntry
*
)
thunk
->
desc
)
->
exec
(
root_frame_ptr
);
...
...
@@ -261,7 +290,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
{
push_a
(
NULL
);
exec
(((
SelectEntry
*
)
expr
)
->
expr
,
frame_ptr
,
stack_top_a
);
Thunk
*
pattern
=
eval
(
pop_a
()
)
;
Thunk
*
pattern
=
pop_a
();
assert
(
is_hnf
(
pattern
));
assert
(
pattern
->
desc
->
type
==
FT_ADT
);
...
...
@@ -304,7 +333,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
push_a
(
&
tmp
);
exec
(((
IfEntry
*
)
expr
)
->
cond
,
frame_ptr
,
stack_top_a
);
Thunk
*
cond
=
eval
(
pop_a
()
)
;
Thunk
*
cond
=
pop_a
();
if
(
readB
(
cond
))
{
expr
=
((
IfEntry
*
)
expr
)
->
texpr
;
...
...
interpreter/code.h
View file @
a9f0c3a6
...
...
@@ -12,8 +12,9 @@
struct
Code
{
unsigned
int
type
:
3
;
unsigned
int
local_type
:
3
;
unsigned
int
nr_args
:
5
;
// used in AppEntry
unsigned
int
nr_cases
:
5
;
// used in SelectEntry
unsigned
int
nr_args
:
5
;
// used in AppEntry
unsigned
int
nr_cases
:
5
;
// used in SelectEntry
unsigned
int
strict
:
1
;
// used in VarEntry
};
#define LIT_INT 1
...
...
interpreter/debug.h
View file @
a9f0c3a6
#ifndef DEBUG_H
#define DEBUG_H
#define DEBUG
// Adjoxo: 2200
//#define DEBUG
#define BENCHMARK
#ifndef DEBUG
#define NDEBUG
...
...
interpreter/main.c
View file @
a9f0c3a6
...
...
@@ -29,7 +29,7 @@ int main ( int argc, char *argv[] )
init_desc
();
init_prim
();
char
*
input
=
"..
\\
tests
\\
Braun
.bsapl"
;
char
*
input
=
"..
\\
tests
\\
fib
.bsapl"
;
if
(
argc
==
2
)
{
...
...
@@ -79,27 +79,29 @@ int main ( int argc, char *argv[] )
Code
*
expr
=
parseTerm
(
&
exprstream
);
#ifdef
DEBUG
#ifdef
BENCHMARK
struct
timeval
t1
,
t2
;
gettimeofday
(
&
t1
,
NULL
);
#endif
push_a
(
NULL
);
exec
(
expr
,
stack_top_a
,
stack_top_a
);
Thunk
*
res
=
eval
(
pop_a
()
)
;
Thunk
*
res
=
pop_a
();
#ifdef
DEBUG
#ifdef
BENCHMARK
gettimeofday
(
&
t2
,
NULL
);
#endif
#endif
print
(
res
,
true
);
#ifdef
DEBUG
#ifdef
BENCHMARK
// compute and print the elapsed time in millisec
double
elapsedTime
=
(
t2
.
tv_sec
-
t1
.
tv_sec
)
*
1000
.
0
;
// sec to ms
elapsedTime
+=
(
t2
.
tv_usec
-
t1
.
tv_usec
)
/
1000
.
0
;
// us to ms
elapsedTime
+=
(
t2
.
tv_usec
-
t1
.
tv_usec
)
/
1000
.
0
;
// us to ms
printf
(
"
\n\n
execution time: %G ms
\n
"
,
elapsedTime
);
#endif
#ifdef DEBUG
print_stat
();
#endif
...
...
interpreter/mem.h
View file @
a9f0c3a6
...
...
@@ -15,12 +15,12 @@ extern Thunk stack_b[STACK_SIZE_B];
#define pop_a() stack_a[--stack_top_a]
#define push_a(r) stack_a[stack_top_a++]=(r)
#define local(base, idx) stack_a[base+idx
-1
]
#define local(base, idx) stack_a[base+idx]
#define set_return(base, r) stack_a[base-1]=(r)
#define destroy_stack_frame(base) stack_top_a = base
#define get_dst(base) stack_a[base-1]
#define alloc_b(
nr
) stack_top_b+
=nr
#define alloc_b()
&stack_b[
stack_top_b+
+]
#define destroy_stack_frame_b(base) stack_top_b = base
...
...
interpreter/parse.c
View file @
a9f0c3a6
...
...
@@ -277,8 +277,10 @@ VarEntry* parseVar(char **ptr, VarEntry* target) {
switch
(
type
)
{
case
'L'
:
// Local var
case
'S'
:
// Strict local var
{
entry
->
base
.
local_type
=
VAR_LOCAL
;
entry
->
base
.
strict
=
type
==
'S'
;
if
(
!
parseInt
(
ptr
,
&
entry
->
index
))
return
0
;
break
;
}
...
...
interpreter/thunk.c
View file @
a9f0c3a6
...
...
@@ -39,50 +39,50 @@ int thunk_size(Thunk* thunk) {
}
}
struct
Thunk
*
updateI
(
Thunk
*
target
,
int
i
)
{
if
(
target
==
NULL
)
target
=
(
Thunk
*
)
alloc_heap
(
sizeof
(
Thunk
));
// always can be overwritten with boxed integer
target
->
desc
=
(
Desc
*
)
__INT__
;
target
->
_int
=
i
;
return
target
;
}
#ifdef DEBUG
int
readI
(
Thunk
*
thunk
)
{
assert
(
thunk
!=
NULL
);
#ifdef DEBUG
if
(
thunk
->
desc
!=
(
Desc
*
)
__INT__
)
{
printf
(
"readI: not an integer
\n
"
);
printf
(
"readI: not an integer
:
"
);
printDesc
(
thunk
->
desc
);
exit
(
-
1
);
}
#endif
return
thunk
->
_int
;
}
struct
Thunk
*
updateB
(
Thunk
*
target
,
int
b
)
{
if
(
target
==
NULL
)
target
=
(
Thunk
*
)
alloc_heap
(
sizeof
(
Thunk
));
// always can be overwritten with boxed integer
target
->
desc
=
(
Desc
*
)
__BOOL__
;
target
->
_bool
=
b
;
return
target
;
}
int
readB
(
Thunk
*
thunk
)
{
assert
(
thunk
!=
NULL
);
#ifdef DEBUG
if
(
thunk
->
desc
!=
(
Desc
*
)
__BOOL__
)
{
printf
(
"readB: not a boolean
\n
"
);
printf
(
"readB: not a boolean: "
);
printDesc
(
thunk
->
desc
);
exit
(
-
1
);
}
#endif
return
thunk
->
_bool
;
}
#endif
struct
Thunk
*
updateI
(
Thunk
*
target
,
int
i
)
{
if
(
target
==
NULL
)
target
=
(
Thunk
*
)
alloc_heap
(
sizeof
(
Thunk
));
// always can be overwritten with boxed integer
target
->
desc
=
(
Desc
*
)
__INT__
;
target
->
_int
=
i
;
return
target
;
}
struct
Thunk
*
updateB
(
Thunk
*
target
,
int
b
)
{
if
(
target
==
NULL
)
target
=
(
Thunk
*
)
alloc_heap
(
sizeof
(
Thunk
));
// always can be overwritten with boxed integer
target
->
desc
=
(
Desc
*
)
__BOOL__
;
target
->
_bool
=
b
;
return
target
;
}
struct
Thunk
*
updateT
(
Thunk
*
target
,
Thunk
*
source
)
{
if
(
target
==
NULL
)
target
=
(
Thunk
*
)
alloc_heap
(
sizeof
(
Thunk
));
...
...
@@ -130,8 +130,14 @@ struct Thunk* eval(Thunk* thunk) {
int
frame_ptr
=
stack_top_a
;
for
(
int
i
=
0
;
i
<
thunk
->
desc
->
arity
;
i
++
)
{
// TODO: handle strictness
push_a
(
thunk
->
_args
[
i
]);
if
(
is_strict_fun_arg
((
FunEntry
*
)
thunk
->
desc
,
i
))
{
push_a
(
eval
(
thunk
->
_args
[
i
]));
}
else
{
push_a
(
thunk
->
_args
[
i
]);
}
}
exec
(((
FunEntry
*
)
thunk
->
desc
)
->
body
,
frame_ptr
,
frame_ptr
);
thunk
=
pop_a
();
...
...
@@ -141,7 +147,7 @@ struct Thunk* eval(Thunk* thunk) {
int
frame_ptr
=
stack_top_a
;
for
(
int
i
=
0
;
i
<
thunk
->
desc
->
arity
;
i
++
)
{
push_a
(
thunk
->
_args
[
i
]);
push_a
(
eval
(
thunk
->
_args
[
i
])
)
;
}
((
PrimEntry
*
)
thunk
->
desc
)
->
exec
(
frame_ptr
);
...
...
interpreter/thunk.h
View file @
a9f0c3a6
...
...
@@ -29,14 +29,21 @@ typedef struct __attribute__((packed)) Thunk {
Thunk
*
forward_to
(
Thunk
*
target
,
Thunk
*
thunk
);
struct
Thunk
*
updateI
(
Thunk
*
target
,
int
i
);
int
readI
(
Thunk
*
thunk
);
#ifdef DEBUG
struct
Thunk
*
updateB
(
Thunk
*
target
,
int
b
);
int
readI
(
Thunk
*
thunk
);
int
readB
(
Thunk
*
thunk
);
struct
Thunk
*
updateT
(
Thunk
*
target
,
Thunk
*
source
);
#else
#define readI(thunk) thunk->_int
#define readB(thunk) thunk->_bool
#endif
struct
Thunk
*
updateI
(
Thunk
*
target
,
int
i
);
struct
Thunk
*
updateB
(
Thunk
*
target
,
int
b
);
struct
Thunk
*
updateT
(
Thunk
*
target
,
Thunk
*
source
);
struct
Thunk
*
updateF
(
Thunk
*
target
,
Desc
*
f
);
bool
is_hnf
(
Thunk
*
thunk
);
...
...
precompiler/precompiler.icl
View file @
a9f0c3a6
...
...
@@ -14,7 +14,7 @@ from Text.Unicode.UChar import instance toChar UChar
import
System
.
CommandLine
import
System
.
File
::
VarType
=
Local
Int
|
Fun
String
::
VarType
=
Local
Int
Bool
|
Fun
String
::
Context
=
{
vars
::
Map
String
VarType
,
localcount
::
Int
...
...
@@ -22,15 +22,18 @@ import System.File
newContext
=
{
vars
=
newMap
,
localcount
=
0
}
registerArgs
vars
idx
[]
=
vars
registerArgs
vars
idx
[
v
:
vs
]
=
registerArgs
(
put
(
unpackVar
v
)
(
Local
idx
(
isStrictVar
v
))
vars
)
(
idx
+
1
)
vs
registerLocals
vars
idx
[]
=
vars
registerLocals
vars
idx
[
v
:
vs
]
=
registerLocals
(
put
(
unpackVar
v
)
(
Local
(
idx
+1
))
vars
)
(
idx
+
1
)
vs
registerLocals
vars
idx
[
v
:
vs
]
=
registerLocals
(
put
(
unpackVar
v
)
(
Local
idx
(
isStrictVar
v
))
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
Local
s
ctx
.
vars
0
params
,
localcount
=
length
params
}
#
ctx
=
{
ctx
&
vars
=
register
Arg
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
...
...
@@ -69,8 +72,9 @@ sSelectCase ctx (PDefault, expr) a
sVar
ctx
var
a
=
case
get
varName
ctx
.
vars
of
(
Just
(
Local
i
))
=
a
<++
"L"
<++
sNum
i
_
=
a
<++
"F"
<++
sText
varName
(
Just
(
Local
i
True
))
=
a
<++
"S"
<++
sNum
i
(
Just
(
Local
i
False
))
=
a
<++
"L"
<++
sNum
i
_
=
a
<++
"F"
<++
sText
varName
where
varName
=
unpackVar
var
...
...
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