2004-01-05 Robert Dewar <dewar@gnat.com>

	* 1ssecsta.ads: Default_Secondary_Stack is not a constant since it may
	be modified by the binder generated main program if the -D switch is
	used.

	* 4onumaux.ads, 4znumaux.ads: Add Pure_Function pragmas for all
	imported functions (since now we expect this to be done for imported
	functions)

	* 5vtaprop.adb: Add several ??? for sections requiring more comments
	Minor reformatting throughout

	* 5zinit.adb: Minor reformatting
	Add 2004 to copyright date
	Minor changes to avoid -gnatwa warnings
	Correct some instances of using OR instead of OR ELSE (noted while
	doing reformatting)

	* sprint.adb: Minor updates to avoid -gnatwa warnings

	* s-secsta.ads, s-secsta.adb:
	(SS_Get_Max): New function to obtain high water mark for ss stack
	Default_Secondary_Stack is not a constant since it may be modified by
	the binder generated main program if the -D switch is used.

	* switch-b.adb: New -Dnnn switch for binder

	* switch-c.adb:
	Make -gnatg imply all warnings currently in -gnatwa

	* vms_conv.adb: Minor reformatting
	Add 2004 to copyright notice
	Add 2004 to printed copyright notice

	* 3vexpect.adb, 4zsytaco.adb, 3wsocthi.adb, 3zsocthi.adb,
	3zsocthi.adb, 56taprop.adb, 56tpopsp.adb, 5amastop.adb,
	5aml-tgt.adb, 5ataprop.adb, 5ataprop.adb, 5atpopsp.adb,
	5ftaprop.adb, 5ginterr.adb, 5gmastop.adb, 5gml-tgt.adb,
	5gtaprop.adb, 5hml-tgt.adb, 5hml-tgt.adb, 5hml-tgt.adb,
	5htaprop.adb, 5htraceb.adb, 5itaprop.adb, 5lml-tgt.adb,
	5sml-tgt.adb, 5staprop.adb, 5staprop.adb, 5stpopsp.adb,
	5vasthan.adb, 5vinmaop.adb, 5vinterr.adb, 5vtaprop.adb,
	5vml-tgt.adb, 5vtaprop.adb, 5wosprim.adb, 5wtaprop.adb,
	5zinterr.adb, 5zintman.adb, 5zml-tgt.adb, 5ztaprop.adb,
	6vcpp.adb, 6vcstrea.adb, 7staprop.adb, 7stpopsp.adb,
	vxaddr2line.adb, vxaddr2line.adb, xref_lib.adb, xr_tabls.adb,
	xr_tabls.ads, s-tasdeb.adb, s-tasdeb.adb, sem_res.ads,
	sem_util.adb, sem_util.adb, sem_util.ads, s-interr.adb,
	checks.adb, clean.adb, cstand.adb, einfo.ads,
	einfo.adb, exp_aggr.adb, exp_ch11.adb, exp_ch3.adb,
	exp_ch4.adb, exp_ch5.adb, exp_ch7.adb, exp_ch9.adb,
	prj-nmsc.adb, prj-pp.adb, prj-util.adb, sem_attr.adb,
	sem_ch10.adb, sem_ch12.adb, sem_ch4.adb, g-dirope.adb,
	g-dirope.ads, gnatlbr.adb, i-cstrea.adb, inline.adb,
	lib-xref.adb, sem_ch5.adb, sem_ch7.adb, sem_ch8.adb:
	Minor reformatting and code clean ups.
	Minor changes to prevent -gnatwa warnings

	* ali.adb: Minor reformatting and cleanup of code
	Acquire new SS indication of secondary stack use from ali files

	* a-numaux.ads: Add Pure_Function pragmas for all imported functions
	(since now we expect this to be done for imported functions)

	* bindgen.adb: Generate call to modify default secondary stack size if
	-Dnnn switch given

	* bindusg.adb: Add line for new -D switch

	* exp_aggr.adb (Type_May_Have_Bit_Aligned_Components): More appropriate
	replacement name for Type_May_Have_Non_Bit_Aligned_Components!
	Add circuitry for both records and arrays to avoid gigi
	processing if the type involved has non-bit-aligned components

	* exp_ch5.adb (Expand_Assign_Array): Avoid assumption that
	N_String_Literal node always references an E_String_Literal_Subtype
	entity. This may not be true in the future.
	(Possible_Bit_Aligned_Component): Move processing of
	Component_May_Be_Bit_Aligned from exp_ch5 to exp_util

	* exp_ch6.adb (Expand_Thread_Body): Pick up
	Default_Secondary_Stack_Size as variable so that we get value modified
	by possible -Dnnn binder parameter.

	* exp_util.adb (Component_May_Be_Bit_Aligned): New function.
	(Type_May_Have_Bit_Aligned_Components): New function.

	* exp_util.ads (Component_May_Be_Bit_Aligned): New function.
	(Type_May_Have_Bit_Aligned_Components): New function.

	* fe.h: (Set_Identifier_Casing): Fix prototype.
	Add declaration for Sem_Elim.Eliminate_Error_Msg.
	Minor reformatting.

	* freeze.adb (Freeze_Entity): Add RM reference to error message about
	importing constant atomic/volatile objects.
	(Freeze_Subprogram): Reset Is_Pure indication for imported subprogram
	unless explicit Pure_Function pragma given, to avoid insidious bug of
	call to non-pure imported function getting eliminated.

	* gnat1drv.adb, gnatbind.adb, gnatchop.adb, gnatfind.adb,
	gnatls.adb, gnatlink.adb, gnatmem.adb, gnatname.adb, gnatsym.adb,
	gnatxref.adb, gprcmd.adb, gprep.adb, make.adb: Minor reformatting
	Add 2004 to printed copyright notice

	* lib-writ.ads, lib-writ.adb: Put new SS flag in ali file if secondary
	stack used.

	* Makefile.rtl: Add entry for g-sestin.o
	g-sestin.ads: New file.

	* mdll.adb: Minor changes to avoid -gnatwa warnings

	* mlib-tgt.adb: Minor reformatting

	* opt.ads: New parameter Default_Secondary_Stack_Size (GNATBIND)
	New switch Sec_Stack_Used (GNAT, GNATBIND)
	Make Default_Secondary_Stack_Size a variable instead of a constant,
	so that it can be modified by the new -Dnnn bind switch.

	* rtsfind.adb (Load_Fail): Give full error message in configurable
	run-time mode if all_errors mode is set. This was not done in the case
	of a file not found, which was an oversight.
	Note if secondary stack unit is used by compiler.

	* sem_elab.adb (Check_A_Call): Rewrite to avoid trying to put
	ineffective elaborate all pragmas on non-visible packages (this
	happened when a renamed subprogram was called). Now the elaborate all
	always goes on the package containing the renaming rather than the one
	containing the renamed subprogram.

	* sem_elim.ads, sem_elim.adb (Eliminate_Error_Msg): New procedure
	(Process_Eliminate_Pragma): Add parameter to capture pragma location.

	* sem_eval.adb (Eval_String_Literal): Do not assume that string literal
	has an Etype that references an E_String_Literal.
	(Eval_String_Literal): Avoid assumption that N_String_Literal node
	always references an E_String_Literal_Subtype entity. This may not
	be true in the future.

	* sem_prag.adb (Process_Eliminate_Pragma): Add parameter to capture
	pragma location.

	* sem_res.adb (Resolve): Specialize msg for function name used in proc
	call.

