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