aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjohnvg2013-12-04 11:29:51 +0000
committerjohnvg2013-12-04 11:29:51 +0000
commitf4cfedb62d877b349eb239387dccd538b7c97d76 (patch)
treeded4d383f2cbf49459ca6afacdf4e9de7f30dd5d
parentfix printing of uniqueness attributes in type with A. (diff)
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 git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@2332 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
-rw-r--r--backendC/CleanCompilerSources/codegen.c7
-rw-r--r--backendC/CleanCompilerSources/codegen1.c161
-rw-r--r--backendC/CleanCompilerSources/codegen1.h5
-rw-r--r--backendC/CleanCompilerSources/codegen2.c13
-rw-r--r--backendC/CleanCompilerSources/codegen2.h2
-rw-r--r--backendC/CleanCompilerSources/instructions.c96
-rw-r--r--backendC/CleanCompilerSources/instructions.h3
-rw-r--r--backendC/CleanCompilerSources/optimisations.c66
-rw-r--r--backendC/CleanCompilerSources/statesgen.c47
-rw-r--r--backendC/CleanCompilerSources/statesgen.h1
-rw-r--r--backendC/CleanCompilerSources/syntaxtr.t1
11 files changed, 301 insertions, 101 deletions
diff --git a/backendC/CleanCompilerSources/codegen.c b/backendC/CleanCompilerSources/codegen.c
index b4509e9..5912521 100644
--- a/backendC/CleanCompilerSources/codegen.c
+++ b/backendC/CleanCompilerSources/codegen.c
@@ -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);
diff --git a/backendC/CleanCompilerSources/codegen1.c b/backendC/CleanCompilerSources/codegen1.c
index b64a90e..d8e96d9 100644
--- a/backendC/CleanCompilerSources/codegen1.c
+++ b/backendC/CleanCompilerSources/codegen1.c
@@ -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;
diff --git a/backendC/CleanCompilerSources/codegen1.h b/backendC/CleanCompilerSources/codegen1.h
index faadc94..3519449 100644
--- a/backendC/CleanCompilerSources/codegen1.h
+++ b/backendC/CleanCompilerSources/codegen1.h
@@ -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)
diff --git a/backendC/CleanCompilerSources/codegen2.c b/backendC/CleanCompilerSources/codegen2.c
index 3deeed8..25224eb 100644
--- a/backendC/CleanCompilerSources/codegen2.c
+++ b/backendC/CleanCompilerSources/codegen2.c
@@ -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;
diff --git a/backendC/CleanCompilerSources/codegen2.h b/backendC/CleanCompilerSources/codegen2.h
index 07a79db..dfaf07f 100644
--- a/backendC/CleanCompilerSources/codegen2.h
+++ b/backendC/CleanCompilerSources/codegen2.h
@@ -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);
diff --git a/backendC/CleanCompilerSources/instructions.c b/backendC/CleanCompilerSources/instructions.c
index 6234be1..a9c905f 100644
--- a/backendC/CleanCompilerSources/instructions.c
+++ b/backendC/CleanCompilerSources/instructions.c
@@ -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){
diff --git a/backendC/CleanCompilerSources/instructions.h b/backendC/CleanCompilerSources/instructions.h
index e218cca..5249124 100644
--- a/backendC/CleanCompilerSources/instructions.h
+++ b/backendC/CleanCompilerSources/instructions.h
@@ -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);
diff --git a/backendC/CleanCompilerSources/optimisations.c b/backendC/CleanCompilerSources/optimisations.c
index 0eb1cad..955873b 100644
--- a/backendC/CleanCompilerSources/optimisations.c
+++ b/backendC/CleanCompilerSources/optimisations.c
@@ -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 */
+ }
+ case DefaultNode:
+ ReorderNodeDefinitionsAndDetermineUsedEntries (&arg->arg_node->node_node_defs,arg->arg_node->node_arguments->arg_node);
+ break;
+ case 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);
+
+ case_node_p=overloaded_case_node_p->node_node;
+ ReorderNodeDefinitionsAndDetermineUsedEntries (&case_node_p->node_node_defs,case_node_p->node_arguments->arg_node);
+ break;
+ }
+ default:
error_in_function ("ReorderNodeDefinitionsAndDetermineUsedEntries");
-
- ReorderNodeDefinitionsAndDetermineUsedEntries (&arg->arg_node->node_node_defs,arg->arg_node->node_arguments->arg_node);
}
}
diff --git a/backendC/CleanCompilerSources/statesgen.c b/backendC/CleanCompilerSources/statesgen.c
index d6b9f9b..9b28178 100644
--- a/backendC/CleanCompilerSources/statesgen.c
+++ b/backendC/CleanCompilerSources/statesgen.c
@@ -1242,10 +1242,14 @@ void ExamineTypesAndLhsOfSymbols (Symbol symbs)
PolyList UserDefinedArrayFunctions;
+char *current_imported_module; /* also used by instructions.c */
+
void ImportSymbols (Symbol symbols)
{
Symbol symbol;
PolyList array_fun;
+
+ current_imported_module = NULL;
for_l (array_fun,UserDefinedArrayFunctions,pl_next){
SymbDef fun_def;
@@ -1259,14 +1263,20 @@ void ImportSymbols (Symbol symbols)
for_l (symbol,symbols,symb_next){
SymbDef sdef;
- if (symbol->symb_kind==definition)
- sdef=symbol->symb_def;
- else
+ if (symbol->symb_kind!=definition)
continue;
+ sdef=symbol->symb_def;
if (sdef->sdef_module!=CurrentModule){
- if (sdef->sdef_isused)
+ if (sdef->sdef_isused
+ && sdef->sdef_mark & (SDEF_USED_STRICTLY_MASK | SDEF_USED_LAZILY_MASK | SDEF_USED_CURRIED_MASK)
+ ){
+ if (sdef->sdef_module!=current_imported_module){
+ current_imported_module=sdef->sdef_module;
+ GenImpMod (current_imported_module);
+ }
GenImport (sdef);
+ }
if (sdef->sdef_kind==RECORDTYPE){
FieldList fields;
@@ -1276,14 +1286,41 @@ void ImportSymbols (Symbol symbols)
field_sdef=fields->fl_symbol->symb_def;
- if (field_sdef->sdef_isused)
+ if (field_sdef->sdef_isused && field_sdef->sdef_mark & SDEF_USED_LAZILY_MASK){
+ if (sdef->sdef_module!=current_imported_module){
+ current_imported_module=sdef->sdef_module;
+ GenImpMod (current_imported_module);
+ }
GenImport (field_sdef);
+ }
}
}
}
}
}
+void import_not_yet_imported_record_r_labels (Symbol symbols)
+{
+ Symbol symbol;
+
+ for_l (symbol,symbols,symb_next){
+ if (symbol->symb_kind==definition){
+ SymbDef sdef;
+
+ sdef=symbol->symb_def;
+ if ((sdef->sdef_mark & (SDEF_USED_STRICTLY_MASK | SDEF_RECORD_R_LABEL_IMPORTED_MASK))==SDEF_USED_STRICTLY_MASK
+ && sdef->sdef_kind==RECORDTYPE && sdef->sdef_module!=CurrentModule)
+ {
+ if (sdef->sdef_module!=current_imported_module){
+ current_imported_module=sdef->sdef_module;
+ GenImpMod (current_imported_module);
+ }
+ GenImport (sdef);
+ }
+ }
+ }
+}
+
static Bool ShouldDecrRefCount;
#if OPTIMIZE_LAZY_TUPLE_RECURSION
diff --git a/backendC/CleanCompilerSources/statesgen.h b/backendC/CleanCompilerSources/statesgen.h
index 2a8edac..ca3b2da 100644
--- a/backendC/CleanCompilerSources/statesgen.h
+++ b/backendC/CleanCompilerSources/statesgen.h
@@ -18,6 +18,7 @@ extern void DetermineSharedAndAnnotatedNodes (ImpRules rules,SymbolP *im_symbols
extern void DetermineStateOfArrayElem (Symbol elemtype, States state);
extern void ExamineTypesAndLhsOfSymbols (Symbol symbs);
extern void ImportSymbols (Symbol symbols);
+extern void import_not_yet_imported_record_r_labels (Symbol symbols);
extern void DetermineStatesOfRootNodeAndDefs (Node root_node,NodeDefs *rootdef,StateS demstate,int local_scope);
extern unsigned next_def_number;
diff --git a/backendC/CleanCompilerSources/syntaxtr.t b/backendC/CleanCompilerSources/syntaxtr.t
index 885ce1a..ee088dd 100644
--- a/backendC/CleanCompilerSources/syntaxtr.t
+++ b/backendC/CleanCompilerSources/syntaxtr.t
@@ -653,6 +653,7 @@ STRUCT (symbol_def,SymbDef){
#define SDEF_USED_LAZILY_MASK 1
#define SDEF_USED_STRICTLY_MASK 2
#define SDEF_USED_CURRIED_MASK 4
+#define SDEF_RECORD_R_LABEL_IMPORTED_MASK 8
#define SDEF_NEXT_IMP_RULE_VERSION_MASK 32
#define SDEF_HAS_IMP_RULE_VERSIONS_MASK 64
#define SDEF_OPTIMISED_FUNCTION_MASK 128