aboutsummaryrefslogtreecommitdiff
path: root/backendC/CleanCompilerSources
diff options
context:
space:
mode:
Diffstat (limited to 'backendC/CleanCompilerSources')
-rw-r--r--backendC/CleanCompilerSources/codegen.c3
-rw-r--r--backendC/CleanCompilerSources/codegen.h5
-rw-r--r--backendC/CleanCompilerSources/codegen1.c27
-rw-r--r--backendC/CleanCompilerSources/codegen1.h3
-rw-r--r--backendC/CleanCompilerSources/codegen2.c479
-rw-r--r--backendC/CleanCompilerSources/codegen2.h68
-rw-r--r--backendC/CleanCompilerSources/codegen3.c378
-rw-r--r--backendC/CleanCompilerSources/optimisations.c480
-rw-r--r--backendC/CleanCompilerSources/optimisations.h1
9 files changed, 1169 insertions, 275 deletions
diff --git a/backendC/CleanCompilerSources/codegen.c b/backendC/CleanCompilerSources/codegen.c
index cc9e8a1..2505f5f 100644
--- a/backendC/CleanCompilerSources/codegen.c
+++ b/backendC/CleanCompilerSources/codegen.c
@@ -1,4 +1,5 @@
+
#define for_l(v,l,n) for(v=(l);v!=NULL;v=v->n)
#define SHARE_UPDATE_CODE 0 /* also in codegen1.c */
@@ -1186,7 +1187,7 @@ void CodeGeneration (ImpMod imod, char *fname)
OptimiseRules (imod->im_rules,imod->im_start);
ExitOnInterrupt();
#if 0
- PrintRules (imod->im_rules);
+ PrintRules (imod->im_rules,rules_file);
#endif
if (DoCode && !CompilerError){
ImpRuleS *rule;
diff --git a/backendC/CleanCompilerSources/codegen.h b/backendC/CleanCompilerSources/codegen.h
index 7719a4d..cc588f6 100644
--- a/backendC/CleanCompilerSources/codegen.h
+++ b/backendC/CleanCompilerSources/codegen.h
@@ -4,4 +4,7 @@ void EvalArgsEntry (StateS *const function_state_p,SymbDef rule_sdef,int maxasiz
void EvaluateAndMoveStateArguments (int state_arity,States states,int oldasp,int maxassize);
void EvaluateAndMoveArguments (int arity,StateP argstates,int *locasp_p,int *aselmts_p);
-extern int function_called_only_curried_or_lazy_with_one_return; \ No newline at end of file
+extern int function_called_only_curried_or_lazy_with_one_return;
+#if GENERATE_CODE_AGAIN
+ extern int call_code_generator_again;
+#endif
diff --git a/backendC/CleanCompilerSources/codegen1.c b/backendC/CleanCompilerSources/codegen1.c
index be5c51c..957dc78 100644
--- a/backendC/CleanCompilerSources/codegen1.c
+++ b/backendC/CleanCompilerSources/codegen1.c
@@ -3119,6 +3119,10 @@ void set_local_reference_counts_and_add_free_node_ids (NodeP case_node,NodeIdLis
node_id=node_id_ref_count_elem->nrcl_node_id;
local_ref_count=node_id_ref_count_elem->nrcl_ref_count;
+# if BOXED_RECORDS
+ node_id_ref_count_elem->nrcl_mark2=node_id->nid_mark2 & NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+# endif
+
# if 0
printf ("global_to_local_ %s %d %d ",node_id_name (node_id),node_id->nid_refcount,node_id_ref_count_elem->nrcl_ref_count);
# endif
@@ -3518,16 +3522,32 @@ static int generate_code_for_switch_node (NodeP node,int asp,int bsp,struct esc
{
need_next_alternative=1;
}
+#if BOXED_RECORDS
+ set_global_reference_counts_and_exchange_record_update_marks (case_node);
+#endif
} else {
+#if BOXED_RECORDS
+ ArgP arg2;
+
+ for_l (arg2,node->node_arguments,arg_next){
+ if (arg2->arg_node->node_kind==CaseNode && arg2->arg_node->node_number)
+ or_then_record_update_marks (case_node->node_node_id_ref_counts);
+ }
+#endif
if (generate_code_for_root_node
(case_node->node_arguments->arg_node,asp,bsp,&old_esc,case_node->node_node_defs,
result_state_p,&saved_node_id_states,ab_node_ids_p))
{
need_next_alternative=1;
}
+#if BOXED_RECORDS
+ set_global_reference_counts (case_node);
+#endif
}
+#if !BOXED_RECORDS
set_global_reference_counts (case_node);
+#endif
#if BUILD_FREE_NODE_ID_LIST_DURING_PATTER_MATCH
ab_node_ids_p->free_node_ids=old_free_node_ids;
}
@@ -3714,9 +3734,12 @@ static int generate_code_for_push_node (NodeP node,int asp,int bsp,struct esc *e
# ifdef DESTRUCTIVE_RECORD_UPDATES
else if (node->node_record_symbol->symb_kind==definition &&
node->node_record_symbol->symb_def->sdef_kind==RECORDTYPE &&
- (node_id_p->nid_mark2 & NID_HAS_REFCOUNT_WITHOUT_UPDATES)!=0 &&
+ (((node_id_p->nid_mark2 & NID_HAS_REFCOUNT_WITHOUT_UPDATES)!=0 &&
node_id_p->nid_number==-2)
- {
+# if BOXED_RECORDS
+ || (node_id_p->nid_mark2 & NID_RECORD_USED_BY_UPDATE)!=0
+# endif
+ )){
node_id_p->nid_number=-1;
if (b_size==0)
GenPushArgsU (asp-node_id_p->nid_a_index,a_size,a_size);
diff --git a/backendC/CleanCompilerSources/codegen1.h b/backendC/CleanCompilerSources/codegen1.h
index e3f6eec..a2ea483 100644
--- a/backendC/CleanCompilerSources/codegen1.h
+++ b/backendC/CleanCompilerSources/codegen1.h
@@ -111,9 +111,8 @@ extern SymbDef CreateUpdateFunction (ArgS *record_arg,ArgS *first_field_arg,Node
,int unbox_record
#endif
);
-#if U_RECORD_SELECTORS
+
extern SymbDef create_select_function (Symbol selector_symbol,int selector_kind);
-#endif
extern SymbDef create_match_function (struct symbol *constructor_symbol,int constructor_arity,int strict_constructor);
extern SymbDef create_select_and_match_function (struct symbol *constructor_symbol,int strict_constructor);
diff --git a/backendC/CleanCompilerSources/codegen2.c b/backendC/CleanCompilerSources/codegen2.c
index dd1c7d0..e1446a0 100644
--- a/backendC/CleanCompilerSources/codegen2.c
+++ b/backendC/CleanCompilerSources/codegen2.c
@@ -24,11 +24,11 @@
#include "sizes.h"
#include "checker.h"
#include "codegen_types.h"
+#include "statesgen.h"
#include "codegen.h"
#include "codegen1.h"
#include "codegen2.h"
#include "sa.h"
-#include "statesgen.h"
#include "transform.h"
#include "instructions.h"
#include "typechecker.h"
@@ -1173,6 +1173,30 @@ Bool CopyNodeIdArgument (StateS demstate,NodeId node_id,int *asp_p,int *bsp_p)
return CopyArgument (demstate,node_id->nid_state,a_index,b_index,asp_p,bsp_p,a_size,b_size,True);
}
+void PushField (StateS recstate,int fieldnr,int offset,int *asp_p,int *bsp_p,int *a_size_p,int *b_size_p)
+{
+ int apos,bpos,totasize,totbsize;
+
+ DetermineFieldSizeAndPositionAndRecordSize (fieldnr,a_size_p,b_size_p,&apos,&bpos,&totasize,&totbsize,&recstate);
+
+ GenPushRArgB (offset, totasize, totbsize, bpos+1, *b_size_p);
+ GenPushRArgA (offset, totasize, totbsize, apos+1, *a_size_p);
+ *bsp_p += *b_size_p;
+ *asp_p += *a_size_p;
+}
+
+void ReplaceRecordByField (StateS recstate,int fieldnr,int *asp_p,int *bsp_p,int *a_size_p,int *b_size_p)
+{
+ int apos,bpos,totasize,totbsize;
+
+ DetermineFieldSizeAndPositionAndRecordSize (fieldnr,a_size_p,b_size_p,&apos,&bpos,&totasize,&totbsize,&recstate);
+
+ GenPushRArgB (0, totasize, totbsize, bpos+1, *b_size_p);
+ GenReplRArgA ( totasize, totbsize, apos+1, *a_size_p);
+ *bsp_p += *b_size_p;
+ *asp_p += *a_size_p - 1;
+}
+
static void FillOrReduceFieldSelection (Node node,SymbDef seldef,int *asp_p,int *bsp_p,NodeId update_node_id,CodeGenNodeIdsP code_gen_node_ids_p)
{
Node arg_node;
@@ -1209,9 +1233,16 @@ static void FillOrReduceFieldSelection (Node node,SymbDef seldef,int *asp_p,int
BuildArg (arg,asp_p,bsp_p,code_gen_node_ids_p);
record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state;
-
+#if BOXED_RECORDS
+ if (arg->arg_state.state_type==SimpleState){
+ if (node->node_arity<SELECTOR_L)
+ PushField (*record_state_p,fieldnr,0,asp_p,bsp_p,&asize,&bsize);
+ else
+ ReplaceRecordByField (*record_state_p,fieldnr,asp_p,bsp_p,&asize,&bsize);
+ } else {
+#endif
DetermineFieldSizeAndPosition (fieldnr,&asize,&bsize,&aindex,&bindex,record_state_p->state_record_arguments);
-
+
if (node->node_arity<SELECTOR_L){
int n;
@@ -1228,6 +1259,9 @@ static void FillOrReduceFieldSelection (Node node,SymbDef seldef,int *asp_p,int
DetermineSizeOfState (*record_state_p,&record_a_size,&record_b_size);
ReplaceRecordOnTopOfStackByField (asp_p,bsp_p,aindex,bindex,asize,bsize,record_a_size,record_b_size);
}
+#if BOXED_RECORDS
+ }
+#endif
} else {
int a_size,b_size,apos,bpos,record_a_size,record_b_size,n;
StateS tuple_state,tuple_state_arguments[2],*record_state_p;
@@ -1237,9 +1271,24 @@ static void FillOrReduceFieldSelection (Node node,SymbDef seldef,int *asp_p,int
record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state;
- DetermineFieldSizeAndPositionAndRecordSize (fieldnr,&a_size,&b_size,&apos,&bpos,&record_a_size,&record_b_size,record_state_p);
+ tuple_state.state_type=TupleState;
+ tuple_state.state_arity=2;
+ tuple_state.state_tuple_arguments=tuple_state_arguments;
- CopyNodeIdArgument (*record_state_p,arg_node_id,asp_p,bsp_p);
+ tuple_state_arguments[0]=record_state_p->state_record_arguments[fieldnr];
+
+ CopyNodeIdArgument (arg->arg_state,arg_node_id,asp_p,bsp_p);
+
+#if BOXED_RECORDS
+ if (arg->arg_state.state_type==SimpleState){
+ PushField (*record_state_p,fieldnr,0,asp_p,bsp_p,&a_size,&b_size);
+
+ tuple_state_arguments[1]=arg->arg_state;
+
+ CoerceArgumentOnTopOfStack (asp_p,bsp_p,tuple_state,node->node_state,1+a_size,b_size);
+ } else {
+#endif
+ DetermineFieldSizeAndPositionAndRecordSize (fieldnr,&a_size,&b_size,&apos,&bpos,&record_a_size,&record_b_size,record_state_p);
for (n=0; n<a_size; ++n)
GenPushA (apos+a_size-1);
@@ -1249,15 +1298,12 @@ static void FillOrReduceFieldSelection (Node node,SymbDef seldef,int *asp_p,int
GenPushB (bpos+b_size-1);
*bsp_p+=b_size;
- tuple_state.state_type=TupleState;
- tuple_state.state_arity=2;
- tuple_state.state_tuple_arguments=tuple_state_arguments;
-
- tuple_state_arguments[0]=record_state_p->state_record_arguments[fieldnr];
tuple_state_arguments[1]=*record_state_p;
CoerceArgumentOnTopOfStack (asp_p,bsp_p,tuple_state,node->node_state,record_a_size+a_size,record_b_size+b_size);
-
+#if BOXED_RECORDS
+ }
+#endif
decrement_reference_count_of_node_id (arg_node_id,&code_gen_node_ids_p->free_node_ids);
}
}
@@ -1297,14 +1343,19 @@ static void FillOrReduceFieldSelection (Node node,SymbDef seldef,int *asp_p,int
BuildOrFillLazyFieldSelector (seldef,node->node_state.state_kind,asp_p,update_node_id);
} else {
int asize,bsize,apos,bpos,tot_asize,tot_bsize;
-
+ StateP record_state_p;
+#if 1
+ record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state;
+#else
+ record_state_p=&arg->arg_state;
+#endif
Build (arg_node,asp_p,bsp_p,code_gen_node_ids_p);
- DetermineFieldSizeAndPositionAndRecordSize (fieldnr,&asize,&bsize,&apos,&bpos,&tot_asize,&tot_bsize,&arg->arg_state);
- CoerceArgumentOnTopOfStack (asp_p,bsp_p,arg->arg_state,arg_node->node_state,tot_asize,tot_bsize);
+ DetermineFieldSizeAndPositionAndRecordSize (fieldnr,&asize,&bsize,&apos,&bpos,&tot_asize,&tot_bsize,record_state_p);
+ CoerceArgumentOnTopOfStack (asp_p,bsp_p,*record_state_p,arg_node->node_state,tot_asize,tot_bsize);
ReplaceRecordOnTopOfStackByField (asp_p,bsp_p,apos,bpos,asize,bsize,tot_asize,tot_bsize);
- CoerceArgumentOnTopOfStack (asp_p,bsp_p,node->node_state,arg->arg_state.state_record_arguments[fieldnr],asize,bsize);
+ CoerceArgumentOnTopOfStack (asp_p,bsp_p,node->node_state,record_state_p->state_record_arguments[fieldnr],asize,bsize);
}
} else {
StateS recstate;
@@ -1358,18 +1409,49 @@ static void FillOrReduceFieldSelection (Node node,SymbDef seldef,int *asp_p,int
#ifdef DO_LAZY_SELECTORS_FROM_BOXED_STRICT_RECORDS
if ((recstate.state_kind==StrictOnA || recstate.state_kind==StrictRedirection) && update_node_id==NULL){
int asize,bsize,apos,bpos,tot_asize,tot_bsize,recindex;
+ SymbDef record_sdef;
StateP record_state_p,field_state_p;
recindex = arg_node_id->nid_a_index;
- record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state;
+ record_sdef=seldef->sdef_type->type_lhs->ft_symbol->symb_def;
+ record_state_p=&record_sdef->sdef_record_state;
if (record_state_p->state_type!=RecordState)
error_in_function ("FillOrReduceFieldSelection");
DetermineFieldSizeAndPositionAndRecordSize (fieldnr,&asize,&bsize,&apos,&bpos,&tot_asize,&tot_bsize,record_state_p);
-
- GenPushRArgB (*asp_p-recindex,tot_asize,tot_bsize,bpos+1,bsize);
- GenPushRArgA (*asp_p-recindex,tot_asize,tot_bsize,apos+1,asize);
+# if BOXED_RECORDS
+ if (record_sdef->sdef_boxed_record && (arg_node_id->nid_mark2 & (NID_RECORD_USED_BY_UPDATE | NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES))==NID_RECORD_USED_BY_UPDATE
+ &&
+# if 1
+ ((
+ (arg_node_id->nid_state.state_mark & STATE_UNIQUE_MASK)!=0
+/*
+ &&
+ (arg_node_id->nid_refcount==-2 || ((arg_node_id->nid_mark2 & NID_HAS_REFCOUNT_WITHOUT_UPDATES)!=0 && arg_node_id->nid_number== -1))
+*/
+ )
+ ||
+ ((arg_node_id->nid_mark2 & NID_SELECTION_NODE_ID)==0
+ ? (arg_node_id->nid_refcount>=0 && arg_node_id->nid_node->node_kind==NodeIdNode &&
+ (arg_node_id->nid_node->node_node_id->nid_mark2 & (NID_SELECTION_NODE_ID | NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES))==NID_SELECTION_NODE_ID)
+ : (arg_node_id->nid_mark2 & (NID_SELECTION_NODE_ID | NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES))==NID_SELECTION_NODE_ID
+ )
+ )
+# else
+ ((arg_node_id->nid_mark2 & NID_SELECTION_NODE_ID)==0
+ ? (arg_node_id->nid_refcount>=0 && arg_node_id->nid_node->node_kind==NodeIdNode &&
+ (arg_node_id->nid_node->node_node_id->nid_mark & NID_SHARED_SELECTION_NODE_ID)==0)
+ : (arg_node_id->nid_mark & NID_SHARED_SELECTION_NODE_ID)==0)
+# endif
+ ){
+ GenPushRArgU (*asp_p-recindex,tot_asize,tot_bsize,apos+1,asize,bpos+1,bsize);
+ } else
+# endif
+ {
+ GenPushRArgB (*asp_p-recindex,tot_asize,tot_bsize,bpos+1,bsize);
+ GenPushRArgA (*asp_p-recindex,tot_asize,tot_bsize,apos+1,asize);
+ }
*asp_p+=asize;
*bsp_p+=bsize;
@@ -1390,13 +1472,12 @@ static void FillOrReduceFieldSelection (Node node,SymbDef seldef,int *asp_p,int
}
} else {
int a_size,b_size,apos, bpos, tot_asize, tot_bsize,recindex;
+ SymbDef record_sdef;
/* the selector is strict but the record is not */
recindex = arg_node_id->nid_a_index;
- DetermineFieldSizeAndPositionAndRecordSize (fieldnr,&a_size,&b_size,&apos, &bpos,&tot_asize,&tot_bsize,&arg->arg_state);
-
if (ResultIsNotInRootNormalForm (recstate)){
GenJsrEval (*asp_p-recindex);
ChangeEvalStatusKindToStrictOnA (arg_node_id,code_gen_node_ids_p->saved_nid_state_l);
@@ -1404,15 +1485,54 @@ static void FillOrReduceFieldSelection (Node node,SymbDef seldef,int *asp_p,int
recstate.state_kind = StrictOnA;
}
- GenPushRArgB (*asp_p-recindex, tot_asize, tot_bsize, bpos+1,b_size);
- GenPushRArgA (*asp_p-recindex, tot_asize, tot_bsize, apos+1,a_size);
+ record_sdef=seldef->sdef_type->type_lhs->ft_symbol->symb_def;
+ DetermineFieldSizeAndPositionAndRecordSize (fieldnr,&a_size,&b_size,&apos, &bpos,&tot_asize,&tot_bsize,
+#if 1
+ &record_sdef->sdef_record_state);
+#else
+ &arg->arg_state);
+#endif
+# if BOXED_RECORDS
+ if (record_sdef->sdef_boxed_record && (arg_node_id->nid_mark2 & (NID_RECORD_USED_BY_UPDATE | NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES))==NID_RECORD_USED_BY_UPDATE
+ &&
+# if 1
+ ((
+ (arg_node_id->nid_state.state_mark & STATE_UNIQUE_MASK)!=0
+/* &&
+ (arg_node_id->nid_refcount==-2 || ((arg_node_id->nid_mark2 & NID_HAS_REFCOUNT_WITHOUT_UPDATES)!=0 && arg_node_id->nid_number== -1))
+*/
+ )
+ ||
+ ((arg_node_id->nid_mark2 & NID_SELECTION_NODE_ID)==0
+ ? (arg_node_id->nid_refcount>=0 && arg_node_id->nid_node->node_kind==NodeIdNode &&
+ (arg_node_id->nid_node->node_node_id->nid_mark2 & (NID_SELECTION_NODE_ID | NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES))==NID_SELECTION_NODE_ID)
+ : (arg_node_id->nid_mark2 & (NID_SELECTION_NODE_ID | NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES))==NID_SELECTION_NODE_ID
+ )
+ )
+# else
+ ((arg_node_id->nid_mark2 & NID_SELECTION_NODE_ID)==0
+ ? (arg_node_id->nid_refcount>=0 && arg_node_id->nid_node->node_kind==NodeIdNode &&
+ (arg_node_id->nid_node->node_node_id->nid_mark & NID_SHARED_SELECTION_NODE_ID)==0)
+ : (arg_node_id->nid_mark & NID_SHARED_SELECTION_NODE_ID)==0)
+# endif
+ ){
+ GenPushRArgU (*asp_p-recindex,tot_asize,tot_bsize,apos+1,a_size,bpos+1,b_size);
+ } else
+# endif
+ {
+ GenPushRArgB (*asp_p-recindex, tot_asize, tot_bsize, bpos+1,b_size);
+ GenPushRArgA (*asp_p-recindex, tot_asize, tot_bsize, apos+1,a_size);
+ }
*asp_p+=a_size;
*bsp_p+=b_size;
- recstate = arg->arg_state.state_record_arguments [fieldnr];
- CoerceArgumentOnTopOfStack (asp_p,bsp_p, node->node_state, recstate,a_size,b_size);
-
+ CoerceArgumentOnTopOfStack (asp_p,bsp_p, node->node_state,
+#if 1
+ record_sdef->sdef_record_state.state_record_arguments [fieldnr],a_size,b_size);
+#else
+ arg->arg_state.state_record_arguments [fieldnr],a_size,b_size);
+#endif
decrement_reference_count_of_node_id (arg_node_id,&code_gen_node_ids_p->free_node_ids);
}
}
@@ -2055,7 +2175,6 @@ void DetermineSizeOfArguments (ArgS *args,int *a_offset_p,int *b_offset_p)
AddSizeOfState (arg->arg_state,a_offset_p,b_offset_p);
}
-static void BuildLazyArgs (Args args,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen_node_ids_p);
static Bool BuildNonParArgs (Args args,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen_node_ids_p);
static void BuildParArgs (ArgS* args,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen_node_ids_p);
static void ReorderParallelAndNonParallelArgsWithResultNode (Args args,int *asize_p,int *bsize_p);
@@ -2522,8 +2641,11 @@ static void build_strict_then_or_else (Node then_or_else_node,Node else_node,int
} else {
NodeId nid;
int a_size,b_size;
-
+
nid=then_or_else_node->node_node_id;
+#if BOXED_RECORDS
+ nid->nid_mark2 |= NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+#endif
DetermineSizeOfState (nid->nid_state,&a_size,&b_size);
CopyArgument (result_state,nid->nid_state,nid->nid_a_index,nid->nid_b_index,asp_p,bsp_p,a_size,b_size,True);
}
@@ -3230,7 +3352,7 @@ void UpdateNodeAndAddSelectorsToUpdateNode
#endif
#ifdef DESTRUCTIVE_RECORD_UPDATES
-static void compute_bits_and_add_selectors_to_update_node
+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)
{
@@ -3284,19 +3406,11 @@ static void compute_bits_and_add_selectors_to_update_node
bits[0]='0';
- for (n=0; n<record_a_size; ++n){
- if (a_bits & (1<<n))
- bits[n+1]='1';
- else
- bits[n+1]='0';
- }
+ for (n=0; n<record_a_size; ++n)
+ bits[n+1]='0' + ((a_bits>>n) & 1);
- for (n=0; n<record_b_size; ++n){
- if (b_bits & (1<<n))
- bits[n+record_a_size+1]='1';
- else
- bits[n+record_a_size+1]='0';
- }
+ for (n=0; n<record_b_size; ++n)
+ bits[n+record_a_size+1]='0' + ((b_bits>>n) & 1);
bits[record_a_size+record_b_size+1]='\0';
@@ -3374,6 +3488,127 @@ static void adjust_state_of_unbox_update_function_argument (ArgP call_arg_p,ArgP
}
#endif
+int is_unique_record_update (NodeIdP record_node_id,NodeP record_node)
+{
+ NodeP selector_node_p;
+
+ if (!DoReuseUniqueNodes)
+ return 0;
+#if 0
+ printf ("is_unique_record_update\n");
+#endif
+
+ if ((record_node_id->nid_state.state_mark & STATE_UNIQUE_MASK)!=0 &&
+#if 1
+ (
+ ((record_node_id->nid_mark2 & (NID_RECORD_USED_BY_UPDATE | NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES))==NID_RECORD_USED_BY_UPDATE
+ && record_node_id->nid_refcount==-2)
+ ||
+ ((record_node_id->nid_mark2 & NID_HAS_REFCOUNT_WITHOUT_UPDATES)!=0 && record_node_id->nid_number== -1)
+ ) &&
+#else
+ (record_node_id->nid_mark2 & NID_HAS_REFCOUNT_WITHOUT_UPDATES)!=0 &&
+ record_node_id->nid_number== -1 &&
+#endif
+ record_node_id->nid_state.state_type==SimpleState &&
+ record_node_id->nid_state.state_kind==StrictOnA)
+ {
+ return 1;
+ }
+
+# if 1
+# if 0
+ printf ("%d %d %d %d\n",record_node_id->nid_state.state_type==SimpleState,record_node_id->nid_mark2,record_node_id->nid_mark,record_node_id->nid_refcount);
+# endif
+ if (record_node_id->nid_state.state_type==SimpleState && (record_node_id->nid_mark2 & (NID_RECORD_USED_BY_UPDATE | NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES))==NID_RECORD_USED_BY_UPDATE){
+# if 0
+ printf ("is_unique_record_update 2\n");
+# endif
+ selector_node_p=record_node;
+
+ if ((record_node_id->nid_mark2 & NID_SELECTION_NODE_ID)==0){
+ if (record_node_id->nid_refcount==1 && record_node_id->nid_node->node_kind==NodeIdNode){
+# if 0
+ printf ("is_unique_record_update_3 %d %d %d\n",record_node_id->nid_mark2,record_node_id->nid_mark,record_node_id->nid_refcount);
+# endif
+ selector_node_p=record_node_id->nid_node;
+ record_node_id=selector_node_p->node_node_id;
+# if 0
+ printf ("is_unique_record_update 3 %d %d %d\n",record_node_id->nid_mark2,record_node_id->nid_mark,record_node_id->nid_refcount);
+# endif
+ } else {
+# if 0
+ printf ("is_unique_record_update 4 %d %d %d\n",record_node_id->nid_mark2,record_node_id->nid_mark,record_node_id->nid_refcount);
+# endif
+ if (record_node_id->nid_refcount>=0 && record_node_id->nid_node->node_kind==NodeIdNode){
+ record_node_id=record_node_id->nid_node->node_node_id;
+# if 0
+ printf ("is_unique_record_update_4 %d %d %d\n",record_node_id->nid_mark2,record_node_id->nid_mark,record_node_id->nid_refcount);
+# endif
+ }
+ return 0;
+ }
+ }
+
+ if ((record_node_id->nid_mark2 & (NID_SELECTION_NODE_ID | NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES))==NID_SELECTION_NODE_ID
+
+ && ((record_node_id->nid_mark & NID_SHARED_SELECTION_NODE_ID)==0 || record_node_id->nid_refcount==0)
+# if 0
+ && (record_node_id->nid_mark & NID_SHARED_SELECTION_NODE_ID)==0
+# endif
+ ){
+# if 0
+ printf ("UpdateNode NodeId NID_UNSHARED_SELECTION_NODE_ID\n");
+# endif
+ if (selector_node_p->node_arguments->arg_node->node_kind==NodeIdNode){
+ NodeIdP tuple_node_id;
+# if 0
+ printf ("UpdateNode sel NodeIdNode\n");
+# endif
+ tuple_node_id=selector_node_p->node_arguments->arg_node->node_node_id;
+
+# if 0
+ if (tuple_node_id->nid_node_def->def_node->node_kind==TupleSelectorsNode)
+ printf ("UpdateNode sel TupleSelectorsNode %d\n",record_node_id->nid_number);
+# endif
+ if (tuple_node_id->nid_node->node_kind==NormalNode && tuple_node_id->nid_node->node_symbol->symb_kind==definition){
+ StateP tuple_result_state_p;
+
+ switch (tuple_node_id->nid_node->node_symbol->symb_def->sdef_kind){
+ case IMPRULE:
+# if 0
+ printf ("UpdateNode sel IMPRULE\n");
+# endif
+ tuple_result_state_p=&tuple_node_id->nid_node->node_symbol->symb_def->sdef_rule->rule_state_p[-1];
+ break;
+ case DEFRULE:
+ case SYSRULE:
+# if 0
+ printf ("UpdateNode sel DEFRULE or SYSRULE\n");
+# endif
+ tuple_result_state_p=&tuple_node_id->nid_node->node_symbol->symb_def->sdef_rule_type->rule_type_state_p[-1];
+ break;
+ default:
+ return 0;
+ }
+
+ if (tuple_result_state_p->state_type==TupleState
+ && (tuple_result_state_p->state_tuple_arguments[record_node_id->nid_number].state_mark & STATE_UNIQUE_MASK)!=0)
+ {
+# if 0
+ printf ("UpdateNode * sel RULE\n");
+# endif
+ return 1;
+ }
+ }
+ }
+ }
+ }
+#endif
+
+ return 0;
+}
+
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;
@@ -3482,24 +3717,25 @@ static void FillUpdateNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i
}
if (update_immediately){
- if (node->node_state.state_kind==StrictOnA && record_node->node_kind==NodeIdNode){
+#if 1
+ BuildArgs (record_arg->arg_next,asp_p,bsp_p,code_gen_node_ids_p);
+#endif
+ if (record_node->node_kind==NodeIdNode){
NodeIdP record_node_id;
record_node_id=record_node->node_node_id;
- if ((record_node_id->nid_state.state_mark & STATE_UNIQUE_MASK)!=0 &&
- (record_node_id->nid_mark2 & NID_HAS_REFCOUNT_WITHOUT_UPDATES)!=0 &&
- record_node_id->nid_number== -1 &&
- record_node_id->nid_state.state_type==SimpleState &&
- record_node_id->nid_state.state_kind==StrictOnA &&
- update_node_id==NULL)
- {
+ if (is_unique_record_update (record_node_id,record_node) && update_node_id==NULL){
int n_a_fill_bits,n_b_fill_bits;
char bits[MaxNodeArity+2];
LabDef record_lab;
+#if BOXED_RECORDS
+ record_node_id->nid_mark2 |= NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+#endif
+#if 0
BuildArgs (record_arg->arg_next,asp_p,bsp_p,code_gen_node_ids_p);
-
+#endif
DetermineSizeOfState (*record_state_p,&record_a_size,&record_b_size);
compute_bits_and_add_selectors_to_update_node (record_arg,first_field_arg,
@@ -3523,14 +3759,20 @@ static void FillUpdateNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i
return;
}
+# if BOXED_RECORDS
+ record_node_id->nid_mark2 |= NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+# endif
}
#else
if (update_immediately){
#endif
- record_arg->arg_state=*record_state_p;
+ record_arg->arg_state=*record_state_p;
+#if 1
+ BuildArg (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);
-
+#endif
DetermineSizeOfState (*record_state_p,&record_a_size,&record_b_size);
#if UPDATE_RECORD_NOT_ON_TOP
@@ -3779,9 +4021,13 @@ static void FillUpdateNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i
} else {
#if UPDATE_RECORD_NOT_ON_TOP
int n_a_elements_above_record,n_b_elements_above_record;
+#endif
+
+#if BOXED_RECORDS
+ node->node_arguments->arg_state=node->node_symbol->symb_def->sdef_record_state;
#endif
BuildArgs (node->node_arguments,asp_p,bsp_p,code_gen_node_ids_p);
-
+
DetermineSizeOfState (node->node_state,&record_a_size,&record_b_size);
#if UPDATE_RECORD_NOT_ON_TOP
UpdateRecordAndAddSelectorsToUpdateNode (record_arg,first_field_arg,
@@ -4003,9 +4249,7 @@ void FillMatchNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_id,CodeGe
#ifdef REUSE_UNIQUE_NODES
# if GENERATE_CODE_AGAIN
-extern int call_code_generator_again;
-
-static void restore_removed_arguments (ArgP *arg_h,ArgP removed_args,unsigned int argument_overwrite_bits,int node_arity)
+void restore_removed_arguments (ArgP *arg_h,ArgP removed_args,unsigned int argument_overwrite_bits,int node_arity)
{
int arg_n;
ArgP not_removed_args;
@@ -4026,11 +4270,10 @@ static void restore_removed_arguments (ArgP *arg_h,ArgP removed_args,unsigned in
}
# endif
-static
#if GENERATE_CODE_AGAIN
- ArgP
+ ArgP
#else
- void
+ void
#endif
compute_bits_and_remove_unused_arguments_for_strict_node (NodeP node,char bits[],unsigned int argument_overwrite_bits,
int *a_size_p,int *b_size_p,int *n_a_fill_bits_p,int *n_b_fill_bits_p)
@@ -4103,12 +4346,10 @@ static
#endif
}
-
-static
#if GENERATE_CODE_AGAIN
- ArgP
+ ArgP
#else
- void
+ void
#endif
compute_bits_and_remove_unused_arguments (NodeP node,char bits[],unsigned int argument_overwrite_bits,unsigned int *n_args_p)
{
@@ -4543,7 +4784,9 @@ void BuildArg (Args arg,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen_node_ids_
NodeId arg_node_id;
arg_node_id=node->node_node_id;
-
+#if BOXED_RECORDS
+ arg_node_id->nid_mark2 |= NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+#endif
if (CopyNodeIdArgument (arg->arg_state,arg_node_id,asp_p,bsp_p))
ChangeEvalStatusKindToStrictOnA (arg_node_id,code_gen_node_ids_p->saved_nid_state_l);
@@ -4692,6 +4935,9 @@ static Bool BuildNonParArgs (Args args,int *asp_p,int *bsp_p,CodeGenNodeIdsP cod
} else {
ArgComment (args);
+#if BOXED_RECORDS
+ arg_node_id->nid_mark2 |= NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+#endif
if (CopyNodeIdArgument (args->arg_state,arg_node_id,asp_p,bsp_p))
ChangeEvalStatusKindToStrictOnA (arg_node_id,code_gen_node_ids_p->saved_nid_state_l);
@@ -4902,7 +5148,7 @@ void BuildArgs (Args args,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen_node_id
}
}
-static void BuildLazyArgs (Args args,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen_node_ids_p)
+void BuildLazyArgs (Args args,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen_node_ids_p)
{
if (args==NULL)
return;
@@ -5255,11 +5501,14 @@ static int FillNodeDefs (NodeDefs nds,int node_id_number,int *asp_p,int *bsp_p,N
NodeId node_id;
node_id=tuple_node->node_node_id;
+#if BOXED_RECORDS
+ node_id->nid_mark2 |= NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+#endif
if (CopyNodeIdArgument (tuple_node->node_arguments->arg_state,node_id,asp_p,bsp_p))
ChangeEvalStatusKindToStrictOnA (node_id,code_gen_node_ids_p->saved_nid_state_l);
tuple_state_p=&tuple_node->node_arguments->arg_state;
-
+
decrement_reference_count_of_node_id (node_id,&code_gen_node_ids_p->free_node_ids);
}
@@ -5352,10 +5601,16 @@ static int FillNodeDefs (NodeDefs nds,int node_id_number,int *asp_p,int *bsp_p,N
#ifdef DO_LAZY_SELECTORS_FROM_BOXED_STRICT_RECORDS
if (result_state_p->state_type==SimpleState && result_state_p->state_kind==OnA && !ResultIsNotInRootNormalForm (node_id->nid_state))
result_state_p->state_kind=StrictOnA;
-#endif
+#endif
+#if BOXED_RECORDS
+ if (node_id->nid_refcount>1)
+ node_id->nid_mark2 |= NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+#endif
if (CopyNodeIdArgument (*result_state_p,node_id,asp_p,bsp_p))
ChangeEvalStatusKindToStrictOnA (node_id,code_gen_node_ids_p->saved_nid_state_l);
-
+# if 0
+ printf ("decrement_reference_count_of_node_id %d\n",node_id->nid_refcount);
+# endif
decrement_reference_count_of_node_id (node_id,&code_gen_node_ids_p->free_node_ids);
}
} else
@@ -5733,41 +5988,31 @@ static void AdjustStacksAndJumpToThenOrElseLabel
}
if (asp==else_asp && bsp - else_bsp - bsize == 0){
-#if 1
if (falselab==next_label && asp==then_asp && bsp-bsize==then_bsp){
GenJmpTrue (truelab);
truelab->lab_mod=NULL;
- } else
-#endif
- {
+ } else {
GenJmpFalse (falselab);
falselab->lab_mod=NULL;
UpdateStackPointers (asp, bsp-bsize, then_asp, then_bsp);
-#if 1
- if (truelab!=next_label)
-#endif
- {
+
+ if (truelab!=next_label){
GenJmp (truelab);
truelab->lab_mod=NULL;
}
}
} else if (asp==then_asp && bsp - then_bsp - bsize == 0){
-#if 1
if (truelab==next_label && asp==else_asp && bsp-bsize==else_bsp){
GenJmpTrue (falselab);
falselab->lab_mod=NULL;
- } else
-#endif
- {
+ } else {
GenJmpTrue (truelab);
truelab->lab_mod=NULL;
UpdateStackPointers (asp, bsp-bsize, else_asp, else_bsp);
-#if 1
- if (falselab!=next_label)
-#endif
- {
+
+ if (falselab!=next_label){
GenJmp (falselab);
falselab->lab_mod=NULL;
}
@@ -5785,10 +6030,7 @@ static void AdjustStacksAndJumpToThenOrElseLabel
GenLabelDefinition (&loclab);
UpdateStackPointers (asp, bsp-bsize, else_asp, else_bsp);
-#if 1
- if (falselab!=next_label)
-#endif
- {
+ if (falselab!=next_label){
GenJmp (falselab);
falselab->lab_mod=NULL;
}
@@ -5802,8 +6044,12 @@ void EvaluateCondition (Node cond_node,int *asp_p,int *bsp_p,CodeGenNodeIdsP cod
{
NodeId nid;
int boolean_b_size;
-
+
nid=cond_node->node_node_id;
+
+#if BOXED_RECORDS
+ nid->nid_mark2 |= NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+#endif
CopyNodeIdArgument (resultstate,nid,asp_p,bsp_p);
decrement_reference_count_of_node_id (nid,&code_gen_node_ids_p->free_node_ids);
@@ -5851,7 +6097,9 @@ void subtract_else_ref_counts (struct node_id_ref_count_list *else_node_id_ref_c
int ref_count;
node_id=else_node_id_ref_count->nrcl_node_id;
-
+#if BOXED_RECORDS
+ else_node_id_ref_count->nrcl_mark2=node_id->nid_mark2 & NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+#endif
ref_count=node_id->nid_refcount;
if (ref_count>=0){
ref_count -= else_node_id_ref_count->nrcl_ref_count;
@@ -5877,8 +6125,17 @@ void add_else_ref_counts (struct node_id_ref_count_list *else_node_id_ref_counts
for_l (else_node_id_ref_count,else_node_id_ref_counts,nrcl_next){
struct node_id *node_id;
-
+#if BOXED_RECORDS
+ unsigned int node_id_mark2;
+#endif
node_id=else_node_id_ref_count->nrcl_node_id;
+
+#if BOXED_RECORDS
+ node_id_mark2=node_id->nid_mark2;
+ node_id->nid_mark2=(node_id_mark2 & ~NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES) | else_node_id_ref_count->nrcl_mark2;
+ else_node_id_ref_count->nrcl_mark2=node_id_mark2 & NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+#endif
+
if (node_id->nid_refcount>=0)
node_id->nid_refcount += else_node_id_ref_count->nrcl_ref_count;
else
@@ -5886,10 +6143,20 @@ void add_else_ref_counts (struct node_id_ref_count_list *else_node_id_ref_counts
}
}
+#if BOXED_RECORDS
+void or_then_record_update_marks (struct node_id_ref_count_list *else_node_id_ref_counts)
+{
+ struct node_id_ref_count_list *else_node_id_ref_count;
+
+ for_l (else_node_id_ref_count,else_node_id_ref_counts,nrcl_next)
+ else_node_id_ref_count->nrcl_node_id->nid_mark2 |= else_node_id_ref_counts->nrcl_mark2;
+}
+#endif
+
static void EvaluateThenOrElsePartOfCondition
(NodeDefs defs,Node node,int asp,int bsp,StateS resultstate, Label truelab, Label falselab,Label next_label,
int then_asp,int then_bsp,int else_asp,int else_bsp,NodeIdListElementP a_node_ids,NodeIdListElementP b_node_ids,
- struct node_id_ref_count_list *else_node_id_ref_counts,NodeIdListElementP free_node_ids);
+ NodeIdListElementP free_node_ids);
void BranchOnCondition (Node condnode,int asp,int bsp,CodeGenNodeIdsP code_gen_node_ids_p, StateS resultstate,
Label truelab,Label falselab,Label next_label,int then_asp,int then_bsp,int else_asp,int else_bsp)
@@ -5957,13 +6224,23 @@ void BranchOnCondition (Node condnode,int asp,int bsp,CodeGenNodeIdsP code_gen_n
new_then_asp, new_then_bsp, new_else_asp, new_else_bsp);
if (!thenlabel){
+ NodeIdListElementP free_node_ids;
+
if (thenlab.lab_mod==NULL)
GenLabelDefinition (&thenlab);
+ free_node_ids=code_gen_node_ids_p->free_node_ids;
+
+ if (condnode->node_else_node_id_ref_counts!=NULL)
+ subtract_else_ref_counts (condnode->node_else_node_id_ref_counts,&free_node_ids);
+
EvaluateThenOrElsePartOfCondition (condnode->node_then_node_defs,
condpart->arg_next->arg_node, asp,bsp,resultstate,truelab,falselab,!elselabel ? &elselab : next_label,
then_asp,then_bsp,else_asp,else_bsp,code_gen_node_ids_p->a_node_ids,code_gen_node_ids_p->b_node_ids,
- condnode->node_else_node_id_ref_counts,code_gen_node_ids_p->free_node_ids);
+ free_node_ids);
+
+ if (condnode->node_else_node_id_ref_counts!=NULL)
+ add_else_ref_counts (condnode->node_else_node_id_ref_counts);
}
if (!elselabel){
@@ -5973,8 +6250,14 @@ void BranchOnCondition (Node condnode,int asp,int bsp,CodeGenNodeIdsP code_gen_n
EvaluateThenOrElsePartOfCondition (condnode->node_else_node_defs,
condpart->arg_next->arg_next->arg_node,asp,bsp,resultstate,truelab,falselab,next_label,
then_asp,then_bsp,else_asp,else_bsp,code_gen_node_ids_p->a_node_ids,code_gen_node_ids_p->b_node_ids,
- NULL,code_gen_node_ids_p->free_node_ids);
+ code_gen_node_ids_p->free_node_ids);
}
+
+#if BOXED_RECORDS
+ if (!thenlabel && condnode->node_else_node_id_ref_counts)
+
+ or_then_record_update_marks (condnode->node_else_node_id_ref_counts);
+#endif
break;
}
default:
@@ -5985,7 +6268,7 @@ void BranchOnCondition (Node condnode,int asp,int bsp,CodeGenNodeIdsP code_gen_n
static void EvaluateThenOrElsePartOfCondition
(NodeDefs defs,Node node,int asp,int bsp,StateS resultstate, Label truelab, Label falselab,Label next_label,
int then_asp,int then_bsp,int else_asp,int else_bsp,NodeIdListElementP a_node_ids,NodeIdListElementP b_node_ids,
- struct node_id_ref_count_list *else_node_id_ref_counts,NodeIdListElementP free_node_ids)
+ NodeIdListElementP free_node_ids)
{
SavedNidStateP saved_node_id_states;
MovedNodeIdP moved_node_ids;
@@ -5994,9 +6277,6 @@ static void EvaluateThenOrElsePartOfCondition
saved_node_id_states=NULL;
moved_node_ids=NULL;
- if (else_node_id_ref_counts!=NULL)
- subtract_else_ref_counts (else_node_id_ref_counts,&free_node_ids);
-
code_gen_node_ids.free_node_ids=free_node_ids;
code_gen_node_ids.saved_nid_state_l=&saved_node_id_states;
code_gen_node_ids.doesnt_fail=False;
@@ -6011,9 +6291,6 @@ static void EvaluateThenOrElsePartOfCondition
BranchOnCondition (node,asp,bsp,&code_gen_node_ids,resultstate,truelab,falselab,next_label,then_asp,then_bsp,else_asp,else_bsp);
restore_saved_node_id_states (saved_node_id_states);
-
- if (else_node_id_ref_counts!=NULL)
- add_else_ref_counts (else_node_id_ref_counts);
}
void InitCoding (void)
diff --git a/backendC/CleanCompilerSources/codegen2.h b/backendC/CleanCompilerSources/codegen2.h
index a6eb383..39f0456 100644
--- a/backendC/CleanCompilerSources/codegen2.h
+++ b/backendC/CleanCompilerSources/codegen2.h
@@ -6,6 +6,25 @@ typedef
{ NormalFill, ReleaseAndFill, PartialFill
} FillKind;
+typedef enum {
+ AToA, AToB, BToA, BToB, Reduce,AToRoot, MayBecomeCyclicSpine, CyclicSpine
+} Coercions;
+
+STRUCT (moved_node_id,MovedNodeId){
+ struct node_id * mnid_node_id;
+ struct moved_node_id * mnid_next;
+ int mnid_a_stack_offset;
+};
+
+STRUCT (code_gen_node_ids,CodeGenNodeIds){
+ struct saved_nid_state **saved_nid_state_l;
+ struct node_id_list_element *free_node_ids;
+ struct moved_node_id **moved_node_ids_l;
+ struct node_id_list_element *a_node_ids;
+ struct node_id_list_element *b_node_ids;
+ int doesnt_fail;
+};
+
extern StateS OnAState;
extern LabDef BasicDescriptors [];
extern unsigned NewLabelNr;
@@ -38,24 +57,29 @@ extern void PackArgument (StateS argstate,int aindex,int bindex,int asp,int bsp,
extern void save_node_id_state (NodeId node_id,struct saved_nid_state **ifrule);
extern void restore_saved_node_id_states (struct saved_nid_state *saved_node_id_states);
-typedef enum {
- AToA, AToB, BToA, BToB, Reduce,AToRoot, MayBecomeCyclicSpine, CyclicSpine
-} Coercions;
-
-STRUCT (moved_node_id,MovedNodeId){
- struct node_id * mnid_node_id;
- struct moved_node_id * mnid_next;
- int mnid_a_stack_offset;
-};
-
-STRUCT (code_gen_node_ids,CodeGenNodeIds){
- struct saved_nid_state **saved_nid_state_l;
- struct node_id_list_element *free_node_ids;
- struct moved_node_id **moved_node_ids_l;
- struct node_id_list_element *a_node_ids;
- struct node_id_list_element *b_node_ids;
- int doesnt_fail;
-};
+#if GENERATE_CODE_AGAIN
+extern ArgP
+#else
+extern void
+#endif
+ compute_bits_and_remove_unused_arguments (NodeP node,char bits[],unsigned int argument_overwrite_bits,unsigned int *n_args_p);
+#if GENERATE_CODE_AGAIN
+extern ArgP
+#else
+extern void
+#endif
+ compute_bits_and_remove_unused_arguments_for_strict_node (NodeP node,char bits[],unsigned int argument_overwrite_bits,
+ int *a_size_p,int *b_size_p,int *n_a_fill_bits_p,int *n_b_fill_bits_p);
+#if GENERATE_CODE_AGAIN
+extern void restore_removed_arguments (ArgP *arg_h,ArgP removed_args,unsigned int argument_overwrite_bits,int node_arity);
+#endif
+
+#ifdef DESTRUCTIVE_RECORD_UPDATES
+extern 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);
+#endif
+int is_unique_record_update (NodeIdP record_node_id,NodeP record_node);
Coercions CoerceStateKind (StateKind dem_state_kind, StateKind off_state_kind);
void GenReduceError (void);
@@ -69,6 +93,7 @@ int get_b_index_of_unpacked_lhs_node (ArgS *arg);
void decrement_reference_count_of_node_id (struct node_id *node_id,NodeIdListElementS **free_node_ids_l);
void BuildArgs (Args args,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen_node_ids_p);
+void BuildLazyArgs (Args args,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen_node_ids_p);
void build_and_cleanup (Node node,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen_node_ids_p);
#define RECORD_N_PREF c_pref
@@ -85,6 +110,9 @@ void Build (Node node,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen_node_ids_p)
Coercions CoerceSimpleStateArgument (StateS demstate,StateKind offkind,int aindex,int *asp_p,Bool leaveontop, Bool *ontop);
void subtract_else_ref_counts (struct node_id_ref_count_list *else_node_id_ref_counts,NodeIdListElementS **free_node_ids_l);
void add_else_ref_counts (struct node_id_ref_count_list *else_node_id_ref_counts);
+#if BOXED_RECORDS
+ void or_then_record_update_marks (struct node_id_ref_count_list *else_node_id_ref_counts);
+#endif
void EvaluateCondition (Node cond_node,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen_node_ids_p,StateS resultstate);
void DetermineFieldSizeAndPositionAndRecordSize
(int fieldnr,int *asize_p,int *bsize_p,int *apos_p,int *bpos_p,int *rec_asize_p,int *rec_bsize_p,StateS *record_state_p);
@@ -114,4 +142,6 @@ void cleanup_stack
void ChangeEvalStatusKindToStrictOnA (NodeId node_id,SavedNidStateS **saved_nid_state_l);
#if OPTIMIZE_LAZY_TUPLE_RECURSION
void FillNodeOnACycle (Node node,int *asp_p,int *bsp_p,NodeId update_node_id,CodeGenNodeIdsP code_gen_node_ids_p);
-#endif \ No newline at end of file
+#endif
+void PushField (StateS recstate,int fieldnr,int offset,int *asp_p,int *bsp_p,int *a_size_p,int *b_size_p);
+void ReplaceRecordByField (StateS recstate,int fieldnr,int *asp_p,int *bsp_p,int *a_size_p,int *b_size_p);
diff --git a/backendC/CleanCompilerSources/codegen3.c b/backendC/CleanCompilerSources/codegen3.c
index 0402a8c..c055041 100644
--- a/backendC/CleanCompilerSources/codegen3.c
+++ b/backendC/CleanCompilerSources/codegen3.c
@@ -17,6 +17,8 @@
#include "comsupport.h"
#include "codegen_types.h"
+#include "statesgen.h"
+#include "optimisations.h"
#include "codegen.h"
#include "codegen1.h"
#include "codegen2.h"
@@ -688,26 +690,18 @@ static void CodeRootSelection (Node root, NodeId rootid,int asp,int bsp,CodeGenN
static int CodeRhsNodeDefsAndRestoreNodeIdStates (Node root_node,NodeDefs defs,int asp,int bsp,StateS resultstate,struct esc *esc_p,
NodeIdListElementP a_node_ids,NodeIdListElementP b_node_ids,
- struct node_id_ref_count_list *else_node_id_ref_counts,int doesnt_fail)
+ NodeIdListElementP free_node_ids,int doesnt_fail)
{
SavedNidStateP saved_node_id_states;
- NodeIdListElementP free_node_ids;
int need_next_alternative;
saved_node_id_states=NULL;
- free_node_ids=NULL;
-
- if (else_node_id_ref_counts!=NULL)
- subtract_else_ref_counts (else_node_id_ref_counts,&free_node_ids);
-
+
need_next_alternative=CodeRhsNodeDefs (root_node,defs,asp,bsp,&saved_node_id_states,resultstate,esc_p,a_node_ids,b_node_ids,
free_node_ids,doesnt_fail);
restore_saved_node_id_states (saved_node_id_states);
- if (else_node_id_ref_counts!=NULL)
- add_else_ref_counts (else_node_id_ref_counts);
-
return need_next_alternative;
}
@@ -928,18 +922,6 @@ static void CodeNormalRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenN
}
}
-static void PushField (StateS recstate,int fieldnr,int offset,int *asp_p,int *bsp_p,int *a_size_p,int *b_size_p)
-{
- int apos,bpos,totasize,totbsize;
-
- DetermineFieldSizeAndPositionAndRecordSize (fieldnr,a_size_p,b_size_p,&apos,&bpos,&totasize,&totbsize,&recstate);
-
- GenPushRArgB (offset, totasize, totbsize, bpos+1, *b_size_p);
- GenPushRArgA (offset, totasize, totbsize, apos+1, *a_size_p);
- *bsp_p += *b_size_p;
- *asp_p += *a_size_p;
-}
-
static void CodeRootFieldSelector (Node root,NodeId rootid,int asp,int bsp,CodeGenNodeIdsP code_gen_node_ids_p,StateS demstate)
{
int fieldnr;
@@ -976,19 +958,31 @@ static void CodeRootFieldSelector (Node root,NodeId rootid,int asp,int bsp,CodeG
if (arg_node->node_kind!=NodeIdNode){
StateS offstate;
+ StateP record_state_p;
offstate = arg_node->node_state;
Build (arg_node,&asp,&bsp,code_gen_node_ids_p);
+ record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state;
+
if (root->node_arity>=SELECTOR_U){
int record_a_size,record_b_size,asize,bsize,aindex,bindex,offstate_a_size,offstate_b_size;
- StateP record_state_p;
-
- record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state;
-
+
DetermineSizeOfState (offstate,&offstate_a_size,&offstate_b_size);
CoerceArgumentOnTopOfStack (&asp,&bsp,arg->arg_state,offstate,offstate_a_size,offstate_b_size);
+#if BOXED_RECORDS
+ if (arg->arg_state.state_type==SimpleState){
+ if (root->node_arity<SELECTOR_L){
+ PushField (*record_state_p,fieldnr,0,&asp,&bsp,&asize,&bsize);
+ RedirectResultAndReturn (asp,bsp,asp,bsp,root->node_state,demstate,1+asize,bsize);
+ } else {
+ ReplaceRecordByField (*record_state_p,fieldnr,&asp,&bsp,&asize,&bsize);
+ DetermineSizeOfState (root->node_state,&offstate_a_size,&offstate_b_size);
+ RedirectResultAndReturn (asp,bsp,asp,bsp,root->node_state,demstate,offstate_a_size,offstate_b_size);
+ }
+ } else {
+#endif
DetermineFieldSizeAndPositionAndRecordSize (fieldnr,&asize,&bsize,&aindex,&bindex,&record_a_size,&record_b_size,record_state_p);
if (root->node_arity<SELECTOR_L){
@@ -1008,7 +1002,9 @@ static void CodeRootFieldSelector (Node root,NodeId rootid,int asp,int bsp,CodeG
DetermineSizeOfState (root->node_state,&offstate_a_size,&offstate_b_size);
RedirectResultAndReturn (asp,bsp,asp,bsp,root->node_state,demstate,offstate_a_size,offstate_b_size);
}
-
+#if BOXED_RECORDS
+ }
+#endif
return;
}
@@ -1023,9 +1019,13 @@ static void CodeRootFieldSelector (Node root,NodeId rootid,int asp,int bsp,CodeG
return;
} else {
int a_size,b_size;
-
+#if 1
+ PushField (*record_state_p, fieldnr, 0, & asp, & bsp,&a_size,&b_size);
+ RedirectResultAndReturn (asp,bsp,asp,bsp,record_state_p->state_record_arguments[fieldnr],demstate,a_size,b_size);
+#else
PushField (arg->arg_state, fieldnr, 0, & asp, & bsp,&a_size,&b_size);
RedirectResultAndReturn (asp,bsp,asp,bsp,arg->arg_state.state_record_arguments[fieldnr],demstate,a_size,b_size);
+#endif
return;
}
} else {
@@ -1079,14 +1079,21 @@ static void CodeRootFieldSelector (Node root,NodeId rootid,int asp,int bsp,CodeG
} else {
Bool ontop;
int a_size,b_size;
+ StateP record_state_p;
+ record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state;
if (root->node_arity>=SELECTOR_U){
int asize,bsize,aindex,bindex,offered_a_size,offered_b_size;
- StateP record_state_p;
- record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state;
CopyNodeIdArgument (arg->arg_state,arg_node_id,&asp,&bsp);
-
+#if BOXED_RECORDS
+ if (arg->arg_state.state_type==SimpleState){
+ if (root->node_arity<SELECTOR_L)
+ PushField (*record_state_p,fieldnr,0,&asp,&bsp,&asize,&bsize);
+ else
+ ReplaceRecordByField (*record_state_p,fieldnr,&asp,&bsp,&asize,&bsize);
+ } else {
+#endif
DetermineFieldSizeAndPosition (fieldnr,&asize,&bsize,&aindex,&bindex,record_state_p->state_record_arguments);
if (root->node_arity<SELECTOR_L){
@@ -1105,17 +1112,22 @@ static void CodeRootFieldSelector (Node root,NodeId rootid,int asp,int bsp,CodeG
DetermineSizeOfState (*record_state_p,&record_a_size,&record_b_size);
ReplaceRecordOnTopOfStackByField (&asp,&bsp,aindex,bindex,asize,bsize,record_a_size,record_b_size);
}
-
+#if BOXED_RECORDS
+ }
+#endif
DetermineSizeOfState (root->node_state,&offered_a_size,&offered_b_size);
RedirectResultAndReturn (asp,bsp,asp,bsp,root->node_state,demstate,offered_a_size,offered_b_size);
return;
}
CoerceSimpleStateArgument (demstate, offstate.state_kind,arg_node_id->nid_a_index,&asp,False,&ontop);
-
+#if 1
+ PushField (*record_state_p,fieldnr,asp-arg_node_id->nid_a_index,&asp,&bsp,&a_size,&b_size);
+ RedirectResultAndReturn (asp, bsp, asp, bsp,record_state_p->state_record_arguments[fieldnr],demstate,a_size,b_size);
+#else
PushField (arg->arg_state,fieldnr,asp-arg_node_id->nid_a_index,&asp,&bsp,&a_size,&b_size);
-
RedirectResultAndReturn (asp, bsp, asp, bsp,arg->arg_state.state_record_arguments[fieldnr],demstate,a_size,b_size);
+#endif
return;
}
}
@@ -1200,24 +1212,85 @@ static void CodeRootUpdateNode (Node root,NodeId rootid,int asp,int bsp,CodeGenN
first_field_arg=record_arg->arg_next;
RemoveSelectorsFromUpdateNode (record_arg,first_field_arg);
-
- /* BuildNewStackFrame (record_arg,asp,bsp,False,code_gen_node_ids_p); */
-
+
+#if 1
+ BuildArgs (record_arg->arg_next,&asp,&bsp,code_gen_node_ids_p);
+#endif
+
+ if (IsSimpleState (root->node_state) && record_arg->arg_node->node_kind==NodeIdNode){
+ NodeIdP record_node_id;
+
+ record_node_id=record_arg->arg_node->node_node_id;
+
+ if (is_unique_record_update (record_node_id,record_arg->arg_node) && rootid==NULL){
+/*
+ if ((record_node_id->nid_state.state_mark & STATE_UNIQUE_MASK)!=0 &&
+ (record_node_id->nid_mark2 & NID_HAS_REFCOUNT_WITHOUT_UPDATES)!=0 &&
+ record_node_id->nid_number== -1 &&
+ record_node_id->nid_state.state_type==SimpleState &&
+ record_node_id->nid_state.state_kind==StrictOnA &&
+ !DoReuseUniqueNodes && rootid==NULL)
+ {
+*/ int n_a_fill_bits,n_b_fill_bits;
+ char bits[MaxNodeArity+2];
+ LabDef record_lab;
+
+#if BOXED_RECORDS
+ record_node_id->nid_mark2 |= NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+#endif
+ DetermineSizeOfState (record_sdef->sdef_record_state,&record_a_size,&record_b_size);
+
+ if (record_a_size+record_b_size>2){
+#if 0
+ BuildArgs (record_arg->arg_next,&asp,&bsp,code_gen_node_ids_p);
+#endif
+ compute_bits_and_add_selectors_to_update_node (record_arg,first_field_arg,
+ record_sdef->sdef_record_state.state_record_arguments,record_a_size,record_b_size,
+ bits,&n_a_fill_bits,&n_b_fill_bits);
+
+ ConvertSymbolToRLabel (&record_lab,record_sdef->sdef_record_state.state_record_symbol);
+
+ GenPushA (asp-record_node_id->nid_a_index);
+ asp+=1;
+
+ GenFill3R (&record_lab,record_a_size,record_b_size,asp,bits+1);
+
+ asp-=n_a_fill_bits+1;
+ bsp-=n_b_fill_bits;
+
+ decrement_reference_count_of_node_id (record_node_id,&code_gen_node_ids_p->free_node_ids);
+
+ GenPopA (asp);
+ GenPopB (bsp);
+ GenRtn (1,0,OnAState);
+ return;
+ }
+ }
+#if BOXED_RECORDS
+ record_node_id->nid_mark2 |= NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+#endif
+ }
+
{
int a_size,b_size;
+ StateP record_state_p;
+
+ record_state_p=&root->node_symbol->symb_def->sdef_record_state;
+ record_arg->arg_state=*record_state_p;
+#if 1
+ BuildArg (record_arg,&asp,&bsp,code_gen_node_ids_p);
+#else
BuildArgs (record_arg,&asp,&bsp,code_gen_node_ids_p);
+#endif
DetermineSizeOfArguments (record_arg,&a_size,&b_size);
UpdateAAndBStack (asp,bsp,a_size,b_size,&asp,&bsp);
- }
+
+ /* BuildNewStackFrame (record_arg,asp,bsp,False,code_gen_node_ids_p); */
if (IsSimpleState (root->node_state)){
LabDef record_label;
- StateP record_state_p;
-/* error_in_function ("CodeRootUpdateNode"); */
-
- record_state_p=&root->node_symbol->symb_def->sdef_record_state;
DetermineSizeOfState (*record_state_p,&record_a_size,&record_b_size);
UpdateNodeAndAddSelectorsToUpdateNode (record_arg,first_field_arg,
@@ -1240,12 +1313,130 @@ static void CodeRootUpdateNode (Node root,NodeId rootid,int asp,int bsp,CodeGenN
GenRtn (record_a_size,record_b_size,result_state);
}
}
+
+ }
}
#ifdef CLEAN2
extern int contains_fail (NodeP node_p);
#endif
+static void fill_strict_root_unique_node (NodeP node,NodeP update_node,char bits[],LabDef *label_p,NodeIdP free_unique_node_id,int asp,int bsp,CodeGenNodeIdsP code_gen_node_ids_p)
+{
+ int a_size,b_size,n_a_fill_bits,n_b_fill_bits;
+#if GENERATE_CODE_AGAIN
+ ArgP removed_args=
+#endif
+ compute_bits_and_remove_unused_arguments_for_strict_node (node,bits,update_node->node_arguments->arg_occurrence,
+ &a_size,&b_size,&n_a_fill_bits,&n_b_fill_bits);
+
+ BuildArgs (node->node_arguments,&asp,&bsp,code_gen_node_ids_p);
+
+#if GENERATE_CODE_AGAIN
+ if (call_code_generator_again)
+ restore_removed_arguments (&node->node_arguments,removed_args,update_node->node_arguments->arg_occurrence,node->node_arity);
+#endif
+
+ GenPushA (asp-free_unique_node_id->nid_a_index);
+ asp+=1;
+
+ GenFill3R (label_p,a_size,b_size,asp,bits+1);
+
+ asp-=n_a_fill_bits+1;
+ bsp-=n_b_fill_bits;
+
+ decrement_reference_count_of_node_id (free_unique_node_id,&code_gen_node_ids_p->free_node_ids);
+
+ GenPopA (asp);
+ GenPopB (bsp);
+ GenRtn (1,0,OnAState);
+}
+
+static void CodeRootFillUniqueNode (Node update_node,int asp,int bsp,CodeGenNodeIdsP code_gen_node_ids_p)
+{
+ unsigned int n_args,node_arity;
+ char bits[MaxNodeArity+2];
+ NodeIdP free_unique_node_id;
+ NodeP node,push_node;
+ LabDef name,*label_p;
+ SymbolP symbol;
+
+ node=update_node->node_arguments->arg_node;
+ push_node=update_node->node_node;
+ free_unique_node_id=push_node->node_arguments->arg_node->node_node_id;
+
+ symbol=node->node_symbol;
+
+ switch (symbol->symb_kind){
+ case definition:
+ {
+ SymbDef sdef;
+
+ sdef=node->node_symbol->symb_def;
+
+ node_arity=node->node_arity;
+
+ switch (sdef->sdef_kind){
+ case CONSTRUCTOR:
+ bits[0]='1';
+
+ if (sdef->sdef_strict_constructor){
+ ConvertSymbolToKLabel (&name,sdef);
+
+ fill_strict_root_unique_node (node,update_node,bits,&name,free_unique_node_id,asp,bsp,code_gen_node_ids_p);
+
+ return;
+ } else {
+ ConvertSymbolToConstructorDLabel (&name,sdef);
+ label_p=&name;
+ }
+ break;
+ case RECORDTYPE:
+ bits[0]='1';
+
+ ConvertSymbolToRLabel (&name,sdef);
+
+ fill_strict_root_unique_node (node,update_node,bits,&name,free_unique_node_id,asp,bsp,code_gen_node_ids_p);
+
+ return;
+ default:
+ error_in_function ("CodeRootFillUniqueNode");
+ return;
+ }
+ break;
+ }
+ default:
+ error_in_function ("CodeRootFillUniqueNode");
+ return;
+ }
+
+#if GENERATE_CODE_AGAIN
+ {
+ ArgP removed_args=
+#endif
+ compute_bits_and_remove_unused_arguments (node,bits,update_node->node_arguments->arg_occurrence,&n_args);
+
+ BuildLazyArgs (node->node_arguments,&asp,&bsp,code_gen_node_ids_p);
+
+#if GENERATE_CODE_AGAIN
+ if (call_code_generator_again)
+ restore_removed_arguments (&node->node_arguments,removed_args,update_node->node_arguments->arg_occurrence,node_arity);
+ }
+#endif
+
+ GenPushA (asp-free_unique_node_id->nid_a_index);
+ asp+=1;
+
+ GenFill3 (label_p,node_arity,asp,bits+1);
+ asp-=n_args+1;
+
+ decrement_reference_count_of_node_id (free_unique_node_id,&code_gen_node_ids_p->free_node_ids);
+
+ GenPopA (asp);
+ GenPopB (bsp);
+ GenRtn (1,0,OnAState);
+}
+
static int CodeRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenNodeIdsP code_gen_node_ids_p,StateS resultstate,struct esc *esc_p)
{
switch (root->node_kind){
@@ -1272,7 +1463,7 @@ static int CodeRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenNodeIdsP
EvaluateCondition (condpart->arg_node,&asp,&bsp,code_gen_node_ids_p,condpart->arg_state);
MakeLabel (&elselab, else_symb, NewLabelNr, no_pref);
- MakeLabel (&thenlab, then_symb, NewLabelNr++, no_pref);
+ MakeLabel (&thenlab, then_symb, NewLabelNr++, no_pref);
thenlab.lab_mod=notused_string;
@@ -1282,15 +1473,23 @@ static int CodeRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenNodeIdsP
if (thenlab.lab_mod==NULL)
GenLabelDefinition (&thenlab);
-#ifdef CLEAN2
+
{
+ NodeIdListElementP free_node_ids;
+#ifdef CLEAN2
int needs_next_alt;
+#endif
+ free_node_ids=NULL;
+ if (root->node_else_node_id_ref_counts!=NULL)
+ subtract_else_ref_counts (root->node_else_node_id_ref_counts,&free_node_ids);
+
+#ifdef CLEAN2
needs_next_alt=
#endif
CodeRhsNodeDefsAndRestoreNodeIdStates (then_arg->arg_node,root->node_then_node_defs,asp,bsp,resultstate,esc_p,
code_gen_node_ids_p->a_node_ids,code_gen_node_ids_p->b_node_ids,
- root->node_else_node_id_ref_counts,
+ free_node_ids,
#ifdef CLEAN2
!contains_fail (then_arg->arg_node)
#else
@@ -1300,6 +1499,9 @@ static int CodeRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenNodeIdsP
code_gen_node_ids_p->doesnt_fail
*/
);
+
+ if (root->node_else_node_id_ref_counts!=NULL)
+ add_else_ref_counts (root->node_else_node_id_ref_counts);
GenLabelDefinition (&elselab);
@@ -1308,6 +1510,11 @@ static int CodeRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenNodeIdsP
if (else_node->node_kind==NormalNode && else_node->node_symbol->symb_kind==fail_symb){
UpdateStackPointers (asp,bsp,esc_p->esc_asp,esc_p->esc_bsp);
GenJmp (esc_p->esc_label);
+
+#if BOXED_RECORDS
+ if (root->node_else_node_id_ref_counts)
+ or_then_record_update_marks (root->node_else_node_id_ref_counts);
+#endif
return 1;
} else
@@ -1319,16 +1526,26 @@ static int CodeRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenNodeIdsP
CodeRhsNodeDefsAndRestoreNodeIdStates (else_node,root->node_else_node_defs,asp,bsp,resultstate,esc_p,
code_gen_node_ids_p->a_node_ids,code_gen_node_ids_p->b_node_ids,
NULL,code_gen_node_ids_p->doesnt_fail);
+#if BOXED_RECORDS
+ if (root->node_else_node_id_ref_counts)
+ or_then_record_update_marks (root->node_else_node_id_ref_counts);
+#endif
+
#ifdef CLEAN2
return needs_next_alt;
- }
#endif
+ }
}
case NodeIdNode:
if (rootid==NULL){
CodeRedirection (root->node_node_id,asp,bsp,resultstate,&code_gen_node_ids_p->free_node_ids);
return 0;
}
+ case FillUniqueNode:
+ if (rootid==NULL){
+ CodeRootFillUniqueNode (root,asp,bsp,code_gen_node_ids_p);
+ return 0;
+ }
default:
error_in_function ("CodeRootNode");
return 0;
@@ -1433,20 +1650,14 @@ static void generate_code_for_tail_call_modulo_cons (NodeP node_p,NodeId node_de
NodeIdListElementP node_id_list;
char bits[MaxNodeArity+2];
unsigned int a_bits,b_bits,a_size,b_size,a_size2,b_size2,n,arg_n;
+ int a_destination_offset,b_destination_offset;
int total_a_size2,total_b_size2;
int node_arity;
ArgP arg_p;
total_a_size2=0;
total_b_size2=0;
-
- for_l (node_id_list,push_node->node_node_ids,nidl_next){
-# ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
- AddSizeOfState (*node_id_list->nidl_node_id->nid_lhs_state_p,&total_a_size2,&total_b_size2);
-# else
- AddSizeOfState (node_id_list->nidl_node_id->nid_state,&total_a_size2,&total_b_size2);
-# endif
- }
+ add_sizes_of_states_of_node_ids (push_node->node_node_ids,&total_a_size2,&total_b_size2);
a_bits=0;
b_bits=0;
@@ -1497,23 +1708,51 @@ static void generate_code_for_tail_call_modulo_cons (NodeP node_p,NodeId node_de
else
b_bits|=1;
- for (n=0; n<a_size; ++n)
- bits[n]='0' + ((a_bits>>n) & 1);
+ a_destination_offset=a_size;
+ for (n=a_size-1; n>=0; --n)
+ if ((a_bits>>n) & 1){
+ bits[n]='1';
+ --a_destination_offset;
+ if (a_destination_offset!=n)
+ GenUpdateA (n,a_destination_offset);
+ } else
+ bits[n]='0';
+
+ if (a_destination_offset!=0){
+ GenPopA (a_destination_offset);
+ asp-=a_destination_offset;
+ }
+
+ b_destination_offset=b_size;
+ for (n=b_size-1; n>=0; --n)
+ if ((b_bits>>n) & 1){
+ bits[n+a_size]='1';
+ --b_destination_offset;
+ if (b_destination_offset!=n)
+ GenUpdateB (n,b_destination_offset);
+ } else
+ bits[n+a_size]='0';
+
+ if (b_destination_offset!=0){
+ GenPopB (b_destination_offset);
+ bsp-=b_destination_offset;
+ }
- for (n=0; n<b_size; ++n)
- bits[n+a_size]='0' + ((b_bits>>n) & 1);
-
bits[a_size+b_size]='\0';
GenPushA (asp-node_def_id->nid_a_index);
GenFill3R (constructor_name_p,asize,bsize,asp+1,bits);
- } else
+
+ asp-=asize-a_destination_offset;
+ bsp-=bsize-b_destination_offset;
+ } else {
GenFillR (constructor_name_p,asize,bsize,asp,0,0,ReleaseAndFill,True);
- asp-=asize;
- bsp-=bsize;
+ asp-=asize;
+ bsp-=bsize;
+ }
}
-
+
if (tail_call_modulo_cons)
name.lab_post=2;
@@ -1641,7 +1880,10 @@ static void fill_lazy_tuple_result_arguments (Args arg,int *asp_p,int *bsp_p,int
NodeId arg_node_id;
arg_node_id=node->node_node_id;
-
+
+# if BOXED_RECORDS
+ arg_node_id->nid_mark2 |= NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+# endif
if (CopyNodeIdArgument (arg->arg_state,arg_node_id,asp_p,bsp_p))
ChangeEvalStatusKindToStrictOnA (arg_node_id,code_gen_node_ids_p->saved_nid_state_l);
@@ -1672,7 +1914,10 @@ static void fill_lazy_tuple_result_arguments (Args arg,int *asp_p,int *bsp_p,int
NodeId arg_node_id;
arg_node_id=node->node_node_id;
-
+
+# if BOXED_RECORDS
+ arg_node_id->nid_mark2 |= NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+# endif
if (arg_node_id->nid_state.state_type==SimpleState && arg_node_id->nid_state.state_kind!=OnB){
if (CopyNodeIdArgument (arg->arg_state,arg_node_id,asp_p,bsp_p))
ChangeEvalStatusKindToStrictOnA (arg_node_id,code_gen_node_ids_p->saved_nid_state_l);
@@ -1739,6 +1984,9 @@ static void fill_strict_tuple_result_arguments (Args arg,ArgP *function_result_t
arg_node_id=node->node_node_id;
+#if BOXED_RECORDS
+ arg_node_id->nid_mark2 |= NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+#endif
if (arg_node_id->nid_state.state_type==SimpleState && arg_node_id->nid_state.state_kind!=OnB){
if (CopyNodeIdArgument (arg->arg_state,arg_node_id,asp_p,bsp_p))
ChangeEvalStatusKindToStrictOnA (arg_node_id,code_gen_node_ids_p->saved_nid_state_l);
diff --git a/backendC/CleanCompilerSources/optimisations.c b/backendC/CleanCompilerSources/optimisations.c
index 7458205..9ceed19 100644
--- a/backendC/CleanCompilerSources/optimisations.c
+++ b/backendC/CleanCompilerSources/optimisations.c
@@ -12,8 +12,8 @@
#include "checker.h"
#include "scanner.h"
#include "buildtree.h"
-#include "optimisations.h"
#include "codegen_types.h"
+#include "optimisations.h"
#include "codegen1.h"
#include "codegen2.h"
#include "sa.h"
@@ -1804,8 +1804,6 @@ static int ChangeArgumentNodeStatesIfStricter (NodeP node_p,StateP demanded_stat
#ifdef REUSE_UNIQUE_NODES
-
-
static NodeP replace_node_by_unique_fill_node (NodeP node,NodeP push_node,int node_size)
{
NodeP node_copy;
@@ -1836,7 +1834,20 @@ static NodeP replace_node_by_unique_fill_node (NodeP node,NodeP push_node,int no
return node_copy;
}
-static int compute_n_not_updated_words (NodeP push_node,NodeP node,int node_a_size)
+void add_sizes_of_states_of_node_ids (NodeIdListElementP node_id_list,int *total_a_size_p,int *total_b_size_p)
+{
+ NodeIdListElementP node_id_list_elem_p;
+
+ for_l (node_id_list_elem_p,node_id_list,nidl_next){
+# ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
+ AddSizeOfState (*node_id_list_elem_p->nidl_node_id->nid_lhs_state_p,total_a_size_p,total_b_size_p);
+# else
+ AddSizeOfState (node_id_list_elem_p->nidl_node_id->nid_state,total_a_size_p,total_b_size_p);
+# endif
+ }
+}
+
+static int compute_root_n_not_updated_words (NodeP push_node,NodeP node,int node_a_size)
{
NodeIdListElementP node_id_list;
unsigned long n_not_updated_words;
@@ -1847,14 +1858,66 @@ static int compute_n_not_updated_words (NodeP push_node,NodeP node,int node_a_si
total_a_size2=0;
total_b_size2=0;
+ add_sizes_of_states_of_node_ids (push_node->node_node_ids,&total_a_size2,&total_b_size2);
- for_l (node_id_list,push_node->node_node_ids,nidl_next){
+ n_not_updated_words=0;
+ node_arg_p=node->node_arguments;
+ arity=node->node_arity;
+ node_id_list=push_node->node_node_ids;
+
+ a_size1=0;
+ b_size1=0;
+ a_size2=0;
+ b_size2=0;
+
+ for (n=0; n<arity; ++n){
+ int e_a_size1,e_b_size1,e_a_size2,e_b_size2;
+
+ DetermineSizeOfState (node_arg_p->arg_state,&e_a_size1,&e_b_size1);
+
+ if (node_id_list!=NULL){
+ NodeIdP node_id_p;
+
+ node_id_p=node_id_list->nidl_node_id;
# ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
- AddSizeOfState (*node_id_list->nidl_node_id->nid_lhs_state_p,&total_a_size2,&total_b_size2);
+ DetermineSizeOfState (*node_id_p->nid_lhs_state_p,&e_a_size2,&e_b_size2);
# else
- AddSizeOfState (node_id_list->nidl_node_id->nid_state,&total_a_size2,&total_b_size2);
-# endif
- }
+ DetermineSizeOfState (node_id_p->nid_state,&e_a_size2,&e_b_size2);
+# endif
+ if (node_arg_p->arg_node->node_kind==NodeIdNode && node_arg_p->arg_node->node_node_id==node_id_list->nidl_node_id){
+ if (! (e_a_size1!=e_a_size2 || e_b_size1!=e_b_size2 ||
+ ((e_a_size1 | e_a_size2)!=0 && a_size1!=a_size2 && a_size1!=0) ||
+ ((e_b_size1 | e_b_size2)!=0 && b_size1+node_a_size!=b_size2+total_a_size2 && b_size1+node_a_size!=0)))
+ {
+ n_not_updated_words += e_a_size1+e_b_size1;
+ }
+ }
+
+ a_size2+=e_a_size2;
+ b_size2+=e_b_size2;
+ node_id_list=node_id_list->nidl_next;
+ }
+
+ a_size1+=e_a_size1;
+ b_size1+=e_b_size1;
+ node_arg_p=node_arg_p->arg_next;
+ }
+
+ return n_not_updated_words;
+}
+
+static int compute_n_not_updated_words (NodeP push_node,NodeP node,int node_a_size)
+{
+ NodeIdListElementP node_id_list;
+ unsigned long n_not_updated_words;
+ ArgP node_arg_p;
+ unsigned int n,arity;
+ int a_size1,b_size1,a_size2,b_size2;
+ int total_a_size2,total_b_size2;
+
+ total_a_size2=0;
+ total_b_size2=0;
+ add_sizes_of_states_of_node_ids (push_node->node_node_ids,&total_a_size2,&total_b_size2);
n_not_updated_words=0;
node_arg_p=node->node_arguments;
@@ -1867,22 +1930,20 @@ static int compute_n_not_updated_words (NodeP push_node,NodeP node,int node_a_si
b_size2=0;
for (n=0; n<arity; ++n){
+ int e_a_size1,e_b_size1,e_a_size2,e_b_size2;
+
+ DetermineSizeOfState (node_arg_p->arg_state,&e_a_size1,&e_b_size1);
+
if (node_id_list!=NULL){
NodeIdP node_id_p;
- StateP arg_node_id_state_p;
node_id_p=node_id_list->nidl_node_id;
-
- if (node_arg_p->arg_node->node_kind==NodeIdNode && node_arg_p->arg_node->node_node_id==node_id_list->nidl_node_id){
- int e_a_size1,e_b_size1,e_a_size2,e_b_size2;
-
- DetermineSizeOfState (node_arg_p->arg_state,&e_a_size1,&e_b_size1);
-
# ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
- DetermineSizeOfState (*node_id_p->nid_lhs_state_p,&e_a_size2,&e_b_size2);
+ DetermineSizeOfState (*node_id_p->nid_lhs_state_p,&e_a_size2,&e_b_size2);
# else
- DetermineSizeOfState (node_id_p->nid_state,&e_a_size2,&e_b_size2);
-# endif
+ DetermineSizeOfState (node_id_p->nid_state,&e_a_size2,&e_b_size2);
+# endif
+ if (node_arg_p->arg_node->node_kind==NodeIdNode && node_arg_p->arg_node->node_node_id==node_id_list->nidl_node_id){
if (! (e_a_size1!=e_a_size2 || e_b_size1!=e_b_size2 ||
((e_a_size1 | e_a_size2)!=0 && a_size1!=a_size2) ||
((e_b_size1 | e_b_size2)!=0 && b_size1+node_a_size!=b_size2+total_a_size2)))
@@ -1891,24 +1952,142 @@ static int compute_n_not_updated_words (NodeP push_node,NodeP node,int node_a_si
}
}
-# ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
- arg_node_id_state_p=node_id_p->nid_lhs_state_p;
-# else
- arg_node_id_state_p=&node_id_p->nid_state;
-# endif
- AddSizeOfState (*arg_node_id_state_p,&a_size2,&b_size2);
-
+ a_size2+=e_a_size2;
+ b_size2+=e_b_size2;
node_id_list=node_id_list->nidl_next;
}
- AddSizeOfState (node_arg_p->arg_state,&a_size1,&b_size1);
-
+ a_size1+=e_a_size1;
+ b_size1+=e_b_size1;
node_arg_p=node_arg_p->arg_next;
}
return n_not_updated_words;
}
+static Bool insert_root_unique_fill_node (NodeP node,FreeUniqueNodeIdsP *f_node_ids,int node_a_size,int node_b_size)
+{
+ FreeUniqueNodeIdsP f_node_id;
+ NodeP push_node,node_copy;
+ ArgP node_copy_arg_p;
+ unsigned long argument_overwrite_bits;
+ NodeIdListElementP node_id_list;
+ unsigned int n,arity;
+ int node_size;
+
+ node_size=node_a_size+node_b_size;
+
+ arity=node->node_arity;
+
+ /* optimization: update node with fewest number of words to be updated */
+ {
+ FreeUniqueNodeIdsP *f_node_id_h,*found_f_node_id_h;
+ int found_size,found_n_not_updated_words;
+
+ found_f_node_id_h=NULL;
+ f_node_id_h=f_node_ids;
+
+ while ((f_node_id=*f_node_id_h)!=NULL){
+ int new_found_size;
+
+ new_found_size=f_node_id->fnid_node_size;
+
+ if (new_found_size>=node_size){
+ int new_found_n_not_updated_words;
+
+ new_found_n_not_updated_words=compute_root_n_not_updated_words (f_node_id->fnid_push_node,node,node_a_size);
+
+ if (found_f_node_id_h==NULL || new_found_size<found_size || new_found_n_not_updated_words>found_n_not_updated_words){
+ found_f_node_id_h=f_node_id_h;
+ found_size=new_found_size;
+ found_n_not_updated_words=new_found_n_not_updated_words;
+ }
+ }
+
+ f_node_id_h=&f_node_id->fnid_next;
+ }
+
+ if (found_f_node_id_h==NULL)
+ return False;
+
+ f_node_id=*found_f_node_id_h;
+ *found_f_node_id_h=f_node_id->fnid_next;
+ }
+
+ push_node=f_node_id->fnid_push_node;
+
+ node_copy=replace_node_by_unique_fill_node (node,push_node,f_node_id->fnid_node_size);
+
+ {
+ int a_size1,b_size1,a_size2,b_size2;
+ int total_a_size2,total_b_size2;
+
+ total_a_size2=0;
+ total_b_size2=0;
+ add_sizes_of_states_of_node_ids (push_node->node_node_ids,&total_a_size2,&total_b_size2);
+
+ argument_overwrite_bits=0;
+ node_copy_arg_p=node_copy->node_arguments;
+ node_id_list=push_node->node_node_ids;
+
+ a_size1=0;
+ b_size1=0;
+ a_size2=0;
+ b_size2=0;
+
+ for (n=0; n<arity; ++n){
+ int e_a_size1,e_b_size1,e_a_size2,e_b_size2;
+
+ DetermineSizeOfState (node_copy_arg_p->arg_state,&e_a_size1,&e_b_size1);
+
+ if (node_id_list!=NULL){
+ NodeIdP node_id_p;
+
+ node_id_p=node_id_list->nidl_node_id;
+# ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
+ DetermineSizeOfState (*node_id_p->nid_lhs_state_p,&e_a_size2,&e_b_size2);
+# else
+ DetermineSizeOfState (node_id_p->nid_state,&e_a_size2,&e_b_size2);
+# endif
+ if (node_copy_arg_p->arg_node->node_kind==NodeIdNode && node_copy_arg_p->arg_node->node_node_id==node_id_list->nidl_node_id){
+ if (e_a_size1!=e_a_size2 ||
+ e_b_size1!=e_b_size2 ||
+ (e_a_size1!=0 && (a_size1!=a_size2 ||
+ a_size1==0 ||
+ ((a_size1==1 || (a_size1==0 && e_a_size1>1)) &&
+ ((node_size==2) != (total_a_size2+total_b_size2==2)))
+ )) ||
+ (e_b_size1!=0 && (b_size1+node_a_size!=b_size2+total_a_size2 ||
+ b_size1+node_a_size==0 ||
+ ((b_size1+node_a_size==1 || (b_size1+node_a_size==0 && e_b_size1>1)) &&
+ ((node_size==2) != (total_a_size2+total_b_size2==2)))
+ )))
+ {
+ argument_overwrite_bits|=1<<n;
+ } else {
+ ++node_id_p->nid_refcount;
+ node_id_p->nid_mark |= NID_EXTRA_REFCOUNT_MASK;
+ }
+ } else
+ argument_overwrite_bits|=1<<n;
+
+ a_size2+=e_a_size2;
+ b_size2+=e_b_size2;
+ node_id_list=node_id_list->nidl_next;
+ } else
+ argument_overwrite_bits|=1<<n;
+
+ a_size1+=e_a_size1;
+ b_size1+=e_b_size1;
+ node_copy_arg_p=node_copy_arg_p->arg_next;
+ }
+ }
+
+ node->node_arguments->arg_occurrence=argument_overwrite_bits;
+
+ return True;
+}
+
static Bool insert_unique_fill_node (NodeP node,FreeUniqueNodeIdsP *f_node_ids,int node_a_size,int node_b_size)
{
FreeUniqueNodeIdsP f_node_id;
@@ -1981,21 +2160,14 @@ static Bool insert_unique_fill_node (NodeP node,FreeUniqueNodeIdsP *f_node_ids,i
push_node=f_node_id->fnid_push_node;
node_copy=replace_node_by_unique_fill_node (node,push_node,f_node_id->fnid_node_size);
-
+
{
int a_size1,b_size1,a_size2,b_size2;
int total_a_size2,total_b_size2;
total_a_size2=0;
total_b_size2=0;
-
- for_l (node_id_list,push_node->node_node_ids,nidl_next){
-# ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
- AddSizeOfState (*node_id_list->nidl_node_id->nid_lhs_state_p,&total_a_size2,&total_b_size2);
-# else
- AddSizeOfState (node_id_list->nidl_node_id->nid_state,&total_a_size2,&total_b_size2);
-# endif
- }
+ add_sizes_of_states_of_node_ids (push_node->node_node_ids,&total_a_size2,&total_b_size2);
argument_overwrite_bits=0;
node_copy_arg_p=node_copy->node_arguments;
@@ -2007,22 +2179,20 @@ static Bool insert_unique_fill_node (NodeP node,FreeUniqueNodeIdsP *f_node_ids,i
b_size2=0;
for (n=0; n<arity; ++n){
+ int e_a_size1,e_b_size1,e_a_size2,e_b_size2;
+
+ DetermineSizeOfState (node_copy_arg_p->arg_state,&e_a_size1,&e_b_size1);
+
if (node_id_list!=NULL){
NodeIdP node_id_p;
- StateP arg_node_id_state_p;
node_id_p=node_id_list->nidl_node_id;
-
- if (node_copy_arg_p->arg_node->node_kind==NodeIdNode && node_copy_arg_p->arg_node->node_node_id==node_id_list->nidl_node_id){
- int e_a_size1,e_b_size1,e_a_size2,e_b_size2;
-
- DetermineSizeOfState (node_copy_arg_p->arg_state,&e_a_size1,&e_b_size1);
-
# ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
- DetermineSizeOfState (*node_id_p->nid_lhs_state_p,&e_a_size2,&e_b_size2);
+ DetermineSizeOfState (*node_id_p->nid_lhs_state_p,&e_a_size2,&e_b_size2);
# else
- DetermineSizeOfState (node_id_p->nid_state,&e_a_size2,&e_b_size2);
-# endif
+ DetermineSizeOfState (node_id_p->nid_state,&e_a_size2,&e_b_size2);
+# endif
+ if (node_copy_arg_p->arg_node->node_kind==NodeIdNode && node_copy_arg_p->arg_node->node_node_id==node_id_list->nidl_node_id){
if (e_a_size1!=e_a_size2 ||
e_b_size1!=e_b_size2 ||
(e_a_size1!=0 && (a_size1!=a_size2 ||
@@ -2034,7 +2204,7 @@ static Bool insert_unique_fill_node (NodeP node,FreeUniqueNodeIdsP *f_node_ids,i
((node_size==2) != (total_a_size2+total_b_size2==2)))
)))
{
- argument_overwrite_bits|=1<<n;
+ argument_overwrite_bits|=1<<n;
} else {
++node_id_p->nid_refcount;
node_id_p->nid_mark |= NID_EXTRA_REFCOUNT_MASK;
@@ -2042,19 +2212,14 @@ static Bool insert_unique_fill_node (NodeP node,FreeUniqueNodeIdsP *f_node_ids,i
} else
argument_overwrite_bits|=1<<n;
-# ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
- arg_node_id_state_p=node_id_p->nid_lhs_state_p;
-# else
- arg_node_id_state_p=&node_id_p->nid_state;
-# endif
- AddSizeOfState (*arg_node_id_state_p,&a_size2,&b_size2);
-
+ a_size2+=e_a_size2;
+ b_size2+=e_b_size2;
node_id_list=node_id_list->nidl_next;
} else
argument_overwrite_bits|=1<<n;
- AddSizeOfState (node_copy_arg_p->arg_state,&a_size1,&b_size1);
-
+ a_size1+=e_a_size1;
+ b_size1+=e_b_size1;
node_copy_arg_p=node_copy_arg_p->arg_next;
}
}
@@ -2119,6 +2284,55 @@ static Bool try_insert_constructor_update_node (NodeP node,FreeUniqueNodeIdsP *f
return False;
}
+static Bool try_insert_root_constructor_update_node (NodeP node,FreeUniqueNodeIdsP *f_node_ids)
+{
+ if (node->node_state.state_type==SimpleState && node->node_state.state_kind!=SemiStrict){
+ switch (node->node_symbol->symb_kind){
+ case definition:
+ {
+ SymbDef sdef;
+
+ sdef=node->node_symbol->symb_def;
+ switch (sdef->sdef_kind){
+ case CONSTRUCTOR:
+ if (sdef->sdef_arity==node->node_arity){
+ if (sdef->sdef_strict_constructor){
+ int a_size,b_size;
+
+ DetermineSizeOfArguments (node->node_arguments,&a_size,&b_size);
+
+ if (a_size+b_size>2)
+ return insert_root_unique_fill_node (node,f_node_ids,a_size,b_size);
+ } else {
+ if (node->node_arity>2)
+ return insert_root_unique_fill_node (node,f_node_ids,node->node_arity,0);
+ }
+ }
+ return False;
+ case RECORDTYPE:
+ if (sdef->sdef_boxed_record){
+ if (sdef->sdef_strict_constructor){
+ int a_size,b_size;
+
+ DetermineSizeOfArguments (node->node_arguments,&a_size,&b_size);
+
+ if (a_size+b_size>2)
+ return insert_root_unique_fill_node (node,f_node_ids,a_size,b_size);
+ } else {
+ if (node->node_arity>2)
+ return insert_root_unique_fill_node (node,f_node_ids,node->node_arity,0);
+ }
+ }
+ return False;
+ }
+ break;
+ }
+ }
+ }
+
+ return False;
+}
+
static NodeP try_insert_function_update_node (NodeP node,FreeUniqueNodeIdsS **f_node_ids_l)
{
if (!(node->node_state.state_type==SimpleState && node->node_state.state_kind==SemiStrict) &&
@@ -2354,15 +2568,11 @@ static void optimise_node_in_then_or_else (NodeP node,FreeUniqueNodeIdsS **f_nod
#ifdef REUSE_UNIQUE_NODES
if (*f_node_ids_l!=NULL && try_insert_constructor_update_node (node,f_node_ids_l)){
- unsigned int n,arity,argument_overwrite_bits;
- NodeP fill_node;
+ unsigned int n,argument_overwrite_bits;
- fill_node=node;
- node=fill_node->node_arguments->arg_node;
+ argument_overwrite_bits=node->node_arguments->arg_occurrence;
+ node=node->node_arguments->arg_node;
- argument_overwrite_bits=fill_node->node_arguments->arg_occurrence;
- arity=node->node_arity;
-
n=0;
for_l (arg,node->node_arguments,arg_next){
if (argument_overwrite_bits & (1<<n))
@@ -2409,6 +2619,10 @@ static void optimise_node_in_then_or_else (NodeP node,FreeUniqueNodeIdsS **f_nod
}
}
#endif
+#if DESTRUCTIVE_RECORD_UPDATES
+ if (node->node_arguments->arg_node->node_kind==NodeIdNode && node->node_arity==1)
+ return;
+#endif
case MatchNode:
optimise_node_in_then_or_else (node->node_arguments->arg_node,f_node_ids_l,local_scope);
return;
@@ -2418,12 +2632,32 @@ static void optimise_node_in_then_or_else (NodeP node,FreeUniqueNodeIdsS **f_nod
#if DESTRUCTIVE_RECORD_UPDATES
arg=node->node_arguments;
- if (arg->arg_node->node_kind==NodeIdNode && (arg->arg_node->node_node_id->nid_mark2 & NID_HAS_REFCOUNT_WITHOUT_UPDATES)!=0
- && arg->arg_node->node_node_id->nid_refcount==-2)
- ++arg->arg_node->node_node_id->nid_number;
-#endif
+ if (arg->arg_node->node_kind==NodeIdNode){
+ NodeIdP node_id;
+
+ node_id=arg->arg_node->node_node_id;
+ if ((node_id->nid_mark2 & NID_HAS_REFCOUNT_WITHOUT_UPDATES)!=0 && node_id->nid_refcount==-2)
+ ++node_id->nid_number;
+
+ node_id->nid_mark2 |= NID_RECORD_USED_BY_UPDATE;
+
+ arg=arg->arg_next;
+ }
+# if BOXED_RECORDS
+ else {
+ optimise_node_in_then_or_else (arg->arg_node,f_node_ids_l,local_scope);
+ if (arg->arg_node->node_kind==NodeIdNode)
+ arg->arg_node->node_node_id->nid_mark2 |= NID_RECORD_USED_BY_UPDATE;
+
+ arg=arg->arg_next;
+ }
+# endif
+ for (; arg!=NULL; arg=arg->arg_next)
+ optimise_node_in_then_or_else (arg->arg_node,f_node_ids_l,local_scope);
+#else
for_l (arg,node->node_arguments,arg_next)
optimise_node_in_then_or_else (arg->arg_node,f_node_ids_l,local_scope);
+#endif
return;
}
@@ -2522,7 +2756,7 @@ static void optimise_then_or_else (NodeP node,NodeDefP node_defs,FreeUniqueNodeI
NodeP node;
node=node_def->def_node;
-
+
optimise_normal_node (node);
for_l (arg,node->node_arguments,arg_next)
@@ -2540,7 +2774,26 @@ static void optimise_then_or_else (NodeP node,NodeDefP node_defs,FreeUniqueNodeI
#ifdef REUSE_UNIQUE_NODES
if (node->node_kind==NormalNode){
ArgP arg;
+
+#if 1
+ if (f_node_ids!=NULL && try_insert_root_constructor_update_node (node,&f_node_ids)){
+ unsigned int n,argument_overwrite_bits;
+
+ argument_overwrite_bits=node->node_arguments->arg_occurrence;
+ node=node->node_arguments->arg_node;
+
+ n=0;
+ for_l (arg,node->node_arguments,arg_next){
+ if (argument_overwrite_bits & (1<<n))
+ optimise_node_in_then_or_else (arg->arg_node,&f_node_ids,local_scope);
+
+ ++n;
+ }
+ } else {
+#endif
+
+
optimise_normal_node (node);
#if OPTIMIZE_LAZY_TUPLE_RECURSION
@@ -2568,6 +2821,13 @@ static void optimise_then_or_else (NodeP node,NodeDefP node_defs,FreeUniqueNodeI
optimise_node_in_then_or_else (arg->arg_node,&f_node_ids,local_scope);
optimise_strict_constructor_in_lazy_context (node,&no_free_unique_node_ids);
+
+
+#if 1
+ }
+#endif
+
+
} else
#endif
optimise_node_in_then_or_else (node,&f_node_ids,local_scope);
@@ -2584,15 +2844,11 @@ static void optimise_node (NodeP node,FreeUniqueNodeIdsS **f_node_ids_l)
#ifdef REUSE_UNIQUE_NODES
if (*f_node_ids_l!=NULL && try_insert_constructor_update_node (node,f_node_ids_l)){
- unsigned int n,arity,argument_overwrite_bits;
- NodeP fill_node;
+ unsigned int n,argument_overwrite_bits;
- fill_node=node;
- node=fill_node->node_arguments->arg_node;
+ argument_overwrite_bits=node->node_arguments->arg_occurrence;
+ node=node->node_arguments->arg_node;
- argument_overwrite_bits=fill_node->node_arguments->arg_occurrence;
- arity=node->node_arity;
-
n=0;
for_l (arg,node->node_arguments,arg_next){
if (argument_overwrite_bits & (1<<n))
@@ -2639,22 +2895,47 @@ static void optimise_node (NodeP node,FreeUniqueNodeIdsS **f_node_ids_l)
}
}
#endif
+#if DESTRUCTIVE_RECORD_UPDATES
+ if (node->node_arguments->arg_node->node_kind==NodeIdNode && node->node_arity==1)
+ return;
+#endif
case MatchNode:
optimise_node (node->node_arguments->arg_node,f_node_ids_l);
return;
case UpdateNode:
{
- ArgS *arg;
+ ArgP arg;
#if DESTRUCTIVE_RECORD_UPDATES
arg=node->node_arguments;
- if (arg->arg_node->node_kind==NodeIdNode && (arg->arg_node->node_node_id->nid_mark2 & NID_HAS_REFCOUNT_WITHOUT_UPDATES)!=0
- && arg->arg_node->node_node_id->nid_refcount==-2)
- ++arg->arg_node->node_node_id->nid_number;
-#endif
- for_l (arg,node->node_arguments,arg_next)
+
+ if (arg->arg_node->node_kind==NodeIdNode){
+ NodeIdP node_id;
+
+ node_id=arg->arg_node->node_node_id;
+ if ((node_id->nid_mark2 & NID_HAS_REFCOUNT_WITHOUT_UPDATES)!=0 && node_id->nid_refcount==-2)
+ ++node_id->nid_number;
+
+ node_id->nid_mark2 |= NID_RECORD_USED_BY_UPDATE;
+
+ arg=arg->arg_next;
+ }
+# if BOXED_RECORDS
+ else {
optimise_node (arg->arg_node,f_node_ids_l);
+ if (arg->arg_node->node_kind==NodeIdNode)
+ arg->arg_node->node_node_id->nid_mark2 |= NID_RECORD_USED_BY_UPDATE;
+
+ arg=arg->arg_next;
+ }
+# endif
+ for (; arg!=NULL; arg=arg->arg_next)
+ optimise_node (arg->arg_node,f_node_ids_l);
+#else
+ for_l (arg,node->node_arguments,arg_next)
+ optimise_node (arg->arg_node,f_node_ids_l);
+#endif
return;
}
case TupleSelectorsNode:
@@ -2853,6 +3134,25 @@ static void optimise_root_node (NodeP node,NodeDefP node_defs,FreeUniqueNodeIdsP
if (node->node_kind==NormalNode){
ArgS *arg;
+
+#if 1
+ if (f_node_ids!=NULL && try_insert_root_constructor_update_node (node,&f_node_ids)){
+ unsigned int n,argument_overwrite_bits;
+
+ argument_overwrite_bits=node->node_arguments->arg_occurrence;
+ node=node->node_arguments->arg_node;
+
+ n=0;
+ for_l (arg,node->node_arguments,arg_next){
+ if (argument_overwrite_bits & (1<<n))
+ optimise_node (arg->arg_node,&f_node_ids);
+
+ ++n;
+ }
+ } else {
+#endif
+
+
optimise_normal_node (node);
#if OPTIMIZE_LAZY_TUPLE_RECURSION
@@ -2880,6 +3180,13 @@ static void optimise_root_node (NodeP node,NodeDefP node_defs,FreeUniqueNodeIdsP
optimise_node (arg->arg_node,&f_node_ids);
optimise_strict_constructor_in_lazy_context (node,&no_free_unique_node_ids);
+
+
+#if 1
+ }
+#endif
+
+
} else
optimise_node (node,&f_node_ids);
@@ -3121,11 +3428,12 @@ static void MarkTupleSelectorsNode (NodeIdP node_id,NodeP tuple_node)
element_node_id->nid_number=element_n;
element_node_id->nid_node=select_node;
element_node_id->nid_scope = node_id->nid_scope;
+ element_node_id->nid_mark2 |= NID_SELECTION_NODE_ID;
select_nodes[element_n]=select_node;
}
++element_node_id->nid_refcount;
-
+
select_node->node_kind=NodeIdNode;
select_node->node_node_id=element_node_id;
@@ -3838,6 +4146,7 @@ void OptimiseRules (ImpRules rules,SymbDef start_sdef)
new_call_state_p = call_arg_state_p2;
*lhs_arg_state_p = *new_call_state_p;
+
*function_arg_state_p = *new_call_state_p;
arg_p1->arg_state = *new_call_state_p;
@@ -3856,7 +4165,10 @@ void OptimiseRules (ImpRules rules,SymbDef start_sdef)
call_arg_node2->node_node_id->nid_refcount==1 &&
call_arg_node2->node_node_id->nid_node->node_kind==NodeIdNode)
{
- call_arg_node2->node_node_id->nid_node->node_arguments->arg_state = *new_call_state_p;
+ StateP state_p;
+
+ state_p=&call_arg_node2->node_node_id->nid_node->node_arguments->arg_state;
+ *state_p = *new_call_state_p;
}
}
} else {
diff --git a/backendC/CleanCompilerSources/optimisations.h b/backendC/CleanCompilerSources/optimisations.h
index 206059d..e1be58c 100644
--- a/backendC/CleanCompilerSources/optimisations.h
+++ b/backendC/CleanCompilerSources/optimisations.h
@@ -5,3 +5,4 @@ int optimise_tuple_result_function (Node node,StateS demanded_state);
void generate_states (struct imp_rule *rules,int do_strictness_analysis);
StateP state_of_node_or_node_id (NodeP node_p);
void copy_rhs_node_defs_and_root (RuleAltP old_alt_p,NodeP *new_root_node_h,NodeDefP *node_defs_p);
+void add_sizes_of_states_of_node_ids (NodeIdListElementP node_id_list,int *total_a_size_p,int *total_b_size_p);
generated by cgit v1.2.3 (git 2.39.1) at 2025-03-18 22:39:02 +0000