diff options
Diffstat (limited to 'backendC/CleanCompilerSources/codegen3.c')
| -rw-r--r-- | backendC/CleanCompilerSources/codegen3.c | 2373 |
1 files changed, 2373 insertions, 0 deletions
diff --git a/backendC/CleanCompilerSources/codegen3.c b/backendC/CleanCompilerSources/codegen3.c new file mode 100644 index 0000000..b055dd7 --- /dev/null +++ b/backendC/CleanCompilerSources/codegen3.c @@ -0,0 +1,2373 @@ +/* + File: codegen3.c + Authors: Sjaak Smetsers & John van Groningen +*/ + +#define FASTER_STRICT_IF /* also in statesgen.c */ +#define DO_LAZY_SELECTORS_FROM_BOXED_STRICT_RECORDS + +#define for_l(v,l,n) for(v=(l);v!=NULL;v=v->n) +#define for_li(v,i,l,n) for(v=(l),i=0;v!=NULL;v=v->n,++i) +#define for_ll(v1,v2,l1,l2,n1,n2) for(v1=(l1),v2=(l2);v1!=NULL;v1=v1->n1,v2=v2->n2) + +#include "system.h" +#include "syntaxtr.t" +#include "comsupport.h" + +#include "codegen_types.h" +#include "codegen.h" +#include "codegen1.h" +#include "codegen2.h" + +#if GENERATE_CODE_AGAIN +struct saved_node_id_ref_counts { + NodeIdP snir_node_id; + int snir_ref_count; + struct saved_node_id_ref_counts * snir_next; +}; + +struct saved_case_node_id_ref_counts { + NodeIdRefCountListP scnir_nrcl; + int scnir_ref_count; + struct saved_case_node_id_ref_counts * scnir_next; +}; +#endif + +#include "codegen3.h" +#include "instructions.h" +#include "sizes.h" +#include "statesgen.h" +#include "settings.h" +#if TAIL_CALL_MODULO_CONS_OPTIMIZATION +# include "buildtree.h" +#endif +#if TAIL_CALL_MODULO_TUPLE_CONS_OPTIMIZATION +# include "tuple_tail_recursion.h" +#endif + +static void error_in_function (char *m) +{ + ErrorInCompiler ("codegen3.c",m,""); +} + +static void UpdateAAndBStack (int aindex,int bindex,int asize,int bsize,int *asp_p,int *bsp_p) +{ + int i,asp,bsp; +#if UPDATE_POP + int a_popped,b_popped; + + a_popped=0; + b_popped=0; +#endif + asp=*asp_p; + bsp=*bsp_p; + + /* copy the values in the right order ! */ + if (aindex < asize){ + for (i=0; i<asize; i++) + GenUpdateA (asp - (aindex - i), asp - (asize - i)); + } else if (aindex > asize){ + for (i=asize - 1; i >= 0; i--) +#if UPDATE_POP + if (i==0){ + GenUpdatePopA (asp - aindex, asp - asize); + a_popped=1; + } else +#endif + GenUpdateA (asp - (aindex - i), asp - (asize - i)); + } + + if (bindex < bsize){ + for (i=0; i<bsize; i++) + GenUpdateB (bsp - (bindex - i), bsp - (bsize - i)); + } else if (bindex > bsize){ + for (i=bsize - 1; i >= 0; i--) +#if UPDATE_POP + if (i==0){ + GenUpdatePopB (bsp - bindex, bsp - bsize); + b_popped=1; + } else +#endif + GenUpdateB (bsp - (bindex - i), bsp - (bsize - i)); + } + +#if UPDATE_POP + if (!a_popped) +#endif + GenPopA (asp-asize); + + *asp_p=asize; + +#if UPDATE_POP + if (!b_popped) +#endif + GenPopB (bsp-bsize); + + *bsp_p=bsize; +} + +void RedirectResultAndReturn (int asp,int bsp,int source_a_index,int source_b_index,StateS offstate,StateS demstate,int offasize,int offbsize) +{ + if (IsSimpleState (offstate)){ + if (IsSimpleState (demstate)){ + switch (CoerceStateKind (demstate.state_kind, offstate.state_kind)){ + case Reduce: + if (demstate.state_kind==StrictRedirection){ +#if UPDATE_POP + GenUpdatePopA (asp-source_a_index, asp - 1); +#else + GenUpdateA (asp-source_a_index, asp - 1); + GenPopA (asp - 1); +#endif + GenPopB (bsp); + GenJmpEval (); + + return; + } else { + Coercions c; + + c=CoerceStateKind (demstate.state_kind,StrictOnA); + + if (c==AToA || c==AToRoot){ + GenPopB (bsp); + + if (source_a_index==0){ + GenPopA (asp); + GenJmpEval (); + + return; + } else { +#if UPDATE_POP + GenUpdatePopA (asp-source_a_index, asp - 1); +#else + GenUpdateA (asp-source_a_index, asp - 1); + GenPopA (asp - 1); +#endif + +#if ABSTRACT_OBJECT + if (demstate.state_object!=AbstractObj) + GenJmpEvalUpdate(); + else { + GenJsrEval (0); + GenFillFromA (0, 1, ReleaseAndFill); + GenPopA (1); + GenRtn (1,0, OnAState); + } +#else + GenJmpEvalUpdate(); +#endif + return; + } + } else { + GenPopB (bsp); + GenPopA (asp-source_a_index); + GenJsrEval (0); + PushBasicFromAOnB (demstate.state_object, 0); + GenPopA (source_a_index); + } + } + break; + case AToB: + GenPopB (bsp); + PushBasicFromAOnB (demstate.state_object, asp-source_a_index); + GenPopA (asp); + break; + case BToA: + GenPopA (asp); +#if STORE_STRICT_CALL_NODES + if (demstate.state_kind==StrictRedirection){ + BuildBasicFromB (offstate.state_object,bsp-source_b_index); + ++asp; + } else +#endif + FillBasicFromB (offstate.state_object,bsp-source_b_index,0,ReleaseAndFill); + GenPopB (bsp); + break; + case BToB: + { + int bsize; + + bsize = ObjectSizes [demstate.state_object]; + UpdateBasic (bsize,bsp-source_b_index,bsp-bsize); + GenPopA (asp); + GenPopB (bsp-bsize); + break; + } + case AToA: + case AToRoot: + GenPopB (bsp); + if (demstate.state_kind==StrictRedirection){ +#if UPDATE_POP + GenUpdatePopA (asp-source_a_index, asp-1); +#else + GenUpdateA (asp-source_a_index, asp-1); + GenPopA (asp-1); +#endif + } else { + GenFillFromA (asp-source_a_index, asp, ReleaseAndFill); + GenPopA (asp); + } + break; + case CyclicSpine: + GenReduceError (); + StaticMessage (False,CurrentAltLabel.lab_symbol->sdef_ident->ident_name,Co_Wspine); + break; + default: + error_in_function ("RedirectResultAndReturn"); + return; + } + } else { + GenPopB (bsp); + + switch (CoerceStateKind (StrictOnA, offstate.state_kind)){ + case Reduce: + GenJsrEval (asp-source_a_index); + default: +#if UPDATE_POP + GenUpdatePopA (asp-source_a_index, asp-1); +#else + GenUpdateA (asp-source_a_index, asp-1); + GenPopA (asp-1); +#endif + asp = 1; + + switch (demstate.state_type){ + case TupleState: + UnpackTuple (0,&asp,&bsp,True,demstate.state_arity,demstate.state_tuple_arguments); + break; + case RecordState: + UnpackRecord (0,&asp,&bsp,True,demstate.state_arity, demstate.state_record_arguments); + break; + case ArrayState: + UnpackArray (0,&asp,True); + break; + } + } + } + } else if (IsSimpleState (demstate)){ +#if 1 /*JVG 29-5-2000 for Clean 2.0*/ + if (demstate.state_kind==StrictRedirection){ + switch (offstate.state_type){ + case TupleState: + BuildTuple (source_a_index,source_b_index,asp,bsp, + offstate.state_arity, offstate.state_tuple_arguments, + offasize, offbsize, 0, ReleaseAndFill,True); + break; + case RecordState: + BuildRecord (offstate.state_record_symbol,source_a_index,source_b_index, asp, bsp, + offasize, offbsize, 0, ReleaseAndFill,True); + break; + case ArrayState: + GenBuildArray (asp-source_a_index); + ++asp; + } + GenUpdatePopA (0,asp); + GenPopB (bsp); + } else { +#endif + switch (offstate.state_type){ + case TupleState: + BuildTuple (source_a_index,source_b_index,asp,bsp, + offstate.state_arity, offstate.state_tuple_arguments, + offasize, offbsize, 0, ReleaseAndFill,False); + break; + case RecordState: + BuildRecord (offstate.state_record_symbol,source_a_index,source_b_index, asp, bsp, + offasize, offbsize, 0, ReleaseAndFill,False); + break; + case ArrayState: + GenFillArray (asp-source_a_index,asp,ReleaseAndFill); + } + GenPopA (asp); + GenPopB (bsp); +#if 1 /*JVG 29-5-2000 for Clean 2.0*/ + } +#endif + } else { + switch (demstate.state_type){ + case RecordState: + { + int asize, bsize; + + DetermineSizeOfStates (demstate.state_arity, demstate.state_record_arguments,&asize, &bsize); + UpdateAAndBStack (source_a_index,source_b_index, asize, bsize,&asp,&bsp); + break; + } + case TupleState: + if (EqualState (demstate, offstate)){ + int asize, bsize; + + DetermineSizeOfStates (demstate.state_arity,demstate.state_tuple_arguments,&asize, &bsize); + UpdateAAndBStack (source_a_index,source_b_index, asize, bsize,&asp,&bsp); + } else { + GenPopA (asp-source_a_index); + GenPopB (bsp-source_b_index); + asp = source_a_index; + bsp = source_b_index; + AdjustTuple (source_a_index,source_b_index, & asp, & bsp, + demstate.state_arity, + demstate.state_tuple_arguments, + offstate.state_tuple_arguments, offasize, offbsize); + } + break; + case ArrayState: +#if UPDATE_POP + GenUpdatePopA (asp-source_a_index, asp - 1); +#else + GenUpdateA (asp-source_a_index, asp - 1); + GenPopA (asp - 1); +#endif + GenPopB (bsp); + break; + } + } + + if (!function_called_only_curried_or_lazy_with_one_return){ + int asize,bsize; + + DetermineSizeOfState (demstate,&asize,&bsize); + GenRtn (asize, bsize, demstate); + } +} + +static void CodeRedirection (NodeId node_id,int asp,int bsp,StateS demstate,NodeIdListElementS **free_node_ids_l) +{ + int asize,bsize; + int a_index,b_index; + StateS offstate; + + offstate = node_id->nid_state; + + DetermineSizeOfState (offstate,&asize,&bsize); + RedirectionComment (node_id); + + if (node_id->nid_refcount<0 && node_id->nid_state.state_type!=SimpleState && node_id->nid_node!=NULL){ + if (asize!=0) + a_index=get_a_index_of_unpacked_lhs_node (node_id->nid_node->node_arguments); + else + a_index=0; + + if (bsize!=0) + b_index=get_b_index_of_unpacked_lhs_node (node_id->nid_node->node_arguments); + else + b_index=0; + } else { + a_index=node_id->nid_a_index; + b_index=node_id->nid_b_index; + } + + RedirectResultAndReturn (asp,bsp,a_index,b_index,offstate,demstate,asize,bsize); + + decrement_reference_count_of_node_id (node_id,free_node_ids_l); +} + +static void FillRhsRoot (Label name,Node root,int asp,int bsp,CodeGenNodeIdsP code_gen_node_ids_p) +{ + BuildArgs (root->node_arguments,&asp,&bsp,code_gen_node_ids_p); + + GenFillh (name,root->node_arity,asp,ReleaseAndFill); + asp-=root->node_arity; + + GenPopA (asp); + GenPopB (bsp); + GenRtn (1,0,OnAState); +} + +static void CreateSemiStrictRootNode (Label name,Label code,Node root,NodeId rootid,int asp,int bsp,CodeGenNodeIdsP code_gen_node_ids_p,StateS demstate) +{ + BuildArgs (root->node_arguments,&asp,&bsp,code_gen_node_ids_p); + + GenFill (name,root->node_arity,code,asp-rootid->nid_a_index, NormalFill); + asp-=root->node_arity; + + RedirectResultAndReturn (asp,bsp,rootid->nid_a_index,rootid->nid_b_index,rootid->nid_state, demstate, 1, 0); +} + +#define IsSemiStrictState(state) ((state).state_type==SimpleState && (state).state_kind==SemiStrict) + +static Bool NoTupleStateAdjustment (StateS st1,StateS st2) +{ + if (IsSimpleState (st1) && IsSimpleState (st2)) + return st1.state_kind==st2.state_kind || (st1.state_kind==OnA && st2.state_kind==StrictOnA); + + switch (st1.state_type){ + case RecordState: + return st2.state_type==RecordState; + case TupleState: + if (st2.state_type==TupleState && st1.state_arity==st2.state_arity){ + int i; + + for (i=0; i<st1.state_arity; i++) + if (!NoTupleStateAdjustment (st1.state_tuple_arguments[i],st2.state_tuple_arguments[i])) + return False; + + return True; + } else + return False; + case ArrayState: + return st2.state_type==ArrayState; + default: + return False; + } +} + +static Coercions DetermineResultAdjustment (StateS demstate, StateS offstate) +{ + if (IsSimpleState (offstate)){ + if (IsSimpleState (demstate)) + return CoerceStateKind (demstate.state_kind,offstate.state_kind); + else + return AToB; + } else if (IsSimpleState (demstate) || ! NoTupleStateAdjustment (demstate, offstate)) + return BToA; + else + return BToB; +} + +static Bool ResultNodeNecessary (Coercions moveact, StateS offstate) +{ + return (moveact == AToB && ! (IsSimpleState (offstate) && + (offstate.state_kind == StrictRedirection || + offstate.state_kind == LazyRedirection))); +} + +static void CodeRootSymbolApplication (Node root,NodeId rootid,SymbDef def,int asp,int bsp,CodeGenNodeIdsP code_gen_node_ids_p,StateS resultstate) +{ + LabDef name; + int symbarity; + + symbarity = def->sdef_kind==RECORDTYPE ? def->sdef_cons_arity : def->sdef_arity; + + if (symbarity==root->node_arity){ + SDefKind symbkind; + + symbkind = (SDefKind)def->sdef_kind; + + switch (symbkind){ + case IMPRULE: + case DEFRULE: + case SYSRULE: + if (IsSemiStrictState (root->node_state)){ + LabDef codelab; + + ConvertSymbolToDandNLabel (&name,&codelab,def); + + CreateSemiStrictRootNode (&name,&codelab,root,rootid,asp,bsp,code_gen_node_ids_p,resultstate); + } else { + Coercions moveact; + + ConvertSymbolToLabel (&name,def); + + moveact = DetermineResultAdjustment (resultstate, root->node_state); + + /* + removal of tail recursion only makes sence when we are sure + that at run-time after calling the rhs root function + it is not necessary to return to the calling function + */ + + if (moveact==AToB || moveact==BToA || moveact==AToRoot){ + int result_a_size,result_b_size,new_node; + int a_size,b_size; + + /* In this case no removal takes place */ + + new_node=ResultNodeNecessary (moveact,root->node_state); + if (new_node) + NewEmptyNode (&asp,-1); + + BuildArgs (root->node_arguments,&asp,&bsp,code_gen_node_ids_p); + + DetermineSizeOfArguments (root->node_arguments,&a_size,&b_size); + if (new_node) + ++a_size; + UpdateAAndBStack (asp,bsp,a_size,b_size,&asp,&bsp); + CallFunction (&name,def,True,root); + + DetermineSizeOfState (root->node_state,&result_a_size,&result_b_size); + + asp+=result_a_size-a_size; + bsp+=result_b_size-b_size; + + RedirectResultAndReturn (asp,bsp,asp,bsp,root->node_state,resultstate,result_a_size,result_b_size); + } else { + int a_size,b_size; + + /* BuildNewStackFrame (root->node_arguments,asp,bsp,ResultNodeNecessary (moveact,root->node_state),code_gen_node_ids_p); */ + + BuildArgs (root->node_arguments,&asp,&bsp,code_gen_node_ids_p); + DetermineSizeOfArguments (root->node_arguments,&a_size,&b_size); + UpdateAAndBStack (asp,bsp,a_size,b_size,&asp,&bsp); + + CallFunction (&name, def, False, root); + } + } + break; + case RECORDTYPE: + if (IsSemiStrictState (root->node_state)){ + LabDef codelab; + + if (def->sdef_strict_constructor){ + ConvertSymbolToRecordDandNLabel (&name,&codelab,def); + CreateSemiStrictRootNode (&name,&codelab,root,rootid,asp,bsp,code_gen_node_ids_p,resultstate); + } else { + ConvertSymbolToRLabel (&codelab,def); + + BuildArgs (root->node_arguments,&asp,&bsp,code_gen_node_ids_p); + + GenFillR (&codelab,root->node_arity,0,asp-rootid->nid_a_index,0,0,NormalFill,True); + asp-=root->node_arity; + + rootid->nid_state__.state_kind=StrictOnA; + + RedirectResultAndReturn (asp,bsp,rootid->nid_a_index,rootid->nid_b_index,rootid->nid_state, resultstate, 1, 0); + } + } else { + int a_size,b_size; + + BuildArgs (root->node_arguments,&asp,&bsp,code_gen_node_ids_p); + + DetermineSizeOfArguments (root->node_arguments,&a_size,&b_size); + + if (IsSimpleState (root->node_state)){ + LabDef codelab; + + ConvertSymbolToRLabel (&codelab,def); + GenFillR (&codelab,a_size,b_size,asp,0,0,ReleaseAndFill,False); + + GenPopA (asp); + GenPopB (bsp); + GenRtn (1,0,OnAState); + } else { + /*BuildNewStackFrame (root->node_arguments,asp,bsp,ResultNodeNecessary (BToB,root->node_state),code_gen_node_ids_p); */ + + UpdateAAndBStack (asp,bsp,a_size,b_size,&asp,&bsp); + + if (!function_called_only_curried_or_lazy_with_one_return){ + int asize,bsize; + + DetermineSizeOfState (resultstate, &asize, &bsize); + GenRtn (asize, bsize, resultstate); + } + } + } + break; + default: /* a USER or a TYPE constructor */ + if (def->sdef_kind==CONSTRUCTOR && def->sdef_strict_constructor && def->sdef_arity==root->node_arity){ + if (IsSemiStrictState (root->node_state)){ + LabDef codelab; + + ConvertSymbolToConstructorDandNLabel (&name,&codelab,def); + CreateSemiStrictRootNode (&name,&codelab,root,rootid,asp,bsp,code_gen_node_ids_p,resultstate); + } else { + LabDef record_label; + int asize,bsize; + + DetermineSizeOfArguments (root->node_arguments,&asize,&bsize); + BuildArgs (root->node_arguments, &asp, &bsp,code_gen_node_ids_p); + + ConvertSymbolToKLabel (&record_label,def); + + GenFillR (&record_label,asize,bsize,asp,0,0,ReleaseAndFill,False); + + GenPopA (asp); + GenPopB (bsp); + GenRtn (1,0, OnAState); + } + } else { + if (def->sdef_kind==CONSTRUCTOR) + ConvertSymbolToConstructorDLabel (&name,def); + else + ConvertSymbolToDLabel (&name,def); + FillRhsRoot (&name, root, asp, bsp,code_gen_node_ids_p); + } + break; + } + } else { + /* Symbol has too few arguments */ + if (def->sdef_kind==CONSTRUCTOR) + ConvertSymbolToConstructorDLabel (&name,def); + else + ConvertSymbolToDLabel (&name,def); + FillRhsRoot (&name, root, asp, bsp,code_gen_node_ids_p); + } +} + +static void CodeRootSelection (Node root, NodeId rootid,int asp,int bsp,CodeGenNodeIdsP code_gen_node_ids_p,StateS demstate) +{ + Args args; + int argnr; + + args=root->node_arguments; + argnr=root->node_arity; + + if (IsSemiStrictState (root->node_state)){ + FillSelectSymbol (SemiStrict,root->node_symbol->symb_arity,argnr,args,&asp,&bsp,rootid,code_gen_node_ids_p); + + RedirectResultAndReturn (asp,bsp,rootid->nid_a_index,rootid->nid_b_index,rootid->nid_state,demstate,1,0); + return; + } else { + Node arg_node; + int tuparity; + + tuparity = args->arg_state.state_arity; + + Assume (tuparity > 1, "codegen","CodeRootSelection"); + + arg_node=args->arg_node; + if (arg_node->node_kind!=NodeIdNode){ + StateS offstate; + + offstate= arg_node->node_state; + + Build (arg_node,&asp,&bsp,code_gen_node_ids_p); + + if (IsSimpleState (offstate)){ + GenPushArg (0, tuparity, argnr); + asp += 1; + + RedirectResultAndReturn (asp,bsp,asp,0,OnAState,demstate,1,0); + return; + } else { + int i,a_offset,b_offset,asize,bsize; + + a_offset=0; + b_offset=0; + for (i=0; i<argnr-1; ++i) + AddSizeOfState (offstate.state_tuple_arguments[i],&a_offset,&b_offset); + + DetermineSizeOfState (offstate.state_tuple_arguments[argnr-1],&asize,&bsize); + + RedirectResultAndReturn (asp,bsp,asp-a_offset,bsp-b_offset,offstate.state_tuple_arguments[argnr-1],demstate,asize,bsize); + return; + } + } else { + StateS offstate; + NodeId arg_node_id; + + arg_node_id=arg_node->node_node_id; + offstate = arg_node_id->nid_state; + + if (IsSimpleState (offstate)){ + Bool ontop; + + CoerceSimpleStateArgument (demstate, offstate.state_kind, arg_node_id->nid_a_index, & asp, False, & ontop); + + GenPushArg (asp - arg_node_id->nid_a_index, tuparity, argnr); + asp += 1; + RedirectResultAndReturn (asp, bsp, asp, 0, OnAState, demstate, 1, 0); + return; + } else { + int i,asize,bsize,aindex,bindex,tuple_a_index,tuple_b_index; + + aindex=0; + bindex=0; + for (i=0; i<argnr-1; i++) + AddSizeOfState (offstate.state_tuple_arguments[i],&aindex, &bindex); + + if (arg_node_id->nid_refcount<0 && arg_node_id->nid_node!=NULL){ + tuple_a_index=get_a_index_of_unpacked_lhs_node (arg_node_id->nid_node->node_arguments); + tuple_b_index=get_b_index_of_unpacked_lhs_node (arg_node_id->nid_node->node_arguments); + } else { + tuple_a_index=arg_node_id->nid_a_index, + tuple_b_index=arg_node_id->nid_b_index; + } + + DetermineSizeOfState (offstate.state_tuple_arguments[argnr-1],&asize,&bsize); + + aindex=tuple_a_index-aindex; + bindex=tuple_b_index-bindex; + + RedirectResultAndReturn (asp,bsp,aindex,bindex,offstate.state_tuple_arguments[argnr-1],demstate,asize,bsize); + } + } + } +} + +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) +{ + 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; +} + +static void CodeNormalRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenNodeIdsP code_gen_node_ids_p,StateS resultstate) +{ + Symbol rootsymb; + + rootsymb = root->node_symbol; + + ContractumComment (asp, bsp); + + switch (rootsymb->symb_kind){ + case definition: + CodeRootSymbolApplication (root,rootid,rootsymb->symb_def,asp,bsp,code_gen_node_ids_p,resultstate); + return; + case tuple_symb: + if (IsSemiStrictState (root->node_state)) + CreateSemiStrictRootNode (&tuple_lab,&hnf_lab,root,rootid,asp,bsp,code_gen_node_ids_p,resultstate); + else { + if (IsSimpleState (root->node_state)) + FillRhsRoot (&tuple_lab, root, asp, bsp,code_gen_node_ids_p); + else { + int asize,bsize; + + /* BuildNewStackFrame (root->node_arguments,asp,bsp,ResultNodeNecessary (BToB,root->node_state),code_gen_node_ids_p); */ + + { + int a_size,b_size; + + BuildArgs (root->node_arguments,&asp,&bsp,code_gen_node_ids_p); + DetermineSizeOfArguments (root->node_arguments,&a_size,&b_size); + UpdateAAndBStack (asp,bsp,a_size,b_size,&asp,&bsp); + } + + if (!function_called_only_curried_or_lazy_with_one_return){ + DetermineSizeOfState (resultstate, &asize, &bsize); + GenRtn (asize, bsize, resultstate); + } + } + } + return; + case cons_symb: + FillRhsRoot (&cons_lab, root, asp, bsp,code_gen_node_ids_p); + return; + case nil_symb: + FillRhsRoot (&nil_lab, root, asp, bsp,code_gen_node_ids_p); + return; + case apply_symb: + CodeRootSymbolApplication (root, rootid, ApplyDef, asp, bsp,code_gen_node_ids_p,resultstate); + return; + case if_symb: +#ifdef FASTER_STRICT_IF + if (root->node_arity==3 && !IsLazyState (root->node_state) && rootid==NULL){ + LabDef elselab,thenlab; + Args cond_arg,then_arg; + + cond_arg = root->node_arguments; + + EvaluateCondition (cond_arg->arg_node,&asp,&bsp,code_gen_node_ids_p,cond_arg->arg_state); + + MakeLabel (&elselab,else_symb,NewLabelNr,no_pref); + MakeLabel (&thenlab,then_symb,NewLabelNr++,no_pref); + + thenlab.lab_mod=notused_string; + + BranchOnCondition (cond_arg->arg_node,asp,bsp,code_gen_node_ids_p,cond_arg->arg_state,&thenlab,&elselab,&thenlab,asp,bsp,asp,bsp); + + then_arg=cond_arg->arg_next; + + if (thenlab.lab_mod==NULL) + GenLabelDefinition (&thenlab); + + CodeRhsNodeDefsAndRestoreNodeIdStates (then_arg->arg_node,NULL,asp,bsp,resultstate,NULL, + code_gen_node_ids_p->a_node_ids,code_gen_node_ids_p->b_node_ids,NULL,True); + + GenLabelDefinition (&elselab); + + CodeRhsNodeDefsAndRestoreNodeIdStates (then_arg->arg_next->arg_node,NULL,asp,bsp,resultstate,NULL, + code_gen_node_ids_p->a_node_ids,code_gen_node_ids_p->b_node_ids,NULL,True); + return; + } else +#endif + CodeRootSymbolApplication (root,rootid,IfDef,asp,bsp,code_gen_node_ids_p,resultstate); + return; + case select_symb: + CodeRootSelection (root, rootid, asp, bsp,code_gen_node_ids_p,resultstate); + return; + case fail_symb: + error_in_function ("CodeNormalRootNode"); +/* JumpToNextAlternative (asp, bsp); */ + return; + case string_denot: + GenPopA (asp); + GenPopB (bsp); + + GenBuildString (rootsymb->symb_val); + GenRtn (1, 0, OnAState); + return; + default: + if (rootsymb->symb_kind < Nr_Of_Basic_Types) + FillRhsRoot (&BasicDescriptors[rootsymb->symb_kind], root, asp, bsp,code_gen_node_ids_p); + else { + /* in case of a denotation: */ + + ObjectKind denottype; + + denottype = (rootsymb->symb_kind < Nr_Of_Predef_Types) + ? BasicSymbolStates [rootsymb->symb_kind].state_object + : UnknownObj; + + GenPopA (asp); + GenPopB (bsp); + + if (root->node_state.state_object == denottype){ + if (root->node_state.state_kind == OnB){ + PushBasic (denottype, rootsymb->symb_val); + if (!function_called_only_curried_or_lazy_with_one_return) + GenRtn (0, ObjectSizes [denottype], root->node_state); + } else { + FillBasic (denottype, rootsymb->symb_val,0, ReleaseAndFill); + if (!function_called_only_curried_or_lazy_with_one_return) + GenRtn (1, 0, OnAState); + } + } else { + StaticMessage (False,CurrentAltLabel.lab_symbol->sdef_ident->ident_name,Co_Wtype); + GenTypeError(); + GenRtn (0, 0, OnAState); + } + } + } +} + +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; + SymbDef seldef; + ArgP arg; + + arg = root->node_arguments; + seldef = root->node_symbol->symb_def; + fieldnr = seldef->sdef_sel_field_number; + + if (IsSemiStrictState (root->node_state)){ + BuildArg (arg,&asp,&bsp,code_gen_node_ids_p); + + if (root->node_arity>=SELECTOR_U){ + SymbDef new_select_sdef; + LabDef name,codelab; + + new_select_sdef=create_select_function (root->node_symbol,root->node_arity); + + ConvertSymbolToDandNLabel (&name,&codelab,new_select_sdef); + GenFill (&name,1,&codelab,asp-rootid->nid_a_index,PartialFill); + --asp; + } else + BuildOrFillLazyFieldSelector (root->node_symbol->symb_def,root->node_state.state_kind,&asp,rootid); + + RedirectResultAndReturn (asp,bsp,rootid->nid_a_index,rootid->nid_b_index,rootid->nid_state,demstate,1,0); + return; + } else { + int recarity; + Node arg_node; + + recarity = arg->arg_state.state_arity; + arg_node=arg->arg_node; + + if (arg_node->node_kind!=NodeIdNode){ + StateS offstate; + + offstate = arg_node->node_state; + Build (arg_node,&asp,&bsp,code_gen_node_ids_p); + + 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); + + DetermineFieldSizeAndPositionAndRecordSize (fieldnr,&asize,&bsize,&aindex,&bindex,&record_a_size,&record_b_size,record_state_p); + + if (root->node_arity<SELECTOR_L){ + int n; + + for (n=0; n<asize; ++n) + GenPushA (aindex+asize-1); + asp+=asize; + + for (n=0; n<bsize; ++n) + GenPushB (bindex+bsize-1); + bsp+=bsize; + + RedirectResultAndReturn (asp,bsp,asp,bsp,root->node_state,demstate,record_a_size+asize,record_b_size+bsize); + } else { + ReplaceRecordOnTopOfStackByField (&asp,&bsp,aindex,bindex,asize,bsize,record_a_size,record_b_size); + 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); + } + + return; + } + + if (offstate.state_type==RecordState){ + int apos,bpos,asize,bsize,aindex,bindex; + + DetermineFieldSizeAndPosition (fieldnr,&asize,&bsize,&apos,&bpos,offstate.state_record_arguments); + + aindex = asp-apos; + bindex = bsp-bpos; + RedirectResultAndReturn (asp, bsp, aindex, bindex,offstate.state_record_arguments[fieldnr], demstate, asize, bsize); + return; + } else { + int a_size,b_size; + + 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); + return; + } + } else { + StateS offstate; + NodeId arg_node_id; + + arg_node_id=arg_node->node_node_id; + + offstate = arg_node_id->nid_state; + + if (offstate.state_type==RecordState){ + int asize,bsize,aindex,bindex,record_a_index,record_b_index; + + DetermineFieldSizeAndPosition (fieldnr, &asize, &bsize, &aindex, &bindex,offstate.state_record_arguments); + + if (arg_node_id->nid_refcount<0 && arg_node_id->nid_node!=NULL){ + record_a_index=get_a_index_of_unpacked_lhs_node (arg_node_id->nid_node->node_arguments); + record_b_index=get_b_index_of_unpacked_lhs_node (arg_node_id->nid_node->node_arguments); + } else { + record_a_index=arg_node_id->nid_a_index, + record_b_index=arg_node_id->nid_b_index; + } + + if (root->node_arity>=SELECTOR_U){ + int record_a_size,record_b_size,n; + + GenPopA (asp-record_a_index); + asp=record_a_index; + GenPopB (bsp-record_b_index); + bsp=record_b_index; + + for (n=0; n<asize; ++n) + GenPushA (aindex+asize-1); + asp+=asize; + + for (n=0; n<bsize; ++n) + GenPushB (bindex+bsize-1); + bsp+=bsize; + + DetermineSizeOfState (offstate,&record_a_size,&record_b_size); + + RedirectResultAndReturn (asp,bsp,asp,bsp,root->node_state,demstate,record_a_size+asize,record_b_size+bsize); + return; + } + + aindex=record_a_index-aindex, + bindex=record_b_index-bindex; + + RedirectResultAndReturn (asp, bsp, aindex, bindex,offstate.state_record_arguments[fieldnr], demstate, asize, bsize); + return; + } else { + Bool ontop; + int a_size,b_size; + + 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); + + DetermineFieldSizeAndPosition (fieldnr,&asize,&bsize,&aindex,&bindex,record_state_p->state_record_arguments); + + if (root->node_arity<SELECTOR_L){ + int n; + + for (n=0; n<asize; ++n) + GenPushA (aindex+asize-1); + asp+=asize; + + for (n=0; n<bsize; ++n) + GenPushB (bindex+bsize-1); + bsp+=bsize; + } else { + int record_a_size,record_b_size; + + DetermineSizeOfState (*record_state_p,&record_a_size,&record_b_size); + ReplaceRecordOnTopOfStackByField (&asp,&bsp,aindex,bindex,asize,bsize,record_a_size,record_b_size); + } + + 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); + + 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); + return; + } + } + } +} + +static void CodeRootMatchNode (Node root,NodeId rootid,int asp,int bsp,CodeGenNodeIdsP code_gen_node_ids_p,StateS demanded_state) +{ + if (IsSemiStrictState (root->node_state)){ + FillMatchNode (root,&asp,&bsp,rootid,code_gen_node_ids_p); + + RedirectResultAndReturn (asp,bsp,rootid->nid_a_index,rootid->nid_b_index,rootid->nid_state,demanded_state,1,0); + } else { + int a_size,b_size; + + FillMatchNode (root,&asp,&bsp,NULL,code_gen_node_ids_p); + + DetermineSizeOfState (root->node_state,&a_size,&b_size); + RedirectResultAndReturn (asp,bsp,asp,bsp,root->node_state,demanded_state,a_size,b_size); + } +} + +static void CodeRootUpdateNode (Node root,NodeId rootid,int asp,int bsp,CodeGenNodeIdsP code_gen_node_ids_p,StateS result_state) +{ + LabDef name; + SymbDef record_sdef; + + record_sdef=root->node_symbol->symb_def; + + ConvertSymbolToLabel (&name,record_sdef); + + if (IsSemiStrictState (root->node_state)){ + ArgS *record_arg,*first_field_arg; + int n_arguments; + LabDef name,codelab; + SymbDef new_update_sdef; + + record_arg=root->node_arguments; + first_field_arg=record_arg->arg_next; + + n_arguments=root->node_arity; + + RemoveSelectorsFromUpdateNode (record_arg,first_field_arg); + + BuildArgs (root->node_arguments,&asp,&bsp,code_gen_node_ids_p); + + new_update_sdef=CreateUpdateFunction (record_arg,first_field_arg,root); + + ConvertSymbolToDandNLabel (&name,&codelab,new_update_sdef); + + GenFill (&name,n_arguments,&codelab,asp-rootid->nid_a_index,NormalFill); + asp-=n_arguments; + + RedirectResultAndReturn (asp,bsp,rootid->nid_a_index,rootid->nid_b_index,rootid->nid_state,result_state,1,0); + } else { + ArgS *record_arg,*first_field_arg; + int record_a_size,record_b_size; + + record_arg=root->node_arguments; + first_field_arg=record_arg->arg_next; + + RemoveSelectorsFromUpdateNode (record_arg,first_field_arg); + + /* BuildNewStackFrame (record_arg,asp,bsp,False,code_gen_node_ids_p); */ + + { + int a_size,b_size; + + BuildArgs (record_arg,&asp,&bsp,code_gen_node_ids_p); + DetermineSizeOfArguments (record_arg,&a_size,&b_size); + UpdateAAndBStack (asp,bsp,a_size,b_size,&asp,&bsp); + } + + 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, + record_state_p->state_record_arguments,record_a_size,record_b_size,&asp,&bsp); + + ConvertSymbolToRLabel (&record_label,record_sdef); + + GenFillR (&record_label,record_a_size,record_b_size,asp,0,0,ReleaseAndFill,False); + + GenPopA (asp); + GenPopB (bsp); + GenRtn (1,0, OnAState); + } else { + DetermineSizeOfState (result_state,&record_a_size,&record_b_size); + + UpdateNodeAndAddSelectorsToUpdateNode (record_arg,first_field_arg, + result_state.state_record_arguments,record_a_size,record_b_size,&asp,&bsp); + + if (!function_called_only_curried_or_lazy_with_one_return) + GenRtn (record_a_size,record_b_size,result_state); + } + } +} + +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){ + case NormalNode: + CodeNormalRootNode (root, rootid, asp, bsp,code_gen_node_ids_p,resultstate); + return 0; + case SelectorNode: + CodeRootFieldSelector (root, rootid, asp, bsp,code_gen_node_ids_p,resultstate); + return 0; + case UpdateNode: + CodeRootUpdateNode (root, rootid, asp, bsp,code_gen_node_ids_p,resultstate); + return 0; + case MatchNode: + CodeRootMatchNode (root,rootid,asp,bsp,code_gen_node_ids_p,resultstate); + return 0; + case IfNode: + { + LabDef elselab,thenlab; + Args condpart,then_arg; + struct node *else_node; + + condpart = root->node_arguments; + + 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); + + thenlab.lab_mod=notused_string; + + BranchOnCondition (condpart->arg_node,asp,bsp,code_gen_node_ids_p,condpart->arg_state,&thenlab,&elselab,&thenlab,asp,bsp,asp,bsp); + + then_arg=condpart->arg_next; + + if (thenlab.lab_mod==NULL) + GenLabelDefinition (&thenlab); + + 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, + True +/* + code_gen_node_ids_p->doesnt_fail +*/ + ); + + GenLabelDefinition (&elselab); + + else_node=then_arg->arg_next->arg_node; + + 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); + + return 1; + } else + return 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); + } + case NodeIdNode: + if (rootid==NULL){ + CodeRedirection (root->node_node_id,asp,bsp,resultstate,&code_gen_node_ids_p->free_node_ids); + return 0; + } + default: + error_in_function ("CodeRootNode"); + return 0; + } +} + +static Bool ExamineRootNodeOnACycle (NodeId rhsid,Node rhsroot,int *asp_p,StateS resultstate) +{ + rhsid->nid_state_=OnAState; + + if (IsSimpleState (resultstate)){ + if (resultstate.state_kind==OnB || resultstate.state_kind==StrictRedirection){ + NewEmptyNode (asp_p,rhsroot->node_arity); + rhsid->nid_a_index_=*asp_p; + } else { + if (rhsroot->node_arity<=2 || NodeOnACycleIsInRootNormalForm (rhsroot)){ + rhsid->nid_a_index_=0; + } else { + NewEmptyNode (asp_p,rhsroot->node_arity); + rhsid->nid_a_index_=*asp_p; + return True; + } + } + } else { + if (NodeOnACycleIsInRootNormalForm (rhsroot)) + NewEmptyNode (asp_p,-1); + else + NewEmptyNode (asp_p,rhsroot->node_arity); + rhsid->nid_a_index_=*asp_p; + } + return False; +} + +#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) +{ + LabDef name; + int a_size,b_size; + + ConvertSymbolToLabel (&name,node_p->node_symbol->symb_def); + + DetermineSizeOfArguments (node_p->node_arguments,&a_size,&b_size); + + if (push_node==NULL) + BuildArgsWithNewResultNode (node_p->node_arguments,&asp,&bsp,code_gen_node_ids_p,&a_size,&b_size); + else + BuildArgsWithResultNodeOnStack (node_p->node_arguments,push_node->node_arguments->arg_node->node_node_id,&asp,&bsp,code_gen_node_ids_p,&a_size,&b_size); + + asp-=a_size; + bsp-=b_size; + + cleanup_stack (&asp,&bsp,a_size,b_size,&code_gen_node_ids_p->a_node_ids,&code_gen_node_ids_p->b_node_ids, + &code_gen_node_ids_p->free_node_ids,code_gen_node_ids_p->moved_node_ids_l,code_gen_node_ids_p->doesnt_fail); + + node_def_id->nid_a_index_=asp+1; + node_def_id->nid_b_index_=bsp; + node_def_id->nid_state_=node_p->node_state; + + asp+=a_size; + bsp+=b_size; + + BuildArgs (root_node->node_arguments,&asp,&bsp,code_gen_node_ids_p); + + if (root_node->node_symbol->symb_kind==cons_symb){ + GenFillh (&cons_lab,root_node->node_arity,asp,ReleaseAndFill); + asp-=root_node->node_arity; + } else { + LabDef constructor_name; + + if (!root_node->node_symbol->symb_def->sdef_strict_constructor){ + ConvertSymbolToConstructorDLabel (&constructor_name,root_node->node_symbol->symb_def); + GenFillh (&constructor_name,root_node->node_arity,asp,ReleaseAndFill); + asp-=root_node->node_arity; + } else { + int asize,bsize; + + ConvertSymbolToKLabel (&constructor_name,root_node->node_symbol->symb_def); + + DetermineSizeOfArguments (root_node->node_arguments,&asize,&bsize); + + if (asize+bsize>2 && push_node!=NULL && push_node->node_line>=asize+bsize){ + NodeIdListElementP node_id_list; + char bits[MaxNodeArity+2]; + unsigned int a_bits,b_bits,a_size,b_size,n,arg_n; + int n_a_fill_bits,n_b_fill_bits,node_arity; + ArgP arg_p; + + a_bits=0; + b_bits=0; + a_size=0; + b_size=0; + n_a_fill_bits=0; + n_b_fill_bits=0; + + arg_p=root_node->node_arguments; + node_arity=root_node->node_arity; + node_id_list=push_node->node_node_ids; + + for (arg_n=0; arg_n<node_arity; ++arg_n){ + int arg_a_size,arg_b_size; + + 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)){ + a_bits |= (~((~0)<<arg_a_size))<<a_size; + b_bits |= (~((~0)<<arg_b_size))<<b_size; + + n_a_fill_bits+=arg_a_size; + n_b_fill_bits+=arg_b_size; + } + + arg_p=arg_p->arg_next; + 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); + + 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,asize,bsize,asp+1,bits); + } else + GenFillR (&constructor_name,asize,bsize,asp,0,0,ReleaseAndFill,True); + asp-=asize; + bsp-=bsize; + } + } + + if (tail_call_modulo_cons) + name.lab_post=2; + + if (tail_call_modulo_cons==2){ + GenKeep (asp,a_size-1); + ++asp; + UpdateAAndBStack (asp,bsp,a_size,b_size,&asp,&bsp); + --asp; + CallFunction (&name,node_p->node_symbol->symb_def,False,node_p); + } else { + CallFunction (&name,node_p->node_symbol->symb_def,True,node_p); + } + + asp-=a_size; + bsp-=b_size; + + DetermineSizeOfState (node_p->node_state,&a_size,&b_size); + + asp+=a_size; + bsp+=b_size; + + if (a_size!=0) + add_node_id_to_list (node_def_id,&code_gen_node_ids_p->a_node_ids); + + if (b_size!=0) + add_node_id_to_list (node_def_id,&code_gen_node_ids_p->b_node_ids); + + if (tail_call_modulo_cons<2){ + node_def_id->nid_a_index_=asp; + node_def_id->nid_b_index_=bsp; + node_def_id->nid_state_=node_p->node_state; + + GenPopA (asp); + GenPopB (bsp); + GenRtn (1,0,OnAState); + } +} + +static int is_tail_call_module_cons_node (NodeP node_p) +{ + if (node_p->node_kind==NormalNode && node_p->node_symbol->symb_kind==definition){ + SymbDef sdef; + + sdef=node_p->node_symbol->symb_def; + + if (sdef->sdef_kind==IMPRULE && sdef->sdef_arity==node_p->node_arity && !IsLazyState (node_p->node_state) && + ExpectsResultNode (node_p->node_state) && node_p->node_state.state_kind!=Parallel) + { + return 1; + } + } + return 0; +} +#endif + +#if OPTIMIZE_LAZY_TUPLE_RECURSION +extern int lazy_tuple_recursion; +NodeP tuple_result_p; + +LabDef d_indirection_lab = {NULL, "", False, "d_indirection", 0}; +LabDef n_indirection_lab = {NULL, "", False, "n_indirection", 0}; + +void update_tuple_element_node (StateP state_p,int tuple_element_a_index,int *asp_p,int *bsp_p) +{ + if (state_p->state_type==SimpleState){ + if (state_p->state_kind==StrictOnA){ + GenFillFromA (0,*asp_p-tuple_element_a_index,ReleaseAndFill); + GenPopA (1); + --*asp_p; + } else if (state_p->state_kind==OnB){ + int b_size; + + FillBasicFromB (state_p->state_object,0,*asp_p-tuple_element_a_index,NormalFill); + b_size=ObjectSizes [state_p->state_object]; + GenPopB (b_size); + *bsp_p-=b_size; + } else { + GenFill (&d_indirection_lab,-2,&n_indirection_lab,*asp_p-tuple_element_a_index,PartialFill); + --*asp_p; + } + } else + error_in_function ("update_tuple_element_node"); +} + +#if TAIL_CALL_MODULO_TUPLE_CONS_OPTIMIZATION +extern int tail_call_modulo_tuple_cons; +extern unsigned long global_same_select_vector; +#endif + +static void fill_lazy_tuple_result_arguments (Args arg,int *asp_p,int *bsp_p,int tuple_element_n,int tuple_element_a_index,CodeGenNodeIdsP code_gen_node_ids_p) +{ + if (arg==NULL) + return; + else { + NodeP node; + int asize,bsize; + + fill_lazy_tuple_result_arguments (arg->arg_next,asp_p,bsp_p,tuple_element_n+1,tuple_element_a_index-1,code_gen_node_ids_p); + + ArgComment (arg); + + node=arg->arg_node; + +#if TAIL_CALL_MODULO_TUPLE_CONS_OPTIMIZATION + if (node->node_kind==FillUniqueNode) + node=node->node_arguments->arg_node; + + if (tail_call_modulo_tuple_cons==2 && global_same_select_vector & (1<<tuple_element_n)){ + if (node->node_kind!=NodeIdNode){ + Build (node,asp_p,bsp_p,code_gen_node_ids_p); + DetermineSizeOfState (node->node_state, &asize, &bsize); + CoerceArgumentOnTopOfStack (asp_p,bsp_p,arg->arg_state,node->node_state,asize,bsize); + } else { + NodeId arg_node_id; + + arg_node_id=node->node_node_id; + + 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); + + decrement_reference_count_of_node_id (arg_node_id,&code_gen_node_ids_p->free_node_ids); + } + } else +#endif + if (node->node_kind!=NodeIdNode){ + NodeIdS update_node_id_struct; + + update_node_id_struct.nid_a_index=tuple_element_a_index; + + if (node->node_kind==NormalNode && node->node_symbol->symb_kind==select_symb && + node->node_arguments->arg_node->node_kind==NodeIdNode && + tuple_element_n+1==node->node_arity && + (node->node_arguments->arg_node->node_node_id->nid_mark2 & NID_CALL_VIA_LAZY_SELECTIONS_ONLY)) + { + ; + } else + FillNodeOnACycle (node,asp_p,bsp_p,&update_node_id_struct,code_gen_node_ids_p); + + GenPushA (*asp_p-tuple_element_a_index); + ++*asp_p; + + DetermineSizeOfState (node->node_state, &asize, &bsize); + CoerceArgumentOnTopOfStack (asp_p,bsp_p,arg->arg_state,node->node_state,asize,bsize); + } else { + NodeId arg_node_id; + + arg_node_id=node->node_node_id; + + 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); + } else + CopyNodeIdArgument (arg_node_id->nid_state,arg_node_id,asp_p,bsp_p); + + update_tuple_element_node (&arg_node_id->nid_state,tuple_element_a_index,asp_p,bsp_p); + + GenPushA (*asp_p-tuple_element_a_index); + ++*asp_p; + + decrement_reference_count_of_node_id (arg_node_id,&code_gen_node_ids_p->free_node_ids); + } + } +} +#endif + +#if TAIL_CALL_MODULO_TUPLE_CONS_OPTIMIZATION +static void fill_strict_tuple_result_arguments (Args arg,ArgP *function_result_tuple_elements_p,int *asp_p,int *bsp_p,int tuple_element_n,int tuple_element_a_index,unsigned long result_and_call_same_select_vector,CodeGenNodeIdsP code_gen_node_ids_p) +{ + if (arg==NULL) + return; + else { + NodeP node; + int asize,bsize; + + --function_result_tuple_elements_p; + + fill_strict_tuple_result_arguments (arg->arg_next,function_result_tuple_elements_p,asp_p,bsp_p,tuple_element_n+1,tuple_element_a_index-1,result_and_call_same_select_vector,code_gen_node_ids_p); + + if (!(global_same_select_vector & (1<<tuple_element_n))){ + node=arg->arg_node; + + if (!(result_and_call_same_select_vector & (1<<tuple_element_n))){ + ArgComment (arg); + + if (node->node_kind==FillUniqueNode) + node=node->node_arguments->arg_node; + + if (node->node_kind!=NodeIdNode){ + NodeIdS update_node_id_struct; + + update_node_id_struct.nid_a_index=tuple_element_a_index; + + if (node->node_kind==NormalNode && node->node_symbol->symb_kind==select_symb && + node->node_arguments->arg_node->node_kind==NodeIdNode && + tuple_element_n+1==node->node_arity && + (node->node_arguments->arg_node->node_node_id->nid_mark2 & NID_CALL_VIA_LAZY_SELECTIONS_ONLY)) + { + ; + } else + FillNodeOnACycle (node,asp_p,bsp_p,&update_node_id_struct,code_gen_node_ids_p); + + GenKeep (*asp_p-tuple_element_a_index,*asp_p-(*function_result_tuple_elements_p)->arg_node->node_node_id->nid_a_index); + /* + GenPushA (*asp_p-tuple_element_a_index); + ++*asp_p; + + DetermineSizeOfState (node->node_state, &asize, &bsize); + CoerceArgumentOnTopOfStack (asp_p,bsp_p,arg->arg_state,node->node_state,asize,bsize); + */ + } else { + NodeId arg_node_id; + + arg_node_id=node->node_node_id; + + 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); + } else + CopyNodeIdArgument (arg_node_id->nid_state,arg_node_id,asp_p,bsp_p); + + update_tuple_element_node (&arg_node_id->nid_state,tuple_element_a_index,asp_p,bsp_p); + + GenKeep (*asp_p-tuple_element_a_index,*asp_p-(*function_result_tuple_elements_p)->arg_node->node_node_id->nid_a_index); + /* + GenPushA (*asp_p-tuple_element_a_index); + ++*asp_p; + */ + decrement_reference_count_of_node_id (arg_node_id,&code_gen_node_ids_p->free_node_ids); + } + } + } + } +} +#endif + +#if TAIL_CALL_MODULO_CONS_OPTIMIZATION || TAIL_CALL_MODULO_TUPLE_CONS_OPTIMIZATION +static void CallFunctionWithStackSizes (LabDef name,NodeP node_p,int a_size,int b_size,int no_tail_call) +{ + name.lab_post=2; + + if (name.lab_mod && name.lab_mod==CurrentModule) + name.lab_mod = NULL; + + name.lab_pref = s_pref; + + GenDStackLayout (a_size,b_size,node_p->node_arguments); + if (no_tail_call){ + GenJsr (&name); + } else + GenJmp (&name); +} +#endif + +int CodeRhsNodeDefs + (Node root_node,NodeDefs defs,int asp,int bsp,SavedNidStateS **saved_nid_state_l,StateS result_state, + struct esc *esc_p,NodeIdListElementP a_node_ids,NodeIdListElementP b_node_ids, + NodeIdListElementP free_node_ids,int doesnt_fail) +{ + int r; + MovedNodeIdP moved_node_ids; + struct code_gen_node_ids code_gen_node_ids; + + moved_node_ids=NULL; + + code_gen_node_ids.free_node_ids=free_node_ids; + code_gen_node_ids.saved_nid_state_l=saved_nid_state_l; + code_gen_node_ids.doesnt_fail=doesnt_fail; + code_gen_node_ids.moved_node_ids_l=&moved_node_ids; + code_gen_node_ids.a_node_ids=a_node_ids; + code_gen_node_ids.b_node_ids=b_node_ids; + + if (root_node->node_kind==NodeIdNode && defs==NULL){ + CodeRedirection (root_node->node_node_id, asp, bsp, result_state ,&free_node_ids); + return 0; + } + + if (root_node->node_kind==NodeIdNode && (root_node->node_node_id->nid_mark & ON_A_CYCLE_MASK)){ + NodeId root_node_id; + NodeDefs rootdef; + Bool large_lazy_root; + + root_node_id=root_node->node_node_id; + rootdef=root_node_id->nid_node_def; + + large_lazy_root=ExamineRootNodeOnACycle (root_node_id, rootdef->def_node, &asp, result_state); + + if (defs!=rootdef || defs->def_next || large_lazy_root){ + CodeSharedNodeDefs (defs,rootdef,&asp,&bsp,&code_gen_node_ids); + + RedirectResultAndReturn (asp,bsp,root_node_id->nid_a_index,0,StrictOnAState,result_state,0,0); + r=0; + } else { + r=CodeRootNode (rootdef->def_node,root_node_id,asp,bsp,&code_gen_node_ids,result_state,esc_p); + } + } else { +#if TAIL_CALL_MODULO_TUPLE_CONS_OPTIMIZATION + if (root_node->node_kind==NormalNode && root_node->node_symbol->symb_kind==tuple_symb && defs!=NULL){ + NodeIdP tuple_call_node_id_p; + + if (is_tuple_tail_call_modulo_cons_root (root_node,&tuple_call_node_id_p) && + (tuple_call_node_id_p->nid_node->node_symbol->symb_def->sdef_rule->rule_mark & RULE_CALL_VIA_LAZY_SELECTIONS_ONLY)) + { + NodeDefP *last_node_def_h,last_node_def_p; + + last_node_def_h=&defs; + while ((last_node_def_p=*last_node_def_h)->def_next!=NULL && last_node_def_p->def_id!=tuple_call_node_id_p) + last_node_def_h=&last_node_def_p->def_next; + + if (last_node_def_p->def_next==NULL && last_node_def_p->def_id==tuple_call_node_id_p && + last_node_def_p->def_node->node_kind==TupleSelectorsNode && + last_node_def_p->def_node->node_arguments->arg_node->node_kind==NodeIdNode) + { + unsigned long result_and_call_same_select_vector; + int n,tuple_arity,result_tuple_arity; + int args_a_size,args_b_size; + ArgP tuple_element_p,function_result_tuple_element_p; + LabDef name; + SymbDef sdef; + NodeP node,tuple_node; + ArgP function_result_tuple_elements_a[MaxNodeArity],*function_result_tuple_elements,*function_result_tuple_elements_p; + + printf ("Tuple tail call modulo cons %s\n",tuple_call_node_id_p->nid_node->node_symbol->symb_def->sdef_ident->ident_name); + + function_result_tuple_elements_p=&function_result_tuple_elements_a[0]; + for_l (function_result_tuple_element_p,last_node_def_p->def_node->node_arguments,arg_next) + *function_result_tuple_elements_p++ = function_result_tuple_element_p; + function_result_tuple_elements=function_result_tuple_elements_p; + + result_and_call_same_select_vector=0; + + if (tail_call_modulo_tuple_cons==2) + for_li (tuple_element_p,n,root_node->node_arguments,arg_next){ + NodeP node_p; + + node_p=tuple_element_p->arg_node; + --function_result_tuple_elements_p; + + if (node_p->node_kind==NodeIdNode && node_p->node_node_id->nid_refcount>0 + && node_p->node_node_id==(*function_result_tuple_elements_p)->arg_node->node_node_id) + { + result_and_call_same_select_vector |= (1<<n); + } + } + + tuple_arity=root_node->node_arity; + result_tuple_arity=tuple_arity; + + for_li (function_result_tuple_element_p,n,last_node_def_p->def_node->node_arguments,arg_next){ + NodeIdP function_result_tuple_element_node_id_p; + + if (!(global_same_select_vector & (1<<(tuple_arity-1-n)))){ + if (result_and_call_same_select_vector & (1<<(tuple_arity-1-n))) + GenPushA (asp-1-n); + else + GenCreate (-1); + ++asp; + } else + --result_tuple_arity; + + function_result_tuple_element_node_id_p=function_result_tuple_element_p->arg_node->node_node_id; + + function_result_tuple_element_node_id_p->nid_a_index = asp; + function_result_tuple_element_node_id_p->nid_state = StrictOnAState; + } + + tuple_result_p=last_node_def_p->def_node; + + *last_node_def_h=NULL; + CodeSharedNodeDefs (defs,NULL,&asp,&bsp,&code_gen_node_ids); + *last_node_def_h=last_node_def_p; + + if (tail_call_modulo_tuple_cons==1) + for_li (function_result_tuple_element_p,n,last_node_def_p->def_node->node_arguments,arg_next){ + if (!(global_same_select_vector & (1<<(tuple_arity-1-n)))){ + GenPushA (asp-function_result_tuple_element_p->arg_node->node_node_id->nid_a_index); + ++asp; + } + } + + { + struct arg *arg; + struct state *tuple_state_p; + int a_offset,b_offset,i; + ArgP node_args; + + node=last_node_def_p->def_node; + + tuple_node=node->node_node; + + sdef=tuple_node->node_symbol->symb_def; + ConvertSymbolToLabel (&name,sdef); + + node_args=tuple_node->node_arguments; + DetermineSizeOfArguments (node_args,&args_a_size,&args_b_size); + + BuildArgs (node_args,&asp,&bsp,&code_gen_node_ids); + + + asp-=args_a_size; + bsp-=args_b_size; + if (tail_call_modulo_tuple_cons==1) + asp-=result_tuple_arity; + + cleanup_stack (&asp,&bsp,tail_call_modulo_tuple_cons==1 ? args_a_size+result_tuple_arity : args_a_size,args_b_size, + &code_gen_node_ids.a_node_ids,&code_gen_node_ids.b_node_ids,&code_gen_node_ids.free_node_ids, + code_gen_node_ids.moved_node_ids_l,code_gen_node_ids.doesnt_fail); + + + if (tail_call_modulo_tuple_cons==1){ + int n; + int result_tuple_a_size,result_tuple_b_size; + StateS new_result_state,element_states[MaxNodeArity]; + + tuple_state_p=&tuple_node->node_state; + new_result_state=*tuple_state_p; + + result_tuple_a_size=0; + result_tuple_b_size=0; + + for (n=0; n<root_node->node_arity; ++n) + if (global_same_select_vector & (1<<n)){ + element_states[n]=tuple_state_p->state_tuple_arguments[n]; + AddSizeOfState (element_states[n],&result_tuple_a_size,&result_tuple_b_size); + } else { + element_states[n]=OnAState; + ++result_tuple_a_size; + } + + + new_result_state.state_tuple_arguments=element_states; + + CallFunctionWithStackSizes (name,tuple_node,args_a_size+result_tuple_arity,args_b_size,True); + + GenOStackLayoutOfState (result_tuple_a_size,result_tuple_b_size,new_result_state); + +/* + AddSizeOfState (tuple_node->node_state,&asp,&bsp); +*/ + asp+=result_tuple_a_size; + bsp+=result_tuple_b_size; + + + arg=node->node_arguments; + + a_offset=result_tuple_a_size; + b_offset=result_tuple_b_size; + + if (new_result_state.state_type!=TupleState) + error_in_function ("CodeRhsNodeDefs"); + + for (i=new_result_state.state_arity-1; i>=0; --i){ + int a_size,b_size; + NodeId node_id; + + DetermineSizeOfState (new_result_state.state_tuple_arguments[i],&a_size,&b_size); + + a_offset-=a_size; + b_offset-=b_size; + + if (global_same_select_vector & (1<<i)){ + if (arg!=NULL && arg->arg_node->node_node_id->nid_number==i){ + node_id=arg->arg_node->node_node_id; + arg=arg->arg_next; + } else { + if (a_size==0 && b_size==0) + continue; + + node_id=NewNodeId (NULL); + add_node_id_to_list (node_id,&code_gen_node_ids.free_node_ids); + } + + node_id->nid_a_index_ = asp - a_offset; + node_id->nid_b_index_ = bsp - b_offset; + node_id->nid_state_ = new_result_state.state_tuple_arguments[i]; + + if (a_size!=0) + add_node_id_to_list (node_id,&code_gen_node_ids.a_node_ids); + if (b_size!=0) + add_node_id_to_list (node_id,&code_gen_node_ids.b_node_ids); + } else + if (arg!=NULL && arg->arg_node->node_node_id->nid_number==i) + arg=arg->arg_next; + } + + if (arg!=NULL) + error_in_function ("CodeRhsNodeDefs"); + } else { + asp+=args_a_size; + bsp+=args_b_size; + } + + } + + if (tail_call_modulo_tuple_cons==1){ + r=CodeRootNode (root_node,NULL,asp,bsp,&code_gen_node_ids,result_state,esc_p); +/* + fill_lazy_tuple_result_arguments (root_node->node_arguments,&asp,&bsp,0,tuple_arity,&code_gen_node_ids); + + UpdateAAndBStack (asp,bsp,args_a_size,args_b_size,&asp,&bsp); + + for (n=0; n<tuple_arity-1; ++n) + GenKeep (tuple_arity-2-n,tuple_arity-1); + + GenPopA (tuple_arity-1); + GenRtn (1,0,OnAState); + + r=0; +*/ + } else { + fill_strict_tuple_result_arguments (root_node->node_arguments,function_result_tuple_elements,&asp,&bsp,0,tuple_arity,result_and_call_same_select_vector,&code_gen_node_ids); + + args_a_size+=result_tuple_arity; + +/* ++asp; +*/ + UpdateAAndBStack (asp,bsp,args_a_size,args_b_size,&asp,&bsp); + + CallFunctionWithStackSizes (name,tuple_node,args_a_size,args_b_size,False); + + r=0; + } + + 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; + } + + return r; + } + } + } +#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) || + (root_node->node_symbol->symb_kind==definition && root_node->node_symbol->symb_def->sdef_kind==CONSTRUCTOR && + root_node->node_arity==root_node->node_symbol->symb_def->sdef_arity)) + { + ArgP arg_p,arg_p2; + + arg_p2=NULL; + + for_l (arg_p,root_node->node_arguments,arg_next) + if (arg_p->arg_node->node_kind!=NodeIdNode) + if (arg_p2==NULL) + arg_p2=arg_p; + else + break; + + if (arg_p==NULL){ + if (arg_p2==NULL){ + if (defs!=NULL){ + NodeDefP *last_node_def_h,last_node_def_p; + NodeP node_p; + + last_node_def_h=&defs; + while ((last_node_def_p=*last_node_def_h)->def_next!=NULL) + last_node_def_h=&last_node_def_p->def_next; + + node_p=last_node_def_p->def_node; + + if (node_p!=NULL){ + NodeIdP node_def_id; + NodeP push_node; + + node_def_id=last_node_def_p->def_id; + + push_node=NULL; + + if (node_p->node_kind==FillUniqueNode){ + push_node=node_p->node_node; + 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)){ + *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; + } + + return 0; + } + } + } + } else { + NodeP node_p,push_node_p; + NodeIdP node_id_p; + + node_p=arg_p2->arg_node; + push_node_p=NULL; + + if (node_p->node_kind==FillUniqueNode){ + push_node_p=node_p->node_node; + node_p=node_p->node_arguments->arg_node; + } + + if (is_tail_call_module_cons_node (node_p)){ + NodeP old_arg_node_p; + + node_id_p=NewNodeId (NULL); + + node_id_p->nid_refcount=1; + + old_arg_node_p=arg_p2->arg_node; + 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; + } + + arg_p2->arg_node=old_arg_node_p; + + return 0; + } + } + } + } + } +#endif + +#if OPTIMIZE_LAZY_TUPLE_RECURSION + if (lazy_tuple_recursion && root_node->node_kind!=IfNode){ + if (root_node->node_kind==NormalNode && root_node->node_symbol->symb_kind==tuple_symb && + !(IsSemiStrictState (root_node->node_state) || IsSimpleState (root_node->node_state)) + ){ + int a_size,b_size,n,tuple_arity; + ArgP tuple_element_p; + /* + unsigned long result_and_call_same_select_vector; + + result_and_call_same_select_vector=0; + + for_li (tuple_element_p,n,root_node->node_arguments,arg_next){ + NodeP node_p; + + node_p=tuple_element_p->arg_node; + + if (node_p->node_symbol->symb_kind==select_symb + && node_p->node_arguments->arg_node->node_kind==NodeIdNode + && n+1==node_p->node_arity + && (node_p->node_arguments->arg_node->node_node_id->nid_mark2 & NID_CALL_VIA_LAZY_SELECTIONS_ONLY) + ) + result_and_call_same_select_vector |= (1<<n); + } + */ + tuple_result_p=root_node; + + CodeSharedNodeDefs (defs,NULL,&asp,&bsp,&code_gen_node_ids); + + fill_lazy_tuple_result_arguments (root_node->node_arguments,&asp,&bsp,0,root_node->node_arity,&code_gen_node_ids); + + tuple_arity=root_node->node_arity; + + a_size=tuple_arity; + b_size=0; + /* + DetermineSizeOfArguments (root_node->node_arguments,&a_size,&b_size); + */ +#if TAIL_CALL_MODULO_TUPLE_CONS_OPTIMIZATION + if (tail_call_modulo_tuple_cons==0) + ++asp; + else if (tail_call_modulo_tuple_cons==2){ + ArgP arg_p; + int n; + + for_li (arg_p,n,root_node->node_arguments,arg_next){ + if (global_same_select_vector & (1<<n)){ + --tuple_arity; + --a_size; + AddSizeOfState (arg_p->arg_state,&a_size,&b_size); + } + } + } +#else + ++asp; +#endif + UpdateAAndBStack (asp,bsp,a_size,b_size,&asp,&bsp); + + for (n=0; n<tuple_arity-1; ++n) + GenKeep (tuple_arity-2-n,tuple_arity-1); + + GenPopA (tuple_arity-1); + +#if TAIL_CALL_MODULO_TUPLE_CONS_OPTIMIZATION + if (tail_call_modulo_tuple_cons==2){ + int n; + StateS new_result_state,element_states[MaxNodeArity]; + + new_result_state=result_state; + + for (n=0; n<root_node->node_arity; ++n) + if (global_same_select_vector & (1<<n)) + element_states[n]=result_state.state_tuple_arguments[n]; + else + element_states[n]=OnAState; + + new_result_state.state_tuple_arguments=element_states; + + GenRtn (a_size-(tuple_arity-1),b_size,new_result_state); + } else +#endif + GenRtn (1,0,OnAState); + + r=0; + } else if (root_node->node_kind==NormalNode && root_node->node_symbol->symb_kind==definition + && root_node->node_symbol->symb_def->sdef_kind==IMPRULE + && (root_node->node_symbol->symb_def->sdef_rule->rule_mark & RULE_CALL_VIA_LAZY_SELECTIONS_ONLY) + && root_node->node_symbol->symb_def->sdef_arity==root_node->node_arity + && !IsSemiStrictState (root_node->node_state)) + { + int a_size,b_size,tuple_arity,n; + SymbDef sdef; + LabDef name; + + CodeSharedNodeDefs (defs,NULL,&asp,&bsp,&code_gen_node_ids); + + sdef=root_node->node_symbol->symb_def; + tuple_arity=sdef->sdef_rule->rule_type->type_alt_rhs->type_node_arity; + + for (n=0; n<tuple_arity; ++n){ + GenPushA (asp-(n+1)); + ++asp; + } + + BuildArgs (root_node->node_arguments,&asp,&bsp,&code_gen_node_ids); + DetermineSizeOfArguments (root_node->node_arguments,&a_size,&b_size); + + UpdateAAndBStack (asp,bsp,a_size+tuple_arity,b_size,&asp,&bsp); + + ConvertSymbolToLabel (&name,sdef); + name.lab_post=2; + + if (name.lab_mod && name.lab_mod==CurrentModule) + name.lab_mod = NULL; + + name.lab_pref = s_pref; + + GenDStackLayout (a_size+tuple_arity,b_size,root_node->node_arguments); + GenJmp (&name); + + r=0; + } else { + error_in_function ("CodeRhsNodeDefs"); + r=0; + } + } else +#endif + { + CodeSharedNodeDefs (defs,NULL,&asp,&bsp,&code_gen_node_ids); + + r=CodeRootNode (root_node,NULL,asp,bsp,&code_gen_node_ids,result_state,esc_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; + } + + return r; +} + +#if GENERATE_CODE_AGAIN +struct saved_node_id_ref_counts* save_lhs_node_id_ref_counts (NodeP node_p,struct saved_node_id_ref_counts *snir_p) +{ + if (node_p->node_kind==NodeIdNode){ + struct saved_node_id_ref_counts *new_snir_p; + + new_snir_p=CompAllocType (struct saved_node_id_ref_counts); + new_snir_p->snir_node_id=node_p->node_node_id; + new_snir_p->snir_ref_count=node_p->node_node_id->nid_refcount; + + new_snir_p->snir_next=snir_p; + snir_p=new_snir_p; + } else { + ArgP arg_p; + + for_l (arg_p,node_p->node_arguments,arg_next) + snir_p=save_lhs_node_id_ref_counts (arg_p->arg_node,snir_p); + } + + return snir_p; +} + +struct saved_node_id_ref_counts* save_rhs_node_id_ref_counts + (NodeP node_p,NodeDefP node_defs,struct saved_node_id_ref_counts *snir_p,struct saved_case_node_id_ref_counts ***scnirc_hl) +{ + NodeDefP node_def_p; + + switch (node_p->node_kind){ + case PushNode: + { + struct node_id_list_element *arg_node_id_list; + + for_l (arg_node_id_list,node_p->node_node_ids,nidl_next){ + struct saved_node_id_ref_counts *new_snir_p; + NodeIdP arg_node_id_p; + + arg_node_id_p=arg_node_id_list->nidl_node_id; + + new_snir_p=CompAllocType (struct saved_node_id_ref_counts); + new_snir_p->snir_node_id=arg_node_id_p; + new_snir_p->snir_ref_count=arg_node_id_p->nid_refcount; + + new_snir_p->snir_next=snir_p; + snir_p=new_snir_p; + } + + return save_rhs_node_id_ref_counts (node_p->node_arguments->arg_next->arg_node,node_defs,snir_p,scnirc_hl); + } + case SwitchNode: + { + ArgP arg_p; + + for_l (arg_p,node_p->node_arguments,arg_next){ + NodeP case_node_p; + NodeIdRefCountListP node_id_ref_count_elem_p; + + case_node_p=arg_p->arg_node; + + for_l (node_id_ref_count_elem_p,case_node_p->node_node_id_ref_counts,nrcl_next){ + struct saved_case_node_id_ref_counts *new_scnirc_p; + + new_scnirc_p=CompAllocType (struct saved_case_node_id_ref_counts); + new_scnirc_p->scnir_nrcl=node_id_ref_count_elem_p; + new_scnirc_p->scnir_ref_count=node_id_ref_count_elem_p->nrcl_ref_count; + + new_scnirc_p->scnir_next=NULL; + **scnirc_hl=new_scnirc_p; + *scnirc_hl=&new_scnirc_p->scnir_next; + } + + snir_p=save_rhs_node_id_ref_counts (case_node_p->node_arguments->arg_node,case_node_p->node_node_defs,snir_p,scnirc_hl); + } + break; + } + case GuardNode: + { + while (node_p->node_kind==GuardNode){ + snir_p=save_rhs_node_id_ref_counts (node_p->node_arguments->arg_node,node_defs,snir_p,scnirc_hl); + + node_defs=node_p->node_node_defs; + node_p=node_p->node_arguments->arg_next->arg_node; + } + + return save_rhs_node_id_ref_counts (node_p,node_defs,snir_p,scnirc_hl); + } + case IfNode: + snir_p=save_rhs_node_id_ref_counts (node_p->node_arguments->arg_next->arg_node,node_p->node_then_node_defs,snir_p,scnirc_hl); + snir_p=save_rhs_node_id_ref_counts (node_p->node_arguments->arg_next->arg_next->arg_node,node_p->node_else_node_defs,snir_p,scnirc_hl); + node_p=node_p->node_arguments->arg_node; + break; + } + + for_l (node_def_p,node_defs,def_next) + if (node_def_p->def_id!=NULL){ + struct saved_node_id_ref_counts *new_snir_p; + + new_snir_p=CompAllocType (struct saved_node_id_ref_counts); + new_snir_p->snir_node_id=node_def_p->def_id; + new_snir_p->snir_ref_count=node_def_p->def_id->nid_refcount; + + new_snir_p->snir_next=snir_p; + snir_p=new_snir_p; + + if (node_def_p->def_node->node_kind==TupleSelectorsNode){ + ArgP arg_p; + + for_l (arg_p,node_def_p->def_node->node_arguments,arg_next) + if (arg_p->arg_node->node_kind==NodeIdNode){ + NodeIdP tuple_element_node_id_p; + + tuple_element_node_id_p=arg_p->arg_node->node_node_id; + + new_snir_p=CompAllocType (struct saved_node_id_ref_counts); + new_snir_p->snir_node_id=tuple_element_node_id_p; + new_snir_p->snir_ref_count=tuple_element_node_id_p->nid_refcount; + + new_snir_p->snir_next=snir_p; + snir_p=new_snir_p; + } + } + } + + return snir_p; +} + +void restore_node_id_ref_counts (struct saved_node_id_ref_counts *snir_p,struct saved_case_node_id_ref_counts *scnir_p) +{ + while (snir_p!=NULL){ + snir_p->snir_node_id->nid_refcount=snir_p->snir_ref_count; + snir_p=snir_p->snir_next; + } + + while (scnir_p!=NULL){ + scnir_p->scnir_nrcl->nrcl_ref_count=scnir_p->scnir_ref_count; + scnir_p=scnir_p->scnir_next; + } +} +#endif + +#if TAIL_CALL_MODULO_CONS_OPTIMIZATION +static int tail_call_modulo_cons_call (NodeP node_p,NodeDefP node_defs) +{ + if (node_p->node_kind==NormalNode){ + SymbolP node_symbol_p; + + node_symbol_p=node_p->node_symbol; + if ((node_symbol_p->symb_kind==cons_symb && node_p->node_arity==2) || + (node_symbol_p->symb_kind==definition && node_symbol_p->symb_def->sdef_kind==CONSTRUCTOR && + node_p->node_arity==node_symbol_p->symb_def->sdef_arity)) + { + ArgP arg_p,arg_p2; + + arg_p2=NULL; + for_l (arg_p,node_p->node_arguments,arg_next) + if (arg_p->arg_node->node_kind!=NodeIdNode) + if (arg_p2==NULL) + arg_p2=arg_p; + else + break; + + if (arg_p==NULL){ + if (arg_p2==NULL){ + if (node_defs!=NULL){ + NodeDefP last_node_def_p; + NodeP node_def_node_p; + + last_node_def_p=node_defs; + while (last_node_def_p->def_next!=NULL) + last_node_def_p=last_node_def_p->def_next; + + node_def_node_p=last_node_def_p->def_node; + + if (node_def_node_p!=NULL){ + NodeIdP node_def_id; + + node_def_id=last_node_def_p->def_id; + + if (node_def_node_p->node_kind==FillUniqueNode) + node_def_node_p=node_def_node_p->node_arguments->arg_node; + + if (!(node_def_id->nid_mark & ON_A_CYCLE_MASK) && is_tail_call_module_cons_node (node_def_node_p)) + return 1; + } + } + } else { + NodeP node_p; + + node_p=arg_p2->arg_node; + if (node_p->node_kind==FillUniqueNode) + node_p=node_p->node_arguments->arg_node; + + if (is_tail_call_module_cons_node (node_p)) + return 1; + } + } + } + } + + return 0; +} + +int does_tail_call_modulo_cons (NodeP node_p,NodeDefP node_defs) +{ + switch (node_p->node_kind){ + case SwitchNode: + { + ArgP arg_p; + int r; + + r=0; + for_l (arg_p,node_p->node_arguments,arg_next) + if (does_tail_call_modulo_cons (arg_p->arg_node->node_arguments->arg_node,arg_p->arg_node->node_node_defs)) + r=1; + + return r; + } + case PushNode: + return does_tail_call_modulo_cons (node_p->node_arguments->arg_next->arg_node,node_defs); + case GuardNode: + { + int r; + + r=0; + while (node_p->node_kind==GuardNode){ + if (does_tail_call_modulo_cons (node_p->node_arguments->arg_node,node_defs)) + r=1; + + node_defs=node_p->node_node_defs; + node_p=node_p->node_arguments->arg_next->arg_node; + } + + if (does_tail_call_modulo_cons (node_p,node_defs)) + r=1; + + return r; + } + case IfNode: + { + int r; + ArgP then_arg_p; + NodeP else_node_p; + + r=0; + then_arg_p=node_p->node_arguments->arg_next; + + r=does_tail_call_modulo_cons (then_arg_p->arg_node,node_p->node_then_node_defs); + + else_node_p=then_arg_p->arg_next->arg_node; + + if (else_node_p->node_kind==NormalNode && else_node_p->node_symbol->symb_kind==fail_symb) + return r; + + if (does_tail_call_modulo_cons (else_node_p,node_p->node_else_node_defs)) + r=1; + + return r; + } + default: + return tail_call_modulo_cons_call (node_p,node_defs); + } + + return 0; +} +#endif |