2004-01-05  Ed Falis  <falis@gnat.com>

	* g-debuti.adb: Replaced direct boolean operator with short-circuit
	form.

2004-01-05  Vincent Celier  <celier@gnat.com>

	* bld.adb: Minor comment updates
	(Process_Declarative_Items): Correct incorrect name (Index_Name instead
	of Item_Name).

	* make.adb (Gnatmake): Special process for files to compile/check when
	-B is specified. Fail when there are only foreign mains in attribute
	Main of the project file and -B is not specified. Do not skip bind/link
	steps when -B is specified.

	* makeusg.adb: Document new switch -B

	* opt.ads (Build_Bind_And_Link_Full_Project): New Boolean flag

	* switch-m.adb: (Scan_Make_Switches): Process -B switch

	* vms_data.ads: Add new GNAT PRETTY qualifier
	/FORM_FEED_AFTER_PRAGMA_PAGE for switch -ff

2004-01-05  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* trans.c (tree_transform, case N_Free_Statement): Handle thin pointer
	case.

	* misc.c (gnat_printable_name): If VERBOSITY is 2, call
	Set_Identifier_Casing.

	* decl.c (gnat_to_gnu_entity, E_Function): Give error if return type
	has size that overflows.

2004-01-05  Gary Dismukes  <dismukes@gnat.com>

	* exp_ch4.adb (Expand_Array_Comparison): Add Boolean constant to avoid
	-gnatwa warning on static condition.

