Commit 6d1ed094 authored by John van Groningen's avatar John van Groningen
Browse files

fix tail recursion modulo cons optimisation

parent 675398ab
......@@ -591,6 +591,10 @@ int lazy_tuple_recursion=0;
int call_code_generator_again;
#endif
#if TAIL_CALL_MODULO_CONS_OPTIMIZATION
extern int does_tail_call_modulo_cons (NodeP node_p,NodeDefP node_defs);
#endif
int function_called_only_curried_or_lazy_with_one_return=0;
#if 0
......@@ -794,16 +798,12 @@ static void CodeRule (ImpRuleP rule)
struct saved_case_node_id_ref_counts *saved_case_node_id_ref_counts_p;
# if TAIL_CALL_MODULO_CONS_OPTIMIZATION
extern int does_tail_call_modulo_cons (NodeP node_p,NodeDefP node_defs);
if (OptimizeTailCallModuloCons && rule->rule_alts->alt_kind==Contractum && (rule->rule_mark & RULE_TAIL_MODULO_CONS_ENTRY_MASK)){
tail_call_modulo_cons=1;
if (OptimizeTailCallModuloCons && rule->rule_alts->alt_kind==Contractum){
tail_call_modulo_cons=does_tail_call_modulo_cons (rule->rule_alts->alt_rhs_root,rule->rule_alts->alt_rhs_defs);
if (tail_call_modulo_cons){
if (ListOptimizations)
printf ("Optimize tail call modulo cons of %s\n",rule_sdef->sdef_ident->ident_name);
call_code_generator_again=1;
}
if (ListOptimizations)
printf ("Optimize tail call modulo cons of %s\n",rule_sdef->sdef_ident->ident_name);
call_code_generator_again=1;
} else
tail_call_modulo_cons=0;
# endif
......@@ -950,12 +950,12 @@ static void CodeRule (ImpRuleP rule)
if (rule->rule_mark & RULE_CALL_VIA_LAZY_SELECTIONS_ONLY){
int tuple_result_arity;
StateS result_state_struct[1];
#if SELECTORS_FIRST
# if SELECTORS_FIRST
LabDef reduce_error_label;
#endif
# endif
tuple_result_arity=rule->rule_type->type_alt_rhs->type_node_arity;
#if TAIL_CALL_MODULO_TUPLE_CONS_OPTIMIZATION
# if TAIL_CALL_MODULO_TUPLE_CONS_OPTIMIZATION
if (tail_call_modulo_tuple_cons){
int i,n;
......@@ -964,13 +964,13 @@ static void CodeRule (ImpRuleP rule)
if (global_same_select_vector & (1<<i))
--tuple_result_arity;
}
#endif
# endif
GenFunctionDescriptorForLazyTupleRecursion (rule_sdef,tuple_result_arity);
result_state_struct[0]=OnAState;
#if SELECTORS_FIRST
# if SELECTORS_FIRST
{
LabDef d_lab,n_lab;
int a_size,b_size;
......@@ -1006,9 +1006,9 @@ static void CodeRule (ImpRuleP rule)
*/
ReduceError = &reduce_error_label;
}
#else
# else
ReduceError = &empty_lab;
#endif
# endif
ea_lab.lab_post=2;
......@@ -1025,7 +1025,7 @@ static void CodeRule (ImpRuleP rule)
else
ReduceError = &cycle_lab;
#if SELECTORS_FIRST
# if SELECTORS_FIRST
if (rule_sdef->sdef_arity!=0){
int n;
......@@ -1040,7 +1040,7 @@ static void CodeRule (ImpRuleP rule)
GenPopA (tuple_result_arity);
}
#endif
# endif
CurrentAltLabel.lab_pref = s_pref;
if (rule->rule_mark & RULE_UNBOXED_LAZY_CALL)
......@@ -1208,6 +1208,13 @@ void CodeGeneration (ImpMod imod, char *fname)
create_result_state_database (imod->im_rules);
#endif
#if TAIL_CALL_MODULO_CONS_OPTIMIZATION
if (OptimizeTailCallModuloCons)
for_l (rule,imod->im_rules,rule_next)
if (rule->rule_alts->alt_kind==Contractum && does_tail_call_modulo_cons (rule->rule_alts->alt_rhs_root,rule->rule_alts->alt_rhs_defs))
rule->rule_mark |= RULE_TAIL_MODULO_CONS_ENTRY_MASK;
#endif
update_function_p=&first_update_function;
for_l (rule,imod->im_rules,rule_next)
if (rule->rule_root->node_symbol->symb_def->sdef_over_arity==0){
......
......@@ -1365,7 +1365,7 @@ static Bool ExamineRootNodeOnACycle (NodeId rhsid,Node rhsroot,int *asp_p,StateS
#if TAIL_CALL_MODULO_CONS_OPTIMIZATION
extern int tail_call_modulo_cons;
static void generate_code_for_tail_call_modulo_cons (NodeP node_p,NodeId node_def_id,NodeP root_node,NodeP push_node,int asp,int bsp,struct code_gen_node_ids *code_gen_node_ids_p)
static void generate_code_for_tail_call_modulo_cons (NodeP node_p,NodeId node_def_id,NodeP root_node,NodeP push_node,int asp,int bsp,MovedNodeIdP *moved_node_ids_p,struct code_gen_node_ids *code_gen_node_ids_p)
{
LabDef name;
int a_size,b_size;
......@@ -1443,6 +1443,11 @@ static void generate_code_for_tail_call_modulo_cons (NodeP node_p,NodeId node_de
n_a_fill_bits=0;
n_b_fill_bits=0;
if (a_size>0)
a_bits|=1;
else
b_bits|=1;
arg_p=root_node->node_arguments;
node_arity=root_node->node_arity;
node_id_list=push_node->node_node_ids;
......@@ -1452,7 +1457,7 @@ static void generate_code_for_tail_call_modulo_cons (NodeP node_p,NodeId node_de
DetermineSizeOfState (arg_p->arg_state,&arg_a_size,&arg_b_size);
if (arg_n==0 || !(arg_p->arg_node->node_kind==NodeIdNode && arg_p->arg_node->node_node_id==node_id_list->nidl_node_id)){
if (!(arg_p->arg_node->node_kind==NodeIdNode && arg_p->arg_node->node_node_id==node_id_list->nidl_node_id)){
a_bits |= (~((~0)<<arg_a_size))<<a_size;
b_bits |= (~((~0)<<arg_b_size))<<b_size;
......@@ -1464,7 +1469,7 @@ static void generate_code_for_tail_call_modulo_cons (NodeP node_p,NodeId node_de
a_size+=arg_a_size;
b_size+=arg_b_size;
node_id_list=node_id_list->nidl_next;
}
}
for (n=0; n<a_size; ++n)
bits[n]='0' + ((a_bits>>n) & 1);
......@@ -1519,6 +1524,16 @@ static void generate_code_for_tail_call_modulo_cons (NodeP node_p,NodeId node_de
GenPopB (bsp);
GenRtn (1,0,OnAState);
}
{
MovedNodeIdP moved_node_ids;
moved_node_ids=*moved_node_ids_p;
while (moved_node_ids!=NULL){
moved_node_ids->mnid_node_id->nid_a_index_=moved_node_ids->mnid_a_stack_offset;
moved_node_ids=moved_node_ids->mnid_next;
}
}
}
static int is_tail_call_module_cons_node (NodeP node_p)
......@@ -2016,7 +2031,6 @@ int CodeRhsNodeDefs
}
#endif
#if TAIL_CALL_MODULO_CONS_OPTIMIZATION
if (OptimizeTailCallModuloCons && root_node->node_kind==NormalNode){
if ((root_node->node_symbol->symb_kind==cons_symb && root_node->node_arity==2) ||
......@@ -2059,17 +2073,14 @@ int CodeRhsNodeDefs
node_p=node_p->node_arguments->arg_node;
}
if (!(node_def_id->nid_mark & ON_A_CYCLE_MASK) && is_tail_call_module_cons_node (node_p)){
if (!(node_def_id->nid_mark & ON_A_CYCLE_MASK) && is_tail_call_module_cons_node (node_p)
&& (node_p->node_symbol->symb_def->sdef_rule->rule_mark & RULE_TAIL_MODULO_CONS_ENTRY_MASK))
{
*last_node_def_h=NULL;
CodeSharedNodeDefs (defs,NULL,&asp,&bsp,&code_gen_node_ids);
*last_node_def_h=last_node_def_p;
generate_code_for_tail_call_modulo_cons (node_p,node_def_id,root_node,push_node,asp,bsp,&code_gen_node_ids);
while (moved_node_ids!=NULL){
moved_node_ids->mnid_node_id->nid_a_index_=moved_node_ids->mnid_a_stack_offset;
moved_node_ids=moved_node_ids->mnid_next;
}
generate_code_for_tail_call_modulo_cons (node_p,node_def_id,root_node,push_node,asp,bsp,&moved_node_ids,&code_gen_node_ids);
return 0;
}
......@@ -2088,7 +2099,7 @@ int CodeRhsNodeDefs
node_p=node_p->node_arguments->arg_node;
}
if (is_tail_call_module_cons_node (node_p)){
if (is_tail_call_module_cons_node (node_p) && (node_p->node_symbol->symb_def->sdef_rule->rule_mark & RULE_TAIL_MODULO_CONS_ENTRY_MASK)){
NodeP old_arg_node_p;
node_id_p=NewNodeId (NULL);
......@@ -2099,12 +2110,7 @@ int CodeRhsNodeDefs
arg_p2->arg_node=NewNodeIdNode (node_id_p);
CodeSharedNodeDefs (defs,NULL,&asp,&bsp,&code_gen_node_ids);
generate_code_for_tail_call_modulo_cons (node_p,node_id_p,root_node,push_node_p,asp,bsp,&code_gen_node_ids);
while (moved_node_ids!=NULL){
moved_node_ids->mnid_node_id->nid_a_index_=moved_node_ids->mnid_a_stack_offset;
moved_node_ids=moved_node_ids->mnid_next;
}
generate_code_for_tail_call_modulo_cons (node_p,node_id_p,root_node,push_node_p,asp,bsp,&moved_node_ids,&code_gen_node_ids);
arg_p2->arg_node=old_arg_node_p;
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment