/*
	File:	codegen1.c
	Authors:Sjaak Smetsers & John van Groningen
*/

#pragma segment codegen1

#define SHARE_UPDATE_CODE 0 /* also in codegen.c */
#define FREE_STRICT_LHS_TUPLE_ELEMENTS 1 /* also in codegen2.c */
#define BIND_UNBOXED_LHS_TUPLE_AND_RECORD_ARGUMENTS_IN_BIND_ARGUMENTS 1

#include "compiledefines.h"
#include "types.t"
#include "system.h"
#include "settings.h"
#include "syntaxtr.t"
#include "comsupport.h"
#include "sizes.h"
#include "checker.h"
#include "codegen_types.h"
#include "codegen1.h"
#include "sa.h"
#include "statesgen.h"
#include "transform.h"
#include "codegen.h"
#include "codegen2.h"
#include "codegen3.h"
#include "instructions.h"
#include "scanner.h"
#include "buildtree.h"
#include "pattern_match.h"
#if SHARE_UPDATE_CODE
#	include "result_state_database.h"
#endif

extern int VERSION;

#define for_l(v,l,n) for(v=(l);v!=NULL;v=v->n)

#define RECORD_N_PREFIX c_pref
#define RECORD_D_PREFIX t_pref
#define CONSTRUCTOR_R_PREFIX k_pref

static char c_pref[] = "c";
static char t_pref[] = "t";
static char k_pref[] = "k";
static char r_pref[] = "r";

char no_pref[]	= "";
char d_pref[] 	= "d";
char n_pref[] 	= "n";

char ea_pref[]	= "ea";
char l_pref[] 	= "l";
char s_pref[] 	= "s";

char caf_pref[]	= "c";

char glob_sel[]	= "_S";
char m_symb[]	= "m";

#ifdef THUNK_LIFT_SELECTORS
char glob_selr[]= "_Sr";
#endif

char channel_code[] = "_channel_code";
char hnf_reducer_code[]	= "_hnf_reducer";
char ext_hnf_reducer_code[]	= "_HnfReducer";
char ext_nf_reducer_code[] = "_NfReducer";
char nf_reducer_code[] = "_nf_reducer";

static char loc_sel[] = "t";

/*
	Each label is represented by 4 items, namely, a module name,a prefix (which is a string), the actual name and a postfix
	(which is a number). Only the third item is always present; all the others are optional (their absence is indicated by resp.
	'NULL', 'no_pref' and 'no_num').
*/

LabDef cycle_lab			= {NULL, "", False, "_cycle_in_spine", 0};
LabDef reserve_lab			= {NULL, "", False, "_reserve", 0};
LabDef type_error_lab		= {NULL, "", False, "_type_error", 0};
LabDef indirection_lab		= {NULL, "", False, "_indirection", 0};
LabDef ind_lab				= {NULL, "", False, "_ind", 0};
LabDef hnf_lab				= {NULL, "", False, "_hnf", 0};
LabDef cons_lab				= {NULL, "", False, "_Cons", 0};
LabDef nil_lab				= {NULL, "", False, "_Nil", 0};
LabDef tuple_lab			= {NULL, "", False, "_Tuple", 0};
LabDef empty_lab			= {NULL, "", False, "_", 0};
LabDef add_arg_lab			= {NULL, "", False, "_add_arg", 0};
LabDef match_error_lab		= {NULL, "", False, "_match_error", 0};
#if STRICT_LISTS
LabDef conss_lab			= {NULL, "", False, "_Conss", 0};
LabDef consts_lab			= {NULL, "", False, "_Consts", 0};
LabDef conssts_lab			= {NULL, "", False, "_Conssts", 0};

LabDef unboxed_cons_labels[][2] = {
	/*IntObj*/	{{NULL, "", False, "_Consi", 0}, {NULL, "", False, "_Consits", 0}},
	/*BoolObj*/	{{NULL, "", False, "_Consb", 0}, {NULL, "", False, "_Consbts", 0}},
	/*CharObj*/	{{NULL, "", False, "_Consc", 0}, {NULL, "", False, "_Conscts", 0}},
	/*RealObj*/	{{NULL, "", False, "_Consr", 0}, {NULL, "", False, "_Consrts", 0}},
	/*FileObj*/	{{NULL, "", False, "_Consf", 0}, {NULL, "", False, "_Consfts", 0}}
	};

LabDef unboxed_cons_array_label = {NULL, "", False, "_Consa", 0};

#endif
#ifdef CLEAN2
LabDef select_with_dictionary_lab	= {NULL, "", False, "_select_with_dictionary", 0};
LabDef update_with_dictionary_lab	= {NULL, "", False, "_update_with_dictionary", 0};
#endif

LabDef CurrentAltLabel; /* Containing the name of the next rule alternative */
Label ReduceError;


static void error_in_function (char *m)
{
	ErrorInCompiler ("codegen1.c",m,"");
}

void MakeLabel (Label lab, char *name, unsigned num, char *pref)
{
	lab->lab_issymbol	= False;
	lab->lab_name		= name;
	lab->lab_post		= num;
	lab->lab_pref		= pref;
}

void MakeSymbolLabel (Label lab, char *mod, char *pref,SymbDef sdef, unsigned num)
{
	lab->lab_mod        = mod;
	lab->lab_pref       = pref;
	lab->lab_issymbol   = True;
	lab->lab_symbol 	= sdef;
	lab->lab_post       = num;
}

void ConvertSymbolToLabel (LabDef *slab,SymbDef sdef)
{
	char *modname;

	if (sdef->sdef_module==CurrentModule){
		if (sdef->sdef_exported)
			modname = CurrentModule;
		else
			modname = NULL;
	} else
		modname = sdef->sdef_module;

	MakeSymbolLabel (slab,modname,no_pref,sdef, 0);
}

void ConvertSymbolToDLabel (LabDef *slab,SymbDef sdef)
{
	char *modname;

	if (sdef->sdef_module==CurrentModule){
		if (sdef->sdef_exported)
			modname = CurrentModule;
		else
			modname = NULL;
	} else
		modname = sdef->sdef_module;

	MakeSymbolLabel (slab,modname,d_pref,sdef,0);
}

void ConvertSymbolToConstructorDLabel (LabDef *slab,SymbDef sdef)
{
	char *modname;

	if (!sdef->sdef_exported && sdef->sdef_module==CurrentModule && !ExportLocalLabels)
		modname = NULL;
	else
		modname = sdef->sdef_module;

	MakeSymbolLabel (slab,modname,d_pref,sdef,0);
}

void ConvertSymbolToDandNLabel (LabDef *d_lab,LabDef *n_lab,SymbDef sdef)
{
	char *modname;

	if (sdef->sdef_module==CurrentModule){
		if (sdef->sdef_exported)
			modname = CurrentModule;
		else
			modname = NULL;
	} else
		modname = sdef->sdef_module;

	MakeSymbolLabel (d_lab,modname,d_pref,sdef,0);

	*n_lab = *d_lab;
	n_lab->lab_pref = n_pref;
}

void ConvertSymbolToConstructorDandNLabel (LabDef *d_lab,LabDef *n_lab,SymbDef sdef)
{
	char *modname;

	if (!sdef->sdef_exported && sdef->sdef_module==CurrentModule && !(ExportLocalLabels && (sdef->sdef_mark & SDEF_USED_CURRIED_MASK)!=0))
		modname = NULL;
	else
		modname = sdef->sdef_module;

	MakeSymbolLabel (d_lab,modname,d_pref,sdef,0);

	if (modname==NULL && ExportLocalLabels)
		d_lab->lab_mod = CurrentModule;	

	*n_lab = *d_lab;
	n_lab->lab_pref = n_pref;	
}

void ConvertSymbolToRecordDandNLabel (LabDef *d_lab,LabDef *n_lab,SymbDef sdef)
{
	char *modname;

	if (!sdef->sdef_exported && sdef->sdef_module==CurrentModule)
		modname = NULL;
	else
		modname = sdef->sdef_module;

	MakeSymbolLabel (d_lab,modname,RECORD_D_PREFIX,sdef,0);

	if (modname==NULL && ExportLocalLabels)
		d_lab->lab_mod = CurrentModule;

	*n_lab = *d_lab;
	n_lab->lab_pref = RECORD_N_PREFIX;
}

void ConvertSymbolToKLabel (LabDef *slab,SymbDef sdef)
{
	char *modname;

	if (!sdef->sdef_exported && sdef->sdef_module==CurrentModule && !ExportLocalLabels)
		modname = NULL;
	else
		modname = sdef->sdef_module;

	MakeSymbolLabel (slab,modname,CONSTRUCTOR_R_PREFIX,sdef,0);
}

void ConvertSymbolToRLabel (LabDef *slab,SymbDef sdef)
{
	char *modname;

	if (!sdef->sdef_exported && sdef->sdef_module==CurrentModule && !ExportLocalLabels)
		modname = NULL;
	else
		modname = sdef->sdef_module;

	MakeSymbolLabel (slab,modname,r_pref,sdef,0);
}

void BuildLazyTupleSelectorLabel (Label slab, int arity, int argnr)
{
	if (argnr > NrOfGlobalSelectors){
		LazyTupleSelectors [argnr - NrOfGlobalSelectors- 1] = True;
		MakeLabel (slab,loc_sel,argnr,n_pref);
	} else 
		MakeLabel (slab,glob_sel,argnr,n_pref);
}

#if defined (THUNK_LIFT_SELECTORS)
void BuildLazyTupleSelectorAndRemoveLabel (Label slab,int arity,int argnr)
{
	if (argnr > NrOfGlobalSelectors){
		MakeLabel (slab,glob_selr,argnr,n_pref);
#if 0
		error_in_function ("BuildLazyTupleSelectorAndRemoveLabel");
#endif
	} else 
		MakeLabel (slab,glob_selr,argnr,n_pref);
}
#endif

void FileComment (void)
{
	if (DoDebug)
		FPrintF (OutFile, "\n||\tConcurrent Clean Code Generator (Version %d.%d)",VERSION / 1000, VERSION % 1000);
}

void PrintNodeId (NodeId nid)
{
	if (nid && nid->nid_ident && nid->nid_ident->ident_name)
		FPrintF (OutFile, "%s", nid->nid_ident->ident_name);
	else
		FPrintF (OutFile, "_");
}

void PrintComment (void)
{
	FPrintF (OutFile, "\n\t\t\t||\t");
}

void LhsComment (unsigned int altnr, int asp, int bsp)
{
	if (DoDebug){
		PrintComment ();
#if 1
		FPrintF (OutFile,"Match code, stacksizes A: %d B: %d",asp,bsp);
#else
		FPrintF (OutFile,"Match code for alternative %d, stacksizes A: %d B: %d",altnr, asp, bsp);
#endif
	}
}

void StrictIdComment (NodeId id)
{
	if (DoDebug){
		PrintComment ();
		PrintNodeId  (id);
		FPrintF (OutFile, ": strict annotated");
	}
}

void NodeDefComment (NodeDefs nd, char *msg)
{
	if (DoDebug){
		PrintComment ();
		FPrintF (OutFile, "Node definition ");
		PrintNodeId  (nd->def_id);

		if (nd->def_node && (nd->def_node->node_kind==NormalNode || nd->def_node->node_kind==SelectorNode)){
			FPrintF (OutFile, ": ");
			PrintSymbol  (nd->def_node->node_symbol, OutFile);
		}
		FPrintF (OutFile, " (%s)", msg);
	}
}

void ContractumComment (int asp, int bsp)
{
	if (DoDebug){
		PrintComment ();
		FPrintF (OutFile,"Building the contractum, Stacksizes A: %d B: %d",asp, bsp);
	}
}

void RedirectionComment (NodeId nid)
{
	if (DoDebug){
		PrintComment();
		FPrintF	   (OutFile, "Redirecting the root to: ");
		PrintNodeId  (nid);
	}
}

void ArgComment (Args arg)
{
	if (DoDebug){
		Node arg_node;
		
		arg_node=arg->arg_node;
		
		PrintComment();

		if (arg_node->node_kind==NodeIdNode){
			PrintNodeId (arg_node->node_node_id);
			
			if (arg_node->node_node_id->nid_node){
				Node node;
				
				node=arg_node->node_node_id->nid_node;
				
				if (node->node_kind==NormalNode || node->node_kind==SelectorNode){
					FPrintF (OutFile, ": ");
					PrintSymbol (node->node_symbol, OutFile);
				}
			}
		} else if (arg_node->node_kind==NormalNode || arg_node->node_kind==SelectorNode)
			PrintSymbol (arg->arg_node->node_symbol, OutFile);
	}
}

void NodeIdComment (NodeId node_id)
{
	if (DoDebug){
		PrintComment();

		PrintNodeId (node_id);

		if (node_id->nid_node){
			Node node;
				
			node=node_id->nid_node;
				
			if (node->node_kind==NormalNode || node->node_kind==SelectorNode){
				FPrintF (OutFile, ": ");
				PrintSymbol (node->node_symbol, OutFile);
			}
		}
	}
}

void TypeArgComment (TypeArgs arg)
{
	if (DoDebug){
		if (arg->type_arg_node->type_node_is_var){
			if (arg->type_arg_node->type_node_tv){
				TypeVar type_var;

				PrintComment();
				
				type_var=arg->type_arg_node->type_node_tv;
				if (type_var && type_var->tv_ident && type_var->tv_ident->ident_name)
					FPrintF (OutFile, "%s", type_var->tv_ident->ident_name);
				else
					FPrintF (OutFile, "_");
			}
		} else {
			PrintComment();
			PrintSymbol (arg->type_arg_node->type_node_symbol,OutFile);
		}
	}
}

void ParComment (Args arg)
{
	if (DoDebug){
		PrintComment ();
/*		if (arg->arg_id)
			PrintNodeId (arg->arg_id);
		else
			PrintSymbol (arg->arg_pattern->node_symbol,OutFile);
*/
		FPrintF	   (OutFile, ": parallel subgraph");
	}
}

void DetermineSizeOfStates (int arity, States states, int *asize, int *bsize)
{
	*asize=0;
	*bsize=0;

	for (; arity; arity--)
		AddSizeOfState (states [arity-1], asize, bsize);
}

static void AddSizeOfStates (int arity, States states, int *asize, int *bsize)
{	
	for (; arity; arity--)
		AddSizeOfState (states [arity-1], asize, bsize);
}

void DetermineSizeOfState (StateS state, int *asize, int *bsize)
{
	*asize=0;
	*bsize=0;
	AddSizeOfState (state,asize,bsize);
}

void AddSizeOfState (StateS state, int *asize, int *bsize)
{
	if (IsSimpleState (state)){
		if (state.state_kind == OnB)
			*bsize += ObjectSizes [state.state_object];
		else if (state.state_kind != Undefined)
			*asize += SizeOfAStackElem;
	} else {
		switch (state.state_type){
			case RecordState:
				AddSizeOfStates (state.state_arity, state.state_record_arguments, asize, bsize);
				break;
			case TupleState:
				AddSizeOfStates (state.state_arity, state.state_tuple_arguments, asize, bsize);
				break;
			case ArrayState:
				*asize += SizeOfAStackElem;
				break;
		}
	}
}
	
void AddStateSizesAndMaxFrameSizes (int arity,States states,int *maxasize,int *asize,int *bsize)
{
	for (arity--; arity>=0; arity--)
		AddStateSizeAndMaxFrameSize (states [arity], maxasize, asize, bsize);
}

void AddStateSizeAndMaxFrameSize (StateS state,int *maxasize,int *asize,int *bsize)
{
	if (IsSimpleState (state)){
		if (state.state_kind == OnB)
			(*bsize)	  += ObjectSizes [state.state_object];
		else if (state.state_kind != Undefined){
			(*asize)	  += SizeOfAStackElem;
			(*maxasize) += SizeOfAStackElem;
		}
	} else {
		switch (state.state_type){
			case RecordState:
				AddStateSizesAndMaxFrameSizes (state.state_arity,state.state_record_arguments,maxasize,asize,bsize);
				break;
			case TupleState:
				(*maxasize) += state.state_arity;
				AddStateSizesAndMaxFrameSizes (state.state_arity,state.state_tuple_arguments,maxasize,asize,bsize);
				break;
			case ArrayState:
				(*asize)	  += SizeOfAStackElem;
				(*maxasize) += SizeOfAStackElem;
				break;
		}
	}
}

void AddStateSizesAndMaxFrameSizesOfArguments (Args args,int *maxasize,int *asize,int *bsize)
{
	for (; args!=NULL; args=args->arg_next)
		AddStateSizeAndMaxFrameSize (args->arg_state,maxasize,asize,bsize);
}

/* The layout of the A and B stack frames are computed compile time. */

static int *OfferedAFrame, *DefAFrame, *OfferedBFrame, *DefBFrame,
	*InitOfferedAFrame, *InitDemandedAFrame, *InitDefAFrame,
	*InitOfferedBFrame, *InitDemandedBFrame, *InitDefBFrame;

int *DemandedAFrame,*DemandedBFrame,CurrentAFrameSize,CurrentBFrameSize;

/*
	CreateStackFrames, InitStackConversions, PutInBFrames and PutInAFrames
	are routines which manipulate the stack frame administration. The latter
	is used for a rather efficient way of converting one frame to another.
	At the end of this part the main routine called 'GenStackConversions'
	is given which generates ABC code for the requested conversion.
*/

#define AFRAMESIZE 1000
#define BFRAMESIZE 2000

