* License or the Artistic License, as specified in the README file.
*/
+#ifndef UNDER_CE
#define CHECK_HOST_INTERP
+#endif
#ifndef ___PerlHost_H___
#define ___PerlHost_H___
+#ifndef UNDER_CE
#include <signal.h>
+#endif
#include "iperlsys.h"
#include "vmem.h"
#include "vdir.h"
+#ifndef WC_NO_BEST_FIT_CHARS
+# define WC_NO_BEST_FIT_CHARS 0x00000400
+#endif
+
START_EXTERN_C
-extern char * g_win32_get_privlib(const char *pl);
-extern char * g_win32_get_sitelib(const char *pl);
-extern char * g_win32_get_vendorlib(const char *pl);
+extern char * g_win32_get_privlib(const char *pl, STRLEN *const len);
+extern char * g_win32_get_sitelib(const char *pl, STRLEN *const len);
+extern char * g_win32_get_vendorlib(const char *pl,
+ STRLEN *const len);
extern char * g_getlogin(void);
END_EXTERN_C
}
char*
-PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl)
+PerlEnvLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len)
{
- return g_win32_get_privlib(pl);
+ return g_win32_get_privlib(pl, len);
}
char*
-PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl)
+PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len)
{
- return g_win32_get_sitelib(pl);
+ return g_win32_get_sitelib(pl, len);
}
char*
-PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl)
+PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl,
+ STRLEN *const len)
{
- return g_win32_get_vendorlib(pl);
+ return g_win32_get_vendorlib(pl, len);
}
void
return win32_getc(pf);
}
-char*
+STDCHAR*
PerlStdIOGetBase(struct IPerlStdIO* piPerl, FILE* pf)
{
#ifdef FILE_base
FILE *f = pf;
return FILE_base(f);
#else
- return Nullch;
+ return NULL;
#endif
}
#endif
}
-char*
+STDCHAR*
PerlStdIOGetPtr(struct IPerlStdIO* piPerl, FILE* pf)
{
#ifdef USE_STDIO_PTR
FILE *f = pf;
return FILE_ptr(f);
#else
- return Nullch;
+ return NULL;
#endif
}
}
void
-PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, char * ptr)
+PerlStdIOSetPtr(struct IPerlStdIO* piPerl, FILE* pf, STDCHAR * ptr)
{
#ifdef STDIO_PTR_LVALUE
FILE *f = pf;
FILE*
PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf)
{
+#ifndef UNDER_CE
FILE* pfdup;
fpos_t pos;
char mode[3];
fsetpos(pfdup, &pos);
}
return pfdup;
+#else
+ return 0;
+#endif
}
struct IPerlStdIO perlStdIO =
int
PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data)
{
- return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data);
+ u_long u_long_arg;
+ int retval;
+
+ /* mauke says using memcpy avoids alignment issues */
+ memcpy(&u_long_arg, data, sizeof u_long_arg);
+ retval = win32_ioctlsocket((SOCKET)i, (long)u, &u_long_arg);
+ memcpy(data, &u_long_arg, sizeof u_long_arg);
+ return retval;
}
int
int
PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig)
{
- dTHX;
- Perl_croak(aTHX_ "killpg not implemented!\n");
- return 0;
+ return win32_kill(pid, -sig);
}
int
if (PL_restartop) {
POPSTACK_TO(PL_mainstack);
PL_op = PL_restartop;
- PL_restartop = Nullop;
+ PL_restartop = (OP*)NULL;
goto restart;
}
PerlIO_printf(Perl_error_log, "panic: restartop\n");
/* XXX hack to avoid perl_destruct() freeing optree */
win32_checkTLS(my_perl);
- PL_main_root = Nullop;
+ PL_main_root = (OP*)NULL;
}
win32_checkTLS(my_perl);
w32_message_hwnd = win32_create_message_window();
new_perl->Isys_intern.message_hwnd = w32_message_hwnd;
w32_pseudo_child_message_hwnds[w32_num_pseudo_children] =
- (w32_message_hwnd == NULL) ? NULL : INVALID_HANDLE_VALUE;
+ (w32_message_hwnd == NULL) ? (HWND)NULL : (HWND)INVALID_HANDLE_VALUE;
# ifdef USE_RTL_THREAD_API
handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child,
(void*)new_perl, 0, (unsigned*)&id);
LPSTR*
CPerlHost::Lookup(LPCSTR lpStr)
{
+#ifdef UNDER_CE
+ if (!m_lppEnvList || !m_dwEnvCount)
+ return NULL;
+#endif
if (!lpStr)
return NULL;
return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup);
CPerlHost::GetChildDir(void)
{
dTHX;
- int length;
char* ptr;
+ size_t length;
+
Newx(ptr, MAX_PATH+1, char);
- if(ptr) {
- m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
- length = strlen(ptr);
- if (length > 3) {
- if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
- ptr[length-1] = 0;
- }
+ m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr);
+ length = strlen(ptr);
+ if (length > 3) {
+ if ((ptr[length-1] == '\\') || (ptr[length-1] == '/'))
+ ptr[length-1] = 0;
}
return ptr;
}