greg
/
metamath
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
metamath/mmvstr.c

998 lines
28 KiB
C
Raw Permalink Blame History

/*****************************************************************************/
/* Copyright (C) 2019 NORMAN MEGILL nm at alum.mit.edu */
/* License terms: GNU General Public License */
/*****************************************************************************/
/*34567890123456 (79-character line to adjust editor window) 2345678901234567*/
/*
mmvstr.c - VMS-BASIC variable length string library routines header
This is an emulation of the string functions available in VMS BASIC.
*/
/*** See the comments in mmvstr.h for an explanation of these functions ******/
#include <stdarg.h>
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#include <time.h>
#include <ctype.h>
#include "mmvstr.h"
/*E*/ /*Next line is need to declare "db" for debugging*/
#include "mmdata.h"
/* 1-Dec-05 nm
mmdata.h is also used to declare the bug() function that is called in
several places by mmvstr.c. To make mmvstr.c and mmvstr.h completely
independent of the other programs, for use with another project, do the
following:
(1) Remove all lines beginning with the "/ *E* /" comment.
(2) Remove all calls to the bug() function (4 places).
To see an example of stand-alone usage of the mmvstr.c functions, see
the program lattice.c and several others included in
http://us.metamath.org/downloads/quantum-logic.tar.gz
*/
/*E*/long db1=0;
#ifdef NDEBUG
# define INCDB1(x)
#else
# define INCDB1(x) db1 += (x)
#endif
#define MAX_ALLOC_STACK 100
long g_tempAllocStackTop = 0; /* Top of stack for tempAlloc functon */
long g_startTempAllocStack = 0; /* Where to start freeing temporary allocation
when let() is called (normally 0, except in
special nested vstring functions) */
void *tempAllocStack[MAX_ALLOC_STACK];
static void freeTempAlloc(void)
{
/* All memory previously allocated with tempAlloc is deallocated. */
/* EXCEPT: When g_startTempAllocStack != 0, the freeing will start at
g_startTempAllocStack. */
long i;
for (i = g_startTempAllocStack; i < g_tempAllocStackTop; i++) {
/*E*/INCDB1(-1 - (long)strlen(tempAllocStack[i]));
/*E* /printf("%ld removing [%s]\n", db1, tempAllocStack[i]);*/
free(tempAllocStack[i]);
}
g_tempAllocStackTop = g_startTempAllocStack;
} /* freeTempAlloc */
static void pushTempAlloc(void *mem)
{
if (g_tempAllocStackTop >= (MAX_ALLOC_STACK-1)) {
printf("*** FATAL ERROR *** Temporary string stack overflow\n");
#if __STDC__
fflush(stdout);
#endif
bug(2201);
}
tempAllocStack[g_tempAllocStackTop++] = mem;
} /* pushTempAlloc */
static void* tempAlloc(long size) /* String memory allocation/deallocation */
{
void* memptr = malloc((size_t)size);
if (!memptr || size == 0) {
printf("*** FATAL ERROR *** Temporary string allocation failed\n");
#if __STDC__
fflush(stdout);
#endif
bug(2202);
}
pushTempAlloc(memptr);
/*E*/INCDB1(size);
/*E* /printf("%ld adding\n",db1);*/
return memptr;
} /* tempAlloc */
/* Make string have temporary allocation to be released by next let() */
/* Warning: after makeTempAlloc() is called, the vstring may NOT be
assigned again with let() */
void makeTempAlloc(vstring s)
{
pushTempAlloc(s);
/*E*/INCDB1((long)strlen(s) + 1);
/*E*/db-=(long)strlen(s) + 1;
/*E* /printf("%ld temping[%s]\n", db1, s);*/
} /* makeTempAlloc */
/* 8-Jul-2013 Wolf Lammen - rewritten to simplify it */
void let(vstring *target, vstring source) /* String assignment */
/* This function must ALWAYS be called to make assignment to */
/* a vstring in order for the memory cleanup routines, etc. */
/* to work properly. If a vstring has never been assigned before, */
/* it is the user's responsibility to initialize it to "" (the */
/* null string). */
{
size_t sourceLength = strlen(source); /* Save its length */
size_t targetLength = strlen(*target); /* Save its length */
/*E*/if (targetLength) {
/*E*/ db -= (long)targetLength+1;
/*E*/ /* printf("%ld Deleting %s\n",db,*target); */
/*E*/}
/*E*/if (sourceLength) {
/*E*/ db += (long)sourceLength+1;
/*E*/ /* printf("%ld Adding %s\n",db,source); */
/*E*/}
if (targetLength < sourceLength) { /* Old string has not enough room for new one */
/* Free old string space and allocate new space */
if (targetLength)
free(*target); /* Free old space */
*target = malloc(sourceLength + 1); /* Allocate new space */
if (!*target) {
printf("*** FATAL ERROR *** String memory couldn't be allocated\n");
#if __STDC__
fflush(stdout);
#endif
bug(2204);
}
}
if (sourceLength) {
strcpy(*target, source);
} else {
/* Empty strings could still be temporaries, so always assign a constant */
if (targetLength) {
free(*target);
}
*target= "";
}
freeTempAlloc(); /* Free up temporary strings used in expression computation */
} /* let */
vstring cat(vstring string1,...) /* String concatenation */
#define MAX_CAT_ARGS 50
{
va_list ap; /* Declare list incrementer */
vstring arg[MAX_CAT_ARGS]; /* Array to store arguments */
size_t argPos[MAX_CAT_ARGS]; /* Array of argument positions in result */
vstring result;
int i;
int numArgs = 0; /* Define "last argument" */
size_t pos = 0;
char* curArg = string1;
va_start(ap, string1); /* Begin the session */
do {
/* User-provided argument list must terminate with 0 */
if (numArgs >= MAX_CAT_ARGS) {
printf("*** FATAL ERROR *** Too many cat() arguments\n");
#if __STDC__
fflush(stdout);
#endif
bug(2206);
}
arg[numArgs] = curArg;
argPos[numArgs] = pos;
pos += strlen(curArg);
} while (++numArgs, (curArg = va_arg(ap,char *)) != 0);
va_end(ap); /* End var args session */
/* Allocate the memory for it */
result = tempAlloc((long)pos+1);
/* Move the strings into the newly allocated area */
for (i = 0; i < numArgs; ++i)
strcpy(result + argPos[i], arg[i]);
return result;
} /* cat */
/* 20-Oct-2013 Wolf Lammen - allow unlimited input line lengths */
/* Input a line from the user or from a file */
/* Returns 1 if a (possibly empty) line was successfully read, 0 if EOF */
int linput(FILE *stream, const char* ask, vstring *target)
{ /* Note: "vstring *target" means "char **target" */
/*
BASIC: linput "what"; a$
c: linput(NULL, "what?", &a);
BASIC: linput #1, a$ (error trap on EOF)
c: if (!linput(file1, NULL, &a)) break; (break on EOF)
*/
/* This function prints a prompt (if 'ask' is not NULL), gets a line from
the stream, and assigns it to target using the let(&...) function.
0 is returned when end-of-file is encountered. The vstring
*target MUST be initialized to "" or previously assigned by let(&...)
before using it in linput. */
char f[10001]; /* Read in chunks up to 10000 characters */
int result = 0;
int eol_found = 0;
if (ask) {
printf("%s", ask);
#if __STDC__
fflush(stdout);
#endif
}
if (stream == NULL) stream = stdin;
while (!eol_found && fgets(f, sizeof(f), stream))
{
size_t endpos = strlen(f) - 1;
eol_found = (f[endpos] == '\n');
/* If the last line in the file has no newline, eol_found will be 0 here.
The fgets() above will return 0 and prevent another loop iteration. */
if (eol_found)
f[endpos] = 0; /* The return string will have any newline stripped. */
if (result)
/* Append additional parts of the line to *target */
/* The let() reallocates *target and copies the concatenation of the
old *target and the additional input f[] to it */
let(target /* = &(*target) */, cat(*target, f, NULL));
else
/* This is the first time through the loop, and normally
the only one unless the input line overflows f[] */
let(target, f); /* Allocate *target and copy f to it */
result = 1;
}
return result;
} /* linput */
/* Find out the length of a string */
long len(vstring s)
{
return ((long)strlen(s));
} /* len */
/* Extract sin from character position start to stop into sout */
vstring seg(vstring sin, long start, long stop)
{
if (start < 1) start = 1;
return mid(sin, start, stop - start + 1);
} /* seg */
/* Extract sin from character position start for length len */
vstring mid(vstring sin, long start, long length)
{
vstring sout;
if (start < 1) start = 1;
if (length < 0) length = 0;
sout=tempAlloc(length + 1);
strncpy(sout,sin + start - 1, (size_t)length);
/*E*/ /*??? Should db be subtracted from if length > end of string? */
sout[length] = 0;
return (sout);
} /* mid */
/* Extract leftmost n characters */
vstring left(vstring sin,long n)
{
return mid(sin, 1, n);
} /* left */
/* Extract after character n */
vstring right(vstring sin, long n)
{
return seg(sin, n, (long)(strlen(sin)));
} /* right */
/* Emulate VMS BASIC edit$ command */
vstring edit(vstring sin,long control)
#define isblank_(c) ((c == ' ') || (c == '\t'))
/* 11-Sep-2009 nm Added _ to fix '"isblank" redefined' compiler warning */
#define isblankorlf_(c) ((c == ' ') || (c == '\t') || (c == '\n'))
/* 8-May-2015 nm added isblankorlf_ */
{
/* EDIT$ (from VMS BASIC manual)
Syntax: str-vbl = EDIT$(str-exp, int-exp)
Values Effect
1 Trim parity bits
2 Discard all spaces and tabs
4 Discard characters: CR, LF, FF, ESC, RUBOUT, and NULL
8 Discard leading spaces and tabs
16 Reduce spaces and tabs to one space
32 Convert lowercase to uppercase
64 Convert [ to ( and ] to )
128 Discard trailing spaces and tabs
256 Do not alter characters inside quotes
(non-BASIC extensions)
512 Convert uppercase to lowercase
1024 Tab the line (convert spaces to equivalent tabs)
2048 Untab the line (convert tabs to equivalent spaces)
4096 Convert VT220 screen print frame graphics to -,|,+ characters
(Added 10/24/03:)
8192 Discard CR only (to assist DOS-to-Unix conversion)
(Added 8-May-2015 nm:)
16384 Discard trailing spaces, tabs, and LFs
*/
vstring sout;
long i, j, k, m;
int last_char_is_blank;
int trim_flag, discardctrl_flag, bracket_flag, quote_flag, case_flag;
int alldiscard_flag, leaddiscard_flag, traildiscard_flag,
traildiscardLF_flag, reduce_flag;
int processing_inside_quote=0;
int lowercase_flag, tab_flag, untab_flag, screen_flag, discardcr_flag;
unsigned char graphicsChar;
/* Set up the flags */
trim_flag = control & 1;
alldiscard_flag = control & 2;
discardctrl_flag = control & 4;
leaddiscard_flag = control & 8;
reduce_flag = control & 16;
case_flag = control & 32;
bracket_flag = control & 64;
traildiscard_flag = control & 128;
traildiscardLF_flag = control & 16384;
quote_flag = control & 256;
/* Non-BASIC extensions */
lowercase_flag = control & 512;
tab_flag = control & 1024;
untab_flag = control & 2048;
screen_flag = control & 4096; /* Convert VT220 screen prints to |,-,+
format */
discardcr_flag = control & 8192; /* Discard CR's */
/* Copy string */
i = (long)strlen(sin) + 1;
if (untab_flag) i = i * 7; /* Allow for max possible length */
sout=tempAlloc(i);
strcpy(sout,sin);
/* Discard leading space/tab */
i=0;
if (leaddiscard_flag)
while ((sout[i] != 0) && isblank_(sout[i]))
sout[i++] = 0;
/* Main processing loop */
while (sout[i] != 0) {
/* Alter characters inside quotes ? */
if (quote_flag && ((sout[i] == '"') || (sout[i] == '\'')))
processing_inside_quote = ~ processing_inside_quote;
if (processing_inside_quote) {
/* Skip the rest of the code and continue to process next character */
i++; continue;
}
/* Discard all space/tab */
if ((alldiscard_flag) && isblank_(sout[i]))
sout[i] = 0;
/* Trim parity (eighth?) bit */
if (trim_flag)
sout[i] = sout[i] & 0x7F;
/* Discard CR,LF,FF,ESC,BS */
if ((discardctrl_flag) && (
(sout[i] == '\015') || /* CR */
(sout[i] == '\012') || /* LF */
(sout[i] == '\014') || /* FF */
(sout[i] == '\033') || /* ESC */
/*(sout[i] == '\032') ||*/ /* ^Z */ /* DIFFERENCE won't work w/ this */
(sout[i] == '\010'))) /* BS */
sout[i] = 0;
/* Discard CR */
if ((discardcr_flag) && (
(sout[i] == '\015'))) /* CR */
sout[i] = 0;
/* Convert lowercase to uppercase */
/*
if ((case_flag) && (islower(sout[i])))
sout[i] = toupper(sout[i]);
*/
/* 13-Jun-2009 nm The upper/lower case C functions have odd behavior
with characters > 127, at least in lcc. So this was rewritten to
not use them. */
if ((case_flag) && (sout[i] >= 'a' && sout[i] <= 'z'))
sout[i] = (char)(sout[i] - ('a' - 'A'));
/* Convert [] to () */
if ((bracket_flag) && (sout[i] == '['))
sout[i] = '(';
if ((bracket_flag) && (sout[i] == ']'))
sout[i] = ')';
/* Convert uppercase to lowercase */
/*
if ((lowercase_flag) && (isupper(sout[i])))
sout[i] = tolower(sout[i]);
*/
/* 13-Jun-2009 nm The upper/lower case C functions have odd behavior
with characters > 127, at least in lcc. So this was rewritten to
not use them. */
if ((lowercase_flag) && (sout[i] >= 'A' && sout[i] <= 'Z'))
sout[i] = (char)(sout[i] + ('a' - 'A'));
/* Convert VT220 screen print frame graphics to +,|,- */
if (screen_flag) {
graphicsChar = (unsigned char)sout[i]; /* Need unsigned char for >127 */
/* vt220 */
if (graphicsChar >= 234 && graphicsChar <= 237) sout[i] = '+';
if (graphicsChar == 241) sout[i] = '-';
if (graphicsChar == 248) sout[i] = '|';
if (graphicsChar == 166) sout[i] = '|';
/* vt100 */
if (graphicsChar == 218 /*up left*/ || graphicsChar == 217 /*lo r*/
|| graphicsChar == 191 /*up r*/ || graphicsChar == 192 /*lo l*/)
sout[i] = '+';
if (graphicsChar == 196) sout[i] = '-';
if (graphicsChar == 179) sout[i] = '|';
}
/* Process next character */
i++;
}
/* sout[i]=0 is the last character at this point */
/* Clean up the deleted characters */
for (j = 0, k = 0; j <= i; j++)
if (sout[j]!=0) sout[k++]=sout[j];
sout[k] = 0;
/* sout[k] = 0 is the last character at this point */
/* Discard trailing space/tab */
if (traildiscard_flag) {
--k;
while ((k >= 0) && isblank_(sout[k])) --k;
sout[++k] = 0;
}
/* 8-May-2015 nm */
/* Discard trailing space/tab and LF */
if (traildiscardLF_flag) {
--k;
while ((k >= 0) && isblankorlf_(sout[k])) --k;
sout[++k] = 0;
}
/* Reduce multiple space/tab to a single space */
if (reduce_flag) {
i = j = last_char_is_blank = 0;
while (i <= k - 1) {
if (!isblank_(sout[i])) {
sout[j++] = sout[i++];
last_char_is_blank = 0;
} else {
if (!last_char_is_blank)
sout[j++]=' '; /* Insert a space at the first occurrence of a blank */
last_char_is_blank = 1; /* Register that a blank is found */
i++; /* Process next character */
}
}
sout[j] = 0;
}
/* Untab the line */
if (untab_flag || tab_flag) {
/*
DEF FNUNTAB$(L$) ! UNTAB LINE L$
I9%=1%
I9%=INSTR(I9%,L$,CHR$(9%))
WHILE I9%
L$=LEFT(L$,I9%-1%)+SPACE$(8%-((I9%-1%) AND 7%))+RIGHT(L$,I9%+1%)
I9%=INSTR(I9%,L$,CHR$(9%))
NEXT
FNUNTAB$=L$
FNEND
*/
/***** old code (doesn't handle multiple lines)
k = (long)strlen(sout);
for (i = 1; i <= k; i++) {
if (sout[i - 1] != '\t') continue;
for (j = k; j >= i; j--) {
sout[j + 8 - ((i - 1) & 7) - 1] = sout[j];
}
for (j = i; j < i + 8 - ((i - 1) & 7); j++) {
sout[j - 1] = ' ';
}
k = k + 8 - ((i - 1) & 7);
}
*****/
/* Untab string containing multiple lines */ /* 9-Jul-2011 nm */
/* (Currently this is needed by outputStatement() in mmpars.c) */
k = (long)strlen(sout);
m = 0; /* Position on line relative to last '\n' */
for (i = 1; i <= k; i++) {
if (sout[i - 1] == '\n') {
m = 0;
continue;
}
m++; /* Should equal i for one-line string */
if (sout[i - 1] != '\t') continue;
for (j = k; j >= i; j--) {
sout[j + 8 - ((m - 1) & 7) - 1] = sout[j];
}
for (j = i; j < i + 8 - ((m - 1) & 7); j++) {
sout[j - 1] = ' ';
}
k = k + 8 - ((m - 1) & 7);
}
}
/* Tab the line */
/* (Note that this does not [yet?] handle string with multiple lines) */
if (tab_flag) {
/*
DEF FNTAB$(L$) ! TAB LINE L$
I9%=0%
FOR I9%=8% STEP 8% WHILE I9%<LEN(L$)
J9%=I9%
J9%=J9%-1% UNTIL ASCII(MID(L$,J9%,1%))<>32% OR J9%=I9%-8%
IF J9%<=I9%-2% THEN
L$=LEFT(L$,J9%)+CHR$(9%)+RIGHT(L$,I9%+1%)
I9%=J9%+1%
END IF
NEXT I9%
FNTAB$=L$
FNEND
*/
k = (long)strlen(sout);
for (i = 8; i < k; i = i + 8) {
j = i;
/* 25-May-2016 nm */
/* gcc m*.c -o metamath.exe -O2 -Wall was giving:
mmvstr.c:285:9: warning: assuming signed overflow does not occur
when assuming that (X - c) <= X is always true [-Wstrict-overflow]
Here we trick gcc into turning off this optimization by moving
the computation of i - 2 here, then referencing m instead of i - 2
below. Note that if "m = i - 2" is moved _after_ the "while", the
error message returns. */
m = i - 2;
while (sout[j - 1] == ' ' && j > i - 8) j--;
/*if (j <= i - 2) {*/
if (j <= m) { /* 25-May-2016 nm */
sout[j] = '\t';
j = i;
while (sout[j - 1] == ' ' && j > i - 8 + 1) {
sout[j - 1] = 0;
j--;
}
}
}
i = k;
/* sout[i]=0 is the last character at this point */
/* Clean up the deleted characters */
for (j = 0, k = 0; j <= i; j++)
if (sout[j] != 0) sout[k++] = sout[j];
sout[k] = 0;
/* sout[k] = 0 is the last character at this point */
}
return (sout);
} /* edit */
/* Return a string of the same character */
vstring string(long n, char c)
{
vstring sout;
long j = 0;
if (n < 0) n = 0;
sout=tempAlloc(n + 1);
while (j < n) sout[j++] = c;
sout[j] = 0;
return (sout);
} /* string */
/* Return a string of spaces */
vstring space(long n)
{
return (string(n, ' '));
} /* space */
/* Return a character given its ASCII value */
vstring chr(long n)
{
vstring sout;
sout = tempAlloc(2);
sout[0] = (char)(n & 0xFF);
sout[1] = 0;
return(sout);
} /* chr */
/* Search for string2 in string1 starting at start_position */
/* If there is no match, 0 is returned */
/* If string2 is "", (length of the string) + 1 is returned */
long instr(long start_position, vstring string1, vstring string2)
{
char *sp1, *sp2;
long ls1, ls2;
long found = 0;
if (start_position < 1) start_position = 1;
ls1 = (long)strlen(string1);
ls2 = (long)strlen(string2);
if (start_position > ls1) start_position = ls1 + 1;
sp1 = string1 + start_position - 1;
while ((sp2 = strchr(sp1, string2[0])) != 0) {
if (strncmp(sp2, string2, (size_t)ls2) == 0) {
found = sp2 - string1 + 1;
break;
} else
sp1 = sp2 + 1;
}
return (found);
} /* instr */
/* 12-Jun-2011 nm Added rinstr */
/* Search for _last_ occurrence of string2 in string1 */
/* 1 = 1st string character; 0 = not found */
/* ??? Future - this could be made more efficient by searching directly,
backwards from end of string1 */
long rinstr(vstring string1, vstring string2)
{
long pos = 0;
long savePos = 0;
while (1) { /* Scan until substring no longer found */
pos = instr(pos + 1, string1, string2);
if (!pos) break;
savePos = pos;
}
return (savePos);
} /* rinstr */
/* Translate string in sin to sout based on table.
Table must be 256 characters long!! <- not true anymore? */
vstring xlate(vstring sin,vstring table)
{
vstring sout;
long len_table, len_sin;
long i, j;
long table_entry;
char m;
len_sin = (long)strlen(sin);
len_table = (long)strlen(table);
sout = tempAlloc(len_sin+1);
for (i = j = 0; i < len_sin; i++)
{
table_entry = 0x000000FF & (long)sin[i];
if (table_entry < len_table)
if ((m = table[table_entry])!='\0')
sout[j++] = m;
}
sout[j]='\0';
return (sout);
} /* xlate */
/* Returns the ascii value of a character */
long ascii_(vstring c)
{
return ((long)c[0]);
} /* ascii_ */
/* Returns the floating-point value of a numeric string */
double val(vstring s)
{
double v = 0;
char signFound = 0;
double power = 1.0;
long i;
for (i = (long)strlen(s); i >= 0; i--) {
switch (s[i]) {
case '.':
v = v / power;
power = 1.0;
break;
case '-':
signFound = 1;
break;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
v = v + ((double)(s[i] - '0')) * power;
power = 10.0 * power;
break;
}
}
if (signFound) v = - v;
return v;
/*
return (atof(s));
*/
} /* val */
/* Returns current date as an ASCII string */
vstring date()
{
vstring sout;
struct tm *time_structure;
time_t time_val;
char *month[12];
/* (Aggregrate initialization is not portable) */
/* (It must be done explicitly for portability) */
month[0] = "Jan";
month[1] = "Feb";
month[2] = "Mar";
month[3] = "Apr";
month[4] = "May";
month[5] = "Jun";
month[6] = "Jul";
month[7] = "Aug";
month[8] = "Sep";
month[9] = "Oct";
month[10] = "Nov";
month[11] = "Dec";
time(&time_val); /* Retrieve time */
time_structure = localtime(&time_val); /* Translate to time structure */
sout = tempAlloc(15); /* 8-Mar-2019 nm Changed from 12 to 15 to prevent
gcc 8.3 warning (patch provided by David Starner) */
/* "%02d" means leading zeros with min. field width of 2 */
/* sprintf(sout,"%d-%s-%02d", */
sprintf(sout,"%d-%s-%04d", /* 10-Apr-06 nm 4-digit year */
time_structure->tm_mday,
month[time_structure->tm_mon],
/* time_structure->tm_year); */ /* old */
/* (int)((time_structure->tm_year) % 100)); */ /* Y2K */
(int)((time_structure->tm_year) + 1900)); /* 10-Apr-06 nm 4-digit yr */
return(sout);
} /* date */
/* Return current time as an ASCII string */
vstring time_()
{
vstring sout;
struct tm *time_structure;
time_t time_val;
int i;
char *format;
char *format1 = "%d:%d %s";
char *format2 = "%d:0%d %s";
char *am_pm[2];
/* (Aggregrate initialization is not portable) */
/* (It must be done explicitly for portability) */
am_pm[0] = "AM";
am_pm[1] = "PM";
time(&time_val); /* Retrieve time */
time_structure = localtime(&time_val); /* Translate to time structure */
if (time_structure->tm_hour >= 12)
i = 1;
else
i = 0;
if (time_structure->tm_hour > 12)
time_structure->tm_hour -= 12;
if (time_structure->tm_hour == 0)
time_structure->tm_hour = 12;
sout = tempAlloc(12);
if (time_structure->tm_min >= 10)
format = format1;
else
format = format2;
sprintf(sout,format,
time_structure->tm_hour,
time_structure->tm_min,
am_pm[i]);
return(sout);
} /* time */
/* Return a number as an ASCII string */
vstring str(double f)
{
/* This function converts a floating point number to a string in the */
/* same way that %f in printf does, except that trailing zeroes after */
/* the one after the decimal point are stripped; e.g., it returns 7 */
/* instead of 7.000000000000000. */
vstring s;
long i;
s = tempAlloc(50);
sprintf(s,"%f", f);
if (strchr(s, '.') != 0) { /* The string has a period in it */
for (i = (long)strlen(s) - 1; i > 0; i--) { /* Scan string backwards */
if (s[i] != '0') break; /* 1st non-zero digit */
s[i] = 0; /* Delete the trailing 0 */
}
if (s[i] == '.') s[i] = 0; /* Delete trailing period */
/*E*/INCDB1(-(49 - (long)strlen(s)));
}
return (s);
} /* str */
/* Return a number as an ASCII string */
/* (This may have differed slightly from str() in BASIC but I forgot how.
It should be considered deprecated.) */
vstring num1(double f)
{
return (str(f));
} /* num1 */
/* Return a number as an ASCII string surrounded by spaces */
/* (This should be considered deprecated.) */
vstring num(double f)
{
return (cat(" ",str(f)," ",NULL));
} /* num */
/*** NEW FUNCTIONS ADDED 11/25/98 ***/
/* Emulate PROGRESS "entry" and related string functions */
/* (PROGRESS is a 4-GL database language) */
/* A "list" is a string of comma-separated elements. Example:
"a,b,c" has 3 elements. "a,b,c," has 4 elements; the last element is
an empty string. ",," has 3 elements; each is an empty string.
In "a,b,c", the entry numbers of the elements are 1, 2 and 3 (i.e.
the entry numbers start a 1, not 0). */
/* Returns a character string entry from a comma-separated
list based on an integer position. */
/* If element is less than 1 or greater than number of elements
in the list, a null string is returned. */
vstring entry(long element, vstring list)
{
vstring sout;
long commaCount, lastComma, i, length;
if (element < 1) return ("");
lastComma = -1;
commaCount = 0;
i = 0;
while (list[i] != 0) {
if (list[i] == ',') {
commaCount++;
if (commaCount == element) {
break;
}
lastComma = i;
}
i++;
}
if (list[i] == 0) commaCount++;
if (element > commaCount) return ("");
length = i - lastComma - 1;
if (length < 1) return ("");
sout = tempAlloc(length + 1);
strncpy(sout, list + lastComma + 1, (size_t)length);
sout[length] = 0;
return (sout);
}
/* Emulate PROGRESS lookup function */
/* Returns an integer giving the first position of an expression
in a comma-separated list. Returns a 0 if the expression
is not in the list. */
long lookup(vstring expression, vstring list)
{
long i, exprNum, exprPos;
char match;
match = 1;
i = 0;
exprNum = 0;
exprPos = 0;
while (list[i] != 0) {
if (list[i] == ',') {
exprNum++;
if (match) {
if (expression[exprPos] == 0) return exprNum;
}
exprPos = 0;
match = 1;
i++;
continue;
}
if (match) {
if (expression[exprPos] != list[i]) match = 0;
}
i++;
exprPos++;
}
exprNum++;
if (match) {
if (expression[exprPos] == 0) return exprNum;
}
return 0;
}
/* Emulate PROGRESS num-entries function */
/* Returns the number of items in a comma-separated list. If the
list is the empty string, return 0. */
long numEntries(vstring list)
{
long i, commaCount;
if (list[0] == 0) {
commaCount = -1; /* 26-Apr-2006 nm Return 0 if list empty */
} else {
commaCount = 0;
i = 0;
while (list[i] != 0) {
if (list[i] == ',') commaCount++;
i++;
}
}
return (commaCount + 1);
}
/* Returns the character position of the start of the
element in a list - useful for manipulating
the list string directly. 1 means the first string
character. */
/* If element is less than 1 or greater than number of elements
in the list, a 0 is returned. If entry is null, a 0 is
returned. */
long entryPosition(long element, vstring list)
{
long commaCount, lastComma, i;
if (element < 1) return 0;
lastComma = -1;
commaCount = 0;
i = 0;
while (list[i] != 0) {
if (list[i] == ',') {
commaCount++;
if (commaCount == element) {
break;
}
lastComma = i;
}
i++;
}
if (list[i] == 0) {
if (i == 0) return 0;
if (list[i - 1] == ',') return 0;
commaCount++;
}
if (element > commaCount) return (0);
if (list[lastComma + 1] == ',') return 0;
return (lastComma + 2);
}
/* For debugging */
/*
int main(void)
{
vstringdef(s);
vstringdef(t);
printf("Hello\n");
let(&t,edit(" x y z ",2));
let(&s,cat(right("abc",2),left("def",len(right("xxx",2))),"ghi",t,NULL));
printf("%s\n",s);
printf("num %s\n",num(5));
printf("str %s\n",str(5.02));
printf("num1 %s\n",num1(5.02));
printf("time_ %s\n",time_());
printf("date %s\n",date());
printf("val %f\n",val("6.77"));
}
*/
Reference in New Issue View Git Blame Copy Permalink