----- Original Message -----
From: Chris Bipes <rpg@cross-check.com>
To: <MIDRANGE-L@midrange.com>
Sent: Friday, November 05, 1999 08:24
Subject: RE: 4 - subfiles


> Is there any chance of getting the "shell sort" code for re-sorting a
> subfile.  I have heard that it can be done but have never seen any examples.
>


Hi Chris,

I had to dig way back in the archives for this one, but here it is. I've never 
had a
need to do this in ILE yet, so this is the original RPG3 code. Sorry about the
formatting. No matter what I tried, I couldn't get my email client (Outlook 
Express)
to use a fixed font. I'm also sending it to you privately as an attached text 
file
with formatting intact.

John Taylor
Canada (Now adding location to avoid confusion with the new JT!)

      *
      * DS' for switching sub-file recs during sort routine. The first
      * data structure must be defined with the exact name, type, and size
      * of the fields used within the sfile record format.
     ISFLDS1     IDS
     I                                        1   5 FLD1
     I                                        6  10 FLD2
     I                                       11  12 FLD3
     ISFLDS2     IDS                             12
     ISFLDS3     IDS                             12
      *
      * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      * SRTSFL - Routine to sort sub-file
     CSR         SRTSFL    BEGSR
      *
      * This routine is based on the "Shell Sort" algorithm. The Shell Sort
      * algorithm is similar to the bubble sort algorithm. However, shell sort
      * begins by comparing elements that are far apart (separated by the value
      * of the offset variable, which is initially half the distance between the
      * first and last element), then comparing elements that are closer
      * together (when offset is one, the last iteration of this procedure is
      * merely a bubble sort).
      *
      *
      * Initialize misc variables
     C                     Z-ADD0         SWITCH  20
      *
      * Set comparison offset to half the number of records
     C           ENDRN     DIV  2         OFFSET  20
      *
      * DO WHILE Offset > 0
     C           OFFSET    DOWGT0
     C           ENDRN     SUB  OFFSET    LIMIT   20
      *    DO UNTIL Switch = 0
      *       assume no switches at this offset
     C           SWITCH    DOUEQ0
     C                     Z-ADD0         SWITCH
      *       compare elements & switch ones out of order
     C                     DO   LIMIT     X       40
     C           X         ADD  OFFSET    Y       40
     C           X         CHAINSFLREC               80
      *
     C                     MOVE FLD2      WKA010 10
     C                     MOVELSFLDS1    SFLDS2
      *
     C           Y         CHAINSFLREC               80
     C           WKA010    IFGT FLD2
     C                     MOVELSFLDS1    SFLDS3    P
     C                     MOVELSFLDS2    SFLDS1
     C                     UPDATSFLREC
     C           X         CHAINSFLREC               80
     C                     MOVELSFLDS3    SFLDS1
     C                     UPDATSFLREC
     C                     Z-ADDX         SWITCH
     C                     ENDIF
      *
     C                     ENDDO
      *
      *       switch on next pass only to where last switch was made
     C           SWITCH    SUB  OFFSET    LIMIT
     C                     ENDDO
      *
      *    No switches at last offset,  try on half as big
     C           OFFSET    DIV  2         OFFSET
     C                     ENDDO
      *
     C                     ENDSR


+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---

This thread ...

Follow-Ups:
Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2019 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available here. If you have questions about this, please contact [javascript protected email address].