regina/funcs.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 "rxiface.h"
  22 #include <string.h>
  23 #include <stdio.h>
  24 #include <assert.h>
  25 #include <time.h>
  26
  27 static streng *conflict_close( tsd_t *TSD, cparamboxptr parms );
  28 static streng *conflict_eof( tsd_t *TSD, cparamboxptr parms );
  29 static streng *conflict_open( tsd_t *TSD, cparamboxptr parms );
  30
  31 struct function_type
  32 {
  33    int compat ;
  34    streng *(*function)(tsd_t *,cparamboxptr) ;
  35    const char *funcname ;
  36 } ;
  37
  38 /*
  39  * A 0 in the first column of this table indicates that this BIF is ANSI.
  40  * Any other value
  41  */
  42 static const struct function_type functions[] = {
  43   { 0,              std_abbrev,            "ABBREV" },
  44   { 0,              std_abs,               "ABS" },
  45 #if defined(_AMIGA) || defined(__AROS__)
  46   { EXT_AREXX_BIFS, amiga_addlib,          "ADDLIB" },
  47 #endif
  48   { 0,              std_address,           "ADDRESS" },
  49 #ifdef TRACEMEM
  50   { EXT_REGINA_BIFS,dbg_allocated,         "ALLOCATED" },
  51 #endif
  52   { 0,              std_arg,               "ARG" },
  53   { EXT_AREXX_BIFS, arexx_b2c,             "B2C" },
  54   { 0,              std_b2x,               "B2X" },
  55   { EXT_REGINA_BIFS,os2_beep,              "BEEP" },
  56   { 0,              std_bitand,            "BITAND" },
  57   { EXT_AREXX_BIFS, arexx_bitchg,          "BITCHG" },
  58   { EXT_AREXX_BIFS, arexx_bitclr,          "BITCLR" },
  59   { EXT_AREXX_BIFS, arexx_bitcomp,         "BITCOMP" },
  60   { 0,              std_bitor,             "BITOR" },
  61   { EXT_AREXX_BIFS, arexx_bitset,          "BITSET" },
  62   { EXT_AREXX_BIFS, arexx_bittst,          "BITTST" },
  63   { 0,              std_bitxor,            "BITXOR" },
  64   { EXT_BUFTYPE_BIF,cms_buftype,           "BUFTYPE" },
  65   { EXT_AREXX_BIFS, arexx_c2b,             "C2B" },
  66   { 0,              std_c2d,               "C2D" },
  67   { 0,              std_c2x,               "C2X" },
  68   { EXT_REGINA_BIFS,unx_chdir,             "CD" },
  69   { 0,              std_center,            "CENTER" },
  70   { 0,              std_center,            "CENTRE" },
  71   { 0,              std_changestr,         "CHANGESTR" }, /* ANSI Std 1996 - MH 10-06-96 */
  72   { 0,              std_charin,            "CHARIN" },
  73   { 0,              std_charout,           "CHAROUT" },
  74   { 0,              std_chars,             "CHARS" },
  75   { EXT_REGINA_BIFS,unx_chdir,             "CHDIR" },
  76   { EXT_REGINA_BIFS,conflict_close,        "CLOSE" },
  77   { 0,              std_compare,           "COMPARE" },
  78   { EXT_AREXX_BIFS, arexx_compress,        "COMPRESS" },
  79   { 0,              std_condition,         "CONDITION" },
  80   { 0,              std_copies,            "COPIES" },
  81   { 0,              std_countstr,          "COUNTSTR" },   /* ANSI Std 1996 - MH 10-06-96 */
  82   { EXT_REGINA_BIFS,unx_crypt,             "CRYPT" },
  83   { 0,              std_d2c,               "D2C" },
  84   { 0,              std_d2x,               "D2X" },
  85   { 0,              std_datatype,          "DATATYPE" },
  86   { 0,              std_date,              "DATE" },
  87   { 0,              std_delstr,            "DELSTR" },
  88   { 0,              std_delword,           "DELWORD" },
  89   { EXT_DESBUF_BIF, cms_desbuf,            "DESBUF" },
  90   { 0,              std_digits,            "DIGITS" },
  91   { EXT_REGINA_BIFS,os2_directory,         "DIRECTORY" },
  92   { EXT_DROPBUF_BIF,cms_dropbuf,           "DROPBUF" },
  93 #ifndef NDEBUG
  94   { EXT_REGINA_BIFS,dbg_dumpfiles,         "DUMPFILES" },
  95   { EXT_REGINA_BIFS,dbg_dumptree,          "DUMPTREE" },
  96   { EXT_REGINA_BIFS,dbg_dumpvars,          "DUMPVARS" },
  97 #endif
  98   { EXT_REGINA_BIFS,conflict_eof,          "EOF" },
  99   { 0,              std_errortext,         "ERRORTEXT" },
 100   { EXT_AREXX_BIFS, arexx_exists,          "EXISTS" },
 101   { EXT_AREXX_BIFS, arexx_export,          "EXPORT" },
 102 #ifdef VMS
 103   { EXT_REGINA_BIFS,vms_f_cvsi,            "F$CVSI" },
 104   { EXT_REGINA_BIFS,vms_f_cvtime,          "F$CVTIME" },
 105   { EXT_REGINA_BIFS,vms_f_cvui,            "F$CVUI" },
 106   { EXT_REGINA_BIFS,vms_f_directory,       "F$DIRECTORY" },
 107   { EXT_REGINA_BIFS,vms_f_element,         "F$ELEMENT" },
 108   { EXT_REGINA_BIFS,vms_f_extract,         "F$EXTRACT" },
 109   { EXT_REGINA_BIFS,vms_f_fao,             "F$FAO" },
 110   { EXT_REGINA_BIFS,vms_f_file_attributes, "F$FILE_ATTRIBUTES" },
 111   { EXT_REGINA_BIFS,vms_f_getdvi,          "F$GETDVI" },
 112   { EXT_REGINA_BIFS,vms_f_getjpi,          "F$GETJPI" },
 113   { EXT_REGINA_BIFS,vms_f_getqui,          "F$GETQUI" },
 114   { EXT_REGINA_BIFS,vms_f_getsyi,          "F$GETSYI" },
 115   { EXT_REGINA_BIFS,vms_f_identifier,      "F$IDENTIFIER" },
 116   { EXT_REGINA_BIFS,vms_f_integer,         "F$INTEGER" },
 117   { EXT_REGINA_BIFS,vms_f_length,          "F$LENGTH" },
 118   { EXT_REGINA_BIFS,vms_f_locate,          "F$LOCATE" },
 119   { EXT_REGINA_BIFS,vms_f_logical,         "F$LOGICAL" },
 120   { EXT_REGINA_BIFS,vms_f_message,         "F$MESSAGE" },
 121   { EXT_REGINA_BIFS,vms_f_mode,            "F$MODE" },
 122   { EXT_REGINA_BIFS,vms_f_parse,           "F$PARSE" },
 123   { EXT_REGINA_BIFS,vms_f_pid,             "F$PID" },
 124   { EXT_REGINA_BIFS,vms_f_privilege,       "F$PRIVILEGE" },
 125   { EXT_REGINA_BIFS,vms_f_process,         "F$PROCESS" },
 126   { EXT_REGINA_BIFS,vms_f_search,          "F$SEARCH" },
 127   { EXT_REGINA_BIFS,vms_f_setprv,          "F$SETPRV" },
 128   { EXT_REGINA_BIFS,vms_f_string,          "F$STRING" },
 129   { EXT_REGINA_BIFS,vms_f_time,            "F$TIME" },
 130   { EXT_REGINA_BIFS,vms_f_trnlnm,          "F$TRNLNM" },
 131   { EXT_REGINA_BIFS,vms_f_type,            "F$TYPE" },
 132   { EXT_REGINA_BIFS,vms_f_user,            "F$USER" },
 133 /*{ EXT_REGINA_BIFS,vms_f_verify,          "F$VERIFY" }, */
 134 #endif
 135   { EXT_REGINA_BIFS,os2_filespec,          "FILESPEC" },
 136   { EXT_REGINA_BIFS,cms_find,              "FIND" },
 137 #ifdef OLD_REGINA_FEATURES
 138   { EXT_REGINA_BIFS,unx_close,             "FINIS" },
 139 #endif /* OLD_REGINA_FEATURES */
 140   { EXT_REGINA_BIFS,unx_fork,              "FORK" },
 141   { 0,              std_form,              "FORM" },
 142   { 0,              std_format,            "FORMAT" },
 143 #if defined(REGINA_DEBUG_MEMORY)
 144   { EXT_REGINA_BIFS,dbg_freelists,         "FREELISTS" },
 145 #endif
 146   { EXT_AREXX_BIFS, arexx_freespace,       "FREESPACE" },
 147   { 0,              std_fuzz,              "FUZZ" },
 148 #if defined(_AMIGA) || defined(__AROS__)
 149   { EXT_AREXX_BIFS, amiga_getclip,         "GETCLIP" },
 150 #endif
 151 #ifdef HAVE_GCI
 152   { EXT_REGINA_BIFS,rex_gciprefixchar,     "GCIPREFIXCHAR" },
 153 #endif
 154   { EXT_REGINA_BIFS,unx_getenv,            "GETENV" },
 155   { EXT_REGINA_BIFS,unx_getpath,           "GETPATH" },
 156   { EXT_REGINA_BIFS,unx_getpid,            "GETPID" },
 157   { EXT_AREXX_BIFS, arexx_getspace,        "GETSPACE" },
 158   { EXT_REGINA_BIFS,unx_gettid,            "GETTID" },
 159   { EXT_AREXX_BIFS, arexx_hash,            "HASH" },
 160   { EXT_AREXX_BIFS, arexx_import,          "IMPORT" },
 161   { EXT_REGINA_BIFS,cms_index,             "INDEX" },
 162   { 0,              std_insert,            "INSERT" },
 163   { EXT_REGINA_BIFS,cms_justify,           "JUSTIFY" },
 164   { 0,              std_lastpos,           "LASTPOS" },
 165   { 0,              std_left,              "LEFT" },
 166   { 0,              std_length,            "LENGTH" },
 167   { 0,              std_linein,            "LINEIN" },
 168   { 0,              std_lineout,           "LINEOUT" },
 169   { 0,              std_lines,             "LINES" },
 170 #ifdef TRACEMEM
 171   { EXT_REGINA_BIFS,dbg_listleaked,        "LISTLEAKED" },
 172 #endif
 173   { EXT_REGINA_BIFS,rex_lower,             "LOWER" },
 174   { EXT_MAKEBUF_BIF,cms_makebuf,           "MAKEBUF" },
 175   { 0,              std_max,               "MAX" },
 176 #ifdef TRACEMEM
 177   { EXT_REGINA_BIFS,dbg_memorystats,       "MEMORYSTATS" },
 178 #endif
 179   { 0,              std_min,               "MIN" },
 180   { EXT_REGINA_BIFS,conflict_open,         "OPEN" },
 181   { 0,              std_overlay,           "OVERLAY" },
 182   { EXT_REGINA_BIFS,rex_poolid,            "POOLID" },
 183   { EXT_REGINA_BIFS,unx_popen,             "POPEN" },
 184   { 0,              std_pos,               "POS" },
 185 #if defined(_AMIGA) || defined(__AROS__)
 186   { EXT_AREXX_BIFS, amiga_pragma,          "PRAGMA" },
 187 #endif
 188   { EXT_REGINA_BIFS,unx_putenv,            "PUTENV" },
 189   { 0,              std_qualify,           "QUALIFY" },
 190   { 0,              std_queued,            "QUEUED" },
 191   { 0,              std_random,            "RANDOM" },
 192   { EXT_AREXX_BIFS, arexx_randu,           "RANDU" },
 193   { EXT_AREXX_BIFS, arexx_readch,          "READCH" },
 194   { EXT_AREXX_BIFS, arexx_readln,          "READLN" },
 195   { 0,              std_reverse,           "REVERSE" },
 196   { 0,              std_right,             "RIGHT" },
 197
 198   { 0,              rex_rxfuncadd,         "RXFUNCADD" },
 199 #ifdef HAVE_GCI
 200   { EXT_REGINA_BIFS,rex_rxfuncdefine,      "RXFUNCDEFINE" },
 201 #endif
 202   { 0,              rex_rxfuncdrop,        "RXFUNCDROP" },
 203   { EXT_REGINA_BIFS,rex_rxfuncerrmsg,      "RXFUNCERRMSG" },
 204   { 0,              rex_rxfuncquery,       "RXFUNCQUERY" },
 205   { 0,              rex_rxqueue,           "RXQUEUE" },
 206
 207   { EXT_AREXX_BIFS, arexx_seek,            "SEEK" },
 208 #if defined(_AMIGA) || defined(__AROS__)
 209   { EXT_AREXX_BIFS, amiga_setclip,         "SETCLIP" },
 210 #endif
 211 #if defined(_AMIGA) || defined(__AROS__)
 212   { EXT_AREXX_BIFS, amiga_show,            "SHOW" },
 213 #else
 214   { EXT_AREXX_BIFS, arexx_show,            "SHOW" },
 215 #endif
 216   { 0,              std_sign,              "SIGN" },
 217   { EXT_REGINA_BIFS,cms_sleep,             "SLEEP" },
 218   { 0,              std_sourceline,        "SOURCELINE" },
 219   { 0,              std_space,             "SPACE" },
 220   { EXT_REGINA_BIFS,cms_state,             "STATE" },
 221   { EXT_AREXX_BIFS, arexx_storage,         "STORAGE" },
 222   { 0,              std_stream,            "STREAM" },
 223   { 0,              std_strip,             "STRIP" },
 224   { 0,              std_substr,            "SUBSTR" },
 225   { 0,              std_subword,           "SUBWORD" },
 226   { 0,              std_symbol,            "SYMBOL" },
 227   { 0,              std_time,              "TIME" },
 228   { 0,              std_trace,             "TRACE" },
 229   { EXT_REGINA_BIFS,arexx_trim,            "TRIM" },
 230
 231   { EXT_REGINA_BIFS,dbg_traceback,         "TRACEBACK" },
 232
 233   { 0,              std_translate,         "TRANSLATE" },
 234   { EXT_AREXX_BIFS, arexx_trim,            "TRIM" },
 235   { 0,              std_trunc,             "TRUNC" },
 236   { EXT_REGINA_BIFS,unx_uname,             "UNAME" },
 237   { EXT_REGINA_BIFS,unx_unixerror,         "UNIXERROR" },
 238   { EXT_REGINA_BIFS,arexx_upper,           "UPPER" },
 239   { EXT_REGINA_BIFS,rex_userid,            "USERID" },
 240   { 0,              std_value,             "VALUE" },
 241   { 0,              std_verify,            "VERIFY" },
 242   { 0,              std_word,              "WORD" },
 243   { 0,              std_wordindex,         "WORDINDEX" },
 244   { 0,              std_wordlength,        "WORDLENGTH" },
 245   { 0,              std_wordpos,           "WORDPOS" },
 246   { 0,              std_words,             "WORDS" },
 247   { EXT_AREXX_BIFS, arexx_writech,         "WRITECH" },
 248   { EXT_AREXX_BIFS, arexx_writeln,         "WRITELN" },
 249   { 0,              std_x2b,               "X2B" },
 250   { 0,              std_x2c,               "X2C" },
 251   { 0,              std_x2d,               "X2D" },
 252   { 0,              std_xrange,            "XRANGE" },
 253   { 0,              NULL,                  NULL }
 254 } ;
 255
 256 static const int num_funcs = sizeof(functions) / (sizeof(functions[0])) - 1 ;
 257
 258 static const int MonthDays[] = {31,28,31,30,31,30,31,31,30,31,30,31};
 259 static const int DaysInYear[] = {0,31,59,90,120,151,181,212,243,273,304,334};
 260
 261 static int leapyear(long year) ;
 262 static void base2date(long basedate,void *conv_tmdata) ;
 263
 264 #ifdef TRACEMEM
 265 void mark_listleaked_params( const tsd_t *TSD )
 266 {
 267    paramboxptr pptr=NULL ;
 268
 269    for (pptr=TSD->listleaked_params; pptr; pptr=pptr->next)
 270    {
 271       markmemory( pptr, TRC_PROCARG ) ;
 272       if (pptr->value)
 273          markmemory( pptr->value, TRC_PROCARG ) ;
 274    }
 275 }
 276 #endif
 277
 278 streng *buildtinfunc( tsd_t *TSD, nodeptr thisptr )
 279 {
 280    int low=0, topp=0, mid=0, end=1, up=num_funcs-1, i=0 ;
 281    streng *ptr;
 282    struct entry_point *vptr;
 283    streng *(*func)(tsd_t *,cparamboxptr)=NULL ;
 284    const char *BIFname = NULL; /* set to non-NULL only in case of a BIF */
 285    void *BIFfunc = NULL; /* set to non-NULL only in case of a BIF */
 286
 287    /*
 288     * Look for a function registered in a DLL
 289     */
 290    vptr = loaded_lib_func( TSD, thisptr->name ) ;
 291    if ( vptr )
 292       func = std_center ; /* e.g. */
 293
 294    /*
 295     * If no function registered in a DLL or EXE, look for a builtin
 296     */
 297    if (!func)
 298    {
 299       topp = Str_len( thisptr->name ) ;
 300
 301       if (thisptr->u.func)
 302          func = thisptr->u.func ;
 303       else
 304       {
 305          mid = 0 ;  /* to keep the compiler happy */
 306          while ((end)&&(up>=low))
 307          {
 308             mid = (up+low)/2 ;
 309             for (i=0; i<topp; i++ )
 310                if (thisptr->name->value[i] != functions[mid].funcname[i])
 311                   break ;
 312
 313             if (i==topp)
 314                end = (functions[mid].funcname[i]!=0x00) ;
 315             else
 316                end = ( functions[mid].funcname[i] - thisptr->name->value[i] ) ;
 317
 318             if (end>0)
 319                up = mid-1 ;
 320             else
 321                low = mid+1 ;
 322          }
 323          if (!end)
 324          {
 325             /*
 326              * Check if the function is an extension. If it is and it matches
 327              * an extension specified with the OPTIONS keyword, then allow it.
 328              * If the OPTION; STRICT_ANSI is in effect however, this overrides
 329              * the extension.
 330              */
 331             BIFname = functions[mid].funcname;
 332             if (functions[mid].compat)
 333             {
 334                if ( get_options_flag( TSD->currlevel, EXT_STRICT_ANSI ) )
 335                   exiterror( ERR_NON_ANSI_FEATURE, 1, functions[mid].funcname );
 336                if ( ! get_options_flag( TSD->currlevel, functions[mid].compat ) )
 337                   func = NULL ;
 338                else
 339                {
 340                   func = functions[mid].function ;
 341                   if ( get_options_flag( TSD->currlevel, EXT_CACHEEXT ) )
 342                      thisptr->u.func = func ;
 343                }
 344             }
 345             else
 346                thisptr->u.func = func = functions[mid].function ;
 347          }
 348       }
 349       BIFfunc = (void *) func;
 350    }
 351
 352    if (func)
 353    {
 354       if (TSD->bif_first)
 355          deallocplink( TSD, TSD->bif_first ) ;
 356       TSD->bif_first = NULL; /* NEVER delete this! initplist
 357                      * may setjmp to the line above
 358                      * which results to a twice-called
 359                      * deallocplink. FGC
 360                      */
 361
 362       TSD->bif_first = initplist( TSD, thisptr ) ;
 363       TSD->BIFname = BIFname;
 364       TSD->BIFfunc = (void *) BIFfunc;
 365       if (vptr)
 366          ptr = call_known_external( TSD, vptr, TSD->bif_first, (char) thisptr->o.called ) ;
 367       else
 368          ptr = (*func)(TSD, TSD->bif_first /* ->next */ ) ;
 369       TSD->BIFname = NULL;
 370       TSD->BIFfunc = NULL;
 371
 372       deallocplink( TSD, TSD->bif_first ) ;
 373       TSD->bif_first = NULL ;
 374       return ptr ;
 375    }
 376    else
 377    {
 378 #if defined(_AMIGA) || defined(__AROS__)
 379       /* Function was not found: so on amiga/AROS try the function
 380        * libraries and hosts
 381        */
 382       if (TSD->bif_first)
 383          deallocplink( TSD, TSD->bif_first ) ;
 384       TSD->bif_first = NULL; /* NEVER delete this! initplist
 385                               * may setjmp to the line above
 386                               * which results to a twice-called
 387                               * deallocplink. FGC
 388                               */
 389
 390       TSD->bif_first = initplist( TSD, thisptr );
 391       ptr = try_func_amiga( TSD, thisptr->name, TSD->bif_first, (char) thisptr->o.called );
 392       deallocplink( TSD, TSD->bif_first );
 393       TSD->bif_first = NULL;
 394
 395       if (ptr)
 396          return ptr;
 397 #endif
 398
 399       if (IfcHaveFunctionExit( TSD )) /* we have an exit handler */
 400       {
 401          if (TSD->bif_first)
 402             deallocplink( TSD, TSD->bif_first ) ;
 403          TSD->bif_first = NULL; /* NEVER delete this! initplist
 404                                                  * may setjmp to the line above
 405                                                  * which results to a twice-called
 406                                                  * deallocplink. FGC
 407                                                  */
 408
 409
 410          TSD->bif_first = initplist( TSD, thisptr ) ;
 411          ptr = call_unknown_external( TSD, thisptr->name, TSD->bif_first, (char) thisptr->o.called ) ;
 412          deallocplink( TSD, TSD->bif_first ) ;
 413          TSD->bif_first = NULL ;
 414       }
 415       else
 416          ptr = NOFUNC;
 417    }
 418    return ptr;
 419 }
 420
 421 paramboxptr initplist( tsd_t *TSD, cnodeptr thisptr )
 422 {
 423    paramboxptr first,newptr,currnt;
 424
 425    first = currnt = NULL ;
 426    for (thisptr=thisptr->p[0]; thisptr; thisptr=thisptr->p[1])
 427    {
 428       if (TSD->par_stack)
 429       {
 430          newptr = TSD->par_stack ;
 431          TSD->par_stack = newptr->next ;
 432       }
 433       else
 434          newptr = (paramboxptr)MallocTSD( sizeof( parambox )) ;
 435
 436       if (!first)
 437          first = currnt = newptr ;
 438       else
 439       {
 440          currnt->next = newptr ;
 441          currnt = newptr ;
 442       }
 443
 444       if (thisptr->type==X_CEXPRLIST && TSD->trace_stat!='I')
 445       {
 446          if (thisptr->u.strng)
 447             currnt->value = thisptr->u.strng ;
 448          else
 449             currnt->value  = NULL ;
 450
 451          currnt->dealloc = 0 ;
 452       }
 453       else if ( !thisptr->p[0] )
 454       {
 455          currnt->dealloc = 1;
 456          currnt->value = NULL;
 457       }
 458       else
 459       {
 460          /*
 461           * This fixes bug 590589 and others.
 462           * Always force a fresh new return value of evaluate.
 463           * Imagine this code, it will produce a crash otherwise:
 464           * call func x
 465           * return
 466           * func:
 467           *    x = "new" || "value"
 468           *    say arg(1)
 469           */
 470          currnt->dealloc = 1;
 471          currnt->value = evaluate( TSD, thisptr->p[0], NULL );
 472       }
 473    }
 474 #ifdef TRACEMEM
 475    TSD->listleaked_params = first ;
 476 #endif
 477    if ( currnt )
 478       currnt->next = NULL ;
 479    return first ;
 480 }
 481
 482
 483 paramboxptr initargs( tsd_t *TSD, int argc, const int *lengths,
 484                       const char **strings )
 485 {
 486    paramboxptr first,newptr,currnt;
 487    int i;
 488
 489    first = currnt = NULL;
 490    for ( i = 0; i < argc; i++ )
 491    {
 492       if ( TSD->par_stack )
 493       {
 494          newptr = TSD->par_stack;
 495          TSD->par_stack = newptr->next;
 496       }
 497       else
 498          newptr = (paramboxptr)MallocTSD( sizeof( parambox ) );
 499
 500       if ( !first )
 501          first = currnt = newptr;
 502       else
 503       {
 504          currnt->next = newptr;
 505          currnt = newptr;
 506       }
 507
 508       if ( lengths[i] == RX_NO_STRING )
 509       {
 510          currnt->dealloc = 1;
 511          currnt->value = NULL;
 512       }
 513       else
 514       {
 515          currnt->value = Str_ncreTSD( strings[i], lengths[i] );
 516          currnt->dealloc = 1;
 517       }
 518    }
 519
 520 #ifdef TRACEMEM
 521    TSD->listleaked_params = first;
 522 #endif
 523
 524    if ( currnt )
 525       currnt->next = NULL;
 526    return first;
 527 }
 528
 529
 530 void deallocplink( tsd_t *TSD, paramboxptr first )
 531 {
 532    paramboxptr thisptr;
 533
 534    for (;first;)
 535    {
 536       thisptr = first ;
 537       first = first->next ;
 538       if (thisptr->dealloc && thisptr->value)
 539       {
 540          Free_stringTSD( thisptr->value ) ;
 541          thisptr->value = NULL;
 542       }
 543
 544 #if defined(CHECK_MEMORY)
 545       FreeTSD(thisptr);
 546 #else
 547       /* Back to the freed-parbox stack: */
 548       thisptr->next = TSD->par_stack ;
 549       TSD->par_stack = thisptr ;
 550 #endif
 551    }
 552 }
 553
 554
 555 #ifdef TRACEMEM
 556 void mark_param_cache( const tsd_t *TSD )
 557 {
 558    paramboxptr ptr=NULL ;
 559
 560    ptr = TSD->par_stack ;
 561    for (; ptr; ptr=ptr->next )
 562       markmemory( ptr, TRC_P_CACHE ) ;
 563 }
 564 #endif
 565
 566
 567
 568 int myatol( const tsd_t *TSD, const streng *text )
 569 {
 570    int num, error ;
 571
 572    num = streng_to_int( TSD, text, &error ) ;
 573    if (error)
 574        exiterror( ERR_INVALID_INTEGER, 0 )  ;
 575
 576    return num ;
 577 }
 578
 579 static int myintatol( tsd_t *TSD, const streng *text, int suberr, const char *bif, int argnum )
 580 {
 581    int num, error ;
 582
 583    num = streng_to_int( TSD, text, &error ) ;
 584    if ( error )
 585       exiterror( ERR_INCORRECT_CALL, suberr, bif, argnum, tmpstr_of( TSD, text ) ) ;
 586
 587    return num ;
 588 }
 589
 590
 591 int atozpos( tsd_t *TSD, const streng *text, const char *bif, int argnum )
 592 {
 593    int result=0 ;
 594
 595    /* fixes bug 1108868 */
 596    if ( ( result = myintatol( TSD, text, 12, bif, argnum ) ) < 0 )
 597       exiterror( ERR_INCORRECT_CALL, 13, bif, argnum, tmpstr_of( TSD, text ) )  ;
 598
 599    return result ;
 600 }
 601
 602
 603 char getoptionchar( tsd_t *TSD, const streng *text, const char* bif, int argnum, const char *ansi_choices, const char *regina_choices )
 604 {
 605    char ch=0 ;
 606    const char *ptr = NULL;
 607    char tmp[50];
 608
 609    if (text->len == 0)
 610       exiterror( ERR_INCORRECT_CALL, 21, bif, argnum )  ;
 611
 612    ch = (char) rx_toupper( text->value[0] ) ;
 613    /*
 614     * If the option supplied is ANSI, then return when we find it.
 615     */
 616    for ( ptr = ansi_choices; *ptr; ptr++ )
 617    {
 618       if ( *ptr == ch )
 619          return ch ;
 620    }
 621    /*
 622     * If the option supplied is a Regina extension, and we are NOT running in
 623     * ANSI mode, then return when we find it.
 624     */
 625    for ( ptr = regina_choices; *ptr; ptr++ )
 626    {
 627       if ( *ptr == ch )
 628       {
 629          if ( get_options_flag( TSD->currlevel, EXT_STRICT_ANSI ) )
 630             exiterror( ERR_NON_ANSI_FEATURE, 3, bif, argnum, ansi_choices, tmpstr_of( TSD, text ) );
 631          else
 632             return ch ;
 633       }
 634    }
 635
 636    if ( get_options_flag( TSD->currlevel, EXT_STRICT_ANSI ) )
 637       exiterror( ERR_INCORRECT_CALL, 28, bif, argnum, ansi_choices, tmpstr_of( TSD, text ) );
 638    else
 639    {
 640       strcpy( tmp, ansi_choices );
 641       strcat( tmp, regina_choices );
 642       exiterror( ERR_INCORRECT_CALL, 28, bif, argnum, tmp, tmpstr_of( TSD, text ) );
 643    }
 644    return 0 ;
 645 }
 646
 647
 648 char getonechar( tsd_t *TSD, const streng *text, const char *bif, int argnum )
 649 {
 650    if ( !text )
 651       exiterror( ERR_INCORRECT_CALL, 23, bif, argnum, "" )  ;
 652    if ( Str_len( text ) != 1 )
 653       exiterror( ERR_INCORRECT_CALL, 23, bif, argnum, tmpstr_of( TSD, text ) ) ;
 654
 655    return text->value[0] ;
 656 }
 657
 658 int atopos( tsd_t *TSD, const streng *text, const char *bif, int argnum )
 659 {
 660    int result=0 ;
 661
 662    /* fixes bug 1108868 */
 663    if ( ( result = myintatol( TSD, text, 12, bif, argnum ) ) <= 0 )
 664       exiterror( ERR_INCORRECT_CALL, 14, bif, argnum, tmpstr_of( TSD, text ) ) ;
 665
 666    return result ;
 667 }
 668
 669 int atoposorzero( tsd_t *TSD, const streng *text, const char *bif, int argnum )
 670 {
 671    int result=0 ;
 672
 673    if ( ( result = myintatol( TSD, text, 11, bif, argnum ) ) < 0 )
 674       exiterror( ERR_INCORRECT_CALL, 17, bif, argnum, tmpstr_of( TSD, text ) ) ;
 675
 676    return result ;
 677 }
 678
 679
 680
 681 streng *int_to_streng( const tsd_t *TSD, int input )
 682 {
 683    streng *output=NULL ;
 684    char *cptr=NULL, *start=NULL, *top=NULL ;
 685
 686    output = Str_makeTSD( sizeof(int)*3 + 2 ) ;
 687    start = output->value ;
 688    cptr = start + sizeof(int)*3 + 2 ;
 689    if (input)
 690    {
 691       if (input<0)
 692       {
 693          input = - input ;
 694          *(start++) = '-' ;
 695       }
 696
 697       for (top=cptr;input;)
 698       {
 699          *(--cptr) = (char) (input % 10 + '0') ;
 700          input = input / 10 ;
 701       }
 702
 703       memmove( start, cptr, top-cptr ) ;
 704       output->len = top-cptr + start-output->value ;
 705    }
 706    else
 707    {
 708       *start = '0' ;
 709       output->len = 1 ;
 710    }
 711
 712    return output ;
 713 }
 714
 715
 716 void checkparam( cparamboxptr params, int min, int max, const char *name )
 717 {
 718    int i=0 ;
 719
 720    for (i=0;i<min;i++,params=(cparamboxptr) (params->next))
 721       if ((!params)||(!params->value))
 722          exiterror( ERR_INCORRECT_CALL, 3, name, min )  ;
 723
 724    for (;(i<max)&&(params);i++,params=(cparamboxptr) (params->next)) ;
 725    if (((i==max)&&(params))&&((max)||(params->value)))
 726       exiterror( ERR_INCORRECT_CALL, 4, name, max )  ;
 727 }
 728
 729
 730 /*
 731  * These functions are rather ugly, but they works :-)
 732  */
 733 /*
 734  * Converts a date supplied in an external format (specified by suppformat)
 735  * into a struct tm (individual values for year, month, day, year_days and
 736  * base days).
 737  */
 738 int convert_date(tsd_t *TSD, const streng *suppdate, char suppformat, struct tm *indate)
 739 {
 740    int rc,i=0,off=0,save_year=indate->tm_year;
 741    long num1=0,num2=0,num3=0;
 742    char buf[20];
 743    char *ptr=(char*)suppdate->value;
 744    struct tm *tmpTime;
 745    time_t num64;
 746
 747    indate->tm_sec = indate->tm_min = indate->tm_hour = 0;
 748    switch(suppformat)
 749    {
 750       case 'B': /* 99999... */
 751       case 'D': /* 99999... */
 752          if (suppdate->len > 19)
 753             return(1);
 754          memcpy(buf,ptr,suppdate->len);
 755          buf[suppdate->len] = '\0';
 756          if ((num1 = atol(buf)) == 0)
 757          {
 758             for (i=0;i<suppdate->len;i++)
 759             {
 760                if (buf[i] != '0')
 761                   return(1);
 762             }
 763          }
 764          if ( suppformat == 'B' )
 765             base2date(num1,indate);
 766          else
 767             base2date(num1+basedays(indate->tm_year)-1,indate);
 768          break;
 769 #if 0
 770       case 'I': /* WHAT IS THIS? */
 771          if (suppdate->len > 19)
 772             return(1);
 773          memcpy(buf,ptr,suppdate->len);
 774          buf[suppdate->len] = '\0';
 775          if ((num1 = atol(buf)) == 0)
 776          {
 777             for (i=0;i<suppdate->len;i++)
 778             {
 779                if (buf[i] != '0')
 780                   return(1);
 781             }
 782          }
 783          base2date(num1+basedays(1978)-1,indate);
 784          break;
 785 #endif
 786       case 'E': /* dd/mm/yy */
 787       case 'O': /* yy/mm/dd */
 788       case 'U': /* mm/dd/yy */
 789          if (suppdate->len != 8)
 790             return(1);
 791          if (*(ptr+2) != '/' && *(ptr+5) != '/')
 792               return( 1 );
 793          memcpy(buf,ptr,2);
 794          buf[2] = '\0';
 795          if ( !rx_isdigit( buf[0] ) || !rx_isdigit( buf[1] ) )
 796             return( 1 );
 797          num1 = atol( buf );
 798          memcpy(buf,(ptr+3),2);
 799          buf[2] = '\0';
 800          if ( !rx_isdigit( buf[0] ) || !rx_isdigit( buf[1] ) )
 801             return( 1 );
 802          num2 = atol( buf );
 803          memcpy(buf,(ptr+6),2);
 804          buf[2] = '\0';
 805          if ( !rx_isdigit( buf[0] ) || !rx_isdigit( buf[1] ) )
 806             return( 1 );
 807          num3 = atol( buf );
 808          switch(suppformat)
 809          {
 810             case 'E':
 811                if ( num1 == 0 || num2 == 0 )
 812                   return( 1 );
 813                indate->tm_mday = num1;
 814                indate->tm_mon = num2-1;
 815                indate->tm_year = num3;
 816                break;
 817             case 'O':
 818                if ( num3 == 0 || num2 == 0 )
 819                   return( 1 );
 820                indate->tm_mday = num3;
 821                indate->tm_mon = num2-1;
 822                indate->tm_year = num1;
 823                break;
 824             case 'U':
 825                if ( num2 == 0 || num1 == 0 )
 826                   return( 1 );
 827                indate->tm_mday = num2;
 828                indate->tm_mon = num1-1;
 829                indate->tm_year = num3;
 830                break;
 831          }
 832          /*
 833           * Work out the century based on a sliding year
 834           */
 835          if (indate->tm_year < 100)   /* do something with century ... */
 836             indate->tm_year += ( indate->tm_year <= (save_year - 2000 ) + 50 ) ? 2000 : 1900;
 837          break;
 838       case 'N': /* dd mmm yyyy */
 839          if (suppdate->len != 11 && suppdate->len != 10)
 840             return(1);
 841          if (suppdate->len == 10)
 842             off = 1;
 843          if (*(ptr+2-off) != ' ' && *(ptr+6-off) != ' ')
 844             return(1);
 845          memcpy(buf,ptr,2-off);
 846          buf[2-off] = '\0';
 847          if ((num1 = atol(buf)) == 0)
 848             return(1);
 849          memcpy(buf,(ptr+3-off),3);
 850          buf[3] = '\0';
 851          /* find month */
 852          num2 = (-1);
 853          for (i=0;i<12;i++)
 854          {
 855             if (strncmp(months[i],buf,3) == 0)
 856             {
 857                num2 = i;
 858                break;
 859             }
 860          }
 861          if (num2 == (-1))
 862             return(1);
 863          memcpy(buf,(ptr+7-off),4);
 864          buf[4] = '\0';
 865          if ((num3 = atol(buf)) == 0 && strcmp("0000",buf) != 0)
 866             return(1);
 867          indate->tm_mday = num1;
 868          indate->tm_mon = num2;
 869          indate->tm_year = num3;
 870          break;
 871       case 'S': /* yyyymmdd */
 872          if ( suppdate->len != 8 )
 873             return(1);
 874          memcpy( buf, ptr, 4 );
 875          buf[4] = '\0';
 876          if ( ( num1 = atol( buf ) ) == 0 )
 877             return(1);
 878          memcpy( buf, (ptr+4), 2 );
 879          buf[2] = '\0';
 880          if ( ( num2 = atol( buf ) ) == 0 )
 881             return(1);
 882          memcpy( buf, (ptr+6), 2 );
 883          buf[2] = '\0';
 884          if ( ( num3 = atol( buf ) ) == 0 )
 885             return(1);
 886          indate->tm_mday = num3;
 887          indate->tm_mon = num2-1;
 888          indate->tm_year = num1;
 889          break;
 890       case 'I': /* yyyy-mm-dd */
 891          if ( suppdate->len != 10 )
 892             return(1);
 893          if ( ptr[4] != '-' )
 894             return(1);
 895          if ( ptr[7] != '-' )
 896             return(1);
 897          memcpy( buf, ptr, 4 );
 898          buf[4] = '\0';
 899          if ( ( num1 = atol( buf ) ) == 0 )
 900             return(1);
 901          memcpy( buf, (ptr+5), 2 );
 902          buf[2] = '\0';
 903          if ( ( num2 = atol( buf ) ) == 0 )
 904             return(1);
 905          memcpy( buf, (ptr+8), 2 );
 906          buf[2] = '\0';
 907          if ( ( num3 = atol( buf ) ) == 0 )
 908             return(1);
 909          indate->tm_mday = num3;
 910          indate->tm_mon = num2-1;
 911          indate->tm_year = num1;
 912          break;
 913       case 'T': /* +|-999999... */
 914          num64 = streng_to_rx64( TSD, suppdate, &rc );
 915          if ( rc )
 916             return 1;
 917          tmpTime = gmtime( (time_t *)&num64 );
 918          *indate = *tmpTime;
 919          indate->tm_year += 1900;
 920          /*
 921           * Reset time to 00:00:00
 922           */
 923          indate->tm_sec = indate->tm_hour = indate->tm_min = 0;
 924          break;
 925       default:
 926          /* should not get here */
 927          break;
 928    }
 929    if (indate->tm_mday > ( MonthDays[indate->tm_mon] + ( (indate->tm_mon == 1) ? leapyear(indate->tm_year) : 0 ) )
 930    ||  indate->tm_mday < 1
 931    ||  indate->tm_mon > 11
 932    ||  indate->tm_mon < 0
 933    ||  indate->tm_year < 0)
 934       return(1);
 935
 936    indate->tm_yday = DaysInYear[indate->tm_mon]+
 937                      ((leapyear(indate->tm_year)&&indate->tm_mon>1)?1:0)+
 938                      indate->tm_mday - 1;
 939    indate->tm_wday = (((indate->tm_yday+basedays(indate->tm_year))+8) % 7);
 940    return(0);
 941 }
 942
 943 /*
 944  * Converts a year (MUST have century) to a number of days
 945  * Base year is 0001 - hence the date 01 Jan 0001 is base day 1
 946  */
 947 int basedays(int year)
 948 {
 949    return((year-1)*365 + (year-1)/4 - (year-1)/100 + (year-1)/400);
 950 }
 951
 952 /*
 953  * Determines if a year (MUST have a century) is a leap year
 954  */
 955 static int leapyear(long year)
 956 {
 957    if ((year%4 == 0 && year%100 != 0) || year%400 == 0)
 958       return(1);
 959    else
 960       return(0);
 961 }
 962
 963 /*
 964  * Converts a number (representing the number of days since 01 Jan 0001)
 965  * to a struct tm value (individual fields for year, month, day and days in year)
 966  */
 967 static void base2date(long basedate,void *conv_tmdata)
 968 {
 969    struct tm *outdate=(struct tm *)conv_tmdata;
 970    int i=0;
 971    long day=0L,year=0L,month=0L,yeardays=0L,thismonth=0L;
 972
 973    day = basedate + 1L;
 974    year = day / 366;
 975    day -= ((year*365) + (year/4) - (year/100) + (year/400));
 976    year++;
 977    while (day > (365 + leapyear(year)))
 978    {
 979       day -= (365 + leapyear(year));
 980       year++;
 981    }
 982
 983    yeardays = day;
 984    for (i=0;i<11;i++)
 985    {
 986       thismonth = (MonthDays[i]) + ((i == 1) ? leapyear(year) : 0);
 987       if (day <= thismonth)
 988          break;
 989       day -= thismonth;
 990    }
 991    month = i;
 992    outdate->tm_year = year;
 993    outdate->tm_mon = month;
 994    outdate->tm_mday = day;
 995    outdate->tm_yday = yeardays;
 996    outdate->tm_wday = ((basedate+8) % 7);
 997    return;
 998 }
 999
