cd ffademo
gprbuild

using project file ffa_demo.gpr
gcc -c -O2 -fdump-scos -gnata -fstack-check -fdata-sections -ffunction-sections ffa_demo.adb
gcc -c -O2 -fdump-scos -gnata -fstack-check -fdata-sections -ffunction-sections
-gnatec=/home/you/ffa/libffa/restrict.adc word_ops.adb
gcc -c -O2 -fdump-scos -gnata -fstack-check -fdata-sections -ffunction-sections
-gnatec=/home/you/ffa/libffa/restrict.adc fz_type.ads
gcc -c -O2 -fdump-scos -gnata -fstack-check -fdata-sections -ffunction-sections
-gnatec=/home/you/ffa/libffa/restrict.adc fz_arith.adb
gcc -c -O2 -fdump-scos -gnata -fstack-check -fdata-sections -ffunction-sections
-gnatec=/home/you/ffa/libffa/restrict.adc w_shifts.ads
gcc -c -O2 -fdump-scos -gnata -fstack-check -fdata-sections -ffunction-sections
-gnatec=/home/you/ffa/libffa/restrict.adc iron.ads
gcc -c -O2 -fdump-scos -gnata -fstack-check -fdata-sections -ffunction-sections
-gnatec=/home/you/ffa/libffa/restrict.adc words.ads
gcc -c -O2 -fdump-scos -gnata -fstack-check -fdata-sections -ffunction-sections demo_ch1.adb
gcc -c -O2 -fdump-scos -gnata -fstack-check -fdata-sections -ffunction-sections ffa_io.adb
gprlib FFA.lexch
ar cr /home/you/ffa/libffa/lib/libFFA.a /home/you/ffa/libffa/obj/word_ops.o
/home/you/ffa/libffa/obj/fz_type.o ...
ranlib libFFA.a
gprbind ffa_demo.bexch
gnatbind ffa_demo.ali
gcc -c b__ffa_demo.adb
gcc ffa_demo.o -Wl,--gc-sections -static -o ffa_demo

gprbuild -Xmode=debug

pragma Restrictions(Immediate_Reclamation);
pragma Restrictions(Max_Asynchronous_Select_Nesting => 0);
pragma Restrictions(Max_Protected_Entries => 0);
pragma Restrictions(Max_Select_Alternatives => 0);
pragma Restrictions(Max_Task_Entries => 0);
pragma Restrictions(Max_Tasks => 0);
pragma Restrictions(No_Abort_Statements);
pragma Restrictions(No_Access_Parameter_Allocators);
pragma Restrictions(No_Allocators);
pragma Restrictions(No_Asynchronous_Control);
pragma Restrictions(No_Calendar);
pragma Restrictions(No_Coextensions);
pragma Restrictions(No_Default_Stream_Attributes);
pragma Restrictions(No_Delay);
pragma Restrictions(No_Dispatch);
pragma Restrictions(No_Dispatching_Calls);
pragma Restrictions(No_Dynamic_Attachment);
pragma Restrictions(No_Dynamic_Priorities);
pragma Restrictions(No_Entry_Calls_In_Elaboration_Code);
pragma Restrictions(No_Entry_Queue);
pragma Restrictions(No_Enumeration_Maps);
pragma Restrictions(No_Exception_Propagation);
pragma Restrictions(No_Exception_Registration);
pragma Restrictions(No_Finalization);
pragma Restrictions(No_Fixed_Io);
pragma Restrictions(No_Floating_Point);
pragma Restrictions(No_Implementation_Aspect_Specifications);
pragma Restrictions(No_Implementation_Units);
pragma Restrictions(No_Implicit_Aliasing);
pragma Restrictions(No_Implicit_Conditionals);
pragma Restrictions(No_Implicit_Dynamic_Code);
pragma Restrictions(No_Implicit_Heap_Allocations);
pragma Restrictions(No_Implicit_Protected_Object_Allocations);
pragma Restrictions(No_Implicit_Task_Allocations);
pragma Restrictions(No_Initialize_Scalars);
pragma Restrictions(No_Local_Protected_Objects);
pragma Restrictions(No_Local_Timing_Events);
pragma Restrictions(No_Multiple_Elaboration);
pragma Restrictions(No_Nested_Finalization);
pragma Restrictions(No_Protected_Type_Allocators);
pragma Restrictions(No_Protected_Types);
pragma Restrictions(No_Relative_Delay);
pragma Restrictions(No_Requeue_Statements);
pragma Restrictions(No_Secondary_Stack);
pragma Restrictions(No_Select_Statements);
pragma Restrictions(No_Specific_Termination_Handlers);
pragma Restrictions(No_Standard_Allocators_After_Elaboration);
pragma Restrictions(No_Stream_Optimizations);
pragma Restrictions(No_Streams);
pragma Restrictions(No_Task_Allocators);
pragma Restrictions(No_Task_At_Interrupt_Priority);
pragma Restrictions(No_Task_Attributes_Package);
pragma Restrictions(No_Task_Hierarchy);
pragma Restrictions(No_Tasking);
pragma Restrictions(No_Task_Termination);
pragma Restrictions(No_Terminate_Alternatives);
pragma Restrictions(No_Unchecked_Access);
pragma Restrictions(No_Unchecked_Conversion);
pragma Restrictions(No_Unchecked_Deallocation);
pragma Restrictions(No_Wide_Characters);
pragma Restrictions(Pure_Barriers);
pragma Restrictions(Simple_Barriers);
pragma Restrictions(Static_Priorities);
pragma Restrictions(Static_Storage_Size);
pragma Validity_Checks(ALL_CHECKS);

