************* OpenCOBOL FAQ ************* .. Formatted for docutils, ReStructuredText. rst-buidhtml .. Texinfo form created using Pandoc .. image:: images/ocbanner.png :alt: OpenCOBOL :target: opencobol.org_ :align: center .. sidebar:: Status This is a 1.0 release candidate of the OpenCOBOL FAQ. Sourced at ocfaq.rst_. Courtesty of ReStructuredText_ and Pygments_. ocfaq.pdf_ is also available, using **rst2latex** and then **pdflatex**. This FAQ is more than a FAQ and less than a FAQ. Someday that will change and this document will be split into an OpenCOBOL manual and a simplified Frequently Asked Questions file. "COBOL Warriors" image |copyright| 2008 Robert Saczkowski. Banner courtesy of the GIMP_, |copyleft| and both are licensed under Creative Commons Attribution-Share Alike 2.0 Generic License http://creativecommons.org/licenses/by-sa/2.0/ .. section-numbering:: .. Maintainer TODO and reminder .. Suggestions in general: 1. Why is this called a FAQ? Good question :Authors: | Brian Tiffin [btiffin]_ | | Answers, quotes and contributions: | John Ellis [jrls_swla]_, Vincent Coen, Jim Currey, Bill Klein [wmklein]_, | Ganymede, Simon Sobisch [human]_, Rildo Pragana, Sergey Kashyrin, | Federico Priolo, Frank Swarbrick, Angus, DamonH, Parhs, Gerald Chudyk | | Compiler by: | **Roger While** [Roger]_, | Keisuke Nishida [Keisuke]_, | (with the invaluable assistance of many others) | | Special credits to | **Gary Cutler** author of the `OpenCOBOL Programmers Guide`_ | Joseph James Frantz for hosting and advocacy [aoirthoir]_ :Version: 1.1rc03, January 20, 2012 (work in progress and being replaced by latex) :Status: content close to complete, still in progress :Copyright: |copyleft| :ChangeLog: ChangeLog_ .. Note:: Regarding COBOL Standards, Official COBOL Standards: There are many references to **standards** in this document. Very few of them are *technically* correct references. Apologies to all the hard working men and women of the technical committees for this unintentional slight. For specific details on what wordings should be used please see `What are the Official COBOL Standards?`_ .. sidebar:: OpenCOBOL FAQ .. contents:: FAQ Contents :local: :depth: 1 :backlinks: entry ========= OpenCOBOL ========= .. sidebar:: OpenCOBOL .. contents:: :local: :backlinks: entry :depth: 2 _`OpenCOBOL FAQ` ------------------ What is OpenCOBOL? ------------------ OpenCOBOL_ is an open-source COBOL_ compiler. OpenCOBOL implements a substantial part of the `COBOL 85`_ and `COBOL 2002`_ standards, as well as many extensions of the existent COBOL compilers. OpenCOBOL translates COBOL into C and compiles the translated code using the native C compiler. You can build your COBOL programs on various platforms, including Unix/Linux, Mac OS X, and Microsoft Windows. The most excellent **OpenCOBOL Programmer's Guide** can be found at `OpenCOBOL Programmers Guide`_. -------------- What is COBOL? -------------- COBOL_ is an acronym for COmmon Business Oriented Language. This author has always thought of it as "Common Business" Oriented more than Common "Business Oriented", but that emphasis is perhaps up to the reader's point of view. -------------------------- How is OpenCOBOL licensed? -------------------------- The compiler is licensed under `GNU General Public License`_. The run-time library is licensed under `GNU Lesser General Public License`_. All source codes are copyright by the respective authors. OpenCOBOL is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. ------------------------------------------ What platforms are supported by OpenCOBOL? ------------------------------------------ `OpenCOBOL 1.0`_ the current official release version, hosted on SourceForge.net, compiles on: * All 32-bit MS Windows (95/98/NT/2000/XP) * All POSIX (Linux/BSD/UNIX-like OSes) * OS/X `OpenCOBOL 1.1`_, has been built on * MS Windows native * MS Windows with Cygwin * GNU/Linux * POSIX Systems including OpenSolaris * OS/X * AS/400 * HP Integrity HPUX 11.23 * RS600 AIX 5 * 390 Mainframe z/OS OMVS/USS * others -------------------------------------- Are there pre-built OpenCOBOL packages -------------------------------------- Yes. Debian_ APT_, and RPM packages exist. Packages for NetBSD. Many. Google *opencobol packages* for any late breaking news. A Debian Advanced Package Tool binary package exists for OpenCOBOL 1.0 as **open-cobol** and lists dependencies of * libc6 (>= 2.7-1), * libcob1, * libcob1-dev (= 1.0-1), * libdb4.5 (>= 4.5.20-3), * libdb4.5-dev, * libgmp3-dev, * libgmp3c2, * libltdl3-dev, * libncurses5 (>= 5.6+20071006-3) Thanks to the gracious efforts of Bart Martens, bartm on Debian's .org domain. .................... kiska.net repository .................... Also check out kiska.net_ for binary builds on various platforms. Thanks to Sergey Kashyrin. ........... sourceforge ........... There are OpenCOBOL links at http://cobol.sourceforge.net In particular, http://sourceforge.net/projects/cobol/files/open-cobol/ can come in handy, with sources and MinGW binaries at a mininum. Maybe more as time goes on. --------------------------------------------- What is the most recent version of OpenCOBOL? --------------------------------------------- See `What is the current version of OpenCOBOL?`_ -------------------------- How complete is OpenCOBOL? -------------------------- `OpenCOBOL 1.0`_ implements a substantial portion of `COBOL 85`_, supports many of the advances and clarifications of `COBOL 2002`_, and includes many extensions in common use from Micro Focus COBOL, ACUCOBOL and other existent compilers. `OpenCOBOL 1.1`_ implements a more substantial portion of the `COBOL 85`_ Dialect, `COBOL 2002`_ and a growing number of vendor extensions. Some proposed COBOL 20xx features have also been implemented. Compatibility support includes: * MF for Micro Focus * IBM for IBM compatibility * MVS * BS2000 OpenCOBOL also includes some advanced features allowing source code such as .. sourcecode:: cobolfree CALL "cfunction" USING BY REFERENCE ADDRESS OF VAR-IN-LINKAGE-SECTION. Passing the equivalent of char**, pointer to pointer to char. Just as a small example of the level of coverage and flexibility provided by OpenCOBOL. .. sourcecode:: cobolfree DISPLAY FUNCTION UPPER-CASE( FUNCTION SUBSTITUTE( "This is the orginal string."; "original"; "new"; "string"; "text" ) ) END-DISPLAY To allow for substitution of mixed length strings, something not normally so easy in COBOL. The above will output:: THIS IS THE NEW TEXT. .. note:: While OpenCOBOL can be held to a high standard of quality and robustness, the authors *DO NOT* claim it to be a "Standard Conforming" implementation of COBOL. ------------------------------ Will I be amazed by OpenCOBOL? ------------------------------ This author believes so. For an open source implementation of COBOL, OpenCOBOL may surprise you in the depth and breadth of its COBOL feature support, usability and robustness. ----------------------------- Who do I thank for OpenCOBOL? ----------------------------- Many people. In particular Keisuke Nishida and Roger While. See the THANKS file in the source code archive for more names of people that have worked on the OpenCOBOL project. Roger points out that the list is woefully incomplete. To quote:: The OC project would not have been where it is today without the significant/enormous help from many-many persons. The THANKS file does not even do justice to this. ------------------------------------ Does OpenCOBOL include a Test Suite? ------------------------------------ Why yes it does. 74 syntax tests, 170 coverage tests, and 16 data representation tests in the February 2009 pre-release. 88 syntax, 253 coverage, and 22 data tests in a 2010 cut. From the development tarball:: $ make check will evaluate and report on the test suite. See `make check listing`_ for a current output listing of a test run. ---------------------------------------- Does OpenCOBOL pass the NIST Test Suite? ---------------------------------------- The National Institute of Standards and Technology, NIST, maintains a COBOL 85 implementation verification suite of tests. An archive of the tests can be found at http://www.itl.nist.gov/div897/ctg/cobol_form.htm OpenCOBOL passes many of the tests included in the NIST sponsored COBOL 85 test suite. While it passes over 9000 of the tests, OpenCOBOL does not claim conformance to any level of COBOL *Standard*. Instructions for use of the NIST suite is included in the build archive under:: tests/cobol85/README Basically, it is a simple **uncompress** and **make** then sit back and relax. The scripts run OpenCOBOL over some 374 programs/modules and includes thousands of test passes. :: Test Modules ------------ Core tests: NC - COBOL nucleus tests SM - COPY sentence tests IC - CALL sentence tests File I-O tests: SQ - Sequential file I-O tests RL - Relative file I-O tests IX - Indexed file I-O tests ST - SORT sentence tests Advanced facilities: IF - Intrinsic Function tests With the addition of GLOBAL support, the OpenCOBOL 1.1 pre-release fails none of the attempted tests. The summary.log from a run in February 2009:: ------ Directory Information ------- --- Total Tests Information --- Module Programs Executed Error Crash Pass Fail Deleted Inspect Total ------ -------- -------- ----- ----- ----- ---- ------- ------- ----- NC 92 92 0 0 4363 0 6 11 4380 SM 15 15 0 0 290 0 3 1 294 IC 24 24 0 0 246 0 4 0 250 SQ 81 81 0 0 512 0 6 81 599 RL 32 32 0 0 1827 0 5 0 1832 IX 39 39 0 0 507 0 1 0 508 ST 39 39 0 0 278 0 0 0 278 SG 5 5 0 0 193 0 0 0 193 OB 5 5 0 0 16 0 0 0 16 IF 42 42 0 0 732 0 0 0 732 ------ -------- -------- ----- ----- ----- ---- ------- ------- ----- Total 374 374 0 0 8964 0 25 93 9082 ------------------------------------ What about OpenCOBOL and benchmarks? ------------------------------------ COBOL has a legacy dating back to 1959. Many features of the COBOL standard provide defaults more suitable to mainframe architecture than the personal computer a 3rd millennium OpenCOBOL developer will likely be using. OpenCOBOL, by default, generates code optimized for big-endian_ hardware. Fairly dramatic speed improvements on Intel architecture can come from simple **USAGE IS COMPUTATIONAL-5** clauses in the DATA DIVISION. ............. telco billing ............. There is a benchmark posted at http://speleotrove.com/decimal/telco.html and thanks to [wmklein]_, there is a COBOL entry. In summary, the benchmark reads a large input file containing a suitably distributed list of telephone call durations (each in seconds). For each call, a charging rate is chosen and the price calculated and rounded to hundreths. One or two taxes are applied (depending on the type of call) and the total cost is converted to a character string and written to an output file. Running totals of the total cost and taxes are kept; these are displayed at the end of the benchmark for verification. A run on an older pentium 4 and the million number file gave:: $ echo 'N' | time ./telco Enter 'N' to skip calculations: 0.46user 1.08system 0:01.61elapsed 96%CPU (0avgtext+0avgdata 0maxresident)k 0inputs+134776outputs (0major+345minor)pagefaults 0swaps $ echo '' | time ./telco Enter 'N' to skip calculations: 11.37user 1.41system 0:12.95elapsed 98%CPU (0avgtext+0avgdata 0maxresident)k 24inputs+134776outputs (0major+360minor)pagefaults 0swaps $ tail TELCO.TXT 35 D | 0.31 0.02 0.01 | 0.34 193 D | 1.73 0.11 0.05 | 1.89 792 L | 1.03 0.06 | 1.09 661 D | 5.91 0.39 0.20 | 6.50 44 L | 0.06 0.00 | 0.06 262 L | 0.34 0.02 | 0.36 -------------+----------------------------------------+------------- Totals: | 922,067.11 57,628.30 25,042.17 | 1,004,737.58 Start-Time:09:37:23.93 End-Time:09:37:36.83 A more recent 1.1 pre-release, on a dual quad-core Xeon box running Linux SLES 10 64-bit::      35    D  |         0.31         0.02         0.01 |         0.34     193    D  |         1.73         0.11         0.05 |         1.89     792    L  |         1.03         0.06              |         1.09     661    D  |         5.91         0.39         0.20 |         6.50      44    L  |         0.06         0.00              |         0.06     262    L  |         0.34         0.02              |         0.36 -------------+----------------------------------------+-------------     Totals:   |   922,067.11    57,628.30    25,042.17 | 1,004,737.58    Start-Time:21:40:48.52   End-Time:21:40:51.92 3.4 seconds cache-hot. Not bad. ------------------------------ Can OpenCOBOL be used for CGI? ------------------------------ Yes. Through standard IO redirection and the extended **ACCEPT ... FROM ENVIRONMENT ...** feature, OpenCOBOL is more than capable of supporting advanced Common Gateway Interface programming. See `How do I use OpenCOBOL for CGI?`_ for a sample *Hello Web* program. For those developers looking to serve OpenCOBOL applications on hosted systems and no super user privileges, see `How do I use LD_RUN_PATH with OpenCOBOL?`_ for some pointers. ----------------------------- Does OpenCOBOL support a GUI? ----------------------------- Yes, but not out of the box. There is not |currently| anything that ships with the product. Third party extensions for Tcl/Tk and bindings for GTK+ do allow for graphical user interfaces. See `Does OpenCOBOL support the GIMP ToolKit, GTK+?`_ and `Can OpenCOBOL interface with Tcl/Tk?`_. ... GTK ... The expectation is that GTK+ will be completely bound as a callable interface. That is |currently| not the case, with perhaps 2% of the GTK+ functionality wrapped (but with that 2%, fully functional graphical interfaces are possible). ...... Tcl/Tk ...... The Tcl/Tk engine is already quite complete but does place most of the burden of GUI development squarely on the Tk side. ............ Vala, WebKit ............ Vala will also open up a quick path to GUI development with OpenCOBOL. There is already an embedded web browser using the Vala bindings to WebKit. See `Can OpenCOBOL interface with Vala?`_ for a lot more details. --------------------------- Does OpenCOBOL have an IDE? --------------------------- Yes and no. There is no IDE that ships with the product. The add1tocobol team is |currently| at work creating extensions for the GNAT Programming Studio. This is working out quite nicely and will likely be the IDE of choice for the add1tocobol OpenCOBOL developers. See `Can the GNAT Programming Studio be used with OpenCOBOL?`_ for more information. There is also the Eclipse IDE and a major project for integrating COBOL but this will not be OpenCOBOL specific. Many text editors have systems in place for invoking compilers. SciTE, Crimson Editor, vi and emacs to name but a few of the hundreds that support edit/compile/test development cycles. See `Does OpenCOBOL work with make?`_ for some information on command line compile assistance. -------------------------------------------------- Can OpenCOBOL be used for production applications? -------------------------------------------------- Depends. OpenCOBOL is still in active development. Feature coverage is growing, and while the current implementation offers great coverage, applicability to any given situation would need to analyzed and risks evaluated before commitment to production use. The licensing allows for commercial use, but OpenCOBOL also ships with notice of indemnity, meaning that there are no guarantees when using OpenCOBOL, directly or indirectly. There may be a time when commercial support of OpenCOBOL is offered, but at the time of writing no known offering exists. *Search google just in case!* And yes, OpenCOBOL is used in production environments. From [Roger]_: :: Incidentally, OC has been (and still is) used in production environments since 2005. (This includes projects that I personally worked on plus other   projects reported to me; these worldwide) The OC project would not have been where it is today without the significant/enormous help from many-many persons. The THANKS file does not even do justice to this. ................... Nagasaki Prefecture ................... Reported on opencobol.org_, The Nagasaki Prefecture, population 1.44 million and 30,000 civil employees is using OpenCOBOL in support of its payroll management system. A team of 3 ported and maintain a suite of 200 COBOL programs, mingled with Perl and specialized reporting modules, running on Nec PX9000 big iron and Xeon servers. ............ More stories ............ Another post from opencobol.org_ in April 2009, *reprinted with permission*. :: OpenCOBOL viability For those concerned about the viability of OpenCOBOL in a production environment, I offer our situation as an example. We started loading OpenCOBOL to a Debian (Etch) Parisc box in mid March. With some valuable help from this forum we were up and running in a few days. We then explored the CGI capabilities and moved our home-brewed CGI handler (written in HP3000 Cobol) over. We ended up changing only a few lines. As Marcr's post indicates, we found a MySql wrapper and made some minor changes to it. Starting the second week in April we were in full development of new systems for commercial use. Please accept our congratulations to the community and our gratitude for the help from the forum. jimc Another reference by Jim, some 6 months later in February 2010, which seems to be enough time for any rose-coloured glass effect to have worn off if it was going to. :: For our part, the answer is yes. You may want to read an earlier thread about this. Search on OpenCOBOL viability. Having worked with Cobol since the 1960's, my mindset is that no conversion is automatic. In our case we are not converting from a specific dialect like MF, but instead are either writing entirely new systems or are changing features (making them web based for example) in older systems. There are some identified failures in OpenCOBOL execution that have been discussed in this forum. We have found them to be inconsequential and simply work around them. Then again I do not remember working with a bug-free compiler. Our environment is Debian Linux, OpenCOBOL 1.1, MySQL, ISAM (the one provided with the 1.1 prerelease), HTML (via CGI) and a new PreProcessor to relieve the tedium of writing SQL statements. If you have some "nay sayers" in your organization and would like some support I will be happy to speak with them. jimc --------------------------------------------- Where can I get more information about COBOL? --------------------------------------------- The `COBOL FAQ`_ by William M Klein is a great place to start. A google of the search words "COBOL" or "OpenCOBOL" are bound to lead to enough days worth of reading of in-depth articles, opinions and technical information to satisfy the greatest of curiosities. The COBUG_ site *COBOL User Groups* is also a wonderful resource for OpenCOBOL developers. *This is highly subject to change*, but |currently| a Draft of 20xx is available at http://www.cobolstandard.info/j4/index.htm and in particular http://www.cobolstandard.info/j4/files/std.zip .. note:: While OpenCOBOL can be held to a high standard of quality and robustness, the authors *DO NOT* claim it to be a "Standard Conforming" implementation of COBOL. ------------------------------------------------- Where can I get more information about OpenCOBOL? ------------------------------------------------- The opencobol.org_ website is probably the best place to find out more about the OpenCOBOL system. add1tocobol.com_ is a place to find out about a few of the fan initiatives. (An older archive has been stashed at http://oldsite.add1tocobol.com) ................................ The OpenCOBOL Programmer's Guide ................................ A very well written and masterful OpenCOBOL reference and COBOL development guide. By Gary Cutler, `OpenCOBOL Programmers Guide`_. ------------------------------------------ Can I help out with the OpenCOBOL project? ------------------------------------------ Absolutely. Visit the opencobol.org_ website and either post a message asking what needs to be done, or perhaps join the development mailing list to find out the current state of development. See `Is there an OpenCOBOL mailing list?`_ for some details. OpenCOBOL is a GPL licensed open source project and while [Roger]_ is the lead developer he is quite open to code submissions. Having a central point of development allows for consistency and the very high level of quality control enjoyed by OpenCOBOL users. ................... Translation Efforts ................... A new project has started to see native language support in the **cobc** compile and run-time systems. Please see http://www.opencobol.org/modules/newbb/viewtopic.php?topic_id=1127&forum=1 for details if you think you can help. :: Hi folks! We're starting to translate upcoming versions into different languages. The necessary code changes for OC 2.0 were already done. Now we need translators. Before posting every stuff here I want to gather the translators here. Who is able and willing to translate the strings (currently 667) into what language(s) [or has somebody who does this]? From the last discussions I remember people wanting to do this for French, Italian, Spanish, German but I don't remember who exactly said that he/she will help. We already have a Japanese translation, but that needs an heavy update. ... ----------------------------------- Is there an OpenCOBOL mailing list? ----------------------------------- Yes. Visit opencobol.org_ for details. The OpenCOBOL development mailing list is graciously hosted by SourceForge. The ML archive is available at http://sourceforge.net/mailarchive/forum.php?forum_name=open-cobol-list and once you have subscribed, the list will accept messages at the open-cobol-list email destination at lists.sourceforge.net. -------------------------------------------------------- Where can I find more information about COBOL standards? -------------------------------------------------------- The `COBOL 85`_ standard is documented in * ANSI X3.23-1985 * ISO 1989-1985 * ANSI X3.23a-1989 * ANSI X3.23b-1993 *This is highly subject to change*, but |currently| a Draft of 20xx is available at http://www.cobolstandard.info/j4/index.htm and in particular http://www.cobolstandard.info/j4/files/std.zip .. note:: While OpenCOBOL can be held to a high standard of quality and robustness, the authors *DO NOT* claim it to be a "Standard Conforming" implementation of COBOL. ------------------------------------- Can I see the OpenCOBOL source codes? ------------------------------------- Absolutely. Being an open source system, all sources that are used to build the compiler are available and free. The `opencobol.org` site has links to release and pre-release archives. Most distributions of GNU/Linux will also have source code bundles. For example .. sourcecode:: bash $ apt-get source open-cobol on Debian GNU/Linux will retrieve the most recent released package sources. A ROBODoc_ experimental project to document the source codes is hosted at ocrobo_. See `ROBODoc Support`_ for a sample configuration file. ................................................ What was used to color the source code listings? ................................................ I wrote a Pygments lexer, mushed it into a local copy of Pygments_ and then call a rst2html-pygments.py program. Requires a fair amount of mucking about. See ReStructuredText_ and Pygments_ for some details. --------------------------- Do you know any good jokes? --------------------------- Maybe. * A computer without COBOL and Fortran is like a piece of chocolate cake without ketchup or mustard. *John Krueger* * A determined coder can write COBOL programs in any language. *Author: unknown* * Rumour has it that the object oriented specification for COBOL was code named *ADD 1 TO COBOL GIVING COBOL.* *Author: unknown* A less verbose, more concise version; *very unCOBOL that* *ADD 1 TO COBOL.* *Thanks to aoirthoir* And, just because; *ADD 1 TO COBOL GIVING OpenCOBOL* * A common disrepect of COBOL joke is that the acronym stands for: Completely Obsolete Business Oriented Language. *Author unkown* We know better. The reality is: Can't Obsolesce Because Of Legacy. *And why would you want to?* *Brian Tiffin* * COBOL Certainly Old But Often Limber. *Brian Tiffin* * Ruby on Rails? Don't forget COBOL ON COGS. http://www.coboloncogs.org/INDEX.HTM * Eat COBOL, 200 billion lines can't be wrong. *Brian Tiffin* * What did COBOL yell to the escaping thief? **STOP RUN RETURNING NOW.** *Brian Tiffin* * A COBOL programmer's husband asks, "*Honey can you go to the store and get some milk. And if they have eggs, get a dozen*." After twenty minutes she returns and flops 12 bags of milk on the table. He looks at her curiously, "*Honey, why did you do that*?" She responds flatly, "**They had eggs**." *Author unknown* * What did COBOL reply to the executive? *Yes, I can* **PERFORM JUMPS THRU HOOPS.** *Brian Tiffin* * What did OpenCOBOL reply to the executive? *Sir, I can* **PERFORM JUMPS THRU FLAMING-HOOPS UNTIL HELL-FREEZES-OVER.** *And being COBOL, I have to show you how little code it takes:* .. sourcecode:: cobolfree identification division. program-id. freeze. data division. working-storage section. 01 hell pic 9. 88 hell-freezes-over value 1. procedure division. perform jumps thru flaming-hoops until hell-freezes-over. stop run. jumps. flaming-hoops. divide 1 by 0 giving hell. .............. A 5-7-5 haiku? .............. How about a 5-7-5 haiku? .. sourcecode:: cobolfree program-id. one. procedure division. add 1 to return-code. *btiffin* Compiles to a program that fails when run. Fails as poetry, fails as code. Your welcome. ======= History ======= .. sidebar:: History .. contents:: :local: :backlinks: entry :depth: 1 _`History` ----------------------------- What is the history of COBOL? ----------------------------- Starting in 1959, a committee was formed under the sponsorship of the United States Department of Defense to recommend a short range option regarding business computing. The Conference on Data System Languages (CODASYL) led by Joe Wegstein of National Bureau of Standards (now National Institute of Standards and Technology) developed a new language, and created the first standardized business computer programming language. The COmmon Business Oriented Language acronym was announced on September 18th, 1959. Late in 1960, *essentially* the same COBOL program ran on two different hardware platforms, and stakeholders espied the potential for fulfilling the objective of industry wide, compatible business systems. `Admiral Grace Hopper`_ is affectionately referred to as the *mother of the COBOL language* as she and her previous work with FLOW-MATIC greatly influenced the specifications of the first COBOL. Standards have been published for: * COBOL-68 * COBOL-74 * COBOL-85 * COBOL-2002 * Draft work for COBOL-20xx is |currently| underway and these roughly correspond to the year they were produced. Note the y2k flavour of four digit naming occurred after the millennium change. Estimates vary, but it is entirely reasonable to believe that of the some 300,000,000,000 (three hundred thousand million) lines of computer source code in production today, 200,000,000,000 (two hundred thousand million) lines are COBOL. A full 2/3rds of the world's source code. See the Wikipedia entry for COBOL_ for a lot more details. -------------------------------------- What are the Official COBOL Standards? -------------------------------------- Many thanks to William Klein, [wmklein]_ for details on what wordings are to be used when referencing COBOL Standards:: There are several references to "COBOL 85" and these are often distinguished from "Intrinsic Functions". The official (but really obscure) term that should be used is "Amended Third Standard COBOL". The "clearer" (and IMHO better) term that should be used is something like - "'85 Standard COBOL with its amendments" By 1991 (actually 1993 for ISO rather than ANSI) there was no such thing as "just '85 Standard COBOL". The only recognized Standard was the "base" document (X3.23-1985) ALONG with its two amendments - Intrinsic Functions Module Amendment - Corrections Amendment An interesting related fact is that the "Intrinsic Functions Module" was OPTIONAL in the ANSI and ISO COBOL Standards but was REQUIRED (at the HIGH level) for FIPS COBOL. As the "certification tests" were aimed at getting US government contracts, most vendors (who were still doing certification) actually treated Intrinsic Functions required not optional for "High-level" certification. (They were NOT included in the FIPS intermediate certification process). Bottom-Line: Although some intrinsic functions were added in the '02 Standard (and more are included in the draft revision), it is not proper (in my opinion) to distinguish between supporting the '85 Standard and supporting intrinsic functions. P.S. The corrections amendment did make some technical changes but all of these were included in the '02 Standard. Therefore, hopefully, what it did won't impact OpenCOBOL much. .. note:: While OpenCOBOL can be held to a high standard of quality and robustness, the authors *DO NOT* claim it to be a "Standard Conforming" implementation of COBOL. .. Maintainer: Details on official names of other standards still missing --------------------------------------------- What is the development history of OpenCOBOL? --------------------------------------------- OpenCOBOL was initially developed by Keisuke Nishida [Keisuke]_ from experience working on TinyCOBOL_ originally developed by Rildo Pragana. The first public release was version 0.9.0 on January 25th, 2002. Development continued apace, with version 0.30 released by Keisuke on August 8th, 2004. Roger While [Roger]_ then took up the role as lead developer on October 30th, 2004. Version 0.31 was released February 1st, 2005. Version 0.32 was released May 12th, 2005. Version 0.33 started on May 13th, 2005. Version 1.0 was released on December 27th, 2007. ----------------------------------------- What is the current version of OpenCOBOL? ----------------------------------------- OpenCOBOL 1.0 was released December 27th, 2007 by Roger While [Roger]_. The decision to go 1.0 from the 0.33 version followed many incremental enhancements from 2005 through till late in 2007. OpenCOBOL 1.1 pre-release became active on December 27th, 2007 and is |currently| in active development. The pre-release source tar can be found at `OpenCOBOL 1.1`_ with installer instructions at `OpenCOBOL Install`_ and in the INSTALLING text file of the sources. After a download .. sourcecode:: bash $ ./configure $ make $ make check $ sudo make install will place a new set of binaries rooted off **/usr/local** Be sure to see `What are the configure options available for building OpenCOBOL?`_ for all the available options for building from sources. ............. occurlrefresh ............. If you build a pre-release OC1.1, you will be able to compile the **occurlrefresh.cbl** (with **occurlsym.cpy**) application and an early **occurl.c** libCURL wrapper that allows file transfers off the Internet. **occurlrefresh** includes default filenames for retrieving the most recent pre-release source archive and only updates the local copy if there has been a newer upstream release. Thanks to [aoirthoir]_ for hosting these; |currently| at * `occurlrefresh.cbl `_ * `occurlsym.cpy `_ * `occurl.c `_ and then simply .. sourcecode:: bash $ ./occurlrefresh to download any new development archives. libCURL tests the modification timestamps, so this procedure is very resource efficient, only pulling from the server if there is something new. A **-b** option is accepted that will spawn off **tar**, **configure** and **make** pass to compile a fresh copy. **-b** does not do an install, you'll still have to do that manually after verifying that everything is ok. =============== Using OpenCOBOL =============== .. sidebar:: Using OpenCOBOL .. contents:: :local: :backlinks: entry :depth: 1 _`Using OpenCOBOL` --------------------------- How do I install OpenCOBOL? --------------------------- Installation instructions can be found at `OpenCOBOL Install`_. .......................... From source with GNU/Linux .......................... .. sourcecode:: bash $ wget http://www.sim-basis.de/open-cobol-1.1.tar.gz $ tar xvf open-cobol-1.1.tar.gz $ cd open-cobol-1.1 $ ./configure $ make $ make check $ sudo make install $ sudo ldconfig ...... Debian ...... The Debian binary package makes installing OpenCOBOL 1.0 a snap. From **root** or using sudo .. sourcecode:: bash $ apt-get install open-cobol ...... Fedora ...... From the main Fedora repositories .. sourcecode:: bash $ yum install open-cobol ....... Windows ....... Build from sources under Cygwin or MinGW. Follow the instructions from the site listed above, or read the OC_GettingStarted_Windows document by [wmklein]_ available online at * http://opencobol.add1tocobol.com/oc_gettingstarted_windows.html * http://opencobol.add1tocobol.com/OC_GettingStarted_Windows.pdf Also see `What is the current version of OpenCOBOL?`_. ......... Macintosh ......... From Ganymede on opencobol.org_ **HOWTO: Installling OpenCOBOL 1.0.0 (with BerkeleyDB) under Mac OS 10.5.x-10.6.x** :: On Mac OS X 10.5.x/10.6.x, I have successfully managed to compile and install OpenCOBOL 1.0.0 (including libdb linking), and am now happily compiling production systems with it. It's not *entirely* straightforward, as it involves installing GMP via MacPorts -- the *only way* that GMP will install properly because of some eccentricities in Apple's Xcode development tools (particularly with relation to c99 in gcc), unless you are willing to patch things by hand. In addition, the earlier BerkeleyDB versions (the 4.x.x ones available via MacPorts) cause some strange ioctl errors at runtime under Mac OS X Leopard and Snow Leopard when attempting certain types of ORGANIZATION IS INDEXED operations; precisely what conditions causes this I am yet to fully ascertain. The upshot of it is that in order to compile and run a complete OpenCOBOL 1.0.0 installation on Leopard and Snow Leopard, one has to 1) install GMP via MacPorts; but 2) compile and install a recent version of BerkeleyDB natively. Probably at some point, I'm going to package this into a pretty-pretty precompiled .app and .dmg along with a rudimentary Cocoa compiler interface. Until then, however -- my COBOL on Mac comrades! -- please do the following: -- INSTALLATION STEPS (Tested on both 10.5.x and 10.6.x) -- 1) Download an appropriate MacPorts distribution for your OS: If you want to use the installer: * For 10.5.x: MacPorts-1.8.0-10.5-Leopard.dmg * For 10.6.x: MacPorts-1.8.0-10.6-SnowLeopard.dmg From source, MacPorts-1.8.0.tar.gz is confirmed to work on both versions. NB: Make sure PATH is properly set by install in your active user's ~/.profile. 2) Update MacPorts: sudo port -d selfupdate 3) Install GMP with MacPorts: sudo port install gmp 4) Download the Oracle Berkeley DB 5.0.21 (or later) .tar.gz source: 5) Untar, cd to the Berkeley DB source folder, then: cd /build_unix 6) Do the following to configure, make and install Berkeley DB: ../dist/configure make sudo make install 7) Download and untar OpenCOBOL 1.0.0, cd to directory 8) Run ./configure, setting CPPFLAGS and LDFLAGS as below (CHANGING ANY VERSION-SPECIFIC PATHS TO WHAT YOU JUST INSTALLED) as follows: ./configure CPPFLAGS="-I/opt/local/var/macports/software/gmp/5.0.1_0/opt/local/include/ -I/usr/local/BerkeleyDB.5.0/include/" LDFLAGS="-L/opt/local/var/macports/software/gmp/5.0.1_0/opt/local/lib -L/usr/local/BerkeleyDB.5.0/lib/" 9) Make and install: make sudo make install 10) Et voila! Try exiting the directory and invoking cobc. -- YOU SHOULD THEN BE ABLE TO DO SOMETHING LIKE THIS: -- phrygia.ganymede-labs.com:bottles ganymede$ sw_vers ProductName: Mac OS X ProductVersion: 10.5.6 BuildVersion: 9G55 phrygia.ganymede-labs.com:bottles ganymede$ cobc -V cobc (OpenCOBOL) 1.0.0 Copyright (C) 2001-2007 Keisuke Nishida Copyright (C) 2007 Roger While phrygia.ganymede-labs.com:bottles ganymede$ cobc -v -x bottles.cbl preprocessing bottles.cbl into /var/folders/KI/KI15WC0KGMmvvO980RztgU+++TI/-Tmp-//cob75450_0.cob translating /var/folders/KI/KI15WC0KGMmvvO980RztgU+++TI/-Tmp-//cob75450_0.cob into /var/folders/KI/KI15WC0KGMmvvO980RztgU+++TI/-Tmp-//cob75450_0.c gcc -pipe -c -I/usr/local/include -I/opt/local/var/macports/software/gmp/5.0.1_0/opt/local/include/ -I/usr/local/BerkeleyDB.5.0/include/ -I/usr/local/include -O2 -Wno-unused -fsigned-char -Wno-pointer-sign -o /var/folders/KI/KI15WC0KGMmvvO980RztgU+++TI/-Tmp-//cob75450_0.o /var/folders/KI/KI15WC0KGMmvvO980RztgU+++TI/-Tmp-//cob75450_0.c gcc -pipe -L/opt/local/var/macports/software/gmp/5.0.1_0/opt/local/lib -L/usr/local/BerkeleyDB.5.0/lib/ -o bottles /var/folders/KI/KI15WC0KGMmvvO980RztgU+++TI/-Tmp-//cob75450_0.o -L/opt/local/var/macports/software/gmp/5.0.1_0/opt/local/lib -L/usr/local/BerkeleyDB.5.0/lib/ -L/usr/local/lib -lcob -lm -lgmp -L/usr/local/lib -lintl -liconv -lc -R/usr/local/lib -lncurses -ldb With lots of sloppy LINKAGE SECTION kisses, -- Ganymede ---------------------------------------------------------------- What are the configure options available for building OpenCOBOL? ---------------------------------------------------------------- *configure* is a defacto standard development tool for POSIX compliant operating systems, in particular GNU/Linux. It examines the current environment and creates a Makefile suitable for the target computer and the package being built. For OpenCOBOL, the *configure* script accepts **--help** as a command line option to display all of the available configuration choices. :: `configure' configures OpenCOBOL 1.1 to adapt to many kinds of systems. Usage: ./configure [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit ---quiet, --silent do not print `checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for `--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or `..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [/usr/local] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, `make install' will install all the files in `/usr/local/bin', `/usr/local/lib' etc. You can specify an installation prefix other than `/usr/local' using `--prefix', for instance `--prefix=$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --datadir=DIR read-only architecture-independent data [PREFIX/share] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --infodir=DIR info documentation [PREFIX/info] --mandir=DIR man documentation [PREFIX/man] Program names: --program-prefix=PREFIX prepend PREFIX to installed program names --program-suffix=SUFFIX append SUFFIX to installed program names --program-transform-name=PROGRAM run sed PROGRAM on installed program names System types: --build=BUILD configure for building on BUILD [guessed] --host=HOST cross-compile to build programs to run on HOST [BUILD] Optional Features: --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --enable-maintainer-mode enable make rules and dependencies not useful (and sometimes confusing) to the casual installer --disable-dependency-tracking speeds up one-time build --enable-dependency-tracking do not reject slow dependency extractors --enable-experimental (OpenCOBOL) enable experimental code (Developers only!) --enable-param-check (OpenCOBOL) enable CALL parameter checking --enable-shared[=PKGS] build shared libraries [default=yes] --enable-static[=PKGS] build static libraries [default=yes] --enable-fast-install[=PKGS] optimize for fast installation [default=yes] --disable-libtool-lock avoid locking (might break parallel builds) --disable-rpath do not hardcode runtime library paths --disable-nls do not use Native Language Support Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-cc= (OpenCOBOL) specify the C compiler used by cobc --with-seqra-extfh (OpenCOBOL) Use external SEQ/RAN file handler --with-cisam (OpenCOBOL) Use CISAM for ISAM I/O --with-disam (OpenCOBOL) Use DISAM for ISAM I/O --with-vbisam (OpenCOBOL) Use VBISAM for ISAM I/O --with-index-extfh (OpenCOBOL) Use external ISAM file handler --with-db1 (OpenCOBOL) use Berkeley DB 1.85 (libdb-1.85) --with-db (OpenCOBOL) use Berkeley DB 3.0 or later (libdb)(default) --with-lfs64 (OpenCOBOL) use large file system for file I/O (default) --with-dl (OpenCOBOL) use system dynamic loader (default) --with-patch-level (OpenCOBOL) define a patch level (default 0) --with-varse (OpenCOBOL) define variable sequential format (default 0) --with-gnu-ld assume the C compiler uses GNU ld [default=no] --with-pic try to use only PIC/non-PIC objects [default=use both] --with-tags[=TAGS] include additional configurations [automatic] --with-gnu-ld assume the C compiler uses GNU ld default=no --with-libiconv-prefix[=DIR] search for libiconv in DIR/include and DIR/lib --without-libiconv-prefix don't search for libiconv in includedir and libdir --with-libintl-prefix[=DIR] search for libintl in DIR/include and DIR/lib --without-libintl-prefix don't search for libintl in includedir and libdir Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory CPPFLAGS C/C++ preprocessor flags, e.g. -I if you have headers in a nonstandard directory CPP C preprocessor CXXCPP C++ preprocessor Use these variables to override the choices made by 'configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to . ------------------------------------------- Does OpenCOBOL have any other dependencies? ------------------------------------------- OpenCOBOL relies on a native C compiler with POSIX compatibility. GCC being a freely available compiler collection supported by most operating systems |currently| in use. OpenCOBOL requires the following external libraries to be installed: GNU MP (libgmp) 4.1.2 or later libgmp is used to implement decimal arithmetic. GNU MP is licensed under GNU Lesser General Public License. GNU Libtool (libltdl) libltdl is used to implement dynamic CALL statements. GNU Libtool is licensed under GNU Lesser General Public License. NOTE - Libtool is not required for Linux and Windows (including MinGW and Cygwin) The following libraries are optional: Berkeley DB (libdb) 1.85 or later libdb can be used to implement indexed file I/O and SORT/MERGE. Berkeley DB is licensed under the original BSD License (1.85) or their own open-source license (2.x or later). Note that, as of 2.x, if you linked your software with Berkeley DB, you must distribute the source code of your software along with your software, or you have to pay royalty to Oracle Corporation. For more information about Oracle Berkeley DB dual licensing go to : Oracle / Embedded / Oracle Berkeley DB Ncurses (libncurses) 5.2 or later libncurses can be used to implement SCREEN SECTION. Ncurses is licensed under a BSD-style license. ------------------------------------- How does the OpenCOBOL compiler work? ------------------------------------- OpenCOBOL is a multi-stage command line driven compiler. Command line options control what stages are performed during processing. 1. Preprocess #. Translate #. Compile #. Assemble #. Link #. Build OpenCOBOL produces intermediate C source code that is then passed to a configured C compiler and other tools. the GNU C compiler, **gcc** being a standard. The main tool, **cobc**, by default, produces modules, linkable shared object files. ........................... Example of OpenCOBOL stages ........................... Documenting the output of the various stages of OpenCOBOL compilation. ..................... Original source code; ..................... .. sourcecode:: cobol $ cat hello.cob 000100* HELLO.COB OpenCOBOL FAQ example 000200 IDENTIFICATION DIVISION. 000300 PROGRAM-ID. hello. 000400 PROCEDURE DIVISION. 000500 DISPLAY "Hello World!". 000600 STOP RUN. .......... Preprocess .......... .. sourcecode:: bash $ cobc -E hello.cob Preprocess only pass. One operation of the preprocessor is to convert FIXED format to FREE format. COPY_ includes are also read in along with REPLACE_ substitution. The above command displayed: .. sourcecode:: cobolfree # 1 "hello.cob" IDENTIFICATION DIVISION. PROGRAM-ID. hello. PROCEDURE DIVISION. DISPLAY "Hello World!". STOP RUN. to standard out. ......... Translate ......... .. sourcecode:: bash $ cobc -C hello.cob Translate only; preprocesses and then translates the COBOL sources into C. You can examine these files to get a good sense of how the OpenCOBOL environment interacts with the native C facilities. OpenCOBOL 1.1 produced **hello.c.h** and **hello.c**. ......... hello.c.h ......... .. sourcecode:: c /* Generated by cobc 1.1.0 */ /* Generated from hello.cob */ /* Generated at Oct 04 2008 00:19:36 EDT */ /* OpenCOBOL build date Oct 01 2008 22:15:19 */ /* OpenCOBOL package date Oct 01 2008 16:31:26 CEST */ /* Compile command cobc -C hello.cob */ /* PROGRAM-ID : hello */ static unsigned char b_5[4] __attribute__((aligned)); /* COB-CRT-STATUS */ static unsigned char b_1[4] __attribute__((aligned)); /* RETURN-CODE */ static unsigned char b_2[4] __attribute__((aligned)); /* SORT-RETURN */ static unsigned char b_3[4] __attribute__((aligned)); /* NUMBER-OF-CALL-PARAMETERS */ /* attributes */ static cob_field_attr a_1 = {16, 4, 0, 0, NULL}; static cob_field_attr a_2 = {33, 0, 0, 0, NULL}; /* fields */ static cob_field f_5 = {4, b_5, &a_1}; /* COB-CRT-STATUS */ /* constants */ static cob_field c_1 = {12, (unsigned char *)"Hello World!", &a_2}; /* ---------------------------------------------- */ ....... hello.c ....... .. sourcecode:: c /* Generated by cobc 1.1.0 */ /* Generated from hello.cob */ /* Generated at Oct 04 2008 00:19:36 EDT */ /* OpenCOBOL build date Oct 01 2008 22:15:19 */ /* OpenCOBOL package date Oct 01 2008 16:31:26 CEST */ /* Compile command cobc -C hello.cob */ #define __USE_STRING_INLINES 1 #include #include #include #include #include #define COB_SOURCE_FILE "hello.cob" #define COB_PACKAGE_VERSION "1.1" #define COB_PATCH_LEVEL 0 /* function prototypes */ static int hello_ (const int); int hello (void); /* functions */ int hello () { return hello_ (0); } /* end functions */ static int hello_ (const int entry) { #include "hello.c.h" /* local variables */ static int initialized = 0; static cob_field *cob_user_parameters[COB_MAX_FIELD_PARAMS]; static cob_module module = { NULL, NULL, &f_5, NULL, cob_user_parameters, 0, '.', '$', ',', 1, 1, 1, 0}; /* perform frame stack */ int frame_index; struct frame { int perform_through; void *return_address; } frame_stack[255]; /* Start of function code */ if (unlikely(entry < 0)) { if (!initialized) { return 0; } initialized = 0; return 0; } module.next = cob_current_module; cob_current_module = &module; if (unlikely(initialized == 0)) { if (!cob_initialized) { cob_fatal_error (COB_FERROR_INITIALIZED); } cob_check_version (COB_SOURCE_FILE, COB_PACKAGE_VERSION, COB_PATCH_LEVEL); if (module.next) cob_set_cancel ((const char *)"hello", (void *)hello, (void *)hello_); (*(int *) (b_1)) = 0; (*(int *) (b_2)) = 0; (*(int *) (b_3)) = 0; memset (b_5, 48, 4); initialized = 1; } /* initialize frame stack */ frame_index = 0; frame_stack[0].perform_through = -1; /* initialize number of call params */ (*(int *) (b_3)) = cob_call_params; cob_save_call_params = cob_call_params; goto l_2; /* PROCEDURE DIVISION */ /* hello: */ l_2:; /* MAIN SECTION: */ /* MAIN PARAGRAPH: */ /* hello.cob:5: DISPLAY */ { cob_new_display (0, 1, 1, &c_1); } /* hello.cob:6: STOP */ { cob_stop_run ((*(int *) (b_1))); } cob_current_module = cob_current_module->next; return (*(int *) (b_1)); } /* end function stuff */ .................. Generate assembler .................. Using the -S switch asks **cobc** to ask the C compiler tool chain to not process farther than the assembler code generation phase. .. sourcecode:: bash $ cobc -S hello.cob ....... hello.s ....... .. sourcecode:: gas .file "cob9141_0.c" .text .globl hello .type hello, @function hello: pushl %ebp movl %esp, %ebp subl $8, %esp movl $0, (%esp) call hello_ leave ret .size hello, .-hello .data .align 4 .type module.5786, @object .size module.5786, 28 module.5786: .long 0 .long 0 .long f_5.5782 .long 0 .long cob_user_parameters.5785 .byte 0 .byte 46 .byte 36 .byte 44 .byte 1 .byte 1 .byte 1 .byte 0 .local cob_user_parameters.5785 .comm cob_user_parameters.5785,256,32 .local initialized.5784 .comm initialized.5784,4,4 .section .rodata .LC0: .string "Hello World!" .data .align 4 .type c_1.5783, @object .size c_1.5783, 12 c_1.5783: .long 12 .long .LC0 .long a_2.5781 .align 4 .type f_5.5782, @object .size f_5.5782, 12 f_5.5782: .long 4 .long b_5.5776 .long a_1.5780 .align 4 .type a_2.5781, @object .size a_2.5781, 8 a_2.5781: .byte 33 .byte 0 .byte 0 .byte 0 .long 0 .align 4 .type a_1.5780, @object .size a_1.5780, 8 a_1.5780: .byte 16 .byte 4 .byte 0 .byte 0 .long 0 .local b_3.5779 .comm b_3.5779,4,16 .local b_2.5778 .comm b_2.5778,4,16 .local b_1.5777 .comm b_1.5777,4,16 .local b_5.5776 .comm b_5.5776,4,16 .section .rodata .LC1: .string "1.1" .LC2: .string "hello.cob" .LC3: .string "hello" .text .type hello_, @function hello_: pushl %ebp movl %esp, %ebp subl $2072, %esp movl 8(%ebp), %eax shrl $31, %eax testl %eax, %eax je .L4 movl initialized.5784, %eax testl %eax, %eax jne .L5 movl $0, -2052(%ebp) jmp .L6 .L5: movl $0, initialized.5784 movl $0, -2052(%ebp) jmp .L6 .L4: movl cob_current_module, %eax movl %eax, module.5786 movl $module.5786, cob_current_module movl initialized.5784, %eax testl %eax, %eax sete %al movzbl %al, %eax testl %eax, %eax je .L7 movl cob_initialized, %eax testl %eax, %eax jne .L8 movl $0, (%esp) call cob_fatal_error .L8: movl $0, 8(%esp) movl $.LC1, 4(%esp) movl $.LC2, (%esp) call cob_check_version movl module.5786, %eax testl %eax, %eax je .L9 movl $hello_, 8(%esp) movl $hello, 4(%esp) movl $.LC3, (%esp) call cob_set_cancel .L9: movl $b_1.5777, %eax movl $0, (%eax) movl $b_2.5778, %eax movl $0, (%eax) movl $b_3.5779, %eax movl $0, (%eax) movl $4, 8(%esp) movl $48, 4(%esp) movl $b_5.5776, (%esp) call memset movl $1, initialized.5784 .L7: movl $0, -4(%ebp) movl $-1, -2044(%ebp) movl $b_3.5779, %edx movl cob_call_params, %eax movl %eax, (%edx) movl cob_call_params, %eax movl %eax, cob_save_call_params .L10: movl $c_1.5783, 12(%esp) movl $1, 8(%esp) movl $1, 4(%esp) movl $0, (%esp) call cob_new_display movl $b_1.5777, %eax movl (%eax), %eax movl %eax, (%esp) call cob_stop_run .L6: movl -2052(%ebp), %eax leave ret .size hello_, .-hello_ .ident "GCC: (Debian 4.3.1-9) 4.3.1" .section .note.GNU-stack,"",@progbits Produces **hello.s**. ................... Produce object code ................... .. sourcecode:: bash $ cobc -c hello.cob Compile and assemble, do not link. Produces **hello.o**. ............. Build modules ............. .. sourcecode:: bash $ cobc -m hello.cob Build dynamically loadable module. The is the *default behaviour*. This example produces **hello.so** or **hello.dll**. .......... Module run .......... .. sourcecode:: bash $ cobcrun hello Hello World! Will scan the DSO_ hello.so, and then link, load, and execute hello. .. Maintainer: Need a little OS/X info here ................. Create executable ................. .. sourcecode:: bash $ cobc -x hello.cob Create an executable program. This examples produces **hello** or **hello.exe**. **This is important**. *cobc* produces a *Dynamic Shared Object* by default. *To create executables*, you need to use **-x**. .. sourcecode:: bash $ ./hello Hello World! OpenCOBOL also supports features for multiple source, multiple language programming, detailed in the FAQ at `Does OpenCOBOL support modules?`_. ------------- What is cobc? ------------- **cobc** is the OpenCOBOL compiler. It processes source code into object, library or executable code. See `What compiler options are supported?`_ for more information. ---------------- What is cobcrun? ---------------- **cobcrun** is the OpenCOBOL driver program that allows the execution of programs stored in OpenCOBOL modules. The **cobc** compiler, by default, produces modules (the *-m* option). These modules are linkable dynamic shared objects (DSO). Using GNU/Linux for example .. sourcecode:: bash $ cobc -x hello.cob $ ./hello Hello World! $ cobc hello.cob $ cobcrun hello Hello World! The **cobc -x hello.cob** built an executable binary called hello. The **cobc hello.cob** produced a DSO_ hello.so, and cobcrun resolves the entry point and executes the code, right from the DSO_. **cobcrun** *is the compiler author's preferred way to manage OpenCOBOL development.* It alleviates knowing which source file needs *-x* while encouraging proper modular programming, a mainstay of OpenCOBOL. ------------------- What is cob-config? ------------------- **cob-config** is a program that can be used to find the C compiler flags and libraries required for compiling. Using GNU/Linux for example .. sourcecode:: bash $ cob-config Usage: cob-config [OPTIONS] Options: [--prefix[=DIR]] [--exec-prefix[=DIR]] [--version] [--libs] [--cflags] $ cob-config --libs -L/usr/local/lib -lcob -lm -lgmp -lncurses -ldb $ cob-config --cflags -I/usr/local/include You may need to use these features during mixed source language development, usually by back-ticking the command output inline with other **gcc** commands. ------------------------------------ What compiler options are supported? ------------------------------------ The OpenCOBOL system strives to follow standards, yet also remain a viable compiler option for the many billions of existing lines of COBOL sources, by supporting many existing extensions to the COBOL language. Many details of the compile can be controlled with command line options. Please also see `What are the OpenCOBOL compile time configuration files?`_ for more details on this finely tuned control. .. Note to maintainers. $ cobc --help and indent 4 spaces. :: $ cobc -V cobc (OpenCOBOL) 1.1.0 Copyright (C) 2001-2008 Keisuke Nishida / Roger While Built Oct 29 2008 16:32:02 Packaged Oct 28 2008 19:05:45 CET $ cobc --help Usage: cobc [options] file... Options: --help Display this message --version, -V Display compiler version -v Display the programs invoked by the compiler -x Build an executable program -m Build a dynamically loadable module (default) -std= Compile for a specific dialect : cobol2002 Cobol 2002 cobol85 Cobol 85 ibm IBM Compatible mvs MVS Compatible bs2000 BS2000 Compatible mf Micro Focus Compatible default When not specified See config/default.conf and config/*.conf -free Use free source format -fixed Use fixed source format (default) -O, -O2, -Os Enable optimization -g Produce debugging information in the output -debug Enable all run-time error checking -o Place the output into -b Combine all input files into a single dynamically loadable module -E Preprocess only; do not compile, assemble or link -C Translation only; convert COBOL to C -S Compile only; output assembly file -c Compile and assemble, but do not link -t Generate and place a program listing into -I Add to copy/include search path -L Add to library search path -l Link the library -D Pass to the C compiler -conf= User defined dialect configuration - See -std= --list-reserved Display reserved words --list-intrinsics Display intrinsic functions --list-mnemonics Display mnemonic names -save-temps(=) Save intermediate files (default current directory) -MT Set target file used in dependency list -MF Place dependency list into -ext Add default file extension -W Enable ALL warnings -Wall Enable all warnings except as noted below -Wobsolete Warn if obsolete features are used -Warchaic Warn if archaic features are used -Wredefinition Warn incompatible redefinition of data items -Wconstant Warn inconsistent constant -Wparentheses Warn lack of parentheses around AND within OR -Wstrict-typing Warn type mismatch strictly -Wimplicit-define Warn implicitly defined data items -Wcall-params Warn non 01/77 items for CALL params (NOT set with -Wall) -Wcolumn-overflow Warn text after column 72, FIXED format (NOT set with -Wall) -Wterminator Warn lack of scope terminator END-XXX (NOT set with -Wall) -Wtruncate Warn possible field truncation (NOT set with -Wall) -Wlinkage Warn dangling LINKAGE items (NOT set with -Wall) -Wunreachable Warn unreachable statements (NOT set with -Wall) -ftrace Generate trace code (Executed SECTION/PARAGRAPH) -ftraceall Generate trace code (Executed SECTION/PARAGRAPH/STATEMENTS) -fsyntax-only Syntax error checking only; don't emit any output -fdebugging-line Enable debugging lines ('D' in indicator column) -fsource-location Generate source location code (Turned on by -debug or -g) -fimplicit-init Do automatic initialization of the Cobol runtime system -fsign-ascii Numeric display sign ASCII (Default on ASCII machines) -fsign-ebcdic Numeric display sign EBCDIC (Default on EBCDIC machines) -fstack-check PERFORM stack checking (Turned on by -debug or -g) -ffold-copy-lower Fold COPY subject to lower case (Default no transformation) -ffold-copy-upper Fold COPY subject to upper case (Default no transformation) -fnotrunc Do not truncate binary fields according to PICTURE -ffunctions-all Allow use of intrinsic functions without FUNCTION keyword -fmfcomment '*' or '/' in column 1 treated as comment (FIXED only) -fnull-param Pass extra NULL terminating pointers on CALL statements ----------------------------------------- What dialects are supported by OpenCOBOL? ----------------------------------------- Using the **std=** compiler option, OpenCOBOL can be configured to compile using specific historical COBOL compiler features and quirks. Supported dialects include: * default * cobol85 * cobol2002 * ibm * mvs * mf * bs2000 For details on what options and switches are used to support these dialect compiles, see the **config/** directory of your OpenCOBOL installation. For Debian GNU/Linux, that will be **/usr/share/open-cobol/config/** if you used APT to install an OpenCOBOL package or **/usr/local/share/open-cobol/config/** after a build from the source archive. For example: the *bs2000.conf* file restricts data representations to 2, 4 or 8 byte binary while *mf.conf* allows data representations from 1 thru 8 bytes. *cobol85.conf* allows debugging lines, *cobol2002.conf* configures the compiler to warn that this feature is obsolete. ----------------------------------------------------------------------- What extensions are used if cobc is called with/without "-ext" for COPY ----------------------------------------------------------------------- From Roger on opencobol.org_ :: In the following order - CPY, CBL, COB, cpy, cbl, cob and finally with no extension. User specified extensions (in the order as per command line) are inspected PRIOR to the above defaults. ie. They take precedence. -------------------------------------------------------- What are the OpenCOBOL compile time configuration files? -------------------------------------------------------- To assist in the support of the various existent COBOL compilers, OpenCOBOL reads configuration files controlling various aspects of a compile pass. Each supported dialect will also have a *.conf* file in the **config/** sub-directory of its installation. For Debian GNU/Linux, these will be in **/usr/share/open-cobol/config/** or **/usr/local/share/open-cobol/config** under default package and default *make* conditions. For example, the default configuration, *default.conf* is:: # COBOL compiler configuration -*- sh -*- # Value: any string name: "OpenCOBOL" # Value: int tab-width: 8 text-column: 72 # Value: `cobol2002', `mf', `ibm' # assign-clause: mf # If yes, file names are resolved at run time using environment variables. # For example, given ASSIGN TO "DATAFILE", the actual file name will be # 1. the value of environment variable `DD_DATAFILE' or # 2. the value of environment variable `dd_DATAFILE' or # 3. the value of environment variable `DATAFILE' or # 4. the literal "DATAFILE" # If no, the value of the assign clause is the file name. # # Value: `yes', `no' filename-mapping: yes # Value: `yes', `no' pretty-display: yes # Value: `yes', `no' auto-initialize: yes # Value: `yes', `no' complex-odo: no # Value: `yes', `no' indirect-redefines: no # Value: signed unsigned bytes # ------ -------- ----- # `2-4-8' 1 - 4 2 # 5 - 9 4 # 10 - 18 8 # # `1-2-4-8' 1 - 2 1 # 3 - 4 2 # 5 - 9 4 # 10 - 18 8 # # `1--8' 1 - 2 1 - 2 1 # 3 - 4 3 - 4 2 # 5 - 6 5 - 7 3 # 7 - 9 8 - 9 4 # 10 - 11 10 - 12 5 # 12 - 14 13 - 14 6 # 15 - 16 15 - 16 7 # 17 - 18 17 - 18 8 binary-size: 1-2-4-8 # Value: `yes', `no' binary-truncate: yes # Value: `native', `big-endian' binary-byteorder: big-endian # Value: `yes', `no' larger-redefines-ok: no # Value: `yes', `no' relaxed-syntax-check: no # Perform type OSVS - If yes, the exit point of any currently executing perform # is recognized if reached. # Value: `yes', `no' perform-osvs: no # If yes, non-parameter linkage-section items remain allocated # between invocations. # Value: `yes', `no' sticky-linkage: no # If yes, allow non-matching level numbers # Value: `yes', `no' relax-level-hierarchy: no # not-reserved: # Value: Word to be taken out of the reserved words list # (case independent) # Dialect features # Value: `ok', `archaic', `obsolete', `skip', `ignore', `unconformable' author-paragraph: obsolete memory-size-clause: obsolete multiple-file-tape-clause: obsolete label-records-clause: obsolete value-of-clause: obsolete data-records-clause: obsolete top-level-occurs-clause: skip synchronized-clause: ok goto-statement-without-name: obsolete stop-literal-statement: obsolete debugging-line: obsolete padding-character-clause: obsolete next-sentence-phrase: archaic eject-statement: skip entry-statement: obsolete move-noninteger-to-alphanumeric: error odo-without-to: ok ------------------------------ Does OpenCOBOL work with make? ------------------------------ Absolutely. Very well. A sample **makefile** .. sourcecode:: make # OpenCOBOL rules COBCWARN = -W # create an executable %: %.cob cobc $(COBCWARN) -x $^ -o $@ # create a dynamic module %.so: %.cob cobc $(COBCWARN) -m $^ -o $@ # create a linkable object %.o: %.cob cobc $(COBCWARN) -c $^ -o $@ # generate C code %.c: %.cob cobc $(COBCWARN) -C $^ # generate assembly %.s: %.cob cobc $(COBCWARN) -S $^ # generate intermediate suitable for cobxref %.i: %.cob [ -d tmps ] || mkdir tmps cobc $(COBCWARN) --save-temps=tmps -c $^ # hack extension; create an executable; if errors, call vim in quickfix %.q: %.cob cobc $(COBCWARN) -x $^ 2>errors.err || vi -q # hack extension; make binary; capture warnings, call vim quickfix %.qw: %.cob cobc $(COBCWARN) -x $^ 2>errors.err ; vi -q # run ocdoc to get documentation %.html: %.cob ./ocdoc $^ $*.rst $*.html $*.css # run cobxref and get a cross reference listing (leaves tmps dir around) %.lst: %.cob [ -d tmps ] || mkdir tmps cobc $(COBCWARN) --save-temps=tmps -c $^ -o tmps/$*.o && ~/writing/add1/tools/cobxref/cobxref tmps/$*.i # tectonics for occurlrefresh occurlrefresh: occurl.c occurlsym.cpy occurlrefresh.cbl cobc -c -Wall occurl.c cobc -x -lcurl occurlrefresh.cbl occurl.o And now to compile a small program called **program.cob**, just use .. sourcecode:: bash $ make program # for executables $ make program.o # for object files $ make program.so # for shared library $ make program.q # create an executable and call vi in quickfix mode The last rule, *occurlrefresh* is an example of how a multi-part project can be supported. Simply type .. sourcecode:: bash $ make occurlrefresh and make will check the timestamps for occurl.c, occurlsym.cpy and occurlrefresh.cbl and then build up the executable if any of those files have changed compared to timestamp of the binary. See Tectonics_ for another word to describe building code. ------------------------------------------------------------ Do you have a reasonable source code skeleton for OpenCOBOL? ------------------------------------------------------------ Maybe. Style is a very personal developer choice. OpenCOBOL pays homage to this freedom of choice. Here is the FIXED form header that this author uses. It includes **ocdoc** lines. .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *><* =========== *><* *><* =========== *><* :Author: *><* :Date: *><* :Purpose: *><* :Tectonics: cobc *> *************************************************************** identification division. program-id. . environment division. configuration section. input-output section. file-control. *> select *> assign to *> organization is *> . data division. file section. *>fd . *> 01 . working-storage section. local-storage section. linkage section. screen section. *> *************************************************************** procedure division. goback. end program . *><* *><* Last Update: dd-Mmm-yyyy Fill in the *program-id* and *end program* to compile. Fill in the ocdoc title for generating documentation. See `What is ocdoc?`_ for more information on *(one method of)* inline documentation. Here are some templates that can cut and pasted. Fixed form in lowercase .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: *> Date: *> Purpose: *> Tectonics: cobc *> *************************************************************** identification division. program-id. . environment division. configuration section. input-output section. *> file-control. *> select *> assign to *> organization is *> . data division. *> file section. *> fd . *> 01 . working-storage section. local-storage section. linkage section. screen section. *> *************************************************************** procedure division. goback. end program . Fixed form in UPPERCASE .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED ****************************************************************** * Author: * Date: * Purpose: * Tectonics: cobc ****************************************************************** IDENTIFICATION DIVISION. PROGRAM-ID. . ENVIRONMENT DIVISION. CONFIGURATION SECTION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT ASSIGN TO ORGANIZATION IS . DATA DIVISION. FILE SECTION. FD . 01 . WORKING-STORAGE SECTION. LOCAL-STORAGE SECTION. LINKAGE SECTION. SCREEN SECTION. ****************************************************************** PROCEDURE DIVISION. GOBACK. END PROGRAM . The OCOBOL "sequence number" can safely be removed. It is there to ensure proper alignment in the browser. FREE FORM can be compiled with **cobc -free** or use the supported compiler directive:: >>SOURCE FORMAT IS FREE the above line must start in column 7 unless **cobc -free** is used. .. sourcecode:: cobolfree *> ** >>SOURCE FORMAT IS FREE *> ********************************************************************* *> Author: *> Date: *> Purpose: *> Tectonics: cobc -free *> ********************************************************************* identification division. program-id. . environment division. configuration section. input-output section. file-control. select assign to organization is . data division. file section. fd . 01 . working-storage section. local-storage section. linkage section. screen section. procedure division. goback. end program . These files can be downloaded from * `headfix.cob `_ * `headfixuppper.cob `_ * `headfree.cob `_ .. Note:: There are tricks to ensure that FIXED FORMAT source code can be compiled in a FREE FORMAT mode. That includes using free form end of line comments, no sequence numbers, free form DEBUG line directives with the >>D starting in column 5 (so the D ends up in column 7). ------------------------------------------------------------------ Can OpenCOBOL be used to write command line stdin, stdout filters? ------------------------------------------------------------------ Absolutely. It comes down to SELECT name ASSIGN TO KEYBOARD for standard input, and SELECT name ASSIGN TO DISPLAY for standard out. Below is a skeleton that can be used to write various filters. These programs can be used as command line pipes, or with redirections. .. sourcecode:: bash $ cat datafile | filter $ filter outputfile **filter.cob.** You'll want to change the 01-transform paragraph to do all the processing of each record. This skeleton simply copies stdin to stdout, *with a limit of 32K records* so that may need to be changed as well or tests made to ensure the default LINE SEQUENTIAL mode of KEYBOARD and DISPLAY are appropriate for the task at hand. .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *><* =========== *><* filter *><* =========== *><* :Author: Brian Tiffin *><* :Date: 20090207 *><* :Purpose: Standard IO filters *><* :Tectonics: cobc -x filter.cob *> *************************************************************** identification division. program-id. filter. environment division. configuration section. input-output section. file-control. select standard-input assign to keyboard. select standard-output assign to display. data division. file section. fd standard-input. 01 stdin-record pic x(32768). fd standard-output. 01 stdout-record pic x(32768). working-storage section. 01 file-status pic x value space. 88 end-of-file value high-value when set to false is low-value. *> *************************************************************** procedure division. main section. 00-main. perform 01-open perform 01-read perform until end-of-file perform 01-transform perform 01-write perform 01-read end-perform . 00-leave. perform 01-close . goback. *> end main support section. 01-open. open input standard-input open output standard-output . 01-read. read standard-input at end set end-of-file to true end-read . *> All changes here 01-transform. move stdin-record to stdout-record . *> 01-write. write stdout-record end-write . 01-close. close standard-input close standard-output . end program filter. *><* *><* Last Update: dd-Mmm-yyyy -------------------------------------------- How do you print to printers with OpenCOBOL? -------------------------------------------- OpenCOBOL and COBOL in general does not directly support printers. That role is delegated to the operating system. Having said that, there are a few ways to get data to a printer. .......................... printing with standard out .......................... Writing directly to standard out, as explained in `Can OpenCOBOL be used to write command line stdin, stdout filters?`_ and then simply piping to **lpd** should usually suffice to get text to your printer. .. sourcecode:: bash $ ./cobprog | lp $ ./yearend | lp -d $PRESIDENTSPRINTER Don't try the above with the DISPLAY verb; use WRITE TO stdout, with stdout selected and assigned to the **DISPLAY** name. ........................ calling the system print ........................ Files can be routed to the printer from a running program with sequences such as .. sourcecode:: cobolfree CALL "SYSTEM" USING "lp os-specific-path-to-file" RETURNING status END-CALL ........................... print control library calls ........................... And then we open up the field of callable libraries for print support. Below is some template code for sending files to a local CUPS_ install. .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian *> Date: 10-Aug-2009 *> Purpose: CUPS quick print *> Tectonics: cobc -lcups -x cupscob.cob *> *************************************************************** identification division. program-id. cupscob. data division. working-storage section. 01 result usage binary-long. 01 cupsError usage binary-long. 01 msgPointer usage pointer. 01 msgBuffer pic x(1024) based. 01 msgDisplay pic x(132). *> *************************************************************** procedure division. call "cupsPrintFile" using "cupsQueue" & x"00" "filename.prn" & x"00" "OpenCOBOL CUPS interface" & x"00" by value 0 by reference NULL returning result end-call if result equals zero call "cupsLastError" returning cupsError end-call display "Err: " cupsError end-display call "cupsLastErrorString" returning msgPointer end-call set address of msgBuffer to msgPointer string msgBuffer delimited by x"00" into msgDisplay end-string display function trim(msgDisplay) end-display else display "Job: " result end-display end-if goback. end program cupscob. ...................... print to PDF with CUPS ...................... As it turns out, the above code snippet can be used to print directly to a PDF defined cups-pdf printer. By .. sourcecode:: bash $ apt-get install cups cups-pdf under Debian, you can then .. sourcecode:: cobolfree call "cupsPrintFile" using "PDFer" & x"00" "cupscob.cob" & x"00" "cupscob.pdf" & x"00" by value 0 by reference NULL returning result end-call assuming **PDFer** is a Class or printer with a PDF member. A PDF version of the text in **cupscob.cob** will be placed in **~/PDF/** as **cupscob.pdf**. Roger While added this wisdom:: Check if your particular distro has cups-pdf in its repository. (eg. Using Yast with Suse). If yes, install from there. If no, use one of the RPM finders on the web to find a version for your distro. eg. www.rpmfind.com The installation of cups-pdf should automatically set up a dummy printer with the name "cups-pdf". So you do not actually need to define a class. You can print directly to "cups-pdf". (Check defined printers with eg. "lpstat -t") The output file location is dependent on the cups-pdf configuration file normally located at /etc/cups/cups-pdf.conf. So, eg. on my box the location is defined thus - Out ${HOME}/Documents/PDFs The code with a little more documentation, in case it turns out to be useful. .. sourcecode:: cobolfree call "cupsPrintFile" *> requires -lcups using "cups-pdf" & x"00" *> printer class "cupscob.cob" & x"00" *> input filename "cupscob.pdf" & x"00" *> title by value 0 *> num_options by reference NULL *> options struct <* returning result on exception display "hint: use -lcups for cupsPrintFile" end-display end-call ................... Jim Currey's prtcbl ................... Jim kindly donated this snippet. One of his earliest efforts establishing a base of OpenCOBOL resources. prtcbl produces source code listing with results piped to a printer. **A few customizations**. This version requires a change to a filename for printer control, location of copybooks, and possible changes to the system lp command line. Stash a print setup string in the file so named. The program prompts for input, output and printer. Jim pointed out that this was early attempts with OpenCOBOL as a tool to support better in house development, *and was nice enough to let me reprint it.* .. sourcecode:: cobol OCOBOL IDENTIFICATION DIVISION. PROGRAM-ID. PRTCBL. *AUTHOR. J C CURREY. ************************************************************ * PRINTS A COBOL SOURCE FILE WITH IT'S COPY BOOKS * * * * VERSION 001--ORIGINAL VERSION * * 3/26/2009--J C CURREY * * * * 002--ADDS .CPY (CAPS) IF .cpy FAILS TO FIND * * FILE AND EXPANDS INPUT TO 132 CHARACTERS* * 4/09/2009--J C CURREY * * * * 003--ADDS NOLIST AND LIST SUPPORT (NOTE NOT * * SUPPORTED BY OPENCOBOL COMPILER) * * **NOLIST IN COL 7-14 TURNS OFF LISTING * * **LIST IN COL 7-12 TURNS ON LISTING * * 4/22/2009--J C CURREY * * * * 004--ADDS SUPPORT FOR /testing-set-1/copybooks * * Copybooks are searched for first in the * * local directory and if not found, then in * * /testing-set-1/copybooks * * 5/7/2009--J C CURREY * * * * 005--CORRECTS MISSING LINE ISSUE ON PAGE BREAKS* * IN THE COPY FILE PRINTING SECTION. * * 1285451--SANDY DOSS * * 06/19/2009--JEREMY MONTOYA * * * * 006--USES EXTERNAL PCL CODE FILE TO INSERT PCL * * CODE INTO PRINT FILE FOR FORMATTING. * * 1330505--JIM CURREY * * 12/14/2009--PETE MCTHOMPSON * ************************************************************ ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. 121409 SELECT FORMAT-FILE ASSIGN TO WS-NAME-FORMAT-FILE 121409 ORGANIZATION IS LINE SEQUENTIAL. SELECT PRINT-FILE ASSIGN TO WS-NAME-PRINT-FILE ORGANIZATION IS LINE SEQUENTIAL. SELECT INPUT-FILE ASSIGN TO WS-NAME-INPUT-FILE ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS WS-INPUT-FILE-STATUS. SELECT COPY-FILE ASSIGN TO WS-NAME-COPY-FILE ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS WS-COPY-FILE-STATUS. DATA DIVISION. FILE SECTION. * FD PRINT-FILE. 121409 01 FORMAT-LINE PIC X(140). 01 PRINT-LINE. 05 OR-LINE-NUMBER PIC Z(6). 05 OR-FILLER-1 PIC XX. 05 OR-TEXT PIC X(132). 121409* 121409 FD FORMAT-FILE. 121409 01 FORMAT-RECORD PIC X(140). * FD INPUT-FILE. 01 INPUT-RECORD. 05 IR-BUFFER PIC X(132). FD COPY-FILE. 01 COPY-RECORD. 05 CR-BUFFER PIC X(132). **NOLIST * THIS IS ANOTHER LINE **LIST * WORKING-STORAGE SECTION. **************************************************** * CONSTANTS, COUNTERS AND WORK AREAS * **************************************************** 01 WS-NAME-PROGRAM PIC X(12) VALUE 121409 "prtcbl 006". 01 WS-NO-PARAGRAPH PIC S9(4) COMP. 01 WS-I PIC S9(4) COMP. 01 WS-J PIC S9(4) COMP. 01 WS-K PIC S9(4) COMP. 01 WS-NAME-PRINT-FILE PIC X(64) VALUE SPACES. 01 WS-NAME-INPUT-FILE PIC X(64) VALUE SPACES. 01 WS-INPUT-FILE-STATUS PIC XX VALUE "00". 050709 01 WS-NAME-COPY-FILE PIC X(128) VALUE SPACES. 050709 01 WS-HOLD-NAME-COPY-FILE PIC X(128) VALUE SPACES. 121409 01 WS-NAME-FORMAT-FILE PIC X(128) VALUE SPACES. 01 WS-COPY-FILE-STATUS PIC XX VALUE "00". 01 WS-LINE-PRINTER-NAME PIC X(16) VALUE SPACES. 01 WS-LINE-NUMBER PIC S9(6) COMP VALUE ZERO. 01 WS-PAGE-LINE-COUNTER PIC S9(4) COMP VALUE 999. 01 WS-PAGE-NUMBER PIC S9(4) COMP VALUE ZERO. 01 WS-PRINT-COMMAND PIC X(128). * 01 WS-ESCAPE-CHARACTER PIC X VALUE X"1B". * 01 WS-HEADING-LINE PIC X(132). 01 WS-CURRENT-DATE PIC X(21). 01 WS-ED4S PIC ZZZZ-. 042209 01 WS-SWITCH-PRINT PIC X VALUE SPACE. **************************************************************** * PROCEDURE DIVISION * **************************************************************** PROCEDURE DIVISION. 0000-MAIN SECTION. PERFORM 1000-INITIALIZATION THRU 1990-EXIT. PERFORM 2000-PROCESS THRU 2990-EXIT. PERFORM 9000-END-OF-PROGRAM THRU 9990-EXIT. STOP RUN. **************************************************************** * INITIALIZATION * **************************************************************** 1000-INITIALIZATION. MOVE 1000 TO WS-NO-PARAGRAPH. DISPLAY "I) ", WS-NAME-PROGRAM, " BEGINNING AT--" FUNCTION CURRENT-DATE. 1002-GET-INPUT-FILE. DISPLAY "A) ENTER INPUT-FILE NAME " WITH NO ADVANCING. ACCEPT WS-NAME-INPUT-FILE. OPEN INPUT INPUT-FILE. IF WS-INPUT-FILE-STATUS IS EQUAL TO 35 DISPLAY "W) INPUT FILE NOT FOUND" GO TO 1002-GET-INPUT-FILE. DISPLAY "A) ENTER PRINT-FILE (WORK FILE) NAME " WITH NO ADVANCING. ACCEPT WS-NAME-PRINT-FILE. DISPLAY "A) ENTER PRINTER NAME " WITH NO ADVANCING. ACCEPT WS-LINE-PRINTER-NAME. OPEN OUTPUT PRINT-FILE. 121409 MOVE "laserjet_113D.txt" TO WS-NAME-FORMAT-FILE. 121409 OPEN INPUT FORMAT-FILE. 121409 1010-OUTPUT-PCL-CODES. 121409 READ FORMAT-FILE NEXT RECORD AT END GO TO 1020-FORMAT-EOF. 121409 MOVE FORMAT-RECORD TO FORMAT-LINE. 121409 WRITE FORMAT-LINE. 121409 GO TO 1010-OUTPUT-PCL-CODES. 121409 1020-FORMAT-EOF. 121409 CLOSE FORMAT-FILE. 1990-EXIT. EXIT. ************************************************************** * DETAIL SECTION * ************************************************************** 2000-PROCESS. MOVE 2000 TO WS-NO-PARAGRAPH. READ INPUT-FILE NEXT RECORD AT END GO TO 2990-EXIT. ADD 1 TO WS-LINE-NUMBER. IF WS-PAGE-LINE-COUNTER IS GREATER THAN 112 PERFORM 2800-HEADINGS THRU 2890-EXIT. MOVE WS-LINE-NUMBER TO OR-LINE-NUMBER. MOVE SPACES TO OR-FILLER-1. MOVE INPUT-RECORD TO OR-TEXT. 042209 IF IR-BUFFER (7:6) IS EQUAL TO "**LIST" 042209 MOVE "Y" TO WS-SWITCH-PRINT. 042209 IF WS-SWITCH-PRINT IS EQUAL TO "N" 042209 THEN NEXT SENTENCE 042209 ELSE WRITE PRINT-LINE 042209 ADD 1 TO WS-PAGE-LINE-COUNTER. 042209 IF IR-BUFFER (7:8) IS EQUAL TO "**NOLIST" 042209 MOVE "N" TO WS-SWITCH-PRINT. IF IR-BUFFER (7:1) IS EQUAL TO "*" GO TO 2000-PROCESS. MOVE 1 TO WS-I. 2010-COMPARE-LOOP. IF IR-BUFFER (WS-I:2) IS EQUAL TO "*>" GO TO 2090-ENDER. IF IR-BUFFER (WS-I:6) IS EQUAL TO " COPY " GO TO 2020-COPY. ADD 1 TO WS-I. IF WS-I IS LESS THAN 73 GO TO 2010-COMPARE-LOOP. GO TO 2000-PROCESS. 2020-COPY. SUBTRACT 1 FROM WS-LINE-NUMBER. ADD 6 TO WS-I. MOVE 1 TO WS-J. MOVE SPACES TO WS-NAME-COPY-FILE. 2022-MOVE-LOOP. IF IR-BUFFER (WS-I:1) IS EQUAL TO SPACE GO TO 2030-OPEN-COPYFILE. IF IR-BUFFER (WS-I:1) IS EQUAL TO "." MOVE ".cpy" to WS-NAME-COPY-FILE (WS-J:4) GO TO 2030-OPEN-COPYFILE. MOVE IR-BUFFER (WS-I:1) TO WS-NAME-COPY-FILE (WS-J:1). ADD 1 TO WS-I, WS-J. IF WS-I IS GREATER THAN 73 OR WS-J IS GREATER THAN 64 THEN MOVE "**PROBLEM WITH.COPY STATEMENT ABOVE**" TO OR-TEXT WRITE PRINT-LINE ADD 1 TO WS-PAGE-LINE-COUNTER GO TO 2000-PROCESS. GO TO 2022-MOVE-LOOP. 2030-OPEN-COPYFILE. OPEN INPUT COPY-FILE. IF WS-COPY-FILE-STATUS IS NOT EQUAL TO "00" 040909 MOVE ".CPY" TO WS-NAME-COPY-FILE (WS-J:4) 040909 OPEN INPUT COPY-FILE 040909 IF WS-COPY-FILE-STATUS IS NOT EQUAL TO "00" 050709 MOVE WS-NAME-COPY-FILE TO WS-HOLD-NAME-COPY-FILE 050709 STRING "/testing-set-1/copybooks/" 050709 WS-HOLD-NAME-COPY-FILE 050709 INTO WS-NAME-COPY-FILE * DISPLAY "D) AT.COPY FILE OPEN NAME=\", WS-NAME-COPY-FILE, "\" 050709 OPEN INPUT COPY-FILE 050709 IF WS-COPY-FILE-STATUS IS NOT EQUAL TO "00" 050709 ADD 25 TO WS-J 050709 MOVE ".cpy" TO WS-NAME-COPY-FILE (WS-J:4) * DISPLAY "D) AT.COPY FILE OPEN NAME=\", WS-NAME-COPY-FILE, "\" 050709 OPEN INPUT COPY-FILE 050709 IF WS-COPY-FILE-STATUS IS NOT EQUAL TO "00" 050709 MOVE "***COPY FILE ABOVE NOT FOUND***" TO OR-TEXT 050709 WRITE PRINT-LINE 050709 ADD 1 TO WS-LINE-NUMBER 050709 ADD 1 TO WS-PAGE-LINE-COUNTER 050709 GO TO 2000-PROCESS 050709 END-IF 050709 END-IF 040909 END-IF 040909 END-IF. 2032-PRINT-LOOP. READ COPY-FILE NEXT RECORD AT END GO TO 2039-EOF. ADD 1 TO WS-LINE-NUMBER. 061909* MOVE WS-LINE-NUMBER TO OR-LINE-NUMBER. 061909* MOVE SPACES TO OR-FILLER-1. 061909* MOVE COPY-RECORD TO OR-TEXT. IF WS-PAGE-LINE-COUNTER IS GREATER THAN 112 PERFORM 2800-HEADINGS THRU 2890-EXIT. 061909 MOVE WS-LINE-NUMBER TO OR-LINE-NUMBER. 061909 MOVE SPACES TO OR-FILLER-1. 061909 MOVE COPY-RECORD TO OR-TEXT. 042209 IF CR-BUFFER (7:6) IS EQUAL TO "**LIST" 042209 MOVE "Y" TO WS-SWITCH-PRINT. 042209 IF WS-SWITCH-PRINT IS EQUAL TO "N" 042209 THEN NEXT SENTENCE 042209 ELSE WRITE PRINT-LINE 042209 ADD 1 TO WS-PAGE-LINE-COUNTER. 042209 IF CR-BUFFER (7:8) IS EQUAL TO "**NOLIST" 042209 MOVE "N" TO WS-SWITCH-PRINT. GO TO 2032-PRINT-LOOP. 2039-EOF. CLOSE COPY-FILE. 042209 MOVE "Y" TO WS-SWITCH-PRINT. 2090-ENDER. GO TO 2000-PROCESS. * * PAGE HEADINGS * 2800-HEADINGS. INITIALIZE PRINT-LINE. ADD 1 TO WS-PAGE-NUMBER. MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE. MOVE WS-NAME-INPUT-FILE TO PRINT-LINE. MOVE WS-PAGE-NUMBER TO WS-ED4S. MOVE "PAGE" TO PRINT-LINE (66:4). MOVE WS-ED4S TO PRINT-LINE (71:4). MOVE WS-CURRENT-DATE (5:2) TO PRINT-LINE (80:2). MOVE "/" TO PRINT-LINE (82:1). MOVE WS-CURRENT-DATE (7:2) TO PRINT-LINE (83:2). MOVE "/" TO PRINT-LINE (85:1). MOVE WS-CURRENT-DATE (1:4) TO PRINT-LINE (86:4). MOVE WS-CURRENT-DATE (9:2) TO PRINT-LINE (92:2). MOVE ":" TO PRINT-LINE (94:1). MOVE WS-CURRENT-DATE (11:2) TO PRINT-LINE (95:2). MOVE ":" TO PRINT-LINE (97:1). MOVE WS-CURRENT-DATE (13:2) TO PRINT-LINE (98:2). IF WS-PAGE-NUMBER IS EQUAL TO 1 THEN WRITE PRINT-LINE ELSE WRITE PRINT-LINE AFTER ADVANCING PAGE. INITIALIZE PRINT-LINE. WRITE PRINT-LINE. MOVE 4 TO WS-PAGE-LINE-COUNTER. 2890-EXIT. EXIT. * * END OF JOB * 2990-EXIT. EXIT. **************************************************************** * TERMINATION * **************************************************************** 9000-END-OF-PROGRAM. MOVE 9000 TO WS-NO-PARAGRAPH. CLOSE INPUT-FILE. CLOSE PRINT-FILE. 121409* STRING "lp -d " DELIMITED BY SIZE, 121409* WS-LINE-PRINTER-NAME DELIMITED BY SIZE, 121409* "-o sides=two-sided-long-edge " DELIMITED BY SIZE, 121409* "-o lpi=11 -o cpi=18 -o page-left=34 " DELIMITED BY SIZE, 121409* WS-NAME-PRINT-FILE DELIMITED BY SIZE 121409* INTO WS-PRINT-COMMAND. STRING "lp -d " DELIMITED BY SIZE, WS-LINE-PRINTER-NAME DELIMITED BY SIZE, "-o raw " DELIMITED BY SIZE, WS-NAME-PRINT-FILE DELIMITED BY SIZE INTO WS-PRINT-COMMAND. CALL "SYSTEM" USING WS-PRINT-COMMAND. DISPLAY "I) " WS-NAME-PROGRAM " COMPLETED NORMALLY AT--" FUNCTION CURRENT-DATE. 9990-EXIT. EXIT. ----------------------------------------------- Can I run background processes using OpenCOBOL? ----------------------------------------------- Absolutely. Using the CALL "SYSTEM" service. Some care must be shown to properly detach the input output handles, and to instruct the processes to ignore hangup signals along with the "run in a background subshell" control. .. sourcecode:: cobolfree CALL "SYSTEM" USING "nohup whatever 0mystdout 2>mystderr &" RETURNING result END-CALL runs **whatever** in the background, detaches stdin, sends standard output to the file **mystdout** and standard error to **mystderr**. *The above example is for POSIX shell operating systems. As always, the commands sent through SYSTEM are VERY operating system dependent.* ------------------------------------- Is there OpenCOBOL API documentation? ------------------------------------- Absolutely. Sort of. And it's beautiful, complete and awe inspiring. Dimitri van Heesch's 1.7.4 release of Doxygen, http://www.doxygen.org was used to produce http://opencobol.add1tocobol.com/doxy/ and along with Gary's OCic.cbl http://opencobol.add1tocobol.com/doxyapp/ to highlight the absolutely beautiful compiler and application documentation available for OpenCOBOL now. These pages were produced with very little effort with only a few small tweaks to the Doxygen generated Doxyfile (to turn on all files, and to generate call graphs). The sample pass produces a 1400 page beauty of a reference manual in PDF generated from the Doxygen LaTex output. *2950 pages for the sample application run*. OpenCOBOL ships as a developer tarball and Doxygen was let loose on the source tree after a ./configure and make pass. When the -C output of Gary Cutler's OCic.clb was placed into the tree, the output includes the call graphs that exercise some of the OpenCOBOL runtime library. This application level documentation is world class. Regarding the above "sort of". This was a near effortless use of Doxygen. OpenCOBOL was not touched and the sources have no explicit Doxygen tags. It also excludes many of the automake, libtool, bison and flex source files. Even still, beautiful. The compiler API is now an easy grok, and application level documentation (doxyapp using OCic.cbl as a sample) should satisfy the world's most ruthless code auditor and meticulous development team lead. See http://opencobol.add1tocobol.com/doxy/d2/dd4/structcb__field.html for a tantalizing sample of cb_field collaboration diagram and completeness of source code coverage. See http://opencobol.add1tocobol.com/doxyapp/d4/da8/OCic_8c.html for a view of how Doxygen handles the application level documentation. All for free. ---------------------------------------- How do I use LD_RUN_PATH with OpenCOBOL? ---------------------------------------- LD_RUN_PATH can be a saving grace for developers that want to build OpenCOBOL on hosted environments. LD_RUN_PATH is similar to LD_LIBRARY_PATH but builds the shared library path into **cobc** and then all of the binaries *compiled* with cobc. That means you can cherry pick the link loader paths when you build OpenCOBOL in a way that can add support for unsupported host features. If you want a recent version of ncurses on your hosting service, but don't have root permissions, you can build it into one of your own directories then EXPORT LD_RUN_PATH=mylibdir BEFORE you ./configure ; make ; make install your OpenCOBOL. All compiles with cobc will now include mylibdir during compiles, and better yet, the binaries produced will also include mylibdir in the search path at runtime. If you don't have *RECORD_PATH* in your **cobc** then you can simply compile with .. sourcecode:: bash LD_RUN_PATH=mylibdir cobc -x nextbigthing.cob to achieve similar results. With the CGI interface, see `How do I use OpenCOBOL for CGI?`_, you can now build up a complete web side solution using OpenCOBOL with little worry about being stuck on link library depencencies or running scripts to setup any path variables before safely using your cgi-bin binaries. LD_RUN_PATH is magical. It also avoids many security problems that can occur if you rely on LD_LIBRARY_PATH user environment settings. Your **cobc** will have **your** search path and not some /home/badusers trickery settings as LD_RUN_PATH searches come BEFORE LD_LIBRARY_PATH. Relying on LD_LIBRARY_PATH is deemed a **Don't do** by some experts. LD_RUN_PATH is a much safer bet. ---------------------------------------------------- What GNU build tool options when building OpenCOBOL? ---------------------------------------------------- The sources for the OpenCOBOL compiler follows GNU_ standards whenever possible. This includes being built around the GNU build system. ...... Basics ...... From an end-user perspective, what this means is that the source code distributions follow these basic steps:: tar xvf open-cobol-1.1.tar.gz cd open-cobol-1.1 ./configure make make check sudo make install sudo ldconfig But that is just scratching the surface of the possibilities. See `What are the configure options available for building OpenCOBOL?`_ for the first steps with *./configure*. .................. Out of tree builds .................. Next up, OpenCOBOL fully supports out-of-source-tree builds. From Roger:: I mentioned in the past the preferred way of doing a configure/build ie. Out-of-source-tree build. eg. We have OC 2.0 in /home/open-cobol-2.0 We want to test - OC with BDB OC with vbisam OC without db (ISAM) mkdir /home/oc20110710bdb cd /home/oc20110710bdb /home/open-cobol-2.0/configure --enable-debug make make check cd tests cd cobol85 # make test mkdir /home/oc20110710vbisam cd /home/oc20110710vbisam /home/open-cobol-2.0/configure --enable-debug --with-vbisam make make check cd tests cd cobol85 # make test mkdir /home/oc20110710nodb cd /home/oc20110710nodb /home/open-cobol-2.0/configure --enable-debug --without-db make make check cd tests cd cobol85 # make test For the last example both the OC and ANSI85 tests have been adjusted to cater for lack of ISAM functionality. To set your current environment to compile/execute from any of the above (ie. without doing a "make install" from any directory), then either "source" or execute as part of current environment (with . ) the following files from the build directory - tests/atconfig tests/atlocal (Note in that order) So eg. . /home/oc20110710vbisam/tests/atconfig . /home/oc20110710vbisam/tests/atlocal will set compiler/runtime to this environment in the current shell. Note that both the OC tests and the ANSI85 tests do this internally (Fairly obvious otherwise we would not be testing the right thing). Of course, from any of the above example directories you can do a final "make install". ................ Autotest options ................ By developing the OpenCOBOL system around the GNU build tools, developers receive a great many options *for free*. **make check** can include TESTSUITEFLAGS. The TESTSUITEFLAGS allows for options that include: - make check TESTSUITEFLAGS="--list" to list the available tests and descriptions - "--verbose" to show a little more information during the tests - "--jobs=n" to run n tests in parallel. On multi core systems, the speed up is fairly dramatic. For 425 tests, normally 1 minute 22 seconds, --jobs=4 ran in 36 seconds (on a small little AMD Athlon(tm) II X2 215 Processor). The more cores, the more dramatic the improvement. ============== Reserved Words ============== .. sidebar:: COBOL Reserved Words .. contents:: :local: :backlinks: entry :depth: 1 _`COBOL Reserved Words` -------------------------------------- What are the OpenCOBOL RESERVED WORDS? -------------------------------------- COBOL_ is a reserved word rich language. The OpenCOBOL compiler recognizes: .. Note to maintainers. Built with $ cobc --list-reserved, followed by a 74 column wide reformat and 4 space indent. The counts were calculated from $ wc and grepping for the literal "-1" in the cobc/reserved.c source. .. sidebar:: Reserved Words .. contents:: :local: :backlinks: entry :depth: 1 _`Reserved Words` 514 words in OC 1.1, 136 of which are marked not yet implemented. 378 functional reserved words, as of August 2008. ...... ACCEPT ...... Makes data available from the keyboard or operating system to named data items. .. sourcecode:: cobolfree ACCEPT variable FROM CONSOLE. ACCEPT variable FROM ENVIRONMENT "path". ACCEPT variable FROM COMMAND LINE. ACCEPT variable AT 0101. ACCEPT screen-variable. ACCEPT today FROM DATE. ACCEPT today FROM DATE YYYYMMDD. ...... ACCESS ...... Defines a file's access mode. One of DYNAMIC_, RANDOM_, or SEQUENTIAL_. .. sourcecode:: cobolfree SELECT filename ASSIGN TO "filename.dat" ACCESS MODE IS RANDOM RELATIVE KEY IS keyfield. ............ ACTIVE-CLASS ............ Not yet implemented. Object COBOL feature. ... ADD ... Sums two or more numerics, with an eye toward financial precision and error detection. .. sourcecode:: cobolfree ADD 1 TO cobol GIVING OpenCOBOL END-ADD. ADD a b c d f g h i j k l m n o p q r s t u v w x y z GIVING total-of ON SIZE ERROR PERFORM log-problem NOT ON SIZE ERROR PERFORM graph-result END-ADD ....... ADDRESS ....... Allows program access to memory address reference and, under controlled conditions, assignment. .. sourcecode:: cobolfree SET pointer-variable TO ADDRESS OF linkage-store. SET ADDRESS OF based-var TO ADDRESS OF working-var ......... ADVANCING ......... Programmer control of newline output and paging. .. sourcecode:: cobolfree DISPLAY "Legend: " WITH NO ADVANCING END-DISPLAY. WRITE printrecord AFTER ADVANCING PAGE END-WRITE. ..... AFTER ..... Nested PERFORM_ clause and can influence when loop conditional testing occurs. .. sourcecode:: cobolfree PERFORM WITH TEST AFTER VARYING variable FROM 1 BY 1 UNTIL variable > 10 AFTER inner FROM 1 BY 1 UNTIL inner > 4 DISPLAY variable ", " inner END-DISPLAY END-PERFORM. Will display 55 lines of output. 1 to 11 and 1 to 5. Removing the *WITH TEST AFTER* clause would cause 40 lines of output. 1 to 10 and 1 to 4. ....... ALIGNED ....... Not yet implemented feature that will influence the internal alignment of not yet implemented USAGE_ BIT fields. ... ALL ... A multipurpose reserved in context word. .. sourcecode:: cobolfree INSPECT variable REPLACING ALL "123" WITH "456". MOVE ALL QUOTES TO var. ........ ALLOCATE ........ Allocates actual working storage for a BASED_ element. .. sourcecode:: cobolfree ALLOCATE based-var INITIALIZED RETURNING pointer-var. ........ ALPHABET ........ .. sourcecode:: cobolfree * Set up for a mixed case SORT COLLATING SEQUENCE IS CONFIGURATION SECTION. SPECIAL-NAMES. ALPHABET name IS "AaBbCcDdEe..". .......... ALPHABETIC .......... One of the OpenCOBOL data class (*category*) tests. .. sourcecode:: cobolfree IF variable IS ALPHABETIC DISPLAY "alphabetic" END-DISPLAY END-IF ................ ALPHABETIC-LOWER ................ One of the OpenCOBOL data class (*category*) tests. .. sourcecode:: cobolfree IF variable IS ALPHABETIC-LOWER DISPLAY "alphabetic-lower" END-DISPLAY END-IF ................ ALPHABETIC-UPPER ................ One of the OpenCOBOL data class (*category*) tests. .. sourcecode:: cobolfree DISPLAY variable "alphabetic-upper " WITH NO ADVANCING IF variable IS ALPHABETIC-UPPER DISPLAY "true" END-DISPLAY ELSE DISPLAY "false" END-DISPLAY END-IF ............ ALPHANUMERIC ............ .. sourcecode:: cobolfree INITIALIZE data-record REPLACING ALPHANUMERIC BY literal-value ................... ALPHANUMERIC-EDITED ................... .. sourcecode:: cobolfree INITIALIZE data-record REPLACING ALPHANUMERIC-EDITED BY identifier-1 .... ALSO .... A powerful, multiple conditional expression feature of EVALUATE_. .. sourcecode:: cobolfree EVALUATE variable ALSO second-test WHEN "A" ALSO 1 THRU 5 PERFORM first-case WHEN "A" ALSO 6 PERFORM second-case WHEN "A" ALSO 7 THRU 9 PERFORM third-case WHEN OTHER PERFORM invalid-case END-EVALUATE ..... ALTER ..... Obsolete and unsupported verb that altered the jump target for GO TO statements. Yeah, just don't. *Rumour is, 1.1 may support this verb*, to increase support for legacy code, and NOT as *homage to a good idea*. But to be honest, I do look forward to seeing the first OpenCOBOL Flying Spaghetti Monster for the giggles of righteous indignation. ......... ALTERNATE ......... Defines an ALTERNATE key for ISAM_ data structures. .. sourcecode:: cobolfree SELECT file ASSIGN TO filename ACCESS MODE IS RANDOM RECORD KEY IS key-field ALTERNATE KEY IS alt-key WITH DUPLICATES. ... AND ... COBOL rules of precedence are; NOT, AND, OR. .. sourcecode:: cobolfree IF field = "A" AND num = 3 DISPLAY "got 3" END-DISPLAY END-IF COBOL also allows abbreviated combined relational conditions. .. sourcecode:: cobolfree IF NOT (a NOT > b AND c AND NOT d) code END-IF is equivalent to .. sourcecode:: cobolfree IF NOT (((a NOT > b) AND (a NOT > c)) AND (NOT (a NOT > d))) code END-IF ... ANY ... Allows for any value is TRUE in an EVALUATE_ statement. .. sourcecode:: cobolfree EVALUATE TRUE ALSO TRUE WHEN a > 3 ALSO ANY *> b can be any value ** PERFORM a-4-b-any WHEN a = 3 ALSO b = 1 PERFORM a-3-b-1 END-EVALUATE ....... ANYCASE ....... Not yet implemented. Will allow case insentive match of currency symbols with FUNCTION NUMVAL-C. ... ARE ... Allows for multiple conditional VALUES_. .. sourcecode:: cobolfree 01 cond-1 PIC X. 88 first-truth VALUES ARE "A" "B" "C". 88 second-truth VALUES ARE "X" "Y" "Z". .... AREA .... Controls SORT_, MERGE_ and RECORD_ data definitions. .. sourcecode:: cobolfree I-O-CONTROL. SAME RECORD AREA FOR file1, file2. ..... AREAS ..... Plural readability option for AREA_ .. sourcecode:: cobolfree SAME RECORD AREAS ............... ARGUMENT-NUMBER ............... Holds the number of OS parsed command line arguments, and can act as the explicit index when retrieving ARGUMENT-VALUE_ data. ARGUMENT-NUMBER can be used in ACCEPT FROM and DISPLAY UPON expressions. .. sourcecode:: cobolfree ACCEPT command-line-argument-count FROM ARGUMENT-NUMBER END-ACCEPT DISPLAY 2 UPON ARGUMENT-NUMBER END-DISPLAY ACCEPT indexed-command-line-argument FROM ARGUMENT-VALUE END-ACCEPT See COMMAND-LINE_ for more information on the unparsed command invocation string. .............. ARGUMENT-VALUE .............. Returns the next command line argument. This post from John on opencobol.org_ is an excellent idiom for parsing command line arguments without too much worry as to the order. .. sourcecode:: cobolfree >>source format is free *>***************************************************************** *> Author: jrls (John Ellis) *> Date: Nov-2008 *> Purpose: command line processing *>***************************************************************** identification division. program-id. cmdline. data division. *> working-storage section. *>****************************************** 01 argv pic x(100) value spaces. 88 recv value "-r", "--recv". 88 email value "-e", "--email". 88 delivered value "-d", "--delivered". 01 cmdstatus pic x value spaces. 88 lastcmd value "l". 01 reptinfo. 05 rept-recv pic x(30) value spaces. 05 rept-howsent pic x(10) value spaces. *> procedure division. 0000-start. *> perform until lastcmd move low-values to argv accept argv from argument-value if argv > low-values perform 0100-process-arguments else move "l" to cmdstatus end-if end-perform display reptinfo. stop run. *> 0100-process-arguments. *> evaluate true when recv if rept-recv = spaces accept rept-recv from argument-value else display "duplicate " argv end-if when email move "email" to rept-howsent when delivered move "delivered" to rept-howsent when other display "invalid switch: " argv end-evaluate. .. *><* Example run:: ./cmdline --recv "john ellis" -e -f invalid switch: -f john ellis email .......... ARITHMETIC .......... Not yet implemented feature of the not yet implemented OPTIONS_ paragraph of the IDENTIFICATION_ DIVISION_. ... AS ... .. sourcecode:: cobolfree PROGRAM-ID. program-name AS literal. ......... ASCENDING ......... COBOL_ table suport. .. sourcecode:: cobolfree 01 CLUBTABLE. 05 MEMBER-DATA OCCURS 1 TO 6000000000 TIMES DEPENDING ON PEOPLE ASCENDING KEY IS HOURS-DONATED. ...... ASSIGN ...... Assign a name to a file or other external resource. .. sourcecode:: cobolfree SELECT input-file ASSIGN TO "filename.ext" The actual filename used is dependent on a configuration setting. Under default configuration settings, **filename-mapping** is set to **yes**. See `What are the OpenCOBOL compile time configuration files?`_ for details. :: # If yes, file names are resolved at run time using # environment variables. # For example, given ASSIGN TO "DATAFILE", the actual # file name will be # 1. the value of environment variable 'DD_DATAFILE' or # 2. the value of environment variable 'dd_DATAFILE' or # 3. the value of environment variable 'DATAFILE' or # 4. the literal "DATAFILE" # If no, the value of the assign clause is the file name. # # Value: 'yes', 'no' filename-mapping: yes So, under GNU/Linux, bash shell .. sourcecode:: bash $ export DD_DATAFILE='/tmp/opencobol.dat' $ ./myprog the program will find the data in **/tmp/opencobol.dat** .. sourcecode:: bash $ export DD_DATAFILE='/tmp/other.dat' $ ./myprog this run of the same program will find the data in **/tmp/other.dat** As shown in the sample .conf comments, the order of environment variable lookup proceeds through three enviroment variables before using a literal as the filename. * DD_DATAFILE * dd_DATAFILE * DATAFILE * and finally "DATAFILE" where DATAFILE is the **name** used in .. sourcecode:: cobolfree ASSIGN TO name and can be any valid COBOL identifier, or string leading to a valid operating system filename, and is not limited to *DATAFILE*. ... AT ... Controls position of ACCEPT and DISPLAY screen oriented verbs. .. sourcecode:: cobolfree *> Display at line 1, column 4 <* DISPLAY "Name:" AT 0104 END-DISPLAY *> Accept starting at line 1, column 10 for length of field <* ACCEPT name-var AT 0110 END-ACCEPT ......... ATTRIBUTE ......... Not yet implemented, but when it is, it will allow .. sourcecode:: cobolfree SET screen-name ATTRIBUTE BLINK OFF .... AUTO .... Automatic cursor flow to next field in screen section. ......... AUTO-SKIP ......... Alias for AUTO_ ......... AUTOMATIC ......... LOCK MODE IS AUTOMATIC. See MANUAL_ and EXCLUSIVE_ for more LOCK options. ............. AUTOTERMINATE ............. Alias for AUTO_ ..... B-AND ..... Not yet implemented BIT_ field operation. See `What STOCK CALL LIBRARY does OpenCOBOL offer?`_ **CBL_AND** for alternatives allowing bitwise operations. ..... B-NOT ..... Not yet implemented BIT_ field operation. See `What STOCK CALL LIBRARY does OpenCOBOL offer?`_ **CBL_NOT** for alternatives allowing bitwise operations. .... B-OR .... Not yet implemented BIT_ field operation. See `What STOCK CALL LIBRARY does OpenCOBOL offer?`_ **CBL_OR** for alternatives allowing bitwise operations. For example: .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 20110626 *> Purpose: Demonstrate alternative for B-OR *> Tectonics: cobc -x bits *> *************************************************************** identification division. program-id. bits. data division. working-storage section. 01 s1 pic 999 usage comp-5. 01 t2 pic 999 usage comp-5. 01 len pic 9. 01 result usage binary-long. *> *************************************************************** procedure division. move 2 to s1 move 4 to t2 move 1 to len *> CBL_OR takes source, target and length value 2 OR 4 is 6. ** call "CBL_OR" using s1 t2 by value len returning result end-call display s1 space t2 space len space result end-display goback. end program bits. giving:: $ cobc -x bits.cob $ ./bits 002 006 1 +0000000000 ..... B-XOR ..... Not yet implemented BIT_ field operation. See `What STOCK CALL LIBRARY does OpenCOBOL offer?`_ **CBL_XOR** for alternatives allowing bitwise operations. ................ BACKGROUND-COLOR ................ .. sourcecode:: cobolfree 05 BLANK SCREEN BACKGROUND-COLOR 7 FOREGROUND-COLOR 0. ..... BASED ..... .. sourcecode:: cobolfree 01 based-var PIC X(80) BASED. A sample posted by [human]_ .. sourcecode:: cobol OCOBOL*----------------------------------------------------------------- IDENTIFICATION DIVISION. PROGRAM-ID. 'MEMALL'. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. DECIMAL-POINT IS COMMA. INPUT-OUTPUT SECTION. FILE-CONTROL. DATA DIVISION. FILE SECTION. * WORKING-STORAGE SECTION. * 77 mychar pic x. 01 REC-TEST BASED. 03 REC-TEST-PART1 PIC X(5500000). 03 REC-TEST-PART2 PIC X(0100000). 03 REC-TEST-PART3 PIC X(1200000). 03 REC-TEST-PART4 PIC X(1200000). 03 REC-TEST-PART5 PIC X(1700000). *----------------------------------------------------------------- LINKAGE SECTION. *----------------------------------------------------------------- PROCEDURE DIVISION. declaratives. end declaratives. *----------------------------------------------------------------- main section. 00. FREE ADDRESS OF REC-TEST display 'MEMALL loaded and REC-TEST FREEd before ALLOCATE' accept mychar * IF ADDRESS OF REC-TEST = NULL display 'REC-TEST was not allocated before' ELSE display 'REC-TEST was allocated before' END-IF accept mychar * ALLOCATE REC-TEST move all '9' to REC-TEST display 'REC-TEST allocated and filled with ' REC-TEST (1:9) end-display accept mychar * IF ADDRESS OF REC-TEST = NULL display 'REC-TEST was not allocated before' ALLOCATE REC-TEST display 'REC-TEST allocated again, filled with ' REC-TEST (1:9) end-display ELSE display 'REC-TEST was allocated before' END-IF accept mychar * * FREE ADDRESS OF REC-TEST display 'REC-TEST FREEd' accept mychar * stop run * continue. ex. exit program. *----------------------------------------------------------------- *--- End of program MEMALL --------------------------------------- .. *><* .... BEEP .... Ring the terminal bell during DISPLAY_ output. Alias for BELL_ .. sourcecode:: cobolfree DISPLAY "Beeeeep" LINE 3 COLUMN 1 WITH BEEP END-DISPLAY. ...... BEFORE ...... Sets up a PERFORM_ loop to test the conditional BEFORE execution of the loop body. See AFTER_ for the alternative. BEFORE is the default. .. sourcecode:: cobolfree MOVE 1 TO counter PERFORM WITH TEST BEFORE UNTIL counter IS GREATER THAN OR EQUAL TO limiter CALL "subprogram" USING counter RETURNING result END-CALL MOVE result TO answers(counter) ADD 1 TO counter END-ADD END-PERFORM Also used with the WRITE verb. .. sourcecode:: cobolfree WRITE record-name BEFORE ADVANCING some-number LINES And to control how the INSPECT verb goes about its job. .. sourcecode:: cobolfree INSPECT character-var TALLYING the-count FOR ALL "tests" BEFORE "prefix" And not |currently| supported, in the declaratives for REPORT SECTION control. .. sourcecode:: cobolfree USE BEFORE REPORTING ... .... BELL .... Ring the terminal bell during DISPLAY_ output. Alias for BEEP_ .. sourcecode:: cobolfree DISPLAY "Beeeeep" LINE 3 COLUMN 1 WITH BELL END-DISPLAY. ...... BINARY ...... .. sourcecode:: cobolfree 01 result PIC S9(8) USAGE BINARY ............. BINARY-C-LONG ............. With OpenCOBOL's tight integration with the C Application Binary Interface the compiler authors have built in support that guarantees a native system C *long* value being the same bit size between COBOL and C modules. This increases coverage of the plethora of open C library functions that can be directly used with the CALL_ verb. Including cases where callback functions that require *long* stack parameters (that can't as easily be wrapped in thin C code layers) can now be used more effectively and safely. ........... BINARY-CHAR ........... Defines an 8 bit usage item. ............. BINARY-DOUBLE ............. Defines a 64 bit usage item. ........... BINARY-LONG ........... 32 bit native USAGE_ modifier. Equivalent to S9(8). ............ BINARY-SHORT ............ 16 bit native USAGE_. Equivalent to S9(5). ... BIT ... Not yet implemented. See `What STOCK CALL LIBRARY does OpenCOBOL offer?`_ for alternatives allowing bitwise operations. ..... BLANK ..... .. sourcecode:: cobolfree 05 BLANK SCREEN BACKGROUND-COLOR 7 FOREGROUND-COLOR 0. ..... BLINK ..... Aaaaaah, my eyes!! ..... BLOCK ..... .. sourcecode:: cobolfree FD file-name BLOCK CONTAINS 1 TO n RECORDS ....... BOOLEAN ....... As yet unsupported modifier. ...... BOTTOM ...... A LINAGE_ setting. .. sourcecode:: cobolfree FD mini-report linage is 16 lines with footing at 15 lines at top 2 lines at bottom 2. ... BY ... .. sourcecode:: cobolfree PERFORM the-procedure VARYING step-counter FROM 1 BY step-size UNTIL step-counter > counter-limit ........... BYTE-LENGTH ........... Human inscisors average about 16mm. More to the point, the BYTE-LENGTH returns the length, in bytes, of a data item. See `FUNCTION BYTE-LENGTH`_ .... CALL .... The OpenCOBOL CALL verb accepts literal or identifier stored names when resolving the transfer address. The USING phrase allows argument passing and OpenCOBOL includes internal rules for the data representation of the call stack entities that depend on the COBOL PICTURE_ and USAGE_ clauses. Return values are captured with RETURNING identifier. See `What STOCK CALL LIBRARY does OpenCOBOL offer?`_. For more information see http://www.opencobol.org/modules/bwiki/index.php?cmd=read&page=UserManual%2F2_3#content_1_0 CALL is the verb that opens up access to the plethora of C based ABI_ libraries. A **plethora**, *and the standard C library is accessible without explicit linkage* as a bonus. Below is a sample that allows fairly carefree use of CBL_OC_DUMP during development. .. sourcecode:: cobol OCOBOL*>>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 20110701 *> Purpose: Try C library formatted printing, and CALL exception *> Tectonics: cobc -x callon.cob *> or cobc -x callon.cob CBL_OC_DUMP.cob *> *************************************************************** identification division. program-id. callon. data division. working-storage section. 01 result usage binary-long. 01 pie usage float-short. 01 stuff pic x(12) value 'abcdefghijkl'. *> *************************************************************** procedure division. move 3.141592654 to pie *> Get a dump of the memory at pie, but don't stop if not linked call "CBL_OC_DUMP" using pie 4 on exception continue end-call *> Call C's printf, abort if not available call static "printf" using "float-short: %10.8f" & x"0a00" by value pie returning result end-call display pie space length of pie space result end-display *> Get a dump of the memory used by stuff, don't stop if no link call "CBL_OC_DUMP" using stuff 12 on exception continue end-call *> Get a dump of the memory used by stuff, abort if not linked <* call "CBL_OC_DUMP" using stuff 12 end-call goback. end program callon. See `What is CBL_OC_DUMP?` for details of the subprogram. A runtime session shows:: $ cobc -x callon.cob $ ./callon float-short: 3.14159274 3.1415927 4 +0000000024 libcob: Cannot find module 'CBL_OC_DUMP' $ cobc -x callon.cob CBL_OC_DUMP.cob $ ./callon Offset HEX-- -- -- -5 -- -- -- -- 10 -- -- -- -- 15 -- CHARS----1----5- 000000 db 0f 49 40 ..I@............ float-short: 3.14159274 3.1415927 4 +0000000024 Offset HEX-- -- -- -5 -- -- -- -- 10 -- -- -- -- 15 -- CHARS----1----5- 000000 61 62 63 64 65 66 67 68 69 6a 6b 6c abcdefghijkl.... Offset HEX-- -- -- -5 -- -- -- -- 10 -- -- -- -- 15 -- CHARS----1----5- 000000 61 62 63 64 65 66 67 68 69 6a 6b 6c abcdefghijkl.... So, the first CALL to CBL_OC_DUMP doesn't 'fail' as the ON EXCEPTION CONTINUE traps the condition and lets the program carry on without a dump displayed. The last CALL does abend the program with 'Cannot find module' when CBL_OC_DUMP is not compiled in. ...... CANCEL ...... Virtual cancel of a module is supported. Physical cancel support is on the development schedule. ... CD ... A control clause of the as yet unsupported COMMUNICATION_ DIVISION. ...... CENTER ...... An as yet unsupported keyword. ... CF ... Shortform for CONTROL FOOTING, a clause used in REPORT SECTION. ... CH ... Shortform for CONTROL HEADING, a clause used in PAGE descriptors in the REPORT SECTION. ..... CHAIN ..... Invokes a subprogram, with no return of control implied. The chained program unit virtually becomes the main program within the run unit. ........ CHAINING ........ Passes procedure division data through WORKING-STORAGE and can be used for shell command line arguments as well, as in CALL "myprog" USING string END-CALL. from opencobol.org_ by human_ .. sourcecode:: cobolfree WORKING-STORAGE SECTION. 01 cmd-argument. 02 some-text pic x(256). procedure division Chaining cmd-argument. display 'You wrote:' '>"' function trim(some-text) '"' 'from shell command line' end-display ......... CHARACTER ......... .. sourcecode:: cobolfree PADDING CHARACTER IS A soon to be obsolete feature. .......... CHARACTERS .......... A multi use keyword. Used in SPECIAL-NAMES_ .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 20101031 *> Purpose: Try out SYMBOLIC CHARACTERS *> Tectonics: cobc -x figurative.cob *> Rave: OpenCOBOL is stone cold cool *> *************************************************************** identification division. program-id. figurative. environment division. configuration section. special-names. symbolic characters TAB is 10 LF is 11 CMA is 45. data division. working-storage section. 01 a-comma pic x(1) value ",". 01 lots-of-commas pic x(20). *> *************************************************************** procedure division. display "thing" TAB "tabbed thing" LF "and" TAB "another tabbed thing" LF "other" CMA " things" end-display move a-comma to lots-of-commas display "MOVE a-comma : " lots-of-commas end-display move CMA to lots-of-commas display "MOVE symbolic: " lots-of-commas end-display goback. end program figurative. Output:: $ cobc -x figuratives.cob $ ./figuratives thing tabbed thing and another tabbed thing other, things MOVE a-comma : , MOVE symbolic: ,,,,,,,,,,,,,,,,,,,, Used in INSPECT_ .. sourcecode:: cobolfree INSPECT str TALLYING tal FOR CHARACTERS Used in a File Description FD_ .. sourcecode:: cobolfree FD file-name BLOCK CONTAINS integer-1 TO integer-2 CHARACTERS RECORD IS VARYING IN SIZE FROM integer-5 TO integer-6 CHARACTERS DEPENDING ON identifier-1. ..... CLASS ..... Used to create alphabets in SPECIAL-NAMES. .. sourcecode:: cobolfree ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. CLASS octals IS '0' THRU '7'. ... PROCEDURE DIVISION. IF user-value IS NOT octals DISPLAY "Sorry, not a valid octal number" END-DISPLAY ELSE DISPLAY user-value END-DISPLAY END-IF ........ CLASS-ID ........ An as yet unsupported Object COBOL class identifier clause. .............. CLASSIFICATION .............. An as yet unsupported source code internationalization clause. ..... CLOSE ..... Close an open file. OpenCOBOL will implicitly close all open resources at termination of a run unit and will display a warning message stating so, and the danger of potentially unsafe termination. .. sourcecode:: cobolfree CLOSE input-file .... CODE .... A syntactically recognized, but as yet unsupported clause of a report descriptor, RD_. ........ CODE-SET ........ An as yet unsupported data internationalization clause. ... COL ... Alias for COLUMNS_. ......... COLLATING ......... Allows definition within a program unit of a character set. .. sourcecode:: cobolfree OBJECT-COMPUTER. name. PROGRAM COLLATING SEQUENCE IS alphabet-1. .... COLS .... Alias for COLUMNS_. ...... COLUMN ...... A recognized but unsupported REPORT SECTION RD_ descriptor clause. Also used for positional DISPLAY and ACCEPT, which implicitly uses SCREEN SECTION style ncurses screen IO. .. sourcecode:: cobolfree DISPLAY var-1 LINE 1 COLUMN 23 END-DISPLAY ....... COLUMNS ....... A recognized but as yet unsupported RD_ clause. ..... COMMA ..... A SPECIAL-NAMES_ clause supporting commas in numeric values versus the default period decimal point. COBOL was way ahead of the internationization curve, *and this feature has caused compiler writers no little grief in its time, a challenge they rise to and deal with for the world's benefit*. .. sourcecode:: cobolfree DECIMAL POINT IS COMMA ............ COMMAND-LINE ............ Provides access to command line arguments. .. sourcecode:: cobolfree ACCEPT the-args FROM COMMAND-LINE END-ACCEPT ...... COMMIT ...... Flushes ALL current locks, synching file I/O buffers. OpenCOBOL supports safe transactional processing with ROLLBACK_ capabilities. *Assuming the ISAM handler configured when building the compiler can support LOCK_* ...... COMMON ...... .. sourcecode:: cobolfree PROGRAM-ID. CBL_OC_PROGRAM IS COMMON PROGRAM. Ensures a nested sub-program is also available to other nested sub-programs with a program unit heirarchy. ............. COMMUNICATION ............. |currently| unsupported DIVISION, but see `Does OpenCOBOL support Message Queues?`_ for an alternative. .... COMP .... See COMPUTATIONAL_ ...... COMP-1 ...... See COMPUTATIONAL-1_ ...... COMP-2 ...... See COMPUTATIONAL-2_ ...... COMP-3 ...... See COMPUTATIONAL-3_ ...... COMP-4 ...... See COMPUTATIONAL-4_ ...... COMP-5 ...... See COMPUTATIONAL-5_ ...... COMP-X ...... See COMPUTATIONAL-X_ ............. COMPUTATIONAL ............. Implementors choice; OpenCOBOL is a big-endian default. With most Intel personal computers and operating systems like GNU/Linux, COMPUTATIONAL-5_ will run faster. ............... COMPUTATIONAL-1 ............... Single precision float. Equivalent to FLOAT-SHORT_. ............... COMPUTATIONAL-2 ............... Double precision float. Equivalent to FLOAT-LONG_. ............... COMPUTATIONAL-3 ............... Equivalent to PACKED DECIMAL. Packed decimal is two digits per byte, always sign extended and influenced by a .conf setting *binary-size* COMPUTATIONAL-6_ is UNSIGNED PACKED. ............... COMPUTATIONAL-4 ............... Equivalent to BINARY. ............... COMPUTATIONAL-5 ............... Native form. ............... COMPUTATIONAL-6 ............... Unsigned packed decimal form, see COMPUTATIONAL-3_. ............... COMPUTATIONAL-X ............... Native form. ....... COMPUTE ....... Computational arithmetic. .. sourcecode:: cobolfree COMPUTE circular-area = radius ** 2 * FUNCTION PI END-COMPUTE OpenCOBOL supports the normal gamut of arithmetic expressions. - Add + - Subtract - - Multiply * - Divide / - Raise to power ** Order of precedence rules apply. #. unary minus, unary plus #. exponentiation #. multiplication, division #. addition, subtraction **Spaces and expressions** Due to COBOL allowing *dash* in user names, care must be taken to properly space arithmetic expressions. Some examples of seemingly ambiguous and potentially dangerous code .. sourcecode:: cobol OCOBOL*> *************************************************************** identification division. program-id. computing. data division. working-storage section. 01 answer pic s9(8). 01 var pic s9(8). *> *************************************************************** procedure division. compute answer = 3*var-1 end-compute goback. end program computing. That is NOT three times var *minus one*, OpenCOBOL will complain. .. sourcecode:: bash $ cobc -x computing.cob computing.cob:18: Error: 'var-1' is not defined whew, saved! .. sourcecode:: cobol OCOBOL*> *************************************************************** identification division. program-id. computing. data division. working-storage section. 01 answer pic s9(8). 01 var pic s9(8). 01 var-1 pic s9(8). *> *************************************************************** procedure division. compute answer = 3*var-1 end-compute goback. end program computing. With the above source, the compile will succeed. .. sourcecode:: bash $ cobc -x computing.cob OpenCOBOL will (properly, according to standard) compile this as **three times var-1**. Not saved, if you meant 3 times var minus 1. *OpenCOBOL programmers are strongly encouraged to use full spacing inside COMPUTE statements.* .. sourcecode:: cobol OCOBOL*> *************************************************************** identification division. program-id. computing. data division. working-storage section. 01 answer pic s9(8). 01 var pic s9(8). 01 var-1 pic s9(8). *> *************************************************************** procedure division. compute answer = 3 * var - 1 on size error display "Problem, call the ghost busters" end-display not on size error display "All good, answer is trustworthy" end-display end-compute goback. end program computing. COMPUTE supports ON SIZE ERROR, NOT ON SIZE ERROR imperatives for safety, and the ROUNDED modifier for bankers. ......... CONDITION ......... As yet unsupported USE AFTER EXCEPTION CONDITION clause. ............. CONFIGURATION ............. A SECTION_ of the ENVIRONMENT_ DIVISION. Holds paragraphs for - SOURCE-COMPUTER_ - OBJECT-COMPUTER_ - REPOSITORY_ - SPECIAL-NAMES_ ........ CONSTANT ........ An extension allowing constant definitions .. sourcecode:: cobolfree 01 enumerated-value CONSTANT AS 500. ........ CONTAINS ........ An FD_ clause: .. sourcecode:: cobolfree FD a-file RECORD CONTAINS 80 CHARACTERS. ....... CONTENT ....... A CALL_ clause that controls how arguments are passed and expected. .. sourcecode:: cobolfree CALL "subprog" USING BY CONTENT alpha-var. alpha-var will not be modifieable by subprog as a copy is passed. See REFERENCE_ and VALUE_ for the other supported CALL argument control. ........ CONTINUE ........ A placeholder, no operation verb. .. sourcecode:: cobolfree if action-flag = "C" or "R" or "U" or "D" continue else display "invalid action-code" end-display end-if ....... CONTROL ....... As yet unsupported REPORT SECTION clause for setting control break data fields. ........ CONTROLS ........ As yet unsupported REPORT SECTION clause for setting control break data fields. .......... CONVERTING .......... A clause of the INSPECT_ verb. .. sourcecode:: cobolfree INSPECT X CONVERTING "012345678" TO "999999999". .... COPY .... The COBOL include pre-processor verb. Also see REPLACE_ and `Does OpenCOBOL support COPY includes?`_. .... CORR .... Alias for CORRESPONDING_. ............. CORRESPONDING ............. Move any and all sub fields with matching names within records. .. sourcecode:: cobolfree 01 bin-record. 05 first-will usage binary-short. 05 second-will usage binary-long. 05 this-wont-move usage binary-long. 05 third-will usage binary-short. 01 num-record. 05 first-will pic 999. 05 second-will pic s9(9). 05 third-will pic 999. 05 this-doesnt-match pic s9(9). move corresponding bin-record to num-record display first-will in num-record second-will in num-record third-will in num-record end-display ..... COUNT ..... Sets the count of characters set in an UNSTRING_ substring. From the OpenCOBOL Programmer's Guide's UNSTRING entry. .. sourcecode:: cobolfree UNSTRING Input-Address DELIMITED BY "," OR "/" INTO Street-Address DELIMITER D1 COUNT C1 Apt-Number DELIMITER D2 COUNT C2 City DELIMITER D3 COUNT C3 State DELIMITER D4 COUNT C4 Zip-Code DELIMITER D5 COUNT C5 END-UNSTRING ... CRT ... .. sourcecode:: cobolfree SPECIAL-NAMES. CONSOLE IS CRT CRT STATUS is identifier-1. **CONSOLE IS CRT** allows "CRT" and "CONSOLE" to be used interchangeably on DISPLAY but this is a default for newer OpenCOBOL implementations. **CRT STATUS IS** establishes a PIC 9(4) field for screen ACCEPT status codes. There is also an implicit **COB-CRT-STATUS** register defined for all programs, that will be used if no explicit field is established. ........ CURRENCY ........ .. sourcecode:: cobolfree SPECIAL-NAMES. CURRENCY SIGN IS literal-1. Default currency sign is the dollar sign "$". ...... CURSOR ...... Tracks the line/column location of screen ACCEPT. .. sourcecode:: cobolfree SPECIAL-NAMES. CURSOR IS identifier-2. identifier-2 is to be declared as PIC 9(4) or 9(6). If 4, the field is LLCC. With 9(6) it is LLLCCC where L is line and C is column, zero relative. ..... CYCLE ..... A clause that causes EXIT PERFORM to return to the top of a loop. See FOREVER_ for an example. .... DATA .... A magical DIVISION_. One of COBOL's major strength is the rules surrounding the DATA DIVISION and pictorial record definitions. ............ DATA-POINTER ............ An as yet unsupported Object COBOL feature. .... DATE .... 6 digit and 8 digit (4 digit year) Gregorian dates. .. sourcecode:: cobolfree identification division. program-id. dates. data division. working-storage section. 01 date-2nd 03 date-yy pic 9(2). 03 date-mm pic 9(2). 03 date-dd pic 9(2). 01 date-3rd 03 date-yyyy pic 9(2). 03 date-mm pic 9(2). 03 date-dd pic 9(2). procedure division. accept date-2nd from date end-accept *> Just before the 3rd millennium, programmers admitted <* *> that 2 digit year storage was a bad idea and ambiguous <* accept date-3rd from date yyyymmdd end-accept display date-2nd space date-3rd end-display goback. end program dates. :: ./dates 110701 20110701 ... DAY ... Access the current date in Julian form. .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 2011182 (July 01) *> Purpose: Accept from day in Julian form *> Tectonics: cobc -x days.cob *> *************************************************************** identification division. program-id. days. data division. working-storage section. 01 julian-2nd. 03 julian-yy pic 9(2). 03 julian-days pic 9(3). 01 julian-3rd. 03 julian-yyyy pic 9(4). 03 julian-days pic 9(3). procedure division. accept julian-2nd from day end-accept *> Just before the 3rd millennium, programmers admitted <* *> that 2 digit year storage was a bad idea and ambiguous <* accept julian-3rd from day yyyyddd end-accept display julian-2nd space julian-3rd end-display goback. end program days. :: $ make days cobc -W -x days.cob -o days $ ./days 11182 2011182 ........... DAY-OF-WEEK ........... Single digit day of week. 1 for Monday, 7 for Sunday. .. sourcecode:: cobolfree accept the-day from day-of-week ... DE ... Report Writer shortcut for DETAIL. Recognized, but not yet implemented. This author found this type of shortcut very unCOBOL, until trying to layout a report, when it made a lot more practical sense *in FIXED form COBOL*. ......... DEBUGGING ......... A SOURCE-COMPUTER clause and DECLARATIVE phrase. .. sourcecode:: cobolfree ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER mine WITH DEBUGGING MODE. DEBUGGING MODE can also be toggled on with the *-fdebugging-line* cobc option, and will compile in 'D' lines. .. sourcecode:: cobolfree PROCEDURE DIVISION. DECLARATIVES. decl-debug section. USE FOR DEBUGGING ON ALL PROCEDURES decl-paragraph. DISPLAY "Why is this happening to me?" END-DISPLAY END DECLARATIVES. USE FOR DEBUGGING sets up a section that is executed when the named section is entered. Powerful. It can also name a file, and the debug section is evaluated after open, close, read, start etc. Identifiers can be also be named and the debug section will trigger when referenced (usually after). ............. DECIMAL-POINT ............. Allows internationization for number formatting. In particular .. sourcecode:: cobolfree IDENTIFICATION DIVISION. PROGRAM-ID. 'MEMALL'. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. DECIMAL-POINT IS COMMA. will cause OpenCOBOL to interpret numeric literals along the lines of 123,45 as one hundred twenty three and forty five one hundreths. DECIMAL-POINT IS COMMA, while world friendly, can be the cause of ambiguous parsing and care must be taken by developers that use comma to separate parameters to FUNCTIONs. ............ DECLARATIVES ............ An imperative entry that can control exception handling of file operations and turn on debug entry points. .. sourcecode:: cobolfree procedure division. declaratives. handle-errors section. use after standard error procedure on filename-1. handle-error. display "Something bad happened with " filename-1 end-display. . helpful-debug section. use for debugging on main-file. help-me. display "Just touched " main-file end-display. . end declaratives. ....... DEFAULT ....... A multi-use clause used in CALL ... SIZE IS DEFAULT ENTRY ... SIZE IS DEFAULT INITIALIZE ... WITH ... THEN TO DEFAULT ...... DELETE ...... Allows removal of records from RELATIVE and INDEXED files. .. sourcecode:: cobolfree DELETE filename-1 RECORD INVALID KEY DISPLAY "no delete" END-DISPLAY NOT INVALID KEY DISPLAY "record removed" END-DISPLAY END-DELETE ,,,,,, OC 2.0 ,,,,,, Allows file deletes. .. sourcecode:: cobolfree DELETE FILE filename-1 filename-2 filename-3 END-DELETE ......... DELIMITED ......... A fairly powerful keyword used with the STRING_ and UNSTRING_ verbs. Accepts literals and the BY SIZE_ modifier. .. sourcecode:: cobolfree STRING null-terminated DELIMITED BY LOW-VALUE INTO no-zero END-STRING ......... DELIMITER ......... Tracks which delimiter was used for a substring in an UNSTRING_ operation. From Gary's OCic.cbl .. sourcecode:: cobolfree UNSTRING Expand-Code-Rec DELIMITED BY ". " OR " " INTO SPI-Current-Token DELIMITER IN Delim WITH POINTER Src-Ptr END-UNSTRING ......... DEPENDING ......... Sets a control identifier for variable OCCURS. .. sourcecode:: cobolfree 01 TABLE-DATA. 05 TABLE-ELEMENTS OCCURS 1 TO 100 TIMES DEPENDING ON crowd-size INDEXED BY cursor-var. 10 field-1 PIC X. .......... DESCENDING .......... Controls a descending key sort order. ........... DESTINATION ........... Currently unsupported data descriptor. Part of VALIDATE. ...... DETAIL ...... A recognized but currently unsupported report descriptor detail line control clause. ....... DISABLE ....... An unsupported COMMUNICATION SECTION control verb. .... DISK .... A SELECT devicename phrase. .. sourcecode:: cobolfree ASSIGN TO DISK USING dataname Alternative spelling of **DISC** is allowed. ....... DISPLAY ....... Prints values to standard out, sets enviroment variables .. sourcecode:: cobolfree DISPLAY "First value: " a-variable " and another string" END-DISPLAY ...... DIVIDE ...... Highly precise arthimetic. .. sourcecode:: cobolfree DIVIDE dividend BY divisor GIVING answer ROUNDED REMAINDER r The 20xx draft standard requires conforming implementations to use 1,000 digits of precision for intermediate results. There will be no rounding errors when properly calculating financials in a COBOL program. ........ DIVISION ........ Ahh, sub-divisions. I think my favourite is the DATA DIVISION. It gives COBOL a distinctive and delicious flavour in a picturesque codescape. OpenCOBOL is flexible enough to compile files with only a PROCEDURE DIVISION, and even then it really only needs a PROGRAM-ID. See `What is the shortest OpenCOBOL program?`_ for an example. .... DOWN .... Allows decrement of an index control or pointer variable. .. sourcecode:: cobolfree SET ind-1 DOWN BY 2 Also used for SCREEN SECTION scroll control. .. sourcecode:: cobolfree SCROLL DOWN 5 LINES .......... DUPLICATES .......... Allows duplicate keys in indexed files. .. sourcecode:: cobolfree SELECT filename ALTERNATE RECORD KEY IS altkey WITH DUPLICATES Also for SORT control. .. sourcecode:: cobolfree SORT filename ON DESCENDING KEY keyfield WITH DUPLICATES IN ORDER USING sort-in GIVING sort-out. ....... DYNAMIC ....... A file access mode allowing runtime control over SEQUENTIAL and RANDOM access for INDEXED and RELATIVE ORGANIZATION. .. sourcecode:: cobolfree SELECT filename ORGANIZATION IS RELATIVE ACCESS MODE IS DYNAMIC ...... EBCDIC ...... Extended Binary Coded Decimal Interchange Code. A character encoding common to mainframe systems, therefore COBOL, therefore OpenCOBOL. Different than ASCII_ and OpenCOBOL supports both through efficient mappings. See http://en.wikipedia.org/wiki/EBCDIC for more info. ASCII to EBCDIC conversion the OpenCOBOL way .. sourcecode:: cobolfree SPECIAL-NAMES. ALPHABET ALPHA IS NATIVE. ALPHABET BETA IS EBCDIC. PROCEDURE DIVISION. INSPECT variable CONVERTING ALPHA TO BETA ... EC ... An unsupported shortform for USE AFTER EXCEPTION CONDITION ... EGI ... An unsupported COMMUNICATION SECTION word. .... ELSE .... Alternate conditional branch point. .. sourcecode:: cobolfree IF AGE IS ZERO DISPLAY "Cigar time" END-DISPLAY ELSE DISPLAY "What is it with kids anyway?" END-DISPLAY END-IF For multi branch conditionals, see EVALUATE_. ... EMI ... An unsupported COMMUNICATION SECTION word. ...... ENABLE ...... An unsupported COMMUNICATION SECTION control verb. ... END ... Ends things. Programs, declaratives, functions. .......... END-ACCEPT .......... Explicit terminator for ACCEPT_. ....... END-ADD ....... Explicit terminator for ADD_. ........ END-CALL ........ Explicit terminator for CALL_. ........... END-COMPUTE ........... Explicit terminator for COMPUTE_. .......... END-DELETE .......... Explicit terminator for DELETE_. ........... END-DISPLAY ........... Explicit terminator for DISPLAY_. .......... END-DIVIDE .......... Explicit terminator for DIVIDE_. ............ END-EVALUATE ............ Explicit terminator for EVALUATE_. ...... END-IF ...... Explicit terminator for IF_. ............ END-MULTIPLY ............ Explicit terminator for MULTIPLY_. ........... END-OF-PAGE ........... A LINAGE_ phrase used by WRITE_ controlling end of page imperative clause. ........... END-PERFORM ........... Explicit terminator for PERFORM_. ........ END-READ ........ Explicit terminator for READ_. ........... END-RECEIVE ........... Explicit terminator for RECEIVE_. .......... END-RETURN .......... Explicit terminator for RETURN_. ........... END-REWRITE ........... Explicit terminator for REWRITE_. .......... END-SEARCH .......... Explicit terminator for SEARCH_. ......... END-START ......... Explicit terminator for START_. .......... END-STRING .......... Explicit terminator for STRING_. ............ END-SUBTRACT ............ Explicit terminator for SUBTRACT_. ............ END-UNSTRING ............ Explicit terminator for UNSTRING_. ......... END-WRITE ......... Explicit terminator for WRITE_. ..... ENTRY ..... Always for CALL entry points without being fully specified sub-programs. Great for defining callbacks required by many GUI frameworks. See `Does OpenCOBOL support the GIMP ToolKit, GTK+?`_ for an example. ................ ENTRY-CONVENTION ................ An as yet unsupported clause. ........... ENVIRONMENT ........... Divisional name. And allows access to operating system environment variables. OpenCOBOL supports - CONFIGURATION_ SECTION - INPUT-OUTPUT_ SECTION within the ENVIROMENT DIVISION. Also a context sensitive keyword for access to the process environment variables. - SET ENVIRONMENT "env-var" TO value - ACCEPT var FROM ENVIRONMENT "env-var" END-ACCEPT ................ ENVIRONMENT-NAME ................ Provides access to the running process environment variables. ................. ENVIRONMENT-VALUE ................. Provides access to the running process environment variables. ... EO ... An unsupported shortform for USE AFTER EXCEPTION OBJECT ... EOL ... ERASE_ to End Of Line. ... EOP ... LINAGE_ clause shortform for END-OF-PAGE_. ... EOS ... ERASE_ to End Of Screen. ..... EQUAL ..... Conditional expression to compare two data items for equality. ...... EQUALS ...... Conditional expression to compare two data items for equality. ..... ERASE ..... A screen section data attribute clause that can control which portions of the screen are cleared during DISPLAY_, and ACCEPT_. .. sourcecode:: cobolfree 01 form-record. 02 first-field PIC xxx USING identifier-1 ERASE EOL. ..... ERROR ..... A DECLARATIVES_ clause that can control error handling. .. sourcecode:: cobolfree USE AFTER STANDARD ERROR PROCEDURE ON filename-1 Program return control. .. sourcecode:: cobolfree STOP RUN WITH ERROR STATUS stat-var. ...... ESCAPE ...... Programmer access to escape key value during ACCEPT_. .. sourcecode:: cobolfree ACCEPT identifier FROM ESCAPE KEY END-ACCEPT Data type is 9(4). ... ESI ... Unsupported COMMUNICATION SECTION control. ........ EVALUATE ........ A very powerful and concise selection construct. .. sourcecode:: cobolfree EVALUATE a ALSO b ALSO TRUE WHEN 1 ALSO 1 THRU 9 ALSO c EQUAL 1 PERFORM all-life WHEN 2 ALSO 1 THRU 9 ALSO c EQUAL 2 PERFORM life WHEN 3 THRU 9 ALSO 1 ALSO c EQUAL 9 PERFORM disability WHEN OTHER PERFORM invalid END-EVALUATE ......... EXCEPTION ......... Allow detection of CALL problem. .. sourcecode:: cobolfree CALL "CBL_OC_DUMP" ON EXCEPTION CONTINUE END-CALL ................ EXCEPTION-OBJECT ................ Unsupport object COBOL data item reference. ......... EXCLUSIVE ......... Mode control for file locks. .... EXIT .... OpenCOBOL supports - EXIT - EXIT PROGRAM_ - EXIT PERFORM_ [CYCLE_] - EXIT SECTION_ - EXIT PARAGRAPH_ Controls flow of the program. EXIT PERFORM CYCLE causes an inline perform to return control to the VARYING_, UNTIL_ or TIMES_ clause, testing the conditional to see if another cycle is required. EXIT PERFORM without the CYCLE option causes flow to continue passed the end of the current PERFORM loop. ....... EXPANDS ....... Unsupported COMMUNICATION SECTION control. ...... EXTEND ...... Open a resource in an append mode. ........ EXTERNAL ........ Clause to specify external data item, file connection and program unit. .. sourcecode:: cobolfree 77 shared-var PIC S9(4) IS EXTERNAL AS 'shared_var'. ....... FACTORY ....... An unsupported object COBOL keyword. ..... FALSE ..... Logical false and conditional set condition. .. sourcecode:: cobolfree 01 record-1 pic 9. 88 conditional-1 values 1,2,3 when set to false is 0. set conditional-1 to true display record-1 end-display set conditional-1 to false display record-1 end-display if conditional-1 display "BAD" end-display end-if Runs as:: $ ./conditionals 1 0 ... FD ... The record side of the COBOL file system. The File Descriptor. .. sourcecode:: cobolfree FD filename-sample RECORD IS VARYING IN SIZE FROM 1 TO 32768 CHARACTERS DEPENDING ON record-size-sample. .... FILE .... Files. .. sourcecode:: cobolfree USE AFTER EXCEPTION FILE filename-maybe ............ FILE-CONTROL ............ Files. The paragraph in the INPUT-OUTPUT_ section, in the ENVIRONMENT_ division. It's verbose, a little voodooey, and worth it. .. sourcecode:: cobolfree ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. select optional data-file assign to file-name organization is line sequential file status is data-file-status. select mini-report assign to "mini-report". ....... FILE-ID ....... Files. .. sourcecode:: cobolfree VALUE OF FILE-ID IS file-ids in summary-array ...... FILLER ...... Filler. This page intentionally filled with filler. ..... FINAL ..... Final. A recognized but currently not supported Report Writer feature. ..... FIRST ..... First. A recognized but currently not supported Report Writer feature. .............. FLOAT-EXTENDED .............. OpenCOBOL recognizes but does not yet support FLOAT-EXTENDED and will abend a compile. .......... FLOAT-LONG .......... OpenCOBOL supports floating point long. .. sourcecode:: cobolfree identification division. program-id. threes. data division. working-storage section. 01 fshort usage float-short. 01 flong usage float-long. 01 fpic pic 9v9(35). procedure division. compute fshort = 1 / 3 end-compute display "as short " fshort end-display compute flong = 1 / 3 end-compute display "as long " flong end-display compute fpic = 1 / 6 end-compute display "as pic " fpic end-display compute fpic rounded = 1 / 6 end-compute display "rounded " fpic end-display goback. end program threes. displays:: $ ./threes as short 0.333333343267440796 as long 0.333333333333333315 as pic 0.16666666666666666666666666666666666 rounded 0.16666666666666666666666666666666667 ........... FLOAT-SHORT ........... OpenCOBOL supports short floating point. ....... FOOTING ....... A well supported LINAGE_ clause. ... FOR ... Recognized but unsupported Report Writer clause. ................ FOREGROUND-COLOR ................ Screen section foreground color control. See `What are the OpenCOBOL SCREEN SECTION colour values?`_ ....... FOREVER ....... Provides for infinite loops. Use EXIT PERFORM or EXIT PERFORM CYCLE to control program flow. .. sourcecode:: cobolfree identification division. program-id. foreverloop. data division. working-storage section. 01 cobol pic 9 value 0. 01 c pic 9 value 1. 01 fortran pic 9 value 2. procedure division. perform forever add 1 to cobol display "cobol at " cobol end-display if cobol greater than fortran exit perform end-if if cobol greater than c exit perform cycle end-if display "cobol still creeping up on c" end-display end-perform display "cobol surpassed c and fortran" end-display goback. end program foreverloop. Which produces:: $ cobc -free -x foreverloop.cob $ ./foreverloop cobol at 1 cobol still creeping up on c cobol at 2 cobol at 3 cobol surpassed c and fortran I asked on opencobol.org for some input, and an interesting conversation ensued. I've included the forum thread archive, nearly in its entirety, to give a sense of various programmer styles and group thought processing. See `Performing FOREVER?`_. ...... FORMAT ...... Source format directive. .. sourcecode:: cobol 123456 >>SOURCE FORMAT IS FIXED .... FREE .... Properly cleans up ALLOCATE_ alloted memory, and source format directive. .. sourcecode:: cobolfree >>SOURCE FORMAT IS FREE 01 var PIC X(1024) BASED. ALLOCATE var CALL "buffer-thing" USING BY REFERENCE var END-CALL MOVE var TO working-store FREE var .... FROM .... .. sourcecode:: cobolfree ACCEPT var FROM ENVIRONMENT "path" ON EXCEPTION DISPLAY "No path" END-DISPLAY NOT ON EXCEPTION DISPLAY var END-DISPLAY END-ACCEPT .... FULL .... A screen section screen item control operator, requesting the normal terminator be ignored until the field is completely full or completely empty. ........ FUNCTION ........ Allows use of the many OpenCOBOL supported intrinsic functions. .. sourcecode:: cobolfree DISPLAY FUNCTION TRIM(" trim off leading spaces" LEADING) END-DISPLAY. See `Does OpenCOBOL implement any Intrinsic FUNCTIONs?`_ for details. ........... FUNCTION-ID ........... Not yet implemented, but it will allow for user defined FUNCTION. ........ GENERATE ........ Not yet implemented beyond simple parsing REPORT writer feature. ... GET ... Unsupported. ...... GIVING ...... Destination control for computations, and return value clause. .. sourcecode:: cobolfree ADD 1 TO cobol GIVING OpenCOBOL. ...... GLOBAL ...... A global name is accessible to all contained programs. ... GO ... GO TO is your friend. Edsger was wrong. Transfer control to a named paragraph or section. See ALTER_ for details of monster goto power. ...... GOBACK ...... A return. This will work correctly for all cases. A return to the operating system or a return to a called program. .. sourcecode:: cobolfree GOBACK. ....... GREATER ....... COBOL conditional expression, IF A GREATER THAN B, See LESS_ ..... GROUP ..... Recognized but unsupported Report Writer clauses. ........... GROUP-USAGE ........... An unsupported BIT_ clause. ....... HEADING ....... Recognized but unsupported Report Writer clauses. .......... HIGH-VALUE .......... A figurative ALPHABETIC_ constant, being the highest character value in the COLLATING_ sequence. It's invalid to MOVE_ HIGH-VALUE to a NUMERIC_ field. ........... HIGH-VALUES ........... Plural of HIGH-VALUE_. ......... HIGHLIGHT ......... Screen control for field intensity. ... I-O ... An OPEN_ mode allowing for both read and write. ........... I-O-CONTROL ........... A paragraph in the INPUT-OUTPUT_ section, allowing sharing memory areas for different files. .. sourcecode:: cobolfree ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. I-O-CONTROL. SAME RECORD AREA FOR filename-1 filename-2. ... ID ... Shortform for IDENTIFICATION_. .............. IDENTIFICATION .............. The initial division for OpenCOBOL programs. .. sourcecode:: cobolfree IDENTIFICATION DIVISION. PROGRAM-ID. sample. Many historical paragraphs from the IDENTIFICATION DIVISION have been deemed obsolete. OpenCOBOL will treat these as comment paragraphs. Including * AUTHOR * DATE-WRITTEN * DATE-MODIFIED * DATE-COMPILED * INSTALLATION * REMARKS * SECURITY ... IF ... Conditional branching. In COBOL, conditionals are quite powerful and there are many conditional expressions allowed with concise shortcuts. .. sourcecode:: cobolfree IF A = 1 OR 2 MOVE 1 TO B END-IF ........ IGNORING ........ .. sourcecode:: cobolfree READ filename-1 INTO identifer-1 IGNORING LOCK END-READ .......... IMPLEMENTS .......... Unsupported Object COBOL expression. ... IN ... A data structure reference and name conflict resolution qualifier. .. sourcecode:: cobolfree MOVE "abc" TO field IN the-record IN the-structure Synonym for OF_ ..... INDEX ..... .. sourcecode:: cobolfree 01 cursor-var USAGE INDEX. SET cursor-var UP BY 1. ....... INDEXED ....... An ISAM file organization. .. sourcecode:: cobolfree environment division. input-output section. file-control. select optional indexing assign to "indexing.dat" organization is indexed access mode is dynamic record key is keyfield of indexing-record alternate record key is splitkey of indexing-record with duplicates . Sets an indexing control identifier for OCCURS data arrays. .. sourcecode:: cobolfree 01 TABLE-DATA. 05 TABLE-ELEMENTS OCCURS 1 TO 100 TIMES DEPENDING ON crowd-size INDEXED BY cursor-var. 10 field-1 PIC X. ........ INDICATE ........ GROUP INDICATE is an as yet unsupported REPORT SECTION RD_ clause that specifies that printable item is ouput only on the first occurrence of its report group for that INITIATE, control break, or page advance. ........ INHERITS ........ An unsupported Object COBOL clause. ....... INITIAL ....... A modifier for the PROGRAM-ID_ clause, that causes the entire DATA DIVISION to be set to an initial state each time the subprogram is executed by CALL. .. sourcecode:: cobol ocobol >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 20111226 *> Purpose: Small sample of INITIAL procedure division clause *> Tectonics: cobc -x -w -g -debug initialclause.cob *> *************************************************************** identification division. program-id. initialclause. *> -*********-*********-*********-*********-*********-*********-** procedure division. call "with-initial" end-call call "without-initial" end-call call "with-initial" end-call call "without-initial" end-call call "without-initial" end-call goback. end program initialclause. *> -*********-*********-*********-*********-*********-*********-** *> -*********-*********-*********-*********-*********-*********-** identification division. program-id. with-initial is initial. data division. working-storage section. 01 the-value pic 99 value 42. *> -*********-*********-*********-*********-*********-*********-** procedure division. display "Inside with-initial with : " the-value end-display multiply the-value by 2 giving the-value on size error display "size overflow" end-display end-multiply goback. end program with-initial. *> -*********-*********-*********-*********-*********-*********-** *> -*********-*********-*********-*********-*********-*********-** identification division. program-id. without-initial. data division. working-storage section. 01 the-value pic 99 value 42. *> -*********-*********-*********-*********-*********-*********-** procedure division. display "Inside without-initial with: " the-value end-display multiply the-value by 2 giving the-value on size error display "size overflow" end-display end-multiply goback. end program without-initial. Gives:: [btiffin@home cobol]$ ./initialclause Inside with-initial with : 42 Inside without-initial with: 42 Inside with-initial with : 42 Inside without-initial with: 84 size overflow Inside without-initial with: 84 size overflow INITIAL sets the-value to 42 upon each and every entry, without-initial multiplies through 42, 84, 168 (or would have). .......... INITIALIZE .......... A sample of the INITIALIZE verb posted `opencobol.org`_ by `human`_ .. sourcecode:: cobol OCOBOL*----------------------------------------------------------------- IDENTIFICATION DIVISION. PROGRAM-ID. 'INITTEST'. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. DECIMAL-POINT IS COMMA. INPUT-OUTPUT SECTION. DATA DIVISION. * WORKING-STORAGE SECTION. * 77 mychar pic x. 77 mynumeric pic 9. 01 REC-TEST BASED. 03 REC-TEST-PART1 PIC X(10) value all '9'. 03 REC-TEST-PART2 PIC X(10) value all 'A'. 01 fillertest. 03 fillertest-1 PIC 9(10) value 2222222222. 03 filler PIC X value '|'. 03 fillertest-2 PIC X(10) value all 'A'. 03 filler PIC 9(03) value 111. 03 filler PIC X value '.'. *----------------------------------------------------------------- LINKAGE SECTION. *----------------------------------------------------------------- PROCEDURE DIVISION. *----------------------------------------------------------------- Main section. 00. * display 'fillertest ' 'on start:' end-display display fillertest end-display accept mychar * initialize fillertest display 'fillertest ' 'after initialize:' end-display display fillertest end-display accept mychar * initialize fillertest replacing numeric by 9 display 'fillertest ' 'after initialize replacing numeric by 9:' end-display display fillertest end-display accept mychar * initialize fillertest replacing alphanumeric by 'X' display 'fillertest ' 'after initialize replacing alphanumeric by "X":' end-display display fillertest end-display accept mychar * initialize fillertest replacing alphanumeric by all 'X' display 'fillertest ' 'after initialize replacing alphanumeric by all "X":' end-display display fillertest end-display accept mychar * initialize fillertest with filler display 'fillertest ' 'after initialize with filler:' end-display display fillertest end-display accept mychar * initialize fillertest all to value display 'fillertest ' 'after initialize all to value:' end-display display fillertest end-display accept mychar * ALLOCATE REC-TEST display 'REC-TEST after allocating:' end-display display REC-TEST end-display accept mychar * initialize REC-TEST all to value display 'REC-TEST after initalize all to value:' end-display display REC-TEST end-display accept mychar * stop run * continue. ex. exit program. *----------------------------------------------------------------- *--- End of program INITTEST ------------------------------------- .. *><* Outputs:: fillertest on start: 2222222222|AAAAAAAAAA111. fillertest after initialize: 0000000000| 111. fillertest after initialize replacing numeric by 9: 0000000009| 111. fillertest after initialize replacing alphanumeric by "X": 0000000009|X 111. fillertest after initialize replacing alphanumeric by all "X": 0000000009|XXXXXXXXXX111. fillertest after initialize with filler: 0000000000 000 fillertest after initialize all to value: 2222222222|AAAAAAAAAA111. REC-TEST after allocating: REC-TEST after initalize all to value: 9999999999AAAAAAAAAA ........... INITIALIZED ........... A modifier for the ALLOCATE_ verb, filling the target with a default value. .. sourcecode:: cobolfree 77 based-var PIC X(9) BASED VALUE "ALLOCATED". 77 pointer-var USAGE POINTER. ALLOCATE based-var DISPLAY ":" based-var ":" END-DISPLAY FREE based-var ALLOCATE based-var INITIALIZED RETURNING pointer-var DISPLAY ":" based-var ":" END-DISPLAY displays:: : : :ALLOCATED: ........ INITIATE ........ Initialize internal storage for named REPORT SECTION entries. Not |currently| supported. ..... INPUT ..... A mode of the OPEN_ verb for file access. .. sourcecode:: cobolfree OPEN INPUT file A SORT_ clause allowing programmer controlled input read passes where sortable records are passed to the sort algorithm using RELEASE_. .. sourcecode:: cobolfree procedure division. sort sort-work on descending key work-rec collating sequence is mixed input procedure is sort-transform output procedure is output-uppercase. display sort-return end-display. goback. ............ INPUT-OUTPUT ............ A section in the ENVIRONMENT DIVISION of a COBOL source file containing FILE and I-O control paragraphs. .. sourcecode:: cobolfree environment division. input-output section. file-control. select htmlfile assign to filename organization is record sequential. OpenCOBOL supports - FILE-CONTROL_ - I-O-CONTROL_ paragraphs within the INPUT-OUTPUT SECTION. ....... INSPECT ....... Provides very powerful parsing and replacement to COBOL and OpenCOBOL supports the full gamet of options. .. sourcecode:: cobol ocobol identification division. program-id. inspecting. data division. working-storage section. 01 ORIGINAL pic XXXX/XX/XXBXX/XX/XXXXXXX/XX. 01 DATEREC pic XXXX/XX/XXBXX/XX/XXXXXXX/XX. procedure division. move function when-compiled to DATEREC ORIGINAL INSPECT DATEREC REPLACING ALL "/" BY ":" AFTER INITIAL SPACE display "Intrinsic function WHEN-COMPILED " ORIGINAL end-display display " after INSPECT REPLACING " DATEREC end-display goback. end program inspecting. Example output:: Intrinsic function WHEN-COMPILED 2010/03/25 23/05/0900-04/00 after INSPECT REPLACING 2010/03/25 23:05:0900-04:00 ......... INTERFACE ......... Unsupported. ............ INTERFACE-ID ............ An unsupported Object COBOL clause in the IDENTIFICATION_ division. .... INTO .... Division. DIVIDE A INTO B GIVING C. ......... INTRINSIC ......... Used in REPOSITORY to allow the optional use of "FUNCTION" keyword. .. sourcecode:: cobolfree environment division. configuration section. repository. function all intrinsic. The source unit will now allow for program lines such as .. sourcecode:: cobolfree move trim(" abc") to dest move function trim(" abc") to dest to compile the same code. ....... INVALID ....... Key exception imperative phrase. .. sourcecode:: cobolfree READ filename-1 INVALID KEY DISPLAY "Bad key" NOT INVALID KEY DISPLAY "Good read" END-READ ...... INVOKE ...... Unsupported Object COBOL method call. ... IS ... Readability word. A IS LESS THAN B is equivalent to A LESS B. .... JUST .... Alias for JUSTIFIED_. ......... JUSTIFIED ......... Tweaks storage rules in wierd JUST_ ways, lessening the voodoo behind MOVE_ instructions, *he said, sarcastically*. .. sourcecode:: cobolfree 77 str1 pic x(40) justified right. ... KEY ... Multi use, always means key:: RELATIVE KEY IS ALTERNATE RECORD KEY IS NOT INVALID KEY SORT filename ON DESCENDING KEY keyfield START indexing KEY IS LESS THAN keyfield ........ KEYBOARD ........ A special value for Standard Input .. sourcecode:: cobolfree file-control. select cgi-in assign to keyboard. ..... LABEL ..... A record label. As with most record labels, falling into disuse. .... LAST .... Used in START to prepare a read of the last record. A recognized but unsupported Report Writer clause. .. sourcecode:: cobolfree START filename-1 LAST INVALID KEY MOVE ZERO TO record-count >>D DISPLAY "No last record for " filename-1 END-DISPLAY END-START ...... LC_ALL ...... A reserved but unsupported category group. See `Setting Locale`_. OpenCOBOL is 'locale' aware, but it is currently more *external* than in COBOL source. For now, it is safest to assume **LC_ALL=C**, but this can be configured differently when OpenCOBOL is built. .......... LC_COLLATE .......... A reserved but unsupported category name. Will be used with SET. ........ LC_CTYPE ........ A reserved but unsupported Locale category name. Will be used with SET. ........... LC_MESSAGES ........... A reserved but unsupported category name. See `Setting Locale`_. OpenCOBOL is 'locale' aware, but it is currently more *external* than in COBOL source. .. sourcecode:: bash $ export LC_MESSAGES=es_ES $ cobc -x fdfgffd.cob cobc: fdfgffd.cob: No existe el fichero o el directorio ........... LC_MONETARY ........... A reserved but unsupported Locale category name. Will be used with SET. .......... LC_NUMERIC .......... A reserved but unsupported Locale category name. Will be used with SET. ....... LC_TIME ....... A reserved but unsupported Locale category name. Will be used with SET. ....... LEADING ....... Multipurpose. .. sourcecode:: cobolfree DISPLAY FUNCTION TRIM(var-1 LEADING) END-DISPLAY INSPECT FUNCTION REVERSE(TEST-CASE) TALLYING B-COUNT FOR LEADING ' '. DISPLAY B-COUNT. INSPECT X REPLACING LEADING ZEROS BY SPACES. as well as use in the COBOL preprocessor: .. sourcecode:: cobolfree COPY "copy.inc" REPLACING LEADING ==TEST== BY ==FIRST== LEADING ==NORM== BY ==SECOND==. .... LEFT .... SYNCHRONIZED_ control. ...... LENGTH ...... A 'cell-count' length. Not always the same as BYTE-LENGTH_. .... LESS .... A comparison operation. .. sourcecode:: cobolfree IF requested LESS THAN OR EQUAL TO balance PERFORM transfer ELSE PERFORM reject END-IF ..... LIMIT ..... Recognized but unsupported Report Writer clause. ...... LIMITS ...... Recognized but unsupported Report Writer clause. ...... LINAGE ...... LINAGE is a *SPECIAL-REGISTER* supported by OpenCOBOL. A counter is maintained for file WRITE_ and can be used for pageing *and other* control. .. sourcecode:: cobol COBOL ***************************************************************** * Example of LINAGE File Descriptor * Author: Brian Tiffin * Date: 10-July-2008 * Tectonics: $ cocb -x linage.cob * $ ./linage * $ cat -n mini-report ***************************************************************** IDENTIFICATION DIVISION. PROGRAM-ID. linage-demo. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. select optional data-file assign to file-name organization is line sequential file status is data-file-status. select mini-report assign to "mini-report". DATA DIVISION. FILE SECTION. FD data-file. 01 data-record. 88 endofdata value high-values. 02 data-line pic x(80). FD mini-report linage is 16 lines with footing at 15 lines at top 2 lines at bottom 2. 01 report-line pic x(80). WORKING-STORAGE SECTION. 01 command-arguments pic x(1024). 01 file-name pic x(160). 01 data-file-status pic 99. 01 lc pic 99. 01 report-line-blank. 02 filler pic x(18) value all "*". 02 filler pic x(05) value spaces. 02 filler pic x(34) VALUE "THIS PAGE INTENTIONALLY LEFT BLANK". 02 filler pic x(05) value spaces. 02 filler pic x(18) value all "*". 01 report-line-data. 02 body-tag pic 9(6). 02 line-3 pic x(74). 01 report-line-header. 02 filler pic x(6) VALUE "PAGE: ". 02 page-no pic 9999. 02 filler pic x(24). 02 filler pic x(5) VALUE " LC: ". 02 header-tag pic 9(6). 02 filler pic x(23). 02 filler pic x(6) VALUE "DATE: ". 02 page-date pic x(6). 01 page-count pic 9999. PROCEDURE DIVISION. accept command-arguments from command-line end-accept. string command-arguments delimited by space into file-name end-string. if file-name equal spaces move "linage.cob" to file-name end-if. open input data-file. read data-file at end display "File: " function trim(file-name) " open error" end-display go to early-exit end-read. open output mini-report. write report-line from report-line-blank end-write. move 1 to page-count. accept page-date from date end-accept. move page-count to page-no. write report-line from report-line-header after advancing page end-write. perform readwrite-loop until endofdata. display "Normal termination, file name: " function trim(file-name) " ending status: " data-file-status end-display. close mini-report. * Goto considered harmful? Bah! :) early-exit. close data-file. exit program. stop run. **************************************************************** readwrite-loop. move data-record to report-line-data move linage-counter to body-tag write report-line from report-line-data end-of-page add 1 to page-count end-add move page-count to page-no move linage-counter to header-tag write report-line from report-line-header after advancing page end-write end-write read data-file at end set endofdata to true end-read . ***************************************************************** * Commentary * LINAGE is set at a 20 line logical page * 16 body lines * 2 top lines * A footer line at 15 (inside the body count) * 2 bottom lines * Build with: * $ cobc -x -Wall -Wtruncate linage.cob * Evaluate with: * $ ./linage * This will read in linage.cob and produce a useless mini-report * $ cat -n mini-report ***************************************************************** END PROGRAM linage-demo. Using .. sourcecode:: bash $ ./linage except.cob Produces a *mini-report* of:: ****************** THIS PAGE INTENTIONALLY LEFT BLANK ****************** PAGE: 0001 LC: 000000 DATE: 090206 000001 IDENTIFICATION DIVISION. 000002 PROGRAM-ID. MINIPROG. 000003 ENVIRONMENT DIVISION. 000004 CONFIGURATION SECTION. 000005 SOURCE-COMPUTER. LINUX. 000006 OBJECT-COMPUTER. LINUX. 000007 SPECIAL-NAMES. 000008 INPUT-OUTPUT SECTION. 000009 FILE-CONTROL. 000010 SELECT PRINTFILE ASSIGN TO "XXRXWXX" 000011 FILE STATUS RXWSTAT. 000012 DATA DIVISION. 000013 FILE SECTION. 000014 FD PRINTFILE. PAGE: 0002 LC: 000015 DATE: 090206 000001 01 PRINTREC PIC X(132). 000002 WORKING-STORAGE SECTION. 000003 01 RXWSTAT PIC XX. 000004 01 str pic x(4). 000005 PROCEDURE DIVISION. 000006 A00-MAIN SECTION. 000007 001-MAIN-PROCEDURE. 000008 OPEN INPUT PRINTFILE. 000009 DISPLAY "File Status: " RXWSTAT. 000010 DISPLAY "EXCEPTION-FILE: " FUNCTION EXCEPTION-FILE. 000011 DISPLAY "Return Length: " 000012 FUNCTION LENGTH (FUNCTION EXCEPTION-FILE). 000013 DISPLAY "EXCEPTION-STATUS: " FUNCTION EXCEPTION-STATUS. 000014 DISPLAY "EXCEPTION-STATEMENT: " FUNCTION EXCEPTION-STATEMENT. PAGE: 0003 LC: 000015 DATE: 090206 000001 STRING "TOOLONG" DELIMITED SIZE INTO RXWSTAT. 000002 DISPLAY "EXCEPTION-STATUS: " FUNCTION EXCEPTION-STATUS. 000003 DISPLAY "EXCEPTION-STATEMENT: " FUNCTION EXCEPTION-STATEMENT. 000004 DISPLAY "EXCEPTION-LOCATION: " FUNCTION EXCEPTION-LOCATION. 000005 STOP RUN. See *except.cob* under the `FUNCTION EXCEPTION-STATUS`_ entry. .............. LINAGE-COUNTER .............. An internal OpenCOBOL noun, or *Special Register*. Value is readonly and is maintained during WRITEs to files that have a LINAGE_ clause. Useful for quick reports and logical page layouts. .... LINE .... LINE SEQUENTIAL_ files. Screen section line control. ............ LINE-COUNTER ............ Special register for the unsupported Report Writer. ..... LINES ..... Screen section line control, screen occurs control and area scrolling. ....... LINKAGE ....... A SECTION_ in the DATA_ DIVISION. Used for call frame data handling when the current run unit may not be in charge of the location of working storage. Defaults to uninitialized references which must be set with USING_ in a CALL or explicitly with SET ADDRESS. References without initialization will cause an addressing segfault. ............. LOCAL-STORAGE ............. A SECTION_ in the DATA_ DIVISION. Data defined in local storage will be local to the running module and re-entrant within subprogram call trees. ...... LOCALE ...... A SPECIAL-NAMES_ entry giving OpenCOBOL an international flair. .. sourcecode:: cobolfree ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. LOCALE spanish IS 'ES_es'. .... LOCK .... Record management. .. sourcecode:: cobolfree SELECT filename-1 ASSIGN TO 'master.dat' LOCK MODE IS MANUAL. ......... LOW-VALUE ......... A figurative ALPHABETIC_ constant, being the lowest character value in the COLLATING_ sequence. .. sourcecode:: cobolfree MOVE LOW-VALUE TO alphanumeric-1. IF alphabetic-1 EQUALS LOW-VALUE DISPLAY "Failed validation" END-DISPLAY END-IF. It's invalid to MOVE_ LOW-VALUE to a numeric field. .......... LOW-VALUES .......... A pluralized form of LOW-VALUE_. Equivalent. .. sourcecode:: cobolfree MOVE LOW-VALUES TO alphanumeric-1. ........ LOWLIGHT ........ A screen attribute for DISPLAY and SCREEN SECTION fields. .. sourcecode:: cobolfree SCREEN SECTION. 01 example. 05 FILLER LINE 1 COLUMN 10 VALUE IS "Example:" LOWLIGHT. Will display the *Example:* legend in a dimmed video if supported with the current terminal settings. ...... MANUAL ...... LOCK MODE IS MANUAL WITH LOCK ON MULTIPLE RECORDS. See AUTOMATIC_ and EXCLUSIVE_ for more LOCK options. ...... MEMORY ...... An OBJECT-COMPUTER clause. .. sourcecode:: cobolfree ENVIRONMENT DIVISION. CONFIGURATION SECTION. OBJECT-COMPUTER. MEMORY SIZE IS 8 CHARACTERS. ..... MERGE ..... Combines two or more identically sequenced files on a set of specified keys. .. sourcecode:: cobolfree MERGE sort-file ON DESCENDING KEY key-field-1 WITH DUPLICATES IN ORDER COLLATING SEQUENCE IS user-alphabet USING filename-1 filename-2 GIVING filename-3 ....... MESSAGE ....... Unsupported Communication Section clause. ...... METHOD ...... Unsupported Object COBOL feature. ......... METHOD-ID ......... Unsupported Object COBOL feature. ..... MINUS ..... Screen section relative line and column control. .. sourcecode:: cobolfree 05 some-field pic x(16) line number is plus 1 column number is minus 8 .... MODE .... Locking mode. See MANUAL_, AUTOMATIC_, EXCLUSIVE_. .... MOVE .... A workhorse of the COBOL paradigm. MOVE is highly flexible, intelligent, safe and sometimes perplexing data movement verb. .. sourcecode:: cobolfree 01 alphanum-3 PIC XXX. 01 num2 PIC 99. MOVE "ABCDEFG" TO xvar3 DISPLAY xvar3 END-DISPLAY MOVE 12345 TO num2 DISPLAY num2 END-DISPLAY displays:: ABC 45 Note the 45, MOVE uses a right to left rule when moving numerics. Groups can be moved with .. sourcecode:: cobolfree MOVE CORRESPONDING ident-1 TO ident-2 in which case only the group items of the same name will be transferred from the ident-1 group to the ident-2 fields. ........ MULTIPLE ........ .. sourcecode:: cobolfree LOCK MODE IS MANUAL WITH LOCK ON MULTIPLE RECORDS. ........ MULTIPLY ........ A mathematic operation. .. sourcecode:: cobolfree MULTIPLY var-1 BY var-2 GIVING var-3 ON SIZE ERROR SET invalid-result TO TRUE END-MULTIPLY ........ NATIONAL ........ NATIONAL character usage. Not yet supported. OpenCOBOL does support PICTURE N. ............... NATIONAL-EDITED ............... Category. ...... NATIVE ...... Alphabet. ........ NEGATIVE ........ Conditional expression. .. sourcecode:: cobolfree IF a IS NEGATIVE SET in-the-red TO TRUE END-IF ...... NESTED ...... An unsupported program-protoype CALL clause. .... NEXT .... With READ_, to read the next record, possibly by KEY_. Also an obsolete control flow verb. .. sourcecode:: cobolfree READ index-sequential-file NEXT RECORD INTO ident-1 IF condition-1 NEXT SENTENCE ELSE PERFORM do-something. ... NO ... Specify NO locks, NO sharing, NO rewind. .. sourcecode:: cobolfree CLOSE filename-1 WITH NO REWIND READ file-1 WITH NO LOCK .... NONE .... Unsupported DEFAULT_ IS NONE. ...... NORMAL ...... Program return control .. sourcecode:: cobolfree STOP RUN WITH NORMAL STATUS status-val See ERROR_ ... NOT ... Conditional negation. See AND_, OR_. Also used in operational declaratives such as NOT ON SIZE ERROR, *in which case the operation succeeded without overflowing the receiving data field*. .. sourcecode:: cobolfree IF NOT testing CALL "thing" NOT ON EXCEPTION DISPLAY "Linkage to thing, OK" END-DISPLAY END-CALL END-IF .... NULL .... Void. A zero address pointer. A symbolic literal. .. sourcecode:: cobolfree CALL "thing" RETURNING NULL END-CALL SET ADDRESS OF ptr TO NULL IF ptr EQUAL NULL DISPLAY "ptr not valid" END-DISPLAY END-IF MOVE CONCATENATE(TRIM(cbl-string TRAILING) NULL) TO c-string ..... NULLS ..... Plural of NULL_. .. sourcecode:: cobolfree MOVE ALL NULLS TO var ...... NUMBER ...... Screen section LINE_ COLUMN_ control. .. sourcecode:: cobolfree 05 some-field pic x(16) LINE NUMBER 5. ....... NUMBERS ....... Plural of NUMBER_. ....... NUMERIC ....... Category. .............. NUMERIC-EDITED .............. Category. ...... OBJECT ...... Unsupported Object COBOL feature. ............... OBJECT-COMPUTER ............... Environment division, configuration section run-time machine paragraph. OpenCOBOL supports .. sourcecode:: cobol OCOBOL identification division. program-id. runtime-computer. environment division. configuration section. object-computer. memory size is 8 characters program collating sequence is bigiron-alphabet segment-limit is 64 character classificiation is spanish-locale. repository. function all intrinsic. special-names. alphabet bigiron-alphabet is ebcdic symbolic characters BS is 9 TAB is 10 LF is 11 NEWLINE is 11 CMA is 45 locale spanish-locale is "es_ES". ................ OBJECT-REFERENCE ................ Unsupported Object COBOL feature. ...... OCCURS ...... Controls multiple occurances of data structures. .. sourcecode:: cobolfree 01 main-table. 03 main-record occurs 366 times depending on the-day. 05 main-field pic x occurs 132 times depending on the-len. ... OF ... A data structure reference and name conflict resolution qualifier. .. sourcecode:: cobolfree MOVE "abc" TO the-field OF the-record OF the-structure Synonym for IN_ ... OFF ... Turn off a switch. See ON_. .. sourcecode:: cobolfree SPECIAL-NAMES. SWITCH-1 IS mainframe ON STATUS IS bigiron OFF STATUS IS pc ... SET mainframe TO OFF ....... OMITTED ....... Allows for placeholders in call frames and testing for said placeholders. Also allows for omitted label records, and void returns. OMITTED is only allowed with BY REFERENCE_ data. .. sourcecode:: cobolfree CALL "thing" USING BY REFERENCE string-var BY VALUE number-var BY REFERENCE OMITTED GIVING NULL END-CALL ... PROGRAM-ID. thing. DATA DIVISION. WORKING-STORAGE SECTION. 77 default-float usage float-long. LINKAGE-SECTION. 77 string-var pic x(80). 77 number-var pic 9(8). 77 float-var usage float-long. PROCEDURE DIVISION USING BY REFERENCE OPTIONAL string-var BY VALUE number-var BY REFERENCE OPTIONAL float-var RETURNING OMITTED. IF float-var IS OMITTED SET ADDRESS OF float-var TO default-float END-IF ... ON ... Turn on a switch. See OFF_. .. sourcecode:: cobolfree SPECIAL-NAMES. SWITCH-1 IS mainframe ON STATUS IS bigiron OFF STATUS IS pc ... SET mainframe TO ON Starts declaratives. .. sourcecode:: cobolfree ADD 1 TO wafer-thin-mint ON SIZE ERROR SET get-a-bucket TO TRUE END-ADD See SIZE_, EXCEPTION_. .... ONLY .... Sharing control. SHARING WITH READ ONLY .... OPEN .... Opens a file selector. Modes include INPUT_, OUTPUT_, I-O_, EXTEND_. May be OPTIONAL_ in the FD_. .. sourcecode:: cobolfree OPEN INPUT SHARING WITH ALL OTHER infile OPEN EXTEND SHARING WITH NO OTHER myfile ........ OPTIONAL ........ Allows for referencing non-existent files. Allows for optionally OMITTED_ call arguments. Code below shows optional file open and optional CALL arguments. .. sourcecode:: cobolfree ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT OPTIONAL nofile ASSIGN TO "file.not" ORGANIZATION IS LINE SEQUENTIAL. ... DATA DIVISION. LINKAGE SECTION. 77 arg PIC 99. PROCEDURE DIVISION USING OPTIONAL arg OPEN INPUT nofile CLOSE nofile IF arg IS OMITTED OR NOT NUMERIC MOVE 0 TO RETURN-CODE ELSE MOVE arg TO RETURN-CODE END-IF GOBACK. ....... OPTIONS ....... A currently unsupported paragraph of the IDENTIFICATION_ division. ... OR ... Logical operation. See AND_, NOT_. OpenCOBOL supports COBOL's logical expression shortcuts. Order of precedence can be controlled with parenthesis, and default to NOT, AND, OR, right to left. .. sourcecode:: cobolfree IF A NOT EQUAL 1 OR 2 OR 3 OR 5 DISPLAY "FORE!" END-DISPLAY END-IF ..... ORDER ..... Sort clause to influence how duplicates are managed. .. sourcecode:: cobolfree sort sort-work ascending key work-rec with duplicates in order using sort-in giving sort-out. In 1.1pre-rel, WITH DUPLICATES IN ORDER is a default. ............ ORGANIZATION ............ Defines a file's storage organization. One of INDEXED_, RELATIVE_, SEQUENTIAL_. OpenCOBOL also supports a `LINE SEQUENTIAL`_ structure. ..... OTHER ..... File sharing option, ALL OTHER, NO OTHER. EVALUATE_'s else clause. .. sourcecode:: cobol OCOBOL*> Here be dragons <* EVALUATE TRUE WHEN a IS 1 PERFORM paragraph-1 WHEN OTHER ALTER paragraph-1 TO paragraph-2 PERFORM paragraph-3 END-EVALUATE ...... OUTPUT ...... File OPEN_ mode. Procedure named in SORT_ .. sourcecode:: cobolfree sort sort-work on descending key work-rec collating sequence is mixed input procedure is sort-transform output procedure is output-uppercase. ........ OVERFLOW ........ Declarative clause for STRING_ and UNSTRING_ that will trigger on space overflow conditions. ........ OVERLINE ........ A display control for SCREEN_ section fields. ........ OVERRIDE ........ Unsupportd Object COBOL METHOD-ID clause. .............. PACKED-DECIMAL .............. Numeric USAGE_ clause, equivalent to COMPUTATIONAL-3_. Holds each digit in a 4-bit field. From the opencobol-2.0 tarball testsuite .. sourcecode:: cobol OCOBOL IDENTIFICATION DIVISION. PROGRAM-ID. prog. DATA DIVISION. WORKING-STORAGE SECTION. 01 G-1. 02 X-1 PIC 9(1) VALUE 1 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-2. 02 X-2 PIC 9(2) VALUE 12 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-3. 02 X-3 PIC 9(3) VALUE 123 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-4. 02 X-4 PIC 9(4) VALUE 1234 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-5. 02 X-5 PIC 9(5) VALUE 12345 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-6. 02 X-6 PIC 9(6) VALUE 123456 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-7. 02 X-7 PIC 9(7) VALUE 1234567 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-8. 02 X-8 PIC 9(8) VALUE 12345678 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-9. 02 X-9 PIC 9(9) VALUE 123456789 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-10. 02 X-10 PIC 9(10) VALUE 1234567890 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-11. 02 X-11 PIC 9(11) VALUE 12345678901 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-12. 02 X-12 PIC 9(12) VALUE 123456789012 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-13. 02 X-13 PIC 9(13) VALUE 1234567890123 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-14. 02 X-14 PIC 9(14) VALUE 12345678901234 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-15. 02 X-15 PIC 9(15) VALUE 123456789012345 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-16. 02 X-16 PIC 9(16) VALUE 1234567890123456 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-17. 02 X-17 PIC 9(17) VALUE 12345678901234567 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-18. 02 X-18 PIC 9(18) VALUE 123456789012345678 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S1. 02 X-S1 PIC S9(1) VALUE -1 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S2. 02 X-S2 PIC S9(2) VALUE -12 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S3. 02 X-S3 PIC S9(3) VALUE -123 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S4. 02 X-S4 PIC S9(4) VALUE -1234 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S5. 02 X-S5 PIC S9(5) VALUE -12345 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S6. 02 X-S6 PIC S9(6) VALUE -123456 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S7. 02 X-S7 PIC S9(7) VALUE -1234567 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S8. 02 X-S8 PIC S9(8) VALUE -12345678 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S9. 02 X-S9 PIC S9(9) VALUE -123456789 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S10. 02 X-S10 PIC S9(10) VALUE -1234567890 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S11. 02 X-S11 PIC S9(11) VALUE -12345678901 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S12. 02 X-S12 PIC S9(12) VALUE -123456789012 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S13. 02 X-S13 PIC S9(13) VALUE -1234567890123 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S14. 02 X-S14 PIC S9(14) VALUE -12345678901234 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S15. 02 X-S15 PIC S9(15) VALUE -123456789012345 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S16. 02 X-S16 PIC S9(16) VALUE -1234567890123456 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S17. 02 X-S17 PIC S9(17) VALUE -12345678901234567 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. 01 G-S18. 02 X-S18 PIC S9(18) VALUE -123456789012345678 PACKED-DECIMAL. 02 FILLER PIC X(18) VALUE SPACE. PROCEDURE DIVISION. *> Dump all values <* CALL "dump" USING G-1 END-CALL. CALL "dump" USING G-2 END-CALL. CALL "dump" USING G-3 END-CALL. CALL "dump" USING G-4 END-CALL. CALL "dump" USING G-5 END-CALL. CALL "dump" USING G-6 END-CALL. CALL "dump" USING G-7 END-CALL. CALL "dump" USING G-8 END-CALL. CALL "dump" USING G-9 END-CALL. CALL "dump" USING G-10 END-CALL. CALL "dump" USING G-11 END-CALL. CALL "dump" USING G-12 END-CALL. CALL "dump" USING G-13 END-CALL. CALL "dump" USING G-14 END-CALL. CALL "dump" USING G-15 END-CALL. CALL "dump" USING G-16 END-CALL. CALL "dump" USING G-17 END-CALL. CALL "dump" USING G-18 END-CALL. CALL "dump" USING G-S1 END-CALL. CALL "dump" USING G-S2 END-CALL. CALL "dump" USING G-S3 END-CALL. CALL "dump" USING G-S4 END-CALL. CALL "dump" USING G-S5 END-CALL. CALL "dump" USING G-S6 END-CALL. CALL "dump" USING G-S7 END-CALL. CALL "dump" USING G-S8 END-CALL. CALL "dump" USING G-S9 END-CALL. CALL "dump" USING G-S10 END-CALL. CALL "dump" USING G-S11 END-CALL. CALL "dump" USING G-S12 END-CALL. CALL "dump" USING G-S13 END-CALL. CALL "dump" USING G-S14 END-CALL. CALL "dump" USING G-S15 END-CALL. CALL "dump" USING G-S16 END-CALL. CALL "dump" USING G-S17 END-CALL. CALL "dump" USING G-S18 END-CALL. INITIALIZE X-1. CALL "dump" USING G-1 END-CALL. INITIALIZE X-2. CALL "dump" USING G-2 END-CALL. INITIALIZE X-3. CALL "dump" USING G-3 END-CALL. INITIALIZE X-4. CALL "dump" USING G-4 END-CALL. INITIALIZE X-5. CALL "dump" USING G-5 END-CALL. INITIALIZE X-6. CALL "dump" USING G-6 END-CALL. INITIALIZE X-7. CALL "dump" USING G-7 END-CALL. INITIALIZE X-8. CALL "dump" USING G-8 END-CALL. INITIALIZE X-9. CALL "dump" USING G-9 END-CALL. INITIALIZE X-10. CALL "dump" USING G-10 END-CALL. INITIALIZE X-11. CALL "dump" USING G-11 END-CALL. INITIALIZE X-12. CALL "dump" USING G-12 END-CALL. INITIALIZE X-13. CALL "dump" USING G-13 END-CALL. INITIALIZE X-14. CALL "dump" USING G-14 END-CALL. INITIALIZE X-15. CALL "dump" USING G-15 END-CALL. INITIALIZE X-16. CALL "dump" USING G-16 END-CALL. INITIALIZE X-17. CALL "dump" USING G-17 END-CALL. INITIALIZE X-18. CALL "dump" USING G-18 END-CALL. INITIALIZE X-S1. CALL "dump" USING G-S1 END-CALL. INITIALIZE X-S2. CALL "dump" USING G-S2 END-CALL. INITIALIZE X-S3. CALL "dump" USING G-S3 END-CALL. INITIALIZE X-S4. CALL "dump" USING G-S4 END-CALL. INITIALIZE X-S5. CALL "dump" USING G-S5 END-CALL. INITIALIZE X-S6. CALL "dump" USING G-S6 END-CALL. INITIALIZE X-S7. CALL "dump" USING G-S7 END-CALL. INITIALIZE X-S8. CALL "dump" USING G-S8 END-CALL. INITIALIZE X-S9. CALL "dump" USING G-S9 END-CALL. INITIALIZE X-S10. CALL "dump" USING G-S10 END-CALL. INITIALIZE X-S11. CALL "dump" USING G-S11 END-CALL. INITIALIZE X-S12. CALL "dump" USING G-S12 END-CALL. INITIALIZE X-S13. CALL "dump" USING G-S13 END-CALL. INITIALIZE X-S14. CALL "dump" USING G-S14 END-CALL. INITIALIZE X-S15. CALL "dump" USING G-S15 END-CALL. INITIALIZE X-S16. CALL "dump" USING G-S16 END-CALL. INITIALIZE X-S17. CALL "dump" USING G-S17 END-CALL. INITIALIZE X-S18. CALL "dump" USING G-S18 END-CALL. MOVE ZERO TO X-1. CALL "dump" USING G-1 END-CALL. MOVE ZERO TO X-2. CALL "dump" USING G-2 END-CALL. MOVE ZERO TO X-3. CALL "dump" USING G-3 END-CALL. MOVE ZERO TO X-4. CALL "dump" USING G-4 END-CALL. MOVE ZERO TO X-5. CALL "dump" USING G-5 END-CALL. MOVE ZERO TO X-6. CALL "dump" USING G-6 END-CALL. MOVE ZERO TO X-7. CALL "dump" USING G-7 END-CALL. MOVE ZERO TO X-8. CALL "dump" USING G-8 END-CALL. MOVE ZERO TO X-9. CALL "dump" USING G-9 END-CALL. MOVE ZERO TO X-10. CALL "dump" USING G-10 END-CALL. MOVE ZERO TO X-11. CALL "dump" USING G-11 END-CALL. MOVE ZERO TO X-12. CALL "dump" USING G-12 END-CALL. MOVE ZERO TO X-13. CALL "dump" USING G-13 END-CALL. MOVE ZERO TO X-14. CALL "dump" USING G-14 END-CALL. MOVE ZERO TO X-15. CALL "dump" USING G-15 END-CALL. MOVE ZERO TO X-16. CALL "dump" USING G-16 END-CALL. MOVE ZERO TO X-17. CALL "dump" USING G-17 END-CALL. MOVE ZERO TO X-18. CALL "dump" USING G-18 END-CALL. MOVE ZERO TO X-S1. CALL "dump" USING G-S1 END-CALL. MOVE ZERO TO X-S2. CALL "dump" USING G-S2 END-CALL. MOVE ZERO TO X-S3. CALL "dump" USING G-S3 END-CALL. MOVE ZERO TO X-S4. CALL "dump" USING G-S4 END-CALL. MOVE ZERO TO X-S5. CALL "dump" USING G-S5 END-CALL. MOVE ZERO TO X-S6. CALL "dump" USING G-S6 END-CALL. MOVE ZERO TO X-S7. CALL "dump" USING G-S7 END-CALL. MOVE ZERO TO X-S8. CALL "dump" USING G-S8 END-CALL. MOVE ZERO TO X-S9. CALL "dump" USING G-S9 END-CALL. MOVE ZERO TO X-S10. CALL "dump" USING G-S10 END-CALL. MOVE ZERO TO X-S11. CALL "dump" USING G-S11 END-CALL. MOVE ZERO TO X-S12. CALL "dump" USING G-S12 END-CALL. MOVE ZERO TO X-S13. CALL "dump" USING G-S13 END-CALL. MOVE ZERO TO X-S14. CALL "dump" USING G-S14 END-CALL. MOVE ZERO TO X-S15. CALL "dump" USING G-S15 END-CALL. MOVE ZERO TO X-S16. CALL "dump" USING G-S16 END-CALL. MOVE ZERO TO X-S17. CALL "dump" USING G-S17 END-CALL. MOVE ZERO TO X-S18. CALL "dump" USING G-S18 END-CALL. STOP RUN. With a support file to dump the first 10 bytes of each record .. sourcecode:: c #include #ifdef __INTEL_COMPILER #pragma warning ( disable : 1419 ) #endif int dump (unsigned char *data); int dump (unsigned char *data) { int i; for (i = 0; i < 10; i++) printf ("%02x", data[i]); puts (""); return 0; } /**/ Which captures:: 1f202020202020202020 012f2020202020202020 123f2020202020202020 01234f20202020202020 12345f20202020202020 0123456f202020202020 1234567f202020202020 012345678f2020202020 123456789f2020202020 01234567890f20202020 12345678901f20202020 0123456789012f202020 1234567890123f202020 012345678901234f2020 123456789012345f2020 01234567890123456f20 12345678901234567f20 0123456789012345678f 1d202020202020202020 012d2020202020202020 123d2020202020202020 01234d20202020202020 12345d20202020202020 0123456d202020202020 1234567d202020202020 012345678d2020202020 123456789d2020202020 01234567890d20202020 12345678901d20202020 0123456789012d202020 1234567890123d202020 012345678901234d2020 123456789012345d2020 01234567890123456d20 12345678901234567d20 0123456789012345678d 0f202020202020202020 000f2020202020202020 000f2020202020202020 00000f20202020202020 00000f20202020202020 0000000f202020202020 0000000f202020202020 000000000f2020202020 000000000f2020202020 00000000000f20202020 00000000000f20202020 0000000000000f202020 0000000000000f202020 000000000000000f2020 000000000000000f2020 00000000000000000f20 00000000000000000f20 0000000000000000000f 0c202020202020202020 000c2020202020202020 000c2020202020202020 00000c20202020202020 00000c20202020202020 0000000c202020202020 0000000c202020202020 000000000c2020202020 000000000c2020202020 00000000000c20202020 00000000000c20202020 0000000000000c202020 0000000000000c202020 000000000000000c2020 000000000000000c2020 00000000000000000c20 00000000000000000c20 0000000000000000000c 0f202020202020202020 000f2020202020202020 000f2020202020202020 00000f20202020202020 00000f20202020202020 0000000f202020202020 0000000f202020202020 000000000f2020202020 000000000f2020202020 00000000000f20202020 00000000000f20202020 0000000000000f202020 0000000000000f202020 000000000000000f2020 000000000000000f2020 00000000000000000f20 00000000000000000f20 0000000000000000000f 0c202020202020202020 000c2020202020202020 000c2020202020202020 00000c20202020202020 00000c20202020202020 0000000c202020202020 0000000c202020202020 000000000c2020202020 000000000c2020202020 00000000000c20202020 00000000000c20202020 0000000000000c202020 0000000000000c202020 000000000000000c2020 000000000000000c2020 00000000000000000c20 00000000000000000c20 0000000000000000000c ....... PADDING ....... Defines a character to use for short record padding. .. sourcecode:: cobolfree ORGANIZATION IS LINE SEQUENTIAL PADDING CHARACTER IS '*' .... PAGE .... Write and Report writer clause. .. sourcecode:: cobolfree WRITE theline AFTER ADVANCING PAGE PAGE LIMITS ARE 66 LINES 132 COLUMNS HEADING iS 4 FIRST DETAIL IS 6 LAST CONTROL HEADING IS 58 LAST DETAIL IS 60 FOOTING IS 62 ............ PAGE-COUNTER ............ A special register, qualified by Report Name. Report Writer is recognized but not yet supported. ......... PARAGRAPH ......... An allowable EXIT_ point. .. sourcecode:: cobolfree NAMED-PARAGRAPH. PERFORM FOREVER IF solution EXIT PARAGRAPH END-IF PERFORM solve-the-puzzle. END-PERFORM. ....... PERFORM ....... A COBOL procedural and inline control flow verb. .. sourcecode:: cobolfree beginning. PERFORM FOREVER PERFORM miracles END-PERFORM GOBACK. miracles. DISPLAY wonders END-DISPLAY. ... PF ... Report Writer alias for PAGE_ FOOTING_. ... PH ... Report Writer alias for PAGE_ HEADING_. ... PIC ... A commonly used shortform of PICTURE_. ....... PICTURE ....... The PICTURE clause is easily one of COBOL's greatest strengths. Fully detailed pictorial data definitions. The internal complexity is left to compiler authors, while developers and management are free to describe data at a very high conceptual level. The two most common picture characters are 9 and X, for numeric and alphanumeric data respectively. For alphbetic data, A can be used. Aside from data storage pictures, a vast array of *edit* pictures are allowed for control of input and output formatting. +, -, A, B, N, X, Z, "*", 'CR', 'DB', E, S, V, ., P, `currency symbol`_ OpenCOBOL offers full standards support of all alpha, alphanumeric and numeric storage specifiers as well as full support for edit and numeric-edit clauses. An example of some of the PICTURE options .. sourcecode:: cobolfree *>>source format is free *> ******************************************************************** *> Author: jrls (John Ellis) *> Date: Oct-2008 *> Purpose: formated output examples using pic strings. *> ******************************************************************** identification division. program-id. picstring. data division. working-storage section. *><* 01 header. 05 filler pic xxx value "ln". 05 filler pic x(11) value " disp1". 05 filler pic x(11) value " disp2". 05 filler pic x(11) value " disp3". 05 filler pic x(11) value " disp4". 05 filler pic x(12) value " disp5". 05 filler pic x(9) value " an1". 05 filler pic x(14) value " phone". 05 filler pic x(10) value " date". *><* 01 headerLines pic x(90) value all "-". *><* 01 displayformats. 05 linenum pic 99 value 1. 05 disp1 pic zzz,zz9.99 value zero. 05 filler pic x value spaces. 05 disp2 pic $zz,zz9.99 value zero. 05 filler pic x value spaces. 05 disp3 pic ---,--9.99 value zero. 05 filler pic x value spaces. 05 disp4 pic $-z,zz9.99 value zero. 05 filler pic x value spaces. 05 disp5 pic -zz,zz9.zz- blank zero value zero. 05 filler pic x value spaces. *><*an1 is actually a string field because of the embedded blanks, thus you put value spaces. 05 an1 pic 99b99b99 value spaces. 05 filler pic x value spaces. 05 phone pic bxxxbxxxbxxxx value spaces. 05 filler pic x value spaces. 05 dispdate pic 99/99/9999 value zero. *><* procedure division. 0000-start. *><* display headerLines. display header. display headerLines. *><**************************************************** move 220.22 to disp1, disp2. move -220.22 to disp3, disp4, disp5. inspect disp5 replacing first "-" by "(", first "-" by ")". move 10122008 to dispdate. *><**************************************************** *><*Please note the results of moving 'abcd' to an1. *><*an1 will show up as 00 00 00 because alpha data was *><*moved into instead of numeric data. *><* *><*The phone field will display " abc def ghij" because *><*'b' in the pic string. *><**************************************************** move "abcd" to an1. move "abcdefghij" to phone. display displayformats. add 1 to linenum. move zero to disp4, disp5. *><**************************************************** *><*Here after moving data to an1 and phone, I use the *><*inspect statement to replace the blanks. *><**************************************************** move "123456" to an1. move "5555551234" to phone. inspect an1 replacing all " " by "-". inspect phone replacing first " " by "(", first " " by ")", first " " by "-". display displayformats. inspect phone converting "23456789" to "adgjmptw". display phone. perform 0010-endProgram. *><* 0010-endProgram. stop run. *><* Outputs:: ------------------------------------------------------------------------------------------ ln disp1 disp2 disp3 disp4 disp5 an1 phone date ------------------------------------------------------------------------------------------ 01 220.22 $220.22 -220.22 $-220.22 (220.22) 00 00 00 abc def ghij 10/12/2008 02 220.22 $220.22 -220.22 $ 0.00 12-34-56 (555)555-1234 10/12/2008 (jjj)jjj-1adg .... PLUS .... Screen section relative line / column control during layout. .. sourcecode:: cobolfree 01 form-1 AUTO. 05 LINE 01 COLUMN 01 VALUE "Form!". 05 LINE PLUS 3 COLUMN 01 VALUE value-4. ....... POINTER ....... Allocates a restricted use variable for holding addresses. .. sourcecode:: cobolfree 01 c-handle USAGE IS POINTER. CALL "open-lib" RETURNING c-handle ON EXCEPTION DISPLAY "Can't link open-lib" END-DISPLAY STOP RUN RETURNING 1 END-CALL IF c-handle EQUAL NULL DISPLAY "Can't open-lib" END-DISPLAY STOP RUN RETURNING 1 END-IF CALL "use-lib" USING BY VALUE c-handle BY CONTENT "Hello" & x"00" CALL "close-lib" USING BY VALUE c-handle *> Interfacing with the C ABI is just a teenie-weenie bit of voodoo *> Pass the REFERENCE or use RETURNING if C sets the value. Use *> VALUE when you want C to have its pointer, not the *> REFERENCE address of the COBOL POINTER. So most inits are *> BY REFERENCE (or RETURNING) and most usage, including *> rundown of C ABI tools, is USING BY VALUE. *> <* ........ POSITION ........ Alias for COLUMN_ in screen section layouts. Also an obsolete, recognized but not supported:: MULTIPLE FILE TAPE CONTAINS file-1 POSITION 1 file-2 POSITION 80 ........ POSITIVE ........ Class condition. .. sourcecode:: cobolfree IF amount IS POSITIVE DISPLAY "Not broke yet" END-DISPLAY END-IF ....... PRESENT ....... Report Writer clause used for optional field and group output. .. sourcecode:: cobolfree 05 field PIC X(16) PRESENT WHEN sum > 0. ........ PREVIOUS ........ Previous key READ_ control for INDEXED_ files. .. sourcecode:: cobolfree READ file-1 PREVIOUS RECORD ....... PRINTER ....... Special name. .. sourcecode:: cobolfree SPECIAL-NAMES. PRINTER IS myprint DISPLAY "test" UPON PRINTER END-DISPLAY ........ PRINTING ........ Report Writer declarative to SUPPRESS_ report printing. ......... PROCEDURE ......... The COBOL DIVISION that holds the executable statements. Also used with INPUT_ and OUTPUT_ sort procedures. ................. PROCEDURE-POINTER ................. Alias for PROGRAM-POINTER_, capable of holding a callable address. .......... PROCEDURES .......... Debug module declarative clause. .. sourcecode:: cobolfree USE FOR DEBUGGING ON ALL PROCEDURES ....... PROCEED ....... Used in ALTER_. .. sourcecode:: cobolfree ALTER paragraph-1 TO PROCEED TO paragraph-x ....... PROGRAM ....... An EXIT_ point. .. sourcecode:: cobolfree EXIT PROGRAM. .......... PROGRAM-ID .......... The program identifier. Case sensitive, unlike all other OpenCOBOL identifiers. OpenCOBOL produces C Application Binary Interface linkable entities and this identifier must conform to those rules. Dashes in names are replaced by a hex string equivalent. ............... PROGRAM-POINTER ............... A data USAGE_ clause defining a field that can hold the executable address of a CALL_ routine. .. sourcecode:: cobolfree 77 callback USAGE PROGRAM-POINTER. ... SET callback TO ENTRY a-program-id CALL callback ...... PROMPT ...... Screen section input control. .. sourcecode:: cobolfree PROMPT IS ':' ........ PROPERTY ........ Unsupported Object COBOL phrase. ......... PROTOTYPE ......... Unsupported Object COBOL phrase. ..... PURGE ..... Unsupported Communication Section clause. ..... QUEUE ..... Unsupported Communication Section clause. ..... QUOTE ..... A figurative constant representing '"'. .. sourcecode:: cobolfree DISPLAY QUOTE 123 QUOTE END-DISPLAY Outputs:: "123" ...... QUOTES ...... A figurative constant representing '"'. .. sourcecode:: cobolfree 01 var PICTURE X(4). MOVE ALL QUOTES TO var DISPLAY var END-DISPLAY Outputs:: """" ..... RAISE ..... Exception handling. There IS support for exceptions in OpenCOBOL but it is currently fairly limited. See `FUNCTION EXCEPTION-LOCATION`_ for a sample. RAISE is not yet recognized. ....... RAISING ....... Exception handling. There IS support for exceptions in OpenCOBOL but it is currently limited. RAISING is not yet recognized. ...... RANDOM ...... A file access mode. RANDOM access allows seeks to any point in a file, usually by KEY_. ... RD ... Report writer DATA_ division, REPORT_ section descriptor. Currently unsupported. .. sourcecode:: cobolfree DATA DIVISION. REPORT SECTION. RD report-1 PAGE LIMIT IS 66 LINES. .... READ .... A staple of COBOL. Read a record. .. sourcecode:: cobolfree READ infile PREVIOUS RECORD INTO back-record AT END SET attop TO TRUE NOT AT END PERFORM cursor-calculator END-READ ....... RECEIVE ....... An unsupported Communication Section clause. ...... RECORD ...... Multiple use phrase. .. sourcecode:: cobolfree FD file RECORD IS VARYING IN SIZE FROM 1 TO 80 CHARACTERS DEPENDING ON size-field SELECT file ASSIGN TO filename ACCESS MODE IS RANDOM RECORD KEY IS key-field ALTERNATE KEY IS alt-key WITH DUPLICATES. READ infile NEXT RECORD INTO display-rec END-READ ......... RECORDING ......... An obsolete, recognized, but ignored file descriptor clause. .. sourcecode:: cobolfree FD file RECORD IS VARYING IN SIZE FROM 1 TO 80 CHARACTERS DEPENDING ON size-field RECORDING MODE IS F. ....... RECORDS ....... Multiple use phrase. .. sourcecode:: cobolfree UNLOCK file-1s RECORDS ......... RECURSIVE ......... Specifies a PROGRAM-ID as having the recursive attribute. Recursive sub programs can CALL themselves. This qualifier has implications on how OpenCOBOL allocates storage. Normally storage is stacked, recursion can chew through stack space very quickly. Sub programs marked RECURSIVE are usually allocated using the memory heap. .. sourcecode:: cobolfree PROGRAM-ID nextbigthing IS RECURSIVE. ......... REDEFINES ......... A very powerful DATA_ division control alllowing for redefinition of memory storage, including incompatible data by type. .. sourcecode:: cobolfree IDENTIFICATION DIVISION. PROGRAM-ID. prog. DATA DIVISION. WORKING-STORAGE SECTION. 01 X PIC X. 01 G REDEFINES X. 02 A PIC X. 02 B REDEFINES A PIC 9. PROCEDURE DIVISION. STOP RUN. .... REEL .... A tape device qualifier .. sourcecode:: cobolfree CLOSE file REEL FOR REMOVAL ......... REFERENCE ......... The default COBOL CALL_ argument handler. CALL arguments can be :: BY REFERENCE BY CONTENT BY VALUE where by reference passes a reference pointer, allowing data modification inside sub programs. ........ RELATION ........ Unsupported. ........ RELATIVE ........ File organization where the position of a logical record is determined by its relative record number. .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 20110806 *> Purpose: RELATIVE file organization *> Tectonics: cobc -g -debug -W -x relatives.cob *> *************************************************************** identification division. program-id. relatives. environment division. configuration section. repository. function all intrinsic. input-output section. file-control. select optional relatives assign to "relatives.dat" file status is filestatus organization is relative access mode is dynamic relative key is nicknum. data division. file section. fd relatives. 01 person. 05 firstname pic x(48). 05 lastname pic x(64). 05 relationship pic x(32). working-storage section. 77 filestatus pic 9(2). 88 ineof value 1 when set to false is 0. 77 satisfaction pic 9. 88 satisfied value 1 when set to false is 0. 77 nicknum pic 9(2). 77 title-line pic x(34). 88 writing-names value "Adding, Overwriting. 00 to finish". 88 reading-names value "Which record? 00 to quit". 77 problem pic x(80). screen section. 01 detail-screen. 05 line 1 column 1 from title-line erase eos. 05 line 2 column 1 value "Record: ". 05 pic 9(2) line 2 column 16 using nicknum. 05 line 3 column 1 value "First name: ". 05 pic x(48) line 3 column 16 using firstname. 05 line 4 column 1 value "Last name: ". 05 pic x(64) line 4 column 16 using lastname. 05 line 5 column 1 value "Relation: ". 05 pic x(32) line 5 column 16 using relationship. 05 pic x(80) line 6 column 1 from problem. 01 show-screen. 05 line 1 column 1 from title-line erase eos. 05 line 2 column 1 value "Record: ". 05 pic 9(2) line 2 column 16 using nicknum. 05 line 3 column 1 value "First name: ". 05 pic x(48) line 3 column 16 from firstname. 05 line 4 column 1 value "Last name: ". 05 pic x(64) line 4 column 16 from lastname. 05 line 5 column 1 value "Relation: ". 05 pic x(32) line 5 column 16 from relationship. 05 pic x(80) line 6 column 1 from problem. *> -*********-*********-*********-*********-*********-*********-** procedure division. beginning. *> Open the file and find the highest record number *> which is a sequential read operation after START open input relatives move 99 to nicknum start relatives key is less than or equal to nicknum invalid key move concatenate('NO START' space filestatus) to problem move 00 to nicknum not invalid key read relatives next end-read end-start *> Close and open for i-o close relatives open i-o relatives *> Prompt for numbers and names to add until 00 set writing-names to true set satisfied to false perform fill-file through fill-file-end until satisfied close relatives *> Prompt for numbers to view names of until 00 open input relatives set reading-names to true set satisfied to false perform record-request through record-request-end until satisfied perform close-shop . ending. goback. *> get some user data to add fill-file. display detail-screen end-display. accept detail-screen end-accept. move spaces to problem if nicknum equal 0 set satisfied to true go to fill-file-end end-if. . write-file. write person invalid key move concatenate("overwriting: " nicknum) to problem rewrite person invalid key move concatenate( exception-location() space nicknum space filestatus) to problem end-rewrite end-write. display detail-screen end-display . fill-file-end. . *> get keys to display record-request. display show-screen end-display accept show-screen end-accept move spaces to problem if nicknum equals 0 set satisfied to true go to record-request-end end-if . *> The magic of relative record number reads read-relation. read relatives invalid key move exception-location() to problem not invalid key move spaces to problem end-read display show-screen end-display . record-request-end. . *> get out <* close-shop. close relatives. goback. . end program relatives. with sample screens:: Adding, Overwriting. 00 to finish Record: 04 First name: Brad____________________________________________ Last name: Tiffin__________________________________________________________ Relation: brother_________________________ allowing for new record additions or overwrites of existing key numbers, and:: Which record? 00 to quit Record: 03 First name: Brian Last name: Tiffin Relation: where typing in a *nicknum* record number retrieves the relative record. ....... RELEASE ....... Release a record to a SORT_. Used with INPUT PROCEDURE of SORT verb. .. sourcecode:: cobolfree RELEASE record-1 FROM identifier-1 ......... REMAINDER ......... Access to integer remainders during division. .. sourcecode:: cobolfree DIVIDE hex-val BY 16 GIVING left-nibble REMAINDER right-nibble END-DIVIDE ....... REMOVAL ....... A close clause. .. sourcecode:: cobolfree CLOSE filename-1 REEL FOR REMOVAL Specifies that the file is stored on multiple removable tapes/disks. Not all systems support such devices. ....... RENAMES ....... OpenCOBOL supports regrouping of level 02-49 data items with level 66 and RENAMES. .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 20110606 *> Purpose: Demonstration of 66-level datanames *> Tectonics: cobc *> *************************************************************** identification division. program-id. sixtysix. data division. working-storage section. 01 master. 05 field-1 pic s9(9). 05 field-2 pic x(16). 05 field-3 pic x(4). 05 field-4 pic s9(9). 66 sixtysix renames field-2. 66 group-66 renames field-2 through field-4. *> *************************************************************** procedure division. move -66 to field-1 move "sixtysix" to field-2 move "ABCD" to field-3 multiply field-1 by -1 giving field-4 end-multiply display "master : " master end-display display "field-1 : " field-1 end-display display "sixtysix: " sixtysix end-display display "group-66: " group-66 end-display goback. end program sixtysix. giving:: $ ./sixtysix master : 00000006vsixtysix ABCD000000066 field-1 : -000000066 sixtysix: sixtysix group-66: sixtysix ABCD000000066 ....... REPLACE ....... A COBOL text preprocessing operator. .. sourcecode:: cobolfree REPLACE ==MARKER== BY ==DISPLAY "REPLACE EXAMPLE" END-DISPLAY==. identification division. program-id. prog. procedure division. MARKER goback. end program prog. And then to see how that REPLACE is working, use *cobc* with the -E argument .. sourcecode:: cobolfree # 1 "replacing.cob" identification division. program-id. prog. procedure division. DISPLAY "REPLACE EXAMPLE" END-DISPLAY goback. end program prog. ......... REPLACING ......... An INSPECT_ subclause. A COPY_ preprocessor clause. ...... REPORT ...... Unsupported Report Writer section and File descriptor clause. ......... REPORTING ......... Unsupported declarative for Report Writer. ....... REPORTS ....... Unsupported Report Writer file descriptor clause associating files with named reports. .......... REPOSITORY .......... A paragraph of the CONFIGURATION_ SECTION. OpenCOBOL supports the **FUNCTION ALL INTRINSIC** clause of the REPOSITORY. Allows source code to use intrinsic functions without the FUNCTION_ keyword. .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 20110213 *> Purpose: Demonstrate an intrinstric function shortcut *> Tectonics: cobc -x functionall.cob *> *************************************************************** identification division. program-id. functionall. environment division. configuration section. repository. function all intrinsic. *> *************************************************************** procedure division. display function pi space function e end-display display pi space e end-display goback. end program functionall. Sample output:: $ cobc -x functionall.cob $ ./functionall 3.1415926535897932384626433832795029 2.7182818284590452353602874713526625 3.1415926535897932384626433832795029 2.7182818284590452353602874713526625 Without the **repository** paragraph:: $ cobc -x functionall.cob functionall.cob:19: Error: 'pi' undefined functionall.cob:19: Error: 'e' undefined ........ REQUIRED ........ Recognized but ignored Screen section field attribute. ....... RESERVE ....... An unsupported SELECT_ clause. ..... RESET ..... Unsupported Report Writer data control field clause. ...... RESUME ...... Unsupported declarative control flow statement. ..... RETRY ..... Unsupported record locking wait and retry clause. - RETRY n TIMES - RETRY FOR n SECONDS - RETRY FOREVER ...... RETURN ...... Return records in a SORT_ OUTPUT PROCEDURE. ......... RETURNING ......... Specify the destination of CALL results. .. sourcecode:: cobolfree 01 result PIC S9(8). CALL "libfunc" RETURNING result END-CALL Specify the return field for a sub-program. .. sourcecode:: cobolfree PROCEDURE DIVISION USING thing RETURNING otherthing ............. REVERSE-VIDEO ............. SCREEN_ section field display attribute. Functionality dependent on terminal and operating system support and settings. ...... REWIND ...... A really cool lyric in the Black Eyed Peas song, "Hey Mama". ....... REWRITE ....... Allow overwrite of records where primary key exists. .. sourcecode:: cobolfree write person invalid key move concatenate("overwriting: " nicknum) to problem rewrite person invalid key move concatenate( exception-location() space nicknum space filestatus) to problem end-rewrite end-write. ... RF ... Short form for unsupported REPORT FOOTING. ... RH ... Short form for unsupported REPORT HEADING. ..... RIGHT ..... Ignored SYNCHRONIZED_ clause. ........ ROLLBACK ........ Recognized but not fully supported revert of transactional revert of file writes. See COMMIT_. ....... ROUNDED ....... Well defined rounding clause applied to arithmetic. Defined well enough for bank managers to feel comfortable handing their calculations over to a bunch of nerds. .. sourcecode:: cobolfree COMPUTE total-value ROUNDED = 1.0 / 6.0 END-COMPUTE ... RUN ... A stopping point. .. sourcecode:: cobolfree STOP RUN RETURNING 1 Terminates run regardless of nesting depth, returning control (and result) to operating system. See GOBACK_ and EXIT PROGRAM_ for other run unit terminations. .... SAME .... I-O-CONTROL clause for SAME RECORD AREA. ...... SCREEN ...... Screen section. .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> ************************************************************ <* *> Author: Brian Tiffin *> Date: 20110701 *> Purpose: Play with 2.0 screen section *> Tectonics: cobc *> ************************************************************ <* identification division. program-id. screening. data division. working-storage section. 01 some-data pic s9(9). screen section. 01 detail-screen. 03 line 1 column 1 value "title line". 03 line 2 column 1 value "field: ". 03 line 2 column 16 using some-data. *> ************************************************************ <* procedure division. display detail-screen end-display accept detail-screen end-accept goback. end program screening. being a poor representation of the plethora of field attribute control allowed in OpenCOBOL screen section. Screen field attributes include: - JUSTIFIED RIGHT - BLANK WHEN ZERO - OCCURS integer-val TIMES - BELL, BEEP - AUTO, AUTO-SKIP, AUTOTERMINATE - UNDERLINE - OVERLINE - SECURE - REQUIRED - FULL - PROMPT - REVERSE-VIDEO - BLANK LINE - BLANK SCREEN - ERASE EOL - ERASE EOS - SIGN IS LEADING SEPERATE CHARACTER - SIGN IS TRAILING SEPERATE CHARACTER - LINE NUMBER IS [PLUS] integer-val - COLUMN NUMBER IS [PLUS] integer-val - FOREGROUND-COLOR IS integer-val HIGHLIGHT, LOWLIGHT - BACKGROUND-COLOR IS integer-val BLINK - PICTURE IS picture-clause USING identifier - PICTURE IS picture-clause FROM identifier, literal - PICTURE IS picture-clause TO identifier - VALUE is literal During ACCEPT, USING_ fields are read/write, FROM_ fields are read and TO_ fields are write. See `What are the OpenCOBOL SCREEN SECTION colour values?`_ for colour values. ... SD ... SORT_ file data descriptor. .. sourcecode:: cobolfree SD sort-file-1 RECORD CONTAINS 80 CHARACTERS. ...... SEARCH ...... A powerful table and file search verb. See `Linear SEARCH`_ for an example. ....... SECONDS ....... Clause of unsupported read/write RETRY_ on lock. ....... SECTION ....... COBOL source code is organized in DIVISION_, SECTION_, paragraphs and sentences. OpenCOBOL supports user named sections and recognizes the following list of pre-defined sections. - CONFIGURATION_ - INPUT-OUTPUT_ - FILE_ - WORKING-STORAGE_ - LOCAL-STORAGE_ - LINKAGE_ - REPORT_ (recognized but unsupported) - SCREEN_ User defined sections provide for source code organization and use of PERFORM_ with THROUGH_ for tried and true COBOL procedural programming. ...... SECURE ...... SCREEN_ section field attribute. Displayed as asterisks. ....... SEGMENT ....... Unsupported Communication section clause. ...... SELECT ...... FILE-CONTROL_ phrase. Associates files with names, descriptors, and options. .. sourcecode:: cobolfree ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT fileresource ASSIGN TO external-name FILE STATUS IS identifier COLLATING SEQUENCE IS alphabet-name LOCK MODE IS MANUAL WITH LOCK ON MULTIPLE RECORDS RECORD DELIMITER IS STANDARD RESERVE num AREA SHARING WITH NO OTHER ORGANIZATION IS INDEX ACCESS MODE IS DYNAMIC RECORD KEY IS key-field ALTERNATE RECORD KEY IS key-field-2 WITH DUPLICATES ALTERNATE RECORD KEY IS key-field-3. though, naming a quick file can be as simple as .. sourcecode:: cobolfree SELECT myfile ASSIGN TO "name.txt". which will be a default LINE_ SEQUENTIAL_ file. .... SELF .... Unsupported Object COBOL clause. .... SEND .... Unsupported Communication section verb. ........ SENTENCE ........ An obsolete control flow clause. CONTINUE_ is preferred to NEXT SENTENCE. ........ SEPARATE ........ Fine tuned control over leading and trailing sign indicator. .. sourcecode:: cobolfree 77 field-1 PICTURE S9(8) SIGN IS TRAILING SEPARATE. ........ SEQUENCE ........ Controls COLLATING_ sequence for character compares, by defining a character set. .......... SEQUENTIAL .......... OpenCOBOL supports both fixed length SEQUENTIAL and newline terminated LINE_ SEQUENTIAL file access. ... SET ... - SET ADDRESS OF ptr-var TO var. - SET ENVIRONMENT "name" TO "value". - SET cond-1 TO TRUE That last one is pretty cool. An 88 level conditional set TRUE will cause the associated value to change to a value that satifies the condition as true. .. sourcecode:: cobolfree 01 field-1 pic 99. 88 cond-1 value 42. MOVE 0 TO field-1 DISPLAY field-1 END-DISPLAY SET cond-1 TO TRUE DISPLAY field-1 END-DISPLAY 00 and 42 are displayed. ....... SHARING ....... File sharing option. - SHARING WITH NO OTHER - SHARING WITH ALL OTHER - SHARING WITH READ ONLY Functionality dependent on build options and operating system running OpenCOBOL. .... SIGN .... Fine tuned control over leading and trailing sign indicator. .. sourcecode:: cobolfree 77 field-1 PICTURE S9(8) SIGN IS TRAILING SEPARATE. ...... SIGNED ...... OpenCOBOL supports the full gamut of COBOL numeric data storage. SIGNED and UNSIGNED_ being part and parcel. .......... SIGNED-INT .......... A native storage format NUMERIC_ data USAGE_ clause. Equivalent to BINARY-LONG_, BINARY-LONG SIGNED, and SIGNED-LONG_. ........... SIGNED-LONG ........... A native storage format NUMERIC_ data USAGE_ clause. Equivalent to BINARY-LONG_, BINARY-LONG SIGNED, and SIGNED-INT_. ............ SIGNED-SHORT ............ A native storage format NUMERIC_ data USAGE_ clause. Equivalent to BINARY-SHORT_ SIGNED. .... SIZE .... Multi purpose. OpenCOBOL allows SIZE IS control on CALL arguments. Arthimetic operations allow for declaritives on size errors. .. sourcecode:: cobolfree ADD 1 TO ocobol ON SIZE ERROR SET erroneous TO TRUE NOT ON SIZE ERROR DISPLAY "Whee, ADD 1 TO COBOL" END-DISPLAY END-ADD STRING_ has a DELIMITED BY SIZE option to include entire fields. .... SORT .... OpenCOBOL supports USING, GIVING as well as INPUT PROCEDURE and OUTPUT PROCEDURE clauses for the SORT verb. .. sourcecode:: cobol OCOBOL* OpenCOBOL SORT verb example using standard in and standard out identification division. program-id. sorting. environment division. input-output section. file-control. select sort-in assign keyboard organization line sequential. select sort-out assign display organization line sequential. select sort-work assign "sortwork". data division. file section. fd sort-in. 01 in-rec pic x(255). fd sort-out. 01 out-rec pic x(255). sd sort-work. 01 work-rec pic x(255). procedure division. sort sort-work ascending key work-rec using sort-in giving sort-out. goback. exit program. end program sorting. In the next sample, demonstrating INPUT PROCEDURE and OUTPUT PROCEDURE take note of the RETURN_ and RELEASE_ verbs as they are key to record by record control over sort operations. Also, just to complicate things, this sample sorts using a mixed-case alphabet (but also places capital A out of order to demonstrate special cases that can codified in an ALPHABET_). .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED ****************************************************************** * Author: Brian Tiffin * Date: 02-Sep-2008 * Purpose: An OpenCOBOL SORT verb example * Tectonics: cobc -x sorting.cob * ./sorting output * or simply * ./sorting * for keyboard and screen demos ****************************************************************** identification division. program-id. sorting. environment division. configuration section. * This sets up a sort order lower then upper except for A and a special-names. alphabet mixed is " AabBcCdDeEfFgGhHiIjJkKlLmMnNoOpPqQrRsStTu -"UvVwWxXyYzZ0123456789". input-output section. file-control. select sort-in assign keyboard organization is line sequential. select sort-out assign display organization is line sequential. select sort-work assign "sortwork". data division. file section. fd sort-in. 01 in-rec pic x(255). fd sort-out. 01 out-rec pic x(255). sd sort-work. 01 work-rec pic x(255). working-storage section. 01 loop-flag pic 9 value low-value. procedure division. sort sort-work on descending key work-rec collating sequence is mixed input procedure is sort-transform output procedure is output-uppercase. display sort-return end-display. goback. ****************************************************************** sort-transform. move low-value to loop-flag open input sort-in read sort-in at end move high-value to loop-flag end-read perform until loop-flag = high-value move FUNCTION LOWER-CASE(in-rec) to work-rec release work-rec read sort-in at end move high-value to loop-flag end-read end-perform close sort-in . ****************************************************************** output-uppercase. move low-value to loop-flag open output sort-out return sort-work at end move high-value to loop-flag end-return perform until loop-flag = high-value move FUNCTION UPPER-CASE(work-rec) to out-rec write out-rec end-write return sort-work at end move high-value to loop-flag end-return end-perform close sort-out . exit program. end program sorting. Here is a snippet describing TABLE sorts by [jrls_swla]_ .. sourcecode:: cobolfree table define 01 nbr-of-columns pic 9(4) value zero. 01 tcindex2 usage is index. 01 dbtables. 03 tables-columns occurs 1 to 1000 times depending on nbr-of-columns ascending key tcTable, tcColumn indexed by tcindex. 05 tcTable pic x(64) value spaces. 05 tcColumn pic x(64) value spaces. 05 tcAlias pic x(10) value spaces. 05 tcOrder pic 9(4) value zero. 05 tcType pic x(10) value spaces. 05 tcMaxLen pic 9(4) value zero. *><* 01 aliasName. 05 pic x value "t". 05 anVal pic 9(3) value zero. 01 showdata. 05 sdTable pic x(17) value spaces. 05 sdColumn pic x(17) value spaces. 05 sdType pic x(10) value spaces. 05 sdOrder pic zzzzz-. 05 sdMaxLen pic zzzzz. table load perform varying rows from 1 by 1 until rows > dbNumRows call "dbNextRow" using by value dbResult, by reference ColumnBuff, by reference CbuffDesc returning dbResult add 1 to nbr-of-columns set tcindex up by 1 move cbTable to tcTable(tcindex) move cbColumn to tcColumn(tcindex) move cbType to tcType(tcindex) move cbOrder to tcOrder(tcindex) move cbMaxLen to tcMaxLen(tcindex) if nbr-of-columns = 1 add 1 to anVal else set tcindex2 to tcindex set tcindex2 down by 1 if cbTable <> tcTable(tcindex2) add 1 to anVal end-if end-if move aliasName to tcAlias(tcindex) end-perform. table sort sort tables-columns ascending key tcTable, tcColumn. display table perform varying tcindex from 1 by 1 until tcindex > nbr-of-columns move tcTable(tcindex) to sdTable move tcColumn(tcindex) to sdColumn move tcOrder(tcindex) to sdOrder move tcType(tcindex) to sdType move tcMaxLen(tcindex) to sdMaxLen display showdata end-perform. Excercise for the audience. Could the above code be simplified by using .. sourcecode:: cobolfree MOVE CORRESPONDING cbRecord to table-columns(tcindex) ... MOVE CORRESPONDING table-columns(tcindex) to showdata with a few judicious field name changes? ,,,,,,,,,,,,,,,,,,,,,, An OCSORT support tool ,,,,,,,,,,,,,,,,,,,,,, There is an external sort utility referenced in `What is ocsort?`_ .......... SORT-MERGE .......... Used in an I-O-CONTROL paragraph with the SAME clause:: SAME SORT-MERGE AREA FOR filename-1. The SORT-MERGE keyword and SORT keyword are equivalent in this case. ........... SORT-RETURN ........... A *SPECIAL-REGISTER* used by the OpenCOBOL SORT routines. * +000000000 for success * +000000016 for failure A programmer may set SORT-RETURN in an INPUT PROCEDURE. ...... SOURCE ...... Compiler directive controlling source code handling. .. sourcecode:: cobolfree >>SOURCE FORMAT IS FIXED >>SOURCE FORMAT IS FREE OpenCOBOL allows use of this directive at programmer whim. **cobc** defaults to FIXED format source handling, so the directive must occur beyond the sequence and indicator columns unless the **-free** compile option is used. Split keys are a pending feature in OpenCOBOL. .. sourcecode:: cobolfree SELECT ... RECORD KEY IS key-name SOURCE is dname-2 dname-3 Also a pending Report Writer data source clause. ............... SOURCE-COMPUTER ............... A paragraph of the IDENTIFICATION_ division. Treated as a comment. ....... SOURCES ....... Currently unsupported SOURCES ARE report writer clause. ..... SPACE ..... A figurative constant representing a space character. ...... SPACES ...... A figurative constant representing space characters. ............. SPECIAL-NAMES ............. OpenCOBOL supports a fair complete set of the SPECIAL-NAMES in common use. - CONSOLE IS CRT - SYSIN IS mnemonic-name-1 - SYSOUT IS - SYSLIST IS - SYSLST IS - PRINTER IS - SYSERR IS - CONSOLE IS mnemonic-name-7 - SWITCH-1 IS mnemonic-name-n ON STATUS IS condition-name-1 OFF STATUS IS condition-name-2 - SWITCH-2 - ... - SWITCH-8 IS ... - C01 IS mnemonic-name-m - ... - C12 IS - ALPHABET alphabet-name IS NATIVE, STANDARD-1, STANDARD-2, EBCDIC literal-1 THRU literal-2 [ALSO literal-3] - SYMBOLIC CHARACTERS symbol-character IS integer-1 IN alphabet-name - CLASS class-name IS literal THRU literal-2 - LOCALE locale-name IS identifier-1 - CURRENCY SIGN IS literal - DECIMAL-POINT IS COMMA - CURSOR IS identifier-1 - CRT STATUS IS identifier-1 - SCREEN CONTROL IS identifier-1 **PENDING** - EVENT STATUS IS identifier-1 **PENDING** ........ STANDARD ........ - LABEL RECORDS ARE STANDARD .......... STANDARD-1 .......... - ALPHABET IS STANDARD-1 - RECORD DELIMITER IS STANDARD-1 equivalent to ASCII_ .......... STANDARD-2 .......... - ALPHABET IS STANDARD-1 - RECORD DELIMITER IS STANDARD-1 equivalent to ASCII_ ..... START ..... Sets internal file fields that will influence sequential READ_ NEXT_ and READ_ PREVIOUS_ for INDEXED_ files. Can also be used to seek to the FIRST_ or LAST_ record of a file for SEQUENTIAL_ access modes. .. sourcecode:: cobolfree start indexing key is less than keyfield of indexing-record invalid key display "bad start: " keyfield of indexing-record end-display set no-more-records to true not invalid key read indexing previous record at end set no-more-records to true end-read end-start The conditionals are quite powerful. .. sourcecode:: cobolfree KEY IS GREATER THAN KEY IS > KEY IS LESS THAN KEY IS < KEY IS EQUAL TO KEY IS = KEY IS NOT GREATER THAN KEY IS NOT > KEY IS NOT LESS THAN KEY IS NOT < KEY IS NOT EQUAL TO KEY IS NOT = KEY IS <> KEY IS GREATER THAN OR EQUAL TO KEY IS >= KEY IS LESS THAN OR EQUAL TO KEY IS <= See `Does OpenCOBOL support ISAM?`_ for some example source code. ......... STATEMENT ......... Unsupported. ...... STATUS ...... Multi-purpose. - CRT STATUS IS - FILE STATUS IS - EVENT STATUS IS - SWITCH-1 IS thing ON STATUS IS conditional-1 .... STEP .... Unsupported Report Writer OCCURS_ subclause. .... STOP .... End a run and return control to the operating system. .. sourcecode:: cobolfree STOP RUN RETURNING 5. Forms include: - STOP RUN - STOP RUN RETURNING stat - STOP RUN GIVING stat - STOP literal - STOP RUN WITH ERROR STATUS stat - STOP RUN WITH NORMAL STATUS stat ...... STRING ...... String together a set of variables with controlled delimiters. .. sourcecode:: cobolfree 01 var PICTURE X(5). STRING "abc" DELIMITED BY "b" "def" DELIMITED BY SIZE "ghi" DELIMITED BY "z" INTO var ON OVERFLOW DISPLAY "var is full at" SPACE LENGTH OF var END-DISPLAY END-STRING DISPLAY var END-DISPLAY Outputs:: var is full at 5 adefg OpenCOBOL also fully supports the WITH POINTER clause to set the initial and track the position in the output character variable. ...... STRONG ...... Unsupported. ........... SUB-QUEUE-1 ........... Unsupported Communication section clause. ........... SUB-QUEUE-2 ........... Unsupported Communication section clause. ........... SUB-QUEUE-3 ........... Unsupported Communication section clause. ........ SUBTRACT ........ Arithmetic operation. .. sourcecode:: cobolfree SUBTRACT a b c FROM d ROUNDED END-SUBTRACT SUBTRACT a FROM b GIVING c ON SIZE ERROR SET math-error TO TRUE NOT ON SIZE ERROR SET math-error TO FALSE END-SUBTRACT SUBTRACT CORRESPONDING record-a FROM record-b ROUNDED ON SIZE ERROR SET something-wrong TO TRUE END-SUBTRACT ... SUM ... A REPORT SECTION control break summation field clause. Unsupported. ..... SUPER ..... Unsupported Object COBOL clause. ........ SUPPRESS ........ Unsupported declarative to suppress printing. ...... SYMBOL ...... Unsupported. ........ SYMBOLIC ........ SPECIAL-NAMES_ clause allowing user defined figurative constants. .... SYNC .... Alias for SYNCHRONIZED_ ............ SYNCHRONIZED ............ Control padding inside record definitions, in particular to match C structures. .. sourcecode:: cobolfree 01 infile. 03 slice occurs 64 times depending on slices. 05 stext usage pointer synchronized. 05 val float-long synchronized. 05 ftext usage pointer synchronized. .............. SYSTEM-DEFAULT .............. OBJECT-COMPUTER_ clause for locale support. .. sourcecode:: cobolfree CHARACTER CLASSIFICATION IS SYSTEM-DEFAULT ..... TABLE ..... Unsupported keyword, but OpenCOBOL fully supports tables, including SORT_. ........ TALLYING ........ INSPECT_ clause for counting occurances of a literal. .. sourcecode:: cobolfree INSPECT record-1 TALLYING ident-1 FOR LEADING "0" .... TAPE .... A device type used in ASSIGN_. ........ TERMINAL ........ Unsupported Comminication section clause. ......... TERMINATE ......... Currently unsupported Report Writer verb to finish up a report. See INITIATE_. .... TEST .... Allows control over when loop conditionals are tested. WITH TEST BEFORE is the default. WITH TEST AFTER will always evaluate the body of the loop at least once. .. sourcecode:: cobolfree perform with test after varying x from 1 by xstep until x >= function e if x > function e move function e to x-value else move x to x-value end-if compute recip = 1 / x end-compute move recip to y-value write outrec end-write end-perform .... TEXT .... Unsupported Communication section clause. .... THAN .... Part of the conditional clauses for readability. .. sourcecode:: cobolfree IF A GREATER THAN 10 DISPLAY "A > 10" END-DISPLAY END-IF .... THEN .... A somewhat disdained keyword that is part of the IF THEN ELSE control structure. .. sourcecode:: cobolfree IF A > 10 THEN DISPLAY "A GREATER THAN 10" END-DISPLAY ELSE DISPLAY "A LESS THAN OR EQUAL TO 10" END-DISPLAY END-IF ....... THROUGH ....... Used in definitions for alphabets in SPECIAL-NAMES_ and a procedural clause allowing PERFORM_ from one label THROUGH (inclusive) to another label and all paragraphs in between. Also used to specify grouping with RENAMES_. .. sourcecode:: cobolfree PERFORM 100-open-files THROUGH 100-files-end .... THRU .... Commonly used alias for THROUGH_ .... TIME .... Allows access to current clock with ACCEPT_. .. sourcecode:: cobolfree 01 current-time. 05 ct-hours pic 99. 05 ct-minutes pic 99. 05 ct-seconds pic 99. 05 ct-hundredths pic 99. ACCEPT current-time FROM TIME ..... TIMES ..... A counted loop. .. sourcecode:: cobolfree PEFORM 5 TIMES DISPLAY "DERP" END-DISPLAY END-PERFORM ... TO ... Multi-purpose destination specifier. .. sourcecode:: cobolfree ADD 1 TO cobol GIVING OpenCOBOL ON SIZE ERROR DISPLAY "Potential exceeeds expectations" END-DISPLAY END-ADD ... TOP ... A LINAGE_ clause. ........ TRAILING ........ Multi-purpose. FUNCTION TRIM allows a TRAILING keyword. An INSPECT TALLYING subclause. .... TRUE .... A SET_ target. Used in EVALUATE to control when the operation succeeds. When used with a conditional 88 level name, will set the corresponding field to a listed VALUE. .. sourcecode:: cobolfree 01 field-1 pic x. 88 cond-1 values 'a','b','c'. SET cond-1 TO TRUE DISPLAY field-1 END-DISPLAY .... TYPE .... An unsupported Report Writer report group clause. Also unsupported data description clause. ....... TYPEDEF ....... Unsupported data description clause that will allow user defined record layouts. ..... UCS-4 ..... Currently unsupported Universal Character Set alphabet. UCS-4 would store international code points in 4 bytes. ......... UNDERLINE ......... SCREEN_ section field attribute. .... UNIT .... A close option, alias for REEL_. .. sourcecode:: cobolfree CLOSE file-1 UNIT WITH NO REWIND ......... UNIVERSAL ......... Unsupported Object COBOL exception object clause. ...... UNLOCK ...... Manual record unlock and buffer write sync. .. sourcecode:: cobolfree UNLOCK filename-1 RECORDS ........ UNSIGNED ........ Usage clause specifing that a value will not include any sign and therefore can't be negative. ............ UNSIGNED-INT ............ A native storage format NUMERIC_ data USAGE_ clause. Equivalent to BINARY-LONG_ UNSIGNED and UNSIGNED-LONG_. ............. UNSIGNED-LONG ............. A native storage format NUMERIC_ data USAGE_ clause. Equivalent to BINARY-LONG_ UNSIGNED and UNSIGNED-INT_. .............. UNSIGNED-SHORT .............. A native storage format NUMERIC_ data USAGE_ clause. Equivalent to BINARY-SHORT_ UNSIGNED and UNSIGNED-SHORT_. ........ UNSTRING ........ A powerful string decomposition verb. .. sourcecode:: cobolfree UNSTRING Input-Address DELIMITED BY "," OR "/" INTO Street-Address DELIMITER D1 COUNT C1 Apt-Number DELIMITER D2 COUNT C2 City DELIMITER D3 COUNT C3 State DELIMITER D4 COUNT C4 Zip-Code DELIMITER D5 COUNT C5 WITH POINTER ptr-1 ON OVERFLOW SET more-fields TO TRUE END-UNSTRING ..... UNTIL ..... Sets a loop conditional. .. sourcecode:: cobolfree PERFORM VARYING ident-1 FROM 1 BY 1 UNTIL ident-1 > 10 CALL "thing" USING BY VALUE ident-1 END-CALL END-PERFORM ... UP ... Index and pointer modification. .. sourcecode:: cobolfree SET ptr-1 UP BY 4 SET ind-1 UP BY 1 ...... UPDATE ...... SCREEN_ section field attribute. .... UPON .... A DISPLAY_ destination clause. ..... USAGE ..... OpenCOBOL uses standard big-endian_ internal storage by default. USAGE clauses influence the data representation. The INTEL architecture uses little-endian_ form and OpenCOBOL programmers developing for this common chipset may need to pay heed to this for performance purposes. As per the standards, OpenCOBOL supports COMPUTATIONAL-5 native usage. OpenCOBOL enables use of one to eight byte binary representations in both big and little endian forms. Along with full support of all common COBOL_ PICTURE_ clauses both storage and display, OpenCOBOL supports USAGE clauses of: * BINARY * COMPUTATIONAL, COMP * COMP-1 * COMP-2 * COMP-3 * COMP-4 * COMP-5 * COMP-X * FLOAT-LONG * FLOAT-SHORT * DISPLAY * INDEX * PACKED-DECIMAL * POINTER * PROGRAM-POINTER * SIGNED-SHORT * SIGNED-INT * SIGNED-LONG * UNSIGNED-SHORT * UNSIGNED-INT * UNSIGNED-LONG * BINARY-CHAR SIGNED * BINARY-CHAR UNSIGNED * BINARY-CHAR * BINARY-SHORT SIGNED * BINARY-SHORT UNSIGNED * BINARY-SHORT * BINARY-LONG SIGNED * BINARY-LONG UNSIGNED * BINARY-LONG * BINARY-DOUBLE SIGNED * BINARY-DOUBLE UNSIGNED * BINARY-DOUBLE * BINARY-C-LONG SIGNED * BINARY-C-LONG UNSIGNED * BINARY-C-LONG ... USE ... Sets up DECLARATIVES_ paragraphs. - USE BEFORE DEBUGGING - USE AFTER EXECEPTION ............ USER-DEFAULT ............ OBJECT-COMPUTER_ clause for locale support. .. sourcecode:: cobolfree CHARACTER CLASSIFICATION IS USER-DEFAULT ..... USING ..... Specifies arguments to CALL_ and in PROCEDURE_ declarations. - BY REFERENCE_ (default, pointer to modifiable data is passed) - BY CONTENT_ (reference to a copy of the data) - BY VALUE_ (actual dereferenced value is placed into call frame) ...... UTF-16 ...... Unsupported internationalization clause. ..... UTF-8 ..... Unsupported internationalization clause. .......... VAL-STATUS .......... Alias for the unsupported VALIDATE-STATUS_ clause of the VALIDATE_ statement. ..... VALID ..... Unsupported. ........ VALIDATE ........ Unsupported data validation verb. ............... VALIDATE-STATUS ............... Unsupported clause of the VALIDATE_ statement. ..... VALUE ..... An CALL_ frame argument modifier. Sets values in data descriptions as well as values used with 88 level conditional names. ...... VALUES ...... Plural of VALUE_ when more than one entry is used in an 88 conditional name. ....... VARYING ....... Sets a looping variable. .. sourcecode:: cobolfree PERFORM VARYING loop-counter FROM 1 BY 1 UNTIL loop-counter > 10 DISPLAY loop-counter END-DISPLAY END-PERFORM .... WHEN .... A very powerful keyword used in EVALUATE phrases for specifying conditional expressions. .. sourcecode:: cobolfree EVALUATE TRUE WHEN A = 10 DISPLAY "A = 10" END-DISPLAY WHEN A = 15 PERFORM A-IS-15 WHEN B IS EQUAL 6 PERFORM B-IS-6 WHEN C IS GREATER THAN 5 DISPLAY "C > 5" END-DISPLAY WHEN OTHER DISPLAY "Default imperative" END-DISPLAY END-EVALUATE .... WITH .... Multi-purpose. - WITH LOCK - DISPLAY WITH screen-attribute - WITH ROLLBACK (pending) ............... WORKING-STORAGE ............... A DATA_ division section. Unless BASED_, all fields are allocated and fixed in memory (for the running program within a module). ..... WRITE ..... Record write. Unlike READ_ that uses filenames syntax, WRITE uses record buffer syntax which must be related to the file through the FD_ file descriptor. OpenCOBOL supports LINAGE_ and WRITE has support for 'report' paging and line control. .. sourcecode:: cobolfree WRITE record-buff END-WRITE WRITE record-name-1 AFTER ADVANCING PAGE END-WRITE. WRITE record-name-1 AT END-OF-PAGE DISPLAY "EOP" END-DISPLAY END-WRITE ....... YYYYDDD ....... Modifies ACCEPT var FROM DAY_ to use full 4 digit year for the Julian date retrieval. .. sourcecode:: cobolfree ACCEPT date-var FROM DAY YYYYDDD ........ YYYYMMDD ........ Modifies ACCEPT var FROM DATE_ to use full 4 digit year. .. sourcecode:: cobolfree ACCEPT date-var FROM DATE YYYYMMDD .... ZERO .... Figurative and numeric constant for the value 0. ...... ZEROES ...... Plural of ZERO_. ..... ZEROS ..... Alternate spelling for ZEROES_. ------------------------------------------------- Does OpenCOBOL implement any Intrinsic FUNCTIONs? ------------------------------------------------- Yes, many. As of the July 2008 1.1 pre-release .. sidebar:: Intrinsic FUNCTION .. contents:: :local: :backlinks: entry :depth: 1 :: ABS, ACOS, ANNUITY, ASIN, ATAN, BYTE-LENGTH, CHAR, CONCATENATE, COS, CURRENT-DATE, DATE-OF-INTEGER, DATE-TO-YYYYMMDD, DAY-OF-INTEGER, DAY-TO-YYYYDDD, E, EXCEPTION-FILE, EXCEPTION-LOCATION, EXCEPTION-STATEMENT, EXCEPTION-STATUS, EXP, EXP10, FACTORIAL, FRACTION-PART, INTEGER, INTEGER-OF-DATE, INTEGER-OF-DAY, INTEGER-PART, LENGTH, LOCALE-DATE, LOCALE-TIME, LOG, LOG10, LOWER-CASE, MAX, MEAN, MEDIAN, MIDRANGE, MIN, MOD, NUMVAL, NUMVAL-C, ORD, ORD-MAX, ORD-MIN, PI, PRESENT-VALUE, RANDOM, RANGE, REM, REVERSE, SECONDS-FROM-FORMATTED-TIME, SECONDS-PAST-MIDNIGHT, SIGN, SIN, SQRT, STANDARD-DEVIATION, STORED-CHAR-LENGTH, SUBSTITUTE, SUBSTITUTE-CASE, SUM, TAN, TEST-DATE-YYYYMMDD, TEST-DAY-YYYYDDD, TRIM, UPPER-CASE, VARIANCE, WHEN-COMPILED, YEAR-TO-YYYY .. Note: More TODO here ............ FUNCTION ABS ............ Absolute value of numeric argument .. sourcecode:: cobolfree DISPLAY FUNCTION ABS(DIFFERENCE). ............. FUNCTION ACOS ............. The ACOS function returns a numeric value (in radians) that approximates the arccosine of the argument. The domain of the arccosine function is -1 to +1. Domain errors return a result of 0. The inverse cosine function returns a range of 0 thru |PISYM| .. sourcecode:: cobolfree DISPLAY FUNCTION ACOS(-1). ................ FUNCTION ANNUITY ................ Compute the ratio of an annuity paid based on arguments of interest and number of periods. .. sourcecode:: cobolfree WORKING-STORAGE SECTION. 77 INTEREST PIC S9V9999 VALUE 0.08. 77 MONTHLY PIC S9V9999 VALUE ZERO. 77 PERIODS PIC 99 VALUE 36. 77 ANNUITY-VALUE PIC S9V9999 VALUE ZERO. PROCEDURE DIVISION. COMPUTE MONTHLY ROUNDED = INTEREST / 12 COMPUTE ANNUITY-VALUE ROUNDED = FUNCTION ANNUITY (MONTHLY PERIODS) DISPLAY "Monthly rate: " MONTHLY " Periods: " PERIODS " Annuity ratio: " ANNUITY-VALUE END-DISPLAY. Outputs:: Monthly rate: +0.0067 Periods: 36 Annuity ratio: +0.0314 ............. FUNCTION ASIN ............. The ASIN function returns a numeric value (in radians) that approximates the arcsine of the argument. The domain of the arcsine function is -1 to +1. Domain errors return a result of 0. The inverse sine function returns a range of -|PISYM|/2 thru |PISYM|/2 .. sourcecode:: cobolfree DISPLAY FUNCTION ASIN(-1). ............. FUNCTION ATAN ............. The ATAN function returns a numeric value (in radians) that approximates the arctangent of the argument. The domain of the arctangent function is all real numbers. The inverse tangent function returns a range of -|PISYM|/2 thru |PISYM|/2 .. sourcecode:: cobolfree DISPLAY FUNCTION ATAN(1). .................... FUNCTION BYTE-LENGTH .................... The BYTE-LENGTH function returns an integer that is the internal storage length of the given argument. .. sourcecode:: cobol COBOL >>SOURCE FORMAT IS FIXED ****************************************************************** * Purpose: demonstrate intrinsic FUNCTION BYTE-LENGTH ****************************************************************** identification division. program-id. bytelength. data division. working-storage section. 01 char-var usage binary-char. 01 short-var usage binary-short. 01 long-var usage binary-long. 01 double-var usage binary-double. 01 num1-var pic 9. 01 num4-var pic 99v99. 01 num9-var pic s9(9). 01 num18-var pic s9(18). 01 num18c-var pic s9(18) usage comp. 01 num18p-var pic s9(18) usage comp-3. 01 edit-var pic $zzzz9.99. 01 string-var pic x(10) value "abc". 01 newline pic x value x'0a'. procedure division. display "num1-var len = " function byte-length(num1-var) newline "num4-var len = " function byte-length(num4-var) newline "num9-var len = " function byte-length(num9-var) newline "num18-var len = " function byte-length(num18-var) newline "num18c-var len = " function byte-length(num18c-var) newline "num18p-var len = " function byte-length(num18p-var) newline "edit-var len = " function byte-length(edit-var) newline "12 len = " function byte-length(12) newline "12.12 len = " function byte-length(12.12) newline "1234567890.123 = " function byte-length(1234567890.123) newline "string-var len = " function byte-length(string-var) newline "trim string = " function byte-length(function trim(string-var)) newline "char-var len = " function byte-length(char-var) newline "short-var len = " function byte-length(short-var) newline "long-var len = " function byte-length(long-var) newline "double-var len = " function byte-length(double-var) end-display goback. exit program. Outputs:: num1-var len = 1 num4-var len = 4 num9-var len = 9 num18-var len = 18 num18c-var len = 8 num18p-var len = 10 edit-var len = 9 12 len = 2 12.12 len = 4 1234567890.123 = 13 string-var len = 10 trim string = 00000003 char-var len = 1 short-var len = 2 long-var len = 4 double-var len = 8 ............. FUNCTION CHAR ............. The CHAR function returns a ONE character alphanumeric field whose value is the character in the current collating sequence having the ordinal position equal to the value of the integer argument. The argument must be greater than 0 and less than or equal to the number of positions in the collating sequence. Errors in the argument range return 0 (the LOW-VALUE by default). See ASCII_ or EBCDIC_ and details of the ALPHABET_ clause. DISPLAY FUNCTION CHAR(66). Would output **A** in the ASCII character set. Note this may be different than what some expect. OpenCOBOL CHAR is 1 thru 128 not 0 thru 127 as a C programmer may be used to. *And to add a little confusion, most personal computers use an extended character set, usually erroneously called ASCII with a range of 0 to 255. A more appropriate name may be ISO-8859-1 Latin 1.* See ASCII_ for more accurate details. This author is often guilty of this misnomer of the use of the term ASCII. ........................... FUNCTION COMBINED-DATETIME ........................... Returns a common datetime form from integer date (years and days from 1600 to 10000) and numeric time arguments (seconds in day). Date should be from 1 to 3067671 and time should be from 1 to 86400. The character string returned is in the form 7.5. .. sourcecode:: cobolfree DISPLAY FUNCTION COMBINED-DATETIME(1; 1) END-DISPLAY Outputs:: 0000001.00001 .................... FUNCTION CONCATENATE .................... Concatenate the given fields. CONCATENATE is an OpenCOBOL extension. .. sourcecode:: cobolfree MOVE "COBOL" TO stringvar MOVE FUNCTION CONCATENATE("Open"; stringvar) TO goodsystem DISPLAY goodsystem END-DISPLAY ............ FUNCTION COS ............ The COS function returns a numeric value that approximates the cosine of the argument (in radians). The domain of the cosine function is all real numbers, with a nominal domain of 0 thru |PISYM| with a zero returned at |PISYM|/2. The cosine function returns a range of -1 thru +1. .. sourcecode:: cobolfree DISPLAY FUNCTION COS(1.5707963267949). ..................... FUNCTION CURRENT-DATE ..................... Returns an alphanumeric field of length 21 with the current date, time and timezone information in the form YYYYMMDDhhmmsscc\ |plusminus|\ tznn .. sourcecode:: cobolfree DISPLAY FUNCTION CURRENT-DATE. Example Output:: 2008080921243796-0400 ........................ FUNCTION DATE-OF-INTEGER ........................ Converts an integer date, days on the Gregorian since December 31 1600 to YYYYMMDD form .. sourcecode:: cobolfree DISPLAY DATE-OF-INTEGER(1) DISPLAY DATE-OF-INTEGER(50000) Outputs:: 16010101 17371123 50,000 days after December 31, 1600 being November 23rd, 1737. ......................... FUNCTION DATE-TO-YYYYMMDD ......................... Converts a two digit year date format to four digit year form using a sliding window pivot of the optional second argument. The pivot defaults to 50. The OpenCOBOL implementation of DATE-TO-YYYYMMDD also accepts an optional third argument, replacing the default century value of 1900 and is treated as the years added to the given year portion of the first argument and modified by the sliding 100 window pivot. Domain errors occur for year values less than 1600 and greater than 999,999. There is no validation of the input date. Because of the sliding window, this function is dependent on the date of evaluation .. sourcecode:: cobolfree DISPLAY FUNCTION DATE-TO-YYYYMMDD(000101) DISPLAY FUNCTION DATE-TO-YYYYMMDD(500101) DISPLAY FUNCTION DATE-TO-YYYYMMDD(610101) DISPLAY FUNCTION DATE-TO-YYYYMMDD(990101) DISPLAY FUNCTION DATE-TO-YYYYMMDD(990101, 50, 1900) DISPLAY FUNCTION DATE-TO-YYYYMMDD(990101, -10, 1900) DISPLAY FUNCTION DATE-TO-YYYYMMDD(990101, 50, 2000) DISPLAY FUNCTION DATE-TO-YYYYMMDD(990101, 50, 2100) When run in August, 2008 produces:: 20000101 20500101 19610101 19990101 18990101 17990101 19990101 20990101 ....................... FUNCTION DAY-OF-INTEGER ....................... Converts a Gregorian integer date form to Julian date form (YYYDDD) based on days since December 31, 1600. Errors return 0 .. sourcecode:: cobolfree DISPLAY FUNCTION DAY-OF-INTEGER(97336). 1867182 97,336 days after 16001231 being the 182nd day of the year 1867. Canada's date of Confederation and recognized birthday. ....................... FUNCTION DAY-TO-YYYYDDD ....................... Converts a Julian 2 digit year and three digit dat integer to a four digit year form. See `FUNCTION DATE-TO-YYYYMMDD`_ for some of the details of the calculations involved. .......... FUNCTION E .......... Returns Euler's number as an alphanumeric field to 34 digits of accuracy after the decimal. E forms the base of the natural logarithms. It has very unique and important properies such as: * the derivative of e\ :superscript:`x` is e\ :superscript:`x` * and the area below the curve of *y = 1/x* for *1 <= x <= e* is exactly 1. * making it very useful in calculations of Future Value with compound interest. .. sourcecode:: cobolfree DISPLAY FUNCTION E END-DISPLAY outputs:: 2.7182818284590452353602874713526625 A small graph to show the magic area. .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 29-May-2009, Modified 20110505 to add e tic mark *> Purpose: Plot Euler's number (using integral of 1 over x) *> Tectonics: requires access to gnuplot. http://www.gnuplot.info *> cobc -Wall -x ploteuler.cob *> OVERWRITES ocgenplot.gp, ocgpdata.txt and images/euler.png *> *************************************************************** identification division. program-id. ploteuler. environment division. input-output section. file-control. select scriptfile assign to "ocgenplot.gp" organization is line sequential. select outfile assign to "ocgpdata.txt" organization is line sequential. data division. file section. fd scriptfile. 01 gnuplot-command pic x(82). fd outfile. 01 outrec. 03 x-value pic -z9.999. 03 filler pic x. 03 y-value pic -z9.999. working-storage section. 01 xstep pic 9v99999. 01 x pic 9v99999. 01 recip pic 9v99999. *> The plot command is xrange 0:3, y 0:2 data col 1 for x 2 for y 01 gpcmds pic x(400) value is "set style fill solid 1.0; " & "set grid; " & "set xtics add ('e' 2.718281); " & "plot [0:3] [0:2] 'ocgpdata.txt' using 1:2 \ " & " with filledcurves below x1 title '1/x'; " & "set terminal png; " & "set output 'images/euler.png'; " & "replot ". 01 line-cnt pic 999. 01 gptable. 05 gpcmd pic x(50) occurs 8 times. 01 gplot pic x(40) value is 'gnuplot -persist ocgenplot.gp'. 01 result pic s9(9). *> *************************************************************** procedure division. display function e end-display *><* Create the script to plot the area of Euler's number open output scriptfile. move gpcmds to gptable perform varying line-cnt from 1 by 1 until line-cnt > 8 move gpcmd(line-cnt) to gnuplot-command write gnuplot-command end-write end-perform close scriptfile *><* Create the reciprocal data open output outfile move spaces to outrec compute xstep = function e / 100 end-compute perform with test after varying x from 1 by xstep until x >= function e if x > function e move function e to x-value else move x to x-value end-if compute recip = 1 / x end-compute move recip to y-value write outrec end-write end-perform close outfile *><* Invoke gnuplot call "SYSTEM" using gplot returning result end-call if result not = 0 display "Problem: " result end-display stop run returning result end-if goback. end program ploteuler. The area in red is exactly 1. *Well, not on this plot exactly, as it is somewhat sloppy with the xstep end case and the precisions.* .. image:: images/euler.png See `Can OpenCOBOL be used for plotting?`_ for some details on plotting. ....................... FUNCTION EXCEPTION-FILE ....................... This special-register holds the error number and name of the source file that caused an input output exception. See `FUNCTION EXCEPTION-STATUS`_ for an example. ........................... FUNCTION EXCEPTION-LOCATION ........................... This special-register can be queried for the location of the last exception. See `FUNCTION EXCEPTION-STATUS`_ for example source code. Note: This feature requires compilation with *-fsource-location* compiler switch. This option is also turned on with *-g* and *-debug* debugging info compiles. Information includes PROGRAM-ID, section and source line. ............................ FUNCTION EXCEPTION-STATEMENT ............................ This special-register holds the statement that was executing when the latest exception was raised. See `FUNCTION EXCEPTION-STATUS`_ for an example. Note: This feature requires compilation with *-fsource-location* compiler switch. This option is also turned on with *-g* debugging info compiles. ......................... FUNCTION EXCEPTION-STATUS ......................... This FUNCTION returns the current exception status. The example below is courtesy of Roger While, from a post he made announcing the *FUNCTION EXCEPTION-* features. Source format is free, compile with *cobc -x -g -free except.cob* .. sourcecode:: cobolfree IDENTIFICATION DIVISION. PROGRAM-ID. MINIPROG. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. LINUX. OBJECT-COMPUTER. LINUX. SPECIAL-NAMES. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT PRINTFILE ASSIGN TO "XXRXWXX" FILE STATUS RXWSTAT. DATA DIVISION. FILE SECTION. FD PRINTFILE. 01 PRINTREC PIC X(132). WORKING-STORAGE SECTION. 01 RXWSTAT PIC XX. PROCEDURE DIVISION. A00-MAIN SECTION. 001-MAIN-PROCEDURE. OPEN INPUT PRINTFILE. DISPLAY "File Status: " RXWSTAT. DISPLAY "EXCEPTION-FILE: " FUNCTION EXCEPTION-FILE. DISPLAY "Return Length: " FUNCTION LENGTH (FUNCTION EXCEPTION-FILE). DISPLAY "EXCEPTION-STATUS: " FUNCTION EXCEPTION-STATUS. DISPLAY "EXCEPTION-STATEMENT: " FUNCTION EXCEPTION-STATEMENT. STRING "TOOLONG" DELIMITED SIZE INTO RXWSTAT. DISPLAY "EXCEPTION-STATUS: " FUNCTION EXCEPTION-STATUS. DISPLAY "EXCEPTION-STATEMENT: " FUNCTION EXCEPTION-STATEMENT. DISPLAY "EXCEPTION-LOCATION: " FUNCTION EXCEPTION-LOCATION. STOP RUN. Example output:: File Status: 35 EXCEPTION-FILE: 35PRINTFILE Return Length: 00000011 EXCEPTION-STATUS: EC-I-O-PERMANENT-ERROR EXCEPTION-STATEMENT: OPEN EXCEPTION-STATUS: EC-OVERFLOW-STRING EXCEPTION-STATEMENT: STRING EXCEPTION-LOCATION: MINIPROG; 001-MAIN-PROCEDURE OF A00-MAIN; 29 .. TIP:: See the source file libcob/exception.def for a list of the plethora of run-time exceptions supported by OpenCOBOL. ............ FUNCTION EXP ............ Returns an approximation of Euler's number (see `FUNCTION E`_) raised to the power of the numeric argument. .. sourcecode:: cobolfree DISPLAY FUNCTION EXP(1) END-DISPLAY outputs:: 2.718281828459045091 .. Note:: Be aware that this approximation seems accurate to "only" 15 decimal places. Diligent programmers need to be aware of the foibles of floating point mathematics and take these issues into consideration. .............. FUNCTION EXP10 .............. Returns an approximation of the value 10 raised to the power of the numeric argument. .. sourcecode:: cobolfree DISPLAY FUNCTION EXP10(1.0) END-DISPLAY DISPLAY FUNCTION EXP10(1.2) END-DISPLAY DISPLAY FUNCTION EXP10(10) END-DISPLAY Outputs:: 10.000000000000000000 15.848931924611132871 10000000000.000000000000000000 .................. FUNCTION FACTORIAL .................. Computes the factorial of the integral argument. Valid Range of 0 to 19 with a domain of 1 to 121645100408832000. .. sourcecode:: cobol OCOBOL*> *************************************************************** *> Program to find range and domain of FUNCTION FACTORIAL identification division. program-id. fact. data division. working-storage section. 01 ind pic 999. 01 result pic 9(18). *> *************************************************************** procedure division. perform varying ind from 0 by 1 until ind > 20 add zero to function factorial(ind) giving result on size error display "overflow at " ind end-display end-add display ind " = " function factorial(ind) end-display end-perform goback. end program fact. .. *><* Outputs:: 000 = 000000000000000001 001 = 000000000000000001 002 = 000000000000000002 003 = 000000000000000006 004 = 000000000000000024 005 = 000000000000000120 006 = 000000000000000720 007 = 000000000000005040 008 = 000000000000040320 009 = 000000000000362880 010 = 000000000003628800 011 = 000000000039916800 012 = 000000000479001600 013 = 000000006227020800 014 = 000000087178291200 015 = 000001307674368000 016 = 000020922789888000 017 = 000355687428096000 018 = 006402373705728000 019 = 121645100408832000 overflow at 020 020 = 432902008176640000 Kind of the same thing, with some zero out formatting. .. sourcecode:: cobol OCOBOL*> *************************************************************** *> Program to find range and domain of FUNCTION FACTORIAL identification division. program-id. fact. data division. working-storage section. 01 ind pic 99. 01 z-ind pic z9. 01 result pic 9(18). 01 pretty-result pic z(17)9. *> *************************************************************** procedure division. perform varying ind from 0 by 1 until ind > 21 add zero to function factorial(ind) giving result on size error display "overflow at " ind ", result undefined: " function factorial(ind) end-display not on size error move ind to z-ind move result to pretty-result display "factorial(" z-ind ") = " pretty-result end-display end-add end-perform goback. end program fact. .. *><* Which outputs:: factorial( 0) = 1 factorial( 1) = 1 factorial( 2) = 2 factorial( 3) = 6 factorial( 4) = 24 factorial( 5) = 120 factorial( 6) = 720 factorial( 7) = 5040 factorial( 8) = 40320 factorial( 9) = 362880 factorial(10) = 3628800 factorial(11) = 39916800 factorial(12) = 479001600 factorial(13) = 6227020800 factorial(14) = 87178291200 factorial(15) = 1307674368000 factorial(16) = 20922789888000 factorial(17) = 355687428096000 factorial(18) = 6402373705728000 factorial(19) = 121645100408832000 overflow at 20, result undefined, 432902008176640000 overflow at 21, result undefined, 197454024290336768 ...................... FUNCTION FRACTION-PART ...................... Returns a numeric value that is the fraction part of the argument. Keeping the sign. .. sourcecode:: cobolfree DISPLAY FUNCTION FRACTION-PART(FUNCTION E) END-DISPLAY DISPLAY FUNCTION FRACTION-PART(-1.5) END-DISPLAY DISPLAY FUNCTION FRACTION-PART(-1.0) END-DISPLAY DISPLAY FUNCTION FRACTION-PART(1) END-DISPLAY Outputs:: +.718281828459045235 -.500000000000000000 +.000000000000000000 +.000000000000000000 ................ FUNCTION INTEGER ................ Returns the greatest integer less than or equal to the numeric argument. .. sourcecode:: cobolfree DISPLAY FUNCTION INTEGER (-3) SPACE FUNCTION INTEGER (-3.141) END-DISPLAY DISPLAY FUNCTION INTEGER (3) SPACE FUNCTION INTEGER (3.141) END-DISPLAY DISPLAY FUNCTION INTEGER (-0.3141) SPACE FUNCTION INTEGER (0.3141) SPACE FUNCTION INTEGER (0) END-DISPLAY Outputs:: -000000000000000003 -000000000000000004 +000000000000000003 +000000000000000003 -000000000000000001 +000000000000000000 +000000000000000000 Note the -4, greatest integer **less than or equal to** the argument. ........................ FUNCTION INTEGER-OF-DATE ........................ Converts a date in the Gregorian calender to an integer form. Expects a numeric argument in the form *YYYYMMDD* based on years greater than or equal to 1601 and less than 10000. Month values range from 1 to 12. Days range from 1 to 31 and should be valud for the specified month and year. Invalid input returns unpredictable results and sets the exception EC-ARGUMENT-FUNCTION to exist. See `FUNCTION DATE-OF-INTEGER`_ for the converse function. ....................... FUNCTION INTEGER-OF-DAY ....................... Converts a Julian date of YYYYDDD to integer date form. See `FUNCTION DAY-OF-INTEGER`_ for the converse intrinsic function. Invalid arguments return an undefined result and set the exception EC-ARGUMENT-FUNCTION to exist. ..................... FUNCTION INTEGER-PART ..................... Returns the integer part of the numeric argument. Similar to `FUNCTION INTEGER`_ but returns different values for negative arguments. .. sourcecode:: cobolfree DISPLAY FUNCTION INTEGER-PART (-3) SPACE FUNCTION INTEGER-PART (-3.141) END-DISPLAY DISPLAY FUNCTION INTEGER-PART (3) SPACE FUNCTION INTEGER-PART (3.141) END-DISPLAY DISPLAY FUNCTION INTEGER-PART (-0.3141) SPACE FUNCTION INTEGER-PART (0.3141) SPACE FUNCTION INTEGER-PART (0) END-DISPLAY Outputs:: -000000000000000003 -000000000000000003 +000000000000000003 +000000000000000003 +000000000000000000 +000000000000000000 +000000000000000000 ............... FUNCTION LENGTH ............... Returns an integer that is the length in character positions of the given argument. .. sourcecode:: cobolfree working storage. 01 nat pic n(10). 01 cha pic x(10). 01 bin constant as h'ff'. 01 num pic s9(8)v9(8). 01 form pic $-z(7)9.9(8). procedure division. display function length(nat) space function length(cha) space function length(bin) end-display display function length(num) space function length(form) end-display Outputs:: 20 10 3 16 19 .................... FUNCTION LOCALE-DATE .................... Returns a culturally appropriate date given an alphanumeric of 8 character positions in the form "YYYYMMDD" and an optional locale name that has been associted with a locale in the SPECIAL-NAMES paragraph. See http://en.wikipedia.org/wiki/Locale for a start at the very detail rich computational requirements of LOCALE. Will set EC-ARGUMENT-FUNCTION to exist for invalid input. .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 20120116 *> Purpose: Demonstrate locale functions *> Tectonics: cobc -x locales.cob *> *************************************************************** identification division. program-id. locales. environment division. configuration section. repository. function all intrinsic. *> -*********-*********-*********-*********-*********-*********-** procedure division. *> Display cultural norm date and times as set in environment. *> Google LC_ALL. *> 20120622 represents June 22 2012 *> 141516 represents 2pm (14th hour), 15 minutes, 16 seconds *> 39600 represents 11 hours in seconds display locale-date(20120622) end-display display locale-time(141516) end-display display locale-time-from-seconds(39600) end-display goback. end program locales. .. *><* Which produced:: [btiffin@home cobol]$ cobc -x locales.cob [btiffin@home cobol]$ ./locales 06/22/2012 02:15:16 PM 11:00:00 AM I live in Canada, but usually run Fedora with LANG=en_US.utf8 and so :: [btiffin@home cobol]$ export LANG='en_CA.utf8' [btiffin@home cobol]$ ./locales 22/06/12 02:15:16 PM 11:00:00 AM Joy, year month day form. Sad, 2 digit year? What kinda backwater land do I live in? Time to write strongly worded letters to some committees. :) I just looked, and it seems Canada is listed as DD/MM/YY; I'm moving to Germany. :: [btiffin@home cobol]$ export LANG=en_DK.utf8 [btiffin@home cobol]$ ./locales 2012-06-22 14:15:16 11:00:00 Joy. year month day. Hmm, what about Hong Kong? :: [btiffin@home cobol]$ LANG=en_HK.utf8 ./locales Sunday, June 22, 2012 02:15:16 EST 11:00:00 EST Nice. If you want to run your system through its locales, try .. sourcecode:: bash $ locs=( $(locale -a) ) $ for l in ${locs[@]}; do echo $l; LANG=$l ./locales; done and expect some unicode in the output. .................... FUNCTION LOCALE-TIME .................... Returns a culturally appropriate date given an alphanumeric of 6 character positions in the form "HHMMSS" and an optional locale name that has been associted with a locale in the SPECIAL-NAMES paragraph. See http://en.wikipedia.org/wiki/Locale for a start at the very detail rich computational requirements of LOCALE. Will set EC-ARGUMENT-FUNCTION to exist for invalid input. See `FUNCTION LOCALE-DATE`_. ................................. FUNCTION LOCALE-TIME-FROM-SECONDS ................................. Returns a culturally appropriate date given an alphanumeric number of seconds and an optional locale name that has been associted with a locale in the SPECIAL-NAMES paragraph. See http://en.wikipedia.org/wiki/Locale for a start at the very detail rich computational requirements of LOCALE. Will set EC-ARGUMENT-FUNCTION to exist for invalid input. See `FUNCTION LOCALE-DATE`_. ............ FUNCTION LOG ............ Returns an approximation of the natural logarithmic value of the given numeric argument. Uses a base of `FUNCTION E`_. .. sourcecode:: cobolfree DISPLAY FUNCTION LOG(100) END-DISPLAY DISPLAY FUNCTION LOG(FUNCTION E) END-DISPLAY gives:: 4.60517018598809137 000000001 .............. FUNCTION LOG10 .............. Returns an approximation of the base-10 logarithmic value of the given numeric argument. .. sourcecode:: cobolfree DISPLAY FUNCTION LOG10(100) END-DISPLAY gives:: 000000002 ................... FUNCTION LOWER-CASE ................... Convert any uppercase character values (A-Z) in the argument to lowercase (a-z). ............ FUNCTION MAX ............ Returns the maximum value from the list of arguments. .. sourcecode:: cobolfree DISPLAY FUNCTION MAX ( "def"; "abc";) END-DISPLAY DISPLAY FUNCTION MAX ( 123.1; 123.11; 123) END-DISPLAY Outputs:: def 123.11 ............. FUNCTION MEAN ............. Returns the arithmetic mean (average) of the list of numeric arguments. .. sourcecode:: cobolfree DISPLAY FUNCTION MEAN(1; 2; 3; 4; 5; 6; 7; 8; 9) END-DISPLAY Outputs:: +5.00000000000000000 ............... FUNCTION MEDIAN ............... Returns the middle value of the arguments formed by arranging the list in sorted order. .. sourcecode:: cobolfree DISPLAY FUNCTION MEDIAN(1; 2; 3; 4; 5; 6; 7; 8; 9) END-DISPLAY Outputs:: 5 ................. FUNCTION MIDRANGE ................. Returns the arithmetic mean (average) of the minimum and maximum argument from the list of numeric arguments. .. sourcecode:: cobolfree DISPLAY FUNCTION MIDRANGE(1; 2; 3; 4; 5; 6; 7; 8; 9) END-DISPLAY Outputs:: 5.000000000000000000 ............ FUNCTION MIN ............ Returns the minimum value from the list of arguments. .. sourcecode:: cobolfree DISPLAY FUNCTION MIN ( "def"; "abc";) END-DISPLAY DISPLAY FUNCTION MIN ( 123.1; 123.11; 123) END-DISPLAY Outputs:: abc 123 ............ FUNCTION MOD ............ Returns an integer value of that is the first-argument modulo second-argument. .. sourcecode:: cobolfree DISPLAY FUNCTION MOD(123; 23) END-DISPLAY Outputs:: +000000000000000008 ............... FUNCTION NUMVAL ............... Returns the numeric value represented by the character string argument. .. sourcecode:: cobol OCOBOL IDENTIFICATION DIVISION. PROGRAM-ID. prog. DATA DIVISION. WORKING-STORAGE SECTION. 01 X PIC X(12) VALUE " -9876.1234 ". 01 F PIC X(12) VALUE "B-9876.1234 ". PROCEDURE DIVISION. DISPLAY FUNCTION NUMVAL ( X ) DISPLAY FUNCTION NUMVAL ( F ) END-DISPLAY. STOP RUN. gives:: -09876.1234 000000000 The "B" in field F, breaks the numeric conversion. NUMVAL is actually fairly complicated and forgiving of inputs, but will return 0 on invalid numeric conversions. OpenCOBOL 2 will also provide FUNCTION TEST-NUMVAL. ................. FUNCTION NUMVAL-C ................. Returns the numeric value represented by the culturally appropriate currency specification argument. .. sourcecode:: cobol OCOBOL IDENTIFICATION DIVISION. PROGRAM-ID. prog. DATA DIVISION. WORKING-STORAGE SECTION. 01 X PIC X(14) VALUE " % -9876.1234 ". PROCEDURE DIVISION. DISPLAY FUNCTION NUMVAL-C ( X , "%" ) END-DISPLAY. STOP RUN. gives:: -09876.1234 in a LOCALE that uses the percent sign as a currency symbol. OpenCOBOL 2 will also provide FUNCTION TEST-NUMVAL-C. ............ FUNCTION ORD ............ Returns the integer value that is the ordinal position of the character argument in the program's collating sequence. COBOL uses 1 as the lowest ordinal for character sequencing. .. sourcecode:: cobolfree DISPLAY FUNCTION ORD("J") END-DISPLAY Outputs (on an ASCII system with no ALPHABET clause):: 00000075 Note that COBOL uses 1 as the first value for collating. So ASCII 74 is ORD 75 for "J". ................ FUNCTION ORD-MAX ................ Returns the integer that is the ordinal position of the maximum value of the given argument list. .. sourcecode:: cobolfree DISPLAY ORD-MAX(9; 8; 7; 6; 5; 4; 3; 2; 1) END-DISPLAY DISPLAY ORD-MAX('abc'; 'def'; 'ghi') END-DISPLAY Outputs:: 00000001 00000003 ................ FUNCTION ORD-MIN ................ Returns the integer that is the ordinal position of the minimum value from the argument list. .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 20090531 *> Purpose: Demonstration of FUNCTION ORD-MIN and REPOSITORY *> Tectonics: cobc -x ordmin.cob *> *************************************************************** identification division. program-id. ordmin. environment division. configuration section. repository. function all intrinsic. data division. working-storage section. 01 posmin pic 9(8). *> *************************************************************** procedure division. move ord-min (9; 8; 7; 6; 5; 4; 3; 2; 1; 2; 3; 4; 5) to posmin display posmin end-display move ord-min ("abc"; "def"; "000"; "def"; "abc") to posmin display posmin end-display goback. end program ordmin. Outputs:: 00000009 00000003 Notice how ord-min did not require FUNCTION, as the REPOSITORY entry allows this to be skipped in the source codes. ............ FUNCTION PI ............ Returns an approximation of the ratio of the circumference by the diameter of a circle. It returns an alphanumeric with 34 digits after the decimal. Please be aware of the limitations of using these types of approximated values in computations. .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 20101030 *> Purpose: Demonstrate PI *> Tectonics: cobc -x pi-demo.cob *> *************************************************************** identification division. program-id. pi-demo. data division. working-storage section. 01 args pic x(80). 01 diameter pic 999 value 1. 01 show-diameter pic zz9. 01 circumference usage float-long. 01 plural pic xx. 01 plural-length pic 9 value 1. 01 newline pic x value x'0a'. *> *************************************************************** procedure division. accept args from command-line end-accept if args not equal spaces move args to diameter end-if if diameter not equal 1 move "s " to plural move 2 to plural-length else move " " to plural move 1 to plural-length end-if move diameter to show-diameter display "FUNCTION PI is " function pi newline end-display compute circumference = function pi * diameter end-compute display "A wheel, " show-diameter " metre" plural(1:plural-length) "wide will roll, very close to but only approximately, " newline circumference " metres in ONE full rotation." newline end-display goback. end program pi-demo. Outputs:: $ cobc -x pi-demo.cob && ./pi-demo && ./pi-demo 42 FUNCTION PI is 3.1415926535897932384626433832795029 A wheel, 1 metre wide will roll, very close to but only approximately, 3.14159265358979312 metres in ONE full rotation. FUNCTION PI is 3.1415926535897932384626433832795029 A wheel, 42 metres wide will roll, very close to but only approximately, 131.946891450771318 metres in ONE full rotation. ...................... FUNCTION PRESENT-VALUE ...................... Returns an approximation of the present value from a discount rate and list of future period end amounts. It attempts to reflect the future value of $1.00 given time, inflation and interest. .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 20101030 *> Purpose: Demo of PRESENT-VALUE *> Tectonics: cobc -x present-value-demo.cob *> *************************************************************** identification division. program-id. present-value-demo. data division. working-storage section. 01 args pic x(80). 01 newline pic x value x'0a'. 01 rate pic s9v9999 value 0.7000. 01 the-value pic s9(6)v99. *> *************************************************************** procedure division. accept args from command-line end-accept if args not equal to spaces move args to rate end-if compute the-value rounded = function present-value(rate; 1000, 1010, 1000, 1100) end-compute display "A discount rate of " rate " gives a PRESENT-VALUE of " the-value " given" newline "end-amounts of 1000, 1010, 1000 and 1100" end-display compute the-value rounded = function present-value(rate; 1000, 1000, 1000, 1000) end-compute display "A discount rate of " rate " gives a PRESENT-VALUE of " the-value " given" newline "end-amounts of 1000, 1000, 1000 and 1000" end-display goback. end program present-value-demo. Outputs:: $ ./present-value-demo A discount rate of +0.7000 gives a PRESENT-VALUE of +001272.96 given end-amounts of 1000, 1010, 1000 and 1100 A discount rate of +0.7000 gives a PRESENT-VALUE of +001257.53 given end-amounts of 1000, 1000, 1000 and 1000 $ ./present-value-demo 0.333 A discount rate of +0.3330 gives a PRESENT-VALUE of +002089.18 given end-amounts of 1000, 1010, 1000 and 1100 A discount rate of +0.3330 gives a PRESENT-VALUE of +002051.88 given end-amounts of 1000, 1000, 1000 and 1000 $ ./present-value-demo 0.935 A discount rate of +0.9350 gives a PRESENT-VALUE of +001003.03 given end-amounts of 1000, 1010, 1000 and 1100 A discount rate of +0.9350 gives a PRESENT-VALUE of +000993.23 given end-amounts of 1000, 1000, 1000 and 1000 For details, talk to a professional. *rant* Any COBOL programmer using financial functions for use by others **HAS** to attain some level of *domain expertise* in the mathematics at work, as well as a level of *technical competence* to read through and defend both the COBOL source code and the generated C code that OpenCOBOL emits before compiling. *rant over* ............... FUNCTION RANDOM ............... Returns a pseudo-random number given a numeric seed value as argument. .. sourcecode:: cobolfree DISPLAY FUNCTION RANDOM(1) END-DISPLAY DISPLAY FUNCTION RANDOM(1) END-DISPLAY DISPLAY FUNCTION RANDOM() END-DISPLAY Outputs:: +00000000.1804289383 +00000000.1804289383 +000000000.846930886 .............. FUNCTION RANGE .............. Returns the value of the minimum argument subtracted from the maximum argument from the list of numeric arguments. .. sourcecode:: cobolfree DISPLAY FUNCTION RANGE(1; 2; 3; 4; 5; 6; 7; 8; 9) END-DISPLAY Outputs:: +000000000000000008 ............ FUNCTION REM ............ Returns the numeric remainder of the first argument divided by the second. .. sourcecode:: cobolfree DISPLAY FUNCTION REM(123; 23) END-DISPLAY Outputs:: +000000000000000008 ................ FUNCTION REVERSE ................ Returns the reverse of the given character string. .. sourcecode:: cobolfree DISPLAY FUNCTION REVERSE("abc") END-DISPLAY Outputs:: cba .................................... FUNCTION SECONDS-FROM-FORMATTED-TIME .................................... This function converts a time that is in a specified format to a numeric value representing the number of seconds after midnight. .. sourcecode:: cobol OCOBOL IDENTIFICATION DIVISION. PROGRAM-ID. prog. DATA DIVISION. WORKING-STORAGE SECTION. 01 X PIC X(6) VALUE "hhmmss". 01 Y PIC 9(8) COMP-5. 01 Z PIC X(6) VALUE "010203". PROCEDURE DIVISION. MOVE FUNCTION SECONDS-FROM-FORMATTED-TIME (X, Z) TO Y. IF Y NOT = 3723 DISPLAY Y END-DISPLAY END-IF. STOP RUN. This test would fail if 01:02:03 was not returned as 3723 seconds past midnight. Argumenent 1 takes the form *hhmmss* and expectes argument 2 to be a matching length numeric item, or 0 is returned. .............................. FUNCTION SECONDS-PAST-MIDNIGHT .............................. Returns the seconds past midnight from the current system time. ............. FUNCTION SIGN ............. Returns +1 for positive, 0 for zero and -1 for a negative numeric argument. ............ FUNCTION SIN ............ Returns an approximation for the trigonometric sine of the given numeric angle (expressed in radians) argument. See `Can OpenCOBOL be used for plotting?`_ for a sample graph using gnuplot. ............. FUNCTION SQRT ............. Returns an approximation of the square root of the given numeric argument. .. sourcecode:: cobolfree DISPLAY FUNCTION SQRT(-1) END-DISPLAY CALL "perror" USING NULL END-CALL DISPLAY FUNCTION SQRT(2) END-DISPLAY Outputs:: 0.000000000000000000 Numerical argument out of domain 1.414213562373095145 Note: CALL "perror" reveals a bug in OpenCOBOL versions packaged before June 2009 where the stack will evetually underflow due to improper handling of the **void** return specification. Versions supporting RETURNING NULL fix this problem. An actual application that needed to verify the results of square roots or other numerical function would be better off placing a small C wrapper to set and get the global errno_. ........................... FUNCTION STANDARD-DEVIATION ........................... Returns an approximation of the standard deviation from the given list of numeric arguments. .. sourcecode:: cobolfree DISPLAY FUNCTION STANDARD-DEVIATION(1 2 3 4 5 6 7 8 9 10) SPACE FUNCTION STANDARD-DEVIATION(1 2 3 4 5 6 7 8 9 100) END-DISPLAY :: 2.872281323269014308 28.605069480775604518 ........................... FUNCTION STORED-CHAR-LENGTH ........................... Returns the numeric value of the internal storage length of the given argument in bytes, not counting spaces. ................... FUNCTION SUBSTITUTE ................... FUNCTION SUBSTITUTE is an OpenCOBOL extension to the suite of intrinsic functions. .. sourcecode:: cobolfree DISPLAY FUNCTION SUBSTITUTE("this is a test", "this", "that", "is a", "was", "test", "very cool!") END-DISPLAY Will display:: that was very cool! having changed *this* for *that*, *is a* for *was* and *test* with **very cool!** The new intrinsic accepts:: SUBSTITUTE(subject, lit-pat-1, repl-1 [, litl-pat-2, repl-2, ...]) *where lit-pat just means the scan is for literals, not that you have to use literal constants.* WORKING-STORAGE identifiers are fine for any of the subject, the search patterns or the replacements. As with all intrinsics, you receive a new field and the subject is untouched. .. Note:: The resulting field can be shorter, the same length or longer than the subject string. This is literal character **global** find and replace, and there are no wildcards or other pattern expressions. Unlike INSPECT, this function **does not require same length** patterns and replacements. Each pattern replacement pair uses the original subject, not any intermediate in progress result. As this is an alphanumeric operation, a reference modification is also allowed .. sourcecode:: cobolfree MOVE FUNCTION SUBSTITUTE(subject, pat, repl)(2:4) TO xvar4 to result in 4 characters starting at the second position after the substitution. ........................ FUNCTION SUBSTITUTE-CASE ........................ Similar to SUBSTITUTE, but ignores upper and lower case of subject when matching patterns. ............ FUNCTION SUM ............ Returns the numeric value that is the sum of the given list of numeric arguments. ............ FUNCTION TAN ............ Returns an approximation for the trigonometric tangent of the given numeric angle (expressed in radians) argument. Returns ZERO if the argument would cause an infinity or other size error. ........................... FUNCTION TEST-DATE-YYYYMMDD ........................... Test for valid date in numeric yyyymmdd form. ......................... FUNCTION TEST-DAY-YYYYDDD ......................... Test for valid date in numeric yyyyddd form. ............. FUNCTION TRIM ............. Returns a character string that is the argument trimmed of spaces. Defaults to trimming both ends, but can be passed LEADING or TRAILING qualifier arguments. .. sourcecode:: cobolfree DISPLAY '"' FUNCTION TRIM(" abc ") '"' END-DISPLAY DISPLAY '"' FUNCTION TRIM(" abc " LEADING) '"' END-DISPLAY DISPLAY '"' FUNCTION TRIM(" abc " TRAILING) '"' END-DISPLAY Outputs:: "abc" "abc " " abc" ................... FUNCTION UPPER-CASE ................... Returns a copy of the alphanumeric argument with any lower case letters replaced by upper case letters. .. sourcecode:: cobolfree DISPLAY FUNCTION UPPER-CASE("# 123 abc DEF #") END-DISPLAY Outputs:: # 123 ABC DEF # ................. FUNCTION VARIANCE ................. Returns the variance of a series of numbers. The variance is defined as the square of the `FUNCTION STANDARD-DEVIATION`_ .. sourcecode:: cobolfree DISPLAY FUNCTION VARIANCE(1 2 3 4 5 6 7 8 9 100) END-DISPLAY. :: +818.250000000000000 ...................... FUNCTION WHEN-COMPILED ...................... Returns a 21 character alphanumeric field of the form YYYYMMDDhhmmsscc\ |plusminus|\ zzzz e.g. 2008070505152000-0400 representing when a module or executable is compiled. The WHEN-COMPILED special register reflects when an object module was compiled .. sourcecode:: cobolfree program-id. whenpart1. procedure division. display "First part :" FUNCTION WHEN-COMPILED end-display. program-id. whenpart2. procedure division. display "Second part:" FUNCTION WHEN-COMPILED end-display. program-id. whenshow. procedure division. call "whenpart1" end-call. call "whenpart2" end-call. display "Main part :" FUNCTION WHEN-COMPILED end-display. For a test .. sourcecode:: bash $ cobc -c whenpart1.cob && sleep 15 && cobc -c whenpart2.cob && > sleep 15 && cobc -x whenshow.cob whenpart1.o whenpart2.o $ ./whenshow gives:: First part :2008082721391500-0400 Second part:2008082721393000-0400 Main part :2008082721394500-0400 ..................... FUNCTION YEAR-TO-YYYY ..................... Converts a two digit year to a sliding window four digit year. The optional second argument (default 50) is added to the date at execution time to determine the ending year of a 100 year interval. ------------------------------------------------- Can you clarify the use of FUNCTION in OpenCOBOL? ------------------------------------------------- Yes. This information is from [Roger]_, posted to the opencobol_ forums. :: Just to clarify the use of FUNCTION. (Applies to 0.33) FUNCTION (generally speaking, there are exceptions) can be used anywhere where a source item is valid. It always results in a new temporary field. This will have the desired characteristics dependant on the parameters. eg. FUNCTION MIN (x, y, z) with x PIC 99 y PIC 9(8) COMP z PIC 9(6)V99 will result in returning a field that has at least 8 positions before the (implied) decimal point and 2 after. It does NOT ever change the contents of parameters to the function. FUNCTION's are nestable. eg. DISPLAY FUNCTION REVERSE (FUNCTION UPPER-CASE (myfield)). One clarification to the above quote was pointed out by Roger. The line:: be used anywhere where a source item is valid. should be:: be used anywhere where a sending field is valid. ------------------------------------------------------------------- What is the difference between the LENGTH verb and FUNCTION LENGTH? ------------------------------------------------------------------- From [Roger]_:: The standard only defines FUNCTION LENGTH. The LENGTH OF phrase is an extension (from MF) --------------------------------------------- What STOCK CALL LIBRARY does OpenCOBOL offer? --------------------------------------------- OpenCOBOL 1.0 ships with quite a few callable features. See CALL_. Looking through the source code, you'll find the current list of service calls in:: libcob/system.def With the 1.1 pre-release of July 2008, that list included .. sourcecode:: c /* COB_SYSTEM_GEN (external name, number of parameters, internal name) */ COB_SYSTEM_GEN ("SYSTEM", 1, SYSTEM) COB_SYSTEM_GEN ("CBL_ERROR_PROC", 2, CBL_ERROR_PROC) COB_SYSTEM_GEN ("CBL_EXIT_PROC", 2, CBL_EXIT_PROC) COB_SYSTEM_GEN ("CBL_OPEN_FILE", 5, CBL_OPEN_FILE) COB_SYSTEM_GEN ("CBL_CREATE_FILE", 5, CBL_CREATE_FILE) COB_SYSTEM_GEN ("CBL_READ_FILE", 5, CBL_READ_FILE) COB_SYSTEM_GEN ("CBL_WRITE_FILE", 5, CBL_WRITE_FILE) COB_SYSTEM_GEN ("CBL_CLOSE_FILE", 1, CBL_CLOSE_FILE) COB_SYSTEM_GEN ("CBL_FLUSH_FILE", 1, CBL_FLUSH_FILE) COB_SYSTEM_GEN ("CBL_DELETE_FILE", 1, CBL_DELETE_FILE) COB_SYSTEM_GEN ("CBL_COPY_FILE", 2, CBL_COPY_FILE) COB_SYSTEM_GEN ("CBL_CHECK_FILE_EXIST", 2, CBL_CHECK_FILE_EXIST) COB_SYSTEM_GEN ("CBL_RENAME_FILE", 2, CBL_RENAME_FILE) COB_SYSTEM_GEN ("CBL_GET_CURRENT_DIR", 3, CBL_GET_CURRENT_DIR) COB_SYSTEM_GEN ("CBL_CHANGE_DIR", 1, CBL_CHANGE_DIR) COB_SYSTEM_GEN ("CBL_CREATE_DIR", 1, CBL_CREATE_DIR) COB_SYSTEM_GEN ("CBL_DELETE_DIR", 1, CBL_DELETE_DIR) COB_SYSTEM_GEN ("CBL_AND", 3, CBL_AND) COB_SYSTEM_GEN ("CBL_OR", 3, CBL_OR) COB_SYSTEM_GEN ("CBL_NOR", 3, CBL_NOR) COB_SYSTEM_GEN ("CBL_XOR", 3, CBL_XOR) COB_SYSTEM_GEN ("CBL_IMP", 3, CBL_IMP) COB_SYSTEM_GEN ("CBL_NIMP", 3, CBL_NIMP) COB_SYSTEM_GEN ("CBL_EQ", 3, CBL_EQ) COB_SYSTEM_GEN ("CBL_NOT", 2, CBL_NOT) COB_SYSTEM_GEN ("CBL_TOUPPER", 2, CBL_TOUPPER) COB_SYSTEM_GEN ("CBL_TOLOWER", 2, CBL_TOLOWER) COB_SYSTEM_GEN ("\364", 2, CBL_XF4) COB_SYSTEM_GEN ("\365", 2, CBL_XF5) COB_SYSTEM_GEN ("\221", 2, CBL_X91) COB_SYSTEM_GEN ("C$NARG", 1, cob_return_args) COB_SYSTEM_GEN ("C$PARAMSIZE", 1, cob_parameter_size) COB_SYSTEM_GEN ("C$MAKEDIR", 1, cob_acuw_mkdir) COB_SYSTEM_GEN ("C$CHDIR", 2, cob_acuw_chdir) COB_SYSTEM_GEN ("C$SLEEP", 1, cob_acuw_sleep) COB_SYSTEM_GEN ("C$COPY", 3, cob_acuw_copyfile) COB_SYSTEM_GEN ("C$FILEINFO", 2, cob_acuw_file_info) COB_SYSTEM_GEN ("C$DELETE", 2, cob_acuw_file_delete) COB_SYSTEM_GEN ("C$TOUPPER", 2, CBL_TOUPPER) COB_SYSTEM_GEN ("C$TOLOWER", 2, CBL_TOLOWER) COB_SYSTEM_GEN ("C$JUSTIFY", 1, cob_acuw_justify) COB_SYSTEM_GEN ("CBL_OC_NANOSLEEP", 1, cob_oc_nanosleep) /**/ Note the "SYSTEM". This CALL sends a command string to the shell. It acts as a wrapper to the standard C library "system" call. "SYSTEM" removes any trailing spaces from the argument and appends the null terminator required for the C library "system" call. While shell access opens yet another powerful door for the OpenCOBOL programmer, diligent delevopers will need to pay heed to cross platform issues when calling the operating system. ........................ A CBL_ERROR_PROC example ........................ .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED ***************************************************************** * OpenCOBOL demonstration * Author: Brian Tiffin * Date: 26-Jun-2008 * History: * 03-Jul-2008 * Updated to compile warning free according to standards * Purpose: * CBL_ERROR_PROC and CBL_EXIT_PROC call example * CBL_ERROR_PROC installs or removes run-time error procedures * CBL_EXIT_PROC installs or removes exit handlers * Also demonstrates the difference between Run time errors * and raised exceptions. Divide by zero is raises an * exception, it does not cause a run time error. * NB: * Please be advised that this example uses the functional but * now obsolete ENTRY verb. Compiling with -Wall will display * a warning. No warning will occur using -std=MF * Tectonics: cobc -x errorproc.cob identification division. program-id. error_exit_proc. data division. working-storage section. * entry point handlers are procedure addresses 01 install-address usage is procedure-pointer. 01 install-flag pic 9 comp-x value 0. 01 status-code pic s9(9) comp-5. * exit handler address and priority (prio is IGNORED with OC1.1) 01 install-params. 02 exit-addr usage is procedure-pointer. 02 handler-prio pic 999 comp-x. * indexing variable for back scannning error message strings 01 ind pic s9(9) comp-5. * work variable to demonstrate raising exception, not RTE 01 val pic 9. * mocked up error procedure reentrancy control, global level 01 once pic 9 value 0. 88 been-here value 1. * mocked up non-reentrant value 01 global-value pic 99 value 99. * LOCAL-STORAGE SECTION comes into play for ERROR_PROCs that * may themselves cause run-time errors, handling reentry. local-storage section. 01 reenter-value pic 99 value 11. * Linkage section for the error message argument passed to proc * By definition, error messages are 325 alphanumeric linkage section. 01 err-msg pic x(325). * example of OpenCOBOL error and exit procedures procedure division. * Demonstrate problem installing procedure * get address of WRONG handler. NOTE: Invalid address set exit-addr to entry "nogo-proc". * flag: 0 to install, 1 to remove call "CBL_EXIT_PROC" using install-flag install-params returning status-code end-call. * status-code 0 on success, in this case expect error. if status-code not = 0 display "Intentional problem installing EXIT PROC" ", Status: " status-code end-display end-if. * Demonstrate install of an exit handler * get address of exit handler set exit-addr to entry "exit-proc". * flag: 0 to install, 1 to remove call "CBL_EXIT_PROC" using install-flag install-params returning status-code end-call. * status-code 0 on success. if status-code not = 0 display "Problem installing EXIT PROC" ", Status: " status-code end-display stop run end-if. * Demonstrate installation of an error procedure * get the procedure entry address set install-address to entry "err-proc". * install error procedure. install-flag 0 installs, 1 removes call "CBL_ERROR_PROC" using install-flag install-address returning status-code end-call. * status-code is 0 on success. if status-code not = 0 display "Error installing ERROR PROC" end-display stop run end-if. * example of error that raises exception, not a run-time error divide 10 by 0 giving val end-divide. * val will be a junk value, use at own risk divide 10 by 0 giving val on size error display "DIVIDE BY ZERO Exception" end-display end-divide. * intentional run-time error call "erroneous" end-call. *> ** Intentional error ** * won't get here. RTS error handler will stop run display "procedure division, following run-time error" end-display. display "global-value: " global-value ", reenter-value: " reenter-value end-display. exit program. ***************************************************************** ***************************************************************** * Programmer controlled Exit Procedure: entry "exit-proc". display "**Custom EXIT HANDLER (will pause 3 and 0.5 seconds)**" end-display. * sleep for 3 seconds call "C$SLEEP" using "3" end-call. * demonstrate nanosleep; argument in billionth's of seconds * Note: also demonstrates OpenCOBOL's compile time * string catenation using ampersand; * 500 million being one half second call "CBL_OC_NANOSLEEP" using "500" & "000000" end-call. exit program. ***************************************************************** * Programmer controlled Error Procedure: entry "err-proc" using err-msg. display "**ENTER error procedure**" end-display. * These lines are to demonstrate local and working storage display "global-value: " global-value ", reenter-value: " reenter-value end-display. * As reenter-value is local-storage * the 77 will NOT display on rentry, while the global 66 will move 66 to global-value. move 77 to reenter-value. * Process err-msg. * Determine Length of error message, looking for null terminator perform varying ind from 1 by 1 until (err-msg(ind:1) = x"00") or (ind = length of err-msg) continue end-perform. display err-msg(1:ind) end-display. * demonstrate trapping an error caused in error-proc if not been-here then set been-here to true display "Cause error while inside error-proc" end-display call "very-erroneous" end-call *> Intentional error end-if. * In OpenCOBOL 1.1, the return-code is local and does * not influence further error handlers *move 1 to return-code. move 0 to return-code. display "**error procedure EXIT**" end-display. exit program. with tectonics:: $ cobc -x errorproc.cob $ ./errorproc Intentional problem installing EXIT PROC, Status: -000000001 DIVIDE BY ZERO Exception **ENTER error procedure** global-value: 99, reenter-value: 11 Cannot find module 'erroneous' Cause error while inside error-proc **ENTER error procedure** global-value: 66, reenter-value: 11 Cannot find module 'very-erroneous' **error procedure EXIT** libcob: Cannot find module 'very-erroneous' **Custom EXIT HANDLER (will pause 3 and 0.5 seconds)** ............................... Some stock library explanations ............................... This small gem of a help file was written up by Vincent Coen, included here for our benefit. .. Note:: The code below is a work in progress. If you see this attention box; the file is not yet deemed complete. :: System Calls v1.1.0 for OC v1.1 Author: Vincent B Coen dated 12/01/2009 COB_SYSTEM_GEN ("CBL_ERROR_PROC", 2, CBL_ERROR_PROC): Register error proc in Linux??? needs checking Roger? call using install-flag pic x comp-x Indicates operation to be performed (0 = install error procedure) (1 = un-install error procedure) install-addrs Usage procedure pointer Create by 'set install-addr to entry entry-name' (the address of error procedure to install or un-install) COB_SYSTEM_GEN ("CBL_EXIT_PROC", 2, CBL_EXIT_PROC) Register closedown proc call using install-flag pic x comp-x Indicate operation to be performed (0 = install closedown proc. with default priority of 64) (1 = un=install closedown proc.) (2 = query priority of installed proc.) (3 = install closedown proc. with given priority) install-param group item defined as: install-addr USAGE PROCEDURE POINTER (addr of closedown proc to install, uninstall or query) install-prty pic x comp-x (when install-flag = 3, priority of proc. being installed 0 - 127) returning status-code (See section key). on exit install-prty (when install-flag = 2, returns priority of selected proc.) COB_SYSTEM_GEN ("CBL_OPEN_FILE", 5, CBL_OPEN_FILE) Open byte stream file call using file-name pic x(n) space or null terminated access-mode pic x comp-5 (1 = read only, 2 = write only [deny must = 0] 3 = read / write) deny-mode pic x comp-5 (0 = deny both, 1 = deny write, 2 = deny read 3 = deny neither read nor write) device pic x comp-5 (must be zero) file-handle pic x(4) (Returns a file handle for a successful open) returning status-code (See section key) COB_SYSTEM_GEN ("CBL_CREATE_FILE", 5, CBL_CREATE_FILE) Create byte stream file call using file-name pic x(n) (space or null terminated) access-mode pic x comp-x (1 = read only) (2 = write only (deny must be 0) (3 = read / write) deny-mode pic x comp-x (0 = deny both read & write exclusive) (1 = deny write) (2 = deny read) (3 = deny neither read nor write) device pic x comp-x (must be zero) (reserved for future use) file-handle pic x(4) (Returns a file handle for a successful open) returning status-code (See section key) COB_SYSTEM_GEN ("CBL_READ_FILE", 5, CBL_READ_FILE) Read byte stream file call using file-handle pic x(4) (File handke returned when file opened) file-offset pic x(8) comp-x (offset in the file at which to read) (Max limit X"00FFFFFFFF") ?? byte-count pic x(4) comp-x (number of bytes to read. Poss limit x"00FFFF") flags pic x comp-x (0 = standard read, 128 = current file size returned in the file-offset field) buffer pic x(n) returning status-code (See section key) on exit: file-offset (Current file size on return if flags = 128 on entry) buffer pic x(n) (Buffer into which bytes are read. IT IS YOUR RESPONSIBILITY TO ENSURE THAT THE BUFFER IS LARGE ENOUGH TO HOLD ALL BYTES TO BE READ) Remarks: See Introduction to Byte Stream Routines as well as example code taken from old version of CobXref COB_SYSTEM_GEN ("CBL_WRITE_FILE", 5, CBL_WRITE_FILE) Write byte stream file call using file-handle pic x(4) (File handke returned when file opened) file-offset pic x(8) comp-x (offset in the file at which to write) (Max limit X"00FFFFFFFF") ?? byte-count pic x(4) comp-x (number of bytes to write. Poss limit x"00FFFF") Putting a value of zero here causes file to be trancated or extended to the size specified in file-offset) flags pic x comp-x (0 = standard write) buffer pic x(n) (Buffer into which bytes are writen from) returning status-code (See section key) Remarks: See Introduction to Byte Stream Routines as well as example code taken from old version of CobXref COB_SYSTEM_GEN ("CBL_CLOSE_FILE", 1, CBL_CLOSE_FILE) Close byte stream file call using file-handle pic x(4) on entry the file handle returned when file opened returning status-code (see section key) COB_SYSTEM_GEN ("CBL_FLUSH_FILE", 1, CBL_FLUSH_FILE) ?????????????? call using ??????? pic ???? No Idea COB_SYSTEM_GEN ("CBL_DELETE_FILE", 1, CBL_DELETE_FILE) Delete File call using file-name pic x(n) file to delete terminated by space can contain path. returning status-code COB_SYSTEM_GEN ("CBL_COPY_FILE", 2, CBL_COPY_FILE) Copy file call using file-name1 (pic x(n) File to copy, can contain path terniated by space file-name2 (pic x(n) File name of new file, can contain path termiated by space. For both, if no path current directory is assumed. returning status-code (see section key) COB_SYSTEM_GEN ("CBL_CHECK_FILE_EXIST", 2, CBL_CHECK_FILE_EXIST) Check if file exists & return details if it does Call using file-name file-details returning status-code file-name pic x(n) file-details Group item defined as: file-size pic x(8) comp-x file-date day pic x comp-x month pic x comp-x year pic xx comp-x file-time hours pic x comp-x minutes pic x comp-x seconds pic x comp-x hundredths pic x comp-x status-code see section key On entry: file-name The file to look for. name can cotain path and is terminated by a space If no path given current directory is assumed. On Exit: file-size Size if file in bytes file-date Date the file was created file-time Time file created COB_SYSTEM_GEN ("CBL_RENAME_FILE", 2, CBL_RENAME_FILE) Rename file call using old-file-name pic x(n) (file to rename can contain path terminated by space) new-file-name pic x(n) (new file name as above path must be same) returning status-code (see section key) COB_SYSTEM_GEN ("CBL_GET_CURRENT_DIR", 3, CBL_GET_CURRENT_DIR) Get details of current directory call using ??? pic x(n) ??? ??? pic x(n) ??? returning status-code (see section key) COB_SYSTEM_GEN ("CBL_CHANGE_DIR", 1, CBL_CHANGE_DIR) Change current directory Call using path-name pic x(n) (relative or absolute terminated by x"00") returning status-code (see section key) COB_SYSTEM_GEN ("CBL_CREATE_DIR", 1, CBL_CREATE_DIR) Create directory Call using path-name pic x(n) (relative or absolute path-name terminate by x"00") returning status-code (see section key) COB_SYSTEM_GEN ("CBL_DELETE_DIR", 1, CBL_DELETE_DIR) Delete directory Call using path-name pic x(n) (relative or absolute name terminated by space or null [x"00"]) returning status-code (see section key) COB_SYSTEM_GEN ("CBL_AND", 3, CBL_AND) logical AND Call using source (Any data item) target (Any data item) by value length (numeric literal or pic x(4) comp-5 returning status-code (see section key) COB_SYSTEM_GEN ("CBL_OR", 3, CBL_OR) logical OR call using source (Any data item) target (Any data item) by value length (numeric literal or pic x(4) comp-5 returning status-code (see section key) COB_SYSTEM_GEN ("CBL_NOR", 3, CBL_NOR) Logial Not OR ? Call using source (Any data item) target (Any data item) by value length (numeric literal or pic x(4) comp-5 returning status-code (see section key) COB_SYSTEM_GEN ("CBL_XOR", 3, CBL_XOR) logical eXclusive OR Call using source (Any data item) target (Any data item) by value length (numeric literal or pic x(4) comp-5 returning status-code (see section key) COB_SYSTEM_GEN ("CBL_IMP", 3, CBL_IMP) Logical IMPlies call using source Any data item target Any data Item by value length Nuneric literal or pic x(4) comp-5 returning status-code (see section key) COB_SYSTEM_GEN ("CBL_NIMP", 3, CBL_NIMP) Logical Not IMPlies call using source Any data item target Any data Item by value length Nuneric literal or pic x(4) comp-5 returning status-code (see section key) COB_SYSTEM_GEN ("CBL_EQ", 3, CBL_EQ) Logical EQUIVALENCE between bits of both items Call using source (Any data item) target (Any data item) by value length (numeric literal or pic x(4) comp-5 returning status-code (see section key) COB_SYSTEM_GEN ("CBL_NOT", 2, CBL_NOT) Logical NOT Call using target Any data item by value length numeric lit or pic x(4) comp-5 COB_SYSTEM_GEN ("CBL_TOUPPER", 2, CBL_TOUPPER) Convert a string to Upper case Call using string pic x(n) (The string to convert) by value length pic x(4) comp-5 (Number of bytes to change) returning status-code (see section key) COB_SYSTEM_GEN ("CBL_TOLOWER", 2, CBL_TOLOWER) Convert a string to Lower case Call using string pic x(n) (The string to convert) by value length pic x(4) comp-5 (Number of bytes to change) returning status-code (see section key) COB_SYSTEM_GEN ("\364", 2, CBL_XF4) COB_SYSTEM_GEN ("\365", 2, CBL_XF5) COB_SYSTEM_GEN ("\221", 2, CBL_X91) COB_SYSTEM_GEN ("C$NARG", 1, cob_return_args) COB_SYSTEM_GEN ("C$PARAMSIZE", 1, cob_parameter_size) COB_SYSTEM_GEN ("C$MAKEDIR", 1, cob_acuw_mkdir) COB_SYSTEM_GEN ("C$CHDIR", 2, cob_acuw_chdir) COB_SYSTEM_GEN ("C$SLEEP", 1, cob_acuw_sleep) COB_SYSTEM_GEN ("C$COPY", 3, cob_acuw_copyfile) COB_SYSTEM_GEN ("C$FILEINFO", 2, cob_acuw_file_info) COB_SYSTEM_GEN ("C$DELETE", 2, cob_acuw_file_delete) COB_SYSTEM_GEN ("C$TOUPPER", 2, CBL_TOUPPER) Convert string to upper case see cbl_toupper ??? COB_SYSTEM_GEN ("C$TOLOWER", 2, CBL_TOLOWER) Convert string to lower case see cbl_tolower ??? COB_SYSTEM_GEN ("C$JUSTIFY", 1, cob_acuw_justify) COB_SYSTEM_GEN ("CBL_OC_NANOSLEEP", 1, CBL_OC_NANOSLEEP) Key: Option Returning clause will allow all routine to return a value showing result of the operation. Zero = success and nonzero failure. If this field is omitted the value should be returned in the special register RETURN-CODE.. Note that status-code must be capable of holding posative values from 0 to 65535 ie, pic xx comp-5. And a sample program too :: Introduction to Byte Streaming Routines. The byte stream file routines enable you to read, write data files without the need to adhere to Cobol record definitions. For all of these routines, if the routine is successful the RETURN-CODE register is set to zero. If it fails, the RETURN-CODE register contains a file status value which indicates the failure. This file status is always the standard ASNI '74 file status value. If no ANSI '74 file status is defined for the error, an extended error status is returned (9/nnn) where nnn is the runtime error number). MAYBE need to speak to Roger. <<<<<<<<<<<<<<<<<<<< An extract of a example of working Cobol code that shows usage of byte stream file handling .. sourcecode:: cobol 000100 Identification division. 000200 program-id. cobxref. ... ... 104000 01 File-Handle-Tables. 104100 03 filler occurs 0 to 99 104200 depending on Fht-Table-Size. 104300 05 Fht-File-Handle pic x(4). 104400 05 Fht-File-OffSet pic x(8) comp-x value zero. 104500 05 Fht-File-Size pic x(8) comp-x value zero. 104600 05 Fht-Block-OffSet pic x(8) comp-x value zero. 104700 05 Fht-Byte-Count pic x(4) comp-x value 4096. 104800 05 Fht-CopyRefNo2 pic 9(6) value zero. 104900 05 Fht-Pointer pic s9(5) comp value zero. 105000 05 Fht-Copy-Line-End pic s9(5) comp value zero. 105100 05 Fht-Copy-Words pic s9(5) comp value zero. 105200 05 Fht-sw-Eof pic 9 value zero. 105300 88 Fht-Eof value 1. 105400 05 Fht-Current-Rec pic x(160) value spaces. 105500 05 Fht-File-Name pic x(256). 105600 05 Fht-Buffer pic x(4097). 105700 05 filler pic x value x"FF". 105800 01 Fht-Table-Size pic s9(5) comp value zero. 105900* 106000 01 Cbl-File-Fields. 106100 03 Cbl-File-name pic x(256). 106200 03 Cbl-Access-Mode pic x comp-x value 1. 106300 03 Cbl-Deny-Mode pic x comp-x value 3. 106400 03 Cbl-Device pic x comp-x value zero. 106500 03 Cbl-Flags pic x comp-x value zero. 106600 03 Cbl-File-Handle pic x(4) value zero. 106700 03 Cbl-File-OffSet pic x(8) comp-x value zero. 106800* 106900 01 Cbl-File-Details. 107000 03 Cbl-File-Size pic x(8) comp-x value zero. 107100 03 Cbl-File-Date. 107200 05 Cbl-File-Day pic x comp-x value zero. 107300 05 Cbl-File-Mth pic x comp-x value zero. 107400 05 Cbl-File-Year pic x comp-x value zero. 107500 03 Cbl-File-time. 107600 05 Cbl-File-Hour pic x comp-x value zero. 107700 05 Cbl-File-Min pic x comp-x value zero. 107800 05 Cbl-File-Sec pic x comp-x value zero. 107900 05 Cbl-File-Hund pic x comp-x value zero. ... ... ******************************************************************** * * zz300, zz400, zz500 & zz600 all relate to copy files/libraries * via the COPY verb * As it is hoped to only use the filename.i via Open-Cobol * then this lot can be killed off as well as all the other related * code. * NOTE that the COPY verb is implemented in a very basic way despite * the fact that this code allows for 99 levels of COPY, eg, there is * NO replacing so hopefully I can remove it all after primary testing * When it is built into cobc * 356400 zz300-Open-File. 356500**************** 356600* Open a Copy file using CBL-OPEN-File 356700* filename is using Cbl-File-name 356800* 356900 move zero to Return-Code. 357000 if Fht-Table-Size > 99 357100 move 24 to Return-Code 357200 display Msg11 357300 go to zz300-Exit. 357400* 357500* set up New entry in File Table 357600* 357700 add 1 to Fht-Table-Size. 357800 move Fht-Table-Size to e. 357900 move zeroes to Fht-File-OffSet (e) Fht-File-Size (e) 358000 Fht-File-Handle (e) Fht-Block-OffSet (e) 358100 Fht-CopyRefNo2 (e) Fht-sw-Eof (e) 358200 Fht-Copy-Line-End (e) Fht-Copy-Words (e). 358300 move 4096 to Fht-Byte-Count (e). 358400 move spaces to Fht-Current-Rec (e). 358500 move 1 to Fht-pointer (e). 358600* 358700 perform zz400-Check-File-Exists thru zz400-Exit. 358800 if Return-Code not = zero 358900 subtract 1 from Fht-Table-Size 359000 go to zz300-Exit. 359100* 359200 move Fht-Table-Size to e. 359300 move Cbl-File-Size to Fht-File-Size (e). 359400 move Cbl-File-name to Fht-File-Name (e). 359500 move 1 to Cbl-Access-Mode 359600 Cbl-Deny-Mode. 359700 move zero to Cbl-Device 359800 Cbl-File-Handle. 359900 move zero to Return-Code. 360000 call "CBL_OPEN_FILE" using 360100 Cbl-File-name 360200 Cbl-Access-Mode 360300 Cbl-Deny-Mode 360400 Cbl-Device 360500 Cbl-File-Handle. 360600 if Return-Code not = zero 360700 display Msg12 cbl-File-name 360800 display " This should not happen here" 360900 subtract 1 from Fht-Table-Size 361000 go to zz300-exit. 361100* 361200 move Cbl-File-Handle to Fht-File-Handle (e). 361300 add 1 to Copy-Depth. 361400 move 1 to sw-Copy. 361500 move zero to Fht-CopyRefNo2 (e) 361600 Return-Code. 362000 zz300-Exit. 362100 exit. 362200/ 362300 zz400-Check-File-Exists. 362400* 362500* check for correct filename and extention taken from COPY verb 362600* 362700* input : wsFoundNewWord2 362800* Output : Return-Code = 0 : Cbl-File-Details & Cbl-File-name 362900* Return-Code = 25 : failed fn in wsFoundNewWord2 363000* 363100 move zero to e. 363200 inspect wsFoundNewWord2 tallying e for all ".". 363300 if e not zero 363400 go to zz400-Try1. 363500 perform varying a from 1 by 1 until Return-Code = zero 363600 move 1 to e 363700 move spaces to Cbl-File-name 363800 string wsFoundNewWord2 delimited by space 363900 into Cbl-File-name pointer e 364000 string File-Ext (a) delimited by size 364100 into Cbl-File-name pointer e 364200 move zero to Return-Code 364300 call "CBL_CHECK_FILE_EXIST" using 364400 Cbl-File-name 364500 Cbl-File-Details 364600 end-call 364700 if Return-Code not = zero 364800 and a = 7 364900 exit perform 365000 end-if 365100 end-perform 365200 if Return-Code not = zero 365300 display "zz400A Check File exist err=" Return-Code 365400 display Msg13 wsFoundNewWord2 365500 move 25 to Return-Code 365600 go to zz400-Exit. 365700* ok file now found 365900 go to zz400-Exit. 366000* 366100 zz400-Try1. 366200 move wsFoundNewWord2 to Cbl-File-name. 366300 move zero to Return-Code. 366400 call "CBL_CHECK_FILE_EXIST" using 366500 Cbl-File-name 366600 Cbl-File-Details. 366700 if Return-Code not = zero 366800 move function lower-case (wsFoundNewWord2) to 366900 Cbl-File-name 367000 go to zz400-Try2. 367100* ok file now found 367200 go to zz400-exit. 367300* 367400 zz400-Try2. 367500 move zero to Return-Code. 367600 call "CBL_CHECK_FILE_EXIST" using 367700 Cbl-File-name 367800 Cbl-File-Details. 367900 if Return-Code not = zero 368000 display "zz400C Check File exist err=" Return-Code 368100 display Msg13 wsFoundNewWord2 " or " Cbl-File-name 368200 move 25 to Return-Code 368300 go to zz400-Exit. 368400* 368500* ok file now found 368600* 368700 zz400-Exit. 368800 exit. 368900/ 369000 zz500-Close-File. 369100 call "CBL_CLOSE_FILE" using 369200 Fht-File-Handle (Fht-Table-Size). 369300 if Return-Code not = zero 369400 display Msg14 369500 Cbl-File-name. 369800 subtract 1 from Fht-Table-Size. 369900* 370000 if Fht-Table-Size = zero 370100 move zero to sw-Copy. 370200 subtract 1 from Copy-Depth. 370300 move zero to Return-Code. 370400 go to zz500-Exit. 370500* 370600 zz500-Exit. 370700 exit. 370800/ 370900 zz600-Read-File. 371000**************** 371100* called using file-handle 371200* returning CopySourceRecin1 size 160 chars 371300* If buffer enpty read a block 371400* and regardless, move record terminated by x"0a" 371500* to Fht-Current-Rec (Fht-Table-Size) 371600* 371700 if Fht-Eof (Fht-Table-Size) 371800 perform zz500-Close-File 371900 go to zz600-Exit. 372000* 372100 if Fht-File-OffSet (Fht-Table-Size) = zero 372200 and Fht-Block-OffSet (Fht-Table-Size) = zero 372300 perform zz600-Read-A-Block 372400 go to zz600-Get-A-Record. 372500* 372600 zz600-Get-A-Record. 372700******************* 372800* Now to extract a record from buffer and if needed read a block 372900* then extract 373000* 373100 move spaces to Fht-Current-Rec (Fht-Table-Size). 373200 add 1 to Fht-Block-OffSet (Fht-Table-Size) giving g. 373300* 373400* note size is buffer size + 2 373500* 373600 unstring Fht-Buffer (Fht-Table-Size) (1:4097) 373700 delimited by x"0A" or x"FF" 373800 into Fht-Current-Rec (Fht-Table-Size) 373900 delimiter Word-Delimit3 374000 pointer g. 374100* 374200* Get next Block of data ? 374300* 374400 if Word-Delimit3 = x"FF" 374500 and g not < 4097 374600 add Fht-Block-OffSet (Fht-Table-Size) 374700 to Fht-File-OffSet (Fht-Table-Size) 374800 perform zz600-Read-A-Block 374900 go to zz600-Get-A-Record. 375000* EOF? 375100 move 1 to Fht-Pointer (Fht-Table-Size). 375200 if Word-Delimit3 = x"FF" 375300 move 1 to Fht-sw-Eof (Fht-Table-Size) 375400 go to zz600-Exit. 375500* Now so tidy up 375600 subtract 1 from g giving Fht-Block-OffSet (Fht-Table-Size). 375700 go to zz600-exit. 375800* 375900 zz600-Read-A-Block. ******************* 376000 move all x"FF" to Fht-Buffer (Fht-Table-Size). 376100* if Fht-File-Size (Fht-Table-Size) < 4096 and not = zero 376200* move Fht-File-Size (Fht-Table-Size) 376300* to Fht-Byte-Count (Fht-Table-Size). 376400 call "CBL_READ_FILE" using 376500 Fht-File-Handle (Fht-Table-Size) 376600 Fht-File-OffSet (Fht-Table-Size) 376700 Fht-Byte-Count (Fht-Table-Size) 376800 Cbl-Flags 376900 Fht-Buffer (Fht-Table-Size). 377000 if Return-Code not = zero 377100 display Msg15 Return-Code 377200 go to zz600-Exit. 377300* just in case all ff does not work 377400 move x"FF" to Fht-Buffer (Fht-Table-Size) (4097:1). 377500 move zero to Fht-Block-OffSet (Fht-Table-Size). 377600 subtract Fht-Byte-Count (Fht-Table-Size) 377700 from Fht-File-Size (Fht-Table-Size). 377800 zz600-Exit. 377900 exit. ---------------------------------------- What are the XF4, XF5, and X91 routines? ---------------------------------------- From opencobol.org_ :: The CALL's X"F4", X"F5", X"91" are from MF. You can find them in the online MF doc under Library Routines. F4/F5 are for packing/unpacking bits from/to bytes. 91 is a multi-use call. Implemented are the subfunctions get/set cobol switches (11, 12) and get number of call params (16). Roger Use .. sourcecode:: cobolfree CALL X"F4" USING BYTE-VAR ARRAY-VAR RETURNING STATUS-VAR to pack the last bit of each byte in the 8 byte ARRAY-VAR into corresponding bits of the 1 byte BYTE-VAR. The X"F5" routine takes the eight bits of byte and moves them to the corresponding occurrence within array. X"91" is a multi-function routine. .. sourcecode:: cobolfree CALL X"91" USING RESULT-VAR FUNCTION-NUM PARAMETER-VAR RETURNING STATUS-VAR As mentioned by Roger, OpenCOBOL supports FUNCTION-NUM of 11, 12 and 16. 11 and 12 get and set the on off status of the 8 (eight) run-time OpenCOBOL switches definable in the SPECIAL-NAMES_ paragraph. 16 returns the number of call parameters given to the current module. --------------------------------------------------- What is CBL_OC_NANOSLEEP OpenCOBOL library routine? --------------------------------------------------- CBL_OC_NANOSLEEP allows (upto) nanosecond sleep timing. It accepts a 64 bit integer value which may be in character or numeric data forms. .. sourcecode:: cobolfree CALL "CBL_OC_NANOSLEEP" USING 500000000 RETURNING STATUS END-CALL Would wait one-half second. *It may be easier to grok if the source code uses string catenation; "500" & "000000" for example.* ------------------------- How do you use C$JUSTIFY? ------------------------- The C$JUSTIFY sub program can centre, or justify strings left or right. .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 01-Jul-2008 *> Purpose: Demonstrate the usage of OpenCOBOL call library *> C$JUSTIFY, C$TOUPPER, C$TOLOWER *> Tectonics: Using OC1.1 post 02-Jul-2008, cobc -x -Wall *> History: 02-Jul-2008, updated to remove warnings *> *************************************************************** identification division. program-id. justify. environment division. configuration section. source-computer. IBMPC. object-computer. IBMPC. data division. WORKING-STORAGE section. 01 source-str pic x(80) value " this is a test of the internal voice communication - " system". 01 just-str pic x(80). 01 justification pic x. 01 result pic s9(9) comp-5. procedure division. move source-str to just-str. *> Left justification move "L" to justification. perform demonstrate-justification. *> case change to upper, demonstrate LENGTH verb call "C$TOUPPER" using just-str by value function length( just-str ) returning result end-call. *> Centre move "C" to justification. perform demonstrate-justification. *> case change to lower call "C$TOLOWER" using just-str by value 80 returning result end-call. *> Right, default if no second argument call "C$JUSTIFY" using just-str returning result end-call. move "R" to justification. perform show-justification. exit program. stop run. *> *************************************************************** demonstrate-justification. call "C$JUSTIFY" using just-str justification returning result end-call if result not equal 0 then display "Problem: " result end-display stop run end-if perform show-justification . *> *************************************************************** show-justification. evaluate justification when "L" display "Left justify" end-display when "C" display "Centred (in UPPERCASE)" end-display when other display "Right justify" end-display end-evaluate display "Source: |" source-str "|" end-display display "Justified: |" just-str "|" end-display display space end-display . Producing:: $ ./justify Left justify Source: | this is a test of the internal voice communication system | Justified: |this is a test of the internal voice communication system | Centred (in UPPERCASE) Source: | this is a test of the internal voice communication system | Justified: | THIS IS A TEST OF THE INTERNAL VOICE COMMUNICATION SYSTEM | Right justify Source: | this is a test of the internal voice communication system | Justified: | this is a test of the internal voice communication system| ---------------------------------------------------- What compiler directives are supported by OpenCOBOL? ---------------------------------------------------- OpenCOBOL 1.1pre-rel supports a limited number of **directives**. - >>D - >>SOURCE OpenCOBOL 2.0 supports a much wider subset of standard directives and existent extensions. Some are only recognized and will be ignored with a warning until implemented. - >>D - >>SOURCE - >>DEFINE - >>DISPLAY - >>IF - >>ELSE - >>ELIF - >>ELSE-IF - >>END-IF - >>SET - >>LEAP-SECOND - >>TURN ... >>D ... Debug line control. OpenCOBOL only compiles these lines if the **-fdebugging-line** command line is used. ........ >>SOURCE ........ OpenCOBOL fully supports FREE and FIXED format source. The compiler defaults FIXED form sources, so this directive is usually placed at column 8 or beyond. The command line arguments **-free** and **-fixed** controls the default for the *first line* of source. See `What source formats are accepted by OpenCOBOL?`_ for more details. ........ >>DEFINE ........ Define a compile time symbol. - >>DEFINE identifier AS literal - >>DEFINE identifier AS literal OVERRIDE - >>DEFINE identifier OFF - >>DEFINE identifier PARAMETER - >>DEFINE identifier CONSTANT - >>DEFINE identifier working-variable The -D command line option can be used to define symbols. .... >>IF .... Conditional compile directive. Will include source lines upto >>END-IF, an >>ELSE-IF or >>ELSE clause if condition is true. - >>IF identifier DEFINED - >>IF conditional-expression ......... >>ELSE-IF ......... Allows for multiple conditions in a conditional compile sequence. ...... >>ELIF ...... Alias for >>ELSE-IF. ...... >>ELSE ...... Compiles in source lines upto an >>END-IF if the previous >>IF or >>ELSE-IF conditions test false. ........ >>END-IF ........ Terminates a conditional compile block. ..... >>SET ..... Allows modification of compiler source text handling behaviour. - >>SET CONSTANT - >>SET SOURCEFORMAT - >>SET FOLDCOPYNAME | FOLD-COPY-NAME - >>SET NOFOLDCOPYNAME | NOFOLD-COPY-NAME - >>SET AS - >>SET literal - >>SET {SET_PAREN_LIT} - >>SET working-store-var ............. >>LEAP-SECOND ............. Ignored. ...... >>TURN ...... Will allow modification of exception code handling, when implemented. ======================= Features and extensions ======================= .. sidebar:: OpenCOBOL Features .. contents:: :local: :backlinks: entry :depth: 2 _`OpenCOBOL Features` ------------------------------- How do I use OpenCOBOL for CGI? ------------------------------- OpenCOBOL is more than capable of being a web server backend tool. - One of the tricks is assigning an input stream to KEYBOARD when you need to get at POST data. - Another is using the ACCEPT var FROM ENVIRONMENT feature. .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED ****************************************************************** * Author: Brian Tiffin, Francois Hiniger * Date: 30-Aug-2008 * Purpose: Display the CGI environment space * Tectonics: cobc -x cgienv.cob * Move cgienv to the cgi-bin directory as cgienv.cgi * browse http://localhost/cgi-bin/cgienv.cgi or cgienvform.html ****************************************************************** identification division. program-id. cgienv. environment division. input-output section. file-control. select webinput assign to KEYBOARD. data division. file section. fd webinput. 01 postchunk pic x(1024). working-storage section. 78 name-count value 34. 01 newline pic x value x'0a'. 01 name-index pic 99 usage comp-5. 01 value-string pic x(256). 01 environment-names. 02 name-strings. 03 filler pic x(20) value 'AUTH_TYPE'. 03 filler pic x(20) value 'CONTENT_LENGTH'. 03 filler pic x(20) value 'CONTENT_TYPE'. 03 filler pic x(20) value 'DOCUMENT_ROOT'. 03 filler pic x(20) value 'GATEWAY_INTERFACE'. 03 filler pic x(20) value 'HTTP_ACCEPT'. 03 filler pic x(20) value 'HTTP_ACCEPT_CHARSET'. 03 filler pic x(20) value 'HTTP_ACCEPT_ENCODING'. 03 filler pic x(20) value 'HTTP_ACCEPT_LANGUAGE'. 03 filler pic x(20) value 'HTTP_COOKIE'. 03 filler pic x(20) value 'HTTP_CONNECTION'. 03 filler pic x(20) value 'HTTP_HOST'. 03 filler pic x(20) value 'HTTP_REFERER'. 03 filler pic x(20) value 'HTTP_USER_AGENT'. 03 filler pic x(20) value 'LIB_PATH'. 03 filler pic x(20) value 'PATH'. 03 filler pic x(20) value 'PATH_INFO'. 03 filler pic x(20) value 'PATH_TRANSLATED'. 03 filler pic x(20) value 'QUERY_STRING'. 03 filler pic x(20) value 'REMOTE_ADDR'. 03 filler pic x(20) value 'REMOTE_HOST'. 03 filler pic x(20) value 'REMOTE_IDENT'. 03 filler pic x(20) value 'REMOTE_PORT'. 03 filler pic x(20) value 'REQUEST_METHOD'. 03 filler pic x(20) value 'REQUEST_URI'. 03 filler pic x(20) value 'SCRIPT_FILENAME'. 03 filler pic x(20) value 'SCRIPT_NAME'. 03 filler pic x(20) value 'SERVER_ADDR'. 03 filler pic x(20) value 'SERVER_ADMIN'. 03 filler pic x(20) value 'SERVER_NAME'. 03 filler pic x(20) value 'SERVER_PORT'. 03 filler pic x(20) value 'SERVER_PROTOCOL'. 03 filler pic x(20) value 'SERVER_SIGNATURE'. 03 filler pic x(20) value 'SERVER_SOFTWARE'. 02 filler redefines name-strings. 03 name-string pic x(20) occurs name-count times. procedure division. * Always send out the Content-type before any other IO display "Content-type: text/html" newline end-display. display "" end-display. display "

CGI environment with OpenCOBOL

" end-display. display 'To cgienvform.html' "

" end-display. * Accept and display some of the known CGI environment values perform varying name-index from 1 by 1 until name-index > name-count accept value-string from environment name-string(name-index) end-accept display "" end-display if (name-string(name-index) = "REQUEST_METHOD") and (value-string = "POST") open input webinput read webinput at end move spaces to postchunk end-read close webinput display '" end-display end-if end-perform. display "
" name-string(name-index) ": " function trim (value-string trailing) "
' "First chunk of POST:" postchunk(1:72) "

" end-display. COOL goback. Once compiled and placed in an appropriate cgi-bin directory of your web server, a simple form can be used to try the example. **cgienvform.html** .. sourcecode:: html OpenCOBOL sample CGI form

OpenCOBOL sample CGI form

Text:
Password:
Checkbox:
One
Two

.... AJAX .... From a post on opencobol.org by DamonH:: As promised, here is the html for AJAX to use the cgenv.cgi example from the FAQ. You need not change anything with the cobol code. **ajax.html** .. sourcecode:: html Simple Ajax Example

word:

A quick screenshot from the Vala WebKit called from OpenCOBOL sample. *To be clear, this is a screenshot of an OpenCOBOL application that includes an embedded brower, displaying AJAX invoked OpenCOBOL CGI binaries (installed on the host without superuser access).* Take this one step further, and the browser application could utilize libSOUP and be its own webserver. **Sometimes, just wow**. Ok, feel the need for marketing speak. "Moving beyond COBOL? Why? Move COBOL beyond." .. image:: images/ajaxcobol.png :align: center For those developers looking to serve OpenCOBOL applications on hosted systems and no super user privileges, see `How do I use LD_RUN_PATH with OpenCOBOL?`_ for some pointers on local library linkage. -------------- What is ocdoc? -------------- **ocdoc** is a small utility used to annotate sample programs and to support generation of Usage Documentation using COBOL sourced ReStructuredText extract lines. ocdoc.cob .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *><* ===================== *><* ocdoc.cob usage guide *><* ===================== *><* .. sidebar:: Table of Contents *><* *><* .. contents:: :local: *><* *><* :Author: Brian Tiffin *><* :Date: 30-Sep-2008 *><* :Rights: Copyright (c) 2008, Brian Tiffin. *><* GNU FDL License. *><* :Purpose: Extract usage document lines from COBOL sources. *><* Using OpenCOBOL 1.1pr. OpenCOBOL is tasty. *><* :Tectonics: cobc -x ocdoc.cob *><* :Docgen: $ ./ocdoc ocdoc.cob ocdoc.rst ocdoc.html skin.css *> *************************************************************** *><* *><* ------------ *><* Command line *><* ------------ *><* *ocdoc* runs in two forms. *><* *><* Without arguments, *ocdoc* will act as a pipe filter. *><* Reading from standard in and writing the extract to standard *><+ out. *><* *><* The *ocdoc* command also takes an input file, an extract *><+ filename, an optional result file (with optional *><+ stylesheet) and a verbosity option *-v* or a *><+ special *-fixed* flag (to force skipping sequence numbers). *><* If a result file is given, ocdoc will automatically *><* run an *rst2html* command using the SYSTEM service. *><* *><* Due to an overly simplistic argument handler, you can only *><+ turn on verbosity or -fixed when using all four filenames. *><* *><* Examples:: *><* *><* $ cat ocdoc.cob | ocdoc >ocdoc.rst *><* $ ./ocdoc ocdoc.cob ocdoc.rst *><* $ ./ocdoc ocdoc.cob ocdoc.rst *><+ ocdoc.html skin.css -fixed *><* ... *><* Input : ocdoc.cob *><* Output : ocdoc.rst *><* Command: rst2html --stylesheet=skin.css *><+ ocdoc.rst ocdoc.html *><* *><* ----------------- *><* What is extracted *><* ----------------- *><* - Lines that begin with \*><\* *ignoring spaces*, are *><+ extracted. *><* *><* - Lines that begin with \*><+ are appended to the *><+ previous output line. As lines are trimmed of trailing *><+ spaces, and *ocdoc* removes the space following the *><+ extract triggers, you may need two spaces after an *><+ ocdoc append. *><* *><* - Lines that begin with \*><[ begin a here document *><+ with lines that follow extracted as is. *><* *><* - Lines that begin with \*><] close a here document. *><+ Here document start and end lines are excluded from the *><+ extract. *><* *><* ----------- *><* Source code *><* ----------- *><* `Download ocdoc.cob *><+ `_ *><* `See ocdocseq.cob *><+ `_ *><* *><* *><* ----------------------- *><* identification division *><* ----------------------- *><* *><* :: *><* *><[ identification division. program-id. OCDOC. environment division. input-output section. file-control. select standard-input assign to KEYBOARD. select standard-output assign to DISPLAY. select source-input assign to source-name organization is line sequential . select doc-output assign to doc-name organization is line sequential . *><] *><* *><* ------------- *><* data division *><* ------------- *><* *><* :: *><* *><[ data division. file section. fd standard-input. 01 stdin-record pic x(256). fd standard-output. 01 stdout-record pic x(256). fd source-input. 01 source-record pic x(256). fd doc-output. 01 doc-record pic x(256). working-storage section. 01 arguments pic x(256). 01 source-name pic x(256). 01 doc-name pic x(256). 01 result-name pic x(256). 01 style-name pic x(256). 01 verbosity pic x(9). 88 verbose values "-v" "--v" "-verbose" "--verbose". 88 skipseqnum values "-fix" "-fixed" "--fix" "--fixed". 01 usagehelp pic x(6). 88 helping values "-h" "--h" "-help" "--help". 01 filter-flag pic x value low-value. 88 filtering value high-value. 01 line-count usage binary-long. 01 line-display pic z(8)9. *><] *><* *><* Note the conditional test for end of here doc *><* *><* :: *><* *><[ 01 trimmed pic x(256). 88 herestart value "*><[". 88 hereend value "*><]". 01 hereflag pic x value low-value. 88 heredoc value high-value. 88 herenone value low-value. *><] *><* *><* Note the here-record adds an ocdoc extract to lines that *><+ follow. *><* *><* :: *><* *><[ 01 here-record. 02 filler pic x(5) value "*><* ". 02 here-data pic x(251). 01 seq-record. 02 filler pic x(7) value " ". 02 seq-data pic x(249). 01 doc-buffer pic x(256). 01 buffer-offset pic 999 usage comp-5 value 1. 01 buffer-flag pic x value low-value. 88 buffer-empty value low-value. 88 buffered-output value high-value. 01 counter pic 999 usage comp-5. 01 len-of-comment pic 999 usage comp-5. 01 first-part pic x(8). 88 special values "*><*" "*><+". 88 autodoc value "*><*". 88 autoappend value "*><+". 01 rst-command pic x(256). 01 result usage binary-long. *><] *><* *><* ------------------ *><* procedure division *><* ------------------ *><* *><* :: *><* *><[ *> *************************************************************** procedure division. *><] *><* *><* Accept command line arguments. See if help requested. *><* *><* :: *><* *><[ accept arguments from command-line end-accept move arguments to usagehelp if helping display "$ ./ocdoc source markover [output [skin [--fixed]]]" end-display display "$ ./ocdoc" end-display display " without arguments extracts stdin to stdout" end-display goback end-if *><] *><* *><* Either run as filter or open given files. Two filenames *><+ will generate an extract. Three will run the extract *><+ through *rst2html* using an optional fourth filename *><+ as a stylesheet. *><* *><* :: *><* *><[ *> Determine if this is running as a filter if arguments not equal spaces unstring arguments delimited by all spaces into source-name doc-name result-name style-name verbosity end-unstring open input source-input open output doc-output else set filtering to true open input standard-input open output standard-output end-if *><] *><* *><* Initialize the output buffer, and line count. *><* *><* :: *><* *><[ set buffer-empty to true move 1 to buffer-offset move spaces to doc-record move 0 to line-count *><] *><* *><* The read is either from file or stdin. Start with the *><+ first record. *><* *><* :: *><* *><[ *> filtering requires different reader loop if filtering read standard-input at end move high-values to stdin-record end-read move stdin-record to source-record else read source-input at end move high-values to source-record end-read end-if *><] *><* *><* The main loop starts here, having done a pre-read to start *><+ things off. *><* *><* :: *><* *><[ perform until source-record = high-values add 1 to line-count *><] *><* *><* Small wrinkle if processing fixed form with sequence numbers, *><+ as the heredoc end marker needs to be recognized *><+ but we still want the sequence numbers in the heredoc. *><* *><* So files processed --fixed play some data shuffling games. *><* *><* :: *><* *><[ if skipseqnum if heredoc move source-record(7 : 248) to trimmed move source-record to seq-data move seq-record to source-record else move source-record(7 : 248) to source-record move source-record to trimmed end-if else move function trim(source-record leading) to trimmed end-if *><] *><* *><* First to check for here doc start and end, setting flag *><+ if trimmed conditional the heredoc start or heredoc end *><+ strings. *><* *><* :: *><* *><[ if herestart set heredoc to true end-if if hereend set herenone to true end-if *><] *><* *><* Inside the loop, we skip over heredoc entries. *><+ If it is normal, than check for heredoc and include *><+ source lines that follow, by prepending the extract tag *><* *><* :: *><* *><[ if (not herestart) and (not hereend) if heredoc move source-record to here-data move here-record to trimmed end-if *><] *><* *><* Unstring the line, looking for special tags in the first *><+ part. *><* *><* :: *><* *><[ unstring trimmed delimited by all spaces into first-part count in counter end-unstring *><] *><* *><* If special, we either buffer or append to buffer *><* *><* :: *><* *><[ evaluate true when special if autoappend and buffer-empty move spaces to doc-record move 1 to buffer-offset end-if if autodoc and buffered-output if filtering move doc-record to stdout-record write stdout-record end-write else write doc-record end-write end-if if verbose display function trim(doc-record trailing) end-display end-if move spaces to doc-record set buffer-empty to true move 1 to buffer-offset end-if *><] *><* *><* Skip over where the tag was found plus an extra space. *><* Adding 2 skips over the assumed space after a special tag *><* *><* :: *><* *><[ add 2 to counter compute len-of-comment = function length(trimmed) - counter end-compute if len-of-comment > 0 move trimmed(counter : len-of-comment) to doc-buffer else move spaces to doc-buffer end-if *><] *><* *><* Buffer the line, either to position 1 or appending to last. *><* *><* :: *><* *><[ string function trim(doc-buffer trailing) delimited by size into doc-record with pointer buffer-offset on overflow move line-count to line-display display "*** truncation *** reading line " line-display end-display end-string set buffered-output to true end-evaluate end-if *><] *><* *><* Again, we either read the next record from file or stdin. *><* *><* :: *><* *><[ if filtering read standard-input at end move high-values to stdin-record end-read move stdin-record to source-record else read source-input at end move high-values to source-record end-read end-if end-perform *><] *><* *><* We may or may not end up with buffered data *><* *><* :: *><* *><[ if buffered-output set buffer-empty to true move 1 to buffer-offset if filtering move doc-record to stdout-record write stdout-record end-write else write doc-record end-write end-if if verbose display function trim(doc-record trailing) end-display end-if move spaces to doc-record end-if *><] *><* *><* Close the OpenCOBOL files *><* *><* :: *><* *><[ if filtering close standard-output close standard-input else close doc-output close source-input end-if if verbose display "Input : " function trim(source-name) end-display display "Output : " function trim(doc-name) end-display end-if *><] *><* *><* If we have a result file, use the SYSTEM service to *><+ generate an HTML file, possibly with stylesheet. *><* *><* :: *><* *><[ *> pass the extract through a markover, in this case ReST move spaces to rst-command if result-name not equal spaces if style-name equal spaces string "rst2html " delimited by size doc-name delimited by space " " delimited by size result-name delimited by space into rst-command end-string else string "rst2html --stylesheet=" delimited by size style-name delimited by space " " delimited by size doc-name delimited by space " " delimited by size result-name delimited by space into rst-command end-string end-if if verbose display "Command: " function trim(rst-command trailing) end-display end-if call "SYSTEM" using rst-command returning result end-call if result not equal zero display "HTML generate failed: " result end-display end-if end-if *><] *><* *><* And before you know it, we are done. *><* *><* :: *><* *><[ goback. end program OCDOC. *><] *><* *><* Don't forget to visit http://opencobol.org *><* *><* Cheers *><* *><* *Last edit:* 03-Oct-2008 ................................... ocdoc generated ocdoc documentation ................................... See `ocdoc.html `_ for the output from processing *ocdoc.cob* with **ocdoc** using the tectonics listed in the source. skin.css ends up embedded in the html. .. sourcecode:: bash $ cobc -x ocdoc.cob $ ./ocdoc ocdoc.cob ocdoc.rst ocdoc.html skin.css -------------------- What is CBL_OC_DUMP? -------------------- CBL_OC_DUMP is somewhat of a community challenge application to allow for runtime data dumps. Multiple postings to opencobol.org_ has refined the hex display callable to: .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *----------------------------------------------------------------- * Authors: Brian Tiffin, Asger Kjelstrup, human * Date: 27-Jan-2010 * Purpose: Hex Dump display * Tectonics: cobc -c CBL_OC_DUMP.cob * Usage: cobc -x program.cob -o CBL_OC_DUMP * export OC_DUMP_EXT=1 for explanatory text on dumps * (memory address and dump length) * export OC_DUMP_EXT=Y for extended explanatory text * (architecture and endian-order) *----------------------------------------------------------------- identification division. program-id. CBL_OC_DUMP. * ENVIRONMENT DIVISION. CONFIGURATION SECTION. * data division. working-storage section. 77 addr usage pointer. 77 addr2addr usage pointer. 77 counter pic 999999 usage comp-5. 77 byline pic 999 usage comp-5. 77 offset pic 999999. 01 some pic 999 usage comp-5. 88 some-is-printable-iso88591 values 32 thru 126, 160 thru 255. 88 some-is-printable-ebcdic values 64, 65, 74 thru 80, 90 thru 97, 106 thru 111, 121 thru 127, 129 thru 137, 143, 145 thru 153, 159, 161 thru 169, 176, 186 thru 188, 192 thru 201, 208 thru 217, 224, 226 thru 233, 240 thru 249. 77 high-var pic 99 usage comp-5. 77 low-var pic 99 usage comp-5. * 01 char-set pic x(06). 88 is-ascii value 'ASCII'. 88 is-ebdic value 'EBCDIC'. 88 is-unknown value '?'. 01 architecture pic x(06). 88 is-32-bit value '32-bit'. 88 is-64-bit value '64-bit'. 01 endian-order pic x(10). 88 is-big-endian-no value 'Little-Big'. 88 is-big-endian-yes value 'Big-Little'. * 77 hex-line pic x(48). 77 hex-line-pointer pic 9(02) value 1. * 77 show pic x(16). 77 dots pic x value '.'. 77 dump-dots pic x. * 77 hex-digit pic x(16) value '0123456789abcdef'. 01 extended-infos pic x. 88 show-extended-infos values '1', '2', 'Y', 'y'. 88 show-very-extended-infos values '2', 'Y', 'y'. * 77 len pic 999999 usage comp-5. 77 len-display pic 999999. * linkage section. 01 buffer pic x any length. 77 byte pic x. *----------------------------------------------------------------- procedure division using buffer. * MAIN SECTION. 00. perform starting-address * perform varying counter from 0 by 16 until counter >= len move counter to offset move spaces to hex-line, show move '-' to hex-line (24:01) move 1 to hex-line-pointer perform varying byline from 1 by 1 until byline > 16 if (counter + byline) > len if byline < 9 move space to hex-line (24:01) end-if inspect show (byline:) replacing all spaces by dots exit perform else move buffer (counter + byline : 1) to byte perform calc-hex-value if ((some-is-printable-iso88591 and is-ascii) or (some-is-printable-ebcdic and is-ebdic) ) move byte to show (byline:1) else move dots to show (byline:1) end-if end-if end-perform display offset ' ' hex-line ' ' show end-display end-perform display ' ' end-display * continue. ex. exit program. *----------------------------------------------------------------- CALC-HEX-VALUE SECTION. 00. subtract 1 from function ord(byte) giving some end-subtract divide some by 16 giving high-var remainder low-var end-divide string hex-digit (high-var + 1:1) hex-digit (low-var + 1:1) space delimited by size into hex-line with pointer hex-line-pointer end-string * continue. ex. exit. *----------------------------------------------------------------- STARTING-ADDRESS SECTION. 00. * Get the length of the transmitted buffer CALL 'C$PARAMSIZE' USING 1 GIVING len END-CALL * If wanted, change the dots to something different than points accept dump-dots from environment 'OC_DUMP_DOTS' not on exception move dump-dots to dots end-accept * perform TEST-ASCII perform TEST-ENDIAN set addr to address of buffer set addr2addr to address of addr * if len > 0 * To show hex-address, reverse if Big-Little Endian if is-big-endian-yes set addr2addr up by LENGTH OF addr set addr2addr down by 1 end-if move 1 to hex-line-pointer perform varying byline from 1 by 1 until byline > LENGTH OF addr set address of byte to addr2addr perform calc-hex-value if is-big-endian-yes set addr2addr down by 1 else set addr2addr up by 1 end-if end-perform end-if * * Get and display characteristics and headline accept extended-infos from environment 'OC_DUMP_EXT' end-accept if show-extended-infos display ' ' end-display if len > 0 end-display display 'Dump of memory beginning at Hex-address: ' hex-line (1 : 3 * (byline - 1) ) end-display end-if move len to len-display display 'Length of memory dump is: ' len-display end-display if show-very-extended-infos perform TEST-64bit display 'Program runs in ' architecture ' architecture. ' 'Char-set is ' function trim (char-set) '.' end-display display 'Byte order is ' endian-order ' endian.' end-display end-if end-if * * Do we have anything to dump? if len > 0 * Ensure that the passed size is not too big if len > 999998 move 999998 to len, len-display display 'Warning, only the first ' len-display ' Bytes are shown!' end-display end-if display ' ' end-display display 'Offset ' 'HEX-- -- -- -5 -- -- -- -- 10 ' '-- -- -- -- 15 -- ' ' ' 'CHARS----1----5-' end-display else display ' ' end-display display 'Nothing to dump.' end-display end-if * continue. ex. exit. *----------------------------------------------------------------- TEST-ASCII SECTION. *Function: Discover if running Ascii or Ebcdic 00. evaluate space when x'20' set is-ascii to true when x'40' set is-ebdic to true when other set is-unknown to true end-evaluate * continue. ex. exit. *----------------------------------------------------------------- TEST-64BIT SECTION. *Function: Discover if running 32/64 bit 00. * Longer pointers in 64-bit architecture if function length (addr) <= 4 set is-32-bit to true else set is-64-bit to true end-if * continue. ex. exit. *----------------------------------------------------------------- TEST-ENDIAN SECTION. 00. * Number-bytes are shuffled in Big-Little endian move 128 to byline set address of byte to address of byline if function ord(byte) > 0 set is-big-endian-yes to true else set is-big-endian-no to true end-if * continue. ex. exit. *----------------------------------------------------------------- end program CBL_OC_DUMP. .. *><* Example displays:: Alpha literal Dump Offs HEX-- -- -- 5- -- -- -- -- 10 -- -- -- -- 15 -- CHARS----1----5- 0000 61 62 63 64 65 66 67 68 69 6a 6b 6c 6d 6f 70 71 abcdefghijklmopq 0016 72 r............... Integer Dump: +0000000123 Offs HEX-- -- -- 5- -- -- -- -- 10 -- -- -- -- 15 -- CHARS----1----5- 0000 7b 00 00 00 {............... Or with OC_DUMP_EXT enviroment variable set to Y:: Numeric Literal Dump: 0 Dump of memory beginning at Hex-address: bf 80 fc e4 Program runs in 32-bit architecture. Char-set is ASCII . Byte order is Big-Little endian. Offs HEX-- -- -- 5- -- -- -- -- 10 -- -- -- -- 15 -- CHARS----1----5- 0000 00 ................ ..................... Update to OC_CBL_DUMP ..................... human posted a new version that displays the dump upon SYSERR. Goes to show the activity that can spring forth from a keen and engaged community. *Edit 19-Oct-2010: Put all dump-outputs to syserr. Removed unused paragraphs and minor beauty changes.* .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *----------------------------------------------------------------- * Authors: Brian Tiffin, Asger Kjelstrup, Simon Sobisch * Date: 19-Oct-2010 * Purpose: Hex Dump display * Tectonics: cobc -c CBL_OC_DUMP.cob * Usage: export OC_DUMP_EXT=1 for explanatory text on dumps * (memory address and dump length) * export OC_DUMP_EXT=Y for extended explanatory text * (architecture and endian-order) *----------------------------------------------------------------- IDENTIFICATION DIVISION. PROGRAM-ID. CBL_OC_DUMP. * ENVIRONMENT DIVISION. CONFIGURATION SECTION. * DATA DIVISION. WORKING-STORAGE SECTION. 77 addr usage pointer. 77 addr2addr usage pointer. 77 counter pic 999999 usage comp-5. 77 byline pic 999 usage comp-5. 77 offset pic 999999. 01 some pic 999 usage comp-5. 88 some-is-printable-iso88591 values 32 thru 126, 160 thru 255. 88 some-is-printable-ebcdic values 64, 65, 74 thru 80, 90 thru 97, 106 thru 111, 121 thru 127, 129 thru 137, 143, 145 thru 153, 159, 161 thru 169, 176, 186 thru 188, 192 thru 201, 208 thru 217, 224, 226 thru 233, 240 thru 249. 77 high-var pic 99 usage comp-5. 77 low-var pic 99 usage comp-5. * 01 char-set pic x(06). 88 is-ascii value 'ASCII'. 88 is-ebdic value 'EBCDIC'. 88 is-unknown value '?'. 01 architecture pic x(06). 88 is-32-bit value '32-bit'. 88 is-64-bit value '64-bit'. 01 endian-order pic x(10). 88 is-big-endian-no value 'Little-Big'. 88 is-big-endian-yes value 'Big-Little'. * 77 hex-line pic x(48). 77 hex-line-pointer pic 9(02) value 1. * 77 show pic x(16). 77 dots pic x value '.'. 77 dump-dots pic x. * 77 hex-digit pic x(16) value '0123456789abcdef'. 01 extended-infos pic x. 88 show-extended-infos values '1', '2', 'Y', 'y'. 88 show-very-extended-infos values '2', 'Y', 'y'. * 77 len pic 999999 usage comp-5. 77 len-display pic 999999. * LINKAGE SECTION. 01 buffer pic x any length. 77 byte pic x. *----------------------------------------------------------------- PROCEDURE DIVISION USING buffer. * *MAIN SECTION. *00. perform starting-address * perform varying counter from 0 by 16 until counter >= len move counter to offset move spaces to hex-line, show move '-' to hex-line (24:01) move 1 to hex-line-pointer perform varying byline from 1 by 1 until byline > 16 if (counter + byline) > len if byline < 9 move space to hex-line (24:01) end-if inspect show (byline:) replacing all spaces by dots exit perform else move buffer (counter + byline : 1) to byte perform calc-hex-value if ((some-is-printable-iso88591 and is-ascii) or (some-is-printable-ebcdic and is-ebdic) ) move byte to show (byline:1) else move dots to show (byline:1) end-if end-if end-perform display offset ' ' hex-line ' ' show upon SYSERR end-display end-perform display ' ' upon SYSERR end-display * exit program. *----------------------------------------------------------------- CALC-HEX-VALUE SECTION. *00. subtract 1 from function ord(byte) giving some end-subtract divide some by 16 giving high-var remainder low-var end-divide string hex-digit (high-var + 1:1) hex-digit (low-var + 1:1) space delimited by size into hex-line with pointer hex-line-pointer end-string * exit section. *----------------------------------------------------------------- STARTING-ADDRESS SECTION. *00. * Get the length of the transmitted buffer CALL 'C$PARAMSIZE' USING 1 GIVING len END-CALL * If wanted, change the dots to something different than points accept dump-dots from environment 'OC_DUMP_DOTS' not on exception move dump-dots to dots end-accept * perform TEST-ASCII perform TEST-ENDIAN set addr to address of buffer set addr2addr to address of addr * if len > 0 * To show hex-address, reverse if Big-Little Endian if is-big-endian-yes set addr2addr up by LENGTH OF addr set addr2addr down by 1 end-if move 1 to hex-line-pointer perform varying byline from 1 by 1 until byline > LENGTH OF addr set address of byte to addr2addr perform calc-hex-value if is-big-endian-yes set addr2addr down by 1 else set addr2addr up by 1 end-if end-perform end-if * * Get and display characteristics and headline accept extended-infos from environment 'OC_DUMP_EXT' end-accept if show-extended-infos display ' ' upon SYSERR end-display if len > 0 display 'Dump of memory beginning at Hex-address: ' hex-line (1 : 3 * (byline - 1) ) upon SYSERR end-display end-if move len to len-display display 'Length of memory dump is: ' len-display upon SYSERR end-display if show-very-extended-infos perform TEST-64bit display 'Program runs in ' architecture ' architecture. ' 'Char-set is ' function trim (char-set) '.' upon SYSERR end-display display 'Byte order is ' endian-order ' endian.' upon SYSERR end-display end-if end-if * * Do we have anything to dump? if len > 0 * Ensure that the passed size is not too big if len > 999998 move 999998 to len, len-display display 'Warning, only the first ' len-display ' Bytes are shown!' upon SYSERR end-display end-if display ' ' upon SYSERR end-display display 'Offset ' 'HEX-- -- -- -5 -- -- -- -- 10 ' '-- -- -- -- 15 -- ' ' ' 'CHARS----1----5-' upon SYSERR end-display else display ' ' upon SYSERR end-display display 'Nothing to dump.' upon SYSERR end-display end-if * exit section. *----------------------------------------------------------------- TEST-ASCII SECTION. *Function: Discover if running Ascii or Ebcdic *00. evaluate space when x'20' set is-ascii to true when x'40' set is-ebdic to true when other set is-unknown to true end-evaluate * exit section. *----------------------------------------------------------------- TEST-64BIT SECTION. *Function: Discover if running 32/64 bit *00. * Longer pointers in 64-bit architecture if function length (addr) <= 4 set is-32-bit to true else set is-64-bit to true end-if * exit section. *----------------------------------------------------------------- TEST-ENDIAN SECTION. *00. * Number-bytes are shuffled in Big-Little endian move 128 to byline set address of byte to address of byline if function ord(byte) > 0 set is-big-endian-yes to true else set is-big-endian-no to true end-if * exit section. *----------------------------------------------------------------- end program CBL_OC_DUMP. ----------------------------------------- Does OpenCOBOL support any SQL databases? ----------------------------------------- Yes. There is no embedded SQL in OpenCOBOL in terms of EXEC but there are *at least* two usable CALL extensions, the EXEC potential of the Firebird **gpre** and the tried and successful use of Oracle's **procob**. There are |currently| quite a few active developments for easing SQL engine access. * as reported on opencobol.org_ the **procob 10.2 Oracle** preprocessor produces code that compiles and executes just fine with OpenCOBOL 1.1 See note about data sizes and the *binary-size:* configuration below. * There are workable prototypes for SQLite at `ocshell.c `_ - with a sample usage program at `sqlscreen.cob `_ - and supporting documentation at `sqlscreen.html `_ * The SQLite extension comes in two flavours; a shell mode discussed above and a direct API interface housed at `ocsqlite.c `_ * A libdbi (generic database access) extension is also available. See `cobdbi `_ for full details. * Efforts toward providing a preprocessor for EXEC are underway. * Jim Currey's team has kindly posted an ease-of-use MySQL preprocessing layer. - http://svn.wp0.org/add1/libraries/mysql4Windows4OpenCobol/ * Rumours of a potential Postgres layer have also been heard. - Not a rumour anymore. Work on a nicely complete PostgreSQL binding was posted by gchudyk to - http://www.opencobol.org/modules/newbb/viewtopic.php?topic_id=868&forum=1&post_id=4142 * **AND** as a *thing to watch for*, one of the good people of the OpenCOBOL communinity has written a layer that converts READ and WRITE verbage to SQL calls *at run time*. More on this as it progresses. ................................... Oracle procob and binary data sizes ................................... Details of the configuration setting for proper Oracle procob processing. From Angus on opencobol.org_ :: Hi I had some trouble with Oracle procob 10.2 and OpenCobol 1.1 with std=mf. For PIC S9(2) COMP, procob seems to use 2 bytes, and OpenCobol only one. It doesn't work well. It comes from the parameter binary-size in the mf.conf, which seems to tell to opencobol the larger of comp type I modify to binary-size: 2-4-8 and it works (same as the mvs.conf) Our application works with Microfocus / Oracle, and microfocus use 2 bytes, like Oracle. Perhaps because we have the mvs toggle Except for this thing, opencobol and oracle work like a charm, on a debian 32bit. Regards, Angus ................. PostgreSQL Sample ................. Nowhere near as complete as the binding that Gerald posted to opencobol.org_, the example below was a starting point. See http://www.opencobol.org/modules/newbb/viewtopic.php?topic_id=868&forum=1#forumpost4142 Note that the PostgreSQL runtime library is **libpq**, *ending in q not g*. .. sourcecode:: cobol OCOBOL*> *************************************************************** *> Author: Brian Tiffin *> Date: 20091129 *> Purpose: PostgreSQL connection test *> Tectonics: cobc -x -lpq pgcob.cob *> *************************************************************** identification division. program-id. pgcob. data division. working-storage section. 01 pgconn usage pointer. 01 pgres usage pointer. 01 resptr usage pointer. 01 resstr pic x(80) based. 01 result usage binary-long. 01 answer pic x(80). *> *************************************************************** procedure division. display "Before connect:" pgconn end-display call "PQconnectdb" using by reference "dbname = postgres" & x"00" returning pgconn end-call display "After connect: " pgconn end-display call "PQstatus" using by value pgconn returning result end-call display "Status: " result end-display call "PQuser" using by value pgconn returning resptr end-call set address of resstr to resptr string resstr delimited by x"00" into answer end-string display "User: " function trim(answer) end-display display "call PQexec" end-display call "PQexec" using by value pgconn by reference "select version();" & x"00" returning pgres end-call display pgres end-display *> Pull out a result. row 0, field 0 <* call "PQgetvalue" using by value pgres by value 0 by value 0 returning resptr end-call set address of resstr to resptr string resstr delimited by x"00" into answer end-string display "Version: " answer end-display call "PQfinish" using by value pgconn returning null end-call display "After finish: " pgconn end-display call "PQstatus" using by value pgconn returning result end-call display "Status: " result end-display *> this will now return garbage <* call "PQuser" using by value pgconn returning resptr end-call set address of resstr to resptr string resstr delimited by x"00" into answer end-string display "User after: " function trim(answer) end-display goback. end program pgcob. Run from a user account that has default PostgreSQL credentials:: $ cobc -x -lpq pgcob.cob $ ./pgcob Before connect:0x00000000 After connect: 0x086713e8 Status: +0000000000 User: brian call PQexec 0x08671a28 Version: PostgreSQL 8.3.7 on i486-pc-linux-gnu, compiled by GCC gcc-4.3.real (Debian 4.3. After finish: 0x086713e8 Status: +0000000001 User after: PostgreSQL 8.3.7 on i486-pc-linux-gnu, compiled by GCC gcc-4.3.real (Debian 4.3. Note that *User after* is not the valid answer, shown on purpose. The connection had been closed and the status was correctly reported as non-zero, being an error, but this example continued through as a demonstration. ---------------------------- Does OpenCOBOL support ISAM? ---------------------------- Yes. The official release used Berkeley DB, but there are also experimental configurations of the compiler that use VBISAM, CISAM, DISAM or other external handlers. See `What are the configure options available for building OpenCOBOL?`_ for more details about these options. The rest of this entry assumes the default Berkeley database. ISAM_ is an acronymn for Indexed Sequential Access Method. OpenCOBOL has fairly full support of all standard specified ISAM compile and runtime semantics. For example .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *><* ================ *><* indexing example *><* ================ *><* :Author: Brian Tiffin *><* :Date: 17-Feb-2009 *><* :Purpose: Fun with Indexed IO routines *><* :Tectonics: cobc -x indexing.cob *> *************************************************************** identification division. program-id. indexing. environment division. configuration section. input-output section. file-control. select optional indexing assign to "indexing.dat" organization is indexed access mode is dynamic record key is keyfield of indexing-record alternate record key is splitkey of indexing-record with duplicates . *> ** OpenCOBOL does not yet support split keys ** *> alternate record key is newkey *> source is first-part of indexing-record *> last-part of indexing-record *> with duplicates data division. file section. fd indexing. 01 indexing-record. 03 keyfield pic x(8). 03 splitkey. 05 first-part pic 99. 05 middle-part pic x. 05 last-part pic 99. 03 data-part pic x(54). working-storage section. 01 display-record. 03 filler pic x(4) value spaces. 03 keyfield pic x(8). 03 filler pic xx value spaces. 03 splitkey. 05 first-part pic z9. 05 filler pic x value space. 05 middle-part pic x. 05 filler pic xx value all "+". 05 last-part pic z9. 03 filler pic x(4) value all "-". 03 data-part pic x(54). *> control break 01 oldkey pic 99x99. *> In a real app this should well be two separate flags 01 control-flag pic x. 88 no-more-duplicates value high-value when set to false is low-value. 88 no-more-records value high-value when set to false is low-value. *> *************************************************************** procedure division. *> Open optional index file for read write open i-o indexing *> populate a sample database move "1234567800a01some 12345678 data here" to indexing-record perform write-indexing-record move "8765432100a01some 87654321 data here" to indexing-record perform write-indexing-record move "1234876500a01some 12348765 data here" to indexing-record perform write-indexing-record move "8765123400a01some 87651234 data here" to indexing-record perform write-indexing-record move "1234567900b02some 12345679 data here" to indexing-record perform write-indexing-record move "9765432100b02some 97654321 data here" to indexing-record perform write-indexing-record move "1234976500b02some 12349765 data here" to indexing-record perform write-indexing-record move "9765123400b02some 97651234 data here" to indexing-record perform write-indexing-record move "1234568900c13some 12345689 data here" to indexing-record perform write-indexing-record move "9865432100c13some 98654321 data here" to indexing-record perform write-indexing-record move "1234986500c13some 12349865 data here" to indexing-record perform write-indexing-record move "9865123400c13some 98651234 data here" to indexing-record perform write-indexing-record *> close it ... not necessary, but for the example close indexing *> clear the record space for this example move spaces to indexing-record *> open the data file again open i-o indexing *> read all the duplicate 00b02 keys move 00 to first-part of indexing-record move "b" to middle-part of indexing-record move 02 to last-part of indexing-record *> using read key and then next key / last key compare set no-more-duplicates to false perform read-indexing-record perform read-next-record until no-more-duplicates *> read by key of reference ... the cool stuff move 00 to first-part of indexing-record move "a" to middle-part of indexing-record move 02 to last-part of indexing-record *> using start and read next set no-more-records to false perform start-at-key perform read-next-by-key until no-more-records *> read by primary key of reference move "87654321" to keyfield of indexing-record *> set no-more-records to false perform start-prime-key perform read-previous-by-key until no-more-records *> and with that we are done with indexing sample close indexing goback. *> *************************************************************** *><* Write paragraph write-indexing-record. write indexing-record invalid key display "rewrite key: " keyfield of indexing-record end-display rewrite indexing-record invalid key display "really bad key: " keyfield of indexing-record end-display end-rewrite end-write . *><* read by alternate key paragraph read-indexing-record. display "Reading: " splitkey of indexing-record end-display read indexing key is splitkey of indexing-record invalid key display "bad read key: " splitkey of indexing-record end-display set no-more-duplicates to true end-read . *><* read next sequential paragraph read-next-record. move corresponding indexing-record to display-record display display-record end-display move splitkey of indexing-record to oldkey read indexing next record at end set no-more-duplicates to true not at end if oldkey not equal splitkey of indexing-record set no-more-duplicates to true end-if end-read . *><* start primary key of reference paragraph start-prime-key. display "Prime < " keyfield of indexing-record end-display start indexing key is less than keyfield of indexing-record invalid key display "bad start: " keyfield of indexing-record end-display set no-more-records to true not invalid key read indexing previous record at end set no-more-records to true end-read end-start . *><* read previous by key of reference paragraph read-previous-by-key. move corresponding indexing-record to display-record display display-record end-display read indexing previous record at end set no-more-records to true end-read . *><* start alternate key of reference paragraph start-at-key. display "Seeking >= " splitkey of indexing-record end-display start indexing key is greater than or equal to splitkey of indexing-record invalid key display "bad start: " splitkey of indexing-record end-display set no-more-records to true not invalid key read indexing next record at end set no-more-records to true end-read end-start . *><* read next by key of reference paragraph read-next-by-key. move corresponding indexing-record to display-record display display-record end-display read indexing next record at end set no-more-records to true end-read . end program indexing. *><* *><* Last Update: 20090220 which outputs:: Reading: 00b02 12345679 0 b++ 2----some 12345679 data here 97654321 0 b++ 2----some 97654321 data here 12349765 0 b++ 2----some 12349765 data here 97651234 0 b++ 2----some 97651234 data here 12345679 0 b++ 2----some 12345679 data here 97654321 0 b++ 2----some 97654321 data here 12349765 0 b++ 2----some 12349765 data here 97651234 0 b++ 2----some 97651234 data here 12345679 0 b++ 2----some 12345679 data here 97654321 0 b++ 2----some 97654321 data here 12349765 0 b++ 2----some 12349765 data here 97651234 0 b++ 2----some 97651234 data here Seeking >= 00a02 12345679 0 b++ 2----some 12345679 data here 97654321 0 b++ 2----some 97654321 data here 12349765 0 b++ 2----some 12349765 data here 97651234 0 b++ 2----some 97651234 data here 12345679 0 b++ 2----some 12345679 data here 97654321 0 b++ 2----some 97654321 data here 12349765 0 b++ 2----some 12349765 data here 97651234 0 b++ 2----some 97651234 data here 12345679 0 b++ 2----some 12345679 data here 97654321 0 b++ 2----some 97654321 data here 12349765 0 b++ 2----some 12349765 data here 97651234 0 b++ 2----some 97651234 data here 12345689 0 c++13----some 12345689 data here 98654321 0 c++13----some 98654321 data here 12349865 0 c++13----some 12349865 data here 98651234 0 c++13----some 98651234 data here 12345689 0 c++13----some 12345689 data here 98654321 0 c++13----some 98654321 data here 12349865 0 c++13----some 12349865 data here 98651234 0 c++13----some 98651234 data here 12345689 0 c++13----some 12345689 data here 98654321 0 c++13----some 98654321 data here 12349865 0 c++13----some 12349865 data here 98651234 0 c++13----some 98651234 data here Prime < 87654321 87651234 0 a++ 1----some 87651234 data here 12349865 0 c++13----some 12349865 data here 12349765 0 b++ 2----some 12349765 data here 12348765 0 a++ 1----some 12348765 data here 12345689 0 c++13----some 12345689 data here 12345679 0 b++ 2----some 12345679 data here 12345678 0 a++ 1----some 12345678 data here on any first runs, where **indexing.dat** does not exist. Subsequent runs have the same output with:: rewrite key: 12345678 rewrite key: 87654321 rewrite key: 12348765 rewrite key: 87651234 rewrite key: 12345679 rewrite key: 97654321 rewrite key: 12349765 rewrite key: 97651234 rewrite key: 12345689 rewrite key: 98654321 rewrite key: 12349865 rewrite key: 98651234 prepended, as the WRITE INVALID KEY clause triggers a REWRITE to allow overwriting key and data. ........... FILE STATUS ........... Historically, the condition of a COBOL I/O operation is set in an identifier specified in a *FILE STATUS IS* clause. John Ellis did us the favour of codifying the OpenCOBOL FILE STATUS codes See `ISAM`_ for the details. ------------------------------- Does OpenCOBOL support modules? ------------------------------- Yes. Quite nicely in fact. Dynamically! COBOL_ modules, and object files of many other languages are linkable. As OpenCOBOL uses intermediate C, linkage to other languages is well supported across many platforms. The OpenCOBOL CALL_ instruction maps COBOL USAGE_ to many common C stack frame data representations. Multipart, complex system development is well integrated in the OpenCOBOL model. .. sourcecode:: bash $ cobc -b hello.cob goodbye.cob Combines both source files into a single dynamically loadable module. Example produces **hello.so**. Using the **-l** link library option, OpenCOBOL has access to most shared libraries supported on its platforms. .. sourcecode:: bash $ cobc -x -lcurl showcurl.cob Will link the /usr/lib/libcurl.so (*from the cURL project*) to showcurl. The OpenCOBOL CALL_ verb will use this linked library to resolve calls at runtime. Large scale systems are at the heart of COBOL development and OpenCOBOL is no exception. For more information, see `What is COB_PRE_LOAD?`_. --------------------- What is COB_PRE_LOAD? --------------------- COB_PRE_LOAD is an environment variable that controls what dynamic link modules are included in a run. For example: .. sourcecode:: bash $ cobc occurl.c $ cobc occgi.c $ cobc -x myprog.cob $ export COB_PRE_LOAD=occurl:occgi $ ./myprog That will allow the OpenCOBOL runtime link resolver to find the entry point for CALL "CBL_OC_CURL_INIT" in the occurl.so module. *Note:* the modules listed in the COB_PRE_LOAD environment variable DO NOT have extensions. OpenCOBOL will do the right thing on the various platforms. If the DSO_ files are not in the current working directory along with the executable, the COB_LIBRARY_PATH can be set to find them. See `What is COB_LIBRARY_PATH?`_ for information on setting the module search path. ------------------------------------------ What is the OpenCOBOL LINKAGE SECTION for? ------------------------------------------ Argument passing in COBOL is normally accomplished through the **LINKAGE SECTION**. This section does not allocate or initialize memory as would definitions in the WORKING-STORAGE SECTION. Care must be taken to inform COBOL of the actual source address of these variables before use. Influences CHAINING and USING phrases. See CALL_ for more details. ------------------------------------------------------------ What does the -fstatic-linkage OpenCOBOL compiler option do? ------------------------------------------------------------ Under normal conditions, the *LINKAGE SECTION* is unallocated and uninitialized. When a LINKAGE SECTION variable, that is not part of the *USING* phrase (not a named calling argument), any memory that has been addressed becomes unaddressable across calls. *-fstatic-linkage* creates static addressing to the LINKAGE SECTION. From [Roger]_:: This relates to LINKAGE items that are NOT referred to in the USING phrase of the PROCEDURE DIVISION. It also only has relevance when the program is CALL'ed from another prog. This means that the addressability of these items must be programmed (usually with SET ADDRESS) before reference. Per default, the item loses its addressability on exit from the program. This option causes the module to retain the item's address between CALL invocations of the program. With some rumours that this may become the default in future releases of OpenCOBOL, and the *-fstatic-linkage* option may be deprecated. -------------------------------------- Does OpenCOBOL support Message Queues? -------------------------------------- Yes, but not out of the box. A linkable POSIX message queue layer is available. .. sourcecode:: c /* OpenCOBOL access to POSIX Message Queues */ /* Author: Brian Tiffin */ /* Date: August, 2008 */ /* Build: gcc -c ocmq.c */ /* Usage: cobc -x -lrt program.cob ocmq.o */ #include /* For O_* constants */ #include /* For mode constants */ #include /* Access to error values */ #include /* The message queues */ #include /* for notification */ #include /* for the timed versions */ #include #include /* For strerror */ #include /* for cob_resolve */ /* Forward declarations */ static void ocmq_handler(int, siginfo_t *, void *); static void (*MQHANDLER)(int *mqid); /* Return C runtime global errno */ int ERRORNUMBER() { return errno; } /* Load a COBOL field with an error string */ int ERRORSTRING(char *errbuff, int buflen) { void *temperr; temperr = strerror(errno); memcpy((void *)errbuff, temperr, buflen); return strlen(temperr); } /* /* Open Message Queue */ int MQOPEN(char *mqname, int oflags) { mqd_t mqres; errno = 0; mqres = mq_open(mqname, oflags); return (int)mqres; } /* Creating a queue requires two extra arguments, permissions and attributes */ int MQCREATE(char *mqname, int oflags, int perms, char *mqattr) { mqd_t mqres; errno = 0; mqres = mq_open(mqname, oflags, (mode_t)perms, (struct mq_attr *)mqattr); return (int)mqres; } /* Get current queue attributes */ int MQGETATTR(int mqid, char *mqattr) { mqd_t mqres; errno = 0; mqres = mq_getattr((mqd_t)mqid, (struct mq_attr *)mqattr); return (int)mqres; } /* Set current queue attributes */ /* only accepts mqflags of 0 or MQO-NONBLOCK once created */ int MQSETATTR(int mqid, char *mqattr, char *oldattr) { mqd_t mqres; errno = 0; mqres = mq_setattr((mqd_t)mqid, (struct mq_attr *)mqattr, (struct mq_attr *)oldattr); return (int)mqres; } /* Send a message to the queue */ int MQSEND(int mqid, char *message, int length, unsigned int mqprio) { mqd_t mqres; errno = 0; mqres = mq_send((mqd_t)mqid, message, (size_t)length, mqprio); return (int)mqres; } /* Read the highest priority message */ int MQRECEIVE(int mqid, char *msgbuf, int buflen, int *retprio) { ssize_t retlen; errno = 0; retlen = mq_receive((mqd_t)mqid, msgbuf, buflen, retprio); return (int)retlen; } /* Timeout send */ int MQTIMEDSEND(int mqid, char *message, int length, unsigned int mqprio, int secs, long nanos) { mqd_t mqres; struct timespec mqtimer; struct timeval curtime; /* Expect seconds and nanos to wait, not absolute. Add the OpenCOBOL values */ gettimeofday(&curtime, NULL); mqtimer.tv_sec = curtime.tv_sec + (time_t)secs; mqtimer.tv_nsec = nanos; errno = 0; mqres = mq_timedsend((mqd_t)mqid, message, (size_t)length, mqprio, &mqtimer); return (int)mqres; } /* Read the highest priority message */ int MQTIMEDRECEIVE(int mqid, char *msgbuf, int buflen, int *retprio, int secs, long nanos) { ssize_t retlen; struct timespec mqtimer; struct timeval curtime; /* Expect seconds and nanos to wait, not absolute. Add the OpenCOBOL values */ gettimeofday(&curtime, NULL); mqtimer.tv_sec = curtime.tv_sec + (time_t)secs; mqtimer.tv_nsec = nanos; errno = 0; retlen = mq_timedreceive((mqd_t)mqid, msgbuf, buflen, retprio, &mqtimer); return (int)retlen; } /* Notify of new message written to queue */ int MQNOTIFY(int mqid, char *procedure) { struct sigevent ocsigevent; struct sigaction ocsigaction; /* Install signal handler for the notify signal - fill in a * sigaction structure and pass it to sigaction(). Because the * handler needs the siginfo structure as an argument, the * SA_SIGINFO flag is set in sa_flags. */ ocsigaction.sa_sigaction = ocmq_handler; ocsigaction.sa_flags = SA_SIGINFO; sigemptyset(&ocsigaction.sa_mask); if (sigaction(SIGUSR1, &ocsigaction, NULL) == -1) { fprintf(stderr, "%s\n", "Error posting sigaction"); return -1; } /* Set up notification: fill in a sigevent structure and pass it * to mq_notify(). The queue ID is passed as an argument to the * signal handler. */ ocsigevent.sigev_signo = SIGUSR1; ocsigevent.sigev_notify = SIGEV_SIGNAL; ocsigevent.sigev_value.sival_int = (int)mqid; if (mq_notify((mqd_t)mqid, &ocsigevent) == -1) { fprintf(stderr, "%s\n", "Error posting notify"); return -1; } return 0; } /* Close a queue */ int MQCLOSE(int mqid) { mqd_t mqres; errno = 0; mqres = mq_close((mqd_t)mqid); return (int)mqres; } /* Unlink a queue */ int MQUNLINK(char *mqname) { mqd_t mqres; errno = 0; mqres = mq_unlink(mqname); return (int)mqres; } /* The signal handling section */ /* signal number */ /* signal information */ /* context unused (required by posix) */ static void ocmq_handler(int sig, siginfo_t *pInfo, void *pSigContext) { struct sigevent ocnotify; mqd_t mqid; /* Get the ID of the message queue out of the siginfo structure. */ mqid = (mqd_t) pInfo->si_value.sival_int; /* The MQPROCESSOR is a hardcoded OpenCOBOL resolvable module name */ /* It must accept an mqd_t pointer */ cob_init(0, NULL); MQHANDLER = cob_resolve("MQPROCESSOR"); if (MQHANDLER == NULL) { /* What to do here? */ fprintf(stderr, "%s\n", "Error resolving MQPROCESSOR"); return; } /* Request notification again; it resets each time a notification * signal goes out. */ ocnotify.sigev_signo = pInfo->si_signo; ocnotify.sigev_value = pInfo->si_value; ocnotify.sigev_notify = SIGEV_SIGNAL; if (mq_notify(mqid, &ocnotify) == -1) { /* What to do here? */ fprintf(stderr, "%s\n", "Error posting notify"); return; } /* Call the cobol module with the message queue id */ MQHANDLER(&mqid); return; } /**/ With a sample of usage. Note the linkage of the rt.so realtime library. .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED ****************************************************************** * Author: Brian Tiffin * Date: August 2008 * Purpose: Demonstration of OpenCOBOL message queues * Tectonics: gcc -c ocmq.c * cobc -Wall -x -lrt mqsample.cob ocmq.o ****************************************************************** identification division. program-id. mqsample. data division. working-storage section. * Constants for the Open Flags 01 MQO-RDONLY constant as 0. 01 MQO-WRONLY constant as 1. 01 MQO-RDWR constant as 2. 01 MQO-CREAT constant as 64. 01 MQO-EXCL constant as 128. 01 MQO-NONBLOCK constant as 2048. * Constants for the protection/permission bits 01 MQS-IREAD constant as 256. 01 MQS-IWRITE constant as 128. * Need a better way of displaying newlines 01 newline pic x value x'0a'. * Message Queues return an ID, maps to int 01 mqid usage binary-long. 01 mqres usage binary-long. * Queue names end up in an mqueue virtual filesystem on GNU/Linux 01 mqname. 02 name-display pic x(5) value "/ocmq". 02 filler pic x value x'00'. 01 mqopenflags usage binary-long. 01 mqpermissions usage binary-long. 01 default-message pic x(20) value 'OpenCOBOL is awesome'. 01 user-message pic x(80). 01 send-length usage binary-long. 01 urgent-message pic x(20) value 'Urgent OpenCOBOL msg'. * Data members for access to C global errno and error strings 01 errnumber usage binary-long. 01 errstr pic x(256). * legend to use with the error reporting 01 operation pic x(7). 01 loopy pic 9. * Debian GNU/Linux defaults to Message Queue entry limit of 8K 01 msgbuf pic x(8192). 01 msglen usage binary-long value 8192. * Priorities range from 0 to 31 on many systems, can be more 01 msgprio usage binary-long. * MQ attributes. See /usr/include/bits/mqueue.h 01 mqattr. 03 mqflags usage binary-long. 03 mqmaxmsg usage binary-long. 03 mqmsgsize usage binary-long. 03 mqcurmsqs usage binary-long. 03 filler usage binary-long occurs 4 times. 01 oldattr. 03 mqflags usage binary-long. 03 mqmaxmsg usage binary-long. 03 mqmsgsize usage binary-long. 03 mqcurmsqs usage binary-long. 03 filler usage binary-long occurs 4 times. procedure division. * The ocmq API support MQCREATE and MQOPEN. * This example uses non blocking, non exclusive create * read/write by owner and default attributes compute mqopenflags = MQO-RDWR + MQO-CREAT + MQO-NONBLOCK end-compute. compute mqpermissions = MQS-IREAD + MQS-IWRITE end-compute. * Sample shows the two types of open, but only evaluates create if zero = zero call "MQCREATE" using mqname by value mqopenflags by value mqpermissions by value 0 returning mqid end-call else call "MQOPEN" using mqname by value mqopenflags returning mqid end-call end-if. move "create" to operation. perform show-error. * Show the attributes after initial create perform show-attributes. * Register notification call "MQNOTIFY" using by value mqid mqname returning mqres end-call. move "notify" to operation. perform show-error. * Create a temporary queue, will be removed on close * call "MQUNLINK" using mqname * returning mqres * end-call. * move "unlink" to operation. * perform show-error. * Use the command line arguments or a default message accept user-message from command-line end-accept. if user-message equal spaces move default-message to user-message end-if. move function length (function trim(user-message trailing)) to send-length. * Queue up an urgent message (priority 31) call "MQSEND" using by value mqid by reference urgent-message by value 20 by value 31 end-call. move "send-31" to operation. perform show-error. * Queue up a low priority message (1) call "MQSEND" using by value mqid by reference user-message by value send-length by value 1 returning mqres end-call. move "send-1" to operation. perform show-error. * Queue up a middle priority message (16) inspect urgent-message replacing leading "Urgent" by "Middle". call "MQSEND" using by value mqid by reference urgent-message by value 20 by value 16 returning mqres end-call. move "send-16" to operation. perform show-error. * Redisplay the queue attributes perform show-attributes. * Pull highest priority message off queue call "MQRECEIVE" using by value mqid by reference msgbuf by value msglen by reference msgprio returning mqres end-call. display newline "receive len: " mqres " prio: " msgprio end-display. if mqres > 0 display "priority 31 message: " msgbuf(1:mqres) end-display end-if. move "receive" to operation. perform show-error. * Pull the middling priority message off queue call "MQRECEIVE" using by value mqid by reference msgbuf by value msglen by reference msgprio returning mqres end-call. display newline "receive len: " mqres " prio: " msgprio end-display. if mqres > 0 display "priority 16 message: " msgbuf(1:mqres) end-display end-if. move "receive" to operation. perform show-error. * ** INTENTIONAL ERROR msglen param too small ** * Pull message off queue call "MQRECEIVE" using by value mqid by reference msgbuf by value 1024 by reference msgprio returning mqres end-call. display newline "receive len: " mqres " prio: " msgprio end-display. if mqres > 0 display "no message: " msgbuf(1:mqres) end-display end-if. move "receive" to operation. perform show-error. * Pull the low priority message off queue, in blocking mode move MQO-NONBLOCK to mqflags of mqattr. call "MQSETATTR" using by value mqid by reference mqattr by reference oldattr returning mqres end-call move "setattr" to operation. perform show-error. perform show-attributes. call "MQRECEIVE" using by value mqid by reference msgbuf by value msglen by reference msgprio returning mqres end-call. display newline "receive len: " mqres " prio: " msgprio end-display. if mqres > 0 display "priority 1 message: " msgbuf(1:mqres) end-display end-if. move "receive" to operation. perform show-error. perform varying loopy from 1 by 1 until loopy > 5 display "Sleeper call " loopy end-display call "CBL_OC_NANOSLEEP" using 50000000000 returning mqres end-call end-perform. * Close the queue. As it is set unlinked, it will be removed call "MQCLOSE" using by value mqid returning mqres end-call. move "close" to operation. perform show-error. * Create a temporary queue, will be removed on close call "MQUNLINK" using mqname returning mqres end-call. move "unlink" to operation. perform show-error. goback. ****************************************************************** * Information display of the Message Queue attributes. show-attributes. call "MQGETATTR" using by value mqid by reference mqattr returning mqres end-call move "getattr" to operation. perform show-error. * Display the message queue attributes display name-display " attributes:" newline "flags: " mqflags of mqattr newline "max msg: " mqmaxmsg of mqattr newline "mqs size: " mqmsgsize of mqattr newline "cur msgs: " mqcurmsqs of mqattr end-display . * The C global errno error display paragraph show-error. call "ERRORNUMBER" returning mqres end-call if mqres > 0 display operation " errno: " mqres end-display call "ERRORSTRING" using errstr by value length errstr returning mqres end-call if mqres > 0 display " strerror: " errstr(1:mqres) end-display end-if end-if . end program mqsample. ****************************************************************** * Author: Brian Tiffin * Date: August 2008 * Purpose: Demonstration of OpenCOBOL message queue notification * Tectonics: gcc -c ocmq.c * cobc -Wall -x -lrt mqsample.cob ocmq.o ****************************************************************** identification division. program-id. MQSIGNAL. data division. working-storage section. 01 msgbuf pic x(8192). 01 msglen usage binary-long value 8192. 01 msgprio usage binary-long. 01 mqres usage binary-long. linkage section. 01 mqid usage binary-long. procedure division using mqid. display "in MQSIGNAL". display "In the COBOL procedure with " mqid end-display. perform with test after until mqres <= 0 call "MQRECEIVE" using by value mqid by reference msgbuf by value msglen by reference msgprio returning mqres end-call display "receive len: " mqres " prio: " msgprio end-display if mqres > 0 display "priority 31 message: " msgbuf(1:mqres) end-display end-if end-perform. goback. end program MQSIGNAL. --------------------------------- Can OpenCOBOL interface with Lua? --------------------------------- Yes. Lua can be embedded in OpenCOBOL applications. .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *><* ======================= *><* OpenCOBOL Lua Interface *><* ======================= *><* *><* .. sidebar:: Contents *><* *><* .. contents:: *><* :local: *><* :depth: 2 *><* :backlinks: entry *><* *><* :Author: Brian Tiffin *><* :Date: 28-Oct-2008 *><* :Purpose: interface to Lua scripting *><* :Rights: | Copyright 2008 Brian Tiffin *><* | Licensed under the GNU General Public License *><* | No warranty expressed or implied *><* :Tectonics: | cobc -c -I/usr/include/lua5.1/ oclua.c *><* | cobc -x -llua5.1 luacaller.cob oclua.o *><* | ./ocdoc luacaller.cob oclua.rst oclua.html ocfaq.css *><* :Requires: lua5.1, liblua5.1, liblua5.1-dev *><* :Link: http://www.lua.org *><* :Thanks to: The Lua team, Pontifical Catholic University *><* of Rio de Janeiro in Brazil. *><* http://www.lua.org/authors.html *><* :Sources: | http://opencobol.add1tocobol.com/luacaller.cob *><* | http://opencobol.add1tocobol.com/oclua.c *><* | http://opencobol.add1tocobol.com/oclua.lua *><* | http://opencobol.add1tocobol.com/oclua.rst *><* | http://opencobol.add1tocobol.com/ocfaq.rss *><* *> *************************************************************** identification division. program-id. luacaller. data division. working-storage section. 01 luastate usage pointer. 01 luascript pic x(10) value 'oclua.lua' & x"00". 01 luacommand pic x(64). 01 luaresult pic x(32). 01 lualength usage binary-long. 01 items pic 9 usage computational-5. 01 luastack. 03 luaitem pic x(32) occurs 5 times. 01 depth usage binary-long. *> ************************************************************** procedure division. call "OCLUA_OPEN" returning luastate end-call move 'return "OpenCOBOL " .. 1.0 + 0.1' & x"00" to luacommand call "OCLUA_DOSTRING" using by value luastate by reference luacommand by reference luaresult by value function length(luaresult) returning depth end-call display "OpenCOBOL displays: " depth " |" luaresult "|" end-display call "OCLUA_DOFILE" using by value luastate by reference luascript by reference luaresult by value 32 returning depth end-call display "OpenCOBOL displays: " depth " |" luaresult "|" end-display call "OCLUA_DOFILE" using by value luastate by reference luascript by reference luaresult by value 32 returning depth end-call display "OpenCOBOL displays: " depth " |" luaresult "|" end-display call "OCLUA_DEPTH" using by value luastate returning depth end-call display "Lua depth: " depth end-display perform varying items from 1 by 1 until items > depth call "OCLUA_GET" using by value luastate by value items by reference luaresult by value 32 returning lualength end-call move luaresult to luaitem(items) end-perform perform varying items from 1 by 1 until items > depth display "Item " items ": " luaitem(items) end-display end-perform call "OCLUA_POP" using by value luastate by value depth returning depth end-call call "OCLUA_DEPTH" using by value luastate returning depth end-call display "Lua depth: " depth end-display call "OCLUA_CLOSE" using by value luastate end-call goback. end program luacaller. *> *************************************************************** *><* ++++++++ *><* Overview *><* ++++++++ *><* The OpenCOBOL Lua interface is defined at a very high level. *><* *><* The objective is to provide easy access to Lua through *><* script files or strings to be evaluated. *><* *><* Command strings and script file names passed to Lua MUST be *><* terminated with a null byte, as per C Language conventions. *><* *><* A Lua engine is started with a call to OCLUA_OPEN, which *><* returns an OpenCOBOL POINTER that is used to reference *><* the Lua state for all further calls. *><* *><* A Lua engine is run down with a call to OCLUA_CLOSE. *><* *><* .. Attention:: *><* Calls to Lua without a valid state will cause *><* undefined behaviour and crash the application. *><* *><* Lua uses a stack and results of the Lua RETURN reserved *><* word are placed on this stack. Multiple values can be *><* returned from Lua. *><* *><* The developer is responsible for stack overflow conditions *><* and the size of the stack (default 20 elements) is *><* controlled with OCLUA_STACK using an integer that *><* determines the numbers of slots to reserve. *><* *><* Requires package installs of: *><* *><* * lua5.1 *><* * liblua5.1 *><* * liblua5.1-dev *><* *><* +++++++++++++++++ *><* OpenCOBOL Lua API *><* +++++++++++++++++ *><* ---------- *><* OCLUA_OPEN *><* ---------- *><* Initialize the Lua engine. *><* *><* :: *><* *><* 01 luastate USAGE POINTER. *><* *><* CALL "OCLUA_OPEN" RETURNING luastate END-CALL *><* *><* ----------- *><* OCLUA_STACK *><* ----------- *><* Check and possibly resize the Lua data stack. Returns 0 if *><* Lua cannot expand the stack to the requested size. *><* *><* :: *><* *><* 01 elements USAGE BINARY-LONG VALUE 32. *><* 01 result USAGE BINARY-LONG. *><* *><* CALL "OCLUA_STACK" *><* USING *><* BY VALUE luastate *><* BY VALUE elements *><* RETURNING result *><* END-CALL *><* *><* -------------- *><* OCLUA_DOSTRING *><* -------------- *><* Evaluate a null terminated alphanumeric field as a Lua program *><* producing any top of stack entry and returning the depth of *><* stack after evaluation. *><* *><* Takes a luastate, a null terminated command string, *><* a result field and length and returns an integer depth. *><* *><* .. Attention:: *><* The Lua stack is NOT popped while returning the top of stack entry. *><* *><* :: *><* *><* 01 luacommand pic x(64). *><* 01 luaresult pic x(32). *><* 01 depth usage binary-long. *><* *><* move 'return "OpenCOBOL " .. 1.0 + 0.1' & x"00" to luacommand *><* call "OCLUA_DOSTRING" *><* using *><* by value luastate *><* by reference luacommand *><* by reference luaresult *><* by value function length(luaresult) *><* returning depth *><* end-call *><* display *><* "OpenCOBOL displays: " depth " |" luaresult "|" *><* end-display *><* *><* Outputs:: *><* *><* OpenCOBOL displays: +0000000001 |OpenCOBOL 1.1 || *><* *><* ------------ *><* OCLUA_DOFILE *><* ------------ *><* Evaluate a script using a null terminated alphanumeric field *><* naming a Lua program source file, retrieving any top of *><* stack entry and returning the depth of stack after evaluation. *><* *><* Takes a luastate, a null terminated filename, *><* a result field and length and returns an integer depth. *><* *><* .. Attention:: *><* The Lua stack is NOT popped while returning the top of *><* stack entry. *><* *><* :: *><* *><* 01 luascript pic x(10) value 'oclua.lua' & x"00". *><* 01 luaresult pic x(32). *><* *><* call "OCLUA_DOFILE" *><* using *><* by value luastate *><* by reference luascript *><* by reference luaresult *><* by value function length(luaresult) *><* returning depth *><* end-call *><* display *><* "OpenCOBOL displays: " depth " |" luaresult "|" *><* end-display *><* *><* Given oclua.lua:: *><* *><* -- Start *><* -- Script: oclua.lua *><* print("Lua prints hello") *><* *><* hello = "Hello OpenCOBOL from Lua" *><* return math.pi, hello *><* -- End *><* *><* Outputs:: *><* *><* Lua prints hello *><* OpenCOBOL displays: +0000000002 |Hello OpenCOBOL from Lua || *><* *><* and on return from Lua, there is *math.pi* and the *><* Hello string remaining on the Lua state stack. *><* *><* ----------- *><* OCLUA_DEPTH *><* ----------- *><* Returns the current number of elements on the Lua stack. *><* *><* :: *><* *><* call "OCLUA_DEPTH" *><* using *><* by value luastate *><* returning depth *><* end-call *><* display "Lua depth: " depth end-display *><* *><* --------- *><* OCLUA_GET *><* --------- *><* Retrieves values from the Lua stack, returning the length *><* of the retrieved item. *><* *><* An example that populates and displays an OpenCOBOL table:: *><* *><* 01 items pic 9 usage computational-5. *><* 01 luastack. *><* 03 luaitem pic x(32) occurs 5 times. *><* *><* perform varying items from 1 by 1 *><* until items > depth *><* call "OCLUA_GET" *><* using *><* by value luastate *><* by value items *><* by reference luaresult *><* by value function length(luaresult) *><* returning lualength *><* end-call *><* move luaresult to luaitem(items) *><* end-perform *><* *><* perform varying items from 1 by 1 *><* until items > depth *><* display *><* "Item " items ": " luaitem(items) *><* end-display *><* end-perform *><* *><* Lua numbers the indexes of stacked items from 1, first *><* item to n, last item (current top of stack). Negative *><* indexes may also be used as documented by Lua, -1 being *><* top of stack. *><* *><* Sample output:: *><* *><* Item 1: OpenCOBOL 1.1 *><* Item 2: 3.1415926535898 *><* Item 3: Hello OpenCOBOL from Lua *><* Item 4: 3.1415926535898 *><* Item 5: Hello OpenCOBOL from Lua *><* *><* --------- *><* OCLUA_POP *><* --------- *><* Pops the given number of elements off of the Lua stack *><* returning the depth of the stack after the pop. *><* *><* Example that empties the Lua stack:: *><* *><* call "OCLUA_POP" *><* using *><* by value luastate *><* by value depth *><* returning depth *><* end-call *><* *><* ----------- *><* OCLUA_CLOSE *><* ----------- *><* Close and free the Lua engine. *><* *><* .. Danger:: *><* Further calls to Lua are unpredictable and may well *><* lead to a SIGSEGV crash. *><* *><* :: *><* *><* call "OCLUA_CLOSE" using by value luastate end-call *><* With usage document at `oclua.html `_ The above code uses a wrapper layer of C code .. sourcecode:: c /* OpenCOBOL Lua interface */ /* tectonics: cobc -c -I/usr/include/lua5.1 oclua.c */ #include #include #include /* Include the Lua API header files. */ #include #include #include /* Open the Lua engine and load all the default libraries */ lua_State *OCLUA_OPEN() { lua_State *oclua_state; oclua_state = lua_open(); luaL_openlibs(oclua_state); return oclua_state; } int OCLUA_DO(lua_State *L, int which, const char *string, unsigned char *cobol, int coblen) { int result; int stacked; const char *retstr; int retlen; memset(cobol, ' ', coblen); result = ((which == 0) ? luaL_dostring(L, string) : luaL_dofile(L, string)); if (result == 1) { /* error condition */ return -1; } else { stacked = lua_gettop(L); if (stacked > 0) { /* populate cobol field with top of stack */ retstr = lua_tolstring(L, stacked, &retlen); memcpy(cobol, retstr, (coblen > retlen) ? retlen : coblen); } /* return number of items on the stack */ return stacked; } } /* by filename */ int OCLUA_DOFILE(lua_State *L, const char *filename, unsigned char *cobol, int coblen) { return OCLUA_DO(L, 1, filename, cobol, coblen); } /* by string */ int OCLUA_DOSTRING(lua_State *L, const char *string, unsigned char *cobol, int coblen) { return OCLUA_DO(L, 0, string, cobol, coblen); } /* retrieve stack item as string */ int OCLUA_GET(lua_State *L, int element, unsigned char *cobol, int coblen) { const char *retstr; int retlen; /* populate cobol field with top of stack */ memset(cobol, ' ', coblen); retstr = lua_tolstring(L, element, &retlen); if (retstr == NULL) { return -1; } else { memcpy(cobol, retstr, (coblen > retlen) ? retlen : coblen); return retlen; } } /* check the stack, resize if needed, returns false if stack can't grow */ int OCLUA_STACK(lua_State *L, int extra) { return lua_checkstack(L, extra); } /* depth of Lua stack */ int OCLUA_DEPTH(lua_State *L) { return lua_gettop(L); } /* pop elements off stack */ int OCLUA_POP(lua_State *L, int elements) { lua_pop(L, elements); return lua_gettop(L); } /* close the engine */ void OCLUA_CLOSE(lua_State *L) { lua_close(L); } /**/ and this sample Lua script **oclua.lua** .. sourcecode:: lua -- Start -- Script: oclua.lua print("Lua prints hello") hello = "Hello OpenCOBOL from Lua" return math.pi, hello -- End ----------------------------- Can OpenCOBOL use ECMAScript? ----------------------------- Yes. Using the SpiderMonkey_ engine. See `Can OpenCOBOL use JavaScript?`_ ----------------------------- Can OpenCOBOL use JavaScript? ----------------------------- Yes. A wrapper for the SpiderMonkey_ engine allows OpenCOBOL access to core JavaScript. .. sourcecode:: c /* OpenCOBOL with embedded spidermonkey javascript */ /* cobc -c -I/usr/include/smjs ocjs.c * cobc -x -lsmjs jscaller.cob * some people found mozjs before smjs */ #include #include /* javascript api requires an environment type */ #define XP_UNIX #if (defined(XP_WIN) || defined(XP_UNIX) || defined(XP_BEOS) || defined(XP_OS2)) #include "jsapi.h" #else #error "Must define one of XP_BEOS, XP_OS2, XP_WIN or XP_UNIX" #endif /* Error codes */ #define OCJS_ERROR_RUNTIME -1 #define OCJS_ERROR_CONTEXT -2 #define OCJS_ERROR_GLOBAL -3 #define OCJS_ERROR_STANDARD -4 #define OCJS_ERROR_EVALUATE -5 /* OpenCOBOL main CALL interface */ /* javascript layer requires * a runtime per process, * a context per thread, * a global object per context * and will initialize * standard classes. */ static JSRuntime *rt; static JSContext *cx; static JSObject *global; static JSClass global_class = { "global",0, JS_PropertyStub,JS_PropertyStub,JS_PropertyStub,JS_PropertyStub, JS_EnumerateStub,JS_ResolveStub,JS_ConvertStub,JS_FinalizeStub }; /* Initialize the engine resources */ int ocjsInitialize(int rtsize, int cxsize) { JSBool ok; /* on zero sizes, pick reasonable values */ if (rtsize == 0) { rtsize = 0x100000; } if (cxsize == 0) { cxsize = 0x1000; } /* Initialize a runtime space */ rt = JS_NewRuntime(rtsize); if (rt == NULL) { return OCJS_ERROR_RUNTIME; } /* Attach a context */ cx = JS_NewContext(rt, cxsize); if (cx == NULL) { return OCJS_ERROR_CONTEXT; } /* And a default global */ global = JS_NewObject(cx, &global_class, NULL, NULL); if (global == NULL) { return OCJS_ERROR_GLOBAL; } /* Load standard classes */ ok = JS_InitStandardClasses(cx, global); /* Return success or standard class load error */ return (ok == JS_TRUE) ? 0 : OCJS_ERROR_STANDARD; } /* Evaluate script */ int ocjsEvaluate(char *script, char *result, int length) { jsval rval; JSString *str; int reslen = OCJS_ERROR_EVALUATE; JSBool ok; /* filename and line number, not reported */ char *filename = NULL; int lineno = 0; /* clear the result field */ memset(result, ' ', length); /* Evaluate javascript */ ok = JS_EvaluateScript(cx, global, script, strlen(script), filename, lineno, &rval); /* Convert js result to JSString form */ if (ok == JS_TRUE) { str = JS_ValueToString(cx, rval); reslen = strlen(JS_GetStringBytes(str)); if (length < reslen) { reslen = length; } /* convert down to char and move to OpenCOBOl result field */ memcpy(result, JS_GetStringBytes(str), reslen); } return reslen; } /* Evaluate script from file */ int ocjsFromFile(char *filename, char *result, int length) { FILE *fin; int bufsize = 10240; char inbuf[bufsize]; int reslen; fin = fopen(filename, "r"); if (fin == NULL) { return OCJS_ERROR_EVALUATE; } //while (fread(inbuf, sizeof(char), bufsize, fin) > 0) { if (fread(inbuf, 1, bufsize, fin) > 0) { reslen = ocjsEvaluate(inbuf, result, length); } return reslen; } /* release js engine */ int ocjsRunDown() { if (cx != NULL) { JS_DestroyContext(cx); } if (rt != NULL) { JS_DestroyRuntime(rt); } JS_ShutDown(); return 0; } /* Quick call; start engine, evaluate, release engine */ int ocjsString(char *script, char *result, int length) { int reslen; reslen = ocjsInitialize(0, 0); if (reslen < 0) { return reslen; } reslen = ocjsEvaluate(script, result, length); ocjsRunDown(); return reslen; } /**/ A sample OpenCOBOL application: .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *>**************************************************************** *>Author: Brian Tiffin *>Date: 11-Sep-2008 *>Purpose: Embed some javascript *>Tectonics: cobc -c -I/usr/include/smjs ocjs.c *> cobc -x -l/smjs jscaller.cob ocjs.o *>**************************************************************** identification division. program-id. jscaller. data division. working-storage section. 78 ocjs-error-runtime value -1. 78 ocjs-error-context value -2. 78 ocjs-error-global value -3. 78 ocjs-error-standard value -4. 78 ocjs-error-evaluate value -5. 78 newline value x"0a". 01 source-data pic x(40) value "----+----1----+-$56.78 90----3----+----4". 01 result pic s9(9). 01 result-field pic x(81). 01 javascript pic x(1024). 01 safety-null pic x value x"00". *>**************************************************************** *><* Evaluate spidermonkey code, return the length of js result procedure division. display "js> " with no advancing end-display accept javascript end-accept call "ocjsString" using javascript result-field by value function length(result-field) returning result end-call display "OpenCOBOL result-field: " result-field end-display display "OpenCOBOL received : " result newline end-display *><* Initialize the javascript engine call "ocjsInitialize" using by value 65536 by value 1024 returning result end-call if result less 0 stop run returning result end-if *><* find (zero offest) dollar amount, space, number move spaces to javascript string "pat = /\$\d+\.\d+\s\d+/; " 'a = "' delimited by size source-data delimited by size '"; ' delimited by size "a.search(pat); " delimited by size x"00" delimited by size into javascript end-string display "Script: " function trim(javascript, trailing) end-display call "ocjsEvaluate" using javascript result-field by value function length(result-field) returning result end-call display "OpenCOBOL result-field: " result-field end-display display "OpenCOBOL received : " result newline end-display *><* values held in js engine across calls move spaces to javascript string 'a;' delimited by size x"00" delimited by size into javascript end-string display "Script: " function trim(javascript, trailing) end-display call "ocjsEvaluate" using javascript result-field by value function length(result-field) returning result end-call display "OpenCOBOL result-field: " result-field end-display display "OpenCOBOL received : " result newline end-display *><* erroneous script move spaces to javascript string 'an error of some kind;' delimited by size x"00" delimited by size into javascript end-string display "Script: " function trim(javascript, trailing) end-display call "ocjsEvaluate" using javascript result-field by value function length(result-field) returning result end-call if result equal ocjs-error-evaluate display " *** script problem ***" end-display end-if display "OpenCOBOL result-field: " result-field end-display display "OpenCOBOL received : " result newline end-display *><* script from file move spaces to javascript string 'ocjsscript.js' delimited by size x"00" delimited by size into javascript end-string display "Script: " function trim(javascript, trailing) end-display call "ocjsFromFile" using javascript result-field by value function length(result-field) returning result end-call if result equal ocjs-error-evaluate display " *** script problem ***" end-display end-if display "OpenCOBOL result-field: " result-field end-display display "OpenCOBOL received : " result newline end-display *><* Rundown the js engine call "ocjsRunDown" returning result *><* take first name last name, return last "," first move spaces to javascript string "re = /(\w+)\s(\w+)/; " delimited by size 'str = "John Smith"; ' delimited by size 'newstr = str.replace(re, "$2, $1"); ' delimited by size "newstr;" delimited by size x"00" delimited by size into javascript end-string display "Script: " function trim(javascript, trailing) end-display call "ocjsString" using javascript result-field by value function length(result-field) returning result end-call display "OpenCOBOL result-field: " result-field end-display display "OpenCOBOL received : " result newline end-display *><* split a string using numbers return array (as js string form) move spaces to javascript string 'myString = "Hello 1 word. Sentence number 2."; ' delimited by size 'splits = myString.split(/(\d)/); ' delimited by size 'splits;' delimited by size x"00" delimited by size into javascript end-string display "Script: " function trim(javascript, trailing) end-display call "ocjsString" using javascript result-field by value function length(result-field) returning result end-call display "OpenCOBOL result-field: " result-field end-display display "OpenCOBOL received : " result newline end-display *><* Get javascript date move "new Date()" & x"00" to javascript display "Script: " function trim(javascript, trailing) end-display call "ocjsString" using javascript result-field by value function length(result-field) returning result end-call display "OpenCOBOL result-field: " result-field end-display display "OpenCOBOL received : " result end-display goback. end program jscaller. And with a sample script: **ocjsscript.js** .. sourcecode:: javascript var x = 2 var y = 39 var z = "42" // boths line evaluate to 42 eval("x + y + 1") eval(z) Sample output:: js> 123 * 456 + 789 OpenCOBOL result-field: 56877 OpenCOBOL received : +000000005 Script: pat = /\$\d+\.\d+\s\d+/; a = "----+----1----+-$56.78 90----3----+----4"; a.search(pat); OpenCOBOL result-field: 16 OpenCOBOL received : +000000002 Script: a; OpenCOBOL result-field: ----+----1----+-$56.78 90----3----+----4 OpenCOBOL received : +000000040 Script: an error of some kind; *** script problem *** OpenCOBOL result-field: OpenCOBOL received : -000000005 Script: re = /(\w+)\s(\w+)/; str = "John Smith"; newstr = str.replace(re, "$2, $1"); newstr; OpenCOBOL result-field: Smith, John OpenCOBOL received : +000000011 Script: myString = "Hello 1 word. Sentence number 2."; splits = myString.split(/(\d)/); splits; OpenCOBOL result-field: Hello ,1, word. Sentence number ,2,. OpenCOBOL received : +000000036 Script: new Date() OpenCOBOL result-field: Mon Sep 15 2008 04:16:06 GMT-0400 (EDT) OpenCOBOL received : +000000039 ------------------------------------ Can OpenCOBOL interface with Scheme? ------------------------------------ Yes, directly embedded with Guile_ and libguile. callguile.cob .. sourcecode:: cobol OCOBOL >>SOURCE FORMAT IS FIXED *> *************************************************************** *> Author: Brian Tiffin *> Date: 20090215 *> Purpose: Demonstrate libguile Scheme interactions *> Tectonics: cobc -x -lguile callguile.cob *> *************************************************************** identification division. program-id. callguile. data division. working-storage section. 01 tax-scm usage pointer. 01 shipping-scm usage pointer. 01 scm-string usage pointer. 01 radix-scm usage pointer. 01 subtotal pic 999v99 value 80.00. 01 subtotal-display pic z(8)9.99. 01 weight pic 99v99 value 10.00. 01 weight-display pic Z9.99. 01 breadth pic 99v99 value 20.00. 01 breadth-display pic Z9.99. 01 answer pic x(80). 01 len usage binary-long. 01 tax pic 9(9)v9(2). 01 tax-display pic z(8)9.9(2). 01 shipping pic 9(9)v9(2). 01 shipping-display pic z(8)9.9(2). 01 invoice-total pic 9(9)v9(2). 01 invoice-display pic $(8)9.9(2). *> *************************************************************** procedure division. display "OC: initialize libguile" end-display call "scm_init_guile" end-call display "OC: load scheme code" end-display call "scm_c_primitive_load" using "script.scm" & x"00" end-call display "OC:" end-display display "OC: evaluate one of the defined functions" end-display call "scm_c_eval_string" using "(do-hello)" & x"00" end-call display "OC:" end-display display "OC: perform tax calculation" end-display move subtotal to subtotal-display move weight to weight-display move breadth to breadth-display call "scm_c_eval_string" using function concatenate( "(compute-tax "; subtotal-display; ")"; x"00" ) returning tax-scm end-call display "OC: perform shipping calculation" end-display display "OC: " function concatenate( "(compute-shipping "; weight-display; " "; breadth-display; ")"; x"00" ) end-display call "scm_c_eval_string" using function concatenate( "(compute-shipping "; weight-display; " "; breadth-display; ")"; x"00" ) returning shipping-scm end-call display "OC: have guile build a scheme integer 10" end-display call "scm_from_int32" using by value size is 4 10 returning radix-scm end-call display "OC: have guile convert number, base 10" end-display call "scm_number_to_string" using by value tax-scm by value radix-scm returning scm-string end-call display "OC: get numeric string to COBOL" end-display call "scm_to_locale_stringbuf" using by value scm-string by reference answer by value 80 returning len end-call display "OC: tax as string: " answer end-display move answer to tax call "scm_number_to_string" using by value shipping-scm by value radix-scm returning scm-string end-call call "scm_to_locale_stringbuf" using by value scm-string by reference answer by value 80 returning len end-call display "OC: shipping as string: " answer end-display move answer to shipping compute invoice-total = subtotal + tax + shipping end-compute move subtotal to subtotal-display move tax to tax-display move shipping to shipping-display move invoice-total to invoice-display display "OC:" end-display display "OC: subtotal " subtotal-display end-display display "OC: tax " tax-display end-display display "OC: shipping " shipping-display end-display display "OC: total: " invoice-display end-display goback. end program callguile. script.scm .. sourcecode:: scheme (define (do-hello) (begin (display "Welcome to Guile") (newline))) (define (compute-tax subtotal) (* subtotal 0.0875)) (define (compute-shipping weight length) ;; For small, light packages, charge the minimum (if (and (< weight 20) (< length 5)) 0.95 ;; Otherwise for long packages, charge a lot (if (> length 100) (+ 0.95 (* weight 0.1)) ;; Otherwise, charge the usual (+ 0.95 (* weight 0.05))))) (display "Loaded script.scm")(newline) Outputs:: OC: initialize libguile OC: load scheme code Loaded script.scm OC: OC: evaluate one of the defined functions Welcome to Guile OC: OC: perform tax calculation OC: perform shipping calculation OC: (compute-shipping 10.00 20.00) OC: have guile build a scheme integer 10 OC: have guile convert number, base 10 OC: get numeric string to COBOL OC: tax as string: 7.0 OC: shipping as string: 1.45 OC: OC: subtotal 80.00 OC: tax 7.00 OC: shipping 1.45 OC: total: $88.45 Of course using Scheme for financial calculations in an OpenCOBOL application would not be a smart usage. This is just a working sample. ------------------------------------ Can OpenCOBOL interface with Tcl/Tk? ------------------------------------ Yes. OpenCOBOL supports the Tcl/Tk embedding engine developed by Rildo Pragana as part of the TinyCOBOL project. We have been given permission by Rildo to embed his engine in OpenCOBOL. See http://ww1.pragana.net/cobol.html for sources. A working sample .. sourcecode:: cobol OCOBOL IDENTIFICATION DIVISION. PROGRAM-ID. tclgui. AUTHOR. Rildo Pragana. *> REMARKS. *> Example tcl/tk GUI program for Cobol. *> ENVIRONMENT DIVISION. DATA DIVISION. *> WORKING-STORAGE SECTION. 01 DATA-BLOCK. 05 NAME PIC X(40). 05 W-ADDRESS PIC X(50). 05 PHONE PIC X(15). 05 END-PGM PIC X. 05 QUICK-RET PIC X. 01 SITE-INFO. 05 TITLE PIC X(20). 05 URL PIC X(50). 77 GUI-01 PIC X(64) VALUE "formA.tcl". 77 GUI-02 PIC X(64) VALUE "formB.tcl". 77 END-OF-STRING pic X value LOW-VALUES. 77 T-SCRIPT PIC X(128). 77 T-RESULT PIC X(80). 01 dummy pic X value X"00". PROCEDURE DIVISION. CALL "initTcl" *> test for stcleval function string "expr 12 * 34" END-OF-STRING into T-SCRIPT call "stcleval" using T-SCRIPT T-RESULT display "eval by tcl: |" T-SCRIPT "| returned " T-RESULT MOVE "Your name here" to NAME MOVE "Your address" TO W-ADDRESS MOVE "Phone number" to PHONE *> this variable tells Cobol that the user required an exit MOVE "0" to END-PGM MOVE "1" to QUICK-RET MOVE "Afonso Pena" to NAME *> now we may have the script name as a variable, terminated by a space CALL "tcleval" USING DATA-BLOCK "./formA.tcl " MOVE "Deodoro da Fonseca" to NAME CALL "tcleval" USING DATA-BLOCK GUI-01 MOVE "Rui Barbosa" to NAME CALL "tcleval" USING DATA-BLOCK GUI-01 MOVE "Frei Caneca" to NAME CALL "tcleval" USING DATA-BLOCK GUI-01 MOVE "0" to QUICK-RET MOVE "Your name here" to NAME. 100-restart. *> call C wrapper, passing data block and size of data CALL "tcleval" USING DATA-BLOCK GUI-01 DISPLAY "Returned data:" DISPLAY "NAME [" NAME "]" DISPLAY "ADDRESS [" W-ADDRESS "]" DISPLAY "PHONE [" PHONE "]" *> if not end of program required, loop if END-PGM = 0 go to 100-restart. *> to start a new GUI (graphical interface), call this first call "newGui" MOVE "Title of the site" to TITLE MOVE "URL (http://..., ftp://..., etc)" to URL *> now we may draw other main window... CALL "tcleval" USING SITE-INFO GUI-02 DISPLAY "Returned data:" DISPLAY "TITLE [" TITLE "]" DISPLAY "URL [" URL "]" STOP RUN. .. *><* Which uses two Tcl/Tk scripts .. sourcecode:: tcl #!/bin/sh # the next line restarts using wish\ exec wish "$0" "$@" if {![info exists vTcl(sourcing)]} { package require Tk switch $tcl_platform(platform) { windows { option add *Button.padY 0 } default { option add *Scrollbar.width 10 option add *Scrollbar.highlightThickness 0 option add *Scrollbar.elementBorderWidth 2 option add *Scrollbar.borderWidth 2 } } } ############################################################################# # Visual Tcl v1.60 Project # ################################# # VTCL LIBRARY PROCEDURES # if {![info exists vTcl(sourcing)]} { ############################################################################# ## Library Procedure: Window proc ::Window {args} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. global vTcl foreach {cmd name newname} [lrange $args 0 2] {} set rest [lrange $args 3 end] if {$name == "" || $cmd == ""} { return } if {$newname == ""} { set newname $name } if {$name == "."} { wm withdraw $name; return } set exists [winfo exists $newname] switch $cmd { show { if {$exists} { wm deiconify $newname } elseif {[info procs vTclWindow$name] != ""} { eval "vTclWindow$name $newname $rest" } if {[winfo exists $newname] && [wm state $newname] == "normal"} { vTcl:FireEvent $newname <> } } hide { if {$exists} { wm withdraw $newname vTcl:FireEvent $newname <> return} } iconify { if $exists {wm iconify $newname; return} } destroy { if $exists {destroy $newname; return} } } } ############################################################################# ## Library Procedure: vTcl:DefineAlias proc ::vTcl:DefineAlias {target alias widgetProc top_or_alias cmdalias} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. global widget set widget($alias) $target set widget(rev,$target) $alias if {$cmdalias} { interp alias {} $alias {} $widgetProc $target } if {$top_or_alias != ""} { set widget($top_or_alias,$alias) $target if {$cmdalias} { interp alias {} $top_or_alias.$alias {} $widgetProc $target } } } ############################################################################# ## Library Procedure: vTcl:DoCmdOption proc ::vTcl:DoCmdOption {target cmd} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. ## menus are considered toplevel windows set parent $target while {[winfo class $parent] == "Menu"} { set parent [winfo parent $parent] } regsub -all {\%widget} $cmd $target cmd regsub -all {\%top} $cmd [winfo toplevel $parent] cmd uplevel #0 [list eval $cmd] } ############################################################################# ## Library Procedure: vTcl:FireEvent proc ::vTcl:FireEvent {target event {params {}}} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. ## The window may have disappeared if {![winfo exists $target]} return ## Process each binding tag, looking for the event foreach bindtag [bindtags $target] { set tag_events [bind $bindtag] set stop_processing 0 foreach tag_event $tag_events { if {$tag_event == $event} { set bind_code [bind $bindtag $tag_event] foreach rep "\{%W $target\} $params" { regsub -all [lindex $rep 0] $bind_code [lindex $rep 1] bind_code } set result [catch {uplevel #0 $bind_code} errortext] if {$result == 3} { ## break exception, stop processing set stop_processing 1 } elseif {$result != 0} { bgerror $errortext } break } } if {$stop_processing} {break} } } ############################################################################# ## Library Procedure: vTcl:Toplevel:WidgetProc proc ::vTcl:Toplevel:WidgetProc {w args} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. if {[llength $args] == 0} { ## If no arguments, returns the path the alias points to return $w } set command [lindex $args 0] set args [lrange $args 1 end] switch -- [string tolower $command] { "setvar" { foreach {varname value} $args {} if {$value == ""} { return [set ::${w}::${varname}] } else { return [set ::${w}::${varname} $value] } } "hide" - "show" { Window [string tolower $command] $w } "showmodal" { ## modal dialog ends when window is destroyed Window show $w; raise $w grab $w; tkwait window $w; grab release $w } "startmodal" { ## ends when endmodal called Window show $w; raise $w set ::${w}::_modal 1 grab $w; tkwait variable ::${w}::_modal; grab release $w } "endmodal" { ## ends modal dialog started with startmodal, argument is var name set ::${w}::_modal 0 Window hide $w } default { uplevel $w $command $args } } } ############################################################################# ## Library Procedure: vTcl:WidgetProc proc ::vTcl:WidgetProc {w args} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. if {[llength $args] == 0} { ## If no arguments, returns the path the alias points to return $w } set command [lindex $args 0] set args [lrange $args 1 end] uplevel $w $command $args } ############################################################################# ## Library Procedure: vTcl:toplevel proc ::vTcl:toplevel {args} { ## This procedure may be used free of restrictions. ## Exception added by Christian Gavin on 08/08/02. ## Other packages and widget toolkits have different licensing requirements. ## Please read their license agreements for details. uplevel #0 eval toplevel $args set target [lindex $args 0] namespace eval ::$target {set _modal 0} } } if {[info exists vTcl(sourcing)]} { proc vTcl:project:info {} { set base .top43 namespace eval ::widgets::$base { set set,origin 1 set set,size 1 set runvisible 1 } namespace eval ::widgets::$base.lab44 { array set save {-disabledforeground 1 -font 1 -text 1} } namespace eval ::widgets::$base.cpd45 { array set save {-disabledforeground 1 -font 1 -text 1} } namespace eval ::widgets::$base.cpd46 { array set save {-disabledforeground 1 -font 1 -text 1} } namespace eval ::widgets::$base.che47 { array set save {-disabledforeground 1 -font 1 -text 1 -variable 1} } namespace eval ::widgets::$base.but48 { array set save {-command 1 -disabledforeground 1 -font 1 -text 1} } namespace eval ::widgets::$base.ent49 { array set save {-background 1 -insertbackground 1 -textvariable 1} } namespace eval ::widgets::$base.cpd50 { array set save {-background 1 -insertbackground 1 -textvariable 1} } namespace eval ::widgets::$base.cpd51 { array set save {-background 1 -insertbackground 1 -textvariable 1} } namespace eval ::widgets::$base.lis43 { array set save {-background 1 -listvariable 1} } namespace eval ::widgets::$base.lab45 { array set save {-disabledforeground 1 -font 1 -text 1} } namespace eval ::widgets::$base.but47 { array set save {-command 1 -disabledforeground 1 -text 1} } namespace eval ::widgets::$base.but51 { array set save {-command 1 -disabledforeground 1 -text 1} } set base .top47 namespace eval ::widgets::$base { set set,origin 1 set set,size 1 set runvisible 1 } namespace eval ::widgets::$base.ent48 { array set save {-background 1 -disabledforeground 1 -insertbackground 1 -textvariable 1} } namespace eval ::widgets::$base.but49 { array set save {-command 1 -disabledforeground 1 -text 1} } namespace eval ::widgets::$base.but50 { array set save {-command 1 -disabledforeground 1 -text 1} } namespace eval ::widgets_bindings { set tagslist _TopLevel } namespace eval ::vTcl::modules::main { set procs { init main cobol_update } set compounds { } set projectType single } } } ################################# # USER DEFINED PROCEDURES # ############################################################################# ## Procedure: main proc ::main {argc argv} { global cobol_fields widget set cobol_fields { name 40 address 50 phone 15 endpgm 1 quickret 1 } global nomes_anteriores if {![info exists nomes_anteriores]} { set nomes_anteriores {} } #bind all do_exit } proc ::cobol_preprocess {args} { global quickret if {$quickret} { do_exit } } ############################################################################# ## Procedure: cobol_update proc ::cobol_update {} { global widget global nomes_anteriores name #puts "tcl-TC LOG: lappend nomes_anteriores $name" lappend nomes_anteriores $name focus $widget(nome_entry) } ############################################################################# ## Initialization Procedure: init proc ::init {argc argv} { } init $argc $argv ################################# # VTCL GENERATED GUI PROCEDURES # proc vTclWindow. {base} { if {$base == ""} { set base . } ################### # CREATING WIDGETS ################### wm focusmodel $top passive wm geometry $top 1x1+0+0; update wm maxsize $top 1265 994 wm minsize $top 1 1 wm overrideredirect $top 0 wm resizable $top 1 1 wm withdraw $top wm title $top "vtcl.tcl" bindtags $top "$top Vtcl.tcl all" vTcl:FireEvent $top <> wm protocol $top WM_DELETE_WINDOW "vTcl:FireEvent $top <>" ################### # SETTING GEOMETRY ################### vTcl:FireEvent $base <> } proc vTclWindow.top43 {base} { if {$base == ""} { set base .top43 } if {[winfo exists $base]} { wm deiconify $base; return } set top $base ################### # CREATING WIDGETS ################### vTcl:toplevel $top -class Toplevel \ -highlightcolor black wm focusmodel $top passive wm geometry $top 570x523+318+169; update wm maxsize $top 1265 994 wm minsize $top 1 1 wm overrideredirect $top 0 wm resizable $top 1 1 wm deiconify $top wm title $top "New Toplevel 1" vTcl:DefineAlias "$top" "Toplevel1" vTcl:Toplevel:WidgetProc "" 1 bindtags $top "$top Toplevel all _TopLevel" vTcl:FireEvent $top <> wm protocol $top WM_DELETE_WINDOW "vTcl:FireEvent $top <>" label $top.lab44 \ -disabledforeground #a1a4a1 -font {helvetica 18 bold} -text Nome: vTcl:DefineAlias "$top.lab44" "Label1" vTcl:WidgetProc "Toplevel1" 1 label $top.cpd45 \ -disabledforeground #a1a4a1 -font {helvetica 18 bold} -text Endereço: vTcl:DefineAlias "$top.cpd45" "Label2"