2004-01-05  Doug Rupp  <rupp@gnat.com>

	* link.c: (shared_libgnat_default) [VMS]: Change to STATIC.

2004-01-05  Arnaud Charlet  <charlet@act-europe.fr>

	* Makefile.in: Install ali files using INSTALL_DATA_DATE to preserve
	all attributes, including read-only attribute.

2004-01-05  Pascal Obry  <obry@gnat.com>

	* bindgen.adb (Gen_Object_Files_Options): Generate the new shared
	library naming scheme.

	* mlib-prj.adb (Build_Library): Generate different names for the static
	or dynamic version of the GNAT runtime. This is needed to support the
	new shared library naming scheme.
	(Process_Binder_File): Add detection of shared library in binder file
	based on the new naming scheme.

	* gnatlink.adb (Process_Binder_File): Properly detect the new naming
	scheme for the shared runtime libraries.

	* Makefile.in:
	(LIBRARY_VERSION) [VMS]: Convert all . to _ to conform to new naming
	scheme.
	(install-gnatlib): Do not create symlinks for shared libraries.
	(gnatlib-shared-default): Idem.
	(gnatlib-shared-dual-win32): New target. Not used for now as the
	auto-import feature does not support arrays/records.
	(gnatlib-shared-win32): Do not create copy for the shared libraries.
	(gnatlib-shared-vms): Fix shared runtime libraries names.

	* osint.ads, osint.adb (Shared_Lib): New routine, returns the target
	dependent runtime shared library name.

2004-01-05  Vasiliy Fofanov  <fofanov@act-europe.fr>

	* osint.adb (Read_Library_Info): Remove bogus check if ALI is older
	than the object.

2004-01-05  Ed Schonberg  <schonberg@gnat.com>

	* sem_ch4.adb (Analyze_Allocator): Check restriction on dynamic
	protected objects when allocator has a subtype indication, not a
	qualified expression. Note that qualified expressions may have to be
	checked when limited aggregates are implemented.

	* sem_prag.adb (Analyze_Pragma, case Import): If enclosing package is
	pure, emit warning.
	(Analyze_Pragma, case Pure_Function): If enclosing package is pure and
	subprogram is imported, remove warning.

2004-01-05  Geert Bosch  <bosch@gnat.com>

	* s-poosiz.adb: Update copyright notice.
	(Allocate): Use Task_Lock to protect against concurrent access.
	(Deallocate): Likewise.

2004-01-05  Joel Brobecker  <brobecker@gnat.com>

	* s-stalib.adb (Elab_Final_Code): Add missing year in date inside ???
	comment.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@75432 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 298 insertions, 158 deletions

diff --git a/gcc/ada/s-secsta.adb b/gcc/ada/s-secsta.adb
index ecb5e9e401e..449d986d511 100644
--- a/gcc/ada/s-secsta.adb
+++ b/gcc/ada/s-secsta.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2002 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-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- --
@@ -45,6 +45,27 @@ package body System.Secondary_Stack is
 
    SS_Ratio_Dynamic : constant Boolean :=
                         Parameters.Sec_Stack_Ratio = Parameters.Dynamic;
