|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 18432 (0x4800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Sort_Sup, seg_0581d9
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
-- UNIT: procedure sort_sup_b.a
-- FILES: sort.a, sort_sup.a, sort_sup_b.a
-- COMPILE: ada sort_sup.a sort_sup_b.a
-- ada -o sort sort.a
-- PURPOSE: To provide a demo for self targets ,
-- as well as a useful demo for performance analysis.
-- Of course with a few generics the support routines
-- would provide a fine addition to a general sort library.
-- DESCRIPTION: This is a menu driven demo that provides examples of
-- four popular sorts: the bubble sort, the shell sort,
-- the quick sort, and the quick sort with an inline swap. --
-- Menu options allow output control, random data
-- generation, and selection of sorting options.
-- USAGE: sort
--
-- .......................................................................... --
with System, Sort_Sup, Text_Io, V_I_Bits;
use System, Sort_Sup, Text_Io;
package body Sort_Sup is
Wait_Time : constant Integer := 10000;
Show_Result : Boolean := False;
procedure Pause is
W : Integer := 1;
begin
for I in 1 .. Wait_Time loop
W := W * 3;
W := W / 3;
end loop;
end Pause;
procedure Initialize is
begin
--
-- set initial values
--
Input_Valid := False;
Output_Valid := False;
Num_Of_Data := 8;
Put_Line
("<<< VADS/NWIS Performance Analyzer Demonstration >>>");
end Initialize;
function Make_Random (Seed : Integer) return Integer is
use V_I_Bits;
Rand_Num1 : Integer := Seed;
Rand_Num2 : Integer := Rand_Num1;
Rand_Num3 : Integer := Rand_Num1;
Ret_Val : Integer := 0;
begin
-- seed >> 4
Rand_Num1 := Rand_Num1 / (2 ** 4);
-- seed << 10
Rand_Num2 := Rand_Num2 * (2 ** 10);
-- seed >> 3
Rand_Num3 := Rand_Num3 / (2 ** 3);
Ret_Val := Bit_Or (Rand_Num2, Rand_Num3);
Ret_Val := Ret_Val + Rand_Num1;
Ret_Val := Bit_And (Ret_Val, Bit_Mask);
return Ret_Val;
end Make_Random;
procedure Gen_Pseudo_Random_Data
(A : in out Sort_Data; N : Integer; Seed : Integer) is
Seed_Clone : Integer := Seed;
begin
for I in 0 .. (N - 1) loop
A (I) := Make_Random (Seed_Clone);
Seed_Clone := A (I);
end loop;
end Gen_Pseudo_Random_Data;
procedure Gen_Random_Data (A : in out Sort_Data; N, Seed : Integer) is
begin
--
-- no cross-compiled C code for a real interface
--
Gen_Pseudo_Random_Data (A, N, Seed);
end Gen_Random_Data;
procedure Gen_Ascending_Data (A : in out Sort_Data; N : Integer) is
begin
for I in 0 .. (N - 1) loop
A (I) := I mod 256;
end loop;
end Gen_Ascending_Data;
procedure Gen_Descending_Data (A : in out Sort_Data; N : Integer) is
begin
for I in 0 .. (N - 1) loop
A (I) := 255 - (I mod 256);
end loop;
end Gen_Descending_Data;
procedure Read_User_Data (A : out Sort_Data; N : Integer) is
begin
Put_Line ("read_user_data is not yet implemented");
end Read_User_Data;
procedure Show_Data is
begin
Put_Line (" ");
if (Input_Valid or Output_Valid) then
for I in 1 .. Num_Of_Data loop
if (Input_Valid) then
Put (" Input data [" & Integer'Image (I));
Put_Line ("] = " & Integer'Image (Input_Data (I - 1)));
end if;
if (Output_Valid) then
Put (" Output data [" & Integer'Image (I));
Put_Line ("] = " & Integer'Image (Output_Data (I - 1)));
end if;
end loop;
end if;
Put_Line (" ");
if ((Num_Of_Data < 1) or ((not Input_Valid) and
(not Output_Valid))) then
Put_Line (" Input and Output data not available.");
else
if (not Output_Valid) then
Put_Line (" Output data not available.");
end if;
end if;
Pause;
end Show_Data;
procedure Draw_Front_Page is
begin
Put_Line ("draw_front_page is not yet implemented");
end Draw_Front_Page;
procedure Copy (Copy_Size : in out Integer) is
begin
for I in 0 .. (Copy_Size - 1) loop
Output_Data (I) := Input_Data (I);
end loop;
Output_Valid := Input_Valid;
end Copy;
procedure Swap (X, Y : in out Integer) is
Temp : Integer;
begin
Temp := X;
X := Y;
Y := Temp;
end Swap;
procedure Show_Output (T : Integer) is
begin
if Show_Result then
Put_Line ("Sorted data:");
for I in 0 .. (T - 1) loop
Put_Line (Integer'Image (Output_Data (I)));
end loop;
Pause;
end if;
end Show_Output;
procedure Bubble_Sort (A : in out Sort_Data; N : Integer) is
Temp : Integer;
begin
for I in reverse 1 .. (N - 1) loop
for T in 0 .. (I - 1) loop
if (A (T) > A (T + 1)) then
Swap (A (T), A (T + 1));
end if;
end loop;
end loop;
end Bubble_Sort;
procedure Shell_Sort (A : in out Sort_Data; N : Integer) is
K1 : Integer := 0;
K2 : Integer := 0;
Gap : Integer := N / 2;
Temp : Integer;
begin
while (Gap > 0) loop
for I in Gap .. (N - 1) loop
K1 := I - Gap;
while (K1 > -1) loop
K2 := K1 + Gap;
if (A (K1) <= A (K2)) then
K1 := -1;
else
Swap (A (K1), A (K2));
end if;
K1 := K1 - Gap;
end loop;
end loop;
Gap := Gap / 2;
end loop;
end Shell_Sort;
procedure Rquick (Lo : in out Integer; Hi : in out Integer) is
Temp : Integer;
I, J : Integer := 0;
begin
if (Lo < Hi) then
Pivot := Output_Data ((Lo + Hi) / 2);
I := Lo;
J := Hi;
while (I <= J) loop
while (Output_Data (I) < Pivot) loop
I := I + 1;
end loop;
while (Output_Data (J) > Pivot) loop
J := J - 1;
end loop;
if (I <= J) then
Swap (Output_Data (I), Output_Data (J));
I := I + 1;
J := J - 1;
end if;
end loop;
if ((J - Lo) < (Hi - I)) then
Rquick (Lo, J);
Rquick (I, Hi);
else
Rquick (I, Hi);
Rquick (Lo, J);
end if;
end if;
end Rquick;
procedure Quick_Sort (A : in out Sort_Data; N : Integer) is
T : Integer := 0;
S : Integer := N - 1;
begin
Rquick (T, S);
end Quick_Sort;
procedure Rquick_Inline (Lo : in out Integer; Hi : in out Integer) is
Temp : Integer := 0;
I, J : Integer := 0;
begin
if (Lo < Hi) then
Pivot := Output_Data ((Lo + Hi) / 2);
I := Lo;
J := Hi; while (I <= J) loop
while (Output_Data (I) < Pivot) loop
I := I + 1;
end loop;
while (Output_Data (J) > Pivot) loop
J := J - 1;
end loop;
if (I <= J) then
Temp := Output_Data (I);
Output_Data (I) := Output_Data (J);
Output_Data (J) := Temp;
I := I + 1;
J := J - 1;
end if;
end loop;
if ((J - Lo) < (Hi - I)) then
Rquick_Inline (Lo, J);
Rquick_Inline (I, Hi);
else
Rquick_Inline (I, Hi);
Rquick_Inline (Lo, J);
end if;
end if;
end Rquick_Inline;
procedure Quick_Sort_Inline (A : in out Sort_Data; N : Integer) is
T : Integer := 0;
S : Integer := N - 1;
begin
Rquick_Inline (T, S);
end Quick_Sort_Inline;
procedure Change_Number_Of_Data_Points is
begin
Num_Of_Data := 0;
Put_Line (" ");
while ((Num_Of_Data < 2) or (Num_Of_Data > Max_Num_Of_Data)) loop
Put (" Enter number of data points ( 2 - ");
Put (Integer'Image (Max_Num_Of_Data));
Put (" ): ");
Int_Io.Get (Num_Of_Data);
end loop;
Put_Line (" ");
end Change_Number_Of_Data_Points;
function Get_Option return Integer is
I : Integer;
begin
Put_Line ("");
Put_Line (" ----------- MENU ----------- ");
Put_Line ("");
Put (" 1 - Change number of data points [");
Put_Line (Integer'Image (Num_Of_Data) & "]");
Put (" 2 - Display results [");
if Show_Result then
Put_Line ("TRUE]");
else
Put_Line ("FALSE]");
end if;
Put_Line ("");
Put_Line (" 3 - Generate random input data ");
Put_Line (" 4 - Generate pseudo random input data");
Put_Line (" 5 - Generate ascending input data");
Put_Line (" 6 - Generate descending input data");
Put_Line (" 7 - Take input data from the user");
Put_Line ("");
Put_Line (" 8 - Bubble sort");
Put_Line (" 9 - Shell sort");
Put_Line ("10 - Quick sort");
Put_Line ("11 - Quick sort ( inline swap )");
Put_Line ("12 - Continuous data sort");
Put_Line ("13 - Show input and output data");
Put_Line ("");
Put_Line (" OTHERWISE - Exit to O/S");
Put_Line ("");
Put_Line ("");
Put (" Enter the choice number: ");
Int_Io.Get (I);
Put_Line (" ");
if ((I < 1) or (I > Max_Menu_Entry)) then
I := 0;
end if;
return I;
end Get_Option;
procedure Sort_Loop is
Loop_Last : constant Integer := 6;
Test_Max : constant Integer := 320;
Seed : Integer := 1372;
Sort_Size : Integer := 5;
Loops_Needed : Integer;
begin
Gen_Random_Data (Input_Data, Test_Max, Seed);
Put (" How many iterations would you like to perform: ");
Int_Io.Get (Loops_Needed);
Put_Line (" ");
for T in 1 .. Loops_Needed loop
--
-- endless loop for scrolling through sorts
--
for I in 1 .. Loop_Last loop
--
-- use 5, 10, 20, 40, 80, 160, and 320 elements for sort
--
Copy (Sort_Size);
Put ("Bubble sort with " & Integer'Image (Sort_Size));
Put_Line (" elements");
Bubble_Sort (Output_Data, Sort_Size);
Show_Output (Sort_Size);
Copy (Sort_Size);
Put ("Quick sort with " & Integer'Image (Sort_Size));
Put_Line (" elements");
Quick_Sort (Output_Data, Sort_Size);
Show_Output (Sort_Size);
Sort_Size := Sort_Size * 2;
end loop;
Pause;
Sort_Size := 5;
Put_Line (" ");
end loop;
end Sort_Loop;
procedure Change_Display_Default is
begin
if Show_Result then
Show_Result := False;
else
Show_Result := True;
end if;
end Change_Display_Default;
procedure Do_Choice is
Seed : Integer := 8765;
begin
Choice := Get_Option;
while (Choice /= 0) loop
case Choice is
when 1 =>
Change_Number_Of_Data_Points;
when 2 =>
Change_Display_Default;
when 3 =>
if (Num_Of_Data > 0) then
Put ("enter a seed value: ");
Int_Io.Get (Seed);
Gen_Random_Data (Input_Data, Num_Of_Data, Seed);
Input_Valid := True;
end if;
when 4 =>
if (Num_Of_Data > 0) then
Put ("enter a seed value: ");
Int_Io.Get (Seed);
Gen_Pseudo_Random_Data (Input_Data, Num_Of_Data, Seed);
Input_Valid := True;
end if;
when 5 =>
if (Num_Of_Data > 0) then
Gen_Ascending_Data (Input_Data, Num_Of_Data);
Input_Valid := True;
end if;
when 6 =>
if (Num_Of_Data > 0) then
Gen_Descending_Data (Input_Data, Num_Of_Data);
Input_Valid := True;
end if;
when 7 =>
if (Num_Of_Data > 0) then
Read_User_Data (Input_Data, Num_Of_Data);
end if;
when 8 =>
Copy (Num_Of_Data);
if (Output_Valid) then
Bubble_Sort (Output_Data, Num_Of_Data);
Show_Output (Num_Of_Data);
end if;
when 9 =>
Copy (Num_Of_Data);
if (Output_Valid) then
Shell_Sort (Output_Data, Num_Of_Data);
Show_Output (Num_Of_Data);
end if;
when 10 =>
Copy (Num_Of_Data);
if (Output_Valid) then
Quick_Sort (Output_Data, Num_Of_Data);
Show_Output (Num_Of_Data);
end if;
when 11 =>
Copy (Num_Of_Data);
if (Output_Valid) then
Quick_Sort_Inline (Output_Data, Num_Of_Data);
Show_Output (Num_Of_Data);
end if;
when 12 =>
Sort_Loop;
when 13 =>
Show_Data;
when others =>
null;
end case;
Choice := Get_Option;
end loop;
end Do_Choice;
end Sort_Sup;
nblk1=11
nid=11
hdr6=20
[0x00] rec0=17 rec1=00 rec2=01 rec3=030
[0x01] rec0=2b rec1=00 rec2=02 rec3=054
[0x02] rec0=28 rec1=00 rec2=03 rec3=004
[0x03] rec0=26 rec1=00 rec2=04 rec3=042
[0x04] rec0=2a rec1=00 rec2=05 rec3=000
[0x05] rec0=2d rec1=00 rec2=06 rec3=018
[0x06] rec0=23 rec1=00 rec2=07 rec3=008
[0x07] rec0=27 rec1=00 rec2=08 rec3=002
[0x08] rec0=21 rec1=00 rec2=09 rec3=004
[0x09] rec0=21 rec1=00 rec2=0a rec3=036
[0x0a] rec0=1c rec1=00 rec2=0b rec3=004
[0x0b] rec0=1e rec1=00 rec2=0c rec3=04c
[0x0c] rec0=2c rec1=00 rec2=0d rec3=03a
[0x0d] rec0=1a rec1=00 rec2=0e rec3=02c
[0x0e] rec0=1a rec1=00 rec2=0f rec3=078
[0x0f] rec0=1d rec1=00 rec2=10 rec3=000
[0x10] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x217657a9e87e167ccc1c7 0x42a00088462060003
Free Block Chain:
0x11: 0000 00 00 00 04 80 01 20 01 00 00 00 00 00 00 00 00 ┆ ┆