RPG で紹介していた「ストレスのない SEU 」である EDTSRC
のソース一式を公開する。
EDTSRC は既に RPG 「 313. ストレスのない新しい SEU 」として説明したように
SEU を閉じなくてオープンしたままでコンパイルすることができる。
その機能の概要は次のとおりである。

EDTSRC は SEU としてソースをオープンしたままで、

SEU はエディターとして非常にパワフルで文字ベースとしての編集効率に
優れているが唯一、問題であるのがコンパイルするためにはソースを
一旦、閉じなければならないことである。
SEU を閉じてソースを保管して、コンパイルを実行して
コンパイル・エラーがあれば、また SEU でオープンする。
同じプログラムの開発に対してこの作業を延々と繰り返さなければならない。
特にデバッグ中ではソースのオープン&クローズの繰返しはストレスを感じさせる。

今回、開発した EDTSRC は社内向けとして使用しているが
繰返し再コンパイルする作業には非常に開発効率が良く早く作ればよかったと
思っているし何より開発が快適になった。
EDTSRC は製品の発表セミナーで発表したかったのだが
いち早く利用して頂きたいので TOOLS で公開することになった。
読者のほうで自社にあった事情を鑑みて必要な修正を施してもらえれば
一層使いやすくなるのではないかと思う。

なおソースの種類が多いので導入が面倒な方のために
オブジェクトを含むライブラリーをセミナーで配布することを予定している。
オブジェクトそのものをご希望の方は次回のセミナーにご出席頂きたい。

EDTSRC はあなたの開発効率を飛躍的に向上させてくれるはずだ。
こんなに開発が楽になるとは、というところを是非実感して欲しい。

【 コマンド: EDTSRC 】

0001.00              CMD        PROMPT('SEU 開始 ')                            
0002.00              PARM       KWD(SRCFILE) TYPE(SRCFILE) +                   
0003.00                           PROMPT(' ソース・ファイル ')                 
0004.00  SRCFILE:    QUAL       TYPE(*NAME) LEN(10) DFT(*PRV) SPCVAL((*PRV))   
0005.00              QUAL       TYPE(*NAME) LEN(10) SPCVAL((*LIBL) (*CURLIB) + 
0006.00                           (*PRV)) PROMPT(' ライブラリー ')             
0007.00              PARM       KWD(SRCMBR) TYPE(*NAME) LEN(10) DFT(*PRV) +    
0008.00                           SPCVAL((*PRV)) +                             
0009.00                           PROMPT(' ソース・メンバー ')                 
0010.00              PARM       KWD(TYPE) TYPE(*NAME) LEN(10) RSTD(*YES) +     
0011.00                           DFT(*SAME) VALUES(RPGLE RPG C CLE PRTF) +    
0012.00                           SPCVAL((*SAME)) PROMPT(' タイプ ')           
0013.00              PARM       KWD(TEXT) TYPE(*CHAR) LEN(50) DFT(*BLANK) +    
0014.00                           PROMPT(' テキスト '' 記述 ''')               
0015.00              PARM       KWD(OBJECT) TYPE(*CHAR) LEN(10) DFT(*SRCMBR) + 
0016.00                           PROMPT(' オブジェクト ')                     
0017.00              PARM       KWD(OBJLIB) TYPE(*CHAR) LEN(10) MIN(1) +       
0018.00                           PROMPT(' オブジェクト・ライブラリー ')       
0019.00              PARM       KWD(OBJTYP) TYPE(*CHAR) LEN(10) RSTD(*YES) +   
0020.00                           DFT(*PGM) VALUES(*PGM *SRVPGM *PRTF +        
0021.00                           *DSPF) PROMPT(' オブジェクト・タイプ ')      
0022.00              PARM       KWD(COMPILE) TYPE(*CHAR) LEN(10) RSTD(*YES) +  
0023.00                           DFT(*OBJDFN) VALUES(CRTBNDRPG CRTRPGMOD +    
0024.00                           CRTBNDC CRTCMOD CRTSRVPGM CRTCMD CRTCLPGM +    
0025.00                           CRTPF CRTLF CRTCBLMOD CRTCBLPGM +              
0026.00                           CRTBNDCBL) SPCVAL((*OBJDFN)) +                 
0027.00                           PROMPT(' コンパイラー ')                       
0028.00              PARM       KWD(BNDSRVPGM) TYPE(BNDSRVPGM) MAX(10) +         
0029.00                           PMTCTL(BIND) +                                 
0030.00                           PROMPT(' バインドサービスプログラム ')         
0031.00  BNDSRVPGM:  QUAL       TYPE(*NAME) LEN(10)                              
0032.00              QUAL       TYPE(*NAME) LEN(10) DFT(*LIBL) +                 
0033.00                           SPCVAL((*LIBL) (*CURLIB)) +                    
0034.00                           PROMPT(' ライブラリー ')                       
0035.00              PARM       KWD(DEFINE) TYPE(*CHAR) LEN(80) DFT(*NONE) +     
0036.00                           PROMPT(' 名前定義 ')                           
0037.00              PARM       KWD(ACTGRP) TYPE(*CHAR) LEN(10) DFT(*NEW) +      
0038.00                           SPCVAL((*NEW) (*CALLER)) +                     
0039.00                           PROMPT(' 活動化グループ ')                     
0040.00  BIND:       PMTCTL     CTL(COMPILE) COND((*EQ CRTRPGMOD)) LGLREL(*OR)   
0041.00              PMTCTL     CTL(COMPILE) COND((*EQ CRTCBLMOD)) LGLREL(*OR)   
0042.00              PMTCTL     CTL(COMPILE) COND((*EQ CRTCMOD)) LGLREL(*OR)     

【 解説 】

                               SEU 開始  (EDTSRC)                               
                                                                                
  選択項目を入力して，実行キーを押してください。                                
                                                                                
  ソース・ファイル  . . . . . . . > QRPGLESRC      名前 , *PRV                  
    ライブラリー  . . . . . . . . >   R610SRC      名前 , *LIBL, *CURLIB, *PRV  
  ソース・メンバー  . . . . . . . > P5250HLR       名前 , *PRV                  
  タイプ  . . . . . . . . . . . .   *SAME         *SAME, RPGLE, RPG, C, CLE...  
  テキスト ' 記述 ' . . . . . . .   *BLANK                                      
                                                                                
  オブジェクト  . . . . . . . . .   *SRCMBR        文字値                       
  オブジェクト・ライブラリー  . . > ASNET.COM      文字値                       
  オブジェクト・タイプ  . . . . . > *PGM          *PGM, *SRVPGM, *PRTF, *DSPF   
  コンパイラー  . . . . . . . . .   *OBJDFN       *OBJDFN, CRTBNDRPG...         
  名前定義  . . . . . . . . . . .   *NONE                                       
                                                                                
  活動化グループ  . . . . . . . . > *CALLER        文字値 , *NEW, *CALLER       
                                                                                

5250 ハンドラーである P5250HLR という RPG プログラムは
RPG ハンドラーであるため、活動家グループは *CALLER として定義しているが
読者が開発する通常のプログラムの場合は
ほとんどが *NEW と指定するのでよい。

CRTCMD CMD(QUATTRO/EDTSRC) PGM(QUATTRO/EDTSRCCL) SRCFILE(MYSRCLIB/QCMDSRC) AUT(*ALL)

【 CLP: EDTSRCCL 】

0001.00              PGM        PARM(&SRCFILLIB &SRCMBR &SRCTYP &TEXT +           
0002.00                           &OBJECT &OBJLIB &OBJTYP &COMPILE +              
0003.00                           &BNDSRVPGM &DEFINE &ACTGRP)                     
0004.00 /*-------------------------------------------------------------------*/   
0005.00 /*   EDTSRCCL  :   ソース・メンバーの編集                            */   
0006.00 /*                                                                   */   
0007.00 /*   2018/05/16  作成                                                */   
0008.00 /*-------------------------------------------------------------------*/   
0009.00              DCL        VAR(&SRCFILLIB) TYPE(*CHAR) LEN(20)               
0010.00              DCL        VAR(&SRCF) TYPE(*CHAR) LEN(10)                    
0011.00              DCL        VAR(&SRCFLIB) TYPE(*CHAR) LEN(10)                 
0012.00              DCL        VAR(&SRCMBR) TYPE(*CHAR) LEN(10)                  
0013.00              DCL        VAR(&SRCTYP) TYPE(*CHAR) LEN(10)                  
0014.00              DCL        VAR(&PGMOBJLIB) TYPE(*CHAR) LEN(20)               
0015.00              DCL        VAR(&RCVVAR) TYPE(*CHAR) LEN(1024)                
0016.00              DCL        VAR(&RCVLEN) TYPE(*CHAR) LEN(4) +                 
0017.00                           VALUE(X'00000400')                              
0018.00              DCL        VAR(&TEXT) TYPE(*CHAR) LEN(50)                    
0019.00              DCL        VAR(&OBJECT) TYPE(*CHAR) LEN(10)                  
0020.00              DCL        VAR(&OBJLIB) TYPE(*CHAR) LEN(10)                  
0021.00              DCL        VAR(&OBJTYP) TYPE(*CHAR) LEN(10)                  
0022.00              DCL        VAR(&COMPILE) TYPE(*CHAR) LEN(10)                 
0023.00              DCL        VAR(&BNDSRVPGM) TYPE(*CHAR) LEN(202)              
0024.00              DCL        VAR(&DEFINE) TYPE(*CHAR) LEN(80)           
0025.00              DCL        VAR(&ACTGRP) TYPE(*CHAR) LEN(10)           
0026.00              DCL        VAR(&ACTGRP_ATR) TYPE(*CHAR) LEN(30)       
0027.00              DCL        VAR(&MSG) TYPE(*CHAR) LEN(132)             
0028.00              DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)             
0029.00              DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)             
0030.00              DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)          
0031.00              DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(132)          
0032.00              DCL        VAR(&TYPE) TYPE(*CHAR) LEN(1)              
0033.00              DCL        VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)           
0034.00              DCL        VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +        
0035.00                           VALUE('*ESCAPE   ')                      
0036.00              DCL        VAR(&APIERR) TYPE(*CHAR) LEN(116) +        
0037.00                           VALUE(X'000074') /* 2 進数  */           
0038.00              DCL        VAR(&NULL4) TYPE(*CHAR) LEN(4) +           
0039.00                           VALUE(X'00000000')                       
0040.00              DCL        VAR(&OBJATR) TYPE(*CHAR) LEN(10)           
0041.00              DCL        VAR(&USRDFN) TYPE(*CHAR) LEN(10)           
0042.00              DCL        VAR(&OBJTXT) TYPE(*CHAR) LEN(50)           
0043.00              DCL        VAR(&COMPILER) TYPE(*CHAR) LEN(14)         
0044.00              DCL        VAR(&SRVSU_BIN) TYPE(*CHAR) LEN(4)         
0045.00              DCL        VAR(&SRVSU) TYPE(*DEC) LEN(8 0) VALUE(0)   
0046.00              DCL        VAR(&N) TYPE(*DEC) LEN(8 0) VALUE(1)       
0047.00              DCL        VAR(&SRV) TYPE(*CHAR) LEN(10)              
0048.00              DCL        VAR(&SRVLIB) TYPE(*CHAR) LEN(10)                   
0049.00              DCL        VAR(&SRVPGMLIB) TYPE(*CHAR) LEN(20)                
0050.00              DCL        VAR(&POS) TYPE(*DEC) LEN(4 0)                      
0051.00              DCL        VAR(&BIN2) TYPE(*CHAR) LEN(2)                      
0052.00              DCLF       FILE(QTEMP/DSPPGMREF)                              
0053.00              DCL        VAR(&BLK102) TYPE(*CHAR) LEN(102)                  
0054.00              DCL        VAR(&DEFINE_B) TYPE(*CHAR) LEN(80)                 
0055.00              DCL        VAR(&ACTGRP_B) TYPE(*CHAR) LEN(10)                 
0056.00              /*( ユーザー・スペース用の変数 )*/                            
0057.00              DCL        VAR(&STRPOS) TYPE(*CHAR) LEN(4) +                  
0058.00                           VALUE(X'0000007D') /* 2 進数開始位置  : +        
0059.00                           125 */                                           
0060.00              DCL        VAR(&LENDTA) TYPE(*CHAR) LEN(4) +                  
0061.00                           VALUE(X'00000010') /* 2 進数受取長さ  : 16 */    
0062.00              DCL        VAR(&RCVVAL) TYPE(*CHAR) LEN(16) +                 
0063.00                           VALUE(X'0000000000000000')                       
0064.00              DCL        VAR(&OFFSET) TYPE(*CHAR) LEN(4) /* +               
0065.00                           2 進数 ｵﾌｾｯﾄ */                                  
0066.00              DCL        VAR(&NOENTR) TYPE(*CHAR) LEN(4) /* +               
0067.00                           2 進数項目数  */                                 
0068.00              DCL        VAR(&LSTSIZ) TYPE(*CHAR) LEN(4) /* +               
0069.00                           2 進数リストサイズ  */                           
0070.00              DCL        VAR(&DEC08) TYPE(*DEC) LEN(8 0) /* WORK */         
0071.00              DCL        VAR(&ADDLEN) TYPE(*DEC) LEN(8 0) /* WORK */        
0072.00              DCL        VAR(&NOENT) TYPE(*DEC) LEN(8 0) /* WORK */        
0073.00              DCL        VAR(&RCVDTA) TYPE(*CHAR) LEN(1024) /* +           
0074.00                            受取データ  */                                 
0075.00              MONMSG     MSGID(CPF0000 EDT0000) EXEC(GOTO CMDLBL(ERROR))   
0076.00                                                                           
0077.00 /*( 環境の取得 )*/                                                        
0078.00              RTVJOBA    TYPE(&TYPE)                                       
0079.00              IF         COND(&TYPE *EQ '0') THEN(DO) /*  バッチ  */       
0080.00              CHGVAR     VAR(&TOPGMQ) VALUE('*SYSOPR   ')                  
0081.00              ENDDO      /*  バッチ  */                                    
0082.00              ELSE       CMD(DO) /*  対話式  */                            
0083.00              CHGVAR     VAR(&TOPGMQ) VALUE('*TOPGMQ   ')                  
0084.00              ENDDO      /*  対話式  */                                    
0085.00                                                                           
0086.00 /*( パラメータの取得 )*/                                                  
0087.00              CHGVAR     VAR(&SRCF) VALUE(%SST(&SRCFILLIB 01 10))          
0088.00              CHGVAR     VAR(&SRCFLIB) VALUE(%SST(&SRCFILLIB 11 10))       
0089.00              IF         COND(&OBJECT *EQ '*SRCMBR   ') THEN(DO)           
0090.00              CHGVAR     VAR(&OBJECT) VALUE(&SRCMBR)                       
0091.00              ENDDO                                                        
0092.00              CHGDTAARA  DTAARA(*LDA (1 20)) VALUE(&SRCFILLIB)             
0093.00              CHGDTAARA  DTAARA(*LDA (21 10)) VALUE(&SRCMBR)               
0094.00              CHGDTAARA  DTAARA(*LDA (31 10)) VALUE(&SRCTYP)               
0095.00              CHGDTAARA  DTAARA(*LDA (41 10)) VALUE(&OBJLIB)               
0096.00              CHGDTAARA  DTAARA(*LDA (51 10)) VALUE(&COMPILE)              
0097.00              CHGDTAARA  DTAARA(*LDA (432 10)) VALUE(&OBJECT)              
0098.00                                                                           
0099.00 /*( オブジェクト参照 )*/                                                  
0100.00              CHGVAR     VAR(&DEFINE_B) VALUE(&DEFINE)                     
0101.00              CHGVAR     VAR(&ACTGRP_B) VALUE(&ACTGRP)                     
0102.00              IF         COND(&COMPILE *EQ '*OBJDFN   ') THEN(DO) /* +     
0103.00                            オブジェクト定義  */                           
0104.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO) /* +      
0105.00                            プログラム  */                                 
0106.00      /*( QCLRPGMI: プログラム情報の検索 )*/                               
0107.00              CHGVAR     VAR(&PGMOBJLIB) VALUE(&OBJECT *CAT &OBJLIB)       
0108.00              CALL       PGM(QCLRPGMI) PARM(&RCVVAR &RCVLEN +              
0109.00                           'PGMI0100' &PGMOBJLIB &APIERR)                  
0110.00              IF         COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)       
0111.00              CHGVAR     VAR(&MSGID) VALUE(%SST(&APIERR 9 7))              
0112.00              IF         COND(&MSGID *EQ 'CPF9811') THEN(DO)               
0113.00              GOTO       STRSEU                                            
0114.00              ENDDO                                                        
0115.00              SNDPGMMSG  +                                                 
0116.00                           MSG('API: QCLRPGMI の実行で次のエラーが発生 +   
0117.00                            しました。 ') MSGTYPE(*DIAG)                   
0118.00              GOTO       APIERR                                            
0119.00              ENDDO                                                        
0120.00              CHGVAR     VAR(&OBJATR) VALUE(%SST(&RCVVAR 39 10))           
0121.00              CHGVAR     VAR(&OBJTXT) VALUE(%SST(&RCVVAR 111 50))          
0122.00              IF         COND(&TEXT *EQ '*SAME') THEN(CHGVAR +             
0123.00                           VAR(&TEXT) VALUE(&OBJTXT))                      
0124.00              CHGVAR     VAR(&COMPILER) VALUE(%SST(&RCVVAR 254 14))        
0125.00              CHGVAR     VAR(&ACTGRP_ATR) VALUE(%SST(&RCVVAR 369 30))      
0126.00              CHGVAR     VAR(&SRVSU_BIN) VALUE(%SST(&RCVVAR 417 4))        
0127.00                                                                           
0128.00              IF         COND(&SRCTYP *EQ '*SAME     ') THEN(DO) /* +      
0129.00                            ソース・タイプ *SAME */                        
0130.00              RTVMBRD    FILE(&SRCFLIB/&SRCF) MBR(&SRCMBR) +               
0131.00                           SRCTYPE(&SRCTYP)                                
0132.00              MONMSG     MSGID(CPF9800) EXEC(DO) /* NOT FOUND CPF9800 */   
0133.00              IF         COND(&SRCF *EQ 'QRPGLESRC ') THEN(DO)             
0134.00              CHGVAR     VAR(&SRCTYP) VALUE('RPGLE     ')                  
0135.00              ENDDO                                                        
0136.00              ELSE       CMD(IF COND(&SRCF *EQ 'QRPGSRC   ') THEN(DO))     
0137.00              CHGVAR     VAR(&SRCTYP) VALUE('RPG       ')                  
0138.00              ENDDO                                                        
0139.00              ELSE       CMD(IF COND(&SRCF *EQ 'QCSRC     ') THEN(DO))     
0140.00              CHGVAR     VAR(&SRCTYP) VALUE('C         ')                  
0141.00              ENDDO                                                        
0142.00              ELSE       CMD(IF COND(&SRCF *EQ 'QCMDSRC   ') THEN(DO))     
0143.00              CHGVAR     VAR(&SRCTYP) VALUE('CMD       ')                  
0144.00              ENDDO                                                        
0145.00              ELSE       CMD(IF COND(&SRCF *EQ 'QCLSRC    ') THEN(DO))     
0146.00              CHGVAR     VAR(&SRCTYP) VALUE('CLP       ')                  
0147.00              ENDDO                                                        
0148.00              ELSE       CMD(IF COND(&SRCF *EQ 'QDSPSRC   ') THEN(DO))     
0149.00              CHGVAR     VAR(&SRCTYP) VALUE('DSPF      ')                  
0150.00              ENDDO                                                        
0151.00              ELSE       CMD(IF COND(&SRCF *EQ 'QPRTSRC   ') THEN(DO))     
0152.00              CHGVAR     VAR(&SRCTYP) VALUE('PRTF      ')                  
0153.00              ENDDO                                                        
0154.00              ENDDO      /* NOT FOUND CPF9800 */                           
0155.00              ENDDO      /* ソース・タイプ *SAME */                        
0156.00                                                                           
0157.00              IF         COND(&TEXT *EQ '*BLANKS') THEN(DO)                
0158.00              CHGVAR     VAR(&TEXT) VALUE(&OBJTXT)                         
0159.00              ENDDO                                                        
0160.00              DSPPGMREF  PGM(&OBJLIB/&OBJECT) OUTPUT(*OUTFILE) +           
0161.00                           OBJTYPE(&OBJTYP) OUTFILE(QTEMP/DSPPGMREF) +     
0162.00                           OUTMBR(*FIRST *REPLACE)                         
0163.00              CHGVAR     VAR(&N) VALUE(1)                                  
0164.00              CHGVAR     VAR(&SRVSU) VALUE(0)                              
0165.00              CHGVAR     VAR(&POS) VALUE(3)                                
0166.00              CHGVAR     VAR(&BNDSRVPGM) VALUE(&BLK102)                    
0167.00  READ:       RCVF       RCDFMT(QWHDRPPR)                                  
0168.00              MONMSG     MSGID(CPF0864) EXEC(GOTO CMDLBL(REDEND))          
0169.00              IF         COND((&WHOTYP *EQ '*SRVPGM   ') *AND +            
0170.00                           (&WHLNAM *NE 'QSYS      ')) THEN(DO)            
0171.00              CHGVAR     VAR(&SRVSU) VALUE(&SRVSU + 1)                     
0172.00              CHGVAR     VAR(&SRV) VALUE(&WHFNAM)                          
0173.00              CHGVAR     VAR(&SRVLIB) VALUE(&WHLNAM)                       
0174.00              CHGVAR     VAR(&SRVPGMLIB) VALUE(&SRV *CAT &SRVLIB)          
0175.00              CHGVAR     VAR(%SST(&BNDSRVPGM &POS 20)) VALUE(&SRVPGMLIB)   
0176.00              CHGVAR     VAR(&POS) VALUE(&POS + 20)                        
0177.00              ENDDO                                                        
0178.00              CHGVAR     VAR(&N) VALUE(&N + 1)                             
0179.00              GOTO       READ                                              
0180.00  REDEND:                                                                  
0181.00              CHGVAR     VAR(%BIN(&BIN2)) VALUE(&SRVSU)                    
0182.00              CHGVAR     VAR(%SST(&BNDSRVPGM 1 2)) VALUE(&BIN2)            
0183.00              CHGDTAARA  DTAARA(*LDA (61 202)) VALUE(&BNDSRVPGM)           
0184.00              CHGVAR     VAR(&DEFINE) VALUE(&DEFINE_B)                     
0185.00              CHGVAR     VAR(&ACTGRP) VALUE(&ACTGRP_B)                     
0186.00     /*( 単独 PGM )*/                                                      
0187.00              IF         COND(&SRVSU *EQ 0) THEN(DO) /*  単独 PGM */       
0188.00              IF         COND(&SRCTYP *EQ 'RPGLE     ') THEN(DO) /* +      
0189.00                           RPGLE */                                        
0190.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)           
0191.00              CHGVAR     VAR(&COMPILE) VALUE('CRTBNDRPG ')                 
0192.00              ENDDO                                                         
0193.00              ELSE       CMD(DO)                                            
0194.00              CHGVAR     VAR(&COMPILE) VALUE('CRTRPGMOD ')                  
0195.00              ENDDO                                                         
0196.00              ENDDO      /* RPGLE */                                        
0197.00              IF         COND(&SRCTYP *EQ 'RPG       ') THEN(DO) /* +       
0198.00                           RPG   */                                         
0199.00              CHGVAR     VAR(&COMPILE) VALUE('CRTRPGPGM ')                  
0200.00              ENDDO      /* RPG   */                                        
0201.00              IF         COND((&SRCTYP *EQ 'C         ') *OR (&SRCTYP +     
0202.00                           *EQ 'CLE       ')) THEN(DO) /* C 言語  */        
0203.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO) /* +       
0204.00                           *PGM */                                          
0205.00              CHGVAR     VAR(&COMPILE) VALUE('CRTBNDC   ')                  
0206.00              ENDDO      /* *PGM */                                         
0207.00              ELSE       CMD(DO) /* *MODULE */                              
0208.00              CHGVAR     VAR(&COMPILE) VALUE('CRTCMOD   ')                  
0209.00              ENDDO      /* *MODULE */                                      
0210.00              ENDDO      /* C 言語  */                                      
0211.00              ENDDO      /*  単独 PGM */                                    
0212.00     /*( BIND プログラム )*/                                                
0213.00              ELSE       CMD(DO) /* BIND プログラム  */                     
0214.00              IF         COND(&SRCTYP *EQ 'RPGLE     ') THEN(DO) /* +       
0215.00                           RPGLE */                                         
0216.00              CHGVAR     VAR(&COMPILE) VALUE('CRTRPGMOD ')               
0217.00              ENDDO      /* RPGLE */                                     
0218.00              IF         COND((&SRCTYP *EQ 'C         ') *OR (&SRCTYP +  
0219.00                           *EQ 'CLE       ')) THEN(DO) /* C     */       
0220.00              CHGVAR     VAR(&COMPILE) VALUE('CRTCMOD   ')               
0221.00              ENDDO      /* C     */                                     
0222.00              ENDDO      /* BIND プログラム  */                          
0223.00                                                                         
0224.00              CHGDTAARA  DTAARA(*LDA (263 80)) VALUE(&DEFINE)            
0225.00              CHGDTAARA  DTAARA(*LDA (342 10)) VALUE(&ACTGRP)            
0226.00              CHGDTAARA  DTAARA(*LDA (352 10)) VALUE(&OBJTYP)            
0227.00              CHGDTAARA  DTAARA(*LDA (382 50)) VALUE(&TEXT)              
0228.00              ENDDO      /*  プログラム  */                              
0229.00              ELSE       CMD(IF COND(&OBJTYP *EQ '*SRVPGM   ') +         
0230.00                           THEN(DO)) /*  サービス・プログラム  */        
0231.00      /*( QBNLSPGM: サービス・プログラム情報の検索 )*/                   
0232.00              CHGVAR     VAR(&PGMOBJLIB) VALUE(&OBJECT *CAT &OBJLIB)     
0233.00 /*( ユーザー・スペースの作成 )*/                                        
0234.00              CALL       PGM(QUSCRTUS) PARM('SRVPGM    QTEMP     ' +     
0235.00                           'PF        ' 1000 ' ' '*ALL      ' +          
0236.00                           'DSPSRVPGM 用ユーザー空間 ' '*YES      ' +    
0237.00                           &APIERR)                                      
0238.00              MONMSG     CPF9870                                         
0239.00              CALL       PGM(QBNLSPGM) PARM('SRVPGM    QTEMP     ' +     
0240.00                           'SPGL0200' &PGMOBJLIB &APIERR)                   
0241.00              IF         COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)        
0242.00              SNDPGMMSG  +                                                  
0243.00                           MSG('API: QBNLSPGM の実行で次のエラーが発生 +    
0244.00                            しました。 ') MSGTYPE(*DIAG)                    
0245.00              GOTO       APIERR                                             
0246.00              ENDDO                                                         
0247.00 /*( リストＡＰＩで作成されたユーザー空間の検索 )*/                         
0248.00              CHGVAR     VAR(&POS) VALUE(3)                                 
0249.00              CHGVAR     VAR(&BNDSRVPGM) VALUE(&BLK102)                     
0250.00              CHGVAR     VAR(&SRVSU) VALUE(0)                               
0251.00      /*( リストデータセクションのオフセットを検索 )*/                      
0252.00              CALL       PGM(QUSRTVUS) PARM('SRVPGM    QTEMP     ' +        
0253.00                           &STRPOS &LENDTA &RCVVAL)                         
0254.00              CHGVAR     VAR(&OFFSET) VALUE(%SST(&RCVVAL 1 4))              
0255.00              CHGVAR     VAR(&NOENTR) VALUE(%SST(&RCVVAL 9 4))              
0256.00              CHGVAR     VAR(&SRVSU_BIN) VALUE(&NOENTR)                     
0257.00              CHGVAR     VAR(&LSTSIZ) VALUE(%SST(&RCVVAL 13 4))             
0258.00                                                                            
0259.00          /*( RCVVAR によって OFFSET,LSTSIZ を受取った )*/                  
0260.00              CHGVAR     VAR(&STRPOS) VALUE(&OFFSET)                        
0261.00              CHGVAR     VAR(&DEC08) VALUE(%BIN(&STRPOS))                   
0262.00              CHGVAR     VAR(&DEC08) VALUE(&DEC08 + 1)                      
0263.00              CHGVAR     VAR(%BIN(&STRPOS)) VALUE(&DEC08)                   
0264.00              CHGVAR     VAR(&LENDTA) VALUE(&LSTSIZ)                          
0265.00              CHGVAR     VAR(&ADDLEN) VALUE(%BIN(&LENDTA))                    
0266.00              CHGVAR     VAR(&NOENT) VALUE(%BIN(&NOENTR))                     
0267.00              CHGVAR     VAR(&SRVSU) VALUE(0)                                 
0268.00              CHGVAR     VAR(&POS) VALUE(3)                                   
0269.00              CHGVAR     VAR(&BNDSRVPGM) VALUE(&BLK102)                       
0270.00 NXTRTV:                                                                      
0271.00              CALL       PGM(QUSRTVUS) PARM('SRVPGM    QTEMP     ' +          
0272.00                           &STRPOS &LENDTA &RCVDTA)                           
0273.00              /*( 処理の開始 )*/                                              
0274.00              CHGVAR     VAR(&SRV) VALUE(%SST(&RCVDTA 21 10))                 
0275.00              CHGVAR     VAR(&SRVLIB) VALUE(%SST(&RCVDTA 31 10))              
0276.00              IF         COND(%SST(&SRVLIB 1 4) *EQ 'QSYS') THEN(GOTO +       
0277.00                           CMDLBL(BYPAS))                                     
0278.00              CHGVAR     VAR(&SRVPGMLIB) VALUE(&SRV *CAT &SRVLIB)             
0279.00              CHGVAR     VAR(%SST(&BNDSRVPGM &POS 20)) VALUE(&SRVPGMLIB)      
0280.00              CHGVAR     VAR(&POS) VALUE(&POS + 20)                           
0281.00              CHGVAR     VAR(&SRVSU) VALUE(&SRVSU + 1)                        
0282.00              /*( 処理の終了 )*/                                              
0283.00  BYPAS:      IF         COND(&N < &NOENT) THEN(DO)                           
0284.00              CHGVAR     VAR(&N) VALUE(&N + 1)                                
0285.00              CHGVAR     VAR(&DEC08)  VALUE(%BIN(&STRPOS))                    
0286.00              CHGVAR     VAR(&DEC08) VALUE(&DEC08 + &ADDLEN)                  
0287.00              CHGVAR     VAR(%BIN(&STRPOS)) VALUE(&DEC08)                     
0288.00              GOTO       NXTRTV                                          
0289.00              ENDDO                                                      
0290.00              CHGVAR     VAR(%BIN(&BIN2)) VALUE(&SRVSU)                  
0291.00              CHGVAR     VAR(%SST(&BNDSRVPGM 1 2)) VALUE(&BIN2)          
0292.00              CHGDTAARA  DTAARA(*LDA (61 202)) VALUE(&BNDSRVPGM)         
0293.00              CHGDTAARA  DTAARA(*LDA (352 10)) VALUE(&OBJTYP)            
0294.00              CHGDTAARA  DTAARA(*LDA (382 50)) VALUE(&TEXT)              
0295.00              CHGVAR     VAR(&DEFINE) VALUE(&DEFINE_B)                   
0296.00              CHGDTAARA  DTAARA(*LDA (263 80)) VALUE(&DEFINE)            
0297.00              CHGVAR     VAR(&ACTGRP) VALUE(&ACTGRP_B)                   
0298.00              CHGVAR     VAR(&ACTGRP) VALUE('*CALLER   ')                
0299.00              CHGDTAARA  DTAARA(*LDA (342 10)) VALUE(&ACTGRP)            
0300.00              ENDDO      /*  サービス・プログラム  */                    
0301.00              ELSE       CMD(IF COND((&OBJTYP *EQ '*DSPF     ') *OR +    
0302.00                           (&OBJTYP *EQ '*PRTF     ')) THEN(DO)) /* +    
0303.00                            印刷または表示ファイル  */                   
0304.00              RTVOBJD    OBJ(&OBJLIB/&OBJECT) OBJTYPE(*FILE) +           
0305.00                           USRDFNATR(&USRDFN) TEXT(&TEXT)                
0306.00              MONMSG     MSGID(CPF9800) EXEC(GOTO CMDLBL(ERROR))         
0307.00              CHGDTAARA  DTAARA(*LDA (352 10)) VALUE(&OBJTYP)            
0308.00              CHGDTAARA  DTAARA(*LDA (382 50)) VALUE(&TEXT)              
0309.00              CHGDTAARA  DTAARA(*LDA (422 10)) VALUE(&USRDFN)            
0310.00              ENDDO      /*  印刷または表示ファイル  */                  
0311.00              ENDDO                                                      
0312.00                                                                           
0313.00 /*( ATTN プログラムの設定 )*/                                             
0314.00 STRSEU:                                                                   
0315.00              SETATNPGM  PGM(QUATTRO/ATTNCL) SET(*ON)                      
0316.00              IF         COND(&DEFINE *NE ' ') THEN(DO)                    
0317.00              CHGMSGD    MSGID(EDT0630) MSGF(QUATTRO/QEDTMSGF) +           
0318.00                           MSG(' リリース・モードのコンパイルも必要で +    
0319.00                            す。 ')                                        
0320.00              ENDDO                                                        
0321.00              ELSE       CMD(DO)                                           
0322.00              CHGMSGD    MSGID(EDT0630) MSGF(QUATTRO/QEDTMSGF) +           
0323.00                           MSG(&BLK102)                                    
0324.00              ENDDO                                                        
0325.00              OVRMSGF    MSGF(QEDTMSG) TOMSGF(QUATTRO/QEDTMSGF) +          
0326.00                           SECURE(*YES)                                    
0327.00                                                                           
0328.00 /*( SEU の開始 )*/                                                        
0329.00              STRSEU     SRCFILE(&SRCFLIB/&SRCF) SRCMBR(&SRCMBR) +         
0330.00                           TYPE(&SRCTYP) TEXT(&TEXT)                       
0331.00              MONMSG     MSGID(EDT0221) EXEC(GOTO CMDLBL(ERROR))           
0332.00              DLTOVR     FILE(QEDTMSG) LVL(*JOB)                           
0333.00              MONMSG     CPF9800                                           
0334.00              SETATNPGM  PGM(QUATTRO/ATTNCL) SET(*OFF)                     
0335.00              RETURN                                                       
0336.00                                                                       
0337.00  APIERR:                                                              
0338.00              CHGVAR     VAR(&MSGID) VALUE(%SST(&APIERR 9 7))          
0339.00              CHGVAR     VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))      
0340.00              CHGVAR     VAR(&MSGF) VALUE('QCPFMSG   ')                
0341.00              CHGVAR     VAR(&MSGFLIB) VALUE('QSYS      ')             
0342.00              GOTO       SNDMSG                                        
0343.00                                                                       
0344.00  ERROR:      RCVMSG     MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +           
0345.00                           MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) + 
0346.00                           MSGFLIB(&MSGFLIB)                           
0347.00              IF         COND(%SST(&MSGID 1 3) *EQ 'EDT' *AND (&MSGID +
0348.00                           *NE 'EDT0001') *AND (&MSGFLIB *EQ +         
0349.00                           '*LIBL     ')) THEN(DO)                     
0350.00              CHGVAR     VAR(&MSGFLIB) VALUE('QPDA      ')             
0351.00              ENDDO                                                    
0352.00              IF         COND(&MSGTYPE *EQ '*ESCAPE   ') THEN(DO)      
0353.00              CHGVAR     VAR(&MSGTYPE) VALUE('*DIAG     ')             
0354.00              ENDDO                                                    
0355.00  SNDMSG:     IF         COND(&MSGID *EQ ' ') THEN(DO)                 
0356.00              SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +   
0357.00                           TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)           
0358.00              ENDDO                                                    
0359.00              ELSE       CMD(DO)                                       
0360.00              SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + 
0361.00                           MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +  
0362.00                           MSGTYPE(&MSGTYPE)                  
0363.00              ENDDO                                           
0364.00              ENDPGM                                          

【 解説 】

0092.00              CHGDTAARA  DTAARA(*LDA (1 20)) VALUE(&SRCFILLIB)             
0093.00              CHGDTAARA  DTAARA(*LDA (21 10)) VALUE(&SRCMBR)               
0094.00              CHGDTAARA  DTAARA(*LDA (31 10)) VALUE(&SRCTYP)               
0095.00              CHGDTAARA  DTAARA(*LDA (41 10)) VALUE(&OBJLIB)               
0096.00              CHGDTAARA  DTAARA(*LDA (51 10)) VALUE(&COMPILE)              
0097.00              CHGDTAARA  DTAARA(*LDA (432 10)) VALUE(&OBJECT)

によって *LDA に保管しておいて SEU の中から F7 キーや F8 キーによって
呼び出されて実行されるプログラムでも参照できるようにしている。

次に API: QCLRPGMI: プログラム情報の検索を使ってプログラムの情報を
調べてプログラムのタイプやテキスト、特にコンパイラーが何であるかを調べている。
ソース・タイプは RTVMBRD によって

0130.00              RTVMBRD    FILE(&SRCFLIB/&SRCF) MBR(&SRCMBR) +
0131.00                           SRCTYPE(&SRCTYP)   

のようにして取得しているがソースが存在しない場合は
ソース・タイプはソース・ファイル名によって判断している。
特殊なソース・ファイル名を使用している場合はこの EDTSRCCL を
修正する必要がある。

次に DSPPGMREF コマンドを使ってプログラムが参照しているオブジェクトを
次のように調べている。

0160.00              DSPPGMREF  PGM(&OBJLIB/&OBJECT) OUTPUT(*OUTFILE) +      
0161.00                           OBJTYPE(&OBJTYP) OUTFILE(QTEMP/DSPPGMREF) +
0162.00                           OUTMBR(*FIRST *REPLACE)                    

出力されたファイル: QTEMP/DSPPGMREF を次のように読み取って
このプログラムによって使用されているサービス・プログラムを
調べている

0163.00              CHGVAR     VAR(&N) VALUE(1)                                    
0164.00              CHGVAR     VAR(&SRVSU) VALUE(0)                                
0165.00              CHGVAR     VAR(&POS) VALUE(3)                                  
0166.00              CHGVAR     VAR(&BNDSRVPGM) VALUE(&BLK102)                      
0167.00  READ:       RCVF       RCDFMT(QWHDRPPR)                                    
0168.00              MONMSG     MSGID(CPF0864) EXEC(GOTO CMDLBL(REDEND))            
0169.00              IF         COND((&WHOTYP *EQ '*SRVPGM   ') *AND +              
0170.00                           (&WHLNAM *NE 'QSYS      ')) THEN(DO)              
0171.00              CHGVAR     VAR(&SRVSU) VALUE(&SRVSU + 1)                       
0172.00              CHGVAR     VAR(&SRV) VALUE(&WHFNAM)                            
0173.00              CHGVAR     VAR(&SRVLIB) VALUE(&WHLNAM)                         
0174.00              CHGVAR     VAR(&SRVPGMLIB) VALUE(&SRV *CAT &SRVLIB)            
0175.00              CHGVAR     VAR(%SST(&BNDSRVPGM &POS 20)) VALUE(&SRVPGMLIB)     
0176.00              CHGVAR     VAR(&POS) VALUE(&POS + 20)                          
0177.00              ENDDO                                                          
0178.00              CHGVAR     VAR(&N) VALUE(&N + 1)                               
0179.00              GOTO       READ                                                
0180.00  REDEND:                                                                    

後は活動化グループやユーザー定義を検索してようやく SEU の開始となる。

0328.00 /*( SEU の開始 )*/                                                        
0329.00              STRSEU     SRCFILE(&SRCFLIB/&SRCF) SRCMBR(&SRCMBR) +         
0330.00                           TYPE(&SRCTYP) TEXT(&TEXT) 

SEU が開始されたら F13 キーを押して次のようにユーザー出口プログラムを
登録しておく。
これは一度きりの作業である。

CRTCLPGM PGM(QUATTRO/EDTSRCCL) SRCFILE(MYSRCLIB/QCLSRC) AUT(*ALL)

                           セッション省略時の値の  変更                      
                                                                             
選択項目を入力して，実行キーを押  してください。                             
                                                                             
  メンバーの番号付け直しの省略時値  .   Y            Y=YES, N=NO             
                                                     P= 前と同じ             
  このソース仕様タイプの大文字                                               
    入力の省略時の値  . . . . . . . .   N            Y=YES, N=NO             
                                                                             
  ユーザー出口プログラム  . . . . . .   EDTSRC       *REGFAC, *NONE, 名前    
    ライブラリー  . . . . . . . . . .   QUATTRO       名前                   

【 解説 】

【 RPG: EDTSRC 】

0001.00 H DFTNAME(EDTSRC) DATEDIT(*YMD/) BNDDIR('QC2LE')                               
0002.00 F********** SEU 出口プログラム ****************************************        
0003.00 F*                                                                             
0004.00 F**********************************************************************        
0005.00                                                                                
0006.00  * CRTRPGMOD  OBJ(QTEMP/EDTSRC)   SRCFILE(R610SRC/QRPGLESRC)                   
0007.00  * DBGVIEW(*SOURCE) AUT(*ALL)                                                  
0008.00  * CRTPGM PGM(ASNET.COM/EDTSRC) MODULE(QTEMP/EDTSRC) ACTGRP(*NEW)              
0009.00  *        AUT(*ALL)                                                            
0010.00                                                                                
0011.00  *-------------------------------------------------------------------*         
0012.00  *  2017/05/17 : 作成                                                          
0013.00  *-------------------------------------------------------------------*         
0014.00 D MSR             S            100    DIM(2) CTDATA PERRCD(1)                  
0015.00                                                                                
0016.00 D*( CMD           のプロトタイプ宣言 )                                         
0017.00 D CMD             PR            10I 0 EXTPROC('system')                        
0018.00 D   PATH                          *   VALUE OPTIONS(*STRING)                   
0019.00 D CMDSTR          S            132A                                            
0020.00                                                                                
0021.00 D QMHSNDPM        PR                  ExtPgm('QMHSNDPM')                       
0022.00 D  MSGID                         7A   CONST                                    
0023.00 D  MSGFILE                      20A   CONST                                    
0024.00 D  MSGDATA                    6000A   CONST OPTIONS(*varsize)     
0025.00 D  MSGDATALEN                   10I 0 CONST                       
0026.00 D  MSGTYPE                      10A   CONST                       
0027.00 D  CALLSTACKE                   10A   CONST                       
0028.00 D  CALLSTACKC                   10I 0 CONST                       
0029.00 D  RTNMSGKEY                     4A                               
0030.00 D  APIERR                             LIKEDS(QUSEC)               
0031.00 D                                     OPTIONS(*VARSIZE)           
0032.00                                                                   
0033.00 D RTNMSGKEY       S              4A                               
0034.00                                                                   
0035.00 DQUSEC            DS                                              
0036.00 D QUSBPRV                 1      4B 0 INZ(8)                      
0037.00 D QUSBAVL                 5      8B 0 INZ(0)                      
0038.00                                                                   
0039.00 D HEADER          DS                                              
0040.00 D  HRLEN                  1      4B 0                             
0041.00 D  HCRRN                  5      8B 0                             
0042.00 D  HCPOS                  9     12B 0                             
0043.00 D  HCCCSID               13     16B 0                             
0044.00 D  HRECI                 17     20B 0                             
0045.00 D  HMNAM                 21     30                                
0046.00 D  HFNAM                 31     40                                
0047.00 D  HLNAM                 41     50                                
0048.00 D  HMTYP                 51     60                                  
0049.00 D  HFKEY                 61     61                                  
0050.00 D  HMODE                 62     62                                  
0051.00 D  HSSES                 63     63                                  
0052.00 D  HRSV1                 64     64                                  
0053.00 D  HRETC                 65     65                                  
0054.00 D  HRSV2                 66     68                                  
0055.00 D  HRECO                 69     72B 0                               
0056.00 D  HSEQN                 73     79                                  
0057.00 D  HRSV3                 80    100                                  
0058.00 D  HLCMD                101    107                                  
0059.00                                                                     
0060.00  * RTV/CHG ユーザー・スペース検索用パラメータ                       
0061.00 D                 DS                                                
0062.00 D  USPNL                  1     20                                  
0063.00 D  USPNAM                 1     10    INZ('QSUSPC    ')             
0064.00 D  USPLIB                11     20    INZ('QTEMP     ')             
0065.00 D  USPSTR                21     24B 0 INZ(1)                        
0066.00 D  USPLEN                25     28B 0 INZ(107)                      
0067.00 D  USPFRC                29     29    INZ('0')                      
0068.00 D  USPERR                30     53                                  
0069.00                                                                     
0070.00  * SNDMSG メッセージ送信パラメータ                                  
0071.00 D                 DS                                                
0072.00 D  MSGID                  1      7    INZ('CPF9897')                 
0073.00 D  MSGF                   8     27    INZ('QCPFMSG   QSYS      ')    
0074.00 D  MSGDTA                28     28    INZ('A')                       
0075.00 D  MSGLEN                29     32B 0 INZ(132)                       
0076.00 D  MSGTYP                33     42    INZ('*INFO')                   
0077.00 D  MSGENT                43     52    INZ('*')                       
0078.00 D  MSGCNT                53     56B 0 INZ(2)                         
0079.00 D  MSGKEY                57     60                                   
0080.00 D  MSGERR                61     84                                   
0081.00                                                                      
0082.00 D MSG             S            132A   INZ('EDTSRC のテスト ')        
0083.00 D AR              S              1A   DIM(256)                       
0084.00 D N               S              4S 0                                
0085.00 D TRUE            S              1A   DIM(256)                       
0086.00 D TRUE#           S              4B 0 INZ(0)                         
0087.00 D FALSE#          S              4B 0 INZ(-1)                        
0088.00 D QUOT            C                   CONST(X'7D')                   
0089.00 D OE              C                   CONST(X'0E')                   
0090.00 D OF              C                   CONST(X'0F')                   
0091.00 D NULL            C                   CONST(X'00')                   
0092.00 D STACK           S              4B 0                                
0093.00                                                                      
0094.00 D*( プログラム状況データ構造 )                                       
0095.00 D INFDS_THIS     SDS                                                 
0096.00 D  PROC_NAM         *PROC                                       
0097.00 D  ROUTINE          *ROUTINE                                    
0098.00 D                              512A                             
0099.00 D  PGMINFO                1    512                              
0100.00 D  LINE_NUM              21     28                              
0101.00 D  CPFID                 40     46                              
0102.00 D  CPFDTA                91    170                              
0103.00 D  ERRMSGID              46     51                              
0104.00 D  CURUSR               358    367                              
0105.00                                                                 
0106.00 D*( WORK 日付 YYMMDD ﾃﾞｰﾀ 構造  )                               
0107.00 D DATEDS          DS                                            
0108.00 D  CENTURY                1      2  0 INZ(20)                   
0109.00 D  YYMMDD                 3      8  0                           
0110.00 D  YY                     3      4                              
0111.00 D  MM                     5      6                              
0112.00 D  DD                     7      8                              
0113.00 D  CYY                    1      4                              
0114.00                                                                 
0115.00 D COMPILE         C                   CONST('QUATTRO/COMPILE')  
0116.00 D RPGERR          C                   CONST('QUATTRO/RPGERR')   
0117.00 D CLEERR          C                   CONST('QUATTRO/CLEERR')   
0118.00 D EXECUTE         C                   CONST('QUATTRO/EXECUTE')  
0119.00 D DEBUG           C                   CONST('QUATTRO/DEBUG')    
0120.00 D SAVMSG          C                   CONST('QUATTRO/SAVMSG')               
0121.00 D UPDJOB          C                   CONST('QUATTRO/UPDJOB')               
0122.00                                                                             
0123.00  * *LDA: ローカル・データ・エリア                                           
0124.00 D WKLDA          UDS                  DTAARA(*LDA)                          
0125.00 D  NXTJOB               362    371                                          
0126.00 C*--------------------------------------------------------------------------
0127.00 C     *ENTRY        PLIST                                                  |
0128.00 C                   PARM                    P1                4 0          |
0129.00 C                   PARM                    P2                4 0          |
0130.00 C                   PARM                    P3                4 0          |
0131.00 C*--------------------------------------------------------------------------
0132.00 C                   EXSR      RTVSPC                                        
0133.00 C                   MOVEL     USPDTA        HEADER                         L
0134.00 C     HFKEY         CASEQ     '7'           COMPILE_                        
0135.00 C     HFKEY         CASEQ     '8'           NXTJOB_                         
0136.00 C                   ENDCS                                                   
0137.00 C                   SETON                                        LR         
0138.00 C                   RETURN                                                  
0139.00 C******************************************************                     
0140.00 C     *INZSR        BEGSR                                                   
0141.00 C******************************************************                     
0142.00 C*  初期 CYCLE のみの実行                                                   
0143.00 C*    *DTAARA       DEFINE    *LDA          WKLDA                           
0144.00 C*    *LOCK         IN        *DTAARA                           
0145.00 C*                  UNLOCK    WKLDA                             
0146.00 C                   ENDSR                                       
0147.00 C******************************************************         
0148.00 C     RTVSPC        BEGSR                                       
0149.00 C******************************************************         
0150.00 C                   CALL      'QUSRTVUS'                        
0151.00 C                   PARM                    USPNL               
0152.00 C                   PARM                    USPSTR              
0153.00 C                   PARM                    USPLEN              
0154.00 C                   PARM                    USPDTA         1024 
0155.00 C                   ENDSR                                       
0156.00 C******************************************************         
0157.00 C     CHGSPC        BEGSR                                       
0158.00 C******************************************************         
0159.00 C                   CALL      'QUSCHGUS'                        
0160.00 C                   PARM                    USPNL               
0161.00 C                   PARM                    USPSTR              
0162.00 C                   PARM                    USPLEN              
0163.00 C                   PARM                    USPDTA              
0164.00 C                   PARM                    USPFRC              
0165.00 C                   PARM                    USPERR              
0166.00 C                   ENDSR                                       
0167.00 C******************************************************         
0168.00 C     COMPILE_      BEGSR                                   
0169.00 C******************************************************     
0170.00 C     HCRRN         IFGT      *ZEROS                        
0171.00 C                   EXSR      SAVERR_                       
0172.00 C                   LEAVESR                                 
0173.00 C                   ENDIF                                   
0174.00 C                   CALL      COMPILE                       
0175.00 C                   MOVE      '1'           HRETC           
0176.00 C                   MOVEL     HEADER        USPDTA          
0177.00 C                   EXSR      CHGSPC                        
0178.00 C                   EXSR      SNDMSG                        
0179.00 C     *LOCK         IN        *DTAARA                       
0180.00 C                   ENDSR                                   
0181.00 C******************************************************     
0182.00 C     SAVERR_       BEGSR                                   
0183.00 C******************************************************     
0184.00 C                   CALL      SAVMSG                        
0185.00 C                   EXSR      SNDMSG                        
0186.00 C                   ENDSR                                   
0187.00 C******************************************************     
0188.00 C     SNDMSG        BEGSR                                   
0189.00 C******************************************************     
0190.00  /FREE                                                      
0191.00      QMHSNDPM('EDT0001':'QEDTMSGF  QUATTRO   ':'EDTSRC':    
0192.00               6:'*INFO':'*':                             
0193.00               2:RTNMSGKEY:QUSEC);                        
0194.00  /END-FREE                                               
0195.00 C                   ENDSR                                
0196.00 C******************************************************  
0197.00 C     NXTJOB_       BEGSR                                
0198.00 C******************************************************  
0199.00 C                   SELECT                               
0200.00 C                   WHEN      NXTJOB = '*RPGERR   '      
0201.00 C                   CALL      RPGERR                     
0202.00 C                   WHEN      NXTJOB = '*CLEERR   '      
0203.00 C                   CALL      CLEERR                     
0204.00 C                   WHEN      NXTJOB = '*EXECUTE  '      
0205.00 C                   CALL      EXECUTE                    
0206.00 C                   EVAL      NXTJOB = '*DEBUG    '      
0207.00 C                   EXSR      UPDJOB_                    
0208.00 C                   WHEN      NXTJOB = '*DEBUG    '      
0209.00 C                   CALL      DEBUG                      
0210.00 C                   EVAL      NXTJOB = '*EXECUTE  '      
0211.00 C                   EXSR      UPDJOB_                    
0212.00 C                   OTHER                                
0213.00 C                   CALL      EXECUTE                    
0214.00 C                   ENDSL                                
0215.00  *( 受取りメッセージの送信 )                             
0216.00 C                   MOVE      '1'           HRETC             
0217.00 C                   MOVEL     HEADER        USPDTA            
0218.00 C                   EXSR      CHGSPC                          
0219.00 C                   EXSR      SNDMSG                          
0220.00 C                   ENDSR                                     
0221.00 C******************************************************       
0222.00 C     UPDJOB_       BEGSR                                     
0223.00 C******************************************************       
0224.00 C*( 次のジョブを更新しておく )                                
0225.00 C                   CALL      UPDJOB                          
0226.00 C                   PARM                    NXTJOB            
0227.00 C                   ENDSR                                     
0228.00 ** MSR                                                             
0229.00 CHGMSGD MSGID(EDT0001) MSGF(QUATTRO/QEDTMSGF)                      
0230.00  MSG('' ソースが保管されていません。 SAVE で保管してください。 '')  

【 解説 】

0115.00 D COMPILE         C                   CONST('QUATTRO/COMPILE')  
0116.00 D RPGERR          C                   CONST('QUATTRO/RPGERR')   
0117.00 D CLEERR          C                   CONST('QUATTRO/CLEERR')   
0118.00 D EXECUTE         C                   CONST('QUATTRO/EXECUTE')  
0119.00 D DEBUG           C                   CONST('QUATTRO/DEBUG')    
0120.00 D SAVMSG          C                   CONST('QUATTRO/SAVMSG')               
0121.00 D UPDJOB          C                   CONST('QUATTRO/UPDJOB') 

として 7 種類のプログラムが用意されている。

CRTBNDRPG PGM(QUATTRO/EDTSRC) SRCFILE(MYSRCLIB/QRPGLESRC) DFTACTGRP(*NO)
                ACTGRP(*NEW) DBGVIEW(*SOURCE) AUT(*ALL)

【 CLP: COMPILE 】

0001.00              PGM                                                            
0002.00 /*-------------------------------------------------------------------*/     
0003.00 /*   COMPILE   :  EDTSRC 出口プログラム ( コンパイル )               */     
0004.00 /*                                                                   */     
0005.00 /*   2018/05/17  作成                                                */     
0006.00 /*-------------------------------------------------------------------*/     
0007.00              DCL        VAR(&MSG) TYPE(*CHAR) LEN(132)                      
0008.00              DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)                      
0009.00              DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)                      
0010.00              DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)                   
0011.00              DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(132)                   
0012.00              DCL        VAR(&TYPE) TYPE(*CHAR) LEN(1)                       
0013.00              DCL        VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)                    
0014.00              DCL        VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +                 
0015.00                           VALUE('*ESCAPE   ')                               
0016.00              DCL        VAR(&APIERR) TYPE(*CHAR) LEN(116) +                 
0017.00                           VALUE(X'000074') /* 2 進数  */                    
0018.00              DCL        VAR(&NULL4) TYPE(*CHAR) LEN(4) +                    
0019.00                           VALUE(X'00000000')                                
0020.00              /*( QUSRTVUS 用変数 )*/                                        
0021.00              DCL        VAR(&STRPOS) TYPE(*CHAR) LEN(4) +                   
0022.00                           VALUE(X'00000001') /* 2 進数開始位置  : +         
0023.00                           125 */                                            
0024.00              DCL        VAR(&LENDTA) TYPE(*CHAR) LEN(4) +                
0025.00                           VALUE(X'00000400') /* 2 進数受取長さ  : 16 */  
0026.00              DCL        VAR(&RCVDTA) TYPE(*CHAR) LEN(1024) /* +          
0027.00                            受取データ  */                                
0028.00              DCL        VAR(&RCDL) TYPE(*CHAR) LEN(4)                    
0029.00              DCL        VAR(&RCDLEN) TYPE(*DEC) LEN(8 0)                 
0030.00              DCL        VAR(&SRCF) TYPE(*CHAR) LEN(10)                   
0031.00              DCL        VAR(&SRCFLIB) TYPE(*CHAR) LEN(10)                
0032.00              DCL        VAR(&SRCMBR) TYPE(*CHAR) LEN(10)                 
0033.00              DCL        VAR(&SRCTYP) TYPE(*CHAR) LEN(10)                 
0034.00              /*( コンパイル用変数 )*/                                    
0035.00              DCL        VAR(&OBJECT) TYPE(*CHAR) LEN(10)                 
0036.00              DCL        VAR(&OBJLIB) TYPE(*CHAR) LEN(10)                 
0037.00              DCL        VAR(&OBJTYP) TYPE(*CHAR) LEN(10)                 
0038.00              DCL        VAR(&USRDFN) TYPE(*CHAR) LEN(10)                 
0039.00              DCL        VAR(&COMPILE) TYPE(*CHAR) LEN(10)                
0040.00              DCL        VAR(&BNDSRVPGM) TYPE(*CHAR) LEN(202)             
0041.00              DCL        VAR(&DEFINE) TYPE(*CHAR) LEN(80)                 
0042.00              DCL        VAR(&ACTGRP) TYPE(*CHAR) LEN(10)                 
0043.00              DCL        VAR(&BIN2) TYPE(*CHAR) LEN(2)                    
0044.00              DCL        VAR(&SRVSU) TYPE(*DEC) LEN(8 0) VALUE(0)         
0045.00              DCL        VAR(&SRV_01) TYPE(*CHAR) LEN(10)                 
0046.00              DCL        VAR(&LIB_01) TYPE(*CHAR) LEN(10)                 
0047.00              DCL        VAR(&SRV_02) TYPE(*CHAR) LEN(10)                 
0048.00              DCL        VAR(&LIB_02) TYPE(*CHAR) LEN(10)       
0049.00              DCL        VAR(&SRV_03) TYPE(*CHAR) LEN(10)       
0050.00              DCL        VAR(&LIB_03) TYPE(*CHAR) LEN(10)       
0051.00              DCL        VAR(&SRV_04) TYPE(*CHAR) LEN(10)       
0052.00              DCL        VAR(&LIB_04) TYPE(*CHAR) LEN(10)       
0053.00              DCL        VAR(&SRV_05) TYPE(*CHAR) LEN(10)       
0054.00              DCL        VAR(&LIB_05) TYPE(*CHAR) LEN(10)       
0055.00              DCL        VAR(&SRV_06) TYPE(*CHAR) LEN(10)       
0056.00              DCL        VAR(&LIB_06) TYPE(*CHAR) LEN(10)       
0057.00              DCL        VAR(&SRV_07) TYPE(*CHAR) LEN(10)       
0058.00              DCL        VAR(&LIB_07) TYPE(*CHAR) LEN(10)       
0059.00              DCL        VAR(&SRV_08) TYPE(*CHAR) LEN(10)       
0060.00              DCL        VAR(&LIB_08) TYPE(*CHAR) LEN(10)       
0061.00              DCL        VAR(&SRV_09) TYPE(*CHAR) LEN(10)       
0062.00              DCL        VAR(&LIB_09) TYPE(*CHAR) LEN(10)       
0063.00              DCL        VAR(&SRV_10) TYPE(*CHAR) LEN(10)       
0064.00              DCL        VAR(&LIB_10) TYPE(*CHAR) LEN(10)       
0065.00              DCL        VAR(&NXTJOB) TYPE(*CHAR) LEN(10) +     
0066.00                           VALUE('*EXECUTE  ')                  
0067.00      /*( RTVPRTFA 用の変数 )*/                                 
0068.00              DCL        VAR(&PRTF) TYPE(*CHAR) LEN(10)         
0069.00              DCL        VAR(&PRTFLIB) TYPE(*CHAR) LEN(10)      
0070.00              DCL        VAR(&IGCDTA) TYPE(*CHAR) LEN(4)        
0071.00              DCL        VAR(&IGCEXNCHR) TYPE(*CHAR) LEN(4)     
0072.00              DCL        VAR(&WAITFILE) TYPE(*CHAR) LEN(6)     
0073.00              DCL        VAR(&SHARE) TYPE(*CHAR) LEN(4)        
0074.00              DCL        VAR(&LVLCHK) TYPE(*CHAR) LEN(4)       
0075.00              DCL        VAR(&DEV) TYPE(*CHAR) LEN(10)         
0076.00              DCL        VAR(&SPOOL) TYPE(*CHAR) LEN(4)        
0077.00              DCL        VAR(&FOLD) TYPE(*CHAR) LEN(4)         
0078.00              DCL        VAR(&RPLUNPRT) TYPE(*CHAR) LEN(4)     
0079.00              DCL        VAR(&RPLUNPRTC) TYPE(*CHAR) LEN(2)    
0080.00              DCL        VAR(&RPLCHAR) TYPE(*CHAR) LEN(1)      
0081.00              DCL        VAR(&CPI) TYPE(*DEC) LEN(3 1)         
0082.00              DCL        VAR(&LPI) TYPE(*DEC) LEN(3 1)         
0083.00              DCL        VAR(&ALIGN) TYPE(*CHAR) LEN(4)        
0084.00              DCL        VAR(&DEVTYPE) TYPE(*CHAR) LEN(10)     
0085.00              DCL        VAR(&PAGLEN) TYPE(*DEC) LEN(3 0)      
0086.00              DCL        VAR(&PAGWTH) TYPE(*DEC) LEN(3 0)      
0087.00              DCL        VAR(&OVERFLOW) TYPE(*DEC) LEN(3 0)    
0088.00              DCL        VAR(&PAGRTT) TYPE(*CHAR) LEN(5)       
0089.00              DCL        VAR(&PRTTXT) TYPE(*CHAR) LEN(30)      
0090.00              DCL        VAR(&JUSTIFY) TYPE(*CHAR) LEN(3)      
0091.00              DCL        VAR(&PAGRTT) TYPE(*CHAR) LEN(5)       
0092.00              DCL        VAR(&PRTTXT) TYPE(*CHAR) LEN(30)      
0093.00              DCL        VAR(&JUSTIFY) TYPE(*CHAR) LEN(3)      
0094.00              DCL        VAR(&CTLCHAR) TYPE(*CHAR) LEN(5)      
0095.00              DCL        VAR(&PRTQLTY) TYPE(*CHAR) LEN(6)      
0096.00              DCL        VAR(&FORMFEED) TYPE(*CHAR) LEN(8)      
0097.00              DCL        VAR(&FORMTYPE) TYPE(*CHAR) LEN(10)     
0098.00              DCL        VAR(&COPIES) TYPE(*DEC) LEN(4 0)       
0099.00              DCL        VAR(&HOLD) TYPE(*CHAR) LEN(4)          
0100.00              DCL        VAR(&SAVE) TYPE(*CHAR) LEN(4)          
0101.00              DCL        VAR(&USRDTA) TYPE(*CHAR) LEN(10)       
0102.00              DCL        VAR(&DRAWER) TYPE(*CHAR) LEN(8)        
0103.00              DCL        VAR(&FONT) TYPE(*CHAR) LEN(10)         
0104.00              DCL        VAR(&GRPCHRSET) TYPE(*CHAR) LEN(10)    
0105.00              DCL        VAR(&CODEPAGE) TYPE(*CHAR) LEN(10)     
0106.00              DCL        VAR(&DUPLEX) TYPE(*CHAR) LEN(7)        
0107.00              DCL        VAR(&MULTIUP) TYPE(*DEC) LEN(2 0)      
0108.00              DCL        VAR(&UOM) TYPE(*CHAR) LEN(5)           
0109.00              DCL        VAR(&DECFMT) TYPE(*CHAR) LEN(5)        
0110.00              DCL        VAR(&REDUCE) TYPE(*CHAR) LEN(5)        
0111.00              DCL        VAR(&TBLREFCHR) TYPE(*CHAR) LEN(4)     
0112.00              DCL        VAR(&CCSID) TYPE(*DEC) LEN(5 0)        
0113.00              DCL        VAR(&TEXT) TYPE(*CHAR) LEN(50)         
0114.00      /*( RTVDSPF  用の変数 )*/                                 
0115.00              DCL        VAR(&DSPF) TYPE(*CHAR) LEN(10)         
0116.00              DCL        VAR(&DSPFLIB) TYPE(*CHAR) LEN(10)      
0117.00              DCL        VAR(&DSPFFLIB) TYPE(*CHAR) LEN(20)     
0118.00              DCL        VAR(&RTNLIB) TYPE(*CHAR) LEN(10)       
0119.00              DCL        VAR(&USRDFN) TYPE(*CHAR) LEN(10)       
0120.00              DCL        VAR(&IGCDTA) TYPE(*CHAR) LEN(4)              
0121.00              DCL        VAR(&IGCEXNCHR) TYPE(*CHAR) LEN(4)           
0122.00              DCL        VAR(&EHNDSP) TYPE(*CHAR) LEN(4)              
0123.00              DCL        VAR(&RSTDSP) TYPE(*CHAR) LEN(4)              
0124.00              DCL        VAR(&DFRWRT) TYPE(*CHAR) LEN(4)              
0125.00              DCL        VAR(&DECFMT) TYPE(*CHAR) LEN(5)              
0126.00              DCL        VAR(&SFLEND) TYPE(*CHAR) LEN(5)              
0127.00              DCL        VAR(&WAITFILE) TYPE(*CHAR) LEN(6)            
0128.00              DCL        VAR(&WAITRCD) TYPE(*CHAR) LEN(6)             
0129.00              DCL        VAR(&DTAQQLIB) TYPE(*CHAR) LEN(20)           
0130.00              DCL        VAR(&DTAQ) TYPE(*CHAR) LEN(10)               
0131.00              DCL        VAR(&DTAQLIB) TYPE(*CHAR) LEN(10)            
0132.00              DCL        VAR(&SHARE) TYPE(*CHAR) LEN(4)               
0133.00              DCL        VAR(&LANGID) TYPE(*CHAR) LEN(10)             
0134.00              DCL        VAR(&LVLCHK) TYPE(*CHAR) LEN(4)              
0135.00              DCL        VAR(&AUT) TYPE(*CHAR) LEN(10)                
0136.00              MONMSG     MSGID(CPF0000 RNS0000 CZM0000) EXEC(GOTO +   
0137.00                           CMDLBL(ERROR))                             
0138.00                                                                      
0139.00 /*( 環境の取得 )*/                                                   
0140.00              RTVJOBA    TYPE(&TYPE)                                  
0141.00              IF         COND(&TYPE *EQ '0') THEN(DO) /*  バッチ  */  
0142.00              CHGVAR     VAR(&TOPGMQ) VALUE('*SYSOPR   ')             
0143.00              ENDDO      /*  バッチ  */                               
0144.00              ELSE       CMD(DO) /*  対話式  */                      
0145.00              CHGVAR     VAR(&TOPGMQ) VALUE('*TOPGMQ   ')            
0146.00              ENDDO      /*  対話式  */                              
0147.00                                                                     
0148.00 /*( SEU で作成されたユーザー空間の検索 )*/                          
0149.00              CHKOBJ     OBJ(QTEMP/QSUSPC) OBJTYPE(*USRSPC)          
0150.00              MONMSG     MSGID(CPF9800) EXEC(DO)                     
0151.00              RTVDTAARA  DTAARA(*LDA (432 10)) RTNVAR(&OBJECT)       
0152.00              RTVDTAARA  DTAARA(*LDA (01 10)) RTNVAR(&SRCF)          
0153.00              RTVDTAARA  DTAARA(*LDA (11 10)) RTNVAR(&SRCFLIB)       
0154.00              RTVDTAARA  DTAARA(*LDA (21 10)) RTNVAR(&SRCMBR)        
0155.00              RTVDTAARA  DTAARA(*LDA (31 10)) RTNVAR(&SRCTYP)        
0156.00              GOTO       GETPARM                                     
0157.00              ENDDO                                                  
0158.00              CALL       PGM(QUSRTVUS) PARM('QSUSPC    QTEMP     ' + 
0159.00                           &STRPOS &LENDTA &RCVDTA)                  
0160.00              CHGVAR     VAR(&RCDL) VALUE(%SST(&RCVDTA 1 4))         
0161.00              CHGVAR     VAR(&RCDLEN) VALUE(%BIN(&RCDL))             
0162.00              CHGVAR     VAR(&SRCMBR) VALUE(%SST(&RCVDTA 21 10))     
0163.00              CHGVAR     VAR(&SRCF) VALUE(%SST(&RCVDTA 31 10))       
0164.00              CHGVAR     VAR(&SRCFLIB) VALUE(%SST(&RCVDTA 41 10))    
0165.00              CHGVAR     VAR(&SRCTYP) VALUE(%SST(&RCVDTA 51 10))     
0166.00                                                                     
0167.00 /*( パラメータの取得 )*/                                            
0168.00  GETPARM:    RTVDTAARA  DTAARA(*LDA (41 10)) RTNVAR(&OBJLIB)          
0169.00              RTVDTAARA  DTAARA(*LDA (51 10)) RTNVAR(&COMPILE)         
0170.00              RTVDTAARA  DTAARA(*LDA (61 202)) RTNVAR(&BNDSRVPGM)      
0171.00              RTVDTAARA  DTAARA(*LDA (263 80)) RTNVAR(&DEFINE)         
0172.00              RTVDTAARA  DTAARA(*LDA (342 10)) RTNVAR(&ACTGRP)         
0173.00              RTVDTAARA  DTAARA(*LDA (352 10)) RTNVAR(&OBJTYP)         
0174.00              RTVDTAARA  DTAARA(*LDA (422 10)) RTNVAR(&USRDFN)         
0175.00              RTVDTAARA  DTAARA(*LDA (432 10)) RTNVAR(&OBJECT)         
0176.00              CHGVAR     VAR(&BIN2) VALUE(%SST(&BNDSRVPGM 1 2))        
0177.00              CHGVAR     VAR(&SRVSU) VALUE(%BIN(&BIN2))                
0178.00              CHGVAR     VAR(&SRV_01) VALUE(%SST(&BNDSRVPGM 3 10))     
0179.00              CHGVAR     VAR(&LIB_01) VALUE(%SST(&BNDSRVPGM 13 10))    
0180.00              CHGVAR     VAR(&SRV_02) VALUE(%SST(&BNDSRVPGM 23 10))    
0181.00              CHGVAR     VAR(&LIB_02) VALUE(%SST(&BNDSRVPGM 33 10))    
0182.00              CHGVAR     VAR(&SRV_03) VALUE(%SST(&BNDSRVPGM 43 10))    
0183.00              CHGVAR     VAR(&LIB_03) VALUE(%SST(&BNDSRVPGM 53 10))    
0184.00              CHGVAR     VAR(&SRV_04) VALUE(%SST(&BNDSRVPGM 63 10))    
0185.00              CHGVAR     VAR(&LIB_04) VALUE(%SST(&BNDSRVPGM 73 10))    
0186.00              CHGVAR     VAR(&SRV_05) VALUE(%SST(&BNDSRVPGM 83 10))    
0187.00              CHGVAR     VAR(&LIB_05) VALUE(%SST(&BNDSRVPGM 93 10))    
0188.00              CHGVAR     VAR(&SRV_06) VALUE(%SST(&BNDSRVPGM 103 10))   
0189.00              CHGVAR     VAR(&LIB_06) VALUE(%SST(&BNDSRVPGM 113 10))   
0190.00              CHGVAR     VAR(&SRV_07) VALUE(%SST(&BNDSRVPGM 123 10))   
0191.00              CHGVAR     VAR(&LIB_07) VALUE(%SST(&BNDSRVPGM 133 10))   
0192.00              CHGVAR     VAR(&SRV_08) VALUE(%SST(&BNDSRVPGM 143 10))   
0193.00              CHGVAR     VAR(&LIB_08) VALUE(%SST(&BNDSRVPGM 153 10))   
0194.00              CHGVAR     VAR(&SRV_09) VALUE(%SST(&BNDSRVPGM 163 10))   
0195.00              CHGVAR     VAR(&LIB_09) VALUE(%SST(&BNDSRVPGM 173 10))   
0196.00              CHGVAR     VAR(&SRV_10) VALUE(%SST(&BNDSRVPGM 183 10))   
0197.00              CHGVAR     VAR(&LIB_10) VALUE(%SST(&BNDSRVPGM 193 10))   
0198.00                                                                       
0199.00              IF         COND(&SRCTYP *EQ '          ') THEN(DO)       
0200.00              CHGVAR     VAR(&MSG) +                                   
0201.00                           VALUE(' このソースにはソース・タイプがない +
0202.00                            のでコンパイルできません。 ')              
0203.00              GOTO       SNDMSG                                        
0204.00              ENDDO                                                    
0205.00 /*( コンパイラーの指定 )*/                                            
0206.00        /*( RPG )*/                                                    
0207.00              IF         COND(&SRCTYP *EQ 'RPGLE     ') THEN(DO)       
0208.00              IF         COND(&SRVSU *EQ 0) THEN(DO)                   
0209.00              CHGVAR     VAR(&COMPILE) VALUE('CRTBNDRPG ')             
0210.00              ENDDO                                                    
0211.00              ELSE       CMD(DO)                                       
0212.00              CHGVAR     VAR(&COMPILE) VALUE('CRTRPGMOD ')             
0213.00              ENDDO                                                    
0214.00              ENDDO                                                    
0215.00        /*( CLE )*/                                                    
0216.00              IF         COND((&SRCTYP *EQ 'C         ') *OR (&SRCTYP +   
0217.00                           *EQ 'CLE       ')) THEN(DO)                    
0218.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO) /* +     
0219.00                           PGM */                                         
0220.00              IF         COND(&SRVSU *EQ 0) THEN(DO)                      
0221.00              CHGVAR     VAR(&COMPILE) VALUE('CRTBNDC   ')                
0222.00              ENDDO                                                       
0223.00              ELSE       CMD(DO)                                          
0224.00              CHGVAR     VAR(&COMPILE) VALUE('CRTCMOD   ')                
0225.00              ENDDO                                                       
0226.00              ENDDO      /* PGM */                                        
0227.00              ELSE       CMD(IF COND(&OBJTYP *EQ '*SRVPGM   ') +          
0228.00                           THEN(DO)) /* *SRVPGM */                        
0229.00              CHGVAR     VAR(&COMPILE) VALUE('CRTCMOD   ')                
0230.00              ENDDO      /* *SRVPGM */                                    
0231.00              ENDDO                                                       
0232.00        /*( PRTF )*/                                                      
0233.00              IF         COND(&SRCTYP *EQ 'PRTF      ') THEN(DO)          
0234.00              CHGVAR     VAR(&PRTF) VALUE(&OBJECT)                        
0235.00              QUATTRO/RTVPRTFA PRTF(&OBJLIB/&PRTF) RTNLIB(&PRTFLIB) +     
0236.00                           IGCDTA(&IGCDTA) IGCEXNCHR(&IGCEXNCHR) +        
0237.00                           WAITFILE(&WAITFILE) SHARE(&SHARE) +            
0238.00                           LVLCHK(&LVLCHK) DEV(&DEV) SPOOL(&SPOOL) +      
0239.00                           FOLD(&FOLD) RPLUNPRT(&RPLUNPRT) +              
0240.00                           RPLUNPRTC(&RPLUNPRTC) CPI(&CPI) LPI(&LPI) +   
0241.00                           ALIGN(&ALIGN) DEVTYPE(&DEVTYPE) +             
0242.00                           PAGLEN(&PAGLEN) PAGWTH(&PAGWTH) +             
0243.00                           OVERFLOW(&OVERFLOW) PAGRTT(&PAGRTT) +         
0244.00                           PRTTXT(&PRTTXT) JUSTIFY(&JUSTIFY) +           
0245.00                           CTLCHAR(&CTLCHAR) PRTQLTY(&PRTQLTY) +         
0246.00                           FORMFEED(&FORMFEED) FORMTYPE(&FORMTYPE) +     
0247.00                           COPIES(&COPIES) DRAWER(&DRAWER) +             
0248.00                           FONT(&FONT) HOLD(&HOLD) SAVE(&SAVE) +         
0249.00                           USRDTA(&USRDTA) GRPCHRSET(&GRPCHRSET) +       
0250.00                           CODEPAGE(&CODEPAGE) DUPLEX(&DUPLEX) +         
0251.00                           MULTIUP(&MULTIUP) UOM(&UOM) +                 
0252.00                           DECFMT(&DECFMT) REDUCE(&REDUCE) +             
0253.00                           TBLREFCHR(&TBLREFCHR) CCSID(&CCSID) +         
0254.00                           TEXT(&TEXT)                                   
0255.00              IF         COND(&RPLUNPRTC *EQ '40') THEN(CHGVAR +         
0256.00                           VAR(&RPLCHAR) VALUE(' '))                     
0257.00              IF         COND(&USRDFN *EQ 'CRTEXPRTF ') THEN(DO)         
0258.00              CHGVAR     VAR(&COMPILE) VALUE('CRTEXPRTF ')               
0259.00              ENDDO                                                      
0260.00              ELSE       CMD(DO)                                         
0261.00              CHGVAR     VAR(&COMPILE) VALUE('CRTPRTF   ')               
0262.00              ENDDO                                                      
0263.00              ENDDO                                                      
0264.00        /*( DSPF )*/                                                    
0265.00              IF         COND(&SRCTYP *EQ 'DSPF      ') THEN(DO)        
0266.00              CHGVAR     VAR(&DSPF) VALUE(&OBJECT)                      
0267.00              RTVDSPF    DSPF(&OBJLIB/&DSPF) RTNLIB(&DSPFLIB) +         
0268.00                           USRDFN(&USRDFN) IGCDTA(&IGCDTA) +            
0269.00                           IGCEXNCHR(&IGCEXNCHR) TEXT(&TEXT) +          
0270.00                           EHNDSP(&EHNDSP) RSTDSP(&RSTDSP) +            
0271.00                           DFRWRT(&DFRWRT) DECFMT(&DECFMT) +            
0272.00                           SFLEND(&SFLEND) WAITFILE(&WAITFILE) +        
0273.00                           WAITRCD(&WAITRCD) DTAQ(&DTAQ) +              
0274.00                           DTAQLIB(&DTAQLIB) SHARE(&SHARE) +            
0275.00                           LANGID(&LANGID) LVLCHK(&LVLCHK) AUT(&AUT)    
0276.00              IF         COND(&USRDFN *EQ 'CRTEXDSPF ') THEN(DO)        
0277.00              CHGVAR     VAR(&COMPILE) VALUE('CRTEXDSPF ')              
0278.00              ENDDO                                                     
0279.00              ELSE       CMD(DO)                                        
0280.00              CHGVAR     VAR(&COMPILE) VALUE('CRTDSPF   ')              
0281.00              ENDDO                                                     
0282.00              ENDDO                                                     
0283.00                                                                        
0284.00 /*( コンパイル・コマンドの指定 )*/                                     
0285.00   /*( CRTBNDC )*/                                                      
0286.00              IF         COND(&COMPILE *EQ 'CRTBNDC   ') THEN(DO) /* +  
0287.00                           BND-C */                                     
0288.00              RMVMSG     PGMQ(*ALLINACT) CLEAR(*ALL)                   
0289.00              ?          CRTBNDC PGM(&OBJLIB/&OBJECT) +                
0290.00                           SRCFILE(&SRCFLIB/&SRCF) SRCMBR(&SRCMBR) +   
0291.00                           AUT(*ALL)                                   
0292.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))       
0293.00              ENDDO                                                    
0294.00   /*( CRTCMOD )*/                                                     
0295.00              IF         COND(&COMPILE *EQ 'CRTCMOD   ') THEN(DO) /* + 
0296.00                           BND-C */                                    
0297.00              RMVMSG     PGMQ(*ALLINACT) CLEAR(*ALL)                   
0298.00              ?          CRTCMOD MODULE(QTEMP/&SRCMBR) +               
0299.00                           SRCFILE(&SRCFLIB/&SRCF) SRCMBR(&SRCMBR) +   
0300.00                           OPTIMIZE(30) DBGVIEW(*SOURCE) +             
0301.00                           DEFINE(&DEFINE) AUT(*ALL)                   
0302.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))       
0303.00              IF         COND(&SRVSU *EQ 0) THEN(DO)                   
0304.00              IF         COND(&OBJTYP *EQ '*SRVPGM   ') THEN(DO)       
0305.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +           
0306.00                           MODULE(QTEMP/&SRCMBR) +                     
0307.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) + 
0308.00                           ACTGRP(&ACTGRP) AUT(*ALL)                   
0309.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))       
0310.00              ENDDO                                                    
0311.00              ENDDO                                                    
0312.00              IF         COND(&SRVSU *EQ 1) THEN(DO)                        
0313.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)            
0314.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                      
0315.00                           MODULE(QTEMP/&SRCMBR) +                          
0316.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED)) +            
0317.00                           ACTGRP(&ACTGRP) AUT(*ALL)                        
0318.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))            
0319.00              ENDDO                                                         
0320.00              ELSE       CMD(DO)                                            
0321.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +                
0322.00                           MODULE(QTEMP/&SRCMBR) +                          
0323.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +      
0324.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED)) +            
0325.00                           ACTGRP(&ACTGRP) AUT(*ALL)                        
0326.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))            
0327.00              ENDDO                                                         
0328.00              ENDDO                                                         
0329.00              IF         COND(&SRVSU *EQ 2) THEN(DO)                        
0330.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)            
0331.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                      
0332.00                           MODULE(QTEMP/&SRCMBR) +                          
0333.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +             
0334.00                           (&LIB_02/&SRV_02 *IMMED)) ACTGRP(&ACTGRP) +      
0335.00                           AUT(*ALL)                                        
0336.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))        
0337.00              ENDDO                                                     
0338.00              ELSE       CMD(DO)                                        
0339.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +            
0340.00                           MODULE(QTEMP/&SRCMBR) +                      
0341.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +  
0342.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +         
0343.00                           (&LIB_02/&SRV_02 *IMMED)) ACTGRP(&ACTGRP) +  
0344.00                           AUT(*ALL)                                    
0345.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))        
0346.00              ENDDO                                                     
0347.00              ENDDO                                                     
0348.00              IF         COND(&SRVSU *EQ 3) THEN(DO)                    
0349.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)        
0350.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                  
0351.00                           MODULE(QTEMP/&SRCMBR) +                      
0352.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +         
0353.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +  
0354.00                           *IMMED)) ACTGRP(&ACTGRP) AUT(*ALL)           
0355.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))        
0356.00              ENDDO                                                     
0357.00              ELSE       CMD(DO)                                        
0358.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +            
0359.00                           MODULE(QTEMP/&SRCMBR) +                      
0360.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +    
0361.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +           
0362.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +    
0363.00                           *IMMED)) ACTGRP(&ACTGRP) AUT(*ALL)             
0364.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))          
0365.00              ENDDO                                                       
0366.00              ENDDO                                                       
0367.00              IF         COND(&SRVSU *EQ 4) THEN(DO)                      
0368.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)          
0369.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                    
0370.00                           MODULE(QTEMP/&SRCMBR) +                        
0371.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +           
0372.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +    
0373.00                           *IMMED) (&LIB_04/&SRV_04 *IMMED)) +            
0374.00                           ACTGRP(&ACTGRP) AUT(*ALL)                      
0375.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))          
0376.00              ENDDO                                                       
0377.00              ELSE       CMD(DO)                                          
0378.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +              
0379.00                           MODULE(QTEMP/&SRCMBR) +                        
0380.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +    
0381.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +           
0382.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +    
0383.00                           *IMMED) (&LIB_04/&SRV_04 *IMMED)) +            
0384.00                           ACTGRP(&ACTGRP) AUT(*ALL)                       
0385.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))           
0386.00              ENDDO                                                        
0387.00              ENDDO                                                        
0388.00              IF         COND(&SRVSU *EQ 5) THEN(DO)                       
0389.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)           
0390.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                     
0391.00                           MODULE(QTEMP/&SRCMBR) +                         
0392.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +            
0393.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +     
0394.00                           *IMMED) (&LIB_04/&SRV_04 *IMMED) +              
0395.00                           (&LIB_05/&SRV_05 *IMMED)) ACTGRP(&ACTGRP) +     
0396.00                           AUT(*ALL)                                       
0397.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))           
0398.00              ENDDO                                                        
0399.00              ELSE       CMD(DO)                                           
0400.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +               
0401.00                           MODULE(QTEMP/&SRCMBR) +                         
0402.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +     
0403.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +            
0404.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +     
0405.00                           *IMMED) (&LIB_04/&SRV_04 *IMMED) +              
0406.00                           (&LIB_05/&SRV_05 *IMMED)) ACTGRP(&ACTGRP) +     
0407.00                           AUT(*ALL)                                       
0408.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))        
0409.00              ENDDO                                                     
0410.00              ENDDO                                                     
0411.00              IF         COND(&SRVSU *EQ 6) THEN(DO)                    
0412.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)        
0413.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                  
0414.00                           MODULE(QTEMP/&SRCMBR) +                      
0415.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +         
0416.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +  
0417.00                           *IMMED) (&LIB_04/&SRV_04 *IMMED) +           
0418.00                           (&LIB_05/&SRV_05 *IMMED) (&LIB_06/&SRV_06 +  
0419.00                           *IMMED)) ACTGRP(&ACTGRP) AUT(*ALL)           
0420.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))        
0421.00              ENDDO                                                     
0422.00              ELSE       CMD(DO)                                        
0423.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +            
0424.00                           MODULE(QTEMP/&SRCMBR) +                      
0425.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +  
0426.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +         
0427.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +  
0428.00                           *IMMED) (&LIB_04/&SRV_04 *IMMED) +           
0429.00                           (&LIB_05/&SRV_05 *IMMED) (&LIB_06/&SRV_06 +  
0430.00                           *IMMED)) ACTGRP(&ACTGRP) AUT(*ALL)           
0431.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))        
0432.00              ENDDO                                                       
0433.00              ENDDO                                                       
0434.00              IF         COND(&SRVSU *EQ 7) THEN(DO)                      
0435.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)          
0436.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                    
0437.00                           MODULE(QTEMP/&SRCMBR) +                        
0438.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +           
0439.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +    
0440.00                           *IMMED) (&LIB_04/&SRV_04 *IMMED) +             
0441.00                           (&LIB_05/&SRV_05 *IMMED) (&LIB_06/&SRV_06 +    
0442.00                           *IMMED) (&LIB_07/&SRV_07 *IMMED)) +            
0443.00                           ACTGRP(&ACTGRP) AUT(*ALL)                      
0444.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))          
0445.00              ENDDO                                                       
0446.00              ELSE       CMD(DO)                                          
0447.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +              
0448.00                           MODULE(QTEMP/&SRCMBR) +                        
0449.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +    
0450.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +           
0451.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +    
0452.00                           *IMMED) (&LIB_04/&SRV_04 *IMMED) +             
0453.00                           (&LIB_05/&SRV_05 *IMMED) (&LIB_06/&SRV_06 +    
0454.00                           *IMMED) (&LIB_07/&SRV_07 *IMMED)) +            
0455.00                           ACTGRP(&ACTGRP) AUT(*ALL)                      
0456.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))         
0457.00              ENDDO                                                      
0458.00              ENDDO                                                      
0459.00              IF         COND(&SRVSU *EQ 8) THEN(DO)                     
0460.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)         
0461.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                   
0462.00                           MODULE(QTEMP/&SRCMBR) +                       
0463.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +          
0464.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +   
0465.00                           *IMMED) (&LIB_04/&SRV_04 *IMMED) +            
0466.00                           (&LIB_05/&SRV_05 *IMMED) (&LIB_06/&SRV_06 +   
0467.00                           *IMMED) (&LIB_07/&SRV_07 *IMMED) +            
0468.00                           (&LIB_08/&SRV_08 *IMMED)) ACTGRP(&ACTGRP) +   
0469.00                           AUT(*ALL)                                     
0470.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))         
0471.00              ENDDO                                                      
0472.00              ELSE       CMD(DO)                                         
0473.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +             
0474.00                           MODULE(QTEMP/&SRCMBR) +                       
0475.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +   
0476.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +          
0477.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +   
0478.00                           *IMMED) (&LIB_04/&SRV_04 *IMMED) +            
0479.00                           (&LIB_05/&SRV_05 *IMMED) (&LIB_06/&SRV_06 +   
0480.00                           *IMMED) (&LIB_07/&SRV_07 *IMMED) +              
0481.00                           (&LIB_08/&SRV_08 *IMMED)) ACTGRP(&ACTGRP) +     
0482.00                           AUT(*ALL)                                       
0483.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))           
0484.00              ENDDO                                                        
0485.00              ENDDO                                                        
0486.00              IF         COND(&SRVSU *EQ 9) THEN(DO)                       
0487.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)           
0488.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                     
0489.00                           MODULE(QTEMP/&SRCMBR) +                         
0490.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +            
0491.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +     
0492.00                           *IMMED) (&LIB_04/&SRV_04 *IMMED) +              
0493.00                           (&LIB_05/&SRV_05 *IMMED) (&LIB_06/&SRV_06 +     
0494.00                           *IMMED) (&LIB_07/&SRV_07 *IMMED) +              
0495.00                           (&LIB_08/&SRV_08 *IMMED) (&LIB_09/&SRV_09 +     
0496.00                           *IMMED)) ACTGRP(&ACTGRP) AUT(*ALL)              
0497.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))           
0498.00              ENDDO                                                        
0499.00              ELSE       CMD(DO)                                           
0500.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +               
0501.00                           MODULE(QTEMP/&SRCMBR) +                         
0502.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +     
0503.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +            
0504.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +      
0505.00                           *IMMED) (&LIB_04/&SRV_04 *IMMED) +               
0506.00                           (&LIB_05/&SRV_05 *IMMED) (&LIB_06/&SRV_06 +      
0507.00                           *IMMED) (&LIB_07/&SRV_07 *IMMED) +               
0508.00                           (&LIB_08/&SRV_08 *IMMED) (&LIB_09/&SRV_09 +      
0509.00                           *IMMED)) ACTGRP(&ACTGRP) AUT(*ALL)               
0510.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))            
0511.00              ENDDO                                                         
0512.00              ENDDO                                                         
0513.00              IF         COND(&SRVSU *EQ 10) THEN(DO)                       
0514.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)            
0515.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                      
0516.00                           MODULE(QTEMP/&SRCMBR) +                          
0517.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +             
0518.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +      
0519.00                           *IMMED) (&LIB_04/&SRV_04 *IMMED) +               
0520.00                           (&LIB_05/&SRV_05 *IMMED) (&LIB_06/&SRV_06 +      
0521.00                           *IMMED) (&LIB_07/&SRV_07 *IMMED) +               
0522.00                           (&LIB_08/&SRV_08 *IMMED) (&LIB_09/&SRV_09 +      
0523.00                           *IMMED) (&LIB_10/&SRV_10 *IMMED)) +              
0524.00                           ACTGRP(&ACTGRP) AUT(*ALL)                        
0525.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))            
0526.00              ENDDO                                                         
0527.00              ELSE       CMD(DO)                                            
0528.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +            
0529.00                           MODULE(QTEMP/&SRCMBR) +                      
0530.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +  
0531.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +         
0532.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +  
0533.00                           *IMMED) (&LIB_04/&SRV_04 *IMMED) +           
0534.00                           (&LIB_05/&SRV_05 *IMMED) (&LIB_06/&SRV_06 +  
0535.00                           *IMMED) (&LIB_07/&SRV_07 *IMMED) +           
0536.00                           (&LIB_08/&SRV_08 *IMMED) (&LIB_09/&SRV_09 +  
0537.00                           *IMMED) (&LIB_10/&SRV_10 *IMMED)) +          
0538.00                           ACTGRP(&ACTGRP) AUT(*ALL)                    
0539.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))        
0540.00              ENDDO                                                     
0541.00              ENDDO                                                     
0542.00              ENDDO                                                     
0543.00   /*( CRTBNDRPG )*/                                                    
0544.00              IF         COND(&COMPILE *EQ 'CRTBNDRPG ') THEN(DO)       
0545.00              ?          CRTBNDRPG PGM(&OBJLIB/&OBJECT) +               
0546.00                           SRCFILE(&SRCFLIB/&SRCF) SRCMBR(&SRCMBR) +    
0547.00                           DFTACTGRP(*NO) ACTGRP(&ACTGRP) +             
0548.00                           DBGVIEW(*SOURCE) AUT(*ALL)                   
0549.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))        
0550.00              ENDDO                                                     
0551.00   /*( CRTRPGMOD )*/                                                    
0552.00              IF         COND(&COMPILE *EQ 'CRTRPGMOD ') THEN(DO)        
0553.00              ?          CRTRPGMOD MODULE(QTEMP/&SRCMBR) +               
0554.00                           SRCFILE(&SRCFLIB/&SRCF) SRCMBR(&SRCMBR) +     
0555.00                           DBGVIEW(*SOURCE) AUT(*ALL)                    
0556.00              MONMSG     MSGID(CPF6801) EXEC(RETURN)                     
0557.00              IF         COND(&SRVSU *EQ 1) THEN(DO)                     
0558.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)         
0559.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                   
0560.00                           MODULE(QTEMP/&SRCMBR) +                       
0561.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED)) +         
0562.00                           ACTGRP(&ACTGRP) AUT(*ALL)                     
0563.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))         
0564.00              ENDDO                                                      
0565.00              ELSE       CMD(DO)                                         
0566.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +             
0567.00                           MODULE(QTEMP/&SRCMBR) +                       
0568.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +   
0569.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED)) +         
0570.00                           ACTGRP(&ACTGRP) AUT(*ALL)                     
0571.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))         
0572.00              ENDDO                                                      
0573.00              ENDDO                                                      
0574.00              IF         COND(&SRVSU *EQ 2) THEN(DO)                     
0575.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)         
0576.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                    
0577.00                           MODULE(QTEMP/&SRCMBR) +                        
0578.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +           
0579.00                           (&LIB_02/&SRV_02 *IMMED)) ACTGRP(&ACTGRP) +    
0580.00                           AUT(*ALL)                                      
0581.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))          
0582.00              ENDDO                                                       
0583.00              ELSE       CMD(DO)                                          
0584.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +              
0585.00                           MODULE(QTEMP/&SRCMBR) +                        
0586.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +    
0587.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +           
0588.00                           (&LIB_02/&SRV_02 *IMMED)) ACTGRP(&ACTGRP) +    
0589.00                           AUT(*ALL)                                      
0590.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))          
0591.00              ENDDO                                                       
0592.00              ENDDO                                                       
0593.00              IF         COND(&SRVSU *EQ 3) THEN(DO)                      
0594.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)          
0595.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                    
0596.00                           MODULE(QTEMP/&SRCMBR) +                        
0597.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +           
0598.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +    
0599.00                           *IMMED)) ACTGRP(&ACTGRP) AUT(*ALL)             
0600.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))         
0601.00              ENDDO                                                      
0602.00              ELSE       CMD(DO)                                         
0603.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +             
0604.00                           MODULE(QTEMP/&SRCMBR) +                       
0605.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +   
0606.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +          
0607.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +   
0608.00                           *IMMED)) ACTGRP(&ACTGRP) AUT(*ALL)            
0609.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))         
0610.00              ENDDO                                                      
0611.00              ENDDO                                                      
0612.00              IF         COND(&SRVSU *EQ 4) THEN(DO)                     
0613.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)         
0614.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                   
0615.00                           MODULE(QTEMP/&SRCMBR) +                       
0616.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +          
0617.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +   
0618.00                           *IMMED) (&LIB_04/&SRV_04)) +                  
0619.00                           ACTGRP(&ACTGRP) AUT(*ALL)                     
0620.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))         
0621.00              ENDDO                                                      
0622.00              ELSE       CMD(DO)                                         
0623.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +             
0624.00                           MODULE(QTEMP/&SRCMBR) +                       
0625.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +   
0626.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +          
0627.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +   
0628.00                           *IMMED) (&LIB_04/&SRV_04)) +                  
0629.00                           ACTGRP(&ACTGRP) AUT(*ALL)                     
0630.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))         
0631.00              ENDDO                                                      
0632.00              ENDDO                                                      
0633.00              IF         COND(&SRVSU *EQ 5) THEN(DO)                     
0634.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)         
0635.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                   
0636.00                           MODULE(QTEMP/&SRCMBR) +                       
0637.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +          
0638.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +   
0639.00                           *IMMED) (&LIB_04/&SRV_04) +                   
0640.00                           (&LIB_05/&SRV_05)) ACTGRP(&ACTGRP) AUT(*ALL)  
0641.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))         
0642.00              ENDDO                                                      
0643.00              ELSE       CMD(DO)                                         
0644.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +             
0645.00                           MODULE(QTEMP/&SRCMBR) +                       
0646.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +   
0647.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +          
0648.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +     
0649.00                           *IMMED) (&LIB_04/&SRV_04) +                     
0650.00                           (&LIB_05/&SRV_05)) ACTGRP(&ACTGRP) AUT(*ALL)    
0651.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))           
0652.00              ENDDO                                                        
0653.00              ENDDO                                                        
0654.00              IF         COND(&SRVSU *EQ 6) THEN(DO)                       
0655.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)           
0656.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                     
0657.00                           MODULE(QTEMP/&SRCMBR) +                         
0658.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +            
0659.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +     
0660.00                           *IMMED) (&LIB_04/&SRV_04) +                     
0661.00                           (&LIB_05/&SRV_05) (&LIB_06/&SRV_06 +            
0662.00                           *IMMED)) ACTGRP(&ACTGRP) AUT(*ALL)              
0663.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))           
0664.00              ENDDO                                                        
0665.00              ELSE       CMD(DO)                                           
0666.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +               
0667.00                           MODULE(QTEMP/&SRCMBR) +                         
0668.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +     
0669.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +            
0670.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +     
0671.00                           *IMMED) (&LIB_04/&SRV_04) +                     
0672.00                           (&LIB_05/&SRV_05) (&LIB_06/&SRV_06 +         
0673.00                           *IMMED)) ACTGRP(&ACTGRP) AUT(*ALL)           
0674.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))        
0675.00              ENDDO                                                     
0676.00              ENDDO                                                     
0677.00              IF         COND(&SRVSU *EQ 7) THEN(DO)                    
0678.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)        
0679.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                  
0680.00                           MODULE(QTEMP/&SRCMBR) +                      
0681.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +         
0682.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +  
0683.00                           *IMMED) (&LIB_04/&SRV_04) +                  
0684.00                           (&LIB_05/&SRV_05) (&LIB_06/&SRV_06 +         
0685.00                           *IMMED) (&LIB_07/&SRV_07)) +                 
0686.00                           ACTGRP(&ACTGRP) AUT(*ALL)                    
0687.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))        
0688.00              ENDDO                                                     
0689.00              ELSE       CMD(DO)                                        
0690.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +            
0691.00                           MODULE(QTEMP/&SRCMBR) +                      
0692.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +  
0693.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +         
0694.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +  
0695.00                           *IMMED) (&LIB_04/&SRV_04) +                  
0696.00                           (&LIB_05/&SRV_05) (&LIB_06/&SRV_06 +         
0697.00                           *IMMED) (&LIB_07/&SRV_07)) +                 
0698.00                           ACTGRP(&ACTGRP) AUT(*ALL)                    
0699.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))        
0700.00              ENDDO                                                     
0701.00              ENDDO                                                     
0702.00              IF         COND(&SRVSU *EQ 8) THEN(DO)                    
0703.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)        
0704.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                  
0705.00                           MODULE(QTEMP/&SRCMBR) +                      
0706.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +         
0707.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +  
0708.00                           *IMMED) (&LIB_04/&SRV_04) +                  
0709.00                           (&LIB_05/&SRV_05) (&LIB_06/&SRV_06 +         
0710.00                           *IMMED) (&LIB_07/&SRV_07) +                  
0711.00                           (&LIB_08/&SRV_08 *IMMED)) ACTGRP(&ACTGRP) +  
0712.00                           AUT(*ALL)                                    
0713.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))        
0714.00              ENDDO                                                     
0715.00              ELSE       CMD(DO)                                        
0716.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +            
0717.00                           MODULE(QTEMP/&SRCMBR) +                      
0718.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +  
0719.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +         
0720.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +    
0721.00                           *IMMED) (&LIB_04/&SRV_04) +                    
0722.00                           (&LIB_05/&SRV_05) (&LIB_06/&SRV_06 +           
0723.00                           *IMMED) (&LIB_07/&SRV_07) +                    
0724.00                           (&LIB_08/&SRV_08 *IMMED)) ACTGRP(&ACTGRP) +    
0725.00                           AUT(*ALL)                                      
0726.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))          
0727.00              ENDDO                                                       
0728.00              ENDDO                                                       
0729.00              IF         COND(&SRVSU *EQ 9) THEN(DO)                      
0730.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)          
0731.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                    
0732.00                           MODULE(QTEMP/&SRCMBR) +                        
0733.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +           
0734.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +    
0735.00                           *IMMED) (&LIB_04/&SRV_04) +                    
0736.00                           (&LIB_05/&SRV_05) (&LIB_06/&SRV_06 +           
0737.00                           *IMMED) (&LIB_07/&SRV_07) +                    
0738.00                           (&LIB_08/&SRV_08 *IMMED) (&LIB_09/&SRV_09 +    
0739.00                           *IMMED)) ACTGRP(&ACTGRP) AUT(*ALL)             
0740.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))          
0741.00              ENDDO                                                       
0742.00              ELSE       CMD(DO)                                          
0743.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +              
0744.00                           MODULE(QTEMP/&SRCMBR) +                      
0745.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +  
0746.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +         
0747.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +  
0748.00                           *IMMED) (&LIB_04/&SRV_04) +                  
0749.00                           (&LIB_05/&SRV_05) (&LIB_06/&SRV_06 +         
0750.00                           *IMMED) (&LIB_07/&SRV_07) +                  
0751.00                           (&LIB_08/&SRV_08 *IMMED) (&LIB_09/&SRV_09 +  
0752.00                           *IMMED)) ACTGRP(&ACTGRP) AUT(*ALL)           
0753.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))        
0754.00              ENDDO                                                     
0755.00              ENDDO                                                     
0756.00              IF         COND(&SRVSU *EQ 10) THEN(DO)                   
0757.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO)        
0758.00              ?          CRTPGM PGM(&OBJLIB/&OBJECT) +                  
0759.00                           MODULE(QTEMP/&SRCMBR) +                      
0760.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +         
0761.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +  
0762.00                           *IMMED) (&LIB_04/&SRV_04) +                  
0763.00                           (&LIB_05/&SRV_05) (&LIB_06/&SRV_06 +         
0764.00                           *IMMED) (&LIB_07/&SRV_07) +                  
0765.00                           (&LIB_08/&SRV_08 *IMMED) (&LIB_09/&SRV_09 +  
0766.00                           *IMMED) (&LIB_10/&SRV_10)) +                 
0767.00                           ACTGRP(&ACTGRP) AUT(*ALL)                    
0768.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))         
0769.00              ENDDO                                                      
0770.00              ELSE       CMD(DO)                                         
0771.00              ?          CRTSRVPGM SRVPGM(&OBJLIB/&OBJECT) +             
0772.00                           MODULE(QTEMP/&SRCMBR) +                       
0773.00                           SRCFILE(&SRCFLIB/QSRVSRC) SRCMBR(&OBJECT) +   
0774.00                           BNDSRVPGM((&LIB_01/&SRV_01 *IMMED) +          
0775.00                           (&LIB_02/&SRV_02 *IMMED) (&LIB_03/&SRV_03 +   
0776.00                           *IMMED) (&LIB_04/&SRV_04) +                   
0777.00                           (&LIB_05/&SRV_05) (&LIB_06/&SRV_06 +          
0778.00                           *IMMED) (&LIB_07/&SRV_07) +                   
0779.00                           (&LIB_08/&SRV_08 *IMMED) (&LIB_09/&SRV_09 +   
0780.00                           *IMMED) (&LIB_10/&SRV_10)) +                  
0781.00                           ACTGRP(&ACTGRP) AUT(*ALL)                     
0782.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))         
0783.00              ENDDO                                                      
0784.00              ENDDO                                                      
0785.00              ENDDO                                                      
0786.00   /*( CRTPRTF   )*/                                                     
0787.00              IF         COND(&COMPILE *EQ 'CRTPRTF   ') THEN(DO)        
0788.00             ?CRTPRTF    FILE(&PRTFLIB/&PRTF) SRCFILE(&SRCFLIB/&SRCF) +  
0789.00                           SRCMBR(&SRCMBR) DEV(&DEV) +                   
0790.00                           DEVTYPE(&DEVTYPE) IGCDTA(&IGCDTA) +           
0791.00                           IGCEXNCHR(&IGCEXNCHR) TEXT(&TEXT) +           
0792.00                           PAGESIZE(&PAGLEN &PAGWTH) LPI(&LPI) +         
0793.00                           CPI(&CPI) OVRFLW(&OVERFLOW) FOLD(&FOLD) +     
0794.00                           RPLUNPRT(&RPLUNPRT &RPLCHAR) +                
0795.00                           ALIGN(&ALIGN) PRTQLTY(&PRTQLTY) +             
0796.00                           FORMFEED(&FORMFEED) DRAWER(&DRAWER) +         
0797.00                           FONT(&FONT) DECFMT(&DECFMT) +                 
0798.00                           REDUCE(&REDUCE) PRTTXT(&PRTTXT) +             
0799.00                           JUSTIFY(&JUSTIFY) DUPLEX(&DUPLEX) +           
0800.00                           UOM(&UOM) SPOOL(&SPOOL) +                     
0801.00                           FORMTYPE(&FORMTYPE) COPIES(&COPIES) +         
0802.00                           USRDTA(&USRDTA) LVLCHK(*NO) AUT(*ALL)         
0803.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))         
0804.00              ENDDO                                                      
0805.00   /*( CRTEXPRTF   )*/                                                   
0806.00              IF         COND(&COMPILE *EQ 'CRTEXPRTF ') THEN(DO)        
0807.00             ?CRTEXPRTF  FILE(&PRTFLIB/&PRTF) SRCFILE(&SRCFLIB/&SRCF) +  
0808.00                           SRCMBR(&SRCMBR) DEV(&DEV) +                   
0809.00                           DEVTYPE(&DEVTYPE) IGCDTA(&IGCDTA) +           
0810.00                           IGCEXNCHR(&IGCEXNCHR) TEXT(&TEXT) +           
0811.00                           PAGESIZE(&PAGLEN &PAGWTH) LPI(&LPI) +         
0812.00                           CPI(&CPI) OVRFLW(&OVERFLOW) FOLD(&FOLD) +     
0813.00                           RPLUNPRT(&RPLUNPRT &RPLCHAR) +                
0814.00                           ALIGN(&ALIGN) PRTQLTY(&PRTQLTY) +             
0815.00                           FORMFEED(&FORMFEED) DRAWER(&DRAWER) +         
0816.00                           FONT(&FONT) DECFMT(&DECFMT) +                  
0817.00                           REDUCE(&REDUCE) PRTTXT(&PRTTXT) +              
0818.00                           JUSTIFY(&JUSTIFY) DUPLEX(&DUPLEX) +            
0819.00                           UOM(&UOM) SPOOL(&SPOOL) +                      
0820.00                           FORMTYPE(&FORMTYPE) COPIES(&COPIES) +          
0821.00                           USRDTA(&USRDTA) LVLCHK(*NO) AUT(*ALL)          
0822.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))          
0823.00              ENDDO                                                       
0824.00   /*( CRTDSPF   )*/                                                      
0825.00              IF         COND(&COMPILE *EQ 'CRTDSPF   ') THEN(DO)         
0826.00             ?CRTDSPF    FILE(&DSPFLIB/&DSPF) SRCFILE(&SRCFLIB/&SRCF) +   
0827.00                           SRCMBR(&SRCMBR) IGCDTA(&IGCDTA) +              
0828.00                           IGCEXNCHR(&IGCEXNCHR) TEXT(&TEXT) +            
0829.00                           ENHDSP(&EHNDSP) RSTDSP(&RSTDSP) +              
0830.00                           DFRWRT(&DFRWRT) DECFMT(&DECFMT) +              
0831.00                           SFLENDTXT(&SFLEND) WAITFILE(&WAITFILE) +       
0832.00                           WAITRCD(&WAITRCD) DTAQ(&DTAQ) +                
0833.00                           SHARE(&SHARE) LANGID(&LANGID) +                
0834.00                           LVLCHK(&LVLCHK) AUT(&AUT)                      
0835.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))          
0836.00              ENDDO                                                       
0837.00   /*( CRTEXDSPF   )*/                                                    
0838.00              IF         COND(&COMPILE *EQ 'CRTEXDSPF ') THEN(DO)         
0839.00              ?CRTEXDSPF FILE(&DSPFLIB/&DSPF) +                           
0840.00                           SRCFILE(&SRCFLIB/&SRCF) SRCMBR(&SRCMBR) +        
0841.00                           IGCDTA(&IGCDTA) IGCEXNCHR(&IGCEXNCHR) +          
0842.00                           TEXT(&TEXT) ENHDSP(&EHNDSP) +                    
0843.00                           RSTDSP(&RSTDSP) DFRWRT(&DFRWRT) +                
0844.00                           DECFMT(&DECFMT) SFLENDTXT(&SFLEND) +             
0845.00                           WAITFILE(&WAITFILE) WAITRCD(&WAITRCD) +          
0846.00                           DTAQ(&DTAQ) SHARE(&SHARE) +                      
0847.00                           LANGID(&LANGID) LVLCHK(&LVLCHK) AUT(&AUT)        
0848.00              MONMSG     MSGID(CPF6801) EXEC(GOTO CMDLBL(ERROR))            
0849.00              ENDDO                                                         
0850.00                                                                            
0851.00              CHGVAR     VAR(&MSGTYPE) VALUE('*INFO     ')                  
0852.00              GOTO       ERROR                                              
0853.00              RETURN                                                        
0854.00                                                                            
0855.00 NXTRTV:                                                                    
0856.00              RETURN                                                        
0857.00                                                                            
0858.00              IF         COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)        
0859.00              SNDPGMMSG  +                                                  
0860.00                           MSG('API: QUHDSPH の実行で次のエラーが発生 +     
0861.00                            しました。 ') MSGTYPE(*DIAG)                    
0862.00              GOTO       APIERR                                             
0863.00              ENDDO                                                         
0864.00              RETURN                                                      
0865.00                                                                          
0866.00  APIERR:                                                                 
0867.00              CHGVAR     VAR(&MSGID) VALUE(%SST(&APIERR 9 7))             
0868.00              CHGVAR     VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))         
0869.00              CHGVAR     VAR(&MSGF) VALUE('QCPFMSG   ')                   
0870.00              CHGVAR     VAR(&MSGFLIB) VALUE('QSYS      ')                
0871.00              GOTO       SNDMSG                                           
0872.00                                                                          
0873.00  ERROR:      RCVMSG     MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +              
0874.00                           MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +    
0875.00                           MSGFLIB(&MSGFLIB)                              
0876.00              IF         COND(&MSGFLIB *EQ '*LIBL     ') THEN(DO)         
0877.00              IF         COND((&MSGF *EQ 'QCPFMSG   ') *OR (&MSGF *EQ +   
0878.00                           'QCZCMDMSG ')) THEN(DO)                        
0879.00              CHGVAR     VAR(&MSGFLIB) VALUE('QSYS      ')                
0880.00              ENDDO                                                       
0881.00              ELSE       CMD(DO)                                          
0882.00              CHGVAR     VAR(&MSGFLIB) VALUE('QDEVTOOLS ')                
0883.00              ENDDO                                                       
0884.00              ENDDO                                                       
0885.00              IF         COND(&MSGTYPE *EQ '*ESCAPE   ') THEN(DO)         
0886.00              CHGVAR     VAR(&MSGTYPE) VALUE('*INFO     ')                
0887.00              IF         COND((&SRCTYP *EQ 'RPGLE     ') *OR (&SRCTYP +   
0888.00                           *EQ 'RPG       ')) THEN(DO)                      
0889.00              CHGVAR     VAR(&NXTJOB) VALUE('*RPGERR   ')                   
0890.00              ENDDO                                                         
0891.00              IF         COND((&SRCTYP *EQ 'C         ') *OR (&SRCTYP +     
0892.00                           *EQ '*CLE      ')) THEN(DO)                      
0893.00              CHGVAR     VAR(&NXTJOB) VALUE('*CLEERR   ')                   
0894.00              ENDDO                                                         
0895.00              ENDDO                                                         
0896.00              CHGDTAARA  DTAARA(*LDA (362 10)) VALUE(&NXTJOB)               
0897.00              CHGDTAARA  DTAARA(*LDA (372 10)) VALUE('          ')          
0898.00  SNDMSG: /*( CZM1613: コンパイルに失敗しました。 QSYS/QCZCMDMSG)*/         
0899.00              IF         COND(&MSGID *EQ ' ') THEN(DO)                      
0900.00              CHGMSGD    MSGID(EDT0001) MSGF(QUATTRO/QEDTMSGF) MSG(&MSG)    
0901.00              SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +        
0902.00                           TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)                
0903.00              ENDDO                                                         
0904.00              ELSE       CMD(DO)                                            
0905.00              CHGMSGD    MSGID(EDT0001) MSGF(QUATTRO/QEDTMSGF) MSG(&MSG)    
0906.00              SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +               
0907.00                           MSGDTA(&MSGDTA) TOPGMQ(*SAME (*PGMNAME +         
0908.00                           *NONE QSUCPP)) TOMSGQ(&TOPGMQ) +                 
0909.00                           MSGTYPE(&MSGTYPE)                                
0910.00              ENDDO                                                         
0911.00              ENDPGM                                                        

【 解説 】

0148.00 /*( SEU で作成されたユーザー空間の検索 )*/                          
0149.00              CHKOBJ     OBJ(QTEMP/QSUSPC) OBJTYPE(*USRSPC) 
　　　　　　　　　　　:
0158.00              CALL       PGM(QUSRTVUS) PARM('QSUSPC    QTEMP     ' + 
0159.00                           &STRPOS &LENDTA &RCVDTA)                  
0160.00              CHGVAR     VAR(&RCDL) VALUE(%SST(&RCVDTA 1 4))         
0161.00              CHGVAR     VAR(&RCDLEN) VALUE(%BIN(&RCDL))             
0162.00              CHGVAR     VAR(&SRCMBR) VALUE(%SST(&RCVDTA 21 10))     
0163.00              CHGVAR     VAR(&SRCF) VALUE(%SST(&RCVDTA 31 10))       
0164.00              CHGVAR     VAR(&SRCFLIB) VALUE(%SST(&RCVDTA 41 10))    
0165.00              CHGVAR     VAR(&SRCTYP) VALUE(%SST(&RCVDTA 51 10))
                      :
0855.00 NXTRTV:                                                                    
0856.00              RETURN

ユーザー・スペース: QTEMP/QSUSPC はユーザー出口プログラムが
指定されたときだけに作成される。
つねに作成されるわけではない。
このユーザー・スペースによっていろいろなソース情報を取得することができる。

ソース・タイプと以前に検索しておいたサービス・プログラムの数を
組み合わせると例えば RPG であれば CRTBNDRPG でコンパイルすればよいのか
それとも CRTRPGMOD + CRTPGM でサービス・プログラムを
バインドする必要があるのかを判断することができる。
もちろんバインドすべきサービス・プログラムもすべて判別しているので
CRTPGM でサービス・プログラムを正しく指定することもできる。
これは C言語のコンパイルでも同じことである。
( 残念ながら COBOL のコンパイルは今回はサポートしなかったが原理は同じなので
読者が工夫して COBOL のコンパイルもサポートすることも難しくはないはずである。)

さらに役に立つのは印刷ファイル( PRTF )や表示装置ファイル( DSPF )の
再コンパイルである。
特に印刷ファイル( PRTF )は個々に設定内容が異なるために再作成するときには
必ず注意深く元の印刷ファイル( PRTF )の設定値を調べなければならないが
元の設定値を見落としてしまうヒューマン・エラーは必ず発生するものである。
CLP: COMPILE は この Tools の「37. 印刷ファイルの属性を調べる RTVPRTFA 」を
利用していて元の印刷ファイルが正確に再作成されるようになっている。

CRTCLPGM PGM(QUATTRO/COMPILE) SRCFILE(MYSRCLIB/QCLSRC) AUT(*ALL)

【 C/400: RPGERR 】

0001.00 /********************************************************************/          
0002.00 /*                                                                  */          
0003.00 /*   RPGERR      :    RPG コンパイル・エラーの検索                  */          
0004.00 /*                                                                  */          
0005.00 /*          Office Quattro Co,.Ltd 2018/05/19 18:06:08 created      */          
0006.00 /*                                                                  */          
0007.00 /*                                                                  */          
0008.00 /********************************************************************/          
0009.00 #pragma comment(COPYRIGHT, "as400-net.com EnterpriseServer (C) CopyRight ™      
0010.00 Office Quattro.Corp. 2018- All right reserved. Users Restricted ™               
0011.00 Rights - Use, duplication or disclosure restricted by Office Quattro ™          
0012.00 Corp. Licenced Materials-Property of Office Quattro.")                          
0013.00 #include                                                               
0014.00 #include                                                              
0015.00 #include                                                              
0016.00 #include  /* triml */                                               
0017.00 #include                                                               
0018.00 #include                                                              
0019.00 #include                                                            
0020.00 #include                                                            
0021.00 #include                                                            
0022.00 #include                                                            
0023.00 #include                                                            
0024.00 #include                                                         
0025.00 #include                                                           
0026.00 #include                                                          
0027.00                                                                              
0028.00 #define TRUE         0                                                       
0029.00 #define FALSE       -1                                                       
0030.00 #define MAX_SPACE_SIZE 16776704                                              
0031.00 #define ID_LEN      16                                                       
0032.00 int    bLR = FALSE;                                                          
0033.00 typedef struct {                                                             
0034.00    int  BYTESPRO;                                                            
0035.00    int  BYTESAVL;                                                            
0036.00    char MSGID[7];                                                            
0037.00    char RESRVD;                                                              
0038.00    char EXCPDATA[100];                                                       
0039.00 } ERRSTRUCTURE;     /* Define the error return structure            */       
0040.00 ERRSTRUCTURE  errcode;/* Error Code Structure for RCVMSG      */             
0041.00 volatile _INTRPT_Hndlr_Parms_T ca;                                           
0042.00 typedef struct {                                                             
0043.00    char NM[10];                                                              
0044.00    char LIB[10];                                                             
0045.00 } QNAME;     /* Define the qualified name                            */      
0046.00 QNAME         inname;                  /*  Qualified user space name */      
0047.00 typedef struct {                                                             
0048.00    char job[10];                                                                 
0049.00    char user[10];                                                                
0050.00    char jobnbr[6];                                                               
0051.00 } JOBINFO;     /* Define the qualified job name structure            */          
0052.00 JOBINFO jobinfo;                                                                 
0053.00 typedef struct spfr_header {                                                     
0054.00      char user_data[64];                                                         
0055.00      int  generic_header_size;                                                   
0056.00      char header_version[4];                                                     
0057.00      char spooled_file_level[6];                                                 
0058.00      char format_name[8];                                                        
0059.00      char information_status;                                                    
0060.00      char reserved2;                                                             
0061.00      int  usrspc_used;                                                           
0062.00      int  first_buffer_offset;                                                   
0063.00      int  buffers_requested;                                                     
0064.00      int  buffers_returned;                                                      
0065.00      int  print_data_sz300;                                                      
0066.00      int  nbr_comp_pages;                                                        
0067.00      char reserved3[16];                                                         
0068.00 } spfr_header;                                                                   
0069.00 spfr_header* inspace;                                                            
0070.00 #define SO      0x0f /* 2004/03/20  シフトアウト  DBCS フィールドの始まり  */    
0071.00 #define SI      0x0e /* 2004/03/20  シフトイン  DBCS フィールドの終わり  */      
0072.00 #define CR      0x0d /*  印刷位置を行の左端へ移動  */                              
0073.00 #define FF      0x0c /*  改ページ  */                                              
0074.00 #define NL      0x15 /*  印刷位置を次の行の左端へ移動  */                          
0075.00 #define HT      0x05 /* 水平タブ */                                                
0076.00 #define IRS     0x1e /* NL(New Line) 制御コードと同じ  */                          
0077.00 #define LF      0x25 /*  印刷位置を垂直方向に 1 行分移動  */                       
0078.00 #define BEL     0x2f /*  印刷を中止させ、操作員に注意を促す  */                    
0079.00 #define NLP     0x00 /*  何も印刷されない  */                                      
0080.00 #define SPS     0x09 /*  スーパースクリプトの指定  */                              
0081.00 #define SBS     0x38 /*  サブスクリプトの指定  */                                  
0082.00 #define CTL2b   0x2b /*  制御コード  : SET 制御  */                                
0083.00                                                                                    
0084.00 #define SA      0x28 /*  Set Attribute(SA) */                                      
0085.00   #define SA_RESET 0x00                                                            
0086.00   #define SA_COLOR 0x42                                                            
0087.00                                                                                    
0088.00 #define CTLD1   0xd1 /*  制御コード  : D1 制御コード  */                           
0089.00 #define SCL     0x81 /*SetCGCSThroughLocalID 言語別文字セット指定 2bd1nn810b*/     
0090.00                                                                                    
0091.00 #define CTLFD   0xfd /*  制御コード  : FD 制御コード  */                           
0092.00 #define DGL     0x00 /*DefineGridLine 罫線の指定と印刷 2bfdnn00*/                  
0093.00 #define SIT     0x01 /*SetIGCTypeDBCS 文字のピッチの指定 2bfdnn01*/                
0094.00 #define SFSS    0x02 /*SetFontSizeScaling フォントサイズ拡大の印刷倍率指定  */     
0095.00 #define SPCC    0x03 /*SetPresentationofControlCharactorSOSI の扱い方の指定 */     
0096.00                                                                                      
0097.00 #define CTLD2 0xd2 /*  制御コード  : D2 制御コード  */                               
0098.00 #define SCD   0x29 /*SetCharacterDensity 英数カナ文字 (1 バイト ) ピッチ設定  */     
0099.00 #define PPM   0x48 /*PagePresentationMedia 形式設定元給紙カセト品質両面印刷 */       
0100.00 #define TABSTOPS 0x01 /* SetHorizontalTabStops */                                    
0101.00                                                                                      
0102.00 #define CTLD3   0xd3 /*  制御コード  : D3 制御コード  */                             
0103.00 #define STO     0xf6 /*SetTextOrientation ページの回転の指定 2bd3nnf6*/              
0104.00                                                                                      
0105.00 #define CTLD4   0xd4 /*  制御コード  : D4 制御コード  */                             
0106.00 #define BUS     0x0a /*BeginUnderscoreBeginUnderscore2bd4nn0a*/                      
0107.00 #define EUS     0x0e /*EndUnderscoreBeginUnderscore2bd4nn0e*/                        
0108.00                                                                                      
0109.00 #define CTLPP 0x34 /* 制御コード :34 位置を 2 つのパラメータ指定の位置移動  */       
0110.00 #define PPC0  0xc0 /* 印刷位置 ( 桁数 nn) で指定された位置 ( 桁 ) へ横方移動 */      
0111.00 #define PPC8  0xc8 /* 現在の印刷位置から nn 桁分、横方向に移動 */                    
0112.00 #define PPC4  0xc4 /* 印刷位置 ( 行数 nn) で指定された位置 ( 行 ) へ縦向移動 */      
0113.00 #define PP4C  0x4c /* 現在の印刷位置から nn 行分、縦方向に移動 */                    
0114.00                                                                                      
0115.00 #define CTLTRN  0x35 /* 制御コード :35 通常印刷されない制御コードを印刷する */       
0116.00                                                                                      
0117.00 #define CTLFE 0xfe /* 制御コード  : FE  代替文字フォントのロード  */                 
0118.00 #define CTLC6 0xc6 /* 制御コード  :C6 行ピッチを 1/72 インチ単位で指定 */            
0119.00 #define CTLC8 0xc8 /* 制御コード :C8 印刷不可能なフォントを受信した場合指定  */      
0120.00 #define CTLC1 0xc1 /* 制御コード C1 桁数左右マジン水平 TAB 停止位置１字単位 */       
0121.00 #define CTLC2 0xc2 /* コード C2 行数上下マージン垂直 TAB 停止位置１文字単位 */       
0122.00                                                                                      
0123.00 #define CTLLIPS  "@@C?" /* 2008/9/7 CANON LIPS */                                    
0124.00                                                                                      
0125.00 #define OPT_HPT 0 /* 2004/04/10  オプションフラグ  HPT */                            
0126.00 #define OPT_HTM 1 /* 2004/04/10  オプションフラグ  HTML */                           
0127.00 #define OPT_TXT 2 /* 2004/04/10  オプションフラグ  TEXT */                           
0128.00 #define OPT_PDF 3 /* 2004/04/10  オプションフラグ  PDF */                            
0129.00 #define OPT_DOC 4 /* 2004/04/10  オプションフラグ  DOC */                            
0130.00 #define OPT_XLS 5 /* 2004/04/10  オプションフラグ  Excel */                          
0131.00 #define OPT_PRT 6 /* 2004/04/10  オプションフラグ  Print */                          
0132.00 #define OPT_ESCP 7 /* 2004/05/20  オプションフラグ  ESCPDBCS  */                     
0133.00 #define OPT_LPR 7 /* 2004/06/04  オプションフラグ  LPR */                            
0134.00 #define OPT_PSC 8 /* 2007/07/30 オプションフラグ  PSC */                             
0135.00 #define OPT_PREVIEW 9 /* 2010/01/24 オプションフラグ  PREVIEW */                     
0136.00                                                                                      
0137.00 #define KEI_COR_X 15 /* 2005/08/31 罫線 1 ドット左補正 */                            
0138.00 #define KEI_COR_Y 0  /* 2005/08/31 罫線 1 ドット下補正 */                            
0139.00                                                                                      
0140.00 #define ESC             0x1b   /* 2004/06/04 ESC/P ESC コード  */                    
0141.00 #define ESCP_UNITR      1800   /* 2004/07/16 ESC/P UNIT */                           
0142.00 #define ESCP_UNIT       600    /* 2004/07/16 ESC/P UNIT H*/                          
0143.00 #define ESCP_MAX_POS    816    /* 2004/08/29 ESC/P PAPER MAX(15Inchi) */             
0144.00                                                                              
0145.00                                                                              
0146.00 /*************************************************************/              
0147.00 /*       内　部　使　用　　関　　数                          */              
0148.00 /*************************************************************/              
0149.00 void  GetParam(int argc, char *argv[]);                                      
0150.00 void  INZSR(void);                                                           
0151.00 int   setCompileList(void);                                                  
0152.00 int   rtvComplieError(int nxterr);                                           
0153.00 int   printOut(int line, int col, char* linebuf, int len, int LINE);         
0154.00 void  ApiError(char* place, int stmno, ERRSTRUCTURE* errcode, char* pgm);    
0155.00 void  LRRTN(void);                                                           
0156.00                                                                              
0157.00 /*************************************************************/              
0158.00 /*       ＩＭＰＯＲＴ　　関　　数                            */              
0159.00 /*************************************************************/              
0160.00 /*************************************************************/              
0161.00 /*       ＩＭＰＯＲＴ　　変　　数                            */              
0162.00 /*************************************************************/              
0163.00 /*************************************************************/              
0164.00 /*       外　部　呼　出　し　　関　　数                      */              
0165.00 /*************************************************************/              
0166.00 void MonitorMSG(_INTRPT_Hndlr_Parms_T ca, char* ref);                        
0167.00 #pragma linkage(MonitorMSG, OS)                                              
0168.00 #pragma map(MonitorMSG, "ASNET.COM/MONMSG")                                    
0169.00 void RtvJobA(char[], char[], char[], char[], char[], char[],                   
0170.00              char[], char[], char[], char[], char[], char[], char[],           
0171.00              char[], char[]);                                                  
0172.00 #pragma map(RtvJobA, "RTVJOBA   ")                         /*CLP*/             
0173.00 #pragma linkage(RtvJobA, OS)                                                   
0174.00 /*************************************************************/                
0175.00 /*        グ　ロ　ー　バ　ル　変　数                         */                
0176.00 /*************************************************************/                
0177.00   /*------( 受取りパラメータ値 )----------*/                                   
0178.00   char NXTJOB[11], NXTSTP[11], SRCMBR[11];                                     
0179.00   /*------( 受取りパラメータ値 )----------*/                                   
0180.00   char ref[133];                                                               
0181.00    char job[10], user[10], jobnbr[6], outq[10], outqlib[10], date[6];          
0182.00    char type[1], prtdev[10], langid[3], cntryid[2], ccsid[5];                  
0183.00    char dftccsid[5], cymddate[7], sbmmsgq[10], sbmmsgqlib[10];                 
0184.00    char jobid[ID_LEN], ascnbr[6];                                              
0185.00    char spoolid[17], linebuf[256], splnm[10];                                  
0186.00    int  splno = -1; /* *LAST */                                                
0187.00    int  nxterr, m_bERR = FALSE;                                                
0188.00    int  nxtstp, curstp = 0;                                                    
0189.00 /********************************************************************/         
0190.00 /*            m  a  i  n --- main module of this pgm                */         
0191.00 /*                                                                  */         
0192.00 /*            なし                                       */    
0193.00 /*                                                                  */    
0194.00 /*------------------------------------------------------------------*/    
0195.00                                                                           
0196.00 int  main(int argc, char *argv[]){                                        
0197.00                                                                           
0198.00    #pragma exception_handler(MONMSG, ca, 0, _C2_MH_ESCAPE, ™              
0199.00                                             _CTLA_HANDLE)                 
0200.00    GetParam(argc, argv);  /*[ パラメータの取得 ]*/                        
0201.00    INZSR();               /*[ 初期設定 ]*/                                
0202.00                                                                           
0203.00    if(strncmp(NXTJOB, "*RPGERR   ", 10) == 0){/* RPG エラー */            
0204.00       if(strncmp(NXTSTP, "          ", 10) == 0){/* 初期環境セット */     
0205.00         if(setCompileList() == FALSE) exit(-1);                           
0206.00       }/* 初期環境セット */                                               
0207.00       nxterr = atoi(NXTSTP) + 1;                                          
0208.00       if(rtvComplieError(nxterr) == FALSE) exit(-1);                      
0209.00    }/* RPG エラー */                                                      
0210.00    LRRTN();                                                               
0211.00    exit(0);                                                               
0212.00                                                                           
0213.00 MONMSG:                                                                   
0214.00    #pragma disable_handler                                                
0215.00    strcpy(ref, "TEST_AA-MAIN");                                           
0216.00    MonitorMSG(ca, ref);                                             
0217.00                                                                     
0218.00    exit(0);                                                         
0219.00 }                                                                   
0220.00 /*************************************/                             
0221.00 void  GetParam(int argc, char *argv[])                              
0222.00 /*************************************/                             
0223.00 {                                                                   
0224.00 }                                                                   
0225.00 /****************/                                                  
0226.00 void  INZSR(void)                                                   
0227.00 /****************/                                                  
0228.00 {                                                                   
0229.00    _DTAA_NAME_T dtaname = {"*LDA      ", "          "};             
0230.00    errcode.BYTESPRO = 160;                                          
0231.00    errcode.BYTESAVL = 0;                                            
0232.00                                                                     
0233.00    QXXRTVDA(dtaname,  21, 10, SRCMBR);                              
0234.00    QXXRTVDA(dtaname, 362, 10, NXTJOB);                              
0235.00    QXXRTVDA(dtaname, 372, 10, NXTSTP);                              
0236.00    if(NXTSTP[0] == ' ') nxtstp = 1;                                 
0237.00    else nxtstp = atoi(NXTSTP);                                      
0238.00    atexit(LRRTN);                                                   
0239.00    memcpy(job, "*         ", 10);                                   
0240.00    RtvJobA(job, user, jobnbr, outq, outqlib, date,                      
0241.00         type, prtdev, langid, cntryid, ccsid, dftccsid, cymddate,       
0242.00         sbmmsgq, sbmmsgqlib);                                           
0243.00    memcpy(jobinfo.job, job, 10);                                        
0244.00    memcpy(jobinfo.user, user, 10);                                      
0245.00    memcpy(jobinfo.jobnbr, jobnbr, 6);                                   
0246.00    memset(jobid, ' ', sizeof(jobid));                                   
0247.00    memset(spoolid, ' ', sizeof(spoolid));                               
0248.00    spoolid[16] = 0x00;                                                  
0249.00    memcpy(splnm, SRCMBR, 10);                                           
0250.00 }                                                                       
0251.00 /*************************/                                             
0252.00 int   setCompileList(void)                                              
0253.00 /*************************/                                             
0254.00 {                                                                       
0255.00   Qus_SPLA0200_t  spla0200;                                             
0256.00   int  handle, pos, i, line, col, page, pot;                            
0257.00   char TEXT[50] = "RPG COMPILE LIST USER-SPACE";                        
0258.00   long  int_size;                                                       
0259.00                                                                         
0260.00 /*-----------------------------------------------------------------*/   
0261.00 /* ( 1 )  スプール情報の取得                                       */   
0262.00 /*-----------------------------------------------------------------*/   
0263.00   QUSRSPLA((char *)&spla0200, sizeof(Qus_SPLA0200_t), "SPLA0200",       
0264.00     (char*)&jobinfo, jobid, spoolid, splnm, splno, (char*)&errcode);     
0265.00   if(errcode.BYTESAVL != 0){/* APIERR */                                 
0266.00     ApiError("QUSRSPLA", __LINE__, &errcode, "TESTSPOOL");               
0267.00       return FALSE;                                                      
0268.00   }/* APIERR */                                                          
0269.00 /*-----------------------------------------------------------------*/    
0270.00 /* ( 2 )  スプールを入れるユーザー・スペースの作成                 */    
0271.00 /*-----------------------------------------------------------------*/    
0272.00     memset(&inname, 0, sizeof(QNAME));                                   
0273.00      memcpy(inname.NM, "RPGERRSPC ", 10);                                
0274.00      memcpy(inname.LIB, "QTEMP     ", sizeof(inname.LIB));               
0275.00     int_size = (spla0200.File_Buffer_Size + 84) *                        
0276.00                (spla0200.Number_Buffers +                                
0277.00                 spla0200.Total_Pages * 12) + 128 + sizeof(spla0200);     
0278.00     if(int_size > MAX_SPACE_SIZE) int_size = MAX_SPACE_SIZE;             
0279.00     QUSCRTUS((char*)&inname, "SPLF      ", int_size, " ",                
0280.00             "*ALL      ", TEXT, "*YES      ", (char*)&errcode);          
0281.00     if(errcode.BYTESAVL != 0){/* APIERR */                               
0282.00       ApiError("QUSCRTUS", __LINE__, &errcode, "RPGERR");                
0283.00       return FALSE;                                                      
0284.00     }/* APIERR */                                                        
0285.00 /*-----------------------------------------------------------------*/    
0286.00 /* ( 3 ) QSPOPNSP -  スプール・ファイルのオープン                  */    
0287.00 /*-----------------------------------------------------------------*/    
0288.00     QSPOPNSP(&handle, (char*)&jobinfo, (char*)&jobid, (char*)&spoolid,      
0289.00              splnm, splno, -1, &errcode);                                   
0290.00     if(errcode.BYTESAVL != 0){/* APIERR */                                  
0291.00       ApiError("QSPOPNSP", __LINE__, &errcode, "TESTSPOOL");                
0292.00       return FALSE;                                                         
0293.00     }/* APIERR */                                                           
0294.00 /*-----------------------------------------------------------------*/       
0295.00 /* ( 4 ) QSPGETSP -  スプール・ファイルの読み取り                  */       
0296.00 /*-----------------------------------------------------------------*/       
0297.00      QSPGETSP(handle, (char*)&inname, "SPFR0300", -1, "*WAIT     ",         
0298.00               &errcode);                                                    
0299.00     if(errcode.BYTESAVL != 0){/* APIERR */                                  
0300.00       ApiError("QSPGETSP", __LINE__, &errcode, "TESTSPOOL");                
0301.00       return FALSE;                                                         
0302.00     }/* APIERR */                                                           
0303.00 /*-----------------------------------------------------------------*/       
0304.00 /* ( 5 ) QSPCLOSP -  スプール・ファイルのクローズ                  */       
0305.00 /*-----------------------------------------------------------------*/       
0306.00     QSPCLOSP(handle, &errcode);                                             
0307.00     if(errcode.BYTESAVL != 0){/* APIERR */                                  
0308.00       ApiError("QSPCLOSP", __LINE__, &errcode, "TESTSPOOL");                
0309.00       return FALSE;                                                         
0310.00     }/* APIERR */                                                           
0311.00                                                                             
0312.00     return TRUE;                                                          
0313.00 }                                                                         
0314.00 /**********************************/                                      
0315.00 int   rtvComplieError(int nxterrno)                                       
0316.00 /**********************************/                                      
0317.00 {                                                                         
0318.00   long int      int_size, spl_size;                                       
0319.00   int  handle, pos, i, j, k, line, col, page, pot, stri;                  
0320.00   char* splbuf;                                                           
0321.00   char cmd[256];                                                          
0322.00                                                                           
0323.00     memset(&inname, 0, sizeof(QNAME));                                    
0324.00     memcpy(inname.NM, "RPGERRSPC ", 10);                                  
0325.00     memcpy(inname.LIB, "QTEMP     ", sizeof(inname.LIB));                 
0326.00 /*-----------------------------------------------------------------*/     
0327.00 /* ( 6 ) QUSPTRUS -  ユーザー・スペースのポインターを取得          */     
0328.00 /*-----------------------------------------------------------------*/     
0329.00     QUSPTRUS((char *)&inname, &inspace, &errcode);                        
0330.00     if(errcode.BYTESAVL != 0){/* APIERR */                                
0331.00       ApiError("QUSPTRUS", __LINE__, &errcode, "TESTSPOOL");              
0332.00     }/* APIERR */                                                         
0333.00 /*-----------------------------------------------------------------*/     
0334.00 /* ( 7 )  ユーザー・スペースからスプールの読み取り                 */     
0335.00 /*-----------------------------------------------------------------*/     
0336.00     spl_size= inspace->usrspc_used -(inspace->first_buffer_offset -1);        
0337.00     splbuf = ((char *)inspace) + inspace->first_buffer_offset;                
0338.00 /*-----------------------------------------------------------------*/         
0339.00 /* ( 8 ) QUSPTRUS -  ユーザー・スペースからバッファーにコピー      */         
0340.00 /*-----------------------------------------------------------------*/         
0341.00     QUSPTRUS((char *)&inname, &splbuf, &errcode);                             
0342.00     if(errcode.BYTESAVL != 0){/* APIERR */                                    
0343.00       ApiError("QUSPTRUS", __LINE__, &errcode, "TESTSPOOL");                  
0344.00     }/* APIERR */                                                             
0345.00 /*-----------------------------------------------------------------*/         
0346.00 /* ( 9 )  スプール・バッファーを読み取って処理する                 */         
0347.00 /*-----------------------------------------------------------------*/         
0348.00     splbuf += 140;                                                            
0349.00     pos = 0;                                                                  
0350.00     line = 1; col = 1; page = 1;                                              
0351.00     i = 0; m_bERR = FALSE;                                                    
0352.00     while(i < spl_size){/*while*/                                             
0353.00       switch(splbuf[i]){/*switch*/                                            
0354.00       case CR:/* 印刷位置を行の左端へ移動  */                                 
0355.00               if(pos > 0) printOut(line, col, linebuf, pos, __LINE__);        
0356.00               line ++;                                                        
0357.00               col = 1;                                                        
0358.00               memset(linebuf, 0, sizeof(linebuf));                            
0359.00               pos = 0; break;                                                 
0360.00       case FF:/* 改ページ  */                                               
0361.00               if(pos > 0) printOut(line, col, linebuf, pos, __LINE__);      
0362.00               page ++; line = col = 1;                                      
0363.00               memset(linebuf, 0, sizeof(linebuf));                          
0364.00               pos = 0; break;                                               
0365.00       case LF:/* 印刷位置を垂直方向に 1 行分移動  */                        
0366.00               if(pos > 0) printOut(line, col, linebuf, pos, __LINE__);      
0367.00               line ++;                                                      
0368.00               memset(linebuf, 0, sizeof(linebuf));                          
0369.00               break;                                                        
0370.00       case NL:/* 印刷位置を次の行の左端へ移動  */                           
0371.00       case IRS:/* NL(New Line) 制御コードと同じ  */                         
0372.00               if(pos > 0) printOut(line, col, linebuf, pos, __LINE__);      
0373.00               line ++; col = 1;                                             
0374.00               memset(linebuf, 0, sizeof(linebuf));                          
0375.00               pos = 0; break;                                               
0376.00       case HT:/* 水平タブ */                                                
0377.00               break;                                                        
0378.00       case BEL:/* 印刷を中止させ、操作員に注意を促す  */                    
0379.00               break;                                                        
0380.00       case SPS:/* スーパースクリプトの指定  */                              
0381.00               break;                                                        
0382.00       case SBS:/* サブスクリプトの指定  */                                  
0383.00               break;                                                        
0384.00       case CTLPP:/* PP  制御  */                                         
0385.00           /*  if(pos > 0) printOut(line, col, linebuf, pos, __LINE__); */
0386.00           /*  pos = 0;  */                                               
0387.00               switch(splbuf[i+1]){/*switch*/                             
0388.00               case PPC0: col = splbuf[i+2];                              
0389.00                          for(j = pos; j 0) printOut(line, col, linebuf, pos, __LINE__);                   
0422.00    strcpy(cmd,                                                                 
0423.00     "CHGMSGD MSGID(EDT0001) MSGF(QUATTRO/QEDTMSGF) MSG(™                       
0424.00 '* * * * *    メ　ッ　セ　ー　ジ　の　要　約　の　終　わ　り     * * * *')");  
0425.00    system(cmd);                                                                
0426.00    exit(0);                                                                    
0427.00 }                                                                              
0428.00 /******************************************************************/           
0429.00 int   printOut(int line, int col, char* linebuf, int len, int LINE)            
0430.00 /******************************************************************/           
0431.00 {                                                                              
0432.00    char* ptr;                                                          
0433.00    int   i, j, sev, lenw, pos;                                         
0434.00    char  msgid[9], sevc[6], num[6], stmt[132], msg[132], cmd[256],     
0435.00          buff[256];                                                    
0436.00                                                                        
0437.00    if(m_bERR == FALSE){/* ERRMSG */                                    
0438.00      if(strstr(linebuf, "MSG ID  SV") != NULL){/* エラーの開始 */      
0439.00         m_bERR = TRUE;                                                 
0440.00         return TRUE;                                                   
0441.00      }/* エラーの開始 */                                               
0442.00      else return FALSE;                                                
0443.00    }/* ERRMSG */                                                       
0444.00    linebuf[len] = 0x00;                                                
0445.00    if(strncmp(linebuf, "*RNF", 4) != 0) return FALSE;                  
0446.00    sscanf(linebuf, "%s %s %s %s %s", msgid, sevc, num, stmt, msg);     
0447.00    sevc[2] = 0x00;                                                     
0448.00    sev = atoi(sevc);                                                   
0449.00    if(sev == 0) return FALSE;                                          
0450.00    msgid[8] = 0x00; sevc[3] = 0x00;                                    
0451.00    if(strlen(stmt) > 10){/* ステートメントなし */                      
0452.00      strcpy(msg, stmt);                                                
0453.00      stmt[0] = 0x00;                                                   
0454.00  /*  return FALSE; */                                                  
0455.00    }/* ステートメントなし */                                           
0456.00    if(strlen(msg) < 10) return FALSE;                              
0457.00    curstp ++;                                                      
0458.00    if(curstp < nxtstp) return TRUE;                                
0459.00    sprintf(cmd,                                                    
0460.00      "CHGDTAARA DTAARA(*LDA (372 4)) VALUE('%04d')", curstp+1);    
0461.00    system(cmd);                                                    
0462.00    sprintf(linebuf, "%s %d %s %s", msgid, sev, stmt, msg);         
0463.00    if(strchr(linebuf, '™'') != NULL){/* 引用符 */                  
0464.00      lenw = strlen(linebuf);                                       
0465.00      j = 0;                                                        
0466.00      for(i = 0; i 0) linebuf[pos+1] = 0x00;                                       
0483.00    sprintf(cmd,                                                             
0484.00     "CHGMSGD MSGID(EDT0001) MSGF(QUATTRO/QEDTMSGF) MSG('%s')", linebuf);    
0485.00    system(cmd);                                                             
0486.00    exit(0);                                                                 
0487.00    return TRUE;                                                             
0488.00 }                                                                           
0489.00 /*********************************************************************/     
0490.00 void  ApiError(char* place, int stmno, ERRSTRUCTURE* errcode, char* pgm)    
0491.00 /*********************************************************************/     
0492.00 {                                                                           
0493.00    char msgid[8], msgdta[101], Message[512];                                
0494.00    int  msglen, msgdtalen, pos;                                             
0495.00    char* ptr;                                                               
0496.00    typedef struct {                                                         
0497.00      Qmh_Rtvm_RTVM0100_t  rtvm0100;                                         
0498.00      char msg[512];                                                         
0499.00    } ERRMSG;                                                                
0500.00    ERRMSG errmsg;                                                           
0501.00                                                                             
0502.00    memset(msgid, 0, sizeof(msgid));                                         
0503.00    memcpy(msgid, errcode->MSGID, 7);                                        
0504.00    msgid[7] = 0x00;                                                            
0505.00    memset(msgdta, 0, sizeof(msgdta));                                          
0506.00    memcpy(msgdta, errcode->EXCPDATA, 100);                                     
0507.00    msgdta[100] = 0x00;                                                         
0508.00    msglen = sizeof(ERRMSG);                                                    
0509.00    msgdtalen = strlen(msgdta);                                                 
0510.00    memset(&errmsg, 0, sizeof(ERRMSG));                                         
0511.00    QMHRTVM(&errmsg,  msglen, "RTVM0100", msgid, "QCPFMSG   *LIBL     ",        
0512.00           msgdta, msgdtalen, "*YES      ", "*YES      ", errcode);             
0513.00    memset(Message, 0, sizeof(Message));                                        
0514.00    memcpy(Message, errmsg.msg, 512);                                           
0515.00    ptr = strstr(Message, "&N");                                                
0516.00    if(ptr != NULL){                                                            
0517.00      pos = (int)(ptr - Message);                                               
0518.00      Message[pos] = 0x00;                                                      
0519.00    }                                                                           
0520.00    printf("(%s) [ERR AT = %d] %s-%s™n", place, stmno,  msgid, Message);        
0521.00    getchar();                                                                  
0522.00    exit(-1);                                                                   
0523.00 }                                                                              
0524.00 /****************/                                                             
0525.00 void  LRRTN(void)                                                              
0526.00 /****************/                                                             
0527.00 {                                                                              
0528.00    if(bLR == TRUE) return;   
0529.00    bLR = TRUE;               
0530.00    system("DLTOVR QPRINT  ");
0531.00 }                            

【 解説 】

関数: printOut の

0445.00    if(strncmp(linebuf, "*RNF", 4) != 0) return FALSE;                  
0446.00    sscanf(linebuf, "%s %s %s %s %s", msgid, sevc, num, stmt, msg);     
0447.00    sevc[2] = 0x00;                                                     
0448.00    sev = atoi(sevc);           

の部分で *RNFxxxx となるエラー・メッセージを検索している。

エラー・メッセージは F8 キーを一回、押すと最初のエラー・メッセージが
SEU の画面下部に表示される。
次にさらに F8 キーを押すと次のエラー・メッセージが表示される。
次々と F8 キーを押していくと最後には

「* * * * *    メ　ッ　セ　ー　ジ　の　要　約　の　終　わ　り     * * * *」

と表示されてエラー・メッセージの終わりを告げる。
これは C言語をコンパイルした場合も同じである。

開発者は F8 キーによって SEU でコンパイル・エラーをすべて修正してから
もう一度 F7 キーを押して再コンパイルすると正しくコンパイルすることができる。

CRTBNDC PGM(QUATTRO/RPGERR) SRCFILE(MYSRCLIB/QCSRC) AUT(*ALL)

【 CLP: CLEERR 】

0001.00              PGM                                                              
0002.00 /*-------------------------------------------------------------------*/       
0003.00 /*   CLPERR    :  C 言語コンパイル・エラーの検索                     */       
0004.00 /*                                                                   */       
0005.00 /*   2018/05/21  作成                                                */       
0006.00 /*-------------------------------------------------------------------*/       
0007.00              DCL        VAR(&MSG) TYPE(*CHAR) LEN(132)                        
0008.00              DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)                        
0009.00              DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)                        
0010.00              DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)                     
0011.00              DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(132)                     
0012.00              DCL        VAR(&TYPE) TYPE(*CHAR) LEN(1)                         
0013.00              DCL        VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)                      
0014.00              DCL        VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +                   
0015.00                           VALUE('*ESCAPE   ')                                 
0016.00              DCL        VAR(&APIERR) TYPE(*CHAR) LEN(116) +                   
0017.00                           VALUE(X'000074') /* 2 進数  */                      
0018.00              DCL        VAR(&NULL4) TYPE(*CHAR) LEN(4) +                      
0019.00                           VALUE(X'00000000')                                  
0020.00              DCLF       FILE(QTEMP/JOBLOG) ALWVARLEN(*YES)                    
0021.00              DCL        VAR(&NXTJOB) TYPE(*CHAR) LEN(10)                      
0022.00              DCL        VAR(&NXTSTP) TYPE(*CHAR) LEN(4)                       
0023.00              DCL        VAR(&STEP) TYPE(*DEC) LEN(4 0)                        
0024.00              DCL        VAR(&COUNT) TYPE(*DEC) LEN(4 0) VALUE(0)              
0025.00              MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))               
0026.00                                                                               
0027.00 /*( 環境の取得 )*/                                                            
0028.00              RTVJOBA    TYPE(&TYPE)                                           
0029.00              IF         COND(&TYPE *EQ '0') THEN(DO) /*  バッチ  */           
0030.00              CHGVAR     VAR(&TOPGMQ) VALUE('*SYSOPR   ')                      
0031.00              ENDDO      /*  バッチ  */                                        
0032.00              ELSE       CMD(DO) /*  対話式  */                                
0033.00              CHGVAR     VAR(&TOPGMQ) VALUE('*TOPGMQ   ')                      
0034.00              ENDDO      /*  対話式  */                                        
0035.00              RTVDTAARA  DTAARA(*LDA (362 10)) RTNVAR(&NXTJOB)                 
0036.00              RTVDTAARA  DTAARA(*LDA (372 4)) RTNVAR(&NXTSTP)                  
0037.00              IF         COND(&NXTSTP *EQ ' ') THEN(DO)                        
0038.00              CHGVAR     VAR(&STEP) VALUE(1)                                   
0039.00              ENDDO                                                            
0040.00              ELSE       CMD(DO)                                               
0041.00              CHGVAR     VAR(&STEP) VALUE(&NXTSTP)                             
0042.00          /*  CHGVAR     VAR(&STEP) VALUE(&STEP + 1) */                        
0043.00              ENDDO                                                            
0044.00                                                                               
0045.00 /*( ジョブログの取得 )*/                                                      
0046.00              DSPJOBLOG  JOB(*) OUTPUT(*OUTFILE) +                             
0047.00                           OUTFILE(QTEMP/JOBLOG) OUTMBR(*FIRST *REPLACE)       
0048.00  READ:       RCVF       RCDFMT(QMHPFT)                                 
0049.00              MONMSG     MSGID(CPF0864) EXEC(DO)                        
0050.00              CHGVAR     VAR(&MSG) VALUE('* * * * *    メ　ッ　セ　 +   
0051.00                            ー　ジ　の　要　約　の　終　わ　り     * +  
0052.00                           * * * *')                                    
0053.00              GOTO       REDEND                                         
0054.00              ENDDO                                                     
0055.00              IF         COND(&QMHRMD *NE 'QCZCUTIL  ') THEN(DO)        
0056.00              GOTO       READ                                           
0057.00              ENDDO                                                     
0058.00              CHGVAR     VAR(&COUNT) VALUE(&COUNT + 1)                  
0059.00              IF         COND(&COUNT *LT &STEP) THEN(DO)                
0060.00              GOTO       READ                                           
0061.00              ENDDO                                                     
0062.00              CHGVAR     VAR(&MSG) VALUE(%SST(&QMHMDT 3 132))           
0063.00  REDEND:     CHGVAR     VAR(&MSGTYPE) VALUE('*INFO     ')              
0064.00              CHGVAR     VAR(&STEP) VALUE(&STEP + 1)                    
0065.00              CHGVAR     VAR(&NXTSTP) VALUE(&STEP)                      
0066.00              CHGDTAARA  DTAARA(*LDA (372 4)) VALUE(&NXTSTP)            
0067.00              GOTO       SNDMSG                                         
0068.00              RETURN                                                    
0069.00                                                                        
0070.00  APIERR:                                                               
0071.00              CHGVAR     VAR(&MSGID) VALUE(%SST(&APIERR 9 7))           
0072.00              CHGVAR     VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))        
0073.00              CHGVAR     VAR(&MSGF) VALUE('QCPFMSG   ')                  
0074.00              CHGVAR     VAR(&MSGFLIB) VALUE('QSYS      ')               
0075.00              GOTO       SNDMSG                                          
0076.00                                                                         
0077.00  ERROR:      RCVMSG     MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +             
0078.00                           MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +   
0079.00                           MSGFLIB(&MSGFLIB)                             
0080.00  SNDMSG:     IF         COND(&MSGID *EQ ' ') THEN(DO)                   
0081.00              CHGMSGD    MSGID(EDT0001) MSGF(QUATTRO/QEDTMSGF) MSG(&MSG) 
0082.00              SNDPGMMSG  MSGID(EDT0001) MSGF(QUATTRO/QEDTMSGF) +         
0083.00                           TOPGMQ(*SAME (*PGMNAME *NONE QSUCPP)) +       
0084.00                           TOMSGQ(*TOPGMQ) MSGTYPE(*INFO)                
0085.00              MONMSG     MSGID(CPF2400)                                  
0086.00           /* MONMSG     MSGID(CPF2400) EXEC(RETURN) */                  
0087.00              ENDDO                                                      
0088.00              ELSE       CMD(DO)                                         
0089.00              CHGMSGD    MSGID(EDT0001) MSGF(QUATTRO/QEDTMSGF) MSG(&MSG) 
0090.00              SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +            
0091.00                           MSGDTA(&MSGDTA) TOPGMQ(*SAME (*PGMNAME +      
0092.00                           *NONE QSUCPP)) TOMSGQ(&TOPGMQ) +              
0093.00                           MSGTYPE(&MSGTYPE)                             
0094.00              MONMSG     MSGID(CPF2400)                                  
0095.00           /* MONMSG     MSGID(CPF2400) EXEC(RETURN) */                  
0096.00              ENDDO   
0097.00              ENDPGM  

【 解説 】

0045.00 /*( ジョブログの取得 )*/                                                      
0046.00              DSPJOBLOG  JOB(*) OUTPUT(*OUTFILE) +                             
0047.00                           OUTFILE(QTEMP/JOBLOG) OUTMBR(*FIRST *REPLACE)

によって出力されたジョブログ: QTEMP/JOBLOG を

0048.00  READ:       RCVF       RCDFMT(QMHPFT)                                 
0049.00              MONMSG     MSGID(CPF0864) EXEC(DO)                        
0050.00              CHGVAR     VAR(&MSG) VALUE('* * * * *    メ　ッ　セ　 +   
0051.00                            ー　ジ　の　要　約　の　終　わ　り     * +  
0052.00                           * * * *')                                    
0053.00              GOTO       REDEND                                         
0054.00              ENDDO             

によって読み取って解析するようにしている。

CRTCLPGM PGM(QUATTRO/CLEERR) SRCFILE(MYSRCLIB/QCLSRC) AUT(*ALL)

【 CLP: EXECUTE 】

0001.00              PGM                                                            
0002.00 /*-------------------------------------------------------------------*/     
0003.00 /*   EXECUTE   :  EDTSRC PGM の実行                                  */     
0004.00 /*                                                                   */     
0005.00 /*   2018/05/20  作成                                                */     
0006.00 /*-------------------------------------------------------------------*/     
0007.00              DCL        VAR(&RCVVAR) TYPE(*CHAR) LEN(1024)                  
0008.00              DCL        VAR(&RCVLEN) TYPE(*CHAR) LEN(4) +                   
0009.00                           VALUE(X'00000400')                                
0010.00              DCL        VAR(&MSG) TYPE(*CHAR) LEN(132)                      
0011.00              DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)                      
0012.00              DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)                      
0013.00              DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)                   
0014.00              DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(132)                   
0015.00              DCL        VAR(&TYPE) TYPE(*CHAR) LEN(1)                       
0016.00              DCL        VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)                    
0017.00              DCL        VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +                 
0018.00                           VALUE('*ESCAPE   ')                               
0019.00              DCL        VAR(&APIERR) TYPE(*CHAR) LEN(116) +                 
0020.00                           VALUE(X'000074') /* 2 進数  */                    
0021.00              DCL        VAR(&NULL4) TYPE(*CHAR) LEN(4) +                    
0022.00                           VALUE(X'00000000')                                
0023.00              /*( プラグラム用変数 )*/                                       
0024.00              DCL        VAR(&OBJECT) TYPE(*CHAR) LEN(10)               
0025.00              DCL        VAR(&PGMOBJLIB) TYPE(*CHAR) LEN(20)            
0026.00              DCL        VAR(&SRCMBR) TYPE(*CHAR) LEN(10)               
0027.00              DCL        VAR(&SRCF) TYPE(*CHAR) LEN(10)                 
0028.00              DCL        VAR(&SRCFLIB) TYPE(*CHAR) LEN(10)              
0029.00              DCL        VAR(&OBJLIB) TYPE(*CHAR) LEN(10)               
0030.00              DCL        VAR(&OBJTYP) TYPE(*CHAR) LEN(10)               
0031.00              DCL        VAR(&BIN4) TYPE(*CHAR) LEN(4)                  
0032.00              DCL        VAR(&PRMSU) TYPE(*DEC) LEN(8 0)                
0033.00              DCL        VAR(&BLK) TYPE(*CHAR) LEN(132)                 
0034.00              MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))        
0035.00                                                                        
0036.00 /*( 環境の取得 )*/                                                     
0037.00              RTVJOBA    TYPE(&TYPE)                                    
0038.00              IF         COND(&TYPE *EQ '0') THEN(DO) /*  バッチ  */    
0039.00              CHGVAR     VAR(&TOPGMQ) VALUE('*SYSOPR   ')               
0040.00              ENDDO      /*  バッチ  */                                 
0041.00              ELSE       CMD(DO) /*  対話式  */                         
0042.00              CHGVAR     VAR(&TOPGMQ) VALUE('*TOPGMQ   ')               
0043.00              ENDDO      /*  対話式  */                                 
0044.00                                                                        
0045.00 /*( パラメータの取得 )*/                                               
0046.00  GETPARM:    RTVDTAARA  DTAARA(*LDA (41 10)) RTNVAR(&OBJLIB)           
0047.00              RTVDTAARA  DTAARA(*LDA (21 10)) RTNVAR(&SRCMBR)           
0048.00              RTVDTAARA  DTAARA(*LDA (432 10)) RTNVAR(&OBJECT)           
0049.00              RTVDTAARA  DTAARA(*LDA (352 10)) RTNVAR(&OBJTYP)           
0050.00              RTVDTAARA  DTAARA(*LDA (01 10)) RTNVAR(&SRCF)              
0051.00              RTVDTAARA  DTAARA(*LDA (11 10)) RTNVAR(&SRCFLIB)           
0052.00                                                                         
0053.00   /*( PGM )*/                                                           
0054.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO) /* +    
0055.00                           PGM */                                        
0056.00      /*( QCLRPGMI: プログラム情報の検索 )*/                             
0057.00              CHGVAR     VAR(&PGMOBJLIB) VALUE(&OBJECT *CAT &OBJLIB)     
0058.00              CALL       PGM(QCLRPGMI) PARM(&RCVVAR &RCVLEN +            
0059.00                           'PGMI0100' &PGMOBJLIB &APIERR)                
0060.00              IF         COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)     
0061.00              SNDPGMMSG  +                                               
0062.00                           MSG('API: QCLRPGMI の実行で次のエラーが発生 + 
0063.00                            しました。 ') MSGTYPE(*DIAG)                 
0064.00              GOTO       APIERR                                          
0065.00              ENDDO                                                      
0066.00              CHGVAR     VAR(&BIN4) VALUE(%SST(&RCVVAR 221 4))           
0067.00              CHGVAR     VAR(&PRMSU) VALUE(%BIN(&BIN4))                  
0068.00                                                                         
0069.00 /*( プログラムの実行 )*/                                                
0070.00              IF         COND(&PRMSU *EQ 0) THEN(DO)                     
0071.00              CALL       PGM(&OBJLIB/&OBJECT) PARM(' ')                  
0072.00              ENDDO                                                       
0073.00              ELSE       CMD(DO)                                          
0074.00              ?          QUATTRO/CALL PGM(&OBJLIB/&OBJECT)                
0075.00              ENDDO                                                       
0076.00              CHGDTAARA  DTAARA(*LDA (362 10)) VALUE('*DEBUG    ')        
0077.00              ENDDO      /* PGM */                                        
0078.00   /*( DSPF )*/                                                           
0079.00              ELSE       CMD(IF COND(&OBJTYP *EQ '*DSPF     ') +          
0080.00                           THEN(DO)) /* DSPF */                           
0081.00              STRSDA     OPTION(3) TSTFILE(&OBJLIB/&OBJECT) MODE(*STD)    
0082.00              ENDDO      /* DSPF */                                       
0083.00   /*( PRTF )*/                                                           
0084.00              ELSE       CMD(IF COND(&OBJTYP *EQ '*PRTF     ') +          
0085.00                           THEN(DO)) /* PRTF */                           
0086.00             ?STRRLU     SRCFILE(&SRCFLIB/&SRCF) SRCMBR(&SRCMBR) +        
0087.00                           OPTION(6)                                      
0088.00              RCVMSG     MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +              
0089.00                           MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +    
0090.00                           MSGFLIB(&MSGFLIB)                              
0091.00              CHGMSGD    MSGID(EDT0001) MSGF(QUATTRO/QEDTMSGF) MSG(&MSG)  
0092.00              RETURN                                                      
0093.00              ENDDO      /* PRTF */                                       
0094.00              CHGMSGD    MSGID(EDT0001) MSGF(QUATTRO/QEDTMSGF) MSG(&BLK)  
0095.00              CHGDTAARA  DTAARA(*LDA (362 10)) VALUE('*DEBUG    ')        
0096.00              RETURN                                              
0097.00                                                                  
0098.00  APIERR:                                                         
0099.00              CHGVAR     VAR(&MSGID) VALUE(%SST(&APIERR 9 7))     
0100.00              CHGVAR     VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100)) 
0101.00              CHGVAR     VAR(&MSGF) VALUE('QCPFMSG   ')           
0102.00              CHGVAR     VAR(&MSGFLIB) VALUE('QSYS      ')        
0103.00              GOTO       SNDMSG                                   
0104.00                                                                  
0105.00  ERROR:      RCVMSG     MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +      
0106.00                           MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSG
0107.00                           MSGFLIB(&MSGFLIB)                      
0108.00  SNDMSG:     IF         COND(&MSGID *EQ ' ') THEN(DO)            
0109.00              SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG)
0110.00                           TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)      
0111.00              ENDDO                                               
0112.00              ELSE       CMD(DO)                                  
0113.00              SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +     
0114.00                           MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +      
0115.00                           MSGTYPE(&MSGTYPE)                      
0116.00              ENDDO                                               
0117.00              ENDPGM                                              

【 解説 】

CRTCLPGM PGM(QUATTRO/EXECUTE) SRCFILE(MYSRCLIB/QCLSRC) AUT(*ALL)

【 CLP: DEBUG 】

0001.00              PGM                                                          
0002.00 /*-------------------------------------------------------------------*/   
0003.00 /*   DEBUG     :  EDTSRC DEBUG 開始                                  */   
0004.00 /*                                                                   */   
0005.00 /*   2018/06/01  作成                                                */   
0006.00 /*-------------------------------------------------------------------*/   
0007.00              DCL        VAR(&MSG) TYPE(*CHAR) LEN(132)                    
0008.00              DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)                    
0009.00              DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)                    
0010.00              DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)                 
0011.00              DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(132)                 
0012.00              DCL        VAR(&TYPE) TYPE(*CHAR) LEN(1)                     
0013.00              DCL        VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)                  
0014.00              DCL        VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +               
0015.00                           VALUE('*ESCAPE   ')                             
0016.00              DCL        VAR(&APIERR) TYPE(*CHAR) LEN(116) +               
0017.00                           VALUE(X'000074') /* 2 進数  */                  
0018.00              DCL        VAR(&NULL4) TYPE(*CHAR) LEN(4) +                  
0019.00                           VALUE(X'00000000')                              
0020.00              /*( プラグラム用変数 )*/                                     
0021.00              DCL        VAR(&OBJECT) TYPE(*CHAR) LEN(10)                  
0022.00              DCL        VAR(&PGMOBJLIB) TYPE(*CHAR) LEN(20)               
0023.00              DCL        VAR(&SRCMBR) TYPE(*CHAR) LEN(10)                  
0024.00              DCL        VAR(&SRCF) TYPE(*CHAR) LEN(10)               
0025.00              DCL        VAR(&SRCFLIB) TYPE(*CHAR) LEN(10)            
0026.00              DCL        VAR(&OBJLIB) TYPE(*CHAR) LEN(10)             
0027.00              DCL        VAR(&OBJTYP) TYPE(*CHAR) LEN(10)             
0028.00              MONMSG     MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))      
0029.00                                                                      
0030.00 /*( 環境の取得 )*/                                                   
0031.00              RTVJOBA    TYPE(&TYPE)                                  
0032.00              IF         COND(&TYPE *EQ '0') THEN(DO) /*  バッチ  */  
0033.00              CHGVAR     VAR(&TOPGMQ) VALUE('*SYSOPR   ')             
0034.00              ENDDO      /*  バッチ  */                               
0035.00              ELSE       CMD(DO) /*  対話式  */                       
0036.00              CHGVAR     VAR(&TOPGMQ) VALUE('*TOPGMQ   ')             
0037.00              ENDDO      /*  対話式  */                               
0038.00                                                                      
0039.00 /*( パラメータの取得 )*/                                             
0040.00  GETPARM:    RTVDTAARA  DTAARA(*LDA (41 10)) RTNVAR(&OBJLIB)         
0041.00              RTVDTAARA  DTAARA(*LDA (21 10)) RTNVAR(&SRCMBR)         
0042.00              RTVDTAARA  DTAARA(*LDA (432 10)) RTNVAR(&OBJECT)        
0043.00              RTVDTAARA  DTAARA(*LDA (352 10)) RTNVAR(&OBJTYP)        
0044.00              RTVDTAARA  DTAARA(*LDA (01 10)) RTNVAR(&SRCF)           
0045.00              RTVDTAARA  DTAARA(*LDA (11 10)) RTNVAR(&SRCFLIB)        
0046.00                                                                      
0047.00 /*( PGM )*/                                                          
0048.00              CHGDTAARA  DTAARA(*LDA (362 10)) VALUE('*EXECUTE  ')    
0049.00              IF         COND(&OBJTYP *EQ '*PGM      ') THEN(DO) /* + 
0050.00                           PGM */                                     
0051.00              STRDBG     PGM(&OBJLIB/&OBJECT) UPDPROD(*YES)           
0052.00              CALL       PGM(&OBJLIB/&OBJECT) PARM(' ')               
0053.00              ENDDBG                                                  
0054.00              ENDDO      /* PGM */                                    
0055.00              ELSE       CMD(IF COND(&OBJTYP *EQ '*SRVPGM   ') +      
0056.00                           THEN(DO)) /* SRVPGM */                     
0057.00             ?STRDBG     SRVPGM(&OBJLIB/&OBJECT)                      
0058.00              CALL       PGM(&OBJLIB/&OBJECT) PARM(' ')               
0059.00              ENDDBG                                                  
0060.00              ENDDO      /* SRVPGM */                                 
0061.00              CHGDTAARA  DTAARA(*LDA (362 10)) VALUE('*EXECUTE  ')    
0062.00              RETURN                                                  
0063.00                                                                      
0064.00  APIERR:                                                             
0065.00              CHGVAR     VAR(&MSGID) VALUE(%SST(&APIERR 9 7))         
0066.00              CHGVAR     VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))     
0067.00              CHGVAR     VAR(&MSGF) VALUE('QCPFMSG   ')               
0068.00              CHGVAR     VAR(&MSGFLIB) VALUE('QSYS      ')            
0069.00              GOTO       SNDMSG                                       
0070.00                                                                      
0071.00  ERROR:      RCVMSG     MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +          
0072.00                           MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) + 
0073.00                           MSGFLIB(&MSGFLIB)                           
0074.00  SNDMSG:     IF         COND(&MSGID *EQ ' ') THEN(DO)                 
0075.00              SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +   
0076.00                           TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)           
0077.00              MONMSG     MSGID(CPF2400) EXEC(RETURN)                   
0078.00              ENDDO                                                    
0079.00              ELSE       CMD(DO)                                       
0080.00              SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +          
0081.00                           MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +           
0082.00                           MSGTYPE(&MSGTYPE)                           
0083.00              MONMSG     MSGID(CPF2400) EXEC(RETURN)                   
0084.00              ENDDO                                                    
0085.00              ENDPGM                                                   

【 解説 】

CRTCLPGM PGM(QUATTRO/DEBUG) SRCFILE(MYSRCLIB/QCLSRC) AUT(*ALL)

【 CLP: SAVMSG 】

0001.00              PGM                                                      
0002.00              CHGMSGD    MSGID(EDT0001) MSGF(QUATTRO/QEDTMSGF) +       
0003.00                           MSG(' ソースが保管されていません。 SAVE で +
0004.00                            保管してください。 ')                      
0005.00              ENDPGM                                                   

【 解説 】

CRTCLPGM PGM(QUATTRO/SAVMSG) SRCFILE(MYSRCLIB/QCLSRC) AUT(*ALL)

以上で EDTSRC に関連するプログラムの紹介を終える。
かなりソースの種類があって面倒なように見えるが導入して頂ければ
いかに開発効率が良くなったかを実感して頂けるはずである。
よく PDM を拡張したものを社内のツールとして運用している例を
目にするのだが SEU そのものを変えている例はほとんど見られない。
SEU の機能を拡張すると開発がいっそう楽になることは間違いない。
是非お試し頂きたい。