+   --  There are two entirely different implementations of the secondary
+   --  stack mechanism in this unit, and this Boolean is used to select
+   --  between them (at compile time, so the generated code will contain
+   --  only the code for the desired variant). If SS_Ratio_Dynamic is
+   --  True, then the secondary stack is dynamically allocated from the
+   --  heap in a linked list of chunks. If SS_Ration_Dynamic is False,
+   --  then the secondary stack is allocated statically by grabbing a
+   --  section of the primary stack and using it for this purpose.
+
+   type Memory is array (Mark_Id range <>) of SSE.Storage_Element;
+   for Memory'Alignment use Standard'Maximum_Alignment;
+   --  This is the type used for actual allocation of secondary stack
+   --  areas. We require maximum alignment for all such allocations.
+
+   ---------------------------------------------------------------
+   -- Data Structures for Dynamically Allocated Secondary Stack --
+   ---------------------------------------------------------------
+
+   --  The following is a diagram of the data structures used for the
+   --  case of a dynamically allocated secondary stack, where the stack
+   --  is allocated as a linked list of chunks allocated from the heap.
 
    --                                      +------------------+
    --                                      |       Next       |
@@ -76,8 +97,6 @@ package body System.Secondary_Stack is
    --    | Default_Size    |               |       Prev       |
    --    +-----------------+               +------------------+
    --
-   --
-   type Memory is array (Mark_Id range <>) of SSE.Storage_Element;
 
    type Chunk_Id (First, Last : Mark_Id);
    type Chunk_Ptr is access all Chunk_Id;
@@ -93,198 +112,302 @@ package body System.Secondary_Stack is
       Current_Chunk : Chunk_Ptr;
    end record;
 
+   type Stack_Ptr is access Stack_Id;
+   --  Pointer to record used to represent a dynamically allocated secondary
+   --  stack descriptor for a secondary stack chunk.
+
+   procedure Free is new Unchecked_Deallocation (Chunk_Id, Chunk_Ptr);
+   --  Free a dynamically allocated chunk
+
+   function To_Stack_Ptr is new
+     Unchecked_Conversion (Address, Stack_Ptr);
+   function To_Addr is new
+     Unchecked_Conversion (Stack_Ptr, Address);
+   --  Convert to and from address stored in task data structures
+
+   --------------------------------------------------------------
+   -- Data Structures for Statically Allocated Secondary Stack --
+   --------------------------------------------------------------
+
+   --  For the static case, the secondary stack is a single contiguous
+   --  chunk of storage, carved out of the primary stack, and represented
+   --  by the following data strcuture
+
    type Fixed_Stack_Id is record
-      Top  : Mark_Id;
+      Top : Mark_Id;
+      --  Index of next available location in Mem. This is initialized to
+      --  0, and then incremented on Allocate, and Decremented on Release.
+
       Last : Mark_Id;
-      Mem  : Memory (1 .. Mark_Id'Last / 2 - 1);
-      --  This should really be 1 .. Mark_Id'Last, but there is a bug in gigi
-      --  with this type, introduced Sep 2001, that causes gigi to reject this
-      --  type because its size in bytes overflows ???
+      --  Length of usable Mem array, which is thus the index past the
+      --  last available location in Mem. Mem (Last-1) can be used. This
+      --  is used to check that the stack does not overflow.
+
+      Max : Mark_Id;
+      --  Maximum value of Top. Initialized to 0, and then may be incremented
+      --  on Allocate, but is never Decremented. The last used location will
+      --  be Mem (Max - 1), so Max is the maximum count of used stack space.
+
+      Mem : Memory (0 .. 0);
+      --  This is the area that is actually used for the secondary stack.
+      --  Note that the upper bound is a dummy value properly defined by
+      --  the value of Last. We never actually allocate objects of type
+      --  Fixed_Stack_Id, so the bounds declared here do not matter.
    end record;
 
-   type Stack_Ptr is access Stack_Id;
-   type Fixed_Stack_Ptr is access Fixed_Stack_Id;
+   Dummy_Fixed_Stack : Fixed_Stack_Id;
+   pragma Warnings (Off, Dummy_Fixed_Stack);
+   --  Well it is not quite true that we never allocate an object of the
+   --  type. This dummy object is allocated for the purpose of getting the
+   --  offset of the Mem field via the 'Position attribute (such a nuisance
+   --  that we cannot apply this to a field of a type!)
 
-   function From_Addr is new Unchecked_Conversion (Address, Stack_Ptr);
-   function To_Addr   is new Unchecked_Conversion (Stack_Ptr, System.Address);
-   function To_Fixed  is new Unchecked_Conversion (Stack_Ptr, Fixed_Stack_Ptr);
+   type Fixed_Stack_Ptr is access Fixed_Stack_Id;
+   --  Pointer to record used to describe statically allocated sec stack
 
