=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
#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
#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
#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)
#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
#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)
#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)
#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)
#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)
#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
#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
#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
#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
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
#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)
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)
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
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 ;
PL_sig_name[sig],
strlen(PL_sig_name[sig]),
TRUE);
- STRLEN n_a;
/* Check optaction and set action */
if(SvTRUE(optaction)) {
#ifdef HAS_GETCWD
char * buf;
int buflen = 128;
- int i;
New(0, buf, buflen, char);
/* Many getcwd()s know how to automatically allocate memory
{
dTHX;
IV code = PerlIOBase_close(f);
- PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
return code;
}
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));
* 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);
# endif
# endif
#endif
+#ifndef HAS_GETHOSTNAME
check_out:
+#endif
if (retval == -1)
XSRETURN_UNDEF;
else
errno = EINVAL;
return 0;
+#if !defined(LOG_NOTICE) || !defined(LOG_NOWAIT)
not_there:
errno = ENOENT;
return 0;
+#endif
}
static double
errno = EINVAL;
return 0;
+#if !defined(LOG_NDELAY) || !defined(LOG_NEWS) || !defined(LOG_NFACILITIES)
not_there:
errno = ENOENT;
return 0;
+#endif
}
static double
errno = EINVAL;
return 0;
+#if !defined(LOG_PERROR) || !defined(LOG_PID) || !defined(LOG_PRIMASK)
not_there:
errno = ENOENT;
return 0;
+#endif
}
static double
errno = EINVAL;
return 0;
+#if !defined(LOG_AUTH) || !defined(LOG_AUTHPRIV)
not_there:
errno = ENOENT;
return 0;
+#endif
}
static double
errno = EINVAL;
return 0;
+#if !defined(LOG_ALERT)
not_there:
errno = ENOENT;
return 0;
+#endif
}
static double
errno = EINVAL;
return 0;
+#if !defined(LOG_CRIT) || !defined(LOG_CRON)
not_there:
errno = ENOENT;
return 0;
+#endif
}
static double
errno = EINVAL;
return 0;
+#if !defined(LOG_CONS)
not_there:
errno = ENOENT;
return 0;
+#endif
}
static double
errno = EINVAL;
return 0;
+#if !defined(LOG_DAEMON) || !defined(LOG_DEBUG)
not_there:
errno = ENOENT;
return 0;
+#endif
}
static double
errno = EINVAL;
return 0;
+#if !defined(LOG_USER) || !defined(LOG_UUCP)
not_there:
errno = ENOENT;
return 0;
+#endif
}
static double
errno = EINVAL;
return 0;
+#if !defined(LOG_EMERG) || !defined(LOG_ERR)
not_there:
errno = ENOENT;
return 0;
+#endif
}
static double
errno = EINVAL;
return 0;
+#if !defined(LOG_FACMASK) || !defined(LOG_FTP)
not_there:
errno = ENOENT;
return 0;
+#endif
}
static double
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
errno = EINVAL;
return 0;
+#if !defined(LOG_LFMT) || !defined(LOG_LPR)
not_there:
errno = ENOENT;
return 0;
+#endif
}
static double
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
}
{
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;
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);
#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)
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)
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);
}
+#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;
else if (op == WHILEM)
l--;
}
-#endif /* DEBUGGING */
return node;
}
+#endif /* DEBUGGING */
+
/*
- regdump - dump a regexp onto Perl_debug_log in vaguely comprehensible form
*/
#endif /* DEBUGGING */
}
+#ifdef DEBUGGING
+
STATIC void
S_put_byte(pTHX_ SV *sv, int c)
{
Perl_sv_catpvf(aTHX_ sv, "%c", c);
}
+#endif /* DEBUGGING */
+
/*
- regprop - printable representation of opcode
*/
}
REGCP_SET(lastcp);
if (paren) {
- UV c;
+ UV c = 0;
while (n >= ln) {
if (c1 != -1000) {
if (do_utf8)
}
}
else {
- UV c;
+ UV c = 0;
while (n >= ln) {
if (c1 != -1000) {
if (do_utf8)
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;
return Nullcv;
else
return deb_curcv(ix - 1);
-#else
- return Nullcv;
-#endif /* DEBUGGING */
}
+#endif /* DEBUGGING */
+
void
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)
{
/* 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)
{
});
}
+#endif
+
/*
* S_ao
*
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++)