mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 08:38:23 +00:00
Code Issues Packages Projects Releases Wiki Activity

Integrate maintperl changes #12268 and #12669;

Browse Source 
final touches to the audit for statics and thread-unsafe code
* make DB_File, ODBM_File thread-safe 
* remove unnecessary/dangerous statics and protect others
  from not getting accidentally enabled under threaded perls

windows support functions get_childdir() et al aren't exported
correctly under vanilla build

Testing under win32 appreciated since changes there had
to be manually merged and I cannot test how badly did I do.

p4raw-link: @12268 on //depot/perlio: bb407f0b8769c638c05e60ebfd157a1e676a6c22

p4raw-id: //depot/perl@12678
p4raw-integrated: from //depot/maint-5.6/perl@12677 'copy in'
	win32/vmem.h (@5902..) 'merge in' ext/DB_File/DB_File.xs
	(@8693..) win32/win32iop.h (@8917..) ext/ODBM_File/ODBM_File.xs
	(@8995..) iperlsys.h (@9154..) scope.c (@9584..) makedef.pl
	(@11425..) gv.c (@12026..) op.c (@12145..) util.c (@12220..)
	toke.c (@12550..) ext/B/B.xs ext/File/Glob/Glob.xs
	ext/Opcode/Opcode.xs ext/re/re.xs (@12653..) mg.c win32/win32.c
	(@12668..)
This commit is contained in:
Jarkko Hietaniemi 2001-10-26 13:03:01 +00:00
parent 9ece3ee665
commit df3728a2a5
17 changed files with 188 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ext/B/B.xs
View File

