%{ /* * mglparse.y - Parser for Bootrom Menu Generation Language * * Copyright (C) 1997-2003 Gero Kuhlmann * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. * * $Id: mglparse.y,v 1.4 2003/01/25 23:29:44 gkminix Exp $ */ #include "mknbi.h" #include "mgl.h" #include "gencode.h" /* ***************************************************************************** * * Global variables */ int lineno = 1; /* Current line number */ int errors = 0; /* Number of errors */ int warnings = 0; /* Number of warnings */ int curlevel = 0; /* Current nesting level */ struct typesdef *typetab = NULL; /* Types table */ struct sym *symtab = NULL; /* Symbol table */ struct sym *curproc = NULL; /* Current procedure, function, menu */ /* ***************************************************************************** * * Local variables */ static int yyerrstatus = 0; /* Error status of parser */ static int inargdef = FALSE; /* TRUE when defining proc args */ static int reclevel = 0; /* Current level within a record def */ static varattrib curattrib = ATTR_NONE; /* Current argument attribute */ static addr_t levelptr[MAX_LEVELS + 1]; /* Current offset to BP */ static struct sym *symstack[MAX_LEVELS + 1]; /* Symbol stack for nesting */ /* ***************************************************************************** * * Make life simpler using preprocessor defines: */ #define newexpr() ((struct expr *)nbmalloc(sizeof(struct expr))) #define newtype() ((struct typesdef *)nbmalloc(sizeof(struct typesdef))) #define newsym() ((struct sym *)nbmalloc(sizeof(struct sym))) #define newsymlist() ((struct symlist *)nbmalloc(sizeof(struct symlist))) #define newtypelist() ((struct typelist *)nbmalloc(sizeof(struct typelist))) #define newvarinfo() ((struct varinfo *)nbmalloc(sizeof(struct varinfo))) /* ***************************************************************************** * * Convert string into IP number */ static char *getinet(name) char *name; { #ifdef HAVE_INET static struct in_addr addr; struct hostent *hp; addr.s_addr = INADDR_ANY; if ((hp = gethostbyname(name)) == NULL) warning("host not found, assuming 0.0.0.0"); else addr = *((struct in_addr *)(hp->h_addr)); #else static char addr[INADDR_SIZE]; warning("no IP address support available, assuming 0.0.0.0"); memset(addr, 0, INADDR_SIZE); #endif return((char *)&addr); } /* ***************************************************************************** * * Delete the list of symbols, which has been builtup during a variable * or enumeration declaration. We also delete the symbols themselves if * they are not used. */ static void delsymlist(symlist) struct symlist *symlist; { struct sym *sp; struct symlist *slp, *slptmp; slp = symlist; while (slp != NULL) { if (isnosym(slp->sym)) { /* * The symbol is not in use, so delete it. To do this we * have to first find the preceding symbol. */ for (sp = symtab; sp != NULL; sp = sp->next) if (sp->next == slp->sym) break; if (sp != NULL && sp->next != NULL) { sp->next = sp->next->next; free(slp->sym->name); free(slp->sym); } } slptmp = slp->next; free(slp); slp = slptmp; } } /* ***************************************************************************** * * Delete all symbols with higher or equal nesting level than the current * level. */ static void delsymbols() { struct sym *sp1, *sp2, *sp3; /* First delete all symbols */ sp1 = NULL; sp2 = symtab; while (sp2 != NULL) { sp3 = sp2->next; if (sp2->level >= curlevel) { /* Delete any string in a constant */ if (sp2->type == constsym && sp2->def.c.t->type == EXPR_STRING) if (sp2->def.c.val.s != NULL) free(sp2->def.c.val.s); /* Now delete the symbol name and the symbol itself */ if (sp1 != NULL) sp1->next = sp3; else symtab = sp3; free(sp2->name); free(sp2); } else sp1 = sp2; sp2 = sp3; } } /* ***************************************************************************** * * Check if the symbol is already defined within the current level. If it * has been defined in a lower level, we can assign the name again, and have * to create a new symbol table entry for it. */ static struct sym *checksym(sp) struct sym *sp; { struct sym *newsp; /* If it's not defined at all, we can return it unchanged */ if (isnosym(sp)) return(sp); /* Check if symbol is defined within the current level */ if (sp->level >= curlevel) { error("identifier already declared"); return(NULL); } /* Create new entry in symbol table */ newsp = newsym(); newsp->type = nosym; newsp->level = curlevel; newsp->next = symtab; symtab = newsp; /* We have to create a new copy of the name to be able to delete the symbol */ copystr(&(newsp->name), sp->name); return(newsp); } /* ***************************************************************************** * * Scan through the current symbol list and assign a variable type to * all symbols. */ static void assignvartype(tp, symlist) struct typesdef *tp; struct symlist *symlist; { struct sym *sp; struct symlist *slp; addr_t varsize; for (slp = symlist; slp != NULL; slp = slp->next) { if (slp->sym == NULL) continue; if (reclevel > 0) { /* * We are defining variables for a record definition. This * is a bit complicated, because the symbols in the record * can have names which are already declared even in the * current level. To care for this, we declare symbols here * which have a higher level than the current level, so * that they can be sorted out lateron. */ curlevel += reclevel; if ((sp = checksym(slp->sym)) == NULL) { curlevel--; break; } sp->type = varsym; sp->def.v.t = tp; sp->def.v.attr = ATTR_NONE; sp->level = curlevel; curlevel -= reclevel; continue; } if ((sp = checksym(slp->sym)) == NULL) break; sp->type = varsym; sp->def.v.t = tp; sp->def.v.attr = ATTR_NONE; varsize = tp->size; if (tp->type == EXPR_STRING) /* Strings occupy one byte more than their size */ varsize++; if (inargdef) { /* * We are preparing an argument list to a function or * procedure. There, non-scalars get always passed as * pointers. If they have to be passed by value, the * caller has to provide a copy of the argument value * on the stack before calling the procedure. * Additionally, when a string gets passed by reference, * not only the address but also the string size gets * pushed onto the stack. * We use sp->addr to temporarily save the size of the * argument on the stack. A positive value of sp->addr * marks this as an argument to a function. */ if (curattrib == ATTR_REF) sp->addr = (tp->type == EXPR_STRING ? 4 : 2); else sp->addr = (isscalar(tp) ? (varsize + 1) & 0xfffe : 2); sp->def.v.attr = curattrib; } else if (curlevel > 0) { levelptr[curlevel] += (varsize + 1) & 0xfffe; sp->addr = -levelptr[curlevel]; } else { sp->addr = dataptr; dataptr += varsize; } } /* Finally delete the symbol list */ delsymlist(symlist); } /* ***************************************************************************** * * Return a pointer to an enumeration type which has the elements listed * in the current symbol list. */ static struct typesdef *enumcreate(symlist) struct symlist *symlist; { struct sym *sp; struct symlist *slp; struct typesdef *tp; int i; /* Just for safety */ if (symlist == NULL) return(NULL); /* Check that all symbols in the list are available */ for (slp = symlist; slp != NULL; slp = slp->next) { if (slp->sym == NULL) continue; if ((slp->sym = checksym(slp->sym)) == NULL) { delsymlist(symlist); return(NULL); } } /* First we count the number of symbols in the symbol list and number them */ for (i = 0, slp = symlist; slp != NULL; slp = slp->next, i++) { if (slp->sym == NULL) break; slp->num = i; } if (slp != NULL || i == 0) { delsymlist(symlist); return(NULL); } /* Reverse the numbers in the list */ i--; for (slp = symlist; slp != NULL; slp = slp->next) slp->num = i - slp->num; /* Let's see if we have a type like this already */ for (tp = typetab; tp != NULL; tp = tp->next) if (tp->type == EXPR_ENUM && tp->def.s.min == 0 && tp->def.s.max == i) break; /* We can now safely create a new enumeration type */ if (tp == NULL) { tp = newtype(); tp->type = EXPR_ENUM; tp->def.s.boundaddr = -1; tp->def.s.min = 0; tp->def.s.max = i; tp->size = int_type.size; tp->next = typetab; typetab = tp; } /* Finally we have to assign a new type to all symbols in the list */ for (slp = symlist; slp != NULL; slp = slp->next) { sp = slp->sym; sp->type = constsym; sp->def.c.t = tp; sp->def.c.val.e = slp->num; } /* Release the symbol list and return the new enumeration type */ delsymlist(symlist); return(tp); } /* ***************************************************************************** * * Return a pointer to an array type. */ static struct typesdef *arraycreate(index, base) struct typesdef *index; struct typesdef *base; { struct typesdef *tp; int elementnum; addr_t size; /* Just for safety */ if (index == NULL || base == NULL) return(NULL); /* Find out the number of elements in the array */ if (!isscalar(index)) { error("scalar type required for array index"); return(NULL); } elementnum = index->def.s.max - index->def.s.min + 1; #ifdef PARANOID if (elementnum < 1) interror(3, "number of elements in array < 1"); #endif /* Determine the total size of the new array type */ size = elementnum * base->size; if (size > MAX_ARRAY_SIZE) { error("array size too large"); return(NULL); } /* Let's see if we have a type like this already */ for (tp = typetab; tp != NULL; tp = tp->next) if (tp->type == EXPR_ARRAY && tp->def.a.elementnum == elementnum && tp->def.a.indextype == index && tp->def.a.basetype == base) break; /* We can now safely create a new enumeration type */ if (tp == NULL) { tp = newtype(); tp->type = EXPR_ARRAY; tp->def.a.elementnum = elementnum; tp->def.a.indextype = index; tp->def.a.basetype = base; tp->size = size; tp->next = typetab; typetab = tp; } return(tp); } /* ***************************************************************************** * * Return a pointer to a record type. The symbols which are part of the * record have been created by the parser in the global symbol list with * a higher level than the current level. We have to take all these * symbols out and insert them into the record specification. */ static struct typesdef *recordcreate() { struct sym *sp1, *sp2, *sp3; struct sym *elements; struct typesdef *tp; int elementnum; addr_t size; /* Create our own elements list from the symbol list */ elements = NULL; elementnum = 0; sp2 = NULL; sp1 = symtab; while (sp1 != NULL) { if (sp1->level >= curlevel + reclevel) { /* This is our symbol -> remove it from global list */ if (sp2 == NULL) symtab = sp1->next; else sp2->next = sp1->next; sp3 = sp1->next; sp1->next = elements; elements = sp1; elementnum++; sp1 = sp3; } else { sp2 = sp1; sp1 = sp1->next; } } /* Now scan through our own symbol list and determine the record size */ size = 0; for (sp1 = elements; sp1 != NULL; sp1 = sp1->next) { #ifdef PARANOID if (!isvarsym(sp1)) interror(100, "invalid symbol list in record specification"); #endif sp1->def.v.attr = ATTR_NONE; sp1->level = -1; /* required for code generator */ sp1->addr = size; size += sp1->def.v.t->size; } /* Check for some errors */ if (size > MAX_REC_SIZE) { error("record too large"); while (elements != NULL) { sp1 = elements->next; free(sp1->name); free(sp1); elements = sp1; } return(NULL); } #ifdef PARANOID if (elementnum == 0 || elements == NULL) interror(101, "empty symbol list in record definition"); #endif /* Let's see if we have a type like this already */ for (tp = typetab; tp != NULL; tp = tp->next) if (tp->type == EXPR_RECORD && tp->def.r.elementnum == elementnum) { sp1 = tp->def.r.elements; sp2 = elements; while (sp1 != NULL && sp2 != NULL) if (sp1->type != varsym || sp1->type != sp2->type || sp1->def.v.t != sp2->def.v.t || strcmp(sp1->name, sp2->name)) break; if (sp1 == NULL && sp2 == NULL) break; } /* If we have a type like this already, we can return it */ if (tp != NULL) { while (elements != NULL) { sp1 = elements->next; free(sp1->name); free(sp1); elements = sp1; } return(tp); } /* We can now safely create a new record type */ tp = newtype(); tp->type = EXPR_RECORD; tp->def.r.elementnum = elementnum; tp->def.r.elements = elements; tp->size = size; tp->next = typetab; typetab = tp; return(tp); } /* ***************************************************************************** * * Lookup the symbol table and assign all symbols, which are arguments to * the current procedure or function, to that procedure. It returns the * total size of the arguments on the stack. */ static addr_t procargassign(proc, level) struct sym *proc; int level; { struct sym *sp; addr_t varsize; addr_t argptr; int i, j; /* * Count all arguments to the procedure, and recalculate the offsets to * the procedure arguments. This will also reverse the order of the * arguments. */ i = MAX_EXPRS - 1; argptr = 4; for (sp = symtab; sp != NULL; sp = sp->next) { if (sp->level != level) break; if (isvarsym(sp) && sp->addr > 0) { if (i < 0) { error("too many arguments"); break; } varsize = sp->addr; sp->addr = argptr; argptr += varsize; proc->def.f.args[i] = sp->def.v.t; proc->def.f.attribs[i] = sp->def.v.attr; i--; } } /* Move the arguments down and clear all unused table entries */ for (i++, j = 0; i < MAX_EXPRS; i++, j++) { proc->def.f.args[j] = proc->def.f.args[i]; proc->def.f.attribs[j] = proc->def.f.attribs[i]; } proc->def.f.argnum = j; for ( ; j < MAX_EXPRS; j++) { proc->def.f.args[j] = NULL; proc->def.f.attribs[j] = ATTR_NONE; } return(argptr); } /* ***************************************************************************** * * Check if two types are assignable to each other */ static int checkassign(type1, type2) struct typesdef *type1; struct typesdef *type2; { /* If the types are exactly the same, we can always assign */ if (type1 == type2) return(TRUE); /* Enumerations have to be exactly the same */ if (type1->type == EXPR_ENUM || type2->type == EXPR_ENUM) return(type1 == type2); /* * With scalars, the types have to be the same, and the ranges must not * be disjunct. */ if (isscalar(type1) && isscalar(type2) && type1->type == type2->type && type1->def.s.min < type2->def.s.max && type1->def.s.max > type2->def.s.min) return(TRUE); /* * Strings are always possible regardless of sizes, because the runtime * module will care for the sizes and truncate if necessary. */ if (type1->type == EXPR_STRING && type1->type == type2->type) return(TRUE); /* In all other cases, assignment is not possible */ return(FALSE); } /* ***************************************************************************** * * Check that an expression has the correct subexpressions for a function * or procedure call, and reorder the subexpressions correctly. */ static struct expr *setprocexpr(sp, ep) struct sym *sp; struct expr *ep; { struct expr *tmpexpr; int i, j; if (!isfuncsym(sp)) error("unknown procedure or function"); else if (sp->def.f.argnum == ep->exprnum) { /* Reverse the expression order and reorg each expression subtree */ j = sp->def.f.argnum - 1; for (i = 0; i < (sp->def.f.argnum / 2); i++, j--) { tmpexpr = ep->exprlist[i]; ep->exprlist[i] = ep->exprlist[j]; ep->exprlist[j] = tmpexpr; } /* Reorganize all subtrees and check for correct arguments */ for (i = 0; i < sp->def.f.argnum; i++) { ep->exprlist[i] = reorg(ep->exprlist[i]); if (sp->def.f.attribs[i] == ATTR_REF && !isvariable(ep->exprlist[i])) { error("variable required for reference argument"); break; } if (!checkassign(sp->def.f.args[i], ep->exprlist[i]->type)) { error("invalid type for argument in function call"); break; } if (isconst(ep->exprlist[i]) && isscalar(ep->exprlist[i]->type) && (getord(ep->exprlist[i]) < sp->def.f.args[i]->def.s.min || getord(ep->exprlist[i]) > sp->def.f.args[i]->def.s.max)) warning("subclass range exceeded in function argument"); } /* If no error occurred, set the resulting expression correctly */ if (i >= sp->def.f.argnum) { ep->type = sp->def.f.ret; ep->opcode = sp->def.f.opcode; ep->spec.func = sp; return (ep); } } else error("invalid number of arguments to function/procedure call"); /* In case of error delete all expression subtrees */ delexpr(ep); return(NULL); } %} /* ********************************************************************* * * Return type for lexer and parser states */ %union { struct symlist *symlist; /* List of symbols in variable decl */ struct typelist *typelist; /* List of types in array decl */ struct typesdef *type; /* Expression type */ struct sym *symbol; /* Pointer to symbol */ struct expr *expr; /* expression tree */ char *inaddr; /* IP address */ char *string; /* string buffer */ char chrarg; /* character argument */ int intarg; /* integer argument */ int op; /* arithmetic operation */ } /* ********************************************************************* * * Tokens returned by lexer */ %token QSTRING %token NUM %token INADDR %token ID %token CHR %token ADDOP MULOP COMPARISON OROP XOROP ANDOP NOTOP %token VAR CONST TYPE SCREEN PROCEDURE FUNCTION ARRAY RECORD %token RETURN RESTART PRINT SELECT ITEM IF ELSE GOTOXY %token TIMEOUT LOAD FROM GATEWAY GET MENU REPEAT UNTIL %token AT WITH THEN WHILE DO BREAK DEFAULT ASSIGN OF %token CBEGIN END DOTS /* ********************************************************************* * * Types of non-terminal rules */ %type string_length %type inetaddr %type expr func expressions exprlist timeout %type const_expr const_value const_id const_binaryop const_unaryop %type binaryop unaryop constant %type variable var_id var_array var_record %type type_spec type_single type_array type_record %type id_list single_id %type index_list /* ********************************************************************* * * Precendeces */ %nonassoc THEN_PREC %nonassoc ELSE %left OROP XOROP %left ANDOP %left NOTOP %left COMPARISON %left ADDOP %left MULOP %nonassoc UMINUS %% /* ********************************************************************* * * Layout of program */ mgl: screen '.' | blocks screen '.' ; blocks: declblock | screen ';' | procedure ';' | blocks declblock | blocks screen ';' | blocks procedure ';' ; declblock: VAR vardecls ';' | CONST constdecls ';' | TYPE typedecls ';' ; /* ********************************************************************* * * General rules to declare a symbol list */ id_list: single_id { $$ = $1; } | id_list ',' single_id { $3->next = $1; $$ = $3; } | id_list ',' error { delsymlist($1); $$ = NULL; } | error { $$ = NULL; } ; single_id: ID { struct symlist *slp; slp = newsymlist(); slp->sym = $1; slp->next = NULL; $$ = slp; } ; /* ********************************************************************* * * Constant declaration section */ constdecls: const_declaration | constdecls ';' const_declaration ; const_declaration: ID COMPARISON const_expr { if (($3 = reorg($3)) == NULL) YYERROR; else if ($2 != CMD_EQ) error("equal sign expected"); else if (!isconst($3)) error("expression not constant"); else if (exprtype($3) != EXPR_NUM && exprtype($3) != EXPR_STRING && exprtype($3) != EXPR_CHAR && exprtype($3) != EXPR_BOOL) error("invalid constant expression type"); else if (($1 = checksym($1)) != NULL) { $1->type = constsym; $1->def.c = $3->spec.cval; $1->def.c.t = $3->type; if (exprtype($3) == EXPR_STRING) { $1->def.c.val.s = NULL; copystr(&($1->def.c.val.s), $3->spec.cval.val.s); } } delexpr($3); } | error ';' { error("constant declaration expected"); yyerrok; } ; /* ********************************************************************* * * Type declaration section */ typedecls: type_declaration | typedecls ';' type_declaration ; type_declaration: ID COMPARISON type_spec { if ($2 != CMD_EQ) error("equal sign expected"); else if ($3 == NULL) error("type specification expected"); else if (($1 = checksym($1)) != NULL) { /* Setup the symbol to contain the type */ $1->type = typesym; $1->def.t = $3; } } | error ';' { error("type declaration expected"); yyerrok; } ; /* ********************************************************************* * * Variable declarations section */ vardecls: var_declaration | vardecls ';' var_declaration ; var_declaration: id_list ':' type_spec { if ($1 == NULL) error("missing variable name(s)"); else if ($3 == NULL) error("type specification expected"); else assignvartype($3, $1); } ; /* ********************************************************************* * * Specify and enter a new type into the type list */ type_spec: type_single { $$ = $1; } | type_array { $$ = $1; } | type_record { $$ = $1; } | error { error("type specification expected"); $$ = NULL; } ; /* ********************************************************************* * * Specification of a single type, i.e. not an array or record */ type_single: ID string_length { struct typesdef *tp; tp = NULL; if ($1 == NULL || isnosym($1)) error("unknown type identifier"); else if (!istypesym($1)) error("identifier is not a type"); else if ($1->def.t->type != EXPR_STRING && $2 != 0) error("length specification not allowed"); else if ($1->def.t->type != EXPR_STRING) /* Assign non-string type */ tp = $1->def.t; else if ($1->level >= 0 && $2 != 0) error("cannot redeclare string type"); else if ($1->level >= 0) /* Assign user defined string type */ tp = $1->def.t; else { /* * Strings are a bit special because different * sizes are actually different types. There- * fore we have to create a new type with the * required size. */ if ($2 == 0) $2 = MAX_STR_LEN; for (tp = typetab; tp != NULL; tp = tp->next) if (tp->type == EXPR_STRING && tp->size == $2) break; if (tp == NULL) { tp = newtype(); tp->size = $2; tp->type = EXPR_STRING; tp->def.a.elementnum = $2; tp->def.a.indextype = &strindex_type; tp->def.a.basetype = &char_type; tp->next = typetab; typetab = tp; } } $$ = tp; } | const_value DOTS const_value { /* Find a subclass specification of a scalar */ int submin, submax; struct typesdef *tp; tp = NULL; if (($1 = reorg($1)) == NULL || ($3 = reorg($3)) == NULL) YYERROR; if (!isconst($1) || !isconst($3)) error("subclass specification has to be constant"); else if (!isscalar($1->type) || !isscalar($3->type)) error("subclass specification has to be scalar"); else if (exprtype($1) != exprtype($3) || $1->type->def.s.min != $3->type->def.s.min || $3->type->def.s.max != $3->type->def.s.max) error("subclass involves different types"); else { submin = getord($1); submax = getord($3); if (submin > submax || submin < $1->type->def.s.min || submax > $1->type->def.s.max) error("invalid subclass range"); else { /* See if we have the type already */ for (tp = typetab; tp != NULL; tp = tp->next) if (tp->type == exprtype($1) && tp->def.s.min == submin && tp->def.s.max == submax) break; if (tp == NULL) { /* No, make a new one */ tp = newtype(); tp->size = $1->type->size; tp->type = $1->type->type; tp->def.s.min = submin; tp->def.s.max = submax; tp->def.s.boundaddr = -1; tp->next = typetab; typetab = tp; } } } delexpr($1); delexpr($3); $$ = tp; } | '(' id_list ')' { $$ = NULL; if ($2 == NULL) error("missing names in enumeration"); else $$ = enumcreate($2); } ; string_length: /* empty */ { $$ = 0; } | '[' const_expr ']' { $$ = 0; if (($2 = reorg($2)) == NULL) YYERROR; if (exprtype($2) != EXPR_NUM) error("length must be a number"); else if (!isconst($2)) error("length must be constant"); else if ($2->spec.cval.val.i < 1 || $2->spec.cval.val.i > MAX_STR_LEN) error("invalid length"); else $$ = $2->spec.cval.val.i; delexpr($2); } | '[' error ']' { error("number expected"); $$ = 0; } ; /* ********************************************************************* * * Rules for defining an array */ type_array: ARRAY '[' index_list ']' OF type_spec { struct typesdef *tp; struct typelist *tlp1, *tlp2; tp = NULL; if ($3 == NULL) error("index type for array missing"); else if ($6 == NULL) error("base type for array missing"); else if ((tp = arraycreate($3->t, $6)) != NULL) { for (tlp1 = $3->next; tlp1 != NULL; tlp1 = tlp1->next) { tp = arraycreate(tlp1->t, tp); if (tp == NULL) break; } if (tlp1 != NULL) tp = NULL; } tlp1 = $3; while (tlp1 != NULL) { tlp2 = tlp1->next; free(tlp1); tlp1 = tlp2; } $$ = tp; } ; index_list: type_single { struct typelist *tlp; tlp = NULL; if ($1 != NULL) { tlp = newtypelist(); tlp->t = $1; tlp->next = NULL; } $$ = tlp; } | index_list ',' type_single { struct typelist *tlp; tlp = NULL; if ($3 != NULL) { tlp = newtypelist(); tlp->t = $3; tlp->next = $1; } $$ = tlp; } | index_list error { struct typelist *tlp1, *tlp2; for (tlp1 = $1; tlp1 != NULL; tlp1 = tlp1->next) { tlp2 = tlp1->next; free(tlp1); tlp1 = tlp2; } $$ = NULL; } ; /* ********************************************************************* * * Rules for declaring a record type */ type_record: record_name vardecls record_end { /* * The vardecls rule created symbols in the global * list which have a higher level than the * current level. These have to be sorted out. */ $$ = recordcreate(); if (reclevel > 0) reclevel--; } | record_name vardecls error { curlevel += reclevel; delsymbols(); curlevel -= reclevel; if (reclevel > 0) reclevel--; } | record_name error { if (reclevel > 0) reclevel--; } ; record_name: RECORD { reclevel++; } ; record_end: ';' END | END ; /* ********************************************************************* * * Screen definition */ screen: screen_name proc_blocks screen_begin commands end { /* Delete all symbols defined in this nesting level */ if (curlevel > 0) { delsymbols(); curlevel--; } /* Return to caller */ docmd(CODE_PROC_END, NULL, NULL, NULL); } ; screen_name: SCREEN ID ';' { if (($2 = checksym($2)) == NULL) YYERROR; else if (curlevel >= MAX_LEVELS) { error("too many nesting levels"); YYERROR; } else { curlevel++; symstack[curlevel] = $2; levelptr[curlevel] = 0; } } | SCREEN error { error("screen identifier expected"); } ; screen_begin: begin { struct sym symbol; /* Restore pointer to current procedure */ curproc = symstack[curlevel]; curproc->type = funcsym; curproc->addr = codeptr; curproc->level = curlevel - 1; startadr = codeptr; /* * We use a symbol to pass the global values to the * code generator */ symbol.type = nosym; symbol.addr = levelptr[curlevel]; symbol.level = curlevel; docmd(CODE_PROC_START, &symbol, NULL, NULL); curproc->def.f.restartaddr = codeptr; curproc->def.f.opcode = CMD_MENU; curproc->def.f.ret = NULL; curproc->def.f.argnum = 0; } ; /* ********************************************************************* * * Procedure/function definition */ procedure: proc_def proc_blocks proc_begin commands end { /* Delete all symbols defined in this nesting level */ if (curlevel > 0) { delsymbols(); curlevel--; } /* Return to caller */ docmd(CODE_PROC_END, NULL, NULL, NULL); } ; proc_blocks: /* empty */ | blocks ; proc_def: PROCEDURE proc_name '(' proc_args ')' ';' { symstack[curlevel]->def.f.ret = NULL; inargdef = FALSE; } | FUNCTION proc_name '(' proc_args ')' ':' type_spec ';' { if ($7 == NULL) error("missing function type"); symstack[curlevel]->def.f.ret = $7; inargdef = FALSE; } | PROCEDURE error { inargdef = FALSE; error("procedure identifier expected"); } | FUNCTION error { inargdef = FALSE; error("function identifier expected"); } ; proc_args: /* empty */ | proc_arg_block | error { curattrib = ATTR_NONE; } ; proc_arg_block: proc_arg_decl | proc_arg_block ';' proc_arg_decl ; proc_arg_decl: var_declaration | VAR { curattrib = ATTR_REF; } var_declaration { curattrib = ATTR_NONE; } | CONST { curattrib = ATTR_CONST; } var_declaration { curattrib = ATTR_NONE; } ; proc_name: ID { if (($1 = checksym($1)) == NULL) YYERROR; else if (curlevel >= MAX_LEVELS) { error("too many nesting levels"); YYERROR; } else { inargdef = TRUE; curlevel++; symstack[curlevel] = $1; levelptr[curlevel] = 0; } } ; proc_begin: begin { addr_t argptr; struct sym symbol; /* * For functions care for space for the return value, * if we have a scalar type. Otherwise the space has * to be provided by the caller, and it's address * pushed onto the stack before calling. */ curproc = symstack[curlevel]; if (curproc->def.f.ret != NULL && isscalar(curproc->def.f.ret)) { levelptr[curlevel] += 2; curproc->def.f.retaddr = -levelptr[curlevel]; } else curproc->def.f.retaddr = 0; curproc->type = funcsym; curproc->addr = codeptr; curproc->level = curlevel - 1; /* * We use a symbol to pass the global values to the * code generator */ symbol.type = nosym; symbol.addr = levelptr[curlevel]; symbol.level = curlevel; docmd(CODE_PROC_START, &symbol, NULL, NULL); curproc->def.f.restartaddr = codeptr; curproc->def.f.opcode = CMD_USERFUNC; curproc->def.f.argnum = 0; /* * Count all arguments to the procedure and reverse * the order of the arguments. */ argptr = procargassign(curproc, curlevel); /* * If we don't have a scalar return type, the * return value's space is pointed to by a value * pushed before the arguments. Adjust the return * value pointer accordingly. */ if (curproc->def.f.ret != NULL && !isscalar(curproc->def.f.ret)) curproc->def.f.retaddr = argptr; } ; /* ********************************************************************* * * Command definitions */ commands: command | commands ';' command ; command: /* empty */ | RETURN { docmd(CODE_PROC_END, NULL, NULL, NULL); } | RESTART { docmd(CODE_RESTART, NULL, NULL, NULL); } | BREAK { docmd(CODE_BREAK, NULL, NULL, NULL); } | assignment | callproc | gotoxy | print | select | get | if | while | repeat | load | menu | error ; /* ********************************************************************* * * Assignment command */ assignment: variable ASSIGN expr { struct varinfo *vp; if ($1 == NULL || ($3 = reorg($3)) == NULL) YYERROR; if (!isvariable($1)) { error("variable expected for lvalue"); delexpr($1); delexpr($3); break; } /* Find last item in var list -> base record */ for (vp = &($1->spec.var); vp != NULL; vp = vp->next) if (vp->next == NULL) break; if (vp == NULL || vp->symbol == NULL || (!isvarsym(vp->symbol) && !isfuncsym(vp->symbol))) { error("variable expected for lvalue"); delexpr($1); delexpr($3); break; } if (vp->symbol->def.v.attr == ATTR_CONST) { error("cannot assign to variable declared constant"); delexpr($1); delexpr($3); break; } if (!checkassign($1->type, $3->type)) { error("variable type doesn't match expression"); delexpr($1); delexpr($3); break; } if (isconst($3) && isscalar($3->type) && (getord($3) < $1->type->def.s.min || getord($3) > $1->type->def.s.max)) warning("subclass range exceeded in scalar assignment"); docmd(CODE_ASSIGN, NULL, $1, $3); delexpr($1); delexpr($3); } | '$' '[' expr ']' ASSIGN expr { struct expr *ep; /* We need this for the code generator */ static struct sym putbootp = { funcsym, "", 0, -1, { { 0, 0, CMD_PUTBOOTP, 2, NULL, { &int_type, &string_type }, { ATTR_NONE, ATTR_CONST } } }, NULL }; if (($3 = reorg($3)) == NULL || ($6 = reorg($6)) == NULL) YYERROR; if (exprtype($3) != EXPR_NUM || exprtype($6) != EXPR_STRING) { error("invalid types in BOOTP assignment"); delexpr($3); delexpr($6); } else { ep = newexpr(); ep->type = putbootp.def.f.ret; ep->opcode = putbootp.def.f.opcode; ep->exprnum = putbootp.def.f.argnum; ep->exprlist[0] = reorg($3); ep->exprlist[1] = reorg($6); ep->spec.func = &putbootp; docmd(CODE_CALL_PROC, NULL, ep, NULL); delexpr(ep); } } | error ASSIGN expr { error("variable identifier expected"); delexpr($3); yyerrok; } | variable ASSIGN error { error("expression expected"); delexpr($1); } ; /* ********************************************************************* * * Call a user procedure */ callproc: ID '(' expressions ')' { if (!isfuncsym($1) || $1->def.f.ret != NULL) error("symbol is not a procedure"); else if ($3 != NULL && ($3 = setprocexpr($1, $3)) != NULL) { docmd(CODE_CALL_PROC, NULL, $3, NULL); delexpr($3); } } | ID { /* Special case for procedures without arguments */ struct expr *ep; ep = newexpr(); ep->exprnum = 0; if (!isfuncsym($1) || $1->def.f.ret != NULL) error("symbol is not a procedure"); else if ((ep = setprocexpr($1, ep)) != NULL) docmd(CODE_CALL_PROC, NULL, ep, NULL); delexpr(ep); } | ID '(' error ')' { error("invalid procedure arguments"); yyerrok; } ; /* ********************************************************************* * * Gotoxy command */ gotoxy: GOTOXY coordinates { /* handled in coordinates already */ } | GOTOXY error { error("coordinates expected"); } ; /* ********************************************************************* * * Print command */ print: PRINT expr print_coordinates { if (($2 = reorg($2)) == NULL) error("expression expected in print command"); else switch (exprtype($2)) { case EXPR_NUM: docmd(CODE_INT_PRINT, NULL, $2, NULL); break; case EXPR_STRING: docmd(CODE_STR_PRINT, NULL, $2, NULL); break; case EXPR_CHAR: docmd(CODE_CHAR_PRINT, NULL, $2, NULL); break; default: error("invalid expression in print command"); break; } delexpr($2); } | PRINT error { error("expression expected in print command"); } ; print_coordinates: /* empty */ | AT coordinates { /* everything handled in coordinates */ } ; /* ********************************************************************* * * Select command */ select: select_name opt_of items END { docmd(CODE_ENDNEST, NULL, NULL, NULL); } ; select_name: SELECT print_coordinates timeout { docmd(CODE_SELECT, NULL, $3, NULL); } ; items: item | items item ; item: item_name ':' commands ; item_name: ITEM expr { if (($2 = reorg($2)) == NULL || exprtype($2) != EXPR_NUM) error("numerical value required for item number"); else if (!isconst($2)) error("constant value required for item number"); else if ($2->spec.cval.val.i < 0 || $2->spec.cval.val.i > 9) error("item identifier out of range"); else docmd(CODE_ITEM, NULL, $2, NULL); delexpr($2); } | DEFAULT { struct expr ep; memset(&ep, 0, sizeof(ep)); ep.type = &int_type; ep.opcode = CMD_CONST; ep.exprnum = 0; ep.spec.cval.val.i = -1; docmd(CODE_ITEM, NULL, &ep, NULL); } ; /* ********************************************************************* * * Read command */ get: GET variable print_coordinates timeout { struct varinfo *vp; int ok = FALSE; if ($2 == NULL || !isvariable($2)) { error("variable expected in get command"); delexpr($2); break; } /* Find last item in var list -> base record */ for (vp = &($2->spec.var); vp != NULL; vp = vp->next) if (vp->next == NULL) break; if (vp == NULL || vp->symbol == NULL || (!isvarsym(vp->symbol) && !isfuncsym(vp->symbol))) { error("variable expected in get command"); delexpr($2); break; } if (vp->symbol->def.v.attr == ATTR_CONST) { error("cannot use variable which is declared constant"); delexpr($2); break; } switch (exprtype($2)) { case EXPR_NUM: if ((ok = checkassign($2->type, &int_type))) docmd(CODE_INT_GET, NULL, $2, $4); break; case EXPR_STRING: if ((ok = checkassign($2->type, &string_type))) docmd(CODE_STR_GET, NULL, $2, $4); break; case EXPR_CHAR: if ((ok = checkassign($2->type, &char_type))) docmd(CODE_CHAR_GET, NULL, $2, $4); break; default: break; } if (!ok) error("invalid type in get command"); delexpr($2); } | GET error { error("variable expected in get command"); } ; /* ********************************************************************* * * If command */ if: if_name then %prec THEN_PREC { docmd(CODE_ENDNEST, NULL, NULL, NULL); } | if_name then else { docmd(CODE_ENDNEST, NULL, NULL, NULL); } ; if_name: IF expr { if (($2 = reorg($2)) == NULL) YYERROR; if (exprtype($2) != EXPR_BOOL) error("boolean expression expected"); else docmd(CODE_IF, NULL, $2, NULL); delexpr($2); } ; then: opt_then begin commands end | opt_then command ; else: else_name begin commands end | else_name command ; else_name: ELSE { docmd(CODE_ELSE, NULL, NULL, NULL); } ; /* ********************************************************************* * * While command */ while: while_name opt_do begin commands end { docmd(CODE_ENDNEST, NULL, NULL, NULL); } | while_name opt_do command { docmd(CODE_ENDNEST, NULL, NULL, NULL); } ; while_name: WHILE expr { if (($2 = reorg($2)) == NULL) YYERROR; if (exprtype($2) != EXPR_BOOL) error("boolean expression expected"); else docmd(CODE_WHILE, NULL, $2, NULL); delexpr($2); } ; /* ********************************************************************* * * Repeat command */ repeat: repeat_name commands UNTIL expr { if (($4 = reorg($4)) == NULL) YYERROR; if (exprtype($4) != EXPR_BOOL) error("boolean expression expected"); else docmd(CODE_ENDNEST, NULL, $4, NULL); delexpr($4); } ; repeat_name: REPEAT { docmd(CODE_REPEAT, NULL, NULL, NULL); } ; /* ********************************************************************* * * Load command */ load: LOAD expr from gateway { if (($2 = reorg($2)) == NULL) YYERROR; if (exprtype($2) != EXPR_STRING) { error("filename expected in load command"); delexpr($2); YYERROR; } docmd(CODE_LOAD, NULL, $2, NULL); delexpr($2); } | LOAD error { error("filename expected in load command"); } ; from: /* empty */ { docmd(CODE_PUSH_IPADDR, NULL, NULL, NULL); } | FROM inetaddr { struct sym symbol; symbol.name = $2; docmd(CODE_PUSH_IPADDR, &symbol, NULL, NULL); } | FROM error { yyerror("IP address expected"); } ; gateway: /* empty */ { docmd(CODE_PUSH_IPADDR, NULL, NULL, NULL); } | opt_with GATEWAY inetaddr { struct sym symbol; symbol.name = $3; docmd(CODE_PUSH_IPADDR, &symbol, NULL, NULL); } | opt_with GATEWAY error { yyerror("IP address expected"); } ; /* ********************************************************************* * * Menu command */ menu: MENU ID { struct expr exp; if (!isfuncsym($2) || $2->def.f.opcode != CMD_MENU) error("symbol in menu command is not a screen"); else { memset(&exp, 0, sizeof(exp)); exp.type = NULL; exp.opcode = CMD_MENU; exp.exprnum = 0; exp.spec.func = $2; docmd(CODE_CALL_PROC, NULL, &exp, NULL); } } | MENU error { error("menu identification expected in menu command"); } ; /* ********************************************************************* * * Expression rules */ expr: '$' '[' expr ']' { struct expr *ep; /* We need this for the code generator */ static struct sym getbootp = { funcsym, "", 0, 0, { { 0, 0, CMD_GETBOOTP, 1, &string_type, { &int_type }, { ATTR_NONE } } }, NULL }; $$ = NULL; if ($3 == NULL) break; if (exprtype($3) != EXPR_NUM) { error("invalid BOOTP tag"); delexpr($3); } else { ep = newexpr(); ep->type = getbootp.def.f.ret; ep->opcode = getbootp.def.f.opcode; ep->exprnum = getbootp.def.f.argnum; ep->exprlist[0] = reorg($3); ep->spec.func = &getbootp; $$ = ep; } } | '(' expr ')' { $$ = $2; } | binaryop { $$ = $1; } | unaryop { $$ = $1; } | variable { $$ = $1; } | func { $$ = $1; } | constant { $$ = $1; } ; /* ********************************************************************* * * Rules for binary operations */ binaryop: expr ANDOP expr { struct expr *ep; $$ = NULL; if ($1 == NULL || $3 == NULL) break; if (!checkassign($1->type, $3->type) || (exprtype($1) != EXPR_NUM && exprtype($1) != EXPR_BOOL)) { error("invalid operation"); delexpr($1); delexpr($3); } else { ep = newexpr(); ep->type = (exprtype($1) == EXPR_NUM ? &int_type : &bool_type); ep->exprnum = 2; ep->opcode = $2; ep->left = $1; ep->right = $3; $$ = ep; } } | expr OROP expr { struct expr *ep; $$ = NULL; if ($1 == NULL || $3 == NULL) break; if (!checkassign($1->type, $3->type) || (exprtype($1) != EXPR_NUM && exprtype($1) != EXPR_BOOL)) { error("invalid operation"); delexpr($1); delexpr($3); } else { ep = newexpr(); ep->type = (exprtype($1) == EXPR_NUM ? &int_type : &bool_type); ep->exprnum = 2; ep->opcode = $2; ep->left = $1; ep->right = $3; $$ = ep; } } | expr XOROP expr { struct expr *ep; $$ = NULL; if ($1 == NULL || $3 == NULL) break; if (!checkassign($1->type, $3->type) || (exprtype($1) != EXPR_NUM && exprtype($1) != EXPR_BOOL)) { error("invalid operation"); delexpr($1); delexpr($3); } else { ep = newexpr(); ep->type = (exprtype($1) == EXPR_NUM ? &int_type : &bool_type); ep->exprnum = 2; ep->opcode = $2; ep->left = $1; ep->right = $3; $$ = ep; } } | expr ADDOP expr { struct expr *ep; $$ = NULL; if ($1 == NULL || $3 == NULL) break; if ($2 == '+' && ((exprtype($1) == EXPR_CHAR || exprtype($1) == EXPR_STRING) && (exprtype($3) == EXPR_CHAR || exprtype($3) == EXPR_STRING))) { ep = newexpr(); ep->type = &string_type; ep->exprnum = 2; ep->opcode = $2; ep->left = $1; ep->right = $3; $$ = ep; } else if (!checkassign($1->type, $3->type) || exprtype($1) != EXPR_NUM) { error("invalid operation"); delexpr($1); delexpr($3); } else { ep = newexpr(); ep->type = &int_type; ep->exprnum = 2; ep->opcode = $2; ep->left = $1; ep->right = $3; $$ = ep; } } | expr MULOP expr { struct expr *ep; $$ = NULL; if ($1 == NULL || $3 == NULL) break; if ($2 == '*' && exprtype($1) == EXPR_CHAR && exprtype($3) == EXPR_NUM) { ep = newexpr(); ep->type = &string_type; ep->exprnum = 2; ep->opcode = $2; ep->left = $1; ep->right = $3; $$ = ep; } else if (!checkassign($1->type, $3->type) || exprtype($1) != EXPR_NUM) { error("invalid operation"); delexpr($1); delexpr($3); } else { ep = newexpr(); ep->type = &int_type; ep->exprnum = 2; ep->opcode = $2; ep->left = $1; ep->right = $3; $$ = ep; } } | expr COMPARISON expr { struct expr *ep; $$ = NULL; if ($1 == NULL || $3 == NULL) break; if (!checkassign($1->type, $3->type) || (isnonscalar($1->type) && exprtype($1) != EXPR_STRING) || (isnonscalar($3->type) && exprtype($3) != EXPR_STRING)) { error("invalid comparison"); delexpr($1); delexpr($3); } else { ep = newexpr(); ep->type = &bool_type; ep->exprnum = 2; ep->opcode = $2; ep->left = $1; ep->right = $3; $$ = ep; } } ; /* ********************************************************************* * * Rules for unary operations */ unaryop: NOTOP expr { struct expr *ep; $$ = NULL; if ($2 == NULL) break; if (exprtype($2) != EXPR_BOOL && exprtype($2) != EXPR_NUM) { error("NOT operation not allowed"); delexpr($2); } else { ep = newexpr(); ep->type = (exprtype($2) == EXPR_NUM ? &int_type : &bool_type); ep->exprnum = 1; ep->opcode = $1; ep->left = $2; $$ = ep; } } | ADDOP expr %prec UMINUS { struct expr *ep; $$ = NULL; if ($2 == NULL) break; if (exprtype($2) != EXPR_NUM) { error("unary operation not allowed"); delexpr($2); } else if ($1 == '-') { ep = newexpr(); ep->type = &int_type; ep->exprnum = 1; ep->opcode = $1; ep->left = $2; $$ = ep; } else if ($1 == '+') { $$ = $2; } } ; /* ********************************************************************* * * Rules for variable values */ variable: var_id { $$ = $1; } | var_array { $$ = $1; } | var_record { $$ = $1; } ; var_id: ID { struct expr *ep; struct typesdef *tp; $$ = NULL; if (isnosym($1) || $1 == NULL) yyerror("symbol not defined"); else if isconstsym($1) { ep = newexpr(); ep->opcode = CMD_CONST; ep->exprnum = 0; ep->type = $1->def.c.t; ep->spec.cval = $1->def.c; if ($1->def.c.t->type == EXPR_STRING) copystr(&(ep->spec.cval.val.s), $1->def.c.val.s); $$ = ep; } else if (!isvarsym($1) && !isfuncsym($1)) error("symbol is not a variable or function"); else if (isfuncsym($1) && $1->def.f.ret == NULL) error("cannot use a procedure in expression"); else if (isfuncsym($1) && $1 != curproc) error("cannot access return value in different function"); else { tp = isvarsym($1) ? $1->def.v.t : $1->def.f.ret; ep = newexpr(); ep->opcode = CMD_VAR; ep->exprnum = 0; ep->type = tp; ep->spec.var.symbol = $1; ep->spec.var.type = tp; ep->spec.var.index = NULL; ep->spec.var.next = NULL; $$ = ep; } } ; var_array: variable '[' expr ']' { $$ = NULL; if (($3 = reorg($3)) == NULL) error("expression expected as array index"); else if ($1 == NULL || !isvariable($1) || (exprtype($1) != EXPR_ARRAY && exprtype($1) != EXPR_STRING)) error("array or string variable expected"); else if (!isscalar($3->type)) error("scalar type expected for array index"); else if (!checkassign($1->type->def.a.indextype, $3->type)) error("invalid scalar type for array index"); else { $1->type = $1->type->def.a.basetype; $1->spec.var.index = $3; $$ = $1; } } | variable '[' expr ',' expr ']' { struct expr *ep; /* We need this for the code generator */ static struct sym strsub = { funcsym, "", 0, -1, { { 0, 0, CMD_STRSUB, 3, &string_type, { &string_type, &int_type, &int_type }, { ATTR_CONST, ATTR_NONE, ATTR_NONE } } }, NULL }; $$ = NULL; if (($3 = reorg($3)) == NULL || ($5 = reorg($5)) == NULL) YYERROR; if ($1 == NULL || !isvariable($1) || exprtype($1) != EXPR_STRING) { error("string variable expected"); delexpr($1); delexpr($3); delexpr($5); } else if (exprtype($3) != EXPR_NUM || exprtype($3) != EXPR_NUM) { error("string subrange indices have to be numerical"); delexpr($1); delexpr($3); delexpr($5); } else { ep = newexpr(); ep->type = strsub.def.f.ret; ep->opcode = strsub.def.f.opcode; ep->exprnum = strsub.def.f.argnum; ep->exprlist[0] = $1; ep->exprlist[1] = $3; ep->exprlist[2] = $5; ep->spec.func = &strsub; $$ = ep; } } ; var_record: variable '.' ID { struct sym *sp; struct varinfo *vp; struct expr *ep; /* We need this for the code generator */ static struct sym strlenF = { funcsym, "", 0, -1, { { 0, 0, CMD_STRLEN, 1, &int_type, { &string_type }, { ATTR_CONST } } }, NULL }; /* Handle string length specially */ if ($1 != NULL && isvariable($1) && exprtype($1) == EXPR_STRING && $3 != NULL && !strcmp($3->name, "len")) { ep = newexpr(); ep->type = strlenF.def.f.ret; ep->opcode = strlenF.def.f.opcode; ep->exprnum = strlenF.def.f.argnum; ep->exprlist[0] = reorg($1); ep->spec.func = &strlenF; $$ = ep; break; } /* Now handle ordinary records */ $$ = NULL; if ($1 == NULL || !isvariable($1) || exprtype($1) != EXPR_RECORD) { error("record variable expected"); break; } if ($3 == NULL) { error("record variant expected"); break; } /* Find the symbol in the record item list */ for (sp = $1->type->def.r.elements; sp != NULL; sp = sp->next) if (!strcmp(sp->name, $3->name)) break; if (sp == NULL) { error("record variant unknown"); break; } #ifdef PARANOID if (!isvarsym(sp)) interror(102, "invalid symbol list in record specification"); #endif /* Generate a new variable record */ vp = newvarinfo(); *vp = $1->spec.var; $1->spec.var.next = vp; $1->spec.var.symbol = sp; $1->spec.var.type = sp->def.v.t; $1->type = sp->def.v.t; $$ = $1; } ; /* ********************************************************************* * * Rules for constant values passed from the lexer */ constant: NUM { struct expr *ep; ep = newexpr(); ep->opcode = CMD_CONST; ep->type = &int_type; ep->exprnum = 0; ep->spec.cval.val.i = $1; $$ = ep; } | QSTRING { struct expr *ep; ep = newexpr(); ep->opcode = CMD_CONST; ep->type = &string_type; ep->exprnum = 0; copystr(&(ep->spec.cval.val.s), $1); $$ = ep; } | CHR { struct expr *ep; ep = newexpr(); ep->opcode = CMD_CONST; ep->type = &char_type; ep->exprnum = 0; ep->spec.cval.val.c = $1; $$ = ep; } ; /* ********************************************************************* * * Rules for calling a function */ func: ID '(' expressions ')' { $$ = NULL; if ($3 == NULL) break; if (isnosym($1)) { error("function not defined"); delexpr($3); } else if (!isfuncsym($1)) { error("symbol in expression is not a function"); delexpr($3); } else if (!iscmdscalar(&($1->def.f))) { /* Handle normal function call */ $$ = setprocexpr($1, $3); } else if ($3->exprnum != 1) { error("invalid number of arguments"); delexpr($3); } else if (!isscalar($3->left->type)) { error("scalar expression required"); delexpr($3); } else { /* * General scalar operations need special * handling because they can operate on a * variety of data types. By using the * checks 'iscmdscalar' and 'isscalar' we * should be pretty sure that we have a * correct function call. */ $3->type = $1->def.f.opcode == CMD_ORD ? &int_type : $3->left->type; $3->opcode = $1->def.f.opcode; $3->spec.func = $1; $$ = $3; } } | ID '(' error ')' { $$ = NULL; error("invalid function arguments"); yyerrok; } ; expressions: /* empty */ { struct expr *ep; ep = newexpr(); ep->exprnum = 0; $$ = ep; } | exprlist { $$ = $1; } ; exprlist: expr { struct expr *ep; ep = newexpr(); ep->exprnum = 1; ep->exprlist[0] = $1; $$ = ep; } | expr ',' exprlist { $3->exprlist[$3->exprnum] = $1; $3->exprnum++; $$ = $3; } ; /* ********************************************************************* * * Rules for constant expressions */ const_expr: '(' const_expr ')' { $$ = $2; } | const_binaryop { $$ = $1; } | const_unaryop { $$ = $1; } | const_id { $$ = $1; } | constant { $$ = $1; } ; /* This is necessary for type definitions */ const_value: const_id { $$ = $1; } | constant { $$ = $1; } ; const_id: ID { struct expr *ep; $$ = NULL; if (isnosym($1) || $1 == NULL) yyerror("symbol not defined"); else if (!isconstsym($1)) yyerror("constant symbol expected"); else { ep = newexpr(); ep->opcode = CMD_CONST; ep->exprnum = 0; ep->type = $1->def.c.t; ep->spec.cval = $1->def.c; if ($1->def.c.t->type == EXPR_STRING) copystr(&(ep->spec.cval.val.s), $1->def.c.val.s); $$ = ep; } } ; /* ********************************************************************* * * Rules for constant binary operations */ const_binaryop: const_expr ANDOP const_expr { struct expr *ep; $$ = NULL; if ($1 == NULL || $3 == NULL) break; if (!checkassign($1->type, $3->type) || (exprtype($1) != EXPR_NUM && exprtype($1) != EXPR_BOOL)) { error("invalid operation"); delexpr($1); delexpr($3); } else { ep = newexpr(); ep->type = (exprtype($1) == EXPR_NUM ? &int_type : &bool_type); ep->exprnum = 2; ep->opcode = $2; ep->left = $1; ep->right = $3; $$ = ep; } } | const_expr OROP const_expr { struct expr *ep; $$ = NULL; if ($1 == NULL || $3 == NULL) break; if (!checkassign($1->type, $3->type) || (exprtype($1) != EXPR_NUM && exprtype($1) != EXPR_BOOL)) { error("invalid operation"); delexpr($1); delexpr($3); } else { ep = newexpr(); ep->type = (exprtype($1) == EXPR_NUM ? &int_type : &bool_type); ep->exprnum = 2; ep->opcode = $2; ep->left = $1; ep->right = $3; $$ = ep; } } | const_expr XOROP const_expr { struct expr *ep; $$ = NULL; if ($1 == NULL || $3 == NULL) break; if (!checkassign($1->type, $3->type) || (exprtype($1) != EXPR_NUM && exprtype($1) != EXPR_BOOL)) { error("invalid operation"); delexpr($1); delexpr($3); } else { ep = newexpr(); ep->type = (exprtype($1) == EXPR_NUM ? &int_type : &bool_type); ep->exprnum = 2; ep->opcode = $2; ep->left = $1; ep->right = $3; $$ = ep; } } | const_expr ADDOP const_expr { struct expr *ep; $$ = NULL; if ($1 == NULL || $3 == NULL) break; if ($2 == '+' && ((exprtype($1) == EXPR_CHAR || exprtype($1) == EXPR_STRING) && (exprtype($3) == EXPR_CHAR || exprtype($3) == EXPR_STRING))) { ep = newexpr(); ep->type = &string_type; ep->exprnum = 2; ep->opcode = $2; ep->left = $1; ep->right = $3; $$ = ep; } else if (!checkassign($1->type, $3->type) || exprtype($1) != EXPR_NUM) { error("invalid operation"); delexpr($1); delexpr($3); } else { ep = newexpr(); ep->type = &int_type; ep->exprnum = 2; ep->opcode = $2; ep->left = $1; ep->right = $3; $$ = ep; } } | const_expr MULOP const_expr { struct expr *ep; $$ = NULL; if ($1 == NULL || $3 == NULL) break; if ($2 == '*' && exprtype($1) == EXPR_CHAR && exprtype($3) == EXPR_NUM) { ep = newexpr(); ep->type = &string_type; ep->exprnum = 2; ep->opcode = $2; ep->left = $1; ep->right = $3; $$ = ep; } else if (!checkassign($1->type, $3->type) || exprtype($1) != EXPR_NUM) { error("invalid operation"); delexpr($1); delexpr($3); } else { ep = newexpr(); ep->type = &int_type; ep->exprnum = 2; ep->opcode = $2; ep->left = $1; ep->right = $3; $$ = ep; } } | const_expr COMPARISON const_expr { struct expr *ep; $$ = NULL; if ($1 == NULL || $3 == NULL) break; if (!checkassign($1->type, $3->type)) { error("invalid comparison"); delexpr($1); delexpr($3); } else { ep = newexpr(); ep->type = &bool_type; ep->exprnum = 2; ep->opcode = $2; ep->left = $1; ep->right = $3; $$ = ep; } } ; /* ********************************************************************* * * Rules for constant unary operations */ const_unaryop: NOTOP const_expr { struct expr *ep; $$ = NULL; if ($2 == NULL) break; if (exprtype($2) != EXPR_BOOL && exprtype($2) != EXPR_NUM) { error("NOT operation not allowed"); delexpr($2); } else { ep = newexpr(); ep->type = (exprtype($2) == EXPR_NUM ? &int_type : &bool_type); ep->exprnum = 1; ep->opcode = $1; ep->left = $2; $$ = ep; } } | ADDOP const_expr %prec UMINUS { struct expr *ep; $$ = NULL; if ($2 == NULL) break; if (exprtype($2) != EXPR_NUM) { error("unary operation not allowed"); delexpr($2); } else if ($1 == '-') { ep = newexpr(); ep->type = &int_type; ep->exprnum = 1; ep->opcode = $1; ep->left = $2; $$ = ep; } else if ($1 == '+') { $$ = $2; } } ; /* ********************************************************************* * * Rules for different keywords with the same meaning */ opt_with: /* empty */ | WITH ; opt_then: /* empty */ | THEN ; opt_do: /* empty */ | DO ; opt_of: /* empty */ | OF ; begin: '{' | CBEGIN ; end: '}' | END ; /* ********************************************************************* * * Miscellaneous rules */ coordinates: '[' expr ',' expr ']' { struct expr *ep; /* We need this for the code generator */ static struct sym gotoxy = { funcsym, "", 0, -1, { { 0, 0, CMD_GOTOXY, 2, NULL, { &int_type, &int_type }, { ATTR_NONE, ATTR_NONE } } }, NULL }; if (($2 = reorg($2)) == NULL || ($4 = reorg($4)) == NULL) YYERROR; if (exprtype($2) != EXPR_NUM || exprtype($4) != EXPR_NUM) { error("coordinate values have to be numerical"); delexpr($2); delexpr($4); } else { ep = newexpr(); ep->type = gotoxy.def.f.ret; ep->opcode = gotoxy.def.f.opcode; ep->exprnum = gotoxy.def.f.argnum; ep->exprlist[0] = reorg($2); ep->exprlist[1] = reorg($4); ep->spec.func = &gotoxy; docmd(CODE_CALL_PROC, NULL, ep, NULL); delexpr(ep); } } ; timeout: /* empty */ { struct expr *ep; ep = newexpr(); ep->opcode = CMD_CONST; ep->type = &int_type; ep->exprnum = 0; ep->spec.cval.val.i = 0; $$ = ep; } | opt_with TIMEOUT expr { $$ = NULL; if (($3 = reorg($3)) == NULL) YYERROR; if (exprtype($3) != EXPR_NUM) { error("timeout value has to be a number"); delexpr($3); } else { $$ = $3; } } | opt_with TIMEOUT error { $$ = NULL; error("expression expected for timeout value"); } ; inetaddr: const_expr { $$ = NULL; if (($1 = reorg($1)) == NULL) YYERROR; if (exprtype($1) != EXPR_STRING) error("IP address has to be numerical or a string"); else if (!isconst($1)) error("IP address has to be constant"); else $$ = getinet($1->spec.cval.val.s); delexpr($1); } | INADDR { $$ = $1; } ; %% /* ***************************************************************************** * * Handle an internal error */ #ifdef PARANOID void interror(num, msg) int num; char *msg; { fprintf(stderr, "%s: internal error %d: %s\n", progname, num, msg); exit(EXIT_INTERNAL); } #endif /* ***************************************************************************** * * Print an error message */ void yyerror(msg) char *msg; { #ifdef YYRECOVERING if (YYRECOVERING()) return; #endif if (!quiet) { fprintf(stderr, "%s: %d: error: %s at ", curfile, lineno, msg); print_token(); fprintf(stderr, "\n"); } if (++errors > MAX_ERRS) { prnerr0("too many errors, aborting"); exit(EXIT_MGL_COMPERRS); } } /* ***************************************************************************** * * Print an error message without token */ void error(msg) char *msg; { #ifdef YYRECOVERING if (YYRECOVERING()) return; #endif if (!quiet) fprintf(stderr, "%s: %d: error: %s\n", curfile, lineno, msg); if (++errors > MAX_ERRS) { prnerr0("too many errors, aborting"); exit(EXIT_MGL_COMPERRS); } } /* ***************************************************************************** * * Print a warning message without a token */ void warning(msg) char *msg; { #ifdef YYRECOVERING if (YYRECOVERING()) return; #endif if (!quiet) fprintf(stderr, "%s: %d: warning: %s\n", curfile, lineno, msg); warnings++; }