Sorry to use this reporting method, but I'm new to your error reporting
system, and I could not get through the Bugzilla routines.
GNAT Ada bug:
I encountered this error while using the included make procedure for
oos-0.1.1 in the gnade download. The command line causing the problem
(as synthesized by the make file) is in file "error_command-line". The
error message itself, including the compiler version information, in the
file "errors". The required source code is concatenated in file
"needed_sources".
Norman Worth
[EMAIL PROTECTED]
for f in util server libclient server/classes libclient server/apps odlprep
doc ; do \
make -C ./$f all ; \
if test "$?" != "0" ; then exit $? ; fi \
done
make[1]: Entering directory `/home/nw/downloads/gnade/oos-0.1.1-src/util'
libtool --mode=compile gcc -c -g -I/usr/local
-I/home/nw/downloads/gnade/oos-0.1.1-src/linux-gnu-i686-include -gnatf
util-linux-shm_streams.adb
gcc -c -g -I/usr/local
-I/home/nw/downloads/gnade/oos-0.1.1-src/linux-gnu-i686-include -gnatf
util-linux-shm_streams.adb -fPIC -DPIC -o .libs/util-linux-shm_streams.o
make[1]: Leaving directory `/home/nw/downloads/gnade/oos-0.1.1-src/util'
+===========================GNAT BUG DETECTED==============================+
| 4.1.2 20061115 (prerelease) (SUSE Linux) (i586-suse-linux-gnu) GCC error:|
| in tree_low_cst, at tree.c:4399 |
| Error detected at util-linux-shm_streams.adb:129:8 |
| Please submit a bug report; see http://gcc.gnu.org/bugs.html. |
| Use a subject line meaningful to you and us to track the bug. |
| Include the entire contents of this bug box in the report. |
| Include the exact gcc or gnatmake command that you entered. |
| Also include sources listed below in gnatchop format |
| (concatenated together with no headers between files). |
+==========================================================================+
Please include these source files with error report
Note that list may not be accurate in some cases,
so please double check that the problem can still
be reproduced with the set of files listed.
util-linux-shm_streams.adb
util-linux-shm_streams.ads
util-linux.ads
util.ads
util-linux-shm.ads
util-types.ads
util-trace.ads
util-trace_helper.ads
util-trace_helper.adb
util-linux-shm_streams.adb:109:11: warning: default initialization of "CA" may
modify overlaid storage
util-linux-shm_streams.adb:109:11: warning: use pragma Import for "CA" to
suppress initialization (RM B.1(24))
util-linux-shm_streams.adb:142:11: warning: default initialization of "CA" may
modify overlaid storage
util-linux-shm_streams.adb:142:11: warning: use pragma Import for "CA" to
suppress initialization (RM B.1(24))
util-linux-shm_streams.adb:179:11: warning: default initialization of "CA" may
modify overlaid storage
util-linux-shm_streams.adb:179:11: warning: use pragma Import for "CA" to
suppress initialization (RM B.1(24))
util-linux-shm_streams.adb:217:11: warning: default initialization of "CA" may
modify overlaid storage
util-linux-shm_streams.adb:217:11: warning: use pragma Import for "CA" to
suppress initialization (RM B.1(24))
util-linux-shm_streams.adb:232:11: warning: default initialization of "CA" may
modify overlaid storage
util-linux-shm_streams.adb:232:11: warning: use pragma Import for "CA" to
suppress initialization (RM B.1(24))
util-linux-shm_streams.adb:248:11: warning: default initialization of "CA" may
modify overlaid storage
util-linux-shm_streams.adb:248:11: warning: use pragma Import for "CA" to
suppress initialization (RM B.1(24))
util-linux-shm_streams.adb:262:11: warning: default initialization of "CA" may
modify overlaid storage
util-linux-shm_streams.adb:262:11: warning: use pragma Import for "CA" to
suppress initialization (RM B.1(24))
util-linux-shm_streams.adb:306:11: warning: default initialization of "CA" may
modify overlaid storage
util-linux-shm_streams.adb:306:11: warning: use pragma Import for "CA" to
suppress initialization (RM B.1(24))
util-linux-shm_streams.adb:337:11: warning: default initialization of "CA" may
modify overlaid storage
util-linux-shm_streams.adb:337:11: warning: use pragma Import for "CA" to
suppress initialization (RM B.1(24))
util-linux-shm_streams.adb:339:68: warning: "Length" may be referenced before
it has a value
compilation abandoned
make[1]: *** [util-linux-shm_streams.lo] Error 1
-------------------------------------------------------------------------------
-- --
-- Filename : $Source:
/cvsroot/gnade/adb/util/util-linux-shm_streams.adb,v $
-- Description : Stream which writes into memory --
-- Author : Michael Erdmann --
-- Created : 31.12.2001 --
-- Last Modified By: $Author: merdmann $
-- Last Modified On: $Date: 2005/10/03 11:54:12 $
-- Status : $State: Exp $
-- --
-- Copyright (C) 2001 Michael Erdmann --
-- --
-- GNADE is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- This software is implemented to work with GNAT, the GNU Ada compiler. --
-- --
-- Functional Description --
-- ====================== --
-- This packages contains a stream class which write into a memory section --
-- with the specified size. --
-- --
-- --
-- Restrictions --
-- ============ --
-- Only Linux --
-- --
-- Contact --
-- ======= --
-- Error reports and suggestions shall be send to the Address: --
-- [EMAIL PROTECTED] --
-- --
-- General Informations will be found at: --
-- purl/net/michael.erdmann --
-- --
-------------------------------------------------------------------------------
--* Ada
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Streams; use Ada.Streams;
with Ada.Characters.Latin_1; use Ada.Characters.Latin_1;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with System; use System;
with System.Storage_Elements; use System.Storage_Elements;
with Unchecked_Deallocation;
with Util.Linux.SHM; use Util.Linux.SHM;
with Util.Trace; use Util.Trace;
with Util.Types; use Util.Types;
with Util.Trace_Helper;
package body Util.Linux.SHM_Streams is
Version : constant String :=
"$Id: util-linux-shm_streams.adb,v 1.9 2005/10/03 11:54:12 merdmann Exp
$";
package Tracer is new Trace_Helper( Module => "Util.Linux.SHM_Streams");
use Tracer;
type Handle is access all Object;
-----------------
-- Object_Data --
-----------------
type Object_Data is record
Shm : SHM_Key;
Size : Stream_Element_Offset;
CA_Address : System.Address;
end record;
--------------------
-- CA_Buffer_Type --
--------------------
type CA_Buffer_Type( Size : Stream_Element_Offset ) is record
Clean : Boolean := False;
Last_Stored : Stream_Element_Offset;
Last_Read : Stream_Element_Offset;
Data : Stream_Element_Array( 1..Size );
end record;
----------
-- Read --
----------
procedure Read (
This : in out Object ;
Item : out Stream_Element_Array ;
Last : out Stream_Element_Offset) is
-- Procedure to read data from the communication link.
Data : Object_Data_Access renames This.Data;
CA_Address : constant System.Address := Data.CA_Address;
CA : CA_Buffer_Type( Data.Size );
for CA'Address use CA_Address;
begin
if CA.Last_Read > CA.Last_Stored then
raise Buffer_Underrun;
end if;
for X in Item'Range loop
Item(X) := CA.Data(CA.Last_Read);
Last := X;
CA.Last_Read := CA.Last_Read + 1;
exit when CA.Last_Read > CA.Last_Stored;
end loop;
exception
when E : others =>
Info( "Util.Lunix.SHM_Streams.Read" & Stream_Element_Offset'Image(
CA.Last_Read ) );
Info( " Last_Read " & Stream_Element_Offset'Image( CA.Last_Read ) );
Info( " Last_Stored" & Stream_Element_Offset'Image( CA.Last_Stored )
);
Trace_Exception(E);
end Read;
-----------
-- Write --
-----------
procedure Write(
This : in out Object;
Item : in Stream_Element_Array) is
-- Write the data into the output stream
Data : Object_Data_Access renames This.Data;
CA_Address : constant System.Address := Data.CA_Address;
CA : CA_Buffer_Type( Data.Size );
for CA'Address use CA_Address;
begin
for X in Item'Range loop
CA.Last_Stored := CA.Last_Stored + 1;
if not ( CA.Last_Stored in CA.Data'Range ) then
raise Buffer_Overrun;
end if;
CA.Data( CA.Last_Stored ) := Item( X );
end loop ;
exception
when E : others =>
Info( "Util.Linx.SHM_Streams.Write at " & Stream_Element_Offset'Image(
CA.Last_Stored ) );
Trace_Exception(E);
end Write;
----------------
-- Initialize --
----------------
function Initialize return Object_Data_Access is
-- Initialize the Object data and call the Initialization
-- procedure of the extension.
Data : Object_Data_Access := new Object_Data;
begin
return Data;
end Initialize;
-------------------
-- Initialize_CA --
-------------------
procedure Initialize_CA(
Data : in Object_Data_Access ) is
CA_Address : constant System.Address := Data.CA_Address;
CA : CA_Buffer_Type( Data.Size );
for CA'Address use CA_Address;
begin
CA.Last_Stored := 0;
CA.Last_Read := CA.Data'First;
CA.Clean := False;
end Initialize_CA;
--------------
-- Finalize --
--------------
procedure Destroy(
S : in out Stream_Access ) is
-- Finalize the instance by releasing the object data
-- finalizing the extension.
Data : Object_Data_Access renames Handle(S).data;
procedure Free is
new Unchecked_Deallocation( Object_Data, Object_Data_Access);
begin
if Data = null then
return;
end if;
Destroy( Data.Shm, Data.CA_Address, Mode => Server );
Free( Data );
S := null;
end Destroy;
-------------------
-- Stored_Length --
-------------------
function Stored_Length(
S : in Stream_Access ) return Natural is
Data : Object_Data_Access renames Handle(S).Data;
CA_Address : constant System.Address := Data.CA_Address;
CA : CA_Buffer_Type( Data.Size );
for CA'Address use CA_Address;
begin
return Natural(CA.Last_Stored);
end Stored_Length;
------------------
-- Write_Offset --
------------------
function Write_Offset(
S : in Stream_Access ) return Natural is
-- returns the number of elements written so far
Data : Object_Data_Access renames Handle(S).Data;
CA_Address : constant System.Address := Data.CA_Address;
CA : CA_Buffer_Type( Data.Size );
for CA'Address use CA_Address;
begin
return Natural( CA.Last_Stored + 1 );
end Write_Offset;
----------
-- Seek --
----------
procedure Seek(
S : in Stream_Access;
Offset : in Natural ) is
-- returns the number of elements written so far
Data : Object_Data_Access renames Handle(S).Data;
CA_Address : constant System.Address := Data.CA_Address;
CA : CA_Buffer_Type( Data.Size );
for CA'Address use CA_Address;
begin
CA.Last_Read := Stream_Element_Offset(Offset);
end Seek;
----------
-- Dump --
----------
procedure Dump(
S : in Stream_Access ) is
Data : Object_Data_Access renames Handle(S).Data;
CA_Address : constant System.Address := Data.CA_Address;
CA : CA_Buffer_Type( Data.Size );
for CA'Address use CA_Address;
begin
Dump( CA.Data(1..CA.Last_Stored) );
end Dump;
------------
-- Stream --
------------
function Stream(
Shm : in SHM_Key;
Size : in Natural := 60_000;
Controler : in Boolean := False ) return Stream_Access is
--
Result : Handle := new Object;
Data : Object_Data_Access := new Object_Data;
Mode : Access_Mode_Type := Client;
begin
if Controler then
Data.CA_Address := Allocate( Shm, Size, Mode => Server );
else
Data.CA_Address := Allocate( Shm, Size );
end if;
Data.Size := Stream_Element_Offset(Size);
Data.Shm := Shm;
Result.Data := Data;
Initialize_CA( Data );
return Stream_Access(Result);
end Stream;
-------------
-- Copy_In --
-------------
procedure Copy_In(
S : in Stream_Access;
Buffer : in Buffer_Access;
Length : in Natural ) is
-- copy from a buffer into the CA buffer
Data : Object_Data_Access renames Handle(S).Data;
CA_Address : constant System.Address := Data.CA_Address;
CA : CA_Buffer_Type( Data.Size );
for CA'Address use CA_Address;
begin
Enter("Copy_In(..," & Image( Buffer ) & "," & Natural'Image(Length) &")"
);
for i in 1..Length loop
CA.Last_Stored := CA.Last_Stored + 1;
if not ( CA.Last_Stored in CA.Data'Range ) then
raise Buffer_Overrun;
end if;
CA.Data( CA.Last_Stored ) := Stream_Element( Buffer( Storage_Offset(i)
) );
end loop;
Info(" Last_Read " & Stream_Element_Offset'Image( CA.Last_Read ) );
Info(" Last_Stored " & Stream_Element_Offset'Image( CA.Last_Stored ) );
Leave("Copy_In");
end Copy_In;
--------------
-- Copy_Out --
--------------
procedure Copy_Out(
S : in Stream_Access;
Buffer : in Buffer_Access;
Length : out Natural ) is
-- Write the data into the output stream
Data : Object_Data_Access renames Handle(S).Data;
CA_Address : constant System.Address := Data.CA_Address;
CA : CA_Buffer_Type( Data.Size );
for CA'Address use CA_Address;
begin
Enter("Copy_Out(..," & Image( Buffer ) & "," & Natural'Image(Length) &")"
);
Info(" Last_Read " & Stream_Element_Offset'Image( CA.Last_Read ) );
Info(" Last_Stored " & Stream_Element_Offset'Image( CA.Last_Stored ) );
Length := 0;
for I in Buffer.all'Range loop
exit when CA.Last_Stored = 0 or CA.Last_Read > CA.Last_Stored;
Buffer(I) := Storage_Element(CA.Data(CA.Last_Read));
CA.Last_Read := CA.Last_Read + 1;
Length := Length + 1;
end loop;
Reset( S );
Leave("Copy_Out" );
end Copy_Out;
-----------
-- Reset --
-----------
procedure Reset(
S : in Stream_Access) is
Data : Object_Data_Access renames Handle(S).Data;
begin
Enter("Reset");
Initialize_CA( Data );
Leave("Reset");
end Reset;
end Util.Linux.SHM_Streams;
-------------------------------------------------------------------------------
-- --
-- Filename : $Source:
/cvsroot/gnade/adb/util/util-linux-shm_streams.ads,v $
-- Description : Streams on top of message queues --
-- Author : Michael Erdmann --
-- Created : 31.12.2001 --
-- Last Modified By: $Author: merdmann $
-- Last Modified On: $Date: 2005/07/17 19:53:37 $
-- Status : $State: Exp $
-- --
-- Copyright (C) 2001 Michael Erdmann --
-- --
-- GNADE is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- This software is implemented to work with GNAT, the GNU Ada compiler. --
-- --
-- Functional Description --
-- ====================== --
-- This package contains all defintions needed for the linux operating --
-- system. This may have to be adopted for other environments. --
-- --
-- Restrictions --
-- ============ --
-- Only Linux --
-- --
-- Contact --
-- ======= --
-- Error reports and suggestions shall be send to the Address: --
-- [EMAIL PROTECTED] --
-- --
-- General Informations will be found at: --
-- purl:/net/michael.erdmann --
-- --
-------------------------------------------------------------------------------
with System; use System;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with Ada.Streams; use Ada.Streams;
with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO;
with Util.Linux; use Util.Linux;
with Util.Linux.SHM; use Util.Linux.SHM;
with Util.Types; use Util.Types;
package Util.Linux.SHM_Streams is
type Object is new Ada.Streams.Root_Stream_Type with private ;
Buffer_Overrun : exception;
Buffer_Underrun : exception;
procedure Destroy(
S : in out Stream_Access );
function Stream(
Shm : in SHM_Key;
Size : in Natural := 60_000;
Controler : in Boolean := False ) return Stream_Access;
function Stored_Length(
S : in Stream_Access ) return Natural;
procedure Dump(
S : in Stream_Access );
procedure Copy_In(
S : in Stream_Access;
Buffer : in Buffer_Access;
Length : in Natural ) ;
procedure Copy_Out(
S : in Stream_Access;
Buffer : in Buffer_Access;
Length : out Natural ) ;
procedure Reset(
S : in Stream_Access) ;
function Write_Offset(
S : in Stream_Access ) return Natural;
procedure Seek(
S : in Stream_Access;
Offset : in Natural );
---=====================================================================---
private
type Object_Data;
type Object_Data_Access is access all Object_Data;
function Initialize return Object_Data_Access;
type Object is new Ada.Streams.Root_Stream_Type with record
Data : Object_Data_Access := Initialize;
end record;
-- requiered by the streams interface
procedure Read (
this : in out Object ;
Item : out Ada.Streams.Stream_Element_Array ;
Last : out Ada.Streams.Stream_Element_Offset ) ;
procedure Write (
this : in out Object ;
Item : in Ada.Streams.Stream_Element_Array) ;
end Util.Linux.SHM_Streams;
-- ------------------------------------------------------------------------- --
-- --
-- Filename : $Source: /cvsroot/gnade/gnade/Makefile
-- Description : Util base package --
-- Author : Michael Erdmann <[EMAIL PROTECTED]> --
-- Created On : 30-April-2005 --
-- Last Modified By: $Author: merdmann $ --
-- Last Modified On: $Date: 2005/05/29 11:22:27 $ --
-- Status : $State: Exp $ --
-- --
-- Copyright (C) 2005 Michael Erdmann --
-- --
-- SDB is copyrighted by the persons and institutions enumerated in the --
-- AUTHORS file. This file is located in the root directory of the --
-- SDB distribution. --
-- --
-- SDB is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with SDB; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from --
-- SDB Ada units, or you link SDB Ada units or libraries with other --
-- files to produce an executable, these units or libraries do not by --
-- itself cause the resulting executable to be covered by the GNU --
-- General Public License. This exception does not however invalidate --
-- any other reasons why the executable file might be covered by the --
-- GNU Public License. --
-- --
-- ------------------------------------------------------------------------- --
package Util is
end Util;
-------------------------------------------------------------------------------
-- --
-- Filename : $Source: /cvsroot/gnade/adb/util/util-linux-shm.ads,v $
-- Description : Shared memory object --
-- Author : Michael Erdmann --
-- Created : 31.12.2001 --
-- Last Modified By: $Author: merdmann $
-- Last Modified On: $Date: 2005/05/21 13:38:12 $
-- Status : $State: Exp $
-- --
-- Copyright (C) 2001 Michael Erdmann --
-- --
-- GNADE is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- This software is implemented to work with GNAT, the GNU Ada compiler. --
-- --
-- Functional Description --
-- ====================== --
-- This genric package provides a shared object which is referenced on --
-- on basis of the shared memory key. This instance is persitent and cant --
-- be deleted because it is in the shared memory of the operating system --
-- --
-- Restrictions --
-- ============ --
-- Only Linux --
-- --
-- Contact --
-- ======= --
-- Error reports and suggestions shall be send to the Address: --
-- [EMAIL PROTECTED] --
-- --
-- General Informations will be found at: --
-- purl:/net/michael.erdmann --
-- --
-------------------------------------------------------------------------------
with System; use System;
with System.Storage_Elements; use System.Storage_Elements;
with Util.Types; use Util.Types;
package Util.Linux.Shm is
type Access_Mode_Type is ( Client, Server );
function Allocate(
Key : in SHM_Key;
Size : in Natural;
Mode : in Access_Mode_Type := Client ) return System.Address;
procedure Destroy(
Key : in SHM_Key;
Addr : in System.Address;
Mode : in Access_Mode_Type := Client );
end Util.Linux.Shm;
-- ------------------------------------------------------------------------- --
-- --
-- Filename : $Source: /cvsroot/gnade/gnade/Makefile
-- Description : Util base package --
-- Author : Michael Erdmann <[EMAIL PROTECTED]> --
-- Created On : 30-April-2005 --
-- Last Modified By: $Author: merdmann $ --
-- Last Modified On: $Date: 2005/09/25 19:20:11 $ --
-- Status : $State: Exp $ --
-- --
-- Copyright (C) 2005 Michael Erdmann --
-- --
-- SDB is copyrighted by the persons and institutions enumerated in the --
-- AUTHORS file. This file is located in the root directory of the --
-- SDB distribution. --
-- --
-- SDB is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with SDB; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from --
-- SDB Ada units, or you link SDB Ada units or libraries with other --
-- files to produce an executable, these units or libraries do not by --
-- itself cause the resulting executable to be covered by the GNU --
-- General Public License. This exception does not however invalidate --
-- any other reasons why the executable file might be covered by the --
-- GNU Public License. --
-- --
-- ------------------------------------------------------------------------- --
with System.Storage_Elements; use System.Storage_Elements;
with System; use System;
with Ada.Streams; use Ada.Streams;
with Util.Trace; use Util.Trace;
use Util;
package Util.Types is
type Buffer_Access is access all Storage_Array;
procedure Free(
Buffer : in out Buffer_Access );
function Image(
A : in Address ) return String;
function Image(
A : in Buffer_Access ) return String;
function Image(
A : in Integer ) return String;
procedure Dump(
Data : in Buffer_Access;
Length : in Natural;
Level : in Level_Type := Trace.Functional );
procedure Dump(
Data : in Stream_Element_Array;
Level : in Level_Type := Trace.Functional );
end Util.Types;
-- ------------------------------------------------------------------------- --
-- --
-- Filename : $Source: /cvsroot/gnade/gnade/Makefile
-- Description : Util base package --
-- Author : Michael Erdmann <[EMAIL PROTECTED]> --
-- Created On : 30-April-2005 --
-- Last Modified By: $Author: merdmann $ --
-- Last Modified On: $Date: 2005/09/06 16:55:47 $ --
-- Status : $State: Exp $ --
-- --
-- Copyright (C) 2005 Michael Erdmann --
-- --
-- SDB is copyrighted by the persons and institutions enumerated in the --
-- AUTHORS file. This file is located in the root directory of the --
-- SDB distribution. --
-- --
-- SDB is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with SDB; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from --
-- SDB Ada units, or you link SDB Ada units or libraries with other --
-- files to produce an executable, these units or libraries do not by --
-- itself cause the resulting executable to be covered by the GNU --
-- General Public License. This exception does not however invalidate --
-- any other reasons why the executable file might be covered by the --
-- GNU Public License. --
-- --
-- ------------------------------------------------------------------------- --
package Util.Trace is
type Level_Type is new Natural Range 0..99;
Informative : constant Level_Type := 1;
Flow : constant Level_Type := 30;
Functional : constant Level_Type := 60;
---------------------------------------------------------------------------
-- Description:
-- Start a trace session for the current task
-- Preconditions:
-- None
-- Postconditions:
-- P.1 - Tracefile with name of the current thread created
-- Exceptions:
-- Notes:
---------------------------------------------------------------------------
procedure Start_Trace(
Trace_File : in String;
Level : in Level_Type := 0 );
---------------------------------------------------------------------------
-- Description:
-- Write a trace entry with the given trace level
-- Preconditions:
-- None
-- Postconditions:
-- P.1 - If a trace session has been created previously by means
-- of Start_Trace the entry is appended to the file
-- Exceptions:
-- Notes:
---------------------------------------------------------------------------
procedure Log(
Level : in Level_Type := Flow;
Text : in String ) ;
---------------------------------------------------------------------------
-- Description:
-- Set the directory where the trace files are written.
-- Preconditions:
-- None
-- Postconditions:
-- P.1 - Directory is changed.
-- Exceptions:
-- Notes:
---------------------------------------------------------------------------
procedure Directory(
Trace_Path : in String );
---------------------------------------------------------------------------
-- Description:
-- Set the global trace level.
-- Preconditions:
-- None
-- Postconditions:
-- P.1 - All entries written via LOG with a trace level higher then
-- the trace level given here is written into the trace.
-- Exceptions:
-- Notes:
---------------------------------------------------------------------------
procedure Trace_Level(
Level : in Level_Type );
---------------------------------------------------------------------------
-- Description:
-- Stop the current trace.
-- Preconditions:
-- None
-- Postconditions:
-- P.1 - The current trace file is closed and no records are written
-- into the trace file.
-- Exceptions:
-- Notes:
---------------------------------------------------------------------------
procedure Stop_Trace;
---------------------------------------------------------------------------
-- Description:
-- Flush the trace
-- Preconditions:
-- None
-- Postconditions:
-- P.1 - All records are flushed from the write buffer into the file.
-- Exceptions:
-- Notes:
-- This method should be used for example in the context of exception
-- handlers in order to avoid that trace records are getting lost.
---------------------------------------------------------------------------
procedure Flush;
end Util.Trace;
-- ------------------------------------------------------------------------- --
-- --
-- Filename : $Source: /cvsroot/gnade/gnade/Makefile
-- Description : Trace Helper package --
-- Author : Michael Erdmann <[EMAIL PROTECTED]> --
-- Created On : 30-April-2005 --
-- Last Modified By: $Author: merdmann $ --
-- Last Modified On: $Date: 2005/09/25 19:20:11 $ --
-- Status : $State: Exp $ --
-- --
-- Copyright (C) 2005 Michael Erdmann --
-- --
-- SDB is copyrighted by the persons and institutions enumerated in the --
-- AUTHORS file. This file is located in the root directory of the --
-- SDB distribution. --
-- --
-- SDB is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with SDB; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from --
-- SDB Ada units, or you link SDB Ada units or libraries with other --
-- files to produce an executable, these units or libraries do not by --
-- itself cause the resulting executable to be covered by the GNU --
-- General Public License. This exception does not however invalidate --
-- any other reasons why the executable file might be covered by the --
-- GNU Public License. --
-- --
-- ------------------------------------------------------------------------- --
with Ada.Exceptions; use Ada.Exceptions;
with Util.Trace; use Util.Trace;
generic
Module : String ;
Level : Level_Type := Trace.Flow;
package Util.Trace_Helper is
procedure Enter( S : in String );
procedure Leave( S : in String );
procedure Error( S : in String );
procedure Info( S : in String );
procedure Trace_Exception(
E : in Exception_Occurrence );
---------------------------------------------------------------------------
-- Description:
-- Start a trace session for the current task
-- Preconditions:
-- None
-- Postconditions:
-- P.1 - Tracefile with name of the current thread created
-- Exceptions:
-- Notes:
---------------------------------------------------------------------------
end Util.Trace_Helper;
-------------------------------------------------------------------------------
-- --
-- Filename : $Source: /cvsroot/gnade/adb/util/util-linux.ads,v $
-- Description : Linux Operating System definitions --
-- Author : Michael Erdmann --
-- Created : 31.12.2001 --
-- Last Modified By: $Author: merdmann $
-- Last Modified On: $Date: 2005/11/26 08:51:36 $
-- Status : $State: Exp $
-- --
-- Copyright (C) 2001 Michael Erdmann --
-- --
-- GNADE is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- This software is implemented to work with GNAT, the GNU Ada compiler. --
-- --
-- Functional Description --
-- ====================== --
-- This package contains all defintions needed for the linux operating --
-- system. This may have to be adopted for other environments. --
-- --
-- Restrictions --
-- ============ --
-- Only Linux --
-- --
-- Contact --
-- ======= --
-- Error reports and suggestions shall be send to the Address: --
-- [EMAIL PROTECTED] --
-- --
-- General Informations will be found at: --
-- purl:/net/michael.erdmann --
-- --
-------------------------------------------------------------------------------
with System; use System;
with Interfaces.C; use Interfaces.C;
use Interfaces;
package Util.Linux is
IPC_CREAT : constant C.Int := 8#1000#;
IPC_EXCL : constant C.Int := 8#2000#;
IPC_NOWAIT : constant C.Int := 8#4000#;
O_RDONLY : constant C.Int := 0;
O_WRONLY : constant C.Int := 1;
O_RDWR : constant C.Int := 2;
IPC_RMID : constant C.Int := 0;
IPC_SET : constant C.Int := 1;
IPC_STAT : constant C.Int := 2;
IPC_INFO : constant C.Int := 3;
EEXIST : constant C.Int := 17;
SHM_Permissions: constant C.Int := 8#0777#;
MSG_Permissions: constant C.Int := 8#0777#;
Plattform_Error : exception ;
Out_Of_Memory : exception ;
Bad_Shm_Key : exception ;
subtype SHM_Key is Natural;
end Util.Linux;
-- ------------------------------------------------------------------------- --
-- --
-- Filename : $Source: /cvsroot/gnade/gnade/Makefile
-- Description : Util base package --
-- Author : Michael Erdmann <[EMAIL PROTECTED]> --
-- Created On : 30-April-2005 --
-- Last Modified By: $Author: merdmann $ --
-- Last Modified On: $Date: 2005/09/25 19:20:11 $ --
-- Status : $State: Exp $ --
-- --
-- Copyright (C) 2005 Michael Erdmann --
-- --
-- SDB is copyrighted by the persons and institutions enumerated in the --
-- AUTHORS file. This file is located in the root directory of the --
-- SDB distribution. --
-- --
-- SDB is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with SDB; see file COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from --
-- SDB Ada units, or you link SDB Ada units or libraries with other --
-- files to produce an executable, these units or libraries do not by --
-- itself cause the resulting executable to be covered by the GNU --
-- General Public License. This exception does not however invalidate --
-- any other reasons why the executable file might be covered by the --
-- GNU Public License. --
-- --
-- ------------------------------------------------------------------------- --
with Util.Trace; use Util.Trace;
package body Util.Trace_Helper is
Version : constant String :=
"$Id: util-trace_helper.adb,v 1.3 2005/09/25 19:20:11 merdmann Exp $";
procedure Enter( S : in String ) is
begin
LOG( Level, Module & "." & S );
end Enter;
procedure Leave( S : in String ) is
begin
LOG( Level, Module & "." & S & " finished" );
end Leave;
procedure Error( S : in String ) is
begin
LOG( Trace.Flow, Module & "." & S & " *** Error ***" );
end Error;
procedure Info( S : in String ) is
begin
LOG( Level, " " & S );
end Info;
----------------------
-- Report_Excpetion --
----------------------
procedure Trace_Exception(
E : in Exception_Occurrence ) is
begin
LOG( Trace.Flow, "Exception *** " & Exception_Name( E ) & ":" &
Exception_Message( E ) );
Trace.Flush;
Reraise_Occurrence( E );
end Trace_Exception;
end Util.Trace_Helper;
