RPG Case Structures

RPG II did not have true case structures, but did include branching logic. THe first case structures to be introduced, naturally enough, resembled the branching operations of early RPG. The CASE Op code in this case was 'compare and execute subroutine', similar in nature to the early 360/DOS assembler instruction 'BALR' branch and link register.

      *----------------------------------------------------------------
      * Determine if an ENTER key, or ROLL key was detected. If not
      * perform an edit of the command function key to get requested
      * program function. (For example; EXIT, RESET, etc.)
      *----------------------------------------------------------------
     C                   EXSR      @EDTKY
<--- C     #KEY          CASEQ     ENTER         @ENTER
<--- C     #KEY          CASEQ     ROLLUP        @LOAD
<--- C     #KEY          CASEQ     ROLLDN        @DOWN
<--- C     SUBOP         CASEQ     'CALL'        @CALLS
<--- C     FUNCT         CASEQ     'EXIT'        @EXIT
<--- C     FUNCT         CASEQ     'RESET'       @RESET
<--- C     FUNCT         CASEQ     'MORE'        @MORE
<--- C     FUNCT         CASEQ     'MOREOPT'     @MOREO
---> C                   ENDCS                                                             

The COMPARE an EXECUTE SUBROUTINE operation is only supported as a fixed-column operation. In-line CASE structures were introduced with the SELECT operation. This structure is common in free-format code and more nearly resembles the case structure in other languages.

                                                                                                  
              SELECT;                                                                               
              WHEN KeyPressed = functionKey.ENTER;                                                  
                 processChanges();                                                                  
                 READ SC032001;                                                                     
                 If ScreenChange ;                                                                  
                    resetDisplay()   ;                                                              
                 ENDIF;                                                                             
                                                                                                    
              WHEN KeyPressed = functionKey.ROLLUP;                                                 
                 loadSubfile();                                                                     
                                                                                                    
              WHEN KeyPressed = functionKey.ROLLDN;                                                 
                 pageDown();                                                                        
                                                                                                    
              WHEN KeyPressed = functionKey.F23;                                                    
                 DisplayOptions(option: z$opt1: z$opt2: O);                                         
                                                                                                    
              WHEN KeyPressed = functionKey.F24;                                                    
                 DisplayKeys(cmdkey: z$key1: z$key2: M);                                            
                                                                                                    
              WHEN Function = 'EXIT';                                                               
                 QUIT();                                                                            
                                                                                                    
              WHEN Function = 'CANCEL';                                                             
                 EXSR returnToCaller;                                                               
                                                                                                    
              WHEN Function = 'RESET';                                                              
                 resetDisplay();                                                                    
                       
              WHEN Function = 'HELP';                                                               
                 HelpText(ThisPgm:fmt);                                                             
                                                                                                    
              WHEN SUBOP = 'CALL';                                                                  
                 callProgram();                                                                     
                                                                                                    
              WHEN Function = 'CMDLINE';                                                            
                 CommandLine();                                                                     
           ENDSL;                                                                                   
                                           
                                                                                                    
           SELECT;                                                                                  
              WHEN rtnfld = 'ZFSTS';                                                                
                   zfsts = %trim(PromptDta);                                                        
              WHEN rtnfld = 'ZFSEQ';                                                                
                   promptDta = %xlate(' ':'0':promptDta);                                           
                   zfseq = %dec(%subst(PromptDta:1:7):7:0);                                         
              WHEN rtnfld = 'ZFCAT';                                                                
                   promptDta = %xlate(' ':'0':promptDta);                                           
                   zfcat = %dec(%subst(PromptDta:1:3):3:0);                                         
              WHEN rtnfld = 'ZFOBJ';                                                                
                   zfobj = %trim(PromptDta);                                                        
              WHEN rtnfld = 'ZFTYP';                                                                
                   zftyp = %trim(PromptDta);                                                        
              WHEN rtnfld = 'ZFDSC';                                                                
                   zfdsc = %trim(PromptDta);                                                        
              OTHER;                                                                                
                   PromptDta = *blanks;                                                             
           ENDSL;