bas.y

/*
 *==============================================================================
 *345678901234567890123456789012345678901234567890123456789012345678901234567890
 *
 *   File:  bas.y
 *   Copyright 2022  David J. Webb
 *
 *   Bison file for parsing MSTS Signal Scripts.  Bison generates a C file
 *   "y.tab.c" containing the routine "yyparse".  When called from the main
 *   program the routine calls a second routine in file "lex.yy.c", generated
 *   by lex, which splits the signal script file into tokens, parses the tokens
 *   to construct a tree representing the signal script, and returns, via a
 *   routine parameter, a pointer to the head of the tree.
 *
 *   The order at which programs should be compiled is:
 *
 *      bison -dy -Dparse.trace bas.y
 *      lex bas.l
 *      gcc lex.yy.c y.tab.c main.c -lm -o main
 *
 *   This file is based on information and example code published in:
 *
 *   Charles Donnelly and Richard Stallman, Bison (version 3.8.1), Free Software
 *   Foundation Boston, MA, USA.
 *      https://www.gnu.org/software/bison/manual/bison.pdf
 *   Tom Niemann, Lex & Yacc Tutorial, epaperpress.com, Portland, Oregon, USA.
 *      https://www.epaperpress.com/lexandyacc/
 *
 *   The MSTS script file specification, is given in document ???
 *   provided with the original MSTS disks.
 *
 *   Released under licence GPL-3.0-or-later
 *
 *   ZR 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 3 of the License, or
 *   (at your option) any later version.
 *
 *   ZR 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 ZR.  If not, see <https://www.gnu.org/licenses/>.
 *
 *==============================================================================
 */
%{
#include <stdio.h>
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#include "sigscr.h"

/*
 *  Prototypes
 */

/*  Routines defined below used to construct the Tree */

nodeType *opr(int oper, int noops, ... ) ;
nodeType *id(int i) ;
nodeType *con(int value) ;
nodeType *str(char *name) ;
int      ip = 0 ;

int  yylex(void);
void yyerror(nodeType **nPtr, char *s) ;
int  print_sigscr_node(nodeType *p) ;
%}

%union {
int   iValue  ;    /* Value of integer */
float fValue  ;    /* Value of Real */
char  *sValue ;    /* Value of string */
char  sIndex  ;    /* symbol table index */
nodeType *nPtr;    /* node pointer */
};

%verbose

/*
 *
 *  Unfortunately there does not seem to be a way of defining a
 *  separate set of define statements to use for the calls to
 *  subroutine "opr()" which generate the tree structure.
 *  For this reason the list of tokens contains a mixture of tokens
 *  returned by Lex and those needed for the subroutine calls.
 *  In some cases both names are the same
 *
 *  File sigscr.h contains an array 'token' which is used when displaying
 *  the tree structure.  The token names there should be in the same order
 *  as the tokens listed in the following "%token" lines.  This is also
 *  the same order as in file "y.tab.h" generated by Bison.
 *
 */
%token  SC_PROGRAM SC_FUNCTION SC_VARIABLE
%token  <sValue> SC_NAME SC_IVALUE SC_FVALUE SC_SCRIPT
%token  SC_EXTERN SC_FLOAT SC_IF SC_ELSE SC_FOR SC_WHILE SC_DO
%token  SC_BREAK SC_CONTINUE SC_RETURN SC_PRINT SC_UMINUS
%token  SC_SCRIPT_LIST SC_DEF_LIST SC_STMT_LIST
%token  SC_DEF_EFUN SC_DEF_EVAR SC_DEF_VAR SC_EXIT
%token  SC_ASSIGN SC_IAS SC_PE SC_ME SC_XE SC_DE SC_IASD SC_AMD
%token  SC_IFX SC_BB SC_NO_OP SC_NEG SC_COMMA SC_EXPR_LIST
%token  SC_AND SC_OR SC_EOR SC_NOT SC_INT
%token  SC_GT SC_LT SC_GE SC_LE SC_EQ SC_NE
%token  SC_IGT SC_ILT SC_IGE SC_ILE SC_IEQ SC_INE SC_PLUS SC_POW
%nonassoc SC_IFX
%nonassoc SC_ELSE
%precedence SC_NEG
%left  SC_AND SC_OR SC_EOR
%left  SC_GT SC_LT SC_GE SC_LE SC_EQ SC_NE SC_IGE SC_ILE SC_IEQ SC_INE SC_IGT SC_ILT SC_POW '^'
%left  SC_PLUS '-'
%left '*' '/'
%nonassoc SC_NOT  '!'   '#'        /*  Should be right?? */
%nonassoc SC_UMINUS

