void
cob_screen_line_col (cob_field *f, const int l_or_c)
{
if (!cob_screen_initialized) {
cob_screen_init ();
}
if (!l_or_c) {
cob_set_int (f, (int)LINES);
} else {
cob_set_int (f, (int)COLS);
}
}
void
cob_string_finish (void)
{
if (string_ptr) {
cob_set_int (string_ptr, string_offset + 1);
}
}
int
cob_return_args (unsigned char *data)
{
COB_CHK_PARMS (C$NARG, 1);
if (cob_current_module->cob_procedure_parameters[0]) {
cob_set_int (cob_current_module->cob_procedure_parameters[0], cob_save_call_params);
}
return 0;
}
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);
}
if (unstring_ptr) {
cob_set_int (unstring_ptr, unstring_offset + 1);
}
}
void
cob_string_finish (void)
{
#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*/
if (string_ptr) {
cob_set_int (string_ptr, string_offset + 1);
}
}
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);
}
}
void
cob_unstring_into (cob_field *dst, cob_field *dlm, cob_field *cnt)
{
unsigned char *p;
unsigned char *dp;
unsigned char *s;
unsigned char *dlm_data;
unsigned char *start;
size_t dlm_size = 0;
int i;
int srsize;
int dlsize;
int match_size = 0;
int brkpt = 0;
if (cob_get_exception_code ()) {
return;
}
if (unstring_offset >= (int)unstring_src->size) {
return;
}
start = unstring_src->data + unstring_offset;
dlm_data = NULL;
if (unstring_ndlms == 0) {
match_size = cob_min_int ((int)COB_FIELD_SIZE (dst),
(int)unstring_src->size - unstring_offset);
cob_str_memcpy (dst, start, match_size);
unstring_offset += match_size;
} else {
srsize = (int) unstring_src->size;
s = unstring_src->data + srsize;
for (p = start; p < s; ++p) {
for (i = 0; i < unstring_ndlms; ++i) {
dlsize = (int) dlm_list[i].uns_dlm.size;
dp = dlm_list[i].uns_dlm.data;
if (p + dlsize > s) {
continue;
}
if (!memcmp (p, dp, (size_t)dlsize)) {
match_size = (int)(p - start);
cob_str_memcpy (dst, start, match_size);
unstring_offset += match_size + dlsize;
dlm_data = dp;
dlm_size = dlsize;
if (dlm_list[i].uns_all) {
for (p++ ; p < s; ++p) {
if (p + dlsize > s) {
break;
}
if (memcmp (p, dp, (size_t)dlsize)) {
break;
}
unstring_offset += dlsize;
}
}
brkpt = 1;
break;
}
}
if (brkpt) {
break;
}
}
if (!brkpt) {
/* No match */
match_size = (int)(unstring_src->size - unstring_offset);
cob_str_memcpy (dst, start, match_size);
unstring_offset = (int) unstring_src->size;
dlm_data = NULL;
}
}
unstring_count++;
if (dlm) {
if (dlm_data) {
cob_str_memcpy (dlm, dlm_data, (int) dlm_size);
} else if (COB_FIELD_IS_NUMERIC (dlm)) {
cob_set_int (dlm, 0);
} else {
memset (dlm->data, ' ', dlm->size);
}
}
if (cnt) {
cob_set_int (cnt, match_size);
}
}
void
cob_unstring_into (cob_field *dst, cob_field *dlm, cob_field *cnt)
{
unsigned char *p;
unsigned char *dp;
unsigned char *s;
unsigned char *dlm_data;
unsigned char *start;
size_t dlm_size = 0;
int i;
int srsize;
int dlsize;
int match_size = 0;
int brkpt = 0;
if (cob_exception_code) {
return;
}
if (unstring_offset >= (int)unstring_src->size) {
return;
}
start = unstring_src->data + unstring_offset;
dlm_data = NULL;
if (unstring_ndlms == 0) {
match_size = cob_min_int ((int)COB_FIELD_SIZE (dst),
(int)unstring_src->size - unstring_offset);
cob_memcpy (dst, start, match_size);
unstring_offset += match_size;
} else {
srsize = (int) unstring_src->size;
s = unstring_src->data + srsize;
for (p = start; p < s; p++) {
for (i = 0; i < unstring_ndlms; i++) {
dlsize = (int) dlm_list[i].uns_dlm.size;
dp = dlm_list[i].uns_dlm.data;
if (p + dlsize > s) {
continue;
}
if (!memcmp (p, dp, (size_t)dlsize)) {
match_size = (int)(p - start);
cob_memcpy (dst, start, match_size);
unstring_offset += match_size + dlsize;
dlm_data = dp;
dlm_size = dlsize;
if (dlm_list[i].uns_all) {
for (p += dlsize; p < s; p += dlsize) {
if (p + dlsize > s) {
break;
}
if (memcmp (p, dp, (size_t)dlsize)) {
break;
}
unstring_offset += dlsize;
}
}
brkpt = 1;
break;
}
}
#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) {
p++;
}
#endif /*I18N_UTF8*/
if (brkpt) {
break;
}
}
if (!brkpt) {
/* no match */
match_size = (int)(unstring_src->size - unstring_offset);
cob_memcpy (dst, start, match_size);
unstring_offset = (int) unstring_src->size;
dlm_data = NULL;
}
}
unstring_count++;
if (dlm) {
if (dlm_data) {
cob_memcpy (dlm, dlm_data, (int) dlm_size);
} else if (COB_FIELD_IS_NUMERIC (dlm)) {
cob_move (&cob_zero, dlm);
} else {
cob_move (&cob_space, dlm);
}
}
#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) {
match_size /= 2;
}
#endif /*I18N_UTF8*/
if (cnt) {
cob_set_int (cnt, match_size);
}
}
