add boxed records

backendC/CleanCompilerSources/codegen.c

 
+
 #define for_l(v,l,n) for(v=(l);v!=NULL;v=v->n)
 
 #define SHARE_UPDATE_CODE 0 /* also in codegen1.c */
@@ -1186,7 +1187,7 @@ void CodeGeneration (ImpMod imod, char *fname)
 		OptimiseRules (imod->im_rules,imod->im_start);
 		ExitOnInterrupt();
 #if 0
-		PrintRules (imod->im_rules);
+		PrintRules (imod->im_rules,rules_file);
 #endif
 		if (DoCode && !CompilerError){
 			ImpRuleS *rule;

backendC/CleanCompilerSources/codegen.h

@@ -4,4 +4,7 @@ void EvalArgsEntry (StateS *const function_state_p,SymbDef rule_sdef,int maxasiz
 void EvaluateAndMoveStateArguments (int state_arity,States states,int oldasp,int maxassize);
 void EvaluateAndMoveArguments (int arity,StateP argstates,int *locasp_p,int *aselmts_p);
 
-extern int function_called_only_curried_or_lazy_with_one_return;
\ No newline at end of file
+extern int function_called_only_curried_or_lazy_with_one_return;
+#if GENERATE_CODE_AGAIN
+ extern int call_code_generator_again;
+#endif

backendC/CleanCompilerSources/codegen1.c

@@ -3119,6 +3119,10 @@ void set_local_reference_counts_and_add_free_node_ids (NodeP case_node,NodeIdLis
 		node_id=node_id_ref_count_elem->nrcl_node_id;
 		local_ref_count=node_id_ref_count_elem->nrcl_ref_count;
 
+# if BOXED_RECORDS
+		node_id_ref_count_elem->nrcl_mark2=node_id->nid_mark2 & NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+# endif
+
 # 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
@@ -3518,16 +3522,32 @@ static int generate_code_for_switch_node (NodeP node,int asp,int bsp,struct esc
 			{
 				need_next_alternative=1;
 			}
+#if BOXED_RECORDS
+			set_global_reference_counts_and_exchange_record_update_marks (case_node);
+#endif
 		} else {
+#if BOXED_RECORDS
+			ArgP arg2;
+			
+			for_l (arg2,node->node_arguments,arg_next){
+				if (arg2->arg_node->node_kind==CaseNode && arg2->arg_node->node_number)
+					or_then_record_update_marks (case_node->node_node_id_ref_counts);
+			}
+#endif
 			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;
 			}
+#if BOXED_RECORDS
+			set_global_reference_counts (case_node);
+#endif
 		}
 
+#if !BOXED_RECORDS
 		set_global_reference_counts (case_node);
+#endif
 #if BUILD_FREE_NODE_ID_LIST_DURING_PATTER_MATCH
 		ab_node_ids_p->free_node_ids=old_free_node_ids;
 		}
@@ -3714,9 +3734,12 @@ static int generate_code_for_push_node (NodeP node,int asp,int bsp,struct esc *e
 # 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_mark2 & NID_HAS_REFCOUNT_WITHOUT_UPDATES)!=0 &&
 				node_id_p->nid_number==-2)
-		{
+#  if BOXED_RECORDS
+				|| (node_id_p->nid_mark2 & NID_RECORD_USED_BY_UPDATE)!=0
+#  endif
+		)){
 			node_id_p->nid_number=-1;
 			if (b_size==0)
 				GenPushArgsU (asp-node_id_p->nid_a_index,a_size,a_size);

backendC/CleanCompilerSources/codegen1.h

@@ -111,9 +111,8 @@ extern SymbDef CreateUpdateFunction (ArgS *record_arg,ArgS *first_field_arg,Node
 	,int unbox_record
 #endif
 );
-#if U_RECORD_SELECTORS
+
 extern SymbDef create_select_function (Symbol selector_symbol,int selector_kind);
-#endif
 extern SymbDef create_match_function (struct symbol *constructor_symbol,int constructor_arity,int strict_constructor);
 extern SymbDef create_select_and_match_function (struct symbol *constructor_symbol,int strict_constructor);
 

backendC/CleanCompilerSources/codegen2.h

@@ -6,6 +6,25 @@ typedef
 	{	NormalFill, ReleaseAndFill, PartialFill
 	} FillKind;
 
+typedef enum {
+	AToA, AToB, BToA, BToB, Reduce,AToRoot, MayBecomeCyclicSpine, CyclicSpine
+} Coercions;
+
+STRUCT (moved_node_id,MovedNodeId){
+	struct node_id *		mnid_node_id;
+	struct moved_node_id *	mnid_next;
+	int						mnid_a_stack_offset;
+};
+
+STRUCT (code_gen_node_ids,CodeGenNodeIds){
+	struct saved_nid_state **saved_nid_state_l;
+	struct node_id_list_element *free_node_ids;
+	struct moved_node_id **moved_node_ids_l;
+	struct node_id_list_element *a_node_ids;
+	struct node_id_list_element *b_node_ids;
+	int doesnt_fail;
+};
+
 extern StateS OnAState;
 extern LabDef BasicDescriptors [];
 extern unsigned NewLabelNr;
@@ -38,24 +57,29 @@ extern void PackArgument (StateS argstate,int aindex,int bindex,int asp,int bsp,
 extern void save_node_id_state (NodeId node_id,struct saved_nid_state **ifrule);
 extern void restore_saved_node_id_states (struct saved_nid_state *saved_node_id_states);
 
-typedef enum {
-	AToA, AToB, BToA, BToB, Reduce,AToRoot, MayBecomeCyclicSpine, CyclicSpine
-} Coercions;
-
-STRUCT (moved_node_id,MovedNodeId){
-	struct node_id *		mnid_node_id;
-	struct moved_node_id *	mnid_next;
-	int						mnid_a_stack_offset;
-};
-
-STRUCT (code_gen_node_ids,CodeGenNodeIds){
-	struct saved_nid_state **saved_nid_state_l;
-	struct node_id_list_element *free_node_ids;
-	struct moved_node_id **moved_node_ids_l;
-	struct node_id_list_element *a_node_ids;
-	struct node_id_list_element *b_node_ids;
-	int doesnt_fail;
-};
+#if GENERATE_CODE_AGAIN
+extern ArgP
+#else
+extern void
+#endif
+	compute_bits_and_remove_unused_arguments (NodeP node,char bits[],unsigned int argument_overwrite_bits,unsigned int *n_args_p);
+#if GENERATE_CODE_AGAIN
+extern ArgP
+#else
+extern void
+#endif
+	compute_bits_and_remove_unused_arguments_for_strict_node (NodeP node,char bits[],unsigned int argument_overwrite_bits,
+															  int *a_size_p,int *b_size_p,int *n_a_fill_bits_p,int *n_b_fill_bits_p);
+#if GENERATE_CODE_AGAIN
+extern void restore_removed_arguments (ArgP *arg_h,ArgP removed_args,unsigned int argument_overwrite_bits,int node_arity);
+#endif
+
+#ifdef DESTRUCTIVE_RECORD_UPDATES
+extern void compute_bits_and_add_selectors_to_update_node
+	(ArgS *record_arg,ArgS *first_field_arg,StateS *field_states,int record_a_size,int record_b_size,
+	char bits[],int *n_a_fill_bits_p,int *n_b_fill_bits_p);
+#endif
+int is_unique_record_update (NodeIdP record_node_id,NodeP record_node);
 
 Coercions CoerceStateKind (StateKind dem_state_kind, StateKind off_state_kind);
 void GenReduceError (void);
@@ -69,6 +93,7 @@ int get_b_index_of_unpacked_lhs_node (ArgS *arg);
 void decrement_reference_count_of_node_id (struct node_id *node_id,NodeIdListElementS **free_node_ids_l);
 
 void BuildArgs (Args args,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen_node_ids_p);
+void BuildLazyArgs (Args args,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen_node_ids_p);
 void build_and_cleanup (Node node,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen_node_ids_p);
 
 #define RECORD_N_PREF c_pref
@@ -85,6 +110,9 @@ void Build (Node node,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen_node_ids_p)
 Coercions CoerceSimpleStateArgument (StateS demstate,StateKind offkind,int aindex,int *asp_p,Bool leaveontop, Bool *ontop);
 void subtract_else_ref_counts (struct node_id_ref_count_list *else_node_id_ref_counts,NodeIdListElementS **free_node_ids_l);
 void add_else_ref_counts (struct node_id_ref_count_list *else_node_id_ref_counts);
+#if BOXED_RECORDS
+	void or_then_record_update_marks (struct node_id_ref_count_list *else_node_id_ref_counts);
+#endif
 void EvaluateCondition (Node cond_node,int *asp_p,int *bsp_p,CodeGenNodeIdsP code_gen_node_ids_p,StateS resultstate);
 void DetermineFieldSizeAndPositionAndRecordSize
 	(int fieldnr,int *asize_p,int *bsize_p,int *apos_p,int *bpos_p,int *rec_asize_p,int *rec_bsize_p,StateS *record_state_p);
@@ -114,4 +142,6 @@ void cleanup_stack
 void ChangeEvalStatusKindToStrictOnA (NodeId node_id,SavedNidStateS **saved_nid_state_l);
 #if OPTIMIZE_LAZY_TUPLE_RECURSION
 void FillNodeOnACycle (Node node,int *asp_p,int *bsp_p,NodeId update_node_id,CodeGenNodeIdsP code_gen_node_ids_p);
-#endif
\ No newline at end of file
+#endif
+void PushField (StateS recstate,int fieldnr,int offset,int *asp_p,int *bsp_p,int *a_size_p,int *b_size_p);
+void ReplaceRecordByField (StateS recstate,int fieldnr,int *asp_p,int *bsp_p,int *a_size_p,int *b_size_p);

backendC/CleanCompilerSources/codegen3.c

@@ -17,6 +17,8 @@
 #include "comsupport.h"
 
 #include "codegen_types.h"
+#include "statesgen.h"
+#include "optimisations.h"
 #include "codegen.h"
 #include "codegen1.h"
 #include "codegen2.h"
@@ -688,26 +690,18 @@ static void CodeRootSelection (Node root, NodeId rootid,int asp,int bsp,CodeGenN
 
 static int CodeRhsNodeDefsAndRestoreNodeIdStates (Node root_node,NodeDefs defs,int asp,int bsp,StateS resultstate,struct esc *esc_p,
 												NodeIdListElementP a_node_ids,NodeIdListElementP b_node_ids,
-												struct node_id_ref_count_list *else_node_id_ref_counts,int doesnt_fail)
+												NodeIdListElementP free_node_ids,int doesnt_fail)
 {
 	SavedNidStateP saved_node_id_states;
-	NodeIdListElementP free_node_ids;
 	int need_next_alternative;
 	
 	saved_node_id_states=NULL;
-	free_node_ids=NULL;
-	
-	if (else_node_id_ref_counts!=NULL)
-		subtract_else_ref_counts (else_node_id_ref_counts,&free_node_ids);
-	
+		
 	need_next_alternative=CodeRhsNodeDefs (root_node,defs,asp,bsp,&saved_node_id_states,resultstate,esc_p,a_node_ids,b_node_ids,
 											free_node_ids,doesnt_fail);
 
 	restore_saved_node_id_states (saved_node_id_states);
 
-	if (else_node_id_ref_counts!=NULL)
-		add_else_ref_counts (else_node_id_ref_counts);
-
 	return need_next_alternative;
 }
 
@@ -928,18 +922,6 @@ static void CodeNormalRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenN
 	}
 }
 