%type <nPtr> program script script_list defn defn_list stmt stmt_list expr function expr_list
/*
 *  "%parse-param" adds an additional parameter to the main function call to
 *  "%yyparse.
 *  Here the parameter is the address of a pointer to a tree node (sTree).
 *  Before the bison routine closes it copies the address of the top level node
 *  of the tree to "sTree" for use by the main program.
 *  NOTE:  The extra parameter also has to be added to the specification of
 *  yyerror (line 16), or compiler errors are generated.
 *
 */
%parse-param {nodeType **sTree}

%%
program:
    script_list                  {
    nodeType  *node, *last_node ;
    int       op_index ;
                                   if(ip)printf("\n BISON: EXIT MSTS COMPILER ROUTINE\n");
                                   if(*sTree == NULL){
                                     $$ = opr(SC_PROGRAM,1,$1) ;
                                     *sTree = $$ ;
                                     return 0; /*exit(0)*/;
                                   }else{
                                     last_node = NULL ;
                                     for(node=*sTree; node != NULL && node->opr.oper != SC_SCRIPT ; node= node->opr.op[0]){
                                       last_node = node ;
                                     }
                                     if(node == NULL){
                                       last_node->opr.op[0] = $$ ;
                                     }else{
                                       printf("  ERROR :: Unable to join script trees\n") ;
                                     }
                                     return 0;
                                   }
                                 }
;
script_list:
    script                       {
                                   if(ip)printf("\n BISON: Found SC_SCRIPT_LIST 1\n");
                                   $$ = opr(SC_SCRIPT_LIST, 2, NULL, $1); }

    | script_list script         {
                                   if(ip)printf("\n BISON: Found SC_SCRIPT_LIST 2\n");
                                   $$ = opr(SC_SCRIPT_LIST, 2, $1, $2); }
;
script:
    SC_SCRIPT defn_list stmt_list {
                                   if(ip)printf("\n BISON: Found SC_SCRIPT\n");
                                   $$ = opr(SC_SCRIPT,3,str($1),$2,$3) ; }
;
defn_list:
    defn                          { if(ip)printf("\n BISON: Found DEFINITION\n");
                                   $$ = $1;                            }
    | defn_list defn              { if(ip)printf("\n BISON: Found DEFINITION LIST\n");
                                   $$ = opr(SC_DEF_LIST, 2, $1, $2);   }
;
defn:
    SC_EXTERN SC_FLOAT SC_NAME SC_BB ';' { if(ip)printf("\n BISON: Found EXTERN FLOAT FUNCTION\n");
                                   $$ = opr(SC_DEF_EFUN, 1, str($3));  }
    | SC_EXTERN SC_FLOAT SC_NAME '(' ')' ';' { if(ip)printf("\n BISON: Found EXTERN FLOAT FUNCTION\n");
                                   $$ = opr(SC_DEF_EFUN, 1, str($3));  }

    | SC_EXTERN SC_FLOAT SC_NAME ';'      { if(ip)printf("\n BISON: Found EXTERN FLOAT VARIABLE\n");
                                   $$ = opr(SC_DEF_EVAR, 1, str($3));  }

    | SC_FLOAT SC_NAME ';'             { if(ip)printf("\n BISON: Found EXTERN FLOAT VARIABLE\n");
                                   $$ = opr(SC_DEF_VAR, 1, str($2));    }
