16 Advanced Linux Programming

 

  <--Last Chapter Table of Contents Next Chapter-->  

 

16.1 Writing Your Own Bindings

 
Ada Package Description C Equivalent
pragma import Import identifier from another language  extern?
pragma export Export identifier to another language  extern?
pragma import_function Like import but extra options
pragma import_procedure Like import but extra options
pragma import_valued_procedure Import a function that returns values as parameters  extern?
pragma export_function Like export but extra options
pragma export_procedure Like export but extra options
Because gnat is tightly integrated with gcc we can make certain assumptions that would otherwise be impossible.

There are rare cases when these assumptions don't hold (e.g. certain cases when null pointer parameters are not allowed by Ada) but generally speaking these assumptions are valid under Linux. Gnat has general purpose interfacing pragmas and support for C types in the Interfaces.C package. Use these if you want maximum portability.

Because of these assumptions most C library calls are easily represented in Ada. For example we check the man page for gettime and discover it returns the current time as a long integer. To call this from Ada we use

  function gettime return long_integer;
  pragma Import( C gettime );  

Since there is no Ada body for the gettime function we use pragma import to let gnat know gettime is a C function. When we link we need to specify the C library that function is in. In the case for the GNU C library this is unnecessary since it's automatically linked. We can now call the C function gettime as if we wrote it ourselves.In C it's possible to call a function and discard the result by not assigning it to anything. You can call C functions from Ada this way by declaring them a procedure. For example:

  procedure gettime;
  pragma Import( C gettime );  

In this case it's not particularly useful to call gettime and throw away the time it gives you. In general you should avoid discarding the result because you may find it useful at some time in the future. However there are certain C function where the result is provided only for flexibility such as functions that return a pointer in a parameter and return the same pointer as the function result as well. These can safely be discarded by treating the function as a procedure.If we wanted to export an integer variable called TotalTimeEstimate to C we'd use

  TotalTimeEstimate : integer;
  pragma Export( C TotalTimeEstimate );  

A C function that returns void corresponds to an Ada procedure.

When importing or exporting to C gnat converts the variable to lower case because C is a case-sensitive language. TotalTimeEstimate would be called totaltimeestimate in a C program. You can override this by providing a specific C name to link to. For example

  pragma Export( C TotalTimeEstimate TotalTimeEstimate );  

Import and Export don't require the name be the same at all. However using entirely different names in C and Ada will make your program hard to understand.

If you want to import functions from libraries other than the standard C library you will have to explicitly link them in. For example to use the C math library libm.a would have to be explicitly linked using -lm. In C functions can have parameters that change value while in Ada this kind of function is not allowed because functions can only have "in" parameters. To get around this problem gnat defines an import_valued_procedure pragma. Suppose you have a C function like this:

  int SomeCFunction( char * param )  

Normally there is no way to represent this kind of function in an Ada program. However we can import it by treating it as a procedure using the import_valued_procedure pragma:

procedure SomeCFunction ( result : out integer; param : in out integer );
pragma import( C SomeCFunction);
pragma import_valued_procedure( SomeCFunction );  

The import_valued_procedure pragma tells gnat that this procedure corresponds to a C function: the first parameter is the result of the C function and the remaining parameters correspond to the parameters of the C function. The first import pragma is not strictly required but ACT recommends using it.

You can't import identifiers created by the #define statement since they only exist before a C program is compiled. You also can't import types (except for C++ classes) since types have no address in memory. [KB-true?]

There is one case where these tricks fail: when the C function returns a pointer to a C variable that it declared. In this case the function is returning a new C pointer. Luckily Ada provides a package called Address_To_Access_Conversions to convert between C pointers and Ada access types. You instantiate the package with the type you want to convert between and the package creates an access type that can be converted to and from an address (which is a C pointer).The following program demonstrates conversions to and from C pointer types.

with Ada.Text_IO
System.Address_To_Access_Conversions;
use Ada.Text_IO;
procedure pointers is

package IntPtrs is
  new System.Address_To_Access_Conversions( integer );
  -- Instantiate a package to convert access types to/from addresses.
  -- This creates an integer access type called Object_Pointer.

  five : aliased integer := 5;
  -- Five is aliased because we will be using access types on it

  int_pointer : IntPtrs.Object_Pointer;
  -- This is an Ada access all type

  int_address : System.Address;
  -- This is an address in memory
a C pointer

begin
  int_pointer := five'unchecked_access;
  -- Unchecked_access needed because five is local to main program.
  -- If it was global
we could use 'access.

  int_address := five'address;
  -- Addresses can be found with the 'address attribute.
  -- This is the equivalent of a C pointer.

  int_pointer := IntPtrs.To_Pointer( int_address );
  int_address := IntPtrs.To_Address( int_pointer);
  -- Convert between Ada and C pointer types.

end pointers;

For example the standard C library function get_current_dir_name returns a pointer to a C string which it declares. To use get_current_dir_name we have to instantiate Address_To_Access_Conversions for an array of characters (a C string) and convert the address to an access type using something like

   CharArray_pointer := CharArrayPtrs.To_Pointer( get_current_dir_name );

There is no other way in Ada to access the array that get_current_dir_name points to.

KB-If your main program is a C program you need to call adainit before any Ada code.

16.2 Linux Errors and Errno

Most standard C library errors are returned in an integer variable called "errno". You can examine errno in your Ada programs by importing it.

  errno : integer;
  pragma import( C errno);
 

Errno contains a number for the error returned by the last library function.

 
NoteIn Multithreading programs be aware errno may not be not "thread safe" because it can be shared between threads. [KB: document how to do it with threads]

Linux provides two functions for working with errno error numbers.

type string255is new string(1..255);
type strptr is access string255;
-- error messages are no longer than 255 characters
procedure perror( message : string);
pragma import( C perror );

Perror prints a standard error description with a leading message to standard error.
 
function strerror( error_number : integer ) return strptr;
pragma import( C strerror);

Retuns a C string standard error description.

The following example program makes a deliberate error with the link function and prints the error message using perror and stderror.

with ada.text_io
ada.strings.fixed;
use ada.text_io
ada.strings.fixed;
procedure perr is
-- an example of perror and strerror error messages

  procedure perror( message : string );
  pragma import( C
perror );
  -- print a standard error description with a leading message

  type string255 is new string(1..255);
  type strptr is access string255;
  -- error messages are no longer than 255 characters

  function strerror( error_number : integer )  return strptr;
  pragma import( C
strerror);
  -- get a standard error description

  errno : integer;
  pragma import( C
errno );
  -- last error number

  function link( path1
path2 : string ) return integer;
  pragma import( C
link);
  -- we'll use the link function to create an error

  LinkResult      : integer; -- value returned by link
  ErrorMessagePtr : strptr;  -- pointer to stderror message
  NullLocation    : integer; -- location of NUL in stderror message

begin

  Put_Line( "This is an example of perror and strerror");
  New_Line;

  -- make a deliberate error and print it with perror

  Put_Line( "Trying to link a non-existent file to itself.." );
  LinkResult := Link( "blahblah"
blahblah
);
  if LinkResult = -1 then
    perror( "Link failed" );
  end if;
  New_Line;

  -- Retrieve the last error message with strerror.
  -- Because strerror returns a C string
only print the
  -- string up to the first NUL character.

  ErrorMessagePtr := StrError( Errno );
  NullLocation := Index( string( ErrorMessagePtr.all )

& ASCII.NUL );
  Put( "The last error message was '" );
  Put( Head( string( ErrorMessagePtr.all )
NullLocation-1 ) );
  Put_Line( "'." );

end perr;

This is an example of perror and strerror
Trying to link a non-existent file to itself.
Link failed: No such file or directory
The last error message was 'No such file or directory'.

A table of error numbers is in the appendix.


 

16.3 The Linux Clock

The Ada.Calendar package is the standard method of working with time in Ada programs. If you need to interface with C programs you may need to use Linux's time features.

The Linux clock functions are either kernel calls or are a part of the standard C library and they don't need to be linked in with the -lc option.

16.3.1 Basic time functions

The basic Linux time functions work with the number of seconds since January 1 1970. This is referred to as the epoch in the Linux man pages. Because of the limits of a long integer value the Linux clock will stop working properly around the year 2038.

The basic functions use a long_integer for the time:

type time_t is new long_integer;
procedure time ( time : in out time_t);
pragma import( C time );
Returns the current time.

function difftime( time1 time2 : time_t ) return long_float;
pragma import( C difftime );
Returns the number of seconds between two times (as a long_float).

 

16.3.2 Timeval Calls - Microsecond Accuracy

The timeval kernel calls return (or set) the current time with microsecond accuracy using a timeval record.

type timeval is record
  tv_sec  : time_t; -- number of seconds (since epoch)
  tv_usec : long_integer; -- number of microseconds
end record;

type timezone is record
  tz_minuteswest : integer; -- minutes west of Greenwich
  tz_dsttime     : integer  -- unsupported in Linux
end record;

procedure gettimeofday( result : out integer; tv : in out timeval tz : in out timezone );
pragma import(C gettimeofday );
pragma import_valued_procedure( gettimeofday );
Get the current time as the number of microseconds since January 1 1970.  Returns 0 for success.  ftime() is an obsolete version of this function

procedure settimeofday( result : out integer; tv : in out timeval; tz : in out timezone );
pragma import( C settimeofday );
pragma import_valued_procedure( settimeofday );
Set the current time as the number of microseconds since January 1 1970.  Returns 0 for success.

procedure tzset;
pragma import( C tzset );
Create the TZ environment variable if it doesn't exist and sets it to the current timezone as specified in /etc/localtime or /usr/lib/zoneinfo/localtime.  This is automatically invoked by the standard C library time functions whenever necessary.

procedure adjtimex( result : out integer; buf : inout timex );
pragma import( C adjtimex );
Tunes the kernel's clock for specific time parameters


 

16.3.3 Functions using the tm record

Besides the number of seconds elapsed since 1970 Linux can also work with records containing the time broken down into common measurements. These functions use a tm record. These functions are all a part of the standard C library.

type tm is record
   sec   : integer; -- seconds on the clock (0-59)
   min   : integer; -- minutes on the clock (0-59)
   hour  : integer; -- hour on the clock (0-23)
   mday  : integer; -- day of the month (1-31)
   mon   : integer; -- month (0-11)
   year  : integer; -- year
   wday  : integer; -- day of the week (0-6)
   yday  : integer; -- day of the year (0-365)
   isdst : integer; -- >0 is daylight savings time
0=not
<0 unknown
end record;

You will also need the Address_To_Access_Conversions package to convert C pointers to tm record into Ada access type pointers.

package TmPtrs is
  new System.Address_To_Access_Conversions( tm );
function localtime( time : in out time_t ) return system.address;
pragma import( C localtime );
Change the time into a tm record making changes for the current time zone. time is the C pointer to the seconds since 1970.
 
function gmtime( time : in out time_t ) return system.address;
pragma import( C gmtime );
Change the time into a tm record for UTC (Coordinated Universal Time). time is the C pointer to the seconds since 1970.
 
function mktime( tm : system.address ) return time_t;
pragma import( C mktime );
Convert a tm record into the seconds since 1970.
 

