GnuCOBOL  2.0
A free COBOL compiler
 All Data Structures Files Functions Variables Typedefs Enumerations Enumerator Macros
Data Structures | Macros | Typedefs | Functions
coblocal.h File Reference
This graph shows which files directly or indirectly include this file:

Go to the source code of this file.

Data Structures

struct  runtime_env
 

Macros

#define _(s)   s
 
#define N_(s)   s
 
#define COB_HIDDEN   extern
 
#define F_OK   0
 
#define X_OK   1
 
#define W_OK   2
 
#define R_OK   4
 
#define COB_DEPTH_LEVEL   32U
 
#define COB_DECIMAL_NAN   -32768
 
#define COB_DECIMAL_INF   -32767
 
#define COB_MPZ_DEF   1024UL
 
#define COB_MPF_PREC   2048UL
 
#define COB_MPF_CUTOFF   1024UL
 
#define COB_128_MSW(x)   x[1]
 
#define COB_128_LSW(x)   x[0]
 
#define COB_MPZ_ENDIAN   -1
 
#define COB_DEC_SPECIAL   COB_U64_C(0x7800000000000000)
 
#define COB_DEC_EXTEND   COB_U64_C(0x6000000000000000)
 
#define COB_DEC_SIGN   COB_U64_C(0x8000000000000000)
 
#define COB_64_IS_SPECIAL(x)   ((x & COB_DEC_SPECIAL) == COB_DEC_SPECIAL)
 
#define COB_128_IS_SPECIAL(x)   ((COB_128_MSW(x) & COB_DEC_SPECIAL) == COB_DEC_SPECIAL)
 
#define COB_64_IS_EXTEND(x)   ((x & COB_DEC_EXTEND) == COB_DEC_EXTEND)
 
#define COB_128_IS_EXTEND(x)   ((COB_128_MSW(x) & COB_DEC_EXTEND) == COB_DEC_EXTEND)
 
#define COB_64_EXPO_1   COB_U64_C(0x7FE0000000000000)
 
#define COB_64_SIGF_1   COB_U64_C(0x001FFFFFFFFFFFFF)
 
#define COB_64_EXPO_2   COB_U64_C(0x1FF8000000000000)
 
#define COB_64_SIGF_2   COB_U64_C(0x0007FFFFFFFFFFFF)
 
#define COB_64_OR_EXTEND   COB_U64_C(0x0020000000000000)
 
#define COB_128_EXPO_1   COB_U64_C(0x7FFE000000000000)
 
#define COB_128_SIGF_1   COB_U64_C(0x0001FFFFFFFFFFFF)
 
#define COB_128_EXPO_2   COB_U64_C(0x1FFF800000000000)
 
#define COB_128_SIGF_2   COB_U64_C(0x00007FFFFFFFFFFF)
 
#define COB_128_OR_EXTEND   COB_U64_C(0x0002000000000000)
 
#define COB_FIELD_INIT(x, y, z)
 
#define COB_ATTR_INIT(u, v, x, y, z)
 
#define COB_GET_SIGN(f)   (COB_FIELD_HAVE_SIGN (f) ? cob_real_get_sign (f) : 0)
 
#define COB_PUT_SIGN(f, s)   do { if (COB_FIELD_HAVE_SIGN (f)) cob_real_put_sign (f, s); } while (0)
 
#define COB_CHK_PARMS(x, z)
 
#define COB_D2I(x)   ((x) & 0x0F)
 
#define COB_I2D(x)   ((x) + '0')
 
#define COB_MODULE_PTR   cobglobptr->cob_current_module
 
#define COB_TERM_BUFF   cobglobptr->cob_term_buff
 
#define COB_DISP_TO_STDERR   cobglobptr->cob_disp_to_stderr
 
#define COB_BEEP_VALUE   cobglobptr->cob_beep_value
 
#define COB_ACCEPT_STATUS   cobglobptr->cob_accept_status
 
#define COB_TIMEOUT_SCALE   cobglobptr->cob_timeout_scale
 
#define COB_EXTENDED_STATUS   cobglobptr->cob_extended_status
 
#define COB_USE_ESC   cobglobptr->cob_use_esc
 
#define COB_MAX_Y_COORD   cobglobptr->cob_max_y
 
#define COB_MAX_X_COORD   cobglobptr->cob_max_x
 

Typedefs

typedef struct runtime_env runtime_env
 

Functions

COB_HIDDEN void cob_init_numeric (cob_global *)
 
COB_HIDDEN void cob_init_termio (cob_global *)
 
COB_HIDDEN void cob_init_fileio (cob_global *, runtime_env *runtimeptr)
 
COB_HIDDEN void cob_init_call (cob_global *, runtime_env *runtimeptr)
 
COB_HIDDEN void cob_init_intrinsic (cob_global *)
 
COB_HIDDEN void cob_init_strings (void)
 
COB_HIDDEN void cob_init_move (cob_global *, runtime_env *runtimeptr)
 
COB_HIDDEN void cob_init_screenio (cob_global *, runtime_env *runtimeptr)
 
COB_HIDDEN void cob_exit_screen (void)
 
COB_HIDDEN void cob_exit_numeric (void)
 
COB_HIDDEN void cob_exit_fileio (void)
 
COB_HIDDEN void cob_exit_call (void)
 
COB_HIDDEN void cob_exit_intrinsic (void)
 
COB_HIDDEN void cob_exit_strings (void)
 
COB_HIDDEN char * cob_strdup (const char *)
 
COB_HIDDEN int cob_real_get_sign (cob_field *)
 
COB_HIDDEN void cob_real_put_sign (cob_field *, const int)
 
COB_HIDDEN void cob_decimal_setget_fld (cob_field *, cob_field *, const int)
 
COB_HIDDEN void cob_decimal_move_temp (cob_field *, cob_field *)
 
COB_HIDDEN void cob_print_ieeedec (const cob_field *, FILE *)
 
COB_HIDDEN void cob_print_realbin (const cob_field *, FILE *, const int)
 
COB_HIDDEN void cob_screen_set_mode (const cob_u32_t)
 
COB_HIDDEN void cob_set_exception (const int)
 
COB_HIDDEN int cob_get_exception_code (void)
 
COB_HIDDEN int cob_check_env_true (char *)
 
COB_HIDDEN int cob_check_env_false (char *)
 
COB_HIDDEN const char * cob_get_exception_name (void)
 
COB_HIDDEN void cob_field_to_string (const cob_field *, void *, const size_t)
 
COB_HIDDEN void cob_parameter_check (const char *, const int)
 
COB_HIDDEN void cob_runtime_error (const char *,...) COB_A_FORMAT12
 
COB_HIDDEN char * cob_save_env_value (char *, char *)
 

Macro Definition Documentation

#define _ (   s)    s
#define COB_128_EXPO_1   COB_U64_C(0x7FFE000000000000)

Referenced by cob_decimal_set_ieee128dec().

#define COB_128_EXPO_2   COB_U64_C(0x1FFF800000000000)

Referenced by cob_decimal_set_ieee128dec().

#define COB_128_IS_EXTEND (   x)    ((COB_128_MSW(x) & COB_DEC_EXTEND) == COB_DEC_EXTEND)

Referenced by cob_decimal_set_ieee128dec().

#define COB_128_IS_SPECIAL (   x)    ((COB_128_MSW(x) & COB_DEC_SPECIAL) == COB_DEC_SPECIAL)

Referenced by cob_decimal_set_ieee128dec().

#define COB_128_LSW (   x)    x[0]

Referenced by cob_decimal_set_ieee128dec().

#define COB_128_MSW (   x)    x[1]

Referenced by cob_decimal_get_ieee128dec(), and cob_decimal_set_ieee128dec().

#define COB_128_OR_EXTEND   COB_U64_C(0x0002000000000000)

Referenced by cob_decimal_get_ieee128dec(), and cob_decimal_set_ieee128dec().

#define COB_128_SIGF_1   COB_U64_C(0x0001FFFFFFFFFFFF)

Referenced by cob_decimal_get_ieee128dec(), and cob_decimal_set_ieee128dec().

#define COB_128_SIGF_2   COB_U64_C(0x00007FFFFFFFFFFF)

Referenced by cob_decimal_get_ieee128dec(), and cob_decimal_set_ieee128dec().

#define COB_64_EXPO_1   COB_U64_C(0x7FE0000000000000)

Referenced by cob_decimal_set_ieee64dec().

#define COB_64_EXPO_2   COB_U64_C(0x1FF8000000000000)

Referenced by cob_decimal_set_ieee64dec().

#define COB_64_IS_EXTEND (   x)    ((x & COB_DEC_EXTEND) == COB_DEC_EXTEND)

Referenced by cob_decimal_set_ieee64dec().

#define COB_64_IS_SPECIAL (   x)    ((x & COB_DEC_SPECIAL) == COB_DEC_SPECIAL)

Referenced by cob_decimal_set_ieee64dec().

#define COB_64_OR_EXTEND   COB_U64_C(0x0020000000000000)

