void
cob_unstring_init (cob_field *src, cob_field *ptr, const size_t num_dlm)
{
unstring_src_copy = *src;
unstring_src = &unstring_src_copy;
unstring_ptr = NULL;
if (ptr) {
unstring_ptr_copy = *ptr;
unstring_ptr = &unstring_ptr_copy;
}
unstring_offset = 0;
unstring_count = 0;
unstring_ndlms = 0;
cob_set_exception (0);
if (num_dlm > dlm_list_size) {
free (dlm_list);
dlm_list = cob_malloc (num_dlm * sizeof(struct dlm_struct));
dlm_list_size = num_dlm;
}
if (unstring_ptr) {
unstring_offset = cob_get_int (unstring_ptr) - 1;
if (unstring_offset < 0 || unstring_offset >= (int)unstring_src->size) {
cob_set_exception (COB_EC_OVERFLOW_UNSTRING);
}
}
}
void
cob_free_alloc (unsigned char **ptr1, unsigned char *ptr2)
{
struct cob_alloc_cache *cache_ptr;
cob_exception_code = 0;
if (ptr1 && *ptr1) {
for (cache_ptr = cob_alloc_base; cache_ptr; cache_ptr = cache_ptr->next) {
if (*(void **)ptr1 == cache_ptr->cob_pointer) {
cache_ptr->cob_pointer = NULL;
free (*ptr1);
*ptr1 = NULL;
return;
}
}
cob_set_exception (COB_EC_STORAGE_NOT_ALLOC);
return;
}
if (ptr2 && *(void **)ptr2) {
for (cache_ptr = cob_alloc_base; cache_ptr; cache_ptr = cache_ptr->next) {
if (*(void **)ptr2 == cache_ptr->cob_pointer) {
cache_ptr->cob_pointer = NULL;
free (*(void **)ptr2);
*(void **)ptr2 = NULL;
return;
}
}
cob_set_exception (COB_EC_STORAGE_NOT_ALLOC);
return;
}
}
void
cob_display_env_value (cob_field *f)
{
char *p;
char *env2;
size_t len;
if (!cob_local_env) {
cob_set_exception (COB_EC_IMP_DISPLAY);
return;
}
if (!*cob_local_env) {
cob_set_exception (COB_EC_IMP_DISPLAY);
return;
}
env2 = cob_malloc (f->size + 1);
cob_field_to_string (f, env2);
len = strlen (cob_local_env) + strlen (env2) + 3;
p = cob_malloc (len);
sprintf (p, "%s=%s", cob_local_env, env2);
if (putenv (p) != 0) {
cob_set_exception (COB_EC_IMP_DISPLAY);
}
free (env2);
}
void
cob_string_init (cob_field *dst, cob_field *ptr)
{
string_dst_copy = *dst;
string_dst = &string_dst_copy;
string_ptr = NULL;
if (ptr) {
string_ptr_copy = *ptr;
string_ptr = &string_ptr_copy;
}
string_offset = 0;
cob_exception_code = 0;
if (string_ptr) {
string_offset = cob_get_int (string_ptr) - 1;
if (string_offset < 0 || string_offset >= (int)string_dst->size) {
cob_set_exception (COB_EC_OVERFLOW_STRING);
}
}
#ifdef I18N_UTF8
/* I18N_UTF8: No offset arrangement needed also in NATIONAL. */
#else /*!I18N_UTF8*/
if (COB_FIELD_TYPE (string_dst) == COB_TYPE_NATIONAL ||
COB_FIELD_TYPE (string_dst) == COB_TYPE_NATIONAL_EDITED) {
string_offset *= 2;
}
#endif /*I18N_UTF8*/
}
void
cob_inspect_init (cob_field *var, const cob_u32_t replacing)
{
size_t i;
size_t digcount;
if (unlikely(COB_FIELD_IS_NUMDISP (var))) {
inspect_var_copy = *var;
inspect_var = &inspect_var_copy;
inspect_sign = COB_GET_SIGN (var);
} else {
inspect_var = NULL;
}
inspect_size = COB_FIELD_SIZE (var);
inspect_data = COB_FIELD_DATA (var);
inspect_replacing = replacing;
inspect_start = NULL;
inspect_end = NULL;
digcount = inspect_size * sizeof (int);
if (digcount > inspect_mark_size) {
if (inspect_mark) {
free (inspect_mark);
}
inspect_mark = cob_fast_malloc (digcount);
inspect_mark_size = digcount;
}
for (i = 0; i < inspect_size; ++i) {
inspect_mark[i] = -1;
}
cob_set_exception (0);
}
void
cob_inspect_converting (const cob_field *f1, const cob_field *f2)
{
size_t i;
size_t j;
size_t len;
if (unlikely(!f1)) {
f1 = &str_cob_low;
}
if (unlikely(!f2)) {
f2 = &str_cob_low;
}
if (f1->size != f2->size) {
if (COB_FIELD_TYPE (f2) == COB_TYPE_ALPHANUMERIC_ALL) {
alloc_figurative (f2, f1);
f2 = &alpha_fld;
} else {
cob_set_exception (COB_EC_RANGE_INSPECT_SIZE);
return;
}
}
len = (size_t)(inspect_end - inspect_start);
for (j = 0; j < f1->size; ++j) {
for (i = 0; i < len; ++i) {
if (inspect_mark[i] == -1 &&
inspect_start[i] == f1->data[j]) {
inspect_start[i] = f2->data[j];
inspect_mark[i] = 1;
}
}
}
}
void
cob_string_append (cob_field *src)
{
size_t src_size;
int i;
int size;
if (cob_exception_code) {
return;
}
src_size = src->size;
if (string_dlm) {
size = (int)(src_size - string_dlm->size + 1);
for (i = 0; i < size; i++) {
if (memcmp (src->data + i, string_dlm->data, string_dlm->size) == 0) {
src_size = i;
break;
}
}
}
if (src_size <= string_dst->size - string_offset) {
memcpy (string_dst->data + string_offset, src->data, src_size);
string_offset += (int) src_size;
} else {
size = (int)(string_dst->size - string_offset);
memcpy (string_dst->data + string_offset, src->data, (size_t)size);
string_offset += size;
cob_set_exception (COB_EC_OVERFLOW_STRING);
}
}
void
cob_allocate (unsigned char **dataptr, cob_field *retptr, cob_field *sizefld)
{
void *mptr = NULL;
struct cob_alloc_cache *cache_ptr;
int fsize;
cob_exception_code = 0;
fsize = cob_get_int (sizefld);
if (fsize > 0) {
cache_ptr = cob_malloc (sizeof (struct cob_alloc_cache));
mptr = malloc ((size_t)fsize);
if (!mptr) {
cob_set_exception (COB_EC_STORAGE_NOT_AVAIL);
free (cache_ptr);
} else {
memset (mptr, 0, (size_t)fsize);
cache_ptr->cob_pointer = mptr;
cache_ptr->size = (size_t)fsize;
cache_ptr->next = cob_alloc_base;
cob_alloc_base = cache_ptr;
}
}
if (dataptr) {
*dataptr = (unsigned char *)mptr;
}
if (retptr) {
*(void **)(retptr->data) = mptr;
}
}
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_accept_arg_value (cob_field *f)
{
if (current_arg >= cob_argc) {
cob_set_exception (COB_EC_IMP_ACCEPT);
return;
}
cob_memcpy (f, (ucharptr)cob_argv[current_arg], (int) strlen (cob_argv[current_arg]));
current_arg++;
}
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);
}
}
void
cob_unstring_finish (void)
{
if (unstring_offset < (int)unstring_src->size) {
cob_set_exception (COB_EC_OVERFLOW_UNSTRING);
}
if (unstring_ptr) {
cob_set_int (unstring_ptr, unstring_offset + 1);
}
}
void
cob_display_environment (cob_field *f)
{
if (!cob_local_env) {
cob_local_env = cob_malloc (COB_SMALL_BUFF);
}
if (f->size > COB_SMALL_MAX) {
cob_set_exception (COB_EC_IMP_DISPLAY);
return;
}
cob_field_to_string (f, cob_local_env);
}
void
cob_string_init (cob_field *dst, cob_field *ptr)
{
string_dst_copy = *dst;
string_dst = &string_dst_copy;
string_ptr = NULL;
if (ptr) {
string_ptr_copy = *ptr;
string_ptr = &string_ptr_copy;
}
string_offset = 0;
cob_set_exception (0);
if (string_ptr) {
string_offset = cob_get_int (string_ptr) - 1;
if (string_offset < 0 ||
string_offset >= (int)string_dst->size) {
cob_set_exception (COB_EC_OVERFLOW_STRING);
}
}
}
void
cob_get_environment (cob_field *envname, cob_field *envval)
{
const char *p;
char *buff;
if (envname->size < COB_SMALL_BUFF) {
buff = cob_malloc (COB_SMALL_BUFF);
cob_field_to_string (envname, buff);
p = getenv (buff);
if (!p) {
cob_set_exception (COB_EC_IMP_ACCEPT);
p = " ";
}
cob_memcpy (envval, (ucharptr)p, (int) strlen (p));
free (buff);
} else {
cob_set_exception (COB_EC_IMP_ACCEPT);
p = " ";
cob_memcpy (envval, (ucharptr)p, (int) strlen (p));
}
}
void
cob_accept_environment (cob_field *f)
{
const char *p = NULL;
if (cob_local_env) {
p = getenv (cob_local_env);
}
if (!p) {
cob_set_exception (COB_EC_IMP_ACCEPT);
p = " ";
}
cob_memcpy (f, (ucharptr)p, (int) strlen (p));
}
void
cob_unstring_init (cob_field *src, cob_field *ptr, const size_t num_dlm)
{
static size_t udlmcount = 0;
unstring_src_copy = *src;
unstring_src = &unstring_src_copy;
unstring_ptr = NULL;
if (ptr) {
unstring_ptr_copy = *ptr;
unstring_ptr = &unstring_ptr_copy;
}
unstring_offset = 0;
unstring_count = 0;
unstring_ndlms = 0;
cob_exception_code = 0;
if (!dlm_list) {
if (num_dlm <= DLM_DEFAULT_NUM) {
dlm_list = cob_malloc (DLM_DEFAULT_NUM * sizeof(struct dlm_struct));
udlmcount = DLM_DEFAULT_NUM;
} else {
dlm_list = cob_malloc (num_dlm * sizeof(struct dlm_struct));
udlmcount = num_dlm;
}
} else {
if (num_dlm > udlmcount) {
free (dlm_list);
dlm_list = cob_malloc (num_dlm * sizeof(struct dlm_struct));
udlmcount = num_dlm;
}
}
if (unstring_ptr) {
unstring_offset = cob_get_int (unstring_ptr) - 1;
if (unstring_offset < 0 || unstring_offset >= (int)unstring_src->size) {
cob_set_exception (COB_EC_OVERFLOW_UNSTRING);
}
}
#ifdef I18N_UTF8
/* I18N_UTF8: No offset arrangement needed also in NATIONAL. */
#else /*!I18N_UTF8*/
if (COB_FIELD_TYPE (unstring_src) == COB_TYPE_NATIONAL ||
COB_FIELD_TYPE (unstring_src) == COB_TYPE_NATIONAL_EDITED) {
unstring_offset *= 2;
}
#endif /*I18N_UTF8*/
}
void
cob_display_arg_number (cob_field *f)
{
int n;
cob_field_attr attr;
cob_field temp;
temp.size = 4;
temp.data = (unsigned char *)&n;
temp.attr = &attr;
COB_ATTR_INIT (COB_TYPE_NUMERIC_BINARY, 9, 0, 0, NULL);
cob_move (f, &temp);
if (n < 0 || n >= cob_argc) {
cob_set_exception (COB_EC_IMP_DISPLAY);
return;
}
current_arg = n;
}
static void COB_NOINLINE
cob_check_pos_status (int fret)
{
cob_field *f;
int sline;
int scolumn;
char datbuf[8];
if (fret) {
cob_set_exception (COB_EC_IMP_ACCEPT);
}
if (cob_current_module->crt_status) {
if (COB_FIELD_IS_NUMERIC (cob_current_module->crt_status)) {
cob_set_int (cob_current_module->crt_status, fret);
} else {
sprintf(datbuf, "%4.4d", fret);
memcpy (cob_current_module->crt_status->data, datbuf, 4);
}
}
if (cob_current_module->cursor_pos) {
getyx (stdscr, sline, scolumn);
f = cob_current_module->cursor_pos;
if (COB_FIELD_IS_NUMERIC (f) &&
COB_FIELD_TYPE (f) != COB_TYPE_NUMERIC_DISPLAY) {
sline *= 1000;
sline += scolumn;
cob_set_int (f, sline);
} else {
if (f->size < 6) {
sline *= 100;
sline += scolumn;
sprintf(datbuf, "%4.4d", sline);
memcpy (f->data, datbuf, 4);
} else {
sline *= 1000;
sline += scolumn;
sprintf(datbuf, "%6.6d", sline);
memcpy (f->data, datbuf, 6);
}
}
}
}
void
cob_unstring_finish (void)
{
if (unstring_offset < (int)unstring_src->size) {
cob_set_exception (COB_EC_OVERFLOW_UNSTRING);
}
#ifdef I18N_UTF8
/* I18N_UTF8: No offset arrangement needed also in NATIONAL. */
#else /*!I18N_UTF8*/
if (COB_FIELD_TYPE (unstring_src) == COB_TYPE_NATIONAL ||
COB_FIELD_TYPE (unstring_src) == COB_TYPE_NATIONAL_EDITED) {
unstring_offset /= 2;
}
#endif /*I18N_UTF8*/
if (unstring_ptr) {
cob_set_int (unstring_ptr, unstring_offset + 1);
}
}
static void
inspect_common (cob_field *f1, cob_field *f2, const int type)
{
int *mark;
size_t n = 0;
size_t j;
int i;
int len;
if (unlikely(!f1)) {
f1 = &str_cob_low;
}
if (unlikely(!f2)) {
f2 = &str_cob_low;
}
if (inspect_replacing && f1->size != f2->size) {
if (COB_FIELD_TYPE (f1) == COB_TYPE_ALPHANUMERIC_ALL) {
alloc_figurative (f1, f2);
f1 = &alpha_fld;
} else {
cob_set_exception (COB_EC_RANGE_INSPECT_SIZE);
return;
}
}
mark = &inspect_mark[inspect_start - inspect_data];
len = (int)(inspect_end - inspect_start);
if (type == INSPECT_TRAILING) {
for (i = len - (int)f2->size; i >= 0; --i) {
/* Find matching substring */
if (memcmp (inspect_start + i, f2->data, f2->size) == 0) {
/* Check if it is already marked */
for (j = 0; j < f2->size; ++j) {
if (mark[i + j] != -1) {
break;
}
}
/* If not, mark and count it */
if (j == f2->size) {
for (j = 0; j < f2->size; ++j) {
mark[i + j] = inspect_replacing ? f1->data[j] : 1;
}
i -= f2->size - 1;
n++;
}
} else {
break;
}
}
} else {
for (i = 0; i < (int)(len - f2->size + 1); ++i) {
/* Find matching substring */
if (memcmp (inspect_start + i, f2->data, f2->size) == 0) {
/* Check if it is already marked */
for (j = 0; j < f2->size; ++j) {
if (mark[i + j] != -1) {
break;
}
}
/* If not, mark and count it */
if (j == f2->size) {
for (j = 0; j < f2->size; ++j) {
mark[i + j] = inspect_replacing ? f1->data[j] : 1;
}
i += f2->size - 1;
n++;
if (type == INSPECT_FIRST) {
break;
}
}
} else if (type == INSPECT_LEADING) {
break;
}
}
}
if (n > 0 && !inspect_replacing) {
cob_add_int (f1, (int) n, 0);
}
}