void CreateStackFrames (void)
{
	CurrentAFrameSize = 0;
	CurrentBFrameSize = 0;

	OfferedAFrame = InitOfferedAFrame = (int*)CompAlloc ((SizeT) (AFRAMESIZE * SizeOf (int)));
	DemandedAFrame = InitDemandedAFrame = (int*)CompAlloc ((SizeT) (AFRAMESIZE * SizeOf (int)));
	DefAFrame = InitDefAFrame = (int*)CompAlloc ((SizeT) (AFRAMESIZE * SizeOf (int)));
	OfferedBFrame = InitOfferedBFrame = (int*)CompAlloc ((SizeT) (BFRAMESIZE * SizeOf (int)));
	DemandedBFrame = InitDemandedBFrame = (int*)CompAlloc ((SizeT) (BFRAMESIZE * SizeOf (int)));
	DefBFrame = InitDefBFrame = (int*)CompAlloc ((SizeT) (BFRAMESIZE * SizeOf (int)));
}	

int *AllocTempDemandedAFrame (int size)
{
	if (OfferedAFrame + size > InitOfferedAFrame + AFRAMESIZE)
		FatalCompError ("codegen", "ReserveAFrameSpace", "stack frame too big");

	return DemandedAFrame + CurrentAFrameSize;
}

int *AllocTempDemandedBFrame (int size)
{
	if (OfferedBFrame + size > InitOfferedBFrame + AFRAMESIZE)
		FatalCompError ("codegen", "ReserveBFrameSpace", "stack frame too big");

	return DemandedBFrame + CurrentBFrameSize;
}

static void ReserveAFrameSpace (int size, int *oldsize)
{
	if (OfferedAFrame + size > InitOfferedAFrame + AFRAMESIZE)
		FatalCompError ("codegen", "ReserveAFrameSpace","stack frame too big");

	DemandedAFrame	+= CurrentAFrameSize;
	OfferedAFrame	+= CurrentAFrameSize;
	DefAFrame		+= CurrentAFrameSize;

	*oldsize = CurrentAFrameSize;
	CurrentAFrameSize = size;
}

void FreeAFrameSpace (int previoussize)
{
	CurrentAFrameSize	 = previoussize;
	DemandedAFrame	-= previoussize;
	OfferedAFrame	-= previoussize;
	DefAFrame		-= previoussize;
}

void ReserveBFrameSpace (int size, int *oldsize)
{
	if ( OfferedBFrame + size > InitOfferedBFrame + BFRAMESIZE)
		FatalCompError ("codegen","ReserveBFrameSpace","stack frame too big");

	DemandedBFrame	+= CurrentBFrameSize;
	OfferedBFrame	+= CurrentBFrameSize;
	DefBFrame		+= CurrentBFrameSize;

	*oldsize = CurrentBFrameSize;
	CurrentBFrameSize = size;
}

void FreeBFrameSpace (int previoussize)
{
	CurrentBFrameSize	 = previoussize;
	DemandedBFrame	-= previoussize;
	OfferedBFrame	-= previoussize;
	DefBFrame		-= previoussize;
}

void InitStackFrame (int offframe[],int defframe [],int max)
{
	int i;

	for (i=0; i<max; i++){
		offframe [i] = max;
		defframe [i] = i;
	}
}

void InitStackConversions (int maxa,int maxb,int *oldamax_p,int *oldbmax_p)
{
	ReserveAFrameSpace (maxa,oldamax_p);
	ReserveBFrameSpace (maxb,oldbmax_p);

	DemandedAFrame [0] = 0;
	InitStackFrame (OfferedAFrame, DefAFrame, CurrentAFrameSize);
	InitStackFrame (OfferedBFrame, DefBFrame, CurrentBFrameSize);
}

void InitAStackConversions (int maxa,int *oldamax_p)
{
	ReserveAFrameSpace (maxa,oldamax_p);
	InitStackFrame (OfferedAFrame, DefAFrame, CurrentAFrameSize);
}

void ExitStackConversions (int oldamax, int oldbmax)
{
	FreeAFrameSpace (oldamax);
	FreeBFrameSpace (oldbmax);
}

#ifdef _FRAMECHECK_
	static void UpdateAFrame (int frame[], int offset, int index)
	{
		if (offset >= CurrentAFrameSize || offset < 0 || index >= CurrentAFrameSize	|| index < 0)
			ErrorInCompiler ("codegen1.c", "UpdateAFrame","index out of range");
		else
			frame [offset] = index;
	}
	
	static void UpdateBFrame (int frame[], int offset, int index)
	{
		if (offset >= CurrentBFrameSize || offset < 0 || index >= CurrentBFrameSize	|| index < 0)
			ErrorInCompiler ("codegen1.c", "UpdateBFrame","index out of range");
		else
			frame [offset] = index;
	}
#else

#define UpdateAFrame(frame,offset,index) ((frame)[offset] = (index))
#define UpdateBFrame(frame,offset,index) ((frame)[offset] = (index))

#endif
	
void PutInBFrames (int bsp, int *b_ind, int size)
{
	int j;
	
	*b_ind += size;
	
	for (j=0; j<size; j++){
		UpdateBFrame (OfferedBFrame, bsp-j, bsp-j);
		UpdateBFrame (DemandedBFrame, (*b_ind)-j, bsp-j);
	}
}

void PutInAFrames (int asp, int *a_ind)
{
	++ *a_ind;
	
	UpdateAFrame (OfferedAFrame,asp,asp);
	UpdateAFrame (DemandedAFrame,*a_ind,asp);
}

#ifdef _FRAMECHECK_
	static void UpdateFrame (int frame[],int offset,int index, int offframe[])
	{
		if (offframe == OfferedAFrame)
			UpdateAFrame (frame,offset,index);
		else
			UpdateBFrame (frame,offset,index);
	}
#else

#	define UpdateFrame(frame,offset,index,offframe) ((frame)[offset] = (index))

#endif

static void CopyEntry (int offset, int *sp, int offframe [])
{
	if (offframe == OfferedAFrame)
		GenPushA (*sp-offset); 
	else
		GenPushB (*sp-offset); 
	++ *sp;
	UpdateFrame  (offframe, *sp, offframe[offset], offframe);
}

static void UpdateEntry (int srcoffset, int dstoffset, int sp, int offframe [])
{
	if (offframe == OfferedAFrame)
		GenUpdateA (sp-srcoffset, sp-dstoffset);
	else
		GenUpdateB (sp-srcoffset, sp-dstoffset);
	UpdateFrame (offframe, dstoffset, offframe [srcoffset], offframe);
}

static void FillHole (int sp,int offframe[],int demframe [],int defframe [],int offsize,int demsize)
{
	do {
		if (sp > demsize)
			return;
		else {
			int newdef;
			
			newdef = defframe [demframe[sp]];
			UpdateEntry (newdef, sp, offsize, offframe);
			UpdateFrame (defframe, demframe[sp], sp, offframe);
			sp = newdef;
		}
	} while (offframe[sp] != demframe[sp]);
}

static void GenStackConversions (int *sp,int demsize,int offframe[],int demframe[],int defframe[],int hole)
{
	int mysp;
	Bool topused;

	topused = False;

	for (mysp = 1; mysp <= *sp; mysp++){
		if (offframe  [mysp] == hole) /* Indicating a hole */
			FillHole (mysp, offframe, demframe, defframe,*sp, demsize);
	}

	for (;mysp <= demsize; mysp++){
		int olddef;
		
		olddef = defframe [demframe [mysp]];
		CopyEntry (olddef, sp, offframe);
		if (offframe [olddef] != demframe [olddef]){
			UpdateFrame (defframe, demframe [mysp], mysp, offframe);
			FillHole (olddef, offframe, demframe, defframe, *sp, demsize);
		}
	}

	for (mysp = 1; mysp <= demsize; mysp++){
		if (offframe [mysp] != demframe [mysp]){
			if (topused)
				UpdateEntry (mysp, *sp, *sp, offframe);
			else {
				topused = True;
				CopyEntry (mysp, sp, offframe);
			}
			UpdateFrame (defframe, offframe [mysp], *sp, offframe);
			FillHole (mysp, offframe, demframe, defframe, *sp, demsize);
		}
	}	
}

void GenAStackConversions (int sp,int demsize)
{
	GenStackConversions (&sp,demsize,OfferedAFrame,DemandedAFrame,DefAFrame,CurrentAFrameSize);
	GenPopA (sp-demsize);
}

void GenBStackConversions (int sp,int demsize)
{
	GenStackConversions (&sp,demsize,OfferedBFrame,DemandedBFrame,DefBFrame,CurrentBFrameSize);
	GenPopB (sp-demsize);
}

/*	End of the stack frame conversion routines */

static void JmpEvalArgsEntry (int args_asp,Label ea_lab)
{
	GenDAStackLayout (args_asp);
	if (DoTimeProfiling)
		GenPN();
	GenJmp (ea_lab);
}

static void CallEvalArgsEntry (int args_a_size,StateP function_state_p,int result_asize,int result_bsize,Label ea_lab)
{
	GenDAStackLayout (args_a_size);
	GenJsr (ea_lab);
	GenOStackLayoutOfState (result_asize,result_bsize,function_state_p[-1]);
}

static void CallEvalArgsEntryUnboxed (int args_a_size,int args_b_size,ArgP arguments,StateP function_state_p,int result_asize,int result_bsize,Label ea_lab)
{
	GenDStackLayout (args_a_size,args_b_size,arguments);
	GenJsr (ea_lab);
	GenOStackLayoutOfState (result_asize,result_bsize,function_state_p[-1]);
}

static void GenerateConstructorDescriptorAndFunction (ConstructorList constructor)
{
	Symbol constructor_symbol;
	SymbDef constructor_def;

	constructor_symbol=constructor->cl_constructor->type_node_symbol;
	constructor_def=constructor_symbol->symb_def;
	
	if (constructor_def->sdef_kind==CONSTRUCTOR && constructor_def->sdef_strict_constructor){
		GenStrictConstructorDescriptor (constructor_def,constructor->cl_state_p);
		
		if (constructor_def->sdef_exported || (constructor_def->sdef_mark & (SDEF_USED_LAZILY_MASK | SDEF_USED_CURRIED_MASK)) || ExportLocalLabels){
			LabDef constructor_label,ealab,n_lab,d_lab;
			int maxasize,asize,bsize;
			int asp,bsp,arity;

			asp = constructor_def->sdef_arity;
			bsp = 0;
			arity = asp;
			
			ConvertSymbolToLabel (&CurrentAltLabel,constructor_def);
						
			if (constructor_def->sdef_exported)
				GenExportEaEntry (constructor_def);
			
			GenConstructorFunctionDescriptorAndExportNodeAndDescriptor (constructor_def);

			if (DoTimeProfiling)
				GenPB (constructor_def->sdef_ident->ident_name);

			MakeSymbolLabel (&ealab,constructor_def->sdef_exported ? CurrentModule : NULL,ea_pref,constructor_def,0);
			
			if (constructor_def->sdef_exported || (constructor_def->sdef_mark & SDEF_USED_CURRIED_MASK) || ExportLocalLabels){
				CurrentAltLabel.lab_pref  = l_pref;

				if (DoTimeProfiling)
					GenPL();
				
				GenOAStackLayout (2);
				GenLabelDefinition (&CurrentAltLabel);
				
				GenPushArgs (0,arity-1,arity-1);
				GenUpdateA (arity,arity-1);	
				GenCreate (-1);
				GenUpdateA (0,arity+1);
				GenPopA (1);
				JmpEvalArgsEntry (arity+1,&ealab);
			}

			ConvertSymbolToConstructorDandNLabel (&d_lab,&n_lab,constructor_def);

			GenNodeEntryDirective (arity,&d_lab,&ealab);
			GenOAStackLayout (1);
			GenLabelDefinition (&n_lab);
			GenPushNode (ReduceError,asp);

			GenOAStackLayout (arity+1);
			if (DoTimeProfiling)
				GenPN();
			GenLabelDefinition (&ealab);

			asize=0;
			bsize=0;
			maxasize=0;

			AddStateSizesAndMaxFrameSizes (arity,constructor->cl_state_p,&maxasize,&asize,&bsize);

			EvaluateAndMoveStateArguments (arity,constructor->cl_state_p,asp,maxasize);

			ConvertSymbolToKLabel (&constructor_label,constructor_def);

			GenFillR (&constructor_label,asize,bsize,asize,0,0,ReleaseAndFill,True);		

		 	GenRtn (1,0,OnAState);
 	
	 		if (DoTimeProfiling)
				GenPE();
		 }
	} else
		GenConstructorDescriptorAndExport (constructor_def);
}

static void GenLazyRecordEntry (SymbDef rdef)
{
	LabDef record_label,d_label;
	States argstates;
	int asp,bsp,arity;
	int maxasize,asize,bsize;

	argstates = rdef->sdef_record_state.state_record_arguments;

	asp = rdef->sdef_cons_arity;
	bsp = 0;
	arity = asp;

	ConvertSymbolToRecordDandNLabel (&d_label,&CurrentAltLabel,rdef);
	
	if (rdef->sdef_exported)
		GenExportEaEntry (rdef);

	if (DoTimeProfiling)
		GenPB (rdef->sdef_ident->ident_name);

	GenLazyRecordDescriptorAndExport (rdef);

	GenLazyRecordNodeEntryDirective (arity,&d_label);

	GenOAStackLayout (1);
	GenLabelDefinition (&CurrentAltLabel);
	GenPushNode (ReduceError,asp);

	asize=0;
	bsize=0;
	maxasize=0;
	
	AddStateSizesAndMaxFrameSizes (arity,argstates,&maxasize,&asize,&bsize);

	EvaluateAndMoveStateArguments (arity,argstates,asp,maxasize);

	ConvertSymbolToRLabel (&record_label, rdef);

	GenFillR (&record_label,asize,bsize,asize,0,0,ReleaseAndFill,True);

 	GenRtn (1,0,OnAState);

	if (DoTimeProfiling)
		GenPE();
}

void DetermineFieldSizeAndPosition (int fieldnr,int *asize,int *bsize,int *apos,int *bpos,States argstates)
{
	int i;

	*asize = *bsize = *apos = *bpos = 0;

	for (i=0; i < fieldnr; i++)
		AddSizeOfState (argstates [i], apos, bpos);

	AddSizeOfState (argstates [i], asize, bsize);
}

static void GenLazyFieldSelectorEntry (SymbDef field_def,StateS recstate,int tot_a_size,int tot_b_size)
{
	if (field_def->sdef_exported || field_def->sdef_mark & SDEF_USED_LAZILY_MASK){
		LabDef newealab,loclab,ealab,d_lab,n_lab;
		Bool update_root_node;
		int fieldnr,apos,bpos,asize,bsize;
		StateS offfieldstate,demfieldstate;
		char *record_name;
		LabDef *ea_label_p;
		int node_directive_arity;
		
		fieldnr = field_def->sdef_sel_field_number;

		offfieldstate = recstate.state_record_arguments [fieldnr];
		demfieldstate = field_def->sdef_sel_field->fl_state;

		DetermineFieldSizeAndPosition (fieldnr,&asize,&bsize,&apos,&bpos,recstate.state_record_arguments);
		
		ConvertSymbolToLabel (&CurrentAltLabel,field_def);
		
		if (field_def->sdef_exported)
			GenExportFieldSelector (field_def);
				
		GenFieldSelectorDescriptor (field_def,IsSimpleState (offfieldstate));

		if (DoTimeProfiling)
			GenPB (field_def->sdef_ident->ident_name);

		update_root_node = ! ExpectsResultNode (offfieldstate);

		record_name=field_def->sdef_type->type_lhs->ft_symbol->symb_def->sdef_ident->ident_name;
		
		if (field_def->sdef_calledwithrootnode){
			ealab = CurrentAltLabel;
			ealab.lab_pref = ea_pref;
			
			if (update_root_node){
				newealab = ealab;
				newealab.lab_mod = CurrentModule;
				ealab.lab_mod = NULL;
				ea_label_p=&newealab;
			} else
				ea_label_p=&ealab;
		} else if (field_def->sdef_returnsnode)
			ea_label_p=&empty_lab;
		else
			ea_label_p=NULL;
		
		node_directive_arity = IsSimpleState (offfieldstate) ? (offfieldstate.state_kind!=OnB ? -4 : -3) : field_def->sdef_arity;

		ConvertSymbolToDandNLabel (&d_lab,&n_lab,field_def);

		GenFieldNodeEntryDirective (node_directive_arity,&d_lab,ea_label_p,record_name);

		GenOAStackLayout (1);
		GenFieldLabelDefinition (&n_lab,record_name);

		GenPushNode (ReduceError,field_def->sdef_arity);
		
		if (field_def->sdef_calledwithrootnode){
			if (update_root_node){
				MakeLabel (&loclab, m_symb,NewLabelNr++,no_pref);
				GenOAStackLayout (field_def->sdef_arity);
				if (DoTimeProfiling)
					GenPN();
				GenLabelDefinition (&loclab);
			} else {
				GenOAStackLayout (field_def->sdef_arity+1);
				if (DoTimeProfiling)
					GenPN();
				GenFieldLabelDefinition (&ealab,record_name);
			}
		}
		
		GenJsrEval (0);

		if (IsSimpleState (offfieldstate) && offfieldstate.state_kind==OnB && !DoTimeProfiling){
			LabDef gc_apply_label;

			gc_apply_label=CurrentAltLabel;
			gc_apply_label.lab_pref = l_pref;

			GenOAStackLayout (2);
			GenFieldLabelDefinition (&gc_apply_label,record_name);
		}

		GenPushRArgB (0, tot_a_size, tot_b_size, bpos + 1, bsize); 
		GenReplRArgA (tot_a_size, tot_b_size, apos + 1, asize);
	
		if (IsSimpleState (offfieldstate)){
			if (offfieldstate.state_kind==OnB){
				FillBasicFromB (offfieldstate.state_object, 0, 0, ReleaseAndFill);
				GenPopB (ObjectSizes [offfieldstate.state_object]);
	 			GenRtn (1,0,OnAState);
			} else {
				if (IsLazyState (offfieldstate)){
					if (ExpectsResultNode (demfieldstate))
						GenJmpEvalUpdate ();
					else {
						GenJsrEval (0);
						GenFillFromA (0, 1, ReleaseAndFill);
						GenPopA (1);
		 				GenRtn (1,0, OnAState);
					}
				} else {
					GenFillFromA (0, 1, ReleaseAndFill);
					GenPopA (1);
	 				GenRtn (1,0,OnAState);
				}
			}
		} else {
			switch (offfieldstate.state_type){
				case TupleState:
					BuildTuple (asize,bsize,asize,bsize,
								offfieldstate.state_arity,offfieldstate.state_tuple_arguments,
								asize,bsize,0,ReleaseAndFill,False);
					break;
				case ArrayState:
					GenFillArray (0,1,ReleaseAndFill);
					break;
#ifdef ADD_ARGUMENTS_TO_HIGHER_ORDER_FUNCTIONS
				case RecordState:
					BuildRecord (offfieldstate.state_record_symbol,asize,bsize,asize,bsize,
									asize,bsize,0,ReleaseAndFill,False);
					break;
#endif
			}
			GenPopA (asize);
			GenPopB (bsize);
		 	GenRtn (1,0,OnAState);
		}
		
		if (field_def->sdef_calledwithrootnode && update_root_node){
			GenOAStackLayout (field_def->sdef_arity + 1);
			if (DoTimeProfiling)
				GenPN();
			GenFieldLabelDefinition (&newealab,record_name);
			GenDAStackLayout (field_def->sdef_arity);
			if (DoTimeProfiling)
				GenPN();
			GenJmp (&loclab);
		}

		if (DoTimeProfiling)
			GenPE();

		/* generate apply entry for the garbage collector: */
		if (IsSimpleState (offfieldstate)){
			LabDef gc_apply_label;

			gc_apply_label=CurrentAltLabel;
			gc_apply_label.lab_pref = l_pref;

			if (offfieldstate.state_kind==OnB){
				if (DoTimeProfiling){
					GenOAStackLayout (2);
					GenFieldLabelDefinition (&gc_apply_label,record_name);
					
					GenPushRArgB (0,tot_a_size,tot_b_size,bpos+1,bsize);
					GenReplRArgA (tot_a_size,tot_b_size,apos+1, asize);

					FillBasicFromB (offfieldstate.state_object,0,0,ReleaseAndFill);
					GenPopB (ObjectSizes [offfieldstate.state_object]);
		 			GenRtn (1,0, OnAState);
	 			}
			} else {
				GenOAStackLayout (1);
				GenFieldLabelDefinition (&gc_apply_label,record_name);
				
				GenReplRArgA (tot_a_size, tot_b_size, apos + 1, asize);
	 			GenRtn (1,0, OnAState);
			}
		}
	 }
}