Referenced by cob_decimal_get_ieee64dec(), and cob_decimal_set_ieee64dec().

#define COB_64_SIGF_1   COB_U64_C(0x001FFFFFFFFFFFFF)

Referenced by cob_decimal_get_ieee64dec(), and cob_decimal_set_ieee64dec().

#define COB_64_SIGF_2   COB_U64_C(0x0007FFFFFFFFFFFF)

Referenced by cob_decimal_get_ieee64dec(), and cob_decimal_set_ieee64dec().

#define COB_ACCEPT_STATUS   cobglobptr->cob_accept_status

Referenced by cob_accept_escape_key().

#define COB_ATTR_INIT (   u,
  v,
  x,
  y,
  z 
)
Value:
do { \
attr.type = u; \
attr.digits = v; \
attr.scale = x; \
attr.flags = y; \
attr.pic = z; \
} while (0)

Referenced by cob_accept_arg_number(), cob_alloc_field(), cob_alloc_set_field_int(), cob_alloc_set_field_uint(), cob_decimal_get_field(), cob_decimal_move_temp(), cob_display_arg_number(), cob_get_int(), cob_intr_combined_datetime(), cob_intr_date_of_integer(), cob_intr_day_of_integer(), cob_intr_module_date(), cob_intr_module_time(), cob_intr_random(), cob_move_all(), cob_set_int(), display_numeric(), indirect_move(), and pretty_display_numeric().

#define COB_BEEP_VALUE   cobglobptr->cob_beep_value

Referenced by cob_sys_sound_bell().

#define COB_CHK_PARMS (   x,
  z 
)

Referenced by cob_sys_and(), cob_sys_calledby(), cob_sys_change_dir(), cob_sys_chdir(), cob_sys_check_file_exist(), cob_sys_close_file(), cob_sys_copy_file(), cob_sys_copyfile(), cob_sys_create_dir(), cob_sys_create_file(), cob_sys_delete_dir(), cob_sys_delete_file(), cob_sys_eq(), cob_sys_error_proc(), cob_sys_exit_proc(), cob_sys_file_delete(), cob_sys_file_info(), cob_sys_flush_file(), cob_sys_get_csr_pos(), cob_sys_get_current_dir(), cob_sys_get_scr_size(), cob_sys_getopt_long_long(), cob_sys_imp(), cob_sys_justify(), cob_sys_mkdir(), cob_sys_nimp(), cob_sys_nor(), cob_sys_not(), cob_sys_oc_nanosleep(), cob_sys_open_file(), cob_sys_or(), cob_sys_parameter_size(), cob_sys_printable(), cob_sys_read_file(), cob_sys_rename_file(), cob_sys_return_args(), cob_sys_sleep(), cob_sys_system(), cob_sys_tolower(), cob_sys_toupper(), cob_sys_write_file(), cob_sys_xf4(), cob_sys_xf5(), and cob_sys_xor().

#define COB_D2I (   x)    ((x) & 0x0F)

Referenced by cob_cmp_numdisp(), cob_decimal_get_packed(), cob_decimal_set_display(), cob_display_get_int(), cob_display_get_long_long(), cob_fatal_error(), cob_move_display_to_binary(), and cob_move_display_to_packed().

#define COB_DEC_EXTEND   COB_U64_C(0x6000000000000000)

Referenced by cob_decimal_get_ieee128dec(), and cob_decimal_get_ieee64dec().

#define COB_DEC_SIGN   COB_U64_C(0x8000000000000000)

Referenced by cob_decimal_get_ieee128dec(), cob_decimal_get_ieee64dec(), cob_decimal_set_ieee128dec(), and cob_decimal_set_ieee64dec().

#define COB_DEC_SPECIAL   COB_U64_C(0x7800000000000000)
#define COB_DECIMAL_INF   -32767

Referenced by cob_decimal_print().

#define COB_DECIMAL_NAN   -32768

Referenced by cob_alloc_field(), cob_decimal_div(), cob_decimal_get_field(), cob_decimal_pow(), cob_decimal_print(), cob_decimal_set_ieee128dec(), cob_decimal_set_ieee64dec(), and cob_div_quotient().

#define COB_DEPTH_LEVEL   32U

Referenced by cob_exit_intrinsic(), cob_init_intrinsic(), and make_field_entry().

#define COB_DISP_TO_STDERR   cobglobptr->cob_disp_to_stderr

Referenced by cob_display().

#define COB_EXTENDED_STATUS   cobglobptr->cob_extended_status
#define COB_FIELD_INIT (   x,
  y,
  z 
)
Value:
do { \
field.size = x; \
field.data = y; \
field.attr = z; \
} while (0)

Referenced by cob_alloc_field(), cob_alloc_set_field_int(), cob_alloc_set_field_uint(), cob_decimal_move_temp(), cob_intr_char(), cob_intr_combined_datetime(), cob_intr_concatenate(), cob_intr_currency_symbol(), cob_intr_current_date(), cob_intr_date_of_integer(), cob_intr_day_of_integer(), cob_intr_exception_file(), cob_intr_exception_location(), cob_intr_exception_statement(), cob_intr_exception_status(), cob_intr_formatted_date(), cob_intr_formatted_datetime(), cob_intr_formatted_time(), cob_intr_highest_algebraic(), cob_intr_lcl_time_from_secs(), cob_intr_locale_compare(), cob_intr_locale_date(), cob_intr_locale_time(), cob_intr_lowest_algebraic(), cob_intr_module_caller_id(), cob_intr_module_date(), cob_intr_module_formatted_date(), cob_intr_module_id(), cob_intr_module_path(), cob_intr_module_source(), cob_intr_module_time(), cob_intr_mon_decimal_point(), cob_intr_mon_thousands_sep(), cob_intr_num_decimal_point(), cob_intr_num_thousands_sep(), cob_intr_random(), cob_intr_substitute(), and cob_intr_substitute_case().

#define COB_GET_SIGN (   f)    (COB_FIELD_HAVE_SIGN (f) ? cob_real_get_sign (f) : 0)

Referenced by cob_cmp_all(), cob_cmp_alnum(), cob_decimal_set_display(), cob_display_get_int(), cob_display_get_long_long(), cob_inspect_init(), cob_move_alphanum_to_edited(), cob_move_display_to_alphanum(), cob_move_display_to_binary(), cob_move_display_to_display(), cob_move_display_to_edited(), and cob_move_display_to_packed().

#define COB_HIDDEN   extern
#define COB_I2D (   x)    ((x) + '0')

Referenced by cob_move_binary_to_display(), cob_move_packed_to_display(), and save_status().

#define COB_MAX_X_COORD   cobglobptr->cob_max_x
#define COB_MAX_Y_COORD   cobglobptr->cob_max_y
#define COB_MODULE_PTR   cobglobptr->cob_current_module

Referenced by cob_accept(), cob_check_numdisp(), cob_check_numval(), cob_check_numval_f(), cob_chk_file_mapping(), cob_cmp_all(), cob_cmp_alnum(), cob_cmp_numdisp(), cob_correct_numeric(), cob_file_sort_init(), cob_intr_currency_symbol(), cob_intr_module_caller_id(), cob_intr_module_date(), cob_intr_module_formatted_date(), cob_intr_module_id(), cob_intr_module_path(), cob_intr_module_source(), cob_intr_module_time(), cob_intr_mon_decimal_point(), cob_intr_mon_thousands_sep(), cob_intr_num_decimal_point(), cob_intr_num_thousands_sep(), cob_intr_numval(), cob_intr_numval_c(), cob_intr_numval_f(), cob_is_numeric(), cob_module_enter(), cob_module_leave(), cob_move_alphanum_to_display(), cob_move_display_to_edited(), cob_move_edited_to_display(), cob_real_get_sign(), cob_real_put_sign(), cob_restore_func(), cob_save_func(), cob_set_location(), cob_sys_calledby(), cob_sys_change_dir(), cob_sys_chdir(), cob_sys_check_file_exist(), cob_sys_copy_file(), cob_sys_create_dir(), cob_sys_delete_dir(), cob_sys_delete_file(), cob_sys_file_delete(), cob_sys_file_info(), cob_sys_getopt_long_long(), cob_sys_justify(), cob_sys_oc_nanosleep(), cob_sys_parameter_size(), cob_sys_printable(), cob_sys_rename_file(), cob_sys_return_args(), cob_sys_sleep(), cob_sys_system(), cob_sys_x91(), cob_table_sort_init(), cob_trace_section(), display_common(), open_cbl_file(), and pretty_display_numeric().

#define COB_MPF_CUTOFF   1024UL

Referenced by cob_mpf_exp(), and cob_mpf_log().

#define COB_MPF_PREC   2048UL

Referenced by cob_init_intrinsic(), cob_init_numeric(), cob_mpf_acos(), cob_mpf_asin(), cob_mpf_atan(), cob_mpf_cos(), cob_mpf_exp(), cob_mpf_log(), cob_mpf_log10(), cob_mpf_sin(), and cob_mpf_tan().

