tinycobol/lib/basicio.c

547 lines
17 KiB
C

//
// Copyright (C) 2001, 2000, 1999, Rildo Pragana, Jim Noeth,
// Andrew Cameron, David Essex.
// Copyright (C) 1993, 1991 Rildo Pragana.
//
// This library is free software; you can redistribute it and/or
// modify it under the terms of the GNU Lesser General Public License
// as published by the Free Software Foundation; either version 2.1,
// or (at your option) any later version.
//
// This library is distributed in the hope that it will be useful,
// but WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
// GNU Lesser General Public License for more details.
//
// You should have received a copy of the GNU Lesser General Public
// License along with this library; see the file COPYING.LIB. If
// not, write to the Free Software Foundation, Inc., 59 Temple Place,
// Suite 330, Boston, MA 02111-1307 USA
//
// Cobol Compiler Run Time Library -- Accept/Display basic I/O functions
//
//
//#define DEBUG_BASIC_RTS 1
//#define HTCOB_LD_PATH "TCOB_LD_LIBRARY_PATH"
#include "htcoblib.h"
#include "rterrors.h"
#include "mwindows.h"
#ifndef __MINGW32__
#include <termios.h>
#endif
#ifdef WANT_DYNAMIC_LIBS
#include <glob.h>
#endif
#ifndef __MINGW32__
/* Needed for gettimeofday */
#include <sys/time.h>
#else
/* Needed for GetSystemTime */
#include <windows.h>
#endif
#ifdef USE_MF_COMPATABILITY
#define TCOB_COMMANDLINE_MFCOMP 1
#endif
extern int bDecimalComma;
//static struct fld_desc _generic_4binary = { 4,DTYPE_BININT,0,0,0,0,0,0,0,0,"S\19\x09" };
int tcob_var_argc = 0;
char **tcob_var_argv = NULL;
#ifdef WANT_READLINE
#ifdef WANT_ALL_DYNAMIC_LIBS
static char *readline_stub(char *s);
static char *(* _readline)(char *s) = readline_stub;
static void add_history_stub(char *s)
{
}
static void (* _add_history)(char *) = add_history_stub;
/*-------------------------------------------------------------------------*\
| |
| readline_stub |
| |
\*-------------------------------------------------------------------------*/
static char * readline_stub(char *s)
{
char *libname = "libreadline.so";
void *handle = dlopen(libname, RTLD_LAZY);
if (!handle)
{
tcob_rt_warning("readline_stub", TCERR_RESOLVE_STUB, libname, dlerror());
// fprintf(stderr,"*ERROR* loading %s: %s\n",libname,dlerror());
return NULL;
}
_readline = dlsym(handle, "readline");
_add_history = dlsym(handle, "add_history");
return _readline(s);
}
#else
#define _readline readline
#define _add_history add_history
#endif
#endif
/*-------------------------------------------------------------------------*\
| |
| tcob_newline |
| |
\*-------------------------------------------------------------------------*/
void tcob_newline(int dupon)
{
putc('\n', ((dupon == 1) ? stdout : stderr));
}
/*-------------------------------------------------------------------------*\
| |
| tcob_display |
| |
\*-------------------------------------------------------------------------*/
void tcob_display(struct fld_desc *f, char *s, int dupon)
{
char *buffer;
struct fld_desc ftmp;
unsigned int picLen;
int moved = 0;
unsigned int i, len;
if ((f->type == DTYPE_DISPLAY)
|| (f->type == DTYPE_PACKED)
|| (f->type == DTYPE_BININT)
|| (f->type == DTYPE_FLOAT))
{
char cDecimalChar = (bDecimalComma) ? ',' : '.';
len = tcob_picCompLength(f) + tc_abs((char) f->pscale);
#ifdef DEBUG_BASIC_RTS
fprintf(stderr, "debug display 1a: f->type=%c, f->len=%d, len=%d, f->decimals=%d\n",
f->type, f->len, len, f->decimals);
if (f->type != DTYPE_GROUP)
{
char c;
fprintf(stderr, "debug display 1b: pic=");
for (i = 0; (c = tcob_picElemVal(f->pic, i)); i++)
{
fprintf(stderr, "%c(%d)", c, tcob_picElemLen(f->pic, i));
}
fprintf(stderr, "\n");
}
#endif
memmove(&ftmp, f, sizeof (ftmp));
ftmp.type = DTYPE_EDITED;
picLen = tcob_picReqLen(4);
ftmp.pic = (char *) malloc(picLen);
tcob_picCreate(ftmp.pic, picLen, NULL);
if (tcob_picElemVal(f->pic, 0) == 'S')
tcob_picAppend(ftmp.pic, picLen, '-', 1, NULL);
if (ftmp.decimals <= 0)
{
tcob_picAppend(ftmp.pic, picLen, '9', len, NULL);
}
else
{
if (tcob_picElemVal(f->pic, 0) == 'P' || /* unsigned scaled */
tcob_picElemVal(f->pic, 1) == 'P')
{ /* signed scaled */
tcob_picAppend(ftmp.pic, picLen,
cDecimalChar, 1,
'9', ftmp.decimals, NULL);
}
else
{
tcob_picAppend(ftmp.pic, picLen,
'9', len - ftmp.decimals,
cDecimalChar, 1,
'9', ftmp.decimals, NULL);
}
}
if (ftmp.decimals > 0) /* account for the decimal point */
len++;
if (tcob_picElemVal(f->pic, 0) == 'S') /* account for the sign */
len++;
buffer = malloc(len);
ftmp.len = len;
tcob_move(f, s, &ftmp, buffer);
moved++;
#ifdef DEBUG_BASIC_RTS
fprintf(stderr, "debug display 2a: type=%c, len=%d, decimals=%d;\n",
ftmp.type, ftmp.len, ftmp.decimals);
if (ftmp.type != DTYPE_GROUP)
{
char c;
fprintf(stderr, "debug display 2b: pic=");
for (i = 0; (c = tcob_picElemVal(ftmp.pic, i)); i++)
fprintf(stderr, "%c(%d)", c, tcob_picElemLen(ftmp.pic, i));
fprintf(stderr, "\n");
}
#endif
free(ftmp.pic);
}
else
{
len = f->len;
buffer = s;
}
if (dupon == 1)
{
for (i = 0; i < len; i++)
putc(buffer[i], stdout);
}
else
{
for (i = 0; i < len; i++)
putc(buffer[i], stderr);
}
if (moved)
free(buffer);
}
/*-------------------------------------------------------------------------*\
| |
| tcob_display_erase |
| |
\*-------------------------------------------------------------------------*/
void tcob_display_erase(int dupon)
{
putc('\f', ((dupon == 1) ? stdout : stderr));
}
/*-------------------------------------------------------------------------*\
| |
| tcob_accept_chron |
| Accepts a variable using the current local time/date. |
| |
\*-------------------------------------------------------------------------*/
/* DATE-TIME */
#define DATE 0
#define TIME 1
#define DAY 2
#define DAY_OF_WEEK 3
int tcob_accept_chron(struct fld_desc *f, char *buffer,
int date_fmt, int is_yyyy)
{
time_t tnow;
struct tm *timep;
unsigned int ctime;
unsigned int year;
unsigned int digits;
unsigned int hsec; /* hundredths of a second */
time(&tnow);
timep = localtime(&tnow);
year = (is_yyyy) ? (timep->tm_year) + 1900 : (timep->tm_year) % 100;
/* Determine hundredths of a second */
if (date_fmt == TIME)
{
#ifndef __MINGW32__
struct timeval tv;
gettimeofday(&tv, NULL);
hsec = tv.tv_usec / 10000;
#else
SYSTEMTIME st;
GetSystemTime(&st);
hsec = st.wMilliseconds / 10;
#endif
}
switch (date_fmt)
{
case TIME:
/* Accepts the current time in the form 'HHMMSScc'.
* HH is the hour (0-23), MM is the minute, SS is the second,
* cc is hundredths of a second.
*/
ctime = timep->tm_hour * 1000000 +
timep->tm_min * 10000 +
timep->tm_sec * 100 +
hsec;
digits = 8;
break;
case DATE:
/* Accepts the current date in the form 'YYMMDD'/'YYYYMMDD'.
* YY is the year, MM is the month (January=1), DD is the day.
*/
ctime = year * 10000 +
((timep->tm_mon) + 1) * 100 +
timep->tm_mday;
digits = (is_yyyy) ? 8 : 6;
break;
case DAY:
/* Accepts the current day of the year in the form 'YYDDD'/'YYYYDDD'.
* YY is the year, DDD is the day of the year.
*/
ctime = year * 1000 +
((timep->tm_yday) + 1);
digits = (is_yyyy) ? 7 : 5;
break;
case DAY_OF_WEEK:
/* Accepts the current day of the week into a single character.
* The reason for the calculation is that C's representation of
* Sunday is 0, while in COBOL it is 7. The rest of the week is
* the same in both languages (Monday=1 ... Saturday=6).
*/
ctime = (((timep->tm_wday) + 6) % 7) + 1;
digits = 1;
break;
default:
return 1;
}
// {
struct fld_desc tmpfld;
int piclen;
char edited[9]; /* length is max value of 'digits' plus one */
memset(&tmpfld, 0, sizeof (tmpfld));
tmpfld.len = digits;
tmpfld.type = DTYPE_DISPLAY;
piclen = tcob_picReqLen(1);
tmpfld.pic = tcob_picCreate(malloc(piclen), piclen, '9', digits);
sprintf(edited, "%0*d", digits, ctime);
tcob_move(&tmpfld, (char *) & edited, f, buffer);
free(tmpfld.pic);
// }
return 0;
}
/*-------------------------------------------------------------------------*\
| |
| tcob_accept_std |
| |
\*-------------------------------------------------------------------------*/
int tcob_accept_std(char *buffer, struct fld_desc *f, int flags)
{
#ifndef __MINGW32__
struct termios attr;
#endif
int r;
static char *szBuf = NULL;
unsigned int picLen;
struct fld_desc f1 = {0, DTYPE_ALPHANUMERIC, 0, 0, 0, 0, 0, 0, 0, 0, NULL};
#ifndef __MINGW32__
if ((flags & SCR_NOECHO) != 0)
{
// Get terminal attributes
if (tcgetattr(STDIN_FILENO, &attr) != 0)
return (-1);
// Turn off echo flag
attr.c_lflag &= ~(ECHO);
// Set terminal attributes
// Discard any typed but un-read characters
if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &attr) != 0)
return (-1);
}
#endif
#ifdef WANT_READLINE
if (isatty(fileno(stdin)))
{
szBuf = _readline("");
}
else
{
fgets(szBuf, RLBUF_SIZE, stdin);
szBuf[strlen(szBuf) - 1] = 0;
}
#else
/* we alloc the line buffer only at the first time */
if (!szBuf)
szBuf = malloc(RLBUF_SIZE);
fgets(szBuf, RLBUF_SIZE, stdin);
szBuf[strlen(szBuf) - 1] = 0;
#endif
r = strlen(szBuf) ? 0 : -1; /* it's not really "on escape", but... */
f1.len = strlen(szBuf);
picLen = tcob_picReqLen(1);
f1.pic = (char *) malloc(picLen);
tcob_picCreate(f1.pic, picLen, 'X', f1.len, NULL);
#ifdef WANT_READLINE
if (f1.len)
_add_history(szBuf);
#endif
tcob_move(&f1, szBuf, f, buffer);
free(f1.pic);
#ifdef WANT_READLINE
/* free the buffer only if it came from a readline call */
if (isatty(fileno(stdin)))
free(szBuf);
#endif
#ifndef __MINGW32__
if ((flags & SCR_NOECHO) != 0)
{
// Turn on echo flag
attr.c_lflag |= ECHO;
// Set terminal attributes
if (tcsetattr(STDIN_FILENO, TCSANOW, &attr) != 0)
return (-1);
}
#endif
return r;
}
/*-------------------------------------------------------------------------*\
| |
| tcob_accept_cmd_line |
| Accepts the set of command-line variables as a single string. |
| Return value - 0: Success |
| 1: Insufficient space in buffer |
| |
\*-------------------------------------------------------------------------*/
//int tcob_accept_cmd_line( int ac, char **av, struct fld_desc *f, char *buffer ) {
int tcob_accept_cmd_line(struct fld_desc *f, char *buffer)
{
int i, r = 0;
unsigned int len, totlen;
// test only
// fprintf(stderr, "debug: accept_cmd_line : f.type=%c, f.len=%d\n", f->type, f->len);
// Padd variable with blanks
memset(buffer, ' ', f->len);
// Process input parms
totlen = 0;
/* Command line index */
// test only
// fprintf(stderr, "debug: accept_cmd_line 1: tcob_var_argc=%d\n", ac);
#ifdef TCOB_COMMANDLINE_MFCOMP
for (i = 1; i < tcob_var_argc; i++)
{
#else
for (i = 0; i < tcob_var_argc; i++)
{
#endif
// test only
// fprintf(stderr, "debug: accept_cmd_line 2: av[%d]=%s;\n", i, tcob_var_argv[i]);
len = strlen(tcob_var_argv[i]);
// test only
// fprintf(stderr, "debug: accept_cmd_line 3: len=%d; j=%d;\n", len, j);
if (f->len >= totlen + len)
{
memmove(&buffer[totlen], tcob_var_argv[i], len);
totlen += (len + 1);
if ((i + 1 != tcob_var_argc) && (f->len < totlen))
{
i = tcob_var_argc;
r = 1;
}
}
else
{
// test only
// fprintf(stderr, "debug: accept_cmd_line 4: len=%d; j=%d;\n", len, j);
i = tcob_var_argc;
r = 1;
}
}
return r;
}
/*-------------------------------------------------------------------------*\
| |
| tcob_accept_env_var |
| Accepts an environment variable. |
| Return value - 0: Success |
| 1: Environment variable was not found |
| 2: Insufficient space in buffer |
| |
\*-------------------------------------------------------------------------*/
int tcob_accept_env_var(struct fld_desc *f, char *buffer, char *ptevname)
{
int r = 0;
unsigned int len;
char *pt1;
// test only
// fprintf(stderr, "debug: accept_env_var 0: f.type=%c, f.len=%d, ptevname=%s;\n",
// f->type, f->len, ptevname);
// Padd variable with blanks
memset(buffer, ' ', f->len);
// Get environment variable, if it exists
if ((pt1 = getenv(ptevname)) == NULL)
r = 1;
else
{
len = strlen(pt1);
// test only
// fprintf(stderr, "debug: accept_env_var 1: f.len=%d, evlen=%d;\n",
// f->len, len);
if (f->len < len)
{
len = f->len;
r = 2;
}
memmove(buffer, pt1, len);
}
return r;
}
/*-------------------------------------------------------------------------*\
| |
| tcob_init |
| Initialize the command line variables. |
| Return value - 0: Success |
| |
\*-------------------------------------------------------------------------*/
int tcob_init(int ac, char **av)
{
int r = 0;
tcob_var_argc = ac;
tcob_var_argv = av;
return r;
}
/* end of basicio.c */