sed -i "s|\"common-defs[.]h\"|\"$(LIB_SOURCE)/common-defs.h\"|g" $@
sed -i "s|\"io[.]h\"|\"$(LIB_SOURCE)/io.h\"|g" $@
sed -i "s|\"gcobolio[.]h\"|\"$(LIB_SOURCE)/gcobolio.h\"|g" $@
- sed -i "s|\"libgcobol[.]h\"|\"$(LIB_SOURCE)/libgcobol.h\"|g" $@
sed -i "s|\"gfileio[.]h\"|\"$(LIB_SOURCE)/gfileio.h\"|g" $@
sed -i "s|\"charmaps[.]h\"|\"$(LIB_SOURCE)/charmaps.h\"|g" $@
sed -i "s|\"valconv[.]h\"|\"$(LIB_SOURCE)/valconv.h\"|g" $@
sed -i "s|\"common-defs[.]h\"|\"$(LIB_SOURCE)/common-defs.h\"|g" $@
sed -i "s|\"io[.]h\"|\"$(LIB_SOURCE)/io.h\"|g" $@
sed -i "s|\"gcobolio[.]h\"|\"$(LIB_SOURCE)/gcobolio.h\"|g" $@
- sed -i "s|\"libgcobol[.]h\"|\"$(LIB_SOURCE)/libgcobol.h\"|g" $@
sed -i "s|\"gfileio[.]h\"|\"$(LIB_SOURCE)/gfileio.h\"|g" $@
sed -i "s|\"charmaps[.]h\"|\"$(LIB_SOURCE)/charmaps.h\"|g" $@
sed -i "s|\"valconv[.]h\"|\"$(LIB_SOURCE)/valconv.h\"|g" $@
#include "genmath.h"
#include "structs.h"
#include "../../libgcobol/gcobolio.h"
-#include "../../libgcobol/libgcobol.h"
#include "../../libgcobol/charmaps.h"
#include "../../libgcobol/valconv.h"
#include "show_parse.h"
else if( refer.field->type == FldLiteralN )
{
// The parser found the string of digits from the source code and converted
- // it to a _Float128.
+ // it to a 128-bit binary floating point number.
// The bad news is that something like 555.55 can't be expressed exactly;
// internally it is 555.5499999999....
- // The good news is that we know any string of 33 or fewer digits is
- // converted to _Float128 and then converted back again, you get the same
- // string.
+ // The good news is that we know any string of 33 or fewer decimal digits
+ // can be converted to and from IEEE 754 binary128 without being changes
// We make use of that here
#include "gengen.h"
#include "structs.h"
#include "../../libgcobol/gcobolio.h"
-#include "../../libgcobol/libgcobol.h"
#include "show_parse.h"
void
#include "genutil.h"
#include "structs.h"
#include "../../libgcobol/gcobolio.h"
-#include "../../libgcobol/libgcobol.h"
#include "../../libgcobol/charmaps.h"
#include "show_parse.h"
#include "../../libgcobol/exceptl.h"
else
{
// 19 through 38 is handled in a second step, because when this was written,
- // GCC couldn't handle __int128 constants:
+ // GCC couldn't handle 128-bit constants:
retval = pos[n/2];
retval *= retval;
if( n & 1 )
tree cblc_file_type_node;
tree cblc_file_p_type_node;
tree cblc_goto_type_node;
-tree cblc_int128_type_node;
// The following functions return type_decl nodes for the various structures
return retval;
}
-static tree
-create_cblc_int128_t()
- {
- /*
- // GCC-13 can't initialize __int64 variables, which is something we need to
- // be able to do. So, I created this union. The array can be initialized,
- // and thus we do an end run around the problem. Annoying, but not fatally
- // so.
-
- typedef union cblc_int128_t
- {
- unsigned char array16[16];
- __uint128 uval128;
- __int128 sval128;
- } cblc_int128_t;
- */
- tree retval = NULL_TREE;
- tree array_type = build_array_type_nelts(UCHAR, 16);
- retval = gg_get_filelevel_union_type_decl(
- "cblc_int128_t",
- 3,
- array_type, "array16" ,
- UINT128, "uval128" ,
- INT128, "sval128" );
- retval = TREE_TYPE(retval);
- return retval;
- }
-
void
create_our_type_nodes()
{
cblc_field_pp_type_node = build_pointer_type(cblc_field_p_type_node);
cblc_file_type_node = create_cblc_file_t();
cblc_file_p_type_node = build_pointer_type(cblc_file_type_node);
- cblc_int128_type_node = create_cblc_int128_t();
}
}
extern GTY(()) tree cblc_file_type_node;
extern GTY(()) tree cblc_file_p_type_node;
extern GTY(()) tree cblc_goto_type_node;
-extern GTY(()) tree cblc_int128_type_node;
extern void create_our_type_nodes();
bool is_elementary( enum cbl_field_type_t type );
+/* In cbl_field_t:
+ * 'offset' is overloaded for FldAlphanumeric/temporary/intermediate variables
+ * For such variables, offset is a copy of the initial capacity. This is in
+ * support of the FUNCTION TRIM function, which both needs to be able to
+ * reduce the capacity of the target variable, and then to reset it back to
+ * the original value
+ */
+
struct cbl_field_t {
size_t offset;
enum cbl_field_type_t type, usage;
#include "common-defs.h"
#include "io.h"
#include "gcobolio.h"
-#include "libgcobol.h"
#include "charmaps.h"
#include "valconv.h"
// takes 127 bits. By using a maximum of 37, that gives us an additional digit
// of headroom in order to accomplish rounding.
-// You should keep in mind that the _Float128 binary floating point numbers that
+// You should keep in mind that the 128-bit binary floating point numbers that
// we use can reliably reproduce numbers of 33 decimal digits when going to
// binary and back.
// In the __gg__move_literala() call, we piggyback this bit onto the
// cbl_round_t parameter, just to cut down on the number of parameters passed
+
#define REFER_ALL_BIT 0x80
+// Other bits for handling MOVE ALL and so on.
+#define REFER_T_ALL_FLAGS_MASK 0x0FF // We allow for seven subscripts
+#define REFER_T_MOVE_ALL 0x100 // This is the move_all flag
+#define REFER_T_ADDRESS_OF 0x200 // This is the address_of flag
+
+#define MIN_FIELD_BLOCK_SIZE (16)
+
+#define A_ZILLION (1000000) // Absurdly large number for __gg__call_parameter_count
+
+// These bits are used for the "call flags" of arithmetic operations
+#define ON_SIZE_ERROR 0x01
+#define REMAINDER_PRESENT 0x02
+
+#define MINIMUM_ALLOCATION_SIZE 16
/*
* User-defined names in IBM COBOL can have at most 30 characters.
return output;
}
-
+enum substitute_flags_t
+ {
+ substitute_anycase_e = 1,
+ substitute_first_e = 2, // first and last are mutually exclusive
+ substitute_last_e = 4,
+ };
#endif
#include "io.h"
#include "common-defs.h"
#include "gcobolio.h"
-#include "libgcobol.h"
-#include "gfileio.h"
-#include "charmaps.h"
-
-#include <sys/mman.h>
-#include <sys/stat.h>
-#include <sys/types.h>
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wwrite-strings"
.dummy = 0 , \
};
-
-
unsigned char __gg__data_space[1] = {' '};
struct cblc_field_t __gg__space = {
.data = __gg__data_space ,
};
+// The following declarations are used by both gcc/cobol code and the libgcobol
+// code
+
+struct cblc_declarative_t
+ {
+ int format;
+ int culprit; //declarative_culprit_t
+ int nfiles;
+ };
+
+/* According to the standard, the first digit of the file operation status
+ register is interpreted like this:
+
+ EC-I-O-AT-END '1'
+ EC-I-O-INVALID-KEY '2'
+ EC-I-O-PERMANENT-ERROR '3'
+ EC-I-O-LOGIC-ERROR '4'
+ EC-I-O-RECORD-OPERATION '5'
+ EC-I-O-FILE-SHARING '6'
+ EC-I-O-IMP '9'
+
+When the tens digit is '0', there are a number of conditions for
+successful completion. See section 9.1.12.1
+
+ 00 unqualified success
+ 02 duplicate key detected
+ 04 the data read were either too short or too long
+ 05 the operator couldn't find the tape
+ 07 somebody tried to rewind the card reader.
+
+For now, I am going to treat the io_status as an integer 00 through 99. I
+anticipate mostly returning
+ 00 for ordinary success,
+ 04 for a mismatched record size
+ 10 for an end-of-file
+
+*/
+
+// This global variable is constantly being updated with the yylineno. This is
+// useful for creating error messages, and for handling EXCEPTION_CONDITIONS
+extern int __gg__exception_code;
+extern int __gg__exception_line_number;
+extern int __gg__exception_file_status;
+extern const char *__gg__exception_file_name;
+extern const char *__gg__exception_statement;
+extern const char *__gg__exception_source_file;
+extern const char *__gg__exception_program_id;
+extern const char *__gg__exception_section;
+extern const char *__gg__exception_paragraph;
+
+extern "C" void __gg__set_exception_code( ec_type_t ec,
+ int from_raise_statement=0);
+
+#if 1
+ static inline
+ void exception_raise(ec_type_t ec_code) { __gg__set_exception_code(ec_code); }
+#else
+# define exception_raise(ec_code)do{__gg__set_exception_code(ec_code);}while(0);
+#endif
+
#endif
#include <unordered_map>
#include <vector>
+// RUNTIME structures *must* match the ones created in structs.c and initialized
+// and used in genapi.c. It's actually not all that important to emphasize that
+// fact, since the compiled executable will crash and burn quickly if they don't
+// match precisely.
+
+// Note that it must match the same structure in the GDB-COBOL debugger
+
typedef struct cblc_field_t
{
// This structure must match the code in structs.cc
/* end implementation details */
+enum cblc_file_flags_t
+ {
+ file_flag_none_e = 0x00000,
+ file_flag_optional_e = 0x00001,
+ file_flag_existed_e = 0x00002,
+ file_name_quoted_e = 0x00004,
+ file_flag_initialized_e = 0x00008,
+ };
+
typedef struct cblc_file_t
{
// This structure must match the code in structs.cc
int dummy;
} cblc_file_t;
+
+/* In various arithmetic routines implemented in libgcobol, it is oftent the
+ case that complicates lists of variables need to be conveyed. For example,
+ "ADD A B C D GIVING E" and "ADD A TO B C D" are valid instructions.
+
+ These treeplets (triplets of trees) were created to handle that. */
+
+extern cblc_field_t ** __gg__treeplet_1f;
+extern size_t * __gg__treeplet_1o;
+extern size_t * __gg__treeplet_1s;
+extern cblc_field_t ** __gg__treeplet_2f;
+extern size_t * __gg__treeplet_2o;
+extern size_t * __gg__treeplet_2s;
+extern cblc_field_t ** __gg__treeplet_3f;
+extern size_t * __gg__treeplet_3o;
+extern size_t * __gg__treeplet_3s;
+extern cblc_field_t ** __gg__treeplet_4f;
+extern size_t * __gg__treeplet_4o;
+extern size_t * __gg__treeplet_4s;
+
+extern int * __gg__fourplet_flags;
+
#endif
file->errnum = 0 ;
file->io_status = FsSuccess ;
file->delimiter = internal_newline ;
- file->flags = 0;
- file->flags |= (optional ? file_flag_optional_e : 0)
+ file->flags = file_flag_none_e;
+ file->flags |= (optional ? file_flag_optional_e : file_flag_none_e)
+ file_flag_initialized_e;
file->record_area_min = record_area_min;
file->record_area_max = record_area_max;
random_access_mode = ( file->access == file_access_rnd_e
|| file->access == file_access_dyn_e);
the_file_exists = access(trimmed_name, F_OK) == 0;
- file->flags |= the_file_exists ? file_flag_existed_e : 0 ;
+ file->flags |= the_file_exists ? file_flag_existed_e : file_flag_none_e ;
// We have four operations: INPUT (r) OUTPUT (w) I-O (+) and EXTEND (a)
// INPUT and I-O and EXTEND have different results based on is_optional
// file close time.
file->filename = filename;
file->flags &= ~file_name_quoted_e;
- file->flags |= is_quoted ? file_name_quoted_e : 0;
+ file->flags |= is_quoted ? file_name_quoted_e : file_flag_none_e;
__gg__file_reopen(file, mode_char);
}
#ifndef GFILEIO_H_
#define GFILEIO_H_
+// For indexed files, there can be one or more indexes, one per key.
+// Each index is one or more fields.
+
+struct file_hole_t
+ {
+ long location;
+ size_t size;
+ };
+
+struct file_index_t
+ {
+ std::multimap<std::vector<unsigned char>, long> key_to_position;
+ std::multimap<std::vector<unsigned char>, long>::iterator current_iterator;
+ std::multimap<std::vector<unsigned char>, long>::iterator ending_iterator;
+ };
+
+class supplemental_t
+ {
+ public:
+ std::vector<file_hole_t> holes;
+ std::vector<file_index_t> indexes;
+ std::vector<int> uniques;
+ };
+
extern "C"
{
void __gg__handle_error(const char *function, const char *msg);
#ifndef LIBGCOBOL_H_
#define LIBGCOBOL_H_
-#include <stdio.h>
+/* Many of the routines declared here are called from the gcc/cobol code by
+ means of explicit GENERIC calls, which is why they are defined as external
+ "C". Because there is no mechanism for checking the definitions, the caller
+ and callee have to agree on parameter types and the types of returned
+ values.
-#include <map>
-#include <vector>
-
-#define MIN_FIELD_BLOCK_SIZE (16)
-
-// RUNTIME structures *must* match the ones created in structs.c and initialized
-// and used in genapi.c. It's actually not all that important to emphasize that
-// fact, since the compiled executable will crash and burn quickly if they don't
-// match precisely.
-
-// Note that it must match the same structure in the GDB-COBOL debugger
-
-#define A_ZILLION (1000000) // Absurdly large number for __gg__call_parameter_count
-
-// These bits are used for the "call flags" of arithmetic operations
-#define ON_SIZE_ERROR 0x01
-#define REMAINDER_PRESENT 0x02
-
-/* 'offset' is overloaded for FldAlphanumeric/temporary/intermediate variables
- * For such variables, offset is a copy of the initial capacity. This is in
- * support of the FUNCTION TRIM function, which both needs to be able to
- * reduce the capacity of the target variable, and then to reset it back to
- * the original value
- */
-
-enum substitute_flags_t
- {
- substitute_anycase_e = 1,
- substitute_first_e = 2, // first and last are mutually exclusive
- substitute_last_e = 4,
- };
-
-enum cblc_file_flags_t
- {
- file_flag_optional_e = 0x00001,
- file_flag_existed_e = 0x00002,
- file_name_quoted_e = 0x00004,
- file_flag_initialized_e = 0x00008,
- };
-
-// For indexed files, there can be one or more indexes, one per key.
-// Each index is one or more fields.
-
-struct file_hole_t
- {
- long location;
- size_t size;
- };
-
-struct file_index_t
- {
- std::multimap<std::vector<unsigned char>, long> key_to_position;
- std::multimap<std::vector<unsigned char>, long>::iterator current_iterator;
- std::multimap<std::vector<unsigned char>, long>::iterator ending_iterator;
- };
-
-class supplemental_t
- {
- public:
- std::vector<file_hole_t> holes;
- std::vector<file_index_t> indexes;
- std::vector<int> uniques;
- };
-
-struct cblc_subscript_t
- {
- cblc_field_t *field; // That's what it usually is:
- unsigned int type; // When type is FldLiteralN, field is a pointer to __int128
- };
-
-#define REFER_T_ALL_FLAGS_MASK 0x0FF // We allow for seven subscripts
-#define REFER_T_MOVE_ALL 0x100 // This is the move_all flag
-#define REFER_T_ADDRESS_OF 0x200 // This is the address_of flag
-
-struct cblc_declarative_t
- {
- int format;
- int culprit; //declarative_culprit_t
- int nfiles;
- };
-
-/* According to the standard, the first digit of the file operation status
- register is interpreted like this:
-
- EC-I-O-AT-END '1'
- EC-I-O-INVALID-KEY '2'
- EC-I-O-PERMANENT-ERROR '3'
- EC-I-O-LOGIC-ERROR '4'
- EC-I-O-RECORD-OPERATION '5'
- EC-I-O-FILE-SHARING '6'
- EC-I-O-IMP '9'
-
-When the tens digit is '0', there are a number of conditions for
-successful completion. See section 9.1.12.1
-
- 00 unqualified success
- 02 duplicate key detected
- 04 the data read were either too short or too long
- 05 the operator couldn't find the tape
- 07 somebody tried to rewind the card reader.
-
-For now, I am going to treat the io_status as an integer 00 through 99. I
-anticipate mostly returning
- 00 for ordinary success,
- 04 for a mismatched record size
- 10 for an end-of-file
-
-*/
-
-// This global variable is constantly being updated with the yylineno. This is
-// useful for creating error messages, and for handling EXCEPTION_CONDITIONS
-extern int __gg__exception_code;
-extern int __gg__exception_line_number;
-extern int __gg__exception_file_status;
-extern const char *__gg__exception_file_name;
-extern const char *__gg__exception_statement;
-extern const char *__gg__exception_source_file;
-extern const char *__gg__exception_program_id;
-extern const char *__gg__exception_section;
-extern const char *__gg__exception_paragraph;
-
-extern "C" void __gg__set_exception_code( ec_type_t ec,
- int from_raise_statement=0);
-
-extern int * __gg__fourplet_flags;
-
-extern cblc_field_t ** __gg__treeplet_1f;
-extern size_t * __gg__treeplet_1o;
-extern size_t * __gg__treeplet_1s;
-extern cblc_field_t ** __gg__treeplet_2f;
-extern size_t * __gg__treeplet_2o;
-extern size_t * __gg__treeplet_2s;
-extern cblc_field_t ** __gg__treeplet_3f;
-extern size_t * __gg__treeplet_3o;
-extern size_t * __gg__treeplet_3s;
-extern cblc_field_t ** __gg__treeplet_4f;
-extern size_t * __gg__treeplet_4o;
-extern size_t * __gg__treeplet_4s;
-
-#if 1
- static inline
- void exception_raise(ec_type_t ec_code) { __gg__set_exception_code(ec_code); }
-#else
-# define exception_raise(ec_code)do{__gg__set_exception_code(ec_code);}while(0);
-#endif
+ Some are also called between source code modules in libgcobol, hence the
+ need here for declarations. */
extern "C" __int128 __gg__power_of_ten(int n);
int *rdigits);
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,
extern "C" _Float128 __gg__float128_from_location(cblc_field_t *var,
unsigned char *location);
extern "C" void __gg__adjust_dest_size(cblc_field_t *dest, size_t ncount);
-#define MINIMUM_ALLOCATION_SIZE 16
+
extern "C" void __gg__realloc_if_necessary( char **dest,
size_t *dest_size,
size_t new_size);
size_t var_size);
void __gg__abort(const char *msg);
-
#endif
projects / thirdparty / gcc.git / commitdiff
