win32 extras and embedding
Gurusamy Sarathy [Thu, 24 Jul 1997 09:58:46 +0000 (21:58 +1200)]
This patch makes the various Win32-specific builtins available
in embedded perl.

It also fixes a problem with FP errors thrown by the Borland
runtime when doing something like C<perl -e "print(1.0e+26 % 1">.
The VC runtime doesn't throw those errors because FP errors are
off by default in VC, on in Borland.  The patch adds code to always
turn them off.  (This should ultimately be made user-settable via
$SIG{FPE}, when we have more robust signal handling).

I've also made Borland builds use gcvt(), which is available there,
and is much faster than sprintf().

Most of the size of the patch comes from moved code.

[editor's note: some of these changes are being applied in the wrong
order and changing slightly]

p5p-msgid: 199707250232.WAA03421@aatma.engin.umich.edu

dosish.h
perl.c
win32/config.bc
win32/config_H.bc
win32/makedef.pl
win32/perllib.c
win32/win32.c
win32/win32.h

index 8734cda..1b251ef 100644 (file)
--- a/dosish.h
+++ b/dosish.h
@@ -11,10 +11,11 @@ void Perl_DJGPP_init();
 #  define PERL_SYS_INIT(argcp, argvp) STMT_START {        \
     Perl_DJGPP_init();    } STMT_END
 #else  /* DJGPP */
-#  define PERL_SYS_INIT(c,v)
 #  ifdef WIN32
+#    define PERL_SYS_INIT(c,v) Perl_win32_init(c,v)
 #    define BIT_BUCKET "nul"
 #  else
+#    define PERL_SYS_INIT(c,v)
 #    define BIT_BUCKET "\\dev\\nul" /* "wanna be like, umm, Newlined, or somethin?" */
 #  endif
 #endif /* DJGPP */
diff --git a/perl.c b/perl.c
index c5979ce..f1c606b 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -771,7 +771,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     boot_core_UNIVERSAL();
     if (xsinit)
        (*xsinit)();    /* in case linked C routines want magical variables */
-#ifdef VMS
+#if defined(VMS) || defined(WIN32)
     init_os_extras();
 #endif
 
index ab3a429..ad76309 100644 (file)
@@ -81,7 +81,7 @@ cpprun=''
 cppstdin=''
 cryptlib=''
 csh='undef'
-d_Gconvert='sprintf((b),"%.*g",(n),(x))'
+d_Gconvert='gcvt((x),(n),(b))'
 d_access='define'
 d_alarm='undef'
 d_archlib='define'
index ef1193e..1883e97 100644 (file)
  *             d_Gconvert='sprintf((b),"%.*g",(n),(x))'
  *     The last two assume trailing zeros should not be kept.
  */
