Commit d3566f1b authored by John van Groningen's avatar John van Groningen

generate .impmod before importing labels and descriptors,

using this information the code generator can determine from which
module a label is imported, this is used when generating position
independent code
parent a592e65f
......@@ -1127,6 +1127,7 @@ void CodeGeneration (ImpMod imod, char *fname)
{
if (! CompilerError){
int DoStrictnessAnalysis_and_init_ok;
CurrentPhase = NULL;
#if 0
......@@ -1242,7 +1243,7 @@ void CodeGeneration (ImpMod imod, char *fname)
ReadInlineCode ();
CreateStackFrames();
ImportSymbols (imod->im_symbols);
GenerateCodeForConstructorsAndRecords (imod->im_symbols);
......@@ -1294,6 +1295,10 @@ void CodeGeneration (ImpMod imod, char *fname)
#if STRICT_LISTS
GenerateCodeForLazyUnboxedRecordListFunctions();
#endif
import_not_yet_imported_record_r_labels (imod->im_symbols);
import_not_yet_imported_system_labels();
WriteLastNewlineToABCFile();
CloseABCFile (fname);
......
......@@ -95,7 +95,7 @@ LabDef conss_lab = {NULL, "", False, "_Conss", 0};
LabDef consts_lab = {NULL, "", False, "_Consts", 0};
LabDef conssts_lab = {NULL, "", False, "_Conssts", 0};
LabDef unboxed_cons_labels[][2] = {
LabDef unboxed_cons_labels[5][2] = {
/*IntObj*/ {{NULL, "", False, "_Consi", 0}, {NULL, "", False, "_Consits", 0}},
/*BoolObj*/ {{NULL, "", False, "_Consb", 0}, {NULL, "", False, "_Consbts", 0}},
/*CharObj*/ {{NULL, "", False, "_Consc", 0}, {NULL, "", False, "_Conscts", 0}},
......@@ -105,6 +105,9 @@ LabDef unboxed_cons_labels[][2] = {
LabDef unboxed_cons_array_label = {NULL, "", False, "_Consa", 0};
int unboxed_cons_mark[5][2];
int unboxed_cons_array_mark;
#endif
#ifdef CLEAN2
LabDef select_with_dictionary_lab = {NULL, "", False, "_select_with_dictionary", 0};
......@@ -251,9 +254,16 @@ void ConvertSymbolToRLabel (LabDef *slab,SymbDef sdef)
if (!sdef->sdef_exported && sdef->sdef_module==CurrentModule && !ExportLocalLabels)
modname = NULL;
else
else {
modname = sdef->sdef_module;
if ((sdef->sdef_mark & SDEF_RECORD_R_LABEL_IMPORTED_MASK)!=0){
sdef->sdef_mark |= SDEF_USED_STRICTLY_MASK;
} else {
sdef->sdef_mark |= SDEF_USED_STRICTLY_MASK | SDEF_RECORD_R_LABEL_IMPORTED_MASK;
GenImpRecordDesc (modname,sdef->sdef_ident->ident_name);
}
}
MakeSymbolLabel (slab,modname,r_pref,sdef,0);
}
......@@ -802,91 +812,84 @@ static void CallEvalArgsEntryUnboxed (int args_a_size,int args_b_size,ArgP argum
GenOStackLayoutOfState (result_asize,result_bsize,function_state_p[-1]);
}
static void GenerateConstructorDescriptorAndFunction (ConstructorList constructor)
static void GenerateLazyConstructorDescriptorAndFunctionForStrictConstructor (ConstructorList constructor)
{
Symbol constructor_symbol;
SymbDef constructor_def;
constructor_symbol=constructor->cl_constructor->type_node_symbol;
constructor_def=constructor_symbol->symb_def;
if (constructor_def->sdef_kind==CONSTRUCTOR && constructor_def->sdef_strict_constructor){
GenStrictConstructorDescriptor (constructor_def,constructor->cl_state_p);
constructor_def=constructor->cl_constructor->type_node_symbol->symb_def;
if (constructor_def->sdef_exported || (constructor_def->sdef_mark & (SDEF_USED_LAZILY_MASK | SDEF_USED_CURRIED_MASK)) || ExportLocalLabels){
LabDef constructor_label,ealab,n_lab,d_lab;
int maxasize,asize,bsize;
int asp,bsp,arity;
asp = constructor_def->sdef_arity;
bsp = 0;
arity = asp;
if (constructor_def->sdef_exported || (constructor_def->sdef_mark & (SDEF_USED_LAZILY_MASK | SDEF_USED_CURRIED_MASK)) || ExportLocalLabels){
LabDef constructor_label,ealab,n_lab,d_lab;
int maxasize,asize,bsize;
int asp,bsp,arity;
asp = constructor_def->sdef_arity;
bsp = 0;
arity = asp;
ConvertSymbolToLabel (&CurrentAltLabel,constructor_def);
if (constructor_def->sdef_exported)
GenExportEaEntry (constructor_def);
GenConstructorFunctionDescriptorAndExportNodeAndDescriptor (constructor_def);
ConvertSymbolToLabel (&CurrentAltLabel,constructor_def);
if (constructor_def->sdef_exported)
GenExportEaEntry (constructor_def);
GenConstructorFunctionDescriptorAndExportNodeAndDescriptor (constructor_def);
if (DoTimeProfiling)
GenPB (constructor_def->sdef_ident->ident_name);
if (DoTimeProfiling)
GenPB (constructor_def->sdef_ident->ident_name);
MakeSymbolLabel (&ealab,constructor_def->sdef_exported ? CurrentModule : NULL,ea_pref,constructor_def,0);
if (constructor_def->sdef_exported || (constructor_def->sdef_mark & SDEF_USED_CURRIED_MASK) || ExportLocalLabels){
CurrentAltLabel.lab_pref = l_pref;
MakeSymbolLabel (&ealab,constructor_def->sdef_exported ? CurrentModule : NULL,ea_pref,constructor_def,0);
if (constructor_def->sdef_exported || (constructor_def->sdef_mark & SDEF_USED_CURRIED_MASK) || ExportLocalLabels){
CurrentAltLabel.lab_pref = l_pref;
if (DoTimeProfiling)
GenPL();
if (DoTimeProfiling)
GenPL();
#ifdef NEW_APPLY
if (arity>=2)
GenApplyEntryDirective (arity,&ealab);
if (arity>=2)
GenApplyEntryDirective (arity,&ealab);
#endif
GenOAStackLayout (2);
GenLabelDefinition (&CurrentAltLabel);
GenPushArgs (0,arity-1,arity-1);
GenUpdateA (arity,arity-1);
GenCreate (-1);
GenUpdateA (0,arity+1);
GenPopA (1);
JmpEvalArgsEntry (arity+1,&ealab);
}
GenOAStackLayout (2);
GenLabelDefinition (&CurrentAltLabel);
GenPushArgs (0,arity-1,arity-1);
GenUpdateA (arity,arity-1);
GenCreate (-1);
GenUpdateA (0,arity+1);
GenPopA (1);
JmpEvalArgsEntry (arity+1,&ealab);
}
ConvertSymbolToConstructorDandNLabel (&d_lab,&n_lab,constructor_def);
ConvertSymbolToConstructorDandNLabel (&d_lab,&n_lab,constructor_def);
GenNodeEntryDirective (arity,&d_lab,&ealab);
GenOAStackLayout (1);
GenLabelDefinition (&n_lab);
GenPushNode (ReduceError,asp);
GenNodeEntryDirective (arity,&d_lab,&ealab);
GenOAStackLayout (1);
GenLabelDefinition (&n_lab);
GenPushNode (ReduceError,asp);
GenOAStackLayout (arity+1);
if (DoTimeProfiling)
GenPN();
GenLabelDefinition (&ealab);
GenOAStackLayout (arity+1);
if (DoTimeProfiling)
GenPN();
GenLabelDefinition (&ealab);
asize=0;
bsize=0;
maxasize=0;
asize=0;
bsize=0;
maxasize=0;
AddStateSizesAndMaxFrameSizes (arity,constructor->cl_state_p,&maxasize,&asize,&bsize);
AddStateSizesAndMaxFrameSizes (arity,constructor->cl_state_p,&maxasize,&asize,&bsize);
EvaluateAndMoveStateArguments (arity,constructor->cl_state_p,asp,maxasize);
EvaluateAndMoveStateArguments (arity,constructor->cl_state_p,asp,maxasize);
ConvertSymbolToKLabel (&constructor_label,constructor_def);
ConvertSymbolToKLabel (&constructor_label,constructor_def);
GenFillR (&constructor_label,asize,bsize,asize,0,0,ReleaseAndFill,True);
GenFillR (&constructor_label,asize,bsize,asize,0,0,ReleaseAndFill,True);
GenRtn (1,0,OnAState);
if (DoTimeProfiling)
GenPE();
}
} else
GenConstructorDescriptorAndExport (constructor_def);
GenRtn (1,0,OnAState);
if (DoTimeProfiling)
GenPE();
}
}
static void GenLazyRecordEntry (SymbDef rdef)
......@@ -1313,9 +1316,25 @@ void GenerateCodeForConstructorsAndRecords (Symbol symbols)
GenConstructor0DescriptorAndExport (alt->cl_constructor->type_node_symbol->symb_def,constructor_n);
++constructor_n;
}
} else
for_l (alt,def->sdef_type->type_constructors,cl_next)
GenerateConstructorDescriptorAndFunction (alt);
} else {
for_l (alt,def->sdef_type->type_constructors,cl_next){
SymbDef constructor_def;
constructor_def=alt->cl_constructor->type_node_symbol->symb_def;
if (constructor_def->sdef_kind==CONSTRUCTOR && constructor_def->sdef_strict_constructor)
GenerateLazyConstructorDescriptorAndFunctionForStrictConstructor (alt);
}
for_l (alt,def->sdef_type->type_constructors,cl_next){
SymbDef constructor_def;
constructor_def=alt->cl_constructor->type_node_symbol->symb_def;
if (constructor_def->sdef_kind==CONSTRUCTOR && constructor_def->sdef_strict_constructor)
GenStrictConstructorDescriptor (constructor_def,alt->cl_state_p);
else
GenConstructorDescriptorAndExport (constructor_def);
}
}
} else if (def->sdef_kind==RECORDTYPE){
FieldList fields;
int asize, bsize;
......@@ -1378,7 +1397,7 @@ Bool NodeEntry (StateS *const function_state_p,int arity,Label ealab,SymbDef roo
if (update_root_node && DoTimeProfiling && !function_called_only_curried_or_lazy_with_one_return)
GenPD();
if (rootsymb->sdef_calledwithrootnode){
if (update_root_node){
newealab = *ealab;
......
......@@ -17,13 +17,16 @@ extern LabDef
cycle_lab, reserve_lab, type_error_lab, indirection_lab, ind_lab,
hnf_lab, cons_lab, nil_lab, tuple_lab, empty_lab, add_arg_lab, match_error_lab,
#if STRICT_LISTS
conss_lab,consts_lab,conssts_lab,unboxed_cons_labels[][2],unboxed_cons_array_label,
conss_lab,consts_lab,conssts_lab,unboxed_cons_labels[5][2],unboxed_cons_array_label,
#endif
#ifdef CLEAN2
select_with_dictionary_lab, update_with_dictionary_lab,
#endif
CurrentAltLabel;
extern int unboxed_cons_mark[5][2];
extern int unboxed_cons_array_mark;
extern Label ReduceError;
#define ExpectsResultNode(state) ((state).state_type==SimpleState && (state).state_kind>StrictRedirection)
......
......@@ -3186,7 +3186,7 @@ static void FillNormalNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i
if (lazy_fill){
LabDef n_strict_cons_lab;
n_strict_cons_lab = *strict_cons_lab_p;
n_strict_cons_lab.lab_pref = n_pref;
......@@ -4285,7 +4285,9 @@ static void FillUpdateNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_i
}
}
static LabDef selector_m_error_lab = {NULL,"",False,"selector_m_error",0};
int selector_m_error_lab_used = 0;
LabDef selector_m_error_lab = {NULL,"",False,"selector_m_error",0};
void FillMatchNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_id,CodeGenNodeIdsP code_gen_node_ids_p)
{
......@@ -4415,6 +4417,7 @@ void FillMatchNode (Node node,int *asp_p,int *bsp_p,NodeId update_node_id,CodeGe
if (branch){
#if 1
selector_m_error_lab_used=1;
GenExitFalse (&selector_m_error_lab);
#else
LabDef local_label;
......@@ -6583,6 +6586,12 @@ void InitCoding (void)
for (i=0; i<MaxNodeArity-NrOfGlobalSelectors; i++)
LazyTupleSelectors [i] = False;
for (i=0; i<5; ++i){
unboxed_cons_mark[i][0]=0;
unboxed_cons_mark[i][1]=0;
}
unboxed_cons_array_mark=0;
next_update_function_n=0;
next_match_function_n=0;
......
......@@ -34,6 +34,8 @@ extern int ObjectSizes [];
#define IsOnACycle(nodenum) (nodenum < 0)
#define IsOnBStack(state) (! IsSimpleState (state) || (state).state_kind == OnB)
extern int selector_m_error_lab_used;
extern LabDef selector_m_error_lab;
extern LabDef *unboxed_cons_label (SymbolP cons_symbol_p);
extern void ScanInlineFile (char *fname);
......
......@@ -504,6 +504,7 @@ enum {
Co,
Cimpdesc,
Cimplab,
Cimpmod,
Cn
};
#endif
......@@ -685,6 +686,7 @@ static void put_instruction_code (int instruction_code)
#define Do "o"
#define Dimpdesc "impdesc"
#define Dimplab "implab"
#define Dimpmod "impmod"
#define Dexport "export"
#define Dn "n"
#define Dnu "nu"
......@@ -2498,6 +2500,19 @@ void GenPushArgB (int offset)
FPrintF (OutFile, "%d", offset);
}
extern char *current_imported_module; /* from statesgen.c */
void GenImpRecordDesc (char *module_name,char *record_name)
{
if (current_imported_module!=module_name){
current_imported_module = module_name;
GenImpMod (module_name);
}
put_directive_b (impdesc);
FPrintF (OutFile, "e_%s_" R_PREFIX "%s",module_name,record_name);
}
void GenImport (SymbDef sdef)
{
if (DoStackLayout){
......@@ -2534,12 +2549,13 @@ void GenImport (SymbDef sdef)
FPrintF (OutFile, " e_%s_" EA_PREFIX "%s.%s",sdef->sdef_module,record_name,name);
else if (sdef->sdef_returnsnode)
FPutS (" _",OutFile);
}
}
return;
case RECORDTYPE:
if (sdef->sdef_mark & (SDEF_USED_STRICTLY_MASK | SDEF_USED_LAZILY_MASK)){
put_directive_b (impdesc);
FPrintF (OutFile, "e_%s_" R_PREFIX "%s",sdef->sdef_module,name);
GenImpRecordDesc (sdef->sdef_module,name);
sdef->sdef_mark |= SDEF_RECORD_R_LABEL_IMPORTED_MASK;
}
if (!sdef->sdef_strict_constructor)
......@@ -2553,14 +2569,21 @@ void GenImport (SymbDef sdef)
}
return;
case CONSTRUCTOR:
if (!sdef->sdef_strict_constructor)
if ((sdef->sdef_mark & (SDEF_USED_STRICTLY_MASK | SDEF_USED_LAZILY_MASK | SDEF_USED_CURRIED_MASK))==0)
return;
if (!sdef->sdef_strict_constructor){
put_directive_b (impdesc);
FPrintF (OutFile, "e_%s_" D_PREFIX "%s", sdef->sdef_module,name);
return;
}
if (sdef->sdef_mark & (SDEF_USED_STRICTLY_MASK | SDEF_USED_LAZILY_MASK)){
put_directive_b (impdesc);
FPrintF (OutFile, "e_%s_" CONSTRUCTOR_R_PREFIX "%s",sdef->sdef_module,name);
}
if (sdef->sdef_mark & SDEF_USED_LAZILY_MASK){
if (sdef->sdef_mark & (SDEF_USED_LAZILY_MASK | SDEF_USED_CURRIED_MASK)){
put_directive_b (impdesc);
FPrintF (OutFile, "e_%s_" D_PREFIX "%s", sdef->sdef_module,name);
}
......@@ -3613,6 +3636,8 @@ void InitFileInfo (ImpMod imod)
FPutS ("_nostart_", OutFile);
}
static int match_error_lab_used = 0;
void GenNoMatchError (SymbDef sdef,int asp,int bsp,int string_already_generated)
{
Bool desc_needed;
......@@ -3650,6 +3675,7 @@ void GenNoMatchError (SymbDef sdef,int asp,int bsp,int string_already_generated)
}
GenJmp (&match_error_lab);
match_error_lab_used = 1;
if (!desc_needed && !string_already_generated){
put_directive_ (Dstring);
......@@ -3674,6 +3700,7 @@ void GenCaseNoMatchError (SymbDefP case_def,int asp,int bsp)
FPrintF (OutFile, "case_fail%u",CaseFailNumber);
GenJmp (&match_error_lab);
match_error_lab_used = 1;
put_directive_ (Dstring);
FPrintF (OutFile, "case_fail%u \"",CaseFailNumber);
......@@ -3696,12 +3723,24 @@ static void GenImpLab_node_entry (char *label_name,char *ea_label_name)
FPrintF (OutFile,"%s %s",label_name,ea_label_name);
}
static void GenImpLab_n_and_ea_label (char *label_name)
{
put_directive_b (implab);
FPrintF (OutFile,"n%s ea%s",label_name,label_name);
}
static void GenImpDesc (char *descriptor_name)
{
put_directive_b (impdesc);
FPutS (descriptor_name,OutFile);
}
void GenImpMod (char *module_name)
{
put_directive_b (impmod);
FPutS (module_name,OutFile);
}
void GenEndInfo (void)
{
put_directive (Dendinfo);
......@@ -3709,11 +3748,16 @@ void GenEndInfo (void)
void GenSystemImports (void)
{
match_error_lab_used = 0;
selector_m_error_lab_used = 0;
if (DoStackLayout){
/* system module labels and descriptors */
int selnum;
GenImpMod ("_system");
if (DoParallel){
GenImpLab (channel_code);
GenImpLab (hnf_reducer_code);
......@@ -3736,6 +3780,8 @@ void GenSystemImports (void)
GenImpLab_node_entry ("e_system_nAP","e_system_eaAP");
GenImpLab ("e_system_sAP");
GenImpDesc (BasicDescriptors [ArrayObj].lab_name);
GenImpDesc (nil_lab.lab_name);
GenImpDesc (cons_lab.lab_name);
#if STRICT_LISTS
......@@ -3746,6 +3792,33 @@ void GenSystemImports (void)
GenImpDesc (conssts_lab.lab_name);
GenImpLab_node_entry ("n_Conssts","ea_Conssts");
#endif
{
int i;
for (i=0; i<5; ++i){
char *descriptor_label_name;
if (unboxed_cons_mark[i][0]!=0){
descriptor_label_name=unboxed_cons_labels[i][0].lab_name;
GenImpDesc (descriptor_label_name);
if (unboxed_cons_mark[i][0] & SDEF_USED_LAZILY_MASK)
GenImpLab_n_and_ea_label (descriptor_label_name);
}
if (unboxed_cons_mark[i][1]!=0){
descriptor_label_name=unboxed_cons_labels[i][1].lab_name;
GenImpDesc (descriptor_label_name);
if (unboxed_cons_mark[i][1] & SDEF_USED_LAZILY_MASK)
GenImpLab_n_and_ea_label (descriptor_label_name);
}
}
if (unboxed_cons_array_mark!=0){
GenImpDesc (unboxed_cons_array_label.lab_name);
if (unboxed_cons_array_mark & SDEF_USED_LAZILY_MASK)
GenImpLab_n_and_ea_label (unboxed_cons_array_label.lab_name);
}
}
GenImpDesc (tuple_lab.lab_name);
for (selnum=1; selnum<=NrOfGlobalSelectors; ++selnum){
put_directive_b (impdesc);
......@@ -3771,6 +3844,17 @@ void GenSystemImports (void)
}
}
void import_not_yet_imported_system_labels (void)
{
if (match_error_lab_used ||
selector_m_error_lab_used)
GenImpMod ("_system");
if (match_error_lab_used)
GenImpLab (match_error_lab.lab_name);
if (selector_m_error_lab_used)
GenImpLab (selector_m_error_lab.lab_name);
}
static void print_foreign_export_type (TypeNode type)
{
if (!type->type_node_is_var){
......
......@@ -145,6 +145,7 @@ void GenSetRedId (int offset);
void GenSetDefer (int offset);
void SetContinue (int offset);
void SetContinueOnReducer (int offset);
void GenImpRecordDesc (char *module_name,char *record_name);
void GenImport (SymbDef sdef);
void GenExportRecord (SymbDef sdef);
void GenExportFieldSelector (SymbDef sdef);
......@@ -200,7 +201,9 @@ void GenModuleDescriptor (void);
void GenDepend (char *modname);
#endif
void GenEndInfo (void);
void GenImpMod (char *module_name);
void GenSystemImports (void);
void import_not_yet_imported_system_labels (void);
void GenerateForeignExports (struct foreign_export_list *foreign_export_p);
void GenStart (SymbDef startsymb);
void InitFileInfo (ImpMod imod);
......
......@@ -3438,8 +3438,24 @@ static void ExamineSymbolApplication (struct node *node)
if (symbol->symb_kind==cons_symb && symbol->symb_head_strictness==4){
if (node->node_arity<2)
symbol->symb_unboxed_cons_sdef_p->sdef_mark |= SDEF_USED_CURRIED_MASK;
else if (IsLazyState (node->node_state))
symbol->symb_unboxed_cons_sdef_p->sdef_mark |= SDEF_USED_LAZILY_MASK;
else {
StateP unboxed_cons_state_p;
int mark;
if (IsLazyState (node->node_state)){
symbol->symb_unboxed_cons_sdef_p->sdef_mark |= SDEF_USED_LAZILY_MASK;
mark = SDEF_USED_LAZILY_MASK;
} else {
mark = SDEF_USED_STRICTLY_MASK;
}
unboxed_cons_state_p = symbol->symb_unboxed_cons_state_p;
if (unboxed_cons_state_p->state_type==SimpleState){
if (BETWEEN (IntObj,FileObj,unboxed_cons_state_p->state_object))
unboxed_cons_mark[unboxed_cons_state_p->state_object-IntObj][symbol->symb_tail_strictness] |= mark;
} else if (unboxed_cons_state_p->state_type==ArrayState){
unboxed_cons_array_mark |= mark;
}
}
} else if (symbol->symb_kind==seq_symb){
if (node->node_arity!=2)
SeqDef->sdef_mark |= SDEF_USED_CURRIED_MASK;
......@@ -3532,7 +3548,7 @@ static void ExamineSymbolApplication (struct node *node)
sdef->sdef_mark |= SDEF_USED_STRICTLY_MASK;
}
}
}
} else {
if ((sdef->sdef_kind==RECORDTYPE ? sdef->sdef_cons_arity : sdef->sdef_arity) != node->node_arity)
sdef->sdef_mark |= SDEF_USED_CURRIED_MASK;
......@@ -3768,20 +3784,40 @@ static void ReorderNodeDefinitionsAndDetermineUsedEntries (NodeDefs *def_p,Node
error_in_function ("ReorderNodeDefinitionsAndDetermineUsedEntries");
for_l (arg,root->node_arguments,arg_next){
if (arg->arg_node->node_kind==OverloadedCaseNode){
NodeP overloaded_case_node_p,case_node_p;
overloaded_case_node_p=arg->arg_node;
MarkDependentNodeDefs (overloaded_case_node_p->node_arguments->arg_node);
MarkDependentNodeDefs (overloaded_case_node_p->node_arguments->arg_next->arg_node);
switch (arg->arg_node->node_kind){
case CaseNode:
{
SymbolP symbol;
case_node_p=overloaded_case_node_p->node_node;
ReorderNodeDefinitionsAndDetermineUsedEntries (&case_node_p->node_node_defs,case_node_p->node_arguments->arg_node);
} else {
if (arg->arg_node->node_kind!=CaseNode && arg->arg_node->node_kind!=DefaultNode && arg->arg_node->node_kind!=OverloadedCaseNode)
symbol=arg->arg_node->node_symbol;
if (symbol->symb_kind==definition){
SymbDef sdef;
sdef=symbol->symb_def;
if (sdef->sdef_kind==CONSTRUCTOR){
sdef->sdef_isused=True;
sdef->sdef_mark |= SDEF_USED_STRICTLY_MASK;
}
}
/* no break */
}