static void GenUnboxedRecordApplyAndNodeEntries (SymbDef fun_def,int n_result_nodes_on_a_stack,int *a_size_p,int *b_size_p)
{
	LabDef ealab;
	int asize,bsize,maxasize;
	RuleTypes rule_type;
	int arity;

	asize = 0;
	bsize = 0;
	maxasize = 0;

	rule_type	= fun_def->sdef_rule_type;
	arity = fun_def->sdef_arity;

	MakeSymbolLabel (&CurrentAltLabel,NULL,no_pref,fun_def,0);

	ealab			= CurrentAltLabel;
	ealab.lab_pref	= ea_pref;
	
	AddStateSizesAndMaxFrameSizes (arity,rule_type->rule_type_state_p,&maxasize,&asize,&bsize);

	if ((fun_def->sdef_mark & SDEF_USED_CURRIED_MASK) || DoDescriptors || DoParallel)
		GenArrayFunctionDescriptor (fun_def,&CurrentAltLabel,arity);

	if (DoTimeProfiling)
		GenPB (fun_def->sdef_ident->ident_name);

	if (fun_def->sdef_mark & SDEF_USED_CURRIED_MASK)
		ApplyEntry (rule_type->rule_type_state_p,arity,&ealab,!(fun_def->sdef_mark & SDEF_USED_LAZILY_MASK));

	if (fun_def->sdef_mark & SDEF_USED_LAZILY_MASK)
		NodeEntry (rule_type->rule_type_state_p,arity,&ealab,fun_def);

	EvalArgsEntry (rule_type->rule_type_state_p,fun_def,maxasize,&ealab,n_result_nodes_on_a_stack);
	
	*a_size_p=asize;
	*b_size_p=bsize;
}

#if STRICT_LISTS
extern PolyList unboxed_record_cons_list,unboxed_record_decons_list;

void GenerateCodeForLazyUnboxedRecordListFunctions (void)
{
	PolyList unboxed_record_cons_elem,unboxed_record_decons_elem;
	
	for_l (unboxed_record_cons_elem,unboxed_record_cons_list,pl_next){
		SymbDef fun_def;
		
		fun_def=unboxed_record_cons_elem->pl_elem;
		if (fun_def->sdef_mark & (SDEF_USED_LAZILY_MASK | SDEF_USED_CURRIED_MASK)){
			int a_size,b_size;
			TypeArgs type_node_arguments_p;
			LabDef unboxed_record_cons_lab;
			int tail_strict;

			GenUnboxedRecordApplyAndNodeEntries (fun_def,1,&a_size,&b_size);
					
			type_node_arguments_p=fun_def->sdef_rule_type->rule_type_rule->type_alt_lhs->type_node_arguments;
			tail_strict=type_node_arguments_p->type_arg_next->type_arg_node->type_node_symbol->symb_tail_strictness;
			
			unboxed_record_cons_lab.lab_mod=NULL;
			unboxed_record_cons_lab.lab_pref=tail_strict ? "r_Cons#!" : "r_Cons#";
			unboxed_record_cons_lab.lab_issymbol=False;
			unboxed_record_cons_lab.lab_name=type_node_arguments_p->type_arg_node->type_node_symbol->symb_def->sdef_ident->ident_name;
			unboxed_record_cons_lab.lab_post='\0';
							
			GenFillR (&unboxed_record_cons_lab,a_size,b_size,a_size,0,0,ReleaseAndFill,True);

			GenRtn (1,0,OnAState);
			
			if (DoTimeProfiling)
				GenPE();
		}
	}

	for_l (unboxed_record_decons_elem,unboxed_record_decons_list,pl_next){
		SymbDef fun_def;
		
		fun_def=unboxed_record_decons_elem->pl_elem;
		if (fun_def->sdef_mark & (SDEF_USED_LAZILY_MASK | SDEF_USED_CURRIED_MASK)){
			int a_size,b_size;
			StateP result_state_p;

			GenUnboxedRecordApplyAndNodeEntries (fun_def,0,&a_size,&b_size);
			
			result_state_p=&fun_def->sdef_rule_type->rule_type_state_p[-1];

			DetermineSizeOfState (*result_state_p,&a_size,&b_size);
			
			if (b_size==0)
				GenReplArgs (a_size,a_size);
			else
				GenReplRArgs (a_size,b_size);
					
			GenRtn (a_size,b_size,*result_state_p);
			
			if (DoTimeProfiling)
				GenPE();
		}
	}
}
#endif

extern PolyList UserDefinedArrayFunctions;

void GenerateCodeForLazyArrayFunctionEntries (void)
{
	PolyList next_fun;
	
	for (next_fun = UserDefinedArrayFunctions; next_fun; next_fun = next_fun -> pl_next){
		SymbDef arr_fun_def;
		
		arr_fun_def = ((Symbol)next_fun->pl_elem)->symb_def;

		if (arr_fun_def ->sdef_mark & (SDEF_USED_LAZILY_MASK | SDEF_USED_CURRIED_MASK)){
			int a_size,b_size;
			
			GenUnboxedRecordApplyAndNodeEntries (arr_fun_def,0,&a_size,&b_size);

			CallArrayFunction (arr_fun_def,False,&arr_fun_def->sdef_rule_type->rule_type_state_p[-1]);

			if (DoTimeProfiling)
				GenPE();
		}
	}
}

void GenerateCodeForConstructorsAndRecords (Symbol symbols)
{
	Symbol symbol_p;
#if STRICT_LISTS
	PolyList unboxed_record_cons_element;
#endif
	
	for_l (symbol_p,symbols,symb_next){
		if (symbol_p->symb_kind==definition){
			SymbDef def;
		
			def = symbol_p->symb_def;

			if (def->sdef_module==CurrentModule){
				if (def->sdef_kind==TYPE){
					ConstructorList alt;

					for_l (alt,def->sdef_type->type_constructors,cl_next)
						GenerateConstructorDescriptorAndFunction (alt);
				} else if (def->sdef_kind==RECORDTYPE){
					FieldList fields;
					int asize, bsize;
					ConstructorList constructor;

					constructor = def->sdef_type->type_constructors;
					DetermineSizeOfState (def->sdef_record_state, &asize, &bsize);

					GenRecordDescriptor (def);

					if (def->sdef_strict_constructor && (def->sdef_exported || (def->sdef_mark & SDEF_USED_LAZILY_MASK) || ExportLocalLabels))
						GenLazyRecordEntry (def);

					for_l (fields,constructor->cl_fields,fl_next)
						GenLazyFieldSelectorEntry (fields->fl_symbol->symb_def,def->sdef_record_state, asize, bsize);
				}					
			}
		}
	}

#if STRICT_LISTS
	for_l (unboxed_record_cons_element,unboxed_record_cons_list,pl_next){
		SymbDef cons_instance_sdef,record_sdef;
		TypeArgs type_node_arguments_p;
		int tail_strict;
		
		cons_instance_sdef=unboxed_record_cons_element->pl_elem;
		type_node_arguments_p=cons_instance_sdef->sdef_rule_type->rule_type_rule->type_alt_lhs->type_node_arguments;
		record_sdef=type_node_arguments_p->type_arg_node->type_node_symbol->symb_def;
		tail_strict=type_node_arguments_p->type_arg_next->type_arg_node->type_node_symbol->symb_tail_strictness;
		
		GenUnboxedConsRecordDescriptor (record_sdef,tail_strict);
	}
#endif
}

Bool NodeEntry (StateS *const function_state_p,int arity,Label ealab,SymbDef rootsymb)
{
	Bool update_root_node;
	LabDef newealab,loclab,d_lab,n_lab,*ea_label_in_node_directive;

	ConvertSymbolToDandNLabel (&d_lab,&n_lab,rootsymb);

	d_lab.lab_post = n_lab.lab_post = CurrentAltLabel.lab_post;

	update_root_node = ! ExpectsResultNode (function_state_p[-1]);

	if (update_root_node && DoTimeProfiling && !function_called_only_curried_or_lazy_with_one_return)
		GenPD();
	
	if (rootsymb->sdef_calledwithrootnode){
		if (update_root_node){
			newealab = *ealab;
			newealab.lab_mod = CurrentModule;
			ea_label_in_node_directive=&newealab;
		} else
			ea_label_in_node_directive=ealab;
	} else if (rootsymb->sdef_returnsnode)
		ea_label_in_node_directive=&empty_lab;
	else
		ea_label_in_node_directive=NULL;

	GenNodeEntryDirective (arity,&d_lab,ea_label_in_node_directive);
	
	GenOAStackLayout (1);
	GenNodeEntryLabelDefinition (&n_lab);
	GenPushNode (ReduceError,arity);

	if (! update_root_node)
		return True;

	if (rootsymb->sdef_calledwithrootnode){
		MakeLabel (&loclab, m_symb, NewLabelNr++, no_pref);
		GenOAStackLayout (arity);
		if (DoTimeProfiling)
			GenPN();
		GenLabelDefinition (&loclab);
	}

	if (IsSimpleState (function_state_p[-1])){
		if (function_state_p[-1].state_kind==OnB){
#if SHARE_UPDATE_CODE
			int result,label_number;
#endif
			if (function_called_only_curried_or_lazy_with_one_return)
				return False;

			CallEvalArgsEntry (arity,function_state_p,0,ObjectSizes [function_state_p[-1].state_object],ealab);

#if SHARE_UPDATE_CODE
			result=get_label_number_from_result_state_database (type,1,&label_number);

			if (result==2){
				LabDef update_label;

				MakeLabel (&update_label,"u",label_number,no_pref);
				GenStackLayoutOfState (DemStackDir,0,ObjectSizes [function_state_p[-1].state_object],function_state_p[-1]);
				GenJmp (&update_label);
			} else {
				if (result==1){
					LabDef update_label;

					MakeLabel (&update_label,"u",label_number,no_pref);
					GenOStackLayoutOfState (0,ObjectSizes [function_state_p[-1].state_object],function_state_p[-1]);
					GenLabelDefinition (&update_label);
				}
#endif

			FillBasicFromB (function_state_p[-1].state_object, 0, 0, ReleaseAndFill);
			GenPopB (ObjectSizes [function_state_p[-1].state_object]);
			GenRtn (1,0,OnAState);

#if SHARE_UPDATE_CODE
			}
#endif
		} else if (function_state_p[-1].state_kind==StrictRedirection || function_state_p[-1].state_kind==LazyRedirection){
			CallEvalArgsEntry (arity,function_state_p,1,0,ealab);
			GenFillFromA (0, 1, ReleaseAndFill);
			GenPopA (1);
			GenRtn (1,0,OnAState);
		}
	} else {
		int asize, bsize;
#if SHARE_UPDATE_CODE
		int result,label_number;
#endif
		
		if (function_called_only_curried_or_lazy_with_one_return)
			return False;

		DetermineSizeOfState (function_state_p[-1], &asize, &bsize);
		CallEvalArgsEntry (arity,function_state_p,asize,bsize,ealab);

#if SHARE_UPDATE_CODE
		result=get_label_number_from_result_state_database (type,1,&label_number);

		if (result==2){
			LabDef update_label;

			MakeLabel (&update_label,"u",label_number,no_pref);
			GenStackLayoutOfState (DemStackDir,asize,bsize,function_state_p[-1]);
			GenJmp (&update_label);
		} else {
			if (result==1){
				LabDef update_label;

				MakeLabel (&update_label,"u",label_number,no_pref);
				GenOStackLayoutOfState (asize,bsize,function_state_p[-1]);
				GenLabelDefinition (&update_label);
			}
#endif

		switch (function_state_p[-1].state_type){
			case TupleState:
				BuildTuple (asize,bsize,asize,bsize,function_state_p[-1].state_arity,
					function_state_p[-1].state_tuple_arguments,asize, bsize, 0, ReleaseAndFill,False);
				break;
			case RecordState:
				BuildRecord (function_state_p[-1].state_record_symbol,asize,bsize,asize,bsize,
								asize,bsize,0,ReleaseAndFill,False);
				break;
			case ArrayState:
				GenFillArray (0, 1, ReleaseAndFill);
				break;
		}
		GenPopA (asize);
		GenPopB (bsize);

		GenRtn (1,0,OnAState);
#if SHARE_UPDATE_CODE
		}
#endif
	}
	
	if (rootsymb->sdef_calledwithrootnode){
		GenOAStackLayout (arity + 1);
		GenLabelDefinition (&newealab);
		GenDAStackLayout (arity);
		if (DoTimeProfiling)
			GenPN();
		GenJmp (&loclab);
	}

	return False;
}

