下のプログラムはCALLプロトタイプの使い方を例示する。CALLプロトタイプを下記のように定義したとする。
identification division. program-id. callsub is external. environment division. configuration section. special-names. call-convention 3 is some-language. data division. linkage section. 01 x1 pic 9(4) comp-5. 01 x2 pic xx. 01 x3 pic 9(8). 01 x7 pic x. procedure division some-language using by value x1 by reference x2 by reference x3. entry "callsub2" using x2 delimited any x1. entry "printf" using x7 delimited any repeated. end program callsub.
上のCALLプロトタイプと同じ原始ファイル中に、下記の「実際の」原始コード"real"があるとする。
identification division. program-id. prog-1. data division. working-storage section. 01 x1 pic 9(4) comp-5. 01 x2. 05 pic 9(4) comp-5. 05 pic x(20). 01 x3 pic 9(8). 01 x4 pic 9(9) comp-5. 01 x5 pic x. 01 x6 pic x(20). procedure division. mainline. call "callsub" using x1 x2 x3
上のCALL文は下記に相当する。
by value x1 by reference x2 by reference x3
いろいろなCALL文とその結果を以下に例示する。
call "callsub" using x1 x2
上のCALL文はエラーとなる。パラメータの数が合わないからである。
call other-language "callsub" using x1 x2 x3
上のCALL文はエラーとなる。呼出し方式が正しくないからである。
call "callsub" using by reference x1 x2 x3
上のCALL文はエラーとなる。x1は値で渡されなければならないからである。
call "callsub" using 99 x2 x3
上のCALL文は下記のように使用したのに等しい。
by value 99 size 2 by reference x2 by reference x3
call "callsub" using x4 x2 x3
上のCALL文はエラーとなる。x4の長さが合わないからである。
call "callsub" using x1 x5 x3
上のCALL文はエラーとなる。x5が小さすぎるからである。
call "printf" using "A long %1\n" x4
上のCALL文において、x4はANY REPEATEDでカバーされるパラメータである。
call "callsub2" using "Hello" x2 x1
上のCALL文は下記に等しい。
move "Hello" & x"00" to temp call "callsub2" using temp x2 x1
call "callsub2" using x6 x2 x1
上のCALL文は下記に等しい。
move x6 to temp move x"00" to temp (21:1) call "callsub2" using temp x2 x1
call "callsub2" using x6 x2 x1 x4
上のCALL文はエラーとなる。渡されるパラメータが多すぎるからである。
COBOLのアプリケーション・プログラマがCOBOLプログラムの中からCの関数を呼び出したい場合、以下のことを行う必要がある。
上記の過程を自動化するために、COBOL TYPEDEFSおよびCOBOL CALLプロトタイプを使用することができる。そうすると、終端を空文字で区切ったCの文字列に文字列を変換する処理も自動的に行われる。上記のすべてを行う方法を示す例を下に示す。
呼び出したいCの関数をmy_C_functionとする。この関数のCのコードの一部を下に示す。
sample.c -----------------------------------------------------------------
/*** start of source module sample.c ***/
/*------------------------*/ /* Include Header Files */ /*------------------------*/ #include <stdio.h> #include "sample.h"
/*-------------------*/ /* Sample Function */ /*-------------------*/ int my_C_function (parm_1, parm_2, parm_3) num_type parm_1; unsigned char *parm_2; complex_type *parm_3; { int rtn_code = 0;
printf(" my-C_function: invoked\n");
printf(" my-C_function: parm_1 = %d\n", parm_1);
if (parm_2 == NULL) { printf(" my_C_function: parm_2 = IS NULL\n", parm_2); rtn_code = -1; } else { printf(" my_C_function: parm_2 = %s\n", parm_2); }
if (parm_3 == NULL ) { printf(" my_C_function: parm_3 = IS NULL\n", parm_3); rtn_code = -1; } else { printf(" my_C_function: parm_3\n"); printf(" (num1) = %d\n", parm_3->num1); printf(" (num2) = %d\n", parm_3->num2); }
printf(" my_C_function: completed\n"); return(rtn_code); }
/*** end of source module sample.c ***/ -----------------------------------------------------------------
この例では、Cの関数に下記の3つのパラメータが使用されている。
Cの型定義と関数プロトタイプが収められたヘッダー・ファイルがある。それは下記のようになっている。
sample.h ----------------------------------------------------------------- /*** start of source module sample.h ***/
#ifndef SAMPLE #define SAMPLE
/*------------*/ /* Typedefs */ /*------------*/ typedef int num_type; typedef struct { int num1; long num2; } complex_type;
/*----------------------*/ /* Function Prototype */ /*----------------------*/ extern int my_C_function ( num_type parm_1, unsigned char *parm_2, complex_type *parm_3 ); #endif /* SAMPLE */ /*** end of source module sample.h ***/ -----------------------------------------------------------------
最初のステップは、Cの型定義と関数プロトタイプをCOBOLのTYPEDEFSとCALLプロトタイプに変換することである。それは、Micro Focus COBOLに付随して提供されているh2cpyユーティリティを使用して行うことができる。
h2cpy sample.h
は下記のコピーブックを出力する。
sample.cpy ----------------------------------------------------------------- program-id. "c_typedefs" is external. 77 char pic s9(2) comp-5 is typedef. 77 uns-char pic 9(2) comp-5 is typedef. 77 short pic s9(4) comp-5 is typedef. 77 uns-short pic 9(4) comp-5 is typedef. 77 int pic s9(9) comp-5 is typedef. 77 uns-int pic 9(9) comp-5 is typedef. 77 long pic s9(9) comp-5 is typedef. 77 uns-long pic 9(9) comp-5 is typedef. 77 d-l-float comp-2 is typedef. 77 d-float comp-2 is typedef. 77 float comp-1 is typedef. 77 proc-pointer procedure-pointer is typedef. 77 data-pointer pointer is typedef. 77 void pic 9(2) comp-5 is typedef. 01 num-type is typedef usage int. 01 complex-type is typedef. 02 num1 usage int. 02 num2 usage long. entry "my_C_function" using by value int by reference uns-char by reference complex-type returning int . end program "c-typedefs". -----------------------------------------------------------------
上記の中に下記のものが含まれている。
テキスト・エディタを用いて、このファイルに下記の変更を加える。
uns-char
の横に必要語のuns-char
を追加する。これによって、実行時に呼出し側のために、パラメータとして渡されるTEXT文字列が終端を空文字で区切ったCの文字列に変換されるようになる。上記の編集を行った結果を下に示す。
sample.cpy ----------------------------------------------------------------- program-id. "c_typedefs" is external. 77 uns-char pic x is typedef. 77 int pic s9(9) comp-5 is typedef. 77 long pic s9(9) comp-5 is typedef. 77 data-pointer pointer is typedef. 01 num-type is typedef usage int. 01 complex-type is typedef. 02 num1 usage int. 02 num2 usage long. entry "my_C_function" using by value int by reference uns-char delimited by reference complex-type returning int . end program "c_typedefs". -----------------------------------------------------------------
my_C_function 関数を呼び出すCOBOLのアプリケーション・プログラムの例を下に示す。
----------------------------------------------------------------- copy 'sample.cpy'. identification division. program-id. prog. working-storage section. 01 ws-parm-1 usage num-type. 01 ws-parm-2 pic x(50) value "This is a PIC X string from COBOL". 01 ws-parm-3 usage complex-type. 01 ws-return-code usage int. procedure division. main-code section. display "prog: started" move 123 to ws-parm-1 move 1 to num1 IN ws-parm-3 move 2 to num2 IN ws-parm -3 display " " display "prog: call 'my_C_function' with ALL parameters" call "my_C_function" using ws-parm-1 ws-parm-2 ws-parm-3 returning ws-return-code end-call display "prog: 'my_C_function' return code = " ws-return-code display " " display "prog: call 'my_C_function' with NULL parameters" call "my_C_function" using 0 OMITTED OMITTED returning ws-return-code end-call display "prog: 'my_C_function' return code = " ws-return-code display " " display "prog: completed" exit program stop run. -----------------------------------------------------------------
上記の例において、下記のコーディングがなされている。
型定義とプロトタイプは完全な「外部」プログラムとして定義されている。それらは実際の原始プログラムの前に置かれている。その形は複数のプログラムが収められた原始ファイルに似ている。
このようにする必要がある理由は、単にBY VALUE 0とすることはできないからである。それは無効とされる。なぜならば、BY REFERENCEはそのパラメータとして必須であるからである。OMITTEDと指定することによって、Cの関数にパラメータへのポインタが渡される代わりに、NULLが渡されるようになる。
上の例を実行した結果の出力を下に示す。
----------------------------------------------------------------- %prog prog: started
prog: call 'my_C_function' with ALL parameters my_C_function: invoked my_C_function: parm_1 = 123 my_C_function: parm_2 = This is a PIC X string from COBOL my_C_function: parm_3 (num1) = 1 (num2) = 2 my_C_function: completed prog: 'my_C_function' return code = +0000000000
prog: call 'my_C_function' with NULL parameters my_C_function: invoked my_C_function: parm_1 = 0 my_C_function: parm_2 = IS NULL my_C_function: parm_3 = IS NULL my_C_function: completed
prog: 'my_C_function' return code = -0000000001
prog: completed % -----------------------------------------------------------------
* Calling program:
program-id. startup. working-storage section. 01 start-point usage procedure-pointer. procedure-division. set start-point to entry "menu" call "controller" using start-point display "End of run" stop run.
entry "illegal" * Recursive calls invalid without local-storage section. stop run. end program startup.
* Called program:
program-id. controller. working-storage section. 01 next-option pic x. linkage section. 01 current-proc usage procedure-pointer. procedure division using current-proc. perform until current-proc = NULL call current-proc returning next-option * Note program-id must be called before any entry point evaluate next-option when "a" set current-proc to entry "sub1" when other set current-proc to NULL end evaluate end-perform exit program. end program controller.
program-id. menu. working-storage section. 01 exit-option pic x. procedure division. display "In menu" move "a" to exit-option exit program returning exit-option. * Note that the maximum size of returned value is 4 bytes
entry "sub1" display "In sub1" exit program returning 1.
* Calling program:
program-id. calling. working-storage section. 01 call-size pic x(4) comp-5 value 64. linkage section. 01 call-area pic x. procedure division. call "sub2" using call-size returning address of call-area if address of call-area not = null display "Contents of new area: " call-area(1:call-size) end-if stop run. end program calling.
* Called program:
program-id. sub2. working-storage section. 01 sub-pointer usage pointer. linkage section. 01 link-size pic x(4) comp-5. 01 link-area pic x. procedure division using link-size. call "CBL_ALLOC_MEM" using sub-pointer by value link-size 0 size is 4 if return-code = 0 set address of link-area to sub-pointer move "Hello!" to link-area(1:call-size) else set sub-pointer to null end-if exit program returning sub-pointer.
OLDCOPYコンパイラ指令を設定すると、COPY文の動作が少し変更される。具体的には、ANSI'74およびANSI'85の標準に定義されているようにではなく、ANSI'68の標準に定義されているように動作するようになる。この変更された動作は、IBMのメインフレーム上でLANGLVL(1)コンパイラ・オプションを使用したときの、OS/VS COBOLおよびDOS/VS COBOLの動作とも一貫性がある。
OLDCOPYコンパイラ指令を設定し、かつ01レベルのデータ記述全体をコピー・メンバーに含めたい場合は、COPY文とコピーされるデータ記述の両方を01レベルのデータ項目として定義すべきである。ただし、COBOLプログラムの残りの部分では、コピー文から得られたデータ名しか利用できない。例を下に示す。
原始ファイルのコード
01 PRODUCT-CODE COPY COPYPROD.
コピーファイル"COPYPROD"のコード
01 PROD-CD. 05 ITEM-NAME PIC X(30). 05 ITEM-NUMBER PIC X(5).
結果のCOBOLコード
01 PRODUCT-CODE. 05 ITEM-NAME PIC X(30). 05 ITEM-NUMBER PIC X(5).
ANSI'85に準拠するコンパイラ中のCOPY文を使用すると、コピー・メンバーの原文中の語を部分的に変更することができる。ただし、この構文が効力を発揮するのは、ある種の方式(および特殊な文字)を使用した場合だけであるので、十分に注意を要する。この技法を応用するときには、プログラマは変更可能な節をコピー・メンバーにあらかじめ設定しておかなければならない。実際、いったんこの技法を使用すると、置換が行われなかったときには、コピー・メンバーは正しくコンピュータされなくなる。例を下に示す。
原始ファイルのコード
copy Payroll replacing ==(TAG)== by ==Payroll==.
コピー・ファイルのコード
01 (TAG). 05 (TAG)-Week pic s99. 05 (TAG)-Gross-Pay pic s9(5)v99. 05 (TAG)-Hours pic s9(3) occurs 1 to 52 times depending on (TAG)-Week of (TAG).
置換しながらコピーした結果は下記のようになる。
01 Payroll. 05 Payroll-Week pic s99. 05 Payroll-Gross-Pay pic s9(5)v99. 05 Payroll-Hours pic s9(3) occurs 1 to 52 times depending on Payroll-Week of Payroll.
特殊名段落のCRT状態句は下記の構成のデータ項目を提示する。
CRT状態キーをコーディングおよび参照する方法を示す例を下に示す。
************************************************************ * * * The following shows how the special-names paragraph * * sets up both a cursor position field and a CRT status * * key field. * * * ************************************************************
special names. cursor is cursor-position crt status is crt-status.
...
working-storage section. 01 cursor-position pic 9(4). ************************************************************ * The following group item defines the CRT status key * * field and establishes certain 78-level condition-names * * associated with key fields. * * * * Programs using these definitions should be compiled * * with NOIBMCOMP and MF to function as expected. * * * ************************************************************ 01 crt-status. 05 crt-status-1 pic 9. 88 terminate-key value 0. 88 function-key value 1. 88 adis-key value 2. 88 status-1-error value 9. 05 crt-status-2 pic 99 comp-x. 88 esc-key value 0. 88 f1-key value 1. 88 enter-key value 1. 88 fun-key-num-user values 0 thru 127. 88 fun-key-num-system values 0 thru 26. 05 crt-status-3 pic 99 comp-x. 88 raw-key-code values 0 thru 255. ... procedure-division. ... ************************************************************ * * * The following shows the procedural code that would * * evaluate the CRT status keys and direct processing * * accordingly. * * * ************************************************************ evaluate terminate-key also function-key also adis-key when true also any also any if esc-key evaluate crt-status-3 when 0 perform raw-key-0 when 1 perform raw-key-1 when 2 perform raw-key-2 when 3 perform raw-key-3 ... end-evaluate else perform logic-for-terminator-key end-if when any also true also any evaluate crt-status-2 when 1 perform user-function-1 when 2 perform user-function-2 when 3 perform user-function-3 when 4 perform user-function-4 when 5 perform user-function-5 ... end-evaluate
when any also any also true evaluate crt-status-2 when 1 perform sys-function-1 when 2 perform sys-function-2 when 3 perform sys-function-3 when 4 perform sys-function-4 when 5 perform sys-function-5 ... end-evaluate end-evaluate
原始プログラムのコードの一部を「条件付きでコンパイルする」ために、&IF文を使用することができる。下の例では、プログラムに下記の指令を指定してコンパイルする。
CONSTANT WHERE "PC"
すると、コンパイル時に、"NO"という語が表示されて、実行用プログラム・コードにはGO TO文ではなく、EVALUATEが含まれる。
$if WHERE = "PC" evaluate test-field when 5 perform test-a end-evaluate $if other-constant defined $display Program compiled with other-constant set $else $display NO $end $else go to test-a test-b depending on test-field $end
INSPECT文を使用すると、指定した文字列が出現する回数を数え、その文字列を別の文字列で置き換えたり、文字の組合せを別の文字の組合せに変換したりすることができる。この文字列検査の条件の設定は非常に複雑になりうる。この動詞の変形および用途をいくつか下に例示する。
下に示すINSPECT文の各例において、この文を実行する直前のCOUNT-nはゼロであるとする。各例の結果は、その上の2つの連続するINSPECT文を実行した結果である。
inspect item tallying count-0 for all "AB", all "D" count-1 for all "BC" count-2 for leading "EF" count-3 for leading "B" count-4 for characters; inspect item replacing all "AB" by "XY", "D" by "X" all "BC" by "VW" leading "EF" by "TU" leading "B" by "S" first "G" by "R" first "G" by "P" characters by "Z"
ITEMの初期値 | COUNT-0 | COUNT-1 | COUNT-2 | COUNT-3 | COUNT-4 | ITEMの最終値 |
---|---|---|---|---|---|---|
EFABDBCGABEFGG | 3 | 1 | 1 | 0 | 5 | TUXYXVWRXYZZPZ |
BABABC | 2 | 0 | 0 | 1 | 1 | SXYXYZ |
BBBC | 0 | 1 | 0 | 2 | 0 | SSVW |
inspect item tallying count-0 for characters count-1 for all "A"; inspect item replacing characters by "Z" all "A" by "X"
ITEMの初期値 | COUNT-0 | COUNT-1 | ITEMの最終値 |
---|---|---|---|
BBB | 3 | 0 | ZZZ |
ABA | 3 | 0 | ZZZ |
inspect item tallying count-0 for all "AB" before "BC" count-1 for leading "B" after "D" count-2 for characters after "A" before "C" inspect item replacing all "AB" by "XY" before "BC" leading "B" by "W" after "D" first "E" by "V" after "D" characters by "Z" after "A" before "C"
ITEMの初期値 | COUNT-0 | COUNT-1 | COUNT-2 | ITEMの最終値 |
---|---|---|---|---|
BBEABDABABBCABEE | 3 | 0 | 2 | BBEXYZXYXYZCABVE |
ADDDDC | 0 | 0 | 4 | AZZZZC |
ADDDDA | 0 | 0 | 5 | AZZZZZ |
CDDDDC | 0 | 0 | 0 | CDDDDC |
BDBBBDB | 0 | 3 | 0 | BDWWWDB |
inspect item tallying count-0 for all "AB" after "BA" before "BC"; inspect item replacing all "AB" by "XY" after "BA" before "BC"
ITEMの初期値 | COUNT-0 | ITEMの最終値 |
---|---|---|
ABABABABC | 1 | ABABXYABC |
inspect item converting "ABCD" to "XYZX" after quote before "#".
The above INSPECT is equivalent to the following INSPECT:
inspect item replacing all "A" by "X" after quote before "#" all "B" by "Y" after quote before "#" all "C" by "Z" after quote before "#" all "D" by "X" after quote before "#".
ITEMの初期値 | ITEMの最終値 |
---|---|
AC"AEBDFBCD#AB"D | AC"XEYXFYZX#AB"D |
VALUE句の定数名形式のNEXT指定は常に、記憶領域の次のバイトが前のデータ宣言のどれだけ後ろにあるかを示すオフセットを指す。例を下に示す。
01 x1 pic x(10). 01 x2 redefines x1 pic x. 78 next-offset value next. 01 x3 pic xx.
next-offset中の値は、x3の開始ロケーションではなくて、x1の2番目のバイトである。
このことはOCCURS句に関して混乱を招く原因となりうる。たとえば、下記の例がある。
01 group-item. 05 tabl occurs 10 times. 78 offset-a value next. 10 elem pic x. 78 offset-b value next. 05 after-tabl pic x(02).
offset-aはelemの最初の反復の開始点でのオフセットを指す。それに対して、 offset-b は、2番目の表要素elemの2番目の反復要素の開始ロケーションを指すのであって、after-tablの開始ロケーションを指すのではない。after-tablの開始ロケーションを得たい場合には、原文を下記のように記述すべきである。
01 group-item. 05 dummy-item pic x(10). 78 offset-c value next. 05 tabl redefines dummy-item occurs 10 times. 78 offset-a value next. 10 elem pic x. 78 offset-b value next. 05 after-tabl pic x (02).
この例では、offset-cはafter-tablの開始オフセットを指す。
SORT文を使用して、ファイル中のレコードを整列させることができる。下記のプログラムは入力ファイルおよび出力ファイルの名前をコマンド行から受け取る。レコードを入力し、そのレコードを整列し、その結果を出力する入力および出力の手続きにおいて、RELEASE文とRETURN文がそれぞれ使用される。
$SET ANS85 select ifile assign to ipf organization is line sequential file status is ipstat.
select sfile assign to "temp.dat".
select ofile assign to opf organization is line sequential.
fd ifile. 01 irec pic x(80). fd ofile. 01 orec pic x(80). sd sfile. 01 srec pic x(80).
working-storage section. 01 ipstat. 03 iskey1 pic x. 03 iskey2 pic x. 01 ipf pic x(20). 01 opf pic x(20). 01 ext pic x(20). 01 clin pic x(132). 01 len pic 9(2) comp-x. 01 a pic 9(2) comp-x value 0. procedure division. accept clin from command-line unstring clin delimited by space into ipf, opf, ext if ext not = space display "too many arguements end if
sort sfile on ascending srec input procedure sortin output procedure sortout
stop run.
sortin section. open input ifile read ifile perform until ipstat not = "00" move irec to srec release srec read ifile end-perform close ifile.
sortout section. return sfile at end go to sortout-exit display srec go to sortout. sortout-exit. display "Done".
整列するために、OCCURS句中にキーを指定して表を下記のように定義する。
working-storage section. 01 group-item. 05 tabl occurs 10 times ascending elem-item2 descending elem-item1. 10 elem-item1 pic x. 10 elem-item2 pic x. . . . procedure division. . . . sort tabl. if tabl (1) . . .
これは単純な整列である。データ項目TablのOCCURS句内のキー定義に基づいて順序を判定して、表を昇順に整列している。具体的には、Elem-Item2が第1キー(昇順)であり、Elem-Item1が第2キー(降順)である。
要素全体を使用して表を整列するには、下記のようにする。
working-storage section. 01 group-item. 05 tabl occurs 10 times 10 elem-item1 pic x. 10 elem-item2 pic x. . . . procedure division. . . . sort tabl ascending. if tabl (1) ...
これは、表のすべての要素を使用して順序を判定して昇順に整列する、単純な整列である。
順序を決定するキーを指定して表を整列するには、下記のようにする。
working-storage section. 01 group-item. 05 tabl occurs 10 times ascending elem-item3 descending elem-item1. 10 elem-item1 pic x. 10 elem-item2 pic x. 10 elem-item3 pic x. . . . procedure division. . . . sort tabl descending elem-item2 elem-item3 if tabl (1) ...
この処理では、指定されたデータ項目をキーとして、表を整列する。OCCURS句の中でキーとして指定されていないが、Elem-Item2が第1キーとなる。Elem-Item3は第2キーとなる。Elem-Item3はこのソートに関してはDESCENDINGキーとして扱われる。なぜならば、SORT文に指定されたDESCENDING(キー・データ項目全体に影響)の方がOCCURS句内に指定されたASCENDINGよりも優先されるからである。
入れ子になった表を整列するに下記のようにする。
working-storage section. 01 group-item. 05 tabl1 occurs 10 times indexed by t1-ind t2-ind. 10 tabl2 occur 5 times. 15 group1. 20 elem-item1 pic x. 15 group2. 20 elem-item1 pic 9. . . . procedure division. . . . set t1-ind to 3 sort tabl2 descending elem-item1 of group2 if group1 (3 1) ...
この整列処理ではTabl2の3番目のインスタンス、つまりTabl2(3)だけが整列される。修飾されたデータ項目のGroup2のElem-Item1がキーに使用されている。手続き部で参照するには通常、Group2のElem-Item1は2レベルの添字付け/指標付けを必要とする。しかし、ここでは添字付けも指標付けも行われていない。(同様に、Tabl2は通常は1レベルの添字付けを必要とする。しかし、SORT文中のデータ名-2を添字付けすることはできない。その代わりに、整列対象のインスタンスを判定するために、T1-Indの値が使用されている。)
プログラムに下記の定義が含まれているとする。
01 rec. 03 forename pic X(10). 03 personnel-no pic X(4). 03 surname pic X(15).
the syntax:
record key is fullname = surname forename
すると、COBOLシステムは下記のデータ項目から構成される明示的に定義された集団項目であるかのように、 fullname
を扱う。
03 surname pic X(15). 03 forename pic X(10).
このCOBOLシステムでは、下記のようにデータを記述することができる。
01 struct-1 TYPEDEF. 05 part-1 pic x (20). 05 part-2 pic x(10). 01 USHORT pic 9 (4) comp-5 typedef.
これは、struct-1とUSHORTを新しいデータ型として定義している。それを次のように使用することができる。
01 a. 05 b struct-1. 05 x USHORT.
これは下記のように記述されているかのように解釈される。
01 a. 05 b. 10 part-1 pic x(20). 10 part-2 pic x(10). 05 x pic 9(4) comp-5.