42. ILE-RPG のソースを検索する RTVRPGSRC
いわゆる OPM と呼ばれるRPG III であれば RTVOBJD コマンドによって RPGプログラムの生成の元と
なったソース・ファイルを簡単に見つけることができるが、ILE-RPG オブジェクトを RTVOBJD で
検索しても元のソースを見つけることはできない。
DSPOBJD で調べてみてもソース・ファイルの欄は次のように空白となっている。
これは何故かと言うとILE の場合、*PGM は複数のオブジェクトを基底として生成されるものであるので
生成の元になるソースは、このひとつであると特定することはできない。
従ってたとえひとつのソースから生成されている *PGM であっても DSPOBJD で見れる場所には
ソース・ファイルの名前は登録されていないのである。
対話式で手動で元のソースを見つけるのであれば DSPOBJD ではなく DSPPGM で表示を進めていくと
次のような表示に到達する。
これは生成の基底となっているモジュールがすべて示されている。多くの場合はひとつだけであるが
ここでメイン・モジュールを、｢5= 記述の表示｣で選択して表示すると次のようにソース情報を
表示することができる。
プログラムのソース情報を手動によって参照する方法を紹介したが、プログラムによって
ソースを探そうとすると上記の手動により操作をプログラムによって行う必要があるので
面倒なことになり、簡単にはソース情報を検索することはできない。
そこで、ここで ILE-RPG のソース情報を検索するツールとして RTVRPGSRC というコマンドを
紹介する。
【コマンド: RTVRPGSRC】
0001.00 CMD PROMPT('RPG ソース情報の検索 ')
0002.00 PARM KWD(PGM) TYPE(PGM) PROMPT(' プログラム ')
0003.00 PGM: QUAL TYPE(*NAME) LEN(10) SPCVAL((*ALL)) MIN(1)
0004.00 QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
0005.00 SPCVAL((*LIBL)) PROMPT(' ライブラリー ')
0006.00 PARM KWD(SRCF) TYPE(*CHAR) LEN(10) RTNVAL(*YES) +
0007.00 PROMPT(' ソース・ファイル ')
0008.00 PARM KWD(SRCFLIB) TYPE(*CHAR) LEN(10) +
0009.00 RTNVAL(*YES) PROMPT(' ライブラリー ')
0010.00 PARM KWD(SRCMBR) TYPE(*CHAR) LEN(10) RTNVAL(*YES) +
0011.00 PROMPT(' ソース・メンバー ')
0012.00 PARM KWD(CCSID) TYPE(*CHAR) LEN(8) RTNVAL(*YES) +
0013.00 PROMPT('CCSID')
【解説】
この RTVRPGSRC コマンドは SRCF, SRCFLIB, SRCMBR, CCSID を戻り値として呼び出し側のプログラムに
戻すので、次のようにバッチ・コマンドとしてコンパイルしなけければならない。
CRTCMD CMD(MYLIB/RTVRPGSRC) PGM(MYLIB/RTVRPGSRCC) SRCFILE(MYSRCLIB/QCMDSRC) ALLOW(*BPGM *IPGM) AUT(*ALL)
( ALLOW(*BPGM *IPGM) がバッチ・コマンドであることを示している)
【CLP: RTVRPGSRCC】
0001.00 PGM PARM(&PGMOBJLIB &SRCF &SRCFLIB &SRCMBR &CCSID)
0002.00 /*---------------------------------------------------------*/
0003.00 /* RTVRPGSRC : RPG ソース情報の検索 */
0004.00 /*---------------------------------------------------------*/
0005.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(80)
0006.00 DCL VAR(&PGMOBJLIB) TYPE(*CHAR) LEN(20)
0007.00 DCL VAR(&PGM) TYPE(*CHAR) LEN(10)
0008.00 DCL VAR(&OBJLIB) TYPE(*CHAR) LEN(10)
0009.00 DCL VAR(&SRCF) TYPE(*CHAR) LEN(10)
0010.00 DCL VAR(&SRCFLIB) TYPE(*CHAR) LEN(10)
0011.00 DCL VAR(&SRCMBR) TYPE(*CHAR) LEN(10)
0012.00 DCL VAR(&OBJATR) TYPE(*CHAR) LEN(10)
0013.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(4) +
0014.00 VALUE(X'00000000') /* 2 進数 */
0015.00 DCL VAR(&STRPOS) TYPE(*CHAR) LEN(4) +
0016.00 VALUE(X'0000007D') /* 2 進数開始位置 : +
0017.00 125 */
0018.00 DCL VAR(&LENDTA) TYPE(*CHAR) LEN(4) +
0019.00 VALUE(X'00000010') /* 2 進数受取長さ : 16 */
0020.00 DCL VAR(&RCVVAR) TYPE(*CHAR) LEN(16) +
0021.00 VALUE(X'0000000000000000')
0022.00 DCL VAR(&OFFSET) TYPE(*CHAR) LEN(4) /* +
0023.00 2 進数 ｵﾌｾｯﾄ */
0024.00 DCL VAR(&NOENTR) TYPE(*CHAR) LEN(4) /* +
0025.00 2 進数項目数 */
0026.00 DCL VAR(&LSTSIZ) TYPE(*CHAR) LEN(4) /* +
0027.00 2 進数リストサイズ */
0028.00 DCL VAR(&DEC08) TYPE(*DEC) LEN(8 0) /* WORK */
0029.00 DCL VAR(&ADDLEN) TYPE(*DEC) LEN(8 0) /* WORK */
0030.00 DCL VAR(&NOENT) TYPE(*DEC) LEN(8 0) /* WORK */
0031.00 DCL VAR(&N) TYPE(*DEC) LEN(8 0) VALUE(1) /* WORK */
0032.00 DCL VAR(&RCVDTA) TYPE(*CHAR) LEN(4096) /* +
0033.00 受取データ */
0034.00 DCL VAR(&MODULE) TYPE(*CHAR) LEN(10)
0035.00 DCL VAR(&CCSID) TYPE(*CHAR) LEN(8)
0036.00 DCL VAR(&CCSID5) TYPE(*DEC) LEN(5 0)
0037.00 DCL VAR(&BIN4) TYPE(*CHAR) LEN(4)
0038.00 DCL VAR(&DEC08) TYPE(*DEC) LEN(8 0)
0039.00 DCL VAR(&FLD8) TYPE(*CHAR) LEN(8)
0040.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0041.00
0042.00 CHGVAR VAR(&SRCF) VALUE('*NONE ')
0043.00 CHGVAR VAR(&PGM) VALUE(%SST(&PGMOBJLIB 01 10))
0044.00 CHGVAR VAR(&OBJLIB) VALUE(%SST(&PGMOBJLIB 11 10))
0045.00 RTVOBJD OBJ(&OBJLIB/&PGM) OBJTYPE(*PGM) +
0046.00 OBJATR(&OBJATR) SRCF(&SRCF) +
0047.00 SRCFLIB(&SRCFLIB) SRCMBR(&SRCMBR)
0048.00 IF COND(&SRCF *NE ' ') THEN(DO) /* RPG ||| */
0049.00 ASNET.COM/RTVCCSID FILE(&SRCFLIB/&SRCF) CCSID(&CCSID5)
0050.00 CHGVAR VAR(&CCSID) VALUE(&CCSID5)
0051.00 RETURN
0052.00 ENDDO /* RPG ||| */
0053.00 IF COND(&OBJATR *NE 'RPGLE ') THEN(RETURN)
0054.00 /*( ユーザー・スペースの作成 )*/
0055.00 CALL PGM(QUSCRTUS) PARM('RPGSPC QTEMP ' +
0056.00 'PF ' 1000 ' ' '*ALL ' +
0057.00 'QBNLPGMI 用ユーザー空間 ' '*YES ' +
0058.00 &APIERR)
0059.00 MONMSG CPF9870
0060.00 /*( QBNLPGMI : モジュール・リスト )*/
0061.00 CALL PGM(QBNLPGMI) PARM('RPGSPC QTEMP ' +
0062.00 'PGML0100' &PGMOBJLIB &APIERR)
0063.00 /*( リストＡＰＩで作成されたユーザー空間の検索 )*/
0064.00 /*( 1. リストデータセクションのオフセット値を検索 )*/
0065.00 CALL PGM(QUSRTVUS) PARM('RPGSPC QTEMP ' +
0066.00 &STRPOS &LENDTA &RCVVAR)
0067.00 CHGVAR VAR(&OFFSET) VALUE(%SST(&RCVVAR 1 4))
0068.00 CHGVAR VAR(&NOENTR) VALUE(%SST(&RCVVAR 9 4))
0069.00 CHGVAR VAR(&LSTSIZ) VALUE(%SST(&RCVVAR 13 4))
0070.00 /*( RCVVAR によって OFFSET,LSTSIZ を受取った )*/
0071.00 CHGVAR VAR(&STRPOS) VALUE(&OFFSET)
0072.00 CHGVAR VAR(&DEC08) VALUE(%BIN(&STRPOS))
0073.00 CHGVAR VAR(&DEC08) VALUE(&DEC08 + 1)
0074.00 CHGVAR VAR(%BIN(&STRPOS)) VALUE(&DEC08)
0075.00 CHGVAR VAR(&LENDTA) VALUE(&LSTSIZ)
0076.00 CHGVAR VAR(&ADDLEN) VALUE(%BIN(&LENDTA))
0077.00 CHGVAR VAR(&NOENT) VALUE(%BIN(&NOENTR))
0078.00 CHGVAR VAR(&N) VALUE(1)
0079.00 NXTRTV:
0080.00 CALL PGM(QUSRTVUS) PARM('RPGSPC QTEMP ' +
0081.00 &STRPOS &LENDTA &RCVDTA)
0082.00 /*( 処理の開始 )*/
0083.00 CHGVAR VAR(&MODULE) VALUE(%SST(&RCVDTA 21 10))
0084.00 IF COND(&MODULE *EQ &PGM) THEN(DO)
0085.00 CHGVAR VAR(&SRCF) VALUE(%SST(&RCVDTA 41 10))
0086.00 CHGVAR VAR(&SRCFLIB) VALUE(%SST(&RCVDTA 51 10))
0087.00 CHGVAR VAR(&SRCMBR) VALUE(%SST(&RCVDTA 61 10))
0088.00 CHGVAR VAR(&BIN4) VALUE(%SST(&RCVDTA 213 4))
0089.00 CHGVAR VAR(&DEC08) VALUE(%BIN(&BIN4))
0090.00 IF COND(&DEC08 *EQ -1) THEN(DO)
0091.00 CHGVAR VAR(&CCSID) VALUE('65535')
0092.00 ENDDO
0093.00 ELSE CMD(DO)
0094.00 CHGVAR VAR(&FLD8) VALUE(&DEC08)
0095.00 CHGVAR VAR(&CCSID) VALUE(%SST(&FLD8 5 4))
0096.00 ENDDO
0097.00 RETURN
0098.00 ENDDO
0099.00 /*( 処理の終了 )*/
0100.00 IF COND(&N < &NOENT) THEN(DO)
0101.00 CHGVAR VAR(&N) VALUE(&N + 1)
0102.00 CHGVAR VAR(&DEC08) VALUE(%BIN(&STRPOS))
0103.00 CHGVAR VAR(&DEC08) VALUE(&DEC08 + &ADDLEN)
0104.00 CHGVAR VAR(%BIN(&STRPOS)) VALUE(&DEC08)
0105.00 GOTO NXTRTV
0106.00 ENDDO
0107.00 RETURN
0108.00
0109.00 ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG)
0110.00 SNDMSG: SNDPGMMSG MSG(&MSG) MSGTYPE(*DIAG)
0111.00 ENDPGM
【解説】
0054.00 /*( ユーザー・スペースの作成 )*/
0055.00 CALL PGM(QUSCRTUS) PARM('RPGSPC QTEMP ' +
0056.00 'PF ' 1000 ' ' '*ALL ' +
0057.00 'QBNLPGMI 用ユーザー空間 ' '*YES ' +
0058.00 &APIERR)
によってライブラリー QTEMP に RPGSPC という名前のユーザー・スペースを作成して
0060.00 /*( QBNLPGMI : モジュール・リスト )*/
0061.00 CALL PGM(QBNLPGMI) PARM('RPGSPC QTEMP ' +
0062.00 'PGML0100' &PGMOBJLIB &APIERR)
によってこの *PGM のモジュールのリストをユーザー・スペース : RPGSRC に出力する。
あとはこのユーザー・スペースを検索した
0084.00 IF COND(&MODULE *EQ &PGM) THEN(DO) 0085.00 CHGVAR VAR(&SRCF) VALUE(%SST(&RCVDTA 41 10)) 0086.00 CHGVAR VAR(&SRCFLIB) VALUE(%SST(&RCVDTA 51 10)) 0087.00 CHGVAR VAR(&SRCMBR) VALUE(%SST(&RCVDTA 61 10))
によってソース情報を抽出するだけである。
