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