Bool NodeEntryUnboxed (StateS *const function_state_p,NodeP call_node_p,int args_a_size,int args_b_size,Label ealab,SymbDef rootsymb)
{
	Bool update_root_node;
	LabDef newealab,loclab,d_lab,n_lab,*ea_label_in_node_directive;

	ConvertSymbolToDandNLabel (&d_lab,&n_lab,rootsymb);

	d_lab.lab_post = n_lab.lab_post = CurrentAltLabel.lab_post;

	update_root_node = ! ExpectsResultNode (function_state_p[-1]);

	if (update_root_node && DoTimeProfiling && !function_called_only_curried_or_lazy_with_one_return)
		GenPD();
	
	if (rootsymb->sdef_calledwithrootnode){
		/* jmp_eval_upd not yet implemented for closures with unboxed elements */
		if (args_b_size!=0){
			ea_label_in_node_directive=&empty_lab;
		} else {
			if (update_root_node){
				newealab = *ealab;
				newealab.lab_mod = CurrentModule;
				ea_label_in_node_directive=&newealab;
			} else
				ea_label_in_node_directive=ealab;	
		}
	} else if (rootsymb->sdef_returnsnode)
		ea_label_in_node_directive=&empty_lab;
	else
		ea_label_in_node_directive=NULL;

	if (args_b_size!=0)
		GenNodeEntryDirectiveUnboxed (args_a_size,args_b_size,&d_lab,ea_label_in_node_directive);
	else
		GenNodeEntryDirective (args_a_size,&d_lab,ea_label_in_node_directive);
	
	GenOAStackLayout (1);
	GenNodeEntryLabelDefinition (&n_lab);
	if (args_b_size!=0)
		GenPushNodeU (ReduceError,args_a_size,args_b_size);
	else
		GenPushNode (ReduceError,args_a_size);

	if (! update_root_node)
		return True;

	if (args_b_size==0 && rootsymb->sdef_calledwithrootnode){
		MakeLabel (&loclab, m_symb, NewLabelNr++, no_pref);
		GenOAStackLayout (args_a_size);
		if (DoTimeProfiling)
			GenPN();
		GenLabelDefinition (&loclab);
	}

	if (IsSimpleState (function_state_p[-1])){
		if (function_state_p[-1].state_kind==OnB){
#	if SHARE_UPDATE_CODE
			int result,label_number;
#	endif
			if (function_called_only_curried_or_lazy_with_one_return)
				return False;

			CallEvalArgsEntryUnboxed (args_a_size,args_b_size,call_node_p->node_arguments,function_state_p,0,ObjectSizes [function_state_p[-1].state_object],ealab);

#	if SHARE_UPDATE_CODE
			result=get_label_number_from_result_state_database (type,1,&label_number);

			if (result==2){
				LabDef update_label;

				MakeLabel (&update_label,"u",label_number,no_pref);
				GenStackLayoutOfState (DemStackDir,0,ObjectSizes [function_state_p[-1].state_object],function_state_p[-1]);
				GenJmp (&update_label);
			} else {
				if (result==1){
					LabDef update_label;

					MakeLabel (&update_label,"u",label_number,no_pref);
					GenOStackLayoutOfState (0,ObjectSizes [function_state_p[-1].state_object],function_state_p[-1]);
					GenLabelDefinition (&update_label);
				}
#	endif

			FillBasicFromB (function_state_p[-1].state_object, 0, 0, ReleaseAndFill);
			GenPopB (ObjectSizes [function_state_p[-1].state_object]);
			GenRtn (1,0,OnAState);

#	if SHARE_UPDATE_CODE
			}
#	endif
		} else if (function_state_p[-1].state_kind==StrictRedirection || function_state_p[-1].state_kind==LazyRedirection){
			CallEvalArgsEntryUnboxed (args_a_size,args_b_size,call_node_p->node_arguments,function_state_p,1,0,ealab);
			GenFillFromA (0, 1, ReleaseAndFill);
			GenPopA (1);
			GenRtn (1,0,OnAState);
		}
	} else {
		int asize, bsize;
#	if SHARE_UPDATE_CODE
		int result,label_number;
#	endif
		
		if (function_called_only_curried_or_lazy_with_one_return)
			return False;

		DetermineSizeOfState (function_state_p[-1], &asize, &bsize);
		CallEvalArgsEntryUnboxed (args_a_size,args_b_size,call_node_p->node_arguments,function_state_p,asize,bsize,ealab);

#	if SHARE_UPDATE_CODE
		result=get_label_number_from_result_state_database (type,1,&label_number);

		if (result==2){
			LabDef update_label;

			MakeLabel (&update_label,"u",label_number,no_pref);
			GenStackLayoutOfState (DemStackDir,asize,bsize,function_state_p[-1]);
			GenJmp (&update_label);
		} else {
			if (result==1){
				LabDef update_label;

				MakeLabel (&update_label,"u",label_number,no_pref);
				GenOStackLayoutOfState (asize,bsize,function_state_p[-1]);
				GenLabelDefinition (&update_label);
			}
#	endif

		switch (function_state_p[-1].state_type){
			case TupleState:
				BuildTuple (asize,bsize,asize,bsize,function_state_p[-1].state_arity,
					function_state_p[-1].state_tuple_arguments,asize, bsize, 0, ReleaseAndFill,False);
				break;
			case RecordState:
				BuildRecord (function_state_p[-1].state_record_symbol,asize,bsize,asize,bsize,
								asize,bsize,0,ReleaseAndFill,False);
				break;
			case ArrayState:
				GenFillArray (0, 1, ReleaseAndFill);
				break;
		}
		GenPopA (asize);
		GenPopB (bsize);

		GenRtn (1,0,OnAState);
#	if SHARE_UPDATE_CODE
		}
#	endif
	}

	if (args_b_size==0 && rootsymb->sdef_calledwithrootnode){
		GenOAStackLayout (args_a_size + 1);
		GenLabelDefinition (&newealab);
		GenDAStackLayout (args_a_size);
		if (DoTimeProfiling)
			GenPN();
		GenJmp (&loclab);
	}

	return False;
}

void ApplyEntry (StateS *const function_state_p,int arity,Label ea_lab,int ea_label_follows)
{
	CurrentAltLabel.lab_pref  = l_pref;

	if (arity==0){
		GenOAStackLayout (1);
		GenLabelDefinition (&CurrentAltLabel);
		GenHalt();
		return;
	}

	if (DoTimeProfiling){
		if ((!IsSimpleState (function_state_p[-1]) || function_state_p[-1].state_kind==OnB) && !function_called_only_curried_or_lazy_with_one_return)
			GenPLD();
		else
			GenPL();
	}

	GenOAStackLayout (2);
	GenLabelDefinition (&CurrentAltLabel);
	
	if (IsSimpleState (function_state_p[-1])){
		if (function_state_p[-1].state_kind==OnB){
#if SHARE_UPDATE_CODE
			int result,label_number;
#endif
			GenReplArgs (arity-1,arity-1);

			if (function_called_only_curried_or_lazy_with_one_return)
				return;
			
			CallEvalArgsEntry (arity,function_state_p,0,ObjectSizes [function_state_p[-1].state_object],ea_lab);

#if SHARE_UPDATE_CODE
# if 1
			result=get_label_number_from_result_state_database (&function_state_p[-1],2,&label_number);
# else
			result=get_label_number_from_result_state_database (type,2,&label_number);
# endif
			if (result==2){
				LabDef update_label;

				MakeLabel (&update_label,"v",label_number,no_pref);
				GenStackLayoutOfState (DemStackDir,0,ObjectSizes [function_state_p[-1].state_object],function_state_p[-1]);
				GenJmp (&update_label);
			} else {
				if (result==1){
					LabDef update_label;

					MakeLabel (&update_label,"v",label_number,no_pref);
					GenOStackLayoutOfState (0,ObjectSizes [function_state_p[-1].state_object],function_state_p[-1]);
					GenLabelDefinition (&update_label);
				}
#endif

			BuildBasicFromB (function_state_p[-1].state_object,0);

			GenPopB (ObjectSizes [function_state_p[-1].state_object]);
			GenRtn (1,0,OnAState);
#if SHARE_UPDATE_CODE
			}
#endif
		} else if (function_state_p[-1].state_kind == StrictRedirection || function_state_p[-1].state_kind == LazyRedirection){
			GenReplArgs (arity-1, arity-1);
			if (!ea_label_follows)
				JmpEvalArgsEntry (arity,ea_lab);
		} else {
			GenPushArgs	(0, arity-1, arity-1);
			GenUpdateA	(arity, arity-1);	
			GenCreate	(-1);
			GenUpdateA	(0, arity+1);
			GenPopA		(1);
			if (!ea_label_follows)
				JmpEvalArgsEntry (arity+1,ea_lab);
		}
	} else {	
		int asize, bsize;
#if SHARE_UPDATE_CODE
		int result,label_number;
#endif
		GenReplArgs (arity-1, arity-1);

		if (function_called_only_curried_or_lazy_with_one_return)
			return;

		DetermineSizeOfState (function_state_p[-1], &asize, &bsize);
		CallEvalArgsEntry (arity,function_state_p,asize,bsize,ea_lab);

#if SHARE_UPDATE_CODE
# if 1
		result=get_label_number_from_result_state_database (&function_state_p[-1],2,&label_number);
# else
		result=get_label_number_from_result_state_database (type,2,&label_number);
# endif
		if (result==2){
			LabDef update_label;

			MakeLabel (&update_label,"v",label_number,no_pref);
			GenStackLayoutOfState (DemStackDir,asize,bsize,function_state_p[-1]);
			GenJmp (&update_label);
		} else {
			if (result==1){
				LabDef update_label;

				MakeLabel (&update_label,"v",label_number,no_pref);
				GenOStackLayoutOfState (asize,bsize,function_state_p[-1]);
				GenLabelDefinition (&update_label);
			}
#endif
		switch (function_state_p[-1].state_type){
			case TupleState:
				BuildTuple (asize, bsize, asize, bsize, function_state_p[-1].state_arity,
					function_state_p[-1].state_tuple_arguments,asize,bsize, asize,NormalFill,True);
				break;
			case RecordState:
				BuildRecord (function_state_p[-1].state_record_symbol,asize, bsize, asize, bsize,
							asize, bsize, asize, NormalFill,True);
				break;
			case ArrayState:
				GenBuildArray (0);
				break;
		}
#if UPDATE_POP
		GenUpdatePopA (0, asize);
#else
		GenUpdateA	(0, asize);
		GenPopA		(asize);
#endif
		GenPopB		(bsize);
		GenRtn		(1,0,OnAState);
#if SHARE_UPDATE_CODE
		}
#endif
	}
}

static void GenExternalLabel (int n_states,StateS *const function_state_p,int asp,int bsp,Label extlab)
{
	if (IsOnBStack (function_state_p[-1]) ||
		(IsSimpleState (function_state_p[-1]) && function_state_p[-1].state_kind==StrictRedirection))
		GenOStackLayoutOfStates (asp,bsp,n_states,function_state_p);
	else
		GenOStackLayoutOfStates (asp+1,bsp,n_states,function_state_p);
	GenLabelDefinition (extlab);
}

static void CoerceArgsFromExtToInt (int n_args,StateP ext_arg_state_p,StateP int_arg_state_p,int aindex,int bindex,
									int *asp_p,int *bsp_p,int *a_ind_p,int *b_ind_p)
{
	if (n_args>0){
		int asize, bsize;
	
		DetermineSizeOfState (*ext_arg_state_p,&asize,&bsize);
		
		CoerceArgsFromExtToInt (n_args-1,ext_arg_state_p+1,int_arg_state_p+1,aindex-asize, bindex-bsize,asp_p,bsp_p,a_ind_p,b_ind_p);
		
		CoerceArgumentUsingStackFrames (*int_arg_state_p,*ext_arg_state_p,aindex, bindex,asp_p,bsp_p,a_ind_p,b_ind_p,asize,bsize);
	}
}

/*
	When a function is exported to another module it may happen that
	the exported type differs from the type in the implementation module.
	This can be the case when one or more instances of abstract types
	are appearing in the exported type specification. In order to bring 
	the external calls into agreement with the inter call a special entry
	is generated.
*/

Bool ConvertExternalToInternalCall (int arity,StateS *const ext_function_state_p,StateS *const int_function_state_p,
									Bool skip_entry,int intasp,int intbsp,Label ealab,Label extlab,Bool root_node_needed)
{
	int arg_n,asp,bsp,asize,bsize,oldamax,oldbmax,a_ind,b_ind;
	Bool adjust_arg,adjust_result,all_args_lazy;
	
	adjust_arg = False;
	all_args_lazy = True;

	adjust_result =  ! EqualState (ext_function_state_p[-1],int_function_state_p[-1]);

	for (arg_n=0; arg_n<arity; ++arg_n){
		if (!IsLazyState (ext_function_state_p[arg_n]))
			all_args_lazy = False;

		if (!EqualState (ext_function_state_p[arg_n],int_function_state_p[arg_n]))
			adjust_arg = True;
	}

	asp=0;
	bsp=0;
	asize=0;
	bsize=0;
	a_ind=0;
	b_ind=0;

	if (! (adjust_arg || adjust_result))
		return True;

	if (all_args_lazy){
		if (adjust_result){
			if (skip_entry)
				JmpEvalArgsEntry (root_node_needed ? arity+1 : arity, ealab);
			
			if (DoTimeProfiling)
				GenPD();
			
			GenExternalLabel (arity,ext_function_state_p,arity,0,extlab);
			
			DetermineSizeOfState (int_function_state_p[-1], &asize, &bsize);
			CallEvalArgsEntry (root_node_needed ? arity+1 : arity,int_function_state_p,asize,bsize,ealab);
			RedirectResultAndReturn (asize,bsize,asize,bsize,int_function_state_p[-1],ext_function_state_p[-1],asize,bsize);
			return False;
		} else {
			GenExternalLabel (arity,ext_function_state_p,arity,0,extlab);
			
			if (DoTimeProfiling){
				GenPD();
				JmpEvalArgsEntry (root_node_needed ? arity+1 : arity,ealab);				
			}
			
			return False;
		}
	} else {
		if (skip_entry)
			JmpEvalArgsEntry (root_node_needed ? arity+1 : arity, ealab);

		if (adjust_arg){
			int maxasize;

			maxasize=0;
			
			for (arg_n=0; arg_n<arity; ++arg_n){
				AddSizeOfState (ext_function_state_p[arg_n],&asp,&bsp);
				AddStateSizeAndMaxFrameSize (int_function_state_p[arg_n],&maxasize,&asize,&bsize);
			}
/*			
			if (adjust_result && DoTimeProfiling)
				GenPD();
*/			
 			GenExternalLabel (arity,ext_function_state_p,asp,bsp,extlab);
			InitStackConversions (asp+maxasize+1, bsp+bsize+1, &oldamax, &oldbmax);
			
			CoerceArgsFromExtToInt (arity,ext_function_state_p,int_function_state_p,asp,bsp,&asp,&bsp,&a_ind,&b_ind);
			
			GenAStackConversions (asp,a_ind);
			GenBStackConversions (bsp,b_ind);

			ExitStackConversions (oldamax, oldbmax);
		} else {
/*
			if (adjust_result && DoTimeProfiling)
				GenPD();
*/
			GenExternalLabel (arity,ext_function_state_p,intasp,intbsp,extlab);
		}
		/* now we call the internal strict entry */
		
		GenDStackLayoutOfStates (root_node_needed ? intasp+1 : intasp,intbsp,arity,int_function_state_p);

		if (adjust_result){
			GenJsr (&CurrentAltLabel);
			
			DetermineSizeOfState (int_function_state_p[-1], &asize, &bsize);
			GenOStackLayoutOfState (asize, bsize, int_function_state_p[-1]);
			RedirectResultAndReturn (asize,bsize,asize,bsize,int_function_state_p[-1],ext_function_state_p[-1],asize,bsize);
		} else {
			if (DoTimeProfiling)
				GenPT();
			GenJmp (&CurrentAltLabel);
		}

		return False;
	}
}

static char g_pref[] = "g";

static void GenerateCodeForLazyTupleSelectorEntry (int argnr)
{
	LabDef sellab,easellab,descriptor_label;

	BuildLazyTupleSelectorLabel	(&sellab, MaxNodeArity, argnr);
	GenSelectorDescriptor (&sellab,g_pref);

	easellab = sellab;
	easellab.lab_pref = ea_pref;

	descriptor_label=sellab;
	descriptor_label.lab_pref=d_pref;
	GenNodeEntryDirectiveForLabelWithoutSymbol (-1,&descriptor_label,&easellab);

	GenOAStackLayout (1);
	GenLabelDefinition	(&sellab);
	GenPushNode			(ReduceError, 1);
	GenJsrEval			(0);
	GenGetNodeArity		(0);
	GenPushArgNr		(argnr);
	GenPushArgB			(0);
	GenJsrEval			(0);
	GenFillFromA		(0, 2, ReleaseAndFill);
	GenPopA				(2);
	GenRtn 				(1,0,OnAState);

	GenOAStackLayout (1);
	sellab.lab_pref = g_pref;
	GenLabelDefinition	(&sellab);
	GenGetNodeArity		(0);
	GenPushArgNr		(argnr);
	GenPushArgB			(0);
#if UPDATE_POP
	GenUpdatePopA		(0, 1);
#else
	GenUpdateA			(0, 1);
	GenPopA				(1);
#endif
	GenRtn 				(1,0,OnAState);
	
	GenOAStackLayout (2);
	GenLabelDefinition	(&easellab);
	GenPushArg			(0,1,1);
	GenPushA			(2);
	GenKeep (1,0);
	GenFill (& ind_lab, -2, &indirection_lab, 2, PartialFill);
	GenKeep (1,0);
#if UPDATE_POP
	GenUpdatePopA		(0, 1);
#else
	GenUpdateA			(0, 1);
	GenPopA				(1);
#endif
	GenJsrEval			(0);
	GenGetNodeArity		(0);
	GenPushArgNr		(argnr);
	GenPushArgB			(0);
#if UPDATE_POP
	GenUpdatePopA		(0, 1);
#else
	GenUpdateA			(0, 1);
	GenPopA				(1);
#endif
	GenJmpEvalUpdate();
}

void GenerateCodeForLazyTupleSelectorEntries (Bool *selectors)
{
	int i;

	for (i = NrOfGlobalSelectors; i < MaxNodeArity; i++)
		if (selectors[i - NrOfGlobalSelectors])
			GenerateCodeForLazyTupleSelectorEntry (i+1);
}

#define allocate_function_state(arity) (((StateP)(CompAlloc (sizeof(StateS)*((arity)+1))))+1)

#define UPDATE_NODE_IN_STRICT_ENTRY 0

static StateP create_function_state_for_update_function (StateS record_state,int n_arguments)
{
	StateP function_state_p;
	int arg_n;

	function_state_p = allocate_function_state (n_arguments);

	for (arg_n=0; arg_n<n_arguments; ++arg_n)
		function_state_p[arg_n]=LazyState;

#if UPDATE_NODE_IN_STRICT_ENTRY
	function_state_p[-1]=StrictState;
#else
	function_state_p[-1]=record_state;
#endif

	return function_state_p;
}

static StateP create_function_state_for_match_function (void)
{
	StateP function_state_p;

	function_state_p = allocate_function_state (1);

	function_state_p[0]=StrictState;	
	function_state_p[-1]=StrictState;
	
	return function_state_p;
}

int next_update_function_n,next_match_function_n;

ImpRuleP first_update_function,*update_function_p;

ImpRuleP create_simple_imp_rule (NodeP lhs_root,NodeP rhs_root,SymbDefP function_sdef)
{
	ImpRuleS *imp_rule;
	RuleAltS *rule_alt;

	rule_alt=CompAllocType (RuleAltS);
	rule_alt->alt_lhs_root=lhs_root;
	rule_alt->alt_lhs_defs=NULL;
	rule_alt->alt_rhs_root=rhs_root;
	rule_alt->alt_rhs_defs=NULL;
	rule_alt->alt_strict_node_ids=NULL;
	rule_alt->alt_next=NULL;
	rule_alt->alt_line=0;
	rule_alt->alt_kind=Contractum;

	imp_rule = CompAllocType (ImpRuleS);
	imp_rule->rule_alts = rule_alt;
	imp_rule->rule_root = lhs_root;
	imp_rule->rule_mark = 0;
	imp_rule->rule_line = 0;
	imp_rule->rule_type = NULL;

	function_sdef->sdef_rule=imp_rule;

	return imp_rule;
}

