diff --git a/libgcobol/libgcobol.h b/libgcobol/libgcobol.h
index 9fe6bf2a524..e4d0ab9fd78 100644
--- a/libgcobol/libgcobol.h
+++ b/libgcobol/libgcobol.h
@@ -59,17 +59,17 @@ extern "C" __int128 __gg__dirty_to_binary(const char
*dirty,
extern "C" __int128 __gg__binary_value_from_field( int *rdigits,
cblc_field_t *var);
-extern "C" int __gg__compare_2( cblc_field_t *left_side,
- unsigned char *left_location,
- size_t left_length,
- int left_attr,
- int left_flags,
- cblc_field_t *right_side,
- unsigned char *right_location,
- size_t right_length,
- int right_attr,
- int right_flags,
- int second_time_through);
+extern "C" int __gg__compare_2( cblc_field_t *left_side,
+ unsigned char *left_location,
+ size_t left_length,
+ uint64_t left_attr,
+ int left_flags,
+ cblc_field_t *right_side,
+ unsigned char *right_location,
+ size_t right_length,
+ uint64_t right_attr,
+ int right_flags,
+ int second_time_through);
extern "C" void __gg__int128_to_field(cblc_field_t *tgt,
__int128 value,
int source_rdigits,
@@ -144,4 +144,17 @@ void __gg__convert_encoding_length(char *pch,
const unsigned short *__gg__current_collation();
+// Warning: field_from_string uses charmap_t, so you can't safely feed
it
+// the results of __gg__iconverter without copying them.
+extern "C"
+void __gg__field_from_string( cblc_field_t *field,
+ size_t field_o,
+ size_t field_s,
+ const char *string,
+ size_t string_length);
+extern "C"
+void *__gg__memdup(const void *p, size_t size);
+
+enum {width_of_utf32 = 4};
+
#endif
diff --git a/libgcobol/posix/bin/Makefile b/libgcobol/posix/bin/Makefile
index 335f205068b..f3c8f911285 100644
--- a/libgcobol/posix/bin/Makefile
+++ b/libgcobol/posix/bin/Makefile
@@ -1,18 +1,37 @@
+.SUFFIXES: .scr .cbl
+
+ROOT = $(shell git rev-parse --show-toplevel)
+
#
# Demonstrate how to generate a new COBOL binding from a man page.
#
+SCRAPE = $(ROOT)/libgcobol/posix/bin/scrape.awk
+UDF.GEN = $(ROOT)/libgcobol/posix/bin/udf-gen
+
+posix-funcs:
+ test "$(FUNCS)"
+ for F in $(FUNCS); \
+ do man 2 $$F | col -b | $(SCRAPE) > posix-$$F.scr; \
+ $(MAKE) -f $(ROOT)/libgcobol/posix/bin/Makefile
posix-$${F}.cbl; done
+
+posix-$(FUNC).cbl:
+ man 2 $(FUNC) | col -b | $(SCRAPE) | \
+ $(UDF.GEN) -D mode_t=unsigned\ long > $@~
+ @mv $@~ $@
+
posix-mkdir.cbl:
- man 2 mkdir | ./scrape.awk | \
- ../udf-gen -D mode_t=unsigned\ long > $@~
+ man 2 mkdir | col -b | $(SCRAPE) | \
+ $(UDF.GEN) -D mode_t=unsigned\ long > $@~
@mv $@~ $@
# ... or
posix-stat-many.scr:
- man 2 stat | col -b | ./scrape.awk > $@~
+ man 2 stat | col -b | $(SCRAPE) > $@~
@mv $@~ $@
-.scr.cbl:
- ./udf-gen -D mode_t=unsigned\ long $^ > $@~
+%.cbl : %.scr
+ test -s $^
+ $(UDF.GEN) $(CPPFLAGS) $^ > $@~
@mv $@~ $@
diff --git a/libgcobol/posix/bin/scrape.awk
b/libgcobol/posix/bin/scrape.awk
index 4d244d0ee3d..ba83146b883 100755
--- a/libgcobol/posix/bin/scrape.awk
+++ b/libgcobol/posix/bin/scrape.awk
@@ -12,6 +12,7 @@
exit
}
+# Print lines that end in dots, a comma, a brace, or a semicolon.
/SYNOPSIS/,/DESCRIPTION/ {
if( /([.][.]|[{},;]) *$/ ) {
print
diff --git a/libgcobol/posix/bin/udf-gen b/libgcobol/posix/bin/udf-gen
index 4ad9f7fffe7..35c8caba268 100755
--- a/libgcobol/posix/bin/udf-gen
+++ b/libgcobol/posix/bin/udf-gen
@@ -30,6 +30,7 @@
import sys, os, getopt, re, copy
from pycparser import c_parser, c_generator, c_ast, parse_file
+from pycparser.plyparser import ParseError
def starify(param):
stars = ""
@@ -283,7 +284,11 @@ for var in ('CPATH', 'C_INCLUDE_PATH'):
cpp_args = ''
def process(srcfile):
- ast = parse_file(srcfile, use_cpp=True, cpp_args=cpp_args)
+ try:
+ ast = parse_file(srcfile, use_cpp=True, cpp_args=cpp_args)
+ except ParseError as oops:
+ print(oops, file=sys.stderr)
+ sys.exit(1)
# print(c_generator.CGenerator().visit(ast))
v = VisitPrototypes()
v.visit(ast)
diff --git a/libgcobol/posix/cpy/psx-lseek.cpy
b/libgcobol/posix/cpy/psx-lseek.cpy
new file mode 100644
index 00000000000..e53e071fcc1
--- /dev/null
+++ b/libgcobol/posix/cpy/psx-lseek.cpy
@@ -0,0 +1,14 @@
+ >> PUSH source format
+ >>SOURCE format is fixed
+
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+ * This file is in the public domain.
+ * Contributed by James K. Lowden of Cobolworx in November 2025.
+ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+
+ >>DEFINE SEEK_SET AS 2
+ >>DEFINE SEEK_CUR AS 4
+ >>DEFINE SEEK_END AS 8
+
+ >> POP source format
+
diff --git a/libgcobol/posix/shim/lseek.cc b/libgcobol/posix/shim/lseek.cc
new file mode 100644
index 00000000000..52407ed1df7
--- /dev/null
+++ b/libgcobol/posix/shim/lseek.cc
@@ -0,0 +1,31 @@
+#include <sys/types.h>
+#include <unistd.h>
+
+#include <cassert>
+#include <map>
+
+#define offsetof(TYPE, MEMBER) __builtin_offsetof (TYPE, MEMBER)
+
+extern "C" {
+
+off_t
+posix_lseek(int fd, off_t offset, int whence) {
+
+ static const std::map<int, int> whences {
+ { 2, SEEK_SET },
+ { 4, SEEK_CUR },
+ { 8, SEEK_END },
+ };
+
+ /*
+ * Map valid input whence value onto C standard library value.
+ * Invalid values are passed through and rejected by lseek(2) per its
documentation.
+ * (The caller always needs to check for errors anyway.)
+ */
+ auto p = whences.find(whence);
+ if( p != whences.end() ) whence = p.second;
+
+ return lseek(fd, offset, whence);
+}
+
+} // extern "C"
diff --git a/libgcobol/posix/udf/posix-lseek.cbl
b/libgcobol/posix/udf/posix-lseek.cbl
index ec007a92802..e82e3d0fe0e 100644
--- a/libgcobol/posix/udf/posix-lseek.cbl
+++ b/libgcobol/posix/udf/posix-lseek.cbl
@@ -11,12 +11,15 @@
01 Lk-fd PIC 9(8) Usage COMP.
01 Lk-offset Binary-Long.
01 Lk-whence Binary-Long.
+ 88 SEEK-SET VALUE 2.
+ 88 SEEK-CUR VALUE 4.
+ 88 SEEK-END VALUE 8.
Procedure Division using
By Value Lk-fd,
By Value Lk-offset,
By Value Lk-whence
Returning Return-Value.
- Call "lseek" using
+ Call "posix_lseek" using
By Value Lk-fd,
By Value Lk-offset,
By Value Lk-whence
diff --git a/libgcobol/posix/udf/posix-unlink.cbl
b/libgcobol/posix/udf/posix-unlink.cbl
index 16dab3eebaa..5285d7ab90d 100644
--- a/libgcobol/posix/udf/posix-unlink.cbl
+++ b/libgcobol/posix/udf/posix-unlink.cbl
@@ -19,11 +19,11 @@
Returning Return-Value.
Move Lk-pathname To Ws-pathname.
- Inspect Ws-pathname
- Replacing Trailing Space By Low-Value
+ D Inspect Ws-pathname
+ D Replacing Trailing Space By Low-Value
Inspect Backward Ws-pathname Replacing Leading Space,
- - By Low-Value.
+ By Low-Value.
Call "unlink" using
By Reference Ws-pathname,
Returning Return-Value.
diff --git a/libgcobol/stringbin.cc b/libgcobol/stringbin.cc
index acbc510ace2..713bc59f863 100644
--- a/libgcobol/stringbin.cc
+++ b/libgcobol/stringbin.cc
@@ -299,12 +299,14 @@ __gg__binary_to_string_ascii(char *result, int
digits, __int128 value)
bool
__gg__binary_to_string_encoded( char *result,
- int digits,
+ size_t digits,
__int128 value,
cbl_encoding_t encoding)
{
- charmap_t *charmap = __gg__get_charmap(encoding);
- zero_char = charmap->mapped_character(ascii_0);
+ // A non-zero retval means the number was too big to fit into the
desired
+ // number of digits.
+
+ zero_char = ascii_0;
// Note that this routine does not terminate the generated string with
a
// NUL. This routine is sometimes used to generate a NumericDisplay
string
@@ -317,8 +319,6 @@ __gg__binary_to_string_encoded( char *result,
value = -value;
}
- // A non-zero retval means the number was too big to fit into the
desired
- // number of digits:
bool retval = !!(value / mask);
// mask off the bottom digits to avoid garbage when value is too large
@@ -328,7 +328,13 @@ __gg__binary_to_string_encoded( char *result,
combined.run = digits;
combined.val128 = value;
string_from_combined(combined);
- memcpy(result, combined_string, digits);
+ size_t converted_bytes;
+ const char *converted = __gg__iconverter(DEFAULT_SOURCE_ENCODING,
+ encoding,
+ combined_string,
+ digits,
+ &converted_bytes);
+ memcpy(result, converted, converted_bytes);
return retval;
}
@@ -482,8 +488,8 @@ __gg__binary_to_packed( unsigned char *result,
extern "C"
__int128
__gg__numeric_display_to_binary(unsigned char *signp,
- const unsigned char *psz,
- int n,
+ const unsigned char *pdigits,
+ int ndigits,
cbl_encoding_t encoding)
{
/* This is specific to numeric display values.
@@ -507,12 +513,13 @@ __gg__numeric_display_to_binary(unsigned char
*signp,
/* We are assuming that 64-bit arithmetic is faster than 128-bit
arithmetic,
and so we build up a 128-bit result in three 64-bit pieces, and
assemble
them at the end. */
+ size_t digit_index = 0;
+ cbl_char_t ch;
charmap_t *charmap = __gg__get_charmap(encoding);
- unsigned char zero = charmap->mapped_character(ascii_0);
- unsigned char minus = charmap->mapped_character(ascii_minus);
+ cbl_char_t minus = charmap->mapped_character(ascii_minus);
- bool is_ebcdic = (zero == 0xF0);
+ bool is_ebcdic = charmap->is_like_ebcdic();
static const uint8_t lookup[] =
{
@@ -557,7 +564,7 @@ __gg__numeric_display_to_binary(unsigned char *signp,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x40
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x50
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x60
- 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x70
+ 0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0, // 0x70
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x80
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x90
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xa0
@@ -581,7 +588,7 @@ __gg__numeric_display_to_binary(unsigned char *signp,
bool is_negative = false;
// Pick up the original sign byte:
- unsigned char sign_byte = *signp;
+ cbl_char_t sign_byte = charmap->getch(signp, (size_t)0);
const unsigned char *mapper;
if( is_ebcdic )
@@ -599,7 +606,7 @@ __gg__numeric_display_to_binary(unsigned char *signp,
// forcing the zone to 0xF0. Note that this is harmless if
redundant, and
// harmless as well if the data SIGN IS SEPARATE. Whatever we do to
this
// byte will be undone at the end of the routine.
- *signp |= 0xF0;
+ charmap->putch(sign_byte|0xF0, signp, (size_t)0);
}
else
{
@@ -613,46 +620,49 @@ __gg__numeric_display_to_binary(unsigned char
*signp,
is_negative = true;
// Make it a valid positive digit by turning the zone to 0x30
- *signp &= 0x3F;
+ charmap->putch(sign_byte&0x3F, signp, (size_t)0);
}
}
// Digits 1 through 18 come from the bottom:
- if( n <= 18 )
+ if( ndigits <= 18 )
{
- count_bottom = n;
+ count_bottom = ndigits;
count_middle = 0;
count_top = 0;
}
- else if( n<= 36 )
+ else if( ndigits<= 36 )
{
count_bottom = 18;
- count_middle = n - 18;
+ count_middle = ndigits - 18;
count_top = 0;
}
else
{
count_bottom = 18;
count_middle = 18;
- count_top = n - 36;
+ count_top = ndigits - 36;
}
- if( n & 1 )
+ if( ndigits & 1 )
{
// We are dealing with an odd number of digits
if( count_top )
{
- top = mapper[*psz++];
+ ch = charmap->getch(pdigits, &digit_index);
+ top = mapper[ch];
count_top -= 1;
}
else if( count_middle )
{
- middle = mapper[*psz++];
+ ch = charmap->getch(pdigits, &digit_index);
+ middle = mapper[ch];
count_middle -= 1;
}
else
{
- bottom = mapper[*psz++];
+ ch = charmap->getch(pdigits, &digit_index);
+ bottom = mapper[ch];
count_bottom -= 1;
}
}
@@ -661,8 +671,10 @@ __gg__numeric_display_to_binary(unsigned char *signp,
while( count_top )
{
- add_me = mapper[*psz++] << 4;
- add_me += mapper[*psz++];
+ ch = charmap->getch(pdigits, &digit_index);
+ add_me = mapper[ch] << 4;
+ ch = charmap->getch(pdigits, &digit_index);
+ add_me += mapper[ch];
top *= 100 ;
top += lookup[add_me];
count_top -= 2;
@@ -670,8 +682,10 @@ __gg__numeric_display_to_binary(unsigned char *signp,
while( count_middle )
{
- add_me = mapper[*psz++] << 4;
- add_me += mapper[*psz++];
+ ch = charmap->getch(pdigits, &digit_index);
+ add_me = mapper[ch] << 4;
+ ch = charmap->getch(pdigits, &digit_index);
+ add_me += mapper[ch];
middle *= 100 ;
middle += lookup[add_me];
count_middle -= 2;
@@ -679,8 +693,10 @@ __gg__numeric_display_to_binary(unsigned char *signp,
while( count_bottom )
{
- add_me = mapper[*psz++] << 4;
- add_me += mapper[*psz++];
+ ch = charmap->getch(pdigits, &digit_index);
+ add_me = mapper[ch] << 4;
+ ch = charmap->getch(pdigits, &digit_index);
+ add_me += mapper[ch];
bottom *= 100 ;
bottom += lookup[add_me];
count_bottom -= 2;
@@ -700,7 +716,7 @@ __gg__numeric_display_to_binary(unsigned char *signp,
}
// Replace the original sign byte:
- *signp = sign_byte; // cppcheck-suppress redundantAssignment
+ charmap->putch(sign_byte, signp, (size_t)0);
return retval;
}
diff --git a/libgcobol/stringbin.h b/libgcobol/stringbin.h
index 48c4874292a..0f30a9ff701 100644
--- a/libgcobol/stringbin.h
+++ b/libgcobol/stringbin.h
@@ -36,7 +36,7 @@ bool __gg__binary_to_string_ascii(char *result,
__int128 value);
extern "C"
bool __gg__binary_to_string_encoded(char *result,
- int digits,
+ size_t digits, // Desired digits
__int128 value,
cbl_encoding_t encoding);
diff --git a/libgcobol/valconv.cc b/libgcobol/valconv.cc
index 00fa986bda5..012f881d4cd 100644
--- a/libgcobol/valconv.cc
+++ b/libgcobol/valconv.cc
@@ -226,6 +226,9 @@ __gg__string_to_numeric_edited( char * const dest,
// We need to expand the picture string. We assume that the caller
left
// enough room in dest to take the expanded picture string.
+ // Note that we do not put on a nul terminator, so if you need one,
it's
+ // your job to put it there.
+
int dlength = expand_picture(dest, picture);
// At the present time, I am taking a liberty. In principle, a 'V'
--
2.34.1
