-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2006, AdaCore --
+-- Copyright (C) 2002-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- writes it into file F. When the array is completed, the routine adds
-- semi-colon and writes the line into file F.
- procedure New_Line
- (File : File_Descriptor);
+ procedure New_Line (File : File_Descriptor);
-- Simulate Ada.Text_IO.New_Line with GNAT.OS_Lib
- procedure Put
- (File : File_Descriptor;
- Str : String);
+ procedure Put (File : File_Descriptor; Str : String);
-- Simulate Ada.Text_IO.Put with GNAT.OS_Lib
- procedure Put_Used_Char_Set
- (File : File_Descriptor;
- Title : String);
+ procedure Put_Used_Char_Set (File : File_Descriptor; Title : String);
-- Output a title and a used character set
procedure Put_Int_Vector
-- Output a title and a matrix. When the matrix has only one non-empty
-- dimension (Len_2 = 0), output a vector.
- procedure Put_Edges
- (File : File_Descriptor;
- Title : String);
+ procedure Put_Edges (File : File_Descriptor; Title : String);
-- Output a title and an edge table
- procedure Put_Initial_Keys
- (File : File_Descriptor;
- Title : String);
+ procedure Put_Initial_Keys (File : File_Descriptor; Title : String);
-- Output a title and a key table
- procedure Put_Reduced_Keys
- (File : File_Descriptor;
- Title : String);
+ procedure Put_Reduced_Keys (File : File_Descriptor; Title : String);
-- Output a title and a key table
- procedure Put_Vertex_Table
- (File : File_Descriptor;
- Title : String);
+ procedure Put_Vertex_Table (File : File_Descriptor; Title : String);
-- Output a title and a vertex table
----------------------------------
function Acyclic return Boolean is
Marks : array (0 .. NV - 1) of Vertex_Id := (others => No_Vertex);
- function Traverse
- (Edge : Edge_Id;
- Mark : Vertex_Id) return Boolean;
+ function Traverse (Edge : Edge_Id; Mark : Vertex_Id) return Boolean;
-- Propagate Mark from X to Y. X is already marked. Mark Y and propagate
-- it to the edges of Y except the one representing the same key. Return
-- False when Y is marked with Mark.
-- Traverse --
--------------
- function Traverse
- (Edge : Edge_Id;
- Mark : Vertex_Id) return Boolean
- is
+ function Traverse (Edge : Edge_Id; Mark : Vertex_Id) return Boolean is
E : constant Edge_Type := Get_Edges (Edge);
K : constant Key_Id := E.Key;
Y : constant Vertex_Id := E.Y;
-------------------------------
procedure Assign_Values_To_Vertices is
- X : Vertex_Id;
+ X : Vertex_Id;
procedure Assign (X : Vertex_Id);
-- Execute assignment on X's neighbors except the vertex that we are
-- Assign --
------------
- procedure Assign (X : Vertex_Id)
- is
+ procedure Assign (X : Vertex_Id) is
E : Edge_Type;
V : constant Vertex_Type := Get_Vertices (X);
+
begin
for J in V.First .. V.Last loop
E := Get_Edges (J);
+
if Get_Graph (E.Y) = -1 then
Set_Graph (E.Y, (E.Key - Get_Graph (X)) mod NK);
Assign (E.Y);
-- Compute --
-------------
- procedure Compute
- (Position : String := Default_Position)
- is
+ procedure Compute (Position : String := Default_Position) is
Success : Boolean := False;
begin
-- Insert --
------------
- procedure Insert
- (Value : String)
- is
+ procedure Insert (Value : String) is
Word : Word_Type := Null_Word;
Len : constant Natural := Value'Length;
-- Start of processing for Parse_Position_Selection
begin
-
-- Empty specification means all the positions
if L < N then
-------------
procedure Produce (Pkg_Name : String := Default_Pkg_Name) is
- File : File_Descriptor;
+ File : File_Descriptor;
Status : Boolean;
-- For call to Close
FName (PLen + 1 .. PLen + 4) := ".ads";
- File := Create_File (FName, Text);
+ File := Create_File (FName, Binary);
+
Put (File, "package ");
Put (File, Pkg_Name);
Put (File, " is");
FName (PLen + 4) := 'b';
- File := Create_File (FName, Text);
+ File := Create_File (FName, Binary);
+
Put (File, "with Interfaces; use Interfaces;");
New_Line (File);
New_Line (File);
procedure Put (File : File_Descriptor; Str : String) is
Len : constant Natural := Str'Length;
-
begin
if Write (File, Str'Address, Len) /= Len then
raise Program_Error;
if F1 <= L1 then
if C1 = F1 and then C2 = F2 then
Add ('(');
+
if F1 = L1 then
Add ("0 .. 0 => ");
end if;
+
else
Add (' ');
end if;
if C2 = F2 then
Add ('(');
+
if F2 = L2 then
Add ("0 .. 0 => ");
end if;
+
else
Add (' ');
end if;
if F1 > L1 then
Add (';');
Flush;
+
elsif C1 /= L1 then
Add (',');
Flush;
+
else
Add (')');
Add (';');
-- Put_Edges --
---------------
- procedure Put_Edges
- (File : File_Descriptor;
- Title : String)
- is
+ procedure Put_Edges (File : File_Descriptor; Title : String) is
E : Edge_Type;
F1 : constant Natural := 1;
L1 : constant Natural := Edges_Len - 1;
-- Put_Initial_Keys --
----------------------
- procedure Put_Initial_Keys
- (File : File_Descriptor;
- Title : String)
- is
+ procedure Put_Initial_Keys (File : File_Descriptor; Title : String) is
F1 : constant Natural := 0;
L1 : constant Natural := NK - 1;
M : constant Natural := Max / 5;
L1 : constant Integer := Len_1 - 1;
F2 : constant Integer := 0;
L2 : constant Integer := Len_2 - 1;
- I : Natural;
+ Ix : Natural;
begin
Put (File, Title);
if Len_2 = 0 then
for J in F1 .. L1 loop
- I := IT.Table (Table + J);
- Put (File, Image (I), 1, 0, 1, F1, L1, J);
+ Ix := IT.Table (Table + J);
+ Put (File, Image (Ix), 1, 0, 1, F1, L1, J);
end loop;
else
for J in F1 .. L1 loop
for K in F2 .. L2 loop
- I := IT.Table (Table + J + K * Len_1);
- Put (File, Image (I), F1, L1, J, F2, L2, K);
+ Ix := IT.Table (Table + J + K * Len_1);
+ Put (File, Image (Ix), F1, L1, J, F2, L2, K);
end loop;
end loop;
end if;
-- Put_Reduced_Keys --
----------------------
- procedure Put_Reduced_Keys
- (File : File_Descriptor;
- Title : String)
- is
+ procedure Put_Reduced_Keys (File : File_Descriptor; Title : String) is
F1 : constant Natural := 0;
L1 : constant Natural := NK - 1;
M : constant Natural := Max / 5;
-- Put_Used_Char_Set --
-----------------------
- procedure Put_Used_Char_Set
- (File : File_Descriptor;
- Title : String)
- is
+ procedure Put_Used_Char_Set (File : File_Descriptor; Title : String) is
F : constant Natural := Character'Pos (Character'First);
L : constant Natural := Character'Pos (Character'Last);
-- Put_Vertex_Table --
----------------------
- procedure Put_Vertex_Table
- (File : File_Descriptor;
- Title : String)
- is
+ procedure Put_Vertex_Table (File : File_Descriptor; Title : String) is
F1 : constant Natural := 0;
L1 : constant Natural := NV - 1;
M : constant Natural := Max / 4;
-- Random --
------------
- procedure Random (Seed : in out Natural)
- is
+ procedure Random (Seed : in out Natural) is
+
-- Park & Miller Standard Minimal using Schrage's algorithm to avoid
-- overflow: Xn+1 = 16807 * Xn mod (2 ** 31 - 1)
WT.Table (Target) := WT.Table (Source);
end Move;
- -- Start of processing for Build_Identical_Key_Sets
+ -- Start of processing for Build_Identical_Key_Sets
begin
Last := 0;
-- Select_Character_Set --
--------------------------
- procedure Select_Character_Set
- is
+ procedure Select_Character_Set is
Last : Natural := 0;
Used : array (Character) of Boolean := (others => False);
Char : Character;