(*---------------------------------------------------------------------------
    :Program.    QSortDemo.mod
    :Author.     Fridtjof Siebert
    :Address.    Nobileweg 67, D-7-Stgt-40
    :Shortcut.   [fbs]
    :Version.    1.0
    :Date.       31-Dec-88
    :Copyright.  PD
    :Language.   Modula-II
    :Translator. M2Amiga v3.1d
    :Imports.    arp.library
    :Contents.   example for use of ARP.QSort, ARP.FPrintf and ARP.ArpOpen
---------------------------------------------------------------------------*)

MODULE QSortDemo;

(*------  IMPORTs:  ------*)

FROM SYSTEM    IMPORT ADR, INLINE, ADDRESS;
FROM Arts      IMPORT Assert;
FROM ARP       IMPORT QSort, ArpOpen, FPrintf, ArpAlloc, Delay;
FROM Dos       IMPORT FileHandlePtr, newFile;
FROM Intuition IMPORT CurrentTime;

(*------  CONSTs:  ------*)

CONST
  con  = "CON:0/0/320/200/M2 QSortDemo using ARP.QSort";
  size = 10000;

(*------  VARs:  ------*)

VAR
  array: POINTER TO ARRAY[0..size-1] OF CARDINAL;
  out: FileHandlePtr;
  cnt: INTEGER;
  rnd: LONGINT;
  Size: CARDINAL;

(*------  Compare Procedure:  ------*)

PROCEDURE CmpProc(); (* $E- assembly code *)
(* this mustn't be written in MODULA-II because A4 and A5 must be saved ! *)
BEGIN
  INLINE(3010H);   (* move  (A0),D0; *)
  INLINE(9051H);   (* sub   (A1),D0; *)
  INLINE(48C0H);   (* ext.l D0;      *)
  INLINE(4E75H);   (* rts;           *)
END CmpProc;

(*------  Print Text and LineFeed:  ------*)

PROCEDURE Print(str: ADDRESS; args: ADDRESS);
VAR
  l: INTEGER;
  lf: ARRAY[0..1] OF CHAR;
BEGIN
  lf[0] := 12C; lf[1] := 0C;
  Assert(FPrintf(out,str    ,args)>0,ADR("FPrintf failed "));
  Assert(FPrintf(out,ADR(lf),NIL )>0,ADR("FPrintf failed "));
END Print;

(*------  Sort Array and stop time:  ------*)

PROCEDURE SortArray();
VAR
  Time1,Time2: RECORD secs,mics: LONGINT END;
BEGIN
  Print(ADR("Sorting %d elements."),ADR(Size));
  CurrentTime(ADR(Time1.secs),ADR(Time1.mics));
  Assert(QSort(array,size,SIZE(array^[0]),CmpProc),ADR("Stack Overflow!"));
  CurrentTime(ADR(Time2.secs),ADR(Time2.mics));
  IF Time2.mics<Time1.mics THEN INC(Time2.mics,1000000); DEC(Time1.secs,1) END;
  Time2.mics := (Time2.mics - Time1.mics) DIV 1000;
  DEC(Time2.secs,Time1.secs);
  Print(ADR("    %lds, %ldms"),ADR(Time2));
END SortArray;

(*------  MAIN:  ------*)

BEGIN

(*------  Init:  ------*)

  Size := size; (* this is necessary because ADR(size) causes an error *)
  array := ArpAlloc(SIZE(array^));
  Assert(array#NIL,ADR("out of memory"));
  out := ArpOpen(ADR(con),newFile);
  Assert(out#NIL,ADR("Couldn't open CON:"));

(*------  Sort Random Array:  ------*)

  Print(ADR("Creating %d random numbers."),ADR(Size));
  rnd := 0;
  FOR cnt:=0 TO size-1 DO
    (* $V- $R- disable overflow and range checking *)
    rnd := (rnd * 54321 + 123456789) MOD 678901;
    (* $V+ $R+ *)
    array^[cnt] := rnd MOD 25000;
  END;
  SortArray();

(*------  Presorted Array:  ------*)

  Print(ADR("Creating presorted array."),ADR(Size));
  FOR cnt:=0 TO size-1 DO
    array^[cnt] :=  cnt;
  END;
  SortArray();

(*------  Descending Array:  ------*)

  Print(ADR("Creating descending array."),ADR(Size));
  FOR cnt:=0 TO size-1 DO
    array^[cnt] :=  size-cnt;
  END;
  SortArray();
  Print(ADR("Done."),NIL);

  Delay(100);

END QSortDemo.