#define COB_MPZ_DEF   1024UL

Referenced by cob_decimal_init(), cob_init_intrinsic(), and cob_init_numeric().

#define COB_MPZ_ENDIAN   -1

Referenced by cob_decimal_get_ieee128dec(), and cob_decimal_get_ieee64dec().

#define COB_PUT_SIGN (   f,
  s 
)    do { if (COB_FIELD_HAVE_SIGN (f)) cob_real_put_sign (f, s); } while (0)

Referenced by cob_cmp_all(), cob_cmp_alnum(), cob_decimal_get_display(), cob_decimal_set_display(), cob_display_get_int(), cob_display_get_long_long(), cob_inspect_finish(), cob_move_alphanum_to_display(), cob_move_alphanum_to_edited(), cob_move_binary_to_display(), cob_move_display_to_alphanum(), cob_move_display_to_binary(), cob_move_display_to_display(), cob_move_display_to_edited(), cob_move_display_to_packed(), cob_move_edited_to_display(), and cob_move_packed_to_display().

#define COB_TERM_BUFF   cobglobptr->cob_term_buff

Referenced by cob_accept(), display_numeric(), and pretty_display_numeric().

#define COB_TIMEOUT_SCALE   cobglobptr->cob_timeout_scale
#define COB_USE_ESC   cobglobptr->cob_use_esc
#define F_OK   0
#define N_ (   s)    s
#define R_OK   4
#define W_OK   2
#define X_OK   1

Typedef Documentation

typedef struct runtime_env runtime_env

Function Documentation

COB_HIDDEN int cob_check_env_false ( char *  )

Referenced by cob_rescan_env_vals().

974 {
975  if (s) {
976  if (strlen(s) == 1 && (*s == 'N' || *s == 'n' || *s == '0')) return 1;
977  if (strcasecmp(s, "NO") == 0 || strcasecmp(s, "NONE") == 0 ||
978  strcasecmp(s, "OFF") == 0 || strcasecmp(s, "FALSE") == 0) {
979  return 1;
980  }
981  }
982  return 0;
983 }
COB_HIDDEN int cob_check_env_true ( char *  )

Referenced by cob_init(), cob_init_fileio(), cob_init_move(), cob_init_screenio(), and cob_rescan_env_vals().

961 {
962  if (s) {
963  if (strlen(s) == 1 && (*s == 'Y' || *s == 'y' || *s == '1')) return 1;
964  if (strcasecmp(s, "YES") == 0 || strcasecmp(s, "ON") == 0 ||
965  strcasecmp(s, "TRUE") == 0) {
966  return 1;
967  }
968  }
969  return 0;
970 }
COB_HIDDEN void cob_decimal_move_temp ( cob_field *  ,
cob_field *   
)

References COB_ATTR_INIT, cob_decimal_get_field(), cob_decimal_set_field(), COB_FIELD_INIT, COB_FLAG_HAVE_SIGN, cob_move(), cob_trim_decimal(), COB_TYPE_NUMERIC_DISPLAY, make_field_entry(), NULL, cob_decimal::scale, and cob_decimal::value.

Referenced by cob_move().

2076 {
2077  int size;
2078  int scale;
2079  cob_field_attr attr;
2080  cob_field field;
2081 
2082  cob_decimal_set_field (&d1, src);
2083  cob_trim_decimal (&d1);
2084 
2085  size = (int)mpz_sizeinbase (d1.value, 10);
2086  if (d1.scale > size) {
2087  size = d1.scale;
2088  }
2089  scale = d1.scale;
2090  COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, size,
2091  scale, COB_FLAG_HAVE_SIGN, NULL);
2092  COB_FIELD_INIT (size, NULL, &attr);
2093  make_field_entry (&field);
2094  (void)cob_decimal_get_field (&d1, curr_field, 0);
2095  cob_move (curr_field, dst);
2096 }
COB_HIDDEN void cob_decimal_setget_fld ( cob_field *  ,
cob_field *  ,
const int   
)

References cob_decimal_get_field(), and cob_decimal_set_field().

Referenced by cob_move().

2008 {
2009  cob_decimal_set_field (&cob_d1, src);
2010  (void)cob_decimal_get_field (&cob_d1, dst, opt);
2011 }
COB_HIDDEN void cob_exit_call ( void  )

References call_table, cob_free(), struct_handle::handle, HASH_SIZE, call_hash::name, call_hash::next, struct_handle::next, NULL, p, call_hash::path, and struct_handle::path.

Referenced by cob_terminate_routines().

1186 {
1187  struct call_hash *p;
1188  struct call_hash *q;
1189  struct struct_handle *h;
1190  struct struct_handle *j;
1191 
1192 #ifndef COB_ALT_HASH
1193  size_t i;
1194 #endif
1195 
1196  if (call_filename_buff) {
1197  cob_free (call_filename_buff);
1198  call_filename_buff = NULL;
1199  }
1200  if (call_entry_buff) {
1201  cob_free (call_entry_buff);
1202  call_entry_buff = NULL;
1203  }
1204  if (call_entry2_buff) {
1205  cob_free (call_entry2_buff);
1206  call_entry2_buff = NULL;
1207  }
1208  if (call_buffer) {
1209  cob_free (call_buffer);
1210  call_buffer = NULL;
1211  }
1212  if (resolve_error_buff) {
1213  cob_free (resolve_error_buff);
1214  resolve_error_buff = NULL;
1215  }
1216  if (resolve_alloc) {
1217  cob_free (resolve_alloc);
1218  resolve_alloc = NULL;
1219  }
1220  if (resolve_path) {
1221  cob_free (resolve_path);
1222  resolve_path = NULL;
1223  }
1224 
1225 #ifndef COB_ALT_HASH
1226  for (i = 0; i < HASH_SIZE; ++i) {
1227  p = call_table[i];
1228 #else
1229  p = call_table;
1230 #endif
1231  for (; p;) {
1232  q = p;
1233  p = p->next;
1234  if (q->name) {
1235  cob_free ((void *)q->name);
1236  }
1237  if (q->path) {
1238  cob_free ((void *)q->path);
1239  }
1240  cob_free (q);
1241  }
1242 #ifndef COB_ALT_HASH
1243  }
1244  if (call_table) {
1245  cob_free (call_table);
1246  }
1247  call_table = NULL;
1248 #endif
1249 
1250  for (h = base_preload_ptr; h;) {
1251  j = h;
1252  if (h->path) {
1253  cob_free ((void *)h->path);
1254  }
1255  if (h->handle) {
1256  lt_dlclose (h->handle);
1257  }
1258  h = h->next;
1259  cob_free (j);
1260  }
1261  base_preload_ptr = NULL;
1262  for (h = base_dynload_ptr; h;) {
1263  j = h;
1264  if (h->path) {
1265  cob_free ((void *)h->path);
1266  }
1267  if (h->handle) {
1268  lt_dlclose (h->handle);
1269  }
1270  h = h->next;
1271  cob_free (j);
1272  }
1273  base_dynload_ptr = NULL;
1274 
1275 #if !defined(_WIN32) && !defined(USE_LIBDL)
1276  lt_dlexit ();
1277 #if 0 /* RXWRXW - ltdl leak */
1278  /* Weird - ltdl leaks mainhandle - This appears to work but .. */
1279  cob_free (mainhandle);
1280 #endif
1281 #endif
1282 
1283 }
COB_HIDDEN void cob_exit_fileio ( void  )

References _, cob_file::assign, cob_close(), COB_CLOSE_NORMAL, __cob_global::cob_display_warn, cob_field_to_string(), COB_FILE_MAX, cob_file_path, COB_FILE_SPECIAL, cob_free(), COB_OPEN_CLOSED, COB_OPEN_LOCKED, file_list::file, cob_file::flag_nonexistent, file_list::next, NULL, cob_file::open_mode, p, runtime_buffer, and cob_file::select_name.

Referenced by cob_terminate_routines().

