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-compiler-and-rts
compiler
Commits
93a24b20
Commit
93a24b20
authored
May 15, 2001
by
clean
Browse files
changes for dynamic linking (not tested)
parent
89a8d39b
Changes
4
Hide whitespace changes
Inline
Side-by-side
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
);
GenNodeEntryDirective
(
arity
,
&
d_label
,
NULL
);
Gen
LazyRecord
NodeEntryDirective
(
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