RPG

366. サブ・ルーチンをプロシージャーに置換える

昔、AS400会議室という掲示板に上司から今あるサブ・ルーチンを
プロシージャーに置換えるように言われて困っています、という相談が
あったがその上司の方は先見の明があったということになる。

ここでサブ・ルーチンの記述をプロシージャーに書き換えると
どうなるかを例を挙げて解説する。

最初にサブ・ルーチンで書かれたILE-RPGのサンプルを示す。

[サブ・ルーチン: TESTSUBR ]

ソースはこちらから

0001.00 H DFTNAME(TESTSUBR) DATEDIT(*YMD/) BNDDIR('QC2LE')                                 
0002.00 F********** サブ・ルーチンのテスト ************************************            
0003.00 F*                                                                                 
0004.00 F**********************************************************************            
0005.00                                                                                    
0006.00  * CRTRPGMOD  OBJ(QTEMP/TESTSUBR)   SRCFILE(R610SRC/QRPGLESRC)                     
0007.00  * DBGVIEW(*SOURCE) AUT(*ALL)                                                      
0008.00  * CRTPGM PGM(ASNET.COM/TESTSUBR) MODULE(QTEMP/TESTSIBR ACTGRP(*NEW)               
0009.00  *        AUT(*ALL)                                                                
0010.00                                                                                    
0011.00  *-------------------------------------------------------------------*             
0012.00  *  2020/08/08 : 作成                                                              
0013.00  *-------------------------------------------------------------------*             
0014.00  *( 作業変数 )                                                                     
0015.00 D MSR             S             80    DIM(1) CTDATA PERRCD(1)               配列   
0016.00 D MSG             S           3000A                                                
0017.00 D MSGFFLIB        S             20    INZ('QCPFMSG   QSYS      ')                  
0018.00 D MSGLEN          S             10I 0                                              
0019.00 D CALLSTK         S             10I 0 INZ(1)                                       
0020.00 D MSGKEY          S              4A                                                
0021.00 D AR              S              1A   DIM(256)                                     
0022.00 D N               S              4S 0                                              
0023.00 D NULL            S              1A   INZ(X'00')                                   
0024.00 D QMHSNDPM        C                   CONST('QSYS/QMHSNDPM')           
0025.00                                                                        
0026.00 D APIERR          DS                  QUALIFIED                        
0027.00 D  GETBYT                 1      4B 0 INZ(160)                         
0028.00 D  AVLBYT                 5      8B 0 INZ(0)                           
0029.00 D  MSGID                  9     15                                     
0030.00 D  MSGDTA                17    160                                     
0031.00                                                                        
0032.00 C*( メイン・ルーチンの始まり )                                         
0033.00 C                   MOVEL     MSR(1)        MSG                        
0034.00 C                   EXSR      SNDPGMMSG                                
0035.00 C                   SETON                                        LR    
0036.00 C                   RETURN                                             
0037.00 C*( メイン・ルーチンの終わり )                                         
0038.00                                                                        
0039.00 C******************************************************                
0040.00 C     *INZSR        BEGSR                                              
0041.00 C******************************************************                
0042.00 C*  初期 CYCLE のみの実行                                              
0043.00 C                   ENDSR                                              
0044.00 C******************************************************                
0045.00 C     SNDPGMMSG     BEGSR                                              
0046.00 C******************************************************                
0047.00 C                   EVAL      MSG    = MSR(1)                          
0048.00 C                   EVAL      MSGLEN = %LEN(%TRIM(MSG))               
0049.00  *-------------------------------------------------------------------*
0050.00 C                   CALL      QMHSNDPM                                
0051.00 C                   PARM      'CPF9897'     MSGID             7       
0052.00 C                   PARM                    MSGFFLIB                  
0053.00 C                   PARM                    MSG                       
0054.00 C                   PARM                    MSGLEN                    
0055.00 C                   PARM      '*DIAG     '  MSGTYPE          10       
0056.00 C                   PARM      '*PGMBDY   '  PGMQUE           10       
0057.00 C                   PARM                    CALLSTK                   
0058.00 C                   PARM                    MSGKEY                    
0059.00 C                   PARM                    APIERR                    
0060.00  *-------------------------------------------------------------------*
0061.00 C                   IF        APIERR.AVLBYT <> 0                      
0062.00 C     'MSGID='      CAT       APIERR.MSGID  DSP40            40       
0063.00 C     DSP40         DSPLY                   ANS               1       
0064.00 C                   ENDIF                                             
0065.00 C                   ENDSR                                             
0066.00 ** MSR -- 以下は配列               
0067.00  これはメッセージ送信のテストです。


  

[解説]

これは API: QMHSNDPM(プログラム・メッセージの送信)を使って
自分のジョブにメッセージを送信する例である。

サブ・ルーチンは SNDPGMMSG という名前で

0034.00 C                   EXSR      SNDPGMMSG

によってサブ・ルーチンを呼び出してはいるがサブ・ルーチンに必要な変数というか
パラメータはプログラムを読んでみないとわからない。

また API: QMHSNDPM の呼び出しは CALL命令で呼び出しているが
CALL命令はフリー・フォーマットで記述することはできない。

AS400会議室の別の書き込みではすべてフリー・フォーマットで記述するには?
との問いもあったがCALL命令はフリー・フォーマットでは使えない。
プログラムの呼び出しはプロシージャーとして定義すれば
フリー・フォーマットで使用することができる。
後でそのサンプルも示す。

さて同じ処理をプロシージャーを使って記述すると次のようになる。

[プロシージャー: TESTPROC ]

ソースはこちらから

0001.00      H DFTNAME(TESTPROC) DATEDIT(*YMD/) BNDDIR('QC2LE')                                
0002.00 F********** プロシージャーのテスト ************************************           
0003.00 F*                                                                                
0004.00 F**********************************************************************           
0005.00                                                                                   
0006.00  * CRTRPGMOD  OBJ(QTEMP/TESTPROC)   SRCFILE(R610SRC/QRPGLESRC)                    
0007.00  * DBGVIEW(*SOURCE) AUT(*ALL)                                                     
0008.00  * CRTPGM PGM(ASNET.COM/TESTPROC) MODULE(QTEMP/TESTPROC ACTGRP(*NEW)              
0009.00  *        AUT(*ALL)                                                               
0010.00                                                                                   
0011.00  *-------------------------------------------------------------------*            
0012.00  *  2020/08/08 : 作成                                                             
0013.00  *-------------------------------------------------------------------*            
0014.00  *( 作業変数 )                                                                    
0015.00 D MSR             S             80    DIM(1) CTDATA PERRCD(1)               配列  
0016.00 D AR              S              1A   DIM(256)                                    
0017.00 D N               S              4S 0                                             
0018.00                                                                                   
0019.00 D*( SNDPGMMSG     のプロトタイプ宣言 )                                            
0020.00 D SNDPGMMSG       PR                                                              
0021.00 D  MSG                        3000A   Value                                       
0022.00 D  MSGTYPE_IN                   10A   value OPTIONS(*NOPASS)                      
0023.00 D  CALLSTACKC_IN                10I 0 CONST OPTIONS(*NOPASS)                      
0024.00                                                                      
0025.00 C*( メイン・ルーチンの始まり )                                       
0026.00 C                   CALLP     SNDPGMMSG(MSR(1))                      
0027.00 C                   SETON                                        LR  
0028.00 C                   RETURN                                           
0029.00 C*( メイン・ルーチンの終わり )                                       
0030.00                                                                      
0031.00 C******************************************************              
0032.00 C     *INZSR        BEGSR                                            
0033.00 C******************************************************              
0034.00 C*  初期 CYCLE のみの実行                                            
0035.00 C                   ENDSR                                            
0036.00  *********************************************************           
0037.00  *   SNDPGMMSG:  メッセージを現在の CALLSTACK に送信     *           
0038.00  *********************************************************           
0039.00  *---( SNDPGMMSG PROCEDURE  ここから )------------------------*      
0040.00 P SNDPGMMSG       B                   EXPORT                         
0041.00 D                 PI                                                 
0042.00 D  MSG                        3000A   Value                          
0043.00 D  MSGTYPE_IN                   10A   value OPTIONS(*NOPASS)         
0044.00 D  CALLSTACKC_IN                10I 0 CONST OPTIONS(*NOPASS)         
0045.00                                                                      
0046.00 D APIERR          DS                                                 
0047.00 D  GETBYT                 1      4B 0 INZ(160)                       
0048.00 D  AVLBYT                 5      8B 0 INZ(0)                    
0049.00 D  MSGID                  9     15                              
0050.00 D  MSGDTA                17    160                              
0051.00                                                                 
0052.00 D QMHSNDPM        PR                  ExtPgm('QMHSNDPM')        
0053.00 D  MSGID                         7A   CONST                     
0054.00 D  MSGFILE                      20A   CONST                     
0055.00 D  MSGDATA                    6000A   CONST OPTIONS(*varsize)   
0056.00 D  MSGDATALEN                   10I 0 CONST                     
0057.00 D  MSGTYPE                      10A   CONST                     
0058.00 D  CALLSTACKE                   10A   CONST                     
0059.00 D  CALLSTACKC                   10I 0 CONST                     
0060.00 D  MSGKEY                        4A                             
0061.00 D  APIERR                             LIKEDS(APIERR)            
0062.00 D                                     OPTIONS(*VARSIZE)         
0063.00 D PARMS           S              4S 0                           
0064.00 D MSGKEY          S              4A                             
0065.00 D CALLSTACKC      S             10I 0 INZ(1)                    
0066.00 D MSGTYPE         S             10A   INZ('*DIAG     ')         
0067.00                                                                 
0068.00 C                   EVAL      PARMS = %PARMS()                  
0069.00 C                   SELECT                                      
0070.00 C                   WHEN      PARMS = 1                         
0071.00 C                   WHEN      PARMS = 2                         
0072.00 C                   EVAL      MSGTYPE = MSGTYPE_IN                
0073.00 C                   WHEN      PARMS = 3                           
0074.00 C                   EVAL      CALLSTACKC = CALLSTACKC_IN          
0075.00 C                   EVAL      MSGTYPE = MSGTYPE_IN                
0076.00 C                   ENDSL                                         
0077.00  /FREE                                                            
0078.00    QMHSNDPM('CPF9897':'QCPFMSG   *LIBL':MSG:                      
0079.00             %LEN(%TRIM(MSG)):MSGTYPE:'*PGMBDY':                   
0080.00             CALLSTACKC:MSGKEY:APIERR);                            
0081.00  /END-FREE                                                        
0082.00 C                   RETURN                                        
0083.00 P                 E                                               
0084.00  *---( SNDPGMMSG    PROCEDURE  ここまで )------------------------*
0085.00                                                                   
0086.00 ** MSR -- 以下は配列               
0087.00  これはメッセージ送信のテストです。


  

[解説]

サブ・ルーチンはプロシージャー: SNDPGMMSG として定義している。
プロシージャーは演算命令文の中で使用する前に型を
次のようにして D-仕様書で定義しなければならない。

0019.00 D*( SNDPGMMSG     のプロトタイプ宣言 )                                            
0020.00 D SNDPGMMSG       PR                                                              
0021.00 D  MSG                        3000A   Value                                       
0022.00 D  MSGTYPE_IN                   10A   value OPTIONS(*NOPASS)                      
0023.00 D  CALLSTACKC_IN                10I 0 CONST OPTIONS(*NOPASS) 

この型のことをプロトタイプと呼んでいる。
関数の型を使用する前に定義するのはILE-RPGだけでなく
一般的に C言語、Java, VisualBASIC, VC++, VBA ,…などの開発言語における
共通のルールである。

次にプロシージャーを記述する位置はサブ・ルーチンのまだ後ろで
演算の最後に追加する。

ひとつのプロシージャーは

0040.00 P SNDPGMMSG       B                   EXPORT

 

から始まって

0083.00 P                 E

の E で終わる。

入り口は

0041.00 D                 PI                                                 
0042.00 D  MSG                        3000A   Value                          
0043.00 D  MSGTYPE_IN                   10A   value OPTIONS(*NOPASS)         
0044.00 D  CALLSTACKC_IN                10I 0 CONST OPTIONS(*NOPASS)  

のようにして受取りパラメータを記述する。
Value がパラメータを表している。
OPTIONS(*NOPASS) はこのパラメータが省略可能であることを意味している。
演算中にある

0068.00 C                   EVAL      PARMS = %PARMS()

によって受取ったパラメータの数を調べることができる。
またプロシージャーが呼び出すプログラムはプロシージャーとして

0052.00 D QMHSNDPM        PR                  ExtPgm('QMHSNDPM')        
0053.00 D  MSGID                         7A   CONST                     
0054.00 D  MSGFILE                      20A   CONST                     
0055.00 D  MSGDATA                    6000A   CONST OPTIONS(*varsize)   
0056.00 D  MSGDATALEN                   10I 0 CONST                     
0057.00 D  MSGTYPE                      10A   CONST                     
0058.00 D  CALLSTACKE                   10A   CONST                     
0059.00 D  CALLSTACKC                   10I 0 CONST                     
0060.00 D  MSGKEY                        4A                             
0061.00 D  APIERR                             LIKEDS(APIERR)            
0062.00 D                                     OPTIONS(*VARSIZE)

定義する。
API: QMHSNDPM はプログラムであるがプロシージャーとして
定義したので

0077.00  /FREE                                                            
0078.00    QMHSNDPM('CPF9897':'QCPFMSG   *LIBL':MSG:                      
0079.00             %LEN(%TRIM(MSG)):MSGTYPE:'*PGMBDY':                   
0080.00             CALLSTACKC:MSGKEY:APIERR);                            
0081.00  /END-FREE 

のようにしてフリー・フォーマットで呼び出すことができる。

プロシージャー化のサンプルは上記のTESTPROCのILE-RPGソースを
入手してご自分のライブラリーに保存してじっくり眺めてみて欲しい。
最初はこのTESTPROCによるプロシージャーを見慣れるところから
始めてほしい。

次回は作成したプロシージャーの公開と利用方法について解説する。