@ -70,7 +70,7 @@ static char *opclassnames[] = {
"B::COP"
};
#define MY_CXT_KEY "B::_guts"##XS_VERSION
#define MY_CXT_KEY "B::_guts" XS_VERSION
typedef struct {
int x_walkoptree_debug; /* Flag for walkoptree debug hook */

66
ext/DB_File/DB_File.xs
View File

@ -463,10 +463,21 @@ extern void __getBerkeleyDBInfo(void);
#endif
/* Internal Global Data */
static recno_t Value ;
static recno_t zero = 0 ;
static DB_File CurrentDB ;
static DBTKEY empty ;
#define MY_CXT_KEY "DB_File::_guts" XS_VERSION
typedef struct {
recno_t x_Value;
recno_t x_zero;
DB_File x_CurrentDB;
DBTKEY x_empty;
} my_cxt_t;
START_MY_CXT
#define Value (MY_CXT.x_Value)
#define zero (MY_CXT.x_zero)
#define CurrentDB (MY_CXT.x_CurrentDB)
#define empty (MY_CXT.x_empty)
#ifdef DB_VERSION_MAJOR
@ -560,7 +571,8 @@ const DBT * key2 ;
dTHX;
#endif
dSP ;
char * data1, * data2 ;
dMY_CXT ;
void * data1, * data2 ;
int retval ;
int count ;
@ -631,6 +643,7 @@ const DBT * key2 ;
dTHX;
#endif
dSP ;
dMY_CXT ;
char * data1, * data2 ;
int retval ;
int count ;
@ -709,6 +722,7 @@ HASH_CB_SIZE_TYPE size ;
dTHX;
#endif
dSP ;
dMY_CXT;
int retval ;
int count ;
@ -884,6 +898,7 @@ SV * sv ;
void * openinfo = NULL ;
INFO * info = &RETVAL->info ;
STRLEN n_a;
dMY_CXT;
/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
Zero(RETVAL, 1, DB_File_type) ;
@ -1157,6 +1172,7 @@ SV * sv ;
DB * dbp ;
STRLEN n_a;
int status ;
dMY_CXT;
/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
Zero(RETVAL, 1, DB_File_type) ;
@ -1639,6 +1655,7 @@ MODULE = DB_File PACKAGE = DB_File PREFIX = db_
BOOT:
{
MY_CXT_INIT;
__getBerkeleyDBInfo() ;
DBT_clear(empty) ;
@ -1680,6 +1697,8 @@ db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_H
int
db_DESTROY(db)
DB_File db
PREINIT:
dMY_CXT;
INIT:
CurrentDB = db ;
CLEANUP:
@ -1711,6 +1730,8 @@ db_DELETE(db, key, flags=0)
DB_File db
DBTKEY key
u_int flags
PREINIT:
dMY_CXT;
INIT:
CurrentDB = db ;
@ -1719,6 +1740,8 @@ int
db_EXISTS(db, key)
DB_File db
DBTKEY key
PREINIT:
dMY_CXT;
CODE:
{
DBT value ;
@ -1736,7 +1759,8 @@ db_FETCH(db, key, flags=0)
DBTKEY key
u_int flags
PREINIT:
int RETVAL;
dMY_CXT ;
int RETVAL ;
CODE:
{
DBT value ;
@ -1755,6 +1779,8 @@ db_STORE(db, key, value, flags=0)
DBTKEY key
DBT value
u_int flags
PREINIT:
dMY_CXT;
INIT:
CurrentDB = db ;
@ -1763,7 +1789,8 @@ void
db_FIRSTKEY(db)
DB_File db
PREINIT:
int RETVAL;
dMY_CXT ;
int RETVAL ;
CODE:
{
DBTKEY key ;
@ -1782,7 +1809,8 @@ db_NEXTKEY(db, key)
DB_File db
DBTKEY key = NO_INIT
PREINIT:
int RETVAL;
dMY_CXT ;
int RETVAL ;
CODE:
{
DBT value ;
@ -1803,6 +1831,8 @@ int
unshift(db, ...)
DB_File db
ALIAS: UNSHIFT = 1
PREINIT:
dMY_CXT;
CODE:
{
DBTKEY key ;
@ -1843,6 +1873,8 @@ unshift(db, ...)
void
pop(db)
DB_File db
PREINIT:
dMY_CXT;
ALIAS: POP = 1
PREINIT:
I32 RETVAL;
@ -1872,6 +1904,8 @@ pop(db)
void
shift(db)
DB_File db
PREINIT:
dMY_CXT;
ALIAS: SHIFT = 1
PREINIT:
I32 RETVAL;
@ -1901,6 +1935,8 @@ shift(db)
I32
push(db, ...)
DB_File db
PREINIT:
dMY_CXT;
ALIAS: PUSH = 1
CODE:
{
@ -1943,6 +1979,8 @@ push(db, ...)
I32
length(db)
DB_File db
PREINIT:
dMY_CXT;
ALIAS: FETCHSIZE = 1
CODE:
CurrentDB = db ;
@ -1960,6 +1998,8 @@ db_del(db, key, flags=0)
DB_File db
DBTKEY key
u_int flags
PREINIT:
dMY_CXT;
CODE:
CurrentDB = db ;
RETVAL = db_del(db, key, flags) ;
@ -1979,6 +2019,8 @@ db_get(db, key, value, flags=0)
DBTKEY key
DBT value = NO_INIT
u_int flags
PREINIT:
dMY_CXT;
CODE:
CurrentDB = db ;
DBT_clear(value) ;
@ -1999,6 +2041,8 @@ db_put(db, key, value, flags=0)
DBTKEY key
DBT value
u_int flags
PREINIT:
dMY_CXT;
CODE:
CurrentDB = db ;
RETVAL = db_put(db, key, value, flags) ;
@ -2015,6 +2059,8 @@ db_put(db, key, value, flags=0)
int
db_fd(db)
DB_File db
PREINIT:
dMY_CXT ;
CODE:
CurrentDB = db ;
#ifdef DB_VERSION_MAJOR
@ -2039,6 +2085,8 @@ int
db_sync(db, flags=0)
DB_File db
u_int flags
PREINIT:
dMY_CXT;
CODE:
CurrentDB = db ;
RETVAL = db_sync(db, flags) ;
@ -2056,6 +2104,8 @@ db_seq(db, key, value, flags)
DBTKEY key
DBT value = NO_INIT
u_int flags
PREINIT:
dMY_CXT;
CODE:
CurrentDB = db ;
DBT_clear(value) ;

2
ext/File/Glob/Glob.xs
View File

@ -4,7 +4,7 @@
#include "bsd_glob.h"
#define MY_CXT_KEY "File::Glob::_guts"##XS_VERSION
#define MY_CXT_KEY "File::Glob::_guts" XS_VERSION
typedef struct {
int x_GLOB_ERROR;

19
ext/ODBM_File/ODBM_File.xs
View File

@ -81,7 +81,15 @@ typedef datum datum_value ;
#define odbm_FIRSTKEY(db) firstkey()
#define odbm_NEXTKEY(db,key) nextkey(key)
static int dbmrefcnt;
#define MY_CXT_KEY "ODBM_File::_guts" XS_VERSION
typedef struct {
int x_dbmrefcnt;
} my_cxt_t;
START_MY_CXT
#define dbmrefcnt (MY_CXT.x_dbmrefcnt)
#ifndef DBM_REPLACE
#define DBM_REPLACE 0
@ -89,6 +97,11 @@ static int dbmrefcnt;
MODULE = ODBM_File PACKAGE = ODBM_File PREFIX = odbm_
BOOT:
{
MY_CXT_INIT;
}
ODBM_File
odbm_TIEHASH(dbtype, filename, flags, mode)
char * dbtype
@ -99,6 +112,8 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
{
char *tmpbuf;
void * dbp ;
dMY_CXT;
if (dbmrefcnt++)
croak("Old dbm can only open one database");
New(0, tmpbuf, strlen(filename) + 5, char);
@ -126,6 +141,8 @@ odbm_TIEHASH(dbtype, filename, flags, mode)
void
DESTROY(db)
ODBM_File db
PREINIT:
dMY_CXT;
CODE:
dbmrefcnt--;
dbmclose();

2
ext/Opcode/Opcode.xs
View File

@ -7,7 +7,7 @@
#define OP_MASK_BUF_SIZE (MAXO + 100)
/* XXX op_named_bits and opset_all are never freed */
#define MY_CXT_KEY "Opcode::_guts"##XS_VERSION
#define MY_CXT_KEY "Opcode::_guts" XS_VERSION
typedef struct {
HV * x_op_named_bits; /* cache shared for whole process */

2
ext/re/re.xs
View File

@ -17,7 +17,7 @@ extern char* my_re_intuit_start (pTHX_ regexp *prog, SV *sv, char *strpos,
struct re_scream_pos_data_s *data);
extern SV* my_re_intuit_string (pTHX_ regexp *prog);
#define MY_CXT_KEY "re::_guts"##XS_VERSION
#define MY_CXT_KEY "re::_guts" XS_VERSION
typedef struct {
int x_oldflag; /* debug flag */

4
gv.c
View File

@ -411,8 +411,8 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload)
GV*
Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
{
static char autoload[] = "AUTOLOAD";
static STRLEN autolen = 8;
char autoload[] = "AUTOLOAD";
STRLEN autolen = sizeof(autoload)-1;
GV* gv;
CV* cv;
HV* varstash;

16
iperlsys.h
View File

@ -542,11 +542,6 @@ struct IPerlEnvInfo
#define PerlEnv_putenv(str) putenv((str))
#define PerlEnv_getenv(str) getenv((str))
#define PerlEnv_getenv_len(str,l) getenv_len((str), (l))
#define PerlEnv_clearenv() clearenv()
#define PerlEnv_get_childenv() get_childenv()
#define PerlEnv_free_childenv(e) free_childenv((e))
#define PerlEnv_get_childdir() get_childdir()
#define PerlEnv_free_childdir(d) free_childdir((d))
#ifdef HAS_ENVGETENV
# define PerlEnv_ENVgetenv(str) ENVgetenv((str))
# define PerlEnv_ENVgetenv_len(str,l) ENVgetenv_len((str), (l))
@ -562,6 +557,17 @@ struct IPerlEnvInfo
#define PerlEnv_sitelib_path(str) win32_get_sitelib(str)
#define PerlEnv_vendorlib_path(str) win32_get_vendorlib(str)
#define PerlEnv_get_child_IO(ptr) win32_get_child_IO(ptr)
#define PerlEnv_clearenv() win32_clearenv()
#define PerlEnv_get_childenv() win32_get_childenv()
#define PerlEnv_free_childenv(e) win32_free_childenv((e))
#define PerlEnv_get_childdir() win32_get_childdir()
#define PerlEnv_free_childdir(d) win32_free_childdir((d))
#else
#define PerlEnv_clearenv() clearenv()
#define PerlEnv_get_childenv() get_childenv()
#define PerlEnv_free_childenv(e) free_childenv((e))
#define PerlEnv_get_childdir() get_childdir()
#define PerlEnv_free_childdir(d) free_childdir((d))
#endif
#endif /* PERL_IMPLICIT_SYS */

6
makedef.pl
View File

@ -882,7 +882,11 @@ if ($PLATFORM eq 'win32') {
win32_getpid
win32_crypt
win32_dynaload
win32_get_childenv
win32_free_childenv
win32_clearenv
win32_get_childdir
win32_free_childdir
win32_stdin
win32_stdout
win32_stderr

30
mg.c
View File

@ -959,27 +959,10 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
#if defined(VMS) || defined(EPOC)
Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
#else
# ifdef PERL_IMPLICIT_SYS
# if defined(PERL_IMPLICIT_SYS) || defined(WIN32)
PerlEnv_clearenv();
# else
# ifdef WIN32
char *envv = GetEnvironmentStrings();
char *cur = envv;
STRLEN len;
while (*cur) {
char *end = strchr(cur,'=');
if (end && end != cur) {
*end = '\0';
my_setenv(cur,Nullch);
*end = '=';
cur = end + strlen(end+1)+2;
}
else if ((len = strlen(cur)))
cur += len+1;
}
FreeEnvironmentStrings(envv);
# else
#ifdef USE_ENVIRON_ARRAY
#if !defined(MACOS_TRADITIONAL)
# ifndef PERL_USE_SAFE_PUTENV
I32 i;
@ -992,8 +975,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
environ[0] = Nullch;
#endif /* USE_ENVIRON_ARRAY */
# endif /* WIN32 */
#endif /* !defined(MACOS_TRADITIONAL) */
# endif /* PERL_IMPLICIT_SYS */
#endif /* VMS */
return 0;
@ -2222,7 +2204,9 @@ Perl_whichsig(pTHX_ char *sig)
return 0;
}
#if !defined(PERL_IMPLICIT_CONTEXT)
static SV* sig_sv;
#endif
Signal_t
Perl_sighandler(int sig)
@ -2290,7 +2274,9 @@ Perl_sighandler(int sig)
if(PL_psig_name[sig]) {
sv = SvREFCNT_inc(PL_psig_name[sig]);
flags |= 64;
#if !defined(PERL_IMPLICIT_CONTEXT)
sig_sv = sv;
#endif
} else {
sv = sv_newmortal();
sv_setpv(sv,PL_sig_name[sig]);
@ -2391,6 +2377,8 @@ unwind_handler_stack(pTHX_ void *p)
if (flags & 1)
PL_savestack_ix -= 5; /* Unprotect save in progress. */
/* cxstack_ix-- Not needed, die already unwound it. */
#if !defined(PERL_IMPLICIT_CONTEXT)
if (flags & 64)
SvREFCNT_dec(sig_sv);
#endif
}

6
op.c
View File

@ -24,10 +24,10 @@
/* #define PL_OP_SLAB_ALLOC */
#ifdef PL_OP_SLAB_ALLOC
#if defined(PL_OP_SLAB_ALLOC) && !defined(PERL_IMPLICIT_CONTEXT)
#define SLAB_SIZE 8192
static char *PL_OpPtr = NULL;
static int PL_OpSpace = 0;
static char *PL_OpPtr = NULL; /* XXX threadead */
static int PL_OpSpace = 0; /* XXX threadead */
#define NewOp(m,var,c,type) do { if ((PL_OpSpace -= c*sizeof(type)) >= 0) \
var = (type *)(PL_OpPtr -= c*sizeof(type)); \
else \

8
scope.c
View File

@ -50,19 +50,11 @@ Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
SV**
Perl_stack_grow(pTHX_ SV **sp, SV **p, int n)
{
#if defined(DEBUGGING) && !defined(USE_5005THREADS)
static int growing = 0;
if (growing++)
abort();
#endif
PL_stack_sp = sp;
#ifndef STRESS_REALLOC
av_extend(PL_curstack, (p - PL_stack_base) + (n) + 128);
#else
av_extend(PL_curstack, (p - PL_stack_base) + (n) + 1);
#endif
#if defined(DEBUGGING) && !defined(USE_5005THREADS)
growing--;
#endif
return PL_stack_sp;
}

7
toke.c
View File

@ -5099,10 +5099,9 @@ Perl_yylex(pTHX)
case KEY_write:
#ifdef EBCDIC
{
static char ctl_l[2];
if (ctl_l[0] == '\0')
ctl_l[0] = toCTRL('L');
char ctl_l[2];
ctl_l[0] = toCTRL('L');
ctl_l[1] = '\0';
gv_fetchpv(ctl_l,TRUE, SVt_PV);
}
#else

3
util.c
View File

@ -2285,7 +2285,8 @@ Perl_rsignal(pTHX_ int signo, Sighandler_t handler)
return PerlProc_signal(signo, handler);
}
static int sig_trapped;
static int sig_trapped; /* XXX signals are process-wide anyway, so we
ignore the implications of this for threading */
static
Signal_t

23
win32/vmem.h
View File

@ -143,6 +143,9 @@ protected:
long m_lAllocSize; // current alloc size
long m_lRefCount; // number of current users
CRITICAL_SECTION m_cs; // access lock
#ifdef _DEBUG_MEM
FILE* m_pLog;
#endif
};
// #define _DEBUG_MEM
@ -185,6 +188,9 @@ VMem::VMem()
ASSERT(bRet);
InitializeCriticalSection(&m_cs);
#ifdef _DEBUG_MEM
m_pLog = 0;
#endif
Init();
}
@ -193,6 +199,9 @@ VMem::~VMem(void)
{
ASSERT(HeapValidate(m_hHeap, HEAP_NO_SERIALIZE, NULL));
WALKHEAPTRACE();
#ifdef _DEBUG_MEM
MemoryUsageMessage(NULL, 0, 0, 0);
#endif
DeleteCriticalSection(&m_cs);
BOOL bRet = HeapDestroy(m_hHeap);
ASSERT(bRet);
@ -642,21 +651,21 @@ void* VMem::Expand(void* block, size_t size)
}
#ifdef _DEBUG_MEM
#define LOG_FILENAME "P:\\Apps\\Perl\\Result.txt"
#define LOG_FILENAME ".\\MemLog.txt"
void MemoryUsageMessage(char *str, long x, long y, int c)
{
static FILE* fp = NULL;
char szBuffer[512];
if(str) {
if(!fp)
fp = fopen(LOG_FILENAME, "w");
if(!m_pLog)
m_pLog = fopen(LOG_FILENAME, "w");
sprintf(szBuffer, str, x, y, c);
fputs(szBuffer, fp);
fputs(szBuffer, m_pLog);
}
else {
fflush(fp);
fclose(fp);
fflush(m_pLog);
fclose(m_pLog);
m_pLog = 0;
}
}

54
win32/win32.c
View File

@ -1824,6 +1824,8 @@ FAILED:
return -1;
}
#ifndef PERL_IMPLICIT_CONTEXT
static UINT timerid = 0;
static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
@ -1834,9 +1836,12 @@ static VOID CALLBACK TimerProc(HWND win, UINT msg, UINT id, DWORD time)
CALL_FPTR(PL_sighandlerp)(14);
}
#endif /* !PERL_IMPLICIT_CONTEXT */
DllExport unsigned int
win32_alarm(unsigned int sec)
{
#ifndef PERL_IMPLICIT_CONTEXT
/*
* the 'obvious' implentation is SetTimer() with a callback
* which does whatever receiving SIGALRM would do
@ -1862,6 +1867,7 @@ win32_alarm(unsigned int sec)
}
}
return 0;
#endif /* !PERL_IMPLICIT_CONTEXT */
}
#ifdef HAVE_DES_FCRYPT
@ -3271,19 +3277,39 @@ GIVE_UP:
* environment and the current directory to CreateProcess
*/
void*
get_childenv(void)
DllExport void*
win32_get_childenv(void)
{
return NULL;
}
void
free_childenv(void* d)
DllExport void
win32_free_childenv(void* d)
{
}
char*
get_childdir(void)
DllExport void
win32_clearenv(void)
{
char *envv = GetEnvironmentStrings();
char *cur = envv;
STRLEN len;
while (*cur) {
char *end = strchr(cur,'=');
if (end && end != cur) {
*end = '\0';
SetEnvironmentVariable(cur, NULL);
*end = '=';
cur = end + strlen(end+1)+2;
}
else if ((len = strlen(cur)))
cur += len+1;
}
FreeEnvironmentStrings(envv);
}
DllExport char*
win32_get_childdir(void)
{
dTHX;
char* ptr;
@ -3302,8 +3328,8 @@ get_childdir(void)
return ptr;
}
void
free_childdir(char* d)
DllExport void
win32_free_childdir(char* d)
{
dTHX;
Safefree(d);
@ -3556,12 +3582,12 @@ win32_putchar(int c)
#ifndef USE_PERL_SBRK
static char *committed = NULL;
static char *base = NULL;
static char *reserved = NULL;
static char *brk = NULL;
static DWORD pagesize = 0;
static DWORD allocsize = 0;
static char *committed = NULL; /* XXX threadead */
static char *base = NULL; /* XXX threadead */
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(int need)

17
win32/win32iop.h
View File

@ -145,6 +145,12 @@ DllExport int win32_getpid(void);
DllExport char * win32_crypt(const char *txt, const char *salt);
DllExport void * win32_get_childenv(void);
DllExport void win32_free_childenv(void* d);
DllExport void win32_clearenv(void);
DllExport char * win32_get_childdir(void);
DllExport void win32_free_childdir(char* d);
END_EXTERN_C
/*
@ -299,6 +305,17 @@ END_EXTERN_C
#undef crypt
#define crypt(t,s) win32_crypt(t,s)
#undef get_childenv
#undef free_childenv
#undef clearenv
#undef get_childdir
#undef free_childdir
#define get_childenv() win32_get_childenv()
#define free_childenv(d) win32_free_childenv(d)
#define clearenv() win32_clearenv()
#define get_childdir() win32_get_childdir()
#define free_childdir(d) win32_free_childdir(d)
#undef getenv
#define getenv win32_getenv
#undef putenv