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

version» Context lines:

pike.git/src/modules/Perl/perlmod.c:1: - /* $Id: perlmod.c,v 1.25 2002/08/15 14:50:27 marcus Exp $ */ + /* $Id: perlmod.c,v 1.26 2002/08/29 12:48:40 stensson Exp $ */      #define NO_PIKE_SHORTHAND      #include "builtin_functions.h"   #include "global.h"   #include "svalue.h"   #include "array.h"   #include "stralloc.h"   #include "interpret.h"   #include "module_support.h"
pike.git/src/modules/Perl/perlmod.c:29:      #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__; + { +  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! */
pike.git/src/modules/Perl/perlmod.c:64:    char **env;    char *env_block;    struct array *argv_strings;    int constructed, parsed;    int array_size_limit;    PerlInterpreter *perl;   };      #define _THIS ((struct perlmod_storage *)(Pike_fp->current_storage))    - #ifdef PERL_560 + #ifdef PERL_560 /* Perl 5.6? */   #define my_perl PERL -  + #else + #define my_perl (_THIS)->perl   #endif      #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); + { +  push_int(0);    Pike_sp[-1].subtype = 1;   }      static SV * _pikev2sv(struct svalue *s) - { switch (s->type) -  { case PIKE_T_INT: + { +  switch (s->type) +  { +  case PIKE_T_INT:    return newSViv(s->u.integer); break;    case PIKE_T_FLOAT:    return newSVnv(s->u.float_number); break;    case PIKE_T_STRING:    if (s->u.string->size_shift) break;    return newSVpv(s->u.string->str, s->u.string->len); break;    }    Pike_error("Unsupported value type.\n");    return 0;   }      static void _sv_to_svalue(SV *sv, struct svalue *sval) - { if (sv && (SvOK(sv))) -  { if (SvIOKp(sv)) -  { sval->type = PIKE_T_INT; sval->subtype = 0; + { +  if (sv && (SvOK(sv))) +  { +  if (SvIOKp(sv)) +  { +  sval->type = PIKE_T_INT; sval->subtype = 0;    sval->u.integer = SvIV(sv);    return;    }    else if (SvNOKp(sv)) -  { sval->type = PIKE_T_FLOAT; sval->subtype = 0; +  { +  sval->type = PIKE_T_FLOAT; sval->subtype = 0;    sval->u.float_number = SvNV(sv);    return;    }    else if (SvPOKp(sv)) -  { sval->type = PIKE_T_STRING; sval->subtype = 0; +  { +  sval->type = PIKE_T_STRING; sval->subtype = 0;    sval->u.string = make_shared_binary_string(SvPVX(sv), SvCUR(sv));    return;    }    }    sval->type = PIKE_T_INT; sval->u.integer = 0;    sval->subtype = !sv; /* zero-type zero if NULL pointer */   }      static void _pikepush_sv(SV *sv) - { if (!SvOK(sv)) + { +  if (!SvOK(sv))    push_int(0);    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; + { +  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)    Pike_error("Internal error: no Perl storage allocated.\n");    if (!ps->perl)
pike.git/src/modules/Perl/perlmod.c:171:    extern char **environ;   #endif       for(d=0;environ[d];d++)    env_block_size+=strlen(environ[d])+1;       if (env_block_size)    ps->env_block=xalloc(env_block_size);    else    ps->env_block = NULL; +     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;
pike.git/src/modules/Perl/perlmod.c:200:    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) - { struct perlmod_storage *ps = _THIS; + { +  struct perlmod_storage *ps = _THIS;      #ifdef PIKE_PERLDEBUG    fprintf(stderr, "[init_perl_glue]\n");   #endif       ps->argv = 0;    ps->env = 0;    ps->env_block = 0;    ps->argv_strings = 0;    ps->constructed = 0;