/******************************************************************************
*
* ELMER, A Computational Fluid Dynamics Program.
*
* Copyright 1st April 1995 - , Center for Scientific Computing,
* Finland.
*
* All rights reserved. No part of this program may be used,
* reproduced or transmitted in any form or by any means
* without the written permission of CSC.
*
******************************************************************************/
/*******************************************************************************
*
* MATC language/expression parser.
*
*******************************************************************************
*
* Author: Juha Ruokolainen
*
* Address: Center for Scientific Computing
* Tietotie 6, P.O. BOX 405
* 02101 Espoo, Finland
* Tel. +358 0 457 2723
* Telefax: +358 0 457 2302
* EMail: Juha.Ruokolainen@csc.fi
*
* Date: 30 May 1996
*
* Modified by:
*
* Date of modification:
*
******************************************************************************/
/***********************************************************************
|
| PARSER.C - Last Edited 8. 8. 1988
|
***********************************************************************/
/*======================================================================
|Syntax of the manual pages:
|
|FUNCTION NAME(...) params ...
|
$ usage of the function and type of the parameters
? explane the effects of the function
= return value and the type of value if not of type int
@ globals effected directly by this routine
! current known bugs or limitations
& functions called by this function
~ these functions may interest you as an alternative function or
| because they control this function somehow
^=====================================================================*/
/*
* $Id: parser.c,v 1.5 2006/11/22 10:57:14 jpr Exp $
*
* $Log: parser.c,v $
* Revision 1.5 2006/11/22 10:57:14 jpr
* *** empty log message ***
*
* Revision 1.4 2006/02/02 06:54:44 jpr
* small formatting changes.
*
* Revision 1.2 2005/05/27 12:26:21 vierinen
* changed header install location
*
* Revision 1.1.1.1 2005/04/14 13:29:14 vierinen
* initial matc automake package
*
* Revision 1.2 1998/08/01 12:34:54 jpr
*
* Added Id, started Log.
*
*
*/
#include "elmer/matc.h"
static SYMTYPE symbol, bendsym;
static char *str, csymbol[4096], buf[4096];
int char_in_list(int ch, char *list)
{
char *p;
for(p = list; *p != '\0'; p++)
if (*p == ch) return TRUE;
return FALSE;
}
void scan()
{
char *p, ch;
int i;
symbol = nullsym;
if ( *str == '\0' ) return;
while( isspace(*str) ) str++;
if (*str == '\0') return;
p = str;
if (isdigit(*str) || (*str == '.' && isdigit(*(str+1))))
{
str++; while(isdigit(*str)) str++;
if (*str == '.')
{
str++;
if (isdigit(*str))
{
while(isdigit(*str)) str++;
}
else if ( *str != '\0' && *str != 'e' && *str != 'E' && *str != 'd' && *str != 'D' )
{
error("Badly formed number.\n");
}
}
if ( *str == 'd' || *str == 'D' ) *str = 'e';
if (*str == 'e' || *str=='E' )
{
str++;
if (isdigit(*str))
{
while(isdigit(*str)) str++;
}
else if (char_in_list(*str,"+-"))
{
str++;
if (isdigit(*str))
{
while(isdigit(*str)) str++;
}
else
{
error("Badly formed number.\n");
}
}
else
{
error("Badly formed number.\n");
}
}
symbol = number;
}
else if (isalpha(*str) || char_in_list(*str, symchars))
{
while(isalnum(*str) || char_in_list(*str, symchars)) str++;
ch = *str; *str = '\0';
for(i = 0; reswords[i] != NULL; i++)
if (strcmp(p, reswords[i]) == 0)
{
symbol = rsymbols[i]; break;
}
if (reswords[i] == NULL) symbol = name;
*str = ch;
}
else if (*str == '"')
{
str++;
while(*str != '"' && *str != '\0')
{
if (*str++ == '\\') str++;
}
if (*str == '\0')
{
error("String not terminated.\n");
}
str++; symbol = string;
}
else if (char_in_list(*str, csymbols))
{
for(i = 0; *str != csymbols[i]; i++);
symbol = ssymbols[i];
str++;
if (*str == '=')
switch(symbol)
{
case assignsym:
symbol = eq; str++; break;
case lt:
symbol = le; str++; break;
case gt:
symbol = ge; str++; break;
case indclose: case rightpar:
break;
default:
error("Syntax error.\n");
}
if (*str == '>')
if (symbol == lt)
{
symbol = neq; str++;
}
}
else
{
error("Syntax error.\n");
}
ch = *str;
*str = '\0';
strcpy( csymbol, p );
*str = ch;
return;
}
TREE *newtree()
{
return (TREE *)ALLOCMEM(sizeof(TREE));
}
TREE *args(minp, maxp)
int minp, maxp;
{
TREE *treeptr, *root;
int numgot = 0;
root = treeptr = equation();
numgot++;
while(symbol == argsep)
{
scan();
NEXT(treeptr) = equation();
treeptr = NEXT(treeptr);
numgot++;
if (numgot > maxp) error("Too many parameters.\n");
}
if (numgot < minp) error("Too few parameters.\n");
return root;
}
TREE *nameorvar()
{
TREE *root, *treeptr, *prevtree, *tp;
SYMTYPE sym = nullsym;
int i, slen;
char *tstr;
root = treeptr = prevtree = newtree();
if (symbol == minus && !isspace(*str) &&
(str-2<buf || isspace(*(str-2)) || char_in_list(*(str-2),"{};=[(\\<>&|+-*/^,")))
{
sym = minus; scan();
}
if (symbol != name && symbol != number &&
symbol != string && symbol != leftpar)
{
error("Expecting identifier, constant or leftpar.\n");
}
while(symbol == name || symbol == number ||
symbol == string || symbol == leftpar)
{
switch(symbol)
{
case name:
SDATA(treeptr) = STRCOPY(csymbol);
ETYPE(treeptr) = ETYPE_NAME;
if (*str == '(' || *str == '[')
{
scan(); scan(); ARGS(treeptr) = args(0, 10000);
if (symbol != rightpar && symbol != indclose)
{
error("Expecting closing parenthesis.\n");
}
}
break;
case string:
tstr = csymbol + 1;
tstr[strlen(tstr)-1] = '\0';
slen = strlen(tstr);
for(i = 0; i < strlen(tstr); i++)
if (tstr[i] == '\\')
switch(tstr[++i])
{
case 'n': break;
default: slen--;
break;
}
SDATA(treeptr) = (char *)ALLOCMEM(slen+1);
for(i = 0; *tstr != '\0'; i++, tstr++)
if (*tstr == '\\')
switch(*++tstr)
{
case 'n':
SDATA(treeptr)[i++] = '\r';
SDATA(treeptr)[i] = '\n';
break;
case 't':
SDATA(treeptr)[i] = '\t';
break;
case 'v':
SDATA(treeptr)[i] = '\v';
break;
case 'b':
SDATA(treeptr)[i] = '\b';
break;
case 'r':
SDATA(treeptr)[i] = '\r';
break;
case 'f':
SDATA(treeptr)[i] = '\f';
break;
case 'e':
SDATA(treeptr)[i] = 27;
break;
default:
SDATA(treeptr)[i] = *tstr;
break;
}
else
SDATA(treeptr)[i] = *tstr;
ETYPE(treeptr) = ETYPE_STRING;
break;
case number:
DDATA(treeptr) = atof(csymbol);
ETYPE(treeptr) = ETYPE_NUMBER;
break;
case leftpar:
scan(); LEFT(treeptr) = equation();
if (symbol != rightpar)
{
error("Right paranthesis missing.\n");
}
ETYPE(treeptr) = ETYPE_EQUAT;
break;
}
if (*str == '[')
{
scan(); scan(); SUBS(treeptr) = args(1,2);
if (symbol != rightpar && symbol != indclose)
{
error("Expecting closing parenthesis.\n");
}
}
if (sym == minus)
{
tp = newtree();
VDATA(tp) = opr_minus;
ETYPE(tp) = ETYPE_OPER;
LEFT(tp) = treeptr;
if (root == treeptr)
root = treeptr = tp;
else
LINK(prevtree) = treeptr = tp;
}
sym = symbol;
scan();
if (symbol == minus && !isspace(*str) &&
(str-2<buf || isspace(*(str-2)) || char_in_list(*(str-2),"{};=([\\<>&|+-*/^,")))
{
sym = minus;
if (*str == '-' && !isspace(*(str + 1)))
{
break;
}
else if (*str == '-')
error("Syntax error.\n");
scan();
if (symbol != name && symbol != number &&
symbol != string && symbol != leftpar)
{
error("Expecting identifier, constant or leftpar.\n");
}
}
if (symbol == name || symbol == number ||
symbol == string || symbol == leftpar)
{
prevtree = treeptr; LINK(treeptr) = newtree(); treeptr = LINK(treeptr);
}
}
return root;
}
TREE *par_apply(root)
TREE *root;
{
TREE *newroot;
newroot = newtree();
switch(symbol)
{
case apply:
VDATA(newroot) = opr_apply;
break;
case not:
VDATA(newroot) = opr_not;
break;
}
ETYPE(newroot) = ETYPE_OPER;
scan();
if (symbol == apply || symbol == not)
LEFT(newroot) = par_apply(newroot);
else
LEFT(newroot) = nameorvar();
return newroot;
}
TREE *par_trans(root)
TREE *root;
{
TREE *newroot;
while(symbol == transpose)
{
newroot = newtree();
LEFT(newroot) = root;
VDATA(newroot) = opr_trans;
ETYPE(newroot) = ETYPE_OPER;
root = newroot;
scan();
}
return newroot;
}
TREE *par_pow(root)
TREE *root;
{
TREE *newroot;
while(symbol == power)
{
newroot = newtree();
LEFT(newroot) = root;
VDATA(newroot) = opr_pow;
ETYPE(newroot) = ETYPE_OPER;
root = newroot;
scan(); RIGHT(newroot) = nameorvar();
switch(symbol)
{
case transpose:
RIGHT(newroot) = par_trans(RIGHT(newroot));
break;
case apply: case not:
RIGHT(newroot) = par_apply(RIGHT(newroot));
break;
}
}
return newroot;
}
TREE *par_timesdivide(root)
TREE *root;
{
TREE *newroot;
while(symbol == times || symbol == ptimes || symbol == divide)
{
newroot = newtree();
LEFT(newroot) = root;
switch(symbol)
{
case times:
VDATA(newroot) = opr_mul;
break;
case ptimes:
VDATA(newroot) = opr_pmul;
break;
case divide:
VDATA(newroot) = opr_div;
break;
}
ETYPE(newroot) = ETYPE_OPER;
root = newroot;
scan(); RIGHT(newroot) = nameorvar();
switch(symbol)
{
case power:
RIGHT(newroot) = par_pow(RIGHT(newroot));
break;
case transpose:
RIGHT(newroot) = par_trans(RIGHT(newroot));
break;
case apply: case not:
RIGHT(newroot) = par_apply(RIGHT(newroot));
break;
}
}
return newroot;
}
TREE *par_plusminus(root)
TREE *root;
{
TREE *newroot;
while(symbol == plus || symbol == minus)
{
newroot = newtree();
LEFT(newroot) = root;
switch(symbol)
{
case plus:
VDATA(newroot) = opr_add;
break;
case minus:
VDATA(newroot) = opr_subs;
break;
}
ETYPE(newroot) = ETYPE_OPER;
root = newroot;
scan(); RIGHT(newroot) = nameorvar();
switch(symbol)
{
case times: case ptimes: case divide:
RIGHT(newroot) = par_timesdivide(RIGHT(newroot));
break;
case power:
RIGHT(newroot) = par_pow(RIGHT(newroot));
break;
case transpose:
RIGHT(newroot) = par_trans(RIGHT(newroot));
break;
case apply: case not:
RIGHT(newroot) = par_apply(RIGHT(newroot));
break;
}
}
return newroot;
}
TREE *par_compare(root)
TREE *root;
{
TREE *newroot;
while(symbol == eq || symbol == neq || symbol == lt ||
symbol == gt || symbol == le || symbol == ge)
{
newroot = newtree();
LEFT(newroot) = root;
switch(symbol)
{
case eq:
VDATA(newroot) = opr_eq;
break;
case lt:
VDATA(newroot) = opr_lt;
break;
case gt:
VDATA(newroot) = opr_gt;
break;
case neq:
VDATA(newroot) = opr_neq;
break;
case le:
VDATA(newroot) = opr_le;
break;
case ge:
VDATA(newroot) = opr_ge;
break;
}
ETYPE(newroot) = ETYPE_OPER;
root = newroot;
scan(); RIGHT(newroot) = nameorvar();
switch(symbol)
{
case plus: case minus:
RIGHT(newroot) = par_plusminus(RIGHT(newroot));
break;
case times: case ptimes: case divide:
RIGHT(newroot) = par_timesdivide(RIGHT(newroot));
break;
case power:
RIGHT(newroot) = par_pow(RIGHT(newroot));
break;
case transpose:
RIGHT(newroot) = par_trans(RIGHT(newroot));
break;
case apply: case not:
RIGHT(newroot) = par_apply(RIGHT(newroot));
break;
}
}
return newroot;
}
TREE *par_vector(root)
TREE *root;
{
TREE *newroot;
while(symbol == vector)
{
newroot = newtree();
LEFT(newroot) = root;
VDATA(newroot) = opr_vector;
ETYPE(newroot) = ETYPE_OPER;
root = newroot;
scan();
RIGHT(newroot) = nameorvar();
switch(symbol)
{
case eq: case neq: case lt: case gt: case le: case ge:
RIGHT(newroot) = par_compare(RIGHT(newroot));
break;
case plus: case minus:
RIGHT(newroot) = par_plusminus(RIGHT(newroot));
break;
case times: case ptimes: case divide:
RIGHT(newroot) = par_timesdivide(RIGHT(newroot));
break;
case power:
RIGHT(newroot) = par_pow(RIGHT(newroot));
break;
case transpose:
RIGHT(newroot) = par_trans(RIGHT(newroot));
break;
case apply: case not:
RIGHT(newroot) = par_apply(RIGHT(newroot));
break;
}
}
return newroot;
}
TREE *par_logical(root)
TREE *root;
{
TREE *newroot;
while(symbol == and || symbol == or)
{
newroot = newtree();
LEFT(newroot) = root;
switch(symbol)
{
case and:
VDATA(newroot) = opr_and;
break;
case or:
VDATA(newroot) = opr_or;
break;
}
ETYPE(newroot) = ETYPE_OPER;
root = newroot;
scan(); RIGHT(newroot) = nameorvar();
switch(symbol)
{
case vector:
RIGHT(newroot) = par_vector(RIGHT(newroot));
break;
case eq: case neq: case lt: case gt: case le: case ge:
RIGHT(newroot) = par_compare(RIGHT(newroot));
break;
case plus: case minus:
RIGHT(newroot) = par_plusminus(RIGHT(newroot));
break;
case times: case ptimes: case divide:
RIGHT(newroot) = par_timesdivide(RIGHT(newroot));
break;
case power:
RIGHT(newroot) = par_pow(RIGHT(newroot));
break;
case transpose:
RIGHT(newroot) = par_trans(RIGHT(newroot));
break;
case apply: case not:
RIGHT(newroot) = par_apply(RIGHT(newroot));
break;
}
}
return newroot;
}
TREE *par_reduction(root)
TREE *root;
{
TREE *newroot;
while(symbol == reduction)
{
newroot = newtree();
VDATA(newroot) = opr_reduction;
ETYPE(newroot) = ETYPE_OPER;
scan(); RIGHT(newroot) = nameorvar();
LEFT(newroot) = root;
root = newroot;
switch(symbol)
{
case and: case or:
RIGHT(newroot) = par_logical(RIGHT(newroot));
break;
case vector:
RIGHT(newroot) = par_vector(RIGHT(newroot));
break;
case eq: case neq: case lt: case gt: case le: case ge:
RIGHT(newroot) = par_compare(RIGHT(newroot));
break;
case plus: case minus:
RIGHT(newroot) = par_plusminus(RIGHT(newroot));
break;
case times: case ptimes: case divide:
RIGHT(newroot) = par_timesdivide(RIGHT(newroot));
break;
case power:
RIGHT(newroot) = par_pow(RIGHT(newroot));
break;
case transpose:
RIGHT(newroot) = par_trans(RIGHT(newroot));
break;
case apply: case not:
RIGHT(newroot) = par_apply(RIGHT(newroot));
break;
}
}
return newroot;
}
TREE *par_resize(root)
TREE *root;
{
TREE *newroot;
while(symbol == resize)
{
newroot = newtree();
VDATA(newroot) = opr_resize;
ETYPE(newroot) = ETYPE_OPER;
scan(); LEFT(newroot) = nameorvar();
RIGHT(newroot) = root;
root = newroot;
switch(symbol)
{
case reduction:
LEFT(newroot) = par_reduction(LEFT(newroot));
break;
case and: case or:
LEFT(newroot) = par_logical(LEFT(newroot));
break;
case vector:
LEFT(newroot) = par_vector(LEFT(newroot));
break;
case eq: case neq: case lt: case gt: case le: case ge:
LEFT(newroot) = par_compare(LEFT(newroot));
break;
case plus: case minus:
LEFT(newroot) = par_plusminus(LEFT(newroot));
break;
case times: case ptimes: case divide:
LEFT(newroot) = par_timesdivide(LEFT(newroot));
break;
case power:
LEFT(newroot) = par_pow(LEFT(newroot)); break;
case transpose:
LEFT(newroot) = par_trans(LEFT(newroot));
break;
case apply: case not:
LEFT(newroot) = par_apply(LEFT(newroot));
break;
}
}
return newroot;
}
TREE *equation()
{
TREE *treeptr;
switch(symbol)
{
case apply: case not:
break;
default:
treeptr = nameorvar();
break;
}
while(TRUE)
{
switch(symbol)
{
case resize:
treeptr = par_resize(treeptr);
break;
case reduction:
treeptr = par_reduction(treeptr);
break;
case and: case or:
treeptr = par_logical(treeptr);
break;
case vector:
treeptr = par_vector(treeptr);
break;
case eq: case neq: case lt: case gt: case le: case ge:
treeptr = par_compare(treeptr);
break;
case plus: case minus:
treeptr = par_plusminus(treeptr);
break;
case times: case ptimes: case divide:
treeptr = par_timesdivide(treeptr);
break;
case power:
treeptr = par_pow(treeptr);
break;
case transpose:
treeptr = par_trans(treeptr);
break;
case apply: case not:
treeptr = par_apply(treeptr);
break;
default:
return treeptr;
}
}
}
CLAUSE *commentparse()
{
char *p = str;
CLAUSE *root = NULL;
while( *str!='\n' && *str!='\0' ) str++;
scan();
return root;
}
CLAUSE *scallparse()
{
char *p = str;
CLAUSE *root = NULL;
while( *str!='\n' && *str != ';' && *str!='\0' ) str++;
if ( *str ) *str++ = '\0';
if ( *p )
{
root = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
root->data = systemcall;
root->this = newtree();
SDATA(root->this) = STRCOPY( p );
ETYPE(root->this) = ETYPE_STRING;
}
scan();
return root;
}
CLAUSE *statement()
{
char *csymbcopy, *p;
CLAUSE *root = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
if (symbol == name)
{
p = str;
csymbcopy = STRCOPY(csymbol);
do
{
scan();
} while( symbol != assignsym && symbol != nullsym && symbol != statemend );
strcpy(csymbol, csymbcopy);
FREEMEM(csymbcopy);
str = p;
if (symbol == assignsym)
{
symbol = name; root -> this = nameorvar(); scan();
}
else
symbol = name;
}
LINK(root) = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
LINK(root) -> this = equation();
root->data = assignsym;
return root;
}
CLAUSE *blockparse()
{
CLAUSE *root, *ptr;
root = (CLAUSE *)NULL;
if (symbol != beginsym)
error("if|while|function: missing block open symbol.\n");
scan();
if (symbol == nullsym)
{
dogets(str, PMODE_BLOCK);
scan();
}
if (symbol != endsym)
{
root = ptr = parse();
while(LINK(ptr) != NULL)
{
ptr = LINK(ptr);
}
}
while(symbol != endsym && symbol != elsesym)
{
if (symbol == nullsym)
{
dogets(str, PMODE_BLOCK); scan();
}
if (symbol != endsym && symbol != elsesym)
{
LINK(ptr) = parse();
while(LINK(ptr) != NULL)
{
ptr = LINK(ptr);
}
}
}
bendsym = symbol;
scan();
return root;
}
CLAUSE *funcparse()
{
CLAUSE *root, *ptr;
SYMTYPE sym;
TREE *lptr, *rptr,*help;
int ch,n;
char *p = str;
root = ptr = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
ptr->data = funcsym;
scan();
ptr->this = nameorvar();
help = SUBS(root->this) = newtree();
SDATA( help ) = STRCOPY( p );
p = str;
while ( symbol == nullsym || symbol == comment )
{
dogets( str, PMODE_CONT );
scan();
if ( symbol == comment )
{
NEXT(help) = newtree();
help = NEXT(help);
while( *str != '\n' && *str != '\0' ) str++;
ch = *str;
if ( *str ) *++str = '\0';
*str = ch;
SDATA(help) = STRCOPY( p );
p = str;
}
}
while(symbol == import || symbol == export)
{
if (symbol == import)
lptr = LEFT(root->this);
else
lptr = RIGHT(root->this);
sym = symbol;
scan();
rptr = args(1,1000);
if (lptr == NULL)
{
if (sym == import)
LEFT(root->this) = rptr;
else
RIGHT(root->this) = rptr;
}
else
{
while(NEXT(lptr)) lptr=NEXT(lptr);
NEXT(lptr) = rptr;
}
if (symbol == nullsym)
{
dogets(str, PMODE_CONT);
scan();
}
}
if (symbol == beginsym)
{
LINK(ptr) = blockparse();
if (bendsym != endsym)
error("function: missing end.\n");
}
else
LINK(ptr) = parse();
return root;
}
CLAUSE *ifparse()
{
CLAUSE *root, *ptr, *parse();
int block = FALSE;
scan();
if (symbol != leftpar)
{
error("Missing leftpar.\n");
}
root = ptr = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
ptr->data = ifsym;
scan();
ptr -> this = equation();
if (symbol != rightpar)
{
error("Missing rightpar.\n");
}
scan();
if (symbol == thensym) scan();
if (symbol == nullsym)
{
dogets(str, PMODE_CONT);
scan();
}
if (symbol == beginsym)
{
block = TRUE;
LINK(ptr) = blockparse();
}
else
LINK(ptr) = parse();
while(LINK(ptr) != NULL)
{
ptr = LINK(ptr);
}
root->jmp = LINK(ptr) = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
ptr = LINK(ptr); ptr->data = endsym;
if (symbol == elsesym || bendsym == elsesym)
{
root -> jmp = LINK(ptr) = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
ptr = LINK(ptr); ptr->data = elsesym;
if (symbol == elsesym) scan();
if (symbol == nullsym)
{
dogets(str, PMODE_CONT);
scan();
}
if (symbol == beginsym)
{
LINK(ptr) = blockparse();
if (block && bendsym != endsym)
error("else: missing end.\n");
}
else
LINK(ptr) = parse();
while(LINK(ptr) != NULL)
{
ptr = LINK(ptr);
}
root->jmp->jmp = LINK(ptr) = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
LINK(ptr)->data = endsym;
}
return root;
}
CLAUSE *whileparse()
{
CLAUSE *root, *ptr;
scan();
if (symbol != leftpar)
{
error("Missing leftpar.\n");
}
root = ptr = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
ptr->data = whilesym;
scan();
ptr->this = equation();
if (symbol != rightpar)
{
error("Missing rightpar.\n");
}
scan();
if (symbol == nullsym)
{
dogets(str, PMODE_CONT);
scan();
}
if (symbol == beginsym)
{
LINK(ptr) = blockparse();
if (bendsym != endsym)
error("while: missing end.\n");
}
else
LINK(ptr) = parse();
while(LINK(ptr) != NULL)
{
ptr = LINK(ptr);
}
root -> jmp = LINK(ptr) = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
LINK(ptr)->data = endsym;
return root;
}
CLAUSE *forparse()
{
CLAUSE *root, *ptr;
scan();
if (symbol != leftpar)
{
error("for: missing leftpar.\n");
}
root = ptr = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
ptr->data = forsym;
scan();
ptr -> this = nameorvar();
if (symbol != assignsym)
{
error("for: missing equalsign\n");
}
scan();
LINK(ptr->this) = equation();
if (symbol != rightpar)
{
error("Missing rightpar.\n");
}
scan();
if (symbol == nullsym)
{
dogets(str, PMODE_CONT);
scan();
}
if (symbol == beginsym)
{
LINK(ptr) = blockparse();
if (bendsym != endsym)
error("for: missing end.\n");
}
else
LINK(ptr) = parse();
while(LINK(ptr) != NULL)
{
ptr = LINK(ptr);
}
root -> jmp = LINK(ptr) = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
LINK(ptr)->data = endsym;
return root;
}
CLAUSE *parse()
{
CLAUSE *ptr = (CLAUSE *)NULL;
switch(symbol)
{
case funcsym:
ptr = funcparse();
break;
case beginsym:
ptr = blockparse();
if (bendsym != endsym)
error("begin: missing end.\n");
break;
case ifsym:
ptr = ifparse();
break;
case whilesym:
ptr = whileparse();
break;
case forsym:
ptr = forparse();
break;
case systemcall:
ptr = scallparse();
break;
case comment:
ptr = commentparse();
break;
default:
ptr = statement();
break;
}
while( symbol == statemend ) scan();
if (ptr == (CLAUSE *)NULL)
ptr = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
return ptr;
}
void free_treeentry(root)
TREEENTRY *root;
{
if (root == NULL) return;
free_tree(root->args);
free_tree(root->subs);
if ( root->entrytype == ETYPE_STRING || root->entrytype == ETYPE_NAME )
FREEMEM(root->entrydata.s_data);
else if ( root->entrytype == ETYPE_CONST )
var_delete_temp(root->entrydata.c_data);
}
void free_tree(root)
TREE *root;
{
if (root == NULL) return;
free_tree(NEXT(root));
free_tree(LINK(root));
free_tree(LEFT(root));
free_tree(RIGHT(root));
free_treeentry(&root->tentry);
FREEMEM((char *)root);
}
void free_clause(root)
CLAUSE *root;
{
if (root == NULL) return;
free_clause(LINK(root));
free_tree(root->this);
FREEMEM((char *)root);
}
VARIABLE *doit(line)
char *line;
{
CLAUSE *ptr, *root;
VARIABLE *res;
str = buf;
strcpy( str, line );
root = ptr = (CLAUSE *)ALLOCMEM(sizeof(CLAUSE));
scan();
while(symbol != nullsym)
{
LINK(ptr) = parse();
while(LINK(ptr) != NULL)
{
ptr = LINK(ptr);
}
}
/* root = optimclause(root); */
/* printclause(root, math_out, 0); */
res = evalclause(root);
free_clause(root);
return res;
}
syntax highlighted by Code2HTML, v. 0.9.1