pike.git / src / modules / Perl / perlmod.c

version» Context lines:

pike.git/src/modules/Perl/perlmod.c:1: - /* $Id: perlmod.c,v 1.15 2000/03/27 00:17:06 grubba Exp $ */ + /* $Id: perlmod.c,v 1.16 2000/05/16 12:38:54 leif Exp $ */      #include "builtin_functions.h"   #include "global.h"   #include "svalue.h"   #include "array.h"   #include "stralloc.h"   #include "interpret.h"   #include "module_support.h"   #include "threads.h"   #include "mapping.h"   #include "perl_machine.h"    -  /* this is just for debugging */ - #define _sv_2mortal(x) (x) -  +    #ifdef HAVE_PERL    -  + /* #define PERL_560 1 */ +    #include <EXTERN.h>   #include <perl.h>    -  + #ifdef USE_THREADS + /* #error Threaded Perl not supported. */ + #endif +  + #define MY_XS 1 + #undef MY_XS +  + /* #define PIKE_PERLDEBUG */ +  + #ifdef MY_XS + EXTERN_C void boot_DynaLoader(); +  + static void xs_init() + { char *file = __FILE__; +  dXSUB_SYS; + #ifdef PIKE_PERLDEBUG +  fprintf(stderr, "[my xs_init]\n"); + #endif +  newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); + } + #endif +  +    /* Do not redefine my malloc macro you stupid Perl! */   #include "dmalloc.h"    -  +  /* this is just for debugging */ + #define _sv_2mortal(x) (sv_2mortal(x)) +    static int num_perl_interpreters=0; - DEFINE_MUTEX(perl_running); + DEFINE_MUTEX(perlrunning);      #ifdef MULTIPLICITY   #endif      struct perlmod_storage   {    char **argv;    char **env;    char *env_block;    struct array *argv_strings;    int constructed, parsed;    int array_size_limit; -  PerlInterpreter *my_perl; +  PerlInterpreter *perl;   };    - #define THIS ((struct perlmod_storage *)(fp->current_storage)) - #define PERL THIS->my_perl + #define _THIS ((struct perlmod_storage *)(Pike_fp->current_storage))    -  + #ifdef PERL_560 + #define my_perl PERL + #endif +    /* since both Perl and Pike likes to use "sp" as a stack pointer,    * let's define some Pike macros as functions...    */   static void _push_int(INT32 i) { push_int(i);}   static void _push_float(float f) { push_float(f);}   static void _push_string(struct pike_string *s) { push_string(s);}   static void _push_array(struct array *a) { push_array(a);}   static void _pop_n_elems(int n) { pop_n_elems(n);} - static struct svalue *_pikesp() { return Pike_sp;} - static void _pike_pop() { --sp;} + static void _pike_pop() { --Pike_sp;}   #undef sp    -  + #define BLOCKING 1 +    #ifndef BLOCKING      #define MT_PERMIT THREADS_ALLOW(); mt_lock(&perl_running);   #define MT_FORBID mt_unlock(&perl_running); THREADS_DISALLOW();    -  + #else +  + #define MT_PERMIT ; + #define MT_FORBID ; +    #endif      /* utility function: push a zero_type zero */   static void _push_zerotype()   { push_int(0);    Pike_sp[-1].subtype = 1;   }      static SV * _pikev2sv(struct svalue *s)   { switch (s->type)
pike.git/src/modules/Perl/perlmod.c:109:    else if (SvIOKp(sv))    _push_int(SvIV(sv));    else if (SvNOKp(sv))    _push_float((float)(SvNV(sv)));    else if (SvPOKp(sv))    _push_string(make_shared_binary_string(SvPVX(sv), SvCUR(sv)));    else    _push_int(0);   }    + static int _perl_parse(struct perlmod_storage *ps, +  int argc, char *argv[], char *envp[]) + { int result; + #ifndef MY_XS +  extern void xs_init(void); + #endif + #ifdef PIKE_PERLDEBUG +  fprintf(stderr, "[_perl_parse, argc=%d]\n", argc); + #endif    -  +  if (!ps) +  error("Internal error: no Perl storage allocated.\n"); +  if (!ps->perl) +  error("Internal error: no Perl interpreter allocated.\n"); +  if (!ps->constructed) +  error("Internal error: Perl interpreter not constructed.\n"); +  if (!envp && !ps->env) +  { /* Copy environment data, since Perl may wish to modify it. */ +  +  INT32 d; +  int env_block_size=0; +  char *env_blockp; +  + #ifdef DECLARE_ENVIRON +  extern char **environ; + #endif +  +  for(d=0;environ[d];d++) +  env_block_size+=strlen(environ[d])+1; +  +  ps->env_block=xalloc(env_block_size); +  ps->env=(char **)xalloc(sizeof(char *)*(d+1)); +  +  env_blockp = ps->env_block; +  +  for(d=0;environ[d];d++) +  { +  int l=strlen(environ[d]); +  ps->env[d]=env_blockp; +  MEMCPY(env_blockp,environ[d],l+1); +  env_blockp+=l+1; +  } +  + #ifdef PIKE_DEBUG +  if(env_blockp - ps->env_block > env_block_size) +  fatal("Arglebargle glop-glyf.\n"); + #endif +  +  ps->env[d]=0; +  } +  MT_PERMIT; +  result = perl_parse(ps->perl, xs_init, argc, argv, envp ? envp : ps->env); +  MT_FORBID; +  ps->parsed += 1; +  return result; + } +  + static char *dummyargv[] = { "perl", "-e", "1", 0 }; +    static void init_perl_glue(struct object *o) - { PerlInterpreter *p; + { struct perlmod_storage *ps = _THIS;      #ifdef PIKE_PERLDEBUG    fprintf(stderr, "[init_perl_glue]\n");   #endif    -  THIS->argv = 0; -  THIS->env = 0; -  THIS->env_block = 0; -  THIS->argv_strings = 0; -  THIS->constructed = 0; -  THIS->parsed = 0; -  THIS->array_size_limit = 500; +  ps->argv = 0; +  ps->env = 0; +  ps->env_block = 0; +  ps->argv_strings = 0; +  ps->constructed = 0; +  ps->parsed = 0; +  ps->array_size_limit = 500;      #ifndef MULTIPLICITY    if(num_perl_interpreters>0)    { -  PERL=0; +  ps->perl=0; + #ifdef PIKE_PERLDEBUG    fprintf(stderr,"num_perl_interpreters=%d\n",num_perl_interpreters); -  + #endif    /* error("Perl: There can be only one!\n"); */    return;    }   #endif    MT_PERMIT; -  p=perl_alloc(); +  ps->perl = perl_alloc(); +  PL_perl_destruct_level=2;    MT_FORBID; -  PERL=p; -  if(p) num_perl_interpreters++; +  if(ps->perl) num_perl_interpreters++; +  + /* #define SPECIAL_PERL_DEBUG */ + #ifdef SPECIAL_PERL_DEBUG +  if (!ps->constructed) +  { fprintf(stderr, "[SpecialDebug: early perl_construct]\n"); +  perl_construct(ps->perl); +  ps->constructed = 1;    } -  +  if (!ps->parsed) +  { fprintf(stderr, "[SpecialDebug: early perl_parse]\n"); +  perl_parse(ps->perl, xs_init, 3, dummyargv, NULL); +  ps->parsed = 1; +  } + #endif + }      static void _free_arg_and_env() - { if(THIS->argv) -  { -  free((char *)THIS->argv); -  THIS->argv=0; + { struct perlmod_storage *ps = _THIS; +  +  if (ps->argv) +  { free((char *)ps->argv); +  ps->argv=0;    } -  if(THIS->argv_strings) -  { -  free_array(THIS->argv_strings); -  THIS->argv_strings=0; +  +  if (ps->argv_strings) +  { free_array(ps->argv_strings); +  ps->argv_strings=0;    } -  if(THIS->env) -  { -  free((char *)THIS->env); -  THIS->env=0; +  +  if (ps->env) +  { free((char *)ps->env); +  ps->env=0;    } -  if(THIS->env_block) -  { -  free((char *)THIS->env_block); -  THIS->env_block=0; +  +  if (ps->env_block) +  { free((char *)ps->env_block); +  ps->env_block=0;    }   }      static void exit_perl_glue(struct object *o) - { + { struct perlmod_storage *ps = _THIS;   #ifdef PIKE_PERLDEBUG    fprintf(stderr, "[exit_perl_glue]\n");   #endif    -  if(PERL) +  if (ps->perl)    { -  struct perlmod_storage *storage=THIS; -  -  MT_PERMIT; -  if(storage->constructed) +  if (ps->constructed)    { -  if (!storage->parsed) -  { static char *dummyargv[] = { "perl", "-e", "1", 0 }; -  extern void xs_init(void); -  /* this should be unnecessary, but for some reason, some +  if (!ps->parsed) +  { /* This should be unnecessary, but for some reason, some    * perl5.004 installations dump core if we don't do this.    */ -  perl_parse(storage->my_perl, xs_init, 3, dummyargv, NULL); +  _perl_parse(ps, 3, dummyargv, NULL);    } -  perl_destruct(storage->my_perl); -  storage->constructed=0; +  perl_destruct(ps->perl); +  ps->constructed = 0;    } -  perl_free(storage->my_perl); +  MT_PERMIT; +  perl_free(ps->perl);    MT_FORBID;    num_perl_interpreters--;    }    _free_arg_and_env();   }      static void perlmod_create(INT32 args) - { PerlInterpreter *p=PERL; -  struct perlmod_storage *storage=THIS; + { struct perlmod_storage *ps = _THIS;      #ifdef PIKE_PERLDEBUG    fprintf(stderr, "[perlmod_create, %d args]\n", args); -  + #ifdef MY_XS +  fprintf(stderr, "[has MY_XS]\n");   #endif -  + #endif       if (args != 0) error("Perl->create takes no arguments."); -  if(!p) error("No perl interpreter available.\n"); +  if (!ps || !ps->perl) error("No perl interpreter available.\n");       MT_PERMIT; -  if(!storage->constructed) -  { perl_construct(p); -  storage->constructed++; +  if(!ps->constructed) +  { perl_construct(ps->perl); +  ps->constructed++;    } -  +  if (!ps->parsed) +  { +  _perl_parse(ps, 3, dummyargv, NULL); +  }    MT_FORBID;    pop_n_elems(args);    push_int(0);   }      static void perlmod_parse(INT32 args)   { -  extern void xs_init(void); +     int e;    struct mapping *env_mapping=0; -  PerlInterpreter *p=PERL; -  struct perlmod_storage *storage=THIS; +  struct perlmod_storage *ps = _THIS; + #ifndef MY_XS +  extern void xs_init(void); + #endif      #ifdef PIKE_PERLDEBUG    fprintf(stderr, "[perlmod_parse, %d args]\n", args);   #endif       check_all_args("Perl->parse",args,BIT_ARRAY, BIT_MAPPING|BIT_VOID, 0); -  if(!p) error("No perl interpreter available.\n"); +  if(!ps->perl) error("No perl interpreter available.\n");       switch(args)    {    default:    env_mapping = Pike_sp[1-args].u.mapping;    mapping_fix_type_field(env_mapping);       if(m_ind_types(env_mapping) & ~BIT_STRING)    error("Bad argument 2 to Perl->create().\n");    if(m_val_types(env_mapping) & ~BIT_STRING)    error("Bad argument 2 to Perl->create().\n");       case 1: -  if (THIS->argv_strings || THIS->env_block) +  if (_THIS->argv_strings || _THIS->env_block)    { /* if we have already setup args/env, free the old values now */    _free_arg_and_env();    }    -  THIS->argv_strings = Pike_sp[-args].u.array; -  add_ref(THIS->argv_strings); -  array_fix_type_field(THIS->argv_strings); +  ps->argv_strings = Pike_sp[-args].u.array; +  add_ref(ps->argv_strings); +  array_fix_type_field(ps->argv_strings);    -  if(THIS->argv_strings->size<2) +  if(ps->argv_strings->size<2)    error("Perl: Too few elements in argv array.\n");    -  if(THIS->argv_strings->type_field & ~BIT_STRING) +  if(ps->argv_strings->type_field & ~BIT_STRING)    error("Bad argument 1 to Perl->parse().\n");    }    -  THIS->argv=(char **)xalloc(sizeof(char *)*THIS->argv_strings->size); -  for(e=0;e<THIS->argv_strings->size;e++) -  THIS->argv[e]=ITEM(THIS->argv_strings)[e].u.string->str; +  ps->argv=(char **)xalloc(sizeof(char *)*ps->argv_strings->size); +  for(e=0;e<ps->argv_strings->size;e++) +  ps->argv[e]=ITEM(ps->argv_strings)[e].u.string->str;       if(env_mapping)    {    INT32 d;    int env_block_size=0;    char *env_blockp;    struct keypair *k;    MAPPING_LOOP(env_mapping)    env_block_size+=k->ind.u.string->len+k->val.u.string->len+2;    -  THIS->env_block=xalloc(env_block_size); -  THIS->env=(char **)xalloc(sizeof(char *)*(m_sizeof(env_mapping)+1)); +  ps->env_block=xalloc(env_block_size); +  ps->env=(char **)xalloc(sizeof(char *)*(m_sizeof(env_mapping)+1));    -  env_blockp=THIS->env_block; +  env_blockp = ps->env_block;    d=0;    MAPPING_LOOP(env_mapping)    { -  THIS->env[d++]=env_blockp; +  ps->env[d++]=env_blockp;    MEMCPY(env_blockp,k->ind.u.string->str,k->ind.u.string->len);    env_blockp+=k->ind.u.string->len;       *(env_blockp++)='=';       MEMCPY(env_blockp,k->val.u.string->str,k->ind.u.string->len);    env_blockp+=k->val.u.string->len;       *(env_blockp++)=0;    } -  THIS->env[d]=0; +  ps->env[d]=0;    } -  else -  { -  /* Perl likes to be able to write in the environment block, -  * give it it's own copy to protect ourselves.. /Hubbe -  */ -  INT32 d; -  int env_block_size=0; -  char *env_blockp; +  else ps->env = 0;    - #ifdef DECLARE_ENVIRON -  extern char **environ; - #endif +  e = _perl_parse(ps, ps->argv_strings->size, ps->argv, ps->env);    -  for(d=0;environ[d];d++) -  env_block_size+=strlen(environ[d])+1; -  -  THIS->env_block=xalloc(env_block_size); -  THIS->env=(char **)xalloc(sizeof(char *)*(d+1)); -  -  env_blockp=THIS->env_block; -  -  for(d=0;environ[d];d++) -  { -  int l=strlen(environ[d]); -  THIS->env[d]=env_blockp; -  MEMCPY(env_blockp,environ[d],l+1); -  env_blockp+=l+1; -  } -  - #ifdef PIKE_DEBUG -  if(env_blockp - THIS->env_block > env_block_size) -  fatal("Arglebargle glop-glyf.\n"); - #endif -  -  THIS->env[d]=0; -  } -  -  -  THIS->parsed++; -  -  MT_PERMIT; -  e=perl_parse(p, -  xs_init, -  storage->argv_strings->size, -  storage->argv, -  storage->env); -  MT_FORBID; +     pop_n_elems(args);    push_int(e);   }      static void perlmod_run(INT32 args)   {    INT32 i; -  PerlInterpreter *p=PERL; -  if(!p) error("No perl interpreter available.\n"); +  struct perlmod_storage *ps = _THIS; +  +  if(!ps->perl) error("No perl interpreter available.\n");    pop_n_elems(args);    -  if(!THIS->constructed || !THIS->parsed) +  if(!_THIS->constructed || !_THIS->parsed)    error("No Perl program loaded (run() called before parse()).\n");       MT_PERMIT; -  i=perl_run(p); +  i=perl_run(ps->perl);    MT_FORBID;       push_int(i);   }      static void _perlmod_eval(INT32 args, int perlflags) - { PerlInterpreter *p = PERL; -  struct pike_string *arg1; -  struct perlmod_storage *storage = THIS; + { struct pike_string *firstarg; +  struct perlmod_storage *ps = _THIS;    int i, n; - #define sp _perlsp + // #define sp _perlsp    dSP;    -  if (!p) error("Perl interpreter not available.\n"); +  if (!ps->perl) error("Perl interpreter not available.\n");       check_all_args("Perl->eval", args, BIT_STRING, 0); -  arg1 = _pikesp()[-args].u.string; +  firstarg = Pike_sp[-args].u.string;       ENTER;    SAVETMPS;    PUSHMARK(sp);       PUTBACK; - #undef sp -  MT_PERMIT; + // #undef sp    -  if (!storage->parsed) -  { static char *dummyargv[] = { "perl", "-e", "1", 0 }; +  if (!ps->parsed) +  { + #if 0 +  _perl_parse(ps, 3, dummyargv, NULL); + #else + #ifndef MY_XS    extern void xs_init(void); -  perl_parse(p, xs_init, 3, dummyargv, NULL); -  storage->parsed++; + #endif +  perl_parse(ps->perl, xs_init, 3, dummyargv, NULL); + #endif    }    -  n = perl_eval_sv(newSVpv(arg1->str, arg1->len), perlflags | G_EVAL); +  MT_PERMIT;    -  + /* perl5.6.0 testing: newSVpv((const char *) "ABC", 3); */ +  +  n = perl_eval_sv(newSVpv((firstarg->str), +  (firstarg->len)), +  perlflags | G_EVAL); +     MT_FORBID;       _pop_n_elems(args);    - #define sp _perlsp + // #define sp _perlsp    SPAGAIN;    -  if (SvTRUE(GvSV(errgv))) +  if (SvTRUE(GvSV(PL_errgv)))    { char errtmp[256];    memset(errtmp, 0, sizeof(errtmp));    strcpy(errtmp, "Error from Perl: "); -  strncpy(errtmp+strlen(errtmp), SvPV(GvSV(errgv), na), 254-strlen(errtmp)); +  strncpy(errtmp+strlen(errtmp), +  SvPV(GvSV(PL_errgv), PL_na), +  254-strlen(errtmp));    POPs;    PUTBACK; FREETMPS; LEAVE;    error(errtmp);    }       if (perlflags & G_ARRAY)    { struct array *a = allocate_array(n);    for(i = 0; i < n; ++i)    _sv_to_svalue(POPs, &(a->item[(n-1)-i]));    _push_array(a);    }    else if (n > 0)    { for(; n > 1; --n) POPs;    _pikepush_sv(POPs);    }    else _push_zerotype();       PUTBACK; FREETMPS; LEAVE; - #undef sp + // #undef sp   }      static void perlmod_eval(INT32 args)    { _perlmod_eval(args, G_SCALAR); }      static void perlmod_eval_list(INT32 args)    { _perlmod_eval(args, G_ARRAY); }      static void _perlmod_call(INT32 args, int perlflags) - { PerlInterpreter *p = PERL; + { struct perlmod_storage *ps = _THIS;    int i, n; char *pv; - #define sp _perlsp + // #define sp _perlsp    dSP;      #ifdef PIKE_PERLDEBUG    fprintf(stderr, "[perlmod_call: args=%d]\n", args);   #endif    -  if (!p) error("No perl interpreter available.\n"); +  if (!ps->perl) error("No perl interpreter available.\n");       if (args < 1) error("Too few arguments.\n");    if (args > 201) error("Too many arguments.\n");    -  if (_pikesp()[-args].type != T_STRING || -  _pikesp()[-args].u.string->size_shift) +  if (Pike_sp[-args].type != T_STRING || +  Pike_sp[-args].u.string->size_shift)    error("bad Perl function name (must be an 8-bit string)");       ENTER;    SAVETMPS;    PUSHMARK(sp);       for(n = 1; n < args; ++n) -  { struct svalue *s = &(_pikesp()[n-args]); +  { struct svalue *s = &(Pike_sp[n-args]);    char *msg;    switch (s->type)    { case T_INT:    XPUSHs(sv_2mortal(newSViv(s->u.integer)));    break;    case T_FLOAT:    XPUSHs(sv_2mortal(newSVnv((double)(s->u.float_number))));    break;    case T_STRING:    if (s->u.string->size_shift)
pike.git/src/modules/Perl/perlmod.c:488:    default:    msg = "Unsupported argument type.\n";    PUTBACK; FREETMPS; LEAVE;    error(msg);    return;    }    }    PUTBACK;       pv = Pike_sp[-args].u.string->str; - #undef sp + // #undef sp    MT_PERMIT;       n = perl_call_pv(pv, perlflags);       MT_FORBID; - #define sp _perlsp + // #define sp _perlsp       _pop_n_elems(args);       SPAGAIN;    -  if (SvTRUE(GvSV(errgv))) +  if (SvTRUE(GvSV(PL_errgv)))    { char errtmp[256];    memset(errtmp, 0, sizeof(errtmp));    strcpy(errtmp, "Error from Perl: "); -  strncpy(errtmp+strlen(errtmp), SvPV(GvSV(errgv), na), 254-strlen(errtmp)); +  strncpy(errtmp+strlen(errtmp), +  SvPV(GvSV(PL_errgv), PL_na), +  254-strlen(errtmp));    POPs;    PUTBACK; FREETMPS; LEAVE;    error(errtmp);    }       if (n < 0)    { PUTBACK; FREETMPS; LEAVE;    error("Internal error: perl_call_pv returned a negative number.\n");    }       if (!(perlflags & G_ARRAY) && n > 1)    while (n > 1) --n, POPs;    -  if (n > THIS->array_size_limit) +  if (n > ps->array_size_limit)    { PUTBACK; FREETMPS; LEAVE;    error("Perl function returned too many values.\n");    }       if (perlflags & G_ARRAY)    { struct array *a = allocate_array(n);    for(i = 0; i < n; ++i)    _sv_to_svalue(POPs, &(a->item[(n-1)-i]));    _push_array(a);    }    else if (n == 1)    _pikepush_sv(POPs);    else /* shouldn't happen unless we put G_DISCARD in perlflags */    _push_zerotype();       PUTBACK; FREETMPS; LEAVE; - #undef sp + // #undef sp   }      static void perlmod_call_list(INT32 args)   { _perlmod_call(args, G_ARRAY | G_EVAL);   }      static void perlmod_call(INT32 args)   { _perlmod_call(args, G_SCALAR | G_EVAL);   }      static void _perlmod_varop(INT32 args, int op, int type)   { int i, wanted_args;       wanted_args = type == 'S' ? 1 : 2;    if (op == 'W') ++wanted_args;    -  if (!(PERL)) error("No Perl interpreter available.\n"); +  if (!(_THIS->perl)) error("No Perl interpreter available.\n");       if (args != wanted_args) error("Wrong number of arguments.\n");    if (Pike_sp[-args].type != T_STRING ||    Pike_sp[-args].u.string->size_shift != 0)    error("Variable name must be an 8-bit string.\n");       if (type == 'S') /* scalar */    { SV *sv = perl_get_sv(Pike_sp[-args].u.string->str, TRUE | GV_ADDMULTI);    if (op == 'W')    { sv_setsv(sv, sv_2mortal(_pikev2sv(Pike_sp-1)));}
pike.git/src/modules/Perl/perlmod.c:642:   { AV *av; int i, n; struct array *arr;    if (args != 1) error("Wrong number of arguments.\n");    if (Pike_sp[-args].type != T_STRING ||    Pike_sp[-args].u.string->size_shift != 0)    error("Array name must be given as an 8-bit string.\n");       av = perl_get_av(Pike_sp[-args].u.string->str, TRUE | GV_ADDMULTI);    if (!av) error("Interal error: perl_get_av() returned NULL.\n");    n = av_len(av) + 1;    -  if (n > THIS->array_size_limit) +  if (n > _THIS->array_size_limit)    error("The array is larger than array_size_limit.\n");       arr = allocate_array(n);    for(i = 0; i < n; ++i)    { SV **svp = av_fetch(av, i, 0);    _sv_to_svalue(svp ? *svp : NULL, &(arr->item[i]));    }    pop_n_elems(args);    push_array(arr);   }
pike.git/src/modules/Perl/perlmod.c:667:    if (Pike_sp[-args].type != T_STRING ||    Pike_sp[-args].u.string->size_shift != 0)    error("Hash name must be given as an 8-bit string.\n");       hv = perl_get_hv(Pike_sp[-args].u.string->str, TRUE | GV_ADDMULTI);    if (!hv) error("Interal error: perl_get_av() return NULL.\n");       /* count number of elements in hash */    for(n = 0, hv_iterinit(hv); (he = hv_iternext(hv)); ++n);    -  if (n > THIS->array_size_limit) +  if (n > _THIS->array_size_limit)    error("The array is larger than array_size_limit.\n");       arr = allocate_array(n);    for(i = 0, hv_iterinit(hv); (he = hv_iternext(hv)); ++i)    _sv_to_svalue(hv_iterkeysv(he), &(arr->item[i]));       pop_n_elems(args);    push_array(arr);   }      static void perlmod_array_size_limit(INT32 args)   { int i;    switch (args)    { case 0:    break;    case 1:    if (Pike_sp[-args].type != T_INT || Pike_sp[-args].u.integer < 1)    error("Argument must be a integer in range 1 to 2147483647."); -  THIS->array_size_limit = Pike_sp[-args].u.integer; +  _THIS->array_size_limit = Pike_sp[-args].u.integer;    break;    default:    error("Wrong number of arguments.\n");    }    pop_n_elems(args); -  _push_int(THIS->array_size_limit); +  _push_int(_THIS->array_size_limit);   }      void pike_module_init(void)   {   #ifdef PIKE_PERLDEBUG    fprintf(stderr, "[perl: module init]\n");   #endif    -  perl_destruct_level=1; -  +     start_new_program();    ADD_STORAGE(struct perlmod_storage);    /* function(void:int) */    ADD_FUNCTION("create",perlmod_create,tFunc(tVoid,tInt),0);    /* function(array(string),void|mapping(string:string):int) */    ADD_FUNCTION("parse",perlmod_parse,tFunc(tArr(tStr) tOr(tVoid,tMap(tStr,tStr)),tInt),0);    /* function(:int) */    ADD_FUNCTION("run",perlmod_run,tFunc(tNone,tInt),0);       /* function(string,mixed...:mixed) */
pike.git/src/modules/Perl/perlmod.c:786:    0,   #endif    0);   }      void pike_module_exit(void)   {   }      #else /* HAVE_PERL */ +  + #ifdef ERROR_IF_NO_PERL + #error "No Perl!" + #endif +    void pike_module_init(void) {}   void pike_module_exit(void) {}   #endif