-   procedure Free is new Unchecked_Deallocation (Chunk_Id, Chunk_Ptr);
+   function To_Fixed_Stack_Ptr is new
+     Unchecked_Conversion (Address, Fixed_Stack_Ptr);
+   --  Convert from address stored in task data structures
 
    --------------
    -- Allocate --
    --------------
 
    procedure SS_Allocate
-     (Address      : out System.Address;
+     (Addr         : out Address;
       Storage_Size : SSE.Storage_Count)
    is
-      Stack        : constant Stack_Ptr :=
-                       From_Addr (SSL.Get_Sec_Stack_Addr.all);
-      Fixed_Stack  : Fixed_Stack_Ptr;
-      Chunk        : Chunk_Ptr;
       Max_Align    : constant Mark_Id := Mark_Id (Standard'Maximum_Alignment);
       Max_Size     : constant Mark_Id :=
                        ((Mark_Id (Storage_Size) + Max_Align - 1) / Max_Align)
                          * Max_Align;
 
-      To_Be_Released_Chunk : Chunk_Ptr;
-
    begin
-      --  If the secondary stack is fixed in the primary stack, then the
-      --  handling becomes simple
+      --  Case of fixed allocation secondary stack
 
       if not SS_Ratio_Dynamic then
-         Fixed_Stack := To_Fixed (Stack);
+         declare
+            Fixed_Stack : constant Fixed_Stack_Ptr :=
+                            To_Fixed_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all);
 
-         if Fixed_Stack.Top + Max_Size > Fixed_Stack.Last then
-            raise Storage_Error;
-         end if;
+         begin
+            --  Check if max stack usage is increasing
 
-         Address := Fixed_Stack.Mem (Fixed_Stack.Top)'Address;
-         Fixed_Stack.Top := Fixed_Stack.Top + Mark_Id (Max_Size);
-         return;
-      end if;
+            if Fixed_Stack.Top + Max_Size > Fixed_Stack.Max then
+
+               --  If so, check if max size is exceeded
+
+               if Fixed_Stack.Top + Max_Size > Fixed_Stack.Last then
+                  raise Storage_Error;
+               end if;
+
+               --  Record new max usage
+
+               Fixed_Stack.Max := Fixed_Stack.Top + Max_Size;
+            end if;
+
+            --  Set resulting address and update top of stack pointer
 
-      Chunk := Stack.Current_Chunk;
+            Addr := Fixed_Stack.Mem (Fixed_Stack.Top)'Address;
+            Fixed_Stack.Top := Fixed_Stack.Top + Max_Size;
+         end;
 
-      --  The Current_Chunk may not be the good one if a lot of release
-      --  operations have taken place. So go down the stack if necessary
+      --  Case of dynamically allocated secondary stack
 
-      while  Chunk.First > Stack.Top loop
-         Chunk := Chunk.Prev;
-      end loop;
+      else
+         declare
+            Stack : constant Stack_Ptr :=
+                      To_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all);
+            Chunk : Chunk_Ptr;
 
-      --  Find out if the available memory in the current chunk is sufficient.
-      --  if not, go to the next one and eventally create the necessary room
+            To_Be_Released_Chunk : Chunk_Ptr;
 
-      while Chunk.Last - Stack.Top + 1 < Max_Size loop
-         if Chunk.Next /= null then
+         begin
+            Chunk := Stack.Current_Chunk;
 
-            --  Release unused non-first empty chunk
+            --  The Current_Chunk may not be the good one if a lot of release
+            --  operations have taken place. So go down the stack if necessary
 
-            if Chunk.Prev /= null and then Chunk.First = Stack.Top then
-               To_Be_Released_Chunk := Chunk;
+            while Chunk.First > Stack.Top loop
                Chunk := Chunk.Prev;