-static void PushField (StateS recstate,int fieldnr,int offset,int *asp_p,int *bsp_p,int *a_size_p,int *b_size_p)
-{
-	int apos,bpos,totasize,totbsize;
-
-	DetermineFieldSizeAndPositionAndRecordSize (fieldnr,a_size_p,b_size_p,&apos,&bpos,&totasize,&totbsize,&recstate);
-	
-	GenPushRArgB (offset, totasize, totbsize, bpos+1, *b_size_p);
-	GenPushRArgA (offset, totasize, totbsize, apos+1, *a_size_p);
-	*bsp_p += *b_size_p;
-	*asp_p += *a_size_p;
-}
-
 static void CodeRootFieldSelector (Node root,NodeId rootid,int asp,int bsp,CodeGenNodeIdsP code_gen_node_ids_p,StateS demstate)
 {
 	int	fieldnr;
@@ -976,19 +958,31 @@ static void CodeRootFieldSelector (Node root,NodeId rootid,int asp,int bsp,CodeG
 		
 		if (arg_node->node_kind!=NodeIdNode){
 			StateS offstate;
+			StateP record_state_p;
 
 			offstate = arg_node->node_state;
 			Build (arg_node,&asp,&bsp,code_gen_node_ids_p);
 
+			record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state;
+
 			if (root->node_arity>=SELECTOR_U){
 				int record_a_size,record_b_size,asize,bsize,aindex,bindex,offstate_a_size,offstate_b_size;
-				StateP record_state_p;
-					
-				record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state;
-									
+														
 				DetermineSizeOfState (offstate,&offstate_a_size,&offstate_b_size);
 				CoerceArgumentOnTopOfStack (&asp,&bsp,arg->arg_state,offstate,offstate_a_size,offstate_b_size);
 
+#if BOXED_RECORDS
+				if (arg->arg_state.state_type==SimpleState){
+					if (root->node_arity<SELECTOR_L){
+						PushField (*record_state_p,fieldnr,0,&asp,&bsp,&asize,&bsize);
+						RedirectResultAndReturn (asp,bsp,asp,bsp,root->node_state,demstate,1+asize,bsize);
+					} else {
+						ReplaceRecordByField (*record_state_p,fieldnr,&asp,&bsp,&asize,&bsize);
+						DetermineSizeOfState (root->node_state,&offstate_a_size,&offstate_b_size);
+						RedirectResultAndReturn (asp,bsp,asp,bsp,root->node_state,demstate,offstate_a_size,offstate_b_size);
+					}
+				} else {
+#endif
 				DetermineFieldSizeAndPositionAndRecordSize (fieldnr,&asize,&bsize,&aindex,&bindex,&record_a_size,&record_b_size,record_state_p);
 				
 				if (root->node_arity<SELECTOR_L){
@@ -1008,7 +1002,9 @@ static void CodeRootFieldSelector (Node root,NodeId rootid,int asp,int bsp,CodeG
 					DetermineSizeOfState (root->node_state,&offstate_a_size,&offstate_b_size);
 					RedirectResultAndReturn (asp,bsp,asp,bsp,root->node_state,demstate,offstate_a_size,offstate_b_size);
 				}
-
+#if BOXED_RECORDS
+				}
+#endif
 				return;
 			}
 			
@@ -1023,9 +1019,13 @@ static void CodeRootFieldSelector (Node root,NodeId rootid,int asp,int bsp,CodeG
 				return;
 			} else {
 				int a_size,b_size;
-
+#if 1
+				PushField (*record_state_p, fieldnr, 0, & asp, & bsp,&a_size,&b_size);
+				RedirectResultAndReturn (asp,bsp,asp,bsp,record_state_p->state_record_arguments[fieldnr],demstate,a_size,b_size);
+#else
 				PushField (arg->arg_state, fieldnr, 0, & asp, & bsp,&a_size,&b_size);
 				RedirectResultAndReturn (asp,bsp,asp,bsp,arg->arg_state.state_record_arguments[fieldnr],demstate,a_size,b_size);
+#endif
 				return;
 			}
 		} else {
@@ -1079,14 +1079,21 @@ static void CodeRootFieldSelector (Node root,NodeId rootid,int asp,int bsp,CodeG
 			} else {
 				Bool ontop;
 				int a_size,b_size;
+				StateP record_state_p;
 
+				record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state;
 				if (root->node_arity>=SELECTOR_U){
 					int	asize,bsize,aindex,bindex,offered_a_size,offered_b_size;
-					StateP record_state_p;
 					
-					record_state_p=&seldef->sdef_type->type_lhs->ft_symbol->symb_def->sdef_record_state;
 					CopyNodeIdArgument (arg->arg_state,arg_node_id,&asp,&bsp);
-
+#if BOXED_RECORDS
+					if (arg->arg_state.state_type==SimpleState){
+						if (root->node_arity<SELECTOR_L)
+							PushField (*record_state_p,fieldnr,0,&asp,&bsp,&asize,&bsize);
+						else
+							ReplaceRecordByField (*record_state_p,fieldnr,&asp,&bsp,&asize,&bsize);
+					} else {
+#endif
 					DetermineFieldSizeAndPosition (fieldnr,&asize,&bsize,&aindex,&bindex,record_state_p->state_record_arguments);
 					
 					if (root->node_arity<SELECTOR_L){
@@ -1105,17 +1112,22 @@ static void CodeRootFieldSelector (Node root,NodeId rootid,int asp,int bsp,CodeG
 						DetermineSizeOfState (*record_state_p,&record_a_size,&record_b_size);
 						ReplaceRecordOnTopOfStackByField (&asp,&bsp,aindex,bindex,asize,bsize,record_a_size,record_b_size);
 					}
-
+#if BOXED_RECORDS
+					}
+#endif
 					DetermineSizeOfState (root->node_state,&offered_a_size,&offered_b_size);	
 					RedirectResultAndReturn (asp,bsp,asp,bsp,root->node_state,demstate,offered_a_size,offered_b_size);
 					return;
 				}
 
 				CoerceSimpleStateArgument (demstate, offstate.state_kind,arg_node_id->nid_a_index,&asp,False,&ontop);
-				
+#if 1
+				PushField (*record_state_p,fieldnr,asp-arg_node_id->nid_a_index,&asp,&bsp,&a_size,&b_size);
+				RedirectResultAndReturn (asp, bsp, asp, bsp,record_state_p->state_record_arguments[fieldnr],demstate,a_size,b_size);
+#else
 				PushField (arg->arg_state,fieldnr,asp-arg_node_id->nid_a_index,&asp,&bsp,&a_size,&b_size);
-
 				RedirectResultAndReturn (asp, bsp, asp, bsp,arg->arg_state.state_record_arguments[fieldnr],demstate,a_size,b_size);
+#endif
 				return;
 			}
 		}
@@ -1200,24 +1212,85 @@ static void CodeRootUpdateNode (Node root,NodeId rootid,int asp,int bsp,CodeGenN
 		first_field_arg=record_arg->arg_next;
 		
 		RemoveSelectorsFromUpdateNode (record_arg,first_field_arg);
-		
-		/* BuildNewStackFrame (record_arg,asp,bsp,False,code_gen_node_ids_p); */
-		
+
+#if 1
+		BuildArgs (record_arg->arg_next,&asp,&bsp,code_gen_node_ids_p);
+#endif
+
+		if (IsSimpleState (root->node_state) && record_arg->arg_node->node_kind==NodeIdNode){
+			NodeIdP record_node_id;
+			
+			record_node_id=record_arg->arg_node->node_node_id;
+
+			if (is_unique_record_update (record_node_id,record_arg->arg_node) && rootid==NULL){
+/*
+			if ((record_node_id->nid_state.state_mark & STATE_UNIQUE_MASK)!=0 &&
+				(record_node_id->nid_mark2 & NID_HAS_REFCOUNT_WITHOUT_UPDATES)!=0 &&
+				record_node_id->nid_number== -1 &&
+				record_node_id->nid_state.state_type==SimpleState &&
+				record_node_id->nid_state.state_kind==StrictOnA &&
+				!DoReuseUniqueNodes && rootid==NULL)
+			{
+*/				int n_a_fill_bits,n_b_fill_bits;
+				char bits[MaxNodeArity+2];
+				LabDef record_lab;
+
+#if BOXED_RECORDS
+				record_node_id->nid_mark2 |= NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+#endif
+				DetermineSizeOfState (record_sdef->sdef_record_state,&record_a_size,&record_b_size);
+			
+				if (record_a_size+record_b_size>2){
+#if 0
+					BuildArgs (record_arg->arg_next,&asp,&bsp,code_gen_node_ids_p);
+#endif			
+					compute_bits_and_add_selectors_to_update_node (record_arg,first_field_arg,
+						record_sdef->sdef_record_state.state_record_arguments,record_a_size,record_b_size,
+						bits,&n_a_fill_bits,&n_b_fill_bits);
+
+					ConvertSymbolToRLabel (&record_lab,record_sdef->sdef_record_state.state_record_symbol);
+				
+					GenPushA (asp-record_node_id->nid_a_index);
+					asp+=1;
+
+					GenFill3R (&record_lab,record_a_size,record_b_size,asp,bits+1);
+
+					asp-=n_a_fill_bits+1;
+					bsp-=n_b_fill_bits;
+
+					decrement_reference_count_of_node_id (record_node_id,&code_gen_node_ids_p->free_node_ids);
+					
+					GenPopA	(asp);
+					GenPopB	(bsp);
+					GenRtn (1,0,OnAState);
+					return;
+				}
+			}
+#if BOXED_RECORDS
+			record_node_id->nid_mark2 |= NID_RECORD_USED_BY_NON_SELECTOR_OR_UPDATES;
+#endif
+		}
+
 		{
 		int a_size,b_size;
+		StateP record_state_p;
+
+		record_state_p=&root->node_symbol->symb_def->sdef_record_state;
 
+		record_arg->arg_state=*record_state_p;
+#if 1
+		BuildArg (record_arg,&asp,&bsp,code_gen_node_ids_p);
+#else
 		BuildArgs (record_arg,&asp,&bsp,code_gen_node_ids_p);
+#endif
 		DetermineSizeOfArguments (record_arg,&a_size,&b_size);
 		UpdateAAndBStack (asp,bsp,a_size,b_size,&asp,&bsp);
-		}
+		
+		/* BuildNewStackFrame (record_arg,asp,bsp,False,code_gen_node_ids_p); */
 
 		if (IsSimpleState (root->node_state)){
 			LabDef record_label;
-			StateP record_state_p;
 
-/*			error_in_function ("CodeRootUpdateNode"); */
-
-			record_state_p=&root->node_symbol->symb_def->sdef_record_state;
 			DetermineSizeOfState (*record_state_p,&record_a_size,&record_b_size);
 
 			UpdateNodeAndAddSelectorsToUpdateNode (record_arg,first_field_arg,
@@ -1240,12 +1313,130 @@ static void CodeRootUpdateNode (Node root,NodeId rootid,int asp,int bsp,CodeGenN
 				GenRtn (record_a_size,record_b_size,result_state);
 		}
 	}
+
+	}
 }
 
 #ifdef CLEAN2
 extern int contains_fail (NodeP node_p);
 #endif
 
+static void fill_strict_root_unique_node (NodeP node,NodeP update_node,char bits[],LabDef *label_p,NodeIdP free_unique_node_id,int asp,int bsp,CodeGenNodeIdsP code_gen_node_ids_p)
+{
+	int a_size,b_size,n_a_fill_bits,n_b_fill_bits;
+#if GENERATE_CODE_AGAIN
+	ArgP removed_args=
+#endif
+	compute_bits_and_remove_unused_arguments_for_strict_node (node,bits,update_node->node_arguments->arg_occurrence,
+															  &a_size,&b_size,&n_a_fill_bits,&n_b_fill_bits);
+		
+	BuildArgs (node->node_arguments,&asp,&bsp,code_gen_node_ids_p);
+
+#if GENERATE_CODE_AGAIN
+	if (call_code_generator_again)
+		restore_removed_arguments (&node->node_arguments,removed_args,update_node->node_arguments->arg_occurrence,node->node_arity);
+#endif
+	
+	GenPushA (asp-free_unique_node_id->nid_a_index);
+	asp+=1;
+
+	GenFill3R (label_p,a_size,b_size,asp,bits+1);
+
+	asp-=n_a_fill_bits+1;
+	bsp-=n_b_fill_bits;
+
+	decrement_reference_count_of_node_id (free_unique_node_id,&code_gen_node_ids_p->free_node_ids);
+
+	GenPopA	(asp);
+	GenPopB	(bsp);
+	GenRtn (1,0,OnAState);
+}
+
+static void CodeRootFillUniqueNode (Node update_node,int asp,int bsp,CodeGenNodeIdsP code_gen_node_ids_p)
+{
+	unsigned int n_args,node_arity;
+	char bits[MaxNodeArity+2];
+	NodeIdP free_unique_node_id;
+	NodeP node,push_node;
+	LabDef name,*label_p;
+	SymbolP symbol;
+
+	node=update_node->node_arguments->arg_node;
+	push_node=update_node->node_node;
+	free_unique_node_id=push_node->node_arguments->arg_node->node_node_id;
+	
+	symbol=node->node_symbol;
+	
+	switch (symbol->symb_kind){
+		case definition:
+		{
+			SymbDef sdef;
+				
+			sdef=node->node_symbol->symb_def;
+
+			node_arity=node->node_arity;
+			
+			switch (sdef->sdef_kind){
+				case CONSTRUCTOR:					
+					bits[0]='1';
+					
+					if (sdef->sdef_strict_constructor){
+						ConvertSymbolToKLabel (&name,sdef);
+						
+						fill_strict_root_unique_node (node,update_node,bits,&name,free_unique_node_id,asp,bsp,code_gen_node_ids_p);
+						
+						return;
+					} else {
+						ConvertSymbolToConstructorDLabel (&name,sdef);
+						label_p=&name;
+					}
+					break;
+				case RECORDTYPE:
+					bits[0]='1';
+
+					ConvertSymbolToRLabel (&name,sdef);
+
+					fill_strict_root_unique_node (node,update_node,bits,&name,free_unique_node_id,asp,bsp,code_gen_node_ids_p);
+					
+					return;
+				default:
+					error_in_function ("CodeRootFillUniqueNode");
+					return;
+			}
+			break;
+		}
+		default:
+			error_in_function ("CodeRootFillUniqueNode");
+			return;
+	}
+
+#if GENERATE_CODE_AGAIN
+	{
+	ArgP removed_args=
+#endif
+	compute_bits_and_remove_unused_arguments (node,bits,update_node->node_arguments->arg_occurrence,&n_args);
+
+	BuildLazyArgs (node->node_arguments,&asp,&bsp,code_gen_node_ids_p);
+
+#if GENERATE_CODE_AGAIN
+	if (call_code_generator_again)
+		restore_removed_arguments (&node->node_arguments,removed_args,update_node->node_arguments->arg_occurrence,node_arity);
+	}
+#endif
+
+	GenPushA (asp-free_unique_node_id->nid_a_index);
+	asp+=1;
+
+	GenFill3 (label_p,node_arity,asp,bits+1);
+	asp-=n_args+1;
+
+	decrement_reference_count_of_node_id (free_unique_node_id,&code_gen_node_ids_p->free_node_ids);
+	
+	GenPopA	(asp);
+	GenPopB	(bsp);
+	GenRtn (1,0,OnAState);
+}
+
 static int CodeRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenNodeIdsP code_gen_node_ids_p,StateS resultstate,struct esc *esc_p)
 {
 	switch (root->node_kind){
@@ -1272,7 +1463,7 @@ static int CodeRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenNodeIdsP
 			EvaluateCondition (condpart->arg_node,&asp,&bsp,code_gen_node_ids_p,condpart->arg_state);
 
 			MakeLabel (&elselab, else_symb, NewLabelNr, no_pref);
-			MakeLabel (&thenlab, then_symb, NewLabelNr++, no_pref);
+			MakeLabel (&thenlab, then_symb, NewLabelNr++, no_pref); 
 
 			thenlab.lab_mod=notused_string;
 
@@ -1282,15 +1473,23 @@ static int CodeRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenNodeIdsP