home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / btree / tree / sort.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-27  |  36.4 KB  |  898 lines
  1. (* TBTree16             Copyright (c)  1988,1989       Dean H. Farwell II    *)
  2.  
  3. unit Sort;
  4.  
  5. (*****************************************************************************)
  6. (*                                                                           *)
  7. (*                       S O R T    R O U T I N E S                          *)
  8. (*                                                                           *)
  9. (*****************************************************************************)
  10.  
  11.  
  12. (* This unit contains the data types and routines required to sort logical
  13.    record lists.  It will handle logical record lists created from either
  14.    fixed length (LOGICAL unit) or variable length (VLOGICAL unit) record data
  15.    files.  A logical record list can be sorted on any number of fields.  This
  16.    unit technically violates the object oriented design techniques used
  17.    throughout TBTREE because it directly manipulates an object ( LrList)
  18.    external to this unit.  This is done to optimize performance.  To alleviate
  19.    this, I could combine this unit with the LRECLIST unit.  I opted against
  20.    this since sorting is considered by most people to be a separate type of
  21.    operation than the operations performed by the LRECLIST unit.  The decision
  22.    really doesn't affect anything as far as the user is concerned.
  23.  
  24.    Sorting using this unit is generally straighforward.  To sort a logical
  25.    record list takes two steps.  The first is to build a sort field list, a
  26.    list containing information on each of the fields to sort on.  The second
  27.    step is to call SortList with the correct parameters.  Once the sort is
  28.    completed you should call DestroySortList which will return the space
  29.    used to store the sort field list.  This last step does not need done if
  30.    you intend to sort on the same fields at a later time.
  31.  
  32.    Step 1 - Call AddFieldToSortList for each field to sort on.  In other words
  33.    if you are sorting on three fields, you must call AddFieldToSortList three
  34.    times.  When calling the routine you must supply a sort field variable (a
  35.    pointer) which is equal to NIL for the first call to the routine.  You must
  36.    also supply the size of the field in bytes and the byte position of the
  37.    field within the logical record and the ValueType of the field.  Again, for
  38.    the first call, when building a list, sPtr must be NIL.  The
  39.    AddFieldToSortList routine must be called once for each field.  The field
  40.    passed in the first call has the highest sort precedence.  The field passed
  41.    in as the next field will have the next highest precedence etc.  The only
  42.    tricky part is determining the byte position of a field within a logical
  43.    record.  Probably the only way to do it is manually determine how much room
  44.    is taken be the preceding fields. An easy way to store it is to have a
  45.    record which contains the position for each field.  For example:
  46.  
  47.         MyRecord = record
  48.             name     : String[20];
  49.             age      : Byte;
  50.             jobTitle : JobType;   { assume it's an enumerated type }
  51.             end;
  52.  
  53.         MyRecordPos = record
  54.             namePos     : Byte;
  55.             agePos      : Byte;
  56.             jobTitlePos : Byte;
  57.             end;
  58.  
  59.          var myPos : MyRecordPos;
  60.  
  61.          procedure SetPosMyRecord;
  62.  
  63.              begin
  64.              myPos.namePos := 1;
  65.              myPos.agePos := 22;   { note it's not 21 since the previous field
  66.                                      is 21 bytes (1 for the length) }
  67.              myPos.jobTitlePos := 23;
  68.              end;
  69.  
  70.          var sPtr : SortFieldList;
  71.  
  72.          procedure BuildMyList;
  73.  
  74.              begin           { sort on age then name
  75.              sPtr := NIL;    { very important !! }
  76.              AddFieldToSortList(sPtr,myPos.agePos,BYTEVALUE);
  77.              AddFieldToSortList(sPtr,myPos.namePos,STRINGVALUE):
  78.              end;
  79.  
  80.  
  81.    This method will make it easier if you're ever change your logical record
  82.    definitions.
  83.  
  84.    Step 2 - Now that you have built the list, simply call SortList.  The call
  85.    is simple.  The list to sort, the file name of the data file and the sort
  86.    field list are all passed in.  Also, a boolean variable is passed in.  If
  87.    the sort was successful, TRUE will be returned in that variable.  If there
  88.    was not enough heap space available to perform the sort, FALSE is returned.
  89.  
  90.    Once the call is made the list will be sorted and returned.  One thing
  91.    is important to realize.  Sorting takes time.  Although the calls are
  92.    simple to the user, there is a great deal of work going on behind the
  93.    scenes.  Sort times will vary from seconds to minutes depending on the size
  94.    of the list and to a lesser extent the size of the logical records and the
  95.    type of fields.  In version 1.5 I made significant changes which speed up
  96.    sorting by about a factor of 3.  I have included an example program which
  97.    can be used as desired.
  98.  
  99.    note - I used the QuickSort algorithm found in the book Data Structures and
  100.    Algorithms by Aho, Hopcroft and Ullman.  I took the liberty of making a few
  101.    changes to speed them up for this particular application.                 *)
  102.  
  103. (*\*)
  104. (* Version Information
  105.  
  106.    Version 1.1 - Not Applicable.  This unit was introduced in version 1.2
  107.  
  108.    Version 1.2 - Added this entire unit.
  109.  
  110.    Version 1.3 - No Changes
  111.  
  112.    Version 1.4 - Added Numbers unit to uses clause
  113.  
  114.                - Deleted size parameter from the SortList routine
  115.  
  116.    Version 1.5 - Changed entire unit internally to significantly increase
  117.                  performance
  118.  
  119.                - Changed code internally to use Inc and Dec where practical
  120.  
  121.                - Changed the call to SortList.  Now, a variable is set to TRUE
  122.                  if the sort was successful.  If there was not enough heap
  123.                  space available, it is set to FALSE.
  124.  
  125.    Version 1.6 - Fixed error which occurred which would lead to an infinite
  126.                  loop when the heap became full while allocating heap space
  127.                  for the sort.
  128.  
  129.                - Changed unit internally to facilitate sorting variable length
  130.                  record files.
  131.  
  132.                - Fixed error which caused a sort field list to be modified
  133.                  after a sort is accomplished.  Now, the sort field list is
  134.                  unmodified upon return (as advertised)
  135.  
  136.                - Fixed error which caused record numbers to be lost from a
  137.                  logical record list upon termination of the sort
  138.  
  139.                - Fixed internal error which occurred during allocation of
  140.                  memory required for sorting                                 *)
  141.  
  142. (*\*)
  143. (*////////////////////////// I N T E R F A C E //////////////////////////////*)
  144.  
  145. interface
  146.  
  147. uses
  148.     Compare,
  149.     FastMove,
  150.     FileDecs,
  151.     Files,
  152.     Logical,
  153.     LRecList,
  154.     Numbers,
  155.     Page,
  156.     Vlogical;
  157.  
  158. type
  159.     SortFieldPosition = DataSizeRange;   (* byte position of sort field
  160.                                             within the data record           *)
  161.  
  162.     SortFieldList = ^SortField; (* used to form a linked list containing info
  163.                                    about sort fields                         *)
  164.  
  165.     SortField = record                        (* used to keep info about one
  166.                                                  sort field                  *)
  167.               size  : DataSizeRange;          (* size of sort field in bytes *)
  168.               dataPos   : SortFieldPosition;  (* byte position of sort field
  169.                                                  relative to the beginning of
  170.                                                  the data record             *)
  171.               sortPos : SortFieldPosition;    (* byte position of sort field
  172.                                                  relative to the beginning of
  173.                                                  the sort record             *)
  174.               vType : ValueType;                        (* type of the field *)
  175.               next  : SortFieldList;
  176.               end;
  177.  
  178. (*\*)
  179. (* This routine will take a previously used list and delete all entries.  sPtr
  180.    will end up being NIL after the call.  It is important to call this routine
  181.    rather than just setting sPtr to NIL because this routine will return the
  182.    heap space used by the list.                                              *)
  183.  
  184. procedure DestroySortList(var sPtr : SortFieldList);
  185.  
  186.  
  187. (* This routine will add one sort field to the end of a sort field list.  The
  188.    size of the field (in bytes), the byte position of the field within the
  189.    data record and the type of the field must be supplied.  The pointer to the
  190.    sort field list must also be supplied.  Remember, when this routine is
  191.    called for the first field, sPtr must equal NIL!!!  The list is kept in the
  192.    order of entry. Therefore, the first entry should be the first field to
  193.    sort on, the second field should be the next field to sort on if the first
  194.    fields in two or more records contain the same value etc.
  195.  
  196.    Note : Two improtant notes are in order here.  First, you must specify pos
  197.    such that the entire field is part of the data record.  In other words,
  198.    make sure that you don't pass in pos = 11 when the data record is only 10
  199.    bytes long.  Likewise, if the field is 2 bytes long and the data record is
  200.    10 bytes long, pos must be 9 or less to make sense.  Secondly, you must be
  201.    extra careful when dealing with variable length record data files.  The
  202.    fields to sort on must still be in a fixed place in every record, or the
  203.    sort will not function properly.  To accommodate this, you should put the
  204.    fixed parts of the record in the beginning and the variable length parts at
  205.    the end.  Then you can sort on the fixed length fields and possibly the
  206.    first variable length field (since its position will be fixed).           *)
  207.  
  208. procedure AddFieldToSortList(var sPtr : SortFieldList;
  209.                              size : DataSizeRange;
  210.                              pos : SortFieldPosition;
  211.                              vType : ValueType);
  212.  
  213. (*\*)
  214. (* This routine sorts a logical record list (lrLst) in ascending order using
  215.    the sort field list passed in as a parameter.  The file name for the data
  216.    file must also be passed in.  lrlst is passed in unsorted and is returned
  217.    sorted in ascending order.  If the caller wants to traverse the list in
  218.    descending order, call this routine and traverse the resulting list in
  219.    reverse order.
  220.  
  221.    note - prior to sorting, this routine checks the heap to see if there is
  222.    sufficient heap space to perform the sort.  The routine requires 2 blocks
  223.    of heap memory each equal to the number of bytes required to store all of
  224.    the sort fields together and one block equal to the logical record size of
  225.    the data records in the data file (fName).  There must be enough room on
  226.    the heap to hold these blocks.  It also needs enough space to copy the list
  227.    held in sPtr.  This working copy is required so that the list represented
  228.    by sPtr will not be modified upon return.  If there is not enough heap
  229.    space the sort is terminated and success is returned with a value of FALSE.
  230.    The list and the SortFiledList will be returned unchanged.  If there is
  231.    enough heap space, the list will be sorted and success will be returned
  232.    equal to TRUE.  Although, a sort will be successful if the minimum heap
  233.    space is available, performance will be greatly increased if there is more
  234.    room available on the heap.  Try to make sure that there is about 40K bytes
  235.    or so available.  Large sort fields (strings) or a large number of sort
  236.    fields will benefit from even more heap space.  Once the sort is completed,
  237.    any space used is returned to the available heap space. Therefore, it makes
  238.    sense to leave as much heap space for the sort as you can.                *)
  239.  
  240. procedure SortList(var lrLst : LrList;                       (* list to sort *)
  241.                    fName : FnString;                       (* data file name *)
  242.                    sPtr : SortFieldList;
  243.                    var success : Boolean);        (* list holding sort fields *)
  244.  
  245.  
  246. (*!*)
  247. (*\*)
  248. (*///////////////////// I M P L E M E N T A T I O N /////////////////////////*)
  249.  
  250. implementation
  251.  
  252. const
  253.     MAXSORTINDEX = 500;           (* number of cells in the SortPointerArray *)
  254.  
  255. type
  256.     SortIndexRange = 1 .. MAXSORTINDEX;
  257.  
  258.     HeapArrayPtr = ^HeapArray;
  259.     HeapArray = Array[1 .. MAXDATASIZE] of Byte;   (* can't use DataSizeRange
  260.                                                       because of zero
  261.                                                       subscript              *)
  262.  
  263.     SortPointerRecord = record
  264.         lrNum : LrNumber;
  265.         heapPtr : HeapArrayPtr;               (* pointer to the heap where
  266.                                                    sort fields are located   *)
  267.         end;
  268.  
  269.     SortPointerArray = Array [SortIndexRange] of SortPointerRecord;
  270.  
  271.  
  272. (* This routine will copy the sort field list sPtr to newSPtr.  sPtr will not
  273.    be affected.  The routine will return TRUE if there was enough heap space
  274.    to do the copy and FALSE otherwise.                                       *)
  275.  
  276. function CopySortList(sPtr : SortFieldList;
  277.                       var newSPtr : SortFieldList) : Boolean;
  278.  
  279. var
  280.     tempPtr1,
  281.     tempPtr2 : SortFieldList;
  282.  
  283.     begin
  284.     tempPtr1 := sPtr;
  285.     tempPtr2 := NIL;
  286.     while (tempPtr1 <> NIL) and
  287.           (MaxAvail >= SizeOf(SortField)) do
  288.         begin
  289.         if tempPtr2= NIL then
  290.             begin
  291.             New(tempPtr2);
  292.             newSPtr := tempPtr2;
  293.             end
  294.         else
  295.             begin
  296.             New(tempPtr2^.next);
  297.             tempPtr2 := tempPtr2^.next;
  298.             end;
  299.         tempPtr2^ := tempPtr1^;
  300.         tempPtr1 := tempPtr1^.next;
  301.         end;
  302.     CopySortList := (tempPtr1 = NIL);
  303.     end;                                      (* end of CopySortList routine *)
  304.  
  305. (*\*)
  306. (* This routine will take a previously used list and delete all entries.  sPtr
  307.    will end up being NIL after the call.  It is important to call this routine
  308.    rather than just setting sPtr to NIL because this routine will return the
  309.    heap space used by the list.                                              *)
  310.  
  311. procedure DestroySortList(var sPtr : SortFieldList);
  312.  
  313. var
  314.     tempPtr : SortFieldList;
  315.  
  316.     begin
  317.     while sPtr <> NIL do
  318.         begin
  319.         tempPtr := sPtr^.next;
  320.         Dispose(sPtr);
  321.         sPtr := tempPtr;
  322.         end;
  323.     end;                                   (* end of DestroySortList routine *)
  324.  
  325. (*\*)
  326. (* This routine will add one sort field to the end of a sort field list.  The
  327.    size of the field (in bytes), the byte position of the field within the
  328.    data record and the type of the field must be supplied.  The pointer to the
  329.    sort field list must also be supplied.  Remember, when this routine is
  330.    called for the first field, sPtr must equal NIL!!!  The list is kept in the
  331.    order of entry. Therefore, the first entry should be the first field to
  332.    sort on, the second field should be the next field to sort on if the first
  333.    fields in two or more records contain the same value etc.
  334.  
  335.    Note : Two improtant notes are in order here.  First, you must specify pos
  336.    such that the entire field is part of the data record.  In other words,
  337.    make sure that you don't pass in pos = 11 when the data record is only 10
  338.    bytes long.  Likewise, if the field is 2 bytes long and the data record is
  339.    10 bytes long, pos must be 9 or less to make sense.  Secondly, you must be
  340.    extra careful when dealing with variable length record data files.  The
  341.    fields to sort on must still be in a fixed place in every record, or the
  342.    sort will not function properly.  To accommodate this, you should put the
  343.    fixed parts of the record in the beginning and the variable length parts at
  344.    the end.  Then you can sort on the fixed length fields and possibly the
  345.    first variable length field (since its position will be fixed).           *)
  346.  
  347. procedure AddFieldToSortList(var sPtr : SortFieldList;
  348.                              size : DataSizeRange;
  349.                              pos : SortFieldPosition;
  350.                              vType : ValueType);
  351.  
  352. var
  353.     tempPtr : SortFieldList;
  354.  
  355.     begin
  356.     if sPtr = NIL then
  357.         begin
  358.         New(sPtr);
  359.         tempPtr := sPtr;
  360.         end
  361.     else
  362.         begin
  363.         tempPtr := sPtr;
  364.         while tempPtr^.next <> NIL do
  365.             begin
  366.             tempPtr := tempPtr^.next;
  367.             end;
  368.         New(tempPtr^.next);
  369.         tempPtr := tempPtr^.next;
  370.         end;
  371.     tempPtr^.size := size;
  372.     tempPtr^.dataPos := pos;
  373.     tempPtr^.sortPos := 0;
  374.     tempPtr^.vType := vType;
  375.     tempPtr^.next := NIL;
  376.     end;                                (* end of AddFieldToSortList routine *)
  377.  
  378.  
  379. (*\*)
  380. (* This routine sorts a logical record list (lrLst) in ascending order using
  381.    the sort field list passed in as a parameter.  The file name for the data
  382.    file must also be passed in.  lrlst is passed in unsorted and is returned
  383.    sorted in ascending order.  If the caller wants to traverse the list in
  384.    descending order, call this routine and traverse the resulting list in
  385.    reverse order.
  386.  
  387.    note - prior to sorting, this routine checks the heap to see if there is
  388.    sufficient heap space to perform the sort.  The routine requires 2 blocks
  389.    of heap memory each equal to the number of bytes required to store all of
  390.    the sort fields together and one block equal to the logical record size of
  391.    the data records in the data file (fName).  There must be enough room on
  392.    the heap to hold these blocks.  It also needs enough space to copy the list
  393.    held in sPtr.  This working copy is required so that the list represented
  394.    by sPtr will not be modified upon return.  If there is not enough heap
  395.    space the sort is terminated and success is returned with a value of FALSE.
  396.    The list and the SortFiledList will be returned unchanged.  If there is
  397.    enough heap space, the list will be sorted and success will be returned
  398.    equal to TRUE.  Although, a sort will be successful if the minimum heap
  399.    space is available, performance will be greatly increased if there is more
  400.    room available on the heap.  Try to make sure that there is about 40K bytes
  401.    or so available.  Large sort fields (strings) or a large number of sort
  402.    fields will benefit from even more heap space.  Once the sort is completed,
  403.    any space used is returned to the available heap space. Therefore, it makes
  404.    sense to leave as much heap space for the sort as you can.                *)
  405.  
  406. procedure SortList(var lrLst : LrList;                       (* list to sort *)
  407.                    fName : FnString;                       (* data file name *)
  408.                    sPtr : SortFieldList;
  409.                    var success : Boolean);       (* list holding sort fields *)
  410.  
  411. var
  412.     newSPtr : SortFieldList;              (* holds temporary copy of newSPtr *)
  413.     newLrLst : LrList;
  414.     sPtrArr : SortPointerArray;
  415.     sRecSize : DataSizeRange; (* size of record created from all sort fields *)
  416.     lRecSize : DataSizeRange;                         (* logical record size *)
  417.     recs,
  418.     recsInArray : SortIndexRange;
  419.     recsLeft : LrNumber;
  420.     extraHeapPtr : HeapArrayPtr;  (* used to point to heap location which will
  421.                                      be used for two purposes at separate
  422.                                      times as follows:
  423.                                      current record in the lrList being merged
  424.                                      copy of the pivot sort record           *)
  425.  
  426.     logicalHeapPtr : HeapArrayPtr; (* used to initially hold the logical
  427.                                       record when it is read in              *)
  428.     dummyLrNum : LrNumber;
  429.  
  430.  
  431. (*\*)
  432.     (* This routine will determine the logical record size needed to hold the
  433.        varialble length data file logical records.  It will dtermine what the
  434.        minimum needed is.                                                    *)
  435.  
  436.     function CalculateDataRecordSize : DataSizeRange;
  437.  
  438.     var
  439.         tempPtr : SortFieldList;
  440.         recSize,
  441.         lastByte : DataSizeRange;
  442.  
  443.         begin
  444.         recSize := 0;
  445.         tempPtr := newSPtr;
  446.         while tempPtr <> nil do
  447.             begin
  448.             lastByte := (tempPtr^.dataPos - 1) + tempPtr^.size;
  449.             if recSize < lastByte then
  450.                 begin
  451.                 recSize := lastByte;
  452.                 end;
  453.             tempPtr := tempPtr^.next;
  454.             end;
  455.         CalculateDataRecordSize := recSize;
  456.         end;                      (* end of CalcualteDataRecordSize roautine *)
  457.  
  458.  
  459.     (* This routine will calculate the total of the size of all the sort
  460.        fields.  It will also update the sort list to show the byte position
  461.        within the sort record for each field.                                *)
  462.  
  463.     function GetSortRecordSize : DataSizeRange;
  464.  
  465.     var
  466.         tempPtr : SortFieldList;
  467.         recSize : DataSizeRange;
  468.  
  469.         begin
  470.         recSize := 0;
  471.         tempPtr := newSPtr;
  472.         while tempPtr <> NIL do
  473.             begin
  474.             tempPtr^.sortPos := recSize + 1;
  475.             Inc(recSize,tempPtr^.size);
  476.             tempPtr := tempPtr^.next;
  477.             end;
  478.         GetSortRecordSize := recSize;
  479.         end;                             (* end of GetSortRecordSize routine *)
  480.  
  481. (*\*)
  482.     (* This routine will allocate, on the heap, the three distinct blocks of
  483.        memory required to perform a sort.                                    *)
  484.  
  485.     function AllocateMinimumSortSpace : Boolean;
  486.  
  487.         begin
  488.         if MaxAvail >= sRecSize then
  489.             begin
  490.             GetMem(extraHeapPtr,sRecSize);
  491.             end
  492.         else
  493.             begin
  494.             AllocateMinimumSortSpace := FALSE;
  495.             Exit;
  496.             end;
  497.         if MaxAvail >= sRecSize then
  498.             begin
  499.             GetMem(sPtrArr[1].heapPtr,sRecSize);
  500.             end
  501.         else
  502.             begin
  503.             FreeMem(extraHeapPtr,sRecSize);
  504.             AllocateMinimumSortSpace := FALSE;
  505.             Exit;
  506.             end;
  507.         if MaxAvail >= lRecSize then
  508.             begin
  509.             GetMem(logicalHeapPtr,lRecSize);
  510.             end
  511.         else
  512.             begin
  513.             FreeMem(extraHeapPtr,sRecSize);
  514.             FreeMem(sPtrArr[1].heapPtr,sRecSize);
  515.             AllocateMinimumSortSpace := FALSE;
  516.             Exit;
  517.             end;
  518.         AllocateMinimumSortSpace := TRUE;
  519.         end;                      (* end of AllocateMinimumSortSpace routine *)
  520.  
  521. (*\*)
  522.     (* This routine will allocate the space required for as many sort records
  523.        (records made up of sort fields only) as will fit on the heap  (up to
  524.        MAXSORTINDEX).  This routine assumes that AllocateMinimumSortSpace has
  525.        been called and the space for the first entry (idx = 1) has already
  526.        been allocated.  It will return the total number of records allocated,
  527.        including the first entry.                                            *)
  528.  
  529.     function AllocateSortSpace : SortIndexRange;
  530.  
  531.     var
  532.         idx : SortIndexRange;
  533.         done : Boolean;
  534.  
  535.         begin
  536.         idx := 1;
  537.         done := FALSE;
  538.         while (not done) and (idx < MAXSORTINDEX) do
  539.             begin
  540.             if MaxAvail >= sRecSize then
  541.                 begin
  542.                 Inc(idx);
  543.                 GetMem(sPtrArr[idx].heapPtr,sRecSize);
  544.                 end
  545.             else
  546.                 begin
  547.                 done := TRUE;
  548.                 end;
  549.             end;
  550.         AllocateSortSpace := idx;
  551.         end;                             (* end of AllocateSortSpace routine *)
  552.  
  553. (*\*)
  554.     (* This routine will retrieve one logical record and build the sort record
  555.        from it.                                                              *)
  556.  
  557.        procedure GetOneSortRecord(lrNum : LrNumber;
  558.                                   heapPtr : HeapArrayPtr);
  559.  
  560.        var
  561.            sortPos : SortFieldPosition;
  562.            tempPtr : SortFieldList;
  563.  
  564.            begin
  565.            if FetchFileType(fName) = DATA then
  566.                begin
  567.                GetALogicalRecord(fName,lrNum,logicalHeapPtr^);
  568.                end
  569.            else
  570.                begin
  571.                VLRGetPartialLogicalRecord(fName,lrNum,
  572.                                           logicalHeapPtr^,lRecSize);
  573.                end;
  574.            sortPos := 1;
  575.            tempPtr := newSPtr;
  576.            while TRUE do
  577.                begin             (* somewhat strange loop structure required
  578.                                     to keep sortPos within range             *)
  579.                FastMover(logicalHeapPtr^[tempPtr^.dataPos],
  580.                          heapPtr^[sortPos],
  581.                          tempPtr^.size);
  582.                if tempPtr^.next = NIL then
  583.                    begin
  584.                    Exit;                             (* only way out of loop *)
  585.                    end;
  586.                Inc(sortPos,tempPtr^.size);
  587.                tempPtr := tempPtr^.next;
  588.                end;
  589.            end;                           (* end of GetOneSortRecord routine *)
  590.  
  591. (*\*)
  592.     (* This routine will get the number of records specified (n) and will
  593.        build the sort records on the heap.  It will make the appropriate
  594.        entries in the SortPointerArray.  It will retrieve logical record
  595.        numbers from the logical record list starting at the present position.
  596.        The cursor will be advanced as the records are retrieved.  The routine
  597.        must not be called if the cursor is not positioned properly.
  598.  
  599.        One note!!! - this routine always gets (n) records.  The caller must
  600.        ensure that there are n records available                             *)
  601.  
  602.     procedure GetSortRecords(var lrLst : LrList;
  603.                              n : SortIndexRange);
  604.  
  605.     var
  606.         idx : SortIndexRange;
  607.         lrNum : LrNumber;
  608.  
  609.         begin
  610.         lrNum := GetCurrLr(lrLst);
  611.         for idx := 1 to n do
  612.             begin
  613.             sPtrArr[idx].lrNum := lrNum;
  614.             GetOneSortRecord(lrNum,sPtrArr[idx].heapPtr);
  615.             lrNum := GetNextlr(lrLst);
  616.             end;
  617.         end;                                (* end of GetSortRecords routine *)
  618.  
  619. (*\*)
  620.     (* This routine will compare logical record stored at the location
  621.        specified by heapPtr1 with the logical record stored at the location
  622.        specified by heapPtr2. The routine will return LESSTHAN if the first
  623.        record is less than the second record for the sort fields in sPtr.   It
  624.        will return EQUALTO if the records are equal for those sort fields.  It
  625.        will return GREATERTHAN if the first record is greater than the second
  626.        record for those sort fields.                                         *)
  627.  
  628.     function CompareRecords(heapPtr1 : HeapArrayPtr;
  629.                             heapPtr2 : HeapArrayPtr) : Comparison;
  630.  
  631.     var
  632.         tempPtr : SortFieldList;
  633.         done : Boolean;
  634.         result : Comparison;
  635.  
  636.         begin
  637.         tempPtr := newSPtr;
  638.         done := FALSE;
  639.         while not done do
  640.             begin
  641.             result := CompareValues(heapPtr1^[tempPtr^.sortPos],
  642.                                     heapPtr2^[tempPtr^.sortPos],
  643.                                     tempPtr^.vType);
  644.             case result of
  645.                 LESSTHAN :
  646.                     begin
  647.                     done := TRUE;
  648.                     end;
  649.                 GREATERTHAN :
  650.                     begin
  651.                     done := TRUE;
  652.                     end;
  653.                 EQUALTO :
  654.                     begin
  655.                     tempPtr := tempPtr^.next;
  656.                     done := (tempPtr = NIL);
  657.                     end;
  658.                 end;                                (* end of case statement *)
  659.             end;
  660.         CompareRecords := result;
  661.         end;                                (* end of CompareRecords routine *)
  662.  
  663.  
  664. (*\*)
  665.     (* This routine sorts the SortPointerArray in ascending order            *)
  666.  
  667.     procedure SortRecords(n : SortIndexRange);
  668.  
  669.     type
  670.  
  671.         ModifiedSortIndexRange = 0 .. 501;    (* needed for the quicksort
  672.                                                  routines
  673.                                                  should really be
  674.                                                  MAXSORTINDEX + 1            *)
  675.  
  676.         (* This routine swaps two values in the sPtrArr                      *)
  677.  
  678.         procedure Swap(idx1 : SortIndexRange;
  679.                        idx2 : SortIndexRange);
  680.  
  681.         var
  682.             temp : SortPointerRecord;
  683.  
  684.             begin
  685.             temp := sPtrArr[idx1];
  686.             sPtrArr[idx1] := sPtrArr[idx2];
  687.             sPtrArr[idx2] := temp;
  688.             end;                                      (* end of Swap routine *)
  689.  
  690. (*\*)
  691.     (* This routine will return the logical record number for the record which
  692.        is the pivot record.                                                  *)
  693.  
  694.         function FindPivot(idx1 : SortIndexRange;
  695.                            idx2 : SortIndexRange) : ModifiedSortIndexRange;
  696.  
  697.         var
  698.             idx3 : ModifiedSortIndexRange;
  699.             mid : SortIndexRange;
  700.  
  701.         begin
  702.         mid := (idx1 + idx2) Div 2;      (* used to speed up sorts in the case
  703.                                             where the records are almost
  704.                                             already sorted                   *)
  705.         Swap(idx2,mid);
  706.         for idx3 := idx1 + 1 to idx2 do
  707.             begin           (* try to find record not equal to the first one *)
  708.             case CompareRecords(sPtrArr[idx3].heapPtr,
  709.                                 sPtrArr[idx1].heapPtr) of
  710.                 GREATERTHAN :
  711.                     begin
  712.                     FindPivot := idx3;
  713.                     Exit;
  714.                     end;
  715.                 LESSTHAN :
  716.                     begin
  717.                     FindPivot := idx1;
  718.                     Exit;
  719.                     end;
  720.                 EQUALTO : ;
  721.                 end;                                (* end of case statement *)
  722.             end;
  723.         FindPivot := 0;                          (* different keys not found *)
  724.         end;                                     (* end of FindPivot routine *)
  725.  
  726. (*\*)
  727.         (* This routine will partition the sPtrArr[idx1] .. sPtrArr[idx2] into
  728.            two arrays so that sort records less than the sort record at
  729.            sPtrArr[pivotIdx] are located prior to pivotIdx in the array and
  730.            records greater and equal to are located after pivotIdx.  This
  731.            routine returns the index where the pivot record resides.         *)
  732.  
  733.         function Partition(idx1 : SortIndexRange; (* must be passed by value *)
  734.                            idx2 : ModifiedSortIndexRange;
  735.                                                   (* must be passed by value *)
  736.                            pivotIdx : LrNumber) : SortIndexRange;
  737.  
  738.             begin
  739.             FastMover(sPtrArr[pivotIdx].heapPtr^,extraHeapPtr^,sRecSize);
  740.             repeat
  741.                 begin
  742.                 Swap(idx1,idx2);
  743.                 while CompareRecords(sPtrArr[idx1].heapPtr,
  744.                                      extraHeapPtr) = LESSTHAN do
  745.                     begin
  746.                     Inc(idx1);
  747.                     end;
  748.                 while CompareRecords(sPtrArr[idx2].heapPtr,
  749.                                      extraHeapPtr) <> LESSTHAN do
  750.                     begin
  751.                     Dec(idx2);
  752.                     end;
  753.                 end;
  754.             until idx1 > idx2;
  755.             Partition := idx1;
  756.             end;                                 (* end of Partition routine *)
  757.  
  758.  
  759.         (* This routine will recursively sort the records in sPtrArr.        *)
  760.  
  761.         procedure QuickSort(idx1 : SortIndexRange;
  762.                             idx2 : SortIndexRange);
  763.  
  764.         var
  765.             idx3 : SortIndexRange;
  766.             pivotIdx : ModifiedSortIndexRange;
  767.  
  768.             begin
  769.             pivotIdx := FindPivot(idx1,idx2);
  770.             if pivotIdx <> 0 then
  771.                 begin
  772.                 idx3 := Partition(idx1,idx2,pivotIdx);
  773.                 QuickSort(idx1,idx3-1);
  774.                 QuickSort(idx3,idx2);
  775.                 end;
  776.             end;                                 (* end of QuickSort routine *)
  777.  
  778.  
  779.         begin                           (* main block of SortRecords routine *)
  780.         QuickSort(1,n);
  781.         end;                                   (* end of SortRecords routine *)
  782.  
  783. (*\*)
  784.     (* This routine will perform a merge sort and merge the contents of the
  785.        SortPointerArray with the contents of the new logical record list and
  786.        leave the contents in the logical record list.                        *)
  787.  
  788.     procedure SortMergeLists(n : SortIndexRange;
  789.                              var newLrLst : LrList);
  790.  
  791.     var
  792.         tempLrLst : LrList;
  793.         lrNum : LrNumber;
  794.         idx : SortIndexRange;
  795.         done : Boolean;
  796.  
  797.         begin
  798.         CreateLrList(tempLrLst);
  799.         lrNum := GetFirstLr(newLrLst);
  800.         for idx := 1 to n do
  801.             begin
  802.             done := FALSE;
  803.             while (lrNum <> 0) and (not done) do
  804.                 begin
  805.                 GetOneSortRecord(lrNum,extraHeapPtr);
  806.                 if CompareRecords(sPtrArr[idx].heapPtr,extraHeapPtr) =
  807.                     LESSTHAN then
  808.                     begin
  809.                     done := TRUE;
  810.                     end
  811.                 else
  812.                     begin
  813.                     AddToLrList(lrNum,tempLrLst);
  814.                     lrNum := GetNextlr(newLrLst);
  815.                     end;
  816.                 end;
  817.             AddToLrList(sPtrArr[idx].lrNum,tempLrLst);
  818.             end;
  819.         while lrNum <> 0 do
  820.             begin
  821.             GetOneSortRecord(lrNum,extraHeapPtr);
  822.             AddToLrList(lrNum,tempLrLst);
  823.             lrNum := GetNextlr(newLrLst);
  824.             end;
  825.         DestroyLrList(newLrLst);
  826.         newLrLst := tempLrLst;
  827.         end;                                (* end of SortMergeLists routine *)
  828.  
  829.  
  830.     (* This routine will free up the heap space used for sorting, including
  831.        the space used for the merge sort record and the temporary logical
  832.        record.  However, it will not free up the space used by the temporary
  833.        sort list.                                                            *)
  834.  
  835.     procedure ReleaseSortRecords;
  836.  
  837.     var
  838.         idx : SortIndexRange;
  839.  
  840.         begin
  841.         for idx := recsInArray downto 1 do
  842.             begin
  843.             FreeMem(sPtrArr[idx].heapPtr,sRecSize);
  844.             end;
  845.         FreeMem(extraHeapPtr,sRecSize);
  846.         FreeMem(logicalHeapPtr,lRecSize);
  847.         end;                            (* end of ReleaseSortRecords routine *)
  848.  
  849. (*\*)
  850.     begin
  851.     success := CopySortList(sPtr,newSPtr);
  852.     if success then
  853.         begin
  854.         sRecSize := GetSortRecordSize;
  855.         if FetchFileType(fName) = DATA then
  856.             begin
  857.             lRecSize := GetDataRecordSize(fName);
  858.             end
  859.         else
  860.             begin
  861.             lrecSize := CalculateDataRecordSize;
  862.             end;
  863.         success := AllocateMinimumSortSpace;
  864.         if success then
  865.             begin
  866.             recsInArray := AllocateSortSpace;
  867.             recsLeft := GetCountLr(lrLst);
  868.             CreateLrList(newLrLst);
  869.             dummyLrNum := GetFirstLr(lrLst); (* set the cursor in the lrlist
  870.                                                 list to the front of the list*)
  871.             while recsLeft > 0 do
  872.                 begin
  873.                 if recsLeft <= recsInArray then
  874.                     begin
  875.                     recs := recsLeft;
  876.                     end
  877.                 else
  878.                     begin
  879.                     recs := recsInArray;
  880.                     end;
  881.                 Dec(recsLeft,recs);
  882.                 GetSortRecords(lrLst,recs);
  883.                 SortRecords(recs);
  884.                 SortMergeLists(recs,newLrLst);
  885.                 end;
  886.             ReleaseSortRecords;
  887.             DestroyLrList(lrLst);
  888.             lrLst := newlrLst;                (* newly sorted list to return *)
  889.             end;
  890.         end;
  891.     DestroySortList(newSPtr);       (* whether or not the sort was successful,
  892.                                        this step needs to be accomplished    *)
  893.  
  894.     end;                                          (* end of SortList routine *)
  895.  
  896.  
  897. end.                                                     (* end of Sort Unit *)
  898.