Interfaces #

Package Interfaces is the parent of several library packages that declare types and other entities useful for interfacing to foreign languages. It also contains some implementation-defined types that are useful across more than one language (in particular for interfacing to assembly language).

package Interfaces
   with Pure is

   type Integer_n is range -2**(n-1) .. 2**(n-1) - 1;  -- 2's complement

   type Unsigned_n is mod 2**n;

   function Shift_Left            (Value: Unsigned_n; Amount: Natural) return Unsigned_n;
   function Shift_Right           (Value: Unsigned_n; Amount: Natural) return Unsigned_n;
   function Shift_Right_Arithmetic(Value: Unsigned_n; Amount: Natural) return Unsigned_n;
   function Rotate_Left           (Value: Unsigned_n; Amount: Natural) return Unsigned_n;
   function Rotate_Right          (Value: Unsigned_n; Amount: Natural) return Unsigned_n;
end Interfaces;

Signed and modular integer types of n bits, if supported by the target architecture, for each n that is at least the size of a storage element and that is a factor of the word size. The names of these types are of the form Integer_n for the signed types, and Unsigned_n for the modular types;
- For example, for a typical 32-bit machine the corresponding types might be Integer_8, Unsigned_8, Integer_16, Unsigned_16, Integer_32, and Unsigned_32.
For each such modular type in Interfaces, shifting and rotating subprograms as specified in the declaration of Interfaces above. These subprograms are Intrinsic. They operate on a bit-by-bit basis, using the binary representation of the value of the operands to yield a binary representation for the result. The Amount parameter gives the number of bits by which to shift or rotate. For shifting, zero bits are shifted in, except in the case of Shift_Right_Arithmetic, where one bits are shifted in if Value is at least half the modulus.
Floating point types corresponding to each floating point format fully supported by the hardware.
- The names for these floating point types are not specified. However, if IEEE arithmetic is supported, then the names should be IEEE_Float_32 and IEEE_Float_64 for single and double precision, respectively.

Shifting and Rotating

“Shifting” and “rotating” have the conventional meaning. Neither of these terms is usefully defined by the usual normative references of the Reference Manual, so we provide pseudo-code here to describe the intended semantics of the above wording (all operations in these examples are using modular semantics).

function Rotate_Left(Value: Unsigned_n; Amount: Natural) return Unsigned_n is
   Result: Unsigned_n := Value;
   Bit   : Unsigned_n range 0 .. 1;
begin
   for Count in 1 .. Amount loop
      Bit    := Result/2**(n - 1); -- High-bit of Result
      Result := Result*2 + Bit;
   end loop;
   return Result;
end Rotate_Left;

function Rotate_Right(Value: Unsigned_n; Amount: Natural) return Unsigned_n is
   Result: Unsigned_n := Value;
   Bit   : Unsigned_n range 0 .. 1;
begin
   for Count in 1 .. Amount loop
      Bit    := Result mod 2; -- Low-bit of Result
      Result := Result/2 + (Bit * 2**(n - 1));
   end loop;
   return Result;
end Rotate_Right;

function Shift_Left(Value: Unsigned_n; Amount: Natural) return Unsigned_n is
   Result: Unsigned_n := Value;
begin
   for Count in 1 .. Amount loop
      Result := Result * 2;
   end loop;
   return Result;
end Shift_Left;

function Shift_Right(Value: Unsigned_n; Amount: Natural) return Unsigned_n is
   Result: Unsigned_n := Value;
begin
   for Count in 1 .. Amount loop
      Result := Result / 2;
   end loop;
   return Result;
end Shift_Right;

function Shift_Right_Arithmetic(Value: Unsigned_n; Amount: Natural) return Unsigned_n is
   Result: Unsigned_n       := Value;
   Neg   : constant Boolean := Result/2**(n-1) = 1; -- High-bit of Result
begin
   for Count in 1 .. Amount loop
      if Neg then
         Result := Result/2 + 2**(n - 1);
      else
         Result := Result/2;
      end if;
   end loop;
   return Result;
end Shift_Right_Arithmetic;

C #

See Also

