[The Original Shootout]   [NEWS]   [FAQ]   [Methodology]   [Platform Details]   [Acknowledgements]   [Scorecard]
All Source For gnat
Ackermann's Function
```-- \$Id: ackermann.gnat,v 1.0 2003/06/11 12:01:00 dada Exp \$
-- Ada 95 code by C.C.

procedure Ackermann is
function L_Trim (Source : String; Side : Ada.Strings.Trim_End :=

subtype Nat is Interfaces.Integer_32 range 0 .. Interfaces.Integer_32'Last;
subtype Pos is Nat range 1 .. Nat'Last;         --  Largest is 2_147_483_647
use type Nat;

function Ack (M, N : Nat) return Pos is
pragma Suppress (Overflow_Check);
pragma Suppress (Range_Check);
begin
if M = 0 then
return N + 1;
elsif N = 0 then
return Ack (M - 1, 1);
else
return Ack (M - 1, Ack (M, N - 1));
end if;
end Ack;

N        : Pos := 1;
begin
end if;
Text_IO.Put_Line ("Ack(3," & L_Trim (Pos'Image (N)) & "):" &
Pos'Image (Ack (3, N)));
end Ackermann;

```
Array Access
```-- \$Id: ary3.gnat,v 1.0 2003/06/11 12:08:00 dada Exp \$
-- Ada 95 code by C.C.

procedure Ary3 is
function L_Trim (Source : String; Side : Ada.Strings.Trim_End :=
N        : Positive := 1;
begin
begin
exception
when Constraint_Error => null;
end;
declare
type Vect is array (1 .. N) of Integer;
X, Y     : Vect;
begin
for K in Vect'Range loop
X (K) := K;
Y (K) := 0;
end loop;

for Iter in 1 .. 1000 loop
for K in reverse Vect'Range loop
declare
Y_K      : Integer renames Y (K);
begin
Y_K := Y_K + X (K);
end;
end loop;
end loop;
Text_IO.Put_Line (L_Trim (Integer'Image (Y (1))) &
Integer'Image (Y (N)));
end;
end Ary3;

```
Count Lines/Words/Chars
```-- \$Id: wc.gnat,v 1.0 2003/06/11 12:11:00 dada Exp \$
-- Ada 95 code by C.C.

procedure Wc is
package IC renames Interfaces.C;
function L_Trim (Source : String; Side : Ada.Strings.Trim_End :=

package Io is
type File_Descriptor is new IC.int;       --  STDIN=0, STDOUT=1, STDERR=2
type Setmode_Flag is new IC.int;
STDIN       : constant File_Descriptor := 0;
O_BINARY    : constant Setmode_Flag := 16#8000#;

function C_Setmode (
FD       : File_Descriptor;
Mode     : Setmode_Flag)
return IC.int;

FD       : File_Descriptor;
NByte    : IC.int)
return IC.int;
private
pragma Import (C, C_Setmode, "_setmode");          --  Microsoft Windows
end Io;

Buffer      : String (1 .. 4 * 1024);
NL, NW, NC  : Natural := 0;
Inside_Word : Boolean := False;
C           : Character;
Last, R     : Integer;
begin
R := Integer (Io.C_Setmode (Io.STDIN, Io.O_BINARY));  --  Read CR,LF right
loop
Last := Integer (Io.C_Sysread (FD => Io.STDIN,
Buf => Buffer (1)'Address, NByte => Buffer'Length));
exit when Last <= 0;
NC := NC + Last;
for K in Buffer'First .. Last loop
C := Buffer (K);
if C = ASCII.LF then
NL := NL + 1;
end if;
if C = ' ' or C = ASCII.CR or C = ASCII.LF or C = ASCII.HT then
Inside_Word := False;
elsif not Inside_Word then
Inside_Word := True;
NW := NW + 1;
end if;
end loop;
end loop;
Ada.Text_IO.Put_Line (L_Trim (Natural'Image (NL)) & Natural'Image (NW) &
Natural'Image (NC));
end Wc;
--  read from STDIN: can't associate Standard Input with File parameter.
--  GNAT's Interfaces.C_Streams.fread function isn't from ISO/IEC 8652:1995.

```
Exception Mechanisms
```-- \$Id: except.gnat,v 1.0 2003/06/11 12:06:00 dada Exp \$
-- Ada 95 code by C.C.

procedure Except is
High_Exception : exception;
Low_Exception  : exception;
Low            : Integer := 0;
High           : Integer := 0;

procedure Blowup (K : Integer) is
pragma Inline (Blowup);
begin
case 1 = (K mod 2) is
when False => raise High_Exception;
when True  => raise Low_Exception;
end case;
end Blowup;

procedure Low_Function (K : Integer) is
pragma Inline (Low_Function);
begin
Blowup (K);
exception
when Low_Exception => Low := Low + 1;
end Low_Function;

procedure High_Function (K : Integer) is
pragma Inline (High_Function);
begin
Low_Function (K);
exception
when High_Exception => High := High + 1;
end High_Function;

procedure Some_Function (K : Integer) is
pragma Inline (Some_Function);
begin
High_Function (K);
exception
when others => Text_IO.Put_Line ("We shouldn't get here");
end Some_Function;

function L_Trim (Source : String; Side : Ada.Strings.Trim_End :=
N        : Natural := 0;
begin
begin
exception
when Constraint_Error => null;
end;
for K in reverse 0 .. N - 1 loop
Some_Function (K);
end loop;
Text_IO.Put_Line ("Exceptions: HI=" & L_Trim (Natural'Image (High)) &
" / LO=" & L_Trim (Natural'Image (Low)));
end Except;

```
Fibonacci Numbers
```-- \$Id: fibo.gnat,v 1.0 2003/06/11 12:02:00 dada Exp \$
-- Ada 95 code by C.C.

procedure Fibo is
function Fib (N : Natural) return Integer is
L        : Integer := N - 1;
pragma Suppress (Range_Check, On => L);
begin
if L <= 0 then
return 1;
else
return Fib (N - 2) + Fib (L);
end if;
end Fib;
N        : Natural := 0;
begin
begin
exception
when Constraint_Error => null;
end;
Ada.Integer_Text_IO.Put (Item => Fib (N), Width => 0);
end Fibo;

```
Heapsort
```-- \$Id: heapsort.gnat,v 1.0 2003/06/11 12:10:00 dada Exp \$
-- Ada 95 code by C.C.

procedure Heapsort is
type Real is digits Positive'Max (15, System.Max_Digits);
package Rio is new Text_IO.Float_IO (Num => Real);

package Random_Real is
function Gen_Random (Supr : Real) return Real;
pragma Inline (Gen_Random);
end Random_Real;

package body Random_Real is
IM          : constant Positive := 139968;
IA          : constant Integer := 3877;
IC          : constant Integer := 29573;
Last        : Integer := 42;

function Gen_Random (Supr : Real) return Real is
pragma Suppress (Overflow_Check);
pragma Suppress (Range_Check);
begin
Last := (Last * IA + IC) mod IM;
return Supr * Real (Last) / Real (IM);
end Gen_Random;
end Random_Real;

type Range_Int is new Integer;
subtype Offset_Int is Range_Int;

type Real_Array is array (Range_Int range <>) of Real;
type Real_Array_Ptr is access Real_Array;

procedure Heapsort (A : in out Real_Array) is
pragma Suppress (Overflow_Check);
pragma Suppress (Index_Check);
pragma Suppress (Range_Check);
subtype Range_Positive is Range_Int;
First          : constant Range_Int := A'First;    --  might be <= -1
IR             : Range_Positive;
One            : constant Offset_Int := 1;
Minus_One      : constant Offset_Int := -1;
First_Minus_1  : constant Range_Int := First + Minus_One;
First_Plus_1   : constant Range_Int := First + One;
RRA            : Real;
L              : Offset_Int := One + (A'Length / 2);
begin
if A'Length <= 0 then
return;
end if;
IR := A'Last;
loop
if L > One then
L := L - One;
RRA := A (First_Minus_1 + L);
else
RRA := A (IR);
A (IR) := A (First);
if IR <= First_Plus_1 then
A (First) := RRA;
exit;
else
IR := IR + Minus_One;
end if;
end if;
declare
K1    : Range_Positive := First_Minus_1 + L;
K2    : Range_Positive := K1 + L;
begin
while K2 <= IR loop
if K2 < IR then
if A (K2) < A (K2 + One) then
K2 := K2 + One;
end if;
end if;
if RRA < A (K2) then
A (K1) := A (K2);
K1 := K2;
K2 := K1 + (K1 - First_Minus_1);
else
K2 := IR + One;
end if;
end loop;
A (K1) := RRA;
end;
end loop;
end Heapsort;

N           : Range_Int;
No_Verify   : constant Boolean := True;
Chk         : Real := 0.0;
X           : Real_Array_Ptr;
begin
begin
N := Range_Int'Max (1, Range_Int'Value (Ada.Command_Line.Argument (1)));
exception
when Constraint_Error => N := 1;
end;
X := new Real_Array (0 .. N - 1);   --  3% slower than 'declare' (stack)
for Iter in X'Range loop
X (Iter) := Random_Real.Gen_Random (Supr => 1.0);
end loop;
if No_Verify then
Heapsort (A => X.all);
Rio.Put (X (X'Last), Fore => 0, Aft => 10, Exp => 0);
Text_IO.New_Line;
else
for Iter in X'Range loop Chk := Chk + X (Iter); end loop;
Heapsort (A => X.all);
for K in X'Range loop
pragma Assert (K + 1 = X'Last or else X (K) <= X (K + 1));
Chk := Chk - X (K);
end loop;
pragma Assert (abs Chk < 50.0 * Real (N) * Real'Model_Epsilon);
end if;
end Heapsort;

```
Hello World
```-- \$Id: hello.gnat,v 1.0 2003/06/11 12:04:00 dada Exp \$
-- Ada 95 code by C.C.

procedure Hello is
begin
end Hello;

```
Matrix Multiplication
```-- \$Id: matrix.gnat,v 1.0 2003/06/11 12:09:00 dada Exp \$
-- Ada 95 code by C.C.

procedure Matrix is
function L_Trim (Source : String; Side : Ada.Strings.Trim_End :=

type Int is new Integer;
type Int_Matrix is array (Positive range <>, Positive range <>) of Int;

function Mk_Matrix (NRows, NCols : Natural) return Int_Matrix is
Count    : Int := 1;
M        : Int_Matrix (1 .. NRows, 1 .. NCols);
begin
for I in M'Range (1) loop
for J in M'Range (2) loop
M (I, J) := Count;
Count := Count + 1;
end loop;
end loop;
return M;
end Mk_Matrix;

procedure M_Mult (M1, M2 : Int_Matrix; MM : in out Int_Matrix) is
pragma Inline (M_Mult);
pragma Suppress (Index_Check);
Sum      : Int;
begin
if not (M1'First (2) = M2'First (1) and M1'Last (2) = M2'Last (1) and
M1'First (1) = MM'First (1) and M1'Last (1) = MM'Last (1) and
M2'First (2) = MM'First (2) and M2'Last (2) = MM'Last (2)) then
raise Constraint_Error;
end if;
for I in M1'Range (1) loop
for J in M2'Range (2) loop
Sum := 0;
for KK in M1'Range (2) loop
Sum := Sum + M1 (I, KK) * M2 (KK, J);
end loop;
MM (I, J) := Sum;
end loop;
end loop;
end M_Mult;

Size     : constant Natural := 30;
M1, M2, MM : Int_Matrix (1 .. Size, 1 .. Size);
N        : Positive := 1;
begin
begin
exception
when Constraint_Error => null;
end;
M1 := Mk_Matrix (Size, Size);
M2 := Mk_Matrix (Size, Size);
for Iter in 1 .. N loop
M_Mult (M1, M2, MM);
end loop;
Text_IO.Put_Line (L_Trim (Int'Image (MM (1, 1))) & Int'Image (MM (3, 4)) &
Int'Image (MM (4, 3)) & Int'Image (MM (5, 5)));
end Matrix;

```
Method Calls
```-- \$Id: methcall.gnat,v 1.0 2003/06/11 12:10:00 dada Exp \$
-- Ada 95 code by C.C.

procedure MethCall is
package Toggles is
type A_Rec is                          --  'tagged' implies hidden field,
tagged record                       --   and can append new fields
Value       : Boolean := True;
end record;

procedure Activate (A : in out A_Rec);

type B_Rec is new A_Rec with                 --  Add more fields to A_Rec
record
Flip_Period : Positive := 1;
Count       : Natural := 0;
end record;

procedure Activate (B : in out B_Rec);
pragma Inline (Activate);
end Toggles;

package body Toggles is
procedure Activate (A : in out A_Rec) is
begin
A.Value := not A.Value;
end Activate;

procedure Activate (B : in out B_Rec) is
begin
B.Count := B.Count + 1;
if B.Count = B.Flip_Period then
B.Count := 0;
B.Value := not B.Value;
end if;
end Activate;
end Toggles;

X        : Toggles.A_Rec := (Value => True);
Y        : Toggles.B_Rec := (Value => True, Count => 0, Flip_Period => 3);
Val      : Boolean;
N        : Positive := 1;
begin
begin
exception
when Constraint_Error => null;
end;
for Iter in 1 .. N loop
Toggles.Activate (X);
Val := X.Value;
end loop;
for Iter in 1 .. N loop
Toggles.Activate (Y);
Val := Y.Value;
end loop;
end MethCall;
```
Nested Loops
```-- \$Id: nestedloop.gnat,v 1.0 2003/06/11 12:04:00 dada Exp \$
-- Ada 95 code by C.C.

procedure NestedLoop is
Count, M : Natural := 0;
N        : Positive := 1;
begin
begin
exception
when Constraint_Error => null;
end;
M := N - 1;
for A in 0 .. M loop
for B in 0 .. M loop
for C in 0 .. M loop
for D in 0 .. M loop
for E in 0 .. M loop
for F in 0 .. M loop
Count := Count + 1;
end loop;
end loop;
end loop;
end loop;
end loop;
end loop;
Ada.Integer_Text_IO.Put (Item => Count, Width => 0);
end NestedLoop;

```
Object Instantiation
```-- \$Id: objinst.gnat,v 1.0 2003/06/11 12:07:00 dada Exp \$
-- Ada 95 code by C.C.

procedure ObjInst is    --  3.451
pragma Suppress (Discriminant_Check);
pragma Suppress (Access_Check);

package Toggles is
type A_Rec is
tagged record                 --  'tagged' allows fields to be added
Value       : Boolean := True;
end record;

type B_Rec is new A_Rec with
record
Flip_Period : Positive := 1;
Count       : Natural := 0;
end record;

type A_Recs_Family_Ptr is access all A_Rec'Class;

function Activate (X : A_Recs_Family_Ptr) return A_Recs_Family_Ptr;
pragma Inline (Activate);
end Toggles;

package body Toggles is
function Activate (X : A_Recs_Family_Ptr) return A_Recs_Family_Ptr is
pragma Suppress (Range_Check);
pragma Suppress (Tag_Check);
begin                   --  X is a ptr: no "in out" parms in a function
if X.all'Tag = A_Rec'Tag then                         --  A_Rec case
X.all.Value := not X.all.Value;
else
declare                       --  Make visible the 2 B_Rec fields
pragma Suppress (Tag_Check);
B        : B_Rec renames B_Rec (X.all);
begin
B.Count := B.Count + 1;
if B.Count = B.Flip_Period then
B.Count := 0;
B.Value := not B.Value;
end if;
end;
end if;
return X;
end Activate;
end Toggles;

A        : aliased Toggles.A_Rec;      --  "aliased", since X'Access is used
B        : aliased Toggles.B_Rec;      --  "access all" above for aliased
N        : Positive := 1;
Res      : Boolean;
begin
begin
exception
when Constraint_Error => null;
end;
A := Toggles.A_Rec'(Value => True);
for K in 1 .. 5 loop
Res := Toggles.Activate (A'Access).Value;
Text_IO.Put_Line (CH.To_Lower (Boolean'Image (Res)));
end loop;
for Iter in 1 .. N loop
A := Toggles.A_Rec'(Value => True);
end loop;
Text_IO.New_Line;
B := Toggles.B_Rec'(Value => True, Flip_Period => 3, Count => 0);
for K in 1 .. 8 loop
Res := Toggles.Activate (B'Access).Value;
Text_IO.Put_Line (CH.To_Lower (Boolean'Image (Res)));
end loop;
for Iter in 1 .. N loop
B := Toggles.B_Rec'(Value => True, Flip_Period => 3, Count => 0);
end loop;
end ObjInst;
```
```-- \$Id: prodcons.gnat,v 1.0 2003/06/11 12:10:00 dada Exp \$
-- Ada 95 code by C.C.

procedure ProdCons is

type Data_Type is new Integer;
End_Of_Data    : constant Data_Type := Data_Type'First;

protected Queue is
entry Put (Data : Data_Type);
entry Get (Data_Out : out Data_Type);
private
Count          : Natural := 0;
Buffer         : Data_Type;
end Queue;

protected body Queue is
entry Put (Data : Data_Type)
when Count = 0 is
begin
Buffer := Data;
Count := Count + 1;
end Put;

entry Get (Data_Out : out Data_Type)
when Count /= 0 is
begin
Data_Out := Buffer;
Count := Count - 1;
end Get;
end Queue;

Produced, Consumed : Natural := 0;

begin
for Data_K in 1 .. Data_Type (N) loop
Queue.Put (Data => Data_K);
Produced := Produced + 1;
end loop;
Queue.Put (Data => End_Of_Data);

Data        : Data_Type;
begin
loop
Queue.Get (Data_Out => Data);
exit when Data = End_Of_Data;
Consumed := Consumed + 1;
end loop;

function L_Trim (Source : String; Side : Ada.Strings.Trim_End :=
N        : Natural := 0;
begin
begin
exception
when Constraint_Error => null;
end;
declare
Producer    : Producer_Task (N => N);
Consumer    : Consumer_Task (N => N);
begin
null;
end;
Text_IO.Put_Line (L_Trim (Natural'Image (Produced)) &
Natural'Image (Consumed));
end ProdCons;

```
Random Number Generator
```-- \$Id: random.gnat,v 1.0 2003/06/11 12:05:00 dada Exp \$
-- Ada 95 code by C.C.

procedure Random is
type Real is digits Positive'Max (15, System.Max_Digits);
package Rio is new Ada.Text_IO.Float_IO (Num => Real);

package Random_Real is
function Gen_Random (Supr : Real) return Real;
pragma Inline (Gen_Random);
end Random_Real;

package body Random_Real is
IM          : constant Positive := 139968;
IA          : constant Integer := 3877;
IC          : constant Integer := 29573;
Last        : Integer := 42;

function Gen_Random (Supr : Real) return Real is
pragma Suppress (Overflow_Check);
pragma Suppress (Range_Check);
begin
Last := (Last * IA + IC) mod IM;
return Supr * Real (Last) / Real (IM);
end Gen_Random;
--  Assume no overflow for "Natural ((IM - 1) * IA + IC)"
end Random_Real;

Result   : Real;
N        : Natural := 0;
begin
begin
exception
when Constraint_Error => null;
end;
for Iter in 1 .. N loop
Result := Random_Real.Gen_Random (Supr => 100.0);
end loop;
Rio.Put (Result, Fore => 0, Aft => 9, Exp => 0);
end Random;

```
Sieve of Erathostenes
```-- \$Id: sieve.gnat,v 1.0 2003/06/11 12:03:00 dada Exp \$
-- Ada 95 code by C.C.

procedure Sieve is
High        : constant := 8192;
Is_Prime    : array (2 .. High) of Boolean;
Count, K, N : Natural := 0;
begin
begin
exception
when Constraint_Error => null;
end;
for Iter in 1 .. N loop
declare
pragma Suppress (Overflow_Check);
pragma Suppress (Index_Check);
pragma Suppress (Range_Check);
begin
Count := 0;
Is_Prime := (others => True);
for J in Is_Prime'Range loop
if Is_Prime (J) then
K := J + J;
while K <= Is_Prime'Last loop
Is_Prime (K) := False;        --  K is not a prime since a
K := K + J;                   --  multiple of prime J
end loop;
Count := Count + 1;
end if;
end loop;
end;
end loop;
Text_IO.Put_Line ("Count:" & Natural'Image (Count));
end Sieve;

```
Statistical Moments
```-- \$Id: moments.gnat,v 1.0 2003/06/11 12:08:00 dada Exp \$
-- Ada 95 code by C.C.

procedure Moments is
type Real is digits Positive'Max (15, System.Max_Digits);
package AF is new
package Rio is new Ada.Text_IO.Float_IO (Num => Real);
procedure Put (Item : Real; Fore : Io.Field := 0; Aft : Io.Field := 6;
Exp : Io.Field := 0) renames Rio.Put;

generic
type Item_Type is private;      --  Component type of array to be sorted
with function "<=" (X, Y : Item_Type) return Boolean;
type Sequence is array (Integer range <>) of Item_Type;
package Sort_Pkg is
procedure Quick_Sort (S : in out Sequence);
end Sort_Pkg;  --  Copied from Southampton Ada MPICH supercomputer bindings

package body Sort_Pkg is
procedure Quick_Sort (S : in out Sequence) is
procedure Sort_Recursive (Lwb, Upb : Integer) is
Pivot    : Item_Type := S (Upb);
Front    : Integer := Lwb;
Back     : Integer := Upb;
Temp     : Item_Type;
begin
if Lwb < Upb then
while  (Front <= Back)  loop
while not  (Pivot <= S (Front)) loop
Front := Front + 1;
end loop;
while not  (S (Back) <= Pivot) loop
Back := Back - 1;
end loop;
if Front <= Back then
Temp := S (Front);
S (Front) := S (Back);
S (Back) := Temp;
Front := Front + 1;
Back  := Back - 1;
end if;
end loop;
Sort_Recursive (Lwb, Back);
Sort_Recursive (Front, Upb);
end if;
end Sort_Recursive;
begin
Sort_Recursive (S'First, S'Last);
end Quick_Sort;
end Sort_Pkg;

type Real_Array is array (Integer range <>) of Real;
type Real_Array_Ptr is access Real_Array;
procedure Deallocate_Real_Array is new Ada.Unchecked_Deallocation (
Object => Real_Array, Name => Real_Array_Ptr);
package Sort is new Sort_Pkg (Real, "<=" => "<=", Sequence => Real_Array);

Data           : Real_Array_Ptr := new Real_Array (1 .. 0);
Temp_Array     : Real_Array_Ptr;
Dev, D_2, Mean, Median     : Real;
Standard_Deviation         : Real;
Sum, Avg_Abs_Deviation     : Real := 0.0;
Variance, Skew, Kurtosis   : Real := 0.0;
M              : Natural := 0;
begin
while not Io.End_Of_File loop
M := M + 1;
if M > Data'Last then                  --  Lengthen array of strings
Temp_Array := new Real_Array (
1 .. 4 + Positive (Real'Ceiling (1.70 * Real (M))));
Temp_Array (Data'Range) := Data.all;
Deallocate_Real_Array (Data);
Data := Temp_Array;     --  Replace the old array with the new one
end if;
Rio.Get (Item => Data (M));      -- Read  numbers between whitespace
Sum := Sum + Data (M);
end loop;
Mean := Sum / Real (M);
for K in 1 .. M loop
Dev := Data (K) - Mean;
Avg_Abs_Deviation := Avg_Abs_Deviation + abs Dev;
D_2 := Dev * Dev;
Variance := Variance + D_2;
Skew := Skew + (D_2 * Dev);
Kurtosis := Kurtosis + (D_2 * D_2);
end loop;
Avg_Abs_Deviation := Avg_Abs_Deviation / Real (M);
Variance := Variance / Real (M - 1);
Standard_Deviation := AF.Sqrt (Variance);
if Variance < 10.0 * Real'Model_Epsilon then
Io.Put_Line ("> Reduced accuracy results: 0 = ((Variance/10 + 1) - 1)");
else
Skew := Skew / (Real (M) * Variance * Standard_Deviation);
Kurtosis := -3.0 + Kurtosis / (Real (M) * Variance * Variance);
end if;
Sort.Quick_Sort (S => Data (1 .. M));
if 1 = (M mod 2) then
Median := Data ((M + 1) / 2);
else
Median := (Data (M / 2) + Data (1 + M / 2)) / 2.0;
end if;
Io.Put_Line ("n:                 " & Integer'Image (M));
Io.Put ("median:             "); Put (Median);              Io.New_Line;
Io.Put ("mean:               "); Put (Mean);                Io.New_Line;
Io.Put ("average_deviation:  "); Put (Avg_Abs_Deviation);   Io.New_Line;
Io.Put ("standard_deviation: "); Put (Standard_Deviation);  Io.New_Line;
Io.Put ("variance:           "); Put (Variance);            Io.New_Line;
Io.Put ("skew:               "); Put (Skew);                Io.New_Line;
Io.Put ("kurtosis:           "); Put (Kurtosis);            Io.New_Line;
end Moments;

```
String Concatenation
```-- \$Id: strcat.gnat,v 1.0 2003/11/18 12:15:00 dada Exp \$
-- contributed by James S. Rogers

procedure Strcat is
N: Integer;
Hello : String := "hello" & Ascii.Lf;
Buffer : Unbounded_String := Null_Unbounded_String;
begin
N := Integer'Value(Argument(1));
for Num in 1..N loop
Append(Source => Buffer, New_Item => Hello);
end loop;
Put(Length(Buffer));
New_Line;
end Strcat;
```
Sum a Column of Integers
```-- \$Id: sumcol.gnat,v 1.0 2003/06/11 12:06:00 dada Exp \$
-- Ada 95 code by C.C.

procedure SumCol is

Buf      : String (1 .. 4096);
Last     : Natural;
begin    --  (End_Error here (in ObjectAda) on unusual missing final "\n")
Text_IO.Get_Line (Text_IO.Standard_Input, Item => Buf, Last => Last);
if Last < Buf'Last or else
Text_IO.End_Of_File (Text_IO.Standard_Input) then
return Buf (1 .. Last);
else
end if;

Sum         : Integer := 0;
begin
while not Text_IO.End_Of_File loop
declare
Line     : String := AS.Fixed.Trim (Read_Line, Side => AS.Right);
begin
Sum := Sum + Integer'Value (Line);  --  Fail 0 or 2 numbers per line
end;
end loop;
Text_IO.Put_Line (AS.Fixed.Trim (Natural'Image (Sum), Side => AS.Left));
exception                        --  Catch error from Get_Line Integer'Value
when Constraint_Error | IE.Device_Error | IE.End_Error =>
Text_IO.Put_Line ("> Error near line" &
Text_IO.Count'Image (Text_IO.Line));
end SumCol;

```