;
stmt:
    ';'                          { $$ = opr(SC_NO_OP, 2, NULL, NULL);   }
    | expr ';'                   { $$ = $1 ;                            }
    | SC_PRINT expr ';'          { $$ = opr(SC_PRINT, 1, $2) ;          }
    | SC_NAME '=' expr ';'       { $$ = opr(SC_ASSIGN, 2, str($1), $3); }
    | SC_NAME SC_IAS expr ';'    { $$ = opr(SC_IAS, 2, str($1), $3);    }
    | SC_NAME SC_PE expr ';'     { $$ = opr(SC_PE, 2, str($1), $3);     }
    | SC_NAME SC_ME expr ';'     { $$ = opr(SC_ME, 2, str($1), $3);     }
    | SC_NAME SC_XE expr ';'     { $$ = opr(SC_XE, 2, str($1), $3);     }
    | SC_NAME SC_DE expr ';'     { $$ = opr(SC_DE, 2, str($1), $3);     }
    | SC_NAME SC_IASD expr ';'   { $$ = opr(SC_IASD, 2, str($1), $3);   }
    | SC_NAME SC_AMD expr ';'    { $$ = opr(SC_AMD, 2, str($1), $3);   }
    | SC_WHILE '(' expr ')' stmt { $$ = opr(SC_WHILE, 2, $3, $5);       }
    | SC_IF '(' expr ')' stmt %prec SC_IFX { $$ = opr(SC_IF, 2, $3, $5);      }
    | SC_IF '(' expr ')' stmt SC_ELSE stmt { $$ = opr(SC_IF, 3, $3, $5, $7);  }
    | '{' stmt_list '}'          { $$ = $2;                             }
    | SC_EXIT                    { $$ = opr(SC_EXIT, 1, NULL);          }
;

stmt_list:
    stmt                         { $$ = $1;                             }
    | stmt_list stmt             { $$ = opr(SC_STMT_LIST, 2, $1, $2);   }
;
expr:
    SC_NAME                      { $$ = opr(SC_VARIABLE,1,str($1)) ;    }
    | SC_IVALUE                  { $$ = opr(SC_IVALUE,1,str($1)) ;      }
    | SC_FVALUE                  { $$ = opr(SC_FVALUE,1,str($1)) ;      }
    | '-' expr %prec SC_UMINUS   { $$ = opr(SC_UMINUS, 1, $2);          }
    | function                   { $$ = $1 ;                            }
    | expr SC_PLUS expr          { $$ = opr(SC_PLUS, 2, $1, $3);        }
    | expr '-' expr              { $$ = opr('-', 2, $1, $3);            }
    | expr '*' expr              { $$ = opr('*', 2, $1, $3);            }
    | expr '/' expr              { $$ = opr('/', 2, $1, $3);            }
    | expr SC_LT expr            { $$ = opr(SC_LT, 2, $1, $3);          }
    | expr SC_GT expr            { $$ = opr(SC_GT, 2, $1, $3);          }
    | expr SC_GE expr            { $$ = opr(SC_GE, 2, $1, $3);          }
    | expr SC_LE expr            { $$ = opr(SC_LE, 2, $1, $3);          }
    | expr SC_NE expr            { $$ = opr(SC_NE, 2, $1, $3);          }
    | expr SC_EQ expr            { $$ = opr(SC_EQ, 2, $1, $3);          }
    | expr SC_IGT expr           { $$ = opr(SC_IGT, 2, $1, $3);         }
    | expr SC_ILT expr           { $$ = opr(SC_ILT, 2, $1, $3);         }
    | expr SC_IGE expr           { $$ = opr(SC_IGE, 2, $1, $3);         }
    | expr SC_ILE expr           { $$ = opr(SC_ILE, 2, $1, $3);         }
    | expr SC_IEQ expr           { $$ = opr(SC_IEQ, 2, $1, $3);         }
    | expr SC_INE expr           { $$ = opr(SC_INE, 2, $1, $3);         }
    | '(' expr ')'               { $$ = $2 ;                            }
    | '!' expr                   { $$ = opr(SC_NOT, 1, $2);             }
    | SC_NOT expr                { $$ = opr(SC_NOT, 1, $2);             }
    | '#' expr                   { $$ = opr(SC_INT, 1, $2);             }
    | expr SC_AND expr           { $$ = opr(SC_AND, 2, $1, $3);         }
    | expr SC_OR expr            { $$ = opr(SC_OR, 2, $1, $3);          }
    | expr SC_EOR expr           { $$ = opr(SC_EOR, 2, $1, $3);         }
    | expr '^' expr              { $$ = opr(SC_EOR, 2, $1, $3);         }
