cobol: Confine all __int128/_Float128 references to libgcobol.
These changes are part of the effort to make possible cross compilation for hosts that don't support __int128 or _Float128. gcc/cobol * Make-lang.in: Eliminate libgcobol.h from gcc/cobol files. * genapi.cc: Eliminate "#include libgcobol.h". (parser_display_internal): Change comment. * genmath.cc: Eliminate "#include libgcobol.h". * genutil.cc: Likewise. (get_power_of_ten): Change comment. * structs.cc: Eliminate cblc_int128_type_node. * structs.h: Likewise. * symbols.h: Receive comment from libgcobol.h libgcobol * charmaps.cc:Eliminate "#include libgcobol.h". Change comment about _Float128. * common-defs.h: Change comment about _Float128. Receive #defines from libgcobol.h. * constants.cc: Eliminate #include libgcobol.h. Eliminate other unneeded #includes. * ec.h: Receive declarations from libgcobol.h. * gcobolio.h: Likewise. * gfileio.cc: (__gg__file_init): Use file_flag_none_e instead of zero in assignment. (__gg__file_reopen): Likewise. (__io__file_open): Likewise. * gfileio.h: Receive declarations from libgcobol.h. * libgcobol.h: Numerous declarations moved elsewhere.
This commit is contained in:
Bob Dubner
Robert Dubner
parent
b69945d511
commit
137e294883
15 changed files with 169 additions and 205 deletions
|
|
@ -93,7 +93,6 @@ cobol/charmaps.cc: $(LIB_SOURCE)/charmaps.cc
|
|||
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" $@
|
||||
|
|
@ -105,7 +104,6 @@ cobol/valconv.cc: $(LIB_SOURCE)/valconv.cc
|
|||
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" $@
|
||||
|
|
|
|||
|
|
@ -48,7 +48,6 @@
|
|||
#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"
|
||||
|
|
@ -4800,14 +4799,13 @@ parser_display_internal(tree file_descriptor,
|
|||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -42,7 +42,6 @@
|
|||
#include "gengen.h"
|
||||
#include "structs.h"
|
||||
#include "../../libgcobol/gcobolio.h"
|
||||
#include "../../libgcobol/libgcobol.h"
|
||||
#include "show_parse.h"
|
||||
|
||||
void
|
||||
|
|
|
|||
|
|
@ -42,7 +42,6 @@
|
|||
#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"
|
||||
|
|
@ -1463,7 +1462,7 @@ get_power_of_ten(int n)
|
|||
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 )
|
||||
|
|
|
|||
|
|
@ -157,7 +157,6 @@ tree cblc_field_pp_type_node;
|
|||
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
|
||||
|
||||
|
|
@ -286,34 +285,6 @@ typedef struct cblc_file_t
|
|||
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()
|
||||
{
|
||||
|
|
@ -326,7 +297,6 @@ 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();
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -55,7 +55,6 @@ extern GTY(()) tree cblc_field_pp_type_node;
|
|||
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();
|
||||
|
||||
|
|
|
|||
|
|
@ -477,6 +477,14 @@ struct cbl_subtable_t {
|
|||
|
||||
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;
|
||||
|
|
|
|||
|
|
@ -42,7 +42,6 @@
|
|||
#include "common-defs.h"
|
||||
#include "io.h"
|
||||
#include "gcobolio.h"
|
||||
#include "libgcobol.h"
|
||||
#include "charmaps.h"
|
||||
#include "valconv.h"
|
||||
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@
|
|||
// 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.
|
||||
|
||||
|
|
@ -63,8 +63,23 @@
|
|||
|
||||
// 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.
|
||||
|
|
@ -495,6 +510,11 @@ T enabled_exception_match( T beg, T end, ec_type_t type, size_t file ) {
|
|||
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
|
||||
|
|
|
|||
|
|
@ -44,13 +44,6 @@
|
|||
#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"
|
||||
|
|
@ -113,8 +106,6 @@ struct cblc_field_t __gg___2_##a = { \
|
|||
.dummy = 0 , \
|
||||
};
|
||||
|
||||
|
||||
|
||||
unsigned char __gg__data_space[1] = {' '};
|
||||
struct cblc_field_t __gg__space = {
|
||||
.data = __gg__data_space ,
|
||||
|
|
|
|||
|
|
@ -210,4 +210,64 @@ enum ec_type_t {
|
|||
};
|
||||
|
||||
|
||||
// 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
|
||||
|
|
|
|||
|
|
@ -35,6 +35,13 @@
|
|||
#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
|
||||
|
|
@ -76,6 +83,15 @@ enum cblc_file_prior_op_t
|
|||
|
||||
/* 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
|
||||
|
|
@ -111,4 +127,26 @@ typedef struct cblc_file_t
|
|||
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
|
||||
|
|
|
|||
|
|
@ -334,8 +334,8 @@ __gg__file_init(
|
|||
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;
|
||||
|
|
@ -4138,7 +4138,7 @@ __gg__file_reopen(cblc_file_t *file, int mode_char)
|
|||
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
|
||||
|
|
@ -4351,7 +4351,7 @@ __io__file_open(cblc_file_t *file,
|
|||
// 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);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -30,6 +30,30 @@
|
|||
#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);
|
||||
|
|
|
|||
|
|
@ -30,153 +30,14 @@
|
|||
#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);
|
||||
|
||||
|
|
@ -188,6 +49,7 @@ extern "C" __int128 __gg__dirty_to_binary_internal( const char *dirty,
|
|||
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,
|
||||
|
|
@ -234,7 +96,7 @@ extern "C" void __gg__clock_gettime(clockid_t clk_id, struct timespec *tp);
|
|||
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);
|
||||
|
|
@ -252,5 +114,4 @@ extern "C" __int128 __gg__integer_from_qualified_field(cblc_field_t *var,
|
|||
size_t var_size);
|
||||
void __gg__abort(const char *msg);
|
||||
|
||||
|
||||
#endif
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue