GnuCOBOL  2.0
A free COBOL compiler
termio.c
Go to the documentation of this file.
1 /*
2  Copyright (C) 2001-2012, 2014-2015 Free Software Foundation, Inc.
3  Written by Keisuke Nishida, Roger While, Simon Sobisch
4 
5  This file is part of GnuCOBOL.
6 
7  The GnuCOBOL runtime library is free software: you can redistribute it
8  and/or modify it under the terms of the GNU Lesser General Public License
9  as published by the Free Software Foundation, either version 3 of the
10  License, or (at your option) any later version.
11 
12  GnuCOBOL is distributed in the hope that it will be useful,
13  but WITHOUT ANY WARRANTY; without even the implied warranty of
14  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15  GNU Lesser General Public License for more details.
16 
17  You should have received a copy of the GNU Lesser General Public License
18  along with GnuCOBOL. If not, see <http://www.gnu.org/licenses/>.
19 */
20 
21 
22 #include "config.h"
23 
24 #include <stdio.h>
25 #include <stdlib.h>
26 #include <stddef.h>
27 #include <string.h>
28 #include <stdarg.h>
29 #include <errno.h>
30 #ifdef HAVE_UNISTD_H
31 #include <unistd.h>
32 #endif
33 #include <time.h>
34 
35 /* Force symbol exports */
36 #define COB_LIB_EXPIMP
37 
38 #include "libcob.h"
39 #include "coblocal.h"
40 
41 /* Local variables */
42 
45 
46 static const unsigned short bin_digits[] =
47  { 1, 3, 5, 8, 10, 13, 15, 17, 20 };
48 
50  {COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL};
51 
52 /* DISPLAY */
53 
54 static void
55 display_numeric (cob_field *f, FILE *fp)
56 {
57  int i;
58  unsigned short digits;
59  signed short scale;
60  int size;
61  cob_field_attr attr;
62  cob_field temp;
63 
64  digits = COB_FIELD_DIGITS (f);
65  scale = COB_FIELD_SCALE (f);
66  size = digits + (COB_FIELD_HAVE_SIGN (f) ? 1 : 0);
67  if (size >= COB_MEDIUM_MAX) {
68  fputs (_("(Not representable)"), fp);
69  return;
70  }
71  COB_ATTR_INIT (COB_TYPE_NUMERIC_DISPLAY, digits, scale, 0, NULL);
72  temp.size = size;
73  temp.data = COB_TERM_BUFF;
74  temp.attr = &attr;
75  if (COB_FIELD_HAVE_SIGN (f)) {
77  if (COB_FIELD_SIGN_LEADING (f) ||
80  }
81  }
82 
83  cob_move (f, &temp);
84  for (i = 0; i < size; ++i) {
85  putc (temp.data[i], fp);
86  }
87 }
88 
89 static void
91 {
92  unsigned char *p;
93  unsigned char *q;
94  int i;
95  unsigned short digits;
96  signed short scale;
97  int size;
98  cob_field_attr attr;
99  cob_field temp;
100  unsigned char pic[32];
101 
102  digits = COB_FIELD_DIGITS (f);
103  scale = COB_FIELD_SCALE (f);
104  size = (digits + (COB_FIELD_HAVE_SIGN (f) ? 1 : 0)
105  + (scale > 0 ? 1 : 0));
106  if (size > COB_MEDIUM_MAX) {
107  fputs (_("(Not representable)"), fp);
108  return;
109  }
110  q = COB_TERM_BUFF;
111  temp.size = size;
112  temp.data = q;
113  temp.attr = &attr;
114  COB_ATTR_INIT (COB_TYPE_NUMERIC_EDITED, digits, scale, 0,
115  (const char *)pic);
116  p = pic;
117 #if 0 /* RXWRXW - memset */
118  memset (pic, 0, sizeof (pic));
119  memset (q, 0, 256);
120 #endif
121  if (COB_FIELD_HAVE_SIGN (f)) {
122  *p++ = '+';
123  i = 1;
124  memcpy (p, (unsigned char *)&i, sizeof(int));
125  p += sizeof(int);
126  }
127  if (scale > 0) {
128  i = digits - scale;
129  if (i > 0 ) {
130  *p++ = '9';
131  memcpy (p, (unsigned char *)&i, sizeof(int));
132  p += sizeof(int);
133  }
134  *p++ = COB_MODULE_PTR->decimal_point;
135  i = 1;
136  memcpy (p, (unsigned char *)&i, sizeof(int));
137  p += sizeof(int);
138  *p++ = '9';
139  i = scale;
140  memcpy (p, (unsigned char *)&i, sizeof(int));
141  p += sizeof(int);
142  } else {
143  *p++ = '9';
144  i = digits;
145  memcpy (p, (unsigned char *)&i, sizeof(int));
146  p += sizeof(int);
147  }
148  *p = 0;
149 
150  cob_move (f, &temp);
151  for (i = 0; i < size; ++i) {
152  putc (q[i], fp);
153  }
154 }
155 
156 static void
157 display_alnum (cob_field *f, FILE *fp)
158 {
159  size_t i;
160 
161  for (i = 0; i < f->size; ++i) {
162  putc (f->data[i], fp);
163  }
164 }
165 
166 static void
167 display_common (cob_field *f, FILE *fp)
168 {
169  unsigned char *p;
170  union {
171  double f1doub;
172  float f1float;
173  } un;
174  int n;
175 #if 0 /* RXWRXW - Print bin */
176  cob_field temp;
177  cob_field_attr attr;
178 #endif
179 
180  if (f->size == 0) {
181  return;
182  }
183  switch (COB_FIELD_TYPE (f)) {
185  memcpy (&un.f1doub, f->data, sizeof (double));
186  fprintf (fp, "%-.16G", un.f1doub);
187  return;
189  memcpy (&un.f1float, f->data, sizeof (float));
190  fprintf (fp, "%-.8G", (double)un.f1float);
191  return;
194  cob_print_ieeedec (f, fp);
195  return;
196  default:
197  break;
198  }
199  if (COB_FIELD_IS_POINTER (f)) {
200  fprintf (fp, "0x");
201 #ifdef WORDS_BIGENDIAN
202  p = f->data;
203  for (n = 0; n < sizeof(void *); ++n, ++p) {
204 #else
205  p = f->data + sizeof(void *) - 1;
206  for (n = sizeof(void *) - 1; n >= 0; --n, --p) {
207 #endif
208  fprintf (fp, "%x%x", *p >> 4, *p & 0xF);
209  }
210  return;
211  } else if (COB_FIELD_REAL_BINARY(f) ||
213  !COB_MODULE_PTR->flag_pretty_display)) {
214  cob_print_realbin (f, fp, bin_digits[f->size]);
215  return;
216 #if 0 /* RXWRXW - print bin */
217  } else if (COB_FIELD_TYPE(f) == COB_TYPE_NUMERIC_BINARY &&
218  !COB_MODULE_PTR->flag_pretty_display) {
219  attr = *f->attr;
220  temp = *f;
221  attr.digits = bin_digits[f->size];
222  temp.attr = &attr;
223  display_numeric (&temp, fp);
224  return;
225 #endif
226  } else if (COB_FIELD_IS_NUMERIC (f)) {
227  if (COB_MODULE_PTR->flag_pretty_display) {
228  pretty_display_numeric (f, fp);
229  } else {
230  display_numeric (f, fp);
231  }
232  return;
233  }
234  display_alnum (f, fp);
235 }
236 
237 void
238 cob_display (const int to_stderr, const int newline, const int varcnt, ...)
239 {
240  FILE *fp;
241  cob_field *f;
242  int i;
243  int nlattr;
244  cob_u32_t disp_redirect;
245  va_list args;
246 
247  disp_redirect = 0;
248  if (to_stderr) {
249  fp = stderr;
250  } else {
251  fp = stdout;
252  if (cobglobptr->cob_screen_initialized) {
253  if (!COB_DISP_TO_STDERR) {
254  disp_redirect = 1;
255  } else {
256  fp = stderr;
257  }
258  }
259  }
260 
261  nlattr = newline ? COB_SCREEN_EMULATE_NL : 0;
262  va_start (args, varcnt);
263  for (i = 0; i < varcnt; ++i) {
264  f = va_arg (args, cob_field *);
265  if (unlikely(disp_redirect)) {
267  NULL, NULL, nlattr);
268  } else {
269  display_common (f, fp);
270  }
271  }
272  va_end (args);
273 
274  if (newline && !disp_redirect) {
275  putc ('\n', fp);
276  fflush (fp);
277  }
278 }
279 
280 /* ACCEPT */
281 
282 void
284 {
285  unsigned char *p;
286  size_t size;
287  int ipchr;
288  cob_field temp;
289 
290  if (cobglobptr->cob_screen_initialized) {
292  NULL, NULL, NULL, NULL,
294  return;
295  }
296  if (COB_MODULE_PTR->crt_status) {
297  if (COB_FIELD_IS_NUMERIC (COB_MODULE_PTR->crt_status)) {
298  cob_set_int (COB_MODULE_PTR->crt_status, 0);
299  } else {
300  memset (COB_MODULE_PTR->crt_status->data, '0', (size_t)4);
301  }
302  }
303  /* extension: ACCEPT OMITTED */
304  if (unlikely(!f)) {
305  for (; ; ) {
306  ipchr = getchar ();
307  if (ipchr == '\n' || ipchr == EOF) {
308  break;
309  }
310  }
311  return;
312  }
313  p = COB_TERM_BUFF;
314  temp.data = p;
315  temp.attr = &const_alpha_attr;
316  size = 0;
317  /* Read a line */
318  for (; size < COB_MEDIUM_MAX; ) {
319  ipchr = getchar ();
320  if (unlikely(ipchr == EOF)) {
322  if (!size) {
323  size = 1;
324  p[0] = ' ';
325  p[1] = 0;
326  }
327  break;
328  } else if (ipchr == '\n') {
329  break;
330  }
331  p[size++] = (char) ipchr;
332  }
333  temp.size = size;
335  if (temp.size > f->size) {
336  temp.size = f->size;
337  }
338  }
339  cob_move (&temp, f);
340 }
341 
342 void
344 {
345  cobglobptr = lptr;
346  cobsetptr = sptr;
347 }
#define COB_FIELD_SCALE(f)
Definition: common.h:664
static const unsigned short bin_digits[]
Definition: termio.c:46
#define cob_u32_t
Definition: common.h:31
static const cob_field_attr const_alpha_attr
Definition: termio.c:49
#define COB_TERM_BUFF
Definition: coblocal.h:186
#define COB_FIELD_IS_NUMERIC(f)
Definition: common.h:674
void cob_move(cob_field *, cob_field *)
Definition: move.c:1170
#define COB_TYPE_ALPHANUMERIC
Definition: common.h:621
#define COB_FIELD_TYPE(f)
Definition: common.h:662
void cob_print_realbin(const cob_field *, FILE *, const int)
Definition: numeric.c:1676
void cob_display(const int to_stderr, const int newline, const int varcnt,...)
Definition: termio.c:238
#define COB_ATTR_INIT(u, v, x, y, z)
Definition: coblocal.h:150
unsigned short flags
Definition: common.h:944
unsigned char * data
Definition: common.h:952
#define COB_FLAG_HAVE_SIGN
Definition: common.h:630
static void pretty_display_numeric(cob_field *f, FILE *fp)
Definition: termio.c:90
void cob_field_accept(cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, const int)
Definition: screenio.c:2353
#define COB_TYPE_NUMERIC_FP_DEC64
Definition: common.h:613
#define COB_SCREEN_EMULATE_NL
Definition: common.h:922
static cob_settings * cobsetptr
Definition: termio.c:44
#define COB_TYPE_NUMERIC_FLOAT
Definition: common.h:610
#define _(s)
Definition: cobcrun.c:59
#define COB_FIELD_REAL_BINARY(f)
Definition: common.h:649
#define unlikely(x)
Definition: common.h:437
void cob_field_display(cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, cob_field *, const int)
Definition: screenio.c:2341
EC ARGUMENT EC EC BOUND EC BOUND EC BOUND EC BOUND TABLE EC DATA EC DATA EC DATA PTR NULL
Definition: exception.def:95
static void display_common(cob_field *f, FILE *fp)
Definition: termio.c:167
#define COB_FLAG_SIGN_LEADING
Definition: common.h:632
#define COB_TYPE_NUMERIC_BINARY
Definition: common.h:608
void cob_set_exception(const int id)
Definition: common.c:1212
#define COB_FLAG_SIGN_SEPARATE
Definition: common.h:631
#define COB_TYPE_NUMERIC_DISPLAY
Definition: common.h:607
void cob_set_int(cob_field *, const int)
Definition: move.c:1612
#define COB_MODULE_PTR
Definition: coblocal.h:185
static cob_global * cobglobptr
Definition: termio.c:43
void cob_print_ieeedec(const cob_field *, FILE *)
Definition: numeric.c:1647
unsigned short digits
Definition: common.h:942
#define COB_SCREEN_PROMPT
Definition: common.h:914
unsigned int cob_screen_initialized
Definition: common.h:1208
static void display_numeric(cob_field *f, FILE *fp)
Definition: termio.c:55
size_t size
Definition: common.h:951
#define COB_TYPE_NUMERIC_DOUBLE
Definition: common.h:611
void cob_init_termio(cob_global *lptr, cob_settings *sptr)
Definition: termio.c:343
const cob_field_attr * attr
Definition: common.h:953
void cob_accept(cob_field *f)
Definition: termio.c:283
#define COB_FIELD_HAVE_SIGN(f)
Definition: common.h:643
#define COB_TYPE_NUMERIC_FP_DEC128
Definition: common.h:614
static void display_alnum(cob_field *f, FILE *fp)
Definition: termio.c:157
#define COB_FIELD_DIGITS(f)
Definition: common.h:663
#define COB_TYPE_NUMERIC_EDITED
Definition: common.h:619
#define COB_MEDIUM_MAX
Definition: common.h:549
#define COB_FIELD_IS_POINTER(f)
Definition: common.h:650
#define COB_FIELD_SIGN_LEADING(f)
Definition: common.h:645
#define COB_DISP_TO_STDERR
Definition: coblocal.h:191