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