-               Chunk.Next := To_Be_Released_Chunk.Next;
-               To_Be_Released_Chunk.Next.Prev := Chunk;
-               Free (To_Be_Released_Chunk);
-            end if;
+            end loop;
+
+            --  Find out if the available memory in the current chunk is
+            --  sufficient, if not, go to the next one and eventally create
+            --  the necessary room.
+
+            while Chunk.Last - Stack.Top + 1 < Max_Size loop
+               if Chunk.Next /= null then
+
+                  --  Release unused non-first empty chunk
+
+                  if Chunk.Prev /= null and then Chunk.First = Stack.Top then
+                     To_Be_Released_Chunk := Chunk;
+                     Chunk := Chunk.Prev;
+                     Chunk.Next := To_Be_Released_Chunk.Next;
+                     To_Be_Released_Chunk.Next.Prev := Chunk;
+                     Free (To_Be_Released_Chunk);
+                  end if;
 
-         --  Create new chunk of the default size unless it is not sufficient
+                  --  Create new chunk of default size unless it is not
+                  --  sufficient to satisfy the current request.
 
-         elsif SSE.Storage_Count (Max_Size) <= Stack.Default_Size then
-            Chunk.Next := new Chunk_Id (
-              First => Chunk.Last + 1,
-              Last  => Chunk.Last + Mark_Id (Stack.Default_Size));
+               elsif SSE.Storage_Count (Max_Size) <= Stack.Default_Size then
+                  Chunk.Next :=
+                    new Chunk_Id
+                      (First => Chunk.Last + 1,
+                       Last  => Chunk.Last + Mark_Id (Stack.Default_Size));
 
-            Chunk.Next.Prev := Chunk;
+                  Chunk.Next.Prev := Chunk;
 
-         else
-            Chunk.Next := new Chunk_Id (
-              First => Chunk.Last + 1,
-              Last  => Chunk.Last + Max_Size);
+                  --  Otherwise create new chunk of requested size
 
-            Chunk.Next.Prev := Chunk;
-         end if;
+               else
+                  Chunk.Next :=
+                    new Chunk_Id
+                      (First => Chunk.Last + 1,
+                       Last  => Chunk.Last + Max_Size);
 
-         Chunk     := Chunk.Next;
-         Stack.Top := Chunk.First;
-      end loop;
+                  Chunk.Next.Prev := Chunk;
+               end if;
 
-      --  Resulting address is the address pointed by Stack.Top
+               Chunk     := Chunk.Next;
+               Stack.Top := Chunk.First;
+            end loop;
 
-      Address      := Chunk.Mem (Stack.Top)'Address;
-      Stack.Top    := Stack.Top + Max_Size;
-      Stack.Current_Chunk := Chunk;
+            --  Resulting address is the address pointed by Stack.Top
+
+            Addr                := Chunk.Mem (Stack.Top)'Address;
+            Stack.Top           := Stack.Top + Max_Size;
+            Stack.Current_Chunk := Chunk;
+         end;
+      end if;
    end SS_Allocate;
 
    -------------
    -- SS_Free --
    -------------
 
-   procedure SS_Free (Stk : in out System.Address) is
-      Stack : Stack_Ptr;
-      Chunk : Chunk_Ptr;
-
-      procedure Free is new Unchecked_Deallocation (Stack_Id, Stack_Ptr);
-
+   procedure SS_Free (Stk : in out Address) is
    begin
+      --  Case of statically allocated secondary stack, nothing to free
+
       if not SS_Ratio_Dynamic then
          return;
-      end if;
 
-      Stack := From_Addr (Stk);
-      Chunk := Stack.Current_Chunk;
+      --  Case of dynamically allocated secondary stack
+
+      else
+         declare
+            Stack : Stack_Ptr := To_Stack_Ptr (Stk);
+            Chunk : Chunk_Ptr;
 
-      while Chunk.Prev /= null loop
-         Chunk := Chunk.Prev;
-      end loop;
+            procedure Free is new Unchecked_Deallocation (Stack_Id, Stack_Ptr);
 
-      while Chunk.Next /= null loop
-         Chunk := Chunk.Next;
-         Free (Chunk.Prev);
-      end loop;
+         begin
+            Chunk := Stack.Current_Chunk;
+
+            while Chunk.Prev /= null loop
+               Chunk := Chunk.Prev;
+            end loop;
 
-      Free (Chunk);
-      Free (Stack);
-      Stk := Null_Address;
+            while Chunk.Next /= null loop
+               Chunk := Chunk.Next;
+               Free (Chunk.Prev);
+            end loop;
+
+            Free (Chunk);
+            Free (Stack);
+            Stk := Null_Address;
+         end;
+      end if;
    end SS_Free;
 