-#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x))
+#define Gconvert(x,n,t,b) gcvt((x),(n),(b))
 
 /* HAS_GETPGID:
  *     This symbol, if defined, indicates to the C program that 
index 82c3da5..038c150 100644 (file)
@@ -318,3 +318,6 @@ win32_sethostent
 win32_setnetent
 win32_setprotoent
 win32_setservent
+win32_getenv
+win32_stdio
+Perl_win32_init
index 45d64d3..391b4d3 100644 (file)
@@ -103,284 +103,11 @@ char *staticlinkmodules[] = {
 
 EXTERN_C void boot_DynaLoader _((CV* cv));
 
-static
-XS(w32_GetCwd)
-{
-    dXSARGS;
-    SV *sv = sv_newmortal();
-    /* Make one call with zero size - return value is required size */
-    DWORD len = GetCurrentDirectory((DWORD)0,NULL);
-    SvUPGRADE(sv,SVt_PV);
-    SvGROW(sv,len);
-    SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv));
-    /* 
-     * If result != 0 
-     *   then it worked, set PV valid, 
-     *   else leave it 'undef' 
-     */
-    if (SvCUR(sv))
-       SvPOK_on(sv);
-    EXTEND(sp,1);
-    ST(0) = sv;
-    XSRETURN(1);
-}
-
-static
-XS(w32_SetCwd)
-{
-    dXSARGS;
-    if (items != 1)
-       croak("usage: Win32::SetCurrentDirectory($cwd)");
-    if (SetCurrentDirectory(SvPV(ST(0),na)))
-       XSRETURN_YES;
-
-    XSRETURN_NO;
-}
-
-static
-XS(w32_GetNextAvailDrive)
-{
-    dXSARGS;
-    char ix = 'C';
-    char root[] = "_:\\";
-    while (ix <= 'Z') {
-       root[0] = ix++;
-       if (GetDriveType(root) == 1) {
-           root[2] = '\0';
-           XSRETURN_PV(root);
-       }
-    }
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_GetLastError)
-{
-    dXSARGS;
-    XSRETURN_IV(GetLastError());
-}
-
-static
-XS(w32_LoginName)
-{
-    dXSARGS;
-    char name[256];
-    DWORD size = sizeof(name);
-    if (GetUserName(name,&size)) {
-       /* size includes NULL */
-       ST(0) = sv_2mortal(newSVpv(name,size-1));
-       XSRETURN(1);
-    }
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_NodeName)
-{
-    dXSARGS;
-    char name[MAX_COMPUTERNAME_LENGTH+1];
-    DWORD size = sizeof(name);
-    if (GetComputerName(name,&size)) {
-       /* size does NOT include NULL :-( */
-       ST(0) = sv_2mortal(newSVpv(name,size));
-       XSRETURN(1);
-    }
-    XSRETURN_UNDEF;
-}
-
-
-static
-XS(w32_DomainName)
-{
-    dXSARGS;
-    char name[256];
-    DWORD size = sizeof(name);
-    if (GetUserName(name,&size)) {
-       char sid[1024];
-       DWORD sidlen = sizeof(sid);
-       char dname[256];
-       DWORD dnamelen = sizeof(dname);
-       SID_NAME_USE snu;
-       if (LookupAccountName(NULL, name, &sid, &sidlen,
-                             dname, &dnamelen, &snu)) {
-           XSRETURN_PV(dname);         /* all that for this */
-       }
-    }
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_FsType)
-{
-    dXSARGS;
-    char fsname[256];
-    DWORD flags, filecomplen;
-    if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
-                        &flags, fsname, sizeof(fsname))) {
-       if (GIMME == G_ARRAY) {
-           XPUSHs(sv_2mortal(newSVpv(fsname,0)));
-           XPUSHs(sv_2mortal(newSViv(flags)));
-           XPUSHs(sv_2mortal(newSViv(filecomplen)));
-           PUTBACK;
-           return;
-       }
-       XSRETURN_PV(fsname);
-    }
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_GetOSVersion)
-{
-    dXSARGS;
-    OSVERSIONINFO osver;
-
-    osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
-    if (GetVersionEx(&osver)) {
-       XPUSHs(newSVpv(osver.szCSDVersion, 0));
-       XPUSHs(newSViv(osver.dwMajorVersion));
-       XPUSHs(newSViv(osver.dwMinorVersion));
-       XPUSHs(newSViv(osver.dwBuildNumber));
-       XPUSHs(newSViv(osver.dwPlatformId));
-       PUTBACK;
-       return;
-    }
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_IsWinNT)
-{
-    dXSARGS;
-    XSRETURN_IV(IsWinNT());
-}
-
-static
-XS(w32_IsWin95)
-{
-    dXSARGS;
-    XSRETURN_IV(IsWin95());
-}
-
-static
-XS(w32_FormatMessage)
-{
-    dXSARGS;
-    DWORD source = 0;
-    char msgbuf[1024];
-
-    if (items != 1)
-       croak("usage: Win32::FormatMessage($errno)");
-
-    if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
-                     &source, SvIV(ST(0)), 0,
-                     msgbuf, sizeof(msgbuf)-1, NULL))
-       XSRETURN_PV(msgbuf);
-
-    XSRETURN_UNDEF;
-}
-
-static
-XS(w32_Spawn)
-{
-    dXSARGS;
-    char *cmd, *args;
-    PROCESS_INFORMATION stProcInfo;
-    STARTUPINFO stStartInfo;
-    BOOL bSuccess = FALSE;
-
-    if(items != 3)
-       croak("usage: Win32::Spawn($cmdName, $args, $PID)");
-
-    cmd = SvPV(ST(0),na);
-    args = SvPV(ST(1), na);
-
-    memset(&stStartInfo, 0, sizeof(stStartInfo));   /* Clear the block */
-    stStartInfo.cb = sizeof(stStartInfo);          /* Set the structure size */
-    stStartInfo.dwFlags = STARTF_USESHOWWINDOW;            /* Enable wShowWindow control */
-    stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE;   /* Start min (normal) */
-
-    if(CreateProcess(
-               cmd,                    /* Image path */
-               args,                   /* Arguments for command line */
-               NULL,                   /* Default process security */
-               NULL,                   /* Default thread security */
-               FALSE,                  /* Must be TRUE to use std handles */
-               NORMAL_PRIORITY_CLASS,  /* No special scheduling */
-               NULL,                   /* Inherit our environment block */
-               NULL,                   /* Inherit our currrent directory */
-               &stStartInfo,           /* -> Startup info */
-               &stProcInfo))           /* <- Process info (if OK) */
-    {
-       CloseHandle(stProcInfo.hThread);/* library source code does this. */
-       sv_setiv(ST(2), stProcInfo.dwProcessId);
-       bSuccess = TRUE;
-    }
-    XSRETURN_IV(bSuccess);
-}
-
-static
-XS(w32_GetTickCount)
-{
-    dXSARGS;
-    XSRETURN_IV(GetTickCount());
-}
-
-static
-XS(w32_GetShortPathName)
-{
-    dXSARGS;
-    SV *shortpath;
-
-    if(items != 1)
-       croak("usage: Win32::GetShortPathName($longPathName)");
-
-    shortpath = sv_mortalcopy(ST(0));
-    SvUPGRADE(shortpath, SVt_PV);
-    /* src == target is allowed */
-    if (GetShortPathName(SvPVX(shortpath), SvPVX(shortpath), SvCUR(shortpath)))
-       ST(0) = shortpath;
-    else
-       ST(0) = &sv_undef;
-    XSRETURN(1);
-}
-
 static void
 xs_init()
 {
     char *file = __FILE__;
     dXSUB_SYS;
     newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
-
-    /* XXX should be removed after checking with Nick */
-    newXS("Win32::GetCurrentDirectory", w32_GetCwd, file);
-
-    /* these names are Activeware compatible */
-    newXS("Win32::GetCwd", w32_GetCwd, file);
-    newXS("Win32::SetCwd", w32_SetCwd, file);
-    newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
-    newXS("Win32::GetLastError", w32_GetLastError, file);
-    newXS("Win32::LoginName", w32_LoginName, file);
-    newXS("Win32::NodeName", w32_NodeName, file);
-    newXS("Win32::DomainName", w32_DomainName, file);
-    newXS("Win32::FsType", w32_FsType, file);
-    newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
-    newXS("Win32::IsWinNT", w32_IsWinNT, file);
-    newXS("Win32::IsWin95", w32_IsWin95, file);
-    newXS("Win32::FormatMessage", w32_FormatMessage, file);
-    newXS("Win32::Spawn", w32_Spawn, file);
-    newXS("Win32::GetTickCount", w32_GetTickCount, file);
-    newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
-
-    /* XXX Bloat Alert! The following Activeware preloads really
-     * ought to be part of Win32::Sys::*, so they're not included
-     * here.
-     */
-    /* LookupAccountName
-     * LookupAccountSID
-     * InitiateSystemShutdown
-     * AbortSystemShutdown
-     * ExpandEnvrironmentStrings
-     */
 }
 
