17 Translating Programs To Ada

c2ada is available from http://www.skinner.demon.co.uk/aidan/programming/

17.2 Interfaces.C package

Gnat 3.12 introduces a new boolean type, C_bool, which behaves as a proper C boolean value: 0 is false and any other value is true.

One thing to remember about this package is that C strings are defined as an array of characters, and Ada will raise a CONSTRANT_ERROR exception if two arrays of characters are not exactly equal length, even if a smaller array is being assigned to a larger one. For example,

s : char_array( 1..80 ) := To_C( "Fred Smith" ); -- bad

The following program demonstrates some of the types and functions in the Interfaces.C packages.

with text_io, unchecked_deallocation,
Interfaces.C.Extensions;



use text_io, Interfaces.C, interfaces.C.Extensions;

procedure ctest is

-- my types
--
-- pointer to C string and deallocation procedure for same

type stringptr is access all char_array;

procedure free is new
unchecked_deallocation( char_array, stringptr );

-- types from standard Ada package Interfaces.C

i  : int;           -- integer
u  : unsigned;      -- unsigned integer
l  : long;          -- long
ul : unsigned_long; -- unsigned long
c  : char;          -- a character
sp : stringptr;     -- ptr to a string (array of characters)
f  : C_float;       -- a float
d  : double;        -- a double
wc : wchar_t;       -- 16-bit wide character

-- additional types from Gnat package Interfaces.C.Extensions

ll : long_long;     -- long long
ull: unsigned_long_long; -- unsigned long long
vp : void_ptr;      -- void pointer

begin

  Put_Line( "This is an example of Interfaces.C" );
  New_Line;

  sp := new char_array'( To_C( "This is a string" ) );
  Put_Line( "The C string s is '" & To_Ada( sp.all ) &
    "'." );
  Free( sp );

end ctest;

This is an example of Interfaces.C

The C string s is 'This is a string'.

17.3 Interfaces.C.Pointers Package

Since pointer arithmetic is important in many C programs, especially sorts, Ada 95 provides a standard generic package called Interfaces.C.Pointers which implements access types that can use pointer arithmetic.

To instantiate the package, you need to specify the elements that will be in your arrays, an unbounded array that will contain the elements, the range of index values, and a default terminator value used by some of the package's subprograms.

For example, to create C-style pointers for the unbounded Char_Array (C string) type in Interfaces.C, you could instantiate the package with

package StringPtrs is new Interfaces.C.Pointers( 
   Index => size_t, -- the index range is size_t
   Element => char, -- the array contains chars
   Element_Array => char_array, -- the unbounded type
   Default_Terminator => char'val( 0 ) -- the terminator value, ASCII.NUL
);
use StringPtrs; -- need this to make + and - visible

strptr : StringPtrs.Pointer;

Pointers created using Interfaces.C.Pointers are access types, and can be used like any other access type.

  Put_Line( "strptr is pointing to the character " & strptr.all );

  strptr := strptr + 2;

  Increment( strptr );  -- forward one position
  Decrement( strptr );  -- back one position

Copy_Array copies a slice of a specific number of elements from one pointer to another. Copy_Terminated Array copies a slice from the pointer position until a terminator is found.

The following program demonstrates C pointers to integer arrays.

with Ada.Text_IO, Interfaces.C.Pointers;

use Ada.Text_IO;

procedure point is

-- To use Interfaces.C.Pointers, you need to define an unbounded
-- array type. In this case, we'll create an unbounded array
-- called IntegerArrays with a maximum index range of 1 to 9.
-- BiggestArray is the largest IntegerArrays array possible,
-- with an index range of 1 to 9.  IntegerArrays must have
-- aliased elements because we will be accessing them with an
-- access type.

subtype PointerRange is integer range 1..9;

type IntegerArrays is array PointerRange range <> )
  of aliased integer;

type BiggestArray is new IntegerArrays( PointerRange );

