aboutsummaryrefslogtreecommitdiff
path: root/backendC/CleanCompilerSources/codegen.c
diff options
context:
space:
mode:
Diffstat (limited to 'backendC/CleanCompilerSources/codegen.c')
-rw-r--r--backendC/CleanCompilerSources/codegen.c1201
1 files changed, 1201 insertions, 0 deletions
diff --git a/backendC/CleanCompilerSources/codegen.c b/backendC/CleanCompilerSources/codegen.c
new file mode 100644
index 0000000..e85fc5e
--- /dev/null
+++ b/backendC/CleanCompilerSources/codegen.c
@@ -0,0 +1,1201 @@
+
+#define for_l(v,l,n) for(v=(l);v!=NULL;v=v->n)
+
+#define SHARE_UPDATE_CODE 0 /* also in codegen1.c */
+#define SELECTORS_FIRST 1 /* also in codegen2.c */
+
+#include "system.h"
+#include "syntaxtr.t"
+#include "comsupport.h"
+#include "checker.h"
+#include "settings.h"
+#include "sa.h"
+#include "statesgen.h"
+#include "typechecker.h"
+#include "codegen_types.h"
+#include "codegen1.h"
+#include "codegen2.h"
+#include "codegen3.h"
+#include "instructions.h"
+#include "codegen.h"
+#include "optimisations.h"
+#include "pattern_match.h"
+#if SHARE_UPDATE_CODE
+# include "result_state_database.h"
+#endif
+# if TAIL_CALL_MODULO_TUPLE_CONS_OPTIMIZATION
+#include "tuple_tail_recursion.h"
+# endif
+
+static char *ECodeBlock = "incorrect number of output parameters";
+
+static Parameters CalculateOffsetsOfParameters (Parameters params,States resultstates,int statearity,int *asp_p,int *bsp_p);
+
+static Parameters CalculateOffsetsOfParameter (Parameters param,StateS resultstate,int *asp_p,int *bsp_p)
+{
+ if (IsSimpleState (resultstate)){
+ if (param->par_node_id!=NULL)
+ param->par_node_id->nid_state_=resultstate;
+
+ if (resultstate.state_kind==OnB){
+ if (param->par_node_id)
+ param->par_node_id->nid_b_index_=*bsp_p;
+ *bsp_p -= ObjectSizes [resultstate.state_object];
+ } else {
+ if (param->par_node_id)
+ param->par_node_id->nid_a_index_=*asp_p;
+ *asp_p -= 1;
+ }
+
+ return param->par_next;
+ } else {
+ if (resultstate.state_type==ArrayState){
+ if (param->par_node_id)
+ param->par_node_id->nid_a_index_=*asp_p;
+ *asp_p -= 1;
+
+ return param->par_next;
+ } else
+ return CalculateOffsetsOfParameters (param,resultstate.state_tuple_arguments,resultstate.state_arity,asp_p,bsp_p);
+ }
+}
+
+static Parameters CalculateOffsetsOfParameters (Parameters params,States resultstates,int statearity,int *asp_p,int *bsp_p)
+{
+ int arity;
+
+ for (arity=0; arity<statearity; arity++){
+ if (params)
+ params = CalculateOffsetsOfParameter (params,resultstates[arity],asp_p,bsp_p);
+ else {
+ StaticMessage (True,CurrentAltLabel.lab_symbol->sdef_ident->ident_name,ECodeBlock);
+ break;
+ }
+ }
+
+ return params;
+}
+
+static void GenCodeBlock (CodeBlock code, int asp, int bsp, StateS resultstate)
+{
+ int newasp,newbsp,asize,bsize;
+
+ DetermineSizeOfState (resultstate,&newasp,&newbsp);
+
+ if (code->co_is_abc_code){
+ GenInstructions (code->co_instr);
+ GenRtn (newasp, newbsp, resultstate);
+ } else {
+ Parameters nextparam;
+
+ asize = newasp;
+ bsize = newbsp;
+
+ if (IsSimpleState (resultstate))
+ nextparam = CalculateOffsetsOfParameter (code->co_parout,resultstate,&asize,&bsize);
+ else {
+ switch (resultstate.state_type){
+ case TupleState:
+ nextparam = CalculateOffsetsOfParameters (code->co_parout,resultstate.state_tuple_arguments,
+ resultstate.state_arity,&asize,&bsize);
+ break;
+ case RecordState:
+ nextparam = CalculateOffsetsOfParameters (code->co_parout,resultstate.state_record_arguments,
+ resultstate.state_arity,&asize,&bsize);
+ break;
+ case ArrayState:
+ if (code->co_parout->par_node_id!=NULL)
+ code->co_parout->par_node_id->nid_state_=resultstate;
+ code->co_parout->par_node_id->nid_a_index_=asize;
+ asize -= 1;
+ nextparam=code->co_parout->par_next;
+ break;
+ }
+ }
+
+ if (nextparam)
+ StaticMessage (True,CurrentAltLabel.lab_symbol->sdef_ident->ident_name, ECodeBlock);
+
+ GenParameters (True, code->co_parin, asp, bsp);
+ GenInstructions (code->co_instr);
+ GenOStackLayoutOfState (newasp, newbsp, resultstate);
+ GenParameters (False, code->co_parout, newasp, newbsp);
+ GenRtn (newasp, newbsp, resultstate);
+ }
+}
+
+static Bool CodeRuleAlt (RuleAlts alt,int asp,int bsp,unsigned int altnr,StateS resultstate)
+{
+ struct label esclab;
+ struct esc esc;
+ struct ab_node_ids ab_node_ids;
+
+ ab_node_ids.a_node_ids=NULL;
+ ab_node_ids.b_node_ids=NULL;
+#if BUILD_FREE_NODE_ID_LIST_DURING_PATTER_MATCH
+ ab_node_ids.free_node_ids=NULL;
+#endif
+
+ esc.esc_asp=asp;
+ esc.esc_bsp=bsp;
+ esc.esc_label=&esclab;
+
+ MakeSymbolLabel (&esclab,CurrentAltLabel.lab_mod,s_pref,CurrentAltLabel.lab_symbol,altnr+1);
+
+ LhsComment (altnr, asp, bsp);
+
+ bind_arguments (alt->alt_lhs_root->node_arguments,asp,bsp,&ab_node_ids);
+ MatchArgs (alt->alt_lhs_root->node_arguments,asp,bsp,asp,bsp,&ab_node_ids);
+
+ if (alt->alt_kind==Contractum)
+ return generate_code_for_root_node (alt->alt_rhs_root,asp,bsp,&esc,alt->alt_rhs_defs,&resultstate,NULL,&ab_node_ids);
+ else {
+ GenCodeBlock (alt->alt_rhs_code,asp,bsp,resultstate);
+ return False;
+ }
+
+#ifdef _FRAMECHECK_
+ if (MaxAFrameSize !=0 || MaxBFrameSize != 0 || OfferedAFrame != InitOfferedAFrame)
+ ErrorInCompiler ("codegen2.c", "CodeRuleAlt","inconsistent stack frames");
+#endif
+}
+
+static void MoveArgumentFromAToB (StateS argstate,int index,int *current_asp_p,int *old_asp_p,int *dest_asp_p)
+{
+ if (IsSimpleState (argstate)){
+ if (argstate.state_kind==OnB)
+ PushBasicFromAOnB ((ObjectKind)(argstate.state_object),*current_asp_p-index);
+ else if (argstate.state_kind!=Undefined)
+ PutInAFrames (index,dest_asp_p);
+ } else {
+ int arity;
+
+ arity = argstate.state_arity;
+
+ switch (argstate.state_type){
+ case TupleState:
+ {
+ int locindex,i;
+ States argstates;
+
+ argstates = argstate.state_tuple_arguments;
+
+ if (*old_asp_p==index)
+ --*old_asp_p;
+
+ *old_asp_p += arity;
+ locindex = *old_asp_p;
+
+ for (i=arity-1; i>=0; --i)
+ MoveArgumentFromAToB (argstates [i],locindex-i,current_asp_p,old_asp_p,dest_asp_p);
+ break;
+ }
+ case RecordState:
+ {
+ int asize,bsize,a_index,element_n;
+
+ DetermineSizeOfStates (arity,argstate.state_record_arguments,&asize,&bsize);
+
+ if (*current_asp_p==index){
+ GenReplRArgs (asize,bsize);
+ *current_asp_p += asize-1;
+ } else {
+ GenPushRArgs (*current_asp_p-index,asize,bsize);
+ *current_asp_p += asize;
+ }
+
+ a_index=*current_asp_p;
+ for (element_n=asize-1; element_n>=0; --element_n)
+ PutInAFrames (a_index-element_n,dest_asp_p);
+ break;
+ }
+ case ArrayState:
+ GenPushArray (*current_asp_p-index);
+ *current_asp_p += 1;
+ PutInAFrames (*current_asp_p,dest_asp_p);
+ break;
+ }
+ }
+}
+
+static void MoveStateArgumentsFromAToB (int n_states,StateP state_p,int index,int *current_asp_p,int *old_asp_p,int *dest_asp_p)
+{
+ int i;
+
+ for (i=n_states-1; i>=0; --i)
+ MoveArgumentFromAToB (state_p[i],index-i,current_asp_p,old_asp_p,dest_asp_p);
+}
+
+static void EvaluateArgument (StateS argstate,int *asp_p,int index)
+{
+ if (!IsLazyState (argstate)){
+ switch (argstate.state_type){
+ case SimpleState:
+ case RecordState:
+ case ArrayState:
+ GenJsrEval (*asp_p-index);
+ break;
+ case TupleState:
+ {
+ int i,arity,locasp;
+
+ arity = argstate.state_arity;
+
+ if (*asp_p-index > 0){
+ GenPushA (*asp_p-index);
+ GenJsrEval (0);
+ GenReplArgs (arity,arity);
+ } else {
+ GenJsrEval (0);
+ GenReplArgs (arity,arity);
+ --*asp_p;
+ }
+ *asp_p += arity;
+ locasp = *asp_p;
+
+ for (i=arity-1; i>=0; i--)
+ EvaluateArgument (argstate.state_tuple_arguments[i],asp_p,locasp-i);
+ break;
+ }
+ }
+ }
+}
+
+static void EvaluateStateArguments (int n_states,StateP state_p,int *asp_p,int index)
+{
+ int i;
+
+ for (i=n_states-1; i>=0; i--)
+ EvaluateArgument (state_p[i],asp_p,index-i);
+}
+
+void EvaluateAndMoveArguments (int arity,StateP argstates,int *locasp_p,int *aselmts_p)
+{
+ int i,index;
+
+ index=*locasp_p;
+
+ for (i=arity-1; i>=0; i--)
+ EvaluateArgument (argstates[i],locasp_p, arity-i);
+
+ for (i=arity-1; i>=0; i--)
+ MoveArgumentFromAToB (argstates[i],arity-i,locasp_p,&index,aselmts_p);
+}
+
+void EvaluateAndMoveStateArguments (int state_arity,StateP states,int oldasp,int maxassize)
+{
+ int oldaframesize,arity,newasp,i;
+
+ arity = oldasp;
+ newasp = 0;
+
+ InitAStackConversions (arity + maxassize + 1,&oldaframesize);
+
+ for (i=state_arity-1; i>=0; i--)
+ EvaluateArgument (states[i],&oldasp,state_arity-i);
+
+ for (i=state_arity-1; i>=0; i--)
+ MoveArgumentFromAToB (states[i],state_arity-i,&oldasp,&arity,&newasp);
+
+ GenAStackConversions (oldasp,newasp);
+
+ FreeAFrameSpace (oldaframesize);
+}
+
+static void EvaluateArgumentIfNecesary (StateS argstate,int *asp_p,int index,struct state *state_p)
+{
+ if (!IsLazyState (argstate)){
+ switch (argstate.state_type){
+ case SimpleState:
+ case RecordState:
+ case ArrayState:
+ if (IsLazyState (*state_p))
+ GenJsrEval (*asp_p-index);
+ break;
+ case TupleState:
+ {
+ int i,arity,locasp;
+
+ arity = argstate.state_arity;
+
+ if (*asp_p-index > 0){
+ GenPushA (*asp_p-index);
+ if (IsLazyState (*state_p))
+ GenJsrEval (0);
+ GenReplArgs (arity,arity);
+ } else {
+ if (IsLazyState (*state_p))
+ GenJsrEval (0);
+ GenReplArgs (arity,arity);
+ --*asp_p;
+ }
+ *asp_p += arity;
+ locasp = *asp_p;
+
+ if (state_p->state_type==TupleState){
+ for (i=arity-1; i>=0; i--)
+ EvaluateArgumentIfNecesary (argstate.state_tuple_arguments[i],asp_p,locasp-i,&state_p->state_tuple_arguments[i]);
+ } else
+ for (i=arity-1; i>=0; i--)
+ EvaluateArgument (argstate.state_tuple_arguments[i],asp_p,locasp-i);
+ break;
+ }
+ }
+ }
+}
+
+static void EvaluateArgumentsForFunctionWithOneCall (int n_states,StateP arg_state_p,int *asp_p,int index,ArgP call_arg)
+{
+ if (call_arg==NULL)
+ EvaluateStateArguments (n_states,arg_state_p,asp_p,index);
+ else
+ if (n_states>0){
+ EvaluateArgumentsForFunctionWithOneCall (n_states-1,arg_state_p+1,asp_p,index-1,call_arg->arg_next);
+ EvaluateArgumentIfNecesary (*arg_state_p,asp_p,index,state_of_node_or_node_id (call_arg->arg_node));
+ }
+}
+
+static void EvaluateAndMoveArgumentsForFunctionWithOneCall (StateS *const function_state_p,int oldasp,int maxassize,struct node *call_node)
+{
+ int oldaframesize,arity,newasp;
+
+ arity = oldasp;
+ newasp = 0;
+
+ InitAStackConversions (arity + maxassize + 1, &oldaframesize);
+
+ EvaluateArgumentsForFunctionWithOneCall (arity,function_state_p,&oldasp,arity,call_node->node_arguments);
+
+ MoveStateArgumentsFromAToB (arity,function_state_p,arity,&oldasp,&arity,&newasp);
+
+ GenAStackConversions (oldasp,newasp);
+
+ FreeAFrameSpace (oldaframesize);
+}
+
+void EvalArgsEntry (StateS *const function_state_p,SymbDef rule_sdef,int maxasize,Label ea_lab,int n_result_nodes_on_a_stack)
+{
+ int asp;
+
+ asp=rule_sdef->sdef_arity;
+
+ GenOAStackLayout (asp+n_result_nodes_on_a_stack);
+
+ if (DoTimeProfiling)
+ GenPN();
+ GenLabelDefinition (ea_lab);
+
+ if (rule_sdef->sdef_kind==IMPRULE && (rule_sdef->sdef_rule->rule_mark & RULE_LAZY_CALL_NODE_MASK))
+ EvaluateAndMoveArgumentsForFunctionWithOneCall (function_state_p,asp,maxasize,rule_sdef->sdef_rule->rule_lazy_call_node);
+ else
+ EvaluateAndMoveStateArguments (asp,function_state_p,asp,maxasize);
+}
+
+static void EvaluateArgumentsForFunctionWithUnboxedArguments (int n_states,StateP arg_state_p,int *asp_p,int index,ArgP call_arg)
+{
+ if (n_states==0)
+ return;
+ else {
+ if (call_arg->arg_state.state_type==SimpleState && call_arg->arg_state.state_kind==OnB)
+ EvaluateArgumentsForFunctionWithUnboxedArguments (n_states-1,arg_state_p+1,asp_p,index,call_arg->arg_next);
+ else {
+ EvaluateArgumentsForFunctionWithUnboxedArguments (n_states-1,arg_state_p+1,asp_p,index-1,call_arg->arg_next);
+ EvaluateArgumentIfNecesary (*arg_state_p,asp_p,index,!IsLazyState (call_arg->arg_state) ? &call_arg->arg_state : state_of_node_or_node_id (call_arg->arg_node));
+ }
+ }
+}
+
+static void MoveArgumentsToBStack (StateS src_state,StateS dest_state,
+ int a_index,int *current_asp_p,int *old_asp_p,int *dest_asp_p,
+ int b_index,int *current_bsp_p,int *dest_bsp_p)
+{
+ if (IsSimpleState (dest_state)){
+ if (dest_state.state_kind==OnB){
+ if (src_state.state_type==SimpleState && src_state.state_kind==OnB)
+ PutInBFrames (b_index,dest_bsp_p,ObjectSizes[dest_state.state_object]);
+ else {
+ PushBasicFromAOnB ((ObjectKind)(dest_state.state_object),*current_asp_p-a_index);
+ *current_bsp_p+=ObjectSizes[dest_state.state_object];
+ PutInBFrames (*current_bsp_p,dest_bsp_p,ObjectSizes[dest_state.state_object]);
+ }
+ } else if (dest_state.state_kind!=Undefined)
+ PutInAFrames (a_index,dest_asp_p);
+ } else {
+ switch (dest_state.state_type){
+ case TupleState:
+ {
+ int tuple_a_index,i,arity;
+ States dest_states;
+
+ arity = dest_state.state_arity;
+ dest_states = dest_state.state_tuple_arguments;
+
+ if (*old_asp_p==a_index)
+ --*old_asp_p;
+
+ *old_asp_p += arity;
+
+ tuple_a_index = *old_asp_p;
+ for (i=arity-1; i>=0; --i)
+ MoveArgumentsToBStack (LazyState,dest_states[i],tuple_a_index-i,current_asp_p,old_asp_p,dest_asp_p,-1000,current_bsp_p,dest_bsp_p);
+ break;
+ }
+ case RecordState:
+ {
+ int asize,bsize,record_a_index,element_n,arity;
+
+ arity = dest_state.state_arity;
+
+ DetermineSizeOfStates (arity,dest_state.state_record_arguments,&asize,&bsize);
+
+ if (*current_asp_p==a_index){
+ GenReplRArgs (asize,bsize);
+ *current_asp_p += asize-1;
+ } else {
+ GenPushRArgs (*current_asp_p-a_index,asize,bsize);
+ *current_asp_p += asize;
+ }
+ *current_bsp_p += bsize;
+
+ record_a_index=*current_asp_p;
+ for (element_n=asize-1; element_n>=0; --element_n)
+ PutInAFrames (record_a_index-element_n,dest_asp_p);
+
+ PutInBFrames (*current_bsp_p,dest_bsp_p,bsize);
+ break;
+ }
+ case ArrayState:
+ if (src_state.state_type==ArrayState)
+ PutInAFrames (a_index,dest_asp_p);
+ else {
+ GenPushArray (*current_asp_p-a_index);
+ ++*current_asp_p;
+ PutInAFrames (*current_asp_p,dest_asp_p);
+ }
+ break;
+ }
+ }
+}
+
+static void MoveArgumentsForFunctionWithUnboxedArguments (int n_states,StateP state_p,ArgP call_arg,
+ int a_index,int *current_asp_p,int *old_asp_p,int *dest_asp_p,
+ int b_index,int *current_bsp_p,int *dest_bsp_p)
+{
+ if (n_states==0)
+ return;
+ else {
+ int next_a_index,next_b_index;
+
+ if (call_arg->arg_state.state_type==SimpleState && call_arg->arg_state.state_kind==OnB){
+ next_a_index=a_index;
+ next_b_index=b_index-ObjectSizes[call_arg->arg_state.state_object];
+ } else {
+ next_a_index=a_index-1;
+ next_b_index=b_index;
+ }
+ MoveArgumentsForFunctionWithUnboxedArguments (n_states-1,state_p+1,call_arg->arg_next,
+ next_a_index,current_asp_p,old_asp_p,dest_asp_p,
+ next_b_index,current_bsp_p,dest_bsp_p);
+ MoveArgumentsToBStack (call_arg->arg_state,*state_p,a_index,current_asp_p,old_asp_p,dest_asp_p,b_index,current_bsp_p,dest_bsp_p);
+ }
+}
+
+static void EvalArgsEntryUnboxed (ImpRuleP rule_p,SymbDef rule_sdef,int strict_a_size,int strict_b_size,int maxasize,Label ea_lab,int n_result_nodes_on_a_stack)
+{
+ int args_a_size,args_b_size,old_a_frame_size,old_b_frame_size,init_a_stack_size;
+ int old_asp,old_bsp,new_asp,new_bsp;
+ StateP function_state_p;
+ NodeP call_node_p;
+
+ function_state_p=rule_p->rule_state_p;
+ call_node_p=rule_p->rule_lazy_call_node;
+
+ DetermineSizeOfArguments (call_node_p->node_arguments,&args_a_size,&args_b_size);
+
+ init_a_stack_size=args_a_size + n_result_nodes_on_a_stack;
+ GenOStackLayout (init_a_stack_size,args_b_size,call_node_p->node_arguments);
+
+ if (DoTimeProfiling)
+ GenPN();
+ GenLabelDefinition (ea_lab);
+
+ InitStackConversions (init_a_stack_size+maxasize+1,strict_b_size+1,&old_a_frame_size,&old_b_frame_size);
+
+ old_asp=args_a_size;
+ old_bsp=args_b_size;
+ EvaluateArgumentsForFunctionWithUnboxedArguments (rule_sdef->sdef_arity,function_state_p,&old_asp,args_a_size,call_node_p->node_arguments);
+
+ new_asp=0;
+ new_bsp=0;
+ MoveArgumentsForFunctionWithUnboxedArguments (rule_sdef->sdef_arity,function_state_p,call_node_p->node_arguments,
+ args_a_size,&old_asp,&args_a_size,&new_asp,args_b_size,&old_bsp,&new_bsp);
+
+ GenAStackConversions (old_asp,new_asp);
+ GenBStackConversions (old_bsp,new_bsp);
+
+ FreeAFrameSpace (old_a_frame_size);
+ FreeBFrameSpace (old_b_frame_size);
+}
+
+#if TAIL_CALL_MODULO_CONS_OPTIMIZATION
+int tail_call_modulo_cons;
+#endif
+#if TAIL_CALL_MODULO_TUPLE_CONS_OPTIMIZATION
+int tail_call_modulo_tuple_cons;
+unsigned long global_same_select_vector;
+#endif
+#if OPTIMIZE_LAZY_TUPLE_RECURSION
+int lazy_tuple_recursion=0;
+#endif
+
+#if GENERATE_CODE_AGAIN
+int call_code_generator_again;
+#endif
+
+int function_called_only_curried_or_lazy_with_one_return=0;
+
+#if 0
+# include "dbprint.h"
+#endif
+
+static void CodeRule (ImpRuleP rule)
+{
+ Bool jmp_to_eval_args_entry,root_node_needed;
+ int asize,bsize,maxasize,a_stack_size_of_strict_entry;
+ StateS resultstate;
+ SymbDef rule_sdef;
+ LabDef ea_lab;
+ int init_a_stack_top,init_b_stack_top,rule_may_fail;
+
+# if 0
+ PrintImpRule (rule,4,StdOut);
+# endif
+
+ CurrentSymbol=rule->rule_root->node_symbol;
+ CurrentLine=rule->rule_alts->alt_line;
+
+ resultstate = rule->rule_root->node_state;
+ rule_sdef = CurrentSymbol->symb_def;
+
+ ConvertSymbolToLabel (&CurrentAltLabel,rule_sdef);
+
+ if (rule_sdef->sdef_exported){
+ GenExportStrictAndEaEntry (rule_sdef);
+ } else if (!(rule_sdef->sdef_mark & (SDEF_USED_CURRIED_MASK | SDEF_USED_LAZILY_MASK | SDEF_USED_STRICTLY_MASK)))
+ return;
+
+ GenFunctionDescriptorAndExportNodeAndDescriptor (rule_sdef);
+
+ if (DoTimeProfiling)
+ GenPB (rule_sdef->sdef_ident->ident_name);
+
+ if (rule_sdef->sdef_exported && rule_sdef->sdef_calledwithrootnode && ExpectsResultNode (resultstate))
+ MakeSymbolLabel (&ea_lab,CurrentModule,ea_pref,rule_sdef,0);
+ else
+ MakeSymbolLabel (&ea_lab,NULL,ea_pref,rule_sdef,0);
+
+ asize = 0;
+ bsize = 0;
+ maxasize = 0;
+ AddStateSizesAndMaxFrameSizesOfArguments (rule->rule_root->node_arguments,&maxasize,&asize,&bsize);
+
+ function_called_only_curried_or_lazy_with_one_return=0;
+
+ if (!(rule_sdef->sdef_mark & SDEF_USED_STRICTLY_MASK) &&
+ ( (rule_sdef->sdef_mark & (SDEF_USED_CURRIED_MASK | SDEF_USED_LAZILY_MASK))==SDEF_USED_CURRIED_MASK
+ || (rule_sdef->sdef_mark & (SDEF_USED_CURRIED_MASK | SDEF_USED_LAZILY_MASK))==SDEF_USED_LAZILY_MASK)
+ && !rule_sdef->sdef_returnsnode && rule->rule_alts->alt_kind==Contractum && !(rule->rule_mark & RULE_CAF_MASK))
+ {
+ NodeP node_p;
+
+ node_p=rule->rule_alts->alt_rhs_root;
+
+ while (node_p->node_kind==PushNode || node_p->node_kind==SwitchNode){
+ if (node_p->node_kind==PushNode)
+ node_p=node_p->node_arguments->arg_next->arg_node;
+ else
+ if (node_p->node_arguments->arg_next==NULL)
+ node_p=node_p->node_arguments->arg_node->node_arguments->arg_node;
+ else
+ break;
+ }
+
+ if (node_p->node_kind==NormalNode){
+ if (node_p->node_symbol->symb_kind==tuple_symb ||
+ (node_p->node_symbol->symb_kind==definition && node_p->node_symbol->symb_def->sdef_kind==RECORDTYPE) ||
+ (unsigned)(node_p->node_symbol->symb_kind-int_denot) <= (unsigned)(real_denot-int_denot))
+ function_called_only_curried_or_lazy_with_one_return=1;
+ } else {
+ if (node_p->node_kind==SelectorNode || node_p->node_kind==UpdateNode)
+ function_called_only_curried_or_lazy_with_one_return=1;
+ }
+ }
+
+ if (rule_sdef->sdef_mark & SDEF_USED_CURRIED_MASK)
+ ApplyEntry (rule->rule_state_p,rule_sdef->sdef_arity,&ea_lab,!(rule_sdef->sdef_mark & SDEF_USED_LAZILY_MASK));
+
+ if (rule_sdef->sdef_mark & SDEF_USED_LAZILY_MASK)
+ if (rule->rule_mark & RULE_UNBOXED_LAZY_CALL){
+ int args_a_size,args_b_size;
+
+ DetermineSizeOfArguments (rule->rule_lazy_call_node->node_arguments,&args_a_size,&args_b_size);
+ jmp_to_eval_args_entry = NodeEntryUnboxed (rule->rule_state_p,rule->rule_lazy_call_node,args_a_size,args_b_size,&ea_lab,rule_sdef);
+ } else
+ jmp_to_eval_args_entry = NodeEntry (rule->rule_state_p,rule_sdef->sdef_arity,&ea_lab,rule_sdef);
+ else
+ jmp_to_eval_args_entry = False;
+
+ init_a_stack_top = asize;
+ init_b_stack_top = bsize;
+
+ root_node_needed = ! (IsOnBStack (resultstate) ||
+ (IsSimpleState (resultstate) && resultstate.state_kind==StrictRedirection));
+
+ a_stack_size_of_strict_entry=root_node_needed ? init_a_stack_top+1 : init_a_stack_top;
+
+ CurrentAltLabel.lab_pref = s_pref;
+ CurrentAltLabel.lab_post = 0;
+
+ if (rule_sdef->sdef_exported){
+ Bool ext_label_needed;
+ LabDef extlab;
+
+ extlab = CurrentAltLabel;
+ extlab.lab_post = 0;
+ CurrentAltLabel.lab_mod = NULL;
+
+ if (rule_sdef->sdef_dcl_icl!=NULL){
+ switch (rule_sdef->sdef_dcl_icl->sdef_kind){
+ case DEFRULE:
+ case SYSRULE:
+ ext_label_needed = ConvertExternalToInternalCall (rule_sdef->sdef_arity,
+ rule_sdef->sdef_dcl_icl->sdef_rule_type->rule_type_state_p,rule->rule_state_p,
+ jmp_to_eval_args_entry,init_a_stack_top, init_b_stack_top, &ea_lab, &extlab, root_node_needed);
+ break;
+ case INSTANCE:
+ ext_label_needed=True;
+ break;
+ default:
+ ErrorInCompiler ("codegen.c","CodeRule","unknown kind of rewrite rule");
+ break;
+ }
+ } else
+ ext_label_needed=True;
+
+ EvalArgsEntry (rule->rule_state_p,rule_sdef,maxasize,&ea_lab,root_node_needed ? 1 : 0);
+
+ if (ext_label_needed){
+ GenOStackLayoutOfStates (a_stack_size_of_strict_entry,init_b_stack_top,rule_sdef->sdef_arity,rule->rule_state_p);
+ GenLabelDefinition (&extlab);
+ }
+ } else if (rule_sdef->sdef_mark & (SDEF_USED_CURRIED_MASK | SDEF_USED_LAZILY_MASK))
+ if (rule->rule_mark & RULE_UNBOXED_LAZY_CALL)
+ EvalArgsEntryUnboxed (rule,rule_sdef,asize,bsize,maxasize,&ea_lab,root_node_needed ? 1 : 0);
+ else
+ EvalArgsEntry (rule->rule_state_p,rule_sdef,maxasize,&ea_lab,root_node_needed ? 1 : 0);
+
+ if ((rule->rule_mark & RULE_CAF_MASK) && ! (rule->rule_alts->alt_rhs_root->node_kind==NormalNode &&
+ (unsigned)(rule->rule_alts->alt_rhs_root->node_symbol->symb_kind-int_denot) <= (unsigned)(real_denot-int_denot)))
+ {
+ LabDef caf_label,local_label;
+ int a_size,b_size;
+
+ GenOStackLayoutOfStates (a_stack_size_of_strict_entry,init_b_stack_top,rule_sdef->sdef_arity,rule->rule_state_p);
+ GenLabelDefinition (&CurrentAltLabel);
+
+ MakeSymbolLabel (&caf_label,NULL,caf_pref,rule_sdef,0);
+ MakeLabel (&local_label,m_symb,NewLabelNr++,no_pref);
+
+ DetermineSizeOfState (resultstate,&a_size,&b_size);
+
+ GenTestCaf (&caf_label);
+ GenJmpFalse (&local_label);
+
+ GenPushCaf (&caf_label,a_size,b_size);
+
+ if (root_node_needed){
+ GenFillFromA (0,1,NormalFill);
+ GenPopA (1);
+ }
+ GenRtn (a_size,b_size,resultstate);
+
+ GenCaf (&caf_label,a_size,b_size);
+
+ GenLabelDefinition (&local_label);
+
+ ++CurrentAltLabel.lab_post;
+
+ GenDStackLayoutOfStates (a_stack_size_of_strict_entry,init_b_stack_top,rule_sdef->sdef_arity,rule->rule_state_p);
+ GenJsr (&CurrentAltLabel);
+ GenOStackLayoutOfState (a_size,b_size,resultstate);
+
+ GenFillCaf (&caf_label,a_size,b_size);
+ GenRtn (a_size,b_size,resultstate);
+ }
+
+#if 0
+ if (rule_sdef->sdef_exported || rule_sdef->sdef_mark & SDEF_USED_STRICTLY_MASK || rule->rule_mark & RULE_CAF_MASK){
+#endif
+
+ if (!function_called_only_curried_or_lazy_with_one_return){
+ GenOStackLayoutOfStates (a_stack_size_of_strict_entry,init_b_stack_top,rule_sdef->sdef_arity,rule->rule_state_p);
+ GenLabelDefinition (&CurrentAltLabel);
+ }
+
+#if 0
+ }
+#endif
+
+#if GENERATE_CODE_AGAIN
+ call_code_generator_again=0;
+
+ {
+ struct saved_node_id_ref_counts *saved_node_id_ref_counts_p;
+ 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){
+ 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;
+ }
+ } else
+ tail_call_modulo_cons=0;
+# endif
+
+# if TAIL_CALL_MODULO_TUPLE_CONS_OPTIMIZATION
+ tail_call_modulo_tuple_cons=0;
+ if (rule->rule_alts->alt_kind==Contractum){
+ int has_tuple_tail_call;
+
+ global_same_select_vector=(unsigned long)-1l;
+ has_tuple_tail_call=0;
+
+ if (roots_are_tuples_or_calls_to_this_function_and_compute_same_select_vector (rule->rule_alts->alt_rhs_root,rule->rule_alts->alt_rhs_defs,rule_sdef,&global_same_select_vector,&has_tuple_tail_call) &&
+ has_tuple_tail_call!=0)
+ {
+ /* printf ("%x\n",global_same_select_vector); */
+
+ rule->rule_mark |= RULE_CALL_VIA_LAZY_SELECTIONS_ONLY;
+ tail_call_modulo_tuple_cons=1;
+ }
+ }
+# endif
+
+# if OPTIMIZE_LAZY_TUPLE_RECURSION
+ if (rule->rule_mark & RULE_CALL_VIA_LAZY_SELECTIONS_ONLY)
+ call_code_generator_again=1;
+# endif
+
+ if (call_code_generator_again){
+ struct saved_case_node_id_ref_counts **saved_case_node_id_ref_counts_h;
+
+ saved_node_id_ref_counts_p=save_lhs_node_id_ref_counts (rule->rule_alts->alt_lhs_root,NULL);
+ saved_case_node_id_ref_counts_h=&saved_case_node_id_ref_counts_p;
+ saved_case_node_id_ref_counts_p=NULL;
+ saved_node_id_ref_counts_p=save_rhs_node_id_ref_counts (rule->rule_alts->alt_rhs_root,rule->rule_alts->alt_rhs_defs,
+ saved_node_id_ref_counts_p,&saved_case_node_id_ref_counts_h);
+ }
+#endif
+
+ rule_may_fail=CodeRuleAlt (rule->rule_alts,init_a_stack_top,init_b_stack_top,CurrentAltLabel.lab_post,resultstate);
+
+ if (function_called_only_curried_or_lazy_with_one_return){
+ StateS *function_state_p;
+
+ function_state_p=rule->rule_state_p;
+
+ if (IsSimpleState (function_state_p[-1])){
+ if (function_state_p[-1].state_kind==OnB){
+ if (rule_sdef->sdef_mark & SDEF_USED_LAZILY_MASK)
+ FillBasicFromB (function_state_p[-1].state_object, 0, 0, ReleaseAndFill);
+ else
+ BuildBasicFromB (function_state_p[-1].state_object,0);
+
+ GenPopB (ObjectSizes [function_state_p[-1].state_object]);
+ GenRtn (1,0,OnAState);
+ }
+ } else {
+ int asize, bsize;
+
+ DetermineSizeOfState (function_state_p[-1], &asize, &bsize);
+
+ if (rule_sdef->sdef_mark & SDEF_USED_LAZILY_MASK){
+ switch (function_state_p[-1].state_type){
+ case TupleState:
+ BuildTuple (asize,bsize,asize,bsize,function_state_p[-1].state_arity,
+ function_state_p[-1].state_tuple_arguments,asize, bsize, 0, ReleaseAndFill,False);
+ break;
+ case RecordState:
+ BuildRecord (function_state_p[-1].state_record_symbol,asize, bsize, asize, bsize,
+ asize, bsize, 0, ReleaseAndFill, False);
+ break;
+ case ArrayState:
+ GenFillArray (0, 1, ReleaseAndFill);
+ break;
+ }
+ GenPopA (asize);
+ } else {
+ switch (function_state_p[-1].state_type){
+ case TupleState:
+ BuildTuple (asize, bsize, asize, bsize, function_state_p[-1].state_arity,
+ function_state_p[-1].state_tuple_arguments,asize,bsize, asize,NormalFill,True);
+ break;
+ case RecordState:
+ BuildRecord (function_state_p[-1].state_record_symbol,asize, bsize, asize, bsize,
+ asize, bsize, asize, NormalFill,True);
+ break;
+ case ArrayState:
+ GenBuildArray (0);
+ break;
+ }
+#if UPDATE_POP
+ GenUpdatePopA (0, asize);
+#else
+ GenUpdateA (0, asize);
+ GenPopA (asize);
+#endif
+ }
+
+ GenPopB (bsize);
+ GenRtn (1,0,OnAState);
+ }
+
+ function_called_only_curried_or_lazy_with_one_return=0;
+ }
+
+ if (rule_may_fail){
+ ++CurrentAltLabel.lab_post;
+
+ CurrentLine=rule->rule_alts->alt_line;
+ StaticMessage (FunctionMayFailIsError, "%S", "function may fail", CurrentSymbol);
+
+ MatchError (asize,bsize,rule_sdef,root_node_needed,0);
+ }
+
+#if GENERATE_CODE_AGAIN
+ if (call_code_generator_again)
+ restore_node_id_ref_counts (saved_node_id_ref_counts_p,saved_case_node_id_ref_counts_p);
+ }
+#endif
+
+#if TAIL_CALL_MODULO_CONS_OPTIMIZATION
+ if (tail_call_modulo_cons)
+ tail_call_modulo_cons=2;
+#endif
+#if TAIL_CALL_MODULO_TUPLE_CONS_OPTIMIZATION
+ if (tail_call_modulo_tuple_cons)
+ tail_call_modulo_tuple_cons=2;
+#endif
+
+#if GENERATE_CODE_AGAIN
+ if (
+# if TAIL_CALL_MODULO_CONS_OPTIMIZATION
+ tail_call_modulo_cons ||
+# endif
+ (rule->rule_mark & RULE_CALL_VIA_LAZY_SELECTIONS_ONLY)){
+# if 0
+ PrintImpRule (rule,4,StdOut);
+# endif
+ call_code_generator_again=0;
+
+ CurrentAltLabel.lab_post=2;
+
+#if OPTIMIZE_LAZY_TUPLE_RECURSION
+ if (rule->rule_mark & RULE_CALL_VIA_LAZY_SELECTIONS_ONLY){
+ int tuple_result_arity;
+ StateS result_state_struct[1];
+#if SELECTORS_FIRST
+ LabDef reduce_error_label;
+#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){
+ int i,n;
+
+ n=tuple_result_arity;
+ for (i=0; i<n; ++i)
+ if (global_same_select_vector & (1<<i))
+ --tuple_result_arity;
+ }
+#endif
+
+ GenFunctionDescriptorForLazyTupleRecursion (rule_sdef,tuple_result_arity);
+
+ result_state_struct[0]=OnAState;
+
+#if SELECTORS_FIRST
+ {
+ LabDef d_lab,n_lab;
+ int a_size,b_size;
+
+ ConvertSymbolToDandNLabel (&d_lab,&n_lab,rule_sdef);
+
+ d_lab.lab_post = n_lab.lab_post = 3;
+
+ if (rule->rule_mark & RULE_UNBOXED_LAZY_CALL){
+ DetermineSizeOfArguments (rule->rule_lazy_call_node->node_arguments,&a_size,&b_size);
+ } else {
+ a_size=rule_sdef->sdef_arity;
+ b_size=0;
+ }
+ b_size+=a_size;
+ a_size=tuple_result_arity;
+
+ if (b_size!=0)
+ GenNodeEntryDirectiveUnboxed (a_size,b_size,&d_lab,NULL);
+ else
+ GenNodeEntryDirective (a_size,&d_lab,NULL);
+
+ GenOAStackLayout (0);
+ GenLabelDefinition (&n_lab);
+ GenDAStackLayout (0);
+ GenJmp (ReduceError);
+
+ reduce_error_label=n_lab;
+ /*
+ reduce_error_label = CurrentAltLabel;
+ reduce_error_label.lab_pref="n";
+ reduce_error_label.lab_post=3;
+ */
+ ReduceError = &reduce_error_label;
+ }
+#else
+ ReduceError = &empty_lab;
+#endif
+
+ ea_lab.lab_post=2;
+
+ if (rule->rule_mark & RULE_UNBOXED_LAZY_CALL){
+ int args_a_size,args_b_size;
+
+ DetermineSizeOfArguments (rule->rule_lazy_call_node->node_arguments,&args_a_size,&args_b_size);
+ NodeEntryUnboxed (&result_state_struct[1],rule->rule_lazy_call_node,args_a_size + tuple_result_arity,args_b_size,&ea_lab,rule_sdef);
+ } else
+ NodeEntry (&result_state_struct[1],rule_sdef->sdef_arity + tuple_result_arity,&ea_lab,rule_sdef);
+
+ if (DoParallel)
+ ReduceError = &reserve_lab;
+ else
+ ReduceError = &cycle_lab;
+
+#if SELECTORS_FIRST
+ if (rule_sdef->sdef_arity!=0){
+ int n;
+
+ for (n=tuple_result_arity; n!=0; --n)
+ GenPushA (tuple_result_arity-1);
+
+ for (n=0; n<rule_sdef->sdef_arity; ++n)
+ GenUpdateA (n+tuple_result_arity+tuple_result_arity,n+tuple_result_arity);
+
+ for (n=0; n<tuple_result_arity; ++n)
+ GenUpdateA (n,n+tuple_result_arity+rule_sdef->sdef_arity);
+
+ GenPopA (tuple_result_arity);
+ }
+#endif
+
+ CurrentAltLabel.lab_pref = s_pref;
+ if (rule->rule_mark & RULE_UNBOXED_LAZY_CALL)
+ EvalArgsEntryUnboxed (rule,rule_sdef,asize,bsize,maxasize,&ea_lab,tuple_result_arity);
+ else
+ EvalArgsEntry (rule->rule_state_p,rule_sdef,maxasize,&ea_lab,tuple_result_arity);
+
+ GenOStackLayoutOfStates (a_stack_size_of_strict_entry + tuple_result_arity,init_b_stack_top,rule_sdef->sdef_arity,rule->rule_state_p);
+
+ init_a_stack_top += tuple_result_arity;
+ lazy_tuple_recursion=1;
+ } else
+#endif
+ GenOStackLayoutOfStates (a_stack_size_of_strict_entry,init_b_stack_top,rule_sdef->sdef_arity,rule->rule_state_p);
+
+ CurrentAltLabel.lab_pref = s_pref;
+ GenLabelDefinition (&CurrentAltLabel);
+
+ if (CodeRuleAlt (rule->rule_alts,init_a_stack_top,init_b_stack_top,CurrentAltLabel.lab_post,resultstate)){
+ ++CurrentAltLabel.lab_post;
+
+ CurrentLine=rule->rule_alts->alt_line;
+ MatchError (asize,bsize,rule_sdef,root_node_needed,1);
+ }
+
+#if OPTIMIZE_LAZY_TUPLE_RECURSION
+ lazy_tuple_recursion=0;
+#endif
+ }
+#endif
+
+ if (DoTimeProfiling)
+ GenPE();
+}
+
+void CodeGeneration (ImpMod imod, char *fname)
+{
+ if (! CompilerError){
+ int DoStrictnessAnalysis_and_init_ok;
+ CurrentPhase = NULL;
+
+#if 0
+ PrintRules (imod->im_rules);
+#endif
+
+ DetermineSharedAndAnnotatedNodes (imod->im_rules,&imod->im_symbols);
+ ExitOnInterrupt();
+
+ GenerateStatesForRecords (imod->im_symbols);
+
+#ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
+ {
+ ImpRuleP rule_p;
+
+ for_l (rule_p,imod->im_rules,rule_next)
+ transform_patterns_to_case_and_guard_nodes (rule_p->rule_alts);
+ }
+#endif
+#if 0
+ PrintRules (imod->im_rules);
+#endif
+ DoStrictnessAnalysis_and_init_ok = DoStrictnessAnalysis && init_strictness_analysis (imod);
+
+ if (DoStrictnessAnalysis_and_init_ok){
+ do_strictness_analysis();
+ ExitOnInterrupt();
+ }
+
+ ExamineTypesAndLhsOfSymbols (imod->im_symbols);
+
+#ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
+ {
+ ImpRuleP rule_p;
+
+ for_l (rule_p,imod->im_rules,rule_next)
+ determine_failing_cases_and_adjust_ref_counts_of_rule (rule_p->rule_alts);
+ }
+#endif
+
+ optimise_strict_tuple_result_functions=DoStrictnessAnalysis;
+
+ generate_states (imod->im_rules,True);
+
+ if (DoStrictnessAnalysis_and_init_ok){
+ ExitOnInterrupt();
+
+ finish_strictness_analysis();
+ }
+ ExitOnInterrupt();
+
+ ListTypes (imod);
+ ExitOnInterrupt();
+#if 0
+ PrintRules (imod->im_rules);
+#endif
+
+ optimise_strict_tuple_result_functions=0;
+
+ OptimiseRules (imod->im_rules,imod->im_start);
+ ExitOnInterrupt();
+#if 0
+ PrintRules (imod->im_rules);
+#endif
+ if (DoCode){
+ ImpRuleS *rule;
+
+ Verbose ("Code generation");
+
+ if (!OpenABCFile (fname)){
+ StaticMessage (True, "<open file>","Can't create abc file (disk full?)");
+ return;
+ }
+
+ InitFileInfo (imod);
+
+ if (DoParallel)
+ ReduceError = &reserve_lab;
+ else
+ ReduceError = &cycle_lab; /* in sequential case we have no reservation mechanism */
+
+ GenDependencyList();
+#if IMPORT_OBJ_AND_LIB
+ {
+ struct string_list *sl;
+
+ for_l (sl,imod->im_imported_objs,sl_next)
+ GenImpObj (sl->sl_string);
+ for_l (sl,imod->im_imported_libs,sl_next)
+ GenImpLib (sl->sl_string);
+ }
+#endif
+
+#if WRITE_DCL_MODIFICATION_TIME
+ if (WriteModificationTimes){
+ GenModuleDescriptor (imod->im_modification_time);
+ GenEndInfo();
+ } else {
+ GenEndInfo();
+ GenModuleDescriptor (imod->im_modification_time);
+ }
+#else
+ GenEndInfo();
+ GenModuleDescriptor();
+#endif
+ GenSystemImports();
+ FileComment();
+ ExitOnInterrupt();
+
+ ReadInlineCode ();
+
+ CreateStackFrames();
+
+ ImportSymbols (imod->im_symbols);
+
+ GenerateCodeForConstructorsAndRecords (imod->im_symbols);
+
+ if (imod->im_start)
+ GenStart (imod->im_start);
+ ExitOnInterrupt ();
+
+#if SHARE_UPDATE_CODE
+ create_result_state_database (imod->im_rules);
+#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){
+ CodeRule (rule);
+
+ *update_function_p=NULL;
+ if (first_update_function){
+ while (first_update_function){
+ transform_patterns_to_case_and_guard_nodes (first_update_function->rule_alts);
+#ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
+ determine_failing_cases_and_adjust_ref_counts_of_rule (first_update_function->rule_alts);
+#endif
+ CodeRule (first_update_function);
+
+ first_update_function=first_update_function->rule_next;
+ }
+ update_function_p=&first_update_function;
+ }
+
+ ExitOnInterrupt ();
+ }
+
+ GenerateCodeForLazyTupleSelectorEntries (LazyTupleSelectors);
+ GenerateCodeForLazyArrayFunctionEntries();
+
+ WriteLastNewlineToABCFile();
+
+ CloseABCFile (fname);
+#ifdef _COMPSTATS_
+ PrintCompStats();
+#endif
+ }
+ }
+}