1 |
root |
1.1 |
/* miniperlmain.c |
2 |
|
|
* |
3 |
|
|
* Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003, |
4 |
|
|
* 2004, 2005 by Larry Wall and others |
5 |
|
|
* |
6 |
|
|
* You may distribute under the terms of either the GNU General Public |
7 |
|
|
* License or the Artistic License, as specified in the README file. |
8 |
|
|
* |
9 |
|
|
*/ |
10 |
|
|
|
11 |
|
|
/* |
12 |
|
|
* "The Road goes ever on and on, down from the door where it began." |
13 |
|
|
*/ |
14 |
|
|
|
15 |
|
|
/* This file contains the main() function for the perl interpreter. |
16 |
|
|
* Note that miniperlmain.c contains main() for the 'miniperl' binary, |
17 |
|
|
* while perlmain.c contains main() for the 'perl' binary. |
18 |
|
|
* |
19 |
|
|
* Miniperl is like perl except that it does not support dynamic loading, |
20 |
|
|
* and in fact is used to build the dynamic modules needed for the 'real' |
21 |
|
|
* perl executable. |
22 |
|
|
*/ |
23 |
|
|
|
24 |
|
|
#ifdef OEMVS |
25 |
|
|
#ifdef MYMALLOC |
26 |
|
|
/* sbrk is limited to first heap segment so make it big */ |
27 |
|
|
#pragma runopts(HEAP(8M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON)) |
28 |
|
|
#else |
29 |
|
|
#pragma runopts(HEAP(2M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON)) |
30 |
|
|
#endif |
31 |
|
|
#endif |
32 |
|
|
|
33 |
|
|
|
34 |
|
|
#include "EXTERN.h" |
35 |
|
|
#define PERL_IN_MINIPERLMAIN_C |
36 |
|
|
#include "perl.h" |
37 |
|
|
|
38 |
|
|
static void xs_init (pTHX); |
39 |
|
|
static PerlInterpreter *my_perl; |
40 |
|
|
|
41 |
|
|
#if defined (__MINT__) || defined (atarist) |
42 |
|
|
/* The Atari operating system doesn't have a dynamic stack. The |
43 |
|
|
stack size is determined from this value. */ |
44 |
|
|
long _stksize = 64 * 1024; |
45 |
|
|
#endif |
46 |
|
|
|
47 |
|
|
int |
48 |
|
|
main(int argc, char **argv, char **env) |
49 |
|
|
{ |
50 |
|
|
int exitstatus; |
51 |
|
|
#ifndef PERL_USE_SAFE_PUTENV |
52 |
|
|
PL_use_safe_putenv = 0; |
53 |
|
|
#endif /* PERL_USE_SAFE_PUTENV */ |
54 |
|
|
|
55 |
|
|
#ifdef PERL_GLOBAL_STRUCT |
56 |
|
|
#define PERLVAR(var,type) /**/ |
57 |
|
|
#define PERLVARA(var,type) /**/ |
58 |
|
|
#define PERLVARI(var,type,init) PL_Vars.var = init; |
59 |
|
|
#define PERLVARIC(var,type,init) PL_Vars.var = init; |
60 |
|
|
#include "perlvars.h" |
61 |
|
|
#undef PERLVAR |
62 |
|
|
#undef PERLVARA |
63 |
|
|
#undef PERLVARI |
64 |
|
|
#undef PERLVARIC |
65 |
|
|
#endif |
66 |
|
|
|
67 |
|
|
/* if user wants control of gprof profiling off by default */ |
68 |
|
|
/* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */ |
69 |
|
|
PERL_GPROF_MONCONTROL(0); |
70 |
|
|
|
71 |
|
|
PERL_SYS_INIT3(&argc,&argv,&env); |
72 |
|
|
|
73 |
|
|
#if defined(USE_5005THREADS) || defined(USE_ITHREADS) |
74 |
|
|
/* XXX Ideally, this should really be happening in perl_alloc() or |
75 |
|
|
* perl_construct() to keep libperl.a transparently fork()-safe. |
76 |
|
|
* It is currently done here only because Apache/mod_perl have |
77 |
|
|
* problems due to lack of a call to cancel pthread_atfork() |
78 |
|
|
* handlers when shared objects that contain the handlers may |
79 |
|
|
* be dlclose()d. This forces applications that embed perl to |
80 |
|
|
* call PTHREAD_ATFORK() explicitly, but if and only if it hasn't |
81 |
|
|
* been called at least once before in the current process. |
82 |
|
|
* --GSAR 2001-07-20 */ |
83 |
|
|
PTHREAD_ATFORK(Perl_atfork_lock, |
84 |
|
|
Perl_atfork_unlock, |
85 |
|
|
Perl_atfork_unlock); |
86 |
|
|
#endif |
87 |
|
|
|
88 |
|
|
if (!PL_do_undump) { |
89 |
|
|
my_perl = perl_alloc(); |
90 |
|
|
if (!my_perl) |
91 |
|
|
exit(1); |
92 |
|
|
perl_construct(my_perl); |
93 |
|
|
PL_perl_destruct_level = 0; |
94 |
|
|
} |
95 |
|
|
PL_exit_flags |= PERL_EXIT_DESTRUCT_END; |
96 |
|
|
exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL); |
97 |
|
|
if (!exitstatus) |
98 |
|
|
perl_run(my_perl); |
99 |
|
|
|
100 |
|
|
exitstatus = perl_destruct(my_perl); |
101 |
|
|
|
102 |
|
|
perl_free(my_perl); |
103 |
|
|
|
104 |
|
|
PERL_SYS_TERM(); |
105 |
|
|
|
106 |
|
|
exit(exitstatus); |
107 |
|
|
return exitstatus; |
108 |
|
|
} |
109 |
|
|
|
110 |
|
|
/* Register any extra external extensions */ |
111 |
|
|
|
112 |
|
|
/* Do not delete this line--writemain depends on it */ |
113 |
|
|
|
114 |
|
|
static void |
115 |
|
|
xs_init(pTHX) |
116 |
|
|
{ |
117 |
|
|
dXSUB_SYS; |
118 |
|
|
} |