regina/rexx.c

   1 #ifndef lint
   2 static char *RCSid = "$Id$";
   3 #endif
   4
   5 /*
   6  *  The Regina Rexx Interpreter
   7  *  Copyright (C) 1992-1994  Anders Christensen <anders@pvv.unit.no>
   8  *
   9  *  This library is free software; you can redistribute it and/or
  10  *  modify it under the terms of the GNU Library General Public
  11  *  License as published by the Free Software Foundation; either
  12  *  version 2 of the License, or (at your option) any later version.
  13  *
  14  *  This library is distributed in the hope that it will be useful,
  15  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  16  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17  *  Library General Public License for more details.
  18  *
  19  *  You should have received a copy of the GNU Library General Public
  20  *  License along with this library; if not, write to the Free
  21  *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  22  */
  23 #if defined(WIN32) && defined(__IBMC__)
  24 #include <windows.h>
  25 #pragma warning(default: 4115 4201 4214)
  26 #else
  27 # ifdef RXLIB
  28 #  define APIENTRY
  29 #  if defined(__WATCOMC__) && defined(__NT__)
  30 #   undef APIENTRY
  31 #   include <windows.h>
  32 #  endif
  33 #  if defined(__MINGW32__)
  34 #   undef APIENTRY
  35 #   include <windows.h>
  36 #  endif
  37 #  if defined(WIN32) && defined(__BORLANDC__)
  38 #   undef APIENTRY
  39 #   include <windows.h>
  40 #  endif
  41
  42 #  if defined(_MSC_VER)
  43 #   undef APIENTRY
  44 #   if _MSC_VER >= 1100
  45 /* Stupid MSC can't compile own headers without warning at least in VC 5.0 */
  46 #    pragma warning(disable: 4115 4201 4214)
  47 #   endif
  48 #   include <windows.h>
  49 #   if _MSC_VER >= 1100
  50 #    pragma warning(default: 4115 4201 4214)
  51 #   endif
  52 #  endif
  53 # else /* not RXLIB */
  54 #  if defined(__WATCOMC__) && defined(__NT__)
  55 #   include <windows.h>
  56 # endif
  57 #  if defined(__MINGW32__)
  58 #   include <windows.h>
  59 #  endif
  60 #  if defined(WIN32) && defined(__BORLANDC__)
  61 #   include <windows.h>
  62 #  endif
  63
  64 #  if defined(_MSC_VER) && !defined(__WINS__)
  65 #   if _MSC_VER >= 1100
  66 /* Stupid MSC can't compile own headers without warning at least in VC 5.0 */
  67 #    pragma warning(disable: 4115 4201 4214)
  68 #   endif
  69 #   include <windows.h>
  70 #   if _MSC_VER >= 1100
  71 #    pragma warning(default: 4115 4201 4214)
  72 #   endif
  73 #  endif
  74 # endif
  75 #endif
  76
  77 #if defined(OS2) || defined(__EMX__)
  78 # define INCL_BASE
  79 # include <os2.h>
  80 # define DONT_TYPEDEF_PFN
  81 #endif
  82
  83 #include "rexx.h"
  84 #include <string.h>
  85 #include <stdio.h>
  86 #include <ctype.h>
  87 #include <assert.h>
  88
  89 #ifdef VMS
  90 # include <stat.h>
  91 #elif defined(MAC)
  92 # include "mac.h"
  93 #else
  94 # include <sys/stat.h>
  95 #endif
  96
  97 #if defined(DJGPP) || defined(__EMX__) || defined(_MSC_VER) || (defined(__WATCOMC__) && !defined(__QNX__)) || defined(__EPOC32__)
  98 # include <fcntl.h>
  99 # if !defined(__WINS__) && !defined(__EPOC32__)
 100 #  include <io.h>
 101 # endif
 102 #endif
 103
 104 #ifdef HAVE_UNISTD_H
 105 # include <unistd.h>
 106 #endif
 107
 108 /*
 109  * Since development of Ultrix has ceased, and they never managed to
 110  * fix a few things, we want to define a few things, just in order
 111  * to kill a few warnings ...
 112  */
 113 #if defined(FIX_PROTOS) && defined(FIX_ALL_PROTOS) && defined(ultrix)
 114    int fstat( int fd, struct stat *buf ) ;
 115    int stat( char *path, struct stat *buf ) ;
 116 #endif
 117
 118
 119 /* Don't terminate the following lines by a semicolon */
 120 GLOBAL_PROTECTION_VAR(regina_globals)
 121
 122
 123 /*
 124  * Note: must match the settings of NUM_FORM_* in flags.h
 125  */
 126 const char *numeric_forms[] = { "SCIENTIFIC", "ENGINEERING" } ;
 127
 128 /*
 129  * Note: these must match the definitions of INVO_* in defs.h
 130  */
 131 const char *invo_strings[] = { "COMMAND", "FUNCTION", "SUBROUTINE" } ;
 132
 133 const char *argv0 = NULL;
 134
 135 #ifdef TRACEMEM
 136 void marksubtree( nodeptr ptr )
 137 {
 138    int i=0 ;
 139    if ( ptr )
 140    {
 141       markmemory(ptr,TRC_TREENODE) ;
 142       if (ptr->name) markmemory(ptr->name, TRC_TREENODE) ;
 143       for (i=0;i<sizeof(ptr->p)/sizeof(ptr->p[0]);marksubtree(ptr->p[i++])) ;
 144       if (ptr->next) marksubtree( ptr->next ) ;
 145
 146       if (ptr->type == X_STRING || ptr->type == X_CON_SYMBOL)
 147          if (ptr->u.number)
 148          {
 149             markmemory( ptr->u.number, TRC_TREENODE ) ;
 150             markmemory( ptr->u.number->num, TRC_TREENODE ) ;
 151          }
 152
 153       if (ptr->type == X_CEXPRLIST)
 154          if (ptr->u.strng)
 155             markmemory( ptr->u.strng, TRC_TREENODE ) ;
 156    }
 157 }
 158 #endif /* TRACEMEM */
 159
 160
 161 /* FIXME, FGC: This is a useless function! */
 162 nodeptr treadit( cnodeptr tree )
 163 {
 164 /*
 165    nodeptr left, mid, right ;
 166  */
 167    tree = tree;
 168    return NULL ;
 169 /*
 170    if (!tree)
 171       return NULL ;
 172
 173    left = tree->p[0] ;
 174    mid = tree->p[1] ;
 175    right = tree->p[2] ;
 176
 177    switch (tree->type)
 178    {
 179       case X_OTHERWISE:
 180       case X_PROGRAM:
 181          treadit( left ) ;
 182          tree = NULL ;
 183          break ;
 184
 185       case X_STATS:
 186       case X_WHENS:
 187          left->next = treadit( mid ) ;
 188          treadit( left ) ;
 189          tree = left ;
 190          break ;
 191
 192       case X_IF:
 193          treadit( mid ) ;
 194       case X_DO:
 195          treadit( right ) ;
 196          break ;
 197
 198       case X_SELECT:
 199          treadit( left ) ;
 200       case X_WHEN:
 201          treadit( mid ) ;
 202          break ;
 203    }
 204
 205    return tree ;
 206  */
 207 }
 208
 209 /* GetArgv0 tries to find the fully qualified filename of the current program.
 210  * It uses some ugly and system specific tricks and it may return NULL if
 211  * it can't find any useful value.
 212  * The argument should be argv[0] of main() and it may be returned.
 213  * This function must not be called from another as the sole one when starting
 214  * up.
 215  */
 216 static const char *GetArgv0(const char *argv0)
 217 {
 218 #ifdef WIN32
 219    char buf[512];
 220
 221    if (GetModuleFileName(NULL, buf, sizeof(buf)) != 0)
 222       return(strdup(buf)); /* never freed up */
 223 #elif defined(OS2)
 224    char buf[512];
 225    PPIB ppib;
 226
 227 # ifdef __EMX__
 228    if (_osmode == OS2_MODE)
 229    {
 230 # endif
 231       if (DosGetInfoBlocks(NULL, &ppib) == 0)
 232          if (DosQueryModuleName(ppib->pib_hmte, sizeof(buf), buf) == 0)
 233             return(strdup(buf));
 234 # ifdef __EMX__
 235    }
 236 # endif
 237 #endif
 238
 239    /* No specific code has found the right file name. Maybe, it's coded
 240     * in argv0. Check it, if it is an absolute path. Be absolutely sure
 241     * to detect it safely!
 242     */
 243    if (argv0 == NULL)
 244       return(NULL);
 245
 246    if (argv0[0] == '/') /* unix systems and some others */
 247       return(argv0);
 248
 249    if ((argv0[0] == '\\') && (argv0[1] == '\\')) /* MS and OS/2 UNC names */
 250       return(argv0);
 251
 252    if (isalpha(argv0[0]) && (argv0[1] == ':') && (argv0[2] == '\\'))
 253       return(argv0); /* MS and OS/2 drive letter with path */
 254
 255    return(NULL); /* not a proven argv0 argument */
 256 }
 257
 258 #ifdef RXLIB
 259 int APIENTRY __regina_faked_main(int argc,char *argv[])
 260 #define CALL_MAIN __regina_faked_main
 261 #else
 262 int main(int argc,char *argv[])
 263 #define CALL_MAIN main
 264 #endif
 265 {
 266    FILE *fptr = NULL ;
 267    streng *string=NULL ;
 268    int i=0, j=0, stdinput=1, state=0, rcode=0, oldi=0, trace_override=0 ;
 269    paramboxptr args=NULL, prev ;
 270    char *arg=NULL ;
 271    int make_perl=0 ;
 272    int do_yydebug=0;
 273    char name[1024];
 274    internal_parser_type parsing;
 275    tsd_t *TSD;
 276
 277 #ifdef MAC
 278    InitCursorCtl(nil);
 279 #endif
 280     /*
 281      * For WIN32, set an atexit() function to allow the user to see the output
 282      * from the program if run from Explorer or the Start menu.
 283      * Only do this if we are running Regina, and not from another process
 284      * that uses the API.
 285      */
 286 #if defined(WIN32) && !defined(__WINS__) && !defined(__EPOC32__)
 287    set_pause_at_exit();
 288 #endif
 289
 290    if (argv0 == NULL)
 291       argv0 = GetArgv0(argv[0]);
 292
 293    TSD = GLOBAL_ENTRY_POINT();
 294
 295    TSD->stddump = stderr ;
 296
 297    TSD->systeminfo = creat_sysinfo( TSD, Str_creTSD("SYSTEM")) ;
 298    TSD->systeminfo->called_as = Str_creTSD( argv[0] ) ;
 299
 300    TSD->systeminfo->currlevel0 = TSD->currlevel = newlevel( TSD, NULL ) ;
 301    TSD->systeminfo->trace_override = 0;
 302    TSD->isclient = 0;
 303
 304    for (i=1; i<argc; i++)
 305    {
 306       arg = argv[i] ;
 307       if (state==0)
 308       {
 309          if (*arg=='-')
 310          {
 311             switch (*(++arg))
 312             {
 313                case 'i':
 314                   starttrace(TSD) ;
 315                   set_trace_char(TSD, 'A') ;
 316                   intertrace(TSD) ;
 317                   intertrace(TSD) ;
 318                   break ;
 319
 320                case 'C':
 321                   if (*(arg+1)=='i')
 322                   {
 323                      TSD->isclient = 1 ; /* Other than the default value of 0 */
 324 #if defined(WIN32) && !defined(__WINS__) && !defined(__EPOC32__)
 325                      dont_pause_at_exit();
 326 #endif
 327                   }
 328                   break ;
 329
 330                case 'p':
 331                   make_perl = 1 ;
 332                   break ;
 333
 334                case 'v':
 335                   fprintf( stderr, "%s\n", PARSE_VERSION_STRING );
 336                   return 0;
 337                   break ;
 338
 339                case 'y':
 340                   do_yydebug = 1 ;
 341                   break ;
 342
 343                case 'r': /* safe-rexx */
 344                   TSD->restricted = 1 ;
 345                   break ;
 346
 347                case 't':
 348                   queue_trace_char(TSD, (char) (*(arg+1)? *(++arg) : 'A')) ;
 349                   trace_override = 1;
 350                   break ;
 351
 352                case 'd':
 353                   if (*(arg+1)=='m')
 354                      TSD->listleakedmemory = 1 ;
 355                   break ;
 356
 357                case 'a':
 358                   TSD->systeminfo->invoked = INVO_SUBROUTINE;
 359                   break ;
 360             }
 361          }
 362          else
 363          {
 364             stdinput = 0 ;
 365             get_external_routine( TSD, "REGINA_MACROS", argv[i], &fptr, name, 1 );
 366             if (!fptr)
 367             {
 368                get_external_routine( TSD, "PATH", argv[i], &fptr, name, 1 );
 369                if ( !fptr )
 370                {
 371                   TSD->systeminfo->input_file = Str_crestrTSD(argv[i]) ;
 372                   exiterror( ERR_PROG_UNREADABLE, 1, "Program was not found" )  ;
 373                }
 374             }
 375             TSD->systeminfo->input_file = Str_crestrTSD(name) ;
 376             TSD->systeminfo->input_fp = fptr ;
 377             break ;
 378          }
 379       }
 380     }
 381     /*
 382      * Under DJGPP setmode screws up Parse Pull and entering code interactively :-(
 383      */
 384 #if defined(__EMX__) || (defined(_MSC_VER) && !defined(__WINS__)) || (defined(__WATCOMC__) && !defined(__QNX__))
 385     setmode( fileno( stdin ), O_BINARY );
 386     setmode( fileno( stdout ), O_BINARY );
 387     setmode( fileno( stderr ), O_BINARY );
 388 #endif
 389
 390    if (stdinput)
 391    {
 392       TSD->systeminfo->input_file = Str_crestrTSD("<stdin>") ;
 393       TSD->systeminfo->input_fp = NULL;
 394    }
 395
 396    if (TSD->isclient)
 397       return 0 ;
 398
 399    oldi = ++i ;
 400
 401    if ( TSD->systeminfo->invoked == INVO_SUBROUTINE )
 402    {
 403       prev = NULL;
 404       for (i=oldi;i<argc;i++)
 405       {
 406          args = MallocTSD(sizeof(parambox)) ;
 407          if ( i == oldi )
 408             TSD->currlevel->args = args;
 409          else
 410             prev->next = args;
 411          memset(args,0,sizeof(parambox)); /* especially ->value */
 412          args->value = Str_cre_TSD( TSD, argv[i] ) ;
 413          prev = args;
 414       }
 415    }
 416    else
 417    {
 418       for (j=1;i<argc;i++)
 419          j += strlen(argv[i]) + 1 ;
 420
 421       TSD->currlevel->args = args = MallocTSD(sizeof(parambox)) ;
 422       memset(args,0,sizeof(parambox)); /* especially ->value */
 423    /*
 424       args->value = Str_dupTSD(TSD->systeminfo->input_file) ;
 425       args = args->next = MallocTSD(sizeof(parambox)) ;
 426     */
 427       args->next = NULL ;
 428       if (oldi>=argc)
 429          args->value = string = NULL ;
 430       else
 431       {
 432          args->value = string = Str_makeTSD( j ) ;
 433          string->len = 0 ;
 434       }
 435
 436       for (i=oldi;i<argc;i++)
 437       {
 438          string = Str_catstrTSD(string,argv[i]) ;
 439          string->value[string->len++] = ' ' ;
 440       }
 441       if (string && string->len)
 442         string->len-- ;
 443    }
 444
 445    signal_setup( TSD ) ;
 446
 447 #ifndef NDEBUG
 448    __reginadebug = do_yydebug ;   /* 1 == yacc-debugging */
 449 #endif
 450    fetch_file( TSD, fptr ? fptr : stdin, &parsing );
 451
 452    if (parsing.result != 0)
 453       exiterror( ERR_YACC_SYNTAX, 1, parsing.tline ) ;
 454    else
 455       TSD->systeminfo->tree = parsing;
 456
 457    if (trace_override)
 458       TSD->systeminfo->trace_override = 1;
 459    else
 460       TSD->systeminfo->trace_override = 0;
 461
 462 #ifndef R2PERL
 463 #ifndef MINIMAL
 464 #ifndef VMS
 465 #ifndef DOS
 466 #ifndef _MSC_VER
 467 #ifndef __IBMC__
 468 #ifndef MAC
 469    if ( stdinput )
 470    {
 471       struct stat buffer ;
 472
 473       /*
 474        * The following line is likely to give a warning when compiled
 475        * under Ultrix, this can be safely ignored, since it is just a
 476        * result of Digital not defining their include files properly.
 477        */
 478       rcode = fstat( fileno(stdin), &buffer ) ;
 479       if (rcode==0 && S_ISCHR(buffer.st_mode))
 480       {
 481          printf("  \b\b") ;
 482          fflush(stdout) ;
 483          rewind(stdin) ;
 484       }
 485    }
 486 #endif /* !MAC */
 487 #endif /* !__IBMC__ */
 488 #endif /* !_MSC_VER */
 489 #endif /* !DOS */
 490 #endif /* !VMS */
 491 #endif /* !MINIMAL */
 492 #endif /* !R2PERL */
 493
 494    treadit( TSD->systeminfo->tree.root ) ;
 495
 496 #ifdef R2PERL
 497    if (make_perl)
 498    {
 499       preamble() ;
 500       translate( TSD, TSD->systeminfo->tree.root ) ;
 501       return( 0 ) ;
 502    }
 503 #endif
 504
 505    flush_trace_chars(TSD) ;
 506    {
 507       nodeptr savecurrentnode = TSD->currentnode; /* pgb */
 508       string = interpret( TSD, TSD->systeminfo->tree.root ) ;
 509       TSD->currentnode = savecurrentnode; /* pgb */
 510    }
 511    rcode = EXIT_SUCCESS ;
 512    if ( string
 513    &&   myisinteger( string ) )
 514       rcode = myatol( TSD, string ) ;
 515
 516    purge_stacks( TSD );
 517 #if defined(FLISTS) && defined(NEW_FLISTS)
 518    free_flists();
 519 #endif
 520
 521 #ifdef DYNAMIC
 522    /*
 523     * Remove all external function package functions
 524     * and libraries. Only valid for the DYNAMIC library.
 525     */
 526    purge_library( TSD );
 527 #endif
 528
 529 #ifdef TRACEMEM
 530    if (TSD->listleakedmemory)
 531       listleaked( TSD, MEMTRC_LEAKED )  ;
 532 #endif
 533
 534    killsystem( TSD, TSD->systeminfo );
 535    TSD->systeminfo = NULL ;
 536
 537    /*
 538     * Remove all memory allocated by the flists internal memory manager.
 539     */
 540 #ifdef FLISTS
 541    purge_flists( TSD );
 542 #endif
 543
 544    return(rcode) ;
 545
 546 }
 547
 548 /* reexecute_main is possibly called by one of the fork_exec routines.
 549  * This functions cleans up some stuff to reexecute without problems.
 550  * The most useful thing to be done here is freeing all used memory.
 551  * NOTE: usage is always the last thing you should try. Better use
 552  * spawn or exec to let a fresh interpreter do the work.
 553  */
 554 int __regina_reexecute_main(int argc, char **argv)
 555 {
 556    tsd_t *TSD;
 557
 558    TSD = __regina_get_tsd(); /* hopefully not multithreading! */
 559
 560    if (TSD != NULL) /* yes! I don't know what happens on forking */
 561    {                /* and active multi-threading                */
 562
 563       purge_stacks(TSD);    /* see main above for comments */
 564       purge_filetable(TSD);
 565 #ifdef DYNAMIC
 566       purge_library(TSD);
 567 #endif
 568 #if defined(FLISTS)
 569 # if defined(NEW_FLISTS)
 570       free_flists();
 571 # endif
 572       purge_flists(TSD);
 573 #endif
 574    }
 575
 576    return(CALL_MAIN(argc, argv));
 577 }
 578
 579 #ifdef TRACEMEM
 580 void mark_systeminfo( const tsd_t *TSD )
 581 {
 582    sysinfo sinfo=NULL ;
 583    labelbox *lptr=NULL ;
 584    lineboxptr llptr=NULL ;
 585
 586    for (sinfo=TSD->systeminfo; sinfo; sinfo=sinfo->previous)
 587    {
 588       markmemory(sinfo, TRC_SYSINFO) ;
 589       markmemory(sinfo->called_as, TRC_SYSINFO) ;
 590       markmemory(sinfo->input_file, TRC_SYSINFO) ;
 591       markmemory(sinfo->environment, TRC_SYSINFO) ;
 592       markmemory(sinfo->callstack, TRC_SYSINFO) ;
 593
 594       markvariables( TSD, sinfo->currlevel0 ) ;
 595       marksource( sinfo->tree.first_source_line ) ;
 596       /* FGC, FIXME: rewrite this: marksubtree( sinfo->tree.root ) ; */
 597
 598       for (lptr=sinfo->tree.first_label; lptr; lptr=lptr->next )
 599       {
 600          markmemory( lptr, TRC_SYSINFO ) ;
 601       }
 602
 603       for (llptr=sinfo->tree.first_source_line; llptr; llptr=llptr->next )
 604       {
 605          markmemory( llptr, TRC_SYSINFO ) ;
 606          markmemory( llptr->line, TRC_SYSINFO ) ;
 607       }
 608    }
 609 }
 610 #endif
 611
 612
 613 sysinfobox *creat_sysinfo( const tsd_t *TSD, streng *envir )
 614 {
 615    sysinfobox *sinfo=NULL ;
 616
 617    sinfo = MallocTSD( sizeof(sysinfobox) ) ;
 618    sinfo->environment = envir ;
 619    sinfo->tracing = DEFAULT_TRACING ;
 620    sinfo->interactive = DEFAULT_INT_TRACING ;
 621    sinfo->previous = NULL ;
 622    sinfo->invoked = INVO_COMMAND ;
 623    sinfo->called_as = NULL ;
 624    sinfo->input_file = NULL ;
 625    sinfo->input_fp = NULL ;
 626    sinfo->panic = NULL ;
 627    sinfo->hooks = 0 ;
 628    sinfo->callstack = MallocTSD(sizeof(nodeptr)*10) ;
 629    sinfo->result = NULL ;
 630    sinfo->cstackcnt = 0 ;
 631    sinfo->cstackmax = 10 ;
 632    sinfo->trace_override = 0 ;
 633    memset(&sinfo->tree, 0, sizeof(sinfo->tree));
 634
 635    return sinfo ;
 636 }
 637
 638 #if !defined(RXLIB)
 639
 640 static void NoAPI( void )
 641 {
 642    fprintf (stderr, "Warning: SAA API not compiled into interpreter\n" ) ;
 643 }
 644
 645 int hookup( const tsd_t *TSD, int dummy )
 646 {
 647    /* This should never happen, if we don't have support for SAA API,
 648     * Then we should never get a system exit!
 649     */
 650    assert( 0 ) ;
 651    dummy = dummy; /* keep compiler happy */
 652    TSD = TSD; /* keep compiler happy */
 653    return 1 ;  /* to keep compiler happy */
 654 }
 655 int hookup_input( const tsd_t *TSD, int dummy1, streng **dummy2 )
 656 {
 657    /* This should never happen, if we don't have support for SAA API,
 658     * Then we should never get a system exit!
 659     */
 660    TSD = TSD; /* keep compiler happy */
 661    dummy1 = dummy1; /* keep compiler happy */
 662    dummy2 = dummy2; /* keep compiler happy */
 663    assert( 0 ) ;
 664    return 1 ;  /* to keep compiler happy */
 665 }
 666 int hookup_input_output( const tsd_t *TSD, int dummy1, const streng *dummy2, streng **dummy3 )
 667 {
 668    /* This should never happen, if we don't have support for SAA API,
 669     * Then we should never get a system exit!
 670     */
 671    TSD = TSD; /* keep compiler happy */
 672    dummy1 = dummy1; /* keep compiler happy */
 673    dummy2 = dummy2; /* keep compiler happy */
 674    dummy3 = dummy3; /* keep compiler happy */
 675    assert( 0 ) ;
 676    return 1 ;  /* to keep compiler happy */
 677 }
 678 int hookup_output( const tsd_t *TSD, int dummy1, const streng *dummy2 )
 679 {
 680    /* This should never happen, if we don't have support for SAA API,
 681     * Then we should never get a system exit!
 682     */
 683    assert( 0 ) ;
 684    dummy1 = dummy1; /* keep compiler happy */
 685    dummy2 = dummy2; /* keep compiler happy */
 686    TSD = TSD; /* keep compiler happy */
 687    return 1 ;  /* to keep compiler happy */
 688 }
 689 int hookup_output2( const tsd_t *TSD, int dummy1, const streng *dummy2, const streng *dummy3 )
 690 {
 691    /* This should never happen, if we don't have support for SAA API,
 692     * Then we should never get a system exit!
 693     */
 694    assert( 0 ) ;
 695    dummy1 = dummy1; /* keep compiler happy */
 696    dummy2 = dummy2; /* keep compiler happy */
 697    dummy3 = dummy3; /* keep compiler happy */
 698    TSD = TSD; /* keep compiler happy */
 699    return 1 ;  /* to keep compiler happy */
 700 }
 701
 702 static void Exit(const tsd_t *TSD)
 703 {
 704    if (TSD->in_protected)
 705    {
 706       jmp_buf h;
 707
 708       memcpy(h,TSD->protect_return,sizeof(jmp_buf));
 709       /* cheat about the const, we go away anyway :-) */
 710       ((tsd_t *)TSD)->delayed_error_type = PROTECTED_DelayedExit;
 711       ((tsd_t *)TSD)->expected_exit_error = 1;
 712       longjmp( h, 1 ) ;
 713    }
 714    TSD->MTExit( 1 ) ;
 715 }
 716
 717 streng *do_an_external_exe( tsd_t *TSD, const streng *dummy1, cparamboxptr dummy2, char dummy3, char dummy4 )
 718 {
 719    NoAPI();
 720    dummy1 = dummy1; /* keep compiler happy */
 721    dummy2 = dummy2; /* keep compiler happy */
 722    dummy3 = dummy3; /* keep compiler happy */
 723    dummy4 = dummy4; /* keep compiler happy */
 724    Exit( TSD ) ;
 725    return NULL;
 726 }
 727
 728 streng *do_an_external_dll( tsd_t *TSD, const void *dummy1, cparamboxptr dummy2, char dummy3 )
 729 {
 730    NoAPI();
 731    dummy1 = dummy1; /* keep compiler happy */
 732    dummy2 = dummy2; /* keep compiler happy */
 733    dummy3 = dummy3; /* keep compiler happy */
 734    Exit( TSD ) ;
 735    return NULL;
 736 }
 737
 738
 739 streng *SubCom( const tsd_t *TSD, const streng *dummy1, const streng *dummy2, int *dummy3 )
 740 {
 741    NoAPI();
 742    dummy1 = dummy1; /* keep compiler happy */
 743    dummy2 = dummy2; /* keep compiler happy */
 744    dummy3 = dummy3; /* keep compiler happy */
 745    Exit( TSD ) ;
 746    return NULL;
 747 }
 748
 749 int IfcHaveFunctionExit(const tsd_t *TSD)
 750 {
 751    TSD = TSD; /* keep compiler happy */
 752    return(0);
 753 }
 754
 755 #endif
 756