How to do vararg in GNAT Ada

General
1

Since it came to question if Ada can call C vararg-ed function I post here an example how to do this on example of printf. Notes:

  1. Though the example illustrates a fixed argument list, it is fully dynamic, you can pass any lists.
  2. It can be rewritten without C code, but I did not want to browse include files for cryptic definitions and mapping idiotic C structures.
  3. libffi is used. AFAIK, all those disgusting languages like Rust, Python etc fall back to libffi to call disgusting C functions like printf. :grinning:

The project:

project Vararg is
   for Languages use ("Ada", "C");
   for Main use ("vararg.adb");
   for Source_Files use ("vararg.adb", "push_and_call.c");
   package Linker is
      for Default_Switches ("Ada") use ("-lffi");
   end Linker;
end Vararg;

The C part:

#include <ffi.h>
#include <stddef.h>

ffi_type * FFI_void    () { return &ffi_type_void;    }
ffi_type * FFI_uint    () { return &ffi_type_uint;    }
ffi_type * FFI_sint    () { return &ffi_type_sint;    }
ffi_type * FFI_uint8   () { return &ffi_type_uint8;   }
ffi_type * FFI_sint8   () { return &ffi_type_sint8;   }
ffi_type * FFI_uint16  () { return &ffi_type_uint16;  }
ffi_type * FFI_sint16  () { return &ffi_type_sint16;  }
ffi_type * FFI_uint32  () { return &ffi_type_uint32;  }
ffi_type * FFI_sint32  () { return &ffi_type_sint32;  }
ffi_type * FFI_uint64  () { return &ffi_type_uint64;  }
ffi_type * FFI_sint64  () { return &ffi_type_sint64;  }
ffi_type * FFI_float   () { return &ffi_type_float;   }
ffi_type * FFI_double  () { return &ffi_type_double;  }
ffi_type * FFI_pointer () { return &ffi_type_pointer; }

/* Push arguments on the stack, call function, clean up */

int push_and_call 
    (  void     * Callee (void),     // Function to call
       void     * Arguments [],      // Arguments (null-terminated)
       ffi_arg  * Result,            // The result address or value (if fits in)
       unsigned   Fixed_Length,      // Arguments count before ellipsis
       unsigned   Variadic_Length,   // Arguments count inside ellipsis
       ffi_type * Argument_Types [], // Argument types (null-terminated)
       ffi_type * Result_Type        // Result type
    )
{
   ffi_cif cif;
   ffi_status status;

   status = ffi_prep_cif_var
            (  &cif,
               FFI_DEFAULT_ABI,
               Fixed_Length,
               Variadic_Length + Fixed_Length,
               Result_Type,
               Argument_Types
            );
   if (status == FFI_OK)
   {
      ffi_call(&cif, FFI_FN (*Callee), Result, Arguments);
   }
   return status;
}

The Ada test:

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

