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