Topspeed_JPI/TS/REP16/NDXSORT.MOD

IMPLEMENTATION MODULE NdxSort;
(*
 *  REPERTOIRE
 *  Release 1.6
 *  By Charles Bradford and Cole Brecheen
 *  (c) Copyright 1985-1992 PMI
 *  Green Bay, Wisconsin
 *  All rights reserved
 *  (414) 468-6040
 *
 *  $Header:   D:/logfiles/mods/ndxsort.mov   1.8   10 Mar 1991 15:30:36   coleb  $
 *
 *
 *  Written and contributed by Torbjorn Sund of
 *  Tromsoe, Norway.
 *
 *)


(*EntryDiag:
IMPORT Diagnostics;
:EntryDiag*)
IMPORT ErrorManager;
IMPORT GenLists;
IMPORT LowLevel;
IMPORT M2Strings;
IMPORT NdxFiles;
IMPORT NdxTypes;
IMPORT PosUtils;
IMPORT StrConv;
IMPORT StrEdit;
IMPORT SYSTEM;

VAR
  Initialized : BOOLEAN;

  PROCEDURE Init();
    BEGIN
      IF Initialized THEN
        RETURN;
      ELSE
        Initialized := TRUE;
      END;
(*EntryDiag:
      Diagnostics.Init();
:EntryDiag*)
      ErrorManager.Init();
      LowLevel.Init();
      StrEdit.Init();
      NdxTypes.Init();
      NdxFiles.Init();
      GenLists.Init();
      M2Strings.Init();
      PosUtils.Init();
      StrConv.Init();

(*EntryDiag:
      Diagnostics.diagS( 'Entering NdxSort', '' );
:EntryDiag*)

      DefMaxPos := InitDefMaxPos;

(*EntryDiag:
      Diagnostics.diagS( 'Exiting NdxSort', '' );
:EntryDiag*)
    END Init;


  CONST
    AFTERLAST = 65535;
      (* clarifies list-append operation *)

  TYPE
    String = ARRAY [0..127] OF CHAR;

(* below taken from Repertoire book *)
  PROCEDURE TypeOf(TheList : GenLists.GenList; TheElmt : CARDINAL) : CARDINAL;
    VAR
      TypeCode, DummySize : CARDINAL;
      DummyAddr : POINTER TO CARDINAL;
    BEGIN
      GenLists.GetElmtAdr(TheList, TheElmt, DummyAddr, DummySize, TypeCode);
      RETURN TypeCode;
    END TypeOf;


