diff options
| -rw-r--r-- | README.tru64 | 12 | ||||
| -rw-r--r-- | embed.h | 24 | ||||
| -rwxr-xr-x | embed.pl | 8 | ||||
| -rw-r--r-- | ext/NDBM_File/NDBM_File.xs | 2 | ||||
| -rw-r--r-- | ext/POSIX/POSIX.xs | 2 | ||||
| -rw-r--r-- | ext/PerlIO/Scalar/Scalar.xs | 1 | ||||
| -rw-r--r-- | ext/Storable/Storable.xs | 6 | ||||
| -rw-r--r-- | ext/Sys/Hostname/Hostname.xs | 2 | ||||
| -rw-r--r-- | ext/Sys/Syslog/Syslog.xs | 28 | ||||
| -rw-r--r-- | perl.c | 2 | ||||
| -rw-r--r-- | proto.h | 8 | ||||
| -rw-r--r-- | regcomp.c | 10 | ||||
| -rw-r--r-- | regexec.c | 4 | ||||
| -rw-r--r-- | run.c | 14 | ||||
| -rw-r--r-- | toke.c | 4 | ||||
| -rw-r--r-- | util.c | 22 |
16 files changed, 110 insertions, 39 deletions
diff --git a/README.tru64 b/README.tru64 index c551a36594..4eb6a001f9 100644 --- a/README.tru64 +++ b/README.tru64 @@ -15,11 +15,13 @@ is compiled and/or runs. =head2 Compiling Perl 5 on Tru64 The recommended compiler to use in Tru64 is the native C compiler. -The native compiler produces much faster code (the speed difference is -noticeable: several dozen percentages) and also more correct code: if you -are considering using the GNU C compiler you should use the gcc 2.95.3 -release since older gcc releases are known to produce buggy code when -compiling Perl. +The native compiler produces much faster code (the speed difference +is noticeable: several dozen percentages) and also more correct code: +if you are considering using the GNU C compiler you should use the +gcc 2.95.3 since all older gcc releases are known to produce broken +code when compiling Perl. One manifestation of this brokenness is +the lib/sdbm test dumping core; another is the op/regexp dumping core +(depending on the GCC release). =head2 Using Large Files with Perl on Tru64 @@ -1017,8 +1017,10 @@ #define regtail S_regtail #define regwhite S_regwhite #define nextchar S_nextchar +# ifdef DEBUGGING #define dumpuntil S_dumpuntil #define put_byte S_put_byte +# endif #define scan_commit S_scan_commit #define cl_anything S_cl_anything #define cl_is_anything S_cl_is_anything @@ -1049,8 +1051,10 @@ #define find_byclass S_find_byclass #endif #if defined(PERL_IN_RUN_C) || defined(PERL_DECL_PROT) +# ifdef DEBUGGING #define deb_curcv S_deb_curcv #define debprof S_debprof +# endif #endif #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) #define save_scalar_at S_save_scalar_at @@ -1100,7 +1104,7 @@ #define visit S_visit #define sv_add_backref S_sv_add_backref #define sv_del_backref S_sv_del_backref -# if defined(DEBUGGING) +# ifdef DEBUGGING #define del_sv S_del_sv # endif # if !defined(NV_PRESERVES_UV) @@ -1145,7 +1149,9 @@ #define filter_gets S_filter_gets #define find_in_my_stash S_find_in_my_stash #define new_constant S_new_constant +# if defined(DEBUGGING) #define tokereport S_tokereport +# endif #define ao S_ao #define depcom S_depcom #define incl_perldb S_incl_perldb @@ -2508,8 +2514,10 @@ #define regtail(a,b,c) S_regtail(aTHX_ a,b,c) #define regwhite(a,b) S_regwhite(aTHX_ a,b) #define nextchar(a) S_nextchar(aTHX_ a) +# ifdef DEBUGGING #define dumpuntil(a,b,c,d,e) S_dumpuntil(aTHX_ a,b,c,d,e) #define put_byte(a,b) S_put_byte(aTHX_ a,b) +# endif #define scan_commit(a,b) S_scan_commit(aTHX_ a,b) #define cl_anything(a,b) S_cl_anything(aTHX_ a,b) #define cl_is_anything(a) S_cl_is_anything(aTHX_ a) @@ -2539,8 +2547,10 @@ #define find_byclass(a,b,c,d,e,f) S_find_byclass(aTHX_ a,b,c,d,e,f) #endif #if defined(PERL_IN_RUN_C) || defined(PERL_DECL_PROT) +# ifdef DEBUGGING #define deb_curcv(a) S_deb_curcv(aTHX_ a) #define debprof(a) S_debprof(aTHX_ a) +# endif #endif #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) #define save_scalar_at(a) S_save_scalar_at(aTHX_ a) @@ -2590,7 +2600,7 @@ #define visit(a) S_visit(aTHX_ a) #define sv_add_backref(a,b) S_sv_add_backref(aTHX_ a,b) #define sv_del_backref(a) S_sv_del_backref(aTHX_ a) -# if defined(DEBUGGING) +# ifdef DEBUGGING #define del_sv(a) S_del_sv(aTHX_ a) # endif # if !defined(NV_PRESERVES_UV) @@ -2635,7 +2645,9 @@ #define filter_gets(a,b,c) S_filter_gets(aTHX_ a,b,c) #define find_in_my_stash(a,b) S_find_in_my_stash(aTHX_ a,b) #define new_constant(a,b,c,d,e,f) S_new_constant(aTHX_ a,b,c,d,e,f) +# if defined(DEBUGGING) #define tokereport(a,b,c) S_tokereport(aTHX_ a,b,c) +# endif #define ao(a) S_ao(aTHX_ a) #define depcom() S_depcom(aTHX) #define incl_perldb() S_incl_perldb(aTHX) @@ -4897,10 +4909,12 @@ #define regwhite S_regwhite #define S_nextchar CPerlObj::S_nextchar #define nextchar S_nextchar +# ifdef DEBUGGING #define S_dumpuntil CPerlObj::S_dumpuntil #define dumpuntil S_dumpuntil #define S_put_byte CPerlObj::S_put_byte #define put_byte S_put_byte +# endif #define S_scan_commit CPerlObj::S_scan_commit #define scan_commit S_scan_commit #define S_cl_anything CPerlObj::S_cl_anything @@ -4957,10 +4971,12 @@ #define find_byclass S_find_byclass #endif #if defined(PERL_IN_RUN_C) || defined(PERL_DECL_PROT) +# ifdef DEBUGGING #define S_deb_curcv CPerlObj::S_deb_curcv #define deb_curcv S_deb_curcv #define S_debprof CPerlObj::S_debprof #define debprof S_debprof +# endif #endif #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) #define S_save_scalar_at CPerlObj::S_save_scalar_at @@ -5055,7 +5071,7 @@ #define sv_add_backref S_sv_add_backref #define S_sv_del_backref CPerlObj::S_sv_del_backref #define sv_del_backref S_sv_del_backref -# if defined(DEBUGGING) +# ifdef DEBUGGING #define S_del_sv CPerlObj::S_del_sv #define del_sv S_del_sv # endif @@ -5137,8 +5153,10 @@ #define find_in_my_stash S_find_in_my_stash #define S_new_constant CPerlObj::S_new_constant #define new_constant S_new_constant +# if defined(DEBUGGING) #define S_tokereport CPerlObj::S_tokereport #define tokereport S_tokereport +# endif #define S_ao CPerlObj::S_ao #define ao S_ao #define S_depcom CPerlObj::S_depcom @@ -2414,9 +2414,11 @@ s |void |regoptail |struct RExC_state_t*|regnode *|regnode * s |void |regtail |struct RExC_state_t*|regnode *|regnode * s |char*|regwhite |char *|char * s |char*|nextchar |struct RExC_state_t* +# ifdef DEBUGGING s |regnode*|dumpuntil |regnode *start|regnode *node \ |regnode *last|SV* sv|I32 l s |void |put_byte |SV* sv|int c +# endif s |void |scan_commit |struct RExC_state_t*|struct scan_data_t *data s |void |cl_anything |struct RExC_state_t*|struct regnode_charclass_class *cl s |int |cl_is_anything |struct regnode_charclass_class *cl @@ -2453,8 +2455,10 @@ s |char* |find_byclass |regexp * prog|regnode *c|char *s|char *strend|char *star #endif #if defined(PERL_IN_RUN_C) || defined(PERL_DECL_PROT) +# ifdef DEBUGGING s |CV* |deb_curcv |I32 ix s |void |debprof |OP *o +# endif #endif #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) @@ -2506,7 +2510,7 @@ s |void |not_a_number |SV *sv s |I32 |visit |SVFUNC_t f s |void |sv_add_backref |SV *tsv|SV *sv s |void |sv_del_backref |SV *sv -# if defined(DEBUGGING) +# ifdef DEBUGGING s |void |del_sv |SV *p # endif # if !defined(NV_PRESERVES_UV) @@ -2557,7 +2561,9 @@ s |char * |filter_gets |SV *sv|PerlIO *fp|STRLEN append s |HV * |find_in_my_stash|char *pkgname|I32 len s |SV* |new_constant |char *s|STRLEN len|const char *key|SV *sv \ |SV *pv|const char *type +# if defined(DEBUGGING) s |void |tokereport |char *thing|char *s|I32 rv +# endif s |int |ao |int toketype s |void |depcom s |char* |incl_perldb diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs index c417eb693e..55dd639e95 100644 --- a/ext/NDBM_File/NDBM_File.xs +++ b/ext/NDBM_File/NDBM_File.xs @@ -53,7 +53,7 @@ ndbm_TIEHASH(dbtype, filename, flags, mode) DBM * dbp ; RETVAL = NULL ; - if (dbp = dbm_open(filename, flags, mode)) { + if ((dbp = dbm_open(filename, flags, mode))) { RETVAL = (NDBM_File)safemalloc(sizeof(NDBM_File_type)) ; Zero(RETVAL, 1, NDBM_File_type) ; RETVAL->dbp = dbp ; diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 842131e115..f079b7b257 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -3181,7 +3181,6 @@ sigaction(sig, optaction, oldaction = 0) PL_sig_name[sig], strlen(PL_sig_name[sig]), TRUE); - STRLEN n_a; /* Check optaction and set action */ if(SvTRUE(optaction)) { @@ -3740,7 +3739,6 @@ getcwd() #ifdef HAS_GETCWD char * buf; int buflen = 128; - int i; New(0, buf, buflen, char); /* Many getcwd()s know how to automatically allocate memory diff --git a/ext/PerlIO/Scalar/Scalar.xs b/ext/PerlIO/Scalar/Scalar.xs index e1e9349cd9..fb8b39abb6 100644 --- a/ext/PerlIO/Scalar/Scalar.xs +++ b/ext/PerlIO/Scalar/Scalar.xs @@ -67,7 +67,6 @@ PerlIOScalar_close(PerlIO *f) { dTHX; IV code = PerlIOBase_close(f); - PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar); PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF); return code; } diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs index f306a49df7..542c2a54cd 100644 --- a/ext/Storable/Storable.xs +++ b/ext/Storable/Storable.xs @@ -2136,8 +2136,8 @@ static int store_hook( I32 classnum; int ret; int clone = cxt->optype & ST_CLONE; - char mtype; /* for blessed ref to tied structures */ - unsigned char eflags; /* used when object type is SHT_EXTRA */ + char mtype = 0; /* for blessed ref to tied structures */ + unsigned char eflags = 0; /* used when object type is SHT_EXTRA */ TRACEME(("store_hook, class \"%s\", tagged #%d", HvNAME(pkg), cxt->tagnum)); @@ -4459,7 +4459,7 @@ magic_ok: * information to check. */ - if (cxt->netorder = (use_network_order & 0x1)) + if ((cxt->netorder = (use_network_order & 0x1))) return &PL_sv_undef; /* No byte ordering info */ sprintf(byteorder, "%lx", (unsigned long) BYTEORDER); diff --git a/ext/Sys/Hostname/Hostname.xs b/ext/Sys/Hostname/Hostname.xs index f1043837e9..23ecd694ed 100644 --- a/ext/Sys/Hostname/Hostname.xs +++ b/ext/Sys/Hostname/Hostname.xs @@ -69,7 +69,9 @@ ghname() # endif # endif #endif +#ifndef HAS_GETHOSTNAME check_out: +#endif if (retval == -1) XSRETURN_UNDEF; else diff --git a/ext/Sys/Syslog/Syslog.xs b/ext/Sys/Syslog/Syslog.xs index 24055d9969..e600da0add 100644 --- a/ext/Sys/Syslog/Syslog.xs +++ b/ext/Sys/Syslog/Syslog.xs @@ -30,9 +30,11 @@ constant_LOG_NO(char *name, int len) errno = EINVAL; return 0; +#if !defined(LOG_NOTICE) || !defined(LOG_NOWAIT) not_there: errno = ENOENT; return 0; +#endif } static double @@ -69,9 +71,11 @@ constant_LOG_N(char *name, int len) errno = EINVAL; return 0; +#if !defined(LOG_NDELAY) || !defined(LOG_NEWS) || !defined(LOG_NFACILITIES) not_there: errno = ENOENT; return 0; +#endif } static double @@ -106,9 +110,11 @@ constant_LOG_P(char *name, int len) errno = EINVAL; return 0; +#if !defined(LOG_PERROR) || !defined(LOG_PID) || !defined(LOG_PRIMASK) not_there: errno = ENOENT; return 0; +#endif } static double @@ -139,9 +145,11 @@ constant_LOG_AU(char *name, int len) errno = EINVAL; return 0; +#if !defined(LOG_AUTH) || !defined(LOG_AUTHPRIV) not_there: errno = ENOENT; return 0; +#endif } static double @@ -162,9 +170,11 @@ constant_LOG_A(char *name, int len) errno = EINVAL; return 0; +#if !defined(LOG_ALERT) not_there: errno = ENOENT; return 0; +#endif } static double @@ -191,9 +201,11 @@ constant_LOG_CR(char *name, int len) errno = EINVAL; return 0; +#if !defined(LOG_CRIT) || !defined(LOG_CRON) not_there: errno = ENOENT; return 0; +#endif } static double @@ -214,9 +226,11 @@ constant_LOG_C(char *name, int len) errno = EINVAL; return 0; +#if !defined(LOG_CONS) not_there: errno = ENOENT; return 0; +#endif } static double @@ -243,9 +257,11 @@ constant_LOG_D(char *name, int len) errno = EINVAL; return 0; +#if !defined(LOG_DAEMON) || !defined(LOG_DEBUG) not_there: errno = ENOENT; return 0; +#endif } static double @@ -272,9 +288,11 @@ constant_LOG_U(char *name, int len) errno = EINVAL; return 0; +#if !defined(LOG_USER) || !defined(LOG_UUCP) not_there: errno = ENOENT; return 0; +#endif } static double @@ -301,9 +319,11 @@ constant_LOG_E(char *name, int len) errno = EINVAL; return 0; +#if !defined(LOG_EMERG) || !defined(LOG_ERR) not_there: errno = ENOENT; return 0; +#endif } static double @@ -330,9 +350,11 @@ constant_LOG_F(char *name, int len) errno = EINVAL; return 0; +#if !defined(LOG_FACMASK) || !defined(LOG_FTP) not_there: errno = ENOENT; return 0; +#endif } static double @@ -411,9 +433,11 @@ constant_LOG_LO(char *name, int len) errno = EINVAL; return 0; +#if !defined(LOG_LOCAL0) || !defined(LOG_LOCAL1) || !defined(LOG_LOCAL2) || !defined(LOG_LOCAL3) || !defined(LOG_LOCAL4) || !defined(LOG_LOCAL5) || !defined(LOG_LOCAL6) || !defined(LOG_LOCAL7) not_there: errno = ENOENT; return 0; +#endif } static double @@ -442,9 +466,11 @@ constant_LOG_L(char *name, int len) errno = EINVAL; return 0; +#if !defined(LOG_LFMT) || !defined(LOG_LPR) not_there: errno = ENOENT; return 0; +#endif } static double @@ -544,9 +570,11 @@ constant(char *name, int len) errno = EINVAL; return 0; +#if !defined(LOG_INFO) || !defined(LOG_KERN) || !defined(LOG_MAIL) || !defined(LOG_ODELAY) || !defined(LOG_SYSLOG) || !defined(LOG_WARNING) not_there: errno = ENOENT; return 0; +#endif } @@ -1868,7 +1868,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) { dSP; UNOP myop; /* fake syntax tree node */ - I32 oldmark = SP - PL_stack_base; + volatile I32 oldmark = SP - PL_stack_base; volatile I32 retval = 0; I32 oldscope; int ret; @@ -1143,8 +1143,10 @@ STATIC void S_regoptail(pTHX_ struct RExC_state_t*, regnode *, regnode *); STATIC void S_regtail(pTHX_ struct RExC_state_t*, regnode *, regnode *); STATIC char* S_regwhite(pTHX_ char *, char *); STATIC char* S_nextchar(pTHX_ struct RExC_state_t*); +# ifdef DEBUGGING STATIC regnode* S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l); STATIC void S_put_byte(pTHX_ SV* sv, int c); +# endif STATIC void S_scan_commit(pTHX_ struct RExC_state_t*, struct scan_data_t *data); STATIC void S_cl_anything(pTHX_ struct RExC_state_t*, struct regnode_charclass_class *cl); STATIC int S_cl_is_anything(pTHX_ struct regnode_charclass_class *cl); @@ -1177,8 +1179,10 @@ STATIC char* S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *stre #endif #if defined(PERL_IN_RUN_C) || defined(PERL_DECL_PROT) +# ifdef DEBUGGING STATIC CV* S_deb_curcv(pTHX_ I32 ix); STATIC void S_debprof(pTHX_ OP *o); +# endif #endif #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) @@ -1230,7 +1234,7 @@ STATIC void S_not_a_number(pTHX_ SV *sv); STATIC I32 S_visit(pTHX_ SVFUNC_t f); STATIC void S_sv_add_backref(pTHX_ SV *tsv, SV *sv); STATIC void S_sv_del_backref(pTHX_ SV *sv); -# if defined(DEBUGGING) +# ifdef DEBUGGING STATIC void S_del_sv(pTHX_ SV *p); # endif # if !defined(NV_PRESERVES_UV) @@ -1277,7 +1281,9 @@ STATIC I32 S_sublex_start(pTHX); STATIC char * S_filter_gets(pTHX_ SV *sv, PerlIO *fp, STRLEN append); STATIC HV * S_find_in_my_stash(pTHX_ char *pkgname, I32 len); STATIC SV* S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv, const char *type); +# if defined(DEBUGGING) STATIC void S_tokereport(pTHX_ char *thing, char *s, I32 rv); +# endif STATIC int S_ao(pTHX_ int toketype); STATIC void S_depcom(pTHX); STATIC char* S_incl_perldb(pTHX); @@ -4175,10 +4175,11 @@ S_regcurly(pTHX_ register char *s) } +#ifdef DEBUGGING + STATIC regnode * S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l) { -#ifdef DEBUGGING register U8 op = EXACT; /* Arbitrary non-END op. */ register regnode *next; @@ -4244,10 +4245,11 @@ S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l) else if (op == WHILEM) l--; } -#endif /* DEBUGGING */ return node; } +#endif /* DEBUGGING */ + /* - regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form */ @@ -4328,6 +4330,8 @@ Perl_regdump(pTHX_ regexp *r) #endif /* DEBUGGING */ } +#ifdef DEBUGGING + STATIC void S_put_byte(pTHX_ SV *sv, int c) { @@ -4339,6 +4343,8 @@ S_put_byte(pTHX_ SV *sv, int c) Perl_sv_catpvf(aTHX_ sv, "%c", c); } +#endif /* DEBUGGING */ + /* - regprop - printable representation of opcode */ @@ -3295,7 +3295,7 @@ S_regmatch(pTHX_ regnode *prog) } REGCP_SET(lastcp); if (paren) { - UV c; + UV c = 0; while (n >= ln) { if (c1 != -1000) { if (do_utf8) @@ -3315,7 +3315,7 @@ S_regmatch(pTHX_ regnode *prog) } } else { - UV c; + UV c = 0; while (n >= ln) { if (c1 != -1000) { if (do_utf8) @@ -107,10 +107,11 @@ Perl_debop(pTHX_ OP *o) return 0; } +#ifdef DEBUGGING + STATIC CV* S_deb_curcv(pTHX_ I32 ix) { -#ifdef DEBUGGING PERL_CONTEXT *cx = &cxstack[ix]; if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) return cx->blk_sub.cv; @@ -122,11 +123,10 @@ S_deb_curcv(pTHX_ I32 ix) return Nullcv; else return deb_curcv(ix - 1); -#else - return Nullcv; -#endif /* DEBUGGING */ } +#endif /* DEBUGGING */ + void Perl_watch(pTHX_ char **addr) { @@ -138,16 +138,18 @@ Perl_watch(pTHX_ char **addr) #endif /* DEBUGGING */ } +#ifdef DEBUGGING + STATIC void S_debprof(pTHX_ OP *o) { -#ifdef DEBUGGING if (!PL_profiledata) Newz(000, PL_profiledata, MAXO, U32); ++PL_profiledata[o->op_type]; -#endif /* DEBUGGING */ } +#endif /* DEBUGGING */ + void Perl_debprofdump(pTHX) { @@ -181,6 +181,8 @@ int yyactlevel = -1; /* grandfather return to old style */ #define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP) +#ifdef DEBUGGING + STATIC void S_tokereport(pTHX_ char *thing, char* s, I32 rv) { @@ -199,6 +201,8 @@ S_tokereport(pTHX_ char *thing, char* s, I32 rv) }); } +#endif + /* * S_ao * @@ -3972,28 +3972,28 @@ Perl_my_fflush_all(pTHX) extern void _fwalk(int (*)(FILE *)); _fwalk(&fflush); return 0; -# else - long open_max = -1; +# else # if defined(FFLUSH_ALL) && defined(HAS_STDIO_STREAM_ARRAY) + long open_max = -1; # ifdef PERL_FFLUSH_ALL_FOPEN_MAX open_max = PERL_FFLUSH_ALL_FOPEN_MAX; # else -# if defined(HAS_SYSCONF) && defined(_SC_OPEN_MAX) +# if defined(HAS_SYSCONF) && defined(_SC_OPEN_MAX) open_max = sysconf(_SC_OPEN_MAX); -# else -# ifdef FOPEN_MAX +# else +# ifdef FOPEN_MAX open_max = FOPEN_MAX; -# else -# ifdef OPEN_MAX +# else +# ifdef OPEN_MAX open_max = OPEN_MAX; -# else -# ifdef _NFILE +# else +# ifdef _NFILE open_max = _NFILE; +# endif +# endif # endif # endif # endif -# endif -# endif if (open_max > 0) { long i; for (i = 0; i < open_max; i++) |