contrib/perl5/ext/B/byteperl.c

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #ifndef PATCHLEVEL
   4 #include "patchlevel.h"
   5 #endif
   6
   7 static void xs_init _((void));
   8 static PerlInterpreter *my_perl;
   9
  10 int
  11 #ifndef CAN_PROTOTYPE
  12 main(argc, argv, env)
  13 int argc;
  14 char **argv;
  15 char **env;
  16 #else  /* def(CAN_PROTOTYPE) */
  17 main(int argc, char **argv, char **env)
  18 #endif  /* def(CAN_PROTOTYPE) */
  19 {
  20     int exitstatus;
  21     int i;
  22     char **fakeargv;
  23     FILE *fp;
  24 #ifdef INDIRECT_BGET_MACROS
  25     struct bytestream bs;
  26 #endif /* INDIRECT_BGET_MACROS */
  27
  28     INIT_SPECIALSV_LIST;
  29     PERL_SYS_INIT(&argc,&argv);
  30
  31 #if PATCHLEVEL > 3 || (PATCHLEVEL == 3 && SUBVERSION >= 1)
  32     perl_init_i18nl10n(1);
  33 #else
  34     perl_init_i18nl14n(1);
  35 #endif
  36
  37     if (!PL_do_undump) {
  38         my_perl = perl_alloc();
  39         if (!my_perl)
  40 #ifdef VMS
  41             exit(vaxc$errno);
  42 #else
  43             exit(1);
  44 #endif
  45         perl_construct( my_perl );
  46     }
  47
  48 #ifdef CSH
  49     if (!PL_cshlen)
  50       PL_cshlen = strlen(PL_cshname);
  51 #endif
  52
  53     if (argc < 2)
  54         fp = stdin;
  55     else {
  56 #ifdef WIN32
  57         fp = fopen(argv[1], "rb");
  58 #else
  59         fp = fopen(argv[1], "r");
  60 #endif
  61         if (!fp) {
  62             perror(argv[1]);
  63 #ifdef VMS
  64             exit(vaxc$errno);
  65 #else
  66             exit(1);
  67 #endif
  68         }
  69         argv++;
  70         argc--;
  71     }
  72     New(666, fakeargv, argc + 4, char *);
  73     fakeargv[0] = argv[0];
  74     fakeargv[1] = "-e";
  75     fakeargv[2] = "";
  76     fakeargv[3] = "--";
  77     for (i = 1; i < argc; i++)
  78         fakeargv[i + 3] = argv[i];
  79     fakeargv[argc + 3] = 0;
  80
  81     exitstatus = perl_parse(my_perl, xs_init, argc + 3, fakeargv, NULL);
  82     if (exitstatus)
  83         exit( exitstatus );
  84
  85     sv_setpv(GvSV(gv_fetchpv("0", TRUE, SVt_PV)), argv[0]);
  86     PL_main_cv = PL_compcv;
  87     PL_compcv = 0;
  88
  89 #ifdef INDIRECT_BGET_MACROS
  90     bs.data = fp;
  91     bs.fgetc = (int(*) _((void*)))fgetc;
  92     bs.fread = (int(*) _((char*,size_t,size_t,void*)))fread;
  93     bs.freadpv = freadpv;
  94     byterun(bs);
  95 #else
  96     byterun(fp);
  97 #endif /* INDIRECT_BGET_MACROS */
  98
  99     exitstatus = perl_run( my_perl );
 100
 101     perl_destruct( my_perl );
 102     perl_free( my_perl );
 103
 104     exit( exitstatus );
 105 }
 106
 107 static void
 108 xs_init()
 109 {
 110 }