Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
clean-compiler-and-rts
compiler
Commits
1ea8a0bd
Commit
1ea8a0bd
authored
May 24, 2019
by
johnvg@science.ru.nl
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
replace field sdef_ident by sdef_name in struct symbol_def of backend
parent
a8376e8d
Changes
16
Hide whitespace changes
Inline
Side-by-side
Showing
16 changed files
with
194 additions
and
252 deletions
+194
-252
backendC/CleanCompilerSources/backend.c
backendC/CleanCompilerSources/backend.c
+38
-64
backendC/CleanCompilerSources/checker.h
backendC/CleanCompilerSources/checker.h
+8
-12
backendC/CleanCompilerSources/checker_2.c
backendC/CleanCompilerSources/checker_2.c
+10
-14
backendC/CleanCompilerSources/checksupport.c
backendC/CleanCompilerSources/checksupport.c
+3
-5
backendC/CleanCompilerSources/checksupport.h
backendC/CleanCompilerSources/checksupport.h
+2
-2
backendC/CleanCompilerSources/codegen.c
backendC/CleanCompilerSources/codegen.c
+5
-5
backendC/CleanCompilerSources/codegen1.c
backendC/CleanCompilerSources/codegen1.c
+15
-23
backendC/CleanCompilerSources/codegen2.c
backendC/CleanCompilerSources/codegen2.c
+17
-17
backendC/CleanCompilerSources/codegen3.c
backendC/CleanCompilerSources/codegen3.c
+8
-14
backendC/CleanCompilerSources/comsupport.c
backendC/CleanCompilerSources/comsupport.c
+4
-4
backendC/CleanCompilerSources/instructions.c
backendC/CleanCompilerSources/instructions.c
+61
-67
backendC/CleanCompilerSources/instructions.h
backendC/CleanCompilerSources/instructions.h
+1
-1
backendC/CleanCompilerSources/optimisations.c
backendC/CleanCompilerSources/optimisations.c
+3
-5
backendC/CleanCompilerSources/sa.c
backendC/CleanCompilerSources/sa.c
+11
-11
backendC/CleanCompilerSources/statesgen.c
backendC/CleanCompilerSources/statesgen.c
+7
-7
backendC/CleanCompilerSources/syntaxtr.t
backendC/CleanCompilerSources/syntaxtr.t
+1
-1
No files found.
backendC/CleanCompilerSources/backend.c
View file @
1ea8a0bd
...
...
@@ -148,7 +148,8 @@ static SymbolP gTupleSelectSymbols [MaxNodeArity];
static
int
number_of_node_ids
=
0
;
typedef
IdentP
*
IdentH
;
static
IdentH
gSpecialIdents
[
BESpecialIdentCount
];
static
char
**
gSpecialModules
[
BESpecialIdentCount
];
static
struct
symbol_def
**
gSpecialFunctions
[
BESpecialIdentCount
];
static
IdentP
Identifier
(
char
*
name
)
...
...
@@ -492,7 +493,7 @@ BEBindSpecialModule (BESpecialIdentIndex index, int moduleIndex)
Assert
((
unsigned
int
)
moduleIndex
<
gBEState
.
be_nModules
);
module
=
&
gBEState
.
be_modules
[
moduleIndex
];
(
*
gSpecial
Idents
[
index
])
->
ident_name
=
module
->
bem_name
;
(
*
gSpecial
Modules
[
index
])
=
module
->
bem_name
;
}
/* BEBindSpecialModule */
void
...
...
@@ -510,7 +511,7 @@ BEBindSpecialFunction (BESpecialIdentIndex index, int functionIndex, int moduleI
functionSymbol
=
&
module
->
bem_functions
[
functionIndex
];
if
(
functionSymbol
->
symb_kind
==
definition
){
*
gSpecial
Idents
[
index
]
=
functionSymbol
->
symb_def
->
sdef_ident
;
*
gSpecial
Functions
[
index
]
=
functionSymbol
->
symb_def
;
if
(
index
==
BESpecialIdentSeq
&&
moduleIndex
!=
main_dcl_module_n
){
functionSymbol
->
symb_kind
=
seq_symb
;
...
...
@@ -592,7 +593,6 @@ BESpecialArrayFunctionSymbol (BEArrayFunKind arrayFunKind, int functionIndex, in
{
char
*
functionName
,
*
functionPrefix
;
TypeAlt
*
newTypeAlt
;
IdentP
newIdent
;
SymbDefP
newsdef
;
SymbolP
newFunctionSymbol
;
RuleTypes
newRuleType
;
...
...
@@ -601,7 +601,6 @@ BESpecialArrayFunctionSymbol (BEArrayFunKind arrayFunKind, int functionIndex, in
newFunctionSymbol
=
ConvertAllocType
(
SymbolS
);
newsdef
=
ConvertAllocType
(
SymbDefS
);
newIdent
=
ConvertAllocType
(
IdentS
);
newTypeAlt
=
ConvertAllocType
(
TypeAlt
);
...
...
@@ -661,21 +660,19 @@ BESpecialArrayFunctionSymbol (BEArrayFunKind arrayFunKind, int functionIndex, in
break
;
}
functionName
=
ConvertAlloc
(
strlen
(
functionPrefix
)
+
1
+
strlen
(
originalsdef
->
sdef_
ident
->
ident_
name
)
+
1
);
functionName
=
ConvertAlloc
(
strlen
(
functionPrefix
)
+
1
+
strlen
(
originalsdef
->
sdef_name
)
+
1
);
strcpy
(
functionName
,
functionPrefix
);
strcat
(
functionName
,
";"
);
strcat
(
functionName
,
originalsdef
->
sdef_
ident
->
ident_
name
);
strcat
(
functionName
,
originalsdef
->
sdef_name
);
newTypeAlt
->
type_alt_lhs
=
BESymbolTypeNode
(
NoAnnot
,
NoUniAttr
,
newFunctionSymbol
,
lhsArgs
);
newTypeAlt
->
type_alt_rhs
=
rhs
;
newTypeAlt
->
type_alt_strict_positions
=
NULL
;
newIdent
->
ident_name
=
functionName
;
newRuleType
=
ConvertAllocType
(
struct
rule_type
);
newRuleType
->
rule_type_rule
=
newTypeAlt
;
newsdef
->
sdef_
ident
=
newIdent
;
newsdef
->
sdef_
name
=
functionName
;
newsdef
->
sdef_module
=
gBEState
.
be_icl
.
beicl_module
->
im_name
;
newsdef
->
sdef_mark
=
0
;
newsdef
->
sdef_isused
=
True
;
...
...
@@ -912,7 +909,7 @@ BEDontCareDefinitionSymbol (void)
symbDef
=
ConvertAllocType
(
SymbDefS
);
symbDef
->
sdef_kind
=
ABSTYPE
;
symbDef
->
sdef_
ident
=
Identifier
(
"_Don'tCare"
)
;
/* +++ name */
symbDef
->
sdef_
name
=
"_Don'tCare"
;
/* +++ name */
symbol
=
ConvertAllocType
(
SymbolS
);
symbol
->
symb_kind
=
definition
;
...
...
@@ -2207,7 +2204,7 @@ BECodeAlt (int line, BENodeDefP lhsDefs, BENodeP lhs, BECodeBlockP codeBlock)
Assert
(
lhs
->
node_kind
==
NormalNode
);
Assert
(
lhs
->
node_symbol
->
symb_kind
==
definition
);
functionName
=
lhs
->
node_symbol
->
symb_def
->
sdef_
ident
->
ident_
name
;
functionName
=
lhs
->
node_symbol
->
symb_def
->
sdef_name
;
/* .inline <name> */
instructionLine
=
ConvertAlloc
(
sizeof
(
".inline "
)
+
strlen
(
functionName
));
...
...
@@ -2235,7 +2232,6 @@ static void
DeclareFunctionC
(
char
*
name
,
int
arity
,
int
functionIndex
,
unsigned
int
ancestor
)
{
SymbDefP
newSymbDef
;
Ident
newIdent
;
SymbolP
functions
;
BEIcl
icl
;
BEModule
module
;
...
...
@@ -2263,20 +2259,14 @@ DeclareFunctionC (char *name, int arity, int functionIndex, unsigned int ancesto
*
icl
->
beicl_depsP
=
newSymbDef
;
icl
->
beicl_depsP
=
&
newSymbDef
->
sdef_next_scc
;
newSymbDef
->
sdef_arfun
=
NoArrayFun
;
newIdent
=
ConvertAllocType
(
IdentS
);
newIdent
->
ident_name
=
name
;
newSymbDef
->
sdef_ident
=
newIdent
;
newSymbDef
->
sdef_name
=
name
;
Assert
(
functions
[
functionIndex
].
symb_kind
==
erroneous_symb
);
functions
[
functionIndex
].
symb_kind
=
definition
;
functions
[
functionIndex
].
symb_def
=
newSymbDef
;
/* +++ ugly */
if
(
strcmp
(
newIdent
->
ident_
name
,
"Start"
)
==
0
)
if
(
strcmp
(
name
,
"Start"
)
==
0
)
{
Assert
(
icl
->
beicl_module
->
im_start
==
NULL
);
icl
->
beicl_module
->
im_start
=
newSymbDef
;
...
...
@@ -2346,7 +2336,6 @@ BERule (int functionIndex, int isCaf, BETypeAltP type, BERuleAltP alts)
void
BEDeclareRuleType
(
int
functionIndex
,
int
moduleIndex
,
CleanString
name
)
{
IdentP
newIdent
;
SymbDefP
newSymbDef
;
SymbolP
functions
;
BEModuleP
module
;
...
...
@@ -2361,20 +2350,20 @@ BEDeclareRuleType (int functionIndex, int moduleIndex, CleanString name)
Assert
(
functions
[
functionIndex
].
symb_kind
==
erroneous_symb
);
if
(
module
->
bem_isSystemModule
){
IdentP
newIdent
;
/* for inline code */
newIdent
=
PutStringInHashTable
(
ConvertCleanString
(
name
),
FirstSystemModuleTable
+
moduleIndex
);
newSymbDef
=
ConvertAllocType
(
SymbDefS
);
newIdent
->
ident_sys_rule_def
=
newSymbDef
;
}
else
{
newIdent
=
ConvertAllocType
(
IdentS
);
newIdent
->
ident_name
=
ConvertCleanString
(
name
);
newSymbDef
=
ConvertAllocType
(
SymbDefS
);
}
newSymbDef
->
sdef_kind
=
NEWDEFINITION
;
newSymbDef
->
sdef_exported
=
False
;
newSymbDef
->
sdef_module
=
module
->
bem_name
;
newSymbDef
->
sdef_
ident
=
newIdent
;
newSymbDef
->
sdef_
name
=
ConvertCleanString
(
name
)
;
newSymbDef
->
sdef_mark
=
0
;
newSymbDef
->
sdef_isused
=
0
;
...
...
@@ -2433,7 +2422,6 @@ void
BEDeclareType
(
int
typeIndex
,
int
moduleIndex
,
CleanString
name
)
{
SymbDefP
newSymbDef
;
Ident
newIdent
;
SymbolP
type_p
;
BEModuleP
module
;
...
...
@@ -2445,8 +2433,6 @@ BEDeclareType (int typeIndex, int moduleIndex, CleanString name)
type_p
=
&
module
->
bem_types
[
typeIndex
];
newIdent
=
ConvertAllocType
(
IdentS
);
newIdent
->
ident_name
=
ConvertCleanString
(
name
);
/* RWS change this
newSymbDef = ConvertAllocType (SymbDefS);
*/
...
...
@@ -2460,7 +2446,7 @@ BEDeclareType (int typeIndex, int moduleIndex, CleanString name)
newSymbDef
->
sdef_isused
=
0
;
newSymbDef
->
sdef_module
=
module
->
bem_name
;
newSymbDef
->
sdef_
ident
=
newIdent
;
newSymbDef
->
sdef_
name
=
ConvertCleanString
(
name
)
;
type_p
->
symb_kind
=
definition
;
type_p
->
symb_def
=
newSymbDef
;
...
...
@@ -2624,7 +2610,6 @@ BEFieldListP
BEFieldList
(
int
fieldIndex
,
int
moduleIndex
,
CleanString
name
,
BETypeNodeP
type
,
BEFieldListP
next_fields
)
{
SymbDefP
newSymbDef
;
Ident
newIdent
;
SymbolP
field_symbol_p
;
BEModuleP
module
;
FieldList
field
;
...
...
@@ -2635,9 +2620,6 @@ BEFieldList (int fieldIndex, int moduleIndex, CleanString name, BETypeNodeP type
field_symbol_p
=
&
module
->
bem_fields
[
fieldIndex
];
Assert
(
field_symbol_p
->
symb_kind
==
erroneous_symb
);
newIdent
=
ConvertAllocType
(
IdentS
);
newIdent
->
ident_name
=
ConvertCleanString
(
name
);
field
=
ConvertAllocType
(
struct
field_list
);
field
->
fl_next
=
next_fields
;
field
->
fl_symbol
=
field_symbol_p
;
...
...
@@ -2647,7 +2629,7 @@ BEFieldList (int fieldIndex, int moduleIndex, CleanString name, BETypeNodeP type
newSymbDef
->
sdef_kind
=
FIELDSELECTOR
;
newSymbDef
->
sdef_exported
=
False
;
newSymbDef
->
sdef_module
=
module
->
bem_name
;
newSymbDef
->
sdef_
ident
=
newIdent
;
newSymbDef
->
sdef_
name
=
ConvertCleanString
(
name
)
;
newSymbDef
->
sdef_isused
=
0
;
newSymbDef
->
sdef_sel_field
=
field
;
newSymbDef
->
sdef_arity
=
1
;
...
...
@@ -2738,7 +2720,6 @@ void
BEDeclareConstructor
(
int
constructorIndex
,
int
moduleIndex
,
CleanString
name
)
{
SymbDefP
newSymbDef
;
Ident
newIdent
;
SymbolP
constructor_p
;
BEModuleP
module
;
...
...
@@ -2747,14 +2728,11 @@ BEDeclareConstructor (int constructorIndex, int moduleIndex, CleanString name)
Assert
(
module
->
bem_constructors
[
constructorIndex
].
symb_kind
==
erroneous_symb
);
constructor_p
=
&
module
->
bem_constructors
[
constructorIndex
];
newIdent
=
ConvertAllocType
(
IdentS
);
newIdent
->
ident_name
=
ConvertCleanString
(
name
);
newSymbDef
=
ConvertAllocType
(
SymbDefS
);
newSymbDef
->
sdef_kind
=
NEWDEFINITION
;
newSymbDef
->
sdef_exported
=
False
;
newSymbDef
->
sdef_module
=
module
->
bem_name
;
newSymbDef
->
sdef_
ident
=
newIdent
;
newSymbDef
->
sdef_
name
=
ConvertCleanString
(
name
)
;
newSymbDef
->
sdef_mark
=
0
;
newSymbDef
->
sdef_isused
=
0
;
...
...
@@ -2865,7 +2843,7 @@ BECodeParameterList (CleanString location, BENodeIdP nodeId, BECodeParameterP pa
parameter
=
ConvertAllocType
(
struct
parameter
);
parameter
->
par_node_id
=
nodeId
;
parameter
->
par_loc_name
=
ConvertCleanString
(
location
);
parameter
->
par_loc_name
=
ConvertCleanString
(
location
);
parameter
->
par_next
=
parameters
;
return
parameter
;
...
...
@@ -2978,7 +2956,7 @@ BEExportType (int isDictionary, int typeIndex)
Assert
(
typeSymbol
->
symb_kind
==
definition
);
dclDef
=
typeSymbol
->
symb_def
;
}
Assert
(
strcmp
(
iclDef
->
sdef_
ident
->
ident_
name
,
dclDef
->
sdef_
ident
->
ident_
name
)
==
0
);
Assert
(
strcmp
(
iclDef
->
sdef_name
,
dclDef
->
sdef_name
)
==
0
);
iclDef
->
sdef_dcl_icl
=
dclDef
;
dclDef
->
sdef_dcl_icl
=
iclDef
;
...
...
@@ -3038,7 +3016,7 @@ BEExportField (int isDictionaryField, int fieldIndex)
dclDef
=
fieldSymbol
->
symb_def
;
}
Assert
(
strcmp
(
iclDef
->
sdef_
ident
->
ident_
name
,
dclDef
->
sdef_
ident
->
ident_
name
)
==
0
);
Assert
(
strcmp
(
iclDef
->
sdef_name
,
dclDef
->
sdef_name
)
==
0
);
iclDef
->
sdef_dcl_icl
=
dclDef
;
dclDef
->
sdef_dcl_icl
=
iclDef
;
...
...
@@ -3072,7 +3050,7 @@ BEExportFunction (int functionIndex)
dclDef
->
sdef_dcl_icl
=
iclDef
;
Assert
(
strcmp
(
iclDef
->
sdef_
ident
->
ident_
name
,
dclDef
->
sdef_
ident
->
ident_
name
)
==
0
);
Assert
(
strcmp
(
iclDef
->
sdef_name
,
dclDef
->
sdef_name
)
==
0
);
}
else
dclDef
=
NULL
;
...
...
@@ -3300,31 +3278,27 @@ BEInit (int argc)
ApplyId
=
Identifier
(
"AP"
);
IfId
=
Identifier
(
"if"
);
FailId
=
Identifier
(
"_Fail"
);
#if DYNAMIC_TYPE
DynamicId
=
Identifier
(
"Dynamic"
);
#endif
#if SA_RECOGNIZES_ABORT_AND_UNDEF
StdMiscId
=
Identifier
(
"StdMisc"
);
abort_id
=
NULL
;
undef_id
=
NULL
;
gSpecialIdents
[
BESpecialIdentStdMisc
]
=
&
StdMiscId
;
gSpecialIdents
[
BESpecialIdentAbort
]
=
&
abort_id
;
gSpecialIdents
[
BESpecialIdentUndef
]
=
&
undef_id
;
StdMiscId
=
NULL
;
abort_symb_def
=
NULL
;
undef_symb_def
=
NULL
;
gSpecialModules
[
BESpecialIdentStdMisc
]
=
&
StdMiscId
;
gSpecialFunctions
[
BESpecialIdentAbort
]
=
&
abort_symb_def
;
gSpecialFunctions
[
BESpecialIdentUndef
]
=
&
undef_symb_def
;
#endif
StdBoolId
=
Identifier
(
"StdBool"
)
;
And
Id
=
NULL
;
Or
Id
=
NULL
;
gSpecial
Idents
[
BESpecialIdentStdBool
]
=
&
StdBoolId
;
gSpecial
Idents
[
BESpecialIdentAnd
]
=
&
And
Id
;
gSpecial
Idents
[
BESpecialIdentOr
]
=
&
Or
Id
;
PreludeId
=
Identifier
(
"Prelude"
)
;
seq_
id
=
NULL
;
gSpecial
Ident
s
[
BESpecialIdentPrelude
]
=
&
PreludeId
;
gSpecial
Ident
s
[
BESpecialIdentSeq
]
=
&
seq_
id
;
StdBoolId
=
"StdBool"
;
And
SymbDef
=
NULL
;
Or
SymbDef
=
NULL
;
gSpecial
Modules
[
BESpecialIdentStdBool
]
=
&
StdBoolId
;
gSpecial
Functions
[
BESpecialIdentAnd
]
=
&
And
SymbDef
;
gSpecial
Functions
[
BESpecialIdentOr
]
=
&
Or
SymbDef
;
PreludeId
=
"Prelude"
;
seq_
symb_def
=
NULL
;
gSpecial
Module
s
[
BESpecialIdentPrelude
]
=
&
PreludeId
;
gSpecial
Function
s
[
BESpecialIdentSeq
]
=
&
seq_
symb_def
;
UserDefinedArrayFunctions
=
NULL
;
#if STRICT_LISTS
...
...
backendC/CleanCompilerSources/checker.h
View file @
1ea8a0bd
extern
Ident
ApplyId
,
IfId
,
FailId
,
StdBoolId
,
AndId
,
OrId
,
ArrayId
,
StrictArrayId
,
UnboxedArrayId
,
ArrayClassId
;
#if STRICT_LISTS
extern
Ident
StrictListId
,
UnboxedListId
,
TailStrictListId
,
StrictTailStrictListId
,
UnboxedTailStrictListId
;
#endif
#ifdef CLEAN2
extern
Ident
DynamicId
;
#endif
extern
Ident
ApplyId
,
IfId
,
FailId
;
extern
char
*
StdBoolId
;
extern
SymbDef
AndSymbDef
,
OrSymbDef
,
abort_symb_def
,
undef_symb_def
;
#if SA_RECOGNIZES_ABORT_AND_UNDEF
extern
Ident
StdMiscId
,
abort_id
,
undef_id
;
extern
char
*
StdMiscId
;
#endif
extern
Ident
PreludeId
,
seq_id
,
system_seq_id
;
extern
char
*
PreludeId
;
extern
SymbDef
seq_symb_def
;
extern
Symbol
StartSymbol
;
extern
SymbDef
scc_dependency_list
;
SymbDef
MakeNewSymbolDefinition
(
char
*
module
,
Ident
name
,
int
arity
,
SDefKind
kind
);
SymbDef
MakeNewSymbolDefinition
(
char
*
module
,
char
*
name
,
int
arity
,
SDefKind
kind
);
char
*
ConvertSymbolToString
(
Symbol
symb
);
void
ReadInlineCode
(
void
);
void
InitChecker
(
void
);
...
...
backendC/CleanCompilerSources/checker_2.c
View file @
1ea8a0bd
...
...
@@ -72,28 +72,29 @@ void ReadInlineCode (void)
}
}
Ident
ApplyId
,
DynamicId
,
StdBoolId
,
IfId
,
FailId
,
AndId
,
OrId
;
Ident
ApplyId
,
IfId
,
FailId
;
char
*
StdBoolId
;
SymbDef
AndSymbDef
,
OrSymbDef
;
#if SA_RECOGNIZES_ABORT_AND_UNDEF
Ident
StdMiscId
,
abort_id
,
undef_id
;
char
*
StdMiscId
;
SymbDef
abort_symb_def
,
undef_symb_def
;
#endif
Ident
PreludeId
,
seq_id
,
system_seq_id
;
Symbol
StartSymbol
;
SymbDef
ArrayFunctionDefs
[
NoArrayFun
],
StdArrayAbortDef
;
char
*
PreludeId
;
SymbDef
seq_symb_def
;
SymbDef
scc_dependency_list
;
SymbDef
MakeNewSymbolDefinition
(
char
*
module
,
Ident
name
,
int
arity
,
SDefKind
kind
)
SymbDef
MakeNewSymbolDefinition
(
char
*
module
,
char
*
name
,
int
arity
,
SDefKind
kind
)
{
SymbDef
def
;
def
=
CompAllocType
(
SymbDefS
);
def
->
sdef_module
=
module
;
def
->
sdef_
ident
=
name
;
def
->
sdef_
name
=
name
;
def
->
sdef_arity
=
arity
;
def
->
sdef_kind
=
kind
;
...
...
@@ -121,11 +122,6 @@ NodeDefs NewNodeDef (NodeId nid,Node node)
void
InitChecker
(
void
)
{
StartSymbol
=
NewSymbol
(
newsymbol
);
StartSymbol
->
symb_ident
=
NewIdent
(
"Start"
);
system_seq_id
=
NewIdent
(
"seq"
);
OpenDefinitionModules
=
NIL
;
}
...
...
backendC/CleanCompilerSources/checksupport.c
View file @
1ea8a0bd
...
...
@@ -28,7 +28,7 @@ char *ConvertSymbolKindToString (SymbKind skind)
case
fun_type
:
return
"=>"
;
case
list_type
:
return
"List"
;
case
tuple_type
:
return
"Tuple"
;
case
dynamic_type
:
return
Dynamic
Id
->
ident_name
;
case
dynamic_type
:
return
"
Dynamic
"
;
default:
return
"Erroneous"
;
}
...
...
@@ -142,11 +142,9 @@ static char *PrintName (char *name, char *name_end, unsigned line_nr, File file)
#define _ANALYSE_IDENT_
/* also in optimisations.c */
void
PrintSymbolOfIdent
(
Ident
sid
,
unsigned
line_nr
,
File
file
)
void
PrintSymbolOfIdent
(
char
*
name
,
unsigned
line_nr
,
File
file
)
{
char
*
next_char
,
*
name
;
name
=
sid
->
ident_name
;
char
*
next_char
;
#ifdef _ANALYSE_IDENT_
if
(
*
name
==
cTypeDelimiter
)
...
...
backendC/CleanCompilerSources/checksupport.h
View file @
1ea8a0bd
...
...
@@ -13,7 +13,7 @@ extern void CheckWarningOrError (Bool error,char *msg1,char *msg2);
extern
void
CheckWarningOrError2
(
Bool
error
,
char
*
msg1
,
char
*
msg2
,
char
*
msg3
);
extern
void
CheckSymbolWarningOrError
(
Bool
error
,
struct
symbol
*
symbol
,
char
*
msg
);
#define NameOfSymbol(symb) ((symb)->symb_def ->sdef_
ident->ident_
name)
#define NameOfSymbol(symb) ((symb)->symb_def ->sdef_name)
extern
void
PrintSymbolOfIdent
(
Ident
sid
,
unsigned
line_nr
,
File
file
);
extern
void
PrintSymbolOfIdent
(
char
*
name
,
unsigned
line_nr
,
File
file
);
backendC/CleanCompilerSources/codegen.c
View file @
1ea8a0bd
...
...
@@ -72,7 +72,7 @@ static Parameters CalculateOffsetsOfParameters (Parameters params,States results
if
(
params
)
params
=
CalculateOffsetsOfParameter
(
params
,
resultstates
[
arity
],
asp_p
,
bsp_p
);
else
{
StaticMessage
(
True
,
CurrentAltLabel
.
lab_symbol
->
sdef_
ident
->
ident_
name
,
ECodeBlock
);
StaticMessage
(
True
,
CurrentAltLabel
.
lab_symbol
->
sdef_name
,
ECodeBlock
);
break
;
}
}
...
...
@@ -118,7 +118,7 @@ static void GenCodeBlock (CodeBlock code, int asp, int bsp, StateS resultstate)
}
if
(
nextparam
)
StaticMessage
(
True
,
CurrentAltLabel
.
lab_symbol
->
sdef_
ident
->
ident_
name
,
ECodeBlock
);
StaticMessage
(
True
,
CurrentAltLabel
.
lab_symbol
->
sdef_name
,
ECodeBlock
);
GenParameters
(
True
,
code
->
co_parin
,
asp
,
bsp
);
GenInstructions
(
code
->
co_instr
);
...
...
@@ -673,7 +673,7 @@ static void CodeRule (ImpRuleP rule)
GenFunctionDescriptorAndExportNodeAndDescriptor
(
rule_sdef
);
if
(
DoTimeProfiling
)
GenPB_ident
(
rule_sdef
->
sdef_
ident
,
0
/*rule_sdef->sdef_line*/
);
GenPB_ident
(
rule_sdef
->
sdef_
name
,
0
/*rule_sdef->sdef_line*/
);
if
(
rule_sdef
->
sdef_exported
&&
rule_sdef
->
sdef_calledwithrootnode
&&
ExpectsResultNode
(
resultstate
))
MakeSymbolLabel
(
&
ea_lab
,
CurrentModule
,
ea_pref
,
rule_sdef
,
0
);
...
...
@@ -795,7 +795,7 @@ static void CodeRule (ImpRuleP rule)
GenOStackLayoutOfStates
(
a_stack_size_of_strict_entry
,
init_b_stack_top
,
rule_sdef
->
sdef_arity
,
rule
->
rule_state_p
);
GenLabelDefinition
(
&
CurrentAltLabel
);
MakeLabel
(
&
caf_label
,
rule_sdef
->
sdef_
ident
->
ident_
name
,
0
,
caf_pref
);
MakeLabel
(
&
caf_label
,
rule_sdef
->
sdef_name
,
0
,
caf_pref
);
MakeLabel
(
&
local_label
,
m_symb
,
NewLabelNr
++
,
no_pref
);
DetermineSizeOfState
(
resultstate
,
&
a_size
,
&
b_size
);
...
...
@@ -850,7 +850,7 @@ static void CodeRule (ImpRuleP rule)
tail_call_modulo_cons
=
1
;
if
(
ListOptimizations
)
printf
(
"Optimize tail call modulo cons of %s
\n
"
,
rule_sdef
->
sdef_
ident
->
ident_
name
);
printf
(
"Optimize tail call modulo cons of %s
\n
"
,
rule_sdef
->
sdef_name
);
call_code_generator_again
=
1
;
}
else
tail_call_modulo_cons
=
0
;
...
...
backendC/CleanCompilerSources/codegen1.c
View file @
1ea8a0bd
...
...
@@ -259,14 +259,13 @@ void ConvertSymbolToRLabel (LabDef *slab,SymbDef sdef)
}
else
{
sdef
->
sdef_mark
|=
SDEF_USED_STRICTLY_MASK
|
SDEF_RECORD_R_LABEL_IMPORTED_MASK
;
GenImpRecordDesc
(
modname
,
sdef
->
sdef_
ident
->
ident_
name
);
GenImpRecordDesc
(
modname
,
sdef
->
sdef_name
);
}
}
MakeSymbolLabel
(
slab
,
modname
,
r_pref
,
sdef
,
0
);
}
static
SymbDefS
lazy_tuple_selector_sdef
;
static
IdentS
lazy_tuple_selector_ident
;
void
BuildLazyTupleSelectorLabel
(
Label
slab
,
int
arity
,
int
argnr
)
{
...
...
@@ -274,8 +273,7 @@ void BuildLazyTupleSelectorLabel (Label slab, int arity, int argnr)
LazyTupleSelectors
[
argnr
-
NrOfGlobalSelectors
-
1
]
=
True
;
if
(
ExportLocalLabels
){
lazy_tuple_selector_sdef
.
sdef_exported
=
True
;
lazy_tuple_selector_sdef
.
sdef_ident
=&
lazy_tuple_selector_ident
;
lazy_tuple_selector_ident
.
ident_name
=
loc_sel
;
lazy_tuple_selector_sdef
.
sdef_name
=
loc_sel
;
MakeSymbolLabel
(
slab
,
CurrentModule
,
n_pref
,
&
lazy_tuple_selector_sdef
,
argnr
);
}
else
{
LazyTupleSelectors
[
argnr
-
NrOfGlobalSelectors
-
1
]
=
True
;
...
...
@@ -831,7 +829,7 @@ static void GenerateLazyConstructorDescriptorAndFunctionForStrictConstructor (Co
GenConstructorFunctionDescriptorAndExportNodeAndDescriptor
(
constructor_def
);
if
(
DoTimeProfiling
)
GenPB
(
constructor_def
->
sdef_
ident
->
ident_
name
);
GenPB
(
constructor_def
->
sdef_name
);
MakeSymbolLabel
(
&
ealab
,
constructor_def
->
sdef_exported
?
CurrentModule
:
NULL
,
ea_pref
,
constructor_def
,
0
);
...
...
@@ -915,7 +913,7 @@ static void GenLazyRecordEntry (SymbDef rdef)
eu_label_p
=
NULL
;
if
(
DoTimeProfiling
)
GenPB
(
rdef
->
sdef_
ident
->
ident_
name
);
GenPB
(
rdef
->
sdef_name
);
GenLazyRecordDescriptorAndExport
(
rdef
);
...
...
@@ -992,11 +990,11 @@ static void GenLazyFieldSelectorEntry (SymbDef field_def,StateS recstate,int tot
#endif
if
(
DoTimeProfiling
)
GenPB
(
field_def
->
sdef_
ident
->
ident_
name
);
GenPB
(
field_def
->
sdef_name
);
update_root_node
=
!
ExpectsResultNode
(
offfieldstate
);
record_name
=
field_def
->
sdef_type
->
type_symbol
->
symb_def
->
sdef_
ident
->
ident_
name
;
record_name
=
field_def
->
sdef_type
->
type_symbol
->
symb_def
->
sdef_name
;
if
(
field_def
->
sdef_calledwithrootnode
){
ealab
=
CurrentAltLabel
;
...
...
@@ -1183,7 +1181,7 @@ static int generate_instance_entry_arguments
member_state_p
=
dictionary_field
->
sdef_member_states_of_field
;
if
(
DoDebug
)
FPrintF
(
OutFile
,
"
\n
||
\t
member type %s %d %d"
,
dictionary_field
->
sdef_
ident
->
ident_
name
,
member_arity
,
function_arity
);
FPrintF
(
OutFile
,
"
\n
||
\t
member type %s %d %d"
,
dictionary_field
->
sdef_name
,
member_arity
,
function_arity
);
n_dictionary_args
=
function_arity
-
member_arity
;
...
...
@@ -1398,7 +1396,7 @@ static void GenUnboxedRecordConsApplyAndNodeEntries
GenArrayFunctionDescriptor
(
fun_def
,
&
CurrentAltLabel
,
arity
);
if
(
DoTimeProfiling
)
GenPB
(
fun_def
->
sdef_
ident
->
ident_
name
);
GenPB
(
fun_def
->
sdef_name
);
if
(
fun_def
->
sdef_mark
&
SDEF_USED_CURRIED_MASK
){
struct
label
i_label
;
...
...
@@ -1442,7 +1440,7 @@ static void GenUnboxedRecordDeconsApplyAndNodeEntries (SymbDef fun_def,int *a_si
GenArrayFunctionDescriptor
(
fun_def
,
&
CurrentAltLabel
,
arity
);
if
(
DoTimeProfiling
)
GenPB
(
fun_def
->
sdef_
ident
->
ident_
name
);
GenPB
(
fun_def
->
sdef_name
);
if
(
fun_def
->
sdef_mark
&
SDEF_USED_CURRIED_MASK
){
struct
label
i_label
;
...
...
@@ -1487,7 +1485,7 @@ static void GenUnboxedRecordApplyAndNodeEntries (SymbDef fun_def,int *a_size_p,i
GenArrayFunctionDescriptor
(
fun_def
,
&
CurrentAltLabel
,
arity
);
if
(
DoTimeProfiling
)
GenPB
(
fun_def
->
sdef_
ident
->
ident_
name
);
GenPB
(
fun_def
->
sdef_name
);
if
(
fun_def
->
sdef_mark
&
SDEF_USED_CURRIED_MASK
){
struct
label
i_label
;
...
...
@@ -1534,7 +1532,7 @@ void GenerateCodeForLazyUnboxedRecordListFunctions (void)
unboxed_record_cons_lab
.
lab_symbol
=
type_node_arguments_p
->
type_arg_node
->
type_node_symbol
->
symb_def
;
unboxed_record_cons_lab
.
lab_issymbol
=
True
;
}
else
{
unboxed_record_cons_lab
.
lab_name
=
type_node_arguments_p
->
type_arg_node
->
type_node_symbol
->
symb_def
->
sdef_
ident
->
ident_
name
;
unboxed_record_cons_lab
.
lab_name
=
type_node_arguments_p
->
type_arg_node
->
type_node_symbol
->
symb_def
->
sdef_name
;
unboxed_record_cons_lab
.
lab_issymbol
=
False
;
}
unboxed_record_cons_lab
.
lab_pref
=
tail_strict
?
"r_Cons#!"
:
"r_Cons#"
;
...
...
@@ -2575,7 +2573,6 @@ SymbDef CreateUpdateFunction (ArgS *record_arg,ArgS *first_field_arg,Node node
{
static
char
update_function_name
[
16
];
SymbDef
update_function_sdef
;
Ident
update_function_ident
;
Symbol
update_function_symbol
;
ArgS
*
previous_arg
,
*
arg
;
Node
lhs_root
,
rhs_root
;
...
...
@@ -2599,8 +2596,7 @@ SymbDef CreateUpdateFunction (ArgS *record_arg,ArgS *first_field_arg,Node node
}
else
strict_record_state_p
=
&
record_state
;
update_function_ident
=
NewIdent
(
update_function_name
);
update_function_sdef
=
MakeNewSymbolDefinition
(
CurrentModule
,
update_function_ident
,
n_arguments
,
IMPRULE
);
update_function_sdef
=
MakeNewSymbolDefinition
(
CurrentModule
,
update_function_name
,
n_arguments
,
IMPRULE
);
update_function_sdef
->
sdef_number
=
next_def_number
++
;
update_function_sdef
->
sdef_isused
=
True
;
...
...
@@ -2757,7 +2753,6 @@ SymbDef create_select_function (Symbol selector_symbol,int selector_kind)
{
static
char
select_function_name
[
16
];
SymbDef
select_function_sdef
;
Ident
select_function_ident
;
Symbol
select_function_symbol
;
NodeP
lhs_root
,
rhs_root
;
ImpRuleS
*
update_imp_rule
;
...
...
@@ -2773,8 +2768,7 @@ SymbDef create_select_function (Symbol selector_symbol,int selector_kind)
sprintf
(
select_function_name
,
"_sel%d"
,
next_update_function_n
);
++
next_update_function_n
;
select_function_ident
=
NewIdent
(
select_function_name
);
select_function_sdef
=
MakeNewSymbolDefinition
(
CurrentModule
,
select_function_ident
,
1
,
IMPRULE
);
select_function_sdef
=
MakeNewSymbolDefinition
(
CurrentModule
,
select_function_name
,
1
,
IMPRULE
);
U5
(
select_function_sdef
,
sdef_number
=
next_def_number
++
,
sdef_isused
=
True
,
...
...
@@ -2856,14 +2850,12 @@ SymbDef create_select_function (Symbol selector_symbol,int selector_kind)
static
SymbDef
create_match_function_sdef
(
void
)
{
char
match_function_name
[
16
];
Ident
match_function_ident
;
SymbDef
match_function_sdef
;
sprintf
(
match_function_name
,
"_match%d"
,
next_match_function_n
);
++
next_match_function_n
;
match_function_ident
=
NewIdent
(
match_function_name
);
match_function_sdef
=
MakeNewSymbolDefinition
(
CurrentModule
,
match_function_ident
,
1
,
IMPRULE
);