Deparse bug introduced by #14615: the fix is just a workaround,
[p5sagit/p5-mst-13.2.git] / wince / wince.c
index c2cda81..b6b9f14 100644 (file)
@@ -1,6 +1,6 @@
 /*  WINCE.C - stuff for Windows CE
  *
- *  Time-stamp: <01/08/01 19:29:57 keuchel@w2k>
+ *  Time-stamp: <26/10/01 15:25:20 keuchel@keuchelnt>
  *
  *  You may distribute under the terms of either the GNU General Public
  *  License or the Artistic License, as specified in the README file.
 #  define getlogin g_getlogin
 #endif
 
-#if defined(PERL_OBJECT)
-#  undef do_aspawn
-#  define do_aspawn g_do_aspawn
-#  undef Perl_do_exec
-#  define Perl_do_exec g_do_exec
-#endif
-
 static long            filetime_to_clock(PFILETIME ft);
 static BOOL            filetime_from_time(PFILETIME ft, time_t t);
 static char *          get_emd_part(SV **leading, char *trailing, ...);
@@ -132,7 +125,7 @@ get_regstr_from(HKEY hkey, const char *valuename, SV **svp)
        DWORD datalen;
        retval = XCERegQueryValueExA(handle, valuename, 0, &type, NULL, &datalen);
        if (retval == ERROR_SUCCESS && type == REG_SZ) {
-           dTHXo;
+           dTHX;
            if (!*svp)
                *svp = sv_2mortal(newSVpvn("",0));
            SvGROW(*svp, datalen);
@@ -212,7 +205,7 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...)
     /* only add directory if it exists */
     if (XCEGetFileAttributesA(mod_name) != (DWORD) -1) {
        /* directory exists */
-       dTHXo;
+       dTHX;
        if (!*prev_pathp)
            *prev_pathp = sv_2mortal(newSVpvn("",0));
        sv_catpvn(*prev_pathp, ";", 1);
@@ -226,7 +219,7 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...)
 char *
 win32_get_privlib(const char *pl)
 {
-    dTHXo;
+    dTHX;
     char *stdlib = "lib";
     char buffer[MAX_PATH+1];
     SV *sv = Nullsv;
@@ -243,7 +236,7 @@ win32_get_privlib(const char *pl)
 static char *
 win32_get_xlib(const char *pl, const char *xlib, const char *libname)
 {
-    dTHXo;
+    dTHX;
     char regstr[40];
     char pathstr[MAX_PATH+1];
     DWORD datalen;
@@ -589,23 +582,19 @@ win32_uname(struct utsname *name)
     return 0;
 }
 
-#ifndef PERL_OBJECT
-
 static UINT timerid = 0;
 
 static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
 {
-    dTHXo;
+    dTHX;
     KillTimer(NULL,timerid);
     timerid=0;  
     sighandler(14);
 }
-#endif /* !PERL_OBJECT */
 
 DllExport unsigned int
 win32_alarm(unsigned int sec)
 {
-#ifndef PERL_OBJECT
     /* 
      * the 'obvious' implentation is SetTimer() with a callback
      * which does whatever receiving SIGALRM would do 
@@ -615,7 +604,7 @@ win32_alarm(unsigned int sec)
      * Snag is unless something is looking at the message queue
      * nothing happens :-(
      */ 
-    dTHXo;
+    dTHX;
     if (sec)
      {
       timerid = SetTimer(NULL,timerid,sec*1000,(TIMERPROC)TimerProc);
@@ -630,7 +619,6 @@ win32_alarm(unsigned int sec)
         timerid=0;  
        }
      }
-#endif /* !PERL_OBJECT */
     return 0;
 }
 
@@ -641,7 +629,7 @@ extern char *       des_fcrypt(const char *txt, const char *salt, char *cbuf);
 DllExport char *
 win32_crypt(const char *txt, const char *salt)
 {
-    dTHXo;
+    dTHX;
 #ifdef HAVE_DES_FCRYPT
     dTHR;
     return des_fcrypt(txt, salt, w32_crypt_buffer);
@@ -756,7 +744,7 @@ win32_strerror(int e)
 DllExport void
 win32_str_os_error(void *sv, DWORD dwErr)
 {
-  dTHXo;
+  dTHX;
 
   sv_setpvn((SV*)sv, "Error", 5);
 }
@@ -883,8 +871,8 @@ win32_fseek(FILE *pf,long offset,int origin)
   return fseek(pf, offset, origin);
 }
 
-// fpos_t seems to be int64 on hpc pro! Really stupid.
-// But maybe someday there will be such large disks in a hpc...
+/* fpos_t seems to be int64 on hpc pro! Really stupid. */
+/* But maybe someday there will be such large disks in a hpc... */
 DllExport int
 win32_fgetpos(FILE *pf, fpos_t *p)
 {
@@ -1237,7 +1225,7 @@ win32_execvp(const char *cmdname, const char *const *argv)
 DllExport void*
 win32_dynaload(const char* filename)
 {
-    dTHXo;
+    dTHX;
     HMODULE hModule;
 
     hModule = XCELoadLibraryA(filename);
@@ -1245,7 +1233,7 @@ win32_dynaload(const char* filename)
     return hModule;
 }
 
-// this is needed by Cwd.pm...
+/* this is needed by Cwd.pm... */
 
 static
 XS(w32_GetCwd)
@@ -1260,6 +1248,9 @@ XS(w32_GetCwd)
   EXTEND(SP,1);
   SvPOK_on(sv);
   ST(0) = sv;
+#ifndef INCOMPLETE_TAINTS
+  SvTAINTED_on(ST(0));
+#endif
   XSRETURN(1);
 }
 
@@ -1302,7 +1293,7 @@ XS(w32_GetOSVersion)
     XPUSHs(newSViv(osver.dwMajorVersion));
     XPUSHs(newSViv(osver.dwMinorVersion));
     XPUSHs(newSViv(osver.dwBuildNumber));
-    // WINCE = 3
+    /* WINCE = 3 */
     XPUSHs(newSViv(osver.dwPlatformId));
     PUTBACK;
 }
@@ -1466,7 +1457,7 @@ XS(w32_ShellEx)
 void
 Perl_init_os_extras(void)
 {
-    dTHXo;
+    dTHX;
     char *file = __FILE__;
     dXSUB_SYS;
 
@@ -1569,17 +1560,12 @@ wce_hitreturn()
   return;
 }
 
-//////////////////////////////////////////////////////////////////////
-
-#ifdef PERL_OBJECT
-#  undef this
-#  define this pPerl
-#endif
+/* //////////////////////////////////////////////////////////////////// */
 
 void
 win32_argv2utf8(int argc, char** argv)
 {
-  // do nothing...
+  /* do nothing... */
 }
 
 void
@@ -1614,3 +1600,19 @@ Perl_sys_intern_clear(pTHX)
 #  endif
 }
 
+/* //////////////////////////////////////////////////////////////////// */
+
+#undef getcwd
+
+char *
+getcwd(char *buf, size_t size)
+{
+  return xcegetcwd(buf, size);
+}
+
+int 
+isnan(double d)
+{
+  return _isnan(d);
+}
+