(* PMI. Get1Parameter below is something I seem to end up implementing
   variations upon again and again. You might use your procedure to
   parse the structure string - or at closer look it seems to be convoluted
   enough already! You might consider implementing a general, useful,
   small, fast etc parsing routine ?
*)
  PROCEDURE Get1Parameter(TheStr : ARRAY OF CHAR; TheSep : CHAR;
      TheNum : CARDINAL; VAR ThePar : ARRAY OF CHAR) : BOOLEAN;
    VAR
      AtPos, Postpos, AtNo, len : CARDINAL;
    BEGIN
      len := M2Strings.Length(TheStr);
    (* search for separator number TheNum-1 *)
      AtNo := 1;
      AtPos := 0;
      WHILE (AtPos<len) AND (AtNo<TheNum) DO
        INC(AtNo);
        AtPos := PosUtils.Positn(TheSep,TheStr,AtPos)+1;
      END;
      IF (AtNo<TheNum) OR (AtPos>=len) THEN
      (* didn't find it *)
        RETURN FALSE;
      ELSE
      (* found it, so get the parameter *)
        IF AtPos>=len THEN
          StrEdit.SetLength(ThePar, 0);
        ELSE
          Postpos := PosUtils.Positn(TheSep,TheStr,AtPos);
          IF Postpos<len THEN
            M2Strings.Copy(TheStr, AtPos, Postpos-AtPos, ThePar);
          ELSE
          (* Postpos may be greater than len, so to be on the safe side: *)
            M2Strings.Copy(TheStr, AtPos, len-AtPos, ThePar);
          END;
        END;
        RETURN TRUE;
      END;
    (* shouldn't get here *)
      HALT();
    END Get1Parameter;


  PROCEDURE CompareCriteria(e1 : SYSTEM.ADDRESS; l1 : CARDINAL; e2 : SYSTEM.ADDRESS;
      l2 : CARDINAL) : INTEGER;
(* Compare routine for SortList. It is assumed here that
   (1) the elements to be sorted are themselves lists of equal length, and
   (2) there is at least one spot in the sublists with unequal elements of
   same type.
   These conditions are guaranteed by InitCriteriaList(...) below.
*)
    VAR
      count, spot : CARDINAL;
      maxcount : CARDINAL;
      RdAd1, RdAd2 : SYSTEM.ADDRESS;
      GL1, GL2 : GenLists.GenList;
      GLP1, GLP2 : POINTER TO GenLists.GenList;
      Typ1, Typ2 : CARDINAL;
      Siz1, Siz2 : CARDINAL;
      Reslt : INTEGER;
      Str1, Str2 : String;
    BEGIN
    (* Note that it is not necessary to EXIT from the outer LOOP,
       the inner LOOP shall always RETURN (see conditions above).
    *)
      spot := 0;
      LOOP
        INC(spot);
      (* would have been nice to dereference directly through a construct
         like GLPType(e1)^, but Logitech won't take that one. Even more
         elegant of course would have been to declare e1 and e2 NOT as
         ADDRESS, but as POINTER TO GenList directly. Why couldn't a variable
         of type ADDRESS be compatible with any pointer type?
         Well, programming probably never was meant to be easy. Sigh ..
      *)
        GLP1 := e1;
        GL1 := GLP1^;
        Typ1 := TypeOf(GL1,spot);
        GLP2 := e2;
        GL2 := GLP2^;
        Typ2 := TypeOf(GL2,spot);
        IF Typ1=Typ2 THEN
                               (* should I compare apples and oranges ? *)
          IF Typ1=GenLists.StrCode THEN
            GenLists.GetElmt(GL1, spot, Str1, Typ1);
            GenLists.GetElmt(GL2, spot, Str2, Typ2);
            Reslt := M2Strings.CompareStr(Str1,Str2);
            IF Reslt#0 THEN
              RETURN Reslt;
            END;
          ELSE
(* PMI! I never sort on anything else than strings,
   so this part of the code has probably never been
   executed.
*)
            GenLists.GetElmtAdr(GL1, spot, RdAd1, Siz1, Typ1);
            GenLists.GetElmtAdr(GL2, spot, RdAd2, Siz2, Typ2);
          (* block compare could come in handy here, but the one found in
             Logitech's block ops only returns true/false. Silly *)
            count := 0;
            maxcount := Siz1;
            IF Siz2>Siz1 THEN
              maxcount := Siz2;
            END;
          (* this is probably a good place to turn off run-time checks *)
            LOOP
              INC(count);
              IF count>maxcount THEN
                EXIT;
              END;
              IF CARDINAL(RdAd1^) > CARDINAL(RdAd2^) THEN
                RETURN -1;
              ELSIF CARDINAL(RdAd1^) < CARDINAL(RdAd2^) THEN
                RETURN 1;
              END;
              LowLevel.IncAddr( RdAd1, 1 );
              LowLevel.IncAddr( RdAd2, 1 );
            END;
          END;
        (* EXITed, elements equal so far. test lengths. *)
          IF Siz1>Siz2 THEN
            RETURN -1;
          ELSIF Siz1<Siz2 THEN
            RETURN 1;
          END;
        END;
           (* IF types equal *)
      (* proceed to next element in the two lists *)
      END;
         (* LOOP *)
    (* impossible to get here *)
      HALT();
    END CompareCriteria;


  (* routine to decode the string with sort fields and optionally lengths *)
  PROCEDURE DecodeFieldStr(TheFile : NdxTypes.NdxFileType; FieldStr : ARRAY OF
      CHAR; VAR FieldList : GenLists.GenList);
  (* Give this routine an NdxFile and a string containing names of
     fields in this file, the routine will exit with FieldList containing
     a list of the position of each field in the genlist that holds the
     file's data record. Fields that are not in the file are ignored.
     The names in the FieldStr are separated by blank(s). Each name may
     optionally be followed by parameters, separated from the name and from
     each other by comma. The first parameter signifies the maximum
     number of bytes used for keeping the copy of that field in the criteria
     list, default is DefMaxSize. Subsequent parameters are (currently)
     ignored, but could easily be stored in the FieldStr to be used
     while building the criteria list.
     Execution speed has not been a concern for the implementation.
  *)
    CONST
      FieldSep = ' ';
      ParSep = ',';
    VAR
      AFieldName, AString : String;
      FieldPart, NumbrPart : String;
      MaxPos, p, dummy, AType : CARDINAL;
      found : BOOLEAN;
    BEGIN
      StrEdit.CrunchBlanks(FieldStr);
      StrEdit.CAPstr(FieldStr);
      p := 0;
      LOOP
           (* on all fields in the input string *)
        INC(p);
        IF NOT Get1Parameter(FieldStr,FieldSep,p,AString) THEN
          EXIT;
        END;
        (* look into the substructure of this parameter *)
        IF Get1Parameter(AString,ParSep,1,FieldPart) AND (M2Strings.Length(
            FieldPart)>0) THEN
          IF Get1Parameter(AString,ParSep,2,NumbrPart) AND
              StrConv.StrToCardinal(NumbrPart,0,MaxPos) AND (MaxPos>0) THEN
            IF MaxPos>255 THEN
              MaxPos := 255;
            END;
          ELSE
            MaxPos := DefMaxPos;
          END;
          (* is this a field of the file ? Could use Get1Parameter on the
             structure string instead of relying on internal details of the
             NdxFile-record.
          *)
          GenLists.GetElmt(TheFile^.StructLst, 1, AFieldName, AType);
          LOOP
            IF M2Strings.CompareStr(FieldPart,AFieldName)=0 THEN
              found := TRUE;
              EXIT;
            ELSIF GenLists.ElmtNow(TheFile^.StructLst)>=GenLists.ListLength(TheFile^.
                StructLst) THEN
              found := FALSE;
              EXIT;
            END;
            GenLists.NextElmt(TheFile^.StructLst, 1, AFieldName, AType);
          END;
               (* LOOP on structure list *)
          IF found THEN
            (* append the position and the max size *)
            dummy := GenLists.ElmtNow(TheFile^.StructLst);
            GenLists.ListInsert(dummy, 0, FieldList, AFTERLAST);
            GenLists.ListInsert(MaxPos, 0, FieldList, AFTERLAST);
          END;
        END;
             (* IF FieldPart not empty *)
      END;
           (* LOOP on the input string *)
    END DecodeFieldStr;


  PROCEDURE InitCriteriaList(TheNdxFile : NdxTypes.NdxFileType; TheIndexes :
      GenLists.GenList; FldNums : GenLists.GenList; VAR into : GenLists.GenList);
  (* Initialize the "into" criteria list for those records in TheNdxFile
     that are selected by TheIndexes. For each record, use the fields
     that are indicated by the FldNums list.
     NB. To keep NewList and DisposeList on the same program level (easier to
     verify correctness), it is left to the calling program to do a
     NewList(into) before calling InitCriteriaList.
     The "into" GenList is structured as a list of lists, where each sublist
     corresponds to a record in TheNdxFile. The elements of each sublist contain
     values fetched from fields in each data record, and FldNums specifies which
     data fields shall enter as criterion.
     In addition, the next-to-last element of each sublist contains the original
     sequence number, this guarantees that the sort is stable, and makes the
     compare routine easier (will always find two elements that are unequal).
     The last element of the sublist contains a copy of the original record
     key. It is not used during the sort but is copied back into the output
     (sorted) list after the sort is finished..
  *)
    VAR
      AType : CARDINAL;
      SubList : GenLists.GenList;
      AListPtr : POINTER TO GenLists.GenList;
      TheRec : GenLists.GenList;
      ReadAddr : SYSTEM.ADDRESS;
      TheSize, MaxSiz : CARDINAL;
      TheNum : CARDINAL;
      IndexNo : CARDINAL;
      AnIndex : NdxTypes.RecNameStr;
      AnNdxElmt : NdxTypes.NdxElement;
      TypeOK : BOOLEAN;
    BEGIN
      IF GenLists.ListLength(FldNums)=0 THEN
        RETURN;
      END;
      IndexNo := 0;
      (* Loop on the selected records in TheNdxFile *)
      WHILE IndexNo < GenLists.ListLength(TheIndexes) DO
        INC(IndexNo);
        TypeOK := TRUE;
        CASE TypeOf(TheIndexes,IndexNo) OF
          NdxTypes.NdxTypeCode :
          GenLists.GetElmt(TheIndexes, IndexNo, AnNdxElmt, AType);
          StrEdit.AssignStr(AnNdxElmt.RecName, AnIndex);
        | GenLists.StrCode :
          GenLists.GetElmt(TheIndexes, IndexNo, AnIndex, AType);
        ELSE
          TypeOK := FALSE;
        END;
        IF NOT TypeOK THEN
          ErrorManager.WARN('Improper type in TheIndexes in NdxSort.InitCriteriaList');
        ELSIF NOT NdxFiles.RecordExists(TheNdxFile,AnIndex) THEN
          (* that's ok, no such record, not much to be done then *)
        ELSIF NOT NdxFiles.GetField(TheNdxFile,AnIndex,'RECORD',AType,TheRec) THEN
          (* ? *)
          ErrorManager.WARN('Corrupted RECORD in NdxSort.InitCriteriaList');
        ELSIF AType#GenLists.ListCode THEN
          ErrorManager.WARN('Corrupted GetField in NdxSort.InitCriteriaList');
        ELSE
          (* Move each sort field into the sublist. *)
          GenLists.NewList(SubList);
          (* note structure of FldNums: REPEAT(fieldno maxfieldsize) *)
          GenLists.GetElmt(FldNums, 1, TheNum, AType);
          GenLists.NextElmt(FldNums, 1, MaxSiz, AType);
                                                (* could put this into loop *)
          LOOP
               (* on each selected field *)
            GenLists.GetElmtAdr(TheRec, TheNum, ReadAddr, TheSize, AType);
            (* It doesn't make much sense to compare lists as addresses.
               So if the field is a list, use instead the first element of the
               list, and if that element is a list, use the first element, etc,
               etc, ... ad nauseatum
            *)
            LOOP
              IF AType#GenLists.ListCode THEN
                EXIT;
              END;
              AListPtr := ReadAddr;
              IF GenLists.ListLength(AListPtr^)=0 THEN
                EXIT;
              END;
              (* retry with the first elmt of the list *)
              GenLists.GetElmtAdr(AListPtr^, 1, ReadAddr, TheSize, AType);
            END;
            GenLists.ListInsertAdr(ReadAddr, TheSize, AType, SubList, AFTERLAST);
            IF GenLists.ElmtNow(FldNums)>=GenLists.ListLength(FldNums) THEN
              EXIT;
            END;
            GenLists.NextElmt(FldNums, 1, TheNum, AType);
            GenLists.NextElmt(FldNums, 1, MaxSiz, AType);
          END;
          (* append to SubList the original position number in the main list *)
          GenLists.ListInsert(IndexNo, 0, SubList, AFTERLAST);
          (* append the record index to the sublist *)
          GenLists.ListInsert(AnIndex, GenLists.StrCode, SubList, AFTERLAST);
          (* finally append the sublist to the main list *)
          (* note that in 1.4c, the sublist is absorbed into the main list,
             so the sublist should not be disposed afterwards
          *)
          GenLists.ListInsert(SubList, GenLists.ListCode, into, AFTERLAST);
        END;
             (* IF index is proper type AND record found AND has proper type *)
      END;
           (* LOOP on all selected records *)
    END InitCriteriaList;


  PROCEDURE RefillSortedList(frm : GenLists.GenList; VAR into : GenLists.GenList);
    VAR
      AType : CARDINAL;
      AList : GenLists.GenList;
      AString : String;
    BEGIN
      (* dispose of the original key sequence found in SortedList *)
      GenLists.DisposeList(into);
      GenLists.NewList(into);
      (* initialize loop with first element of list *)
      IF GenLists.ListLength(frm)=0 THEN
        RETURN;
      END;
      GenLists.GetElmt(frm, 1, AList, AType);
      LOOP
        IF AType#GenLists.ListCode THEN
          ErrorManager.WARN('Corrupted frm in NdxSort.RefillSortedList');
        ELSE
        (* index is in the last element of each (list) element of the frm list*)
          GenLists.GetElmt(AList, GenLists.ListLength(AList), AString, AType);
          IF AType#GenLists.StrCode THEN
            ErrorManager.WARN('Corrupted frm.sublist in NdxSort.RefillSortedList');
          ELSE
            GenLists.ListInsert(AString, AType, into, AFTERLAST);
          END;
        END;
        IF GenLists.ElmtNow(frm)>=GenLists.ListLength(frm) THEN
          EXIT;
        END;
        GenLists.NextElmt(frm, 1, AList, AType);
      END;
           (* LOOP *)
    END RefillSortedList;


  PROCEDURE AltNdxSort(TheFile : NdxTypes.NdxFileType; TheFields : ARRAY OF CHAR;
    VAR TheRecordList : GenLists.GenList);
(* Finally, the main driver routine. *)
    VAR
      FieldNumbers, CriteriaList : GenLists.GenList;
    BEGIN
        (* NdxSort *)
      IF NOT GenLists.Initialized(TheRecordList) THEN
        ErrorManager.WARN(' Unitialized "TheRecordList" in call to NdxSort');
        GenLists.NewList(TheRecordList);
      END;
    (* Decode the string with the list of fields to sort on *)
      GenLists.NewList(FieldNumbers);
      DecodeFieldStr(TheFile, TheFields, FieldNumbers);
    (* Initialize the list of sort criteria *)
      GenLists.NewList(CriteriaList);
      IF GenLists.ListLength(TheRecordList)>0 THEN
      (* TheRecordList contains the list of ptrs to selected records *)
        InitCriteriaList(TheFile, TheRecordList, FieldNumbers,
            CriteriaList);
      ELSE
      (* otherwise, sort the whole file *)
        InitCriteriaList(TheFile, TheFile^.Ndx, FieldNumbers,
            CriteriaList);
      END;
    (* Sort the criteria list *)
      GenLists.SortList(CriteriaList, CompareCriteria);
    (* dispose and refill the original list of record keys *)
      RefillSortedList(CriteriaList, TheRecordList);
    (* finally do away with all temporary lists *)
      GenLists.DisposeList(CriteriaList);
      GenLists.DisposeList(FieldNumbers);
    END AltNdxSort;


BEGIN
  Initialized := FALSE;
  Init();
END NdxSort.