6299 {
6300  struct file_list *l;
6301  struct file_list *p;
6302 
6303  for (l = file_cache; l; l = l->next) {
6304  if (l->file && l->file->open_mode != COB_OPEN_CLOSED &&
6305  l->file->open_mode != COB_OPEN_LOCKED &&
6306  !l->file->flag_nonexistent) {
6307  if (COB_FILE_SPECIAL (l->file)) {
6308  continue;
6309  }
6310  cob_close (l->file, NULL, COB_CLOSE_NORMAL, 0);
6311  if (cobglobptr->cob_display_warn) {
6312  cob_field_to_string (l->file->assign,
6313  runtime_buffer,
6314  (size_t)COB_FILE_MAX);
6315  fprintf (stderr, _("WARNING - Implicit CLOSE of %s ('%s')"),
6316  l->file->select_name, runtime_buffer);
6317  putc ('\n', stderr);
6318  fflush (stderr);
6319  }
6320  }
6321  }
6322 #ifdef WITH_DB
6323  if (bdb_env) {
6324  bdb_env->lock_id_free (bdb_env, bdb_lock_id);
6325  bdb_env->close (bdb_env, 0);
6326  bdb_env = NULL;
6327  }
6328  if (record_lock_object) {
6329  cob_free (record_lock_object);
6330  record_lock_object = NULL;
6331  }
6332  if (bdb_buff) {
6333  cob_free (bdb_buff);
6334  bdb_buff = NULL;
6335  }
6336  if (bdb_home) {
6337  cob_free (bdb_home);
6338  bdb_home = NULL;
6339  }
6340 
6341 #elif defined(WITH_ANY_ISAM)
6342 #ifndef WITH_DISAM
6343  (void)iscleanup ();
6344 #endif
6345 #endif
6346 
6347 #if defined(WITH_INDEX_EXTFH) || defined(WITH_SEQRA_EXTFH)
6348  extfh_cob_exit_fileio ();
6349 #endif
6350 
6351  if (cob_file_path) {
6352  cob_free (cob_file_path);
6353  cob_file_path = NULL;
6354  }
6355 
6356  if (runtime_buffer) {
6357  cob_free (runtime_buffer);
6358  runtime_buffer = NULL;
6359  }
6360 
6361  for (l = file_cache; l;) {
6362  p = l;
6363  l = l->next;
6364  cob_free (p);
6365  }
6366  file_cache = NULL;
6367 }
COB_HIDDEN void cob_exit_intrinsic ( void  )

References calc_base, calc_struct::calc_field, COB_DEPTH_LEVEL, cob_free(), cob_log_half, cob_mexp, cob_mpft, cob_mpft2, cob_mpft_get, cob_mpzt, cob_pi, cob_sqrt_two, cob_u32_t, cob_field::data, and cob_decimal::value.

Referenced by cob_terminate_routines().

5827 {
5828  struct calc_struct *calc_temp;
5829  cob_u32_t i;
5830 
5831  mpf_clear (cob_log_half);
5832  mpf_clear (cob_sqrt_two);
5833  mpf_clear (cob_pi);
5834 
5835  mpf_clear (cob_mpft_get);
5836  mpf_clear (cob_mpft2);
5837  mpf_clear (cob_mpft);
5838 
5839  mpz_clear (d5.value);
5840  mpz_clear (d4.value);
5841  mpz_clear (d3.value);
5842  mpz_clear (d2.value);
5843  mpz_clear (d1.value);
5844 
5845  mpz_clear (cob_mpzt);
5846  mpz_clear (cob_mexp);
5847 
5848  calc_temp = calc_base;
5849  for (i = 0; i < COB_DEPTH_LEVEL; ++i, ++calc_temp) {
5850  if (calc_temp->calc_field.data) {
5851  cob_free (calc_temp->calc_field.data);
5852  }
5853  }
5854  cob_free (calc_base);
5855 }
COB_HIDDEN void cob_exit_numeric ( void  )

References cob_decimal_base, cob_free(), COB_MAX_BINARY, COB_MAX_DEC_STRUCT, cob_mexp, cob_mpft, cob_mpft_get, cob_mpz_ten16m1, cob_mpz_ten34m1, cob_mpze10, cob_mpzt, cob_mpzt2, d1, and cob_decimal::value.

Referenced by cob_terminate_routines().

2634 {
2635  cob_decimal *d1;
2636  size_t i;
2637 
2638  d1 = cob_decimal_base;
2639  for (i = 0; i < COB_MAX_DEC_STRUCT; d1++, i++) {
2640  mpz_clear (d1->value);
2641  }
2642  cob_free (cob_decimal_base);
2643 
2644  mpz_clear (cob_d_remainder.value);
2645 
2646  mpz_clear (cob_d3.value);
2647  mpz_clear (cob_d2.value);
2648  mpz_clear (cob_d1.value);
2649 
2650  mpz_clear (cob_mexp);
2651  mpz_clear (cob_mpzt2);
2652  mpz_clear (cob_mpzt);
2653 
2654  mpz_clear (cob_mpz_ten34m1);
2655  mpz_clear (cob_mpz_ten16m1);
2656  for (i = 0; i < COB_MAX_BINARY; i++) {
2657  mpz_clear (cob_mpze10[i]);
2658  }
2659 
2660  mpf_clear (cob_mpft_get);
2661  mpf_clear (cob_mpft);
2662 }
COB_HIDDEN void cob_exit_screen ( void  )

Referenced by cob_runtime_error(), and cob_terminate_routines().

1682 {
1683 }
COB_HIDDEN void cob_exit_strings ( void  )

References cob_free(), figurative_ptr, figurative_size, inspect_mark, and NULL.

Referenced by cob_terminate_routines().

635 {
636  if (inspect_mark) {
637  cob_free (inspect_mark);
638  inspect_mark = NULL;
639  }
640  if (dlm_list) {
641  cob_free (dlm_list);
642  dlm_list = NULL;
643  }
644  if (figurative_ptr) {
645  cob_free (figurative_ptr);
646  figurative_ptr = NULL;
647  }
648  figurative_size = 0;
649 }
COB_HIDDEN void cob_field_to_string ( const cob_field *  ,
void *  ,
const size_t   
)

References cob_field::data, cob_field::size, and unlikely.

Referenced by cob_call_field(), cob_cancel_field(), cob_delete_file(), cob_display_env_value(), cob_display_environment(), cob_exit_fileio(), cob_fatal_error(), cob_get_environment(), cob_intr_lcl_time_from_secs(), cob_intr_locale_compare(), cob_intr_locale_date(), cob_intr_locale_time(), cob_open(), cob_set_locale(), and cob_sys_getopt_long_long().

1335 {
1336  unsigned char *s;
1337  size_t count;
1338  size_t i;
1339 
1340  count = 0;
1341  if (unlikely(f->size == 0)) {
1342  return;
1343  }
1344  i = f->size - 1;
1345  for (; ;) {
1346  if (f->data[i] && f->data[i] != (unsigned char)' ') {
1347  count = i + 1;
1348  break;
1349  }
1350  if (!i) {
1351  break;
1352  }
1353  --i;
1354  }
1355  if (count > maxsize) {
1356  count = maxsize;
1357  }
1358  s = (unsigned char *)str;
1359  for (i = 0; i < count; ++i) {
1360  s[i] = f->data[i];
1361  }
1362  s[i] = 0;
1363 }
COB_HIDDEN int cob_get_exception_code ( void  )

References __cob_global::cob_exception_code.

Referenced by cob_string_append(), and cob_unstring_into().

1073 {
1074  return cobglobptr->cob_exception_code;
1075 }
COB_HIDDEN const char* cob_get_exception_name ( void  )

References __cob_global::cob_exception_code, cob_exception_tab_code, cob_exception_tab_name, EXCEPTION_TAB_SIZE, and NULL.

Referenced by cob_intr_exception_status().

1079 {
1080  size_t n;
1081 
1082  for (n = 0; n < EXCEPTION_TAB_SIZE; ++n) {
1083  if (cobglobptr->cob_exception_code == cob_exception_tab_code[n]) {
1084  return cob_exception_tab_name[n];
1085  }
1086  }
1087  return NULL;
1088 }
COB_HIDDEN void cob_init_call ( cob_global *  ,
runtime_env *  runtimeptr 
)

References cache_preload(), CALL_BUFF_SIZE, cob_fast_malloc(), cob_free(), COB_LIBRARY_PATH, cob_library_path_env, runtime_env::cob_library_path_env, cob_malloc(), COB_MEDIUM_BUFF, COB_MEDIUM_MAX, COB_MODULE_EXT, COB_NORMAL_BUFF, cob_preload_env, runtime_env::cob_preload_env, runtime_env::cob_preload_resolved, cob_save_env_value(), cob_set_library_path(), COB_SMALL_BUFF, cob_strdup(), HASH_SIZE, name_convert, runtime_env::name_convert, name_convert_env, runtime_env::name_convert_env, NULL, p, PATHSEPS, physical_cancel, runtime_env::physical_cancel, physical_cancel_env, runtime_env::physical_cancel_env, resolve_path, runtime_env::resolve_path, resolve_size, runtime_env::resolve_size, and SLASH_STR.

Referenced by cob_init().

1287 {
1288  char *buff;
1289  char *s;
1290  char *p;
1291  size_t i;
1292 #ifndef HAVE_DESIGNATED_INITS
1293  const unsigned char *pv;
1294 #endif
1295 #ifdef __OS400__
1296  char *t;
1297 #endif
1298 
1299  cobglobptr = lptr;
1300 
1301  base_preload_ptr = NULL;
1302  base_dynload_ptr = NULL;
1303  resolve_path = NULL;
1304  resolve_alloc = NULL;
1305  resolve_error = NULL;
1306  resolve_error_buff = NULL;
1307  mainhandle = NULL;
1308  call_buffer = NULL;
1309  call_filename_buff = NULL;
1310  call_entry_buff = NULL;
1311  call_entry2_buff = NULL;
1312  call_table = NULL;
1313  call_lastsize = 0;
1314  resolve_size = 0;
1315  name_convert = 0;
1316  cob_jmp_primed = 0;
1317  physical_cancel = 0;
1318 
1319 #ifndef HAVE_DESIGNATED_INITS
1320  memset (valid_char, 0, sizeof(valid_char));
1321  for (pv = pvalid_char; *pv; ++pv) {
1322  valid_char[*pv] = 1;
1323  }
1324 #endif
1325 
1326  /* Big enough for anything from libdl/libltdl */
1327  resolve_error_buff = cob_malloc ((size_t)CALL_BUFF_SIZE);
1328 
1329 #ifndef COB_ALT_HASH
1330  call_table = cob_malloc (sizeof (struct call_hash *) * HASH_SIZE);
1331 #endif
1332 
1333  call_filename_buff = cob_malloc ((size_t)COB_NORMAL_BUFF);
1334  call_entry_buff = cob_malloc ((size_t)COB_SMALL_BUFF);
1335 
1336  s = getenv ("COB_PHYSICAL_CANCEL");
1337  if (s) {
1338  physical_cancel_env = cob_save_env_value(physical_cancel_env, s);
1339 
1340  if (*s == 'Y' || *s == 'y' || *s == '1') {
1341  physical_cancel = 1;
1342  }
1343  } else {
1344  s = getenv ("default_cancel_mode");
1345  if (s) {
1346  if (*s == '0') {
1347  physical_cancel = 1;
1348  }
1349  }
1350  }
1351 
1352  s = getenv ("COB_LOAD_CASE");
1353  if (s != NULL) {
1354  name_convert_env = cob_save_env_value(name_convert_env, s);
1355 
1356  if (strcasecmp (s, "LOWER") == 0) {
1357  name_convert = 1;
1358  } else if (strcasecmp (s, "UPPER") == 0) {
1359  name_convert = 2;
1360  }
1361  }
1362 
1363  buff = cob_fast_malloc ((size_t)COB_MEDIUM_BUFF);
1364  s = getenv ("COB_LIBRARY_PATH");
1365  if (s == NULL) {
1366  snprintf (buff, (size_t)COB_MEDIUM_MAX, ".%s%s",
1367  PATHSEPS, COB_LIBRARY_PATH);
1368  } else {
1369  cob_library_path_env = cob_save_env_value(cob_library_path_env, s);
1370 
1371  snprintf (buff, (size_t)COB_MEDIUM_MAX, "%s%s.%s%s",
1372  s, PATHSEPS, PATHSEPS, COB_LIBRARY_PATH);
1373  }
1374  cob_set_library_path (buff);
1375 
1376  lt_dlinit ();
1377 
1378 #ifndef COB_BORKED_DLOPEN
1379  mainhandle = lt_dlopen (NULL);
1380 #endif
1381 
1382  s = getenv ("COB_PRE_LOAD");
1383  if (s != NULL) {
1384  cob_preload_env = cob_save_env_value(cob_preload_env, s);
1385 
1386  p = cob_strdup (s);
1387  s = strtok (p, PATHSEPS);
1388  for (; s; s = strtok (NULL, PATHSEPS)) {
1389 #ifdef __OS400__
1390  for (t = s; *t; ++t) {
1391  *t = toupper (*t);
1392  }
1393  cache_preload (t);
1394 #else
1395  for (i = 0; i < resolve_size; ++i) {
1396  buff[COB_MEDIUM_MAX] = 0;
1397  snprintf (buff, (size_t)COB_MEDIUM_MAX,
1398  "%s%s%s.%s",
1399  resolve_path[i], SLASH_STR, s, COB_MODULE_EXT);
1400  if (cache_preload (buff)) {
1401  break;
1402  }
1403  }
1404  /* If not found, try just using the name */
1405  if (i == resolve_size) {
1406  (void)cache_preload (s);
1407  }
1408 #endif
1409  }
1410  cob_free (p);
1411  }
1412  cob_free (buff);
1413  call_buffer = cob_fast_malloc ((size_t)CALL_BUFF_SIZE);
1414  call_lastsize = CALL_BUFF_SIZE;
1415 
1416  runtimeptr->physical_cancel = &physical_cancel;
1417  runtimeptr->physical_cancel_env = physical_cancel_env;
1418  runtimeptr->name_convert = &name_convert;
1419  runtimeptr->name_convert_env = name_convert_env;
1420  runtimeptr->resolve_path = resolve_path;
1421  runtimeptr->resolve_size = &resolve_size;
1422  runtimeptr->cob_library_path_env = cob_library_path_env;
1423  if(cob_preload_resolved) runtimeptr->cob_preload_resolved = cob_strdup(cob_preload_resolved);
1424  runtimeptr->cob_preload_env = cob_preload_env;
1425 }
COB_HIDDEN void cob_init_fileio ( cob_global *  ,
runtime_env *  runtimeptr 
)

References check_eop_status, cob_check_env_true(), runtime_env::cob_do_sync, cob_do_sync, runtime_env::cob_do_sync_env, cob_do_sync_env, cob_fast_malloc(), COB_FILE_BUFF, runtime_env::cob_file_path, cob_file_path, runtime_env::cob_file_path_env, cob_file_path_env, cob_file_write_opt(), cob_fileio_getenv(), cob_free(), runtime_env::cob_ls_fixed, cob_ls_fixed, runtime_env::cob_ls_fixed_env, cob_ls_fixed_env, runtime_env::cob_ls_nulls, cob_ls_nulls, runtime_env::cob_ls_nulls_env, cob_ls_nulls_env, runtime_env::cob_ls_uses_cr, cob_ls_uses_cr, runtime_env::cob_ls_uses_cr_env, cob_ls_uses_cr_env, cob_malloc(), cob_save_env_value(), cob_sli_t, COB_SMALL_BUFF, runtime_env::cob_sort_chunk, cob_sort_chunk, COB_SORT_CHUNK, runtime_env::cob_sort_chunk_env, cob_sort_chunk_env, runtime_env::cob_sort_memory, cob_sort_memory, COB_SORT_MEMORY, runtime_env::cob_sort_memory_env, cob_sort_memory_env, runtime_env::cob_varseq_type, cob_varseq_type, runtime_env::cob_varseq_type_env, cob_varseq_type_env, cob_vsq_len, eop_status, file_open_buff, file_open_env, file_open_name, NULL, runtime_buffer, and WITH_VARSEQ.

Referenced by cob_init().

6371 {
6372  char *s;
6373  cob_sli_t memsiz;
6374  int n;
6375  struct stat st;
6376 
6377  cobglobptr = lptr;
6378  file_cache = NULL;
6379  eop_status = 0;
6380  check_eop_status = 0;
6381  cob_do_sync = 0;
6382  cob_ls_uses_cr = 0;
6383  cob_ls_nulls = 0;
6384  cob_ls_fixed = 0;
6385  if ((s = getenv ("COB_SYNC")) != NULL) {
6386  cob_do_sync_env = cob_save_env_value(cob_do_sync_env, s);
6387 
6388  if (cob_check_env_true(s) || *s == 'P' || *s == 'p' ) {
6389  cob_do_sync = 1;
6390  }
6391  }
6392  if ((s = getenv ("COB_LS_USES_CR")) != NULL) {
6393  cob_ls_uses_cr_env = cob_save_env_value(cob_ls_uses_cr_env, s);
6394 
6395  if (cob_check_env_true(s)) {
6396  cob_ls_uses_cr = 1;
6397  }
6398  }
6399  cob_sort_memory = COB_SORT_MEMORY;
6400  if ((s = getenv ("COB_SORT_MEMORY")) != NULL) {
6401  cob_sort_memory_env = cob_save_env_value(cob_sort_memory_env, s);
6402 
6403  errno = 0;
6404  memsiz = strtol (s, NULL, 10);
6405  if (!errno && memsiz >= 1024 * 1024) {
6406  cob_sort_memory = (size_t)memsiz;
6407  }
6408  }
6409  cob_sort_chunk = COB_SORT_CHUNK;
6410  if ((s = getenv ("COB_SORT_CHUNK")) != NULL) {
6411  cob_sort_chunk_env = cob_save_env_value(cob_sort_chunk_env, s);
6412 
6413  n = atoi (s);
6414  if (n >= (128 * 1024) && n <= (16 * 1024 * 1024)) {
6415  cob_sort_chunk = (size_t)n;
6416  if (cob_sort_chunk % sizeof(void *)) {
6417  cob_sort_chunk += sizeof(void *) -
6418  (cob_sort_chunk % sizeof(void *));
6419  }
6420  }
6421  }
6422  if (cob_sort_chunk > (cob_sort_memory / 2)) {
6423  cob_sort_chunk = cob_sort_memory / 2;
6424  }
6425  cob_file_path = cob_fileio_getenv ("COB_FILE_PATH");
6426  cob_file_path_env = cob_save_env_value(cob_file_path_env, cob_file_path);
6427  if (cob_file_path) {
6428  if (stat (cob_file_path, &st) || !(S_ISDIR (st.st_mode))) {
6429  cob_free (cob_file_path);
6430  cob_file_path = NULL;
6431  }
6432  }
6433  if ((s = getenv ("COB_LS_NULLS")) != NULL) {
6434  cob_ls_nulls_env = cob_save_env_value(cob_ls_nulls_env, s);
6435 
6436  if (cob_check_env_true(s)) {
6437  cob_ls_nulls = 1;
6438  }
6439  }
6440  if ((s = getenv ("COB_LS_FIXED")) != NULL) {
6441  cob_ls_fixed_env = cob_save_env_value(cob_ls_fixed_env, s);
6442 
6443  if (cob_check_env_true(s)) {
6444  cob_ls_fixed = 1;
6445  }
6446  }
6447 
6448 #if WITH_VARSEQ == 3
6449  cob_vsq_len = 2;
6450 #else
6451  cob_vsq_len = 4;
6452 #endif
6453  cob_varseq_type = WITH_VARSEQ;
6454  if ((s = getenv ("COB_VARSEQ_FORMAT")) != NULL) {
6455  cob_varseq_type_env = cob_save_env_value(cob_varseq_type_env, s);
6456 
6457  if (*s == '0') {
6458  cob_varseq_type = 0;
6459  cob_vsq_len = 4;
6460  } else if (*s == '1') {
6461  cob_varseq_type = 1;
6462  cob_vsq_len = 4;
6463  } else if (*s == '2') {
6464  cob_varseq_type = 2;
6465  cob_vsq_len = 4;
6466  } else if (*s == '3') {
6467  cob_varseq_type = 3;
6468  cob_vsq_len = 2;
6469  }
6470  }
6471 
6472  runtime_buffer = cob_fast_malloc ((size_t)(4 * COB_FILE_BUFF));
6473  file_open_env = runtime_buffer + COB_FILE_BUFF;
6474  file_open_name = runtime_buffer + (2 * COB_FILE_BUFF);
6475  file_open_buff = runtime_buffer + (3 * COB_FILE_BUFF);
6476 
6477 #ifdef WITH_DB
6478  bdb_env = NULL;
6479  bdb_data_dir = NULL;
6480  bdb_home = cob_fileio_getenv ("DB_HOME");
6481  join_environment ();
6482  record_lock_object = cob_malloc ((size_t)1024);
6483  bdb_buff = cob_malloc ((size_t)COB_SMALL_BUFF);
6484  rlo_size = 1024;
6485 #endif
6486 
6487 #if defined(WITH_INDEX_EXTFH) || defined(WITH_SEQRA_EXTFH)
6488  extfh_cob_init_fileio (&sequential_funcs, &lineseq_funcs,
6489  &relative_funcs, &cob_file_write_opt);
6490 #endif
6491 
6492 
6493  runtimeptr->cob_do_sync = &cob_do_sync;
6494  runtimeptr->cob_do_sync_env = cob_do_sync_env;
6495  runtimeptr->cob_ls_nulls = &cob_ls_nulls;
6496  runtimeptr->cob_ls_nulls_env = cob_ls_nulls_env;
6497  runtimeptr->cob_ls_fixed = &cob_ls_fixed;
6498  runtimeptr->cob_ls_fixed_env = cob_ls_fixed_env;
6499  runtimeptr->cob_ls_uses_cr = &cob_ls_uses_cr;
6500  runtimeptr->cob_ls_uses_cr_env = cob_ls_uses_cr_env;
6501  runtimeptr->cob_file_path = cob_file_path;
6502  runtimeptr->cob_file_path_env = cob_file_path_env;
6503  runtimeptr->cob_sort_memory = &cob_sort_memory;
6504  runtimeptr->cob_sort_memory_env = cob_sort_memory_env;
6505  runtimeptr->cob_sort_chunk = &cob_sort_chunk;
6506  runtimeptr->cob_sort_chunk_env = cob_sort_chunk_env;
6507  runtimeptr->cob_varseq_type = &cob_varseq_type;
6508  runtimeptr->cob_varseq_type_env = cob_varseq_type_env;
6509 }
COB_HIDDEN void cob_init_intrinsic ( cob_global *  )

References calc_base, calc_struct::calc_field, calc_struct::calc_size, COB_DEPTH_LEVEL, cob_log_half, COB_LOG_HALF_LEN, cob_log_half_str, cob_malloc(), cob_mexp, COB_MPF_PREC, cob_mpft, cob_mpft2, cob_mpft_get, COB_MPZ_DEF, cob_mpzt, cob_pi, COB_PI_LEN, cob_pi_str, cob_sqrt_two, COB_SQRT_TWO_LEN, cob_sqrt_two_str, cob_u32_t, curr_entry, cob_field::data, NULL, cob_decimal::scale, cob_field::size, and cob_decimal::value.

Referenced by cob_init().

5859 {
5860  struct calc_struct *calc_temp;
5861  cob_u32_t i;
5862 
5863  cobglobptr = lptr;
5864 
5865  move_field = NULL;
5866  curr_entry = 0;
5867  curr_field = NULL;
5868  calc_base = cob_malloc (COB_DEPTH_LEVEL * sizeof(struct calc_struct));
5869  calc_temp = calc_base;
5870  for (i = 0; i < COB_DEPTH_LEVEL; ++i, ++calc_temp) {
5871  calc_temp->calc_field.data = cob_malloc ((size_t)256);
5872  calc_temp->calc_field.size = 256;
5873  calc_temp->calc_size = 256;
5874  }
5875 
5876  mpz_init2 (cob_mexp, COB_MPZ_DEF);
5877  mpz_init2 (cob_mpzt, COB_MPZ_DEF);
5878  mpz_init2 (d1.value, 1536UL);
5879  d1.scale = 0;
5880  mpz_init2 (d2.value, 1536UL);
5881  d2.scale = 0;
5882  mpz_init2 (d3.value, 1536UL);
5883  d3.scale = 0;
5884  mpz_init2 (d4.value, 1536UL);
5885  d4.scale = 0;
5886  mpz_init2 (d5.value, 1536UL);
5887  d5.scale = 0;
5888 
5889  mpf_init2 (cob_mpft, COB_MPF_PREC);
5890  mpf_init2 (cob_mpft2, COB_MPF_PREC);
5891  mpf_init2 (cob_mpft_get, COB_MPF_PREC);
5892 
5893  mpf_init2 (cob_pi, COB_PI_LEN);
5894  mpf_set_str (cob_pi, cob_pi_str, 10);
5895 
5896  mpf_init2 (cob_sqrt_two, COB_SQRT_TWO_LEN);
5897  mpf_set_str (cob_sqrt_two, cob_sqrt_two_str, 10);
5898 
5899  mpf_init2 (cob_log_half, COB_LOG_HALF_LEN);
5900  mpf_set_str (cob_log_half, cob_log_half_str, 10);
5901 }
COB_HIDDEN void cob_init_move ( cob_global *  ,
runtime_env *  runtimeptr 
)

References cob_check_env_true(), runtime_env::cob_local_edit, COB_UNUSED, and p.

Referenced by cob_init().

1683 {
1684 #if 0 /* RXWRXW - Local edit sym */
1685 #ifdef HAVE_LOCALECONV
1686  struct lconv *p;
1687  char *s;
1688 #endif
1689 #endif
1690 
1691  cobglobptr = lptr;
1692 
1693 #if 0 /* RXWRXW localeconv */
1694  cob_locale_edit = 0;
1695  cob_lc_dec = 0;
1696  cob_lc_thou = 0;
1697 #ifdef HAVE_LOCALECONV
1698  s = getenv ("COB_LOCALE_NUMERIC_EDITED");
1699  if (cob_check_env_true(s)) {
1700  p = localeconv ();
1701  if (strlen (p->mon_decimal_point) != 1) {
1702  return;
1703  }
1704  if (strlen (p->mon_thousands_sep) != 1) {
1705  return;
1706  }
1707  cob_locale_edit = 1;
1708  runtimeptr->cob_local_edit = &cob_local_edit;
1709  cob_lc_dec = *((unsigned char *)(p->mon_decimal_point));
1710  cob_lc_thou = *((unsigned char *)(p->mon_thousands_sep));
1711  }
1712 #else
1713  COB_UNUSED(runtimeptr);
1714 #endif
1715 #else
1716  COB_UNUSED(runtimeptr);
1717 #endif
1718 }
COB_HIDDEN void cob_init_numeric ( cob_global *  )

References cob_decimal_base, cob_decimal_init(), cob_malloc(), COB_MAX_BINARY, COB_MAX_DEC_STRUCT, cob_mexp, COB_MPF_PREC, cob_mpft, cob_mpft_get, COB_MPZ_DEF, cob_mpz_ten16m1, cob_mpz_ten34m1, cob_mpze10, cob_mpzt, cob_mpzt2, cob_u32_t, cob_uli_t, d1, last_packed_val, and packed_value.

