diff options
Diffstat (limited to 'backendC')
-rw-r--r-- | backendC/CleanCompilerSources/codegen1.c | 39 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/instructions.c | 21 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/instructions.h | 4 | ||||
-rw-r--r-- | backendC/CleanCompilerSources/statesgen.c | 8 |
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; |