generate ea entry for boxed records, fixes jmp_eval_upd in lazy selectors

for fields (in other records) with this record type

backendC/CleanCompilerSources/codegen1.c

@@ -890,7 +890,7 @@ static void GenerateConstructorDescriptorAndFunction (ConstructorList constructo
 
 static void GenLazyRecordEntry (SymbDef rdef)
 {
-	LabDef record_label,d_label;
+	LabDef record_label,d_label,ea_label,*ea_label_p;
 	States argstates;
 	int asp,bsp,arity;
 	int maxasize,asize,bsize;
@@ -902,21 +902,36 @@ static void GenLazyRecordEntry (SymbDef rdef)
 	arity = asp;
 
 	ConvertSymbolToRecordDandNLabel (&d_label,&CurrentAltLabel,rdef);
-	
-	if (rdef->sdef_exported)
-		GenExportEaEntry (rdef);
 
+	if (rdef->sdef_boxed_record){
+		if (rdef->sdef_exported){
+			GenExportEaEntry (rdef);
+			MakeSymbolLabel (&ea_label,CurrentModule,ea_pref,rdef,0);
+		} else {
+			MakeSymbolLabel (&ea_label,NULL,ea_pref,rdef,0);		
+		}
+		ea_label_p=&ea_label;
+	} else
+		ea_label_p=NULL;
+	
 	if (DoTimeProfiling)
 		GenPB (rdef->sdef_ident->ident_name);
 
 	GenLazyRecordDescriptorAndExport (rdef);
 
-	GenLazyRecordNodeEntryDirective (arity,&d_label);
+	GenLazyRecordNodeEntryDirective (arity,&d_label,ea_label_p);
 
 	GenOAStackLayout (1);
 	GenLabelDefinition (&CurrentAltLabel);
 	GenPushNode (ReduceError,asp);
 
+	if (ea_label_p!=NULL){
+		GenOAStackLayout (arity+1);
+		if (DoTimeProfiling)
+			GenPN();
+		GenLabelDefinition (&ea_label);
+	}
+
 	asize=0;
 	bsize=0;
 	maxasize=0;
@@ -1399,10 +1414,15 @@ Bool NodeEntry (StateS *const function_state_p,int arity,Label ealab,SymbDef roo
 			}
 #endif
 		} else if (function_state_p[-1].state_kind==StrictRedirection || function_state_p[-1].state_kind==LazyRedirection){
+#ifdef JMP_UPD
+			GenDAStackLayout (arity);
+			GenJmpUpd (ealab);
+#else
 			CallEvalArgsEntry (arity,function_state_p,1,0,ealab);
 			GenFillFromA (0, 1, ReleaseAndFill);
 			GenPopA (1);
 			GenRtn (1,0,OnAState);
+#endif
 		}
 	} else {
 		int asize, bsize;
@@ -1560,10 +1580,19 @@ Bool NodeEntryUnboxed (StateS *const function_state_p,NodeP call_node_p,int args
 			}
 #	endif
 		} else if (function_state_p[-1].state_kind==StrictRedirection || function_state_p[-1].state_kind==LazyRedirection){
+#ifdef JMP_UPD
+			if (args_b_size==0){
+				GenDAStackLayout (args_a_size);
+				GenJmpUpd (ealab);	
+			} else {
+#endif
 			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);
+#ifdef JMP_UPD
+			}
+#endif
 		}
 	} else {
 		int asize, bsize;

backendC/CleanCompilerSources/instructions.c

@@ -643,6 +643,8 @@ enum {
 #define Ijmp_eval "jmp_eval"
 #define Ijmp_eval_upd "jmp_eval_upd"
 #define Ijmp_ap "jmp_ap"
+#define Ijmp_ap_upd "jmp_ap_upd"
+#define Ijmp_upd "jmp_upd"
 
 #define Ihalt "halt"
 
@@ -2211,6 +2213,18 @@ void GenJmpAp (int n_args)
 	put_arguments_n_b (n_args);
 }
 
+void GenJmpApUpd (int n_args)
+{
+	put_instruction_b (jmp_ap_upd);
+	put_arguments_n_b (n_args);
+}
+
+void GenJmpUpd (Label tolab)
+{
+	put_instruction_b (jmp_upd);
+	GenLabel (tolab);
+}
+
 void GenPopA (int nr)
 {
 	if (nr > 0){
@@ -2660,7 +2674,7 @@ void GenApplyEntryDirective (int arity,Label label)
 }
 #endif
 
-void GenLazyRecordNodeEntryDirective (int arity,Label label)
+void GenLazyRecordNodeEntryDirective (int arity,Label label,Label label2)
 {
 	if (DoStackLayout){
 		put_directive_b (n);
@@ -2671,6 +2685,11 @@ void GenLazyRecordNodeEntryDirective (int arity,Label label)
 		else
 			FPutS (empty_lab.lab_name, OutFile);
 
+		if (label2){
+			FPutC (' ', OutFile);
+			GenLabel (label2);
+		}
+
 #ifdef MEMORY_PROFILING_WITH_N_STRING
 		if (DoProfiling && arity>=0 && !DoParallel){
 			put_directive_ (Dn_string);

backendC/CleanCompilerSources/instructions.h

@@ -90,6 +90,8 @@ void GenJsrEval (int offset);
 void GenJsrAp (int n_args);
 void GenJmpEval (void);
 void GenJmpAp (int n_args);
+void GenJmpApUpd (int n_args);
+void GenJmpUpd (Label tolab);
 void GenPopA (int nr);
 void GenPopB (int nr);
 
@@ -162,7 +164,7 @@ void GenApplyEntryDirective (int arity,Label label);
 #ifdef NEW_APPLY
 void GenApplyEntryDirective (int arity,Label label);
 #endif
-void GenLazyRecordNodeEntryDirective (int arity,Label label);
+void GenLazyRecordNodeEntryDirective (int arity,Label label,Label label2);
 void GenFieldNodeEntryDirective (int arity, Label label, Label label2,char *record_name);
 void GenConstructorDescriptorAndExport (SymbDef sdef);
 void GenFunctionDescriptorAndExportNodeAndDescriptor (SymbDef sdef);

backendC/CleanCompilerSources/statesgen.c

@@ -1159,6 +1159,12 @@ void ExamineTypesAndLhsOfSymbolDefinition (SymbDef def)
 			for_l (fields,def->sdef_type->type_fields,fl_next)
 				ExamineTypesAndLhsOfSymbolDefinition (fields->fl_symbol->symb_def);
 
+			if (def->sdef_boxed_record){
+				def->sdef_calledwithrootnode = True;
+				def->sdef_returnsnode = True;
+				return;
+			}
+
 			rootstate = def->sdef_record_state;
 			break;
 		}
@@ -1717,7 +1723,7 @@ static Bool ArgsInAStrictContext (StateP arg_state_p,Args argn, int local_scope)
 #if BOXED_RECORDS
 		if (record_sdef->sdef_boxed_record){
 			StateS boxed_record_state;
-				
+			
 			SetUnaryState (&boxed_record_state,StrictOnA,RecordObj);
 			if (DetermineStrictArgContext (arg, boxed_record_state,local_scope))
 				parallel = True;