SymbDef CreateUpdateFunction (ArgS *record_arg,ArgS *first_field_arg,Node node
#if UNBOX_UPDATE_FUNCTION_ARGUMENTS
	,int unbox_record
#endif
	)
{
	static char update_function_name[16];
	SymbDef update_function_sdef;
	Ident update_function_ident;
	Symbol update_function_symbol;
	ArgS *previous_arg,*arg;
	Node lhs_root,rhs_root;
	int n_arguments;
	ImpRuleS *update_imp_rule;
	StateS record_state;

	sprintf (update_function_name,"_upd%d",next_update_function_n);
	++next_update_function_n;
	
	n_arguments=node->node_arity;
	record_state=node->node_symbol->symb_def->sdef_record_state;
#if UNBOX_UPDATE_FUNCTION_ARGUMENTS
	if (unbox_record)
		n_arguments=record_state.state_arity;
#endif

	update_function_ident=PutStringInHashTable (update_function_name,SymbolIdTable);
	update_function_sdef=MakeNewSymbolDefinition (CurrentModule,update_function_ident,n_arguments,IMPRULE);

	update_function_sdef->sdef_number=next_def_number++;
	update_function_sdef->sdef_isused=True;
	update_function_sdef->sdef_mark |= SDEF_USED_LAZILY_MASK;

#if UPDATE_NODE_IN_STRICT_ENTRY
	update_function_sdef->sdef_returnsnode=True;
	update_function_sdef->sdef_calledwithrootnode=True;
#else
	update_function_sdef->sdef_returnsnode=False;
	update_function_sdef->sdef_calledwithrootnode=False;
#endif

	update_function_symbol=NewSymbol (definition);
	update_function_symbol->symb_def=update_function_sdef;

#if UNBOX_UPDATE_FUNCTION_ARGUMENTS
	if (unbox_record){
		ArgS **lhs_new_fields_arg_p,**lhs_old_fields_arg_p,*lhs_new_fields_p,**rhs_arg_p;
		int field_number;
		
		lhs_root=NewNode (update_function_symbol,NULL,n_arguments);
# if UPDATE_NODE_IN_STRICT_ENTRY
		lhs_root->node_state=StrictState;
# else
		lhs_root->node_state=record_state;
# endif

		rhs_root=NewNode (node->node_symbol,NULL,n_arguments);
# if UPDATE_NODE_IN_STRICT_ENTRY
		rhs_root->node_state=StrictState;
# else
		rhs_root->node_state=record_state;
# endif
		rhs_root->node_number=0;

		lhs_old_fields_arg_p=&lhs_root->node_arguments;
		lhs_new_fields_arg_p=&lhs_new_fields_p;
		rhs_arg_p=&rhs_root->node_arguments;
		
		for (field_number=0; field_number<n_arguments; ++field_number){
			ArgS *rhs_arg,*lhs_arg;
			NodeId arg_node_id;
			StateS *state_p;

			state_p=&record_state.state_record_arguments [field_number];

			arg_node_id=NewNodeId (NULL);
			arg_node_id->nid_refcount=-2;
			
			lhs_arg=NewArgument (NewNodeIdNode (arg_node_id));
			lhs_arg->arg_state=LazyState;
			
			rhs_arg=NewArgument (NewNodeIdNode (arg_node_id));
			rhs_arg->arg_state=*state_p;

			*rhs_arg_p=rhs_arg;			
			rhs_arg_p=&rhs_arg->arg_next;

			if (first_field_arg==NULL || first_field_arg->arg_node->node_symbol->symb_def->sdef_sel_field_number!=field_number){
				*lhs_old_fields_arg_p=lhs_arg;
				lhs_old_fields_arg_p=&lhs_arg->arg_next;
			
				lhs_arg->arg_state=*state_p;
			} else {
				*lhs_new_fields_arg_p=lhs_arg;
				lhs_new_fields_arg_p=&lhs_arg->arg_next;

				first_field_arg=first_field_arg->arg_next;
			}
		}
		*lhs_old_fields_arg_p=lhs_new_fields_p;
		*lhs_new_fields_arg_p=NULL;
		*rhs_arg_p=NULL;
	} else
#endif
	{
		NodeId record_node_id;
		ArgS *lhs_record_arg,*rhs_record_arg,**lhs_arg_p,**rhs_arg_p;
		
		record_node_id=NewNodeId (NULL);
		record_node_id->nid_refcount=-1;
		
		lhs_record_arg=NewArgument (NewNodeIdNode (record_node_id));
		lhs_record_arg->arg_state=LazyState;
		rhs_record_arg=NewArgument (NewNodeIdNode (record_node_id));
		rhs_record_arg->arg_state=record_state;

		lhs_root=NewNode (update_function_symbol,lhs_record_arg,n_arguments);
#if UPDATE_NODE_IN_STRICT_ENTRY
		lhs_root->node_state=StrictState;
#else
		lhs_root->node_state=record_state;
#endif

		rhs_root=NewUpdateNode (node->node_symbol,rhs_record_arg,n_arguments);
#if UPDATE_NODE_IN_STRICT_ENTRY
		rhs_root->node_state=StrictState;
#else
		rhs_root->node_state=record_state;
#endif
		rhs_root->node_number=0;

		lhs_arg_p=&lhs_record_arg->arg_next;
		rhs_arg_p=&rhs_record_arg->arg_next;
		
		previous_arg=record_arg;
		for_l (arg,first_field_arg,arg_next){
			ArgS *rhs_arg,*lhs_arg,*field_value_arg;
			NodeId arg_node_id;
			int field_number;
			Node field_node;
			StateS *state_p;

			field_node=arg->arg_node;
			field_number=field_node->node_symbol->symb_def->sdef_sel_field_number;

			arg_node_id=NewNodeId (NULL);
			arg_node_id->nid_refcount=-2;
			
			lhs_arg=NewArgument (NewNodeIdNode (arg_node_id));
			lhs_arg->arg_state=LazyState;
			field_value_arg=NewArgument (NewNodeIdNode (arg_node_id));
			state_p=&record_state.state_record_arguments [field_number];
			field_value_arg->arg_state=*state_p;

			rhs_arg=NewArgument (NewSelectorNode (field_node->node_symbol,field_value_arg,1));
			rhs_arg->arg_state=*state_p;
			
			*lhs_arg_p=lhs_arg;
			*rhs_arg_p=rhs_arg;
			
			lhs_arg_p=&lhs_arg->arg_next;
			rhs_arg_p=&rhs_arg->arg_next;
#if !UNBOX_UPDATE_FUNCTION_ARGUMENTS
			field_node->node_arguments->arg_next=NULL;
			previous_arg->arg_next=arg;
#endif
			previous_arg=arg;
		}
#if !UNBOX_UPDATE_FUNCTION_ARGUMENTS
		previous_arg->arg_next=NULL;
#endif	
		*lhs_arg_p=NULL;
		*rhs_arg_p=NULL;
	}

	update_imp_rule=create_simple_imp_rule (lhs_root,rhs_root,update_function_sdef);

	update_imp_rule->rule_state_p = create_function_state_for_update_function (record_state,n_arguments);

	*update_function_p=update_imp_rule;
	update_function_p=&update_imp_rule->rule_next;
	
	return update_function_sdef;
}

#define R4(r,f1,f2,f3,f4) (r).f1;(r).f2;(r).f3;(r).f4
#define U5(r,f1,f2,f3,f4,f5) (r)->f1;(r)->f2;(r)->f3;(r)->f4;(r)->f5

SymbDef create_select_function (Symbol selector_symbol,int selector_kind)
{
	static char select_function_name[16];
	SymbDef select_function_sdef;
	Ident select_function_ident;
	Symbol select_function_symbol;
	NodeP lhs_root,rhs_root;
	ImpRuleS *update_imp_rule;
	SymbDef selector_sdef;
	ArgP lhs_record_arg,rhs_record_arg;
	NodeIdP record_node_id;
	StateP tuple_state_arguments,function_state_p,record_state_p,arg_state_p;
	StateS selector_arg_state;
	int fieldnr;

	selector_sdef=selector_symbol->symb_def;
	
	sprintf (select_function_name,"_sel%d",next_update_function_n);
	++next_update_function_n;
		
	select_function_ident=PutStringInHashTable (select_function_name,SymbolIdTable);
	select_function_sdef=MakeNewSymbolDefinition (CurrentModule,select_function_ident,1,IMPRULE);

	U5 (select_function_sdef,	sdef_number=next_def_number++,
								sdef_isused=True,
								sdef_mark |= SDEF_USED_LAZILY_MASK,
								sdef_returnsnode=False,
								sdef_calledwithrootnode=False);
	
	select_function_symbol=NewSymbol (definition);
	select_function_symbol->symb_def=select_function_sdef;

	record_state_p=&selector_sdef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state;
	fieldnr = selector_sdef->sdef_sel_field_number;
	
	record_node_id=NewNodeId (NULL);
	record_node_id->nid_refcount=-2;

	tuple_state_arguments=CompAllocArray (2,StateS);
	tuple_state_arguments[0]=record_state_p->state_record_arguments[fieldnr];
	if (selector_kind<SELECTOR_L){
		tuple_state_arguments[1]=*record_state_p;
		arg_state_p=record_state_p;
	} else {
		StateP selector_arg_tuple_args;
		
		tuple_state_arguments[1]=StrictState;

		selector_arg_tuple_args=CompAllocArray (2,StateS);
		selector_arg_tuple_args[0]=*record_state_p;
		selector_arg_tuple_args[1]=StrictState;
		
		selector_arg_state.state_type=TupleState;
		selector_arg_state.state_arity=2;
		selector_arg_state.state_mark=0;
		selector_arg_state.state_tuple_arguments=selector_arg_tuple_args;
		arg_state_p=&selector_arg_state;
	}
	
	lhs_record_arg=NewArgument (NewNodeIdNode (record_node_id));
	lhs_record_arg->arg_state=*arg_state_p;

	lhs_root=NewNode (select_function_symbol,lhs_record_arg,1);
	R4 (lhs_root->node_state,	state_type=TupleState,
								state_arity=2,
								state_mark=0,
								state_tuple_arguments=tuple_state_arguments);

	rhs_record_arg=NewArgument (NewNodeIdNode (record_node_id));
	rhs_record_arg->arg_state=*arg_state_p;

	rhs_root=NewSelectorNode (selector_symbol,rhs_record_arg,selector_kind);
	
	R4 (rhs_root->node_state,	state_type=TupleState,
								state_arity=2,
								state_mark=0,
								state_tuple_arguments=tuple_state_arguments);
			
	rhs_root->node_number=0;

	update_imp_rule=create_simple_imp_rule (lhs_root,rhs_root,select_function_sdef);

	function_state_p = allocate_function_state (1);
	function_state_p[0]=*arg_state_p;

	R4 (function_state_p[-1],	state_type=TupleState,
								state_arity=2,
								state_mark=0,
								state_tuple_arguments=tuple_state_arguments);

	update_imp_rule->rule_state_p=function_state_p;

	*update_function_p=update_imp_rule;
	update_function_p=&update_imp_rule->rule_next;
	
	return select_function_sdef;
}

static SymbDef create_match_function_sdef (void)
{
	char match_function_name[16];
	Ident match_function_ident;
	SymbDef match_function_sdef;

	sprintf (match_function_name,"_match%d",next_match_function_n);
	++next_match_function_n;

	match_function_ident=PutStringInHashTable (match_function_name,SymbolIdTable);
	match_function_sdef=MakeNewSymbolDefinition (CurrentModule,match_function_ident,1,IMPRULE);

	U5 (match_function_sdef,	sdef_number=next_def_number++,
								sdef_isused=True,
								sdef_mark |= SDEF_USED_LAZILY_MASK,
								sdef_returnsnode=True,
								sdef_calledwithrootnode=True);

	return match_function_sdef;
}

SymbDef create_match_function (SymbolP constructor_symbol,int constructor_arity,int strict_constructor)
{
	SymbDef match_function_sdef;
	Symbol match_function_symbol;
	struct arg *lhs_function_arg,**lhs_arg_p;
	int n;
	struct node *lhs_root,*rhs_root,*constructor_node;
	ImpRuleS *match_imp_rule;

	match_function_sdef=create_match_function_sdef();

	match_function_symbol=NewSymbol (definition);
	match_function_symbol->symb_def=match_function_sdef;

	constructor_node=NewNode (constructor_symbol,NULL,constructor_arity);

	lhs_arg_p=&constructor_node->node_arguments;
	
	for (n=0; n<constructor_arity; ++n){
		struct arg *lhs_arg;
		struct node_id *arg_node_id;

		arg_node_id=NewNodeId (NULL);
		arg_node_id->nid_refcount=-1;
		
		lhs_arg=NewArgument (NewNodeIdNode (arg_node_id));
		lhs_arg->arg_state=LazyState;
					
		*lhs_arg_p=lhs_arg;
		lhs_arg_p=&lhs_arg->arg_next;
	}

	*lhs_arg_p=NULL;

	if (strict_constructor){
		struct arg **rhs_arg_p,*lhs_arg;
		StateP constructor_arg_state_p;
#if STRICT_LISTS
		StateS head_and_tail_states[2];
#endif

		lhs_function_arg=NewArgument (constructor_node);
		lhs_function_arg->arg_state=StrictState;

		rhs_root=NewNode (TupleSymbol,NULL,constructor_arity);
		rhs_arg_p=&rhs_root->node_arguments;

#if STRICT_LISTS
		if (constructor_symbol->symb_kind==cons_symb && (constructor_symbol->symb_head_strictness>1 || constructor_symbol->symb_tail_strictness)){
			constructor_symbol->symb_def->sdef_constructor->cl_state_p;
			
			if (constructor_symbol->symb_head_strictness>1){
				if (constructor_symbol->symb_head_strictness==4)
					head_and_tail_states[0]=*constructor_symbol->symb_state_p;
				else
					head_and_tail_states[0]=StrictState;
			} else
				head_and_tail_states[0]=LazyState;
			
			if (constructor_symbol->symb_tail_strictness)
				head_and_tail_states[1]=StrictState;
			else
				head_and_tail_states[1]=LazyState;
			
			constructor_arg_state_p=head_and_tail_states;
		} else
#endif
		constructor_arg_state_p=constructor_symbol->symb_def->sdef_constructor->cl_state_p;

		for_l (lhs_arg,constructor_node->node_arguments,arg_next){
			struct arg *rhs_arg;
			struct node_id *node_id;

			node_id=lhs_arg->arg_node->node_node_id;
			--node_id->nid_refcount;

			rhs_arg=NewArgument (NewNodeIdNode (node_id));
			rhs_arg->arg_state=LazyState;

			*rhs_arg_p=rhs_arg;
			rhs_arg_p=&rhs_arg->arg_next;

			lhs_arg->arg_state=*constructor_arg_state_p++;
		}

		*rhs_arg_p=NULL;		
	} else {
		struct node_id *constructor_node_node_id;

		constructor_node_node_id=NewNodeId (NULL);
		constructor_node_node_id->nid_refcount=-2;

		constructor_node_node_id->nid_node=constructor_node;
	
		lhs_function_arg=NewArgument (NewNodeIdNode (constructor_node_node_id));
		lhs_function_arg->arg_state=StrictState;

		rhs_root=NewNodeIdNode (constructor_node_node_id);
	}

	lhs_root=NewNode (match_function_symbol,lhs_function_arg,1);
	lhs_root->node_state=StrictState;

	rhs_root->node_state=StrictState;
	rhs_root->node_number=0;
	
	match_imp_rule=create_simple_imp_rule (lhs_root,rhs_root,match_function_sdef);

	match_imp_rule->rule_state_p = create_function_state_for_match_function();

	*update_function_p=match_imp_rule;
	update_function_p=&match_imp_rule->rule_next;
	
	return match_function_sdef;
}

SymbDef create_select_and_match_function (SymbolP constructor_symbol,int strict_constructor)
{
	SymbDef match_function_sdef;
	Symbol match_function_symbol;
	ArgP lhs_function_arg,lhs_arg;
	NodeP lhs_root,rhs_root,constructor_node;
	NodeIdP node_id;
	ImpRuleS *match_imp_rule;

	match_function_sdef=create_match_function_sdef();

	match_function_symbol=NewSymbol (definition);
	match_function_symbol->symb_def=match_function_sdef;

	node_id=NewNodeId (NULL);
	node_id->nid_refcount=-2;
	
	lhs_arg=NewArgument (NewNodeIdNode (node_id));
	constructor_node=NewNode (constructor_symbol,lhs_arg,1);

	if (strict_constructor)
		lhs_arg->arg_state=constructor_symbol->symb_def->sdef_constructor->cl_state_p[0];
	else
		lhs_arg->arg_state=LazyState;

	lhs_function_arg=NewArgument (constructor_node);
	lhs_function_arg->arg_state=StrictState;

	lhs_root=NewNode (match_function_symbol,lhs_function_arg,1);
	lhs_root->node_state=StrictState;

	rhs_root=NewNodeIdNode (node_id);
	rhs_root->node_state=StrictState;
	rhs_root->node_number=0;
	
	match_imp_rule=create_simple_imp_rule (lhs_root,rhs_root,match_function_sdef);

	match_imp_rule->rule_state_p = create_function_state_for_match_function();

	{
		TypeNode type_node;
		StateP lhs_type_root_state_p;
			
		type_node=constructor_symbol->symb_def->sdef_constructor->cl_constructor->type_node_arguments->type_arg_node;
		lhs_type_root_state_p=&match_imp_rule->rule_state_p[-1];
		if (!(type_node->type_node_is_var || type_node->type_node_symbol->symb_kind==apply_symb)
			&& !IsLazyState (constructor_symbol->symb_def->sdef_constructor->cl_state_p[0]))
		{
			*lhs_type_root_state_p=constructor_symbol->symb_def->sdef_constructor->cl_state_p[0];
		} else
			lhs_type_root_state_p->state_kind=StrictRedirection;
		lhs_root->node_state=*lhs_type_root_state_p;
		
		if (IsSimpleState (*lhs_type_root_state_p)){
			if (lhs_type_root_state_p->state_kind==OnA || lhs_type_root_state_p->state_kind==StrictOnA){
				match_function_sdef->sdef_calledwithrootnode = True;
				match_function_sdef->sdef_returnsnode = True;
			} else if (lhs_type_root_state_p->state_kind==StrictRedirection){
				match_function_sdef->sdef_calledwithrootnode = False;
				match_function_sdef->sdef_returnsnode = True;
			} else {
				match_function_sdef->sdef_calledwithrootnode = False;
				match_function_sdef->sdef_returnsnode = False;
			}
		} else {
			match_function_sdef->sdef_calledwithrootnode = False;
			match_function_sdef->sdef_returnsnode = False;
		}
	}

	*update_function_p=match_imp_rule;
	update_function_p=&match_imp_rule->rule_next;
		
	return match_function_sdef;
}

