H dftactgrp( *no ) bnddir( 'QC2LE' )

      *========================================================================
      *==== Prototype the external functions we will be calling
      *========================================================================
     D memcmp          PR            10I 0 Extproc( '__memcmp' )                *- Used to compare data
     D  #source1                       *   Value
     D  #source2                       *   Value
     D  #nbytes                      10I 0 Value

     D memmove         PR              *   Extproc( '_MEMMOVE' )                *- Used to get move data
     D  #target                        *   Value
     D  #source                        *   Value
     D  #nbytes                      10I 0 Value

      *========================================================================
      *==== Prototype the internal functions we will be calling
      *========================================================================
     D combsort        PR              *                                        *- returns a pointer to the sorted table
     D  #nbrElements                  7P 0 Value
     D  #sizeElements                10I 0 Value
     D  #sizeKey                     10I 0 Value
     D  #sortDir                      1A   Value
     D  #table                         *   Value

      *========================================================================
      *==== Main line code
      *========================================================================

     D dummy           S               *
     D testArray       S             15A   Dim( 20 ) CTData

     C                   Eval      dummy = combsort( 10  :
     C                                               15  :
     C                                               15  :
     C                                               'A' :
     C                                               %Addr( testArray ) )

      *-- all done...
     C                   Eval      *INLR = *on


      *====================================================================
      * Procedure-- processDir
      *====================================================================
     P combsort        B
     D combsort        PI              *                                        *- returns a pointer to the sorted table
     D  #nbrElements                  7P 0 Value
     D  #sizeElement                 10I 0 Value
     D  #sizeKey                     10I 0 Value
     D  #sortDir                      1A   Value
     D  #table                         *   Value

      *-- misc procedure variables
     D swapFlag        S              1A
     D jumpSize        S              4B 0
     D sweepEnd        S              4B 0
     D itemNbr         S              4B 0
     D compNbr         S              4B 0
     D compTest        S             10I 0
     D elmtItemPtr     S               *
     D elmtCompPtr     S               *
     D keyItemPtr      S               *
     D keyCompPtr      S               *
     D swapPtr         S               *
     D dummyPtr        S               *

      *-- begin procedure code

     C                   Eval      jumpSize = #nbrElements
     C                   Alloc     #sizeElement  swapPtr

     C     SORT@JUMP     Tag
     C     jumpSize      CabGT     1             SORT@SWEEP
     C     swapFlag      CabNE     'S'           ALL@DONE

     C     SORT@SWEEP    Tag
     C                   Eval      jumpSize = ((jumpSize * 10) + 3) / 13
     C                   Eval      sweepEnd = #nbrElements - jumpSize
     C                   Eval      swapFlag = ' '
     C                   Eval      itemNbr = -1
     C     itemNbr       CabEQ     -1            SORT@COMP

     C     SORT@SWAP     Tag
     C                   Eval      dummyPtr = memmove(swapPtr     :
     C                                                elmtItemPtr :
     C                                                #sizeElement )
     C                   Eval      dummyPtr = memmove(elmtItemPtr :
     C                                                elmtCompPtr :
     C                                                #sizeElement )
     C                   Eval      dummyPtr = memmove(elmtCompPtr :
     C                                                swapPtr     :
     C                                                #sizeElement )
     C                   Eval      swapFlag = 'S'

     C     SORT@COMP     Tag
     C                   Eval      itemNbr = itemNbr + 1
     C     itemNbr       CabGT     sweepEnd      SORT@JUMP
     C                   Eval      elmtItemPtr = #table +
     C                                           (itemNbr * #sizeElement)
     C                   Eval      keyItemPtr =  #table  +
     C                                           (itemNbr * #sizeElement)
     C                   Eval      compNbr  = (itemNbr + jumpSize) - 1
     C                   Eval      keyCompPtr = #table +
     C                                          (compNbr * #sizeElement)
     C                   Eval      elmtCompPtr = #table +
     C                                           (compNbr * #sizeElement)
     C     #sortDir      CabEQ     'D'           DESC@SORT

     C     ASCE@SORT     Tag
     C                   Eval      compTest = memcmp( keyItemPtr :
     C                                                keyCompPtr :
     C                                                #sizeKey )
     C                   Select
     C                   When      compTest > 0
     C                   Goto      SORT@SWAP

     C                   When      compTest < 0
     C                   Goto      SORT@COMP

     C                   EndSl

     C     DESC@SORT     Tag
     C                   Eval      compTest = memcmp( keyItemPtr :
     C                                                keyCompPtr :
     C                                                #sizeKey )
     C                   Select
     C                   When      compTest < 0
     C                   Goto      SORT@SWAP

     C                   When      compTest > 0
     C                   Goto      SORT@COMP

     C                   EndSl

     C     ALL@DONE      Tag
     C                   Return    #table

      *-- end procedure code
     P combsort        E

      *====================================================================
      * Compile Time Array Data
      *====================================================================
**CTDATA testArray
String 8
String 2
String 5
String 9
String 6
String 3
String 0
String 4
String 7
String 1