regina/macros.c

   1 /*
   2  *  The Regina Rexx Interpreter
   3  *  Copyright (C) 1993-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 "rxiface.h"
  22
  23 #include <stdio.h>
  24 #include <setjmp.h>
  25 #include <string.h>
  26 #include <assert.h>
  27
  28
  29 void killsystem( tsd_t *TSD, sysinfo systm )
  30 {
  31    if ( systm->environment )
  32    {
  33       Free_stringTSD( systm->environment ) ;
  34       systm->environment = NULL;
  35    }
  36
  37    if (systm->input_file )
  38    {
  39       Free_stringTSD( systm->input_file ) ;
  40       systm->input_file = NULL;
  41    }
  42
  43    if (systm->input_fp )
  44    {
  45       fclose( systm->input_fp ) ;
  46       systm->input_fp = NULL;
  47    }
  48
  49    DestroyInternalParsingTree( TSD, &systm->tree ) ;
  50
  51    if (systm->currlevel0)
  52      {
  53       removelevel( TSD, systm->currlevel0 ) ;
  54       systm->currlevel0 = NULL;
  55      }
  56
  57    if ( systm->script_exit )
  58    {
  59       FreeTSD( systm->script_exit ) ;
  60       systm->script_exit = NULL;
  61    }
  62
  63    if ( systm->result)
  64    {
  65       Free_stringTSD( systm->result ) ;
  66       systm->result = NULL;
  67    }
  68
  69    if (systm->callstack)
  70    {
  71       FreeTSD( systm->callstack ) ;
  72       systm->callstack = NULL;
  73    }
  74
  75    FreeTSD( systm ) ;
  76 }
  77
  78 streng *do_instore( tsd_t * volatile TSD, const streng *name, paramboxptr args,
  79                     const streng *envir, int * volatile RetCode, int hooks,
  80                     const void *instore, unsigned long instore_length,
  81                     const char *instore_source,
  82                     unsigned long instore_source_length,
  83                     const internal_parser_type *ipt,
  84                     int ctype )
  85 {
  86    sysinfobox *newsystem, *tmpsys;
  87    streng *ptr=NULL;
  88    jmp_buf *jbuf;
  89    unsigned InterpreterStatus[IPRT_BUFSIZE];
  90    tsd_t * volatile saved_TSD;
  91    int * volatile saved_RetCode;
  92    volatile proclevel oldlevel;
  93    volatile int doTermHook=0;
  94
  95    if ( RetCode )
  96       *RetCode = 0;
  97
  98    SaveInterpreterStatus( TSD, InterpreterStatus );
  99    jbuf = (jmp_buf *)MallocTSD( sizeof( jmp_buf ) );
 100    assert( !TSD->in_protected );
 101
 102    saved_TSD = TSD;            /* vars used until here */
 103    saved_RetCode = RetCode;
 104    if ( setjmp( *jbuf ) )
 105    {
 106       TSD = saved_TSD;         /* prevents bugs like  592393 */
 107       RetCode = saved_RetCode;
 108
 109       ptr = TSD->systeminfo->result;
 110       TSD->systeminfo->result = NULL;
 111       if ( !TSD->instore_is_errorfree )
 112       {
 113          /*
 114           * In case of an error we don't return the error number as the result.
 115           * Instead, use the current "result" as the error code. It is set
 116           * to a negative value already by errortext().
 117           *
 118           * ==> errortext() uses a static buffer, if you ever need the value
 119           *     you have to dup it after the restore of the old system or you
 120           *     risk an endless loop.
 121           */
 122          if ( RetCode )
 123             *RetCode = atoi( ptr->value );
 124
 125          ptr = NULL;
 126       }
 127    }
 128    else
 129    {
 130       nodeptr savecurrentnode = TSD->currentnode; /* pgb fixes bug 595300 */
 131
 132       TSD->currentnode = NULL;
 133
 134       newsystem = creat_sysinfo( TSD, Str_dupTSD( envir ) );
 135       newsystem->previous = TSD->systeminfo;
 136       newsystem->hooks = hooks;
 137       newsystem->script_exit = jbuf;
 138       newsystem->invoked = ctype;
 139       newsystem->input_file = Str_dupstrTSD( name );
 140       newsystem->trace_override = newsystem->previous->trace_override;
 141       newsystem->ctrlcounter = newsystem->previous->ctrlcounter +
 142                                                newsystem->previous->cstackcnt;
 143
 144       /*
 145        * see note in execute_external
 146        * Fixes bug 604219
 147        */
 148       oldlevel = TSD->currlevel;
 149
 150       TSD->systeminfo = newsystem;
 151       TSD->systeminfo->currlevel0 = TSD->currlevel = newlevel( TSD, NULL );
 152       TSD->currlevel->pool = oldlevel->pool + 1;
 153
 154       TSD->currlevel->args = args;
 155
 156       if ( ipt )
 157          TSD->systeminfo->tree = *ipt;
 158       else if ( IsValidTin( (const external_parser_type *)instore, instore_length ) )
 159          TSD->systeminfo->tree = ExpandTinnedTree( TSD, (const external_parser_type *)instore, instore_length,
 160                                                    instore_source,
 161                                                    instore_source_length );
 162       else
 163       {
 164          memset( &TSD->systeminfo->tree, 0, sizeof( TSD->systeminfo->tree ) );
 165       }
 166       if ( TSD->systeminfo->hooks & HOOK_MASK( HOOK_INIT ) )
 167          hookup( TSD, HOOK_INIT );
 168
 169       doTermHook = 1;
 170
 171       if ( TSD->systeminfo->tree.root )
 172          ptr = interpret( TSD, TSD->systeminfo->tree.root );
 173       else
 174          ptr = NULL;
 175       TSD->currentnode = savecurrentnode; /* pgb */
 176    }
 177
 178    if ( doTermHook )
 179    {
 180       /*
 181        * Be sure to try it only once.
 182        */
 183       doTermHook = 0;
 184       if ( TSD->systeminfo->hooks & HOOK_MASK( HOOK_TERMIN ) )
 185          hookup( TSD, HOOK_TERMIN );
 186    }
 187
 188    tmpsys = TSD->systeminfo;
 189    TSD->systeminfo = TSD->systeminfo->previous;
 190    TSD->currlevel = oldlevel;
 191    TSD->trace_stat = TSD->currlevel->tracestat;
 192
 193    tmpsys->currlevel0->args = NULL;
 194
 195    /*
 196     * jbuf will be freed by killsystem.
 197     */
 198    killsystem( TSD, tmpsys );
 199
 200    RestoreInterpreterStatus( TSD, InterpreterStatus );
 201
 202    return ptr;
 203 }
 204
 205 streng *execute_external( tsd_t * volatile TSD, const streng *command,
 206                           paramboxptr args, const streng *envir,
 207                           int * volatile RetCode, int hooks, int ctype )
 208 {
 209    sysinfobox *newsystem, *tmpsys;
 210    streng *ptr=NULL;
 211    char *path;
 212    streng *name;
 213    int len;
 214    FILE *fptr;
 215    jmp_buf *jbuf;
 216    internal_parser_type parsing;
 217    volatile proclevel oldlevel;
 218    unsigned InterpreterStatus[IPRT_BUFSIZE];
 219    nodeptr savecurrentnode = TSD->currentnode;
 220    tsd_t * volatile saved_TSD;
 221    int * volatile saved_RetCode;
 222    volatile int doTermHook=0;
 223    int iserror=0;
 224
 225    if ( RetCode )
 226       *RetCode = 0;
 227
 228    SaveInterpreterStatus( TSD, InterpreterStatus );
 229    jbuf = (jmp_buf *)MallocTSD( sizeof( jmp_buf ) );
 230    assert( !TSD->in_protected );
 231
 232    saved_TSD = TSD; /* vars used until here */
 233    saved_RetCode = RetCode;
 234
 235    if ( setjmp( *jbuf ) )
 236    {
 237       TSD = saved_TSD;          /* prevents bugs like  592393 */
 238       RetCode = saved_RetCode;
 239
 240       ptr = TSD->systeminfo->result;
 241       TSD->systeminfo->result = NULL;
 242       if ( !TSD->instore_is_errorfree )
 243       {
 244          /*
 245           * In case of an error we don't return the error number as the result.
 246           * Instead, use the current "result" as the error code. It is set
 247           * to a negative value already by errortext().
 248           *
 249           * ==> errortext() uses a static buffer, if you ever need the value
 250           *     you have to dup it after the restore of the old system or you
 251           *     risk an endless loop.
 252           */
 253          if ( RetCode )
 254             *RetCode = atoi( ptr->value );
 255          /*
 256           * Defer the exiting with 40.1 until the jmpbuf stuff is done
 257           */
 258          iserror = 1;
 259          ptr = NULL;
 260       }
 261    }
 262    else
 263    {
 264       fptr = NULL;
 265       /* FGC: Check length first to avoid  */
 266       /*      access of invalid buffer     */
 267       if ( ( command->len == 7 )
 268       && ( memcmp( "<stdin>", command->value, command->len ) == 0 ) )
 269       {
 270          fptr = stdin;
 271          name = Str_dupstrTSD( command );
 272       }
 273       else
 274       {
 275          path = (char *) tmpstr_of( TSD, command );
 276          while ( rx_isspace( *path ) )
 277             path++;
 278          len = strlen( path );
 279          while ( len > 0 )
 280             if ( !rx_isspace( path[len - 1] ) )
 281                break;
 282             else
 283                len--;
 284          path[len] = '\0';
 285
 286          name = get_external_routine( TSD, path, &fptr );
 287          if ( !name )
 288          {
 289             FreeTSD( jbuf );
 290             if ( get_options_flag( TSD->currlevel, EXT_STRICT_ANSI ) )
 291             {
 292                /*
 293                 * If we can't find the external routine, we should exiterror()
 294                 * with 43.1 - as per ANSI
 295                 */
 296                exiterror( ERR_ROUTINE_NOT_FOUND, 1, path );
 297             }
 298             else
 299             {
 300                /*
 301                 * The only time this function is called with a non-NULL
 302                 * RetCode is from client.c, when an external routine
 303                 * is being executed via the SAA interface. In this case
 304                 * the error returned is the only thing we should do;
 305                 * we certainly should NOT be writing anything to stdout
 306                 * or stderr!
 307                 */
 308                if ( RetCode )
 309                {
 310                   *RetCode = -ERR_PROG_UNREADABLE;
 311                }
 312                return NULL;
 313             }
 314          }
 315       }
 316
 317       newsystem = creat_sysinfo( TSD, Str_dupTSD( envir ) );
 318       newsystem->previous = TSD->systeminfo;
 319       newsystem->hooks = hooks;
 320       newsystem->invoked = ctype;
 321       newsystem->script_exit = jbuf;
 322       newsystem->input_file = name;
 323       newsystem->trace_override = newsystem->previous->trace_override;
 324       newsystem->ctrlcounter = newsystem->previous->ctrlcounter +
 325                                                newsystem->previous->cstackcnt;
 326
 327       oldlevel = TSD->currlevel;
 328
 329       TSD->systeminfo = newsystem;
 330       TSD->systeminfo->currlevel0 = TSD->currlevel = newlevel( TSD, NULL );
 331       TSD->currlevel->pool = oldlevel->pool + 1;
 332
 333       savecurrentnode = TSD->currentnode; /* pgb fixes bug 595300 */
 334
 335       TSD->currlevel->args = args;
 336       TSD->currentnode = NULL;
 337
 338       fetch_file( TSD, fptr, &parsing );
 339       if ( fptr != stdin )
 340          fclose( fptr );
 341       if ( parsing.result == 0 )
 342       {
 343          TSD->systeminfo->tree = parsing;
 344          /*
 345           * Execute any RXINI system exit
 346           */
 347          if ( TSD->systeminfo->hooks & HOOK_MASK( HOOK_INIT ) )
 348             hookup( TSD, HOOK_INIT );
 349
 350          doTermHook = 1;
 351
 352          ptr = interpret( TSD, TSD->systeminfo->tree.root );
 353          TSD->currentnode = savecurrentnode; /* pgb */
 354       }
 355       else
 356       {
 357          TSD->currentnode = savecurrentnode; /* pgb */
 358          ptr = NULL;
 359          exiterror( ERR_YACC_SYNTAX, 1, parsing.tline );
 360       }
 361    }
 362    /*
 363     * Execute any RXTER system exit
 364     */
 365    if ( doTermHook )
 366    {
 367       /*
 368        * Be sure to try it only once.
 369        */
 370       doTermHook = 0;
 371       if ( TSD->systeminfo->hooks & HOOK_MASK( HOOK_TERMIN ) )
 372          hookup( TSD, HOOK_TERMIN );
 373    }
 374    if ( TSD->systeminfo->hooks & HOOK_MASK( HOOK_TERMIN ) )
 375       hookup( TSD, HOOK_TERMIN );
 376
 377    tmpsys = TSD->systeminfo;
 378    TSD->systeminfo = TSD->systeminfo->previous;
 379    TSD->currlevel = oldlevel;
 380    TSD->trace_stat = TSD->currlevel->tracestat;
 381
 382    tmpsys->currlevel0->args = NULL;
 383
 384    /*
 385     * jbuf will be freed by killsystem
 386     */
 387    killsystem( TSD, tmpsys );
 388
 389    /*
 390     * If the called routine failed exit with "external routine failed"
 391     * depending on OPTION HALT_ON_EXT_CALL_FAIL or with STRICT_ANSI
 392     */
 393    if ( iserror)
 394    {
 395       if ( get_options_flag( TSD->currlevel, EXT_HALT_ON_EXT_CALL_FAIL )
 396       ||   get_options_flag( TSD->currlevel, EXT_STRICT_ANSI ) )
 397       {
 398          char *cmd = (char *) tmpstr_of( TSD, command );
 399          exiterror( 40, 1, cmd);
 400       }
 401    }
 402
 403    RestoreInterpreterStatus( TSD, InterpreterStatus );
 404    /*
 405     * Oops, we really ought to handle function-did-not-return-data
 406     */
 407    return ptr;
 408 }
 409
 410
 411 internal_parser_type enter_macro( tsd_t *TSD, const streng *source,
 412                                   void **ept, unsigned long *extlength)
 413 {
 414    internal_parser_type parsing;
 415
 416    fetch_string( TSD, source, &parsing );
 417    if (parsing.result != 0)
 418    {
 419       exiterror( ERR_YACC_SYNTAX, 1, parsing.tline ) ;
 420       return(parsing);
 421    }
 422    if (ept && extlength)
 423       *ept = TinTree( TSD, &parsing, extlength ) ;
 424
 425    return( parsing );
 426 }
 427
 428 /*
 429  * Takes as input a pointer to a parameter structure, and counts the
 430  * number of parameters in it, and return that value. The counting
 431  * can be performed in two different manners, either soft or hard.
 432  * Soft means that "trailing" ommitted parameters are ignored, hard
 433  * means that all parameters are counted. (When counting hard, all
 434  * routines stared from Rexx has at least one parameter: the one that
 435  * was ommitted. However, when started from C by SAA API, functions
 436  * can be started with zero parameters.)
 437  */
 438 int count_params( cparamboxptr ptr, int soft )
 439 {
 440    int scnt=0, hcnt=0 ;
 441
 442    assert( PARAM_TYPE_SOFT && !PARAM_TYPE_HARD ) ;
 443
 444    for (hcnt=scnt=0; ptr; ptr=ptr->next, hcnt++)
 445       if (soft && ptr->value)
 446          scnt = hcnt ;
 447
 448    return ((soft) ? scnt : hcnt ) ;
 449
 450 }
 451
 452
 453 /*
 454  * Takes a pointer to an argument structure as input, together with an
 455  * integer. Returns the parameter numbered by the number, or NULL if
 456  * either that parameter is omitted or otherwise non-existing.
 457  */
 458 streng *get_parameter( paramboxptr ptr, int number )
 459 {
 460    assert( number>0 ) ;
 461    for (; ptr && (--number!=0); ptr=ptr->next) ;
 462
 463    return ((ptr && ptr->value) ? ptr->value : NULL ) ;
 464 }