1000 /*
1001  * Converts a time supplied in an external format (specified by suppformat)
1002  * into a struct tm (individual values for hour, minute, second).
1003  */
1004 int convert_time( const tsd_t *TSD, const streng *supptime, char suppformat, struct tm *intime, time_t *unow)
1005 {
1006    int rc,offset;
1007    long num1=0,num2=0,num3=0,num4=0;
1008    char buf[20];
1009    char *ptr=(char*)supptime->value;
1010    struct tm *tmpTime;
1011    time_t num64;
1012
1013    switch(suppformat)
1014    {
1015       case 'C': /* hh:mmXX */
1016          /*
1017           * Format of time can be "3:45pm", or "11:45pm"; ie hour can be 1 or
1018           * two digits. Use of "offset" below fixes bug 742725
1019           */
1020          if (*(ptr+2) == ':')
1021             offset = 1;
1022          else if (*(ptr+1) == ':')
1023             offset = 0;
1024          else
1025             return(1);
1026          if (memcmp("am",ptr+4+offset,2) != 0 && memcmp("pm",ptr+4+offset,2) != 0)
1027             return(1);
1028          memcpy(buf,ptr,1+offset);
1029          buf[1+offset] = '\0';
1030          if ((num1 = atol(buf)) == 0 && strcmp("00",buf) != 0)
1031             return(1);
1032          if (num1 > 12)
1033             return(1);
1034          memcpy(buf,ptr+2+offset,2);
1035          buf[2] = '\0';
1036          if ((num2 = atol(buf)) == 0 && strcmp("00",buf) != 0)
1037             return(1);
1038          if (num2 > 59)
1039             return(1);
1040          intime->tm_sec = 0;
1041          if (memcmp("am",ptr+4+offset,2)==0)
1042          {
1043             if (num1 == 12)
1044                intime->tm_hour = 0;
1045             else
1046                intime->tm_hour = num1;
1047          }
1048          else
1049          {
1050             if (num1 == 12)
1051                intime->tm_hour = num1;
1052             else
1053                intime->tm_hour = num1+12;
1054          }
1055          intime->tm_min = num2;
1056          *unow = 0;
1057          break;
1058       case 'H': /* 99999... */
1059       case 'M': /* 99999... */
1060       case 'S': /* 99999... */
1061          /*
1062           * Convert supptime to whole number using streng_to_int()
1063           * rather than atoi(). Bug #20000922-78622
1064           */
1065          num1 = streng_to_int( TSD, supptime, &rc );
1066          if ( rc
1067          || num1 < 0 )
1068             return(1);
1069          switch(suppformat)
1070          {
1071             case 'H':
1072                intime->tm_hour = num1;
1073                intime->tm_min = intime->tm_sec = 0;
1074                break;
1075             case 'M':
1076                intime->tm_hour = num1 / 60;
1077                intime->tm_min = num1 % 60;
1078                intime->tm_sec = 0;
1079                break;
1080             case 'S':
1081                intime->tm_hour = num1 / 3600;
1082                intime->tm_min = (num1 % 3600) / 60;
1083                intime->tm_sec = (num1 % 3600) % 60;
1084                break;
1085          }
1086          if ( intime->tm_sec > 59 || intime->tm_hour > 23 || intime->tm_min > 59 )
1087             return(1);
1088          *unow = 0;
1089          break;
1090       case 'L': /* hh:mm:ss.mmmmmm */
1091       case 'N': /* hh:mm:ss */
1092          if (suppformat == 'N' && supptime->len != 8)
1093             return(1);
1094          if (suppformat == 'L' && supptime->len != 15)
1095             return(1);
1096          if (*(ptr+2) != ':' && *(ptr+5) != ':')
1097             return(1);
1098          memcpy(buf,ptr,2);
1099          buf[2] = '\0';
1100          if ((num1 = atol(buf)) == 0 && strcmp("00",buf) != 0)
1101             return(1);
1102          if (num1 < 0 || num1 > 23)
1103             return(1);
1104
1105          memcpy(buf,ptr+3,2);
1106          buf[2] = '\0';
1107          if ((num2 = atol(buf)) == 0 && strcmp("00",buf) != 0)
1108             return(1);
1109          if (num2 < 0 || num2 > 59)
1110             return(1);
1111
1112          memcpy(buf,ptr+6,2);
1113          buf[2] = '\0';
1114          if ((num3 = atol(buf)) == 0 && strcmp("00",buf) != 0)
1115             return(1);
1116          if (num3 < 0 || num3 > 59)
1117             return(1);
1118          intime->tm_sec = num3;
1119          intime->tm_hour = num1;
1120          intime->tm_min = num2;
1121          if (suppformat == 'N')
1122          {
1123             *unow = 0;
1124             break;
1125          }
1126          if (*(ptr+8) != '.')
1127             return(1);
1128          memcpy(buf,ptr+9,6);
1129          buf[6] = '\0';
1130          if ((num4 = atol(buf)) == 0 && strcmp("000000",buf) != 0)
1131             return(1);
1132          if (num4 < 0)
1133             return(1);
1134          *unow = num4;
1135          break;
1136       case 'T': /* +|-999999... */
1137          num64 = streng_to_int( TSD, supptime, &rc );
1138          if ( rc )
1139             return 1;
1140          tmpTime = gmtime( (time_t *)&num64 );
1141          *intime = *tmpTime;
1142          *unow = 0;
1143          break;
1144       default:
1145          /* should not get here */
1146          break;
1147    }
1148
1149    return(0);
1150 }
1151 /*
1152  * The following functions are wrappers for BIFs that are syntactically different
1153  * depending on the OPTONS used.
1154  */
1155
1156 static streng *conflict_close( tsd_t *TSD, cparamboxptr parms )
1157 {
1158    if ( get_options_flag( TSD->currlevel, EXT_AREXX_SEMANTICS ) )
1159       return( arexx_close( TSD, parms ) );
1160    else
1161       return( unx_close( TSD, parms ) );
1162 }
1163
1164 static streng *conflict_eof( tsd_t *TSD, cparamboxptr parms )
1165 {
1166    if ( get_options_flag( TSD->currlevel, EXT_AREXX_SEMANTICS ) )
1167       return( arexx_eof( TSD, parms ) );
1168    else
1169       return( unx_eof( TSD, parms ) );
1170 }
1171
1172 static streng *conflict_open( tsd_t *TSD, cparamboxptr parms )
1173 {
1174    if ( get_options_flag( TSD->currlevel, EXT_AREXX_SEMANTICS ) )
1175       return( arexx_open( TSD, parms ) );
1176    else
1177       return( unx_open( TSD, parms ) );
1178 }
1179
1180 /*
1181  * BIFname tries to guess the name of the BIF we currently evaluate.
1182  * We try to identify cached functions pointers.
1183  */
1184 const char *BIFname( tsd_t *TSD )
1185 {
1186    int i;
1187    void *func;
1188
1189    assert( TSD->currentnode );
1190
1191    if ( TSD->BIFname != NULL )
1192    {
1193       return TSD->BIFname;
1194    }
1195
1196    if ( TSD->BIFfunc != NULL )
1197    {
1198       func = TSD->BIFfunc;
1199    }
1200    else
1201    {
1202       func = (void *) TSD->currentnode->u.func;
1203
1204    }
1205    for ( i = 0; i < num_funcs; i++ )
1206    {
1207       if ( (void *) functions[i].function == func )
1208       {
1209          return functions[i].funcname;
1210       }
1211    }
1212    return "(internal)";
1213 }