package IntPtrs is new Interfaces.C.Pointers(
  Index => PointerRange, -- the index range
  Element => Integer, -- what the array contains
  Element_Array => IntegerArrays, -- the unbounded type
  Default_Terminator => 0 ); -- the terminator value

use IntPtrs; -- need this to make + and - visible

procedure ShowArray( ia : IntegerArrays ) is

-- show the contents of any IntegerArrays array

begin

  for i in ia'first..ia'last-1 loop
    Put( i'img );
    Put( " =>" );
    Put( ia( i )'img );
    Put( "," );

  end loop;

  Put( ia'last'img );
  Put( " => " );
  Put_Line( ia( ia'last )'img );
end ShowArray;

ia, ia2 : BiggestArray;  -- two integer arrays
ip, ip2 : IntPtrs.Pointer; -- two pointers to integer arrays

begin

  Put_Line( "This program demonstrates C-style pointers provided" );
  Put_Line( "by Interfaces.C.Pointers" );
  New_Line;

  -- initialize and display the contents of the array

  for i in PointerRange'first..PointerRange'last-1 loop
    ia( i ) := i*2;
  end loop;

  ia( PointerRange'last ) := 0;
  Put_Line( "The array is: " );
  ShowArray( IntegerArrays( ia ) );
  -- must typecast ia because ShowArray is expecting an IntegerArrays

  Put_Line( "Zero is our terminator in this example" );
  New_Line;

  -- set the pointers to the first elements in the arrays

  ip := ia( ia'first )'access;
  ip2 := ia2( ia'first )'access;

  -- ip works like a normal access type

  Put_Line( "Our pointer is set to first position in the array");
  Put_Line( "The element is " & ip.all'img );
  New_Line;

  -- increment example

  Increment( ip );
  Put_Line( "Incrementing the pointer, it now points at " &
    ip.all'img );
  New_Line;

  -- decrement example

  Decrement( ip );
  Put_Line( "Decrementing the pointer, it now points at" &
    ip.all'img );
  New_Line;

  -- addition example

  ip := ip + 3;
  Put_Line( "Addition moves the pointer forward." );
  Put_Line( "Moving forward three elements, it now points at"
    & ip.all'img );
  New_Line;

  -- subtraction example

  ip := ip - 2;
  Put_Line( "Subtraction moves the pointer backwards." );
  Put_Line( "Moving backwards two elements, it now points at"
    & ip.all'img );
  New_Line;

  -- Virtual_Length examples

  Put_Line( "Virtual_Length gives the length from the pointer to the" );

  Put_Line( "default terminator.  The length from this position is" &
  Virtual_Length( ip )'img & " positions" );
  Put_Line( "Virtual_Length can also use an arbitrary terminator." );
  Put_Line( "The length from the pointer to the first 14 is" &
  Virtual_Length( ip, 14 )'img & " positions" );
  New_Line;

  -- Value examples

  Put_Line( "Value returns the array slice from the pointer position to" );
  Put_Line( "the terminator.  The array value from this position is" );
  ShowArray( Value( ip ) );

  Put_Line( "Value can also return a slice of a specific length." );
  Put_Line( "The next four elements are" );
  ShowArray( Value( ip, Length => 4 ) );
  New_Line;

  -- Copy_Terminated_Array example

  Put_Line( "Our second array contains" );
  ShowArray( IntegerArrays( ia2 ) ); -- must typecast here
  New_Line;

  Put_Line( "Copy_Terminated_Array copies elements from one pointer to" );
  Put_Line( "another, up to and including the terminator.  Copying to" );
  Put_Line( "the second array " );
  Copy_Terminated_Array( ip, ip2 );
  ShowArray( IntegerArrays ( ia2 ) ); -- must typecast here
  New_Line;

  -- Copy_Array example

  Put_Line( "Copy_Array copies a specific number of elements.");
  Put_Line( "Copying 4 elements from 3 positions ahead, the new");
  Put_Line( "array contains" );
  Copy_Array( ip+3, ip2, 4 );
  ShowArray( IntegerArrays( ia2 ) ); -- must typecast here
  New_Line;

end point;

This program demonstrates C-style pointers provided
by Interfaces.C.Pointers

The array is:

1 => 2, 2 => 4, 3 => 6, 4 => 8, 5 => 10, 6 => 12, 7 => 14, 8 => 16, 9 => 0

Zero is our terminator in this example

Our pointer is set to first position in the array

The element is 2

Incrementing the pointer, it now points at 4

Decrementing the pointer, it now points at 2

Addition moves the pointer forward.
Moving forward three elements, it now points at 8

Subtraction moves the pointer backwards.
Moving backwards two elements, it now points at 4

Virtual_Length gives the length from the pointer to the
default terminator.  The length from this position is 7 positions

Virtual_Length can also use an arbitrary terminator.
The length from the pointer to the first 14 is 5 positions

Value returns the array slice from the pointer position to
the terminator.  The array value from this position is

1 => 4, 2 => 6, 3 => 8, 4 => 10, 5 => 12, 6 => 14, 7 => 16, 8 => 0

Value can also return a slice of a specific length.

The next four elements are
1 => 4, 2 => 6, 3 => 8, 4 => 10

Our second array contains

1 => 12, 2 => 134531961, 3 => 12, 4 => 1, 5 => 134560412, 6 => 134891560, 7 => 134575980, 8 => 0, 9 => 134560432

Copy_Terminated_Array copies elements from one pointer to another, up to
and including the terminator.
Copying to the second array
1 => 4, 2 => 6, 3 => 8, 4 => 10, 5 => 12, 6 => 14, 7 => 16, 8 => 0, 9 => 134560432

Copy_Array copies a specific number of elements.

Copying 4 elements from 3 positions ahead, the new array contains
1 => 10, 2 => 12, 3 => 14, 4 => 16, 5 => 12, 6 => 14, 7 => 16, 8 => 0, 9 => 134560432

17.4 Interfaces.C_Streams package

The Interfaces.C_Streams package provides a thin binding to the C stdio library. This is comparable to the gnat.os_lib library, but the binding is "thinner" and covers all C stream operations. Some stdio library functions aren't covered because they can't be represented by Ada. Gnat guarantees these functions will be available, no matter what platform gnat is running under, even if it isn't UNIX-based.

It is also possible to call stdio directly. See the discussion above.

c_streams uses "stream" to refer to a Linux text file.

procedure clearerr(stream : FILEs);
Clear any error associated with the stream.

function fclose(stream : FILEs) return int;
Close a stream.

function fdopen(handle : int; mode : chars) return FILEs;
Open a stream by a handle (UNIX file descriptor).

function feof(stream : FILEs) return int;
Check for the end of stream.

function ferror(stream : FILEs) return int;
Return any error associated with the last stream operation.

functionfflush(stream : FILEs) return int;
Finish writing any outstanding data to the stream.

function fgetc(stream : FILEs) return int;
Read one character from the stream. Characters will be ASCII values between 0 and 255, and can be converted to a character with character'val.

function fgets(strng : chars; n : int; stream : FILEs) return chars;
Read a string from the stream. Note this is not an Ada string.

function fileno(stream : FILEs) return int;
Return the fine number associated with a stream for use with standard Linux file operations.

function fopen( filename : chars; Mode : chars) return FILEs;
Open a stream.

function fputc(C : int; stream : FILEs) return int;
Write one character to a stream. Convert the character to an integer using character'val.

function fputs(Strng : chars; Stream : FILEs) return int;
Write a string of characters to the stream.

function fread( buffer : voids; size : size_t; count : size_t; stream : FILEs) return size_t;
Read count bytes into a buffer of length size and return number of bytes actually read.

function freopen( filename : chars; mode : chars; stream : FILEs) return FILEs;
Reopen the stream with a new mode.

function fseek( stream : FILEs; offset : long; origin : int) return int;
Move offset bytes from the specified origin point.

function ftell(stream : FILEs) return long;
Get stream offset for fseek.

function fwrite( buffer : voids; size : size_t; count : size_t; stream : FILEs) return size_t;
Write count bytes from a buffer of count length and return the number of bytes actually written.

function isatty(handle : int) return int;
[NQS--determine if stream is a TTY device?--KB]

procedure mktemp(template : chars);
Create a random name for a temporary file.

procedure rewind(stream : FILEs);
Move to the start of the stream.

function setvbuf(stream : FILEs; buffer : chars; mode : int; size : size_t) return int;
[NQS--used to know what this did--KB]

procedure tmpnam(string : chars);
[Difference with tmpnam?--KB]
The parameter must be a pointer to a string buffer of at least L_tmpnam bytes (the call with a null parameter is not supported).

function tmpfile return FILEs;
[NQS--KB]

function ungetc(c : int; stream : FILEs) return int;
Back up one character in the stream.

function unlink(filename : chars) return int;
Delete a stream file.

The following are related utility functions added by ACT. They are not standard UNIX functions like the above.

function file_exists(name : chars) return int;
Returns 0 if a file doesn't exist, 1 if it does.

function is_regular_file(handle : int) return int;
Return 1 if given handle is for a regular file, or 0 for some other kind of file.

procedure set_binary_mode( handle : int);
Read text without translation. Only works if compiled with text_translation_required.

procedure set_text_mode( handle : int);
Translate text. Only works if compiled with text_translation_required.

procedure full_name(nam : chars; buffer : chars);
Return the full path of a file as a C string.

The following program demonstrates some of the c_stream functions.

with text_io, unchecked_deallocation, Interfaces.C_Streams;
use text_io, Interfaces.C_Streams;

procedure cstreamtest is

  fd : FILEs;
  line2write : constant string := "This is a test";
  cline2write: constant string := "This is a test" &
    ASCII.NUL;
  path : constant string := "testfile.xxx";
  cpath : constant string := path & ASCII.NUL;
  fileMode : constant string := "w";

  amountWritten : size_t;
  result : int;

begin

  Put_Line( "This is an example of Interfaces.C_Streams" );
  New_Line;

  fd := fopen( cpath'address, fileMode'address );
  if ferror( fd ) = 0 then
    Put_Line( "Opened " & path & " with fopen");
    Put_Line( "Writing '" & line2write & "' with fwrite" );
    amountWritten := fwrite( line2write'address, -- what to write
                             1, -- size of elements
                             line2write'length, -- how many to write
                             fd ); -- to which file

    Put_Line( "Wrote" & amountWritten'img & " characters" );
    New_Line;
    Put_Line( "Writing with fputs" );
    result := fputs( cline2write'address, fd );
    Put_Line( "Result was" & result'img );
    New_Line;

    result := fclose( fd );
    Put_Line( "Closed " & path & " with fclose");
    Put_Line( "Result was" & result'img );
    New_Line;

    result := unlink( cpath'address );
    Put_Line( "Deleted " & path & " with unlink");
    Put_Line( "Result was" & result'img );
  end if;

end cstreamtest;

This is an example of Interfaces.C_Streams

Opened testfile.xxx with fopen
Writing 'This is a test' with fwrite
Wrote 14 characters

Writing with fputs
Result was 1

Closed testfile.xxx with fclose
Result was 0

Deleted testfile.xxx with unlink
Result was 0

17.5 Ada and C Files

• Ada.Direct_IO.C_Streams - a variation of Ada.Direct_IO of reading and writing C direct files.
• Ada.Sequential_IO.C_Streams - a variation of Ada.Sequential_IO for reading and writing C sequential files
• Ada.Streams_Stream_IO.C_Streams
- a package for reading and writing C streams
• Ada.Text_IO.C_Streams
- a package for reading and writing C text files
• Ada.Wide_Text_IO.C_Streams
- a package for reading and writing 16-bit character C text files

procedure MyFortranSubroutine;
pragma import( Fortran, MyFortranSubroutine );

RealVar : float;
pragma import( Fortran, RealVar );

pragma import (Fortran, MyFortranSubroutine, "MyFortranSubroutine_");