static void get_shell(void);
static long tokenize(const char *str, char **dest, char ***destv);
-static int do_spawn2(pTHX_ char *cmd, int exectype);
-static BOOL has_shell_metachars(char *ptr);
+static int do_spawn2(pTHX_ const char *cmd, int exectype);
+static BOOL has_shell_metachars(const char *ptr);
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, ...);
#define ONE_K_BUFSIZE 1024
+#ifdef __BORLANDC__
+/* Silence STDERR grumblings from Borland's math library. */
+DllExport int
+_matherr(struct _exception *a)
+{
+ PERL_UNUSED_VAR(a);
+ return 1;
+}
+#endif
+
int
IsWin95(void)
{
: w32_perldll_handle),
w32_module_name, sizeof(w32_module_name));
+ /* remove \\?\ prefix */
+ if (memcmp(w32_module_name, "\\\\?\\", 4) == 0)
+ memmove(w32_module_name, w32_module_name+4, strlen(w32_module_name+4)+1);
+
/* try to get full path to binary (which may be mangled when perl is
* run from a 16-bit app) */
/*PerlIO_printf(Perl_debug_log, "Before %s\n", w32_module_name);*/
dTHX;
if (!*prev_pathp)
*prev_pathp = sv_2mortal(newSVpvn("",0));
- sv_catpvn(*prev_pathp, ";", 1);
+ else if (SvPVX(*prev_pathp))
+ sv_catpvn(*prev_pathp, ";", 1);
sv_catpv(*prev_pathp, mod_name);
return SvPVX(*prev_pathp);
}
}
static BOOL
-has_shell_metachars(char *ptr)
+has_shell_metachars(const char *ptr)
{
int inquote = 0;
char quote = '\0';
* the library functions will get the correct environment
*/
PerlIO *
-Perl_my_popen(pTHX_ char *cmd, char *mode)
+Perl_my_popen(pTHX_ const char *cmd, const char *mode)
{
#ifdef FIXCMD
#define fixcmd(x) { \
int slen = strlen(str);
register char *ret;
register char **retv;
- New(1307, ret, slen+2, char);
- New(1308, retv, (slen+3)/2, char*);
+ Newx(ret, slen+2, char);
+ Newx(retv, (slen+3)/2, char*);
retstart = ret;
retvstart = retv;
return -1;
get_shell();
- New(1306, argv, (sp - mark) + w32_perlshell_items + 2, char*);
+ Newx(argv, (sp - mark) + w32_perlshell_items + 2, char*);
if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) {
++mark;
}
static int
-do_spawn2(pTHX_ char *cmd, int exectype)
+do_spawn2(pTHX_ const char *cmd, int exectype)
{
char **a;
char *s;
/* Save an extra exec if possible. See if there are shell
* metacharacters in it */
if (!has_shell_metachars(cmd)) {
- New(1301,argv, strlen(cmd) / 2 + 2, char*);
- New(1302,cmd2, strlen(cmd) + 1, char);
+ Newx(argv, strlen(cmd) / 2 + 2, char*);
+ Newx(cmd2, strlen(cmd) + 1, char);
strcpy(cmd2, cmd);
a = argv;
for (s = cmd2; *s;) {
char **argv;
int i = -1;
get_shell();
- New(1306, argv, w32_perlshell_items + 2, char*);
+ Newx(argv, w32_perlshell_items + 2, char*);
while (++i < w32_perlshell_items)
argv[i] = w32_perlshell_vec[i];
- argv[i++] = cmd;
+ argv[i++] = (char *)cmd;
argv[i] = Nullch;
switch (exectype) {
case EXECF_SPAWN:
}
bool
-Perl_do_exec(pTHX_ char *cmd)
+Perl_do_exec(pTHX_ const char *cmd)
{
do_spawn2(aTHX_ cmd, EXECF_EXEC);
return FALSE;
* return the pointer to the current file name.
*/
DllExport DIR *
-win32_opendir(char *filename)
+win32_opendir(const char *filename)
{
dTHX;
DIR *dirp;
return NULL;
/* Get us a DIR structure */
- Newz(1303, dirp, 1, DIR);
+ Newxz(dirp, 1, DIR);
/* Create the search pattern */
strcpy(scanname, filename);
dirp->size = 128;
else
dirp->size = idx;
- New(1304, dirp->start, dirp->size, char);
+ Newx(dirp->start, dirp->size, char);
strcpy(dirp->start, ptr);
dirp->nfiles++;
dirp->end = dirp->curr = dirp->start;
/* FindFirstFile() and stat() are buggy with a trailing
* backslash, so change it to a forward slash :-( */
case '\\':
+ if (l >= sizeof(buffer)) {
+ errno = ENAMETOOLONG;
+ return -1;
+ }
strncpy(buffer, path, l-1);
buffer[l - 1] = '/';
buffer[l] = '\0';
if (name) {
if (USING_WIDE()) {
length = strlen(name)+1;
- New(1309,wCuritem,length,WCHAR);
+ Newx(wCuritem,length,WCHAR);
A2WHELPER(name, wCuritem, length*sizeof(WCHAR));
wVal = wcschr(wCuritem, '=');
if (wVal) {
Safefree(wCuritem);
}
else {
- New(1309,curitem,strlen(name)+1,char);
+ Newx(curitem,strlen(name)+1,char);
strcpy(curitem, name);
val = strchr(curitem, '=');
if (val) {
win32_ftell(FILE *pf)
{
#if defined(WIN64) || defined(USE_LARGE_FILES)
-#if defined(__BORLAND__) /* buk */
+#if defined(__BORLANDC__) /* buk */
return win32_tell( fileno( pf ) );
#else
fpos_t pos;
return fsetpos(pf, &offset);
#endif
#else
- return fseek(pf, offset, origin);
+ return fseek(pf, (long)offset, origin);
#endif
}
win32_lseek(fd, cur, SEEK_SET);
return retval;
#else
- return chsize(fd, size);
+ return chsize(fd, (long)size);
#endif
}
return _lseeki64(fd, offset, origin);
#endif
#else
- return lseek(fd, offset, origin);
+ return lseek(fd, (long)offset, origin);
#endif
}
|| (IsWinNT() && stricmp(&cname[clen-4], ".cmd") == 0)))
{
bat_file = TRUE;
- len += 3;
+ if (!IsWin95())
+ len += 3;
}
else {
char *exe = strrchr(cname, '/');
DEBUG_p(PerlIO_printf(Perl_debug_log, "\n"));
argc = index;
- New(1310, cmd, len, char);
+ Newx(cmd, len, char);
ptr = cmd;
- if (bat_file) {
+ if (bat_file && !IsWin95()) {
*ptr++ = '"';
extra_quotes = TRUE;
}
/* look in PATH */
pathstr = PerlEnv_getenv("PATH");
- New(0, fullcmd, MAX_PATH+1, char);
+
+ /* worst case: PATH is a single directory; we need additional space
+ * to append "/", ".exe" and trailing "\0" */
+ Newx(fullcmd, (pathstr ? strlen(pathstr) : 0) + cmdlen + 6, char);
curfullcmd = fullcmd;
while (1) {
if (*pathstr == '"') { /* foo;"baz;etc";bar */
pathstr++; /* skip initial '"' */
while (*pathstr && *pathstr != '"') {
- if ((STRLEN)(curfullcmd-fullcmd) < MAX_PATH-cmdlen-5)
- *curfullcmd++ = *pathstr;
- pathstr++;
+ *curfullcmd++ = *pathstr++;
}
if (*pathstr)
pathstr++; /* skip trailing '"' */
}
else {
- if ((STRLEN)(curfullcmd-fullcmd) < MAX_PATH-cmdlen-5)
- *curfullcmd++ = *pathstr;
- pathstr++;
+ *curfullcmd++ = *pathstr++;
}
}
if (*pathstr)
GetCurrentDirectoryA(MAX_PATH+1, szfilename);
}
- New(0, ptr, strlen(szfilename)+1, char);
+ Newx(ptr, strlen(szfilename)+1, char);
strcpy(ptr, szfilename);
return ptr;
}
/* if command name contains dquotes, must remove them */
if (strchr(cname, '"')) {
cmd = cname;
- New(0,cname,clen+1,char);
+ Newx(cname,clen+1,char);
clen = 0;
while (*cmd) {
if (*cmd != '"') {
/* if this is a pseudo-forked child, we just want to spawn
* the new program, and return */
if (w32_pseudo_id)
+# ifdef __BORLANDC__
return spawnv(P_WAIT, cmdname, (char *const *)argv);
+# else
+ return spawnv(P_WAIT, cmdname, argv);
+# endif
#endif
+#ifdef __BORLANDC__
return execv(cmdname, (char *const *)argv);
+#else
+ return execv(cmdname, argv);
+#endif
}
DllExport int
return status;
}
#endif
+#ifdef __BORLANDC__
return execvp(cmdname, (char *const *)argv);
+#else
+ return execvp(cmdname, argv);
+#endif
}
DllExport void
static char *reserved = NULL; /* XXX threadead */
static char *brk = NULL; /* XXX threadead */
static DWORD pagesize = 0; /* XXX threadead */
-static DWORD allocsize = 0; /* XXX threadead */
void *
sbrk(ptrdiff_t need)
* call the OS to commit just one page ...
*/
pagesize = info.dwPageSize << 3;
- allocsize = info.dwAllocationGranularity;
}
- /* This scheme fails eventually if request for contiguous
- * block is denied so reserve big blocks - this is only
- * address space not memory ...
- */
if (brk+need >= reserved)
{
- DWORD size = 64*1024*1024;
+ DWORD size = brk+need-reserved;
char *addr;
+ char *prev_committed = NULL;
if (committed && reserved && committed < reserved)
{
/* Commit last of previous chunk cannot span allocations */
addr = (char *) VirtualAlloc(committed,reserved-committed,MEM_COMMIT,PAGE_READWRITE);
if (addr)
+ {
+ /* Remember where we committed from in case we want to decommit later */
+ prev_committed = committed;
committed = reserved;
+ }
}
/* Reserve some (more) space
+ * Contiguous blocks give us greater efficiency, so reserve big blocks -
+ * this is only address space not memory...
* Note this is a little sneaky, 1st call passes NULL as reserved
* so lets system choose where we start, subsequent calls pass
* the old end address so ask for a contiguous block
*/
+sbrk_reserve:
+ if (size < 64*1024*1024)
+ size = 64*1024*1024;
+ size = ((size + pagesize - 1) / pagesize) * pagesize;
addr = (char *) VirtualAlloc(reserved,size,MEM_RESERVE,PAGE_NOACCESS);
if (addr)
{
if (!brk)
brk = committed;
}
+ else if (reserved)
+ {
+ /* The existing block could not be extended far enough, so decommit
+ * anything that was just committed above and start anew */
+ if (prev_committed)
+ {
+ if (!VirtualFree(prev_committed,reserved-prev_committed,MEM_DECOMMIT))
+ return (void *) -1;
+ }
+ reserved = base = committed = brk = NULL;
+ size = need;
+ goto sbrk_reserve;
+ }
else
{
return (void *) -1;
if (brk > committed)
{
DWORD size = ((brk-committed + pagesize -1)/pagesize) * pagesize;
- char *addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE);
+ char *addr;
+ if (committed+size > reserved)
+ size = reserved-committed;
+ addr = (char *) VirtualAlloc(committed,size,MEM_COMMIT,PAGE_READWRITE);
if (addr)
- {
- committed += size;
- }
+ committed += size;
else
return (void *) -1;
}
XSRETURN_EMPTY;
}
}
+ if (GIMME_V == G_SCALAR) {
+ XSRETURN_IV(osverw.dwPlatformId);
+ }
W2AHELPER(osverw.szCSDVersion, szCSDVersion, sizeof(szCSDVersion));
XPUSHs(newSVpvn(szCSDVersion, strlen(szCSDVersion)));
osver.dwMajorVersion = osverw.dwMajorVersion;
XSRETURN_EMPTY;
}
}
+ if (GIMME_V == G_SCALAR) {
+ XSRETURN_IV(osver.dwPlatformId);
+ }
XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion)));
}
XPUSHs(newSViv(osver.dwMajorVersion));
SV *fullpath;
char *filepart;
DWORD len;
+ STRLEN filename_len;
+ char *filename_p;
if (items != 1)
Perl_croak(aTHX_ "usage: Win32::GetFullPathName($filename)");
filename = ST(0);
- fullpath = sv_mortalcopy(filename);
- SvUPGRADE(fullpath, SVt_PV);
+ filename_p = SvPV(filename, filename_len);
+ fullpath = sv_2mortal(newSVpvn(filename_p, filename_len));
if (!SvPVX(fullpath) || !SvLEN(fullpath))
XSRETURN_UNDEF;
w32_perlshell_vec = (char**)NULL;
w32_perlshell_items = 0;
w32_fdpid = newAV();
- New(1313, w32_children, 1, child_tab);
+ Newx(w32_children, 1, child_tab);
w32_num_children = 0;
# ifdef USE_ITHREADS
w32_pseudo_id = 0;
- New(1313, w32_pseudo_children, 1, child_tab);
+ Newx(w32_pseudo_children, 1, child_tab);
w32_num_pseudo_children = 0;
# endif
- w32_init_socktype = 0;
w32_timerid = 0;
w32_poll_count = 0;
for (i=0; i < SIG_SIZE; i++) {
{
# endif
/* Force C runtime signal stuff to set its console handler */
- signal(SIGINT,&win32_csighandler);
- signal(SIGBREAK,&win32_csighandler);
+ signal(SIGINT,win32_csighandler);
+ signal(SIGBREAK,win32_csighandler);
/* Push our handler on top */
SetConsoleCtrlHandler(win32_ctrlhandler,TRUE);
}
dst->perlshell_vec = (char**)NULL;
dst->perlshell_items = 0;
dst->fdpid = newAV();
- Newz(1313, dst->children, 1, child_tab);
+ Newxz(dst->children, 1, child_tab);
dst->pseudo_id = 0;
- Newz(1313, dst->pseudo_children, 1, child_tab);
- dst->thr_intern.Winit_socktype = 0;
+ Newxz(dst->pseudo_children, 1, child_tab);
dst->timerid = 0;
dst->poll_count = 0;
Copy(src->sigtable,dst->sigtable,SIG_SIZE,Sighandler_t);
if (lpwStr && argc) {
while (argc--) {
length = WideCharToMultiByte(CP_UTF8, 0, lpwStr[--wargc], -1, NULL, 0, NULL, NULL);
- Newz(0, psz, length, char);
+ Newxz(psz, length, char);
WideCharToMultiByte(CP_UTF8, 0, lpwStr[wargc], -1, psz, length, NULL, NULL);
argv[argc] = psz;
}
projects / p5sagit/p5-mst-13.2.git / blobdiff