struct update {
	int a_from_offset;
	int a_to_offset;
	int a_size;
	int b_from_offset;
	int b_to_offset;
	int b_size;
};

#if BIND_UNBOXED_LHS_TUPLE_AND_RECORD_ARGUMENTS_IN_BIND_ARGUMENTS /* added 9-4-1999 */
void bind_tuple_and_record_arguments (ArgP arguments,NodeId tuple_node_id,int a_offset,int b_offset,
									  NodeIdListElementS ***a_node_ids_h,NodeIdListElementS ***b_node_ids_h)
{
	NodeIdListElementS **a_node_ids_p,**b_node_ids_p;
	ArgP arg_p;
	
	a_node_ids_p=*a_node_ids_h;
	b_node_ids_p=*b_node_ids_h;
	
	for_l (arg_p,arguments,arg_next){
		if (arg_p->arg_node->node_kind==NodeIdNode){
			struct node_id *node_id;
			
			node_id=arg_p->arg_node->node_node_id;

			if (tuple_node_id!=NULL){
				node_id->nid_mark |= NID_STRICT_LHS_TUPLE_ELEMENT_MASK;
				node_id->nid_lhs_tuple_node_id_=tuple_node_id;
			}

			node_id->nid_a_index_ = a_offset;
 			node_id->nid_b_index_ = b_offset;

#ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
			node_id->nid_mark2 |= NID_LHS_PUSHED;
			node_id->nid_state = *node_id->nid_lhs_state_p;
#endif 			
			if (IsSimpleState (arg_p->arg_state)){
				if (arg_p->arg_state.state_kind==OnB){
					struct node_id_list_element *new_p_node_id;
					
					new_p_node_id=CompAllocType (struct node_id_list_element);
					new_p_node_id->nidl_node_id=node_id;

					*b_node_ids_p=new_p_node_id;
					b_node_ids_p=&new_p_node_id->nidl_next;
				} else {
					struct node_id_list_element *new_p_node_id;
					
					new_p_node_id=CompAllocType (struct node_id_list_element);
					new_p_node_id->nidl_node_id=node_id;

					*a_node_ids_p=new_p_node_id;
					a_node_ids_p=&new_p_node_id->nidl_next;
				}
			} else {
				if (node_id->nid_node==NULL){
					int asize,bsize;

					DetermineSizeOfState (arg_p->arg_state, &asize, &bsize);
					
					if (asize!=0){
						struct node_id_list_element *new_p_node_id;
						
						new_p_node_id=CompAllocType (struct node_id_list_element);
						new_p_node_id->nidl_node_id=node_id;

						*a_node_ids_p=new_p_node_id;
						a_node_ids_p=&new_p_node_id->nidl_next;
					}
					
					if (bsize!=0){
						struct node_id_list_element *new_p_node_id;

						new_p_node_id=CompAllocType (struct node_id_list_element);
						new_p_node_id->nidl_node_id=node_id;

						*b_node_ids_p=new_p_node_id;
						b_node_ids_p=&new_p_node_id->nidl_next;
					}
				} else {
					NodeIdListElementS **a_node_ids_p_c,**b_node_ids_p_c;
						
					a_node_ids_p_c=a_node_ids_p;
					b_node_ids_p_c=b_node_ids_p;
					
					bind_tuple_and_record_arguments (node_id->nid_node->node_arguments,node_id,a_offset,b_offset,&a_node_ids_p_c,&b_node_ids_p_c);
					
					a_node_ids_p=a_node_ids_p_c;
					b_node_ids_p=b_node_ids_p_c;
				}
			}
 		}
		else if (!IsSimpleState (arg_p->arg_state)){
			NodeIdListElementS **a_node_ids_p_c,**b_node_ids_p_c;
			
			a_node_ids_p_c=a_node_ids_p;
			b_node_ids_p_c=b_node_ids_p;
			
			bind_tuple_and_record_arguments (arg_p->arg_node->node_arguments,tuple_node_id /* !!!, not NULL */,a_offset,b_offset,&a_node_ids_p_c,&b_node_ids_p_c);
			
			a_node_ids_p=a_node_ids_p_c;
			b_node_ids_p=b_node_ids_p_c;			
		}

		if (IsSimpleState (arg_p->arg_state)){
			if (arg_p->arg_state.state_kind==OnB)
				b_offset -= ObjectSizes [arg_p->arg_state.state_object];
			else
				a_offset -= SizeOfAStackElem;
		} else {
			int asize,bsize;

			DetermineSizeOfState (arg_p->arg_state, &asize, &bsize);
			a_offset -= asize;
			b_offset -= bsize;
		}
	}

	*a_node_ids_h=a_node_ids_p;
	*b_node_ids_h=b_node_ids_p;
}

#else
static void set_lhs_tuple_node_ids (ArgS *args,NodeId node_id)
{
	ArgS *arg;
	
	for_l (arg,args,arg_next){
		Node arg_node;
		
		arg_node=arg->arg_node;
		if (arg_node->node_kind==NodeIdNode){
			arg_node->node_node_id->nid_mark |= NID_STRICT_LHS_TUPLE_ELEMENT_MASK;
			arg_node->node_node_id->nid_lhs_tuple_node_id_=node_id;
		} else
			set_lhs_tuple_node_ids (arg_node->node_arguments,node_id);
	}
}
#endif

void bind_arguments (ArgP arguments,int a_offset,int b_offset,AbNodeIdsP ab_node_ids_p)
{
	NodeIdListElementS **a_node_ids_p,**b_node_ids_p,*a_node_ids,*b_node_ids;
	ArgP arg_p;

	a_node_ids=ab_node_ids_p->a_node_ids;
	b_node_ids=ab_node_ids_p->b_node_ids;
	
	a_node_ids_p=&ab_node_ids_p->a_node_ids;
	b_node_ids_p=&ab_node_ids_p->b_node_ids;

	for_l (arg_p,arguments,arg_next){
		if (arg_p->arg_node->node_kind==NodeIdNode){
			struct node_id *node_id;
			
			node_id=arg_p->arg_node->node_node_id;
#ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
			node_id->nid_mark2 |= NID_LHS_PUSHED;
			node_id->nid_state = *node_id->nid_lhs_state_p;
#endif
			node_id->nid_a_index_ = a_offset;
 			node_id->nid_b_index_ = b_offset;
 			
			if (IsSimpleState (arg_p->arg_state)){
				if (arg_p->arg_state.state_kind==OnB){
					struct node_id_list_element *new_p_node_id;
					
					new_p_node_id=CompAllocType (struct node_id_list_element);
					new_p_node_id->nidl_node_id=node_id;

					*b_node_ids_p=new_p_node_id;
					b_node_ids_p=&new_p_node_id->nidl_next;
				} else {
					struct node_id_list_element *new_p_node_id;
					
					new_p_node_id=CompAllocType (struct node_id_list_element);
					new_p_node_id->nidl_node_id=node_id;

					*a_node_ids_p=new_p_node_id;
					a_node_ids_p=&new_p_node_id->nidl_next;
				}
			} else {
				if (node_id->nid_node==NULL){
					int asize,bsize;

					DetermineSizeOfState (arg_p->arg_state, &asize, &bsize);
					
					if (asize!=0){
						struct node_id_list_element *new_p_node_id;
						
						new_p_node_id=CompAllocType (struct node_id_list_element);
						new_p_node_id->nidl_node_id=node_id;

						*a_node_ids_p=new_p_node_id;
						a_node_ids_p=&new_p_node_id->nidl_next;
					}
					
					if (bsize!=0){
						struct node_id_list_element *new_p_node_id;

						new_p_node_id=CompAllocType (struct node_id_list_element);
						new_p_node_id->nidl_node_id=node_id;

						*b_node_ids_p=new_p_node_id;
						b_node_ids_p=&new_p_node_id->nidl_next;
					}		
				} else
#if BIND_UNBOXED_LHS_TUPLE_AND_RECORD_ARGUMENTS_IN_BIND_ARGUMENTS /* added 9-4-1999 */
				{
					NodeIdListElementS **a_node_ids_p_c,**b_node_ids_p_c;
					
					a_node_ids_p_c=a_node_ids_p;
					b_node_ids_p_c=b_node_ids_p;
					
					bind_tuple_and_record_arguments (node_id->nid_node->node_arguments,node_id,a_offset,b_offset,&a_node_ids_p_c,&b_node_ids_p_c);
					
					a_node_ids_p=a_node_ids_p_c;
					b_node_ids_p=b_node_ids_p_c;
				}
#else
					set_lhs_tuple_node_ids (node_id->nid_node->node_arguments,node_id);
#endif
			}
 		}
#if BIND_UNBOXED_LHS_TUPLE_AND_RECORD_ARGUMENTS_IN_BIND_ARGUMENTS /* added 9-4-1999 */
		else if (!IsSimpleState (arg_p->arg_state)){
			NodeIdListElementS **a_node_ids_p_c,**b_node_ids_p_c;
			
			a_node_ids_p_c=a_node_ids_p;
			b_node_ids_p_c=b_node_ids_p;
			
			bind_tuple_and_record_arguments (arg_p->arg_node->node_arguments,NULL,a_offset,b_offset,&a_node_ids_p_c,&b_node_ids_p_c);
			
			a_node_ids_p=a_node_ids_p_c;
			b_node_ids_p=b_node_ids_p_c;			
		}
#endif

		if (IsSimpleState (arg_p->arg_state)){
			if (arg_p->arg_state.state_kind==OnB)
				b_offset -= ObjectSizes [arg_p->arg_state.state_object];
			else
				a_offset -= SizeOfAStackElem;
		} else {
			int asize,bsize;

			DetermineSizeOfState (arg_p->arg_state, &asize, &bsize);
			a_offset -= asize;
			b_offset -= bsize;
		}
	}

	*a_node_ids_p=a_node_ids;
	*b_node_ids_p=b_node_ids;
}

void ReduceArgumentToHnf (NodeIdP node_id,StateS state,int offset,SavedNidStateS **ifrule)
{
	if (IsSimpleState (state) && state.state_kind==OnA){
		GenJsrEval (offset);
		state.state_kind = StrictOnA;
		
		if (ifrule && node_id){
			save_node_id_state (node_id,ifrule);			
			node_id->nid_state_ = state;
		}
	}

	if (ifrule==NULL && node_id!=NULL)
		node_id->nid_state_=state;
}

static void MatchLhsNode (NodeP node,StateS demstate,int aindex,int bindex,int asp,int bsp,struct ab_node_ids *ab_node_ids_p);

void MatchArgs (Args args,int aindex,int bindex,int asp,int bsp,struct ab_node_ids *ab_node_ids_p)
{
	for (; args; args=args->arg_next){
		Node arg_node;
		int asize, bsize;

		arg_node=args->arg_node;
		
		if (arg_node->node_kind!=NodeIdNode){
			ReduceArgumentToHnf (NULL,args->arg_state,asp-aindex,NULL);
			MatchLhsNode (arg_node,args->arg_state,aindex,bindex,asp,bsp,ab_node_ids_p);
		} else {
			NodeId node_id;
			
			node_id=arg_node->node_node_id;
			arg_node=node_id->nid_node;

#ifndef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
			if (arg_node!=NULL){
				ReduceArgumentToHnf (node_id,args->arg_state,asp-aindex,NULL);
				MatchLhsNode (arg_node,args->arg_state,aindex,bindex,asp,bsp,ab_node_ids_p);				
			} else
#endif
			{
				node_id->nid_state_=args->arg_state;
			}
		}
		
		DetermineSizeOfState (args->arg_state,&asize,&bsize);
		aindex -= asize;
		bindex -= bsize;
	}
}

static void MatchLhsNode (NodeP node,StateS demstate,int aindex,int bindex,int asp,int bsp,struct ab_node_ids *ab_node_ids_p)
{
	Symbol symb;
	
	symb = node->node_symbol;
	
	switch (symb->symb_kind){
		case tuple_symb:
			if (!IsSimpleState (demstate)){
#if !BIND_UNBOXED_LHS_TUPLE_AND_RECORD_ARGUMENTS_IN_BIND_ARGUMENTS
				bind_arguments (node->node_arguments,aindex,bindex,ab_node_ids_p);
#endif
				MatchArgs (node->node_arguments,aindex,bindex,asp,bsp,ab_node_ids_p);
				return;
			}
			break;
		case definition:
		{
			SymbDef def;
			
			def = symb->symb_def;
			if (def->sdef_kind==RECORDTYPE){
				if (demstate.state_type==RecordState){
#if !BIND_UNBOXED_LHS_TUPLE_AND_RECORD_ARGUMENTS_IN_BIND_ARGUMENTS
					bind_arguments (node->node_arguments,aindex,bindex,ab_node_ids_p);
#endif
					MatchArgs (node->node_arguments,aindex,bindex,asp,bsp,ab_node_ids_p);
					return;
				}
			}
		}
	}
	error_in_function ("MatchLhsNode");
}

/*
	static void BindArgs (Args args,int ara,int arb)
	{
		for (; args; args = args->arg_next){
			if (IsSimpleState (args->arg_state)){
				if (args->arg_state.state_kind==OnB){
		 			if (args->arg_node->node_kind==NodeIdNode)
			 			args->arg_node->node_node_id->nid_b_index = arb;
					arb -= ObjectSizes [args->arg_state.state_object];
				} else {
		 			if (args->arg_node->node_kind==NodeIdNode)
			 			args->arg_node->node_node_id->nid_a_index = ara;
					ara -= SizeOfAStackElem;
				}
			} else {
				int asize,bsize;

				if (args->arg_node->node_kind==NodeIdNode){
		 			args->arg_node->node_node_id->nid_a_index = ara;
		 			args->arg_node->node_node_id->nid_b_index = arb;
		 		}

				DetermineSizeOfState (args->arg_state, &asize, &bsize);
				ara -= asize;
				arb -= bsize;
			}
		}
	}
*/

static void jump_false_to_next_alternative (LabDef *esclabel,int remove_a,int remove_b)
{
	if (remove_a==0 && remove_b==0)
		GenJmpFalse (esclabel);
	else {
		LabDef to;

		MakeLabel (&to,m_symb,NewLabelNr++,no_pref);
		GenJmpTrue (&to);

		GenPopA (remove_a);
		GenPopB (remove_b);
		GenJmp (esclabel);
		GenLabelDefinition (&to);
	}
}

static void CheckSymbol (Label symblab,int arity,int stackpos,int remove_a,int remove_b,Label esclabel)
{
	GenEqDesc (symblab, arity, stackpos);

	jump_false_to_next_alternative (esclabel,remove_a,remove_b);
}

static void GenNoMatchOnApplies (void)
{
	GenDumpString ("Runtime Error: left-hand-side application encountered\\n");
	GenHalt ();
}

static void GenNoMatchOnIfs (void)
{
	GenDumpString ("Runtime Error: left-hand-side application of IF encountered\\n");
	GenHalt ();
}

#ifdef GENERATE_RECORD_STATES_DURING_MATCH
static void SetArgumentStates (Args args, States argstates)
{
	int i;

	for (i = 0; args ; args = args->arg_next, i++)
		args->arg_state = argstates [i];
}
#endif

void MatchError (int aselmts,int bselmts,SymbDef sdef,Bool root_node_needed,int string_already_generated)
{
	GenLabelDefinition (&CurrentAltLabel);

	CurrentAltLabel.lab_pref  = no_pref;
	CurrentAltLabel.lab_post  = 0;

	if (sdef->sdef_exported)
		CurrentAltLabel.lab_mod = CurrentModule;

	GenNoMatchError (sdef,root_node_needed ? aselmts+1 : aselmts,bselmts,string_already_generated);

	if (sdef->sdef_exported)
		CurrentAltLabel.lab_mod = NULL;
}

static char case_symb[] = "case";

static int generate_int_char_or_bool_match (struct arg *first_arg,int *matches_always_p)
{
	struct arg *arg;
	int case_number;

	case_number=0;
	for_l (arg,first_arg,arg_next){
		struct node *case_node;
		struct symbol *symbol;
		
		case_node=arg->arg_node;

		switch (case_node->node_kind){
			case CaseNode:
			{
				LabDef case_label;

				symbol=case_node->node_symbol;
				
				MakeLabel (&case_label,case_symb,NewLabelNr,no_pref);
				
				if (symbol->symb_kind < Nr_Of_Predef_Types){
					if (symbol->symb_kind==bool_denot && case_number==1){
						GenJmp (&case_label);
						*matches_always_p=1;
					} else {
						EqBasic	(BasicSymbolStates [symbol->symb_kind].state_object,symbol->symb_val,0);
						GenJmpTrue (&case_label);
					}
				} else
					error_in_function ("generate_int_char_or_bool_match");
				
				++NewLabelNr;
				break;
			}
			case DefaultNode:
				return 1;
			default:
				error_in_function ("generate_int_char_or_bool_match");
		}
		
		++case_number;
	}

	return 0;
}

