Skip to content
Projects
Groups
Snippets
Help
This project
Loading...
Sign in / Register
Toggle navigation
R
riscv-gcc-1
Overview
Overview
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
lvzhengyang
riscv-gcc-1
Commits
8f9df7d8
Commit
8f9df7d8
authored
Apr 19, 2004
by
Vincent Celier
Committed by
Arnaud Charlet
Apr 20, 2004
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
* makeutl.ads, makeutl.adb: New files.
From-SVN: r80868
parent
8e48104d
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
477 additions
and
0 deletions
+477
-0
gcc/ada/ChangeLog
+2
-0
gcc/ada/makeutl.adb
+387
-0
gcc/ada/makeutl.ads
+88
-0
No files found.
gcc/ada/ChangeLog
View file @
8f9df7d8
...
...
@@ -91,6 +91,8 @@
(
Gnatmake
):
Move
sorting
of
linker
options
to
function
Makeutl
.
Linker_Options_Switches
.
*
makeutl
.
ads
,
makeutl
.
adb
:
New
files
.
*
Makefile
.
in
:
Add
makeutl
.
o
to
the
object
files
for
gnatmake
*
makeusg
.
adb
:
Add
line
for
new
switch
-
eL
.
...
...
gcc/ada/makeutl.adb
0 → 100644
View file @
8f9df7d8
------------------------------------------------------------------------------
--
--
--
GNAT
COMPILER
COMPONENTS
--
--
--
--
M
A
K
E
U
T
L
--
--
--
--
B
o
d
y
--
--
--
--
Copyright
(
C
)
2004
Free
Software
Foundation
,
Inc
.
--
--
--
--
GNAT
is
free
software
;
you
can
redistribute
it
and
/
or
modify
it
under
--
--
terms
of
the
GNU
General
Public
License
as
published
by
the
Free
Soft
-
--
--
ware
Foundation
;
either
version
2
,
or
(
at
your
option
)
any
later
ver
-
--
--
sion
.
GNAT
is
distributed
in
the
hope
that
it
will
be
useful
,
but
WITH
-
--
--
OUT
ANY
WARRANTY
;
without
even
the
implied
warranty
of
MERCHANTABILITY
--
--
or
FITNESS
FOR
A
PARTICULAR
PURPOSE
.
See
the
GNU
General
Public
License
--
--
for
more
details
.
You
should
have
received
a
copy
of
the
GNU
General
--
--
Public
License
distributed
with
GNAT
;
see
file
COPYING
.
If
not
,
write
--
--
to
the
Free
Software
Foundation
,
59
Temple
Place
-
Suite
330
,
Boston
,
--
--
MA
02111
-
1307
,
USA
.
--
--
--
--
GNAT
was
originally
developed
by
the
GNAT
team
at
New
York
University
.
--
--
Extensive
contributions
were
provided
by
Ada
Core
Technologies
Inc
.
--
--
--
------------------------------------------------------------------------------
with
Namet
;
use
Namet
;
with
Prj
;
use
Prj
;
with
Prj
.
Ext
;
with
Prj
.
Util
;
with
Snames
;
use
Snames
;
with
Table
;
with
Types
;
use
Types
;
package
body
Makeutl
is
type
Linker_Options_Data
is
record
Project
:
Project_Id
;
Options
:
String_List_Id
;
end
record
;
Linker_Option_Initial_Count
:
constant
:=
20
;
Linker_Options_Buffer
:
String_List_Access
:=
new
String_List
(
1
..
Linker_Option_Initial_Count
);
Last_Linker_Option
:
Natural
:=
0
;
package
Linker_Opts
is
new
Table
.
Table
(
Table_Component_Type
=>
Linker_Options_Data
,
Table_Index_Type
=>
Integer
,
Table_Low_Bound
=>
1
,
Table_Initial
=>
10
,
Table_Increment
=>
100
,
Table_Name
=>
"Make.Linker_Opts"
);
procedure
Add_Linker_Option
(
Option
:
String
);
-----------------------
--
Add_Linker_Option
--
-----------------------
procedure
Add_Linker_Option
(
Option
:
String
)
is
begin
if
Option
'Length > 0 then
if Last_Linker_Option = Linker_Options_Buffer'
Last
then
declare
New_Buffer
:
constant
String_List_Access
:=
new
String_List
(
1
..
Linker_Options_Buffer
'Last +
Linker_Option_Initial_Count);
begin
New_Buffer (Linker_Options_Buffer'
Range
)
:=
Linker_Options_Buffer
.
all
;
Linker_Options_Buffer
.
all
:=
(
others
=>
null
);
Free
(
Linker_Options_Buffer
);
Linker_Options_Buffer
:=
New_Buffer
;
end
;
end
if
;
Last_Linker_Option
:=
Last_Linker_Option
+
1
;
Linker_Options_Buffer
(
Last_Linker_Option
)
:=
new
String
'(Option);
end if;
end Add_Linker_Option;
----------------------------
-- Is_External_Assignment --
----------------------------
function Is_External_Assignment (Argv : String) return Boolean is
Start : Positive := 3;
Finish : Natural := Argv'
Last
;
Equal_Pos
:
Natural
;
begin
if
Argv
'Last < 5 then
return False;
elsif Argv (3) = '
"' then
if Argv (Argv'Last) /= '"
' or else Argv'
Last
<
7
then
return
False
;
else
Start
:=
4
;
Finish
:=
Argv
'Last - 1;
end if;
end if;
Equal_Pos := Start;
while Equal_Pos <= Finish and then Argv (Equal_Pos) /= '
=
' loop
Equal_Pos := Equal_Pos + 1;
end loop;
if Equal_Pos = Start
or else Equal_Pos >= Finish
then
return False;
else
Prj.Ext.Add
(External_Name => Argv (Start .. Equal_Pos - 1),
Value => Argv (Equal_Pos + 1 .. Finish));
return True;
end if;
end Is_External_Assignment;
-----------------------------
-- Linker_Options_Switches --
-----------------------------
function Linker_Options_Switches
(Project : Project_Id)
return String_List
is
----------------------------------
-- Recursive_Add_Linker_Options --
----------------------------------
procedure Recursive_Add_Linker_Options (Proj : Project_Id);
procedure Recursive_Add_Linker_Options (Proj : Project_Id) is
Data : Project_Data;
Linker_Package : Package_Id;
Options : Variable_Value;
Imported : Project_List;
begin
if Proj /= No_Project then
Data := Projects.Table (Proj);
if not Data.Seen then
Projects.Table (Proj).Seen := True;
Imported := Data.Imported_Projects;
while Imported /= Empty_Project_List loop
Recursive_Add_Linker_Options
(Project_Lists.Table (Imported).Project);
Imported := Project_Lists.Table (Imported).Next;
end loop;
if Proj /= Project then
Linker_Package :=
Prj.Util.Value_Of
(Name => Name_Linker,
In_Packages => Data.Decl.Packages);
Options :=
Prj.Util.Value_Of
(Name => Name_Ada,
Attribute_Or_Array_Name => Name_Linker_Options,
In_Package => Linker_Package);
-- If attribute is present, add the project with
-- the attribute to table Linker_Opts.
if Options /= Nil_Variable_Value then
Linker_Opts.Increment_Last;
Linker_Opts.Table (Linker_Opts.Last) :=
(Project => Proj, Options => Options.Values);
end if;
end if;
end if;
end if;
end Recursive_Add_Linker_Options;
begin
Linker_Opts.Init;
for Index in 1 .. Projects.Last loop
Projects.Table (Index).Seen := False;
end loop;
Recursive_Add_Linker_Options (Project);
Last_Linker_Option := 0;
for Index in reverse 1 .. Linker_Opts.Last loop
declare
Options : String_List_Id := Linker_Opts.Table (Index).Options;
Proj : constant Project_Id :=
Linker_Opts.Table (Index).Project;
Option : Name_Id;
begin
-- If Dir_Path has not been computed for this project, do it now
if Projects.Table (Proj).Dir_Path = null then
Projects.Table (Proj).Dir_Path :=
new String'
(
Get_Name_String
(
Projects
.
Table
(
Proj
).
Directory
));
end
if
;
while
Options
/=
Nil_String
loop
Option
:=
String_Elements
.
Table
(
Options
).
Value
;
Options
:=
String_Elements
.
Table
(
Options
).
Next
;
Add_Linker_Option
(
Get_Name_String
(
Option
));
--
Object
files
and
-
L
switches
specified
with
--
relative
paths
and
must
be
converted
to
--
absolute
paths
.
Test_If_Relative_Path
(
Switch
=>
Linker_Options_Buffer
(
Last_Linker_Option
),
Parent
=>
Projects
.
Table
(
Proj
).
Dir_Path
,
Including_L_Switch
=>
True
);
end
loop
;
end
;
end
loop
;
return
Linker_Options_Buffer
(
1
..
Last_Linker_Option
);
end
Linker_Options_Switches
;
-----------
--
Mains
--
-----------
package
body
Mains
is
package
Names
is
new
Table
.
Table
(
Table_Component_Type
=>
File_Name_Type
,
Table_Index_Type
=>
Integer
,
Table_Low_Bound
=>
1
,
Table_Initial
=>
10
,
Table_Increment
=>
100
,
Table_Name
=>
"Makeutl.Mains.Names"
);
--
The
table
that
stores
the
mains
Current
:
Natural
:=
0
;
--
The
index
of
the
last
main
retrieved
from
the
table
--------------
--
Add_Main
--
--------------
procedure
Add_Main
(
Name
:
String
)
is
begin
Name_Len
:=
0
;
Add_Str_To_Name_Buffer
(
Name
);
Names
.
Increment_Last
;
Names
.
Table
(
Names
.
Last
)
:=
Name_Find
;
end
Add_Main
;
------------
--
Delete
--
------------
procedure
Delete
is
begin
Names
.
Set_Last
(
0
);
Reset
;
end
Delete
;
---------------
--
Next_Main
--
---------------
function
Next_Main
return
String
is
begin
if
Current
>=
Names
.
Last
then
return
""
;
else
Current
:=
Current
+
1
;
return
Get_Name_String
(
Names
.
Table
(
Current
));
end
if
;
end
Next_Main
;
---------------------
--
Number_Of_Mains
--
---------------------
function
Number_Of_Mains
return
Natural
is
begin
return
Names
.
Last
;
end
Number_Of_Mains
;
-----------
--
Reset
--
-----------
procedure
Reset
is
begin
Current
:=
0
;
end
Reset
;
end
Mains
;
---------------------------
--
Test_If_Relative_Path
--
---------------------------
procedure
Test_If_Relative_Path
(
Switch
:
in
out
String_Access
;
Parent
:
String_Access
;
Including_L_Switch
:
Boolean
:=
True
)
is
begin
if
Switch
/=
null
then
declare
Sw
:
String
(
1
..
Switch
'Length);
Start : Positive;
begin
Sw := Switch.all;
if Sw (1) = '
-
' then
if Sw'
Length
>=
3
and
then
(
Sw
(
2
)
=
'A'
or
else
Sw
(
2
)
=
'I'
or
else
(
Including_L_Switch
and
then
Sw
(
2
)
=
'L'
))
then
Start
:=
3
;
if
Sw
=
"-I-"
then
return
;
end
if
;
elsif
Sw
'Length >= 4
and then (Sw (2 .. 3) = "aL"
or else Sw (2 .. 3) = "aO"
or else Sw (2 .. 3) = "aI")
then
Start := 4;
else
return;
end if;
-- Because relative path arguments to --RTS= may be relative
-- to the search directory prefix, those relative path
-- arguments are not converted.
if not Is_Absolute_Path (Sw (Start .. Sw'
Last
))
then
if
Parent
=
null
or
else
Parent
'Length = 0 then
Do_Fail
("relative search path switches (""",
Sw,
""") are not allowed");
else
Switch :=
new String'
(
Sw
(
1
..
Start
-
1
)
&
Parent
.
all
&
Directory_Separator
&
Sw
(
Start
..
Sw
'Last));
end if;
end if;
else
if not Is_Absolute_Path (Sw) then
if Parent = null or else Parent'
Length
=
0
then
Do_Fail
(
"relative paths ("""
,
Sw
,
""") are not allowed"
);
else
Switch
:=
new
String
'(Parent.all & Directory_Separator & Sw);
end if;
end if;
end if;
end;
end if;
end Test_If_Relative_Path;
end Makeutl;
gcc/ada/makeutl.ads
0 → 100644
View file @
8f9df7d8
------------------------------------------------------------------------------
--
--
--
GNAT
COMPILER
COMPONENTS
--
--
--
--
M
A
K
E
U
T
L
--
--
--
--
S
p
e
c
--
--
--
--
Copyright
(
C
)
2004
Free
Software
Foundation
,
Inc
.
--
--
--
--
GNAT
is
free
software
;
you
can
redistribute
it
and
/
or
modify
it
under
--
--
terms
of
the
GNU
General
Public
License
as
published
by
the
Free
Soft
-
--
--
ware
Foundation
;
either
version
2
,
or
(
at
your
option
)
any
later
ver
-
--
--
sion
.
GNAT
is
distributed
in
the
hope
that
it
will
be
useful
,
but
WITH
-
--
--
OUT
ANY
WARRANTY
;
without
even
the
implied
warranty
of
MERCHANTABILITY
--
--
or
FITNESS
FOR
A
PARTICULAR
PURPOSE
.
See
the
GNU
General
Public
License
--
--
for
more
details
.
You
should
have
received
a
copy
of
the
GNU
General
--
--
Public
License
distributed
with
GNAT
;
see
file
COPYING
.
If
not
,
write
--
--
to
the
Free
Software
Foundation
,
59
Temple
Place
-
Suite
330
,
Boston
,
--
--
MA
02111
-
1307
,
USA
.
--
--
--
--
GNAT
was
originally
developed
by
the
GNAT
team
at
New
York
University
.
--
--
Extensive
contributions
were
provided
by
Ada
Core
Technologies
Inc
.
--
--
--
------------------------------------------------------------------------------
with
GNAT
.
OS_Lib
;
use
GNAT
.
OS_Lib
;
with
Osint
;
with
Prj
;
use
Prj
;
package
Makeutl
is
type
Fail_Proc
is
access
procedure
(
S1
:
String
;
S2
:
String
:=
""
;
S3
:
String
:=
""
);
Do_Fail
:
Fail_Proc
:=
Osint
.
Fail
'Access;
function Is_External_Assignment (Argv : String) return Boolean;
-- Verify that an external assignment switch is syntactically correct.
-- Correct forms are
-- -Xname=value
-- -X"name=other value"
-- Assumptions: '
First
=
1
,
Argv
(
1
..
2
)
=
"-X"
--
When
this
function
returns
True
,
the
external
assignment
has
--
been
entered
by
a
call
to
Prj
.
Ext
.
Add
,
so
that
in
a
project
--
file
,
External
(
"name"
)
will
return
"value"
.
--
Package
Mains
is
used
to
store
the
mains
specified
on
the
command
line
--
and
to
retrieve
them
when
a
project
file
is
used
,
to
verify
that
the
--
files
exist
and
that
they
belong
to
a
project
file
.
function
Linker_Options_Switches
(
Project
:
Project_Id
)
return
String_List
;
package
Mains
is
--
Mains
are
stored
in
a
table
.
An
index
is
used
to
retrieve
the
mains
--
from
the
table
.
procedure
Add_Main
(
Name
:
String
);
--
Add
one
main
to
the
table
procedure
Delete
;
--
Empty
the
table
procedure
Reset
;
--
Reset
the
index
to
the
beginning
of
the
table
function
Next_Main
return
String
;
--
Increase
the
index
and
return
the
next
main
.
--
If
table
is
exhausted
,
return
an
empty
string
.
function
Number_Of_Mains
return
Natural
;
--
Returns
the
number
of
mains
added
with
Add_Main
since
the
last
call
--
to
Delete
.
end
Mains
;
procedure
Test_If_Relative_Path
(
Switch
:
in
out
String_Access
;
Parent
:
String_Access
;
Including_L_Switch
:
Boolean
:=
True
);
--
Test
if
Switch
is
a
relative
search
path
switch
.
--
If
it
is
,
fail
if
Parent
is
null
,
otherwise
prepend
the
path
with
--
Parent
.
This
subprogram
is
only
called
when
using
project
files
.
--
For
gnatbind
switches
,
Including_L_Switch
is
False
,
because
the
--
argument
of
the
-
L
switch
is
not
a
path
.
end
Makeutl
;
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment