アレクサンドル;
OpenCOBOL 2.0 には FUNCTION-ID があり、次のようなことが可能になります。
MOVE FUNCTION nextbigthing(args) TO cobol-working-store
ただし、リリースされるまでは、CALL、ENTRY、PROGRAM-ID などに「制限」されています。
低レベル関数ポインタ関連の例については、以下をご覧ください。
http://opencobol.add1tocobol.com/#what-stock-call-library-does-opencobol-offer
これには、エラー ハンドラと終了手順を設定するためのスニペットが含まれています。それを目でスキャンする
- 手続きポインタ
- エントリ
- SET proc-ptr TO ENTRY "リンク名"
- 呼び出し ... 使用中 ... 戻る
ただし、これは 1 つの方法です。他にもあります。ENTRY 行は、PROGRAM-ID サブプログラムなどでいっぱいになる可能性があります。OpenCOBOL FAQ のセクション 5 には、他の言語とリンク ライブラリとの間でデータをやり取りするルーチンがたくさんあります。
また、libcob/common.h の cob_field を見てください。CALL によって生成された C コードは、引数の COBOL フィールドの配列と実際の呼び出しフレームを設定します。これらの COBOL フィールド構造には、cob_module を介して C 関数からアクセスできます。
errorproc.cob
>>SOURCE FORMAT IS FIXED
*****************************************************************
* OpenCOBOL demonstration
* Author: Brian Tiffin
* Date: 26-Jun-2008
* History:
* 03-Jul-2008
* Updated to compile warning free according to standards
* Purpose:
* CBL_ERROR_PROC and CBL_EXIT_PROC call example
* CBL_ERROR_PROC installs or removes run-time error procedures
* CBL_EXIT_PROC installs or removes exit handlers
* Also demonstrates the difference between Run time errors
* and raised exceptions. Divide by zero raises an
* exception, it does not cause a run time error.
* NB:
* Please be advised that this example uses the functional but
* now obsolete ENTRY verb. Compiling with -Wall will display
* a warning. No warning will occur using -std=MF
* Tectonics: cobc -x errorproc.cob
identification division.
program-id. error_exit_proc.
data division.
working-storage section.
* entry point handlers are procedure addresses
01 install-address usage is procedure-pointer.
01 install-flag pic 9 comp-x value 0.
01 status-code pic s9(9) comp-5.
* exit handler address and priority (prio is IGNORED with OC1.1)
01 install-params.
02 exit-addr usage is procedure-pointer.
02 handler-prio pic 999 comp-x.
* indexing variable for back scannning error message strings
01 ind pic s9(9) comp-5.
* work variable to demonstrate raising exception, not RTE
01 val pic 9.
* mocked up error procedure reentrancy control, global level
01 once pic 9 value 0.
88 been-here value 1.
* mocked up non-reentrant value
01 global-value pic 99 value 99.
* LOCAL-STORAGE SECTION comes into play for ERROR_PROCs that
* may themselves cause run-time errors, handling reentry.
local-storage section.
01 reenter-value pic 99 value 11.
* Linkage section for the error message argument passed to proc
* By definition, error messages are 325 alphanumeric
linkage section.
01 err-msg pic x(325).
* example of OpenCOBOL error and exit procedures
procedure division.
* Demonstrate problem installing procedure
* get address of WRONG handler. NOTE: Invalid address
set exit-addr to entry "nogo-proc".
* flag: 0 to install, 1 to remove
call "CBL_EXIT_PROC" using install-flag
install-params
returning status-code
end-call.
* status-code 0 on success, in this case expect error.
if status-code not = 0
display
"Intentional problem installing EXIT PROC"
", Status: " status-code
end-display
end-if.
* Demonstrate install of an exit handler
* get address of exit handler
set exit-addr to entry "exit-proc".
* flag: 0 to install, 1 to remove
call "CBL_EXIT_PROC" using install-flag
install-params
returning status-code
end-call.
* status-code 0 on success.
if status-code not = 0
display
"Problem installing EXIT PROC"
", Status: " status-code
end-display
stop run
end-if.
* Demonstrate installation of an error procedure
* get the procedure entry address
set install-address to entry "err-proc".
* install error procedure. install-flag 0 installs, 1 removes
call "CBL_ERROR_PROC" using install-flag
install-address
returning status-code
end-call.
* status-code is 0 on success.
if status-code not = 0
display "Error installing ERROR PROC" end-display
stop run
end-if.
* example of error that raises exception, not a run-time error
divide 10 by 0 giving val end-divide.
* val will be a junk value, use at own risk
divide 10 by 0 giving val
on size error display "DIVIDE BY ZERO Exception" end-display
end-divide.
* intentional run-time error
call "erroneous" end-call. *> ** Intentional error **
* won't get here. RTS error handler will stop run
display
"procedure division, following run-time error"
end-display.
display
"global-value: " global-value
", reenter-value: " reenter-value
end-display.
exit program.
*****************************************************************
*****************************************************************
* Programmer controlled Exit Procedure:
entry "exit-proc".
display
"**Custom EXIT HANDLER (will pause 3 and 0.5 seconds)**"
end-display.
* sleep for 3 seconds
call "C$SLEEP" using "3" end-call.
* demonstrate nanosleep; argument in billionth's of seconds
* Note: also demonstrates OpenCOBOL's compile time
* string catenation using ampersand;
* 500 million being one half second
call "CBL_OC_NANOSLEEP" using "500" & "000000" end-call.
exit program.
*****************************************************************
* Programmer controlled Error Procedure:
entry "err-proc" using err-msg.
display "**ENTER error procedure**" end-display.
* These lines are to demonstrate local and working storage
display
"global-value: " global-value
", reenter-value: " reenter-value
end-display.
* As reenter-value is local-storage
* the 77 will NOT display on rentry, while the global 66 will
move 66 to global-value.
move 77 to reenter-value.
* Process err-msg.
* Determine Length of error message, looking for null terminator
perform varying ind from 1 by 1
until (err-msg(ind:1) = x"00") or (ind = length of err-msg)
continue
end-perform.
display err-msg(1:ind) end-display.
* demonstrate trapping an error caused in error-proc
if not been-here then
set been-here to true
display "Cause error while inside error-proc" end-display
call "very-erroneous" end-call *> Intentional error
end-if.
* In OpenCOBOL 1.1, the return-code is local and does
* not influence further error handlers
*move 1 to return-code.
move 0 to return-code.
display "**error procedure EXIT**" end-display.
exit program.