To get the current time in tm format

  seconds_since_1970 : long_integer;
  tm_rec : tm;
  ...
  time( seconds_since_1970 );
  tm = TmPtrs.To_Pointer( localtime( seconds_since_1970'address ) ).all;

 

16.3.4 Time as a String

function asctime( tm : system.address ) return string;
pragma import( C asctime );
Convert the tm into a standard UNIX time C string such as you see with the ls -l shell command.
 
function ctime( time : in out time_t) return long_integer;
pragma import( C ctime );
Get the current time as a standard UNIX time C string. It's equivalent to using asctime() on the localtime() of the current time().
 

procedure strftime( result: size_t; datestr : in out stringtype; max : size_t; format : string; tm : in out tmrec );
pragma import( C strftime );
Like asctime() converts a tm time into text.  strftime() uses formatting codes to determine the appearance of the text similar to the shell date command.  Returns the length of the date string (including the ending ASCII.NUL). See the man page for complete details.

Example:
datestring : string(1..80);
...
statftime( datestringsize datestring datestring'size/8 %I:%M & ASCII.NUL tm );
Ada.Text_IO.Put_Line( "The time is " & datestring( 1..datestringsize-1 ) );
 

16.3.5 Timer Functions

Timer functions use the timeval structure

function timerclear( tv : timeval );
function timerisset( tv : timeval );
function timercmp( t0
t1 : timeval; operator : ? );
 

16.4 Process Information

The Linux process functions are part of the standard C library and do not need to be linked in with -lc.

function getpid return integer;
Returns the Process Identification Number (PID) for your program.
 

16.4.1 Ownership

The owner of a program is referred to as the UID (user identification number). Under Linux there are actually three owners to any given program: the effective UID the real UID and the saved UID. Normally these three are all the same login. The real and saved uids are provided for programs that must temporarily pretend to be somebody else like a daemon that needs special login for a short period of time or setuid/setgid programs that must temporarily switch between owners. These special functions are not covered here.

function getuid return integer;
pragma import( C getuid );
Get the (real) UID of a process.
Example: Put_Line( "My UID is " & getuid'img );
 
function setuid (uid : integer ) return integer;
pragma import( C setuid );
Change the effective (and saved and real) UID of a process to a new owner.
 

The GID (group identification number) is the group the program belongs to. In Linux there's a main effective group number and any number of secondary groups that a program can belong to. There is also real and saved GIDs just like UIDs.

procedure getgroups( result : out integer; num : integer; gidlist );
pragma import( C getgroups);
pragma import_valued_procedure( getgroups );
Return a list of group numbers that a process belongs to. Gidlist is the address of a list of C strings.
 
function getgid return integer;
pragma import( C getgid );
Get the (real) UID of the process.
Example: Put_Line( "My GID is " & getgid'img );
 
function setguid( gid : integer ) return integer;
pragma import( C setgid );
Change the effective GID (and saved and real) of a process to a new group.
 

Linux also allows you to arrange processes into groups for easier management of multiple processes at once. Each process group as a no surprise a process group identification number (PGID).

function setpgid( pid pgid : integer ) return integer;
pragma import( C setpgid );
Place a process into a new process group. PID 0 is the current process. PGID 0 creates a new process group.
 
function getpgid( pid : intger ) return integer;
pragma import( C getpgid );
Example: Put_Line( "My PGID is " & getpgid'img );
Returns the process group number for a process. PID 0 is the current process.
 

Every program and process group also belongs to a session (as in a login session). When you log off the computer Linux automatically stops all programs that were running in your session. The session leader is the top process in a session such as your login shell. However if you want to create a new session for some reason you can use the following function:

function setsid return integer;
pragma import( C setsid );
Start a new session and return a new session identification number (SID).
Example: NewSID := etsid;
 
16.4.2 Other Functions
 
function kill( uid signal : integer ) return integer;
pragma import( C kill );
Stop a child process that your process has started the same as using the kill command at the shell prompt. (More accuately send a signal to a child process—some signals won't stop the child process.)
Example: Result := kill( MyRunawayChildUID 15 ); -- send SIGTERM (terminate) signal

Signal handling in general is easier through Ada.Interrupts than through Linux kernel calls because of their heavy reliance on C macros.--KB

function alarm( seconds : Interfaces.C.unsigned ) return Interfaces.C.unsigned;
pragma import( C alarm );

After the specified number of seconds cause a SIGALRM interrupt in the current process.
 

16.5 Environment Variables

Environment variables can easily be set and read with Ada.Command_Line.Environment package. You can also set them directly through the standard C library.

function putenv( str : string ) return integer;
pragma import( C putenv );
Define a Linux environment variable. putenv literally saves a pointer to the string; therefore the string must be global (or a literal).
Example: Result := putenv( "TERM=vt102" & ASCII.NUL );
 
function getenv( str : string ) return string;
pragma import( C putenv );
Read the value of an environment value. Remember the string returned is a C string with an ending ASCII.NUL.
 

16.6 Multitasking

Multitasking creates child processes to do tasks for your main program. On multiprocessor machines different processes can be assigned to different processors allowing work to be done simultaneously. On single processor machines the processor switches several times a second between processes and does a little work on each.

The function to create a new child process is called fork. When Linux creates a new process it doesn't start by creating a blank process. Instead it makes a copy of the original process so there are effectively two copies of your program running. The fork function returns a value to tells your program if it is the original program or the new copy.

If you want to run a different program you'll have to use one of the exec family of functions to load and run the new program. The exec functions destroy the old program and run a new program in its place. The above section Using System and OSLib.Spawn has an example C function called CrunIt that uses fork to start a new process and run a new program.

type pid_t is new integer;
function fork return pid_t;
pragma import( C fork );
Create a new child process identical to the original process and return 0 if the program is running as the child process or the PID of the parent if the program is running as the original parent process.
Example: myPID := fork;
 
procedure wait( pid : out pid_t; status : in out integer );
pragma import( C wait);
pragma import_valued_procedure( wait );
Wait until a child process have finished running. Pid is the PID of the child. status is an integer code indicating whether the child finished normally and if it was stopped by a signal which signal terminated the program. Status can be a null pointer if you don't want status information.
Example: wait( wait_pid wait_status );
 
procedure waitpid( pid : out pid_t pid_or_gid : in out pid_t; status : in out integer; options : integer );

pragma import( C waitpid);
pragma import_valued_procedure( waitpid);
Wait for a specific child. If pid_or_gid is less than -1 waitpid waits for any child in the specified group id. If pid_or_gid is -1 it waits for any child (the same as wait). If pid_or_gid is 0 it waits for any child in the same group id as the parent. If pid_or_gid is greater than zero waits for the child with the specified pid. Status can be a null pointer if you don't want status information. Options can determine whether waitpid returns immediately or blocks indefintely.
Example: waitpid( child_pid -children_gid wait_status 0 );
 

Wait3 and Wait4 are BSD UNIX variations which perform the same functions as wait and waitpid but with slightly different parameters.

When multitasking if a child process stops it's retained in memory so that the parent can use wait to find out the reason it stopped running. These children are called "zombies". If the parent process doesn't use wait the zombies will remain indefinitely using up system resources. For any large multitasking program make sure you handle SIGCHLD signals: these are created when a child stops running. The SIGCHLD handler only needs to call wait and Linux will then remove the child process from memory.

The following is a simple multitasking example that multitasks two Put_Line statements.

-- a simple example of multitasking that multitasks
-- two put_line statements

with ada.text_io;
use ada.text_io;
procedure multitask  is
type pid_t is new integer;

  function fork return pid_t;
  pragma import( C
fork);
  -- create a new process

  errno : integer;
  pragma import( C
errno);
  -- the last error code

  procedure wait( pid : out pid_t; status : in out integer);
  pragma import( C
wait);
  pragma import_valued_procedure( wait);
  -- wait until all child processes are finished

  myPID : pid_t;
  wait_pid : pid_t;
  wait_status : integer;

begin

  Put_Line( "Welcome to this multitasking example" );
  Put_Line( "This is the original process." );
  New_Line;

  -- the fork function duplicates this program into
  -- two identical processes.

  Put_Line( "Splitting into two identical processes..." );
  Put_Line( "-----------------------------------------" );
  myPID := fork; -- split in two!

  -- This program is now the original process or the
  -- new child process. myPID tells you which process
  -- you are.

  if myPID < 0 then
    Put_Line( Standard_Error
Fork has failed.  Error code
& errno'img );
  elsif myPID = 0 then
    Put_Line( "This is the child process" );
  else
    Put_Line( "This is the original process." );
    -- wait until child is finished
    wait( wait_pid
wait_status);
    if wait_pid < 0  then
      Put_Line( Standard_Error
Wait error: wait returned PID
& wait_pid'img
        & " and error number " & errno'img);
    end if;
  end if;

end multitask;

Welcome to this multitasking example
This is the original process.
Splitting into two identical processes...
-----------------------------------------
This is the original process.
This is the child process
 

16.7 Linux File Operations

The Linux file operations are part of the standard C library and don't need to be linked in with the -lc option. The C calls are defined in the "fcntl.h" header file.

[Explain Linux files here]

 
NoteLinux never shortens files. If your file gets smaller you must shorten it yourself using truncate.
 

The following bindings assume these types have been defined.

type file_id is new integer;
-- file ID number are discussed below

type mode_t is new integer;
type gid_t is new integer;
type uid_t is new integer;
type size_t is new long_integer;
function unlink( pathname : string ) return integer;
pragma import( C unlink );
Delete a file.
Example: Result := unlink( "/tmp/temp.txt" & ASCII.NUL );
 
function link( oldpath newpath : string) return integer;
pragma import( C link );
Make a shortcut (hard link) to a file.
Example: Result := link( "/tmp/temp.txt" & ASCII.NUL /tmp/newtemp.txt & ASCII.NUL );
 
procedure getcwd( buf1 : out StringPtr; buf2 : in out stringptr; size : integer );
pragma import( C getcwd );
pragma import_valued_procedure( getcwd)
Return the current working directory.
 
function mkdir( pathname : stringPtr; mode : mode_t ) return integer;
pragma import( C mkdir );
Create a new directory and set default permissions.
 
function rmdir( pathname : string ) return integer;
pragma import( C rmdir );
Delete a directory.
Example: Result := rmdir( "/tmp/tempdir" & ASCII.NUL );
 
function umask( mask : integer ) return integer;
pragma import( c umask );
Sets the default file permissions.
 
function stat( filename : stringPtr; buf : stat_struct ) return integer;
pragma import( C stat );
Get information about a file such as size and when it was last opened.
 
function lstat( filename : stringPtr; buf : stat_struct ) return integer
pragma import( C lstat );
Same as stat function but doesn't follow symbolic links.
 
function tmpnam( s : stringPtr ) return stringPtr;
pragma import( C tmpnam );
Create a random name for a temporary file.
 
function chown( path : string; owner : uid_t; group : gid_t) return integer;
pragma import( C chown );
function fchown( file : file_id; owner : uid_t; group : gid_t return integer;
pragma import( C fchown );
Change the ownership of a file to the specified owner and group.
Example: Result := chown( "root.txt" & ASCII.NUL 0 0 );
 
function chmod( path : string; mode : mode_t ) return integer;
pragma import( C chmod );
function fchmod( file : file_id; mode : mode_t ) return integer;
pragma import( C fchmod );
Change the read/write/execute permissions on a file.
Example: Result := chmod( "secure.txt" & ASCII.NUL #8#640 );

Other low-level file operations are all done with the fcntl (file control) function. There are three variations to fcntl: it may have an operation code an operation code and a long integer argument or an operation code and a locking record argument.

The operation numbers are defined in /usr/src/linux/asm-i386/fnctl.h:

F_DUPFD  : constant integer :=  0;
F_GETFD  : constant integer :=  1;
F_SETFD  : constant integer :=  2;
F_GETFL  : constant integer :=  3;
F_SETFL  : constant integer :=  4;
F_GETLK  : constant integer :=  5;
F_SETLK  : constant integer :=  6;
F_SETLKW : constant integer :=  7;
F_SETOWN : constant integer :=  8;
F_GETOWN : constant integer :=  9;
F_SETSIG : constant integer := 10;
F_GETSIG : constant integer := 11;
function fcntl( fd : file_id; operation => F_DUPFD )
pragma import( C fcntl );
Duplicates a file descriptor (same as dup2 but different errors returned). New descriptor shares everything except close-on-exec. New descriptor is returned.
 
function fcntl( fd : file_id; operation => F_GETFD )
pragma import( C fcntl );
Get close-on-exec flag; low bit is zero file will close on exec kernel call.
 
function fcntl( fd : file_id; operation => F_SETFD; arg : long_integer )
pragma import( C fcntl );
Set the close-on-exec flag; low bit is 1 to make file close on exec kernel call.
 
function fcntl( fd : file_id; operation => F_GETFL )
pragma import( C fcntl );
Get flags used on open kernel call used to open the file
 
function fcntl( fd : file_id; operation => F_SETFL; arg : long_integer )
pragma import( C fcntl );
Set flags for open kernel call. Only async nonblock and appending can be changed.
 
procedure fcntl( result : out integer; fd : file_id; operation => F_GETLK; lock : in out lockstruct )
return integer
pragma import( C fcntl );
pragma import_valued_procedure( fcntl );
Return a copy of the lock that prevents the program from accessing the file or else if there is nothing blocking the type of lock
 
procedure fcntl( result : out integer; fd : file_id; operation => F_SETLK; lock : in out lockstruct )
return integer
pragma import( C fcntl );
pragma import_valued_procedure( fcntl );
Place a lock on the file. If someone else has locked the file already -1 is returned and errno contains the locking error.
 
procedure fcntl( result : out integer; fd : file_id; operation => F_SETLKW; lock : in out lockstruct )
return integer
pragma import( C fcntl );
pragma import_valued_procedure( fcntl );
Place a read or write lock on the file or to unlock it. If someone else has locked the file already wait until the lock can be placed.
 

Additional information about locks are found in /usr/src/linux/Documentation/locks.txt

type aLock is new short_integer;
F_RDLCK : constant aLock := 0; -- read lock
F_WRLCK : constant aLock := 1; -- write lock
F_UNLCK : constant aLock := 2; -- unlock (remove a lock)
F_EXLCK : constant aLock := 3; -- exclusive lock
F_SHLCK : constant aLock := 4; -- shared lock

type aWhenceMode is new short_integer;
SEEK_SET : constant aWhenceMode := 0; -- absolute position
SEEK_CUR : constant aWhenceMode := 1; -- offset from current position
SEEK_END : constant aWhenceMode := 2; -- offset from end of file
type lockstruct is record
  l_type   : aLock;         -- type of lock
  l_whence : short_integer; -- how to interpret l_start
  l_start  : integer;       -- offset or position
  l_len    : integer;       -- number of bytes to lock (0 for all)
  l_pid    : integer;       -- with GETLK
process ID owning lock
end record;

To lock a file create a lockstruct record and fill in the details about the kind of lock you want.

A read lock (F_RDLCK) makes the part of the file you specify read-only. No one can write to that part of the file.

A write lock prevents any other program from reading or writing to the part of the file you specify. Your program may change that part of the file without being concerned that another process will try to read it before you're finished.

If your program stops prematurely the locks will be released.

Example: Get exclusive right to write to the file waiting until it's possible:

  -- lock file
  myLockStruct : lockStruct;
  result : integer;
  ...
  myLockStruct.l_type := F_WRLCK;
  myLockStruct.l_whence := 0;
  myLockStruct.l_start := 0;
  myLockStruct.l_end := 0;
  fcntl( result
fd
F_SETLKW
myLockStruct );
  if result = -1 then
     put_line( standard_error
fcntl failed
);
  end if;
  -- file is now locked
  ...
  -- unlock file
  myLockStruct.l_type := F_UNLCK;
  myLockStruct.l_whence := 0;
  fcntl( result
fd
F_SETLKW
myLockStruct );
  if result = -1 then
     put_line( standard_error
fcntl failed
);
  end if;

[Double check off_t size for l_start l_len--KB]

function fcntl( fd : file_id; operation => F_GETOWN )
pragma import( C fcntl );
Get the process (or process group) id of owner of file. The owner is the process that handles SIGIO and SIGURG signals for that file.
 
function fcntl( fd : file_id; operation => F_SETOWN arg : long_integer )
pragma import( C fcntl );
Set the process (or process group) id of owner of file. The owner is the process that handles SIGIO and SIGURG signals for that file. This affects async files and sockets.
 
function fcntl( fd : file_id; operation => F_GETSIG )
pragma import( C fcntl );
Get the signal number of the signal sent when input or output becomes possible on a file (usually SIGIO or zero). (This is a Linux-specific function.)
 
function fcntl( fd : file_id; operation => F_SETSIG arg : long_integer )
pragma import( C fcntl );
Set the signal number of the signal sent when input or output becomes possible on a file (zero being the default SIGIO). Use this to set up a signal handler alternative to the kernel calls select and poll. See the man page for more information. (This is a Linux-specifc function.)
 

 

16.8 Opening and Closing Files

The standard Ada packages Text_IO Sequential_IO and Direct_IO are suitable for simple projects but they were never intended as a complete solution for large-scale applications. If you want to do efficient file manipulation you'll have to write your own routines based on kernel calls or the standard C library.

gnat's OSLIB package contains low-level commands to work with UNIX files. However you can always create your own.

The following bindings assume these types have been defined.

type file_id is new integer;
type mode_t is new integer;
type off_t is new long_integer;
type size_t is new long_integer;
subype ssize_t is size_t;
 
function open( path : string; flags : integer; mode : mode_t ) return file_id;
pragma import( c open );
Open a file and return and file identification number. flags indicates how the file should be opened and what kind of access the file should allow (defined in /usr/include/fcntlbits.h). Mode defines the access permissions you want on the file.
 
The flags are a set of bits with different meanings:
O_RDONLY   : constant integer :=      8#00#; -- open for reading only
O_WRONLY   : constant integer :=      8#01#; -- open for writing only
O_RDWR     : constant integer :=      8#02#; -- open for reading and writing
O_CREAT    : constant integer :=    8#0100#; -- no file? create it
O_EXCL     : constant integer :=    8#0200#; -- lock file (see below)
O_NOCTTY   : constant integer :=    8#0400#; -- if tty
don't acquire it
O_TRUNC    : constant integer :=   8#01000#; -- file exists? truncate it
O_APPEND   : constant integer :=   8#02000#; -- file exists? move to end
O_NONBLOCK : constant integer :=   8#04000#; -- if pipe
don't wait for data
O_SYNC     : constant integer :=  8#010000#; -- don't cache writes
O_ASYNC    : constant integer :=  8#020000#; -- async. IO via SIGIO
O_DIRECT   : constant integer :=  8#040000#; -- direct disk access
O_LARGEFILE: constant integer := 8#0100000#; -- not implemented in Linux (yet)
O_DIRECTORY: constant integer := 8#0200000#; -- error if file isn't a dir
O_NOFOLLOW : constant integer := 8#0400000#; -- if sym link
open link itself
Flags may be added together.
O_EXCL is somewhat obsolete and has limitations on certain file systems. Use fcntl to lock files instead.
O_SYNC only works on the ext2 file system or on block devices.
 
function creat( path : string mode : mode_t ) return file_id;
pragma import( c creat );
Creat is a short form for open( path create + writeonly + truncate mode )
 
function close( file : file_id ) return integer;
pragma import( C close );
Closes a file.
 
function truncate( path : string; length : size_t ) return integer;
pragma import( C truncate );
function ftruncate( file : file_id; length : size_t ) return integer;
pragma import( C ftruncate);
Shorten a file to a specific length. Despite its name ftruncate is a kernel call not a standard C library call like fopen.
 
function read( file : file_id; b : in out buffer; length : size_t ) return ssize_t;
pragma import( C read );
Read bytes from the specified file into a buffer. Buffer is any type of destination for the bytes read with length being the size of the buffer in bytes. The number of bytes read is returned or -1 on an error.
 
function write( file : file_id; b : in out buffer; length : size_t ) return ssize_t;
pragma import( C write );
Write bytes from a buffer into the specified file. Buffer is any type of destination for the bytes read with length being the size of the buffer in bytes. The number of bytes written is returned or -1 on an error.
 
function lseek( file : file_id; offset : off_t; whence : integer ) return integer;
pragma import( C lseek );
Move to a particular position in the specified file. Whence is a code representing where your starting position is. Offset is how many bytes to move.
 
There are three possible "whence" values:
SEEK_SET : constant integer := 0; -- from start of file
SEEK_CUR : constant integer := 1; -- offset from current position
SEEK_END : constant integer := 2; -- from end of file

File input/output is naturally suited to generic packages. You can use the generic package to hide the low-level details of the standard C library. In following example SeqIO is a generic package for reading and writing a sequential file of some type using the kernel calls mentioned above.

-- SeqIO
--
-- A simple sequential IO package using standard C functions

generic
  type AFileElement is private;

package SeqIO is

  type AFileID is new short_integer;
  seqio_error : exception;

  function Open( path : string; read : boolean := true ) return AFileID;
  -- open a new file for read or write

  procedure Close( fid : AFileID );
  -- close a file

  procedure Read( fid : AFileID; data : in out AFileElement);
  -- read one data item from the file. seqio_error is raised
  -- if the data couldn't be read

  procedure Write( fid : AFileID; data : AFileElement );
  -- write one data item to the file.  seqio_error is raised
  -- if the data couldn't be written

end SeqIO;

package body SeqIO is
pragma optimize( space);

  -- Import C file handling functions
  type mode_t is new integer; -- C mode_t type
  type size_t is new integer; -- C size_t type
  subtype ssize_t  is size_t; -- C ssize_t type

  -- The C file functions we'll be using
  -- (denoted with a C_ prefix for clarity )

  function C_Open( path : string; flags : integer; mode : mode_t)
    return AFileID;
  pragma import( C
C_Open
open
);

  function C_Close( file : AFileID )  return integer;
  pragma import( C
C_Close
close
);

  procedure C_Read( size : out ssize_t;
    file : AFileID;
    data : in out AFileElement;
    count: size_t);
  pragma import( C
C_Read
read
);
  pragma import_valued_procedure( C_Read);
  -- Using an "in out" parameter is the easiest way to pass
  -- the address of the data element. Because Ada doesn't
  -- allow in out parameters in functions
we'll use gnat's
  -- valued procedure pragma to pretend read is a procedure

  procedure C_Write( size : out ssize_t;
    file : AFileID;
    data : in out AFileElement;
    count: size_t);
  pragma import( C
C_Write
write
);
  pragma import_valued_procedure( C_Write);
  -- Using an "in out" parameter is the easiest way to pass
  -- the address of the data element. Because Ada doesn't
  -- allow in out parameters in functions
we'll use gnat's
  -- valued procedure pragma to pretend write is a procedure
  -- Our Ada subprograms

function Open( path : string; read : boolean := true ) return AFileID  is
  -- open a new file for read or write
  flags : integer;
begin

  -- the flag values are listed in fcntlbits.h and man 2 open
  if read then
    flags := 0; -- read only
existing file
  else
    flags := 1000 + 100 + 1; -- write only
create or truncate
  end if;
  -- octal 640 => usr=read/write
group=read
others=no access

  return C_Open( path & ASCII.NUL
flags
8#640# );
end Open;

procedure Close( fid : AFileID ) is
  -- close a file
  Result : integer; -- we'll ignore it
begin
  Result := C_Close( fid);
end Close;

procedure Read( fid : AFileID; data : in out AFileElement ) is
  -- read one data item from the file
  BytesRead : ssize_t;
begin
  -- 'size returns the size of the type in bits
so we
  -- divide by 8 for number of bytes to read
  C_Read( BytesRead
fid
data
AFileElement'size / 8 );
  if BytesRead /= AFileElement'size / 8  then
    raise seqio_error;
  end if;
end Read;

procedure Write( fid : AFileID; data : AFileElement ) is
  -- write one data item to the file
  BytesWritten : ssize_t;
  data2write : AFileElement;
begin
  -- can't use data directly because it's an "in" parameter
  data2write := data;
  -- 'size returns the size of the type in bits
so we
  -- divide by 8 for number of bytes to write
  C_Write( BytesWritten
fid
data2write
AFileElement'size / 8);
  if BytesWritten /= AFileElement'size / 8 then
    raise seqio_error;
  end if;
end Write;

end SeqIO;

You can test SeqIO with the following program:

with SeqIO;
with Ada.Text_IO;
use Ada.Text_IO;

procedure SeqIOtest is
-- program to test SeqIO

package IntIO is new SeqIO( integer);
-- IntIO is a SeqIO for integer numbers

  id : IntIO.AFileID;
  int2read : integer;

begin

  Put_Line( "Testing SeqIO package..." );
  New_Line;

  -- Part #1: Write numbers to a file

  Put_Line( "Writing numbers 1 to 10 to a file...");
  id := IntIO.Open( "int_list.txt"
read => false );
  for i in 1..10 loop
    IntIO.Write( id
i)
  end loop;
  IntIO.Close( id);

  -- Part #2: Read the numbers back from the same file

  Put_Line( "Reading numbers back..." );
  id := IntIO.Open( "int_list.txt"
read => true);
  for i in 1..10  loop
    IntIO.Read( id
int2read);
    Put_Line( "Number" & i'img & " =" & int2read'img );
  end loop;
  IntIO.Close( id );

exception when IntIO.seqio_error =>
  Put_Line( "Oh
oh! seqio_error!");
end SeqIOtest;

Note: This should be rewritten because a failure to write all the bytes is not necessarily an error--Linux has a buffer limit on how much it writes at one time--KB


Writing numbers 1 to 10 to a file...
Reading numbers back...
Number 1 = 1
Number 2 = 2
Number 3 = 3
Number 4 = 4
Number 5 = 5
Number 6 = 6
Number 7 = 7
Number 8 = 8
Number 9 = 9
Number 10 = 10
File Multiplexing Operations

These kernel calls help programs that have to monitor several file descriptors at once for activity.

procedure select( result : out integer; topplusone : integer; readset : in out fdset; writeset : in out fd_set; errorset : in out fd_set; timeout : in out timeval );
pragma import( C select );
pragma import_valued_procedure( select );
Select checks one or more file descriptors to see if they are ready for reading writing or if there is an error. It will wait up to timeout microseconds before timing out (0 wll return immediately). topplusone is the numerically highest file descriptor to wait on plue one. The result is 0 for a timeout -1 for failure or the number of file discriptors that are ready and the file discriptor sets indicate which ones.
Unlike most UNIX's Linux leaves the time remaining in the timeout record so that you can use select in a timing loop--to repeatedly select file descriptors until the timeout counts down to zero. Other UNIX's leave the timeout unchanged.
 
type pollfd is record
  fd : integer;
  events : short_integer;
  revents : short_integer;
end record;

Poll Events
POLLIN := 16#1#;
POLLPRI := 16#2#;
POLLOUT := 16#4#;
POLLERR := 16#8#;
POLLHUP := 16#10#;
POLLNVAL := 16#20#;

These are defined in asm/poll.h.

procedure poll( result : out integer; ufds : in out pollfd; nfds : integer; timeout_milliseconds : integer );
pragma import( C poll );
pragma import_valued_procedure( poll );
The name of this kernel call is misleading: poll is a form of select(). timeout_milliseconds is a timeout in milliseconds -1 for no timeout. ufds is an array of pollfd records for files that poll() should monitor. Poll returns the number of pollfd array elements that have something to report 0 in a timeout or -1 for an error. Each bit in events when set indicates a particular event that the program is waiting for. Revents represents the events which occurred.
 

16.9 Directories

Directories are "folders" containing collections of files and other directories. In Linux a directory is a special kind of file. Some of the standard file operations work on directories and some other file operations are specific to directories.

The top-most directory is / or the root directory. All files on a system are located under the root directory. Disk drives do not have separate designations as in MS-DOS.

A period (.) represents the current directory and a double period (..) represents the parent directory of the current directory. All directories have . and .. defined. The root directory of course doesn't have a parent: it's .. entry points to itself.

Many of the kernel calls and standard C library functions dealing with directories use functions that return C pointers. As mentioned in the bindings section the only way to convert these kind of functions to Ada is by declaring the C pointers as a System.Address type and changing the C pointers to Ada access types using the Address_To_Access_Conversions package.

procedure getcwd( buffer : out string; maxsize : size_t );
pragma import( C getcwd );
Returns the name of the current working directory as a C string in buffer. Maxsize is the size of the buffer. All symbolic links are dereferenced.

function get_current_dir_name return System.Address;
pragma import( C get_current_dir_name );
Like getcwd returns the current working directory name as a pointer to a C string. Unlike getcwd symbolic links aren't dereferenced. Use this function to show the current directory to a user.

procedure chdir( path : string);
pragma import( C chdir );
Change the current working directory to the specified path.
Example: chdir( "/home/bob/stuff" & ASCII.NUL );

function mkdir( path : string; mode : size_t ) return integer;
pragma import( C mkdir );
Create a new directory with permission bits as specified by mode.

function rmdir( path : string ) return integer;
pragma import( C rmdir );

Remove a directory.

function opendir( path : string ) return System.Address; pragma import( C opendir);
Open a directory in order to read its contents with readdir.

function closedir( info : System.Address) return integer;
pragma import( C closedir);
Close a directory openned with opendir. Info is the C pointer returned by opendir.

function readdir( info : System.Address ) return DirEntCPtr;
pragma import( C readdir);
Read the next entry in the directory. A null C pointer is returned if there is no more entries. Info is the C pointer returned by opendir.

function rewinddir( info : System.Address ) return integer;
pragma import( C rewinddir);
Begin reading from the top of the directory. Info is the C pointer returned by opendir.

function telldir( info : System.Address) return integer;
pragma import( C telldir);
Mark the current position in the directory to return to it later using the seekdir function. Info is the C pointer returned by opendir.

function seekdir( info : System.Address; position : integer ) return integer;
pragma import( C seekdir );
Return to a position in the directory marked by telldir. Info is the C pointer returned by opendir.

function chroot( newroot : string ) return int;
pragma import( C chroot );
Make Linux think that a different directory is the root directory (for your program). This is used by programs such as FTP servers to prevent uses from trying to access files outside of a designated FTP directory.
Example: Result := chroot( "/home/server/stay-in-this-directory" & ASCII.NUL);

There is also a scandir function that reads a directory and sorts the entries but this is difficult to use directly from Ada.

The following program demonstrates some of the directory subprograms in Linux.

with Ada.Text_IO
Interfaces.C
Ada.Strings.Fixed;
use Ada.Text_IO
Interfaces.C
Ada.Strings.Fixed;
with System.Address_To_Access_Conversions;

procedure direct is

   -- Working with directories

  subtype size_t is Interfaces.C.size_t;
  -- renaming size_t to save some typing

  package CStringPtrs is  new
    System.Address_To_Access_Conversions( string );
  use CStringPtrs;
-- Convert between C and Ada pointers to a string

  subtype DirInfoCPtr  is System.Address;
  subtype DirEntCPtr is System.Address;
  -- two C pointers (System.Address types)
renamed for
  -- clarity below

  type DirEnt is record
    inode : long_integer; -- inode number
    offset : integer; -- system dependent
    offset2: unsigned_char; -- system dependent
    reclen : unsigned_short; -- system dependent
    name : string( 1..257 ); -- name of file
  end record;
  pragma pack( dirent);
  -- dirent is defined in /usr/src/linux../linux/dirent.h

  package DirEntPtrs is new
    System.Address_To_Access_Conversions( DirEnt );
  use DirEntPtrs;
    -- Convert between C and Ada pointers to a directory entry

  procedure getcwd( buffer : out string; maxsize : size_t );
  pragma import( C
getcwd );

  function get_current_dir_name return System.Address;
  pragma import( C
get_current_dir_name);

  function mkdir( path : string; mode : size_t ) return integer;
  pragma import( C
mkdir );

  function rmdir( path : string ) return integer;
  pragma import( C
rmdir );

  function opendir( path : string ) return DirInfoCPtr;
  pragma import( C
opendir );

  function closedir( info : DirInfoCPtr ) return integer;
  pragma import( C
closedir );

  function readdir( info : DirInfoCPtr ) return DirEntCPtr;
  pragma import( C
readdir );

  function rewinddir( info : DirInfoCPtr ) return integer;
  pragma import( C
rewinddir );

  function telldir( info : DirInfoCPtr ) return integer;
  pragma import( C
telldir );

  function seekdir( info : DirInfoCPtr; position : integer ) return integer;
  pragma import( C
seekdir );

  -- scandir hard to use from Ada

  s: string(1..80);
  csop: CStringPtrs.Object_Pointer;
  Result: integer;
  DirInfo: DirInfoCPtr;
  direntop : DirEntPtrs.Object_Pointer;
  Position : integer;
  LastPosition : integer;

begin

  Put_Line( "This program demonstrates Linux's directory functions" );
  New_Line;

  -- getcwd example

  getcwd( s
s'length );
  Put( "The current path (simplified) is " );
  Put_Line( Head( s
Index( s
ASCII.NUL & "" )-1 ));

  -- Index for fixed strings takes a string as the second parameter
  -- We'll make a string containing an ASCII.NUL with &

  -- get_current_dir_name example

  csop := To_Pointer( get_current_dir_name );
  Put( "The current path is " );
  Put_Line( Head( csop.all
Index( csop.all
ASCII.NUL & "" )-1 ) );

  -- mkdir example: create a directory named "temp"

  Result := mkdir( "temp" & ASCII.NUL
755 );
  if Result /= 0 then
    Put_Line( "mkdir error" );
  else
    Put_Line( "temp directory created" );
  end if;

  -- rmdir example: remove the directory we just made

  Result := rmdir( "temp" & ASCII.NUL );
  if Result /= 0 then
    Put_Line( "rmdir error" );
  else
    Put_Line( "temp directory removed" );
  end if;
  New_Line;

  -- directory reading

  DirInfo := OpenDir( "/home/ken/ada" & ASCII.NUL);
  Put_Line( "Directory /home/ken/ada contains these files:");
  loop
    direntop := To_Pointer( ReadDir( DirInfo ) );
  exit when direntop = null;

    -- TellDir returns the position in the directory
    -- LastPosition will hold the position of the last entry read

    LastPosition := Position;
    Position := TellDir( DirInfo );
    Put_Line( Head( Direntop.name
Index( Direntop.name
ASCII.NUL & "" )-1 ) );
  end loop;
  New_Line;

  -- SeekDir: move to last position in directory
  Result := SeekDir( DirInfo
LastPosition );
  Put( "The last position is " );
  direntop := To_Pointer( ReadDir( DirInfo ) );
  Put_Line( Head( Direntop.name
Index( Direntop.name
ASCII.NUL & "" )-1 ) );
  New_Line;

  -- RewindDir: Start reading again

  Result := RewindDir( DirInfo );
  Put( "The first position is " );
  direntop := To_Pointer( ReadDir( DirInfo ) );
  Put_Line( Head( Direntop.name
Index( Direntop.name
ASCII.NUL & "" )-1 ) );
  New_Line;

  -- close the directory

  Result := CloseDir( DirInfo );
end direct;

This program demonstrates Linux's directory functions
The current path (simplified) is /home/ken/ada/trials
The current path is /home/ken/ada/trial
temp directory created
temp directory removed
Directory /home/ken/ada contains these files:
.
..
temp
all.zip
README
posix.zip
sm
posix
cgi
tia
x
rcsinfo.txt
text_only
original
lintel
texttools
smbeta2.zip
trials
plugins
texttools.zip

The last position is texttools.zip

The first position is .
 

16.10 Stdio Files

C has a library called stdio or STanDard IO which contains standard operations for text files. Loosely stdio is the C equivalent of Ada's Text_IO package.The standard gnat package cstreams(?) provides a thin binding to many of the stdio functions. In this section we'll looking at using stdio directly.

Some of the stdio functions can't be used from Ada because of differences in the languages. For example printf the standard command for writing to the screen has a variable number of parameters. Because there's no way to express a variable number of parameters in Ada printf can't be imported into Ada.

with System;
type AStdioFileID is new System.Address;
function fputc( c : integer; fid : AStdioFileID ) return integer;
pragma import( C fputc fputc );
Part of standard C library. Writes one charcter to a file.
 
function fputs( s : string; fid : AStdioFileID ) return integer;
pragma import( C fputs fputs );
Writes a C string to a file.
 
function ferror( fid : AStdioFileID ) return integer;
pragma import( C ferror);
Return error from last file operation if any.
 
procedure clearerr( fid : AStdioFileID );
pragma import( C clearerr);
Clear the error and end of file information.
 
function feof( fid : AStdioFileID ) return integer;
pragma import( C feof);
Return non-zero if you are at the end of the file.
 
function fileno( fid : AStdioFileID ) return integer;
pragma import( C fileno);
Return the file number for use with Linux file kernel calls.
 
function flock( fd operation : integer ) return integer;
pragma import( C flock );
Locks or unlocks a file (or a portion of a file).
This is for compatibility with other UNIXes--use fcntl instead.
Operation: LOCK_SH (1) - shared lock
           LOCK_EX (2) - exclusive lock
           LOCK_NB (4) - no block flag (may be added to others)
           LOCK_UN (8) - unlock
 

16.11 Stdio Pipes

Pipes are the equivalent of shell command pipes formed by the '|' character. You can open a pipe to or from a shell command depending if the pipe is for writing or reading respectively.

These single direction pipe commands are a part of the standard C library.

function popen( command mode : string ) return AStdioFileID;
pragma import( C popen popen );
Opens a pipe to a Linux shell command.Mode can be "w" for write or "r" for read.
 
procedure pclose( result : out integer; fid : AStdioFileID);
pragma import( C pclose pclose );
pragma import_valued_procedure( pclose );
Closes a pipe.

The following program prints to a printer by opening a pipe to the lpr command.

with Ada.Text_IO
System
SeqIO;
use Ada.Text_IO;

procedure printer2 is
  -- a program for simple printing

  ---> Pipe Stuff -------------------------------------

  type AStdioFileID is new System.Address;
  -- a pointer to a C standard IO (stdio) file id

  function popen( command
mode : string )  return AStdioFileID;
  pragma import( C
popen
popen
);
  -- opens a pipe to command

  procedure pclose( result : out integer; fid : AStdioFileID );
  pragma import( C
pclose
pclose
);
  pragma import_valued_procedure( pclose);
  -- closes a pipe

  function fputc( c : integer; fid : AStdioFileID ) return integer;
  pragma import( C
fputc
fputc
);
  -- part of standard C library.Writes one charctera to a file.

  function fputs( s : string; fid : AStdioFileID ) return integer;
  pragma import( C
fputs
fputs
);
  -- part of standard C library.Writes a string to a file.

  PipeID : AStdioFileID; -- File ID for lpr pipe

  procedure BeginPrinting is
    -- open a pipe to lpr
  begin
    Put_Line( "Opening pipe to lpr ..." );
    PipeID := popen( "lpr" & ASCII.NUL
w
& ASCII.NUL);
  end BeginPrinting;

  procedure EndPrinting is
    -- close the pipe.Result doesn't matter.
    -- Linux normally will not eject a page when
    -- printing is done
so we'll use a form feed.
    Result : integer;
  begin
    Result := fputc( character'pos( ASCII.FF )
PipeID);
    pclose( Result
PipeID );
  end EndPrinting;

  --> Input/Output Stuff --------------------------------

  procedure Print( s : string ) is
    -- print a string to the pipe
with a carriage
    -- return and line feed.
    Result : integer;
  begin
    Result := fputs( s & ASCII.CR & ASCII.LF & ASCII.NUL
PipeID );
  end Print;

begin

  -- Open the pipe to the lpr command

Put_Line( "Starting to print..." ); BeginPrinting; Print( "Sales Report" ); Print( "------------" ); Print( "" ); Print( "Sales were good" ); -- Now close the pipe. EndPrinting; Put_Line( "Program done...check the printer" ); end printer2;
 

16.12 Memory Management

The amount of virtual memory for a process depends on the processor. For Intel x86 processors your program and data must be 3 Gigabytes or less. (An additional 1 Gigabyte per process is reserved for the kernel accounting for the full 32-bits of addressing space.)

[not finished--KB]

16.13 The Virtual Consoles

The virtual consoles are controlled by the ioctl() function.

[not finished--KB]

The following example catches SIGWINCH signals and reports the new window size.

with Ada.Interrupts.Names;
useAda.Interrupts;

package sigwinch is

protected SignalHandler is

  procedure SizeChangeHandler;
  pragma Attach_Handler( SizeChangeHandler
Names.SIGWINCH );
  -- this handler will catch SIGWINCH signals
a window size
  -- change

end SignalHandler;

end sigwinch;

with Ada.Text_IO;
useAda.Text_IO;

package body sigwinch  is

  -- imported C functions

  TIOGWINSIZ : constant integer := 16#5413#;
  -- get window size ioctl request

  type WindowSizeInfo is record
    row
column
unused1
unused2 : short_integer;
  end record;
  pragma pack( WindowSizeInfo );

  -- the window size information returned by ioctl

  type AFileID is new integer;
  -- a file descriptor
a new integer for safety

  procedure ioctl_winsz( Result : out integer; fid : AFileID; request : integer;
  info : in out WindowSizeInfo );
  pragma import( C
ioctl_winsz
ioctl
);
  pragma import_valued_procedure( ioctl_winsz
ioctl
);
  -- get the size of the window

  function open( path : string; flags : integer ) return AFileID;
  pragma import( C
open
open
);
  -- open a file (in this case
the tty)

  procedure close( fid : AFileID );
  pragma import( C
close
close
);
  -- close a file

  -- The Signal Handler

  protected body SignalHandler is

    procedure SizeChangeHandler is
    -- handle a window size change
SIGWINCH

      fid: AFileID;-- open's file ID

      Result : integer; -- function result of ioctl

      Info: WindowSizeInfo; -- window size returned by ioctl

    begin

      fid := Open( "/dev/tty" & ASCII.NUL
0 );

      ioctl_winsz( Result
fid
TIOGWINSIZ
Info );

      if Result = 0 then
        Put_Line( "Window is now " & info.column'img & " x " & info.row'img);
      else
        Put_Line( "ioctl reports an error" );
      end if;

      Close( fid );

    end SizeChangeHandler;

  end SignalHandler;

end sigwinch;

with Ada.Text_IO
sigwinch;

useAda.Text_IO sigwinch; procedure winch is begin Put_Line( "This program catches SIGWINCH signals"); New_Line; Put_Line( "It will stop running is 60 seconds. If you are using" ); Put_Line( "X Windows move the window to send signals."); New_Line; delay 60.0; -- run for 60 seconds end winch;

 

16.14. Making Database Queries

16.14.1 mySQL

mySQL (pronounced "my ess que ell" ) is a free high-performance database from T.c.X. It's available for a number of platform including Linux. The mySQL home page is http://www.mysql.org.

mySQL comes with a C library called "mysqlclient". If an Ada program links in this library with "-lmysqlclient" it can access mySQL databases. You issue commands to the database called queries using the database language SQL (pronounced "sequel").

Connecting to a mySQL database is a six step process:

  1. Open a new connect using mysql_init.
  2. Login using mysql_real_connect.
  3. Perform database queries with mysql_query or mysql_real_query. real_query allows binary data in the query.
  4. Retrieve the results using mysql_store_result or mysql_use_result.
  5. Free any memory using mysql_free_result.
  6. Close your connection with mysql_close.

Usually a null point or non-zero integer result indicates an error. mysql_errono returns the error.

Complete documentation is available from the mySQL web site.

16.14.2 PostgreSQL

Not finished--KB

 

16.15 Dynamic Loading

Not finished--KB

 

16.16 Writing Linux Modules

If you are writing kernel components you'll have to use "GNORT" (pragma no_run_time). Without the run time components you won't be able to use some Ada packages and features including exceptions and the Text_IO library (which uses exceptions). You'll have to import the appropriate C functions to do I/O. Without the run time library you're source code will also be much smaller comparable with C.

If you have the time you can always copy some of the standard Ada packages to a separate directory and compile them into your GNORT project effectively creating your own small custom run-time system.

The Gnat run-time system is described at http://www.iuma.ulpgc.es/users/jmiranda/.

For details on how to program for the Linux kernel read Linux Kernel Module Programming Guide. To create a Linux kernel module in Ada you will also need to register a license. In C this is accomplised with the MODULE_LICENSE macro. The Linux kernel will expect init_module and cleanup_module subprograms to exist.

with Interfaces.C;

package SomeModule is

  -- Module Variables

  type Aliased_String is array (Positive range <>)
  of aliased Character;
  pragma Convention (C
Aliased_String);

  Kernel_Version: constant Aliased_String:="2.4.18-5" & Character'Val(0);
  pragma Export (C
Kernel_Version
kernel_version
);

  Mod_Use_Count: Integer;
  Pragma Export (C
Mod_Use_Count
mod_use_count_
);

  -- Kernel Calls

  procedure Printk( s : string );
  pragma import( C
printk
printk
);

  -- Our Module Functions

  function Init_Module return Interfaces.C.int;
  pragma Export (C
Init_Module
init_module
);

  procedure Cleanup_Module;
  pragma Export (C
Cleanup_Module
cleanup_module
);
end SomeModule;

package body SomeModule is
  -- sample module layout

  function Init_Module return Interfaces.C.int is
  begin
    Printk("Hello
World!" & Character'val(10) & character'val(0));
    return 0;
  end Init_Module;

  procedure Cleanup_Module is
  begin
    Printk("Goodbye
World!" & Character'val(10) & character'val(0));
  end Cleanup_Module;
 end SomeModule;

Multiple object files must be combined into a single loadable module object file using the ld command. Never use -fPIC when working with the kernel. You may need the '-a' flag and '-s' flags so that Gnat will recompile the system package and related low-level Gnat files or copy them by hand and compile them yourself (use the -gnatg switch).

Use insmod lsmod and rmmod to install test and uninstall your module.

$ insmod hello.o
   Hello
World!

For embedded systems there is RTEMS an embedded run time and supports a more complete Ada runtime (with tasking) on some targets. See http://www.rtems.com/.

 

with Ada.Text_IO;
use Ada.Text_IO;

procedure nrt2 is
  -- Simple Program
begin
  put_line( "Hello World" );
end nrt2;

pragma no_run_time;

procedure nrt is
  -- Same as nrt2 but using no run time

  type file_id is new integer;

  -- No Ada.Text_IO possible
so we'll write our own
  -- that talks directly to the Linux kernel

  procedure write_char( amount_written : out long_integer;
	id : file_id;
  	buffer : in out character;
  	amount2write : long_integer );
  pragma import( C
write_char
write
);
  pragma import_valued_procedure( write_char
write
);

  procedure put( c : character ) is
    result : long_integer;
    buf    : character := c;
  begin
    write_char( result
1
buf
1 );
  end put;

  procedure new_line is
  begin
    put( character'val( 10 ) );
  end new_line;

  procedure put_line( s : string ) is
    pragma suppress( index_check
s );
    -- s(i) won't throw a range error
but Gnat checks for it
    -- by default.  Exceptions are a part of the run time.
  begin
    for i in s'range loop
        put( s(i) );
    end loop;
    new_line;
  end put_line;

begin
  put_line( "Hello World" );
end nrt;

16.17 Linux Sound

The Linux sound capabilities called OSS were developed by 4front technologies.You can find more advanced documentation at their website http://www.opensound.com. This section describes only the basic functions.

The newest Linux sound standard is ALSA.

Most distributions have OSS in the kernel by default but there's no reason that OSS must be present--it can always be turned off for computers without a sound card.

16.17.1 Detecting a Sound Card

Open the file /dev/sndstatus. If there is no error the computer has a sound card.

16.17.2 Playing Sound Samples

There are no C libraries or kernel calls to play sound samples. Instead there is a device file called /dev/audio which plays sound samples in the .au sound format.

The .au sound format consists of a header describing the sound followed by the actual sound data. The header looks like this:

type AAUHeader is record
  Magic : integer;        -- a unique number denoting a .au file

                          -- as used with the magic file
SND_MAGIC
                          -- Hex 646E732E (bytes 2E
73
6E
64)
  dataLocation : integer; -- offset or pointer to the sound data
  dataSize: integer;      -- number of bytes of sound data
  dataFormat: integer;    -- the data format code
  samplingRate : integer; -- the sampling rate
  channelCount : integer; -- the number of channels
  info1
info2
info3
info4 : character;-- name of sound
end record;

dataLocation is an offset to the first byte of the sound data. If there's no sound name it's 28 the size of the header. It can a pointer to the data depending on the dataFormat code but that doesn't apply if you're playing a .au file.

dataSize is the size of the sound data in bytes not including the header.

dataFormat describes how the sound data is to be interpreted. Here is a table of some common values.

Value Code Format
0 SND_FORMAT_UNSPECIFIED unspecified format
1 SND_FORMAT_MULAW_8 8-bit mu-law samples
2 SND_FORMAT_LINEAR_8 8-bit linear samples
3 SND_FORMAT_LINEAR_16 16-bit linear samples
4 SND_FORMAT_LINEAR_24 24-bit linear samples
5 SND_FORMAT_LINEAR_32 32-bit linear samples
6 SND_FORMAT_FLOAT floating-point samples
7 SND_FORMAT_DOUBLE double-precision float samples
8 SND_FORMAT_INDIRECT fragmented sampled data
10 SND_FORMAT_DSP_CORE DSP program
11 SND_FORMAT_DSP_DATA_8 8-bit fixed-point samples
12 SND_FORMAT_DSP_DATA_16 16-bit fixed-point samples
13 SND_FORMAT_DSP_DATA_24 24-bit fixed-point samples
14 SND_FORMAT_DSP_DATA_32 32-bit fixed-point samples
16 SND_FORMAT_DISPLAY non-audio display data
18 SND_FORMAT_EMPHASIZED 16-bit linear with emphasis
19 SND_FORMAT_COMPRESSED 16-bit linear with compression
20 SND_FORMAT_COMPRESSED_EMPHASIZED Combo of the two above
21 SND_FORMAT_DSP_COMMANDS Music Kit DSP commands

SamplingRate is the playback rate in hertz.CD quality samples are 44100.

channelCount is 1 for mono 2 for stereo.

The info characters are a C null-terminated string giving a name for the sound. It's always at least 4 characters long even if unused.

In order to play a sound treat /dev/audio as if it were a device attached to your computer for playing .au sounds.Write a program to open /dev/audio for writing and write the .au sound to it.

Playing sounds is a natural candidate for multithreading because you don't want your entire program to stop while a sound is being played.

The following program uses the seqio generic package we developed above to play an .au sound through /dev/audio.

with seqio;
with Ada.Text_IO;
use Ada.Text_IO;

procedure playsnd is

  -- simple program to play an .au sound file

  package byteio is new seqio( short_short_integer );
  -- sequential files of bytes

  au_filename : constant string := "beep.au";
  -- sound file to play.  supply the name of the .au file to play

  au_file: byteio.AFileID; -- the sound file
  dev_audio: byteio.AFileID; -- /dev/audio device

  soundbyte : short_short_integer;

begin

  Put_Line( "Playing " & au_filename & "...");

  -- open the files

  au_file := byteio.Open( au_filename
read => true);
  dev_audio := byteio.Open( "/dev/audio"
read => false);

  -- read until we run out of bytes
send all bytes to
  -- /dev/audio.The end of file will cause a seqio_error

  begin
    -- nested block to catch the exception

    loop
      byteio.Read( au_file
soundbyte );
      byteio.Write( dev_audio
soundbyte );
    end loop;

  exception when byteio.seqio_error =>
    null; -- just leave block
  end;

  -- close files

  byteio.Close( au_file );
  byteio.Close( dev_audio );

  Put_Line( "All done" );

exception when others =>
  Put_Line( "Oh
oh! An exception occurred!" );
  byteio.Close( au_file );
  byteio.Close( dev_audio );
  raise;

end playsnd;

16.17.3 Using the Mixer

You control the mixer chip if your sound card has one by using the ioctl() kernel call. If there is no mixer the ioctl() function returns -1. Mixer Functions Table

SOUND_MIXER_NRDEVICES 17 Number of mixer functions on this computer
SOUND_MIXER_VOLUME 0 The master volume setting
SOUND_MIXER_BASS 1 Bass setting
SOUND_MIXER_TREBLE 2 Treble setting
SOUND_MIXER_SYNTH 3 FM synthesizer volume
SOUND_MIXER_PCM 4 /dev/dsp volume
SOUND_MIXER_SPEAKER 5 internal speaker volume if attached to sound card
SOUND_MIXER_LINE 6 "line in" jack volume
SOUND_MIXER_MIC 7 microphone jack volume
SOUND_MIXER_CD 8 CD input volume
SOUND_MIXER_IMIX 9 Recording monitor volume
SOUND_MIXER_ALTPCM 10 volume of alternate codec on some cards
SOUND_MIXER_RECLEV 11 Recording level volume
SOUND_MIXER_IGAIN 12 Input gain
SOUND_MIXER_OGAIN 13 Output gain
SOUND_MIXER_LINE1 14 Input source 1 (aux1)
SOUND_MIXER_LINE2 15 Input source 2 (aux2)
SOUND_MIXER_LINE3 16 Input source 3 (line)

Reading or writing values have a special bit set [Ken check using soundcard.h].

Ioctl calls return an integer value. Volume levels can be 0 to 100 but many sound cards do not offer 100 levels of volume. /dev/mixer will set the volume to setting nearest to your requested volume.

[Not complete--KB]

Sound_mixer_volume : constant integer := 0;
Sound_Mixer_Read : constant integer := ?;
Sound_Mixer_Write : constant integer := ?;

oldVolume : integer;

ioctlResult := Ioctl( mixer_file_id
sound_mixer_read + sound_mixer_volume
oldVolume );

-- master volume now in oldVolume

if ioctlResult = -1  then
  Put_Line( "No mixer installed " );
end if;

newVolume := 75;

ioctlResult := ioctl( mixer_file_id
sound_mixer_write + sound_mixer_volume
newVolume );

-- master volume is 75%
 

16.17.4 Recording Sound Samples

Recording sounds works is the reverse process of playing sounds. Open /dev/dsp for reading and it returns sound data. However before you can begin recording from /dev/dsp you need to describe how you want the recording done. You need to select the input source sample format (sometimes called as number of bits) number of channels (mono/stereo) and the sampling rate (speed). These are set by using the ioctl function on the /dev/dsp file.

To select the input source you'll need to use /dev/mixer.

[Not finished--KB

Sound_Mixer_Recsrc : constant integer := ?;
Sound_Mixer_Read : constant integer := ?;
Sound_Mixer_Write : constant integer := ?;

newInputSource := Sound_Mixer_Mic;

ioctlResult := ioctl( mixer_file_id
sound_mixer_write + sound_mixer_recsrc
newInputSource
);

Common formats

/* Audio data formats (Note! U8=8 and S16_LE=16 for compatibility) */

AFMT_QUERY 16#00000000# Returns current format
AFMT_IMA_ADPCM 16#00000004# ADPCM compressed data
AFMT_U8 16#00000008# Unsigned bytes
AFMT_S16_LE 16#00000010# Little endian signed 16 bits
AFMT_S16_BE 16#00000020# Big endian signed 16 bits
AFMT_S8 16#00000040# Signed bytes
AFMT_U16_LE 16#00000080# Little endian U16 bits
AFMT_U16_BE 16#00000100# Big endian U16 bits
AFMT_MPEG 16#00000200# MPEG (2) audio
sndctl_dsp_setfmt : constant integer := ?;

newFormat : integer;

newFormat := 16#0000010#;

ioctlResult := ioctl( dsp_id
sndctl_dsp_setfmt
newFormat );
-- recording format now 16 bit signed little endian

if newFormat /= 16#00000010  then
  Put_Line( "Sound card doesn't support recording format" );
end if;

Selecting mono or stereo recording is a matter of 0 or 1 respectively.

sndctl_dsp_stereo : constant integer := ?;

stereo : integer;

stereo := 1;

...

ioctlResult := ioctl( dsp_id
sndctl_dsp_stereo
stereo );
-- recording format now stereo

if stereo /= 1 then
  Put_Line( "Sound card doesn't support stereo" );
end if;

Finally select a sampling rate.

sndctl_dsp_speed : constant integer := ?;

newSpeed : integer;

newSpeed:= 44100;

ioctlResult := ioctl( dsp_id
sndctl_dsp_speed
newFormat );
-- recording now CD quality sampling speed

if newSpeed /= 44100  then
  Put_Line( "Sound card doesn't support sampling speed" );
end if;

Now read /dev/dsp for the raw sound data. If you want to save the sound as an .au file you'll have to create the .au header information to attach to the sound data.

16.18 Audio CDs

16.19 Kernel Pipes

16.20 Shared Memory

Shared Memory Flags

IPC_CREAT Create new shared memory block
IPC_EXCL plus read write and execute bits.

IPC_PRIVATE indicates no key is supplied.

 
function shmget( key : key_t; bytes : integer; shmflag : integer ) return integer;
pragma import( C shmget );
Key is an id you supply to identify the memory (or IPC_PRIVATE for no key). bytes is the minimum amount of memory that you need. shmflag indicates options for this call. Returns -1 on error or an id for the memory.
Example: shmid := shmget( mykey 4096 IPC_CREAT+IPC_EXCL+8#0660#);
 
function shmat( result : out system.address; shmid : integer; shmaddr : system.address; shmflag : integer ) return system.address;
pragma import( C shmat );

Shared memory attach.  Makes shared memory accessible by returning a pointer to it.  shmid is the id returned by shmget.  if shmaddr isn't zero the kernel will the address you give instead of chosing one itself.  shmflags are additional options.  Returns the address of the shared memory or an address of -1 for an error.
Exampleshmat( ShmCPtr myID To_Address( null ) 0 );
ShmPtr := To_Address( ShmCPtr );
 
SHM_RDONLY - this memory is read-only (that is as if it was constant ).
SHM_RND - allows your shmaddr to be truncated to a virtual memory page boundary.
 
function shmdt( shmaddr : system.address ) return integer;
pragma import( C shmdt );
Shared memory detach. Removes the association of the shared memory to the pointer. Returns 0 if the memory was detached -1 for failure.
Example: Result := shmdt( To_Address( ShmPtr ) );
 
function shmctl( shmid : integer; cmd : integer; info : system.address) return integer;
pragma import( C shmctl );
Performs miscellaneous shared memory functions including deallocating shared memory allocated with shmget.  Returns 0 if the function was successful or -1 for a failure.
Example: Result := shmctl( myID IPC_RMID To_Address( null) );
 
IPC_RMID - deallocate shared memory

16.21 Message Queues

What are they?

Message queues are one of three IPC (Inter Process Communication) ways of System V. The others are shared memory and semaphores. Message queues are linked lists of messages maintained by the kernel. A process can set one up disappear and the queue still remains.

Are they usefull?
Yes they provide a fairly simple way of passing messages between processes. They are also very fast.

A way of using them

We'll look at a simple case where two processes will pass a message between each other.

First we'll need a System V IPC key. Ftok generates a almost always uniqe key by gathering some info from a user provided file. This key is needed when we create a queue.

type key_t is new integer;
 
function ftok( path : string; proj_id : integer ) return key_t;
Convert a project id number and a pathname of an accessible file to a key that can be used by Linux's System V interprocess communication features (that is message queues.)
Example: my_queue := ftok( "./queue_file.que" & ASCII.NUL my_proj );

Ftok proberbly means "File To Key".

Although Ada integers and C "int" types are identical we'll use the Interfaces.C package for maximum portability.

  -- C is key_t ftok(const char *pathname
int proj_id);

  package C renames Interfaces.C;
  type Key_t is new C.Int;
  pragma Convention (C
Key_t);
  function C_Ftok(Pathname : in String; Proj : in C.Int) return Key_t;
  pragma Import(C
C_Ftok
ftok
);

By calling C_Ftok with Proj greater than 0 we get a key or -1 for error. We now wants to create a message queue with this key.

function msgget( key : key_t; flags : integer ) return integer;
Return the message queue id number associated with the key. A new message queue will be created if the key has value IPC_PRIVATE or of no queue exists. The flags indicate indicate the permissions for the message queue.
Example: qid := msgget( key IPC_CREAT+8#660#;

Mesget can be called with a lot of options but we'll go for getting an id for a queue and if it does not exists we create it.

  int msgget(key_t key
int msgflg);

  IPC_CREAT       : constant C.Int :=  512 ;
  IPC_PERMISSIONS : constant C.Int := 8#660#;
  function C_Msgget(Key : Key_t; Msgflg : C.Int) return C.Int;
  pragma Import (C
C_Msgget
msgget
);

By calling msgget with IPC_CREAT + IPC_PERMISSIONS and the generated key we get the identity of a message queue that either exists or is newly created with the corresponding permissons. The execute flag has no meaning for message queues.

msgsnd msgsnd(2)

Now we want to do something but first have a look at 'ipcs -q'. This command lists message queues in the system.

We send a record that looks like this

      struct msgbuf {
        long    mtype;   /* message type
must be > 0 */
        char    mtext[1];        /* message data */
       };
  
This translates in Ada into a record with an C.long member + another member of arbitrary kind ie a record.

    type Message_Type is record
      M_Type         : C.Long := 100;
      An_Integer     : Integer;
      Anther_Integer : Integer;
    end record;

    function C_Send(Queue_Identity : in C.Int;
                    Message        : in Message_Type) return C.Int is

    type Message_Pointer_Type is access all Message_Type;

    Tmp_Msg     : aliased Message_Type := Message;
    Tmp_Msg_Ptr : Message_Pointer_Type := Tmp_Msg'Access;
    -- All 'size are in bits. There are System.Storage_Unit bits in a byte
    Local_Size : C.Int := C.Int((C.Long'Size + 2 * Integer'Size)/System.Storage_Unit);

    function C_Msgsnd(Msqid : C.Int; Msgp   : Message_Pointer_Type;
                      Msgsz : C.Int; Msgflg : C.Int) return C.Int;
    pragma Import (C
C_Msgsnd
msgsnd
);
  begin
    return C_Msgsnd(Queue_Identity
Tmp_Msg_Ptr
Local_Size
0);
  end C_Send;
  
This will send a record containing 2 integers with message type set to 100. The type can be used in receiving messages.

msgrec

msgrcv(2)

When receiving from a queue we can use fifo-order or just look at messages of a certain kind. This is determined by the Msg_Type parameter. 0 means fifo greater than 0 means first message of that type less than 0 means message with lowest type less than or equal to the absolute value of Msg_Type.

    ssize_t msgrcv(int msqid
struct msgbuf *msgp
size_t msgsz
long msgtyp
int msgflg);

    function C_Receive(Queue_Identity : in C.Int;
                       Msg_Type       : in C.Long;
                       Msg_Flag       : in C.Int := 0) return Message_Type is

      type Message_Pointer_Type is access all Message_Type;
      Receive_Failure : exception;
      function C_Msgrcv(Msqid   : C.Int; Msgpointer : Message_Pointer_Type;
                        Msgsize : C.Int; Msgtype    : C.Long;
                        Msgflag : C.Int)                 return C.Int;
      pragma Import (C
C_Msgrcv
msgrcv
);

      Tmp_Msg     : aliased Message_Type;
      Tmp_Msg_Ptr : Message_Pointer_Type := Tmp_Msg'Access;
      Result      : C.Int                := C.Int'First;
    begin
      Result := C_Msgrcv(Queue_Identity
Tmp_Msg_Ptr

                         C.Int((Message_type'Size + C.Long'Size)/System.Storage_Unit)

                         Msg_Type
Msg_Flag);
      if (Result >= 0) then
        return Tmp_Msg_Ptr.all;
      else
        raise Receive_Failure;
      end if;
    end C_Receive;
  

msgctl

msgctl(2)

With msgctl you can examine and remove existing message queues.

Putting it all together

We'll do 2 simple programs the first sends a message to a message queue and creates the queue if it does not exists. Then the program exits. The second program retrieves a message from a queue. If the queue does not exists it creates the queue and blocks until a message arrives. It then prints out the sum of the fields in the record. The programs was tested with Mandrake 9 and Gnat 3.15p. 4 files are involved:

-- test_def.ads
--
-- a package to provide a simple message queue binding

with Interfaces.C;
package Test_Def is
  package C renames Interfaces.C;

  type Key_t is new C.Int;
  pragma Convention (C
Key_t);

  IPC_CREAT       : constant C.Int :=  512 ;
  IPC_PERMISSIONS : constant C.Int := 8#660#;

  type Message_Type is record
    M_Type         : C.Long := 100;
    An_Integer     : Integer;
    Another_Integer : Integer;
  end record;

  Receive_Failure : exception;

  function C_Ftok(Pathname : in String; Proj : in C.Int) return Key_t;
  pragma Import(C
C_Ftok
ftok
);

  function C_Msgget(Key : Key_t; Msgflg : C.Int) return C.Int;
  pragma Import (C
C_Msgget
msgget
);

  function C_Send(Queue_Identity : in C.Int;
                  Message        : in Message_Type) return C.Int ;
  function C_Receive(Queue_Identity : in C.Int;
                     Msg_Type       : in C.Long;
                     Msg_Flag       : in C.Int := 0) return Message_Type;
end Test_Def;
  

-- test_def.adb package body
--
-- a package to provide a simple message queue binding

with Ada.Text_IO;
with System;
  package body Test_Def is
  use C;

  function C_Send(Queue_Identity : in C.Int;
                  Message        : in Message_Type) return C.Int is
    -- Send a message through the message queue.  Wrapper function for msgsnd.

    type Message_Pointer_Type is new System.Address;

    Tmp_Msg     : aliased Message_Type := Message;
    Tmp_Msg_Ptr : Message_Pointer_Type := Tmp_Msg'Address;
    -- All 'size are in bits. There are System.Storage_Unit bits in a byte
    Local_Size : C.Int := C.Int((C.Long'Size + 2 * Integer'Size)/System.Storage_Unit);

    function C_Msgsnd(Msqid : C.Int; Msgp   : Message_Pointer_Type;
                      Msgsz : C.Int; Msgflg : C.Int) return C.Int;
    pragma Import (C
C_Msgsnd
msgsnd
);

  begin
    return C_Msgsnd(Queue_Identity
Tmp_Msg_Ptr
Local_Size
0);
  end C_Send;

  function C_Receive(Queue_Identity : in C.Int;
                     Msg_Type       : in C.Long;
                     Msg_Flag       : in C.Int := 0) return Message_Type is
    -- Receive a message from a message queue.  Wrapper function for msgrcv.

    type Message_Pointer_Type is new System.Address;

    function C_Msgrcv(Msqid   : C.Int; Msgpointer : Message_Pointer_Type;
                      Msgsize : C.Int; Msgtype    : C.Long;
                      Msgflag : C.Int)                return C.Int;
    pragma Import (C
C_Msgrcv
msgrcv
);

    Tmp_Msg     : aliased Message_Type;
    Tmp_Msg_Ptr : Message_Pointer_Type := Tmp_Msg'Address;
    Result      : C.Int                := C.Int'First;

  begin
    Result := C_Msgrcv(Queue_Identity
Tmp_Msg_Ptr

                     C.Int((Message_type'Size + C.Long'Size)/System.Storage_Unit)

                     Msg_Type
Msg_Flag);
    Ada.Text_Io.Put_Line("Lenght of message:" & C.Int'Image(Result));
    if Result >= 0 then
      return Tmp_Msg_Ptr.all;
    else
      raise Receive_Failure;
    end if;
  end C_Receive;

end Test_Def;
  

-- test_send.adb
--
-- a program to test our message queue package

with Ada.Text_IO;
with Test_Def; use Test_Def;
procedure Test_Send is
  use C;
  Key  : Key_T ;
  Q_Id : C.Int ;
  Message : Message_Type;
  Result : C.Int;
begin
  Key  := C_Ftok("/etc/profile" & Ascii.NUL
1);
  Q_Id := C_Msgget(Key
IPC_CREAT + IPC_PERMISSIONS);

  Message.An_Integer := 40;
  Message.Another_Integer := 2;
  Result := C_Send(Q_Id
Message);
  Ada.Text_Io.Put_Line("Created/got hold of Key:" & Key_T'Image(Key) &
  " Q-id:" & C.Int'Image(Q_Id) & "Result sending:" & C.Int'Image(Result));

  Ada.Text_Io.Put_Line("Check with 'ipcs -q'");
end Test_Send;
  

-- test_receive.adb
--
-- another program to test our message queue package

with Ada.Text_IO;
with Test_Def; use Test_Def;
procedure Test_Receive is
  use C;
  Key  : Key_T ;
  Q_Id : C.Int ;
  Message : Message_Type;
begin
  Key  := C_Ftok("/etc/profile" & Ascii.NUL
1);
  Ada.Text_Io.Put_Line("Received with  Key:" & Key_T'Image(Key) );

  Q_Id := C_Msgget(Key
IPC_CREAT + IPC_PERMISSIONS);
  Ada.Text_Io.Put_Line("Q-id:" & C.Int'Image(Q_Id));

  Message := C_Receive(Q_Id
Message.M_Type);
  Ada.Text_Io.Put_Line("Received with  Key:" & Key_T'Image(Key) &
   " Q-id:" & C.Int'Image(Q_Id) & " The sum of the two fields are:" &
   Integer'Image(Message.An_Integer + Message.Another_Integer));

  Ada.Text_Io.Put_Line("Check with 'ipcs -q'");
end Test_Receive;
  

Compile with gnatmake test_send.adb and gnatmake test_receive.adb. Run test_send first check with 'ipcs -q' and then run test_receive. remove the queue with 'ipcrm'

16.22 Semaphores

16.23 Sockets

Send (sentto and sendmsg) are supersets of write. When you use write on a socket it's actually implemented using the send family.

Write will not work on UDP because it's connectionless. Use send to specify an address everytime.

Protocol Families
PF_INET Internet (IPv4)
PF_INET6 Internet (IPv6)
PF_IPX Novell
PF_NETLINK Kernel user interface device
PF_X25 ITU-T X.25 / ISO-8208
PF_AX25 Amateur radio AX.25
PF_ATMPVC Access to raw ATM PVCs
PF_APPLETALK Appletalk
PF_PACKET Low-level packet interface

Socket Types
SOCK_STREAM Two-way reliable connection with possible out-of-band transmission (eg. TCP/IP)
SOCK_DGRAM (Datagram) Connectionless unreliable messages (eg. UDP/IP)
SOCK_SEQPACKET Sequenced reliable datagram connection.
SOCK_RAQ Raw network protocol access.
SOCK_RDM Reliable unordered datagrams.

function socket( domain soctype protocol : integer ) return integer;
pragma import( C socket );
Creates a network socket for protocol family domain connection type soctype and a protocol (0 uses the default protocol).  Returns -1 on an error or else a kernel file descriptor for the socket.
Example: mySocket := socket( PF_INET SOCK_STREAM 0 ); -- open a standard Internet socket

procedure connect( result : out integer; socket : integer; addr : in out socketaddr; addrlen : integer );
pragma import( C connect );
pragma import_valued_procedure( connect );
Connects to a server on the network.  socket is the socket to use; addr is the machine and service to connect to; addrlen is the length of the addr record.  Returns -1 on an error 0 for success.
Example: connect( result webserver webserver'size/8 ); -- connect to the web server described by the webserver record

function shutdown( socket how : integer ) return integer;
pragma import( C shutdown );
Shuts down one or both directions of a socket.  This is used for example by web browsers to let the server know there are no more HTTP requests being sent. Returns 0 on sucess -1 on failure.
Example: result := shutdown( mysocket 1 );
 
procedure bind( result : out integer; myaddr : in out sockaddr addrlen : integer );
pragma import( C bind );
pragma import_valued_procedure( bind );
Registers your server on a particular port number with the Linux kernel. addrlen is the length of myaddr.  Returns 0 on success -1 on failure.
Example: bind( result myservice myservice'size/8 );
 
function listen( socket : integer; backlog : integer ) return integer;
pragma import( C listen );
pragma import_valued_procedure( listen );
Prepares a socket for your server to listen for incoming connections. Backlog is the maximum number of established connections that can be queued. Returns 0 on success -1 on failure.
Example: result := listen( mysocket 10 );
 
procedure accept( result : out integer; socket : integer; clientaddr : in out sockaddr; addrlen : in out addrlen );
pragma import( C accept );
pragma import_valued_procuedre( accept );

Returns the next connection to your server. If there are no connections it waits for a new connection (unless you disabled blocking on the socket.) myaddr is the address of the incoming connection and addrlen is the size of the address is bytes.  addrlen should be initialized to the size of your sockaddr record.  You must use listen before accept. Returns -1 on failure or a new socket with the connection on success. You have to close the new socket when you are finished handling the connection.
Example: len := clientaddr'size/8;
        accept( newsocket listensocket clientaddr len );  

This section ends with a demonstration of how to get a web page off the Internet.

with Ada.Text_IO
Interfaces.C
System.Address_To_Access_Conversions;
use  Ada.Text_IO
Interfaces.C;

procedure websocket is

  -- A program to fetch a web page from a server


  -- Socket related definitions
  --
  -- These are the kernel calls and types we need to create
  -- and use a basic Internet socket.

  type aSocketFD is new int;

  -- a socket file descriptor is an integer -- man socket
  -- make this a new integer for strong typing purposes

  type aProtocolFamily is new unsigned_short;
  AF_INET : constant aProtocolFamily := 2;

  -- Internet protocol PF_Net defined as 2 in
  -- /usr/src/linux/include/linux/socket.h
  -- Make this a new integer for strong typing purposes

  type aSocketType is new int;
  SOCK_STREAM : constant aSocketType := 1;

  -- this is for a steady connection.  Defined as 1 in
  -- /usr/src/linux/include/linux/socket.h
  -- Make this a new integer for strong typing purposes

  type aNetProtocol is new int;
  IPPROTO_TCP : constant aNetProtocol := 6;

  -- The number of the TCP/IP protocol
  -- TCP protocol defined as 6 in /etc/protocols
  -- See man 5 protocols
  -- Make this a new integer for strong typing purposes

  type aNetDomain is new integer;
  PF_INET : constant aNetDomain := 2;

  -- The number of the Internet domain
  -- Make this a new integer for strong typing purposes

  type aInAddr is record
       addr : unsigned := 0;
  end record;
  for aInAddr'size use 96;
  -- A sockaddr_in record is defined as 16 bytes long (or 96 bits)
  -- Request Ada to use 16 bytes to represent this record

  type aSocketAddr is record
       family : aProtocolFamily := AF_INET; -- protocol (AF_INET for TCP/IP)
       port   : unsigned_short := 0;  -- the port number (eg 80 for web)
       ip     : aInAddr;              -- IP number
  end record;
  -- an Internet socket address
  -- defined in /usr/src/linux/include/linux/socket.h
  -- and /usr/src/linux/include/linux/in.h

  function socket( domain   : aNetDomain;
                   stype    : aSocketType;
                   protocol : aNetProtocol )
    return aSocketFD;
  pragma import( C
socket );
  -- initialize a communication socket.  -1 if error

  procedure bind( result : out int; sockfd : aSocketFD;
    sa : in out aSocketAddr; addrlen : int );
  pragma import( C
bind );
  pragma import_valued_procedure( bind );
  -- give socket a name. 0 if successful

  procedure Connect( result : out int; socket : aSocketFD;
    sa : in out aSocketAddr; addrlen : int );
  pragma import( C
connect );
  pragma import_valued_procedure( connect );
  -- connect to a (Internet) server.  0 if successful

  procedure Close( fd : aSocketFD );
  pragma import( C
close );
  -- close the socket
discard the integer result

  procedure Read( result : out integer; from : aSocketFD; buffer : in out string;
    buffersize : integer );
  pragma import( C
read );
  pragma import_valued_procedure( read );
  -- read from a socket

  procedure Write( result : out integer; from : aSocketFD;
    buffer : system.address; buffersize : integer );
  pragma import( C
write );
  pragma import_valued_procedure( write );
  -- write to a socket

  package addrListPtrs is new System.Address_To_Access_Conversions( System.Address );
  -- We need to use C pointers with the address list because this is
  -- a pointer to a pointer in C.  This will allow us to dereference
  -- the C pointers in Ada.

  subtype addrListPtr is System.Address;
  -- easier to read than System.Address

  type aHostEnt is record
       h_name      : System.Address;    -- pointer to offical name of host
       h_aliases   : System.Address;    -- pointer to alias list
       h_addrtype  : int     := 0;      -- host address type (PF_INET)
       h_length    : int     := 0;      -- length of address
       h_addr_list : addrListPtr;       -- pointer to list IP addresses
                                        -- we only want first one
  end record;
  -- defined in man gethostbyname

  package HEptrs is new System.Address_To_Access_Conversions( aHostEnt );
  -- Again
we need to work with C pointers here
  subtype aHEptr is System.Address;
  -- and this is easier to read
  use HEptrs;
  -- use makes = (equals) visible

  function getHostByName( cname : string ) return aHEptr;
  pragma import( C
getHostByName );
  -- look up a host by it's name
returning the IP number

  function htons( s : unsigned_short ) return unsigned_short;
  pragma import( C
htons );
  -- acronym: host to network short -- on Intel x86 platforms

  -- switches the byte order on a short integer to the network
  -- Most Significant Byte first standard of the Internet

  procedure memcpy( dest
src : System.Address; numbytes : int );
  pragma import( C
memcpy);
  -- Copies bytes from one C pointer to another.  We could probably
  -- use unchecked_conversion
but the C examples use this.

  errno : int;
  pragma import( C
errno );
  -- last error number

  procedure perror( s : string );
  pragma import( C
perror );
  -- print the last kernel error and a leading C string

  procedure PutIPNum( ia : aInAddr ) is
    -- divide an IP number into bytes and display it
    IP : unsigned := ia.addr;
    Byte1
Byte2
Byte3
Byte4 : unsigned;
  begin
    Byte4 := IP mod 256;
    IP := IP / 256;
    Byte3 := IP mod 256;
    IP := IP / 256;
    Byte2 := IP mod 256;
    Byte1 := IP / 256;
    Put( Byte4'img );
    Put( "." );
    Put( Byte3'img );
    Put( "." );
    Put( Byte2'img );
    Put( "." );
    Put( Byte1'img );
  end PutIPNum;

  procedure SendHTTPCommand( soc : aSocketFD; cmd : string ) is
  -- Write a HTTP command string to the socket
    amountWritten : integer := 0;
    totalWritten  : integer := 0;
    position      : integer := cmd'first;
  begin
    loop
          Write( amountWritten
soc
cmd( position )'address

            cmd'length - integer( totalWritten ) );
          if amountWritten < 0 then
             Put_Line( Standard_Error
Write to socket failed
);
             return;
          end if;
          Put_Line( "Sent" & amountWritten'img & " bytes" );
          totalWritten := totalWritten + amountWritten;
          position := position + amountWritten;
    exit when totalWritten = cmd'length;
    end loop;
  end SendHTTPCommand;

  procedure ShowWebPage( soc : aSocketFD ) is
  -- Read the web server's response and display it to the screen
    amountRead : integer := 1;
    buffer : string( 1..80 );
  begin
    -- continue reading until an error or no more data read
    -- up to 80 bytes at a time
    while amountRead > 0 loop
       Read( amountRead
soc
buffer
buffer'length );
       if amountRead > 0 then
          Put( buffer( 1..amountRead ) );
       end if;
    end loop;
  end ShowWebPage;

  ServerName: string := "www.adapower.com";

  mySocket    : aSocketFD;     -- the socket
  myAddress   : aSocketAddr;   -- where it goes
  myServer    : aHEptr;        -- IP number of server
  myServerPtr : HEptrs.Object_Pointer;
  addrList    : addrListPtrs.Object_Pointer;
  Result      : int;

begin

  Put_Line( "Socket Demonstration" );
  New_Line;
  Put_Line( "This program opens a socket to a web server" );
  Put_Line( "and retrieves the server's home page" );
  New_Line;

  -- initialize a new TCP/IP socket
  -- 0 for the third param lets the kernel decide

  Put_Line( "Initializing a TCP/IP socket" );
  Put_Line( "Socket( " & PF_INET'img & '
' & SOCK_STREAM'img &
     "
0 );" );

  mySocket := Socket( PF_INET
SOCK_STREAM
0 );
  if mySocket = -1 then
     perror( "Error making socket" & ASCII.NUL );
     return;
  end if;
  New_Line;

  -- Lookup the IP number for the server

  Put_Line( "Looking for information on " & ServerName );
  Put_Line( "GetHostByName( " & ServerName & ");" );

  myServer := GetHostByName( ServerName & ASCII.NUL );
  myServerPtr := HEptrs.To_Pointer( myServer );
  if myServerPtr = null then
     Put_Line( Standard_Error
Error looking up server
);
     return;
  end if;

  Put_Line( "IP number is" & myServerPtr.h_length'img & " bytes long" );
  addrList := addrlistPtrs.To_Pointer( myServerPtr.h_addr_list );
  New_Line;

  -- Create the IP
port and protocol information

  Put_Line( "Preparing connection destination information" );
  myAddress.family := AF_INET;
  myAddress.port   := htons( 80 );
  memcpy( myAddress.ip'address
addrlist.all
myServerPtr.h_length );
  New_Line;

  -- Open a connection to the server

  Put_Line( "Connect( Result
Socket
Family/Address rec
F/A rec size )" );

  Connect( Result
mySocket
myAddress
myAddress'size/8 );

  Put( "Connect( " & Result'img & "
 );
  Put(  myAddress.family'img &
/" );
  PutIPNum( myAddress.ip );
  Put(  "
 & integer'image( myAddress'size / 8 ) &
)" );
  if Result /= 0 then
     perror( "Error connecting to server" & ASCII.NUL );
     return;
  end if;
  New_Line;

  -- Write the request
  --
  -- "GET" returns a web page from a web server
  -- Also send minimal HTTP header using User-Agent
  -- Followed with a blank line to indicate end of command

  Put_Line( "Transmitting HTTP command..." );
  SendHTTPCommand( mySocket

     "GET /index.html HTTP/1.0" & ASCII.CR & ASCII.LF &
     "User-Agent: WebSocket/1.0 (BigBookLinuxAda Example)" & ASCII.CR & ASCII.LF
     & ASCII.CR & ASCII.LF );
  New_Line;

  -- read web page back

  Put_Line( "---Web Page / Server Results-------------------------" );
  ShowWebPage( mySocket );
  Put_Line( "-----------------------------------------------------" );

  -- close the connection

  Put_Line( "Closing the connection" );
  close( mySocket );

  Put_Line( "Demonstration finished - have a nice day" );

end websocket;

Socket Demonstration

This program opens a socket to a web server
and retrieves the server's home page

Initializing a TCP/IP socket
Socket(  2
1
0 );

Looking for information on www.adapower.com
GetHostByName( www.adapower.com);
IP number is 4 bytes long

Preparing connection destination information

Connect( Result
Socket
Family/Address rec
F/A rec size )
Connect(  0
2/ 216. 92. 66. 46
16)
Transmitting HTTP command...
Sent 81 bytes

---Web Page / Server Results-------------------------
HTTP/1.0 200 OK
Date: Wed
29 Mar 2000 02:32:56 GMT
Server: Apache/1.3.3
Last-Modified: Thu
11 Nov 1999 02:03:14 GMT
Etag: "1f31-406-382a23e2"
Accept-Ranges: Bytes
Content-Length: 1030
Content-Type: text/html
Age: 39
Via: HTTP/1.0 csmc2 (Traffic-Server/3.0.3 [uScHs f p eN:t cCHi p s ])

<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
<HTML>
<HEAD>
   <META NAME="author" CONTENT="David Botton">>
   <META NAME="keywords" CONTENT="Ada AdaPower power source code free treasury repository">
   <META NAME="description" CONTENT="The Ada Source Code Treasurey contains components
procedures
algorithms and articles for Ada developers.">
   <META http-equiv="Page-Enter" CONTENT="revealtrans(duration=2.0
transition=3)">
   <TITLE>AdaPower.com</TITLE>
   <LINK href="mailto:David@Botton.com" rev="made">
</HEAD>
<FRAMESET COLS="120
*" FRAMEBORDER=0 FRAMESPACING=0 BORDER=0>
	<FRAME SRC="buttons.html" name="menu" frameborder=0 marginheight=0 marginwidth=0 noresize scrolling=auto border=0>
	<FRAME SRC="http://www.adapower.com/body.html" name="body" frameborder=0 marginheight=5 marginwidth=0 noresize scrolling=auto border=0>
<NOFRAMES>
<meta HTTP-EQUIV="REFRESH" CONTENT="0; URL="body.html">
<body bgcolor="#ffffff" text="#000000">
<a href="body.html">Click here</a>
</BODY>
</BODY>
</NOFRAMES>
</FRAMESET>

</HTML>
-----------------------------------------------------
Closing the connection
Demonstration finished - have a nice day

16.24 Memory Management

type aProtection is new integer;
type aMapFlag is new integer;

function getpagesize return long_integer;
pragma import( C getpagesize );

Return the size of a Linux memory page (that is the size of the memory blocks that your program and data are broken up into when loaded into memory).

function mmap( start : system.address; size : long_integer; prot : aProtection; flags : aMapFlag; fd : integer; offset : long_integer ) return system.address;
pragma import( C mmap );

Allocates size bytes of memory and returns a C pointer. If it failed -1 is returned. If MAP_FIXED and start are used the memory will be at the specified address. The protection flags indicate how the memory will be accessed: a signal will be raised on an illegal access. If MAP_ANON is used fd should be -1 and no file will be associated with the memory otherwise fd is a file that will be copied into the block of memory and offset indicates how many bytes into the file the copying should take place.

function munmap( start : system.address; size : long_integer ) return integer;
pramga import( C munmap );

Deallocate memory allocated by mmap.  Returns -1 on an error.

function mremap( old_start : system.address; old_size : long_integer;
new_size : long_integer; flags : aMapFlag) return system.address;
pragma import( C mremap );

Changes the size of a block of memory allocated by mmap possibly moving it.

function mprotect( start : system.address; size : long_integer; new_prot : aProtection ) return integer;
pragma import( C mprotect );

Change the protection settings on a block of memory allocated by mmap. Returns -1 on an error.

Other mmap flags:

  PROT_NONE     : constant aProtection := 0;     -- shorthand for no access
  PROT_READ     : constant aProtection := 1;     -- read access allowed
  PROT_WRITE    : constant aProtection := 2;     -- write access allowed
  PROT_EXEC     : constant aProtection := 4;     -- execute access allowed

  MAP_SHARED    : constant aMapFlag := 16#01#;   -- share changes with child processes
                                                 -- (write changes to the file if any)
  MAP_PRIVATE   : constant aMapFlag := 16#02#;   -- separate copy for child processes
                                                 -- (changes kept in memory if any)
  MAP_FIXED     : constant aMapFlag := 16#10#;   -- use specified address
  MAP_ANON      : constant aMapFlag := 16#20#;   -- just alloc memory no related file
  MAP_ANONYMOUS : constant aMapFlag := MAP_ANON; -- another name for MAP_ANON
  MAP_GROWSDOWN : constant aMapFlag := 16#0100#; -- stack-line usage
  MAP_DENYWRITE : constant aMapFlag := 16#0800#; -- write lock the file
  MAP_EXECUTABLE: constant aMapFlag := 16#1000#; -- mark as executable
  MAP_LOCKED    : constant aMapFlag := 16#2000#; -- don't swap out memory
  MAP_NORESERVE : constant aMapFlag := 16#4000#; -- don't check for reservations

function msync( start : system.address; size : length;
flags : aMSyncFlag ) return integer;
pragma import( C msync );

Updates the file associated with the memory allocated by mmap. Returns -1 on an error.

  MS_ASYNC     : constant aSyncFlag := 1;       -- request memory to be saved soon
  MS_INVALIDATE: constant aSyncFlag := 2;       -- mark cache as needing updating
  MS_SYNC      : constant aSyncFlag := 4;       -- save memory to file immediately

function mlock( start : system.address; size : long_integer ) return integer;
pragma import( C mlock );

Deny page swapping on this block of memory allocated by mmap. Only a superuser process may lock pages. Returns -1 on an error.

function munlock( start : system.address; size : long_integer) return integer;
pragma import( C munlock );

Allow page swapping on this block of memory allocated by mmap. Returns -1 on an error.

function mlockall( flags : aLockFlag ) return integer;
pragma import( C mlockall );

Deny swapping on all memory for this process. Only a superuser process can lock memory. Returns -1 on an error.

function munlockall return integer;
pragma import( C mlockall );
Allow swapping on all memory for this process.  Returns -1 on an error.

  MCL_CURRENT : constant aLockFlag := 1; -- lock current blocks
  MCL_FUTURE  : constant aLockFlag := 2; -- lock subsequent blocks

function brk( end_data_segment : system.address ) return integer;
pragma import( C brk );
Resize the (Intel) data segment to the specified ending address. Returns -1 on an error.

procedure sbrk( increment : long_integer );
pragma import( C sbrk );

Increase the (Intel) data segment by the specified number of bytes.

16.25 Exit Procedures

procedure C_exit;
pragma import( C C_exit exit );
pragma import_valued_procedure( C_exit );
exit is a C a standard C library function that closes all your standard C library files and stops your program. This procedure is meant to be used by C. It is not recommended in an Ada program.

procedure K_exit;
pragma import( C K_exit _exit );
pragma import_valued_procedure( K_exit );
_exit is a kernel call to stop your program. It leaves any open file open. Not recommended in an Ada program: there are more effective ways to stop your program.

 

  <--Last Chapter Table of Contents Next Chapter-->