Writing Ada Bindings for C Libraries

The facilities relevant to interfacing with the C language and the corresponding subset of the C++ language are the package Interfaces.C and its children, and support for specifying the Convention aspect with convention_identifiers C, C_Pass_By_Copy, and any of the C_Variadic_n conventions.

The identifiers C_Variadic_0, C_Variadic_1, C_Variadic_2, and so on are convention_identifiers. These conventions are said to be C_Variadic. The convention C_Variadic_n is the calling convention for a variadic C function taking n fixed parameters and then a variable number of additional parameters. The C_Variadic_n convention shall only be specified as the convention aspect for a subprogram, or for an access-to-subprogram type, having at least n parameters. A type is compatible with a C_Variadic convention if and only if the type is C-compatible.

The package Interfaces.C contains the basic types, constants, and subprograms that allow an Ada program to pass scalars and strings to C and C++ functions. When this subclause mentions a C entity, the reference also applies to the corresponding entity in C++.

package Interfaces.C
   with pragma Pure is

   -- Declarations based on C's <limits.h>
   CHAR_BIT : constant := <implementation-defined>;  -- typically 8
   SCHAR_MIN: constant := <implementation-defined>;  -- typically –128
   SCHAR_MAX: constant := <implementation-defined>;  -- typically 127
   UCHAR_MAX: constant := <implementation-defined>;  -- typically 255

   -- Signed and Unsigned Integers
   type int   is range <implementation-defined>;
   type short is range <implementation-defined>;
   type long  is range <implementation-defined>;

   type signed_char is range SCHAR_MIN .. SCHAR_MAX;
   for signed_char'Size use CHAR_BIT;

   type unsigned       is mod <implementation-defined>;
   type unsigned_short is mod <implementation-defined>;
   type unsigned_long  is mod <implementation-defined>;

   type unsigned_char is mod (UCHAR_MAX + 1);
   for unsigned_char'Size use CHAR_BIT;

   subtype plain_char is <implementation-defined>;

   type ptrdiff_t is range <implementation-defined>;

   type size_t is mod <implementation-defined>;

   type C_bool is new Boolean;

   -- Floating Point
   type C_float     is digits <implementation-defined>;
   type double      is digits <implementation-defined>;
   type long_double is digits <implementation-defined>;

   -- Characters and Strings 
   type char is <implementation-defined character type>;

   nul: constant char := <implementation-defined>;

   function To_C  (Item: Character) return char;
   function To_Ada(Item: char)      return Character;

   type char_array is array(size_t range <>) of aliased char
      with Pack;
   for char_array'Component_Size use CHAR_BIT;

   function Is_Nul_Terminated(Item: char_array) return Boolean;

   function To_C(Item: String; Append_Nul: Boolean := True) return char_array;
   function To_Ada(Item: char_array; Trim_Nul: Boolean := True) return String;

   procedure To_C  (Item: String    ; Target: out char_array; Count: out size_t ; Append_Nul: Boolean := True);
   procedure To_Ada(Item: char_array; Target: out String    ; Count: out Natural; Trim_Nul  : Boolean := True);

   -- Wide Character and Wide String
   type wchar_t is <implementation-defined character type>;

   wide_nul: constant wchar_t := <implementation-defined>;

   function To_C  (Item: Wide_Character) return wchar_t;
   function To_Ada(Item: wchar_t)        return Wide_Character;

   type wchar_array is array(size_t range <>) of aliased wchar_t
      with Pack;

   function Is_Nul_Terminated(Item: wchar_array) return Boolean;

   function To_C  (Item: Wide_String; Append_Nul: Boolean := True) return wchar_array;
   function To_Ada(Item: wchar_array; Trim_Nul  : Boolean := True) return Wide_String;

   procedure To_C  (Item: Wide_String; Target: out wchar_array; Count: out size_t ; Append_Nul: Boolean := True);
   procedure To_Ada(Item: wchar_array; Target: out Wide_String; Count: out Natural; Trim_Nul  : Boolean := True);

   -- ISO/IEC 10646 compatible types
   type char16_t is <implementation-defined character type>;

   char16_nul: constant char16_t := <implementation-defined>;

   function To_C  (Item: Wide_Character) return char16_t;
   function To_Ada(Item: char16_t)       return Wide_Character;

   type char16_array is array(size_t range <>) of aliased char16_t
      with Pack;

   function Is_Nul_Terminated(Item: char16_array) return Boolean;

   function To_C  (Item: Wide_String ; Append_Nul: Boolean := True) return char16_array;
   function To_Ada(Item: char16_array; Trim_Nul  : Boolean := True) return Wide_String;

   procedure To_C  (Item: Wide_String ; Target: out char16_array; Count: out size_t ; Append_Nul: Boolean := True);
   procedure To_Ada(Item: char16_array; Target: out Wide_String ; Count: out Natural; Trim_Nul  : Boolean := True);

   type char32_t is <implementation-defined character type>;

   char32_nul: constant char32_t := <implementation-defined>;

   function To_C  (Item: Wide_Wide_Character) return char32_t;
   function To_Ada(Item: char32_t)            return Wide_Wide_Character;

   type char32_array is array(size_t range <>) of aliased char32_t
      with Pack;

   function Is_Nul_Terminated(Item: char32_array) return Boolean;

   function To_C  (Item: Wide_Wide_String; Append_Nul: Boolean := True) return char32_array;
   function To_Ada(Item: char32_array    ; Trim_Nul  : Boolean := True) return Wide_Wide_String;

   procedure To_C  (Item: Wide_Wide_String; Target: out char32_array    ; Count: out size_t ; Append_Nul: Boolean := True);
   procedure To_Ada(Item: char32_array    ; Target: out Wide_Wide_String; Count: out Natural; Trim_Nul  : Boolean := True);

   Terminator_Error: exception;
end Interfaces.C;

An Ada procedure corresponds to a void-returning C function.
The programmer can also choose an Ada procedure when the C function returns an int that is to be discarded.
An Ada enumeration type corresponds to a C enumeration type with corresponding enumeration literals having the same internal codes, provided the internal codes fall within the range of the C int type.
An Ada in scalar parameter is passed as a scalar argument to a C function.
An Ada in parameter of an access-to-object type with designated type T is passed as a t* argument to a C function, where t is the C type corresponding to the Ada type T.
An Ada access T parameter, or an Ada out or in out parameter of an elementary type T, is passed as a t* argument to a C function, where t is the C type corresponding to the Ada type T. In the case of an elementary out or in out parameter, a pointer to a temporary copy is used to preserve by-copy semantics.
An Ada parameter of a (record) type T of convention C_Pass_By_Copy, of mode in, is passed as a t argument to a C function, where t is the C struct corresponding to the Ada type T.
An Ada parameter of a record type T, other than an in parameter of a type of convention C_Pass_By_Copy, is passed as a t* argument to a C function, with the const modifier if the Ada mode is in, where t is the C struct corresponding to the Ada type T.
An Ada parameter of an array type with component type T, is passed as a t* argument to a C function, with the const modifier if the Ada mode is in, where t is the C type corresponding to the Ada type T.
An Ada parameter of an access-to-subprogram type is passed as a pointer to a C function whose prototype corresponds to the designated subprogram’s specification.
An Ada parameter of a private type is passed as specified for the full view of the type.
The rules of correspondence given above for parameters of mode in also apply to the return object of a function.
An implementation should provide unsigned_long_long and long_long as 64-bit modular and signed integer types (respectively) in package Interfaces.C if the C implementation supports unsigned long long and long long as 64-bit types.

sizeof

