diff --git a/backendC/CleanCompilerSources/codegen.c b/backendC/CleanCompilerSources/codegen.c index 9203890fff5798f0e6feaadc8d4ad5d8390b5ab5..13f02feae18bb9f2fef1f5740e65cd36d47e6d02 100644 --- a/backendC/CleanCompilerSources/codegen.c +++ b/backendC/CleanCompilerSources/codegen.c @@ -925,17 +925,17 @@ static void CodeRule (ImpRuleP rule) GenFillArrayAndPop (1, ReleaseAndFill); break; } + GenPopB (bsize); } else { 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); GenUpdatePopA (0, asize); + GenPopB (bsize); break; case RecordState: - BuildRecord (function_state_p[-1].state_record_symbol,asize, bsize, asize, bsize, - asize, bsize, asize, NormalFill,True); - GenUpdatePopA (0, asize); + BuildNewRecordPop (function_state_p[-1].state_record_symbol,asize,bsize); break; case ArrayState: GenBuildArrayPop(); @@ -943,7 +943,6 @@ static void CodeRule (ImpRuleP rule) } } - GenPopB (bsize); GenRtn (1,0,OnAState); } diff --git a/backendC/CleanCompilerSources/codegen1.c b/backendC/CleanCompilerSources/codegen1.c index 111a219df5a2064b932a3084687c6b56ca4d2ff2..77076d4780e0c54a9bedc917128ac195d2799f06 100644 --- a/backendC/CleanCompilerSources/codegen1.c +++ b/backendC/CleanCompilerSources/codegen1.c @@ -1856,18 +1856,16 @@ void ApplyEntry (StateS *const function_state_p,int arity,Label ea_lab,int ea_la BuildTuple (asize, bsize, asize, bsize, function_state_p[-1].state_arity, function_state_p[-1].state_tuple_arguments,asize,bsize, asize,NormalFill,True); GenUpdatePopA (0, asize); + GenPopB (bsize); break; case RecordState: - BuildRecord (function_state_p[-1].state_record_symbol,asize, bsize, asize, bsize, - asize, bsize, asize, NormalFill,True); - GenUpdatePopA (0, asize); + BuildNewRecordPop (function_state_p[-1].state_record_symbol,asize,bsize); break; case ArrayState: GenBuildArrayPop(); break; } - GenPopB (bsize); - GenRtn (1,0,OnAState); + GenRtn (1,0,OnAState); #if SHARE_UPDATE_CODE } #endif @@ -3870,7 +3868,7 @@ static int generate_code_for_switch_node (NodeP node,int asp,int bsp,struct esc LabDef record_lab; ConvertSymbolToRLabel (&record_lab,BasicSymbolStates [integer_denot].state_record_symbol); - GenBuildR (&record_lab,1,1,0,0,True); + GenBuildhr (&record_lab,1,1); } } else if (symbol->symb_kind==rational_denot){ push_rational (symbol); @@ -3878,7 +3876,7 @@ static int generate_code_for_switch_node (NodeP node,int asp,int bsp,struct esc LabDef ratio_record_lab; ConvertSymbolToKLabel (&ratio_record_lab,special_types[1]->sdef_type->type_constructors->cl_constructor->type_node_symbol->symb_def); - GenBuildR (&ratio_record_lab,2,0,0,0,True); + GenBuildhr (&ratio_record_lab,2,0); } } else BuildBasic (BasicSymbolStates [symbol->symb_kind].state_object,symbol->symb_val); @@ -3902,7 +3900,7 @@ static int generate_code_for_switch_node (NodeP node,int asp,int bsp,struct esc GenPushZ (symbol->symb_val); ConvertSymbolToRLabel (&record_lab,BasicSymbolStates [integer_denot].state_record_symbol); - GenBuildR (&record_lab,1,1,0,0,True); + GenBuildhr (&record_lab,1,1); } else if (symbol->symb_kind==rational_denot){ LabDef ratio_record_lab; @@ -3910,7 +3908,7 @@ static int generate_code_for_switch_node (NodeP node,int asp,int bsp,struct esc ConvertSymbolToKLabel (&ratio_record_lab,special_types[1]->sdef_type->type_constructors->cl_constructor->type_node_symbol->symb_def); - GenBuildR (&ratio_record_lab,2,0,0,0,True); + GenBuildhr (&ratio_record_lab,2,0); } else BuildBasic (BasicSymbolStates [symbol->symb_kind].state_object,symbol->symb_val); diff --git a/backendC/CleanCompilerSources/codegen2.c b/backendC/CleanCompilerSources/codegen2.c index 20437dafe64c12916cfe0b7412e50762d579687c..97bf789c2287fa2846346c0af060425e7ec7ab38 100644 --- a/backendC/CleanCompilerSources/codegen2.c +++ b/backendC/CleanCompilerSources/codegen2.c @@ -454,8 +454,7 @@ void CoerceArgumentUsingStackFrames (StateS demstate, StateS offstate,int aindex *asp_p += SizeOfAStackElem; break; case RecordState: - BuildRecord (offstate.state_record_symbol,aindex, bindex, *asp_p, *bsp, - asize,bsize,*asp_p,NormalFill,True); + BuildNewRecord (offstate.state_record_symbol,aindex,bindex,*asp_p,*bsp,asize,bsize); *asp_p += SizeOfAStackElem; break; case ArrayState: @@ -591,11 +590,29 @@ void BuildRecord (SymbDef record_sdef,int aindex,int bindex,int asp,int bsp,int ConvertSymbolToRLabel (&record_lab,record_sdef); if (newnode) - GenBuildR (&record_lab,asize,bsize,asp-aindex,bsp-bindex,False); + GenBuildR (&record_lab,asize,bsize,asp-aindex,bsp-bindex); else GenFillR (&record_lab,asize,bsize,asp-rootindex,asp-aindex,bsp-bindex,fkind,False); } +void BuildNewRecord (SymbDef record_sdef,int aindex,int bindex,int asp,int bsp,int asize,int bsize) +{ + LabDef record_lab; + + ConvertSymbolToRLabel (&record_lab,record_sdef); + + GenBuildR (&record_lab,asize,bsize,asp-aindex,bsp-bindex); +} + +void BuildNewRecordPop (SymbDef record_sdef,int asize,int bsize) +{ + LabDef record_lab; + + ConvertSymbolToRLabel (&record_lab,record_sdef); + + GenBuildhr (&record_lab,asize,bsize); +} + void PackArgument (StateS argstate,int aindex,int bindex,int asp,int bsp,int offasize,int offbsize) { if (IsSimpleState (argstate)){ @@ -610,8 +627,7 @@ void PackArgument (StateS argstate,int aindex,int bindex,int asp,int bsp,int off offasize,offbsize,asp,NormalFill,True); return; case RecordState: - BuildRecord (argstate.state_record_symbol,aindex, bindex, asp, bsp, - offasize,offbsize,asp,NormalFill,True); + BuildNewRecord (argstate.state_record_symbol,aindex,bindex,asp,bsp,offasize,offbsize); return; case ArrayState: GenBuildArray (asp - aindex); @@ -686,13 +702,14 @@ void CoerceArgumentOnTopOfStack (int *asp_p,int *bsp_p,StateS argstate,StateS no *asp_p+=1; GenUpdatePopA (0,asize); *asp_p-=asize; + GenPopB (bsize); + *bsp_p-=bsize; break; case RecordState: - BuildRecord (nodestate.state_record_symbol,*asp_p,*bsp_p,*asp_p,*bsp_p, - asize,bsize,*asp_p,NormalFill,True); + BuildNewRecordPop (nodestate.state_record_symbol,asize,bsize); *asp_p+=1; - GenUpdatePopA (0,asize); *asp_p-=asize; + *bsp_p-=bsize; break; case ArrayState: if (asize==1) @@ -703,10 +720,10 @@ void CoerceArgumentOnTopOfStack (int *asp_p,int *bsp_p,StateS argstate,StateS no GenUpdatePopA (0,asize); *asp_p-=asize; } + GenPopB (bsize); + *bsp_p-=bsize; break; } - GenPopB (bsize); - *bsp_p-=bsize; } else { if (argstate.state_type==TupleState) AdjustTuple (asize,bsize,asp_p,bsp_p,argstate.state_arity, @@ -1782,7 +1799,7 @@ static void FillOrReduceFieldSelection (Node node,SymbDef seldef,int *asp_p,int *asp_p+=a_size; *bsp_p+=b_size; - CoerceArgumentOnTopOfStack (asp_p,bsp_p, node->node_state,record_sdef->sdef_record_state.state_record_arguments [fieldnr],a_size,b_size); + CoerceArgumentOnTopOfStack (asp_p,bsp_p,node->node_state,record_sdef->sdef_record_state.state_record_arguments[fieldnr],a_size,b_size); decrement_reference_count_of_node_id (arg_node_id,&code_gen_node_ids_p->free_node_ids); } } @@ -2716,7 +2733,7 @@ static void FillSymbol (Node node,SymbDef sdef,int *asp_p,int *bsp_p,NodeId upda *bsp_p-=bsize; if (update_node_id==NULL){ - GenBuildR (&record_label,asize,bsize,0,0,True); + GenBuildhr (&record_label,asize,bsize); *asp_p+=1; } else { GenFillR (&record_label,asize,bsize,*asp_p+asize-update_node_id->nid_a_index,0,0,node->node_state.state_kind==SemiStrict ? ReleaseAndFill : NormalFill,True); @@ -2788,7 +2805,7 @@ static void FillSymbol (Node node,SymbDef sdef,int *asp_p,int *bsp_p,NodeId upda if (update_node_id==NULL){ *asp_p+=1; - GenBuildR (&record_label,asize,bsize,0,0,True); + GenBuildhr (&record_label,asize,bsize); } else { GenFillR (&record_label,asize,bsize,*asp_p+asize-update_node_id->nid_a_index,0,0,node->node_state.state_kind==SemiStrict ? ReleaseAndFill : NormalFill,True); } @@ -3249,8 +3266,8 @@ void push_rational (SymbolP symb) ConvertSymbolToRLabel (&integer_record_lab,BasicSymbolStates [integer_denot].state_record_symbol); GenPushZR (symb->symb_val); - GenBuildR (&integer_record_lab,1,1,1,1,False); - GenBuildR (&integer_record_lab,1,1,0+1,0,False); + GenBuildR (&integer_record_lab,1,1,1,1); + GenBuildR (&integer_record_lab,1,1,0+1,0); GenPopB (2); GenUpdateA (1,3); GenUpdateA (0,2); @@ -3416,7 +3433,7 @@ static void FillNormalNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i if (update_node_id==NULL){ *asp_p+=1-a_size; if (symb->symb_head_strictness==4) - GenBuildR (strict_cons_lab_p,a_size,b_size,0,0,True); + GenBuildhr (strict_cons_lab_p,a_size,b_size); else GenBuildh (node->node_arity==2 ? &cons_lab : strict_cons_lab_p,a_size); } else { @@ -3478,7 +3495,7 @@ static void FillNormalNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i ConvertSymbolToRLabel (&record_lab,BasicSymbolStates [integer_denot].state_record_symbol); if (update_node_id==NULL) - GenBuildR (&record_lab,1,1,0,0,True); + GenBuildhr (&record_lab,1,1); else { GenFillR (&record_lab,1,1,*asp_p-update_node_id->nid_a_index,0,0,node->node_state.state_kind==SemiStrict ? ReleaseAndFill : NormalFill,True); *asp_p-=1; @@ -3495,7 +3512,7 @@ static void FillNormalNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i ConvertSymbolToKLabel (&ratio_record_lab,special_types[1]->sdef_type->type_constructors->cl_constructor->type_node_symbol->symb_def); if (update_node_id==NULL){ - GenBuildR (&ratio_record_lab,2,0,0,0,True); + GenBuildhr (&ratio_record_lab,2,0); *asp_p+=1; } else { GenFillR (&ratio_record_lab,2,0,*asp_p+2-update_node_id->nid_a_index,0,0,node->node_state.state_kind==SemiStrict ? ReleaseAndFill : NormalFill,True); @@ -4136,19 +4153,20 @@ static void FillUpdateNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i record_state_p->state_record_arguments,record_a_size,record_b_size,&end_args_a_offset,&end_args_b_offset); if (update_node_id==NULL){ - BuildRecord (record_state_p->state_record_symbol,*asp_p,*bsp_p,*asp_p,*bsp_p,record_a_size,record_b_size, - 0,node->node_state.state_kind==SemiStrict ? PartialFill : NormalFill,True); - GenUpdatePopA (0,end_args_a_offset); + BuildNewRecordPop (record_state_p->state_record_symbol,record_a_size,record_b_size); + GenUpdatePopA (0,end_args_a_offset-record_a_size); + GenPopB (end_args_b_offset-record_b_size); *asp_p+=1-end_args_a_offset; + *bsp_p-=end_args_b_offset; } else { BuildRecord (record_state_p->state_record_symbol,*asp_p,*bsp_p,*asp_p,*bsp_p,record_a_size,record_b_size, *asp_p-update_node_id->nid_a_index,node->node_state.state_kind==SemiStrict ? PartialFill : NormalFill,False); GenPopA (end_args_a_offset); *asp_p-=end_args_a_offset; - } GenPopB (end_args_b_offset); *bsp_p-=end_args_b_offset; } + } return; #if DESTRUCTIVE_RECORD_UPDATES diff --git a/backendC/CleanCompilerSources/codegen2.h b/backendC/CleanCompilerSources/codegen2.h index 8cfca197c595aaf1b3d075f9bfdde05f220851fa..4a8fcbc502ae04e9a804f88f453bae15756d0a38 100644 --- a/backendC/CleanCompilerSources/codegen2.h +++ b/backendC/CleanCompilerSources/codegen2.h @@ -46,6 +46,8 @@ extern void BuildTuple (int aindex, int bindex, int asp, int bsp, int arity, extern void BuildRecord (SymbDef seldef, int aindex, int bindex, int asp, int bsp, int asize, int bsize, int rootindex,FillKind fkind, Bool popargs); +extern void BuildNewRecord (SymbDef seldef, int aindex, int bindex, int asp, int bsp, int asize, int bsize); +extern void BuildNewRecordPop (SymbDef seldef, int asize, int bsize); extern void CoerceArgumentUsingStackFrames (StateS demstate, StateS offstate, int aindex,int bindex,int *asp,int *bsp,int *anext,int *bnext,int asize,int bsize); extern void DetermineArrayElemDescr (StateS elemstate, Label lab); diff --git a/backendC/CleanCompilerSources/codegen3.c b/backendC/CleanCompilerSources/codegen3.c index b16dd227eb1e0506551d20b5c41837bd8f184ce2..b39244c018d2e0d2f7477dc8841c3788ec8dfc0a 100644 --- a/backendC/CleanCompilerSources/codegen3.c +++ b/backendC/CleanCompilerSources/codegen3.c @@ -256,11 +256,16 @@ void RedirectResultAndReturn (int asp,int bsp,int source_a_index,int source_b_in offstate.state_arity, offstate.state_tuple_arguments, offasize, offbsize, 0, ReleaseAndFill,True); GenUpdatePopA (0,asp); + GenPopB (bsp); break; case RecordState: - BuildRecord (offstate.state_record_symbol,source_a_index,source_b_index, asp, bsp, - offasize, offbsize, 0, ReleaseAndFill,True); + if (source_a_index==asp && (source_b_index==bsp || offbsize==0)) + BuildNewRecordPop (offstate.state_record_symbol,offasize,offbsize); + else { + BuildNewRecord (offstate.state_record_symbol,source_a_index,source_b_index,asp,bsp,offasize,offbsize); GenUpdatePopA (0,asp); + GenPopB (bsp); + } break; case ArrayState: if (asp==source_a_index && asp==1) @@ -268,9 +273,9 @@ void RedirectResultAndReturn (int asp,int bsp,int source_a_index,int source_b_in else { GenBuildArray (asp-source_a_index); GenUpdatePopA (0,asp); - } } GenPopB (bsp); + } } else { switch (offstate.state_type){ case TupleState: @@ -977,7 +982,7 @@ static void CodeNormalRootNode (Node root,NodeId rootid,int asp,int bsp,CodeGenN LabDef record_lab; ConvertSymbolToRLabel (&record_lab,BasicSymbolStates [integer_denot].state_record_symbol); - GenBuildR (&record_lab,1,1,0,0,True); + GenBuildhr (&record_lab,1,1); GenRtn (1,0,OnAState); } else GenRtn (1,1,resultstate); @@ -1434,12 +1439,12 @@ static void CodeRootUpdateNode (Node root,NodeId rootid,int asp,int bsp,CodeGenN BuildRecord (record_state_p->state_record_symbol,asp,bsp,asp,bsp,record_a_size,record_b_size, 0,ReleaseAndFill,False); GenPopA (asp); + GenPopB (bsp); } else { - BuildRecord (record_state_p->state_record_symbol,asp,bsp,asp,bsp,record_a_size,record_b_size, - asp,NormalFill,True); - GenUpdatePopA (0,asp); + BuildNewRecordPop (record_state_p->state_record_symbol,record_a_size,record_b_size); + GenUpdatePopA (0,asp-record_a_size); + GenPopB (bsp-record_b_size); } - GenPopB (bsp); GenRtn (1,0,OnAState); function_called_only_curried_or_lazy_with_one_return = 0; diff --git a/backendC/CleanCompilerSources/instructions.c b/backendC/CleanCompilerSources/instructions.c index 8dcaaf3ed22af46706fca370da516416d3274ae8..a96cb8ce1ca259f8cb2165c8daf5f3df7208a057 100644 --- a/backendC/CleanCompilerSources/instructions.c +++ b/backendC/CleanCompilerSources/instructions.c @@ -610,6 +610,7 @@ enum { #define Ifill2_r "fill2_r" #define Ifill3_r "fill3_r" +#define Ibuildhr "buildhr" #define Ibuild_r "build_r" #define Ifill_a "fill_a" @@ -2080,7 +2081,19 @@ void GenFill3R (Label symblab,int n_a_args,int n_b_args,int rootoffset,char bits FPrintF (OutFile, " %d %d %d %s",n_a_args,n_b_args,rootoffset,bits); } -void GenBuildR (Label symblab,int nr_a_args,int nr_b_args,int a_offset,int b_offset,Bool pop_args) +void GenBuildhr (Label symblab,int nr_a_args,int nr_b_args) +{ + put_instruction_ (Ibuildhr); + + if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenLabel (symblab); + else + FPutS (empty_lab.lab_name, OutFile); + + FPrintF (OutFile, " %d %d",nr_a_args,nr_b_args); +} + +void GenBuildR (Label symblab,int nr_a_args,int nr_b_args,int a_offset,int b_offset) { put_instruction_ (Ibuild_r); @@ -2095,12 +2108,6 @@ void GenBuildR (Label symblab,int nr_a_args,int nr_b_args,int a_offset,int b_off b_offset=0; FPrintF (OutFile, " %d %d %d %d",nr_a_args,nr_b_args,a_offset,b_offset); - - if (pop_args){ - if (nr_a_args>0) - GenUpdatePopA (0,nr_a_args); - GenPopB (nr_b_args); - } } void GenFillFromA (int src, int dst, FillKind fkind) diff --git a/backendC/CleanCompilerSources/instructions.h b/backendC/CleanCompilerSources/instructions.h index a3464b970f4db19198aaa57d0277dcb47bca0bdf..17b8d647284e50ed36738595013845769dafdba9 100644 --- a/backendC/CleanCompilerSources/instructions.h +++ b/backendC/CleanCompilerSources/instructions.h @@ -80,7 +80,8 @@ void GenFillR (Label symblab,int nr_a_args,int nr_b_args,int rootoffset,int a_of void GenFill1R (Label symblab,int n_a_args,int n_b_args,int rootoffset,char bits[]); void GenFill2R (Label symblab,int n_a_args,int n_b_args,int rootoffset,char bits[]); void GenFill3R (Label symblab,int n_a_args,int n_b_args,int rootoffset,char bits[]); -void GenBuildR (Label symblab,int nr_a_args,int nr_b_args,int a_offset,int b_offset,Bool pop_args); +void GenBuildhr (Label symblab,int nr_a_args,int nr_b_args); +void GenBuildR (Label symblab,int nr_a_args,int nr_b_args,int a_offset,int b_offset); void GenFillArrayAndPop (int rootoffset, FillKind fkind); void GenFillArray (int argoffset, int rootoffset, FillKind fkind);