Referenced by cob_init().

2666 {
2667  cob_decimal *d1;
2668  cob_u32_t i;
2669 
2670  cobglobptr = lptr;
2671 
2672  memset (packed_value, 0, sizeof(packed_value));
2673  last_packed_val = 0;
2674 
2675  mpf_init2 (cob_mpft, COB_MPF_PREC);
2676  mpf_init2 (cob_mpft_get, COB_MPF_PREC);
2677 
2678  for (i = 0; i < COB_MAX_BINARY; i++) {
2679  mpz_init2 (cob_mpze10[i], 128UL);
2680  mpz_ui_pow_ui (cob_mpze10[i], 10UL, (cob_uli_t)i);
2681  }
2682  mpz_init_set (cob_mpz_ten16m1, cob_mpze10[16]);
2683  mpz_sub_ui (cob_mpz_ten16m1, cob_mpz_ten16m1, 1UL);
2684  mpz_init_set (cob_mpz_ten34m1, cob_mpze10[34]);
2685  mpz_sub_ui (cob_mpz_ten34m1, cob_mpz_ten34m1, 1UL);
2686 
2687  mpz_init2 (cob_mpzt, COB_MPZ_DEF);
2688  mpz_init2 (cob_mpzt2, COB_MPZ_DEF);
2689  mpz_init2 (cob_mexp, COB_MPZ_DEF);
2690 
2691  cob_decimal_init (&cob_d1);
2692  cob_decimal_init (&cob_d2);
2693  cob_decimal_init (&cob_d3);
2694  cob_decimal_init (&cob_d_remainder);
2695 
2696  cob_decimal_base = cob_malloc (COB_MAX_DEC_STRUCT * sizeof(cob_decimal));
2697  d1 = cob_decimal_base;
2698  for (i = 0; i < COB_MAX_DEC_STRUCT; d1++, i++) {
2699  cob_decimal_init (d1);
2700  }
2701 }
COB_HIDDEN void cob_init_screenio ( cob_global *  ,
runtime_env *  runtimeptr 
)

References cob_check_env_true(), cob_legacy, runtime_env::cob_legacy, cob_legacy_env, runtime_env::cob_legacy_env, cob_save_env_value(), and NULL.

Referenced by cob_init().

1820 {
1821  char* s;
1822 
1823  /*
1824  * TODO: needs Documentation
1825  */
1826  if ((s = getenv ("COB_LEGACY")) != NULL) {
1827  if (cob_check_env_true(s)) {
1828  cob_legacy_env = cob_save_env_value(cob_legacy_env, s);
1829 
1830  cob_legacy = 1U;
1831  }
1832  }
1833 
1834  cobglobptr = lptr;
1835  runtimeptr->cob_legacy_env = cob_legacy_env;
1836  runtimeptr->cob_legacy = &cob_legacy;
1837 }
COB_HIDDEN void cob_init_strings ( void  )

References cob_field::attr, cob_malloc(), COB_NORMAL_BUFF, cob_u8_ptr, const_alpha_attr, const_strall_attr, cob_field::data, DLM_DEFAULT_NUM, dlm_list_size, figurative_ptr, figurative_size, inspect_mark, inspect_mark_size, NULL, and cob_field::size.

Referenced by cob_init().

653 {
654  inspect_mark = cob_malloc ((size_t)COB_NORMAL_BUFF);
655  dlm_list = cob_malloc (DLM_DEFAULT_NUM * sizeof(struct dlm_struct));
656  inspect_mark_size = COB_NORMAL_BUFF;
657  dlm_list_size = DLM_DEFAULT_NUM;
658  figurative_ptr = NULL;
659  figurative_size = 0;
660  alpha_fld.size = 0;
661  alpha_fld.data = NULL;
662  alpha_fld.attr = &const_alpha_attr;
663  str_cob_low.size = 1;
664  str_cob_low.data = (cob_u8_ptr)"\0";
665  str_cob_low.attr = &const_strall_attr;
666 }
COB_HIDDEN void cob_init_termio ( cob_global *  )

Referenced by cob_init().

342 {
343  cobglobptr = lptr;
344 }
COB_HIDDEN void cob_parameter_check ( const char *  ,
const int   
)

References _, __cob_global::cob_call_params, cob_runtime_error(), and cob_stop_run().

1688 {
1689  if (cobglobptr->cob_call_params < numparms) {
1690  cob_runtime_error (_("CALL to %s requires %d parameters"),
1691  funcname, numparms);
1692  cob_stop_run (1);
1693  }
1694 }
COB_HIDDEN void cob_print_ieeedec ( const cob_field *  ,
FILE *   
)

References cob_decimal_print(), cob_decimal_set_double(), cob_decimal_set_ieee128dec(), cob_decimal_set_ieee64dec(), COB_FIELD_TYPE, COB_TYPE_NUMERIC_DOUBLE, COB_TYPE_NUMERIC_FLOAT, COB_TYPE_NUMERIC_FP_DEC128, COB_TYPE_NUMERIC_FP_DEC64, and cob_field::data.

Referenced by display_common().

1648 {
1649  union {
1650  double dval;
1651  float fval;
1652  } uval;
1653 
1654  switch (COB_FIELD_TYPE (f)) {
1655  case COB_TYPE_NUMERIC_FP_DEC64:
1656  cob_decimal_set_ieee64dec (&cob_d3, f);
1657  break;
1658  case COB_TYPE_NUMERIC_FP_DEC128:
1659  cob_decimal_set_ieee128dec (&cob_d3, f);
1660  break;
1661  case COB_TYPE_NUMERIC_FLOAT:
1662  memcpy ((void *)&uval.fval, f->data, sizeof(float));
1663  cob_decimal_set_double (&cob_d3, (double)uval.fval);
1664  break;
1665  case COB_TYPE_NUMERIC_DOUBLE:
1666  memcpy ((void *)&uval.dval, f->data, sizeof(double));
1667  cob_decimal_set_double (&cob_d3, uval.dval);
1668  break;
1669  default:
1670  return;
1671  }
1672  cob_decimal_print (&cob_d3, fp);
1673 }
COB_HIDDEN void cob_print_realbin ( const cob_field *  ,
FILE *  ,
const int   
)

References CB_FMT_PLLD, CB_FMT_PLLU, cob_binary_get_sint64(), COB_FIELD_HAVE_SIGN, cob_s64_t, and cob_u64_t.

Referenced by display_common().

1677 {
1678  union {
1679  cob_u64_t uval;
1680  cob_s64_t val;
1681  } llval;
1682 
1683  if (COB_FIELD_HAVE_SIGN (f)) {
1684  llval.val = cob_binary_get_sint64 (f);
1685  fprintf (fp, CB_FMT_PLLD, size, size, llval.val);
1686  return;
1687  }
1688  llval.uval = cob_binary_get_sint64 (f);
1689  fprintf (fp, CB_FMT_PLLU, size, size, llval.uval);
1690 }
COB_HIDDEN int cob_real_get_sign ( cob_field *  )

References COB_FIELD_NO_SIGN_NIBBLE, COB_FIELD_SIGN_LEADING, COB_FIELD_SIGN_SEPARATE, COB_FIELD_TYPE, cob_get_sign_ascii(), cob_get_sign_ebcdic(), COB_MODULE_PTR, COB_TYPE_NUMERIC_DISPLAY, COB_TYPE_NUMERIC_PACKED, cob_field::data, p, cob_field::size, and unlikely.

1986 {
1987  unsigned char *p;
1988 
1989  switch (COB_FIELD_TYPE (f)) {
1990  case COB_TYPE_NUMERIC_DISPLAY:
1991  /* Locate sign */
1992  if (unlikely(COB_FIELD_SIGN_LEADING (f))) {
1993  p = f->data;
1994  } else {
1995  p = f->data + f->size - 1;
1996  }
1997 
1998  /* Get sign */
1999  if (unlikely(COB_FIELD_SIGN_SEPARATE (f))) {
2000  return (*p == '-') ? -1 : 1;
2001  }
2002  if (*p >= (unsigned char)'0' && *p <= (unsigned char)'9') {
2003  return 1;
2004  }
2005  if (*p == ' ') {
2006 #if 0 /* RXWRXW - Space sign */
2007  *p = (unsigned char)'0';
2008 #endif
2009  return 1;
2010  }
2011  if (unlikely(COB_MODULE_PTR->ebcdic_sign)) {
2012  return cob_get_sign_ebcdic (p);
2013  }
2014  return cob_get_sign_ascii (p);
2015  case COB_TYPE_NUMERIC_PACKED:
2016  if (COB_FIELD_NO_SIGN_NIBBLE (f)) {
2017  return 1;
2018  }
2019  p = f->data + f->size - 1;
2020  return ((*p & 0x0F) == 0x0D) ? -1 : 1;
2021  }
2022  return 0;
2023 }
COB_HIDDEN void cob_real_put_sign ( cob_field *  ,
const int   
)