To obtain the effect of C’s sizeof(item_type), where Item_Type is the corresponding Ada type, evaluate the expression: size_t(Item_Type'Size/CHAR_BIT).

Variadic Functions

A variadic C function can correspond to several Ada subprograms, taking various specific numbers and types of parameters.

NULL Termination

Values of type char_array are not implicitly terminated with nul. If a char_array is to be passed as a parameter to an imported C function requiring nul termination, it is the programmer’s responsibility to obtain this effect.

Example Using Interfaces.C

with Interfaces.C;

procedure Test is
   package C renames Interfaces.C;
   use type C.char_array;
   -- Call <string.h> strcpy:
   -- char* strcpy(char* s1, const char* s2);
   -- Note: since the C function's return value is of no interest, the Ada interface is a procedure
   procedure Strcpy(Target: out C.char_array; Source: C.char_array)
      with Import => True, Convention => C, External_Name => "strcpy";

   -- Call <sdtio.h> printf:
   -- int printf(const char* format, ...);
   -- This function writes the C string pointed by format to the standard output (stdout).
   --   If format includes format specifiers (subsequences beginning with %), the additional
   --   arguments following format are formatted and inserted in the resulting string
   --   replacing their respective specifiers. If the number of arguments does not match
   --   the number of format specifiers, or if the types of the arguments do not match
   --   the corresponding format specifier, the behaviour is undefined. On success, the
   --   printf function returns the total number of characters written to the standard output.
   --   If a writing error occurs, a negative number is returned.
   -- Note: since the C function's return value is of no interest, the Ada interface is a procedure
   procedure Printf(Format: C.char_array; Param1: C.char_array; Param2: C.int)
      with Import => True, Convention => C_Variadic_1, External_Name => "printf";

   Chars1: C.char_array(1 .. 20);
   Chars2: C.char_array(1 .. 20);
begin
   Chars2(1 .. 6) := "qwert" & C.nul;
   Strcpy(Chars1, Chars2);
   -- Now Chars1(1 .. 6) = "qwert" & C.Nul
   Printf("The String=%s, Length=%d", Chars1, Chars1'Length);
end Test;

C Strings #

The package Interfaces.C.Strings declares types and subprograms allowing an Ada program to allocate, reference, update, and free C-style strings. In particular, the private type chars_ptr corresponds to a common use of char * in C programs, and an object of this type can be passed to a subprogram to which with Import => True, Convention => C has been specified, and for which char * is the type of the argument of the C function.

package Interfaces.C.Strings
   with Preelaborate, Nonblocking, Global => in out synchronized is

   type char_array_access is access all char_array;
   type chars_ptr is private
      with Preelaborable_Initialization;
   type chars_ptr_array is array(size_t range <>) of aliased chars_ptr;

   Null_Ptr: constant chars_ptr;

   function To_Chars_Ptr(Item: char_array_access; Nul_Check: Boolean := False) return chars_ptr;

   function New_Char_Array(Chars: char_array) return chars_ptr;
   function New_String(Str: String)           return chars_ptr;

   procedure Free(Item: in out chars_ptr);

   Dereference_Error: exception;

   function Value(Item: chars_ptr)                 return char_array;
   function Value(Item: chars_ptr; Length: size_t) return char_array;
   function Value(Item: chars_ptr)                 return String;
   function Value(Item: chars_ptr; Length: size_t) return String;

   function Strlen(Item: chars_ptr) return size_t;

   procedure Update(Item: chars_ptr; Offset: size_t; Chars: char_array; Check: Boolean := True);
   procedure Update(Item: chars_ptr; Offset: size_t; Str  : String    ; Check: Boolean := True);

   Update_Error: exception;
end Interfaces.C.Strings;

Erroneous Execution

Execution of any of the following is erroneous if the Item parameter is not null_ptr and Item does not point to a nul-terminated array of chars:

A Value function not taking a Length parameter
The Free procedure
The Strlen function

Execution of Free(X) is also erroneous if the chars_ptr X was not returned by New_Char_Array or New_String.
Reading or updating a freed char_array is erroneous.
Execution of Update is erroneous if Check is False and a call with Check equal to True would have propagated Update_Error.

C Pointers #

The generic package Interfaces.C.Pointers allows the Ada programmer to perform C-style operations on pointers. It includes an access type Pointer, Value functions that dereference a Pointer and deliver the designated array, several pointer arithmetic operations, and “copy” procedures that copy the contents of a source pointer into the array designated by a destination pointer. As in C, it treats an object Ptr of type Pointer as a pointer to the first element of an array, so that for example, adding 1 to Ptr yields a pointer to the second element of the array.

The generic allows two styles of usage: one in which the array is terminated by a special terminator element; and another in which the programmer keeps track of the length.

generic
   type Index         is (<>);
   type Element       is private;
   type Element_Array is array(Index range <>) of aliased Element;
   Default_Terminator: Element;
package Interfaces.C.Pointers
   with Preelaborate, Nonblocking, Global => in out synchronized is

   type Pointer is access all Element;

   function Value(Ref: Pointer; Terminator: Element := Default_Terminator) return Element_Array;
   function Value(Ref: Pointer; Length: ptrdiff_t)                         return Element_Array;

   Pointer_Error: exception;

   -- C-style Pointer arithmetic
   function "+"(Left: Pointer;   Right: ptrdiff_t) return Pointer   with Convention => Intrinsic;
   function "+"(Left: ptrdiff_t; Right: Pointer)   return Pointer   with Convention => Intrinsic;
   function "-"(Left: Pointer;   Right: ptrdiff_t) return Pointer   with Convention => Intrinsic;
   function "-"(Left: Pointer;   Right: Pointer)   return ptrdiff_t with Convention => Intrinsic;

   procedure Increment(Ref: in out Pointer) with Convention => Intrinsic;
   procedure Decrement(Ref: in out Pointer) with Convention => Intrinsic;

   function Virtual_Length(Ref: Pointer; Terminator: Element := Default_Terminator) return ptrdiff_t;

   procedure Copy_Terminated_Array(Source    : Pointer;
                                   Target    : Pointer;
                                   Limit     : ptrdiff_t := ptrdiff_t'Last;
                                   Terminator: Element   := Default_Terminator);
   procedure Copy_Array(Source: Pointer; Target: Pointer; Length: ptrdiff_t);
end Interfaces.C.Pointers;

Erroneous Execution

It is erroneous to dereference a Pointer that does not designate an aliased Element.
Execution of Value(Ref, Terminator) is erroneous if Ref does not designate an aliased Element in an Element_Array terminated by Terminator.
Execution of Value(Ref, Length) is erroneous if Ref does not designate an aliased Element in an Element_Array containing at least Length Elements between the designated Element and the end of the array, inclusive.
Execution of Virtual_Length(Ref, Terminator) is erroneous if Ref does not designate an aliased Element in an Element_Array terminated by Terminator.
Execution of Copy_Terminated_Array(Source, Target, Limit, Terminator) is erroneous in either of the following situations:

Execution of both Value(Source, Terminator) and Value(Source, Limit) are erroneous, or
Copying writes past the end of the array containing the Element designated by Target.

Execution of Copy_Array(Source, Target, Length) is erroneous if either Value(Source, Length) is erroneous, or copying writes past the end of the array containing the Element designated by Target.
To compose a Pointer from an Element_Array, use 'Access on the first element. For example (assuming appropriate instantiations):

Some_Array  : Element_Array(0 .. 5);
Some_Pointer: Pointer := Some_Array(0)'Access;

Examples of Using Interfaces.C.Pointers

with Interfaces.C.Pointers;
with Interfaces.C.Strings;

procedure Test_Pointers is
   package C renames Interfaces.C;
   package Char_Ptrs is new C.Pointers(Index              => C.size_t,
                                       Element            => C.char,
                                       Element_Array      => C.char_array,
                                       Default_Terminator => C.nul);
   use type Char_Ptrs.Pointer;
   subtype Char_Star is Char_Ptrs.Pointer;

   procedure Strcpy(Target_Ptr, Source_Ptr: Char_Star) is
      Target_Temp_Ptr: Char_Star := Target_Ptr;
      Source_Temp_Ptr: Char_Star := Source_Ptr;
      Element        : C.char;
   begin
      if Target_Temp_Ptr = null or Source_Temp_Ptr = null then
         raise C.Strings.Dereference_Error;
      end if;

      loop
         Element             := Source_Temp_Ptr.all;
         Target_Temp_Ptr.all := Element;
         exit when C."="(Element, C.nul);
         Char_Ptrs.Increment(Target_Temp_Ptr);
         Char_Ptrs.Increment(Source_Temp_Ptr);
      end loop;
   end Strcpy;
begin
   ...
end Test_Pointers;

Unchecked Unions #

Specifying aspect Unchecked_Union to have the value True defines an interface correspondence between a given discriminated type and some C union. The aspect requires that the associated type shall be given a representation that allocates no space for its discriminant(s).

type T(Flag: Boolean := False) is record
   case Flag is
   when False => F1: Float   := 0.0;
   when True  => F2: Integer := 0;
   end case;
end record with Unchecked_Union;

X: T;
Y: Integer := X.F2; -- erroneous

COBOL #

The facilities relevant to interfacing with the COBOL language are the package Interfaces.COBOL and support for specifying the Convention aspect with convention_identifier COBOL.

The COBOL interface package supplies several sets of facilities:

A set of types corresponding to the native COBOL types of the supported COBOL implementation (so-called “internal COBOL representations”), allowing Ada data to be passed as parameters to COBOL programs
A set of types and constants reflecting external data representations such as can might be found in files or databases, allowing COBOL-generated data to be read by an Ada program, and Ada-generated data to be read by COBOL programs

A generic package for converting between an Ada decimal type value and either an internal or external COBOL representation

package Interfaces.COBOL
   with Preelaborate, Nonblocking, Global => in out synchronized is

   -- Types and operations for internal data representations
   type Floating      is digits <implementation-defined>;
   type Long_Floating is digits <implementation-defined>;

   type Binary      is range <implementation-defined>;
   type Long_Binary is range <implementation-defined>;

   Max_Digits_Binary     : constant := <implementation-defined>;
   Max_Digits_Long_Binary: constant := <implementation-defined>;

   type Decimal_Element is mod <implementation-defined>;
   type Packed_Decimal  is array(Positive range <>) of Decimal_Element
      with Pack;

   type COBOL_Character is <implementation-defined character type>;

   Ada_To_COBOL: array(Character)       of COBOL_Character := <implementation-defined>;
   COBOL_To_Ada: array(COBOL_Character) of Character       := <implementation-defined>;

   type Alphanumeric is array(Positive range <>) of COBOL_Character
      with Pack;

   function To_COBOL(Item: String)       return Alphanumeric;
   function To_Ada  (Item: Alphanumeric) return String;

   procedure To_COBOL(Item: String      ; Target: out Alphanumeric; Last: out Natural);
   procedure To_Ada  (Item: Alphanumeric; Target: out String      ; Last: out Natural);

   type Numeric is array(Positive range <>) of COBOL_Character
      with Pack;

   -- Formats for COBOL data representations
   type Display_Format is private;

   Unsigned            : constant Display_Format;
   Leading_Separate    : constant Display_Format;
   Trailing_Separate   : constant Display_Format;
   Leading_Nonseparate : constant Display_Format;
   Trailing_Nonseparate: constant Display_Format;

   type Binary_Format is private;

   High_Order_First: constant Binary_Format;
   Low_Order_First : constant Binary_Format;
   Native_Binary   : constant Binary_Format;

   type Packed_Format is private;

   Packed_Unsigned: constant Packed_Format;
   Packed_Signed  : constant Packed_Format;

   -- Types for external representation of COBOL binary data

   type Byte is mod 2**COBOL_Character'Size;
   type Byte_Array is array(Positive range <>) of Byte
      with Pack;

   Conversion_Error: exception;

   generic
      type Num is delta <> digits <>;
   package Decimal_Conversions is
      -- Display Formats: data values are represented as Numeric
      function Valid (Item: Numeric; Format: Display_Format) return Boolean;
      function Length(               Format: Display_Format) return Natural;

      function To_Decimal(Item: Numeric; Format: Display_Format) return Num;
      function To_Display(Item: Num    ; Format: Display_Format) return Numeric;

      -- Packed Formats: data values are represented as Packed_Decimal
      function Valid (Item: Packed_Decimal; Format: Packed_Format) return Boolean;
      function Length(                      Format: Packed_Format) return Natural;

      function To_Decimal(Item: Packed_Decimal; Format: Packed_Format) return Num;
      function To_Packed (Item: Num           ; Format: Packed_Format) return Packed_Decimal;

      -- Binary Formats: external data values are represented as Byte_Array
      function Valid (Item: Byte_Array; Format: Binary_Format) return Boolean;
      function Length(                  Format: Binary_Format) return Natural;

      function To_Decimal(Item: Byte_Array; Format: Binary_Format) return Num;
      function To_Binary (Item: Num       ; Format: Binary_Format) return Byte_Array;

      -- Internal Binary formats: data values are of type Binary or Long_Binary
      function To_Decimal(Item: Binary)      return Num;
      function To_Decimal(Item: Long_Binary) return Num;

      function To_Binary     (Item: Num) return Binary;
      function To_Long_Binary(Item: Num) return Long_Binary;
   end Decimal_Conversions;
end Interfaces.COBOL;

Examples of Interfaces.COBOL

Calling a foreign COBOL program

with Interfaces.COBOL;
procedure Test_Call is
   -- Assume that a COBOL program PROG has the following declaration
   --  in its LINKAGE section:
   --  01 Parameter-Area
   --     05 NAME   PIC X(20).
   --     05 SSN    PIC X(9).
   --     05 SALARY PIC 99999V99 USAGE COMP.
   -- The effect of PROG is to update SALARY based on some algorithm
   package COBOL renames Interfaces.COBOL;

   type Salary_Type is delta 0.01 digits 7;
   type COBOL_Record is record
      Name  : COBOL.Numeric(1 .. 20);
      SSN   : COBOL.Numeric(1 .. 9);
      Salary: COBOL.Binary;  -- Assume Binary = 32 bits
   end record with Convention => COBOL;

   procedure Prog(Item: in out COBOL_Record)
      with Import => True, Convention => COBOL;

   package Salary_Conversions is new COBOL.Decimal_Conversions(Salary_Type);

   Some_Salary: Salary_Type  := 12_345.67;
   Some_Record: COBOL_Record := (Name   => "Johnson, John       ",
                                 SSN    => "111223333",
                                 Salary => Salary_Conversions.To_Binary(Some_Salary));
begin
   Prog(Some_Record);
   ...
end Test_Call;

Using data created by a COBOL program

with Interfaces.COBOL;
with COBOL_Sequential_IO; -- Assumed to be supplied by implementation

procedure Test_External_Formats is
   -- Assume that a COBOL program has created a sequential file with
   --  the following record structure, and that we want
   --  process the records in an Ada program
   --  01 EMPLOYEE-RECORD
   --     05 NAME    PIC X(20).
   --     05 SSN     PIC X(9).
   --     05 SALARY  PIC 99999V99 USAGE COMP.
   --     05 ADJUST  PIC S999V999 SIGN LEADING SEPARATE.
   -- The COMP data is binary (32 bits), high-order byte first
   package COBOL renames Interfaces.COBOL;

   type Salary_Type      is delta 0.01  digits 7;
   type Adjustments_Type is delta 0.001 digits 6;

   type COBOL_Employee_Record_Type is record -- External representation
      Name  : COBOL.Alphanumeric(1 .. 20);
      SSN   : COBOL.Alphanumeric(1 .. 9);
      Salary: COBOL.Byte_Array(1 .. 4);
      Adjust: COBOL.Numeric(1 .. 7);  -- Sign and 6 digits
   end record with Convention => COBOL;

   package COBOL_Employee_IO is new COBOL_Sequential_IO(COBOL_Employee_Record_Type);
   use COBOL_Employee_IO;

   COBOL_File: File_Type;

   type Ada_Employee_Record_Type is record -- Internal representation
      Name  : String(1 .. 20);
      SSN   : String(1 .. 9);
      Salary: Salary_Type;
      Adjust: Adjustments_Type;
   end record;

   COBOL_Record: COBOL_Employee_Record_Type;
   Ada_Record  : Ada_Employee_Record_Type;

   package Salary_Conversions is new COBOL.Decimal_Conversions(Salary_Type);
   use Salary_Conversions;

   package Adjustments_Conversions is new COBOL.Decimal_Conversions(Adjustments_Type);
   use Adjustments_Conversions;
begin
   Open(COBOL_File, Name => "Some_File");
   loop
      Read(COBOL_File, COBOL_Record);

      Ada_Record.Name   := COBOL.To_Ada(COBOL_Record.Name);
      Ada_Record.SSN    := COBOL.To_Ada(COBOL_Record.SSN);
      Ada_Record.Salary := To_Decimal(COBOL_Record.Salary, COBOL.High_Order_First);
      Ada_Record.Adjust := To_Decimal(COBOL_Record.Adjust, COBOL.Leading_Separate);
      ... -- Process Ada_Record
   end loop;
exception
   when End_Error => ...
end Test_External_Formats;

Fortran #

The facilities relevant to interfacing with the Fortran language are the package Interfaces.Fortran and support for specifying the Convention aspect with convention_identifier Fortran.

The package Interfaces.Fortran defines Ada types whose representations are identical to the default representations of the Fortran intrinsic types Integer, Real, Double Precision, Complex, Logical, and Character in a supported Fortran implementation. These Ada types can therefore be used to pass objects between Ada and Fortran programs.

with Ada.Numerics.Generic_Complex_Types;

pragma Elaborate_All(Ada.Numerics.Generic_Complex_Types);

package Interfaces.Fortran
   with pragma Pure is

   type Fortran_Integer is range <implementation-defined>;

   type Real             is digits <implementation-defined>;
   type Double_Precision is digits <implementation-defined>;

   type Logical is new Boolean;

   package Single_Precision_Complex_Types is new Ada.Numerics.Generic_Complex_Types(Real);

   type Complex is new Single_Precision_Complex_Types.Complex;

   subtype Imaginary is Single_Precision_Complex_Types.Imaginary;
   i: Imaginary renames Single_Precision_Complex_Types.i;
   j: Imaginary renames Single_Precision_Complex_Types.j;

   package Double_Precision_Complex_Types is new Ada.Numerics.Generic_Complex_Types(Double_Precision);

   type    Double_Complex   is new Double_Precision_Complex_Types.Complex;
   subtype Double_Imaginary is     Double_Precision_Complex_Types.Imaginary;

   type Character_Set is <implementation-defined character type>;

   type Fortran_Character is array(Positive range <>) of Character_Set
      with Pack;

   function To_Fortran(Item: Character)     return Character_Set;
   function To_Ada    (Item: Character_Set) return Character;

   function To_Fortran(Item: String)            return Fortran_Character;
   function To_Ada    (Item: Fortran_Character) return String;

   procedure To_Fortran(Item: String           ; Target: out Fortran_Character; Last: out Natural);
   procedure To_Ada    (Item: Fortran_Character; Target: out String           ; Last: out Natural);
end Interfaces.Fortran;

Interfaces.Fortran

with Interfaces.Fortran; use Interfaces.Fortran;

procedure Ada_Application is
   type Fortran_Matrix is array(Fortran_Integer range <>, Fortran_Integer range <>) of Double_Precision
      with Convention => Fortran; -- stored in Fortran's column-major order

   procedure Invert(Rank: Fortran_Integer; X: in out Fortran_Matrix)
      with Import => True, Convention => Fortran; -- a Fortran subroutine

   Rank     : constant Fortran_Integer := 100;
   My_Matrix: Fortran_Matrix (1 .. Rank, 1 .. Rank);
   Precision: constant := 6;

   type Standard_Deviation is digits Precision
      with Convention => Fortran;

   Deviation: Standard_Deviation;
      -- Declarations to match the following Fortran declarations:
      --   integer, parameter :: precision = selected_real_kind(p=6)
      --   real(precision) :: deviation
begin
   ...
   My_Matrix := ...;
   ...
   Invert(Rank, My_Matrix);
   ...
   Deviation := ...;
   ...
end Ada_Application;

Interfaces#

C#

C Strings#

C Pointers#

Unchecked Unions#

COBOL#

Fortran#