regina/interp.c

   1 /*
   2  *  The Regina Rexx Interpreter
   3  *  Copyright (C) 1992-1994  Anders Christensen <anders@pvv.unit.no>
   4  *
   5  *  This library is free software; you can redistribute it and/or
   6  *  modify it under the terms of the GNU Library General Public
   7  *  License as published by the Free Software Foundation; either
   8  *  version 2 of the License, or (at your option) any later version.
   9  *
  10  *  This library is distributed in the hope that it will be useful,
  11  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13  *  Library General Public License for more details.
  14  *
  15  *  You should have received a copy of the GNU Library General Public
  16  *  License along with this library; if not, write to the Free
  17  *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18  */
  19
  20 #include "rexx.h"
  21 #include <stdio.h>
  22
  23 static void set_line_nos( treenode *ptr, int lineno, int charno )
  24 {
  25    unsigned i=0 ;
  26
  27    if (!ptr)
  28       return ;
  29
  30    if (ptr->lineno >= 0)
  31    {
  32       ptr->lineno = lineno ;
  33       ptr->charnr = charno ;
  34    }
  35
  36    for (i=0; i<sizeof(ptr->p)/sizeof(ptr->p[0]); i++)
  37       if (ptr->p[i])
  38          set_line_nos( ptr->p[i], lineno, charno ) ;
  39
  40    if (ptr->next)
  41       set_line_nos( ptr->next, lineno, charno ) ;
  42 }
  43
  44 /* Will do the "INTERPRET" work on a given streng. This function returns
  45  * either NULL on error or the result string of the interpretation.
  46  * The streng will be deleted.
  47  */
  48 streng *dointerpret( tsd_t *TSD, streng *string )
  49 {
  50    treenode *newtree ;
  51    nodeptr savecurrentnode ;
  52    streng *ptr;
  53    internal_parser_type parsing;
  54    int errpos;
  55
  56    fetch_string( TSD, string, &parsing );
  57
  58    if (parsing.result != 0)
  59    {
  60       Free_stringTSD(string) ;
  61       /*
  62        * get position from parent script if available and add it.
  63        * fixes bug 658542.
  64        */
  65       errpos = TSD->currentnode->lineno;
  66       errpos = ( errpos > 0 ) ? errpos - 1 : 0 ;
  67       exiterror( ERR_YACC_SYNTAX, 1, parsing.tline + errpos ) ;
  68       return NULL ;
  69    }
  70
  71    newtree = parsing.root ;
  72    parsing.kill = string ;
  73    if (TSD->currentnode)
  74       set_line_nos( newtree, TSD->currentnode->lineno, TSD->currentnode->charnr ) ;
  75
  76    /* Save and restore currentnode around interpret. It is set within
  77     * interpret and may result to illegal memory accesses in case of
  78     * errors if it is not restored, FGC
  79     */
  80    savecurrentnode = TSD->currentnode;
  81    ptr = interpret( TSD, newtree ) ;
  82    TSD->currentnode = savecurrentnode;
  83 #if 0
  84    /*
  85     * FIXME: Always clean up the structure. newtree may be NULL in case
  86     *        of an empty command where we still have to remove the
  87     *        single empty line. I can't remember why we should destroy
  88     *        it just in that case we have a newtree. What is a typical
  89     *        other reason of not having newtree?
  90     *        In either case, delete this comment and the "#if 0"-block
  91     *        one year after now. Florian, 04.03.2004
  92     */
  93    if (newtree)
  94 #endif
  95       DestroyInternalParsingTree( TSD, &parsing ) ;
  96
  97    return ptr ;
  98 }