+2009-06-24 Vincent Celier <celier@adacore.com>
+
+ * prj-nmsc.adb (Check): A project declared abstract is legal if no
+ attribute Source_Dirs, Source_Files, Source_List_File or Languages is
+ declared.
+
+2009-06-24 Robert Dewar <dewar@adacore.com>
+
+ * clean.adb, gnatcmd.adb, make.adb, mlib-prj.adb,
+ prj-env.adb: Minor reformatting
+
+2009-06-24 Ed Falis <falis@adacore.com>
+
+ * s-taprop-vxworks.adb, s-osinte-vxworks.ads, s-vxwext.ads,
+ s-vxwext-kernel.adb, s-vxwext-kernel.ads, s-vxwext-rtp.adb,
+ s-tasinf-vxworks.ads, gcc-interface/Makefile.in: Add processor affinity
+ support for VxWorks SMP.
+
+ * gcc-interface/Make-lang.in: Update dependencies
+
2009-06-24 Emmanuel Briot <briot@adacore.com>
* gnatcmd.adb, make.adb, mlib-prj.adb, prj.adb, prj.ads, clean.adb,
while Unit /= No_Unit_Index loop
if Unit.File_Names (Impl) /= null
and then Ultimate_Extending_Project_Of
- (Unit.File_Names (Impl).Project) = Project
+ (Unit.File_Names (Impl).Project) = Project
and then
- Get_Name_String (Unit.File_Names (Impl).File)
- = Name (1 .. Last)
+ Get_Name_String (Unit.File_Names (Impl).File) =
+ Name (1 .. Last)
then
Delete_File := True;
exit;
if Unit.File_Names (Spec) /= null
and then Ultimate_Extending_Project_Of
- (Unit.File_Names (Spec).Project) = Project
+ (Unit.File_Names (Spec).Project) = Project
and then
Get_Name_String
- (Unit.File_Names (Spec).File) =
- Name (1 .. Last)
+ (Unit.File_Names (Spec).File) = Name (1 .. Last)
then
Delete_File := True;
exit;
while Unit /= No_Unit_Index loop
if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Project /=
- No_Project
+ No_Project
then
if Ultimate_Extending_Project_Of
- (Unit.File_Names (Impl).Project) =
- Project
+ (Unit.File_Names (Impl).Project) =
+ Project
then
Get_Name_String
(Unit.File_Names (Impl).File);
File_Extension
(Name (1 .. Name_Len))'Length;
if Name_Buffer (1 .. Name_Len) =
- Name (1 .. Last - 4)
+ Name (1 .. Last - 4)
then
Delete_File := True;
exit;
elsif Unit.File_Names (Spec) /= null
and then Ultimate_Extending_Project_Of
- (Unit.File_Names (Spec).Project) =
- Project
+ (Unit.File_Names (Spec).Project) =
+ Project
then
Get_Name_String
(Unit.File_Names (Spec).File);
- Name_Len := Name_Len -
- File_Extension
- (Name (1 .. Name_Len))'Length;
+ Name_Len :=
+ Name_Len -
+ File_Extension
+ (Name (1 .. Name_Len))'Length;
if Name_Buffer (1 .. Name_Len) =
- Name (1 .. Last - 4)
+ Name (1 .. Last - 4)
then
Delete_File := True;
exit;
end if;
end if;
- Unit := Units_Htable.Get_Next
- (Project_Tree.Units_HT);
+ Unit :=
+ Units_Htable.Get_Next (Project_Tree.Units_HT);
end loop;
end;
end if;
ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
ada/restrict.ads ada/rident.ads ada/rtsfind.ads ada/scans.ads \
ada/sdefault.ads ada/sem.ads ada/sem_aggr.ads ada/sem_attr.ads \
- ada/sem_attr.adb ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch13.ads \
- ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch6.ads ada/sem_ch8.ads \
- ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads ada/sem_elim.ads \
- ada/sem_eval.ads ada/sem_eval.adb ada/sem_intr.ads ada/sem_res.ads \
- ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads \
- ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/sinput.adb \
- ada/snames.ads ada/snames.adb ada/sprint.ads ada/stand.ads \
- ada/stringt.ads ada/stringt.adb ada/style.ads ada/styleg.ads \
- ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-carun8.ads \
- ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-imenne.ads \
- ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
- ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
- ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
- ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
- ada/targparm.ads ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads \
- ada/ttypef.ads ada/ttypes.ads ada/types.ads ada/types.adb ada/uintp.ads \
- ada/uintp.adb ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads \
- ada/urealp.adb ada/validsw.ads ada/widechar.ads
+ ada/sem_attr.adb ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch10.ads \
+ ada/sem_ch13.ads ada/sem_ch3.ads ada/sem_ch4.ads ada/sem_ch6.ads \
+ ada/sem_ch8.ads ada/sem_disp.ads ada/sem_dist.ads ada/sem_elab.ads \
+ ada/sem_elim.ads ada/sem_eval.ads ada/sem_eval.adb ada/sem_intr.ads \
+ ada/sem_res.ads ada/sem_res.adb ada/sem_type.ads ada/sem_util.ads \
+ ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
+ ada/sinput.adb ada/snames.ads ada/snames.adb ada/sprint.ads \
+ ada/stand.ads ada/stringt.ads ada/stringt.adb ada/style.ads \
+ ada/styleg.ads ada/styleg.adb ada/stylesw.ads ada/system.ads \
+ ada/s-carun8.ads ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads \
+ ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
+ ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
+ ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
+ ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
+ ada/table.adb ada/targparm.ads ada/tbuild.ads ada/tbuild.adb \
+ ada/tree_io.ads ada/ttypef.ads ada/ttypes.ads ada/types.ads \
+ ada/types.adb ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
+ ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/validsw.ads \
+ ada/widechar.ads
ada/sem_aux.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
s-stchop.ads<s-stchop-limit.ads \
s-stchop.adb<s-stchop-vxworks.adb \
s-taprop.adb<s-taprop-vxworks.adb \
+ s-tasinf.ads<s-tasinf-vxworks.ads \
s-taspri.ads<s-taspri-vxworks.ads \
s-tpopsp.adb<s-tpopsp-vxworks.adb \
s-vxwork.ads<s-vxwork-m68k.ads \
s-stchop.ads<s-stchop-limit.ads \
s-stchop.adb<s-stchop-vxworks.adb \
s-taprop.adb<s-taprop-vxworks.adb \
+ s-tasinf.ads<s-tasinf-vxworks.ads \
s-taspri.ads<s-taspri-vxworks.ads \
s-vxwork.ads<s-vxwork-ppc.ads \
g-socthi.ads<g-socthi-vxworks.ads \
ifeq ($(strip $(filter-out rtp-smp,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += \
s-vxwext.ads<s-vxwext-rtp.ads \
- s-vxwext.adb<s-vxwext-rtp.adb \
+ s-vxwext.adb<s-vxwext-rtp-smp.adb \
s-tpopsp.adb<s-tpopsp-vxworks-tls.adb \
system.ads<system-vxworks-ppc-rtp.ads
EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
+ EXTRA_GNATRTL_TASKING_OBJS=affinity.o
else
ifeq ($(strip $(filter-out kernel-smp,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += \
s-vxwext.ads<s-vxwext-kernel.ads \
s-vxwext.adb<s-vxwext-kernel-smp.adb \
system.ads<system-vxworks-ppc-kernel.ads
+
+ EXTRA_GNATRTL_TASKING_OBJS=affinity.o
else
LIBGNAT_TARGET_PAIRS += \
s-interr.adb<s-interr-hwint.adb \
LIBGNAT_TARGET_PAIRS += \
system.ads<system-vxworks-ppc.ads
endif
-
endif
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
endif
endif
- EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o s-vxwext.o
+ EXTRA_GNATRTL_TASKING_OBJS += s-vxwork.o s-vxwext.o
EXTRA_LIBGNAT_SRCS+=vx_stack_info.c
EXTRA_LIBGNAT_OBJS+=vx_stack_info.o
# vxworksae / vxworks 653
ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
- # target pairs for kernel + vthreads runtime
+ # target pairs for vthreads runtime
LIBGNAT_TARGET_PAIRS = \
a-elchha.adb<a-elchha-vxworks-ppc-full.adb \
a-intnam.ads<a-intnam-vxworks.ads \
s-parame.ads<s-parame-ae653.ads \
s-parame.adb<s-parame-vxworks.adb \
s-taprop.adb<s-taprop-vxworks.adb \
+ s-tasinf.ads<s-tasinf-vxworks.ads \
s-taspri.ads<s-taspri-vxworks.ads \
s-tpopsp.adb<s-tpopsp-vxworks.adb \
s-vxwext.adb<s-vxwext-noints.adb \
s-osprim.adb<s-osprim-vxworks.adb \
s-parame.ads<s-parame-ae653.ads \
s-taprop.adb<s-taprop-vxworks.adb \
+ s-tasinf.ads<s-tasinf-vxworks.ads \
s-taspri.ads<s-taspri-vxworks.ads \
s-thread.adb<s-thread-ae653.adb \
s-tpopsp.adb<s-tpopsp-vxworks.adb \
s-stchop.ads<s-stchop-limit.ads \
s-stchop.adb<s-stchop-vxworks.adb \
s-taprop.adb<s-taprop-vxworks.adb \
+ s-tasinf.ads<s-tasinf-vxworks.ads \
s-taspri.ads<s-taspri-vxworks.ads \
s-tpopsp.adb<s-tpopsp-vxworks.adb \
s-vxwork.ads<s-vxwork-sparcv9.ads \
s-stchop.ads<s-stchop-limit.ads \
s-stchop.adb<s-stchop-vxworks.adb \
s-taprop.adb<s-taprop-vxworks.adb \
+ s-tasinf.ads<s-tasinf-vxworks.ads \
s-taspri.ads<s-taspri-vxworks.ads \
s-vxwork.ads<s-vxwork-x86.ads \
g-bytswa.adb<g-bytswa-x86.adb \
ifeq ($(strip $(filter-out rtp-smp, $(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += \
s-vxwext.ads<s-vxwext-rtp.ads \
- s-vxwext.adb<s-vxwext-rtp.adb \
+ s-vxwext.adb<s-vxwext-rtp-smp.adb \
s-tpopsp.adb<s-tpopsp-vxworks-tls.adb \
system.ads<system-vxworks-x86-rtp.ads
EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
+ EXTRA_GNATRTL_TASKING_OBJS=affinity.o
else
ifeq ($(strip $(filter-out kernel-smp, $(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += \
s-vxwext.ads<s-vxwext-kernel.ads \
s-vxwext.adb<s-vxwext-kernel-smp.adb \
system.ads<system-vxworks-x86-kernel.ads
+ EXTRA_GNATRTL_TASKING_OBJS=affinity.o
else
LIBGNAT_TARGET_PAIRS += \
s-interr.adb<s-interr-hwint.adb \
EXTRA_GNATRTL_NONTASKING_OBJS=i-vxwork.o i-vxwoio.o s-vxwexc.o
endif
endif
- EXTRA_GNATRTL_TASKING_OBJS=s-vxwork.o s-vxwext.o
+ EXTRA_GNATRTL_TASKING_OBJS += s-vxwork.o s-vxwext.o
EXTRA_LIBGNAT_SRCS+=vx_stack_info.c
EXTRA_LIBGNAT_OBJS+=vx_stack_info.o
s-stchop.ads<s-stchop-limit.ads \
s-stchop.adb<s-stchop-vxworks.adb \
s-taprop.adb<s-taprop-vxworks.adb \
+ s-tasinf.ads<s-tasinf-vxworks.ads \
s-taspri.ads<s-taspri-vxworks.ads \
s-tpopsp.adb<s-tpopsp-vxworks.adb \
s-vxwork.ads<s-vxwork-arm.ads \
s-stchop.ads<s-stchop-limit.ads \
s-stchop.adb<s-stchop-vxworks.adb \
s-taprop.adb<s-taprop-vxworks.adb \
+ s-tasinf.ads<s-tasinf-vxworks.ads \
s-taspri.ads<s-taspri-vxworks.ads \
s-tpopsp.adb<s-tpopsp-vxworks.adb \
s-vxwork.ads<s-vxwork-mips.ads \
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
while Unit /= No_Unit_Index loop
+
-- For gnatls, we only need to put the library units, body or
-- spec, but not the subunits.
then
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
- new String'
- (Get_Name_String
- (Unit.File_Names
- (Spec).Display_File));
+ new String'(Get_Name_String
+ (Unit.File_Names (Spec).Display_File));
end if;
end if;
-- must be added.
if Check_Project
- (Unit.File_Names (Impl).Project, Project)
+ (Unit.File_Names (Impl).Project, Project)
then
Subunit := False;
Last_Switches.Table (Last_Switches.Last) :=
new String'
(Get_Name_String
- (Unit.File_Names
- (Impl).Project.
- Object_Directory.Name) &
- Directory_Separator &
+ (Unit.File_Names
+ (Impl).Project. Object_Directory.Name) &
+ Directory_Separator &
MLib.Fil.Ext_To
(Get_Name_String
- (Unit.File_Names
- (Impl).Display_File),
+ (Unit.File_Names (Impl).Display_File),
"ci"));
end if;
end if;
elsif Unit.File_Names (Spec) /= null
and then Unit.File_Names (Spec).Path.Name /= Slash
then
- -- We have a spec with no body. Check if it is for this
- -- project.
+ -- Spec with no body, check if it is for this project
if Check_Project
- (Unit.File_Names (Spec).Project, Project)
+ (Unit.File_Names (Spec).Project, Project)
then
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'
(Get_Name_String
- (Unit.File_Names
- (Spec).Project.
- Object_Directory.Name) &
- Dir_Separator &
+ (Unit.File_Names
+ (Spec).Project. Object_Directory.Name) &
+ Dir_Separator &
MLib.Fil.Ext_To
- (Get_Name_String
- (Unit.File_Names (Spec).File),
+ (Get_Name_String (Unit.File_Names (Spec).File),
"ci"));
end if;
end if;
for Kind in Spec_Or_Body loop
if Unit.File_Names (Kind) /= null
and then Check_Project
- (Unit.File_Names (Kind).Project, Project)
+ (Unit.File_Names (Kind).Project, Project)
and then Unit.File_Names (Kind).Path.Name /= Slash
then
Get_Name_String
else
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
- new String'
- (Get_Name_String
- (Unit.File_Names
- (Kind).Path.Display_Name));
+ new String'(Get_Name_String
+ (Unit.File_Names
+ (Kind).Path.Display_Name));
end if;
end if;
end loop;
if UID /= Prj.No_Unit_Index then
if (UID.File_Names (Impl) = null
- or else UID.File_Names (Impl).File /= Sfile)
+ or else UID.File_Names (Impl).File /= Sfile)
and then
(UID.File_Names (Spec) = null
- or else UID.File_Names (Spec).File /= Sfile)
+ or else UID.File_Names (Spec).File /= Sfile)
then
Verbose_Msg (Uname, "sources do not include ", Name_Id (Sfile));
return True;
exit;
elsif Udata.File_Names (Spec) /= null
- and then Udata.File_Names (Spec).File =
- Source_File
+ and then Udata.File_Names (Spec).File = Source_File
then
- ALI_Project :=
- Udata.File_Names (Spec).Project;
+ ALI_Project := Udata.File_Names (Spec).Project;
exit;
end if;
if Uid /= Prj.No_Unit_Index then
if Uid.File_Names (Impl) /= null
and then
- Uid.File_Names (Impl).Path.Name /=
- Slash
+ Uid.File_Names (Impl).Path.Name /= Slash
then
Sfile := Uid.File_Names (Impl).File;
Source_Index :=
elsif Uid.File_Names (Spec) /= null
and then
- Uid.File_Names
- (Spec).Path.Name /= Slash
+ Uid.File_Names (Spec).Path.Name /= Slash
then
- Sfile :=
- Uid.File_Names (Spec).File;
+ Sfile := Uid.File_Names (Spec).File;
Source_Index :=
Uid.File_Names (Spec).Index;
end if;
-- If we have something to put in the mapping then do it
-- now. However, if the project is extended, we don't put
- -- anything in the mapping file, because we do not know
- -- where the ALI file is: it might be in the extended
- -- project obj dir as well as in the extending project
- -- obj dir.
+ -- anything in the mapping file, because we don't know where
+ -- the ALI file is: it might be in the extended project obj
+ -- dir as well as in the extending project obj dir.
if ALI_Name /= No_File
and then ALI_Project.Extended_By = No_Project
declare
ALI_Path_Name : constant String :=
- Name_Buffer (1 .. Name_Len);
+ Name_Buffer (1 .. Name_Len);
begin
if Is_Regular_File
- (ALI_Path_Name (1 .. ALI_Path_Name'Last - 1))
+ (ALI_Path_Name (1 .. ALI_Path_Name'Last - 1))
then
-
-- First line is the unit name
Get_Name_String (ALI_Unit);
(Mapping_FD,
Name_Buffer (1)'Address,
Name_Len);
- OK := Bytes = Name_Len;
+ OK := (Bytes = Name_Len);
exit when not OK;
(Mapping_FD,
ALI_Path_Name (1)'Address,
ALI_Path_Name'Length);
- OK := Bytes = ALI_Path_Name'Length;
+ OK := (Bytes = ALI_Path_Name'Length);
- -- If OK is False, it means we were unable
- -- to write a line. No point in continuing
- -- with the other units.
+ -- If OK is False, it means we were unable to
+ -- write a line. No point in continuing with the
+ -- other units.
exit when not OK;
end if;
-- For all the sources in the project files,
Unit := Units_Htable.Get_First (Project_Tree.Units_HT);
-
while Unit /= null loop
Sfile := No_File;
Index := 0;
Processed_ALIs.Reset;
Unit := Units_Htable.Get_First (In_Tree.Units_HT);
-
while Unit /= No_Unit_Index loop
if Unit.File_Names (Impl) /= null
and then Unit.File_Names (Impl).Path.Name /= Slash
then
- if
- Check_Project (Unit.File_Names (Impl).Project)
- then
+ if Check_Project (Unit.File_Names (Impl).Project) then
if Unit.File_Names (Spec) = null then
declare
Src_Ind : Source_File_Index;
begin
Src_Ind := Sinput.P.Load_Project_File
- (Get_Name_String
- (Unit.File_Names (Impl).Path.Name));
+ (Get_Name_String
+ (Unit.File_Names (Impl).Path.Name));
-- Add the ALI file only if it is not a subunit
if not
Sinput.P.Source_File_Is_Subunit (Src_Ind)
then
- Add_ALI_For
- (Unit.File_Names (Impl).File);
+ Add_ALI_For (Unit.File_Names (Impl).File);
exit when not Bind;
end if;
end;
elsif Unit.File_Names (Spec) /= null
and then Unit.File_Names (Spec).Path.Name /= Slash
- and then Check_Project
- (Unit.File_Names (Spec).Project)
+ and then Check_Project (Unit.File_Names (Spec).Project)
then
Add_ALI_For (Unit.File_Names (Spec).File);
exit when not Bind;
ALI.Units.Table
(ALI.ALIs.Table (A).First_Unit).Last_Arg
loop
- -- Look for --RTS. If found, add the switch to call
- -- gnatbind.
+ -- If --RTS found, add switch to call gnatbind
declare
Arg : String_Ptr renames Args.Table (Index);
--------------------
procedure Create_Mapping (In_Tree : Project_Tree_Ref) is
- Unit : Unit_Index;
- Data : Source_Id;
+ Unit : Unit_Index;
+ Data : Source_Id;
begin
Fmap.Reset_Tables;
Unit := Units_Htable.Get_First (In_Tree.Units_HT);
-
while Unit /= No_Unit_Index loop
+
-- Process only if the unit has a valid name
if Unit.Name /= No_Name then
Data := Unit.File_Names (Spec);
- -- If there is a spec, put it in the mapping
+ -- If there is a spec put it in the mapping
if Data /= null then
if Data.Path.Name = Slash then
-- For each project in the closure of Project, the corresponding flag
-- will be set to True.
- Source : Source_Id;
- Suffix : File_Name_Type;
- Unit : Unit_Index;
- Data : Source_Id;
- Iter : Source_Iterator;
+ Source : Source_Id;
+ Suffix : File_Name_Type;
+ Unit : Unit_Index;
+ Data : Source_Id;
+ Iter : Source_Iterator;
procedure Put_Name_Buffer;
-- Put the line contained in the Name_Buffer in the mapping file
-- Find the list of files that should not be considered as source files
-- for this project. Sets the list in the Excluded_Sources_Htable.
+ procedure Override_Kind (Source : Source_Id; Kind : Source_Kind);
+ -- Override the reference kind for a source file. This properly updates
+ -- the unit data if necessary.
+
function Hash (Unit : Unit_Info) return Header_Num;
type Name_And_Index is record
-- Process_Exceptions_Unit_Based and Check_File haven't looked it up.
UData := Units_Htable.Get (In_Tree.Units_HT, Unit);
+
if UData = No_Unit_Index then
UData := new Unit_Data;
UData.Name := Unit;
Units_Htable.Set (In_Tree.Units_HT, Unit, UData);
end if;
- UData.File_Names (Kind) := Id;
- Id.Unit := UData;
+ Id.Unit := UData;
+
+ -- Note that this updates Unit information as well
+
+ Override_Kind (Id, Kind);
end if;
- Id.Index := Index;
- Id.File := File_Name;
- Id.Display_File := Display_File;
- Id.Dep_Name := Dependency_Name
- (File_Name, Lang_Id.Config.Dependency_Kind);
- Id.Naming_Exception := Naming_Exception;
+ Id.Index := Index;
+ Id.File := File_Name;
+ Id.Display_File := Display_File;
+ Id.Dep_Name := Dependency_Name
+ (File_Name, Lang_Id.Config.Dependency_Kind);
+ Id.Naming_Exception := Naming_Exception;
- if Is_Compilable (Id)
- and then Config.Object_Generated
- then
+ if Is_Compilable (Id) and then Config.Object_Generated then
Id.Object := Object_Name (File_Name, Config.Object_File_Suffix);
Id.Switches := Switches_Name (File_Name);
end if;
function ALI_File_Name (Source : String) return String is
begin
- -- If the source name has an extension, then replace it with
- -- the ALI suffix.
+ -- If the source name has extension, replace it with the ALI suffix
for Index in reverse Source'First + 1 .. Source'Last loop
if Source (Index) = '.' then
end if;
end loop;
- -- If there is no dot, or if it is the first character, just add the
- -- ALI suffix.
+ -- If no dot, or if it is the first character, just add the ALI suffix
return Source & ALI_Suffix;
end ALI_File_Name;
if Project.Qualifier = Dry
and then Project.Source_Dirs /= Nil_String
then
- Error_Msg
- (Project, In_Tree,
- "an abstract project needs to have no language, no sources " &
- "or no source directories",
- Project.Location);
+ declare
+ Source_Dirs : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Source_Dirs,
+ Project.Decl.Attributes, In_Tree);
+ Source_Files : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Source_Files,
+ Project.Decl.Attributes, In_Tree);
+ Source_List_File : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Source_List_File,
+ Project.Decl.Attributes, In_Tree);
+ Languages : constant Variable_Value :=
+ Util.Value_Of
+ (Name_Languages,
+ Project.Decl.Attributes, In_Tree);
+
+ begin
+ if Source_Dirs.Values = Nil_String
+ and then Source_Files.Values = Nil_String
+ and then Languages.Values = Nil_String
+ and then Source_List_File.Default
+ then
+ Project.Source_Dirs := Nil_String;
+
+ else
+ Error_Msg
+ (Project, In_Tree,
+ "an abstract project needs to have no language, " &
+ "no sources or no source directories",
+ Project.Location);
+ end if;
+ end;
end if;
-- Check configuration in multi language mode
-- Get the name of the language
- Lang_Index := Get_Language_From_Name
- (Project, Get_Name_String (Element.Index));
+ Lang_Index :=
+ Get_Language_From_Name
+ (Project, Get_Name_String (Element.Index));
if Lang_Index /= No_Language_Index then
case Current_Array.Name is
- when Name_Driver =>
+ when Name_Driver =>
- -- Attribute Driver (<language>)
+ -- Attribute Driver (<language>)
- Lang_Index.Config.Binder_Driver :=
- File_Name_Type (Element.Value.Value);
+ Lang_Index.Config.Binder_Driver :=
+ File_Name_Type (Element.Value.Value);
- when Name_Required_Switches =>
- Put (Into_List =>
+ when Name_Required_Switches =>
+ Put
+ (Into_List =>
Lang_Index.Config.Binder_Required_Switches,
- From_List => Element.Value.Values,
- In_Tree => In_Tree);
+ From_List => Element.Value.Values,
+ In_Tree => In_Tree);
- when Name_Prefix =>
+ when Name_Prefix =>
- -- Attribute Prefix (<language>)
+ -- Attribute Prefix (<language>)
- Lang_Index.Config.Binder_Prefix :=
- Element.Value.Value;
+ Lang_Index.Config.Binder_Prefix :=
+ Element.Value.Value;
- when Name_Objects_Path =>
+ when Name_Objects_Path =>
- -- Attribute Objects_Path (<language>)
+ -- Attribute Objects_Path (<language>)
- Lang_Index.Config.Objects_Path :=
- Element.Value.Value;
+ Lang_Index.Config.Objects_Path :=
+ Element.Value.Value;
- when Name_Objects_Path_File =>
+ when Name_Objects_Path_File =>
- -- Attribute Objects_Path (<language>)
+ -- Attribute Objects_Path (<language>)
- Lang_Index.Config.Objects_Path_File :=
- Element.Value.Value;
+ Lang_Index.Config.Objects_Path_File :=
+ Element.Value.Value;
- when others =>
- null;
+ when others =>
+ null;
end case;
end if;
end if;
-- Get the name of the language
- Lang_Index := Get_Language_From_Name
- (Project, Get_Name_String (Element.Index));
+ Lang_Index :=
+ Get_Language_From_Name
+ (Project, Get_Name_String (Element.Index));
if Lang_Index /= No_Language_Index then
case Current_Array.Name is
Source := Prj.Element (Iter);
exit when Source = No_Source
or else (Source.Unit /= null
- and then Source.Unit.Name = Unit
- and then Source.Index = Index);
+ and then Source.Unit.Name = Unit
+ and then Source.Index = Index);
Next (Iter);
end loop;
exit when Source = No_Source
or else (Source.Unit /= null
- and then Source.Unit.Name = Unit
- and then Source.Index = Index);
+ and then Source.Unit.Name = Unit
+ and then Source.Index = Index);
end loop;
end if;
Src_Ind : Source_File_Index;
begin
- Src_Ind := Sinput.P.Load_Project_File
- (Get_Name_String
- (UData.File_Names
- (Impl).Path.Name));
+ Src_Ind :=
+ Sinput.P.Load_Project_File
+ (Get_Name_String (UData.File_Names
+ (Impl).Path.Name));
if Sinput.P.Source_File_Is_Subunit
- (Src_Ind)
+ (Src_Ind)
then
Error_Msg
(Project, In_Tree,
end if;
elsif UData.File_Names (Spec) /= null
- and then UData.File_Names
- (Spec).Path.Name /= Slash
+ and then UData.File_Names (Spec).Path.Name /= Slash
and then Check_Project
- (UData.File_Names
- (Spec).Project,
+ (UData.File_Names (Spec).Project,
Project, Extending)
then
-- Multi_Language mode
Next_Proj := Project.Extends;
-
Iter := For_Each_Source (In_Tree, Project);
-
loop
while Prj.Element (Iter) /= No_Source
and then
(Prj.Element (Iter).Unit = null
- or else Prj.Element (Iter).Unit.Name /= Unit)
+ or else Prj.Element (Iter).Unit.Name /= Unit)
loop
Next (Iter);
end loop;
Source := Prj.Element (Iter);
- exit when Source /= No_Source or else
- Next_Proj = No_Project;
+ exit when Source /= No_Source
+ or else Next_Proj = No_Project;
Iter := For_Each_Source (In_Tree, Next_Proj);
Next_Proj := Next_Proj.Extends;
if Source /= No_Source then
if Source.Kind = Sep then
Source := No_Source;
-
elsif Source.Kind = Spec
and then Source.Other_Part /= No_Source
then
if Source /= No_Source then
if Source.Project /= Project
- and then
- not Is_Extending (Project, Source.Project)
+ and then not Is_Extending (Project, Source.Project)
then
Source := No_Source;
end if;
String_Element_Table.Increment_Last
(In_Tree.String_Elements);
+
In_Tree.String_Elements.Table
(String_Element_Table.Last
(In_Tree.String_Elements)) :=
(Interfaces).Location,
Flag => False,
Next => Interface_ALIs);
- Interface_ALIs := String_Element_Table.Last
- (In_Tree.String_Elements);
+
+ Interface_ALIs :=
+ String_Element_Table.Last (In_Tree.String_Elements);
end if;
end if;
end if;
end Check_File_Naming_Schemes;
+ -------------------
+ -- Override_Kind --
+ -------------------
+
+ procedure Override_Kind (Source : Source_Id; Kind : Source_Kind) is
+ begin
+ -- Remove reference in the unit, if necessary
+
+ if Source.Unit /= null
+ and then Source.Kind in Spec_Or_Body
+ then
+ Source.Unit.File_Names (Source.Kind) := null;
+ end if;
+
+ Source.Kind := Kind;
+
+ if Source.Kind in Spec_Or_Body and then Source.Unit /= null then
+ Source.Unit.File_Names (Source.Kind) := Source;
+ end if;
+ end Override_Kind;
+
----------------
-- Check_File --
----------------
(Get_Name_String (Canonical_Path));
if Sinput.P.Source_File_Is_Subunit (Src_Ind) then
- Name_Loc.Source.Kind := Sep;
+ Override_Kind (Name_Loc.Source, Sep);
end if;
end if;
end if;
procedure Mark_Excluded_Sources is
Source : Source_Id := No_Source;
OK : Boolean;
- Excluded : File_Found := Excluded_Sources_Htable.Get_First;
+ Excluded : File_Found;
Index : Unit_Index;
+
begin
+ Excluded := Excluded_Sources_Htable.Get_First;
while Excluded /= No_File_Found loop
- OK := False;
+ OK := False;
+
+ -- ??? Don't we have a hash table to map files to Source_Id?
- -- ??? Don't we have a hash table to map files to Source_Id ?
Iter := For_Each_Source (In_Tree);
loop
Source := Prj.Element (Iter);
-- ??? Should we simply set (can be done from the
-- source)
-- Index.File_Names (Source.Kind) := null;
+
end if;
end if;
if Sinput.P.Source_File_Is_Subunit
(Src_Ind)
then
- Src_Id.Kind := Sep;
+ Override_Kind (Src_Id, Sep);
else
Check_Object (Src_Id);
end if;
Unit_Kind : Spec_Or_Body;
Needs_Pragma : Boolean)
is
+ UData : constant Unit_Index :=
+ Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
-- ??? Add_Source will look it up again, can we do that only once ?
- UData : constant Unit_Index :=
- Units_Htable.Get (In_Tree.Units_HT, Unit_Name);
- Source : Source_Id;
- To_Record : Boolean := False;
- The_Location : Source_Ptr := Location;
- Unit_Prj : Project_Id;
+
+ Source : Source_Id;
+ To_Record : Boolean := False;
+ The_Location : Source_Ptr := Location;
+ Unit_Prj : Project_Id;
begin
if Current_Verbosity = High then
if UData.File_Names (Unit_Kind) = null
or else
(UData.File_Names (Unit_Kind).File = Canonical_File
- and then UData.File_Names (Unit_Kind).Path.Name = Slash)
+ and then UData.File_Names (Unit_Kind).Path.Name = Slash)
or else Is_Extending
(Project.Extends, UData.File_Names (Unit_Kind).Project)
then
if Specs then
if not Check_Project
- (The_Unit_Data.File_Names (Spec).Project,
- Project, Extending)
+ (The_Unit_Data.File_Names (Spec).Project,
+ Project, Extending)
then
Error_Msg
(Project, In_Tree,
else
if The_Unit_Data.File_Names (Impl) = null
or else not Check_Project
- (The_Unit_Data.File_Names (Impl).Project,
- Project, Extending)
+ (The_Unit_Data.File_Names (Impl).Project,
+ Project, Extending)
then
Error_Msg
(Project, In_Tree,
Handler : Interrupt_Handler;
Parameter : System.Address := System.Null_Address) return int;
pragma Inline (Interrupt_Connect);
- -- Use this to set up an user handler. The routine installs a
- -- a user handler which is invoked after the OS has saved enough
- -- context for a high-level language routine to be safely invoked.
+ -- Use this to set up an user handler. The routine installs a a user
+ -- handler which is invoked after the OS has saved enough context for a
+ -- high-level language routine to be safely invoked.
function Interrupt_Number_To_Vector (intNum : int) return Interrupt_Vector;
pragma Inline (Interrupt_Number_To_Vector);
-- Convert a logical interrupt number to the hardware interrupt vector
-- number used to connect the interrupt.
+ --------------------------------
+ -- Processor Affinity for SMP --
+ --------------------------------
+
+ function taskCpuAffinitySet (tid : t_id; CPU : int) return int
+ renames System.VxWorks.Ext.taskCpuAffinitySet;
+ -- For SMP run-times the affinity to CPU.
+ -- For uniprocessor systems return ERROR status.
+
private
type sigset_t is new unsigned_long_long;
-- on. For example when using the restricted run time, it is replaced by
-- System.Tasking.Restricted.Stages.
+with System.Task_Info;
with System.VxWorks.Ext;
package body System.Task_Primitives.Operations is
Succeeded : out Boolean)
is
Adjusted_Stack_Size : size_t;
+ Result : int;
+
+ use System.Task_Info;
+
begin
-- Ask for four extra bytes of stack space so that the ATCB pointer can
-- be stored below the stack limit, plus extra space for the frame of
To_Address (T));
end;
+ -- Set processor affinity
+
+ if T.Common.Task_Info /= Unspecified_Task_Info then
+ Result :=
+ taskCpuAffinitySet (T.Common.LL.Thread, T.Common.Task_Info);
+
+ if Result = -1 then
+ taskDelete (T.Common.LL.Thread);
+ T.Common.LL.Thread := -1;
+ end if;
+ end if;
+
if T.Common.LL.Thread = -1 then
Succeeded := False;
else
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- S Y S T E M . T A S K _ I N F O --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 1992-2009, 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 3, 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. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package contains the definitions and routines associated with the
+-- implementation and use of the Task_Info pragma. It is specialized
+-- appropriately for targets that make use of this pragma.
+
+-- Note: the compiler generates direct calls to this interface, via Rtsfind.
+-- Any changes to this interface may require corresponding compiler changes.
+
+-- This unit may be used directly from an application program by providing
+-- an appropriate WITH, and the interface can be expected to remain stable.
+
+-- This is the VxWorks version of this package
+
+with Interfaces.C;
+
+package System.Task_Info is
+ pragma Preelaborate;
+ pragma Elaborate_Body;
+ -- To ensure that a body is allowed
+
+ -----------------------------------------
+ -- Implementation of Task_Info Feature --
+ -----------------------------------------
+
+ -- The Task_Info pragma:
+
+ -- pragma Task_Info (EXPRESSION);
+
+ -- allows the specification on a task by task basis of a value of type
+ -- System.Task_Info.Task_Info_Type to be passed to a task when it is
+ -- created. The specification of this type, and the effect on the task
+ -- that is created is target dependent.
+
+ -- The Task_Info pragma appears within a task definition (compare the
+ -- definition and implementation of pragma Priority). If no such pragma
+ -- appears, then the value Unspecified_Task_Info is passed. If a pragma
+ -- is present, then it supplies an alternative value. If the argument of
+ -- the pragma is a discriminant reference, then the value can be set on
+ -- a task by task basis by supplying the appropriate discriminant value.
+
+ -- Note that this means that the type used for Task_Info_Type must be
+ -- suitable for use as a discriminant (i.e. a scalar or access type).
+
+ ------------------
+ -- Declarations --
+ ------------------
+
+ subtype Task_Info_Type is Interfaces.C.int;
+ -- This is a CPU number (positive)
+
+ Any_CPU : constant Task_Info_Type := 0;
+ -- Allow task to run on any CPU
+
+ use type Interfaces.C.int;
+
+ Unspecified_Task_Info : constant Task_Info_Type := -1;
+ -- Value passed to task in the absence of a Task_Info pragma
+ -- This value means do not try to set the CPU affinity
+
+end System.Task_Info;
return Os_Sem_Delete (Sem);
end semDelete;
+ ------------------------
+ -- taskCpuAffinitySet --
+ ------------------------
+
+ function taskCpuAffinitySet (tid : t_id; CPU : int) return int is
+ pragma Unreferenced (tid, CPU);
+ begin
+ return ERROR;
+ end taskCpuAffinitySet;
+
end System.VxWorks.Ext;
-- Needed for ravenscar-cert
pragma Import (C, tickGet, "tick64Get");
+ --------------------------------
+ -- Processor Affinity for SMP --
+ --------------------------------
+
+ function taskCpuAffinitySet (tid : t_id; CPU : int) return int;
+ pragma Convention (C, taskCpuAffinitySet);
+ -- For SMP run-times set the CPU affinity.
+ -- For uniprocessor systems return ERROR status.
+
end System.VxWorks.Ext;
-- --
-- B o d y --
-- --
--- Copyright (C) 2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2008-2009, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
return 0;
end Interrupt_Number_To_Vector;
+ ------------------------
+ -- taskCpuAffinitySet --
+ ------------------------
+
+ function taskCpuAffinitySet (tid : t_id; CPU : int) return int is
+ pragma Unreferenced (tid, CPU);
+ begin
+ return ERROR;
+ end taskCpuAffinitySet;
+
end System.VxWorks.Ext;
function Set_Time_Slice (ticks : int) return int;
pragma Import (C, Set_Time_Slice, "kernelTimeSlice");
+ --------------------------------
+ -- Processor Affinity for SMP --
+ --------------------------------
+
+ function taskCpuAffinitySet (tid : t_id; CPU : int) return int;
+ pragma Convention (C, taskCpuAffinitySet);
+ -- For SMP run-times set the CPU affinity.
+ -- For uniprocessor systems return ERROR status.
+
end System.VxWorks.Ext;
OSDN Git Service
