diff options
| -rw-r--r-- | backendC/CleanCompilerSources/codegen1.c | 93 | ||||
| -rw-r--r-- | backendC/CleanCompilerSources/codegen2.c | 444 | ||||
| -rw-r--r-- | backendC/CleanCompilerSources/instructions.c | 218 | ||||
| -rw-r--r-- | backendC/CleanCompilerSources/instructions.h | 4 |
4 files changed, 696 insertions, 63 deletions
diff --git a/backendC/CleanCompilerSources/codegen1.c b/backendC/CleanCompilerSources/codegen1.c index f41f5a8..69bd411 100644 --- a/backendC/CleanCompilerSources/codegen1.c +++ b/backendC/CleanCompilerSources/codegen1.c @@ -258,7 +258,10 @@ void BuildLazyTupleSelectorLabel (Label slab, int arity, int argnr) void BuildLazyTupleSelectorAndRemoveLabel (Label slab,int arity,int argnr) { if (argnr > NrOfGlobalSelectors){ + MakeLabel (slab,glob_selr,argnr,n_pref); +#if 0 error_in_function ("BuildLazyTupleSelectorAndRemoveLabel"); +#endif } else MakeLabel (slab,glob_selr,argnr,n_pref); } @@ -892,7 +895,7 @@ static void GenLazyRecordEntry (SymbDef rdef) GenLazyRecordDescriptorAndExport (rdef); - GenNodeEntryDirective (arity,&d_label,NULL); + GenLazyRecordNodeEntryDirective (arity,&d_label); GenOAStackLayout (1); GenLabelDefinition (&CurrentAltLabel); @@ -1222,7 +1225,7 @@ Bool NodeEntry (StateS *const function_state_p,int arity,Label ealab,SymbDef roo GenNodeEntryDirective (arity,&d_lab,ea_label_in_node_directive); GenOAStackLayout (1); - GenLabelDefinition (&n_lab); + GenNodeEntryLabelDefinition (&n_lab); GenPushNode (ReduceError,arity); if (! update_root_node) @@ -1380,7 +1383,7 @@ Bool NodeEntryUnboxed (StateS *const function_state_p,NodeP call_node_p,int args GenNodeEntryDirective (args_a_size,&d_lab,ea_label_in_node_directive); GenOAStackLayout (1); - GenLabelDefinition (&n_lab); + GenNodeEntryLabelDefinition (&n_lab); if (args_b_size!=0) GenPushNodeU (ReduceError,args_a_size,args_b_size); else @@ -1826,7 +1829,7 @@ static void GenerateCodeForLazyTupleSelectorEntry (int argnr) GenPushArg (0,1,1); GenPushA (2); GenKeep (1,0); - GenFill (& ind_lab, -2, & indirection_lab, 2, PartialFill); + GenFill (& ind_lab, -2, &indirection_lab, 2, PartialFill); GenKeep (1,0); #if UPDATE_POP GenUpdatePopA (0, 1); @@ -1922,7 +1925,11 @@ ImpRuleP create_simple_imp_rule (NodeP lhs_root,NodeP rhs_root,SymbDefP function return imp_rule; } -SymbDef CreateUpdateFunction (ArgS *record_arg,ArgS *first_field_arg,Node node) +SymbDef CreateUpdateFunction (ArgS *record_arg,ArgS *first_field_arg,Node node +#if UNBOX_UPDATE_FUNCTION_ARGUMENTS + ,int unbox_record +#endif + ) { static char update_function_name[16]; SymbDef update_function_sdef; @@ -1938,7 +1945,12 @@ SymbDef CreateUpdateFunction (ArgS *record_arg,ArgS *first_field_arg,Node node) ++next_update_function_n; n_arguments=node->node_arity; - + record_state=node->node_symbol->symb_def->sdef_record_state; +#if UNBOX_UPDATE_FUNCTION_ARGUMENTS + if (unbox_record) + n_arguments=record_state.state_arity; +#endif + update_function_ident=PutStringInHashTable (update_function_name,SymbolIdTable); update_function_sdef=MakeNewSymbolDefinition (CurrentModule,update_function_ident,n_arguments,IMPRULE); @@ -1957,14 +1969,72 @@ SymbDef CreateUpdateFunction (ArgS *record_arg,ArgS *first_field_arg,Node node) update_function_symbol=NewSymbol (definition); update_function_symbol->symb_def=update_function_sdef; +#if UNBOX_UPDATE_FUNCTION_ARGUMENTS + if (unbox_record){ + ArgS **lhs_new_fields_arg_p,**lhs_old_fields_arg_p,*lhs_new_fields_p,**rhs_arg_p; + int field_number; + + lhs_root=NewNode (update_function_symbol,NULL,n_arguments); +#if UPDATE_NODE_IN_STRICT_ENTRY + lhs_root->node_state=StrictState; +#else + lhs_root->node_state=record_state; +#endif + + rhs_root=NewNode (node->node_symbol,NULL,n_arguments); +#if UPDATE_NODE_IN_STRICT_ENTRY + rhs_root->node_state=StrictState; +#else + rhs_root->node_state=record_state; +#endif + rhs_root->node_number=0; + + lhs_old_fields_arg_p=&lhs_root->node_arguments; + lhs_new_fields_arg_p=&lhs_new_fields_p; + rhs_arg_p=&rhs_root->node_arguments; + + for (field_number=0; field_number<n_arguments; ++field_number){ + ArgS *rhs_arg,*lhs_arg; + NodeId arg_node_id; + StateS *state_p; + + state_p=&record_state.state_record_arguments [field_number]; + + arg_node_id=NewNodeId (NULL); + arg_node_id->nid_refcount=-2; + + lhs_arg=NewArgument (NewNodeIdNode (arg_node_id)); + lhs_arg->arg_state=LazyState; + + rhs_arg=NewArgument (NewNodeIdNode (arg_node_id)); + rhs_arg->arg_state=*state_p; + + *rhs_arg_p=rhs_arg; + rhs_arg_p=&rhs_arg->arg_next; + + if (first_field_arg==NULL || first_field_arg->arg_node->node_symbol->symb_def->sdef_sel_field_number!=field_number){ + *lhs_old_fields_arg_p=lhs_arg; + lhs_old_fields_arg_p=&lhs_arg->arg_next; + + lhs_arg->arg_state=*state_p; + } else { + *lhs_new_fields_arg_p=lhs_arg; + lhs_new_fields_arg_p=&lhs_arg->arg_next; + + first_field_arg=first_field_arg->arg_next; + } + } + *lhs_old_fields_arg_p=lhs_new_fields_p; + *lhs_new_fields_arg_p=NULL; + *rhs_arg_p=NULL; + } else +#endif { NodeId record_node_id; ArgS *lhs_record_arg,*rhs_record_arg,**lhs_arg_p,**rhs_arg_p; record_node_id=NewNodeId (NULL); record_node_id->nid_refcount=-1; - - record_state=node->node_symbol->symb_def->sdef_record_state; lhs_record_arg=NewArgument (NewNodeIdNode (record_node_id)); lhs_record_arg->arg_state=LazyState; @@ -2017,14 +2087,15 @@ SymbDef CreateUpdateFunction (ArgS *record_arg,ArgS *first_field_arg,Node node) lhs_arg_p=&lhs_arg->arg_next; rhs_arg_p=&rhs_arg->arg_next; - +#if !UNBOX_UPDATE_FUNCTION_ARGUMENTS field_node->node_arguments->arg_next=NULL; - previous_arg->arg_next=arg; +#endif previous_arg=arg; } +#if !UNBOX_UPDATE_FUNCTION_ARGUMENTS previous_arg->arg_next=NULL; - +#endif *lhs_arg_p=NULL; *rhs_arg_p=NULL; } diff --git a/backendC/CleanCompilerSources/codegen2.c b/backendC/CleanCompilerSources/codegen2.c index f1f738b..b5372fe 100644 --- a/backendC/CleanCompilerSources/codegen2.c +++ b/backendC/CleanCompilerSources/codegen2.c @@ -1565,6 +1565,8 @@ static void FillOrReduceSelectSymbol (Node node,int *asp_p,int *bsp_p,NodeId upd GenFill1 (&tuple_lab,arity,*asp_p+1-tupindex,bits); else GenFill2 (&tuple_lab,arity,*asp_p+1-tupindex,bits); + + GenKeep (*asp_p-tupindex,0); } else { GenPushArg (*asp_p-tupindex,arity,argnr); *asp_p+=1; @@ -2148,10 +2150,7 @@ static void FillSymbol (Node node,SymbDef sdef,int *asp_p,int *bsp_p,NodeId upda DetermineSizeOfArguments (node->node_arguments,&a_size,&b_size); - if (b_size!=0) - BuildArgs (node->node_arguments,asp_p,bsp_p,code_gen_node_ids_p); - else - BuildArgs (node->node_arguments,asp_p,bsp_p,code_gen_node_ids_p); + BuildArgs (node->node_arguments,asp_p,bsp_p,code_gen_node_ids_p); #if OPTIMIZE_LAZY_TUPLE_RECURSION if (update_node_id!=NULL){ @@ -2438,7 +2437,7 @@ static void FillSymbol (Node node,SymbDef sdef,int *asp_p,int *bsp_p,NodeId upda if (update_node_id==NULL){ *asp_p+=1-node->node_arity; - GenBuildh (&name,node->node_arity); + GenBuildPartialFunctionh (&name,node->node_arity); } else { GenFillh (&name,node->node_arity,*asp_p-update_node_id->nid_a_index,NormalFill); *asp_p-=node->node_arity; @@ -2870,6 +2869,110 @@ void RemoveSelectorsFromUpdateNode (ArgS *previous_arg,ArgS *arg) previous_arg->arg_next=NULL; } +#if UPDATE_RECORD_NOT_ON_TOP +void UpdateRecordAndAddSelectorsToUpdateNode + (ArgS *record_arg,ArgS *first_field_arg,StateS *field_states,int record_a_size,int record_b_size,int *n_a_elements_above_record_p,int *n_b_elements_above_record_p) +{ + ArgS *arg,*previous_arg; + int a_offset,b_offset,arg_a_offset,arg_b_offset,previous_field_number; + + a_offset=0; + b_offset=0; + arg_a_offset=record_a_size; + arg_b_offset=record_b_size; + + previous_field_number=0; + + previous_arg=record_arg; + for_l (arg,first_field_arg,arg_next){ + int field_number,arg_a_size,arg_b_size; + Node field_node; + + field_node=arg->arg_node; + field_node->node_arguments->arg_next=NULL; + + field_number=field_node->node_symbol->symb_def->sdef_sel_field_number; + + while (field_number!=previous_field_number){ + AddSizeOfState (field_states[previous_field_number],&a_offset,&b_offset); + ++previous_field_number; + } + + DetermineSizeOfState (field_states[field_number],&arg_a_size,&arg_b_size); + + while (arg_a_size){ + GenUpdateA (arg_a_offset,a_offset); + ++arg_a_offset; + ++a_offset; + --arg_a_size; + } + + while (arg_b_size){ + GenUpdateB (arg_b_offset,b_offset); + ++arg_b_offset; + ++b_offset; + --arg_b_size; + } + + ++previous_field_number; + + previous_arg->arg_next=arg; + previous_arg=arg; + } + previous_arg->arg_next=NULL; + + *n_a_elements_above_record_p = arg_a_offset-record_a_size; + *n_b_elements_above_record_p = arg_b_offset-record_b_size; +} + +void RemoveFieldsFromStackAfterUpdate (int n_a_elements_above_record,int n_b_elements_above_record,int record_a_size,int record_b_size,int *asp_p,int *bsp_p) +{ + if (n_a_elements_above_record!=0){ + int arg_a_offset,a_offset; + + arg_a_offset=record_a_size+n_a_elements_above_record; + a_offset=record_a_size; + while (a_offset>0){ + --a_offset; + --arg_a_offset; +#if UPDATE_POP + if (a_offset==0) + GenUpdatePopA (a_offset,arg_a_offset); + else +#endif + GenUpdateA (a_offset,arg_a_offset); + } +#if UPDATE_POP + if (record_a_size==0) +#endif + GenPopA (arg_a_offset); + + *asp_p -= arg_a_offset; + } + + if (n_b_elements_above_record!=0){ + int arg_b_offset,b_offset; + + arg_b_offset=record_b_size+n_b_elements_above_record; + b_offset=record_b_size; + while (b_offset>0){ + --b_offset; + --arg_b_offset; +#if UPDATE_POP + if (b_offset==0) + GenUpdatePopB (b_offset,arg_b_offset); + else +#endif + GenUpdateB (b_offset,arg_b_offset); + } +#if UPDATE_POP + if (record_b_size==0) +#endif + GenPopB (arg_b_offset); + *bsp_p -= arg_b_offset; + } +} +#else void UpdateNodeAndAddSelectorsToUpdateNode (ArgS *record_arg,ArgS *first_field_arg,StateS *field_states,int record_a_size,int record_b_size,int *asp_p,int *bsp_p) { @@ -2960,15 +3063,16 @@ void UpdateNodeAndAddSelectorsToUpdateNode *bsp_p -= arg_b_offset; } } +#endif #ifdef DESTRUCTIVE_RECORD_UPDATES -void compute_bits_and_add_selectors_to_update_node +static 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) { ArgP arg,previous_arg; int a_offset,b_offset,previous_field_number; - unsigned int a_bits,b_bits,n,arg_n,n_args; + unsigned int a_bits,b_bits,n; int n_a_fill_bits,n_b_fill_bits; a_bits=0; @@ -3037,6 +3141,41 @@ void compute_bits_and_add_selectors_to_update_node } #endif +#if UNBOX_UPDATE_FUNCTION_ARGUMENTS +static void remove_updated_fields_from_record (int field_number,ArgP field_arg,int a_from_offset,int b_from_offset,int *a_to_offset_p,int *b_to_offset_p,int n_fields,StateP field_states) +{ + if (field_number<n_fields){ + int field_a_size,field_b_size; + + DetermineSizeOfState (field_states[field_number],&field_a_size,&field_b_size); + + a_from_offset+=field_a_size; + b_from_offset+=field_b_size; + + if (field_arg==NULL || field_arg->arg_node->node_symbol->symb_def->sdef_sel_field_number!=field_number){ + remove_updated_fields_from_record (field_number+1,field_arg,a_from_offset,b_from_offset,a_to_offset_p,b_to_offset_p,n_fields,field_states); + + while (field_a_size){ + --a_from_offset; + --*a_to_offset_p; + if (a_from_offset!=*a_to_offset_p) + GenUpdateA (a_from_offset,*a_to_offset_p); + --field_a_size; + } + + while (field_b_size){ + --b_from_offset; + --*b_to_offset_p; + if (b_from_offset!=*b_to_offset_p) + GenUpdateB (b_from_offset,*b_to_offset_p); + --field_b_size; + } + } else + remove_updated_fields_from_record (field_number+1,field_arg->arg_next,a_from_offset,b_from_offset,a_to_offset_p,b_to_offset_p,n_fields,field_states); + } +} +#endif + static void FillUpdateNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_id,CodeGenNodeIdsP code_gen_node_ids_p) { ArgS *record_arg,*first_field_arg; @@ -3150,24 +3289,42 @@ static void FillUpdateNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i BuildArgs (node->node_arguments,asp_p,bsp_p,code_gen_node_ids_p); DetermineSizeOfState (*record_node_id_state_p,&record_a_size,&record_b_size); - + +#if UPDATE_RECORD_NOT_ON_TOP + { + int n_a_elements_above_record,n_b_elements_above_record; + + UpdateRecordAndAddSelectorsToUpdateNode (record_arg,first_field_arg, + record_node_id_state_p->state_record_arguments,record_a_size,record_b_size,&n_a_elements_above_record,&n_b_elements_above_record); +#else UpdateNodeAndAddSelectorsToUpdateNode (record_arg,first_field_arg, record_node_id_state_p->state_record_arguments,record_a_size,record_b_size,asp_p,bsp_p); - +#endif if (update_node_id==NULL){ BuildRecord (record_node_id_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); *asp_p+=1; +#if UPDATE_RECORD_NOT_ON_TOP + GenUpdateA (0,record_a_size+n_a_elements_above_record); +#else GenUpdateA (0,record_a_size); +#endif } else BuildRecord (record_node_id_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); +#if UPDATE_RECORD_NOT_ON_TOP + GenPopA (record_a_size+n_a_elements_above_record); + *asp_p-=record_a_size+n_a_elements_above_record; + GenPopB (record_b_size+n_b_elements_above_record); + *bsp_p-=record_b_size+n_b_elements_above_record; + } +#else GenPopA (record_a_size); *asp_p-=record_a_size; GenPopB (record_b_size); *bsp_p-=record_b_size; - +#endif return; } #else @@ -3192,7 +3349,7 @@ static void FillUpdateNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i if (!FieldArgumentNodeStatesAreStricter (record_arg->arg_next,first_field_arg,record_states)) update_immediately=0; - else { + else { ArgP node_arg,field_arg; for_ll (node_arg,field_arg,record_arg->arg_next,first_field_arg,arg_next,arg_next){ @@ -3220,23 +3377,41 @@ static void FillUpdateNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i DetermineSizeOfState (*record_node_id_state_p,&record_a_size,&record_b_size); +#if UPDATE_RECORD_NOT_ON_TOP + { + int n_a_elements_above_record,n_b_elements_above_record; + + UpdateRecordAndAddSelectorsToUpdateNode (record_arg,first_field_arg, + record_node_id_state_p->state_record_arguments,record_a_size,record_b_size,&n_a_elements_above_record,&n_b_elements_above_record); +#else UpdateNodeAndAddSelectorsToUpdateNode (record_arg,first_field_arg, record_node_id_state_p->state_record_arguments,record_a_size,record_b_size,asp_p,bsp_p); - +#endif if (update_node_id==NULL){ BuildRecord (record_node_id_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); *asp_p+=1; +#if UPDATE_RECORD_NOT_ON_TOP + GenUpdateA (0,record_a_size+n_a_elements_above_record); +#else GenUpdateA (0,record_a_size); +#endif } else BuildRecord (record_node_id_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); +#if UPDATE_RECORD_NOT_ON_TOP + GenPopA (record_a_size+n_a_elements_above_record); + *asp_p-=record_a_size+n_a_elements_above_record; + GenPopB (record_b_size+n_b_elements_above_record); + *bsp_p-=record_b_size+n_b_elements_above_record; + } +#else GenPopA (record_a_size); *asp_p-=record_a_size; GenPopB (record_b_size); *bsp_p-=record_b_size; - +#endif return; } } @@ -3245,9 +3420,242 @@ static void FillUpdateNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i n_arguments=node->node_arity; +#if UNBOX_UPDATE_FUNCTION_ARGUMENTS + if (update_node_id==NULL){ + ArgP call_arg_p,lhs_arg_p,rhs_arg_p,*call_arg_h; + StateP record_state_p; + int i,unbox_record; + ImpRuleP update_rule_p; + NodeP call_node_p; + + call_arg_p=node->node_arguments; + + unbox_record = call_arg_p->arg_node->node_kind!=NodeIdNode ? + call_arg_p->arg_node->node_state.state_type==RecordState : + call_arg_p->arg_node->node_node_id->nid_state.state_type==RecordState; + + new_update_sdef=CreateUpdateFunction (record_arg,first_field_arg,node,unbox_record); + + update_rule_p=new_update_sdef->sdef_rule; + + lhs_arg_p=update_rule_p->rule_alts->alt_lhs_root->node_arguments; + rhs_arg_p=update_rule_p->rule_alts->alt_rhs_root->node_arguments; + i=0; + + record_state_p=&node->node_symbol->symb_def->sdef_record_state; + + if (unbox_record){ + int record_size,n_old_fields,field_number; + ArgP field_arg_p; + + record_size=record_state_p->state_arity; + + n_old_fields=record_size-(node->node_arity-1); + + call_node_p=NewNode (NULL,NULL,record_size); + call_arg_h=&call_node_p->node_arguments; + + field_arg_p=first_field_arg; + field_number=0; + + while (n_old_fields){ + if (field_arg_p==NULL || field_arg_p->arg_node->node_symbol->symb_def->sdef_sel_field_number!=field_number){ + StateP arg_state_p; + NodeP new_node_p; + ArgP new_arg_p; + + new_node_p=NewNode (NULL,NULL,0); + new_arg_p=NewArgument (new_node_p); + + arg_state_p=&record_state_p->state_record_arguments[field_number]; + + new_arg_p->arg_state=*arg_state_p; + new_node_p->node_state=*arg_state_p; + lhs_arg_p->arg_state=*arg_state_p; + update_rule_p->rule_state_p[i]=*arg_state_p; + + *call_arg_h=new_arg_p; + call_arg_h=&new_arg_p->arg_next; + + lhs_arg_p=lhs_arg_p->arg_next; + ++i; + --n_old_fields; + } else + field_arg_p=field_arg_p->arg_next; + + ++field_number; + } + + call_arg_p->arg_state=*record_state_p; + + call_arg_p=call_arg_p->arg_next; + *call_arg_h=call_arg_p; + + while (call_arg_p!=NULL){ + StateP arg_state_p; + + while (rhs_arg_p->arg_node->node_node_id!=lhs_arg_p->arg_node->node_node_id) + rhs_arg_p=rhs_arg_p->arg_next; + + if (call_arg_p->arg_node->node_kind!=NodeIdNode) + arg_state_p=&call_arg_p->arg_node->node_state; + else + arg_state_p=&call_arg_p->arg_node->node_node_id->nid_state; + + if (rhs_arg_p->arg_state.state_type==SimpleState){ + if (rhs_arg_p->arg_state.state_kind==OnB && (arg_state_p->state_type==SimpleState && arg_state_p->state_kind==OnB)){ + call_arg_p->arg_state=*arg_state_p; + lhs_arg_p->arg_state=*arg_state_p; + update_rule_p->rule_state_p[i]=*arg_state_p; + } else if (!IsLazyState (*arg_state_p) && !IsLazyStateKind (rhs_arg_p->arg_state.state_kind)){ + lhs_arg_p->arg_state.state_kind=StrictOnA; + update_rule_p->rule_state_p[i].state_kind=StrictOnA; + } + } else { + if ((rhs_arg_p->arg_state.state_type==ArrayState && arg_state_p->state_type==ArrayState) || + (rhs_arg_p->arg_state.state_type==RecordState && arg_state_p->state_type==RecordState)) + { + call_arg_p->arg_state=*arg_state_p; + lhs_arg_p->arg_state=*arg_state_p; + update_rule_p->rule_state_p[i]=*arg_state_p; + } else if (!IsLazyState (*arg_state_p)){ + lhs_arg_p->arg_state.state_kind=StrictOnA; + update_rule_p->rule_state_p[i].state_kind=StrictOnA; + } + } + call_arg_p=call_arg_p->arg_next; + lhs_arg_p=lhs_arg_p->arg_next; + rhs_arg_p=rhs_arg_p->arg_next; + ++i; + } + } else { + while (call_arg_p!=NULL){ + StateP arg_state_p; + + if (call_arg_p->arg_node->node_kind!=NodeIdNode) + arg_state_p=&call_arg_p->arg_node->node_state; + else + arg_state_p=&call_arg_p->arg_node->node_node_id->nid_state; + + if (rhs_arg_p->arg_state.state_type==SimpleState){ + if (rhs_arg_p->arg_state.state_kind==OnB && (arg_state_p->state_type==SimpleState && arg_state_p->state_kind==OnB)){ + call_arg_p->arg_state=*arg_state_p; + lhs_arg_p->arg_state=*arg_state_p; + update_rule_p->rule_state_p[i]=*arg_state_p; + } else if (!IsLazyState (*arg_state_p) && !IsLazyStateKind (rhs_arg_p->arg_state.state_kind)){ + lhs_arg_p->arg_state.state_kind=StrictOnA; + update_rule_p->rule_state_p[i].state_kind=StrictOnA; + } + } else { + if ((rhs_arg_p->arg_state.state_type==ArrayState && arg_state_p->state_type==ArrayState) || + (rhs_arg_p->arg_state.state_type==RecordState && arg_state_p->state_type==RecordState)) + { + call_arg_p->arg_state=*arg_state_p; + lhs_arg_p->arg_state=*arg_state_p; + update_rule_p->rule_state_p[i]=*arg_state_p; + } else if (!IsLazyState (*arg_state_p)){ + lhs_arg_p->arg_state.state_kind=StrictOnA; + update_rule_p->rule_state_p[i].state_kind=StrictOnA; + } + } + call_arg_p=call_arg_p->arg_next; + lhs_arg_p=lhs_arg_p->arg_next; + rhs_arg_p=rhs_arg_p->arg_next; + ++i; + } + { + ArgP arg1_p; + + arg1_p=NewArgument (NULL); + *arg1_p=*node->node_arguments; + + call_node_p=NewNode (NULL,arg1_p,node->node_arity); + call_arg_h=&arg1_p->arg_next; + } + } + + while (*call_arg_h){ + ArgP new_call_arg_p; + NodeP new_node_p; + + new_node_p=NewNode (NULL,NULL,0); + new_call_arg_p=NewArgument (NULL); + *new_call_arg_p=**call_arg_h; + + new_call_arg_p->arg_node=new_node_p; + new_node_p->node_state=(*call_arg_h)->arg_state; + + new_call_arg_p->arg_next=(*call_arg_h)->arg_next; + + *call_arg_h=new_call_arg_p; + call_arg_h=&new_call_arg_p->arg_next; + } + + update_rule_p->rule_mark |= RULE_UNBOXED_LAZY_CALL; + update_rule_p->rule_lazy_call_node=call_node_p; + + BuildArgs (node->node_arguments,asp_p,bsp_p,code_gen_node_ids_p); + + { + int a_size,b_size; + + DetermineSizeOfArguments (node->node_arguments,&a_size,&b_size); + + if (unbox_record){ + int a_to_offset,b_to_offset; + + DetermineSizeOfState (*record_state_p,&record_a_size,&record_b_size); + + a_to_offset=record_a_size; + b_to_offset=record_b_size; + + remove_updated_fields_from_record (0,first_field_arg,0,0,&a_to_offset,&b_to_offset,record_state_p->state_arity,record_state_p->state_record_arguments); + + GenPopA (a_to_offset); + GenPopB (b_to_offset); + + *asp_p-=a_to_offset; + *bsp_p-=b_to_offset; + + a_size-=a_to_offset; + b_size-=b_to_offset; + } + + { + ArgP previous_arg,arg; + + previous_arg=record_arg; + for_l (arg,first_field_arg,arg_next){ + Node field_node; + + field_node=arg->arg_node; + field_node->node_arguments->arg_next=NULL; + + previous_arg->arg_next=arg; + previous_arg=arg; + } + previous_arg->arg_next=NULL; + } + + ConvertSymbolToDandNLabel (&name,&codelab,new_update_sdef); + + *asp_p += 1-a_size; + *bsp_p -= b_size; + + if (b_size!=0) + GenBuildU (&name,a_size,b_size,&codelab); + else + GenBuild (&name,a_size,&codelab); + + return; + } + } else + new_update_sdef=CreateUpdateFunction (record_arg,first_field_arg,node,False); +#else BuildArgs (node->node_arguments,asp_p,bsp_p,code_gen_node_ids_p); new_update_sdef=CreateUpdateFunction (record_arg,first_field_arg,node); +#endif ConvertSymbolToDandNLabel (&name,&codelab,new_update_sdef); @@ -3259,12 +3667,20 @@ static void FillUpdateNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i *asp_p-=n_arguments; } } else { +#if UPDATE_RECORD_NOT_ON_TOP + int n_a_elements_above_record,n_b_elements_above_record; +#endif BuildArgs (node->node_arguments,asp_p,bsp_p,code_gen_node_ids_p); DetermineSizeOfState (node->node_state,&record_a_size,&record_b_size); - +#if UPDATE_RECORD_NOT_ON_TOP + UpdateRecordAndAddSelectorsToUpdateNode (record_arg,first_field_arg, + node->node_state.state_record_arguments,record_a_size,record_b_size,&n_a_elements_above_record,&n_b_elements_above_record); + RemoveFieldsFromStackAfterUpdate (n_a_elements_above_record,n_b_elements_above_record,record_a_size,record_b_size,asp_p,bsp_p); +#else UpdateNodeAndAddSelectorsToUpdateNode (record_arg,first_field_arg, node->node_state.state_record_arguments,record_a_size,record_b_size,asp_p,bsp_p); +#endif } } diff --git a/backendC/CleanCompilerSources/instructions.c b/backendC/CleanCompilerSources/instructions.c index 80ecb14..12ec681 100644 --- a/backendC/CleanCompilerSources/instructions.c +++ b/backendC/CleanCompilerSources/instructions.c @@ -185,6 +185,42 @@ static void GenLabel (Label label) FPrintF (OutFile,".%u",label->lab_post); } +static void GenDescriptorOrNodeEntryLabel (Label label) +{ + if (label->lab_issymbol){ + SymbDef def; + char *module_name; + + def=label->lab_symbol; + + module_name = label->lab_mod; + + if (module_name!=NULL) + FPrintF (OutFile,"e_%s_%s%s",module_name,label->lab_pref,def->sdef_ident->ident_name); + else if (ExportLocalLabels){ + if (def->sdef_kind==IMPRULE) + FPrintF (OutFile,"e_%s_%s%s.%u",CurrentModule,label->lab_pref,def->sdef_ident->ident_name,def->sdef_number); + else + FPrintF (OutFile,"e_%s_%s%s",CurrentModule,label->lab_pref,def->sdef_ident->ident_name); + } else if (DoDebug){ + if (def->sdef_kind==IMPRULE) + FPrintF (OutFile, "%s%s.%u",label->lab_pref,def->sdef_ident->ident_name,def->sdef_number); + else + FPrintF (OutFile, "%s%s",label->lab_pref,def->sdef_ident->ident_name); + } else if (def->sdef_number==0) + FPrintF (OutFile, "%s%s",label->lab_pref,def->sdef_ident->ident_name); + else if (label->lab_pref[0] == '\0') + FPrintF (OutFile,LOCAL_D_PREFIX "%u",def->sdef_number); + else + FPrintF (OutFile,"%s%u",label->lab_pref,def->sdef_number); + } else { + FPutS (label->lab_pref,OutFile); + FPutS (label->lab_name,OutFile); + } + if (label->lab_post!=0) + FPrintF (OutFile,".%u",label->lab_post); +} + static void GenGetWL (int offset) { FPrintF (OutFile, "\n\tgetWL %d", offset); @@ -1752,20 +1788,20 @@ void GenPushNodeU (Label contlab,int a_size,int b_size) put_arguments__nn_b (a_size,b_size); } -void GenFill (Label symblab, int arity,Label contlab, int offset, FillKind fkind) +void GenFill (Label symblab,int arity,Label contlab,int offset,FillKind fkind) { TreatWaitListBeforeFill (offset, fkind); put_instruction_b (fill); if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) - GenLabel (symblab); + GenDescriptorOrNodeEntryLabel (symblab); else FPutS (empty_lab.lab_name, OutFile); put_arguments__n__b (arity); - GenLabel (contlab); + GenDescriptorOrNodeEntryLabel (contlab); put_arguments__n_b (offset); @@ -1779,13 +1815,13 @@ void GenFillU (Label symblab,int a_size,int b_size,Label contlab,int offset) put_instruction_ (Ifill_u); if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) - GenLabel (symblab); + GenDescriptorOrNodeEntryLabel (symblab); else FPutS (empty_lab.lab_name, OutFile); FPrintF (OutFile," %d %d ",a_size,b_size); - GenLabel (contlab); + GenDescriptorOrNodeEntryLabel (contlab); put_arguments__n_b (offset); } @@ -1795,13 +1831,13 @@ void GenFillcp (Label symblab,int arity,Label contlab,int offset,char bits[]) put_instruction_b (fillcp); if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) - GenLabel (symblab); + GenDescriptorOrNodeEntryLabel (symblab); else FPutS (empty_lab.lab_name, OutFile); put_arguments__n__b (arity); - GenLabel (contlab); + GenDescriptorOrNodeEntryLabel (contlab); put_arguments__n_b (offset); @@ -1813,13 +1849,13 @@ void GenFillcpU (Label symblab,int a_size,int b_size,Label contlab,int offset,ch put_instruction_b (fillcp_u); if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) - GenLabel (symblab); + GenDescriptorOrNodeEntryLabel (symblab); else FPutS (empty_lab.lab_name, OutFile); FPrintF (OutFile," %d %d ",a_size,b_size); - GenLabel (contlab); + GenDescriptorOrNodeEntryLabel (contlab); put_arguments__n_b (offset); @@ -1833,7 +1869,7 @@ void GenFillh (Label symblab, int arity, int offset, FillKind fkind) put_instruction_b (fillh); if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) - GenLabel (symblab); + GenDescriptorOrNodeEntryLabel (symblab); else FPutS (empty_lab.lab_name, OutFile); @@ -1868,13 +1904,13 @@ void GenBuild (Label symblab,int arity,Label contlab) put_instruction_b (build); if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) - GenLabel (symblab); + GenDescriptorOrNodeEntryLabel (symblab); else FPutS (empty_lab.lab_name, OutFile); put_arguments__n__b (arity); - GenLabel (contlab); + GenDescriptorOrNodeEntryLabel (contlab); } void GenBuildh (Label symblab,int arity) @@ -1889,18 +1925,30 @@ void GenBuildh (Label symblab,int arity) put_arguments__n_b (arity); } +void GenBuildPartialFunctionh (Label symblab,int arity) +{ + put_instruction_b (buildh); + + if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) + GenDescriptorOrNodeEntryLabel (symblab); + else + FPutS (empty_lab.lab_name, OutFile); + + put_arguments__n_b (arity); +} + void GenBuildU (Label symblab,int a_size,int b_size,Label contlab) { put_instruction_ (Ibuild_u); if (!symblab->lab_issymbol || DescriptorNeeded (symblab->lab_symbol)) - GenLabel (symblab); + GenDescriptorOrNodeEntryLabel (symblab); else FPutS (empty_lab.lab_name, OutFile); FPrintF (OutFile," %d %d ",a_size,b_size); - GenLabel (contlab); + GenDescriptorOrNodeEntryLabel (contlab); } void GenBuildArray (int argoffset) @@ -2208,6 +2256,12 @@ void GenLabelDefinition (Label lab) } } +void GenNodeEntryLabelDefinition (Label lab) +{ + FPutC ('\n', OutFile); + GenDescriptorOrNodeEntryLabel (lab); +} + void GenUpdateA (int src, int dst) { if (src != dst){ @@ -2540,7 +2594,7 @@ void GenNodeEntryDirective (int arity,Label label,Label label2) put_arguments_n__b (arity); if (DescriptorNeeded (label->lab_symbol)) - GenLabel (label); + GenDescriptorOrNodeEntryLabel (label); else FPutS (empty_lab.lab_name, OutFile); @@ -2557,6 +2611,26 @@ void GenNodeEntryDirective (int arity,Label label,Label label2) } } +void GenLazyRecordNodeEntryDirective (int arity,Label label) +{ + if (DoStackLayout){ + put_directive_b (n); + put_arguments_n__b (arity); + + if (DescriptorNeeded (label->lab_symbol)) + GenLabel (label); + else + FPutS (empty_lab.lab_name, OutFile); + +#ifdef MEMORY_PROFILING_WITH_N_STRING + if (DoProfiling && arity>=0 && !DoParallel){ + put_directive_ (Dn_string); + FPrintF (OutFile,"\"%s\"",label->lab_symbol->sdef_ident->ident_name); + } +#endif + } +} + void GenNodeEntryDirectiveForLabelWithoutSymbol (int arity,Label label,Label label2) { if (DoStackLayout){ @@ -2586,7 +2660,7 @@ void GenNodeEntryDirectiveUnboxed (int a_size,int b_size,Label label,Label label FPrintF (OutFile,"%d %d ",a_size,b_size); if (DescriptorNeeded (label->lab_symbol)) - GenLabel (label); + GenDescriptorOrNodeEntryLabel (label); else FPutS (empty_lab.lab_name, OutFile); @@ -2725,6 +2799,11 @@ void GenArrayFunctionDescriptor (SymbDef arr_fun_def, Label desclab, int arity) name = arr_fun_def->sdef_ident->ident_name; + if (ExportLocalLabels){ + put_directive_ (Dexport); + FPrintF (OutFile,"e_%s_" D_PREFIX "%s",CurrentModule,name); + } + descriptor_label=*desclab; descriptor_label.lab_pref=d_pref; @@ -2733,7 +2812,10 @@ void GenArrayFunctionDescriptor (SymbDef arr_fun_def, Label desclab, int arity) else put_directive_ (Ddescn); - GenLabel (&descriptor_label); + if (ExportLocalLabels) + FPrintF (OutFile,"e_%s_" D_PREFIX "%s ",CurrentModule,name); + else + GenLabel (&descriptor_label); FPutC (' ', OutFile); GenLabel (&empty_lab); @@ -2767,45 +2849,87 @@ void GenFunctionDescriptorAndExportNodeAndDescriptor (SymbDef sdef) CurrentModule,name,CurrentModule,name,CurrentModule,name); } else { if (sdef->sdef_mark & SDEF_USED_CURRIED_MASK){ - put_directive_ (Ddesc); - - if (DoDebug) - FPrintF (OutFile, D_PREFIX "%s.%u ", name,sdef->sdef_number); - else - FPrintF (OutFile, LOCAL_D_PREFIX "%u ", sdef->sdef_number); + int sdef_n; + + sdef_n=sdef->sdef_number; + + if (ExportLocalLabels){ + put_directive_ (Dexport); + FPrintF (OutFile,"e_%s_" D_PREFIX "%s.%u",CurrentModule,name,sdef_n); + + if (sdef->sdef_mark & SDEF_USED_LAZILY_MASK){ + put_directive_ (Dexport); + FPrintF (OutFile,"e_%s_" N_PREFIX "%s.%u",CurrentModule,name,sdef_n); + } + + put_directive_ (Ddesc); + FPrintF (OutFile,"e_%s_" D_PREFIX "%s.%u ",CurrentModule,name,sdef_n); + } else { + put_directive_ (Ddesc); + if (DoDebug) + FPrintF (OutFile,D_PREFIX "%s.%u ",name,sdef_n); + else + FPrintF (OutFile,LOCAL_D_PREFIX "%u ",sdef_n); + } if (sdef->sdef_mark & SDEF_USED_LAZILY_MASK){ - if (DoDebug) - FPrintF (OutFile,N_PREFIX "%s.%u ",name,sdef->sdef_number); + if (ExportLocalLabels) + FPrintF (OutFile,"e_%s_" N_PREFIX "%s.%u ",CurrentModule,name,sdef_n); + else if (DoDebug) + FPrintF (OutFile,N_PREFIX "%s.%u ",name,sdef_n); else - FPrintF (OutFile,N_PREFIX "%u ",sdef->sdef_number); + FPrintF (OutFile,N_PREFIX "%u ",sdef_n); } else FPrintF (OutFile, "%s ", hnf_lab.lab_name); if (DoDebug) - FPrintF (OutFile,L_PREFIX "%s.%u ",name,sdef->sdef_number); + FPrintF (OutFile,L_PREFIX "%s.%u ",name,sdef_n); else - FPrintF (OutFile,L_PREFIX "%u ",sdef->sdef_number); + FPrintF (OutFile,L_PREFIX "%u ",sdef_n); } else { - put_directive_ (Ddescn); + int sdef_n; - if (DoDebug) - FPrintF (OutFile, D_PREFIX "%s.%u ", name,sdef->sdef_number); - else - FPrintF (OutFile, LOCAL_D_PREFIX "%u ", sdef->sdef_number); + sdef_n=sdef->sdef_number; - if (sdef->sdef_mark & SDEF_USED_LAZILY_MASK){ + if (ExportLocalLabels){ + put_directive_ (Dexport); + FPrintF (OutFile,"e_%s_" D_PREFIX "%s.%u",CurrentModule,name,sdef_n); + + if (sdef->sdef_mark & SDEF_USED_LAZILY_MASK){ + put_directive_ (Dexport); + FPrintF (OutFile,"e_%s_" N_PREFIX "%s.%u",CurrentModule,name,sdef_n); + } + + put_directive_ (Ddescn); + FPrintF (OutFile,"e_%s_" D_PREFIX "%s.%u ",CurrentModule,name,sdef_n); + } else { + put_directive_ (Ddescn); if (DoDebug) - FPrintF (OutFile,N_PREFIX "%s.%u ",name,sdef->sdef_number); + FPrintF (OutFile,D_PREFIX "%s.%u ",name,sdef_n); else - FPrintF (OutFile,N_PREFIX "%u ",sdef->sdef_number); + FPrintF (OutFile,LOCAL_D_PREFIX "%u ",sdef_n); + } + + if (sdef->sdef_mark & SDEF_USED_LAZILY_MASK){ + if (ExportLocalLabels) + FPrintF (OutFile,"e_%s_" N_PREFIX "%s.%u ",CurrentModule,name,sdef_n); + else if (DoDebug) + FPrintF (OutFile,N_PREFIX "%s.%u ",name,sdef_n); + else + FPrintF (OutFile,N_PREFIX "%u ",sdef_n); } else FPrintF (OutFile, "%s ", hnf_lab.lab_name); } } FPrintF (OutFile, "%d 0 \"", sdef->sdef_arity); - PrintSymbolOfIdent (name_id, 0, OutFile); + if (ExportLocalLabels){ + if (sdef->sdef_exported) + FPrintF (OutFile,"%s",name); + else + FPrintF (OutFile,"%s.%u",name,sdef->sdef_number); + } else + PrintSymbolOfIdent (name_id, 0, OutFile); FPutC ('\"',OutFile); } @@ -3099,6 +3223,11 @@ void GenStart (SymbDef startsymb) if (startsymb->sdef_exported) FPrintF (OutFile, "e_%s_" D_PREFIX "Start",CurrentModule); + else if (ExportLocalLabels) + if (DoParallel) + FPrintF (OutFile,"e_%s_" D_PREFIX "Start.%u",CurrentModule,startsymb->sdef_number); + else + FPutS (empty_lab.lab_name, OutFile); else if (DoDebug){ if (DoParallel) FPrintF (OutFile, D_PREFIX "Start.%u",startsymb->sdef_number); @@ -3115,6 +3244,8 @@ void GenStart (SymbDef startsymb) if (startsymb->sdef_exported) FPrintF (OutFile, "e_%s_" N_PREFIX "Start",CurrentModule); + else if (ExportLocalLabels) + FPrintF (OutFile, "e_%s_" N_PREFIX "Start.%u",CurrentModule,startsymb->sdef_number); else if (DoDebug) FPrintF (OutFile, N_PREFIX "Start.%u",startsymb->sdef_number); else @@ -3184,7 +3315,12 @@ void GenNoMatchError (SymbDef sdef,int asp,int bsp,int string_already_generated) FPrintF (OutFile, "x_%u", sdef->sdef_number); else if (sdef->sdef_exported) FPrintF (OutFile, "e_%s_" D_PREFIX "%s", CurrentModule, sdef->sdef_ident->ident_name); - else if (DoDebug){ + else if (ExportLocalLabels){ + if (sdef->sdef_kind==IMPRULE) + FPrintF (OutFile,"e_%s_" D_PREFIX "%s.%u",CurrentModule,sdef->sdef_ident->ident_name,sdef->sdef_number); + else + FPrintF (OutFile,"e_%s_" D_PREFIX "%s",CurrentModule,sdef->sdef_ident->ident_name); + } else if (DoDebug){ if (sdef->sdef_kind==IMPRULE) FPrintF (OutFile, D_PREFIX "%s.%u", sdef->sdef_ident->ident_name,sdef->sdef_number); else @@ -3366,6 +3502,12 @@ void GenPB (char *function_name) FPrintF (OutFile,"\"%s\"",function_name); } +void GenPB_with_line_number (char *function_name,int line_number) +{ + put_directive_ (Dpb); + FPrintF (OutFile,"\"%s[line:%d]\"",function_name,line_number); +} + void GenPD (void) { put_directive (Dpd); diff --git a/backendC/CleanCompilerSources/instructions.h b/backendC/CleanCompilerSources/instructions.h index 423b07a..fc3790b 100644 --- a/backendC/CleanCompilerSources/instructions.h +++ b/backendC/CleanCompilerSources/instructions.h @@ -58,6 +58,7 @@ void GenFill1 (Label symblab,int arity,int offset,char bits[]); void GenFill2 (Label symblab, int arity,int offset,char bits[]); void GenBuild (Label symblab,int arity,Label contlab); void GenBuildh (Label symblab,int arity); +void GenBuildPartialFunctionh (Label symblab,int arity); void GenBuildU (Label symblab,int a_size,int b_size,Label contlab); void GenBuildArray (int argoffset); void GenBuildString (SymbValue val); @@ -103,6 +104,7 @@ void GenCreate (int arity); void GenDumpString (char *str); void GenLabelDefinition (Label lab); +void GenNodeEntryLabelDefinition (Label lab); void GenFieldLabelDefinition (Label label,char *record_name); @@ -152,6 +154,7 @@ void GenOStackLayout (int asize,int bsize,Args fun_args); void GenNodeEntryDirective (int arity,Label label,Label label2); void GenNodeEntryDirectiveForLabelWithoutSymbol (int arity,Label label,Label label2); void GenNodeEntryDirectiveUnboxed (int a_size,int b_size,Label label,Label label2); +void GenLazyRecordNodeEntryDirective (int arity,Label label); void GenFieldNodeEntryDirective (int arity, Label label, Label label2,char *record_name); void GenConstructorDescriptorAndExport (SymbDef sdef); void GenFunctionDescriptorAndExportNodeAndDescriptor (SymbDef sdef); @@ -200,6 +203,7 @@ void GenFillCaf (Label label,int a_stack_size,int b_stack_size); void GenCaf (Label label,int a_stack_size,int b_stack_size); void GenPB (char *function_name); +void GenPB_with_line_number (char *function_name,int line_number); void GenPD (void); void GenPN (void); void GenPL (void); |