[multiple changes]
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 From-SVN: r148902
This commit is contained in:
Arnaud Charlet
parent
5a66a7661d
commit
95cd3246e6
@ -1,3 +1,23 @@
|
||||
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,
|
||||
|
||||
@ -577,10 +577,10 @@ package body Clean is
|
||||
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;
|
||||
@ -588,11 +588,10 @@ package body Clean is
|
||||
|
||||
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;
|
||||
@ -742,11 +741,11 @@ package body Clean is
|
||||
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);
|
||||
@ -754,7 +753,7 @@ package body Clean is
|
||||
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;
|
||||
@ -763,25 +762,26 @@ package body Clean is
|
||||
|
||||
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;
|
||||
|
||||
@ -3115,24 +3115,25 @@ ada/sem_attr.o : ada/ada.ads ada/a-charac.ads ada/a-chlat1.ads \
|
||||
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 \
|
||||
|
||||
@ -416,6 +416,7 @@ ifeq ($(strip $(filter-out m68k% wrs vx%,$(targ))),)
|
||||
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 \
|
||||
@ -461,6 +462,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
|
||||
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 \
|
||||
@ -496,11 +498,12 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
|
||||
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 += \
|
||||
@ -509,6 +512,8 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
|
||||
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 \
|
||||
@ -523,13 +528,12 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
|
||||
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
|
||||
@ -537,7 +541,7 @@ endif
|
||||
|
||||
# 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 \
|
||||
@ -554,6 +558,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
|
||||
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 \
|
||||
@ -619,6 +624,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworksae,$(targ))),)
|
||||
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 \
|
||||
@ -679,6 +685,7 @@ ifeq ($(strip $(filter-out sparc% wrs vx%,$(targ))),)
|
||||
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 \
|
||||
@ -719,6 +726,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),)
|
||||
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 \
|
||||
@ -755,11 +763,12 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),)
|
||||
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 += \
|
||||
@ -768,6 +777,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),)
|
||||
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 \
|
||||
@ -787,7 +797,7 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),)
|
||||
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
|
||||
@ -809,6 +819,7 @@ ifeq ($(strip $(filter-out arm% coff wrs vx%,$(targ))),)
|
||||
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 \
|
||||
@ -848,6 +859,7 @@ ifeq ($(strip $(filter-out mips% wrs vx%,$(targ))),)
|
||||
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 \
|
||||
|
||||
@ -411,6 +411,7 @@ procedure GNATCmd is
|
||||
|
||||
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.
|
||||
|
||||
@ -465,10 +466,8 @@ procedure GNATCmd is
|
||||
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;
|
||||
|
||||
@ -485,7 +484,7 @@ procedure GNATCmd is
|
||||
-- must be added.
|
||||
|
||||
if Check_Project
|
||||
(Unit.File_Names (Impl).Project, Project)
|
||||
(Unit.File_Names (Impl).Project, Project)
|
||||
then
|
||||
Subunit := False;
|
||||
|
||||
@ -513,14 +512,12 @@ procedure GNATCmd is
|
||||
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;
|
||||
@ -528,23 +525,20 @@ procedure GNATCmd is
|
||||
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;
|
||||
@ -557,7 +551,7 @@ procedure GNATCmd is
|
||||
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
|
||||
@ -576,10 +570,9 @@ procedure GNATCmd is
|
||||
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;
|
||||
|
||||
@ -1471,10 +1471,10 @@ package body Make is
|
||||
|
||||
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;
|
||||
@ -1951,11 +1951,9 @@ package body Make is
|
||||
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;
|
||||
|
||||
@ -3611,8 +3609,7 @@ package body Make is
|
||||
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 :=
|
||||
@ -3620,11 +3617,9 @@ package body Make is
|
||||
|
||||
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;
|
||||
@ -4428,10 +4423,9 @@ package body Make is
|
||||
|
||||
-- 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
|
||||
@ -4465,13 +4459,12 @@ package body Make is
|
||||
|
||||
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);
|
||||
@ -4494,7 +4487,7 @@ package body Make is
|
||||
(Mapping_FD,
|
||||
Name_Buffer (1)'Address,
|
||||
Name_Len);
|
||||
OK := Bytes = Name_Len;
|
||||
OK := (Bytes = Name_Len);
|
||||
|
||||
exit when not OK;
|
||||
|
||||
@ -4505,11 +4498,11 @@ package body Make is
|
||||
(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;
|
||||
@ -7001,7 +6994,6 @@ package body Make is
|
||||
-- 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;
|
||||
|
||||
@ -944,30 +944,26 @@ package body MLib.Prj is
|
||||
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;
|
||||
@ -980,8 +976,7 @@ package body MLib.Prj is
|
||||
|
||||
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;
|
||||
@ -1019,8 +1014,7 @@ package body MLib.Prj is
|
||||
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);
|
||||
|
||||
@ -738,21 +738,21 @@ package body Prj.Env is
|
||||
--------------------
|
||||
|
||||
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
|
||||
@ -802,11 +802,11 @@ package body Prj.Env is
|
||||
-- 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
|
||||
|
||||
@ -196,6 +196,10 @@ package body Prj.Nmsc is
|
||||
-- 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
|
||||
@ -717,26 +721,28 @@ package body Prj.Nmsc is
|
||||
-- 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;
|
||||
@ -762,8 +768,7 @@ package body Prj.Nmsc is
|
||||
|
||||
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
|
||||
@ -771,8 +776,7 @@ package body Prj.Nmsc is
|
||||
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;
|
||||
@ -827,11 +831,40 @@ package body Prj.Nmsc is
|
||||
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
|
||||
@ -1221,47 +1254,49 @@ package body Prj.Nmsc is
|
||||
|
||||
-- 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;
|
||||
@ -2190,8 +2225,9 @@ package body Prj.Nmsc is
|
||||
|
||||
-- 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
|
||||
@ -2994,8 +3030,8 @@ package body Prj.Nmsc 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;
|
||||
|
||||
@ -3009,8 +3045,8 @@ package body Prj.Nmsc is
|
||||
|
||||
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;
|
||||
|
||||
@ -4531,13 +4567,13 @@ package body Prj.Nmsc is
|
||||
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,
|
||||
@ -4565,11 +4601,9 @@ package body Prj.Nmsc is
|
||||
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
|
||||
@ -4593,21 +4627,19 @@ package body Prj.Nmsc is
|
||||
-- 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;
|
||||
@ -4616,7 +4648,6 @@ package body Prj.Nmsc is
|
||||
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
|
||||
@ -4626,8 +4657,7 @@ package body Prj.Nmsc is
|
||||
|
||||
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;
|
||||
@ -4649,6 +4679,7 @@ package body Prj.Nmsc is
|
||||
|
||||
String_Element_Table.Increment_Last
|
||||
(In_Tree.String_Elements);
|
||||
|
||||
In_Tree.String_Elements.Table
|
||||
(String_Element_Table.Last
|
||||
(In_Tree.String_Elements)) :=
|
||||
@ -4660,8 +4691,9 @@ package body Prj.Nmsc is
|
||||
(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;
|
||||
@ -7267,6 +7299,27 @@ package body Prj.Nmsc is
|
||||
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 --
|
||||
----------------
|
||||
@ -7341,7 +7394,7 @@ package body Prj.Nmsc is
|
||||
(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;
|
||||
@ -7713,13 +7766,16 @@ package body Prj.Nmsc is
|
||||
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
|
||||
while Excluded /= No_File_Found loop
|
||||
OK := False;
|
||||
|
||||
-- ??? Don't we have a hash table to map files to Source_Id ?
|
||||
begin
|
||||
Excluded := Excluded_Sources_Htable.Get_First;
|
||||
while Excluded /= No_File_Found loop
|
||||
OK := False;
|
||||
|
||||
-- ??? Don't we have a hash table to map files to Source_Id?
|
||||
|
||||
Iter := For_Each_Source (In_Tree);
|
||||
loop
|
||||
Source := Prj.Element (Iter);
|
||||
@ -7743,6 +7799,7 @@ package body Prj.Nmsc is
|
||||
-- ??? Should we simply set (can be done from the
|
||||
-- source)
|
||||
-- Index.File_Names (Source.Kind) := null;
|
||||
|
||||
end if;
|
||||
end if;
|
||||
|
||||
@ -7868,7 +7925,7 @@ package body Prj.Nmsc is
|
||||
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;
|
||||
@ -8017,13 +8074,14 @@ package body Prj.Nmsc is
|
||||
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
|
||||
@ -8040,7 +8098,7 @@ package body Prj.Nmsc is
|
||||
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
|
||||
@ -8352,8 +8410,8 @@ package body Prj.Nmsc is
|
||||
|
||||
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,
|
||||
@ -8365,8 +8423,8 @@ package body Prj.Nmsc is
|
||||
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,
|
||||
|
||||
@ -471,15 +471,24 @@ package System.OS_Interface is
|
||||
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;
|
||||
|
||||
|
||||
@ -52,6 +52,7 @@ with System.Soft_Links;
|
||||
-- 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
|
||||
@ -901,6 +902,10 @@ 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
|
||||
@ -963,6 +968,18 @@ package body System.Task_Primitives.Operations is
|
||||
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
|
||||
|
||||
90
gcc/ada/s-tasinf-vxworks.ads
Normal file
90
gcc/ada/s-tasinf-vxworks.ads
Normal file
@ -0,0 +1,90 @@
|
||||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- 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;
|
||||
@ -63,4 +63,14 @@ package body System.VxWorks.Ext is
|
||||
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;
|
||||
|
||||
@ -87,4 +87,13 @@ package System.VxWorks.Ext is
|
||||
-- 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;
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
-- --
|
||||
-- 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- --
|
||||
@ -79,4 +79,14 @@ package body System.VxWorks.Ext is
|
||||
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;
|
||||
|
||||
@ -81,4 +81,13 @@ package System.VxWorks.Ext is
|
||||
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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user