This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Two more delays added to test suite to help *-solaris-thread.
[perl5.git] / win32 / perllib.c
1 /*
2  * "The Road goes ever on and on, down from the door where it began."
3  */
4
5
6 #include "EXTERN.h"
7 #include "perl.h"
8 #include "XSUB.h"
9
10 #ifdef __cplusplus
11 #  define EXTERN_C extern "C"
12 #else
13 #  define EXTERN_C extern
14 #endif
15
16 static void xs_init _((void));
17
18 __declspec(dllexport) int
19 RunPerl(int argc, char **argv, char **env, void *iosubsystem)
20 {
21     int exitstatus;
22     PerlInterpreter *my_perl;
23     void *pOldIOSubsystem;
24
25     pOldIOSubsystem = SetIOSubSystem(iosubsystem);
26
27     PERL_SYS_INIT(&argc,&argv);
28
29     perl_init_i18nl10n(1);
30
31     if (!(my_perl = perl_alloc()))
32         return (1);
33     perl_construct( my_perl );
34     perl_destruct_level = 0;
35
36     exitstatus = perl_parse( my_perl, xs_init, argc, argv, env);
37     if (!exitstatus) {
38         exitstatus = perl_run( my_perl );
39     }
40
41     perl_destruct( my_perl );
42     perl_free( my_perl );
43
44     PERL_SYS_TERM();
45
46     SetIOSubSystem(pOldIOSubsystem);
47
48     return (exitstatus);
49 }
50
51 extern HANDLE PerlDllHandle;
52
53 BOOL APIENTRY
54 DllMain(HANDLE hModule,         /* DLL module handle */
55         DWORD fdwReason,        /* reason called */
56         LPVOID lpvReserved)     /* reserved */
57
58     switch (fdwReason) {
59         /* The DLL is attaching to a process due to process
60          * initialization or a call to LoadLibrary.
61          */
62     case DLL_PROCESS_ATTACH:
63 /* #define DEFAULT_BINMODE */
64 #ifdef DEFAULT_BINMODE
65         setmode( fileno( stdin  ), O_BINARY );
66         setmode( fileno( stdout ), O_BINARY );
67         setmode( fileno( stderr ), O_BINARY );
68         _fmode = O_BINARY;
69 #endif
70         PerlDllHandle = hModule;
71         break;
72
73         /* The DLL is detaching from a process due to
74          * process termination or call to FreeLibrary.
75          */
76     case DLL_PROCESS_DETACH:
77         break;
78
79         /* The attached process creates a new thread. */
80     case DLL_THREAD_ATTACH:
81         break;
82
83         /* The thread of the attached process terminates. */
84     case DLL_THREAD_DETACH:
85         break;
86
87     default:
88         break;
89     }
90     return TRUE;
91 }
92
93 /* Register any extra external extensions */
94
95 char *staticlinkmodules[] = {
96     "DynaLoader",
97     NULL,
98 };
99
100 EXTERN_C void boot_DynaLoader _((CV* cv));
101
102 static void
103 xs_init()
104 {
105     char *file = __FILE__;
106     dXSUB_SYS;
107     newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
108 }
109