enlightenment
/
efl
4
5
Fork 9
Code Issues 8 Pull Requests 1 Projects Releases Wiki Activity
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
20424 Commits
488 Branches
1 Tag
649 MiB
 
 
 
 
 
 
Tag: Branch: Tree: 4bc0210bd3
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from '4bc0210bd3'
${ noResults }
efl/src/bin/embryo/embryo_cc_sc2.c

2779 lines
72 KiB
Raw Blame History

/* Small compiler - File input, preprocessing and lexical analysis functions
*
* Copyright (c) ITB CompuPhase, 1997-2003
*
* This software is provided "as-is", without any express or implied warranty.
* In no event will the authors be held liable for any damages arising from
* the use of this software.
*
* Permission is granted to anyone to use this software for any purpose,
* including commercial applications, and to alter it and redistribute it
* freely, subject to the following restrictions:
*
* 1. The origin of this software must not be misrepresented; you must not
* claim that you wrote the original software. If you use this software in
* a product, an acknowledgment in the product documentation would be
* appreciated but is not required.
* 2. Altered source versions must be plainly marked as such, and must not be
* misrepresented as being the original software.
* 3. This notice may not be removed or altered from any source distribution.
*
* Version: $Id$
*/
#ifdef HAVE_CONFIG_H
# include <config.h>
#endif
#include <assert.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <math.h>
#include "embryo_cc_sc.h"
#include "Embryo.h"
static int match(char *st, int end);
static cell litchar(char **lptr, int rawmode);
static int alpha(char c);
static int icomment; /* currently in multiline comment? */
static int iflevel; /* nesting level if #if/#else/#endif */
static int skiplevel; /* level at which we started skipping */
static int elsedone; /* level at which we have seen an #else */
static char term_expr[] = "";
static int listline = -1; /* "current line" for the list file */
/* pushstk & popstk
*
* Uses a LIFO stack to store information. The stack is used by doinclude(),
* doswitch() (to hold the state of "swactive") and some other routines.
*
* Porting note: I made the bold assumption that an integer will not be
* larger than a pointer (it may be smaller). That is, the stack element
* is typedef'ed as a pointer type, but I also store integers on it. See
* SC.H for "stkitem"
*
* Global references: stack,stkidx (private to pushstk() and popstk())
*/
static stkitem stack[sSTKMAX];
static int stkidx;
void
pushstk(stkitem val)
{
if (stkidx >= sSTKMAX)
error(102, "parser stack"); /* stack overflow (recursive include?) */
stack[stkidx] = val;
stkidx += 1;
}
stkitem
popstk(void)
{
if (stkidx == 0)
return (stkitem) - 1; /* stack is empty */
stkidx -= 1;
return stack[stkidx];
}
int
plungequalifiedfile(char *name)
{
static char *extensions[] = { ".inc", ".sma", ".small" };
FILE *fp;
char *ext;
int ext_idx;
ext_idx = 0;
do
{
fp = (FILE *) sc_opensrc(name);
ext = strchr(name, '\0'); /* save position */
if (!fp)
{
/* try to append an extension */
strcpy(ext, extensions[ext_idx]);
fp = (FILE *) sc_opensrc(name);
if (!fp)
*ext = '\0'; /* on failure, restore filename */
} /* if */
ext_idx++;
}
while ((!fp) &&
(ext_idx < (int)(sizeof extensions / sizeof extensions[0])));
if (!fp)
{
*ext = '\0'; /* restore filename */
return FALSE;
} /* if */
pushstk((stkitem) inpf);
pushstk((stkitem) inpfname); /* pointer to current file name */
pushstk((stkitem) curlibrary);
pushstk((stkitem) iflevel);
assert(skiplevel == 0);
pushstk((stkitem) icomment);
pushstk((stkitem) fcurrent);
pushstk((stkitem) fline);
inpfname = strdup(name); /* set name of include file */
if (!inpfname)
error(103); /* insufficient memory */
inpf = fp; /* set input file pointer to include file */
fnumber++;
fline = 0; /* set current line number to 0 */
fcurrent = fnumber;
icomment = FALSE;
setfile(inpfname, fcurrent);
listline = -1; /* force a #line directive when changing the file */
setactivefile(fcurrent);
return TRUE;
}
int
plungefile(char *name, int try_currentpath, int try_includepaths)
{
int result = FALSE;
int i;
char *ptr;
if (try_currentpath)
result = plungequalifiedfile(name);
if (try_includepaths && name[0] != DIRSEP_CHAR)
{
for (i = 0; !result && (ptr = get_path(i)); i++)
{
char path[PATH_MAX];
strncpy(path, ptr, sizeof path);
path[sizeof path - 1] = '\0'; /* force '\0' termination */
strncat(path, name, sizeof(path) - strlen(path));
path[sizeof path - 1] = '\0';
result = plungequalifiedfile(path);
} /* while */
} /* if */
return result;
}
static void
check_empty(char *lptr)
{
/* verifies that the string contains only whitespace */
while (*lptr <= ' ' && *lptr != '\0')
lptr++;
if (*lptr != '\0')
error(38); /* extra characters on line */
}
/* doinclude
*
* Gets the name of an include file, pushes the old file on the stack and
* sets some options. This routine doesn't use lex(), since lex() doesn't
* recognize file names (and directories).
*
* Global references: inpf (altered)
* inpfname (altered)
* fline (altered)
* lptr (altered)
*/
static void
doinclude(void)
{
char name[PATH_MAX], c;
int i, result;
while (*lptr <= ' ' && *lptr != 0) /* skip leading whitespace */
lptr++;
if (*lptr == '<' || *lptr == '\"')
{
c = (char)((*lptr == '\"') ? '\"' : '>'); /* termination character */
lptr++;
while (*lptr <= ' ' && *lptr != 0) /* skip whitespace after quote */
lptr++;
}
else
{
c = '\0';
} /* if */
i = 0;
while ((*lptr != c) && (*lptr != '\0') && (i < (int)(sizeof(name) - 1))) /* find the end of the string */
name[i++] = *lptr++;
while (i > 0 && name[i - 1] <= ' ')
i--; /* strip trailing whitespace */
assert((i >= 0) && (i < (int)(sizeof(name))));
name[i] = '\0'; /* zero-terminate the string */
if (*lptr != c)
{ /* verify correct string termination */
error(37); /* invalid string */
return;
} /* if */
if (c != '\0')
check_empty(lptr + 1); /* verify that the rest of the line is whitespace */
/* Include files between "..." or without quotes are read from the current
* directory, or from a list of "include directories". Include files
* between <...> are only read from the list of include directories.
*/
result = plungefile(name, (c != '>'), TRUE);
if (!result)
error(100, name); /* cannot read from ... (fatal error) */
}
/* readline
*
* Reads in a new line from the input file pointed to by "inpf". readline()
* concatenates lines that end with a \ with the next line. If no more data
* can be read from the file, readline() attempts to pop off the previous file
* from the stack. If that fails too, it sets "freading" to 0.
*
* Global references: inpf,fline,inpfname,freading,icomment (altered)
*/
static void
readline(char *line)
{
int i, num, cont;
char *ptr;
if (lptr == term_expr)
return;
num = sLINEMAX;
cont = FALSE;
do
{
if (!inpf || sc_eofsrc(inpf))
{
if (cont)
error(49); /* invalid line continuation */
if (inpf && inpf != inpf_org)
sc_closesrc(inpf);
i = (int)(long)popstk();
if (i == -1)
{ /* All's done; popstk() returns "stack is empty" */
freading = FALSE;
*line = '\0';
/* when there is nothing more to read, the #if/#else stack should
* be empty and we should not be in a comment
*/
assert(iflevel >= 0);
if (iflevel > 0)
error(1, "#endif", "-end of file-");
else if (icomment)
error(1, "*/", "-end of file-");
return;
} /* if */
fline = i;
fcurrent = (int)(long)popstk();
icomment = (int)(long)popstk();
assert(skiplevel == 0); /* skiplevel was not stored on stack, because it should always be zero at this point */
iflevel = (int)(long)popstk();
curlibrary = (constvalue *) popstk();
free(inpfname); /* return memory allocated for the include file name */
inpfname = (char *)popstk();
inpf = (FILE *) popstk();
setactivefile(fcurrent);
listline = -1; /* force a #line directive when changing the file */
elsedone = 0;
} /* if */
if (!sc_readsrc(inpf, line, num))
{
*line = '\0'; /* delete line */
cont = FALSE;
}
else
{
/* check whether to erase leading spaces */
if (cont)
{
char *ptr = line;
while (*ptr == ' ' || *ptr == '\t')
ptr++;
if (ptr != line)
memmove(line, ptr, strlen(ptr) + 1);
} /* if */
cont = FALSE;
/* check whether a full line was read */
if (!strchr(line, '\n') && !sc_eofsrc(inpf))
error(75); /* line too long */
/* check if the next line must be concatenated to this line */
if ((ptr = strchr(line, '\n')) && ptr > line)
{
assert(*(ptr + 1) == '\0'); /* '\n' should be last in the string */
while (ptr > line
&& (*ptr == '\n' || *ptr == ' ' || *ptr == '\t'))
ptr--; /* skip trailing whitespace */
if (*ptr == '\\')
{
cont = TRUE;
/* set '\a' at the position of '\\' to make it possible to check
* for a line continuation in a single line comment (error 49)
*/
*ptr++ = '\a';
*ptr = '\0'; /* erase '\n' (and any trailing whitespace) */
} /* if */
} /* if */
num -= strlen(line);
line += strlen(line);
} /* if */
fline += 1;
}
while (num >= 0 && cont);
}
/* stripcom
*
* Replaces all comments from the line by space characters. It updates
* a global variable ("icomment") for multiline comments.
*
* This routine also supports the C++ extension for single line comments.
* These comments are started with "//" and end at the end of the line.
*
* Global references: icomment (private to "stripcom")
*/
static void
stripcom(char *line)
{
char c;
while (*line)
{
if (icomment)
{
if (*line == '*' && *(line + 1) == '/')
{
icomment = FALSE; /* comment has ended */
*line = ' '; /* replace '*' and '/' characters by spaces */
*(line + 1) = ' ';
line += 2;
}
else
{
if (*line == '/' && *(line + 1) == '*')
error(216); /* nested comment */
*line = ' '; /* replace comments by spaces */
line += 1;
} /* if */
}
else
{
if (*line == '/' && *(line + 1) == '*')
{
icomment = TRUE; /* start comment */
*line = ' '; /* replace '/' and '*' characters by spaces */
*(line + 1) = ' ';
line += 2;
}
else if (*line == '/' && *(line + 1) == '/')
{ /* comment to end of line */
if (strchr(line, '\a'))
error(49); /* invalid line continuation */
*line++ = '\n'; /* put "newline" at first slash */
*line = '\0'; /* put "zero-terminator" at second slash */
}
else
{
if (*line == '\"' || *line == '\'')
{ /* leave literals unaltered */
c = *line; /* ending quote, single or double */
line += 1;
while ((*line != c || *(line - 1) == '\\')
&& *line != '\0')
line += 1;
line += 1; /* skip final quote */
}
else
{
line += 1;
} /* if */
} /* if */
} /* if */
} /* while */
}
/* btoi
*
* Attempts to interpret a numeric symbol as a boolean value. On success
* it returns the number of characters processed (so the line pointer can be
* adjusted) and the value is stored in "val". Otherwise it returns 0 and
* "val" is garbage.
*
* A boolean value must start with "0b"
*/
static int
btoi(cell * val, char *curptr)
{
char *ptr;
*val = 0;
ptr = curptr;
if (*ptr == '0' && *(ptr + 1) == 'b')
{
ptr += 2;
while (*ptr == '0' || *ptr == '1' || *ptr == '_')
{
if (*ptr != '_')
*val = (*val << 1) | (*ptr - '0');
ptr++;
} /* while */
}
else
{
return 0;
} /* if */
if (alphanum(*ptr)) /* number must be delimited by non-alphanumeric char */
return 0;
else
return (int)(ptr - curptr);
}
/* dtoi
*
* Attempts to interpret a numeric symbol as a decimal value. On success
* it returns the number of characters processed and the value is stored in
* "val". Otherwise it returns 0 and "val" is garbage.
*/
static int
dtoi(cell * val, char *curptr)
{
char *ptr;
*val = 0;
ptr = curptr;
if (!sc_isdigit(*ptr)) /* should start with digit */
return 0;
while (sc_isdigit(*ptr) || *ptr == '_')
{
if (*ptr != '_')
*val = (*val * 10) + (*ptr - '0');
ptr++;
} /* while */
if (alphanum(*ptr)) /* number must be delimited by non-alphanumerical */
return 0;
if (*ptr == '.' && sc_isdigit(*(ptr + 1)))
return 0; /* but a fractional part must not be present */
return (int)(ptr - curptr);
}
/* htoi
*
* Attempts to interpret a numeric symbol as a hexadecimal value. On
* success it returns the number of characters processed and the value is
* stored in "val". Otherwise it return 0 and "val" is garbage.
*/
static int
htoi(cell * val, char *curptr)
{
char *ptr;
*val = 0;
ptr = curptr;
if (!sc_isdigit(*ptr)) /* should start with digit */
return 0;
if (*ptr == '0' && *(ptr + 1) == 'x')
{ /* C style hexadecimal notation */
ptr += 2;
while (sc_isxdigit(*ptr) || *ptr == '_')
{
if (*ptr != '_')
{
assert(sc_isxdigit(*ptr));
*val = *val << 4;
if (sc_isdigit(*ptr))
*val += (*ptr - '0');
else
*val += (tolower(*ptr) - 'a' + 10);
} /* if */
ptr++;
} /* while */
}
else
{
return 0;
} /* if */
if (alphanum(*ptr))
return 0;
else
return (int)(ptr - curptr);
}
#if defined LINUX
static double
pow10(int value)
{
double res = 1.0;
while (value >= 4)
{
res *= 10000.0;
value -= 5;
} /* while */
while (value >= 2)
{
res *= 100.0;
value -= 2;
} /* while */
while (value >= 1)
{
res *= 10.0;
value -= 1;
} /* while */
return res;
}
#endif
/* ftoi
*
* Attempts to interpret a numeric symbol as a rational number, either as
* IEEE 754 single precision floating point or as a fixed point integer.
* On success it returns the number of characters processed and the value is
* stored in "val". Otherwise it returns 0 and "val" is unchanged.
*
* Small has stricter definition for floating point numbers than most:
* o the value must start with a digit; ".5" is not a valid number, you
* should write "0.5"
* o a period must appear in the value, even if an exponent is given; "2e3"
* is not a valid number, you should write "2.0e3"
* o at least one digit must follow the period; "6." is not a valid number,
* you should write "6.0"
*/
static int
ftoi(cell * val, char *curptr)
{
char *ptr;
double fnum, ffrac, fmult;
unsigned long dnum, dbase;
int i, ignore;
assert(rational_digits >= 0 && rational_digits < 9);
for (i = 0, dbase = 1; i < rational_digits; i++)
dbase *= 10;
fnum = 0.0;
dnum = 0L;
ptr = curptr;
if (!sc_isdigit(*ptr)) /* should start with digit */
return 0;
while (sc_isdigit(*ptr) || *ptr == '_')
{
if (*ptr != '_')
{
fnum = (fnum * 10.0) + (*ptr - '0');
dnum = (dnum * 10L) + (*ptr - '0') * dbase;
} /* if */
ptr++;
} /* while */
if (*ptr != '.')
return 0; /* there must be a period */
ptr++;
if (!sc_isdigit(*ptr)) /* there must be at least one digit after the dot */
return 0;
ffrac = 0.0;
fmult = 1.0;
ignore = FALSE;
while (sc_isdigit(*ptr) || *ptr == '_')
{
if (*ptr != '_')
{
ffrac = (ffrac * 10.0) + (*ptr - '0');
fmult = fmult / 10.0;
dbase /= 10L;
dnum += (*ptr - '0') * dbase;
if (dbase == 0L && sc_rationaltag && rational_digits > 0
&& !ignore)
{
error(222); /* number of digits exceeds rational number precision */
ignore = TRUE;
} /* if */
} /* if */
ptr++;
} /* while */
fnum += ffrac * fmult; /* form the number so far */
if (*ptr == 'e')
{ /* optional fractional part */
int exp, sign;
ptr++;
if (*ptr == '-')
{
sign = -1;
ptr++;
}
else
{
sign = 1;
} /* if */
if (!sc_isdigit(*ptr)) /* 'e' should be followed by a digit */
return 0;
exp = 0;
while (sc_isdigit(*ptr))
{
exp = (exp * 10) + (*ptr - '0');
ptr++;
} /* while */
#if defined LINUX
fmult = pow10(exp * sign);
#else
fmult = pow(10, exp * sign);
#endif
fnum *= fmult;
dnum *= (unsigned long)(fmult + 0.5);
} /* if */
/* decide how to store the number */
if (sc_rationaltag == 0)
{
error(70); /* rational number support was not enabled */
*val = 0;
}
else if (rational_digits == 0)
{
float f = (float) fnum;
/* floating point */
*val = EMBRYO_FLOAT_TO_CELL(f);
#if !defined NDEBUG
/* I assume that the C/C++ compiler stores "float" values in IEEE 754
* format (as mandated in the ANSI standard). Test this assumption anyway.
*/
{
float test1 = 0.0, test2 = 50.0;
Embryo_Cell c1 = EMBRYO_FLOAT_TO_CELL(test1);
Embryo_Cell c2 = EMBRYO_FLOAT_TO_CELL(test2);
if (c1 != 0x00000000L)
{
fprintf(stderr,
"embryo_cc: WARNING! you compiler does not SEEM to interpret IEEE floating\n"
"point math as embryo expects. this could be bad.\n"
"\n"
"(float 0.0 != 0x00000000 bitpattern, 0x%08x instead)\n"
"\n"
"this could be an issue with you compiling embryo with gcc 3.2.x that seems\n"
"to trigger this sanity check. we are not sure why yet, but gcc 3.3.x works\n"
, c1);
}
else if (c2 != 0x42480000L)
{
fprintf(stderr,
"embryo_cc: WARNING! you compiler does not SEEM to interpret IEEE floating\n"
"point math as embryo expects. This could be bad.\n"
"\n"
"(float 50.0 != 0x42480000 bitpattern, 0x%08x instead)\n"
"\n"
"this could be an issue with you compiling embryo with gcc 3.2.x that seems\n"
"to trigger this sanity check. we are not sure why yet, but gcc 3.3.x works\n"
, c2);
}
}
#endif
}
else
{
/* fixed point */
*val = (cell) dnum;
} /* if */
return (int)(ptr - curptr);
}
/* number
*
* Reads in a number (binary, decimal or hexadecimal). It returns the number
* of characters processed or 0 if the symbol couldn't be interpreted as a
* number (in this case the argument "val" remains unchanged). This routine
* relies on the 'early dropout' implementation of the logical or (||)
* operator.
*
* Note: the routine doesn't check for a sign (+ or -). The - is checked
* for at "hier2()" (in fact, it is viewed as an operator, not as a
* sign) and the + is invalid (as in K&R C, and unlike ANSI C).
*/
static int
number(cell * val, char *curptr)
{
int i;
cell value;
if ((i = btoi(&value, curptr)) != 0 /* binary? */
|| (i = htoi(&value, curptr)) != 0 /* hexadecimal? */
|| (i = dtoi(&value, curptr)) != 0) /* decimal? */
{
*val = value;
return i;
}
else
{
return 0; /* else not a number */
} /* if */
}
static void
chrcat(char *str, char chr)
{
str = strchr(str, '\0');
*str++ = chr;
*str = '\0';
}
static int
preproc_expr(cell * val, int *tag)
{
int result;
int idx;
cell code_index;
char *term;
/* Disable staging; it should be disabled already because
* expressions may not be cut off half-way between conditional
* compilations. Reset the staging index, but keep the code
* index.
*/
if (stgget(&idx, &code_index))
{
error(57); /* unfinished expression */
stgdel(0, code_index);
stgset(FALSE);
} /* if */
/* append a special symbol to the string, so the expression
* analyzer won't try to read a next line when it encounters
* an end-of-line
*/
assert(strlen(pline) < sLINEMAX);
term = strchr(pline, '\0');
assert(term != NULL);
chrcat(pline, PREPROC_TERM); /* the "DEL" code (see SC.H) */
result = constexpr(val, tag); /* get value (or 0 on error) */
*term = '\0'; /* erase the token (if still present) */
lexclr(FALSE); /* clear any "pushed" tokens */
return result;
}
/* getstring
* Returns returns a pointer behind the closing quote or to the other
* character that caused the input to be ended.
*/
static char *
getstring(char *dest, int max)
{
assert(dest != NULL);
*dest = '\0';
while (*lptr <= ' ' && *lptr != '\0')
lptr++; /* skip whitespace */
if (*lptr != '"')
{
error(37); /* invalid string */
}
else
{
int len = 0;
lptr++; /* skip " */
while (*lptr != '"' && *lptr != '\0')
{
if (len < max - 1)
dest[len++] = *lptr;
lptr++;
} /* if */
dest[len] = '\0';
if (*lptr == '"')
lptr++; /* skip closing " */
else
error(37); /* invalid string */
} /* if */
return lptr;
}
enum
{
CMD_NONE,
CMD_TERM,
CMD_EMPTYLINE,
CMD_CONDFALSE,
CMD_INCLUDE,
CMD_DEFINE,
CMD_IF,
CMD_DIRECTIVE,
};
/* command
*
* Recognizes the compiler directives. The function returns:
* CMD_NONE the line must be processed
* CMD_TERM a pending expression must be completed before processing further lines
* Other value: the line must be skipped, because:
* CMD_CONDFALSE false "#if.." code
* CMD_EMPTYLINE line is empty
* CMD_INCLUDE the line contains a #include directive
* CMD_DEFINE the line contains a #subst directive
* CMD_IF the line contains a #if/#else/#endif directive
* CMD_DIRECTIVE the line contains some other compiler directive
*
* Global variables: iflevel, skiplevel, elsedone (altered)
* lptr (altered)
*/
static int
command(void)
{
int tok, ret;
cell val;
char *str;
int idx;
cell code_index;
while (*lptr <= ' ' && *lptr != '\0')
lptr += 1;
if (*lptr == '\0')
return CMD_EMPTYLINE; /* empty line */
if (*lptr != '#')
return skiplevel > 0 ? CMD_CONDFALSE : CMD_NONE; /* it is not a compiler directive */
/* compiler directive found */
indent_nowarn = TRUE; /* allow loose indentation" */
lexclr(FALSE); /* clear any "pushed" tokens */
/* on a pending expression, force to return a silent ';' token and force to
* re-read the line
*/
if (!sc_needsemicolon && stgget(&idx, &code_index))
{
lptr = term_expr;
return CMD_TERM;
} /* if */
tok = lex(&val, &str);
ret = skiplevel > 0 ? CMD_CONDFALSE : CMD_DIRECTIVE; /* preset 'ret' to CMD_DIRECTIVE (most common case) */
switch (tok)
{
case tpIF: /* conditional compilation */
ret = CMD_IF;
iflevel += 1;
if (skiplevel)
break; /* break out of switch */
preproc_expr(&val, NULL); /* get value (or 0 on error) */
if (!val)
skiplevel = iflevel;
check_empty(lptr);
break;
case tpELSE:
ret = CMD_IF;
if (iflevel == 0 && skiplevel == 0)
{
error(26); /* no matching #if */
errorset(sRESET);
}
else
{
if (elsedone == iflevel)
error(60); /* multiple #else directives between #if ... #endif */
elsedone = iflevel;
if (skiplevel == iflevel)
skiplevel = 0;
else if (skiplevel == 0)
skiplevel = iflevel;
} /* if */
check_empty(lptr);
break;
#if 0 /* ??? *really* need to use a stack here */
case tpELSEIF:
ret = CMD_IF;
if (iflevel == 0 && skiplevel == 0)
{
error(26); /* no matching #if */
errorset(sRESET);
}
else if (elsedone == iflevel)
{
error(61); /* #elseif directive may not follow an #else */
errorset(sRESET);
}
else
{
preproc_expr(&val, NULL); /* get value (or 0 on error) */
if (skiplevel == 0)
skiplevel = iflevel; /* we weren't skipping, start skipping now */
else if (val)
skiplevel = 0; /* we were skipping, condition is valid -> stop skipping */
/* else: we were skipping and condition is invalid -> keep skipping */
check_empty(lptr);
} /* if */
break;
#endif
case tpENDIF:
ret = CMD_IF;
if (iflevel == 0 && skiplevel == 0)
{
error(26);
errorset(sRESET);
}
else
{
if (skiplevel == iflevel)
skiplevel = 0;
if (elsedone == iflevel)
elsedone = 0; /* ??? actually, should build a stack of #if/#endif and keep
* the state whether an #else was seen per nesting level */
iflevel -= 1;
} /* if */
check_empty(lptr);
break;
case tINCLUDE: /* #include directive */
ret = CMD_INCLUDE;
if (skiplevel == 0)
doinclude();
break;
case tpFILE:
if (skiplevel == 0)
{
char pathname[PATH_MAX];
lptr = getstring(pathname, sizeof pathname);
if (pathname[0] != '\0')
{
free(inpfname);
inpfname = strdup(pathname);
if (!inpfname)
error(103); /* insufficient memory */
} /* if */
} /* if */
check_empty(lptr);
break;
case tpLINE:
if (skiplevel == 0)
{
if (lex(&val, &str) != tNUMBER)
error(8); /* invalid/non-constant expression */
fline = (int)val;
while (*lptr == ' ' && *lptr != '\0')
lptr++; /* skip whitespace */
if (*lptr == '"')
{
char pathname[PATH_MAX];
lptr = getstring(pathname, sizeof pathname);
if (pathname[0] != '\0')
{
free(inpfname);
inpfname = strdup(pathname);
if (!inpfname)
error(103); /* insufficient memory */
} /* if */
}
} /* if */
check_empty(lptr);
break;
case tpASSERT:
if (skiplevel == 0 && (sc_debug & sCHKBOUNDS) != 0)
{
preproc_expr(&val, NULL); /* get constant expression (or 0 on error) */
if (!val)
error(7); /* assertion failed */
check_empty(lptr);
} /* if */
break;
case tpPRAGMA:
if (skiplevel == 0)
{
if (lex(&val, &str) == tSYMBOL)
{
if (strcmp(str, "ctrlchar") == 0)
{
if (lex(&val, &str) != tNUMBER)
error(27); /* invalid character constant */
sc_ctrlchar = (char)val;
}
else if (strcmp(str, "compress") == 0)
{
cell val;
preproc_expr(&val, NULL);
sc_compress = (int)val; /* switch code packing on/off */
}
else if (strcmp(str, "dynamic") == 0)
{
preproc_expr(&sc_stksize, NULL);
}
else if (strcmp(str, "library") == 0)
{
char name[sNAMEMAX + 1];
while (*lptr <= ' ' && *lptr != '\0')
lptr++;
if (*lptr == '"')
{
lptr = getstring(name, sizeof name);
}
else
{
int i;
for (i = 0;
(i < (int)(sizeof(name))) &&
(alphanum(*lptr));
i++, lptr++)
name[i] = *lptr;
name[i] = '\0';
} /* if */
if (name[0] == '\0')
{
curlibrary = NULL;
}
else
{
if (strlen(name) > sEXPMAX)
error(220, name, sEXPMAX); /* exported symbol is truncated */
/* add the name if it does not yet exist in the table */
if (!find_constval(&libname_tab, name, 0))
curlibrary =
append_constval(&libname_tab, name, 0, 0);
} /* if */
}
else if (strcmp(str, "pack") == 0)
{
cell val;
preproc_expr(&val, NULL); /* default = packed/unpacked */
sc_packstr = (int)val;
}
else if (strcmp(str, "rational") == 0)
{
char name[sNAMEMAX + 1];
cell digits = 0;
int i;
/* first gather all information, start with the tag name */
while ((*lptr <= ' ') && (*lptr != '\0'))
lptr++;
for (i = 0;
(i < (int)(sizeof(name))) &&
(alphanum(*lptr));
i++, lptr++)
name[i] = *lptr;
name[i] = '\0';
/* then the precision (for fixed point arithmetic) */
while (*lptr <= ' ' && *lptr != '\0')
lptr++;
if (*lptr == '(')
{
preproc_expr(&digits, NULL);
if (digits <= 0 || digits > 9)
{
error(68); /* invalid rational number precision */
digits = 0;
} /* if */
if (*lptr == ')')
lptr++;
} /* if */
/* add the tag (make it public) and check the values */
i = sc_addtag(name);
exporttag(i);
if (sc_rationaltag == 0
|| (sc_rationaltag == i
&& rational_digits == (int)digits))
{
sc_rationaltag = i;
rational_digits = (int)digits;
}
else
{
error(69); /* rational number format already set, can only be set once */
} /* if */
}
else if (strcmp(str, "semicolon") == 0)
{
cell val;
preproc_expr(&val, NULL);
sc_needsemicolon = (int)val;
}
else if (strcmp(str, "tabsize") == 0)
{
cell val;
preproc_expr(&val, NULL);
sc_tabsize = (int)val;
}
else if (strcmp(str, "align") == 0)
{
sc_alignnext = TRUE;
}
else if (strcmp(str, "unused") == 0)
{
char name[sNAMEMAX + 1];
int i, comma;
symbol *sym;
do
{
/* get the name */
while ((*lptr <= ' ') && (*lptr != '\0'))
lptr++;
for (i = 0;
(i < (int)(sizeof(name))) &&
(sc_isalpha(*lptr));
i++, lptr++)
name[i] = *lptr;
name[i] = '\0';
/* get the symbol */
sym = findloc(name);
if (!sym)
sym = findglb(name);
if (sym)
{
sym->usage |= uREAD;
if (sym->ident == iVARIABLE
|| sym->ident == iREFERENCE
|| sym->ident == iARRAY
|| sym->ident == iREFARRAY)
sym->usage |= uWRITTEN;
}
else
{
error(17, name); /* undefined symbol */
} /* if */
/* see if a comma follows the name */
while (*lptr <= ' ' && *lptr != '\0')
lptr++;
comma = (*lptr == ',');
if (comma)
lptr++;
}
while (comma);
}
else
{
error(207); /* unknown #pragma */
} /* if */
}
else
{
error(207); /* unknown #pragma */
} /* if */
check_empty(lptr);
} /* if */
break;
case tpENDINPUT:
case tpENDSCRPT:
if (skiplevel == 0)
{
check_empty(lptr);
assert(inpf != NULL);
if (inpf != inpf_org)
sc_closesrc(inpf);
inpf = NULL;
} /* if */
break;
#if !defined NOEMIT
case tpEMIT:
{
/* write opcode to output file */
char name[40];
int i;
while (*lptr <= ' ' && *lptr != '\0')
lptr++;
for (i = 0; i < 40 && (sc_isalpha(*lptr) || *lptr == '.'); i++, lptr++)
name[i] = (char)tolower(*lptr);
name[i] = '\0';
stgwrite("\t");
stgwrite(name);
stgwrite(" ");
code_idx += opcodes(1);
/* write parameter (if any) */
while (*lptr <= ' ' && *lptr != '\0')
lptr++;
if (*lptr != '\0')
{
symbol *sym;
tok = lex(&val, &str);
switch (tok)
{
case tNUMBER:
case tRATIONAL:
outval(val, FALSE);
code_idx += opargs(1);
break;
case tSYMBOL:
sym = findloc(str);
if (!sym)
sym = findglb(str);
if (!sym || (sym->ident != iFUNCTN
&& sym->ident != iREFFUNC
&& (sym->usage & uDEFINE) == 0))
{
error(17, str); /* undefined symbol */
}
else
{
outval(sym->addr, FALSE);
/* mark symbol as "used", unknown whether for read or write */
markusage(sym, uREAD | uWRITTEN);
code_idx += opargs(1);
} /* if */
break;
default:
{
char s2[20];
extern char *sc_tokens[]; /* forward declaration */
if (tok < 256)
sprintf(s2, "%c", (char)tok);
else
strcpy(s2, sc_tokens[tok - tFIRST]);
error(1, sc_tokens[tSYMBOL - tFIRST], s2);
break;
} /* case */
} /* switch */
} /* if */
stgwrite("\n");
check_empty(lptr);
break;
} /* case */
#endif
#if !defined NO_DEFINE
case tpDEFINE:
{
ret = CMD_DEFINE;
if (skiplevel == 0)
{
char *pattern, *substitution;
char *start, *end;
int count, prefixlen;
stringpair *def;
/* find the pattern to match */
while (*lptr <= ' ' && *lptr != '\0')
lptr++;
start = lptr; /* save starting point of the match pattern */
count = 0;
while (*lptr > ' ' && *lptr != '\0')
{
litchar(&lptr, FALSE); /* litchar() advances "lptr" and handles escape characters */
count++;
} /* while */
end = lptr;
/* check pattern to match */
if (!sc_isalpha(*start) && *start != '_')
{
error(74); /* pattern must start with an alphabetic character */
break;
} /* if */
/* store matched pattern */
pattern = malloc(count + 1);
if (!pattern)
error(103); /* insufficient memory */
lptr = start;
count = 0;
while (lptr != end)
{
assert(lptr < end);
assert(*lptr != '\0');
pattern[count++] = (char)litchar(&lptr, FALSE);
} /* while */
pattern[count] = '\0';
/* special case, erase trailing variable, because it could match anything */
if (count >= 2 && sc_isdigit(pattern[count - 1])
&& pattern[count - 2] == '%')
pattern[count - 2] = '\0';
/* find substitution string */
while (*lptr <= ' ' && *lptr != '\0')
lptr++;
start = lptr; /* save starting point of the match pattern */
count = 0;
end = NULL;
while (*lptr != '\0')
{
/* keep position of the start of trailing whitespace */
if (*lptr <= ' ')
{
if (!end)
end = lptr;
}
else
{
end = NULL;
} /* if */
count++;
lptr++;
} /* while */
if (!end)
end = lptr;
/* store matched substitution */
substitution = malloc(count + 1); /* +1 for '\0' */
if (!substitution)
error(103); /* insufficient memory */
lptr = start;
count = 0;
while (lptr != end)
{
assert(lptr < end);
assert(*lptr != '\0');
substitution[count++] = *lptr++;
} /* while */
substitution[count] = '\0';
/* check whether the definition already exists */
for (prefixlen = 0, start = pattern;
sc_isalpha(*start) || sc_isdigit(*start) || *start == '_';
prefixlen++, start++)
/* nothing */ ;
assert(prefixlen > 0);
if ((def = find_subst(pattern, prefixlen)))
{
if (strcmp(def->first, pattern) != 0
|| strcmp(def->second, substitution) != 0)
error(201, pattern); /* redefinition of macro (non-identical) */
delete_subst(pattern, prefixlen);
} /* if */
/* add the pattern/substitution pair to the list */
assert(pattern[0] != '\0');
insert_subst(pattern, substitution, prefixlen);
free(pattern);
free(substitution);
} /* if */
break;
} /* case */
case tpUNDEF:
if (skiplevel == 0)
{
if (lex(&val, &str) == tSYMBOL)
{
if (!delete_subst(str, strlen(str)))
error(17, str); /* undefined symbol */
}
else
{
error(20, str); /* invalid symbol name */
} /* if */
check_empty(lptr);
} /* if */
break;
#endif
default:
error(31); /* unknown compiler directive */
ret = skiplevel > 0 ? CMD_DIRECTIVE : CMD_NONE; /* line must be processed (if skiplevel==0) */
} /* switch */
return ret;
}
#if !defined NO_DEFINE
static int
is_startstring(char *string)
{
if (*string == '\"' || *string == '\'')
return TRUE; /* "..." */
if (*string == '!')
{
string++;
if (*string == '\"' || *string == '\'')
return TRUE; /* !"..." */
if (*string == sc_ctrlchar)
{
string++;
if (*string == '\"' || *string == '\'')
return TRUE; /* !\"..." */
} /* if */
}
else if (*string == sc_ctrlchar)
{
string++;
if (*string == '\"' || *string == '\'')
return TRUE; /* \"..." */
if (*string == '!')
{
string++;
if (*string == '\"' || *string == '\'')
return TRUE; /* \!"..." */
} /* if */
} /* if */
return FALSE;
}
static char *
skipstring(char *string)
{
char endquote;
int rawstring = FALSE;
while (*string == '!' || *string == sc_ctrlchar)
{
rawstring = (*string == sc_ctrlchar);
string++;
} /* while */
endquote = *string;
assert(endquote == '\"' || endquote == '\'');
string++; /* skip open quote */
while (*string != endquote && *string != '\0')
litchar(&string, rawstring);
return string;
}
static char *
skippgroup(char *string)
{
int nest = 0;
char open = *string;
char close;
switch (open)
{
case '(':
close = ')';
break;
case '{':
close = '}';
break;
case '[':
close = ']';
break;
case '<':
close = '>';
break;
default:
assert(0);
close = '\0'; /* only to avoid a compiler warning */
} /* switch */
string++;
while (*string != close || nest > 0)
{
if (*string == open)
nest++;
else if (*string == close)
nest--;
else if (is_startstring(string))
string = skipstring(string);
if (*string == '\0')
break;
string++;
} /* while */
return string;
}
static char *
strdel(char *str, size_t len)
{
size_t length = strlen(str);
if (len > length)
len = length;
memmove(str, str + len, length - len + 1); /* include EOS byte */
return str;
}
static char *
strins(char *dest, char *src, size_t srclen)
{
size_t destlen = strlen(dest);
assert(srclen <= strlen(src));
memmove(dest + srclen, dest, destlen + 1); /* include EOS byte */
memcpy(dest, src, srclen);
return dest;
}
static int
substpattern(char *line, size_t buffersize, char *pattern, char *substitution)
{
int prefixlen;
char *p, *s, *e, *args[10];
int match, arg, len;
memset(args, 0, sizeof args);
/* check the length of the prefix */
for (prefixlen = 0, s = pattern; sc_isalpha(*s) || sc_isdigit(*s) || *s == '_';
prefixlen++, s++)
/* nothing */ ;
assert(prefixlen > 0);
assert(strncmp(line, pattern, prefixlen) == 0);
/* pattern prefix matches; match the rest of the pattern, gather
* the parameters
*/
s = line + prefixlen;
p = pattern + prefixlen;
match = TRUE; /* so far, pattern matches */
while (match && *s != '\0' && *p != '\0')
{
if (*p == '%')
{
p++; /* skip '%' */
if (sc_isdigit(*p))
{
arg = *p - '0';
assert(arg >= 0 && arg <= 9);
p++; /* skip parameter id */
assert(*p != '\0');
/* match the source string up to the character after the digit
* (skipping strings in the process
*/
e = s;
while (*e != *p && *e != '\0' && *e != '\n')
{
if (is_startstring(e)) /* skip strings */
e = skipstring(e);
else if (strchr("({[", *e)) /* skip parenthized groups */
e = skippgroup(e);
if (*e != '\0')
e++; /* skip non-alphapetic character (or closing quote of
* a string, or the closing paranthese of a group) */
} /* while */
/* store the parameter (overrule any earlier) */
if (args[arg])
free(args[arg]);
len = (int)(e - s);
args[arg] = malloc(len + 1);
if (!args[arg])
error(103); /* insufficient memory */
strncpy(args[arg], s, len);
args[arg][len] = '\0';
/* character behind the pattern was matched too */
if (*e == *p)
{
s = e + 1;
}
else if (*e == '\n' && *p == ';' && *(p + 1) == '\0'
&& !sc_needsemicolon)
{
s = e; /* allow a trailing ; in the pattern match to end of line */
}
else
{
assert(*e == '\0' || *e == '\n');
match = FALSE;
s = e;
} /* if */
p++;
}
else
{
match = FALSE;
} /* if */
}
else if (*p == ';' && *(p + 1) == '\0' && !sc_needsemicolon)
{
/* source may be ';' or end of the line */
while (*s <= ' ' && *s != '\0')
s++; /* skip white space */
if (*s != ';' && *s != '\0')
match = FALSE;
p++; /* skip the semicolon in the pattern */
}
else
{
cell ch;
/* skip whitespace between two non-alphanumeric characters, except
* for two identical symbols
*/
assert(p > pattern);
if (!alphanum(*p) && *(p - 1) != *p)
while (*s <= ' ' && *s != '\0')
s++; /* skip white space */
ch = litchar(&p, FALSE); /* this increments "p" */
if (*s != ch)
match = FALSE;
else
s++; /* this character matches */
} /* if */
} /* while */
if (match && *p == '\0')
{
/* if the last character to match is an alphanumeric character, the
* current character in the source may not be alphanumeric
*/
assert(p > pattern);
if (alphanum(*(p - 1)) && alphanum(*s))
match = FALSE;
} /* if */
if (match)
{
/* calculate the length of the substituted string */
for (e = substitution, len = 0; *e != '\0'; e++)
{
if (*e == '%' && sc_isdigit(*(e + 1)))
{
arg = *(e + 1) - '0';
assert(arg >= 0 && arg <= 9);
if (args[arg])
len += strlen(args[arg]);
e++; /* skip %, digit is skipped later */
}
else
{
len++;
} /* if */
} /* for */
/* check length of the string after substitution */
if (strlen(line) + len - (int)(s - line) > buffersize)
{
error(75); /* line too long */
}
else
{
/* substitute pattern */
strdel(line, (int)(s - line));
for (e = substitution, s = line; *e != '\0'; e++)
{
if (*e == '%' && sc_isdigit(*(e + 1)))
{
arg = *(e + 1) - '0';
assert(arg >= 0 && arg <= 9);
if (args[arg])
{
strins(s, args[arg], strlen(args[arg]));
s += strlen(args[arg]);
} /* if */
e++; /* skip %, digit is skipped later */
}
else
{
strins(s, e, 1);
s++;
} /* if */
} /* for */
} /* if */
} /* if */
for (arg = 0; arg < 10; arg++)
if (args[arg])
free(args[arg]);
return match;
}
static void
substallpatterns(char *line, int buffersize)
{
char *start, *end;
int prefixlen;
stringpair *subst;
start = line;
while (*start != '\0')
{
/* find the start of a prefix (skip all non-alphabetic characters),
* also skip strings
*/
while (!sc_isalpha(*start) && *start != '_' && *start != '\0')
{
/* skip strings */
if (is_startstring(start))
{
start = skipstring(start);
if (*start == '\0')
break; /* abort loop on error */
} /* if */
start++; /* skip non-alphapetic character (or closing quote of a string) */
} /* while */
if (*start == '\0')
break; /* abort loop on error */
/* get the prefix (length), look for a matching definition */
prefixlen = 0;
end = start;
while (sc_isalpha(*end) || sc_isdigit(*end) || *end == '_')
{
prefixlen++;
end++;
} /* while */
assert(prefixlen > 0);
subst = find_subst(start, prefixlen);
if (subst)
{
/* properly match the pattern and substitute */
if (!substpattern
(start, buffersize - (start - line), subst->first,
subst->second))
start = end; /* match failed, skip this prefix */
/* match succeeded: do not update "start", because the substitution text
* may be matched by other macros
*/
}
else
{
start = end; /* no macro with this prefix, skip this prefix */
} /* if */
} /* while */
}
#endif
/* preprocess
*
* Reads a line by readline() into "pline" and performs basic preprocessing:
* deleting comments, skipping lines with false "#if.." code and recognizing
* other compiler directives. There is an indirect recursion: lex() calls
* preprocess() if a new line must be read, preprocess() calls command(),
* which at his turn calls lex() to identify the token.
*
* Global references: lptr (altered)
* pline (altered)
* freading (referred to only)
*/
void
preprocess(void)
{
int iscommand;
if (!freading)
return;
do
{
readline(pline);
stripcom(pline); /* ??? no need for this when reading back from list file (in the second pass) */
lptr = pline; /* set "line pointer" to start of the parsing buffer */
iscommand = command();
if (iscommand != CMD_NONE)
errorset(sRESET); /* reset error flag ("panic mode") on empty line or directive */
#if !defined NO_DEFINE
if (iscommand == CMD_NONE)
{
assert(lptr != term_expr);
substallpatterns(pline, sLINEMAX);
lptr = pline; /* reset "line pointer" to start of the parsing buffer */
} /* if */
#endif
}
while (iscommand != CMD_NONE && iscommand != CMD_TERM && freading); /* enddo */
}
static char *
unpackedstring(char *lptr, int rawstring)
{
while (*lptr != '\0')
{
/* check for doublequotes indicating the end of the string */
if (*lptr == '\"')
{
/* check whether there's another pair of quotes following.
* If so, paste the two strings together, thus
* "pants""off" becomes "pantsoff"
*/
if (*(lptr + 1) == '\"')
lptr += 2;
else
break;
}
if (*lptr == '\a')
{ /* ignore '\a' (which was inserted at a line concatenation) */
lptr++;
continue;
} /* if */
stowlit(litchar(&lptr, rawstring)); /* litchar() alters "lptr" */
} /* while */
stowlit(0); /* terminate string */
return lptr;
}
static char *
packedstring(char *lptr, int rawstring)
{
int i;
ucell val, c;
i = sizeof(ucell) - (charbits / 8); /* start at most significant byte */
val = 0;
while (*lptr != '\0')
{
/* check for doublequotes indicating the end of the string */
if (*lptr == '\"')
{
/* check whether there's another pair of quotes following.
* If so, paste the two strings together, thus
* "pants""off" becomes "pantsoff"
*/
if (*(lptr + 1) == '\"')
lptr += 2;
else
break;
}
if (*lptr == '\a')
{ /* ignore '\a' (which was inserted at a line concatenation) */
lptr++;
continue;
} /* if */
c = litchar(&lptr, rawstring); /* litchar() alters "lptr" */
if (c >= (ucell) (1 << charbits))
error(43); /* character constant exceeds range */
val |= (c << 8 * i);
if (i == 0)
{
stowlit(val);
val = 0;
} /* if */
i = (i + sizeof(ucell) - (charbits / 8)) % sizeof(ucell);
} /* if */
/* save last code; make sure there is at least one terminating zero character */
if (i != (int)(sizeof(ucell) - (charbits / 8)))
stowlit(val); /* at least one zero character in "val" */
else
stowlit(0); /* add full cell of zeros */
return lptr;
}
/* lex(lexvalue,lexsym) Lexical Analysis
*
* lex() first deletes leading white space, then checks for multi-character
* operators, keywords (including most compiler directives), numbers,
* labels, symbols and literals (literal characters are converted to a number
* and are returned as such). If every check fails, the line must contain
* a single-character operator. So, lex() returns this character. In the other
* case (something did match), lex() returns the number of the token. All
* these tokens have been assigned numbers above 255.
*
* Some tokens have "attributes":
* tNUMBER the value of the number is return in "lexvalue".
* tRATIONAL the value is in IEEE 754 encoding or in fixed point
* encoding in "lexvalue".
* tSYMBOL the first sNAMEMAX characters of the symbol are
* stored in a buffer, a pointer to this buffer is
* returned in "lexsym".
* tLABEL the first sNAMEMAX characters of the label are
* stored in a buffer, a pointer to this buffer is
* returned in "lexsym".
* tSTRING the string is stored in the literal pool, the index
* in the literal pool to this string is stored in
* "lexvalue".
*
* lex() stores all information (the token found and possibly its attribute)
* in global variables. This allows a token to be examined twice. If "_pushed"
* is true, this information is returned.
*
* Global references: lptr (altered)
* fline (referred to only)
* litidx (referred to only)
* _lextok, _lexval, _lexstr
* _pushed
*/
static int _pushed;
static int _lextok;
static cell _lexval;
static char _lexstr[sLINEMAX + 1];
static int _lexnewline;
void
lexinit(void)
{
stkidx = 0; /* index for pushstk() and popstk() */
iflevel = 0; /* preprocessor: nesting of "#if" */
skiplevel = 0; /* preprocessor: skipping lines or compiling lines */
icomment = FALSE; /* currently not in a multiline comment */
_pushed = FALSE; /* no token pushed back into lex */
_lexnewline = FALSE;
}
char *sc_tokens[] = {
"*=", "/=", "%=", "+=", "-=", "<<=", ">>>=", ">>=", "&=", "^=", "|=",
"||", "&&", "==", "!=", "<=", ">=", "<<", ">>>", ">>", "++", "--",
"...", "..",
"assert", "break", "case", "char", "const", "continue", "default",
"defined", "do", "else", "enum", "exit", "for", "forward", "goto",
"if", "native", "new", "operator", "public", "return", "sizeof",
"sleep", "static", "stock", "switch", "tagof", "while",
"#assert", "#define", "#else", "#emit", "#endif", "#endinput",
"#endscript", "#file", "#if", "#include", "#line", "#pragma", "#undef",
";", ";", "-integer value-", "-rational value-", "-identifier-",
"-label-", "-string-"
};
int
lex(cell * lexvalue, char **lexsym)
{
int i, toolong, newline, rawstring;
char **tokptr;
if (_pushed)
{
_pushed = FALSE; /* reset "_pushed" flag */
*lexvalue = _lexval;
*lexsym = _lexstr;
return _lextok;
} /* if */
_lextok = 0; /* preset all values */
_lexval = 0;
_lexstr[0] = '\0';
*lexvalue = _lexval;
*lexsym = _lexstr;
_lexnewline = FALSE;
if (!freading)
return 0;
newline = (lptr == pline); /* does lptr point to start of line buffer */
while (*lptr <= ' ')
{ /* delete leading white space */
if (*lptr == '\0')
{
preprocess(); /* preprocess resets "lptr" */
if (!freading)
return 0;
if (lptr == term_expr) /* special sequence to terminate a pending expression */
return (_lextok = tENDEXPR);
_lexnewline = TRUE; /* set this after preprocess(), because
* preprocess() calls lex() recursively */
newline = TRUE;
}
else
{
lptr += 1;
} /* if */
} /* while */
if (newline)
{
stmtindent = 0;
for (i = 0; i < (int)(lptr - pline); i++)
if (pline[i] == '\t' && sc_tabsize > 0)
stmtindent +=
(int)(sc_tabsize - (stmtindent + sc_tabsize) % sc_tabsize);
else
stmtindent++;
} /* if */
i = tFIRST;
tokptr = sc_tokens;
while (i <= tMIDDLE)
{ /* match multi-character operators */
if (match(*tokptr, FALSE))
{
_lextok = i;
return _lextok;
} /* if */
i += 1;
tokptr += 1;
} /* while */
while (i <= tLAST)
{ /* match reserved words and compiler directives */
if (match(*tokptr, TRUE))
{
_lextok = i;
errorset(sRESET); /* reset error flag (clear the "panic mode") */
return _lextok;
} /* if */
i += 1;
tokptr += 1;
} /* while */
if ((i = number(&_lexval, lptr)) != 0)
{ /* number */
_lextok = tNUMBER;
*lexvalue = _lexval;
lptr += i;
}
else if ((i = ftoi(&_lexval, lptr)) != 0)
{
_lextok = tRATIONAL;
*lexvalue = _lexval;
lptr += i;
}
else if (alpha(*lptr))
{ /* symbol or label */
/* Note: only sNAMEMAX characters are significant. The compiler
* generates a warning if a symbol exceeds this length.
*/
_lextok = tSYMBOL;
i = 0;
toolong = 0;
while (alphanum(*lptr))
{
_lexstr[i] = *lptr;
lptr += 1;
if (i < sNAMEMAX)
i += 1;
else
toolong = 1;
} /* while */
_lexstr[i] = '\0';
if (toolong)
error(200, _lexstr, sNAMEMAX); /* symbol too long, truncated to sNAMEMAX chars */
if (_lexstr[0] == PUBLIC_CHAR && _lexstr[1] == '\0')
{
_lextok = PUBLIC_CHAR; /* '@' all alone is not a symbol, it is an operator */
}
else if (_lexstr[0] == '_' && _lexstr[1] == '\0')
{
_lextok = '_'; /* '_' by itself is not a symbol, it is a placeholder */
} /* if */
if (*lptr == ':' && sc_allowtags && _lextok != PUBLIC_CHAR)
{
_lextok = tLABEL; /* it wasn't a normal symbol, it was a label/tagname */
lptr += 1; /* skip colon */
} /* if */
}
else if (*lptr == '\"' || (*lptr == sc_ctrlchar && *(lptr + 1) == '\"'))
{ /* unpacked string literal */
_lextok = tSTRING;
rawstring = (*lptr == sc_ctrlchar);
*lexvalue = _lexval = litidx;
lptr += 1; /* skip double quote */
if (rawstring)
lptr += 1; /* skip "escape" character too */
lptr =
sc_packstr ? packedstring(lptr, rawstring) : unpackedstring(lptr,
rawstring);
if (*lptr == '\"')
lptr += 1; /* skip final quote */
else
error(37); /* invalid (non-terminated) string */
}
else if ((*lptr == '!' && *(lptr + 1) == '\"')
|| (*lptr == '!' && *(lptr + 1) == sc_ctrlchar && *(lptr + 2) == '\"')
|| (*lptr == sc_ctrlchar && *(lptr + 1) == '!'
&& *(lptr + 2) == '\"'))
{ /* packed string literal */
_lextok = tSTRING;
rawstring = (*lptr == sc_ctrlchar || *(lptr + 1) == sc_ctrlchar);
*lexvalue = _lexval = litidx;
lptr += 2; /* skip exclamation point and double quote */
if (rawstring)
lptr += 1; /* skip "escape" character too */
lptr =
sc_packstr ? unpackedstring(lptr, rawstring) : packedstring(lptr,
rawstring);
if (*lptr == '\"')
lptr += 1; /* skip final quote */
else
error(37); /* invalid (non-terminated) string */
}
else if (*lptr == '\'')
{ /* character literal */
lptr += 1; /* skip quote */
_lextok = tNUMBER;
*lexvalue = _lexval = litchar(&lptr, FALSE);
if (*lptr == '\'')
lptr += 1; /* skip final quote */
else
error(27); /* invalid character constant (must be one character) */
}
else if (*lptr == ';')
{ /* semicolumn resets "error" flag */
_lextok = ';';
lptr += 1;
errorset(sRESET); /* reset error flag (clear the "panic mode") */
}
else
{
_lextok = *lptr; /* if every match fails, return the character */
lptr += 1; /* increase the "lptr" pointer */
} /* if */
return _lextok;
}
/* lexpush
*
* Pushes a token back, so the next call to lex() will return the token
* last examined, instead of a new token.
*
* Only one token can be pushed back.
*
* In fact, lex() already stores the information it finds into global
* variables, so all that is to be done is set a flag that informs lex()
* to read and return the information from these variables, rather than
* to read in a new token from the input file.
*/
void
lexpush(void)
{
assert(_pushed == FALSE);
_pushed = TRUE;
}
/* lexclr
*
* Sets the variable "_pushed" to 0 to make sure lex() will read in a new
* symbol (a not continue with some old one). This is required upon return
* from Assembler mode.
*/
void
lexclr(int clreol)
{
_pushed = FALSE;
if (clreol)
{
lptr = strchr(pline, '\0');
assert(lptr != NULL);
} /* if */
}
/* matchtoken
*
* This routine is useful if only a simple check is needed. If the token
* differs from the one expected, it is pushed back.
*/
int
matchtoken(int token)
{
cell val;
char *str;
int tok;
tok = lex(&val, &str);
if (tok == token || (token == tTERM && (tok == ';' || tok == tENDEXPR)))
{
return 1;
}
else if (!sc_needsemicolon && token == tTERM && (_lexnewline || !freading))
{
lexpush(); /* push "tok" back, we use the "hidden" newline token */
return 1;
}
else
{
lexpush();
return 0;
} /* if */
}
/* tokeninfo
*
* Returns additional information of a token after using "matchtoken()"
* or needtoken(). It does no harm using this routine after a call to
* "lex()", but lex() already returns the same information.
*
* The token itself is the return value. Normally, this one is already known.
*/
int
tokeninfo(cell * val, char **str)
{
/* if the token was pushed back, tokeninfo() returns the token and
* parameters of the *next* token, not of the *current* token.
*/
assert(!_pushed);
*val = _lexval;
*str = _lexstr;
return _lextok;
}
/* needtoken
*
* This routine checks for a required token and gives an error message if
* it isn't there (and returns FALSE in that case).
*
* Global references: _lextok;
*/
int
needtoken(int token)
{
char s1[20], s2[20];
if (matchtoken(token))
{
return TRUE;
}
else
{
/* token already pushed back */
assert(_pushed);
if (token < 256)
sprintf(s1, "%c", (char)token); /* single character token */
else
strcpy(s1, sc_tokens[token - tFIRST]); /* multi-character symbol */
if (!freading)
strcpy(s2, "-end of file-");
else if (_lextok < 256)
sprintf(s2, "%c", (char)_lextok);
else
strcpy(s2, sc_tokens[_lextok - tFIRST]);
error(1, s1, s2); /* expected ..., but found ... */
return FALSE;
} /* if */
}
/* match
*
* Compares a series of characters from the input file with the characters
* in "st" (that contains a token). If the token on the input file matches
* "st", the input file pointer "lptr" is adjusted to point to the next
* token, otherwise "lptr" remains unaltered.
*
* If the parameter "end: is true, match() requires that the first character
* behind the recognized token is non-alphanumeric.
*
* Global references: lptr (altered)
*/
static int
match(char *st, int end)
{
int k;
char *ptr;
k = 0;
ptr = lptr;
while (st[k])
{
if (st[k] != *ptr)
return 0;
k += 1;
ptr += 1;
} /* while */
if (end)
{ /* symbol must terminate with non-alphanumeric char */
if (alphanum(*ptr))
return 0;
} /* if */
lptr = ptr; /* match found, skip symbol */
return 1;
}
/* stowlit
*
* Stores a value into the literal queue. The literal queue is used for
* literal strings used in functions and for initializing array variables.
*
* Global references: litidx (altered)
* litq (altered)
*/
void
stowlit(cell value)
{
if (litidx >= litmax)
{
cell *p;
litmax += sDEF_LITMAX;
p = (cell *) realloc(litq, litmax * sizeof(cell));
if (!p)
error(102, "literal table"); /* literal table overflow (fatal error) */
litq = p;
} /* if */
assert(litidx < litmax);
litq[litidx++] = value;
}
/* litchar
*
* Return current literal character and increase the pointer to point
* just behind this literal character.
*
* Note: standard "escape sequences" are suported, but the backslash may be
* replaced by another character; the syntax '\ddd' is supported,
* but ddd must be decimal!
*/
static cell
litchar(char **lptr, int rawmode)
{
cell c = 0;
unsigned char *cptr;
cptr = (unsigned char *)*lptr;
if (rawmode || *cptr != sc_ctrlchar)
{ /* no escape character */
c = *cptr;
cptr += 1;
}
else
{
cptr += 1;
if (*cptr == sc_ctrlchar)
{
c = *cptr; /* \\ == \ (the escape character itself) */
cptr += 1;
}
else
{
switch (*cptr)
{
case 'a': /* \a == audible alarm */
c = 7;
cptr += 1;
break;
case 'b': /* \b == backspace */
c = 8;
cptr += 1;
break;
case 'e': /* \e == escape */
c = 27;
cptr += 1;
break;
case 'f': /* \f == form feed */
c = 12;
cptr += 1;
break;
case 'n': /* \n == NewLine character */
c = 10;
cptr += 1;
break;
case 'r': /* \r == carriage return */
c = 13;
cptr += 1;
break;
case 't': /* \t == horizontal TAB */
c = 9;
cptr += 1;
break;
case 'v': /* \v == vertical TAB */
c = 11;
cptr += 1;
break;
case '\'': /* \' == ' (single quote) */
case '"': /* \" == " (single quote) */
case '%': /* \% == % (percent) */
c = *cptr;
cptr += 1;
break;
default:
if (sc_