static int generate_constructor_match (ArgP first_arg,int *matches_always_p)
{
	ArgP arg;
	int case_number;

	for (arg=first_arg,case_number=0; arg!=NULL; arg=arg->arg_next,++case_number){
		struct node *case_node;
		struct symbol *symbol;
		
		case_node=arg->arg_node;

		switch (case_node->node_kind){
			case DefaultNode:
				return 1;
			case CaseNode:
			{
				LabDef case_label;

				symbol=case_node->node_symbol;
				
				MakeLabel (&case_label,case_symb,NewLabelNr,no_pref);
				++NewLabelNr;

				if (symbol->symb_kind==definition){
					LabDef symbol_label;
					SymbDef sdef;

					sdef=symbol->symb_def;

					if (sdef->sdef_kind==CONSTRUCTOR && sdef->sdef_type->type_nr_of_constructors==case_number+1){
						GenJmp (&case_label);
						*matches_always_p=1;
					} else {
						if (sdef->sdef_kind==CONSTRUCTOR && sdef->sdef_strict_constructor && sdef->sdef_arity==case_node->node_arity){
							ConvertSymbolToKLabel (&symbol_label,sdef);
							GenEqD_b (&symbol_label,0);
						} else {
							ConvertSymbolToConstructorDLabel (&symbol_label,sdef);
							GenEqD_b (&symbol_label,case_node->node_arity);
						}
						GenJmpTrue (&case_label);
					}
					break;
				}
			}
			default:
				error_in_function ("generate_constructor_match");
		}
	}

	return 0;
}

#if 0
extern char *node_id_name (NodeId node_id);
#endif

#if FREE_STRICT_LHS_TUPLE_ELEMENTS
static void add_node_id_or_tuple_node_ids_to_list (NodeIdP node_id,NodeIdP push_node_id_p,NodeIdListElementS **free_node_ids_l)
{
	if (! (node_id->nid_node!=NULL && !IsSimpleState (node_id->nid_state))){
#if defined (TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS)
		if (!(node_id->nid_refcount<0 && (node_id->nid_mark2 & NID_LHS_PUSHED)==0))
#endif
		add_node_id_to_list (node_id,free_node_ids_l);
	} else {
		ArgP arg_p;
		
		for_l (arg_p,node_id->nid_node->node_arguments,arg_next){
			NodeP arg_node_p;
			
			arg_node_p=arg_p->arg_node;
			if (arg_node_p->node_kind==NodeIdNode){
				NodeIdP node_id_p;
				
				node_id_p=arg_node_p->node_node_id;
				if (node_id_p->nid_refcount==-1 && node_id!=push_node_id_p)
#if defined (TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS)
					if (!(node_id_p->nid_refcount<0 && (node_id_p->nid_mark2 & NID_LHS_PUSHED)==0))
#endif
					add_node_id_or_tuple_node_ids_to_list (node_id_p,push_node_id_p,free_node_ids_l);								
			}
		}
	}
}
#endif

#if BUILD_FREE_NODE_ID_LIST_DURING_PATTER_MATCH
void set_local_reference_counts_and_add_free_node_ids (NodeP case_node,NodeIdListElementS **free_node_ids_l)
{
	NodeIdRefCountListP node_id_ref_count_elem;
	NodeIdP push_node_id_p;

	if (case_node->node_arguments->arg_node->node_kind==PushNode)
		push_node_id_p=case_node->node_arguments->arg_node->node_arguments->arg_node->node_node_id;
	else
		push_node_id_p=NULL;

	for_l (node_id_ref_count_elem,case_node->node_node_id_ref_counts,nrcl_next){
		int local_ref_count;
		NodeIdP node_id;

		node_id=node_id_ref_count_elem->nrcl_node_id;
		local_ref_count=node_id_ref_count_elem->nrcl_ref_count;

# if 0
		printf ("global_to_local_ %s %d %d ",node_id_name (node_id),node_id->nid_refcount,node_id_ref_count_elem->nrcl_ref_count);
# endif

		if (local_ref_count==-1 && node_id!=push_node_id_p){
			if (unused_node_id_(node_id)){
#if FREE_STRICT_LHS_TUPLE_ELEMENTS
# if 0
				printf ("global_to_local__ %s %d %d %d ",node_id_name (node_id),node_id->nid_refcount,node_id_ref_count_elem->nrcl_ref_count,node_id->nid_a_index);
# endif

				add_node_id_or_tuple_node_ids_to_list (node_id,push_node_id_p,free_node_ids_l);
#else
				if (! (node_id->nid_node!=NULL && !IsSimpleState (node_id->nid_state)))
					add_node_id_to_list (node_id,free_node_ids_l);
#endif
			}
		}

		node_id_ref_count_elem->nrcl_ref_count=node_id->nid_refcount - local_ref_count;
		node_id->nid_refcount = local_ref_count;
	}

# if 0
	printf ("\n");
# endif
}
#endif

static int generate_code_for_switch_node (NodeP node,int asp,int bsp,struct esc *esc_p,StateP result_state_p,
										  SavedNidStateS **save_states_p,AbNodeIdsP ab_node_ids_p)
{
	int has_default,need_next_alternative,matches_always;
	unsigned int first_case_label_number,case_number;
	struct node_id *node_id;
	struct arg *arg,*first_arg;
	int a_index,b_index;
	struct esc esc,old_esc;
	int match_b_stack_top_element;
	LabDef esc_case_label;

	node_id=node->node_node_id;
	a_index=node_id->nid_a_index;
	b_index=node_id->nid_b_index;

#if 0
	ReduceArgumentToHnf (node_id,node->node_state,asp-a_index,save_states_p);
#else
	if (node_id->nid_state.state_type!=SimpleState || node_id->nid_state.state_kind==OnB){
		node->node_state=node_id->nid_state;
	} else
		ReduceArgumentToHnf (node_id,node->node_state,asp-a_index,save_states_p);
#endif
	
	first_case_label_number=NewLabelNr;

	esc=*esc_p;

	need_next_alternative=0;
	matches_always=0;
	has_default=0;

	first_arg=node->node_arguments;
	match_b_stack_top_element=0;

	if (first_arg->arg_node->node_kind==CaseNode && first_arg->arg_next!=NULL && first_arg->arg_next->arg_node->node_kind==CaseNode){
		if (node->node_state.state_type==SimpleState && (node->node_state.state_kind==OnA || node->node_state.state_kind==StrictOnA)){
			int first_case_symbol_kind;
			Symbol symbol;

			symbol=first_arg->arg_node->node_symbol;
			first_case_symbol_kind=symbol->symb_kind;

			if (first_case_symbol_kind==int_denot || first_case_symbol_kind==char_denot || first_case_symbol_kind==bool_denot){
				PushBasicFromAOnB (BasicSymbolStates [first_case_symbol_kind].state_object,asp-a_index);
				match_b_stack_top_element=1;
				
				has_default=generate_int_char_or_bool_match (first_arg,&matches_always);
			}
			else if (first_case_symbol_kind==definition){
				SymbDef sdef;

				sdef=symbol->symb_def;
				if (sdef->sdef_kind==CONSTRUCTOR){
					Symbol next_case_node_symbol;
					SymbDef next_sdef;

					next_case_node_symbol=first_arg->arg_next->arg_node->node_symbol;
				
					if (! (next_case_node_symbol->symb_kind==definition && (next_sdef=next_case_node_symbol->symb_def,
						next_sdef->sdef_kind==CONSTRUCTOR && next_sdef->sdef_type->type_nr_of_constructors==2)))
					{
						GenPushD_a (asp-a_index);
						match_b_stack_top_element=1;
					
						has_default=generate_constructor_match (first_arg,&matches_always);
					}
				}
			}
		}
	}

#if BUILD_FREE_NODE_ID_LIST_DURING_PATTER_MATCH
	++node_id->nid_refcount;

	for_l (arg,node->node_arguments,arg_next){
		NodeIdRefCountListP *node_id_ref_count_elem_h,node_id_ref_count_elem_p;
		struct node *case_node;

		case_node=arg->arg_node;
		
		node_id_ref_count_elem_h=&case_node->node_node_id_ref_counts;

		while ((node_id_ref_count_elem_p=*node_id_ref_count_elem_h)!=NULL){
			if (node_id_ref_count_elem_p->nrcl_node_id->nid_refcount==-1 && node_id_ref_count_elem_p->nrcl_ref_count==-1)
				*node_id_ref_count_elem_h=node_id_ref_count_elem_p->nrcl_next;
			else
			 	node_id_ref_count_elem_h=&node_id_ref_count_elem_p->nrcl_next;
		 }
	}

	--node_id->nid_refcount;
#endif

	if (!match_b_stack_top_element)
		for (arg=first_arg,case_number=0; arg!=NULL; arg=arg->arg_next,++case_number){
			struct node *case_node;
			struct symbol *symbol;
			
			case_node=arg->arg_node;
	
			switch (case_node->node_kind){
				case CaseNode:
				{
					LabDef case_label;
	
					symbol=case_node->node_symbol;
					
					MakeLabel (&case_label,case_symb,NewLabelNr,no_pref);
					
					switch (symbol->symb_kind){
						case definition:
						{
							LabDef symbol_label;
							SymbDef sdef;
	
							sdef=symbol->symb_def;
							if (sdef->sdef_kind==RECORDTYPE || (sdef->sdef_kind==CONSTRUCTOR 
								&& sdef->sdef_type->type_nr_of_constructors==case_number+1))
							{
								if (case_number==0 && arg->arg_next==NULL){
									SavedNidStateP saved_node_id_states;
									int need_next_alternative;
	
									saved_node_id_states=NULL;
								
									++node_id->nid_refcount;
#if BUILD_FREE_NODE_ID_LIST_DURING_PATTER_MATCH
									{
									NodeIdListElementP old_free_node_ids;
									
									old_free_node_ids=ab_node_ids_p->free_node_ids;
									set_local_reference_counts_and_add_free_node_ids (case_node,&ab_node_ids_p->free_node_ids);
#else
 									set_local_reference_counts (case_node);
#endif
									need_next_alternative=
										generate_code_for_root_node
											(case_node->node_arguments->arg_node,asp,bsp,&esc,
											case_node->node_node_defs,result_state_p,&saved_node_id_states ,ab_node_ids_p);
								
									set_global_reference_counts (case_node);
#if BUILD_FREE_NODE_ID_LIST_DURING_PATTER_MATCH
									ab_node_ids_p->free_node_ids=old_free_node_ids;
									}
#endif								

									--node_id->nid_refcount;

									restore_saved_node_id_states (saved_node_id_states);
									return need_next_alternative;
								}
								
								GenJmp (&case_label);
								matches_always=1;
							} else {	
								if (sdef->sdef_kind==CONSTRUCTOR && sdef->sdef_strict_constructor
									&& sdef->sdef_arity==case_node->node_arity)
								{
									ConvertSymbolToKLabel (&symbol_label,sdef);
									GenEqDesc (&symbol_label,0,asp-a_index);
								} else {
									ConvertSymbolToConstructorDLabel (&symbol_label,sdef);
									GenEqDesc (&symbol_label,case_node->node_arity,asp-a_index);
								}
								GenJmpTrue (&case_label);
							}
							break;
						}
						case cons_symb:
							if (case_number==1){
								GenJmp (&case_label);
								matches_always=1;
							} else {
#if STRICT_LISTS
								if (symbol->symb_head_strictness==1 || symbol->symb_head_strictness>=3){
									GenEqDesc (&nil_lab,0,asp-a_index);
									GenJmpFalse (&case_label);
								} else
#endif
								{
									GenEqDesc (&cons_lab,case_node->node_arity,asp-a_index);
									GenJmpTrue (&case_label);
								}
							}
							break;
						case nil_symb:
							if (case_number==1){
								GenJmp (&case_label);
								matches_always=1;
							} else {
								GenEqDesc (&nil_lab,case_node->node_arity,asp-a_index);
								GenJmpTrue (&case_label);
							}
							break;
						case tuple_symb:
							if (case_number==0 && arg->arg_next==NULL){
								SavedNidStateP saved_node_id_states;
								int need_next_alternative;
	
								saved_node_id_states=NULL;
	
								++node_id->nid_refcount;
#if BUILD_FREE_NODE_ID_LIST_DURING_PATTER_MATCH
								{
								NodeIdListElementP old_free_node_ids;
								
								old_free_node_ids=ab_node_ids_p->free_node_ids;
								set_local_reference_counts_and_add_free_node_ids (case_node,&ab_node_ids_p->free_node_ids);
#else
								set_local_reference_counts (case_node);
#endif

								need_next_alternative=
									generate_code_for_root_node
										(case_node->node_arguments->arg_node,asp,bsp,&esc,
										case_node->node_node_defs,result_state_p,&saved_node_id_states ,ab_node_ids_p);
	
								set_global_reference_counts (case_node);
#if BUILD_FREE_NODE_ID_LIST_DURING_PATTER_MATCH
								ab_node_ids_p->free_node_ids=old_free_node_ids;
								}
#endif	
								--node_id->nid_refcount;

								restore_saved_node_id_states (saved_node_id_states);
								return need_next_alternative;
							}
#if defined (TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS)
							if (!(arg->arg_next->arg_node->node_kind==DefaultNode))
#endif
							GenJmp (&case_label);
							matches_always=1;
							break;
						case apply_symb:
						case if_symb:
							error_in_function ("generate_code_for_switch_node");
							return 0;
						case string_denot:
							if (IsSimpleState (node->node_state)){
								GenPushArray (asp-a_index);
								IsString (symbol->symb_val);
							} else {
								GenPushA (asp-a_index);
								IsString (symbol->symb_val);
							}
							GenJmpTrue (&case_label);
							break;
						default:
							if (symbol->symb_kind < Nr_Of_Predef_Types){
								ObjectKind denot_type;

								denot_type = BasicSymbolStates [symbol->symb_kind].state_object;

								if (node->node_state.state_object==denot_type){
									if (symbol->symb_kind==bool_denot && case_number==1){
										GenJmp (&case_label);
										matches_always=1;					
									} else {
										if (node->node_state.state_kind==OnB)									
											EqBasic	(denot_type,symbol->symb_val,bsp-b_index);
										else
											IsBasic	(denot_type,symbol->symb_val,asp-a_index);
						
										GenJmpTrue (&case_label);
									}
									break;
								} else if (node->node_state.state_object==UnknownObj
#if ABSTRACT_OBJECT
										|| node->node_state.state_object==AbstractObj
#endif
								){
									IsBasic	(denot_type,symbol->symb_val,asp-a_index);
									GenJmpTrue (&case_label);
								} else
									error_in_function ("generate_code_for_switch_node");
							} else
								error_in_function ("generate_code_for_switch_node");
					}
					
					++NewLabelNr;
					break;
				}
				case DefaultNode:
					has_default=1;
					break;
				default:
					error_in_function ("generate_code_for_switch_node");
			}
		}

	if (has_default){
		MakeLabel (&esc_case_label,case_symb,NewLabelNr,no_pref);
		++NewLabelNr;

		if (!matches_always){
			if (match_b_stack_top_element)
				GenPopB (1);
			GenJmp (&esc_case_label);
		}

		old_esc=esc;

		esc.esc_asp=asp;
		esc.esc_bsp=bsp;
		esc.esc_label=&esc_case_label;
	} else
	if (/* !has_default && */ !matches_always){
		int n_pop_a;

		need_next_alternative=1;
		
		n_pop_a=asp-esc.esc_asp;

		if (n_pop_a>0)
			GenPopA (n_pop_a);
		else if (n_pop_a<0){
			int offset;
			
			GenBuildh (&nil_lab,0);
			
			offset=0;
			while (++n_pop_a!=0)
				GenPushA (offset++);
		}

		if (match_b_stack_top_element)
			GenPopB (bsp+1-esc.esc_bsp);
		else
			GenPopB (bsp-esc.esc_bsp);

		GenJmp (esc.esc_label);
	}

	for_l (arg,node->node_arguments,arg_next){
		struct node *case_node;
		LabDef case_label;
		SavedNidStateP saved_node_id_states;

		case_node=arg->arg_node;

		MakeLabel (&case_label,case_symb,first_case_label_number,no_pref);
		++first_case_label_number;

		GenLabelDefinition	(&case_label);

		saved_node_id_states=NULL;

		++node_id->nid_refcount;
#if BUILD_FREE_NODE_ID_LIST_DURING_PATTER_MATCH
		{
		NodeIdListElementP old_free_node_ids;
		
		old_free_node_ids=ab_node_ids_p->free_node_ids;
		set_local_reference_counts_and_add_free_node_ids (case_node,&ab_node_ids_p->free_node_ids);
#else
		set_local_reference_counts (case_node);
#endif

		if (case_node->node_kind==CaseNode){
			if (match_b_stack_top_element)
				GenPopB (1);

			if (generate_code_for_root_node
				(case_node->node_arguments->arg_node,asp,bsp,&esc,case_node->node_node_defs,
					result_state_p,&saved_node_id_states,ab_node_ids_p) && !has_default)
			{
				need_next_alternative=1;
			}
		} else {
			if (generate_code_for_root_node
				(case_node->node_arguments->arg_node,asp,bsp,&old_esc,case_node->node_node_defs,
					result_state_p,&saved_node_id_states,ab_node_ids_p))
			{
				need_next_alternative=1;
			}
		}

		set_global_reference_counts (case_node);
#if BUILD_FREE_NODE_ID_LIST_DURING_PATTER_MATCH
		ab_node_ids_p->free_node_ids=old_free_node_ids;
		}
#endif
		--node_id->nid_refcount;

		restore_saved_node_id_states (saved_node_id_states);
	}

	return need_next_alternative;
}

