.. |_| unicode:: 0xA0 :trim: .. role:: small-caps :class: small-caps .. include:: .. index:: single:System Routines System Routines =============== For a complete list of supported system routines, :ref:`Appendix D `. .. _CBLAGCAGETOPT: .. index:: single:CBL_GC_GETOPT CBL_GC_GETOPT ------------- \ :code:`CBL_GC_GETOPT`\ provides the quite well-known option parser, getopt, for GnuCOBOL. The usage of this system routine is described by the following example. :: identification division. program-id. prog. data division. working-storage section. 78 shortoptions value "jkl". 01 longoptions. 05 optionrecord occurs 2 times. 10 optionname pic x(25). 10 has-value pic 9. 10 valpoint pointer value NULL. 10 return-value pic x(4). 01 longind pic 99. 01 long-only pic 9 value 1. 01 return-char pic x(4). 01 opt-val pic x(10). 01 counter pic 9 value 0. We first need to define the necessary fields for getopt's shortoptions (so), longoptions (lo), longoption index (longind), long-only-option (long-only) and also the fields for return values return-char and opt-val (arbitrary size with trimming, see return codes). The shortoptions are written down as an alphanumeric field (i.e., a string with arbitrary size) as follows: :: "ab:c::d" This means we want getopt to look for shortoptions named a, b, c or d and we demand an option value for b and we are accepting an optional one for c. The longoptions are defined as a table of records with oname, has-value, valpoint and val. * oname defines the name of a longoption. * has-value defines if an option value is demanded (has-val = 1), optional (has-val = 2) or not required (has-val = 0). * valpoint is a pointer used to specify an address to save getopt's return value to. The pointer is optional. If it is \ :code:`NULL`\ , getopt returns a value as usual. If you use the pointer it has to point to a \ :code:`PIC X(4)`\ field. * The field val is a \ :code:`PIC X(4)`\ character which is returned if the longoption was recognized. The longoption structure is immutable! You can only vary the number of records. Now we have the tools to run \ :code:`CBL_GC_GETOPT`\ within the procedure division. :: procedure division. move "version" to optionname (1). move 0 to has-value (1). move "v" to return-value (1). move "verbose" to optionname (2). move 0 to has-value (2). move "V" to return-value (2). perform with test after until return-code = -1 call 'CBL_GC_GETOPT' using by reference shortoptions longoptions longind by value long-only by reference return-char opt-val end-call display return-char end-display display opt-val end-display end-perform stop run. The example shows how we initialize all parameters and call the routine until \ :code:`CBL_GC_GETOPT`\ runs out of options and returns -1. If the option is recognized, \ :code:`return-char`\ contains the option character. Otherwise, \ :code:`return-char`\ will contain one of the following: * \ :code:`?`\ undefined or ambiguous option * \ :code:`1`\ non-option (only if first byte of so is '\ :code:`-`\ ') * \ :code:`0`\ \ :code:`valpoint != NULL`\ and we are writing the return value to the specified address * \ :code:`-1`\ no more options (or reached the first non-option if first byte of so is '\ :code:`+`\ ') The return-code of \ :code:`CBL_GC_GETOPT`\ is one of: * \ :code:`1`\ a non-option (only if first byte of so is '\ :code:`-`\ ') * \ :code:`0`\ \ :code:`valpoint != NULL`\ and we are writing the return value to the specified address * \ :code:`-1`\ no more options (or reach the first non-option if first byte of so is '\ :code:`+`\ ') * \ :code:`2`\ truncated option value in opt-val (because opt-val was too small) * \ :code:`3`\ regular answer from \ :code:`getopt`\ .. _CBLAGCAHOSTED: .. index:: single:CBL_GC_HOSTED CBL_GC_HOSTED ------------- \ :code:`CBL_GC_HOSTED`\ provides access to the following C hosted variables: * \ :code:`argc`\ |_| to binary-long by value * \ :code:`argv`\ |_| to pointer to char \*\* * \ :code:`stdin`\ , \ :code:`stdout`\ , \ :code:`stderr`\ |_| to pointer * \ :code:`errno`\ |_| giving address of errno in pointer to binary-long, use based for more direct access and conditional access to the following variables: * \ :code:`tzname`\ |_| pointer to pointer to array of two char pointers * \ :code:`timezone`\ |_| C long, will be seconds west of UTC * \ :code:`daylight`\ |_| C int, will be 1 during daylight savings System will need to \ :code:`HAVE_TIMEZONE`\ defined for these to return anything meaningful. Attempts made when they are not available return 1 from \ :code:`CBL_GC_HOSTED`\ . It returns 0 when match, 1 on failure, case matters as does length, \ :code:`arg`\ won't match. The usage of this system routine is described by the following example. :: HOSTED identification division. program-id. hosted. data division. working-storage section. 01 argc usage binary-long. 01 argv usage pointer. 01 stdin usage pointer. 01 stdout usage pointer. 01 stderr usage pointer. 01 errno usage pointer. 01 err usage binary-long based. 01 domain usage float-long value 3.0. 01 tzname usage pointer. 01 tznames usage pointer based. 05 tzs usage pointer occurs 2 times. 01 timezone usage binary-long. 01 daylight usage binary-short. *> Testing CBL_GC_HOSTED procedure division. call "CBL_GC_HOSTED" using stdin "stdin" display "stdin : " stdin call "feof" using by value stdin display "feof stdin : " return-code call "CBL_GC_HOSTED" using stdout "stdout" display "stdout : " stdout call "fprintf" using by value stdout by content "Hello" & x"0a" call "CBL_GC_HOSTED" using stderr "stderr" display "stderr : " stderr call "fprintf" using by value stderr by content "on err" & x"0a" call "CBL_GC_HOSTED" using argc "argc" display "argc : " argc call "CBL_GC_HOSTED" using argv "argv" display "argv : " argv call "args" using by value argc argv call "CBL_GC_HOSTED" using errno "errno" display "&errno : " errno set address of err to errno display "errno : " err call "acos" using by value domain display "errno after acos(3.0): " err ", EDOM is 33" call "CBL_GC_HOSTED" using argc "arg" display "'arg' lookup : " return-code call "CBL_GC_HOSTED" using null "argc" display "null with argc : " return-code display "argc is still : " argc *> the following only returns zero if the system has HAVE_TIMEZONE set call "CBL_GC_HOSTED" using daylight "daylight " display "'timezone' lookup : " return-code if return-code not = 0 display "system doesn't has timezone" else display "timezone is : " timezone call "CBL_GC_HOSTED" using daylight "daylight " display "'daylight' lookup : " return-code display "daylight is : " daylight set environment "TZ" to "PST8PDT" call static "tzset" returning omitted on exception continue end-call call "CBL_GC_HOSTED" using tzname "tzname" display "'tzname' lookup : " return-code *> tzs(1) will point to z"PST" and tzs(2) to z"PDT" if return-code equal 0 and tzname not equal null then set address of tznames to tzname if tzs(1) not equal null then display "tzs #1 : " tzs(1) end-if if tzs(2) not equal null then display "tzs #2 : " tzs(2) end-if end-if end-if goback. end program hosted. .. _CBLAGCANANOSLEEP: .. index:: single:CBL_GC_NANOSLEEP CBL_GC_NANOSLEEP ---------------- \ :code:`CBL_GC_NANOSLEEP`\ allows you to pause the program for nanoseconds. The actual precision depends on the system. :: *> Waiting a half second call "CBL_GC_NANOSLEEP" using "500000000" end-call *> Waiting five seconds using compiler string catenation for readability call "CBL_GC_NANOSLEEP" using "500" & "0000000" end-call .. _CBLAGCAFORK: .. index:: single:CBL_GC_FORK CBL_GC_FORK ----------- \ :code:`CBL_GC_FORK`\ allows you to fork the current COBOL process to a new one. The current content of the process' storage (including \ :code:`LOCAL-STORAGE`\ ) will be identical, any file handles get invalid in the new process, positions and file / record locks are only available to the original process. This system routine is not available on Windows (exception: GCC on Cygwin). * Parameters none * Returns PID (the child process gets '\ :code:`0`\ ' returned, the calling process gets the PID of the created children). Negative values are returned for system dependent error codes and -1 if the function is not available on the current system. :: IDENTIFICATION DIVISION. PROGRAM-ID. prog. DATA DIVISION. WORKING-STORAGE SECTION. 01 CHILD-PID PIC S9(9) BINARY. 01 WAIT-STS PIC S9(9) BINARY. PROCEDURE DIVISION. CALL "CBL_GC_FORK" RETURNING CHILD-PID END-CALL EVALUATE TRUE WHEN CHILD-PID = ZERO PERFORM CHILD-CODE WHEN CHILD-PID > ZERO PERFORM PARENT-CODE WHEN CHILD-PID = -1 DISPLAY 'CBL_GC_FORK is not available ' 'on the current system!' END-DISPLAY PERFORM CHILD-CODE MOVE 0 TO CHILD-PID PERFORM PARENT-CODE WHEN OTHER MULTIPLY CHILD-PID BY -1 END-MULTIPLY DISPLAY 'CBL_GC_FORK returned system error: ' CHILD-PID END-DISPLAY END-EVALUATE STOP RUN. CHILD-CODE. CALL "C$SLEEP" USING 1 END-CALL DISPLAY "Hello, I am the child" END-DISPLAY MOVE 2 TO RETURN-CODE CONTINUE. PARENT-CODE. DISPLAY "Hello, I am the parent" END-DISPLAY CALL "CBL_GC_WAITPID" USING CHILD-PID RETURNING WAIT-STS END-CALL MOVE 0 TO RETURN-CODE EVALUATE TRUE WHEN WAIT-STS >= 0 DISPLAY 'Child ended with status: ' WAIT-STS END-DISPLAY WHEN WAIT-STS = -1 DISPLAY 'CBL_GC_WAITPID is not available ' 'on the current system!' END-DISPLAY WHEN WAIT-STS < -1 MULTIPLY -1 BY WAIT-STS END-MULTIPLY DISPLAY 'CBL_GC_WAITPID returned system error: ' WAIT-STS END-DISPLAY END-EVALUATE CONTINUE. .. _CBLAGCAWAITPID: .. index:: single:CBL_GC_WAITPID CBL_GC_WAITPID -------------- \ :code:`CBL_GC_WAITPID`\ allows you to wait until another system process ended. Additional you can check the process' return code. Parameters: none Returns: function-status / child-status Negative values are returned for system dependent error codes and -1 if the function is not available on the current system. :: CALL "CBL_GC_WAITPID" USING CHILD-PID RETURNING WAIT-STS END-CALL MOVE 0 TO RETURN-CODE DISPLAY 'CBL_GC_WAITPID ended with status: ' WAIT-STS END-DISPLAY .. _Appendices: .. _AppendixAA: