aboutsummaryrefslogtreecommitdiff
path: root/backendC
diff options
context:
space:
mode:
Diffstat (limited to 'backendC')
-rw-r--r--backendC/CleanCompilerSources/codegen1.c39
-rw-r--r--backendC/CleanCompilerSources/instructions.c21
-rw-r--r--backendC/CleanCompilerSources/instructions.h4
-rw-r--r--backendC/CleanCompilerSources/statesgen.c8
4 files changed, 64 insertions, 8 deletions
diff --git a/backendC/CleanCompilerSources/codegen1.c b/backendC/CleanCompilerSources/codegen1.c
index fee4b4f..1b935d5 100644
--- a/backendC/CleanCompilerSources/codegen1.c
+++ b/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;
diff --git a/backendC/CleanCompilerSources/instructions.c b/backendC/CleanCompilerSources/instructions.c
index 00d422d..00acba7 100644
--- a/backendC/CleanCompilerSources/instructions.c
+++ b/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);
diff --git a/backendC/CleanCompilerSources/instructions.h b/backendC/CleanCompilerSources/instructions.h
index da507e4..62d2b6c 100644
--- a/backendC/CleanCompilerSources/instructions.h
+++ b/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);
diff --git a/backendC/CleanCompilerSources/statesgen.c b/backendC/CleanCompilerSources/statesgen.c
index c8a6cc9..5fbb731 100644
--- a/backendC/CleanCompilerSources/statesgen.c
+++ b/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;