project FFA is
 
  for Object_Dir use "obj";
 
  type Mode_Type is ("debug", "release");
  Mode : Mode_Type := external ("mode", "release");
 
  for Languages         use ("Ada");
  for Source_Dirs       use (".");
  for Library_Dir       use "lib";
  for Library_Name      use "FFA";
  for Library_Kind      use "static";
 
  package Binder is
     case Mode is
        when "debug" =>
           for Switches ("Ada")
             use ();
        when "release" =>
           for Switches ("Ada")
             use ("-static", "-r");
     end case;
  end Binder;
 
  package Builder is
     for Switches ("Ada")
       use ("-nostdlib");
  end Builder;
 
  package Compiler is
     case Mode is
        when "debug" =>
           for Switches ("Ada")
             use ("-g");
        when "release" =>
           for Switches ("Ada")
             use ("-O2", "-fdump-scos", "-gnata", "-fstack-check",
                  "-fdata-sections", "-ffunction-sections",
                  "-gnatec=" & FFA'Project_Dir & "restrict.adc");
     end case;
  end Compiler;
 
end FFA;

package Iron is
 
   pragma Pure;
 
   --------------------------------------
   -------- For a 64-bit system: --------
   --------------------------------------
   MachineBitness     : constant Positive := 64;
   MachineBitnessLog2 : constant Positive := 6; -- log2(64)
   --------------------------------------
 
   -- Bits per Byte
   ByteBits           : constant Positive := 8;
 
end Iron;

   ------------------------------------
   ------ For a 32-bit system: --------
   ------------------------------------
     MachineBitness     : constant Positive := 32;
     MachineBitnessLog2 : constant Positive := 5; -- log2(32)
   ------------------------------------

with Iron;
 
package Words is
 
   pragma Pure;
 
   -- The most fundamental fact about Word: width.
   Bitness     : constant Positive := Iron.MachineBitness;
 
   -- It is possible to calculate BitnessLog2 at elaboration time,
   -- but we will avoid having ~any~ elaboration at all in FFA.
   BitnessLog2 : constant Positive := Iron.MachineBitnessLog2;
 
   -- The Word width, expressed in ~bytes~:
   Byteness    : constant Positive := Bitness / Iron.ByteBits;
 
   -- What kind of words to use. Must be machine-word or smaller.
   type Word is mod 2**Bitness;
   for Word'Size use Bitness;
 
   -- The very same Word, but its only legal values are 0 and 1.
   subtype WBool is Word range 0 .. 1;
 
   -- When we must refer to individual bit positions of a machine word:
   subtype WBit_Index is Natural range 0 .. Bitness - 1;
 
end Words;

with Words; use Words;
 
package W_Shifts is
 
   pragma Pure;
 
   function Shift_Left
     (Value  : Word;
      Amount : Natural)
     return    Word;
   pragma Import(Intrinsic, Shift_Left);
 
   function Shift_Right
     (Value  : Word;
      Amount : Natural)
     return    Word;
   pragma Import(Intrinsic, Shift_Right);
 
   function Rotate_Left
     (Value  : Word;
      Amount : Natural)
     return    Word;
   pragma Import(Intrinsic, Rotate_Left);
 
   function Rotate_Right
     (Value  : Word;
      Amount : Natural)
     return    Word;
   pragma Import(Intrinsic, Rotate_Right);
 
end W_Shifts;

with Words; use Words;
 
-- Fundamental Operations on Words:
package Word_Ops is
 
   pragma Pure;
 
   -- Branch-free calculation of 'carry' from a machine-word addition.
   function W_Carry(A : in Word; B : in Word; S : in Word)
                   return WBool;
 
   -- Branch-free calculation of 'borrow' from a machine-word subtraction.
   function W_Borrow(A : in Word; B : in Word; D : in Word)
                    return WBool;
 
   -- Without any branching: if Sel == 0, return A; if Sel == 1, return B.
   function W_Mux(A : in Word; B : in Word; Sel : in WBool)
                 return Word;
 
   -- Exchange A and B.
   procedure W_Swap(A : in out Word; B : in out Word);
 
end Word_Ops;

with W_Shifts; use W_Shifts;
 
-- Fundamental Operations on Words:
package body Word_Ops is

   -- Find the Carry, from an addition where it is known that A + B == S:
   function W_Carry(A : in Word; B : in Word; S : in Word)
                   return WBool is
   begin
      return WBool(Shift_Right((A and B) or ((A or B) and (not S)),
                               Bitness - 1));
   end W_Carry;
   pragma Inline_Always(W_Carry);
 
   -- Find the Borrow, from a subtraction where it is known that A - B == D:
   function W_Borrow(A : in Word; B : in Word; D : in Word)
                    return WBool is
   begin
      return WBool(Shift_Right(((not A) and B) or (((not A) or B) and D),
                               Bitness - 1));
   end W_Borrow;
   pragma Inline_Always(W_Borrow);

A+B+C is the output bit of 1-bit adder; C is carry-in;
A-B-C is the output bit of 1-bit subber; C is borrow-in.
Observe that A+B+C is equal to A-B-C for all A,B,C !
+-+-+-+-----+--------------+-----+----------------+
|           | 'Carry' out: |     | 'Borrow' out:  |
+-+-+-+-----+--------------+-----+----------------+
| | | |     |(a and b) or  |     |(~a and b) or   |
|A|B|C|A+B+C| ((a or b) and|A-B-C| ((~a or b) and |
| | | |     |    ~(A+B+C)) |     |    (A-B-C))    |
+-+-+-+-----+--------------+-----+----------------+
|0|0|0|  0  |      0       |  0  |       0        |
+-+-+-+-----+--------------+-----+----------------+
|1|0|0|  1  |      0       |  1  |       0        |
+-+-+-+-----+--------------+-----+----------------+
|0|1|0|  1  |      0       |  1  |       1        |
+-+-+-+-----+--------------+-----+----------------+
|1|1|0|  0  |      1       |  0  |       0        |
+-+-+-+-----+--------------+-----+----------------+
|0|0|1|  1  |      0       |  1  |       1        |
+-+-+-+-----+--------------+-----+----------------+
|1|0|1|  0  |      1       |  0  |       0        |
+-+-+-+-----+--------------+-----+----------------+
|0|1|1|  0  |      1       |  0  |       1        |
+-+-+-+-----+--------------+-----+----------------+
|1|1|1|  1  |      1       |  1  |       1        |
+-+-+-+-----+--------------+-----+----------------+
--- This base case extends to any N bit register, since
--- both equations depend ~strictly~ on A, B, and C.

   -- Without any branching: if Sel == 0, return A; if Sel == 1, return B.
   function W_Mux(A : in Word; B : in Word; Sel : in WBool) return Word is
   begin
      return B xor ((Sel - 1) and (A xor B));
   end W_Mux;
   pragma Inline_Always(W_Mux);
 
   -- Exchange A and B.
   procedure W_Swap(A : in out Word; B : in out Word) is
   begin
      A := A xor B;
      B := A xor B;
      A := A xor B;
   end W_Swap;
   pragma Inline_Always(W_Swap);
 
end Word_Ops;

with Words; use Words;
 
package FZ_Type is
 
   pragma Pure;
 
   -- Indices of all indexable items:
   type Indices is new Natural;
 
   -- Index of a particular Word in an FZ:
   subtype Word_Index is Indices;
 
   -- The FZ, in person! I.e. a bignum of permanently fixed bitness.
   type FZ is array(Word_Index range <>) of Word;
 
   -- A count of Words in an FZ (cannot be 0):
   subtype Word_Count is Indices range 1 .. Indices'Last;
 
   -- An index of a particular ~bit~ in an FZ:
   subtype FZBit_Index is Indices;
 
end FZ_Type;

with Words;   use Words;
with FZ_Type; use FZ_Type;
 
-- Fundamental Arithmetic operators on FZ:
package FZ_Arith is
 
   pragma Pure;
 
   -- Sum := X + Y; Overflow := Carry
   procedure FZ_Add(X          : in    FZ;
                    Y          : in    FZ;
                    Sum        : out   FZ;
                    Overflow   : out   WBool);
   pragma Precondition(X'Length = Y'Length and X'Length = Sum'Length);
 
   -- Difference := X - Y; Underflow := Borrow
   procedure FZ_Sub(X          : in  FZ;
                    Y          : in  FZ;
                    Difference : out FZ;
                    Underflow  : out WBool);
   pragma Precondition(X'Length = Y'Length and X'Length = Difference'Length);
 
end FZ_Arith;

with Word_Ops; use Word_Ops;
 
-- Fundamental Arithmetic operators on FZ:
package body FZ_Arith is
 
   -- Sum := X + Y; Overflow := Carry
   procedure FZ_Add(X          : in  FZ;
                    Y          : in  FZ;
                    Sum        : out FZ;
                    Overflow   : out WBool) is
      Carry : WBool := 0;
   begin
      for i in X'Range loop
         declare
            A : constant Word := X(I);
            B : constant Word := Y(I);
            S : constant Word := A + B + Carry;
         begin
            Sum(i) := S;
            Carry  := W_Carry(A, B, S);
         end;
      end loop;
      Overflow := Carry;
   end FZ_Add;
   pragma Inline_Always(FZ_Add);
 
   -- Difference := X - Y; Underflow := Borrow
   procedure FZ_Sub(X          : in  FZ;
                    Y          : in  FZ;
                    Difference : out FZ;
                    Underflow  : out WBool) is
      Borrow : WBool := 0;
   begin
      for i in 0 .. Word_Index(X'Length - 1) loop
         declare
            A : constant Word := X(X'First + i);
            B : constant Word := Y(Y'First + i);
            S : constant Word := A - B - Borrow;
         begin
            Difference(Difference'First + i) := S;
            Borrow := W_Borrow(A, B, S);
         end;
      end loop;
      Underflow := Borrow;
   end FZ_Sub;
   pragma Inline_Always(FZ_Sub);
 
end FZ_Arith;

with Words;   use Words;
with FZ_Type; use FZ_Type;
 
package FFA_IO is
 
   -- Character representation of a Word
   type WChars is array(1 .. 2 * Byteness) of Character;
 
   -- Obtain the WChars corresponding to the given Word
   function W_To_WChars(N : Word) return WChars;
 
   -- Display a hex representation of W to stdout
   procedure Dump(W : in Word);
 
   -- Display a hex representation of N to stdout
   procedure Dump(N : in FZ);
 
end FFA_IO;

with Ada.Text_IO; use Ada.Text_IO;
 
with Words;    use Words;
with W_Shifts; use W_Shifts;
with FZ_Type;  use FZ_Type;
 
package body FFA_IO is
 
   -- Obtain the WChars corresponding to the given Word
   function W_To_WChars(N : Word) return WChars is
      H      : constant array(0 .. 15) of Character := "0123456789ABCDEF";
      W      : Word := N;
      Result : WChars;
   begin
      for b in WChars'Range loop               -- From bottom to top:
         Result(B) := H(Natural(W and 16#F#)); -- Get current nibble.
         W         := Shift_Right(W, 4);       -- Get the next nibble.
      end loop;
      return Result;
   end W_To_WChars;
 
   -- Display a hex representation of W to stdout
   procedure Dump(W : in Word) is
      T : WChars := W_To_WChars(W);
   begin
      for i in reverse T'Range loop
         Put(T(i));
      end loop;
   end Dump;
 
   -- Display a hex representation of N to stdout
   procedure Dump(N : in FZ) is
   begin
      for i in reverse N'Range loop
         Dump(N(i));
      end loop;
   end Dump;
 
end FFA_IO;

package Demo_Ch1 is
 
   procedure Demo_Add_Sub;
 
end Demo_Ch1;

-- From Ada:
with Ada.Text_IO; use Ada.Text_IO;
 
-- From FFA:
with Words;    use Words;
with FZ_Type;  use FZ_Type;
with FZ_Arith; use FZ_Arith;
 
-- From the Demo:
with FFA_IO;   use FFA_IO;
 
package body Demo_Ch1 is
 
   procedure Demo_Add_Sub is
 
      -- We are using 64-bit Words (see iron.ads).
      -- We'll begin with an elementary demo, using 256-bit FZ:
      X : FZ(1 .. 4) := (0,        0, 0, 0);
      Y : FZ(1 .. 4) := (16#5555#, 0, 0, 0);
      Z : FZ(1 .. 4) := (0,        0, 0, 0);
 
      -- Carry.
      C : WBool := 0;
 
   begin
 
      Put_Line("X         =");
      Dump(X);
      New_Line;
 
      Put_Line("Y         =");
      Dump(Y);
      New_Line;
 
      FZ_Add(X, Y, Z, C);
      Put_Line("X + Y     =");
      Dump(Z);
      New_Line;
      Put_Line("C         = " & WBool'Image(C));
 
      FZ_Sub(X, Y, Z, C);
      Put_Line("X - Y     =");
      Dump(Z);
      New_Line;
      Put_Line("C         = " & WBool'Image(C));
 
   end Demo_Add_Sub;
 
end Demo_Ch1;

with Demo_Ch1; use Demo_Ch1;
 
procedure FFA_Demo is
begin
 
   Demo_Add_Sub;
 
end FFA_Demo;

with "../libffa/ffa.gpr";
 
project FFA_Demo is
 
  for Object_Dir use "obj";
 
  type Mode_Type is ("debug", "release");
  Mode : Mode_Type := external ("mode", "release");
 
  for Languages   use ("Ada");
  for Source_Dirs use (".");
  for Exec_Dir    use "bin";
  for Main        use ("ffa_demo.adb");
 
  package Compiler is
     case Mode is
        when "debug" =>
           for Switches ("Ada")
             use ("-g");
        when "release" =>
           for Switches ("Ada")
             use ("-O2", "-fdump-scos", "-gnata", "-fstack-check",
                  "-fdata-sections", "-ffunction-sections");
     end case;
  end Compiler;
 
  package Binder is
     case Mode is
        when "debug" =>
           for Switches ("Ada")
             use ();
        when "release" =>
           for Switches ("Ada")
             use ("-static");
     end case;
  end Binder;
 
  package Linker is
     case Mode is
        when "debug" =>
           for Switches ("Ada")
             use ();
        when "release" =>
           for Switches ("Ada")
             use ("-Wl,--gc-sections",
                  "-static");
     end case;
  end Linker;
 
end FFA_Demo;

./bin/ffa_demo

X         =
0000000000000000000000000000000000000000000000000000000000000000
Y         =
0000000000000000000000000000000000000000000000000000000000005555
X + Y     =
0000000000000000000000000000000000000000000000000000000000005555
C         =  0
X - Y     =
FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFAAAB
C         =  1