References COB_FIELD_NO_SIGN_NIBBLE, COB_FIELD_SIGN_LEADING, COB_FIELD_SIGN_SEPARATE, COB_FIELD_TYPE, COB_MODULE_PTR, cob_put_sign_ascii(), cob_put_sign_ebcdic(), COB_TYPE_NUMERIC_DISPLAY, COB_TYPE_NUMERIC_PACKED, cob_u8_t, cob_field::data, p, cob_field::size, and unlikely.

2027 {
2028  unsigned char *p;
2029  unsigned char c;
2030 
2031  switch (COB_FIELD_TYPE (f)) {
2032  case COB_TYPE_NUMERIC_DISPLAY:
2033  /* Locate sign */
2034  if (unlikely(COB_FIELD_SIGN_LEADING (f))) {
2035  p = f->data;
2036  } else {
2037  p = f->data + f->size - 1;
2038  }
2039 
2040  /* Put sign */
2041  if (unlikely(COB_FIELD_SIGN_SEPARATE (f))) {
2042  c = (sign < 0) ? (cob_u8_t)'-' : (cob_u8_t)'+';
2043  if (*p != c) {
2044  *p = c;
2045  }
2046  } else if (unlikely(COB_MODULE_PTR->ebcdic_sign)) {
2047  cob_put_sign_ebcdic (p, sign);
2048  } else if (sign < 0) {
2049  cob_put_sign_ascii (p);
2050  }
2051  return;
2052  case COB_TYPE_NUMERIC_PACKED:
2053  if (COB_FIELD_NO_SIGN_NIBBLE (f)) {
2054  return;
2055  }
2056  p = f->data + f->size - 1;
2057  if (sign < 0) {
2058  *p = (*p & 0xF0) | 0x0D;
2059  } else {
2060  *p = (*p & 0xF0) | 0x0C;
2061  }
2062  return;
2063  }
2064 }
COB_HIDDEN void cob_runtime_error ( const char *  ,
  ... 
)

References _, cob_exit_screen(), cob_free(), cob_source_file, cob_source_line, hdlrs, handlerlist::next, NULL, p, handlerlist::proc, and runtime_err_str.

Referenced by cob_call(), cob_call_error(), cob_cancel(), cob_check_based(), cob_check_numeric(), cob_check_odo(), cob_check_ref_mod(), cob_check_subscript(), cob_check_version(), cob_command_line(), cob_external_addr(), cob_fatal_error(), cob_get_sort_tempfile(), cob_longjmp(), cob_parameter_check(), cob_resolve_func(), cob_savenv(), cob_sys_check_file_exist(), cob_sys_file_info(), cob_sys_getopt_long_long(), and cob_sys_system().

1386 {
1387  struct handlerlist *h;
1388  struct handlerlist *hp;
1389  char *p;
1390  va_list ap;
1391 
1392 #if 1 /* RXWRXW - Exit screen */
1393  /* Exit screen mode early */
1394  cob_exit_screen ();
1395 #endif
1396 
1397  if (hdlrs != NULL) {
1398  if (runtime_err_str) {
1399  p = runtime_err_str;
1400  if (cob_source_file) {
1401  sprintf (runtime_err_str, "%s: %u: ",
1402  cob_source_file, cob_source_line);
1403  p = runtime_err_str + strlen (runtime_err_str);
1404  }
1405  va_start (ap, fmt);
1406  vsprintf (p, fmt, ap);
1407  va_end (ap);
1408  }
1409  h = hdlrs;
1410  while (h != NULL) {
1411  if (runtime_err_str) {
1412  h->proc (runtime_err_str);
1413  } else {
1414  h->proc ((char *)_("Malloc error"));
1415  }
1416  hp = h;
1417  h = h->next;
1418  cob_free (hp);
1419  }
1420  hdlrs = NULL;
1421  }
1422 
1423  /* Prefix */
1424  if (cob_source_file) {
1425  fprintf (stderr, "%s: %u: ", cob_source_file, cob_source_line);
1426  }
1427  fputs ("libcob: ", stderr);
1428 
1429  /* Body */
1430  va_start (ap, fmt);
1431  vfprintf (stderr, fmt, ap);
1432  va_end (ap);
1433 
1434  /* Postfix */
1435  putc ('\n', stderr);
1436  fflush (stderr);
1437 }
COB_HIDDEN char* cob_save_env_value ( char *  ,
char *   
)

References cob_fast_malloc(), cob_free(), and NULL.

Referenced by cob_init(), cob_init_call(), cob_init_fileio(), cob_init_screenio(), and cob_rescan_env_vals().

3914  {
3915  if (!env_val) return NULL;
3916 
3917  if (env_var) cob_free(env_var);
3918  env_var = (char*) cob_fast_malloc(strlen(env_val) + 1);
3919  strcpy(env_var, env_val);
3920 
3921  return env_var;
3922 }
COB_HIDDEN void cob_screen_set_mode ( const cob_u32_t  )

References COB_UNUSED.

Referenced by cob_sys_system().

1745 {
1746  COB_UNUSED (smode);
1747 }
COB_HIDDEN void cob_set_exception ( const int  )

References cob_current_paragraph, cob_current_program_id, cob_current_section, __cob_global::cob_exception_code, cob_exception_tab_code, __cob_global::cob_got_exception, __cob_global::cob_orig_line, __cob_global::cob_orig_paragraph, __cob_global::cob_orig_program_id, __cob_global::cob_orig_section, __cob_global::cob_orig_statement, cob_source_line, and cob_source_statement.

Referenced by cob_accept(), cob_accept_arg_value(), cob_accept_environment(), cob_alloc_field(), cob_allocate(), cob_call_field(), cob_check_odo(), cob_check_ref_mod(), cob_check_subscript(), cob_decimal_div(), cob_decimal_do_round(), cob_decimal_get_binary(), cob_decimal_get_display(), cob_decimal_get_field(), cob_decimal_get_ieee128dec(), cob_decimal_get_ieee64dec(), cob_decimal_get_packed(), cob_decimal_pow(), cob_display_arg_number(), cob_display_env_value(), cob_free_alloc(), cob_get_environment(), cob_inspect_converting(), cob_inspect_init(), cob_intr_acos(), cob_intr_annuity(), cob_intr_asin(), cob_intr_atan(), cob_intr_binop(), cob_intr_combined_datetime(), cob_intr_cos(), cob_intr_currency_symbol(), cob_intr_date_of_integer(), cob_intr_date_to_yyyymmdd(), cob_intr_day_of_integer(), cob_intr_day_to_yyyyddd(), cob_intr_exp(), cob_intr_exp10(), cob_intr_factorial(), cob_intr_formatted_date(), cob_intr_formatted_datetime(), cob_intr_formatted_time(), cob_intr_highest_algebraic(), cob_intr_integer_of_date(), cob_intr_integer_of_day(), cob_intr_lcl_time_from_secs(), cob_intr_locale_compare(), cob_intr_locale_date(), cob_intr_locale_time(), cob_intr_log(), cob_intr_log10(), cob_intr_lowest_algebraic(), cob_intr_mon_decimal_point(), cob_intr_mon_thousands_sep(), cob_intr_num_decimal_point(), cob_intr_num_thousands_sep(), cob_intr_numval(), cob_intr_numval_c(), cob_intr_numval_f(), cob_intr_seconds_from_formatted_time(), cob_intr_sin(), cob_intr_sqrt(), cob_intr_standard_deviation(), cob_intr_tan(), cob_intr_year_to_yyyy(), cob_mod_or_rem(), cob_resolve_cobol(), cob_resolve_internal(), cob_set_locale(), cob_string_append(), cob_string_init(), cob_unstring_finish(), cob_unstring_init(), inspect_common(), save_status(), and set_resolve_error().

1092 {
1093  cobglobptr->cob_exception_code = cob_exception_tab_code[id];
1094  if (cobglobptr->cob_exception_code) {
1095  cobglobptr->cob_got_exception = 1;
1096  cobglobptr->cob_orig_statement = cob_source_statement;
1097  cobglobptr->cob_orig_line = cob_source_line;
1098  cobglobptr->cob_orig_program_id = cob_current_program_id;
1099  cobglobptr->cob_orig_section = cob_current_section;
1100  cobglobptr->cob_orig_paragraph = cob_current_paragraph;
1101  }
1102 }
COB_HIDDEN char* cob_strdup ( const char *  )

References cob_malloc().

Referenced by cache_dynload(), cache_preload(), cob_chk_call_path(), cob_chk_file_env(), cob_chk_file_mapping(), cob_fileio_getenv(), cob_getenv(), cob_gettmpdir(), cob_init(), cob_init_call(), cob_putenv(), cob_set_locale(), cob_strcat(), indexed_open(), and insert().

1159 {
1160  char *mptr;
1161  size_t len;
1162 
1163  len = strlen (p);
1164  mptr = (char *) cob_malloc (len + 1U);
1165  memcpy (mptr, p, len);
1166  return mptr;
1167 }