+   ----------------
+   -- SS_Get_Max --
+   ----------------
+
+   function SS_Get_Max return Long_Long_Integer is
+   begin
+      if SS_Ratio_Dynamic then
+         return -1;
+      else
+         declare
+            Fixed_Stack : constant Fixed_Stack_Ptr :=
+                            To_Fixed_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all);
+         begin
+            return Long_Long_Integer (Fixed_Stack.Max);
+         end;
+      end if;
+   end SS_Get_Max;
+
    -------------
    -- SS_Info --
    -------------
 
    procedure SS_Info is
-      Stack       : constant Stack_Ptr :=
-                      From_Addr (SSL.Get_Sec_Stack_Addr.all);
-      Fixed_Stack : Fixed_Stack_Ptr;
-      Nb_Chunks   : Integer            := 1;
-      Chunk       : Chunk_Ptr          := Stack.Current_Chunk;
-
    begin
       Put_Line ("Secondary Stack information:");
 
+      --  Case of fixed secondary stack
+
       if not SS_Ratio_Dynamic then
-         Fixed_Stack := To_Fixed (Stack);
-         Put_Line (
-           "  Total size              : "
-           & Mark_Id'Image (Fixed_Stack.Last)
-           & " bytes");
-         Put_Line (
-           "  Current allocated space : "
-           & Mark_Id'Image (Fixed_Stack.Top - 1)
-           & " bytes");
-         return;
-      end if;
+         declare
+            Fixed_Stack : constant Fixed_Stack_Ptr :=
+                            To_Fixed_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all);
+
+         begin
+            Put_Line (
+                      "  Total size              : "
+                      & Mark_Id'Image (Fixed_Stack.Last)
+                      & " bytes");
+
+            Put_Line (
+                      "  Current allocated space : "
+                      & Mark_Id'Image (Fixed_Stack.Top - 1)
+                      & " bytes");
+         end;
+
+      --  Case of dynamically allocated secondary stack
+
+      else
+         declare
+            Stack     : constant Stack_Ptr :=
+                          To_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all);
+            Nb_Chunks : Integer   := 1;
+            Chunk     : Chunk_Ptr := Stack.Current_Chunk;
+
+         begin
+            while Chunk.Prev /= null loop
+               Chunk := Chunk.Prev;
+            end loop;
 