;

expr_list:
    expr                         { $$ = $1 ;                            }
    | expr_list SC_COMMA expr    { $$ = opr(SC_EXPR_LIST, 2, $1, $3);   }
;

function:
    SC_NAME SC_BB                   { $$ = opr(SC_FUNCTION,1,str($1)) ;    }
    | SC_NAME '(' ')'            { $$ = opr(SC_FUNCTION,1,str($1)) ;    }
    | SC_NAME '(' expr_list ')'  { $$ = opr(SC_FUNCTION,2,str($1),$3) ; }
;

%%
/*
 *  C Routines used to generate tree
 *
 *  In principal the nodes could be of different length but here
 *  they are all defined to be of size nodeType.  However means that
 *  the 'opr' type node can have no more than three elements.
 */
nodeType *con(int value) {
nodeType *p ;
int      ip = 0 ;
/* allocate node */
      if ((p = malloc(sizeof(nodeType))) == NULL) yyerror(&p,"out of memory");
/* copy information */
        p->type      = typeCon;
        p->con.value = value;
        if(ip){
          printf(" con :: p    = %p\n", (void *)p)   ;
          printf(" con :: type = %i\n", p->type)     ;
          printf(" con :: value= %i\n", p->con.value) ;
        }
       return p;
}

nodeType *id(int i) {
nodeType *p ;
int      ip = 0 ;
/* allocate node */
      if ((p = malloc(sizeof(nodeType))) == NULL) yyerror(&p,"out of memory");
/* copy information */
      p->type = typeId;
      p->id.i = i;
      if(ip){
        printf(" id  :: p    = %p\n", (void *)p) ;
        printf(" id  :: type = %i\n", p->type)   ;
        printf(" di  :: i    = %i\n", p->id.i)   ;
      }
      return p;
}

nodeType *str(char *name){
nodeType *p ;
int      ip = 0 ;
/* allocate node */
      if ((p = malloc(sizeof(nodeType))) == NULL) yyerror(&p,"out of memory");
/* copy information */
      p->type     = typeStr      ;
      p->str.name = strdup(name) ;
      if(ip){
        printf(" str :: p    = %p\n", (void *)p)   ;
        printf(" str :: type = %i\n", p->type)     ;
        printf(" str :: name = %s\n", p->str.name) ;
      }
      return p ;
}

nodeType *opr(int oper, int nops, ...) {
va_list   ap  ;
nodeType *p   ;
size_t   size ;
int      i, ip = 0;
/*  Check parameter 'nops' */
      if(nops>3){
        printf("  Signal script error\n");
        printf("  Routine called with parameter 'nops' >3\n");
        printf("  Program stopping ... \n");
        exit(1);
      }
/* allocate node */
      if ((p = malloc(sizeof(nodeType))) == NULL) yyerror(&p,"out of memory");
/* copy information */
      p->type = typeOpr;
      p->opr.oper = oper;
      p->opr.nops = nops;
      for (i = 0; i < 3; i++) p->opr.op[i] = NULL;
      va_start(ap, nops);
      for (i = 0; i < nops; i++) p->opr.op[i] = va_arg(ap, nodeType*);
      va_end(ap);
      if(ip){
        printf(" opr :: p    = %p\n", (void *)p)   ;
        printf(" opr :: type = %i\n", p->type)     ;
        printf(" opr :: oper = %i\n", p->opr.oper) ;
        printf(" opr :: nops = %i\n", p->opr.nops) ;
        for (i = 0; i < nops; i++){
          printf(" opr :: %i  %p\n",i,(void *)p->opr.op[i]);
        }
        print_sigscr_node(p) ;
      }
      return p;
}

void freeNode(nodeType *p) {
int i;
      if (!p) return;
      if (p->type == typeOpr) {
        for (i = 0; i < p->opr.nops; i++) freeNode(p->opr.op[i]);
      }
      free (p);
}

void yyerror(nodeType **p, char *s) {
      fprintf(stdout, "yyerror %s\n", s);
}