int
crackident (char *s)
{
struct keywords {
char *k_name; /* the keyword string itself. */
short k_token; /* yacc %token for the keyword */
short k_yylval; /* the value associated with token.*/
};
static struct keywords kw[] = {
/* Control flow keywords.
*/
{ "while", Y_WHILE, 0 }, { "if", Y_IF, 0 },
{ "else", Y_ELSE, 0 }, { "switch", Y_SWITCH, 0 },
{ "case", Y_CASE, 0 }, { "default", Y_DEFAULT, 0 },
{ "break", Y_BREAK, 0 }, { "next", Y_NEXT, 0 },
{ "return", Y_RETURN, 0 }, { "goto", Y_GOTO, 0 },
{ "for", Y_FOR, 0 }, { "procedure", Y_PROCEDURE, 0 },
{ "begin", Y_BEGIN, 0 }, { "end", Y_END, 0 },
{ "iferr", Y_IFERR, 0 }, { "ifnoerr", Y_IFNOERR, 0 },
{ "then", Y_THEN, 0 },
/* Parameter and variable types.
*/
{ "int", Y_INT, 0 }, { "char", Y_STRING, 0 },
{ "real", Y_REAL, 0 }, { "string", Y_STRING, 0 },
{ "file", Y_FILE, 0 }, { "gcur", Y_GCUR, 0 },
{ "imcur", Y_IMCUR, 0 }, { "ukey", Y_UKEY, 0 },
{ "pset", Y_PSET, 0 }, { "bool", Y_BOOL, 0 },
{ "struct", Y_STRUCT, 0 },
/* debugging commands.
*/
{ "d_d", D_D, 0 },
{ "d_peek", D_PEEK, 0 },
{ "", 0, 0 } /* sentinel; leave it here... */
};
static struct keywords kf[] = {
/* Keywords of intrinsic functions that get built into
* the grammar. Most intrinsics handled by intrinsic().
*/
{ "scan", Y_SCAN, 0 },
{ "scanf", Y_SCANF, 0 },
{ "fscan", Y_FSCAN, 0 },
{ "fscanf", Y_FSCANF, 0 },
/* sentinel; leave it here... */
{ "", 0, 0 }
};
register struct keywords *kp;
XINT oldtopd;
static char sch, kch; /* static storage is faster here */
char *scopy; /* non-makelower'd copy */
char sb[REALWIDTH];
oldtopd = topd; /* save topd */
scopy = comdstr(s); /* make a copy in the dictionary */
makelower (scopy); /* make it lower case for compares */
topd = oldtopd; /*restore topd but scopy still there!*/
/* Put the first character of the identifier we are searching for
* in local storage to permit fast rejection of keywords without all
* the overhead involved in a call to strcmp. This is an easy way
* to speed things up several times w/o coding fancy data structures.
*/
sch = *scopy;
kch = *s; /* save original string */
/* Check for and handle special-case keywords first.
*/
if (sch == *truestr && !strcmp (scopy, truestr)) {
yylval = addconst (truestr, OT_BOOL);
return (Y_CONSTANT);
} else if (sch == *falsestr && !strcmp (scopy, falsestr)) {
yylval = addconst (falsestr, OT_BOOL);
return (Y_CONSTANT);
} else if (sch == *indeflc && !strcmp (scopy, indeflc)) {
yylval = addconst (scopy, OT_INT);
return (Y_CONSTANT);
} else if (sch == *eoflc && !strcmp (scopy, eoflc)) {
yylval = addconst (CL_EOFSTR, OT_INT);
return (Y_CONSTANT);
} else if (sch == *errorstr && !strcmp (scopy, errorstr)) {
yylval = addconst (errorstr, OT_STRING);
return (Y_IDENT);
/* Check for defined numerical constants. For backwards compatability
* we match 'epsilon', however this particular value is deprecated by
* the fp_equal() builtin and we assume CL constants will be upper
* case strings.
*/
} else if ((sch == *epsilonstr && !strcmp (scopy, epsilonstr)) ||
(kch == *epsilonuc && !strcmp (s, epsilonuc))) {
sprintf (sb, "%e", EPSILON);
yylval = addconst (sb, OT_REAL);
return (Y_CONSTANT);
} else if (const_str (pistr)) { retconst (PI);
} else if (const_str (twopistr)) { retconst (TWOPI);
} else if (const_str (fourpistr)) { retconst (FOURPI);
} else if (const_str (halfpistr)) { retconst (HALFPI);
} else if (const_str (sqrtpistr)) { retconst (SQRTOFPI);
} else if (const_str (sqrttwostr)) { retconst (SQRTOF2);
} else if (const_str (baseestr)) { retconst (BASE_E);
} else if (const_str (ln2str)) { retconst (LN_2);
} else if (const_str (ln10str)) { retconst (LN_10);
} else if (const_str (lnpistr)) { retconst (LN_PI);
} else if (const_str (logestr)) { retconst (LOG_E);
} else if (const_str (gammastr)) { retconst (GAMMA);
} else if (const_str (radianstr)) { retconst (RADIAN);
} else if (const_str (austr)) { retconst (AU);
} else if (const_str (gaccelstr)) { retconst (GRAV_ACCEL);
} else if (const_str (gconststr)) { retconst (GRAV_CONST);
} else if (const_str (lystr)) { retconst (LIGHT_YEAR);
} else if (const_str (parsecstr)) { retconst (PARSEC);
} else if (const_str (lightstr)) { retconst (SPEED_OF_LIGHT);
} else if (const_str (solmassstr)) { retconst (SOLAR_MASS);
} else if (!inarglist && parenlevel == 0) {
/* Search the keyword list; kewords are not recognized in argument
* lists and expressions, else unquoted strings like "for" and
* "file" will cause syntax errors.
*/
for (kp=kw; (kch = *kp->k_name); kp++)
if (kch == sch)
if (strcmp (scopy, kp->k_name) == 0) {
yylval = kp->k_yylval;
return (kp->k_token);
}
} else {
/* Search the list of intrinsic functions.
*/
for (kp=kf; (kch = *kp->k_name); kp++)
if (kch == sch)
if (strcmp (scopy, kp->k_name) == 0) {
yylval = kp->k_yylval;
return (kp->k_token);
}
}
/* S not a keyword, so it's just an identifier.
*/
yylval = addconst (s, OT_STRING); /* use original */
return (Y_IDENT);
}
/* LEXICON -- Simple "conversational mode" lexical analyser. Lexical analysis
* in the CL is carried out by a dual mode lexical analyser. In conversational
* mode there are few tokens and few special characters; arguments are
* delimited by whitespace and may contain nonalphanumeric characters. Few
* strings have to be quoted. In computational mode the arithmetic operators
* are recognized and arguments must be delimited by commas. Computational
* mode is in effect whenever the parenlevel is nonzero.
*
* The two modes are implemented with two separate lexical analyzers. Gettok
* implements conversational mode, while computational mode is implemented with
* a LEX finite state automaton. Gettok recognizes the following special chars:
*
* [ \t] argument delimiter
* ["'] string
* \n newline
* \ single character escape
* ! os escape
* # comment
* & spawn background job
* ( lparen
* + plus (switch)
* - minus (switch)
* ; eost
* = equals
* += add and set
* -= subtract and set
* *= multiply and set
* /= divide and set
* < redirin
* > redir
* >& allredir
* >> append
* >>& allappend
* >(G|I|P|)+ graphics stream redirection
* { lbrace
* | pipe
* |& allpipe
* } rbrace
* [ beginning of index list
* ] end of index list
*
* The history metacharacter ^ is processed before input is passed to the
* lexical analyser. Any sequence of nonwhite characters that does not form
* one of the recognized tokens is returned as a string.
*/
int
lexicon (void)
{
char *bkgerr = "ERROR: cannot submit background job inside {}\n";
register int ch, cch;
register int token;
int stringtok, identifier, setlevel;
int clswitch;
char *op, *index();
/* Return pushed back token if any.
*/
if (pbtoken) {
token = pbtoken;
pbtoken = 0;
return (token);
}
/* Skip leading whitespace. If whitespace is seen and we are in an
* argument list (according to the parser) set flag to output the
* comma argument delimiter if the next token begins an argument.
* If whitespace or = is seen (except whitespace at the beginning of
* a command) then set LHS to false, turning [] off as conversational
* mode metacharacters (they will be automatically turned on when
* compute mode is entered in an expression).
*/
while (ch = input())
if (ch == ' ' || ch == '\t') {
space: if (lexcol > 0)
lhs = 0;
if (inarglist)
newarg++;
} else if (ch == '\\') {
if ((ch = input()) != '\n') {
unput (ch);
break;
} else
goto space;
} else
break;
/* Start new token.
*/
if (ch) {
unput (ch);
yyleng = 0;
if (!inarglist)
newarg = 0;
} else
return (0);
/* Identify and accumulate next token. Simple tokens are returned as
* integer constants, more complex tokens as operand structures in
* yylval.
*/
while (ch = input()) {
lexcol++;
switch (ch) {
case '&':
/* An ampersand triggers bkg execution in command mode, unless
* it occurs in a token such as >& or >>&, in which case we
* never get here.
*/
if (!newtoken) {
unput (ch);
goto tokout_;
} else {
while (ch = input()) {
if (ch == ' ' || ch == '\t')
continue;
else {
char bkgmsg[SZ_LINE+1];
int n = SZ_LINE;
op = bkgmsg;
unput (ch);
if (bracelevel) {
eprintf (bkgerr);
return ('#');
}
while (--n >= 0 && (*op = input()) != '\n')
op++;
*op = EOS;
bkg_init (bkgmsg);
return (Y_NEWLINE);
}
}
return (0);
}
case ';':
case '\n':
lexcol = 0;
lhs = 1;
goto etok_;
case '\t':
case ' ':
if (lexcol > 0)
lhs = 0;
goto etok_;
case '[':
case ']':
/* [] are recognized as command mode metacharacters only
* on the left hand side of an assignment statement.
*/
if (!lhs)
goto deposit_;
/* Fall through */
case '{':
case '}':
/* We want to distinguish here between the use of {} for
* the set selection operator in template strings, and the
* conventional compound statement operator. The distinction
* is that { is recognized as a token only if occurs at the
* beginning of a token, and } is recognized as a separate
* token when inside a token only if it matches a { in the
* same token. Hence, alpha{xxx} is a single token in command
* mode, whereas {xxx} is 3 tokens, the same as { xxx },
* and xxx} is the same as xxx }. Usage is completely
* unambiguous if the { or } is preceded by a space.
*/
if (newtoken)
return (ch);
if (stringtok) {
if (ch == '{')
setlevel++;
else if (setlevel == 0)
goto etok_; /* } does not match { */
else
--setlevel;
goto deposit_;
}
/* fall through */
case '=':
etok_: if (!newtoken) {
unput (ch);
goto tokout_;
} else if (ch == '\n') {
return (Y_NEWLINE);
} else if (ch == '=') {
token = ch;
lhs = 0;
goto eatwhite_;
} else
return (ch);
case '?':
/* ?, ?? menu commands, recognized only at beginning of stmt */
if (lexcol > 1) {
goto deposit_;
} else if (ch = input()) {
if (ch == '?')
return (crackident ("??"));
else {
unput (ch);
return (crackident ("?"));
}
} else
return (0);
case '+':
case '-':
/* Plus and minus are recognized as the switch operators for
* boolean parameters only if encountered while accumulating
* a token and if followed by an argument delimiter, i.e.,
* space, tab, newline, or semicolon. If found at the beginning
* of a token they are returned as a separate token and will be
* interpreted by the parser as unary plus or minus.
*/
if (newtoken) {
if (newarg) {
cch = input();
if (cch == 0)
return (0);
unput (cch);
if (ch == '-' && isdigit (cch)) {
unput (ch);
newarg = 0;
return (',');
} else {
/* Not number; treat +- as a string char.
*/
goto deposit_;
}
} else {
cch = input();
if (cch == 0)
return (0);
if (cch == '=') {
if (ch == '+')
return (YOP_AOADD);
else
return (YOP_AOSUB);
} else if (isdigit (cch)) {
unput (cch);
return (ch);
} else {
unput (cch);
goto deposit_;
}
}
} else if (cch = input()) {
clswitch = (isspace (cch) || cch == ';');
if (cch == '=') {
unput(cch);
unput (ch);
goto tokout_;
}
unput (cch);
if (clswitch) {
pbtoken = ch;
goto tokout_;
} else
goto deposit_;
} else
return (0);
case '"':
case '\'':
if (!newtoken) {
unput (ch);
goto tokout_;
} else if (newarg) {
unput (ch);
newarg = 0;
return (',');
} else {
traverse (ch);
yylval = addconst (yytext, OT_STRING);
return (Y_CONSTANT);
}
case '\\':
if (ch = input()) {
if (ch == '\n')
continue;
else if (index ("&;=+-\"'\\#><()|", ch) != NULL)
goto deposit_; /* put ch in string */
else
goto escape_; /* put \ch in string */
} else
return (0);
case '!':
/* OS escape is only recognized when the ! occurs as the first
* token in a statement.
*/
if (lexcol > 1)
goto deposit_;
/* Accumulate command. Newline may be escaped to enter a long
* command, but all other escapes are passed on unmodified.
*/
while ((ch = input()) && ch != '\n') {
if (ch == '\\')
if (ch = input()) {
if (ch == '\n')
continue;
else
yytext[yyleng++] = '\\';
} else
break;
yytext[yyleng++] = ch;
}
if (ch)
unput (ch);
yytext[yyleng] = '\0';
yylval = addconst (yytext, OT_STRING);
return (Y_OSESC);
case '#':
/* Discard the comment line. */
while ((ch = input()) && ch != '\n')
;
if (ch) {
unput (ch);
continue;
} else
return (0);
case '>':
case '<':
case '(':
/* These characters are alike in that they all begin a new
* argument when found in an argument list.
*/
if (!newtoken) {
unput (ch);
goto tokout_;
} else if (newarg) {
unput (ch);
newarg = 0;
return (',');
} else if (ch == '<') {
token = ch;
goto eatwhite_;
} else if (ch == '>') {
ch = input();
if (ch == 0) {
return ('>');
} else if (ch == '>') {
ch = input();
if (ch == 0) {
return (Y_APPEND);
} else if (ch == 'G' || ch == 'I' || ch == 'P') {
op = yytext;
*op++ = '>';
*op++ = '>';
*op++ = ch;
goto gsredir_;
} else if (ch == '&') {
token = Y_ALLAPPEND;
goto eatwhite_;
} else {
unput (ch);
token = Y_APPEND;
goto eatwhite_;
}
} else if (ch == 'G' || ch == 'I' || ch == 'P') {
/* Graphics stream redirection.
*/
op = yytext;
*op++ = '>';
*op++ = ch;
gsredir_:
ch = input();
while (ch == 'G' || ch == 'I' || ch == 'P') {
*op++ = ch;
ch = input();
}
unput (ch);
*op = EOS;
yylval = addconst (yytext, OT_STRING);
token = Y_GSREDIR;
goto eatwhite_;
} else if (ch == '&') {
token = Y_ALLREDIR;
goto eatwhite_;
} else {
unput (ch);
token = '>';
goto eatwhite_;
}
} else
return ('(');
case '|':
if (!newtoken) {
unput (ch);
goto tokout_;
} else if (ch = input()) {
if (ch == '&')
return (Y_ALLPIPE);
else {
unput (ch);
return ('|');
}
} else
return (0);
case '*':
case '/':
cch = input();
if (cch == 0)
return (0);
if (newtoken) {
if (cch == '=')
return ((ch=='*') ? YOP_AOMUL:YOP_AODIV);
else {
unput (cch);
goto deposit_;
}
} else {
if (cch == '=') {
unput (cch);
unput (ch);
goto tokout_;
} else {
unput (cch);
goto deposit_;
}
}
/* The following cases are included to force the compiler
* to compile the case as an ASCII jump table.
*/
case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':
case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':
case 's': case 't': case 'u': case 'v': case 'w': case 'x':
case 'y': case 'z':
case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':
case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':
case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':
case 'Y': case 'Z':
/* fall through to default */
default:
goto deposit_;
escape_:
/* Deposit a character preceded by the escape character.
*/
if (!newarg) {
unput (ch);
ch = '\\';
}
deposit_:
/* If the last token returned was a string argument and we
* are starting a second, a delimiter token must be returned
* to delimit the two arguments. Check for chars not legal
* in an identifier so that we can know whether to return
* CONSTANT or call crackident() which returns IDENT if not
* a reserved keyword.
*/
if (newtoken) {
identifier = 1;
stringtok = 1;
setlevel = 0;
if (newarg) {
unput (ch);
newarg = 0;
return (',');
}
}
yytext[yyleng++] = ch;
if (ch == '[') {
while ((ch = input()) != ']')
yytext[yyleng++] = ch;
yytext[yyleng++] = ch;
} else if (ch == '\\')
yytext[yyleng++] = ch = input();
else if (!(isalnum(ch) || ch == '_' || ch == '$' || ch == '.'))
identifier = 0;
}
}
tokout_:
yytext[yyleng] = '\0';
if (isdigit (yytext[0]) || yytext[0] == '.' && isdigit (yytext[1])) {
int token, toklen;
token = c_lexnum (yytext, &toklen);
if (token != LEX_NONNUM && toklen == yyleng) {
switch (token) {
case LEX_REAL:
yylval = addconst (yytext, OT_REAL);
break;
default:
yylval = addconst (yytext, OT_INT);
break;
}
return (Y_CONSTANT);
}
}
if (identifier)
return (crackident (yytext));
else {
yylval = addconst (yytext, OT_STRING);
return (Y_CONSTANT);
}
eatwhite_:
/* Control transfers here after a token has been identified which is
* followed by an associated argument (e.g. > file or < file). Our
* function is to discard any whitespace following the current token
* in order to make whitespace optional in the input at this point.
* This makes "> file" (for example) equivalent to ">file".
*/
newarg = 0;
while ((ch = input()) && (ch == ' ' || ch == '\t'))
;
if (ch) {
unput (ch);
return (token);
} else
return (0);
}
static void doagentcmd(FILE *str,char *line)
{
char *agentname;
char *instances;
char *inst;
char *ptr;
char regline[500];
char cumlname[100];
REGINFO regs[100];
char temp[20];
int rmax = 0;
int idx;
unsigned int cumlmask;
int agentidx;
agentname = gettoken(&line);
instances = gettoken(&line);
if (!instances) {
strcpy(temp,"*");
instances = temp;
}
fprintf(stderr,"Agent %s Instances %s\n",agentname,instances);
if (agentcnt == MAXAGENTS) {
fatal("Out of agent slots\n",NULL);
}
agentnames[agentcnt] = strdup(agentname);
agentidx = agentcnt;
agentcnt++;
regline[0] = '\0';
while ((readline(str,regline,sizeof(regline)) >= 0) && (rmax < 100)) {
char *atext,*subinst,*pfunc,*descr;
if (regline[0] == '!') break;
ptr = regline;
atext = gettoken(&ptr);
subinst = gettoken(&ptr);
pfunc = gettoken(&ptr);
descr = gettoken(&ptr);
if (!descr) {
fatal("Missing fields for ",atext);
}
regs[rmax].reg_addr = strdup(atext);
regs[rmax].reg_subinst = strdup(subinst);
regs[rmax].reg_printfunc = strdup(pfunc);
regs[rmax].reg_description = strdup(descr);
regs[rmax].reg_mask = 0;
rmax++;
}
if (rmax == 100) fatal("Too many registers in section ",agentname);
inst = strtok(instances,",");
cumlmask = 0;
while (inst) {
char defname[100];
unsigned int curmask;
sprintf(defname,"SOC_AGENT_%s%s",
agentname,inst[0] == '*' ? "" : inst);
curmask = newmask();
cumlmask |= curmask;
addconst(defname,curmask);
for (idx = 0; idx < rmax; idx++) {
char descr[100];
char atext[200];
macroexpand(regs[idx].reg_addr,inst,atext);
#if 0
strcpy(descr,agentname);
if (inst[0] != '*') {
strcat(descr,inst);
}
strcat(descr," ");
if (regs[idx].reg_subinst[0] != '*') {
strcat(descr,regs[idx].reg_subinst);
strcat(descr," ");
}
strcat(descr,regs[idx].reg_description);
#else
strcpy(descr,regs[idx].reg_description);
#endif
addreg(agentname,
agentidx,
curmask,
atext,
inst,
regs[idx].reg_subinst,
regs[idx].reg_printfunc,
descr);
}
inst = strtok(NULL,",");
}
if (instances[0] != '*') {
sprintf(cumlname,"SOC_AGENT_%s",agentname);
addconst(cumlname,cumlmask);
}
}
