void cob_check_version (const char *prog, const char *packver, const int patchlev) { if (strcmp (packver, PACKAGE_VERSION) || patchlev > PATCH_LEVEL) { cob_runtime_error ("Error - Version mismatch"); cob_runtime_error ("%s has version/patch level %s/%d", prog, packver, patchlev); cob_runtime_error ("Library has version/patch level %s/%d", PACKAGE_VERSION, PATCH_LEVEL); cob_stop_run (1); } }
unsigned char * cob_external_addr (const char *exname, const int exlength) { static struct cob_external *basext = NULL; struct cob_external *eptr; for (eptr = basext; eptr; eptr = eptr->next) { if (!strcmp (exname, eptr->ename)) { if (exlength > eptr->esize) { cob_runtime_error ("EXTERNAL item '%s' has size > %d", exname, exlength); cob_stop_run (1); } cob_initial_external = 0; return (ucharptr)eptr->ext_alloc; } } eptr = cob_malloc (sizeof (struct cob_external)); eptr->next = basext; eptr->esize = exlength; eptr->ename = cob_malloc (strlen (exname) + 1); strcpy (eptr->ename, exname); eptr->ext_alloc = cob_malloc ((size_t)exlength); basext = eptr; cob_initial_external = 1; return (ucharptr)eptr->ext_alloc; }
void * cobcommandline (int flags, int *pargc, char ***pargv, char ***penvp, char **pname) { char **spenvp; char *spname; int sflags; if (!cob_initialized) { cob_runtime_error ("'cobcommandline' - Runtime has not been initialized"); cob_stop_run (1); } if (pargc && pargv) { cob_argc = *pargc; cob_argv = *pargv; } /* Shut up the compiler */ sflags = flags; if (penvp) { spenvp = *penvp; } if (pname) { spname = *pname; } /* What are we supposed to return here? */ return NULL; }
void cob_check_based (const unsigned char *x, const char *name) { if (!x) { cob_runtime_error ("BASED/LINKAGE item '%s' has NULL address", name); cob_stop_run (1); } }
void cob_check_ref_mod (const int offset, const int length, const int size, const char *name) { /* check the offset */ if (offset < 1 || offset > size) { cob_set_exception (COB_EC_BOUND_REF_MOD); cob_runtime_error ("Offset of '%s' out of bounds: %d", name, offset); cob_stop_run (1); } /* check the length */ if (length < 1 || offset + length - 1 > size) { cob_set_exception (COB_EC_BOUND_REF_MOD); cob_runtime_error ("Length of '%s' out of bounds: %d", name, length); cob_stop_run (1); } }
void cob_check_subscript (const int i, const int min, const int max, const char *name) { /* check the subscript */ if (i < min || max < i) { cob_set_exception (COB_EC_BOUND_SUBSCRIPT); cob_runtime_error ("Subscript of '%s' out of bounds: %d", name, i); cob_stop_run (1); } }
void cob_check_odo (const int i, const int min, const int max, const char *name) { /* check the OCCURS DEPENDING ON item */ if (i < min || max < i) { cob_set_exception (COB_EC_BOUND_ODO); cob_runtime_error ("OCCURS DEPENDING ON '%s' out of bounds: %d", name, i); cob_stop_run (1); } }
static void COB_NOINLINE cob_screen_init (void) { char *s; if (!cob_screen_initialized) { s = getenv ("COB_SCREEN_EXCEPTIONS"); if (s) { if (*s == 'Y' || *s == 'y') { cob_extended_status = 1; s = getenv ("COB_SCREEN_ESC"); if (s) { if (*s == 'Y' || *s == 'y') { cob_use_esc = 1; } } } } /* Get default insert mode, if 'Y' set to on */ s = getenv ("COB_INSERT_MODE"); if (s) { if (*s == 'Y' || *s == 'y') { insert_mode = 1; } } fflush (stdout); fflush (stderr); if (!initscr ()) { cob_runtime_error ("Failed to initialize curses"); cob_stop_run (1); } cbreak (); keypad (stdscr, 1); nl (); noecho (); if (has_colors ()) { start_color (); pair_content ((short)0, &fore_color, &back_color); if (COLOR_PAIRS) { #ifdef HAVE_LIBPDCURSES size_t i; /* pdcurses sets ALL pairs to default fg/bg */ /* IMHO a bug. */ for (i = 1; i < (size_t)COLOR_PAIRS; ++i) { init_pair ((short)i, 0, 0); } #endif cob_has_color = 1; } } attrset (A_NORMAL); getmaxyx (stdscr, cob_max_y, cob_max_x); cob_screen_initialized = 1; } }
void * cob_malloc (const size_t size) { void *mptr; mptr = calloc (1, size); if (unlikely(!mptr)) { cob_runtime_error ("Cannot acquire %d bytes of memory - Aborting", size); cob_stop_run (1); } return mptr; }
void cob_fatal_error (const unsigned int fatal_error) { switch (fatal_error) { case COB_FERROR_INITIALIZED: cob_runtime_error ("cob_init() has not been called"); break; case COB_FERROR_CODEGEN: cob_runtime_error ("Codegen error - Please report this"); break; case COB_FERROR_CHAINING: cob_runtime_error ("ERROR - Recursive call of chained program"); break; case COB_FERROR_STACK: cob_runtime_error ("Stack overflow, possible PERFORM depth exceeded"); break; default: cob_runtime_error ("Unknown failure : %d", (int)fatal_error); break; } cob_stop_run (1); }
int SYSTEM (const unsigned char *cmd) { char *buff; int i; COB_CHK_PARMS (SYSTEM, 1); if (cob_current_module->cob_procedure_parameters[0]) { i = (int)cob_current_module->cob_procedure_parameters[0]->size; if (i > COB_MEDIUM_MAX) { cob_runtime_error ("Parameter to SYSTEM call is larger than 8192 characters"); cob_stop_run (1); } i--; for (; i >= 0; i--) { if (cmd[i] != ' ' && cmd[i] != 0) { break; } } if (i >= 0) { buff = cob_malloc ((size_t)(i + 2)); memcpy (buff, cmd, (size_t)(i + 1)); if (cob_screen_initialized) { cob_screen_set_mode (0); } i = system (buff); free (buff); if (cob_screen_initialized) { cob_screen_set_mode (1); } return i; } } return 1; }
void cob_check_numeric (cob_field *f, const char *name) { unsigned char *data; char *p; char *buff; size_t i; if (!cob_is_numeric (f)) { buff = cob_malloc (COB_SMALL_BUFF); p = buff; data = f->data; for (i = 0; i < f->size; ++i) { if (isprint (data[i])) { *p++ = data[i]; } else { p += sprintf (p, "\\%03o", data[i]); } } *p = '\0'; cob_runtime_error ("'%s' not numeric: '%s'", name, buff); cob_stop_run (1); } }
void cob_inspect_converting (const cob_field *f1, const cob_field *f2) { size_t i; size_t j; size_t len; #ifdef I18N_UTF8 const int mark_wait[6] = {-1, -1, -1, -1, -1, -1}; const int mark_done[6] = { 1, 1, 1, 1, 1, 1}; size_t nc1; size_t nc2; size_t nc3; const cob_field *fig_const = NULL; const cob_field *fig_constw = NULL; unsigned char *pdata; char buf1[8]; /* for error message */ char buf2[8]; /* for error message */ #endif /*!I18N_UTF8*/ len = (size_t)(inspect_end - inspect_start); #ifdef I18N_UTF8 if (f2 == &cob_quote) { fig_const = &cob_quote; fig_constw = &cob_zen_quote; } else if (f2 == &cob_space) { fig_const = &cob_space; fig_constw = &cob_zen_space; } else if (f2 == &cob_zero) { fig_const = &cob_zero; fig_constw = &cob_zen_zero; } for (j = 0; j < f1->size; j += nc1) { if (!(nc1 = COB_U8BYTE_1 (f1->data[j]))) { cob_runtime_error ( "Unexpected char X(%02X) in INSPECT CONVERTING (value before)", f1->data[j]); cob_stop_run (1); } else if (fig_const) { /* iteratively map to figurative */ } else if (!(nc2 = COB_U8BYTE_1 (f2->data[j]))) { cob_runtime_error ( "Unexpected char X(%02X) in INSPECT CONVERTING (value after)", f2->data[j]); cob_stop_run (1); } else if (nc1 != nc2) { memset (buf1, 0, sizeof (buf1)); memset (buf2, 0, sizeof (buf2)); memcpy (buf1, &(f1->data[j]), nc1); memcpy (buf2, &(f2->data[j]), nc2); cob_runtime_error ( "'%s' char width (%d) to '%s' char width (%d) mismatch", buf1, nc1, buf2, nc2); cob_stop_run (1); } for (i = 0; i < len; i += nc3) { if (!(nc3 = COB_U8BYTE_1 (inspect_start[i]))) { cob_runtime_error ( "Unexpected char X(%02X) in INSPECT field", inspect_start[i]); cob_stop_run (1); } if (nc1 == nc3 && !memcmp (&(inspect_mark[i]), mark_wait, nc1) && !memcmp (&(inspect_start[i]), &(f1->data[j]), nc1)) { if (!fig_const) { pdata = &(f2->data[j]); } else if (nc1 == 1) { pdata = fig_const->data; } else if (nc1 == COB_U8CSIZ) { pdata = fig_constw->data; } else { memset (buf1, 0, sizeof (buf1)); memcpy (buf1, &(f1->data[j]), nc1); cob_runtime_error ( "'%s' char width (%d) mismatch", buf1, nc1); cob_stop_run (1); } memcpy (&(inspect_start[i]), pdata, nc1); memcpy (&(inspect_mark[i]), mark_done, nc1); } } } #else /*!I18N_UTF8*/ if (COB_FIELD_TYPE (f1) == COB_TYPE_NATIONAL || COB_FIELD_TYPE (f1) == COB_TYPE_NATIONAL_EDITED) { if (f2 == &cob_quote) { f2 = &cob_zen_quote; } else if (f2 == &cob_space) { f2 = &cob_zen_space; } else if (f2 == &cob_zero) { f2 = &cob_zen_zero; } for (j = 0; j < f1->size; j += 2) { for (i = 0; i < len; i += 2) { if (inspect_mark[i] == -1 && inspect_mark[i+1] == -1 && memcmp (&inspect_start[i], &(f1->data[j]), 2) == 0) { if (f2 == &cob_zen_quote || f2 == &cob_zen_space || f2 == &cob_zen_zero) { inspect_start[i] = f2->data[0]; inspect_start[i+1] = f2->data[1]; } else { inspect_start[i] = f2->data[j]; inspect_start[i+1] = f2->data[j+1]; } inspect_mark[i] = 1; inspect_mark[i+1] = 1; } } } } else { for (j = 0; j < f1->size; j++) { for (i = 0; i < len; i++) { if (inspect_mark[i] == -1 && inspect_start[i] == f1->data[j]) { if (f2 == &cob_quote || f2 == &cob_space || f2 == &cob_zero) { inspect_start[i] = f2->data[0]; } else { inspect_start[i] = f2->data[j]; } inspect_mark[i] = 1; } } } } #endif /*I18N_UTF8*/ }