This is gcfaq.info, produced by makeinfo version 5.1 from gcfaq.texi.  File: gcfaq.info, Node: libsoup HTTP server, Prev: GNU libmicrohttpd, Up: Can GNU Cobol be used to serve HTTP? 5.63.2 libsoup HTTP server -------------------------- Vala and libsoup is another way to embed a server. Given 'soupserver.vala' // vala .10 specific. .11 changes string to uint8 array // valac -c --pkg libsoup-2.4 --thread soupserver.vala // Give the server a default void default_handler (Soup.Server server, Soup.Message msg, string path, GLib.HashTable? query, Soup.ClientContext client) { string response_text = """

Current location: %s

Test XML

Test COBOL

Tell server to exit

""".printf (path); msg.set_response ("text/html", Soup.MemoryUse.COPY, response_text, response_text.size ()); msg.set_status (Soup.KnownStatusCode.OK); } void xml_handler (Soup.Server server, Soup.Message msg, string path, GLib.HashTable? query, Soup.ClientContext client) { string response_text = "test"; msg.set_response ("text/xml", Soup.MemoryUse.COPY, response_text, response_text.size ()); } void cobol_handler (Soup.Server server, Soup.Message msg, string path, GLib.HashTable? query, Soup.ClientContext client) { string response_text = """

Current location: %s

Test XML

Home

Tell server to exit

