Change 23304 by nicholas@no-spam on 2004/09/10 06:04:43
Integrate:
[ 23111]
This seems to be needed to get COW working on Win32
[ 23121]
Some calls to PerlMemShared_alloc() aren't checking the return value.
Bug spotted by Nigel Sandever
[ 23128]
Use VirtualAlloc() more flexibly when using it to mimic UNIX's sbrk().
From: Steve Hay <steve.hay@no-spam>
CC: perl-win32-porters@no-spam
Message-ID: <40F6B295.8010804@no-spam>
Assumes perl's malloc can now handle non-contiguous memory (believed
to be true).
Does not address threading issues.
"The attached patch (against blead) makes sbrk() initially try to
extend the existing block of memory exactly as it currently does, but
to not fail immediately if it can't -- it now frees up that part of
whatever it had previously reserved+committed which hadn't actually
been used yet, resets all its static variables and basically starts
anew."
Affected files ...
... //depot/maint-5.8/perl/ext/threads/threads.xs#23 integrate
... //depot/maint-5.8/perl/util.c#42 integrate
... //depot/maint-5.8/perl/win32/win32.c#21 integrate
Differences ...
==== //depot/maint-5.8/perl/ext/threads/threads.xs#23 (xtext) ====
Index: perl/ext/threads/threads.xs
--- perl/ext/threads/threads.xs#22~23133~ Sat Jul 17 02:36:41 2004
+++ perl/ext/threads/threads.xs Thu Sep 9 23:04:43 2004
@@no-spam -389,6 +389,12 @@no-spam
MUTEX_LOCK(&create_destruct_mutex);
thread = PerlMemShared_malloc(sizeof(ithread));
+ if (!thread) {
+ MUTEX_UNLOCK(&create_destruct_mutex);
+ PerlLIO_write(PerlIO_fileno(Perl_error_log),
+ PL_no_mem, strlen(PL_no_mem));
+ my_exit(1);
+ }
Zero(thread,1,ithread);
thread->next = threads;
thread->prev = threads->prev;
@@no-spam -755,6 +761,11 @@no-spam
MUTEX_LOCK(&create_destruct_mutex);
PL_threadhook = &Perl_ithread_hook;
thread = PerlMemShared_malloc(sizeof(ithread));
+ if (!thread) {
+ PerlLIO_write(PerlIO_fileno(Perl_error_log),
+ PL_no_mem, strlen(PL_no_mem));
+ my_exit(1);
+ }
Zero(thread,1,ithread);
PL_perl_destruct_level = 2;
MUTEX_INIT(&thread->mutex);
==== //depot/maint-5.8/perl/util.c#42 (text) ====
Index: perl/util.c
--- perl/util.c#41~22555~ Mon Mar 22 11:57:32 2004
+++ perl/util.c Thu Sep 9 23:04:43 2004
@@no-spam -803,6 +803,11 @@no-spam
register char *newaddr = Nullch;
if (pv) {
newaddr = (char*)PerlMemShared_malloc(strlen(pv)+1);
+ if (!newaddr) {
+ PerlLIO_write(PerlIO_fileno(Perl_error_log),
+ PL_no_mem, strlen(PL_no_mem));
+ my_exit(1);
+ }
(void)strcpy(newaddr,pv);
}
return newaddr;
==== //depot/maint-5.8/perl/win32/win32.c#21 (text) ====
Index: perl/win32/win32.c
--- perl/win32/win32.c#20~22794~ Thu May 6 08:43:41 2004
+++ perl/win32/win32.c Thu Sep 9 23:04:43 2004
@@no-spam -4155,7 +4155,6 @@no-spam
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)
@@no-spam -4168,28 +4167,34 @@no-spam
* 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)
{
@@no-spam -4201,6 +4206,19 @@no-spam
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;
@@no-spam -4211,11 +4229,12 @@no-spam
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;
}
@@no-spam -4807,13 +4826,15 @@no-spam
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;
End of Patch.