aboutsummaryrefslogtreecommitdiff
path: root/backendC/CleanCompilerSources/codegen3.c
diff options
context:
space:
mode:
Diffstat (limited to 'backendC/CleanCompilerSources/codegen3.c')
-rw-r--r--backendC/CleanCompilerSources/codegen3.c2373
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