"James K. Lowden" <jklow...@schemamania.org> writes:

> From 5d53920602e234e4d99ae2d502e662ee3699978e 4 Oct 2024 12:01:22 -0400
> From: "James K. Lowden" <jklow...@symas.com>
> Date: Sat 15 Feb 2025 12:50:54 PM EST
> Subject: [PATCH] 12 new 'cobol' FE files

Please make sure the commit summaries reflect the contents.

>
> gcc/cobol/ChangeLog
>       * posix/.gitignore: New file.
>       * posix/Makefile: New file.
>       * posix/README.md: New file.
>       * posix/headers: New file.
>       * posix/scrape.awk: New file.
>       * posix/udf-gen: New file.
>       * posix/c/posix_errno.c: New file.
>       * posix/udf/Makefile: New file.
>       * posix/udf/posix-errno.cbl: New file.
>       * posix/udf/posix-exit.cbl: New file.
>       * posix/udf/t/errno.cbl: New file.
>       * posix/udf/t/exit.cbl: New file.
>
> ---
> gcc/cobol/posix/.gitignore | +++-
> gcc/cobol/posix/Makefile | +++++++++++++-
> gcc/cobol/posix/README.md | 
> +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
> gcc/cobol/posix/c/posix_errno.c | +++++-
> gcc/cobol/posix/headers | +++++++++++++++++++++++++++++++++++++-
> gcc/cobol/posix/scrape.awk | +++++++++++++++++++-
> gcc/cobol/posix/udf-gen |
> ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
> gcc/cobol/posix/udf/Makefile | +++++++++++++++++++++++++++-
> gcc/cobol/posix/udf/posix-errno.cbl | ++++++++++++++++++-
> gcc/cobol/posix/udf/posix-exit.cbl | ++++++++++++-
> gcc/cobol/posix/udf/t/errno.cbl | ++++++++++++++++++++++++++-
> gcc/cobol/posix/udf/t/exit.cbl | +++++++++++++++
> 12 files changed, 590 insertions(+), 12 deletions(-)
> diff --git a/gcc/cobol/posix/.gitignore b/gcc/cobol/posix/.gitignore
> new file mode 100644
> index 00000000000..a65b24a10dc
> --- /dev/null
> +++ b/gcc/cobol/posix/.gitignore
> @@ -0,0 +1,3 @@
> +posix.txt
> +prototypes.c
> +prototypes.cpp
> diff --git a/gcc/cobol/posix/Makefile b/gcc/cobol/posix/Makefile
> new file mode 100644
> index 00000000000..471769482b2
> --- /dev/null
> +++ b/gcc/cobol/posix/Makefile
> @@ -0,0 +1,13 @@
> +prototypes.c:  headers prototypes.cpp
> +     cat $^ > $@~
> +     @mv $@~ $@
> +
> +prototypes.cpp: posix.txt
> +     awk -F'[/.]' '{ print $$6 }' $^ | \
> +     while read F; do echo "/* $$F */" && man 2 $$F | \
> +                     ./scrape.awk -v funcname=$$6; done > $@~
> +     @mv $@~ $@
> +
> +posix.txt:
> +     zgrep -l 'POSIX[.]' /usr/share/man/man2/*z > $@~

This will need reworking. It assumes the location of the man pages on
the system, assumes 'zgrep' exists, and assumes 'zgrep' can read the
man pages (the man pages may be compressed with something else; I know
such systems exist).

I'm not sure this is really any less brittle or more robust than just
listing the actual functions you scraped out from your system.

> +     @mv $@~ $@
> diff --git a/gcc/cobol/posix/README.md b/gcc/cobol/posix/README.md
> new file mode 100644
> index 00000000000..f126a8be990
> --- /dev/null
> +++ b/gcc/cobol/posix/README.md
> @@ -0,0 +1,65 @@
> +# GCC COBOL Posix Functions and Adapter
> +
> +## Purpose
> +
> +ISO COBOL does not specify any relationship to any particular
> +operating system, and does not reference Posix. The raw capability is

Nit: Posix -> POSIX

> +there, of course, via the `CALL` statement.  But that's not very
> +convenient, and offers no parameter validation.
> +
> +GCC COBOL as of this writing works *only* in a Posix environment. This
> +directory exists to make using OS-provided functions a bit more convenient.
> +
> +## Contents
> +
> +The machine-shop tools are in this directory.  Things directly usable
> +by a COBOL program are in the `udf/` and `c/` directories.
> +
> +- `scrape.awk` extracts function prototypes from the SYNOPSIS of a man page.
> +- `udf-gen` reads function declarations and, for each one, produces a
> +  COBOL User Defined Function (UDF) that calls the function.
> +- `Makefile` produces a list of function prototypes from Section 2 of
> +  the manual.
> +- `c/` contains helper functions in C that cannot be expressed in
> +  COBOL. For example, the C `errno` "variable" may be a macro, and may
> +  not be declared except by `errno.h`, which is not accessible to
> +  COBOL.
> +- `udf/Makefile` builds some infrastructure and examples:
> +  - `udf/libposix-errno.so`, to get at the C `errno` variable and its
> +    string representation.
> +  - `udf/posix-mkdir.cbl` automatically from the manual, using `udf-gen`.
> +  - `udf/t/errno` and
> +  - `udf/t/exit` as examples of COBOL programs using these Posix UDFs.
> +
> +## Prerequisites
> +
> +`udf-gen` is a Python program that imports
> +the [PLY pycparser module](http://www.dabeaz.com/ply/) module, which must be 
> installed.
> +
> +`udf-gen` is lightly documented, use `udf-gen --help`. It can be a
> +little tedious to set up the first time, but if you want to use more a
> +few functions, it will be faster than doing the work by hand.
> +
> +## Limitations
> +
> +`udf-gen` does not
> +
> +- generate a working UDF for function parameters of type `struct`,
> +  such as is used by **stat**(2).  This is because the information is
> +  not available in a standardized way in the SYNOPSIS of a man page.
> +- define helpful Level 88 values for "magic" numbers, such as
> +  permission bits in **chmod**(2).
> +
> +None of this is particularly difficult; it's just a matter of time and
> +need. The `scrape.awk` script finds 560 functions in the Ubuntu LTS
> +22.04 manual.  Which of those is important is for users to decide.
> +
> +## Other Options
> +
> +IBM and Microfocus both supply intrinsic functions to interface with
> +the OS, each in their own way. GnuCOBOL implements some of those functions.
> +
> +## Portability
> +
> +The UDF produced by `udf-gen` is pure ISO COBOL.  The code should be
> +compilable by any ISO COBOL compiler.
> diff --git a/gcc/cobol/posix/c/posix_errno.c b/gcc/cobol/posix/c/posix_errno.c
> new file mode 100644
> index 00000000000..f87e271ced4
> --- /dev/null
> +++ b/gcc/cobol/posix/c/posix_errno.c
> @@ -0,0 +1,5 @@
> +#include <errno.h>
> +
> +int posix_errno() {
> +  return errno;
> +}
> diff --git a/gcc/cobol/posix/headers b/gcc/cobol/posix/headers
> new file mode 100644
> index 00000000000..b17c0f30cb3
> --- /dev/null
> +++ b/gcc/cobol/posix/headers
> @@ -0,0 +1,37 @@
> +#include <stddef.h>
> +#include <stdio.h>
> +#include <stddef.h>
> +#include <unistd.h>
> +#define loff_t ssize_t
> +#define socklen_t size_t
> +#define fd_set struct fd_set
> +#define id_t unsigned int
> +// typedef int mqd_t;
> +#define mqd_t int
> +// typedef unsigned long int nfds_t;
> +#define nfds_t unsigned long int
> +
> +#if 0
> +typedef struct
> +{
> +  unsigned long int __val[(1024 / (8 * sizeof (unsigned long int)))];
> +} __sigset_t;
> +define struct py_sigset_t                                            \
> +{                                                                    \
> +  unsigned long int __val[(1024 / (8 * sizeof (unsigned long int)))];        
> \
> +};
> +#else
> +#define kernel_sigset_t     sigset_t
> +#define old_kernel_sigset_t sigset_t
> +#endif
> +
> +#if 0
> +typedef enum
> +{
> +  P_ALL,
> +  P_PID,
> +  P_PGID
> +} idtype_t;
> +#else
> +#define idtype_t int
> +#endif
> diff --git a/gcc/cobol/posix/scrape.awk b/gcc/cobol/posix/scrape.awk
> new file mode 100755
> index 00000000000..4d244d0ee3d
> --- /dev/null
> +++ b/gcc/cobol/posix/scrape.awk
> @@ -0,0 +1,19 @@
> +#! /usr/bin/awk -f
> +
> +/^UNIMPLEMENTED/ {
> +  exit
> +}
> +
> +/^DESCRIPTION/ {
> +  exit
> +}
> +
> +/struct sched_param {$/ {
> +  exit
> +}
> +
> +/SYNOPSIS/,/DESCRIPTION/ {
> +  if( /([.][.]|[{},;]) *$/ ) {
> +    print
> +  }
> +}
> diff --git a/gcc/cobol/posix/udf-gen b/gcc/cobol/posix/udf-gen
> new file mode 100755
> index 00000000000..e6207085b1d
> --- /dev/null
> +++ b/gcc/cobol/posix/udf-gen
> @@ -0,0 +1,350 @@
> +#! /usr/bin/python3
> +
> +# Copyright (c) 2024 Symas Corporation
> +#
> +# Redistribution and use in source and binary forms, with or without
> +# modification, are permitted provided that the following conditions are
> +# met:
> +#
> +# * Redistributions of source code must retain the above copyright
> +#   notice, this list of conditions and the following disclaimer.
> +# * Redistributions in binary form must reproduce the above
> +#   copyright notice, this list of conditions and the following disclaimer
> +#   in the documentation and/or other materials provided with the
> +#   distribution.
> +# * Neither the name of the Symas Corporation nor the names of its
> +#   contributors may be used to endorse or promote products derived from
> +#   this software without specific prior written permission.
> +#
> +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
> +# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
> +# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
> +# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
> +# OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
> +# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
> +# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
> +# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
> +# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
> +# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
> +# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
> +
> +import sys, os, getopt, re, copy
> +from pycparser import c_parser, c_generator, c_ast, parse_file
> +
> +def starify(param):
> +    stars = ""
> +    while( isinstance(param, c_ast.PtrDecl) ):
> +        q = ' '.join(param.quals)
> +        stars = '*' + ' '.join((stars, q))
> +        param = param.type
> +    if( isinstance(param.type, c_ast.PtrDecl) ):
> +        (stars, param) = starify(param.type)
> +    if( isinstance(param, c_ast.TypeDecl) ):
> +        return (stars, param)
> +    return (stars, param.type)
> +
> +def linkage_str( i, name, param ) -> str:
> +    if name == 'execve':
> +        param.show()
> +    if( isinstance(param, c_ast.EllipsisParam) ):
> +        return (None, None, '...') # COBOL syntax error: no variadic UDF
> +
> +    is_array = False;
> +    node = param
> +
> +    if( isinstance(node, c_ast.Decl) ):
> +        node = node.type
> +
> +    if( isinstance(node, c_ast.ArrayDecl) ):
> +        is_array = True;
> +        node = node.type
> +
> +    (stars, node) = starify(node)
> +
> +    if( isinstance(node, c_ast.TypeDecl) ):
> +        level = 1
> +        item_name = ''
> +        picture = ''
> +        usage = ''
> +        if node.declname:
> +            item_name = 'Lk-' + node.declname
> +
> +        if is_array: # ignore level
> +            if stars:
> +                usage = 'Usage POINTER'
> +            output = '01 FILLER.\n              02 %s %s %s OCCURS 100' \
> +                % (item_name, picture, usage)
> +            return (None, None, output)
> +
> +        if( isinstance(node.type, c_ast.Struct) ):
> +            stars = None
> +
> +        if isinstance(node.type, c_ast.IdentifierType):
> +            ctype = node.type.names[-1]
> +            if ctype == 'void':
> +                if not stars and not item_name:
> +                    return (None, None, None)
> +            if ctype == 'char':
> +                picture = 'X'
> +                if stars[0] == '*':
> +                    picture = 'X ANY LENGTH'
> +            if ctype == 'int' or \
> +               ctype == 'long' or \
> +               ctype == 'mode_t' or \
> +               ctype == 'off_t' or \
> +               ctype == 'size_t':
> +                picture = '9(8)'
> +                usage = 'Usage COMP'
> +                stars = None
> +
> +        output = "%02d %s" % (level, ' '.join((item_name, 'PIC ' + picture, 
> usage)))
> +        return (stars, item_name, output)
> +
> +    node.show()
> +    return (None, None, '???')
> +
> +def using_str( i, name, param ) -> str:
> +    item_name = ''
> +    if( isinstance(param, c_ast.EllipsisParam) ):
> +        return '...' # COBOL syntax error: no variadic UDF
> +    node = param
> +
> +    if( isinstance(node, c_ast.Decl) ):
> +        node = node.type
> +
> +    if( isinstance(node, c_ast.ArrayDecl) ):
> +        node = node.type
> +
> +    (stars, node) = starify(node)
> +
> +    if( isinstance(node, c_ast.TypeDecl) ):
> +        item_name = ''
> +
> +        if isinstance(node.type, c_ast.IdentifierType):
> +            ctype = node.type.names[-1]
> +            how = 'By Reference'
> +            if ctype == 'int' or \
> +               ctype == 'long' or \
> +               ctype == 'mode_t' or \
> +               ctype == 'off_t' or \
> +               ctype == 'size_t':
> +                how = 'By Value'
> +        if node.declname:
> +            item_name = '%s Lk-%s' % (how, node.declname)
> +
> +    return item_name
> +
> +def parameter_str( i, name, param ) -> str:
> +    if( isinstance(param, c_ast.EllipsisParam) ):
> +        return '...'
> +
> +    t = [0, 1, 2] # qual, type, name
> +    is_array = False;
> +    node = param
> +
> +    if( isinstance(node, c_ast.Decl) ):
> +        node = node.type
> +
> +    if( isinstance(node, c_ast.ArrayDecl) ):
> +        is_array = True;
> +        node = node.type
> +
> +    (stars, node) = starify(node)
> +
> +    if( isinstance(node, c_ast.TypeDecl) ):
> +        t[0] = ' '.join(node.quals)
> +        item_name = ''
> +        if node.declname:
> +            item_name = 'Lk-' + node.declname
> +        t[2] = ' '.join((stars, item_name))
> +        if( node.declname == None ):
> +            t[2] = ''
> +        if( isinstance(node.type, c_ast.IdentifierType) ):
> +            try:
> +                t[1] = ' '.join(node.type.names)
> +            except:
> +                print("oops: node.type of %s is %s" % (name, str(node.type)))
> +                return "could not parse %s arg[%d]" % (name, i)
> +        if( isinstance(node.type, c_ast.Struct) ):
> +            t[0] = ' '.join(node.quals)
> +            t[1] = "struct " + node.type.name
> +    if( isinstance(node, c_ast.ArrayDecl) ):
> +        return parameter_str(i, name, node.type) + '[]'
> +
> +    try:
> +        return ' '.join(t)
> +    except:
> +        print("oops: %s[%d]: {%s}" % (name, i, str(t)) )
> +        param.show()
> +
> +class VisitPrototypes(c_ast.NodeVisitor):
> +    def __init__(self):
> +        self.done = set()
> +
> +    def type_of(self, node):
> +        while( not isinstance(node.type, c_ast.TypeDecl) ):
> +            node = node.type
> +        return node.type.type.name
> +
> +    def visit_Decl(self, node):
> +        name = node.name
> +        if name in self.done:
> +            return
> +        self.done.add(name)
> +
> +        params = []
> +        cbl_args = []
> +        linkage_items = []
> +        string_items = []
> +        returns = '???'
> +
> +        if False and isinstance(node.type, c_ast.FuncDecl):
> +            function_decl = node.type
> +            print('Function: %s' % node.name)
> +            if( node.type.args == None ):
> +                print('  (no arguments)')
> +            else:
> +                for param_decl in node.type.args.params:
> +                    if( isinstance(param_decl, c_ast.EllipsisParam) ):
> +                        param_decl.show(offset=6)
> +                        continue
> +                    print('  Arg name: %s' % param_decl.name)
> +                    print('  Type:')
> +                    param_decl.type.show(offset=6)
> +
> +        if isinstance(node.type, c_ast.FuncDecl):
> +            args = node.type.args
> +            if isinstance(args, c_ast.ParamList):
> +                #rint("params are %s (type %s)" % (str(args.params), 
> type(args.params)))
> +                if( args == None ):
> +                    params.append('')
> +                else:
> +                    for (i, param) in enumerate(args.params):
> +                        params.append(parameter_str(i, name, param))
> +                        cbl_args.append(using_str(i, name, param))
> +                        (stars, item, definition) = linkage_str(i, name, 
> param)
> +                        if definition:
> +                            if stars:
> +                                string_items.append(item)
> +                            linkage_items.append(definition)
> +
> +            (stars, rets) = starify(node.type)
> +
> +            if isinstance(rets, c_ast.TypeDecl):
> +                q =  ' '.join(rets.quals)
> +                if( isinstance(rets.type, c_ast.Struct) ):
> +                    t = "struct " + rets.type.name
> +                else:
> +                    t =  ' '.join(rets.type.names)
> +                returns = ' '.join((q, t, stars))
> +
> +        if name == None:
> +            return
> +
> +        # print the C version as a comment
> +        cparams = [ x.replace('Lk-', '') for x in params ]
> +        print( "      * %s %s(%s)"
> +               % (returns, name, ', '.join(cparams)) )
> +
> +        # print the UDF
> +        print( '        Identification Division.')
> +        sname = name
> +        if( sname[0] == '_' ):
> +            sname = sname[1:]
> +        print( '        Function-ID. posix-%s.' % sname)
> +
> +        print( '        Data Division.')
> +        print( '        Linkage Section.')
> +        print( '          77 Return-Value Binary-Long.')
> +        for item  in linkage_items:
> +            print( '          %s.' % item.strip())
> +        args = ',\n             '.join(cbl_args)
> +        args = 'using\n             %s\n            ' % args
> +        print( '        Procedure Division %s Returning Return-Value.'
> +               % args )
> +        for item in string_items:
> +            print( '          Inspect Backward %s ' % item +
> +                   'Replacing Leading Space By Low-Value' )
> +        using_args = ''
> +        if args:
> +            using_args = '%s' % args
> +        print( '          Call "%s" %s Returning Return-Value.'
> +               % (name, using_args) )
> +        print( '          Goback.')
> +        print( '        End Function posix-%s.' % sname)
> +
> +# Hard code a path to the fake includes
> +# if not using cpp(1) environment variables.
> +cpp_args = 
> ['-I/home/jklowden/projects/3rd/pycparser/utils/fake_libc_include']
> +
> +for var in ('CPATH', 'C_INCLUDE_PATH'):
> +    dir = os.getenv(var)
> +    if dir:
> +        cpp_args = ''
> +
> +def process(srcfile):
> +    ast = parse_file(srcfile, use_cpp=True, cpp_args=cpp_args)
> +    # print(c_generator.CGenerator().visit(ast))
> +    v = VisitPrototypes()
> +    v.visit(ast)
> +
> +__doc__ = """
> +SYNOPSIS
> +    udf-gen [-I include-path] [header-file ...]
> +
> +DESCRIPTION
> +    For each C function declared in header-file,
> +produce an ISO COBOL user-defined function definition to call it.
> +If no filename is supplied, declarations are read from standard input.
> +All output is written to standard output.
> +
> +    This Python script uses the PLY pycparser module,
> +(http://www.dabeaz.com/ply/), which supplies a set of simplified "fake
> +header files" to avoid parsing the (very complex) standard C header
> +files.  These alost suffice for parsing the Posix function
> +declarations in Section 2 of the manual.
> +
> +    Use the -I option or the cpp(1) environment variables to direct
> +the preprocessor to use the fake header files instead of the system
> +header files.
> +
> +LIMITATIONS
> +    udf-gen does not recognize C struct parameters, such as used by stat(2).
> +
> +     No attempt has been made to define "magic" values, such as would
> +be needed for example by chmod(2).
> +"""
> +
> +def main( argv=None ):
> +    global cpp_args
> +    if argv is None:
> +        argv = sys.argv
> +    # parse command line options
> +    try:
> +        opts, args = getopt.getopt(sys.argv[1:], "D:hI:m:", ["help"])
> +    except getopt.error as msg:
> +        print(msg)
> +        print("for help use --help")
> +        sys.exit(2)
> +
> +    # process options
> +    astfile = None
> +
> +    for opt, arg in opts:
> +        if opt in ("-h", "--help"):
> +            print(__doc__)
> +            sys.exit(0)
> +        if opt == '-D':
> +            cpp_args.append('-D%s ' % arg)
> +        if opt == '-I':
> +            cpp_args[0] = '-I' + arg
> +
> +    # process arguments
> +    if not args:
> +        args = ('/dev/stdin',)
> +
> +    for arg in args:
> +        process(arg)
> +
> +if __name__ == "__main__":
> +    sys.exit(main())
> diff --git a/gcc/cobol/posix/udf/Makefile b/gcc/cobol/posix/udf/Makefile
> new file mode 100644
> index 00000000000..8321f2dde90
> --- /dev/null
> +++ b/gcc/cobol/posix/udf/Makefile
> @@ -0,0 +1,27 @@
> +LDFLAGS = -L $$(pwd) -Wl,-rpath -Wl,$$(pwd)
> +

This clobbers passed LDFLAGS from the environment. It should probably append.

> +all: t/exit t/errno
> +
> +t/exit: posix-exit.cbl t/exit.cbl
> +     ../../built-gcobol $(FLAGS) -o $@ -I$$(pwd) $(lastword $^)
> +
> +t/errno: t/errno.cbl posix-mkdir.cbl | libposix-errno.so
> +     ../../built-gcobol $(FLAGS) -o $@ -I$$(pwd) \
> +     $(firstword $^) $(LDFLAGS) -lposix-errno
> +
> +libposix-errno.so: ../c/posix_errno.c posix-errno.o
> +     gcc $(CFLAGS) -shared -o $@ $^
> +

Directly invoking 'gcc' and not $(CC) looks off.

> +posix-errno.o: posix-errno.cbl
> +     ../../built-gcobol $(FLAGS) -fPIC  -c -o $@ $^
> +

What is $(FLAGS)? Should this really be $(COBOLFLAGS) or whatever? (Not
gone back over the patchset to see what you use in other places, but
$(FLAGS) is too generic.)

> +posix-mkdir.cbl:
> +     man 2 mkdir | ../scrape.awk | \
> +     ../udf-gen -D mode_t=unsigned\ long  > $@~
> +     @mv $@~ $@
> +
> +test: $(basename $(wildcard t/*.cbl))
> +     t/errno
> +
> +clean:
> +     rm -f *.o *.so $(basename $(wildcard t/*.cbl))
> diff --git a/gcc/cobol/posix/udf/posix-errno.cbl 
> b/gcc/cobol/posix/udf/posix-errno.cbl
> new file mode 100644
> index 00000000000..9670637b3ba
> --- /dev/null
> +++ b/gcc/cobol/posix/udf/posix-errno.cbl
> @@ -0,0 +1,18 @@
> +       Identification Division.
> +       Function-ID. posix-errno.
> +
> +       Data Division.
> +       Linkage Section.
> +       77 Return-Value Binary-Long.
> +       01 Error-Msg PIC X ANY LENGTH.
> +
> +       Procedure Division
> +           using Error-Msg
> +           Returning Return-Value.
> +       CALL "posix_errno"
> +           returning Return-Value.
> +       CALL "strerror"
> +           using by value Return-Value
> +           returning error-msg.
> +       Goback.
> +       END FUNCTION posix-errno.
> diff --git a/gcc/cobol/posix/udf/posix-exit.cbl 
> b/gcc/cobol/posix/udf/posix-exit.cbl
> new file mode 100644
> index 00000000000..cd2ac1857e9
> --- /dev/null
> +++ b/gcc/cobol/posix/udf/posix-exit.cbl
> @@ -0,0 +1,12 @@
> +       Identification Division.
> +       Function-ID. posix-exit.
> +
> +       Data Division.
> +       Linkage Section.
> +       77 Return-Value Binary-Long.
> +       77 Exit-Status Binary-Long.
> +
> +       Procedure Division using Exit-Status Returning Return-Value.
> +       CALL "_exit" using by value Exit-Status.
> +       Goback.
> +       END FUNCTION posix-exit.
> \ No newline at end of file
> diff --git a/gcc/cobol/posix/udf/t/errno.cbl b/gcc/cobol/posix/udf/t/errno.cbl
> new file mode 100644
> index 00000000000..22078ae3c31
> --- /dev/null
> +++ b/gcc/cobol/posix/udf/t/errno.cbl
> @@ -0,0 +1,26 @@
> +        COPY posix-mkdir.
> +        COPY posix-errno.
> +
> +        Identification Division.
> +        Program-ID. test-errno.
> +        Data Division.
> +        Working-Storage Section.
> +        77 Return-Value Binary-Long.
> +        77 Exit-Status Binary-Long Value 1.
> +        77 error-msg PIC X(100).
> +        77 errnum Binary-Long.
> +        77 Filename PIC X(100) Value '/'.
> +
> +        Procedure Division.
> +        Display 'calling posix-mkdir with a foolish name ...'
> +        Move Function posix-mkdir(Filename, 0) to Return-Value.
> +        If Return-Value <> 0
> +            Display 'calling posix-errno ...'
> +            Move Function posix-errno(error-msg) to errnum
> +            Display 'error: "' Filename '": ' error-msg ' (' errnum ')'
> +            Goback with Error Status errnum
> +        Else
> +            Display 'Return-Value is ' Return-Value
> +        End-If.
> +
> +        Goback.
> diff --git a/gcc/cobol/posix/udf/t/exit.cbl b/gcc/cobol/posix/udf/t/exit.cbl
> new file mode 100644
> index 00000000000..4aed400b17a
> --- /dev/null
> +++ b/gcc/cobol/posix/udf/t/exit.cbl
> @@ -0,0 +1,15 @@
> +        COPY posix-exit.
> +
> +        Identification Division.
> +        Program-ID. test-exit.
> +        Data Division.
> +        Working-Storage Section.
> +        77 Return-Value Binary-Long.
> +        77 Exit-Status Binary-Long Value 1.
> +
> +        Procedure Division.
> +        Display 'calling posix-exit ...'
> +        Move Function posix-exit(Exit-Status) to Return-Value.
> +      * Does not return, Does not print
> +        Display 'How did we get here?'
> +        Goback.

Reply via email to