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

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;