""".printf (path); msg.set_response ("text/html", Soup.MemoryUse.COPY, response_text, response_text.size ()); msg.set_status (Soup.KnownStatusCode.OK); } void exit_handler (Soup.Server server, Soup.Message msg, string path, GLib.HashTable? query, Soup.ClientContext client) { server.quit(); } int CBL_OC_SOUPSERVER(ref Soup.Server* ss, int port) { var server = new Soup.Server(Soup.SERVER_PORT, port); server.add_handler("/", default_handler); server.add_handler("/xml", xml_handler); server.add_handler("/cobol", cobol_handler); server.add_handler("/exit", exit_handler); ss = (owned)server; stdout.printf("ss: %X\n", (uint)ss); return 0; } int CBL_OC_SOUPRUN(Soup.Server ss) { ss.run(); return 0; } and *ocsoup.cob* OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 20101205 *> Purpose: An HTTP server with libsoup *> Tectonics: valac -c --pkg libsoup-2.4 --thread soupserver.vala *> cobc -x ocsoup.cob soupserver.vala.o -lglib-2.0 *> -lsoup-2.4 -lgobject-2.0 *> *************************************************************** identification division. program-id. ocsoup. data division. working-storage section. 01 soup-server usage pointer. 01 port usage binary-long value 8088. 01 result usage binary-long. *> *************************************************************** procedure division. call "g_type_init" end-call display "Initialize soup HTTP server on port " port end-display call "CBL_OC_SOUPSERVER" using by reference soup-server by value port returning result end-call display "Result: " result " Server at: " soup-server end-display display "About to run server, ^C to terminate" end-display call "CBL_OC_SOUPRUN" using by value soup-server returning result end-call goback. end program ocsoup. and a little bash $ valac -c --pkg libsoup-2.4 --thread soupserver.vala $ ... some warnings about unused methods ... $ cobc -x ocsoup.cob soupserver.vala.o -lglib-2.0 -lsoup-2.4 -lgobject-2.0 $ ./ocsoup Initialize soup HTTP server on port +0000008088 ss: 21CF060 Result: +0000000000 Server at: 0x00000000021cf060 About to run server, ^C to terminate You get RESTful screen shots like... [image src="images/ocsouphome.png" alt="ocsouphome.png"] (opencobol.org_) [image src="images/ocsoupxml.png" alt="ocsoupxml.png"] (opencobol.org_) [image src="images/ocsoupcobol.png" alt="ocsoupcobol.png"] (opencobol.org_) The next steps are getting the add_handler callbacks into COBOL, and then play with the template and replace model.  File: gcfaq.info, Node: Is there a good SCM tool for GNU Cobol?, Next: Does GNU Cobol interface with FORTRAN?, Prev: Can GNU Cobol be used to serve HTTP?, Up: Features and extensions 5.64 Is there a good SCM tool for GNU Cobol? ============================================ In this author's opinion, yes. *Fossil*. Where SCM (http://en.wikipedia.org/wiki/Software_configuration_management) is _Software Configuration Management_, and not simply _Source Code Management_, which Fossil does quite well. See the Fossil (http://www.fossil-scm.org) site, snag a tar ball, make, and move the binary to /usr/bin. Then, to start up your next GNU Cobol COBOL project: # Create the fossil distributed repository $ mkdir ~/fossils $ cd ~/fossils $ fossil new nextbigthing.fossil # Serve it up on the localhost port 8080 $ fossil server . & # browse to the admin panel and do a little nicey nice config $ opera http://localhost:8080/nextbigthing # set up the working copy $ cd ~/projects $ mkdir nextbigthing $ cd nextbigthing $ fossil clone http://localhost:8080/nextbigthing nbt.fossil # now look at the shiny copy of nextbig $ ls $ vi nextbigthing.cob $ fossil add nextbigthing.cob $ fossil ci -m "On to the next big thing" # browse to the repo and create some wiki pages for morale boosting $ opera http://localhost:8080/nextbigthing # compile and run the next big thing $ cobc -x nextbigthing.cob $ ./nextbigthing # browse again, and create the bug tickets $ opera http://localhost:8080/nextbigthing/tktnew Ahh, morale boosting bugs. :) [image src="images/fossiltktnew.png" alt="Fossil"] (fossil_) The fans of GNU Cobol have posted a few Fossils at for an experimental build of GNU Cobol with support for ACCEPT var FROM HTTP-POST identifier and where there is a stash of short GNU Cobol source code samples. Access with: $ fossil clone http://user:password@fossile.plpwebs.com/ocsamples.cgi my.fossil $ fossil open my.fossil If you don't have a username and password it'll simply be: $ fossil clone http://fossile.plpwebs.com/ocsamples.cgi my.fossil  File: gcfaq.info, Node: Does GNU Cobol interface with FORTRAN?, Next: Does GNU Cobol interface with APL?, Prev: Is there a good SCM tool for GNU Cobol?, Up: Features and extensions 5.65 Does GNU Cobol interface with FORTRAN? =========================================== Yes. Quite well in the GNU land. Snuggled away at is a color unit converter; RGB to HLS, HSV to RGB, etc... And with a simple Makefile ala all: rgbcobol libcolors.so: colors.for gfortran -ffree-form -shared -fPIC -o libcolors.so colors.for rgbcobol: rgbcobol.cob libcolors.so cobc -g -debug -x rgbcobol.cob -lcolors -L . and some COBOL OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 20110411 *> Purpose: Call a FORTRAN color unit converter, rgb, hsv, ... *> Tectonics: gfortran -ffree-form -shared -fPIC *> -o libcolors.so colors.for *> cobc -x rgbcobol.cob -lcolors -L . *> *************************************************************** identification division. program-id. rgbcobol. data division. working-storage section. 01 r usage float-short. 01 g usage float-short. 01 b usage float-short. 01 h usage float-short value 12.21. 01 l usage float-short value 21.12. 01 s usage float-short value 23.32. 01 st usage binary-long. *> *************************************************************** procedure division. move 000.0 to h move 050.0 to l move 100.0 to s display "Calling FORTRAN with " h space l space s end-display call "jucolor_" using 'hls', h, l, s, 'rgb', r, g, b, st end-call display "Returned " r space g space b end-display display "Status of " st end-display call "showit_" end-call goback. end program rgbcobol. which produces: [btiffin@home fortran]$ ./rgbcobol Calling FORTRAN with 0.000000000000000000 50.000000000000000000 100.000000000000000000 inside jucolor_: 0.0000000 0.0000000 50.000000 0.0000000 100.00000 0.0000000 Returned 100.000000000000000000 0.000000000000000000 0.000000000000000000 Status of +0000000000 inside jucolor_: 0.0000000 0.0000000 50.000000 595.19684 100.00000 4.57103559E-41 INPUT HLS PURE RED ==> OUTPUT RGB values are 100.00000 0.0000000 0.0000000 ================================================================================ inside jucolor_: 120.00000 100.00000 50.000000 0.0000000 100.00000 0.0000000 INPUT HLS PURE GREEN OUTPUT RGB values are 0.0000000 100.00000 0.0000000 ================================================================================ inside jucolor_: 240.00000 0.0000000 50.000000 100.00000 100.00000 0.0000000 INPUT HLS PURE BLUE OUTPUT RGB values are 0.0000000 0.0000000 100.00000 ================================================================================ inside jucolor_: 100.00000 0.0000000 0.0000000 0.0000000 0.0000000 0.0000000 INPUT RGB PURE RED OUTPUT HLS values are 0.0000000 50.000000 100.00000 ================================================================================ inside jucolor_: 0.0000000 0.0000000 100.00000 50.000000 0.0000000 100.00000 INPUT RGB PURE GREEN OUTPUT HLS values are 120.00000 50.000000 100.00000 ================================================================================ inside jucolor_: 0.0000000 120.00000 0.0000000 50.000000 100.00000 100.00000 INPUT RGB PURE BLUE OUTPUT HLS values are 240.00000 50.000000 100.00000 values are 240.00000 50.000000 100.00000 ================================================================================ The weird numbers on the second "inside jucolor_" are uninitialized gfortran variables, displayed before being set, not great, but safe enough for a one off.  File: gcfaq.info, Node: Does GNU Cobol interface with APL?, Next: Does GNU Cobol interface with J?, Prev: Does GNU Cobol interface with FORTRAN?, Up: Features and extensions 5.66 Does GNU Cobol interface with APL? ======================================= See Does GNU Cobol interface with J?_  File: gcfaq.info, Node: Does GNU Cobol interface with J?, Next: What is COBOLUnit?, Prev: Does GNU Cobol interface with APL?, Up: Features and extensions 5.67 Does GNU Cobol interface with J? ===================================== Yes, kinda. Jsoftware recently posted GPL 3 licensed source code for the J programming language. J is designed in part by one of the creators of APL, Eric Iverson. Initial tests have proven successful but there is more work before integration with *libj* in GNU Cobol is ready for prime-time. OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 20110711 *> Purpose: Attempt calling a J sentence. APL in COBOL. *> Tectonics: cobc -x callj.cob -lj *> *************************************************************** identification division. program-id. callj. data division. working-storage section. 77 jptr usage pointer. 77 result usage binary-long. *> *************************************************************** procedure division. call "JInit" returning jptr end-call display jptr end-display call "JDo" using by value jptr by content z"a =. 1 + 1" returning result end-call display result end-display call "JDo" using by value jptr by content z"2 + 2" returning result end-call display result end-display call "JDo" using by value jptr by content z"('Test Data',CR,LF) 1!:2 <'temp.dat'" returning result end-call display result end-display call "JDo" using by value jptr by content z"load 'jgplsrc/test/test.ijs'" returning result end-call display result end-display call "JDo" using by value jptr by content z"bad=: TEST ddall" returning result end-call display result end-display call "JDo" using by value jptr by content z"BAD ddall" returning result end-call display result end-display goback. end program callj. produces: $ cobc -x callj.cob -lj $ ./callj 0x00007f3b6ead7010 +0000000000 +0000000000 +0000000003 +0000000021 +0000000000 +0000000000 So libj inits, and can JDo J sentences, but there is a little more background effort to properly set J I/O and PATH settings into an array of callbacks. Doable, just have to ask the good folk at Jsoftware for a little assistance. More coming soon. The GPL 3 J version 7.01b source code can be found at Compiling the sources took a little reading, but built clean on 64bit Fedora 14 after a quick edit of jgplsrc/bin/jconfig. Needed to set BITS to 64 and added readline support, as command line recall is more fun than no command line recall when running *jconsole*. After that bin/build_libj bin/build_jconsole all went smooth as silk. *libj.so* was copied to /usr/lib64 and the above code compiled and linked just fine. As did: $ bin/build_defs $ bin/build_tsdll A test suite validates a J system. Read test/test.ijs and test/tsu.ijs for more info. $ j/bin/jconsole load 'test/test.ijs' bad=: TEST ddall NB. run all tests BAD ddall NB. report tests that failed with a full test suite pass, all successful. Once the callbacks are properly installed in the sample GNU Cobol above, I'm sure the error 3 will be resolved for 1:!2 write to file as well as running the test suite from within JDo, which currently reports error 21. The above GNU Cobol listing is the poor man's 10 minute guide to integrating J.  File: gcfaq.info, Node: What is COBOLUnit?, Next: Can GNU Cobol interface with Gambas?, Prev: Does GNU Cobol interface with J?, Up: Features and extensions 5.68 What is COBOLUnit? ======================= A well documented, full featured Unit testing framework for COBOL, written in GNU Cobol with a GPL license. * Tutorials * Installation instructions, with videos * Open sources Test suite configuration files look like: SUITE-DELIVERY-COST Tests Suite for delivery costs * Add a test FRANCE-TO-ITALY TS000011 IF FROM='FR' and TO='IT' then TAXES=120€ and _with the scaffolding in place_, a success report looking like: *************************************************************************** COBOL UNIT : A COBOL FRAMEWORK FOR UNIT TESTS. *************************************************************************** COBOL UNIT Current release : REL 1.00 COBOL UNIT Release date : 2009-10-31 Language used for Logging : EN Verbosity Level of Log : 1 End of the 'Testing Strategy Set up' Phase Starting the 'Test Execution' Phase |--- SUITE ' SUITE-DELIVERY-COST ' Running |--- | TEST ' FRANCE-TO-ITALY ' Running | |- Assert ' FR => IT:TAX=120 ' success | |==> Test ' FRANCE-TO-ITALY ' * SUCCESS * ( 000000001 Assertions, 000000000 Failures, 0 errors). |==> SUITE ' SUITE-DELIVERY-COST ' SUCCESS ( 000000000 test cases, 000000001 success, 000000000 failures, 000000000 errors) *************************************************************************** * SUCCESS * ( 000000001 Suites run, 000000001 succeed, 000000000 failed) *************************************************************************** ( 00 min: 00 sec: 00 ms)  File: gcfaq.info, Node: Can GNU Cobol interface with Gambas?, Next: Does GNU Cobol work with LLVM?, Prev: What is COBOLUnit?, Up: Features and extensions 5.69 Can GNU Cobol interface with Gambas? ========================================= Yes. See for a working sample. As a taster, the Gambas () sample calls GNU Cobol coded as OCOBOL ENTRY "startGrid". MOVE FCHIUSO TO GRID-FILE-STATE. ACCEPT SOLODATA FROM DATE YYYYMMDD. ACCEPT ORA FROM TIME. MOVE DATAEORA TO STARTINGPOINT, PRMR-KEY-OF-LIGNE (GAP), DATAEORA-KR. PERFORM RWDWN. MOVE 0 TO RETURN-CODE. GOBACK. ENTRY "fillrow" USING BY REFERENCE pRiga, BY VALUE numRiga. ADD 1 TO numRiga. MOVE SUPER-LIGNE-PMP (numRiga) TO ROW-OUT. SET pRiga TO ADDRESS OF ROW-OUT. MOVE 0 TO RETURN-CODE. GOBACK. which this author found to be a pretty neat way of packaging GNU Cobol _other language_ callables. The Gambas is nicely clean. Below being a snippet from the sample. Extern cob_init(argc As Integer, argv As Integer) As Integer In "libcob" Extern startGrid() As Integer In "SCONTO:69"  File: gcfaq.info, Node: Does GNU Cobol work with LLVM?, Next: Does GNU Cobol interface with Python?, Prev: Can GNU Cobol interface with Gambas?, Up: Features and extensions 5.70 Does GNU Cobol work with LLVM? =================================== Yes. Almost first try for the February 2009 pre-release of 1.1. The compiler sources has a conditional use of a -fno-gcse switch that tripped warnings in clang causing some unit test failure reports. One change to compile out the -fno-gcse in cobc/cobc.c, and a simple: $ sudo yum install llvm clang clang-analyzer clang-devel $ export CC=clang $ ./configure GNU Cobol Configuration: CC clang COB_CC clang CFLAGS -O2 COB_CFLAGS -I/usr/local/include COB_EXTRA_FLAGS LDFLAGS COB_LDFLAGS COB_LIBS -L${exec_prefix}/lib -lcob -lm -lgmp -lncurses -ldb COB_CONFIG_DIR ${prefix}/share/open-cobol/config COB_COPY_DIR ${prefix}/share/open-cobol/copy COB_LIBRARY_PATH ${exec_prefix}/lib/open-cobol COB_MODULE_EXT so COB_SHARED_OPT -shared COB_PIC_FLAGS -fPIC -DPIC COB_EXPORT_DYN -Wl,--export-dynamic COB_STRIP_CMD strip --strip-unneeded Dynamic loading System $ scan-build make scan-build: Removing directory '/tmp/scan-build-2012-05-23-2' because it contains no reports. $ make check # I had to make one change to cobc/cobc.c to remove -fno-gcse to avoid a # bunch of make check 'failures' due to a warning about unused -fno-gcse $ sudo make install $ sudo ldconfig # cobc is built with clang, and uses clang when compiling # the .c generated from the .cob. [btiffin@cobol]$ scan-build cobc -v -x hello.cob scan-build: 'clang' executable not found in '/usr/lib64/clang-analyzer/scan-build/bin'. scan-build: Using 'clang' from path: /usr/bin/clang preprocessing hello.cob into /tmp/cob18158_0.cob translating /tmp/cob18158_0.cob into /tmp/cob18158_0.c clang -pipe -c -I/usr/local/include -Wno-unused -fsigned-char -Wno-pointer-sign -o /tmp/cob18158_0.o /tmp/cob18158_0.c clang -pipe -Wl,--export-dynamic -o hello /tmp/cob18158_0.o -L/usr/local/lib -lcob -lm -lgmp -lncurses -ldb scan-build: Removing directory '/tmp/scan-build-2012-05-23-2' because it contains no reports. [btiffin@cobol]$ ./hello Hello [btiffin@cobol]$ ls -la hello -rwxrwxr-x. 1 btiffin btiffin 9630 May 23 12:37 hello And GNU Cobol is good to go with clang and the LLVM universe. The above compiles GNU Cobol with clang, and the installed cobc will use clang as the compiler after processing the COBOL sources. This is grand news in terms of anyone worried about GNU Cobol viability into the future. The existent C ABI space and now the growing LLVM software pool. Nice.  File: gcfaq.info, Node: Does GNU Cobol interface with Python?, Next: Can GNU Cobol interface with Forth?, Prev: Does GNU Cobol work with LLVM?, Up: Features and extensions 5.71 Does GNU Cobol interface with Python? ========================================== Yes. Embedding Python can be accomplished using purely COBOL sources. Extending Python, to allow calling COBOL modules, will usually require a small amount of glue code written in C. Very high level Python embedding is pretty straight forward, been there, done that. OCOBOL >>SOURCE FORMAT IS FIXED *> ******************************************************* *> Author: Brian Tiffin *> Date: 20130126 *> Purpose: Embed Python *> Tectonics: cobc -x cobpy.cob -lpython2.6 *> ******************************************************* identification division. program-id. cobpy. procedure division. call "Py_Initialize" on exception display "link cobpy with -lpython2.6" end-display end-call call "PyRun_SimpleString" using by reference "from time import time,ctime" & x"0a" & "print('Today is', ctime(time()))" & x"0a" & x"00" on exception continue end-call call "Py_Finalize" end-call goback. end program cobpy. Giving: $ cobc -x cobpy.cob -lpython2.6 $ ./cobpy ('Today is', 'Sat Jan 26 20:01:41 2013') Python dutifully displayed the tuple. But what fun is Python if it is just for high level script side effects? Lots, but still. Pure embedding. OCOBOL >>SOURCE FORMAT IS FIXED *> ******************************************************* *> Author: Brian Tiffin *> Date: 20130126 *> Purpose: Embed Python *> Tectonics: cobc -x cobkat.cob -lpython2.6 *> NOTES: leaks, no Py_DECREF macros called. *> ******************************************************* identification division. program-id. cobkat. data division. working-storage section. 77 python-name usage pointer. 77 python-module usage pointer. 77 python-dict usage pointer. 77 python-func usage pointer. 77 python-stringer usage pointer. 77 python-args usage pointer. 77 python-value usage pointer. 01 cobol-buffer-pointer usage pointer. 01 cobol-buffer pic x(80) based. 01 cobol-string pic x(80). 01 cobol-integer usage binary-long. 01 command-line-args pic x(80). *> ******************************************************* procedure division. call "Py_Initialize" on exception display "link cobpy with -lpython" end-display end-call *> Python likes module names in Unicode call "PyUnicodeUCS4_FromString" using by reference "pythonfile" & x"00" returning python-name on exception display "unicode problem" end-display end-call *> import the module, using PYTHONPATH call "PyImport_Import" using by value python-name returning python-module on exception display "this would be borked" end-display end-call if python-module equal null display "no pythonfile.py in PYTHONPATH" end-display end-if *> within the module, an attribute is "pythonfunction" call "PyObject_GetAttrString" using by value python-module by reference "pythonfunction" & x"00" returning python-func on exception continue end-call *> *> error handling now skimped out on *> *> pythonfunction takes a single argument call "PyTuple_New" using by value 1 returning python-args end-call *> of type long, hard coded to the ultimate answer call "PyLong_FromLong" using by value 42 returning python-value end-call *> set first (only) element of the argument tuple call "PyTuple_SetItem" using by value python-args by value 0 by value python-value end-call *> call the function, arguments marshalled for Python call "PyObject_CallObject" using by value python-func by value python-args returning python-value end-call *> we know we get a long back, hopefully 1764 call "PyLong_AsLong" using by value python-value returning cobol-integer end-call display "Python returned: " cobol-integer end-display *> **************************************************** *< *> a function taking string and returning string call "PyObject_GetAttrString" using by value python-module by reference "pythonstringer" & x"00" returning python-stringer end-call call "PyTuple_New" using by value 1 returning python-args end-call *> Use the GNU Cobol command argument accept command-line-args from command-line end-accept call "PyString_FromString" using by reference function concatenate( function trim(command-line-args) x"00") returning python-value end-call *> Set the function argument tuple to the cli args call "PyTuple_SetItem" using by value python-args by value 0 by value python-value end-call *> call the "pythonstringer" function call "PyObject_CallObject" using by value python-stringer by value python-args returning python-value end-call *> return as String (with the MD5 hex digest tacked on) call "PyString_AsString" using by value python-value returning cobol-buffer-pointer end-call *> one way of removing null while pulling data out of C set address of cobol-buffer to cobol-buffer-pointer string cobol-buffer delimited by x"00" into cobol-string end-string display "Python returned: " cobol-string end-display *> and clear out <* call "Py_Finalize" end-call goback. end program cobkat. with *pythonfile.py* # # Simple Python sample for GNU Cobol embedding trial # def pythonfunction(i): return i * i import hashlib def pythonstringer(s): sum = hashlib.md5() sum.update(s) return s + ": " + sum.hexdigest() Giving: $ ./cobkat Python will use this for MD5 hash no pythonfile.py in PYTHONPATH Attempt to reference unallocated memory (Signal SIGSEGV) Abnormal termination - File contents may be incorrect Oops: $ export PYTHONPATH=. $ ./cobkat Python will use this for MD5 hash Python returned: +0000001764 Python returned: Python will use this for MD5 hash: c5577e3ab8dea11adede20a1949b5fb3 _Oh, in case you're reading along, 1764 is the ultimate answer, squared._ A GNU Cobol source line of set environment "PYTHONPATH" to "." before 'Py_Initialize', saves on the oops when you need to find current working directory Python scripts.  File: gcfaq.info, Node: Can GNU Cobol interface with Forth?, Next: Can GNU Cobol interface with Shakespeare?, Prev: Does GNU Cobol interface with Python?, Up: Features and extensions 5.72 Can GNU Cobol interface with Forth? ======================================== Yes, ficl, Forth Inspired Command Language embeds nicely. _Ok, I said, easy, I meant almost easy, as I had to hunt down a sysdep.h file and could not get 4.10 to go, but 4.0.31 works the beauty, once the sysdep.h was put in place._ First, the license compliance. /******************************************************* ** f i c l . h ** Forth Inspired Command Language ** Author: John Sadler (john_sadler@alum.mit.edu) ** Created: 19 July 1997 ** Dedicated to RHS, in loving memory ** $Id: //depot/gamejones/ficl/ficl.h#33 $ ******************************************************** ** ** Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu) ** All rights reserved. ** ** Get the latest Ficl release at http://ficl.sourceforge.net ** ** I am interested in hearing from anyone who uses Ficl. If you have ** a problem, a success story, a defect, an enhancement request, or ** if you would like to contribute to the Ficl release, please ** contact me by email at the address above. ** ** L I C E N S E and D I S C L A I M E R ** ** Redistribution and use in source and binary forms, with or without ** modification, are permitted provided that the following conditions ** are met: ** 1. Redistributions of source code must retain the above copyright ** notice, this list of conditions and the following disclaimer. ** 2. Redistributions in binary form must reproduce the above copyright ** notice, this list of conditions and the following disclaimer in the ** documentation and/or other materials provided with the distribution. ** ** THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND ** ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE ** IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ** ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE ** FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ** DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS ** OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) ** HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT ** LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY ** OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF ** SUCH DAMAGE. */ And then the COBOL, *callficl.cob* OCOBOL >>SOURCE FORMAT IS FIXED *> ****************************************************** *> Author: Brian Tiffin *> Date: 20130220 *> Purpose: Embed ficl *> Tectonics: cobc -x callficl.cob -lficl -L. *> LD_LIBRARY_PATH=. ./callficl *> ****************************************************** identification division. program-id. callficl. data division. working-storage section. 01 ficl-result usage binary-long. 01 ficl-system usage pointer. 01 ficl-vm usage pointer. *> ****************************************************** procedure division. call "ficlSystemCreate" using by value 0 returning ficl-system end-call display ficl-system end-display call "ficlSystemCompileExtras" using by value ficl-system end-call call "ficlSystemCreateVm" using by value ficl-system returning ficl-vm end-call display ficl-vm end-display call "ficlVmEvaluate" using by value ficl-vm by reference ".ver cr quit" & x"00" returning ficl-result end-call display ficl-result end-display call "ficlVmEvaluate" using by value ficl-vm by reference ".( loading ooptest.fr ) cr load ooptest.fr" & x"0a" & " cr" & x"00" returning ficl-result end-call display ficl-result end-display goback. end program callficl. and the test file *ooptest.fr* \ OOP test stuff only also oop definitions object subclass c-aggregate c-byte obj: m0 c-byte obj: m1 c-4byte obj: m2 c-2byte obj: m3 end-class object --> sub class1 cell: .a cell: .b : init locals| class inst | 0 inst class --> .a ! 1 inst class --> .b ! ; end-class class1 --> new c1inst class1 --> sub class2 cell: .c cell: .d : init locals| class inst | inst class --> super --> init 2 inst class --> .c ! 3 inst class --> .d ! ; end-class class2 --> new c2inst object subclass c-list c-list ref: link c-ref obj: payload end-class \ test stuff from ficl.html .( metaclass methods ) cr metaclass --> methods cr .( c-foo class ) cr object --> sub c-foo cell: m_cell1 4 chars: m_chars : init ( inst class -- ) locals| class inst | 0 inst class --> m_cell1 ! inst class --> m_chars 4 0 fill ." initializing an instance of c_foo at " inst x. cr ; end-class .( c-foo instance methods... ) cr c-foo --> new foo-instance cr foo-instance --> methods foo-instance --> pedigree cr foo-instance 2dup --> methods --> pedigree cr c-foo --> see init cr foo-instance --> class --> see init and finally, *the run*. The first two commands building up ficl and the libficl shared library, the next two for COBOL: $ make -f Makefile.linux $ make -f Makefile.linux main $ cobc -g -debug -x callficl.cob -lficl -L . $ LD_LIBRARY_PATH=. ./callficl loading CORE EXT words loading SEARCH & SEARCH-EXT words loading Johns-Hopkins locals loading MARKER loading ficl O-O extensions loading ficl utility classes loading ficl string class 0x080569c0 0x08057928 Ficl version 4.0.31 -0000000056 loading ooptest.fr metaclass methods metaclassmethods: debug see pedigree methods id offset-of sub resume-class ref allot-array allot alloc-array alloc new-array new array instance get-super get-wid get-size .size .wid .super .do-instance Dictionary: 24 words, 7786 cells used of 12288 total c-foo class c-foo instance methods... initializing an instance of c_foo at 806043C c-foomethods: init m_chars m_cell1 .do-instance Dictionary: 4 words, 7893 cells used of 12288 total objectmethods: debug prev next index methods size pedigree super free array-init init class .do-instance Dictionary: 13 words, 7893 cells used of 12288 total c-foo object c-foomethods: init m_chars m_cell1 .do-instance Dictionary: 4 words, 7893 cells used of 12288 total objectmethods: debug prev next index methods size pedigree super free array-init init class .do-instance Dictionary: 13 words, 7893 cells used of 12288 total c-foo object : init 0 (link) (instruction 136) 1 2 (instruction 2) 2 (toLocal) (instruction 140), with argument 0 (0) 4 (toLocal) (instruction 140), with argument 1 (0x1) 6 0 (instruction 17) 7 (@local1) (instruction 146) 8 (@local0) (instruction 142) 9 s" m_cell1" 13 exec-method 14 ! (instruction 57) 15 (@local1) (instruction 146) 16 (@local0) (instruction 142) 17 s" m_chars" 21 exec-method 22 4 (instruction 4) 23 0 (instruction 17) 24 fill (instruction 111) 25 s" initializing an instance of c_foo at " 36 type 37 (@local1) (instruction 146) 38 x. 39 cr 40 (unlink) (instruction 137) ; : init 0 (link) (instruction 136) 1 2 (instruction 2) 2 (toLocal) (instruction 140), with argument 0 (0) 4 (toLocal) (instruction 140), with argument 1 (0x1) 6 0 (instruction 17) 7 (@local1) (instruction 146) 8 (@local0) (instruction 142) 9 s" m_cell1" 13 exec-method 14 ! (instruction 57) 15 (@local1) (instruction 146) 16 (@local0) (instruction 142) 17 s" m_chars" 21 exec-method 22 4 (instruction 4) 23 0 (instruction 17) 24 fill (instruction 111) 25 s" initializing an instance of c_foo at " 36 type 37 (@local1) (instruction 146) 38 x. 39 cr 40 (unlink) (instruction 137) ; -0000000257 Turns out that return codes -56 and -257 are ok codes, (from *ficl.h*): #define FICL_VM_STATUS_QUIT ( -56) /* like FICL_VM_STATUS_ERROR_EXIT, but leave dataStack & base alone */ #define FICL_VM_STATUS_OUT_OF_TEXT (-257) /* hungry - normal exit */ GNU Cobol does Forth. _p.s. One small note. The ficl load word, load ooptest.fr needed a newline after the filename. Normally Forth uses a straight up space delimited word parser, but ficl accounts for filenames with spaces in them. Nice feature._  File: gcfaq.info, Node: Can GNU Cobol interface with Shakespeare?, Next: Can GNU Cobol interface with Ruby?, Prev: Can GNU Cobol interface with Forth?, Up: Features and extensions 5.73 Can GNU Cobol interface with Shakespeare? ============================================== Yes. The reference implementation of the Shakespeare Programming Language builds into GNU Cobol applications that can CALL SPL modules. Technicals: I downloaded Marlowe which fixes the reference implementation problem with Roman Numerals. Then inside a working dir (_/lang/cobol/cobill/_ for instance) create spl, untar, and make SPL. _I assume the spl/ sub directory in the Makefile listed below_. What is happening here isn't runtime link loading, it is simply building the SPL engine into COBOL, and then CALL the result of *spl2c*. This first cut *lacks art*. Lacks. Sad, so verily verily sad. *cobill.cob* OCOBOL*> ******************************************************* *> Author: Brian Tiffin *> Date: 20130224 *> Purpose: COBOL meets Shakespeare *> Tectonics: cobc -x -Ispl cobill.cob ocshake.c *> spl/libspl.c spl/strutils.c *> pre-req: spl2c ocshake.spl and an spl/ distribution *> ******************************************************* identification division. program-id. cobill. procedure division. call "ocshake" end-call goback. end program cobill. Then some cowardly SPL, *ocshake.spl* The derp in SPL from GNU Cobol. Ajax, the loud mouth. Dorcas, the d. Escalus, the e. Rosalind, the r. Prospero, the p. The Archbishop of Canterbury, the new line. Act I: derping. Scene I: derp. [Enter Ajax and Dorcas] Ajax: You amazing beautiful fine charming gentle delicious door. You are as honest as the sum of a bold brave hard proud noble stone wall and thyself. You are as trustworthy as the sum of a proud rich tree and thyself. Speak your mind. [Exit Dorcas] [Enter Escalus] Ajax: You bluest peaceful smooth lovely warm embroidered summer's day. You are as beautiful as the sum of a fine honest fair sweet gentle wind and thyself. You are as lovely as the sum of a reddest sunny flower and thyself. You are as mighty as the sum of the sky and thyself. Speak your mind. [Exit Escalus] [Enter Rosalind] Ajax: You fair reddest sweet rich smooth blossoming red rose. You are as rich as the difference between thyself and a golden gentle clearest wind. You are as rich as the difference between thyself and a proud white lantern. You are as rich as the difference between thyself and a honest morning. Speak your mind. [Exit Rosalind] [Enter Prospero] Ajax: You proud prompt pretty loving gentle warm purple pony. You are as bold as the difference between thyself and an amazing cute delicious pretty purse. Speak your mind. [Exeunt] Scene II: a new line. [Enter Ajax and The Archbishop of Canterbury] Ajax: You are nothing. You are a bold beautiful blossoming wind. You are as cunning as the sum of thyself and a tiny thing. Speak your mind! [Exeunt] A *Makefile* of: cobill: ocshake.spl cobill.cob spl/spl2c ocshake.c sed -i 's/int main(void)/int ocshake(void)/' ocshake.c cobc -x -Ispl cobill.cob ocshake.c spl/libspl.c spl/strutils.c Then a run of: $ make spl/spl2c ocshake.c sed -i 's/int main(void)/int ocshake(void)/' ocshake.c cobc -x -Ispl cobill.cob ocshake.c spl/libspl.c spl/strutils.c $ ./cobill derp $ *derp*, in a 20K binary, from 2K of source. _I am kinda proud of Scene II, that one reads well. The rest needs some Fahrenheit 451_  File: gcfaq.info, Node: Can GNU Cobol interface with Ruby?, Next: Can GNU Cobol interface with Pure?, Prev: Can GNU Cobol interface with Shakespeare?, Up: Features and extensions 5.74 Can GNU Cobol interface with Ruby? ======================================= Yes. Ruby 1.8 links without issue. _This example is only calling Ruby for side effect, without data exchange._ OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 20130226 *> Purpose: Embed Ruby for effect, no data exchange yet *> Tectonics: cobc -x callruby.cob -lruby1.8 *> *************************************************************** identification division. program-id. callruby. procedure division. display "GNU Cobol: initialize ruby" end-display call "ruby_init" on exception display "hint: link with -lruby1.8" end-display stop run giving 1 end-call display "GNU Cobol: evaluate ruby string" end-display call "rb_eval_string" using by content "puts 'Hello, world'" & x"00" end-call display "GNU Cobol: evaluate ruby script.rb" end-display call "ruby_init_loadpath" end-call call "rb_load_file" using by content "script.rb" & x"00" end-call call "ruby_exec" end-call call "ruby_finalize" end-call display "GNU Cobol: finalized ruby" end-display goback. end program callruby. and *script.rb* puts 'Hello, script' puts 6*7 puts 'Goodbye, script' and a run test of: $ cobc -x callruby.cob $ ./callruby GNU Cobol: initialize ruby hint: link with -lruby1.8 $ cobc -x callruby.cob -lruby1.8 $ ./callruby GNU Cobol: initialize ruby GNU Cobol: evaluate ruby string Hello, world GNU Cobol: evaluate ruby script.rb Hello, script 42 Goodbye, script GNU Cobol: finalized ruby  File: gcfaq.info, Node: Can GNU Cobol interface with Pure?, Next: Can GNU Cobol process null terminated strings?, Prev: Can GNU Cobol interface with Ruby?, Up: Features and extensions 5.75 Can GNU Cobol interface with Pure? ======================================= Yes. Yes it can. Pure is a term rewriting functional programming language by Albert Graef. Influenced by Haskell, the system generates C code as part of the just in time compiler. The successor of Q. Given a Fedora with LLVM installed, and a: $ sudo yum install pure pure-devel pure-gen pure-doc Below is a little test program, to see if pure can call GNU Cobol *hellooc.pure* #!/usr/bin/pure -x using system; puts "Hello, world"; using "lib:hellocobol"; extern int hellocobol(); hellocobol; And a little snippet of COBOL introduction *hellocobol.cob* OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************** *> Author: Brian Tiffin *> Date: 20130612 *> Purpose: Call this COBOL program from pure *> Tectonics: cobc -fimplicit-init hellocobol.cob *> pure -L. hellooc.pure *> *************************************************** identification division. program-id. hellocobol. procedure division. display "S'up?" end-display goback. end program hellocobol. With a first try of: $ cobc hellocobol.cob $ pure -L. hellooc.pure Hello, world Segmentation fault Oops. Kept the error above in, to show the fix. The object code needs to initialize GNU Cobol: $ cobc -fimplicit-init hellocobol.cob $ pure -L. hellooc.pure Hello, world S'up? Yayy, success one. Pure can call GNU Cobol. And then to leverage Pure power from GNU Cobol, _as things should be, power balance wise_. OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************** *> Author: Brian Tiffin *> Date: 20130612 *> Purpose: Call pure. Nice. *> Tectonics: pure -o hello.o -c -x hello.pure 8 * cobc -x callpurefact.cob hello.o -lpure *> *************************************************** identification division. program-id. callpurefact. data division. working-storage section. 01 pure-arg-pointer usage pointer. 01 fact-function-pointer usage program-pointer. 01 fact-result-pointer usage pointer. 01 pure-result usage binary-long. 01 fact-answer usage binary-long. *> *************************************************** procedure division. *> Initialize pure, with empty argc argv. call "__pure_main__" using by value 0 by value 0 end-call *> convert a 9 to a pure expression pointer argument call "pure_int" using by value 9 returning pure-arg-pointer end-call *> resolve the link address to the function, "fact" set fact-function-pointer to entry "fact" *> call the pure function "fact" *> using the program pointer *> 1 as the number of argumments *> the address of the argument expression *> returing a result expression pointer call "pure_funcall" using by value fact-function-pointer by value 1 by value pure-arg-pointer returning fact-result-pointer end-call *> convert the result expression back to integer call "pure_is_int" using by value fact-result-pointer by reference fact-answer returning pure-result end-call display "fact 9 should be 362880" end-display display "fact 9 result is " fact-answer end-display goback. end program callpurefact. *><* Below is the tutorial hello program for Pure. 'pure' is used to compile this, and in this example, is passed an initial argument of 8 for the ubiquitous factorial functional hello. GNU Cobol will call this main, mapping out 8 factorial results, then will call the defined 'fact' function with an argument of 9. *hello.pure* using system; fact n = if n>0 then n*fact (n-1) else 1; main n = do puts ["Hello, world!", str (map fact (1..n))]; const n = if argc>1 then sscanf (argv!1) "%d" else 10; if compiling then () else main n; And then: $ pure -o hello.o -c -x hello.pure 8 $ cobc -g -debug -W -x callpurefact.cob -lpure hello.o $ ./callpurefact Hello, world! [1,2,6,24,120,720,5040,40320] fact 9 should be 362880 fact 9 result is +0000362880 So, yayy, success. GNU Cobol can handle 'Pure' integration. Pure looks pretty sweet. Pure at Wikipedia (http://en.wikipedia.org/wiki/Pure_(programming_language))  File: gcfaq.info, Node: Can GNU Cobol process null terminated strings?, Next: Can GNU Cobol display the process environment space?, Prev: Can GNU Cobol interface with Pure?, Up: Features and extensions 5.76 Can GNU Cobol process null terminated strings? =================================================== Yes. With care. One aspect of interfacing with C, is the indeterminant length of data blocks. C strings assume a zero null byte terminator. No need to know length before hand. This does not align with the fixed length requirements of COBOL. There are various ways to handle this situation, old, and new. A new way, for display, with BASED_ allocation, and a sliding pointer. 01 c-char-star usage pointer. 01 cobol-char pic x based. 01 previous-char pic x. call "c-function" returning c-char-star end-call if c-char-star equal null then display "all that work, for nothing?" end-display goback end-if set address of cobol-char to c-char-star if cobol-char not equal to low-value move cobol-char to previous-char perform until cobol-char equal low-value set c-char-star up by 1 set address of cobol-char to c-char-star if cobol-char equal low-value then display previous-char end-display else display previous-char with no advancing end-display move cobol-char to previous-char end-if end-perform end-if Most of that dance is to allow GNU Cobol to decide how to flush the output buffer, as there is no current support for display OMITTED end-display and there should/will be, just like ACCEPT_ which will wait and discard input. display omitted would be a buffer flush end of line without the space. _Zero length items are another issue_. There is also * z"Z quoted string literal" * "string literal with append of null" & x"00" * "string literal with append of null in most character sets" & low-value And some STRING_ code when you need COBOL working-storage_ set address of c-char-buffer to c-char-star string c-char-buffer delimited by x"00" into cobol-space end-string Note that NULL_ is NOT the same as x"00" or LOW-VALUE_  File: gcfaq.info, Node: Can GNU Cobol display the process environment space?, Next: Can GNU Cobol generate callable programs with void returns?, Prev: Can GNU Cobol process null terminated strings?, Up: Features and extensions 5.77 Can GNU Cobol display the process environment space? ========================================================= Yes, almost. One small snippet of C code is required to get at a global variable, 'char **environ'. /** * Access a C external variable for the environment space */ #include extern char **environ; char **value_of_environ() { return environ; } and then COBOL that processes the array of character string pointers. GNU >>SOURCE FORMAT IS FIXED Cobol *> ***************************************************** *> Author: Brian Tiffin *> Date: 20140321 *> Purpose: Display the process environment space *> License: This source code is placed in the Public Domain *> Tectonics: cobc -x printenv.cob value-of-environ.c *> ****************************************************** identification division. program-id. printenv. environment division. configuration section. repository. function all intrinsic. data division. working-storage section. 01 environ usage pointer. 01 envptr usage pointer based. 01 envbuf pic x(8388608) based. 01 charindex usage index. >>DEFINE WINDIR PARAMETER >>IF WINDIR IS DEFINED 01 newline pic xx value x"0d0a". >>ELSE 01 newline pic x value x"0a". >>END-IF *> ****************************************************** procedure division. call "value_of_environ" returning environ on exception display "could not get value of environ" upon syserr end-display end-call *> Dereference the pointer to the array of pointers set address of envptr to environ perform until exit if envptr equal null then exit perform end-if set address of envbuf to envptr set charindex to 1 perform until exit if envbuf(charindex:1) equal x"00" then display newline with no advancing end-display exit perform end-if display envbuf(charindex:1) with no advancing end-display set charindex up by 1 end-perform *> Point to the next envvar pointer set environ up by byte-length(environ) set address of envptr to environ end-perform goback. end program printenv. and a run sample of: $ cobc -x printenv.cob value-of-environ.c $ ./printenv XDG_VTNR=1 SSH_AGENT_PID=xxxxx XDG_SESSION_ID=1 HOSTNAME=local DM_CONTROL=/var/run/xdmctl IMSETTINGS_INTEGRATE_DESKTOP=yes GPG_AGENT_INFO=/home/btiffin/... GLADE_PIXMAP_PATH=: SHELL=/bin/bash TERM=xterm-256color XDG_MENU_PREFIX=xfce- XDG_SESSION_COOKIE=somemagicookievaluethatneednotbepublic HISTSIZE=1000 LUA_INIT=@/home/btiffin/.local/luainit.lua XDM_MANAGED=method=classic KONSOLE_DBUS_SERVICE=:1.34 KONSOLE_PROFILE_NAME=Shell PLAN9=/home/btiffin/inst/plan9port WINDOWID=2936... QTDIR=/usr/lib64/qt-3.3 GNOME_KEYRING_CONTROL=/run/user/500/keyring-idval SHELL_SESSION_ID=anothermagicvalue QTINC=/usr/lib64/qt-3.3/include IMSETTINGS_MODULE=none QT_GRAPHICSSYSTEM_CHECKED=1 USER=btiffin LS_COLORS=rs=0:di=00;34:ln=00;36:mh=00:pi=40;33:so=00;35:do=00;35: GLADE_MODULE_PATH=: SSH_AUTH_SOCK=/tmp/andanothermagicvalue SESSION_MANAGER=local/unix:@/tmp/.ICE-unix/12345,unix/unix:/tmp/.ICE-unix/12345 XDG_CONFIG_DIRS=/etc/xdg:/usr/local/etc/xdg DESKTOP_SESSION=xfce MAIL=/var/spool/mail/btiffin PATH=/usr/local/firebird/bin:/home/btiffin/inst/unicon12/bin:/home/btiffin/bin QT_IM_MODULE=xim PWD=/home/btiffin/lang/cobol XMODIFIERS=@im=none KONSOLE_DBUS_WINDOW=/Windows/2 LANG=en_US.UTF-8 GNOME_KEYRING_PID=12345 KDE_IS_PRELINKED=1 KDEDIRS=/usr KONSOLE_DBUS_SESSION=/Sessions/32 HISTCONTROL=erasedups SSH_ASKPASS=somedirectory HOME=/home/btiffin COLORFGBG=0;15 XDG_SEAT=seat0 SHLVL=3 LANGUAGE= GDL_PATH=+/usr/share/gnudatalanguage LESS=-QX LOGNAME=btiffin CVS_RSH=ssh QTLIB=/usr/lib64/qt-3.3/lib XDG_DATA_DIRS=/usr/local/share:/usr/share DBUS_SESSION_BUS_ADDRESS=unix:abstract=/tmp/andmoresensitivedata LESSOPEN=||/usr/bin/lesspipe.sh %s WINDOWPATH=1 PROFILEHOME= XDG_RUNTIME_DIR=/run/user/500 DISPLAY=:0 QT_PLUGIN_PATH=/usr/lib64/kde4/plugins:/usr/lib/kde4/plugins GLADE_CATALOG_PATH=: XAUTHORITY=/tmp/.Xauth... CCACHE_HASHDIR= _=./printenv OLDPWD=/home/btiffin/lang  File: gcfaq.info, Node: Can GNU Cobol generate callable programs with void returns?, Prev: Can GNU Cobol display the process environment space?, Up: Features and extensions 5.78 Can GNU Cobol generate callable programs with void returns? ================================================================ No. There is currently no support for syntax such as PROCEDURE DIVISION RETURNING OMITTED GNU Cobol can CALL_ void functions, but can't at this point in time, generate functions with a void return signature. This is normally not an issue, but does become a problem when using GNU Cobol with certain frameworks, that require particular signatures for call backs. For instance, many GTK+ features support a call back handler for reacting to events. Unfortunately, most of these functions are expected to return void. Fortunately, GTK+ also supports 'userdata' pointers with most of the call back signatures. This 'userdata' field can be used to allow for GNU Cobol source code that manages GUI_ event call backs. * Menu: * voidcallc:: * A GTK+ calendar::  File: gcfaq.info, Node: voidcallc, Next: A GTK+ calendar, Up: Can GNU Cobol generate callable programs with void returns? 5.78.1 voidcall.c ----------------- /** wrapping void C returns in callbacks for use with COBOL */ void voidcall(void *gtk, int (*cobfunc)(void *)) { if ((cobfunc) && (cobfunc(gtk))) return; else return; } This can then be used to wrap a call back, allowing GNU Cobol to take part in event handling, without a specific C wrapper written for each case.  File: gcfaq.info, Node: A GTK+ calendar, Prev: voidcallc, Up: Can GNU Cobol generate callable programs with void returns? 5.78.2 A GTK+ calendar ---------------------- The above code was used as a generic wrapper for practising with GTK+ calendar features. *> Start up the GIMP/Gnome Tool Kit cobgtk. call "gtk_init" using by value 0 *> argc int by value 0 *> argv pointer to pointer returning omitted *> void return, requires cobc 2010+ on exception display "hellogtk link error, see pkg-config --libs gtk+-2.0" upon syserr end-display stop run returning 1 end-call *> Create a new window, returning handle as pointer call "gtk_window_new" using by value GTK-WINDOW-TOPLEVEL *> it's a zero or a 1 popup returning gtk-window *> and remember the handle end-call *> More fencing, skimped on after this first test if gtk-window equal null then display "hellogtk service error, gtk_window_new" upon syserr end-display stop run returning 1 end-if *> Hint to not let the sample window be too small call "gtk_window_set_default_size" using by value gtk-window *> by value is used to get the C address by value 270 *> a rectangle, wider than tall by value 90 returning omitted *> another void end-call *> Put in the title, it'll be truncated in a size request window call "gtk_window_set_title" using by value gtk-window *> pass the C handle by reference hello-msg *> obligatory, with new Z strings returning omitted end-call *> Connect a signal. GNU Cobol's SET ... TO ENTRY is AWESOME set gtk-quit-callback to entry "gtk_main_quit" call "g_signal_connect_data" using by value gtk-window by reference z"destroy" *> with inline Z string by value gtk-quit-callback *> function call back pointer by value 0 *> pointer to data by value 0 *> closure notify to manage data by value 0 *> connect before or after flag returning gtk-quit-handler-id *> not used in this sample end-call *> Define a container. Boxey, but nice. call "gtk_box_new" using by value GTK-ORIENTATION-VERTICAL by value 8 *> pixels between widgets returning gtk-box end-call *> Add the label call "gtk_label_new" using by reference hello-msg returning gtk-label end-call *> Add the label to the box call "gtk_container_add" using by value gtk-box by value gtk-label returning omitted end-call *> Add a calendar widget call "gtk_calendar_new" returning gtk-calendar end-call call "gtk_container_add" using by value gtk-box by value gtk-calendar returning omitted end-call *> Connect a signal. GNU Cobol doesn't generate void returns *> so this calls a C function two-liner that calls the *> COBOL entry, but returns void to the runtime stack frame set cob-calendar-callback to entry "calendarclick" set gtk-calendar-callback to entry "voidcall" call "g_signal_connect_data" using by value gtk-calendar by reference z"day_selected" *> with inline Z string by value gtk-calendar-callback *> function call back pointer by value cob-calendar-callback *> pointer to COBOL proc by value 0 *> closure notify to manage data by value 0 *> connect before or after flag returning gtk-quit-handler-id *> not used in this sample end-call *> Add the box to the window call "gtk_container_add" using by value gtk-window by value gtk-box returning omitted end-call *> ready to display call "gtk_widget_show_all" using by value gtk-window returning omitted end-call *> Enter the GTK event loop call "gtk_main" returning omitted end-call *> Control can pass back and forth to COBOL subprograms, *> but control flow stops above, until the window *> is torn down and the event loop exits display "GNU Cobol: GTK main eventloop terminated normally" upon syserr end-display accept venue from environment "GDK_BACKEND" end-accept if broadway then display "Ken sends his regards" upon syserr end-display end-if . and the handler entry point. GNU >>SOURCE FORMAT IS FIXED Cobol *> ******************************************************* cob *> Author: Brian Tiffin web *> Date: 20140201 call *> Purpose: Support cobweb callbacks backs *> Tectonics: cobc -x -C gnucobol-cobweb.cob *> sed -i 's/stdio.h/fcgi_stdio.h/' gnucobol-cobweb.c *> cobc -x gnucobol-cobweb.c -lfcgi buccaneer.so \ *> $(pkg-config --libs gtk+-2.0) voidcalls.c \ *> support-cobweb.cob *> Move gnucobol-cobweb to the cgi-bin directory *> supporting libraries in the COB_LIBRARY_PATH *> browse http://localhost/cgi-bin/gnucobol-cobweb *> ******************************************************** *> Callbacks identification division. program-id. supporting-callbacks. data division. working-storage section. 01 gtk-calendar-data. 05 gtk-calendar-year usage binary-long sync. 05 gtk-calendar-month usage binary-long sync. 05 gtk-calendar-day usage binary-long sync. 01 gtk-calendar-display. 05 the-year pic 9999. 05 filler pic x value "/". 05 the-month pic 99. 05 filler pic x value "/". 05 the-day pic 99. linkage section. 01 gtk-widget usage pointer. procedure division. entry 'calendarclick' using by value gtk-widget call "gtk_calendar_get_date" using by value gtk-widget by reference gtk-calendar-year by reference gtk-calendar-month by reference gtk-calendar-day end-call move gtk-calendar-year to the-year move gtk-calendar-month to the-month move gtk-calendar-day to the-day display "In the year " the-year " somebody clicked " gtk-calendar-display end-display goback. which will come in handy as GTK features are extended, especially with the new Broadway backend to the GDK part of GTK+, which allows desktop GTK applications to be seamlessly integrated with a browser.  File: gcfaq.info, Node: Notes, Next: Authors, Prev: Features and extensions, Up: Top 6 Notes ******* *Notes* _Notes * Menu: * big-endian:: * little-endian:: * ASCII:: * currency symbol:: * DSO:: * errno:: * gdb:: * GMP:: * ISAM:: * line sequential:: * APT:: * ROBODoc Support:: * cobolvim:: * make check listing:: * ABI:: * Tectonics:: * Setting Locale:: * GNU:: * Performing FOREVER?:: * POSIX:: * BITWISE:: * Getting Started with esqlOC:: * UDF:: * GUI::  File: gcfaq.info, Node: big-endian, Next: little-endian, Up: Notes 6.1 big-endian ============== Binary values stored with the most significant byte at the lowest memory address. *Big End First*. See for more details. The GNU Cobol compiler _default_ storage format for USAGE_ BINARY and COMP.  File: gcfaq.info, Node: little-endian, Next: ASCII, Prev: big-endian, Up: Notes 6.2 little-endian ================= Binary values stored with the most significant byte at the highest memory address. *Little End First*. for more details. This is the common Intel architecture form, and USAGE_ clauses of COMPUTATIONAL-5, BINARY-CHAR, BINARY-SHORT, BINARY-LONG, BINARY-DOUBLE are a true performance boost on this hardware. See for some details.  File: gcfaq.info, Node: ASCII, Next: currency symbol, Prev: little-endian, Up: Notes 6.3 ASCII ========= American Symbolic Code for Information Interchange. The character encoding common to personal computers and the early Internet Age, therefore GNU Cobol. GNU Cobol also supports the EBCDIC_ character encoding so some data transfers and keyboard handling or console display programs may need programmer attention to detail. Although this is a rare case as GNU Cobol operates using an intelligent choice of encoding for each platform build. See for more info. *note* Unicode? GNU Cobol supports PIC N, a two-byte character field.  File: gcfaq.info, Node: currency symbol, Next: DSO, Prev: ASCII, Up: Notes 6.4 currency symbol =================== COBOL allows a SPECIAL-NAMES clause that determines the currency symbol. This effects both source codes and input/output PICTURE_ definitions. CONFIGURATION SECTION. SPECIAL-NAMES. CURRENCY SIGN IS "#".  File: gcfaq.info, Node: DSO, Next: errno, Prev: currency symbol, Up: Notes 6.5 DSO ======= Dynamic Shared Objects. Similar to, but conceptually different from _shared libraries_. A COBOL abstraction of .dll Dynamic Link Library and POSIX .so along with other platform specific dynamic link and run-time catalog loader systems.  File: gcfaq.info, Node: errno, Next: gdb, Prev: DSO, Up: Notes 6.6 errno ========= GNU Cobol and C are fairly closely related as GNU Cobol produces intermediate C source code and passes this off to another compiler. Some C functions had no easy way to report out-of-bound errors so a global int *errno* is defined in the standard C library as a thread safe variable. Conscientious programmers will reset and test this variable for any and all functions documented as setting *errno*. This is not straight forward for GNU Cobol, but a small wrapper along the lines of /* set/get errno */ #include int reset_errno() { errno = 0; return errno; } int get_errno() { return errno; } /**/ exposes this critical run-time variable. Usage: $ cobc -c geterrno.c $ cobc -x program.cob geterrno.o and then something like CALL "reset_errno" END-CALL MOVE FUNCTION SQRT(-1) TO root CALL "get_errno" RETURNING result END-CALL IF result NOT EQUAL ZERO CALL "perror" USING NULL END-CALL END-IF Outputs: Numerical argument out of domain Note: errno is a 'volatile' system variable, *any* function can change the value.  File: gcfaq.info, Node: gdb, Next: GMP, Prev: errno, Up: Notes 6.7 gdb ======= The GNU symbolic debugger. Big, deep, wide. $ info gdb for the details. or visit  File: gcfaq.info, Node: GMP, Next: ISAM, Prev: gdb, Up: Notes 6.8 GMP ======= GNU MP libgmp. GNU Library for decimal arithmetic. See for complete details on the library advertised as _Arithmetic without limitations_.  File: gcfaq.info, Node: ISAM, Next: line sequential, Prev: GMP, Up: Notes 6.9 ISAM ======== Indexed Sequential Access Method. A system to allow a variety of access methods for data records in file storage. See for more details. * Menu: * GNU Cobol FILE STATUS codes::  File: gcfaq.info, Node: GNU Cobol FILE STATUS codes, Up: ISAM 6.9.1 GNU Cobol FILE STATUS codes --------------------------------- From *statcodes.cpy* courtesy of John Ellis. 01 status-code pic x(2) value spaces. 88 SUCCESS value '00'. 88 SUCCESS_DUPLICATE value '02'. 88 SUCCESS_INCOMPLETE value '04'. 88 SUCCESS_OPTIONAL value '05'. 88 SUCCESS_NO_UNIT value '07'. 88 END_OF_FILE value '10'. 88 OUT_OF_KEY_RANGE value '14'. 88 KEY_INVALID value '21'. 88 KEY_EXISTS value '22'. 88 KEY_NOT_EXISTS value '23'. 88 PERMANENT_ERROR value '30'. 88 INCONSISTENT_FILENAME value '31'. 88 BOUNDARY_VIOLATION value '34'. 88 NOT_EXISTS value '35'. 88 PERMISSION_DENIED value '37'. 88 CLOSED_WITH_LOCK value '38'. 88 CONFLICT_ATTRIBUTE value '39'. 88 ALREADY_OPEN value '41'. 88 NOT_OPEN value '42'. 88 READ_NOT_DONE value '43'. 88 RECORD_OVERFLOW value '44'. 88 READ_ERROR value '46'. 88 INPUT_DENIED value '47'. 88 OUTPUT_DENIED value '48'. 88 I_O_DENIED value '49'. 88 RECORD_LOCKED value '51'. 88 END_OF_PAGE value '52'. 88 I_O_LINAGE value '57'. 88 FILE_SHARING value '61'. 88 NOT_AVAILABLE value '91'. Download and then in your WORKING-STORAGE SECTION use COPY "statcodes.cpy".  File: gcfaq.info, Node: line sequential, Next: APT, Prev: ISAM, Up: Notes 6.10 line sequential ==================== An access method for newline terminated files. GNU Cobol reads each line and strips off carriage returns and line feeds. Filling the record buffer with the current line and padding with spaces.  File: gcfaq.info, Node: APT, Next: ROBODoc Support, Prev: line sequential, Up: Notes 6.11 APT ======== Advanced Package Tool. One of the strengths of the Debian GNU/Linux system. Allows for dependency checked binary packages.  File: gcfaq.info, Node: ROBODoc Support, Next: cobolvim, Prev: APT, Up: Notes 6.12 ROBODoc Support ==================== Below is a sample of a configuration file for using ROBODoc with GNU Cobol programs. # robodoc.rc for GNU Cobol # items: NAME AUTHOR DATE PURPOSE TECTONICS SYNOPSIS INPUTS OUTPUTS SIDE EFFECTS HISTORY BUGS EXAMPLE SOURCE ignore items: HISTORY BUGS item order: PURPOSE SYNOPSIS INPUTS OUTPUTS source items: SYNOPSIS preformatted items: INPUTS OUTPUTS format items: PURPOSE SIDE EFFECTS options: # --src ./ # --doc ./doc --html --syntaxcolors # --singledoc # --multidoc --index --tabsize 4 headertypes: J "Projects" robo_projects 2 F "Files" robo_files 1 e "Makefile Entries" robo_mk_entries x "System Tests" robo_syst_tests q Queries robo_queries ignore files: README CVS *.bak *~ "a test_*" accept files: *.cob *.COB *.cbl *.CBL *.cpy *.CPY header markers: *>**** remark markers: *> end markers: *>**** header separate characters: , header ignore characters: [ remark begin markers: *>+ remark end markers: *>- source line comments: *> # GNU Cobol keywords *><* keywords: accept access active-class add address advancing after aligned all allocate alphabet alphabetic alphabetic-lower alphabetic-upper alphanumeric alphanumeric-edited also alter alternate and any anycase are area areas argument-number argument-value arithmetic as ascending assign at attribute auto auto-skip automatic autoterminate b-and b-not b-or b-xor background-color based beep before bell binary binary-c-long binary-char binary-double binary-long binary-short bit blank blink block boolean bottom by byte-length call cancel cd center cf ch chain chaining character characters class class-id classification close code code-set col collating cols column columns comma command-line commit common communication comp comp-1 comp-2 comp-3 comp-4 comp-5 comp-x computational computational-1 computational-2 computational-3 computational-4 computational-5 computational-x compute condition configuration constant contains content continue control controls converting copy corr corresponding count crt currency cursor cycle data data-pointer date day day-of-week de debugging decimal-point declaratives default delete delimited delimiter depending descending destination detail disable disk display divide division down duplicates dynamic ebcdic ec egi else emi enable end end-accept end-add end-call end-compute end-delete end-display end-divide end-evaluate end-if end-multiply end-of-page end-perform end-read end-receive end-return end-rewrite end-search end-start end-string end-subtract end-unstring end-write entry entry-convention environment environment-name environment-value eo eol eop eos equal equals erase error escape esi evaluate exception exception-object exclusive exit expands extend external factory false fd file file-control file-id filler final first float-extended float-long float-short footing for foreground-color forever format free from full function function-id generate get giving global go goback greater group group-usage heading high-value high-values highlight i-o i-o-control id identification if ignoring implements in index indexed indicate inherits initial initialize initialized initiate input input-output inspect interface interface-id into intrinsic invalid invoke is just justified key label last lc_all lc_collate lc_ctype lc_messages lc_monetary lc_numeric lc_time leading left length less limit limits linage linage-counter line line-counter lines linkage local-storage locale lock low-value low-values lowlight manual memory merge message method method-id minus mode move multiple multiply national national-edited native negative nested next no none normal not null nulls number numbers numeric numeric-edited object object-computer object-reference occurs of off omitted on only open optional options or order organization other output overflow overline override packed-decimal padding page page-counter paragraph perform pf ph pic picture plus pointer position positive present previous printer printing procedure procedure-pointer procedures proceed program program-id program-pointer prompt property prototype purge queue quote quotes raise raising random rd read receive record recording records recursive redefines reel reference relation relative release remainder removal renames replace replacing report reporting reports repository required reserve reset resume retry return returning reverse-video rewind rewrite rf rh right rollback rounded run same screen sd search seconds section secure segment select self send sentence separate sequence sequential set sharing sign signed signed-int signed-long signed-short size sort sort-merge source source-computer sources space spaces special-names standard standard-1 standard-2 start statement status step stop string strong sub-queue-1 sub-queue-2 sub-queue-3 subtract sum super suppress symbol symbolic sync synchronized system-default table tallying tape terminal terminate test text than then through thru time times to top trailing true type typedef ucs-4 underline unit universal unlock unsigned unsigned-int unsigned-long unsigned-short unstring until up update upon usage use user-default using utf-16 utf-8 val-status valid validate validate-status value values varying when with working-storage write yyyyddd yyyymmdd zero zeroes zeros To be used with $ robodoc --src program.cob --doc program --singlefile --rc robocob.rc Producing a nice HTML file documenting the program using embedded ROBODoc comment line directives. See ROBODoc (http://www.xs4all.nl/~rfsber/Robo/robodoc.html) for more information.  File: gcfaq.info, Node: cobolvim, Next: make check listing, Prev: ROBODoc Support, Up: Notes 6.13 cobol.vim ============== Many thanks to the good people at www.vim.org: " Vim syntax file " Language: COBOL " Maintainers: Davyd Ondrejko " (formerly Sitaram Chamarty " James Mitchell " Last change: 2001 Sep 02 " For version 5.x: Clear all syntax items " For version 6.x: Quit when a syntax file was already loaded " Stephen Gennard " - added keywords - AS, REPOSITORY " - added extra cobolCall bits if version < 600 syntax clear elseif exists("b:current_syntax") finish endif " MOST important - else most of the keywords wont work! if version < 600 set isk=@,48-57,- else setlocal isk=@,48-57,- endif syn case ignore if exists("cobol_legacy_code") syn match cobolKeys "^\a\{1,6\}" contains=cobolReserved else syn match cobolKeys "" contains=cobolReserved endif syn keyword cobolReserved contained ACCEPT ACCESS ADD ADDRESS ADVANCING AFTER ALPHABET ALPHABETIC syn keyword cobolReserved contained ALPHABETIC-LOWER ALPHABETIC-UPPER ALPHANUMERIC ALPHANUMERIC-EDITED ALS syn keyword cobolReserved contained ALTERNATE AND ANY ARE AREA AREAS ASCENDING ASSIGN AT AUTHOR BEFORE BINARY syn keyword cobolReserved contained BLANK BLOCK BOTTOM BY CANCEL CBLL CD CF CH CHARACTER CHARACTERS CLASS syn keyword cobolReserved contained CLOCK-UNITS CLOSE COBOL CODE CODE-SET COLLATING COLUMN COMMA COMMON syn keyword cobolReserved contained COMMUNICATIONS COMPUTATIONAL COMPUTE CONFIGURATION CONTENT CONTINUE syn keyword cobolReserved contained CONTROL CONVERTING CORR CORRESPONDING COUNT CURRENCY DATA DATE DATE-COMPILED syn keyword cobolReserved contained DATE-WRITTEN DAY DAY-OF-WEEK DE DEBUG-CONTENTS DEBUG-ITEM DEBUG-LINE syn keyword cobolReserved contained DEBUG-NAME DEBUG-SUB-1 DEBUG-SUB-2 DEBUG-SUB-3 DEBUGGING DECIMAL-POINT syn keyword cobolReserved contained DELARATIVES DELETE DELIMITED DELIMITER DEPENDING DESCENDING DESTINATION syn keyword cobolReserved contained DETAIL DISABLE DISPLAY DIVIDE DIVISION DOWN DUPLICATES DYNAMIC EGI ELSE EMI syn keyword cobolReserved contained ENABLE END-ADD END-COMPUTE END-DELETE END-DIVIDE END-EVALUATE END-IF syn keyword cobolReserved contained END-MULTIPLY END-OF-PAGE END-PERFORM END-READ END-RECEIVE END-RETURN syn keyword cobolReserved contained END-REWRITE END-SEARCH END-START END-STRING END-SUBTRACT END-UNSTRING syn keyword cobolReserved contained END-WRITE ENVIRONMENT EQUAL ERROR ESI EVALUATE EVERY EXCEPTION syn keyword cobolReserved contained EXTEND EXTERNAL FALSE FD FILE FILE-CONTROL FILLER FINAL FIRST FOOTING FOR FROM syn keyword cobolReserved contained GENERATE GIVING GLOBAL GREATER GROUP HEADING HIGH-VALUE HIGH-VALUES I-O syn keyword cobolReserved contained I-O-CONTROL IDENTIFICATION IN INDEX INDEXED INDICATE INITIAL INITIALIZE syn keyword cobolReserved contained INITIATE INPUT INPUT-OUTPUT INSPECT INSTALLATION INTO IS JUST syn keyword cobolReserved contained JUSTIFIED KEY LABEL LAST LEADING LEFT LENGTH LOCK MEMORY syn keyword cobolReserved contained MERGE MESSAGE MODE MODULES MOVE MULTIPLE MULTIPLY NATIVE NEGATIVE NEXT NO NOT syn keyword cobolReserved contained NUMBER NUMERIC NUMERIC-EDITED OBJECT-COMPUTER OCCURS OF OFF OMITTED ON OPEN syn keyword cobolReserved contained OPTIONAL OR ORDER ORGANIZATION OTHER OUTPUT OVERFLOW PACKED-DECIMAL PADDING syn keyword cobolReserved contained PAGE PAGE-COUNTER PERFORM PF PH PIC PICTURE PLUS POSITION POSITIVE syn keyword cobolReserved contained PRINTING PROCEDURE PROCEDURES PROCEDD PROGRAM PROGRAM-ID PURGE QUEUE QUOTES syn keyword cobolReserved contained RANDOM RD READ RECEIVE RECORD RECORDS REDEFINES REEL REFERENCE REFERENCES syn keyword cobolReserved contained RELATIVE RELEASE REMAINDER REMOVAL REPLACE REPLACING REPORT REPORTING syn keyword cobolReserved contained REPORTS RERUN RESERVE RESET RETURN RETURNING REVERSED REWIND REWRITE RF RH syn keyword cobolReserved contained RIGHT ROUNDED SAME SD SEARCH SECTION SECURITY SEGMENT SEGMENT-LIMITED syn keyword cobolReserved contained SELECT SEND SENTENCE SEPARATE SEQUENCE SEQUENTIAL SET SIGN SIZE SORT syn keyword cobolReserved contained SORT-MERGE SOURCE SOURCE-COMPUTER SPECIAL-NAMES STANDARD syn keyword cobolReserved contained STANDARD-1 STANDARD-2 START STATUS STRING SUB-QUEUE-1 SUB-QUEUE-2 syn keyword cobolReserved contained SUB-QUEUE-3 SUBTRACT SUM SUPPRESS SYMBOLIC SYNC SYNCHRONIZED TABLE TALLYING syn keyword cobolReserved contained TAPE TERMINAL TERMINATE TEST TEXT THAN THEN THROUGH THRU TIME TIMES TO TOP syn keyword cobolReserved contained TRAILING TRUE TYPE UNIT UNSTRING UNTIL UP UPON USAGE USE USING VALUE VALUES syn keyword cobolReserved contained VARYING WHEN WITH WORDS WORKING-STORAGE WRITE " new syn keyword cobolReserved contained AS LOCAL-STORAGE LINKAGE SCREEN ENTRY " new - btiffin syn keyword cobolReserved contained END-ACCEPT END-DISPLAY " new syn keyword cobolReserved contained environment-name environment-value argument-number syn keyword cobolReserved contained call-convention identified pointer syn keyword cobolReserved contained external-form division wait national " new -- oo stuff syn keyword cobolReserved contained repository object class method-id method object static syn keyword cobolReserved contained class-id class-control private inherits object-storage syn keyword cobolReserved contained class-object protected delegate syn keyword cobolReserved contained try catch raise end-try super property syn keyword cobolReserved contained override instance equals " new - new types syn match cobolTypes "condition-value"hs=s,he=e syn match cobolTypes "binary-char"hs=s,he=e syn match cobolTypes "binary-c-long"hs=s,he=e syn match cobolTypes "binary-long"hs=s,he=e syn match cobolTypes "binary-short"hs=s,he=e syn match cobolTypes "binary-double"hs=s,he=e syn match cobolTypes "procedure-pointer"hs=s,he=e syn match cobolTypes "object reference"hs=s,he=e syn match cobolReserved contained "\" syn match cobolReserved contained "\<\(IF\|ELSE|INVALID\|END\|EOP\)\>" syn match cobolReserved contained "\" syn keyword cobolConstant SPACE SPACES NULL ZERO ZEROES ZEROS LOW-VALUE LOW-VALUES syn keyword cobolReserved contained fold folder if exists("cobol_legacy_code") syn match cobolMarker "^.\{6\}" syn match cobolBadLine "^.\{6\}[^ D\-*$/].*"hs=s+6 " If comment mark somehow gets into column past Column 7. syn match cobolBadLine "^.\{6\}\s\+\*.*" endif syn match cobolNumber "\<-\=\d*\.\=\d\+\>" contains=cobolMarker,cobolComment syn match cobolPic "\" contains=cobolMarker,cobolComment syn match cobolPic "\<$*\.\=9\+\>" contains=cobolMarker,cobolComment syn match cobolPic "\" contains=cobolMarker,cobolComment syn match cobolPic "\" contains=cobolMarker,cobolComment syn match cobolPic "\<9\+V\>" contains=cobolMarker,cobolComment syn match cobolPic "\<-\+[Z9]\+\>" contains=cobolMarker,cobolComment syn match cobolTodo "todo" contained if exists("cobol_mf_syntax") syn region cobolComment start="*>" end="$" contains=cobolTodo,cobolMarker endif syn keyword cobolGoTo GO GOTO syn keyword cobolCopy COPY " cobolBAD: things that are BAD NEWS! syn keyword cobolBAD ALTER ENTER RENAMES " cobolWatch: things that are important when trying to understand a program syn keyword cobolWatch OCCURS DEPENDING VARYING BINARY COMP REDEFINES syn keyword cobolWatch REPLACING THROW syn match cobolWatch "COMP-[123456XN]" " new - btiffin, added Intrinsics syn keyword cobolWatch ABS ACOS ANNUITY ASIN ATAN BYTE-LENGTH CHAR syn keyword cobolWatch COS CURRENT-DATE DATE-OF-INTEGER DATE-TO-YYYYMMDD syn keyword cobolWatch DAY-OF-INTEGER DAY-TO-YYYYDDD E EXCEPTION-FILE syn keyword cobolWatch EXCEPTION-LOCATION EXCEPTION-STATEMENT syn keyword cobolWatch EXCEPTION-STATUS EXP EXP10 FACTORIAL FRACTION-PART syn keyword cobolWatch INTEGER INTEGER-OF-DATE INTEGER-OF-DAY INTEGER-PART syn keyword cobolWatch LENGTH LOCALE-DATE LOCALE-TIME LOG LOG10 LOWER-CASE syn keyword cobolWatch MAX MEAN MEDIAN MIDRANGE MIN MOD NUMVAL NUMVAL-C syn keyword cobolWatch ORD ORD-MAX ORD-MIN PI PRESENT-VALUE RANDOM RANGE syn keyword cobolWatch REM REVERSE SECONDS-FROM-FORMATTED-TIME syn keyword cobolWatch SECONDS-PAST-MIDNIGHT SIGN SIN SQRT syn keyword cobolWatch STANDARD-DEVIATION STORED-CHAR-LENGTH SUM TAN syn keyword cobolwatch SUBSTITUTE SUBSTITUTE-CASE syn keyword cobolWatch TEST-DATE-YYMMDD TEST-DAY-YYYYDDD TRIM UPPER-CASE syn keyword cobolWatch VARIANCE WHEN-COMPILED YEAR-TO-YYYY syn region cobolEXECs contains=cobolLine start="EXEC " end="END-EXEC" syn match cobolComment "^.\{6\}\*.*"hs=s+6 contains=cobolTodo,cobolMarker syn match cobolComment "^.\{6\}/.*"hs=s+6 contains=cobolTodo,cobolMarker syn match cobolComment "^.\{6\}C.*"hs=s+6 contains=cobolTodo,cobolMarker if exists("cobol_legacy_code") syn match cobolCompiler "^.\{6\}$.*"hs=s+6 syn match cobolDecl "^.\{6} \{1,8}\(0\=1\|77\|78\) "hs=s+7,he=e-1 contains=cobolMarker syn match cobolDecl "^.\{6} \+[1-8]\d "hs=s+7,he=e-1 contains=cobolMarker syn match cobolDecl "^.\{6} \+0\=[2-9] "hs=s+7,he=e-1 contains=cobolMarker syn match cobolDecl "^.\{6} \+66 "hs=s+7,he=e-1 contains=cobolMarker syn match cobolWatch "^.\{6} \+88 "hs=s+7,he=e-1 contains=cobolMarker else syn match cobolWhiteSpace "^*[ \t]" syn match cobolCompiler "$.*"hs=s,he=e contains=cobolWhiteSpace,cobolTypes syn match cobolDecl "0\=[1-9] *$"hs=s,he=e-1 contains=cobolWhiteSpace,cobolTypes syn match cobolDecl "66 *$"hs=s,he=e-1 contains=cobolWhiteSpace,cobolTypes syn match cobolWatch "88 *$"hs=s,he=e-1 contains=cobolWhiteSpace,cobolTypes endif syn match cobolBadID "\k\+-\($\|[^-A-Z0-9]\)" syn keyword cobolCALLs CALL CANCEL GOBACK INVOKE PERFORM END-PERFORM END-CALL RUN syn match cobolCALLs "STOP \+RUN" syn match cobolCALLs "EXIT \+PROGRAM" syn match cobolCALLs "EXIT \+PROGRAM \+RETURNING" syn match cobolCALLs "EXIT \+PERFORM" syn match cobolCALLs "EXIT \+METHOD" syn match cobolCALLs "EXIT \+SECTION" syn match cobolCALLs "STOP " contains=cobolString syn match cobolExtras /\= 508 || !exists("did_cobol_syntax_inits") if version < 508 let did_cobol_syntax_inits = 1 command -nargs=+ HiLink hi link else command -nargs=+ HiLink hi def link endif HiLink cobolBAD Error HiLink cobolBadID Error HiLink cobolBadLine Error HiLink cobolMarker Comment HiLink cobolCALLs Function HiLink cobolComment Comment HiLink cobolKeys Comment HiLink cobolCompiler PreProc HiLink cobolEXECs PreProc HiLink cobolCondFlow Special HiLink cobolCopy PreProc HiLink cobolDecl Type HiLink cobolTypes Type HiLink cobolExtras Special HiLink cobolGoTo Special HiLink cobolConstant Constant HiLink cobolNumber Constant HiLink cobolPic Constant HiLink cobolReserved Statement HiLink cobolString Constant HiLink cobolTodo Todo HiLink cobolWatch Special delcommand HiLink endif let b:current_syntax = "cobol" " vim: ts=6 nowrap  File: gcfaq.info, Node: make check listing, Next: ABI, Prev: cobolvim, Up: Notes 6.14 make check listing ======================= A 'make check' from October 2013: ## --------------------------------------- ## ## GNU Cobol 1.1 test suite: Syntax Tests. ## ## --------------------------------------- ## 1: COPY: file not found ok 2: COPY: replacement order ok 3: COPY: separators ok 4: COPY: partial replacement ok 5: COPY: recursive replacement ok 6: Invalid PROGRAM-ID ok 7: Invalid PROGRAM-ID type clause (1) ok 8: Invalid PROGRAM-ID type clause (2) ok 9: Undefined data name ok 10: Undefined group name ok 11: Undefined data name in group ok 12: Reference not a group name ok 13: Incomplete 01 definition ok 14: Same labels in different sections ok 15: Redefinition of 01 items ok 16: Redefinition of 01 and 02 items ok 17: Redefinition of 02 items ok 18: Redefinition of 77 items ok 19: Redefinition of 01 and 77 items ok 20: Redefinition of 88 items ok 21: Ambiguous reference to 02 items ok 22: Ambiguous reference to 02 and 03 items ok 23: Ambiguous reference with qualification ok 24: Unique reference with ambiguous qualifiers ok 25: Undefined procedure name ok 26: Redefinition of section names ok 27: Redefinition of section and paragraph names ok 28: Redefinition of paragraph names ok 29: Ambiguous reference to paragraph name ok 30: Non-matching level numbers (extension) ok 31: Ambiguous AND/OR ok 32: START on SEQUENTIAL file ok 33: Subscripted item requires OCCURS clause ok 34: The number of subscripts ok 35: OCCURS with level 01, 66, 77, and 88 ok 36: OCCURS with variable-occurrence data item ok 37: Nested OCCURS clause ok 38: OCCURS DEPENDING followed by another field ok 39: OCCURS DEPENDING without TO clause ok 40: REDEFINES: not following entry-name ok 41: REDEFINES: level 02 by 01 ok 42: REDEFINES: level 03 by 02 ok 43: REDEFINES: level 66 ok 44: REDEFINES: level 88 ok 45: REDEFINES: lower level number ok 46: REDEFINES: with OCCURS ok 47: REDEFINES: with subscript ok 48: REDEFINES: with variable occurrence ok 49: REDEFINES: with qualification ok 50: REDEFINES: multiple redefinition ok 51: REDEFINES: size exceeds ok 52: REDEFINES: with VALUE ok 53: REDEFINES: with intervention ok 54: REDEFINES: within REDEFINES ok 55: Numeric item (integer) ok 56: Numeric item (non-integer) ok 57: Numeric item with picture P ok 58: Signed numeric literal ok 59: Alphabetic item ok 60: Alphanumeric item ok 61: Alphanumeric group item ok 62: Numeric-edited item ok 63: Alphanumeric-edited item ok 64: MOVE SPACE TO numeric or numeric-edited item ok 65: MOVE ZERO TO alphabetic item ok 66: MOVE alphabetic TO x ok 67: MOVE alphanumeric TO x ok 68: MOVE alphanumeric-edited TO x ok 69: MOVE numeric (integer) TO x ok 70: MOVE numeric (non-integer) TO x ok 71: MOVE numeric-edited TO x ok 72: Operands must be groups ok 73: MOVE: misc ok 74: Category check of Format 1 ok 75: Category check of Format 2 ok 76: Category check of literals ok 77: SET: misc ok ## ------------- ## ## Test results. ## ## ------------- ## All 77 tests were successful. PASS: ./syntax ## ------------------------------------ ## ## GNU Cobol 1.1 test suite: Run Tests. ## ## ------------------------------------ ## 1: DISPLAY literals ok 2: DISPLAY literals, DECIMAL-POINT is COMMA ok 3: Hexadecimal literal ok 4: DISPLAY data items with VALUE clause ok 5: DISPLAY data items with MOVE statement ok 6: GLOBAL at same level ok 7: GLOBAL at lower level ok 8: non-numeric subscript ok 9: The range of subscripts ok 10: Subscript out of bounds (1) ok 11: Subscript out of bounds (2) ok 12: Value of DEPENDING ON N out of bounds (lower) ok 13: Value of DEPENDING ON N out of bounds (upper) ok 14: Subscript bounds with ODO (lower) ok 15: Subscript bounds with ODO (upper) ok 16: Subscript bounds with ODO ok 17: Subscript by arithmetic expression ok 18: Separate sign positions ok 19: Static reference modification ok 20: Dynamic reference modification ok 21: Static out of bounds ok 22: Offset underflow ok 23: Offset overflow ok 24: Length underflow ok 25: Length overflow ok 26: ACCEPT ok 27: INITIALIZE group entry with OCCURS ok 28: INITIALIZE OCCURS with numeric edited ok 29: INITIALIZE complex group (1) ok 30: INITIALIZE complex group (2) ok 31: INITIALIZE with REDEFINES ok 32: Source file not found ok 33: Comma separator without space ok 34: LOCAL-STORAGE ok 35: EXTERNAL data item ok 36: EXTERNAL AS data item ok 37: cobcrun validation ok 38: MOVE to itself ok 39: MOVE with refmod ok 40: MOVE with refmod (variable) ok 41: MOVE with group refmod ok 42: MOVE indexes ok 43: MOVE X'00' ok 44: Level 01 subscripts ok 45: Class check with reference modification ok 46: Index and parenthesized expression ok 47: String concatenation ok 48: Alphanumeric and binary numeric ok 49: Dynamic call with static linking ok 50: CALL m1. CALL m2. CALL m1. ok 51: CALL binary literal parameter/LENGTH OF ok 52: INSPECT REPLACING LEADING ZEROS BY SPACES ok 53: INSPECT: No repeat conversion check ok 54: INSPECT: REPLACING figurative constant ok 55: INSPECT: TALLYING BEFORE ok 56: INSPECT: TALLYING AFTER ok 57: INSPECT REPLACING TRAILING ZEROS BY SPACES ok 58: INSPECT REPLACING complex ok 59: SWITCHES ok 60: Nested PERFORM ok 61: EXIT PERFORM ok 62: EXIT PERFORM CYCLE ok 63: EXIT PARAGRAPH ok 64: EXIT SECTION ok 65: 88 with FILLER ok 66: Non-overflow after overflow ok 67: PERFORM ... CONTINUE ok 68: STRING with subscript reference ok 69: UNSTRING DELIMITED ALL LOW-VALUE ok 70: READ INTO AT-END sequence ok 71: First READ on empty SEQUENTIAL INDEXED file ok 72: REWRITE a RELATIVE file with RANDOM access ok 73: SORT: table sort ok 74: SORT: EBCDIC table sort ok 75: SORT nonexistent file ok 76: PIC ZZZ-, ZZZ+ ok 77: Larger REDEFINES lengths ok 78: PERFORM type OSVS ok 79: Sticky LINKAGE ok 80: COB_PRE_LOAD test ok 81: COB_LOAD_CASE=UPPER test ok 82: 88 level with FALSE IS clause ok 83: ALLOCATE/FREE with BASED item ok 84: INITIZIALIZE with reference modification ok 85: CALL with OMITTED parameter ok 86: ANY LENGTH ok 87: COMP-5 ok 88: Hexadecimal numeric literal ok 89: Semi-parenthesized condition ok 90: ADDRESS OF ok 91: LENGTH OF ok 92: WHEN-COMPILED ok 93: Complex OCCURS DEPENDING ON ok 94: MOVE NON-INTEGER TO ALPHA-NUMERIC ok 95: CALL USING file-name ok 96: CALL unusual PROGRAM-ID. ok 97: Case independent PROGRAM-ID ok 98: PROGRAM-ID AS clause ok 99: Quoted PROGRAM-ID ok 100: ASSIGN MF ok 101: ASSIGN IBM ok 102: ASSIGN mapping ok 103: ASSIGN expansion ok 104: ASSIGN with COB_FILE_PATH ok 105: NUMBER-OF-CALL-PARAMETERS ok 106: PROCEDURE DIVISION USING BY ... ok 107: PROCEDURE DIVISION CHAINING ... ok 108: STOP RUN RETURNING ok 109: ENTRY ok 110: LINE SEQUENTIAL write ok 111: LINE SEQUENTIAL read ok 112: ASSIGN to KEYBOARD/DISPLAY ok 113: Environment/Argument variable ok 114: DECIMAL-POINT is COMMA (1) ok 115: DECIMAL-POINT is COMMA (2) ok 116: DECIMAL-POINT is COMMA (3) ok 117: DECIMAL-POINT is COMMA (4) ok 118: DECIMAL-POINT is COMMA (5) ok 119: 78 Level (1) ok 120: 78 Level (2) ok 121: 78 Level (3) ok 122: Unreachable statement ok 123: RETURN-CODE moving ok 124: RETURN-CODE passing ok 125: RETURN-CODE nested ok 126: FUNCTION ABS ok 127: FUNCTION ACOS ok 128: FUNCTION ANNUITY ok 129: FUNCTION ASIN ok 130: FUNCTION ATAN ok 131: FUNCTION CHAR ok 132: FUNCTION COMBINED-DATETIME ok 133: FUNCTION CONCATENATE ok 134: FUNCTION CONCATENATE with reference modding ok 135: FUNCTION COS ok 136: FUNCTION DATE-OF-INTEGER ok 137: FUNCTION DATE-TO-YYYYMMDD ok 138: FUNCTION DAY-OF-INTEGER ok 139: FUNCTION DAY-TO-YYYYDDD ok 140: FUNCTION E ok 141: FUNCTION EXCEPTION-FILE ok 142: FUNCTION EXCEPTION-LOCATION ok 143: FUNCTION EXCEPTION-STATEMENT ok 144: FUNCTION EXCEPTION-STATUS ok 145: FUNCTION EXP ok 146: FUNCTION FACTORIAL ok 147: FUNCTION FRACTION-PART ok 148: FUNCTION INTEGER ok 149: FUNCTION INTEGER-OF-DATE ok 150: FUNCTION INTEGER-OF-DAY ok 151: FUNCTION INTEGER-PART ok 152: FUNCTION LENGTH ok 153: FUNCTION LOCALE-DATE ok 154: FUNCTION LOCALE-TIME ok 155: FUNCTION LOCALE-TIME-FROM-SECONDS ok 156: FUNCTION LOG ok 157: FUNCTION LOG10 ok 158: FUNCTION LOWER-CASE ok 159: FUNCTION LOWER-CASE with reference modding ok 160: FUNCTION MAX ok 161: FUNCTION MEAN ok 162: FUNCTION MEDIAN ok 163: FUNCTION MIDRANGE ok 164: FUNCTION MIN ok 165: FUNCTION MOD ok 166: FUNCTION NUMVAL ok 167: FUNCTION NUMVAL-C ok 168: FUNCTION ORD ok 169: FUNCTION ORD-MAX ok 170: FUNCTION ORD-MIN ok 171: FUNCTION PI ok 172: FUNCTION PRESENT-VALUE ok 173: FUNCTION RANGE ok 174: FUNCTION REM ok 175: FUNCTION REVERSE ok 176: FUNCTION REVERSE with reference modding ok 177: FUNCTION SECONDS-FROM-FORMATTED-TIME ok 178: FUNCTION SECONDS-PAST-MIDNIGHT ok 179: FUNCTION SIGN ok 180: FUNCTION SIN ok 181: FUNCTION SQRT ok 182: FUNCTION STANDARD-DEVIATION ok 183: FUNCTION STORED-CHAR-LENGTH ok 184: FUNCTION SUBSTITUTE ok 185: FUNCTION SUBSTITUTE with reference modding ok 186: FUNCTION SUBSTITUTE-CASE ok 187: FUNCTION SUBSTITUTE-CASE with reference mod ok 188: FUNCTION TAN ok 189: FUNCTION TRIM ok 190: FUNCTION TRIM with reference modding ok 191: FUNCTION UPPER-CASE ok 192: FUNCTION UPPER-CASE with reference modding ok 193: FUNCTION VARIANCE ok 194: FUNCTION WHEN-COMPILED ok ## ------------- ## ## Test results. ## ## ------------- ## All 194 tests were successful. PASS: ./run ## Run time tests with -O option ## ## ------------------------------------ ## ## GNU Cobol 1.1 test suite: Run Tests. ## ## ------------------------------------ ## 1: DISPLAY literals ok 2: DISPLAY literals, DECIMAL-POINT is COMMA ok 3: Hexadecimal literal ok 4: DISPLAY data items with VALUE clause ok 5: DISPLAY data items with MOVE statement ok 6: GLOBAL at same level ok 7: GLOBAL at lower level ok 8: non-numeric subscript ok 9: The range of subscripts ok 10: Subscript out of bounds (1) ok 11: Subscript out of bounds (2) ok 12: Value of DEPENDING ON N out of bounds (lower) ok 13: Value of DEPENDING ON N out of bounds (upper) ok 14: Subscript bounds with ODO (lower) ok 15: Subscript bounds with ODO (upper) ok 16: Subscript bounds with ODO ok 17: Subscript by arithmetic expression ok 18: Separate sign positions ok 19: Static reference modification ok 20: Dynamic reference modification ok 21: Static out of bounds ok 22: Offset underflow ok 23: Offset overflow ok 24: Length underflow ok 25: Length overflow ok 26: ACCEPT ok 27: INITIALIZE group entry with OCCURS ok 28: INITIALIZE OCCURS with numeric edited ok 29: INITIALIZE complex group (1) ok 30: INITIALIZE complex group (2) ok 31: INITIALIZE with REDEFINES ok 32: Source file not found ok 33: Comma separator without space ok 34: LOCAL-STORAGE ok 35: EXTERNAL data item ok 36: EXTERNAL AS data item ok 37: cobcrun validation ok 38: MOVE to itself ok 39: MOVE with refmod ok 40: MOVE with refmod (variable) ok 41: MOVE with group refmod ok 42: MOVE indexes ok 43: MOVE X'00' ok 44: Level 01 subscripts ok 45: Class check with reference modification ok 46: Index and parenthesized expression ok 47: String concatenation ok 48: Alphanumeric and binary numeric ok 49: Dynamic call with static linking ok 50: CALL m1. CALL m2. CALL m1. ok 51: CALL binary literal parameter/LENGTH OF ok 52: INSPECT REPLACING LEADING ZEROS BY SPACES ok 53: INSPECT: No repeat conversion check ok 54: INSPECT: REPLACING figurative constant ok 55: INSPECT: TALLYING BEFORE ok 56: INSPECT: TALLYING AFTER ok 57: INSPECT REPLACING TRAILING ZEROS BY SPACES ok 58: INSPECT REPLACING complex ok 59: SWITCHES ok 60: Nested PERFORM ok 61: EXIT PERFORM ok 62: EXIT PERFORM CYCLE ok 63: EXIT PARAGRAPH ok 64: EXIT SECTION ok 65: 88 with FILLER ok 66: Non-overflow after overflow ok 67: PERFORM ... CONTINUE ok 68: STRING with subscript reference ok 69: UNSTRING DELIMITED ALL LOW-VALUE ok 70: READ INTO AT-END sequence ok 71: First READ on empty SEQUENTIAL INDEXED file ok 72: REWRITE a RELATIVE file with RANDOM access ok 73: SORT: table sort ok 74: SORT: EBCDIC table sort ok 75: SORT nonexistent file ok 76: PIC ZZZ-, ZZZ+ ok 77: Larger REDEFINES lengths ok 78: PERFORM type OSVS ok 79: Sticky LINKAGE ok 80: COB_PRE_LOAD test ok 81: COB_LOAD_CASE=UPPER test ok 82: 88 level with FALSE IS clause ok 83: ALLOCATE/FREE with BASED item ok 84: INITIZIALIZE with reference modification ok 85: CALL with OMITTED parameter ok 86: ANY LENGTH ok 87: COMP-5 ok 88: Hexadecimal numeric literal ok 89: Semi-parenthesized condition ok 90: ADDRESS OF ok 91: LENGTH OF ok 92: WHEN-COMPILED ok 93: Complex OCCURS DEPENDING ON ok 94: MOVE NON-INTEGER TO ALPHA-NUMERIC ok 95: CALL USING file-name ok 96: CALL unusual PROGRAM-ID. ok 97: Case independent PROGRAM-ID ok 98: PROGRAM-ID AS clause ok 99: Quoted PROGRAM-ID ok 100: ASSIGN MF ok 101: ASSIGN IBM ok 102: ASSIGN mapping ok 103: ASSIGN expansion ok 104: ASSIGN with COB_FILE_PATH ok 105: NUMBER-OF-CALL-PARAMETERS ok 106: PROCEDURE DIVISION USING BY ... ok 107: PROCEDURE DIVISION CHAINING ... ok 108: STOP RUN RETURNING ok 109: ENTRY ok 110: LINE SEQUENTIAL write ok 111: LINE SEQUENTIAL read ok 112: ASSIGN to KEYBOARD/DISPLAY ok 113: Environment/Argument variable ok 114: DECIMAL-POINT is COMMA (1) ok 115: DECIMAL-POINT is COMMA (2) ok 116: DECIMAL-POINT is COMMA (3) ok 117: DECIMAL-POINT is COMMA (4) ok 118: DECIMAL-POINT is COMMA (5) ok 119: 78 Level (1) ok 120: 78 Level (2) ok 121: 78 Level (3) ok 122: Unreachable statement ok 123: RETURN-CODE moving ok 124: RETURN-CODE passing ok 125: RETURN-CODE nested ok 126: FUNCTION ABS ok 127: FUNCTION ACOS ok 128: FUNCTION ANNUITY ok 129: FUNCTION ASIN ok 130: FUNCTION ATAN ok 131: FUNCTION CHAR ok 132: FUNCTION COMBINED-DATETIME ok 133: FUNCTION CONCATENATE ok 134: FUNCTION CONCATENATE with reference modding ok 135: FUNCTION COS ok 136: FUNCTION DATE-OF-INTEGER ok 137: FUNCTION DATE-TO-YYYYMMDD ok 138: FUNCTION DAY-OF-INTEGER ok 139: FUNCTION DAY-TO-YYYYDDD ok 140: FUNCTION E ok 141: FUNCTION EXCEPTION-FILE ok 142: FUNCTION EXCEPTION-LOCATION ok 143: FUNCTION EXCEPTION-STATEMENT ok 144: FUNCTION EXCEPTION-STATUS ok 145: FUNCTION EXP ok 146: FUNCTION FACTORIAL ok 147: FUNCTION FRACTION-PART ok 148: FUNCTION INTEGER ok 149: FUNCTION INTEGER-OF-DATE ok 150: FUNCTION INTEGER-OF-DAY ok 151: FUNCTION INTEGER-PART ok 152: FUNCTION LENGTH ok 153: FUNCTION LOCALE-DATE ok 154: FUNCTION LOCALE-TIME ok 155: FUNCTION LOCALE-TIME-FROM-SECONDS ok 156: FUNCTION LOG ok 157: FUNCTION LOG10 ok 158: FUNCTION LOWER-CASE ok 159: FUNCTION LOWER-CASE with reference modding ok 160: FUNCTION MAX ok 161: FUNCTION MEAN ok 162: FUNCTION MEDIAN ok 163: FUNCTION MIDRANGE ok 164: FUNCTION MIN ok 165: FUNCTION MOD ok 166: FUNCTION NUMVAL ok 167: FUNCTION NUMVAL-C ok 168: FUNCTION ORD ok 169: FUNCTION ORD-MAX ok 170: FUNCTION ORD-MIN ok 171: FUNCTION PI ok 172: FUNCTION PRESENT-VALUE ok 173: FUNCTION RANGE ok 174: FUNCTION REM ok 175: FUNCTION REVERSE ok 176: FUNCTION REVERSE with reference modding ok 177: FUNCTION SECONDS-FROM-FORMATTED-TIME ok 178: FUNCTION SECONDS-PAST-MIDNIGHT ok 179: FUNCTION SIGN ok 180: FUNCTION SIN ok 181: FUNCTION SQRT ok 182: FUNCTION STANDARD-DEVIATION ok 183: FUNCTION STORED-CHAR-LENGTH ok 184: FUNCTION SUBSTITUTE ok 185: FUNCTION SUBSTITUTE with reference modding ok 186: FUNCTION SUBSTITUTE-CASE ok 187: FUNCTION SUBSTITUTE-CASE with reference mod ok 188: FUNCTION TAN ok 189: FUNCTION TRIM ok 190: FUNCTION TRIM with reference modding ok 191: FUNCTION UPPER-CASE ok 192: FUNCTION UPPER-CASE with reference modding ok 193: FUNCTION VARIANCE ok 194: FUNCTION WHEN-COMPILED ok ## ------------- ## ## Test results. ## ## ------------- ## All 194 tests were successful. PASS: ./run-O ## ---------------------------------------------- ## ## GNU Cobol 1.1 test suite: Data Representation. ## ## ---------------------------------------------- ## 1: BINARY: 2-4-8 big-endian ok 2: BINARY: 2-4-8 native ok 3: BINARY: 1-2-4-8 big-endian ok 4: BINARY: 1-2-4-8 native ok 5: BINARY: 1--8 big-endian ok 6: BINARY: 1--8 native ok 7: BINARY: full-print ok 8: DISPLAY: Sign ASCII ok 9: DISPLAY: Sign ASCII (2) ok 10: DISPLAY: Sign EBCDIC ok 11: PACKED-DECIMAL dump ok 12: PACKED-DECIMAL display ok 13: PACKED-DECIMAL move ok 14: PACKED-DECIMAL arithmetic (1) ok 15: PACKED-DECIMAL arithmetic (2) ok 16: PACKED-DECIMAL numeric test ok 17: POINTER: display ok ## ------------- ## ## Test results. ## ## ------------- ## All 17 tests were successful. PASS: ./data-rep ## Data representation tests with -O option ## ## ---------------------------------------------- ## ## GNU Cobol 1.1 test suite: Data Representation. ## ## ---------------------------------------------- ## 1: BINARY: 2-4-8 big-endian ok 2: BINARY: 2-4-8 native ok 3: BINARY: 1-2-4-8 big-endian ok 4: BINARY: 1-2-4-8 native ok 5: BINARY: 1--8 big-endian ok 6: BINARY: 1--8 native ok 7: BINARY: full-print ok 8: DISPLAY: Sign ASCII ok 9: DISPLAY: Sign ASCII (2) ok 10: DISPLAY: Sign EBCDIC ok 11: PACKED-DECIMAL dump ok 12: PACKED-DECIMAL display ok 13: PACKED-DECIMAL move ok 14: PACKED-DECIMAL arithmetic (1) ok 15: PACKED-DECIMAL arithmetic (2) ok 16: PACKED-DECIMAL numeric test ok 17: POINTER: display ok ## ------------- ## ## Test results. ## ## ------------- ## All 17 tests were successful. PASS: ./data-rep-O ================== All 5 tests passed ==================  File: gcfaq.info, Node: ABI, Next: Tectonics, Prev: make check listing, Up: Notes 6.15 ABI ======== Application Binary Interface. An acronym that covers the way object code is managed and the expectations of the run-time system. GNU Cobol is at home in the "C" ABI. * Link names are as expected. * CALL arguments are stacked as expected for C programming. * etc... The C application binary interface allows GNU Cobol to link with many, if not all, existent C libraries. Defaulting to the C ABI does mean that small wrapper source codes may be required for access to C++ runtimes, to inform the C++ linker to use 'extern "C"' code handling.  File: gcfaq.info, Node: Tectonics, Next: Setting Locale, Prev: ABI, Up: Notes 6.16 Tectonics ============== I use the expression *tectonics* using the definition below as a basis for the nerd slang describing the code building process. Using a lookup from the ** protocol bank of open servers: "Tectonics" gcide "The Collaborative International Dictionary of English v.0.48" Tectonics \Tec*ton"ics\, n. 1. The science, or the art, by which implements, vessels, dwellings, or other edifices, are constructed, both agreeably to the end for which they are designed, and in conformity with artistic sentiments and ideas. [1913 Webster] Trying to infer that building with GNU Cobol is rock solid and artistically pleasing. Ok fine, I mean *wicked cool*!.  File: gcfaq.info, Node: Setting Locale, Next: GNU, Prev: Tectonics, Up: Notes 6.17 Setting Locale =================== GNU Cobol supports LC_ locale settings, during builds and with generated programs.  File: gcfaq.info, Node: GNU, Next: Performing FOREVER?, Prev: Setting Locale, Up: Notes 6.18 GNU ======== GNU is Not Unix, one of the original recursive acronyms. GNU software leads the Free Software movement, and with the Linux kernel is a critical piece in the GNU/Linux operating system. See for more details. The developers of GNU Cobol follow, as closely as possible, the GNU coding standards.  File: gcfaq.info, Node: Performing FOREVER?, Next: POSIX, Prev: GNU, Up: Notes 6.19 Performing FOREVER? ======================== I asked on opencobol.org for some input, and an interesting conversation ensued. I've included most of the forum thread archive, to give a sense of various programmer styles and group thought processing. See FOREVER_. Subject: FOREVER and a small request for involvement I just updated the FAQ and was wondering if anyone could come up with a better/different short sample program than the one I use in http://opencobol.add1tocobol.com/#forever The one I have also demonstrates the CYCLE clause of EXIT PERFORM, but reading it, it seems a little, umm, lame for what is a pretty powerful program flow construct. [i]Plus I'd like to show off a little more community involvement and spread some credit around.[/i] Cheers, Brian ---------------------------------------------------------------- I think it's fine and think you should leave it as it is... human ---------------------------------------------------------------- human; I know it's "fine", kinda, but I'm also trying to get some of the lurkers out into the open. :-) Hoping that some small steps will lead to bigger bolder steps. Plus, the post was a thinly veiled self promotion and the, [i]as always[/i], greater desire to inform that OpenCOBOL supports FOREVER along with EXIT PERFORM CYCLE. As I add reserved words to the FAQ in the future, I may post up more of these challenges [i]in a thinly veiled disguise to highlight the feature[/i]. Cheers, Brian ---------------------------------------------------------------- As one of the "lurkers", may I offer an excuse. I think that many of us who do not make a contribution, are ordinary cobol people who know nothing of C or web based extensions or GUI or database extensions. Much of the discussion here seems pretty esoteric. There is no place where one feels that it would be appropriate to post ordinary basic cobol programs or even tips. I think this is a pity, but I don't have any solutions. Going way back to the computer language cobol group in the pre YK2 years, it was apparent that cobol programmers were a most ungenerous lot. "Do your own homework", and "I do this for money not for free" were common responses with a few exceptions like WM Klein and J McLendon. Perhaps the decline of cobol might have made people more open. Even though cobol is the accounting language, you can't I think find books with debtors, creditors, stock payroll and general ledger. You can find them in basic, but not cobol. I think that if there was a place where low level people could contribute, perhaps they might. It is not approprate to clutter up this forum, but it would need to be a place which is just as simple to write to, else most of us would be unable to join in. John. ---------------------------------------------------------------- Thanks for the post John. Exactly the catch-22 I wanted to break here. OpenCOBOL is for sharing. And yes, old school COBOL is/was very much "top-secret, tight lipped programming". We can change that. No need to feel you have to talk C bindings, or GUI or highfalutin issues. A nice challenge on a short sample of PERFORM FOREVER do some thing now get me outta here do some other thing END-PERFORM was what I wanted to start up. A sample on a neat INSPECT trick, or a blurb on preferred section/paragraph naming. Anything. OpenCOBOL doesn't have to be closed like the olden days. [i]And to be honest, it is to great credit that most COBOLers kept their tight lips, when I just know that some of them wanted to help, or point out mistakes, or show off, but couldn't, due to the nature of the work they were/are doing.[/i] We can, and we should, flap some loose lips. :-) Do that here on opencobol.org. I'd read the posts, and feel better for the reading, and the learning, of all the old and new techniques. I blather on with samples and bindings to show what OpenCOBOL is capable of, but a pure COBOL discussion would be more than welcome. It'd be appreciated. Unless it sounds like actual homework and it'd hurt more than help, there won't be many "Do your own homework" remarks...umm, I hope ([i]no, I'm pretty sure[/i]). [b]To everyone[/b]; join in, the water's fine. ;-) In the FAQ as it stands, there are over 500 reserved words in section 4 and only a mere hundred or so have code samples. I'd gladly read submissions here, get permission and then include them (with or without credit at author's desire) for everyone's benefit. If we start to overwhelm the forum and people want to direct compiler questions to Roger, we can work out a way to keep his perception of the signal to noise ratio high enough for productive usage of time. Cheers, Brian ---------------------------------------------------------------- Did not know that existed. >>SOURCE FORMAT IS FREE id division. program-id. read_forever. environment division. input-output section. file-control. select my-file organization line sequential assign to "myfile". data division. file section. fd my-file. 01 my-record pic x(80). procedure division. open input my-file perform forever read my-file at end exit perform end-read display my-record end-perform close my-file goback. Cool. No need for a goto, a file status, or any working-storage at all. Too bad it's apparently not standard. ---------------------------------------------------------------- Yep, no standard - but a real nice extension. If you want to do this the standard way do [code] [...] perform until 0 = 1 read my-file at end exit perform end-read display my-record end-display end-perform [...] OpenCOBOL may supports PERFORM UNTIL EXIT, too (this is a MF extension, if I remember this correct). human ---------------------------------------------------------------- OK Brian here is how we did this in the original dialects of COBOL. In an effort to show how the language has changed, I offer the following version of Brian's program. While many styles can be effectively used in COBOL programming, this program is an example of the style used in programming shops where I worked. The first six columns of each source line were reserved for the source code sequence number (usually page and line number). We generally used the first three columns to represent the ascending page number and the last three for the line number on the page. Skipping ten numbers between each original line allowed us to insert additional lines when needed. You can see that an insertion was made at 001045. These sequence numbers were desirable in that the program was punched on cards with one card for each line. If the source card deck was accidently dropped the sequence numbers allowed us to get the source deck back into order. You will also notice that the code is all in uppercase. Quite simply, early line printers could not print lowercase. Take a look at line 001080. While even early compilers would have allowed us to write "VALUE 0" we would spell out the word zero since the difference in appearance between an alphabetic letter O and a numeric zero was easy to miss when reading the program. All of the environment division has been left out of this program, although it was almost always necessary. The numbers after "FOREVERLOOP" on line 001070 were the version number of the program. It was our habit to keep a journal (in comment lines) at the beginning of the program describing modifications that were made to the program. The variable names start with "WS-". This allowed the reader of the program to understand that the variable in question was in the WORKING-STORAGE instead of being part of a file descriptor, thus making it easier to find. Numeric fields were almost always signed, both for efficiency at run-time and to allow for the possibility of a value going negative even if it should not. COMP asked the compiler to use the most efficient method to store the value on the architecture on which the program was going to run. You will see that the display statements start their display with "I) ". We used this to make reading console output easier. "I)" was for normal information, "W)" was for warnings, and "T)" was for terminal conditions. From a syntactical standpoint this code was written to the COBOL-68 standard. Structured programming constructs were not available. Paragraphs were numbered in ascending sequence in order to make finding a paragraph easier. Sentences were kept short and periods were used as often as we could use them. 001010 IDENTIFICATION DIVISION. 001020 PROGRAM-ID. FOREVERLOOP. 001030* 001040 DATA DIVISION. 001050 WORKING-STORAGE SECTION. 001060 01 WS-PROGRAM-NAME PIC X(16) 001070 VALUE "FOREVERLOOP 001". 001080 01 WS-COBOL PIC S9 COMP VALUE ZERO. 001090 01 WS-C PIC S9 COMP VALUE 1. 001100 01 WS-FORTRAN PIC S9 COMP VALUE 2. 001110 01 WS-ED1S PIC Z-. 001110* 001010 PROCEDURE DIVISION. 001020 DISPLAY "I) PROGRAM ", WS-PROGRAM-NAME, " BEGINNING". 001030 0100-LOOP. 001040 ADD 1 TO WS-COBOL. 001045 MOVE WS-COBOL TO WS-ED1S. 001050 DISPLAY "I) COBOL AT ", WS-ED1S. 001060 IF WS-COBOL IS GREATER THAN WS-FORTRAN 001070 THEN GO TO 0800-ENDER. 001080 IF WS-COBOL IS EQUAL TO 1 001090 THEN DISPLAY "I) COBOL STILL CREEPING UP ON C". 001100 GO TO 0100-LOOP. 001110* 001120 0800-ENDER. 001130 DISPLAY "I) COBOL SURPASSED C AND FORTRAN". 001140 DISPLAY "I) PROGRAM ", WS-PROGRAM-NAME, " TERMINATED". 001150* 001160 STOP RUN. The run-time output is below: [code] I) PROGRAM FOREVERLOOP 001 BEGINNING I) COBOL AT 1 I) COBOL STILL CREEPING UP ON C I) COBOL AT 2 I) COBOL AT 3 I) COBOL SURPASSED C AND FORTRAN I) PROGRAM FOREVERLOOP 001 TERMINATED [/code] Please note that I am not advocating this style. However it is a good example of traditional methods. ---------------------------------------------------------------- You made one "syntax" error for duplicating "old-style" (required for Standard conformance) programming. You hae DISPLAY statement immediately following the PROCEDURE DIVISON header. Up until "more recent" Standards, you were required to have either a section or paragraph header and could NOT have statements "outside" of a named procedure. P.S. In the days of "numbered lines" and all upper-case, you probably would have also had a REMARKS paragraph, but that was optional. ---------------------------------------------------------------- As is usually the case, Mr. Klein is correct. :-) Chalk it up to CRS (Can't Remember Stuff). Yes the "old-style" relied a lot more on the environment division, including the ability to specify both a source computer and an object computer. This would allow the compilers that supported it to output different object code depending on the object computer specified. A compile of a simple listing program done on a four tape 1401 would take about 15 minutes and then you had to run the result through the Autocoder macro assembler. The 360's would generally compile directly (without the Autocoder step) and would get the job done in a few minutes but if you were not authorized to be in the computer room you had to wait until someone in production saw fit to run your compile for you. ---------------------------------------------------------------- Like OMG! I learned COBOL on the 1401. And I remember pops letting me practice on the week ends on the 360. Good times... But the PC is so much more convenient! ---------------------------------------------------------------- Now thats what I'm talking about. John, Jim, Frank, Bill, human; If you don't mind, I'd like to include nearly this entire thread in the FAQ, (under what heading I'm not sure, but this is some wicked good COBOL technical [i]and cultural[/i] wisdom). Damon; not to worry, I plan on including as many of your snippets as the future will bear. ;-) More of this please...[i]he said, hinting towards the anonymous readers[/i]. Cheers, Brian ---------------------------------------------------------------- I added a more contemporary method of doing the same thing for the COBOL newbies. 001010 IDENTIFICATION DIVISION. 001020 PROGRAM-ID. FOREVERLOOP. 001030* 021611************************************************************** 021611* * 021611* This program will demonstrate various techniques and * 021611* coding styles. * 021611* * 021611* Version 001--Shows a COBOL68 technique * 021611* 02/15/2011--J C Currey * 021611* * 021611* Version 002--Shows an OpenCOBOL 1.1 technique * 021611* 02/16/2011--J C Currey * 021611* * 021611************************************************************** 001040 DATA DIVISION. 001050 WORKING-STORAGE SECTION. 001060 01 WS-PROGRAM-NAME PIC X(16) 021611 VALUE "FOREVERLOOP 002". 001080 01 WS-COBOL PIC S9 COMP VALUE ZERO. 001090 01 WS-C PIC S9 COMP VALUE 1. 001100 01 WS-FORTRAN PIC S9 COMP VALUE 2. 001110 01 WS-ED1S PIC Z-. 001110* 001010 PROCEDURE DIVISION. 001020 DISPLAY "I) PROGRAM ", WS-PROGRAM-NAME, " BEGINNING". 021611* 021611* THIS CODE SHOWS HOW WE WOULD DO IT WITH COBOL68 021611* 001030 0100-LOOP. 001040 ADD 1 TO WS-COBOL. 001045 MOVE WS-COBOL TO WS-ED1S. 001050 DISPLAY "I) COBOL AT ", WS-ED1S. 001060 IF WS-COBOL IS GREATER THAN WS-FORTRAN 001070 THEN GO TO 0800-ENDER. 001080 IF WS-COBOL IS EQUAL TO 1 001090 THEN DISPLAY "I) COBOL STILL CREEPING UP ON C". 001100 GO TO 0100-LOOP. 001110* 001120 0800-ENDER. 001130 DISPLAY "I) COBOL SURPASSED C AND FORTRAN". 021611 DISPLAY " ". 021611* 021611* Now we will do the same thing a newer way 021611* 021611 perform with test after 021611 varying ws-cobol from 1 by 1 021611 until ws-cobol is greater than ws-fortran 021611 move ws-cobol to ws-ed1s 021611 display "I) COBOL at ", ws-ed1s 021611 evaluate ws-cobol 021611 when 1 021611 display "I) COBOL still creeping up on C" 021611 when 3 021611 display "I) COBOL surpassed C and FORTRAN" 021611 end-evaluate 021611 end-perform. 021611* 001140 DISPLAY "I) PROGRAM ", WS-PROGRAM-NAME, " TERMINATED". 001150* 001160 STOP RUN. The explanation was then updated In an effort to show how the language has changed, I offer the following version of Brian's program. While many styles can be effectively used in COBOL programming, this program is an example of the style used in programming shops where I worked. The first six columns of each source line were reserved for the source code sequence number (usually page and line number). We generally used the first three columns to represent the ascending page number and the last three for the line number on the page. Skipping ten numbers between each original line allowed us to insert additional lines when needed. You can see that an insertion was made at 001045. These sequence numbers were desirable in that the program was punched on cards with one card for each line. If the source card deck was accidently dropped the sequence numbers allowed us to get the source deck back into order. You will also notice that the code is all in uppercase. Quite simply, early line printers could not print lowercase. Take a look at line 001080. While even early compilers would have allowed us to write "VALUE O" we would spell out the word zero since the difference in appearance between an alphabetic letter O and a numeric zero was easy to miss when reading the program. All of the environment division has been left out of this program, although it was almost always necessary. The numbers after "FOREVERLOOP" on line 001070 were the version number of the program. It was our habit to keep a journal (in comment lines) at the beginning of the program describing modifications that were made to the program. The variable names start with "WS-". This allowed the reader of the program to understand that the variable in question was in the WORKING- STORAGE instead of being part of a file descriptor, thus making it easier to find. Numeric fields were almost always signed, both for efficiency at run-time and to allow for the possibility of a value going negative even if it should not. COMP asked the compiler to use the most efficient method to store the value on the architecture on which the program was going to run. You will see that the display statements start their display with "I) ". We used this to make reading console output easier. "I)" was for normal information, "W)" was for warnings, and "T)" was for terminal conditions. From a syntactical standpoint this code was written to the COBOL-68 standard. Structured programming constructs were not available. Paragraphs were numbered in ascending sequence in order to make finding a paragraph easier. ************************* Version 002 shows how one might code the application with OpenCOBOL 1.1. A modification log has been added via comments at the beginning of the program. Note that the sequence numbers are now being used to store the date that the new or changed code was made. By looking at the modification date and then referring to the modification log, one can determine what changed from version to version. Structured programming constructs have been used. I expect that there may be some discussion as to which method is easier to read and understand. jimc ---------------------------------------------------------------- This is a variation of the 'perform forever' program. >>SOURCE FORMAT IS FREE program-id. "readForever". _>_> _> Author. rkeane_> Written: 16 Feb 2011 _> Purpose: A variation of submitted "read-forever"_> environment division. input-output section. file-control. select my-file assign to "myFile" organization line sequential. data division. file section. fd myFile. 01 myRecord pic x(80). working-storage section. *> procedure division. main. open input myFile perform forever read myFile not at end display myRecord at end perform finish goback *>Program exit end-read _>End read myFile end-perform_>End perform forever exit. finish. close my-file exit. Using non-structured statements: procedure division. main. open input myFile. 0100-loop. read myFile next record at end close myFile stop run. display myRecord. go to 0100-loop. ---------------------------------------------------------------- I don't know if anyone else is getting this sensation, but is COBOL becoming cool enough for the internet generation now? Thanks to open folk and OpenCOBOL? [i]Or did I just jinx the tide?[/i] :-) Cheers, Brian ---------------------------------------------------------------- I found the thread a nice read. And to top it off, for me, Roger added a nice idiom in a separate thread for avoiding paragraphs and sections. Not FOREVER related, but a nice use for an "empty" inline PERFORM. Yep, One thing that I saw on earlier posts to the newsgroup cobol was - What is the need/justification for an empty inline perform group. ie. PERFORM ... END-PERFORM None of the discussions then realized that there is a - EXIT PERFORM [CYCLE] Therefore, it is a method to to define an exit condition without having paragraphs. ie. (very simply) PERFORM READ xxx AT END EXIT PERFORM END-READ MOVE something TO somewhere END-PERFORM .. test xxx status and somewhere There are, of course, other variations. Basically, it means that you code without using section/paragraphs. (Recommended, if only from performance point of view) Note that the CYCLE option offers interesting possibilities. Roger  File: gcfaq.info, Node: POSIX, Next: BITWISE, Prev: Performing FOREVER?, Up: Notes 6.20 POSIX ========== An acronym first suggested by Richard Stallman for the IEEE specification for maintaining compatibility between operating systems. IEEE Std 1003.1-1988. POSIX Portable Operating System Interface  File: gcfaq.info, Node: BITWISE, Next: Getting Started with esqlOC, Prev: POSIX, Up: Notes 6.21 BITWISE ============ A COBOL source code solution to bit operations. *BITWISE.cbl* 000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. BITWISE. 000300 AUTHOR. PAUL CHANDLER. 000400******************************************************** 000500*** *** 000600*** COPYRIGHT PAUL CHANDLER 1976, 1994, 2012. *** 000700*** *** 000800*** THIS PROGRAM IS FREE SOFTWARE: YOU CAN *** 000900*** REDISTRIBUTE IT AND/OR MODIFY IT UNDER THE TERMS *** 001000*** OF THE GNU LESSER GENERAL PUBLIC LICENSE AS *** 001100*** PUBLISHED BY THE FREE SOFTWARE FOUNDATION, EITHER*** 001200*** VERSION 3 OF THE LICENSE, OR (AT YOUR OPTION) ANY*** 001300*** LATER VERSION. *** 001400*** *** 001500*** THIS PROGRAM IS DISTRIBUTED IN THE HOPE THAT IT *** 001600*** WILL BE USEFUL,BUT WITHOUT ANY WARRANTY; WITHOUT *** 001700*** EVEN THE IMPLIED WARRANTY OF MERCHANTABILITY OR *** 001800*** FITNESS FOR A PARTICULAR PURPOSE.SEE THE GNU *** 001900*** LESSER GENERAL PUBLIC LICENSE FOR MORE DETAILS. *** 002000*** *** 002100*** YOU SHOULD HAVE RECEIVED A COPY OF THE GNU LESSER*** 002200*** GENERAL PUBLIC LICENSE ALONG WITH THIS PROGRAM. *** 002300*** IF NOT, A COPY MAY BE OBTAINED AT: *** 002400*** HTTP://WWW.GNU.ORG/LICENSES/ *** 002500*** *** 002600*** ===== BITWISE VERSION 1.0 ===== *** 002700*** *** 002800*** INITIAL VERSION: JULY 1974. *** 002900*** LAST UPDATED...: APRIL 2013 *** 003000*** *** 003100*** THIS PROGRAM PERFORMS BITWISE OPERATIONS ON AN *** 003200*** INPUT BYTE, USING THE PRINCIPLE OF 'INVERSE *** 003300*** BINARY WEIGHTING'. *** 003400*** *** 003500*** THE PROCESS IS: *** 003600*** (A) THE CONTENTS OF THE LINKAGE SECTION *** 003700*** (BITWISE-PARMS) ARE SYNTAX-CHECKED. IF ERRORS*** 003800*** ARE ENCOUNTERED, A CODE IDENTIFYING THE *** 003900*** ERROR IS RETURNED TO THE CALLING PROGRAM IN *** 004000*** FIELD BWP-RETURN-CODE. *** 004100*** (B) THE UNARY OPERAND (AND THE BINARY OPERAND IF *** 004200*** OP IS 'AND', 'OR', OR 'XOR') ARE CONVERTED *** 004300*** TO AN 8-CHARACTER PATTERN OF THE VALUE'S *** 004400*** BINARY EQUIVALENT (EG. 'A' IS CONVERTED TO *** 004500*** '01000001' IN THE ASCII CHARACTER SET. *** 004600*** *** 004700*** (C) THE OP SPECIFIED IN FLD BWP-OP IS PERFORMED *** 004800*** USING THE OPERANDS AS APPROPRIATE. THE RESULT*** 004900*** IS TEMPORARILY STORED AS AN 8-CHARACTER *** 005000*** PATTERN IN FIELD BWP-RESULT. *** 005100*** *** 005200*** (D) BWP-RESULT IS CONVERTED TO THE FORMAT SET BY *** 005300*** THE CALLING PROGRAM IN FIELD BWP-FMT-RESULT *** 005400*** AND CONTROL IS RETURNED TO THE CALLER. *** 005500*** *** 005600*** ADDITIONAL DETAIL FOR THE USE OF THIS PROGRAM *** 005700*** IS PROVIDED IN THE ACCOMPANYING DOCUMENTATION. *** 005800******************************************************** 005900 ENVIRONMENT DIVISION. 006000 DATA DIVISION. 006100 FILE SECTION. 006200 WORKING-STORAGE SECTION. 006300 01 WORKBENCH-FLDS. 006400 05 WBF-FLAGS. 006500 10 WBF-FLAG-VALIDATE PIC X(01). 006600 88 WBF-INPUT-VALID VALUE 'Y'. 006700 05 WBF-BINARIES BINARY. 006800 10 WBF-STARTING-WEIGHT PIC S9(04) 006900 VALUE +128. 007000 10 WBF-SCALE PIC S9(04). 007100 10 WBF-CURRENT-BIT PIC S9(04). 007200 10 WBF-CHK-PTN-CNT PIC S9(04). 007300 88 WBF-CHK-PTN-ERR VALUE 0 THRU 7. 007400 05 WBF-CHAR. 007500 10 WBF-UNARY PIC X(08). 007600 10 WBF-BINARY PIC X(08). 007700 10 WBF-CHK PIC X(08). 007800 10 WBF-CHK-PTN-RDF REDEFINES WBF-CHK. 007900 15 WBF-CHK-PTN PIC X(08). 008000 10 WBF-CHK-BIN-RDF REDEFINES WBF-CHK. 008100 15 WBF-CHK-BIN PIC 9(04) BINARY. 008200 88 WBF-CHK-BIN-OK VALUE 0 THRU 255. 008300 15 FILLER PIC X(06). 008400 05 WBF-INPT-VAL. 008500 10 WBF-INPT-AREA-CHR. 008600 15 FILLER PIC X(01) 008700 VALUE LOW-VALUES. 008800 15 WBF-INPT-VAL-CHR PIC X(01). 008900 10 WBF-INPT-AREA-BIN REDEFINES WBF-INPT-AREA-CHR. 009000 15 WBF-INPT-VAL-BIN PIC 9(04) BINARY. 009100 05 WBF-PACK-FMT PIC X(01). 009200 88 WBF-PACK-FMT-PTRN VALUE 'P'. 009300 88 WBF-PACK-FMT-BNRY VALUE 'B'. 009400 88 WBF-PACK-FMT-CHAR VALUE 'C'. 009500 05 WBF-PACK PIC X(08). 009600 05 WBF-PACK-RDF-BIN REDEFINES WBF-PACK. 009700 10 WBF-PACK-BIN PIC 9(04) BINARY. 009800 10 WFILLER PIC X(06). 009900 05 WBF-PACK-RDF-CHR REDEFINES WBF-PACK. 010000 10 FILLER PIC X(01). 010100 10 WBF-PACK-CHR PIC X(01). 010200 10 FILLER PIC X(06). 010300 LINKAGE SECTION. 010400 COPY BWPARMS. 010500 PROCEDURE DIVISION USING BITWISE-PARMS. 010600 PERFORM 10000-VALIDATE 010700 IF BWP-NO-ERRORS 010800 IF BWP-OP-XLAT 010900 PERFORM 20000-BWP-OP-XLAT 011000 ELSE 011100 PERFORM 30000-BWP-OP-TEST 011200 END-IF 011300 END-IF 011400 GOBACK 011500 . 011600 10000-VALIDATE. 011700 SET BWP-NO-ERRORS TO TRUE 011800 IF NOT BWP-OP-VALID 011900 SET BWP-OP-ERROR TO TRUE 012000 END-IF 012100 IF NOT BWP-FMT-UNARY-VALID 012200 SET BWP-FMT-UNARY-ERROR TO TRUE 012300 END-IF 012400 IF BWP-FMT-UNARY-PTRN 012500 MOVE BWP-UNARY-PTN TO WBF-CHK-PTN 012600 PERFORM 11000-CHK-PTN 012700 IF WBF-CHK-PTN-ERR 012800 SET BWP-PTN-UNARY-ERROR 012900 TO TRUE 013000 END-IF 013100 END-IF 013200 IF BWP-FMT-UNARY-BNRY 013300 MOVE BWP-UNARY-BIN TO WBF-CHK-BIN 013400 IF NOT WBF-CHK-BIN-OK 013500 SET BWP-UNARY-OVF-ERROR 013600 TO TRUE 013700 END-IF 013800 END-IF 013900 IF BWP-OP-BINARY 014000 IF NOT BWP-FMT-BINARY-VALID 014100 SET BWP-FMT-BINARY-ERROR 014200 TO TRUE 014300 END-IF 014400 IF BWP-FMT-BINARY-PTRN 014500 MOVE BWP-BINARY-PTN TO WBF-CHK-PTN 014600 PERFORM 11000-CHK-PTN 014700 IF WBF-CHK-PTN-ERR 014800 SET BWP-PTN-BINARY-ERROR 014900 TO TRUE 015000 END-IF 015100 END-IF 015200 IF BWP-FMT-BINARY-BNRY 015300 MOVE BWP-BINARY-BIN TO WBF-CHK-BIN 015400 IF NOT WBF-CHK-BIN-OK 015500 SET BWP-BINARY-OVF-ERROR 015600 TO TRUE 015700 END-IF 015800 END-IF 015900 END-IF 016000 IF NOT BWP-FMT-RESULT-VALID 016100 SET BWP-FMT-RESULT-ERROR TO TRUE 016200 END-IF 016300 . 016400 11000-CHK-PTN. 016500 MOVE ZERO TO WBF-CHK-PTN-CNT 016600 INSPECT WBF-CHK-PTN 016700 TALLYING WBF-CHK-PTN-CNT FOR ALL '0' 016800 INSPECT WBF-CHK-PTN 016900 TALLYING WBF-CHK-PTN-CNT FOR ALL '1' 017000 . 017100 20000-BWP-OP-XLAT. 017200 MOVE BWP-FMT-UNARY TO WBF-PACK-FMT 017300 EVALUATE TRUE 017400 WHEN BWP-FMT-UNARY-BNRY 017500 MOVE BWP-UNARY-BIN TO WBF-PACK-BIN 017600 WHEN BWP-FMT-UNARY-CHAR 017700 MOVE BWP-UNARY-CHR TO WBF-PACK-CHR 017800 WHEN OTHER 017900 MOVE BWP-UNARY TO WBF-PACK 018000 END-EVALUATE 018100 PERFORM 40000-PACK 018200 PERFORM 50000-TRANSLATE 018300 IF BWP-FMT-RESULT-BNRY 018400 OR BWP-FMT-RESULT-CHAR 018500 MOVE BWP-RESULT TO WBF-PACK 018600 MOVE 'P' TO WBF-PACK-FMT 018700 PERFORM 40000-PACK 018800 IF BWP-FMT-RESULT-BNRY 018900 MOVE SPACES TO BWP-RESULT 019000 MOVE WBF-PACK-BIN TO BWP-RESULT-BIN 019100 ELSE 019200 MOVE SPACES TO BWP-RESULT 019300 MOVE WBF-PACK-CHR TO BWP-RESULT-CHR 019400 END-IF 019500 END-IF 019600 . 019700 30000-BWP-OP-TEST. 019800 MOVE BWP-UNARY TO WBF-PACK 019900 EVALUATE TRUE 020000 WHEN BWP-FMT-UNARY-BNRY 020100 MOVE BWP-UNARY-BIN TO WBF-PACK-BIN 020200 WHEN BWP-FMT-UNARY-CHAR 020300 MOVE BWP-UNARY-CHR TO WBF-PACK-CHR 020400 WHEN OTHER 020500 MOVE BWP-UNARY TO WBF-PACK 020600 END-EVALUATE 020700 MOVE BWP-FMT-UNARY TO WBF-PACK-FMT 020800 PERFORM 40000-PACK 020900 PERFORM 50000-TRANSLATE 021000 MOVE BWP-RESULT TO WBF-UNARY 021100 MOVE BWP-BINARY TO WBF-PACK 021200 MOVE BWP-FMT-BINARY TO WBF-PACK-FMT 021300 EVALUATE TRUE 021400 WHEN BWP-FMT-BINARY-BNRY 021500 MOVE BWP-BINARY-BIN TO WBF-PACK-BIN 021600 WHEN BWP-FMT-BINARY-CHAR 021700 MOVE BWP-BINARY-CHR TO WBF-PACK-CHR 021800 WHEN OTHER 021900 MOVE BWP-BINARY TO WBF-PACK 022000 END-EVALUATE 022100 PERFORM 40000-PACK 022200 PERFORM 50000-TRANSLATE 022300 MOVE BWP-RESULT TO WBF-BINARY 022400 MOVE ZEROES TO BWP-RESULT 022500 EVALUATE TRUE 022600 WHEN BWP-OP-AND 022700 PERFORM VARYING WBF-CURRENT-BIT FROM 1 BY 1 022800 UNTIL WBF-CURRENT-BIT > 8 022900 IF WBF-BINARY (WBF-CURRENT-BIT:1) = '1' 023000 AND WBF-UNARY (WBF-CURRENT-BIT:1) = '1' 023100 MOVE '1' TO BWP-RESULT 023200 (WBF-CURRENT-BIT:1) 023300 END-IF 023400 END-PERFORM 023500 WHEN BWP-OP-OR 023600 PERFORM VARYING WBF-CURRENT-BIT FROM 1 BY 1 023700 UNTIL WBF-CURRENT-BIT > 8 023800 IF WBF-BINARY (WBF-CURRENT-BIT:1) = '1' 023900 OR WBF-UNARY (WBF-CURRENT-BIT:1) = '1' 024000 MOVE '1' TO BWP-RESULT 024100 (WBF-CURRENT-BIT:1) 024200 END-IF 024300 END-PERFORM 024400 WHEN BWP-OP-XOR 024500 PERFORM VARYING WBF-CURRENT-BIT FROM 1 BY 1 024600 UNTIL WBF-CURRENT-BIT > 8 024700 IF WBF-UNARY (WBF-CURRENT-BIT:1) NOT EQUAL 024800 WBF-BINARY (WBF-CURRENT-BIT:1) 024900 MOVE '1' TO BWP-RESULT 025000 (WBF-CURRENT-BIT:1) 025100 END-IF 025200 END-PERFORM 025300 WHEN BWP-OP-NOT 025400 PERFORM VARYING WBF-CURRENT-BIT FROM 1 BY 1 025500 UNTIL WBF-CURRENT-BIT > 8 025600 IF WBF-UNARY (WBF-CURRENT-BIT:1) = '0' 025700 MOVE '1' TO BWP-RESULT 025800 (WBF-CURRENT-BIT:1) 025900 END-IF 026000 END-PERFORM 026100 END-EVALUATE 026200 IF BWP-FMT-RESULT-BNRY 026300 OR BWP-FMT-RESULT-CHAR 026400 MOVE BWP-RESULT TO WBF-PACK 026500 MOVE 'P' TO WBF-PACK-FMT 026600 PERFORM 40000-PACK 026700 IF BWP-FMT-RESULT-BNRY 026800 MOVE SPACES TO BWP-RESULT 026900 MOVE WBF-PACK-BIN TO BWP-RESULT-BIN 027000 ELSE 027100 MOVE SPACES TO BWP-RESULT 027200 MOVE WBF-PACK-CHR TO BWP-RESULT-CHR 027300 END-IF 027400 END-IF 027500 . 027600 40000-PACK. 027700 EVALUATE TRUE 027800 WHEN WBF-PACK-FMT-BNRY 027900 MOVE WBF-PACK-BIN TO WBF-INPT-VAL-BIN 028000 WHEN WBF-PACK-FMT-CHAR 028100 MOVE WBF-PACK-CHR TO WBF-INPT-VAL-CHR 028200 WHEN OTHER 028300 MOVE 0 TO WBF-INPT-VAL-BIN 028400 MOVE WBF-STARTING-WEIGHT TO WBF-SCALE 028500 PERFORM VARYING WBF-CURRENT-BIT FROM 1 BY 1 028600 UNTIL WBF-CURRENT-BIT > 8 028700 IF WBF-PACK (WBF-CURRENT-BIT:1) = '1' 028800 ADD WBF-SCALE 028900 TO WBF-INPT-VAL-BIN 029000 END-IF 029100 COMPUTE WBF-SCALE = WBF-SCALE / 2 029200 END-PERFORM 029300 MOVE SPACES TO WBF-PACK 029400 MOVE WBF-INPT-VAL-BIN TO WBF-PACK-BIN 029500 END-EVALUATE 029600 . 029700 50000-TRANSLATE. 029800 MOVE WBF-STARTING-WEIGHT TO WBF-SCALE 029900 MOVE ALL ZEROES TO BWP-RESULT 030000 MOVE 1 TO WBF-CURRENT-BIT 030100 PERFORM VARYING WBF-CURRENT-BIT FROM 1 BY 1 030200 UNTIL WBF-CURRENT-BIT > 8 030300 IF WBF-INPT-VAL-BIN >= WBF-SCALE 030400 MOVE '1' TO BWP-RESULT 030500 (WBF-CURRENT-BIT:1) 030600 COMPUTE WBF-INPT-VAL-BIN = 030700 WBF-INPT-VAL-BIN - WBF-SCALE 030800 END-IF 030900 COMPUTE WBF-SCALE = WBF-SCALE / 2 031000 END-PERFORM 031100 . 031200 END PROGRAM BITWISE. and *BWPARMS.cbl* 000010***************************************************************** 000020* CALLING AREA FOR THE 'BITWISE' SUBPROGRAM * 000021* WRITTEN BY.....: PAUL CHANDLER. * 000022* INITIAL VERSION: JULY 1974. * 000023* LAST MODIFIED..: APRIL 2013. * 000030***************************************************************** 000100 01 BITWISE-PARMS. 00010000 000200 05 BWP-UNARY PIC X(08). 000210 05 BWP-UNARY-RDF-PTN REDEFINES BWP-UNARY. 000220 10 BWP-UNARY-PTN PIC X(08). 000300 05 BWP-UNARY-RDF-BIN REDEFINES BWP-UNARY. 000400 10 BWP-UNARY-BIN PIC 9(04) BINARY. 000500 10 FILLER PIC X(06). 000600 05 BWP-UNARY-RDF-CHR REDEFINES BWP-UNARY. 000700 10 BWP-UNARY-CHR PIC X(01). 000800 10 FILLER PIC X(07). 000900 05 BWP-BINARY PIC X(08). 000910 05 BWP-BINARY-RDF-PTN REDEFINES BWP-BINARY. 000920 10 BWP-BINARY-PTN PIC X(08). 001000 05 BWP-BINARY-RDF-BIN REDEFINES BWP-BINARY. 001100 10 BWP-BINARY-BIN PIC 9(04) BINARY. 001200 10 FILLER PIC X(06). 001300 05 BWP-BINARY-RDF-CHR REDEFINES BWP-BINARY. 001400 10 BWP-BINARY-CHR PIC X(01). 001500 10 FILLER PIC X(07). 001600 05 BWP-RESULT PIC X(08). 001610 05 BWP-RESULT-RDF-PTN REDEFINES BWP-RESULT. 001620 10 BWP-RESULT-PTN PIC X(08). 001700 05 BWP-RESULT-RDF-BIN REDEFINES BWP-RESULT. 001800 10 BWP-RESULT-BIN PIC 9(04) BINARY. 001900 10 FILLER PIC X(06). 002000 05 BWP-RESULT-RDF-CHR REDEFINES BWP-RESULT. 002100 10 BWP-RESULT-CHR PIC X(01). 002200 10 FILLER PIC X(07). 002300 05 BWP-OP PIC X(04). 002500 88 BWP-OP-XLAT VALUE 'XLAT'. 002600 88 BWP-OP-AND VALUE 'AND '. 002700 88 BWP-OP-OR VALUE 'OR '. 002800 88 BWP-OP-XOR VALUE 'XOR '. 002900 88 BWP-OP-NOT VALUE 'NOT '. 003000 88 BWP-OP-UNARY VALUE 'NOT ', 003100 'XLAT'. 003200 88 BWP-OP-BINARY VALUE 'AND ', 003300 'OR ', 003400 'XOR '. 003500 88 BWP-OP-VALID VALUE 'NOT ', 003600 'XLAT', 003700 'AND ', 003800 'OR ', 003900 'XOR '. 004000 05 BWP-FMTS. 004100 10 BWP-FMT-UNARY PIC X(01). 004300 88 BWP-FMT-UNARY-PTRN VALUE 'P'. 004400 88 BWP-FMT-UNARY-BNRY VALUE 'B'. 004500 88 BWP-FMT-UNARY-CHAR VALUE 'C'. 004600 88 BWP-FMT-UNARY-VALID VALUE 'B' 004700 'C' 004800 'P'. 005000 10 BWP-FMT-BINARY PIC X(01). 005200 88 BWP-FMT-BINARY-PTRN VALUE 'P'. 005300 88 BWP-FMT-BINARY-BNRY VALUE 'B'. 005400 88 BWP-FMT-BINARY-CHAR VALUE 'C'. 005500 88 BWP-FMT-BINARY-VALID VALUE 'B' 005600 'C' 005700 'P'. 005800 10 BWP-FMT-RESULT PIC X(01). 006000 88 BWP-FMT-RESULT-PTRN VALUE 'P'. 006100 88 BWP-FMT-RESULT-BNRY VALUE 'B'. 006200 88 BWP-FMT-RESULT-CHAR VALUE 'C'. 006300 88 BWP-FMT-RESULT-VALID VALUE 'B' 006400 'C' 006500 'P'. 006600 10 BWP-RETURN-CODE PIC 9(01). 006800 88 BWP-NO-ERRORS VALUE 0. 006900 88 BWP-OP-ERROR VALUE 1. 007000 88 BWP-FMT-UNARY-ERROR VALUE 2. 007100 88 BWP-FMT-BINARY-ERROR VALUE 3. 007200 88 BWP-FMT-RESULT-ERROR VALUE 4. 007300 88 BWP-PTN-UNARY-ERROR VALUE 5. 007400 88 BWP-PTN-BINARY-ERROR VALUE 6. 007500 88 BWP-UNARY-OVF-ERROR VALUE 7. 007600 88 BWP-BINARY-OVF-ERROR VALUE 8. and a small demo program, with intentional errors. 000100 IDENTIFICATION DIVISION. 00010000 000200 PROGRAM-ID. DEMO. 00020016 000300 AUTHOR. PAUL CHANDLER, APRIL 2013. 00030014 000400******************************************************** 00040000 000500*** THIS PROGRAM DEMO'S THE BITWISE TOOLBOX *** 00050036 000600******************************************************** 00060000 000700 ENVIRONMENT DIVISION. 00070000 000800 DATA DIVISION. 00080000 000900 FILE SECTION. 00090000 001000 WORKING-STORAGE SECTION. 00100000 001100 01 WS-BITWISE PIC X(08) 00110036 001200 VALUE 'BITWISE '. 00120037 001300 COPY BWPARMS. 00130036 001400 PROCEDURE DIVISION. 00140000 001500***=== ===*** 00150039 001600***=== TEST #1 ===*** 00160039 001700***=== A SIMPLE CONVERSION. GET A DISPLAYABLE =*** 00170039 001800***=== BIT BATTERN FOR THE CHARACTER 'A' =*** 00180039 001900***=== ===*** 00190039 002000 DISPLAY '* ' 00200029 002100 DISPLAY 00210028 002200 '*** CASE 1 - TRANSLATE ''A'', RETURN PATTERN ***' 00220028 002300 DISPLAY '* ' 00230029 002400 MOVE 'XLAT' TO BWP-OP 00240039 002500 MOVE 'A' TO BWP-UNARY-CHR 00250039 002600 MOVE 'C' TO BWP-FMT-UNARY 00260036 002700 MOVE SPACES TO BWP-BINARY 00270036 002800 BWP-FMT-BINARY 00280036 002900 MOVE 'P' TO BWP-FMT-RESULT 00290036 003000 PERFORM DISPLAY-INPUT 00300023 003100 CALL WS-BITWISE USING BITWISE-PARMS 00310036 003200 PERFORM DISPLAY-RETURN 00320024 003300* 00330030 003400***=== ===*** 00340039 003500***=== TEST #2 ===*** 00350039 003600***=== CONVERT THE PATTERN GENERATED IN CASE 1=*** 00360039 003700***=== TO ITS NUMERIC EQUIVALENT. =*** 00370039 003800***=== ===*** 00380039 003900 DISPLAY '* ' 00390029 004000 DISPLAY 00400029 004100 '*** CASE 2 - TAKE THE PATTERN WE JUST GENERATED *' 00410039 004200 '*** AND DISPLAY ITS NUMERIC VALUE *' 00420039 004300 DISPLAY '* ' 00430029 004400 MOVE BWP-RESULT-PTN TO BWP-UNARY 00440039 004500 MOVE 'P' TO BWP-FMT-UNARY 00450036 004600 MOVE 'B' TO BWP-FMT-RESULT 00460036 004700 PERFORM DISPLAY-INPUT 00470029 004800 CALL WS-BITWISE USING BITWISE-PARMS 00480036 004900 PERFORM DISPLAY-RETURN 00490029 005000* 00500030 005100* 00510039 005200***=== ===*** 00520039 005300***=== TEST #3 ===*** 00530039 005400***=== CONVERT THE NUMERIC GENERATED IN CASE 2=*** 00540039 005500***=== TO ITS CHARACTER EQUIVALENT, BRINGING =*** 00550039 005600***=== US BACK TO THE 'A' INPUT OF CASE 1 =*** 00560039 005700***=== ===*** 00570039 005800 DISPLAY '* ' 00580030 005900 DISPLAY 00590030 006000 '*** CASE 3 - TRANSLATE NUMERIC, RETURN CHAR ***' 00600030 006100 DISPLAY '* ' 00610030 006200 MOVE BWP-RESULT-BIN TO BWP-UNARY-BIN 00620039 006300 MOVE 'B' TO BWP-FMT-UNARY 00630036 006400 MOVE 'C' TO BWP-FMT-RESULT 00640036 006500 PERFORM DISPLAY-INPUT 00650030 006600 CALL WS-BITWISE USING BITWISE-PARMS 00660036 006700 PERFORM DISPLAY-RETURN 00670030 006800* 00680030 006810* 00681039 006820***=== ===*** 00682039 006830***=== TEST #4 ===*** 00683039 006840***=== 'OR' 2 NUMERICS TOGETHER AND RETURN ===*** 00684039 006850***=== THE RESULTING BINARY PATTERN =*** 00685039 006870***=== ===*** 00687039 006900 DISPLAY '* ' 00690031 007000 DISPLAY 00700031 007100 '*** CASE 4 - ''OR'' 15 & 240, RETURN PATTERN**' 00710031 007200 DISPLAY '* ' 00720031 007300 MOVE 'OR ' TO BWP-OP 00730036 007400 MOVE 15 TO BWP-UNARY-BIN 00740036 007500 MOVE 240 TO BWP-BINARY-BIN 00750036 007600 MOVE 'B' TO BWP-FMT-UNARY 00760036 007700 BWP-FMT-BINARY 00770036 007800 MOVE 'P' TO BWP-FMT-RESULT 00780036 007900 PERFORM DISPLAY-INPUT 00790031 008000 CALL WS-BITWISE USING BITWISE-PARMS 00800036 008100 PERFORM DISPLAY-RETURN 00810031 008200* 00820031 008220***=== ===*** 00822039 008230***=== TEST #5 ===*** 00823039 008240***=== 'AND' 2 NUMERICS TOGETHER AND RETURN ===*** 00824039 008250***=== THE RESULTING BINARY PATTERN =*** 00825039 008260***=== ===*** 00826039 008270* 00827039 008300 DISPLAY '* ' 00830032 008400 DISPLAY 00840032 008500 '*** CASE 5 - ''AND'' 255 & 70, RETURN PATTERN**' 00850032 008600 DISPLAY '* ' 00860032 008700 MOVE 'AND ' TO BWP-OP 00870036 008800 MOVE 255 TO BWP-UNARY-BIN 00880036 008900 MOVE 70 TO BWP-BINARY-BIN 00890036 009000 MOVE 'B' TO BWP-FMT-UNARY 00900036 009100 BWP-FMT-BINARY 00910036 009200 MOVE 'P' TO BWP-FMT-RESULT 00920036 009300 PERFORM DISPLAY-INPUT 00930032 009400 CALL WS-BITWISE USING BITWISE-PARMS 00940036 009500 PERFORM DISPLAY-RETURN 00950032 009510* 00951039 009520***=== ===*** 00952039 009530***=== TEST #6 ===*** 00953039 009540***=== 'NOT' A RANDOM PATTERN. WE'LL RETURN ===*** 00954039 009550***=== THE RSULT AS A PATTERN SO THAT THE BIT =*** 00955039 009551***=== INVERSION IS EASIER TO SEE. =*** 00955139 009560***=== ===*** 00956039 009570* 00957039 009700 DISPLAY '* ' 00970033 009800 DISPLAY 00980033 009900 '*** CASE 6 - ''NOT'' A RANDOM PATTERN**' 00990033 010000 DISPLAY '* ' 01000033 010100 MOVE 'NOT ' TO BWP-OP 01010036 010200 MOVE '10110101' TO BWP-UNARY 01020036 010300 MOVE 'P' TO BWP-FMT-UNARY 01030036 010400 PERFORM DISPLAY-INPUT 01040033 010500 CALL WS-BITWISE USING BITWISE-PARMS 01050036 010600 PERFORM DISPLAY-RETURN 01060033 010610* 01061039 010620***=== ===*** 01062039 010630***=== TEST #7 ===*** 01063039 010640***=== 'XOR' 2 PATTERNS. AGAIN, WE'LL RETURN===*** 01064039 010650***=== THE RSULT AS A PATTERN SO THAT THE BIT =*** 01065039 010660***=== INTERACTIONS EASIER TO SEE. =*** 01066039 010670***=== ===*** 01067039 010680* 01068039 010800 DISPLAY '* ' 01080035 010900 DISPLAY 01090035 011000 '*** CASE 7 - ''XOR'' PATTERN VS PATTERN' 01100035 011100 DISPLAY '* ' 01110035 011200 MOVE 'XOR ' TO BWP-OP 01120036 011300 MOVE '10110101' TO BWP-UNARY 01130036 011400 MOVE '01101100' TO BWP-BINARY 01140036 011500 MOVE 'P' TO BWP-FMT-UNARY 01150036 011600 BWP-FMT-BINARY 01160036 011700 PERFORM DISPLAY-INPUT 01170035 011800 CALL WS-BITWISE USING BITWISE-PARMS 01180036 011900 PERFORM DISPLAY-RETURN 01190035 011910* 01191039 011920***=== ===*** 01192039 011930***=== TESTS #8 AND #9 ===*** 01193039 011940***=== A COUPLE OF ERROR CASES. #8 TRIES TO ===*** 01194039 011950***=== TRANSLATE A PATTERN NOT CORRECTLY SET =*** 01195039 011960***=== TO ONES AND ZEROES, #9 TRIES TO CONVERT=*** 01196039 011961***=== A NUMERIC VALUE TOO LARGE TO FIT WITHIN=*** 01196139 011970***=== ONE BYTE. ===*** 01197039 011971***=== ===*** 01197139 011980* 01198039 012100 DISPLAY '* ' 01210038 012200 DISPLAY 01220038 012300 '*** CASE 8 - BAD PATTERN INPUT' 01230039 012400 DISPLAY '* ' 01240038 012500 MOVE 'XLAT' TO BWP-OP 01250038 012600 MOVE '1 ' TO BWP-UNARY 01260038 012700 MOVE 'P' TO BWP-FMT-UNARY 01270038 012800 PERFORM DISPLAY-INPUT 01280038 012900 CALL WS-BITWISE USING BITWISE-PARMS 01290038 013000 PERFORM DISPLAY-RETURN 01300038 013100* 01310038 013200 DISPLAY '* ' 01320038 013300 DISPLAY 01330038 013400 '*** CASE 9 - BAD BINARY INPUT' 01340039 013500 DISPLAY '* ' 01350038 013600 MOVE 256 TO BWP-UNARY-BIN 01360038 013700 MOVE 'B' TO BWP-FMT-UNARY 01370038 013800 PERFORM DISPLAY-INPUT 01380038 013900 CALL WS-BITWISE USING BITWISE-PARMS 01390038 014000 PERFORM DISPLAY-RETURN 01400038 014100* 01410038 014200 GOBACK 01420038 014300 . 01430004 014400 DISPLAY-INPUT. 01440023 014500 DISPLAY '* ' 01450029 014600 DISPLAY '***** INPUT *****' 01460027 014700 DISPLAY '* ' 01470029 014800 DISPLAY 'OP.........: ' BWP-OP 01480036 014900 IF BWP-FMT-UNARY-BNRY 01490036 015000 DISPLAY 'UNARY......: ' BWP-UNARY-BIN 01500036 015100 ELSE 01510027 015200 DISPLAY 'UNARY......: ' BWP-UNARY 01520036 015300 END-IF 01530027 015400 DISPLAY 'UNARY FMT..: ' BWP-FMT-UNARY 01540036 015500 IF BWP-OP-BINARY 01550036 015600 IF BWP-FMT-BINARY-BNRY 01560036 015700 DISPLAY 'BINARY.....: ' BWP-BINARY-BIN 01570036 015800 ELSE 01580027 015900 DISPLAY 'BINARY.....: ' BWP-BINARY 01590036 016000 END-IF 01600027 016100 DISPLAY 'BINARY FMT.: ' BWP-FMT-BINARY 01610036 016200 END-IF 01620023 016300 DISPLAY 'RESULT FMT.: ' BWP-FMT-RESULT 01630036 016400 . 01640025 016500 DISPLAY-RETURN. 01650023 016600 DISPLAY '*** ' 01660027 016700 DISPLAY '**** RETURN ****' 01670027 016800 DISPLAY '*** ' 01680027 016900 IF BWP-NO-ERRORS 01690036 017000 IF BWP-FMT-RESULT-BNRY 01700036 017100 DISPLAY 'RESULT = ' BWP-RESULT-BIN 01710036 017200 ELSE 01720023 017300 DISPLAY 'RESULT = ' BWP-RESULT 01730036 017400 END-IF 01740023 017500 ELSE 01750023 017600 DISPLAY 'ERROR ' BWP-RETURN-CODE 01760036 017700 END-IF 01770023 017800 DISPLAY '* ' 01780031 017900 . 01790025 018000 END PROGRAM DEMO. 01800016 Giving: * *** CASE 1 - TRANSLATE 'A', RETURN PATTERN *** * * ***** INPUT ***** * OP.........: XLAT UNARY......: A UNARY FMT..: C RESULT FMT.: P *** **** RETURN **** *** RESULT = 01000001 * * *** CASE 2 - TAKE THE PATTERN WE JUST GENERATED ** ** AND DISPLAY ITS NUMERIC VALUE * * * ***** INPUT ***** * OP.........: XLAT UNARY......: 01000001 UNARY FMT..: P RESULT FMT.: B *** **** RETURN **** *** RESULT = 0065 * * *** CASE 3 - TRANSLATE NUMERIC, RETURN CHAR *** * * ***** INPUT ***** * OP.........: XLAT UNARY......: 0065 UNARY FMT..: B RESULT FMT.: C *** **** RETURN **** *** RESULT = A * * *** CASE 4 - 'OR' 15 & 240, RETURN PATTERN** * * ***** INPUT ***** * OP.........: OR UNARY......: 0015 UNARY FMT..: B BINARY.....: 0240 BINARY FMT.: B RESULT FMT.: P *** **** RETURN **** *** RESULT = 11111111 * * *** CASE 5 - 'AND' 255 & 70, RETURN PATTERN** * * ***** INPUT ***** * OP.........: AND UNARY......: 0255 UNARY FMT..: B BINARY.....: 0070 BINARY FMT.: B RESULT FMT.: P *** **** RETURN **** *** RESULT = 01000110 * * *** CASE 6 - 'NOT' A RANDOM PATTERN** * * ***** INPUT ***** * OP.........: NOT UNARY......: 10110101 UNARY FMT..: P RESULT FMT.: P *** **** RETURN **** *** RESULT = 01001010 * * *** CASE 7 - 'XOR' PATTERN VS PATTERN * * ***** INPUT ***** * OP.........: XOR UNARY......: 10110101 UNARY FMT..: P BINARY.....: 01101100 BINARY FMT.: P RESULT FMT.: P *** **** RETURN **** *** RESULT = 11011001 * * *** CASE 8 - BAD PATTERN INPUT * * ***** INPUT ***** * OP.........: XLAT UNARY......: 1 UNARY FMT..: P RESULT FMT.: P *** **** RETURN **** *** ERROR 5 * * *** CASE 9 - BAD BINARY INPUT * * ***** INPUT ***** * OP.........: XLAT UNARY......: 0256 UNARY FMT..: B RESULT FMT.: P *** **** RETURN **** *** ERROR 7 * This code has been in production use for a lot of years now; thanks to Paul for sharing.  File: gcfaq.info, Node: Getting Started with esqlOC, Next: UDF, Prev: BITWISE, Up: Notes 6.22 Getting Started with esqlOC ================================ By user ati on the SourceForge GNU Cobol Discussion group: We could successfully test esqlOC (by Sergey) for our system and would like encourage others to give it a chance. So here it comes: * Menu: * esqlOC overview:: * What does this code do?:: * And this works with which database systems?:: * Does it really work?:: * Features:: * Getting started with esqlOC WinXP MySQL "OpenCOBOL 11" build by Sergey::  File: gcfaq.info, Node: esqlOC overview, Next: What does this code do?, Up: Getting Started with esqlOC 6.22.1 esqlOC overview ---------------------- The author of the system is Sergey Kashyrin: You can download it from: It provides "Embedded SQL" for GNU Cobol (formerly OpenCOBOL). With Embedded SQL you can insert SQL commands into your COBOL program: [...] * MOVE 0 TO hVar3 PERFORM UNTIL hVar3 > 2 COMPUTE hVar3 = hVar3 + 1 EXEC SQL SELECT TestCol1, TestCol2 INTO :hVar1, :hVar2 FROM TestTab WHERE TestCol1=:hVar3 END-EXEC IF SQLCODE NOT < 0 AND NOT = 100 DISPLAY 'SELECTED in LOOP iteration ' hVar3 DISPLAY ' hVar1 ' hVar1 ' hVar2 ' hVar2 END-IF END-PERFORM. [...] *  File: gcfaq.info, Node: What does this code do?, Next: And this works with which database systems?, Prev: esqlOC overview, Up: Getting Started with esqlOC 6.22.2 What does this code do? ------------------------------ In a PERFORM-loop we count our iterations. For every iteration number _hVar3=1,2,3_ we try to select a row from the database table _TestTab_. If there was no error and if we found a row * the value of column _TestCol1_ will be stored in the COBOL field _hVar1_ * the value of column _TestCol2_ will be stored in the COBOL field _hVar2_ and we can DISPLAY the values. Your COBOL compiler won't like the SQL part of the snippet. Therefore you need esqlOC, which translates code with "EXEC SQL" to "normal" COBOL code to make your compiler (_GNU Cobol_ of course) happy. This translation is called "precompilation", so esqlOC is a _precompiler_ for ESQL/COBOL. esqlOC comes with a runtime library (DLL) and needs the ODBC driver for your database of choice. It is programmed in C++ with MS Visual Studio but should be portable to other compilers.  File: gcfaq.info, Node: And this works with which database systems?, Next: Does it really work?, Prev: What does this code do?, Up: Getting Started with esqlOC 6.22.3 And this works with which database systems? -------------------------------------------------- This should work with every serious database system (Definition _serious database system_: One, which has an ODBC driver.) It worked with MS-SQL, MySQL, IBM-DB2. Sergey made some valuable choices: First: Embedded SQL Embedded SQL is an ISO/IEC standard: If you have to change your precompiler, you can keep most of your ESQL/COBOL code. Besides: Existing ESQL/COBOL code can be ported to _GNU Cobol_. Second: ODBC ODBC is an ISO/IEC standard: If you have to change your database system, you can keep your precompiler esqlOC. Yes, we COBOL programmers learned the hard way not to get too dependent...  File: gcfaq.info, Node: Does it really work?, Next: Features, Prev: And this works with which database systems?, Up: Getting Started with esqlOC 6.22.4 Does it really work? --------------------------- After _our_ tests for _our_ system: YES. As always with software: You have to test and decide for your system. We have tested esqlOC with Visual Studio-2010/WinXP/MySQL: 1. Load with ESQL/COBOL OpenCOBOL-Sequential file with 500 MB of data into 14 Tables with 412 columns. One of the tables has 132 columns. 2. Unload with ESQL/COBOL all the data to a new OpenCOBOL-Sequential file. 3. File compare: OpenCOBOL-Sequential files are identical. 4. Run different ESQL/COBOL programs with millions of DB interactions up to 50 Minutes: Identical output files, no exceptions, no problems with memory leaks. 5. We have successfully migrated 7 of our programs from files to DB.  File: gcfaq.info, Node: Features, Next: Getting started with esqlOC WinXP MySQL "OpenCOBOL 11" build by Sergey, Prev: Does it really work?, Up: Getting Started with esqlOC 6.22.5 Features --------------- * Connection strings with a ODBC data source name (DSN) are possible, e. g.: ''youruser/yourpasswd@yourODBC_DSN''. * Using Connection strings without DSN you can set database specific connection parameters (see example below). * Arbitrary Statements can be send to the database. * Host variables can also be declared in the 'LINKAGE SECTION'. You can hide all your esql/COBOL code in sub programs. * Indicator Variables (NULL values) are supported. They must be declared as '"PIC S9(4) COMP-5"' * Dynamic SQL is partly supported (see example below). * '"EXEC SQL PREPARE"' and '"EXEC SQL DESCRIBE"' are not supported. If you lookup the complex usage of these in COBOL, you won't miss them. If you always know at compile time the number, type and length of your IN and OUT parameters (host variables) you don't need them. Other ways you are invited to contribute to esqlOC, but it will be some work to do. * There is no programmatic limition (except sizeof(int)?) to the number of columns, number of host variables, length of data exchanged with the database. * Connection parameters set OFF: 'SQL_ATTR_CONNECTION_TIMEOUT, SQL_ATTR_AUTOCOMMIT'  File: gcfaq.info, Node: Getting started with esqlOC WinXP MySQL "OpenCOBOL 11" build by Sergey, Prev: Features, Up: Getting Started with esqlOC 6.22.6 Getting started with esqlOC (WinXP, MySQL, "OpenCOBOL 1.1" build by Sergey) ---------------------------------------------------------------------------------- 1. GNU Cobol You can get Binaries from: We use this version: "Win32 Windows (32-bit) VS2008" We unzip to: 'c:\OpenCobol_bin\' 2. esqlOC Download from: We unzip to: 'c:\esqlOC\' 3. MySQL with ODBC drivers see: You can get an installer or a zip archive here: Using the installer server and ODBC driver can be installed. Using the zip archive you have to install die ODBC driver separately. We install to: '%PROGRAMFILES%\MySQL5.6\' 4. ANSI-C Compiler We use Visual Studio 2010 Express (Visual Studio 2008 Express shoul also work). We install to the default path: '%PROGRAMFILES%\Microsoft Visual Studio 10.0\' 5. Save this example in a file: esqlOCGetStart1.sqb Look at the connection parameters and make changes. GNU * Cobol * IDENTIFICATION DIVISION. PROGRAM-ID. esqlOCGetStart1. DATA DIVISION. WORKING-STORAGE SECTION. EXEC SQL BEGIN DECLARE SECTION END-EXEC. 01 HOSTVARS. 05 BUFFER PIC X(1024). 05 hVarD PIC S9(5)V99. 05 hVarC PIC X(50). 05 hVarN PIC 9(12). EXEC SQL END DECLARE SECTION END-EXEC. PROCEDURE DIVISION. MAIN SECTION. *-----------------------------------------------------------------* * CONNECT TO THE DATABASE * also possible with DSN: 'youruser/yourpasswd@yourODBC_DSN' *-----------------------------------------------------------------* STRING 'DRIVER={MySQL ODBC 5.2w Driver};' 'SERVER=localhost;' 'PORT=3306;' 'DATABASE=test;' 'USER=youruser;' 'PASSWORD=yourpasswd;' * example for DB specific ODBC parameter: * no compressed MySQL connection (would be the DEFAULT anyway) 'COMRESSED_PROTO=0;' INTO BUFFER. EXEC SQL CONNECT TO :BUFFER END-EXEC. PERFORM SQLSTATE-CHECK. *-----------------------------------------------------------------* * CREATE TABLEs *-----------------------------------------------------------------* * TESTPERSON MOVE SPACES TO BUFFER. STRING 'CREATE TABLE TESTPERSON(' 'ID DECIMAL(12,0), ' 'NAME CHAR(50) NOT NULL, ' 'PRIMARY KEY (ID))' INTO BUFFER. EXEC SQL EXECUTE IMMEDIATE :BUFFER END-EXEC IF SQLSTATE='42S01' DISPLAY ' Table TESTPERSON already exists.' ELSE PERFORM SQLSTATE-CHECK DISPLAY ' created Table TESTPERSON' PERFORM INSDATAPERSON. * TESTGAME MOVE SPACES TO BUFFER. STRING 'CREATE TABLE TESTGAME(' 'ID DECIMAL(12,0), ' 'NAME CHAR(50) NOT NULL, ' 'PRIMARY KEY (ID))' INTO BUFFER. EXEC SQL EXECUTE IMMEDIATE :BUFFER END-EXEC IF SQLSTATE='42S01' DISPLAY ' Table TESTGAME already exists.' ELSE PERFORM SQLSTATE-CHECK DISPLAY ' created Table TESTGAME' PERFORM INSDATAGAME. * TESTPOINTS MOVE SPACES TO BUFFER. STRING 'CREATE TABLE TESTPOINTS(' 'PERSONID DECIMAL(12,0), ' 'GAMEID DECIMAL(12,0), ' 'POINTS DECIMAL(6,2), ' 'CONSTRAINT POINTS_CONSTRAINT1 FOREIGN ' 'KEY (PERSONID) REFERENCES TESTPERSON(ID), ' 'CONSTRAINT POINTS_CONSTRAINT2 FOREIGN ' 'KEY (GAMEID) REFERENCES TESTGAME(ID),' 'PRIMARY KEY (PERSONID, GAMEID))' INTO BUFFER. EXEC SQL EXECUTE IMMEDIATE :BUFFER END-EXEC IF SQLSTATE='42S01' DISPLAY ' Table TESTPOINTS already exists.' ELSE PERFORM SQLSTATE-CHECK DISPLAY ' created Table TESTPOINTS' PERFORM INSDATAPOINTS. *-----------------------------------------------------------------* * SELECT SUM of POINTS for persons >1 *-----------------------------------------------------------------* EXEC SQL SELECT SUM(POINTS) INTO :hVarD FROM TESTPERSON, TESTPOINTS WHERE PERSONID>1 AND PERSONID=ID END-EXEC PERFORM SQLSTATE-CHECK IF SQLCODE NOT = 100 DISPLAY 'SELECTED ' DISPLAY ' SUM of POINTS for persons >1 ' hVarD ELSE DISPLAY ' No points found' END-IF. *-----------------------------------------------------------------* * SELECT ALL with CURSORS *-----------------------------------------------------------------* EXEC SQL DECLARE CUR_ALL CURSOR FOR SELECT TESTPERSON.NAME, POINTS FROM TESTPERSON, TESTPOINTS WHERE PERSONID=ID END-EXEC PERFORM SQLSTATE-CHECK EXEC SQL OPEN CUR_ALL END-EXEC PERFORM SQLSTATE-CHECK PERFORM UNTIL SQLCODE = 100 EXEC SQL FETCH CUR_ALL INTO :hVarC, :hVarD END-EXEC PERFORM SQLSTATE-CHECK IF SQLCODE NOT = 100 DISPLAY 'FETCHED ' DISPLAY ' person ' hVarC ' points: ' hVarD ELSE DISPLAY ' No points found' END-IF END-PERFORM. *-----------------------------------------------------------------* * DROP TABLEs *-----------------------------------------------------------------* * MOVE 'DROP TABLE TESTPOINTS' TO BUFFER. * EXEC SQL * EXECUTE IMMEDIATE :BUFFER * END-EXEC * PERFORM SQLSTATE-CHECK. * MOVE 'DROP TABLE TESTGAME' TO BUFFER. * EXEC SQL * EXECUTE IMMEDIATE :BUFFER * END-EXEC * PERFORM SQLSTATE-CHECK. * MOVE 'DROP TABLE TESTPERSON' TO BUFFER. * EXEC SQL * EXECUTE IMMEDIATE :BUFFER * END-EXEC * PERFORM SQLSTATE-CHECK. * DISPLAY ' dropped Tables ' *-----------------------------------------------------------------* * COMMIT CHANGES *-----------------------------------------------------------------* EXEC SQL COMMIT END-EXEC. PERFORM SQLSTATE-CHECK. *-----------------------------------------------------------------* * DISCONNECT FROM THE DATABASE *-----------------------------------------------------------------* EXEC SQL CONNECT RESET END-EXEC. PERFORM SQLSTATE-CHECK. STOP RUN. . *-----------------------------------------------------------------* * CHECK SQLSTATE AND DISPLAY ERRORS IF ANY *-----------------------------------------------------------------* SQLSTATE-CHECK SECTION. IF SQLCODE < 0 DISPLAY 'SQLSTATE=' SQLSTATE, ', SQLCODE=' SQLCODE IF SQLERRML > 0 DISPLAY 'SQL Error message:' SQLERRMC(1:SQLERRML) END-IF MOVE SQLCODE TO RETURN-CODE STOP RUN ELSE IF SQLCODE > 0 AND NOT = 100 DISPLAY 'SQLSTATE=' SQLSTATE, ', SQLCODE=' SQLCODE IF SQLERRML > 0 DISPLAY 'SQL Warning message:' SQLERRMC(1:SQLERRML) END-IF END-IF. . INSDATAPERSON SECTION. *-----------------------------------------------------------------* * INSERT Data *-----------------------------------------------------------------* * TESTPERSON MOVE 0 TO hVarN. PERFORM UNTIL hVarN > 2 COMPUTE hVarN = hVarN + 1 STRING 'Testpers ' hVarN INTO hVarC EXEC SQL INSERT INTO TESTPERSON SET ID=:hVarN, NAME=:hVarC END-EXEC PERFORM SQLSTATE-CHECK DISPLAY 'INSERTED ' DISPLAY ' Person ' hVarN ' NAME ' hVarC END-PERFORM. INSDATAGAME SECTION. * TESTGAME MOVE 0 TO hVarN. PERFORM UNTIL hVarN > 3 COMPUTE hVarN = hVarN + 1 STRING 'Testgame ' hVarN INTO hVarC EXEC SQL INSERT INTO TESTGAME SET ID=:hVarN, NAME=:hVarC END-EXEC PERFORM SQLSTATE-CHECK DISPLAY 'INSERTED ' DISPLAY ' Game ' hVarN ' NAME ' hVarC END-PERFORM. INSDATAPOINTS SECTION. * TESTPOINTS MOVE 0 TO hVarN. MOVE 0 TO hVarD. PERFORM UNTIL hVarN > 2 COMPUTE hVarN = hVarN + 1 COMPUTE hVarD = hVarN + 0.75 EXEC SQL INSERT INTO TESTPOINTS SET PERSONID=:hVarN, GAMEID=:hVarN, POINTS=:hVarD END-EXEC PERFORM SQLSTATE-CHECK DISPLAY 'INSERTED ' DISPLAY ' POINTS for person/game ' hVarN ' : ' hVarD END-PERFORM. We store it in: 'c:\Temp\' 6. Precompile c:\esqlOC\release\esqlOC.exe -static -o c:\Temp\esqlOCGetStart1.cob c:\Temp\esqlOCGetStart1.sqb 7. Compile SET OC_RUNTIME=c:\OpenCobol_bin SET esqlOC_RUNTIME=c:\esqlOC\release SET COB_CFLAGS=-I %OC_RUNTIME% SET COB_LIBS=%OC_RUNTIME%\libcob.lib %OC_RUNTIME%\mpir.lib %esqlOC_RUNTIME%\ocsql.lib SET COB_CONFIG_DIR=%OC_RUNTIME%\config\ set PATH=C:\WINDOWS\system32;%OC_RUNTIME% call "%PROGRAMFILES%\Microsoft Visual Studio 10.0\VC\vcvarsall.bat" %OC_RUNTIME%\cobc.exe -fixed -v -x -static -o c:\Temp\esqlOCGetStart1.exe c:\Temp\esqlOCGetStart1.cob 8. Execute To create the schema "test": %PROGRAMFILES%\MySQL5.6\mysql-5.6.13-win32\bin\mysql -u youruser -p --host=localhost --execute "CREATE DATABASE IF NOT EXISTS test;" Execute program: SET OC_RUNTIME=c:\OpenCobol_bin SET esqlOC_RUNTIME=c:\esqlOC\release set PATH=%OC_RUNTIME%;%esqlOC_RUNTIME% c:\Temp\esqlOCGetStart1.exe Output: Microsoft Windows XP [Version 5.1.2600] (C) Copyright 1985-2001 Microsoft Corp. c:\~$dir temp Volume in Laufwerk C: hat keine Bezeichnung. Volumeseriennummer: 75F6-3F89 Verzeichnis von c:\temp 08.11.2013 18:18 . 08.11.2013 18:18 .. 08.11.2013 18:10 9.169 esqlOCGetStart1.sqb 1 Datei(en) 9.169 Bytes 2 Verzeichnis(se), 51.086.712.832 Bytes frei c:\~$c:\esqlOC\release\esqlOC.exe -static -o c:\Temp\esqlOCGetStart1.cob c:\Temp\esqlOCGetStart1.sqb c:\esqlOC\release\esqlOC.exe: ESQL for OpenCobol Version 2 Build May 8 2013 c:\~$dir temp Volume in Laufwerk C: hat keine Bezeichnung. Volumeseriennummer: 75F6-3F89 Verzeichnis von c:\temp 08.11.2013 18:18 . 08.11.2013 18:18 .. 08.11.2013 18:18 17.973 esqlOCGetStart1.cob 08.11.2013 18:10 9.169 esqlOCGetStart1.sqb 2 Datei(en) 27.142 Bytes 2 Verzeichnis(se), 51.086.692.352 Bytes frei c:\~$SET OC_RUNTIME=c:\OpenCobol_bin c:\~$SET esqlOC_RUNTIME=c:\esqlOC\release c:\~$SET COB_CFLAGS=-I %OC_RUNTIME% c:\~$SET COB_LIBS=%OC_RUNTIME%\libcob.lib %OC_RUNTIME%\mpir.lib %esqlOC_RUNTIME%\ocsql.lib c:\~$SET COB_CONFIG_DIR=%OC_RUNTIME%\config\ c:\~$set PATH=C:\WINDOWS\system32;%OC_RUNTIME% c:\~$call "%PROGRAMFILES%\Microsoft Visual Studio 10.0\VC\vcvarsall.bat" Setting environment for using Microsoft Visual Studio 2010 x86 tools. c:\~$%OC_RUNTIME%\cobc.exe -fixed -v -x -static -o c:\Temp\esqlOCGetStart1.exe c:\Temp\esqlOCGetStart1.cob Preprocessing: c:\Temp\esqlOCGetStart1.cob to C:\DOKUME~1\DOK-AD~1\LOKALE~1\Temp\cob13.cob Return status: 0 Parsing: C:\DOKUME~1\DOK-AD~1\LOKALE~1\Temp\cob13.cob Return status: 0 Translating: C:\DOKUME~1\DOK-AD~1\LOKALE~1\Temp\cob13.cob to C:\DOKUME~1\DOK-AD~1\LOKALE~1\Temp\cob14.c Executing: cl /c -I c:\OpenCobol_bin /MD /Fo"esqlOCGetStart1.obj" "C:\DOKUME~1\DOK-AD~1\LOKALE~1\Temp\cob14.c" Microsoft (R) 32-Bit C/C++-Optimierungscompiler Version 16.00.40219.01 für 80x86 Copyright (C) Microsoft Corporation. Alle Rechte vorbehalten. cob14.c Return status: 0 Executing: cl /MD /Fe"c:\Temp\esqlOCGetStart1" "esqlOCGetStart1.obj" c:\OpenCobol_bin\libcob.lib c:\OpenCobol_bin\mpir.lib c:\esqlOC\release\ocsql.lib /link /manifest Microsoft (R) 32-Bit C/C++-Optimierungscompiler Version 16.00.40219.01 für 80x86 Copyright (C) Microsoft Corporation. Alle Rechte vorbehalten. Microsoft (R) Incremental Linker Version 10.00.40219.01 Copyright (C) Microsoft Corporation. All rights reserved. /out:c:\Temp\esqlOCGetStart1.exe /manifest esqlOCGetStart1.obj c:\OpenCobol_bin\libcob.lib c:\OpenCobol_bin\mpir.lib c:\esqlOC\release\ocsql.lib Return status: 0 Executing: mt /manifest "c:\Temp\esqlOCGetStart1.exe.manifest" /outputresource:"c:\Temp\esqlOCGetStart1.exe";#1 Microsoft (R) Manifest Tool version 5.2.3790.2076 Copyright (c) Microsoft Corporation 2005. All rights reserved. Return status: 0 c:\~$dir temp Volume in Laufwerk C: hat keine Bezeichnung. Volumeseriennummer: 75F6-3F89 Verzeichnis von c:\temp 08.11.2013 18:18 . 08.11.2013 18:18 .. 08.11.2013 18:18 17.973 esqlOCGetStart1.cob 08.11.2013 18:18 17.408 esqlOCGetStart1.exe 08.11.2013 18:10 9.169 esqlOCGetStart1.sqb 3 Datei(en) 44.550 Bytes 2 Verzeichnis(se), 51.086.667.776 Bytes frei c:\~$SET OC_RUNTIME=c:\OpenCobol_bin c:\~$SET esqlOC_RUNTIME=c:\esqlOC\release c:\~$set PATH=%OC_RUNTIME%;%esqlOC_RUNTIME% c:\~$c:\Temp\esqlOCGetStart1.exe created Table TESTPERSON INSERTED Person 000000000001 NAME Testpers 000000000001 INSERTED Person 000000000002 NAME Testpers 000000000002 INSERTED Person 000000000003 NAME Testpers 000000000003 created Table TESTGAME INSERTED Game 000000000001 NAME Testgame 000000000001 INSERTED Game 000000000002 NAME Testgame 000000000002 INSERTED Game 000000000003 NAME Testgame 000000000003 INSERTED Game 000000000004 NAME Testgame 000000000004 created Table TESTPOINTS INSERTED POINTS for person/game 000000000001 : +00001.75 INSERTED POINTS for person/game 000000000002 : +00002.75 INSERTED POINTS for person/game 000000000003 : +00003.75 SELECTED SUM of POINTS for persons >1 +00006.50 FETCHED person Testpers 000000000001 points: +00001.75 FETCHED person Testpers 000000000002 points: +00002.75 FETCHED person Testpers 000000000003 points: +00003.75 No points found c:\~$ _ati's post modified for ReStructuredText_  File: gcfaq.info, Node: UDF, Next: GUI, Prev: Getting Started with esqlOC, Up: Notes 6.23 UDF ======== User Defined Function. See FUNCTION-ID_ for an example putting user defined functions to use. This is a new paradigm in COBOL programming. It is now possible to deliver repositories of functions, that can provide code with less need to pre-allocate WORKING-STORAGE_ areas. For instance ENVIRONMENT DIVISION. configuration section. repository. function current-stock-price function all intrinsic. PROCEDURE DIVISION. display current-stock-price("GOOG") end-display doesn't even need to know what type of data 'current-stock-price' returns. The result may be passed in a pipeline expressions, easing burdens on application developers. 'UDF' will be a good thing for GNU Cobol. 'cobc' can include the repositories from source code or DSO_; let the sharing begin.  File: gcfaq.info, Node: GUI, Prev: UDF, Up: Notes 6.24 GUI ======== Graphical User Interface. GNU Cobol is well suited to programming with GTK+, but more than capable of leveraging just about GUI framework.  File: gcfaq.info, Node: Authors, Next: Maintainers and Contributors, Prev: Notes, Up: Top 7 Authors *********  File: gcfaq.info, Node: Maintainers and Contributors, Next: ChangeLog, Prev: Authors, Up: Top 8 Maintainers and Contributors ******************************  File: gcfaq.info, Node: ChangeLog, Prev: Maintainers and Contributors, Up: Top 9 ChangeLog *********** 03-May-2014, 07-May Addded a blurb about null terminated strings, added example for compiler directives, added blurb on UDF. Bragged about MathGL some more, added printenv.cob and voidcall.c. 15-Apr-2014, 16-Apr, 20-Apr, 25-Apr, 26-Apr Added Arnold's INNO installer link. Fleshed out some entries, added FUNCTION-ID sample. Typos, more color, libmicrohttpd sample. Updated NUMERIC entry, touched on ACCEPT. Odds and sods. 04-Mar-2014, 15-Mar, 29-Mar More typos. More typos. Still winter, updated development history blurb, added head-full.cob skeleton, added OpenCOBOLIDE link, March 29th and still winter. 28-Feb-2014 Better credits and typo fixes. 04-Jan-2014, 28-Jan Added the DB2 link from Dick Rietveld. Updated the indexing.cob sample, updated docs on cobcrun. 04-Dec-2013 Updated some credits. Added Ron as an author. More Simon credits. 13-Nov-2013, 23-Nov, 27-Nov Added esqlOC article by ati from SourceForge, more credits for Sergey. Clarified Rexx sample with a new variable instead of sharing. Added first hint of Report Writer support by Ron Norman. Example by Jay Moseley. Started mentioning 2.1. 23-Oct-2013 GNU Cobol FAQ now. Updated CGI sample. 11-Oct-2013 OpenCOBOL FAQ finalized at 1.1. 25-Aug-2013, 27-Aug Updated the EXEC SQL entry. Filled out FILLER, FILE, FILE-ID and FALSE. 03-Jul-2013, 19-Jul-2013 Added Pure embedding sample. Cleaned up some sourcecode types, got rid of warnings. Wim's stickleback project. 08-Jun-2013, 11-Jun-2013 Added the missing tests blurb for NIST, some corrections. Added more open source COBOL project links. Added SMCUP, RMCUP terminfo blurb. Fixes. 15-May-2013, 29-May Added BITWISE from Paul Chandler. Started list of open source projects. Tweaked the development history, fixed Fossil image placement. 30-Mar-2013 Added another haiku (using cbrain). 08-Feb-2013, 09-Feb, 25-Feb, 26-Feb Moving to Sphinx, started documenting new SourceForge project site. Fixed cobxref listing, no truncated lines. Added 'nosidebar' to the sphinx-doc theme settings in conf.py. Added some Computus, and Latin. Updating current version information. Added Python embedding. Added ficl Forth notes. Added Shakespeare. Touched on ocsort. Reversed the ChangeLog order with tac -r -s "^$". Moved the Sphinx output to main. Added Ruby. 03-Jun-2012 Added site favicon.ico from Silk/help.png, credited Mark James. Fleshed out telco benchmark entry. 27-May-2012 Added LLVM and clang reference. 22-Apr-2012 Typos. Added the size listing for hello. 07-Mar-2012, 19-Mar Added carpe diem farberistic joke. 05-Feb-2012, 29-Feb Added to DIVIDE, put in some lists in the RESERVED words. Added Public Accounting. 12-Jan-2012, 14-Jan, 15-Jan, 20-Jan Added a criticism of easter.cob. Updated CURSOR and FOREVER entries. Version to 1.1rc01. FOREVER thread listing moved. cupsPrintFile documented. Rid of the _><_ comment output. LOCALE-DATE update. Removed Organization from attributions, there is no official group. 06-Dec-2011, 26-Dec-2011 Added Gambas interface link. Fixed INDEXED entry. Added INITIAL source sample. 03-Sep-2011, 25-Sep, 28-Sep Fixed the ocgtk.c files, getting rid of void returns. Updated list of platforms with 1.1pre-rel running. Added COBOLUnit. 26-Aug-2011 Finished the last FUNCTION. 01-Aug-2011, 05-Aug, 06-Aug, 07-Aug, 08-Aug, 09-Aug, 13-Aug, 14-Aug, 22-Aug Done M, N. Done O. Fixed the colours after a Pygments update. P's in. Q, R done. Doing S. Just passed 750000 bytes of FAQ. Done S to Z. Started documenting the GNU build tool options available. Fixed a DSO misnomer. 01-Jul-2011, 02-Jul, 10-Jul, 11-Jul, 12-Jul, 20-Jul, 23-Jul Updated CALL reserved word entry to show off ON EXCEPTION CONTINUE. Updated a few more reserved words; DATE, DAY, DEBUGGING. D's are done. Fleshed out a few reserved words, E's done. Added links to the Doxygen API passes. Started on some future 2.0 entries with the Directives. Added blurb about LD_RUN_PATH. Added initial entry on APL/J linkage. Into the Fs. Done A thru K. Done L. 25-Jun-2011, 26-Jun Added sourceforge link. Updated shortest program entries. Updated a few reserved words. 07-May-2011 Added gfortran sample. 13-Feb-2011 Fixed an unnecessary css import, small corrections. Added REPOSITORY, CYCLE and FOREVER entries. 02-Jan-2011, 23-Jan Added errorproc.cob sample. Added some vim and Fossil info. 12-Dec-2010, 31-Dec Added libsoup HTTP server sample. Changed EOP file status 52 copy sample. Updated Falcon entry. 01-Nov-2010, 06-Nov, 18-Nov, 20-Nov, 27-Nov Added a Genie sample. Some small touch-ups. Restored borked colouring. Added DECLARATIVES entry and a few small tweaks. Added a few RESERVED words entries. Added ROOT/CINT info. Expanded install instructions. 18-Oct-2010, 19-Oct, 24-Oct, 30-Oct, 31-Oct Added some working Vala code samples. Added DamonH's AJAX code to the CGI section. Updated the CBL_OC_DUMP listings. Added a few minor reserved word entries. Added translation help request note. Added mkfifo sample. Added call Genie sample. Added CBL_OC_GTKHTML sample. Updated the PI and PRESENT-VALUE entries. Updated CHARACTERS entry. 13-Jun-2010 Reorganized table of contents boxes. Split SEARCH sample source code. 05-May-2010, 06-May Added the SEARCH and SORT sample. Updated Rexx. Image for GNAT GPS. 04-Apr-2010, 05-Apr, 11-Apr, 15-Apr Fixed up the source code listings. Added telco benchmark. Added print to PDF. Added COB_LIBRARY_PATH info. Expanded the Tcl/Tk entry. Added Mac install instructions from Ganymede. Rexx. 01-Mar-2010, 28-Mar Added Oracle procob news. Added FILE STATUS codes to ISAM note. Mention TP-COBOL-DEBUGGER. Updated INSPECT sample and COB_SCREEN_ESC entry. Added ocgtk.c 15-Feb-2010, 20-Feb, 25-Feb, 27-Feb, 28-Feb Added advocacy, and a few tweaks. Added Jim's PRTCBL. Added Angus' ocsort. Added cobol.vim and Easter Day programs. Updated CBL_OC_DUMP source code listing. Added a REPLACE text preprocessor sample. Added pgcob.cob PostgreSQL sample. 12-Oct-2009 Added some links, credits. 13-Sep-2009 Some printing information. 29-Jul-2009 more human assisted corrections. 01-Jun-2009, 03-Jun, 05-Jun, 28-Jun Added errno, makefile, a few samples and some reserved word explanations. Added filter.cob the stdin stdout sample. Added some reserved word blurbs and the message queue sample. human assisted corrections. Many thanks to human. 01-May-2009, 09-May, 28-May, 31-May Started a structural and TOC reorg. Mention S-Lang. Continue re-org. Added some FUNCTION samples. Getting close to a complete Intrinsic list. 17-Apr-2009, 18-Apr, 19-Apr Clarified -fsource-location option. Added a production use posting. Added START and ISAM sample. 09-Mar-2009, 31-Mar Added Vala and a few more RESERVED word entries. Added -ext clarification. 16-Feb-2009, 18-Feb Added JavaScript, Lua, Guile embedding samples and mention Tcl/Tk, GTK. Added CBL_OC_DUMP sample by Asger Kjelstrup and human 02-Feb-2009, 06-Feb, 09-Feb, 11-Feb Coloured Source codes. Added info on COB_PRE_LOAD, added LINAGE sample, fixed colours (kinda). Added Haiku, disclaimer about no claim to Standards conformance. Updated look. 01-Jan-2009, 10-Jan, 12-Jan, 22-Jan Lame attempt at clarifying (excusing) poor use of Standards references. Small corrections and additions to SQL entry. Added a few RESERVED entries and Vincent's STOCK library expansion. Typos. 28-Dec-2008, 29-Dec, 30-Dec Added info on CobXRef, some debugging tricks and an entry on recursion. 12-Dec-2008, 16-Dec, 21-Dec Added new links to OpenCOBOL 1.1 binary builds by Sergey. Updated header templates. Added a few keywords. 28-Nov-2008 OpenCOBOL passes the NIST test suite. 13-Oct-2008, 15-Oct,19-Oct, 22-Oct, 29-Oct Added a few samples. Added TABLE SORT sample. Added configure script information. Added dialect configuration information. 23-Sep-2008 Adds and a trial skin 10-Aug-2008, 21-Aug, 28-Aug, 29-Aug, 30-Aug Started in on the intrinsic functions. Dropped the pre from the alpha designation. Still some Look into this entries. Move to add1tocobol.com Publish link to 1.0rc Skeleton of the reserved words list Let the tweaking begin 17-Jul-2008, 20-Jul, 24-Jul, 28-Jul Last-last-last 0.0 pre-alpha. Second DIFF. Corrections pass. Expanded the SCREEN SECTION questions. Another correction pass, with clarifications from Roger While 02-Jul-2008, 06-Jul, 07-Jul, 11-Jul, 13-Jul Experimental version for comment. First 0.0 pre-alpha release. Second 0.0 pre-alpha. Last 0.0 pre-alpha. Checked in for diffs. Last-last 0.0 pre-alpha. Verify DIFF functionality.