DataMuseum.dk

top - metrics - download

    Length: 5348 (0x14e4)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

----------------------------------------------------------------------
--
--    QUICK SORT BENCHMARK
--
--    Version: @(#)qsortpar.ada 1.1 Date: 6/5/84
--
--       Gerry Fisher
--      Computer Sciences Corporation
--
--       May 26, 1984
--
--  This benchmark consists of two versions of the familiar quick
--  sort algorithm: a parallel version and a sequential version.
--  A relatively small vector (length 100) is sorted into ascending
--  sequence.  The number of comparisons and exchanges is counted.
--  In the parallel version separate tasks are created to sort the
--  two subvectors created by partitioning the vector.  Each task
--  invokes the quicksort procedure.  The parallel version is
--  functionally equivalent to the sequential version and should
--  require the same number of comparisions and exchanges.  A check
--  is made to verify that this is so.  Also, the sorted vector is
--  checked to verify that the sort has been performed correctly.
--  Control is exercised so that no more than fourteen tasks are
--  created when sorting the vector.
--
--  The sorting is repeated a number of times to obtain a measurable
--  amount of execution time.
--
--  The important measure for this benchmark is the ratio of the
--  execution time of the parallel version to that of the sequential
--  version.  This will give some indication of task activation and
--  scheduling overhead.
--
--  One file is used for both versions.  The boolean constant "p"
--  indicates whether the parallel or serial version of the algorithm
--  is to be used.  Simply set this constant TRUE for the parallel
--  test and FALSE for the sequential test.  A difference in code
--  size between the two tests may indicate that conditional
--  compilation is supported by the compiler.
--
------------------------------------------------------------------------

with Text_Io;
use Text_Io;
procedure Main is
    Failed : exception;

    type Vector is array (Integer range <>) of Integer;

    type Stats is
        record
            C, E : Integer := 0;
        end record;

    P : constant Boolean := True;  -- true for parallel algorithm
    N : constant Integer := 100;          -- size of vector to be sorted
    M : constant Integer := 100;          -- number of times to sort vector

    X : Vector (1 .. N);

    Y : Stats;

    procedure Quick_Sort (A : in out Vector; W : out Stats) is
        Lb : constant Integer := A'First;
        Ub : constant Integer := A'Last;
        K : Integer;

        C, E : Integer := 0;
        U, V : Stats;

        function Partition (L, U : Integer) return Integer is
            Q, R, I, J : Integer;
        begin

            R := A ((U + L) / 2);
            I := L;
            J := U;

            while I < J loop
                while A (I) < R loop
                    C := C + 1;
                    I := I + 1;
                end loop;

                while A (J) > R loop
                    C := C + 1;
                    J := J - 1;
                end loop;

                C := C + 2;

                if I <= J then
                    E := E + 1;
                    Q := A (I);
                    A (I) := A (J);
                    A (J) := Q;
                    I := I + 1;
                    J := J - 1;
                end if;
            end loop;

            if J > L then
                return J;
            else
                return L;
            end if;

        end Partition;

    begin
        if Lb < Ub then

            K := Partition (Lb, Ub);

            if Ub > Lb + 15 then
                if P then
                    declare
                        task S1;

                        task body S1 is
                        begin
                            Quick_Sort (A (Lb .. K), U);
                        end S1;

                        task S2;

                        task body S2 is
                        begin
                            Quick_Sort (A (K + 1 .. Ub), V);
                        end S2;
                    begin
                        null;
                    end;

                else
                    Quick_Sort (A (Lb .. K), U);
                    Quick_Sort (A (K + 1 .. Ub), V);
                end if;

            elsif Ub > Lb + 1 then
                Quick_Sort (A (Lb .. K), U);
                Quick_Sort (A (K + 1 .. Ub), V);
            end if;

            E := E + U.E + V.E;
            C := C + U.C + V.C;

        end if;

        W := (C, E);

    end Quick_Sort;

begin

    Set_Line_Length (Count (50));

    if P then
        Put_Line ("*** Starting Parallel Quick Sort Benchmark");
    else
        Put_Line ("*** Starting Sequential Quick Sort Benchmark");
    end if;

    for K in 1 .. M loop

        for I in X'Range loop
            X (I) := X'Last - I + 1;
        end loop;

        Quick_Sort (X, Y);

        for I in X'First .. X'Last - 1 loop
            if X (I) > X (I + 1) then
                raise Failed;
            end if;
        end loop;

        Put (".");

    end loop;

    New_Line;

    if Y.C /= 782 or else Y.E /= 148 then
        Put_Line ("*** FAILED Wrong number of comparisons or exchanges");
    else
        Put_Line ("*** PASSED Sorting test");
    end if;

exception
    when Failed =>
        Put_Line ("*** FAILED Vector not sorted");

end Main;