Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
C
compiler
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
17
Issues
17
List
Boards
Labels
Service Desk
Milestones
Operations
Operations
Incidents
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
clean-compiler-and-rts
compiler
Commits
93a24b20
Commit
93a24b20
authored
May 15, 2001
by
clean
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
changes for dynamic linking (not tested)
parent
89a8d39b
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
696 additions
and
63 deletions
+696
-63
backendC/CleanCompilerSources/codegen1.c
backendC/CleanCompilerSources/codegen1.c
+82
-11
backendC/CleanCompilerSources/codegen2.c
backendC/CleanCompilerSources/codegen2.c
+430
-14
backendC/CleanCompilerSources/instructions.c
backendC/CleanCompilerSources/instructions.c
+180
-38
backendC/CleanCompilerSources/instructions.h
backendC/CleanCompilerSources/instructions.h
+4
-0
No files found.
backendC/CleanCompilerSources/codegen1.c
View file @
93a24b20
...
...
@@ -258,7 +258,10 @@ void BuildLazyTupleSelectorLabel (Label slab, int arity, int argnr)
void
BuildLazyTupleSelectorAndRemoveLabel
(
Label
slab
,
int
arity
,
int
argnr
)
{
if
(
argnr
>
NrOfGlobalSelectors
){
MakeLabel
(
slab
,
glob_selr
,
argnr
,
n_pref
);
#if 0
error_in_function ("BuildLazyTupleSelectorAndRemoveLabel");
#endif
}
else
MakeLabel
(
slab
,
glob_selr
,
argnr
,
n_pref
);
}
...
...
@@ -892,7 +895,7 @@ static void GenLazyRecordEntry (SymbDef rdef)
GenLazyRecordDescriptorAndExport
(
rdef
);
Gen
NodeEntryDirective
(
arity
,
&
d_label
,
NULL
);
Gen
LazyRecordNodeEntryDirective
(
arity
,
&
d_label
);
GenOAStackLayout
(
1
);
GenLabelDefinition
(
&
CurrentAltLabel
);
...
...
@@ -1222,7 +1225,7 @@ Bool NodeEntry (StateS *const function_state_p,int arity,Label ealab,SymbDef roo
GenNodeEntryDirective
(
arity
,
&
d_lab
,
ea_label_in_node_directive
);
GenOAStackLayout
(
1
);
GenLabelDefinition
(
&
n_lab
);
Gen
NodeEntry
LabelDefinition
(
&
n_lab
);
GenPushNode
(
ReduceError
,
arity
);
if
(
!
update_root_node
)
...
...
@@ -1380,7 +1383,7 @@ Bool NodeEntryUnboxed (StateS *const function_state_p,NodeP call_node_p,int args
GenNodeEntryDirective
(
args_a_size
,
&
d_lab
,
ea_label_in_node_directive
);
GenOAStackLayout
(
1
);
GenLabelDefinition
(
&
n_lab
);
Gen
NodeEntry
LabelDefinition
(
&
n_lab
);
if
(
args_b_size
!=
0
)
GenPushNodeU
(
ReduceError
,
args_a_size
,
args_b_size
);
else
...
...
@@ -1826,7 +1829,7 @@ static void GenerateCodeForLazyTupleSelectorEntry (int argnr)
GenPushArg
(
0
,
1
,
1
);
GenPushA
(
2
);
GenKeep
(
1
,
0
);
GenFill
(
&
ind_lab
,
-
2
,
&
indirection_lab
,
2
,
PartialFill
);
GenFill
(
&
ind_lab
,
-
2
,
&
indirection_lab
,
2
,
PartialFill
);
GenKeep
(
1
,
0
);
#if UPDATE_POP
GenUpdatePopA
(
0
,
1
);
...
...
@@ -1922,7 +1925,11 @@ ImpRuleP create_simple_imp_rule (NodeP lhs_root,NodeP rhs_root,SymbDefP function
return
imp_rule
;
}
SymbDef
CreateUpdateFunction
(
ArgS
*
record_arg
,
ArgS
*
first_field_arg
,
Node
node
)
SymbDef
CreateUpdateFunction
(
ArgS
*
record_arg
,
ArgS
*
first_field_arg
,
Node
node
#if UNBOX_UPDATE_FUNCTION_ARGUMENTS
,
int
unbox_record
#endif
)
{
static
char
update_function_name
[
16
];
SymbDef
update_function_sdef
;
...
...
@@ -1938,7 +1945,12 @@ SymbDef CreateUpdateFunction (ArgS *record_arg,ArgS *first_field_arg,Node node)
++
next_update_function_n
;
n_arguments
=
node
->
node_arity
;
record_state
=
node
->
node_symbol
->
symb_def
->
sdef_record_state
;
#if UNBOX_UPDATE_FUNCTION_ARGUMENTS
if
(
unbox_record
)
n_arguments
=
record_state
.
state_arity
;
#endif
update_function_ident
=
PutStringInHashTable
(
update_function_name
,
SymbolIdTable
);
update_function_sdef
=
MakeNewSymbolDefinition
(
CurrentModule
,
update_function_ident
,
n_arguments
,
IMPRULE
);
...
...
@@ -1957,14 +1969,72 @@ SymbDef CreateUpdateFunction (ArgS *record_arg,ArgS *first_field_arg,Node node)
update_function_symbol
=
NewSymbol
(
definition
);
update_function_symbol
->
symb_def
=
update_function_sdef
;
#if UNBOX_UPDATE_FUNCTION_ARGUMENTS
if
(
unbox_record
){
ArgS
**
lhs_new_fields_arg_p
,
**
lhs_old_fields_arg_p
,
*
lhs_new_fields_p
,
**
rhs_arg_p
;
int
field_number
;
lhs_root
=
NewNode
(
update_function_symbol
,
NULL
,
n_arguments
);
#if UPDATE_NODE_IN_STRICT_ENTRY
lhs_root
->
node_state
=
StrictState
;
#else
lhs_root
->
node_state
=
record_state
;
#endif
rhs_root
=
NewNode
(
node
->
node_symbol
,
NULL
,
n_arguments
);
#if UPDATE_NODE_IN_STRICT_ENTRY
rhs_root
->
node_state
=
StrictState
;
#else
rhs_root
->
node_state
=
record_state
;
#endif
rhs_root
->
node_number
=
0
;
lhs_old_fields_arg_p
=&
lhs_root
->
node_arguments
;
lhs_new_fields_arg_p
=&
lhs_new_fields_p
;
rhs_arg_p
=&
rhs_root
->
node_arguments
;
for
(
field_number
=
0
;
field_number
<
n_arguments
;
++
field_number
){
ArgS
*
rhs_arg
,
*
lhs_arg
;
NodeId
arg_node_id
;
StateS
*
state_p
;
state_p
=&
record_state
.
state_record_arguments
[
field_number
];
arg_node_id
=
NewNodeId
(
NULL
);
arg_node_id
->
nid_refcount
=-
2
;
lhs_arg
=
NewArgument
(
NewNodeIdNode
(
arg_node_id
));
lhs_arg
->
arg_state
=
LazyState
;
rhs_arg
=
NewArgument
(
NewNodeIdNode
(
arg_node_id
));
rhs_arg
->
arg_state
=*
state_p
;
*
rhs_arg_p
=
rhs_arg
;
rhs_arg_p
=&
rhs_arg
->
arg_next
;
if
(
first_field_arg
==
NULL
||
first_field_arg
->
arg_node
->
node_symbol
->
symb_def
->
sdef_sel_field_number
!=
field_number
){
*
lhs_old_fields_arg_p
=
lhs_arg
;
lhs_old_fields_arg_p
=&
lhs_arg
->
arg_next
;
lhs_arg
->
arg_state
=*
state_p
;
}
else
{
*
lhs_new_fields_arg_p
=
lhs_arg
;
lhs_new_fields_arg_p
=&
lhs_arg
->
arg_next
;
first_field_arg
=
first_field_arg
->
arg_next
;
}
}
*
lhs_old_fields_arg_p
=
lhs_new_fields_p
;
*
lhs_new_fields_arg_p
=
NULL
;
*
rhs_arg_p
=
NULL
;
}
else
#endif
{
NodeId
record_node_id
;
ArgS
*
lhs_record_arg
,
*
rhs_record_arg
,
**
lhs_arg_p
,
**
rhs_arg_p
;
record_node_id
=
NewNodeId
(
NULL
);
record_node_id
->
nid_refcount
=-
1
;
record_state
=
node
->
node_symbol
->
symb_def
->
sdef_record_state
;
lhs_record_arg
=
NewArgument
(
NewNodeIdNode
(
record_node_id
));
lhs_record_arg
->
arg_state
=
LazyState
;
...
...
@@ -2017,14 +2087,15 @@ SymbDef CreateUpdateFunction (ArgS *record_arg,ArgS *first_field_arg,Node node)
lhs_arg_p
=&
lhs_arg
->
arg_next
;
rhs_arg_p
=&
rhs_arg
->
arg_next
;
#if !UNBOX_UPDATE_FUNCTION_ARGUMENTS
field_node
->
node_arguments
->
arg_next
=
NULL
;
previous_arg
->
arg_next
=
arg
;
#endif
previous_arg
=
arg
;
}
#if !UNBOX_UPDATE_FUNCTION_ARGUMENTS
previous_arg
->
arg_next
=
NULL
;
#endif
*
lhs_arg_p
=
NULL
;
*
rhs_arg_p
=
NULL
;
}
...
...
backendC/CleanCompilerSources/codegen2.c
View file @
93a24b20
...
...
@@ -1565,6 +1565,8 @@ static void FillOrReduceSelectSymbol (Node node,int *asp_p,int *bsp_p,NodeId upd
GenFill1
(
&
tuple_lab
,
arity
,
*
asp_p
+
1
-
tupindex
,
bits
);
else
GenFill2
(
&
tuple_lab
,
arity
,
*
asp_p
+
1
-
tupindex
,
bits
);
GenKeep
(
*
asp_p
-
tupindex
,
0
);
}
else
{
GenPushArg
(
*
asp_p
-
tupindex
,
arity
,
argnr
);
*
asp_p
+=
1
;
...
...
@@ -2148,10 +2150,7 @@ static void FillSymbol (Node node,SymbDef sdef,int *asp_p,int *bsp_p,NodeId upda
DetermineSizeOfArguments
(
node
->
node_arguments
,
&
a_size
,
&
b_size
);
if
(
b_size
!=
0
)
BuildArgs
(
node
->
node_arguments
,
asp_p
,
bsp_p
,
code_gen_node_ids_p
);
else
BuildArgs
(
node
->
node_arguments
,
asp_p
,
bsp_p
,
code_gen_node_ids_p
);
BuildArgs
(
node
->
node_arguments
,
asp_p
,
bsp_p
,
code_gen_node_ids_p
);
#if OPTIMIZE_LAZY_TUPLE_RECURSION
if
(
update_node_id
!=
NULL
){
...
...
@@ -2438,7 +2437,7 @@ static void FillSymbol (Node node,SymbDef sdef,int *asp_p,int *bsp_p,NodeId upda
if
(
update_node_id
==
NULL
){
*
asp_p
+=
1
-
node
->
node_arity
;
GenBuildh
(
&
name
,
node
->
node_arity
);
GenBuild
PartialFunction
h
(
&
name
,
node
->
node_arity
);
}
else
{
GenFillh
(
&
name
,
node
->
node_arity
,
*
asp_p
-
update_node_id
->
nid_a_index
,
NormalFill
);
*
asp_p
-=
node
->
node_arity
;
...
...
@@ -2870,6 +2869,110 @@ void RemoveSelectorsFromUpdateNode (ArgS *previous_arg,ArgS *arg)
previous_arg
->
arg_next
=
NULL
;
}
#if UPDATE_RECORD_NOT_ON_TOP
void
UpdateRecordAndAddSelectorsToUpdateNode
(
ArgS
*
record_arg
,
ArgS
*
first_field_arg
,
StateS
*
field_states
,
int
record_a_size
,
int
record_b_size
,
int
*
n_a_elements_above_record_p
,
int
*
n_b_elements_above_record_p
)
{
ArgS
*
arg
,
*
previous_arg
;
int
a_offset
,
b_offset
,
arg_a_offset
,
arg_b_offset
,
previous_field_number
;
a_offset
=
0
;
b_offset
=
0
;
arg_a_offset
=
record_a_size
;
arg_b_offset
=
record_b_size
;
previous_field_number
=
0
;
previous_arg
=
record_arg
;
for_l
(
arg
,
first_field_arg
,
arg_next
){
int
field_number
,
arg_a_size
,
arg_b_size
;
Node
field_node
;
field_node
=
arg
->
arg_node
;
field_node
->
node_arguments
->
arg_next
=
NULL
;
field_number
=
field_node
->
node_symbol
->
symb_def
->
sdef_sel_field_number
;
while
(
field_number
!=
previous_field_number
){
AddSizeOfState
(
field_states
[
previous_field_number
],
&
a_offset
,
&
b_offset
);
++
previous_field_number
;
}
DetermineSizeOfState
(
field_states
[
field_number
],
&
arg_a_size
,
&
arg_b_size
);
while
(
arg_a_size
){
GenUpdateA
(
arg_a_offset
,
a_offset
);
++
arg_a_offset
;
++
a_offset
;
--
arg_a_size
;
}
while
(
arg_b_size
){
GenUpdateB
(
arg_b_offset
,
b_offset
);
++
arg_b_offset
;
++
b_offset
;
--
arg_b_size
;
}
++
previous_field_number
;
previous_arg
->
arg_next
=
arg
;
previous_arg
=
arg
;
}
previous_arg
->
arg_next
=
NULL
;
*
n_a_elements_above_record_p
=
arg_a_offset
-
record_a_size
;
*
n_b_elements_above_record_p
=
arg_b_offset
-
record_b_size
;
}
void
RemoveFieldsFromStackAfterUpdate
(
int
n_a_elements_above_record
,
int
n_b_elements_above_record
,
int
record_a_size
,
int
record_b_size
,
int
*
asp_p
,
int
*
bsp_p
)
{
if
(
n_a_elements_above_record
!=
0
){
int
arg_a_offset
,
a_offset
;
arg_a_offset
=
record_a_size
+
n_a_elements_above_record
;
a_offset
=
record_a_size
;
while
(
a_offset
>
0
){
--
a_offset
;
--
arg_a_offset
;
#if UPDATE_POP
if
(
a_offset
==
0
)
GenUpdatePopA
(
a_offset
,
arg_a_offset
);
else
#endif
GenUpdateA
(
a_offset
,
arg_a_offset
);
}
#if UPDATE_POP
if
(
record_a_size
==
0
)
#endif
GenPopA
(
arg_a_offset
);
*
asp_p
-=
arg_a_offset
;
}
if
(
n_b_elements_above_record
!=
0
){
int
arg_b_offset
,
b_offset
;
arg_b_offset
=
record_b_size
+
n_b_elements_above_record
;
b_offset
=
record_b_size
;
while
(
b_offset
>
0
){
--
b_offset
;
--
arg_b_offset
;
#if UPDATE_POP
if
(
b_offset
==
0
)
GenUpdatePopB
(
b_offset
,
arg_b_offset
);
else
#endif
GenUpdateB
(
b_offset
,
arg_b_offset
);
}
#if UPDATE_POP
if
(
record_b_size
==
0
)
#endif
GenPopB
(
arg_b_offset
);
*
bsp_p
-=
arg_b_offset
;
}
}
#else
void
UpdateNodeAndAddSelectorsToUpdateNode
(
ArgS
*
record_arg
,
ArgS
*
first_field_arg
,
StateS
*
field_states
,
int
record_a_size
,
int
record_b_size
,
int
*
asp_p
,
int
*
bsp_p
)
{
...
...
@@ -2960,15 +3063,16 @@ void UpdateNodeAndAddSelectorsToUpdateNode
*
bsp_p
-=
arg_b_offset
;
}
}
#endif
#ifdef DESTRUCTIVE_RECORD_UPDATES
void
compute_bits_and_add_selectors_to_update_node
static
void
compute_bits_and_add_selectors_to_update_node
(
ArgS
*
record_arg
,
ArgS
*
first_field_arg
,
StateS
*
field_states
,
int
record_a_size
,
int
record_b_size
,
char
bits
[],
int
*
n_a_fill_bits_p
,
int
*
n_b_fill_bits_p
)
{
ArgP
arg
,
previous_arg
;
int
a_offset
,
b_offset
,
previous_field_number
;
unsigned
int
a_bits
,
b_bits
,
n
,
arg_n
,
n_args
;
unsigned
int
a_bits
,
b_bits
,
n
;
int
n_a_fill_bits
,
n_b_fill_bits
;
a_bits
=
0
;
...
...
@@ -3037,6 +3141,41 @@ void compute_bits_and_add_selectors_to_update_node
}
#endif
#if UNBOX_UPDATE_FUNCTION_ARGUMENTS
static
void
remove_updated_fields_from_record
(
int
field_number
,
ArgP
field_arg
,
int
a_from_offset
,
int
b_from_offset
,
int
*
a_to_offset_p
,
int
*
b_to_offset_p
,
int
n_fields
,
StateP
field_states
)
{
if
(
field_number
<
n_fields
){
int
field_a_size
,
field_b_size
;
DetermineSizeOfState
(
field_states
[
field_number
],
&
field_a_size
,
&
field_b_size
);
a_from_offset
+=
field_a_size
;
b_from_offset
+=
field_b_size
;
if
(
field_arg
==
NULL
||
field_arg
->
arg_node
->
node_symbol
->
symb_def
->
sdef_sel_field_number
!=
field_number
){
remove_updated_fields_from_record
(
field_number
+
1
,
field_arg
,
a_from_offset
,
b_from_offset
,
a_to_offset_p
,
b_to_offset_p
,
n_fields
,
field_states
);
while
(
field_a_size
){
--
a_from_offset
;
--*
a_to_offset_p
;
if
(
a_from_offset
!=*
a_to_offset_p
)
GenUpdateA
(
a_from_offset
,
*
a_to_offset_p
);
--
field_a_size
;
}
while
(
field_b_size
){
--
b_from_offset
;
--*
b_to_offset_p
;
if
(
b_from_offset
!=*
b_to_offset_p
)
GenUpdateB
(
b_from_offset
,
*
b_to_offset_p
);
--
field_b_size
;
}
}
else
remove_updated_fields_from_record
(
field_number
+
1
,
field_arg
->
arg_next
,
a_from_offset
,
b_from_offset
,
a_to_offset_p
,
b_to_offset_p
,
n_fields
,
field_states
);
}
}
#endif
static
void
FillUpdateNode
(
Node
node
,
int
*
asp_p
,
int
*
bsp_p
,
NodeId
update_node_id
,
CodeGenNodeIdsP
code_gen_node_ids_p
)
{
ArgS
*
record_arg
,
*
first_field_arg
;
...
...
@@ -3150,24 +3289,42 @@ static void FillUpdateNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i
BuildArgs
(
node
->
node_arguments
,
asp_p
,
bsp_p
,
code_gen_node_ids_p
);
DetermineSizeOfState
(
*
record_node_id_state_p
,
&
record_a_size
,
&
record_b_size
);
#if UPDATE_RECORD_NOT_ON_TOP
{
int
n_a_elements_above_record
,
n_b_elements_above_record
;
UpdateRecordAndAddSelectorsToUpdateNode
(
record_arg
,
first_field_arg
,
record_node_id_state_p
->
state_record_arguments
,
record_a_size
,
record_b_size
,
&
n_a_elements_above_record
,
&
n_b_elements_above_record
);
#else
UpdateNodeAndAddSelectorsToUpdateNode
(
record_arg
,
first_field_arg
,
record_node_id_state_p
->
state_record_arguments
,
record_a_size
,
record_b_size
,
asp_p
,
bsp_p
);
#endif
if
(
update_node_id
==
NULL
){
BuildRecord
(
record_node_id_state_p
->
state_record_symbol
,
*
asp_p
,
*
bsp_p
,
*
asp_p
,
*
bsp_p
,
record_a_size
,
record_b_size
,
0
,
node
->
node_state
.
state_kind
==
SemiStrict
?
PartialFill
:
NormalFill
,
True
);
*
asp_p
+=
1
;
#if UPDATE_RECORD_NOT_ON_TOP
GenUpdateA
(
0
,
record_a_size
+
n_a_elements_above_record
);
#else
GenUpdateA
(
0
,
record_a_size
);
#endif
}
else
BuildRecord
(
record_node_id_state_p
->
state_record_symbol
,
*
asp_p
,
*
bsp_p
,
*
asp_p
,
*
bsp_p
,
record_a_size
,
record_b_size
,
*
asp_p
-
update_node_id
->
nid_a_index
,
node
->
node_state
.
state_kind
==
SemiStrict
?
PartialFill
:
NormalFill
,
False
);
#if UPDATE_RECORD_NOT_ON_TOP
GenPopA
(
record_a_size
+
n_a_elements_above_record
);
*
asp_p
-=
record_a_size
+
n_a_elements_above_record
;
GenPopB
(
record_b_size
+
n_b_elements_above_record
);
*
bsp_p
-=
record_b_size
+
n_b_elements_above_record
;
}
#else
GenPopA
(
record_a_size
);
*
asp_p
-=
record_a_size
;
GenPopB
(
record_b_size
);
*
bsp_p
-=
record_b_size
;
#endif
return
;
}
#else
...
...
@@ -3192,7 +3349,7 @@ static void FillUpdateNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i
if
(
!
FieldArgumentNodeStatesAreStricter
(
record_arg
->
arg_next
,
first_field_arg
,
record_states
))
update_immediately
=
0
;
else
{
else
{
ArgP
node_arg
,
field_arg
;
for_ll
(
node_arg
,
field_arg
,
record_arg
->
arg_next
,
first_field_arg
,
arg_next
,
arg_next
){
...
...
@@ -3220,23 +3377,41 @@ static void FillUpdateNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i
DetermineSizeOfState
(
*
record_node_id_state_p
,
&
record_a_size
,
&
record_b_size
);
#if UPDATE_RECORD_NOT_ON_TOP
{
int
n_a_elements_above_record
,
n_b_elements_above_record
;
UpdateRecordAndAddSelectorsToUpdateNode
(
record_arg
,
first_field_arg
,
record_node_id_state_p
->
state_record_arguments
,
record_a_size
,
record_b_size
,
&
n_a_elements_above_record
,
&
n_b_elements_above_record
);
#else
UpdateNodeAndAddSelectorsToUpdateNode
(
record_arg
,
first_field_arg
,
record_node_id_state_p
->
state_record_arguments
,
record_a_size
,
record_b_size
,
asp_p
,
bsp_p
);
#endif
if
(
update_node_id
==
NULL
){
BuildRecord
(
record_node_id_state_p
->
state_record_symbol
,
*
asp_p
,
*
bsp_p
,
*
asp_p
,
*
bsp_p
,
record_a_size
,
record_b_size
,
0
,
node
->
node_state
.
state_kind
==
SemiStrict
?
PartialFill
:
NormalFill
,
True
);
*
asp_p
+=
1
;
#if UPDATE_RECORD_NOT_ON_TOP
GenUpdateA
(
0
,
record_a_size
+
n_a_elements_above_record
);
#else
GenUpdateA
(
0
,
record_a_size
);
#endif
}
else
BuildRecord
(
record_node_id_state_p
->
state_record_symbol
,
*
asp_p
,
*
bsp_p
,
*
asp_p
,
*
bsp_p
,
record_a_size
,
record_b_size
,
*
asp_p
-
update_node_id
->
nid_a_index
,
node
->
node_state
.
state_kind
==
SemiStrict
?
PartialFill
:
NormalFill
,
False
);
#if UPDATE_RECORD_NOT_ON_TOP
GenPopA
(
record_a_size
+
n_a_elements_above_record
);
*
asp_p
-=
record_a_size
+
n_a_elements_above_record
;
GenPopB
(
record_b_size
+
n_b_elements_above_record
);
*
bsp_p
-=
record_b_size
+
n_b_elements_above_record
;
}
#else
GenPopA
(
record_a_size
);
*
asp_p
-=
record_a_size
;
GenPopB
(
record_b_size
);
*
bsp_p
-=
record_b_size
;
#endif
return
;
}
}
...
...
@@ -3245,9 +3420,242 @@ static void FillUpdateNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i
n_arguments
=
node
->
node_arity
;
#if UNBOX_UPDATE_FUNCTION_ARGUMENTS
if
(
update_node_id
==
NULL
){
ArgP
call_arg_p
,
lhs_arg_p
,
rhs_arg_p
,
*
call_arg_h
;
StateP
record_state_p
;
int
i
,
unbox_record
;
ImpRuleP
update_rule_p
;
NodeP
call_node_p
;
call_arg_p
=
node
->
node_arguments
;
unbox_record
=
call_arg_p
->
arg_node
->
node_kind
!=
NodeIdNode
?
call_arg_p
->
arg_node
->
node_state
.
state_type
==
RecordState
:
call_arg_p
->
arg_node
->
node_node_id
->
nid_state
.
state_type
==
RecordState
;
new_update_sdef
=
CreateUpdateFunction
(
record_arg
,
first_field_arg
,
node
,
unbox_record
);
update_rule_p
=
new_update_sdef
->
sdef_rule
;
lhs_arg_p
=
update_rule_p
->
rule_alts
->
alt_lhs_root
->
node_arguments
;
rhs_arg_p
=
update_rule_p
->
rule_alts
->
alt_rhs_root
->
node_arguments
;
i
=
0
;
record_state_p
=&
node
->
node_symbol
->
symb_def
->
sdef_record_state
;
if
(
unbox_record
){
int
record_size
,
n_old_fields
,
field_number
;
ArgP
field_arg_p
;
record_size
=
record_state_p
->
state_arity
;
n_old_fields
=
record_size
-
(
node
->
node_arity
-
1
);
call_node_p
=
NewNode
(
NULL
,
NULL
,
record_size
);
call_arg_h
=&
call_node_p
->
node_arguments
;
field_arg_p
=
first_field_arg
;
field_number
=
0
;
while
(
n_old_fields
){
if
(
field_arg_p
==
NULL
||
field_arg_p
->
arg_node
->
node_symbol
->
symb_def
->
sdef_sel_field_number
!=
field_number
){
StateP
arg_state_p
;
NodeP
new_node_p
;
ArgP
new_arg_p
;
new_node_p
=
NewNode
(
NULL
,
NULL
,
0
);
new_arg_p
=
NewArgument
(
new_node_p
);
arg_state_p
=&
record_state_p
->
state_record_arguments
[
field_number
];
new_arg_p
->
arg_state
=*
arg_state_p
;
new_node_p
->
node_state
=*
arg_state_p
;
lhs_arg_p
->
arg_state
=*
arg_state_p
;
update_rule_p
->
rule_state_p
[
i
]
=*
arg_state_p
;
*
call_arg_h
=
new_arg_p
;
call_arg_h
=&
new_arg_p
->
arg_next
;
lhs_arg_p
=
lhs_arg_p
->
arg_next
;
++
i
;
--
n_old_fields
;
}
else
field_arg_p
=
field_arg_p
->
arg_next
;
++
field_number
;
}
call_arg_p
->
arg_state
=*
record_state_p
;
call_arg_p
=
call_arg_p
->
arg_next
;
*
call_arg_h
=
call_arg_p
;
while
(
call_arg_p
!=
NULL
){
StateP
arg_state_p
;
while
(
rhs_arg_p
->
arg_node
->
node_node_id
!=
lhs_arg_p
->
arg_node
->
node_node_id
)
rhs_arg_p
=
rhs_arg_p
->
arg_next
;
if
(
call_arg_p
->
arg_node
->
node_kind
!=
NodeIdNode
)
arg_state_p
=&
call_arg_p
->
arg_node
->
node_state
;
else
arg_state_p
=&
call_arg_p
->
arg_node
->
node_node_id
->
nid_state
;
if
(
rhs_arg_p
->
arg_state
.
state_type
==
SimpleState
){
if
(
rhs_arg_p
->
arg_state
.
state_kind
==
OnB
&&
(
arg_state_p
->
state_type
==
SimpleState
&&
arg_state_p
->
state_kind
==
OnB
)){
call_arg_p
->
arg_state
=*
arg_state_p
;
lhs_arg_p
->
arg_state
=*
arg_state_p
;
update_rule_p
->
rule_state_p
[
i
]
=*
arg_state_p
;
}
else
if
(
!
IsLazyState
(
*
arg_state_p
)
&&
!
IsLazyStateKind
(
rhs_arg_p
->
arg_state
.
state_kind
)){
lhs_arg_p
->
arg_state
.
state_kind
=
StrictOnA
;
update_rule_p
->
rule_state_p
[
i
].
state_kind
=
StrictOnA
;
}
}
else
{
if
((
rhs_arg_p
->
arg_state
.
state_type
==
ArrayState
&&
arg_state_p
->
state_type
==
ArrayState
)
||
(
rhs_arg_p
->
arg_state
.
state_type
==
RecordState
&&
arg_state_p
->
state_type
==
RecordState
))
{
call_arg_p
->
arg_state
=*
arg_state_p
;
lhs_arg_p
->
arg_state
=*
arg_state_p
;
update_rule_p
->
rule_state_p
[
i
]
=*
arg_state_p
;
}
else
if
(
!
IsLazyState
(
*
arg_state_p
)){
lhs_arg_p
->
arg_state
.
state_kind
=
StrictOnA
;
update_rule_p
->
rule_state_p
[
i
].
state_kind
=
StrictOnA
;
}
}
call_arg_p
=
call_arg_p
->
arg_next
;
lhs_arg_p
=
lhs_arg_p
->
arg_next
;
rhs_arg_p
=
rhs_arg_p
->
arg_next
;
++
i
;
}
}
else
{
while
(
call_arg_p
!=
NULL
){
StateP
arg_state_p
;
if
(
call_arg_p
->
arg_node
->
node_kind
!=
NodeIdNode
)
arg_state_p
=&
call_arg_p
->
arg_node
->
node_state
;
else
arg_state_p
=&
call_arg_p
->
arg_node
->
node_node_id
->
nid_state
;
if
(
rhs_arg_p
->
arg_state
.
state_type
==
SimpleState
){
if
(
rhs_arg_p
->
arg_state
.
state_kind
==
OnB
&&
(
arg_state_p
->
state_type
==
SimpleState
&&
arg_state_p
->
state_kind
==
OnB
)){
call_arg_p
->
arg_state
=*
arg_state_p
;
lhs_arg_p
->
arg_state
=*
arg_state_p
;
update_rule_p
->
rule_state_p
[
i
]
=*
arg_state_p
;
}
else
if
(
!
IsLazyState
(
*
arg_state_p
)
&&
!
IsLazyStateKind
(
rhs_arg_p
->
arg_state
.
state_kind
)){
lhs_arg_p
->
arg_state
.
state_kind
=
StrictOnA
;
update_rule_p
->
rule_state_p
[
i
].
state_kind
=
StrictOnA
;
}
}
else
{
if
((
rhs_arg_p
->
arg_state
.
state_type
==
ArrayState
&&
arg_state_p
->
state_type
==
ArrayState
)
||
(
rhs_arg_p
->
arg_state
.
state_type
==
RecordState
&&
arg_state_p
->
state_type
==
RecordState
))
{
call_arg_p
->
arg_state
=*
arg_state_p
;
lhs_arg_p
->
arg_state
=*
arg_state_p
;
update_rule_p
->
rule_state_p
[
i
]
=*
arg_state_p
;
}
else
if
(
!
IsLazyState
(
*
arg_state_p
)){
lhs_arg_p
->
arg_state
.
state_kind
=
StrictOnA
;
update_rule_p
->
rule_state_p
[
i
].
state_kind
=
StrictOnA
;
}