-      while Chunk.Prev /= null loop
-         Chunk := Chunk.Prev;
-      end loop;
-
-      while Chunk.Next /= null loop
-         Nb_Chunks := Nb_Chunks + 1;
-         Chunk := Chunk.Next;
-      end loop;
-
-      --  Current Chunk information
-
-      Put_Line (
-        "  Total size              : "
-        & Mark_Id'Image (Chunk.Last)
-        & " bytes");
-      Put_Line (
-        "  Current allocated space : "
-        & Mark_Id'Image (Stack.Top - 1)
-        & " bytes");
-
-      Put_Line (
-        "  Number of Chunks       : "
-        & Integer'Image (Nb_Chunks));
-
-      Put_Line (
-        "  Default size of Chunks : "
-        & SSE.Storage_Count'Image (Stack.Default_Size));
+            while Chunk.Next /= null loop
+               Nb_Chunks := Nb_Chunks + 1;
+               Chunk := Chunk.Next;
+            end loop;
+
+            --  Current Chunk information
+
+            Put_Line (
+                      "  Total size              : "
+                      & Mark_Id'Image (Chunk.Last)
+                      & " bytes");
+
+            Put_Line (
+                      "  Current allocated space : "
+                      & Mark_Id'Image (Stack.Top - 1)
+                      & " bytes");
+
+            Put_Line (
+                      "  Number of Chunks       : "
+                      & Integer'Image (Nb_Chunks));
+
+            Put_Line (
+                      "  Default size of Chunks : "
+                      & SSE.Storage_Count'Image (Stack.Default_Size));
+         end;
+      end if;
    end SS_Info;
 
    -------------
@@ -292,33 +415,41 @@ package body System.Secondary_Stack is
    -------------
 
    procedure SS_Init
-     (Stk  : in out System.Address;
+     (Stk  : in out Address;
       Size : Natural := Default_Secondary_Stack_Size)
    is
-      Stack : Stack_Ptr;
-      Fixed_Stack : Fixed_Stack_Ptr;
-
    begin
-      if not SS_Ratio_Dynamic then
-         Fixed_Stack      := To_Fixed (From_Addr (Stk));
-         Fixed_Stack.Top  := Fixed_Stack.Mem'First;
-
-         if Size < 2 * Mark_Id'Max_Size_In_Storage_Elements then
-            Fixed_Stack.Last := 0;
-         else
-            Fixed_Stack.Last := Mark_Id (Size) -
-              2 * Mark_Id'Max_Size_In_Storage_Elements;
-         end if;
+      --  Case of fixed size secondary stack
 
-         return;
+      if not SS_Ratio_Dynamic then
+         declare
+            Fixed_Stack : Fixed_Stack_Ptr := To_Fixed_Stack_Ptr (Stk);
+
+         begin
+            Fixed_Stack.Top  := 0;
+            Fixed_Stack.Max  := 0;
+
+            if Size < Dummy_Fixed_Stack.Mem'Position then
+               Fixed_Stack.Last := 0;
+            else
+               Fixed_Stack.Last :=
+                 Mark_Id (Size) - Dummy_Fixed_Stack.Mem'Position;
+            end if;
+         end;
+
+      --  Case of dynamically allocated secondary stack
+
+      else
+         declare
+            Stack : Stack_Ptr;
+         begin
+            Stack               := new Stack_Id;
+            Stack.Current_Chunk := new Chunk_Id (1, Mark_Id (Size));
+            Stack.Top           := 1;
+            Stack.Default_Size  := SSE.Storage_Count (Size);
+            Stk := To_Addr (Stack);
+         end;
       end if;
-
-      Stack               := new Stack_Id;
-      Stack.Current_Chunk := new Chunk_Id (1, Mark_Id (Size));
-      Stack.Top           := 1;
-      Stack.Default_Size  := SSE.Storage_Count (Size);
-
-      Stk := To_Addr (Stack);
    end SS_Init;
 
    -------------
@@ -327,7 +458,11 @@ package body System.Secondary_Stack is
 
    function SS_Mark return Mark_Id is
    begin
-      return From_Addr (SSL.Get_Sec_Stack_Addr.all).Top;
+      if SS_Ratio_Dynamic then
+         return To_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all).Top;
+      else
+         return To_Fixed_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all).Top;
+      end if;
    end SS_Mark;
 
    ----------------
@@ -336,30 +471,35 @@ package body System.Secondary_Stack is
 
    procedure SS_Release (M : Mark_Id) is
    begin
-      From_Addr (SSL.Get_Sec_Stack_Addr.all).Top := M;
+      if SS_Ratio_Dynamic then
+         To_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all).Top := M;
+      else
+         To_Fixed_Stack_Ptr (SSL.Get_Sec_Stack_Addr.all).Top := M;
+      end if;
    end SS_Release;
 
    -------------------------
    -- Package Elaboration --
    -------------------------
 
-   --  Allocate a secondary stack for the main program to use.
+   --  Allocate a secondary stack for the main program to use
+
    --  We make sure that the stack has maximum alignment. Some systems require
    --  this (e.g. Sun), and in any case it is a good idea for efficiency.
 
    Stack : aliased Stack_Id;
    for Stack'Alignment use Standard'Maximum_Alignment;
 
-   Chunk : aliased Chunk_Id (1, Default_Secondary_Stack_Size);
+   Chunk : aliased Chunk_Id (1, Mark_Id (Default_Secondary_Stack_Size));
    for Chunk'Alignment use Standard'Maximum_Alignment;
 
-   Chunk_Address : System.Address;
+   Chunk_Address : Address;
 
 begin
    if SS_Ratio_Dynamic then
       Stack.Top           := 1;
       Stack.Current_Chunk := Chunk'Access;
-      Stack.Default_Size  := Default_Secondary_Stack_Size;
+      Stack.Default_Size  := SSE.Storage_Offset (Default_Secondary_Stack_Size);
       System.Soft_Links.Set_Sec_Stack_Addr_NT (Stack'Address);
 
    else