index 055eaf9..45f9e46 100644 (file)
 
 #include "EXTERN.h"
 #include "perl.h"
+#include "XSUB.h"
 #include <fcntl.h>
 #include <sys/stat.h>
 #include <assert.h>
 #include <string.h>
 #include <stdarg.h>
+#include <float.h>
 
 #define CROAK croak
 #define WARN warn
@@ -1206,3 +1208,294 @@ win32_flock(int fd, int oper)
     return pIOSubSystem->pfnflock(fd, oper);
 }
 
+static
+XS(w32_GetCwd)
+{
+    dXSARGS;
+    SV *sv = sv_newmortal();
+    /* Make one call with zero size - return value is required size */
+    DWORD len = GetCurrentDirectory((DWORD)0,NULL);
+    SvUPGRADE(sv,SVt_PV);
+    SvGROW(sv,len);
+    SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv));
+    /* 
+     * If result != 0 
+     *   then it worked, set PV valid, 
+     *   else leave it 'undef' 
+     */
+    if (SvCUR(sv))
+       SvPOK_on(sv);
+    EXTEND(sp,1);
+    ST(0) = sv;
+    XSRETURN(1);
+}
+
+static
+XS(w32_SetCwd)
+{
+    dXSARGS;
+    if (items != 1)
+       croak("usage: Win32::SetCurrentDirectory($cwd)");
+    if (SetCurrentDirectory(SvPV(ST(0),na)))
+       XSRETURN_YES;
+
+    XSRETURN_NO;
+}
+
+static
+XS(w32_GetNextAvailDrive)
+{
+    dXSARGS;
+    char ix = 'C';
+    char root[] = "_:\\";
+    while (ix <= 'Z') {
+       root[0] = ix++;
+       if (GetDriveType(root) == 1) {
+           root[2] = '\0';
+           XSRETURN_PV(root);
+       }
+    }
+    XSRETURN_UNDEF;
+}
+
+static
+XS(w32_GetLastError)
+{
+    dXSARGS;
+    XSRETURN_IV(GetLastError());
+}
+
+static
+XS(w32_LoginName)
+{
+    dXSARGS;
+    char name[256];
+    DWORD size = sizeof(name);
+    if (GetUserName(name,&size)) {
+       /* size includes NULL */
+       ST(0) = sv_2mortal(newSVpv(name,size-1));
+       XSRETURN(1);
+    }
+    XSRETURN_UNDEF;
+}
+
+static
+XS(w32_NodeName)
+{
+    dXSARGS;
+    char name[MAX_COMPUTERNAME_LENGTH+1];
+    DWORD size = sizeof(name);
+    if (GetComputerName(name,&size)) {
+       /* size does NOT include NULL :-( */
+       ST(0) = sv_2mortal(newSVpv(name,size));
+       XSRETURN(1);
+    }
+    XSRETURN_UNDEF;
+}
+
+
+static
+XS(w32_DomainName)
+{
+    dXSARGS;
+    char name[256];
+    DWORD size = sizeof(name);
+    if (GetUserName(name,&size)) {
+       char sid[1024];
+       DWORD sidlen = sizeof(sid);
+       char dname[256];
+       DWORD dnamelen = sizeof(dname);
+       SID_NAME_USE snu;
+       if (LookupAccountName(NULL, name, &sid, &sidlen,
+                             dname, &dnamelen, &snu)) {
+           XSRETURN_PV(dname);         /* all that for this */
+       }
+    }
+    XSRETURN_UNDEF;
+}
+
+static
+XS(w32_FsType)
+{
+    dXSARGS;
+    char fsname[256];
+    DWORD flags, filecomplen;
+    if (GetVolumeInformation(NULL, NULL, 0, NULL, &filecomplen,
+                        &flags, fsname, sizeof(fsname))) {
+       if (GIMME == G_ARRAY) {
+           XPUSHs(sv_2mortal(newSVpv(fsname,0)));
+           XPUSHs(sv_2mortal(newSViv(flags)));
+           XPUSHs(sv_2mortal(newSViv(filecomplen)));
+           PUTBACK;
+           return;
+       }
+       XSRETURN_PV(fsname);
+    }
+    XSRETURN_UNDEF;
+}
+
+static
+XS(w32_GetOSVersion)
+{
+    dXSARGS;
+    OSVERSIONINFO osver;
+
+    osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+    if (GetVersionEx(&osver)) {
+       XPUSHs(newSVpv(osver.szCSDVersion, 0));
+       XPUSHs(newSViv(osver.dwMajorVersion));
+       XPUSHs(newSViv(osver.dwMinorVersion));
+       XPUSHs(newSViv(osver.dwBuildNumber));
+       XPUSHs(newSViv(osver.dwPlatformId));
+       PUTBACK;
+       return;
+    }
+    XSRETURN_UNDEF;
+}
+
+static
+XS(w32_IsWinNT)
+{
+    dXSARGS;
+    XSRETURN_IV(IsWinNT());
+}
+
+static
+XS(w32_IsWin95)
+{
+    dXSARGS;
+    XSRETURN_IV(IsWin95());
+}
+
+static
+XS(w32_FormatMessage)
+{
+    dXSARGS;
+    DWORD source = 0;
+    char msgbuf[1024];
+
+    if (items != 1)
+       croak("usage: Win32::FormatMessage($errno)");
+
+    if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,
+                     &source, SvIV(ST(0)), 0,
+                     msgbuf, sizeof(msgbuf)-1, NULL))
+       XSRETURN_PV(msgbuf);
+
+    XSRETURN_UNDEF;
+}
+
+static
+XS(w32_Spawn)
+{
+    dXSARGS;
+    char *cmd, *args;
+    PROCESS_INFORMATION stProcInfo;
+    STARTUPINFO stStartInfo;
+    BOOL bSuccess = FALSE;
+
+    if(items != 3)
+       croak("usage: Win32::Spawn($cmdName, $args, $PID)");
+
+    cmd = SvPV(ST(0),na);
+    args = SvPV(ST(1), na);
+
+    memset(&stStartInfo, 0, sizeof(stStartInfo));   /* Clear the block */
+    stStartInfo.cb = sizeof(stStartInfo);          /* Set the structure size */
+    stStartInfo.dwFlags = STARTF_USESHOWWINDOW;            /* Enable wShowWindow control */
+    stStartInfo.wShowWindow = SW_SHOWMINNOACTIVE;   /* Start min (normal) */
+
+    if(CreateProcess(
+               cmd,                    /* Image path */
+               args,                   /* Arguments for command line */
+               NULL,                   /* Default process security */
+               NULL,                   /* Default thread security */
+               FALSE,                  /* Must be TRUE to use std handles */
+               NORMAL_PRIORITY_CLASS,  /* No special scheduling */
+               NULL,                   /* Inherit our environment block */
+               NULL,                   /* Inherit our currrent directory */
+               &stStartInfo,           /* -> Startup info */
+               &stProcInfo))           /* <- Process info (if OK) */
+    {
+       CloseHandle(stProcInfo.hThread);/* library source code does this. */
+       sv_setiv(ST(2), stProcInfo.dwProcessId);
+       bSuccess = TRUE;
+    }
+    XSRETURN_IV(bSuccess);
+}
+
+static
+XS(w32_GetTickCount)
+{
+    dXSARGS;
+    XSRETURN_IV(GetTickCount());
+}
+
+static
+XS(w32_GetShortPathName)
+{
+    dXSARGS;
+    SV *shortpath;
+
+    if(items != 1)
+       croak("usage: Win32::GetShortPathName($longPathName)");
+
+    shortpath = sv_mortalcopy(ST(0));
+    SvUPGRADE(shortpath, SVt_PV);
+    /* src == target is allowed */
+    if (GetShortPathName(SvPVX(shortpath), SvPVX(shortpath), SvCUR(shortpath)))
+       ST(0) = shortpath;
+    else
+       ST(0) = &sv_undef;
+    XSRETURN(1);
+}
+
+void
+init_os_extras()
+{
+    char *file = __FILE__;
+    dXSUB_SYS;
+
+    /* XXX should be removed after checking with Nick */
+    newXS("Win32::GetCurrentDirectory", w32_GetCwd, file);
+
+    /* these names are Activeware compatible */
+    newXS("Win32::GetCwd", w32_GetCwd, file);
+    newXS("Win32::SetCwd", w32_SetCwd, file);
+    newXS("Win32::GetNextAvailDrive", w32_GetNextAvailDrive, file);
+    newXS("Win32::GetLastError", w32_GetLastError, file);
+    newXS("Win32::LoginName", w32_LoginName, file);
+    newXS("Win32::NodeName", w32_NodeName, file);
+    newXS("Win32::DomainName", w32_DomainName, file);
+    newXS("Win32::FsType", w32_FsType, file);
+    newXS("Win32::GetOSVersion", w32_GetOSVersion, file);
+    newXS("Win32::IsWinNT", w32_IsWinNT, file);
+    newXS("Win32::IsWin95", w32_IsWin95, file);
+    newXS("Win32::FormatMessage", w32_FormatMessage, file);
+    newXS("Win32::Spawn", w32_Spawn, file);
+    newXS("Win32::GetTickCount", w32_GetTickCount, file);
+    newXS("Win32::GetShortPathName", w32_GetShortPathName, file);
+
+    /* XXX Bloat Alert! The following Activeware preloads really
+     * ought to be part of Win32::Sys::*, so they're not included
+     * here.
+     */
+    /* LookupAccountName
+     * LookupAccountSID
+     * InitiateSystemShutdown
+     * AbortSystemShutdown
+     * ExpandEnvrironmentStrings
+     */
+}
+
+void
+Perl_win32_init(int *argcp, char ***argvp)
+{
+    /* Disable floating point errors, Perl will trap the ones we
+     * care about.  VC++ RTL defaults to switching these off
+     * already, but the Borland RTL doesn't.  Since we don't
+     * want to be at the vendor's whim on the default, we set
+     * it explicitly here.
+     */
+    _control87(MCW_EM, MCW_EM);
+}
index 5d15eb2..f683938 100644 (file)
@@ -111,6 +111,7 @@ unsigned int myalarm(unsigned int sec);
 int do_aspawn(void* really, void** mark, void** arglast);
 int do_spawn(char *cmd);
 char do_exec(char *cmd);
+void init_os_extras(void);
 
 typedef  char *                caddr_t;        /* In malloc.c (core address). */