Example of a Bubble Sort in RPG

This is an example of a bubble sort in RPG. The small array is loaded with three digit values. The entries are not in numerical sequence. The demo program loops through and performs a 'bubble' sort rearranging the values so that they are in sequence from lowest to highest.

 /TITLE ** DISPLAY BUBBLE SORT EXAMPLE **                             
H DEBUG(*YES)                                                         
 
 ******************************************************************** 
FCH5P11    CF   E             WORKSTN                                 
F                                     INFDS(DSPDS)                    
 *=================================================================== 
 * Externally defined data structures                                
 *-------------------------------------------------------------------
D KEYDS         E DS                  EXTNAME(MISKEYPF)              
D PGMDS         ESDS                  EXTNAME(MISSTSDA)              
D DSPDS         E DS                  EXTNAME(MISDSPDA)              
 *-------------------------------------------------------------------
 * Array of 10, 3 digit numbers, defined as a data structure         
 *-------------------------------------------------------------------
DARRAY            DS            30                                   
D  SEQ                           3  0                                
D                                     DIM(10) CTDATA PERRCD(10)      
 *-------------------------------------------------------------------
 * data structure to hold array values before sort                   
 *-------------------------------------------------------------------
D                 DS                  INZ                            
DBEFORE                         30                                   
D  Z$ARR0                        3  0 OVERLAY(BEFORE)                
D  Z$ARR1                        3  0 OVERLAY(BEFORE:4)              
D  Z$ARR2                        3  0 OVERLAY(BEFORE:7)
D  Z$ARR3                        3  0 OVERLAY(BEFORE:10)             
D  Z$ARR4                        3  0 OVERLAY(BEFORE:13)             
D  Z$ARR5                        3  0 OVERLAY(BEFORE:16)             
D  Z$ARR6                        3  0 OVERLAY(BEFORE:19)             
D  Z$ARR7                        3  0 OVERLAY(BEFORE:22)             
D  Z$ARR8                        3  0 OVERLAY(BEFORE:25)             
D  Z$ARR9                        3  0 OVERLAY(BEFORE:28)             
 *-------------------------------------------------------------------
 * data structure to hold after image of sorted array                
 *-------------------------------------------------------------------
D                 DS                  INZ                            
DAFTER                          30                                   
D  Z$NEW0                        3  0 OVERLAY(AFTER :1)              
D  Z$NEW1                        3  0 OVERLAY(AFTER :4)              
D  Z$NEW2                        3  0 OVERLAY(AFTER :7)              
D  Z$NEW3                        3  0 OVERLAY(AFTER :10)             
D  Z$NEW4                        3  0 OVERLAY(AFTER :13)             
D  Z$NEW5                        3  0 OVERLAY(AFTER :16)             
D  Z$NEW6                        3  0 OVERLAY(AFTER :19)             
D  Z$NEW7                        3  0 OVERLAY(AFTER :22)             
D  Z$NEW8                        3  0 OVERLAY(AFTER :25)                                
D  Z$NEW9                        3  0 OVERLAY(AFTER :28)                                
 *-------------------------------------------------------------------                   
 * Define constants                                                                     
 *-------------------------------------------------------------------                   
D #NO             C                   CONST('N')                                        
D #YES            C                   CONST('Y')                                        
 *-------------------------------------------------------------------                   
 * START of work fields                                                                 
 *-------------------------------------------------------------------                   
D END_SORT        S              1    INZ(#NO)                                          
D HOLD            S              3  0                                                   
D I               S              3  0 INZ(1)                               index        
D X               S              3  0 INZ(1)                               next element 
D NXT_PASS        S              3  0 INZ(10)                                           
D PASS            S              3  0 INZ(10)                                           
 *-------------------------------------------------------------------                   
 * END of work fields                                                                   
 *-------------------------------------------------------------------                   
 * Load array to the before image for display                                           
C                   MOVE      ARRAY         BEFORE                                            
 *                                                                                            
C                   DOU       PASS = 1                                     Do until pass = 1  
C                   EVAL      END_SORT = #YES                              Assume sort complet
C                   EVAL      NXT_PASS = 1                                 Set element pass   
C                   EVAL      I = 1                                        Initialize index   
C                   EVAL      X = 1                                        Initialize X       
C                   DOW       NXT_PASS < 10                                While less than 10 
C                   EVAL      X = X + 1                                                       
C                   IF        SEQ(I) > SEQ(X)                              If an element was  
C                   EVAL      HOLD = SEQ(I)                                moved, do not end  
C                   EVAL      SEQ(I) = SEQ(X)                              the sort           
C                   EVAL      SEQ(X) = HOLD                                                   
C                   EVAL      END_SORT = #NO                                                  
C                   ENDIF                                                  End if             
C                   EVAL      I = I + 1                                    Increment index    
C                   EVAL      NXT_PASS = NXT_PASS + 1                      Increment elem pass
C                   ENDDO                                                  End inner loop     
C                   IF        END_SORT = #YES                              If elements are    
C                   EVAL      PASS = 1                                     sequenced end sort 
C                   ELSE                                                   else continue       
C                   EVAL      PASS = PASS - 1                              Decrement array pass
C                   ENDIF                                                  End if              
C                   ENDDO                                                  End do outer loop   
 * Load array to the after image for display                                                   
C                   MOVE      ARRAY         AFTER                                              
 *-------------------------------------------------------------------                          
 * Display panel, wait for F3 to exit program.                                                 
 *-------------------------------------------------------------------                          
C                   DOU       #KEY  = #F3                                                      
C                   EXFMT     CH5P1101                                                         
C                   ENDDO                                                                      
 * Exit program                                                                                
C                   EVAL      *INLR = *ON                                                      
C                   RETURN                                                                     
 *===================================================================                          
 * END of mainline calculations, begin subroutine section                                      
 *===================================================================                          
C     *INZSR        BEGSR                                                                      
 * define function keys                                                                        
C                   CALL      'MIS500RP'          
C                   PARM                    KEYDS 
C                   ENDSR 
** Sequence Array             
002006004008010012089068045037