procedure Vararg is

   type ffi_type is new System.Address;
   FFI_NULL : constant ffi_type := ffi_type (System.Null_Address);
   function FFI_void return ffi_type;
   pragma Import (C, FFI_void, "FFI_void");
   function FFI_uint return ffi_type;
   pragma Import (C, FFI_uint, "FFI_uint");
   function FFI_sint return ffi_type;
   pragma Import (C, FFI_sint, "FFI_sint");
   function FFI_uint8 return ffi_type;
   pragma Import (C, FFI_uint8, "FFI_uint8");
   function FFI_sint8 return ffi_type;
   pragma Import (C, FFI_sint8, "FFI_sint8");
   function FFI_uint16 return ffi_type;
   pragma Import (C, FFI_uint16, "FFI_uint16");
   function FFI_sint16 return ffi_type;
   pragma Import (C, FFI_sint16, "FFI_sint16");
   function FFI_uint32 return ffi_type;
   pragma Import (C, FFI_uint32, "FFI_uint32");
   function FFI_sint32 return ffi_type;
   pragma Import (C, FFI_sint32, "FFI_sint32");
   function FFI_uint64 return ffi_type;
   pragma Import (C, FFI_uint64, "FFI_uint64");
   function FFI_sint64 return ffi_type;
   pragma Import (C, FFI_sint64, "FFI_sint64");
   function FFI_float return ffi_type;
   pragma Import (C, FFI_float, "FFI_float");
   function FFI_double return ffi_type;
   pragma Import (C, FFI_double, "FFI_double");
   function FFI_pointer return ffi_type;
   pragma Import (C, FFI_pointer, "FFI_pointer");
   
   FFI_OK          : constant := 0;
   FFI_BAD_TYPEDEF : constant := 1;
   FFI_BAD_ABI     : constant := 2;
   FFI_BAD_ARGTYPE : constant := 3;

   type ffi_arg is new long;
   
   function push_and_call
            (  Callee          : System.Address;
               Arguments       : access constant System.Address;
               Result          : access ffi_arg;
               Fixed_Length    : unsigned;
               Variadic_Length : unsigned;
               Argument_Types  : access constant ffi_type;
               Result_Type     : ffi_type
            )  return int;
   pragma Import (C, push_and_call);

   function Printf (Format : String; Value_1 : double; Value_2 : int)
      return int is
      procedure C_Printf;
      pragma Import (C, C_Printf, "printf");
      Argument_Types  : constant array (1..4) of aliased ffi_type :=
                           (FFI_Pointer, FFI_double, FFI_sint, FFI_Null);
      Result_Value    : aliased ffi_arg;
      Result_Type     : constant ffi_type := FFI_sint;
      Status          : int;
      F : aliased char_array     := To_C (Format);
      P : aliased System.Address := F'Address;
      D : aliased double := Value_1;
      I : aliased int    := Value_2;
      Argument_Values : constant array (1..4)
                           of aliased System.Address :=
         (P'Address, D'Address, I'Address, System.Null_Address);
   begin
      Status := push_and_call
                (  C_Printf'Address,
                   Argument_Values (Argument_Values'First)'Access,
                   Result_Value'Access,
                   1,
                   2,
                   Argument_Types (Argument_Types'First)'Access,
                   Result_Type
                );
       if Status /= FFI_OK then
          raise Program_Error;
       else
          return int (Result_Value);
       end if;
   end Printf;
   
   Result : int;
begin
   Result := Printf ("%.5g, %d" & Character'Val (10), 3.14159, 7);
   Put_Line ("Result:" & int'Image (Result));
end Vararg;

Output:

4.1416, 7
Result: 10
3 Likes
2

That’s NOT varargs.

va_start, va_arg, va_end, etc. are all macros. Actually in gcc they are intrinsics now, probably due to the mess they cause.

You can’t create function something (arg1 : type1; ...); in Ada. Which means, you also cannot bind to any C function like, e.g. int execl(const char *path, const char *arg0, ... /*, (char *)0 */); or write it in such a way that you don’t need a C stub to pass to Ada. Which is what you’ve done.

That WAS the point, which you have proved.

3

These are irrelevant, Ada has a different calling convention. For interfacing C in the oppositive direction: C → Ada nobody and nothing forces you to use ellipsis.

Why should I? It is untyped. If I have to pass a collection of arguments in Ada I would simply use an array or other container.

Of course I can. See the code sample.

All libffi calls and structures can be interfaced from Ada without C code. I was too lazy to do so, it was just a small exercise, not a production code. Furthermore, there are normal calls to spawn a process in Linux which have argument lists without ellipsis.

If you want to implement vararg without libffi from scratch, you need assembly insertions. Note that this is not Ada specific in any way, because to do that in C you would need assembly code as well (in order to directly manipulate the stack). GCC offers a set of macros for that:

You can translate them to Ada, which supports Assembly insertions if you care so much…

1 Like