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
66795043
Commit
66795043
authored
Mar 08, 2016
by
Laszlo Domoszlai
Browse files
fix another bunch of bugs
parent
effeac32
Changes
5
Hide whitespace changes
Inline
Side-by-side
interpreter/code.c
View file @
66795043
...
...
@@ -166,9 +166,9 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
if
(
heap_curr
>
gc_trigger
)
gc
();
int
root_frame_ptr_b
=
stack_top_b
;
while
(
1
)
{
{
assert
(
expr
!=
NULL
);
assert
(
stack_top_a
<
STACK_SIZE_A
);
assert
(
stack_top_b
<
STACK_SIZE_B
);
...
...
@@ -338,7 +338,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
{
Desc
*
slice
=
((
AppEntry
*
)
expr
)
->
f
;
Thunk
*
thunk
=
get_dst
(
root_frame_ptr
);
// no need to check for array length, thunks in HNF are never overwritten
int
newsize
=
slice
->
thunk_size
;
...
...
@@ -578,7 +578,7 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
case
CT_VAR
:
{
Thunk
*
thunk
=
local
(
frame_ptr
,
((
VarEntry
*
)
expr
)
->
index
);
assert
(
!
instackb
(
thunk
));
follow_thunk
(
thunk
);
...
...
@@ -774,9 +774,13 @@ void exec(Code* expr, int frame_ptr, int root_frame_ptr)
if
(
expr
!=
NULL
)
{
for
(
int
i
=
0
;
i
<
cons
->
desc
->
arity
;
i
++
)
{
push_a
(
cons
->
_args
[
i
]);
}
// Skip the arguments in the case of a default
if
(
!
(
select
->
default_map
&
1
<<
((
ADTEntry
*
)
cons
->
desc
)
->
idx
))
{
for
(
int
i
=
0
;
i
<
cons
->
desc
->
arity
;
i
++
)
{
push_a
(
cons
->
_args
[
i
]);
}
}
continue
;
}
...
...
interpreter/code.h
View file @
66795043
...
...
@@ -65,6 +65,9 @@ struct SelectEntry {
struct
Code
*
fallback
;
// how many arguments to be removed from the stack in the case of fallback
int
fallback_nrargs
;
// it tells which cases are default. in default cases ADT arguments are omitted
// from the stack, that's why it is important to know
int
default_map
;
union
{
...
...
interpreter/mem.c
View file @
66795043
...
...
@@ -48,12 +48,18 @@ void init_mem() {
void
*
alloc_desc
(
int
size
)
{
size
=
((
size
+
3
)
/
4
)
*
4
;
desc_alloc
+=
size
;
return
malloc
(
size
);
void
*
ret
=
malloc
(
size
);
assert
(
ret
!=
NULL
);
return
ret
;
}
void
*
alloc_code
(
int
size
)
{
code_alloc
+=
((
size
+
3
)
/
4
)
*
4
;
return
malloc
(
size
);
void
*
ret
=
malloc
(
size
);
assert
(
ret
!=
NULL
);
return
ret
;
}
#ifdef DEBUG
...
...
interpreter/parse.c
View file @
66795043
...
...
@@ -217,7 +217,7 @@ int parseDef1(char** ptr) {
int
fieldNameLength
;
if
(
!
parseInt
(
ptr
,
&
fieldNameLength
))
return
0
;
entry
->
fields
[
i
]
=
(
char
*
)
alloc_desc
(
fieldNameLength
);
entry
->
fields
[
i
]
=
(
char
*
)
alloc_desc
(
fieldNameLength
+
1
);
copyStringAndForward
(
entry
->
fields
[
i
],
ptr
,
fieldNameLength
);
}
...
...
@@ -560,7 +560,8 @@ SelectEntry* parseSelect(char **ptr, Code* fallback, int fallback_nrargs) {
{
entry
->
base
.
type
=
CT_SELECT_ADT
;
entry
->
base
.
nr_cases
=
nrConses
;
entry
->
default_map
=
0xFFFFFFFF
;
// set the default case for all the entries
for
(
int
i
=
0
;
i
<
nrConses
;
i
++
)
{
entry
->
bodies
[
i
]
=
defaultBody
;
...
...
@@ -570,12 +571,14 @@ SelectEntry* parseSelect(char **ptr, Code* fallback, int fallback_nrargs) {
nrCases
--
;
// firstCase
entry
->
bodies
[((
ADTEntry
*
)
firstCase
)
->
idx
]
=
firstBody
;
entry
->
default_map
&=
~
(
1
<<
((
ADTEntry
*
)
firstCase
)
->
idx
);
for
(
int
i
=
0
;
i
<
nrCases
;
i
++
)
{
(
*
ptr
)
++
;
// skip type
ADTEntry
*
nextCase
=
(
ADTEntry
*
)
parseFunName
(
ptr
);
entry
->
bodies
[
nextCase
->
idx
]
=
(
Code
*
)
parseSelectBody
(
ptr
,
child_fallback
,
child_fallback_base_nrargs
+
nextCase
->
base
.
arity
);
entry
->
default_map
&=
~
(
1
<<
nextCase
->
idx
);
}
}
else
...
...
interpreter/prim.c
View file @
66795043
...
...
@@ -308,7 +308,8 @@ void __S2I(int dst_idx) {
Thunk
*
target
=
get_dst
(
dst_idx
);
target
->
desc
=
(
Desc
*
)
__INT__
;
target
->
_int
=
strtol
(
buff
,
NULL
,
10
);
// use atol instead of strtol, the former overflows (Clen semantics), the latter returns MAX
target
->
_int
=
atol
(
buff
);
}
void
__string_size
(
int
dst_idx
)
...
...
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