/* #define unused_node_id(node_id) ((node_id)->nid_refcount!=-1 ? (node_id)->nid_refcount==0 : unused_node_id_ (node_id)) */

int unused_node_id_ (NodeId node_id)
{
	if (!(node_id->nid_mark & NID_STRICT_LHS_TUPLE_ELEMENT_MASK))
		return True;

	node_id=node_id->nid_lhs_tuple_node_id;
	
	while (node_id->nid_refcount==-1){
		if (!(node_id->nid_mark & NID_STRICT_LHS_TUPLE_ELEMENT_MASK))
			return True;

		node_id=node_id->nid_lhs_tuple_node_id;		
	}

	return False;
}

#if STRICT_LISTS
static void repl_overloaded_cons_arguments (NodeP node_p,int *asp_p,int *bsp_p,SavedNidStateS **save_states_p,AbNodeIdsP ab_node_ids_p)
{
	CodeGenNodeIdsS code_gen_node_ids;
	LabDef apply_label;
	
	code_gen_node_ids.saved_nid_state_l=save_states_p;
	code_gen_node_ids.free_node_ids=ab_node_ids_p->free_node_ids;
	code_gen_node_ids.moved_node_ids_l=NULL;
	code_gen_node_ids.a_node_ids=ab_node_ids_p->a_node_ids;
	code_gen_node_ids.b_node_ids=ab_node_ids_p->b_node_ids;
	code_gen_node_ids.doesnt_fail=0;
	
	Build (node_p->node_decons_node,asp_p,bsp_p,&code_gen_node_ids);

	*asp_p -= 2;

	ab_node_ids_p->free_node_ids=code_gen_node_ids.free_node_ids;
	ab_node_ids_p->a_node_ids=code_gen_node_ids.a_node_ids;
	ab_node_ids_p->b_node_ids=code_gen_node_ids.b_node_ids;

	GenDAStackLayout (2);
	MakeSymbolLabel (&apply_label,ApplyDef->sdef_module,s_pref,ApplyDef, 0);
	GenJsr (&apply_label);
	GenOAStackLayout (1);

	GenReplArgs (2,2);	
}
#endif

static int generate_code_for_push_node (NodeP node,int asp,int bsp,struct esc *esc_p,NodeDefs defs,StateP result_state_p,
										SavedNidStateS **save_states_p,AbNodeIdsP ab_node_ids_p)
{
	NodeIdP node_id_p;
	struct node_id_list_element *arg_node_id_list;
	int a_index,b_index;
	struct arg *arguments;
	int a_size,b_size;
	int a_remove,b_remove;
	int source_a_index,source_b_index;
	int update_stack_size;
	struct ab_node_ids ab_node_ids;
	struct update updates[MaxNodeArity];
	
	ab_node_ids=*ab_node_ids_p;

	arguments=node->node_arguments;

	node_id_p=arguments->arg_node->node_node_id;

#if defined (TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS)
	if (!IsSimpleState (node_id_p->nid_state) && node_id_p->nid_refcount<0 && node_id_p->nid_node!=NULL){
		for_l (arg_node_id_list,node->node_node_ids,nidl_next){
			NodeIdP arg_node_id;
		
			arg_node_id=arg_node_id_list->nidl_node_id;
			arg_node_id->nid_mark2 |= NID_LHS_PUSHED;
			arg_node_id->nid_state = *arg_node_id->nid_lhs_state_p;
		}

		return generate_code_for_root_node (arguments->arg_next->arg_node,asp,bsp,esc_p,defs,result_state_p,save_states_p,&ab_node_ids);
	}
#endif

	a_size=0;
	b_size=0;

	a_remove=0;
	b_remove=0;

	for_l (arg_node_id_list,node->node_node_ids,nidl_next){
		NodeIdP arg_node_id;
		
		arg_node_id=arg_node_id_list->nidl_node_id;

#ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
		arg_node_id->nid_mark2 |= NID_LHS_PUSHED;
		arg_node_id->nid_state = *arg_node_id->nid_lhs_state_p;
#endif

		if (arg_node_id->nid_refcount==-1){
			if (IsSimpleState (arg_node_id->nid_state)){
				if (arg_node_id->nid_state.state_kind==OnB)
					b_remove += ObjectSizes [arg_node_id->nid_state.state_object];
				else
					a_remove += SizeOfAStackElem;
			} else
				AddSizeOfState (arg_node_id->nid_state,&a_remove,&b_remove);			
		}

		if (IsSimpleState (arg_node_id->nid_state)){
			if (arg_node_id->nid_state.state_kind==OnB)
				b_size += ObjectSizes [arg_node_id->nid_state.state_object];
			else
				a_size += SizeOfAStackElem;
		} else {
			/* added 6-8-1999 */
#if defined (TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS)
			arg_node_id->nid_node=NULL;
#endif
			/* */
			AddSizeOfState (arg_node_id->nid_state,&a_size,&b_size);
		}
	}


#if FREE_STRICT_LHS_TUPLE_ELEMENTS /* added 26-4-2000 */
	{
	NodeIdListElementP removed_free_node_id_p,*removed_free_node_id_h;
	
	removed_free_node_id_p=NULL;
#endif

	if (!IsSimpleState (node_id_p->nid_state)){
		int a_size,b_size;
		
		DetermineSizeOfState (node_id_p->nid_state,&a_size,&b_size);
		
		if (unused_node_id (node_id_p) && (a_size==0 || node_id_p->nid_a_index==asp) && (b_size==0 || node_id_p->nid_b_index==bsp)){
			asp-=a_size;
			bsp-=b_size;

			if (ab_node_ids.a_node_ids!=NULL && ab_node_ids.a_node_ids->nidl_node_id==node_id_p)
				ab_node_ids.a_node_ids=ab_node_ids.a_node_ids->nidl_next;
			
			if (ab_node_ids.b_node_ids!=NULL && ab_node_ids.b_node_ids->nidl_node_id==node_id_p)
				ab_node_ids.b_node_ids=ab_node_ids.b_node_ids->nidl_next;
		} else {
			int a_offset,b_offset;

			a_offset=(asp-node_id_p->nid_a_index)+a_size-1;
			while (a_size){
				GenPushA (a_offset);
				--a_size;
			}

			b_offset=(bsp-node_id_p->nid_b_index)+b_size-1;
			while (b_size){
				GenPushB (b_offset);
				--b_size;
			}
			
			node_id_p->nid_node=NULL; /* to prevent codegen2 from using a_index and b_index of elements */
		}
	} else {
#ifdef REUSE_UNIQUE_NODES
		if (node->node_number!=0){
			if (b_size==0)
				GenPushArgsU (asp-node_id_p->nid_a_index,a_size,a_size);
			else
				GenPushRArgsU (asp-node_id_p->nid_a_index,a_size,b_size);				
		}
# ifdef DESTRUCTIVE_RECORD_UPDATES
		else if (node->node_record_symbol->symb_kind==definition &&
				node->node_record_symbol->symb_def->sdef_kind==RECORDTYPE &&
				(node_id_p->nid_mark2 & NID_HAS_REFCOUNT_WITHOUT_UPDATES)!=0 &&
				node_id_p->nid_number==-2)
		{
			node_id_p->nid_number=-1;
			if (b_size==0)
				GenPushArgsU (asp-node_id_p->nid_a_index,a_size,a_size);
			else
				GenPushRArgsU (asp-node_id_p->nid_a_index,a_size,b_size);				
		}
# endif
		else {
#endif

		if (unused_node_id (node_id_p)){
			if (node_id_p->nid_a_index==asp){
				if (b_size==0){
#if STRICT_LISTS
					if (node->node_push_symbol->symb_kind==cons_symb && (node->node_push_symbol->symb_head_strictness & 1)){
						repl_overloaded_cons_arguments (node,&asp,&bsp,save_states_p,ab_node_ids_p);
					} else
#endif
					GenReplArgs (a_size,a_size);
				} else
					GenReplRArgs (a_size,b_size);

				if (ab_node_ids.a_node_ids!=NULL && ab_node_ids.a_node_ids->nidl_node_id==node_id_p)
					ab_node_ids.a_node_ids=ab_node_ids.a_node_ids->nidl_next;

#if FREE_STRICT_LHS_TUPLE_ELEMENTS /* added 26-4-2000 */
				removed_free_node_id_h=&ab_node_ids.free_node_ids;

				while ((removed_free_node_id_p=*removed_free_node_id_h)!=NULL){
					if (removed_free_node_id_p->nidl_node_id==node_id_p){
						*removed_free_node_id_h=removed_free_node_id_p->nidl_next;
						break;
					}
					removed_free_node_id_h=&removed_free_node_id_p->nidl_next;
				}				
#endif

				--asp;
			} else {
				if (b_size==0){
#if STRICT_LISTS
					if (node->node_push_symbol->symb_kind==cons_symb && (node->node_push_symbol->symb_head_strictness & 1)){
						GenPushA (asp-node_id_p->nid_a_index);
						++asp;
						
						repl_overloaded_cons_arguments (node,&asp,&bsp,save_states_p,ab_node_ids_p);
					} else
#endif
					GenPushArgs (asp-node_id_p->nid_a_index,a_size,a_size);
				} else
					GenPushRArgs (asp-node_id_p->nid_a_index,a_size,b_size);
				
				GenBuildh (&nil_lab,0);
				GenUpdateA (0,1+a_size+asp-node_id_p->nid_a_index);
				GenPopA (1);
			}
		} else {
			if (b_size==0){
#if STRICT_LISTS
				if (node->node_push_symbol->symb_kind==cons_symb && (node->node_push_symbol->symb_head_strictness & 1)){
					GenPushA (asp-node_id_p->nid_a_index);
					++asp;
						
					repl_overloaded_cons_arguments (node,&asp,&bsp,save_states_p,ab_node_ids_p);
				} else
#endif
				GenPushArgs (asp-node_id_p->nid_a_index,a_size,a_size);
}			else
				GenPushRArgs (asp-node_id_p->nid_a_index,a_size,b_size);
		}

#ifdef REUSE_UNIQUE_NODES
		}
#endif
	}

	asp+=a_size;
	bsp+=b_size;

	source_a_index=asp;
	source_b_index=bsp;

	a_index = source_a_index-a_remove;
	b_index = source_b_index-b_remove;
	
	update_stack_size=0;

	{
		struct node_id_list_element **a_node_ids_p,**b_node_ids_p,*a_node_ids,*b_node_ids;

		a_node_ids=ab_node_ids.a_node_ids;
		b_node_ids=ab_node_ids.b_node_ids;
	
		a_node_ids_p=&ab_node_ids.a_node_ids;
		b_node_ids_p=&ab_node_ids.b_node_ids;

		for_l (arg_node_id_list,node->node_node_ids,nidl_next){
			int asize,bsize;
			struct node_id *arg_node_id;
			
			arg_node_id=arg_node_id_list->nidl_node_id;

			DetermineSizeOfState (arg_node_id->nid_state,&asize,&bsize);

			arg_node_id->nid_a_index_ = a_index;
			arg_node_id->nid_b_index_ = b_index;
			
			if (arg_node_id->nid_refcount==-1){
				source_a_index -= asize;
				source_b_index -= bsize;
				
				continue;
			}

			if (IsSimpleState (arg_node_id->nid_state) || arg_node_id->nid_node==NULL){
				struct node_id_list_element *new_p_node_id;

				if (asize!=0){
					new_p_node_id=CompAllocType (struct node_id_list_element);
					new_p_node_id->nidl_node_id=arg_node_id;
		
					*a_node_ids_p=new_p_node_id;
					a_node_ids_p=&new_p_node_id->nidl_next;
				}

				if (bsize!=0){
					new_p_node_id=CompAllocType (struct node_id_list_element);
					new_p_node_id->nidl_node_id=arg_node_id;
		
					*b_node_ids_p=new_p_node_id;
					b_node_ids_p=&new_p_node_id->nidl_next;
				}
			}
			
			if (a_index!=source_a_index || b_index!=source_b_index){
				struct update *update_p;
				
				update_p=&updates[update_stack_size++];
				
				update_p->a_from_offset=source_a_index;
				update_p->a_to_offset=a_index;
				update_p->a_size=asize;
				update_p->b_from_offset=source_b_index;
				update_p->b_to_offset=b_index;
				update_p->b_size=bsize;
			}
			
			a_index -= asize;
			b_index -= bsize;
			source_a_index -= asize;
			source_b_index -= bsize;
		}

		*a_node_ids_p=a_node_ids;
		*b_node_ids_p=b_node_ids;
	}

	while (update_stack_size!=0){
		struct update *update_p;
		int to,from,size;

		update_p=&updates[--update_stack_size];
		
		size=update_p->a_size;
		from=update_p->a_from_offset;
		to=update_p->a_to_offset;
		while (size!=0){
			--size;
			GenUpdateA (asp-(from-size),asp-(to-size));
		}

		size=update_p->b_size;
		from=update_p->b_from_offset;
		to=update_p->b_to_offset;
		while (size!=0){
			--size;
			GenUpdateB (bsp-(from-size),bsp-(to-size));
		}		
	}
	
	GenPopA (a_remove);
	GenPopB (b_remove);
	
	asp-=a_remove;
	bsp-=b_remove;

#ifdef TRANSFORM_PATTERNS_BEFORE_STRICTNESS_ANALYSIS
	{
		int r;

		r=generate_code_for_root_node (arguments->arg_next->arg_node,asp,bsp,esc_p,defs,result_state_p,save_states_p,&ab_node_ids);

#if FREE_STRICT_LHS_TUPLE_ELEMENTS /* added 26-4-2000 */
		if (removed_free_node_id_p!=NULL)
			*removed_free_node_id_h=removed_free_node_id_p;
#endif
		for_l (arg_node_id_list,node->node_node_ids,nidl_next){
			NodeIdP arg_node_id;
		
			arg_node_id=arg_node_id_list->nidl_node_id;

			arg_node_id->nid_mark2 &= ~NID_LHS_PUSHED;
		}

		return r;
	}
#else
	return generate_code_for_root_node (arguments->arg_next->arg_node,asp,bsp,esc_p,defs,result_state_p,save_states_p,&ab_node_ids);
#endif

#if FREE_STRICT_LHS_TUPLE_ELEMENTS /* added 26-4-2000 */
	}
#endif
}

#ifdef CLEAN2
int contains_fail (NodeP node_p)
{
	while (node_p->node_kind==IfNode){
		NodeP then_node_p,else_node_p;
	
		then_node_p=node_p->node_arguments->arg_next->arg_node;
		else_node_p=node_p->node_arguments->arg_next->arg_next->arg_node;

		if (else_node_p->node_kind==NormalNode && else_node_p->node_symbol->symb_kind==fail_symb)
			return 1;

		if (then_node_p->node_kind==IfNode && contains_fail (then_node_p))
			return 1;
		
		node_p=else_node_p;
	}

	return 0;
}
#endif

int generate_code_for_root_node (NodeP node,int asp,int bsp,struct esc *esc_p,NodeDefP defs,StateP result_state_p,
								 SavedNidStateS **save_states_p,AbNodeIdsP ab_node_ids_p)
{
	switch (node->node_kind){
		case SwitchNode:
			return generate_code_for_switch_node (node,asp,bsp,esc_p,result_state_p,save_states_p,ab_node_ids_p);
		case PushNode:
			return generate_code_for_push_node (node,asp,bsp,esc_p,defs,result_state_p,save_states_p,ab_node_ids_p);
		case GuardNode:
			while (node->node_kind==GuardNode){
				SavedNidStateP saved_node_id_states;
				ArgP arguments;
				int fail_label_number;
				LabDef fail_label;
				struct esc guard_esc;

				fail_label_number=NewLabelNr++;
				MakeLabel (&fail_label,"fail",fail_label_number,no_pref);

				arguments=node->node_arguments;

				saved_node_id_states=NULL;

				guard_esc.esc_asp=asp;
				guard_esc.esc_bsp=bsp;
				guard_esc.esc_label=&fail_label;

#if BUILD_FREE_NODE_ID_LIST_DURING_PATTER_MATCH
				{
				NodeIdListElement old_free_node_ids;
				
				old_free_node_ids=ab_node_ids_p->free_node_ids;
#endif
				generate_code_for_root_node (arguments->arg_node,asp,bsp,&guard_esc,defs,result_state_p,&saved_node_id_states,ab_node_ids_p);

#if BUILD_FREE_NODE_ID_LIST_DURING_PATTER_MATCH
				ab_node_ids_p->free_node_ids=old_free_node_ids;
				}
#endif
		
				restore_saved_node_id_states (saved_node_id_states);

				GenLabelDefinition	(&fail_label);

				defs=node->node_node_defs;
				node=arguments->arg_next->arg_node;
			}

			return generate_code_for_root_node (node,asp,bsp,esc_p,defs,result_state_p,save_states_p,ab_node_ids_p);
		default:
		{
#ifndef CLEAN2
			NodeP else_node;	

			else_node=node;
			while (else_node->node_kind==IfNode)
				else_node=else_node->node_arguments->arg_next->arg_next->arg_node;
#endif

			return CodeRhsNodeDefs (node,defs,asp,bsp,save_states_p,*result_state_p,esc_p,ab_node_ids_p->a_node_ids,
					ab_node_ids_p->b_node_ids,
#if BUILD_FREE_NODE_ID_LIST_DURING_PATTER_MATCH
					ab_node_ids_p->free_node_ids,
#else
					NULL,
#endif
#ifdef CLEAN2
					!contains_fail (node));
#else
					!(else_node->node_kind==NormalNode && else_node->node_symbol->symb_kind==fail_symb));
#endif
		}
	}
}
