RPGLE Sort - Using SORTA, C Library qsort function Part 2

In the C standard library, qsort is a function used to sort elements in an array. qsort is named after the quicksort algorithm, although the C standard does not require it to be implemented using any specific algorithm.

qsort is a generic function that can sort arrays of any size, containing any kind of object (although, if the objects are not the same in size, pointers have to be used) and using any kind of comparison predicate. The genericity, however, comes at the expense of type-safety, since qsort operates on void pointers.

Well, using the 'qsort' library function from the C library, an RPGLE program can sort a memory structure according to any desired arbitrary combination of "key" field

Click here to learn RPGLE sortA op-code for sorting a simple array or data structure array

Prototype

void qsort(void *base, size_t nmemb, size_t size, int (*compare)(const void *, const void *));

*   Prototype of the C Library 'qsort' function                       
d qsort           pr                  extproc('qsort')                 
d  ArrayToSort                    *   value                            
d  Howmany                      10u 0 value                            
d  Size                         10u 0 value                            
d  CompareRoutine...                                                   
d                                 *   procptr value                   

Sample RPGLE Code using qsort C function

Lets say you want to sort some kind of shipping data by Ship Via Method and then freight amount.

h option(*nodebugio : *srcstmt)                                     
h bnddir('*LIBL/XABNDDIR':'QC2LE') dftactgrp(*NO) actgrp(*CALLER)    

d @output         ds                                            
d $ship_weight                  11s 2              
d $ship_via                     10a              
d $ship_desc                    30a           
d $frt_amt                      11s 2                

 *   Prototype of the C Library 'qsort' function                      
d qsort           pr                  extproc('qsort')                
d  ArrayToSort                    *   value                           
d  Howmany                      10u 0 value                           
d  Size                         10u 0 value                           
d  CompareRoutine...                                                  
d                                 *   procptr value                   
                                                                      
d Myarray         ds                  Qualified                       
d    Subdata                          likeds(@output) Dim(100)        
                                                                      
d  $count         s             10u 0                                 
                                                                      
d  CompareRoutine...                                                  
d                 s               *   procptr                         
d                                     inz(%paddr('COMPRTN'))          
                                                                      
d CompRtn         pr            10i 0                                 
d  Element1                           likeds(@output)                 
d  Element2                           likeds(@output)                 

d @results        ds                  dim(100) likeds(@output)    
d                                                                  

c                   callp     qsort( %addr(MyArray) :             
c                                    $count         :             
c                                    %Size(Myarray.Subdata):      
c                                    CompareRoutine)  

To tell qsort() where my data is located in memory, I've told it that the base address is %addr(MyArray) —in other words, it's the location where the MyArray array is stored in the computer's memory. This information enables qsort() to find my array.

The second parameter is the number of entries to be sorted. As I loaded this array, I kept track of how many records were loaded by incrementing a field that I called $count. So that count field is passed as the second parameter to qsort().

The third parameter is the size of an individual array element. No problem. I asked RPGLE for the size by calling the %SIZE BIF.

The final parameter is procedure address (the spot in memory) of the routine that I'd like to use for comparisons. I'll have to write that routine as a subprocedure in my RPGLE program so that it can determine which array entries should come first and which entries should come last.

c                   clear     *all          @results              
c                   eval      @n = 0                              
c     1             do        $count        @n                    
                                                                  
 /free                                                            
   @results(@n).$ship_weight = Myarray.Subdata(@n).$opt_type;       
   @results(@n).$ship_via    = Myarray.Subdata(@n).$ship_via;       
   @results(@n).$ship_desc   = Myarray.Subdata(@n).$ship_desc;              
   @results(@n).$frt_amt     = Myarray.Subdata(@n).$frt_amt;               
 /end-free                                                                
                                                                          
c                   enddo            

p CompRtn         b                   export                                   
                                                                               
d CompRtn         pi            10i 0                                          
d  Element1                           likeds(@output)                          
d  Element2                           likeds(@output)                          
                                                                               
d Result          s             10i 0                                          
                                                                               
 *   Assume they are equal (result = *zero)                                    
c                   eval      Result = *zero                                   
                                                                               
c                   if        Element1.$ship_via>Element2.$ship_via              
c                   eval      Result = 1                                       
c                   endif                                                      
                                                                               
c                   if        Element1.$ship_via<Element2.$ship_via
c                   eval      Result = -1                                      
c                   endif                                                      
                                                                               
c                   if        Element1.$ship_via=Element2.$ship_via               
c                   if        Element1.$frt_amt > Element2.$frt_amt       
c                   eval      Result = 1                                     
c                   endif                                                    
                                                                             
c                   if        Element1.$frt_amt < Element2.$frt_amt      
c                   eval      Result = -1                                    
c                   endif                                                    
c                   endif                                                    
                                                                             
c                   return    Result                                         
                                                                             
p CompRtn         e